* Comitted half-fix to exact->inexact regarding bug 162334.
- some of the generic arithmetic operations are still broken due to rounding errors.
This commit is contained in:
parent
4b7f03df1a
commit
ef6b9c0bae
3371
benchmarks/timelog
3371
benchmarks/timelog
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -595,14 +595,34 @@
|
||||||
[(8) (bignum/8->flonum x)]
|
[(8) (bignum/8->flonum x)]
|
||||||
[else (bignum/n->flonum x bytes)]))))
|
[else (bignum/n->flonum x bytes)]))))
|
||||||
|
|
||||||
(define (ratnum->flonum x)
|
|
||||||
(let f ([n ($ratnum-n x)] [d ($ratnum-d x)])
|
|
||||||
|
(define (ratnum->flonum x)
|
||||||
|
(define (->flonum n d)
|
||||||
(let-values ([(q r) (quotient+remainder n d)])
|
(let-values ([(q r) (quotient+remainder n d)])
|
||||||
(if (= q 0)
|
(if (= r 0)
|
||||||
(/ 1.0 (f d n))
|
(inexact q)
|
||||||
(if (= r 0)
|
(if (= q 0)
|
||||||
(inexact q)
|
(/ (->flonum d n))
|
||||||
(+ q (f r d)))))))
|
(+ q (->flonum r d))))))
|
||||||
|
(let ([n (numerator x)] [d (denominator x)])
|
||||||
|
(let ([b (bitwise-first-bit-set n)])
|
||||||
|
(if (eqv? b 0)
|
||||||
|
(let ([b (bitwise-first-bit-set d)])
|
||||||
|
(if (eqv? b 0)
|
||||||
|
(->flonum n d)
|
||||||
|
(/ (->flonum n (bitwise-arithmetic-shift-right d b))
|
||||||
|
(expt 2.0 b))))
|
||||||
|
(* (->flonum (bitwise-arithmetic-shift-right n b) d)
|
||||||
|
(expt 2.0 b))))))
|
||||||
|
;;; (define (ratnum->flonum x)
|
||||||
|
;;; (let f ([n ($ratnum-n x)] [d ($ratnum-d x)])
|
||||||
|
;;; (let-values ([(q r) (quotient+remainder n d)])
|
||||||
|
;;; (if (= q 0)
|
||||||
|
;;; (/ 1.0 (f d n))
|
||||||
|
;;; (if (= r 0)
|
||||||
|
;;; (inexact q)
|
||||||
|
;;; (+ q (f r d)))))))
|
||||||
|
|
||||||
(define binary+
|
(define binary+
|
||||||
(lambda (x y)
|
(lambda (x y)
|
||||||
|
|
Loading…
Reference in New Issue