add ephemeron hash tables

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.

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]))

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
+retained either strongly, weakly (see @secref["weakbox"]), or like
-table is also either mutable or immutable. Immutable hash tables
+@tech{ephemerons}. A hash table is also either mutable or immutable.
-support effectively constant-time access and update, just like mutable
+Immutable hash tables support effectively constant-time access and
-hash tables; the constant on immutable operations is usually larger,
+update, just like mutable hash tables; the constant on immutable
-but the functional nature of immutable hash tables can pay off in
+operations is usually larger, but the functional nature of immutable
-certain algorithms. Use @racket[immutable?] to check whether a hash
+hash tables can pay off in certain algorithms. Use @racket[immutable?]
-table is 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
+Two hash tables cannot be @racket[equal?] unless they have the same
-key-comparison procedure (@racket[equal?], @racket[eqv?], or
+mutability, use the same key-comparison procedure (@racket[equal?],
-@racket[eq?]), both hold keys strongly or weakly, and have the same
+@racket[eqv?], or @racket[eq?]), both hold keys strongly, weakly, or
-mutability. Empty immutable hash tables are @racket[eq?] when they
+like @tech{ephemerons}. Empty immutable hash tables are @racket[eq?]
-are @racket[equal?].
+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
+problem, use an ephemeron hash table as created by
-@tech{ephemeron} that pairs the key and value. Beware further,
+@racket[make-ephemeron-hash], @racket[make-ephemeron-hasheqv], or
-however, that an ephemeron's value might be cleared between retrieving
+@racket[make-ephemeron-hasheq]. For values that do not refer to keys,
-an ephemeron and extracting its value, depending on whether the key is
+there is a modest extra cost to using an ephemeron hash table instead
-otherwise reachable. For @racket[eq?]-based mappings, consider using
+of a weak hash table, but prefer an ephemeron hash table when in
-the pattern @racket[(ephemeron-value _ephemeron #f _key)] to extract
+doubt.}
-the value of @racket[_ephemeron] while ensuring that @racket[_key] is
+
-retained until the value is extracted.}
+
+@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]
+Returns the number of keys mapped by @racket[hash].
-retains keys weakly, the result is computed in
+
-constant time and atomically. If @racket[hash] retains it keys weakly, a
+For the @tech{CS} implementation of Racket, the result is always
-traversal is required to count the keys.}
+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
+@deftech{valid hash index} for a given hash table only as long it
-from @racket[hash-iterate-first] or @racket[hash-iterate-next], and
+comes from @racket[hash-iterate-first] or @racket[hash-iterate-next],
-only as long as the hash table is not modified. In the case of a hash
+and only as long as the hash table is not modified. In the case of a
-table with weakly held keys, the hash table can be implicitly modified
+hash table with weakly held keys or keys held like @tech{ephemerons},
-by the garbage collector (see @secref["gc-model"]) when it discovers
+the hash table can be implicitly modified by the garbage collector
-that the key is not reachable.}
+(see @secref["gc-model"]) when it discovers that the key is not
+reachable.}
 
 
 @defproc[(hash-iterate-next [hash hash?]

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].
 

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.}]
 }
 
 

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)]

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?)
+  (define (check-hash-tables weak-kind reorder?)
-    (let ([h1 (if weak? (make-weak-hasheq) (make-hasheq))]
+    (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 'weak #f)
-                        (check-hash-tables #t #t)
+                        (check-hash-tables 'weak #t)
-                        #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))))]

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)

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-hash -in-hash -in-hash -in-hash
-          -in-pairs -in-pairs -in-pairs
+          -in-pairs -in-pairs -in-pairs -in-pairs
-          -in-keys -in-keys -in-keys
+          -in-keys -in-keys -in-keys -in-keys
-          -in-values -in-values -in-values)]
+          -in-values -in-values -in-values -in-values)]
      [(_ tag
-         -in-immut-hash -in-mut-hash -in-weak-hash
+         -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-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-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-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 in-mutable-hash in-weak-hash in-ephemeron-hash
-    in-immutable-hash-pairs in-mutable-hash-pairs in-weak-hash-pairs
+    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-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-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
 

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())

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))
 

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)

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 {

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, 
+    kb = GC_malloc_weak_box((void *)key, (void **)bucket, (void **)&bucket->val XFORM_OK_MINUS (void **)bucket, 
-                            (table->weak > 1));
+                            (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)
+        if (!val2)
-	  return 0;
+          return 0;
-	if (!scheme_recur_equal(val1, val2, eql))
+        if (!scheme_recur_equal(val1, val2, eql))
-	  return 0;
+          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)
+            if (hk) {
-              bucket = allocate_bucket(table, hk, bucket->val);
+              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)
+      if (_val) {
-	*_val = (Scheme_Object *)bucket->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);

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))
+  if (SCHEME_BUCKTP(o)) {
-    return scheme_true;
+    if (!weak)
-  else if (SCHEME_HASHTP(o) || SCHEME_HASHTRP(o))
+      return scheme_false;
-    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)
+    if (((Scheme_Bucket_Table *)v)->weak == SCHEME_BT_KIND_EPHEMERON) {
-      v2 = make_weak_hasheq(0, NULL);
+      if (is_eq)
-    else if (is_eqv)
+        v2 = make_ephemeron_hasheq(0, NULL);
-      v2 = make_weak_hasheqv(0, NULL);
+      else if (is_eqv)
-    else
+        v2 = make_ephemeron_hasheqv(0, NULL);
-      v2 = make_weak_hash(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);

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);
+XFORM_NONGCING 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_key(Scheme_Object *o);
 
 MZ_EXTERN Scheme_Object *scheme_make_late_will_executor();
 

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

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);

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)]

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)]

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

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)
 
-;; ----------------------------------------
+(define unsafe-ephemeron-hash-iterate-first hash-iterate-first)
-;; When `eq?`ness of flonums is not preserved by
+(define unsafe-ephemeron-hash-iterate-next hash-iterate-next)
-;; the GC, then we need special handling for flonums.
+(define unsafe-ephemeron-hash-iterate-key hash-iterate-key)
-;; But the GC now does preserve `eq?`ness.
+(define unsafe-ephemeron-hash-iterate-value hash-iterate-value)
-
+(define unsafe-ephemeron-hash-iterate-key+value hash-iterate-key+value)
-(define (weak/fl-cons key d)
+(define unsafe-ephemeron-hash-iterate-pair hash-iterate-pair)
-  (weak-cons key d))
 
 ;; ----------------------------------------
 
@@ -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)]

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