;;;; readtable operations
(defun copy-readtable (&optional (from-readtable *readtable*)
- (to-readtable (make-readtable)))
- (let ((really-from-readtable (or from-readtable *standard-readtable*)))
- (replace (character-attribute-table to-readtable)
+ to-readtable)
+ (let ((really-from-readtable (or from-readtable *standard-readtable*))
+ (really-to-readtable (or to-readtable (make-readtable))))
+ (replace (character-attribute-table really-to-readtable)
(character-attribute-table really-from-readtable))
- (replace (character-macro-table to-readtable)
+ (replace (character-macro-table really-to-readtable)
(character-macro-table really-from-readtable))
- (setf (dispatch-tables to-readtable)
- (mapcar #'(lambda (pair) (cons (car pair)
- (copy-seq (cdr pair))))
+ (setf (dispatch-tables really-to-readtable)
+ (mapcar (lambda (pair) (cons (car pair)
+ (copy-seq (cdr pair))))
(dispatch-tables really-from-readtable)))
- to-readtable))
+ (setf (readtable-case really-to-readtable)
+ (readtable-case really-from-readtable))
+ really-to-readtable))
(defun set-syntax-from-char (to-char from-char &optional
(to-readtable *readtable*)
(defun set-macro-character (char function &optional
(non-terminatingp nil) (rt *readtable*))
#!+sb-doc
- "Causes char to be a macro character which invokes function when
- seen by the reader. The non-terminatingp flag can be used to
+ "Causes CHAR to be a macro character which invokes FUNCTION when
+ seen by the reader. The NON-TERMINATINGP flag can be used to
make the macro character non-terminating. The optional readtable
- argument defaults to the current readtable. Set-macro-character
+ argument defaults to the current readtable. SET-MACRO-CHARACTER
returns T."
- (if non-terminatingp
- (set-cat-entry char (get-secondary-attribute char) rt)
- (set-cat-entry char +char-attr-terminating-macro+ rt))
- (set-cmt-entry char function rt)
- T)
+ (let ((rt (or rt *standard-readtable*)))
+ (if non-terminatingp
+ (set-cat-entry char (get-secondary-attribute char) rt)
+ (set-cat-entry char +char-attr-terminating-macro+ rt))
+ (set-cmt-entry char function rt)
+ T))
(defun get-macro-character (char &optional (rt *readtable*))
#!+sb-doc
- "Returns the function associated with the specified char which is a macro
+ "Return the function associated with the specified CHAR which is a macro
character. The optional readtable argument defaults to the current
readtable."
(let ((rt (or rt *standard-readtable*)))
;; This flushes whitespace chars, returning the last char it read (a
;; non-white one). It always gets an error on end-of-file.
(let ((stream (in-synonym-of stream)))
- (if (lisp-stream-p stream)
+ (if (ansi-stream-p stream)
(prepare-for-fast-read-char stream
(do ((attribute-table (character-attribute-table *readtable*))
(char (fast-read-char t) (fast-read-char t)))
(eof-value nil)
(recursivep nil))
#!+sb-doc
- "Reads from stream and returns the object read, preserving the whitespace
+ "Read from STREAM and return the value read, preserving any whitespace
that followed the object."
- (cond
- (recursivep
+ (if recursivep
;; a loop for repeating when a macro returns nothing
(loop
(let ((char (read-char stream eof-error-p *eof-object*)))
(result (multiple-value-list
(funcall macrofun stream char))))
;; Repeat if macro returned nothing.
- (if result (return (car result)))))))))
- (t
+ (if result (return (car result))))))))
(let ((*sharp-equal-alist* nil))
- (read-preserving-whitespace stream eof-error-p eof-value t)))))
+ (read-preserving-whitespace stream eof-error-p eof-value t))))
;;; Return NIL or a list with one thing, depending.
;;;
;;; for functions that want comments to return so that they can look
-;;; past them. Assumes char is not whitespace.
+;;; past them. We assume CHAR is not whitespace.
(defun read-maybe-nothing (stream char)
(let ((retval (multiple-value-list
(funcall (get-cmt-entry char *readtable*) stream char))))
(if retval (rplacd retval nil))))
-(defun read (&optional (stream *standard-input*) (eof-error-p t)
- (eof-value ()) (recursivep ()))
+(defun read (&optional (stream *standard-input*)
+ (eof-error-p t)
+ (eof-value ())
+ (recursivep ()))
#!+sb-doc
- "Reads in the next object in the stream, which defaults to
- *standard-input*. For details see the I/O chapter of
- the manual."
- (prog1
- (read-preserving-whitespace stream eof-error-p eof-value recursivep)
- (let ((whitechar (read-char stream nil *eof-object*)))
- (if (and (not (eofp whitechar))
- (or (not (whitespacep whitechar))
- recursivep))
- (unread-char whitechar stream)))))
+ "Read the next Lisp value from STREAM, and return it."
+ (let ((result (read-preserving-whitespace stream
+ eof-error-p
+ eof-value
+ recursivep)))
+ ;; (This function generally discards trailing whitespace. If you
+ ;; don't want to discard trailing whitespace, call
+ ;; 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)
+ (whitespacep next-char))
+ (unread-char next-char stream))))
+ result))
;;; (This is a COMMON-LISP exported symbol.)
(defun read-delimited-list (endchar &optional
(input-stream *standard-input*)
recursive-p)
#!+sb-doc
- "Reads objects from input-stream until the next character after an
- object's representation is endchar. A list of those objects read
- is returned."
+ "Read Lisp values from INPUT-STREAM until the next character after a
+ value's representation is ENDCHAR, and return the objects as a list."
(declare (ignore recursive-p))
(do ((char (flush-whitespace input-stream)
(flush-whitespace input-stream))
\f
;;;; basic readmacro definitions
;;;;
-;;;; Large, hairy subsets of readmacro definitions (backquotes and sharp
-;;;; macros) are not here, but in their own source files.
+;;;; Some large, hairy subsets of readmacro definitions (backquotes
+;;;; and sharp macros) are not here, but in their own source files.
(defun read-quote (stream ignore)
(declare (ignore ignore))
(defun read-comment (stream ignore)
(declare (ignore ignore))
(let ((stream (in-synonym-of stream)))
- (if (lisp-stream-p stream)
+ (if (ansi-stream-p stream)
(prepare-for-fast-read-char stream
(do ((char (fast-read-char nil nil)
(fast-read-char nil nil)))
;; For a very long string, this could end up bloating the read buffer.
(reset-read-buffer)
(let ((stream (in-synonym-of stream)))
- (if (lisp-stream-p stream)
+ (if (ansi-stream-p stream)
(prepare-for-fast-read-char stream
(do ((char (fast-read-char t) (fast-read-char t)))
((char= char closech)
(defvar *read-suppress* nil
#!+sb-doc
- "Suppresses most interpreting of the reader when T")
+ "Suppress most interpreting in the reader when T.")
(defvar *read-base* 10
#!+sb-doc
- "The radix that Lisp reads numbers in.")
+ "the radix that Lisp reads numbers in")
(declaim (type (integer 2 36) *read-base*))
;;; Modify the read buffer according to READTABLE-CASE, ignoring
(t (go SYMBOL)))
SYMBOL ; not a dot, dots, or number
(let ((stream (in-synonym-of stream)))
- (if (lisp-stream-p stream)
+ (if (ansi-stream-p stream)
(prepare-for-fast-read-char stream
(prog ()
SYMBOL-LOOP
(when (digit-char-p sub-char)
(error "SUB-CHAR must not be a decimal digit: ~S" sub-char))
(let* ((sub-char (char-upcase sub-char))
+ (rt (or rt *standard-readtable*))
(dpair (find disp-char (dispatch-tables rt)
:test #'char= :key #'car)))
(if dpair
(defun get-dispatch-macro-character (disp-char sub-char
&optional (rt *readtable*))
#!+sb-doc
- "Returns the macro character function for sub-char under disp-char
- or nil if there is no associated function."
+ "Return the macro character function for SUB-CHAR under DISP-CHAR
+ or NIL if there is no associated function."
(unless (digit-char-p sub-char)
(let* ((sub-char (char-upcase sub-char))
(rt (or rt *standard-readtable*))
projects / sbcl.git / blobdiff