From 216f352b3ac0c7f69b43b551d6db88608855dd5d Mon Sep 17 00:00:00 2001
From: "Adam R. Nelson" <adam@nels.onl>
Date: Thu, 18 Mar 2021 19:51:21 -0400
Subject: impl fixes: add flexvector-fill!, remove dupe
 flexvector-reverse-copy!

---
 implementation/flexvectors-body2.scm | 25 +++++++++++++++----------
 implementation/tests.scm             |  9 +++++++++
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/implementation/flexvectors-body2.scm b/implementation/flexvectors-body2.scm
index 6f37efe..8c26134 100644
--- a/implementation/flexvectors-body2.scm
+++ b/implementation/flexvectors-body2.scm
@@ -1,3 +1,4 @@
+
 (define flexvector-unfold
   (case-lambda
     ((p f g seed)
@@ -21,6 +22,18 @@
   (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)
@@ -97,7 +110,7 @@
           (if (>= i len)
               acc
               (lp (+ i 1)
-                  (apply kons acc (flexvector-ref v1 i)
+                  (apply kons acc (flexvector-ref fv1 i)
                          (map (lambda (fv) (flexvector-ref fv i)) o))))))))
 
 (define (flexvector-fold-right kons knil fv1 . o)
@@ -111,7 +124,7 @@
           (if (negative? i)
               acc
               (lp (- i 1)
-                  (apply kons acc (flexvector-ref v1 i)
+                  (apply kons acc (flexvector-ref fv1 i)
                          (map (lambda (fv) (flexvector-ref fv i)) o))))))))
 
 (define flexvector-for-each/index
@@ -309,14 +322,6 @@
         (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))
diff --git a/implementation/tests.scm b/implementation/tests.scm
index e41f19c..391540e 100644
--- a/implementation/tests.scm
+++ b/implementation/tests.scm
@@ -293,4 +293,13 @@
 (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-equal "flexvector-fill!" '#(foo foo foo)
+  (mutate-as x '#(1 2 3) (flexvector-fill! x 'foo)))
+(test-equal "flexvector-fill! start" '#(1 2 bar bar bar)
+  (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'bar 2)))
+(test-equal "flexvector-fill! start end" '#(1 2 baz baz 5)
+  (mutate-as x '#(1 2 3 4 5) (flexvector-fill! x 'baz 2 4)))
+(test-equal "flexvector-fill! clamped" '#(qux qux qux)
+  (mutate-as x '#(1 2 3) (flexvector-fill! x 'qux -1 10)))
+
 (test-end "Flexvectors")
-- 
cgit 1.4.1