← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:34 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny/Union.pm
StatementsExecuted 64 statements in 1.97ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11141µs41µsType::Tiny::Union::::BEGIN@3Type::Tiny::Union::BEGIN@3
11123µs23µsType::Tiny::Union::::BEGIN@7Type::Tiny::Union::BEGIN@7
11123µs109µsType::Tiny::Union::::newType::Tiny::Union::new
32122µs71µsType::Tiny::Union::::can_be_inlinedType::Tiny::Union::can_be_inlined
11117µs151µsType::Tiny::Union::::new_by_overloadType::Tiny::Union::new_by_overload
21116µs128µsType::Tiny::Union::::inline_checkType::Tiny::Union::inline_check
11110µs48µsType::Tiny::Union::::BEGIN@14Type::Tiny::Union::BEGIN@14
11110µs15µsType::Tiny::Union::::BEGIN@4Type::Tiny::Union::BEGIN@4
1117µs16µsType::Tiny::Union::::_build_display_nameType::Tiny::Union::_build_display_name
1116µs51µsType::Tiny::Union::::BEGIN@5Type::Tiny::Union::BEGIN@5
7415µs5µsType::Tiny::Union::::__ANON__[:23]Type::Tiny::Union::__ANON__[:23]
1114µs4µsType::Tiny::Union::::BEGIN@15Type::Tiny::Union::BEGIN@15
1114µs4µsType::Tiny::Union::::BEGIN@19Type::Tiny::Union::BEGIN@19
0000s0sType::Tiny::Union::::__ANON__[:112]Type::Tiny::Union::__ANON__[:112]
0000s0sType::Tiny::Union::::__ANON__[:220]Type::Tiny::Union::__ANON__[:220]
0000s0sType::Tiny::Union::::__ANON__[:353]Type::Tiny::Union::__ANON__[:353]
0000s0sType::Tiny::Union::::_build_coercionType::Tiny::Union::_build_coercion
0000s0sType::Tiny::Union::::_build_constraintType::Tiny::Union::_build_constraint
0000s0sType::Tiny::Union::::_build_parentType::Tiny::Union::_build_parent
0000s0sType::Tiny::Union::::_croakType::Tiny::Union::_croak
0000s0sType::Tiny::Union::::_instantiate_moose_typeType::Tiny::Union::_instantiate_moose_type
0000s0sType::Tiny::Union::::_is_null_constraintType::Tiny::Union::_is_null_constraint
0000s0sType::Tiny::Union::::constraintType::Tiny::Union::constraint
0000s0sType::Tiny::Union::::find_type_forType::Tiny::Union::find_type_for
0000s0sType::Tiny::Union::::has_parentType::Tiny::Union::has_parent
0000s0sType::Tiny::Union::::numifies_toType::Tiny::Union::numifies_to
0000s0sType::Tiny::Union::::parentType::Tiny::Union::parent
0000s0sType::Tiny::Union::::stringifies_toType::Tiny::Union::stringifies_to
0000s0sType::Tiny::Union::::type_constraintsType::Tiny::Union::type_constraints
0000s0sType::Tiny::Union::::validate_explainType::Tiny::Union::validate_explain
0000s0sType::Tiny::Union::::with_attribute_valuesType::Tiny::Union::with_attribute_values
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Type::Tiny::Union;
2
3264µs141µs
# spent 41µs within Type::Tiny::Union::BEGIN@3 which was called: # once (41µs+0s) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 3
use 5.008001;
# spent 41µs making 1 call to Type::Tiny::Union::BEGIN@3
4233µs220µs
# spent 15µs (10+5) within Type::Tiny::Union::BEGIN@4 which was called: # once (10µs+5µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 4
use strict;
# spent 15µs making 1 call to Type::Tiny::Union::BEGIN@4 # spent 5µs making 1 call to strict::import
5290µs296µs
# spent 51µs (6+45) within Type::Tiny::Union::BEGIN@5 which was called: # once (6µs+45µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 5
use warnings;
# spent 51µs making 1 call to Type::Tiny::Union::BEGIN@5 # spent 45µs making 1 call to warnings::import
6
7
# spent 23µs within Type::Tiny::Union::BEGIN@7 which was called: # once (23µs+0s) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 10
BEGIN {
811µs $Type::Tiny::Union::AUTHORITY = 'cpan:TOBYINK';
917µs $Type::Tiny::Union::VERSION = '2.000001';
10163µs123µs}
# spent 23µs making 1 call to Type::Tiny::Union::BEGIN@7
11
1211µs$Type::Tiny::Union::VERSION =~ tr/_//d;
13
14226µs286µs
# spent 48µs (10+38) within Type::Tiny::Union::BEGIN@14 which was called: # once (10µs+38µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 14
use Scalar::Util qw< blessed >;
# spent 48µs making 1 call to Type::Tiny::Union::BEGIN@14 # spent 38µs making 1 call to Exporter::import
15269µs14µs
# spent 4µs within Type::Tiny::Union::BEGIN@15 which was called: # once (4µs+0s) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 15
use Types::TypeTiny ();
# spent 4µs making 1 call to Type::Tiny::Union::BEGIN@15
16
17sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
18
1921.51ms14µs
# spent 4µs within Type::Tiny::Union::BEGIN@19 which was called: # once (4µs+0s) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 19
use Type::Tiny ();
# spent 4µs making 1 call to Type::Tiny::Union::BEGIN@19
20110µsour @ISA = 'Type::Tiny';
21
22__PACKAGE__->_install_overloads(
23819µs115µs
# spent 5µs within Type::Tiny::Union::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny/Union.pm:23] which was called 7 times, avg 714ns/call: # 3 times (3µs+0s) by Type::Tiny::Union::can_be_inlined at line 117, avg 1µs/call # 2 times (0s+0s) by Type::Tiny::Union::inline_check at line 140, avg 0s/call # once (2µs+0s) by Type::Tiny::Union::new at line 86 # once (0s+0s) by Type::Tiny::Union::_build_display_name at line 97
q[@{}] => sub { $_[0]{type_constraints} ||= [] } );
# spent 15µs making 1 call to Type::Tiny::_install_overloads
24
25
# spent 151µs (17+134) within Type::Tiny::Union::new_by_overload which was called: # once (17µs+134µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 125 of Type/Tiny.pm
sub new_by_overload {
2610s my $proto = shift;
2712µs my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
28
2911µs my @types = @{ $opts{type_constraints} };
30111µs425µs if ( my @makers = map scalar( blessed($_) && $_->can( 'new_union' ) ), @types ) {
# spent 23µs making 2 calls to Type::Tiny::can, avg 12µs/call # spent 2µs making 2 calls to Scalar::Util::blessed, avg 1µs/call
3110s my $first_maker = shift @makers;
3210s if ( ref $first_maker ) {
33 my $all_same = not grep +( !defined $_ or $_ ne $first_maker ), @makers;
34 if ( $all_same ) {
35 return ref( $types[0] )->$first_maker( %opts );
36 }
37 }
38 }
39
4014µs1109µs return $proto->new( \%opts );
# spent 109µs making 1 call to Type::Tiny::Union::new
41}
42
43
# spent 109µs (23+86) within Type::Tiny::Union::new which was called: # once (23µs+86µs) by Type::Tiny::Union::new_by_overload at line 40
sub new {
4410s my $proto = shift;
45
4611µs my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
47 _croak
48 "Union type constraints cannot have a parent constraint passed to the constructor"
4911µs if exists $opts{parent};
50 _croak
51 "Union type constraints cannot have a constraint coderef passed to the constructor"
5210s if exists $opts{constraint};
53 _croak
54 "Union type constraints cannot have a inlining coderef passed to the constructor"
5510s if exists $opts{inlined};
56 _croak "Need to supply list of type constraints"
5710s unless exists $opts{type_constraints};
58
59 $opts{type_constraints} = [
6023µs29µs map { $_->isa( __PACKAGE__ ) ? @$_ : $_ }
# spent 9µs making 2 calls to Type::Tiny::isa, avg 4µs/call
61 map Types::TypeTiny::to_TypeTiny( $_ ),
62 @{
6315µs29µs ref $opts{type_constraints} eq "ARRAY"
# spent 9µs making 2 calls to Types::TypeTiny::to_TypeTiny, avg 4µs/call
64 ? $opts{type_constraints}
65 : [ $opts{type_constraints} ]
66 }
67 ];
68
69 if ( Type::Tiny::_USE_XS ) {
70 my @constraints = @{ $opts{type_constraints} };
71 my @known = map {
72 my $known = Type::Tiny::XS::is_known( $_->compiled_check );
73 defined( $known ) ? $known : ();
74 } @constraints;
75
76 if ( @known == @constraints ) {
77 my $xsub = Type::Tiny::XS::get_coderef_for(
78 sprintf "AnyOf[%s]",
79 join( ',', @known )
80 );
81 $opts{compiled_type_constraint} = $xsub if $xsub;
82 }
83 } #/ if ( Type::Tiny::_USE_XS)
84
8514µs153µs my $self = $proto->SUPER::new( %opts );
# spent 53µs making 1 call to Type::Tiny::new
8614µs315µs $self->coercion if grep $_->has_coercion, @$self;
# spent 13µs making 2 calls to Type::Tiny::has_coercion, avg 6µs/call # spent 2µs making 1 call to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23]
8713µs return $self;
88} #/ sub new
89
90sub type_constraints { $_[0]{type_constraints} }
91sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }
92
93sub _is_null_constraint { 0 }
94
95
# spent 16µs (7+9) within Type::Tiny::Union::_build_display_name which was called: # once (7µs+9µs) by Type::Tiny::display_name at line 432 of Type/Tiny.pm
sub _build_display_name {
9610s my $self = shift;
9715µs30s join q[|], @$self;
# spent 0s making 1 call to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23] # spent 9µs making 2 calls to Type::Tiny::__ANON__[Type/Tiny.pm:100], avg 4µs/call, recursion: max depth 1, sum of overlapping time 9µs
98}
99
100sub _build_coercion {
101 require Type::Coercion::Union;
102 my $self = shift;
103 return "Type::Coercion::Union"->new( type_constraint => $self );
104}
105
106sub _build_constraint {
107 my @checks = map $_->compiled_check, @{ +shift };
108 return sub {
109 my $val = $_;
110 $_->( $val ) && return !!1 for @checks;
111 return;
112 }
113}
114
115
# spent 71µs (22+49) within Type::Tiny::Union::can_be_inlined which was called 3 times, avg 24µs/call: # 2 times (12µs+27µs) by Type::Tiny::inline_assert at line 915 of Type/Tiny.pm, avg 20µs/call # once (10µs+22µs) by Type::Tiny::_overload_coderef at line 203 of Type/Tiny.pm
sub can_be_inlined {
11630s my $self = shift;
117313µs949µs not grep !$_->can_be_inlined, @$self;
# spent 46µs making 6 calls to Type::Tiny::can_be_inlined, avg 8µs/call # spent 3µs making 3 calls to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23], avg 1µs/call
118}
119
120
# spent 128µs (16+112) within Type::Tiny::Union::inline_check which was called 2 times, avg 64µs/call: # 2 times (16µs+112µs) by Type::Tiny::inline_assert at line 915 of Type/Tiny.pm, avg 64µs/call
sub inline_check {
12121µs my $self = shift;
122
123 if ( Type::Tiny::_USE_XS and !exists $self->{xs_sub} ) {
124 $self->{xs_sub} = undef;
125
126 my @constraints = @{ $self->type_constraints };
127 my @known = map {
128 my $known = Type::Tiny::XS::is_known( $_->compiled_check );
129 defined( $known ) ? $known : ();
130 } @constraints;
131
132 if ( @known == @constraints ) {
133 $self->{xs_sub} = Type::Tiny::XS::get_subname_for(
134 sprintf "AnyOf[%s]",
135 join( ',', @known )
136 );
137 }
138 } #/ if ( Type::Tiny::_USE_XS...)
139
14026µs6112µs my $code = sprintf '(%s)', join " or ", map $_->inline_check( $_[0] ), @$self;
# spent 112µs making 4 calls to Type::Tiny::inline_check, avg 28µs/call # spent 0s making 2 calls to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23], avg 0s/call
141
14221µs return "do { $Type::Tiny::SafePackage $code }"
143 if $Type::Tiny::AvoidCallbacks;
144 return "$self->{xs_sub}\($_[0]\)"
14521µs if $self->{xs_sub};
14623µs return $code;
147} #/ sub inline_check
148
149sub _instantiate_moose_type {
150 my $self = shift;
151 my %opts = @_;
152 delete $opts{parent};
153 delete $opts{constraint};
154 delete $opts{inlined};
155
156 my @tc = map $_->moose_type, @{ $self->type_constraints };
157
158 require Moose::Meta::TypeConstraint::Union;
159 return "Moose::Meta::TypeConstraint::Union"
160 ->new( %opts, type_constraints => \@tc );
161} #/ sub _instantiate_moose_type
162
163sub has_parent {
164 defined( shift->parent );
165}
166
167sub parent {
168 $_[0]{parent} ||= $_[0]->_build_parent;
169}
170
171sub _build_parent {
172 my $self = shift;
173 my ( $first, @rest ) = @$self;
174
175 for my $parent ( $first, $first->parents ) {
176 return $parent unless grep !$_->is_a_type_of( $parent ), @rest;
177 }
178
179 return;
180} #/ sub _build_parent
181
182sub find_type_for {
183 my @types = @{ +shift };
184 for my $type ( @types ) {
185 return $type if $type->check( @_ );
186 }
187 return;
188}
189
190sub validate_explain {
191 my $self = shift;
192 my ( $value, $varname ) = @_;
193 $varname = '$_' unless defined $varname;
194
195 return undef if $self->check( $value );
196
197 require Type::Utils;
198 return [
199 sprintf(
200 '"%s" requires that the value pass %s',
201 $self,
202 Type::Utils::english_list( \"or", map qq["$_"], @$self ),
203 ),
204 map {
205 $_->get_message( $value ),
206 map( " $_", @{ $_->validate_explain( $value ) || [] } ),
207 } @$self
208 ];
209} #/ sub validate_explain
210
211my $_delegate = sub {
212 my ( $self, $method ) = ( shift, shift );
213 my @types = @{ $self->type_constraints };
214
215 my @unsupported = grep !$_->can( $method ), @types;
216 _croak( 'Could not apply method %s to all types within the union', $method )
217 if @unsupported;
218
219 ref( $self )->new( type_constraints => [ map $_->$method( @_ ), @types ] );
22015µs};
221
222sub stringifies_to {
223 my $self = shift;
224 $self->$_delegate( stringifies_to => @_ );
225}
226
227sub numifies_to {
228 my $self = shift;
229 $self->$_delegate( numifies_to => @_ );
230}
231
232sub with_attribute_values {
233 my $self = shift;
234 $self->$_delegate( with_attribute_values => @_ );
235}
236
237push @Type::Tiny::CMP, sub {
238 my $A = shift->find_constraining_type;
239 my $B = shift->find_constraining_type;
240
241 if ( $A->isa( __PACKAGE__ ) and $B->isa( __PACKAGE__ ) ) {
242 my @A_constraints = @{ $A->type_constraints };
243 my @B_constraints = @{ $B->type_constraints };
244
245 # If everything in @A_constraints is equal to something in @B_constraints and vice versa, then $A equiv to $B
246 EQUALITY: {
247 my $everything_in_a_is_equal = 1;
248 OUTER: for my $A_child ( @A_constraints ) {
249 INNER: for my $B_child ( @B_constraints ) {
250 if ( $A_child->equals( $B_child ) ) {
251 next OUTER;
252 }
253 }
254 $everything_in_a_is_equal = 0;
255 last OUTER;
256 }
257
258 my $everything_in_b_is_equal = 1;
259 OUTER: for my $B_child ( @B_constraints ) {
260 INNER: for my $A_child ( @A_constraints ) {
261 if ( $B_child->equals( $A_child ) ) {
262 next OUTER;
263 }
264 }
265 $everything_in_b_is_equal = 0;
266 last OUTER;
267 }
268
269 return Type::Tiny::CMP_EQUIVALENT
270 if $everything_in_a_is_equal && $everything_in_b_is_equal;
271 } #/ EQUALITY:
272
273 # If everything in @A_constraints is a subtype of something in @B_constraints, then $A is subtype of $B
274 SUBTYPE: {
275 OUTER: for my $A_child ( @A_constraints ) {
276 my $a_child_is_subtype_of_something = 0;
277 INNER: for my $B_child ( @B_constraints ) {
278 if ( $A_child->is_a_type_of( $B_child ) ) {
279 ++$a_child_is_subtype_of_something;
280 last INNER;
281 }
282 }
283 if ( not $a_child_is_subtype_of_something ) {
284 last SUBTYPE;
285 }
286 } #/ OUTER: for my $A_child ( @A_constraints)
287 return Type::Tiny::CMP_SUBTYPE;
288 } #/ SUBTYPE:
289
290 # If everything in @B_constraints is a subtype of something in @A_constraints, then $A is supertype of $B
291 SUPERTYPE: {
292 OUTER: for my $B_child ( @B_constraints ) {
293 my $b_child_is_subtype_of_something = 0;
294 INNER: for my $A_child ( @A_constraints ) {
295 if ( $B_child->is_a_type_of( $A_child ) ) {
296 ++$b_child_is_subtype_of_something;
297 last INNER;
298 }
299 }
300 if ( not $b_child_is_subtype_of_something ) {
301 last SUPERTYPE;
302 }
303 } #/ OUTER: for my $B_child ( @B_constraints)
304 return Type::Tiny::CMP_SUPERTYPE;
305 } #/ SUPERTYPE:
306 } #/ if ( $A->isa( __PACKAGE__...))
307
308 # I think it might be possible to merge this into the first bit by treating $B as union[$B].
309 # Test cases first though.
310 if ( $A->isa( __PACKAGE__ ) ) {
311 my @A_constraints = @{ $A->type_constraints };
312 if ( @A_constraints == 1 ) {
313 my $result = Type::Tiny::cmp( $A_constraints[0], $B );
314 return $result unless $result eq Type::Tiny::CMP_UNKNOWN;
315 }
316 my $subtype = 1;
317 for my $child ( @A_constraints ) {
318 if ( $B->is_a_type_of( $child ) ) {
319 return Type::Tiny::CMP_SUPERTYPE;
320 }
321 if ( $subtype and not $B->is_supertype_of( $child ) ) {
322 $subtype = 0;
323 }
324 }
325 if ( $subtype ) {
326 return Type::Tiny::CMP_SUBTYPE;
327 }
328 } #/ if ( $A->isa( __PACKAGE__...))
329
330 # I think it might be possible to merge this into the first bit by treating $A as union[$A].
331 # Test cases first though.
332 if ( $B->isa( __PACKAGE__ ) ) {
333 my @B_constraints = @{ $B->type_constraints };
334 if ( @B_constraints == 1 ) {
335 my $result = Type::Tiny::cmp( $A, $B_constraints[0] );
336 return $result unless $result eq Type::Tiny::CMP_UNKNOWN;
337 }
338 my $supertype = 1;
339 for my $child ( @B_constraints ) {
340 if ( $A->is_a_type_of( $child ) ) {
341 return Type::Tiny::CMP_SUBTYPE;
342 }
343 if ( $supertype and not $A->is_supertype_of( $child ) ) {
344 $supertype = 0;
345 }
346 }
347 if ( $supertype ) {
348 return Type::Tiny::CMP_SUPERTYPE;
349 }
350 } #/ if ( $B->isa( __PACKAGE__...))
351
352 return Type::Tiny::CMP_UNKNOWN;
35311µs};
354
35516µs1;
356
357__END__
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.