[gitmo/Mouse.git] / xs-src / MouseTypeConstraints.xs

/*
 *   full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints)
 */

#include "mouse.h"

#if PERL_BCDVERSION >= 0x5008005
#define LooksLikeNumber(sv) looks_like_number(sv)
#else
#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
#endif

#ifndef SvRXOK
#define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
#endif

typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv);

/*
    NOTE: mouse_tc_check() handles GETMAGIC
*/
int
mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
    CV* const cv = (CV*)SvRV(tc_code);
    assert(SvTYPE(cv) == SVt_PVCV);

    if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
        MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;

        assert(CvXSUBANY(cv).any_ptr != NULL);
        assert(mg->mg_ptr            != NULL);

        SvGETMAGIC(sv);
        /* call the check function directly, skipping call_sv() */
        return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
    }
    else { /* custom */
        int ok;
        dSP;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv);
        PUTBACK;

        call_sv(tc_code, G_SCALAR);

        SPAGAIN;
        ok = sv_true(POPs);
        PUTBACK;

        FREETMPS;
        LEAVE;

        return ok;
    }
}

/*
    The following type check functions return an integer, not a bool, to keep them simple,
    so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
*/

int
mouse_tc_Any(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv PERL_UNUSED_DECL) {
    assert(sv);
    return TRUE;
}

int
mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);

    if(sv_true(sv)){
        if(SvIOKp(sv)){
            return SvIVX(sv) == 1;
        }
        else if(SvNOKp(sv)){
            return SvNVX(sv) == 1.0;
        }
        else if(SvPOKp(sv)){ /* "1" */
            return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1';
        }
        else{
            return FALSE;
        }
    }
    else{
        /* any false value must be boolean */
        return TRUE;
    }
}

int
mouse_tc_Undef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return !SvOK(sv);
}

int
mouse_tc_Defined(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvOK(sv);
}

int
mouse_tc_Value(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvOK(sv) && !SvROK(sv);
}

int
mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return LooksLikeNumber(sv);
}

int
S_nv_is_integer(pTHX_ NV const nv) {
    if(nv == (NV)(IV)nv){
        return TRUE;
    }
    else {
        char buf[64];  /* Must fit sprintf/Gconvert of longest NV */
        char* p;
        Gconvert(nv, NV_DIG, 0, buf);
        p = &buf[0];

        /* -?[0-9]+ */
        if(*p == '-') p++;

        while(*p){
            if(!isDIGIT(*p)){
                return FALSE;
            }
            p++;
        }
        return TRUE;
    }
}

int
mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    if(SvIOKp(sv)){
        return TRUE;
    }
    else if(SvNOKp(sv)) {
        return S_nv_is_integer(aTHX_ SvNVX(sv));
    }
    else if(SvPOKp(sv)){
        int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
        if(num_type){
            return !(num_type & IS_NUMBER_NOT_INT);
        }
    }
    return FALSE;
}

int
mouse_tc_Str(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvOK(sv) && !SvROK(sv) && !isGV(sv);
}

int
mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){ 
    assert(sv);
    return is_class_loaded(sv);
}

int
mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    if(is_class_loaded(sv)){
        int ok;

        ENTER;
        SAVETMPS;

        ok =  is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv));

        FREETMPS;
        LEAVE;

        return ok;
    }
    return FALSE;
}

int
mouse_tc_Ref(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvROK(sv);
}

int
mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* sv) {
    assert(sv);
    if(SvROK(sv)){
         sv = SvRV(sv);
         return !SvOBJECT(sv) && (SvTYPE(sv) <= SVt_PVLV && !isGV(sv));
    }
    return FALSE;
}

int
mouse_tc_ArrayRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return IsArrayRef(sv);
}

int
mouse_tc_HashRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return IsHashRef(sv);
}

int
mouse_tc_CodeRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return IsCodeRef(sv);
}

int
mouse_tc_RegexpRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvRXOK(sv);
}

int
mouse_tc_GlobRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
}

int
mouse_tc_FileHandle(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    GV* gv;
    assert(sv);

    /* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */

    gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
    if(isGV(gv) || SvTYPE(gv) == SVt_PVIO){
        IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;

        if(io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
            return TRUE;
        }
    }

    return is_an_instance_of("IO::Handle", sv);
}

int
mouse_tc_Object(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
    assert(sv);
    return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
}

/* Parameterized type constraints */

static int
mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
    if(IsArrayRef(sv)){
        AV* const av  = (AV*)SvRV(sv);
        I32 const len = av_len(av) + 1;
        I32 i;
        for(i = 0; i < len; i++){
            SV* const value = *av_fetch(av, i, TRUE);
            if(!mouse_tc_check(aTHX_ param, value)){
                return FALSE;
            }
        }
        return TRUE;
    }
    return FALSE;
}

static int
mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
    if(mouse_tc_HashRef(aTHX_ NULL, sv)){
        HV* const hv  = (HV*)SvRV(sv);
        HE* he;

        hv_iterinit(hv);
        while((he = hv_iternext(hv))){
            SV* const value = hv_iterval(hv, he);
            if(!mouse_tc_check(aTHX_ param, value)){
                hv_iterinit(hv); /* reset */
                return FALSE;
            }
        }
        return TRUE;
    }
    return FALSE;
}

static int
mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
    if(SvOK(sv)){
        return mouse_tc_check(aTHX_ param, sv);
    }
    return TRUE;
}

static int
mouse_types_union_check(pTHX_ AV* const types, SV* const sv) {
    I32 const len = AvFILLp(types) + 1;
    I32 i;

    for(i = 0; i < len; i++){
        if(mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
            return TRUE;
        }
    }

    return FALSE;
}

