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

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

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

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]