X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=cbdb50dbea24d48451311d89200dc8a4a175201d;hb=dc33d6a6b84f8338e603759cec8e25da29055d50;hp=3ec10599c7f9623014002b964d73bacba4ad257a;hpb=72826ded21763d6885dd8a34552cb57edfb1cf26;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 3ec1059..cbdb50d 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -61,21 +61,29 @@ (defmacro get-cat-entry (char rt) ;; KLUDGE: Only give this side-effect-free args. ;; FIXME: should probably become inline function - `(elt (character-attribute-table ,rt) - (char-code ,char))) + `(if (typep ,char 'base-char) + (elt (character-attribute-array ,rt) (char-code ,char)) + (gethash ,char (character-attribute-hash-table ,rt) + +char-attr-constituent+))) (defun set-cat-entry (char newvalue &optional (rt *readtable*)) - (setf (elt (character-attribute-table rt) - (char-code char)) - newvalue)) + (if (typep char 'base-char) + (setf (elt (character-attribute-array rt) (char-code char)) newvalue) + ;; FIXME: could REMHASH if we're setting to + ;; +CHAR-ATTR-CONSTITUENT+ + (setf (gethash char (character-attribute-hash-table rt)) newvalue))) ;;; the value actually stored in the character macro table. As per ;;; ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, this can ;;; be either a function or NIL. (eval-when (:compile-toplevel :execute) (sb!xc:defmacro get-raw-cmt-entry (char readtable) - `(svref (character-macro-table ,readtable) - (char-code ,char)))) + `(if (typep ,char 'base-char) + (svref (character-macro-array ,readtable) (char-code ,char)) + ;; Note: DEFAULT here is NIL, not #'UNDEFINED-MACRO-CHAR, so + ;; that everything above the base-char range is a non-macro + ;; constituent by default. + (gethash ,char (character-macro-hash-table ,readtable) nil)))) ;;; the value represented by whatever is stored in the character macro ;;; table. As per ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, @@ -87,10 +95,13 @@ #'read-token))) (defun set-cmt-entry (char new-value-designator &optional (rt *readtable*)) - (setf (svref (character-macro-table rt) - (char-code char)) + (if (typep char 'base-char) + (setf (svref (character-macro-array rt) (char-code char)) + (and new-value-designator + (%coerce-callable-to-fun new-value-designator))) + (setf (gethash char (character-macro-hash-table rt)) (and new-value-designator - (%coerce-callable-to-fun new-value-designator)))) + (%coerce-callable-to-fun new-value-designator))))) (defun undefined-macro-char (stream char) (unless *read-suppress* @@ -108,13 +119,13 @@ (test-attribute char +char-attr-whitespace+ rt)) (defmacro constituentp (char &optional (rt '*readtable*)) - `(>= (get-cat-entry ,char ,rt) +char-attr-constituent+)) + `(test-attribute ,char +char-attr-constituent+ ,rt)) (defmacro terminating-macrop (char &optional (rt '*readtable*)) `(test-attribute ,char +char-attr-terminating-macro+ ,rt)) -(defmacro escapep (char &optional (rt '*readtable*)) - `(test-attribute ,char +char-attr-escape+ ,rt)) +(defmacro single-escape-p (char &optional (rt '*readtable*)) + `(test-attribute ,char +char-attr-single-escape+ ,rt)) (defmacro multiple-escape-p (char &optional (rt '*readtable*)) `(test-attribute ,char +char-attr-multiple-escape+ ,rt)) @@ -123,59 +134,77 @@ ;; depends on actual attribute numbering above. `(<= (get-cat-entry ,char ,rt) +char-attr-terminating-macro+)) -;;;; secondary attribute table +;;;; constituent traits (see ANSI 2.1.4.2) ;;; There are a number of "secondary" attributes which are constant ;;; properties of characters (as long as they are constituents). -(defvar *secondary-attribute-table*) -(declaim (type attribute-table *secondary-attribute-table*)) +(defvar *constituent-trait-table*) +(declaim (type attribute-table *constituent-trait-table*)) -(defun !set-secondary-attribute (char attribute) - (setf (elt *secondary-attribute-table* (char-code char)) - attribute)) +(defun !set-constituent-trait (char trait) + (aver (typep char 'base-char)) + (setf (elt *constituent-trait-table* (char-code char)) + trait)) -(defun !cold-init-secondary-attribute-table () - (setq *secondary-attribute-table* - (make-array char-code-limit :element-type '(unsigned-byte 8) +(defun !cold-init-constituent-trait-table () + (setq *constituent-trait-table* + (make-array base-char-code-limit :element-type '(unsigned-byte 8) :initial-element +char-attr-constituent+)) - (!set-secondary-attribute #\: +char-attr-package-delimiter+) - (!set-secondary-attribute #\| +char-attr-multiple-escape+) ; |) [for EMACS] - (!set-secondary-attribute #\. +char-attr-constituent-dot+) - (!set-secondary-attribute #\+ +char-attr-constituent-sign+) - (!set-secondary-attribute #\- +char-attr-constituent-sign+) - (!set-secondary-attribute #\/ +char-attr-constituent-slash+) + (!set-constituent-trait #\: +char-attr-package-delimiter+) + (!set-constituent-trait #\. +char-attr-constituent-dot+) + (!set-constituent-trait #\+ +char-attr-constituent-sign+) + (!set-constituent-trait #\- +char-attr-constituent-sign+) + (!set-constituent-trait #\/ +char-attr-constituent-slash+) (do ((i (char-code #\0) (1+ i))) ((> i (char-code #\9))) - (!set-secondary-attribute (code-char i) +char-attr-constituent-digit+)) - (!set-secondary-attribute #\E +char-attr-constituent-expt+) - (!set-secondary-attribute #\F +char-attr-constituent-expt+) - (!set-secondary-attribute #\D +char-attr-constituent-expt+) - (!set-secondary-attribute #\S +char-attr-constituent-expt+) - (!set-secondary-attribute #\L +char-attr-constituent-expt+) - (!set-secondary-attribute #\e +char-attr-constituent-expt+) - (!set-secondary-attribute #\f +char-attr-constituent-expt+) - (!set-secondary-attribute #\d +char-attr-constituent-expt+) - (!set-secondary-attribute #\s +char-attr-constituent-expt+) - (!set-secondary-attribute #\l +char-attr-constituent-expt+)) - -(defmacro get-secondary-attribute (char) - `(elt *secondary-attribute-table* - (char-code ,char))) + (!set-constituent-trait (code-char i) +char-attr-constituent-digit+)) + (!set-constituent-trait #\E +char-attr-constituent-expt+) + (!set-constituent-trait #\F +char-attr-constituent-expt+) + (!set-constituent-trait #\D +char-attr-constituent-expt+) + (!set-constituent-trait #\S +char-attr-constituent-expt+) + (!set-constituent-trait #\L +char-attr-constituent-expt+) + (!set-constituent-trait #\e +char-attr-constituent-expt+) + (!set-constituent-trait #\f +char-attr-constituent-expt+) + (!set-constituent-trait #\d +char-attr-constituent-expt+) + (!set-constituent-trait #\s +char-attr-constituent-expt+) + (!set-constituent-trait #\l +char-attr-constituent-expt+) + (!set-constituent-trait #\Space +char-attr-invalid+) + (!set-constituent-trait #\Newline +char-attr-invalid+) + (dolist (c (list backspace-char-code tab-char-code form-feed-char-code + return-char-code rubout-char-code)) + (!set-constituent-trait (code-char c) +char-attr-invalid+))) + +(defmacro get-constituent-trait (char) + `(if (typep ,char 'base-char) + (elt *constituent-trait-table* (char-code ,char)) + +char-attr-constituent+)) ;;;; readtable operations +(defun shallow-replace/eql-hash-table (to from) + (maphash (lambda (k v) (setf (gethash k to) v)) from)) + (defun copy-readtable (&optional (from-readtable *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 really-to-readtable) - (character-macro-table really-from-readtable)) + (replace (character-attribute-array really-to-readtable) + (character-attribute-array really-from-readtable)) + (shallow-replace/eql-hash-table + (character-attribute-hash-table really-to-readtable) + (character-attribute-hash-table really-from-readtable)) + (replace (character-macro-array really-to-readtable) + (character-macro-array really-from-readtable)) + (shallow-replace/eql-hash-table + (character-macro-hash-table really-to-readtable) + (character-macro-hash-table really-from-readtable)) (setf (dispatch-tables really-to-readtable) - (mapcar (lambda (pair) (cons (car pair) - (copy-seq (cdr pair)))) + (mapcar (lambda (pair) + (cons (car pair) + (let ((table (make-hash-table))) + (shallow-replace/eql-hash-table table (cdr pair)) + table))) (dispatch-tables really-from-readtable))) (setf (readtable-case really-to-readtable) (readtable-case really-from-readtable)) @@ -189,17 +218,25 @@ optional readtable (defaults to the current readtable). The FROM-TABLE defaults to the standard Lisp readtable when NIL." (let ((really-from-readtable (or from-readtable *standard-readtable*))) - ;; Copy FROM-CHAR entries to TO-CHAR entries, but make sure that if - ;; FROM-CHAR is a constituent you don't copy non-movable secondary - ;; attributes (constituent types), and that said attributes magically - ;; appear if you transform a non-constituent to a constituent. - (let ((att (get-cat-entry from-char really-from-readtable))) - (if (constituentp from-char really-from-readtable) - (setq att (get-secondary-attribute to-char))) + (let ((att (get-cat-entry from-char really-from-readtable)) + (mac (get-raw-cmt-entry from-char really-from-readtable)) + (from-dpair (find from-char (dispatch-tables really-from-readtable) + :test #'char= :key #'car)) + (to-dpair (find to-char (dispatch-tables to-readtable) + :test #'char= :key #'car))) (set-cat-entry to-char att to-readtable) - (set-cmt-entry to-char - (get-raw-cmt-entry from-char really-from-readtable) - to-readtable))) + (set-cmt-entry to-char mac to-readtable) + (when from-dpair + (cond + (to-dpair + (let ((table (cdr to-dpair))) + (clrhash table) + (shallow-replace/eql-hash-table table (cdr from-dpair)))) + (t + (let ((pair (cons to-char (make-hash-table)))) + (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair)) + (setf (dispatch-tables to-readtable) + (push pair (dispatch-tables to-readtable))))))))) t) (defun set-macro-character (char function &optional @@ -210,10 +247,9 @@ by the reader. The NON-TERMINATINGP flag can be used to make the macro character non-terminating, i.e. embeddable in a symbol name." (let ((designated-readtable (or readtable *standard-readtable*))) - (set-cat-entry char - (if non-terminatingp - (get-secondary-attribute char) - +char-attr-terminating-macro+) + (set-cat-entry char (if non-terminatingp + +char-attr-constituent+ + +char-attr-terminating-macro+) designated-readtable) (set-cmt-entry char function designated-readtable) t)) ; (ANSI-specified return value) @@ -250,17 +286,29 @@ (let ((stream (in-synonym-of stream))) (if (ansi-stream-p stream) (prepare-for-fast-read-char stream - (do ((attribute-table (character-attribute-table *readtable*)) + (do ((attribute-array (character-attribute-array *readtable*)) + (attribute-hash-table + (character-attribute-hash-table *readtable*)) (char (fast-read-char t) (fast-read-char t))) - ((/= (the fixnum (aref attribute-table (char-code char))) + ((/= (the fixnum + (if (typep char 'base-char) + (aref attribute-array (char-code char)) + (gethash char attribute-hash-table + +char-attr-constituent+))) +char-attr-whitespace+) (done-with-fast-read-char) char))) - ;; fundamental-stream - (do ((attribute-table (character-attribute-table *readtable*)) - (char (stream-read-char stream) (stream-read-char stream))) + ;; CLOS stream + (do ((attribute-array (character-attribute-array *readtable*)) + (attribute-hash-table + (character-attribute-hash-table *readtable*)) + (char (read-char stream nil :eof) (read-char stream nil :eof))) ((or (eq char :eof) - (/= (the fixnum (aref attribute-table (char-code char))) + (/= (the fixnum + (if (typep char 'base-char) + (aref attribute-array (char-code char)) + (gethash char attribute-hash-table + +char-attr-constituent+))) +char-attr-whitespace+)) (if (eq char :eof) (error 'end-of-file :stream stream) @@ -276,15 +324,19 @@ (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 #\space) + (whitespaceify #\Newline) + (whitespaceify #\Space) (whitespaceify (code-char form-feed-char-code)) (whitespaceify (code-char return-char-code))) - (set-cat-entry #\\ +char-attr-escape+) - (set-cmt-entry #\\ #'read-token) + (set-cat-entry #\\ +char-attr-single-escape+) + (set-cmt-entry #\\ nil) + + (set-cat-entry #\| +char-attr-multiple-escape+) + (set-cmt-entry #\| nil) ;; Easy macro-character definitions are in this source file. (set-macro-character #\" #'read-string) @@ -298,11 +350,10 @@ ;; all constituents (do ((ichar 0 (1+ ichar)) (char)) - ((= ichar #O200)) + ((= ichar base-char-code-limit)) (setq char (code-char ichar)) (when (constituentp char *standard-readtable*) - (set-cat-entry char (get-secondary-attribute char)) - (set-cmt-entry char nil))))) + (set-cmt-entry char nil))))) ;;;; implementation of the read buffer @@ -326,11 +377,6 @@ ;; *INCH-PTR* always points to next char to read. (setq *inch-ptr* 0))) -(defun !cold-init-read-buffer () - (setq *read-buffer* (make-string 512)) ; initial bufsize - (setq *read-buffer-length* 512) - (reset-read-buffer)) - ;;; FIXME I removed "THE FIXNUM"'s from OUCH-READ-BUFFER and ;;; OUCH-UNREAD-BUFFER, check to make sure that Python really is smart ;;; enough to make good code without them. And while I'm at it, @@ -380,6 +426,18 @@ (defun read-buffer-to-string () (subseq *read-buffer* 0 *ouch-ptr*)) + +(defmacro with-reader ((&optional recursive-p) &body body) + #!+sb-doc + "If RECURSIVE-P is NIL, bind *READER-BUFFER* and its subservient +variables to allow for nested and thread safe reading." + `(if ,recursive-p + (progn ,@body) + (let* ((*read-buffer* (make-string 128)) + (*read-buffer-length* 128) + (*ouch-ptr* 0) + (*inch-ptr* 0)) + ,@body))) ;;;; READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST, and READ @@ -406,19 +464,21 @@ "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)) - (read-preserving-whitespace stream eof-error-p eof-value t)))) + ;; 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))))))))) + (with-reader () + (let ((*sharp-equal-alist* nil)) + (read-preserving-whitespace stream eof-error-p eof-value t))))) ;;; Return NIL or a list with one thing, depending. ;;; @@ -441,9 +501,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) @@ -458,12 +518,12 @@ #!+sb-doc "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)) - (retlist ())) - ((char= char endchar) (nreverse retlist)) - (setq retlist (nconc (read-maybe-nothing input-stream char) retlist)))) + (with-reader (recursive-p) + (do ((char (flush-whitespace input-stream) + (flush-whitespace input-stream)) + (retlist ())) + ((char= char endchar) (unless *read-suppress* (nreverse retlist))) + (setq retlist (nconc (read-maybe-nothing input-stream char) retlist))))) ;;;; basic readmacro definitions ;;;; @@ -476,16 +536,22 @@ (defun read-comment (stream ignore) (declare (ignore ignore)) - (let ((stream (in-synonym-of stream))) - (if (ansi-stream-p stream) - (prepare-for-fast-read-char stream - (do ((char (fast-read-char nil nil) - (fast-read-char nil nil))) - ((or (not char) (char= char #\newline)) - (done-with-fast-read-char)))) - ;; FUNDAMENTAL-STREAM - (do ((char (stream-read-char stream) (stream-read-char stream))) - ((or (eq char :eof) (char= char #\newline)))))) + (handler-bind + ((character-decoding-error + #'(lambda (decoding-error) + (declare (ignorable decoding-error)) + (style-warn "Character decoding error in a ;-comment at position ~A reading source file ~A, resyncing." (file-position stream) stream) + (invoke-restart 'attempt-resync)))) + (let ((stream (in-synonym-of stream))) + (if (ansi-stream-p stream) + (prepare-for-fast-read-char stream + (do ((char (fast-read-char nil nil) + (fast-read-char nil nil))) + ((or (not char) (char= char #\newline)) + (done-with-fast-read-char)))) + ;; CLOS stream + (do ((char (read-char stream nil :eof) (read-char stream nil :eof))) + ((or (eq char :eof) (char= char #\newline))))))) ;; Don't return anything. (values)) @@ -499,9 +565,10 @@ (let ((nextchar (read-char stream t))) (cond ((token-delimiterp nextchar) (cond ((eq listtail thelist) - (%reader-error - stream - "Nothing appears before . in list.")) + (unless *read-suppress* + (%reader-error + stream + "Nothing appears before . in list."))) ((whitespacep nextchar) (setq nextchar (flush-whitespace stream)))) (rplacd listtail @@ -522,7 +589,9 @@ (let ((lastobj ())) (do ((char firstchar (flush-whitespace stream))) ((char= char #\) ) - (%reader-error stream "Nothing appears after . in list.")) + (if *read-suppress* + (return-from read-after-dot nil) + (%reader-error stream "Nothing appears after . in list."))) ;; See whether there's something there. (setq lastobj (read-maybe-nothing stream char)) (when lastobj (return t))) @@ -532,7 +601,8 @@ (flush-whitespace stream))) ((char= lastchar #\) ) lastobj) ;success! ;; Try reading virtual whitespace. - (if (read-maybe-nothing stream lastchar) + (if (and (read-maybe-nothing stream lastchar) + (not *read-suppress*)) (%reader-error stream "More than one object follows . in list."))))) (defun read-string (stream closech) @@ -545,15 +615,15 @@ (do ((char (fast-read-char t) (fast-read-char t))) ((char= char closech) (done-with-fast-read-char)) - (if (escapep char) (setq char (fast-read-char t))) + (if (single-escape-p char) (setq char (fast-read-char t))) (ouch-read-buffer char))) - ;; FUNDAMENTAL-STREAM - (do ((char (stream-read-char stream) (stream-read-char stream))) + ;; CLOS stream + (do ((char (read-char stream nil :eof) (read-char stream nil :eof))) ((or (eq char :eof) (char= char closech)) (if (eq char :eof) (error 'end-of-file :stream stream))) - (when (escapep char) - (setq char (stream-read-char stream)) + (when (single-escape-p char) + (setq char (read-char stream nil :eof)) (if (eq char :eof) (error 'end-of-file :stream stream))) (ouch-read-buffer char)))) @@ -582,7 +652,7 @@ t) (t nil)) (values escapes colon)) - (cond ((escapep char) + (cond ((single-escape-p char) ;; It can't be a number, even if it's 1\23. ;; Read next char here, so it won't be casified. (push *ouch-ptr* escapes) @@ -599,7 +669,7 @@ ((eofp ch) (reader-eof-error stream "inside extended token")) ((multiple-escape-p ch) (return)) - ((escapep ch) + ((single-escape-p ch) (let ((nextchar (read-char stream nil *eof-object*))) (cond ((eofp nextchar) (reader-eof-error stream "after escape character")) @@ -611,8 +681,8 @@ (ouch-read-buffer ch)))))) (t (when (and (constituentp char) - (eql (get-secondary-attribute char) - +char-attr-package-delimiter+) + (eql (get-constituent-trait char) + +char-attr-package-delimiter+) (not colon)) (setq colon *ouch-ptr*)) (ouch-read-buffer char)))))) @@ -620,47 +690,70 @@ ;;;; character classes ;;; Return the character class for CHAR. -(defmacro char-class (char attable) - `(let ((att (aref ,attable (char-code ,char)))) +;;; +;;; FIXME: why aren't these ATT-getting forms using GET-CAT-ENTRY? +;;; Because we've cached the readtable tables? +(defmacro char-class (char attarray atthash) + `(let ((att (if (typep ,char 'base-char) + (aref ,attarray (char-code ,char)) + (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - att))) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((< att +char-attr-constituent+) att) + (t (setf att (get-constituent-trait ,char)) + (if (= att +char-attr-invalid+) + (%reader-error stream "invalid constituent") + att))))) ;;; Return the character class for CHAR, which might be part of a ;;; rational number. -(defmacro char-class2 (char attable) - `(let ((att (aref ,attable (char-code ,char)))) +(defmacro char-class2 (char attarray atthash) + `(let ((att (if (typep ,char 'base-char) + (aref ,attarray (char-code ,char)) + (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - (if (digit-char-p ,char *read-base*) - +char-attr-constituent-digit+ - (if (= att +char-attr-constituent-digit+) - +char-attr-constituent+ - att))))) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((< att +char-attr-constituent+) att) + (t (setf att (get-constituent-trait ,char)) + (cond + ((digit-char-p ,char *read-base*) +char-attr-constituent-digit+) + ((= att +char-attr-constituent-digit+) +char-attr-constituent+) + ((= att +char-attr-invalid+) + (%reader-error stream "invalid constituent")) + (t att)))))) ;;; Return the character class for a char which might be part of a ;;; rational or floating number. (Assume that it is a digit if it ;;; could be.) -(defmacro char-class3 (char attable) - `(let ((att (aref ,attable (char-code ,char)))) +(defmacro char-class3 (char attarray atthash) + `(let ((att (if (typep ,char 'base-char) + (aref ,attarray (char-code ,char)) + (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if possibly-rational - (setq possibly-rational - (or (digit-char-p ,char *read-base*) - (= att +char-attr-constituent-slash+)))) - (if possibly-float - (setq possibly-float - (or (digit-char-p ,char 10) - (= att +char-attr-constituent-dot+)))) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - (if (digit-char-p ,char (max *read-base* 10)) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((< att +char-attr-constituent+) att) + (t (setf att (get-constituent-trait ,char)) + (when possibly-rational + (setq possibly-rational + (or (digit-char-p ,char *read-base*) + (= att +char-attr-constituent-slash+)))) + (when possibly-float + (setq possibly-float + (or (digit-char-p ,char 10) + (= att +char-attr-constituent-dot+)))) + (cond + ((digit-char-p ,char (max *read-base* 10)) (if (digit-char-p ,char *read-base*) - +char-attr-constituent-digit+ - +char-attr-constituent+) - att)))) + (if (= att +char-attr-constituent-expt+) + +char-attr-constituent-digit-or-expt+ + +char-attr-constituent-digit+) + +char-attr-constituent-decimal-digit+)) + ((= att +char-attr-invalid+) + (%reader-error stream "invalid constituent")) + (t att)))))) ;;;; token fetching @@ -731,22 +824,30 @@ (when *read-suppress* (internal-read-extended-token stream firstchar nil) (return-from read-token nil)) - (let ((attribute-table (character-attribute-table *readtable*)) + (let ((attribute-array (character-attribute-array *readtable*)) + (attribute-hash-table (character-attribute-hash-table *readtable*)) (package-designator nil) (colons 0) (possibly-rational t) + (seen-digit-or-expt nil) (possibly-float t) + (was-possibly-float nil) (escapes ()) (seen-multiple-escapes nil)) (reset-read-buffer) (prog ((char firstchar)) - (case (char-class3 char attribute-table) + (case (char-class3 char attribute-array attribute-hash-table) (#.+char-attr-constituent-sign+ (go SIGN)) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-digit-or-expt+ + (setq seen-digit-or-expt t) + (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT)) (#.+char-attr-constituent-dot+ (go FRONTDOT)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) + (#.+char-attr-invalid+ (%reader-error stream "invalid constituent")) ;; can't have eof, whitespace, or terminating macro as first char! (t (go SYMBOL))) SIGN ; saw "sign" @@ -755,10 +856,14 @@ (unless char (go RETURN-SYMBOL)) (setq possibly-rational t possibly-float t) - (case (char-class3 char attribute-table) + (case (char-class3 char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-digit-or-expt+ + (setq seen-digit-or-expt t) + (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT)) (#.+char-attr-constituent-dot+ (go SIGNDOT)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) @@ -767,18 +872,66 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (make-integer))) - (case (char-class3 char attribute-table) + (setq was-possibly-float possibly-float) + (case (char-class3 char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (if possibly-float + (go LEFTDECIMALDIGIT) + (go SYMBOL))) (#.+char-attr-constituent-dot+ (if possibly-float (go MIDDLEDOT) (go SYMBOL))) - (#.+char-attr-constituent-expt+ (go EXPONENT)) + (#.+char-attr-constituent-digit-or-expt+ + (if (or seen-digit-or-expt (not was-possibly-float)) + (progn (setq seen-digit-or-expt t) (go LEFTDIGIT)) + (progn (setq seen-digit-or-expt t) (go LEFTDIGIT-OR-EXPT)))) + (#.+char-attr-constituent-expt+ + (if was-possibly-float + (go EXPONENT) + (go SYMBOL))) (#.+char-attr-constituent-slash+ (if possibly-rational (go RATIO) (go SYMBOL))) (#.+char-attr-delimiter+ (unread-char char stream) (return (make-integer))) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) + (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) + (#.+char-attr-package-delimiter+ (go COLON)) + (t (go SYMBOL))) + LEFTDIGIT-OR-EXPT + (ouch-read-buffer char) + (setq char (read-char stream nil nil)) + (unless char (return (make-integer))) + (case (char-class3 char attribute-array attribute-hash-table) + (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (bug "impossible!")) + (#.+char-attr-constituent-dot+ (go SYMBOL)) + (#.+char-attr-constituent-digit-or-expt+ (go LEFTDIGIT)) + (#.+char-attr-constituent-expt+ (go SYMBOL)) + (#.+char-attr-constituent-sign+ (go EXPTSIGN)) + (#.+char-attr-constituent-slash+ (if possibly-rational + (go RATIO) + (go SYMBOL))) + (#.+char-attr-delimiter+ (unread-char char stream) + (return (make-integer))) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) + (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) + (#.+char-attr-package-delimiter+ (go COLON)) + (t (go SYMBOL))) + LEFTDECIMALDIGIT ; saw "[sign] {decimal-digit}+" + (aver possibly-float) + (ouch-read-buffer char) + (setq char (read-char stream nil nil)) + (unless char (go RETURN-SYMBOL)) + (case (char-class char attribute-array attribute-hash-table) + (#.+char-attr-constituent-digit+ (go LEFTDECIMALDIGIT)) + (#.+char-attr-constituent-dot+ (go MIDDLEDOT)) + (#.+char-attr-constituent-expt+ (go EXPONENT)) + (#.+char-attr-constituent-slash+ (aver (not possibly-rational)) + (go SYMBOL)) + (#.+char-attr-delimiter+ (unread-char char stream) + (go RETURN-SYMBOL)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -787,28 +940,28 @@ (setq char (read-char stream nil nil)) (unless char (return (let ((*read-base* 10)) (make-integer)))) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-expt+ (go EXPONENT)) (#.+char-attr-delimiter+ (unread-char char stream) (return (let ((*read-base* 10)) (make-integer)))) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) - RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+" + RIGHTDIGIT ; saw "[sign] {decimal-digit}* dot {digit}+" (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (make-float stream))) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-expt+ (go EXPONENT)) (#.+char-attr-delimiter+ (unread-char char stream) (return (make-float stream))) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -816,21 +969,21 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (t (go SYMBOL))) FRONTDOT ; saw "dot" (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (%reader-error stream "dot context error")) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-dot+ (go DOTS)) (#.+char-attr-delimiter+ (%reader-error stream "dot context error")) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -838,11 +991,12 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) + (setq possibly-float t) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-sign+ (go EXPTSIGN)) (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -850,10 +1004,10 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -861,12 +1015,12 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (make-float stream))) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (return (make-float stream))) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -874,10 +1028,10 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class2 char attribute-table) + (case (char-class2 char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RATIODIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -885,12 +1039,12 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (make-ratio stream))) - (case (char-class2 char attribute-table) + (case (char-class2 char attribute-array attribute-hash-table) (#.+char-attr-constituent-digit+ (go RATIODIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (return (make-ratio stream))) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -898,12 +1052,12 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (%reader-error stream "too many dots")) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-constituent-dot+ (go DOTS)) (#.+char-attr-delimiter+ (unread-char char stream) (%reader-error stream "too many dots")) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -916,9 +1070,9 @@ (ouch-read-buffer char) (setq char (fast-read-char nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) - (#.+char-attr-escape+ (done-with-fast-read-char) - (go ESCAPE)) + (case (char-class char attribute-array attribute-hash-table) + (#.+char-attr-single-escape+ (done-with-fast-read-char) + (go SINGLE-ESCAPE)) (#.+char-attr-delimiter+ (done-with-fast-read-char) (unread-char char stream) (go RETURN-SYMBOL)) @@ -927,32 +1081,32 @@ (#.+char-attr-package-delimiter+ (done-with-fast-read-char) (go COLON)) (t (go SYMBOL-LOOP))))) - ;; fundamental-stream + ;; CLOS stream (prog () SYMBOL-LOOP (ouch-read-buffer char) - (setq char (stream-read-char stream)) + (setq char (read-char stream nil :eof)) (when (eq char :eof) (go RETURN-SYMBOL)) - (case (char-class char attribute-table) - (#.+char-attr-escape+ (go ESCAPE)) - (#.+char-attr-delimiter+ (stream-unread-char stream char) + (case (char-class char attribute-array attribute-hash-table) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) + (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL-LOOP)))))) - ESCAPE ; saw an escape - ;; Don't put the escape in the read buffer. + SINGLE-ESCAPE ; saw a single-escape + ;; Don't put the escape character in the read buffer. ;; READ-NEXT CHAR, put in buffer (no case conversion). (let ((nextchar (read-char stream nil nil))) (unless nextchar - (reader-eof-error stream "after escape character")) + (reader-eof-error stream "after single-escape character")) (push *ouch-ptr* escapes) (ouch-read-buffer nextchar)) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -960,14 +1114,14 @@ (setq seen-multiple-escapes t) (do ((char (read-char stream t) (read-char stream t))) ((multiple-escape-p char)) - (if (escapep char) (setq char (read-char stream t))) + (if (single-escape-p char) (setq char (read-char stream t))) (push *ouch-ptr* escapes) (ouch-read-buffer char)) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) @@ -992,13 +1146,13 @@ (setq escapes ()) (setq char (read-char stream nil nil)) (unless char (reader-eof-error stream "after reading a colon")) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-delimiter+ (unread-char char stream) (%reader-error stream "illegal terminating character after a colon: ~S" char)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go INTERN)) (t (go SYMBOL))) @@ -1007,13 +1161,13 @@ (setq char (read-char stream nil nil)) (unless char (reader-eof-error stream "after reading a colon")) - (case (char-class char attribute-table) + (case (char-class char attribute-array attribute-hash-table) (#.+char-attr-delimiter+ (unread-char char stream) (%reader-error stream "illegal terminating character after a colon: ~S" char)) - (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-single-escape+ (go SINGLE-ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (%reader-error stream @@ -1211,46 +1365,10 @@ (#\F 'single-float) (#\D 'double-float) (#\L 'long-float))) - num) - ;; Raymond Toy writes: We need to watch out if the - ;; exponent is too small or too large. We add enough to - ;; EXPONENT to make it within range and scale NUMBER - ;; appropriately. This should avoid any unnecessary - ;; underflow or overflow problems. - (multiple-value-bind (min-expo max-expo) - ;; FIXME: These forms are broken w.r.t. - ;; cross-compilation portability, as the - ;; cross-compiler will call the host's LOG function - ;; while attempting to constant-fold. Maybe some sort - ;; of load-time-form magic could be used instead? - (case float-format - ((short-float single-float) - (values - (log sb!xc:least-positive-normalized-single-float 10f0) - (log sb!xc:most-positive-single-float 10f0))) - ((double-float #!-long-float long-float) - (values - (log sb!xc:least-positive-normalized-double-float 10d0) - (log sb!xc:most-positive-double-float 10d0))) - #!+long-float - (long-float - (values - (log sb!xc:least-positive-normalized-long-float 10l0) - (log sb!xc:most-positive-long-float 10l0)))) - (let ((correction (cond ((<= exponent min-expo) - (ceiling (- min-expo exponent))) - ((>= exponent max-expo) - (floor (- max-expo exponent))) - (t - 0)))) - (incf exponent correction) - (setf number (/ number (expt 10 correction))) - (setq num (make-float-aux number divisor float-format stream)) - (setq num (* num (expt 10 exponent))) - (return-from make-float (if negative-fraction - (- num) - num)))))) - ;; should never happen + (result (make-float-aux (* (expt 10 exponent) number) + divisor float-format stream))) + (return-from make-float + (if negative-fraction (- result) result)))) (t (bug "bad fallthrough in floating point reader"))))) (defun make-float-aux (number divisor float-format stream) @@ -1296,7 +1414,7 @@ ;;;; cruft for dispatch macros (defun make-char-dispatch-table () - (make-array char-code-limit :initial-element #'dispatch-char-error)) + (make-hash-table)) (defun dispatch-char-error (stream sub-char ignore) (declare (ignore ignore)) @@ -1335,9 +1453,7 @@ (dpair (find disp-char (dispatch-tables rt) :test #'char= :key #'car))) (if dpair - (setf (elt (the simple-vector (cdr dpair)) - (char-code sub-char)) - (coerce function 'function)) + (setf (gethash sub-char (cdr dpair)) (coerce function 'function)) (error "~S is not a dispatch char." disp-char)))) (defun get-dispatch-macro-character (disp-char sub-char @@ -1350,14 +1466,7 @@ (dpair (find disp-char (dispatch-tables rt) :test #'char= :key #'car))) (if dpair - (let ((dispatch-fun (elt (the simple-vector (cdr dpair)) - (char-code sub-char)))) - ;; Digits are also initialized in a dispatch table to - ;; #'dispatch-char-error; READ-DISPATCH-CHAR handles them - ;; separately. - CSR, 2002-04-12 - (if (eq dispatch-fun #'dispatch-char-error) - nil - dispatch-fun)) + (values (gethash sub-char (cdr dpair))) (error "~S is not a dispatch char." disp-char)))) (defun read-dispatch-char (stream char) @@ -1381,19 +1490,13 @@ :test #'char= :key #'car))) (if dpair (funcall (the function - (elt (the simple-vector (cdr dpair)) - (char-code sub-char))) + (gethash sub-char (cdr dpair) #'dispatch-char-error)) stream sub-char (if numargp numarg nil)) (%reader-error stream "no dispatch table for dispatch char"))))) ;;;; READ-FROM-STRING -;;; FIXME: Is it really worth keeping this pool? -(defvar *read-from-string-spares* () - #!+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 @@ -1401,23 +1504,14 @@ and the lisp object built by the reader is returned. Macro chars will take effect." (declare (string string)) - - (with-array-data ((string string) + (with-array-data ((string string :offset-var offset) (start start) (end (%check-vector-sequence-bounds string start end))) - (unless *read-from-string-spares* - (push (internal-make-string-input-stream "" 0 0) - *read-from-string-spares*)) - (let ((stream (pop *read-from-string-spares*))) - (setf (string-input-stream-string stream) string) - (setf (string-input-stream-current stream) start) - (setf (string-input-stream-end stream) end) - (unwind-protect - (values (if preserve-whitespace - (read-preserving-whitespace stream eof-error-p eof-value) - (read stream eof-error-p eof-value)) - (string-input-stream-current stream)) - (push stream *read-from-string-spares*))))) + (let ((stream (make-string-input-stream string start end))) + (values (if preserve-whitespace + (read-preserving-whitespace stream eof-error-p eof-value) + (read stream eof-error-p eof-value)) + (- (string-input-stream-current stream) offset))))) ;;;; PARSE-INTEGER @@ -1480,8 +1574,7 @@ ;;;; reader initialization code (defun !reader-cold-init () - (!cold-init-read-buffer) - (!cold-init-secondary-attribute-table) + (!cold-init-constituent-trait-table) (!cold-init-standard-readtable) ;; FIXME: This was commented out, but should probably be restored. #+nil (!cold-init-integer-reader))