static int
mouse_types_check(pTHX_ AV* const types, SV* const sv) {
    I32 const len = AvFILLp(types) + 1;
    I32 i;

    ENTER;
    SAVE_DEFSV;
    DEFSV_set(sv);

    for(i = 0; i < len; i++){
        if(!mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
            LEAVE;
            return FALSE;
        }
    }

    LEAVE;

    return TRUE;
}

/*
 *  This class_type generator is taken from Scalar::Util::Instance
 */

#define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
typedef struct sui_cxt{
    GV* universal_isa;
    GV* universal_can;
} my_cxt_t;
START_MY_CXT

#define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
#define MG_klass_pv(mg)    ((mg)->mg_ptr)
#define MG_klass_len(mg)   ((mg)->mg_len)

static const char*
mouse_canonicalize_package_name(const char* name){

    /* "::Foo" -> "Foo" */
    if(name[0] == ':' && name[1] == ':'){
        name += 2;
    }

    /* "main::main::main::Foo" -> "Foo" */
    while(strnEQ(name, "main::", sizeof("main::")-1)){
        name += sizeof("main::")-1;
    }

    return name;
}

static int
mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){
    AV*  const linearized_isa = mro_get_linear_isa(instance_stash);
    SV**       svp            = AvARRAY(linearized_isa);
    SV** const end            = svp + AvFILLp(linearized_isa) + 1;

    while(svp != end){
        assert(SvPVX(*svp));
        if(strEQ(klass_pv, mouse_canonicalize_package_name(SvPVX(*svp)))){
            return TRUE;
        }
        svp++;
    }
    return FALSE;
}

#define find_method_pvn(a, b, c) mouse_stash_find_method(aTHX_ a, b, c)
#define find_method_pvs(a, b)    mouse_stash_find_method(aTHX_ a, STR_WITH_LEN(b))

static inline GV*
mouse_stash_find_method(pTHX_ HV* const stash, const char* const name, I32 const namelen){
    GV** const gvp = (GV**)hv_fetch(stash, name, namelen, FALSE);
    if(gvp && isGV(*gvp) && GvCV(*gvp)){ /* shortcut */
        return *gvp;
    }

    return gv_fetchmeth_autoload(stash, name, namelen, 0);
}

int
mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
    assert(stash);
    assert(SvTYPE(stash) == SVt_PVHV);

    if(IsObject(instance)){
        dMY_CXT;
        HV* const instance_stash = SvSTASH(SvRV(instance));
        GV* const myisa          = find_method_pvs(instance_stash, "isa");

        /* the instance has no own isa method */
        if(myisa == NULL || GvCV(myisa) == GvCV(MY_CXT.universal_isa)){
            return stash == instance_stash
                || mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash));
        }
        /* the instance has its own isa method */
        else {
            SV* package;
            int ok;

            ENTER;
            SAVETMPS;

            package = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
            ok = sv_true(mcall1s(instance, "isa", sv_2mortal(package)));

            FREETMPS;
            LEAVE;

            return ok;
        }
    }
    return FALSE;
}

static int
mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
    PERL_UNUSED_ARG(data);
    return SvROK(sv) && SvOBJECT(SvRV(sv));
}

static int
mouse_can_methods(pTHX_ AV* const methods, SV* const instance){
    if(IsObject(instance)){
        dMY_CXT;
        HV* const mystash      = SvSTASH(SvRV(instance));
        GV* const mycan        = find_method_pvs(mystash, "can");
        bool const use_builtin = (mycan == NULL || GvCV(mycan) == GvCV(MY_CXT.universal_can)) ? TRUE : FALSE;
        I32 const len           = AvFILLp(methods) + 1;
        I32 i;
        for(i = 0; i < len; i++){
            SV* const name = MOUSE_av_at(methods, i);

            if(use_builtin){
                if(!find_method_pvn(mystash, SvPVX(name), SvCUR(name))){
                    return FALSE;
                }
            }
            else{
                bool ok;

                ENTER;
                SAVETMPS;

                ok = sv_true(mcall1s(instance, "can", sv_mortalcopy(name)));

                FREETMPS;
                LEAVE;

                if(!ok){
                    return FALSE;
                }
            }
        }
        return TRUE;
    }
    return FALSE;
}

static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */

static CV*
mouse_tc_generate(pTHX_ const char* const name, check_fptr_t const fptr, SV* const param) {
    CV* xsub;

    xsub = newXS(name, XS_Mouse_constraint_check, __FILE__);
    CvXSUBANY(xsub).any_ptr = sv_magicext(
        (SV*)xsub,
        param,       /* mg_obj: refcnt will be increased */
        PERL_MAGIC_ext,
        &mouse_util_type_constraints_vtbl,
        (char*)fptr, /* mg_ptr */
        0            /* mg_len: 0 for static data */
    );

    if(!name){
        sv_2mortal((SV*)xsub);
    }

    return xsub;
}

CV*
mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
    STRLEN klass_len;
    const char* klass_pv = SvPV_const(klass, klass_len);
    SV*   param;
    check_fptr_t fptr;

    klass_pv = mouse_canonicalize_package_name(klass_pv);

    if(strNE(klass_pv, "UNIVERSAL")){
        param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
        fptr = (check_fptr_t)mouse_is_an_instance_of;

    }
    else{
        param = NULL;
        fptr = (check_fptr_t)mouse_is_an_instance_of_universal;
    }

    return mouse_tc_generate(aTHX_ predicate_name, fptr, param);
}

