(define-module (oop gvector)
  #:use-module (oop goops)
  #:use-module ((guile)
		#:select (vector-length vector-ref vector-set!)
		#:prefix orig:)
  #:export (<gvector>)
  #:replace (vector-length vector-ref vector-set!))

;;; Constants

(define *initial-allocated-size* 8)

;;; Capture original bindings of vector getters and setters

(define-generic vector-length)

(define-method (vector-length (v <vector>))
  (orig:vector-length v))

(define-generic vector-set!)

(define-method (vector-set! (gv <vector>) (i <integer>) obj)
  (orig:vector-set! gv i obj))

(define-generic vector-ref)

(define-method (vector-ref (gv <vector>) (i <integer>))
  (orig:vector-ref gv i))

;;; The <gvector> class

(define-class <gvector> (<vector>)
  (v #:init-value (make-vector *initial-allocated-size*) #:getter v)
  (length #:init-value 0 #:getter vector-length))

(define (assert-size! gv i)
  (if (>= i (length gv))
      *unspecified*)) ; do nothing for now

(define-method (vector-set! (gv <gvector>) (i <integer>) obj)
  (assert-size! gv i)
  (vector-set! (v gv) i obj))

(define-method (vector-ref (gv <gvector>) (i <integer>))
  (assert-size! gv i)
  (vector-ref (v gv) i))