bug#54142: [PATCH] Add srfi 214 - flexvectors
Vijay Marupudi <[email protected]>
| Newsgroups | gmane.lisp.guile.bugs |
|---|---|
| Message-ID | <[email protected]> |
Hello, I've attached a patch that adds support for dynamic vectors, aka flexvectors. Tests and documentation included. ~ Vijay
0001-Added-srfi-214-flexvectors.patch
(text/x-patch, 73.2 KB)
From 42206dec4d5e9ae51665c6e98ef07715b89b12fe Mon Sep 17 00:00:00 2001 From: Vijay Marupudi <[email protected]> Date: Tue, 18 Jan 2022 20:52:08 -0500 Subject: [PATCH] Added srfi-214: flexvectors Included code, documentation, and tests --- doc/ref/api-data.texi | 842 ++++++++++++++++++++++++++++++++- doc/ref/srfi-modules.texi | 6 + module/Makefile.am | 1 + module/srfi/srfi-214.scm | 735 ++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-214.test | 437 +++++++++++++++++ 6 files changed, 2021 insertions(+), 1 deletion(-) create mode 100644 module/srfi/srfi-214.scm create mode 100644 test-suite/tests/srfi-214.test diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index b6c2c4d61..1ba7b57a9 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -26,7 +26,8 @@ complex. * Bit Vectors:: Vectors of bits. * Bytevectors:: Sequences of bytes. * Arrays:: Multidimensional matrices. -* VLists:: Vector-like lists. +* VLists:: Vector-like lists +* Flexvectors:: Mutable vectors with adjustable size * Record Overview:: Walking through the maze of record APIs. * SRFI-9 Records:: The standard, recommended record API. * Records:: Guile's historical record API. @@ -8393,6 +8394,845 @@ Return a new vlist whose contents correspond to @var{lst}. Return a new list whose contents match those of @var{vlist}. @end deffn +@node Flexvectors +@subsection Flexvectors +@cindex flexvector + +Flexvectors are sometimes better known as a @url{https://en.wikipedia.org/wiki/Dynamic_array,dynamic arrays}. This data +structure has a wide variety of names in different languages: + +@itemize @bullet{} + +@item +JavaScript and Ruby call it an array +@item +Python calls it a list +@item +Java calls it an ArrayList (and, before that, it was called a Vector) + +@end itemize + + +Flexvectors have the same O(1) random-access performance guarantees as +ordinary vectors. Additionally, appending to the back of a flexvector +has the same (amortized) performance as setting an existing location in +the same flexvector. + +Functions in this module can be obtained with: + +@example +(use-modules (srfi srfi-214)) +@end example + +The material in this section was derived from the +@url{https://srfi.schemers.org/srfi-214/srfi-214.html,SRFI-214} proposal +written by Adam Nelson, whose copyright notice is as follows. + +@quotation +(C) Adam Nelson 2020-2021. + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice (including the +next paragraph) shall be included in all copies or substantial portions +of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +@end quotation + +@subsubsection Constructors + +@deffn {Scheme Procedure} make-flexvector size [fill] + +Creates and returns a flexvector of size @var{size}. If @var{fill} is +specified, all of the elements of the vector are initialized to +@var{fill}. Otherwise, their contents are indeterminate. + + +@example +(make-flexvector 5 3) @result{} #<flexvector 3 3 3 3 3> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector x ... + +Creates and returns a flexvector whose elements are @var{x ...}. + +@example +(flexvector 0 1 2 3 4) @result{} #<flexvector 0 1 2 3 4> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-unfold p f g initial-seed ... +@deffnx {Scheme Procedure} flexvector-unfold-right p f g initial-seed ... + +The fundamental flexvector constructor. @code{flexvector-unfold} is +modeled on SRFI 1 @code{unfold} instead of SRFI 133 +@code{vector-unfold} because flexvectors are not limited to a +predetermined length. + +@example +;; List of squares: 1^2 ... 10^2 +(flexvector-unfold (lambda (x) (> x 10)) (lambda (x) (* x x)) (lambda (x) (+ x 1)) 1) +@result{} #<flexvector 1 4 9 16 25 36 49 64 81 100> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-copy fv [start [end]] +@deffnx {Scheme Procedure} flexvector-reverse-copy fv [start [end]] + +Allocates a new flexvector whose length is @code{(- end start)} and fills +it with elements from @var{fv}, taking elements from @var{fv} starting +at index @var{start} and stopping at index @var{end}. @var{start} +defaults to @var{0} and @var{end} defaults to the value of +@code{(flexvector-length fv)}. + +@example +(flexvector-copy (flexvector 'a 'b 'c)) @result{} #<flexvector a b c> +(flexvector-copy (flexvector 'a 'b 'c) 1) @result{} #<flexvector b c> +(flexvector-copy (flexvector 'a 'b 'c) 1 2) @result{} #<flexvector b> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-append fv ... + +Returns a newly allocated flexvector that contains all elements in order +from the subsequent locations in @var{fv ...}. + +@example +(flexvector-append (flexvector 'x) (flexvector 'y)) +@result{} #<flexvector x y> + +(flexvector-append (flexvector 'a) (flexvector 'b 'c 'd)) +@result{} #<flexvector a b c d> + +(flexvector-append (flexvector 'a (flexvector 'b)) + (flexvector (flexvector 'c))) +@result{} #<flexvector a #<flexvector b> #<flexvector c>> + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-concatenate list-of-flexvectors + +Equivalent to @code{(apply flexvector-append list-of-flexvectors)}, but +may be implemented more efficiently. + +@example +(flexvector-concatenate (list (flexvector 'a 'b) (flexvector 'c 'd))) +@result{} #<flexvector a b c d> +@end example +@end deffn + + +@deffn {Scheme Procedure} flexvector-append-subvectors [fv start end] ... + +Returns a vector that contains every element of each @var{fv} from +@var{start} to @var{end} in the specified order. This procedure is a +generalization of @code{flexvector-append}. + +@example +(flexvector-append-subvectors (flexvector 'a 'b 'c 'd 'e) 0 2 + (flexvector 'f 'g 'h 'i 'j) 2 4) +@result{} #<flexvector a b h i> +@end example +@end deffn + +@subsubsection Predicates + +@deffn {Scheme Procedure} flexvector? x + +Disjoint type predicate for flexvectors: this returns @var{#t} if +@var{x} is a flexvector, and @var{#f} otherwise. + +@example +(flexvector? (flexvector 1 2 3)) @result{} #t +(flexvector? (vector 1 2 3)) @result{} #f +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-empty? fv + +Returns @var{#t} if @var{fv} is empty (i.e., its length is @var{0}), and +@var{#f} if not. + +@example +(flexvector-empty? (flexvector)) @result{} #t +(flexvector-empty? (flexvector 'a)) @result{} #f +(flexvector-empty? (flexvector (flexvector))) @result{} #f +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector=? elt=? fv ... + +Flexvector structural equality predicate, generalized across +user-specified element equality predicates. Flexvectors @var{a} and +@var{b} are considered equal by @code{flexvector=?} iff their lengths are +the same and, for each index @var{i} less than @code{(flexvector-length +a)}, @code{(elt=? (flexvector-ref a i) (flexvector-ref b i))} is true. +@var{elt=?} is always applied to two arguments. + + +@example +(flexvector=? eq? (flexvector 'a 'b) (flexvector 'a 'b)) @result{} #t +(flexvector=? eq? (flexvector 'a 'b) (flexvector 'b 'a)) @result{} #f +(flexvector=? = (flexvector 1 2 3 4 5) (flexvector 1 2 3 4)) @result{} #f +(flexvector=? = (flexvector 1 2 3 4) (flexvector 1 2 3 4)) @result{} #t +@end example +@end deffn + +@subsubsection Selectors + +@deffn {Scheme Procedure} flexvector-ref fv i + +Flexvector element dereferencing: returns the value at location @var{i} +in @var{fv}. Indexing is zero-based. It is an error if @var{i} is +outside the range [0, @code{(flexvector-length fv)}). + +@example +(flexvector-ref (flexvector 'a 'b 'c 'd) 2) @result{} c +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-front fv + +Returns the first element in @var{fv}. It is an error if @var{fv} is +empty. Alias for @code{(flexvector-ref fv 0)}. + +@example +(flexvector-front (flexvector 'a 'b 'c 'd)) @result{} a +@end example +@end deffn +@deffn {Scheme Procedure} flexvector-back fv + +Returns the last element in @var{fv}. It is an error if @var{fv} is +empty. Alias for @code{(flexvector-ref fv (- (flexvector-length fv) +1))}. + +@example +(flexvector-back (flexvector 'a 'b 'c 'd)) @result{} d +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-length fv + +Returns the length of @var{fv}, which is the number of elements +contained in @var{fv}. + +@end deffn + +@subsubsection Mutators + +@deffn {Scheme Procedure} flexvector-add! fv i x ... + +Inserts the elements @var{x ...} into @var{fv} at the location @var{i}, +preserving their order and shifting all elements after @var{i} backward +to make room. This increases the length of @var{fv} by the number of +elements inserted. + +It is an error if @var{i} is outside the range [0, +@code{(flexvector-length fv)}]. + +@code{flexvector-add!} returns @var{fv} after mutating it. + +@example +(flexvector-add! (flexvector 'a 'b) 1 'c) @result{} #<flexvector a c b> +(flexvector-add! (flexvector 'a 'b) 2 'c 'd 'e) @result{} #<flexvector a b c d e> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-add-front! fv x ... +@deffnx {Scheme Procedure} flexvector-add-back! fv x ... + +Inserts the elements @var{x ...} into the front or back of @var{fv}, +preserving their order. This increases the length of @var{fv} by the +number of elements inserted. + +@code{flexvector-add-back!} of one element has the same O(1) +computational complexity as @code{vector-set!}, amortized. + +These procedures return @var{fv} after mutating it. + +@example +(flexvector-add-front! (flexvector 'a 'b) 'c) @result{} #<flexvector c a b> +(flexvector-add-front! (flexvector 'a 'b) 'c 'd) @result{} #<flexvector c d a b> + +(flexvector-add-back! (flexvector 'a 'b) 'c) @result{} #<flexvector a b c> +(flexvector-add-back! (flexvector 'a 'b) 'c 'd) @result{} #<flexvector a b c d> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-add-all! fv i xs + +Inserts the elements of the list @code{xs} into @var{fv} at location +@var{i}. Equivalent to @code{(apply flexvector-add! fv i xs)}. Returns +@var{fv} after mutating it. + +@example +(flexvector-add-all! (flexvector 'a 'b) 2 '(c d e)) @result{} #<flexvector a b c d e> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-append! fv1 fv2 ... + +Inserts the elements of the flexvectors @var{fv2 ...} at the end of the +flexvector @var{fv1}, in order. Returns @var{fv1} after mutating it. + +@example +(flexvector-append! (flexvector 'a 'b) (flexvector 'c 'd) (flexvector 'e)) @result{} #<flexvector a b c d e> +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-remove! fv i + +Removes and returns the element at @var{i} in @var{fv}, then +shifts all subsequent elements forward, reducing the length of @var{fv} +by 1. + +It is an error if @var{i} is outside the range [0, +@code{(flexvector-length fv)}). + +@end deffn + +@deffn {Scheme Procedure} flexvector-remove-front! fv +@deffnx {Scheme Procedure} flexvector-remove-back! fv +Removes and returns the first element from @var{fv}, then shifts +all other elements forward. @code{flexvector-remove-back!} instead +removes the last element, without moving any other elements, and has the +same performance guarantees as @code{flexvector-add-back!}. + +It is an error if @var{fv} is empty. + +@end deffn + +@deffn {Scheme Procedure} flexvector-remove-range! fv start [end] + +Removes all elements from @var{fv} between @var{start} and +@var{end}, shifting all elements after @var{end} forward by @code{(- end +start)}. If @var{end} is not present, it defaults to +@code{(flexvector-length fv)}. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(flexvector-length fv)}). It is an error if @var{end} is less than +@var{start}. + +@code{flexvector-remove-range!} returns @var{fv} after mutating +it. + +@end deffn +@deffn {Scheme Procedure} flexvector-clear! fv + +Removes all items from @var{fv}, setting its length to 0. +Returns @var{fv} after mutating it. + +@end deffn + +@deffn {Scheme Procedure} flexvector-set! fv i x + +Assigns the value of @var{x} to the location @var{i} in +@var{fv}. It is an error if @var{i} is outside the range [0, +@code{(flexvector-length fv)}]. If @var{i} is equal to +@code{(flexvector-length fv)}, @var{x} is appended after the last +element in @var{fv}; this is equivalent to @code{flexvector-add-back!}. + +Returns the previous value at location @var{i} in @var{fv}, or +an unspecified value if @var{i} is equal to @code{(flexvector-length +fv)}. + +@code{flexvector-set!} has the same O(1) computational +complexity as @code{vector-set!}. + +@end deffn + +@deffn {Scheme Procedure} flexvector-swap! fv i j + +Swaps or exchanges the values of the locations in @var{fv} at +indexes @var{i} and @var{j}. It is an error if either @var{i} or @var{j} +is outside the range [0, @code{(flexvector-length fv)}). Returns @var{fv} +after mutating it. + +@end deffn +@deffn {Scheme Procedure} flexvector-fill! fv fill [start [end]] + +Assigns the value of every location in @var{fv} between +@var{start}, which defaults to 0 and @var{end}, which defaults to the +length of @var{fv}, to @var{fill}. Returns @var{fv} after mutating it. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(flexvector-length fv)}]. It is an error if @var{end} is less than +@var{start}. + +@end deffn +@deffn {Scheme Procedure} flexvector-reverse! fv + +Destructively reverses @var{fv} in-place. Returns @var{fv} after +mutating it. + +@end deffn + +@deffn {Scheme Procedure} flexvector-copy! to at from [start [end]] +@deffnx {Scheme Procedure} flexvector-reverse-copy! to at from [start [end]] + +Copies the elements of flexvector @var{from} between @var{start} +and @var{end} to flexvector @var{to}, starting at @var{at}. 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. This can +be achieved without allocating storage by making sure to copy in the +correct direction in such circumstances. + +@code{flexvector-reverse-copy!} is the same, but copies elements +in reverse order. + +@var{start} and @var{end} default to 0 and +@code{(flexvector-length from)} if not present. Both @var{start} and +@var{end} are clamped to the range [0, @code{(flexvector-length from)}]. +It is an error if @var{end} is less than @var{start}. + +Unlike @code{vector-copy!}, @code{flexvector-copy!} may copy +elements past the end of @var{to}, which will increase the length of +@var{to}. + +@code{flexvector-copy!} shares the performance characteristics +of @code{vector-copy!}. + +Both procedures return @var{to} after mutating it. + +@end deffn + +@subsubsection Iteration + +@deffn {Scheme Procedure} flexvector-fold kons knil fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-fold-right kons knil fv1 fv2 ... + +The fundamental flexvector iterator. @var{kons} is iterated over each +value in all of the vectors, stopping at the end of the shortest; +@var{kons} is applied as @code{(kons state (flexvector-ref fv1 i) +(flexvector-ref fv2 i) ...)} where @var{state} is the current state +value—the current state value begins with @var{knil}, and becomes +whatever @var{kons} returned on the previous iteration—and @var{i} is +the current index. + +The iteration of @code{flexvector-fold} is strictly +left-to-right. The iteration of @code{flexvector-fold-right} is strictly +right-to-left. + +@example +(flexvector-fold (lambda (len str) (max (string-length str) len)) + 0 + (flexvector "baz" "qux" "quux")) +@result{} 4 + +(flexvector-fold-right (lambda (tail elt) (cons elt tail)) + '() + (flexvector 1 2 3)) +@result{} (1 2 3) + +(flexvector-fold (lambda (counter n) + (if (even? n) (+ counter 1) counter)) + 0 + (flexvector 1 2 3 4 5 6 7)) +@result{} 3 + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-map f fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-map/index f fv1 fv2 ... + +Constructs a new flexvector of the shortest size of the flexvector +arguments. Each element at index @var{i} of the new flexvector is mapped +from the old flexvectors by @code{(f (flexvector-ref fv1 i) +(flexvector-ref fv2 i) ...)}. The dynamic order of application of +@var{f} is unspecified. + + + + +@code{flexvector-map/index} is a variant that passes @var{i} as +the first argument to @var{f} for each element. + + +@example +(flexvector-map (lambda (x) (* x 10)) (flexvector 10 20 30)) +@result{} #<flexvector 100 200 300> + +(flexvector-map/index (lambda (i x) (+ x (* i 2))) (flexvector 10 20 30)) +@result{} #<flexvector 10 22 34> + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-map! f fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-map/index! f fv1 fv2 ... + + +Similar to @code{flexvector-map}, but rather than mapping the new +elements into a new flexvector, the new mapped elements are +destructively inserted into @var{fv1}. Again, the dynamic order of +application of @var{f} is unspecified, so it is dangerous for @var{f} to +apply either @code{flexvector-ref} or @code{flexvector-set!} to @var{fv1} +in @var{f}. + + +@example +(let ((fv (flexvector 10 20 30))) + (flexvector-map! (lambda (x) (* x 10)) fv) + fv) +@result{} #<flexvector 100 200 300> + +(let ((fv (flexvector 10 20 30))) + (flexvector-map/index (lambda (i x) (+ x (* i 2))) fv) + fv) +@result{} #<flexvector 10 22 34> + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-append-map f fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-append-map/index f fv1 fv2 ... + +Constructs a new flexvector by appending the results of each call to +@var{f} on the elements of the flexvectors @var{fv1}, @var{fv2}, etc., +in order. Each call is of the form @code{(f (flexvector-ref fv1 i) +(flexvector-ref fv2 i) ...)}. Iteration stops when the end of the +shortest flexvector argument is reached. The dynamic order of +application of @var{f} is unspecified. + + + + +@var{f} must return a flexvector. It is an error if @var{f} +returns anything else. + + + + +@code{flexvector-append-map/index} is a variant that passes the +index @var{i} as the first argument to @var{f} for each element. + + +@example +(flexvector-append-map (lambda (x) (flexvector (* x 10) (* x 100))) (flexvector 10 20 30)) +@result{} #<flexvector 100 1000 200 2000 300 3000> + +(flexvector-append-map/index (lambda (i x) (flexvector x i)) (flexvector 10 20 30)) +@result{} #<flexvector 10 0 20 1 30 2> +@end example + +@end deffn +@deffn {Scheme Procedure} flexvector-filter pred? fv +@deffnx {Scheme Procedure} flexvector-filter/index pred? fv + +Constructs a new flexvector consisting of only the elements of @var{fv} +for which @var{pred?} returns a non-@var{#f} value. +@code{flexvector-filter/index} passes the index of each element as the +first argument to @var{pred?}, and the element itself as the second +argument. + +@example +(flexvector-filter even? (flexvector 1 2 3 4 5 6 7 8)) +@result{} #<flexvector 2 4 6 8> + +@end example + +@end deffn +@deffn {Scheme Procedure} flexvector-filter! pred? fv +@deffnx {Scheme Procedure} flexvector-filter/index! pred? fv + +Similar to @code{flexvector-filter}, but destructively updates @var{fv} +by removing all elements for which @var{pred?} returns @var{#f}. +@code{flexvector-filter/index!} passes the index of each element as the +first argument to @var{pred?}, and the element itself as the second +argument. + + +@example +(let ((fv (flexvector 1 2 3 4 5 6 7 8))) + (flexvector-filter! odd? fv) + fv) +@result{} #<flexvector 1 3 5 7> + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-for-each f fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-for-each/index f fv1 fv2 ... + +Simple flexvector iterator: applies @var{f} to the corresponding list of +parallel elements from @var{fv1 fv2 ...} in the range [0, @code{length}), +where @code{length} is the length of the smallest flexvector argument +passed. In contrast with @code{flexvector-map}, @var{f} is reliably +applied in left-to-right order, starting at index 0, in the flexvectors. + +@code{flexvector-for-each/index} is a variant that passes the +index as the first argument to @var{f} for each element. + +Example: + +@example +(flexvector-for-each (lambda (x) (display x) (newline)) + f(lexvector "foo" "bar" "baz" "quux" "zot")) + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-count pred? fv1 fv2 ... + +Counts the number of parallel elements in the flexvectors that satisfy +@var{pred?}, which is applied, for each index @var{i} in the range [0, +@emph{length}) where @emph{length} is the length of the smallest +flexvector argument, to each parallel element in the flexvectors, in +order. + + +@example +(flexvector-count even? (flexvector 3 1 4 1 5 9 2 5 6)) +@result{} 3 + +(flexvector-count < (flexvector 1 3 6 9) (flexvector 2 4 6 8 10 12)) +@result{} 2 + +@end example +@end deffn + +@deffn {Scheme Procedure} flexvector-cumulate f knil fv + +Returns a newly-allocated flexvector @var{new} with the same length as +@var{fv}. Each element @var{i} of @var{new} is set to the result of +@code{(f (flexvector-ref new (- i 1)) (flexvector-ref fv i))}, except +that, for the first call on @var{f}, the first argument is @var{knil}. +The @var{new} flexvector is returned. + + +@example +(flexvector-cumulate + 0 (flexvector 3 1 4 1 5 9 2 5 6)) +@result{} #<flexvector 3 4 8 9 14 23 25 30 36> + +@end example +@end deffn + +@subsubsection Searching + +@deffn {Scheme Procedure} flexvector-index pred? fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-index/right pred? fv1 fv2 ... + +Finds and returns the index of the first elements in @var{fv1 fv2 ...} +that satisfy @var{pred?}. If no matching element is found by the end of +the shortest flexvector, @code{#f} is returned. + +@var{flexvector-index-right} is similar, but returns the index +of the @emph{last} elements that satisfy @var{pred?}, and requires all +flexvector arguments to have the same length. + + +Given @emph{n} arguments @var{fv1 fv2...}, @var{pred?} should be +a function that takes @emph{n} arguments and returns a single value, +interpreted as a boolean. + +@example +(flexvector-index even? (flexvector 3 1 4 1 5 9)) +@result{} 2 + +(flexvector-index < (flexvector 3 1 4 1 5 9 2 5 6) (flexvector 2 7 1 8 2)) +@result{} 1 + +(flexvector-index = (flexvector 3 1 4 1 5 9 2 5 6) (flexvector 2 7 1 8 2)) +@result{} #f + +(flexvector-index-right < (flexvector 3 1 4 1 5) (flexvector 2 7 1 8 2)) +@result{} 3 + +@end example +@end deffn + + +@deffn {Scheme Procedure} flexvector-skip pred? fv1 fv2 ... +@deffnx {Scheme Procedure} flexvector-skip-right pred? fv1 fv2 ... + +Finds and returns the index of the first elements in @var{fv1 fv2 ...} +that do @emph{not} satisfy @var{pred?}. If all the values in the +flexvectors satisfy @var{pred?} until the end of the shortest +flexvector, this returns @var{#f}. + +@code{flexvector-skip-right} is similar, but returns the index of +the @emph{last} elements that do not satisfy @var{pred?}, and requires +all flexvector arguments to have the same length. + +Given @emph{n} arguments @var{fv1 fv2...}, @var{pred?} should be +a function that takes @emph{n} arguments and returns a single value, +interpreted as a boolean. + + +@example +(flexvector-skip number? (flexvector 1 2 'a 'b 3 4 'c 'd)) +@result{} 2 + +(flexvector-skip-right number? (flexvector 1 2 'a 'b 3 4 'c 'd)) +@result{} 4 +@end example +@end deffn + + +@deffn {Scheme Procedure} flexvector-binary-search fv value cmp [start [end]] + +Similar to @code{flexvector-index} and @code{flexvector-index-right}, +but, instead of searching left-to-right or right-to-left, this performs +a binary search. If there is more than one element of @var{fv} that +matches @var{value} in the sense of @var{cmp}, +@code{flexvector-binary-search} may return the index of any of them. + +The search is performed on only the indexes of @var{fv} between +@var{start}, which defaults to 0, and @var{end}, which defaults to the +length of @var{fv}. Both @var{start} and @var{end} are clamped to the +range [0, @code{(flexvector-length fv)}]. It is an error if @var{end} is +less than @var{start}. + +@var{cmp} should be a procedure of two arguments that returns +either a negative integer, which indicates that its first argument is +less than its second; zero, which indicates that they are equal; or a +positive integer, which indicates that the first argument is greater +than the second argument. An example @var{cmp} might be: + + +@example +(lambda (char1 char2) + (cond ((char<? char1 char2) -1) + ((char=? char1 char2) 0) + (else 1))) +@end example +@end deffn + + +@deffn {Scheme Procedure} flexvector-any pred? fv1 fv2 ... + +Finds the first set of elements in parallel from @var{fv1 fv2 +...} for which @var{pred?} returns a true value. If such a parallel set +of elements exists, @code{flexvector-any} returns the value that +@var{pred?} returned for that set of elements. The iteration is strictly +left-to-right. + +@end deffn + +@deffn {Scheme Procedure} flexvector-every pred? fv1 fv2 ... + +If, for every index @var{i} between 0 and the length of the +shortest flexvector argument, the set of elements @code{(flexvector-ref +fv1 i) (flexvector-ref fv2 i) ...} satisfies @var{pred?}, +@code{flexvector-every} returns the value that @var{pred?} returned for +the last set of elements, at the last index of the shortest flexvector. +The iteration is strictly left-to-right. + +@end deffn + +@deffn {Scheme Procedure} flexvector-partition pred? fv + +Returns two values: a flexvector containing all elements of +@var{fv} that satisfy @var{pred?}, and a flexvector containing all +elements of @var{fv} that do not satisfy @var{pred?}. Elements remain in +their original order. + +@end deffn + +@subsubsection Conversion + +@deffn {Scheme Procedure} flexvector->vector fv [start [end]] + +Creates a vector containing the elements in @var{fv} between +@var{start}, which defaults to 0, and @var{end}, which defaults to the +length of @var{fv}. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(flexvector-length fv)}). It is an error if @var{end} is less than +@var{start}. + +@end deffn + +@deffn {Scheme Procedure} vector->flexvector vec [start [end]] + +Creates a flexvector containing the elements in @var{vec} +between @var{start}, which defaults to 0, and @var{end}, which defaults +to the length of @var{vec}. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(vector-length vec)}). It is an error if @var{end} is less than +@var{start}. + +@end deffn + + +@deffn {Scheme Procedure} flexvector->list fv [start [end]] +@deffnx {Scheme Procedure} reverse-flexvector->list fv [start [end]] + +Creates a list containing the elements in @var{fv} between +@var{start}, which defaults to 0, and @var{end}, which defaults to the +length of @var{fv}. + +@code{reverse-flexvector->list} is similar, but creates a list +with elements in reverse order of @var{fv}. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(flexvector-length fv)}). It is an error if @var{end} is less than +@var{start}. + + +@end deffn + +@deffn {Scheme Procedure} list->flexvector proper-list + +Creates a flexvector of elements from @var{proper-list}. + +@code{reverse-list->flexvector} is similar, but creates a +flexvector with elements in reverse order of @var{proper-list}. + +@end deffn + +@deffn {Scheme Procedure} flexvector->string fv [start [end]] + +Creates a string containing the elements in @var{fv} between +@var{start}, which defaults to 0, and @var{end}, which defaults to the +length of @var{fv}. It is an error if the elements are not characters. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(flexvector-length fv)}). It is an error if @var{end} is less than +@var{start}. + +@end deffn + +@deffn {Scheme Procedure} string->flexvector string [start [end]] + +Creates a flexvector containing the elements in @var{string} +between @var{start}, which defaults to 0, and @var{end}, which defaults +to the length of @var{string}. + +Both @var{start} and @var{end} are clamped to the range [0, +@code{(string-length string)}). It is an error if @var{end} is less than +@var{start}. + +@end deffn + +@deffn {Scheme Procedure} flexvector->generator fv + +Returns a SRFI 158 generator that emits the elements of the +flexvector @var{fv}, in order. If @var{fv} is mutated before the +generator is exhausted, the generator's remaining return values are +undefined. + +@end deffn + + @node Record Overview @subsection Record Overview diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 8ff42d82a..a93fe1d0e 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -65,6 +65,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-105:: Curly-infix expressions. * SRFI-111:: Boxes. * SRFI-171:: Transducers +* SRFI-214:: Flexvectors @end menu @@ -6141,6 +6142,11 @@ The generator version of list-reduce. It reduces over @code{gen} until it returns the EOF object @end deffn +@node SRFI-214 +@subsection SRFI-214 - Flexvectors + +Documentation for SRFI-214, Flexvectors is provided in @xref{Flexvectors}. + @c srfi-modules.texi ends here @c Local Variables: diff --git a/module/Makefile.am b/module/Makefile.am index f6f5a9bb8..799ef7bd6 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -323,6 +323,7 @@ SOURCES = \ srfi/srfi-171.scm \ srfi/srfi-171/gnu.scm \ srfi/srfi-171/meta.scm \ + srfi/srfi-214.scm \ \ statprof.scm \ \ diff --git a/module/srfi/srfi-214.scm b/module/srfi/srfi-214.scm new file mode 100644 index 000000000..c9d8c9cd3 --- /dev/null +++ b/module/srfi/srfi-214.scm @@ -0,0 +1,735 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) Adam Nelson (2020). +;;; Copyright (C) Vijay Marupudi (2022). +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining a copy of +;;; this software and associated documentation files (the "Software"), to deal in +;;; the Software without restriction, including without limitation the rights to +;;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +;;; the Software, and to permit persons to whom the Software is furnished to do so, +;;; subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice (including the next +;;; paragraph) shall be included in all copies or substantial portions of the +;;; Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +;;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +;;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +;;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +;; Authorship: This code was largely written by Adam Nelson as a +;; sample implementation for srfi-214 and adapted for Guile by Vijay +;; Marupudi. + +(define-module (srfi srfi-214)) + +(use-modules ((scheme base) + #:prefix r7:) + (scheme case-lambda) + (scheme write) + (srfi srfi-1) + (srfi srfi-9) + (srfi srfi-9 gnu) + (srfi srfi-11) + (rnrs io ports)) + + +(export ; Constructors + make-flexvector flexvector + flexvector-unfold flexvector-unfold-right + flexvector-copy flexvector-reverse-copy + flexvector-append flexvector-concatenate flexvector-append-subvectors + <flexvector> + + ; Predicates + flexvector? flexvector-empty? flexvector=? + + ; Selectors + flexvector-ref flexvector-front flexvector-back flexvector-length + + ; Mutators + flexvector-add! flexvector-add-front! flexvector-add-back! + flexvector-remove! flexvector-remove-front! flexvector-remove-back! + flexvector-add-all! flexvector-remove-range! flexvector-clear! + flexvector-set! flexvector-swap! + flexvector-fill! flexvector-reverse! + flexvector-copy! flexvector-reverse-copy! + flexvector-append! + + ; Iteration + flexvector-fold flexvector-fold-right + flexvector-map flexvector-map! flexvector-map/index flexvector-map/index! + flexvector-append-map flexvector-append-map/index + flexvector-filter flexvector-filter! flexvector-filter/index flexvector-filter/index! + flexvector-for-each flexvector-for-each/index + flexvector-count flexvector-cumulate + + ; Searching + flexvector-index flexvector-index-right + flexvector-skip flexvector-skip-right + flexvector-binary-search + flexvector-any flexvector-every flexvector-partition + + ; Conversion + flexvector->vector flexvector->list flexvector->string + vector->flexvector list->flexvector string->flexvector + reverse-flexvector->list reverse-list->flexvector + generator->flexvector flexvector->generator) + + +(define-syntax assume + (syntax-rules () + ((assume expression message ...) + (or expression + (error "invalid assumption" (quote expression) (list message ...)))) + ((assume . _) + (syntax-error "invalid assume syntax")))) + +(define-record-type <flexvector> + (%make-flexvector fv-vector fv-length) + flexvector? + (fv-vector vec set-vec!) + (fv-length flexvector-length set-flexvector-length!)) + +(set-record-type-printer! <flexvector> + (lambda (obj port) + (display "#<flexvector" port) + (if (= (flexvector-length obj) 0) + (display ">" port) + (begin + (format port " ~s" (flexvector-ref obj 0)) + (let loop ((i 1) + (len (flexvector-length obj))) + (if (= len i) + (display ">" port) + (begin + (write (flexvector-ref obj i) port) + (loop (+ i 1) + len)))))))) + +(define (cap fv) + (vector-length (vec fv))) + +(define (grow! fv) + (define old-vec (vec fv)) + (define new-vec (make-vector (quotient (* (vector-length old-vec) 3) 2))) + (r7:vector-copy! new-vec 0 old-vec) + (set-vec! fv new-vec) + new-vec) + +(define make-flexvector + (case-lambda + ((size) + (assume (>= size 0)) + (%make-flexvector (make-vector (max size 4)) size)) + ((size fill) + (assume (>= size 0)) + (%make-flexvector (make-vector (max size 4) fill) size)))) + +(define (flexvector . xs) + (if (null? xs) + (%make-flexvector (make-vector 4) 0) + (list->flexvector xs))) + +(define (flexvector-ref fv index) + (assume (flexvector? fv)) + (assume (integer? index)) + (assume (< -1 index (flexvector-length fv))) + (vector-ref (vec fv) index)) + +(define (flexvector-set! fv index x) + (assume (flexvector? fv)) + (assume (integer? index)) + (assume (< -1 index (flexvector-length fv))) + (let ((last-value (vector-ref (vec fv) index))) + (vector-set! (vec fv) index x) + last-value)) + +(define flexvector-add! + (case-lambda + ((fv i x) + (assume (flexvector? fv)) + (assume (integer? i)) + (let* ((len (flexvector-length fv)) + (v (if (< len (cap fv)) (vec fv) (grow! fv)))) + (assume (<= 0 i len)) + (r7:vector-copy! v (+ i 1) v i len) + (vector-set! v i x) + (set-flexvector-length! fv (+ len 1)) + fv)) + ((fv i . xs) + (flexvector-add-all! fv i xs)))) + +(define flexvector-add-back! + (case-lambda + ((fv x) + (assume (flexvector? fv)) + (let* ((len (flexvector-length fv)) + (v (if (< len (cap fv)) (vec fv) (grow! fv)))) + (vector-set! v len x) + (set-flexvector-length! fv (+ len 1)) + fv)) + ((fv x . xs) + (flexvector-add-back! fv x) + (apply flexvector-add-back! fv xs)))) + +(define (flexvector-add-all! fv i xs) + (assume (flexvector? fv)) + (assume (integer? i)) + (assume (list? xs)) + (let* ((len (flexvector-length fv)) + (xv (list->vector xs)) + (xvlen (vector-length xv)) + (v (let lp ((v (vec fv))) + (if (< (+ len xvlen) (vector-length v)) v (lp (grow! fv)))))) + (assume (<= 0 i len)) + (r7:vector-copy! v (+ i xvlen) v i len) + (r7:vector-copy! v i xv 0 xvlen) + (set-flexvector-length! fv (+ len xvlen)) + fv)) + +(define (flexvector-remove! fv i) + (assume (flexvector? fv)) + (assume (integer? i)) + (assume (<= 0 i (- (flexvector-length fv) 1))) + (let ((removed (flexvector-ref fv i))) + (flexvector-remove-range! fv i (+ i 1)) + removed)) + +(define (flexvector-remove-range! fv start end) + (assume (flexvector? fv)) + (let ((len (flexvector-length fv))) + (when (< start 0) (set! start 0)) + (when (>= end len) (set! end len)) + (assume (<= start end)) + (r7:vector-copy! (vec fv) start (vec fv) end) + (let ((new-len (- len (- end start)))) + (vector-fill! (vec fv) #f new-len len) + (set-flexvector-length! fv new-len))) + fv) + +(define (flexvector-clear! fv) + (assume (flexvector? fv)) + (set-vec! fv (make-vector 4)) + (set-flexvector-length! fv 0) + fv) + +(define vector->flexvector + (case-lambda + ((vec) + (assume (vector? vec)) + (vector->flexvector vec 0 (vector-length vec))) + ((vec start) + (assume (vector? vec)) + (vector->flexvector vec start (vector-length vec))) + ((vec start end) + (assume (vector? vec)) + (assume (<= 0 start end (vector-length vec))) + (let ((len (- end start))) + (cond + ((< len 4) + (let ((new-vec (make-vector 4))) + (r7:vector-copy! new-vec 0 vec start end) + (%make-flexvector new-vec len))) + (else + (%make-flexvector (r7:vector-copy vec start end) len))))))) + +(define flexvector->vector + (case-lambda + ((fv) + (assume (flexvector? fv)) + (flexvector->vector fv 0 (flexvector-length fv))) + ((fv start) + (assume (flexvector? fv)) + (flexvector->vector fv start (flexvector-length fv))) + ((fv start end) + (assume (flexvector? fv)) + (assume (<= 0 start end (flexvector-length fv))) + (r7:vector-copy (vec fv) start end)))) + +(define (list->flexvector xs) + (let* ((vec (list->vector xs)) + (len (vector-length vec))) + (cond + ((< len 4) + (let ((new-vec (make-vector 4))) + (r7:vector-copy! new-vec 0 vec) + (%make-flexvector new-vec len))) + (else + (%make-flexvector vec len))))) + +(define flexvector-filter/index! + (case-lambda + ((pred? fv) + (assume (flexvector? fv)) + (let ((v (vec fv)) (len (flexvector-length fv))) + (let lp ((i 0) (j 0)) + (cond + ((>= i len) + (set-flexvector-length! fv j) + fv) + ((pred? i (vector-ref v i)) + (unless (= i j) (vector-set! v j (vector-ref v i))) + (lp (+ i 1) (+ j 1))) + (else + (lp (+ i 1) j)))))) + ((pred? fv . fvs) + (assume (flexvector? fv)) + (let ((v (vec fv)) (len (flexvector-length fv))) + (let lp ((i 0) (j 0)) + (cond + ((>= i len) + (set-flexvector-length! fv j) + fv) + ((apply pred? + i + (vector-ref v i) + (r7:map (lambda (fv) (flexvector-ref fv i)) fvs)) + (unless (= i j) (vector-set! v j (vector-ref v i))) + (lp (+ i 1) (+ j 1))) + (else + (lp (+ i 1) j)))))))) + +(define flexvector-copy + (case-lambda + ((fv) + (assume (flexvector? fv)) + (%make-flexvector (r7:vector-copy (vec fv)) + (flexvector-length fv))) + ((fv start) + (assume (flexvector? fv)) + (flexvector-copy fv start (flexvector-length fv))) + ((fv start end) + (assume (flexvector? fv)) + (assume (<= 0 start end (flexvector-length fv))) + (vector->flexvector (r7:vector-copy (vec fv) start end))))) + +(define flexvector-copy! + (case-lambda + ((to at from) + (assume (flexvector? from)) + (flexvector-copy! to at from 0 (flexvector-length from))) + ((to at from start) + (assume (flexvector? from)) + (flexvector-copy! to at from start (flexvector-length from))) + ((to at from start end) + (assume (flexvector? to)) + (assume (<= 0 at (flexvector-length to))) + (assume (<= 0 start end (flexvector-length from))) + (let* ((vf (vec from)) + (lt (+ (flexvector-length to) (- end start))) + (vt (let lp ((v (vec to))) + (if (< lt (vector-length v)) v (lp (grow! to)))))) + (r7:vector-copy! vt at vf start end) + (set-flexvector-length! to + (max (flexvector-length to) (+ at (- end start)))))))) + +(define flexvector-unfold + (case-lambda + ((p f g seed) + (define fv (flexvector)) + (assume (procedure? p)) + (assume (procedure? f)) + (assume (procedure? g)) + (do ((seed seed (g seed))) ((p seed) fv) + (flexvector-add-back! fv (f seed)))) + ((p f g . seeds) + (define fv (flexvector)) + (assume (procedure? p)) + (assume (procedure? f)) + (assume (procedure? g)) + (do ((seeds seeds (let-values ((seeds (apply g seeds))) seeds))) + ((apply p seeds) fv) + (flexvector-add-back! fv (apply f seeds)))))) + +(define (flexvector-unfold-right . args) + (define fv (apply flexvector-unfold args)) + (flexvector-reverse! fv) + fv) + +(define flexvector-fill! + (case-lambda + ((fv fill) + (flexvector-fill! fv fill 0 (flexvector-length fv))) + ((fv fill start) + (flexvector-fill! fv fill start (flexvector-length fv))) + ((fv fill start end) + (let ((actual-end (min end (flexvector-length fv)))) + (do ((i (max 0 start) (+ i 1))) + ((>= i actual-end)) + (flexvector-set! fv i fill)))))) + +(define (flexvector-reverse-copy . args) + (define fv (apply flexvector-copy args)) + (flexvector-reverse! fv) + fv) + +(define flexvector-reverse-copy! + (case-lambda + ((to at from) + (assume (flexvector? from)) + (flexvector-reverse-copy! to at from 0 (flexvector-length from))) + ((to at from start) + (assume (flexvector? from)) + (flexvector-reverse-copy! to at from start (flexvector-length from))) + ((to at from start end) + (flexvector-copy! to at from start end) + (flexvector-reverse! to at (+ at (- end start)))))) + +(define (flexvector-append! fv . fvs) + (assume (flexvector? fv)) + (assume (every flexvector? fvs)) + (for-each + (lambda (fv2) (flexvector-copy! fv (flexvector-length fv) fv2)) + fvs) + fv) + +(define (flexvector-front fv) + (assume (flexvector? fv)) + (assume (not (flexvector-empty? fv))) + (flexvector-ref fv 0)) + +(define (flexvector-back fv) + (assume (flexvector? fv)) + (assume (not (flexvector-empty? fv))) + (flexvector-ref fv (- (flexvector-length fv) 1))) + +(define flexvector-add-front! + (case-lambda + ((fv x) (flexvector-add! fv 0 x)) + ((fv . xs) (apply flexvector-add! fv 0 xs)))) + +(define (flexvector-remove-front! fv) + (assume (flexvector? fv)) + (assume (not (flexvector-empty? fv))) + (flexvector-remove! fv 0)) + +(define (flexvector-remove-back! fv) + (assume (flexvector? fv)) + (assume (not (flexvector-empty? fv))) + (flexvector-remove! fv (- (flexvector-length fv) 1))) + +(define (flexvector=? eq . o) + (cond + ((null? o) #t) + ((null? (cdr o)) #t) + (else + (and (let* ((fv1 (car o)) + (fv2 (cadr o)) + (len (flexvector-length fv1))) + (and (= len (flexvector-length fv2)) + (let lp ((i 0)) + (or (>= i len) + (and (eq (flexvector-ref fv1 i) (flexvector-ref fv2 i)) + (lp (+ i 1))))))) + (apply flexvector=? eq (cdr o)))))) + +(define (flexvector-fold kons knil fv1 . o) + (assume (procedure? kons)) + (assume (flexvector? fv1)) + (let ((len (flexvector-length fv1))) + (if (null? o) + (let lp ((i 0) (acc knil)) + (if (>= i len) acc (lp (+ i 1) (kons acc (flexvector-ref fv1 i))))) + (let lp ((i 0) (acc knil)) + (if (>= i len) + acc + (lp (+ i 1) + (apply kons acc (flexvector-ref fv1 i) + (r7:map (lambda (fv) (flexvector-ref fv i)) o)))))))) + +(define (flexvector-fold-right kons knil fv1 . o) + (assume (procedure? kons)) + (assume (flexvector? fv1)) + (let ((len (flexvector-length fv1))) + (if (null? o) + (let lp ((i (- len 1)) (acc knil)) + (if (negative? i) acc (lp (- i 1) (kons acc (flexvector-ref fv1 i))))) + (let lp ((i (- len 1)) (acc knil)) + (if (negative? i) + acc + (lp (- i 1) + (apply kons acc (flexvector-ref fv1 i) + (r7:map (lambda (fv) (flexvector-ref fv i)) o)))))))) + +(define flexvector-for-each/index + (case-lambda + ((proc fv) + (assume (procedure? proc)) + (assume (flexvector? fv)) + (let ((len (flexvector-length fv))) + (do ((i 0 (+ i 1))) ((= i len)) + (proc i (flexvector-ref fv i))))) + ((proc . fvs) + (assume (procedure? proc)) + (let ((len (apply min (r7:map flexvector-length fvs)))) + (do ((i 0 (+ i 1))) ((= i len)) + (apply proc i (r7:map (lambda (fv) (flexvector-ref fv i)) fvs))))))) + +(define flexvector-for-each + (case-lambda + ((proc fv) + (assume (procedure? proc)) + (flexvector-for-each/index (lambda (i x) (proc x)) fv)) + ((proc . fvs) + (assume (procedure? proc)) + (apply flexvector-for-each/index (lambda (i . xs) (apply proc xs)) fvs)))) + +(define flexvector-map/index! + (case-lambda + ((proc fv) + (assume (procedure? proc)) + (assume (flexvector? fv)) + (flexvector-for-each/index + (lambda (i x) (flexvector-set! fv i (proc i x))) + fv) + fv) + ((proc fv . fvs) + (assume (procedure? proc)) + (assume (flexvector? fv)) + (apply flexvector-for-each/index + (lambda (i . xs) (flexvector-set! fv i (apply proc i xs))) + fv + fvs) + fv))) + +(define flexvector-map! + (case-lambda + ((proc fv) + (assume (procedure? proc)) + (flexvector-map/index! (lambda (i x) (proc x)) fv)) + ((proc . fvs) + (assume (procedure? proc)) + (apply flexvector-map/index! (lambda (i . xs) (apply proc xs)) fvs)))) + +(define (flexvector-map/index proc fv . fvs) + (assume (flexvector? fv)) + (apply flexvector-map/index! proc (flexvector-copy fv) fvs)) + +(define (flexvector-map proc fv . fvs) + (assume (flexvector? fv)) + (apply flexvector-map! proc (flexvector-copy fv) fvs)) + +(define (flexvector-append-map/index proc fv . fvs) + (define out (flexvector)) + (flexvector-for-each + (lambda (x) (flexvector-append! out x)) + (apply flexvector-map/index proc fv fvs)) + out) + +(define (flexvector-append-map proc fv . fvs) + (define out (flexvector)) + (flexvector-for-each + (lambda (x) (flexvector-append! out x)) + (apply flexvector-map proc fv fvs)) + out) + +(define flexvector-filter! + (case-lambda + ((pred? fv) + (assume (procedure? pred?)) + (assume (flexvector? fv)) + (flexvector-filter/index! (lambda (i x) (pred? x)) fv)) + ((pred? . fvs) + (assume (procedure? pred?)) + (apply flexvector-filter/index! (lambda (i . xs) (apply pred? xs)) fvs)))) + +(define (flexvector-filter/index proc fv . fvs) + (assume (flexvector? fv)) + (apply flexvector-filter/index! proc (flexvector-copy fv) fvs)) + +(define (flexvector-filter proc fv . fvs) + (assume (flexvector? fv)) + (apply flexvector-filter! proc (flexvector-copy fv) fvs)) + +(define (flexvector-index pred? fv1 . o) + (assume (procedure? pred?)) + (assume (flexvector? fv1)) + (let ((len (flexvector-length fv1))) + (let lp ((i 0)) + (and (< i len) + (if (apply pred? + (flexvector-ref fv1 i) + (r7:map (lambda (fv) (flexvector-ref fv i)) o)) + i + (lp (+ i 1))))))) + +(define (flexvector-index-right pred? fv1 . o) + (assume (procedure? pred?)) + (assume (flexvector? fv1)) + (let ((len (flexvector-length fv1))) + (let lp ((i (- len 1))) + (and (>= i 0) + (if (apply pred? + (flexvector-ref fv1 i) + (r7:map (lambda (fv) (flexvector-ref fv i)) o)) + i + (lp (- i 1))))))) + +(define (complement f) + (lambda args (not (apply f args)))) + +(define (flexvector-skip pred? fv1 . o) + (assume (procedure? pred?)) + (assume (flexvector? fv1)) + (apply flexvector-index (complement pred?) fv1 o)) + +(define (flexvector-skip-right pred? fv1 . o) + (assume (procedure? pred?)) + (assume (flexvector? fv1)) + (apply flexvector-index-right (complement pred?) fv1 o)) + +(define flexvector-binary-search + (case-lambda + ((fv value cmp) + (flexvector-binary-search fv value cmp 0 (flexvector-length fv))) + ((fv value cmp start) + (flexvector-binary-search fv value cmp start (flexvector-length fv))) + ((fv value cmp start end) + (assume (flexvector? fv)) + (assume (procedure? cmp)) + (assume (integer? start)) + (assume (integer? end)) + (assume (<= start end)) + (let lp ((lo (max start 0)) + (hi (- (min end (flexvector-length fv)) 1))) + (and (<= lo hi) + (let* ((mid (quotient (+ lo hi) 2)) + (x (flexvector-ref fv mid)) + (y (cmp value x))) + (cond + ((< y 0) (lp lo (- mid 1))) + ((> y 0) (lp (+ mid 1) hi)) + (else mid)))))))) + +(define (flexvector-any pred? fv . o) + (assume (procedure? pred?)) + (assume (flexvector? fv)) + (let ((len (apply min (flexvector-length fv) (r7:map flexvector-length o)))) + (let lp ((i 0)) + (and (< i len) + (or (apply pred? + (flexvector-ref fv i) + (r7:map (lambda (v) (flexvector-ref v i)) o)) + (lp (+ i 1))))))) + +(define (flexvector-every pred? fv . o) + (assume (procedure? pred?)) + (assume (flexvector? fv)) + (let ((len (apply min (flexvector-length fv) (r7:map flexvector-length o)))) + (or (zero? len) + (let lp ((i 0)) + (let ((x (apply pred? + (flexvector-ref fv i) + (r7:map (lambda (v) (flexvector-ref v i)) o)))) + (if (= i (- len 1)) + x + (and x (lp (+ i 1))))))))) + +(define (flexvector-swap! fv i j) + (assume (flexvector? fv)) + (assume (integer? i)) + (assume (integer? j)) + (let ((tmp (flexvector-ref fv i))) + (flexvector-set! fv i (flexvector-ref fv j)) + (flexvector-set! fv j tmp))) + +(define (flexvector-reverse! fv . o) + (assume (flexvector? fv)) + (let lp ((left (if (pair? o) (car o) 0)) + (right (- (if (and (pair? o) (pair? (cdr o))) + (cadr o) + (flexvector-length fv)) + 1))) + (cond + ((>= left right) (if #f #f)) + (else + (flexvector-swap! fv left right) + (lp (+ left 1) (- right 1)))))) + +(define (flexvector-append fv . fvs) + (assume (flexvector? fv)) + (apply flexvector-append! (flexvector-copy fv) fvs)) + +(define (flexvector-concatenate ls) + (apply flexvector-append ls)) + +(define (flexvector-append-subvectors . o) + (let lp ((ls o) (vecs '())) + (if (null? ls) + (flexvector-concatenate (reverse vecs)) + (lp (cdr (cddr ls)) + (cons (flexvector-copy (car ls) (cadr ls) (car (cddr ls))) vecs))))) + +(define (flexvector-empty? fv) + (assume (flexvector? fv)) + (zero? (flexvector-length fv))) + +(define (flexvector-count pred? fv1 . o) + (assume (procedure? pred?)) + (assume (flexvector? fv1)) + (apply flexvector-fold + (lambda (count . x) (+ count (if (apply pred? x) 1 0))) + 0 + fv1 o)) + +(define (flexvector-cumulate f knil fv) + (assume (procedure? f)) + (assume (flexvector? fv)) + (let* ((len (flexvector-length fv)) + (res (make-vector len))) + (let lp ((i 0) (acc knil)) + (if (>= i len) + (vector->flexvector res) + (let ((acc (f acc (flexvector-ref fv i)))) + (vector-set! res i acc) + (lp (+ i 1) acc)))))) + +(define (flexvector-partition pred? fv) + (assume (procedure? pred?)) + (assume (flexvector? fv)) + (let ((left (flexvector)) (right (flexvector))) + (flexvector-for-each + (lambda (x) (flexvector-add-back! (if (pred? x) left right) x)) + fv) + (values left right))) + +(define (flexvector->list fv) + (assume (flexvector? fv)) + (flexvector-fold-right (lambda (x y) (cons y x)) '() fv)) + +(define (reverse-flexvector->list fv . o) + (assume (flexvector? fv)) + (flexvector->list (apply flexvector-reverse-copy fv o))) + +(define (reverse-list->flexvector ls) + (assume (list? ls)) + (let ((fv (list->flexvector ls))) + (flexvector-reverse! fv) + fv)) + +(define (string->flexvector s . o) + (assume (string? s)) + (vector->flexvector (apply r7:string->vector s o))) + +(define (flexvector->string fv . o) + (assume (flexvector? fv)) + (r7:vector->string (apply flexvector->vector fv o))) + +(define (generator->flexvector g) + (assume (procedure? g)) + (flexvector-unfold eof-object? (lambda (x) x) (lambda (_) (g)) (g))) + +(define (flexvector->generator fv) + (assume (flexvector? fv)) + (let ((i 0)) + (lambda () + (if (< i (flexvector-length fv)) + (let ((element (flexvector-ref fv i))) + (set! i (+ i 1)) + element) + (eof-object))))) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 16fa2e952..a62ffcf6c 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -162,6 +162,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/srfi-105.test \ tests/srfi-111.test \ tests/srfi-171.test \ + tests/srfi-214.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/statprof.test \ diff --git a/test-suite/tests/srfi-214.test b/test-suite/tests/srfi-214.test new file mode 100644 index 000000000..dacec8fa8 --- /dev/null +++ b/test-suite/tests/srfi-214.test @@ -0,0 +1,437 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 2020 Adam Nelson. +;;; Copyright (C) 2022 Vijay Marupudi. +;;; +;;; This code is based on the file tests.scm in the reference +;;; implementation of SRFI-214, provided under the following license: +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the +;;; "Software"), to deal in the Software without restriction, including +;;; without limitation the rights to use, copy, modify, merge, publish, +;;; distribute, sublicense, and/or sell copies of the Software, and to +;;; permit persons to whom the Software is furnished to do so, subject to +;;; the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;;; SOFTWARE. + +(define-module (test-suite test-srfi-214) + #:use-module (srfi srfi-214) + #:use-module (test-suite lib) + #:use-module (rnrs io ports)) + +(with-test-prefix "SRFI-214" + + (pass-if "flexvector?" + (equal? #t (flexvector? (flexvector)))) + (pass-if "flexvector-length" + (equal? 3 (flexvector-length (make-flexvector 3 #f)))) + (pass-if "flexvector" + (equal? 3 (flexvector-length (flexvector 1 2 3)))) + + (let ((fv (flexvector 'a 'b 'c))) + (pass-if "flexvector-ref" + (equal? 'b (flexvector-ref fv 1))) + (pass-if "flexvector-front" + (equal? 'a (flexvector-front fv))) + (pass-if "flexvector-back" + (equal? 'c (flexvector-back fv))) + (pass-if "flexvector-set! return" + (equal? 'b (flexvector-set! fv 1 'd))) + (pass-if "flexvector-set! mutate" + (equal? 'd (flexvector-ref fv 1))) + (pass-if "flexvector-add-back! return" + (equal? fv (flexvector-add-back! fv 'e))) + (pass-if "flexvector-add-back! mutate" + (equal? '(4 . e) + (cons (flexvector-length fv) + (flexvector-ref fv (- (flexvector-length fv) 1))))) + (pass-if "flexvector-remove! return" + (equal? 'd (flexvector-remove! fv 1))) + (pass-if "flexvector-remove! mutate" + (equal? '(3 . c) + (cons (flexvector-length fv) + (flexvector-ref fv 1)))) + (pass-if "flexvector-clear! return" + (equal? fv (flexvector-clear! fv))) + (pass-if "flexvector-clear! mutate" + (equal? 0 (flexvector-length fv))) + (pass-if "flexvector-empty?" + (equal? #t (flexvector-empty? fv)))) + + (pass-if "flexvector=? same symbols" + (equal? #t + (flexvector=? eq? (flexvector 'a 'b) (flexvector 'a 'b)))) + (pass-if "flexvector=? different symbols" + (equal? #f + (flexvector=? eq? (flexvector 'a 'b) (flexvector 'b 'a)))) + (pass-if "flexvector=? different lengths" + (equal? #f + (flexvector=? = (flexvector 1 2 3 4 5) (flexvector 1 2 3 4)))) + (pass-if "flexvector=? same numbers" + (equal? #t + (flexvector=? = (flexvector 1 2 3 4) (flexvector 1 2 3 4)))) + (pass-if "flexvector=? 0 arguments" + (equal? #t + (flexvector=? eq?))) + (pass-if "flexvector=? 1 argument" + (equal? #t + (flexvector=? eq? (flexvector 'a)))) + + (pass-if "make-flexvector" + (equal? #(a a a) (flexvector->vector (make-flexvector 3 'a)))) + + (pass-if "flexvector-unfold" + (equal? + #(1 4 9 16 25 36 49 64 81 100) + (flexvector->vector + (flexvector-unfold (lambda (x) (> x 10)) + (lambda (x) (* x x)) + (lambda (x) (+ x 1)) + 1)))) + (pass-if "flexvector-unfold-right" + (equal? + #(100 81 64 49 36 25 16 9 4 1) + (flexvector->vector + (flexvector-unfold-right (lambda (x) (> x 10)) + (lambda (x) (* x x)) + (lambda (x) (+ x 1)) + 1)))) + + + (pass-if "string->flexvector" + (equal? #(#\a #\b #\c) + (flexvector->vector (string->flexvector "abc")))) + (pass-if "flexvector->string" + (equal? "abc" (flexvector->string (flexvector #\a #\b #\c)))) + + (define genlist '(a b c)) + (define (mock-generator) + (if (pair? genlist) + (let ((value (car genlist))) + (set! genlist (cdr genlist)) + value) + (eof-object))) + + (pass-if "generator->flexvector" + (equal? #(a b c) + (flexvector->vector (generator->flexvector mock-generator)))) + (pass-if "flexvector->generator" + (equal? '(a b c #t) + (let* ((gen (flexvector->generator (flexvector 'a 'b 'c))) + (one (gen)) + (two (gen)) + (three (gen)) + (four (eof-object? (gen)))) + (list one two three four)))) + + ; Nondestructive operations on one vector + (let ((fv (flexvector 10 20 30))) + (pass-if "flexvector->vector" + (equal? #(10 20 30) (flexvector->vector fv))) + (pass-if "flexvector->list" + (equal? '(10 20 30) (flexvector->list fv))) + (pass-if "reverse-flexvector->list" + (equal? '(30 20 10) (reverse-flexvector->list fv))) + (pass-if "flexvector-copy" + (equal? #t + (let ((copy (flexvector-copy fv))) + (and (= (flexvector-length fv) (flexvector-length copy)) + (not (eq? fv copy)))))) + (pass-if "flexvector-reverse-copy" + (equal? #(30 20 10) + (flexvector->vector (flexvector-reverse-copy fv)))) + (pass-if "flexvector-copy start" + (equal? #(20 30) + (flexvector->vector (flexvector-copy fv 1)))) + (pass-if "flexvector-copy start end" + (equal? #(20) + (flexvector->vector (flexvector-copy fv 1 2)))) + (pass-if "flexvector-for-each" + (equal? '(30 20 10) + (let ((res '())) + (flexvector-for-each (lambda (x) (set! res (cons x res))) fv) + res))) + (pass-if "flexvector-for-each/index" + (equal? '(34 22 10) + (let ((res '())) + (flexvector-for-each/index + (lambda (i x) (set! res (cons (+ x (* i 2)) res))) + fv) + res))) + (pass-if "flexvector-map" + (equal? #(100 200 300) + (flexvector->vector (flexvector-map (lambda (x) (* x 10)) fv)))) + (pass-if "flexvector-map/index" + (equal? #(10 22 34) + (flexvector->vector (flexvector-map/index (lambda (i x) (+ x (* i 2))) fv)))) + (pass-if "flexvector-append-map" + (equal? #(10 100 20 200 30 300) + (flexvector->vector + (flexvector-append-map (lambda (x) (flexvector x (* x 10))) fv)))) + (pass-if "flexvector-append-map/index" + (equal? #(0 10 10 1 20 22 2 30 34) + (flexvector->vector + (flexvector-append-map/index + (lambda (i x) (flexvector i x (+ x (* i 2)))) + fv)))) + (pass-if "flexvector-filter" + (equal? #(10) + (flexvector->vector (flexvector-filter (lambda (x) (< x 15)) fv)))) + (pass-if "flexvector-filter/index" + (equal? #(10 30) + (flexvector->vector (flexvector-filter/index (lambda (i x) (not (= i 1))) fv)))) + (pass-if "flexvector-fold" + (equal? '(30 20 10) + (flexvector-fold (lambda (x y) (cons y x)) '() fv))) + (pass-if "flexvector-fold-right" + (equal? '(10 20 30) + (flexvector-fold-right (lambda (x y) (cons y x)) '() fv))) + (pass-if "flexvector-count" + (equal? 2 + (flexvector-count (lambda (x) (< x 25)) fv))) + (pass-if "flexvector-cumulate" + (equal? #(3 4 8 9 14 23 25 30 36) + (flexvector->vector + (flexvector-cumulate + 0 (flexvector 3 1 4 1 5 9 2 5 6))))) + (pass-if "flexvector-any" + (equal? '(#t . #f) + (cons (flexvector-any (lambda (x) (= x 20)) fv) + (flexvector-any (lambda (x) (= x 21)) fv)))) + (pass-if "flexvector-every" + (equal? '(#t . #f) + (cons (flexvector-every (lambda (x) (< x 40)) fv) + (flexvector-every (lambda (x) (< x 30)) fv)))) + (pass-if "flexvector-index" + (equal? 1 + (flexvector-index (lambda (x) (> x 10)) fv))) + (pass-if "flexvector-index-right" + (equal? 2 + (flexvector-index-right (lambda (x) (> x 10)) fv))) + (pass-if "flexvector-skip" + (equal? 1 + (flexvector-skip (lambda (x) (< x 20)) fv))) + (pass-if "flexvector-skip-right" + (equal? 0 + (flexvector-skip-right (lambda (x) (> x 10)) fv))) + (pass-if "flexvector-partition" + (equal? '(#(10 20) #(30)) + (call-with-values + (lambda () (flexvector-partition (lambda (x) (< x 25)) fv)) + (lambda vs ((@ (scheme base) map) flexvector->vector vs)))))) + + (let ((fv (flexvector #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j)) + (cmp (lambda (char1 char2) + (cond ((char<? char1 char2) -1) + ((char=? char1 char2) 0) + (else 1))))) + (pass-if "flexvector-binary-search" + (equal? 3 + (flexvector-binary-search fv #\d cmp))) + (pass-if "flexvector-binary-search first" + (equal? 0 + (flexvector-binary-search fv #\a cmp))) + (pass-if "flexvector-binary-search last" + (equal? 9 + (flexvector-binary-search fv #\j cmp))) + (pass-if "flexvector-binary-search not found" + (equal? #f + (flexvector-binary-search fv #\k cmp))) + + (pass-if "flexvector-binary-search in range" + (equal? 5 + (flexvector-binary-search fv #\f cmp 2 6))) + (pass-if "flexvector-binary-search out of range" + (equal? #f + (flexvector-binary-search fv #\f cmp 1 5)))) + + ; Nondestructive operations on multiple vectors + (pass-if "flexvector-append" + (equal? #(10 20 30 40 50 60) + (flexvector->vector + (flexvector-append (flexvector 10 20) + (flexvector) + (flexvector 30 40) + (flexvector 50 60))))) + (pass-if "flexvector-concatenate" + (equal? #(10 20 30 40 50 60) + (flexvector->vector + (flexvector-concatenate + (list (flexvector 10 20) + (flexvector) + (flexvector 30 40) + (flexvector 50 60)))))) + (pass-if "flexvector-append-subvectors" + (equal? #(a b h i) + (flexvector->vector + (flexvector-append-subvectors + (flexvector 'a 'b 'c 'd 'e) 0 2 + (flexvector 'f 'g 'h 'i 'j) 2 4)))) + + + ; Destructive operations on one vector + (define-syntax mutate-as + (syntax-rules () + ((_ name vec expr) + (let ((name (vector->flexvector vec))) + expr + (flexvector->vector name))))) + + (pass-if "flexvector-add! empty" + (equal? '#(foo) + (mutate-as x '#() (flexvector-add! x 0 'foo)))) + (pass-if "flexvector-add! empty multiple" + (equal? '#(foo bar baz) + (mutate-as x '#() (flexvector-add! x 0 'foo 'bar 'baz)))) + (pass-if "flexvector-add! start" + (equal? '#(foo bar baz) + (mutate-as x '#(bar baz) (flexvector-add! x 0 'foo)))) + (pass-if "flexvector-add! start multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(qux quux) (flexvector-add! x 0 'foo 'bar 'baz)))) + (pass-if "flexvector-add! middle" + (equal? '#(foo bar baz) + (mutate-as x '#(foo baz) (flexvector-add! x 1 'bar)))) + (pass-if "flexvector-add! middle multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(foo quux) (flexvector-add! x 1 'bar 'baz 'qux)))) + (pass-if "flexvector-add! end" + (equal? '#(foo bar baz) + (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz)))) + (pass-if "flexvector-add! end multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz 'qux 'quux)))) + + (pass-if "flexvector-add-all!" + (equal? '#(foo bar baz qux) + (mutate-as x '#(foo qux) (flexvector-add-all! x 1 '(bar baz))))) + + (pass-if "flexvector-add-front! empty" + (equal? '#(foo) + (mutate-as x '#() (flexvector-add-front! x 'foo)))) + (pass-if "flexvector-add-front! empty multiple" + (equal? '#(foo bar baz) + (mutate-as x '#() (flexvector-add-front! x 'foo 'bar 'baz)))) + (pass-if "flexvector-add-front!" + (equal? '#(foo bar baz) + (mutate-as x '#(bar baz) (flexvector-add-front! x 'foo)))) + (pass-if "flexvector-add-front! multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(qux quux) (flexvector-add-front! x 'foo 'bar 'baz)))) + + (pass-if "flexvector-add-back! empty" + (equal? '#(foo) + (mutate-as x '#() (flexvector-add-back! x 'foo)))) + (pass-if "flexvector-add-back! empty multiple" + (equal? '#(foo bar baz) + (mutate-as x '#() (flexvector-add-back! x 'foo 'bar 'baz)))) + (pass-if "flexvector-add-back!" + (equal? '#(foo bar baz) + (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz)))) + (pass-if "flexvector-add-back! multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz 'qux 'quux)))) + + (pass-if "flexvector-append!" + (equal? '#(foo bar baz qux) + (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux))))) + (pass-if "flexvector-append! multiple" + (equal? '#(foo bar baz qux quux) + (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux) (flexvector 'quux))))) + + (pass-if "flexvector-remove!" + (equal? '#(foo baz) + (mutate-as x '#(foo bar baz) (flexvector-remove! x 1)))) + (pass-if "flexvector-remove! only" + (equal? '#() + (mutate-as x '#(foo) (flexvector-remove! x 0)))) + + (pass-if "flexvector-remove-front!" + (equal? '#(bar baz) + (mutate-as x '#(foo bar baz) (flexvector-remove-front! x)))) + (pass-if "flexvector-remove-front! only" + (equal? '#() + (mutate-as x '#(foo) (flexvector-remove-front! x)))) + + (pass-if "flexvector-remove-back!" + (equal? '#(foo bar) + (mutate-as x '#(foo bar baz) (flexvector-remove-back! x)))) + (pass-if "flexvector-remove-back! only" + (equal? '#() + (mutate-as x '#(foo) (flexvector-remove-back! x)))) + + (pass-if "flexvector-remove-range!" + (equal? '#(a e f) + (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 4)))) + (pass-if "flexvector-remove-range! empty range" + (equal? '#(a b c d e f) + (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 1)))) + (pass-if "flexvector-remove-range! overflow left" + (equal? '#(e f) + (mutate-as x '#(a b c d e f) (flexvector-remove-range! x -1 4)))) + (pass-if "flexvector-remove-range! overflow right" + (equal? '#(a b) + (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 2 10)))) + + (pass-if "flexvector-map!" + (equal? '#(100 200 300) + (mutate-as fv '#(10 20 30) (flexvector-map! (lambda (x) (* x 10)) fv)))) + (pass-if "flexvector-map/index!" + (equal? '#(10 22 34) + (mutate-as fv '#(10 20 30) (flexvector-map/index! (lambda (i x) (+ x (* i 2))) fv)))) + (pass-if "flexvector-filter!" + (equal? '#(10) + (mutate-as fv '#(10 20 30) (flexvector-filter! (lambda (x) (< x 15)) fv)))) + (pass-if "flexvector-filter/index!" + (equal? '#(10 30) + (mutate-as fv '#(10 20 30) (flexvector-filter/index! (lambda (i x) (not (= i 1))) fv)))) + + (pass-if "flexvector-swap!" + (equal? #(10 30 20) + (mutate-as fv '#(10 20 30) (flexvector-swap! fv 1 2)))) + (pass-if "flexvector-reverse!" + (equal? #(30 20 10) + (mutate-as fv '#(10 20 30) (flexvector-reverse! fv)))) + + (pass-if "flexvector-copy!" + (equal? #(1 20 30 40 5) + (mutate-as fv '#(1 2 3 4 5) (flexvector-copy! fv 1 (flexvector 20 30 40))))) + (pass-if "flexvector-copy! bounded" + (equal? #(1 20 30 40 5) + (mutate-as fv '#(1 2 3 4 5) (flexvector-copy! fv 1 (flexvector 10 20 30 40 50) 1 4)))) + (pass-if "flexvector-copy! overflow" + (equal? #(1 2 30 40 50) + (mutate-as fv '#(1 2 3) (flexvector-copy! fv 2 (flexvector 30 40 50))))) + (pass-if "flexvector-reverse-copy!" + (equal? #(1 40 30 20 5) + (mutate-as fv '#(1 2 3 4 5) (flexvector-reverse-copy! fv 1 (flexvector 20 30 40))))) + (pass-if "flexvector-reverse-copy! bounded" + (equal? #(1 40 30 20 5) + (mutate-as fv '#(1 2 3 4 5) (flexvector-reverse-copy! fv 1 (flexvector 10 20 30 40 50) 1 4)))) + (pass-if "flexvector-reverse-copy! overflow" + (equal? #(1 2 50 40 30) + (mutate-as fv '#(1 2 3) (flexvector-reverse-copy! fv 2 (flexvector 30 40 50))))) + + (pass-if "flexvector-fill!" + (equal? '#(foo foo foo) + (mutate-as x '#(1 2 3) (flexvector-fill! x 'foo)))) + (pass-if "flexvector-fill! start" + (equal? '#(1 2 bar bar bar) + (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'bar 2)))) + (pass-if "flexvector-fill! start end" + (equal? '#(1 2 baz baz 5) + (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'baz 2 4)))) + (pass-if "flexvector-fill! clamped" + (equal? '#(qux qux qux) + (mutate-as x '#(1 2 3) (flexvector-fill! x 'qux -1 10))))) -- 2.34.1