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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
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);
+}
+