X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=57ed21a4887361e4ec7f259e4ac8fcda43ee7d2e;hb=13f78bbc5485977c9fa0809cda34bea7481f7276;hp=5ad33898d3a51ae4a07c1daaf3134ad8d15883e3;hpb=f3e4c7ebdc35a752e69f6031121b5cab1630b09a;p=gitmo%2FMouse.git diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index 5ad3389..57ed21a 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -1,15 +1,11 @@ /* - * 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) : (I32)SvNIOKp(sv) ) -#endif - #ifndef SvRXOK #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr)) #endif @@ -392,7 +388,7 @@ mouse_lookup_isa(pTHX_ HV* const instance_stash, const char* const klass_pv){ #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* +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 */ @@ -553,16 +549,26 @@ XS(XS_Mouse_constraint_check) { dVAR; dXSARGS; MAGIC* const mg = (MAGIC*)XSANY.any_ptr; + SV* sv; 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)) ); + sv = ST(0); + SvGETMAGIC(sv); + ST(0) = boolSV( CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv) ); XSRETURN(1); } +XS(XS_Mouse_TypeConstraint_fallback); /* -Wmissing-prototypes */ +XS(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); @@ -574,6 +580,8 @@ setup_my_cxt(pTHX_ pMY_CXT){ #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 @@ -667,6 +675,45 @@ BOOT: 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 ); + } + + void compile_type_constraint(SV* self) CODE: