diff --git a/NEWS b/NEWS index f7383cc76..c5875b2b3 100644 --- a/NEWS +++ b/NEWS @@ -19,6 +19,13 @@ These replace the wonky "bit-count" and "bit-position" procedures. See These replace the wonky "bit-set*!" procedure. See "Bit Vectors" in the manual, for more. +** New bitvector-bit-set?, bitvector-bit-clear? procedures + +These replace bitvector-ref. The reason to migrate is that it's an +opportunity be more efficient in 3.0 (because no generic array support), +easier to read (no need for 'not' when checking for false bits), and +more consistent with other bitvector procedures. + * New deprecations ** bit-count, bit-position deprecated @@ -26,6 +33,10 @@ manual, for more. Use bitvector-count or bitvector-position instead. See "Bit Vectors" in the manual. +** 'bitvector-ref' deprecated + +Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead. + ** 'bit-set*!' deprecated Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 1df634205..d13fe3acc 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6573,15 +6573,17 @@ Like @code{scm_bitvector_length}, but the length is returned as a @code{size_t}. @end deftypefn -@deffn {Scheme Procedure} bitvector-ref vec idx -@deffnx {C Function} scm_bitvector_ref (vec, idx) -Return the element at index @var{idx} of the bitvector -@var{vec}. +@deffn {Scheme Procedure} bitvector-bit-set? vec idx +@deffnx {Scheme Procedure} bitvector-bit-clear? vec idx +Return @code{#t} if the bit at index @var{idx} of the bitvector +@var{vec} is set (for @code{bitvector-bit-set?}) or clear (for +@code{bitvector-bit-clear?}). @end deffn -@deftypefn {C Function} SCM scm_c_bitvector_ref (SCM vec, size_t idx) -Return the element at index @var{idx} of the bitvector -@var{vec}. +@deftypefn {C Function} int scm_bitvector_bit_is_set (SCM vec, size_t idx) +@deftypefnx {C Function} int scm_bitvector_bit_is_clear (SCM vec, size_t idx) +Return 1 if the bit at index @var{idx} of the bitvector @var{vec} is set +or clear, respectively, or 0 otherwise. @end deftypefn @deffn {Scheme Procedure} bitvector-set! vec idx val diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 4b69e67a1..f547bf518 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -27,6 +27,7 @@ #include #include "arrays.h" +#include "boolean.h" #include "bitvectors.h" #include "bytevectors.h" #include "list.h" @@ -167,6 +168,12 @@ initialize_vector_handle (scm_t_array_handle *h, size_t len, h->vset = vset; } +static SCM +bitvector_ref (SCM bv, size_t idx) +{ + return scm_from_bool (scm_c_bitvector_bit_is_set (bv, idx)); +} + void scm_array_get_handle (SCM array, scm_t_array_handle *h) { @@ -194,7 +201,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h) case scm_tc7_bitvector: initialize_vector_handle (h, scm_c_bitvector_length (array), SCM_ARRAY_ELEMENT_TYPE_BIT, - scm_c_bitvector_ref, scm_c_bitvector_set_x, + bitvector_ref, + scm_c_bitvector_set_x, scm_i_bitvector_bits (array), scm_i_is_mutable_bitvector (array)); break; diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index 40da4757e..9755f24d8 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -254,45 +254,42 @@ scm_bitvector_writable_elements (SCM vec, return (uint32_t *) ret; } -SCM -scm_c_bitvector_ref (SCM vec, size_t idx) +int +scm_c_bitvector_bit_is_set (SCM vec, size_t idx) { - const uint32_t *bits; + if (!IS_BITVECTOR (vec)) + scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector"); + if (idx >= BITVECTOR_LENGTH (vec)) + scm_out_of_range (NULL, scm_from_size_t (idx)); - if (IS_BITVECTOR (vec)) - { - if (idx >= BITVECTOR_LENGTH (vec)) - scm_out_of_range (NULL, scm_from_size_t (idx)); - bits = BITVECTOR_BITS(vec); - return scm_from_bool (bits[idx/32] & (1L << (idx%32))); - } - else - { - SCM res; - scm_t_array_handle handle; - size_t len, off; - ssize_t inc; - - bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc); - scm_c_issue_deprecation_warning - ("Using bitvector-ref on arrays is deprecated. " - "Use array-ref instead."); - if (idx >= len) - scm_out_of_range (NULL, scm_from_size_t (idx)); - idx = idx*inc + off; - res = scm_from_bool (bits[idx/32] & (1L << (idx%32))); - scm_array_handle_release (&handle); - return res; - } + const uint32_t *bits = BITVECTOR_BITS (vec); + return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0; } -SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0, - (SCM vec, SCM idx), - "Return the element at index @var{idx} of the bitvector\n" - "@var{vec}.") -#define FUNC_NAME s_scm_bitvector_ref +int +scm_c_bitvector_bit_is_clear (SCM vec, size_t idx) { - return scm_c_bitvector_ref (vec, scm_to_size_t (idx)); + return !scm_c_bitvector_bit_is_set (vec, idx); +} + +SCM_DEFINE_STATIC (scm_bitvector_bit_set_p, "bitvector-bit-set?", 2, 0, 0, + (SCM vec, SCM idx), + "Return @code{#t} if the bit at index @var{idx} of the \n" + "bitvector @var{vec} is set, or @code{#f} otherwise.") +#define FUNC_NAME s_scm_bitvector_bit_set_p +{ + return scm_from_bool (scm_c_bitvector_bit_is_set (vec, scm_to_size_t (idx))); +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_bitvector_bit_clear_p, "bitvector-bit-clear?", 2, 0, 0, + (SCM vec, SCM idx), + "Return @code{#t} if the bit at index @var{idx} of the \n" + "bitvector @var{vec} is clear (unset), or @code{#f} otherwise.") +#define FUNC_NAME s_scm_bitvector_bit_clear_p +{ + return scm_from_bool + (scm_c_bitvector_bit_is_clear (vec, scm_to_size_t (idx))); } #undef FUNC_NAME @@ -724,7 +721,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { size_t kv_len = BITVECTOR_LENGTH (kv); for (size_t i = 0; i < kv_len; i++) - if (scm_is_true (scm_c_bitvector_ref (kv, 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))) diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h index 82c8b3236..136f22953 100644 --- a/libguile/bitvectors.h +++ b/libguile/bitvectors.h @@ -36,7 +36,6 @@ SCM_API SCM scm_bitvector_p (SCM vec); SCM_API SCM scm_bitvector (SCM bits); SCM_API SCM scm_make_bitvector (SCM len, SCM fill); SCM_API SCM scm_bitvector_length (SCM vec); -SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx); SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val); SCM_API SCM scm_list_to_bitvector (SCM list); SCM_API SCM scm_bitvector_to_list (SCM vec); @@ -53,7 +52,8 @@ SCM_API SCM scm_bit_invert_x (SCM v); 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); -SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx); +SCM_API int scm_c_bitvector_bit_is_set (SCM vec, size_t idx); +SCM_API int scm_c_bitvector_bit_is_clear (SCM vec, size_t idx); SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val); 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); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index d5cb0dfca..dde780be9 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -88,6 +88,41 @@ scm_find_executable (const char *name) +SCM +scm_c_bitvector_ref (SCM vec, size_t idx) +{ + scm_c_issue_deprecation_warning + ("bitvector-ref is deprecated. Use bitvector-bit-set? instead."); + + if (scm_is_bitvector (vec)) + return scm_from_bool (scm_c_bitvector_bit_is_set (vec, idx)); + + SCM res; + scm_t_array_handle handle; + size_t len, off; + ssize_t inc; + + const uint32_t *bits = + scm_bitvector_elements (vec, &handle, &off, &len, &inc); + + if (idx >= len) + scm_out_of_range (NULL, scm_from_size_t (idx)); + idx = idx*inc + off; + res = scm_from_bool (bits[idx/32] & (1L << (idx%32))); + scm_array_handle_release (&handle); + return res; +} + +SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0, + (SCM vec, SCM idx), + "Return the element at index @var{idx} of the bitvector\n" + "@var{vec}.") +#define FUNC_NAME s_scm_bitvector_ref +{ + return scm_c_bitvector_ref (vec, scm_to_size_t (idx)); +} +#undef FUNC_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" diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 3411ab7c6..6dadaad1d 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -115,6 +115,8 @@ typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE; SCM_DEPRECATED char* scm_find_executable (const char *name); +SCM_DEPRECATED SCM scm_c_bitvector_ref (SCM vec, size_t idx); +SCM_DEPRECATED SCM scm_bitvector_ref (SCM vec, SCM idx); 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_bit_set_star_x (SCM v, SCM kv, SCM obj); diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm index b2c0658e9..26958cce4 100644 --- a/module/ice-9/sandbox.scm +++ b/module/ice-9/sandbox.scm @@ -1082,7 +1082,8 @@ allocation limit is exceeded, an exception will be thrown to the bitvector bitvector->list bitvector-length - bitvector-ref + bitvector-bit-set? + bitvector-bit-clear? bitvector? list->bitvector make-bitvector))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index e6ce864e6..4d539a17d 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -509,7 +509,7 @@ address of that offset." subr-call foreign-call continuation-call j)) (let ((opcode (logand (bytevector-u32-native-ref code pos) #xff))) - (not (bitvector-ref non-fallthrough-set opcode)))) + (bitvector-bit-clear? non-fallthrough-set opcode))) (define-syntax define-jump-parser (lambda (x) diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test index b615705c6..de6f95d30 100644 --- a/test-suite/tests/bitvectors.test +++ b/test-suite/tests/bitvectors.test @@ -41,10 +41,10 @@ (with-test-prefix "ref and set" (with-test-prefix "as bitvector" (let ((bv (list->bitvector '(#f #f #t #f #t)))) - (pass-if (eqv? (bitvector-ref bv 0) #f)) - (pass-if (eqv? (bitvector-ref bv 2) #t)) + (pass-if (eqv? (bitvector-bit-set? bv 0) #f)) + (pass-if (eqv? (bitvector-bit-set? bv 2) #t)) (bitvector-set! bv 0 #t) - (pass-if (eqv? (bitvector-ref bv 0) #t)))) + (pass-if (eqv? (bitvector-bit-set? bv 0) #t)))) (with-test-prefix "as array" (let ((bv (list->bitvector '(#f #f #t #f #t))))