diff options
Diffstat (limited to 'implementation/flexvectors-body1.scm')
-rw-r--r-- | implementation/flexvectors-body1.scm | 222 |
1 files changed, 222 insertions, 0 deletions
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)))))))) |