Filename | /usr/lib/x86_64-linux-gnu/perl5/5.26/Function/Parameters.pm |
Statements | Executed 186 statements in 1.67ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.30ms | 2.42ms | BEGIN@6 | Function::Parameters::
1 | 1 | 1 | 588µs | 790µs | BEGIN@7 | Function::Parameters::
1 | 1 | 1 | 67µs | 126µs | import | Function::Parameters::
3 | 1 | 1 | 30µs | 30µs | CORE:regcomp (opcode) | Function::Parameters::
3 | 2 | 1 | 10µs | 43µs | _assert_valid_identifier | Function::Parameters::
1 | 1 | 1 | 7µs | 7µs | BEGIN@3 | Function::Parameters::
6 | 3 | 1 | 7µs | 7µs | CORE:match (opcode) | Function::Parameters::
14 | 7 | 1 | 7µs | 7µs | _delete_default | Function::Parameters::
1 | 1 | 1 | 5µs | 5µs | _register_info | Function::Parameters::
1 | 1 | 1 | 4µs | 10µs | BEGIN@80 | Function::Parameters::
1 | 1 | 1 | 4µs | 104µs | BEGIN@15 | Function::Parameters::
1 | 1 | 1 | 4µs | 6µs | BEGIN@4 | Function::Parameters::
1 | 1 | 1 | 3µs | 3µs | BEGIN@14 | Function::Parameters::
1 | 1 | 1 | 3µs | 3µs | CORE:sort (opcode) | Function::Parameters::
1 | 1 | 1 | 2µs | 4µs | _assert_valid_attributes | Function::Parameters::
0 | 0 | 0 | 0s | 0s | __ANON__[:104] | Function::Parameters::
0 | 0 | 0 | 0s | 0s | __ANON__[:95] | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _croak | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _find_or_add_idx | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _malformed_type | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _mkparam1 | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _mkparams | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _reify_type_auto | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _reify_type_auto_term | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _reify_type_auto_union | Function::Parameters::
0 | 0 | 0 | 0s | 0s | _reify_type_moose | Function::Parameters::
0 | 0 | 0 | 0s | 0s | info | Function::Parameters::
0 | 0 | 0 | 0s | 0s | unimport | Function::Parameters::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Function::Parameters; | ||||
2 | |||||
3 | 2 | 22µs | 1 | 7µs | # spent 7µs within Function::Parameters::BEGIN@3 which was called:
# once (7µs+0s) by main::BEGIN@33 at line 3 # spent 7µs making 1 call to Function::Parameters::BEGIN@3 |
4 | 2 | 15µs | 2 | 9µs | # spent 6µs (4+3) within Function::Parameters::BEGIN@4 which was called:
# once (4µs+3µs) by main::BEGIN@33 at line 4 # spent 6µs making 1 call to Function::Parameters::BEGIN@4
# spent 3µs making 1 call to warnings::import |
5 | |||||
6 | 2 | 62µs | 2 | 2.45ms | # spent 2.42ms (2.30+128µs) within Function::Parameters::BEGIN@6 which was called:
# once (2.30ms+128µs) by main::BEGIN@33 at line 6 # spent 2.42ms making 1 call to Function::Parameters::BEGIN@6
# spent 29µs making 1 call to Exporter::import |
7 | 2 | 85µs | 2 | 816µs | # spent 790µs (588+202) within Function::Parameters::BEGIN@7 which was called:
# once (588µs+202µs) by main::BEGIN@33 at line 7 # spent 790µs making 1 call to Function::Parameters::BEGIN@7
# spent 26µs making 1 call to Exporter::import |
8 | |||||
9 | sub _croak { | ||||
10 | my (undef, $file, $line) = caller 1; | ||||
11 | die @_, " at $file line $line.\n"; | ||||
12 | } | ||||
13 | |||||
14 | 2 | 20µs | 1 | 3µs | # spent 3µs within Function::Parameters::BEGIN@14 which was called:
# once (3µs+0s) by main::BEGIN@33 at line 14 # spent 3µs making 1 call to Function::Parameters::BEGIN@14 |
15 | # spent 104µs (4+101) within Function::Parameters::BEGIN@15 which was called:
# once (4µs+101µs) by main::BEGIN@33 at line 19 | ||||
16 | 1 | 100ns | our $VERSION = '2.001003'; | ||
17 | #$VERSION =~ s/-TRIAL[0-9]*\z//; | ||||
18 | 1 | 104µs | 1 | 101µs | XSLoader::load; # spent 101µs making 1 call to XSLoader::load |
19 | 1 | 221µs | 1 | 104µs | } # spent 104µs making 1 call to Function::Parameters::BEGIN@15 |
20 | |||||
21 | sub _assert_valid_identifier { | ||||
22 | 3 | 700ns | my ($name, $with_dollar) = @_; | ||
23 | 3 | 600ns | my $bonus = $with_dollar ? '\$' : ''; | ||
24 | 3 | 43µs | 6 | 33µs | $name =~ /\A${bonus}[^\W\d]\w*\z/ # spent 30µs making 3 calls to Function::Parameters::CORE:regcomp, avg 10µs/call
# spent 3µs making 3 calls to Function::Parameters::CORE:match, avg 867ns/call |
25 | or confess qq{"$name" doesn't look like a valid identifier}; | ||||
26 | } | ||||
27 | |||||
28 | # spent 4µs (2+3) within Function::Parameters::_assert_valid_attributes which was called:
# once (2µs+3µs) by Function::Parameters::import at line 280 | ||||
29 | 1 | 200ns | my ($attrs) = @_; | ||
30 | 1 | 5µs | 1 | 3µs | $attrs =~ m{ # spent 3µs making 1 call to Function::Parameters::CORE:match |
31 | \A \s*+ | ||||
32 | : \s*+ | ||||
33 | (?&ident) (?! [^\s:(] ) (?¶m)?+ \s*+ | ||||
34 | (?: | ||||
35 | (?: : \s*+ )? | ||||
36 | (?&ident) (?! [^\s:(] ) (?¶m)?+ \s*+ | ||||
37 | )*+ | ||||
38 | \z | ||||
39 | |||||
40 | (?(DEFINE) | ||||
41 | (?<ident> | ||||
42 | [^\W\d] | ||||
43 | \w*+ | ||||
44 | ) | ||||
45 | (?<param> | ||||
46 | \( | ||||
47 | [^()\\]*+ | ||||
48 | (?: | ||||
49 | (?: | ||||
50 | \\ . | ||||
51 | | | ||||
52 | (?¶m) | ||||
53 | ) | ||||
54 | [^()\\]*+ | ||||
55 | )*+ | ||||
56 | \) | ||||
57 | ) | ||||
58 | ) | ||||
59 | }sx or confess qq{"$attrs" doesn't look like valid attributes}; | ||||
60 | } | ||||
61 | |||||
62 | sub _reify_type_moose { | ||||
63 | require Moose::Util::TypeConstraints; | ||||
64 | Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0]) | ||||
65 | } | ||||
66 | |||||
67 | sub _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 | |||||
74 | sub _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 { | ||||
80 | 2 | 981µs | 2 | 16µs | # spent 10µs (4+6) within Function::Parameters::BEGIN@80 which was called:
# once (4µs+6µs) by main::BEGIN@33 at line 80 # spent 10µs making 1 call to Function::Parameters::BEGIN@80
# spent 6µ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 | |||||
98 | sub _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 | |||||
109 | sub _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 7µs within Function::Parameters::_delete_default which was called 14 times, avg 486ns/call:
# 2 times (2µs+0s) by Function::Parameters::import at line 338, avg 1µs/call
# 2 times (1µs+0s) by Function::Parameters::import at line 341, avg 500ns/call
# 2 times (1µs+0s) by Function::Parameters::import at line 339, avg 500ns/call
# 2 times (800ns+0s) by Function::Parameters::import at line 340, avg 400ns/call
# 2 times (700ns+0s) by Function::Parameters::import at line 342, avg 350ns/call
# 2 times (700ns+0s) by Function::Parameters::import at line 343, avg 350ns/call
# 2 times (600ns+0s) by Function::Parameters::import at line 344, avg 300ns/call | ||||
120 | 14 | 2µs | my ($href, $key, $default) = @_; | ||
121 | 14 | 12µs | exists $href->{$key} ? delete $href->{$key} : $default | ||
122 | } | ||||
123 | |||||
124 | sub _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 | |||||
140 | 1 | 10µs | my %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 | |||||
191 | 1 | 4µs | my %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 | ); | ||||
225 | 1 | 800ns | for my $v (values %import_map) { | ||
226 | 12 | 3µs | if (ref $v eq 'ARRAY') { | ||
227 | $v = { | ||||
228 | 2 | 4µs | map +($_ => $import_map{$_} || die "Internal error: $v => $_"), | ||
229 | @$v | ||||
230 | }; | ||||
231 | } | ||||
232 | } | ||||
233 | |||||
234 | # spent 126µs (67+59) within Function::Parameters::import which was called:
# once (67µs+59µs) by main::BEGIN@33 at line 33 of /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v5.pl | ||||
235 | 1 | 200ns | my $class = shift; | ||
236 | |||||
237 | 1 | 100ns | my %imports; | ||
238 | 1 | 5µs | @_ = qw(:std) if !@_; | ||
239 | 1 | 300ns | for my $item (@_) { | ||
240 | 1 | 100ns | my $part; | ||
241 | 1 | 100ns | if (ref $item) { | ||
242 | $part = $item; | ||||
243 | } else { | ||||
244 | 1 | 400ns | my $type = $import_map{$item} | ||
245 | or croak qq{"$item" is not exported by the $class module}; | ||||
246 | 1 | 400ns | $part = ref $type | ||
247 | ? $type | ||||
248 | : { $item => $type }; | ||||
249 | } | ||||
250 | 1 | 2µs | @imports{keys %$part} = values %$part; | ||
251 | } | ||||
252 | |||||
253 | 1 | 100ns | my %spec; | ||
254 | |||||
255 | 1 | 7µs | 1 | 3µs | for my $name (sort keys %imports) { # spent 3µs making 1 call to Function::Parameters::CORE:sort |
256 | 2 | 1µs | 2 | 25µs | _assert_valid_identifier $name; # spent 25µs making 2 calls to Function::Parameters::_assert_valid_identifier, avg 13µs/call |
257 | 2 | 500ns | my $proto_type = $imports{$name}; | ||
258 | |||||
259 | 2 | 1µs | $proto_type = {defaults => $proto_type} unless ref $proto_type; | ||
260 | |||||
261 | 2 | 2µs | my %type = %$proto_type; | ||
262 | 2 | 3µs | while (my $defaults = delete $type{defaults}) { | ||
263 | 5 | 1µ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})]; | ||||
265 | 5 | 4µs | %type = (%$base, %type); | ||
266 | } | ||||
267 | |||||
268 | 2 | 300ns | if (exists $type{strict}) { | ||
269 | $type{check_argument_count} ||= $type{strict}; | ||||
270 | delete $type{strict}; | ||||
271 | } | ||||
272 | |||||
273 | 2 | 200ns | my %clean; | ||
274 | |||||
275 | 2 | 600ns | $clean{name} = delete $type{name} // 'optional'; | ||
276 | 2 | 3µs | 2 | 2µs | $clean{name} =~ /\A(?:optional|required|prohibited)\z/ # spent 2µs making 2 calls to Function::Parameters::CORE:match, avg 800ns/call |
277 | or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; | ||||
278 | |||||
279 | 2 | 600ns | $clean{attrs} = delete $type{attributes} // ''; | ||
280 | 2 | 800ns | 1 | 4µs | _assert_valid_attributes $clean{attrs} if $clean{attrs}; # spent 4µs making 1 call to Function::Parameters::_assert_valid_attributes |
281 | |||||
282 | 2 | 900ns | 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 | |||||
298 | 2 | 400ns | 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 | |||||
311 | 2 | 500ns | $clean{shift} = do { | ||
312 | 2 | 600ns | my $shift = delete $type{shift} // []; | ||
313 | 2 | 600ns | $shift = [$shift] if !ref $shift; | ||
314 | 2 | 300ns | my $str = ''; | ||
315 | 2 | 200ns | my @shifty_types; | ||
316 | 2 | 400ns | for my $item (@$shift) { | ||
317 | 1 | 100ns | my ($name, $type); | ||
318 | 1 | 200ns | if (ref $item) { | ||
319 | @$item == 2 or confess "A 'shift' item must have 2 elements, not " . @$item; | ||||
320 | ($name, $type) = @$item; | ||||
321 | } else { | ||||
322 | 1 | 100ns | $name = $item; | ||
323 | } | ||||
324 | 1 | 600ns | 1 | 18µs | _assert_valid_identifier $name, 1; # spent 18µs making 1 call to Function::Parameters::_assert_valid_identifier |
325 | 1 | 200ns | $name eq '$_' and confess q[Using "$_" as a parameter is not supported]; | ||
326 | 1 | 300ns | $str .= $name; | ||
327 | 1 | 100ns | 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 | } | ||||
332 | 1 | 400ns | $str .= ' '; | ||
333 | } | ||||
334 | 2 | 400ns | $clean{shift_types} = \@shifty_types; | ||
335 | 2 | 900ns | $str | ||
336 | }; | ||||
337 | |||||
338 | 2 | 2µs | 2 | 2µs | $clean{default_arguments} = _delete_default \%type, 'default_arguments', 1; # spent 2µs making 2 calls to Function::Parameters::_delete_default, avg 1µs/call |
339 | 2 | 2µs | 2 | 1µs | $clean{named_parameters} = _delete_default \%type, 'named_parameters', 1; # spent 1µs making 2 calls to Function::Parameters::_delete_default, avg 500ns/call |
340 | 2 | 900ns | 2 | 800ns | $clean{types} = _delete_default \%type, 'types', 1; # spent 800ns making 2 calls to Function::Parameters::_delete_default, avg 400ns/call |
341 | 2 | 900ns | 2 | 1µs | $clean{invocant} = _delete_default \%type, 'invocant', 0; # spent 1µs making 2 calls to Function::Parameters::_delete_default, avg 500ns/call |
342 | 2 | 800ns | 2 | 700ns | $clean{runtime} = _delete_default \%type, 'runtime', 0; # spent 700ns making 2 calls to Function::Parameters::_delete_default, avg 350ns/call |
343 | 2 | 700ns | 2 | 700ns | $clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 1; # spent 700ns making 2 calls to Function::Parameters::_delete_default, avg 350ns/call |
344 | 2 | 900ns | 2 | 600ns | $clean{check_argument_types} = _delete_default \%type, 'check_argument_types', 1; # spent 600ns making 2 calls to Function::Parameters::_delete_default, avg 300ns/call |
345 | |||||
346 | 2 | 400ns | %type and confess "Invalid keyword property: @{[sort keys %type]}"; | ||
347 | |||||
348 | 2 | 2µs | $spec{$name} = \%clean; | ||
349 | } | ||||
350 | |||||
351 | 1 | 900ns | my %config = %{$^H{+HINTK_CONFIG} // {}}; | ||
352 | 1 | 500ns | for my $kw (keys %spec) { | ||
353 | 2 | 400ns | my $type = $spec{$kw}; | ||
354 | |||||
355 | my $flags = | ||||
356 | $type->{name} eq 'prohibited' ? FLAG_ANON_OK : | ||||
357 | 2 | 700ns | $type->{name} eq 'required' ? FLAG_NAME_OK : | ||
358 | FLAG_ANON_OK | FLAG_NAME_OK | ||||
359 | ; | ||||
360 | 2 | 500ns | $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments}; | ||
361 | 2 | 400ns | $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count}; | ||
362 | 2 | 100ns | $flags |= FLAG_CHECK_TARGS if $type->{check_argument_types}; | ||
363 | 2 | 200ns | $flags |= FLAG_INVOCANT if $type->{invocant}; | ||
364 | 2 | 300ns | $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters}; | ||
365 | 2 | 200ns | $flags |= FLAG_TYPES_OK if $type->{types}; | ||
366 | 2 | 200ns | $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}, | ||||
375 | 2 | 3µs | ), | ||
376 | }; | ||||
377 | } | ||||
378 | 1 | 5µs | $^H{+HINTK_CONFIG} = \%config; | ||
379 | } | ||||
380 | |||||
381 | sub 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 | |||||
395 | our %metadata; | ||||
396 | |||||
397 | # spent 5µs within Function::Parameters::_register_info which was called:
# once (5µs+0s) by main::NULL at line 125 of /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v5.pl | ||||
398 | my ( | ||||
399 | 1 | 800ns | $key, | ||
400 | $declarator, | ||||
401 | $shift, | ||||
402 | $positional_required, | ||||
403 | $positional_optional, | ||||
404 | $named_required, | ||||
405 | $named_optional, | ||||
406 | $slurpy, | ||||
407 | $slurpy_type, | ||||
408 | ) = @_; | ||||
409 | |||||
410 | 1 | 2µ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 | |||||
420 | 1 | 3µs | $metadata{$key} = $info; | ||
421 | } | ||||
422 | |||||
423 | sub _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 | |||||
432 | sub _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 | |||||
443 | sub 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 | |||||
464 | 1 | 9µs | 'ok' | ||
465 | |||||
466 | __END__ | ||||
# spent 7µs within Function::Parameters::CORE:match which was called 6 times, avg 1µs/call:
# 3 times (3µs+0s) by Function::Parameters::_assert_valid_identifier at line 24, avg 867ns/call
# 2 times (2µs+0s) by Function::Parameters::import at line 276, avg 800ns/call
# once (3µs+0s) by Function::Parameters::_assert_valid_attributes at line 30 | |||||
# spent 30µs within Function::Parameters::CORE:regcomp which was called 3 times, avg 10µs/call:
# 3 times (30µs+0s) by Function::Parameters::_assert_valid_identifier at line 24, avg 10µs/call | |||||
# spent 3µs within Function::Parameters::CORE:sort which was called:
# once (3µs+0s) by Function::Parameters::import at line 255 |