bitvector-bit-set? / bitvector-bit-clear? replace bitvector-ref

This is an opportunity to make a new interface that can be more
efficient in 3.0 (because no generic array support), easier to read (no
need for 'not'), and more consistent with other bitvector interfaces.

* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/array-handle.h (bitvector_ref, scm_array_get_handle): Adapt
  to bitvector changes.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_c_bitvector_bit_is_set)
  (scm_c_bitvector_bit_is_clear): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bitvector_ref): Deprecate.
* module/ice-9/sandbox.scm (bitvector-bindings): Replace
  bitvector-ref with bitvector-bit-set? / bitvector-bit-clear?.
* module/system/vm/disassembler.scm (instruction-has-fallthrough): Use
  bitvector-bit-clear?.
* test-suite/tests/bitvectors.test: Update.

NEWS

@@ -19,6 +19,13 @@ These replace the wonky "bit-count" and "bit-position" procedures.  See
 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
+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 deprecations
 
 ** bit-count, bit-position deprecated
@@ -26,6 +33,10 @@ manual, for more.
 Use bitvector-count or bitvector-position instead.  See "Bit Vectors" in
 the manual.
 
+** 'bitvector-ref' deprecated
+
+Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead.
+
 ** 'bit-set*!' deprecated
 
 Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead.

doc/ref/api-data.texi

@@ -6573,15 +6573,17 @@ Like @code{scm_bitvector_length}, but the length is returned as a
 @code{size_t}.
 @end deftypefn
 
-@deffn {Scheme Procedure} bitvector-ref vec idx
-@deffnx {C Function} scm_bitvector_ref (vec, idx)
-Return the element at index @var{idx} of the bitvector
-@var{vec}.
+@deffn {Scheme Procedure} bitvector-bit-set? vec idx
+@deffnx {Scheme Procedure} bitvector-bit-clear? vec idx
+Return @code{#t} if the bit at index @var{idx} of the bitvector
+@var{vec} is set (for @code{bitvector-bit-set?}) or clear (for
+@code{bitvector-bit-clear?}).
 @end deffn
 
-@deftypefn {C Function} SCM scm_c_bitvector_ref (SCM vec, size_t idx)
-Return the element at index @var{idx} of the bitvector
-@var{vec}.
+@deftypefn {C Function} int scm_bitvector_bit_is_set (SCM vec, size_t idx)
+@deftypefnx {C Function} int scm_bitvector_bit_is_clear (SCM vec, size_t idx)
+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

libguile/array-handle.c

@@ -27,6 +27,7 @@
 #include <string.h>
 
 #include "arrays.h"
+#include "boolean.h"
 #include "bitvectors.h"
 #include "bytevectors.h"
 #include "list.h"
@@ -167,6 +168,12 @@ initialize_vector_handle (scm_t_array_handle *h, size_t len,
   h->vset = vset;
 }
 
+static SCM
+bitvector_ref (SCM bv, size_t idx)
+{
+  return scm_from_bool (scm_c_bitvector_bit_is_set (bv, idx));
+}
+
 void
 scm_array_get_handle (SCM array, scm_t_array_handle *h)
 {
@@ -194,7 +201,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
     case scm_tc7_bitvector:
       initialize_vector_handle (h, scm_c_bitvector_length (array),
                                 SCM_ARRAY_ELEMENT_TYPE_BIT,
-                                scm_c_bitvector_ref, scm_c_bitvector_set_x,
+                                bitvector_ref,
+                                scm_c_bitvector_set_x,
                                 scm_i_bitvector_bits (array),
                                 scm_i_is_mutable_bitvector (array));
       break;

libguile/bitvectors.c

@@ -254,45 +254,42 @@ scm_bitvector_writable_elements (SCM vec,
   return (uint32_t *) ret;
 }
 
-SCM
-scm_c_bitvector_ref (SCM vec, size_t idx)
+int
+scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
 {
-  const uint32_t *bits;
+  if (!IS_BITVECTOR (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));
 
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-    }
-  else
-    {
-      SCM res;
-      scm_t_array_handle handle;
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-      scm_c_issue_deprecation_warning
-        ("Using bitvector-ref on arrays is deprecated.  "
-         "Use array-ref instead.");
-      if (idx >= len)
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-      scm_array_handle_release (&handle);
-      return res;
-    }
+  const uint32_t *bits = BITVECTOR_BITS (vec);
+  return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0;
 }
 
-SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
-	    (SCM vec, SCM idx),
-	    "Return the element at index @var{idx} of the bitvector\n"
-	    "@var{vec}.")
-#define FUNC_NAME s_scm_bitvector_ref
+int
+scm_c_bitvector_bit_is_clear (SCM vec, size_t idx)
 {
-  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+  return !scm_c_bitvector_bit_is_set (vec, idx);
+}
+
+SCM_DEFINE_STATIC (scm_bitvector_bit_set_p, "bitvector-bit-set?", 2, 0, 0,
+                   (SCM vec, SCM idx),
+                   "Return @code{#t} if the bit at index @var{idx} of the \n"
+                   "bitvector @var{vec} is set, or @code{#f} otherwise.")
+#define FUNC_NAME s_scm_bitvector_bit_set_p
+{
+  return scm_from_bool (scm_c_bitvector_bit_is_set (vec, scm_to_size_t (idx)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_bitvector_bit_clear_p, "bitvector-bit-clear?", 2, 0, 0,
+                   (SCM vec, SCM idx),
+                   "Return @code{#t} if the bit at index @var{idx} of the \n"
+                   "bitvector @var{vec} is clear (unset), or @code{#f} otherwise.")
+#define FUNC_NAME s_scm_bitvector_bit_clear_p
+{
+  return scm_from_bool
+    (scm_c_bitvector_bit_is_clear (vec, scm_to_size_t (idx)));
 }
 #undef FUNC_NAME
 
@@ -724,7 +721,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
         {
           size_t kv_len = BITVECTOR_LENGTH (kv);
           for (size_t i = 0; i < kv_len; i++)
-            if (scm_is_true (scm_c_bitvector_ref (kv, i)))
+            if (scm_c_bitvector_bit_is_set (kv, i))
               {
                 SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
                 if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))

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_ref (SCM vec, SCM idx);
 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);
@@ -53,7 +52,8 @@ SCM_API SCM scm_bit_invert_x (SCM v);
 SCM_API int scm_is_bitvector (SCM obj);
 SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
 SCM_API size_t scm_c_bitvector_length (SCM vec);
-SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
+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 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);

