Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15680

Modified Files: special-operators.lisp Log Message: Use newly created movitz-macro-expander-make-function.

Date: Thu Jan 15 11:40:40 2004 Author: ffjeld

Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.1.1.1 movitz/special-operators.lisp:1.2 --- movitz/special-operators.lisp:1.1.1.1 Tue Jan 13 06:04:59 2004 +++ movitz/special-operators.lisp Thu Jan 15 11:40:40 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.1.1.1 2004/01/13 11:04:59 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.2 2004/01/15 16:40:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -344,19 +344,22 @@ (parse-docstring-declarations-and-body cl-macro-body 'cl:declare) (declare (ignore doc-string)) (setf (movitz-env-get access-fn :setf-expander nil) - (let ((form-formal (or wholevar (gensym))) - (env-formal (or envvar (gensym)))) - (if (null cl-lambda-list) - `(lambda (,form-formal ,env-formal) - (declare ,@declarations) - (translate-program (block ,access-fn ,@cl-body) :cl :muerte.cl)) - `(lambda (,form-formal ,env-formal) - (declare ,@declarations) - (destructuring-bind ,cl-lambda-list - (translate-program (rest ,form-formal) :muerte.cl :cl) - (values-list - (translate-program (multiple-value-list (block ,access-fn ,@cl-body)) - :cl :muerte.cl))))))))))) + (let* ((form-formal (or wholevar (gensym))) + (env-formal (or envvar (gensym))) + (expander (if (null cl-lambda-list) + `(lambda (,form-formal ,env-formal) + (declare (ignorable ,form-formal ,env-formal) + ,@declarations) + (translate-program (block ,access-fn ,@cl-body) :cl :muerte.cl)) + `(lambda (,form-formal ,env-formal) + (declare (ignorable ,form-formal ,env-formal) + ,@declarations) + (destructuring-bind ,cl-lambda-list + (translate-program (rest ,form-formal) :muerte.cl :cl) + (values-list + (translate-program (multiple-value-list (block ,access-fn ,@cl-body)) + :cl :muerte.cl))))))) + (movitz-macro-expander-make-function expander :type :setf))))))) (compiler-values ()))

(define-special-operator muerte::defmacro-compile-time (&form form) @@ -396,9 +399,9 @@ (declare ,@declarations) (translate-program (block ,name ,@cl-body) :cl :muerte.cl))))))) (setf (movitz-macro-function name) - (if *compiler-compile-macro-expanders* - (compile expander-name expander-lambda) - expander-lambda))))))) + (movitz-macro-expander-make-function expander-lambda + :name expander-name + :type :defmacro))))))) (compiler-values ()))

(define-special-operator muerte::define-compiler-macro-compile-time (&form form) @@ -438,9 +441,9 @@ ,form-formal ; declined (translate-program ,expansion-var :cl :muerte.cl))))))) (setf (movitz-compiler-macro-function operator-name nil) - (if *compiler-compile-macro-expanders* - (compile (make-symbol (format nil "~A-compiler-macro" name)) expander) - expander)))))))) + (movitz-macro-expander-make-function expander + :name (gensym (format nil "~A-compiler-macro-" name)) + :type :compiler-macro)))))))) (compiler-values ()))

(define-special-operator muerte::with-inline-assembly-case