/* 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");
RW_str = Parrot_str_new_constant(interp, "rw");
PUN_str = Parrot_str_new_constant(interp, "!pun");
PERL_str = Parrot_str_new_constant(interp, "perl");
HASH_str = Parrot_str_new_constant(interp, "Hash");
LIST_str = Parrot_str_new_constant(interp, "List");
SELF_str = Parrot_str_new_constant(interp, "self");
ARRAY_str = Parrot_str_new_constant(interp, "Array");
BLOCK_str = Parrot_str_new_constant(interp, "Block");
STORE_str = Parrot_str_new_constant(interp, "!STORE");
CREATE_str = Parrot_str_new_constant(interp, "CREATE");
SCALAR_str = Parrot_str_new_constant(interp, "scalar");
SELECT_str = Parrot_str_new_constant(interp, "!select");
CAPTURE_str = Parrot_str_new_constant(interp, "Capture");
SNAPCAP_str = Parrot_str_new_constant(interp, "!snapshot_capture");
STORAGE_str = Parrot_str_new_constant(interp, "$!storage");
JUNCTION_str = Parrot_str_new_constant(interp, "Junction");
P6_SCALAR_str = Parrot_str_new_constant(interp, "Perl6Scalar");
SHORTNAME_str = Parrot_str_new_constant(interp, "shortname");
HASH_SIGIL_str = Parrot_str_new_constant(interp, "%");
ARRAY_SIGIL_str = Parrot_str_new_constant(interp, "@");
BANG_TWIGIL_str = Parrot_str_new_constant(interp, "!");
CALLCONTEXT_str = Parrot_str_new_constant(interp, "CallContext");
SCALAR_SIGIL_str = Parrot_str_new_constant(interp, "$");
or_id = pmc_type(interp, Parrot_str_new(interp, "ObjectRef", 0));
lls_id = pmc_type(interp, Parrot_str_new(interp, "P6LowLevelSig", 0));
p6s_id = pmc_type(interp, P6_SCALAR_str);
p6r_id = pmc_type(interp, Parrot_str_new(interp, "P6role", 0));
p6o_id = pmc_type(interp, Parrot_str_new(interp, "P6opaque", 0));
}
/* Creates a Perl 6 Array. */
static PMC *
Rakudo_binding_create_positional(PARROT_INTERP, PMC *rest, STRING *type_str) {
static PMC *truepmc = NULL;
PMC *hll_ns = Parrot_get_ctx_HLL_namespace(interp);
PMC *arr_ns = Parrot_ns_get_namespace_keyed_str(interp, hll_ns, type_str);
PMC *arr_class = VTABLE_get_class(interp, arr_ns);
PMC *result = VTABLE_instantiate(interp, arr_class, PMCNULL);
INTVAL type_id = pmc_type(interp, Parrot_str_new(interp, "P6opaque", 0));
result->vtable = interp->vtables[type_id];
if (!truepmc)
truepmc = VTABLE_get_pmc_keyed_str(interp, hll_ns, Parrot_str_new(interp, "True", 0));
VTABLE_set_attr_str(interp, result, Parrot_str_new(interp, "$!flat", 0), truepmc);
VTABLE_set_attr_str(interp, result, Parrot_str_new(interp, "@!rest", 0), rest);
return result;
}
/* 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 = pmc_type(interp, Parrot_str_new(interp, "SixModelObject", 0));
p6l_id = pmc_type(interp, Parrot_str_new(interp, "Perl6LexPad", 0));
}
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, pmc_type(interp,
string_from_literal(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;
}
/* 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, llsig_element *sig_info, PMC *lexpad) {
PMC *cur_lex;
/* Is the "get default from outer" flag set? */
if (sig_info->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, sig_info->variable_name);
}
/* Do we have a default value closure? */
else if (!PMC_IS_NULL(sig_info->default_closure)) {
/* Run it to get a value. */
PMC *result = PMCNULL;
Parrot_sub_capture_lex(interp, sig_info->default_closure);
Parrot_ext_call(interp, sig_info->default_closure, "->P", &result);
return result;
}
/* Did the value already get initialized to something? (We can avoid re-creating a
* PMC if so.) */
else if (!PMC_IS_NULL(cur_lex = VTABLE_get_pmc_keyed_str(interp, lexpad, sig_info->variable_name))) {
/* Yes; if $ sigil then we want to bind set value in it to be the
* type object of the default type. */
if (!(sig_info->flags & (SIG_ELEM_ARRAY_SIGIL | SIG_ELEM_HASH_SIGIL)))
VTABLE_set_pmc(interp, cur_lex, sig_info->nominal_type);
return cur_lex;
}
/* Otherwise, go by sigil to pick the correct default type of value. */
else {
if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) {
return Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str);
}
else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) {
return Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash));
}
else {
return pmc_new_init(interp, pmc_type(interp, P6_SCALAR_str),
sig_info->nominal_type);
}
}
}
