(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)
(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)
((= 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
"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.
(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)
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)
#!+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