From: gfx <gfuji@cpan.org>
Date: Sun, 1 Nov 2009 02:47:48 +0000 (+0900)
Subject: Implement compile_type_constraint in XS
X-Git-Tag: 0.40_04~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=f790c46b83718b0665e24380b0df0c387925ea27

Implement compile_type_constraint in XS
---

diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm
index 2e97406..155c48c 100644
--- a/lib/Mouse/Meta/TypeConstraint.pm
+++ b/lib/Mouse/Meta/TypeConstraint.pm
@@ -17,8 +17,6 @@ use overload
 
 use Carp         ();
 
-my $null_check = sub { 1 };
-
 sub new {
     my($class, %args) = @_;
 
@@ -90,53 +88,6 @@ sub create_child_type{
    );
 }
 
-
-sub compile_type_constraint{
-    my($self) = @_;
-
-    # add parents first
-    my @checks;
-    for(my $parent = $self->{parent}; defined $parent; $parent = $parent->{parent}){
-         if($parent->{hand_optimized_type_constraint}){
-            unshift @checks, $parent->{hand_optimized_type_constraint};
-            last; # a hand optimized constraint must include all the parents
-        }
-        elsif($parent->{constraint}){
-            unshift @checks, $parent->{constraint};
-        }
-    }
-
-    # then add child
-    if($self->{constraint}){
-        push @checks, $self->{constraint};
-    }
-
-    if($self->{type_constraints}){ # Union
-        my @types = map{ $_->{compiled_type_constraint} } @{ $self->{type_constraints} };
-        push @checks, sub{
-            foreach my $c(@types){
-                return 1 if $c->($_[0]);
-            }
-            return 0;
-        };
-    }
-
-    if(@checks == 0){
-        $self->{compiled_type_constraint} = $null_check;
-    }
-    else{
-        $self->{compiled_type_constraint} =  sub{
-            my(@args) = @_;
-            local $_ = $args[0];
-            foreach my $c(@checks){
-                return undef if !$c->(@args);
-            }
-            return 1;
-        };
-    }
-    return;
-}
-
 sub _add_type_coercions{
     my $self = shift;
 
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index 32616b0..9b67e30 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -282,6 +282,55 @@ sub _compiled_type_coercion  { $_[0]->{_compiled_type_coercion}  }
 
 sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }
 
+
+sub compile_type_constraint{
+    my($self) = @_;
+
+    # add parents first
+    my @checks;
+    for(my $parent = $self->{parent}; defined $parent; $parent = $parent->{parent}){
+         if($parent->{hand_optimized_type_constraint}){
+            unshift @checks, $parent->{hand_optimized_type_constraint};
+            last; # a hand optimized constraint must include all the parents
+        }
+        elsif($parent->{constraint}){
+            unshift @checks, $parent->{constraint};
+        }
+    }
+
+    # then add child
+    if($self->{constraint}){
+        push @checks, $self->{constraint};
+    }
+
+    if($self->{type_constraints}){ # Union
+        my @types = map{ $_->{compiled_type_constraint} } @{ $self->{type_constraints} };
+        push @checks, sub{
+            foreach my $c(@types){
+                return 1 if $c->($_[0]);
+            }
+            return 0;
+        };
+    }
+
+    if(@checks == 0){
+        $self->{compiled_type_constraint} = \&Mouse::Util::TypeConstraints::Any;
+    }
+    else{
+        $self->{compiled_type_constraint} =  sub{
+            my(@args) = @_;
+            local $_ = $args[0];
+            foreach my $c(@checks){
+                return undef if !$c->(@args);
+            }
+            return 1;
+        };
+    }
+    return;
+}
+
+
+
 1;
 __END__
 
diff --git a/mouse.h b/mouse.h
index daf740f..d198f38 100644
--- a/mouse.h
+++ b/mouse.h
@@ -101,6 +101,13 @@ SV*  mouse_instance_set_slot   (pTHX_ SV* const instance, SV* const slot, SV* co
 SV*  mouse_instance_delete_slot(pTHX_ SV* const instance, SV* const slot);
 void mouse_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot);
 
+#define has_slot(self, key)         mouse_instance_has_slot(aTHX_ self, key)
+#define get_slot(self, key)         mouse_instance_get_slot(aTHX_ self, key)
+#define set_slot(self, key, value)  mouse_instance_set_slot(aTHX_ self, key, value)
+
+#define has_slots(self, key)        mouse_instance_has_slot(aTHX_ self, sv_2mortal(newSVpvs_share(key)))
+#define get_slots(self, key)        mouse_instance_get_slot(aTHX_ self, sv_2mortal(newSVpvs_share(key)))
+#define set_slots(self, key, value) mouse_instance_set_slot(aTHX_ self, sv_2mortal(newSVpvs_share(key)), value)
 
 /* mouse_simle_accessor.xs */
 #define INSTALL_SIMPLE_READER(klass, name)                  INSTALL_SIMPLE_READER_WITH_KEY(klass, name, name)
