built-in type constraints in XS
gfx [Sun, 25 Oct 2009 05:00:47 +0000 (14:00 +0900)]
lib/Mouse/Meta/Module.pm
lib/Mouse/PurePerl.pm
lib/Mouse/Util.pm
lib/Mouse/Util/TypeConstraints.pm
mouse.h
xs-src/Mouse.xs
xs-src/mouse_optimized_tc.xs [new file with mode: 0644]

index 44e990d..c313b71 100755 (executable)
@@ -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;
     };
 }
index 07b4520..b601b29 100644 (file)
@@ -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;
 
index f24da52..dbf6cc0 100644 (file)
@@ -44,6 +44,7 @@ Mouse::Exporter->setup_import_methods(
         get_code_info
 
         get_code_package
+        get_code_ref
 
         not_supported
 
index 96a56dc..f48b6cd 100644 (file)
@@ -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 (file)
--- 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 */
 
index 5a6c844..12bcf89 100644 (file)
@@ -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 (file)
index 0000000..2da5843
--- /dev/null
@@ -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);
+}
+