* Fixed rational? and integer? to handle flonums properly.

This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 09:03:30 +03:00
parent 83c7fe71b8
commit 9bd65cc447
4 changed files with 47 additions and 9 deletions

Binary file not shown.

View File

@ -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)
@ -39,6 +41,36 @@
(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

View File

@ -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)])))

View File

@ -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]
@ -568,6 +569,9 @@
[$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]