From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 17 Apr 2010 04:17:04 +0000 (-0500)
Subject: slightly more efficient inlined constraints
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0355297f0cb172878293cf171a9160d7de01500e;p=gitmo%2FMoose.git

slightly more efficient inlined constraints
---

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 27f04c3..dfebe59 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -230,7 +230,7 @@ sub _compile_hand_optimized_type_constraint {
 sub _compile_hand_optimized_inline_type_constraint {
     my $self = shift;
 
-    my $inline_type_constraint = $self->hand_optimized_inline_type_constraint;
+    my $inline_type_constraint = $self->hand_optimized_inline_type_constraint->('$_[0]');
     local $@;
     my $type_constraint = $self->_eval_in_emptyish_lexical_scope("sub { $inline_type_constraint }");
 
@@ -345,11 +345,9 @@ sub inline_check_of {
     $constraint_var ||= '$constraint';
     $value_var      ||= '$_';
     if ($self->has_hand_optimized_inline_type_constraint) {
-        return 'do { local @_ = ('
-            . $value_var
-            . ');'
-            . $self->hand_optimized_inline_type_constraint
-            . '}';
+        return 'do { '
+             . $self->hand_optimized_inline_type_constraint->($value_var)
+             . ' }';
     }
     else {
         return "$constraint_var->check($value_var)";
diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 9109bbd..3374b64 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -42,7 +42,7 @@ Moose::Exporter->setup_import_methods(
     as_is => [
         qw(
             type subtype class_type role_type maybe_type duck_type
-            as where message optimize_as
+            as where message optimize_as inline_as
             coerce from via
             enum
             find_type_constraint
@@ -284,7 +284,7 @@ sub type {
 
     return _create_type_constraint(
         $name, undef, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -329,7 +329,7 @@ sub subtype {
 
     return _create_type_constraint(
         $name, $p{as}, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -399,7 +399,7 @@ sub as { { as => shift }, @_ }
 sub where (&)       { { where       => $_[0] } }
 sub message (&)     { { message     => $_[0] } }
 sub optimize_as (&) { { optimize_as => $_[0] } }
-sub inline_as       { { optimize_as => $_[0] } }
+sub inline_as (&)   { { inline_as => $_[0] } }
 
 sub from    {@_}
 sub via (&) { $_[0] }
@@ -486,12 +486,13 @@ sub match_on_type {
 ## desugaring functions ...
 ## --------------------------------------------------------
 
-sub _create_type_constraint ($$$;$$) {
+sub _create_type_constraint ($$$;$$$) {
     my $name      = shift;
     my $parent    = shift;
     my $check     = shift;
     my $message   = shift;
     my $optimized = shift;
+    my $inlined   = shift;
 
     my $pkg_defined_in = scalar( caller(1) );
 
@@ -515,13 +516,10 @@ sub _create_type_constraint ($$$;$$) {
         name               => $name,
         package_defined_in => $pkg_defined_in,
 
-        ( $check     ? ( constraint => $check )     : () ),
-        ( $message   ? ( message    => $message )   : () ),
-        ( $optimized
-              ? ref($optimized)
-                  ? ( optimized  => $optimized )
-                  : ( inline_optimized => $optimized )
-              : () ),
+        ( $check     ? ( constraint => $check )         : () ),
+        ( $message   ? ( message    => $message )       : () ),
+        ( $optimized ? ( optimized  => $optimized )     : () ),
+        ( $inlined   ? ( inline_optimized => $inlined ) : () ),
     );
 
     my $constraint;
@@ -662,28 +660,30 @@ subtype 'Bool' => as 'Item' =>
     where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
 
 subtype 'Value' => as 'Defined' => where { !ref($_) } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineValue;
+    inline_as \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineValue;
 
 subtype 'Ref' => as 'Defined' => where { ref($_) } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineRef;
+    inline_as \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineRef;
 
 subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineStr;
+    inline_as \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineStr;
 
 subtype 'Num' => as 'Str' =>
     where { Scalar::Util::looks_like_number($_) } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineNum;
+    inline_as \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineNum;
 
 subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineInt;
+    inline_as \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineInt;
 
 subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineCodeRef;
+    inline_as
+        \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineCodeRef;
 subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } =>
     inline_as
-        Moose::Util::TypeConstraints::OptimizedConstraints::InlineRegexpRef;
+        \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineRegexpRef;
 subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineGlobRef;
+    inline_as
+        \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineGlobRef;
 
 # NOTE:
 # scalar filehandles are GLOB refs,
@@ -691,13 +691,14 @@ subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } =>
 subtype 'FileHandle' => as 'GlobRef' => where {
     Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") );
 } => inline_as
-    Moose::Util::TypeConstraints::OptimizedConstraints::InlineFileHandle;
+    \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineFileHandle;
 
 # NOTE:
 # blessed(qr/.../) returns true,.. how odd
 subtype 'Object' => as 'Ref' =>
     where { blessed($_) && blessed($_) ne 'Regexp' } =>
-    inline_as Moose::Util::TypeConstraints::OptimizedConstraints::InlineObject;
+    inline_as
+        \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineObject;
 
 # This type is deprecated.
 subtype 'Role' => as 'Object' => where { $_->can('does') } =>
@@ -705,12 +706,12 @@ subtype 'Role' => as 'Object' => where { $_->can('does') } =>
 
 subtype 'ClassName' => as 'Str' =>
     where { Class::MOP::is_class_loaded($_) } => inline_as
-    Moose::Util::TypeConstraints::OptimizedConstraints::InlineClassName;
+    \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineClassName;
 
 subtype 'RoleName' => as 'ClassName' => where {
     (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
 } => inline_as
-    Moose::Util::TypeConstraints::OptimizedConstraints::InlineRoleName;
+    \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineRoleName;
 
 ## --------------------------------------------------------
 # parameterizable types ...
@@ -722,7 +723,7 @@ $REGISTRY->add_type_constraint(
         parent             => find_type_constraint('Ref'),
         constraint         => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
         inline_optimized   =>
-            Moose::Util::TypeConstraints::OptimizedConstraints::InlineScalarRef,
+            \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineScalarRef,
         constraint_generator => sub {
             my $type_parameter = shift;
             my $check          = $type_parameter->_compiled_type_constraint;
@@ -740,7 +741,7 @@ $REGISTRY->add_type_constraint(
         parent             => find_type_constraint('Ref'),
         constraint         => sub { ref($_) eq 'ARRAY' },
         inline_optimized   =>
-            Moose::Util::TypeConstraints::OptimizedConstraints::InlineArrayRef,
+            \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineArrayRef,
         constraint_generator => sub {
             my $type_parameter = shift;
             my $check          = $type_parameter->_compiled_type_constraint;
@@ -761,7 +762,7 @@ $REGISTRY->add_type_constraint(
         parent             => find_type_constraint('Ref'),
         constraint         => sub { ref($_) eq 'HASH' },
         inline_optimized   =>
-            Moose::Util::TypeConstraints::OptimizedConstraints::InlineHashRef,
+            \&Moose::Util::TypeConstraints::OptimizedConstraints::InlineHashRef,
         constraint_generator => sub {
             my $type_parameter = shift;
             my $check          = $type_parameter->_compiled_type_constraint;
@@ -781,7 +782,7 @@ $REGISTRY->add_type_constraint(
         package_defined_in   => __PACKAGE__,
         parent               => find_type_constraint('Item'),
         constraint           => sub {1},
-        inline_optimized     => '1',
+        inline_optimized     => sub {1},
         constraint_generator => sub {
             my $type_parameter = shift;
             my $check          = $type_parameter->_compiled_type_constraint;
diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
index 3108a1a..7abcb8a 100644
--- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
@@ -11,48 +11,48 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 
 sub InlineValue {
-    'defined($_[0]) && !ref($_[0])';
+    qq{defined($_[0]) && !ref($_[0])};
 }
-sub InlineRef { 'ref($_[0])' }
+sub InlineRef { qq{ref($_[0])} }
 
 # We need to use a temporary here to flatten LVALUEs, for instance as in
 # Str(substr($_,0,255)).
 sub InlineStr {
-    q{my $value = $_[0];}
-        . q{defined($value) && ref(\$value) eq 'SCALAR'}
+    qq{my \$value = $_[0];}
+        . qq{defined(\$value) && ref(\\\$value) eq 'SCALAR'}
 }
 
 sub InlineNum {
-    q{!ref($_[0]) && Scalar::Util::looks_like_number($_[0])}
+    qq{!ref($_[0]) && Scalar::Util::looks_like_number($_[0])}
 }
 
 sub InlineInt {
-    q{defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/}
+    qq{defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+\$/}
 }
 
-sub InlineScalarRef { q{ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF'} }
-sub InlineArrayRef  { q{ref($_[0]) eq 'ARRAY'}                         }
-sub InlineHashRef   { q{ref($_[0]) eq 'HASH'}                          }
-sub InlineCodeRef   { q{ref($_[0]) eq 'CODE'}                          }
-sub InlineRegexpRef { q{ref($_[0]) eq 'Regexp'}                        }
-sub InlineGlobRef   { q{ref($_[0]) eq 'GLOB'}                          }
+sub InlineScalarRef { qq{ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF'} }
+sub InlineArrayRef  { qq{ref($_[0]) eq 'ARRAY'}                         }
+sub InlineHashRef   { qq{ref($_[0]) eq 'HASH'}                          }
+sub InlineCodeRef   { qq{ref($_[0]) eq 'CODE'}                          }
+sub InlineRegexpRef { qq{ref($_[0]) eq 'Regexp'}                        }
+sub InlineGlobRef   { qq{ref($_[0]) eq 'GLOB'}                          }
 
 sub InlineFileHandle {
-        q{(ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]))}
-  . q{ or (Scalar::Util::blessed($_[0]) && $_[0]->isa('IO::Handle'))}
+        qq{(ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]))}
+  . qq{ or (Scalar::Util::blessed($_[0]) && $_[0]->isa('IO::Handle'))}
 }
 
 sub InlineObject {
-    q{Scalar::Util::blessed($_[0]) && Scalar::Util::blessed($_[0]) ne 'Regexp'}
+    qq{Scalar::Util::blessed($_[0]) && Scalar::Util::blessed($_[0]) ne 'Regexp'}
 }
 
 sub Role { Carp::cluck('The Role type is deprecated.'); Scalar::Util::blessed($_[0]) && $_[0]->can('does') }
 
-sub InlineClassName { q{Class::MOP::is_class_loaded($_[0])} }
+sub InlineClassName { qq{Class::MOP::is_class_loaded($_[0])} }
 
 sub InlineRoleName {
-    InlineClassName()
-  . q{ && (Class::MOP::class_of($_[0]) || return)->isa('Moose::Meta::Role')}
+    InlineClassName(@_)
+  . qq{ && (Class::MOP::class_of($_[0]) || return)->isa('Moose::Meta::Role')}
 }
 
 # NOTE: