Association Vectors

avector.scm

(use-modules (srfi srfi-43)) ;; for extra vector functions

(define (vassociation-procedure equalfn ref)
  (lambda (key avec)
    (let ((idx (vector-index (lambda (x) (equalfn (ref x) key)) avec)))
      (vector-ref avec idx))))

(define vassq  (vassociation-procedure eq? car))
(define vassv  (vassociation-procedure eqv? car))
(define vassoc (vassociation-procedure equal? car))

(define (vassociation-ref-procedure vassocation-procedure)
  (lambda (key avec)
    (cdr (vassocation-procedure key avec))))

(define vassq-ref  (vassociation-ref-procedure vassq))
(define vassv-ref  (vassociation-ref-procedure vassv))
(define vassoc-ref (vassociation-ref-procedure vassoc))

(define (vassociation-set! equalfn ref)
  (lambda (key newval avec)
    (let ((idx (vector-index (lambda (x) (equalfn (ref x) key)) avec)))
      (vector-set! avec idx (cons key newval)))))

(define vassq-set!  (vassociation-set! eq? car))
(define vassv-set!  (vassociation-set! eqv? car))
(define vassoc-set! (vassociation-set! equal? car))

(define (vassociation-set equalfn ref)
  (lambda (key newval avec)
    (vector-fold
     (lambda (i a x)
       (vector-append a
                      (vector
                       (if (equalfn (ref x) key)
                           (cons key newval)
                           x))))
     #()
     avec)))
(define vassq-set  (vassociation-set eq? car))
(define vassv-set  (vassociation-set eqv? car))
(define vassoc-set (vassociation-set equal? car))


(define (vacons key val avec)
  (vector-append (vector (cons key val)) avec))

(define (vassociation-remove! equalfn ref)
  (lambda (key avec)
    (vector-fold
     (lambda (i a x)
       (if (equalfn (ref x) key)
           a
           (vector-append a (vector x))))
     #()
     avec)))

(define vassq-remove!  (vassociation-remove! eq? car))
(define vassv-remove!  (vassociation-remove! eqv? car))
(define vassoc-remove! (vassociation-remove! equal? car))