bitvector-set-bit! / bitvector-clear-bit! replace bitvector-set!

* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/array-handle.h (bitvector_set_x, scm_array_get_handle): Adapt
  to bitvector changes.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_c_bitvector_set_bit_x)
  (scm_c_bitvector_clear_bit_x): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bitvector_set_x): Deprecate.
* module/ice-9/sandbox.scm (mutable-bitvector-bindings): Replace
  bitvector-set! with bitvector-set-bit! / bitvector-clear-bit!.
* module/system/vm/disassembler.scm (static-opcode-set): Use
  bitvector-set-bit!.
* module/system/vm/frame.scm (compute-defs-by-slot, available-bindings):
  Use bitvector-set-bit!.
* test-suite/tests/bitvectors.test: Update.

NEWS

@@ -14,11 +14,6 @@ Changes in 3.0.3 (since 3.0.2)
 These replace the wonky "bit-count" and "bit-position" procedures.  See
 "Bit Vectors" in the manual, for more.
 
-** New bitvector-set-bits!, bitvector-clear-bits! procedures
-
-These replace the wonky "bit-set*!" procedure.  See "Bit Vectors" in the
-manual, for more.
-
 ** New bitvector-bit-set?, bitvector-bit-clear? procedures
 
 These replace bitvector-ref.  The reason to migrate is that it's an
@@ -26,6 +21,16 @@ opportunity be more efficient in 3.0 (because no generic array support),
 easier to read (no need for 'not' when checking for false bits), and
 more consistent with other bitvector procedures.
 
+** New bitvector-set-bit!, bitvector-clear-bit! procedures
+
+These replace bitvector-set!, for similar reasons as the bitvector-ref
+replacement above.
+
+** New bitvector-set-bits!, bitvector-clear-bits! procedures
+
+These replace the wonky "bit-set*!" procedure.  See "Bit Vectors" in the
+manual, for more.
+
 * New deprecations
 
 ** bit-count, bit-position deprecated
@@ -37,6 +42,10 @@ the manual.
 
 Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead.
 
+** 'bitvector-set!' deprecated
+
+Use 'bitvector-set-bit!' or 'bitvector-clear-bit!' instead.
+
 ** 'bit-set*!' deprecated
 
 Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead.

doc/ref/api-data.texi

@@ -6586,12 +6586,18 @@ Return 1 if the bit at index @var{idx} of the bitvector @var{vec} is set
 or clear, respectively, or 0 otherwise.
 @end deftypefn
 
-@deffn {Scheme Procedure} bitvector-set! vec idx val
+@deffn {Scheme Procedure} bitvector-set-bit! vec idx
-@deffnx {C Function} scm_bitvector_set_x (vec, idx, val)
+@deffnx {Scheme Procedure} bitvector-clear-bit! vec idx
-Set the element at index @var{idx} of the bitvector
+Set (for @code{bitvector-set-bit!}) or clear (for
-@var{vec} when @var{val} is true, else clear it.
+@code{bitvector-clear-bit!}) the bit at index @var{idx} of the bitvector
+@var{vec}.
 @end deffn
 
+@deftypefn {C Function} void scm_bitvector_set_bit_x (SCM vec, size_t idx)
+@deftypefnx {C Function} void scm_bitvector_clear_bit_x (SCM vec, size_t idx)
+Set or clear the bit at index @var{idx} of the bitvector @var{vec}.
+@end deftypefn
+
 @deftypefn {C Function} SCM scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
 Set the element at index @var{idx} of the bitvector
 @var{vec} when @var{val} is true, else clear it.

libguile/array-handle.c

@@ -174,6 +174,15 @@ bitvector_ref (SCM bv, size_t idx)
   return scm_from_bool (scm_c_bitvector_bit_is_set (bv, idx));
 }
 
