Replace bit-set*! with bitvector-set-bits! / bitvector-clear-bits!

The old name was wonky and hard to read: you almost always pass a
literal as the value to set, so better to make separate functions.

* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_bitvector_set_bits_x)
  (scm_bitvector_clear_bits_x): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bit_set_star_x): Deprecate.
* module/ice-9/sandbox.scm (mutable-bitvector-bindings): Replace
  bit-set*! with bitvector-set-bits! / bitvector-clear-bits!.
* module/system/vm/frame.scm (available-bindings, compute-killv): Use
  bitvector-set-bits! and bitvector-clear-bits!.
* test-suite/tests/bitvectors.test: Update.

NEWS

@@ -14,6 +14,11 @@ 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 deprecations
 
 ** bit-count, bit-position deprecated
@@ -21,6 +26,10 @@ These replace the wonky "bit-count" and "bit-position" procedures.  See
 Use bitvector-count or bitvector-position instead.  See "Bit Vectors" in
 the manual.
 
+** 'bit-set*!' deprecated
+
+Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead.
+
 ** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated
 
 These functions had an interface that allowed the second bit-selection

doc/ref/api-data.texi

@@ -6640,24 +6640,34 @@ entry between @var{start} and the end of @var{bitvector}, then return
 Modify @var{bitvector} by replacing each element with its negation.
 @end deffn
 
