/* Initializes our cached versions of some strings and type IDs that we
* use very commonly. For strings, this should mean we only compute their
* hash value once, rather than every time we create and consume them. */
static void setup_binder_statics(PARROT_INTERP) {
ACCEPTS = Parrot_str_new_constant(interp, "ACCEPTS");
HOW = Parrot_str_new_constant(interp, "HOW");
DO_str = Parrot_str_new_constant(interp, "$!do");
NAME_str = Parrot_str_new_constant(interp, "name");
SELF_str = Parrot_str_new_constant(interp, "self");
BLOCK_str = Parrot_str_new_constant(interp, "Block");
CAPTURE_str = Parrot_str_new_constant(interp, "Capture");
STORAGE_str = Parrot_str_new_constant(interp, "$!storage");
REST_str = Parrot_str_new_constant(interp, "$!rest");
LIST_str = Parrot_str_new_constant(interp, "$!list");
HASH_str = Parrot_str_new_constant(interp, "$!hash");
FLATTENS_str = Parrot_str_new_constant(interp, "$!flattens");
NEXTITER_str = Parrot_str_new_constant(interp, "$!nextiter");
HASH_SIGIL_str = Parrot_str_new_constant(interp, "%");
ARRAY_SIGIL_str = Parrot_str_new_constant(interp, "@");
BANG_TWIGIL_str = Parrot_str_new_constant(interp, "!");
SCALAR_SIGIL_str = Parrot_str_new_constant(interp, "$");
NAMED_str = Parrot_str_new_constant(interp, "named");
INSTANTIATE_GENERIC_str = Parrot_str_new_constant(interp, "instantiate_generic");
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
p6l_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "Perl6LexPad", 0));
qrpa_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "QRPA", 0));
}
/* Initializes the P6opaque representation. */
REPROps * P6opaque_initialize(PARROT_INTERP) {
/* Allocate and populate the representation function table. */
this_repr = mem_allocate_zeroed_typed(REPROps);
this_repr->type_object_for = type_object_for;
this_repr->allocate = allocate;
this_repr->initialize = initialize;
this_repr->copy_to = copy_to;
this_repr->attr_funcs = mem_allocate_typed(REPROps_Attribute);
this_repr->attr_funcs->get_attribute_boxed = get_attribute_boxed;
this_repr->attr_funcs->get_attribute_ref = get_attribute_ref;
this_repr->attr_funcs->bind_attribute_boxed = bind_attribute_boxed;
this_repr->attr_funcs->bind_attribute_ref = bind_attribute_ref;
this_repr->attr_funcs->is_attribute_initialized = is_attribute_initialized;
this_repr->attr_funcs->hint_for = hint_for;
this_repr->box_funcs = mem_allocate_typed(REPROps_Boxing);
this_repr->box_funcs->set_int = set_int;
this_repr->box_funcs->get_int = get_int;
this_repr->box_funcs->set_num = set_num;
this_repr->box_funcs->get_num = get_num;
this_repr->box_funcs->set_str = set_str;
this_repr->box_funcs->get_str = get_str;
this_repr->box_funcs->get_boxed_ref = get_boxed_ref;
this_repr->gc_mark = gc_mark;
this_repr->gc_free = gc_free;
this_repr->gc_mark_repr_data = gc_mark_repr_data;
this_repr->gc_free_repr_data = gc_free_repr_data;
this_repr->get_storage_spec = get_storage_spec;
this_repr->change_type = change_type;
this_repr->serialize = serialize;
this_repr->deserialize = deserialize;
this_repr->serialize_repr_data = serialize_repr_data;
this_repr->deserialize_repr_data = deserialize_repr_data;
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
return this_repr;
}
PARROT_EXPORT
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC *
Parrot_oo_get_class(PARROT_INTERP, ARGIN(PMC *key))
{
ASSERT_ARGS(Parrot_oo_get_class)
PMC *classobj = PMCNULL;
if (PMC_IS_NULL(key))
return PMCNULL;
if (PObj_is_class_TEST(key))
classobj = key;
else {
/* Fast select of behavior based on type of the lookup key */
switch (key->vtable->base_type) {
case enum_class_NameSpace:
classobj = VTABLE_get_class(interp, key);
break;
case enum_class_String:
case enum_class_Key:
case enum_class_ResizableStringArray:
{
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
interp->HLL_namespace,
Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
PMC * const ns = Parrot_ns_get_namespace_keyed(interp,
hll_ns, key);
if (!PMC_IS_NULL(ns))
classobj = VTABLE_get_class(interp, ns);
}
default:
break;
}
}
/* If the PMCProxy doesn't exist yet for the given key, we look up the
type ID here and create a new one */
if (PMC_IS_NULL(classobj)) {
INTVAL type;
const INTVAL base_type = key->vtable->base_type;
/* This is a hack! All PMCs should be able to be handled through
a single codepath, and all of them should be able to avoid
stringification because it's so imprecise. */
if (base_type == enum_class_Key
|| base_type == enum_class_ResizableStringArray
|| base_type == enum_class_String)
type = Parrot_pmc_get_type(interp, key);
else
type = Parrot_pmc_get_type_str(interp, VTABLE_get_string(interp, key));
classobj = get_pmc_proxy(interp, type);
}
return classobj;
}
PARROT_EXPORT
Parrot_Int
Parrot_PMC_typenum(PARROT_INTERP, ARGIN_NULLOK(const char *_class))
{
ASSERT_ARGS(Parrot_PMC_typenum)
Parrot_Int retval = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, _class, 0));
return retval;
}
/* Gets the list of possible candidates to dispatch too. */
static PMC *get_dispatchees(PARROT_INTERP, PMC *dispatcher) {
if (!smo_id)
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
if (dispatcher->vtable->base_type == enum_class_Sub && PARROT_SUB(dispatcher)->multi_signature->vtable->base_type == smo_id) {
NQP_Routine *r = (NQP_Routine *)PMC_data(PARROT_SUB(dispatcher)->multi_signature);
return r->dispatchees;
}
else {
Parrot_ex_throw_from_c_args(interp, 0, 1,
"Could not find multi-dispatch list");
}
}
/*
=item C<static void add_to_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args)>
Adds an entry to the multi-dispatch cache.
=cut
*/
void add_to_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args, PMC *result) {
INTVAL arg_tup[MD_CACHE_MAX_ARITY];
INTVAL i, entries, ins_type;
struct Pcc_cell * pc_positionals;
/* Make sure 6model type ID is set. */
if (!smo_id)
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
/* If it's zero arity, just stick it in that slot. */
if (num_args == 0) {
cache->zero_arity = result;
return;
}
/* If the cache is saturated, don't do anything (we could instead do a random
* replacement). */
entries = cache->arity_caches[num_args - 1].num_entries;
if (entries == MD_CACHE_MAX_ENTRIES)
return;
/* Create arg tuple. */
if (capture->vtable->base_type == enum_class_CallContext)
GETATTR_CallContext_positionals(interp, capture, pc_positionals);
else
return;
for (i = 0; i < num_args; i++) {
if (pc_positionals[i].type == BIND_VAL_OBJ) {
PMC *arg = pc_positionals[i].u.p;
if (arg->vtable->base_type != smo_id)
return;
arg_tup[i] = STABLE(arg)->type_cache_id | (IS_CONCRETE(arg) ? 1 : 0);
}
else {
arg_tup[i] = (pc_positionals[i].type << 1) | 1;
}
}
/* If there's no entries yet, need to do some allocation. */
if (entries == 0) {
cache->arity_caches[num_args - 1].type_ids = mem_sys_allocate(num_args * sizeof(INTVAL) * MD_CACHE_MAX_ENTRIES);
cache->arity_caches[num_args - 1].results = mem_sys_allocate(sizeof(PMC *) * MD_CACHE_MAX_ENTRIES);
}
/* Add entry. */
ins_type = entries * num_args;
for (i = 0; i < num_args; i++)
cache->arity_caches[num_args - 1].type_ids[ins_type + i] = arg_tup[i];
cache->arity_caches[num_args - 1].results[entries] = result;
cache->arity_caches[num_args - 1].num_entries = entries + 1;
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
blizkost_wrap_sv(BLIZKOST_NEXUS, SV *sv) {
dBNPERL; dBNINTERP;
PMC *wrapper = Parrot_pmc_new_noinit(interp, Parrot_pmc_get_type_str(interp,
Parrot_str_new_constant(interp, "P5Scalar")));
PObj_custom_mark_SET(wrapper);
PObj_custom_destroy_SET(wrapper);
SETATTR_P5Scalar_nexus(interp, wrapper, nexus);
SETATTR_P5Scalar_sv(interp, wrapper, SvREFCNT_inc(sv));
return wrapper;
}
/* Gets (creating if needed) a multi-dispatch cache. */
static NQP_md_cache *get_dispatch_cache(PARROT_INTERP, PMC *dispatcher) {
PMC *cache_ptr;
if (!smo_id)
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
if (dispatcher->vtable->base_type == enum_class_Sub && PARROT_SUB(dispatcher)->multi_signature->vtable->base_type == smo_id) {
NQP_Routine *r = (NQP_Routine *)PMC_data(PARROT_SUB(dispatcher)->multi_signature);
if (PMC_IS_NULL(r->dispatch_cache)) {
NQP_md_cache *c = mem_sys_allocate_zeroed(sizeof(NQP_md_cache));
cache_ptr = Parrot_pmc_new(interp, enum_class_Pointer);
VTABLE_set_pointer(interp, cache_ptr, c);
r->dispatch_cache = cache_ptr;
PARROT_GC_WRITE_BARRIER(interp, PARROT_SUB(dispatcher)->multi_signature);
}
else {
cache_ptr = r->dispatch_cache;
}
}
else {
Parrot_ex_throw_from_c_args(interp, 0, 1,
"Could not find multi-dispatch list");
}
return (NQP_md_cache *)VTABLE_get_pointer(interp, cache_ptr);
}
/* Performs a multiple dispatch using the candidates held in the passed
* DispatcherSub and using the arguments in the passed capture. */
PMC *nqp_multi_dispatch(PARROT_INTERP, PMC *dispatcher, PMC *capture) {
/* Get list and number of dispatchees. */
PMC *dispatchees = PARROT_DISPATCHERSUB(dispatcher)->dispatchees;
const INTVAL num_candidates = VTABLE_elements(interp, dispatchees);
/* Count arguments. */
const INTVAL num_args = VTABLE_elements(interp, capture);
/* Initialize dispatcher state. */
INTVAL type_mismatch;
INTVAL possibles_count = 0;
candidate_info **possibles = mem_allocate_n_typed(num_candidates, candidate_info *);
INTVAL type_check_count;
/* Get sorted candidate list.
* XXX We'll cache this in the future. */
candidate_info** candidates = sort_candidates(interp, dispatchees);
candidate_info** cur_candidate = candidates;
/* Ensure we know what is a 6model object and what is not. */
if (!smo_id)
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
/* Iterate over the candidates and collect best ones; terminate
* when we see two nulls (may break out earlier). */
while (1) {
INTVAL i;
if (*cur_candidate == NULL) {
/* If we have some possible candidate(s), we're done in this loop. */
if (possibles_count)
break;
/* Otherwise, we keep looping and looking, unless we really hit the end. */
if (cur_candidate[1]) {
cur_candidate++;
continue;
}
else {
break;
}
}
/* Check if it's admissable by arity. */
if (num_args < (*cur_candidate)->min_arity || num_args > (*cur_candidate)->max_arity) {
cur_candidate++;
continue;
}
/* Check if it's admissable by type. */
type_check_count = (*cur_candidate)->num_types > num_args
? num_args
: (*cur_candidate)->num_types;
type_mismatch = 0;
for (i = 0; i < type_check_count; i++) {
PMC * const param = VTABLE_get_pmc_keyed_int(interp, capture, i);
PMC * const param_type = param->vtable->base_type == smo_id ?
STABLE(param)->WHAT : PMCNULL;
PMC * const type_obj = (*cur_candidate)->types[i];
INTVAL const definedness = (*cur_candidate)->definednesses[i];
if (param_type != type_obj && !is_narrower_type(interp, param_type, type_obj)) {
type_mismatch = 1;
break;
}
if (definedness) {
/* Have a constraint on the definedness. */
INTVAL defined = param->vtable->base_type == smo_id ?
IS_CONCRETE(param) :
VTABLE_defined(interp, param);
if ((!defined && definedness == DEFINED_ONLY) || (defined && definedness == UNDEFINED_ONLY)) {
type_mismatch = 1;
break;
}
}
}
if (type_mismatch) {
cur_candidate++;
continue;
}
/* If we get here, it's an admissable candidate; add to list. */
possibles[possibles_count] = *cur_candidate;
possibles_count++;
cur_candidate++;
}
/* Cache the result if there's a single chosen one. */
if (possibles_count == 1) {
/* XXX TODO: Cache entry. */
}
/* Need a unique candidate. */
if (possibles_count == 1) {
PMC *result = possibles[0]->sub;
mem_sys_free(possibles);
return result;
}
else if (possibles_count == 0) {
/* Get signatures of all possible candidates. We dump them in the
* order in which we search for them. */
STRING *signatures = Parrot_str_new(interp, "", 0);
cur_candidate = candidates;
while (1) {
if (!cur_candidate[0] && !cur_candidate[1])
break;
/* XXX TODO: add sig dumping.
if (cur_candidate[0])
signatures = dump_signature(interp, signatures, (*cur_candidate)->sub); */
cur_candidate++;
}
mem_sys_free(possibles);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"No applicable candidates found to dispatch to for '%Ss'. Available candidates are:\n%Ss",
VTABLE_get_string(interp, candidates[0]->sub),
signatures);
}
else {
/* Get signatures of ambiguous candidates. */
STRING *signatures = Parrot_str_new(interp, "", 0);
INTVAL i;
/* XXX TODO: sig dumping
for (i = 0; i < possibles_count; i++)
signatures = dump_signature(interp, signatures, possibles[i]->sub); */
mem_sys_free(possibles);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Ambiguous dispatch to multi '%Ss'. Ambiguous candidates had signatures:\n%Ss",
VTABLE_get_string(interp, candidates[0]->sub), signatures);
}
}
