* Added flzero?

This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 14:08:12 +03:00
parent 89fd9d0a23
commit 0f910c431f
3 changed files with 24 additions and 4 deletions

Binary file not shown.

View File

@ -7,7 +7,7 @@
(library (ikarus flonums)
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts
inexact->exact $flonum-rational? $flonum-integer?)
inexact->exact $flonum-rational? $flonum-integer? $flzero?)
(import
(ikarus system $bytevectors)
(except (ikarus system $flonums) $flonum-signed-biased-exponent
@ -71,6 +71,18 @@
(let ([v ($flonum->exact x)])
(or (fixnum? v) (bignum? v)))])))
(define ($flzero? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
(and
(fx= be 0) ;;; denormalized double, only +/-0.0 is integer
(and (fx= ($flonum-u8-ref x 7) 0)
(fx= ($flonum-u8-ref x 6) 0)
(fx= ($flonum-u8-ref x 5) 0)
(fx= ($flonum-u8-ref x 4) 0)
(fx= ($flonum-u8-ref x 3) 0)
(fx= ($flonum-u8-ref x 2) 0)
(fx= ($flonum-u8-ref x 1) 0)))))
(define ($flonum->exact x)
(let-values ([(pos? be m) (flonum-parts x)])
(cond
@ -102,7 +114,7 @@
positive? expt gcd lcm numerator denominator exact-integer-sqrt
quotient+remainder number->string string->number min max
exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>?
fl>=? fl+ fl- fl* fl/ flsqrt)
fl>=? fl+ fl- fl* fl/ flsqrt flzero?)
(import
(ikarus system $fx)
(ikarus system $flonums)
@ -110,13 +122,14 @@
(ikarus system $bignums)
(ikarus system $chars)
(ikarus system $strings)
(only (ikarus flonums) $flonum->exact)
(only (ikarus flonums) $flonum->exact $flzero?)
(except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
remainder modulo even? odd? quotient+remainder number->string positive?
string->number expt gcd lcm numerator denominator
exact->inexact floor ceiling round log
exact-integer-sqrt min max
fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt))
fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt
flzero?))
(define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x))
@ -1463,6 +1476,12 @@
(foreign-call "ikrt_fl_sqrt" x)
(error 'flsqrt "~s is not a flonum" x))))
(define flzero?
(lambda (x)
(if (flonum? x)
($flzero? x)
(error 'flzero? "~s is not a flonum" x))))
(define exact-integer-sqrt
(lambda (x)
(define who 'exact-integer-sqrt)

View File

@ -377,6 +377,7 @@
[fl- i rfl]
[fl/ i rfl]
[flsqrt i rfl]
[flzero? i rfl]
[fixnum->string i]
[string->flonum i]
[- i r]