read and string->number: fix large-exponent cutoff and # in fractions

The cutoff point for large-magnitude exponents (forcing a +inf,0 or
0.0 result) was wrong for bases below 10, and its did not take into
account the mantissa magnitude for some number forms.

Also, change the parsing of numbers with both `/` and `#` to be more
consistent. A `#` anywhere in the number should trigger an inexact
teratment 0 in the denominator (so inifnity or not-a-number instead of
divide-by-zero), even if `#` is only in the numerator. Meanwhile,
setting `read-decimal-as-inexact` to #f should count `#`s as `0`s and
not trigger inexact treatment.
This commit is contained in:
Matthew Flatt 2019-01-16 04:52:30 -07:00
parent 345339990f
commit be19996953
6 changed files with 52 additions and 9 deletions

View File

@ -2466,6 +2466,8 @@
(test 0.1 string->number (string-append "0." (make-string 400 #\0) "1e400")) (test 0.1 string->number (string-append "0." (make-string 400 #\0) "1e400"))
(test 0.1 string->number (string-append "0." (make-string 8000 #\0) "1e8000")) (test 0.1 string->number (string-append "0." (make-string 8000 #\0) "1e8000"))
(test 1.0e-101 string->number (string-append "0." (make-string 8000 #\0) "1e7900")) (test 1.0e-101 string->number (string-append "0." (make-string 8000 #\0) "1e7900"))
(test 1.0e-101 string->number (string-append "1/1" (make-string 8000 #\0) "1e7900"))
(test 1.0e-101 string->number (string-append "1/1" (make-string 8000 #\0) "#e7900"))
(test +inf.0 string->number (string-append "0." (make-string 400 #\0) "1e1000")) (test +inf.0 string->number (string-append "0." (make-string 400 #\0) "1e1000"))
(test -inf.0 string->number (string-append "-0." (make-string 400 #\0) "1e1000")) (test -inf.0 string->number (string-append "-0." (make-string 400 #\0) "1e1000"))
(test +inf.0 string->number (string-append "0." (make-string 8000 #\0) "1e8400")) (test +inf.0 string->number (string-append "0." (make-string 8000 #\0) "1e8400"))
@ -2474,6 +2476,18 @@
(test #t extflonum? (string->extfl-number (string-append "-0." (make-string 8000 #\0) "1t8400"))) (test #t extflonum? (string->extfl-number (string-append "-0." (make-string 8000 #\0) "1t8400")))
(test #f string->number (string-append "-0." (make-string 8000 #\0) "9e10000") 8) (test #f string->number (string-append "-0." (make-string 8000 #\0) "9e10000") 8)
(test #f string->number (string-append "0." (make-string 8000 #\0) "e1008") 8) (test #f string->number (string-append "0." (make-string 8000 #\0) "e1008") 8)
(test 1.333602886575971e+241 string->number "#b10e1100100000")
(test 2.999393627791262e-241 string->number "#b10e-1100100000")
(test 3.334007216439927e+240 string->number "#b1/10e1100100000")
(test 1.0 string->number (string-append "#i1" (make-string 8000 #\0) "/" "1" (make-string 8000 #\0)))
(test 10.0 string->number (string-append "1" (make-string 8000 #\0) "#/" "1" (make-string 8000 #\0)))
(test 1.0 string->number (string-append "1" (make-string 8000 #\0) "#/" "1" (make-string 8000 #\0) "#"))
(test 1.0+3.0i string->number (string-append "#i1" (make-string 8000 #\0) "/" "1" (make-string 8000 #\0) "+3.0i"))
(test 10.0+3.0i string->number (string-append "#i1" (make-string 8000 #\0) "/" "1" (make-string 7998 #\0) "#+3.0i"))
(test 1.0+0.0i string->number (string-append "#i1" (make-string 8000 #\0) "/" "1" (make-string 8000 #\0) "@0"))
(test 10.0+0.0i string->number (string-append "#i1" (make-string 8000 #\0) "/" "1" (make-string 7998 #\0) "#@0"))
(test 1 string->number (string-append "1" (make-string 8000 #\0) "/" "1" (make-string 8000 #\0) "@0"))
(test 10.0 string->number (string-append "1" (make-string 8000 #\0) "/" "1" (make-string 7998 #\0) "#@0"))
(test #t andmap (lambda (x) (and (>= x 0) (< x 10))) (map random '(10 10 10 10))) (test #t andmap (lambda (x) (and (>= x 0) (< x 10))) (map random '(10 10 10 10)))
(test (void) random-seed 5) (test (void) random-seed 5)

View File

@ -120,6 +120,8 @@
(-inf.0 "-1/0#") (-inf.0 "-1/0#")
(DBZ "1#/0") (DBZ "1#/0")
(DBZ "-1#/0") (DBZ "-1#/0")
(+inf.0 "#i1#/0")
(-inf.0 "#i-1#/0")
(NOE "#e+inf.0") (NOE "#e+inf.0")
(NOE "#e-inf.0") (NOE "#e-inf.0")
(NOE "#e+nan.0") (NOE "#e+nan.0")

View File

@ -110,6 +110,23 @@
(err/rt-test (readstr "#fals") exn:fail:read:eof?) (err/rt-test (readstr "#fals") exn:fail:read:eof?)
(err/rt-test (readstr "#falser") exn:fail:read?)) (err/rt-test (readstr "#falser") exn:fail:read?))
(parameterize ([read-decimal-as-inexact #f])
(test 1 readstr "1.0")
(test 100000 readstr "1e5")
(test 100000 readstr "1#e4")
(test 10 readstr "1#")
(test 1/2 readstr "1#/20")
(test 1/2 readstr "10/2#")
(test 1/2 readstr "1#/2#")
(test 1/2 string->number "1#/2#")
(test 10+3i readstr "1#+3i")
(test 1+30i readstr "1+3#i")
(err/rt-test (readstr "1#/0") exn:fail:read?)
(err/rt-test (readstr "1/0#") exn:fail:read?)
(err/rt-test (readstr "1#/0#") exn:fail:read?)
(test #f string->number "1#/0")
(test #f string->number "1/0#"))
(test (integer->char 0) readstr "#\\nul") (test (integer->char 0) readstr "#\\nul")
(test (integer->char 0) readstr "#\\Nul") (test (integer->char 0) readstr "#\\Nul")
(test (integer->char 0) readstr "#\\NuL") (test (integer->char 0) readstr "#\\NuL")

View File

@ -488,7 +488,10 @@
[(and (eq? convert-mode 'number-or-false) get-extfl?) [(and (eq? convert-mode 'number-or-false) get-extfl?)
#f] #f]
[(and (or (eq? exactness 'inexact) (eq? exactness 'decimal-as-inexact)) [(and (or (eq? exactness 'inexact) (eq? exactness 'decimal-as-inexact))
((abs e-v) . > . (if get-extfl? 6000 400))) (let ([m-v-e (/ (- (integer-length (numerator m-v))
(integer-length (denominator m-v)))
(log radix 2))])
((abs (+ e-v m-v-e)) . > . (if get-extfl? (expt 2 15) (expt 2 11)))))
;; Don't calculate a huge exponential to return a float: ;; Don't calculate a huge exponential to return a float:
(real->precision-inexact (real->precision-inexact
(cond (cond
@ -533,9 +536,8 @@
convert-mode)) convert-mode))
(define (get-inexact? from-pos) (define (get-inexact? from-pos)
(or (eq? exactness 'inexact) (or (eq? exactness 'inexact)
;; For historical reasons, `#`s in a fraction trigger an (and (not (or (eq? exactness 'exact)
;; inexact result, even if `exactness` is 'decimal-as-exact (eq? exactness 'decimal-as-exact)))
(and (not (eq? exactness 'exact))
(hashes? s from-pos end)))) (hashes? s from-pos end))))
(cond (cond
[(or (not n-v) (not d-v)) #f] [(or (not n-v) (not d-v)) #f]

View File

@ -357,7 +357,7 @@ static Scheme_Object *read_special_number(const mzchar *str, int pos)
/* Exponent threshold for obvious infinity. Must be at least /* Exponent threshold for obvious infinity. Must be at least
max(MAX_FAST_FLOATREAD_LEN, MAX_FLOATREAD_PRECISION_DIGITS) more max(MAX_FAST_FLOATREAD_LEN, MAX_FLOATREAD_PRECISION_DIGITS) more
than the larget possible FP exponent. */ than the larget possible FP exponent. */
#define CHECK_INF_EXP_THRESHOLD(extfl) (extfl ? 6000 : 400) #define CHECK_INF_EXP_THRESHOLD(extfl) (extfl ? 32768 : 2048)
/* Don't bother reading more than the following number of digits in a /* Don't bother reading more than the following number of digits in a
floating-point mantissa: */ floating-point mantissa: */
@ -1552,11 +1552,11 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
/* 0.0 => -0.0 */ /* 0.0 => -0.0 */
#ifdef MZ_USE_SINGLE_FLOATS #ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(n)) { if (SCHEME_FLTP(n)) {
n = scheme_make_float(-SCHEME_FLT_VAL(n)); n = scheme_nzerof;
} }
#endif #endif
if (SCHEME_DBLP(n)) { if (SCHEME_DBLP(n)) {
n = scheme_make_double(-SCHEME_DBL_VAL(n)); n = scheme_nzerod;
} }
} }
} }

View File

@ -54846,7 +54846,13 @@ static const char *startup_source =
"(let-values() #f)" "(let-values() #f)"
"(if(if(let-values(((or-part_0)(eq? exactness_0 'inexact)))" "(if(if(let-values(((or-part_0)(eq? exactness_0 'inexact)))"
"(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-inexact)))" "(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-inexact)))"
"(>(abs e-v_0)(if get-extfl?_0 6000 400))" "(let-values(((m-v-e_0)"
"(/"
"(-"
"(integer-length(numerator m-v_0))"
"(integer-length(denominator m-v_0)))"
"(log radix_0 2))))"
"(>(abs(+ e-v_0 m-v-e_0))(if get-extfl?_0(expt 2 15)(expt 2 11))))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(real->precision-inexact_0" "(real->precision-inexact_0"
@ -54907,7 +54913,9 @@ static const char *startup_source =
"(let-values(((or-part_0)(eq? exactness_0 'inexact)))" "(let-values(((or-part_0)(eq? exactness_0 'inexact)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(if(not(eq? exactness_0 'exact))" "(if(not"
"(let-values(((or-part_1)(eq? exactness_0 'exact)))"
"(if or-part_1 or-part_1(eq? exactness_0 'decimal-as-exact))))"
"(hashes? s_0 from-pos_0 end_0)" "(hashes? s_0 from-pos_0 end_0)"
" #f)))))))" " #f)))))))"
"(if(let-values(((or-part_0)(not n-v_0)))(if or-part_0 or-part_0(not d-v_0)))" "(if(let-values(((or-part_0)(not n-v_0)))(if or-part_0 or-part_0(not d-v_0)))"