Replace bit-count with bitvector-count

The old name was wonky and had bad argument order.

* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/bitvectors.h:
* libguile/bitvectors.c (VALIDATE_BITVECTOR): New helper.
  (scm_bitvector_count): New function.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bit_count): Deprecate.
* module/ice-9/sandbox.scm (bitvector-bindings): Replace bit-count with
  bitvector-count.
* module/srfi/srfi-60.scm: No need to #:replace bit-count.
* module/system/vm/frame.scm (available-bindings): Use bitvector-count.
* test-suite/tests/bitvectors.test ("bitvector-count"): Add test.

NEWS

@@ -7,8 +7,19 @@ Please send Guile bug reports to bug-guile@gnu.org.
 
 Changes in 3.0.3 (since 3.0.2)
 
+* New interfaces and functionality
+
+** New bitvector-count procedure
+
+This replaces the wonky "bit-count" procedure.  See "Bit Vectors" in the
+manual, for more.
+
 * New deprecations
 
+** bit-count deprecated
+
+Use bitvector-count instead.  See "Bit Vectors" in the manual.
+
 ** 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

@@ -6613,13 +6613,12 @@ Return a new list initialized with the elements
 of the bitvector @var{vec}.
 @end deffn
 
-@deffn {Scheme Procedure} bit-count bool bitvector
+@deffn {Scheme Procedure} bitvector-count bitvector
-@deffnx {C Function} scm_bit_count (bool, bitvector)
+@deffnx {C Function} scm_bitvector_count (bitvector)
-Return a count of how many entries in @var{bitvector} are equal to
+Return a count of how many entries in @var{bitvector} are set.
-@var{bool}.  For example,
 
 @example
-(bit-count #f #*000111000)  @result{} 6
+(bitvector-count #*000111000)  @result{} 3
 @end example
 @end deffn
 

libguile/bitvectors.c

@@ -58,6 +58,10 @@
 #define BITVECTOR_LENGTH(obj)   ((size_t)SCM_CELL_WORD_1(obj))
 #define BITVECTOR_BITS(obj)     ((uint32_t *)SCM_CELL_WORD_2(obj))
 
+#define VALIDATE_BITVECTOR(_pos, _obj)                                  \
+  SCM_ASSERT_TYPE (IS_BITVECTOR (_obj), (_obj), (_pos), FUNC_NAME,      \
+                   "bitvector")
+
 uint32_t *
 scm_i_bitvector_bits (SCM vec)
 {
@@ -479,51 +483,30 @@ count_ones (uint32_t x)
   return (x+(x>>16)) & 0xff;
 }
 
-SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
+SCM_DEFINE (scm_bitvector_count, "bitvector-count", 1, 0, 0,
-	    (SCM b, SCM bitvector),
+	    (SCM bitvector),
-	    "Return the number of occurrences of the boolean @var{b} in\n"
+	    "Return the number of set bits in @var{bitvector}.")
-	    "@var{bitvector}.")
+#define FUNC_NAME s_scm_bitvector_count
-#define FUNC_NAME s_scm_bit_count
 {
-  int bit = scm_to_bool (b);
+  VALIDATE_BITVECTOR (1, bitvector);
-  size_t count = 0, len;
 
-  if (IS_BITVECTOR (bitvector))
+  size_t len = BITVECTOR_LENGTH (bitvector);
-    {
+
-      len = BITVECTOR_LENGTH (bitvector);
+  if (len == 0)
+    return SCM_INUM0;
 
-      if (len > 0)
-        {
   const uint32_t *bits = BITVECTOR_BITS (bitvector);
-          size_t word_len = (len + 31) / 32;
+  size_t count = 0;
-          uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
 
+  size_t word_len = (len + 31) / 32;
   size_t i;
   for (i = 0; i < word_len-1; i++)
     count += count_ones (bits[i]);
+
+  uint32_t last_mask =  ((uint32_t)-1) >> (32*word_len - len);
   count += count_ones (bits[i] & last_mask);
-        }
-    }
-  else
-    {
-      scm_t_array_handle handle;
-      size_t off;
-      ssize_t inc;
 
-      scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
+  return scm_from_size_t (count);
-
-      scm_c_issue_deprecation_warning
-        ("Using bit-count on arrays is deprecated.  "
-         "Use array->list instead.");
-
-      for (size_t i = 0; i < len; i++)
-	if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
-	  count++;
-
-      scm_array_handle_release (&handle);
-    }
-  
-  return scm_from_size_t (bit ? count : len-count);
 }
 #undef FUNC_NAME
 

libguile/bitvectors.h

@@ -42,7 +42,8 @@ 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);
 
