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

cs (mostly): fix hash table problems

Browse Source 
RacketCS weak `equal?`-based hash tables didn't retain flonums, and
hashing of hash tables was not properly insensitive to the order of
keys.

Racket, meanwhile, didn't limit work consistently for different kinds
of hash tables, and it didn't keep a counter value odd as intended
(but the counter never gets large enough to appear to be a mapped
pointer, anyway).
This commit is contained in:
Matthew Flatt 2018-08-18 21:10:28 -06:00
parent 27693843ea
commit 008102decc
4 changed files with 64 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2261,7 +2261,7 @@
(hash-set! h1 (save a) 'struct)
(hash-set! h1 (save an-ax) 'structx)
(hash-set! h1 (save b) 'box)
(hash-set! h1 cyclic-list 'cyclic-list))])
(hash-set! h1 (save cyclic-list) 'cyclic-list))])
(if reorder?
(begin
(puts2)

9
racket/src/cs/rumble/hash-code.ss
View File

@ -125,6 +125,15 @@
(vec-loop (fx+ i 1)
burn
(+/fx (mix2 hc) hc0)))]))]))]
[(hash? x)
;; Treat hash-table hashing specially, so it can be order-insensitive
(let ([burn (fx* (fxmax burn 1) 2)])
(let ([hc (+/fx hc (->fx (hash-hash-code
x
(lambda (x)
(let-values ([(hc0 burn0) (equal-hash-loop x burn 0)])
hc0)))))])
(values hc burn)))]
[(and (#%$record? x) (#%$record-hash-procedure x))
=> (lambda (rec-hash)
(let ([burn (fx+ burn 2)])

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

@ -692,6 +692,7 @@
(define-record weak-equal-hash locked-iterable-hash
(keys-ht ; integer[equal hash code] -> weak list of keys
vals-ht ; weak, eq?-based hash table: key -> value
fl-vals-ht ; eqv?-based hash table: flonum-key -> value
count ; number of items in the table (= sum of list lengths)
prune-at)) ; count at which we should try to prune empty weak boxes
@ -699,7 +700,7 @@
(define make-weak-hash
(case-lambda
[() (make-weak-equal-hash (make-lock 'equal?) #f #f (hasheqv) (make-weak-eq-hashtable) 0 128)]
[() (make-weak-equal-hash (make-lock 'equal?) #f #f (hasheqv) (make-weak-eq-hashtable) (make-eqv-hashtable) 0 128)]
[(alist) (fill-hash! 'make-weak-hash (make-weak-hash) alist)]))
(define (weak-hash-copy ht)
@ -709,11 +710,17 @@
#t
(weak-equal-hash-keys-ht ht)
(hashtable-copy (weak-equal-hash-vals-ht ht) #t)
(hashtable-copy (weak-equal-hash-fl-vals-ht ht) #t)
(weak-equal-hash-count ht)
(weak-equal-hash-prune-at ht))])
(lock-release (weak-equal-hash-lock ht))
new-ht))
(define (weak-equal-hash-*vals-ht t k)
(if (flonum? k)
(weak-equal-hash-fl-vals-ht t)
(weak-equal-hash-vals-ht t)))
(define (weak-hash-ref t key fail)
(let ([code (key-equal-hash-code key)])
(lock-acquire (weak-equal-hash-lock t))
@ -727,7 +734,8 @@
(|#%app| fail)
fail)]
[(key-equal? (car keys) key)
(let ([v (hashtable-ref (weak-equal-hash-vals-ht t) (car keys) none)])
(let* ([k (car keys)]
[v (hashtable-ref (weak-equal-hash-*vals-ht t k) (car keys) none)])
(lock-release (weak-equal-hash-lock t))
(if (eq? v none)
(if (procedure? fail)
@ -764,10 +772,11 @@
(intmap-set ht code
(weak/fl-cons k
(intmap-ref ht code '()))))
(hashtable-set! (weak-equal-hash-vals-ht t) k v))
(hashtable-set! (weak-equal-hash-*vals-ht t k) k v))
(lock-release (weak-equal-hash-lock t))]
[(key-equal? (car keys) k)
(hashtable-set! (weak-equal-hash-vals-ht t) (car keys) v)
(let ([k (car keys)])
(hashtable-set! (weak-equal-hash-*vals-ht t k) k v))
(lock-release (weak-equal-hash-lock t))]
[else (loop (cdr keys))])))))
@ -785,7 +794,7 @@
(and (key-equal? a k)
a))
=> (lambda (a)
(let ([ht (weak-equal-hash-vals-ht t)])
(let ([ht (weak-equal-hash-*vals-ht t a)])
(cond
[(locked-iterable-hash-cells t)
;; Clear cell, because it may be in `(locked-iterable-hash-cells ht)`
@ -815,20 +824,24 @@
(lock-acquire (weak-equal-hash-lock t))
(set-weak-equal-hash-keys-ht! t (hasheqv))
(hashtable-clear! (weak-equal-hash-vals-ht t))
(hashtable-clear! (weak-equal-hash-fl-vals-ht t))
(set-weak-equal-hash-count! t 0)
(set-weak-equal-hash-prune-at! t 128)
(set-locked-iterable-hash-cells! t #f)
(lock-release (weak-equal-hash-lock t)))
(define (weak-hash-for-each t proc)
(let* ([ht (weak-equal-hash-vals-ht t)]
[keys (hashtable-keys ht)]
[len (#%vector-length keys)])
(let loop ([i 0])
(unless (fx= i len)
(let ([key (#%vector-ref keys i)])
(|#%app| proc key (hashtable-ref ht key #f)))
(loop (fx1+ i))))))
(let ([ht-for-each
(lambda (ht)
(let* ([keys (hashtable-keys ht)]
[len (#%vector-length keys)])
(let loop ([i 0])
(unless (fx= i len)
(let ([key (#%vector-ref keys i)])
(|#%app| proc key (hashtable-ref ht key #f)))
(loop (fx1+ i))))))])
(ht-for-each (weak-equal-hash-vals-ht t))
(ht-for-each (weak-equal-hash-fl-vals-ht t))))
(define (weak-hash-map t proc)
(let* ([ht (weak-equal-hash-vals-ht t)]
@ -836,18 +849,28 @@
[len (#%vector-length keys)])
(let loop ([i 0])
(cond
[(fx= i len) '()]
[else
(let ([key (#%vector-ref keys i)])
(cons (|#%app| proc key (hashtable-ref ht key #f))
(loop (fx1+ i))))]))))
[(fx= i len)
(let* ([ht (weak-equal-hash-fl-vals-ht t)]
[keys (hashtable-keys ht)]
[len (#%vector-length keys)])
(let loop ([i 0])
(cond
[(fx= i len) '()]
[else
(let ([key (#%vector-ref keys i)])
(cons (|#%app| proc key (hashtable-ref ht key #f))
(loop (fx1+ i))))])))]
[else
(let ([key (#%vector-ref keys i)])
(cons (|#%app| proc key (hashtable-ref ht key #f))
(loop (fx1+ i))))]))))
(define (weak-hash-count t)
(hashtable-size (weak-equal-hash-vals-ht t)))
(fx+ (hashtable-size (weak-equal-hash-vals-ht t))
(hashtable-size (weak-equal-hash-fl-vals-ht t))))
(define (weak-equal-hash-cells ht len)
(let ([vals-ht (weak-equal-hash-vals-ht ht)]
[vec (make-vector len #f)]
(let ([vec (make-vector len #f)]
[pos (box 0)])
(call/cc
(lambda (esc)
@ -862,7 +885,7 @@
(cond
[(eq? #!bwp key) (loop (cdr l))]
[else
(#%vector-set! vec (unbox pos) (hashtable-cell vals-ht key #f))
(#%vector-set! vec (unbox pos) (hashtable-cell (weak-equal-hash-*vals-ht ht key) key #f))
(set-box! pos (add1 (unbox pos)))
(if (= (unbox pos) len)
;; That's enough keys

15
racket/src/racket/src/hash.c
View File

@ -1739,8 +1739,11 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
# include "mzhashchk.inc"
/* mult to counteract potential explosion due to old_depth reset */
# define GROW_RESET_DEPTH(n) ((n * 2) + 1)
k = (k << 1) + 3;
hi->depth *= 2; /* mult to counteract potential explosion due to old_depth reset */
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
keys = ht->keys;
@ -1777,7 +1780,7 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
# include "mzhashchk.inc"
k = (k << 1) + 3;
hi->depth += 2;
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
/* hash tree holds pre-computed hashes for keys, so use those: */
@ -1811,7 +1814,7 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
buckets = ht->buckets;
weak = ht->weak;
hi->depth += 2;
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
k = (k << 1) + 7;
@ -2228,7 +2231,7 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
# include "mzhashchk.inc"
hi->depth *= 2; /* mult to counteract potential explosion due to old_depth reset */
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
keys = ht->keys;
@ -2267,7 +2270,7 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
# include "mzhashchk.inc"
hi->depth += 2;
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
/* hash tree holds pre-computed hashes for keys, so use those: */
@ -2298,7 +2301,7 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
buckets = ht->buckets;
weak = ht->weak;
hi->depth += 2;
hi->depth = GROW_RESET_DEPTH(hi->depth);
old_depth = hi->depth;
for (i = ht->size; i--; ) {