[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: bitvector-bit-set? / bitvector-bit-clear? replace
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/02: bitvector-bit-set? / bitvector-bit-clear? replace bitvector-ref |
|
Date: |
Tue, 14 Apr 2020 16:43:08 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit d804177be4525feb517feb63ca09502d187fc016
Author: Andy Wingo <address@hidden>
AuthorDate: Tue Apr 14 22:08:45 2020 +0200
bitvector-bit-set? / bitvector-bit-clear? replace bitvector-ref
This is an opportunity to make a new interface that can be more
efficient in 3.0 (because no generic array support), easier to read (no
need for 'not'), and more consistent with other bitvector interfaces.
* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/array-handle.h (bitvector_ref, scm_array_get_handle): Adapt
to bitvector changes.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_c_bitvector_bit_is_set)
(scm_c_bitvector_bit_is_clear): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bitvector_ref): Deprecate.
* module/ice-9/sandbox.scm (bitvector-bindings): Replace
bitvector-ref with bitvector-bit-set? / bitvector-bit-clear?.
* module/system/vm/disassembler.scm (instruction-has-fallthrough): Use
bitvector-bit-clear?.
* test-suite/tests/bitvectors.test: Update.
---
NEWS | 11 +++++++
doc/ref/api-data.texi | 16 ++++++----
libguile/array-handle.c | 10 +++++-
libguile/bitvectors.c | 67 +++++++++++++++++++--------------------
libguile/bitvectors.h | 4 +--
libguile/deprecated.c | 35 ++++++++++++++++++++
libguile/deprecated.h | 2 ++
module/ice-9/sandbox.scm | 3 +-
module/system/vm/disassembler.scm | 2 +-
test-suite/tests/bitvectors.test | 6 ++--
10 files changed, 106 insertions(+), 50 deletions(-)
diff --git a/NEWS b/NEWS
index f7383cc..c5875b2 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 1df6342..d13fe3a 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 4b69e67..f547bf5 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -27,6 +27,7 @@
#include <string.h>
#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 40da475..9755f24 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_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_c_bitvector_ref (vec, scm_to_size_t (idx));
+ 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 82c8b32..136f229 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 d5cb0df..dde780b 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 3411ab7..6dadaad 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 b2c0658..26958cc 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 e6ce864..4d539a1 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 b615705..de6f95d 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))))