(define-module (growable-vector)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:export (growable-vector
            make-growable-vector
            growable-vector-ref
            growable-vector-set!
            growable-vector-resize!
            list->growable-vector
            growable-vector->list))

(define-record-type <growable-vector>
  (%make-growable-vector length vector)
  growable-vector?
  (length growable-vector-length %set-growable-vector-length!)
  (vector growable-vector-vector %set-growable-vector-vector!))

(define (alloc-size len)
  (expt 2 (integer-length (- len 1))))

(define (make-growable-vector len . maybe-init)
  (let ((v (apply make-vector (alloc-size len) maybe-init)))
    (%make-growable-vector len v)))

(define (list->growable-vector lst)
  (let* ((len (length lst))
         (v (make-vector (alloc-size len))))
    (do ((i 0 (+ i 1))
         (lst lst (cdr lst)))
        ((null? lst))
      (vector-set! v i (car lst)))
    (%make-growable-vector len v)))

(define (growable-vector->list gv)
  (let ((len (growable-vector-length gv))
        (v   (growable-vector-vector gv)))
    (do ((i (- len 1) (- i 1))
         (lst '() (cons (vector-ref v i) lst)))
        ((negative? i) lst))))

(define (growable-vector . elems)
  (list->growable-vector elems))

(define (growable-vector-ref gv idx)
  (if (< -1 idx (growable-vector-length gv))
      (vector-ref (growable-vector-vector gv) idx)
      (error "growable-vector-ref: index out of range" idx gv)))

(define (growable-vector-set! gv idx val)
  (if (< -1 idx (growable-vector-length gv))
      (vector-set! (growable-vector-vector gv) idx val)
      (error "growable-vector-set!: index out of range" idx gv)))

(define (growable-vector-resize! gv new-len)
  (let* ((old-len   (growable-vector-length gv))
         (old-v     (growable-vector-vector gv))
         (old-alloc (vector-length old-v))
         (new-alloc (alloc-size new-len)))
    (if (not (= old-alloc new-alloc))
        (let ((new-v (make-vector new-alloc)))
          (vector-move-left! old-v 0 (min old-len new-len)
                             new-v 0)
          (%set-growable-vector-vector! gv new-v)))
    (%set-growable-vector-length! gv new-len)))

(set-record-type-printer! <growable-vector>
  (lambda (gv port)
    (format port "#<growable-vector ~S>"
            (growable-vector->list gv))))