From ab301580cea284f3e9c5035e58f48f599eb362c2 Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Wed, 7 Dec 2016 13:03:30 -0600 Subject: [PATCH 1/4] Remove arbitrary junk passed as options to Sub::Exporter I'm not sure why this was ever added, but all the tests pass if options is just made an empty hash. --- lib/MooseX/Types/Base.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 8c29d08..5020cc1 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; } From f83f767c52ff4951d59562848dd24bcd38d1a2c3 Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Wed, 16 Nov 2016 11:18:48 -0600 Subject: [PATCH 2/4] Add a benchmark to compare Moose to various MooseX::Types constructs We're comparing plain Moose TCs to is_Foo and Foo()->check. The latter is _incredibly_ slow because it goes through AUTOLOAD magic. We're also comparing to_Foo() to Foo()->coerce. --- eg/benchmarks.pl | 91 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 eg/benchmarks.pl 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, + }, +); From fc5d25ff44c7e8c3c1adb9cf4aea44295c97fbb5 Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Wed, 7 Dec 2016 11:33:18 -0600 Subject: [PATCH 3/4] Revert "Revert "Make the is_Foo and to_Foo subs way faster"" This reverts commit bf385165ab6df90cd470d16e00ef16f3df5a1fa9. --- Changes | 2 ++ lib/MooseX/Types.pm | 35 ++++++++++++++++++++++++++++------- lib/MooseX/Types/Base.pm | 11 +++++++---- t/11_library-definition.t | 22 ++++++++++++++++++++++ 4 files changed, 59 insertions(+), 11 deletions(-) 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/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index 19e6687..aa19f3d 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -485,18 +485,23 @@ This generates a coercion handler function, e.g. C. =cut sub coercion_export_generator { - my ($class, $type, $full, $undef_msg) = @_; + my ($class, $type, $full, $undef_msg, $sub_name) = @_; return 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); + my $coercion_sub = sub { + my $return = $tobj->coerce($_[0]); - return $return; + # non-successful coercion returns false + return unless $tobj->check($return); + + return $return; + }; + + $class->_replace_and_call_trampoline((caller(0))[0], $sub_name, $coercion_sub, $value); } } @@ -507,17 +512,33 @@ Generates a constraint check closure, e.g. C. =cut sub check_export_generator { - my ($class, $type, $full, $undef_msg) = @_; + my ($class, $type, $full, $undef_msg, $sub_name) = @_; + return 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]) } + my $check_sub = $tobj->_compiled_type_constraint; + $class->_replace_and_call_trampoline((caller(0))[0], $sub_name, $check_sub, $value); } } +sub _replace_and_call_trampoline { + my ($class, $package, $sub_name, $sub, $value) = @_; + + no warnings 'redefine'; + no strict 'refs'; + + *{$package . '::' . $sub_name} = $sub; + + @_ = ($value); + goto $sub; +} + =head1 CAVEATS The following are lists of gotchas and their workarounds for developers coming diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 5020cc1..3b26d82 100644 --- a/lib/MooseX/Types/Base.pm +++ b/lib/MooseX/Types/Base.pm @@ -76,17 +76,20 @@ sub import { }; # the check helper + my $check_name = "is_${type_short}"; push @{ $ex_spec{exports} }, - "is_${type_short}", - sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) }; + $check_name, + sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg, $check_name) }; # 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}", - sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) }; + $coercion_name, + sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg, $coercion_name) }; $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; From 32e89aab4d0642100860b6b6a6e049c3736e3578 Mon Sep 17 00:00:00 2001 From: Dave Rolsky Date: Fri, 9 Dec 2016 09:23:15 -0600 Subject: [PATCH 4/4] Use Sub::Defer for trampolines --- lib/MooseX/Types.pm | 28 +++++++--------------------- lib/MooseX/Types/Base.pm | 4 ++-- 2 files changed, 9 insertions(+), 23 deletions(-) diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index aa19f3d..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' @@ -485,14 +486,14 @@ This generates a coercion handler function, e.g. C. =cut sub coercion_export_generator { - my ($class, $type, $full, $undef_msg, $sub_name) = @_; - return sub { + my ($class, $type, $full, $undef_msg) = @_; + return defer_sub undef, sub { my ($value) = @_; # we need a type object my $tobj = find_type_constraint($full) or croak $undef_msg; - my $coercion_sub = sub { + return sub { my $return = $tobj->coerce($_[0]); # non-successful coercion returns false @@ -500,8 +501,6 @@ sub coercion_export_generator { return $return; }; - - $class->_replace_and_call_trampoline((caller(0))[0], $sub_name, $coercion_sub, $value); } } @@ -512,9 +511,9 @@ Generates a constraint check closure, e.g. C. =cut sub check_export_generator { - my ($class, $type, $full, $undef_msg, $sub_name) = @_; + my ($class, $type, $full, $undef_msg) = @_; - return sub { + return defer_sub undef, sub { my ($value) = @_; # we need a type object @@ -522,23 +521,10 @@ sub check_export_generator { # This method will actually compile an inlined sub if possible. If # not, it will return something like sub { $tobj->check($_[0]) } - my $check_sub = $tobj->_compiled_type_constraint; - $class->_replace_and_call_trampoline((caller(0))[0], $sub_name, $check_sub, $value); + return $tobj->_compiled_type_constraint; } } -sub _replace_and_call_trampoline { - my ($class, $package, $sub_name, $sub, $value) = @_; - - no warnings 'redefine'; - no strict 'refs'; - - *{$package . '::' . $sub_name} = $sub; - - @_ = ($value); - goto $sub; -} - =head1 CAVEATS The following are lists of gotchas and their workarounds for developers coming diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index 3b26d82..14f2ceb 100644 --- a/lib/MooseX/Types/Base.pm +++ b/lib/MooseX/Types/Base.pm @@ -79,7 +79,7 @@ sub import { my $check_name = "is_${type_short}"; push @{ $ex_spec{exports} }, $check_name, - sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg, $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 @@ -89,7 +89,7 @@ sub import { my $coercion_name = "to_${type_short}"; push @{ $ex_spec{exports} }, $coercion_name, - sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg, $coercion_name) }; + sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) }; $ex_util{ $type_short }{to}++; # shortcut to remember this exists }