X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmacros.lisp;h=fe11e84033953ede66d8fe362d70592cacee9a08;hb=b6aa15328871678a3475e82c150b251dffb49ba1;hp=559889eb78b974863c266a780097b92effa42286;hpb=b5703d98da9ebfd688c87e14862ab4e26dc94d14;p=sbcl.git diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 559889e..fe11e84 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -91,7 +91,7 @@ (defun sb!c::%defconstant (name value doc) (unless (symbolp name) (error "The constant name is not a symbol: ~S" name)) - (about-to-modify name) + (about-to-modify-symbol-value name) (when (looks-like-name-of-special-var-p name) (style-warn "defining ~S as a constant, even though the name follows~@ the usual naming convention (names like *FOO*) for special variables" @@ -128,7 +128,6 @@ the usual naming convention (names like *FOO*) for special variables" ;; will be cross-compiled correctly. #-sb-xc-host (setf (symbol-value name) value) #+sb-xc-host (progn - (/show (symbol-package name)) ;; Redefining our cross-compilation host's CL symbols ;; would be poor form. ;; @@ -177,8 +176,8 @@ the usual naming convention (names like *FOO*) for special variables" ;; 2001-03-24 (eval `(defconstant ,name ',value)))) - (setf (info :variable :kind name) :constant) - (setf (info :variable :constant-value name) value) + (setf (info :variable :kind name) :constant + (info :variable :constant-value name) value) name) ;;;; DEFINE-COMPILER-MACRO @@ -199,10 +198,11 @@ the usual naming convention (names like *FOO*) for special variables" :environment environment) (let ((def `(lambda (,whole ,environment) ,@local-decs - (block ,(function-name-block-name name) + (block ,(fun-name-block-name name) ,body)))) `(sb!c::%define-compiler-macro ',name #',def ',lambda-list ,doc))))) (defun sb!c::%define-compiler-macro (name definition lambda-list doc) + (declare (ignore lambda-list)) (sb!c::%%define-compiler-macro name definition doc)) (defun sb!c::%%define-compiler-macro (name definition doc) (setf (sb!xc:compiler-macro-function name) definition) @@ -413,7 +413,7 @@ the usual naming convention (names like *FOO*) for special variables" (defmacro-mundanely nth-value (n form) #!+sb-doc - "Evaluates FORM and returns the Nth value (zero based). This involves no + "Evaluate FORM and return the Nth value (zero based). This involves no consing when N is a trivial constant integer." (if (integerp n) (let ((dummy-list nil) @@ -437,29 +437,23 @@ the usual naming convention (names like *FOO*) for special variables" #!+sb-doc "DECLAIM Declaration* Do a declaration or declarations for the global environment." - #-sb-xc-host `(eval-when (:compile-toplevel :load-toplevel :execute) - ,@(mapcar #'(lambda (x) - `(sb!xc:proclaim ',x)) - specs)) - ;; KLUDGE: The definition above doesn't work in the cross-compiler, - ;; because UNCROSS translates SB!XC:PROCLAIM into CL:PROCLAIM before - ;; the form gets executed. Instead, we have to explicitly do the - ;; proclamation at macroexpansion time. -- WHN ca. 19990810 - ;; - ;; FIXME: Maybe we don't need this special treatment any more now - ;; that we're using DEFMACRO-MUNDANELY instead of DEFMACRO? - #+sb-xc-host (progn - (mapcar #'sb!xc:proclaim specs) - `(progn - ,@(mapcar #'(lambda (x) - `(sb!xc:proclaim ',x)) - specs)))) + ,@(mapcar (lambda (spec) `(sb!xc:proclaim ',spec)) + specs))) -(defmacro-mundanely print-unreadable-object ((object stream - &key type identity) +(defmacro-mundanely print-unreadable-object ((object stream &key type identity) &body body) + "Output OBJECT to STREAM with \"#<\" prefix, \">\" suffix, optionally + with object-type prefix and object-identity suffix, and executing the + code in BODY to provide possible further output." `(%print-unreadable-object ,object ,stream ,type ,identity ,(if body `#'(lambda () ,@body) nil))) + +(defmacro-mundanely ignore-errors (&rest forms) + #!+sb-doc + "Execute FORMS handling ERROR conditions, returning the result of the last + form, or (VALUES NIL the-ERROR-that-was-caught) if an ERROR was handled." + `(handler-case (progn ,@forms) + (error (condition) (values nil condition))))