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

Replace bit-position with bitvector-position

Browse source 
The old name was wonky and had bad argument order.

* NEWS: Add entry.
* doc/ref/api-data.texi (Bit Vectors): Update.
* libguile/bitvectors.h:
* libguile/bitvectors.c (scm_bitvector_position): New function.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_bit_position): Deprecate.
* module/ice-9/sandbox.scm (bitvector-bindings): Replace bit-position
  with bitvector-position.
* module/language/cps/intset.scm (bitvector->intset): Use
  bitvector-position.
* module/system/vm/frame.scm (available-bindings): Use
  bitvector-position.
* test-suite/tests/bitvectors.test ("bitvector-position"): Add test.
This commit is contained in:
Andy Wingo 2020-04-12 22:39:55 +02:00
parent cae74359de
commit 06709d77b9
10 changed files with 97 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

11
NEWS
View file

@ -9,16 +9,17 @@ Changes in 3.0.3 (since 3.0.2)
* New interfaces and functionality
** New bitvector-count procedure
** New bitvector-count, bitvector-position procedures
This replaces the wonky "bit-count" procedure. See "Bit Vectors" in the
manual, for more.
These replace the wonky "bit-count" and "bit-position" procedures. See
"Bit Vectors" in the manual, for more.
* New deprecations
** bit-count deprecated
** bit-count, bit-position deprecated
Use bitvector-count instead. See "Bit Vectors" in the manual.
Use bitvector-count or bitvector-position instead. See "Bit Vectors" in
the manual.
** Passing a u32vector to 'bit-set*!' and 'bit-count*' deprecated

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

