From ddad8ae05adfdb84ef80cb2d2730e73f4d27c74b Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Wed, 18 Dec 2019 14:31:39 +0100 Subject: [PATCH] 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 | 51 +++++++++++++++++++++++++++++------------ module/srfi/srfi-43.scm | 32 ++------------------------ 3 files changed, 57 insertions(+), 45 deletions(-) diff --git a/NEWS b/NEWS index b89813247..4fb91c879 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,25 @@ See the end for copying conditions. Please send Guile bug reports to bug-guile@gnu.org. + +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): diff --git a/libguile/vectors.c b/libguile/vectors.c index 87a50a3dd..1578841c3 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,23 +312,43 @@ 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.") +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_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); + + 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; + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + +SCM +scm_vector_fill_x (SCM vec, SCM fill) #define FUNC_NAME s_scm_vector_fill_x { - scm_t_array_handle handle; - SCM *data; - size_t i, len; - ssize_t inc; - - data = scm_vector_writable_elements (v, &handle, &len, &inc); - for (i = 0; i < len; i += inc) - data[i] = fill; - scm_array_handle_release (&handle); - return SCM_UNSPECIFIED; + return scm_vector_fill_partial_x (vec, fill, SCM_UNDEFINED, SCM_UNDEFINED); } #undef FUNC_NAME diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm index e1bf19e9d..eb6d8c317 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)