fixed some r6rs bitwise bugs.

scheme/ikarus.numerics.ss

@@ -321,11 +321,18 @@
         (foreign-call "ikrt_fl_acos" x)
         (die 'flacos "not a flonum" x)))
 
-  (define (flatan x)
+  (define flatan 
-    (if (flonum? x) 
+    (case-lambda
-        (foreign-call "ikrt_fl_atan" x)
+      [(x)
-        (die 'flatan "not a flonum" x)))
+       (if (flonum? x) 
-
+           (foreign-call "ikrt_fl_atan" x)
+           (die 'flatan "not a flonum" x))]
+      [(x y)
+       (if (flonum? x)
+           (if (flonum? y)
+               (foreign-call "ikrt_atan2" x y)
+               (die 'flatan "not a flonum" y))
+           (die 'flatan "not a flonum" x))]))
 
   (define (flfloor x)
     (define (ratnum-floor x)
@@ -1477,25 +1484,25 @@
            x 
            (die 'flmin "not a flonum" x))]))
 
-  (define exact->inexact
+  (define (->inexact x who)
-    (lambda (x)
+    (cond
-      (cond
+      [(fixnum? x) ($fixnum->flonum x)]
-        [(fixnum? x) ($fixnum->flonum x)]
+      [(bignum? x) (bignum->flonum x)]
-        [(bignum? x) (bignum->flonum x)]
+      [(ratnum? x) (ratnum->flonum x)]
-        [(ratnum? x) (ratnum->flonum x)]
+      [(flonum? x) x]
-        [else
+      [(compnum? x) 
-         (die 'exact->inexact 
+       (make-rectangular 
-                "not an exact number" x)])))
+         (->inexact (real-part x))
+         (->inexact (imag-part x)))]
+      [(cflonum? x) x]
+      [else
+       (die who "not a number" x)]))
 
-  (define inexact
+  (define (exact->inexact x)
-    (lambda (x)
+    (->inexact x 'exact->inexact))
-      (cond
+
-        [(fixnum? x) ($fixnum->flonum x)]
+  (define (inexact x)
-        [(bignum? x) (bignum->flonum x)]
+    (->inexact x 'inexact))
-        [(ratnum? x) (ratnum->flonum x)]
-        [(flonum? x) x]
-        [else
-         (die 'inexact "not a number" x)])))
 
   (define real->flonum
     (lambda (x)
@@ -2044,16 +2051,36 @@
   (flcmp flfl<= flfx<= fxfl<= flbn<= bnfl<= $fl<=)
   (flcmp flfl>= flfx>= fxfl>= flbn>= bnfl>= $fl>=)
 
-  (define-syntax flrt= (syntax-rules () [(_ x y) (= (inexact->exact x) y)]))
+  (define-syntax cmp-ex/in
-  (define-syntax rtfl= (syntax-rules () [(_ x y) (= x (inexact->exact y))]))
+    (syntax-rules ()
-  (define-syntax flrt<  (syntax-rules () [(_ x y) (< (inexact->exact x) y)]))
+      [(_ pred)
-  (define-syntax rtfl<  (syntax-rules () [(_ x y) (< x (inexact->exact y))]))
+       (syntax-rules ()
-  (define-syntax flrt<= (syntax-rules () [(_ x y) (<= (inexact->exact x) y)]))
+         [(_ ex in) 
-  (define-syntax rtfl<= (syntax-rules () [(_ x y) (<= x (inexact->exact y))]))
+          (let ([x ex] [y in])
-  (define-syntax flrt>  (syntax-rules () [(_ x y) (> (inexact->exact x) y)]))
+            (if ($flonum-rational? y)
-  (define-syntax rtfl>  (syntax-rules () [(_ x y) (> x (inexact->exact y))]))
+                (pred x (exact y))
-  (define-syntax flrt>= (syntax-rules () [(_ x y) (>= (inexact->exact x) y)]))
+                (pred (inexact x) y)))])]))
-  (define-syntax rtfl>= (syntax-rules () [(_ x y) (>= x (inexact->exact y))]))
+  (define-syntax cmp-in/ex
+    (syntax-rules ()
+      [(_ pred)
+       (syntax-rules ()
+         [(_ in ex) 
+          (let ([x in] [y ex])
+            (if ($flonum-rational? x)
+                (pred (exact x) y)
+                (pred x (inexact y))))])]))
+
+  (define-syntax flrt=  (cmp-in/ex =))
+  (define-syntax rtfl=  (cmp-ex/in =))
+  (define-syntax flrt<  (cmp-in/ex <))
+  (define-syntax rtfl<  (cmp-ex/in <))
+  (define-syntax flrt<= (cmp-in/ex <=))
+  (define-syntax rtfl<= (cmp-ex/in <=))
+  (define-syntax flrt>  (cmp-in/ex >))
+  (define-syntax rtfl>  (cmp-ex/in >))
+  (define-syntax flrt>= (cmp-in/ex >=))
+  (define-syntax rtfl>= (cmp-ex/in >=))
+
   (define (exrt< x y) (< (* x ($ratnum-d y)) ($ratnum-n y)))
   (define (rtex< x y) (< ($ratnum-n x) (* y ($ratnum-d x))))
   (define (rtrt< x y) (< (* ($ratnum-n x) ($ratnum-d y)) (* ($ratnum-n y) ($ratnum-d x))))
@@ -2616,8 +2643,7 @@
     (cond
       [(flonum? x) 
        ;;; optimize for integer flonums
-       (let ([e (or ($flonum->exact x)
+       (let ([e ($flonum->exact x)])
-                    (die 'floor "number has no real value" x))])
          (cond
            [(ratnum? e) 
             (exact->inexact (ratnum-floor e))] 
@@ -2634,8 +2660,7 @@
     (cond
       [(flonum? x) 
        ;;; optimize for integer flonums
-       (let ([e (or ($flonum->exact x)
+       (let ([e ($flonum->exact x)])
-                    (die 'ceiling "number has no real value" x))])
          (cond
            [(ratnum? e) (exact->inexact (ratnum-ceiling e))] 
            [else x]))]
@@ -3417,16 +3442,16 @@
         (lambda (x)
           (define (fst n)
             (cond
-              [(zero? n) 0]
+              [(odd? n) 0]
-              [(even? n) (fst (bitwise-arithmetic-shift-right n 1))]
               [else (+ 1 (fst (bitwise-arithmetic-shift-right n 1)))]))
           (u8-list->bytevector
-            (let f ([i 0])
+            (cons 0 #| not used |#
-              (cond
+              (let f ([i 1])
-                [(= i 256) '()]
+                (cond
-                [else (cons (fst i) (f (+ i 1)))])))))
+                  [(= i 256) '()]
+                  [else (cons (fst i) (f (+ i 1)))]))))))
       (define bv (make-first-bit-set-bytevector))
-      ($fx+ i ($bytevector-u8-ref bv i)))
+      ($fx+ i ($bytevector-u8-ref bv x)))
     (define ($fxloop x i)
       (let ([y ($fxlogand x 255)])
         (if ($fx= y 0)
@@ -3605,7 +3630,7 @@
                                          ($fxsub1 ($fxsll 1 i))
                                          ($fxsub1 ($fxsll 1 j)))])
                                   ($fxlogor
-                                    ($fxlogand m b)
+                                    ($fxlogand m ($fxsll b i))
                                     ($fxlogand ($fxlognot m) x)))
                                 (die who "not a fixnum" b))
                             (if ($fx<= 0 j)

scheme/last-revision

@@ -1 +1 @@
-1549
+1550