-@deffn {Scheme Procedure} bit-set*! bitvector bits bool
+@deffn {Scheme Procedure} bitvector-set-bits! bitvector bits
-@deffnx {C Function} scm_bit_set_star_x (bitvector, bits, bool)
+@deffnx {C Function} scm_bit_set_star_x (bitvector, bits)
-Set entries of @var{bitvector} to @var{bool}, with @var{bits} selecting
+Set entries of @var{bitvector} to @code{#t}, with @var{bits} selecting
-the entries to change.  The return value is unspecified.  Those bits in
+the bits to set.  The return value is unspecified.  @var{bitvector} must
-the bitvector @var{bits} which are set to one indicate the bits in
+be at least as long as @var{bits}.
-@var{bitvector} to set to @var{bool}.  @var{bitvector} must be at least
-as long as @var{bits}.  When @var{bool} is @code{#t} it is as if
-@var{bits} is OR'ed into @var{bitvector}, whereas when @var{bool} is
-@code{#f} is like an ANDNOT.
 
 @example
-(define bv #*01000010)
+(define bv (bitvector-copy #*11000010))
-(bit-set*! bv #*10010001 #t)
+(bitvector-set-bits! bv #*10010001)
 bv
 @result{} #*11010011
 @end example
 @end deffn
 
+@deffn {Scheme Procedure} bitvector-clear-bits! bitvector bits
+@deffnx {C Function} scm_bitvector_clear_bits_x (bitvector, bits)
+Set entries of @var{bitvector} to @code{#f}, with @var{bits} selecting
+the bits to clear.  The return value is unspecified.  @var{bitvector}
+must be at least as long as @var{bits}.
+
+@example
+(define bv (bitvector-copy #*11000010))
+(bitvector-clear-bits! bv #*10010001)
+bv
+@result{} #*01000010
+@end example
+@end deffn
+
 @deffn {Scheme Procedure} bit-count* bitvector bits bool
 @deffnx {C Function} scm_bit_count_star (bitvector, bits, bool)
 Return a count of how many entries in @var{bitvector} are equal to

libguile/bitvectors.c

@@ -61,6 +61,9 @@
 #define VALIDATE_BITVECTOR(_pos, _obj)                                  \
   SCM_ASSERT_TYPE (IS_BITVECTOR (_obj), (_obj), (_pos), FUNC_NAME,      \
                    "bitvector")
+#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj)                          \
+  SCM_ASSERT_TYPE (IS_MUTABLE_BITVECTOR (_obj), (_obj), (_pos),         \
+                   FUNC_NAME, "mutable bitvector")
 
 uint32_t *
 scm_i_bitvector_bits (SCM vec)
@@ -575,46 +578,66 @@ SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+SCM_DEFINE (scm_bitvector_set_bits_x, "bitvector-set-bits!", 2, 0, 0,
-	    (SCM v, SCM kv, SCM obj),
+	    (SCM v, SCM bits),
-	    "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+	    "Update the bitvector @var{v} in place by performing a logical\n"
-	    "selecting the entries to change.  The return value is\n"
+            "OR of its bits with those of @var{bits}.\n"
-	    "unspecified.\n"
+            "For example:\n"
-	    "\n"
-	    "If @var{kv} is a bit vector, then those entries where it has\n"
-	    "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
-	    "@var{v} must be at least as long as @var{kv}.  When @var{obj}\n"
-	    "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
-	    "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
 	    "\n"
 	    "@example\n"
-	    "(define bv #*01000010)\n"
+	    "(define bv (bitvector-copy #*11000010))\n"
-	    "(bit-set*! bv #*10010001 #t)\n"
+	    "(bitvector-set-bits! bv #*10010001)\n"
 	    "bv\n"
 	    "@result{} #*11010011\n"
-	    "@end example\n"
-	    "\n"
-	    "If @var{kv} is a u32vector, then its elements are\n"
-	    "indices into @var{v} which are set to @var{obj}.\n"
-	    "\n"
-	    "@example\n"
-	    "(define bv #*01000010)\n"
-	    "(bit-set*! bv #u32(5 2 7) #t)\n"
-	    "bv\n"
-	    "@result{} #*01100111\n"
 	    "@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
+#define FUNC_NAME s_scm_bitvector_set_bits_x
 {
-  /* Validate that OBJ is a boolean so this is done even if we don't
+  VALIDATE_MUTABLE_BITVECTOR (1, v);
-     need BIT.  */
+  VALIDATE_BITVECTOR (2, bits);
-  int bit = scm_to_bool (obj);
-
-  if (IS_MUTABLE_BITVECTOR (v) && IS_BITVECTOR (kv))
-    {
   size_t v_len = BITVECTOR_LENGTH (v);
   uint32_t *v_bits = BITVECTOR_BITS (v);
-      size_t kv_len = BITVECTOR_LENGTH (kv);
+  size_t kv_len = BITVECTOR_LENGTH (bits);
-      const uint32_t *kv_bits = BITVECTOR_BITS (kv);
+  const uint32_t *kv_bits = BITVECTOR_BITS (bits);
+
+  if (v_len < kv_len)
+    scm_misc_error (NULL,
+                    "selection bitvector longer than target bitvector",
+                    SCM_EOL);
+      
+  if (kv_len > 0)
+    {
+      size_t word_len = (kv_len + 31) / 32;
+      uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+      size_t i;
+      for (i = 0; i < word_len-1; i++)
+        v_bits[i] |= kv_bits[i];
+      v_bits[i] |= kv_bits[i] & last_mask;
+    }
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_clear_bits_x, "bitvector-clear-bits!", 2, 0, 0,
+	    (SCM v, SCM bits),
+	    "Update the bitvector @var{v} in place by performing a logical\n"
+            "AND of its bits with the complement of those of @var{bits}.\n"
+            "For example:\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv (bitvector-copy #*11000010))\n"
+	    "(bitvector-clear-bits! bv #*10010001)\n"
+	    "bv\n"
+	    "@result{} #*01000010\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bitvector_clear_bits_x
+{
+  VALIDATE_MUTABLE_BITVECTOR (1, v);
+  VALIDATE_BITVECTOR (2, bits);
+  size_t v_len = BITVECTOR_LENGTH (v);
+  uint32_t *v_bits = BITVECTOR_BITS (v);
+  size_t kv_len = BITVECTOR_LENGTH (bits);
+  const uint32_t *kv_bits = BITVECTOR_BITS (bits);
 
   if (v_len < kv_len)
     scm_misc_error (NULL,
@@ -627,73 +650,15 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
       uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
       size_t i;
 
-          if (bit == 0)
-            {
       for (i = 0; i < word_len-1; i++)
         v_bits[i] &= ~kv_bits[i];
       v_bits[i] &= ~(kv_bits[i] & last_mask);
     }
-          else
-            {
-              for (i = 0; i < word_len-1; i++)
-                v_bits[i] |= kv_bits[i];
-              v_bits[i] |= kv_bits[i] & last_mask;
-            }
-        }
-    }
-  else
-    {
-      scm_t_array_handle v_handle;
-      size_t v_off, v_len;
-      ssize_t v_inc;
-      scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
-
-      if (!IS_MUTABLE_BITVECTOR (v))
-        scm_c_issue_deprecation_warning
-          ("Using bit-set*! on arrays is deprecated.  "
-           "Use array-set! in a loop instead.");
-
-      if (IS_BITVECTOR (kv))
-        {
-          size_t kv_len = BITVECTOR_LENGTH (kv);
-
-          if (v_len < kv_len)
-            scm_misc_error (NULL,
-                            "selection bitvector longer than target bitvector",
-                            SCM_EOL);
-
-	  for (size_t i = 0; i < kv_len; i++)
-	    if (scm_is_true (scm_c_bitvector_ref (kv, i)))
-	      scm_array_handle_set (&v_handle, i*v_inc, obj);
-        }
-      else if (scm_is_true (scm_u32vector_p (kv)))
-        {
-          scm_c_issue_deprecation_warning
-            ("Passing a u32vector to bit-set*! is deprecated.  "
-             "Use bitvector-set! in a loop instead.");
-
-          scm_t_array_handle kv_handle;
-          size_t kv_len;
-          ssize_t kv_inc;
-          const uint32_t *kv_elts;
-
-          kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-          for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
-            scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
-          scm_array_handle_release (&kv_handle);
-        }
-      else
-        scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-      scm_array_handle_release (&v_handle);
-    }
 
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-
 SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
            (SCM v, SCM kv, SCM obj),
 	    "Return a count of how many entries in bit vector @var{v} are\n"

libguile/bitvectors.h

@@ -44,8 +44,9 @@ SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
 
 SCM_API SCM scm_bitvector_count (SCM v);
 SCM_API SCM scm_bitvector_position (SCM v, SCM item, SCM start);
+SCM_API SCM scm_bitvector_set_bits_x (SCM v, SCM bits);
+SCM_API SCM scm_bitvector_clear_bits_x (SCM v, SCM bits);
 
-SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
 SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
 SCM_API SCM scm_bit_invert_x (SCM v);
 

libguile/deprecated.c

@@ -32,6 +32,7 @@
 #include "deprecation.h"
 #include "gc.h"
 #include "gsubr.h"
+#include "srfi-4.h"
 #include "strings.h"
 
 #include "deprecated.h"
@@ -100,7 +101,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
     ("bit-count is deprecated.  Use bitvector-count, or a loop over array-ref "
      "if array support is needed.");
 
-  if (scm_is_true (scm_bitvector_p (bitvector)))
+  if (scm_is_bitvector (bitvector))
     {
       len = scm_to_size_t (scm_bitvector_length (bitvector));
       count = scm_to_size_t (scm_bitvector_count (bitvector));
@@ -141,7 +142,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
     ("bit-position is deprecated.  Use bitvector-position, or "
      "array-ref in a loop if you need generic arrays instead.");
 
-  if (scm_is_true (scm_bitvector_p (v)))
+  if (scm_is_bitvector (v))
     return scm_bitvector_position (v, item, k);
 
   scm_t_array_handle handle;
@@ -166,6 +167,87 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+	    (SCM v, SCM kv, SCM obj),
+	    "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+	    "selecting the entries to change.  The return value is\n"
+	    "unspecified.\n"
+	    "\n"
+	    "If @var{kv} is a bit vector, then those entries where it has\n"
+	    "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
+	    "@var{v} must be at least as long as @var{kv}.  When @var{obj}\n"
+	    "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
+	    "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #*10010001 #t)\n"
+	    "bv\n"
+	    "@result{} #*11010011\n"
+	    "@end example\n"
+	    "\n"
+	    "If @var{kv} is a u32vector, then its elements are\n"
+	    "indices into @var{v} which are set to @var{obj}.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #u32(5 2 7) #t)\n"
+	    "bv\n"
+	    "@result{} #*01100111\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+  scm_c_issue_deprecation_warning
+    ("bit-set*! is deprecated.  Use bitvector-set-bits! or "
+     "bitvector-clear-bits! on bitvectors, or array-set! in a loop "
+     "if you need to work on generic arrays.");
+
+  int bit = scm_to_bool (obj);
+  if (scm_is_bitvector (v) && scm_is_bitvector (kv))
+    return bit
+      ? scm_bitvector_set_bits_x (v, kv)
+      : scm_bitvector_clear_bits_x (v, kv);
+
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      size_t kv_len = scm_c_bitvector_length (kv);
+
+      if (v_len < kv_len)
+        scm_misc_error (NULL,
+                        "selection bitvector longer than target bitvector",
+                        SCM_EOL);
+
+      for (size_t i = 0; i < kv_len; i++)
+        if (scm_is_true (scm_c_bitvector_ref (kv, i)))
+          scm_array_handle_set (&v_handle, i*v_inc, obj);
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_len;
+      ssize_t kv_inc;
+      const uint32_t *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
+        scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM
 scm_istr2bve (SCM str)
 {

libguile/deprecated.h

@@ -117,6 +117,7 @@ SCM_DEPRECATED char* scm_find_executable (const char *name);
 
 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);
 SCM_DEPRECATED SCM scm_istr2bve (SCM str);
 
 void scm_i_init_deprecated (void);

module/ice-9/sandbox.scm

@@ -1092,7 +1092,8 @@ allocation limit is exceeded, an exception will be thrown to the
 (define mutating-bitvector-bindings
   '(((guile)
      bit-invert!
-     bit-set*!
+     bitvector-clear-bits!
+     bitvector-set-bits!
      bitvector-fill!
      bitvector-set!)))
 

module/system/vm/frame.scm

@@ -180,7 +180,8 @@
                  (compute-frame-sizes code parsed initial-frame-size))
                 ((killv) (make-vector (vector-length parsed) #f)))
     (define (kill-slot! n slot)
-      (bit-set*! (vector-ref killv n) (vector-ref defs-by-slot slot) #t))
+      (bitvector-set-bits! (vector-ref killv n)
+                           (vector-ref defs-by-slot slot)))
     (let lp ((n 0))
       (when (< n (vector-length killv))
         (vector-set! killv n (make-bitvector (vector-length defs) #f))
@@ -224,11 +225,11 @@
          (tmp (make-bitvector (vector-length defs) #f)))
     (define (bitvector-copy! dst src)
       (bitvector-fill! dst #f)
-      (bit-set*! dst src #t))
+      (bitvector-set-bits! dst src))
     (define (bitvector-meet! accum src)
       (bitvector-copy! tmp src)
       (bit-invert! tmp)
-      (bit-set*! accum tmp #f))
+      (bitvector-clear-bits! accum tmp))
 
     (let lp ((n 0))
       (when (< n len)
@@ -253,7 +254,7 @@
                    (bitvector-meet! in (vector-ref outv pred)))
                  (lp preds))))
             (bitvector-copy! out in)
-            (bit-set*! out kill #f)
+            (bitvector-clear-bits! out kill)
             (for-each (lambda (def)
                         (bitvector-set! out def #t))
                       gen)
@@ -280,7 +281,7 @@
                           ;; values defined by the call.
                           (begin
                             (bitvector-copy! tmp (vector-ref inv (1- n)))
-                            (bit-set*! tmp (vector-ref killv (1- n)) #f)
+                            (bitvector-clear-bits! tmp (vector-ref killv (1- n)))
                             tmp))))
             (let lp ((n 0))
               (let ((n (bitvector-position live #t n)))

test-suite/tests/bitvectors.test

@@ -53,22 +53,24 @@
       (array-set! bv #t 0)
       (pass-if (eqv? (array-ref bv 0) #t)))))
 
-(with-test-prefix "bit-set*!"
+(with-test-prefix "bitvector-set-bits!"
   (pass-if "#t"
     (let ((v (bitvector #t #t #f #f)))
-      (bit-set*! v #*1010 #t)
+      (bitvector-set-bits! v #*1010)
       (equal? v #*1110)))
-  (pass-if "#f"
-    (let ((v (bitvector #t #t #f #f)))
-      (bit-set*! v #*1010 #f)
-      (equal? v #*0100)))
   (pass-if "#t, shorter"
     (let ((v (bitvector #t #t #f #f)))
-      (bit-set*! v #*101 #t)
+      (bitvector-set-bits! v #*101)
-      (equal? v #*1110)))
+      (equal? v #*1110))))
+
+(with-test-prefix "bitvector-clear-bits!"
+  (pass-if "#f"
+    (let ((v (bitvector #t #t #f #f)))
+      (bitvector-clear-bits! v #*1010)
+      (equal? v #*0100)))
   (pass-if "#f, shorter"
     (let ((v (bitvector #t #t #f #f)))
-      (bit-set*! v #*101 #f)
+      (bitvector-clear-bits! v #*101)
       (equal? v #*0100))))
 
 (with-test-prefix "bitvector-count"