+char-attr-delimiter+
(if (digit-char-p ,char (max *read-base* 10))
(if (digit-char-p ,char *read-base*)
- +char-attr-constituent-digit+
+ (if (= att +char-attr-constituent-expt+)
+ +char-attr-constituent-digit-or-expt+
+ +char-attr-constituent-digit+)
+char-attr-constituent-decimal-digit+)
att))))
\f
(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)
(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))
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))
(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
(#.+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)))
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
(unless char (go RETURN-SYMBOL))
- (case (char-class3 char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go LEFTDECIMALDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT))
+ (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))
(unless char (return (let ((*read-base* 10))
(make-integer))))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go RIGHTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+ (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
(#.+char-attr-constituent-expt+ (go EXPONENT))
(#.+char-attr-delimiter+
(unread-char char stream)
(setq char (read-char stream nil nil))
(unless char (return (make-float stream)))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go RIGHTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+ (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
(#.+char-attr-constituent-expt+ (go EXPONENT))
(#.+char-attr-delimiter+
(unread-char char stream)
(setq char (read-char stream nil nil))
(unless char (go RETURN-SYMBOL))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go RIGHTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+ (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(setq char (read-char stream nil nil))
(unless char (%reader-error stream "dot context error"))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go RIGHTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+ (#.+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))
(setq possibly-float t)
(case (char-class char attribute-table)
(#.+char-attr-constituent-sign+ (go EXPTSIGN))
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go EXPTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+ (#.+char-attr-constituent-digit+ (go EXPTDIGIT))
(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(setq char (read-char stream nil nil))
(unless char (go RETURN-SYMBOL))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go EXPTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+ (#.+char-attr-constituent-digit+ (go EXPTDIGIT))
(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(setq char (read-char stream nil nil))
(unless char (return (make-float stream)))
(case (char-class char attribute-table)
- (#.+char-attr-constituent-digit+ (if possibly-float
- (go EXPTDIGIT)
- (go SYMBOL)))
- (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+ (#.+char-attr-constituent-digit+ (go EXPTDIGIT))
(#.+char-attr-delimiter+
(unread-char char stream)
(return (make-float stream)))