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

fix printing of hash tables with chaperones

Browse Source 
Closes PR 12276
This commit is contained in:
Matthew Flatt 2011-11-27 09:56:44 -07:00
parent 10246d7ade
commit 8b7370a4f9
5 changed files with 32 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/tests/racket/chaperone.rktl
View File

@ -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)

6
src/racket/src/list.c
View File

@ -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);
}

12
src/racket/src/print.c
View File

@ -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;
}

2
src/racket/src/schpriv.h
View File

@ -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);
/*========================================================================*/

2
src/racket/src/syntax.c
View File

@ -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);