0.9.2.7:
[sbcl.git] / src / code / describe.lisp
index 5fe79b8..f36be45 100644 (file)
   (declare (type stream s))
   (let ((info (sb-kernel:%code-debug-info code-obj)))
     (when info
-      (let ((sources (sb-c::debug-info-source info)))
-       (when sources
+      (let ((source (sb-c::debug-info-source info)))
+       (when source
          (format s "~&On ~A it was compiled from:"
                  ;; FIXME: The FORMAT-UNIVERSAL-TIME calls in the system
                  ;; should become more consistent, probably not using
                  ;; any nondefault options.
-                 (format-universal-time nil
-                                        (sb-c::debug-source-compiled
-                                         (first sources))
+                 (format-universal-time nil (sb-c::debug-source-compiled source)
                                         :style :abbreviated))
-         (dolist (source sources)
-           (let ((name (sb-c::debug-source-name source)))
-             (ecase (sb-c::debug-source-from source)
-               (:file
-                (format s "~&~A~@:_  Created: " (namestring name))
-                (format-universal-time s (sb-c::debug-source-created
-                                          source)))
-               (:lisp (format s "~&~S" name))))))))))
+         (let ((name (sb-c::debug-source-name source)))
+           (ecase (sb-c::debug-source-from source)
+             (:file
+              (format s "~&~A~@:_  Created: " (namestring name))
+              (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
 ;;; the guts.
         (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)))))
-      ((#.sb-vm:simple-fun-header-widetag #.sb-vm:closure-fun-header-widetag)
+      (#.sb-vm:simple-fun-header-widetag
        (%describe-fun-compiled x s kind name))
       (#.sb-vm:funcallable-instance-header-widetag
        ;; Only STANDARD-GENERIC-FUNCTION would be handled here, but