diff --git a/code/describe.lisp b/code/describe.lisp
index 25333b9216bea8f38c7fb32eacf0f384174542a2..bfcd0195576a7ddb8681accda939b5f0d89ec2ea 100644
--- a/code/describe.lisp
+++ b/code/describe.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.37 2002/11/14 16:54:33 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.38 2002/12/07 18:21:22 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -148,20 +148,22 @@
 	   (format t "~%~A: ~S." (car slot) (cdr slot))))))
 
 (defun describe-array (x)
-  (let ((rank (array-rank x)))
-    (cond ((> rank 1)
-	   (format t "~&~S is " x)
-	   (write-string (if (%array-displaced-p x) "a displaced" "an"))
-	   (format t " array of rank ~A." rank)
-	   (format t "~%Its dimensions are ~S." (array-dimensions x)))
-	  (t
+  (let ((rank (array-rank x))
+	(element-type (array-element-type x)))
+    (cond ((= rank 1)
 	   (format t "~&~S is a ~:[~;displaced ~]vector of length ~D." x
 		   (and (array-header-p x) (%array-displaced-p x)) (length x))
 	   (if (array-has-fill-pointer-p x)
 	       (format t "~&It has a fill pointer, currently ~d"
 		       (fill-pointer x))
-	       (format t "~&It has no fill pointer."))))
-  (format t "~&Its element type is ~S." (array-element-type x))))
+	       (format t "~&It has no fill pointer.")))
+	  (t
+	   (format t "~&~S is " x)
+	   (write-string (if (%array-displaced-p x) "a displaced" "an"))
+	   (format t " array of rank ~A." rank)
+	   (format t "~%Its dimensions are ~S." (array-dimensions x))))
+    (unless (eq t element-type)
+      (format t "~&Its element type is specialized to ~S." element-type))))
 
 (defun describe-fixnum (x)
   (cond ((not (or *describe-verbose* (zerop *current-describe-level*))))