← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:03 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny/Union.pm
StatementsExecuted 64 statements in 1.51ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11123µs95µsType::Tiny::Union::::newType::Tiny::Union::new
11118µs18µsType::Tiny::Union::::BEGIN@3Type::Tiny::Union::BEGIN@3
32116µs67µsType::Tiny::Union::::can_be_inlinedType::Tiny::Union::can_be_inlined
11115µs130µsType::Tiny::Union::::new_by_overloadType::Tiny::Union::new_by_overload
21114µs149µsType::Tiny::Union::::inline_checkType::Tiny::Union::inline_check
7416µs6µsType::Tiny::Union::::__ANON__[:23]Type::Tiny::Union::__ANON__[:23]
1116µs14µsType::Tiny::Union::::_build_display_nameType::Tiny::Union::_build_display_name
1115µs23µsType::Tiny::Union::::BEGIN@5Type::Tiny::Union::BEGIN@5
1114µs31µsType::Tiny::Union::::BEGIN@14Type::Tiny::Union::BEGIN@14
1114µs6µsType::Tiny::Union::::BEGIN@4Type::Tiny::Union::BEGIN@4
1113µs3µsType::Tiny::Union::::BEGIN@15Type::Tiny::Union::BEGIN@15
1112µs2µsType::Tiny::Union::::BEGIN@7Type::Tiny::Union::BEGIN@7
1111µs1µ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
3239µs118µs
# spent 18µs within Type::Tiny::Union::BEGIN@3 which was called: # once (18µ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 18µs making 1 call to Type::Tiny::Union::BEGIN@3
4215µs28µs
# spent 6µs (4+2) within Type::Tiny::Union::BEGIN@4 which was called: # once (4µs+2µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 4
use strict;
# spent 6µs making 1 call to Type::Tiny::Union::BEGIN@4 # spent 2µs making 1 call to strict::import
5222µs241µs
# spent 23µs (5+18) within Type::Tiny::Union::BEGIN@5 which was called: # once (5µs+18µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 5
use warnings;
# spent 23µs making 1 call to Type::Tiny::Union::BEGIN@5 # spent 18µs making 1 call to warnings::import
6
7
# spent 2µs within Type::Tiny::Union::BEGIN@7 which was called: # once (2µs+0s) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:126] at line 10
BEGIN {
810s $Type::Tiny::Union::AUTHORITY = 'cpan:TOBYINK';
913µs $Type::Tiny::Union::VERSION = '2.000001';
10121µs12µs}
# spent 2µs making 1 call to Type::Tiny::Union::BEGIN@7
11
1211µs$Type::Tiny::Union::VERSION =~ tr/_//d;
13
14215µs258µs
# spent 31µs (4+27) within Type::Tiny::Union::BEGIN@14 which was called: # once (4µs+27µ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 31µs making 1 call to Type::Tiny::Union::BEGIN@14 # spent 27µs making 1 call to Exporter::import
15229µs13µs
# spent 3µs within Type::Tiny::Union::BEGIN@15 which was called: # once (3µ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 3µs making 1 call to Type::Tiny::Union::BEGIN@15
16
17sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
18
1921.27ms11µs
# spent 1µs within Type::Tiny::Union::BEGIN@19 which was called: # once (1µ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 1µs making 1 call to Type::Tiny::Union::BEGIN@19
2015µsour @ISA = 'Type::Tiny';
21
22__PACKAGE__->_install_overloads(
23817µs114µs
# spent 6µ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 857ns/call: # 3 times (3µs+0s) by Type::Tiny::Union::can_be_inlined at line 117, avg 1µs/call # 2 times (2µs+0s) by Type::Tiny::Union::inline_check at line 140, avg 1µs/call # once (1µ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 14µs making 1 call to Type::Tiny::_install_overloads
24
25
# spent 130µs (15+115) within Type::Tiny::Union::new_by_overload which was called: # once (15µs+115µ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;
2711µs my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
28
2911µs my @types = @{ $opts{type_constraints} };
3017µs420µs if ( my @makers = map scalar( blessed($_) && $_->can( 'new_union' ) ), @types ) {
# spent 18µs making 2 calls to Type::Tiny::can, avg 9µs/call # spent 2µs making 2 calls to Scalar::Util::blessed, avg 1µs/call
3110s my $first_maker = shift @makers;
3211µs 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
4013µs195µs return $proto->new( \%opts );
# spent 95µs making 1 call to Type::Tiny::Union::new
41}
42
43
# spent 95µs (23+72) within Type::Tiny::Union::new which was called: # once (23µs+72µs) by Type::Tiny::Union::new_by_overload at line 40
sub new {
4410s my $proto = shift;
45
4612µs my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
47 _croak
48 "Union type constraints cannot have a parent constraint passed to the constructor"
4910s if exists $opts{parent};
50 _croak
51 "Union type constraints cannot have a constraint coderef passed to the constructor"
5211µs 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µs25µs map { $_->isa( __PACKAGE__ ) ? @$_ : $_ }
# spent 5µs making 2 calls to Type::Tiny::isa, avg 2µs/call
61 map Types::TypeTiny::to_TypeTiny( $_ ),
62 @{
6314µ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
8512µs144µs my $self = $proto->SUPER::new( %opts );
# spent 44µs making 1 call to Type::Tiny::new
8614µs314µs $self->coercion if grep $_->has_coercion, @$self;
# spent 13µs making 2 calls to Type::Tiny::has_coercion, avg 6µs/call # spent 1µs making 1 call to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23]
8712µ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 14µs (6+8) within Type::Tiny::Union::_build_display_name which was called: # once (6µs+8µs) by Type::Tiny::display_name at line 432 of Type/Tiny.pm
sub _build_display_name {
9610s my $self = shift;
9716µs30s join q[|], @$self;
# spent 0s making 1 call to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23] # spent 8µs making 2 calls to Type::Tiny::__ANON__[Type/Tiny.pm:100], avg 4µs/call, recursion: max depth 1, sum of overlapping time 8µ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 67µs (16+51) within Type::Tiny::Union::can_be_inlined which was called 3 times, avg 22µs/call: # 2 times (12µs+29µs) by Type::Tiny::inline_assert at line 915 of Type/Tiny.pm, avg 20µs/call # once (4µs+22µs) by Type::Tiny::_overload_coderef at line 203 of Type/Tiny.pm
sub can_be_inlined {
11631µs my $self = shift;
117312µs951µs not grep !$_->can_be_inlined, @$self;
# spent 48µ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 149µs (14+135) within Type::Tiny::Union::inline_check which was called 2 times, avg 74µs/call: # 2 times (14µs+135µs) by Type::Tiny::inline_assert at line 915 of Type/Tiny.pm, avg 74µs/call
sub inline_check {
12120s 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
14028µs6135µs my $code = sprintf '(%s)', join " or ", map $_->inline_check( $_[0] ), @$self;
# spent 133µs making 4 calls to Type::Tiny::inline_check, avg 33µs/call # spent 2µs making 2 calls to Type::Tiny::Union::__ANON__[Type/Tiny/Union.pm:23], avg 1µs/call
141
14220s return "do { $Type::Tiny::SafePackage $code }"
143 if $Type::Tiny::AvoidCallbacks;
144 return "$self->{xs_sub}\($_[0]\)"
14521µs if $self->{xs_sub};
14624µ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 ] );
22011µ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;
35312µs};
354
35514µ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.