X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefmacro.lisp;h=d5bc4f2c26714a18bef5baffe9bcb966c7cde47b;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=ac2702f9868b7b22f09f2bf96faeb48a8ac12ab5;hpb=dc84ceb894fdbe315f82dd8336f3ba894435a669;p=sbcl.git diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index ac2702f..d5bc4f2 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -16,26 +16,32 @@ ;;; 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))) - ;; if we want to move over to list-style names + ,new-body)) + ;; If we want to move over to list-style names ;; [e.g. (DEFMACRO FOO), maybe to support some XREF-like ;; functionality] here might be a good place to start. - (debug-name (debug-namify "DEFMACRO ~S" name))) + (debug-name (sb!c::debug-namify "DEFMACRO " name))) `(eval-when (:compile-toplevel :load-toplevel :execute) (sb!c::%defmacro ',name #',def ',lambda-list ,doc ,debug-name))))))) @@ -86,14 +92,13 @@ lambda-list (%simple-fun-name (%closure-fun definition)) debug-name)) - ((#.sb!vm:simple-fun-header-widetag - #.sb!vm:closure-fun-header-widetag) + (#.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 (: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