Fix up bit-indexed integer operations.

. Fix sense of BIT-SET?.
. Add BIT-CLEAR?, for symmetry.
. Export forgotten TOGGLE-BIT.
. Add some tests for these operations.

diff --git a/src/runtime/integer-bits.scm b/src/runtime/integer-bits.scm
index 70e8f0260694880ebed162578dba4639e80d6f4a..f63f1e3ff8731a1e42adfb1de3d339129e5b514b 100644 (file)
--- a/src/runtime/integer-bits.scm
+++ b/src/runtime/integer-bits.scm
@@ -125,6 +125,9 @@ USA.
   (extract-bit-field 1 bit integer))
 
 (define-integrable (bit-set? bit integer)
+  (not (bit-clear? bit integer)))
+
+(define-integrable (bit-clear? bit integer)
   (zero? (extract-bit-field 1 bit integer)))
 \f
 ;;; SRFI 60 operations

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 98bfc7afc22eed0003cce426873f76410e3b7d26..d8887e816f931e63bc430c8adbfc2d6235274c03 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -336,6 +336,7 @@ USA.
          any-bits-set?
          arithmetic-shift
          bit-antimask
+         bit-clear?
          bit-count
          bit-mask
          bit-set?
@@ -355,6 +356,7 @@ USA.
          splice-bit-field
          test-bit-field
          test-bit-field?
+         toggle-bit
 
          ;; Truth table order
          bitwise-and

diff --git a/tests/runtime/test-integer-bits.scm b/tests/runtime/test-integer-bits.scm
index bf2ff18c00fcf653fb2c29713c640194ef8325b1..5eb602bfee07d02286196f69de5b0bc00c9f6107 100644 (file)
--- a/tests/runtime/test-integer-bits.scm
+++ b/tests/runtime/test-integer-bits.scm
@@ -370,11 +370,11 @@ USA.
   (lambda (a b)
     (if (not (eqv? (hamming-distance a b)
                    (if (eqv? (negative? a) (negative? b))
-                    (bit-count (bitwise-xor a b))
-                    -1)))
+                       (bit-count (bitwise-xor a b))
+                       -1)))
         (error "Failed:" `(HAMMING-DISTANCE ,a ,b)
                '=> (hamming-distance a b)))))
-
+\f
 (define-test 'BIT-MASK
   (lambda ()
     (do ((i 0 (+ i 1))) ((>= i #x1000))
@@ -394,3 +394,22 @@ USA.
                     (bitwise-not
                      (shift-left (bitwise-not (shift-left -1 size))
                                  position)))))))
+
+(define (define-per-bit-test name procedure)
+  (define-test name
+    (lambda ()
+      (do ((i 0 (+ i 1))) ((>= i #x100))
+        (procedure (random-integer-of-weight (random-integer #x1000) #x1000)
+                   (random-integer #x1000))))))
+
+(define-per-bit-test 'SET-BIT
+  (lambda (n i) (assert-true (bit-set? i (set-bit i n)))))
+
+(define-per-bit-test 'CLEAR-BIT
+  (lambda (n i) (assert-true (bit-clear? i (clear-bit i n)))))
+
+(define-per-bit-test 'TOGGLE-BIT
+  (lambda (n i) (assert-eqv (bit-clear? i (toggle-bit i n)) (bit-set? i n))))
+
+(define-per-bit-test 'EXTRACT-BIT
+  (lambda (n i) (assert-eqv (zero? (extract-bit i n)) (bit-clear? i n))))