CV*
mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const predicate_name){
    AV* av;
    AV* const param = newAV_mortal();
    I32 len;
    I32 i;

    must_ref(methods, "an ARRAY ref for method names", SVt_PVAV);
    av = (AV*)SvRV(methods);

    len = av_len(av) + 1;
    for(i = 0; i < len; i++){
        SV* const name = *av_fetch(av, i, TRUE);
        STRLEN pvlen;
        const char* const pv = SvPV_const(name, pvlen);

        av_push(param, newSVpvn_share(pv, pvlen, 0U));
    }

    return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param);
}


XS(XS_Mouse_constraint_check) {
    dVAR;
    dXSARGS;
    MAGIC* const mg = (MAGIC*)XSANY.any_ptr;

    if(items < 1){
        croak("Too few arguments for type constraint check functions");
    }

    SvGETMAGIC( ST(0) );
    ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, ST(0)) );
    XSRETURN(1);
}

static void
setup_my_cxt(pTHX_ pMY_CXT){
    MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV);
    SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa);

    MY_CXT.universal_can = gv_fetchpvs("UNIVERSAL::can", GV_ADD, SVt_PVCV);
    SvREFCNT_inc_simple_void_NN(MY_CXT.universal_can);
}

#define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL)

MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Util::TypeConstraints

PROTOTYPES:   DISABLE
VERSIONCHECK: DISABLE

BOOT:
{
    MY_CXT_INIT;
    setup_my_cxt(aTHX_ aMY_CXT);

    /* setup built-in type constraints */
    DEFINE_TC(Any);
    DEFINE_TC(Undef);
    DEFINE_TC(Defined);
    DEFINE_TC(Bool);
    DEFINE_TC(Value);
    DEFINE_TC(Ref);
    DEFINE_TC(Str);
    DEFINE_TC(Num);
    DEFINE_TC(Int);
    DEFINE_TC(ScalarRef);
    DEFINE_TC(ArrayRef);
    DEFINE_TC(HashRef);
    DEFINE_TC(CodeRef);
    DEFINE_TC(GlobRef);
    DEFINE_TC(FileHandle);
    DEFINE_TC(RegexpRef);
    DEFINE_TC(Object);
    DEFINE_TC(ClassName);
    DEFINE_TC(RoleName);
}

#ifdef USE_ITHREADS

void
CLONE(...)
CODE:
{
    MY_CXT_CLONE;
    setup_my_cxt(aTHX_ aMY_CXT);
    PERL_UNUSED_VAR(items);
}

#endif /* !USE_ITHREADS */

#define MOUSE_TC_MAYBE     0
#define MOUSE_TC_ARRAY_REF 1
#define MOUSE_TC_HASH_REF  2

CV*
_parameterize_ArrayRef_for(SV* param)
ALIAS:
    _parameterize_ArrayRef_for = MOUSE_TC_ARRAY_REF
    _parameterize_HashRef_for  = MOUSE_TC_HASH_REF
    _parameterize_Maybe_for    = MOUSE_TC_MAYBE
CODE:
{
    check_fptr_t fptr;
    SV* const tc_code = mcall0s(param, "_compiled_type_constraint");
    if(!IsCodeRef(tc_code)){
        croak("_compiled_type_constraint didn't return a CODE reference");
    }

    switch(ix){
    case MOUSE_TC_ARRAY_REF:
        fptr = mouse_parameterized_ArrayRef;
        break;
    case MOUSE_TC_HASH_REF:
        fptr = mouse_parameterized_HashRef;
        break;
    default: /* Maybe type */
        fptr = mouse_parameterized_Maybe;
    }
    RETVAL = mouse_tc_generate(aTHX_ NULL, fptr, tc_code);
}
OUTPUT:
    RETVAL

MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Meta::TypeConstraint

BOOT:
    INSTALL_SIMPLE_READER(TypeConstraint, name);
    INSTALL_SIMPLE_READER(TypeConstraint, parent);
    INSTALL_SIMPLE_READER(TypeConstraint, message);

    INSTALL_SIMPLE_READER(TypeConstraint, type_parameter);

    INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint);
    INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */

    INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
    INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */

void
compile_type_constraint(SV* self)
CODE:
{
    AV* const checks = newAV_mortal();
    SV* check; /* check function */
    SV* parent;
    SV* types_ref;

    for(parent = get_slots(self, "parent"); parent; parent = get_slots(parent, "parent")){
        check = get_slots(parent, "hand_optimized_type_constraint");
        if(check && SvOK(check)){
            if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
                croak("Not a CODE reference");
            }
            av_unshift(checks, 1);
            av_store(checks, 0, newSVsv(check));
            break; /* a hand optimized constraint must include all the parent */
        }

        check = get_slots(parent, "constraint");
        if(check && SvOK(check)){
            if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
                croak("Not a CODE reference");
            }
            av_unshift(checks, 1);
            av_store(checks, 0, newSVsv(check));
        }
    }

    check = get_slots(self, "constraint");
    if(check && SvOK(check)){
        if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
            croak("Not a CODE reference");
        }
        av_push(checks, newSVsv(check));
    }

    types_ref = get_slots(self, "type_constraints");
    if(types_ref && SvOK(types_ref)){ /* union type */
        AV* types;
        AV* union_checks;
        CV* union_check;
        I32 len;
        I32 i;

        if(!IsArrayRef(types_ref)){
            croak("Not an ARRAY reference");
        }
        types = (AV*)SvRV(types_ref);
        len = av_len(types) + 1;

        union_checks = newAV_mortal();

        for(i = 0; i < len; i++){
            SV* const tc = *av_fetch(types, i, TRUE);
            SV* const c  = get_slots(tc, "compiled_type_constraint");
            if(!(c && mouse_tc_CodeRef(aTHX_ NULL, c))){
                mouse_throw_error(self, c, "'%"SVf"' has no compiled type constraint", self);
            }
            av_push(union_checks, newSVsv(c));
        }

        union_check = mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_union_check, (SV*)union_checks);
        av_push(checks, newRV_inc((SV*)union_check));
    }

    if(AvFILLp(checks) < 0){
        check = newRV_inc((SV*)get_cv("Mouse::Util::TypeConstraints::Any", TRUE));
    }
    else{
        check = newRV_inc((SV*)mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_check, (SV*)checks));
    }
    (void)set_slots(self, "compiled_type_constraint", check);
}

