/* Composes the meta-object. */
static void compose(PARROT_INTERP, PMC *nci) {
PMC *repr_info_hash, *repr_info, *type_info, *attr_list, *attr_iter, *unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1);
UNUSED(nci);
/* Do REPR composition. */
repr_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
type_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, repr_info, type_info);
VTABLE_push_pmc(interp, type_info, obj);
attr_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
attr_iter = VTABLE_get_iter(interp, ((KnowHOWREPRInstance *)PMC_data(self))->body.attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
PMC *attr = VTABLE_shift_pmc(interp, attr_iter);
PMC *attr_hash = Parrot_pmc_new(interp, enum_class_Hash);;
VTABLE_set_string_keyed_str(interp, attr_hash, name_str,
REPR(attr)->box_funcs->get_str(interp, STABLE(attr), OBJECT_BODY(attr)));
VTABLE_push_pmc(interp, attr_list, attr_hash);
}
VTABLE_push_pmc(interp, type_info, attr_list);
VTABLE_push_pmc(interp, type_info, Parrot_pmc_new(interp, enum_class_ResizablePMCArray));
repr_info_hash = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, repr_info_hash, attribute_str, repr_info);
REPR(obj)->compose(interp, STABLE(obj), repr_info_hash);
/* Set up method and type caches. */
STABLE(obj)->method_cache = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods;
STABLE(obj)->mode_flags = METHOD_CACHE_AUTHORITATIVE;
STABLE(obj)->type_check_cache_length = 1;
STABLE(obj)->type_check_cache = (PMC **)mem_sys_allocate(sizeof(PMC *));
STABLE(obj)->type_check_cache[0] = obj;
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", obj);
}
/* Locates all of the attributes. Puts them onto a flattened, ordered
* list of attributes (populating the passed flat_list). Also builds
* the index mapping for doing named lookups. Note index is not related
* to the storage position. */
static PMC * index_mapping_and_flat_list(PARROT_INTERP, PMC *WHAT, P6opaqueREPRData *repr_data) {
PMC *flat_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *class_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *attr_map_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
STRING *attributes_str = Parrot_str_new_constant(interp, "attributes");
STRING *parents_str = Parrot_str_new_constant(interp, "parents");
STRING *name_str = Parrot_str_new_constant(interp, "name");
STRING *mro_str = Parrot_str_new_constant(interp, "mro");
INTVAL current_slot = 0;
INTVAL num_classes, i;
P6opaqueNameMap * result = NULL;
/* Get the MRO. */
PMC *mro = introspection_call(interp, WHAT, STABLE(WHAT)->HOW, mro_str, 0);
INTVAL mro_idx = VTABLE_elements(interp, mro);
/* Walk through the parents list. */
while (mro_idx)
{
/* Get current class in MRO. */
PMC *current_class = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, mro, --mro_idx));
PMC *HOW = STABLE(current_class)->HOW;
/* Get its local parents. */
PMC *parents = introspection_call(interp, current_class, HOW, parents_str, 1);
INTVAL num_parents = VTABLE_elements(interp, parents);
/* Get attributes and iterate over them. */
PMC *attributes = introspection_call(interp, current_class, HOW, attributes_str, 1);
PMC *attr_map = PMCNULL;
PMC *attr_iter = VTABLE_get_iter(interp, attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
/* Get attribute. */
PMC * attr = VTABLE_shift_pmc(interp, attr_iter);
/* Get its name. */
PMC *name_pmc = accessor_call(interp, attr, name_str);
STRING *name = VTABLE_get_string(interp, name_pmc);
/* Allocate a slot. */
if (PMC_IS_NULL(attr_map))
attr_map = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, attr_map, name,
Parrot_pmc_new_init_int(interp, enum_class_Integer, current_slot));
current_slot++;
/* Push attr onto the flat list. */
VTABLE_push_pmc(interp, flat_list, attr);
}
/* Add to class list and map list. */
VTABLE_push_pmc(interp, class_list, current_class);
VTABLE_push_pmc(interp, attr_map_list, attr_map);
/* If there's more than one parent, flag that we in an MI
* situation. */
if (num_parents > 1)
repr_data->mi = 1;
}
/* We can now form the name map. */
num_classes = VTABLE_elements(interp, class_list);
result = (P6opaqueNameMap *) mem_sys_allocate_zeroed(sizeof(P6opaqueNameMap) * (1 + num_classes));
for (i = 0; i < num_classes; i++) {
result[i].class_key = VTABLE_get_pmc_keyed_int(interp, class_list, i);
result[i].name_map = VTABLE_get_pmc_keyed_int(interp, attr_map_list, i);
}
repr_data->name_to_index_mapping = result;
return flat_list;
}
/* Locates all of the attributes. Puts them onto a flattened, ordered
* list of attributes (populating the passed flat_list). Also builds
* the index mapping for doing named lookups. Note index is not related
* to the storage position. */
static PMC * index_mapping_and_flat_list(PARROT_INTERP, PMC *mro, CStructREPRData *repr_data) {
PMC *flat_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *class_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *attr_map_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
STRING *name_str = Parrot_str_new_constant(interp, "name");
INTVAL current_slot = 0;
INTVAL num_classes, i;
CStructNameMap * result = NULL;
/* Walk through the parents list. */
INTVAL mro_idx = VTABLE_elements(interp, mro);
while (mro_idx)
{
/* Get current class in MRO. */
PMC *type_info = VTABLE_get_pmc_keyed_int(interp, mro, --mro_idx);
PMC *current_class = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, type_info, 0));
/* Get its local parents; make sure we're not doing MI. */
PMC *parents = VTABLE_get_pmc_keyed_int(interp, type_info, 2);
INTVAL num_parents = VTABLE_elements(interp, parents);
if (num_parents <= 1) {
/* Get attributes and iterate over them. */
PMC *attributes = VTABLE_get_pmc_keyed_int(interp, type_info, 1);
PMC *attr_map = PMCNULL;
PMC *attr_iter = VTABLE_get_iter(interp, attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
/* Get attribute. */
PMC * attr = VTABLE_shift_pmc(interp, attr_iter);
/* Get its name. */
PMC *name_pmc = VTABLE_get_pmc_keyed_str(interp, attr, name_str);
STRING *name = VTABLE_get_string(interp, name_pmc);
/* Allocate a slot. */
if (PMC_IS_NULL(attr_map))
attr_map = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, attr_map, name,
Parrot_pmc_new_init_int(interp, enum_class_Integer, current_slot));
current_slot++;
/* Push attr onto the flat list. */
VTABLE_push_pmc(interp, flat_list, attr);
}
/* Add to class list and map list. */
VTABLE_push_pmc(interp, class_list, current_class);
VTABLE_push_pmc(interp, attr_map_list, attr_map);
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"CStruct representation does not support multiple inheritance");
}
}
/* We can now form the name map. */
num_classes = VTABLE_elements(interp, class_list);
result = (CStructNameMap *) mem_sys_allocate_zeroed(sizeof(CStructNameMap) * (1 + num_classes));
for (i = 0; i < num_classes; i++) {
result[i].class_key = VTABLE_get_pmc_keyed_int(interp, class_list, i);
result[i].name_map = VTABLE_get_pmc_keyed_int(interp, attr_map_list, i);
}
repr_data->name_to_index_mapping = result;
return flat_list;
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
SV *
blizkost_marshal_arg(BLIZKOST_NEXUS, PMC *arg) {
struct sv *result = NULL;
dBNPERL; dBNINTERP;
/* If it's a P5Scalar PMC, then we just fetch the SV from it - trivial
* round-tripping. */
if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Scalar"))) {
GETATTR_P5Scalar_sv(interp, arg, result);
}
/* XXX At this point, we should probably wrap it up in a tied Perl 5
* scalar so we can round-trip Parrot objects to. However, that's hard,
* so for now we cheat on a few special cases and just panic otherwise. */
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Integer"))) {
result = sv_2mortal(newSViv(VTABLE_get_integer(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "Float"))) {
result = sv_2mortal(newSVnv(VTABLE_get_number(interp, arg)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "P5Namespace"))) {
STRING *pkg;
char *c_str;
GETATTR_P5Namespace_ns_name(interp, arg, pkg);
c_str = Parrot_str_to_cstring(interp, pkg);
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_isa(interp, arg, CONST_STRING(interp, "String"))) {
char *c_str = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, arg));
result = sv_2mortal(newSVpv(c_str, strlen(c_str)));
}
else if (VTABLE_does(interp, arg, CONST_STRING(interp, "invokable"))) {
CV *wrapper = blizkost_wrap_callable(nexus, arg);
result = sv_2mortal(newRV_inc((SV*)wrapper));
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "array"))) {
PMC *iter;
struct av *array = newAV();
iter = VTABLE_get_iter(interp, arg);
while (VTABLE_get_bool(interp, iter)) {
PMC *item = VTABLE_shift_pmc(interp, iter);
struct sv *marshaled =
blizkost_marshal_arg(nexus, item);
av_push( array, marshaled);
}
result = newRV_inc((SV*)array);
}
else if ( VTABLE_does(interp, arg, CONST_STRING(interp, "hash"))) {
PMC *iter = VTABLE_get_iter(interp, arg);
struct hv *hash = newHV();
INTVAL n = VTABLE_elements(interp, arg);
INTVAL i;
for(i = 0; i < n; i++) {
STRING *s = VTABLE_shift_string(interp, iter);
char *c_str = Parrot_str_to_cstring(interp, s);
struct sv *val = blizkost_marshal_arg(nexus,
VTABLE_get_pmc_keyed_str(interp, arg, s));
hv_store(hash, c_str, strlen(c_str), val, 0);
}
result = newRV_inc((SV*)hash);
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Sorry, we do not support marshaling most things to Perl 5 yet.");
}
return result;
}
