mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Add function vector-copy! to core

Browse source 
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!.
This commit is contained in:
Daniel Llorens 2021-08-06 16:51:40 +02:00
parent 091f5062cb
commit 5df5555d12
5 changed files with 80 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

36
doc/ref/api-data.texi
View file

@ -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

42
libguile/vectors.c
View file

@ -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),

6
libguile/vectors.h
View file

@ -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 */

17
module/scheme/base.scm
View file

@ -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))

17
module/srfi/srfi-43.scm
View file

@ -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