diff options
author | Daniel Llorens <lloda@sarc.name> | 2021-08-06 16:51:40 +0200 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2021-08-06 17:13:21 +0200 |
commit | 5df5555d12f1408a66a5368a918abb981edf5445 (patch) | |
tree | c6ffa77362fac657c6f77276fadef7efff323611 | |
parent | 091f5062cb2f9f5701b999c3b7ee88a480eeecf7 (diff) | |
download | guile-5df5555d12f1408a66a5368a918abb981edf5445.tar.gz |
Add function vector-copy! to core
This is up to 20%-30% faster than the previous versions in (scheme base) or
(srfi srfi-43) that used vector-move-left!/vector-move-right!.
* libguile/vectors.h:
* libguile/vectors.c: As stated.
* doc/ref/api-data.texi (vector-copy!): Document the new function.
(vector-fill!): Document optional arguments.
(vector-copy): Document optional arguments.
* module/scheme/base.scm: Reuse core vector-copy!.
* module/srfi/srfi-43.scm: Reuse core vector-copy!.
-rw-r--r-- | doc/ref/api-data.texi | 36 | ||||
-rw-r--r-- | libguile/vectors.c | 42 | ||||
-rw-r--r-- | libguile/vectors.h | 6 | ||||
-rw-r--r-- | module/scheme/base.scm | 17 | ||||
-rw-r--r-- | module/srfi/srfi-43.scm | 17 |
5 files changed, 80 insertions, 38 deletions
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index eb3d91060..a3e6d6c31 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6381,16 +6381,38 @@ Store @var{obj} in position @var{k} (a @code{size_t}) of @var{vec}. @end deftypefn @rnindex vector-fill! -@deffn {Scheme Procedure} vector-fill! vec 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}. The value -returned by @code{vector-fill!} is unspecified. +Store @var{fill} in every position of @var{vec} in the range +[@var{start} ... @var{end}). @var{start} defaults to 0 and @var{end} +defaults to the length of @var{vec}. + +The value returned by @code{vector-fill!} is unspecified. @end deffn @rnindex vector-copy -@deffn {Scheme Procedure} vector-copy vec +@deffn {Scheme Procedure} vector-copy vec [start [end]] @deffnx {C Function} scm_vector_copy (vec) -Return a copy of @var{vec}. +Returns a freshly allocated vector containing the elements of @var{vec} +in the range [@var{start} ... @var{end}). @var{start} defaults to 0 and +@var{end} defaults to the length of @var{vec}. +@end deffn + +@rnindex vector-copy! +@deffn {Scheme Procedure} vector-copy! dst at src [start [end]] +Copy the block of elements from vector @var{src} in the range +[@var{start} ... @var{end}) into vector @var{dst}, starting at position +@var{at}. @var{at} and @var{start} default to 0 and @var{end} defaults +to the length of @var{src}. + +It is an error for @var{dst} to have a length less than @var{at} + +(@var{end} - @var{start}). + +The order in which elements are copied is unspecified, except that if the +source and destination overlap, copying takes place as if the source is +first copied into a temporary vector and then into the destination. + +The value returned by @code{vector-copy!} is unspecified. @end deffn @deffn {Scheme Procedure} vector-move-left! vec1 start1 end1 vec2 start2 @@ -6403,6 +6425,8 @@ to @var{vec2} starting at position @var{start2}. @var{start1} and Therefore, in the case where @var{vec1} and @var{vec2} refer to the same vector, @code{vector-move-left!} is usually appropriate when @var{start1} is greater than @var{start2}. + +The value returned by @code{vector-move-left!} is unspecified. @end deffn @deffn {Scheme Procedure} vector-move-right! vec1 start1 end1 vec2 start2 @@ -6415,6 +6439,8 @@ to @var{vec2} starting at position @var{start2}. @var{start1} and Therefore, in the case where @var{vec1} and @var{vec2} refer to the same vector, @code{vector-move-right!} is usually appropriate when @var{start1} is less than @var{start2}. + +The value returned by @code{vector-move-right!} is unspecified. @end deffn @node Vector Accessing from C diff --git a/libguile/vectors.c b/libguile/vectors.c index 3a2ff7ab5..40e80ddd2 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -329,6 +329,48 @@ scm_vector_copy (SCM vec) return scm_vector_copy_partial (vec, SCM_UNDEFINED, SCM_UNDEFINED); } +SCM_DEFINE (scm_vector_copy_x, "vector-copy!", 3, 2, 0, + (SCM dst, SCM at, SCM src, SCM start, SCM end), + "Copy a block of elements from @var{src} to @var{dst}, both of which must be\n" + "vectors, starting in @var{dst} at @var{at} and starting in @var{src} at\n" + "@var{start} and ending at @var{end}.\n\n" + "It is an error for @var{dst} to have a length less than\n" + "@var{at} + (@var{end} - @var{start}). @var{at} and @var{start} default\n" + "to 0 and @var{end} defaults to the length of @var{src}.\n\n" + "The order in which elements are copied is unspecified, except that if the\n" + "source and destination overlap, copying takes place as if the source is\n" + "first copied into a temporary vector and then into the destination.") +#define FUNC_NAME s_scm_vector_copy_x +{ + SCM_VALIDATE_MUTABLE_VECTOR (1, dst); + SCM_VALIDATE_VECTOR (3, src); + size_t src_org = 0; + size_t dst_org = scm_to_size_t (at); + size_t src_end = SCM_I_VECTOR_LENGTH (src); + size_t dst_end = SCM_I_VECTOR_LENGTH (dst); + + if (!SCM_UNBNDP (start)) + { + src_org = scm_to_size_t (start); + SCM_ASSERT_RANGE (SCM_ARG4, start, src_org<=src_end); + + if (!SCM_UNBNDP (end)) + { + size_t e = scm_to_size_t (end); + SCM_ASSERT_RANGE (SCM_ARG5, end, e>=src_org && e<=src_end); + src_end = e; + } + } + size_t len = src_end-src_org; + SCM_ASSERT_RANGE (SCM_ARG2, at, dst_org<=dst_end && len<=dst_end-dst_org); + + memmove (SCM_I_VECTOR_WELTS (dst) + dst_org, SCM_I_VECTOR_ELTS (src) + src_org, + len * sizeof(SCM)); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, (SCM vec), diff --git a/libguile/vectors.h b/libguile/vectors.h index 1c04f9afe..78abc16f2 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -41,6 +41,8 @@ SCM_API SCM scm_vector_move_left_x (SCM vec1, SCM start1, SCM end1, SCM_API SCM scm_vector_move_right_x (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2); SCM_API SCM scm_vector_copy (SCM vec); +SCM_API SCM scm_vector_copy_partial (SCM vec, SCM start, SCM end); +SCM_API SCM scm_vector_copy_x (SCM dst, SCM at, SCM src, SCM start, SCM end); SCM_API int scm_is_vector (SCM obj); SCM_API int scm_is_simple_vector (SCM obj); @@ -87,9 +89,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec, #define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1)) #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8) -SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y); -SCM_INTERNAL SCM scm_vector_copy_partial (SCM vec, SCM start, SCM end); - +SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y); SCM_INTERNAL void scm_init_vectors (void); #endif /* SCM_VECTORS_H */ diff --git a/module/scheme/base.scm b/module/scheme/base.scm index c57bdf110..c6a73c092 100644 --- a/module/scheme/base.scm +++ b/module/scheme/base.scm @@ -57,7 +57,7 @@ string->vector vector->string (r7:string->utf8 . string->utf8) (r7:vector->list . vector->list) - vector-copy! vector-append vector-for-each vector-map + vector-append vector-for-each vector-map (r7:bytevector-copy . bytevector-copy) (r7:bytevector-copy! . bytevector-copy!) (r7:utf8->string . utf8->string) @@ -114,7 +114,7 @@ (char-ready? . u8-ready?) unless unquote unquote-splicing values - vector vector-copy vector-fill! + vector vector-copy vector-copy! vector-fill! vector-length vector-ref vector-set! vector? when with-exception-handler write-char zero?)) @@ -431,19 +431,6 @@ ;;; vector -(define* (vector-copy! target tstart source - #:optional (sstart 0) (send (vector-length source))) - "Copy a block of elements from SOURCE to TARGET, both of which must be -vectors, starting in TARGET at TSTART and starting in SOURCE at SSTART, -ending when SEND - SSTART elements have been copied. It is an error for -TARGET to have a length less than TSTART + (SEND - SSTART). SSTART -defaults to 0 and SEND defaults to the length of SOURCE." - (let ((tlen (vector-length target)) - (slen (vector-length source))) - (if (< tstart sstart) - (vector-move-left! source sstart send target tstart) - (vector-move-right! source sstart send target tstart)))) - (define r7:vector->list (case-lambda* ((v) (vector->list v)) diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm index f8e38e27c..18e97cf53 100644 --- a/module/srfi/srfi-43.scm +++ b/module/srfi/srfi-43.scm @@ -22,7 +22,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-8) #:re-export (make-vector vector vector? vector-ref vector-set! - vector-length vector-fill!) + vector-length vector-fill! vector-copy!) #:replace (vector-copy list->vector vector->list) #:export (vector-empty? vector= vector-unfold vector-unfold-right vector-reverse-copy @@ -35,7 +35,7 @@ vector-binary-search vector-any vector-every vector-swap! vector-reverse! - vector-copy! vector-reverse-copy! + vector-reverse-copy! reverse-vector->list reverse-list->vector)) @@ -933,19 +933,6 @@ START defaults to 0 and END defaults to the length of VEC." (error-from 'copy! "would write past end of target")) (%copy! target tstart source sstart send))))))) -(define-vector-copier! vector-copy! - "(vector-copy! target tstart source [sstart [send]]) -> unspecified - -Copy a block of elements from SOURCE to TARGET, both of which must be -vectors, starting in TARGET at TSTART and starting in SOURCE at -SSTART, ending when SEND - SSTART elements have been copied. It is an -error for TARGET to have a length less than TSTART + (SEND - SSTART). -SSTART defaults to 0 and SEND defaults to the length of SOURCE." - (lambda (target tstart source sstart send) - (if (< tstart sstart) - (vector-move-left! source sstart send target tstart) - (vector-move-right! source sstart send target tstart)))) - (define-vector-copier! vector-reverse-copy! "(vector-reverse-copy! target tstart source [sstart [send]]) -> unspecified |