aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-05-11 15:36:24 +0000
committerdos-reis <gdr@axiomatics.org>2010-05-11 15:36:24 +0000
commit348cdc0022cf9aaf0fc5491ed8d899a7284e07ec (patch)
treea7a62de0495cb107357b742f5b1d3a0c1a76e3e0 /src/interp
parent35e9d8ac6d43cad99aa07aa8ad7a7f0242ab3887 (diff)
downloadopen-axiom-348cdc0022cf9aaf0fc5491ed8d899a7284e07ec.tar.gz
Add support for interpreter-style anonymous function.
* interp/compiler.boot (compUnnamedMapping): New. (gatherParameterList): Likewise. (compLambda): Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot54
-rw-r--r--src/interp/define.boot1
-rw-r--r--src/interp/newaux.lisp2
3 files changed, 56 insertions, 1 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 4f8d46d3..f55cbd31 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2459,6 +2459,59 @@ compRep(["rep",x],m,e) ==
T.rest.first := getRepresentation e or return nil
coerce(T,m)
+--% Lambda expressions
+
+compUnnamedMapping(parms,source,target,body,env) ==
+ $killOptimizeIfTrue: local := true
+ savedEnv := env
+ for p in parms for s in source repeat
+ [.,.,env] := compMakeDeclaration(p,s,env)
+ env := put(p,'value,[genSomeVariable(),get(p,'mode,env),nil],env)
+ T := comp(body,target,env) or return nil
+ [.,fun] := optimizeFunctionDef [nil,["LAMBDA",parms,T.expr]]
+ fun := finishLambdaExpression(fun,env)
+ [fun,["Mapping",T.mode,:source],savedEnv]
+
+gatherParameterList vars == main(vars,nil,nil) where
+ main(vars,parms,source) ==
+ vars = nil => [nreverse parms,nreverse source]
+ atom vars or vars is [":",:.] => [[x] for x in check vars]
+ [v,s] := check first vars
+ main(rest vars,[v,:parms],[s,:source])
+ check var ==
+ atom var =>
+ not IDENTP var =>
+ stackAndThrow('"invalid parameter %1b in lambda expression",[var])
+ [checkVariableName var,nil]
+ var is [":",p,t] =>
+ not IDENTP p =>
+ stackAndThrow('"invalid parameter %1b in lambda expression",[p])
+ [checkVariableName p,t]
+ stackAndThrow('"invalid parameter for mapping",nil)
+
+compLambda(x is ["+->",vars,body],m,e) ==
+ -- 1. Gather parameters and their types.
+ if vars is ["%Comma",:vars'] then
+ vars := vars'
+ [parms,source] := gatherParameterList vars
+ -- 2. Compile the form
+ T :=
+ -- 2.1. No parameter is declared
+ and/[s = nil for s in source] =>
+ -- Guess from context
+ m is ["Mapping",dst,:src] =>
+ #src ~= #parms =>
+ stackAndThrow('"inappropriate function type for unnamed mapping",nil)
+ compUnnamedMapping(parms,src,dst,body,e) or return nil
+ -- Otherwise, assumes this is just purely syntactic code block.
+ [quoteForm ["+->",parms,body],$AnonymousFunction,e]
+ -- 2.2. If all parameters are declared, then compile as a mapping.
+ and/[s ~= nil for s in source] =>
+ compUnnamedMapping(parms,source,$EmptyMode,body,e) or return nil
+ -- 2.3. Well, give up for now.
+ stackAndThrow('"parameters in a lambda expression must be all declared or none declared",nil)
+ coerce(T,m)
+
--%
--% Entry point to the compiler
--%
@@ -2503,6 +2556,7 @@ for x in [["|", :"compSuchthat"],_
["@", :"compAtSign"],_
[":", :"compColon"],_
["::", :"compCoerce"],_
+ ["+->", :"compLambda"],_
["QUOTE", :"compQuote"],_
["add", :"compAdd"],_
["CAPSULE", :"compCapsule"],_
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 59a2bde4..58bc4863 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -181,6 +181,7 @@ $reservedNames == '(per rep _$)
checkVariableName var ==
MEMQ(var,$reservedNames) =>
stackAndThrow('"You cannot use reserved name %1b as variable",[var])
+ var
checkParameterNames parms ==
for p in parms repeat
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index b5d82ba4..ddf763b1 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -122,7 +122,7 @@
(/\\ 250 251) (\\/ 200 201)
(\.\. SEGMENT 401 699 (|PARSE-Seg|))
(=> 123 103)
- (+-> 122 121)
+ (+-> 998 121)
(== DEF 122 121)
(==> MDEF 122 121)
(\| 108 111) ;was 190 190