X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=7fc9cd1b832b9d7b3c71cd427a5fdc596ee524f4;hb=ec066d84dd46611428943d152749b3891a3f4b7c;hp=afb69097eccf74acd00905ec7259c63b2bad1ee6;hpb=b4831dc945c0754b3ba77881e67c8ea4d0a3d905;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index afb6909..7fc9cd1 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -256,9 +256,9 @@
 		   +char-attr-whitespace+)
 	       (done-with-fast-read-char)
 	       char)))
-	;; fundamental-stream
+	;; CLOS stream
 	(do ((attribute-table (character-attribute-table *readtable*))
-	     (char (stream-read-char stream) (stream-read-char stream)))
+	     (char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof)
 		 (/= (the fixnum (aref attribute-table (char-code char)))
 		     +char-attr-whitespace+))
@@ -483,8 +483,8 @@
 		     (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)))
+	;; 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))
@@ -547,13 +547,13 @@
 	       (done-with-fast-read-char))
 	    (if (escapep 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))
+	    (setq char (read-char stream nil :eof))
 	    (if (eq char :eof)
 		(error 'end-of-file :stream stream)))
 	  (ouch-read-buffer char))))
@@ -658,8 +658,10 @@
 	 +char-attr-delimiter+
 	 (if (digit-char-p ,char (max *read-base* 10))
 	     (if (digit-char-p ,char *read-base*)
-		 +char-attr-constituent-digit+
-		 +char-attr-constituent+)
+		 (if (= att +char-attr-constituent-expt+)
+		     +char-attr-constituent-digit-or-expt+
+		     +char-attr-constituent-digit+)
+		 +char-attr-constituent-decimal-digit+)
 	     att))))
 
 ;;;; token fetching
@@ -735,7 +737,9 @@
 	(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)
@@ -743,6 +747,10 @@
       (case (char-class3 char attribute-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-package-delimiter+ (go COLON))
@@ -757,6 +765,10 @@
 	    possibly-float t)
       (case (char-class3 char attribute-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-package-delimiter+ (go COLON))
@@ -767,12 +779,43 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
+      (setq was-possibly-float possibly-float)
       (case (char-class3 char attribute-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-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-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)))
@@ -782,6 +825,23 @@
 	(#.+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-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-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
+	(t (go SYMBOL)))
      MIDDLEDOT ; saw "[sign] {digit}+ dot"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
@@ -798,7 +858,7 @@
 	(#.+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)))
@@ -838,6 +898,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
+      (setq possibly-float t)
       (case (char-class char attribute-table)
 	(#.+char-attr-constituent-sign+ (go EXPTSIGN))
 	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
@@ -927,15 +988,15 @@
 		 (#.+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)
+	       (#.+char-attr-delimiter+ (unread-char char stream)
 			    (go RETURN-SYMBOL))
 	       (#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	       (#.+char-attr-package-delimiter+ (go COLON))
@@ -1431,7 +1492,7 @@
 	       `(error 'simple-parse-error
 		       :format-control ,format-control
 		       :format-arguments (list string))))
-    (with-array-data ((string string)
+    (with-array-data ((string string :offset-var offset)
 		      (start start)
 		      (end (%check-vector-sequence-bounds string start end)))
       (let ((index (do ((i start (1+ i)))
@@ -1460,10 +1521,10 @@
 			found-digit t))
 		 (junk-allowed (return nil))
 		 ((whitespacep char)
-		  (do ((jndex (1+ index) (1+ jndex)))
-		      ((= jndex end))
-		    (declare (fixnum jndex))
-		    (unless (whitespacep (char string jndex))
+                  (loop
+                   (incf index)
+                   (when (= index end) (return))
+                   (unless (whitespacep (char string index))
 		      (parse-error "junk in string ~S")))
 		  (return nil))
 		 (t
@@ -1475,7 +1536,7 @@
 	     (if junk-allowed
 		 nil
 		 (parse-error "no digits in string ~S")))
-	 index)))))
+	 (- index offset))))))
 
 ;;;; reader initialization code