(module record-vector racket/base

  (provide record-vector
           make-rv
           record-vector?
           record-vector-length
           rv-len
           record-vector-ref
           rv-ref
           record-vector-update!
           rv-update!
           record-vector-attr?
           rv-attr?
           record-vector-set!
           rv-set!
           record-vector-clone
           rv-clone
           record-vector-like?
           rv-like?
           )

  (require racket/vector)

  (define record-vector
    (lambda r
      (let loop ((defs r) (i 0) (vals '()) (kws '()))
        (cond ((null? defs)
               (mcons (reverse kws) (list->vector (reverse vals))))
              (else
               (cond ((and (keyword? (car defs)) (pair? (cdr defs)) (not (keyword? (cadr defs))))
                      (loop (cddr defs) (+ 1 i) (cons (cadr defs) vals) (cons (cons (car defs) i) kws)))
                     (else (error "unmatched keyword in " r))))))))


  (define-syntax-rule (make-rv some ...) (record-vector some ...))

  (define (record-vector? r)
    (and (mpair? r) (list? (mcar r)) (vector? (mcdr r))))


  (define (record-vector-length r)
    (vector-length (mcdr r)))


  (define-syntax-rule (rv-len r) (record-vector-length r))


  (define (record-vector-ref r index . default)
    (if (exact-integer? index)
        (vector-ref (mcdr r) index)
        (cond ((assq index (mcar r)) => (lambda (ix) (vector-ref (mcdr r) (cdr ix))))
              (else (or (and (pair? default) (car default)) #f)))))

  (define-syntax rv-ref
    (syntax-rules ()
      ((_ r prop) (record-vector-ref r prop))
      ((_ r prop1 prop2 ...)
       (rv-ref (record-vector-ref r prop1) prop2 ...))))


  (define (record-vector-update! r index value)
    (cond ((exact-integer? index)
           (vector-set! (mcdr r) index value))
          (else
           (cond ((assq index (mcar r)) => (lambda (i) (vector-set! (mcdr r) (cdr i) value)))
                 (else (set-mcar! r (reverse
                                     (cons (cons index (vector-length (mcdr r)))
                                           (reverse (mcar r)))))
                       (set-mcdr! r (vector-extend (mcdr r)
                                                   (+ 1 (vector-length (mcdr r))) value)))))))

  (define-syntax rv-update!
    (syntax-rules ()
      ((_ r prop val) (record-vector-update! r prop val))
      ((_ r prop1 prop2 val)
       (record-vector-update! (record-vector-ref r prop1) prop2 val))
      ((_ r prop1 prop2 ...)
       (rv-update! (record-vector-ref r prop1) prop2 ...))))


  (define (record-vector-attr? r k)
    (assq k (mcar r)))

  (define-syntax-rule (rv-attr? r k) (record-vector-attr? r k))


  (define (record-vector-set! r index value)
    (cond ((exact-integer? index)
           (vector-set! (mcdr r) index value))
          (else (vector-set! (mcdr r) (cdr (assq index (mcar r))) value))))

  (define-syntax rv-set!
    (syntax-rules ()
      ((_ r prop val) (record-vector-set! r prop val))
      ((_ r prop1 prop2 val)
       (record-vector-set! (record-vector-ref r prop1) prop2 val))
      ((_ r prop1 prop2 ...)
       (rv-set! (record-vector-ref r prop1) prop2 ...))))


  (define (record-vector-clone src . r)
    (define (record-copy rvec)
      (do ((i 0 (+ i 1)) (newvec (make-vector (vector-length rvec))))
          ((= i (vector-length newvec)) newvec)
        (let ((val (vector-ref rvec i)))
          (vector-set! newvec i
                       (if (record-vector? val)
                           (record-vector-clone val)
                           val)))))
    (let ((dst (mcons (mcar src) (record-copy (mcdr src)))))
      (let loop ((defs r))
        (unless (null? defs)
          (cond ((and (keyword? (car defs)) (pair? (cdr defs)) (not (keyword? (cadr defs))))
                 (record-vector-update! dst (car defs) (cadr defs))
                 (loop (cddr defs)))
                (else (error "unmatched keyword in " r)))))
      dst))

  (define-syntax-rule (rv-clone r k ...) (record-vector-clone r k ...))

  (define (record-vector-like? rv etrv)
    (define hlp
      (lambda (props et)
        (call/cc
         (lambda (k)
           (for-each
            (lambda (e)
              (unless (assq (car e) props)
                (k #f)))
            (mcar et))
           #t))))
    (cond ((and (null? (mcar rv)) (null? (mcar etrv))) #t)
          ((or (null? (mcar rv)) (null? (mcar etrv))) #f)
          (else
           (or (hlp (mcar rv) etrv) (hlp (mcar etrv) rv)))))


  (define-syntax-rule (rv-like? left right) (record-vector-like? left right))

  ) ;; end of module