Commit | Line | Data |
7a63380c |
1 | package Function::Parameters; |
2 | |
7dd35535 |
3 | use v5.14.0; |
4 | |
7a63380c |
5 | use strict; |
6 | use warnings; |
7 | |
63915d26 |
8 | use Carp qw(confess); |
9 | |
db81d362 |
10 | use XSLoader; |
11 | BEGIN { |
e33f970b |
12 | our $VERSION = '0.10'; |
db81d362 |
13 | XSLoader::load; |
7a63380c |
14 | } |
15 | |
2d5cf47a |
16 | sub _assert_valid_identifier { |
17 | my ($name, $with_dollar) = @_; |
18 | my $bonus = $with_dollar ? '\$' : ''; |
19 | $name =~ /^${bonus}[^\W\d]\w*\z/ |
20 | or confess qq{"$name" doesn't look like a valid identifier}; |
21 | } |
22 | |
b72eb6ee |
23 | sub _assert_valid_attributes { |
24 | my ($attrs) = @_; |
25 | $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/ |
26 | or confess qq{"$attrs" doesn't look like valid attributes}; |
27 | } |
28 | |
125c067e |
29 | my @bare_arms = qw(function method); |
2d5cf47a |
30 | my %type_map = ( |
63915d26 |
31 | function => { |
32 | name => 'optional', |
33 | default_arguments => 1, |
34 | check_argument_count => 0, |
35 | }, |
7947f7ce |
36 | method => { |
37 | name => 'optional', |
63915d26 |
38 | default_arguments => 1, |
39 | check_argument_count => 0, |
7947f7ce |
40 | attrs => ':method', |
63915d26 |
41 | shift => '$self', |
d8e5d540 |
42 | invocant => 1, |
7947f7ce |
43 | }, |
a23979e1 |
44 | classmethod => { |
45 | name => 'optional', |
63915d26 |
46 | default_arguments => 1, |
47 | check_argument_count => 0, |
698e861c |
48 | attributes => ':method', |
63915d26 |
49 | shift => '$class', |
d8e5d540 |
50 | invocant => 1, |
a23979e1 |
51 | }, |
2d5cf47a |
52 | ); |
7817d698 |
53 | for my $k (keys %type_map) { |
54 | $type_map{$k . '_strict'} = { |
55 | %{$type_map{$k}}, |
56 | check_argument_count => 1, |
57 | }; |
58 | } |
c9a39f6b |
59 | |
db81d362 |
60 | sub import { |
61 | my $class = shift; |
7a63380c |
62 | |
fcaf7811 |
63 | if (!@_) { |
64 | @_ = { |
65 | fun => 'function', |
66 | method => 'method', |
67 | }; |
68 | } |
69 | if (@_ == 1 && $_[0] eq ':strict') { |
70 | @_ = { |
71 | fun => 'function_strict', |
72 | method => 'method_strict', |
73 | }; |
74 | } |
125c067e |
75 | if (@_ == 1 && ref($_[0]) eq 'HASH') { |
fcaf7811 |
76 | @_ = map [$_, $_[0]{$_}], keys %{$_[0]}; |
125c067e |
77 | } |
7a63380c |
78 | |
125c067e |
79 | my %spec; |
80 | |
81 | my $bare = 0; |
82 | for my $proto (@_) { |
83 | my $item = ref $proto |
84 | ? $proto |
85 | : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})] |
86 | ; |
ae6e00b5 |
87 | my ($name, $proto_type) = @$item; |
2d5cf47a |
88 | _assert_valid_identifier $name; |
89 | |
ae6e00b5 |
90 | unless (ref $proto_type) { |
91 | # use '||' instead of 'or' to preserve $proto_type in the error message |
92 | $proto_type = $type_map{$proto_type} |
93 | || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; |
2d5cf47a |
94 | } |
b72eb6ee |
95 | |
ae6e00b5 |
96 | my %type = %$proto_type; |
97 | my %clean; |
10acc8b1 |
98 | |
ae6e00b5 |
99 | $clean{name} = delete $type{name} || 'optional'; |
100 | $clean{name} =~ /^(?:optional|required|prohibited)\z/ |
101 | or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; |
10acc8b1 |
102 | |
ae6e00b5 |
103 | $clean{shift} = delete $type{shift} || ''; |
10acc8b1 |
104 | _assert_valid_identifier $clean{shift}, 1 if $clean{shift}; |
105 | |
698e861c |
106 | $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs); |
10acc8b1 |
107 | _assert_valid_attributes $clean{attrs} if $clean{attrs}; |
125c067e |
108 | |
59f51b8b |
109 | $clean{default_arguments} = |
110 | exists $type{default_arguments} |
111 | ? !!delete $type{default_arguments} |
112 | : 1 |
113 | ; |
63915d26 |
114 | $clean{check_argument_count} = !!delete $type{check_argument_count}; |
d8e5d540 |
115 | $clean{invocant} = !!delete $type{invocant}; |
63915d26 |
116 | |
ae6e00b5 |
117 | %type and confess "Invalid keyword property: @{[keys %type]}"; |
118 | |
119 | $spec{$name} = \%clean; |
125c067e |
120 | } |
121 | |
db81d362 |
122 | for my $kw (keys %spec) { |
123 | my $type = $spec{$kw}; |
124 | |
63915d26 |
125 | my $flags = |
126 | $type->{name} eq 'prohibited' ? FLAG_ANON_OK : |
127 | $type->{name} eq 'required' ? FLAG_NAME_OK : |
128 | FLAG_ANON_OK | FLAG_NAME_OK |
129 | ; |
130 | $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments}; |
131 | $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count}; |
d8e5d540 |
132 | $flags |= FLAG_INVOCANT if $type->{invocant}; |
63915d26 |
133 | $^H{HINTK_FLAGS_ . $kw} = $flags; |
ae6e00b5 |
134 | $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; |
10acc8b1 |
135 | $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; |
db81d362 |
136 | $^H{+HINTK_KEYWORDS} .= "$kw "; |
125c067e |
137 | } |
eeb7df5f |
138 | } |
139 | |
db81d362 |
140 | sub unimport { |
eeb7df5f |
141 | my $class = shift; |
125c067e |
142 | |
db81d362 |
143 | if (!@_) { |
144 | delete $^H{+HINTK_KEYWORDS}; |
125c067e |
145 | return; |
146 | } |
147 | |
db81d362 |
148 | for my $kw (@_) { |
149 | $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g; |
125c067e |
150 | } |
151 | } |
152 | |
db81d362 |
153 | |
125c067e |
154 | 'ok' |
7a63380c |
155 | |
156 | __END__ |
157 | |
f2541b7d |
158 | =encoding UTF-8 |
159 | |
7a63380c |
160 | =head1 NAME |
161 | |
162 | Function::Parameters - subroutine definitions with parameter lists |
163 | |
164 | =head1 SYNOPSIS |
165 | |
166 | use Function::Parameters; |
167 | |
698e861c |
168 | # simple function |
7a63380c |
169 | fun foo($bar, $baz) { |
170 | return $bar + $baz; |
171 | } |
172 | |
698e861c |
173 | # function with prototype |
d71d548b |
174 | fun mymap($fun, @args) |
175 | :(&@) |
176 | { |
7a63380c |
177 | my @res; |
178 | for (@args) { |
179 | push @res, $fun->($_); |
180 | } |
181 | @res |
182 | } |
183 | |
184 | print "$_\n" for mymap { $_ * 2 } 1 .. 4; |
125c067e |
185 | |
698e861c |
186 | # method with implicit $self |
125c067e |
187 | method set_name($name) { |
188 | $self->{name} = $name; |
189 | } |
d8e5d540 |
190 | |
191 | # method with explicit invocant |
192 | method new($class: %init) { |
193 | return bless { %init }, $class; |
194 | } |
195 | |
698e861c |
196 | # function with default arguments |
197 | fun search($haystack, $needle = qr/^(?!)/, $offset = 0) { |
198 | ... |
199 | } |
d8e5d540 |
200 | |
698e861c |
201 | # method with default arguments |
202 | method skip($amount = 1) { |
203 | $self->{position} += $amount; |
204 | } |
205 | |
125c067e |
206 | =cut |
207 | |
208 | =pod |
209 | |
8dbfd12d |
210 | use Function::Parameters qw(:strict); |
211 | |
212 | fun greet($x) { |
213 | print "Hello, $x\n"; |
214 | } |
215 | |
216 | greet "foo", "bar"; |
217 | # Dies at runtime with "Too many arguments for fun greet" |
218 | |
219 | greet; |
220 | # Dies at runtime with "Not enough arguments for fun greet" |
221 | |
222 | =cut |
223 | |
224 | =pod |
225 | |
698e861c |
226 | # use different keywords |
63a24d7c |
227 | use Function::Parameters { |
228 | proc => 'function', |
229 | meth => 'method', |
230 | }; |
c9a39f6b |
231 | |
125c067e |
232 | my $f = proc ($x) { $x * 2 }; |
233 | meth get_age() { |
234 | return $self->{age}; |
235 | } |
236 | |
7a63380c |
237 | =head1 DESCRIPTION |
238 | |
239 | This module lets you use parameter lists in your subroutines. Thanks to |
63a24d7c |
240 | L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters. |
7a63380c |
241 | |
7a63380c |
242 | =head2 Basic stuff |
243 | |
244 | To use this new functionality, you have to use C<fun> instead of C<sub> - |
245 | C<sub> continues to work as before. The syntax is almost the same as for |
246 | C<sub>, but after the subroutine name (or directly after C<fun> if you're |
125c067e |
247 | writing an anonymous sub) you can write a parameter list in parentheses. This |
7a63380c |
248 | list consists of comma-separated variables. |
249 | |
250 | The effect of C<fun foo($bar, $baz) {> is as if you'd written |
251 | C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply |
95915793 |
252 | copied into L<my|perlfunc/my-EXPR> and initialized from L<@_|perlvar/"@_">. |
7a63380c |
253 | |
125c067e |
254 | In addition you can use C<method>, which understands the same syntax as C<fun> |
255 | but automatically creates a C<$self> variable for you. So by writing |
256 | C<method foo($bar, $baz) {> you get the same effect as |
257 | C<sub foo { my $self = shift; my ($bar, $baz) = @_; >. |
7a63380c |
258 | |
125c067e |
259 | =head2 Customizing the generated keywords |
c9a39f6b |
260 | |
63a24d7c |
261 | You can customize the names of the keywords injected into your scope. To do |
698e861c |
262 | that you pass a reference to a hash mapping keywords to types in the import |
263 | list: |
264 | |
265 | use Function::Parameters { |
266 | KEYWORD1 => TYPE1, |
267 | KEYWORD2 => TYPE2, |
268 | ... |
269 | }; |
270 | |
271 | Or more concretely: |
7a63380c |
272 | |
125c067e |
273 | use Function::Parameters { proc => 'function', meth => 'method' }; # -or- |
274 | use Function::Parameters { proc => 'function' }; # -or- |
a23979e1 |
275 | use Function::Parameters { meth => 'method' }; # etc. |
125c067e |
276 | |
277 | The first line creates two keywords, C<proc> and C<meth> (for defining |
278 | functions and methods, respectively). The last two lines only create one |
698e861c |
279 | keyword. Generally the hash keys (keywords) can be any identifiers you want |
7817d698 |
280 | while the values (types) have to be either a hash reference (see below) or |
281 | C<'function'>, C<'method'>, C<'classmethod'>, C<'function_strict'>, |
282 | C<'method_strict'>, or C<'classmethod_strict'>. The main difference between |
698e861c |
283 | C<'function'> and C<'method'> is that C<'method'>s automatically |
284 | L<shift|perlfunc/shift> their first argument into C<$self> (C<'classmethod'>s |
285 | are similar but shift into C<$class>). |
125c067e |
286 | |
287 | The following shortcuts are available: |
288 | |
289 | use Function::Parameters; |
290 | # is equivalent to # |
291 | use Function::Parameters { fun => 'function', method => 'method' }; |
292 | |
293 | =cut |
294 | |
295 | =pod |
296 | |
fcaf7811 |
297 | use Function::Parameters ':strict'; |
298 | # is equivalent to # |
299 | use Function::Parameters { fun => 'function_strict', method => 'method_strict' }; |
300 | |
301 | =pod |
302 | |
63a24d7c |
303 | The following shortcuts are deprecated and may be removed from a future version |
698e861c |
304 | of this module: |
63a24d7c |
305 | |
306 | # DEPRECATED |
125c067e |
307 | use Function::Parameters 'foo'; |
308 | # is equivalent to # |
309 | use Function::Parameters { 'foo' => 'function' }; |
310 | |
311 | =cut |
312 | |
313 | =pod |
314 | |
63a24d7c |
315 | # DEPRECATED |
125c067e |
316 | use Function::Parameters 'foo', 'bar'; |
317 | # is equivalent to # |
318 | use Function::Parameters { 'foo' => 'function', 'bar' => 'method' }; |
319 | |
fcaf7811 |
320 | That is, if you want to create custom keywords with L<Function::Parameters>, |
321 | use a hashref, not a list of strings. |
63a24d7c |
322 | |
fcaf7811 |
323 | You can tune the properties of the generated keywords even more by passing |
698e861c |
324 | a hashref instead of a string. This hash can have the following keys: |
ce052c57 |
325 | |
326 | =over |
327 | |
328 | =item C<name> |
329 | |
330 | Valid values: C<optional> (default), C<required> (all uses of this keyword must |
331 | specify a function name), and C<prohibited> (all uses of this keyword must not |
332 | specify a function name). This means a C<< name => 'prohibited' >> keyword can |
333 | only be used for defining anonymous functions. |
334 | |
335 | =item C<shift> |
336 | |
337 | Valid values: strings that look like a scalar variable. Any function created by |
338 | this keyword will automatically L<shift|perlfunc/shift> its first argument into |
63a24d7c |
339 | a local variable whose name is specified here. |
ce052c57 |
340 | |
d8e5d540 |
341 | =item C<invocant> |
342 | |
343 | Valid values: booleans. This lets users of this keyword specify an explicit |
344 | invocant, that is, the first parameter may be followed by a C<:> (colon) |
345 | instead of a comma and will by initialized by shifting the first element off |
346 | C<@_>. |
347 | |
348 | You can combine C<shift> and C<invocant>, in which case the variable named in |
8dbfd12d |
349 | C<shift> serves as a default shift target for functions that don't specify an |
d8e5d540 |
350 | explicit invocant. |
351 | |
698e861c |
352 | =item C<attributes>, C<attrs> |
273c6544 |
353 | |
354 | Valid values: strings that are valid source code for attributes. Any value |
355 | specified here will be inserted as a subroutine attribute in the generated |
356 | code. Thus: |
357 | |
698e861c |
358 | use Function::Parameters { sub_l => { attributes => ':lvalue' } }; |
273c6544 |
359 | sub_l foo() { |
360 | ... |
361 | } |
362 | |
363 | turns into |
364 | |
365 | sub foo :lvalue { |
366 | ... |
367 | } |
368 | |
698e861c |
369 | It is recommended that you use C<attributes> in new code but C<attrs> is also |
370 | accepted for now. |
371 | |
372 | =item C<default_arguments> |
373 | |
374 | Valid values: booleans. This property is on by default, so you have to pass |
375 | C<< default_arguments => 0 >> to turn it off. If it is disabled, using C<=> in |
376 | a parameter list causes a syntax error. Otherwise it lets you specify |
377 | default arguments directly in the parameter list: |
378 | |
379 | fun foo($x, $y = 42, $z = []) { |
380 | ... |
381 | } |
382 | |
383 | turns into |
384 | |
385 | sub foo { |
386 | my ($x, $y, $z) = @_; |
387 | $y = 42 if @_ < 2; |
388 | $z = [] if @_ < 3; |
389 | ... |
390 | } |
391 | |
1e0f1595 |
392 | You can even refer to previous parameters in the same parameter list: |
698e861c |
393 | |
1e0f1595 |
394 | print fun ($x, $y = $x + 1) { "$x and $y" }->(9); # "9 and 10" |
698e861c |
395 | |
1e0f1595 |
396 | This also works with the implicit first parameter of methods: |
698e861c |
397 | |
1e0f1595 |
398 | method scale($factor = $self->default_factor) { |
399 | $self->{amount} *= $factor; |
400 | } |
698e861c |
401 | |
402 | =item C<check_argument_count> |
403 | |
404 | Valid values: booleans. This property is off by default. If it is enabled, the |
405 | generated code will include checks to make sure the number of passed arguments |
406 | is correct (and otherwise throw an exception via L<Carp::croak|Carp>): |
407 | |
408 | fun foo($x, $y = 42, $z = []) { |
409 | ... |
410 | } |
411 | |
412 | turns into |
413 | |
414 | sub foo { |
415 | Carp::croak "Not enough arguments for fun foo" if @_ < 1; |
416 | Carp::croak "Too many arguments for fun foo" if @_ > 3; |
417 | my ($x, $y, $z) = @_; |
418 | $y = 42 if @_ < 2; |
419 | $z = [] if @_ < 3; |
420 | ... |
421 | } |
422 | |
ce052c57 |
423 | =back |
424 | |
698e861c |
425 | Plain C<'function'> is equivalent to: |
426 | |
427 | { |
428 | name => 'optional', |
429 | default_arguments => 1, |
430 | check_argument_count => 0, |
431 | } |
432 | |
433 | (These are all default values so C<'function'> is also equivalent to C<{}>.) |
434 | |
7817d698 |
435 | C<'function_strict'> is like C<'function'> but with |
436 | C<< check_argument_count => 1 >>. |
437 | |
698e861c |
438 | C<'method'> is equivalent to: |
439 | |
440 | { |
441 | name => 'optional', |
442 | default_arguments => 1, |
443 | check_argument_count => 0, |
444 | attributes => ':method', |
445 | shift => '$self', |
d8e5d540 |
446 | invocant => 1, |
698e861c |
447 | } |
448 | |
7817d698 |
449 | C<'method_strict'> is like C<'method'> but with |
450 | C<< check_argument_count => 1 >>. |
451 | |
698e861c |
452 | C<'classmethod'> is equivalent to: |
453 | |
454 | { |
455 | name => 'optional', |
456 | default_arguments => 1, |
457 | check_argument_count => 0, |
458 | attributes => ':method', |
459 | shift => '$class', |
d8e5d540 |
460 | invocant => 1, |
698e861c |
461 | } |
ce052c57 |
462 | |
7817d698 |
463 | C<'classmethod_strict'> is like C<'classmethod'> but with |
464 | C<< check_argument_count => 1 >>. |
465 | |
63a24d7c |
466 | =head2 Syntax and generated code |
7a63380c |
467 | |
468 | Normally, Perl subroutines are not in scope in their own body, meaning the |
63a24d7c |
469 | parser doesn't know the name C<foo> or its prototype while processing the body |
470 | of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as |
7a63380c |
471 | C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the |
472 | interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger |
473 | a I<foo() called too early to check prototype> warning. This module attempts |
698e861c |
474 | to fix all of this by adding a subroutine declaration before the function body, |
7a63380c |
475 | so the parser knows the name (and possibly prototype) while it processes the |
476 | body. Thus C<fun foo($x) :($) { $x }> really turns into |
698e861c |
477 | C<sub foo ($) { sub foo ($); my ($x) = @_; $x }>. |
7a63380c |
478 | |
95915793 |
479 | If you need L<subroutine attributes|perlsub/Subroutine-Attributes>, you can |
125c067e |
480 | put them after the parameter list with their usual syntax. |
481 | |
482 | Syntactically, these new parameter lists live in the spot normally occupied |
483 | by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by |
484 | specifying it as the first attribute (this is syntactically unambiguous |
63a24d7c |
485 | because normal attributes have to start with a letter while a prototype starts |
486 | with C<(>). |
487 | |
698e861c |
488 | As an example, the following declaration uses every available feature |
489 | (subroutine name, parameter list, default arguments, prototype, default |
d8e5d540 |
490 | attributes, attributes, argument count checks, and implicit C<$self> overriden |
491 | by an explicit invocant declaration): |
63a24d7c |
492 | |
d8e5d540 |
493 | method foo($this: $x, $y, $z = sqrt 5) |
d71d548b |
494 | :($$$;$) |
495 | :lvalue |
496 | :Banana(2 + 2) |
497 | { |
63a24d7c |
498 | ... |
499 | } |
500 | |
501 | And here's what it turns into: |
502 | |
698e861c |
503 | sub foo ($$$;$) :method :lvalue :Banana(2 + 2) { |
504 | sub foo ($$$;$); |
3087bda1 |
505 | Carp::croak "Not enough arguments for method foo" if @_ < 3; |
698e861c |
506 | Carp::croak "Too many arguments for method foo" if @_ > 4; |
d8e5d540 |
507 | my $this = shift; |
698e861c |
508 | my ($x, $y, $z) = @_; |
509 | $z = sqrt 5 if @_ < 3; |
63a24d7c |
510 | ... |
511 | } |
512 | |
513 | Another example: |
514 | |
d71d548b |
515 | my $coderef = fun ($p, $q) |
516 | :(;$$) |
63a24d7c |
517 | :lvalue |
518 | :Gazebo((>:O)) { |
519 | ... |
520 | }; |
521 | |
522 | And the generated code: |
523 | |
698e861c |
524 | my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { |
525 | # vvv only if check_argument_count is enabled vvv |
526 | Carp::croak "Not enough arguments for fun (anon)" if @_ < 2; |
527 | Carp::croak "Too many arguments for fun (anon)" if @_ > 2; |
7817d698 |
528 | # ^^^ ^^^ |
698e861c |
529 | my ($p, $q) = @_; |
63a24d7c |
530 | ... |
531 | }; |
532 | |
533 | =head2 Wrapping Function::Parameters |
125c067e |
534 | |
db81d362 |
535 | If you want to wrap L<Function::Parameters>, you just have to call its |
536 | C<import> method. It always applies to the file that is currently being parsed |
95915793 |
537 | and its effects are L<lexical|perlpragma> (i.e. it works like L<warnings> or |
538 | L<strict>). |
63a24d7c |
539 | |
540 | package Some::Wrapper; |
541 | use Function::Parameters (); |
542 | sub import { |
543 | Function::Parameters->import; |
698e861c |
544 | # or Function::Parameters->import(@custom_import_args); |
63a24d7c |
545 | } |
eeb7df5f |
546 | |
7a63380c |
547 | =head1 AUTHOR |
548 | |
549 | Lukas Mai, C<< <l.mai at web.de> >> |
550 | |
551 | =head1 COPYRIGHT & LICENSE |
552 | |
db81d362 |
553 | Copyright 2010, 2011, 2012 Lukas Mai. |
7a63380c |
554 | |
555 | This program is free software; you can redistribute it and/or modify it |
556 | under the terms of either: the GNU General Public License as published |
557 | by the Free Software Foundation; or the Artistic License. |
558 | |
559 | See http://dev.perl.org/licenses/ for more information. |
560 | |
561 | =cut |