projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix (documentation #'function t)
[sbcl.git]
/
src
/
code
/
pprint.lisp
diff --git
a/src/code/pprint.lisp
b/src/code/pprint.lisp
index
f938d30
..
f542878
100644
(file)
--- a/
src/code/pprint.lisp
+++ b/
src/code/pprint.lisp
@@
-1003,14
+1003,15
@@
line break."
;;;; standard pretty-printing routines
(defun pprint-array (stream array)
;;;; 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)))
(output-ugly-object array stream))
((and *print-readably*
(not (array-readably-printable-p array)))
- (let ((*print-readably* nil))
- (error 'print-not-readable :object array)))
+ (if *read-eval*
+ (if (vectorp array)
+ (sb!impl::output-unreadable-vector-readably array stream)
+ (sb!impl::output-unreadable-array-readably array stream))
+ (print-not-readable-error array stream)))
((vectorp array)
(pprint-vector stream array))
(t
((vectorp array)
(pprint-vector stream array))
(t
@@
-1139,7
+1140,10
@@
line break."
(declare (ignore noise))
(if (and (consp list)
(consp (cdr list))
(declare (ignore noise))
(if (and (consp list)
(consp (cdr list))
- (cddr list))
+ (cddr list)
+ ;; Filter out (FLET FOO :IN BAR) names.
+ (and (consp (cddr list))
+ (not (eq :in (third list)))))
(funcall (formatter
"~:<~^~W~^ ~@_~:<~@{~:<~^~W~^~3I ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~:@_~@{~W~^ ~_~}~:>~^ ~_~}~:>~1I~@:_~@{~W~^ ~_~}~:>")
stream
(funcall (formatter
"~:<~^~W~^ ~@_~:<~@{~:<~^~W~^~3I ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~:@_~@{~W~^ ~_~}~:>~^ ~_~}~:>~1I~@:_~@{~W~^ ~_~}~:>")
stream
@@
-1263,7
+1267,9
@@
line break."
(defun pprint-defmethod (stream list &rest noise)
(declare (ignore noise))
(defun pprint-defmethod (stream list &rest noise)
(declare (ignore noise))
- (if (consp (third list))
+ (if (and (consp (cdr list))
+ (consp (cddr list))
+ (consp (third list)))
(pprint-defun stream list)
(funcall (formatter
"~:<~^~W~^ ~@_~:I~W~^ ~W~^ ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~@{ ~_~W~}~:>")
(pprint-defun stream list)
(funcall (formatter
"~:<~^~W~^ ~@_~:I~W~^ ~W~^ ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~@{ ~_~W~}~:>")
@@
-1370,7
+1376,7
@@
line break."
(declare (ignore noise))
(destructuring-bind (loop-symbol . clauses) list
(declare (ignore loop-symbol))
(declare (ignore noise))
(destructuring-bind (loop-symbol . clauses) list
(declare (ignore loop-symbol))
- (if (or (null clauses) (consp (car clauses)))
+ (if (or (atom clauses) (consp (car clauses)))
(pprint-spread-fun-call stream list)
(pprint-extended-loop stream list))))
(pprint-spread-fun-call stream list)
(pprint-extended-loop stream list))))
@@
-1480,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")
(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)))
(set-pprint-dispatch '(cons (and symbol (satisfies mboundp)))
#'pprint-macro-call -1)
(set-pprint-dispatch '(cons (and symbol (satisfies fboundp)))
@@
-1591,5
+1597,6
@@
line break."
(setf *standard-pprint-dispatch-table*
(copy-pprint-dispatch *initial-pprint-dispatch-table*))
(setf *standard-pprint-dispatch-table*
(copy-pprint-dispatch *initial-pprint-dispatch-table*))
- (setf *print-pprint-dispatch* *initial-pprint-dispatch-table*)
+ (setf *print-pprint-dispatch*
+ (copy-pprint-dispatch *initial-pprint-dispatch-table*))
(setf *print-pretty* t))
(setf *print-pretty* t))