0.pre7.14:

[sbcl.git] / src / code / describe.lisp

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index 9939e92..fc7bb94 100644 (file)
--- 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*)
+
 \f
 (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))
 \f
 ;;;; miscellaneous DESCRIBE-OBJECT methods
@@ -130,6 +135,7 @@
 ;;; Interpreted function describing; handles both closure and
 ;;; non-closure functions. Instead of printing the compiled-from info,
 ;;; we print the definition.
+#+sb-interpreter
 (defun %describe-function-interpreted (x s kind name)
   (declare (type stream s))
   (multiple-value-bind (exp closure-p dname)
@@ -147,12 +153,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 +182,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
@@ -251,6 +257,7 @@
          (let ((data (byte-closure-data x)))
            (dotimes (i (length data))
              (format s "~@:_~S: ~S" i (svref data i))))))
+       #+sb-interpreter
        (sb-eval:interpreted-function
        (%describe-function-interpreted x s kind name))
        (standard-generic-function
@@ -274,9 +281,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 +306,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 +327,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))))