diff --git a/NEWS b/NEWS index 65cbd1c8b..e485226c0 100644 --- a/NEWS +++ b/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 diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 32d94e6ac..bce628cab 100644 --- a/doc/ref/api-data.texi +++ b/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 -@deffnx {C Function} scm_bit_count (bool, bitvector) -Return a count of how many entries in @var{bitvector} are equal to -@var{bool}. For example, +@deffn {Scheme Procedure} bitvector-count bitvector +@deffnx {C Function} scm_bitvector_count (bitvector) +Return a count of how many entries in @var{bitvector} are set. @example -(bit-count #f #*000111000) @result{} 6 +(bitvector-count #*000111000) @result{} 3 @end example @end deffn diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index f771b7735..02091024b 100644 --- a/libguile/bitvectors.c +++ b/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 b, SCM bitvector), - "Return the number of occurrences of the boolean @var{b} in\n" - "@var{bitvector}.") -#define FUNC_NAME s_scm_bit_count +SCM_DEFINE (scm_bitvector_count, "bitvector-count", 1, 0, 0, + (SCM bitvector), + "Return the number of set bits in @var{bitvector}.") +#define FUNC_NAME s_scm_bitvector_count { - int bit = scm_to_bool (b); - size_t count = 0, len; + VALIDATE_BITVECTOR (1, bitvector); - if (IS_BITVECTOR (bitvector)) - { - len = BITVECTOR_LENGTH (bitvector); + size_t len = BITVECTOR_LENGTH (bitvector); - if (len > 0) - { - const uint32_t *bits = BITVECTOR_BITS (bitvector); - size_t word_len = (len + 31) / 32; - uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); + if (len == 0) + return SCM_INUM0; - size_t i; - for (i = 0; i < word_len-1; i++) - count += count_ones (bits[i]); - count += count_ones (bits[i] & last_mask); - } - } - else - { - scm_t_array_handle handle; - size_t off; - ssize_t inc; + const uint32_t *bits = BITVECTOR_BITS (bitvector); + size_t count = 0; - scm_bitvector_elements (bitvector, &handle, &off, &len, &inc); + size_t word_len = (len + 31) / 32; + size_t i; + for (i = 0; i < word_len-1; i++) + count += count_ones (bits[i]); - scm_c_issue_deprecation_warning - ("Using bit-count on arrays is deprecated. " - "Use array->list instead."); + uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); + count += count_ones (bits[i] & last_mask); - 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); + return scm_from_size_t (count); } #undef FUNC_NAME diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 3a00bf267..2cf521385 100644 --- a/libguile/bitvectors.h +++ b/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); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 60459c603..e39d11e9d 100644 --- a/libguile/deprecated.c +++ b/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) { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index fb8854326..3bdef4ab4 100644 --- a/libguile/deprecated.h +++ b/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); diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm index 3f9359dab..a9eefbfdd 100644 --- a/module/ice-9/sandbox.scm +++ b/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 diff --git a/module/srfi/srfi-60.scm b/module/srfi/srfi-60.scm index b3ddaada7..9bf0a35ca 100644 --- a/module/srfi/srfi-60.scm +++ b/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 diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 47f0e1380..89b6399ae 100644 --- a/module/system/vm/frame.scm +++ b/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)))) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index 2b59e9285..18d77edc9 100644 --- a/test-suite/tests/bitvectors.test +++ b/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)))