bool
check(SV* self, SV* sv)
CODE:
{
    SV* const check = get_slots(self, "compiled_type_constraint");
    if(!(check && mouse_tc_CodeRef(aTHX_ NULL, check))){
        mouse_throw_error(self, check, "'%"SVf"' has no compiled type constraint", self);
    }
    RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE;
}
OUTPUT:
    RETVAL
Commit	Line	Data
7d96ae4d	1	/*
	2	* full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints)
	3	*/
	4
	5	#include "mouse.h"
	6
	7	#if PERL_BCDVERSION >= 0x5008005
	8	#define LooksLikeNumber(sv) looks_like_number(sv)
	9	#else
	10	#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
	11	#endif
	12
	13	#ifndef SvRXOK
	14	#define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
	15	#endif
	16
d33d8840	17	typedef int (check_fptr_t)(pTHX_ SV const data, SV* const sv);
d33d8840	18
85a74fcf	19	/*
	20	NOTE: mouse_tc_check() handles GETMAGIC
	21	*/
1d5ecd5f	22	int
1d5ecd5f	23	mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
28ba5a26	24	CV* const cv = (CV*)SvRV(tc_code);
7ca3334f	25	assert(SvTYPE(cv) == SVt_PVCV);
d33d8840	26
19462c57	27	if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
7ca3334f	28	MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
d33d8840	29
7ca3334f	30	assert(CvXSUBANY(cv).any_ptr != NULL);
19462c57	31	assert(mg->mg_ptr != NULL);
28ba5a26	32
a901dc2e	33	SvGETMAGIC(sv);
7ca3334f	34	/* call the check function directly, skipping call_sv() */
7ca3334f	35	return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
1d5ecd5f	36	}
7ca3334f	37	else { /* custom */
1d5ecd5f	38	int ok;
	39	dSP;
	40
	41	ENTER;
	42	SAVETMPS;
	43
	44	PUSHMARK(SP);
	45	XPUSHs(sv);
	46	PUTBACK;
	47
	48	call_sv(tc_code, G_SCALAR);
	49
	50	SPAGAIN;
6ad77996	51	ok = sv_true(POPs);
1d5ecd5f	52	PUTBACK;
	53
	54	FREETMPS;
	55	LEAVE;
	56
	57	return ok;
	58	}
	59	}
7d96ae4d	60
7d96ae4d	61	/*
	62	The following type check functions return an integer, not a bool, to keep them simple,
	63	so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
	64	*/
	65
	66	int
19462c57	67	mouse_tc_Any(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv PERL_UNUSED_DECL) {
7d96ae4d	68	assert(sv);
	69	return TRUE;
	70	}
	71
	72	int
19462c57	73	mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	74	assert(sv);
f6e3b8a9	75
6ad77996	76	if(sv_true(sv)){
7d96ae4d	77	if(SvIOKp(sv)){
f6e3b8a9	78	return SvIVX(sv) == 1;
7d96ae4d	79	}
7d96ae4d	80	else if(SvNOKp(sv)){
f6e3b8a9	81	return SvNVX(sv) == 1.0;
7d96ae4d	82	}
f6e3b8a9	83	else if(SvPOKp(sv)){ /* "1" */
f6e3b8a9	84	return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1';
7d96ae4d	85	}
	86	else{
	87	return FALSE;
	88	}
	89	}
	90	else{
90232975	91	/* any false value must be boolean */
7d96ae4d	92	return TRUE;
	93	}
	94	}
	95
	96	int
19462c57	97	mouse_tc_Undef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	98	assert(sv);
	99	return !SvOK(sv);
	100	}
	101
	102	int
19462c57	103	mouse_tc_Defined(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	104	assert(sv);
	105	return SvOK(sv);
	106	}
	107
	108	int
19462c57	109	mouse_tc_Value(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	110	assert(sv);
	111	return SvOK(sv) && !SvROK(sv);
	112	}
	113
	114	int
19462c57	115	mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	116	assert(sv);
	117	return LooksLikeNumber(sv);
	118	}
	119
	120	int
0cfe08a4	121	S_nv_is_integer(pTHX_ NV const nv) {
	122	if(nv == (NV)(IV)nv){
	123	return TRUE;
	124	}
	125	else {
	126	char buf[64]; /* Must fit sprintf/Gconvert of longest NV */
	127	char* p;
	128	Gconvert(nv, NV_DIG, 0, buf);
	129	p = &buf[0];
	130
	131	/* -?[0-9]+ */
	132	if(*p == '-') p++;
	133
	134	while(*p){
	135	if(!isDIGIT(*p)){
	136	return FALSE;
	137	}
	138	p++;
	139	}
	140	return TRUE;
	141	}
	142	}
	143
	144	int
19462c57	145	mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	146	assert(sv);
	147	if(SvIOKp(sv)){
	148	return TRUE;
	149	}
