From bfd38b857757c767c1b94762aeb35db112c4f76b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 21 Apr 2020 21:58:33 +0200 Subject: [PATCH] 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 | 134 +++++++++---------------------- 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, 154 insertions(+), 118 deletions(-) diff --git a/NEWS b/NEWS index 5a33dacbe..84bf4256e 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 bb8f97a73..abd45569a 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 69efd458f..e8993b842 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" { + VALIDATE_BITVECTOR (1, bv); + VALIDATE_BITVECTOR (2, bits); + + 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 (v_len < kv_len) + SCM_MISC_ERROR ("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); + 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); - /* Validate that OBJ is a boolean so this is done even if we don't - need BIT. - */ - int bit = scm_to_bool (obj); + return count; +} +#undef FUNC_NAME - 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); - - 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); - } - - return scm_from_size_t (count); +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 3cf7697dd..a855e1fc6 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 b48982b10..861ade56a 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 0a663eb0d..6366e5e34 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 799db250d..fcfc57365 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 070a15f6c..557a68e08 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)))