aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog7
-rw-r--r--src/interp/compiler.boot54
-rw-r--r--src/interp/define.boot1
-rw-r--r--src/interp/newaux.lisp2
4 files changed, 63 insertions, 1 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d62c3ed0..91b45cfc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2010-05-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ Add support for interpreter-style anonymous function.
+ * interp/compiler.boot (compUnnamedMapping): New.
+ (gatherParameterList): Likewise.
+ (compLambda): Likewise.
+
2010-05-10 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/compiler.boot (freeVarUsage): New. Split out of
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