X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseTypeConstraints.xs;h=3f0a3d304941f2a40cfb58ce2c5179a07775c821;hb=91ee66cbb155fe48f641868aebc1c6215446e2c0;hp=bf07619554680a388e3dad81a7ff784261fb0dea;hpb=4bb92469f92834968fc1162ef086f040fa182713;p=gitmo%2FMouse.git diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs index bf07619..3f0a3d3 100644 --- a/xs-src/MouseTypeConstraints.xs +++ b/xs-src/MouseTypeConstraints.xs @@ -1,21 +1,20 @@ /* - * 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 typedef int (*check_fptr_t)(pTHX_ SV* const data, SV* const sv); +static +XSPROTO(XS_Mouse_constraint_check); + /* NOTE: mouse_tc_check() handles GETMAGIC */ @@ -59,8 +58,10 @@ mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) { } /* - 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 @@ -74,21 +75,21 @@ mouse_tc_Bool(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); if(sv_true(sv)){ - if(SvIOKp(sv)){ + if(SvPOKp(sv)){ /* "1" */ + return SvCUR(sv) == 1 && SvPVX(sv)[0] == '1'; + } + else 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 */ + /* any false value is a boolean */ return TRUE; } } @@ -124,8 +125,8 @@ S_nv_is_integer(pTHX_ NV const nv) { } else { char buf[64]; /* Must fit sprintf/Gconvert of longest NV */ - char* p; - Gconvert(nv, NV_DIG, 0, buf); + const char* p; + (void)Gconvert(nv, NV_DIG, 0, buf); p = &buf[0]; /* -?[0-9]+ */ @@ -144,18 +145,16 @@ S_nv_is_integer(pTHX_ NV const nv) { int mouse_tc_Int(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { assert(sv); - if(SvIOKp(sv)){ + if(SvPOKp(sv)){ + int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL); + 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)); } - 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; } @@ -166,7 +165,7 @@ mouse_tc_Str(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { } int -mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){ +mouse_tc_ClassName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv){ assert(sv); return is_class_loaded(sv); } @@ -180,7 +179,7 @@ mouse_tc_RoleName(pTHX_ SV* const data PERL_UNUSED_DECL, SV* const sv) { ENTER; SAVETMPS; - ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv)); + ok = is_an_instance_of("Mouse::Meta::Role", get_metaclass(sv)); FREETMPS; LEAVE; @@ -282,7 +281,7 @@ mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) { static int mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) { - if(mouse_tc_HashRef(aTHX_ NULL, sv)){ + if(IsHashRef(sv)){ HV* const hv = (HV*)SvRV(sv); HE* he; @@ -392,7 +391,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 */ @@ -548,21 +547,31 @@ mouse_generate_can_predicate_for(pTHX_ SV* const methods, const char* const pred return mouse_tc_generate(aTHX_ predicate_name, (check_fptr_t)mouse_can_methods, (SV*)param); } - -XS(XS_Mouse_constraint_check) { +static +XSPROTO(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); } +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); @@ -574,6 +583,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 @@ -662,11 +673,60 @@ BOOT: 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 */ + /* 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: @@ -679,7 +739,7 @@ CODE: 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)){ + if(!IsCodeRef(check)){ croak("Not a CODE reference"); } av_unshift(checks, 1); @@ -748,8 +808,9 @@ 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); + if(!(check && IsCodeRef(check))){ + mouse_throw_error(self, check, + "'%"SVf"' has no compiled type constraint", self); } RETVAL = mouse_tc_check(aTHX_ check, sv) ? TRUE : FALSE; }