From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Vijay Marupudi Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Added srfi-214: flexvectors Date: Wed, 19 Jan 2022 10:44:00 -0500 Message-ID: <87fspjzq67.fsf@vijaymarupudi.com> References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="33726"; mail-complaints-to="usenet@ciao.gmane.io" To: Maxime Devos , guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Wed Jan 19 17:58:33 2022 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nAEI3-0008cj-H7 for guile-devel@m.gmane-mx.org; Wed, 19 Jan 2022 17:58:32 +0100 Original-Received: from localhost ([::1]:48884 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nAEI2-0003SD-JT for guile-devel@m.gmane-mx.org; Wed, 19 Jan 2022 11:58:30 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:44720) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nAD8J-0002PP-LH for guile-devel@gnu.org; Wed, 19 Jan 2022 10:44:23 -0500 Original-Received: from [2a0c:5a00:149::26] (port=34782 helo=mailtransmit05.runbox.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nAD8E-0000Fp-2P for guile-devel@gnu.org; Wed, 19 Jan 2022 10:44:23 -0500 Original-Received: from mailtransmit03.runbox ([10.9.9.163] helo=aibo.runbox.com) by mailtransmit05.runbox.com with esmtps (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 (Exim 4.93) (envelope-from ) id 1nAD88-00BX2f-Id for guile-devel@gnu.org; Wed, 19 Jan 2022 16:44:12 +0100 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=vijaymarupudi.com; s=selector1; h=Content-Type:MIME-Version:Message-ID:Date :In-Reply-To:Subject:To:From; bh=vI4dbfN+WGFZ0Hq+AgEtP9trycqaMtZETjirQHfGo4w= ; b=cG6T65aAea7CHvjrq9Byn862vjrlRnXkdJsZBvCIQI+zlph1nPMCw6zFdqi8zMAKmCY1I2NVm friXL5xjZMWAPQC25H9fFY0M7qgpo6ccRz0TN9U9eSXRdxEdTOAxXbwUScwB4pvLfM868ENY96Itm d1+2fujQLL2c5CRVi3A2eIuLINM4973j9wV0Fg38MNPwgeMS8IHrQmu9Y4RrYkm/M87efaWdo6/WC VDRC4I/DC0jroVJeTKaqr+a4zkcaZHTVd67bGzJCo+RQZbIZLlTNnWQmuYY/f6qpZkaKxdjoNQ33q ugbLf0t2NWLNRxhWPzZtAyLBmezqZ+j2FCf41Q==; Original-Received: from [10.9.9.73] (helo=submission02.runbox) by mailtransmit03.runbox with esmtp (Exim 4.86_2) (envelope-from ) id 1nAD88-0004My-4J; Wed, 19 Jan 2022 16:44:12 +0100 Original-Received: by submission02.runbox with esmtpsa [Authenticated ID (1028486)] (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) id 1nAD7y-00033w-3k; Wed, 19 Jan 2022 16:44:03 +0100 In-Reply-To: X-Host-Lookup-Failed: Reverse DNS lookup failed for 2a0c:5a00:149::26 (failed) Received-SPF: pass client-ip=2a0c:5a00:149::26; envelope-from=vijay@vijaymarupudi.com; helo=mailtransmit05.runbox.com X-Spam_score_int: -12 X-Spam_score: -1.3 X-Spam_bar: - X-Spam_report: (-1.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_NONE=-0.0001, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.io gmane.lisp.guile.devel:21041 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable > If no copyright assignment has happend, then the copyright still > belongs to the author > -- from the Git repository's LICENSE: =C2=A0Copyright =C2=A9 Adam Nelson = (2020)). > While possibly you might have made some small changes to flexvectors, > it seems that most code is preserved, so at most a =E2=80=98=C2=A9 FSF=E2= =80=99 line could > be added (*), however, the copyright line =E2=80=98=C2=A9 Adam Nelson=E2= =80=99 would need to > remain, otherwise the copyright lines are misleading. > > (*) This assumes you did copyright assignment to the FSF, otherwise > =E2=80=98=C2=A9 Vijay Marupudi=E2=80=99. That's fair, thanks for looking into it! I was unaware of where to include that information. I have added Adam Nelson and my name (can remove this if necessary, just did it to be complete) to the license comments and switched the `srfi-214.scm' file to the expat license for now. Note that I kept the GPL license in the srfi-214.test file, given that the README in test-suite/README says: > Please write more Guile tests, and send them to bug-guile@gnu.org. > We'll merge them into the distribution. All test suites must be > licensed for our use under the GPL, but I don't think I'm going to > collect assignment papers for them. I have not assigned my copyright to the FSF, but can do so if necessary. >> best for Guile. > > That would be up to the maintainers I suppose. Great, will wait for that. I have attached the latest version of the patch. ~ Vijay --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Added-srfi-214-flexvectors.patch >From 164b482a3191a19e1090e485a080834af5adce97 Mon Sep 17 00:00:00 2001 From: Vijay Marupudi Date: Tue, 18 Jan 2022 20:52:08 -0500 Subject: [PATCH] Added srfi-214: flexvectors --- module/Makefile.am | 1 + module/srfi/srfi-214.scm | 735 +++++++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-214.test | 428 +++++++++++++++++++ 4 files changed, 1165 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..cb5caf16e --- /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 + + + ; 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 + (%make-flexvector fv-vector fv-length) + flexvector? + (fv-vector vec set-vec!) + (fv-length flexvector-length set-flexvector-length!)) + +(set-record-type-printer! + (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..403105e8a --- /dev/null +++ b/test-suite/tests/srfi-214.test @@ -0,0 +1,428 @@ +;;;; srfi-214.test --- Test suite for SRFI 214 -*- scheme -*- +;;;; +;;;; Copyright (C) 2020 Adam Nelson. +;;;; Copyright (C) 2022 Vijay Marupudi. +;;;; +;;;; 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 ((charvector + (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 --=-=-=--