cons (cons key value) vhash #t))
         (base      (vlist-base vhash))
         (offset    (vlist-offset vhash))
         (size      (block-size base))
         (khash     (hash key size))
         (content   (block-content base)))
    (block-hash-table-add! content size khash offset)
    vhash))

(define vhash-consq (cut vhash-cons <> <> <> hashq))
(define vhash-consv (cut vhash-cons <> <> <> hashv))

(define-inlinable (%vhash-fold* proc init key vhash equal? hash)
  ;; Fold over all the values associated with KEY in VHASH.
  (define (visit-block base max-offset result)
    (let* ((size (block-size base))
           (content (block-content base))
           (khash (hash key size)))
      (let loop ((offset (block-hash-table-ref content size khash))
                 (result result))
        (if offset
            (loop (block-hash-table-next-offset content size offset)
                  (if (and (<= offset max-offset)
                           (equal? key (car (block-ref content offset))))
                      (proc (cdr (block-ref content offset)) result)
                      result))
            (let ((next-block (block-base base)))
              (if (> (block-size next-block) 0)
                  (visit-block next-block (block-offset base) result)
                  result))))))

  (assert-vlist vhash)
  (if (> (block-size (vlist-base vhash)) 0)
      (visit-block (vlist-base vhash)
                   (vlist-offset vhash)
                   init)
      init))

(define* (vhash-fold* proc init key vhash
                      #:optional (equal? equal?) (hash hash))
  "Fold over all the values associated with KEY in VHASH, with each
call to PROC having the form ‘(proc value result)’, where
RESULT is the result of the previous call to PROC and INIT the
value of RESULT for the first call to PROC."
  (%vhash-fold* proc init key vhash equal? hash))

(define (vhash-foldq* proc init key vhash)
  "Same as ‘vhash-fold*’, but using ‘hashq’ and ‘eq?’."
  (%vhash-fold* proc init key vhash eq? hashq))

(define (vhash-foldv* proc init key vhash)
  "Same as ‘vhash-fold*’, but using ‘hashv’ and ‘eqv?’."
  (%vhash-fold* proc init key vhash eqv? hashv))

(define-inlinable (%vhash-assoc key vhash equal? hash)
  ;; A specialization of `vhash-fold*' that stops when the first value
  ;; associated with KEY is found or when the end-of-list is reached.  Inline to
  ;; make sure `vhash-assq' gets to use the `eq?' instruction instead of calling
  ;; the `eq?'  subr.
  (define (visit-block base max-offset)
    (let* ((size (block-size base))
           (content (block-content base))
           (khash (hash key size)))
      (let loop ((offset (block-hash-table-ref content size khash)))
        (if offset
            (if (and (<= offset max-offset)
                     (equal? key (car (block-ref content offset))))
                (block-ref content offset)
                (loop (block-hash-table-next-offset content size offset)))
            (let ((next-block (block-base base)))
              (and (> (block-size next-block) 0)
                   (visit-block next-block (block-offset base))))))))

  (assert-vlist vhash)
  (and (> (block-size (vlist-base vhash)) 0)
       (visit-block (vlist-base vhash)
                    (vlist-offset vhash))))

(define* (vhash-assoc key vhash #:optional (equal? equal?) (hash hash))
  "Return the first key/value pair from VHASH whose key is equal to
KEY according to the EQUAL? equality predicate."
  (%vhash-assoc key vhash equal? hash))

(define (vhash-assq key vhash)
  "Return the first key/value pair from VHASH whose key is ‘eq?’ to
KEY."
  (%vhash-assoc key vhash eq? hashq))

(define (vhash-assv key vhash)
  "Return the first key/value pair from VHASH whose key is ‘eqv?’ to
KEY."
  (%vhash-assoc key vhash eqv? hashv))

(define* (vhash-delete key vhash #:optional (equal? equal?) (hash hash))
  "Remove all associations from VHASH with KEY, comparing keys
with EQUAL?."
  (if (vhash-assoc key vhash equal? hash)
      (vlist-fold (lambda (k+v result)
                    (let ((k (car k+v))
                          (v (cdr k+v)))
                      (if (equal? k key)
                          result
                          (vhash-cons k v result hash))))
                  vlist-null
                  vhash)
      vhash))

(define vhash-delq (cut vhash-delete <> <> eq? hashq))
(define vhash-delv (cut vhash-delete <> <> eqv? hashv))

(define (vhash-fold proc init vhash)
  "Fold over the key/pair elements of VHASH from left to right, with
each call to PROC having the form ‘(PROC key value result)’,
where RESULT is the result of the previous call to PROC and
INIT the value of RESULT for the first call to PROC."
  (vlist-fold (lambda (key+value result)
                (proc (car key+value) (cdr key+value)
                      result))
              init
              vhash))

(define (vhash-fold-right proc init vhash)
  "Fold over the key/pair elements of VHASH from right to left, with
each call to PROC having the form ‘(PROC key value result)’,
where RESULT is the result of the previous call to PROC and
INIT the value of RESULT for the first call to PROC."
  (vlist-fold-right (lambda (key+value result)
                      (proc (car key+value) (cdr key+value)
                            result))
                    init
                    vhash))

(define* (alist->vhash alist #:optional (hash hash))
  "Return the vhash corresponding to ALIST, an association list."
  (fold-right (lambda (pair result)
                (vhash-cons (car pair) (cdr pair) result hash))
              vlist-null
              alist))

;;; vlist.scm ends here