From 58deff8b6fd20a467cb6141249af9c74ff57d644 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 29 Sep 2020 08:38:35 -0600 Subject: [PATCH] cs: repairs for old vector-based HAMT Sync the old implementation with some repairs for `equal?/recur` and key replacement. --- racket/src/cs/rumble/hamt-vector.ss | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/racket/src/cs/rumble/hamt-vector.ss b/racket/src/cs/rumble/hamt-vector.ss index 39170f049e..bc28edafb2 100644 --- a/racket/src/cs/rumble/hamt-vector.ss +++ b/racket/src/cs/rumble/hamt-vector.ss @@ -394,7 +394,8 @@ [v (val-ref node ki)]) (cond [(key=? node key k) - (if (eq? val v) + (if (and (eq? val v) + (eq? key k)) node ;; for consistency, we're required to keep the new key: (bnode-replace-val node ki val key (not (eq? key k))))] @@ -480,6 +481,7 @@ (node=? ak bk eql? (down shift))] [else (and (key=? a ak bk) + (eql? ak bk) ; needed for `equal?/recur` (eql? (val-ref a i) (val-ref b i)))]) (loop (fx1+ i))))]))))) @@ -857,9 +859,11 @@ [(fx= i alen) #t] [else (let* ([akey (key-ref a i)] - [bval (cnode-ref b akey none2)]) + [bi (cnode-index b akey)]) (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))))])))))) (define (cnode-keys-subset? a b shift)