X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefmacro.lisp;h=adce1a782e5b39e2503b3ea244675519080b4eb9;hb=c6f456356fb8899efa02b2a74a23e653fef3e57d;hp=adb9d35df179c82bbf6e2d51c81b60b422f5329a;hpb=9d907d32cec5750eac109d7d06fc5981911866f7;p=sbcl.git

diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp
index adb9d35..adce1a7 100644
--- a/src/code/defmacro.lisp
+++ b/src/code/defmacro.lisp
@@ -12,12 +12,17 @@
 (in-package "SB!IMPL")
 
 ;;; the guts of the DEFMACRO macro, pulled out into a separate
-;;; function in order to make it easier to express the common 
+;;; function in order to make it easier to express the common
 ;;; bootstrap idiom
 ;;;   CL:DEFMACRO SB!XC:DEFMACRO
 ;;;   SB!XC:DEFMACRO CL:DEFMACRO
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun %expander-for-defmacro (name lambda-list body)
+    (unless (symbolp name)
+      (error "The macro name ~S is not a symbol." name))
+    (when (special-operator-p name)
+      (error "The special operator ~S can't be redefined as a macro."
+             name))
     (let ((whole (gensym "WHOLE-"))
 	  (environment (gensym "ENV-")))
       (multiple-value-bind (new-body local-decs doc)
@@ -27,42 +32,65 @@
 		      ,@local-decs
 		      (block ,name
 			,new-body))))
-	  `(sb!c::%defmacro ',name #',def ',lambda-list ,doc))))))
+	  `(eval-when (:compile-toplevel :load-toplevel :execute)
+             (sb!c::%defmacro ',name #',def ',lambda-list ,doc)))))))
 
-;;; Ordinarily this definition of SB!C:%DEFMACRO as an ordinary
-;;; function is not used: the parallel (but different) definition as
-;;; an IR1 transform takes precedence. However, this definition is
-;;; still useful in the target interpreter, and in the
-;;; cross-compilation host.
-(defun sb!c::%defmacro (name definition lambda-list doc)
-  (declare (ignore lambda-list))
-  (sb!c::%%defmacro name definition doc))
-
-;;; (called by SB!C::%DEFMACRO)
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun sb!c::%%defmacro (name definition doc)
-    ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO should
-    ;; deal with clearing old compiler information for the functional
-    ;; value."
-    (clear-info :function :where-from name)
-    ;; FIXME: It would be nice to warn about DEFMACRO of an
-    ;; already-defined macro, but that's slightly hard to do because
-    ;; in common usage DEFMACRO is defined at compile time and then
-    ;; redefined at load time. We'd need to make a distinction between
-    ;; the defined-at-compile-time state and the defined-at-load-time
-    ;; state to make this work. (Trying to warn about duplicate
-    ;; DEFTYPEs runs into the same problem.)
-    #+nil (when (sb!xc:macro-function name)
-	    (style-warn "redefining ~S in DEFMACRO" name))
-    (setf (sb!xc:macro-function name) definition
-	  (fdocumentation name 'function) doc)
-    name))
+(macrolet
+    ((def (times set-args-p)
+       `(eval-when (,@times)
+          (defun sb!c::%defmacro (name definition lambda-list doc)
+            ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO
+            ;; should deal with clearing old compiler information for
+            ;; the functional value."
+            (ecase (info :function :kind name)
+              ((nil))
+              (:function
+               ;; (remhash name *free-funs*)
+               (undefine-fun-name name)
+               (style-warn
+                "~S is being redefined as a macro when it was ~
+                 previously ~(~A~) to be a function."
+                name
+                (info :function :where-from name)))
+              (:macro)
+              (:special-form
+               (error "The special form ~S can't be redefined as a macro."
+                      name)))
+            (clear-info :function :where-from name)
+            ;; FIXME: It would be nice to warn about DEFMACRO of an
+            ;; already-defined macro, but that's slightly hard to do
+            ;; because in common usage DEFMACRO is defined at compile
+            ;; time and then redefined at load time. We'd need to make a
+            ;; distinction between the defined-at-compile-time state and
+            ;; the defined-at-load-time state to make this work. (Trying
+            ;; to warn about duplicate DEFTYPEs runs into the same
+            ;; problem.)
+            #+nil (when (sb!xc:macro-function name)
+                    ;; Someday we could check for macro arguments
+                    ;; being incompatibly redefined. Doing this right
+                    ;; will involve finding the old macro lambda-list
+                    ;; and comparing it with the new one.
+                    (style-warn "redefining ~S in DEFMACRO" name))
+            (setf (sb!xc:macro-function name) definition
+                  (fdocumentation name 'function) doc)
+            ,(when set-args-p
+                   `(case (widetag-of definition)
+                      (#.sb!vm:closure-header-widetag
+                       (setf (%simple-fun-arglist (%closure-fun definition))
+                             lambda-list))
+                      ((#.sb-vm:simple-fun-header-widetag
+                        #.sb-vm:closure-fun-header-widetag)
+                       (setf (%simple-fun-arglist definition) lambda-list))))
+            name))))
+  (progn
+    (def (:load-toplevel :execute) #-sb-xc-host t #+sb-xc-host nil)
+    (def (:compile-toplevel) nil)))
 
 ;;; Parse the definition and make an expander function. The actual
-;;; definition is done by %DEFMACRO which we expand into, and which is
-;;; handled magically by an IR1 transform. After the compiler has
-;;; gotten the information it wants out of macro definition, it
-;;; compiles a call to %%DEFMACRO which happens at load time.
+;;; definition is done by %DEFMACRO which we expand into. After the
+;;; compiler has gotten the information it wants out of macro
+;;; definition, it compiles a call to %DEFMACRO which happens at load
+;;; time.
 (defmacro sb!xc:defmacro (name lambda-list &rest body)
   (%expander-for-defmacro name lambda-list body))