[movitz-cvs] CVS update: movitz/special-operators.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	special-operators.lisp 
Log Message:
Improved compiler-macro-call so that it works on setf operators.

Date: Tue Jul 20 05:40:07 2004
Author: ffjeld

Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.30 movitz/special-operators.lisp:1.31
--- movitz/special-operators.lisp:1.30	Sat Jul 17 05:17:35 2004
+++ movitz/special-operators.lisp	Tue Jul 20 05:40:07 2004
@@ -8,7 +8,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 24 16:22:59 2000
 ;;;;                
-;;;; $Id: special-operators.lisp,v 1.30 2004/07/17 12:17:35 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.31 2004/07/20 12:40:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1057,11 +1057,14 @@
 (define-special-operator muerte::compiler-macro-call (&all all &form form &env env)
   (destructuring-bind (operator &rest arguments)
       (cdr form)
-    (assert (movitz-compiler-macro-function operator env) ()
-      "There is no compiler-macro ~S." operator)
-    (compiler-call #'compile-compiler-macro-form
-      :forward all
-      :form (cons operator arguments))))
+    (let ((name (if (not (setf-name operator))
+		    operator
+		  (movitz-env-setf-operator-name (setf-name operator)))))
+      (assert (movitz-compiler-macro-function name env) ()
+	"There is no compiler-macro ~S." name)
+      (compiler-call #'compile-compiler-macro-form
+	:forward all
+	:form (cons name arguments)))))
 
 (define-special-operator muerte::do-result-mode-case (&all all &result-mode result-mode &form form)
   (loop for (cases . then-forms) in (cddr form)