0.9.1.38:

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

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 5032ecb..af4eaa2 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -119,7 +119,7 @@
 
 (defun pretty-out (stream char)
   (declare (type pretty-stream stream)
-          (type base-char char))
+          (type character char))
   (cond ((char= char #\newline)
         (enqueue-newline stream :literal))
        (t
@@ -662,15 +662,15 @@
    *STANDARD-OUTPUT*) if it is a pretty-printing stream, and do
    nothing if not. KIND can be one of:
      :LINEAR - A line break is inserted if and only if the immediatly
-       containing section cannot be printed on one line.
+        containing section cannot be printed on one line.
      :MISER - Same as LINEAR, but only if ``miser-style'' is in effect.
-       (See *PRINT-MISER-WIDTH*.)
+        (See *PRINT-MISER-WIDTH*.)
      :FILL - A line break is inserted if and only if either:
        (a) the following section cannot be printed on the end of the
-          current line,
+           current line,
        (b) the preceding section was not printed on a single line, or
        (c) the immediately containing section cannot be printed on one
-          line and miser-style is in effect.
+           line and miser-style is in effect.
      :MANDATORY - A line break is always inserted.
    When a line break is inserted by any type of conditional newline, any
    blanks that immediately precede the conditional newline are ommitted
@@ -694,7 +694,7 @@
    and do nothing if not. (See PPRINT-LOGICAL-BLOCK.)  N is the indentation
    to use (in ems, the width of an ``m'') and RELATIVE-TO can be either:
      :BLOCK - Indent relative to the column the current logical block
-       started on.
+        started on.
      :CURRENT - Indent relative to the current column.
    The new indentation value does not take effect until the following line
    break."
@@ -1099,10 +1099,21 @@
 
 (defun pprint-flet (stream list &rest noise)
   (declare (ignore noise))
-  (funcall (formatter
-           "~:<~^~W~^ ~@_~:<~@{~:<~^~W~^~3I ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~:@_~@{~W~^ ~_~}~:>~^ ~_~}~:>~1I~@:_~@{~W~^ ~_~}~:>")
-          stream
-          list))
+  (if (and (consp list)
+          (consp (cdr list))
+           (cddr list))
+      (funcall (formatter
+                "~:<~^~W~^ ~@_~:<~@{~:<~^~W~^~3I ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~:@_~@{~W~^ ~_~}~:>~^ ~_~}~:>~1I~@:_~@{~W~^ ~_~}~:>")
+               stream
+               list)
+      ;; for printing function names like (flet foo)
+      (pprint-logical-block (stream list :prefix "(" :suffix ")")
+        (pprint-exit-if-list-exhausted)
+        (write (pprint-pop) :stream stream)
+        (loop
+           (pprint-exit-if-list-exhausted)
+           (write-char #\space stream)
+           (write (pprint-pop) :stream stream)))))
 
 (defun pprint-let (stream list &rest noise)
   (declare (ignore noise))