X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefmacro.lisp;h=d5bc4f2c26714a18bef5baffe9bcb966c7cde47b;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=c80dcba8a095638965322cdc6742c8ada99e01c2;hpb=670010e3f3dcd62efaf23f61abdc73950edb88c6;p=sbcl.git diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index c80dcba..d5bc4f2 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -16,10 +16,18 @@ ;;; 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)) @@ -29,12 +37,11 @@ :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))))))) @@ -85,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