1.0.35.7: fix docstrings for printing-releated things

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 7240bf8..276ce95 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -18,8 +18,8 @@
 
 (defvar *print-readably* nil
   #!+sb-doc
-  "If true, all objects will printed readably. If readable printing is
-  impossible, an error will be signalled. This overrides the value of
+  "If true, all objects will be printed readably. If readable printing
+  is impossible, an error will be signalled. This overrides the value of
   *PRINT-ESCAPE*.")
 (defvar *print-escape* t
   #!+sb-doc
@@ -30,7 +30,7 @@
   "Should pretty printing be used?")
 (defvar *print-base* 10.
   #!+sb-doc
-  "the output base for RATIONALs (including integers)")
+  "The output base for RATIONALs (including integers).")
 (defvar *print-radix* nil
   #!+sb-doc
   "Should base be verified when printing RATIONALs?")
@@ -56,10 +56,10 @@
   "Should #: prefixes be used when printing symbols with null SYMBOL-PACKAGE?")
 (defvar *print-lines* nil
   #!+sb-doc
-  "the maximum number of lines to print per object")
+  "The maximum number of lines to print per object.")
 (defvar *print-right-margin* nil
   #!+sb-doc
-  "the position of the right margin in ems (for pretty-printing)")
+  "The position of the right margin in ems (for pretty-printing).")
 (defvar *print-miser-width* nil
   #!+sb-doc
   "If the remaining space between the current column and the right margin
@@ -69,7 +69,7 @@
 (defvar *print-pprint-dispatch*)
 #!+sb-doc
 (setf (fdocumentation '*print-pprint-dispatch* 'variable)
-      "the pprint-dispatch-table that controls how to pretty-print objects")
+      "The pprint-dispatch-table that controls how to pretty-print objects.")
 
 (defmacro with-standard-io-syntax (&body body)
   #!+sb-doc
@@ -86,6 +86,7 @@
        *PRINT-LEVEL*                    NIL
        *PRINT-LINES*                    NIL
        *PRINT-MISER-WIDTH*              NIL
+       *PRINT-PPRINT-DISPATCH*          the standard pprint dispatch table
        *PRINT-PRETTY*                   NIL
        *PRINT-RADIX*                    NIL
        *PRINT-READABLY*                 T
@@ -110,6 +111,7 @@
         (*print-level* nil)
         (*print-lines* nil)
         (*print-miser-width* nil)
+        (*print-pprint-dispatch* sb!pretty::*standard-pprint-dispatch-table*)
         (*print-pretty* nil)
         (*print-radix* nil)
         (*print-readably* t)
@@ -118,12 +120,6 @@
         (*read-default-float-format* 'single-float)
         (*read-eval* t)
         (*read-suppress* nil)
-        ;; FIXME: It doesn't seem like a good idea to expose our
-        ;; disaster-recovery *STANDARD-READTABLE* here. What if some
-        ;; enterprising user corrupts the disaster-recovery readtable
-        ;; by doing destructive readtable operations within
-        ;; WITH-STANDARD-IO-SYNTAX? Perhaps we should do a
-        ;; COPY-READTABLE? The consing would be unfortunate, though.
         (*readtable* *standard-readtable*))
     (funcall function)))
 \f
@@ -171,7 +167,7 @@
                      ((:pprint-dispatch *print-pprint-dispatch*)
                       *print-pprint-dispatch*))
   #!+sb-doc
-  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*"
+  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*."
   (output-object object (out-synonym-of stream))
   object)
 
@@ -320,10 +316,12 @@
                     :level nil :length nil)
              (write-char #\space stream))
            (when body
+             (pprint-newline :fill stream)
              (funcall body))
            (when identity
              (when (or body (not type))
                (write-char #\space stream))
+             (pprint-newline :fill stream)
              (write-char #\{ stream)
              (write (get-lisp-obj-address object) :stream stream
                     :radix nil :base 16)
@@ -336,9 +334,9 @@
            (pprint-logical-block (stream nil :prefix "#<" :suffix ">")
              (print-description)))
           (t
-            (write-string "#<" stream)
-            (print-description)
-            (write-char #\> stream))))
+           (write-string "#<" stream)
+           (print-description)
+           (write-char #\> stream))))
   nil)
 \f
 ;;;; OUTPUT-OBJECT -- the main entry point
@@ -447,8 +445,6 @@
         (output-float object stream))
        (ratio
         (output-ratio object stream))
-       (ratio
-        (output-ratio object stream))
        (complex
         (output-complex object stream))))
     (character
@@ -1351,9 +1347,9 @@
 ;;; possible extension for the enthusiastic: printing floats in bases
 ;;; other than base 10.
 (defconstant single-float-min-e
-  (nth-value 1 (decode-float least-positive-single-float)))
+  (- 2 sb!vm:single-float-bias sb!vm:single-float-digits))
 (defconstant double-float-min-e
-  (nth-value 1 (decode-float least-positive-double-float)))
+  (- 2 sb!vm:double-float-bias sb!vm:double-float-digits))
 #!+long-float
 (defconstant long-float-min-e
   (nth-value 1 (decode-float least-positive-long-float)))
@@ -1483,7 +1479,20 @@
           (values (float 0.0e0 original-x) 1)
           (let* ((ex (locally (declare (optimize (safety 0)))
                        (the fixnum
-                         (round (* exponent (log 2e0 10))))))
+                         (round (* exponent
+                                   ;; this is the closest double float
+                                   ;; to (log 2 10), but expressed so
+                                   ;; that we're not vulnerable to the
+                                   ;; host lisp's interpretation of
+                                   ;; arithmetic.  (FIXME: it turns
+                                   ;; out that sbcl itself is off by 1
+                                   ;; ulp in this value, which is a
+                                   ;; little unfortunate.)
+                                   (load-time-value
+                                    #!-long-float
+                                    (sb!kernel:make-double-float 1070810131 1352628735)
+                                    #!+long-float
+                                    (error "(log 2 10) not computed")))))))
                  (x (if (minusp ex)
                         (if (float-denormalized-p x)
                             #!-long-float