예제 #1
0
/* 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;
}
예제 #2
0
파일: embed.c 프로젝트: gitpan/ponie
static void
setup_argv(struct Parrot_Interp *interpreter, int argc, char ** argv)
{
    INTVAL i;
    PMC *userargv;

    if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
        PIO_eprintf(interpreter,
                "*** Parrot VM: Setting up ARGV array in P5.  Current argc: %d ***\n",
                argc);
    }

    userargv = pmc_new_noinit(interpreter, enum_class_SArray);
    /* immediately anchor pmc to root set */
    interpreter->pmc_reg.registers[5] = userargv;
    VTABLE_set_pmc_keyed_int(interpreter, interpreter->iglobals,
            (INTVAL)IGLOBALS_ARGV_LIST, userargv);
    VTABLE_init(interpreter, userargv);
    VTABLE_set_integer_native(interpreter, userargv, argc);

    for (i = 0; i < argc; i++) {
        /* Run through argv, adding everything to @ARGS. */
        STRING *arg = string_make(interpreter, argv[i], strlen(argv[i]),
                                  0, PObj_external_FLAG, 0);

        if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
            PIO_eprintf(interpreter, "\t%vd: %s\n", i, argv[i]);
        }

        VTABLE_push_string(interpreter, userargv, arg);
    }
}
예제 #3
0
파일: bind.c 프로젝트: LittleForker/rakudo
/* 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));
            }
        }
예제 #4
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;
}
예제 #5
0
파일: library.c 프로젝트: ashgti/parrot
void
parrot_init_library_paths(PARROT_INTERP)
{
    ASSERT_ARGS(parrot_init_library_paths)
    PMC    *paths;
    STRING *entry;
    STRING *versionlib      = NULL;
    STRING *builddir        = NULL;
    PMC * const iglobals    = interp->iglobals;
    PMC * const config_hash = VTABLE_get_pmc_keyed_int(interp, iglobals,
                                (INTVAL)IGLOBALS_CONFIG_HASH);

    /* create the lib_paths array */
    PMC * const lib_paths   = Parrot_pmc_new_init_int(interp,
            enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
    VTABLE_set_pmc_keyed_int(interp, iglobals,
            IGLOBALS_LIB_PATHS, lib_paths);

    if (VTABLE_elements(interp, config_hash)) {
        STRING * const libkey      = CONST_STRING(interp, "libdir");
        STRING * const verkey      = CONST_STRING(interp, "versiondir");
        STRING * const builddirkey = CONST_STRING(interp, "build_dir");
        STRING * const installed   = CONST_STRING(interp, "installed");

        versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
        entry      = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
        versionlib = Parrot_str_concat(interp, versionlib, entry);

        if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
            builddir = VTABLE_get_string_keyed_str(interp,
                                config_hash, builddirkey);
    }

    /* each is an array of strings */
    /* define include paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_INCLUDE, paths);
    { /* EXPERIMENTAL: add include path from environment */
        const char *envvar = Parrot_getenv(interp,
                                           Parrot_str_new_constant(interp, "PARROT_INCLUDE"));
        if (envvar != NULL  && envvar[0]) {
            entry = Parrot_str_new(interp, envvar, 0);
            VTABLE_push_string(interp, paths, entry);
        }
    }
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
        VTABLE_push_string(interp, paths, entry);
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
        VTABLE_push_string(interp, paths, entry);
    }
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
        VTABLE_push_string(interp, paths, entry);
    }

    /* define library paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_LIBRARY, paths);
    { /* EXPERIMENTAL: add library path from environment */
        const char *envvar = Parrot_getenv(interp,
                                           Parrot_str_new_constant(interp, "PARROT_LIBRARY"));
        if (envvar != NULL && envvar[0]) {
            entry = Parrot_str_new(interp, envvar, 0);
            VTABLE_push_string(interp, paths, entry);
        }
    }
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
        VTABLE_push_string(interp, paths, entry);
    }
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
        VTABLE_push_string(interp, paths, entry);
    }

    /* define languages paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_LANG, paths);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
        VTABLE_push_string(interp, paths, entry);
    }
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
        VTABLE_push_string(interp, paths, entry);
    }

    /* define dynext paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_DYNEXT, paths);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
        VTABLE_push_string(interp, paths, entry);
    }
    entry = CONST_STRING(interp, "dynext/");
    VTABLE_push_string(interp, paths, entry);
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
        VTABLE_push_string(interp, paths, entry);
    }

    /* shared exts */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_DYN_EXTS, paths);
    /* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
    entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
    VTABLE_push_string(interp, paths, entry);
    /* OS/X has .dylib and .bundle */
    if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
        entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
        VTABLE_push_string(interp, paths, entry);
    }

#ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
    PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
#endif
}
예제 #6
0
파일: library.c 프로젝트: atrodo/parrot
PARROT_EXPORT
void
Parrot_lib_update_paths_from_config_hash(PARROT_INTERP)
{
    ASSERT_ARGS(Parrot_lib_update_paths_from_config_hash)
    STRING * versionlib = NULL;
    STRING * entry = NULL;
    STRING * builddir = NULL;
    PMC * const lib_paths =
        VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_LIB_PATHS);
    PMC * const config_hash =
        VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_CONFIG_HASH);
    PMC * paths;

    if (VTABLE_elements(interp, config_hash)) {
        STRING * const libkey      = CONST_STRING(interp, "libdir");
        STRING * const verkey      = CONST_STRING(interp, "versiondir");
        STRING * const builddirkey = CONST_STRING(interp, "build_dir");
        STRING * const installed   = CONST_STRING(interp, "installed");

        versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
        entry      = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
        versionlib = Parrot_str_concat(interp, versionlib, entry);

        if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
            builddir = VTABLE_get_string_keyed_str(interp,
                                config_hash, builddirkey);
    }

    paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_INCLUDE);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
        VTABLE_push_string(interp, paths, entry);
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
        VTABLE_push_string(interp, paths, entry);
    }
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
        VTABLE_push_string(interp, paths, entry);
    }

    paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_LIBRARY);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
        VTABLE_push_string(interp, paths, entry);
    }
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
        VTABLE_push_string(interp, paths, entry);
    }

    paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_LANG);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
        VTABLE_push_string(interp, paths, entry);
    }
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
        VTABLE_push_string(interp, paths, entry);
    }

    paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_DYNEXT);
    if (!STRING_IS_NULL(builddir)) {
        entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
        VTABLE_push_string(interp, paths, entry);
    }
    if (!STRING_IS_NULL(versionlib)) {
        entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
        VTABLE_push_string(interp, paths, entry);
    }
}
예제 #7
0
파일: library.c 프로젝트: atrodo/parrot
void
parrot_init_library_paths(PARROT_INTERP)
{
    ASSERT_ARGS(parrot_init_library_paths)
    PMC    *paths;
    STRING *entry;
    PMC * const iglobals    = interp->iglobals;

    /* create the lib_paths array */
    PMC * const lib_paths   = Parrot_pmc_new_init_int(interp,
            enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
    VTABLE_set_pmc_keyed_int(interp, iglobals,
            IGLOBALS_LIB_PATHS, lib_paths);

    /* each is an array of strings */
    /* define include paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_INCLUDE, paths);
    { /* EXPERIMENTAL: add include path from environment */
        STRING *envvar = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_INCLUDE"));
        Parrot_warn_experimental(interp, "PARROT_INCLUDE environment variable is experimental");
        if (!STRING_IS_NULL(envvar) && !STRING_IS_EMPTY(envvar))
            VTABLE_push_string(interp, paths, envvar);
    }
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);

    /* define library paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_LIBRARY, paths);
    { /* EXPERIMENTAL: add library path from environment */
        STRING *envvar = Parrot_getenv(interp, CONST_STRING(interp, "PARROT_LIBRARY"));
        Parrot_warn_experimental(interp, "PARROT_LIBRARY environment variable is experimental");
        if (!STRING_IS_NULL(envvar) && !STRING_IS_EMPTY(envvar))
            VTABLE_push_string(interp, paths, envvar);
    }
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);

    /* define languages paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_LANG, paths);
    entry = CONST_STRING(interp, "./");
    VTABLE_push_string(interp, paths, entry);

    /* define dynext paths */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_PATH_DYNEXT, paths);
    entry = CONST_STRING(interp, "dynext/");
    VTABLE_push_string(interp, paths, entry);

    /* shared exts */
    paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
    VTABLE_set_pmc_keyed_int(interp, lib_paths,
            PARROT_LIB_DYN_EXTS, paths);
    /* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
    entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
    VTABLE_push_string(interp, paths, entry);
    /* OS/X has .dylib and .bundle */
    if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
        entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
        VTABLE_push_string(interp, paths, entry);
    }

#ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
    PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
#endif
}