X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=8ff2975298645f095131d951fcd68108aeb2e626;hb=31aa6299ca20515174f1b145e5b3d4dbd9e09a08;hp=31d7c46e3b747fb7c52a481409dc5afdea292554;hpb=672bde7c9b3e68ea3aff3186eafb11b73e8e3d89;p=gitmo%2FMouse.git diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index 31d7c46..8ff2975 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -1,39 +1,70 @@ /* - * full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints) + * TypeConstraint stuff + * - Mouse::Util::TypeConstraints (including OptimizedConstraionts) + * - Mouse::Meta::TypeConstraint */ #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 +#define MY_CXT_KEY "Mouse::Util::TypeConstraints::_guts" XS_VERSION +typedef struct sui_cxt{ + GV* universal_isa; + GV* universal_can; + AV* tc_extra_args; +} my_cxt_t; +START_MY_CXT + +typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv); + +static +XSPROTO(XS_Mouse_constraint_check); + +/* + NOTE: mouse_tc_check() handles GETMAGIC +*/ int mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { - if(SvIOK(tc_code)){ /* built-in type constraints */ - return mouse_builtin_tc_check(aTHX_ SvIVX(tc_code), 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 { + else { /* custom */ int ok; dSP; + dMY_CXT; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv); + if( MY_CXT.tc_extra_args ) { + AV* const av = MY_CXT.tc_extra_args; + I32 const len = AvFILLp(av) + 1; + int i; + for(i = 0; i < len; i++) { + XPUSHs( AvARRAY(av)[i] ); + } + } PUTBACK; call_sv(tc_code, G_SCALAR); SPAGAIN; - ok = SvTRUEx(POPs); + ok = sv_true(POPs); PUTBACK; FREETMPS; @@ -43,148 +74,129 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { } } -int -mouse_builtin_tc_check(pTHX_ mouse_tc const tc, SV* const sv) { - switch(tc){ - case MOUSE_TC_ANY: return mouse_tc_Any(aTHX_ sv); - case MOUSE_TC_ITEM: return mouse_tc_Any(aTHX_ sv); - case MOUSE_TC_UNDEF: return mouse_tc_Undef(aTHX_ sv); - case MOUSE_TC_DEFINED: return mouse_tc_Defined(aTHX_ sv); - case MOUSE_TC_BOOL: return mouse_tc_Bool(aTHX_ sv); - case MOUSE_TC_VALUE: return mouse_tc_Value(aTHX_ sv); - case MOUSE_TC_REF: return mouse_tc_Ref(aTHX_ sv); - case MOUSE_TC_STR: return mouse_tc_Str(aTHX_ sv); - case MOUSE_TC_NUM: return mouse_tc_Num(aTHX_ sv); - case MOUSE_TC_INT: return mouse_tc_Int(aTHX_ sv); - case MOUSE_TC_SCALAR_REF: return mouse_tc_ScalarRef(aTHX_ sv); - case MOUSE_TC_ARRAY_REF: return mouse_tc_ArrayRef(aTHX_ sv); - case MOUSE_TC_HASH_REF: return mouse_tc_HashRef(aTHX_ sv); - case MOUSE_TC_CODE_REF: return mouse_tc_CodeRef(aTHX_ sv); - case MOUSE_TC_GLOB_REF: return mouse_tc_GlobRef(aTHX_ sv); - case MOUSE_TC_FILEHANDLE: return mouse_tc_FileHandle(aTHX_ sv); - case MOUSE_TC_REGEXP_REF: return mouse_tc_RegexpRef(aTHX_ sv); - case MOUSE_TC_OBJECT: return mouse_tc_Object(aTHX_ sv); - case MOUSE_TC_CLASS_NAME: return mouse_tc_ClassName(aTHX_ sv); - case MOUSE_TC_ROLE_NAME: return mouse_tc_RoleName(aTHX_ sv); - default: - /* custom type constraints */ - NOOP; - } - - croak("Custom type constraint is not yet implemented"); - return FALSE; /* not reached */ -} - - /* - 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". + The following type check functions return an integer, not a bool, to keep + the code simple, + so if you assign these return value to a bool variable, you must use + "expr ? TRUE : FALSE". */ int -mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) { +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 sv) { +mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - if(SvOK(sv)){ - if(SvIOKp(sv)){ - return SvIVX(sv) == 1 || SvIVX(sv) == 0; + + if(sv_true(sv)){ + if(SvPOKp(sv)){ /* "1" */ + return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1'; } - else if(SvNOKp(sv)){ - return SvNVX(sv) == 1.0 || SvNVX(sv) == 0.0; + else if(SvIOKp(sv)){ + return SvIVX(sv) == 1; } - else if(SvPOKp(sv)){ /* "" or "1" or "0" */ - return SvCUR(sv) == 0 - || ( SvCUR(sv) == 1 && ( SvPVX(sv)[0] == '1' || SvPVX(sv)[0] == '0' ) ); + else if(SvNOKp(sv)){ + return SvNVX(sv) == 1.0; } else{ return FALSE; } } else{ + /* any false value is a boolean */ return TRUE; } } int -mouse_tc_Undef(pTHX_ SV* const sv) { +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 sv) { +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 sv) { +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 sv) { +mouse_tc_Num(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); return LooksLikeNumber(sv); } -int -mouse_tc_Int(pTHX_ SV* const sv) { - assert(sv); - if(SvIOKp(sv)){ +static int +S_nv_is_integer(pTHX_ NV const nv) { + if(nv == (NV)(IV)nv){ return TRUE; } - else if(SvNOKp(sv)){ - NV const nv = SvNVX(sv); - return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv); + else { + char buf[64]; /* Must fit sprintf/Gconvert of longest NV */ + const char* p; + (void)Gconvert(nv, NV_DIG, 0, buf); + p = &buf[0]; + + /* -?[0-9]+ */ + if(*p == '-') p++; + + while(*p){ + if(!isDIGIT(*p)){ + return FALSE; + } + p++; + } + return TRUE; } - else if(SvPOKp(sv)){ +} + +int +mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { + assert(sv); + 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 num_type && !(num_type & IS_NUMBER_NOT_INT); + } + else if(SvIOKp(sv)){ + return TRUE; + } + else if(SvNOKp(sv)) { + return S_nv_is_integer(aTHX_ SvNVX(sv)); } return FALSE; } int -mouse_tc_Str(pTHX_ SV* const sv) { +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 sv){ +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 sv) { +mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); if(is_class_loaded(sv)){ int ok; - SV* meta; - dSP; ENTER; SAVETMPS; - PUSHMARK(SP); - XPUSHs(sv); - PUTBACK; - call_pv("Mouse::Util::get_metaclass_by_name", G_SCALAR); - SPAGAIN; - meta = POPs; - PUTBACK; - - ok = is_instance_of(meta, newSVpvs_flags("Mouse::Meta::Role", SVs_TEMP)); + ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv)); FREETMPS; LEAVE; @@ -195,49 +207,53 @@ mouse_tc_RoleName(pTHX_ SV* const sv) { } int -mouse_tc_Ref(pTHX_ SV* const sv) { +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 sv) { +mouse_tc_ScalarRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* sv) { assert(sv); - return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(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 sv) { +mouse_tc_ArrayRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV; + return IsArrayRef(sv); } int -mouse_tc_HashRef(pTHX_ SV* const sv) { +mouse_tc_HashRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV; + return IsHashRef(sv); } int -mouse_tc_CodeRef(pTHX_ SV* const sv) { +mouse_tc_CodeRef(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - return SvROK(sv) && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV; + return IsCodeRef(sv); } int -mouse_tc_RegexpRef(pTHX_ SV* const sv) { +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 sv) { +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 sv) { +mouse_tc_FileHandle(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { GV* gv; assert(sv); @@ -252,24 +268,100 @@ mouse_tc_FileHandle(pTHX_ SV* const sv) { } } - return is_instance_of(sv, newSVpvs_flags("IO::Handle", SVs_TEMP)); + return is_an_instance_of("IO::Handle", sv); } int -mouse_tc_Object(pTHX_ SV* const sv) { +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(IsHashRef(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; -} my_cxt_t; -START_MY_CXT #define MG_klass_stash(mg) ((HV*)(mg)->mg_obj) #define MG_klass_pv(mg) ((mg)->mg_ptr) @@ -307,47 +399,49 @@ mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){ 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(SvROK(instance) && SvOBJECT(SvRV(instance))){ + if(IsObject(instance)){ dMY_CXT; HV* const instance_stash = SvSTASH(SvRV(instance)); - GV* const instance_isa = gv_fetchmeth_autoload(instance_stash, "isa", sizeof("isa")-1, 0); + GV* const myisa = find_method_pvs(instance_stash, "isa"); /* the instance has no own isa method */ - if(instance_isa == NULL || GvCV(instance_isa) == GvCV(MY_CXT.universal_isa)){ + 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 { - int retval; - dSP; + SV* package; + int ok; ENTER; SAVETMPS; - PUSHMARK(SP); - EXTEND(SP, 2); - PUSHs(instance); - mPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash)); - PUTBACK; - - call_sv((SV*)instance_isa, G_SCALAR); - - SPAGAIN; - - retval = SvTRUEx(POPs); - - PUTBACK; + package = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U); + ok = sv_true(mcall1s(instance, "isa", sv_2mortal(package))); FREETMPS; LEAVE; - return retval; + return ok; } } return FALSE; @@ -359,67 +453,151 @@ mouse_is_an_instance_of_universal(pTHX_ SV* const data, SV* const sv){ 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); - CV* xsub; - SV* mg_obj; - void* mg_ptr; + SV* param; + check_fptr_t fptr; klass_pv = mouse_canonicalize_package_name(klass_pv); if(strNE(klass_pv, "UNIVERSAL")){ - mg_obj = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD); - mg_ptr = (void*)mouse_is_an_instance_of; + param = (SV*)gv_stashpvn(klass_pv, klass_len, GV_ADD); + fptr = (check_fptr_t)mouse_is_an_instance_of; } else{ - mg_obj = NULL; - mg_ptr = (void*)mouse_is_an_instance_of_universal; + param = NULL; + fptr = (check_fptr_t)mouse_is_an_instance_of_universal; } - xsub = newXS(predicate_name, XS_Mouse_parameterized_check, __FILE__); - - CvXSUBANY(xsub).any_ptr = sv_magicext( - (SV*)xsub, - mg_obj, - PERL_MAGIC_ext, - &mouse_util_type_constraints_vtbl, - mg_ptr, - 0 /* indicates static data */ - ); + return mouse_tc_generate(aTHX_ predicate_name, fptr, param); +} - if(!predicate_name){ - sv_2mortal((SV*)xsub); +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 xsub; + return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param); } -XS(XS_Mouse_parameterized_check) { +static +XSPROTO(XS_Mouse_constraint_check) { dVAR; dXSARGS; MAGIC* const mg = (MAGIC*)XSANY.any_ptr; - typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv); + SV* sv; if(items < 1){ - croak("Too few arguments for parameterized check functions"); + 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)) ); + sv = ST(0); + SvGETMAGIC(sv); + ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv) ); XSRETURN(1); } +static +XSPROTO(XS_Mouse_TypeConstraint_fallback) { + dXSARGS; + PERL_UNUSED_VAR(cv); + PERL_UNUSED_VAR(items); + XSRETURN_EMPTY; +} + 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); + + MY_CXT.tc_extra_args = NULL; } +#define DEFINE_TC(name) mouse_tc_generate(aTHX_ "Mouse::Util::TypeConstraints::" STRINGIFY(name), CAT2(mouse_tc_, name), NULL) + +#define MTC_CLASS "Mouse::Meta::TypeConstraint" + MODULE = Mouse::Util::TypeConstraints PACKAGE = Mouse::Util::TypeConstraints PROTOTYPES: DISABLE @@ -429,6 +607,27 @@ 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 @@ -444,32 +643,201 @@ CODE: #endif /* !USE_ITHREADS */ -void -Item(SV* sv = &PL_sv_undef) +#define MOUSE_TC_MAYBE 0 +#define MOUSE_TC_ARRAY_REF 1 +#define MOUSE_TC_HASH_REF 2 + +CV* +_parameterize_ArrayRef_for(SV* param) ALIAS: - Any = MOUSE_TC_ANY - Item = MOUSE_TC_ITEM - Undef = MOUSE_TC_UNDEF - Defined = MOUSE_TC_DEFINED - Bool = MOUSE_TC_BOOL - Value = MOUSE_TC_VALUE - Ref = MOUSE_TC_REF - Str = MOUSE_TC_STR - Num = MOUSE_TC_NUM - Int = MOUSE_TC_INT - ScalarRef = MOUSE_TC_SCALAR_REF - ArrayRef = MOUSE_TC_ARRAY_REF - HashRef = MOUSE_TC_HASH_REF - CodeRef = MOUSE_TC_CODE_REF - GlobRef = MOUSE_TC_GLOB_REF - FileHandle = MOUSE_TC_FILEHANDLE - RegexpRef = MOUSE_TC_REGEXP_REF - Object = MOUSE_TC_OBJECT - ClassName = MOUSE_TC_CLASS_NAME - RoleName = MOUSE_TC_ROLE_NAME + _parameterize_ArrayRef_for = MOUSE_TC_ARRAY_REF + _parameterize_HashRef_for = MOUSE_TC_HASH_REF + _parameterize_Maybe_for = MOUSE_TC_MAYBE CODE: - SvGETMAGIC(sv); - ST(0) = boolSV( mouse_builtin_tc_check(aTHX_ ix, sv) ); - XSRETURN(1); +{ + 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_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion); + INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, __is_parameterized, type_parameter); /* Mouse specific */ + + /* overload stuff */ + PL_amagic_generation++; + (void)newXS( MTC_CLASS "::()", + XS_Mouse_TypeConstraint_fallback, file); + + /* fallback => 1 */ + sv_setsv( + get_sv( MTC_CLASS "::()", GV_ADD ), + &PL_sv_yes + ); + + /* '""' => '_as_string' */ + { + SV* const code_ref = sv_2mortal(newRV_inc( + (SV*)get_cv( MTC_CLASS "::_as_string", GV_ADD ))); + sv_setsv_mg( + (SV*)gv_fetchpvs( MTC_CLASS "::(\"\"", GV_ADDMULTI, SVt_PVCV ), + code_ref ); + } + + /* '0+' => '_identity' */ + { + SV* const code_ref = sv_2mortal(newRV_inc( + (SV*)get_cv( MTC_CLASS "::_identity", GV_ADD ))); + sv_setsv_mg( + (SV*)gv_fetchpvs( MTC_CLASS "::(0+", GV_ADDMULTI, SVt_PVCV ), + code_ref ); + } + + /* '|' => '_unite' */ + { + SV* const code_ref = sv_2mortal(newRV_inc( + (SV*)get_cv( MTC_CLASS "::_unite", GV_ADD ))); + sv_setsv_mg( + (SV*)gv_fetchpvs( MTC_CLASS "::(|", GV_ADDMULTI, SVt_PVCV ), + code_ref ); + } + +UV +_identity(SV* self, ...) +CODE: +{ + if(!SvROK(self)) { + croak("Invalid object instance: '%"SVf"'", self); + } + RETVAL = PTR2UV(SvRV(self)); +} +OUTPUT: + RETVAL + +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(!IsCodeRef(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 && IsCodeRef(check))){ + mouse_throw_error(self, check, + "'%"SVf"' has no compiled type constraint", self); + } + if( items > 2 ) { + int i; + AV* av; + dMY_CXT; + SAVESPTR(MY_CXT.tc_extra_args); + av = MY_CXT.tc_extra_args = newAV_mortal(); + av_extend(av, items - 3); + for(i = 2; i < items; i++) { + av_push(av, SvREFCNT_inc_NN( ST(i) ) ); + } + } + RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE; +} +OUTPUT: + RETVAL