← 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:35 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Tuple.pm
StatementsExecuted 129 statements in 2.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
811198µs2.00msTypes::Standard::Tuple::::__ANON__[:164]Types::Standard::Tuple::__ANON__[:164]
21187µs5.00msTypes::Standard::Tuple::::__constraint_generatorTypes::Standard::Tuple::__constraint_generator
21163µs2.19msTypes::Standard::Tuple::::__inline_generatorTypes::Standard::Tuple::__inline_generator
11127µs27µsTypes::Standard::Tuple::::BEGIN@5Types::Standard::Tuple::BEGIN@5
11123µs41µsTypes::Standard::Tuple::::BEGIN@25Types::Standard::Tuple::BEGIN@25
11117µs17µsTypes::Standard::Tuple::::BEGIN@9Types::Standard::Tuple::BEGIN@9
11110µs14µsTypes::Standard::Tuple::::BEGIN@6Types::Standard::Tuple::BEGIN@6
1119µs118µsTypes::Standard::Tuple::::BEGIN@7Types::Standard::Tuple::BEGIN@7
1118µs21µsTypes::Standard::Tuple::::BEGIN@338Types::Standard::Tuple::BEGIN@338
2115µs5µsTypes::Standard::Tuple::::CORE:sortTypes::Standard::Tuple::CORE:sort (opcode)
1113µs3µsTypes::Standard::Tuple::::BEGIN@16Types::Standard::Tuple::BEGIN@16
1112µs2µsTypes::Standard::Tuple::::BEGIN@17Types::Standard::Tuple::BEGIN@17
1111µs1µsTypes::Standard::Tuple::::BEGIN@18Types::Standard::Tuple::BEGIN@18
0000s0sTypes::Standard::Tuple::::__ANON__[:310]Types::Standard::Tuple::__ANON__[:310]
0000s0sTypes::Standard::Tuple::::__ANON__[:350]Types::Standard::Tuple::__ANON__[:350]
0000s0sTypes::Standard::Tuple::::__ANON__[:91]Types::Standard::Tuple::__ANON__[:91]
0000s0sTypes::Standard::Tuple::::__coercion_generatorTypes::Standard::Tuple::__coercion_generator
0000s0sTypes::Standard::Tuple::::__deep_explanationTypes::Standard::Tuple::__deep_explanation
0000s0sTypes::Standard::Tuple::::_croakTypes::Standard::Tuple::_croak
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# INTERNAL MODULE: guts for Tuple type from Types::Standard.
2
3package Types::Standard::Tuple;
4
5245µs127µs
# spent 27µs within Types::Standard::Tuple::BEGIN@5 which was called: # once (27µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 5
use 5.008001;
# spent 27µs making 1 call to Types::Standard::Tuple::BEGIN@5
6237µs218µs
# spent 14µs (10+4) within Types::Standard::Tuple::BEGIN@6 which was called: # once (10µs+4µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 6
use strict;
# spent 14µs making 1 call to Types::Standard::Tuple::BEGIN@6 # spent 4µs making 1 call to strict::import
7256µs2227µs
# spent 118µs (9+109) within Types::Standard::Tuple::BEGIN@7 which was called: # once (9µs+109µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 7
use warnings;
# spent 118µs making 1 call to Types::Standard::Tuple::BEGIN@7 # spent 109µs making 1 call to warnings::import
8
9
# spent 17µs within Types::Standard::Tuple::BEGIN@9 which was called: # once (17µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 12
BEGIN {
1011µs $Types::Standard::Tuple::AUTHORITY = 'cpan:TOBYINK';
1113µs $Types::Standard::Tuple::VERSION = '2.000001';
12135µs117µs}
# spent 17µs making 1 call to Types::Standard::Tuple::BEGIN@9
13
1411µs$Types::Standard::Tuple::VERSION =~ tr/_//d;
15
16241µs13µs
# spent 3µs within Types::Standard::Tuple::BEGIN@16 which was called: # once (3µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 16
use Type::Tiny ();
# spent 3µs making 1 call to Types::Standard::Tuple::BEGIN@16
17210µs12µs
# spent 2µs within Types::Standard::Tuple::BEGIN@17 which was called: # once (2µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 17
use Types::Standard ();
# spent 2µs making 1 call to Types::Standard::Tuple::BEGIN@17
18261µs11µs
# spent 1µs within Types::Standard::Tuple::BEGIN@18 which was called: # once (1µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 18
use Types::TypeTiny ();
# spent 1µs making 1 call to Types::Standard::Tuple::BEGIN@18
19
20sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
21
2211µs14µsmy $_Optional = Types::Standard::Optional;
# spent 4µs making 1 call to Types::Standard::Optional
2312µs15µsmy $_Slurpy = Types::Standard::Slurpy;
# spent 5µs making 1 call to Types::Standard::Slurpy
24
2521.41ms259µs
# spent 41µs (23+18) within Types::Standard::Tuple::BEGIN@25 which was called: # once (23µs+18µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 25
no warnings;
# spent 41µs making 1 call to Types::Standard::Tuple::BEGIN@25 # spent 18µs making 1 call to warnings::unimport
26
27
# spent 5.00ms (87µs+4.91) within Types::Standard::Tuple::__constraint_generator which was called 2 times, avg 2.50ms/call: # 2 times (87µs+4.91ms) by Type::Tiny::parameterize at line 1044 of Type/Tiny.pm, avg 2.50ms/call
sub __constraint_generator {
2829µs4782µs my $slurpy =
# spent 706µs making 2 calls to Type::Tiny::is_strictly_a_type_of, avg 353µs/call # spent 76µs making 2 calls to Types::TypeTiny::is_TypeTiny, avg 38µs/call
29 @_
30 && Types::TypeTiny::is_TypeTiny( $_[-1] )
31 && $_[-1]->is_strictly_a_type_of( $_Slurpy )
32 ? pop
33 : undef;
34
3522µs my @constraints = @_;
3622µs for ( @constraints ) {
3743µs453µs Types::TypeTiny::is_TypeTiny( $_ )
# spent 53µs making 4 calls to Types::TypeTiny::is_TypeTiny, avg 13µs/call
38 or
39 _croak( "Parameters to Tuple[...] expected to be type constraints; got $_" );
40 }
41
42 # By god, the Type::Tiny::XS API is currently horrible
4321µs my @xsub;
44 if ( Type::Tiny::_USE_XS and !$slurpy ) {
45 my @known = map {
46 my $known;
47 $known = Type::Tiny::XS::is_known( $_->compiled_check )
48 unless $_->is_strictly_a_type_of( $_Optional );
49 defined( $known ) ? $known : ();
50 } @constraints;
51
52 if ( @known == @constraints ) {
53 my $xsub = Type::Tiny::XS::get_coderef_for(
54 sprintf( "Tuple[%s]", join( ',', @known ) ) );
55 push @xsub, $xsub if $xsub;
56 }
57 } #/ if ( Type::Tiny::_USE_XS...)
58
5929µs41.49ms my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @constraints;
# spent 1.49ms making 4 calls to Type::Tiny::is_strictly_a_type_of, avg 372µs/call
6020s my $slurp_hash = $slurpy && $slurpy->my_slurp_into eq 'HASH';
6121µs my $slurp_any = $slurpy && $slurpy->my_unslurpy->equals( Types::Standard::Any );
62
63213µs25µs my @sorted_is_optional = sort @is_optional;
# spent 5µs making 2 calls to Types::Standard::Tuple::CORE:sort, avg 2µs/call
6423µs join( "|", @sorted_is_optional ) eq join( "|", @is_optional )
65 or _croak(
66 "Optional parameters to Tuple[...] cannot precede required parameters" );
67
68 sub {
69 my $value = $_[0];
70 if ( $#constraints < $#$value ) {
71 return !!0 unless $slurpy;
72 my $tmp;
73 if ( $slurp_hash ) {
74 ( $#$value - $#constraints + 1 ) % 2 or return;
75 $tmp = +{ @$value[ $#constraints + 1 .. $#$value ] };
76 $slurpy->check( $tmp ) or return;
77 }
78 elsif ( not $slurp_any ) {
79 $tmp = +[ @$value[ $#constraints + 1 .. $#$value ] ];
80 $slurpy->check( $tmp ) or return;
81 }
82 } #/ if ( $#constraints < $#$value)
83 for my $i ( 0 .. $#constraints ) {
84 ( $i > $#$value )
85 and return !!$is_optional[$i];
86
87 $constraints[$i]->check( $value->[$i] )
88 or return !!0;
89 }
90 return !!1;
91218µs }, @xsub;
92} #/ sub __constraint_generator
93
94
# spent 2.19ms (63µs+2.12) within Types::Standard::Tuple::__inline_generator which was called 2 times, avg 1.09ms/call: # 2 times (63µs+2.12ms) by Type::Tiny::parameterize at line 1057 of Type/Tiny.pm, avg 1.09ms/call
sub __inline_generator {
9526µs4637µs my $slurpy =
# spent 609µs making 2 calls to Type::Tiny::is_strictly_a_type_of, avg 304µs/call # spent 28µs making 2 calls to Types::TypeTiny::is_TypeTiny, avg 14µs/call
96 @_
97 && Types::TypeTiny::is_TypeTiny( $_[-1] )
98 && $_[-1]->is_strictly_a_type_of( $_Slurpy )
99 ? pop
100 : undef;
10123µs my @constraints = @_;
102
103612µs440µs return if grep { not $_->can_be_inlined } @constraints;
# spent 38µs making 2 calls to Type::Tiny::can_be_inlined, avg 19µs/call # spent 2µs making 2 calls to Type::Tiny::Enum::can_be_inlined, avg 1µs/call
10421µs return if defined $slurpy && !$slurpy->can_be_inlined;
105
10620s my $xsubname;
107 if ( Type::Tiny::_USE_XS and !$slurpy ) {
108 my @known = map {
109 my $known;
110 $known = Type::Tiny::XS::is_known( $_->compiled_check )
111 unless $_->is_strictly_a_type_of( $_Optional );
112 defined( $known ) ? $known : ();
113 } @constraints;
114
115 if ( @known == @constraints ) {
116 $xsubname = Type::Tiny::XS::get_subname_for(
117 sprintf( "Tuple[%s]", join( ',', @known ) ) );
118 }
119 } #/ if ( Type::Tiny::_USE_XS...)
120
12122µs my $tmpl = "do { my \$tmp = +[\@{%s}[%d..\$#{%s}]]; %s }";
12220s my $slurpy_any;
12322µs if ( defined $slurpy ) {
124 $tmpl =
125 'do { my ($orig, $from, $to) = (%s, %d, $#{%s});'
126 . '(($to-$from) %% 2) and do { my $tmp = +{@{$orig}[$from..$to]}; %s }'
127 . '}'
128 if $slurpy->my_slurp_into eq 'HASH';
129 $slurpy_any = 1
130 if $slurpy->my_unslurpy->equals( Types::Standard::Any );
131 }
132
13329µs41.45ms my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @constraints;
# spent 1.45ms making 4 calls to Type::Tiny::is_strictly_a_type_of, avg 362µs/call
13423µs my $min = 0+ grep !$_, @is_optional;
135
136
# spent 2.00ms (198µs+1.80) within Types::Standard::Tuple::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Tuple.pm:164] which was called 8 times, avg 250µs/call: # 8 times (198µs+1.80ms) by Type::Tiny::inline_check at line 895 of Type/Tiny.pm, avg 250µs/call
return sub {
13784µs my $v = $_[1];
13885µs return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks;
139 join " and ",
140 Types::Standard::ArrayRef->inline_check( $v ),
141 (
142 ( scalar @constraints == $min and not $slurpy )
143 ? "\@{$v} == $min"
144 : sprintf(
145 "(\@{$v} == $min or (\@{$v} > $min and \@{$v} <= ${\(1+$#constraints)}) or (\@{$v} > ${\(1+$#constraints)} and %s))",
146 (
147 $slurpy_any ? '!!1'
148 : (
149 $slurpy
150 ? sprintf( $tmpl, $v, $#constraints + 1, $v, $slurpy->inline_check( '$tmp' ) )
151 : sprintf( "\@{$v} <= %d", scalar @constraints )
152 )
153 ),
154 )
155 ),
156 map {
15724131µs32218µs my $inline = $constraints[$_]->inline_check( "$v\->[$_]" );
# spent 187µs making 8 calls to Type::Tiny::Enum::inline_check, avg 23µs/call # spent 31µs making 8 calls to Types::Standard::ArrayRef, avg 4µs/call # spent 1.58ms making 16 calls to Type::Tiny::inline_check, avg 99µs/call, recursion: max depth 2, sum of overlapping time 1.58ms
1581615µs $inline eq '(!!1)' ? ()
159 : (
160 $is_optional[$_] ? sprintf( '(@{%s} <= %d or %s)', $v, $_, $inline )
161 : $inline
162 );
163 } 0 .. $#constraints;
164216µs };
165} #/ sub __inline_generator
166
167sub __deep_explanation {
168 my ( $type, $value, $varname ) = @_;
169
170 my @constraints = @{ $type->parameters };
171 my $slurpy =
172 @constraints
173 && Types::TypeTiny::is_TypeTiny( $constraints[-1] )
174 && $constraints[-1]->is_strictly_a_type_of( $_Slurpy )
175 ? pop( @constraints )
176 : undef;
177 @constraints = map Types::TypeTiny::to_TypeTiny( $_ ), @constraints;
178
179 if ( @constraints < @$value and not $slurpy ) {
180 return [
181 sprintf(
182 '"%s" expects at most %d values in the array', $type, scalar( @constraints )
183 ),
184 sprintf( '%d values found; too many', scalar( @$value ) ),
185 ];
186 }
187
188 for my $i ( 0 .. $#constraints ) {
189 next
190 if $constraints[$i]
191 ->is_strictly_a_type_of( Types::Standard::Optional )
192 && $i > $#$value;
193 next if $constraints[$i]->check( $value->[$i] );
194
195 return [
196 sprintf(
197 '"%s" constrains value at index %d of array with "%s"', $type, $i,
198 $constraints[$i]
199 ),
200 @{
201 $constraints[$i]
202 ->validate_explain( $value->[$i], sprintf( '%s->[%s]', $varname, $i ) )
203 },
204 ];
205 } #/ for my $i ( 0 .. $#constraints)
206
207 if ( defined( $slurpy ) ) {
208 my $tmp =
209 $slurpy->my_slurp_into eq 'HASH'
210 ? +{ @$value[ $#constraints + 1 .. $#$value ] }
211 : +[ @$value[ $#constraints + 1 .. $#$value ] ];
212 $slurpy->check( $tmp )
213 or return [
214 sprintf(
215 'Array elements from index %d are slurped into a %s which is constrained with "%s"',
216 $#constraints + 1,
217 ( $slurpy->my_slurp_into eq 'HASH' ) ? 'hashref' : 'arrayref',
218 ( $slurpy->my_unslurpy || $slurpy ),
219 ),
220 @{ ( $slurpy->my_unslurpy || $slurpy )->validate_explain( $tmp, '$SLURPY' ) },
221 ];
222 } #/ if ( defined( $slurpy ...))
223
224 # This should never happen...
225 return; # uncoverable statement
226} #/ sub __deep_explanation
227
22810smy $label_counter = 0;
229
230sub __coercion_generator {
231 my ( $parent, $child, @tuple ) = @_;
232
233 my $slurpy =
234 @tuple
235 && Types::TypeTiny::is_TypeTiny( $tuple[-1] )
236 && $tuple[-1]->is_strictly_a_type_of( $_Slurpy )
237 ? pop( @tuple )
238 : undef;
239
240 my $child_coercions_exist = 0;
241 my $all_inlinable = 1;
242 for my $tc ( @tuple, ( $slurpy ? $slurpy : () ) ) {
243 $all_inlinable = 0 if !$tc->can_be_inlined;
244 $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined;
245 $child_coercions_exist++ if $tc->has_coercion;
246 }
247
248 return unless $child_coercions_exist;
249 my $C = "Type::Coercion"->new( type_constraint => $child );
250
251 my $slurpy_is_hashref = $slurpy && $slurpy->my_slurp_into eq 'HASH';
252
253 if ( $all_inlinable ) {
254 $C->add_type_coercions(
255 $parent => Types::Standard::Stringable {
256 my $label = sprintf( "TUPLELABEL%d", ++$label_counter );
257 my @code;
258 push @code, 'do { my ($orig, $return_orig, $tmp, @new) = ($_, 0);';
259 push @code, "$label: {";
260 push @code,
261 sprintf(
262 '(($return_orig = 1), last %s) if @$orig > %d;', $label,
263 scalar @tuple
264 ) unless $slurpy;
265 for my $i ( 0 .. $#tuple ) {
266 my $ct = $tuple[$i];
267 my $ct_coerce = $ct->has_coercion;
268 my $ct_optional = $ct->is_a_type_of( Types::Standard::Optional );
269
270 push @code, sprintf(
271 'if (@$orig > %d) { $tmp = %s; (%s) ? ($new[%d]=$tmp) : (($return_orig=1), last %s) }',
272 $i,
273 $ct_coerce
274 ? $ct->coercion->inline_coercion( "\$orig->[$i]" )
275 : "\$orig->[$i]",
276 $ct->inline_check( '$tmp' ),
277 $i,
278 $label,
279 );
280 } #/ for my $i ( 0 .. $#tuple)
281 if ( $slurpy ) {
282 my $size = @tuple;
283 push @code, sprintf( 'if (@$orig > %d) {', $size );
284 push @code, sprintf(
285 (
286 $slurpy_is_hashref
287 ? 'my $tail = do { no warnings; +{ @{$orig}[%d .. $#$orig]} };'
288 : 'my $tail = [ @{$orig}[%d .. $#$orig] ];'
289 ),
290 $size,
291 );
292 push @code,
293 $slurpy->has_coercion
294 ? sprintf(
295 '$tail = %s;',
296 $slurpy->coercion->inline_coercion( '$tail' )
297 )
298 : q();
299 push @code, sprintf(
300 '(%s) ? push(@new, %s$tail) : ($return_orig++);',
301 $slurpy->inline_check( '$tail' ),
302 ( $slurpy_is_hashref ? '%' : '@' ),
303 );
304 push @code, '}';
305 } #/ if ( $slurpy )
306 push @code, '}';
307 push @code, '$return_orig ? $orig : \\@new';
308 push @code, '}';
309 "@code";
310 }
311 );
312 } #/ if ( $all_inlinable )
313
314 else {
315 my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @tuple;
316
317 $C->add_type_coercions(
318 $parent => sub {
319 my $value = @_ ? $_[0] : $_;
320
321 if ( !$slurpy and @$value > @tuple ) {
322 return $value;
323 }
324
325 my @new;
326 for my $i ( 0 .. $#tuple ) {
327 return \@new if $i > $#$value and $is_optional[$i];
328
329 my $ct = $tuple[$i];
330 my $x = $ct->has_coercion ? $ct->coerce( $value->[$i] ) : $value->[$i];
331
332 return $value unless $ct->check( $x );
333
334 $new[$i] = $x;
335 } #/ for my $i ( 0 .. $#tuple)
336
337 if ( $slurpy and @$value > @tuple ) {
3382165µs234µs
# spent 21µs (8+13) within Types::Standard::Tuple::BEGIN@338 which was called: # once (8µs+13µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 338
no warnings;
# spent 21µs making 1 call to Types::Standard::Tuple::BEGIN@338 # spent 13µs making 1 call to warnings::unimport
339 my $tmp =
340 $slurpy_is_hashref
341 ? { @{$value}[ @tuple .. $#$value ] }
342 : [ @{$value}[ @tuple .. $#$value ] ];
343 $tmp = $slurpy->coerce( $tmp ) if $slurpy->has_coercion;
344 $slurpy->check( $tmp )
345 ? push( @new, $slurpy_is_hashref ? %$tmp : @$tmp )
346 : return ( $value );
347 } #/ if ( $slurpy and @$value...)
348
349 return \@new;
350 },
351 );
352 } #/ else [ if ( $all_inlinable ) ]
353
354 return $C;
355} #/ sub __coercion_generator
356
35714µs1;
 
# spent 5µs within Types::Standard::Tuple::CORE:sort which was called 2 times, avg 2µs/call: # 2 times (5µs+0s) by Types::Standard::Tuple::__constraint_generator at line 63, avg 2µs/call
sub Types::Standard::Tuple::CORE:sort; # opcode
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.