suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add ephemeron hash tables

Browse Source 
Weak hash tables retain keys weakly, but they hold each corresponding
value strongly as long as the key is accessible. As a result, weak
hash tables suffer from the key-in-value problem: if the value refers
to the key, the key cannot become inaccesible and be removed from the
table.

Previously, the way around that problem was to map a key to an
ephemeron that combines the key and value. The extra cost of involving
ephemerons (a constant factor) is why ephemerons storage is not the
default behavior of weak hash tables.[*] Having ephemeron hash tables
as a distinct variant avoids imposing a cost where its not needed, and
compared to using explicit ephemerons, it's easier to drop into a
program that was written to use strong or merely weak hash tables.

For Racket CS, the change is especially straightforward, because
ephemeron tables already exist in Chez Scheme (at least for the Racket
variant, in the case of eqv- and equal-based tables).

[*] Also, non-emphemeron hash tables turn out to be needed for certain
    finalization tasks.
This commit is contained in:
Matthew Flatt 2021-02-27 17:03:30 -07:00
parent c89f885578
commit 2b79ba6d4f
22 changed files with 721 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -14,7 +14,7 @@
;; In the Racket source repo, this version should change only when
;; "racket_version.h" changes:
(define version "8.0.0.9")
(define version "8.0.0.10")
(define deps `("racket-lib"
["racket" #:version ,version]))

106
pkgs/racket-doc/scribblings/reference/hashes.scrbl
View File

@ -20,13 +20,13 @@
A @deftech{hash table} (or simply @deftech{hash}) maps each of its
keys to a single value. For a given hash table, keys are equivalent
via @racket[equal?], @racket[eqv?], or @racket[eq?], and keys are
retained either strongly or weakly (see @secref["weakbox"]). A hash
table is also either mutable or immutable. Immutable hash tables
support effectively constant-time access and update, just like mutable
hash tables; the constant on immutable operations is usually larger,
but the functional nature of immutable hash tables can pay off in
certain algorithms. Use @racket[immutable?] to check whether a hash
table is immutable.
retained either strongly, weakly (see @secref["weakbox"]), or like
@tech{ephemerons}. A hash table is also either mutable or immutable.
Immutable hash tables support effectively constant-time access and
update, just like mutable hash tables; the constant on immutable
operations is usually larger, but the functional nature of immutable
hash tables can pay off in certain algorithms. Use @racket[immutable?]
to check whether a hash table is immutable.
@margin-note{Immutable hash tables actually provide @math{O(log N)}
access and update. Since @math{N} is limited by the address space so
@ -53,11 +53,11 @@ table during iteration, then an iteration step may fail with
keys and values. See also @racket[in-hash], @racket[in-hash-keys],
@racket[in-hash-values], and @racket[in-hash-pairs].
Two hash tables cannot be @racket[equal?] unless they use the same
key-comparison procedure (@racket[equal?], @racket[eqv?], or
@racket[eq?]), both hold keys strongly or weakly, and have the same
mutability. Empty immutable hash tables are @racket[eq?] when they
are @racket[equal?].
Two hash tables cannot be @racket[equal?] unless they have the same
mutability, use the same key-comparison procedure (@racket[equal?],
@racket[eqv?], or @racket[eq?]), both hold keys strongly, weakly, or
like @tech{ephemerons}. Empty immutable hash tables are @racket[eq?]
when they are @racket[equal?].
@history[#:changed "7.2.0.9" @elem{Made empty immutable hash tables
@racket[eq?] when they are
@ -122,10 +122,28 @@ Returns @racket[#t] if @racket[hash] compares keys with @racket[eq?],
@racket[#f] if it compares with @racket[equal?] or @racket[eqv?].}
@defproc[(hash-strong? [hash hash?]) boolean?]{
Returns @racket[#t] if @racket[hash] retains its keys strongly,
@racket[#f] if it retains keys strongly or like @tech{ephemerons}.
@history[#:added "8.0.0.10"]}
@defproc[(hash-weak? [hash hash?]) boolean?]{
Returns @racket[#t] if @racket[hash] retains its keys weakly,
@racket[#f] if it retains keys strongly.}
@racket[#f] if it retains keys strongly or like @tech{ephemerons}.}
@defproc[(hash-ephemeron? [hash hash?]) boolean?]{
Returns @racket[#t] if @racket[hash] retains its keys like
@tech{ephemerons}, @racket[#f] if it retains keys strongly or merely
weakly.
@history[#:added "8.0.0.10"]}
@deftogether[(
@defproc[(hash [key any/c] [val any/c] ... ...) (and/c hash? hash-equal? immutable?)]
@ -178,18 +196,38 @@ Like @racket[make-hash], @racket[make-hasheq], and
@racket[make-hasheqv], but creates a mutable hash table that holds
keys weakly.
Beware that values in the table are retained normally. If a value in
Beware that values in a weak hash table are retained normally. If a value in
the table refers back to its key, then the table will retain the value
and therefore the key; the mapping will never be removed from the
table even if the key becomes otherwise inaccessible. To avoid that
problem, instead of mapping the key to the value, map the key to an
@tech{ephemeron} that pairs the key and value. Beware further,
however, that an ephemeron's value might be cleared between retrieving
an ephemeron and extracting its value, depending on whether the key is
otherwise reachable. For @racket[eq?]-based mappings, consider using
the pattern @racket[(ephemeron-value _ephemeron #f _key)] to extract
the value of @racket[_ephemeron] while ensuring that @racket[_key] is
retained until the value is extracted.}
problem, use an ephemeron hash table as created by
@racket[make-ephemeron-hash], @racket[make-ephemeron-hasheqv], or
@racket[make-ephemeron-hasheq]. For values that do not refer to keys,
there is a modest extra cost to using an ephemeron hash table instead
of a weak hash table, but prefer an ephemeron hash table when in
doubt.}
@deftogether[(
@defproc[(make-ephemeron-hash [assocs (listof pair?) null]) (and/c hash? hash-equal? hash-ephemeron?)]
@defproc[(make-ephemeron-hasheqv [assocs (listof pair?) null]) (and/c hash? hash-eqv? hash-ephemeron?)]
@defproc[(make-ephemeron-hasheq [assocs (listof pair?) null]) (and/c hash? hash-eq? hash-ephemeron?)]
)]{
Like @racket[make-hash], @racket[make-hasheq], and
@racket[make-hasheqv], but creates a mutable hash table that holds
keys-value combinations in the same way as an @tech{ephemeron}.
Using an ephemeron hash table is like using a weak hash table and
mapping each key to a @tech{ephemeron} that pairs the key and value.
An advantage of an ephemeron hash table is that the value need not be
extracted with @racket[ephemeron-value] from the result of functions
like @racket[hash-ref]. An ephemeron hash table might also be
represented more compactly than a weak hash table with explicit
@tech{ephemeron} values.
@history[#:added "8.0.0.10"]}
@deftogether[(
@defproc[(make-immutable-hash [assocs (listof pair?) null])
@ -546,10 +584,13 @@ about modifying @racket[hash] within @racket[proc].
@defproc[(hash-count [hash hash?])
exact-nonnegative-integer?]{
Returns the number of keys mapped by @racket[hash]. Unless @racket[hash]
retains keys weakly, the result is computed in
constant time and atomically. If @racket[hash] retains it keys weakly, a
traversal is required to count the keys.}
Returns the number of keys mapped by @racket[hash].
For the @tech{CS} implementation of Racket, the result is always
computed in time and atomically. For the @tech{BC} implementation of
Racket, the result is computed in constant time and atomically only if
@racket[hash] does not retain keys weakly or like an @tech{ephemeron},
otherwise, a traversal is required to count the keys.}
@defproc[(hash-empty? [hash hash?]) boolean?]{
@ -569,12 +610,13 @@ integers.
For a mutable @racket[hash], this index is guaranteed to refer to the
first item only as long as no items are added to or removed from
@racket[hash]. More generally, an index is guaranteed to be a
@deftech{valid hash index} for a given hash table only as long it comes
from @racket[hash-iterate-first] or @racket[hash-iterate-next], and
only as long as the hash table is not modified. In the case of a hash
table with weakly held keys, the hash table can be implicitly modified
by the garbage collector (see @secref["gc-model"]) when it discovers
that the key is not reachable.}
@deftech{valid hash index} for a given hash table only as long it
comes from @racket[hash-iterate-first] or @racket[hash-iterate-next],
and only as long as the hash table is not modified. In the case of a
hash table with weakly held keys or keys held like @tech{ephemerons},
the hash table can be implicitly modified by the garbage collector
(see @secref["gc-model"]) when it discovers that the key is not
reachable.}
@defproc[(hash-iterate-next [hash hash?]

3
pkgs/racket-doc/scribblings/reference/memory.scrbl
View File

@ -57,7 +57,8 @@ are the same.
One particularly common use of ephemerons is to combine them with a
weak hash table (see @secref["hashtables"]) to produce a mapping where
the memory manager can reclaim key--value pairs even when the value
refers to the key. A related use is to retain a reference to a value
refers to the key; see @racket[make-ephemeron-hash].
A related use is to retain a reference to a value
as long as any value for which it is an @tech{impersonator} is
reachable; see @racket[impersonator-ephemeron].

31
pkgs/racket-doc/scribblings/reference/sequences.scrbl
View File

@ -502,13 +502,42 @@ each element in the sequence.
(in-weak-hash-pairs
[hash (and/c hash? hash-weak?)] [bad-index-v any/c])
sequence?]
@defproc[(in-ephemeron-hash
[hash (and/c hash? hash-ephemeron?)])
sequence?]
@defproc[#:link-target? #f
(in-ephemeron-hash
[hash (and/c hash? hash-ephemeron?)] [bad-index-v any/c])
sequence?]
@defproc[(in-ephemeron-hash-keys
[hash (and/c hash? hash-ephemeron?)])
sequence?]
@defproc[#:link-target? #f
(in-ephemeron-hash-keys
[hash (and/c hash? hash-ephemeron?)] [bad-index-v any/c])
sequence?]
@defproc[(in-ephemeron-hash-values
[hash (and/c hash? hash-ephemeron?)])
sequence?]
@defproc[#:link-target? #f
(in-ephemeron-hash-keys
[hash (and/c hash? hash-ephemeron?)] [bad-index-v any/c])
sequence?]
@defproc[(in-ephemeron-hash-pairs
[hash (and/c hash? hash-ephemeron?)])
sequence?]
@defproc[#:link-target? #f
(in-ephemeron-hash-pairs
[hash (and/c hash? hash-ephemeron?)] [bad-index-v any/c])
sequence?]
)]{
Sequence constructors for specific kinds of hash tables.
These may perform better than the analogous @racket[in-hash]
forms.
@history[#:added "6.4.0.6"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}
#:changed "8.0.0.10" @elem{Added @schemeidfont{ephemeron} variants.}]
}

70
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -474,49 +474,49 @@ is analogous to @racket[box-cas!] to perform an atomic compare-and-set.
@deftogether[(
@defproc[(unsafe-mutable-hash-iterate-first
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
[hash (and/c hash? (not/c immutable?) hash-strong?)])
(or/c #f any/c)]
@defproc[(unsafe-mutable-hash-iterate-next
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c])
(or/c #f any/c)]
@defproc[(unsafe-mutable-hash-iterate-key
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-key
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-mutable-hash-iterate-value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-mutable-hash-iterate-key+value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c])
(values any/c any/c)]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-key+value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c]
[bad-index-v any/c])
(values any/c any/c)]
@defproc[(unsafe-mutable-hash-iterate-pair
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c])
pair?]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-pair
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[hash (and/c hash? (not/c immutable?) hash-strong?)]
[pos any/c]
[bad-index-v any/c])
pair?]
@ -614,6 +614,53 @@ is analogous to @racket[box-cas!] to perform an atomic compare-and-set.
[pos any/c]
[bad-index-v any/c])
pair?]
@defproc[(unsafe-ephemeron-hash-iterate-first
[hash (and/c hash? hash-ephemeron?)])
(or/c #f any/c)]
@defproc[(unsafe-ephemeron-hash-iterate-next
[hash (and/c hash? hash-ephemeron?)]
[pos any/c])
(or/c #f any/c)]
@defproc[(unsafe-ephemeron-hash-iterate-key
[hash (and/c hash? hash-ephemeron?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-ephemeron-hash-iterate-key
[hash (and/c hash? hash-ephemeron?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-ephemeron-hash-iterate-value
[hash (and/c hash? hash-ephemeron?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-ephemeron-hash-iterate-value
[hash (and/c hash? hash-ephemeron?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-ephemeron-hash-iterate-key+value
[hash (and/c hash? hash-ephemeron?)]
[pos any/c])
(values any/c any/c)]
@defproc[#:link-target? #f
(unsafe-ephemeron-hash-iterate-key+value
[hash (and/c hash? hash-ephemeron?)]
[pos any/c]
[bad-index-v any/c])
(values any/c any/c)]
@defproc[(unsafe-ephemeron-hash-iterate-pair
[hash (and/c hash? hash-ephemeron?)]
[pos any/c])
pair?]
@defproc[#:link-target? #f
(unsafe-ephemeron-hash-iterate-pair
[hash (and/c hash? hash-ephemeron?)]
[pos any/c]
[bad-index-v any/c])
pair?]
)]{
Unsafe versions of @racket[hash-iterate-key] and similar procedures.
These operations support @tech{chaperones} and @tech{impersonators}.
@ -635,7 +682,8 @@ not useful for the @code{unsafe-immutable-hash-iterate-} functions,
since an index cannot become invalid for an immutable @racket[hash].
@history[#:added "6.4.0.6"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}
#:changed "8.0.0.10" @elem{Added @schemeidfont{ephemeron} variants.}]}
@defproc[(unsafe-make-srcloc [source any/c]
[line (or/c exact-positive-integer? #f)]

139
pkgs/racket-test-core/tests/racket/basic.rktl
View File

@ -408,6 +408,8 @@
(test #f immutable? (make-hash))
(test #f immutable? (make-weak-hasheq))
(test #f immutable? (make-weak-hash))
(test #f immutable? (make-ephemeron-hasheq))
(test #f immutable? (make-ephemeron-hash))
(test #t eq? (hash) #hash())
(test #t eq? (hasheq) #hasheq())
@ -428,6 +430,9 @@
(err/rt-test (make-weak-hash 1))
(err/rt-test (make-weak-hasheqv 1))
(err/rt-test (make-weak-hasheq 1))
(err/rt-test (make-ephemeron-hash 1))
(err/rt-test (make-ephemeron-hasheqv 1))
(err/rt-test (make-ephemeron-hasheq 1))
(test #t symbol? 'foo)
(test #t symbol? (car '(a b)))
@ -2343,9 +2348,13 @@
(arity-test make-weak-hash 0 1)
(arity-test make-weak-hasheq 0 1)
(arity-test make-weak-hasheqv 0 1)
(arity-test make-ephemeron-hash 0 1)
(arity-test make-ephemeron-hasheq 0 1)
(arity-test make-ephemeron-hasheqv 0 1)
(define (hash-tests make-hash make-hasheq make-hasheqv
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv
hash-ref hash-set! hash-ref! hash-update! hash-has-key?
hash-remove! hash-count
hash-map hash-for-each
@ -2362,8 +2371,11 @@
(let ([x null]) (case-lambda [() x] [(a) (set! x (cons a x)) a])))
(define an-ax (make-ax 1 2))
(define (check-hash-tables weak? reorder?)
(let ([h1 (if weak? (make-weak-hasheq) (make-hasheq))]
(define (check-hash-tables weak-kind reorder?)
(let ([h1 (case weak-kind
[(weak) (make-weak-hasheq)]
[(ephemeron) (make-ephemeron-hasheq)]
[else (make-hasheq)])]
[l (list 1 2 3)])
(test #t eq? (eq-hash-code l) (eq-hash-code l))
(test #t eq? (eqv-hash-code l) (eqv-hash-code l))
@ -2392,7 +2404,10 @@
(test 1 hash-ref h1 l)
(hash-remove! h1 l))
(let ([h1 (if weak? (make-weak-hasheqv) (make-hasheqv))]
(let ([h1 (case weak-kind
[(weak) (make-weak-hasheqv)]
[(ephemeron) (make-ephemeron-hasheqv)]
[else (make-hasheqv)])]
[n (expt 2 500)]
[q (/ 1 2)]
[s (make-string 2 #\q)])
@ -2403,7 +2418,10 @@
(test 'half hash-ref h1 (/ 1 (read (open-input-string "2"))))
(test #f hash-ref h1 (make-string (read (open-input-string "2")) #\q) #f))
(let ([h1 (if weak? (make-weak-hash) (make-hash))]
(let ([h1 (case weak-kind
[(weak) (make-weak-hash)]
[(ephemeron) (make-ephemeron-hash)]
[else (make-hash)])]
[l (list 1 2 3)]
[v (vector 5 6 7)]
[a (make-a 1 (make-a 2 3))]
@ -2506,12 +2524,15 @@
;; return the hash table:
h1))
(define (check-tables-equal mode t1 t2 weak?)
(define (check-tables-equal mode t1 t2 weak-kind)
(test #t equal? t1 t2)
(test #t hash-keys-subset? t1 t2)
(test (equal-hash-code t1) equal-hash-code t2)
(test #t equal? t1 (hash-copy t1))
(let ([again (if weak? (make-weak-hash) (make-hash))])
(let ([again (case weak-kind
[(weak) (make-weak-hash)]
[(ephemeron) (make-ephemeron-hash)]
[else (make-hash)])])
(let loop ([i (hash-iterate-first t1)])
(when i
(hash-set! again
@ -2530,13 +2551,18 @@
#f)
(when make-weak-hash
(check-tables-equal 'the-weak-table
(check-hash-tables #t #f)
(check-hash-tables #t #t)
#t))
(check-hash-tables 'weak #f)
(check-hash-tables 'weak #t)
'weak)
(check-tables-equal 'the-ephemeron-table
(check-hash-tables 'ephemeron #f)
(check-hash-tables 'ephemeron #t)
'ephemeron))
;; Make sure copy doesn't share:
(for ([make-hash (list make-hash
make-weak-hash)])
make-weak-hash
make-ephemeron-hash)])
(when make-hash
(define c1 (make-hash))
(hash-set! c1 'the-key1 'the-val1)
@ -2554,7 +2580,8 @@
(test 'the-val4 hash-ref c1 'the-key4)))
(for ([make-hash (list make-hash
make-weak-hash)])
make-weak-hash
make-ephemeron-hash)])
(when make-hash
(define c1 (make-hash))
(hash-set! c1 'the-key1 'the-val1)
@ -2569,6 +2596,7 @@
(hash-tests make-hash make-hasheq make-hasheqv
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv
hash-ref hash-set! hash-ref! hash-update! hash-has-key?
hash-remove! hash-count
hash-map hash-for-each
@ -2585,6 +2613,7 @@
(lambda () (box #hasheq()))
(lambda () (box #hasheqv()))
#f #f #f
#f #f #f
(ub-wrap hash-ref)
(lambda (ht k v) (set-box! ht (hash-set (unbox ht) k v)))
#f
@ -2610,24 +2639,66 @@
(test #f hash? 5)
(test #t hash? (make-hasheq))
(test #t hash? (make-hasheqv))
(test #t hash-eq? (hasheq))
(test #f hash-eq? (hash))
(test #f hash-eq? (hasheqv))
(test #t hash-eq? (make-hasheq))
(test #f hash-eq? (make-hash))
(test #f hash-eq? (make-hasheqv))
(test #t hash-eq? (make-weak-hasheq))
(test #f hash-eq? (make-weak-hash))
(test #f hash-eq? (make-weak-hasheqv))
(test #f hash-eqv? (make-hasheq))
(test #t hash-eq? (make-ephemeron-hasheq))
(test #f hash-eq? (make-ephemeron-hash))
(test #f hash-eq? (make-ephemeron-hasheqv))
(test #f hash-eqv? (hasheq))
(test #f hash-eqv? (hash))
(test #t hash-eqv? (hasheqv))
(test #f hash-eqv? (hasheq))
(test #f hash-eqv? (make-hash))
(test #t hash-eqv? (make-hasheqv))
(test #f hash-eqv? (make-weak-hasheq))
(test #f hash-eqv? (make-weak-hash))
(test #t hash-eqv? (make-weak-hasheqv))
(test #f hash-eqv? (make-ephemeron-hasheq))
(test #f hash-eqv? (make-ephemeron-hash))
(test #t hash-eqv? (make-ephemeron-hasheqv))
(test #f hash-weak? (hasheq))
(test #f hash-weak? (hash))
(test #f hash-weak? (hasheqv))
(test #f hash-weak? (make-hasheq))
(test #f hash-weak? (make-hash))
(test #f hash-weak? (make-hasheqv))
(test #t hash-weak? (make-weak-hasheq))
(test #t hash-weak? (make-weak-hash))
(test #t hash-weak? (make-weak-hasheqv))
(test #f hash-weak? (make-ephemeron-hasheq))
(test #f hash-weak? (make-ephemeron-hash))
(test #f hash-weak? (make-ephemeron-hasheqv))
(test #f hash-ephemeron? (hasheq))
(test #f hash-ephemeron? (hash))
(test #f hash-ephemeron? (hasheqv))
(test #f hash-ephemeron? (make-hasheq))
(test #f hash-ephemeron? (make-hash))
(test #f hash-ephemeron? (make-hasheqv))
(test #f hash-ephemeron? (make-weak-hasheq))
(test #f hash-ephemeron? (make-weak-hash))
(test #f hash-ephemeron? (make-weak-hasheqv))
(test #t hash-ephemeron? (make-ephemeron-hasheq))
(test #t hash-ephemeron? (make-ephemeron-hash))
(test #t hash-ephemeron? (make-ephemeron-hasheqv))
(test #t hash-strong? (hasheq))
(test #t hash-strong? (hash))
(test #t hash-strong? (hasheqv))
(test #t hash-strong? (make-hasheq))
(test #t hash-strong? (make-hash))
(test #t hash-strong? (make-hasheqv))
(test #f hash-strong? (make-weak-hasheq))
(test #f hash-strong? (make-weak-hash))
(test #f hash-strong? (make-weak-hasheqv))
(test #f hash-strong? (make-ephemeron-hasheq))
(test #f hash-strong? (make-ephemeron-hash))
(test #f hash-strong? (make-ephemeron-hasheqv))
(let ([ht (make-hasheqv)]
[l (list #x03B1 #x03B2 #x03B3)]
@ -2644,6 +2715,8 @@
(err/rt-test (hash-eq? 5))
(err/rt-test (hash-eqv? 5))
(err/rt-test (hash-weak? 5))
(err/rt-test (hash-ephemeron? 5))
(err/rt-test (hash-strong? 5))
(let ([a (expt 2 500)]
[b (expt (read (open-input-string "2")) 500)])
@ -2652,13 +2725,16 @@
;; Check for proper clearing of weak hash tables
;; (internally, value should get cleared along with key):
(let ([ht (make-weak-hasheq)])
(let ([ht (make-weak-hasheq)]
[et (make-ephemeron-hasheq)])
(let loop ([n 10])
(unless (zero? n)
(hash-set! ht (make-string 10) #f)
(hash-set! et (make-string 10) #f)
(loop (sub1 n))))
(collect-garbage)
(map (lambda (i) (format "~a" i)) (hash-map ht cons)))
(map (lambda (i) (format "~a" i)) (hash-map ht cons))
(map (lambda (i) (format "~a" i)) (hash-map et cons)))
;; Double check that table are equal after deletions
(let ([test-del-eq
@ -2676,7 +2752,9 @@
(test-del-eq make-hasheq)
(test-del-eq make-hash)
(test-del-eq make-weak-hasheq)
(test-del-eq make-weak-hash))
(test-del-eq make-weak-hash)
(test-del-eq make-ephemeron-hasheq)
(test-del-eq make-ephemeron-hash))
(err/rt-test (hash-count 0))
(err/rt-test (hash-set! 1 2 3))
@ -2696,7 +2774,13 @@
(test #f equal? (mk make-hasheq) (mk make-hasheqv))
(test #f equal? (mk make-hash) (mk make-weak-hash))
(test #f equal? (mk make-hasheq) (mk make-weak-hasheq))
(test #f equal? (mk make-hasheqv) (mk make-weak-hasheqv)))
(test #f equal? (mk make-hasheqv) (mk make-weak-hasheqv))
(test #f equal? (mk make-hash) (mk make-ephemeron-hash))
(test #f equal? (mk make-hasheq) (mk make-ephemeron-hasheq))
(test #f equal? (mk make-hasheqv) (mk make-ephemeron-hasheqv))
(test #f equal? (mk make-weak-hash) (mk make-ephemeron-hash))
(test #f equal? (mk make-weak-hasheq) (mk make-ephemeron-hasheq))
(test #f equal? (mk make-weak-hasheqv) (mk make-ephemeron-hasheqv)))
(let ([mk (lambda (mk)
(mk `((1 . 2))))])
(test #t equal? (mk make-immutable-hash) (mk make-immutable-hash))
@ -2733,11 +2817,15 @@
(check-subset hash hash #:k1 (cons 1 2) #:k2 (cons 1 2))
(check-subset hasheq (make-make-hash make-hasheq))
(check-subset hasheq (make-make-hash make-weak-hasheq))
(check-subset hasheq (make-make-hash make-ephemeron-hasheq))
(check-subset hasheqv (make-make-hash make-hasheqv))
(check-subset hasheqv (make-make-hash make-weak-hasheqv))
(check-subset hasheqv (make-make-hash make-ephemeron-hasheqv))
(check-subset hash (make-make-hash make-hash))
(check-subset hash (make-make-hash make-weak-hash))
(check-subset hash (make-make-hash make-ephemeron-hash))
(check-subset (make-make-hash make-hash) (make-make-hash make-weak-hash))
(check-subset (make-make-hash make-hash) (make-make-hash make-ephemeron-hash))
(check-subset hash (make-make-hash make-hash) #:k1 (expt 2 70) #:k2 (expt 2 70)))
(let ([not-same-comparison? (lambda (x)
@ -2746,7 +2834,8 @@
(err/rt-test (hash-keys-subset? #hash() #hasheqv()) not-same-comparison?)
(err/rt-test (hash-keys-subset? #hasheq() #hasheqv()) not-same-comparison?)
(err/rt-test (hash-keys-subset? (make-hasheq #hasheqv()) not-same-comparison?))
(err/rt-test (hash-keys-subset? (make-weak-hasheq #hasheqv()) not-same-comparison?)))
(err/rt-test (hash-keys-subset? (make-weak-hasheq #hasheqv()) not-same-comparison?))
(err/rt-test (hash-keys-subset? (make-ephemeron-hasheq #hasheqv()) not-same-comparison?)))
(define im-t (make-immutable-hasheq null))
(test #t hash? im-t)
@ -2781,8 +2870,10 @@
(test #f hash-iterate-first (make-hasheq))
(test #f hash-iterate-first (make-weak-hasheq))
(test #f hash-iterate-first (make-ephemeron-hasheq))
(test #f hash-iterate-next (make-hasheq) 0)
(test #f hash-iterate-next (make-weak-hasheq) 0)
(test #f hash-iterate-next (make-ephemeron-hasheq) 0)
(let ([hts (list (make-hash)
(make-hasheq)
@ -2790,6 +2881,9 @@
(make-weak-hash)
(make-weak-hasheq)
(make-weak-hasheqv)
(make-ephemeron-hash)
(make-ephemeron-hasheq)
(make-ephemeron-hasheqv)
(hash)
(hasheq)
(hasheqv))])
@ -2873,6 +2967,8 @@
(arity-test hash? 1 1)
(arity-test hash-eq? 1 1)
(arity-test hash-weak? 1 1)
(arity-test hash-ephemeron? 1 1)
(arity-test hash-strong? 1 1)
;; Ensure that hash-table hashing is not sensitive to the
;; order of key+value additions
@ -2881,6 +2977,8 @@
(define ht2 (make-hash))
(define wht (make-weak-hash))
(define wht2 (make-weak-hash))
(define eht (make-ephemeron-hash))
(define eht2 (make-ephemeron-hash))
(define keys (make-hasheq))
(struct a (x) #:transparent)
@ -2919,10 +3017,17 @@
(for ([i (in-list l2)])
(hash-set! wht2 (reg (a i)) (a (a i))))
(for ([i (in-list l)])
(hash-set! eht (reg (a i)) (a (a i))))
(for ([i (in-list l2)])
(hash-set! eht2 (reg (a i)) (a (a i))))
(test (equal-hash-code ht) values (equal-hash-code ht2))
(test (equal-hash-code wht) values (equal-hash-code wht2))
(test (equal-hash-code eht) values (equal-hash-code eht2))
(test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))
(test (equal-secondary-hash-code wht) values (equal-secondary-hash-code wht2))
(test (equal-secondary-hash-code eht) values (equal-secondary-hash-code eht2))
(let ([ht (for/hash ([i (in-list l)])
(values (a i) (a (a i))))]

21
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -1909,7 +1909,8 @@
(list
make-hash make-hasheq make-hasheqv
(lambda () #hash()) (lambda () #hasheq()) (lambda () #hasheqv())
make-weak-hash make-weak-hasheq make-weak-hasheqv))
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv))
(let ([mk (lambda clear-proc+more
(apply chaperone-hash (make-hash)
@ -1941,7 +1942,8 @@
(test #t (lambda (x) (hash? x)) h)))
(list
make-hash make-hasheq make-hasheqv
make-weak-hash make-weak-hasheq make-weak-hasheqv))
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv))
(for-each
(lambda (make-hash)
@ -2038,7 +2040,8 @@
(void)))
(list
make-hash make-hasheq make-hasheqv
make-weak-hash make-weak-hasheq make-weak-hasheqv)))
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv)))
(for-each
(lambda (h1)
@ -2249,7 +2252,7 @@
(lambda (h k) k)
#f
(lambda (h k) (set! saw (cons k saw)) k)))
(for ([make-hash (in-list (list make-hash make-weak-hash))])
(for ([make-hash (in-list (list make-hash make-weak-hash make-ephemeron-hash))])
(set! saw null)
(define ht (make-hash))
(define cht (mk ht))
@ -2300,7 +2303,7 @@
(lambda (h k) k)
#f
(lambda (h k) (inexact->exact (floor k)))))
(for ([make-hash (in-list (list make-hash make-weak-hash))])
(for ([make-hash (in-list (list make-hash make-weak-hash make-ephemeron-hash))])
(define ht (make-hash))
(define cht (mk ht))
(hash-set! cht 1.2 'one)
@ -2335,7 +2338,7 @@
(define ht1 (hash-set cht (vector 1) 'vec))
(test 'vec hash-ref ht1 (vector 1) #f)
(test #f hash-ref ht1 (vector 2) #f))
(for ([make-hash (in-list (list make-hash make-weak-hash))])
(for ([make-hash (in-list (list make-hash make-weak-hash make-ephemeron-hash))])
(define ht (make-hash))
(define cht (mk ht))
(define key (vector 1 2))
@ -2353,7 +2356,7 @@
;; ----------------------------------------
;; Make sure chaperoned hash tables use a lock
(for ([make-hash (list make-hash make-weak-hash)])
(for ([make-hash (list make-hash make-weak-hash make-ephemeron-hash)])
(define ht (make-hash))
(struct a (v)
@ -2432,7 +2435,9 @@
(check (make-hash))
(check (make-hasheq))
(check (make-weak-hash))
(check (make-weak-hasheq)))
(check (make-weak-hasheq))
(check (make-ephemeron-hash))
(check (make-ephemeron-hasheq)))
(let ([check
(lambda (orig)

106
pkgs/racket-test-core/tests/racket/hash.rktl
View File

@ -161,15 +161,15 @@
(syntax-case stx ()
[(_ tag -in-hash -in-pairs -in-keys -in-values)
#'(define-hash-iterations-tester tag
-in-hash -in-hash -in-hash
-in-pairs -in-pairs -in-pairs
-in-keys -in-keys -in-keys
-in-values -in-values -in-values)]
-in-hash -in-hash -in-hash -in-hash
-in-pairs -in-pairs -in-pairs -in-pairs
-in-keys -in-keys -in-keys -in-keys
-in-values -in-values -in-values -in-values)]
[(_ tag
-in-immut-hash -in-mut-hash -in-weak-hash
-in-immut-hash-pairs -in-mut-hash-pairs -in-weak-hash-pairs
-in-immut-hash-keys -in-mut-hash-keys -in-weak-hash-keys
-in-immut-hash-values -in-mut-hash-values -in-weak-hash-values)
-in-immut-hash -in-mut-hash -in-weak-hash -in-ephemeron-hash
-in-immut-hash-pairs -in-mut-hash-pairs -in-weak-hash-pairs -in-ephemeron-hash-pairs
-in-immut-hash-keys -in-mut-hash-keys -in-weak-hash-keys -in-ephemeron-hash-keys
-in-immut-hash-values -in-mut-hash-values -in-weak-hash-values -in-ephemeron-hash-values)
(with-syntax
([name
(datum->syntax #'tag
@ -179,6 +179,7 @@
(define ht/immut (make-immutable-hash (map cons lst1 lst2)))
(define ht/mut (make-hash (map cons lst1 lst2)))
(define ht/weak (make-weak-hash (map cons lst1 lst2)))
(define ht/ephemeron (make-ephemeron-hash (map cons lst1 lst2)))
(define fake-ht/immut
(chaperone-hash
@ -200,129 +201,172 @@
(lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
(lambda (h k v) values k v) ; set-proc
(lambda (h k) k) ; remove-proc
(lambda (h k) k)))
(define fake-ht/ephemeron
(impersonate-hash
ht/ephemeron
(lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
(lambda (h k v) values k v) ; set-proc
(lambda (h k) k) ; remove-proc
(lambda (h k) k))) ; key-proc
(define ht/immut/seq (-in-immut-hash ht/immut))
(define ht/mut/seq (-in-mut-hash ht/mut))
(define ht/weak/seq (-in-weak-hash ht/weak))
(define ht/ephemeron/seq (-in-ephemeron-hash ht/ephemeron))
(define ht/immut-pair/seq (-in-immut-hash-pairs ht/immut))
(define ht/mut-pair/seq (-in-mut-hash-pairs ht/mut))
(define ht/weak-pair/seq (-in-weak-hash-pairs ht/weak))
(define ht/ephemeron-pair/seq (-in-ephemeron-hash-pairs ht/ephemeron))
(define ht/immut-keys/seq (-in-immut-hash-keys ht/immut))
(define ht/mut-keys/seq (-in-mut-hash-keys ht/mut))
(define ht/weak-keys/seq (-in-weak-hash-keys ht/weak))
(define ht/ephemeron-keys/seq (-in-ephemeron-hash-keys ht/ephemeron))
(define ht/immut-vals/seq (-in-immut-hash-values ht/immut))
(define ht/mut-vals/seq (-in-mut-hash-values ht/mut))
(define ht/weak-vals/seq (-in-weak-hash-values ht/weak))
(define ht/ephemeron-vals/seq (-in-ephemeron-hash-values ht/ephemeron))
(test #t =
(for/sum ([(k v) (-in-immut-hash ht/immut)]) (+ k v))
(for/sum ([(k v) (-in-mut-hash ht/mut)]) (+ k v))
(for/sum ([(k v) (-in-weak-hash ht/weak)]) (+ k v))
(for/sum ([(k v) (-in-ephemeron-hash ht/ephemeron)]) (+ k v))
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) (+ k v))
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) (+ k v))
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) (+ k v))
(for/sum ([(k v) (-in-ephemeron-hash fake-ht/ephemeron)]) (+ k v))
(for/sum ([(k v) ht/immut/seq]) (+ k v))
(for/sum ([(k v) ht/mut/seq]) (+ k v))
(for/sum ([(k v) ht/weak/seq]) (+ k v))
(for/sum ([(k v) ht/ephemeron/seq]) (+ k v))
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-ephemeron-hash-pairs ht/ephemeron)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v (-in-ephemeron-hash-pairs fake-ht/ephemeron)])
(+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/immut-pair/seq]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/mut-pair/seq]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/weak-pair/seq]) (+ (car k+v) (cdr k+v)))
(for/sum ([k+v ht/ephemeron-pair/seq]) (+ (car k+v) (cdr k+v)))
(+ (for/sum ([k (-in-immut-hash-keys ht/immut)]) k)
(for/sum ([v (-in-immut-hash-values ht/immut)]) v))
(+ (for/sum ([k (-in-mut-hash-keys ht/mut)]) k)
(for/sum ([v (-in-mut-hash-values ht/mut)]) v))
(+ (for/sum ([k (-in-weak-hash-keys ht/weak)]) k)
(for/sum ([v (-in-weak-hash-values ht/weak)]) v))
(+ (for/sum ([k (-in-ephemeron-hash-keys ht/ephemeron)]) k)
(for/sum ([v (-in-ephemeron-hash-values ht/ephemeron)]) v))
(+ (for/sum ([k (-in-immut-hash-keys fake-ht/immut)]) k)
(for/sum ([v (-in-immut-hash-values fake-ht/immut)]) v))
(+ (for/sum ([k (-in-mut-hash-keys fake-ht/mut)]) k)
(for/sum ([v (-in-mut-hash-values fake-ht/mut)]) v))
(+ (for/sum ([k (-in-weak-hash-keys fake-ht/weak)]) k)
(for/sum ([v (-in-weak-hash-values fake-ht/weak)]) v))
(+ (for/sum ([k (-in-ephemeron-hash-keys fake-ht/ephemeron)]) k)
(for/sum ([v (-in-ephemeron-hash-values fake-ht/ephemeron)]) v))
(+ (for/sum ([k ht/immut-keys/seq]) k)
(for/sum ([v ht/immut-vals/seq]) v))
(+ (for/sum ([k ht/mut-keys/seq]) k)
(for/sum ([v ht/mut-vals/seq]) v))
(+ (for/sum ([k ht/weak-keys/seq]) k)
(for/sum ([v ht/weak-vals/seq]) v)))
(for/sum ([v ht/weak-vals/seq]) v))
(+ (for/sum ([k ht/ephemeron-keys/seq]) k)
(for/sum ([v ht/ephemeron-vals/seq]) v)))
(test #t =
(for/sum ([(k v) (-in-immut-hash ht/immut)]) k)
(for/sum ([(k v) (-in-mut-hash ht/mut)]) k)
(for/sum ([(k v) (-in-weak-hash ht/weak)]) k)
(for/sum ([(k v) (-in-ephemeron-hash ht/ephemeron)]) k)
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) k)
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) k)
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) k)
(for/sum ([(k v) (-in-ephemeron-hash fake-ht/ephemeron)]) k)
(for/sum ([(k v) ht/immut/seq]) k)
(for/sum ([(k v) ht/mut/seq]) k)
(for/sum ([(k v) ht/weak/seq]) k)
(for/sum ([(k v) ht/ephemeron/seq]) k)
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)]) (car k+v))
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)]) (car k+v))
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)]) (car k+v))
(for/sum ([k+v (-in-ephemeron-hash-pairs ht/ephemeron)]) (car k+v))
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)]) (car k+v))
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)]) (car k+v))
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)]) (car k+v))
(for/sum ([k+v (-in-ephemeron-hash-pairs fake-ht/ephemeron)]) (car k+v))
(for/sum ([k+v ht/immut-pair/seq]) (car k+v))
(for/sum ([k+v ht/mut-pair/seq]) (car k+v))
(for/sum ([k+v ht/weak-pair/seq]) (car k+v))
(for/sum ([k+v ht/ephemeron-pair/seq]) (car k+v))
(for/sum ([k (-in-immut-hash-keys ht/immut)]) k)
(for/sum ([k (-in-mut-hash-keys ht/mut)]) k)
(for/sum ([k (-in-weak-hash-keys ht/weak)]) k)
(for/sum ([k (-in-ephemeron-hash-keys ht/ephemeron)]) k)
(for/sum ([k (-in-immut-hash-keys fake-ht/immut)]) k)
(for/sum ([k (-in-mut-hash-keys fake-ht/mut)]) k)
(for/sum ([k (-in-weak-hash-keys fake-ht/weak)]) k)
(for/sum ([k (-in-ephemeron-hash-keys fake-ht/ephemeron)]) k)
(for/sum ([k ht/immut-keys/seq]) k)
(for/sum ([k ht/mut-keys/seq]) k)
(for/sum ([k ht/weak-keys/seq]) k))
(for/sum ([k ht/weak-keys/seq]) k)
(for/sum ([k ht/ephemeron-keys/seq]) k))
(test #t =
(for/sum ([(k v) (-in-immut-hash ht/immut)]) v)
(for/sum ([(k v) (-in-mut-hash ht/mut)]) v)
(for/sum ([(k v) (-in-weak-hash ht/weak)]) v)
(for/sum ([(k v) (-in-ephemeron-hash ht/ephemeron)]) v)
(for/sum ([(k v) (-in-immut-hash fake-ht/immut)]) v)
(for/sum ([(k v) (-in-mut-hash fake-ht/mut)]) v)
(for/sum ([(k v) (-in-weak-hash fake-ht/weak)]) v)
(for/sum ([(k v) (-in-ephemeron-hash fake-ht/ephemeron)]) v)
(for/sum ([(k v) ht/immut/seq]) v)
(for/sum ([(k v) ht/mut/seq]) v)
(for/sum ([(k v) ht/weak/seq]) v)
(for/sum ([(k v) ht/ephemeron/seq]) v)
(for/sum ([k+v (-in-immut-hash-pairs ht/immut)]) (cdr k+v))
(for/sum ([k+v (-in-mut-hash-pairs ht/mut)]) (cdr k+v))
(for/sum ([k+v (-in-weak-hash-pairs ht/weak)]) (cdr k+v))
(for/sum ([k+v (-in-ephemeron-hash-pairs ht/ephemeron)]) (cdr k+v))
(for/sum ([k+v (-in-immut-hash-pairs fake-ht/immut)]) (cdr k+v))
(for/sum ([k+v (-in-mut-hash-pairs fake-ht/mut)]) (cdr k+v))
(for/sum ([k+v (-in-weak-hash-pairs fake-ht/weak)]) (cdr k+v))
(for/sum ([k+v (-in-ephemeron-hash-pairs fake-ht/ephemeron)]) (cdr k+v))
(for/sum ([k+v ht/immut-pair/seq]) (cdr k+v))
(for/sum ([k+v ht/mut-pair/seq]) (cdr k+v))
(for/sum ([k+v ht/weak-pair/seq]) (cdr k+v))
(for/sum ([k+v ht/ephemeron-pair/seq]) (cdr k+v))
(for/sum ([v (-in-immut-hash-values ht/immut)]) v)
(for/sum ([v (-in-mut-hash-values ht/mut)]) v)
(for/sum ([v (-in-weak-hash-values ht/weak)]) v)
(for/sum ([v (-in-ephemeron-hash-values ht/ephemeron)]) v)
(for/sum ([v (-in-immut-hash-values fake-ht/immut)]) v)
(for/sum ([v (-in-mut-hash-values fake-ht/mut)]) v)
(for/sum ([v (-in-weak-hash-values fake-ht/weak)]) v)
(for/sum ([v (-in-ephemeron-hash-values fake-ht/ephemeron)]) v)
(for/sum ([v ht/immut-vals/seq]) v)
(for/sum ([v ht/mut-vals/seq]) v)
(for/sum ([v ht/weak-vals/seq]) v))))]))
(for/sum ([v ht/weak-vals/seq]) v)
(for/sum ([v ht/ephemeron-vals/seq]) v))))]))
(define-hash-iterations-tester generic
in-hash in-hash-pairs in-hash-keys in-hash-values)
(define-hash-iterations-tester specific
in-immutable-hash in-mutable-hash in-weak-hash
in-immutable-hash-pairs in-mutable-hash-pairs in-weak-hash-pairs
in-immutable-hash-keys in-mutable-hash-keys in-weak-hash-keys
in-immutable-hash-values in-mutable-hash-values in-weak-hash-values)
in-immutable-hash in-mutable-hash in-weak-hash in-ephemeron-hash
in-immutable-hash-pairs in-mutable-hash-pairs in-weak-hash-pairs in-ephemeron-hash-pairs
in-immutable-hash-keys in-mutable-hash-keys in-weak-hash-keys in-ephemeron-hash-keys
in-immutable-hash-values in-mutable-hash-values in-weak-hash-values in-ephemeron-hash-values)
(define lst1 (build-list 10 values))
(define lst2 (build-list 10 add1))
@ -494,6 +538,38 @@
(hash-remove-iterate-test* [make-weak-hash make-weak-hasheq make-weak-hasheqv]
(p) in-hash-pairs in-weak-hash-pairs car)
;; ----------------------------------------
;; weak and ephemeron hash tables
(unless (eq? 'cgc (system-type 'gc))
(let ([wht (make-weak-hash)]
[eht (make-ephemeron-hash)])
(define key1 (gensym "key"))
(define key2 (gensym "key"))
(define key3 (gensym "key"))
(hash-set! wht key1 (list key1))
(hash-set! wht key2 'ok)
(hash-set! wht key3 'not-key3)
(hash-set! eht key1 (list key1))
(hash-set! eht key2 'ok)
(hash-set! eht key3 (box key3))
(test (list key1) hash-ref wht key1)
(test 'ok hash-ref wht key2)
(test (list key1) hash-ref eht key1)
(test 'ok hash-ref eht key2)
(collect-garbage)
(test 1 values (hash-count wht))
(test 1 values (hash-count eht))
(test (list key1) hash-ref wht key1)
(test (list key1) hash-ref eht key1)
(void)))
;; ----------------------------------------
;; hash-ref-key

1
pkgs/racket-test-core/tests/racket/jitinline.rktl
View File

@ -255,6 +255,7 @@
(un #f 'immutable? (make-hash))
(un #f 'immutable? (make-hasheq))
(un #f 'immutable? (make-weak-hasheq))
(un #f 'immutable? (make-ephemeron-hasheq))
(un #t 'immutable? #hash())
(un #t 'immutable? #hasheq())
(un #t 'immutable? #hasheqv())

12
pkgs/racket-test-core/tests/racket/unsafe.rktl
View File

@ -853,7 +853,11 @@
;; Check that unsafe-weak-hash-iterate- ops do not segfault
;; when a key is collected before access; throw exception instead.
;; They are used for safe iteration in in-weak-hash- sequence forms
(let ()
(for ([make-weak-hash (list make-weak-hash make-ephemeron-hash)]
[unsafe-weak-hash-iterate-first (list unsafe-weak-hash-iterate-first unsafe-ephemeron-hash-iterate-first)]
[unsafe-weak-hash-iterate-key (list unsafe-weak-hash-iterate-key unsafe-ephemeron-hash-iterate-key)]
[unsafe-weak-hash-iterate-pair (list unsafe-weak-hash-iterate-pair unsafe-ephemeron-hash-iterate-pair)]
[unsafe-weak-hash-iterate-key+value (list unsafe-weak-hash-iterate-key+value unsafe-ephemeron-hash-iterate-key+value)])
(define ht #f)
;; retain the list at first...
@ -923,7 +927,11 @@
(test-values '(gone gone) (lambda () (unsafe-mutable-hash-iterate-key+value ht i 'gone)))
(test #f unsafe-mutable-hash-iterate-next ht i))
(let ()
(for ([make-weak-hash (list make-weak-hash make-ephemeron-hash)]
[unsafe-weak-hash-iterate-first (list unsafe-weak-hash-iterate-first unsafe-ephemeron-hash-iterate-first)]
[unsafe-weak-hash-iterate-key (list unsafe-weak-hash-iterate-key unsafe-ephemeron-hash-iterate-key)]
[unsafe-weak-hash-iterate-pair (list unsafe-weak-hash-iterate-pair unsafe-ephemeron-hash-iterate-pair)]
[unsafe-weak-hash-iterate-key+value (list unsafe-weak-hash-iterate-key+value unsafe-ephemeron-hash-iterate-key+value)])
(define ht (make-weak-hash '((a . b))))
(define i (unsafe-weak-hash-iterate-first ht))

10
racket/collects/racket/private/for.rkt
View File

@ -69,6 +69,10 @@
in-weak-hash-keys
in-weak-hash-values
in-weak-hash-pairs
in-ephemeron-hash
in-ephemeron-hash-keys
in-ephemeron-hash-values
in-ephemeron-hash-pairs
(rename *in-directory in-directory)
@ -797,7 +801,6 @@
#f)]))
(define (mutable? ht) (not (immutable? ht)))
(define (not-weak? ht) (not (hash-weak? ht)))
;; Each call defines 4 in-HASHTYPE-VALs sequences,
;; where VAL = key, value, pair, key+value (key+value not used in seq name)
@ -892,9 +895,10 @@
[_ #f]))))))]))
;; 2) define sequence syntaxes (using just-defined definer):
(IN-HASH-DEFINER hash-type: hash)
(IN-HASH-DEFINER hash-type: mutable-hash checks: mutable? not-weak?)
(IN-HASH-DEFINER hash-type: mutable-hash checks: mutable? hash-strong?)
(IN-HASH-DEFINER hash-type: immutable-hash checks: immutable?)
(IN-HASH-DEFINER hash-type: weak-hash checks: hash-weak?))))]))
(IN-HASH-DEFINER hash-type: weak-hash checks: hash-weak?)
(IN-HASH-DEFINER hash-type: ephemeron-hash checks: hash-ephemeron?))))]))
(define-in-hash-sequences element-types: key value)
(define-in-hash-sequences element-types: key)
(define-in-hash-sequences element-types: value)

3
racket/src/bc/include/scheme.h
View File

@ -953,7 +953,8 @@ enum {
SCHEME_hash_string,
SCHEME_hash_ptr,
SCHEME_hash_weak_ptr,
SCHEME_hash_late_weak_ptr
SCHEME_hash_late_weak_ptr,
SCHEME_hash_ephemeron_ptr
};
enum {

90
racket/src/bc/src/hash.c
View File

@ -765,9 +765,11 @@ scheme_make_bucket_table (intptr_t size, int type)
}
if (type == SCHEME_hash_weak_ptr)
table->weak = 1;
table->weak = SCHEME_BT_KIND_WEAK;
else if (type == SCHEME_hash_late_weak_ptr)
table->weak = 2;
table->weak = SCHEME_BT_KIND_LATE;
else if (type == SCHEME_hash_ephemeron_ptr)
table->weak = SCHEME_BT_KIND_EPHEMERON;
else
table->weak = 0;
@ -809,15 +811,15 @@ allocate_bucket (Scheme_Bucket_Table *table, const char *key, void *val)
if (table->weak) {
#ifdef MZ_PRECISE_GC
void *kb;
kb = GC_malloc_weak_box((void *)key, (void **)bucket, (void **)&bucket->val - (void **)bucket,
(table->weak > 1));
kb = GC_malloc_weak_box((void *)key, (void **)bucket, (void **)&bucket->val XFORM_OK_MINUS (void **)bucket,
(table->weak == SCHEME_BT_KIND_LATE));
bucket->key = (char *)kb;
#else
char *kb;
kb = (char *)MALLOC_ONE_WEAK(void *);
bucket->key = kb;
*(void **)bucket->key = (void *)key;
if (table->weak > 1) {
if (table->weak == SCHEME_BT_KIND_LATE) {
scheme_late_weak_reference_indirect((void **)bucket->key, (void *)key);
scheme_late_weak_reference_indirect((void **)&bucket->val, (void *)key);
} else {
@ -825,6 +827,10 @@ allocate_bucket (Scheme_Bucket_Table *table, const char *key, void *val)
scheme_weak_reference_indirect((void **)&bucket->val, (void *)key);
}
#endif
if (table->weak == SCHEME_BT_KIND_EPHEMERON) {
/* we expect this ephemeron to be cleared if the bcket key is cleared */
val = scheme_make_ephemeron((Scheme_Object *)key, val);
}
} else
bucket->key = (char *)key;
bucket->val = val;
@ -1009,8 +1015,11 @@ scheme_add_to_table_w_key_wraps (Scheme_Bucket_Table *table, const char *key, vo
b = get_bucket(table, key, 1, NULL, key_wraps);
if (val)
if (val) {
if (table->weak == SCHEME_BT_KIND_EPHEMERON)
val = scheme_make_ephemeron((Scheme_Object *)key, val);
b->val = val;
}
if (constant && table->with_home)
((Scheme_Bucket_With_Flags *)b)->flags |= GLOB_IS_CONST;
}
@ -1040,10 +1049,13 @@ scheme_lookup_in_table_w_key_wraps (Scheme_Bucket_Table *table, const char *key,
if (_interned_key) {
if (table->weak)
*_interned_key = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
else
else
*_interned_key = (Scheme_Object *)bucket->key;
}
return bucket->val;
if (table->weak == SCHEME_BT_KIND_EPHEMERON)
return scheme_ephemeron_value(bucket->val);
else
return bucket->val;
} else {
return NULL;
}
@ -1074,8 +1086,11 @@ scheme_change_in_table (Scheme_Bucket_Table *table, const char *key, void *naya)
bucket = get_bucket(table, key, 0, NULL, NULL);
if (bucket)
if (bucket) {
if (table->weak == SCHEME_BT_KIND_EPHEMERON)
naya = scheme_make_ephemeron((Scheme_Object *)key, naya);
bucket->val = naya;
}
}
int scheme_bucket_table_equal_rec(Scheme_Bucket_Table *t1, Scheme_Object *orig_t1,
@ -1108,20 +1123,25 @@ int scheme_bucket_table_equal_rec(Scheme_Bucket_Table *t1, Scheme_Object *orig_t
if (key) {
if (!SAME_OBJ((Scheme_Object *)t1, orig_t1))
val1 = scheme_chaperone_hash_traversal_get(orig_t1, key, &key);
else
else {
val1 = (Scheme_Object *)bucket->val;
if (weak == SCHEME_BT_KIND_EPHEMERON) {
val1 = scheme_ephemeron_value(val1);
MZ_ASSERT(val1);
}
}
checked++;
if (!SAME_OBJ((Scheme_Object *)t2, orig_t2))
val2 = scheme_chaperone_hash_get(orig_t2, key);
else
val2 = (Scheme_Object *)scheme_lookup_in_table(t2, (const char *)key);
if (!val2)
return 0;
if (!scheme_recur_equal(val1, val2, eql))
return 0;
if (!val2)
return 0;
if (!scheme_recur_equal(val1, val2, eql))
return 0;
}
}
}
@ -1189,8 +1209,16 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
if (bucket->key) {
if (table->weak) {
void *hk = (void *)HT_EXTRACT_WEAK(bucket->key);
if (hk)
bucket = allocate_bucket(table, hk, bucket->val);
if (hk) {
Scheme_Object *val = bucket->val;
if (table->weak == SCHEME_BT_KIND_EPHEMERON) {
val = scheme_ephemeron_value(val);
MZ_ASSERT(val);
}
bucket = allocate_bucket(table, hk, val);
} else {
/* ok to use the same keyless bucket */
}
} else
bucket = allocate_bucket(table, bucket->key, bucket->val);
ba[i] = bucket;
@ -1210,7 +1238,7 @@ Scheme_Object *scheme_bucket_table_next(Scheme_Bucket_Table *hash,
if (start >= 0) {
bucket = ((start < sz) ? hash->buckets[start] : NULL);
if (!bucket || !bucket->val || !bucket->key)
if (!bucket || !bucket->val || !bucket->key)
return NULL;
}
for (i = start + 1; i < sz; i++) {
@ -1234,8 +1262,12 @@ int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_
*_key = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
else
*_key = (Scheme_Object *)bucket->key;
if (_val)
*_val = (Scheme_Object *)bucket->val;
if (_val) {
Scheme_Object *val = bucket->val;
if (hash->weak == SCHEME_BT_KIND_EPHEMERON)
val = scheme_ephemeron_value(val);
*_val = val;
}
return 1;
}
}
@ -1858,9 +1890,13 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
_key = bucket->key;
if (_key) {
key = (Scheme_Object *)_key;
if (SAME_OBJ(o, orig_obj))
if (SAME_OBJ(o, orig_obj)) {
val = (Scheme_Object *)bucket->val;
else
if (weak == SCHEME_BT_KIND_EPHEMERON) {
val = scheme_ephemeron_value(val);
MZ_ASSERT(val);
}
} else
val = scheme_chaperone_hash_traversal_get(orig_obj, key, &key);
vk = equal_hash_key(val, 0, hi);
MZ_MIX(vk);
@ -2344,9 +2380,13 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
_key = bucket->key;
if (_key) {
key = (Scheme_Object *)_key;
if (SAME_OBJ(o, orig_obj))
if (SAME_OBJ(o, orig_obj)) {
val = (Scheme_Object *)bucket->val;
else
if (weak == SCHEME_BT_KIND_EPHEMERON) {
val = scheme_ephemeron_value(val);
MZ_ASSERT(val);
}
} else
val = scheme_chaperone_hash_traversal_get(orig_obj, key, &key);
k += equal_hash_key2(val, hi);
k += equal_hash_key2(key, hi);

169
racket/src/bc/src/list.c
View File

@ -32,9 +32,6 @@ READ_ONLY Scheme_Object *scheme_unsafe_unbox_star_proc;
READ_ONLY Scheme_Object *scheme_unsafe_set_box_star_proc;
/* read only locals */
ROSYM static Scheme_Object *weak_symbol;
ROSYM static Scheme_Object *equal_symbol;
ROSYM static Scheme_Hash_Tree *empty_hash;
ROSYM static Scheme_Hash_Tree *empty_hasheq;
ROSYM static Scheme_Hash_Tree *empty_hasheqv;
@ -99,6 +96,9 @@ static Scheme_Object *make_hasheqv(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_weak_hash(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_weak_hasheq(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_weak_hasheqv(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_ephemeron_hash(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_ephemeron_hasheq(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_ephemeron_hasheqv(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]);
@ -110,7 +110,9 @@ static Scheme_Object *hash_p(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_strong_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_weak_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_ephemeron_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_ref_key(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_put_bang(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]);
@ -560,6 +562,18 @@ scheme_init_list (Scheme_Startup_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-weak-hasheqv", p, env);
p = scheme_make_immed_prim(make_ephemeron_hash, "make-ephemeron-hash", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-ephemeron-hash", p, env);
p = scheme_make_immed_prim(make_ephemeron_hasheq, "make-ephemeron-hasheq", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-ephemeron-hasheq", p, env);
p = scheme_make_immed_prim(make_ephemeron_hasheqv, "make-ephemeron-hasheqv", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-ephemeron-hasheqv", p, env);
p = scheme_make_immed_prim(scheme_make_immutable_hash, "make-immutable-hash", 0, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION);
scheme_addto_prim_instance("make-immutable-hash", p, env);
@ -613,11 +627,21 @@ scheme_init_list (Scheme_Startup_Env *env)
"hash-equal?",
1, 1, 1),
env);
scheme_addto_prim_instance("hash-strong?",
scheme_make_folding_prim(hash_strong_p,
"hash-strong?",
1, 1, 1),
env);
scheme_addto_prim_instance("hash-weak?",
scheme_make_folding_prim(hash_weak_p,
"hash-weak?",
1, 1, 1),
env);
scheme_addto_prim_instance("hash-ephemeron?",
scheme_make_folding_prim(hash_ephemeron_p,
"hash-ephemeron?",
1, 1, 1),
env);
p = scheme_make_immed_prim(scheme_checked_hash_count, "hash-count", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
@ -829,12 +853,6 @@ scheme_init_list (Scheme_Startup_Env *env)
1, 1, 1),
env);
REGISTER_SO(weak_symbol);
REGISTER_SO(equal_symbol);
weak_symbol = scheme_intern_symbol("weak");
equal_symbol = scheme_intern_symbol("equal");
REGISTER_SO(empty_hash);
REGISTER_SO(empty_hasheq);
REGISTER_SO(empty_hasheqv);
@ -979,6 +997,12 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-first", p, env);
p = scheme_make_immed_prim(unsafe_bucket_table_iterate_start,
"unsafe-ephemeron-hash-iterate-first", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-first", p, env);
/* For the rest, only immutable variants can have
SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL, because a key can disappear
from mutable variants and trigger an error. */
@ -998,6 +1022,10 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
"unsafe-weak-hash-iterate-next", 2, 2);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-next", p, env);
p = scheme_make_immed_prim(unsafe_bucket_table_iterate_next,
"unsafe-ephemeron-hash-iterate-next", 2, 2);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-next", p, env);
/* unsafe-hash-iterate-key ---------------------------------------- */
p = scheme_make_noncm_prim(unsafe_hash_table_iterate_key,
"unsafe-mutable-hash-iterate-key", 2, 3);
@ -1014,6 +1042,10 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
"unsafe-weak-hash-iterate-key", 2, 3);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-key", p, env);
p = scheme_make_noncm_prim(unsafe_bucket_table_iterate_key,
"unsafe-ephemeron-hash-iterate-key", 2, 3);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-key", p, env);
/* unsafe-hash-iterate-value ---------------------------------------- */
p = scheme_make_noncm_prim(unsafe_hash_table_iterate_value,
"unsafe-mutable-hash-iterate-value", 2, 3);
@ -1030,6 +1062,10 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
"unsafe-weak-hash-iterate-value", 2, 3);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-value", p, env);
p = scheme_make_noncm_prim(unsafe_bucket_table_iterate_value,
"unsafe-ephemeron-hash-iterate-value", 2, 3);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-value", p, env);
/* unsafe-hash-iterate-key+value ---------------------------------------- */
p = scheme_make_prim_w_arity2(unsafe_hash_table_iterate_key_value,
"unsafe-mutable-hash-iterate-key+value",
@ -1049,6 +1085,11 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
2, 3, 2, 2);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-key+value", p, env);
p = scheme_make_prim_w_arity2(unsafe_bucket_table_iterate_key_value,
"unsafe-ephemeron-hash-iterate-key+value",
2, 3, 2, 2);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-key+value", p, env);
/* unsafe-hash-iterate-pair ---------------------------------------- */
p = scheme_make_immed_prim(unsafe_hash_table_iterate_pair,
"unsafe-mutable-hash-iterate-pair",
@ -1066,6 +1107,11 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
"unsafe-weak-hash-iterate-pair",
2, 3);
scheme_addto_prim_instance ("unsafe-weak-hash-iterate-pair", p, env);
p = scheme_make_immed_prim(unsafe_bucket_table_iterate_pair,
"unsafe-ephemeron-hash-iterate-pair",
2, 3);
scheme_addto_prim_instance ("unsafe-ephemeron-hash-iterate-pair", p, env);
}
Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
@ -2097,6 +2143,21 @@ Scheme_Bucket_Table *scheme_make_weak_equal_table(void)
return t;
}
Scheme_Bucket_Table *scheme_make_ephemeron_equal_table(void)
{
Scheme_Object *sema;
Scheme_Bucket_Table *t;
t = scheme_make_bucket_table(20, SCHEME_hash_ephemeron_ptr);
sema = scheme_make_sema(1);
t->mutex = sema;
t->compare = scheme_compare_equal;
t->make_hash_indices = make_hash_indices_for_equal;
return t;
}
Scheme_Bucket_Table *scheme_make_nonlock_equal_bucket_table(void)
{
Scheme_Bucket_Table *t;
@ -2124,6 +2185,21 @@ Scheme_Bucket_Table *scheme_make_weak_eqv_table(void)
return t;
}
Scheme_Bucket_Table *scheme_make_ephemeron_eqv_table(void)
{
Scheme_Object *sema;
Scheme_Bucket_Table *t;
t = scheme_make_bucket_table(20, SCHEME_hash_ephemeron_ptr);
sema = scheme_make_sema(1);
t->mutex = sema;
t->compare = compare_eqv;
t->make_hash_indices = make_hash_indices_for_eqv;
return t;
}
static Scheme_Object *fill_table(Scheme_Object *ht, const char *who,
int argc, Scheme_Object **argv)
{
@ -2197,6 +2273,27 @@ static Scheme_Object *make_weak_hasheqv(int argc, Scheme_Object *argv[])
return fill_table(ht, "make-weak-hasheqv", argc, argv);
}
static Scheme_Object *make_ephemeron_hash(int argc, Scheme_Object *argv[])
{
Scheme_Object *ht;
ht = (Scheme_Object *)scheme_make_ephemeron_equal_table();
return fill_table(ht, "make-ephemeron-hash", argc, argv);
}
static Scheme_Object *make_ephemeron_hasheq(int argc, Scheme_Object *argv[])
{
Scheme_Object *ht;
ht = (Scheme_Object *)scheme_make_bucket_table(20, SCHEME_hash_ephemeron_ptr);
return fill_table(ht, "make-ephemeron-hasheq", argc, argv);
}
static Scheme_Object *make_ephemeron_hasheqv(int argc, Scheme_Object *argv[])
{
Scheme_Object *ht;
ht = (Scheme_Object *)scheme_make_ephemeron_eqv_table();
return fill_table(ht, "make-ephemeron-hasheqv", argc, argv);
}
static Scheme_Object *make_immutable_table(const char *who, int kind, int argc, Scheme_Object *argv[])
{
Scheme_Object *l = (argc ? argv[0] : scheme_null), *a;
@ -2496,23 +2593,39 @@ Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[])
return scheme_false;
}
static Scheme_Object *hash_weak_p(int argc, Scheme_Object *argv[])
static Scheme_Object *strong_weak_p(const char *who, int weak, int eph, int argc, Scheme_Object *argv[])
{
Scheme_Object *o = argv[0];
if (SCHEME_CHAPERONEP(o))
o = SCHEME_CHAPERONE_VAL(o);
if (SCHEME_BUCKTP(o))
return scheme_true;
else if (SCHEME_HASHTP(o) || SCHEME_HASHTRP(o))
return scheme_false;
if (SCHEME_BUCKTP(o)) {
if (!weak)
return scheme_false;
return ((((Scheme_Bucket_Table *)o)->weak == SCHEME_BT_KIND_EPHEMERON)
? (eph ? scheme_true : scheme_false)
: (eph ? scheme_false : scheme_true));
} else if (SCHEME_HASHTP(o) || SCHEME_HASHTRP(o))
return (weak ? scheme_false : scheme_true);
scheme_wrong_contract("hash-weak?", "hash?", 0, argc, argv);
scheme_wrong_contract(who, "hash?", 0, argc, argv);
return NULL;
}
static Scheme_Object *hash_strong_p(int argc, Scheme_Object *argv[]) {
return strong_weak_p("hash-strong?", 0, 0, argc, argv);
}
static Scheme_Object *hash_weak_p(int argc, Scheme_Object *argv[]) {
return strong_weak_p("hash-weak?", 1, 0, argc, argv);
}
static Scheme_Object *hash_ephemeron_p(int argc, Scheme_Object *argv[]) {
return strong_weak_p("hash-ephemeron?", 1, 1, argc, argv);
}
int scheme_is_hash_table_equal(Scheme_Object *o)
{
return (((Scheme_Hash_Table *)o)->compare == scheme_compare_equal);
@ -2923,8 +3036,11 @@ static Scheme_Object *do_map_hash_table(int argc,
v = scheme_chaperone_hash_get(chaperone, v);
if (!v)
no_post_key(name, p[0], 0);
} else
} else {
v = (Scheme_Object *)bucket->val;
if (hash->weak == SCHEME_BT_KIND_EPHEMERON)
v = scheme_ephemeron_value(v);
}
if (v) {
p[1] = v;
if (keep) {
@ -3715,12 +3831,21 @@ Scheme_Object *scheme_chaperone_hash_table_filtered_copy(Scheme_Object *obj,
else
v2 = scheme_make_immutable_hash(0, NULL);
} else {
if (is_eq)
v2 = make_weak_hasheq(0, NULL);
else if (is_eqv)
v2 = make_weak_hasheqv(0, NULL);
else
v2 = make_weak_hash(0, NULL);
if (((Scheme_Bucket_Table *)v)->weak == SCHEME_BT_KIND_EPHEMERON) {
if (is_eq)
v2 = make_ephemeron_hasheq(0, NULL);
else if (is_eqv)
v2 = make_ephemeron_hasheqv(0, NULL);
else
v2 = make_ephemeron_hash(0, NULL);
} else {
if (is_eq)
v2 = make_weak_hasheq(0, NULL);
else if (is_eqv)
v2 = make_weak_hasheqv(0, NULL);
else
v2 = make_weak_hash(0, NULL);
}
}
idx = scheme_hash_table_iterate_start(1, a);

4
racket/src/bc/src/schemef.h
View File

@ -1140,8 +1140,8 @@ MZ_EXTERN Scheme_Object *scheme_make_weak_box(Scheme_Object *v);
MZ_EXTERN Scheme_Object *scheme_make_late_weak_box(Scheme_Object *v);
MZ_EXTERN Scheme_Object *scheme_make_ephemeron(Scheme_Object *key, Scheme_Object *val);
MZ_EXTERN Scheme_Object *scheme_ephemeron_value(Scheme_Object *o);
MZ_EXTERN Scheme_Object *scheme_ephemeron_key(Scheme_Object *o);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_ephemeron_value(Scheme_Object *o);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_ephemeron_key(Scheme_Object *o);
MZ_EXTERN Scheme_Object *scheme_make_late_will_executor();

2
racket/src/bc/src/schminc.h
View File

@ -15,7 +15,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1488
#define EXPECTED_PRIM_COUNT 1499
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

7
racket/src/bc/src/schpriv.h
View File

@ -1020,6 +1020,10 @@ struct Scheme_Hash_Tree {
Scheme_Object *scheme_intern_literal_string(Scheme_Object *str);
Scheme_Object *scheme_intern_literal_number(Scheme_Object *num);
#define SCHEME_BT_KIND_WEAK 1
#define SCHEME_BT_KIND_LATE 2
#define SCHEME_BT_KIND_EPHEMERON 3
/*========================================================================*/
/* hash functions */
/*========================================================================*/
@ -3834,6 +3838,9 @@ Scheme_Bucket_Table *scheme_make_weak_equal_table(void);
Scheme_Bucket_Table *scheme_make_weak_eqv_table(void);
Scheme_Bucket_Table *scheme_make_nonlock_equal_bucket_table(void);
Scheme_Bucket_Table *scheme_make_ephemeron_equal_table(void);
Scheme_Bucket_Table *scheme_make_ephemeron_eqv_table(void);
int scheme_hash_table_equal_rec(Scheme_Hash_Table *t1, Scheme_Object *orig_t1,
Scheme_Hash_Table *t2, Scheme_Object *orig_t2,
void *eql);

5
racket/src/cs/primitive/kernel.ss
View File

@ -408,6 +408,7 @@
[hash-clear! (known-procedure/single-valued 2)]
[hash-copy (known-procedure/single-valued 2)]
[hash-count (known-procedure/single-valued 2)]
[hash-ephemeron? (known-procedure/single-valued 2)]
[hash-eq? (known-procedure/single-valued 2)]
[hash-equal? (known-procedure/single-valued 2)]
[hash-eqv? (known-procedure/single-valued 2)]
@ -427,6 +428,7 @@
[hash-remove! (known-procedure/single-valued 4)]
[hash-set (known-procedure/single-valued 8)]
[hash-set! (known-procedure/single-valued 8)]
[hash-strong? (known-procedure/single-valued 2)]
[hash-weak? (known-procedure/single-valued 2)]
[hash? (known-procedure/pure/folding 2)]
[hasheq (known-procedure/single-valued -1)]
@ -502,6 +504,9 @@
[make-directory (known-procedure/no-prompt 2)]
[make-environment-variables (known-procedure/no-prompt -1)]
[make-ephemeron (known-procedure/allocates 4)]
[make-ephemeron-hash (known-procedure/single-valued 3)]
[make-ephemeron-hasheq (known-procedure/no-prompt 3)]
[make-ephemeron-hasheqv (known-procedure/no-prompt 3)]
[make-file-or-directory-link (known-procedure/no-prompt 4)]
[make-hash (known-procedure/single-valued 3)]
[make-hash-placeholder (known-procedure/no-prompt 2)]

6
racket/src/cs/primitive/unsafe.ss
View File

@ -31,6 +31,12 @@
[unsafe-custodian-unregister (known-procedure 4)]
[unsafe-end-atomic (known-procedure 1)]
[unsafe-end-breakable-atomic (known-procedure 1)]
[unsafe-ephemeron-hash-iterate-first (known-procedure 2)]
[unsafe-ephemeron-hash-iterate-key (known-procedure 12)]
[unsafe-ephemeron-hash-iterate-key+value (known-procedure 12)]
[unsafe-ephemeron-hash-iterate-next (known-procedure 4)]
[unsafe-ephemeron-hash-iterate-pair (known-procedure 12)]
[unsafe-ephemeron-hash-iterate-value (known-procedure 12)]
[unsafe-extfl* (known-procedure/pure 4)]
[unsafe-extfl+ (known-procedure/pure 4)]
[unsafe-extfl- (known-procedure/pure 4)]

6
racket/src/cs/rumble.sls
View File

@ -270,6 +270,7 @@
make-hash make-hasheqv make-hasheq
make-immutable-hash make-immutable-hasheqv make-immutable-hasheq
make-weak-hash make-weak-hasheq make-weak-hasheqv
make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv
hash-ref hash-ref-key hash-set hash-set! hash-remove hash-remove!
hash-for-each hash-map hash-copy hash-clear hash-clear!
hash-iterate-first hash-iterate-next
@ -284,9 +285,12 @@
unsafe-weak-hash-iterate-first unsafe-weak-hash-iterate-next
unsafe-weak-hash-iterate-key unsafe-weak-hash-iterate-value
unsafe-weak-hash-iterate-key+value unsafe-weak-hash-iterate-pair
unsafe-ephemeron-hash-iterate-first unsafe-ephemeron-hash-iterate-next
unsafe-ephemeron-hash-iterate-key unsafe-ephemeron-hash-iterate-value
unsafe-ephemeron-hash-iterate-key+value unsafe-ephemeron-hash-iterate-pair
unsafe-hash-seal! ; not exported to racket
hash? hash-eq? hash-equal? hash-eqv? hash-weak?
hash? hash-eq? hash-equal? hash-eqv? hash-strong? hash-weak? hash-ephemeron?
hash-count
hash-keys-subset?
eq-hashtable->hash ; not exported to racket

98
racket/src/cs/rumble/hash.ss
View File

@ -25,40 +25,55 @@
(and (impersonator? v)
(authentic-hash? (impersonator-val v)))))
(define make-hash
(define/who make-hash
(case-lambda
[() (create-mutable-hash (make-hashtable key-equal-hash-code key-equal?) 'equal?)]
[(alist) (fill-hash! 'make-hash (make-hash) alist)]))
[(alist) (fill-hash! who (make-hash) alist)]))
(define make-weak-hash
(define/who make-weak-hash
(case-lambda
[() (create-mutable-hash (make-weak-hashtable key-equal-hash-code key-equal?) 'equal?)]
[(alist) (fill-hash! 'make-weak-hash (make-weak-hash) alist)]))
[(alist) (fill-hash! who (make-weak-hash) alist)]))
(define make-hasheq
(define/who make-ephemeron-hash
(case-lambda
[() (create-mutable-hash (make-ephemeron-hashtable key-equal-hash-code key-equal?) 'equal?)]
[(alist) (fill-hash! who (make-ephemeron-hash) alist)]))
(define/who make-hasheq
(case-lambda
[() (create-eq-mutable-hash (make-eq-hashtable))]
[(alist) (fill-hash! 'make-hasheq (make-hasheq) alist)]))
[(alist) (fill-hash! who (make-hasheq) alist)]))
(define (eq-hashtable->hash ht)
(create-eq-mutable-hash ht))
(define (hash->eq-hashtable ht)
(mutable-hash-ht ht))
(define make-weak-hasheq
(define/who make-weak-hasheq
(case-lambda
[() (create-eq-mutable-hash (make-weak-eq-hashtable))]
[(alist) (fill-hash! 'make-weak-hasheq (make-weak-hasheq) alist)]))
[(alist) (fill-hash! who (make-weak-hasheq) alist)]))
(define make-hasheqv
(define/who make-ephemeron-hasheq
(case-lambda
[() (create-eq-mutable-hash (make-ephemeron-eq-hashtable))]
[(alist) (fill-hash! who (make-ephemeron-hasheq) alist)]))
(define/who make-hasheqv
(case-lambda
[() (create-mutable-hash (make-eqv-hashtable) 'eqv?)]
[(alist) (fill-hash! 'make-hasheqv (make-hasheqv) alist)]))
[(alist) (fill-hash! who (make-hasheqv) alist)]))
(define make-weak-hasheqv
(define/who make-weak-hasheqv
(case-lambda
[() (create-mutable-hash (make-weak-eqv-hashtable) 'eqv?)]
[(alist) (fill-hash! 'make-weak-hasheqv (make-weak-hasheqv) alist)]))
[(alist) (fill-hash! who (make-weak-hasheqv) alist)]))
(define/who make-ephemeron-hasheqv
(case-lambda
[() (create-mutable-hash (make-ephemeron-eqv-hashtable) 'eqv?)]
[(alist) (fill-hash! who (make-ephemeron-hasheqv) alist)]))
(define/who (fill-hash! who ht alist)
(check who :test (and (list? alist) (andmap pair? alist)) :contract "(listof pair?)" alist)
@ -248,7 +263,7 @@
(prepare-iterate! ht (hash-count ht))
(set-locked-iterable-hash-lock! ht #f))
(define (hash-eq? ht)
(define/who (hash-eq? ht)
(cond
[(mutable-hash? ht) (eq-mutable-hash? ht)]
[(intmap? ht)
@ -256,9 +271,9 @@
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-eq? (impersonator-val ht))]
[else (raise-argument-error 'hash-eq? "hash?" ht)]))
[else (raise-argument-error who "hash?" ht)]))
(define (hash-eqv? ht)
(define/who (hash-eqv? ht)
(cond
[(mutable-hash? ht)
(eq? (hashtable-equivalence-function (mutable-hash-ht ht)) eqv?)]
@ -267,9 +282,9 @@
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-eqv? (impersonator-val ht))]
[else (raise-argument-error 'hash-eqv? "hash?" ht)]))
[else (raise-argument-error who "hash?" ht)]))
(define (hash-equal? ht)
(define/who (hash-equal? ht)
(cond
[(mutable-hash? ht)
(eq? (hashtable-equivalence-function (mutable-hash-ht ht)) key-equal?)]
@ -278,9 +293,21 @@
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-equal? (impersonator-val ht))]
[else (raise-argument-error 'hash-equal? "hash?" ht)]))
[else (raise-argument-error who "hash?" ht)]))
(define (hash-weak? ht)
(define/who (hash-strong? ht)
(cond
[(mutable-hash? ht)
(let ([t (mutable-hash-ht ht)])
(not (or (hashtable-weak? t)
(hashtable-ephemeron? t))))]
[(intmap? ht) #t]
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-strong? (impersonator-val ht))]
[else (raise-argument-error who "hash?" ht)]))
(define/who (hash-weak? ht)
(cond
[(mutable-hash? ht)
(hashtable-weak? (mutable-hash-ht ht))]
@ -288,7 +315,17 @@
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-weak? (impersonator-val ht))]
[else (raise-argument-error 'hash-weak? "hash?" ht)]))
[else (raise-argument-error who "hash?" ht)]))
(define/who (hash-ephemeron? ht)
(cond
[(mutable-hash? ht)
(hashtable-ephemeron? (mutable-hash-ht ht))]
[(intmap? ht) #f]
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(hash-ephemeron? (impersonator-val ht))]
[else (raise-argument-error who "hash?" ht)]))
(define/who hash-ref
(case-lambda
@ -577,7 +614,8 @@
(and (hash-equal? ht1)
(hash-equal? ht2)))
;; Same weakness?
(eq? (hash-weak? ht1) (hash-weak? ht2)))
(eq? (hash-weak? ht1) (hash-weak? ht2))
(eq? (hash-ephemeron? ht1) (hash-ephemeron? ht2)))
(and (= (hash-count ht1) (hash-count ht2))
;; This generic comparison supports impersonators
(let loop ([i (hash-iterate-first ht1)])
@ -885,13 +923,12 @@
(define unsafe-weak-hash-iterate-key+value hash-iterate-key+value)
(define unsafe-weak-hash-iterate-pair hash-iterate-pair)
;; ----------------------------------------
;; When `eq?`ness of flonums is not preserved by
;; the GC, then we need special handling for flonums.
;; But the GC now does preserve `eq?`ness.
(define (weak/fl-cons key d)
(weak-cons key d))
(define unsafe-ephemeron-hash-iterate-first hash-iterate-first)
(define unsafe-ephemeron-hash-iterate-next hash-iterate-next)
(define unsafe-ephemeron-hash-iterate-key hash-iterate-key)
(define unsafe-ephemeron-hash-iterate-value hash-iterate-value)
(define unsafe-ephemeron-hash-iterate-key+value hash-iterate-key+value)
(define unsafe-ephemeron-hash-iterate-pair hash-iterate-pair)
;; ----------------------------------------
@ -1140,6 +1177,11 @@
[(hash-eq? val-ht) (make-weak-hasheq)]
[(hash-eqv? val-ht) (make-weak-hasheq)]
[else (make-weak-hash)])]
[(hash-ephemeron? ht)
(cond
[(hash-eq? val-ht) (make-ephemeron-hasheq)]
[(hash-eqv? val-ht) (make-ephemeron-hasheq)]
[else (make-ephemeron-hash)])]
[else
(cond
[(hash-eq? val-ht) (make-hasheq)]

2
racket/src/version/racket_version.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 8
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_W 10
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x