summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <lloda@sarc.name>2021-08-06 16:51:40 +0200
committerDaniel Llorens <lloda@sarc.name>2021-08-06 17:13:21 +0200
commit5df5555d12f1408a66a5368a918abb981edf5445 (patch)
treec6ffa77362fac657c6f77276fadef7efff323611
parent091f5062cb2f9f5701b999c3b7ee88a480eeecf7 (diff)
downloadguile-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.texi36
-rw-r--r--libguile/vectors.c42
-rw-r--r--libguile/vectors.h6
-rw-r--r--module/scheme/base.scm17
-rw-r--r--module/srfi/srfi-43.scm17
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