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)
   (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)
             (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+)
       (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)
 
     ;; 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*)
        ((= 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
 
 \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
   "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.
        (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))))
                 (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)
 
 (defun read (&optional (stream *standard-input*)
                       (eof-error-p t)

@@ -441,9 +444,9 @@
                                            eof-error-p
                                            eof-value
                                            recursivep)))
                                            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
     ;; 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)
     (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.")
 
   #!+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
                                &key (start 0) end
                                preserve-whitespace)
   #!+sb-doc