X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=04c893f7af3fc934f062c68feca650aa7167a77c;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=b5c5e73b148557faf99754169f4d384ad5b7df95;hpb=7c1298a73f97b8c71474d8aa4a7c8f863fe0718d;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index b5c5e73..04c893f 100644
--- 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)))))
 
 ;;;; 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