lloda pushed a commit to branch wip-exception-truncate in repository guile.
commit f8285eef9bcb261db425be61cd66b54c3cbf26c5 Author: Daniel Llorens <ll...@sarc.name> 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)