diff --git a/Changes b/Changes index 5c25e3d..5804233 100644 --- a/Changes +++ b/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 diff --git a/eg/benchmarks.pl b/eg/benchmarks.pl new file mode 100644 index 0000000..c8576fe --- /dev/null +++ b/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, + }, +); diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index 19e6687..a968aad 100644 --- a/lib/MooseX/Types.pm +++ b/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. 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. 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; } } diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 8c29d08..14f2ceb 100644 --- a/lib/MooseX/Types/Base.pm +++ b/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 } diff --git a/t/11_library-definition.t b/t/11_library-definition.t index 5150f57..a722e99 100644 --- a/t/11_library-definition.t +++ b/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;