diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index d4fe7dd00a..05c2cfe2bf 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -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])) diff --git a/pkgs/racket-doc/scribblings/reference/hashes.scrbl b/pkgs/racket-doc/scribblings/reference/hashes.scrbl index 8bdcc52ebd..6aa70bb347 100644 --- a/pkgs/racket-doc/scribblings/reference/hashes.scrbl +++ b/pkgs/racket-doc/scribblings/reference/hashes.scrbl @@ -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?] diff --git a/pkgs/racket-doc/scribblings/reference/memory.scrbl b/pkgs/racket-doc/scribblings/reference/memory.scrbl index e0fa4b4daa..1d23c3df4e 100644 --- a/pkgs/racket-doc/scribblings/reference/memory.scrbl +++ b/pkgs/racket-doc/scribblings/reference/memory.scrbl @@ -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]. diff --git a/pkgs/racket-doc/scribblings/reference/sequences.scrbl b/pkgs/racket-doc/scribblings/reference/sequences.scrbl index 9d28440020..769434efea 100644 --- a/pkgs/racket-doc/scribblings/reference/sequences.scrbl +++ b/pkgs/racket-doc/scribblings/reference/sequences.scrbl @@ -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.}] } diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index d44a03d528..0ee2de2d5c 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -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)] diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl index 1d631b5a00..99d290beef 100644 --- a/pkgs/racket-test-core/tests/racket/basic.rktl +++ b/pkgs/racket-test-core/tests/racket/basic.rktl @@ -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))))] diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index 88308dfb27..5469faba30 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -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) diff --git a/pkgs/racket-test-core/tests/racket/hash.rktl b/pkgs/racket-test-core/tests/racket/hash.rktl index 3edabb9e81..f0fe72be63 100644 --- a/pkgs/racket-test-core/tests/racket/hash.rktl +++ b/pkgs/racket-test-core/tests/racket/hash.rktl @@ -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 diff --git a/pkgs/racket-test-core/tests/racket/jitinline.rktl b/pkgs/racket-test-core/tests/racket/jitinline.rktl index 5f38bcc0a3..da8e589410 100644 --- a/pkgs/racket-test-core/tests/racket/jitinline.rktl +++ b/pkgs/racket-test-core/tests/racket/jitinline.rktl @@ -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()) diff --git a/pkgs/racket-test-core/tests/racket/unsafe.rktl b/pkgs/racket-test-core/tests/racket/unsafe.rktl index 7d5e670cab..4ec1fa20c4 100644 --- a/pkgs/racket-test-core/tests/racket/unsafe.rktl +++ b/pkgs/racket-test-core/tests/racket/unsafe.rktl @@ -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)) diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index a73d0fd880..246a14ef27 100644 --- a/racket/collects/racket/private/for.rkt +++ b/racket/collects/racket/private/for.rkt @@ -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) diff --git a/racket/src/bc/include/scheme.h b/racket/src/bc/include/scheme.h index bed459db68..c227e0b4ad 100644 --- a/racket/src/bc/include/scheme.h +++ b/racket/src/bc/include/scheme.h @@ -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 { diff --git a/racket/src/bc/src/hash.c b/racket/src/bc/src/hash.c index b3c32f8fd9..e8484dc456 100644 --- a/racket/src/bc/src/hash.c +++ b/racket/src/bc/src/hash.c @@ -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); diff --git a/racket/src/bc/src/list.c b/racket/src/bc/src/list.c index 4129fedcf4..d2ded95b86 100644 --- a/racket/src/bc/src/list.c +++ b/racket/src/bc/src/list.c @@ -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); diff --git a/racket/src/bc/src/schemef.h b/racket/src/bc/src/schemef.h index 3d524660a8..a2360017aa 100644 --- a/racket/src/bc/src/schemef.h +++ b/racket/src/bc/src/schemef.h @@ -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(); diff --git a/racket/src/bc/src/schminc.h b/racket/src/bc/src/schminc.h index 2d8365a69b..9bd3b214bf 100644 --- a/racket/src/bc/src/schminc.h +++ b/racket/src/bc/src/schminc.h @@ -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 diff --git a/racket/src/bc/src/schpriv.h b/racket/src/bc/src/schpriv.h index 5bced9c71e..7ef5871511 100644 --- a/racket/src/bc/src/schpriv.h +++ b/racket/src/bc/src/schpriv.h @@ -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); diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index d232ebfbbc..f18df40f49 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -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)] diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index 914fcb8676..a9f45f19c2 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -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)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 87f26dea19..1628fe4606 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -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 diff --git a/racket/src/cs/rumble/hash.ss b/racket/src/cs/rumble/hash.ss index 975caf2d1c..02963eff0d 100644 --- a/racket/src/cs/rumble/hash.ss +++ b/racket/src/cs/rumble/hash.ss @@ -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)] diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 911bcb7e6f..eb21234a0b 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -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