← Index
NYTProf Performance Profile   « line view »
For ./v1.pl
  Run on Wed Sep 18 20:26:04 2019
Reported on Wed Sep 18 20:29:11 2019

Filename/usr/lib/x86_64-linux-gnu/perl5/5.26/Function/Parameters.pm
StatementsExecuted 186 statements in 4.44ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.67ms7.08msFunction::Parameters::::BEGIN@6Function::Parameters::BEGIN@6
1111.64ms2.13msFunction::Parameters::::BEGIN@7Function::Parameters::BEGIN@7
111188µs347µsFunction::Parameters::::importFunction::Parameters::import
31179µs79µsFunction::Parameters::::CORE:regcompFunction::Parameters::CORE:regcomp (opcode)
32126µs114µsFunction::Parameters::::_assert_valid_identifierFunction::Parameters::_assert_valid_identifier
11123µs23µsFunction::Parameters::::BEGIN@3Function::Parameters::BEGIN@3
147123µs23µsFunction::Parameters::::_delete_defaultFunction::Parameters::_delete_default
63120µs20µsFunction::Parameters::::CORE:matchFunction::Parameters::CORE:match (opcode)
11111µs19µsFunction::Parameters::::BEGIN@4Function::Parameters::BEGIN@4
11111µs27µsFunction::Parameters::::BEGIN@80Function::Parameters::BEGIN@80
11110µs269µsFunction::Parameters::::BEGIN@15Function::Parameters::BEGIN@15
1119µs9µsFunction::Parameters::::_register_infoFunction::Parameters::_register_info
1118µs8µsFunction::Parameters::::BEGIN@14Function::Parameters::BEGIN@14
1116µs6µsFunction::Parameters::::CORE:sortFunction::Parameters::CORE:sort (opcode)
1114µs12µsFunction::Parameters::::_assert_valid_attributesFunction::Parameters::_assert_valid_attributes
0000s0sFunction::Parameters::::__ANON__[:104]Function::Parameters::__ANON__[:104]
0000s0sFunction::Parameters::::__ANON__[:95]Function::Parameters::__ANON__[:95]
0000s0sFunction::Parameters::::_croakFunction::Parameters::_croak
0000s0sFunction::Parameters::::_find_or_add_idxFunction::Parameters::_find_or_add_idx
0000s0sFunction::Parameters::::_malformed_typeFunction::Parameters::_malformed_type
0000s0sFunction::Parameters::::_mkparam1Function::Parameters::_mkparam1
0000s0sFunction::Parameters::::_mkparamsFunction::Parameters::_mkparams
0000s0sFunction::Parameters::::_reify_type_autoFunction::Parameters::_reify_type_auto
0000s0sFunction::Parameters::::_reify_type_auto_termFunction::Parameters::_reify_type_auto_term
0000s0sFunction::Parameters::::_reify_type_auto_unionFunction::Parameters::_reify_type_auto_union
0000s0sFunction::Parameters::::_reify_type_mooseFunction::Parameters::_reify_type_moose
0000s0sFunction::Parameters::::infoFunction::Parameters::info
0000s0sFunction::Parameters::::unimportFunction::Parameters::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Function::Parameters;
2
3266µs123µs
# spent 23µs within Function::Parameters::BEGIN@3 which was called: # once (23µs+0s) by main::BEGIN@25 at line 3
use v5.14.0;
# spent 23µs making 1 call to Function::Parameters::BEGIN@3
4244µs228µs
# spent 19µs (11+8) within Function::Parameters::BEGIN@4 which was called: # once (11µs+8µs) by main::BEGIN@25 at line 4
use warnings;
# spent 19µs making 1 call to Function::Parameters::BEGIN@4 # spent 8µs making 1 call to warnings::import
5
62187µs27.16ms
# spent 7.08ms (6.67+405µs) within Function::Parameters::BEGIN@6 which was called: # once (6.67ms+405µs) by main::BEGIN@25 at line 6
use Carp qw(croak confess);
# spent 7.08ms making 1 call to Function::Parameters::BEGIN@6 # spent 79µs making 1 call to Exporter::import
72239µs22.20ms
# spent 2.13ms (1.64+491µs) within Function::Parameters::BEGIN@7 which was called: # once (1.64ms+491µs) by main::BEGIN@25 at line 7
use Scalar::Util qw(blessed);
# spent 2.13ms making 1 call to Function::Parameters::BEGIN@7 # spent 74µs making 1 call to Exporter::import
8
9sub _croak {
10 my (undef, $file, $line) = caller 1;
11 die @_, " at $file line $line.\n";
12}
13
14256µs18µs
# spent 8µs within Function::Parameters::BEGIN@14 which was called: # once (8µs+0s) by main::BEGIN@25 at line 14
use XSLoader;
# spent 8µs making 1 call to Function::Parameters::BEGIN@14
15
# spent 269µs (10+258) within Function::Parameters::BEGIN@15 which was called: # once (10µs+258µs) by main::BEGIN@25 at line 19
BEGIN {
161500ns our $VERSION = '2.001003';
17 #$VERSION =~ s/-TRIAL[0-9]*\z//;
181267µs1258µs XSLoader::load;
# spent 258µs making 1 call to XSLoader::load
191564µs1269µs}
# spent 269µs making 1 call to Function::Parameters::BEGIN@15
20
21
# spent 114µs (26+87) within Function::Parameters::_assert_valid_identifier which was called 3 times, avg 38µs/call: # 2 times (20µs+46µs) by Function::Parameters::import at line 256, avg 33µs/call # once (7µs+41µs) by Function::Parameters::import at line 324
sub _assert_valid_identifier {
2232µs my ($name, $with_dollar) = @_;
2331µs my $bonus = $with_dollar ? '\$' : '';
243113µs687µs $name =~ /\A${bonus}[^\W\d]\w*\z/
# spent 79µs making 3 calls to Function::Parameters::CORE:regcomp, avg 26µs/call # spent 8µs making 3 calls to Function::Parameters::CORE:match, avg 3µs/call
25 or confess qq{"$name" doesn't look like a valid identifier};
26}
27
28
# spent 12µs (4+7) within Function::Parameters::_assert_valid_attributes which was called: # once (4µs+7µs) by Function::Parameters::import at line 280
sub _assert_valid_attributes {
291600ns my ($attrs) = @_;
30112µs17µs $attrs =~ m{
# spent 7µs making 1 call to Function::Parameters::CORE:match
31 \A \s*+
32 : \s*+
33 (?&ident) (?! [^\s:(] ) (?&param)?+ \s*+
34 (?:
35 (?: : \s*+ )?
36 (?&ident) (?! [^\s:(] ) (?&param)?+ \s*+
37 )*+
38 \z
39
40 (?(DEFINE)
41 (?<ident>
42 [^\W\d]
43 \w*+
44 )
45 (?<param>
46 \(
47 [^()\\]*+
48 (?:
49 (?:
50 \\ .
51 |
52 (?&param)
53 )
54 [^()\\]*+
55 )*+
56 \)
57 )
58 )
59 }sx or confess qq{"$attrs" doesn't look like valid attributes};
60}
61
62sub _reify_type_moose {
63 require Moose::Util::TypeConstraints;
64 Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0])
65}
66
67sub _malformed_type {
68 my ($type, $msg) = @_;
69 my $pos = pos $_[0];
70 substr $type, $pos, 0, ' <-- HERE ';
71 croak "Malformed type: $msg marked by <-- HERE in '$type'";
72}
73
74sub _reify_type_auto_term {
75 # (str, caller)
76 $_[0] =~ /\G ( \w+ (?: :: \w+)* ) \s* /xgc or _malformed_type $_[0], "missing type name";
77 my $name = $1;
78 $name = "$_[1]::$name" unless $name =~ /::/;
79 my $fun = do {
8022.57ms243µs
# spent 27µs (11+16) within Function::Parameters::BEGIN@80 which was called: # once (11µs+16µs) by main::BEGIN@25 at line 80
no strict 'refs';
# spent 27µs making 1 call to Function::Parameters::BEGIN@80 # spent 16µs making 1 call to strict::unimport
81 defined &$name or croak "Undefined type name $name";
82 \&$name
83 };
84
85 $_[0] =~ /\G \[ \s* /xgc
86 or return $fun;
87
88 my @args;
89 until ($_[0] =~ /\G \] \s* /xgc) {
90 $_[0] =~ /\G , \s* /xgc or _malformed_type $_[0], "missing ',' or ']'"
91 if @args;
92 push @args, &_reify_type_auto_union;
93 }
94
95 sub { $fun->([map $_->(), @args]) }
96}
97
98sub _reify_type_auto_union {
99 # (str, caller)
100 my $fun = &_reify_type_auto_term;
101 while ($_[0] =~ /\G \| \s* /xgc) {
102 my $right = &_reify_type_auto_term;
103 my $left = $fun;
104 $fun = sub { $left->() | $right->() };
105 }
106 $fun
107}
108
109sub _reify_type_auto {
110 my ($type) = @_;
111 my $caller = caller;
112
113 $type =~ /\G \s+ /xgc;
114 my $tfun = _reify_type_auto_union $type, $caller;
115 $type =~ /\G \z/xgc or _malformed_type $type, "trailing garbage";
116 $tfun->()
117}
118
119
# spent 23µs within Function::Parameters::_delete_default which was called 14 times, avg 2µs/call: # 2 times (7µs+0s) by Function::Parameters::import at line 338, avg 3µs/call # 2 times (4µs+0s) by Function::Parameters::import at line 339, avg 2µs/call # 2 times (3µs+0s) by Function::Parameters::import at line 341, avg 2µs/call # 2 times (3µs+0s) by Function::Parameters::import at line 340, avg 1µs/call # 2 times (2µs+0s) by Function::Parameters::import at line 342, avg 1µs/call # 2 times (2µs+0s) by Function::Parameters::import at line 343, avg 950ns/call # 2 times (2µs+0s) by Function::Parameters::import at line 344, avg 900ns/call
sub _delete_default {
120146µs my ($href, $key, $default) = @_;
1211448µs exists $href->{$key} ? delete $href->{$key} : $default
122}
123
124sub _find_or_add_idx {
125 my ($array, $x) = @_;
126 my $index;
127 for my $i (0 .. $#$array) {
128 if ($array->[$i] == $x) {
129 $index = $i;
130 last;
131 }
132 }
133 unless (defined $index) {
134 $index = @$array;
135 push @$array, $x;
136 }
137 $index
138}
139
140128µsmy %type_map = (
141 function_strict => {},
142 function_lax => {
143 defaults => 'function_strict',
144 strict => 0,
145 },
146 function => { defaults => 'function_strict' },
147
148 method_strict => {
149 defaults => 'function_strict',
150 attributes => ':method',
151 shift => '$self',
152 invocant => 1,
153 },
154 method_lax => {
155 defaults => 'method_strict',
156 strict => 0,
157 },
158 method => { defaults => 'method_strict' },
159
160 classmethod_strict => {
161 defaults => 'method_strict',
162 shift => '$class',
163 },
164 classmethod_lax => {
165 defaults => 'classmethod_strict',
166 strict => 0,
167 },
168 classmethod => { defaults => 'classmethod_strict' },
169
170 around => {
171 defaults => 'method',
172 name => 'required',
173 install_sub => 'around',
174 shift => ['$orig', '$self'],
175 runtime => 1,
176 },
177 (
178 map +(
179 $_ => {
180 defaults => 'method',
181 name => 'required',
182 install_sub => $_,
183 runtime => 1,
184 }
185 ), qw(
186 before after augment override
187 ),
188 ),
189);
190
191110µsmy %import_map = (
192 fun => 'function',
193 (
194 map +($_ => $_),
195 qw(
196 method
197 classmethod
198 before
199 after
200 around
201 augment
202 override
203 )
204 ),
205
206 ':strict' => {
207 fun => 'function_strict',
208 method => 'method_strict',
209 },
210
211 ':lax' => {
212 fun => 'function_lax',
213 method => 'method_lax',
214 },
215
216 ':std' => [qw(fun method)],
217 ':modifiers' => [qw(
218 before
219 after
220 around
221 augment
222 override
223 )],
224);
22512µsfor my $v (values %import_map) {
226127µs if (ref $v eq 'ARRAY') {
227 $v = {
22829µs map +($_ => $import_map{$_} || die "Internal error: $v => $_"),
229 @$v
230 };
231 }
232}
233
234
# spent 347µs (188+159) within Function::Parameters::import which was called: # once (188µs+159µs) by main::BEGIN@25 at line 25 of /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v1.pl
sub import {
2351600ns my $class = shift;
236
2371300ns my %imports;
23812µs @_ = qw(:std) if !@_;
2391700ns for my $item (@_) {
2401300ns my $part;
2411600ns if (ref $item) {
242 $part = $item;
243 } else {
2441700ns my $type = $import_map{$item}
245 or croak qq{"$item" is not exported by the $class module};
24611µs $part = ref $type
247 ? $type
248 : { $item => $type };
249 }
25014µs @imports{keys %$part} = values %$part;
251 }
252
2531100ns my %spec;
254
255117µs16µs for my $name (sort keys %imports) {
# spent 6µs making 1 call to Function::Parameters::CORE:sort
25623µs266µs _assert_valid_identifier $name;
# spent 66µs making 2 calls to Function::Parameters::_assert_valid_identifier, avg 33µs/call
25721µs my $proto_type = $imports{$name};
258
25924µs $proto_type = {defaults => $proto_type} unless ref $proto_type;
260
26124µs my %type = %$proto_type;
26227µs while (my $defaults = delete $type{defaults}) {
26353µs my $base = $type_map{$defaults}
264 or confess qq["$defaults" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
26559µs %type = (%$base, %type);
266 }
267
2682700ns if (exists $type{strict}) {
269 $type{check_argument_count} ||= $type{strict};
270 delete $type{strict};
271 }
272
2732300ns my %clean;
274
27522µs $clean{name} = delete $type{name} // 'optional';
27629µs24µs $clean{name} =~ /\A(?:optional|required|prohibited)\z/
# spent 4µs making 2 calls to Function::Parameters::CORE:match, avg 2µs/call
277 or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
278
27921µs $clean{attrs} = delete $type{attributes} // '';
28022µs112µs _assert_valid_attributes $clean{attrs} if $clean{attrs};
# spent 12µs making 1 call to Function::Parameters::_assert_valid_attributes
281
28223µs if (!exists $type{reify_type}) {
283 $clean{reify_type} = \&_reify_type_auto;
284 } else {
285 my $rt = delete $type{reify_type} // '(undef)';
286 if (!ref $rt) {
287 $rt =
288 $rt eq 'auto' ? \&_reify_type_auto :
289 $rt eq 'moose' ? \&_reify_type_moose :
290 confess qq{"$rt" isn't a known predefined type reifier};
291 } elsif (ref $rt ne 'CODE') {
292 confess qq{"$rt" doesn't look like a type reifier};
293 }
294
295 $clean{reify_type} = $rt;
296 }
297
29821µs if (!exists $type{install_sub}) {
299 $clean{install_sub} = '';
300 } else {
301 my $is = delete $type{install_sub};
302 if (!ref $is) {
303 _assert_valid_identifier $is;
304 } elsif (ref $is ne 'CODE') {
305 confess qq{"$is" doesn't look like a sub installer};
306 }
307
308 $clean{install_sub} = $is;
309 }
310
31122µs $clean{shift} = do {
31222µs my $shift = delete $type{shift} // [];
31322µs $shift = [$shift] if !ref $shift;
3142500ns my $str = '';
3152500ns my @shifty_types;
31622µs for my $item (@$shift) {
3171200ns my ($name, $type);
3181400ns if (ref $item) {
319 @$item == 2 or confess "A 'shift' item must have 2 elements, not " . @$item;
320 ($name, $type) = @$item;
321 } else {
3221500ns $name = $item;
323 }
32412µs148µs _assert_valid_identifier $name, 1;
# spent 48µs making 1 call to Function::Parameters::_assert_valid_identifier
3251400ns $name eq '$_' and confess q[Using "$_" as a parameter is not supported];
3261800ns $str .= $name;
3271400ns if (defined $type) {
328 blessed($type) or confess "${name}'s type must be an object, not $type";
329 my $index = _find_or_add_idx \@shifty_types, $type;
330 $str .= "/$index";
331 }
33211µs $str .= ' ';
333 }
334212µs $clean{shift_types} = \@shifty_types;
33523µs $str
336 };
337
33826µs27µs $clean{default_arguments} = _delete_default \%type, 'default_arguments', 1;
# spent 7µs making 2 calls to Function::Parameters::_delete_default, avg 3µs/call
33925µs24µs $clean{named_parameters} = _delete_default \%type, 'named_parameters', 1;
# spent 4µs making 2 calls to Function::Parameters::_delete_default, avg 2µs/call
34023µs23µs $clean{types} = _delete_default \%type, 'types', 1;
# spent 3µs making 2 calls to Function::Parameters::_delete_default, avg 1µs/call
34122µs23µs $clean{invocant} = _delete_default \%type, 'invocant', 0;
# spent 3µs making 2 calls to Function::Parameters::_delete_default, avg 2µs/call
34222µs22µs $clean{runtime} = _delete_default \%type, 'runtime', 0;
# spent 2µs making 2 calls to Function::Parameters::_delete_default, avg 1µs/call
34322µs22µs $clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 1;
# spent 2µs making 2 calls to Function::Parameters::_delete_default, avg 950ns/call
34422µs22µs $clean{check_argument_types} = _delete_default \%type, 'check_argument_types', 1;
# spent 2µs making 2 calls to Function::Parameters::_delete_default, avg 900ns/call
345
3462500ns %type and confess "Invalid keyword property: @{[sort keys %type]}";
347
34826µs $spec{$name} = \%clean;
349 }
350
35113µs my %config = %{$^H{+HINTK_CONFIG} // {}};
35212µs for my $kw (keys %spec) {
3532900ns my $type = $spec{$kw};
354
355 my $flags =
356 $type->{name} eq 'prohibited' ? FLAG_ANON_OK :
35722µs $type->{name} eq 'required' ? FLAG_NAME_OK :
358 FLAG_ANON_OK | FLAG_NAME_OK
359 ;
3602900ns $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments};
3612800ns $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count};
3622600ns $flags |= FLAG_CHECK_TARGS if $type->{check_argument_types};
3632500ns $flags |= FLAG_INVOCANT if $type->{invocant};
3642400ns $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
3652400ns $flags |= FLAG_TYPES_OK if $type->{types};
3662600ns $flags |= FLAG_RUNTIME if $type->{runtime};
367 $config{$kw} = {
368 HINTSK_FLAGS, => $flags,
369 HINTSK_SHIFT, => $type->{shift},
370 HINTSK_ATTRS, => $type->{attrs},
371 HINTSK_REIFY, => $type->{reify_type},
372 HINTSK_INSTL, => $type->{install_sub},
373 !@{$type->{shift_types}} ? () : (
374 HINTSK_SHIF2, => $type->{shift_types},
37527µs ),
376 };
377 }
378112µs $^H{+HINTK_CONFIG} = \%config;
379}
380
381sub unimport {
382 my $class = shift;
383
384 if (!@_) {
385 delete $^H{+HINTK_CONFIG};
386 return;
387 }
388
389 my %config = %{$^H{+HINTK_CONFIG}};
390 delete @config{@_};
391 $^H{+HINTK_CONFIG} = \%config;
392}
393
394
395our %metadata;
396
397
# spent 9µs within Function::Parameters::_register_info which was called: # once (9µs+0s) by main::NULL at line 103 of /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v1.pl
sub _register_info {
398 my (
39912µs $key,
400 $declarator,
401 $shift,
402 $positional_required,
403 $positional_optional,
404 $named_required,
405 $named_optional,
406 $slurpy,
407 $slurpy_type,
408 ) = @_;
409
41014µs my $info = {
411 declarator => $declarator,
412 shift => $shift,
413 positional_required => $positional_required,
414 positional_optional => $positional_optional,
415 named_required => $named_required,
416 named_optional => $named_optional,
417 slurpy => defined $slurpy ? [$slurpy, $slurpy_type] : undef,
418 };
419
42016µs $metadata{$key} = $info;
421}
422
423sub _mkparam1 {
424 my ($pair) = @_;
425 my ($v, $t) = @{$pair || []} or return undef;
426 Function::Parameters::Param->new(
427 name => $v,
428 type => $t,
429 )
430}
431
432sub _mkparams {
433 my @r;
434 while (my ($v, $t) = splice @_, 0, 2) {
435 push @r, Function::Parameters::Param->new(
436 name => $v,
437 type => $t,
438 );
439 }
440 \@r
441}
442
443sub info {
444 my ($func) = @_;
445 my $key = _cv_root $func or return undef;
446 my $info = $metadata{$key} or return undef;
447 require Function::Parameters::Info;
448 Function::Parameters::Info->new(
449 keyword => $info->{declarator},
450 nshift => $info->{shift},
451 slurpy => _mkparam1($info->{slurpy}),
452 (
453 map +("_$_" => _mkparams @{$info->{$_}}),
454 qw(
455 positional_required
456 positional_optional
457 named_required
458 named_optional
459 )
460 )
461 )
462}
463
464122µs'ok'
465
466__END__
 
# spent 20µs within Function::Parameters::CORE:match which was called 6 times, avg 3µs/call: # 3 times (8µs+0s) by Function::Parameters::_assert_valid_identifier at line 24, avg 3µs/call # 2 times (4µs+0s) by Function::Parameters::import at line 276, avg 2µs/call # once (7µs+0s) by Function::Parameters::_assert_valid_attributes at line 30
sub Function::Parameters::CORE:match; # opcode
# spent 79µs within Function::Parameters::CORE:regcomp which was called 3 times, avg 26µs/call: # 3 times (79µs+0s) by Function::Parameters::_assert_valid_identifier at line 24, avg 26µs/call
sub Function::Parameters::CORE:regcomp; # opcode
# spent 6µs within Function::Parameters::CORE:sort which was called: # once (6µs+0s) by Function::Parameters::import at line 255
sub Function::Parameters::CORE:sort; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.