mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

bitvector-set-bit! / bitvector-clear-bit! replace bitvector-set!

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2020-04-14 22:40:43 +02:00
parent d804177be4
commit 8110061e64
12 changed files with 142 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

19
NEWS
View file

@ -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.

14
doc/ref/api-data.texi
View file

@ -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.

11
libguile/array-handle.c
View file

@ -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;

84
libguile/bitvectors.c
View file

@ -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;
}
mask = 1L << (idx%32);
if (scm_is_true (val))
bits[idx/32] |= mask;
else
bits[idx/32] &= ~mask;
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
void
scm_c_bitvector_clear_bit_x (SCM vec, size_t idx)
#define FUNC_NAME "bitvector-clear-bit!"
{
scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
VALIDATE_MUTABLE_BITVECTOR (1, vec);
if (idx >= BITVECTOR_LENGTH (vec))
SCM_OUT_OF_RANGE (2, scm_from_size_t (idx));
uint32_t *bits = BITVECTOR_BITS (vec);
uint32_t mask = 1L << (idx%32);
bits[idx/32] &= ~mask;
}
#undef FUNC_NAME
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_clear_bit_x (vec, scm_to_size_t (idx));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

4
libguile/bitvectors.h
View file

@ -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);

47
libguile/deprecated.c
View file

@ -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"

2
libguile/deprecated.h
View file

@ -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);

2
libguile/posix.c
View file

@ -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;

5
module/ice-9/sandbox.scm
View file

@ -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)

2
module/system/vm/disassembler.scm
View file

@ -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))))))

4
module/system/vm/frame.scm
View file

@ -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))))))))

8
test-suite/tests/bitvectors.test
View file

@ -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))))