* boot/tokens.boot (absKind, absParms, absBody): New selectors.

	* interp/compiler.boot (canReturn): Handle %lambda forms.
	(compUnnamedMapping): Generate %lambda forms. Don't optimize them
	yet. 
	* interp/g-opt.boot: %lambda forms are side-effect free.
	* interp/lisp-backend.boot: Translate them.

9 files changed, 29 insertions, 16 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index ae9597dd..f033da2f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2011-11-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/tokens.boot (absKind, absParms, absBody): New selectors.
+	* interp/compiler.boot (canReturn): Handle %lambda forms.
+	(compUnnamedMapping): Generate %lambda forms. Don't optimize them
+	yet. 
+	* interp/g-opt.boot: %lambda forms are side-effect free.
+	* interp/lisp-backend.boot: Translate them.
+
+2011-11-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/g-opt.boot (isSimpleForm): Remove as unused.
 	(floatableVMForm?): New.
 	(modified?): Rename form varIsAssigned.
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index ea0dabcf..ceecbce5 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -232,11 +232,12 @@
    (SETQ |bfVar#1| (CDR |bfVar#1|))))
 
 (LET ((|bfVar#1|
-       (LIST (LIST '|setName| 0) (LIST '|setLabel| 1) (LIST '|setLevel| 2)
-             (LIST '|setType| 3) (LIST '|setVar| 4) (LIST '|setLeaf| 5)
-             (LIST '|setDef| 6) (LIST '|aGeneral| 4) (LIST '|aMode| 1)
-             (LIST '|aModeSet| 3) (LIST '|aTree| 0) (LIST '|aValue| 2)
-             (LIST '|args| 'CDR) (LIST '|attributes| 'CADDR)
+       (LIST (LIST '|absKind| 'CAR) (LIST '|absParms| 'CADR)
+             (LIST '|absBody| 'CADDR) (LIST '|setName| 0) (LIST '|setLabel| 1)
+             (LIST '|setLevel| 2) (LIST '|setType| 3) (LIST '|setVar| 4)
+             (LIST '|setLeaf| 5) (LIST '|setDef| 6) (LIST '|aGeneral| 4)
+             (LIST '|aMode| 1) (LIST '|aModeSet| 3) (LIST '|aTree| 0)
+             (LIST '|aValue| 2) (LIST '|args| 'CDR) (LIST '|attributes| 'CADDR)
              (LIST '|cacheCount| 'CADDDDR) (LIST '|cacheName| 'CADR)
              (LIST '|cacheReset| 'CADDDR) (LIST '|cacheType| 'CADDR)
              (LIST '|env| 'CADDR) (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 2f87cc64..9abbe2ca 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -93,7 +93,7 @@
   (|reallyPrettyPrint|
    (LIST 'PROCLAIM (|quote| (CONS 'OPTIMIZE |$LispOptimizeOptions|))) |stream|))
 
-(DEFUN |AxiomCore|::|%sysInit| ()
+(DEFUN |%sysInit| ()
   (PROGN
    (SETQ *LOAD-VERBOSE* NIL)
    (COND
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 663f1301..b45cb669 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -340,6 +340,9 @@ for i in [ _
 
  
 for i in [ _
+  ["absKind",           "CAR"] ,_
+  ["absParms",         "CADR"] ,_
+  ["absBody",         "CADDR"] ,_
   ["setName",               0] , _
   ["setLabel",              1] , _
   ["setLevel",              2] , _
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 0254f3db..dea05b3d 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1379,7 +1379,7 @@ compIf(["IF",a,b,c],m,E) ==
 canReturn(expr,level,exitCount,ValueFlag) ==  --SPAD: exit and friends
   expr isnt [.,:.] => ValueFlag and level=exitCount
   op := expr.op
-  op in '(QUOTE CLOSEDFN) => ValueFlag and level=exitCount
+  op in '(QUOTE CLOSEDFN %lambda) => ValueFlag and level=exitCount
   op is "TAGGEDexit" =>
     expr is [.,count,data] => canReturn(data.expr,level,count,count=level)
   level=exitCount and not ValueFlag => nil
@@ -2684,8 +2684,7 @@ compUnnamedMapping(parms,source,target,body,env) ==
     [.,.,env] := compMakeDeclaration(p,s,env)
     env := giveVariableSomeValue(p,get(p,'mode,env),env)
   T := comp(body,target,env) or return nil
-  [.,fun] := optimizeFunctionDef [nil,["LAMBDA",parms,T.expr]]
-  fun := finishLambdaExpression(fun,env)
+  fun := ['%closure,['%lambda,[:parms,'$],T.expr],'$]
   [fun,["Mapping",T.mode,:source],savedEnv]
 
 gatherParameterList vars == main(vars,nil,nil) where
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index a859c67a..c92e326e 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -95,7 +95,7 @@ changeVariableDefinitionToStore(form,vars) ==
     changeVariableDefinitionToStore(third form,vars')
     vars
   abstractionOperator? form.op =>
-    changeVariableDefinitionToStore(third form,[:second form,:vars])
+    changeVariableDefinitionToStore(form.absBody,[:form.absParms,:vars])
     vars
   for x in form repeat
     vars := changeVariableDefinitionToStore(x,vars)
@@ -180,8 +180,8 @@ simplifyVMForm x ==
   atomic? x => x
   x.op is 'CLOSEDFN => x
   x.op isnt [.,:.] =>
-    x is [op,vars,body] and abstractionOperator? op =>
-      third(x) := simplifyVMForm body
+    symbol? x.op and abstractionOperator? x.op =>
+      x.absBody := simplifyVMForm x.absBody
       x
     if x.op is 'IF then
       resetTo(x,optIF2COND x)
@@ -455,7 +455,7 @@ $VMsideEffectFreeOperators ==
     %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq %bitveclt
     %before? %equal %sptreq %ident? %property %tref
     %writeString %writeNewline %writeLine
-    %void %retract %pullback)
+    %void %retract %pullback %lambda %closure)
 
 ++ List of simple VM operators
 $simpleVMoperators == 
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index d826627c..18ada7f8 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -86,7 +86,7 @@ macro builtinConstructor? s ==
 --%  
 
 $AbstractionOperator ==
-  '(LAM ILAM SLAM XLAM SPADSLAM LAMBDA)
+  '(LAM ILAM SLAM XLAM SPADSLAM LAMBDA %lambda)
 
 ++ Return true if the symbol 's' is used in the form 'x'.  
 usedSymbol?(s,x) ==
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 17efec64..3b41d361 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -629,8 +629,10 @@ for x in [
     ['%lam,      :'LAMBDA],
     ['%leave,    :'RETURN],
     ['%otherwise,:'T],
+    ['%closure,  :'CONS],
     ['%funcall,  :'FUNCALL],
     ['%function, :'FUNCTION],
+    ['%lambda,   :'LAMBDA],
     ['%when,     :'COND],
 
     -- I/O stream functions
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 2fe210e9..29a36988 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -666,8 +666,7 @@ NRTputInHead(db,bod) ==
   bod is ['%when,:clauses] =>
     for cc in clauses repeat NRTputInTail(db,cc)
     bod
-  bod is ['QUOTE,:.] => bod
-  bod is ["CLOSEDFN",:.] => bod
+  bod.op in '(QUOTE CLOSEDFN) => bod
   NRTputInHead(db,first bod)
   NRTputInTail(db,rest bod)
   bod