0.pre7.35:

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

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index e926472..d085947 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,6 +25,7 @@
 (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)))
     (pprint-logical-block (stream nil)
       (fresh-line stream)
@@ -38,7 +42,8 @@
   (call-next-method)
   (when (and (legal-function-name-p x)
             (fboundp x))
-    (format s "Its FDEFINITION is ~S.~@:_" (fdefinition x))
+    (%describe-function (fdefinition x) s :function x)
+    ;;was: (format s "~@:_Its FDEFINITION is ~S.~@:_" (fdefinition x))
     ;; TO DO: should check for SETF documentation.
     ;; TO DO: should make it clear whether the definition is a
     ;; DEFUN (SETF FOO) or DEFSETF FOO or what.
@@ -128,34 +133,6 @@
                 ~:[no~;~] expansion is available."
                inlinep (info :function :inline-expansion name))))))
 
-;;; Interpreted function describing; handles both closure and
-;;; non-closure functions. Instead of printing the compiled-from info,
-;;; we print the definition.
-(defun %describe-function-interpreted (x s kind name)
-  (declare (type stream s))
-  (multiple-value-bind (exp closure-p dname)
-      (sb-eval:interpreted-function-lambda-expression x)
-    (let ((args (sb-eval:interpreted-function-arglist x)))
-      (format s "~@:_~@(~@[~A ~]arguments:~@:_~)" kind)
-      (if args
-         (format s "  ~<~S~:>" args)
-         (write-string "  There are no arguments." s)))
-    (let ((name (or name dname)))
-      (%describe-doc name s 'function kind)
-      (unless (eq kind :macro)
-       (%describe-function-name
-        name
-        s
-        (type-specifier (sb-eval:interpreted-function-type x)))))
-    (when closure-p
-      (format s "~@:_Its closure environment is:~%")
-      (pprint-logical-block (s nil)
-       (pprint-indent :current 2)
-       (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
 ;;; compiled from.
 (defun %describe-compiled-from (code-obj s)
@@ -177,8 +154,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
@@ -252,8 +229,6 @@
          (let ((data (byte-closure-data x)))
            (dotimes (i (length data))
              (format s "~@:_~S: ~S" i (svref data i))))))
-       (sb-eval:interpreted-function
-       (%describe-function-interpreted x s kind name))
        (standard-generic-function
        ;; There should be a special method for this case; we'll
        ;; delegate to that.
@@ -321,8 +296,8 @@
        ((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?
+  ;; 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.)
@@ -331,8 +306,15 @@
   (%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))))