9ab5eba8	150	else if(SvNOKp(sv)) {
0cfe08a4	151	return S_nv_is_integer(aTHX_ SvNVX(sv));
7d96ae4d	152	}
	153	else if(SvPOKp(sv)){
	154	int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
	155	if(num_type){
	156	return !(num_type & IS_NUMBER_NOT_INT);
	157	}
	158	}
	159	return FALSE;
	160	}
	161
	162	int
19462c57	163	mouse_tc_Str(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	164	assert(sv);
	165	return SvOK(sv) && !SvROK(sv) && !isGV(sv);
	166	}
	167
	168	int
19462c57	169	mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){
7d96ae4d	170	assert(sv);
	171	return is_class_loaded(sv);
	172	}
	173
	174	int
19462c57	175	mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	176	assert(sv);
	177	if(is_class_loaded(sv)){
	178	int ok;
7d96ae4d	179
	180	ENTER;
	181	SAVETMPS;
	182
aa2d2e2c	183	ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv));
7d96ae4d	184
	185	FREETMPS;
	186	LEAVE;
	187
	188	return ok;
	189	}
	190	return FALSE;
	191	}
	192
	193	int
19462c57	194	mouse_tc_Ref(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	195	assert(sv);
	196	return SvROK(sv);
	197	}
	198
	199	int
bcf612a8	200	mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* sv) {
7d96ae4d	201	assert(sv);
bcf612a8	202	if(SvROK(sv)){
	203	sv = SvRV(sv);
	204	return !SvOBJECT(sv) && (SvTYPE(sv) <= SVt_PVLV && !isGV(sv));
	205	}
	206	return FALSE;
7d96ae4d	207	}
	208
	209	int
19462c57	210	mouse_tc_ArrayRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	211	assert(sv);
80aa5731	212	return IsArrayRef(sv);
7d96ae4d	213	}
	214
	215	int
19462c57	216	mouse_tc_HashRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	217	assert(sv);
80aa5731	218	return IsHashRef(sv);
7d96ae4d	219	}
	220
	221	int
19462c57	222	mouse_tc_CodeRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	223	assert(sv);
80aa5731	224	return IsCodeRef(sv);
7d96ae4d	225	}
	226
	227	int
19462c57	228	mouse_tc_RegexpRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	229	assert(sv);
	230	return SvRXOK(sv);
	231	}
	232
	233	int
19462c57	234	mouse_tc_GlobRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	235	assert(sv);
	236	return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
	237	}
	238
	239	int
19462c57	240	mouse_tc_FileHandle(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	241	GV* gv;
	242	assert(sv);
	243
	244	/* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */
	245
	246	gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
	247	if(isGV(gv) \|\| SvTYPE(gv) == SVt_PVIO){
	248	IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;
	249
	250	if(io && ( IoIFP(io) \|\| SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
	251	return TRUE;
	252	}
	253	}
	254
016e4681	255	return is_an_instance_of("IO::Handle", sv);
7d96ae4d	256	}
	257
	258	int
19462c57	259	mouse_tc_Object(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) {
7d96ae4d	260	assert(sv);
	261	return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
	262	}
	263
619338ac	264	/* Parameterized type constraints */
619338ac	265
f790c46b	266	static int
619338ac	267	mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
80aa5731	268	if(IsArrayRef(sv)){
619338ac	269	AV* const av = (AV*)SvRV(sv);
	270	I32 const len = av_len(av) + 1;
	271	I32 i;
	272	for(i = 0; i < len; i++){
	273	SV* const value = *av_fetch(av, i, TRUE);
619338ac	274	if(!mouse_tc_check(aTHX_ param, value)){
	275	return FALSE;
	276	}
	277	}
	278	return TRUE;
	279	}
	280	return FALSE;
	281	}
	282
f790c46b	283	static int
619338ac	284	mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
19462c57	285	if(mouse_tc_HashRef(aTHX_ NULL, sv)){
619338ac	286	HV* const hv = (HV*)SvRV(sv);
	287	HE* he;
	288
	289	hv_iterinit(hv);
	290	while((he = hv_iternext(hv))){
	291	SV* const value = hv_iterval(hv, he);
619338ac	292	if(!mouse_tc_check(aTHX_ param, value)){
a1cf0531	293	hv_iterinit(hv); /* reset */
619338ac	294	return FALSE;
	295	}
	296	}
	297	return TRUE;
	298	}
	299	return FALSE;
	300	}
	301
f790c46b	302	static int
619338ac	303	mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
	304	if(SvOK(sv)){
	305	return mouse_tc_check(aTHX_ param, sv);
	306	}
	307	return TRUE;
	308	}
	309
f790c46b	310	static int
	311	mouse_types_union_check(pTHX_ AV* const types, SV* const sv) {
	312	I32 const len = AvFILLp(types) + 1;
	313	I32 i;
	314
	315	for(i = 0; i < len; i++){
	316	if(mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
	317	return TRUE;
	318	}
	319	}
	320
	321	return FALSE;
	322	}
	323
	324	static int
	325	mouse_types_check(pTHX_ AV* const types, SV* const sv) {
	326	I32 const len = AvFILLp(types) + 1;
	327	I32 i;
	328
	329	ENTER;
	330	SAVE_DEFSV;
	331	DEFSV_set(sv);
	332
	333	for(i = 0; i < len; i++){
	334	if(!mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
	335	LEAVE;
	336	return FALSE;
	337	}
	338	}
	339
	340	LEAVE;
	341
	342	return TRUE;
	343	}
	344
