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

[Daniel Llorens]

lloda pushed a commit to branch master
in repository guile.

commit ddad8ae05adfdb84ef80cb2d2730e73f4d27c74b
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.
---
 NEWS                    | 19 +++++++++++++++++++
 libguile/vectors.c      | 45 +++++++++++++++++++++++++++++++++------------
 module/srfi/srfi-43.scm | 32 ++------------------------------
 3 files changed, 54 insertions(+), 42 deletions(-)

diff --git a/NEWS b/NEWS
index b898132..4fb91c8 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,25 @@ See the end for copying conditions.
 Please send Guile bug reports to address@hidden.
 
 
+Changes since alpha 2.9.8:
+
+** Fix performance of SRFI-43 vector-fill!
+
+SRFI-43 vector-fill! now has the same performance whether an optional
+range is provided or not, and is also provided in core.  As a side
+effect, vector-fill! and vector_fill_x no longer work on non-vector
+rank-1 arrays. Such cases were handled incorrectly before; for example,
+prior to this change,
+
+  (define a (make-vector 10 'x))
+  (define b (make-shared-array a (lambda (i) (list (* 2 i))) 5))
+  (vector-fill! b 'y)
+
+  => #1(y y y x x)
+
+This is now an error. Instead, use array-fill! (or array_fill_x).
+
+
 Changes in alpha 2.9.8 (since alpha 2.9.7):
 
 * Bug fixes
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 87a50a3..1578841 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -43,7 +43,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 +312,48 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+static 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_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"
+            "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_vector_writable_elements (v, &handle, &len, &inc);
-  for (i = 0; i < len; i += inc)
+  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);
+
+  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)