0.9.5.47: minor INSPECT & DESCRIBE improvements
authorNikodemus Siivola <nikodemus@random-state.net>
Wed, 12 Oct 2005 12:35:31 +0000 (12:35 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Wed, 12 Oct 2005 12:35:31 +0000 (12:35 +0000)
 * INSPECT on closures should not display the closure itself.
 * Refactor DESCRIBE to use %CLOSURE-VALUES too, and clean up printing of the
   source form when from lisp.
 * Amend bug 33 to reflect current state of affairs.

BUGS
src/code/describe.lisp
src/code/target-misc.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index a9bd148..e8f41ef 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -94,6 +94,9 @@ WORKAROUND:
   And as long as we're wishing, it would be awfully nice if INSPECT could
   also report on closures, telling about the values of the bound variables.
 
   And as long as we're wishing, it would be awfully nice if INSPECT could
   also report on closures, telling about the values of the bound variables.
 
+  Currently INSPECT and DESCRIBE do show the values, but showing the
+  names of the bindings would be even nicer.
+
 35:
   The compiler assumes that any time a function of declared FTYPE
   doesn't signal an error, its arguments were of the declared type.
 35:
   The compiler assumes that any time a function of declared FTYPE
   doesn't signal an error, its arguments were of the declared type.
index 17aba76..1ec98ed 100644 (file)
               (:file
                (format s "~&~A~@:_  Created: " (namestring name))
                (format-universal-time s (sb-c::debug-source-created source)))
               (:file
                (format s "~&~A~@:_  Created: " (namestring name))
                (format-universal-time s (sb-c::debug-source-created source)))
-              (:lisp (format s "~&~S" name)))))))))
+              (:lisp (format s "~&  ~S" (aref name 0))))))))))
 
 ;;; Describe a compiled function. The closure case calls us to print
 ;;; the guts.
 
 ;;; Describe a compiled function. The closure case calls us to print
 ;;; the guts.
     (case (widetag-of x)
       (#.sb-vm:closure-header-widetag
        (%describe-fun-compiled (%closure-fun x) s kind name)
     (case (widetag-of x)
       (#.sb-vm:closure-header-widetag
        (%describe-fun-compiled (%closure-fun x) s kind name)
-       (format s "~@:_Its closure environment is:")
-       (pprint-logical-block (s nil)
-         (pprint-indent :current 8)
-         (dotimes (i (- (get-closure-length x) (1- sb-vm:closure-info-offset)))
-           (format s "~@:_~S: ~S" i (%closure-index-ref x i)))))
+       (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
        (%describe-fun-compiled x s kind name))
       (#.sb-vm:funcallable-instance-header-widetag
       (#.sb-vm:simple-fun-header-widetag
        (%describe-fun-compiled x s kind name))
       (#.sb-vm:funcallable-instance-header-widetag
index a641538..65fe84d 100644 (file)
@@ -57,9 +57,9 @@
 
 (defun %closure-values (object)
   (declare (function object))
 
 (defun %closure-values (object)
   (declare (function object))
-  (coerce (loop for index from 0 below (1- (get-closure-length object))
-                collect (%closure-index-ref object index))
-          'simple-vector))
+  (loop for index from 0
+     below (- (get-closure-length object) (1- sb!vm:closure-info-offset))
+     collect (%closure-index-ref object index)))
 
 (defun %fun-lambda-list (object)
   (%simple-fun-arglist (%fun-fun object)))
 
 (defun %fun-lambda-list (object)
   (%simple-fun-arglist (%fun-fun object)))
index d1e1b02..2d286fc 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.5.46"
+"0.9.5.47"