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

Places: fix prefab_struct_key

Browse Source
This commit is contained in:
Kevin Tew 2010-07-28 10:34:36 -06:00
parent 79b782edad
commit c7926001ef
3 changed files with 49 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2252,9 +2252,9 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
&& SCHEME_PREFABP(SCHEME_CHAPERONE_VAL(obj))))) {
Scheme_Object *vec, *prefab;
print_compact(pp, CPT_PREFAB);
prefab = ((Scheme_Structure *)obj)->stype->prefab_key;
prefab = scheme_prefab_struct_key(obj);
vec = scheme_struct_to_vector(obj, (notdisplay >= 3) ? qq_ellipses : NULL, pp->inspector);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CDR(prefab);
SCHEME_VEC_ELS(vec)[0] = prefab;
print_vector(vec, notdisplay, compact, ht, mt, pp, 1);
} else if (compact || !pp->print_unreadable) {
cannot_print(pp, notdisplay, obj, ht, compact);
@ -2275,18 +2275,18 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
if (pb) {
Scheme_Object *vec, *prefab;
prefab = ((Scheme_Structure *)obj)->stype->prefab_key;
prefab = scheme_prefab_struct_key(obj);
vec = scheme_struct_to_vector(obj, (notdisplay >= 3) ? qq_ellipses : NULL, pp->inspector);
if (prefab)
if (SCHEME_TRUEP(prefab))
notdisplay = to_quoted(obj, pp, notdisplay);
if (notdisplay == 3) {
vec = scheme_vector_to_list(vec);
vec = scheme_make_pair(scheme_object_name(obj), SCHEME_CDR(vec));
print_pair(vec, notdisplay, compact, ht, mt, pp, scheme_pair_type, !pp->print_pair_curly, 1);
} else {
if (prefab)
SCHEME_VEC_ELS(vec)[0] = SCHEME_CDR(prefab);
print_vector(vec, notdisplay, compact, ht, mt, pp, !!prefab);
if (SCHEME_TRUEP(prefab))
SCHEME_VEC_ELS(vec)[0] = prefab;
print_vector(vec, notdisplay, compact, ht, mt, pp, SCHEME_TRUEP(prefab));
}
closed = 1;
} else {

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

@ -746,6 +746,7 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base,
int num_islots,
Scheme_Object *uninit_val,
char *immutable_pos_list);
Scheme_Object *scheme_prefab_struct_key(Scheme_Object *s);
Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);

45
src/racket/src/struct.c
View File

@ -117,6 +117,9 @@ static Scheme_Object *struct_to_vector(int argc, Scheme_Object *argv[]);
static Scheme_Object *prefab_struct_key(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_prefab_struct(int argc, Scheme_Object *argv[]);
static Scheme_Object *prefab_key_struct_type(int argc, Scheme_Object *argv[]);
#ifdef MZ_USE_PLACES
static Scheme_Object *convert_prefab_key_to_external_form(Scheme_Object *key);
#endif
static Scheme_Object *struct_setter_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *struct_getter_p(int argc, Scheme_Object *argv[]);
@ -2687,14 +2690,25 @@ static Scheme_Object *struct_to_vector(int argc, Scheme_Object *argv[])
static Scheme_Object *prefab_struct_key(int argc, Scheme_Object *argv[])
{
Scheme_Structure *s = (Scheme_Structure *)argv[0];
return scheme_prefab_struct_key(argv[0]);
}
Scheme_Object *scheme_prefab_struct_key(Scheme_Object *so)
{
Scheme_Structure *s = (Scheme_Structure *)so;
if (SCHEME_CHAPERONEP((Scheme_Object *)s))
s = (Scheme_Structure *)SCHEME_CHAPERONE_VAL((Scheme_Object *)s);
if (SCHEME_STRUCTP(((Scheme_Object *)s))
&& s->stype->prefab_key)
return SCHEME_CDR(s->stype->prefab_key);
if (SCHEME_STRUCTP(((Scheme_Object *)s)) && s->stype->prefab_key) {
Scheme_Object *prefab_key;
prefab_key = SCHEME_CDR(s->stype->prefab_key);
#ifdef MZ_USE_PLACES
return convert_prefab_key_to_external_form(prefab_key);
#else
return prefab_key;
#endif
}
return scheme_false;
}
@ -4561,6 +4575,29 @@ static char *mutability_data_to_immutability_data(int icnt, Scheme_Object *mutab
return immutable_array;
}
#ifdef MZ_USE_PLACES
static Scheme_Object *convert_prefab_key_to_external_form(Scheme_Object *key)
{
Scheme_Object *l;
Scheme_Object *nl;
if (SCHEME_SYMBOLP(key)) return key;
if (SCHEME_BYTE_STRINGP(key))
return scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(key), SCHEME_BYTE_STRLEN_VAL(key));
nl = scheme_null;
for (l = key; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
Scheme_Object *a;
a = SCHEME_CAR(l);
if (SCHEME_BYTE_STRINGP(a))
a = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(a), SCHEME_BYTE_STRLEN_VAL(a));
nl = scheme_make_pair(a, nl);
}
return scheme_reverse(nl);
}
#endif
Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_count)
{
Scheme_Struct_Type *parent = NULL;