X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=d6305149b758d6ea79a5f69f4ddced0f763eeccb;hb=aa61c7571b33b86981301f34d3acdb66666f53a3;hp=32661aa9f7920902b66b394788567cc888f6532f;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 32661aa..d630514 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -164,6 +164,8 @@ (mapcar #'(lambda (pair) (cons (car pair) (copy-seq (cdr pair)))) (dispatch-tables really-from-readtable))) + (setf (readtable-case to-readtable) + (readtable-case from-readtable)) to-readtable)) (defun set-syntax-from-char (to-char from-char &optional @@ -203,7 +205,7 @@ (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*))) @@ -223,7 +225,7 @@ ;; 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))) @@ -374,10 +376,9 @@ (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*))) @@ -388,42 +389,46 @@ (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)) @@ -433,8 +438,8 @@ ;;;; 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)) @@ -443,7 +448,7 @@ (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))) @@ -506,7 +511,7 @@ ;; 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) @@ -632,11 +637,11 @@ (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 @@ -874,7 +879,7 @@ (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 @@ -1273,7 +1278,8 @@ (error "The dispatch character ~S already exists." char)) (t (setf (dispatch-tables rt) - (push (cons char (make-char-dispatch-table)) dalist)))))) + (push (cons char (make-char-dispatch-table)) dalist))))) + t) (defun set-dispatch-macro-character (disp-char sub-char function &optional (rt *readtable*)) @@ -1296,7 +1302,7 @@ (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 + "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))