1d5ecd5f	345	/*
	346	* This class_type generator is taken from Scalar::Util::Instance
	347	*/
	348
	349	#define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION
	350	typedef struct sui_cxt{
	351	GV* universal_isa;
ebe91068	352	GV* universal_can;
1d5ecd5f	353	} my_cxt_t;
	354	START_MY_CXT
	355
	356	#define MG_klass_stash(mg) ((HV*)(mg)->mg_obj)
	357	#define MG_klass_pv(mg) ((mg)->mg_ptr)
	358	#define MG_klass_len(mg) ((mg)->mg_len)
	359
441964ce	360	static const char*
f48920c1	361	mouse_canonicalize_package_name(const char* name){
1d5ecd5f	362
	363	/* "::Foo" -> "Foo" */
	364	if(name[0] == ':' && name[1] == ':'){
	365	name += 2;
	366	}
	367
	368	/* "main::main::main::Foo" -> "Foo" */
	369	while(strnEQ(name, "main::", sizeof("main::")-1)){
	370	name += sizeof("main::")-1;
	371	}
	372
	373	return name;
	374	}
	375
	376	static int
441964ce	377	mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){
1d5ecd5f	378	AV* const linearized_isa = mro_get_linear_isa(instance_stash);
	379	SV** svp = AvARRAY(linearized_isa);
	380	SV** const end = svp + AvFILLp(linearized_isa) + 1;
	381
	382	while(svp != end){
	383	assert(SvPVX(*svp));
f48920c1	384	if(strEQ(klass_pv, mouse_canonicalize_package_name(SvPVX(*svp)))){
1d5ecd5f	385	return TRUE;
	386	}
	387	svp++;
	388	}
	389	return FALSE;
	390	}
	391
ce89cb68	392	#define find_method_pvn(a, b, c) mouse_stash_find_method(aTHX_ a, b, c)
	393	#define find_method_pvs(a, b) mouse_stash_find_method(aTHX_ a, STR_WITH_LEN(b))
	394
	395	static inline GV*
	396	mouse_stash_find_method(pTHX_ HV* const stash, const char* const name, I32 const namelen){
	397	GV const gvp = (GV)hv_fetch(stash, name, namelen, FALSE);
	398	if(gvp && isGV(gvp) && GvCV(gvp)){ /* shortcut */
	399	return *gvp;
	400	}
	401
	402	return gv_fetchmeth_autoload(stash, name, namelen, 0);
	403	}
	404
441964ce	405	int
	406	mouse_is_an_instance_of(pTHX_ HV* const stash, SV* const instance){
	407	assert(stash);
	408	assert(SvTYPE(stash) == SVt_PVHV);
	409
016e4681	410	if(IsObject(instance)){
441964ce	411	dMY_CXT;
441964ce	412	HV* const instance_stash = SvSTASH(SvRV(instance));
28e3abdf	413	GV* const myisa = find_method_pvs(instance_stash, "isa");
441964ce	414
441964ce	415	/* the instance has no own isa method */
28e3abdf	416	if(myisa == NULL \|\| GvCV(myisa) == GvCV(MY_CXT.universal_isa)){
441964ce	417	return stash == instance_stash
	418	\|\| mouse_lookup_isa(aTHX_ instance_stash, HvNAME_get(stash));
	419	}
	420	/* the instance has its own isa method */
	421	else {
28e3abdf	422	SV* package;
28e3abdf	423	int ok;
1d5ecd5f	424
441964ce	425	ENTER;
441964ce	426	SAVETMPS;
1d5ecd5f	427
28e3abdf	428	package = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
28e3abdf	429	ok = sv_true(mcall1s(instance, "isa", sv_2mortal(package)));
1d5ecd5f	430
441964ce	431	FREETMPS;
441964ce	432	LEAVE;
1d5ecd5f	433
28e3abdf	434	return ok;
441964ce	435	}
1d5ecd5f	436	}
441964ce	437	return FALSE;
	438	}
	439
	440	static int
	441	mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){
	442	PERL_UNUSED_ARG(data);
	443	return SvROK(sv) && SvOBJECT(SvRV(sv));
1d5ecd5f	444	}
1d5ecd5f	445
ebe91068	446	static int
	447	mouse_can_methods(pTHX_ AV* const methods, SV* const instance){
	448	if(IsObject(instance)){
	449	dMY_CXT;
	450	HV* const mystash = SvSTASH(SvRV(instance));
ce89cb68	451	GV* const mycan = find_method_pvs(mystash, "can");
ce89cb68	452	bool const use_builtin = (mycan == NULL \|\| GvCV(mycan) == GvCV(MY_CXT.universal_can)) ? TRUE : FALSE;
ebe91068	453	I32 const len = AvFILLp(methods) + 1;
	454	I32 i;
	455	for(i = 0; i < len; i++){
	456	SV* const name = MOUSE_av_at(methods, i);
	457
	458	if(use_builtin){
ce89cb68	459	if(!find_method_pvn(mystash, SvPVX(name), SvCUR(name))){
ebe91068	460	return FALSE;
	461	}
	462	}
	463	else{
	464	bool ok;
ebe91068	465
	466	ENTER;
	467	SAVETMPS;
	468
28e3abdf	469	ok = sv_true(mcall1s(instance, "can", sv_mortalcopy(name)));
ebe91068	470
	471	FREETMPS;
	472	LEAVE;
	473
	474	if(!ok){
	475	return FALSE;
	476	}
	477	}
	478	}
	479	return TRUE;
	480	}
	481	return FALSE;
	482	}
	483
