reader: fix number->string
case insensitivity
For example, `1+2I` and `+INF.FI` should parse as numbers. Closes #2660
This commit is contained in:
parent
236e2768f8
commit
39fe53f5d5
|
@ -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)
|
||||
|
|
|
@ -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)]))
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in New Issue
Block a user