X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fprint-object.lisp;h=df187c37d32f3c659ee87b15e2c3b79e6ae2e1b2;hb=7d853ed1882221bc790062e423a74a620f6e4ee1;hp=964c84be6ef390c24534844234aba411c945a5d4;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git

diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp
index 964c84b..df187c3 100644
--- a/src/pcl/print-object.lisp
+++ b/src/pcl/print-object.lisp
@@ -67,46 +67,50 @@
 
 (defmethod print-object ((method standard-method) stream)
   (print-unreadable-object (method stream :type t :identity t)
-    (if (slot-boundp method 'generic-function)
-	(let ((generic-function (method-generic-function method)))
-	  (format stream "~S ~{~S ~}~:S"
-		  (and generic-function
-		       (generic-function-name generic-function))
-		  (method-qualifiers method)
-		  (unparse-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))))
+    (if (slot-boundp method '%generic-function)
+        (let ((generic-function (method-generic-function method)))
+          (format stream "~S ~{~S ~}~:S"
+                  (and generic-function
+                       (generic-function-name generic-function))
+                  (method-qualifiers 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))))
 
 (defmethod print-object ((method standard-accessor-method) stream)
   (print-unreadable-object (method stream :type t :identity t)
-    (if (slot-boundp method 'generic-function)
-	(let ((generic-function (method-generic-function method)))
-	  (format stream "~S, slot:~S, ~:S"
-		  (and generic-function
-		       (generic-function-name generic-function))
-		  (accessor-method-slot-name method)
-		  (unparse-specializers method)))
-	(call-next-method))))
+    (if (slot-boundp method '%generic-function)
+        (let ((generic-function (method-generic-function method)))
+          (format stream "~S, slot:~S, ~:S"
+                  (and generic-function
+                       (generic-function-name generic-function))
+                  (accessor-method-slot-name 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)
   (print-unreadable-object (mc stream :type t :identity t)
     (format stream
-	    "~S ~S"
-	    (slot-value-or-default mc 'type)
-	    (slot-value-or-default mc 'options))))
+            "~S ~S"
+            (slot-value-or-default mc 'type-name)
+            (slot-value-or-default mc 'options))))
 
 (defun named-object-print-function (instance stream
-				    &optional (extra nil extra-p))
+                                    &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)))))
+    (if extra-p
+        (format stream
+                "~S ~:S"
+                (slot-value-or-default instance 'name)
+                extra)
+        (format stream
+                "~S"
+                (slot-value-or-default instance 'name)))))
 
 (defmethod print-object ((class class) stream)
   (named-object-print-function class stream))
@@ -114,28 +118,27 @@
 (defmethod print-object ((slotd slot-definition) stream)
   (named-object-print-function slotd stream))
 
-(defmethod print-object ((generic-function generic-function) stream)
+(defmethod print-object ((generic-function standard-generic-function) stream)
   (named-object-print-function
     generic-function
     stream
     (if (slot-boundp generic-function 'methods)
-	(list (length (generic-function-methods generic-function)))
-	"?")))
-
-(defmethod print-object ((constructor constructor) stream)
-  (print-unreadable-object (constructor stream :type t :identity t)
-    (format stream
-	    "~S (~S)"
-	    (slot-value-or-default constructor 'name)
-	    (slot-value-or-default constructor 'code-type))))
+        (list (length (generic-function-methods generic-function)))
+        "?")))
 
 (defmethod print-object ((cache cache) stream)
   (print-unreadable-object (cache stream :type t :identity t)
-    (format stream
-	    "~W ~S ~W"
-	    (cache-nkeys cache)
-	    (cache-valuep cache)
-	    (cache-nlines cache))))
+    (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"
+              (cache-key-count cache)
+              (cache-key-count cache)
+              (cache-value cache)
+              lines-used
+              lines-total
+              max-depth
+              depth-limit))))
 
 (defmethod print-object ((wrapper wrapper) stream)
   (print-unreadable-object (wrapper stream :type t :identity t)