diff options
author | Daniel Llorens <lloda@sarc.name> | 2020-02-06 13:19:59 +0100 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2020-04-09 16:59:39 +0200 |
commit | 9e785509e494dd3c1b9b001eb89ba0a00fd693a2 (patch) | |
tree | ad6b056fce3dc8d145c7346b48f05beb510ca2c1 | |
parent | 53b9d678a639403a51e3c582c84f4f80c46c2bcc (diff) | |
download | guile-9e785509e494dd3c1b9b001eb89ba0a00fd693a2.tar.gz |
Rewrite vector-copy! using memmove
* libguile/vectors.c (vector-copy!): As stated. Provide C binding
scm_vector_copy_x.
* module/srfi/srfi-43.scm: Re-export vector-copy! from core.
(vector-reverse-copy!): Remove definer macro, simplify.
* doc/ref/api-data.texi: Document vector-copy!.
-rw-r--r-- | NEWS-wip-vector-cleanup.txt | 5 | ||||
-rw-r--r-- | doc/ref/api-data.texi | 13 | ||||
-rw-r--r-- | libguile/vectors.c | 31 | ||||
-rw-r--r-- | libguile/vectors.h | 4 | ||||
-rw-r--r-- | module/srfi/srfi-43.scm | 75 |
5 files changed, 69 insertions, 59 deletions
diff --git a/NEWS-wip-vector-cleanup.txt b/NEWS-wip-vector-cleanup.txt index b8770e1e7..c45e6434f 100644 --- a/NEWS-wip-vector-cleanup.txt +++ b/NEWS-wip-vector-cleanup.txt @@ -56,6 +56,11 @@ These functions weren't advertised to work on non-vector arrays. They did try to instead of the correct result #1@1(0 1 2 0 0). This buggy support has been removed. +* Compatible changes + +** vector-copy! from (srfi :43) is provided in core. + + * Rationale / TODO The ultimate goal of this patch set is to have arrays be strictly layered above typed vectors so they can be replaced by a different implementation without affecting the latter. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 010d4c841..5c49272a5 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -6390,6 +6390,19 @@ returned by @code{vector-fill!} is unspecified. Return a copy of @var{vec}. @end deffn +@deffn {Scheme Procedure} vector-copy! target tstart source [sstart [send]] +@deffnx {C Function} scm_vector_copy_x (target tstart source, sstart, send) +Copy a block of elements from @var{source} to @var{target}, both of +which must be vectors, starting in @var{target} at @var{tstart} and +starting in @var{source} at @var{sstart}, ending when (@var{send} - +@var{sstart}) elements have been copied. It is an error for +@var{target} to have a length less than (@var{tstart} + @var{send} - +@var{sstart}). @var{sstart} defaults to 0 and @var{send} defaults to +the length of @var{source}. + +This function is also provided as part of @ref{SRFI-43}. +@end deffn + @deffn {Scheme Procedure} vector-move-left! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_left_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, diff --git a/libguile/vectors.c b/libguile/vectors.c index 6df2dc58d..9093e6b6b 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -335,8 +335,35 @@ scm_i_vector_equal_p (SCM x, SCM y) return SCM_BOOL_T; } -// These functions are used by vector-copy! -// FIXME split into vector- and array- (?) +SCM_DEFINE (scm_vector_copy_x, "vector-copy!", 3, 2, 0, + (SCM target, SCM tstart, SCM source, SCM sstart, SCM send), + "Copy a block of elements from @var{source} to @var{target}, " + "both of which must be vectors, starting in @var{target} at " + "@var{tstart} and starting in @var{source} at @var{sstart}, ending " + "when @var{send} - @var{sstart} elements have been copied.\n\n" + "It is an error for @var{target} to have a length less than " + "@var{tstart} + (@var{send} - @var{sstart}). @var{sstart} defaults " + "to 0 and @var{send} defaults to the length of @var{source}.\n\n" + "If @var{target} and @var{source} are the same vector, then copying takes " + "place as though the elements in @var{source} are first copied into a " + "temporary vector, and that temporary vector is then copied to @var{target}.") +#define FUNC_NAME s_scm_vector_copy_x +{ + size_t slen, tlen; + const SCM *s = scm_vector_elements (source, &slen); + SCM *t = scm_vector_writable_elements (target, &tlen); + + size_t t0, s0, len; + t0 = scm_to_unsigned_integer (tstart, 0, tlen); + s0 = (SCM_UNBNDP (sstart)) ? 0 : scm_to_unsigned_integer (sstart, 0, slen); + len = ((SCM_UNBNDP (send)) ? slen : scm_to_unsigned_integer (send, s0, slen)) - s0; + SCM_ASSERT_RANGE (SCM_ARG3, source, t0+len <= tlen); + + memmove(t + t0, s + s0, len * sizeof(SCM)); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2), diff --git a/libguile/vectors.h b/libguile/vectors.h index fe5f92779..a6f569d86 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -36,11 +36,13 @@ SCM_API SCM scm_vector_set_x (SCM v, SCM k, SCM obj); SCM_API SCM scm_make_vector (SCM k, SCM fill); SCM_API SCM scm_vector_to_list (SCM v); SCM_API SCM scm_vector_fill_x (SCM v, SCM fill_x); +SCM_API SCM scm_vector_copy (SCM vec); +SCM_API SCM scm_vector_copy_x (SCM target, SCM tstart, + SCM source, SCM sstart, SCM send); SCM_API SCM scm_vector_move_left_x (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2); 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 int scm_is_vector (SCM obj); SCM_API SCM scm_c_make_vector (size_t len, SCM fill); diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm index eb6d8c317..2d042edea 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)) @@ -900,57 +900,8 @@ START defaults to 0 and END defaults to the length of VEC." (assert-valid-range start end len 'vector-reverse!) (%vector-reverse! vec start end))))) -(define-syntax-rule (define-vector-copier! copy! docstring inner-proc) - (define copy! - (let ((%copy! inner-proc)) - (case-lambda - docstring - ((target tstart source) - (assert-vector target 'copy!) - (assert-vector source 'copy!) - (let ((tlen (vector-length target)) - (slen (vector-length source))) - (assert-valid-start tstart tlen 'copy!) - (unless (>= tlen (+ tstart slen)) - (error-from 'copy! "would write past end of target")) - (%copy! target tstart source 0 slen))) - - ((target tstart source sstart) - (assert-vector target 'copy!) - (assert-vector source 'copy!) - (let ((tlen (vector-length target)) - (slen (vector-length source))) - (assert-valid-start tstart tlen 'copy!) - (assert-valid-start sstart slen 'copy!) - (unless (>= tlen (+ tstart (- slen sstart))) - (error-from 'copy! "would write past end of target")) - (%copy! target tstart source sstart slen))) - - ((target tstart source sstart send) - (assert-vector target 'copy!) - (assert-vector source 'copy!) - (let ((tlen (vector-length target)) - (slen (vector-length source))) - (assert-valid-start tstart tlen 'copy!) - (assert-valid-range sstart send slen 'copy!) - (unless (>= tlen (+ tstart (- send sstart))) - (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! +(define vector-reverse-copy! + (case-lambda "(vector-reverse-copy! target tstart source [sstart [send]]) -> unspecified Like vector-copy!, but copy the elements in the reverse order. It is @@ -958,13 +909,25 @@ an error if TARGET and SOURCE are identical vectors and the TARGET and SOURCE ranges overlap; however, if TSTART = SSTART, vector-reverse-copy! behaves as (vector-reverse! TARGET TSTART SEND) would." - (lambda (target tstart source sstart send) - (if (and (eq? target source) (= tstart sstart)) + ((target tstart source) + (vector-reverse-copy! target tstart source 0 (vector-length source))) + ((target tstart source sstart) + (vector-reverse-copy! target tstart source sstart (vector-length source))) + ((target tstart source sstart send) + (assert-vector target 'copy!) + (assert-vector source 'copy!) + (let ((tlen (vector-length target)) + (slen (vector-length source))) + (assert-valid-start tstart tlen 'copy!) + (assert-valid-range sstart send slen 'copy!) + (unless (>= tlen (+ tstart (- send sstart))) + (error-from 'copy! "would write past end of target")) + (if (and (eq? target source) (= tstart sstart)) (%vector-reverse! target sstart send) (let loop ((i tstart) (j (- send 1))) (when (>= j sstart) (vector-set! target i (vector-ref source j)) - (loop (+ i 1) (- j 1))))))) + (loop (+ i 1) (- j 1))))))))) (define vector->list (let () |