[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: bitvector-set-bit! / bitvector-clear-bit! replace
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/02: bitvector-set-bit! / bitvector-clear-bit! replace bitvector-set! |
|
Date: |
Tue, 14 Apr 2020 16:43:09 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 8110061e647134ab9071ecb5ce59b69b4ed6ed35
Author: Andy Wingo <address@hidden>
AuthorDate: Tue Apr 14 22:40:43 2020 +0200
bitvector-set-bit! / bitvector-clear-bit! replace bitvector-set!
* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/array-handle.h (bitvector_set_x, scm_array_get_handle): Adapt
to bitvector changes.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_c_bitvector_set_bit_x)
(scm_c_bitvector_clear_bit_x): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bitvector_set_x): Deprecate.
* module/ice-9/sandbox.scm (mutable-bitvector-bindings): Replace
bitvector-set! with bitvector-set-bit! / bitvector-clear-bit!.
* module/system/vm/disassembler.scm (static-opcode-set): Use
bitvector-set-bit!.
* module/system/vm/frame.scm (compute-defs-by-slot, available-bindings):
Use bitvector-set-bit!.
* test-suite/tests/bitvectors.test: Update.
---
NEWS | 19 +++++++---
doc/ref/api-data.texi | 14 +++++--
libguile/array-handle.c | 11 +++++-
libguile/bitvectors.c | 80 ++++++++++++++++++++-------------------
libguile/bitvectors.h | 4 +-
libguile/deprecated.c | 47 +++++++++++++++++++++++
libguile/deprecated.h | 2 +
libguile/posix.c | 2 +-
module/ice-9/sandbox.scm | 5 ++-
module/system/vm/disassembler.scm | 2 +-
module/system/vm/frame.scm | 4 +-
test-suite/tests/bitvectors.test | 8 +++-
12 files changed, 140 insertions(+), 58 deletions(-)
diff --git a/NEWS b/NEWS
index c5875b2..68e5d08 100644
--- a/NEWS
+++ b/NEWS
@@ -14,11 +14,6 @@ Changes in 3.0.3 (since 3.0.2)
These replace the wonky "bit-count" and "bit-position" procedures. See
"Bit Vectors" in the manual, for more.
-** New bitvector-set-bits!, bitvector-clear-bits! procedures
-
-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
@@ -26,6 +21,16 @@ 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 bitvector-set-bit!, bitvector-clear-bit! procedures
+
+These replace bitvector-set!, for similar reasons as the bitvector-ref
+replacement above.
+
+** New bitvector-set-bits!, bitvector-clear-bits! procedures
+
+These replace the wonky "bit-set*!" procedure. See "Bit Vectors" in the
+manual, for more.
+
* New deprecations
** bit-count, bit-position deprecated
@@ -37,6 +42,10 @@ the manual.
Use 'bitvector-bit-set?' or 'bitvector-bit-clear?' instead.
+** 'bitvector-set!' deprecated
+
+Use 'bitvector-set-bit!' or 'bitvector-clear-bit!' 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 d13fe3a..141b214 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -6586,12 +6586,18 @@ 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
-@deffnx {C Function} scm_bitvector_set_x (vec, idx, val)
-Set the element at index @var{idx} of the bitvector
-@var{vec} when @var{val} is true, else clear it.
+@deffn {Scheme Procedure} bitvector-set-bit! vec idx
+@deffnx {Scheme Procedure} bitvector-clear-bit! vec idx
+Set (for @code{bitvector-set-bit!}) or clear (for
+@code{bitvector-clear-bit!}) the bit at index @var{idx} of the bitvector
+@var{vec}.
@end deffn
+@deftypefn {C Function} void scm_bitvector_set_bit_x (SCM vec, size_t idx)
+@deftypefnx {C Function} void scm_bitvector_clear_bit_x (SCM vec, size_t idx)
+Set or clear the bit at index @var{idx} of the bitvector @var{vec}.
+@end deftypefn
+
@deftypefn {C Function} SCM scm_c_bitvector_set_x (SCM vec, size_t idx, SCM
val)
Set the element at index @var{idx} of the bitvector
@var{vec} when @var{val} is true, else clear it.
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index f547bf5..e51e133 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -174,6 +174,15 @@ bitvector_ref (SCM bv, size_t idx)
return scm_from_bool (scm_c_bitvector_bit_is_set (bv, idx));
}
+static void
+bitvector_set_x (SCM bv, size_t idx, SCM val)
+{
+ if (scm_is_true (val))
+ scm_c_bitvector_set_bit_x (bv, idx);
+ else
+ scm_c_bitvector_clear_bit_x (bv, idx);
+}
+
void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
@@ -202,7 +211,7 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
initialize_vector_handle (h, scm_c_bitvector_length (array),
SCM_ARRAY_ELEMENT_TYPE_BIT,
bitvector_ref,
- scm_c_bitvector_set_x,
+ 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 9755f24..87ad6e8 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -256,15 +256,16 @@ scm_bitvector_writable_elements (SCM vec,
int
scm_c_bitvector_bit_is_set (SCM vec, size_t idx)
+#define FUNC_NAME "bitvector-bit-set?"
{
- if (!IS_BITVECTOR (vec))
- scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
+ VALIDATE_BITVECTOR (1, vec);
if (idx >= BITVECTOR_LENGTH (vec))
- scm_out_of_range (NULL, scm_from_size_t (idx));
+ SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
const uint32_t *bits = BITVECTOR_BITS (vec);
return (bits[idx/32] & (1L << (idx%32))) ? 1 : 0;
}
+#undef FUNC_NAME
int
scm_c_bitvector_bit_is_clear (SCM vec, size_t idx)
@@ -294,48 +295,51 @@ SCM_DEFINE_STATIC (scm_bitvector_bit_clear_p,
"bitvector-bit-clear?", 2, 0, 0,
#undef FUNC_NAME
void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+scm_c_bitvector_set_bit_x (SCM vec, size_t idx)
+#define FUNC_NAME "bitvector-set-bit!"
{
- scm_t_array_handle handle;
- uint32_t *bits, mask;
+ VALIDATE_MUTABLE_BITVECTOR (1, vec);
+ if (idx >= BITVECTOR_LENGTH (vec))
+ SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
- if (IS_MUTABLE_BITVECTOR (vec))
- {
- if (idx >= BITVECTOR_LENGTH (vec))
- scm_out_of_range (NULL, scm_from_size_t (idx));
- bits = BITVECTOR_BITS(vec);
- }
- else
- {
- size_t len, off;
- ssize_t inc;
-
- bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
- scm_c_issue_deprecation_warning
- ("Using bitvector-set! on arrays is deprecated. "
- "Use array-set! instead.");
- if (idx >= len)
- scm_out_of_range (NULL, scm_from_size_t (idx));
- idx = idx*inc + off;
- }
+ uint32_t *bits = BITVECTOR_BITS (vec);
+ uint32_t mask = 1L << (idx%32);
+ bits[idx/32] |= mask;
+}
+#undef FUNC_NAME
- mask = 1L << (idx%32);
- if (scm_is_true (val))
- bits[idx/32] |= mask;
- else
- bits[idx/32] &= ~mask;
+void
+scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
+#define FUNC_NAME "bitvector-clear-bit!"
+{
+ VALIDATE_MUTABLE_BITVECTOR (1, vec);
+ if (idx >= BITVECTOR_LENGTH (vec))
+ SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
- if (!IS_MUTABLE_BITVECTOR (vec))
- scm_array_handle_release (&handle);
+ uint32_t *bits = BITVECTOR_BITS (vec);
+ uint32_t mask = 1L << (idx%32);
+ bits[idx/32] &= ~mask;
}
+#undef FUNC_NAME
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
- (SCM vec, SCM idx, SCM val),
- "Set the element at index @var{idx} of the bitvector\n"
- "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
+SCM_DEFINE_STATIC (scm_bitvector_set_bit_x, "bitvector-set-bit!", 2, 0, 0,
+ (SCM vec, SCM idx),
+ "Set the element at index @var{idx} of the bitvector\n"
+ "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_set_bit_x
+{
+ scm_c_bitvector_set_bit_x (vec, scm_to_size_t (idx));
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_bitvector_clear_bit_x, "bitvector-clear-bit!", 2, 0, 0,
+ (SCM vec, SCM idx),
+ "Clear the element at index @var{idx} of the bitvector\n"
+ "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_set_bit_x
{
- scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+ scm_c_bitvector_clear_bit_x (vec, scm_to_size_t (idx));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 136f229..7061d38 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_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);
SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
@@ -54,7 +53,8 @@ SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
SCM_API size_t scm_c_bitvector_length (SCM vec);
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 void scm_c_bitvector_set_bit_x (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_clear_bit_x (SCM vec, size_t idx);
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 dde780b..24a50ee 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -123,6 +123,53 @@ SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
}
#undef FUNC_NAME
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+ scm_c_issue_deprecation_warning
+ ("bitvector-set! is deprecated. Use bitvector-set-bit! or "
+ "bitvector-clear-bit! instead.");
+
+ if (scm_is_bitvector (vec))
+ {
+ if (scm_is_true (val))
+ scm_c_bitvector_set_bit_x (vec, idx);
+ else
+ scm_c_bitvector_clear_bit_x (vec, idx);
+ }
+ else
+ {
+ scm_t_array_handle handle;
+ uint32_t *bits, mask;
+ size_t len, off;
+ ssize_t inc;
+
+ bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+ if (idx >= len)
+ scm_out_of_range (NULL, scm_from_size_t (idx));
+ idx = idx*inc + off;
+
+ mask = 1L << (idx%32);
+ if (scm_is_true (val))
+ bits[idx/32] |= mask;
+ else
+ bits[idx/32] &= ~mask;
+
+ scm_array_handle_release (&handle);
+ }
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+ (SCM vec, SCM idx, SCM val),
+ "Set the element at index @var{idx} of the bitvector\n"
+ "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+ scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+ return SCM_UNSPECIFIED;
+}
+#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 6dadaad..a243831 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -117,6 +117,8 @@ 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 void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_DEPRECATED SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
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/libguile/posix.c b/libguile/posix.c
index 9b9b476..5d51633 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -2137,7 +2137,7 @@ cpu_set_to_bitvector (const cpu_set_t *cs)
{
if (CPU_ISSET (cpu, cs))
/* XXX: This is inefficient but avoids code duplication. */
- scm_c_bitvector_set_x (bv, cpu, SCM_BOOL_T);
+ scm_c_bitvector_set_bit_x (bv, cpu);
}
return bv;
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index 26958cc..86d8cba 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -1093,10 +1093,11 @@ allocation limit is exceeded, an exception will be
thrown to the
(define mutating-bitvector-bindings
'(((guile)
bit-invert!
+ bitvector-clear-bit!
bitvector-clear-bits!
- bitvector-set-bits!
bitvector-fill!
- bitvector-set!)))
+ bitvector-set-bit!
+ bitvector-set-bits!)))
(define fluid-bindings
'(((guile)
diff --git a/module/system/vm/disassembler.scm
b/module/system/vm/disassembler.scm
index 4d539a1..7107977 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -496,7 +496,7 @@ address of that offset."
((static-opcode-set inst ...)
(let ((bv (make-bitvector 256 #f)))
(for-each (lambda (inst)
- (bitvector-set! bv (instruction-opcode inst) #t))
+ (bitvector-set-bit! bv (instruction-opcode inst)))
(syntax->datum #'(inst ...)))
(datum->syntax #'static-opcode-set bv))))))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 1d507d1..112187e 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -169,7 +169,7 @@
(when (< n (vector-length defs))
(match (vector-ref defs n)
(#(_ _ slot _)
- (bitvector-set! (vector-ref by-slot slot) n #t)
+ (bitvector-set-bit! (vector-ref by-slot slot) n)
(lp (1+ n))))))
by-slot))
@@ -256,7 +256,7 @@
(bitvector-copy! out in)
(bitvector-clear-bits! out kill)
(for-each (lambda (def)
- (bitvector-set! out def #t))
+ (bitvector-set-bit! out def))
gen)
(lp (1+ n) first?
(or changed? (not (eqv? out-count (bitvector-count out))))))))
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index de6f95d..87b201b 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -43,8 +43,12 @@
(let ((bv (list->bitvector '(#f #f #t #f #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-bit-set? bv 0) #t))))
+ (bitvector-set-bit! bv 0)
+ (pass-if (eqv? (bitvector-bit-set? bv 0) #t))
+ (pass-if (eqv? (bitvector-bit-clear? bv 0) #f))
+ (bitvector-clear-bit! bv 0)
+ (pass-if (eqv? (bitvector-bit-set? bv 0) #f))
+ (pass-if (eqv? (bitvector-bit-clear? bv 0) #t))))
(with-test-prefix "as array"
(let ((bv (list->bitvector '(#f #f #t #f #t))))