X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=3b650bc14e2724a225cf68a109b5969d791cf570;hb=3bd7a97d1b11a2b0aee086ef211cae807f3dfc35;hp=9939e92e12e77a1fc570a259497e58d81d414a89;hpb=fbd731d14e61b8f57e4bfb6f2865cb9c6aa2d86e;p=sbcl.git

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index 9939e92..3b650bc 100644
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -10,7 +10,10 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB-IMPL")
+(in-package "SB-IMPL") ;(SB-IMPL, not SB!IMPL, since we're built in warm load.)
+
+(declaim #.*optimize-byte-compilation*)
+
 
 (defvar *describe-indentation-step* 3
   #+sb-doc
@@ -22,10 +25,12 @@
 (defun describe (x &optional (stream-designator *standard-output*))
   #+sb-doc
   "Print a description of the object X."
+  (declare #.*optimize-external-despite-byte-compilation*)
   (let ((stream (out-synonym-of stream-designator)))
-    #+nil (fresh-line stream)
     (pprint-logical-block (stream nil)
-      (describe-object x stream)))
+      (fresh-line stream)
+      (describe-object x stream)
+      (fresh-line stream)))
   (values))
 
 ;;;; miscellaneous DESCRIBE-OBJECT methods
@@ -147,12 +152,12 @@
 	 s
 	 (type-specifier (sb-eval:interpreted-function-type x)))))
     (when closure-p
-      (format s "~@:_Its closure environment is:")
+      (format s "~@:_Its closure environment is:~%")
       (pprint-logical-block (s nil)
 	(pprint-indent :current 2)
-	(let ((clos (sb-eval:interpreted-function-closure x)))
-	  (dotimes (i (length clos))
-	    (format s "~@:_~S: ~S" i (svref clos i))))))
+	(let ((closure (sb-eval:interpreted-function-closure x)))
+	  (dotimes (i (length closure))
+	    (format s "~@:_~S: ~S" i (svref closure i))))))
     (format s "~@:_Its definition is:~@:_  ~S" exp)))
 
 ;;; Print information from the debug-info about where CODE-OBJ was
@@ -176,8 +181,8 @@
 	      (ecase (sb-c::debug-source-from source)
 		(:file
 		 (format s "~@:_~A~@:_  Created: " (namestring name))
-		 (sb-int:format-universal-time s (sb-c::debug-source-created
-						  source)))
+		 (format-universal-time s (sb-c::debug-source-created
+					   source)))
 		(:lisp (format s "~@:_~S" name))))))))))
 
 ;;; Describe a compiled function. The closure case calls us to print
@@ -274,9 +279,9 @@
 	(multiple-value-bind (symbol status)
 	    (find-symbol (symbol-name x) package)
 	  (declare (ignore symbol))
-	  (format s "~S is an ~(~A~) symbol in ~S."
+	  (format s "~S is ~_an ~(~A~) symbol ~_in ~S."
 		  x status (symbol-package x)))
-	(format s "~S is an uninterned symbol." x)))
+	(format s "~S is ~_an uninterned symbol." x)))
   ;; TO DO: We could grovel over all packages looking for and
   ;; reporting other phenomena, e.g. IMPORT and SHADOW, or
   ;; availability in some package even after (SYMBOL-PACKAGE X) has
@@ -299,12 +304,12 @@
 	(format s "~@<Its current value is ~3I~:_~S.~:>"
 		(eval x))))
      ((boundp x)
-      (format s "~@:_It is a ~A; its value is ~S." wot (symbol-value x)))
+      (format s "~@:_It is a ~A; its ~_value is ~S." wot (symbol-value x)))
      ((not (eq kind :global))
       (format s "~@:_It is a ~A; no current value." wot)))
 
     (when (eq (info :variable :where-from x) :declared)
-      (format s "~@:_Its declared type is ~S."
+      (format s "~@:_Its declared type ~_is ~S."
 	      (type-specifier (info :variable :type x))))
 
     (%describe-doc x s 'variable kind))
@@ -320,18 +325,25 @@
 	((fboundp x)
 	 (%describe-function (fdefinition x) s :function x)))
 
-  ;; TO DO: Print out other stuff from the INFO database:
-  ;;   * Does it name a type or class?
-  ;;   * Is it a structure accessor? (important since those are 
+  ;; FIXME: Print out other stuff from the INFO database:
+  ;;   * Does it name a type?
+  ;;   * Is it a structure accessor? (This is important since those are 
   ;;     magical in some ways, e.g. blasting the structure if you 
-  ;;     redefine them)
+  ;;     redefine them.)
 
   ;; Print other documentation.
   (%describe-doc x s 'structure "Structure")
   (%describe-doc x s 'type "Type")
   (%describe-doc x s 'setf "Setf macro")
+
   (dolist (assoc (info :random-documentation :stuff x))
     (format s
 	    "~@:_Documentation on the ~(~A~):~@:_~A"
 	    (car assoc)
-	    (cdr assoc))))
+	    (cdr assoc)))
+  
+  ;; Describe the associated class, if any.
+  (let ((symbol-named-class (cl:find-class x nil)))
+    (when symbol-named-class
+      (format t "~&It names a class ~A." symbol-named-class)
+      (describe symbol-named-class))))