X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=ca2ab733f650c30e948097bdd6a82fe6db2b470f;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=cdbfb3605a2f61c30779de09620f493c77cf388e;hpb=648b48d2406f6d6f2bf341bf8ed350aac85398d0;p=sbcl.git

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index cdbfb36..ca2ab73 100644
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -60,26 +60,24 @@
 (defmethod describe-object ((x array) s)
   (fresh-line s)
   (pprint-logical-block (s nil)
-    (let ((rank (array-rank x)))
-      (cond ((= rank 1)
-	     (format s
-		     "~S is a ~:[~;displaced ~]vector of length ~S." x
-		     (and (array-header-p x)
-			  (%array-displaced-p x)
-			  ) (length x))
-	     (when (array-has-fill-pointer-p x)
-	       (format s "~@:_It has a fill pointer, currently ~S."
-		       (fill-pointer x))))
-	    (t
-	     (format s "~S ~_is " x)
-	     (write-string (if (%array-displaced-p x) "a displaced" "an") s)
-	     (format s " array of rank ~S." rank)
-	     (format s "~@:_Its dimensions are ~S." (array-dimensions x)))))
+    (cond
+     ((= 1 (array-rank x))
+      (format s "~S is a vector with ~D elements."
+	      x (car (array-dimensions x)))
+      (when (array-has-fill-pointer-p x)
+	(format s "~@:_It has a fill pointer value of ~S."
+		(fill-pointer x))))
+     (t
+      (format s "~S is an array of dimension ~:S."
+	      x (array-dimensions x))))
     (let ((array-element-type (array-element-type x)))
       (unless (eq array-element-type t)
 	(format s
 		"~@:_Its element type is specialized to ~S."
-		array-element-type))))
+		array-element-type)))
+    (if (and (array-header-p x) (%array-displaced-p x))
+	(format s "~@:_The array is displaced with offset ~S."
+		(%array-displacement x))))
   (terpri s))
 
 (defmethod describe-object ((x hash-table) s)
@@ -90,7 +88,7 @@
 	  "~&~@<Its REHASH-SIZE is ~S. ~_Its REHASH-THRESHOLD is ~S.~:>"
 	  (hash-table-rehash-size x)
 	  (hash-table-rehash-threshold x))
-  (fresh-line)
+  (fresh-line s)
   (pprint-logical-block (s nil)
     (let ((count (hash-table-count x)))
       (format s "It holds ~S key/value pair~:P~:[: ~2I~_~;.~]"
@@ -221,7 +219,7 @@
 	 (pprint-indent :current 8)
 	 (dotimes (i (- (get-closure-length x) (1- sb-vm:closure-info-offset)))
 	   (format s "~@:_~S: ~S" i (%closure-index-ref x i)))))
-      ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag)
+      (#.sb-vm:simple-fun-header-widetag
        (%describe-fun-compiled x s kind name))
       (#.sb-vm:funcallable-instance-header-widetag
        ;; Only STANDARD-GENERIC-FUNCTION would be handled here, but
@@ -328,7 +326,7 @@
   ;;   * NIL, in which case there's nothing to see here, move along.
   (when (eq (info :type :kind x) :defined)
     (format s "~&It names a type specifier."))
-  (let ((symbol-named-class (find-classoid x nil)))
+  (let ((symbol-named-class (find-class x nil)))
     (when symbol-named-class
       (format s "~&It names a class ~A." symbol-named-class)
       (describe symbol-named-class s)))