diff --git a/src/ikarus.boot b/src/ikarus.boot index f200556..2fed51f 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index 16300f5..afe2a38 100644 --- a/src/ikarus.numerics.ss +++ b/src/ikarus.numerics.ss @@ -6,10 +6,12 @@ (library (ikarus flonums) - (export $flonum->exact flonum-parts inexact->exact) + (export $flonum->exact $flonum-signed-biased-exponent flonum-parts + inexact->exact $flonum-rational? $flonum-integer?) (import (ikarus system $bytevectors) - (ikarus system $flonums) + (except (ikarus system $flonums) $flonum-signed-biased-exponent + $flonum-rational? $flonum-integer?) (except (ikarus) inexact->exact)) (define (flonum-bytes f) @@ -38,7 +40,37 @@ (fxsll b2 16) (fxsll (fxlogand b1 #b1111) 24)) (expt 2 24)))))) - + + (define ($flonum-signed-biased-exponent x) + (let ([b0 ($flonum-u8-ref x 0)] + [b1 ($flonum-u8-ref x 1)]) + (fxlogor (fxsll b0 4) (fxsra b1 4)))) + + (define ($flonum-rational? x) + (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))]) + (fx< be 2047))) + + (define ($flonum-integer? x) + (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))]) + (cond + [(fx= be 2047) ;;; nans and infs + #f] + [(fx>= be 1075) ;;; magnitue large enough + #t] + [(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))] + [(fx<= be (fx+ 1075 -52)) ;;; too small to be an integer + #f] + [else + (let ([v ($flonum->exact x)]) + (or (fixnum? v) (bignum? v)))]))) + (define ($flonum->exact x) (let-values ([(pos? be m) (flonum-parts x)]) (cond diff --git a/src/ikarus.predicates.ss b/src/ikarus.predicates.ss index f2b3bd5..fb690aa 100644 --- a/src/ikarus.predicates.ss +++ b/src/ikarus.predicates.ss @@ -14,6 +14,7 @@ null? pair? weak-pair? symbol? code? not eq? eqv? equal? port? input-port? output-port?) (ikarus system $fx) + (ikarus system $flonums) (ikarus system $pairs) (ikarus system $chars) (ikarus system $strings) @@ -76,7 +77,7 @@ [(sys:fixnum? x) #t] [(sys:bignum? x) #t] [(sys:ratnum? x) #t] - [(sys:flonum? x) #f] + [(sys:flonum? x) ($flonum-rational? x)] [else (error 'rational? "~s is not a number" x)]))) (define integer? @@ -85,7 +86,7 @@ [(sys:fixnum? x) #t] [(sys:bignum? x) #t] [(sys:ratnum? x) #f] - [(sys:flonum? x) (error 'integer "dunno for ~s" x)] + [(sys:flonum? x) ($flonum-integer? x)] [else #f]))) (define exact? @@ -93,6 +94,7 @@ (cond [(sys:fixnum? x) #t] [(sys:bignum? x) #t] + [(sys:ratnum? x) #t] [(sys:flonum? x) #f] [else (error 'exact? "~s is not a number" x)]))) diff --git a/src/makefile.ss b/src/makefile.ss index a59eda7..87f932b 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -381,7 +381,8 @@ [number? i r] [bignum? i] [ratnum? i] - [integer? i] + [integer? i r] + [rational? i r] [flonum? i] [positive? i r] [quotient i r] @@ -565,9 +566,12 @@ [$bytevector-u8-ref $bytes] [$bytevector-set! $bytes] - [$flonum-u8-ref $flonums] - [$make-flonum $flonums] - [$flonum-set! $flonums] + [$flonum-u8-ref $flonums] + [$make-flonum $flonums] + [$flonum-set! $flonums] + [$flonum-signed-biased-exponent $flonums] + [$flonum-rational? $flonums] + [$flonum-integer? $flonums] [$make-bignum $bignums] [$bignum-positive? $bignums]