0.pre7.58:
[sbcl.git] / src / code / target-misc.lisp
index 20ea613..9cb38b6 100644 (file)
 (defun function-doc (x)
   (let ((name
         (case (get-type x)
-          (#.sb!vm:closure-header-type
-           (%function-name (%closure-function x)))
-          ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
-           (%function-name x))
-          (#.sb!vm:funcallable-instance-header-type
-           (typecase x
-             (byte-function
-              (sb!c::byte-function-name x))
-             (byte-closure
-              (sb!c::byte-function-name (byte-closure-function x)))
-             (sb!eval:interpreted-function
-              (multiple-value-bind (exp closure-p dname)
-                  (sb!eval:interpreted-function-lambda-expression x)
-                (declare (ignore exp closure-p))
-                dname))
-             (t ;; funcallable-instance
-              (%function-name
-               (funcallable-instance-function x))))))))
+          (#.sb!vm:closure-header-widetag
+           (%simple-fun-name (%closure-fun x)))
+          ((#.sb!vm:simple-fun-header-widetag
+            #.sb!vm:closure-fun-header-widetag)
+           (%simple-fun-name x))
+          (#.sb!vm:funcallable-instance-header-widetag
+           (%simple-fun-name
+            (funcallable-instance-fun x))))))
     (when (and name (typep name '(or symbol cons)))
       (values (info :function :documentation name)))))
 
   #!+sb-doc "the value of LONG-SITE-NAME")
 (defun short-site-name ()
   #!+sb-doc
-  "Returns a string with the abbreviated site name, or NIL if not known."
+  "Return a string with the abbreviated site name, or NIL if not known."
   *short-site-name*)
 (defun long-site-name ()
   #!+sb-doc
-  "Returns a string with the long form of the site name, or NIL if not known."
+  "Return a string with the long form of the site name, or NIL if not known."
   *long-site-name*)
 \f
 ;;;; dribble stuff