From cde743ee1148f89d9299b444244d0a5ba8856e13 Mon Sep 17 00:00:00 2001
From: "Adam R. Nelson" <adam@nels.onl>
Date: Wed, 13 Jan 2021 22:26:53 -0500
Subject: add implementation source

---
 implementation/Makefile              |  12 ++
 implementation/README.md             |  11 +
 implementation/flexvectors-body1.scm | 222 ++++++++++++++++++++
 implementation/flexvectors-body2.scm | 391 +++++++++++++++++++++++++++++++++++
 implementation/flexvectors.sld       |  50 +++++
 implementation/srfi-64-minimal.scm   |  50 +++++
 implementation/tests.scm             | 278 +++++++++++++++++++++++++
 7 files changed, 1014 insertions(+)
 create mode 100644 implementation/Makefile
 create mode 100644 implementation/README.md
 create mode 100644 implementation/flexvectors-body1.scm
 create mode 100644 implementation/flexvectors-body2.scm
 create mode 100644 implementation/flexvectors.sld
 create mode 100644 implementation/srfi-64-minimal.scm
 create mode 100644 implementation/tests.scm

diff --git a/implementation/Makefile b/implementation/Makefile
new file mode 100644
index 0000000..bb70d1f
--- /dev/null
+++ b/implementation/Makefile
@@ -0,0 +1,12 @@
+.PHONY: test-all test-gauche test-sagittarius test-chibi
+
+test-all: test-gauche test-sagittarius test-chibi
+
+test-gauche:
+	gosh -I. tests.scm
+
+test-sagittarius:
+	sash -c -r7 -L. tests.scm
+
+test-chibi:
+	chibi-scheme tests.scm
diff --git a/implementation/README.md b/implementation/README.md
new file mode 100644
index 0000000..d3fe58a
--- /dev/null
+++ b/implementation/README.md
@@ -0,0 +1,11 @@
+# Flexvectors
+
+An implementation of flexvectors (also known as dynamic arrays or arraylists) in
+R7RS Scheme. Contains an R7RS library (`flexvectors.sld`) and a test suite
+(`tests.scm`).
+
+This implementation supports Gauche, Sagittarius, and Chibi. If all three of
+these are installed (binaries `gosh`, `sash`, and `chibi-scheme`), running
+`make` should run the test suite for all three. To run the test suite in
+a specific Scheme, use `make test-gauche`, `make test-sagittarius`, or `make
+test-chibi`.
diff --git a/implementation/flexvectors-body1.scm b/implementation/flexvectors-body1.scm
new file mode 100644
index 0000000..fb8ba67
--- /dev/null
+++ b/implementation/flexvectors-body1.scm
@@ -0,0 +1,222 @@
+(define-record-type Flexvector
+  (%make-flexvector fv-vector fv-length)
+  flexvector?
+  (fv-vector vec set-vec!)
+  (fv-length flexvector-length set-flexvector-length!))
+
+(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)))
+  (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))
+        (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))
+    (vector-copy! v (+ i xvlen) v i len)
+    (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))
+    (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)))
+              (vector-copy! new-vec 0 vec start end)
+              (%make-flexvector new-vec len)))
+          (else
+            (%make-flexvector (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)))
+      (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)))
+          (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)
+                    (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 (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 (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))))))
+        (vector-copy! vt at vf start end)
+        (set-flexvector-length! to
+          (max (flexvector-length to) (+ at (- end start))))))))
diff --git a/implementation/flexvectors-body2.scm b/implementation/flexvectors-body2.scm
new file mode 100644
index 0000000..ba3e2f5
--- /dev/null
+++ b/implementation/flexvectors-body2.scm
@@ -0,0 +1,391 @@
+(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-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 v1 i)
+                         (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 v1 i)
+                         (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 (map flexvector-length fvs))))
+        (do ((i 0 (+ i 1))) ((= i len))
+          (apply proc i (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)
+                      (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)
+                      (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) (map flexvector-length o))))
+    (let lp ((i 0))
+      (and (< i len)
+           (or (apply pred?
+                      (flexvector-ref fv i)
+                      (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) (map flexvector-length o))))
+    (or (zero? len)
+      (let lp ((i 0))
+        (let ((x (apply pred?
+                        (flexvector-ref fv i)
+                        (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-reverse-copy! to at from . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o)))
+                 (cadr o)
+                 (flexvector-length from))))
+    (flexvector-copy! to at from start end)
+    (flexvector-reverse! to at (+ at (- end start)))))
+
+(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 string->vector s o)))
+
+(define (flexvector->string fv . o)
+  (assume (flexvector? fv))
+  (vector->string (apply flexvector->vector fv o)))
+
+(define (generator->flexvector g)
+  (assume (procedure? g))
+  (flexvector-unfold eof-object? (lambda (x) x) (lambda (_) (g)) (g)))
diff --git a/implementation/flexvectors.sld b/implementation/flexvectors.sld
new file mode 100644
index 0000000..25e1543
--- /dev/null
+++ b/implementation/flexvectors.sld
@@ -0,0 +1,50 @@
+(define-library (flexvectors)
+  (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)
+
+  (import (scheme base)
+          (scheme case-lambda)
+          (scheme write)
+          (srfi 1)
+          (srfi 145))
+
+  (include "flexvectors-body1.scm")
+  (include "flexvectors-body2.scm"))
diff --git a/implementation/srfi-64-minimal.scm b/implementation/srfi-64-minimal.scm
new file mode 100644
index 0000000..e60632b
--- /dev/null
+++ b/implementation/srfi-64-minimal.scm
@@ -0,0 +1,50 @@
+; Just enough of SRFI 64 (unit tests) to run test.scm.
+
+(define *test-failures* '())
+
+(define (test-begin name)
+  (newline)
+  (display "Test group: ")
+  (display name)
+  (newline)
+  (newline))
+
+(define (test-end name)
+  (newline)
+  (cond
+    ((null? *test-failures*)
+      (display "All tests passed!")
+      (newline)
+      (newline)
+      (exit 0))
+    (else
+      (write (length *test-failures*))
+      (display " TEST(S) FAILED:")
+      (newline)
+      (for-each (lambda (x) (x)) (reverse *test-failures*))
+      (newline)
+      (exit 1))))
+
+(define (%test-equal name expected actual)
+  (cond
+    ((equal? expected actual)
+      (display "pass: "))
+    (else
+      (set! *test-failures*
+            (cons
+              (lambda ()
+                (display name)
+                (display ": Expected ")
+                (write expected)
+                (display ", got ")
+                (write actual)
+                (newline))
+              *test-failures*))
+      (display "FAIL: ")))
+  (display name)
+  (newline))
+
+(define-syntax test-equal
+  (syntax-rules ()
+    ((_ name expected actual)
+       (%test-equal name expected (guard (e (#t e)) actual)))))
diff --git a/implementation/tests.scm b/implementation/tests.scm
new file mode 100644
index 0000000..329a8d6
--- /dev/null
+++ b/implementation/tests.scm
@@ -0,0 +1,278 @@
+(import (scheme base)
+        (scheme write)
+        (scheme process-context)
+        (flexvectors))
+
+(include "./srfi-64-minimal.scm")
+
+(test-begin "Flexvectors")
+
+(test-equal "flexvector?" #t (flexvector? (flexvector)))
+(test-equal "flexvector-length" 3 (flexvector-length (make-flexvector 3 #f)))
+(test-equal "flexvector" 3 (flexvector-length (flexvector 1 2 3)))
+
+(let ((fv (flexvector 'a 'b 'c)))
+  (test-equal "flexvector-ref" 'b (flexvector-ref fv 1))
+  (test-equal "flexvector-front" 'a (flexvector-front fv))
+  (test-equal "flexvector-back" 'c (flexvector-back fv))
+  (test-equal "flexvector-set! return" 'b (flexvector-set! fv 1 'd))
+  (test-equal "flexvector-set! mutate" 'd (flexvector-ref fv 1))
+  (test-equal "flexvector-add-back! return" fv (flexvector-add-back! fv 'e))
+  (test-equal "flexvector-add-back! mutate" '(4 . e)
+    (cons (flexvector-length fv)
+          (flexvector-ref fv (- (flexvector-length fv) 1))))
+  (test-equal "flexvector-remove! return" 'd (flexvector-remove! fv 1))
+  (test-equal "flexvector-remove! mutate" '(3 . c)
+    (cons (flexvector-length fv)
+          (flexvector-ref fv 1)))
+  (test-equal "flexvector-clear! return" fv (flexvector-clear! fv))
+  (test-equal "flexvector-clear! mutate" 0 (flexvector-length fv))
+  (test-equal "flexvector-empty?" #t (flexvector-empty? fv)))
+
+(test-equal "flexvector=? same symbols" #t
+  (flexvector=? eq? (flexvector 'a 'b) (flexvector 'a 'b)))
+(test-equal "flexvector=? different symbols" #f
+  (flexvector=? eq? (flexvector 'a 'b) (flexvector 'b 'a)))
+(test-equal "flexvector=? different lengths" #f
+  (flexvector=? = (flexvector 1 2 3 4 5) (flexvector 1 2 3 4)))
+(test-equal "flexvector=? same numbers" #t
+  (flexvector=? = (flexvector 1 2 3 4) (flexvector 1 2 3 4)))
+(test-equal "flexvector=? 0 arguments" #t
+  (flexvector=? eq?))
+(test-equal "flexvector=? 1 argument" #t
+  (flexvector=? eq? (flexvector 'a)))
+
+(test-equal "make-flexvector" #(a a a) (flexvector->vector (make-flexvector 3 'a)))
+
+(test-equal "flexvector-unfold"
+  #(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)))
+(test-equal "flexvector-unfold-right"
+  #(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)))
+
+
+(test-equal "string->flexvector" #(#\a #\b #\c)
+  (flexvector->vector (string->flexvector "abc")))
+(test-equal "flexvector->string" "abc" (flexvector->string (flexvector #\a #\b #\c)))
+
+; Nondestructive operations on one vector
+(let ((fv (flexvector 10 20 30)))
+  (test-equal "flexvector->vector" #(10 20 30) (flexvector->vector fv))
+  (test-equal "flexvector->list" '(10 20 30) (flexvector->list fv))
+  (test-equal "reverse-flexvector->list" '(30 20 10) (reverse-flexvector->list fv))
+  (test-equal "flexvector-copy" #t
+    (let ((copy (flexvector-copy fv)))
+      (and (= (flexvector-length fv) (flexvector-length copy))
+           (not (eq? fv copy)))))
+  (test-equal "flexvector-reverse-copy" #(30 20 10)
+    (flexvector->vector (flexvector-reverse-copy fv)))
+  (test-equal "flexvector-copy start" #(20 30)
+    (flexvector->vector (flexvector-copy fv 1)))
+  (test-equal "flexvector-copy start end" #(20)
+    (flexvector->vector (flexvector-copy fv 1 2)))
+  (test-equal "flexvector-for-each" '(30 20 10)
+    (let ((res '()))
+      (flexvector-for-each (lambda (x) (set! res (cons x res))) fv)
+      res))
+  (test-equal "flexvector-for-each/index" '(34 22 10)
+    (let ((res '()))
+      (flexvector-for-each/index
+        (lambda (i x) (set! res (cons (+ x (* i 2)) res)))
+        fv)
+      res))
+  (test-equal "flexvector-map" #(100 200 300)
+    (flexvector->vector (flexvector-map (lambda (x) (* x 10)) fv)))
+  (test-equal "flexvector-map/index" #(10 22 34)
+    (flexvector->vector (flexvector-map/index (lambda (i x) (+ x (* i 2))) fv)))
+  (test-equal "flexvector-append-map" #(10 100 20 200 30 300)
+    (flexvector->vector
+      (flexvector-append-map (lambda (x) (flexvector x (* x 10))) fv)))
+  (test-equal "flexvector-append-map/index" #(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)))
+  (test-equal "flexvector-filter" #(10)
+    (flexvector->vector (flexvector-filter (lambda (x) (< x 15)) fv)))
+  (test-equal "flexvector-filter/index" #(10 30)
+    (flexvector->vector (flexvector-filter/index (lambda (i x) (not (= i 1))) fv)))
+  (test-equal "flexvector-fold" '(30 20 10)
+    (flexvector-fold (lambda (x y) (cons y x)) '() fv))
+  (test-equal "flexvector-fold-right" '(10 20 30)
+    (flexvector-fold-right (lambda (x y) (cons y x)) '() fv))
+  (test-equal "flexvector-count" 2
+    (flexvector-count (lambda (x) (< x 25)) fv))
+  (test-equal "flexvector-cumulate" #(3 4 8 9 14 23 25 30 36)
+    (flexvector->vector
+      (flexvector-cumulate + 0 (flexvector 3 1 4 1 5 9 2 5 6))))
+  (test-equal "flexvector-any" '(#t . #f)
+    (cons (flexvector-any (lambda (x) (= x 20)) fv)
+          (flexvector-any (lambda (x) (= x 21)) fv)))
+  (test-equal "flexvector-every" '(#t . #f)
+    (cons (flexvector-every (lambda (x) (< x 40)) fv)
+          (flexvector-every (lambda (x) (< x 30)) fv)))
+  (test-equal "flexvector-index" 1
+    (flexvector-index (lambda (x) (> x 10)) fv))
+  (test-equal "flexvector-index-right" 2
+    (flexvector-index-right (lambda (x) (> x 10)) fv))
+  (test-equal "flexvector-skip" 1
+    (flexvector-skip (lambda (x) (< x 20)) fv))
+  (test-equal "flexvector-skip-right" 0
+    (flexvector-skip-right (lambda (x) (> x 10)) fv))
+  (test-equal "flexvector-partition" '(#(10 20) #(30))
+    (call-with-values
+      (lambda () (flexvector-partition (lambda (x) (< x 25)) fv))
+      (lambda vs (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)))))
+  (test-equal "flexvector-binary-search" 3
+    (flexvector-binary-search fv #\d cmp))
+  (test-equal "flexvector-binary-search first" 0
+    (flexvector-binary-search fv #\a cmp))
+  (test-equal "flexvector-binary-search last" 9
+    (flexvector-binary-search fv #\j cmp))
+  (test-equal "flexvector-binary-search not found" #f
+    (flexvector-binary-search fv #\k cmp))
+
+  (test-equal "flexvector-binary-search in range" 5
+    (flexvector-binary-search fv #\f cmp 2 6))
+  (test-equal "flexvector-binary-search out of range" #f
+    (flexvector-binary-search fv #\f cmp 1 5)))
+
+; Nondestructive operations on multiple vectors
+(test-equal "flexvector-append" #(10 20 30 40 50 60)
+  (flexvector->vector
+    (flexvector-append (flexvector 10 20)
+                       (flexvector)
+                       (flexvector 30 40)
+                       (flexvector 50 60))))
+(test-equal "flexvector-concatenate" #(10 20 30 40 50 60)
+  (flexvector->vector
+    (flexvector-concatenate
+      (list (flexvector 10 20)
+            (flexvector)
+            (flexvector 30 40)
+            (flexvector 50 60)))))
+(test-equal "flexvector-append-subvectors" #(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)))))
+
+(test-equal "flexvector-add! empty" '#(foo)
+  (mutate-as x '#() (flexvector-add! x 0 'foo)))
+(test-equal "flexvector-add! empty multiple" '#(foo bar baz)
+  (mutate-as x '#() (flexvector-add! x 0 'foo 'bar 'baz)))
+(test-equal "flexvector-add! start" '#(foo bar baz)
+  (mutate-as x '#(bar baz) (flexvector-add! x 0 'foo)))
+(test-equal "flexvector-add! start multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(qux quux) (flexvector-add! x 0 'foo 'bar 'baz)))
+(test-equal "flexvector-add! middle" '#(foo bar baz)
+  (mutate-as x '#(foo baz) (flexvector-add! x 1 'bar)))
+(test-equal "flexvector-add! middle multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(foo quux) (flexvector-add! x 1 'bar 'baz 'qux)))
+(test-equal "flexvector-add! end" '#(foo bar baz)
+  (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz)))
+(test-equal "flexvector-add! end multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(foo bar) (flexvector-add! x 2 'baz 'qux 'quux)))
+
+(test-equal "flexvector-add-all!" '#(foo bar baz qux)
+  (mutate-as x '#(foo qux) (flexvector-add-all! x 1 '(bar baz))))
+
+(test-equal "flexvector-add-front! empty" '#(foo)
+  (mutate-as x '#() (flexvector-add-front! x 'foo)))
+(test-equal "flexvector-add-front! empty multiple" '#(foo bar baz)
+  (mutate-as x '#() (flexvector-add-front! x 'foo 'bar 'baz)))
+(test-equal "flexvector-add-front!" '#(foo bar baz)
+  (mutate-as x '#(bar baz) (flexvector-add-front! x 'foo)))
+(test-equal "flexvector-add-front! multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(qux quux) (flexvector-add-front! x 'foo 'bar 'baz)))
+
+(test-equal "flexvector-add-back! empty" '#(foo)
+  (mutate-as x '#() (flexvector-add-back! x 'foo)))
+(test-equal "flexvector-add-back! empty multiple" '#(foo bar baz)
+  (mutate-as x '#() (flexvector-add-back! x 'foo 'bar 'baz)))
+(test-equal "flexvector-add-back!" '#(foo bar baz)
+  (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz)))
+(test-equal "flexvector-add-back! multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(foo bar) (flexvector-add-back! x 'baz 'qux 'quux)))
+
+(test-equal "flexvector-append!" '#(foo bar baz qux)
+  (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux))))
+(test-equal "flexvector-append! multiple" '#(foo bar baz qux quux)
+  (mutate-as x '#(foo bar) (flexvector-append! x (flexvector 'baz 'qux) (flexvector 'quux))))
+
+(test-equal "flexvector-remove!" '#(foo baz)
+  (mutate-as x '#(foo bar baz) (flexvector-remove! x 1)))
+(test-equal "flexvector-remove! only" '#()
+  (mutate-as x '#(foo) (flexvector-remove! x 0)))
+
+(test-equal "flexvector-remove-front!" '#(bar baz)
+  (mutate-as x '#(foo bar baz) (flexvector-remove-front! x)))
+(test-equal "flexvector-remove-front! only" '#()
+  (mutate-as x '#(foo) (flexvector-remove-front! x)))
+
+(test-equal "flexvector-remove-back!" '#(foo bar)
+  (mutate-as x '#(foo bar baz) (flexvector-remove-back! x)))
+(test-equal "flexvector-remove-back! only" '#()
+  (mutate-as x '#(foo) (flexvector-remove-back! x)))
+
+(test-equal "flexvector-remove-range!" '#(a e f)
+  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 4)))
+(test-equal "flexvector-remove-range! empty range" '#(a b c d e f)
+  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 1 1)))
+(test-equal "flexvector-remove-range! overflow left" '#(e f)
+  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x -1 4)))
+(test-equal "flexvector-remove-range! overflow right" '#(a b)
+  (mutate-as x '#(a b c d e f) (flexvector-remove-range! x 2 10)))
+
+(test-equal "flexvector-map!" '#(100 200 300)
+  (mutate-as fv '#(10 20 30) (flexvector-map! (lambda (x) (* x 10)) fv)))
+(test-equal "flexvector-map/index!" '#(10 22 34)
+  (mutate-as fv '#(10 20 30) (flexvector-map/index! (lambda (i x) (+ x (* i 2))) fv)))
+(test-equal "flexvector-filter!" '#(10)
+  (mutate-as fv '#(10 20 30) (flexvector-filter! (lambda (x) (< x 15)) fv)))
+(test-equal "flexvector-filter/index!" '#(10 30)
+  (mutate-as fv '#(10 20 30) (flexvector-filter/index! (lambda (i x) (not (= i 1))) fv)))
+
+(test-equal "flexvector-swap!" #(10 30 20)
+  (mutate-as fv '#(10 20 30) (flexvector-swap! fv 1 2)))
+(test-equal "flexvector-reverse!" #(30 20 10)
+  (mutate-as fv '#(10 20 30) (flexvector-reverse! fv)))
+
+(test-equal "flexvector-copy!" #(1 20 30 40 5)
+  (mutate-as fv '#(1 2 3 4 5) (flexvector-copy! fv 1 (flexvector 20 30 40))))
+(test-equal "flexvector-copy! bounded" #(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)))
+(test-equal "flexvector-copy! overflow" #(1 2 30 40 50)
+  (mutate-as fv '#(1 2 3) (flexvector-copy! fv 2 (flexvector 30 40 50))))
+(test-equal "flexvector-reverse-copy!" #(1 40 30 20 5)
+  (mutate-as fv '#(1 2 3 4 5) (flexvector-reverse-copy! fv 1 (flexvector 20 30 40))))
+(test-equal "flexvector-reverse-copy! bounded" #(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)))
+(test-equal "flexvector-reverse-copy! overflow" #(1 2 50 40 30)
+  (mutate-as fv '#(1 2 3) (flexvector-reverse-copy! fv 2 (flexvector 30 40 50))))
+
+(test-end "Flexvectors")
-- 
cgit 1.4.1