-SCM_API SCM scm_bit_count (SCM item, SCM seq);
+SCM_API SCM scm_bitvector_count (SCM v);
+
 SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
 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);

libguile/deprecated.c

@@ -27,9 +27,11 @@
 
 #define SCM_BUILDING_DEPRECATED_CODE
 
+#include "boolean.h"
 #include "bitvectors.h"
 #include "deprecation.h"
 #include "gc.h"
+#include "gsubr.h"
 #include "strings.h"
 
 #include "deprecated.h"
@@ -85,6 +87,43 @@ scm_find_executable (const char *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"
+	    "@var{bitvector}.")
+#define FUNC_NAME s_scm_bit_count
+{
+  int bit = scm_to_bool (b);
+  size_t count = 0, len;
+
+  scm_c_issue_deprecation_warning
+    ("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)))
+    {
+      len = scm_to_size_t (scm_bitvector_length (bitvector));
+      count = scm_to_size_t (scm_bitvector_count (bitvector));
+    }
+  else
+    {
+      scm_t_array_handle handle;
+      size_t off;
+      ssize_t inc;
+
+      scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
+
+      for (size_t i = 0; i < len; i++)
+	if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
+	  count++;
+
+      scm_array_handle_release (&handle);
+    }
+  
+  return scm_from_size_t (bit ? count : len-count);
+}
+#undef FUNC_NAME
+
 SCM
 scm_istr2bve (SCM str)
 {

libguile/deprecated.h

@@ -115,6 +115,7 @@ typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
 
 SCM_DEPRECATED char* scm_find_executable (const char *name);
 
+SCM_DEPRECATED SCM scm_bit_count (SCM item, SCM seq);
 SCM_DEPRECATED SCM scm_istr2bve (SCM str);
 
 void scm_i_init_deprecated (void);

module/ice-9/sandbox.scm

@@ -1075,7 +1075,7 @@ allocation limit is exceeded, an exception will be thrown to the
 
 (define bitvector-bindings
   '(((guile)
-     bit-count
+     bitvector-count
      bit-count*
      bit-extract
      bit-position

module/srfi/srfi-60.scm

@@ -1,6 +1,6 @@
 ;;; srfi-60.scm --- Integers as Bits
 
-;; Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2010, 2020 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -26,6 +26,7 @@
 	    log2-binary-factors first-set-bit
 	    bit-set?
 	    copy-bit
+            bit-count
 	    bit-field
 	    copy-bit-field
 	    arithmetic-shift
@@ -34,7 +35,6 @@
 	    integer->list
 	    list->integer
 	    booleans->integer)
-  #:replace (bit-count)
   #:re-export (logand
 	       logior
 	       logxor

module/system/vm/frame.scm

@@ -243,7 +243,7 @@
               (out (vector-ref outv n))
               (kill (vector-ref killv n))
               (gen (vector-ref genv n)))
-          (let ((out-count (or changed? (bit-count #t out))))
+          (let ((out-count (or changed? (bitvector-count out))))
             (bitvector-fill! in (not (zero? n)))
             (let lp ((preds (vector-ref preds n)))
               (match preds
@@ -258,7 +258,7 @@
                         (bitvector-set! out def #t))
                       gen)
             (lp (1+ n) first?
-                (or changed? (not (eqv? out-count (bit-count #t out))))))))
+                (or changed? (not (eqv? out-count (bitvector-count out))))))))
        ((or changed? first?)
         (lp 0 #f #f))))
 

test-suite/tests/bitvectors.test

@@ -71,5 +71,10 @@
       (bit-set*! v #*101 #f)
       (equal? v #*0100))))
 
+(with-test-prefix "bitvector-count"
+  (pass-if-equal 6 (bitvector-count #*01110111))
+  (pass-if-equal 2 (let ((bv #*01110111))
+                     (- (bitvector-length bv) (bitvector-count bv)))))
+
 (with-test-prefix "bit-count*"
   (pass-if-equal 3 (bit-count* #*01110111 #*11001101 #t)))