[Guile-commits] 01/02: Extend core vector-fill! to handle a range

[Daniel Llorens]

lloda pushed a commit to branch wip-exception-truncate
in repository guile.

commit f8285eef9bcb261db425be61cd66b54c3cbf26c5
Author: Daniel Llorens <address@hidden>
Date:   Wed Dec 18 14:31:39 2019 +0100

    Extend core vector-fill! to handle a range
    
    With this patch, these two lines
    
      (vector-fill! vec fill)
      (vector-fill! vec fill 0 end)
    
    run at the same speed; before, the second one was much slower.
    
    This patch also makes it an error to call vector-fill! with a non-vector
    array. The previous implementation did not work correctly in this case.
    
    * libguile/vectors.c (SCM_VALIDATE_MUTABLE_VECTOR): Better error message.
      (vector-fill!): Handle optional arguments start, end. Do not attempt
        to handle non-vector arrays. Rename the C binding to
        scm_vector_fill_partial_x.
      (scm_vector_fill_x): Reuse scm_vector_fill_partial_x.
    * module/srfi/srfi-43.scm (vector-fill!): Remove & re-export the core
      version instead.
---
 libguile/vectors.c      | 47 +++++++++++++++++++++++++++++++++++------------
 module/srfi/srfi-43.scm | 32 ++------------------------------
 2 files changed, 37 insertions(+), 42 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 87a50a3..d00b799 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -24,6 +24,8 @@
 # include <config.h>
 #endif
 
+#include <assert.h>
+
 #include "array-handle.h"
 #include "bdw-gc.h"
 #include "boolean.h"
@@ -43,7 +45,8 @@
 
 #define SCM_VALIDATE_MUTABLE_VECTOR(pos, v)                             \
   do {                                                                  \
-    SCM_ASSERT (SCM_I_IS_MUTABLE_VECTOR (v), v, pos, FUNC_NAME);        \
+    SCM_ASSERT_TYPE (SCM_I_IS_MUTABLE_VECTOR (v), v, pos, FUNC_NAME,    \
+                     "mutable vector");                                 \
   } while (0)
 
 
@@ -311,28 +314,48 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM scm_vector_fill_partial_x (SCM vec, SCM fill, SCM start, SCM end);
 
-SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
-            (SCM v, SCM fill),
-           "Store @var{fill} in every position of @var{vector}.  The value\n"
-           "returned by @code{vector-fill!} is unspecified.")
-#define FUNC_NAME s_scm_vector_fill_x
+SCM_DEFINE (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"
+            "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_t_array_handle handle;
+  SCM_VALIDATE_MUTABLE_VECTOR(1, vec);
+
   SCM *data;
-  size_t i, len;
-  ssize_t inc;
+  size_t i = 0;
+  size_t len = SCM_I_VECTOR_LENGTH (vec);
+
+  data = SCM_I_VECTOR_WELTS (vec);
+
+  if (!SCM_UNBNDP (start))
+    i = scm_to_unsigned_integer (start, 0, len);
+
+  if (!SCM_UNBNDP (end))
+    len = scm_to_unsigned_integer (end, i, len);
 
-  data = scm_vector_writable_elements (v, &handle, &len, &inc);
-  for (i = 0; i < len; i += inc)
+  for (; i < len; ++i)
     data[i] = fill;
-  scm_array_handle_release (&handle);
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 
 SCM
+scm_vector_fill_x (SCM vec, SCM fill)
+#define FUNC_NAME s_scm_vector_fill_x
+{
+  return scm_vector_fill_partial_x (vec, fill, SCM_UNDEFINED, SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+
+SCM
 scm_i_vector_equal_p (SCM x, SCM y)
 {
   long i;
diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm
index e1bf19e..eb6d8c3 100644
--- a/module/srfi/srfi-43.scm
+++ b/module/srfi/srfi-43.scm
@@ -22,8 +22,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-8)
   #:re-export (make-vector vector vector? vector-ref vector-set!
-                           vector-length)
-  #:replace (vector-copy vector-fill! list->vector vector->list)
+                           vector-length vector-fill!)
+  #:replace (vector-copy list->vector vector->list)
   #:export (vector-empty? vector= vector-unfold vector-unfold-right
                           vector-reverse-copy
                           vector-append vector-concatenate
@@ -872,34 +872,6 @@ Swap the values of the locations in VEC at I and J."
       (vector-set! vec i (vector-ref vec j))
       (vector-set! vec j tmp))))
 
-;; TODO: Enhance Guile core 'vector-fill!' to do this.
-(define vector-fill!
-  (let ()
-    (define guile-vector-fill!
-      (@ (guile) vector-fill!))
-    (define (%vector-fill! vec fill start end)
-      (let loop ((i start))
-        (when (< i end)
-          (vector-set! vec i fill)
-          (loop (+ i 1)))))
-    (case-lambda
-      "(vector-fill! vec fill [start [end]]) -> unspecified
-
-Assign the value of every location in VEC between START and END to
-FILL.  START defaults to 0 and END defaults to the length of VEC."
-      ((vec fill)
-       (guile-vector-fill! vec fill))
-      ((vec fill start)
-       (assert-vector vec 'vector-fill!)
-       (let ((len (vector-length vec)))
-         (assert-valid-start start len 'vector-fill!)
-         (%vector-fill! vec fill start len)))
-      ((vec fill start end)
-       (assert-vector vec 'vector-fill!)
-       (let ((len (vector-length vec)))
-         (assert-valid-range start end len 'vector-fill!)
-         (%vector-fill! vec fill start end))))))
-
 (define (%vector-reverse! vec start end)
   (let loop ((i start) (j (- end 1)))
     (when (< i j)