static INTVAL has_junctional_args(PARROT_INTERP, INTVAL num_args, struct Pcc_cell * pc_positionals) { INTVAL i; for (i = 0; i < num_args; i++) { if (pc_positionals[i].type == BIND_VAL_OBJ) { PMC * const arg = Rakudo_cont_decontainerize(interp, pc_positionals[i].u.p); if (STABLE(arg)->WHAT == Rakudo_types_junction_get()) return 1; } } return 0; }
/* Returns an appropriate failure mode (junction fail or normal fail). */ static INTVAL junc_or_fail(PARROT_INTERP, PMC *value) { if (value->vtable->base_type == smo_id && STABLE(value)->WHAT == Rakudo_types_junction_get()) return BIND_RESULT_JUNCTION; else return BIND_RESULT_FAIL; }
/* 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. */ PMC *box_type_obj = box_type(orig_bv); bv.type = BIND_VAL_OBJ; bv.val.o = REPR(box_type_obj)->instance_of(interp, box_type_obj); switch (orig_bv.type) { case BIND_VAL_INT: REPR(bv.val.o)->set_int(interp, bv.val.o, orig_bv.val.i); break; case BIND_VAL_NUM: REPR(bv.val.o)->set_num(interp, bv.val.o, orig_bv.val.n); break; case BIND_VAL_STR: REPR(bv.val.o)->set_str(interp, bv.val.o, orig_bv.val.s); break; } } else { storage_spec spec = REPR(orig_bv.val.o)->get_storage_spec(interp, STABLE(orig_bv.val.o)); 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(orig_bv.val.o)->get_int(interp, orig_bv.val.o); } 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(orig_bv.val.o)->get_num(interp, orig_bv.val.o); } 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(orig_bv.val.o)->get_str(interp, orig_bv.val.o); } 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; } } /* 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. */ if (decont_value->vtable->base_type == smo_id && STABLE(decont_value)->WHAT == Rakudo_types_junction_get()) return BIND_RESULT_JUNCTION; else return BIND_RESULT_FAIL; } /* Also enforce definedness constraints. */ if (param->flags & SIG_ELEM_DEFINEDNES_CHECK) { INTVAL defined = REPR(decont_value)->defined(interp, 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 BIND_RESULT_FAIL; } 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 BIND_RESULT_FAIL; } } } } /* 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, 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, 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; }