Revert "remove unneeded places prefab-key conversions"
Well try again tomorrow to clean this up.
This reverts commit bd1c47cce1
.
This commit is contained in:
parent
982503b083
commit
5a01e9ddb8
|
@ -1047,7 +1047,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
nprefab_key = scheme_places_deep_copy_worker(SCHEME_CDR(stype->prefab_key), ht, copy);
|
nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht, copy);
|
||||||
|
|
||||||
if (copy) {
|
if (copy) {
|
||||||
new_so = scheme_make_serialized_struct_instance(nprefab_key, size);
|
new_so = scheme_make_serialized_struct_instance(nprefab_key, size);
|
||||||
|
@ -1073,16 +1073,13 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
|
||||||
Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so;
|
Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so;
|
||||||
Scheme_Struct_Type *stype;
|
Scheme_Struct_Type *stype;
|
||||||
Scheme_Structure *nst;
|
Scheme_Structure *nst;
|
||||||
Scheme_Object *key;
|
|
||||||
intptr_t size;
|
intptr_t size;
|
||||||
int i = 0;
|
int i = 0;
|
||||||
|
|
||||||
size = st->num_slots;
|
size = st->num_slots;
|
||||||
|
stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
|
||||||
|
|
||||||
key = scheme_places_deep_copy_worker(st->prefab_key, ht, copy);
|
|
||||||
|
|
||||||
if (copy) {
|
if (copy) {
|
||||||
stype = scheme_lookup_prefab_type(key, size);
|
|
||||||
new_so = scheme_make_blank_prefab_struct_instance(stype);
|
new_so = scheme_make_blank_prefab_struct_instance(stype);
|
||||||
nst = (Scheme_Structure*)new_so;
|
nst = (Scheme_Structure*)new_so;
|
||||||
} else
|
} else
|
||||||
|
|
|
@ -120,6 +120,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 *prefab_struct_key(int argc, Scheme_Object *argv[]);
|
||||||
static Scheme_Object *make_prefab_struct(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[]);
|
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_setter_p(int argc, Scheme_Object *argv[]);
|
||||||
static Scheme_Object *struct_getter_p(int argc, Scheme_Object *argv[]);
|
static Scheme_Object *struct_getter_p(int argc, Scheme_Object *argv[]);
|
||||||
|
@ -2798,7 +2801,13 @@ Scheme_Object *scheme_prefab_struct_key(Scheme_Object *so)
|
||||||
s = (Scheme_Structure *)SCHEME_CHAPERONE_VAL((Scheme_Object *)s);
|
s = (Scheme_Structure *)SCHEME_CHAPERONE_VAL((Scheme_Object *)s);
|
||||||
|
|
||||||
if (SCHEME_STRUCTP(((Scheme_Object *)s)) && s->stype->prefab_key) {
|
if (SCHEME_STRUCTP(((Scheme_Object *)s)) && s->stype->prefab_key) {
|
||||||
return SCHEME_CDR(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;
|
return scheme_false;
|
||||||
|
@ -3957,6 +3966,8 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base,
|
||||||
struct_type->num_islots = num_fields + (parent_type ? parent_type->num_islots : 0);
|
struct_type->num_islots = num_fields + (parent_type ? parent_type->num_islots : 0);
|
||||||
struct_type->name_pos = depth;
|
struct_type->name_pos = depth;
|
||||||
struct_type->inspector = scheme_false;
|
struct_type->inspector = scheme_false;
|
||||||
|
//Scheme_Object *accessor *mutator;
|
||||||
|
//Scheme_Object *prefab_key;
|
||||||
struct_type->uninit_val = uninit_val;
|
struct_type->uninit_val = uninit_val;
|
||||||
struct_type->props = NULL;
|
struct_type->props = NULL;
|
||||||
struct_type->num_props = 0;
|
struct_type->num_props = 0;
|
||||||
|
@ -3977,12 +3988,19 @@ static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *base,
|
||||||
Scheme_Object *uninit_val,
|
Scheme_Object *uninit_val,
|
||||||
char *immutable_array)
|
char *immutable_array)
|
||||||
{
|
{
|
||||||
return scheme_make_prefab_struct_type_raw(base,
|
#ifdef MZ_USE_PLACES
|
||||||
parent,
|
/*
|
||||||
num_fields,
|
return scheme_make_prefab_struct_type_in_master
|
||||||
num_uninit_fields,
|
*/
|
||||||
uninit_val,
|
#else
|
||||||
immutable_array);
|
#endif
|
||||||
|
return scheme_make_prefab_struct_type_raw
|
||||||
|
(base,
|
||||||
|
parent,
|
||||||
|
num_fields,
|
||||||
|
num_uninit_fields,
|
||||||
|
uninit_val,
|
||||||
|
immutable_array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Scheme_Object *_make_struct_type(Scheme_Object *base,
|
static Scheme_Object *_make_struct_type(Scheme_Object *base,
|
||||||
|
@ -4620,7 +4638,19 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type)
|
||||||
if (!SCHEME_NULLP(stack))
|
if (!SCHEME_NULLP(stack))
|
||||||
key = scheme_make_pair(scheme_make_integer(icnt), key);
|
key = scheme_make_pair(scheme_make_integer(icnt), key);
|
||||||
|
|
||||||
|
/*symbols aren't equal? across places now*/
|
||||||
|
#if defined(MZ_USE_PLACES)
|
||||||
|
if (SCHEME_SYMBOLP(type->name)) {
|
||||||
|
Scheme_Object *newname;
|
||||||
|
newname = scheme_make_sized_offset_byte_string((char *)type->name, SCHEME_SYMSTR_OFFSET(type->name), SCHEME_SYM_LEN(type->name), 1);
|
||||||
|
key = scheme_make_pair(newname, key);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
scheme_arg_mismatch("make_prefab_key", "unknown type of struct name", type->name);
|
||||||
|
}
|
||||||
|
#else
|
||||||
key = scheme_make_pair(type->name, key);
|
key = scheme_make_pair(type->name, key);
|
||||||
|
#endif
|
||||||
|
|
||||||
if (SCHEME_PAIRP(stack)) {
|
if (SCHEME_PAIRP(stack)) {
|
||||||
type = (Scheme_Struct_Type *)SCHEME_CAR(stack);
|
type = (Scheme_Struct_Type *)SCHEME_CAR(stack);
|
||||||
|
@ -4673,6 +4703,29 @@ static char *mutability_data_to_immutability_data(int icnt, Scheme_Object *mutab
|
||||||
return immutable_array;
|
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 *scheme_lookup_prefab_type(Scheme_Object *key, int field_count)
|
||||||
{
|
{
|
||||||
Scheme_Struct_Type *parent = NULL;
|
Scheme_Struct_Type *parent = NULL;
|
||||||
|
@ -4680,8 +4733,19 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
|
||||||
int ucnt, icnt;
|
int ucnt, icnt;
|
||||||
char *immutable_array = NULL;
|
char *immutable_array = NULL;
|
||||||
|
|
||||||
|
/*symbols aren't equal? across places now*/
|
||||||
|
#if defined(MZ_USE_PLACES)
|
||||||
|
if (SCHEME_SYMBOLP(key)) {
|
||||||
|
Scheme_Object *newname;
|
||||||
|
newname = scheme_make_sized_offset_byte_string((char*)key, SCHEME_SYMSTR_OFFSET(key), SCHEME_SYM_LEN(key), 1);
|
||||||
|
key = scheme_make_pair(newname, scheme_null);
|
||||||
|
}
|
||||||
|
if (SCHEME_BYTE_STRINGP(key))
|
||||||
|
key = scheme_make_pair(key, scheme_null);
|
||||||
|
#else
|
||||||
if (SCHEME_SYMBOLP(key))
|
if (SCHEME_SYMBOLP(key))
|
||||||
key = scheme_make_pair(key, scheme_null);
|
key = scheme_make_pair(key, scheme_null);
|
||||||
|
#endif
|
||||||
|
|
||||||
if (scheme_proper_list_length(key) < 0)
|
if (scheme_proper_list_length(key) < 0)
|
||||||
return NULL;
|
return NULL;
|
||||||
|
@ -4755,9 +4819,21 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
|
||||||
a = SCHEME_CAR(key);
|
a = SCHEME_CAR(key);
|
||||||
key = SCHEME_CDR(key);
|
key = SCHEME_CDR(key);
|
||||||
|
|
||||||
|
/*symbols aren't equal? across places now*/
|
||||||
|
#if defined(MZ_USE_PLACES)
|
||||||
|
if (SCHEME_SYMBOLP(a)) {
|
||||||
|
name = a;
|
||||||
|
}
|
||||||
|
else if (SCHEME_BYTE_STRINGP(a))
|
||||||
|
name = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(a), SCHEME_BYTE_STRLEN_VAL(a));
|
||||||
|
else
|
||||||
|
return NULL;
|
||||||
|
#else
|
||||||
if (!SCHEME_SYMBOLP(a))
|
if (!SCHEME_SYMBOLP(a))
|
||||||
return NULL;
|
return NULL;
|
||||||
name = a;
|
name = a;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables);
|
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables);
|
||||||
|
|
||||||
|
@ -4765,10 +4841,10 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
|
||||||
return NULL;
|
return NULL;
|
||||||
|
|
||||||
parent = scheme_make_prefab_struct_type(name,
|
parent = scheme_make_prefab_struct_type(name,
|
||||||
(Scheme_Object *)parent,
|
(Scheme_Object *)parent,
|
||||||
icnt, ucnt,
|
icnt, ucnt,
|
||||||
uninit_val,
|
uninit_val,
|
||||||
immutable_array);
|
immutable_array);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user