X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=797f149efb79b521a8805da268dc9e91a985c09c;hb=b36697e233ff1ef1cc3ad2e687581520656d4755;hp=5fb2c0f8b5b723bab8eb9e261e9978a6bc9bda33;hpb=602c9b1f15e2d96e4b79a3341a734b5eb8e02093;p=sbcl.git diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 5fb2c0f..797f149 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -798,27 +798,10 @@ (defun %failed-aver (expr-as-string) (bug "~@" expr-as-string)) -;;; We need a definition of BUG here for the host compiler to be able -;;; to deal with BUGs in sbcl. This should never affect an end-user, -;;; who will pick up the definition that signals a CONDITION of -;;; condition-class BUG; however, this is not defined on the host -;;; lisp, but for the target. SBCL developers sometimes trigger BUGs -;;; in their efforts, and it is useful to get the details of the BUG -;;; rather than an undefined function error. - CSR, 2002-04-12 -#+sb-xc-host (defun bug (format-control &rest format-arguments) - (error 'simple-error - :format-control "~@< ~? ~:@_~?~:>" - :format-arguments `(,format-control - ,format-arguments - "~@.~:@>" - ()))) + (error 'bug + :format-control format-control + :format-arguments format-arguments)) (defmacro enforce-type (value type) (once-only ((value value)) @@ -1174,3 +1157,17 @@ which can be found at .~:@>" (*read-suppress* *read-suppress*) (*readtable* *readtable*)) (funcall function))) + +;;; Bind a few "potentially dangerous" printer control variables to +;;; safe values, respecting current values if possible. +(defmacro with-sane-io-syntax (&body forms) + `(call-with-sane-io-syntax (lambda () ,@forms))) + +(defun call-with-sane-io-syntax (function) + (declare (type function function)) + (macrolet ((true (sym) + `(and (boundp ',sym) ,sym))) + (let ((*print-readably* nil) + (*print-level* (or (true *print-level*) 6)) + (*print-length* (or (true *print-length*) 12))) + (funcall function))))