From 06709d77b9f519c712e13e086c7213e5a77fcbc4 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 12 Apr 2020 22:39:55 +0200 Subject: [PATCH] Replace bit-position with bitvector-position 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 (scm_bitvector_position): New function. * libguile/deprecated.h: * libguile/deprecated.c (scm_bit_position): Deprecate. * module/ice-9/sandbox.scm (bitvector-bindings): Replace bit-position with bitvector-position. * module/language/cps/intset.scm (bitvector->intset): Use bitvector-position. * module/system/vm/frame.scm (available-bindings): Use bitvector-position. * test-suite/tests/bitvectors.test ("bitvector-position"): Add test. --- NEWS | 11 ++-- doc/ref/api-data.texi | 8 +-- libguile/bitvectors.c | 89 ++++++++++++-------------------- libguile/bitvectors.h | 2 +- libguile/deprecated.c | 42 +++++++++++++++ libguile/deprecated.h | 1 + module/ice-9/sandbox.scm | 2 +- module/language/cps/intset.scm | 2 +- module/system/vm/frame.scm | 2 +- test-suite/tests/bitvectors.test | 8 +++ 10 files changed, 97 insertions(+), 70 deletions(-) diff --git a/NEWS b/NEWS index e485226c0..a006dd6ce 100644 --- a/NEWS +++ b/NEWS @@ -9,16 +9,17 @@ Changes in 3.0.3 (since 3.0.2) * New interfaces and functionality -** New bitvector-count procedure +** New bitvector-count, bitvector-position procedures -This replaces the wonky "bit-count" procedure. See "Bit Vectors" in the -manual, for more. +These replace the wonky "bit-count" and "bit-position" procedures. See +"Bit Vectors" in the manual, for more. * New deprecations -** bit-count deprecated +** bit-count, bit-position deprecated -Use bitvector-count instead. See "Bit Vectors" in the manual. +Use bitvector-count or bitvector-position instead. See "Bit Vectors" in +the manual. ** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index bce628cab..732884213 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6622,16 +6622,16 @@ Return a count of how many entries in @var{bitvector} are set. @end example @end deffn -@deffn {Scheme Procedure} bit-position bool bitvector start -@deffnx {C Function} scm_bit_position (bool, bitvector, start) +@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 @var{bitvector}, starting from @var{start}. If there is no @var{bool} entry between @var{start} and the end of @var{bitvector}, then return @code{#f}. For example, @example -(bit-position #t #*000101 0) @result{} 3 -(bit-position #f #*0001111 3) @result{} #f +(bitvector-position #*000101 #t 0) @result{} 3 +(bitvector-position #*0001111 #f 3) @result{} #f @end example @end deffn diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 02091024b..356b1c743 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -530,73 +530,48 @@ find_first_one (uint32_t x) return pos; } -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" - "vector @var{v}, starting from @var{k}. If there is no\n" - "@var{item} entry between @var{k} and the end of\n" +SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0, + (SCM v, SCM bit, SCM start), + "Return the index of the first occurrence of @var{bit} in bit\n" + "vector @var{v}, starting from @var{start} (or zero if not given)\n." + "If there is no @var{bit} entry between @var{start} and the end of\n" "@var{v}, then return @code{#f}. For example,\n" "\n" "@example\n" - "(bit-position #t #*000101 0) @result{} 3\n" - "(bit-position #f #*0001111 3) @result{} #f\n" + "(bitvector-position #*000101 #t) @result{} 3\n" + "(bitvector-position #*0001111 #f 3) @result{} #f\n" "@end example") -#define FUNC_NAME s_scm_bit_position +#define FUNC_NAME s_scm_bitvector_position { - int bit = scm_to_bool (item); - SCM res = SCM_BOOL_F; + VALIDATE_BITVECTOR (1, v); + + size_t len = BITVECTOR_LENGTH (v); + int c_bit = scm_to_bool (bit); + size_t first_bit = + SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len); - if (IS_BITVECTOR (v)) - { - size_t len = BITVECTOR_LENGTH (v); - if (len > 0) - { - size_t first_bit = scm_to_unsigned_integer (k, 0, len); - const uint32_t *bits = BITVECTOR_BITS (v); - size_t word_len = (len + 31) / 32; - uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); - size_t first_word = first_bit / 32; - uint32_t first_mask = - ((uint32_t)-1) << (first_bit - 32*first_word); + if (first_bit == len) + return SCM_BOOL_F; + + const uint32_t *bits = BITVECTOR_BITS (v); + size_t word_len = (len + 31) / 32; + uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len); + size_t first_word = first_bit / 32; + uint32_t first_mask = + ((uint32_t)-1) << (first_bit - 32*first_word); - for (size_t i = first_word; i < word_len; i++) - { - uint32_t w = bit ? bits[i] : ~bits[i]; - if (i == first_word) - w &= first_mask; - if (i == word_len-1) - w &= last_mask; - if (w) - { - res = scm_from_size_t (32*i + find_first_one (w)); - break; - } - } - } - } - else + for (size_t i = first_word; i < word_len; i++) { - scm_t_array_handle handle; - size_t off, len; - ssize_t inc; - scm_bitvector_elements (v, &handle, &off, &len, &inc); - scm_c_issue_deprecation_warning - ("Using bit-position on arrays is deprecated. " - "Use array-ref in a loop instead."); - size_t first_bit = scm_to_unsigned_integer (k, 0, len); - for (size_t i = first_bit; i < len; i++) - { - SCM elt = scm_array_handle_ref (&handle, i*inc); - if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt))) - { - res = scm_from_size_t (i); - break; - } - } - scm_array_handle_release (&handle); + uint32_t w = c_bit ? bits[i] : ~bits[i]; + if (i == first_word) + w &= first_mask; + if (i == word_len-1) + w &= last_mask; + if (w) + return scm_from_size_t (32*i + find_first_one (w)); } - return res; + return SCM_BOOL_F; } #undef FUNC_NAME diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 2cf521385..09a9a6147 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -43,8 +43,8 @@ SCM_API SCM scm_bitvector_to_list (SCM vec); SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val); SCM_API SCM scm_bitvector_count (SCM v); +SCM_API SCM scm_bitvector_position (SCM v, SCM item, SCM start); -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); SCM_API SCM scm_bit_invert_x (SCM v); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index e39d11e9d..2b1a338a5 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -124,6 +124,48 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, } #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" + "vector @var{v}, starting from @var{k}. If there is no\n" + "@var{item} entry between @var{k} and the end of\n" + "@var{v}, then return @code{#f}. For example,\n" + "\n" + "@example\n" + "(bit-position #t #*000101 0) @result{} 3\n" + "(bit-position #f #*0001111 3) @result{} #f\n" + "@end example") +#define FUNC_NAME s_scm_bit_position +{ + scm_c_issue_deprecation_warning + ("bit-position is deprecated. Use bitvector-position, or " + "array-ref in a loop if you need generic arrays instead."); + + if (scm_is_true (scm_bitvector_p (v))) + return scm_bitvector_position (v, item, k); + + scm_t_array_handle handle; + size_t off, len; + ssize_t inc; + scm_bitvector_elements (v, &handle, &off, &len, &inc); + int bit = scm_to_bool (item); + size_t first_bit = scm_to_unsigned_integer (k, 0, len); + SCM res = SCM_BOOL_F; + for (size_t i = first_bit; i < len; i++) + { + SCM elt = scm_array_handle_ref (&handle, i*inc); + if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt))) + { + res = scm_from_size_t (i); + break; + } + } + scm_array_handle_release (&handle); + + return res; +} +#undef FUNC_NAME + SCM scm_istr2bve (SCM str) { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 3bdef4ab4..edbbff418 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -116,6 +116,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_bit_position (SCM item, SCM v, SCM k); 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 a9eefbfdd..bd80a49fe 100644 --- a/module/ice-9/sandbox.scm +++ b/module/ice-9/sandbox.scm @@ -1076,9 +1076,9 @@ allocation limit is exceeded, an exception will be thrown to the (define bitvector-bindings '(((guile) bitvector-count + bitvector-position bit-count* bit-extract - bit-position bitvector bitvector->list bitvector-length diff --git a/module/language/cps/intset.scm b/module/language/cps/intset.scm index 7b2a66aaf..54def5cb5 100644 --- a/module/language/cps/intset.scm +++ b/module/language/cps/intset.scm @@ -781,7 +781,7 @@ out (intset-union out (make-intset min *leaf-bits* tail)))) (let lp ((out empty-intset) (min 0) (pos 0) (tail 0)) - (let ((pos (bit-position #t bv pos))) + (let ((pos (bitvector-position bv #t pos))) (cond ((not pos) (finish-tail out min tail)) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 89b6399ae..3800d5bf6 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -283,7 +283,7 @@ (bit-set*! tmp (vector-ref killv (1- n)) #f) tmp)))) (let lp ((n 0)) - (let ((n (bit-position #t live n))) + (let ((n (bitvector-position live #t n))) (if n (match (vector-ref defs n) (#(name def-offset slot representation) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index 18d77edc9..332c8ff55 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -76,5 +76,13 @@ (pass-if-equal 2 (let ((bv #*01110111)) (- (bitvector-length bv) (bitvector-count bv))))) +(with-test-prefix "bitvector-position" + (pass-if-equal 0 (bitvector-position #*01110111 #f)) + (pass-if-equal 1 (bitvector-position #*01110111 #t)) + (pass-if-equal 4 (bitvector-position #*01110111 #f 1)) + (pass-if-equal 4 (bitvector-position #*01110111 #f 4)) + (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)))