faster type constraints
Yuval Kogman [Sun, 13 Jan 2008 23:51:35 +0000 (23:51 +0000)]
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/TypeCoercion.pm
lib/Moose/Meta/TypeConstraint.pm
lib/Moose/Util/TypeConstraints.pm
lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm

index 104151d..9a7545e 100644 (file)
@@ -277,7 +277,7 @@ sub set_value {
         if ($self->should_coerce) {
             $value = $type_constraint->coerce($value);
         }
-        defined($type_constraint->_compiled_type_constraint->($value))
+        $type_constraint->_compiled_type_constraint->($value)
                 || confess "Attribute ($attr_name) does not pass the type constraint ("
                . $type_constraint->name
                . ") with "
index 36acba4..7ace8e7 100644 (file)
@@ -55,7 +55,7 @@ sub compile_type_coercion {
         my $thing = shift;
         foreach my $coercion (@coercions) {
             my ($constraint, $converter) = @$coercion;
-            if (defined $constraint->($thing)) {
+            if ($constraint->($thing)) {
                 local $_ = $thing;                
                 return $converter->($thing);
             }
@@ -154,4 +154,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut
index 691337c..b37ee8a 100644 (file)
@@ -58,7 +58,7 @@ sub new {
 }
 
 sub coerce   { ((shift)->coercion || confess "Cannot coerce without a type coercion")->coerce(@_) }
-sub check    { $_[0]->_compiled_type_constraint->($_[1]) }
+sub check    { $_[0]->_compiled_type_constraint->($_[1]) ? 1 : undef }
 sub validate {
     my ($self, $value) = @_;
     if ($self->_compiled_type_constraint->($value)) {
@@ -124,11 +124,9 @@ sub _compile_hand_optimized_type_constraint {
 
     my $type_constraint = $self->hand_optimized_type_constraint;
 
-    return sub {
-        confess unless ref $type_constraint;
-        return undef unless $type_constraint->($_[0]);
-        return 1;
-    };
+    confess unless ref $type_constraint;
+
+    return $type_constraint;
 }
 
 sub _compile_subtype {
index 5af8dc5..2d6a438 100644 (file)
@@ -98,8 +98,8 @@ sub export_type_constraints_as_functions {
     my $pkg = caller();
     no strict 'refs';
     foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
-        *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
-                                              ->_compiled_type_constraint;
+        my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint;
+        *{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef };
     }
 }
 
index 47ea4e9..0576a14 100644 (file)
@@ -24,12 +24,15 @@ sub Num { !ref($_[0]) && looks_like_number($_[0]) }
 
 sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
 
-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'   }
+{
+    no warnings 'uninitialized';
+    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 { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) }