[Guile-commits] 01/05: bitvector-count-bits replaces bit-count*

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit bfd38b857757c767c1b94762aeb35db112c4f76b
Author: Andy Wingo <address@hidden>
AuthorDate: Tue Apr 21 21:58:33 2020 +0200

    bitvector-count-bits replaces bit-count*
    
    * NEWS: Add entry.
    * doc/ref/api-data.texi (Bit Vectors): Update.
    * libguile/bitvectors.h:
    * libguile/bitvectors.c (scm_c_bitvector_count_bits): New function.
    * libguile/deprecated.h:
    * libguile/deprecated.c (scm_bit_count_star): Deprecate.
    * module/ice-9/sandbox.scm (bitvector-bindings): Replace bit-count* with
      bitvector-count-bits.
    * test-suite/tests/bitvectors.test: Update.
---
 NEWS                             |  12 +++-
 doc/ref/api-data.texi            |  30 +++++----
 libguile/bitvectors.c            | 132 +++++++++++----------------------------
 libguile/bitvectors.h            |   3 +-
 libguile/deprecated.c            |  86 +++++++++++++++++++++++++
 libguile/deprecated.h            |   1 +
 module/ice-9/sandbox.scm         |   2 +-
 test-suite/tests/bitvectors.test |   4 +-
 8 files changed, 153 insertions(+), 117 deletions(-)

diff --git a/NEWS b/NEWS
index 5a33dac..84bf425 100644
--- a/NEWS
+++ b/NEWS
@@ -9,10 +9,11 @@ Changes in 3.0.3 (since 3.0.2)
 
 * New interfaces and functionality
 
-** New bitvector-count, bitvector-position procedures
+** New bitvector-count, bitvector-count-bits, bitvector-position
+   procedures
 
-These replace the wonky "bit-count" and "bit-position" procedures.  See
-"Bit Vectors" in the manual, for more.
+These replace the wonky "bit-count", "bit-count*", and "bit-position"
+procedures.  See "Bit Vectors" in the manual, for more.
 
 ** New bitvector-bit-set?, bitvector-bit-clear? procedures
 
@@ -66,6 +67,11 @@ Use 'bitvector-flip-all-bits! instead.
 
 Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead.
 
+** 'bit-count*' deprecated
+
+Use 'bitvector-count-bits' instead, subtracting from 'bitvector-count'
+on the mask bitvector if you are counting unset bits.
+
 ** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated
 
 These functions had an interface that allowed the second bit-selection
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index bb8f97a..abd4556 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -6631,6 +6631,23 @@ Return a count of how many entries in @var{bitvector} 
are set.
 @end example
 @end deffn
 
