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

cs: repairs for old vector-based HAMT

Browse Source 
Sync the old implementation with some repairs for `equal?/recur` and
key replacement.
This commit is contained in:
Matthew Flatt 2020-09-29 08:38:35 -06:00
parent c4df79b38d
commit 58deff8b6f
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/src/cs/rumble/hamt-vector.ss
View File

@ -394,7 +394,8 @@
[v (val-ref node ki)]) [v (val-ref node ki)])
(cond (cond
[(key=? node key k) [(key=? node key k)
(if (eq? val v) (if (and (eq? val v)
(eq? key k))
node node
;; for consistency, we're required to keep the new key: ;; for consistency, we're required to keep the new key:
(bnode-replace-val node ki val key (not (eq? key k))))] (bnode-replace-val node ki val key (not (eq? key k))))]
@ -480,6 +481,7 @@
(node=? ak bk eql? (down shift))] (node=? ak bk eql? (down shift))]
[else [else
(and (key=? a ak bk) (and (key=? a ak bk)
(eql? ak bk) ; needed for `equal?/recur`
(eql? (val-ref a i) (val-ref b i)))]) (eql? (val-ref a i) (val-ref b i)))])
(loop (fx1+ i))))]))))) (loop (fx1+ i))))])))))
@ -857,9 +859,11 @@
[(fx= i alen) #t] [(fx= i alen) #t]
[else [else
(let* ([akey (key-ref a i)] (let* ([akey (key-ref a i)]
[bval (cnode-ref b akey none2)]) [bi (cnode-index b akey)])
(and (and
(eql? (val-ref a i) bval) bi
(eql? akey (key-ref b bi)) ; needed for `equal?/recur`
(eql? (val-ref a i) (val-ref b bi))
(loop (fx1+ i))))])))))) (loop (fx1+ i))))]))))))
(define (cnode-keys-subset? a b shift) (define (cnode-keys-subset? a b shift)