From 348cdc0022cf9aaf0fc5491ed8d899a7284e07ec Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 11 May 2010 15:36:24 +0000
Subject: 	Add support for interpreter-style anonymous function. 	*
 interp/compiler.boot (compUnnamedMapping): New. 	(gatherParameterList):
 Likewise. 	(compLambda): Likewise.

---
 src/ChangeLog            |  7 +++++++
 src/interp/compiler.boot | 54 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/interp/define.boot   |  1 +
 src/interp/newaux.lisp   |  2 +-
 4 files changed, 63 insertions(+), 1 deletion(-)

(limited to 'src')

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
-- 
cgit v1.2.3