0.8.16.2: TYPE-ERROR for ERROR

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

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index b5c5e73..04c893f 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -276,6 +276,7 @@
   (let ((*readtable* *standard-readtable*))
 
     (flet ((whitespaceify (char)
+            (set-cmt-entry char nil)
             (set-cat-entry char +char-attr-whitespace+)))
       (whitespaceify (code-char tab-char-code))
       (whitespaceify #\linefeed)
@@ -284,7 +285,7 @@
       (whitespaceify (code-char return-char-code)))
 
     (set-cat-entry #\\ +char-attr-escape+)
-    (set-cmt-entry #\\ #'read-token)
+    (set-cmt-entry #\\ nil)
 
     ;; Easy macro-character definitions are in this source file.
     (set-macro-character #\" #'read-string)
@@ -301,8 +302,8 @@
        ((= ichar #O200))
       (setq char (code-char ichar))
       (when (constituentp char *standard-readtable*)
-           (set-cat-entry char (get-secondary-attribute char))
-           (set-cmt-entry char nil)))))
+       (set-cat-entry char (get-secondary-attribute char))
+       (set-cmt-entry char nil)))))
 \f
 ;;;; implementation of the read buffer
 
@@ -406,18 +407,19 @@
   "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
   (if recursivep
-    ;; a loop for repeating when a macro returns nothing
-    (loop
-      (let ((char (read-char stream eof-error-p *eof-object*)))
-       (cond ((eofp char) (return eof-value))
-             ((whitespacep char))
-             (t
-              (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
-                     (result (multiple-value-list
-                              (funcall macrofun stream char))))
-                ;; Repeat if macro returned nothing.
-                 (if result (return (car result))))))))
-    (let ((*sharp-equal-alist* nil))
+      ;; a loop for repeating when a macro returns nothing
+      (loop
+       (let ((char (read-char stream eof-error-p *eof-object*)))
+         (cond ((eofp char) (return eof-value))
+               ((whitespacep char))
+               (t
+                (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
+                       (result (multiple-value-list
+                                (funcall macrofun stream char))))
+                  ;; Repeat if macro returned nothing.
+                 (when result 
+                    (return (unless *read-suppress* (car result)))))))))
+      (let ((*sharp-equal-alist* nil))
        (read-preserving-whitespace stream eof-error-p eof-value t))))
 
 ;;; Return NIL or a list with one thing, depending.
@@ -429,7 +431,8 @@
                 (funcall (get-coerced-cmt-entry char *readtable*)
                          stream
                          char))))
-    (if retval (rplacd retval nil))))
+    (when (and retval (not *read-suppress*))
+      (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
                       (eof-error-p t)
@@ -441,9 +444,9 @@
                                            eof-error-p
                                            eof-value
                                            recursivep)))
-    ;; (This function generally discards trailing whitespace. If you
+    ;; This function generally discards trailing whitespace. If you
     ;; don't want to discard trailing whitespace, call
-    ;; CL:READ-PRESERVING-WHITESPACE instead.)
+    ;; CL:READ-PRESERVING-WHITESPACE instead.
     (unless (or (eql result eof-value) recursivep)
       (let ((next-char (read-char stream nil nil)))
        (unless (or (null next-char)
@@ -1418,7 +1421,7 @@
   #!+sb-doc
   "A resource of string streams for Read-From-String.")
 
-(defun read-from-string (string &optional eof-error-p eof-value
+(defun read-from-string (string &optional (eof-error-p t) eof-value
                                &key (start 0) end
                                preserve-whitespace)
   #!+sb-doc