From: gfx Date: Sun, 25 Oct 2009 05:00:47 +0000 (+0900) Subject: built-in type constraints in XS X-Git-Tag: 0.40_01~25 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d96ae4dfb9f6806432c90c33bb2d3a5bf63a9a7;p=gitmo%2FMouse.git built-in type constraints in XS --- diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 44e990d..c313b71 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -1,5 +1,5 @@ package Mouse::Meta::Module; -use Mouse::Util qw/:meta get_code_package load_class not_supported/; # enables strict and warnings +use Mouse::Util qw/:meta get_code_package get_code_ref load_class not_supported/; # enables strict and warnings use Carp (); use Scalar::Util qw/blessed weaken/; @@ -110,7 +110,7 @@ sub has_method { return 1 if $self->{methods}{$method_name}; - my $code = $self->_get_code_ref($method_name); + my $code = get_code_ref($self->{package}, $method_name); return $code && $self->_code_is_mine($code); } @@ -122,7 +122,7 @@ sub get_method_body{ or $self->throw_error('You must define a method name'); return $self->{methods}{$method_name} ||= do{ - my $code = $self->_get_code_ref($method_name); + my $code = get_code_ref($self->{package}, $method_name); ($code && $self->_code_is_mine($code)) ? $code : undef; }; } diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 07b4520..b601b29 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -66,6 +66,47 @@ sub get_code_package{ return $gv->STASH->NAME; } +sub get_code_ref{ + my($package, $name) = @_; + no strict 'refs'; + no warnings 'once'; + use warnings FATAL => 'uninitialized'; + return *{$package . '::' . $name}{CODE}; +} + +package + Mouse::Util::TypeConstraints; + +sub Any { 1 } +sub Item { 1 } +sub Maybe { 1 } + +sub Bool { $_[0] ? $_[0] eq '1' : 1 } +sub Undef { !defined($_[0]) } +sub Defined { defined($_[0]) } +sub Value { defined($_[0]) && !ref($_[0]) } +sub Num { !ref($_[0]) && looks_like_number($_[0]) } +sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } +sub Str { defined($_[0]) && !ref($_[0]) } + +sub Ref { ref($_[0]) } +sub ScalarRef { ref($_[0]) eq 'SCALAR' } +sub ArrayRef { ref($_[0]) eq 'ARRAY' } +sub HashRef { ref($_[0]) eq 'HASH' } +sub CodeRef { ref($_[0]) eq 'CODE' } +sub RegexpRef { ref($_[0]) eq 'Regexp' } +sub GlobRef { ref($_[0]) eq 'GLOB' } + +sub FileHandle { + openhandle($_[0]) || (blessed($_[0]) && $_[0]->isa("IO::Handle")) +} + +sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } + +sub ClassName { Mouse::Util::is_class_loaded($_[0]) } +sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') } + + package Mouse::Meta::Module; diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index f24da52..dbf6cc0 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -44,6 +44,7 @@ Mouse::Exporter->setup_import_methods( get_code_info get_code_package + get_code_ref not_supported diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 96a56dc..f48b6cd 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -32,32 +32,28 @@ BEGIN { Item => undef, # null check Maybe => undef, # null check - Bool => sub { $_[0] ? $_[0] eq '1' : 1 }, - Undef => sub { !defined($_[0]) }, - Defined => sub { defined($_[0]) }, - Value => sub { defined($_[0]) && !ref($_[0]) }, - Num => sub { !ref($_[0]) && looks_like_number($_[0]) }, - Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }, - Str => sub { defined($_[0]) && !ref($_[0]) }, - Ref => sub { ref($_[0]) }, - - ScalarRef => sub { ref($_[0]) eq 'SCALAR' }, - ArrayRef => sub { ref($_[0]) eq 'ARRAY' }, - HashRef => sub { ref($_[0]) eq 'HASH' }, - CodeRef => sub { ref($_[0]) eq 'CODE' }, - RegexpRef => sub { ref($_[0]) eq 'Regexp' }, - GlobRef => sub { ref($_[0]) eq 'GLOB' }, - - FileHandle => sub { - ref($_[0]) eq 'GLOB' && openhandle($_[0]) - or - blessed($_[0]) && $_[0]->isa("IO::Handle") - }, - - Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }, - - ClassName => sub { Mouse::Util::is_class_loaded($_[0]) }, - RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') }, + Bool => \&Bool, + Undef => \&Undef, + Defined => \&Defined, + Value => \&Value, + Num => \&Num, + Int => \&Int, + Str => \&Str, + Ref => \&Ref, + + ScalarRef => \&ScalarRef, + ArrayRef => \&ArrayRef, + HashRef => \&HashRef, + CodeRef => \&CodeRef, + RegexpRef => \&RegexpRef, + GlobRef => \&GlobRef, + + FileHandle => \&FileHandle, + + Object => \&Object, + + ClassName => \&ClassName, + RoleName => \&RoleName, ); while (my ($name, $code) = each %builtins) { diff --git a/mouse.h b/mouse.h index 781d149..0ebe38c 100644 --- a/mouse.h +++ b/mouse.h @@ -82,5 +82,55 @@ XS(mouse_xs_simple_reader); XS(mouse_xs_simple_writer); XS(mouse_xs_simple_predicate); +typedef enum mouse_tc{ + MOUSE_TC_ANY, + MOUSE_TC_ITEM, + MOUSE_TC_UNDEF, + MOUSE_TC_DEFINED, + MOUSE_TC_BOOL, + MOUSE_TC_VALUE, + MOUSE_TC_REF, + MOUSE_TC_STR, + MOUSE_TC_NUM, + MOUSE_TC_INT, + MOUSE_TC_SCALAR_REF, + MOUSE_TC_ARRAY_REF, + MOUSE_TC_HASH_REF, + MOUSE_TC_CODE_REF, + MOUSE_TC_GLOB_REF, + MOUSE_TC_FILEHANDLE, + MOUSE_TC_REGEXP_REF, + MOUSE_TC_OBJECT, + MOUSE_TC_CLASS_NAME, + MOUSE_TC_ROLE_NAME, + + MOUSE_TC_last +} mouse_tc; + +/* type constraints */ + +int mouse_tc_check(pTHX_ mouse_tc const tc, SV* sv); + +int mouse_tc_Any (pTHX_ SV* const sv); +int mouse_tc_Bool (pTHX_ SV* const sv); +int mouse_tc_Undef (pTHX_ SV* const sv); +int mouse_tc_Defined (pTHX_ SV* const sv); +int mouse_tc_Value (pTHX_ SV* const sv); +int mouse_tc_Num (pTHX_ SV* const sv); +int mouse_tc_Int (pTHX_ SV* const sv); +int mouse_tc_Str (pTHX_ SV* const sv); +int mouse_tc_ClassName (pTHX_ SV* const sv); +int mouse_tc_RoleName (pTHX_ SV* const sv); +int mouse_tc_Ref (pTHX_ SV* const sv); +int mouse_tc_ScalarRef (pTHX_ SV* const sv); +int mouse_tc_ArrayRef (pTHX_ SV* const sv); +int mouse_tc_HashRef (pTHX_ SV* const sv); +int mouse_tc_CodeRef (pTHX_ SV* const sv); +int mouse_tc_RegexpRef (pTHX_ SV* const sv); +int mouse_tc_GlobRef (pTHX_ SV* const sv); +int mouse_tc_FileHandle(pTHX_ SV* const sv); +int mouse_tc_Object (pTHX_ SV* const sv); + + #endif /* !MOUSE_H */ diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 5a6c844..12bcf89 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -41,49 +41,33 @@ CODE: OUTPUT: RETVAL -MODULE = Mouse PACKAGE = Mouse::Meta::Module - -BOOT: - INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package); - INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods); - INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes); - -HV* -namespace(SV* self) -CODE: -{ - SV* const package = mouse_instance_get_slot(self, mouse_package); - if(!(package && SvOK(package))){ - croak("No package name"); - } - RETVAL = gv_stashsv(package, GV_ADDMULTI); -} -OUTPUT: - RETVAL - CV* -_get_code_ref(SV* self, SV* name) +get_code_ref(SV* package, SV* name) CODE: { - SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */ HV* stash; HE* he; - if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){ - croak("namespace() didn't return a HASH reference"); + + if(!SvOK(package)){ + croak("You must define a package name"); + } + if(!SvOK(name)){ + croak("You must define a subroutine name"); + } + + stash = gv_stashsv(package, FALSE); + if(!stash){ + XSRETURN_UNDEF; } - stash = (HV*)SvRV(stash_ref); he = hv_fetch_ent(stash, name, FALSE, 0U); if(he){ GV* const gv = (GV*)hv_iterval(stash, he); - if(isGV(gv)){ - RETVAL = GvCVu(gv); - } - else{ /* special constant or stub */ + if(!isGV(gv)){ /* special constant or stub */ STRLEN len; const char* const pv = SvPV_const(name, len); gv_init(gv, stash, pv, len, GV_ADDMULTI); - RETVAL = GvCVu(gv); } + RETVAL = GvCVu(gv); } else{ RETVAL = NULL; @@ -97,6 +81,57 @@ OUTPUT: RETVAL +MODULE = Mouse PACKAGE = Mouse::Util::TypeConstraints + +void +Item(SV* sv = &PL_sv_undef) +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 +CODE: + SvGETMAGIC(sv); + ST(0) = boolSV( mouse_tc_check(aTHX_ ix, sv) ); + XSRETURN(1); + + +MODULE = Mouse PACKAGE = Mouse::Meta::Module + +BOOT: + INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package); + INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods); + INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes); + +HV* +namespace(SV* self) +CODE: +{ + SV* const package = mouse_instance_get_slot(self, mouse_package); + if(!(package && SvOK(package))){ + croak("No package name"); + } + RETVAL = gv_stashsv(package, GV_ADDMULTI); +} +OUTPUT: + RETVAL + MODULE = Mouse PACKAGE = Mouse::Meta::Class BOOT: @@ -180,4 +215,3 @@ BOOT: INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */ INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion); - diff --git a/xs-src/mouse_optimized_tc.xs b/xs-src/mouse_optimized_tc.xs new file mode 100644 index 0000000..2da5843 --- /dev/null +++ b/xs-src/mouse_optimized_tc.xs @@ -0,0 +1,235 @@ +/* + * 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 + + +int +mouse_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". +*/ + +int +mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) { + assert(sv); + return TRUE; +} + +int +mouse_tc_Bool(pTHX_ SV* const sv) { + assert(sv); + if(SvOK(sv)){ + if(SvIOKp(sv)){ + return SvIVX(sv) == 1 || SvIVX(sv) == 0; + } + else if(SvNOKp(sv)){ + return SvNVX(sv) == 1.0 || SvNVX(sv) == 0.0; + } + else if(SvPOKp(sv)){ /* "" or "1" or "0" */ + return SvCUR(sv) == 0 + || ( SvCUR(sv) == 1 && ( SvPVX(sv)[0] == '1' || SvPVX(sv)[0] == '0' ) ); + } + else{ + return FALSE; + } + } + else{ + return TRUE; + } +} + +int +mouse_tc_Undef(pTHX_ SV* const sv) { + assert(sv); + return !SvOK(sv); +} + +int +mouse_tc_Defined(pTHX_ SV* const sv) { + assert(sv); + return SvOK(sv); +} + +int +mouse_tc_Value(pTHX_ SV* const sv) { + assert(sv); + return SvOK(sv) && !SvROK(sv); +} + +int +mouse_tc_Num(pTHX_ SV* const sv) { + assert(sv); + return LooksLikeNumber(sv); +} + +int +mouse_tc_Int(pTHX_ SV* const sv) { + assert(sv); + if(SvIOKp(sv)){ + return TRUE; + } + else if(SvNOKp(sv)){ + NV const nv = SvNVX(sv); + return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv); + } + 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 sv) { + assert(sv); + return SvOK(sv) && !SvROK(sv) && !isGV(sv); +} + +int +mouse_tc_ClassName(pTHX_ SV* const sv){ + assert(sv); + return is_class_loaded(sv); +} + +int +mouse_tc_RoleName(pTHX_ 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)); + + FREETMPS; + LEAVE; + + return ok; + } + return FALSE; +} + +int +mouse_tc_Ref(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv); +} + +int +mouse_tc_ScalarRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv))); +} + +int +mouse_tc_ArrayRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV; +} + +int +mouse_tc_HashRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV; +} + +int +mouse_tc_CodeRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV; +} + +int +mouse_tc_RegexpRef(pTHX_ SV* const sv) { + assert(sv); + return SvRXOK(sv); +} + +int +mouse_tc_GlobRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv)); +} + +int +mouse_tc_FileHandle(pTHX_ 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_instance_of(sv, newSVpvs_flags("IO::Handle", SVs_TEMP)); +} + +int +mouse_tc_Object(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv); +} +