X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefmacro.lisp;h=d45a27c0603bfc80e4e99eb73919240013d93978;hb=6fa968aaa8051da23cc3153a1c0e67addbea85f6;hp=8a0f43ea17a2fdfcbfebf44103e082ce2d8f15aa;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index 8a0f43e..d45a27c 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -11,60 +11,107 @@ (in-package "SB!IMPL") -(file-comment - "$Header$") - ;;; 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) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun %expander-for-defmacro (name lambda-list body) - (let ((whole (gensym "WHOLE-")) - (environment (gensym "ENV-"))) + (unless (symbolp name) + (error "The macro name ~S is not a symbol." name)) + ;; When we are building the cross-compiler, we could be in a host + ;; lisp which implements CL macros (e.g. CL:AND) as special + ;; operators (while still providing a macroexpansion for + ;; compliance): therefore can't use the host's SPECIAL-OPERATOR-P + ;; as a discriminator, but that's OK because the set of forms the + ;; cross-compiler compiles is tightly controlled. -- CSR, + ;; 2003-04-20 + #-sb-xc-host + (when (special-operator-p name) + (error "The special operator ~S can't be redefined as a macro." + name)) + (with-unique-names (whole environment) (multiple-value-bind (new-body local-decs doc) - (parse-defmacro lambda-list whole body name 'defmacro - :environment environment) - (let ((def `(lambda (,whole ,environment) - ,@local-decs - (block ,name - ,new-body)))) - `(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) - (try-to-rename-interpreted-function-as-macro definition name lambda-list) - (sb!c::%%defmacro name definition doc)) + (parse-defmacro lambda-list whole body name 'defmacro + :environment environment) + (let ((def `(#+sb-xc-host lambda + ;; Use a named-lambda rather than a lambda so that + ;; proper xref information can be stored. Use a + ;; list-based name, since otherwise the compiler + ;; will momentarily assume that it names a normal + ;; function, and report spurious warnings about + ;; redefinition a macro as a function, and then + ;; vice versa. + #-sb-xc-host #-sb-xc-host named-lambda (defmacro ,name) + (,whole ,environment) + ,@local-decs + ,new-body)) + (debug-name (sb!c::debug-name 'macro-function name))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c::%defmacro ',name #',def ',lambda-list + ,doc ',debug-name))))))) -;;; (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-p) + `(eval-when (,@times) + (defun sb!c::%defmacro (name definition lambda-list doc debug-name) + ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO + ;; should deal with clearing old compiler information for + ;; the functional value." + ,@(unless set-p + '((declare (ignore lambda-list debug-name)))) + (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-p + `(case (widetag-of definition) + (#.sb!vm:closure-header-widetag + (setf (%simple-fun-arglist (%closure-fun definition)) + lambda-list + (%simple-fun-name (%closure-fun definition)) + debug-name)) + (#.sb!vm:simple-fun-header-widetag + (setf (%simple-fun-arglist definition) lambda-list + (%simple-fun-name definition) debug-name)))) + name)))) + (progn + (def (:load-toplevel :execute) #-sb-xc-host t #+sb-xc-host nil) + (def (#-sb-xc :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)) @@ -80,21 +127,23 @@ ;;; DEFMACRO-MUNDANELY is like SB!XC:DEFMACRO, except that it doesn't ;;; have any EVAL-WHEN or IR1 magic associated with it, so it only ;;; takes effect in :LOAD-TOPLEVEL or :EXECUTE situations. -;;; -;;; KLUDGE: Currently this is only used for various special -;;; circumstances in bootstrapping, but it seems to me that it might -;;; be a good basis for reimplementation of DEFMACRO in terms of -;;; EVAL-WHEN, which might be easier to understand than the current -;;; approach based on IR1 magic. -- WHN 19990811 (def!macro defmacro-mundanely (name lambda-list &body body) - `(setf (sb!xc:macro-function ',name) - ,(let ((whole (gensym "WHOLE-")) - (environment (gensym "ENVIRONMENT-"))) - (multiple-value-bind (new-body local-decs doc) - (parse-defmacro lambda-list whole body name 'defmacro - :environment environment) - (declare (ignore doc)) - `(lambda (,whole ,environment) - ,@local-decs - (block ,name - ,new-body)))))) + + ;; old way: + ;;(let ((whole (gensym "WHOLE-")) + ;; (environment (gensym "ENVIRONMENT-"))) + ;; (multiple-value-bind (new-body local-decs doc) + ;; (parse-defmacro lambda-list whole body name 'defmacro + ;; :environment environment) + ;; `(progn + ;; (setf (sb!xc:macro-function ',name) + ;; (lambda (,whole ,environment) + ;; ,@local-decs + ;; (block ,name + ;; ,new-body))) + ;; (setf (fdocumentation ',name 'macro) + ;; ,doc) + ;; ',name))) + + `(let () + (sb!xc:defmacro ,name ,lambda-list ,@body)))