1 files changed, 391 insertions, 0 deletions
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)))