diff --git a/src/lib/reader.rls b/src/lib/reader.rls index 262c92f..1019aa5 100644 --- a/src/lib/reader.rls +++ b/src/lib/reader.rls @@ -26,10 +26,6 @@ [(eq? current-char #\[) (next-char) (read-list #\])] - [(or (eq? current-char #\-) - (eq? current-char #\+) - (decimal-char? current-char)) - (read-number)] [(eq? current-char #\") (read-string)] [(eq? current-char #\|) @@ -49,7 +45,7 @@ (list 'unquote-splicing (read-one-value))) (list 'unquote (read-one-value)))] [(symbol-char? current-char) - (read-symbol)] + (read-symbol #f string->number-or-symbol)] [else (syntax-error)])) (list current-read-eof-handler (lambda () (syntax-error)))))) @@ -192,45 +188,83 @@ accum))))]) (if neg? (fix- pos-val) pos-val)))) - (define (read-number) - (let ([negative (cond [(eq? current-char #\-) (next-char) #t] - [(eq? current-char #\+) (next-char) #f] - [else #f])]) - (unless (decimal-char? current-char) (syntax-error)) - (let ([radix (if (eq? current-char #\0) - (begin - (next-char) - (cond [(memq current-char '(#\X #\x)) (next-char) 16] - [(memq current-char '(#\B #\b)) (next-char) 2] - [(decimal-char? current-char) 8] - [else 10])) - 10)]) - (let ([num (let iter ([num 0]) - (if (alphanumeric-char? current-char) - (let ([digit (digit->integer current-char)]) - (if (fix< digit radix) - (begin - (next-char) - (iter (fix+ (fix* num radix) digit))) - num)) - num))]) - (if (or (not (eq? radix 10)) - (not (memq current-char '(#\. #\E #\e)))) - (if negative (fix- num) num) - (let ([flt (make-float num)]) - (when (eq? current-char #\.) - (next-char) - (let iter ([pv (if negative -0.1 0.1)]) - (if (decimal-char? current-char) - (let ([digit (make-float (digit->integer current-char))]) - (set! flt (float+ flt (float* digit pv))) - (next-char) - (iter (float/ pv 10))) - (values)))) - (when (memq current-char '(#\E #\e)) - (next-char) - (set! flt (float* flt (pow 10.0 (make-float (read-fixnum 10)))))) - (if negative (float- flt) flt))))))) + (define (parse-number str) + (define (end? n) (fix>= n (byte-string-size str))) + (define (char n) (byte-string-ref str n)) + (define (next n) (fix+ n 1)) + (let/cc return + (define (fail) (return #f)) + (define (start n) + (cond + [(end? n) (fail)] + [(eq? (char n) #\+) (digits (next n) #f)] + [(eq? (char n) #\-) (digits (next n) #t)] + [#t (digits n #f)])) + (define (digits n neg) + (cond + [(end? n) (fail)] + [(eq? (char n) #\.) (fpnum* (next n) neg)] + [(eq? (char n) #\0) (leading-zero (next n) neg)] + [(decimal-char? (char n)) (decimal n neg 0)])) + (define (leading-zero n neg) + (cond + [(end? n) 0] + [(eq? (char n) #\.) (fpnum (next n) neg 0.0)] + [(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg 0.0)] + [(memq (char n) '(#\X #\x)) (radix (next n) neg 16 0)] + [(memq (char n) '(#\B #\b)) (radix (next n) neg 2 0)] + [(octal-char? (char n)) (radix n neg 8 0)])) + (define (radix n neg rad accum) + (cond + [(end? n) (if neg (fix-neg accum) accum)] + [(hex-char? (char n)) (let ([int (digit->integer (char n))]) + (when (fix>= int rad) (fail)) + (radix (next n) neg rad (fix+ (fix* accum rad) int)))])) + (define (decimal n neg accum) + (cond + [(end? n) (if neg (fix-neg accum) accum)] + [(eq? (char n) #\.) (fpnum (next n) neg (make-float accum))] + [(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg (make-float accum))] + [(decimal-char? (char n)) (let ([int (digit->integer (char n))]) + (decimal (next n) neg + (fix+ (fix* accum 10) int)))])) + (define (fpnum* n neg) ; follows ".", "+.", or "-."; needs a digit for float + (cond + [(end? n) (fail)] + [(decimal-char? (char n)) (let ([int (digit->integer (char n))]) + (fpnum (next n) neg + (float* (make-float int) 0.1) + (float/ 0.1 10.0)))])) + (define (fpnum n neg accum [pv 0.1]) + (cond + [(end? n) (if neg (float-neg accum) accum)] + [(memq (char n) '(#\E #\e)) (fpnum-exp (next n) neg accum)] + [(decimal-char? (char n)) (let ([int (digit->integer (char n))]) + (fpnum (next n) neg + (float+ accum (float* (make-float int) pv)) + (float/ pv 10.0)))])) + (define (fpnum-exp n neg accum) + (let ([signed-accum (if neg (float-neg accum) accum)]) + (cond + [(end? n) (fail)] + [(eq? (char n) #\+) (fpnum-exp-digit+ (next n) signed-accum #f)] + [(eq? (char n) #\-) (fpnum-exp-digit+ (next n) signed-accum #t)] + [#t (fpnum-exp-digit+ n signed-accum #f)]))) + (define (fpnum-exp-digit+ n accum neg) + (cond + [(end? n) (fail)] + [(decimal-char? (char n)) (let ([int (digit->integer (char n))]) + (fpnum-exp-digit* (next n) accum neg int))])) + (define (fpnum-exp-digit* n accum neg expon) + (cond + [(end? n) ((if neg float/ float*) + accum + (pow 10.0 (make-float expon)))] + [(decimal-char? (char n)) (let ([int (digit->integer (char n))]) + (fpnum-exp-digit* (next n) accum neg + (fix+ (fix* expon 10) int)))])) + (start 0) + (fail))) (define (read-box) (make-box (read-one-value))) @@ -388,6 +422,10 @@ [(byte-string= name "RUBOUT") 127] [else (syntax-error)])))))) + (define (string->number-or-symbol str) + (or (parse-number str) + (string->symbol str))) + (define (read-symbol [quoted? #f] [convert-fn string->symbol]) (define (read-chars) (cond @@ -410,8 +448,7 @@ (cons ch (read-chars)))] [else '()])) - (let* ([chars (read-chars)]) - (convert-fn (list->string chars)))) + (convert-fn (list->string (read-chars)))) (define (read-keyword) (if (eq? current-char #\|) @@ -490,8 +527,8 @@ (define (symbol-char? ch) (or (alphanumeric-char? ch) (memq? ch '(#\! #\$ #\% #\& #\* #\+ - #\- #\/ #\: #\< #\= #\> - #\? #\@ #\^ #\_ #\~)))) + #\- #\. #\/ #\: #\< #\= + #\> #\? #\@ #\^ #\_ #\~)))) (define (digit->integer ch) (cond