X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=86b223e07e3a4e7ec41fa52e47441d5f7b96244d;hb=c01ff86b012283af04641a02e45f066aa7cdb10c;hp=a8081ae273795aecf467cc7f4c90d98e89f94f89;hpb=069ca63d16c8de8742fc78b927dfa7b79a27c96d;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index a8081ae..86b223e 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -118,13 +118,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))
@@ -133,45 +133,51 @@
   ;; 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*
+(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
 
@@ -211,17 +217,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
@@ -232,10 +246,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)
@@ -311,14 +324,17 @@
 	     (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-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)
@@ -334,7 +350,6 @@
 	((= 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)))))
 
 ;;;; implementation of the read buffer
@@ -510,16 +525,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))))
-	;; CLOS stream
-	(do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
-	    ((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))
 
@@ -533,9 +554,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
@@ -556,7 +578,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)))
@@ -566,7 +590,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)
@@ -579,14 +604,14 @@
 	  (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)))
@@ -616,7 +641,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)
@@ -633,7 +658,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"))
@@ -645,8 +670,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))))))
@@ -662,9 +687,13 @@
                   (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.
@@ -673,13 +702,16 @@
                   (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
@@ -689,23 +721,28 @@
                   (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*)
 		 (if (= att +char-attr-constituent-expt+)
 		     +char-attr-constituent-digit-or-expt+
 		     +char-attr-constituent-digit+)
-		 +char-attr-constituent-decimal-digit+)
-	     att))))
+		 +char-attr-constituent-decimal-digit+))
+	    ((= att +char-attr-invalid+)
+	     (%reader-error stream "invalid constituent"))
+	    (t att))))))
 
 ;;;; token fetching
 
@@ -796,9 +833,10 @@
 	 (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"
@@ -814,7 +852,7 @@
 	 (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))
@@ -845,7 +883,7 @@
 					     (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)))
@@ -865,7 +903,7 @@
 					     (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)))
@@ -882,7 +920,7 @@
 					 (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)))
@@ -898,7 +936,7 @@
 	 (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)))
@@ -912,7 +950,7 @@
 	(#.+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)))
@@ -923,7 +961,7 @@
       (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"
@@ -934,7 +972,7 @@
 	(#.+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)))
@@ -947,7 +985,7 @@
 	(#.+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)))
@@ -958,7 +996,7 @@
       (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)))
@@ -971,7 +1009,7 @@
 	(#.+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)))
@@ -982,7 +1020,7 @@
       (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)))
@@ -995,7 +1033,7 @@
 	(#.+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)))
@@ -1008,7 +1046,7 @@
 	(#.+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)))
@@ -1022,8 +1060,8 @@
 	       (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))
@@ -1039,25 +1077,25 @@
 	     (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)))
@@ -1065,14 +1103,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-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)))
@@ -1103,7 +1141,7 @@
 	 (%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)))
@@ -1118,7 +1156,7 @@
 	 (%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
@@ -1461,21 +1499,21 @@
    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*))
+      (push (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-string stream)
+	    (coerce string '(simple-array character (*))))
       (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))
+		  (- (string-input-stream-current stream) offset))
 	(push stream *read-from-string-spares*)))))
 
 ;;;; PARSE-INTEGER
@@ -1540,7 +1578,7 @@
 
 (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))