diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl index 83527d5800..3839e7180c 100644 --- a/pkgs/racket-test-core/tests/racket/number.rktl +++ b/pkgs/racket-test-core/tests/racket/number.rktl @@ -2652,6 +2652,9 @@ (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")) +;; Regression test to make sure prevision isn't lost by multiplying 10.0 times 1e44: +(test (exact->inexact #e1e45) string->number "1.0e45") + (test #t andmap (lambda (x) (and (>= x 0) (< x 10))) (map random '(10 10 10 10))) (test (void) random-seed 5) (test (begin (random-seed 23) (list (random 10) (random 20) (random 30))) diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 2ffb4cddb9..4cc9f9920c 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -56049,8 +56049,14 @@ static const char *startup_source = "(let-values()(if(fx= sgn_0 1) 0.0(- 0.0)))" "(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))))" +"(let-values(((exp_1)(+ exp_0(* sgn2_0 exp2_0))))" +"(if(if(fixnum? exp_1)" +"(if(fx<= radix_0 10)" +"(let-values()(fx<= -15 exp_1 15))" +"(let-values()(fx<= -12 exp_1 12)))" +" #f)" +"(let-values()" +"(let-values(((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(not(fixnum? exp_1))" @@ -56058,11 +56064,9 @@ static const char *startup_source = "(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(fx- 0 exp_1))))" "(let-values()(* m_0(expt fradix_0 exp_1))))))))))" +"(let-values() #f))))" "(let-values() #f)))))" "(let-values() #f))))))" "(define-values" diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 7331fbca6a..68af8e2b04 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -64606,22 +64606,25 @@ (if (< n_0 1125899906842624) (> n_0 -1125899906842624) #f) #f) (let ((exp_1 (+ exp_0 (* sgn2_0 exp2_0)))) - (let ((m_0 - (unsafe-fx->fl (if (fx= sgn_0 -1) (fx- 0 n_0) n_0)))) - (let ((exp_2 exp_1)) - (if (eqv? exp_2 0) + (if (if (fixnum? exp_1) + (if (fx<= radix_0 10) + (fx<= -15 exp_1 15) + (fx<= -12 exp_1 12)) + #f) + (let ((m_0 + (unsafe-fx->fl (if (fx= sgn_0 -1) (fx- 0 n_0) n_0)))) + (if (eqv? exp_1 0) m_0 - (if (not (fixnum? exp_2)) + (if (not (fixnum? exp_1)) #f (let ((fradix_0 (if (fx= radix_0 10) 10.0 (unsafe-fx->fl radix_0)))) - (if (fx< exp_2 0) - (if (fx> exp_2 (if (fx<= radix_0 10) -300 -240)) - (/ m_0 (expt fradix_0 (fx- 0 exp_2))) - #f) - (* m_0 (expt fradix_0 exp_2))))))))) + (if (fx< exp_1 0) + (/ m_0 (expt fradix_0 (fx- 0 exp_1))) + (* m_0 (expt fradix_0 exp_1))))))) + #f)) #f))) #f)))) (define finish.1 diff --git a/racket/src/expander/read/number.rkt b/racket/src/expander/read/number.rkt index 3da66fd58c..92029930ae 100644 --- a/racket/src/expander/read/number.rkt +++ b/racket/src/expander/read/number.rkt @@ -238,28 +238,27 @@ (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))]) + (let ([exp (+ exp (* sgn2 exp2))]) (cond - [(eqv? exp 0) m] - [(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))])]))] + [(and (fixnum? exp) + (cond + [(radix . fx<= . 10) (fx<= -15 exp 15)] + [else (fx<= -12 exp 12)])) + ;; No loss of precision in radix^exponent as a flonum + (let ([m (fx->fl (if (fx= sgn -1) + (fx- 0 n) + n))]) + (cond + [(eqv? exp 0) m] + [(not (fixnum? exp)) #f] + [else + (define fradix (if (fx= radix 10) + 10.0 + (fx->fl radix))) + (cond + [(exp . fx< . 0) (/ m (expt fradix (fx- 0 exp)))] + [else (* m (expt fradix exp))])]))] + [else #f]))] [else #f])] [else #f])) @@ -839,7 +838,7 @@ (try "#i+inf.f") (try "-inf.f") (try "#e+inf.0") - (try "-inf.t") + (when (extflonum-available?) (try "-inf.t")) (try "10") (try "10.1") (try "1+2i") @@ -851,9 +850,9 @@ (try "#e#x+e#s+e") (try "-e#l-e") (try "#e#x+e#s+e@-e#l-e") - (try "3.1415926535897932385t0") + (when (extflonum-available?) (try "3.1415926535897932385t0")) (try "+nan.0+1i") - (try "3.0t0") + (when (extflonum-available?) (try "3.0t0")) (try "+i") (try "-i") (try "#i3") @@ -862,7 +861,7 @@ (try "1.2+i") (try "1/2+3") (try "1.2+3") - (try "#i1.2t0+3i") + (when (extflonum-available?) (try "#i1.2t0+3i")) (try "#i-0") (try "#i0") (try "-0#") @@ -885,11 +884,12 @@ (try "1@+inf.0") (try "1/1@+inf.0") ;(try "#d1/0+3.0i") - (try "3.0t0+1/0i") - (try "1/0+3.0t0i") - (try "+inf.t0+1/0i") - (try "1/0+inf.t0i") - (try "3.#t0") + (when (extflonum-available?) + (try "3.0t0+1/0i") + (try "1/0+3.0t0i") + (try "+inf.t0+1/0i") + (try "1/0+inf.t0i") + (try "3.#t0")) (try "-1-2i") (try "-4.242154731064108e-5-6.865001427422244e-5i") (try "1e300+1e300i")