@ -6622,16 +6622,16 @@ Return a count of how many entries in @var{bitvector} are set.
@end example
@end deffn
@deffn {Scheme Procedure} bit-position bool bitvector start
@deffnx {C Function} scm_bit_position (bool, bitvector, start)
@deffn {Scheme Procedure} bitvector-position bitvector bool start
@deffnx {C Function} scm_bitvector_position (bitvector, bool, start)
Return the index of the first occurrence of @var{bool} in
@var{bitvector}, starting from @var{start}. If there is no @var{bool}
entry between @var{start} and the end of @var{bitvector}, then return
@code{#f}. For example,
@example
(bit-position #t #*000101 0) @result{} 3
(bit-position #f #*0001111 3) @result{} #f
(bitvector-position #*000101 #t 0) @result{} 3
(bitvector-position #*0001111 #f 3) @result{} #f
@end example
@end deffn

89
libguile/bitvectors.c
View file

@ -530,73 +530,48 @@ find_first_one (uint32_t x)
return pos;
}
SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
(SCM item, SCM v, SCM k),
"Return the index of the first occurrence of @var{item} in bit\n"
"vector @var{v}, starting from @var{k}. If there is no\n"
"@var{item} entry between @var{k} and the end of\n"
SCM_DEFINE (scm_bitvector_position, "bitvector-position", 2, 1, 0,
(SCM v, SCM bit, SCM start),
"Return the index of the first occurrence of @var{bit} in bit\n"
"vector @var{v}, starting from @var{start} (or zero if not given)\n."
"If there is no @var{bit} entry between @var{start} and the end of\n"
"@var{v}, then return @code{#f}. For example,\n"
"\n"
"@example\n"
"(bit-position #t #*000101 0) @result{} 3\n"
"(bit-position #f #*0001111 3) @result{} #f\n"
"(bitvector-position #*000101 #t) @result{} 3\n"
"(bitvector-position #*0001111 #f 3) @result{} #f\n"
"@end example")
#define FUNC_NAME s_scm_bit_position
#define FUNC_NAME s_scm_bitvector_position
{
int bit = scm_to_bool (item);
SCM res = SCM_BOOL_F;
VALIDATE_BITVECTOR (1, v);
size_t len = BITVECTOR_LENGTH (v);
int c_bit = scm_to_bool (bit);
size_t first_bit =
SCM_UNBNDP (start) ? 0 : scm_to_unsigned_integer (start, 0, len);
if (IS_BITVECTOR (v))
{
size_t len = BITVECTOR_LENGTH (v);
if (len > 0)
{
size_t first_bit = scm_to_unsigned_integer (k, 0, len);
const uint32_t *bits = BITVECTOR_BITS (v);
size_t word_len = (len + 31) / 32;
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
size_t first_word = first_bit / 32;
uint32_t first_mask =
((uint32_t)-1) << (first_bit - 32*first_word);
if (first_bit == len)
return SCM_BOOL_F;
const uint32_t *bits = BITVECTOR_BITS (v);
size_t word_len = (len + 31) / 32;
uint32_t last_mask = ((uint32_t)-1) >> (32*word_len - len);
size_t first_word = first_bit / 32;
uint32_t first_mask =
((uint32_t)-1) << (first_bit - 32*first_word);
for (size_t i = first_word; i < word_len; i++)
{
uint32_t w = bit ? bits[i] : ~bits[i];
if (i == first_word)
w &= first_mask;
if (i == word_len-1)
w &= last_mask;
if (w)
{
res = scm_from_size_t (32*i + find_first_one (w));
break;
}
}
}
}
else
for (size_t i = first_word; i < word_len; i++)
{
scm_t_array_handle handle;
size_t off, len;
ssize_t inc;
scm_bitvector_elements (v, &handle, &off, &len, &inc);
scm_c_issue_deprecation_warning
("Using bit-position on arrays is deprecated. "
"Use array-ref in a loop instead.");
size_t first_bit = scm_to_unsigned_integer (k, 0, len);
for (size_t i = first_bit; i < len; i++)
{
SCM elt = scm_array_handle_ref (&handle, i*inc);
if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
{
res = scm_from_size_t (i);
break;
}
}
scm_array_handle_release (&handle);
uint32_t w = c_bit ? bits[i] : ~bits[i];
if (i == first_word)
w &= first_mask;
if (i == word_len-1)
w &= last_mask;
if (w)
return scm_from_size_t (32*i + find_first_one (w));
}
return res;
return SCM_BOOL_F;
}
#undef FUNC_NAME

2
libguile/bitvectors.h
View file

@ -43,8 +43,8 @@ SCM_API SCM scm_bitvector_to_list (SCM vec);
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_bit_position (SCM item, SCM v, SCM k);
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);

42
libguile/deprecated.c
View file

@ -124,6 +124,48 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
(SCM item, SCM v, SCM k),
"Return the index of the first occurrence of @var{item} in bit\n"
"vector @var{v}, starting from @var{k}. If there is no\n"
"@var{item} entry between @var{k} and the end of\n"
"@var{v}, then return @code{#f}. For example,\n"
"\n"
"@example\n"
"(bit-position #t #*000101 0) @result{} 3\n"
"(bit-position #f #*0001111 3) @result{} #f\n"
"@end example")
#define FUNC_NAME s_scm_bit_position
{
scm_c_issue_deprecation_warning
("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)))
return scm_bitvector_position (v, item, k);
scm_t_array_handle handle;
size_t off, len;
ssize_t inc;
scm_bitvector_elements (v, &handle, &off, &len, &inc);
int bit = scm_to_bool (item);
size_t first_bit = scm_to_unsigned_integer (k, 0, len);
SCM res = SCM_BOOL_F;
for (size_t i = first_bit; i < len; i++)
{
SCM elt = scm_array_handle_ref (&handle, i*inc);
if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
{
res = scm_from_size_t (i);
break;
}
}
scm_array_handle_release (&handle);
return res;
}
#undef FUNC_NAME
SCM
scm_istr2bve (SCM str)
{

1
libguile/deprecated.h
View file

@ -116,6 +116,7 @@ typedef struct scm_thread scm_i_thread SCM_DEPRECATED_TYPE;
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_istr2bve (SCM str);
void scm_i_init_deprecated (void);

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

@ -1076,9 +1076,9 @@ allocation limit is exceeded, an exception will be thrown to the
(define bitvector-bindings
'(((guile)
bitvector-count
bitvector-position
bit-count*
bit-extract
bit-position
bitvector
bitvector->list
bitvector-length

2
module/language/cps/intset.scm
View file

@ -781,7 +781,7 @@
out
(intset-union out (make-intset min *leaf-bits* tail))))
(let lp ((out empty-intset) (min 0) (pos 0) (tail 0))
(let ((pos (bit-position #t bv pos)))
(let ((pos (bitvector-position bv #t pos)))
(cond
((not pos)
(finish-tail out min tail))

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

@ -283,7 +283,7 @@
(bit-set*! tmp (vector-ref killv (1- n)) #f)
tmp))))
(let lp ((n 0))
(let ((n (bit-position #t live n)))
(let ((n (bitvector-position live #t n)))
(if n
(match (vector-ref defs n)
(#(name def-offset slot representation)

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

@ -76,5 +76,13 @@
(pass-if-equal 2 (let ((bv #*01110111))
(- (bitvector-length bv) (bitvector-count bv)))))
(with-test-prefix "bitvector-position"
(pass-if-equal 0 (bitvector-position #*01110111 #f))
(pass-if-equal 1 (bitvector-position #*01110111 #t))
(pass-if-equal 4 (bitvector-position #*01110111 #f 1))
(pass-if-equal 4 (bitvector-position #*01110111 #f 4))
(pass-if-equal 5 (bitvector-position #*01110111 #t 5))
(pass-if-equal #f (bitvector-position #*01110111 #f 5)))
(with-test-prefix "bit-count*"
(pass-if-equal 3 (bit-count* #*01110111 #*11001101 #t)))