libguile/deprecated.c

@@ -88,6 +88,41 @@ scm_find_executable (const char *name)
 
 
 
+SCM
+scm_c_bitvector_ref (SCM vec, size_t idx)
+{
+  scm_c_issue_deprecation_warning
+    ("bitvector-ref is deprecated.  Use bitvector-bit-set? instead.");
+
+  if (scm_is_bitvector (vec))
+    return scm_from_bool (scm_c_bitvector_bit_is_set (vec, idx));
+
+  SCM res;
+  scm_t_array_handle handle;
+  size_t len, off;
+  ssize_t inc;
+
+  const uint32_t *bits =
+    scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+
+  if (idx >= len)
+    scm_out_of_range (NULL, scm_from_size_t (idx));
+  idx = idx*inc + off;
+  res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+  scm_array_handle_release (&handle);
+  return res;
+}
+
+SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
+	    (SCM vec, SCM idx),
+	    "Return the element at index @var{idx} of the bitvector\n"
+	    "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_ref
+{
+  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+}
+#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

@@ -115,6 +115,8 @@ typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
 
 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 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);

module/ice-9/sandbox.scm

@@ -1082,7 +1082,8 @@ allocation limit is exceeded, an exception will be thrown to the
      bitvector
      bitvector->list
      bitvector-length
-     bitvector-ref
+     bitvector-bit-set?
+     bitvector-bit-clear?
      bitvector?
      list->bitvector
      make-bitvector)))

module/system/vm/disassembler.scm

@@ -509,7 +509,7 @@ address of that offset."
                        subr-call foreign-call continuation-call
                        j))
   (let ((opcode (logand (bytevector-u32-native-ref code pos) #xff)))
-    (not (bitvector-ref non-fallthrough-set opcode))))
+    (bitvector-bit-clear? non-fallthrough-set opcode)))
 
 (define-syntax define-jump-parser
   (lambda (x)

test-suite/tests/bitvectors.test

@@ -41,10 +41,10 @@
 (with-test-prefix "ref and set"
   (with-test-prefix "as bitvector"
     (let ((bv (list->bitvector '(#f #f #t #f #t))))
-      (pass-if (eqv? (bitvector-ref bv 0) #f))
-      (pass-if (eqv? (bitvector-ref bv 2) #t))
+      (pass-if (eqv? (bitvector-bit-set? bv 0) #f))
+      (pass-if (eqv? (bitvector-bit-set? bv 2) #t))
       (bitvector-set! bv 0 #t)
-      (pass-if (eqv? (bitvector-ref bv 0) #t))))
+      (pass-if (eqv? (bitvector-bit-set? bv 0) #t))))
 
   (with-test-prefix "as array"
     (let ((bv (list->bitvector '(#f #f #t #f #t))))