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(a)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