diff --git a/xs-src/MouseTypeConstraints.xs b/xs-src/MouseTypeConstraints.xs
index 27bf1a3..48fa08e 100644
--- a/xs-src/MouseTypeConstraints.xs
+++ b/xs-src/MouseTypeConstraints.xs
@@ -63,6 +63,7 @@ mouse_builtin_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_MAYBE:      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);
@@ -278,7 +279,7 @@ mouse_tc_Object(pTHX_ SV* const sv) {
 
 /* Parameterized type constraints */
 
-int
+static int
 mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
     if(mouse_tc_ArrayRef(aTHX_ sv)){
         AV* const av  = (AV*)SvRV(sv);
@@ -296,7 +297,7 @@ mouse_parameterized_ArrayRef(pTHX_ SV* const param, SV* const sv) {
     return FALSE;
 }
 
-int
+static int
 mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
     if(mouse_tc_HashRef(aTHX_ sv)){
         HV* const hv  = (HV*)SvRV(sv);
@@ -315,7 +316,7 @@ mouse_parameterized_HashRef(pTHX_ SV* const param, SV* const sv) {
     return FALSE;
 }
 
-int
+static int
 mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
     if(SvOK(sv)){
         return mouse_tc_check(aTHX_ param, sv);
@@ -323,6 +324,41 @@ mouse_parameterized_Maybe(pTHX_ SV* const param, SV* const sv) {
     return TRUE;
 }
 
+static int
+mouse_types_union_check(pTHX_ AV* const types, SV* const sv) {
+    I32 const len = AvFILLp(types) + 1;
+    I32 i;
+
+    for(i = 0; i < len; i++){
+        if(mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
+            return TRUE;
+        }
+    }
+
+    return FALSE;
+}
+
+static int
+mouse_types_check(pTHX_ AV* const types, SV* const sv) {
+    I32 const len = AvFILLp(types) + 1;
+    I32 i;
+
+    ENTER;
+    SAVE_DEFSV;
+    DEFSV_set(sv);
+
+    for(i = 0; i < len; i++){
+        if(!mouse_tc_check(aTHX_ AvARRAY(types)[i], sv)){
+            LEAVE;
+            return FALSE;
+        }
+    }
+
+    LEAVE;
+
+    return TRUE;
+}
+
 /*
  *  This class_type generator is taken from Scalar::Util::Instance
  */
@@ -568,3 +604,85 @@ CODE:
 OUTPUT:
     RETVAL
 
+MODULE = Mouse::Util::TypeConstraints    PACKAGE = Mouse::Meta::TypeConstraint
+
+void
+compile_type_constraint(SV* self)
+CODE:
+{
+    AV* const checks = newAV();
+    SV* check; /* check function */
+    SV* parent;
+    SV* types_ref;
+
+    sv_2mortal((SV*)checks);
+
+    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_ check)){
+                croak("Not a CODE reference");
+            }
+            av_unshift(checks, 1);
+            av_store(checks, 0, newSVsv(check));
+            break; /* a hand optimized constraint must include all the parent */
+        }
+
+        check = get_slots(parent, "constraint");
+        if(check && SvOK(check)){
+            if(!mouse_tc_CodeRef(aTHX_ check)){
+                croak("Not a CODE reference");
+            }
+            av_unshift(checks, 1);
+            av_store(checks, 0, newSVsv(check));
+        }
+    }
+
+    check = get_slots(self, "constraint");
+    if(check && SvOK(check)){
+        if(!mouse_tc_CodeRef(aTHX_ check)){
+            croak("Not a CODE reference");
+        }
+        av_push(checks, newSVsv(check));
+    }
+
+    types_ref = get_slots(self, "type_constraints");
+    if(types_ref && SvOK(types_ref)){ /* union type */
+        AV* types;
+        AV* union_checks;
+        CV* union_check;
+        I32 len;
+        I32 i;
+
+        if(!mouse_tc_ArrayRef(aTHX_ types_ref)){
+            croak("Not an ARRAY reference");
+        }
+        types = (AV*)SvRV(types_ref);
+        len = av_len(types) + 1;
+
+        union_checks = newAV();
+        sv_2mortal((SV*)union_checks);
+
+        for(i = 0; i < len; i++){
+            SV* const tc = *av_fetch(types, i, TRUE);
+            SV* const c  = get_slots(tc, "compiled_type_constraint");
+            if(!(c && mouse_tc_CodeRef(aTHX_ c))){
+                sv_dump(self);
+                croak("'%"SVf"' has no compiled type constraint", self);
+            }
+            av_push(union_checks, newSVsv(c));
+        }
+
+        union_check = mouse_tc_parameterize(aTHX_ NULL, (check_fptr_t)mouse_types_union_check, (SV*)union_checks);
+        av_push(checks, newRV_inc((SV*)union_check));
+    }
+
+    if(AvFILLp(checks) < 0){
+        check = newRV_inc((SV*)get_cv("Mouse::Util::TypeConstraints::Any", TRUE));
+    }
+    else{
+        check = newRV_inc((SV*)mouse_tc_parameterize(aTHX_ NULL, (check_fptr_t)mouse_types_check, (SV*)checks));
+    }
+    set_slots(self, "compiled_type_constraint", check);
+}
+