[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch master updated: Replace bit-set*! with bitvector-
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] branch master updated: Replace bit-set*! with bitvector-set-bits! / bitvector-clear-bits! |
|
Date: |
Mon, 13 Apr 2020 16:09:31 -0400 |
This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch master
in repository guile.
The following commit(s) were added to refs/heads/master by this push:
new ff9979b Replace bit-set*! with bitvector-set-bits! /
bitvector-clear-bits!
ff9979b is described below
commit ff9979b6bc6a72e03085d7ce21fd3f8f1bd39b64
Author: Andy Wingo <address@hidden>
AuthorDate: Mon Apr 13 22:06:56 2020 +0200
Replace bit-set*! with bitvector-set-bits! / bitvector-clear-bits!
The old name was wonky and hard to read: you almost always pass a
literal as the value to set, so better to make separate functions.
* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_bitvector_set_bits_x)
(scm_bitvector_clear_bits_x): New functions.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bit_set_star_x): Deprecate.
* module/ice-9/sandbox.scm (mutable-bitvector-bindings): Replace
bit-set*! with bitvector-set-bits! / bitvector-clear-bits!.
* module/system/vm/frame.scm (available-bindings, compute-killv): Use
bitvector-set-bits! and bitvector-clear-bits!.
* test-suite/tests/bitvectors.test: Update.
---
NEWS | 9 +++
doc/ref/api-data.texi | 32 +++++---
libguile/bitvectors.c | 167 ++++++++++++++++-----------------------
libguile/bitvectors.h | 3 +-
libguile/deprecated.c | 86 +++++++++++++++++++-
libguile/deprecated.h | 1 +
module/ice-9/sandbox.scm | 3 +-
module/system/vm/frame.scm | 11 +--
test-suite/tests/bitvectors.test | 18 +++--
9 files changed, 201 insertions(+), 129 deletions(-)
diff --git a/NEWS b/NEWS
index a006dd6..f7383cc 100644
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,11 @@ 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 deprecations
** bit-count, bit-position deprecated
@@ -21,6 +26,10 @@ These replace the wonky "bit-count" and "bit-position"
procedures. See
Use bitvector-count or bitvector-position instead. See "Bit Vectors" in
the manual.
+** 'bit-set*!' deprecated
+
+Use 'bitvector-set-bits!' or 'bitvector-clear-bits!' instead.
+
** 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 7328842..1df6342 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -6640,24 +6640,34 @@ entry between @var{start} and the end of
@var{bitvector}, then return
Modify @var{bitvector} by replacing each element with its negation.
@end deffn
-@deffn {Scheme Procedure} bit-set*! bitvector bits bool
-@deffnx {C Function} scm_bit_set_star_x (bitvector, bits, bool)
-Set entries of @var{bitvector} to @var{bool}, with @var{bits} selecting
-the entries to change. The return value is unspecified. Those bits in
-the bitvector @var{bits} which are set to one indicate the bits in
-@var{bitvector} to set to @var{bool}. @var{bitvector} must be at least
-as long as @var{bits}. When @var{bool} is @code{#t} it is as if
-@var{bits} is OR'ed into @var{bitvector}, whereas when @var{bool} is
-@code{#f} is like an ANDNOT.
+@deffn {Scheme Procedure} bitvector-set-bits! bitvector bits
+@deffnx {C Function} scm_bit_set_star_x (bitvector, bits)
+Set entries of @var{bitvector} to @code{#t}, with @var{bits} selecting
+the bits to set. The return value is unspecified. @var{bitvector} must
+be at least as long as @var{bits}.
@example
-(define bv #*01000010)
-(bit-set*! bv #*10010001 #t)
+(define bv (bitvector-copy #*11000010))
+(bitvector-set-bits! bv #*10010001)
bv
@result{} #*11010011
@end example
@end deffn
+@deffn {Scheme Procedure} bitvector-clear-bits! bitvector bits
+@deffnx {C Function} scm_bitvector_clear_bits_x (bitvector, bits)
+Set entries of @var{bitvector} to @code{#f}, with @var{bits} selecting
+the bits to clear. The return value is unspecified. @var{bitvector}
+must be at least as long as @var{bits}.
+
+@example
+(define bv (bitvector-copy #*11000010))
+(bitvector-clear-bits! bv #*10010001)
+bv
+@result{} #*01000010
+@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
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 356b1c7..40da475 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -61,6 +61,9 @@
#define VALIDATE_BITVECTOR(_pos, _obj) \
SCM_ASSERT_TYPE (IS_BITVECTOR (_obj), (_obj), (_pos), FUNC_NAME, \
"bitvector")
+#define VALIDATE_MUTABLE_BITVECTOR(_pos, _obj) \
+ SCM_ASSERT_TYPE (IS_MUTABLE_BITVECTOR (_obj), (_obj), (_pos), \
+ FUNC_NAME, "mutable bitvector")
uint32_t *
scm_i_bitvector_bits (SCM vec)
@@ -575,125 +578,87 @@ SCM_DEFINE (scm_bitvector_position,
"bitvector-position", 2, 1, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
- (SCM v, SCM kv, SCM obj),
- "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
- "selecting the entries to change. The return value is\n"
- "unspecified.\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 set to @var{obj}.\n"
- "@var{v} must be at least as long as @var{kv}. When @var{obj}\n"
- "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n"
- "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+SCM_DEFINE (scm_bitvector_set_bits_x, "bitvector-set-bits!", 2, 0, 0,
+ (SCM v, SCM bits),
+ "Update the bitvector @var{v} in place by performing a logical\n"
+ "OR of its bits with those of @var{bits}.\n"
+ "For example:\n"
"\n"
"@example\n"
- "(define bv #*01000010)\n"
- "(bit-set*! bv #*10010001 #t)\n"
+ "(define bv (bitvector-copy #*11000010))\n"
+ "(bitvector-set-bits! bv #*10010001)\n"
"bv\n"
"@result{} #*11010011\n"
- "@end example\n"
- "\n"
- "If @var{kv} is a u32vector, then its elements are\n"
- "indices into @var{v} which are set to @var{obj}.\n"
+ "@end example")
+#define FUNC_NAME s_scm_bitvector_set_bits_x
+{
+ VALIDATE_MUTABLE_BITVECTOR (1, v);
+ VALIDATE_BITVECTOR (2, bits);
+ size_t v_len = BITVECTOR_LENGTH (v);
+ uint32_t *v_bits = BITVECTOR_BITS (v);
+ size_t kv_len = BITVECTOR_LENGTH (bits);
+ const uint32_t *kv_bits = BITVECTOR_BITS (bits);
+
+ if (v_len < kv_len)
+ scm_misc_error (NULL,
+ "selection bitvector longer than target bitvector",
+ SCM_EOL);
+
+ if (kv_len > 0)
+ {
+ size_t word_len = (kv_len + 31) / 32;
+ uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+ size_t i;
+ for (i = 0; i < word_len-1; i++)
+ v_bits[i] |= kv_bits[i];
+ v_bits[i] |= kv_bits[i] & last_mask;
+ }
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_clear_bits_x, "bitvector-clear-bits!", 2, 0, 0,
+ (SCM v, SCM bits),
+ "Update the bitvector @var{v} in place by performing a logical\n"
+ "AND of its bits with the complement of those of @var{bits}.\n"
+ "For example:\n"
"\n"
"@example\n"
- "(define bv #*01000010)\n"
- "(bit-set*! bv #u32(5 2 7) #t)\n"
+ "(define bv (bitvector-copy #*11000010))\n"
+ "(bitvector-clear-bits! bv #*10010001)\n"
"bv\n"
- "@result{} #*01100111\n"
+ "@result{} #*01000010\n"
"@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
+#define FUNC_NAME s_scm_bitvector_clear_bits_x
{
- /* Validate that OBJ is a boolean so this is done even if we don't
- need BIT. */
- int bit = scm_to_bool (obj);
-
- if (IS_MUTABLE_BITVECTOR (v) && IS_BITVECTOR (kv))
- {
- size_t v_len = BITVECTOR_LENGTH (v);
- 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);
+ VALIDATE_MUTABLE_BITVECTOR (1, v);
+ VALIDATE_BITVECTOR (2, bits);
+ size_t v_len = BITVECTOR_LENGTH (v);
+ uint32_t *v_bits = BITVECTOR_BITS (v);
+ size_t kv_len = BITVECTOR_LENGTH (bits);
+ const uint32_t *kv_bits = BITVECTOR_BITS (bits);
+
+ if (v_len < kv_len)
+ scm_misc_error (NULL,
+ "selection bitvector longer than target bitvector",
+ SCM_EOL);
- if (kv_len > 0)
- {
- size_t word_len = (kv_len + 31) / 32;
- uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
- size_t i;
-
- if (bit == 0)
- {
- for (i = 0; i < word_len-1; i++)
- v_bits[i] &= ~kv_bits[i];
- v_bits[i] &= ~(kv_bits[i] & last_mask);
- }
- else
- {
- for (i = 0; i < word_len-1; i++)
- v_bits[i] |= kv_bits[i];
- v_bits[i] |= kv_bits[i] & last_mask;
- }
- }
- }
- else
+ if (kv_len > 0)
{
- scm_t_array_handle v_handle;
- size_t v_off, v_len;
- ssize_t v_inc;
- scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
-
- if (!IS_MUTABLE_BITVECTOR (v))
- scm_c_issue_deprecation_warning
- ("Using bit-set*! on arrays is deprecated. "
- "Use array-set! in a loop instead.");
-
- if (IS_BITVECTOR (kv))
- {
- size_t kv_len = BITVECTOR_LENGTH (kv);
-
- if (v_len < kv_len)
- scm_misc_error (NULL,
- "selection bitvector longer than target bitvector",
- SCM_EOL);
-
- for (size_t i = 0; i < kv_len; i++)
- if (scm_is_true (scm_c_bitvector_ref (kv, i)))
- scm_array_handle_set (&v_handle, i*v_inc, obj);
- }
- else if (scm_is_true (scm_u32vector_p (kv)))
- {
- scm_c_issue_deprecation_warning
- ("Passing a u32vector to bit-set*! is deprecated. "
- "Use bitvector-set! in a loop instead.");
-
- scm_t_array_handle kv_handle;
- size_t kv_len;
- ssize_t kv_inc;
- const uint32_t *kv_elts;
-
- kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
- for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
- scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
- scm_array_handle_release (&kv_handle);
- }
- else
- scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+ size_t word_len = (kv_len + 31) / 32;
+ uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - kv_len);
+ size_t i;
- scm_array_handle_release (&v_handle);
+ for (i = 0; i < word_len-1; i++)
+ v_bits[i] &= ~kv_bits[i];
+ v_bits[i] &= ~(kv_bits[i] & last_mask);
}
return SCM_UNSPECIFIED;
}
#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"
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 09a9a61..82c8b32 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -44,8 +44,9 @@ 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_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_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 2b1a338..d5cb0df 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -32,6 +32,7 @@
#include "deprecation.h"
#include "gc.h"
#include "gsubr.h"
+#include "srfi-4.h"
#include "strings.h"
#include "deprecated.h"
@@ -100,7 +101,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
("bit-count is deprecated. Use bitvector-count, or a loop over array-ref "
"if array support is needed.");
- if (scm_is_true (scm_bitvector_p (bitvector)))
+ if (scm_is_bitvector (bitvector))
{
len = scm_to_size_t (scm_bitvector_length (bitvector));
count = scm_to_size_t (scm_bitvector_count (bitvector));
@@ -141,7 +142,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
("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)))
+ if (scm_is_bitvector (v))
return scm_bitvector_position (v, item, k);
scm_t_array_handle handle;
@@ -166,6 +167,87 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+ (SCM v, SCM kv, SCM obj),
+ "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+ "selecting the entries to change. The return value is\n"
+ "unspecified.\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 set to @var{obj}.\n"
+ "@var{v} must be at least as long as @var{kv}. When @var{obj}\n"
+ "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n"
+ "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+ "\n"
+ "@example\n"
+ "(define bv #*01000010)\n"
+ "(bit-set*! bv #*10010001 #t)\n"
+ "bv\n"
+ "@result{} #*11010011\n"
+ "@end example\n"
+ "\n"
+ "If @var{kv} is a u32vector, then its elements are\n"
+ "indices into @var{v} which are set to @var{obj}.\n"
+ "\n"
+ "@example\n"
+ "(define bv #*01000010)\n"
+ "(bit-set*! bv #u32(5 2 7) #t)\n"
+ "bv\n"
+ "@result{} #*01100111\n"
+ "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+ scm_c_issue_deprecation_warning
+ ("bit-set*! is deprecated. Use bitvector-set-bits! or "
+ "bitvector-clear-bits! on bitvectors, or array-set! in a loop "
+ "if you need to work on generic arrays.");
+
+ int bit = scm_to_bool (obj);
+ if (scm_is_bitvector (v) && scm_is_bitvector (kv))
+ return bit
+ ? scm_bitvector_set_bits_x (v, kv)
+ : scm_bitvector_clear_bits_x (v, kv);
+
+ scm_t_array_handle v_handle;
+ size_t v_off, v_len;
+ ssize_t v_inc;
+ scm_bitvector_writable_elements (v, &v_handle, &v_off, &v_len, &v_inc);
+
+ if (scm_is_bitvector (kv))
+ {
+ size_t kv_len = scm_c_bitvector_length (kv);
+
+ if (v_len < kv_len)
+ scm_misc_error (NULL,
+ "selection bitvector longer than target bitvector",
+ SCM_EOL);
+
+ for (size_t i = 0; i < kv_len; i++)
+ if (scm_is_true (scm_c_bitvector_ref (kv, i)))
+ scm_array_handle_set (&v_handle, i*v_inc, obj);
+ }
+ else if (scm_is_true (scm_u32vector_p (kv)))
+ {
+ scm_t_array_handle kv_handle;
+ size_t kv_len;
+ ssize_t kv_inc;
+ const uint32_t *kv_elts;
+
+ kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+ for (size_t i = 0; i < kv_len; i++, kv_elts += kv_inc)
+ scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+ 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_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
SCM
scm_istr2bve (SCM str)
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index edbbff4..3411ab7 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -117,6 +117,7 @@ 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_bit_set_star_x (SCM v, SCM kv, SCM obj);
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 bd80a49..b2c0658 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -1092,7 +1092,8 @@ allocation limit is exceeded, an exception will be thrown
to the
(define mutating-bitvector-bindings
'(((guile)
bit-invert!
- bit-set*!
+ bitvector-clear-bits!
+ bitvector-set-bits!
bitvector-fill!
bitvector-set!)))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 3800d5b..1d507d1 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -180,7 +180,8 @@
(compute-frame-sizes code parsed initial-frame-size))
((killv) (make-vector (vector-length parsed) #f)))
(define (kill-slot! n slot)
- (bit-set*! (vector-ref killv n) (vector-ref defs-by-slot slot) #t))
+ (bitvector-set-bits! (vector-ref killv n)
+ (vector-ref defs-by-slot slot)))
(let lp ((n 0))
(when (< n (vector-length killv))
(vector-set! killv n (make-bitvector (vector-length defs) #f))
@@ -224,11 +225,11 @@
(tmp (make-bitvector (vector-length defs) #f)))
(define (bitvector-copy! dst src)
(bitvector-fill! dst #f)
- (bit-set*! dst src #t))
+ (bitvector-set-bits! dst src))
(define (bitvector-meet! accum src)
(bitvector-copy! tmp src)
(bit-invert! tmp)
- (bit-set*! accum tmp #f))
+ (bitvector-clear-bits! accum tmp))
(let lp ((n 0))
(when (< n len)
@@ -253,7 +254,7 @@
(bitvector-meet! in (vector-ref outv pred)))
(lp preds))))
(bitvector-copy! out in)
- (bit-set*! out kill #f)
+ (bitvector-clear-bits! out kill)
(for-each (lambda (def)
(bitvector-set! out def #t))
gen)
@@ -280,7 +281,7 @@
;; values defined by the call.
(begin
(bitvector-copy! tmp (vector-ref inv (1- n)))
- (bit-set*! tmp (vector-ref killv (1- n)) #f)
+ (bitvector-clear-bits! tmp (vector-ref killv (1-
n)))
tmp))))
(let lp ((n 0))
(let ((n (bitvector-position live #t n)))
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index 332c8ff..b615705 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -53,22 +53,24 @@
(array-set! bv #t 0)
(pass-if (eqv? (array-ref bv 0) #t)))))
-(with-test-prefix "bit-set*!"
+(with-test-prefix "bitvector-set-bits!"
(pass-if "#t"
(let ((v (bitvector #t #t #f #f)))
- (bit-set*! v #*1010 #t)
+ (bitvector-set-bits! v #*1010)
(equal? v #*1110)))
+ (pass-if "#t, shorter"
+ (let ((v (bitvector #t #t #f #f)))
+ (bitvector-set-bits! v #*101)
+ (equal? v #*1110))))
+
+(with-test-prefix "bitvector-clear-bits!"
(pass-if "#f"
(let ((v (bitvector #t #t #f #f)))
- (bit-set*! v #*1010 #f)
+ (bitvector-clear-bits! v #*1010)
(equal? v #*0100)))
- (pass-if "#t, shorter"
- (let ((v (bitvector #t #t #f #f)))
- (bit-set*! v #*101 #t)
- (equal? v #*1110)))
(pass-if "#f, shorter"
(let ((v (bitvector #t #t #f #f)))
- (bit-set*! v #*101 #f)
+ (bitvector-clear-bits! v #*101)
(equal? v #*0100))))
(with-test-prefix "bitvector-count"
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch master updated: Replace bit-set*! with bitvector-set-bits! / bitvector-clear-bits!,
Andy Wingo <=