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

fix chaperone-hash to be more consistent with key handling

Browse Source
This commit is contained in:
Matthew Flatt 2010-05-03 17:12:08 -06:00
parent fae14aed03
commit a097b2ef6a
3 changed files with 60 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -231,18 +231,20 @@ or override chaperone-property values of @scheme[bx].}
@defproc[(chaperone-hash [hash hash?]
[ref-proc (hash? any/c any/c . -> . any/c)]
[set-proc (hash? any/c any/c . -> . any/c)]
[ref-proc (hash? any/c . -> . (values
any/c
(hash? any/c any/c . -> . any/c)))]
[set-proc (hash? any/c any/c . -> . (values any/c any/c))]
[remove-proc (hash? any/c . -> . any/c)]
[key-proc (hash? any/c . -> . any/c)]
[prop chaperone-property?]
[val any] ... ...)
(and/c vector? chaperone?)]{
(and/c hash? chaperone?)]{
Returns a chaperoned value like @scheme[hash], but with
@scheme[hash-ref], @scheme[hash-set!] or @scheme[hash-set] (as
applicable) and @scheme[hash-remove] or @scheme[hash-remove!] (as
application) operations on the chaperoned hash table redirected. When
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
@ -252,16 +254,19 @@ from the table. Operations like @scheme[hash-iterate-value] or
@scheme[hash-iterate-map] implicitly use @scheme[hash-ref] and
therefore redirect through @scheme[ref-proc].
The @scheme[ref-proc] must accept @scheme[hash], an key passed
@scheme[hash-ref], and the value that @scheme[hash-ref] on
@scheme[hash] produces for the given key; it must produce the same
value or a chaperone of the value, which is the result of
@scheme[hash-ref] on the chaperone.
The @scheme[ref-proc] must accept @scheme[hash] and a key passed
@scheme[hash-ref]. It must returned the key or a chaperone of the key
as well as a procedure. The returned procedure is called only if the
returned key is found in @scheme[hash] via @scheme[hash-ref], in which
case the procedure is called with @scheme[hash], the previously
returned key, and the found value. The returned procedure must itself
return the found value or a chaperone of the value.
The @scheme[set-proc] must accept @scheme[hash], a key passed to
@scheme[hash-set!] or @scheme[hash-set], and the value passed to
@scheme[hash-set!] or @scheme[hash-set]; it must produce the same
value or a chaperone of the value, which is used with
@scheme[hash-set!] or @scheme[hash-set]; it must produce two values:
the same key or a chaperone of the key and the same value or a
chaperone of the value. The returned key and value are used with
@scheme[hash-set!] or @scheme[hash-set] on the original @scheme[hash]
to install the value.

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

@ -430,7 +430,8 @@
(for-each
(lambda (make-hash)
(let ([h (chaperone-hash (make-hash)
(lambda (h k v) v) (lambda (h k v) (values k v))
(lambda (h k) (values k (lambda (h k v) v)))
(lambda (h k v) (values k v))
(lambda (h k) k) (lambda (h k) k))])
(test #t chaperone? h)
(test #t hash? h)
@ -450,10 +451,12 @@
[remove-k #f]
[access-k #f]
[h2 (chaperone-hash h1
(lambda (h k v)
(lambda (h k)
(set! get-k k)
(set! get-v v)
v)
(values k
(lambda (h k v)
(set! get-v v)
v)))
(lambda (h k v)
(set! set-k k)
(set! set-v v)
@ -470,8 +473,9 @@
(test #t (format "~s ~s ~s" proc val got) (equal? val got))))])
(test #f hash-ref h1 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test #f hash-ref h2 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'nope hash-ref h2 'key 'nope)
(test '(key #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(set! get-k #f)
(test (void) hash-set! h1 'key 'val)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'val hash-ref h1 'key #f)
@ -508,10 +512,12 @@
[remove-k #f]
[access-k #f]
[h2 (chaperone-hash h1
(lambda (h k v)
(lambda (h k)
(set! get-k k)
(set! get-v v)
v)
(values k
(lambda (h k v)
(set! get-v v)
v)))
(lambda (h k v)
(set! set-k k)
(set! set-v v)
@ -528,10 +534,10 @@
(test #t (format "~s ~s ~s" proc val got) (equal? val got))))])
(test #f hash-ref h1 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test #f hash-ref h2 'key #f)
(test '(#f #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'nope hash-ref h2 'key 'nope)
(test '(key #f #f #f #f #f) list get-k get-v set-k set-v remove-k access-k)
(let ([h2 (hash-set h2 'key 'val)])
(test '(#f #f key val #f #f) list get-k get-v set-k set-v remove-k access-k)
(test '(key #f key val #f #f) list get-k get-v set-k set-v remove-k access-k)
(test 'val hash-ref h2 'key #f)
(test '(key val key val #f #f) list get-k get-v set-k set-v remove-k access-k)
(let ([h2 (hash-set h2 'key2 'val2)])

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

@ -2601,7 +2601,7 @@ static Scheme_Object *chaperone_hash(int argc, Scheme_Object **argv)
if (!SCHEME_HASHTP(val) && !SCHEME_HASHTRP(val) && !SCHEME_BUCKTP(val))
scheme_wrong_type("chaperone-hash", "hash", 0, argc, argv);
scheme_check_proc_arity("chaperone-hash", 3, 1, argc, argv); /* ref */
scheme_check_proc_arity("chaperone-hash", 2, 1, argc, argv); /* ref */
scheme_check_proc_arity("chaperone-hash", 3, 2, argc, argv); /* set! */
scheme_check_proc_arity("chaperone-hash", 2, 3, argc, argv); /* remove */
scheme_check_proc_arity("chaperone-hash", 2, 4, argc, argv); /* key */
@ -2721,10 +2721,9 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
}
#endif
if (mode == 0) {
orig = chaperone_hash_op(who, px->prev, k, v, mode);
if (!orig) return NULL;
} else if ((mode == 2) || (mode == 3))
if (mode == 0)
orig = NULL;
else if ((mode == 2) || (mode == 3))
orig = k;
else
orig = v;
@ -2733,7 +2732,6 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
/* chaperone was on property accessors */
o = orig;
} else {
red = SCHEME_BOX_VAL(px->redirects);
red = SCHEME_VEC_ELS(red)[mode];
@ -2741,17 +2739,13 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
a[1] = k;
a[2] = orig;
if (mode == 0) {
/* hash-ref */
o = _scheme_apply(red, 3, a);
what = "result";
} else if (mode == 1) {
if ((mode == 0) || (mode == 1)) {
/* hash-set! */
Scheme_Object **vals;
int cnt;
Scheme_Thread *p;
o = _scheme_apply_multi(red, 3, a);
o = _scheme_apply_multi(red, ((mode == 0) ? 2 : 3), a);
if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
p = scheme_current_thread;
@ -2781,7 +2775,26 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
k);
k = vals[0];
o = vals[1];
what = "value";
if (mode == 0) {
red = o;
if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced second value that is not a procedure (arity 3): %V",
who,
red);
orig = chaperone_hash_op(who, px->prev, k, v, mode);
if (!orig) return NULL;
/* hash-ref */
a[0] = px->prev;
a[1] = k;
a[2] = orig;
o = _scheme_apply(red, 3, a);
what = "result";
} else
what = "value";
} else {
/* hash-remove! and key extraction */
o = _scheme_apply(red, 2, a);