Make is_* and to_* subs faster

Changes

@@ -1,6 +1,8 @@
 Revision history for MooseX-Types
 
 {{$NEXT}}
+        - made the exported is_Foo and to_Foo subs much faster, especially for
+          type constraints which can be inlined.
 
 0.48      2016-12-07 01:15:14Z
         - reverted is_Foo and to_Foo refactoring [from 0.47] for now, so they

eg/benchmarks.pl

@@ -0,0 +1,91 @@
+use strict;
+use warnings;
+
+{
+    package MXT;
+
+    use MooseX::Types -declare => [qw( HasCoercion NonInline )];
+    use MooseX::Types::Moose qw( Int Num Value );
+
+    subtype HasCoercion, as Int;
+    coerce HasCoercion,
+        from Num,
+        via { return int( $_[0] ) };
+
+    subtype NonInline,
+        as Value,
+        where { $_ eq 'foo' || $_ eq 'bar' };
+}
+
+{
+    package T;
+
+    use Moose::Util::TypeConstraints;
+
+    our $arrayref   = find_type_constraint('ArrayRef');
+    our $int        = find_type_constraint('Int');
+    our $str        = find_type_constraint('Str');
+    our $non_inline = subtype(
+        as 'Value',
+        where { $_ eq 'foo' || $_ eq 'bar' },
+    );
+}
+
+use Benchmark qw( cmpthese timethese );
+
+use MooseX::Types::Moose qw( ArrayRef Int Str );
+MXT->import( qw( HasCoercion NonInline ) );
+
+my @items = ( undef, 42, 42.123, 'foo', [], {}, $T::arrayref );
+
+sub plain_moose {
+    for my $item (@items) {
+        $T::arrayref->check($item);
+        $T::int->check($item);
+        $T::str->check($item);
+        $T::non_inline->check($item);
+    }
+}
+
+sub moosex_types_is {
+    for my $item (@items) {
+        is_ArrayRef($item);
+        is_Int($item);
+        is_Str($item);
+        is_NonInline($item);
+    }
+}
+
+sub moosex_types_check {
+    for my $item (@items) {
+        ArrayRef()->check($item);
+        Int()->check($item);
+        Str()->check($item);
+        NonInline()->check($item);
+    }
+}
+
+print "\n";
+
+cmpthese(
+    50_000,
+    {
+        'HasCoercion()->coerce' => sub {
+            HasCoercion()->coerce($_) for @items;
+        },
+        'to_HasCoercion' => sub {
+            to_HasCoercion($_) for @items;
+        },
+    },
+);
+
+print "\n";
+
+cmpthese(
+    50_000,
+    {
+        'plain Moose'                 => \&plain_moose,
+        'MooseX::Types is_*'          => \&moosex_types_is,
+        'MooseX::Types Type()->check' => \&moosex_types_check,
+    },
+);

lib/MooseX/Types.pm

@@ -12,6 +12,7 @@ use MooseX::Types::Util               qw( filter_tags );
 use MooseX::Types::UndefinedType;
 use MooseX::Types::CheckedUtilExports ();
 use Carp::Clan                        qw( ^MooseX::Types );
+use Sub::Defer                        qw( defer_sub );
 use Sub::Name;
 use Scalar::Util                      qw( reftype );
 use Sub::Exporter::ForMethods 0.100052 'method_installer';  # for 'rebless'
@@ -486,17 +487,20 @@ This generates a coercion handler function, e.g. C<to_Int($value)>.
 
 sub coercion_export_generator {
     my ($class, $type, $full, $undef_msg) = @_;
-    return sub {
+    return defer_sub undef, sub {
         my ($value) = @_;
 
         # we need a type object
         my $tobj = find_type_constraint($full) or croak $undef_msg;
-        my $return = $tobj->coerce($value);
 
-        # non-successful coercion returns false
-        return unless $tobj->check($return);
+        return sub {
+            my $return = $tobj->coerce($_[0]);
 
-        return $return;
+            # non-successful coercion returns false
+            return unless $tobj->check($return);
+
+            return $return;
+        };
     }
 }
 
@@ -508,13 +512,16 @@ Generates a constraint check closure, e.g. C<is_Int($value)>.
 
 sub check_export_generator {
     my ($class, $type, $full, $undef_msg) = @_;
-    return sub {
+
+    return defer_sub undef, sub {
         my ($value) = @_;
 
         # we need a type object
         my $tobj = find_type_constraint($full) or croak $undef_msg;
 
-        return $tobj->check($value);
+        # This method will actually compile an inlined sub if possible. If
+        # not, it will return something like sub { $tobj->check($_[0]) }
+        return $tobj->_compiled_type_constraint;
     }
 }
 

lib/MooseX/Types/Base.pm

@@ -43,7 +43,7 @@ sub import {
     delete @ex_spec{ qw(-wrapper -into -full) };
 
     unless ($options) {
-        $options = {foo => 23};
+        $options = {};
         unshift @args, $options;
     }
 
@@ -76,16 +76,19 @@ sub import {
             };
 
         # the check helper
+        my $check_name = "is_${type_short}";
         push @{ $ex_spec{exports} },
-            "is_${type_short}",
+            $check_name,
             sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
 
         # only export coercion helper if full (for libraries) or coercion is defined
         next TYPE
             unless $options->{ -full }
             or ($type_cons and $type_cons->has_coercion);
+
+        my $coercion_name = "to_${type_short}";
         push @{ $ex_spec{exports} },
-            "to_${type_short}",
+            $coercion_name,
             sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
         $ex_util{ $type_short }{to}++;  # shortcut to remember this exists
     }

t/11_library-definition.t

@@ -13,6 +13,28 @@ my @tests = (
     [ 'IntArrayRef', 12, [12], {}, [17, 23], {} ],
 );
 
+{
+    is_deeply(
+        to_IntArrayRef(42), [42],
+        'to_IntArrayRef works on first call'
+    );
+    is_deeply(
+        to_IntArrayRef(84), [84],
+        'to_IntArrayRef works on second call and does not close over first value'
+    );
+}
+
+{
+    ok(
+        is_IntArrayRef([42]),
+        'is_IntArrayRef works on first call'
+    );
+    ok(
+        !is_IntArrayRef({}),
+        'to_IntArrayRef works on second call and does not close over first value'
+    );
+}
+
 # new array ref so we can safely shift from it
 for my $data (map { [@$_] } @tests) {
     my $type = shift @$data;