suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

number-parsing repair for some inexact numbers

Browse Source 
The fast path for inexact numbers didn't guard against underflow
correctly.
This commit is contained in:
Matthew Flatt 2019-02-25 07:46:46 -07:00
parent 078f697a0b
commit 685a1ff040
3 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -2507,6 +2507,7 @@
(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 #f zero? (string->number "7.4109846876187e-323"))
(test #t andmap (lambda (x) (and (>= x 0) (< x 10))) (map random '(10 10 10 10)))
(test (void) random-seed 5)

28
racket/src/expander/read/number.rkt
View File

@ -210,7 +210,7 @@
exp))
(cond
[(eqv? n 0) (if (fx= sgn/z -1) (- 0.0) 0.0)]
[(approx-expt . > . precision) +inf.0]
[(approx-expt . > . precision) (if (fx= sgn/z -1) -inf.0 +inf.0)]
[(approx-expt . < . (- precision)) (if (fx= sgn/z -1) (- 0.0) 0.0)]
[else
(* n (expt radix exp))])]
@ -224,19 +224,31 @@
[(state-has-first-half? state) #f]
[(eqv? n 0) (if (fx= sgn 1) 0.0 (- 0.0))]
[(and (fixnum? n)
((integer-length n) . < . 50))
(n . < . (expt 2 50))
(n . > . (- (expt 2 50))))
;; No loss of precision in mantissa from early flonum conversion
(let ([exp (+ exp (* sgn2 exp2))]
[m (fx->fl (if (fx= sgn -1)
(fx- 0 n)
n))]
[radix (if (fx= radix 10)
10.0
(fx->fl radix))])
n))])
(cond
[(eqv? exp 0) m]
[(exp . < . 0) (/ m (expt radix (- exp)))]
[else (* m (expt radix exp))]))]
[(not (fixnum? exp)) #f]
[else
(define fradix (if (fx= radix 10)
10.0
(fx->fl radix)))
(cond
[(exp . fx< . 0)
;; Stay well away from limits on the exponent to make
;; sure there's still no loss of precision. We could
;; use `(integer-length n)` to improve the bounds,
;; but this seems good enough for the common case.
(and (exp . fx> . (cond
[(radix . fx<= . 10) -300]
[else -240]))
(/ m (expt fradix (fx- 0 exp))))]
[else (* m (expt fradix exp))])]))]
[else #f])]
[else #f]))

20
racket/src/racket/src/startup.inc
View File

@ -54065,7 +54065,7 @@ static const char *startup_source =
"(if(eqv? n_0 0)"
"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))"
"(if(> approx-expt_0 precision_0)"
"(let-values() +inf.0)"
"(let-values()(if(fx= sgn/z_0 -1) -inf.0 +inf.0))"
"(if(< approx-expt_0(- precision_0))"
"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))"
"(let-values()(* n_0(expt radix_0 exp_0)))))))))))"
@ -54086,16 +54086,22 @@ static const char *startup_source =
"(let-values() #f)"
"(if(eqv? n_0 0)"
"(let-values()(if(fx= sgn_0 1) 0.0(- 0.0)))"
"(if(if(fixnum? n_0)(<(integer-length n_0) 50) #f)"
"(if(if(fixnum? n_0)(if(< n_0(expt 2 50))(> n_0(-(expt 2 50))) #f) #f)"
"(let-values()"
"(let-values(((exp_1)(+ exp_0(* sgn2_0 exp2_0)))"
"((m_0)(fx->fl(if(fx= sgn_0 -1)(fx- 0 n_0) n_0)))"
"((radix_1)(if(fx= radix_0 10) 10.0(fx->fl radix_0))))"
"((m_0)(fx->fl(if(fx= sgn_0 -1)(fx- 0 n_0) n_0))))"
"(if(eqv? exp_1 0)"
"(let-values() m_0)"
"(if(< exp_1 0)"
"(let-values()(/ m_0(expt radix_1(- exp_1))))"
"(let-values()(* m_0(expt radix_1 exp_1)))))))"
"(if(not(fixnum? exp_1))"
"(let-values() #f)"
"(let-values()"
"(let-values(((fradix_0)(if(fx= radix_0 10) 10.0(fx->fl radix_0))))"
"(if(fx< exp_1 0)"
"(let-values()"
"(if(fx> exp_1(if(fx<= radix_0 10)(let-values() -300)(let-values() -240)))"
"(/ m_0(expt fradix_0(fx- 0 exp_1)))"
" #f))"
"(let-values()(* m_0(expt fradix_0 exp_1))))))))))"
"(let-values() #f)))))"
"(let-values() #f))))))"
"(define-values"