From 63df59e7ab921baff00e47e915b4df1c441b2381 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 29 Nov 2011 19:19:54 +0000
Subject: * 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.
---
src/ChangeLog | 9 +++++++++
src/boot/strap/tokens.clisp | 11 ++++++-----
src/boot/strap/translator.clisp | 2 +-
src/boot/tokens.boot | 3 +++
src/interp/compiler.boot | 5 ++---
src/interp/g-opt.boot | 8 ++++----
src/interp/g-util.boot | 2 +-
src/interp/lisp-backend.boot | 2 ++
src/interp/nruncomp.boot | 3 +--
9 files changed, 29 insertions(+), 16 deletions(-)
(limited to 'src')
diff --git a/src/ChangeLog b/src/ChangeLog
index ae9597dd..f033da2f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+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.
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
--
cgit v1.2.3