X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefmacro.lisp;h=92fbb48b1f08082410a79c04af52636cd42f2cf1;hb=7f1e94ae961a198e00daf281eb1dc858e5b2dcc7;hp=2bc701b4a00b42bbb4da8a99591ef91c1ae24342;hpb=989580141ab01d799365be12642e54b5d7c83136;p=sbcl.git diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index 2bc701b..92fbb48 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -16,77 +16,85 @@ ;;; 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) (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)) - (let ((whole (gensym "WHOLE-")) - (environment (gensym "ENV-"))) + (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)))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (sb!c::%defmacro ',name #',def ',lambda-list ,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 named-lambda #-sb-xc-host (defmacro ,name) + (,whole ,environment) + ,@local-decs + ,new-body)) + (debug-name (sb!c::debug-name 'macro-function name))) + `(progn + (eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c::%defmacro ',name #',def ',lambda-list ,doc ',debug-name + (sb!c:source-location))))))))) (macrolet - ((def (times set-args-p) + ((def (times set-p) `(eval-when (,@times) - (defun sb!c::%defmacro (name definition lambda-list doc) + (defun sb!c::%defmacro (name definition lambda-list doc debug-name + source-location) ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO ;; should deal with clearing old compiler information for ;; the functional value." - ,@(unless set-args-p - '((declare (ignore lambda-list)))) - (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)))) + ,@(unless set-p + '((declare (ignore lambda-list debug-name doc)))) + (let ((kind (info :function :kind name))) + ;; Check for special form before package locks. + (when (eq :special-form kind) + (error "The special operator ~S can't be redefined as a macro." + name)) + (with-single-package-locked-error (:symbol name "defining ~S as a macro") + (when (eq :function kind) + (style-warn + "~S is being redefined as a macro when it was ~ + previously ~(~A~) to be a function." + name (info :function :where-from name)) + (undefine-fun-name name)) + (clear-info :function :where-from name) + #-sb-xc-host + (when (fboundp 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. + (warn 'sb!kernel::redefinition-with-defmacro + :name name + :new-function definition + :new-location source-location)) + (setf (sb!xc:macro-function name) definition) + ,(when set-p + `(setf (%fun-doc definition) doc + (%fun-lambda-list definition) lambda-list + (%fun-name definition) debug-name)))) name)))) (progn (def (:load-toplevel :execute) #-sb-xc-host t #+sb-xc-host nil) - (def (:compile-toplevel) 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. After the