441964ce	484	static MGVTBL mouse_util_type_constraints_vtbl; /* not used, only for identity */
f48920c1	485
619338ac	486	static CV*
19462c57	487	mouse_tc_generate(pTHX_ const char* const name, check_fptr_t const fptr, SV* const param) {
619338ac	488	CV* xsub;
916eb82f	489
19462c57	490	xsub = newXS(name, XS_Mouse_constraint_check, __FILE__);
916eb82f	491	CvXSUBANY(xsub).any_ptr = sv_magicext(
	492	(SV*)xsub,
	493	param, /* mg_obj: refcnt will be increased */
	494	PERL_MAGIC_ext,
	495	&mouse_util_type_constraints_vtbl,
1b364415	496	(char)fptr, / mg_ptr */
916eb82f	497	0 /* mg_len: 0 for static data */
	498	);
	499
	500	if(!name){
	501	sv_2mortal((SV*)xsub);
	502	}
	503
	504	return xsub;
	505	}
	506
	507	CV*
672bde7c	508	mouse_generate_isa_predicate_for(pTHX_ SV* const klass, const char* const predicate_name){
441964ce	509	STRLEN klass_len;
441964ce	510	const char* klass_pv = SvPV_const(klass, klass_len);
916eb82f	511	SV* param;
1b364415	512	check_fptr_t fptr;
1d5ecd5f	513
441964ce	514	klass_pv = mouse_canonicalize_package_name(klass_pv);
1d5ecd5f	515
441964ce	516	if(strNE(klass_pv, "UNIVERSAL")){
916eb82f	517	param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD);
1b364415	518	fptr = (check_fptr_t)mouse_is_an_instance_of;
441964ce	519
	520	}
	521	else{
916eb82f	522	param = NULL;
1b364415	523	fptr = (check_fptr_t)mouse_is_an_instance_of_universal;
441964ce	524	}
441964ce	525
19462c57	526	return mouse_tc_generate(aTHX_ predicate_name, fptr, param);
441964ce	527	}
f48920c1	528
ebe91068	529	CV*
	530	mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const predicate_name){
	531	AV* av;
	532	AV* const param = newAV_mortal();
	533	I32 len;
	534	I32 i;
	535
d06d9266	536	must_ref(methods, "an ARRAY ref for method names", SVt_PVAV);
ebe91068	537	av = (AV*)SvRV(methods);
	538
	539	len = av_len(av) + 1;
	540	for(i = 0; i < len; i++){
	541	SV* const name = *av_fetch(av, i, TRUE);
	542	STRLEN pvlen;
	543	const char* const pv = SvPV_const(name, pvlen);
	544
	545	av_push(param, newSVpvn_share(pv, pvlen, 0U));
	546	}
	547
	548	return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param);
	549	}
	550
	551
19462c57	552	XS(XS_Mouse_constraint_check) {
1d5ecd5f	553	dVAR;
1d5ecd5f	554	dXSARGS;
441964ce	555	MAGIC* const mg = (MAGIC*)XSANY.any_ptr;
1d5ecd5f	556
441964ce	557	if(items < 1){
19462c57	558	croak("Too few arguments for type constraint check functions");
1d5ecd5f	559	}
1d5ecd5f	560
441964ce	561	SvGETMAGIC( ST(0) );
441964ce	562	ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, ST(0)) );
1d5ecd5f	563	XSRETURN(1);
	564	}
	565
	566	static void
	567	setup_my_cxt(pTHX_ pMY_CXT){
	568	MY_CXT.universal_isa = gv_fetchpvs("UNIVERSAL::isa", GV_ADD, SVt_PVCV);
	569	SvREFCNT_inc_simple_void_NN(MY_CXT.universal_isa);
ebe91068	570
	571	MY_CXT.universal_can = gv_fetchpvs("UNIVERSAL::can", GV_ADD, SVt_PVCV);
	572	SvREFCNT_inc_simple_void_NN(MY_CXT.universal_can);
1d5ecd5f	573	}
1d5ecd5f	574
19462c57	575	#define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL)
19462c57	576
1d5ecd5f	577	MODULE = Mouse::Util::TypeConstraints PACKAGE = Mouse::Util::TypeConstraints
1d5ecd5f	578
646c0371	579	PROTOTYPES: DISABLE
646c0371	580	VERSIONCHECK: DISABLE
1d5ecd5f	581
	582	BOOT:
	583	{
	584	MY_CXT_INIT;
	585	setup_my_cxt(aTHX_ aMY_CXT);
19462c57	586
	587	/* setup built-in type constraints */
	588	DEFINE_TC(Any);
	589	DEFINE_TC(Undef);
	590	DEFINE_TC(Defined);
	591	DEFINE_TC(Bool);
	592	DEFINE_TC(Value);
	593	DEFINE_TC(Ref);
	594	DEFINE_TC(Str);
	595	DEFINE_TC(Num);
	596	DEFINE_TC(Int);
	597	DEFINE_TC(ScalarRef);
	598	DEFINE_TC(ArrayRef);
	599	DEFINE_TC(HashRef);
	600	DEFINE_TC(CodeRef);
	601	DEFINE_TC(GlobRef);
	602	DEFINE_TC(FileHandle);
	603	DEFINE_TC(RegexpRef);
	604	DEFINE_TC(Object);
	605	DEFINE_TC(ClassName);
	606	DEFINE_TC(RoleName);
1d5ecd5f	607	}
	608
	609	#ifdef USE_ITHREADS
	610
	611	void
	612	CLONE(...)
	613	CODE:
	614	{
	615	MY_CXT_CLONE;
	616	setup_my_cxt(aTHX_ aMY_CXT);
	617	PERL_UNUSED_VAR(items);
	618	}
	619
	620	#endif /* !USE_ITHREADS */
	621
19462c57	622	#define MOUSE_TC_MAYBE 0
	623	#define MOUSE_TC_ARRAY_REF 1
	624	#define MOUSE_TC_HASH_REF 2
