From: Juho Snellman Date: Tue, 7 Jun 2005 10:49:56 +0000 (+0000) Subject: 0.9.1.28: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5bc505c743d3f89de71b319479c2bbb71b0256ae;p=sbcl.git 0.9.1.28: MORE PRETTY: * "Oops". Change the definition of the recenctly introduced WITH-CIRCULARITY-DETECTION macro to only include BODY once. Otherwise code with nested PPRINT-LOGICAL-BLOCKs would expand into ridiculous amounts of code. (The macroexpansion of PPRINT-LAMBDA-LIST was >18000 lines). * Return NIL from PPRINT-POP when OBJECT is NIL. * Check for malformed LABELS/FLET/MACROLET forms in PPRINT-FLET. Other stuff: * Declare a more specific type for *CHARACTER-DATABASE* to avoid going through HAIRY-DATA-VECTOR-REF. (thanks to Christophe for noticing this) * Add missing type predicate for VECTOR-NIL-P. (MISC.596) --- diff --git a/NEWS b/NEWS index e1f0fa4..d1b9a94 100644 --- a/NEWS +++ b/NEWS @@ -32,6 +32,9 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1: ** allow using the (declare (typespec var*)) abbreviation for (declare (type typespec var*)) with all type specifiers ** circularity detection works properly with PPRINT-LOGICAL-BLOCK + ** always return NIL from PPRINT-POP when OBJECT is NIL + ** don't signal errors when pretty-printing malformed LABELS, + FLET or MACROLET forms changes in sbcl-0.9.1 relative to sbcl-0.9.0: * fixed cross-compiler leakages that prevented building a 32-bit diff --git a/src/code/early-pprint.lisp b/src/code/early-pprint.lisp index 296135a..59392d2 100644 --- a/src/code/early-pprint.lisp +++ b/src/code/early-pprint.lisp @@ -119,8 +119,9 @@ (output-object ,object-var ,stream-var) (return-from ,block-name nil)))) (incf ,count-name) - ,@(when object - `((pop ,object-var))))) + ,@(if object + `((pop ,object-var)) + `(nil)))) (declare (ignorable (function ,pp-pop-name))) (locally (declare (disable-package-locks diff --git a/src/code/early-print.lisp b/src/code/early-print.lisp index bb0fcd1..8b770f5 100644 --- a/src/code/early-print.lisp +++ b/src/code/early-print.lisp @@ -189,22 +189,25 @@ t)))))) (defmacro with-circularity-detection ((object stream) &body body) - (let ((marker (gensym "WITH-CIRCULARITY-DETECTION-"))) - `(cond ((not *print-circle*) - ,@body) - (*circularity-hash-table* - (let ((,marker (check-for-circularity ,object t :logical-block))) - (if ,marker - (when (handle-circularity ,marker ,stream) - ,@body) - ,@body))) - (t - (let ((*circularity-hash-table* (make-hash-table :test 'eq))) - (output-object ,object (make-broadcast-stream)) - (let ((*circularity-counter* 0)) - (let ((,marker (check-for-circularity ,object t - :logical-block))) - (when ,marker - (handle-circularity ,marker ,stream))) - ,@body)))))) + (let ((marker (gensym "WITH-CIRCULARITY-DETECTION-")) + (body-name (gensym "WITH-CIRCULARITY-DETECTION-BODY-"))) + `(labels ((,body-name () + ,@body)) + (cond ((not *print-circle*) + (,body-name)) + (*circularity-hash-table* + (let ((,marker (check-for-circularity ,object t :logical-block))) + (if ,marker + (when (handle-circularity ,marker ,stream) + (,body-name)) + (,body-name)))) + (t + (let ((*circularity-hash-table* (make-hash-table :test 'eq))) + (output-object ,object (make-broadcast-stream)) + (let ((*circularity-counter* 0)) + (let ((,marker (check-for-circularity ,object t + :logical-block))) + (when ,marker + (handle-circularity ,marker ,stream))) + (,body-name)))))))) diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index bc26510..af4eaa2 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -1099,7 +1099,9 @@ (defun pprint-flet (stream list &rest noise) (declare (ignore noise)) - (if (cddr list) + (if (and (consp list) + (consp (cdr list)) + (cddr list)) (funcall (formatter "~:<~^~W~^ ~@_~:<~@{~:<~^~W~^~3I ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~:@_~@{~W~^ ~_~}~:>~^ ~_~}~:>~1I~@:_~@{~W~^ ~_~}~:>") stream diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 1ccc065..ada4bed 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -110,7 +110,8 @@ #!+long-float (def-type-predicate-wrapper simple-array-long-float-p) (def-type-predicate-wrapper simple-array-complex-single-float-p) (def-type-predicate-wrapper simple-array-complex-double-float-p) - #!+long-float (def-type-predicate-wrapper simple-array-complex-long-float-p)) + #!+long-float (def-type-predicate-wrapper simple-array-complex-long-float-p) + (def-type-predicate-wrapper vector-nil-p)) ;;; Return the specifier for the type of object. This is not simply ;;; (TYPE-SPECIFIER (CTYPE-OF OBJECT)) because CTYPE-OF has different diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp index 2efd4c7..a846dad 100644 --- a/src/code/target-char.lisp +++ b/src/code/target-char.lisp @@ -33,7 +33,7 @@ `(integer 0 (,char-code-limit))) (defvar *character-database*) -(declaim (type (vector (unsigned-byte 8)) *character-database*)) +(declaim (type (simple-array (unsigned-byte 8) (*)) *character-database*)) (macrolet ((frob () (with-open-file (stream (merge-pathnames diff --git a/version.lisp-expr b/version.lisp-expr index eb876b4..9c0ad36 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.1.27" +"0.9.1.28"