conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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:
Abdulaziz Ghuloum 2007-11-13 00:45:04 -05:00
parent 4b7f03df1a
commit ef6b9c0bae
3 changed files with 3398 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3371
benchmarks/timelog
View File

File diff suppressed because it is too large Load Diff

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

34
scheme/ikarus.numerics.ss
View File

@ -595,14 +595,34 @@
[(8) (bignum/8->flonum x)]
[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)])
(if (= q 0)
(/ 1.0 (f d n))
(if (= r 0)
(inexact q)
(+ q (f r d)))))))
(if (= r 0)
(inexact q)
(if (= q 0)
(/ (->flonum d n))
(+ 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+
(lambda (x y)