X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fprint-object.lisp;h=50153b2af4bbe7ac1345ee0d4323aafeb8005724;hb=d25e3478acccec70402ff32554669a982be8e281;hp=82966e3e8899279af2fad8c38e5068a733d1dde7;hpb=4f7c5ad9f9ef93c149ed4e45d4dce696863d324f;p=sbcl.git diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index 82966e3..50153b2 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -73,7 +73,9 @@ (and generic-function (generic-function-name generic-function)) (method-qualifiers method) - (unparse-specializers method))) + (if generic-function + (unparse-specializers generic-function (method-specializers method)) + (method-specializers method)))) ;; FIXME: Why do we do CALL-NEXT-METHOD in this method (and ;; in the PRINT-OBJECT STANDARD-ACCESSOR-METHOD method too)? (call-next-method)))) @@ -86,7 +88,9 @@ (and generic-function (generic-function-name generic-function)) (accessor-method-slot-name method) - (unparse-specializers method))) + (if generic-function + (unparse-specializers generic-function (method-specializers method)) + (method-specializers method)))) (call-next-method)))) (defmethod print-object ((mc standard-method-combination) stream) @@ -98,15 +102,11 @@ (defun named-object-print-function (instance stream &optional (extra nil extra-p)) - (print-unreadable-object (instance stream :type t) - (if extra-p - (format stream - "~S ~:S" - (slot-value-or-default instance 'name) - extra) - (format stream - "~S" - (slot-value-or-default instance 'name))))) + (let ((name (slot-value-or-default instance 'name))) + (print-unreadable-object (instance stream :type t :identity (not name)) + (if extra-p + (format stream "~S ~:S" name extra) + (format stream "~S" name))))) (defmethod print-object ((class class) stream) (named-object-print-function class stream)) @@ -127,7 +127,7 @@ (multiple-value-bind (lines-used lines-total max-depth depth-limit) (cache-statistics cache) (format stream - "~D key, ~P~:[no value~;value~], ~D/~D lines, depth ~D/~D" + "~D key~P, ~:[no value~;value~], ~D/~D lines, depth ~D/~D" (cache-key-count cache) (cache-key-count cache) (cache-value cache)