[Guile-commits] branch main updated: Extend bytevector-fill! to handle a partial fill

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 9a62f7c  Extend bytevector-fill! to handle a partial fill
9a62f7c is described below

commit 9a62f7cacaf730fca07f6cfd400a1893c2c2acb6
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Tue Aug 17 16:47:04 2021 +0200

    Extend bytevector-fill! to handle a partial fill
    
    * libguile/bytevectors.c (bytevector-fill!): As stated.
      (scm_bytevector_fill_x): Stub to avoid changing the C API.
    * doc/ref/api-data.texi: Documentation.
    * libguile/vectors.c (vector-fill!): Less confusing variable names.
    * test-suite/tests/bytevectors.test: Test partial fill cases for
      bytevector-fill!.
---
 doc/ref/api-data.texi             | 18 +++++++++++++----
 libguile/bytevectors.c            | 42 ++++++++++++++++++++++++++-------------
 libguile/vectors.c                | 17 +++++++---------
 test-suite/tests/bytevectors.test | 14 +++++++++++++
 4 files changed, 63 insertions(+), 28 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index b41cffd..f695b19 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3424,6 +3424,7 @@ Like @code{scm_string_set_x}, but the index is given as a 
@code{size_t}.
 @end deftypefn
 
 @rnindex string-fill!
+@anchor{x-string-fill!}
 @deffn {Scheme Procedure} string-fill! str chr [start [end]]
 @deffnx {C Function} scm_substring_fill_x (str, chr, start, end)
 @deffnx {C Function} scm_string_fill_x (str, chr)
@@ -6383,6 +6384,7 @@ Store @var{obj} in position @var{k} (a @code{size_t}) of 
@var{vec}.
 @end deftypefn
 
 @rnindex vector-fill!
+@anchor{x-vector-fill!}
 @deffn {Scheme Procedure} vector-fill! vec fill [start [end]]
 @deffnx {C Function} scm_vector_fill_x (vec, fill)
 Store @var{fill} in every position of @var{vec} in the range
@@ -6821,17 +6823,25 @@ Return is @var{bv1} equals to @var{bv2}---i.e., if they 
have the same
 length and contents.
 @end deffn
 
-@deffn {Scheme Procedure} bytevector-fill! bv fill
+@deffn {Scheme Procedure} bytevector-fill! bv fill [start [end]]
 @deffnx {C Function} scm_bytevector_fill_x (bv, fill)
-Fill bytevector @var{bv} with @var{fill}, a byte.
+Fill positions [@var{start} ... @var{end}) of bytevector @var{bv} with
+byte @var{fill}. @var{start} defaults to 0 and @var{end} defaults to the
+length of @var{bv}.@footnote{R6RS defines @code{(bytevector-fill! bv
+fill)}. Arguments @var{start} and @var{end} are a Guile extension
+(cf. @ref{x-vector-fill!,@code{vector-fill!}},
+@ref{x-string-fill!,@code{string-fill!}}).}
 @end deffn
 
 @deffn {Scheme Procedure} bytevector-copy! source source-start target 
target-start len
 @deffnx {C Function} scm_bytevector_copy_x (source, source_start, target, 
target_start, len)
 Copy @var{len} bytes from @var{source} into @var{target}, starting
 reading from @var{source-start} (a positive index within @var{source})
