VList on Gauche

vlist.scm

(define-class <vlist> ()
  ((base :init-keyword :base :accessor base-of)
   (offset :init-keyword :offset :accessor offset-of)
   (size :init-keyword :size :accessor size-of)
   (block :init-keyword :block :accessor block-of)))

(define (make-vlist base offset size block)
  (make <vlist> :base base :offset offset :size size :block block))

(define vlist-null (make-vlist () 0 -1 #()))

(define (vlist-cons* obj vlist)
  (vector-set! (block-of vlist) (- (offset-of vlist) 1) obj)
  (make-vlist (base-of vlist) (- (offset-of vlist) 1) (size-of vlist) (block-of vlist)))

(define (vlist-cons obj vlist)
  (if (zero? (offset-of vlist))
      (vlist-cons* obj (make-vlist vlist (ash 1 (+ (size-of vlist) 1)) (+ (size-of vlist) 1) (make-vector (ash 1 (+ (size-of vlist) 1)))))
      (vlist-cons* obj vlist)))

(define (vlist . args)
  (if (null? args)
      vlist-null
      (vlist-cons (car args) (apply vlist (cdr args)))))

(define (vlist-ref vlist index)
  (if (< (+ index (offset-of vlist)) (vector-length (block-of vlist)))
      (vector-ref (block-of vlist) (+ index (offset-of vlist)))
      (vlist-ref (base-of vlist) (- index (- (vector-length (block-of vlist)) (offset-of vlist))))))