1d5ecd5f	625
619338ac	626	CV*
	627	_parameterize_ArrayRef_for(SV* param)
	628	ALIAS:
	629	_parameterize_ArrayRef_for = MOUSE_TC_ARRAY_REF
	630	_parameterize_HashRef_for = MOUSE_TC_HASH_REF
	631	_parameterize_Maybe_for = MOUSE_TC_MAYBE
	632	CODE:
	633	{
	634	check_fptr_t fptr;
	635	SV* const tc_code = mcall0s(param, "_compiled_type_constraint");
80aa5731	636	if(!IsCodeRef(tc_code)){
619338ac	637	croak("_compiled_type_constraint didn't return a CODE reference");
	638	}
	639
	640	switch(ix){
	641	case MOUSE_TC_ARRAY_REF:
	642	fptr = mouse_parameterized_ArrayRef;
	643	break;
	644	case MOUSE_TC_HASH_REF:
	645	fptr = mouse_parameterized_HashRef;
	646	break;
	647	default: /* Maybe type */
	648	fptr = mouse_parameterized_Maybe;
	649	}
19462c57	650	RETVAL = mouse_tc_generate(aTHX_ NULL, fptr, tc_code);
619338ac	651	}
	652	OUTPUT:
	653	RETVAL
	654
f790c46b	655	MODULE = Mouse::Util::TypeConstraints PACKAGE = Mouse::Meta::TypeConstraint
f790c46b	656
a4b901ac	657	BOOT:
	658	INSTALL_SIMPLE_READER(TypeConstraint, name);
	659	INSTALL_SIMPLE_READER(TypeConstraint, parent);
	660	INSTALL_SIMPLE_READER(TypeConstraint, message);
	661
fc83f4cf	662	INSTALL_SIMPLE_READER(TypeConstraint, type_parameter);
fc83f4cf	663
a4b901ac	664	INSTALL_SIMPLE_READER_WITH_KEY(TypeConstraint, _compiled_type_constraint, compiled_type_constraint);
	665	INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */
	666
	667	INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
fc83f4cf	668	INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */
a4b901ac	669
f790c46b	670	void
	671	compile_type_constraint(SV* self)
	672	CODE:
	673	{
6fab29c6	674	AV* const checks = newAV_mortal();
f790c46b	675	SV* check; /* check function */
	676	SV* parent;
	677	SV* types_ref;
	678
f790c46b	679	for(parent = get_slots(self, "parent"); parent; parent = get_slots(parent, "parent")){
	680	check = get_slots(parent, "hand_optimized_type_constraint");
	681	if(check && SvOK(check)){
19462c57	682	if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
f790c46b	683	croak("Not a CODE reference");
	684	}
	685	av_unshift(checks, 1);
	686	av_store(checks, 0, newSVsv(check));
	687	break; /* a hand optimized constraint must include all the parent */
	688	}
	689
	690	check = get_slots(parent, "constraint");
	691	if(check && SvOK(check)){
19462c57	692	if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
f790c46b	693	croak("Not a CODE reference");
	694	}
	695	av_unshift(checks, 1);
	696	av_store(checks, 0, newSVsv(check));
	697	}
	698	}
	699
	700	check = get_slots(self, "constraint");
	701	if(check && SvOK(check)){
19462c57	702	if(!mouse_tc_CodeRef(aTHX_ NULL, check)){
f790c46b	703	croak("Not a CODE reference");
	704	}
	705	av_push(checks, newSVsv(check));
	706	}
	707
	708	types_ref = get_slots(self, "type_constraints");
	709	if(types_ref && SvOK(types_ref)){ /* union type */
	710	AV* types;
	711	AV* union_checks;
	712	CV* union_check;
	713	I32 len;
	714	I32 i;
	715
80aa5731	716	if(!IsArrayRef(types_ref)){
f790c46b	717	croak("Not an ARRAY reference");
	718	}
	719	types = (AV*)SvRV(types_ref);
	720	len = av_len(types) + 1;
	721
6fab29c6	722	union_checks = newAV_mortal();
f790c46b	723
	724	for(i = 0; i < len; i++){
	725	SV* const tc = *av_fetch(types, i, TRUE);
	726	SV* const c = get_slots(tc, "compiled_type_constraint");
19462c57	727	if(!(c && mouse_tc_CodeRef(aTHX_ NULL, c))){
c7576321	728	mouse_throw_error(self, c, "'%"SVf"' has no compiled type constraint", self);
f790c46b	729	}
	730	av_push(union_checks, newSVsv(c));
	731	}
	732
19462c57	733	union_check = mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_union_check, (SV*)union_checks);
f790c46b	734	av_push(checks, newRV_inc((SV*)union_check));
	735	}
	736
	737	if(AvFILLp(checks) < 0){
	738	check = newRV_inc((SV*)get_cv("Mouse::Util::TypeConstraints::Any", TRUE));
	739	}
	740	else{
19462c57	741	check = newRV_inc((SV)mouse_tc_generate(aTHX_ NULL, (check_fptr_t)mouse_types_check, (SV)checks));
f790c46b	742	}
ca8e67d6	743	(void)set_slots(self, "compiled_type_constraint", check);
f790c46b	744	}
f790c46b	745
c7576321	746	bool
	747	check(SV* self, SV* sv)
	748	CODE:
	749	{
	750	SV* const check = get_slots(self, "compiled_type_constraint");
	751	if(!(check && mouse_tc_CodeRef(aTHX_ NULL, check))){
	752	mouse_throw_error(self, check, "'%"SVf"' has no compiled type constraint", self);
	753	}
	754	RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE;
	755	}
	756	OUTPUT:
	757	RETVAL
	758