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

fix problem with chaperone of chaperoned hash

Browse Source
This commit is contained in:
Matthew Flatt 2010-05-05 09:23:36 -06:00
parent a60a083802
commit 27cd77c16c
3 changed files with 39 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scribblings/reference/chaperones.scrbl
View File

@ -250,7 +250,7 @@ application) operations on the chaperoned hash table redirected. When
@scheme[hash-set] or @scheme[hash-remove] is used on a chaperoned hash
table, the resulting hash table is given all of the chaperones of the
given hash table. In addition, operations like
@scheme[hash-iterate-key] or @scheme[hash-iterate-map], which extract
@scheme[hash-iterate-key] or @scheme[hash-map], which extract
keys from the table, use @scheme[key-proc] to filter keys extracted
from the table. Operations like @scheme[hash-iterate-value] or
@scheme[hash-iterate-map] implicitly use @scheme[hash-ref] and

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

@ -626,6 +626,37 @@
;; ----------------------------------------
(letrec ([wrap
(lambda (v)
(cond
[(hash? v)
(chaperone-hash v
(lambda (h k)
(values (wrap k)
(lambda (h k v) (wrap v))))
(lambda (h k v)
(values (wrap k) (wrap v)))
(lambda (h k)
(wrap k))
(lambda (h k)
(wrap k)))]
[(procedure? v) (chaperone-procedure
v
(lambda args
(apply values
(lambda args
(apply values (map wrap args)))
(map wrap args))))]
[(number? v) v]
[else (error 'wrap "cannot wrap: ~v" v)]))])
(let ([ht (wrap (wrap (make-hash)))])
(hash-set! ht add1 sub1)
(test 9 (hash-ref ht add1) 10)
(test '(10) 'for-hash (for/list ([(k v) (in-hash ht)])
(k (v 10))))))
;; ----------------------------------------
(let ()
(define-struct a (x y) #:transparent)
(let* ([a1 (make-a 1 2)]

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

@ -2692,6 +2692,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
while (1) {
if (!SCHEME_NP_CHAPERONEP(o)) {
if (mode == 0) {
/* hash-ref */
if (SCHEME_HASHTP(o))
return scheme_hash_get((Scheme_Hash_Table *)o, k);
else if (SCHEME_HASHTRP(o))
@ -2699,6 +2700,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
else
return scheme_lookup_in_table((Scheme_Bucket_Table *)o, (const char *)k);
} else if ((mode == 1) || (mode == 2)) {
/* hash-set! or hash-remove! */
if (SCHEME_HASHTP(o))
scheme_hash_set((Scheme_Hash_Table *)o, k, v);
else if (SCHEME_HASHTRP(o)) {
@ -2734,9 +2736,10 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
if (mode == 0)
orig = NULL;
else if (mode == 3)
else if (mode == 3) {
orig = chaperone_hash_op(who, px->prev, k, v, mode);
else if (mode == 2)
k = orig;
} else if (mode == 2)
orig = k;
else
orig = v;
@ -2753,7 +2756,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
a[2] = orig;
if ((mode == 0) || (mode == 1)) {
/* hash-set! */
/* hash-ref or hash-set! */
Scheme_Object **vals;
int cnt;
Scheme_Thread *p;
@ -2790,6 +2793,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
o = vals[1];
if (mode == 0) {
/* hash-ref */
red = o;
if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,