0.8.19.7:
authorChristophe Rhodes <csr21@cam.ac.uk>
Mon, 31 Jan 2005 14:04:22 +0000 (14:04 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Mon, 31 Jan 2005 14:04:22 +0000 (14:04 +0000)
SET-SYNTAX-FROM-CHAR fix
... SET-SYNTAX-FROM-CHAR now copies the dispatch table if necessary.
Customizeable reader fixes (PFD SYNTAX.FOO ansi-tests)
... Better delineation between character syntax and character
constituent trait;
... rename SECONDARY-ATTRIBUTE to CONSTITUENT-TRAIT;
... renumber +char-attr-multiple-escape+ to below
+char-attr-consituent+;
... rename ESCAPE to SINGLE-ESCAPE;
... in token reader helper macros CHAR-CLASS<n>, get
CONSTITUENT-TRAIT only if the character is a constituent.

NEWS
src/code/reader.lisp
src/code/readtable.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index edb6a78..a36521c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
   * fixed bugs 19 and 317: fixed-format floating point printing is
     more accurate.  This also fixes a bug reported by Adam Warner
     related to the ~@F format directive.
+  * fixed bug: SET-SYNTAX-FROM-CHAR correctly shallow-copies a
+    dispatch table if the from-char is a dispatch macro character.
   * fixed some bugs related to Unicode integration:
     ** portions of multibyte characters at the end of buffers for
        character-based file input are correctly transferred to the
@@ -15,6 +17,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** Space, Tab, Linefeed, Return and Page have the invalid
        secondary constituent character trait.
+    ** SET-SYNTAX-FROM-CHAR correctly copies multiple-escape character
+       syntax.
 
 changes in sbcl-0.8.19 relative to sbcl-0.8.18:
   * new port: SBCL now works in native 64-bit mode on x86-64/Linux
index de0ada0..4eb3400 100644 (file)
   (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))
   ;; depends on actual attribute numbering above.
   `(<= (get-cat-entry ,char ,rt) +char-attr-terminating-macro+))
 \f
-;;;; 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*
+(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+)
-  (!set-secondary-attribute #\Space +char-attr-invalid+)
-  (!set-secondary-attribute #\Newline +char-attr-invalid+)
+    (!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-secondary-attribute (code-char c) +char-attr-invalid+)))
+    (!set-constituent-trait (code-char c) +char-attr-invalid+)))
                   
-(defmacro get-secondary-attribute (char)
-  `(elt *secondary-attribute-table*
-       (char-code ,char)))
+(defmacro get-constituent-trait (char)
+  `(if (typep ,char 'base-char)
+       (elt *constituent-trait-table* (char-code ,char))
+       +char-attr-constituent+))
 \f
 ;;;; readtable operations
 
   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
    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)
       (whitespaceify (code-char form-feed-char-code))
       (whitespaceify (code-char return-char-code)))
 
-    (set-cat-entry #\\ +char-attr-escape+)
+    (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)
     (set-macro-character #\' #'read-quote)
        ((= 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)))))
 \f
 ;;;; implementation of the read buffer
          (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)))
        ;; 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)
+         (when (single-escape-p char)
            (setq char (read-char stream nil :eof))
            (if (eq char :eof)
                (error 'end-of-file :stream stream)))
              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)
                ((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"))
                 (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))))))
      (declare (fixnum att))
      (cond
        ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+)
-       ((= att +char-attr-invalid+) 
-       (%reader-error stream "invalid constituent"))
-       (t att))))
+       ((< 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.
      (declare (fixnum att))
      (cond
        ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+)
-       ((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))))
+       ((< 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
                   (aref ,attarray (char-code ,char))
                   (gethash ,char ,atthash +char-attr-constituent+))))
      (declare (fixnum att))
-     (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
        ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+)
-       ((digit-char-p ,char (max *read-base* 10))
-       (if (digit-char-p ,char *read-base*)
-           (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))))
+       ((< 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*)
+                (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))))))
 \f
 ;;;; token fetching
 
         (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 "invalid constituent"))
         (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))
                                             (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)))
                                             (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)))
                                         (go SYMBOL))
        (#.+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)))
         (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)))
        (#.+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)))
       (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"
        (#.+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)))
        (#.+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)))
       (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)))
        (#.+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)))
       (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)))
        (#.+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)))
        (#.+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)))
               (setq char (fast-read-char nil nil))
               (unless char (go RETURN-SYMBOL))
               (case (char-class char attribute-array attribute-hash-table)
-                (#.+char-attr-escape+ (done-with-fast-read-char)
-                                      (go ESCAPE))
+                (#.+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))
             (setq char (read-char stream nil :eof))
             (when (eq char :eof) (go RETURN-SYMBOL))
             (case (char-class char attribute-array attribute-hash-table)
-              (#.+char-attr-escape+ (go ESCAPE))
+              (#.+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-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)))
       (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-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)))
         (%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)))
         (%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
 
 (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))
index 5f712e4..615bc98 100644 (file)
 ;;; when changing them.
 (def!constant +char-attr-whitespace+ 0)
 (def!constant +char-attr-terminating-macro+ 1)
-(def!constant +char-attr-escape+ 2)
-(def!constant +char-attr-constituent+ 3)
-(def!constant +char-attr-constituent-dot+ 4)
-(def!constant +char-attr-constituent-expt+ 5)
-(def!constant +char-attr-constituent-slash+ 6)
-(def!constant +char-attr-constituent-digit+ 7)
-(def!constant +char-attr-constituent-sign+ 8)
+(def!constant +char-attr-single-escape+ 2)
+(def!constant +char-attr-multiple-escape+ 3)
+(def!constant +char-attr-constituent+ 4)
+(def!constant +char-attr-constituent-dot+ 5)
+(def!constant +char-attr-constituent-expt+ 6)
+(def!constant +char-attr-constituent-slash+ 7)
+(def!constant +char-attr-constituent-digit+ 8)
+(def!constant +char-attr-constituent-sign+ 9)
 ;;; the following two are not static but depend on *READ-BASE*.
 ;;; DECIMAL-DIGIT is for characters being digits in base 10 but not in
 ;;; base *READ-BASE* (which is therefore perforce smaller than 10);
 ;;; DIGIT-OR-EXPT is for characters being both exponent markers and
 ;;; digits in base *READ-BASE* (which is therefore perforce larger
 ;;; than 10).  -- CSR, 2004-03-16
-(def!constant +char-attr-constituent-decimal-digit+ 9)
-(def!constant +char-attr-constituent-digit-or-expt+ 10)
+(def!constant +char-attr-constituent-decimal-digit+ 10)
+(def!constant +char-attr-constituent-digit-or-expt+ 11)
 
-(def!constant +char-attr-multiple-escape+ 11)
 (def!constant +char-attr-package-delimiter+ 12)
 (def!constant +char-attr-invalid+ 13)
 (def!constant +char-attr-delimiter+ 14) ; (a fake for READ-UNQUALIFIED-TOKEN)
index f443461..5072090 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.19.6"
+"0.8.19.7"