;;;;;; Riatables: alternative hash tables -*- Scheme -*-
;;;;;; Thread-unsafe implementation
;;; Taylor Campbell wrote this code; he places it in the public domain.
(define-record-type table type/table
(really-make-table id
template
size
gc-stamp
bucket-vector)
table?
(id table-id)
(template table-template)
(size table-size set-table-size!)
(gc-stamp table-gc-stamp set-table-gc-stamp!)
(bucket-vector table-bucket-vector set-table-bucket-vector!))
(define-record-discloser type/table
(lambda (table)
`(,(or (table-type-name table) 'table)
,@(cond ((table-id table) => list) (else '()))
,(table-size table))))
;;; --------------------
;;; Parameters
;;; These are just guesses. I ought to fill in better suggestions at
;;; some point, but these will do for now.
;;; The number of buckets to put in freshly created tables.
(define initial-bucket-count 10)
;;; The next number of buckets to have in a table after PREVIOUS.
(define (next-bucket-count previous)
(+ (* previous 2) 1))
;;; The maximum average number of entries to have in a bucket.
(define maximum-average-bucket-entries 3)
;;; --------------------
;;; Table templates
;;; This code is rather too verbose for my tastes. At least there can
;;; be a DEFINE-TEMPLATE-ACCESSOR macro to reduce code tedium.
(define-record-type table-template type/table-template
(really-make-table-template type-name
key-predicate
key-comparator
key-hasher
gc-sensitive?
head-weak?
tail-weak?
searcher
expander)
table-template?
(type-name table-template-type-name)
(key-predicate table-template-key-predicate)
(key-comparator table-template-key-comparator)
(key-hasher table-template-key-hasher)
(gc-sensitive? table-template-gc-sensitive?)
(head-weak? table-template-head-weak?)
(tail-weak? table-template-tail-weak?)
(searcher table-template-searcher)
(expander table-template-expander))
(define-record-discloser type/table-template
(lambda (t)
`(table-template ,@(cond ((table-template-type-name t) => list)
(else '())))))
(define-syntax define-template-accessors
(syntax-rules ()
((define-template-accessors (table template) ...)
(begin (define (table t)
(template (table-template t)))
...))))
(define-template-accessors
(table-type-name table-template-type-name)
(table-key-predicate table-template-key-predicate)
(table-key-comparator table-template-key-comparator)
(table-key-hasher table-template-key-hasher)
(table-gc-sensitive? table-template-gc-sensitive?)
(table-head-weak? table-template-head-weak?)
(table-tail-weak? table-template-tail-weak?)
(table-searcher table-template-searcher)
(table-expander table-template-expander))
(define (make-table-template key? key= key-hash
gc? head-weak? tail-weak?
type-name)
(let* ((rehasher (make-table-rehasher key-hash
gc? head-weak? tail-weak?))
(hasher (make-table-hasher key-hash gc? rehasher)))
(really-make-table-template
type-name
key? key= key-hash
gc? head-weak? tail-weak?
(make-table-searcher key= hasher gc?
head-weak? tail-weak?)
(make-table-expander hasher gc?
head-weak? tail-weak?
rehasher))))
(define (make-weak-table-template key? key= key-hash gc? type-name)
(make-table-template key? key= key-hash gc? #t #t type-name))
(define (make-strong-table-template key? key= key-hash gc? type-name)
(make-table-template key? key= key-hash gc? #f #f type-name))
(define (modify-table-template-weakness template head-weak? tail-weak?)
(make-table-template (table-template-key-predicate template)
(table-template-key-comparator template)
(table-template-key-hasher template)
(table-template-gc-sensitive? template)
head-weak?
tail-weak?
(table-template-type-name template)))
(define-syntax define-weakness-modifiers
(syntax-rules ()
((define-weakness-modifiers
(name template head? tail?)
...)
(begin (define (name template)
(modify-table-template-weakness template head? tail?))
...))))
(define-weakness-modifiers
(weaken-table-template t #t #t)
(head-weaken-table-template t #t (table-template-tail-weak? t))
(tail-weaken-table-template t (table-template-head-weak? t) #t)
(strengthen-table-template t #f #f)
(head-strengthen-table-template t #f (table-template-tail-weak? t))
(tail-strengthen-table-template t (table-template-head-weak? t) #f))
;;; --------------------
;;; Constructors
(define (%make-table-from-template template suggested-size id)
(let ((gc? (table-template-gc-sensitive? template)))
(really-make-table id
template
0
(and gc? (gc-stamp))
(make-vector
(if (and suggested-size
(> suggested-size
maximum-average-bucket-entries))
(quotient suggested-size
maximum-average-bucket-entries)
initial-bucket-count)
(empty-bucket)))))
(define (table-constructor template)
(let ((name `(table-constructor ,template)))
(lambda size+id
(receive (suggested-size id)
(table-cons-options size+id name)
(%make-table-from-template template suggested-size id)))))
(define (make-table-from-template template . size+id)
(receive (suggested-size id)
(table-cons-options size+id make-table-from-template)
(%make-table-from-template template suggested-size id)))
(define (table-cons-options options callee)
(if (null? options)
(values #f #f)
(let ((size (car options))
(more (cdr options)))
(if (or (integer? size) (not size))
(if (null? more)
(values size #f)
(let ((name (car more))
(more (cdr more)))
(if (null? more)
(values size name)
(error "extraneous arguments" more callee))))
(error "invalid table size suggestion argument"
size
callee)))))
;;; --------------------
;;; Main table operations
;;; This is a macro so that it gets integrated and debugging info is
;;; retained about the procedure.
(define-syntax define-keyed-table-operation
(syntax-rules ()
((define-keyed-table-operation (name table-arg key-arg arg ...)
(bucket-index-var entry-var)
body1 body2 ...)
(define (name table-arg key-arg arg ...)
(cond ((not (table? table-arg))
(call-error "invalid table argument" name
table-arg key-arg arg ...))
((not ((table-key-predicate table-arg) key-arg))
(call-error "invalid key argument" name
table-arg key-arg arg ...))
(else
(receive (bucket-index-var entry-var)
((table-searcher table-arg)
table-arg key-arg)
body1 body2 ...)))))))
(define-keyed-table-operation (table-entry table key)
(bucket-index entry)
(and entry
(let ((tail-weak? (table-tail-weak? table)))
(cond ((not tail-weak?)
(entry-value entry))
((weak-entry-value entry))
(else ; Broken weak entry.
(expunge-entry-from-table! table bucket-index entry)
#f)))))
(define-keyed-table-operation (set-table-entry! table key value)
(bucket-index entry)
(cond ((not value)
(cond (entry
(expunge-entry-from-table! table bucket-index entry)
(if (table-tail-weak? table)
(set-weak-entry-value! entry #f)
(set-entry-value! entry #f)))))
(entry
(if (table-tail-weak? table)
(set-weak-entry-value! entry #f)
(set-entry-value! entry #f)))
(bucket-index
((table-expander table) table bucket-index key value))))
(define-keyed-table-operation (modify-table-entry! table key modifier)
(bucket-index entry)
(cond (entry
;; We don't need to set the entry's value to be #F here: both
;; of the modifiers will set the entry to #F if MODIFIER
;; returns it.
(if (not (if (table-tail-weak? table)
(modify-weak-entry-value! entry modifier)
(modify-entry-value! entry modifier)))
(expunge-entry-from-table! table bucket-index entry)))
((modifier #f)
=> (lambda (new-value)
((table-expander table)
table bucket-index key new-value)))))
(define-keyed-table-operation (pop-table-entry! table key)
(bucket-index entry)
(and entry
(begin (expunge-entry-from-table! table bucket-index entry)
(if (table-tail-weak? table)
(weak-entry-value entry)
(entry-value entry)))))
;++ This should also clean out any of the table's broken weak entries.
(define (table->alist table)
(let* ((buckets (table-bucket-vector table))
(bcount (vector-length buckets))
(cons-entry
(let ((head-weak? (table-head-weak? table))
(tail-weak? (table-tail-weak? table)))
(cond ((and head-weak? tail-weak?)
(lambda (entry alist)
(cond ((weak-entry-key entry)
=> (lambda (k)
(cond ((weak-entry-value entry)
=> (lambda (v)
(cons (cons k v) alist)))
(else alist))))
(else alist))))
(head-weak?
(lambda (entry alist)
(cond ((weak-entry-key entry)
=> (lambda (k)
(cons (cons k (entry-value entry))
alist)))
(else alist))))
(tail-weak?
(lambda (entry alist)
(cond ((weak-entry-value entry)
=> (lambda (v)
(cons (cons (entry-key entry) v)
alist)))
(else alist))))
(else
(lambda (entry alist)
(cons (cons (entry-key entry) (entry-value entry))
alist)))))))
(let outer-loop ((alist '())
(i 0))
(if (= i bcount)
alist
(let inner-loop ((alist alist)
(bucket (vector-ref buckets i)))
(if (bucket-empty? bucket)
(outer-loop alist (+ i 1))
(inner-loop (cons-entry (bucket-entry bucket) alist)
(bucket-next bucket))))))))
(define (walk-table table proc)
(for-each (lambda (k.v) (proc (car k.v) (cdr k.v)))
(table->alist table)))
;;; --------------------
;;; Buckets
;;; Buckets are represented as alists, because ASSQ in the Scheme48 VM
;;; is fast. However, this is no longer useful: using ASSQ was an
;;; optimization hack that would lose with optimistic concurrency, so
;;; it is no longer used. A more space-efficient representation could,
;;; and probably should, be chosen now with no adverse effects on time
;;; efficiency.
;;; All these trivial procedures are procedures, not direct aliases, so
;;; that the silly Scheme48 automatic procedure integrator, which has
;;; much too low a threshold and no provision for alias integration,
;;; will integrate them.
(define (empty-bucket) '())
(define (bucket-empty? bucket) (null? bucket))
(define (bucket-nonempty? bucket) (pair? bucket))
(define (make-bucket entry next) (cons entry next))
(define (bucket-entry bucket) (car bucket))
(define (bucket-next bucket) (cdr bucket))
(define (set-bucket-next! bucket next) (set-cdr! bucket next))
(define (entry-maker head-weak? tail-weak?)
(cond ((and head-weak? tail-weak?)
make-weak-entry)
(head-weak? make-head-weak-entry)
(tail-weak? make-tail-weak-entry)
(else make-strong-entry)))
(define (make-weak-entry key value)
(cons (make-weak-pointer key)
(make-weak-pointer value)))
(define (make-head-weak-entry key value)
(cons (make-weak-pointer key) value))
(define (make-tail-weak-entry key value)
(cons key (make-weak-pointer value)))
(define (make-strong-entry key value)
(cons key value))
(define (entry-key entry) (car entry))
(define (weak-entry-key entry) (weak-pointer-ref (car entry)))
(define (entry-value entry) (cdr entry))
(define (weak-entry-value entry) (weak-pointer-ref (cdr entry)))
(define (set-entry-value! entry value)
(set-cdr! entry value))
(define (set-weak-entry-value! entry value)
(set-entry-value! entry (make-weak-pointer value)))
;;; If MODIFIER returns #F, the entry is to be deleted. It would seem
;;; superfluous to set it if it is #F, but the entry, if it is to be
;;; deleted, needs to be set to #F. This is because of a delicate case
;;; in thread synchronization:
;;; - Thread A is rehashing a table; it is in the middle of dumping
;;; the bucket that contains an entry E, which it has already
;;; dumped.
;;; - Thread A is suspended; thread B gets to run.
;;; - Thread B tries to expunge E from the bucket, but it's absent,
;;; so it assumes that another thread concurrently deleted it.
;;; Now the entry E is still in the table, even though thread B thought
;;; it must have been deleted.
(define (modify-entry-value! entry modifier)
(let ((new-value (modifier (entry-value entry))))
(set-entry-value! entry new-value)
new-value))
(define (modify-weak-entry-value! entry modifier)
(let ((new-value (modifier (weak-entry-value entry))))
(set-weak-entry-value! entry new-value)
new-value))
;;; It might be better to write a purely functional, allocation-only
;;; version of this, to perform as little proposal logging as possible.
;;; Then again, it might make GCs more frequent.
;++ But couldn't that be handled by having two versions, one for GC-
;++ sensitive tables and one for GC-insensitive tables, with the latter
;++ of which allocation has no problems?
(define (expunge-entry-from-bucket! bucket entry)
(cond ((bucket-empty? bucket) bucket)
((eq? entry (bucket-entry bucket))
(bucket-next bucket))
(else
(let loop ((b (bucket-next bucket))
(lag bucket))
;; It is OK for BUCKET not to contain ENTRY: another thread
;; may have concurrently deleted it before the call to
;; EXPUNGE-ENTRY-FROM-BUCKET! but after the search for the
;; entry.
(if (bucket-nonempty? b)
(cond ((eq? (bucket-entry b) entry)
(set-bucket-next! lag (bucket-next b))
bucket)
(else
(loop (bucket-next b) b))))))))
;;; --------------------
;;; Bucket operations
(define (make-bucket-searcher key= gc? head-weak? tail-weak?)
((cond ((and gc? (or head-weak? tail-weak?))
make-gc-weak-bucket-searcher)
((and head-weak? tail-weak?)
make-weak-bucket-searcher)
(head-weak? make-head-weak-bucket-searcher)
(tail-weak? make-tail-weak-bucket-searcher)
(else make-strong-bucket-searcher))
key=))
(define-syntax define-bucket-searcher
(syntax-rules ()
((define-bucket-searcher name
entry-var
(key-var key-expression)
test)
(define (name key=)
(letrec ((expunge-broken-initials
(lambda (bucket delta)
(if (bucket-empty? bucket)
(values bucket delta)
(let* ((entry-var (bucket-entry bucket))
(next (bucket-next bucket))
(key-var key-expression))
(if test
(values bucket delta)
(expunge-broken-initials next
(+ delta 1)))))))
(search
(lambda (bucket lag key delta)
(if (bucket-empty? bucket)
(values #f delta)
(let* ((entry-var (bucket-entry bucket))
(next (bucket-next bucket))
(key-var key-expression))
(cond ((not test)
(set-bucket-next! lag next)
(search next lag key (+ delta 1)))
((key= key-var key)
(values entry-var delta))
(else
(search next bucket key delta))))))))
(lambda (table index bucket key)
(receive (bucket* delta)
(expunge-broken-initials bucket 0)
(if (positive? delta)
(vector-set! (table-bucket-vector table)
index
bucket*))
(receive (entry delta)
(if (bucket-empty? bucket*)
(values #f delta)
(let ((entry-var (bucket-entry bucket*))
(next (bucket-next bucket*)))
(if (key= key-expression key)
(values entry-var delta)
(search next
bucket*
key
delta))))
(set-table-size! table (- (table-size table) delta))
entry))))))))
(define-bucket-searcher make-weak-bucket-searcher
entry
(key (weak-entry-key entry))
(and key (weak-entry-value entry)))
(define-bucket-searcher make-head-weak-bucket-searcher
entry
(key (weak-entry-key entry))
key)
(define-bucket-searcher make-tail-weak-bucket-searcher
entry
(key (entry-key entry))
(weak-entry-value entry))
;;; This is just like the strong bucket searcher, except that it looks
;;; at the weak pointer keys' contents, not at the keys themselves.
;;; This works because, if a key was broken at the last GC, the rehash
;;; of the table would have cleared it out before calling this.
(define (make-gc-weak-bucket-searcher key=)
(lambda (table index bucket key)
(let loop ((bucket bucket))
(if (bucket-empty? bucket)
#f
(let ((entry (bucket-entry bucket)))
(if (key= (weak-entry-key entry) key)
entry
(loop (bucket-next bucket))))))))
(define (make-strong-bucket-searcher key=)
;** EXPUNGE WHEN OPTIMISTIC CONCURRENCY IS IMPLEMENTED
;** (ASSQ doesn't log)
(if (eq? key= eq?)
(lambda (table index bucket key) ;+++ Performance hack: ASSQ is
(assq key bucket)) ;+++ a VM primitive, so fast.
(letrec ((loop (lambda (table index bucket key)
(if (bucket-empty? bucket)
#f
(let ((entry (bucket-entry bucket)))
(if (key= (entry-key entry) key)
entry
(loop table
index
(bucket-next bucket)
key)))))))
loop)))
(define (make-bucket-dumper key-hash head-weak? tail-weak?)
((cond ((and head-weak? tail-weak?)
make-weak-bucket-dumper)
(head-weak? make-head-weak-bucket-dumper)
(tail-weak? make-tail-weak-bucket-dumper)
(else make-strong-bucket-dumper))
key-hash))
(define-syntax define-bucket-dumper
(syntax-rules ()
((define-bucket-dumper name
entry-var
(key-var key-expression)
test)
(define (name key-hash)
(letrec ((loop
(lambda (buckets index bucket count mod)
(if (bucket-empty? bucket)
count
(let* ((entry-var (bucket-entry bucket))
(next (bucket-next bucket))
(key-var key-expression))
(loop buckets index
next
(if test
(let ((hash (key-hash key-var mod)))
(if (not (eq? hash index))
(begin (set-bucket-next!
bucket
(vector-ref buckets
hash))
(vector-set! buckets
hash
bucket)))
(+ count 1))
count)
mod))))))
(lambda (bucket-vector old-buckets index)
(loop bucket-vector index
(vector-ref old-buckets index)
0
(vector-length bucket-vector))))))))
(define-bucket-dumper make-weak-bucket-dumper
entry
(key (weak-entry-key entry))
(and key (weak-entry-value entry)))
(define-bucket-dumper make-head-weak-bucket-dumper
entry
(key (weak-entry-key entry))
key)
(define-bucket-dumper make-tail-weak-bucket-dumper
entry
(key (entry-key entry))
(weak-entry-value entry))
(define (make-strong-bucket-dumper key-hash)
(letrec ((loop
(lambda (buckets index bucket count mod)
(if (bucket-empty? bucket)
count
(let ((next (bucket-next bucket))
(hash
(key-hash (entry-key (bucket-entry bucket))
mod)))
;; Prevent accidentally creating a circular bucket.
(if (not (eq? hash index))
(begin (set-bucket-next! bucket
(vector-ref buckets
hash))
(vector-set! buckets hash bucket)))
(loop buckets index next (+ count 1) mod))))))
(lambda (bucket-vector old-buckets index)
(loop bucket-vector
index
(vector-ref old-buckets index)
0
(vector-length bucket-vector)))))
;;; --------------------
;;; Internal hash table procedures
(define (make-table-rehasher key-hash gc? head-weak? tail-weak?)
((if gc?
make-gc-table-rehasher
make-stable-table-rehasher)
(make-bucket-dumper key-hash head-weak? tail-weak?)))
;;; GC-sensitive table rehashers have to be very carefully constructed.
;;; They may not allocate, and it must be absolutely certain whether or
;;; not they succeeded in hashing immediately following a certain GC
;;; stamp.
(define (make-gc-table-rehasher dump-bucket!)
(letrec ((attempt-rehash!
(make-gc-attempted-table-rehasher dump-bucket!))
(loop (lambda (table new-vector)
(if (attempt-rehash! table (gc-stamp) new-vector)
#f
(loop table new-vector)))))
(lambda (table stamp new-vector)
(or (attempt-rehash! table stamp new-vector)
(loop table new-vector)))))
;;; This returns a procedure that tries to copy all the buckets from
;;; TABLE's existing bucket vector to NEW-VECTOR.
(define (make-gc-attempted-table-rehasher dump-bucket!)
(define (loop table stamp new-vector old-buckets old-length
i new-size)
(cond ((not (eq? stamp (gc-stamp)))
;; Immediately abort, even if we finished copying all of the
;; buckets, because our efforts were for naught.
(vector-fill! new-vector (empty-bucket))
#f)
((= i old-length)
;; We succeeded in rehashing and a GC didn't occur to
;; circumvent us. Of course, a GC could still occur in the
;; next couple instructions, but that will be caught in the
;; next table lookup; what is important is that the table
;; table was completely rehashed safely.
(set-table-gc-stamp! table stamp)
(set-table-bucket-vector! table new-vector)
(set-table-size! table new-size)
#t)
(else
;; Copy the bucket at I & proceed happily. DUMP-BUCKET!
;; could test the stamp itself, but it's probably a lot
;; cheaper just to test it after every bucket copied.
(loop table stamp new-vector old-buckets old-length
(+ i 1)
(+ (dump-bucket! new-vector old-buckets i)
new-size)))))
(lambda (table stamp new-vector)
(let ((old-buckets (table-bucket-vector table)))
(loop table stamp new-vector
old-buckets
(vector-length old-buckets)
0 0))))
(define (make-stable-table-rehasher dump-bucket!)
(lambda (table stamp new-vector)
(let* ((old-buckets (table-bucket-vector table))
(old-length (vector-length old-buckets)))
(do ((i 0 (+ i 1))
(new-size 0
(+ (dump-bucket! new-vector old-buckets i)
new-size)))
((= i old-length)
(set-table-bucket-vector! table
new-vector)
(set-table-size! table new-size)
#t)))))
(define (make-table-hasher key-hash gc? rehasher)
(if gc?
(make-gc-table-hasher key-hash rehasher)
(lambda (table key)
(key-hash key (vector-length (table-bucket-vector table))))))
(define (make-gc-table-hasher key-hash rehash-table!)
(letrec ((retry
(lambda (table key mod new-vector)
(let* ((hash (key-hash key mod))
(stamp (gc-stamp)))
(if (or (eq? (table-gc-stamp table) stamp)
(rehash-table! table stamp new-vector))
hash
(retry table key mod new-vector))))))
(lambda (table key)
(let ((mod (vector-length (table-bucket-vector table))))
(let ((stamp (gc-stamp)))
(if (eq? (table-gc-stamp table) stamp)
(let* ((hash (key-hash key mod)))
(if (eq? (gc-stamp) stamp)
hash
;;; These next two calls are duplicated, but it is
;;; needed so we don't allocate unnecessarily.
(retry table key mod
(make-vector mod (empty-bucket)))))
(retry table key mod
(make-vector mod (empty-bucket)))))))))
(define (make-table-searcher key= table-hash gc? head-weak? tail-weak?)
(let ((search-bucket (make-bucket-searcher key= gc?
head-weak? tail-weak?)))
(lambda (table key)
(let* ((hash (table-hash table key))
(bucket-vector (table-bucket-vector table))
(bucket (vector-ref bucket-vector hash)))
(values hash (search-bucket table hash bucket key))))))
(define (make-table-expander table-hash gc?
head-weak? tail-weak?
rehash-table!)
(let ((make-entry (entry-maker head-weak? tail-weak?))
(rehash! (if gc?
(lambda (table new-vector)
(let loop ((stamp (table-gc-stamp table)))
(if (rehash-table! table stamp new-vector)
(values)
(loop (gc-stamp)))))
(lambda (table new-vector)
(rehash-table! table #f new-vector)))))
(lambda (table cached-hash key value)
(let* ((hash (if (maybe-expand-table! table rehash!)
cached-hash
(table-hash table key)))
;; Note the LET*: the rehash might set the table's bucket
;; vector.
(bucket-vector (table-bucket-vector table)))
(vector-set! bucket-vector hash
(make-bucket (make-entry key value)
(vector-ref bucket-vector hash)))
(set-table-size! table (+ (table-size table) 1))))))
(define (maybe-expand-table! table rehash!)
(let loop ((first? #t))
(let ((size (table-size table)))
(cond ((<= size (* (vector-length (table-bucket-vector table))
maximum-average-bucket-entries))
first?)
(else
(rehash! table
(make-vector (next-bucket-count size)
(empty-bucket)))
(loop #f))))))
(define (expunge-entry-from-table! table bucket-index entry)
(let ((bucket-vector (table-bucket-vector table)))
(vector-set! bucket-vector bucket-index
(expunge-entry-from-bucket!
(vector-ref bucket-vector bucket-index)
entry))))
;;; --------------------
;;; Various table templates
(define-syntax define-table-types
(syntax-rules ()
((define-table-types
(template-name constructor-name template-exp)
...)
(begin (begin (define template-name template-exp)
(define constructor-name
(table-constructor template-name)))
...))))
(define-table-types
(object-table-template make-object-table
(make-strong-table-template (lambda (x) #t) eq?
modular-descriptor-hash
#t ; GC-sensitive hash function
'object-table))
(weak-object-table-template make-weak-object-table
(make-weak-table-template (lambda (x) #t) eq?
modular-descriptor-hash
#t ; GC-sensitive hash function
'weak-object-table))
(string-table-template make-string-table
(make-strong-table-template string? string=?
modular-string-hash
#f ; GC-insensitive hash function
'string-table))
(string-ci-table-template make-string-ci-table
(make-strong-table-template string? string-ci=?
modular-string-ci-hash
#f ; GC-insensitive hash function
'string-ci-table))
(integer-table-template make-integer-table
(make-strong-table-template integer? =
modular-integer-hash
#f ; GC-insensitive hash function
'integer-table))
(symbol-table-template make-symbol-table
(make-strong-table-template symbol? eq?
(lambda (sym mod)
(modular-string-hash
(symbol->string sym)
mod))
#f ; GC-insensitive hash function
'symbol-table)))