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

allow cyclic values over place channels

Browse Source
This commit is contained in:
Matthew Flatt 2011-04-20 07:21:10 -06:00
parent e1fced4897
commit e47c9a2f9d
3 changed files with 51 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/tests/racket/place-channel.rktl
View File

@ -104,10 +104,21 @@ END
(place-channel-send pl pc5)
(test "Ready5" sync pc6)
(let ([try-graph
(lambda (s)
(let ([v (read (open-input-string s))])
(place-channel-send pc5 v)
(test v place-channel-receive pc6)))])
(try-graph "#0=(#0# . #0#)")
(try-graph "#0=#(#0# 7 #0#)")
(try-graph "#0=#s(thing 7 #0#)"))
(check-exn exn:fail? (λ () (place-channel-send pl (open-output-string))))
(check-not-exn (λ () (place-channel-send pl "Test String")))
(check-not-exn (λ () (place-channel-send pl (string->path "C:\\Windows"))))
(check-not-exn (λ () (place-channel-send pl (bytes->path #"/tmp/unix" 'unix))))
(check-not-exn (λ () (place-channel-send pl (bytes->path #"C:\\Windows" 'windows))))
(place-wait pl)
)
(report-errs)

2
collects/tests/racket/place.rktl
View File

@ -34,3 +34,5 @@
(printf "Hello form place 2\n")
(sync never-evt))])
(place-kill p))
(report-errs)

44
src/racket/src/places.c
View File

@ -802,6 +802,7 @@ static Scheme_Object *trivial_copy(Scheme_Object *so)
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht)
{
Scheme_Object *new_so = so;
int skip_hash;
/* First, check for simple values that don't need to be hashed: */
new_so = trivial_copy(so);
@ -814,6 +815,14 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
}
}
if (!*ht) {
Scheme_Hash_Table *_ht;
_ht = scheme_make_hash_table(SCHEME_hash_ptr);
*ht = _ht;
}
skip_hash = 0;
switch (SCHEME_TYPE(so)) {
case scheme_char_type:
new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
@ -874,9 +883,17 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Object *car;
Scheme_Object *cdr;
Scheme_Object *pair;
/* handle cycles: */
pair = scheme_make_pair(scheme_false, scheme_false);
scheme_hash_set(*ht, so, pair);
skip_hash = 1;
car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht);
cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht);
pair = scheme_make_pair(car, cdr);
SCHEME_CAR(pair) = car;
SCHEME_CDR(pair) = cdr;
new_so = pair;
}
break;
@ -886,6 +903,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
intptr_t i;
intptr_t size = SCHEME_VEC_SIZE(so);
vec = scheme_make_vector(size, 0);
/* handle cycles: */
scheme_hash_set(*ht, so, vec);
skip_hash = 1;
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht);
@ -944,6 +966,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht);
nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
/* handle cycles: */
scheme_hash_set(*ht, so, (Scheme_Object *)nst);
skip_hash = 1;
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
@ -964,6 +991,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
size = st->num_slots;
stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
/* handle cycles: */
scheme_hash_set(*ht, so, (Scheme_Object *)nst);
skip_hash = 1;
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
@ -979,11 +1011,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
break;
}
if (!*ht) {
Scheme_Hash_Table *_ht;
_ht = scheme_make_hash_table(SCHEME_hash_ptr);
*ht = _ht;
}
if (!skip_hash)
scheme_hash_set(*ht, so, new_so);
return new_so;
@ -1296,7 +1324,7 @@ Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) {
else {
scheme_wrong_count_m("place-channel-send", 2, 2, argc, args, 0);
}
return scheme_true;
return scheme_void;
}
Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) {
@ -1317,7 +1345,7 @@ Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) {
else {
scheme_wrong_count_m("place-channel-receive", 1, 1, argc, args, 0);
}
return scheme_true;
ESCAPED_BEFORE_HERE;
}
# ifdef MZ_PRECISE_GC