-and start writing at @var{target-start}.  It is permitted for the
-@var{source} and @var{target} regions to overlap.
+and writing at @var{target-start}.
+
+It is permitted for the @var{source} and @var{target} regions to
+overlap. In that case, copying takes place as if the source is first
+copied into a temporary bytevector and then into the destination.
 @end deffn
 
 @deffn {Scheme Procedure} bytevector-copy bv
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 2d6cbdb..5bb1c8d 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -565,32 +565,46 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
-           (SCM bv, SCM fill),
-           "Fill bytevector @var{bv} with @var{fill}, a byte.")
-#define FUNC_NAME s_scm_bytevector_fill_x
-{
-  size_t c_len, i;
-  uint8_t *c_bv, c_fill;
-  int value;
+static SCM scm_bytevector_fill_partial_x (SCM bv, SCM fill, SCM start, SCM 
end);
 
+SCM_DEFINE (scm_bytevector_fill_partial_x, "bytevector-fill!", 2, 2, 0,
+           (SCM bv, SCM fill, SCM start, SCM end),
+           "Fill positions [@var{start} ... @var{end}) of bytevector "
+            "@var{bv} with @var{fill}, a byte. @var{start} defaults to 0 "
+            "and @var{end} defaults to the length of @var{bv}. "
+            "The return value is unspecified.")
+#define FUNC_NAME s_scm_bytevector_fill_partial_x
+{
   SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
 
-  value = scm_to_int (fill);
+  int value  = scm_to_int (fill);
   if (SCM_UNLIKELY ((value < -128) || (value > 255)))
     scm_out_of_range (FUNC_NAME, fill);
-  c_fill = (uint8_t) value;
+  
+  size_t i = 0;
+  size_t c_end = SCM_BYTEVECTOR_LENGTH (bv);
+  uint8_t *c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
 
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
+  if (!SCM_UNBNDP (start))
+    i = scm_to_unsigned_integer (start, 0, c_end);
+  if (!SCM_UNBNDP (end))
+    c_end = scm_to_unsigned_integer (end, i, c_end);
 
-  for (i = 0; i < c_len; i++)
-    c_bv[i] = c_fill;
+  memset (c_bv + i, value, c_end-i);
 
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+SCM
+scm_bytevector_fill_x (SCM bv, SCM fill)
+#define FUNC_NAME s_scm_bytevector_fill_x
+{
+  return scm_bytevector_fill_partial_x (bv, fill, SCM_UNDEFINED, 
SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
            (SCM source, SCM source_start, SCM target, SCM target_start,
             SCM len),
diff --git a/libguile/vectors.c b/libguile/vectors.c
index a71f51e..8cbd201 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -412,27 +412,24 @@ static SCM scm_vector_fill_partial_x (SCM vec, SCM fill, 
SCM start, SCM end);
 
 SCM_DEFINE_STATIC (scm_vector_fill_partial_x, "vector-fill!", 2, 2, 0,
             (SCM vec, SCM fill, SCM start, SCM end),
-            "Assign the value of every location in vector @var{vec} between\n"
-            "@var{start} and @var{end} to @var{fill}.  @var{start} defaults\n"
+            "Assign the value of every location in vector @var{vec} in the 
range\n"
+            "[@var{start} ... @var{end}) to @var{fill}.  @var{start} 
defaults\n"
             "to 0 and @var{end} defaults to the length of @var{vec}.  The 
value\n"
             "returned by @code{vector-fill!} is unspecified.")
 #define FUNC_NAME s_scm_vector_fill_partial_x
 {
   SCM_VALIDATE_MUTABLE_VECTOR(1, vec);
 
-  SCM *data;
   size_t i = 0;
-  size_t len = SCM_I_VECTOR_LENGTH (vec);
-
-  data = SCM_I_VECTOR_WELTS (vec);
+  size_t c_end = SCM_I_VECTOR_LENGTH (vec);
+  SCM *data = SCM_I_VECTOR_WELTS (vec);
 
   if (!SCM_UNBNDP (start))
-    i = scm_to_unsigned_integer (start, 0, len);
-
+    i = scm_to_unsigned_integer (start, 0, c_end);
   if (!SCM_UNBNDP (end))
-    len = scm_to_unsigned_integer (end, i, len);
+    c_end = scm_to_unsigned_integer (end, i, c_end);
 
-  for (; i < len; ++i)
+  for (; i < c_end; ++i)
     data[i] = fill;
 
   return SCM_UNSPECIFIED;
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index 9ae040f..732aadb 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -65,6 +65,20 @@
       (bytevector-fill! bv -128)
       bv))
 
+  ;; This is a Guile-specific extension.
+  (pass-if-equal "bytevector-fill! range arguments I"
+      #vu8(0 0 1 1 1)
+    (let ((bv (make-bytevector 5 0)))
+      (bytevector-fill! bv 1 2)
+      bv))
+
+  ;; This is a Guile-specific extension.
+  (pass-if-equal "bytevector-fill! range arguments II"
+      #vu8(0 0 1 1 0)
+    (let ((bv (make-bytevector 5 0)))
+      (bytevector-fill! bv 1 2 4)
+      bv))
+  
   (pass-if "bytevector-copy! overlapping"
     ;; See <http://debbugs.gnu.org/10070>.
     (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))