Commit | Line | Data |
7a63380c |
1 | package Function::Parameters; |
2 | |
7dd35535 |
3 | use v5.14.0; |
4 | |
7a63380c |
5 | use strict; |
6 | use warnings; |
7 | |
db81d362 |
8 | use XSLoader; |
9 | BEGIN { |
5d0dba1f |
10 | our $VERSION = '0.05_03'; |
db81d362 |
11 | XSLoader::load; |
7a63380c |
12 | } |
13 | |
db81d362 |
14 | use Carp qw(confess); |
7a63380c |
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 = ( |
31 | function => { name => 'optional' }, |
7947f7ce |
32 | method => { |
33 | name => 'optional', |
34 | shift => '$self', |
35 | attrs => ':method', |
36 | }, |
a23979e1 |
37 | classmethod => { |
38 | name => 'optional', |
39 | shift => '$class', |
40 | attrs => ':method', |
41 | }, |
2d5cf47a |
42 | ); |
c9a39f6b |
43 | |
db81d362 |
44 | sub import { |
45 | my $class = shift; |
7a63380c |
46 | |
b72eb6ee |
47 | @_ or @_ = { |
48 | fun => 'function', |
49 | method => 'method', |
50 | }; |
125c067e |
51 | if (@_ == 1 && ref($_[0]) eq 'HASH') { |
52 | @_ = map [$_, $_[0]{$_}], keys %{$_[0]} |
53 | or return; |
54 | } |
7a63380c |
55 | |
125c067e |
56 | my %spec; |
57 | |
58 | my $bare = 0; |
59 | for my $proto (@_) { |
60 | my $item = ref $proto |
61 | ? $proto |
62 | : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})] |
63 | ; |
ae6e00b5 |
64 | my ($name, $proto_type) = @$item; |
2d5cf47a |
65 | _assert_valid_identifier $name; |
66 | |
ae6e00b5 |
67 | unless (ref $proto_type) { |
68 | # use '||' instead of 'or' to preserve $proto_type in the error message |
69 | $proto_type = $type_map{$proto_type} |
70 | || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; |
2d5cf47a |
71 | } |
b72eb6ee |
72 | |
ae6e00b5 |
73 | my %type = %$proto_type; |
74 | my %clean; |
10acc8b1 |
75 | |
ae6e00b5 |
76 | $clean{name} = delete $type{name} || 'optional'; |
77 | $clean{name} =~ /^(?:optional|required|prohibited)\z/ |
78 | or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; |
10acc8b1 |
79 | |
ae6e00b5 |
80 | $clean{shift} = delete $type{shift} || ''; |
10acc8b1 |
81 | _assert_valid_identifier $clean{shift}, 1 if $clean{shift}; |
82 | |
83 | $clean{attrs} = delete $type{attrs} || ''; |
84 | _assert_valid_attributes $clean{attrs} if $clean{attrs}; |
125c067e |
85 | |
ae6e00b5 |
86 | %type and confess "Invalid keyword property: @{[keys %type]}"; |
87 | |
88 | $spec{$name} = \%clean; |
125c067e |
89 | } |
90 | |
db81d362 |
91 | for my $kw (keys %spec) { |
92 | my $type = $spec{$kw}; |
93 | |
ae6e00b5 |
94 | $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; |
10acc8b1 |
95 | $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; |
db81d362 |
96 | $^H{HINTK_NAME_ . $kw} = |
97 | $type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED : |
98 | $type->{name} eq 'required' ? FLAG_NAME_REQUIRED : |
99 | FLAG_NAME_OPTIONAL |
100 | ; |
101 | $^H{+HINTK_KEYWORDS} .= "$kw "; |
125c067e |
102 | } |
eeb7df5f |
103 | } |
104 | |
db81d362 |
105 | sub unimport { |
eeb7df5f |
106 | my $class = shift; |
125c067e |
107 | |
db81d362 |
108 | if (!@_) { |
109 | delete $^H{+HINTK_KEYWORDS}; |
125c067e |
110 | return; |
111 | } |
112 | |
db81d362 |
113 | for my $kw (@_) { |
114 | $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g; |
125c067e |
115 | } |
116 | } |
117 | |
db81d362 |
118 | |
125c067e |
119 | 'ok' |
7a63380c |
120 | |
121 | __END__ |
122 | |
123 | =head1 NAME |
124 | |
125 | Function::Parameters - subroutine definitions with parameter lists |
126 | |
127 | =head1 SYNOPSIS |
128 | |
129 | use Function::Parameters; |
130 | |
131 | fun foo($bar, $baz) { |
132 | return $bar + $baz; |
133 | } |
134 | |
135 | fun mymap($fun, @args) :(&@) { |
136 | my @res; |
137 | for (@args) { |
138 | push @res, $fun->($_); |
139 | } |
140 | @res |
141 | } |
142 | |
143 | print "$_\n" for mymap { $_ * 2 } 1 .. 4; |
125c067e |
144 | |
145 | method set_name($name) { |
146 | $self->{name} = $name; |
147 | } |
7a63380c |
148 | |
125c067e |
149 | =cut |
150 | |
151 | =pod |
152 | |
63a24d7c |
153 | use Function::Parameters { |
154 | proc => 'function', |
155 | meth => 'method', |
156 | }; |
c9a39f6b |
157 | |
125c067e |
158 | my $f = proc ($x) { $x * 2 }; |
159 | meth get_age() { |
160 | return $self->{age}; |
161 | } |
162 | |
7a63380c |
163 | =head1 DESCRIPTION |
164 | |
165 | This module lets you use parameter lists in your subroutines. Thanks to |
63a24d7c |
166 | L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters. |
7a63380c |
167 | |
db81d362 |
168 | WARNING: This is my first attempt at writing L<XS code|perlxs> and I have |
7a63380c |
169 | almost no experience with perl's internals. So while this module might |
170 | appear to work, it could also conceivably make your programs segfault. |
171 | Consider this module alpha quality. |
172 | |
173 | =head2 Basic stuff |
174 | |
175 | To use this new functionality, you have to use C<fun> instead of C<sub> - |
176 | C<sub> continues to work as before. The syntax is almost the same as for |
177 | C<sub>, but after the subroutine name (or directly after C<fun> if you're |
125c067e |
178 | writing an anonymous sub) you can write a parameter list in parentheses. This |
7a63380c |
179 | list consists of comma-separated variables. |
180 | |
181 | The effect of C<fun foo($bar, $baz) {> is as if you'd written |
182 | C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply |
183 | copied into C<my> and initialized from L<@_|perlvar/"@_">. |
184 | |
125c067e |
185 | In addition you can use C<method>, which understands the same syntax as C<fun> |
186 | but automatically creates a C<$self> variable for you. So by writing |
187 | C<method foo($bar, $baz) {> you get the same effect as |
188 | C<sub foo { my $self = shift; my ($bar, $baz) = @_; >. |
7a63380c |
189 | |
125c067e |
190 | =head2 Customizing the generated keywords |
c9a39f6b |
191 | |
63a24d7c |
192 | You can customize the names of the keywords injected into your scope. To do |
193 | that you pass a hash reference in the import list: |
7a63380c |
194 | |
125c067e |
195 | use Function::Parameters { proc => 'function', meth => 'method' }; # -or- |
196 | use Function::Parameters { proc => 'function' }; # -or- |
a23979e1 |
197 | use Function::Parameters { meth => 'method' }; # etc. |
125c067e |
198 | |
199 | The first line creates two keywords, C<proc> and C<meth> (for defining |
200 | functions and methods, respectively). The last two lines only create one |
201 | keyword. Generally the hash keys can be any identifiers you want while the |
a23979e1 |
202 | values have to be either C<function>, C<method>, C<classmethod> or a hash |
203 | reference (see below). The difference between C<function> and C<method> is that |
204 | C<method>s automatically L<shift|perlfunc/shift> their first argument into |
205 | C<$self> (C<classmethod>s are similar but shift into C<$class>). |
125c067e |
206 | |
207 | The following shortcuts are available: |
208 | |
209 | use Function::Parameters; |
210 | # is equivalent to # |
211 | use Function::Parameters { fun => 'function', method => 'method' }; |
212 | |
213 | =cut |
214 | |
215 | =pod |
216 | |
63a24d7c |
217 | The following shortcuts are deprecated and may be removed from a future version |
218 | of the module: |
219 | |
220 | # DEPRECATED |
125c067e |
221 | use Function::Parameters 'foo'; |
222 | # is equivalent to # |
223 | use Function::Parameters { 'foo' => 'function' }; |
224 | |
225 | =cut |
226 | |
227 | =pod |
228 | |
63a24d7c |
229 | # DEPRECATED |
125c067e |
230 | use Function::Parameters 'foo', 'bar'; |
231 | # is equivalent to # |
232 | use Function::Parameters { 'foo' => 'function', 'bar' => 'method' }; |
233 | |
63a24d7c |
234 | That is, if you want to pass arguments to L<Function::Parameters>, use a |
235 | hashref, not a list of strings. |
236 | |
ce052c57 |
237 | You can customize things even more by passing a hashref instead of C<function> |
238 | or C<method>. This hash can have the following keys: |
239 | |
240 | =over |
241 | |
242 | =item C<name> |
243 | |
244 | Valid values: C<optional> (default), C<required> (all uses of this keyword must |
245 | specify a function name), and C<prohibited> (all uses of this keyword must not |
246 | specify a function name). This means a C<< name => 'prohibited' >> keyword can |
247 | only be used for defining anonymous functions. |
248 | |
249 | =item C<shift> |
250 | |
251 | Valid values: strings that look like a scalar variable. Any function created by |
252 | this keyword will automatically L<shift|perlfunc/shift> its first argument into |
63a24d7c |
253 | a local variable whose name is specified here. |
ce052c57 |
254 | |
273c6544 |
255 | =item C<attrs> |
256 | |
257 | Valid values: strings that are valid source code for attributes. Any value |
258 | specified here will be inserted as a subroutine attribute in the generated |
259 | code. Thus: |
260 | |
261 | use Function::Parameters { sub_l => { attrs => ':lvalue' } }; |
262 | sub_l foo() { |
263 | ... |
264 | } |
265 | |
266 | turns into |
267 | |
268 | sub foo :lvalue { |
269 | ... |
270 | } |
271 | |
ce052c57 |
272 | =back |
273 | |
a23979e1 |
274 | Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, plain |
273c6544 |
275 | C<'method'> is equivalent to |
a23979e1 |
276 | C<< { name => 'optional', shift => '$self', attrs => ':method' } >>, and plain |
277 | C<'classmethod'> is equivalent to |
278 | C<< { name => 'optional', shift => '$class', attrs => ':method' } >>. |
ce052c57 |
279 | |
63a24d7c |
280 | =head2 Syntax and generated code |
7a63380c |
281 | |
282 | Normally, Perl subroutines are not in scope in their own body, meaning the |
63a24d7c |
283 | parser doesn't know the name C<foo> or its prototype while processing the body |
284 | of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as |
7a63380c |
285 | C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the |
286 | interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger |
287 | a I<foo() called too early to check prototype> warning. This module attempts |
288 | to fix all of this by adding a subroutine declaration before the definition, |
289 | so the parser knows the name (and possibly prototype) while it processes the |
290 | body. Thus C<fun foo($x) :($) { $x }> really turns into |
291 | C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>. |
292 | |
125c067e |
293 | If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can |
294 | put them after the parameter list with their usual syntax. |
295 | |
296 | Syntactically, these new parameter lists live in the spot normally occupied |
297 | by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by |
298 | specifying it as the first attribute (this is syntactically unambiguous |
63a24d7c |
299 | because normal attributes have to start with a letter while a prototype starts |
300 | with C<(>). |
301 | |
302 | As an example, the following declaration uses every feature available |
303 | (subroutine name, parameter list, prototype, attributes, and implicit |
304 | C<$self>): |
305 | |
306 | method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) { |
307 | ... |
308 | } |
309 | |
310 | And here's what it turns into: |
311 | |
312 | sub foo ($;$@); sub foo ($;$@) :lvalue :Banana(2 + 2) { my $self = shift; my ($x, $y, @z) = @_; |
313 | ... |
314 | } |
315 | |
316 | Another example: |
317 | |
318 | my $coderef = fun ($p, $q) :(;$$) |
319 | :lvalue |
320 | :Gazebo((>:O)) { |
321 | ... |
322 | }; |
323 | |
324 | And the generated code: |
325 | |
326 | my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_; |
327 | ... |
328 | }; |
329 | |
330 | =head2 Wrapping Function::Parameters |
125c067e |
331 | |
db81d362 |
332 | If you want to wrap L<Function::Parameters>, you just have to call its |
333 | C<import> method. It always applies to the file that is currently being parsed |
63a24d7c |
334 | and its effects are lexical (i.e. it works like L<warnings> or L<strict>): |
335 | |
336 | package Some::Wrapper; |
337 | use Function::Parameters (); |
338 | sub import { |
339 | Function::Parameters->import; |
340 | # or Function::Parameters->import(@other_import_args); |
341 | } |
eeb7df5f |
342 | |
7a63380c |
343 | =head1 AUTHOR |
344 | |
345 | Lukas Mai, C<< <l.mai at web.de> >> |
346 | |
347 | =head1 COPYRIGHT & LICENSE |
348 | |
db81d362 |
349 | Copyright 2010, 2011, 2012 Lukas Mai. |
7a63380c |
350 | |
351 | This program is free software; you can redistribute it and/or modify it |
352 | under the terms of either: the GNU General Public License as published |
353 | by the Free Software Foundation; or the Artistic License. |
354 | |
355 | See http://dev.perl.org/licenses/ for more information. |
356 | |
357 | =cut |