/* Adds an attribute meta-object to the list. */ static void add_attribute(PARROT_INTERP, PMC *nci) { PMC * unused; /* Get attributes list out of meta-object. */ PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); PMC *attrs = ((KnowHOWREPRInstance *)PMC_data(self))->body.attributes; /* Add meta-attribute to it. */ PMC *meta_attr = VTABLE_get_pmc_keyed_int(interp, capture, 2); VTABLE_push_pmc(interp, attrs, meta_attr); unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", meta_attr); }
/* Composes the meta-object. */ static void compose(PARROT_INTERP, PMC *nci) { PMC * 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); 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); }
/* Adds a method. */ static void add_method(PARROT_INTERP, PMC *nci) { PMC * unused; /* Get methods table out of meta-object. */ PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); PMC *methods = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods; /* Get name and method to add. */ STRING *name = VTABLE_get_string_keyed_int(interp, capture, 2); PMC *method = VTABLE_get_pmc_keyed_int(interp, capture, 3); /* Add it, and return added method as result. */ VTABLE_set_pmc_keyed_str(interp, methods, name, method); unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", method); }
int blizkost_slurpy_to_stack(BLIZKOST_NEXUS, PMC *positional, PMC *named) { int num_pos, i, stkdepth; PMC *iter; dBNPERL; dBNINTERP; dSP; stkdepth = 0; /* Stick on positional arguments. */ num_pos = VTABLE_elements(interp, positional); for (i = 0; i < num_pos; i++) { PMC *pos_arg = VTABLE_get_pmc_keyed_int(interp, positional, i); XPUSHs(blizkost_marshal_arg(nexus, pos_arg)); stkdepth++; } /* Stick on named arguments (we unbundle them to a string * followed by the argument. */ iter = VTABLE_get_iter(interp, named); while (VTABLE_get_bool(interp, iter)) { STRING *arg_name = VTABLE_shift_string(interp, iter); PMC *arg_value = VTABLE_get_pmc_keyed_str(interp, named, arg_name); char *c_arg_name = Parrot_str_to_cstring(interp, arg_name); XPUSHs(sv_2mortal(newSVpv(c_arg_name, strlen(c_arg_name)))); XPUSHs(blizkost_marshal_arg(nexus, arg_value)); stkdepth += 2; } PUTBACK; return stkdepth; }
static STRING *get_str(PARROT_INTERP, STable *st, void *data) { CStrBody *body = (CStrBody *) data; PMC *old_ctx, *cappy, *meth, *enc_pmc; STRING *enc; STR_VTABLE *encoding; if (!body->cstr) return (STRING *) NULL; /* Look up "encoding" method. */ meth = VTABLE_find_method(interp, st->WHAT, Parrot_str_new_constant(interp, "encoding")); if (PMC_IS_NULL(meth)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStr representation expects an 'encoding' method, specifying the encoding"); old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, st->WHAT); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); enc_pmc = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0)); enc = REPR(enc_pmc)->box_funcs->get_str(interp, STABLE(enc_pmc), OBJECT_BODY(enc_pmc)); return new_from_cstring(interp, body->cstr, enc); }
/* Introspects the methods. For now just hand back real method table. */ static void methods(PARROT_INTERP, PMC *nci) { PMC * unused; PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); PMC *meths = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods; unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", meths); }
/* Extracts bind value information for a positional parameter. */ static Rakudo_BindVal get_positional_bind_val(PARROT_INTERP, struct Pcc_cell *pc_positionals, PMC *capture, INTVAL cur_pos_arg) { Rakudo_BindVal cur_bv; if (pc_positionals) { switch (pc_positionals[cur_pos_arg].type) { case BIND_VAL_INT: cur_bv.type = BIND_VAL_INT; cur_bv.val.i = pc_positionals[cur_pos_arg].u.i; break; case BIND_VAL_NUM: cur_bv.type = BIND_VAL_NUM; cur_bv.val.n = pc_positionals[cur_pos_arg].u.n; break; case BIND_VAL_STR: cur_bv.type = BIND_VAL_STR; cur_bv.val.s = pc_positionals[cur_pos_arg].u.s; break; default: cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = pc_positionals[cur_pos_arg].u.p; } } else { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = VTABLE_get_pmc_keyed_int(interp, capture, cur_pos_arg); } return cur_bv; }
/* Attribute name introspection. */ static void attr_name(PARROT_INTERP, PMC *nci) { PMC * unused; PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); STRING *name = REPR(self)->box_funcs->get_str(interp, STABLE(self), OBJECT_BODY(self)); unused = Parrot_pcc_build_call_from_c_args(interp, capture, "S", name); }
/* Introspects the name. */ static void name(PARROT_INTERP, PMC *nci) { PMC * unused; PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); STRING *name = ((KnowHOWREPRInstance *)PMC_data(self))->body.name; unused = Parrot_pcc_build_call_from_c_args(interp, capture, "S", name); }
/* Creates a new type with this HOW as its meta-object. */ static void new_type(PARROT_INTERP, PMC *nci) { PMC * unused; /* We first create a new HOW instance. */ PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); PMC *HOW = REPR(self)->allocate(interp, STABLE(self)); /* See if we have a representation name; if not default to P6opaque. */ STRING *repr_name = VTABLE_exists_keyed_str(interp, capture, repr_str) ? VTABLE_get_string_keyed_str(interp, capture, repr_str) : p6opaque_str; /* Create a new type object of the desired REPR. (Note that we can't * default to KnowHOWREPR here, since it doesn't know how to actually * store attributes, it's just for bootstrapping knowhow's. */ REPROps *repr_to_use = REPR_get_by_name(interp, repr_name); PMC *type_object = repr_to_use->type_object_for(interp, HOW); /* See if we were given a name; put it into the meta-object if so. */ STRING *name = VTABLE_exists_keyed_str(interp, capture, name_str) ? VTABLE_get_string_keyed_str(interp, capture, name_str) : empty_str; REPR(HOW)->initialize(interp, STABLE(HOW), OBJECT_BODY(HOW)); ((KnowHOWREPRInstance *)PMC_data(HOW))->body.name = name; PARROT_GC_WRITE_BARRIER(interp, HOW); /* Set .WHO to an empty hash. */ STABLE(type_object)->WHO = Parrot_pmc_new(interp, enum_class_Hash); PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(type_object)); /* Put it into capture to act as return value. */ unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", type_object); }
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; }
/* Introspects the MRO. That's just a list with ourself. */ static void mro(PARROT_INTERP, PMC *nci) { PMC * unused; PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1); PMC *mro = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); VTABLE_push_pmc(interp, mro, STABLE(obj)->WHAT); unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", mro); }
/* Given an SC and an index, fetch the object stored there. */ PMC * SC_get_object(PARROT_INTERP, PMC *sc, INTVAL idx) { PMC *objects; GETATTR_SerializationContext_root_objects(interp, sc, objects); if (idx >= VTABLE_elements(interp, objects)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "No object at index %d", idx); return VTABLE_get_pmc_keyed_int(interp, objects, idx); }
/* Attribute new method. */ static void attr_new(PARROT_INTERP, PMC *nci) { PMC * unused; PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *type = VTABLE_get_pmc_keyed_int(interp, capture, 0); STRING *name = VTABLE_get_string_keyed_str(interp, capture, name_str); PMC *self = REPR(type)->allocate(interp, STABLE(type)); REPR(self)->box_funcs->set_str(interp, STABLE(self), OBJECT_BODY(self), name); unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", self); }
/* Sets up a very simple attribute meta-object. Just supports having a * name, and even uses the P6str representation to store it, so that's * really all that it supports. */ PMC * SixModelObject_setup_knowhow_attribute(PARROT_INTERP, PMC *sc, PMC *knowhow) { PMC *old_ctx, *cappy, *meth, *knowhow_attr, *how; /* Create a new KnowHOWAttribute type using P6str repr.. */ meth = STABLE(knowhow)->find_method(interp, knowhow, Parrot_str_new_constant(interp, "new_type"), NO_HINT); old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, knowhow); VTABLE_set_string_keyed_str(interp, cappy, name_str, Parrot_str_new_constant(interp, "KnowHOWAttribute")); VTABLE_set_string_keyed_str(interp, cappy, repr_str, Parrot_str_new_constant(interp, "P6str")); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); knowhow_attr = VTABLE_get_pmc_keyed_int(interp, cappy, 0); how = STABLE(knowhow_attr)->HOW; /* Add new method. */ meth = STABLE(how)->find_method(interp, how, Parrot_str_new_constant(interp, "add_method"), NO_HINT); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, how); VTABLE_push_pmc(interp, cappy, knowhow_attr); VTABLE_push_string(interp, cappy, Parrot_str_new_constant(interp, "new")); VTABLE_push_pmc(interp, cappy, wrap_c(interp, F2DPTR(attr_new))); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); /* Add name method. */ cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, how); VTABLE_push_pmc(interp, cappy, knowhow_attr); VTABLE_push_string(interp, cappy, name_str); VTABLE_push_pmc(interp, cappy, wrap_c(interp, F2DPTR(attr_name))); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); /* Compose. */ meth = STABLE(knowhow)->find_method(interp, how, Parrot_str_new_constant(interp, "compose"), NO_HINT); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, how); VTABLE_push_pmc(interp, cappy, knowhow_attr); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); /* Associate the created object with the intial core serialization * context. */ VTABLE_set_pmc_keyed_int(interp, sc, 2, knowhow_attr); SC_PMC(knowhow_attr) = sc; STABLE(knowhow_attr)->sc = sc; return knowhow_attr; }
/* Given an SC, looks up the index of an object that is in its root set. */ INTVAL SC_find_object_idx(PARROT_INTERP, PMC *sc, PMC *obj) { PMC *to_search; INTVAL i, count; GETATTR_SerializationContext_root_objects(interp, sc, to_search); count = VTABLE_elements(interp, to_search); for (i = 0; i < count; i++) if (VTABLE_get_pmc_keyed_int(interp, to_search, i) == obj) return i; Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Object does not exist in serialization context"); }
/* Finds a method. */ static void find_method(PARROT_INTERP, PMC *nci) { PMC * unused; /* Get methods table out of meta-object and look up method. */ PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0); PMC *methods = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods; STRING *name = VTABLE_get_string_keyed_int(interp, capture, 2); PMC *method = VTABLE_get_pmc_keyed_str(interp, methods, name); /* Put into capture to act as return value. */ unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", method); }
/* 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); }
PARROT_CAN_RETURN_NULL static PMC * make_local_copy(PARROT_INTERP, ARGIN(Parrot_Interp from), ARGIN(PMC *arg)) { ASSERT_ARGS(make_local_copy) PMC *ret_val; STRING * const _sub = interp->vtables[enum_class_Sub]->whoami; STRING * const _multi_sub = interp->vtables[enum_class_MultiSub]->whoami; if (PMC_IS_NULL(arg)) { ret_val = PMCNULL; } else if (PObj_is_PMC_shared_TEST(arg)) { ret_val = arg; } else if (VTABLE_isa(from, arg, _multi_sub)) { INTVAL i = 0; const INTVAL n = VTABLE_elements(from, arg); ret_val = Parrot_pmc_new(interp, enum_class_MultiSub); for (i = 0; i < n; ++i) { PMC *const orig = VTABLE_get_pmc_keyed_int(from, arg, i); PMC *const copy = make_local_copy(interp, from, orig); VTABLE_push_pmc(interp, ret_val, copy); } } else if (VTABLE_isa(from, arg, _sub)) { /* this is a workaround for cloning subroutines not actually * working as one might expect mainly because the segment is * not correctly copied */ Parrot_Sub_attributes *ret_val_sub, *arg_sub; ret_val = Parrot_clone(interp, arg); PMC_get_sub(interp, ret_val, ret_val_sub); PMC_get_sub(interp, arg, arg_sub); ret_val_sub->seg = arg_sub->seg; /* Skip vtable overrides and methods. */ if (ret_val_sub->vtable_index == -1 && !(ret_val_sub->comp_flags & SUB_COMP_FLAG_METHOD)) { Parrot_ns_store_sub(interp, ret_val); } } else { ret_val = Parrot_clone(interp, arg); } return ret_val; }
/* This function gets shared with perl6.ops for the perl6_parcel_from_rpa op. */ PMC * Rakudo_binding_parcel_from_rpa(PARROT_INTERP, PMC *rpa, PMC *fill) { PMC *type = Rakudo_types_parcel_get(); PMC *parcel = REPR(type)->allocate(interp, STABLE(type)); VTABLE_set_attr_keyed(interp, parcel, type, STORAGE_str, rpa); if (!PMC_IS_NULL(fill)) { INTVAL elems = VTABLE_elements(interp, rpa); INTVAL i; for (i = 0; i < elems; i++) { if (PMC_IS_NULL(VTABLE_get_pmc_keyed_int(interp, rpa, i))) VTABLE_set_pmc_keyed_int(interp, rpa, i, fill); } } return parcel; }
static STRING * Rakudo_binding_arity_fail(PARROT_INTERP, PMC *params, INTVAL num_params, INTVAL num_pos_args, INTVAL too_many) { STRING *result; INTVAL arity = 0; INTVAL count = 0; INTVAL i; const char *whoz_up = too_many ? "Too many" : "Not enough"; /* Work out how many we could have been passed. */ for (i = 0; i < num_params; i++) { Rakudo_Parameter *param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i)); if (!PMC_IS_NULL(param->named_names)) continue; if (param->flags & SIG_ELEM_SLURPY_NAMED) continue; if (param->flags & SIG_ELEM_SLURPY_POS) { count = -1; } else if (param->flags & SIG_ELEM_IS_OPTIONAL) { count++; } else { count++; arity++; } } /* Now generate decent error. */ if (arity == count) result = Parrot_sprintf_c(interp, "%s positional parameters passed; got %d but expected %d", whoz_up, num_pos_args, arity); else if (count == -1) result = Parrot_sprintf_c(interp, "%s positional parameters passed; got %d but expected at least %d", whoz_up, num_pos_args, arity); else result = Parrot_sprintf_c(interp, "%s positional parameters passed; got %d but expected between %d and %d", whoz_up, num_pos_args, arity, count); return result; }
/* Helper to make an accessor call. */ static PMC * accessor_call(PARROT_INTERP, PMC *obj, STRING *name) { PMC *old_ctx, *cappy; /* Look up method; if there is none hand back a null. */ PMC *meth = VTABLE_find_method(interp, obj, name); if (PMC_IS_NULL(meth)) return meth; /* Set up call capture. */ old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, obj); /* Call. */ Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); /* Grab result. */ cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); return VTABLE_get_pmc_keyed_int(interp, cappy, 0); }
/* This takes a signature element and either runs the closure to get a default * value if there is one, or creates an appropriate undefined-ish thingy. */ static PMC * Rakudo_binding_handle_optional(PARROT_INTERP, Rakudo_Parameter *param, PMC *lexpad) { PMC *cur_lex; /* Is the "get default from outer" flag set? */ if (param->flags & SIG_ELEM_DEFAULT_FROM_OUTER) { PMC *outer_ctx = Parrot_pcc_get_outer_ctx(interp, CURRENT_CONTEXT(interp)); PMC *outer_lexpad = Parrot_pcc_get_lex_pad(interp, outer_ctx); return VTABLE_get_pmc_keyed_str(interp, outer_lexpad, param->variable_name); } /* Do we have a default value or value closure? */ else if (!PMC_IS_NULL(param->default_value)) { if (param->flags & SIG_ELEM_DEFAULT_IS_LITERAL) { return param->default_value; } else { /* Thunk; run it to get a value. */ PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *cappy = Parrot_pmc_new(interp, enum_class_CallContext); Parrot_pcc_invoke_from_sig_object(interp, param->default_value, cappy); cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); return VTABLE_get_pmc_keyed_int(interp, cappy, 0); } } /* Otherwise, go by sigil to pick the correct default type of value. */ else { if (param->flags & SIG_ELEM_ARRAY_SIGIL) { return Rakudo_binding_create_positional(interp, PMCNULL); } else if (param->flags & SIG_ELEM_HASH_SIGIL) { return Rakudo_binding_create_hash(interp, Parrot_pmc_new(interp, enum_class_Hash)); } else { return param->nominal_type; } } }
static void set_str(PARROT_INTERP, STable *st, void *data, STRING *value) { CStrBody *body = (CStrBody *) data; PMC *old_ctx, *cappy, *meth, *enc_pmc; STRING *enc; STR_VTABLE *encoding; if(body->cstr) mem_sys_free(body->cstr); /* Look up "encoding" method. */ meth = VTABLE_find_method(interp, st->WHAT, Parrot_str_new_constant(interp, "encoding")); if (PMC_IS_NULL(meth)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStr representation expects an 'encoding' method, specifying the encoding"); old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, st->WHAT); Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); enc_pmc = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0)); enc = REPR(enc_pmc)->box_funcs->get_str(interp, STABLE(enc_pmc), OBJECT_BODY(enc_pmc)); if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "utf8"))) encoding = Parrot_utf8_encoding_ptr; else if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "utf16"))) encoding = Parrot_utf16_encoding_ptr; else if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "ascii"))) encoding = Parrot_ascii_encoding_ptr; else Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Unknown encoding passed to CStr representation"); body->cstr = Parrot_str_to_encoded_cstring(interp, value, encoding); }
/* Helper to make an introspection call, possibly with :local. */ static PMC * introspection_call(PARROT_INTERP, PMC *WHAT, PMC *HOW, STRING *name, INTVAL local) { PMC *old_ctx, *cappy; /* Look up method; if there is none hand back a null. */ PMC *meth = VTABLE_find_method(interp, HOW, name); if (PMC_IS_NULL(meth)) return meth; /* Set up call capture. */ old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); cappy = Parrot_pmc_new(interp, enum_class_CallContext); VTABLE_push_pmc(interp, cappy, HOW); VTABLE_push_pmc(interp, cappy, WHAT); if (local) VTABLE_set_integer_keyed_str(interp, cappy, Parrot_str_new_constant(interp, "local"), 1); /* Call. */ Parrot_pcc_invoke_from_sig_object(interp, meth, cappy); /* Grab result. */ cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); return VTABLE_get_pmc_keyed_int(interp, cappy, 0); }
/* Binds a single argument into the lexpad, after doing any checks that are * needed. Also handles any type captures. If there is a sub signature, then * re-enters the binder. Returns one of the BIND_RESULT_* codes. */ static INTVAL Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, PMC *llsig, llsig_element *sig_info, PMC *value, INTVAL no_nom_type_check, STRING **error) { /* If we need to do a type check, do one. */ if (!no_nom_type_check) { /* See if we get a hit in the type cache. */ INTVAL cache_matched = 0; INTVAL value_type = VTABLE_type(interp, value); if (value_type != 0) { INTVAL i; for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) { if (sig_info->nom_type_cache[i] == value_type) { cache_matched = 1; break; } } } /* If not, do the check. */ if (!cache_matched) { PMC * const type_obj = sig_info->nominal_type; PMC * accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS); PMC * result = PMCNULL; Parrot_ext_call(interp, accepts_meth, "PiP->P", type_obj, value, &result); if (VTABLE_get_bool(interp, result)) { /* Cache if possible. */ if (value_type != 0 && value_type != p6r_id && value_type != p6o_id) { INTVAL i; for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) { if (sig_info->nom_type_cache[i] == 0) { sig_info->nom_type_cache[i] = value_type; PARROT_GC_WRITE_BARRIER(interp, llsig); break; } } } } else { /* Type check failed. However, for language inter-op, we do some * extra checks if the type is just Positional, Associative, or * Callable and the thingy we have matches those enough. */ /* XXX TODO: Implement language interop checks. */ if (error) { STRING * const perl = PERL_str; PMC * perl_meth = VTABLE_find_method(interp, type_obj, perl); PMC * how_meth = VTABLE_find_method(interp, value, HOW); STRING * expected, * got; PMC * value_how, * value_type; Parrot_ext_call(interp, perl_meth, "Pi->S", type_obj, &expected); Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how); value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str); got = VTABLE_get_string(interp, value_type); *error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead", sig_info->variable_name, expected, got); } if (VTABLE_isa(interp, value, JUNCTION_str)) return BIND_RESULT_JUNCTION; else return BIND_RESULT_FAIL; } } } /* Do we have any type captures to bind? */ if (!PMC_IS_NULL(sig_info->type_captures)) Rakudo_binding_bind_type_captures(interp, lexpad, sig_info, value); /* Do a coercion, if one is needed. */ if (!STRING_IS_NULL(sig_info->coerce_to)) { PMC *coerce_meth = VTABLE_find_method(interp, value, sig_info->coerce_to); if (!PMC_IS_NULL(coerce_meth)) { Parrot_ext_call(interp, coerce_meth, "Pi->P", value, &value); } else { /* No coercion method availale; whine and fail to bind. */ if (error) { PMC * how_meth = VTABLE_find_method(interp, value, HOW); PMC * value_how, * value_type; STRING * got; Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how); value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str); got = VTABLE_get_string(interp, value_type); *error = Parrot_sprintf_c(interp, "Unable to coerce value for '%S' from %S to %S; no coercion method defined", sig_info->variable_name, got, sig_info->coerce_to); } return BIND_RESULT_FAIL; } } /* If it's not got attributive binding, we'll go about binding it into the * lex pad. */ if (!(sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE)) { /* Is it "is rw"? */ if (sig_info->flags & SIG_ELEM_IS_RW) { /* XXX TODO Check if rw flag is set. */ if (!STRING_IS_NULL(sig_info->variable_name)) VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value); } else if (sig_info->flags & SIG_ELEM_IS_PARCEL) { /* Just bind the thing as is into the lexpad. */ if (!STRING_IS_NULL(sig_info->variable_name)) VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value); } else if (sig_info->flags & SIG_ELEM_IS_COPY) { /* Place the value into a new container instead of binding to an existing one */ value = descalarref(interp, value); if (!STRING_IS_NULL(sig_info->variable_name)) { PMC *copy, *ref, *store_meth; if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) { copy = Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str); store_meth = VTABLE_find_method(interp, copy, STORE_str); Parrot_ext_call(interp, store_meth, "PiP", copy, value); } else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) { copy = Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash)); store_meth = VTABLE_find_method(interp, copy, STORE_str); Parrot_ext_call(interp, store_meth, "PiP", copy, value); } else { copy = pmc_new_init(interp, p6s_id, value); VTABLE_setprop(interp, copy, SCALAR_str, copy); } VTABLE_setprop(interp, copy, RW_str, copy); VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, copy); } } else { /* Read only. Wrap it into a ObjectRef, mark readonly and bind it. */ if (!STRING_IS_NULL(sig_info->variable_name)) { PMC *ref = pmc_new_init(interp, or_id, value); if (!(sig_info->flags & (SIG_ELEM_ARRAY_SIGIL | SIG_ELEM_HASH_SIGIL))) VTABLE_setprop(interp, ref, SCALAR_str, ref); VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, ref); } } } /* Is it the invocant? If so, also have to bind to self lexical. */ if (sig_info->flags & SIG_ELEM_INVOCANT) VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, value); /* Handle any constraint types (note that they may refer to the parameter by * name, so we need to have bound it already). */ if (!PMC_IS_NULL(sig_info->post_constraints)) { PMC * const constraints = sig_info->post_constraints; INTVAL num_constraints = VTABLE_elements(interp, constraints); PMC * result = PMCNULL; INTVAL i; for (i = 0; i < num_constraints; i++) { PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i); PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS); if (VTABLE_isa(interp, cons_type, BLOCK_str)) Parrot_sub_capture_lex(interp, VTABLE_get_attr_str(interp, cons_type, DO_str)); Parrot_ext_call(interp, accepts_meth, "PiP->P", cons_type, value, &result); if (!VTABLE_get_bool(interp, result)) { if (error) *error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'", sig_info->variable_name); return BIND_RESULT_FAIL; } } } /* If it's attributive, now we assign it. */ if (sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE) { INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, sig_info, value, error); if (result != BIND_RESULT_OK) return result; } /* If it has a sub-signature, bind that. */ if (!PMC_IS_NULL(sig_info->sub_llsig)) { /* Turn value into a capture, unless we already have one. */ PMC *capture = PMCNULL; INTVAL result; if (sig_info->flags & SIG_ELEM_IS_CAPTURE) { capture = value; } else { PMC *meth = VTABLE_find_method(interp, value, Parrot_str_new(interp, "Capture", 0)); if (PMC_IS_NULL(meth)) { if (error) *error = Parrot_sprintf_c(interp, "Could not turn argument into capture"); return BIND_RESULT_FAIL; } Parrot_ext_call(interp, meth, "Pi->P", value, &capture); } /* Recurse into signature binder. */ result = Rakudo_binding_bind_llsig(interp, lexpad, sig_info->sub_llsig, capture, no_nom_type_check, error); if (result != BIND_RESULT_OK) { if (error) { /* Note in the error message that we're in a sub-signature. */ *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, " in sub-signature", 0)); /* Have we a variable name? */ if (!STRING_IS_NULL(sig_info->variable_name)) { *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, " of parameter ", 0)); *error = Parrot_str_concat(interp, *error, sig_info->variable_name); } } return result; } } /* Binding of this parameter was thus successful - we're done. */ return BIND_RESULT_OK; }
void Parrot_nci_load_core_thunks(PARROT_INTERP) { PMC * const iglobals = interp->iglobals; PMC *nci_funcs; PMC *temp_pmc; PARROT_ASSERT(!(PMC_IS_NULL(iglobals))); nci_funcs = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS); PARROT_ASSERT(!(PMC_IS_NULL(nci_funcs))); { const int n = 1; static const int sig[] = { 5, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_char); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 5, 6, 5, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_char_short_char); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 16, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_double); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 16, 16, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_double_double); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 15, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_float); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 15, 15, 15, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_float_float_float); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 4; static const int sig[] = { 7, 7, 7, 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_int_int_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 7, 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 7, 30, 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_ptr_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 7, 6, 5, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_short_char); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 7, 31, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_cstr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 8, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_long); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 30, 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 30, 7, 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 5; static const int sig[] = { 30, 7, 7, 7, 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_int_int_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 30, 7, 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 30, 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 30, 30, 3, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_ptr_STRING); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 6, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_short); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 6, 6, 5, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_short_short_char); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 31, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 31, 31, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr_cstr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 31, 31, 31, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr_cstr_cstr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 1; static const int sig[] = { 29, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 4; static const int sig[] = { 29, 15, 15, 15, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_float_float_float); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 29, 30, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 2; static const int sig[] = { 29, 4, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_PMC); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 4; static const int sig[] = { 29, 30, 7, 7, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr_int_int); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } { const int n = 3; static const int sig[] = { 29, 30, 4, }; PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n); int i; for (i = 0; i < n; i++) VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]); temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct); VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr_PMC); VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc); } }
/* Compile time trial binding; tries to determine at compile time whether * certain binds will/won't work. */ INTVAL Rakudo_binding_trial_bind(PARROT_INTERP, PMC *sig_pmc, PMC *capture) { INTVAL i, num_pos_args, got_prim; INTVAL cur_pos_arg = 0; Rakudo_Signature *sig = (Rakudo_Signature *)PMC_data(sig_pmc); PMC *params = sig->params; INTVAL num_params = VTABLE_elements(interp, params); /* Grab arguments. */ struct Pcc_cell * pc_positionals = NULL; if (capture->vtable->base_type == enum_class_CallContext) GETATTR_CallContext_positionals(interp, capture, pc_positionals); else return TRIAL_BIND_NOT_SURE; /* Set up statics. */ if (!smo_id) setup_binder_statics(interp); /* Walk through the signature and consider the parameters. */ num_pos_args = VTABLE_elements(interp, capture); for (i = 0; i < num_params; i++) { Rakudo_Parameter *param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i)); /* If the parameter is anything other than a boring old * required positional parameter, we won't analyze it. */ if (param->flags & ~( SIG_ELEM_MULTI_INVOCANT | SIG_ELEM_IS_PARCEL | SIG_ELEM_IS_COPY | SIG_ELEM_ARRAY_SIGIL | SIG_ELEM_HASH_SIGIL | SIG_ELEM_NATIVE_VALUE)) return TRIAL_BIND_NOT_SURE; if (!PMC_IS_NULL(param->named_names)) return TRIAL_BIND_NOT_SURE; if (!PMC_IS_NULL(param->post_constraints)) return TRIAL_BIND_NOT_SURE; if (!PMC_IS_NULL(param->type_captures)) return TRIAL_BIND_NOT_SURE; /* Did we pass too few required arguments? If so, fail. */ if (cur_pos_arg >= num_pos_args) return TRIAL_BIND_NO_WAY; /* Otherwise, need to consider type. */ got_prim = pc_positionals[cur_pos_arg].type; if (param->flags & SIG_ELEM_NATIVE_VALUE) { if (got_prim == BIND_VAL_OBJ) { /* We got an object; if we aren't sure we can unbox, we can't * be sure about the dispatch. */ PMC *arg = pc_positionals[cur_pos_arg].u.p; storage_spec spec = REPR(arg)->get_storage_spec(interp, STABLE(arg)); switch (param->flags & SIG_ELEM_NATIVE_VALUE) { case SIG_ELEM_NATIVE_INT_VALUE: if (!(spec.can_box & STORAGE_SPEC_CAN_BOX_INT)) return TRIAL_BIND_NOT_SURE; break; case SIG_ELEM_NATIVE_NUM_VALUE: if (!(spec.can_box & STORAGE_SPEC_CAN_BOX_NUM)) return TRIAL_BIND_NOT_SURE; break; case SIG_ELEM_NATIVE_STR_VALUE: if (!(spec.can_box & STORAGE_SPEC_CAN_BOX_STR)) return TRIAL_BIND_NOT_SURE; break; default: /* WTF... */ return TRIAL_BIND_NOT_SURE; } } else { /* If it's the wrong type of native, there's no way it * can ever bind. */ if ((param->flags & SIG_ELEM_NATIVE_INT_VALUE) && got_prim != BIND_VAL_INT || (param->flags & SIG_ELEM_NATIVE_NUM_VALUE) && got_prim != BIND_VAL_NUM || (param->flags & SIG_ELEM_NATIVE_STR_VALUE) && got_prim != BIND_VAL_STR) return TRIAL_BIND_NO_WAY; } } else { /* Work out a parameter type to consider, and see if it matches. */ PMC * const arg = got_prim == BIND_VAL_OBJ ? pc_positionals[cur_pos_arg].u.p : got_prim == BIND_VAL_INT ? Rakudo_types_int_get() : got_prim == BIND_VAL_NUM ? Rakudo_types_num_get() : Rakudo_types_str_get(); if (param->nominal_type != Rakudo_types_mu_get() && !STABLE(arg)->type_check(interp, arg, param->nominal_type)) { /* If it failed because we got a junction, may auto-thread; * hand back "not sure" for now. */ if (STABLE(arg)->WHAT == Rakudo_types_junction_get()) return TRIAL_BIND_NOT_SURE; /* It failed to, but that doesn't mean it can't work at runtime; * we perhaps want an Int, and the most we know is we have an Any, * which would include Int. However, the Int ~~ Str case can be * rejected now, as there's no way it'd ever match. Basically, we * just flip the type check around. */ return STABLE(param->nominal_type)->type_check(interp, param->nominal_type, arg) ? TRIAL_BIND_NOT_SURE : TRIAL_BIND_NO_WAY; } } /* Continue to next argument. */ cur_pos_arg++; } /* If we have any left over arguments, it's a binding fail. */ if (cur_pos_arg < num_pos_args) return TRIAL_BIND_NO_WAY; /* Otherwise, if we get there, all is well. */ return TRIAL_BIND_OK; }
/* Binds a single argument into the lexpad, after doing any checks that are * needed. Also handles any type captures. If there is a sub signature, then * re-enters the binder. Returns one of the BIND_RESULT_* codes. */ static INTVAL Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, Rakudo_Signature *signature, Rakudo_Parameter *param, Rakudo_BindVal orig_bv, INTVAL no_nom_type_check, STRING **error) { PMC *decont_value = NULL; INTVAL desired_native; Rakudo_BindVal bv; /* Check if boxed/unboxed expections are met. */ desired_native = param->flags & SIG_ELEM_NATIVE_VALUE; if (desired_native == 0 && orig_bv.type == BIND_VAL_OBJ || desired_native == SIG_ELEM_NATIVE_INT_VALUE && orig_bv.type == BIND_VAL_INT || desired_native == SIG_ELEM_NATIVE_NUM_VALUE && orig_bv.type == BIND_VAL_NUM || desired_native == SIG_ELEM_NATIVE_STR_VALUE && orig_bv.type == BIND_VAL_STR) { /* We have what we want. */ bv = orig_bv; } else if (desired_native == 0) { /* We need to do a boxing operation. */ bv.type = BIND_VAL_OBJ; bv.val.o = create_box(interp, orig_bv); } else { storage_spec spec; decont_value = Rakudo_cont_decontainerize(interp, orig_bv.val.o); spec = REPR(decont_value)->get_storage_spec(interp, STABLE(decont_value)); switch (desired_native) { case SIG_ELEM_NATIVE_INT_VALUE: if (spec.can_box & STORAGE_SPEC_CAN_BOX_INT) { bv.type = BIND_VAL_INT; bv.val.i = REPR(decont_value)->box_funcs->get_int(interp, STABLE(decont_value), OBJECT_BODY(decont_value)); } else { if (error) *error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native int", param->variable_name); return BIND_RESULT_FAIL; } break; case SIG_ELEM_NATIVE_NUM_VALUE: if (spec.can_box & STORAGE_SPEC_CAN_BOX_NUM) { bv.type = BIND_VAL_NUM; bv.val.n = REPR(decont_value)->box_funcs->get_num(interp, STABLE(decont_value), OBJECT_BODY(decont_value)); } else { if (error) *error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native num", param->variable_name); return BIND_RESULT_FAIL; } break; case SIG_ELEM_NATIVE_STR_VALUE: if (spec.can_box & STORAGE_SPEC_CAN_BOX_STR) { bv.type = BIND_VAL_STR; bv.val.s = REPR(decont_value)->box_funcs->get_str(interp, STABLE(decont_value), OBJECT_BODY(decont_value)); } else { if (error) *error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native str", param->variable_name); return BIND_RESULT_FAIL; } break; default: if (error) *error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native type", param->variable_name); return BIND_RESULT_FAIL; } decont_value = NULL; } /* By this point, we'll either have an object that we might be able to * bind if it passes the type check, or a native value that needs no * further checking. */ if (bv.type == BIND_VAL_OBJ) { /* Ensure the value is a 6model object; if not, marshall it to one. */ if (bv.val.o->vtable->base_type != smo_id) { bv.val.o = Rakudo_types_parrot_map(interp, bv.val.o); if (bv.val.o->vtable->base_type != smo_id) { *error = Parrot_sprintf_c(interp, "Unmarshallable foreign language value passed for parameter '%S'", param->variable_name); return BIND_RESULT_FAIL; } } /* We pretty much always need to de-containerized value, so get it * right off. */ decont_value = Rakudo_cont_decontainerize(interp, bv.val.o); /* Skip nominal type check if not needed. */ if (!no_nom_type_check) { PMC *nom_type; /* Is the nominal type generic and in need of instantiation? (This * can happen in (::T, T) where we didn't learn about the type until * during the signature bind). */ if (param->flags & SIG_ELEM_NOMINAL_GENERIC) { PMC *HOW = STABLE(param->nominal_type)->HOW; PMC *ig = VTABLE_find_method(interp, HOW, INSTANTIATE_GENERIC_str); Parrot_ext_call(interp, ig, "PiPP->P", HOW, param->nominal_type, lexpad, &nom_type); } else { nom_type = param->nominal_type; } /* If not, do the check. If the wanted nominal type is Mu, then * anything goes. */ if (nom_type != Rakudo_types_mu_get() && (decont_value->vtable->base_type != smo_id || !STABLE(decont_value)->type_check(interp, decont_value, nom_type))) { /* Type check failed; produce error if needed. */ if (error) { PMC * got_how = STABLE(decont_value)->HOW; PMC * exp_how = STABLE(nom_type)->HOW; PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str); PMC * exp_name_meth = VTABLE_find_method(interp, exp_how, NAME_str); STRING * expected, * got; Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, bv.val.o, &got); Parrot_ext_call(interp, exp_name_meth, "PiP->S", exp_how, nom_type, &expected); *error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead", param->variable_name, expected, got); } /* Report junction failure mode if it's a junction. */ return junc_or_fail(interp, decont_value); } /* Also enforce definedness constraints. */ if (param->flags & SIG_ELEM_DEFINEDNES_CHECK) { INTVAL defined = IS_CONCRETE(decont_value); if (defined && param->flags & SIG_ELEM_UNDEFINED_ONLY) { if (error) *error = Parrot_sprintf_c(interp, "Parameter '%S' requires a type object, but an object instance was passed", param->variable_name); return junc_or_fail(interp, decont_value); } if (!defined && param->flags & SIG_ELEM_DEFINED_ONLY) { if (error) *error = Parrot_sprintf_c(interp, "Parameter '%S' requires an instance, but a type object was passed", param->variable_name); return junc_or_fail(interp, decont_value); } } } } /* Do we have any type captures to bind? */ if (!PMC_IS_NULL(param->type_captures)) { Rakudo_binding_bind_type_captures(interp, lexpad, param, bv); } /* Do a coercion, if one is needed. */ if (!PMC_IS_NULL(param->coerce_type)) { /* Coercing natives not possible - nothing to call a method on. */ if (bv.type != BIND_VAL_OBJ) { *error = Parrot_sprintf_c(interp, "Unable to coerce natively typed parameter '%S'", param->variable_name); return BIND_RESULT_FAIL; } /* Only coerce if we don't already have the correct type. */ if (!STABLE(decont_value)->type_check(interp, decont_value, param->coerce_type)) { PMC *coerce_meth = VTABLE_find_method(interp, decont_value, param->coerce_method); if (!PMC_IS_NULL(coerce_meth)) { Parrot_ext_call(interp, coerce_meth, "Pi->P", decont_value, &decont_value); } else { /* No coercion method availale; whine and fail to bind. */ if (error) { PMC * got_how = STABLE(decont_value)->HOW; PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str); STRING * got; Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, decont_value, &got); *error = Parrot_sprintf_c(interp, "Unable to coerce value for '%S' from %S to %S; no coercion method defined", param->variable_name, got, param->coerce_method); } return BIND_RESULT_FAIL; } } } /* If it's not got attributive binding, we'll go about binding it into the * lex pad. */ if (!(param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) && !STRING_IS_NULL(param->variable_name)) { /* Is it native? If so, just go ahead and bind it. */ if (bv.type != BIND_VAL_OBJ) { switch (bv.type) { case BIND_VAL_INT: VTABLE_set_integer_keyed_str(interp, lexpad, param->variable_name, bv.val.i); break; case BIND_VAL_NUM: VTABLE_set_number_keyed_str(interp, lexpad, param->variable_name, bv.val.n); break; case BIND_VAL_STR: VTABLE_set_string_keyed_str(interp, lexpad, param->variable_name, bv.val.s); break; } } /* Otherwise it's some objecty case. */ else if (param->flags & SIG_ELEM_IS_RW) { /* XXX TODO Check if rw flag is set; also need to have a * wrapper container that carries extra constraints. */ VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o); } else if (param->flags & SIG_ELEM_IS_PARCEL) { /* Just bind the thing as is into the lexpad. */ VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o); } else { /* If it's an array, copy means make a new one and store, * and a normal bind is a straightforward binding plus * adding a constraint. */ if (param->flags & SIG_ELEM_ARRAY_SIGIL) { PMC *bindee = decont_value; if (param->flags & SIG_ELEM_IS_COPY) { bindee = Rakudo_binding_create_positional(interp, Parrot_pmc_new(interp, enum_class_ResizablePMCArray)); Rakudo_cont_store(interp, bindee, decont_value, 0, 0); } VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee); } /* If it's a hash, similar approach to array. */ else if (param->flags & SIG_ELEM_HASH_SIGIL) { PMC *bindee = decont_value; if (param->flags & SIG_ELEM_IS_COPY) { bindee = Rakudo_binding_create_hash(interp, Parrot_pmc_new(interp, enum_class_Hash)); Rakudo_cont_store(interp, bindee, decont_value, 0, 0); } VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee); } /* If it's a scalar, we always need to wrap it into a new * container and store it, for copy or ro case (the rw bit * in the container descriptor takes care of the rest). */ else { PMC *new_cont = Rakudo_cont_scalar_from_descriptor(interp, param->container_descriptor); Rakudo_cont_store(interp, new_cont, decont_value, 0, 0); VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, new_cont); } } } /* Is it the invocant? If so, also have to bind to self lexical. */ if (param->flags & SIG_ELEM_INVOCANT) VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, decont_value); /* Handle any constraint types (note that they may refer to the parameter by * name, so we need to have bound it already). */ if (!PMC_IS_NULL(param->post_constraints)) { PMC * code_type = Rakudo_types_code_get(); PMC * const constraints = param->post_constraints; INTVAL num_constraints = VTABLE_elements(interp, constraints); INTVAL i; for (i = 0; i < num_constraints; i++) { /* Check we meet the constraint. */ PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i); PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS); PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); PMC *cappy = Parrot_pmc_new(interp, enum_class_CallContext); if (STABLE(cons_type)->type_check(interp, cons_type, code_type)) Parrot_sub_capture_lex(interp, VTABLE_get_attr_keyed(interp, cons_type, code_type, DO_str)); VTABLE_push_pmc(interp, cappy, cons_type); switch (bv.type) { case BIND_VAL_OBJ: VTABLE_push_pmc(interp, cappy, bv.val.o); break; case BIND_VAL_INT: VTABLE_push_integer(interp, cappy, bv.val.i); break; case BIND_VAL_NUM: VTABLE_push_float(interp, cappy, bv.val.n); break; case BIND_VAL_STR: VTABLE_push_string(interp, cappy, bv.val.s); break; } Parrot_pcc_invoke_from_sig_object(interp, accepts_meth, cappy); cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)); Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx); if (!VTABLE_get_bool(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0))) { if (error) *error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'", param->variable_name); return BIND_RESULT_FAIL; } } } /* If it's attributive, now we assign it. */ if (param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) { INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, param, bv, decont_value, error); if (result != BIND_RESULT_OK) return result; } /* If it has a sub-signature, bind that. */ if (!PMC_IS_NULL(param->sub_llsig) && bv.type == BIND_VAL_OBJ) { /* Turn value into a capture, unless we already have one. */ PMC *capture = PMCNULL; INTVAL result; if (param->flags & SIG_ELEM_IS_CAPTURE) { capture = decont_value; } else { PMC *meth = VTABLE_find_method(interp, decont_value, Parrot_str_new(interp, "Capture", 0)); if (PMC_IS_NULL(meth)) { if (error) *error = Parrot_sprintf_c(interp, "Could not turn argument into capture"); return BIND_RESULT_FAIL; } Parrot_ext_call(interp, meth, "Pi->P", decont_value, &capture); } /* Recurse into signature binder. */ result = Rakudo_binding_bind(interp, lexpad, param->sub_llsig, capture, no_nom_type_check, error); if (result != BIND_RESULT_OK) { if (error) { /* Note in the error message that we're in a sub-signature. */ *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, " in sub-signature", 0)); /* Have we a variable name? */ if (!STRING_IS_NULL(param->variable_name)) { *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, " of parameter ", 0)); *error = Parrot_str_concat(interp, *error, param->variable_name); } } return result; } } /* Binding of this parameter was thus successful - we're done. */ return BIND_RESULT_OK; }
/* Takes a signature along with positional and named arguments and binds them * into the provided lexpad (actually, anything that has a Hash interface will * do). Returns BIND_RESULT_OK if binding works out, BIND_RESULT_FAIL if there * is a failure and BIND_RESULT_JUNCTION if the failure was because of a * Junction being passed (meaning we need to auto-thread). */ INTVAL Rakudo_binding_bind(PARROT_INTERP, PMC *lexpad, PMC *sig_pmc, PMC *capture, INTVAL no_nom_type_check, STRING **error) { INTVAL i, num_pos_args; INTVAL bind_fail = 0; INTVAL cur_pos_arg = 0; Rakudo_Signature *sig = (Rakudo_Signature *)PMC_data(sig_pmc); PMC *params = sig->params; INTVAL num_params = VTABLE_elements(interp, params); Rakudo_BindVal cur_bv; /* If we do have some named args, we want to make a clone of the hash * to work on. We'll delete stuff from it as we bind, and what we have * left over can become the slurpy hash or - if we aren't meant to be * taking one - tell us we have a problem. */ PMC *named_args_copy = PMCNULL; /* If we have a |$foo that's followed by slurpies, then we can suppress * any future arity checks. */ INTVAL suppress_arity_fail = 0; /* If it's a Parrot capture, it may contain natively typed arguments. * NOTE: This is a really an encapsulation breakage; if Parrot folks * change stuff and this breaks, it's not Parrot's fault. */ struct Pcc_cell * pc_positionals = NULL; /* Set up statics. */ if (!smo_id) setup_binder_statics(interp); /* If we've got a CallContext, just has an attribute with list of named * parameter names. Otherwise, it's probably a Perl 6 Capture and we need * to extract its parts. */ if (capture->vtable->base_type == enum_class_CallContext) { PMC *named_names = VTABLE_get_attr_str(interp, capture, NAMED_str); if (!PMC_IS_NULL(named_names)) { PMC *iter = VTABLE_get_iter(interp, named_names); named_args_copy = Parrot_pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args_copy, name, VTABLE_get_pmc_keyed_str(interp, capture, name)); } } GETATTR_CallContext_positionals(interp, capture, pc_positionals); } else if (capture->vtable->base_type == smo_id && STABLE(capture)->type_check(interp, capture, Rakudo_types_capture_get())) { PMC *captype = Rakudo_types_capture_get(); PMC *list_part = VTABLE_get_attr_keyed(interp, capture, captype, LIST_str); PMC *hash_part = VTABLE_get_attr_keyed(interp, capture, captype, HASH_str); capture = Rakudo_isnqplist(list_part) ? list_part : Parrot_pmc_new(interp, enum_class_ResizablePMCArray); if (hash_part->vtable->base_type == enum_class_Hash) { PMC *iter = VTABLE_get_iter(interp, hash_part); named_args_copy = Parrot_pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *arg_copy_name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args_copy, arg_copy_name, VTABLE_get_pmc_keyed_str(interp, hash_part, arg_copy_name)); } } } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Internal Error: Rakudo_binding_bind passed invalid Capture"); } /* Now we'll walk through the signature and go about binding things. */ num_pos_args = VTABLE_elements(interp, capture); for (i = 0; i < num_params; i++) { Rakudo_Parameter *param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i)); /* Is it looking for us to bind a capture here? */ if (param->flags & SIG_ELEM_IS_CAPTURE) { /* Capture the arguments from this point forwards into a Capture. * Of course, if there's no variable name we can (cheaply) do pretty * much nothing. */ if (STRING_IS_NULL(param->variable_name)) { bind_fail = BIND_RESULT_OK; } else { PMC *captype = Rakudo_types_capture_get(); PMC *capsnap = REPR(captype)->allocate(interp, STABLE(captype)); PMC *pos_args = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); PMC *named_args = Parrot_pmc_new(interp, enum_class_Hash); INTVAL k; VTABLE_set_attr_keyed(interp, capsnap, captype, LIST_str, pos_args); VTABLE_set_attr_keyed(interp, capsnap, captype, HASH_str, named_args); for (k = cur_pos_arg; k < num_pos_args; k++) { cur_bv = get_positional_bind_val(interp, pc_positionals, capture, k); VTABLE_push_pmc(interp, pos_args, cur_bv.type == BIND_VAL_OBJ ? cur_bv.val.o : create_box(interp, cur_bv)); } if (!PMC_IS_NULL(named_args_copy)) { PMC *iter = VTABLE_get_iter(interp, named_args_copy); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args, name, VTABLE_get_pmc_keyed_str(interp, named_args_copy, name)); } } cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = capsnap; bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); } if (bind_fail) { return bind_fail; } else if (i + 1 == num_params) { /* Since a capture acts as "the ultimate slurpy" in a sense, if * this is the last parameter in the signature we can return * success right off the bat. */ return BIND_RESULT_OK; } else { Rakudo_Parameter *next_param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i + 1)); if (next_param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_NAMED)) suppress_arity_fail = 1; } } /* Could it be a named slurpy? */ else if (param->flags & SIG_ELEM_SLURPY_NAMED) { /* Can cheat a bit if it's the default method %_. * We give the hash to the lexpad. */ if (param->flags & SIG_ELEM_METHOD_SLURPY_NAMED && lexpad->vtable->base_type == p6l_id) { SETATTR_Perl6LexPad_default_named_slurpy(interp, lexpad, named_args_copy); PARROT_GC_WRITE_BARRIER(interp, lexpad); } else { /* We'll either take the current named arguments copy hash which * will by definition contain all unbound named parameters and use * that, or just create an empty one. */ PMC *slurpy = PMC_IS_NULL(named_args_copy) ? Parrot_pmc_new(interp, enum_class_Hash) : named_args_copy; cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_create_hash(interp, slurpy); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; } /* Nullify named arguments hash now we've consumed it, to mark all * is well. */ named_args_copy = PMCNULL; } /* Otherwise, maybe it's a positional. */ else if (PMC_IS_NULL(param->named_names)) { /* Slurpy or LoL-slurpy? */ if (param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_LOL)) { /* Create Perl 6 array, create RPA of all remaining things, then * store it. */ PMC *temp = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); while (cur_pos_arg < num_pos_args) { cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg); VTABLE_push_pmc(interp, temp, cur_bv.type == BIND_VAL_OBJ ? cur_bv.val.o : create_box(interp, cur_bv)); cur_pos_arg++; } cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = param->flags & SIG_ELEM_SLURPY_POS ? Rakudo_binding_create_positional(interp, temp) : Rakudo_binding_create_lol(interp, temp); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; } /* Otherwise, a positional. */ else { /* Do we have a value?. */ if (cur_pos_arg < num_pos_args) { /* Easy - just bind that. */ cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; cur_pos_arg++; } else { /* No value. If it's optional, fetch a default and bind that; * if not, we're screwed. Note that we never nominal type check * an optional with no value passed. */ if (param->flags & SIG_ELEM_IS_OPTIONAL) { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); if (bind_fail) return bind_fail; } else { if (error) *error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 0); return BIND_RESULT_FAIL; } } } } /* Else, it's a non-slurpy named. */ else { /* Try and get hold of value. */ PMC *value = PMCNULL; INTVAL num_names = VTABLE_elements(interp, param->named_names); INTVAL j; if (!PMC_IS_NULL(named_args_copy)) { for (j = 0; j < num_names; j++) { STRING *name = VTABLE_get_string_keyed_int(interp, param->named_names, j); value = VTABLE_get_pmc_keyed_str(interp, named_args_copy, name); if (!PMC_IS_NULL(value)) { /* Found a value. Delete entry from to-bind args and stop looking. */ VTABLE_delete_keyed_str(interp, named_args_copy, name); break; } } } /* Did we get one? */ if (PMC_IS_NULL(value)) { /* Nope. We'd better hope this param was optional... */ if (param->flags & SIG_ELEM_IS_OPTIONAL) { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); } else if (!suppress_arity_fail) { if (error) *error = Parrot_sprintf_c(interp, "Required named parameter '%S' not passed", VTABLE_get_string_keyed_int(interp, param->named_names, 0)); return BIND_RESULT_FAIL; } } else { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = value; bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); } /* If we got a binding failure, return it. */ if (bind_fail) return bind_fail; } } /* Do we have any left-over args? */ if (cur_pos_arg < num_pos_args && !suppress_arity_fail) { /* Oh noes, too many positionals passed. */ if (error) *error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 1); return BIND_RESULT_FAIL; } if (!PMC_IS_NULL(named_args_copy) && VTABLE_elements(interp, named_args_copy)) { /* Oh noes, unexpected named args. */ if (error) { INTVAL num_extra = VTABLE_elements(interp, named_args_copy); PMC *iter = VTABLE_get_iter(interp, named_args_copy); if (num_extra == 1) { *error = Parrot_sprintf_c(interp, "Unexpected named parameter '%S' passed", VTABLE_shift_string(interp, iter)); } else { INTVAL first = 1; STRING *comma = Parrot_str_new(interp, ", ", 0); *error = Parrot_sprintf_c(interp, "%d unexpected named parameters passed (", num_extra); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); if (!first) *error = Parrot_str_concat(interp, *error, comma); else first = 0; *error = Parrot_str_concat(interp, *error, name); } *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, ")", 0)); } } return BIND_RESULT_FAIL; } /* If we get here, we're done. */ return BIND_RESULT_OK; }