diff options
| author | Adam R. Nelson <adam@nels.onl> | 2021-03-18 19:51:21 -0400 |
|---|---|---|
| committer | Arthur A. Gleckler <srfi@speechcode.com> | 2021-03-18 20:45:24 -0700 |
| commit | 216f352b3ac0c7f69b43b551d6db88608855dd5d (patch) | |
| tree | 7ce8cc24b94479cea1694469d2fa54c7d8efeabb | |
| parent | c7b10eea0315f59a3806a3195e89a0a2e7a1cf3d (diff) | |
| download | srfi-214-216f352b3ac0c7f69b43b551d6db88608855dd5d.tar.gz srfi-214-216f352b3ac0c7f69b43b551d6db88608855dd5d.tar.xz srfi-214-216f352b3ac0c7f69b43b551d6db88608855dd5d.zip | |
impl fixes: add flexvector-fill!, remove dupe flexvector-reverse-copy!
| -rw-r--r-- | implementation/flexvectors-body2.scm | 25 | ||||
| -rw-r--r-- | 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") |