aboutsummaryrefslogtreecommitdiff
path: root/src/interp/lisp-backend.boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/lisp-backend.boot')
-rw-r--r--src/interp/lisp-backend.boot30
1 files changed, 30 insertions, 0 deletions
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 79677e07..2b739af8 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -781,3 +781,33 @@ removeFluids args ==
$Vars := [v,:$Vars]
v
[removeFluids first args,:removeFluids rest args]
+
+COMPILE1 fun ==
+ $Vars: local := nil
+ $Decls: local := nil
+ [name,lambda] := fun
+ [type,args,:body] := lambda
+ if type is 'LAM then
+ lambda := f(name,lambda) where
+ f(n,x) ==
+ $lamName: local := makeSymbol strconc(n,'",LAM")
+ EVAL x
+ [type,args,:body] := lambda
+ if body is [['DECLARE,['SPECIAL,:xs]],:body'] then
+ $Decls := xs
+ body := body'
+ args := removeFluids args
+ newArgs :=
+ type is 'LAMBDA and simpleParameterList? args => args
+ args' := gensym()
+ body := [['DSETQ,args,args'],:body]
+ type is 'LAMBDA => ["&REST",args',"&AUX",:$Vars]
+ type is 'MLAMBDA => ["&WHOLE",args',"&REST",gensym(),"&AUX",:$Vars]
+ coreError '"bad function type"
+ if $Decls ~= nil then
+ body := [['DECLARE,['SPECIAL,:$Decls]],:body]
+ body :=
+ type is 'LAMBDA => ['DEFUN,name,newArgs,:body]
+ ['DEFMACRO,name,newArgs,:body]
+ compileLispDefinition(name,body)
+ body