From 8b7370a4f94999305debedbc962414324887d701 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 27 Nov 2011 09:56:44 -0700 Subject: [PATCH] fix printing of hash tables with chaperones Closes PR 12276 --- collects/tests/racket/chaperone.rktl | 20 ++++++++++++++++++++ src/racket/src/list.c | 6 ++++-- src/racket/src/print.c | 12 ++++++------ src/racket/src/schpriv.h | 2 +- src/racket/src/syntax.c | 2 +- 5 files changed, 32 insertions(+), 10 deletions(-) diff --git a/collects/tests/racket/chaperone.rktl b/collects/tests/racket/chaperone.rktl index 56d8aab58f..41b691b838 100644 --- a/collects/tests/racket/chaperone.rktl +++ b/collects/tests/racket/chaperone.rktl @@ -1218,6 +1218,26 @@ (apply values (lambda (v) (box v)) (map list kwd-args) args)))) #:a "x")) +;; ---------------------------------------- +;; Check that importantor transformations are applied for printing: + +(let () + (define ht + (impersonate-hash + (let ([h (make-hash)]) + (hash-set! h 'x' y) + h) + (lambda (hash key) + (values (car key) (lambda (hash key val) (list val)))) + (lambda (hash key val) + (values (car key) (list val))) + (lambda (hash key) (car key)) + (lambda (hash key) (list key)))) + (test '(y) hash-ref ht '(x)) + (test "'#hash(((x) . (y)))" 'print (let ([o (open-output-bytes)]) + (print ht o) + (get-output-string o)))) + ;; ---------------------------------------- (report-errs) diff --git a/src/racket/src/list.c b/src/racket/src/list.c index 1c13c7e6a0..b92956d163 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -2046,7 +2046,7 @@ static Scheme_Object *hash_table_copy(int argc, Scheme_Object *argv[]) for (i = t->count; i--; ) { scheme_hash_tree_index(t, i, &k, &val); if (!SAME_OBJ((Scheme_Object *)t, v)) - val = scheme_chaperone_hash_traversal_get(v, k); + val = scheme_chaperone_hash_traversal_get(v, k, &k); if (val) scheme_hash_set(naya, k, val); } @@ -3012,9 +3012,11 @@ static Scheme_Object *chaperone_hash_key(const char *name, Scheme_Object *table, return chaperone_hash_op(name, table, key, NULL, 3); } -Scheme_Object *scheme_chaperone_hash_traversal_get(Scheme_Object *table, Scheme_Object *key) +Scheme_Object *scheme_chaperone_hash_traversal_get(Scheme_Object *table, Scheme_Object *key, + Scheme_Object **alt_key) { key = chaperone_hash_key("hash-table-iterate-key", table, key); + *alt_key = key; return chaperone_hash_op("hash-ref", table, key, NULL, 0); } diff --git a/src/racket/src/print.c b/src/racket/src/print.c index 5b07927998..0ed074648e 100644 --- a/src/racket/src/print.c +++ b/src/racket/src/print.c @@ -608,7 +608,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht if (vals[i]) { key = keys[i]; if (!SAME_OBJ((Scheme_Object *)t, obj)) - val = scheme_chaperone_hash_traversal_get(obj, key); + val = scheme_chaperone_hash_traversal_get(obj, key, &key); else val = vals[i]; if (val) { @@ -639,7 +639,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht while (i != -1) { scheme_hash_tree_index(t, i, &key, &val); if (!SAME_OBJ((Scheme_Object *)t, obj)) - val = scheme_chaperone_hash_traversal_get(obj, key); + val = scheme_chaperone_hash_traversal_get(obj, key, &key); res2 = check_cycles(key, for_write, ht, pp); res |= res2; if ((for_write < 3) && res) @@ -876,7 +876,7 @@ static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Tab if (vals[i]) { key = keys[i]; if (!SAME_OBJ((Scheme_Object *)t, obj)) - val = scheme_chaperone_hash_traversal_get(obj, key); + val = scheme_chaperone_hash_traversal_get(obj, key, &key); else val = vals[i]; if (val) { @@ -900,7 +900,7 @@ static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Tab while (i != -1) { scheme_hash_tree_index(t, i, &key, &val); if (!SAME_OBJ((Scheme_Object *)t, obj)) - val = scheme_chaperone_hash_traversal_get(obj, key); + val = scheme_chaperone_hash_traversal_get(obj, key, &key); setup_graph_table(key, for_write, ht, counter, pp); setup_graph_table(val, for_write, ht, counter, pp); i = scheme_hash_tree_next(t, i); @@ -2109,13 +2109,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, if (!vals) { scheme_hash_tree_index(tr, i, &key, &val); if (!SAME_OBJ(obj, orig)) - val = scheme_chaperone_hash_traversal_get(orig, key); + val = scheme_chaperone_hash_traversal_get(orig, key, &key); } else { if (i < t->size) { val = vals[i]; key = keys[i]; if (!SAME_OBJ(obj, orig)) - val = scheme_chaperone_hash_traversal_get(orig, key); + val = scheme_chaperone_hash_traversal_get(orig, key, &key); } else val = 0; } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 665946abbb..88b03a8970 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -863,7 +863,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object Scheme_Hash_Tree *scheme_parse_chaperone_props(const char *who, int start_at, int argc, Scheme_Object **argv); Scheme_Object *scheme_chaperone_hash_get(Scheme_Object *table, Scheme_Object *key); -Scheme_Object *scheme_chaperone_hash_traversal_get(Scheme_Object *table, Scheme_Object *key); +Scheme_Object *scheme_chaperone_hash_traversal_get(Scheme_Object *table, Scheme_Object *key, Scheme_Object **alt_key); void scheme_chaperone_hash_set(Scheme_Object *table, Scheme_Object *key, Scheme_Object *val); /*========================================================================*/ diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 964a2cc72d..d8112ad462 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -7343,7 +7343,7 @@ static Scheme_Object *datum_to_syntax_inner(Scheme_Object *o, while (i != -1) { scheme_hash_tree_index(ht1, i, &key, &val); if (!SAME_OBJ((Scheme_Object *)ht1, o)) - val = scheme_chaperone_hash_traversal_get(o, key); + val = scheme_chaperone_hash_traversal_get(o, key, &key); val = datum_to_syntax_inner(val, ut, stx_src, stx_wraps, ht, tainted); if (!val) return NULL; ht2 = scheme_hash_tree_set(ht2, key, val);