diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/lisp-backend.boot | 30 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 37 |
2 files changed, 32 insertions, 35 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 diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index a4d5e01f..4c35ef41 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -57,7 +57,7 @@ (defvar *fileactq-apply* nil "function to apply in fileactq") -(defvar *lam-name* nil "name to be used by lam macro if non-nil") +(defvar |$lamName| nil "name to be used by lam macro if non-nil") (defvar macerrorcount 0 "Put some documentation in here someday") @@ -293,7 +293,7 @@ (CONTROL (QUOTESOF (first BODY))) (BODY (cdr BODY)) (ARGS (GENSYM)) - (INNER-FUNC (or *lam-name* (gentemp)))) + (INNER-FUNC (or |$lamName| (gentemp)))) (COMP370 (LIST INNER-FUNC `(LAMBDA ,BV . ,BODY))) `(MLAMBDA ,ARGS (CONS (QUOTE ,INNER-FUNC) @@ -343,39 +343,6 @@ (declare (ignore sd)) (macroexpand `(,arg ,item))) -; 8.1 Definition and Transformation Operations - -(defun COMPILE1 (fn) - (let* (nargs - (fname (car fn)) - (lamda (cadr fn)) - (ltype (car lamda)) - |$Vars| |$Decls| args - (body (cddr lamda))) - (declare (special |$Vars| |$Decls|)) - (if (eq ltype 'LAM) - (let ((*lam-name* (intern (concat fname "\,LAM")))) - (setq lamda (eval lamda) ltype (car lamda) body (cddr lamda)))) - (let ((dectest (car body))) - (if (and (eqcar dectest 'declare) (eqcar (cadr dectest) 'special)) - (setq |$Decls| (cdr (cadr dectest)) body (cdr body)))) - (setq args (|removeFluids| (cadr lamda))) - (cond ((and (eq ltype 'lambda) (|simpleParameterList?| args)) - (setq nargs args)) - (t (setq nargs (gensym)) - (setq body `((dsetq ,args ,nargs) ,@body)) - (cond ((eq ltype 'lambda) (setq nargs `(&rest ,nargs &aux ,@ |$Vars|))) - ((eq ltype 'mlambda) - (setq nargs `(&whole ,nargs &rest ,(gensym) &aux ,@ |$Vars|))) - (t (error "bad function type"))))) - (cond (|$Decls| (setq body (cons `(declare (special ,@ |$Decls|)) body)))) - (setq body - (cond ((eq ltype 'lambda) `(defun ,fname ,nargs . ,body)) - ((eq ltype 'mlambda) `(defmacro ,fname ,nargs . ,body)))) - (|compileLispDefinition| fname body) - - body)) - ; 9.4 Vectors and Bpis (defun IVECP (x) (and (vectorp x) (subtypep (array-element-type x) 'integer))) |