From: gfx Date: Mon, 31 Aug 2009 04:36:33 +0000 (+0900) Subject: The first step of type constraints (not yet fully optimized) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=101dbab1d03339d05316a4418d0cce761a531fca;p=gitmo%2FMoose.git The first step of type constraints (not yet fully optimized) --- diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 87b2efd..f72b9e1 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -36,7 +36,7 @@ use Moose::Meta::TypeConstraint::DuckType; use Moose::Meta::TypeCoercion; use Moose::Meta::TypeCoercion::Union; use Moose::Meta::TypeConstraint::Registry; -use Moose::Util::TypeConstraints::OptimizedConstraints; +#use Moose::Util::TypeConstraints::OptimizedConstraints; Moose::Exporter->setup_import_methods( as_is => [ @@ -51,6 +51,8 @@ Moose::Exporter->setup_import_methods( _export_to_main => 1, ); +require Moose; # load XS + ## -------------------------------------------------------- ## type registry and some useful functions for it ## -------------------------------------------------------- @@ -607,14 +609,19 @@ $_->make_immutable( Moose::Meta::TypeConstraint::Registry ); -type 'Any' => where {1}; # meta-type including all +type 'Any' => where {1}, # meta-type including all + => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Any; + subtype 'Item' => as 'Any'; # base-type -subtype 'Undef' => as 'Item' => where { !defined($_) }; -subtype 'Defined' => as 'Item' => where { defined($_) }; +subtype 'Undef' => as 'Item' => where { !defined($_) }, + => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Undef; +subtype 'Defined' => as 'Item' => where { defined($_) }, + => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Defined; subtype 'Bool' => as 'Item' => - where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; + where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' } + => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Bool; subtype 'Value' => as 'Defined' => where { !ref($_) } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value; diff --git a/moose.h b/moose.h index f70a142..34bba9a 100644 --- a/moose.h +++ b/moose.h @@ -7,25 +7,65 @@ #define __attribute__format__(name, ifmt, iargs) #endif +/* Moose.xs */ void moose_throw_error(SV* const metaobject, SV* const data, const char* const fmt, ...) __attribute__format__(__printf__, 3, 4); - +/* Accessor.xs */ XS(moose_xs_accessor); XS(moose_xs_reader); XS(moose_xs_writer); CV* moose_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_impl, mop_instance_vtbl* const instance_vtbl); +/* optimized_tc.c */ +typedef enum moose_tc{ + MOOSE_TC_ANY, + MOOSE_TC_ITEM, + MOOSE_TC_UNDEF, + MOOSE_TC_DEFINED, + MOOSE_TC_BOOL, + MOOSE_TC_VALUE, + MOOSE_TC_REF, + MOOSE_TC_STR, + MOOSE_TC_NUM, + MOOSE_TC_INT, + MOOSE_TC_SCALAR_REF, + MOOSE_TC_ARRAY_REF, + MOOSE_TC_HASH_REF, + MOOSE_TC_CODE_REF, + MOOSE_TC_GLOB_REF, + MOOSE_TC_FILEHANDLE, + MOOSE_TC_REGEXP_REF, + MOOSE_TC_OBJECT, + MOOSE_TC_CLASS_NAME, + MOOSE_TC_ROLE_NAME, -#ifdef DEBUGGING -#define MOOSE_mi_access(mi, a) *moose_debug_mi_access(aTHX_ (mi) , (a)) -SV** moose_debug_mi_access(pTHX_ AV* const mi, I32 const attr_ix); -#else -#define MOOSE_mi_access(mi, a) AvARRAY((mi))[(a)] -#endif + MOOSE_TC_last +} moose_tc; + +int moose_tc_check(pTHX_ moose_tc const tc, SV* sv); +int moose_tc_Any (pTHX_ SV* const sv); +int moose_tc_Bool (pTHX_ SV* const sv); +int moose_tc_Undef (pTHX_ SV* const sv); +int moose_tc_Defined (pTHX_ SV* const sv); +int moose_tc_Value (pTHX_ SV* const sv); +int moose_tc_Num (pTHX_ SV* const sv); +int moose_tc_Int (pTHX_ SV* const sv); +int moose_tc_Str (pTHX_ SV* const sv); +int moose_tc_ClassName (pTHX_ SV* const sv); +int moose_tc_RoleName (pTHX_ SV* const sv); +int moose_tc_Ref (pTHX_ SV* const sv); +int moose_tc_ScalarRef (pTHX_ SV* const sv); +int moose_tc_ArrayRef (pTHX_ SV* const sv); +int moose_tc_HashRef (pTHX_ SV* const sv); +int moose_tc_CodeRef (pTHX_ SV* const sv); +int moose_tc_RegexpRef (pTHX_ SV* const sv); +int moose_tc_GlobRef (pTHX_ SV* const sv); +int moose_tc_FileHandle(pTHX_ SV* const sv); +int moose_tc_Object (pTHX_ SV* const sv); #endif /* !PERL_MOOSE_H */ diff --git a/xs/Moose.xs b/xs/Moose.xs index 1a5dcd3..bb638ae 100644 --- a/xs/Moose.xs +++ b/xs/Moose.xs @@ -35,6 +35,35 @@ moose_throw_error(SV* const metaobject, SV* const data, const char* const fmt, . } } +MODULE = Moose PACKAGE = Moose::Util::TypeConstraints::OptimizedConstraints + +void +Item(SV* sv = &PL_sv_undef) +ALIAS: + Any = MOOSE_TC_ANY + Item = MOOSE_TC_ITEM + Undef = MOOSE_TC_UNDEF + Defined = MOOSE_TC_DEFINED + Bool = MOOSE_TC_BOOL + Value = MOOSE_TC_VALUE + Ref = MOOSE_TC_REF + Str = MOOSE_TC_STR + Num = MOOSE_TC_NUM + Int = MOOSE_TC_INT + ScalarRef = MOOSE_TC_SCALAR_REF + ArrayRef = MOOSE_TC_ARRAY_REF + HashRef = MOOSE_TC_HASH_REF + CodeRef = MOOSE_TC_CODE_REF + GlobRef = MOOSE_TC_GLOB_REF + FileHandle = MOOSE_TC_FILEHANDLE + RegexpRef = MOOSE_TC_REGEXP_REF + Object = MOOSE_TC_OBJECT + ClassName = MOOSE_TC_CLASS_NAME + RoleName = MOOSE_TC_ROLE_NAME +CODE: + SvGETMAGIC(sv); + ST(0) = boolSV( moose_tc_check(aTHX_ ix, sv) ); + XSRETURN(1); MODULE = Moose PACKAGE = Moose::Meta::Method::Accessor diff --git a/xs/optimized_tc.c b/xs/optimized_tc.c new file mode 100755 index 0000000..3bd1fc2 --- /dev/null +++ b/xs/optimized_tc.c @@ -0,0 +1,233 @@ +/* + * full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints) + */ + +#define PERL_NO_GET_CONTEXT +#include "mop.h" +#include "moose.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 +moose_tc_check(pTHX_ moose_tc const tc, SV* const sv) { + switch(tc){ + case MOOSE_TC_ANY: return moose_tc_Any(aTHX_ sv); + case MOOSE_TC_ITEM: return moose_tc_Any(aTHX_ sv); + case MOOSE_TC_UNDEF: return moose_tc_Undef(aTHX_ sv); + case MOOSE_TC_DEFINED: return moose_tc_Defined(aTHX_ sv); + case MOOSE_TC_BOOL: return moose_tc_Bool(aTHX_ sv); + case MOOSE_TC_VALUE: return moose_tc_Value(aTHX_ sv); + case MOOSE_TC_REF: return moose_tc_Ref(aTHX_ sv); + case MOOSE_TC_STR: return moose_tc_Str(aTHX_ sv); + case MOOSE_TC_NUM: return moose_tc_Num(aTHX_ sv); + case MOOSE_TC_INT: return moose_tc_Int(aTHX_ sv); + case MOOSE_TC_SCALAR_REF: return moose_tc_ScalarRef(aTHX_ sv); + case MOOSE_TC_ARRAY_REF: return moose_tc_ArrayRef(aTHX_ sv); + case MOOSE_TC_HASH_REF: return moose_tc_HashRef(aTHX_ sv); + case MOOSE_TC_CODE_REF: return moose_tc_CodeRef(aTHX_ sv); + case MOOSE_TC_GLOB_REF: return moose_tc_GlobRef(aTHX_ sv); + case MOOSE_TC_FILEHANDLE: return moose_tc_FileHandle(aTHX_ sv); + case MOOSE_TC_REGEXP_REF: return moose_tc_RegexpRef(aTHX_ sv); + case MOOSE_TC_OBJECT: return moose_tc_Object(aTHX_ sv); + case MOOSE_TC_CLASS_NAME: return moose_tc_ClassName(aTHX_ sv); + case MOOSE_TC_ROLE_NAME: return moose_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 +moose_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) { + assert(sv); + return TRUE; +} + +int +moose_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 +moose_tc_Undef(pTHX_ SV* const sv) { /* Who use this? */ + assert(sv); + return !SvOK(sv); +} + +int +moose_tc_Defined(pTHX_ SV* const sv) { + assert(sv); + return SvOK(sv); +} + +int +moose_tc_Value(pTHX_ SV* const sv) { + assert(sv); + return SvOK(sv) && !SvROK(sv); +} + +int +moose_tc_Num(pTHX_ SV* const sv) { + assert(sv); + return LooksLikeNumber(sv); +} + +int +moose_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 +moose_tc_Str(pTHX_ SV* const sv) { + assert(sv); + return SvOK(sv) && !SvROK(sv); +} + +int +moose_tc_ClassName(pTHX_ SV* const sv){ + assert(sv); + return mop_is_class_loaded(aTHX_ sv); +} + +int +moose_tc_RoleName(pTHX_ SV* const sv) { + assert(sv); + if(mop_is_class_loaded(aTHX_ sv)){ + int ok; + SV* meta; + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv); + PUTBACK; + call_pv("Class::MOP::get_metaclass_by_name", G_SCALAR); + SPAGAIN; + meta = POPs; + PUTBACK; + + ok = mop_is_instance_of(aTHX_ meta, newSVpvs_flags("Moose::Meta::Role", SVs_TEMP)); + + FREETMPS; + LEAVE; + + return ok; + } + return FALSE; +} + +int +moose_tc_Ref(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv); +} + +int +moose_tc_ScalarRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv))); +} + +int +moose_tc_ArrayRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV; +} + +int +moose_tc_HashRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV; +} + +int +moose_tc_CodeRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV; +} + +int +moose_tc_RegexpRef(pTHX_ SV* const sv) { + assert(sv); + return SvRXOK(sv); +} + +int +moose_tc_GlobRef(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv)); +} + +int +moose_tc_FileHandle(pTHX_ SV* const sv) { + GV* gv; + assert(sv); + + gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv); + if(isGV(gv)){ + IO* const io = GvIO(gv); + + return io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) ); + } + + return mop_is_instance_of(aTHX_ sv, newSVpvs_flags("IO::Handle", SVs_TEMP)); +} + +int +moose_tc_Object(pTHX_ SV* const sv) { + assert(sv); + return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv); +} +