0.9.1.1:

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 7da9efe..b53c9ec 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -21,7 +21,7 @@
   "If true, all objects will printed readably. If readable printing is
   impossible, an error will be signalled. This overrides the value of
   *PRINT-ESCAPE*.")
-(defvar *print-escape* T
+(defvar *print-escape* t
   #!+sb-doc
   "Should we print in a reasonably machine-readable way? (possibly
   overridden by *PRINT-READABLY*)")
@@ -1630,23 +1630,15 @@
   nil)
 
 (defun output-fun (object stream)
-  (let* ((*print-length* 3) ; in case we have to..
-        (*print-level* 3)  ; ..print an interpreted function definition
-        ;; FIXME: This find-the-function-name idiom ought to be
-        ;; encapsulated in a function somewhere.
-        (name (case (fun-subtype object)
-                (#.sb!vm:closure-header-widetag "CLOSURE")
-                (#.sb!vm:simple-fun-header-widetag (%simple-fun-name object))
-                (t 'no-name-available)))
-        (identified-by-name-p (and (symbolp name)
-                                   (fboundp name)
-                                   (eq (fdefinition name) object))))
-      (print-unreadable-object (object
-                               stream
-                               :identity (not identified-by-name-p))
-       (prin1 'function stream)
-       (unless (eq name 'no-name-available)
-         (format stream " ~S" name)))))
+    (let* ((*print-length* 3)  ; in case we have to..
+           (*print-level* 3)  ; ..print an interpreted function definition
+           (name (%fun-name object))
+           (proper-name-p (and (legal-fun-name-p name) (fboundp name)
+                               (eq (fdefinition name) object))))
+      (print-unreadable-object (object stream :identity (not proper-name-p))
+        (format stream "~:[FUNCTION~;CLOSURE~]~@[ ~S~]" 
+                (closurep object)
+                name))))
 \f
 ;;;; catch-all for unknown things