X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdescribe.lisp;h=b4f1b9406a35b5282a8cbaa2661a1af8c0675b89;hb=df871446529da0e83d670f35a9566c11d814be32;hp=7da9cd7a0cdab08a8c21a23ed270789e0dca94f7;hpb=c593dc26733b179db6c12c7085ed76b762ac256b;p=sbcl.git

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index 7da9cd7..b4f1b94 100644
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -217,16 +217,16 @@
     (format s "~@:_~@<Its associated name (as in ~S) is ~2I~_~S.~:>"
             'function-lambda-expression
             (nth-value 2 (function-lambda-expression x)))
-    (case (widetag-of x)
-      (#.sb-vm:closure-header-widetag
+    (typecase x
+      (closure
        (%describe-fun-compiled (%closure-fun x) s kind name)
        (format s "~&Its closure environment is:")
-       (loop for value in (%closure-values x)
-          for i = 0 then (1+ i)
-          do (format s "~&  ~S: ~S" i value)))
-      (#.sb-vm:simple-fun-header-widetag
+       (let ((i -1))
+         (do-closure-values (value x)
+           (format s "~&  ~S: ~S" (incf i) value))))
+      (simple-fun
        (%describe-fun-compiled x s kind name))
-      (#.sb-vm:funcallable-instance-header-widetag
+      (funcallable-instance
        ;; Only STANDARD-GENERIC-FUNCTION would be handled here, but
        ;; since it has its own DESCRIBE-OBJECT method, it should've been
        ;; picked off before getting here. So hopefully we never get here.
@@ -252,27 +252,23 @@
             'function-lambda-expression
             (nth-value 2 (function-lambda-expression x)))
     (format s "~&It is an interpreted function.~%")
-    (let ((args (sb-eval:interpreted-function-lambda-list x)))
-      (cond ((not args)
-             (write-string "There are no arguments." s))
-            (t
-             (format s "~&~@(The ~@[~A's ~]arguments are:~@:_~)" kind)
-             (write-string "  " s)
-             (let ((*print-pretty* t)
-                   (*print-escape* t)
-                   (*print-base* 10)
-                   (*print-radix* nil))
-               (pprint-logical-block (s nil)
-                 (pprint-indent :current 2)
-                 (format s "~A" args)))))
-      (format s "~&It was defined as: ")
+    (let ((args (sb-eval:interpreted-function-debug-lambda-list x)))
+      (format s "Its lambda-list is: ")
+      (let ((*print-pretty* t)
+            (*print-escape* t)
+            (*print-base* 10)
+            (*print-radix* nil))
+        (pprint-logical-block (s nil)
+          (pprint-indent :current 2)
+          (format s "~A" args)))
+      (format s "~&It was defined as:~%  ")
       (let ((*print-pretty* t)
             (*print-escape* t)
             (*print-base* 10)
             (*print-radix* nil))
         (pprint-logical-block (s nil)
           (pprint-indent :current 2)
-          (format s "~A" (function-lambda-expression x))))))
+          (format s "~S" (function-lambda-expression x))))))
   (terpri s))
 
 (defmethod describe-object ((x function) s)