+static void
+bitvector_set_x (SCM bv, size_t idx, SCM val)
+{
+  if (scm_is_true (val))
+    scm_c_bitvector_set_bit_x (bv, idx);
+  else
+    scm_c_bitvector_clear_bit_x (bv, idx);
+}
+
 void
 scm_array_get_handle (SCM array, scm_t_array_handle *h)
 {
@@ -202,7 +211,7 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
       initialize_vector_handle (h, scm_c_bitvector_length (array),
                                 SCM_ARRAY_ELEMENT_TYPE_BIT,
                                 bitvector_ref,
-                                scm_c_bitvector_set_x,
+                                bitvector_set_x,
                                 scm_i_bitvector_bits (array),
                                 scm_i_is_mutable_bitvector (array));
       break;

libguile/bitvectors.c

@@ -256,15 +256,16 @@ scm_bitvector_writable_elements (SCM vec,
 
 int
 scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
+#define FUNC_NAME "bitvector-bit-set?"
 {
-  if (!IS_BITVECTOR (vec))
+  VALIDATE_BITVECTOR (1, vec);
-    scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
   if (idx >= BITVECTOR_LENGTH (vec))
-    scm_out_of_range (NULL, scm_from_size_t (idx));
+    SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
 
   const uint32_t *bits = BITVECTOR_BITS (vec);
   return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0;
 }
+#undef FUNC_NAME
 
 int
 scm_c_bitvector_bit_is_clear (SCM vec, size_t idx)
@@ -294,48 +295,51 @@ SCM_DEFINE_STATIC (scm_bitvector_bit_clear_p, "bitvector-bit-clear?", 2, 0, 0,
 #undef FUNC_NAME
 
 void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+scm_c_bitvector_set_bit_x (SCM vec, size_t idx)
+#define FUNC_NAME "bitvector-set-bit!"
 {
-  scm_t_array_handle handle;
+  VALIDATE_MUTABLE_BITVECTOR (1, vec);
-  uint32_t *bits, mask;
+  if (idx >= BITVECTOR_LENGTH (vec))
+    SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
 
-  if (IS_MUTABLE_BITVECTOR (vec))
+  uint32_t *bits = BITVECTOR_BITS (vec);
-    {
+  uint32_t mask = 1L << (idx%32);
-      if (idx >= BITVECTOR_LENGTH (vec))
+  bits[idx/32] |= mask;
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-    }
-  else
-    {
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
-      scm_c_issue_deprecation_warning
-        ("Using bitvector-set! on arrays is deprecated.  "
-         "Use array-set! instead.");
-      if (idx >= len)
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-    }
-
-  mask = 1L << (idx%32);
-  if (scm_is_true (val))
-    bits[idx/32] |= mask;
-  else
-    bits[idx/32] &= ~mask;
-
-  if (!IS_MUTABLE_BITVECTOR (vec))
-      scm_array_handle_release (&handle);
 }
+#undef FUNC_NAME
 
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+void
-	    (SCM vec, SCM idx, SCM val),
+scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
-	    "Set the element at index @var{idx} of the bitvector\n"
+#define FUNC_NAME "bitvector-clear-bit!"
-	    "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
 {
-  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  VALIDATE_MUTABLE_BITVECTOR (1, vec);
+  if (idx >= BITVECTOR_LENGTH (vec))
+    SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
+
+  uint32_t *bits = BITVECTOR_BITS (vec);
+  uint32_t mask = 1L << (idx%32);
+  bits[idx/32] &= ~mask;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_bitvector_set_bit_x, "bitvector-set-bit!", 2, 0, 0,
+                   (SCM vec, SCM idx),
+                   "Set the element at index @var{idx} of the bitvector\n"
+                   "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_set_bit_x
+{
+  scm_c_bitvector_set_bit_x (vec, scm_to_size_t (idx));
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0,
+                   (SCM vec, SCM idx),
+                   "Clear the element at index @var{idx} of the bitvector\n"
+                   "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_set_bit_x
+{
+  scm_c_bitvector_clear_bit_x (vec, scm_to_size_t (idx));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME

libguile/bitvectors.h

@@ -36,7 +36,6 @@ SCM_API SCM scm_bitvector_p (SCM vec);
 SCM_API SCM scm_bitvector (SCM bits);
 SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
 SCM_API SCM scm_bitvector_length (SCM vec);
-SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
 SCM_API SCM scm_list_to_bitvector (SCM list);
 SCM_API SCM scm_bitvector_to_list (SCM vec);
 SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
@@ -54,7 +53,8 @@ SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
 SCM_API size_t scm_c_bitvector_length (SCM vec);
 SCM_API int scm_c_bitvector_bit_is_set (SCM vec, size_t idx);
 SCM_API int scm_c_bitvector_bit_is_clear (SCM vec, size_t idx);
-SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_API void scm_c_bitvector_set_bit_x (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_clear_bit_x (SCM vec, size_t idx);
 SCM_API const uint32_t *scm_array_handle_bit_elements (scm_t_array_handle *h);
 SCM_API uint32_t *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
 SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);

libguile/deprecated.c

@@ -123,6 +123,53 @@ SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+  scm_c_issue_deprecation_warning
+    ("bitvector-set! is deprecated.  Use bitvector-set-bit! or "
+     "bitvector-clear-bit! instead.");
+
+  if (scm_is_bitvector (vec))
+    {
+      if (scm_is_true (val))
+        scm_c_bitvector_set_bit_x (vec, idx);
+      else
+        scm_c_bitvector_clear_bit_x (vec, idx);
+    }
+  else
+    {
+      scm_t_array_handle handle;
+      uint32_t *bits, mask;
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+
+      mask = 1L << (idx%32);
+      if (scm_is_true (val))
+        bits[idx/32] |= mask;
+      else
+        bits[idx/32] &= ~mask;
+
+      scm_array_handle_release (&handle);
+    }
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+	    (SCM vec, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the bitvector\n"
+	    "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
 	    (SCM b, SCM bitvector),
 	    "Return the number of occurrences of the boolean @var{b} in\n"

libguile/deprecated.h

@@ -117,6 +117,8 @@ SCM_DEPRECATED char* scm_find_executable (const char *name);
 
 SCM_DEPRECATED SCM scm_c_bitvector_ref (SCM vec, size_t idx);
 SCM_DEPRECATED SCM scm_bitvector_ref (SCM vec, SCM idx);
+SCM_DEPRECATED void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_DEPRECATED SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
 SCM_DEPRECATED SCM scm_bit_count (SCM item, SCM seq);
 SCM_DEPRECATED SCM scm_bit_position (SCM item, SCM v, SCM k);
 SCM_DEPRECATED SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);

libguile/posix.c

@@ -2137,7 +2137,7 @@ cpu_set_to_bitvector (const cpu_set_t *cs)
     {
       if (CPU_ISSET (cpu, cs))
 	/* XXX: This is inefficient but avoids code duplication.  */
-	scm_c_bitvector_set_x (bv, cpu, SCM_BOOL_T);
+	scm_c_bitvector_set_bit_x (bv, cpu);
     }
 
   return bv;

module/ice-9/sandbox.scm

@@ -1093,10 +1093,11 @@ allocation limit is exceeded, an exception will be thrown to the
 (define mutating-bitvector-bindings
   '(((guile)
      bit-invert!
+     bitvector-clear-bit!
      bitvector-clear-bits!
-     bitvector-set-bits!
      bitvector-fill!
-     bitvector-set!)))
+     bitvector-set-bit!
+     bitvector-set-bits!)))
 
 (define fluid-bindings
   '(((guile)

module/system/vm/disassembler.scm

@@ -496,7 +496,7 @@ address of that offset."
       ((static-opcode-set inst ...)
        (let ((bv (make-bitvector 256 #f)))
          (for-each (lambda (inst)
-                     (bitvector-set! bv (instruction-opcode inst) #t))
+                     (bitvector-set-bit! bv (instruction-opcode inst)))
                    (syntax->datum #'(inst ...)))
          (datum->syntax #'static-opcode-set bv))))))
 

module/system/vm/frame.scm

@@ -169,7 +169,7 @@
       (when (< n (vector-length defs))
         (match (vector-ref defs n)
           (#(_ _ slot _)
-           (bitvector-set! (vector-ref by-slot slot) n #t)
+           (bitvector-set-bit! (vector-ref by-slot slot) n)
            (lp (1+ n))))))
     by-slot))
 
@@ -256,7 +256,7 @@
             (bitvector-copy! out in)
             (bitvector-clear-bits! out kill)
             (for-each (lambda (def)
-                        (bitvector-set! out def #t))
+                        (bitvector-set-bit! out def))
                       gen)
             (lp (1+ n) first?
                 (or changed? (not (eqv? out-count (bitvector-count out))))))))

test-suite/tests/bitvectors.test

@@ -43,8 +43,12 @@
     (let ((bv (list->bitvector '(#f #f #t #f #t))))
       (pass-if (eqv? (bitvector-bit-set? bv 0) #f))
       (pass-if (eqv? (bitvector-bit-set? bv 2) #t))
-      (bitvector-set! bv 0 #t)
+      (bitvector-set-bit! bv 0)
-      (pass-if (eqv? (bitvector-bit-set? bv 0) #t))))
+      (pass-if (eqv? (bitvector-bit-set? bv 0) #t))
+      (pass-if (eqv? (bitvector-bit-clear? bv 0) #f))
+      (bitvector-clear-bit! bv 0)
+      (pass-if (eqv? (bitvector-bit-set? bv 0) #f))
+      (pass-if (eqv? (bitvector-bit-clear? bv 0) #t))))
 
   (with-test-prefix "as array"
     (let ((bv (list->bitvector '(#f #f #t #f #t))))