reader: fix number->string case insensitivity

For example, `1+2I` and `+INF.FI` should parse as numbers.

Closes #2660
This commit is contained in:
Matthew Flatt 2019-05-18 12:17:39 -04:00
parent 236e2768f8
commit 39fe53f5d5
3 changed files with 79 additions and 41 deletions

View File

@ -269,23 +269,24 @@
(let* ([pair (car l)]
[v (car pair)]
[s (cadr pair)])
(cond
[(memq v '(X DBZ NOE))
(err/rt-test (readstr s) exn:fail:read?)
(test #f string->number s)
(test #t string? (string->number s 10 'read))]
[v
(test v readstr s)
(test (if (symbol? v) #f v) string->number s)
(test (if (symbol? v) #f v) string->number s 10 'read)]
[else
(test (string->symbol s) readstr s)
(test #f string->number s)
(test #f string->number s 10 'read)
(unless (regexp-match "#" s)
(err/rt-test (readstr (string-append "#d" s)) exn:fail:read?)
(test #f string->number (string-append "#d" s))
(test #t string? (string->number (string-append "#d" s) 10 'read)))]))
(for ([s (in-list (list s (string-upcase s)))])
(cond
[(memq v '(X DBZ NOE))
(err/rt-test (readstr s) exn:fail:read?)
(test #f string->number s)
(test #t string? (string->number s 10 'read))]
[v
(test v readstr s)
(test (if (symbol? v) #f v) string->number s)
(test (if (symbol? v) #f v) string->number s 10 'read)]
[else
(test (string->symbol s) readstr s)
(test #f string->number s)
(test #f string->number s 10 'read)
(unless (regexp-match "#" s)
(err/rt-test (readstr (string-append "#d" s)) exn:fail:read?)
(test #f string->number (string-append "#d" s))
(test #t string? (string->number (string-append "#d" s) 10 'read)))])))
(loop (cdr l))))
(define (make-exn:fail:read:eof?/span start span)

View File

@ -403,7 +403,8 @@
(cond
[(eqv? (string-ref s start) #\#)
(trim-number s (fx+ 2 start) end)]
[(eqv? (string-ref s (fx- end 1)) #\i)
[(let ([c (string-ref s (fx- end 1))])
(or (eqv? c #\i) (eqv? c #\I)))
(trim-number s start (fx- end 1))]
[else (substring s start end)]))
@ -519,7 +520,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i)
[(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else
(bad-digit c s state)]))
@ -564,7 +565,7 @@
(maybe (get-n)
(lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i)
[(#\i #\I)
(maybe (get-n)
(lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -595,7 +596,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i)
[(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else
(bad-digit c s state)]))
@ -612,7 +613,7 @@
(read-signed-exponent sgn sgn-n exp sgn2 #f s (fx+ 1 start) end radix state)]
[(#\. #\# #\/ #\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T)
(bad-misplaced c s state)]
[(#\i)
[(#\i #\I)
(if (state-has-first-half? state)
(fail state "empty exponent `~.a`" s)
(bad-misplaced "i" s state))]
@ -645,7 +646,7 @@
(maybe (get-n)
(lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i)
[(#\i #\I)
(maybe (get-n)
(lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -658,7 +659,7 @@
s start end
[[(#\f #\F)
(#\.)
(#\0 #\f #\t)]
(#\0 #\f #\t #\F #\T)]
(define n (if (negative? sgn) -inf.0 +inf.0))
(define new-state (set-exactness-by-char state (string-ref s (fx+ start 2))
#:override? #t))
@ -669,7 +670,7 @@
(read-imag c2 sgn n (if (eqv? c2 #\+) +1 -1) s (fx+ 4 start) end radix new-state)]
[(#\@)
(read-polar sgn n s (fx+ 4 start) end radix new-state)]
[(#\i)
[(#\i #\I)
(finish-imaginary sgn n s (fx+ 4 start) end new-state)]
[else
(bad-digit c s state)])]
@ -683,7 +684,7 @@
[[(#\a #\A)
(#\n #\N)
(#\.)
(#\0 #\f #\t)]
(#\0 #\f #\t #\F #\T)]
(define n +nan.0)
(define new-state (set-exactness-by-char state (string-ref s (fx+ start 3))
#:override? #t))
@ -694,7 +695,7 @@
(read-imag c2 1 n (if (eqv? c2 #\+) +1 -1) s (fx+ 5 start) end radix new-state)]
[(#\@)
(read-polar 1 n s (fx+ 5 start) end radix new-state)]
[(#\i)
[(#\i #\I)
(finish-imaginary +1 n s (fx+ 5 start) end new-state)]
[else
(bad-digit c s state)])]
@ -734,7 +735,7 @@
(maybe (get-n)
(lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i)
[(#\i #\I)
(maybe (get-n)
(lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -759,7 +760,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i)
[(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else
(bad-digit c s state)]))

View File

@ -54639,7 +54639,8 @@ static const char *startup_source =
"(begin"
"(if(eqv?(string-ref s_0 start_0) '#\\#)"
"(let-values()(trim-number s_0(fx+ 2 start_0) end_0))"
"(if(eqv?(string-ref s_0(fx- end_0 1)) '#\\i)"
"(if(let-values(((c_0)(string-ref s_0(fx- end_0 1))))"
"(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0(eqv? c_0 '#\\I))))"
"(let-values()(trim-number s_0 start_0(fx- end_0 1)))"
"(let-values()(substring s_0 start_0 end_0)))))))"
"(define-values"
@ -54982,7 +54983,10 @@ static const char *startup_source =
" state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))"
"(define-values"
@ -55114,7 +55118,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0"
"((lambda(n_1)(read-polar sgn_0 n_1 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55221,7 +55228,10 @@ static const char *startup_source =
" state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))"
"(define-values"
@ -55292,7 +55302,8 @@ static const char *startup_source =
" or-part_14"
" #f))))))))))))))))))))))))))))))"
"(let-values()(bad-misplaced c_0 s_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(if(state-has-first-half? state_0)"
"(if(eq?(state->convert-mode state_0) 'must-read)"
@ -55410,7 +55421,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0"
"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55437,7 +55451,13 @@ static const char *startup_source =
"(let-values(((start+n_2)(fx+ start_0(+(+ 0 1) 1))))"
"(let-values(((var_2)(if(fx= start+n_2 end_0) 'eof(string-ref s_0 start+n_2))))"
"(let-values(((tmp_2) var_2))"
"(if(if(equal? tmp_2 '#\\0) #t(if(equal? tmp_2 '#\\f) #t(equal? tmp_2 '#\\t)))"
"(if(if(equal? tmp_2 '#\\0)"
" #t"
"(if(equal? tmp_2 '#\\f)"
" #t"
"(if(equal? tmp_2 '#\\t)"
" #t"
"(if(equal? tmp_2 '#\\F) #t(equal? tmp_2 '#\\T)))))"
"(let-values()"
"(let-values()"
"(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))"
@ -55490,7 +55510,10 @@ static const char *startup_source =
" radix_0"
" new-state_0))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))"
"(if or-part_0 or-part_0 #f))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c2_0 '#\\I)))"
"(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(finish-imaginary"
" sgn_0"
@ -55532,7 +55555,11 @@ static const char *startup_source =
"(let-values(((tmp_3) var_3))"
"(if(if(equal? tmp_3 '#\\0)"
" #t"
"(if(equal? tmp_3 '#\\f) #t(equal? tmp_3 '#\\t)))"
"(if(equal? tmp_3 '#\\f)"
" #t"
"(if(equal? tmp_3 '#\\t)"
" #t"
"(if(equal? tmp_3 '#\\F) #t(equal? tmp_3 '#\\T)))))"
"(let-values()"
"(let-values()"
"(let-values(((n_0) +nan.0))"
@ -55594,7 +55621,10 @@ static const char *startup_source =
" radix_0"
" new-state_0))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))"
"(if or-part_0 or-part_0 #f))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c2_0 '#\\I)))"
"(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(finish-imaginary"
" 1"
@ -55736,7 +55766,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0"
"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()"
"(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55827,7 +55860,10 @@ static const char *startup_source =
" state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0)))))))))))))))"
"(define-values"