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

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

27
src/ikarus.numerics.ss
View File

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

1
src/makefile.ss
View File

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