From 3e0e4a3f6bc441b25349d261f8d41bc225760ebf Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Thu, 23 Feb 2012 14:17:15 -0700 Subject: [PATCH] Allow hashes across place channels. --- collects/scribblings/reference/places.scrbl | 3 + collects/tests/racket/place-channel.rkt | 17 ++- src/racket/src/list.c | 84 ++++++------- src/racket/src/place.c | 125 ++++++++++++++++++-- src/racket/src/schpriv.h | 16 +++ 5 files changed, 192 insertions(+), 53 deletions(-) diff --git a/collects/scribblings/reference/places.scrbl b/collects/scribblings/reference/places.scrbl index 65c5b75035..fe9433263f 100644 --- a/collects/scribblings/reference/places.scrbl +++ b/collects/scribblings/reference/places.scrbl @@ -318,6 +318,9 @@ messages: where a mutable vector is automatically replaced by an immutable vector;} + @item{@tech{hash tables} where mutable hash tables are automatically + replaced by immutable variants;} + @item{@tech{place channels}, where a @tech{place descriptor} is automatically replaced by a plain place channel;} diff --git a/collects/tests/racket/place-channel.rkt b/collects/tests/racket/place-channel.rkt index 45844d4751..eba62e30f2 100644 --- a/collects/tests/racket/place-channel.rkt +++ b/collects/tests/racket/place-channel.rkt @@ -52,6 +52,9 @@ (define-struct building (rooms location) #:prefab) (define-struct (house building) (occupied ) #:prefab) (define h1 (make-house 5 'factory 'yes)) +(define l1 (list (cons 1 2) (cons 'red "green") (cons (hash) 1) (cons (vector 1) #s(blue 2)))) +(define l2 (list (cons 1 2) (cons 3 4) (cons #\a 5))) +(define l3 (list (cons 1 2) (cons 3 4) (cons #\a 5) (cons 3.1415 12))) (define-syntax (test-place-channel-get/put stx) (syntax-case stx () @@ -82,7 +85,12 @@ (list (car x) 'b (cadr x)) (vector (vector-ref x 0) 'b (vector-ref x 1)) #s((abuilding 1 building 2) 6 'utah 'no) - `(,x)))) + `(,x) + (make-immutable-hash (list (cons 'red 'der))) + (make-immutable-hash l1) + (make-immutable-hasheq l2) + (make-immutable-hasheqv l3) + ))) (define (channel-test-basic-types-master sender ch) (define-syntax-rule (test-place-channel-put-receive sender ch (send expect) ...) @@ -103,7 +111,12 @@ ((list 'a 'a) (list 'a 'b 'a)) (#(a a) #(a b a)) (h1 #s((abuilding 1 building 2) 6 'utah 'no)) - ('(printf "Hello") '((printf "Hello"))))) + ('(printf "Hello") '((printf "Hello"))) + ((make-hash (list (cons 'red 'der))) (make-immutable-hash (list (cons 'red 'der)))) + ((make-hash l1) (make-immutable-hash l1)) + ((make-hasheq l2) (make-immutable-hasheq l2)) + ((make-hasheqv l3) (make-immutable-hasheqv l3)) + )) (define-place (place-worker ch) (channel-test-basic-types-worker normal-receiver ch) diff --git a/src/racket/src/list.c b/src/racket/src/list.c index 16a7805151..73cceb0249 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -97,30 +97,30 @@ static Scheme_Object *make_hasheqv(int argc, Scheme_Object *argv[]); static Scheme_Object *make_weak_hash(int argc, Scheme_Object *argv[]); static Scheme_Object *make_weak_hasheq(int argc, Scheme_Object *argv[]); static Scheme_Object *make_weak_hasheqv(int argc, Scheme_Object *argv[]); -static Scheme_Object *make_immutable_hash(int argc, Scheme_Object *argv[]); -static Scheme_Object *make_immutable_hasheq(int argc, Scheme_Object *argv[]); -static Scheme_Object *make_immutable_hasheqv(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]); static Scheme_Object *direct_hash(int argc, Scheme_Object *argv[]); static Scheme_Object *direct_hasheq(int argc, Scheme_Object *argv[]); static Scheme_Object *direct_hasheqv(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_count(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_copy(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_p(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_eq_p(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_eqv_p(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_equal_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_weak_p(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_put_bang(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_table_put(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_remove_bang(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_map(int argc, Scheme_Object *argv[]); static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_table_iterate_start(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_table_iterate_value(int argc, Scheme_Object *argv[]); -static Scheme_Object *hash_table_iterate_key(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]); static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[]); static Scheme_Object *equal_hash_code(int argc, Scheme_Object *argv[]); static Scheme_Object *equal_hash2_code(int argc, Scheme_Object *argv[]); @@ -490,17 +490,17 @@ scheme_init_list (Scheme_Env *env) 0, 1), env); scheme_add_global_constant("make-immutable-hash", - scheme_make_immed_prim(make_immutable_hash, + scheme_make_immed_prim(scheme_make_immutable_hash, "make-immutable-hash", 0, 1), env); scheme_add_global_constant("make-immutable-hasheq", - scheme_make_immed_prim(make_immutable_hasheq, + scheme_make_immed_prim(scheme_make_immutable_hasheq, "make-immutable-hasheq", 0, 1), env); scheme_add_global_constant("make-immutable-hasheqv", - scheme_make_immed_prim(make_immutable_hasheqv, + scheme_make_immed_prim(scheme_make_immutable_hasheqv, "make-immutable-hasheqv", 0, 1), env); @@ -525,17 +525,17 @@ scheme_init_list (Scheme_Env *env) 1, 1, 1), env); scheme_add_global_constant("hash-eq?", - scheme_make_folding_prim(hash_eq_p, + scheme_make_folding_prim(scheme_hash_eq_p, "hash-eq?", 1, 1, 1), env); scheme_add_global_constant("hash-eqv?", - scheme_make_folding_prim(hash_eqv_p, + scheme_make_folding_prim(scheme_hash_eqv_p, "hash-eqv?", 1, 1, 1), env); scheme_add_global_constant("hash-equal?", - scheme_make_folding_prim(hash_equal_p, + scheme_make_folding_prim(scheme_hash_equal_p, "hash-equal?", 1, 1, 1), env); @@ -560,7 +560,7 @@ scheme_init_list (Scheme_Env *env) 3, 3), env); scheme_add_global_constant("hash-set", - scheme_make_noncm_prim(hash_table_put, + scheme_make_noncm_prim(scheme_hash_table_put, "hash-set", 3, 3), env); @@ -589,22 +589,22 @@ scheme_init_list (Scheme_Env *env) env); scheme_add_global_constant("hash-iterate-first", - scheme_make_immed_prim(hash_table_iterate_start, + scheme_make_immed_prim(scheme_hash_table_iterate_start, "hash-iterate-first", 1, 1), env); scheme_add_global_constant("hash-iterate-next", - scheme_make_immed_prim(hash_table_iterate_next, + scheme_make_immed_prim(scheme_hash_table_iterate_next, "hash-iterate-next", 2, 2), env); scheme_add_global_constant("hash-iterate-value", - scheme_make_noncm_prim(hash_table_iterate_value, + scheme_make_noncm_prim(scheme_hash_table_iterate_value, "hash-iterate-value", 2, 2), env); scheme_add_global_constant("hash-iterate-key", - scheme_make_noncm_prim(hash_table_iterate_key, + scheme_make_noncm_prim(scheme_hash_table_iterate_key, "hash-iterate-key", 2, 2), env); @@ -1887,17 +1887,17 @@ static Scheme_Object *make_immutable_table(const char *who, int kind, int argc, return (Scheme_Object *)ht; } -static Scheme_Object *make_immutable_hash(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]) { return make_immutable_table("make-immutable-hash", 1, argc, argv); } -static Scheme_Object *make_immutable_hasheq(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]) { return make_immutable_table("make-immutable-hasheq", 0, argc, argv); } -static Scheme_Object *make_immutable_hasheqv(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]) { return make_immutable_table("make-immutable-hasheqv", 2, argc, argv); } @@ -2083,7 +2083,7 @@ static Scheme_Object *hash_p(int argc, Scheme_Object *argv[]) return scheme_false; } -static Scheme_Object *hash_eq_p(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]) { Scheme_Object *o = argv[0]; @@ -2108,7 +2108,7 @@ static Scheme_Object *hash_eq_p(int argc, Scheme_Object *argv[]) return scheme_false; } -static Scheme_Object *hash_eqv_p(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]) { Scheme_Object *o = argv[0]; @@ -2131,7 +2131,7 @@ static Scheme_Object *hash_eqv_p(int argc, Scheme_Object *argv[]) return scheme_false; } -static Scheme_Object *hash_equal_p(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]) { Scheme_Object *o = argv[0]; @@ -2217,7 +2217,7 @@ static Scheme_Object *hash_table_put_bang(int argc, Scheme_Object *argv[]) return scheme_void; } -static Scheme_Object *hash_table_put(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]) { Scheme_Object *v = argv[0]; @@ -2574,12 +2574,12 @@ static Scheme_Object *hash_table_next(const char *name, int start, int argc, Sch } } -static Scheme_Object *hash_table_iterate_start(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]) { return hash_table_next("hash-iterate-first", -1, argc, argv); } -static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]) { Scheme_Object *p = argv[1], *v; int pos; @@ -2726,12 +2726,12 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object return NULL; } -static Scheme_Object *hash_table_iterate_value(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]) { return hash_table_index("hash-iterate-value", argc, argv, 1); } -static Scheme_Object *hash_table_iterate_key(int argc, Scheme_Object *argv[]) +Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]) { return hash_table_index("hash-iterate-key", argc, argv, 0); } @@ -3040,8 +3040,8 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) v = SCHEME_CHAPERONE_VAL(obj); a[0] = obj; - is_eq = SCHEME_TRUEP(hash_eq_p(1, a)); - is_eqv = SCHEME_TRUEP(hash_eqv_p(1, a)); + is_eq = SCHEME_TRUEP(scheme_hash_eq_p(1, a)); + is_eqv = SCHEME_TRUEP(scheme_hash_eqv_p(1, a)); if (SCHEME_HASHTP(obj)) { if (is_eq) @@ -3052,11 +3052,11 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) v2 = make_hash(0, NULL); } else if (SCHEME_HASHTRP(obj)) { if (is_eq) - v2 = make_immutable_hasheq(0, NULL); + v2 = scheme_make_immutable_hasheq(0, NULL); else if (is_eqv) - v2 = make_immutable_hasheqv(0, NULL); + v2 = scheme_make_immutable_hasheqv(0, NULL); else - v2 = make_immutable_hash(0, NULL); + v2 = scheme_make_immutable_hash(0, NULL); } else { if (is_eq) v2 = make_weak_hasheq(0, NULL); @@ -3066,11 +3066,11 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) v2 = make_weak_hash(0, NULL); } - idx = hash_table_iterate_start(1, a); + idx = scheme_hash_table_iterate_start(1, a); while (SCHEME_TRUEP(idx)) { a[0] = v; a[1] = idx; - key = hash_table_iterate_key(2, a); + key = scheme_hash_table_iterate_key(2, a); val = scheme_chaperone_hash_get(obj, key); if (val) { @@ -3078,14 +3078,14 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) a[1] = key; a[2] = val; if (SCHEME_HASHTRP(v2)) - v2 = hash_table_put(2, a); + v2 = scheme_hash_table_put(2, a); else (void)hash_table_put_bang(2, a); } a[0] = v; a[1] = idx; - idx = hash_table_iterate_next(2, a); + idx = scheme_hash_table_iterate_next(2, a); } return v2; diff --git a/src/racket/src/place.c b/src/racket/src/place.c index 9d874312e2..30fa56277e 100644 --- a/src/racket/src/place.c +++ b/src/racket/src/place.c @@ -1677,6 +1677,9 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab /* lifted variables for xform*/ Scheme_Object *pair; Scheme_Object *vec; + Scheme_Object *nht; + Scheme_Object *hti; + Scheme_Object *htk; intptr_t i; intptr_t size; Scheme_Structure *st; @@ -1685,15 +1688,17 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab Scheme_Struct_Type *ptype; int local_slots; -#define DEEP_DO_CDR 1 -#define DEEP_DO_FIN_PAIR 2 -#define DEEP_VEC1 3 -#define DEEP_ST1 4 -#define DEEP_ST2 5 -#define DEEP_SST1 6 -#define DEEP_SST2 7 -#define DEEP_RETURN 8 -#define DEEP_DONE 9 +#define DEEP_DO_CDR 1 +#define DEEP_DO_FIN_PAIR 2 +#define DEEP_VEC1 3 +#define DEEP_ST1 4 +#define DEEP_ST2 5 +#define DEEP_SST1 6 +#define DEEP_SST2 7 +#define DEEP_HT1 8 +#define DEEP_HT2 9 +#define DEEP_RETURN 10 +#define DEEP_DONE 11 #define RETURN do { goto DEEP_RETURN_L; } while(0); #define ABORT do { goto DEEP_DONE_L; } while(0); #define IFS_PUSH(x) inf_push(&inf_stack, x, &inf_stack_depth, &inf_max_depth, gcable) @@ -1989,6 +1994,102 @@ DEEP_SST2_L: RETURN; } break; + case scheme_hash_table_type: + case scheme_hash_tree_type: + /* if ((mode == mzPDC_COPY) || (mode == mzPDC_UNCOPY)) { */ + if (set_mode) { + if (scheme_true == scheme_hash_eq_p(1, &so)) { + nht = scheme_make_immutable_hasheq(0, NULL); + } + else if ( scheme_true == scheme_hash_eqv_p(1, &so)) { + nht = scheme_make_immutable_hasheqv(0, NULL); + } + else if ( scheme_true == scheme_hash_equal_p(1, &so)) { + nht = scheme_make_immutable_hash(0, NULL); + } + } + else + nht = so; + + /* handle cycles: */ + scheme_hash_set(*ht, so, nht); + hti = scheme_hash_table_iterate_start(1,&so); + i = 0; + + IFS_PUSH(nht); + IFS_PUSH(so); + IFS_PUSH(hti); + + if (SCHEME_INTP(hti)) { + Scheme_Object *a[2]; + a[0] = so; + a[1] = hti; + SET_R0(scheme_hash_table_iterate_key(2, a)); + GOTO_NEXT_CONT(DEEP_DO, DEEP_HT1); + } + else { + goto DEEP_HT3; + } + +DEEP_HT1_L: + /* hash table loop*/ + hti = IFS_GET(0); + so = IFS_GET(1); + nht = IFS_GET(2); + IFS_PUSH(GET_R0()); + + { + Scheme_Object *a[2]; + a[0] = so; + a[1] = hti; + SET_R0(scheme_hash_table_iterate_value(2, a)); + GOTO_NEXT_CONT(DEEP_DO, DEEP_HT2); + } + +DEEP_HT2_L: + htk = IFS_POP; + hti = IFS_GET(0); + so = IFS_GET(1); + nht = IFS_GET(2); + + if (set_mode) { + Scheme_Object *a[3]; + a[0] = nht; + a[1] = htk; + a[2] = GET_R0(); + nht = scheme_hash_table_put(3, a); + IFS_SET(2, nht); + } + { + Scheme_Object *a[3]; + a[0] = so; + a[1] = hti; + hti = scheme_hash_table_iterate_next(2, a); + } + + if (SCHEME_INTP(hti)) { + Scheme_Object *a[2]; + IFS_SET(0, hti); + a[0] = so; + a[1] = hti; + SET_R0(scheme_hash_table_iterate_key(2, a)); + GOTO_NEXT_CONT(DEEP_DO, DEEP_HT1); + } + else { + goto DEEP_HT3; + } + +DEEP_HT3: + hti = IFS_POP; + so = IFS_POP; + nht = IFS_POP; + + if (set_mode) { + new_so = nht; + } + RETURN; + break; + default: if (delayed_errno) scheme_warning("Error serializing place message: %e", delayed_errno); @@ -2011,6 +2112,8 @@ DEEP_RETURN_L: case DEEP_ST2: goto DEEP_ST2_L; case DEEP_SST1: goto DEEP_SST1_L; case DEEP_SST2: goto DEEP_SST2_L; + case DEEP_HT1: goto DEEP_HT1_L; + case DEEP_HT2: goto DEEP_HT2_L; case DEEP_RETURN: goto DEEP_RETURN_L; case DEEP_DONE: goto DEEP_DONE_L; default: @@ -2028,6 +2131,10 @@ DEEP_DONE_L: #undef DEEP_VEC1 #undef DEEP_ST1 #undef DEEP_ST2 +#undef DEEP_SST1 +#undef DEEP_SST2 +#undef DEEP_HT1 +#undef DEEP_TT2 #undef DEEP_RETURN #undef DEEP_DONE #undef RETURNS diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 608a792732..98a852fc58 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -428,6 +428,22 @@ extern Scheme_Object *scheme_reduced_procedure_struct; #define scheme_constant_key scheme_stack_dump_key #define scheme_fixed_key scheme_default_prompt_tag +/*========================================================================*/ +/* hash functions */ +/*========================================================================*/ + +Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]); + /*========================================================================*/ /* thread state and maintenance */ /*========================================================================*/