generalize {impersonator,chaperone}-of? on immutable hash tables

pkgs/racket-doc/scribblings/reference/chaperones.scrbl

@@ -105,16 +105,29 @@ Otherwise, impersonators within @racket[v2] must be intact within
 
        @itemlist[
 
-         @item{the same value that is a part of @racket[v2];}
+         @item{the same value that is a part of @racket[v2] (with a
+         special meaning of ``the same value`` in the case of
+         immutable hash tables, as described below);}
 
-         @item{a value further derived from the part of @racket[v2]
-               value using an impersonator constructor; or}
+         @item{a value further derived from the same value that is
+               part of @racket[v2] using an impersonator constructor;
+               or}
 
          @item{a value with the @racket[prop:impersonator-of] property
-               whose procedure produces an impersonator of the value
-               that is a part of @racket[v2].}
+               whose procedure produces an impersonator of the same value
+               that is part of @racket[v2].}
 
-      ]}
+      ]
+
+      For most kinds of values, ``the same value'' means equal
+      according to @racket[eq?]. In the case of an immutable hash
+      table, two impersonated hash tables count as ``the same value''
+      when their redirection procedures were originally attached to a
+      hash table by the same call to @racket[impersonate-hash] or
+      @racket[chaperone-hash] (and potentially propagated by
+      @racket[hash-set], @racket[hash-remove], or
+      @racket[hash-clear]), as long as the content of the first hash
+      table is @racket[impersonator-of?] of the second hash table.}
 
  @item{If a part of @racket[v2] is a structure or procedure impersonator that was
        created with no redirection procedures (i.e, @racket[#f] in

pkgs/racket-test-core/tests/racket/chaperone.rktl

@@ -1137,7 +1137,7 @@
    make-weak-hash make-weak-hasheq make-weak-hasheqv)))
 
 (for-each
- (lambda (h1)
+ (lambda (h1)   
    (let* ([get-k #f]
           [get-v #f]
           [set-k #f]
@@ -1199,7 +1199,27 @@
              (set! get-v #f)
              (test #t values (equal? h2 (hash-set h1 'key 'val)))
              (test '(key val key2 val2 key2 key) list get-k get-v set-k set-v remove-k access-k)
-             (void)))))))
+             (void))))))
+   ;; Check that `hash-set` propagates in a way that allows
+   ;; `chaperone-of?` to work recursively:
+   (let ()
+     (define proc (lambda (x) (add1 x)))
+     (define h2 (hash-set h1 1 proc))
+     (define (add-chap h2)
+       (chaperone-hash h2
+                       (λ (h k) (values k (λ (h k v) v)))
+                       (λ (h k v) (values k v))
+                       (λ _ #f)
+                       (λ (h k) k)))
+     (define h3 (add-chap h2))
+     (test #t chaperone-of? h3 h2)
+     (test #f chaperone-of? h3 (add-chap h2))
+     (define h4 (hash-set h3 1 proc))
+     (test #t chaperone-of? h4 h3)
+     (define h5 (hash-set h3 1 (chaperone-procedure proc void)))
+     (test #t chaperone-of? h5 h3)
+     (test #f chaperone-of? (hash-set h3 1 sub1) h3)
+     (test #f chaperone-of? (hash-set h3 2 sub1) h3)))
  (list #hash() #hasheq() #hasheqv()))
 
 ;; ----------------------------------------

racket/src/racket/src/bool.c

@@ -576,6 +576,19 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
       && SCHEME_CHAPERONEP(obj1)
       && (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
           || (eql->for_chaperone > 1))) {
+    /* `obj1` and `obj2` are not eq, otherwise is_fast_equal()
+       would have returned true */
+    if (SCHEME_CHAPERONEP(obj2)) {
+      /* for immutable hashes, it's ok for the two objects to not be eq,
+         as long as the interpositions are the same and the underlying
+         values are `{impersonator,chaperone}-of?`: */
+      if (SAME_TYPE(SCHEME_TYPE(((Scheme_Chaperone *)obj1)->val), scheme_hash_tree_type)
+          && SAME_TYPE(SCHEME_TYPE(((Scheme_Chaperone *)obj2)->val), scheme_hash_tree_type)
+          /* eq redirects means redirects were propagated: */
+          && SAME_OBJ(((Scheme_Chaperone *)obj1)->redirects,
+                      ((Scheme_Chaperone *)obj2)->redirects))
+        obj2 = ((Scheme_Chaperone *)obj2)->prev;
+    }
     obj1 = ((Scheme_Chaperone *)obj1)->prev;
     goto top_after_next;
   }

racket/src/racket/src/list.c

@@ -2914,6 +2914,9 @@ static Scheme_Object *do_chaperone_hash(const char *name, int is_impersonator, i
   } else
     clear = scheme_false;
 
+  /* The allocation of this vector is used to detect when two
+     chaperoned immutable hash tables can be
+     `{chaperone,impersonator}-of?` when they're not eq. */
   redirects = scheme_make_vector(5, NULL);
   SCHEME_VEC_ELS(redirects)[0] = argv[1];
   SCHEME_VEC_ELS(redirects)[1] = argv[2];