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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))
 \f
 ;;; 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 (file)
--- 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 (file)
--- 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"