123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137 |
- (define-module (ps-compiler util expand-vec)
- #:use-module (srfi srfi-9)
- #:export (export make-xvector
- xvector-length
- xvector-ref
- xvector-set!
- xvector-length
- xvector->vector))
- (define-record-type :expanding-vector
- (make-expanding-vector default length contents max)
- expanding-vector?
- (default expanding-vector-default)
- (length expanding-vector-length set-expanding-vector-length!)
- (contents expanding-vector-contents set-expanding-vector-contents!)
- (max expanding-vector-max set-expanding-vector-max!))
- (define (make-xvector default)
- (make-expanding-vector default 0 '#() -1))
- (define xvec-max-contents-size 1024)
- (define (xvector-length xvec)
- (+ 1 (expanding-vector-max xvec)))
- (define (xvector-ref xvec index)
- (let ((length (expanding-vector-length xvec)))
- (cond ((>= index length)
- (expanding-vector-default xvec))
- ((<= length xvec-max-contents-size)
- (vector-ref (expanding-vector-contents xvec) index))
- (else
- (vector-ref (vector-ref (expanding-vector-contents xvec)
- (quotient index xvec-max-contents-size))
- (remainder index xvec-max-contents-size))))))
- (define (xvector-set! xvec index value)
- (let ((length (expanding-vector-length xvec)))
- (if (> index (expanding-vector-max xvec))
- (set-expanding-vector-max! xvec index))
- (cond ((>= index length)
- (expand-expanding-vector xvec)
- (xvector-set! xvec index value))
- ((<= length xvec-max-contents-size)
- (vector-set! (expanding-vector-contents xvec) index value))
- (else
- (vector-set! (vector-ref (expanding-vector-contents xvec)
- (quotient index xvec-max-contents-size))
- (remainder index xvec-max-contents-size)
- value)))))
- (define (xvector->vector xvec)
- (let ((new (make-vector (xvector-length xvec))))
- (do ((i 0 (+ i 1)))
- ((>= i (xvector-length xvec)))
- (vector-set! new i (xvector-ref xvec i)))
- new))
- (define (expand-expanding-vector xvec)
- (let ((length (expanding-vector-length xvec))
- (contents (expanding-vector-contents xvec))
- (default (expanding-vector-default xvec))
- (finish (lambda (length contents)
- (set-expanding-vector-length! xvec length)
- (set-expanding-vector-contents! xvec contents))))
- (if (< length xvec-max-contents-size)
- (let ((new (expand-vector contents default)))
- (finish (vector-length new) new))
- (let ((contents (cond ((= length xvec-max-contents-size)
- (let ((new (make-vector 4 #f)))
- (vector-set! new 0 contents)
- new))
- ((vector-ref contents
- (- (vector-length contents) 1))
- (expand-vector contents #f))
- (else
- contents))))
- (vector-set! contents
- (quotient length xvec-max-contents-size)
- (make-vector xvec-max-contents-size default))
- (finish (+ length xvec-max-contents-size) contents)))))
- (define (expand-vector old default)
- (let* ((length (vector-length old))
- (new (make-vector (if (= 0 length) 4 (* 2 length)) default)))
- (do ((i 0 (+ i 1)))
- ((>= i length))
- (vector-set! new i (vector-ref old i)))
- new))
|