* interp/c-util.boot (eqSubstAndCopy): New.

	(eqSubst): Likewise.
	(replaceSimpleFunctions): Handle XLAM-replaceable functions.
	* interp/wi1.boot (pairList): Remove duplicate.

4 files changed, 29 insertions, 8 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index fe4e7bb4..b6e432d8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2008-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/c-util.boot (eqSubstAndCopy): New.
+	(eqSubst): Likewise.
+	(replaceSimpleFunctions): Handle XLAM-replaceable functions.
+	* interp/wi1.boot (pairList): Remove duplicate.
+
 2008-10-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/c-util.boot (clearReplacement): New.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 28221176..567c1e47 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -848,30 +848,45 @@ getFunctionReplacement name ==
 clearReplacement name ==
   REMPROP(name,"SPADreplace")
 
+eqSubstAndCopy: (%List, %List, %Form) -> %Form
+eqSubstAndCopy(args,parms,body) ==
+  SUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ)
+
+eqSubst: (%List, %List, %Form) -> %Form
+eqSubst(args,parms,body) ==
+  NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ)
+
 ++ Walk `form' and replace simple functions as appropriate.
 replaceSimpleFunctions form ==
   atom form => form
   form is ["QUOTE",:.] => form
-  -- process argument first.
+  -- 1. process argument first.
   for args in tails rest form repeat
     arg' := replaceSimpleFunctions(arg := first args)
     not EQ(arg',arg) =>
       rplac(first args, arg')
-  -- now, see if we know something about this function.
+  -- 2. see if we know something about this function.
   [fun,:args] := form
   atom fun =>
     null (fun' := getFunctionReplacement fun) => form
-    -- the renaming case.
+    -- 2.1. the renaming case.
     atom fun' =>
       rplac(first form,fun')
       NBUTLAST form
-    -- the substitution case; ignore for now.
+    -- 2.2. the substitution case.
+    fun' is ["XLAM",parms,body] =>
+      -- conversatively approximate eager semantics
+      and/[atom first as for as in tails args] =>
+        -- alpha rename before substitution.
+	newparms := [GENSYM() for p in parms]
+	body := eqSubstAndCopy(newparms,parms,body)
+	eqSubst(args,newparms,body)
+      -- get cute later.
+      form
     form
   fun' := replaceSimpleFunctions fun
   not EQ(fun',fun) => rplac(first form,fun')
   form
-    
-
 
 ++ record optimizations permitted at level `level'.
 setCompilerOptimizations level ==
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 4640f06d..a856ca2d 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -38,6 +38,7 @@ namespace BOOT
 
 module g_-util where
   getTypeOfSyntax: %Form -> %Mode
+  pairList: (%List,%List) -> %List
 
 ++
 $interpOnly := false
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index bb120ab5..8693f7d4 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -39,8 +39,6 @@ namespace BOOT
 
 spad2AsTranslatorAutoloadOnceTrigger() == nil
 
-pairList(u,v) == [[x,:y] for x in u for y in v]
-
 --======================================================================
 --    Temporary definitions---for tracing and debugging
 --======================================================================