0.8.8.27:

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 968c84f..d27924a 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -597,7 +597,7 @@
 ;;; 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)
@@ -875,19 +875,19 @@
 ;;; :DOWNCASE          :CAPITALIZE
 (defun output-capitalize-symbol (pname stream)
   (declare (simple-string pname))
-  (let ((prev-not-alpha t)
+  (let ((prev-not-alphanum t)
        (up (eq (readtable-case *readtable*) :upcase)))
     (dotimes (i (length pname))
       (let ((char (char pname i)))
        (write-char (if up
-                       (if (or prev-not-alpha (lower-case-p char))
+                       (if (or prev-not-alphanum (lower-case-p char))
                            char
                            (char-downcase char))
-                       (if prev-not-alpha
+                       (if prev-not-alphanum
                            (char-upcase char)
                            char))
                    stream)
-       (setq prev-not-alpha (not (alpha-char-p char)))))))
+       (setq prev-not-alphanum (not (alphanumericp char)))))))
 
 ;;; called when:
 ;;; READTABLE-CASE     *PRINT-CASE*
@@ -1163,8 +1163,8 @@
       (2 (write-char #\b stream))
       (8 (write-char #\o stream))
       (16 (write-char #\x stream))
-      (t (write *print-base* :stream stream :radix nil :base 10)))
-    (write-char #\r stream))
+      (t (write *print-base* :stream stream :radix nil :base 10)
+        (write-char #\r stream))))
   (let ((*print-radix* nil))
     (output-integer (numerator ratio) stream)
     (write-char #\/ stream)
@@ -1402,7 +1402,9 @@
       (declare (ignore sig))
       (if (= x 0.0e0)
          (values (float 0.0e0 original-x) 1)
-         (let* ((ex (round (* exponent (log 2e0 10))))
+         (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
@@ -1419,7 +1421,9 @@
                      (z y (* y m))
                      (ex ex (1- ex)))
                     ((>= z 0.1e0)
-                     (values (float z original-x) ex))))))))))
+                     (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
@@ -1524,9 +1528,10 @@
 ;;; the character name or the character in the #\char format.
 (defun output-character (char stream)
   (if (or *print-escape* *print-readably*)
-      (let ((name (char-name char)))
+      (let ((graphicp (graphic-char-p char))
+           (name (char-name char)))
        (write-string "#\\" stream)
-       (if name
+       (if (and name (not graphicp))
            (quote-string name stream)
            (write-char char stream)))
       (write-char char stream)))