+@deffn {Scheme Procedure} bitvector-count-bits bitvector bits
+Return a count of how many entries in @var{bitvector} are set, with the
+bitvector @var{bits} selecting the entries to consider.  @var{bitvector}
+must be at least as long as @var{bits}.
+
+For example,
+
+@example
+(bitvector-count-bits #*01110111 #*11001101) @result{} 3
+@end example
+@end deffn
+
+@deftypefn {C Function} size_t scm_c_bitvector_count_bits (SCM bitvector, SCM 
bits)
+Same as @code{bitvector-count-bits}, but returning a @code{size_t} for
+C.
+@end deftypefn
+
 @deffn {Scheme Procedure} bitvector-position bitvector bool start
 @deffnx {C Function} scm_bitvector_position (bitvector, bool, start)
 Return the index of the first occurrence of @var{bool} in
@@ -6672,19 +6689,6 @@ bv
 @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
-@var{bool}, with the bitvector @var{bits} selecting the entries to
-consider.  @var{bitvector} must be at least as long as @var{bits}.
-
-For example,
-
-@example
-(bit-count* #*01110111 #*11001101 #t) @result{} 3
-@end example
-@end deffn
-
 @deftypefn {C Function} {const scm_t_uint32 *} scm_bitvector_elements (SCM 
vec, scm_t_array_handle *handle, size_t *offp, size_t *lenp, ssize_t *incp)
 Like @code{scm_vector_elements} (@pxref{Vector Accessing from C}), but
 for bitvectors.  The variable pointed to by @var{offp} is set to the
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 69efd45..e8993b8 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -663,107 +663,47 @@ SCM_DEFINE (scm_bitvector_clear_bits_x, 
"bitvector-clear-bits!", 2, 0, 0,
 }
 #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"
-           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
-           "consider.\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 considered.\n"
-           "@var{kv} and @var{v} must be the same length.\n"
-           "\n"
-           "If @var{kv} is a u32vector, then it contains\n"
-           "the indexes in @var{v} to consider.\n"
-           "\n"
-           "For example,\n"
-           "\n"
-           "@example\n"
-           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
-           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_count_star
+size_t
+scm_c_bitvector_count_bits (SCM bv, SCM bits)
+#define FUNC_NAME "bitvector-count-bits"
 {
-  size_t count = 0;
+  VALIDATE_BITVECTOR (1, bv);
+  VALIDATE_BITVECTOR (2, bits);
 
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  int bit = scm_to_bool (obj);
+  size_t v_len = BITVECTOR_LENGTH (bv);
+  const uint32_t *v_bits = BITVECTOR_BITS (bv);
+  size_t kv_len = BITVECTOR_LENGTH (bits);
+  const uint32_t *kv_bits = BITVECTOR_BITS (bits);
 
-  if (IS_BITVECTOR (v) && IS_BITVECTOR (kv))
-    {
-      size_t v_len = BITVECTOR_LENGTH (v);
-      const uint32_t *v_bits = BITVECTOR_BITS (v);
-      size_t kv_len = BITVECTOR_LENGTH (kv);
-      const uint32_t *kv_bits = BITVECTOR_BITS (kv);
-
-      if (v_len < kv_len)
-        scm_misc_error (NULL,
-                        "selection bitvector longer than target bitvector",
-                        SCM_EOL);
-      
-      size_t i, word_len = (kv_len + 31) / 32;
-      uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
-      uint32_t xor_mask = bit? 0 : ((uint32_t)-1);
+  if (v_len < kv_len)
+    SCM_MISC_ERROR ("selection bitvector longer than target bitvector",
+                    SCM_EOL);
 
-      for (i = 0; i < word_len-1; i++)
-        count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
-      count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
-    }
-  else
-    {
-      scm_t_array_handle v_handle;
-      size_t v_off, v_len;
-      ssize_t v_inc;
-
-      scm_bitvector_elements (v, &v_handle, &v_off, &v_len, &v_inc);
-
-      if (!IS_BITVECTOR (v))
-        scm_c_issue_deprecation_warning
-          ("Using bit-count* on arrays is deprecated.  "
-           "Use array-set! in a loop instead.");
-
-      if (IS_BITVECTOR (kv))
-        {
-          size_t kv_len = BITVECTOR_LENGTH (kv);
-          for (size_t i = 0; i < kv_len; 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)))
-                  count++;
-              }
-        }
-      else if (scm_is_true (scm_u32vector_p (kv)))
-        {
-          scm_t_array_handle kv_handle;
-          size_t i, kv_len;
-          ssize_t kv_inc;
-          const uint32_t *kv_elts;
-
-          scm_c_issue_deprecation_warning
-            ("Passing a u32vector to bit-count* is deprecated.  "
-             "Use bitvector-ref in a loop instead.");
-
-          kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-
-          for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-            {
-              SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
-              if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-                count++;
-            }
-
-          scm_array_handle_release (&kv_handle);
-        }
-      else
-        scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-      scm_array_handle_release (&v_handle);
-    }
+  size_t i, word_len = (kv_len + 31) / 32;
+  uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
 
-  return scm_from_size_t (count);
+  size_t count = 0;
+  for (i = 0; i < word_len-1; i++)
+    count += count_ones (v_bits[i] & kv_bits[i]);
+  count += count_ones (v_bits[i] & kv_bits[i] & last_mask);
+
+  return count;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_bitvector_count_bits, "bitvector-count-bits", 2, 0, 0,
+                   (SCM v, SCM kv),
+                   "Return a count of how many entries in bit vector @var{v}\n"
+                   "are set, with @var{kv} selecting the entries to 
consider.\n"
+                   "\n"
+                   "For example,\n"
+                   "\n"
+                   "@example\n"
+                   "(bitvector-count-bits #*01110111 #*11001101) @result{} 3\n"
+                   "@end example")
+#define FUNC_NAME s_scm_bitvector_count_bits
+{
+  return scm_from_size_t (scm_c_bitvector_count_bits (v, kv));
 }
 #undef FUNC_NAME
 
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 3cf7697..a855e1f 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -44,8 +44,6 @@ 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_count_star (SCM v, SCM kv, SCM obj);
-
 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);
