is less than this, then print using ``miser-style'' output. Miser
style conditional newlines are turned on, and all indentations are
turned off. If NIL, never use miser mode.")
-(defvar *print-pprint-dispatch* nil
- #!+sb-doc
- "the pprint-dispatch-table that controls how to pretty-print objects")
+(defvar *print-pprint-dispatch*)
+#!+sb-doc
+(setf (fdocumentation '*print-pprint-dispatch* 'variable)
+ "the pprint-dispatch-table that controls how to pretty-print objects")
(defmacro with-standard-io-syntax (&body body)
#!+sb-doc
(check-for-circularity object t)
;; initialization of the circulation detect noise ...
(if (eq initiate :initiate)
- (let ((*circularity-hash-table*
- (make-hash-table :test 'eq)))
- (check-it (make-broadcast-stream))
- (let ((*circularity-counter* 0))
- (check-it stream)))
- ;; otherwise
- (if marker
- (when (handle-circularity marker stream)
- (print-it stream))
- (print-it stream))))))
+ (let ((*circularity-hash-table*
+ (make-hash-table :test 'eq)))
+ (check-it (make-broadcast-stream))
+ (let ((*circularity-counter* 0))
+ (check-it stream)))
+ ;; otherwise
+ (if marker
+ (when (handle-circularity marker stream)
+ (print-it stream))
+ (print-it stream))))))
(cond (;; Maybe we don't need to bother with circularity detection.
(or (not *print-circle*)
(uniquely-identified-by-print-p object))
;;; words, diddle its case according to *PRINT-CASE* and
;;; READTABLE-CASE.
(defun output-symbol-name (name stream &optional (maybe-quote t))
- (declare (type simple-base-string name))
+ (declare (type simple-string name))
(setup-printer-state)
(if (and maybe-quote (symbol-quotep name))
(output-quoted-symbol-name name stream)
:initial-element 36))
(declaim (type (simple-array (unsigned-byte 8) (#.char-code-limit))
*digit-bases*))
-
(dotimes (i 36)
(let ((char (digit-char i 36)))
(setf (aref *digit-bases* (char-code char)) i)))
(return t)
MARKER ; number marker in a numeric number...
+ ;; ("What," you may ask, "is a 'number marker'?" It's something
+ ;; that a conforming implementation might use in number syntax.
+ ;; See ANSI 2.3.1.1 "Potential Numbers as Tokens".)
(when (test letter) (advance OTHER nil))
(go DIGIT))))
\f
(write-char (if (zerop bit) #\0 #\1) stream)))
(t
(when (and *print-readably*
- (not (array-readably-printable-p array)))
+ (not (array-readably-printable-p vector)))
(error 'print-not-readable :object vector))
(descend-into (stream)
(write-string "#(" stream)
;;; part of the computation to avoid over/under flow. When
;;; denormalized, we must pull out a large factor, since there is more
;;; negative exponent range than positive range.
+
+(eval-when (:compile-toplevel :execute)
+ (setf *read-default-float-format*
+ #!+long-float 'long-float #!-long-float 'double-float))
(defun scale-exponent (original-x)
(let* ((x (coerce original-x 'long-float)))
(multiple-value-bind (sig exponent) (decode-float x)
(declare (ignore sig))
- (if (= x 0.0l0)
- (values (float 0.0l0 original-x) 1)
- (let* ((ex (round (* exponent (log 2l0 10))))
+ (if (= x 0.0e0)
+ (values (float 0.0e0 original-x) 1)
+ (let* ((ex (locally (declare (optimize (safety 0)))
+ (the fixnum
+ (round (* exponent (log 2e0 10))))))
(x (if (minusp ex)
(if (float-denormalized-p x)
#!-long-float
- (* x 1.0l16 (expt 10.0l0 (- (- ex) 16)))
+ (* x 1.0e16 (expt 10.0e0 (- (- ex) 16)))
#!+long-float
- (* x 1.0l18 (expt 10.0l0 (- (- ex) 18)))
- (* x 10.0l0 (expt 10.0l0 (- (- ex) 1))))
- (/ x 10.0l0 (expt 10.0l0 (1- ex))))))
- (do ((d 10.0l0 (* d 10.0l0))
+ (* x 1.0e18 (expt 10.0e0 (- (- ex) 18)))
+ (* x 10.0e0 (expt 10.0e0 (- (- ex) 1))))
+ (/ x 10.0e0 (expt 10.0e0 (1- ex))))))
+ (do ((d 10.0e0 (* d 10.0e0))
(y x (/ x d))
(ex ex (1+ ex)))
- ((< y 1.0l0)
- (do ((m 10.0l0 (* m 10.0l0))
+ ((< y 1.0e0)
+ (do ((m 10.0e0 (* m 10.0e0))
(z y (* y m))
(ex ex (1- ex)))
- ((>= z 0.1l0)
- (values (float z original-x) ex))))))))))
+ ((>= z 0.1e0)
+ (values (float z original-x) ex))
+ (declare (long-float m) (integer ex))))
+ (declare (long-float d))))))))
+(eval-when (:compile-toplevel :execute)
+ (setf *read-default-float-format* 'single-float))
\f
;;;; entry point for the float printer