(module extensible-vector mzscheme
(provide
make-evector
evector?
evector-ref
evector-set!
evector-length
set-evector-length!
evector-sub-fill!
evector-fill
evector-fill!
evector-size
set-evector-fill!
evector
evector->list
evector->vector
list->evector
vector->evector
evector-push!
evector-pop!)
(define-values ( make-evector
evector?
evector-ref
evector-set!
evector-length
set-evector-length!
evector-sub-fill!
evector-fill
set-evector-fill!
evector
evector->list
evector->vector
list->evector
vector->evector
evector-fill!
evector-size
evector-push!
evector-pop!
)
(let ()
(define MIN-LENGTH 16)
(define DEFAULT-FILL '())
(define DEFAULT-EXPAND #t)
(define-struct %evector (length vector fill automatic-expansion-on-set!?) (make-inspector))
(define make-evector
(case-lambda
[(k) (make-evector k DEFAULT-FILL DEFAULT-EXPAND)]
[(k fill) (make-evector k fill DEFAULT-EXPAND)]
[(k fill automatic) (let ([len (max k MIN-LENGTH)])
(make-%evector k (make-vector len fill) fill
(or (eq? automatic 'automatic-expansion-on-set!)
(eq? automatic #t))))]))
(define (evector-length v)
(unless (%evector? v) (error "evector-length: expects arguments of type <evector>; given" v))
(%evector-length v))
(define (evector-ref v i)
(unless (%evector? v) (error "evector-ref: expects arguments of type <evector>; given" v))
(unless (< -1 i (%evector-length v)) (error "evector-ref: index out of range; given: " v i))
(vector-ref (%evector-vector v) i))
(define (evector-set! v i val)
(unless (%evector? v) (error "evector-set!: expects arguments of type <evector>; given" v))
(unless (>= i 0) (error "evector-set!: index must be a non-negative integer: " v i))
(cond
[(< i (%evector-length v)) (vector-set! (%evector-vector v) i val)]
[(%evector-automatic-expansion-on-set!? v) (begin
(set-evector-length! v (+ i 1))
(evector-set! v i val))]
[else (error "evector-set!: index out of range; given: " v i val)]))
(define (set-evector-length! v l)
(let ([max-len (vector-length (%evector-vector v))]
[old-len (%evector-length v)])
(cond
[(<= 0 l max-len) (set-%evector-length! v l)]
[(> l max-len) (begin
(expand-evector! v l)
(set-evector-length! v l))])
(evector-sub-fill! v old-len l)))
(define (set-evector-length! v l)
(let ([max-len (vector-length (%evector-vector v))])
(cond
[(<= 0 l max-len) (set-%evector-length! v l)]
[(> l max-len) (begin
(expand-evector! v l)
(let ([old-len (%evector-length v)])
(set-evector-length! v l)
(evector-sub-fill! v old-len l)))])))
(define evector-sub-fill!
(case-lambda
[(v start end) (evector-sub-fill! v start end (%evector-fill v))]
[(v start end fill) (let ([w (%evector-vector v)]
[fill (%evector-fill v)])
(do ([i start (add1 i)])
[(= i end) (void)]
(vector-set! w i fill)))]))
(define (expand-evector! v l)
(cond
[(<= (* 2 l) (%evector-length v))
(void)]
[else
(let* ([new-size (do ([len (* 2 (vector-length (%evector-vector v))) (* 2 len)])
[(<= (* 2 l) len) len])]
[new-vector (make-vector new-size (%evector-fill v))]
[old-vector (%evector-vector v)]
[old-size (vector-length old-vector)]
[length (%evector-length v)])
(do ([i 0 (add1 i)])
[(= i length) (void)]
(vector-set! new-vector i (vector-ref old-vector i)))
(set-%evector-vector! v new-vector))]))
(define (evector . os)
(let ([ev (make-evector (length os) #f #t)])
(do ([os os (cdr os)]
[i 0 (+ i 1)])
[(null? os) ev]
(evector-set! ev i (car os)))))
(define (evector->list ev)
(unless (%evector? ev) (error "evector->list: expects arguments of type <evector>; given" ev))
(let ([len (evector-length ev)])
(do ([i (- len 1) (- i 1)]
[l '() (cons (evector-ref ev i) l)])
[(< i 0) l])))
(define (list->evector l)
(unless (pair? l) (error "list->evector: expects arguments of type <list>; given" l))
(let ([ev (make-evector (length l) '() #t)])
(do ([i 0 (+ i 1)]
[l l (cdr l)])
[(null? l) ev]
(evector-set! ev i (car l)))))
(define (evector->vector ev)
(unless (%evector? ev) (error "evector->vector: expects arguments of type <evector>; given" ev))
(let* ([len (evector-length ev)]
[v (make-vector len)])
(do ([i 0 (+ i 1)])
[(= i len) v]
(vector-set! v i (evector-ref ev i)))))
(define (vector->evector v)
(unless (vector? v) (error "vector->evector: expects arguments of type <vector>; given" v))
(let* ([len (vector-length v)]
[ev (make-evector len '() #t)])
(do ([i 0 (+ i 1)])
[(= i len) ev]
(evector-set! ev i (vector-ref v i)))))
(define evector-fill!
(case-lambda
[(ev val)
(evector-fill! ev val 0 (evector-length ev))]
[(ev val start)
(evector-fill! ev val start (evector-length ev))]
[(ev val start end)
(let ([max-len (vector-length (%evector-vector ev))])
(cond
[(<= 0 end max-len) (begin
(let ([v (%evector-vector ev)])
(do ([i start (+ i 1)])
[(= i end) (void)]
(vector-set! v i val))))]
[(> end max-len) (begin
(expand-evector! ev end)
(set-%evector-length! ev end)
(evector-fill! ev val start end))]))]))
(define (evector-size ev)
(unless (evector? ev) (error "evector-size: expects arguments of type <vector>; given" ev))
(vector-length (%evector-vector ev)))
(define (evector-push! ev v)
(unless (evector? ev) (error "evector-push: expected a value of type <extensible-vector> as first argument; given" ev))
(let ([l (%evector-length ev)])
(evector-set! ev l v)
l))
(define (evector-pop! ev)
(unless (evector? ev) (error "evector-pop!: expected an <extensible-vector> as argument; given" ev))
(unless (positive? (%evector-length ev)) (error "evector-pop!: received empty extensible vector"))
(let* ([l (%evector-length ev)])
(set-%evector-length! ev (- l 1))
(vector-ref (%evector-vector ev) (- l 1))))
(values
make-evector
%evector?
evector-ref
evector-set!
%evector-length
set-evector-length!
evector-sub-fill!
%evector-fill
set-%evector-fill!
evector
evector->list
evector->vector
list->evector
vector->evector
evector-fill!
evector-size
evector-push!
evector-pop!
)))
)