@@ -56,6 +54,7 @@ SCM_API void scm_c_bitvector_clear_bit_x (SCM vec, size_t 
idx);
 SCM_API void scm_c_bitvector_set_all_bits_x (SCM vec);
 SCM_API void scm_c_bitvector_clear_all_bits_x (SCM vec);
 SCM_API void scm_c_bitvector_flip_all_bits_x (SCM vec);
+SCM_API size_t scm_c_bitvector_count_bits (SCM v, SCM bits);
 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);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index b48982b..861ade5 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -272,6 +272,92 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
 }
 #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"
+           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
+           "consider.\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 considered.\n"
+           "@var{kv} and @var{v} must be the same length.\n"
+           "\n"
+           "If @var{kv} is a u32vector, then it contains\n"
+           "the indexes in @var{v} to consider.\n"
+           "\n"
+           "For example,\n"
+           "\n"
+           "@example\n"
+           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
+           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_count_star
+{
+  size_t count = 0;
+
+  scm_c_issue_deprecation_warning
+    ("bit-count* is deprecated.  Use bitvector-count-bits instead, and in the "
+     "case of counting false bits, subtract from a bitvector-count on the "
+     "selection bitvector.");
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  int bit = scm_to_bool (obj);
+
+  if (scm_is_bitvector (v) && scm_is_bitvector (kv))
+    {
+      count = scm_c_bitvector_count_bits (v, kv);
+      if (count == 0)
+        count = scm_to_size_t (scm_bitvector_count (kv)) - count;
+    }
+  else
+    {
+      scm_t_array_handle v_handle;
+      size_t v_off, v_len;
+      ssize_t v_inc;
+
+      scm_bitvector_elements (v, &v_handle, &v_off, &v_len, &v_inc);
+
+      if (scm_is_bitvector (kv))
+        {
+          size_t kv_len = scm_c_bitvector_length (kv);
+          for (size_t i = 0; i < kv_len; 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)))
+                  count++;
+              }
+        }
+      else if (scm_is_true (scm_u32vector_p (kv)))
+        {
+          scm_t_array_handle kv_handle;
+          size_t i, kv_len;
+          ssize_t kv_inc;
+          const uint32_t *kv_elts;
+
+          kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+
+          for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+            {
+              SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+              if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+                count++;
+            }
+
+          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_from_size_t (count);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
            (SCM item, SCM v, SCM k),
            "Return the index of the first occurrence of @var{item} in bit\n"
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 0a663eb..6366e5e 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -122,6 +122,7 @@ SCM_DEPRECATED SCM scm_bitvector_set_x (SCM vec, SCM idx, 
SCM val);
 SCM_DEPRECATED SCM scm_bitvector_fill_x (SCM vec, SCM val);
 SCM_DEPRECATED SCM scm_bit_invert_x (SCM vec);
 SCM_DEPRECATED SCM scm_bit_count (SCM item, SCM seq);
+SCM_DEPRECATED SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
 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);
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index 799db25..fcfc573 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -1077,7 +1077,7 @@ allocation limit is exceeded, an exception will be thrown 
to the
   '(((guile)
      bitvector-count
      bitvector-position
-     bit-count*
+     bitvector-count-bits
      bit-extract
      bitvector
      bitvector->list
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index 070a15f..557a68e 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -101,5 +101,5 @@
   (pass-if-equal 5 (bitvector-position #*01110111 #t 5))
   (pass-if-equal #f (bitvector-position #*01110111 #f 5)))
 
-(with-test-prefix "bit-count*"
-  (pass-if-equal 3 (bit-count* #*01110111 #*11001101 #t)))
+(with-test-prefix "bitvector-count-bits"
+  (pass-if-equal 3 (bitvector-count-bits #*01110111 #*11001101)))