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

* Fixed a bug that causes (- 0.0) to be 0.0 instead of -0.0.

This commit is contained in:
Abdulaziz Ghuloum 2007-06-14 20:11:58 +03:00
parent b6779a0f87
commit 96851f8285
2 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

19
src/ikarus.numerics.ss
View File

@ -441,7 +441,9 @@
[(bignum? y) [(bignum? y)
(foreign-call "ikrt_fxbnminus" x y)] (foreign-call "ikrt_fxbnminus" x y)]
[(flonum? y) [(flonum? y)
($fl- (fixnum->flonum x) y)] (if ($fx= x 0)
($fl* y -1.0)
($fl- (fixnum->flonum x) y))]
[(ratnum? y) [(ratnum? y)
(let ([n ($ratnum-n y)] [d ($ratnum-d y)]) (let ([n ($ratnum-n y)] [d ($ratnum-d y)])
(binary/ (binary- (binary* d x) n) d))] (binary/ (binary- (binary* d x) n) d))]
@ -570,7 +572,8 @@
(case-lambda (case-lambda
[(x y) (binary- x y)] [(x y) (binary- x y)]
[(x y z) (binary- (binary- x y) z)] [(x y z) (binary- (binary- x y) z)]
[(a) (binary- 0 a)] [(a)
(binary- 0 a)]
[(a b c d . e*) [(a b c d . e*)
(let f ([ac (binary- (binary- (binary- a b) c) d)] (let f ([ac (binary- (binary- (binary- a b) c) d)]
[e* e*]) [e* e*])
@ -1284,7 +1287,7 @@
(f (fl- ac (car rest)) (cdr rest))))] (f (fl- ac (car rest)) (cdr rest))))]
[(x) [(x)
(if (flonum? x) (if (flonum? x)
($fl- (exact->inexact 0) x) ($fl- 0.0 x)
(error 'fl+ "~s is not a flonum" x))])) (error 'fl+ "~s is not a flonum" x))]))
(define fl* (define fl*
@ -1306,7 +1309,7 @@
(if (flonum? x) (if (flonum? x)
x x
(error 'fl* "~s is not a flonum" x))] (error 'fl* "~s is not a flonum" x))]
[() (exact->inexact 1)])) [() 1.0]))
(define fl/ (define fl/
(case-lambda (case-lambda
@ -1326,8 +1329,7 @@
[(x) [(x)
(if (flonum? x) (if (flonum? x)
x x
(error 'fl/ "~s is not a flonum" x))] (error 'fl/ "~s is not a flonum" x))]))
[() (exact->inexact 1)]))
(flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=) (flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=)
(flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<) (flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<)
@ -1395,7 +1397,8 @@
(cond (cond
[(fixnum? x) (eq? x 0)] [(fixnum? x) (eq? x 0)]
[(bignum? x) #f] [(bignum? x) #f]
[(flonum? x) (= x (exact->inexact 0))] [(flonum? x)
(or ($fl= x 0.0) ($fl= x -0.0))]
[else (error 'zero? "tag=~s / ~s is not a number" [else (error 'zero? "tag=~s / ~s is not a number"
($fxlogand 255 ($fxlogand 255
($fxsll x 2)) ($fxsll x 2))
@ -1893,7 +1896,7 @@
(let ([est (inexact->exact (let ([est (inexact->exact
(ceiling (ceiling
(- (* (+ e (len f) -1) (invlog2of B)) (- (* (+ e (len f) -1) (invlog2of B))
(exact->inexact (expt 10 -10)))))]) 1e-10)))])
(if (>= est 0) (if (>= est 0)
(fixup r (* s (exptt B est)) m+ m- est B round?) (fixup r (* s (exptt B est)) m+ m- est B round?)
(let ([scale (exptt B (- est))]) (let ([scale (exptt B (- est))])