[Sbcl-commits] master: optimize pretty-printing strings and bit-vectors

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  70a16828572748140239e3c74f34a2967e1e5131 (commit)
      from  9ae34bc57917880d3fe6c2a1b5e322698b81ce96 (commit)

- Log -----------------------------------------------------------------
commit 70a16828572748140239e3c74f34a2967e1e5131
Author: Nikodemus Siivola <nik...@sb...>
Date:   Tue Aug 23 20:01:37 2011 +0300

    optimize pretty-printing strings and bit-vectors
    
      Since strings and bit-vectors use the ugly output in any case,
      exlude them from using PPRINT-ARRAY -- so we don't need to cons up a
      pretty stream when printing strings while *PRINT-PRETTY* is true.
---
 NEWS                 |    2 ++
 src/code/pprint.lisp |    6 ++----
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 52196bb..8eca65d 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes relative to sbcl-1.0.50:
   * enhancement: ASDF has been updated to version 2.017.
   * optimization: SLEEP no longer conses.
+  * optimization: *PRINT-PRETTY* no longer slows down printing of strings
+    or bit-vectors when using the standard pretty-print dispatch table.
   * bug fix: non-function FTYPE declarations no longer cause a compiler-error.
     (lp#738464)
   * bug fix: compiler-errors causes by MEMBER types in conjunction with with
diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index c8e2301..07f8725 100644
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1003,9 +1003,7 @@ line break."
 ;;;; standard pretty-printing routines
 
 (defun pprint-array (stream array)
-  (cond ((or (and (null *print-array*) (null *print-readably*))
-             (stringp array)
-             (bit-vector-p array))
+  (cond ((and (null *print-array*) (null *print-readably*))
          (output-ugly-object array stream))
         ((and *print-readably*
               (not (array-readably-printable-p array)))
@@ -1488,7 +1486,7 @@ line break."
   (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*)
         (*building-initial-table* t))
     (/show0 "doing SET-PPRINT-DISPATCH for regular types")
-    (set-pprint-dispatch 'array #'pprint-array)
+    (set-pprint-dispatch '(and array (not (or string bit-vector))) #'pprint-array)
     (set-pprint-dispatch '(cons (and symbol (satisfies mboundp)))
                          #'pprint-macro-call -1)
     (set-pprint-dispatch '(cons (and symbol (satisfies fboundp)))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL