diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/compiler.boot | 54 | ||||
| -rw-r--r-- | src/interp/define.boot | 1 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 2 |
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 |