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

add make-ephemeron-eq-hashtable, etc.

Browse Source 
Revert the use of ephemeron pairs in weak hashtables, since the
difference is visible via guardians. Add hashtable based on ephemerons
(to avoid key-in-value problems) as an explicit variant.

original commit: 31ac6d78592e1a9ba6bfbe802260e3d56d4cf772
This commit is contained in:
Matthew Flatt 2017-07-06 13:47:54 -06:00
parent fd7606ca05
commit 59c772ba48
15 changed files with 1216 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
LOG
View File

@ -529,3 +529,8 @@
bytevector.ms, root-experr*
- fixed typo in S_abnormal_exit
schsig.c
- revert use of ephemerons in weak hashtables, add ephemeron
hashtables
newhash.ss, hashtable-types.ss, library.ss, primdata.ss,
fasl.ss, fasl.c, gc.c, globals.h,
hash.ms, objects.stex, release_notes.stex

25
c/fasl.c
View File

@ -722,7 +722,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
return;
}
case fasl_type_eq_hashtable: {
ptr rtd, ht, v; IBOOL weakp; uptr veclen, i, n;
ptr rtd, ht, v; uptr subtype; uptr veclen, i, n;
if ((rtd = S_G.eq_ht_rtd) == Sfalse) {
S_G.eq_ht_rtd = rtd = SYMVAL(S_intern((const unsigned char *)"$eq-ht-rtd"));
if (!Srecordp(rtd)) S_error_abort("$eq-ht-rtd has not been set");
@ -731,7 +731,15 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
RECORDINSTTYPE(ht) = rtd;
INITPTRFIELD(ht,eq_hashtable_type_disp) = S_G.eq_symbol;
INITPTRFIELD(ht,eq_hashtable_mutablep_disp) = bytein(f) ? Strue : Sfalse;
INITPTRFIELD(ht,eq_hashtable_weakp_disp) = (weakp = bytein(f)) ? Strue : Sfalse;
switch ((subtype = bytein(f))) {
case eq_hashtable_subtype_normal:
case eq_hashtable_subtype_weak:
case eq_hashtable_subtype_ephemeron:
INITPTRFIELD(ht,eq_hashtable_subtype_disp) = FIX(subtype);
break;
default:
S_error2("", "invalid eq-hashtable subtype code", FIX(subtype), f->uf->path);
}
INITPTRFIELD(ht,eq_hashtable_minlen_disp) = FIX(uptrin(f));
veclen = uptrin(f);
INITPTRFIELD(ht,eq_hashtable_vec_disp) = v = S_vector(veclen);
@ -740,7 +748,18 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
for (i = 0; i < veclen ; i += 1) { INITVECTIT(v, i) = FIX(i); }
while (n > 0) {
ptr keyval;
keyval = weakp ? S_cons_in(space_weakpair, 0, FIX(0), FIX(0)) : Scons(FIX(0), FIX(0));
switch (subtype) {
case eq_hashtable_subtype_normal:
keyval = Scons(FIX(0), FIX(0));
break;
case eq_hashtable_subtype_weak:
keyval = S_cons_in(space_weakpair, 0, FIX(0), FIX(0));
break;
case eq_hashtable_subtype_ephemeron:
default:
keyval = S_cons_in(space_ephemeron, 0, FIX(0), FIX(0));
break;
}
faslin(tc, &INITCAR(keyval), t, pstrbuf, f);
faslin(tc, &INITCDR(keyval), t, pstrbuf, f);
i = ((uptr)Scar(keyval) >> primary_type_bits) & (veclen - 1);

2
c/gc.c
View File

@ -1205,7 +1205,7 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
for (b = TLCNEXT(tlc); !Sfixnump(b); b = TLCNEXT(b));
old_idx = UNFIX(b);
if (key == Sbwp_object && PTRFIELD(ht,eq_hashtable_weakp_disp) != Sfalse) {
if (key == Sbwp_object && PTRFIELD(ht,eq_hashtable_subtype_disp) != FIX(eq_hashtable_subtype_normal)) {
/* remove tlc */
b = Svector_ref(vec, old_idx);
if (b == tlc) {

64
csug/objects.stex
View File

@ -1847,9 +1847,13 @@ except the keys of the hashtable are held weakly, i.e., they are not
protected from the garbage collector.
Keys reclaimed by the garbage collector are removed from the table,
and their associated values are dropped the next time the table
is modified, if not sooner. A value in the hashtable can refer to a
key in the hashtable without preventing the garbage collector from
reclaiming the key (because keys are paired values using ephemeron pairs).
is modified, if not sooner.
Values in the hashtable are referenced normally as long as the key is
not reclaimed, since keys are paired values using weak pairs. Consequently,
if a value in the hashtable refers to its own key, then
garbage collection is prevented from reclaiming the key. See
\scheme{make-ephemeron-eq-hashtable} and \scheme{make-ephemeron-eqv-hashtable}.
A copy of a weak eq or eqv hashtable created by \scheme{hashtable-copy} is
also weak.
@ -1864,6 +1868,32 @@ The effect of this can be observed via \scheme{hashtable-keys} and
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{make-ephemeron-eq-hashtable}{\categoryprocedure}{(make-ephemeron-eq-hashtable)}
\formdef{make-ephemeron-eq-hashtable}{\categoryprocedure}{(make-ephemeron-eq-hashtable \var{size})}
\formdef{make-ephemeron-eqv-hashtable}{\categoryprocedure}{(make-ephemeron-eqv-hashtable)}
\formdef{make-ephemeron-eqv-hashtable}{\categoryprocedure}{(make-ephemeron-eqv-hashtable \var{size})}
\returns a new ephemeron eq hashtable
\listlibraries
\endentryheader
These procedures are like \scheme{make-weak-eq-hashtable} and
\scheme{make-weak-eqv-hashtable}, but a value in the hashtable can refer to a
key in the hashtable without preventing garbage collection from
reclaiming the key, because keys are paired with values using ephemeron pairs.
A copy of an ephemeron eq or eqv hashtable created by
\scheme{hashtable-copy} is also an ephemeron table, and inaccesible
key can be dropped from an immutable ephemeron hashtable in the same
way as for an immutable weak hashtable.
\schemedisplay
(define ht1 (make-ephemeron-eq-hashtable))
(define ht2 (make-ephemeron-eq-hashtable 32))
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{hashtable-weak?}{\categoryprocedure}{(hashtable-weak? \var{obj})}
@ -1878,6 +1908,20 @@ The effect of this can be observed via \scheme{hashtable-keys} and
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{hashtable-ephemeron?}{\categoryprocedure}{(hashtable-ephemeron? \var{obj})}
\returns \scheme{#t} if \var{obj} is an ephemeron eq or eqv hashtable, \scheme{#f} otherwise
\listlibraries
\endentryheader
\schemedisplay
(define ht1 (make-ephemeron-eq-hashtable))
(define ht2 (hashtable-copy ht1))
(hashtable-ephemeron? ht2) ;=> #t
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{eq-hashtable?}{\categoryprocedure}{(eq-hashtable? \var{obj})}
@ -1904,6 +1948,20 @@ The effect of this can be observed via \scheme{hashtable-keys} and
(eq-hashtable-weak? (make-weak-eq-hashtable)) ;=> #t
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{eq-hashtable-ephemeron?}{\categoryprocedure}{(eq-hashtable-ephemeron? \var{hashtable})}
\returns \scheme{#t} if \var{hashtable} uses ephemeron pairs, \scheme{#f} otherwise
\listlibraries
\endentryheader
\var{hashtable} must be an eq hashtable.
\schemedisplay
(eq-hashtable-ephemeron? (make-eq-hashtable)) ;=> #f
(eq-hashtable-ephemeron? (make-ephemeron-eq-hashtable)) ;=> #t
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{eq-hashtable-set!}{\categoryprocedure}{(eq-hashtable-set! \var{hashtable} \var{key} \var{value})}

1063
mats/hash.ms
View File

File diff suppressed because it is too large Load Diff

14
mats/root-experr-compile-0-f-f-f
View File

@ -7506,6 +7506,9 @@ hash.mo:Expected error in mat hashtable-arguments: "hashtable-equivalence-functi
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-weak?)".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-weak? $ht 3)".
hash.mo:Expected error in mat hashtable-arguments: "hashtable-weak?: (hash . table) is not a hashtable".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-ephemeron?)".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-ephemeron? $ht 3)".
hash.mo:Expected error in mat hashtable-arguments: "hashtable-ephemeron?: (hash . table) is not a hashtable".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value "oops" for any".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 3.5 for any".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 1+2i for any".
@ -7528,6 +7531,10 @@ hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (make-ephemeron-eq-hashtable 3 #t)".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref $wht)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref $wht (quote a))".
@ -7563,6 +7570,9 @@ hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-cell: (hash
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-weak?)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-weak? $ht 3)".
hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-weak?: (hash . table) is not an eq hashtable".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ephemeron?)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ephemeron? $ht 3)".
hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-ephemeron?: (hash . table) is not an eq hashtable".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref)".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref $symht)".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref $symht (quote a))".
@ -7617,6 +7627,10 @@ hash.mo:Expected error in mat eqv-hashtable-arguments: "incorrect argument count
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eqv-hashtable-arguments: "incorrect argument count in call (make-ephemeron-eqv-hashtable 3 #t)".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #f".
hash.mo:Expected error in mat generic-hashtable: "hashtable-clear!: #<hashtable> is not mutable".
hash.mo:Expected error in mat generic-hashtable: "hashtable-delete!: #<hashtable> is not mutable".
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".

14
mats/root-experr-compile-2-f-f-f
View File

@ -7506,6 +7506,9 @@ hash.mo:Expected error in mat hashtable-arguments: "hashtable-equivalence-functi
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-weak?)".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-weak? $ht 3)".
hash.mo:Expected error in mat hashtable-arguments: "hashtable-weak?: (hash . table) is not a hashtable".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-ephemeron?)".
hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-ephemeron? $ht 3)".
hash.mo:Expected error in mat hashtable-arguments: "hashtable-ephemeron?: (hash . table) is not a hashtable".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value "oops" for any".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 3.5 for any".
hash.mo:Expected error in mat hash-return-value: "hashtable-ref: invalid hash-function #<procedure> return value 1+2i for any".
@ -7528,6 +7531,10 @@ hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-weak-eq-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (make-ephemeron-eq-hashtable 3 #t)".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eq-hashtable-arguments: "make-ephemeron-eq-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref $wht)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ref $wht (quote a))".
@ -7563,6 +7570,9 @@ hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-cell: (hash
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-weak?)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-weak? $ht 3)".
hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-weak?: (hash . table) is not an eq hashtable".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ephemeron?)".
hash.mo:Expected error in mat eq-hashtable-arguments: "incorrect argument count in call (eq-hashtable-ephemeron? $ht 3)".
hash.mo:Expected error in mat eq-hashtable-arguments: "eq-hashtable-ephemeron?: (hash . table) is not an eq hashtable".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref)".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref $symht)".
hash.mo:Expected error in mat symbol-hashtable-arguments: "incorrect argument count in call (symbol-hashtable-ref $symht (quote a))".
@ -7617,6 +7627,10 @@ hash.mo:Expected error in mat eqv-hashtable-arguments: "incorrect argument count
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-weak-eqv-hashtable: invalid size argument #f".
hash.mo:Expected error in mat eqv-hashtable-arguments: "incorrect argument count in call (make-ephemeron-eqv-hashtable 3 #t)".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument -1".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #t".
hash.mo:Expected error in mat eqv-hashtable-arguments: "make-ephemeron-eqv-hashtable: invalid size argument #f".
hash.mo:Expected error in mat generic-hashtable: "hashtable-clear!: #<hashtable> is not mutable".
hash.mo:Expected error in mat generic-hashtable: "hashtable-delete!: #<hashtable> is not mutable".
hash.mo:Expected error in mat generic-hashtable: "hashtable-update!: #<hashtable> is not mutable".

13
release_notes/release_notes.stex
View File

@ -78,6 +78,19 @@ procedures.
Immutable boxes are created via \scheme{box-immutable}.
Any attempt to modify an immutable object causes an exception to be raised.
\subsection{Ephemeron pairs and hashtables (9.4.1)}
Support for ephemeron pairs has been added, along with eq and eqv
hashtables that use ephemeron pairs to combine keys and values. An
ephemeron pair avoids the ``key in value'' problem of weak pairs,
where a weakly held key is paired to a value that refers back to the
key, in which case the key remains reachable as long as the pair is
reachable. In an ephemeron pair, the cdr of the pair is not considered
reachable by the garbage collector until both the pair and the car of
the pair have been found reachable. An ephemeron hashtable implements
a weak mapping where referencing a key in a value does not prevent the
mapping from being removed from the table.
\subsection{Optional timeout for \protect\scheme{condition-wait} (9.4.1)}
The \scheme{condition-wait} procedure now takes an optional

4
s/cmacros.ss
View File

@ -1845,6 +1845,10 @@
(define-constant hashtable-default-size 8)
(define-constant eq-hashtable-subtype-normal 0)
(define-constant eq-hashtable-subtype-weak 1)
(define-constant eq-hashtable-subtype-ephemeron 2)
; keep in sync with make-date
(define-constant dtvec-nsec 0)
(define-constant dtvec-sec 1)

19
s/cpnanopass.ss
View File

@ -8940,11 +8940,11 @@
[(quote ,d) (and (and (fixnum? d) (fx<= d 4)) (add-cdrs d e-ls))]
[else #f])]))
(let ()
(define (go0 src sexpr weak?)
(define (go0 src sexpr subtype)
(%primcall src sexpr $make-eq-hashtable
(immediate ,(fix (constant hashtable-default-size)))
(immediate ,weak?)))
(define (go1 src sexpr e-size weak?)
(immediate ,(fix subtype))))
(define (go1 src sexpr e-size subtype)
(nanopass-case (L7 Expr) e-size
[(quote ,d)
; d must be a fixnum? for $hashtable-size-minlen and a
@ -8952,14 +8952,17 @@
(and (and (fixnum? d) (target-fixnum? d) (fx>= d 0))
(%primcall src sexpr $make-eq-hashtable
(immediate ,(fix ($hashtable-size->minlen d)))
(immediate ,weak?)))]
(immediate ,(fix subtype))))]
[else #f]))
(define-inline 3 make-eq-hashtable
[() (go0 src sexpr (constant sfalse))]
[(e-size) (go1 src sexpr e-size (constant sfalse))])
[() (go0 src sexpr (constant eq-hashtable-subtype-normal))]
[(e-size) (go1 src sexpr e-size (constant eq-hashtable-subtype-normal))])
(define-inline 3 make-weak-eq-hashtable
[() (go0 src sexpr (constant strue))]
[(e-size) (go1 src sexpr e-size (constant strue))]))
[() (go0 src sexpr (constant eq-hashtable-subtype-weak))]
[(e-size) (go1 src sexpr e-size (constant eq-hashtable-subtype-weak))])
(define-inline 3 make-ephemeron-eq-hashtable
[() (go0 src sexpr (constant eq-hashtable-subtype-ephemeron))]
[(e-size) (go1 src sexpr e-size (constant eq-hashtable-subtype-ephemeron))]))
(let ()
(define-syntax def-put-x
(syntax-rules ()

5
s/fasl.ss
View File

@ -432,7 +432,10 @@
(lambda (x p t a?)
(put-u8 p (constant fasl-type-eq-hashtable))
(put-u8 p (if (hashtable-mutable? x) 1 0))
(put-u8 p (if (eq-hashtable-weak? x) 1 0))
(put-u8 p (cond
[(eq-hashtable-weak? x) (constant eq-hashtable-subtype-weak)]
[(eq-hashtable-ephemeron? x) (constant eq-hashtable-subtype-ephemeron)]
[else (constant eq-hashtable-subtype-normal)]))
(put-uptr p ($ht-minlen x))
(put-uptr p ($ht-veclen x))
(let-values ([(keyvec valvec) (hashtable-entries x)])

4
s/hashtable-types.ss
View File

@ -24,8 +24,8 @@
(define-record-type eq-ht
(parent ht)
(fields (immutable weak?))
(nongenerative #{eq-ht bu811z2onf9o6tfc-5})
(fields (immutable subtype)) ; eq-hashtable-subtype-{normal,weak,ephemeron}
(nongenerative #{eq-ht icguu8mlhm1y7ywsairxck-0})
(sealed #t))
(define-record-type symbol-ht

12
s/library.ss
View File

@ -1435,7 +1435,11 @@
[b (vector-ref vec idx)])
(lookup-keyval x b
values
(let ([keyval (if (eq-ht-weak? h) (ephemeron-cons x v) (cons x v))])
(let ([keyval (let ([subtype (eq-ht-subtype h)])
(cond
[(eq? subtype (constant eq-hashtable-subtype-normal)) (cons x v)]
[(eq? subtype (constant eq-hashtable-subtype-weak)) (weak-cons x v)]
[else (ephemeron-cons x v)]))])
(vector-set! vec idx ($make-tlc h keyval b))
(incr-size! h vec)
keyval))))
@ -1451,7 +1455,11 @@
(begin
(vector-set! vec idx
($make-tlc h
(if (eq-ht-weak? h) (ephemeron-cons x v) (cons x v))
(let ([subtype (eq-ht-subtype h)])
(cond
[(eq? subtype (constant eq-hashtable-subtype-normal)) (cons x v)]
[(eq? subtype (constant eq-hashtable-subtype-weak)) (weak-cons x v)]
[else (ephemeron-cons x v)]))
b))
(incr-size! h vec))))))

72
s/newhash.ss
View File

@ -61,6 +61,7 @@ Documentation notes:
;;; other generic hash operators
(define hashtable-cell)
(define hashtable-weak?) ; hashtable
(define hashtable-ephemeron?) ; hashtable
;;; eq-hashtable operators
(define make-weak-eq-hashtable) ; [k], k >= 0
@ -71,6 +72,7 @@ Documentation notes:
(define eq-hashtable-cell) ; eq-hashtable key default
(define eq-hashtable-delete!) ; eq-hashtable key
(define eq-hashtable-weak?) ; eq-hashtable
(define eq-hashtable-ephemeron?) ; eq-hashtable
;;; eq-hashtable operators
(define make-symbol-hashtable) ; [k], k >= 0
@ -85,7 +87,7 @@ Documentation notes:
(define make-weak-eqv-hashtable) ; [k], k >= 0
;;; unsafe eq-hashtable operators
(define $make-eq-hashtable) ; fxminlen weak?, fxminlen = 2^n, n >= 0
(define $make-eq-hashtable) ; fxminlen subtype, fxminlen = 2^n, n >= 0
(define $eq-hashtable-keys) ; eq-hashtable
(define $eq-hashtable-values) ; eq-hashtable
(define $eq-hashtable-entries) ; eq-hashtable
@ -393,8 +395,8 @@ Documentation notes:
[else (logxor (lognot (number-hash (real-part z))) (number-hash (imag-part z)))])))
(set! $make-eq-hashtable ; assumes minlen is a power of two >= 1
(lambda (minlen weak?)
(make-eq-ht 'eq #t ($make-eqhash-vector minlen) minlen 0 weak?)))
(lambda (minlen subtype)
(make-eq-ht 'eq #t ($make-eqhash-vector minlen) minlen 0 subtype)))
(set-who! $hashtable-veclen
(lambda (h)
@ -444,8 +446,11 @@ Documentation notes:
; csv7 interface
(set! make-hash-table
(case-lambda
[() ($make-eq-hashtable (constant hashtable-default-size) #f)]
[(weak?) ($make-eq-hashtable (constant hashtable-default-size) weak?)]))
[() ($make-eq-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-normal))]
[(weak?) ($make-eq-hashtable (constant hashtable-default-size)
(if weak?
(constant eq-hashtable-subtype-weak)
(constant eq-hashtable-subtype-normal)))]))
(set! hash-table?
(lambda (x)
@ -488,13 +493,18 @@ Documentation notes:
(set-who! make-eq-hashtable
(case-lambda
[() ($make-eq-hashtable (constant hashtable-default-size) #f)]
[(k) ($make-eq-hashtable (size->minlen who k) #f)]))
[() ($make-eq-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-normal))]
[(k) ($make-eq-hashtable (size->minlen who k) (constant eq-hashtable-subtype-normal))]))
(set-who! make-weak-eq-hashtable
(case-lambda
[() ($make-eq-hashtable (constant hashtable-default-size) #t)]
[(k) ($make-eq-hashtable (size->minlen who k) #t)]))
[() ($make-eq-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-weak))]
[(k) ($make-eq-hashtable (size->minlen who k) (constant eq-hashtable-subtype-weak))]))
(set-who! make-ephemeron-eq-hashtable
(case-lambda
[() ($make-eq-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-ephemeron))]
[(k) ($make-eq-hashtable (size->minlen who k) (constant eq-hashtable-subtype-ephemeron))]))
(let ()
(define $make-hashtable
@ -507,9 +517,9 @@ Documentation notes:
(make-symbol-ht 'symbol #t (make-vector minlen '()) minlen 0 equiv?)
(make-gen-ht 'generic #t (make-vector minlen '()) minlen 0 hash equiv?))))
(define $make-eqv-hashtable
(lambda (minlen weak?)
(lambda (minlen subtype)
(make-eqv-ht 'eqv #t
($make-eq-hashtable minlen weak?)
($make-eq-hashtable minlen subtype)
($make-hashtable minlen number-hash eqv?))))
(set-who! make-hashtable
(case-lambda
@ -523,12 +533,16 @@ Documentation notes:
($make-hashtable (size->minlen who k) hash equiv?)]))
(set-who! make-eqv-hashtable
(case-lambda
[() ($make-eqv-hashtable (constant hashtable-default-size) #f)]
[(k) ($make-eqv-hashtable (size->minlen who k) #f)]))
[() ($make-eqv-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-normal))]
[(k) ($make-eqv-hashtable (size->minlen who k) (constant eq-hashtable-subtype-normal))]))
(set-who! make-weak-eqv-hashtable
(case-lambda
[() ($make-eqv-hashtable (constant hashtable-default-size) #t)]
[(k) ($make-eqv-hashtable (size->minlen who k) #t)])))
[() ($make-eqv-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-weak))]
[(k) ($make-eqv-hashtable (size->minlen who k) (constant eq-hashtable-subtype-weak))]))
(set-who! make-ephemeron-eqv-hashtable
(case-lambda
[() ($make-eqv-hashtable (constant hashtable-default-size) (constant eq-hashtable-subtype-ephemeron))]
[(k) ($make-eqv-hashtable (size->minlen who k) (constant eq-hashtable-subtype-ephemeron))])))
(set! eq-hashtable-ref
(lambda (h x v)
@ -577,14 +591,27 @@ Documentation notes:
(set-who! eq-hashtable-weak?
(lambda (h)
(unless (eq-ht? h) ($oops who "~s is not an eq hashtable" h))
(eq-ht-weak? h)))
(eq? (constant eq-hashtable-subtype-weak) (eq-ht-subtype h))))
(set-who! eq-hashtable-ephemeron?
(lambda (h)
(unless (eq-ht? h) ($oops who "~s is not an eq hashtable" h))
(eq? (constant eq-hashtable-subtype-ephemeron) (eq-ht-subtype h))))
(set-who! hashtable-weak?
(lambda (h)
(unless (xht? h) ($oops who "~s is not a hashtable" h))
(case (xht-type h)
[(eq) (eq-ht-weak? h)]
[(eqv) (eq-ht-weak? (eqv-ht-eqht h))]
[(eq) (eq? (constant eq-hashtable-subtype-weak) (eq-ht-subtype h))]
[(eqv) (eq? (constant eq-hashtable-subtype-weak) (eq-ht-subtype (eqv-ht-eqht h)))]
[else #f])))
(set-who! hashtable-ephemeron?
(lambda (h)
(unless (xht? h) ($oops who "~s is not a hashtable" h))
(case (xht-type h)
[(eq) (eq? (constant eq-hashtable-subtype-ephemeron) (eq-ht-subtype h))]
[(eqv) (eq? (constant eq-hashtable-subtype-ephemeron) (eq-ht-subtype (eqv-ht-eqht h)))]
[else #f])))
(set-who! symbol-hashtable-ref
@ -1004,11 +1031,11 @@ Documentation notes:
(set! $eq-hashtable-copy
(lambda (h1 mutable?)
(let ([weak? (eq-ht-weak? h1)])
(let ([subtype (eq-ht-subtype h1)])
(let* ([vec1 (ht-vec h1)]
[n (vector-length vec1)]
[vec2 ($make-eqhash-vector n)]
[h2 (make-eq-ht 'eq mutable? vec2 (ht-minlen h1) (ht-size h1) weak?)])
[h2 (make-eq-ht 'eq mutable? vec2 (ht-minlen h1) (ht-size h1) subtype)])
(let outer ([i 0])
(if (fx= i n)
h2
@ -1019,7 +1046,10 @@ Documentation notes:
b
($make-tlc h2
(let* ([keyval ($tlc-keyval b)] [key (car keyval)] [val (cdr keyval)])
(if weak? (ephemeron-cons key val) (cons key val)))
(cond
[(eq? subtype (constant eq-hashtable-subtype-normal)) (cons key val)]
[(eq? subtype (constant eq-hashtable-subtype-weak)) (weak-cons key val)]
[else (ephemeron-cons key val)]))
(inner ($tlc-next b))))))
(outer (fx+ i 1)))))
h2))))

4
s/primdata.ss
View File

@ -1254,6 +1254,7 @@
(eq-hashtable-cell [sig [(eq-hashtable ptr ptr) -> ((ptr . ptr))]] [flags true])
(eq-hashtable-contains? [sig [(eq-hashtable ptr) -> (boolean)]] [flags discard])
(eq-hashtable-delete! [sig [(eq-hashtable ptr) -> (void)]] [flags true])
(eq-hashtable-ephemeron? [sig [(eq-hashtable) -> (boolean)]] [flags pure mifoldable discard])
(eq-hashtable-ref [sig [(eq-hashtable ptr ptr) -> (ptr)]] [flags discard])
(eq-hashtable-set! [sig [(eq-hashtable ptr ptr) -> (void)]] [flags true])
(eq-hashtable-update! [sig [(eq-hashtable ptr procedure ptr) -> (void)]] [flags])
@ -1360,6 +1361,7 @@
(getenv [sig [(string) -> (maybe-string)]] [flags discard])
(getprop [sig [(symbol ptr) (symbol ptr ptr) -> (ptr)]] [flags discard])
(hash-table? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
(hashtable-ephemeron? [sig [(hashtable) -> (boolean)]] [flags pure mifoldable discard])
(hash-table-for-each [sig [(old-hash-table procedure) -> (void)]] [flags])
(hash-table-map [sig [(old-hash-table procedure) -> (list)]] [flags true])
(hashtable-cell [sig [(old-hash-table ptr ptr) -> ((ptr . ptr))]] [flags true])
@ -1412,6 +1414,8 @@
(make-condition [feature pthreads] [sig [() -> (condition-object)]] [flags pure unrestricted alloc])
(make-continuation-condition [sig [(ptr) -> (condition)]] [flags pure unrestricted mifoldable discard])
(make-cost-center [sig [() -> (cost-center)]] [flags unrestricted alloc])
(make-ephemeron-eq-hashtable [sig [() (uint) -> (eq-hashtable)]] [flags alloc])
(make-ephemeron-eqv-hashtable [sig [() (uint) -> (hashtable)]] [flags alloc])
(make-engine [sig [(procedure) -> (engine)]] [flags pure alloc])
(make-format-condition [sig [() -> (condition)]] [flags pure unrestricted mifoldable discard])
(make-fxvector [sig [(length) (length fixnum) -> (fxvector)]] [flags alloc])