593 lines
21 KiB
Scheme
593 lines
21 KiB
Scheme
;;; -*- mode: scheme; coding: utf-8; -*-
|
||
;;;
|
||
;;; Copyright (C) 2009, 2010, 2011, 2012, 2024 Free Software Foundation, Inc.
|
||
;;;
|
||
;;; This library is free software; you can redistribute it and/or
|
||
;;; modify it under the terms of the GNU Lesser General Public
|
||
;;; License as published by the Free Software Foundation; either
|
||
;;; version 3 of the License, or (at your option) any later version.
|
||
;;;
|
||
;;; This library is distributed in the hope that it will be useful,
|
||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
;;; Lesser General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU Lesser General Public
|
||
;;; License along with this library; if not, write to the Free Software
|
||
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
|
||
;;; Author: Ludovic Courtès <ludo@gnu.org>
|
||
;;;
|
||
;;; Commentary:
|
||
;;;
|
||
;;; This is a port of Guile's (ice-9 vlist) for Hoot. It is derived from the
|
||
;;; upstream module and differs only as necessary to work with Hoot. The
|
||
;;; original developer's commentary continues below.
|
||
;;;
|
||
;;; This module provides an implementations of vlists, a functional list-like
|
||
;;; data structure described by Phil Bagwell in "Fast Functional Lists,
|
||
;;; Hash-Lists, Dequeues and Variable-Length Arrays", EPFL Technical Report,
|
||
;;; 2002.
|
||
;;;
|
||
;;; The idea is to store vlist elements in increasingly large contiguous blocks
|
||
;;; (implemented as vectors here). These blocks are linked to one another using
|
||
;;; a pointer to the next block (called `block-base' here) and an offset within
|
||
;;; that block (`block-offset' here). The size of these blocks form a geometric
|
||
;;; series with ratio `block-growth-factor'.
|
||
;;;
|
||
;;; In the best case (e.g., using a vlist returned by `list->vlist'),
|
||
;;; elements from the first half of an N-element vlist are accessed in O(1)
|
||
;;; (assuming `block-growth-factor' is 2), and `vlist-length' takes only
|
||
;;; O(ln(N)). Furthermore, the data structure improves data locality since
|
||
;;; vlist elements are adjacent, which plays well with caches.
|
||
;;;
|
||
;;; Code:
|
||
|
||
(define-module (ice-9 vlist)
|
||
#:use-module (hoot hashtables)
|
||
#:use-module ((hoot lists) #:select (fold))
|
||
#:use-module (srfi srfi-9)
|
||
#:export (vlist? vlist-cons vlist-head vlist-tail vlist-null?
|
||
vlist-null list->vlist vlist-ref vlist-drop vlist-take
|
||
vlist-length vlist-fold vlist-fold-right vlist-map
|
||
vlist-unfold vlist-unfold-right vlist-append
|
||
vlist-reverse vlist-filter vlist-delete vlist->list
|
||
vlist-for-each
|
||
block-growth-factor
|
||
|
||
vhash? vhash-cons vhash-consq vhash-consv
|
||
vhash-assoc vhash-assq vhash-assv
|
||
vhash-delete vhash-delq vhash-delv
|
||
vhash-fold vhash-fold-right
|
||
vhash-fold* vhash-foldq* vhash-foldv*
|
||
alist->vhash))
|
||
|
||
;;; Hoot Hacks™ (not really ™)
|
||
|
||
;; XXX hashes using equal? and eqv? have not been defined; use only eq?
|
||
(define hash hashq)
|
||
(define hashv hashq)
|
||
(define (fold-right proc init lst)
|
||
(fold proc init (reverse lst)))
|
||
|
||
|
||
;;;
|
||
;;; VList Blocks and Block Descriptors.
|
||
;;;
|
||
|
||
(define block-growth-factor
|
||
(make-fluid 2))
|
||
|
||
(define (make-block base offset size hash-tab?)
|
||
;; Return a block (and block descriptor) of SIZE elements pointing to
|
||
;; BASE at OFFSET. If HASH-TAB? is true, we also reserve space for a
|
||
;; "hash table". Note: We use `next-free' instead of `last-used' as
|
||
;; suggested by Bagwell.
|
||
(if hash-tab?
|
||
(vector (make-vector (* size 3) #f)
|
||
base offset size 0)
|
||
(vector (make-vector size)
|
||
base offset size 0)))
|
||
|
||
(define-syntax define-block-accessor
|
||
(syntax-rules ()
|
||
((_ name index)
|
||
(define (name block)
|
||
(vector-ref block index)))))
|
||
|
||
(define-block-accessor block-content 0)
|
||
(define-block-accessor block-base 1)
|
||
(define-block-accessor block-offset 2)
|
||
(define-block-accessor block-size 3)
|
||
(define-block-accessor block-next-free 4)
|
||
|
||
(define (block-hash-table? block)
|
||
(< (block-size block) (vector-length (block-content block))))
|
||
|
||
(define (set-block-next-free! block next-free)
|
||
(vector-set! block 4 next-free))
|
||
|
||
(define (block-append! block value offset)
|
||
;; This is not thread-safe. To fix it, see Section 2.8 of the paper.
|
||
(and (< offset (block-size block))
|
||
(= offset (block-next-free block))
|
||
(begin
|
||
(set-block-next-free! block (+ offset 1))
|
||
(vector-set! (block-content block) offset value)
|
||
#t)))
|
||
|
||
;; Return the item at slot OFFSET.
|
||
(define (block-ref content offset)
|
||
(vector-ref content offset))
|
||
|
||
;; Return the offset of the next item in the hash bucket, after the one
|
||
;; at OFFSET.
|
||
(define (block-hash-table-next-offset content size offset)
|
||
(vector-ref content (+ size size offset)))
|
||
|
||
;; Save the offset of the next item in the hash bucket, after the one
|
||
;; at OFFSET.
|
||
(define (block-hash-table-set-next-offset! content size offset
|
||
next-offset)
|
||
(vector-set! content (+ size size offset) next-offset))
|
||
|
||
;; Returns the index of the last entry stored in CONTENT with
|
||
;; SIZE-modulo hash value KHASH.
|
||
(define (block-hash-table-ref content size khash)
|
||
(vector-ref content (+ size khash)))
|
||
|
||
(define (block-hash-table-set! content size khash offset)
|
||
(vector-set! content (+ size khash) offset))
|
||
|
||
;; Add hash table information for the item recently added at OFFSET,
|
||
;; with SIZE-modulo hash KHASH.
|
||
(define (block-hash-table-add! content size khash offset)
|
||
(block-hash-table-set-next-offset! content size offset
|
||
(block-hash-table-ref content size khash))
|
||
(block-hash-table-set! content size khash offset))
|
||
|
||
(define block-null
|
||
;; The null block.
|
||
(make-block #f 0 0 #f))
|
||
|
||
|
||
;;;
|
||
;;; VLists.
|
||
;;;
|
||
|
||
(define-record-type <vlist>
|
||
;; A vlist is just a base+offset pair pointing to a block.
|
||
|
||
;; XXX: Allocating a <vlist> record in addition to the block at each
|
||
;; `vlist-cons' call is inefficient. However, Bagwell's hack to avoid it
|
||
;; (Section 2.2) would require GC_ALL_INTERIOR_POINTERS, which would be a
|
||
;; performance hit for everyone.
|
||
(make-vlist base offset)
|
||
vlist?
|
||
(base vlist-base)
|
||
(offset vlist-offset))
|
||
|
||
(define vlist-null
|
||
;; The empty vlist.
|
||
(make-vlist block-null 0))
|
||
|
||
;; Asserting that something is a vlist is actually a win if your next
|
||
;; step is to call record accessors, because that causes CSE to
|
||
;; eliminate the type checks in those accessors.
|
||
;;
|
||
(define (assert-vlist val)
|
||
(unless (vlist? val)
|
||
(error "Not a vlist: " (list val))))
|
||
|
||
(define (block-cons item vlist hash-tab?)
|
||
(let ((base (vlist-base vlist))
|
||
(offset (+ (vlist-offset vlist) 1)))
|
||
(cond
|
||
((block-append! base item offset)
|
||
;; Fast path: We added the item directly to the block.
|
||
(make-vlist base offset))
|
||
(else
|
||
;; Slow path: Allocate a new block.
|
||
(let* ((size (block-size base))
|
||
(base (make-block
|
||
base
|
||
(- offset 1)
|
||
(cond
|
||
((zero? size) 1)
|
||
((< offset size) 1) ;; new vlist head
|
||
(else (* (fluid-ref block-growth-factor) size)))
|
||
hash-tab?)))
|
||
(set-block-next-free! base 1)
|
||
(vector-set! (block-content base) 0 item)
|
||
(make-vlist base 0))))))
|
||
|
||
(define (vlist-cons item vlist)
|
||
"Return a new vlist with ITEM as its head and VLIST as its
|
||
tail."
|
||
;; Note: Although the result of `vlist-cons' on a vhash is a valid
|
||
;; vlist, it is not a valid vhash. The new item does not get a hash
|
||
;; table entry. If we allocate a new block, the new block will not
|
||
;; have a hash table. Perhaps we can do something more sensible here,
|
||
;; but this is a hot function, so there are performance impacts.
|
||
(assert-vlist vlist)
|
||
(block-cons item vlist #f))
|
||
|
||
(define (vlist-head vlist)
|
||
"Return the head of VLIST."
|
||
(assert-vlist vlist)
|
||
(let ((base (vlist-base vlist))
|
||
(offset (vlist-offset vlist)))
|
||
(block-ref (block-content base) offset)))
|
||
|
||
(define (vlist-tail vlist)
|
||
"Return the tail of VLIST."
|
||
(assert-vlist vlist)
|
||
(let ((base (vlist-base vlist))
|
||
(offset (vlist-offset vlist)))
|
||
(if (> offset 0)
|
||
(make-vlist base (- offset 1))
|
||
(make-vlist (block-base base)
|
||
(block-offset base)))))
|
||
|
||
(define (vlist-null? vlist)
|
||
"Return true if VLIST is empty."
|
||
(assert-vlist vlist)
|
||
(let ((base (vlist-base vlist)))
|
||
(and (not (block-base base))
|
||
(= 0 (block-size base)))))
|
||
|
||
|
||
;;;
|
||
;;; VList Utilities.
|
||
;;;
|
||
|
||
(define (list->vlist lst)
|
||
"Return a new vlist whose contents correspond to LST."
|
||
(vlist-reverse (fold vlist-cons vlist-null lst)))
|
||
|
||
(define (vlist-fold proc init vlist)
|
||
"Fold over VLIST, calling PROC for each element."
|
||
;; FIXME: Handle multiple lists.
|
||
(assert-vlist vlist)
|
||
(let loop ((base (vlist-base vlist))
|
||
(offset (vlist-offset vlist))
|
||
(result init))
|
||
(if (eq? base block-null)
|
||
result
|
||
(let* ((next (- offset 1))
|
||
(done? (< next 0)))
|
||
(loop (if done? (block-base base) base)
|
||
(if done? (block-offset base) next)
|
||
(proc (block-ref (block-content base) offset) result))))))
|
||
|
||
(define (vlist-fold-right proc init vlist)
|
||
"Fold over VLIST, calling PROC for each element, starting from
|
||
the last element."
|
||
(assert-vlist vlist)
|
||
(let loop ((index (- (vlist-length vlist) 1))
|
||
(result init))
|
||
(if (< index 0)
|
||
result
|
||
(loop (- index 1)
|
||
(proc (vlist-ref vlist index) result)))))
|
||
|
||
(define (vlist-reverse vlist)
|
||
"Return a new VLIST whose content are those of VLIST in reverse
|
||
order."
|
||
(vlist-fold vlist-cons vlist-null vlist))
|
||
|
||
(define (vlist-map proc vlist)
|
||
"Map PROC over the elements of VLIST and return a new vlist."
|
||
(vlist-fold (lambda (item result)
|
||
(vlist-cons (proc item) result))
|
||
vlist-null
|
||
(vlist-reverse vlist)))
|
||
|
||
(define (vlist->list vlist)
|
||
"Return a new list whose contents match those of VLIST."
|
||
(vlist-fold-right cons '() vlist))
|
||
|
||
(define (vlist-ref vlist index)
|
||
"Return the element at index INDEX in VLIST."
|
||
(assert-vlist vlist)
|
||
(let loop ((index index)
|
||
(base (vlist-base vlist))
|
||
(offset (vlist-offset vlist)))
|
||
(if (<= index offset)
|
||
(block-ref (block-content base) (- offset index))
|
||
(loop (- index offset 1)
|
||
(block-base base)
|
||
(block-offset base)))))
|
||
|
||
(define (vlist-drop vlist count)
|
||
"Return a new vlist that does not contain the COUNT first elements of
|
||
VLIST."
|
||
(assert-vlist vlist)
|
||
(let loop ((count count)
|
||
(base (vlist-base vlist))
|
||
(offset (vlist-offset vlist)))
|
||
(if (<= count offset)
|
||
(make-vlist base (- offset count))
|
||
(loop (- count offset 1)
|
||
(block-base base)
|
||
(block-offset base)))))
|
||
|
||
(define (vlist-take vlist count)
|
||
"Return a new vlist that contains only the COUNT first elements of
|
||
VLIST."
|
||
(let loop ((count count)
|
||
(vlist vlist)
|
||
(result vlist-null))
|
||
(if (= 0 count)
|
||
(vlist-reverse result)
|
||
(loop (- count 1)
|
||
(vlist-tail vlist)
|
||
(vlist-cons (vlist-head vlist) result)))))
|
||
|
||
(define (vlist-filter pred vlist)
|
||
"Return a new vlist containing all the elements from VLIST that
|
||
satisfy PRED."
|
||
(vlist-fold-right (lambda (e v)
|
||
(if (pred e)
|
||
(vlist-cons e v)
|
||
v))
|
||
vlist-null
|
||
vlist))
|
||
|
||
(define* (vlist-delete x vlist #:optional (equal? equal?))
|
||
"Return a new vlist corresponding to VLIST without the elements
|
||
EQUAL? to X."
|
||
(vlist-filter (lambda (e)
|
||
(not (equal? e x)))
|
||
vlist))
|
||
|
||
(define (vlist-length vlist)
|
||
"Return the length of VLIST."
|
||
(assert-vlist vlist)
|
||
(let loop ((base (vlist-base vlist))
|
||
(len (vlist-offset vlist)))
|
||
(if (eq? base block-null)
|
||
len
|
||
(loop (block-base base)
|
||
(+ len 1 (block-offset base))))))
|
||
|
||
(define* (vlist-unfold p f g seed
|
||
#:optional (tail-gen (lambda (x) vlist-null)))
|
||
"Return a new vlist. See the description of SRFI-1 `unfold' for details."
|
||
(let uf ((seed seed))
|
||
(if (p seed)
|
||
(tail-gen seed)
|
||
(vlist-cons (f seed)
|
||
(uf (g seed))))))
|
||
|
||
(define* (vlist-unfold-right p f g seed #:optional (tail vlist-null))
|
||
"Return a new vlist. See the description of SRFI-1 `unfold-right' for
|
||
details."
|
||
(let uf ((seed seed) (lis tail))
|
||
(if (p seed)
|
||
lis
|
||
(uf (g seed) (vlist-cons (f seed) lis)))))
|
||
|
||
(define (vlist-append . vlists)
|
||
"Append the given lists."
|
||
(if (null? vlists)
|
||
vlist-null
|
||
(fold-right (lambda (vlist result)
|
||
(vlist-fold-right (lambda (e v)
|
||
(vlist-cons e v))
|
||
result
|
||
vlist))
|
||
vlist-null
|
||
vlists)))
|
||
|
||
(define (vlist-for-each proc vlist)
|
||
"Call PROC on each element of VLIST. The result is unspecified."
|
||
(vlist-fold (lambda (item x)
|
||
(proc item))
|
||
(if #f #f)
|
||
vlist))
|
||
|
||
|
||
;;;
|
||
;;; Hash Lists, aka. `VHash'.
|
||
;;;
|
||
|
||
;; Assume keys K1 and K2, H = hash(K1) = hash(K2), and two values V1 and V2
|
||
;; associated with K1 and K2, respectively. The resulting layout is a
|
||
;; follows:
|
||
;;
|
||
;; ,--------------------.
|
||
;; 0| ,-> (K1 . V1) | Vlist array
|
||
;; 1| | |
|
||
;; 2| | (K2 . V2) |
|
||
;; 3| | |
|
||
;; size +-|------------------+
|
||
;; 0| | | Hash table
|
||
;; 1| | |
|
||
;; 2| +-- O <------------- H
|
||
;; 3| | |
|
||
;; size * 2 +-|------------------+
|
||
;; 0| `-> 2 | Chain links
|
||
;; 1| |
|
||
;; 2| #f |
|
||
;; 3| |
|
||
;; size * 3 `--------------------'
|
||
;;
|
||
;; The backing store for the vhash is partitioned into three areas: the
|
||
;; vlist part, the hash table part, and the chain links part. In this
|
||
;; example we have a hash H which, when indexed into the hash table
|
||
;; part, indicates that a value with this hash can be found at offset 0
|
||
;; in the vlist part. The corresponding index (in this case, 0) of the
|
||
;; chain links array holds the index of the next element in this block
|
||
;; with this hash value, or #f if we reached the end of the chain.
|
||
;;
|
||
;; This API potentially requires users to repeat which hash function and
|
||
;; which equality predicate to use. This can lead to unpredictable
|
||
;; results if they are used in consistenly, e.g., between `vhash-cons'
|
||
;; and `vhash-assoc', which is undesirable, as argued in
|
||
;; http://savannah.gnu.org/bugs/?22159 . OTOH, two arguments can be
|
||
;; made in favor of this API:
|
||
;;
|
||
;; - It's consistent with how alists are handled in SRFI-1.
|
||
;;
|
||
;; - In practice, users will probably consistenly use either the `q',
|
||
;; the `v', or the plain variant (`vlist-cons' and `vlist-assoc'
|
||
;; without any optional argument), i.e., they will rarely explicitly
|
||
;; pass a hash function or equality predicate.
|
||
|
||
(define (vhash? obj)
|
||
"Return true if OBJ is a hash list."
|
||
(and (vlist? obj)
|
||
(block-hash-table? (vlist-base obj))))
|
||
|
||
(define* (vhash-cons key value vhash #:optional (hash hash))
|
||
"Return a new hash list based on VHASH where KEY is associated
|
||
with VALUE. Use HASH to compute KEY's hash."
|
||
(assert-vlist vhash)
|
||
;; We should also assert that it is a hash table. Need to check the
|
||
;; performance impacts of that. Also, vlist-null is a valid hash
|
||
;; table, which does not pass vhash?. A bug, perhaps.
|
||
(let* ((vhash (block-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 key value vhash)
|
||
(vhash-cons key value vhash hashq))
|
||
(define (vhash-consv key value vhash)
|
||
(vhash-cons key value vhash hashv))
|
||
|
||
(define (%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 (%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 key vhash)
|
||
(vhash-delete key vhash eq? hashq))
|
||
(define (vhash-delv key vhash)
|
||
(vhash-delete key vhash 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
|