From: Vijay Marupudi <vijay@vijaymarupudi.com>
To: Maxime Devos <maximedevos@telenet.be>, guile-devel@gnu.org
Subject: Re: [PATCH] Added srfi-214: flexvectors
Date: Wed, 19 Jan 2022 08:55:12 -0500 [thread overview]
Message-ID: <87sftjzv7j.fsf@vijaymarupudi.com> (raw)
In-Reply-To: <53571f80fa796b002f696c68ba2151d97bb6edad.camel@telenet.be>
[-- Attachment #1: Type: text/plain, Size: 1541 bytes --]
Thank you for taking a look Maxime. I have accidentally replied to just
you and not the whole list, so there might be a duplicate email.
> How about including the tests
> (https://github.com/scheme-requests-for-implementation/srfi-214/blob/master/implementation/tests.scm)
> as well?
>
> Guile doesn't use SRFI-64 in its own tests though, so some changes may
> be necessary.
I've converted and added the tests to the patch. It passes with no
issues on my end.
> however, the README says ‘by Adam Nelson’. Did you reach some kind of
> agreement with Adam Nelson about copyright assignment? And since SRFIs
> are licensed under Expat (not 100% sure), wouldn't this need to be the
> Expat license text?
>
> Even if the Expat license allows this (I don't know), then I would
> still recommend to keep the license the same, such that fixes can
> easily be interchanged between Scheme implementations (e.g. there have
> been some fixes to SRFI-64 a while ago).
There was no copyright assignment. The expat license is GPL compatible,
so I assumed GPL would be the preferred license for a contribution to
Guile. I can definitely change the license for my edits to whatever is
best for Guile. The license for srfi-214's sample implementation is
definitely expat, given the SRFI process errata
<https://srfi.schemers.org/srfi-process.html> and the working repository
of the implementation
<https://github.com/ar-nelson/scheme-flexvectors/blob/master/LICENSE>
I have attached the updated patch.
~ Vijay
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Added-srfi-214-flexvectors.patch --]
[-- Type: text/x-patch, Size: 43965 bytes --]
From ec49b052809bbe44ee47765db0dd887313702dcc Mon Sep 17 00:00:00 2001
From: Vijay Marupudi <vijay@vijaymarupudi.com>
Date: Tue, 18 Jan 2022 20:52:08 -0500
Subject: [PATCH] Added srfi-214: flexvectors
---
module/Makefile.am | 1 +
module/srfi/srfi-214.scm | 730 +++++++++++++++++++++++++++++++++
test-suite/Makefile.am | 1 +
test-suite/tests/srfi-214.test | 427 +++++++++++++++++++
4 files changed, 1159 insertions(+)
create mode 100644 module/srfi/srfi-214.scm
create mode 100644 test-suite/tests/srfi-214.test
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..d52eca958
--- /dev/null
+++ b/module/srfi/srfi-214.scm
@@ -0,0 +1,730 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;; This code was largely written by Adam Nelson as a sample
+;; implementation for srfi-214
+
+(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 "(~a" (flexvector-ref obj 0))
+ (let loop ((i 1)
+ (len (flexvector-length obj)))
+ (if (= len i)
+ (display ")" port)
+ (begin
+ (format port " ~a" (flexvector-ref obj i))
+ (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..26925e614
--- /dev/null
+++ b/test-suite/tests/srfi-214.test
@@ -0,0 +1,427 @@
+;;;; srfi-214.test --- Test suite for SRFI 214 -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(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
next prev parent reply other threads:[~2022-01-19 13:55 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-01-19 2:34 [PATCH] Added srfi-214: flexvectors Vijay Marupudi
2022-01-19 9:00 ` Maxime Devos
2022-01-19 13:55 ` Vijay Marupudi [this message]
[not found] ` <87wnivzvd4.fsf@vijaymarupudi.com>
2022-01-19 15:04 ` Maxime Devos
2022-01-19 15:44 ` Vijay Marupudi
2022-01-19 16:04 ` Maxime Devos
2022-01-20 15:34 ` Vijay Marupudi
2022-01-20 16:53 ` Maxime Devos
2022-01-20 17:57 ` Vijay Marupudi
2022-01-20 18:15 ` Maxime Devos
2022-01-20 20:38 ` Vijay Marupudi
2022-10-07 19:58 ` Vijay Marupudi
2022-10-12 12:22 ` Ludovic Courtès
2022-11-13 20:27 ` Vijay Marupudi
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87sftjzv7j.fsf@vijaymarupudi.com \
--to=vijay@vijaymarupudi.com \
--cc=guile-devel@gnu.org \
--cc=maximedevos@telenet.be \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).