示例#1
0
/*

=item C<static STRING* dump_signature(PARROT_INTERP, STRING *so_far, PMC *sub)>

Utility for getting hold of the signature dump for a sub, which aids us in
producing awesomer errors.

=cut

*/
static STRING* dump_signature(PARROT_INTERP, STRING *so_far, PMC *sub) {
    STRING * const sig_name  = Parrot_str_new(interp, "signature", 0);
    STRING * const perl_name = Parrot_str_new(interp, "perl", 0);
    STRING * const newline   = Parrot_str_new(interp, "\n", 0);
    PMC    * sig_meth, *sig_obj, *perl_meth, * sig_perl;
    sig_meth = VTABLE_find_method(interp, sub, sig_name);
    Parrot_ext_call(interp, sig_meth, "Pi->P", sub, &sig_obj);
    perl_meth = VTABLE_find_method(interp, sig_obj, perl_name);
    Parrot_ext_call(interp, perl_meth, "Pi->P", sig_obj, &sig_perl);
    so_far = Parrot_str_concat(interp, so_far,
        REPR(sig_perl)->box_funcs->get_str(interp, STABLE(sig_perl), OBJECT_BODY(sig_perl)));
    so_far = Parrot_str_concat(interp, so_far, newline);
    return so_far;
}
示例#2
0
文件: CStr.c 项目: Arcterus/nqp
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);
}
示例#3
0
/* Creates a Perl 6 Hash. */
static PMC *
Rakudo_binding_create_hash(PARROT_INTERP, PMC *storage) {
    PMC *result = PMCNULL;
    PMC *create = PMCNULL;

    if (!HashPunned) {
        /* We cache the punned Hash role class so we can very quickly call
         * CREATE - critical as we have slurpy hashes for all methods. */
        PMC *root_ns   = Parrot_get_ctx_HLL_namespace(interp);
        PMC *hash_role = VTABLE_get_pmc_keyed_str(interp, root_ns, HASH_str);
        PMC *meth      = VTABLE_find_method(interp, hash_role, SELECT_str);
        Parrot_ext_call(interp, meth, "P->P", hash_role, &hash_role);
        meth           = VTABLE_find_method(interp, hash_role, PUN_str);
        Parrot_ext_call(interp, meth, "P->P", hash_role, &HashPunned);
    }

    create = VTABLE_find_method(interp, HashPunned, CREATE_str);
    Parrot_ext_call(interp, create, "P->P", HashPunned, &result);
    VTABLE_set_attr_str(interp, result, STORAGE_str, storage);

    return result;
}
示例#4
0
文件: bind.c 项目: gitpan/Rakudo-Star
/* Assigns an attributive parameter to the desired attribute. */
static INTVAL
Rakudo_binding_assign_attributive(PARROT_INTERP, PMC *lexpad, Rakudo_Parameter *param,
                                  Rakudo_BindVal value, PMC *decont_value, STRING **error) {
    PMC *assignee = PMCNULL;
    PMC *assigner;

    /* Find self. */
    PMC *self = VTABLE_get_pmc_keyed_str(interp, lexpad,
            Parrot_str_new(interp, "self", 0));
    if (PMC_IS_NULL(self)) {
        if (error)
            *error = Parrot_sprintf_c(interp,
                    "Unable to bind attributive parameter '%S' - could not find self",
                    param->variable_name);
        return BIND_RESULT_FAIL;
    }
    
    /* Ensure it's not native; NYI. */
    if (value.type != BIND_VAL_OBJ) {
        *error = Parrot_sprintf_c(interp,
            "Binding to natively typed attributive parameter '%S' not supported",
            param->variable_name);
        return BIND_RESULT_FAIL;
    }

    /* If it's private, just need to fetch the attribute. */
    if (param->flags & SIG_ELEM_BIND_PRIVATE_ATTR) {
        assignee = VTABLE_get_attr_keyed(interp, self, param->attr_package,
            param->variable_name);
    }

    /* Otherwise if it's public, do a method call to get the assignee. */
    else {
        PMC *meth = VTABLE_find_method(interp, self, param->variable_name);
        if (PMC_IS_NULL(meth)) {
            if (error)
                *error = Parrot_sprintf_c(interp,
                        "Unable to bind attributive parameter '$.%S' - could not find method '%S'",
                        param->variable_name,
                        param->variable_name);
            return BIND_RESULT_FAIL;
        }
        Parrot_ext_call(interp, meth, "Pi->P", self, &assignee);
    }

    Rakudo_cont_store(interp, assignee, decont_value, 1, 1);
    return BIND_RESULT_OK;
}
示例#5
0
/* Binds any type captures a variable has. */
static void
Rakudo_binding_bind_type_captures(PARROT_INTERP, PMC *lexpad, llsig_element *sig_info, PMC *value) {
    /* Obtain type object. */
    PMC    * meta_obj = PMCNULL;
    PMC    * type_obj = PMCNULL;
    PMC    * iter;
    STRING * const HOW      = Parrot_str_new(interp, "HOW", 0);
    PMC    * const how_meth = VTABLE_find_method(interp, value, HOW);
    Parrot_ext_call(interp, how_meth, "Pi->P", value, &meta_obj);
    type_obj = VTABLE_get_attr_str(interp, meta_obj, Parrot_str_new(interp, "protoobject", 0));

    /* Iterate over symbols we need to bind this to, and bind 'em. */
    iter = VTABLE_get_iter(interp, sig_info->type_captures);
    while (VTABLE_get_bool(interp, iter)) {
        STRING *name = VTABLE_shift_string(interp, iter);
        VTABLE_set_pmc_keyed_str(interp, lexpad, name, type_obj);
    }
}
示例#6
0
/* Assigns an attributive parameter to the desired attribute. */
static INTVAL
Rakudo_binding_assign_attributive(PARROT_INTERP, PMC *lexpad, llsig_element *sig_info,
                                  PMC *value, STRING **error) {
    PMC *assignee = PMCNULL;
    PMC *assigner;

    /* Find self. */
    PMC *self = VTABLE_get_pmc_keyed_str(interp, lexpad,
            Parrot_str_new(interp, "self", 0));
    if (PMC_IS_NULL(self)) {
        if (error)
            *error = Parrot_sprintf_c(interp,
                    "Unable to bind attributive parameter '%S' - could not find self",
                    sig_info->variable_name);
        return BIND_RESULT_FAIL;
    }

    /* If it's private, just need to fetch the attribute. */
    if (sig_info->flags & SIG_ELEM_BIND_PRIVATE_ATTR) {
        assignee = VTABLE_get_attr_str(interp, self, sig_info->variable_name);
    }

    /* Otherwise if it's public, do a method call to get the assignee. */
    else {
        PMC *meth = VTABLE_find_method(interp, self, sig_info->variable_name);
        if (PMC_IS_NULL(meth)) {
            if (error)
                *error = Parrot_sprintf_c(interp,
                        "Unable to bind attributive parameter '$.%S' - could not find method '%S'",
                        sig_info->variable_name,
                        sig_info->variable_name);
            return BIND_RESULT_FAIL;
        }
        Parrot_ext_call(interp, meth, "Pi->P", self, &assignee);
    }

    /* Now look up infix:<=> and do the assignment. */
    assigner = VTABLE_get_pmc_keyed_str(interp, Parrot_get_ctx_HLL_namespace(interp),
            Parrot_str_new(interp, "!only_infix:=", 0));
    Parrot_ext_call(interp, assigner, "PP", assignee, value);

    return BIND_RESULT_OK;
}
示例#7
0
文件: pcc.c 项目: biddyweb/parrot
PARROT_EXPORT
void
Parrot_pcc_invoke_method_from_c_args(PARROT_INTERP, ARGIN(PMC* pmc),
        ARGMOD(STRING *method_name),
        ARGIN(const char *signature), ...)
{
    ASSERT_ARGS(Parrot_pcc_invoke_method_from_c_args)
    PMC        *call_obj;
    PMC        *sub_obj;
    va_list     args;
    const char *arg_sig, *ret_sig;
    PMC        *arg_flags;
    PMC        * const old_call_obj =
        Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));

    Parrot_pcc_split_signature_string(signature, &arg_sig, &ret_sig);

    va_start(args, signature);
    call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args);

    /* inlined version of pcc_add_invocant */
    arg_flags = PARROT_CALLCONTEXT(call_obj)->arg_flags;
    VTABLE_unshift_integer(interp, arg_flags, PARROT_ARG_PMC | PARROT_ARG_INVOCANT);
    Parrot_CallContext_unshift_pmc(interp, call_obj, pmc);

    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_obj);

    /* Find the subroutine object as a named method on pmc */
    sub_obj = VTABLE_find_method(interp, pmc, method_name);

    if (UNLIKELY(PMC_IS_NULL(sub_obj)))
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
            "Method '%Ss' not found", method_name);

    /* Invoke the subroutine object with the given CallContext object */
    Parrot_pcc_invoke_from_sig_object(interp, sub_obj, call_obj);
    call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
    Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
            PARROT_ERRORS_RESULT_COUNT_FLAG);
    va_end(args);
    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_call_obj);
}
示例#8
0
文件: P6opaque.c 项目: fgomezrdz/nqp
/* 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);
}
示例#9
0
文件: CStr.c 项目: Arcterus/nqp
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);
}
示例#10
0
文件: P6opaque.c 项目: fgomezrdz/nqp
/* 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);
}
示例#11
0
/* 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_llsig(PARROT_INTERP, PMC *lexpad, PMC *llsig,
                              PMC *capture, INTVAL no_nom_type_check,
                              STRING **error) {
    INTVAL        i;
    INTVAL        bind_fail;
    INTVAL        cur_pos_arg  = 0;
    INTVAL        num_pos_args = VTABLE_elements(interp, capture);
    PMC           *named_names = PMCNULL;
    llsig_element **elements;
    INTVAL        num_elements;
    PMC           *named_to_pos_cache;

    /* Lazily allocated array of bindings to positionals of nameds. */
    PMC **pos_from_named = NULL;

    /* 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;

    /* Check that we have a valid signature and pull the bits out of it. */
    if (!lls_id)
        setup_binder_statics(interp);

    if (llsig->vtable->base_type != lls_id)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                "Internal Error: Rakudo_binding_bind_llsig passed invalid signature");

    GETATTR_P6LowLevelSig_elements(interp, llsig, elements);
    GETATTR_P6LowLevelSig_num_elements(interp, llsig, num_elements);
    GETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache);

    /* Build nameds -> position hash for named positional arguments,
     * if it was not yet built. */
    if (PMC_IS_NULL(named_to_pos_cache)) {
        named_to_pos_cache = pmc_new(interp, enum_class_Hash);
        PARROT_GC_WRITE_BARRIER(interp, llsig);
        SETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache);
        for (i = 0; i < num_elements; i++) {
            /* If we find a named argument, we're done with the positionals. */
            if (!PMC_IS_NULL(elements[i]->named_names))
                break;

            /* Skip slurpies (may be a slurpy block, so can't just break). */
            if (elements[i]->flags & SIG_ELEM_SLURPY)
                continue;

            /* Provided it has a name... */
            if (!STRING_IS_NULL(elements[i]->variable_name)) {
                /* Strip any sigil, then stick in named to positional array. */
                STRING *store  = elements[i]->variable_name;
                STRING *sigil  = Parrot_str_substr(interp, store, 0, 1);
                STRING *twigil = Parrot_str_substr(interp, store, 1, 1);

                if (Parrot_str_equal(interp, sigil, SCALAR_SIGIL_str)
                ||  Parrot_str_equal(interp, sigil, ARRAY_SIGIL_str)
                ||  Parrot_str_equal(interp, sigil, HASH_SIGIL_str))
                    store = Parrot_str_substr(interp, store, 1,
                            Parrot_str_byte_length(interp, store));

                if (Parrot_str_equal(interp, twigil, BANG_TWIGIL_str))
                    store = Parrot_str_substr(interp, store, 1,
                            Parrot_str_byte_length(interp, store));

                VTABLE_set_integer_keyed_str(interp, named_to_pos_cache, store, i);
            }
        }
    }

    /* If we've got a CallContext, just has an attribute with list of named
     * parameter names. Otherwise, it's a Capture and we need to do .hash and
     * grab out the keys. */
    if (capture->vtable->base_type == enum_class_CallContext
    ||  VTABLE_isa(interp, capture, CALLCONTEXT_str)) {
        named_names = VTABLE_get_attr_str(interp, capture, Parrot_str_new(interp, "named", 0));
    }
    else if (VTABLE_isa(interp, capture, CAPTURE_str)) {
        PMC *meth = VTABLE_find_method(interp, capture, Parrot_str_new(interp, "!PARROT_NAMEDS", 0));
        PMC *hash = PMCNULL;
        PMC *iter;
        Parrot_ext_call(interp, meth, "Pi->P", capture, &hash);
        iter = VTABLE_get_iter(interp, hash);
        if (VTABLE_get_bool(interp, iter)) {
            named_names = pmc_new(interp, enum_class_ResizableStringArray);
            while (VTABLE_get_bool(interp, iter))
                VTABLE_push_string(interp, named_names, VTABLE_shift_string(interp, iter));
        }
    }
    else {
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                "Internal Error: Rakudo_binding_bind_llsig passed invalid Capture");
    }

    /* First, consider named arguments, to see if there are any that we will
     * be wanting to bind positionally. */
    if (!PMC_IS_NULL(named_names)) {
        PMC *iter = VTABLE_get_iter(interp, named_names);
        named_args_copy = pmc_new(interp, enum_class_Hash);
        while (VTABLE_get_bool(interp, iter)) {
            STRING *name = VTABLE_shift_string(interp, iter);
            if (VTABLE_exists_keyed_str(interp, named_to_pos_cache, name)) {
                /* Found one. We'll stash it away for quick access to bind it
                 * later. */
                INTVAL pos = VTABLE_get_integer_keyed_str(interp, named_to_pos_cache, name);
                if (!pos_from_named)
                    pos_from_named = mem_allocate_n_zeroed_typed(num_elements, PMC *);
                pos_from_named[pos] = VTABLE_get_pmc_keyed_str(interp, capture, name);
            }
            else {
                /* Otherwise, we'll enter it into the hash of things to bind
                 * to nameds. */
                VTABLE_set_pmc_keyed_str(interp, named_args_copy, name,
                        VTABLE_get_pmc_keyed_str(interp, capture, name));
            }
        }
示例#12
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;
}
示例#13
0
文件: bind.c 项目: gitpan/Rakudo-Star
/* 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;
}