X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmacros.lisp;h=61a6d4473277788120a46a78eb2c7ddeb270e81b;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=559889eb78b974863c266a780097b92effa42286;hpb=b5703d98da9ebfd688c87e14862ab4e26dc94d14;p=sbcl.git diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 559889e..61a6d44 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -203,6 +203,7 @@ the usual naming convention (names like *FOO*) for special variables" ,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 +414,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) @@ -456,10 +457,19 @@ the usual naming convention (names like *FOO*) for special variables" `(sb!xc:proclaim ',x)) 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))))