[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch master updated: Replace bit-position with bitvect
From: |
Andy Wingo |
Subject: |
[Guile-commits] branch master updated: Replace bit-position with bitvector-position |
Date: |
Sun, 12 Apr 2020 16:42:04 -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 06709d7 Replace bit-position with bitvector-position
06709d7 is described below
commit 06709d77b9f519c712e13e086c7213e5a77fcbc4
Author: Andy Wingo <address@hidden>
AuthorDate: Sun Apr 12 22:39:55 2020 +0200
Replace bit-position with bitvector-position
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.
---
NEWS | 11 ++---
doc/ref/api-data.texi | 8 ++--
libguile/bitvectors.c | 89 +++++++++++++++-------------------------
libguile/bitvectors.h | 2 +-
libguile/deprecated.c | 42 +++++++++++++++++++
libguile/deprecated.h | 1 +
module/ice-9/sandbox.scm | 2 +-
module/language/cps/intset.scm | 2 +-
module/system/vm/frame.scm | 2 +-
test-suite/tests/bitvectors.test | 8 ++++
10 files changed, 97 insertions(+), 70 deletions(-)
diff --git a/NEWS b/NEWS
index e485226..a006dd6 100644
--- a/NEWS
+++ b/NEWS
@@ -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
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index bce628c..7328842 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -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
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 0209102..356b1c7 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -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
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 2cf5213..09a9a61 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -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);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index e39d11e..2b1a338 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -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)
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 3bdef4a..edbbff4 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -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);
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index a9eefbf..bd80a49 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -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
diff --git a/module/language/cps/intset.scm b/module/language/cps/intset.scm
index 7b2a66a..54def5c 100644
--- a/module/language/cps/intset.scm
+++ b/module/language/cps/intset.scm
@@ -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))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 89b6399..3800d5b 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -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)
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index 18d77ed..332c8ff 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -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)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch master updated: Replace bit-position with bitvector-position,
Andy Wingo <=