-
Notifications
You must be signed in to change notification settings - Fork 0
/
Parameters.pm
executable file
·311 lines (224 loc) · 8.09 KB
/
Parameters.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
package DDgrey::Perl6::Parameters;
use 5.006;
use strict;
use warnings;
use Switch 'Perl6'; #given/when
our $VERSION = '0.03';
use Filter::Simple;
sub separate($);
sub makeproto(\@\@);
sub makepopstate(\@\@);
FILTER_ONLY all => sub {
while(/(sub\s+([\w:]+)\s*\(([^)]*\w.*?)\)\s*\{)/) {
my($oldsubstate, $subname, $paramlist)=($1, $2, $3);
my($substate);
die "'is rw' is not implemented but is used in subroutine $subname" if($oldsubstate =~ /is rw/);
#build the new sub statement
do {
my($popstate, $proto);
do {
#separate the parameter list into 3 arrays
my(@ret)=separate($paramlist);
my(@seps)=@{$ret[0]}; my(@params)=@{$ret[1]}; my(@names)=@{$ret[2]};
#form the line-noise prototype
($proto, my(@symbols))=makeproto(@params, @seps);
#form the population statements
$popstate=makepopstate(@names, @symbols);
};
#now assemble the new sub statement
$substate="sub $subname ($proto) { $popstate"; warn "subname" unless defined $subname; warn "proto" unless defined $proto; warn "popstate" unless defined $popstate;
};
#$substate: DONE--contains the new sub statement
#replace the old sub statement with the new one
do {
s/\Q$oldsubstate/$substate/;
};
}
if(@_) {
print STDERR $_ if($_[0] eq '-debug');
}
};
sub separate($) {
my($paramlist, @seps, @names, @params)=shift;
my(@things);
#split the param list on separators--but keep the separators around
@things=split /([,;])/, $paramlist;
#separate the things into separators and parameters
for(0..$#things) {
if($_ % 2) {
push @seps, $things[$_];
}
else {
push @params, $things[$_];
}
}
#form the names array
push @names, (/([\$\@\%]\w+)$/)[0] for @params;
return \@seps, \@params, \@names;
}
sub makeproto(\@\@) {
my($params, $seps)=@_;
my(@symbols, $proto);
#first, we convert each parameter to the appropriate symbol
for(@$params) {
push @symbols, tosymbol($_);
}
#then we get rid of commas since they don't appear in line-noise prototypes
@$seps=map {$_ eq ',' ? "" : $_} @$seps;
push @$seps, ''; #avoid warning
#build the line-noise prototype
$proto.="$symbols[$_]$seps->[$_]" for(0..$#symbols);
return $proto, @symbols;
}
sub makepopstate(\@\@) {
my(@names)=@{shift()};
my(@symbols)=@{shift()};
my($popstate);
for(0..$#names) {
given($symbols[$_]) {
when '\@' {
if($names[$_] =~ /\@/) {
#literal array--use it
$popstate .= "my($names[$_])=\@{shift()};";
}
else {
#array ref--just like a normal one
$popstate .= "my($names[$_])=shift;";
}
}
when '\%' {
if($names[$_] =~ m'%') {
#literal hash--use it
$popstate .= "my($names[$_])=\%{shift()};";
}
else {
#hash ref--just like a normal one
$popstate .= "my($names[$_])=shift;";
}
}
when '@' {
if($names[$_] ne '@_') {
$popstate .= "my($names[$_])=(\@_);";
}
}
when '%' {
if($names[$_] eq '%_') {
$popstate .= '(%_)=(@_);'
}
else {
$popstate .= "my($names[$_])=(\@_);"
}
}
$popstate .= "my($names[$_])=shift;";
}
}
return $popstate;
}
sub tosymbol {
my $term=shift;
$term =~ s/^\s+|\s+$//g; #strip whitespace
given($term) {
when /^REF/ { return $^V gt 5.8.0 ? '\\[$@%]' : '$' }
when /^GLOB/ { return '\*' }
when /^CODE/ { return '&' }
when /^HASH/ { return '\%' }
when /^ARRAY/ { return '\@' }
when /^SCALAR/ { return '\$' }
when /^\*\@/ { return '@' }
when /^\*\%/ { return '%' }
when /^\@/ { return '\@' }
when /^\%/ { return '\%' }
{ return '$' }
}
}
1;
=head1 NAME
Perl6::Parameters – Perl 6-style prototypes with named parameters
=head1 SYNOPSIS
use Perl6::Parameters;
sub mysub($foo, ARRAY $bar, *%rest) {
...
}
=head1 DETAILS
Perl6::Parameters is a Perl module which simulates Perl 6's named parameters. (When I
talk about "named parameters" I mean something like the parameters you're used to from
C, Java and many other languages--not pass-a-hash-with-the-parameters-in-it things.)
Like most other programming languages, Perl 6 will support subroutines with
pre-declared variables the parameters are put into. (Using this will be optional,
however.) This goes far beyond the "line-noise prototypes" available in Perl 5, which
only allow you to control context and automatically take references to some
parameters--lines like C<my($first, $second)=(@_)> will no longer be necessary.
Although Perl 6 will have this, Perl 5 doesn't; this module makes it so that Perl 5
does. It uses some other Perl 6-isms too, notably the names for builtin types and the
unary-asterisk notation for flattening a list.
=head2 Crafting Parameter Lists
Crafting parameter lists is simple; just declare your subroutine and put the parameters
separated by commas or semicolons, in parenthesis. (Using a semicolon signifies that
all remaining parameters are optional; this may not be available this way in Perl 6,
but I'm assuming it is until I hear otherwise.)
Most parameters are just variable names like C<$foo>; however, more sophisticated
behavior is possible. There are three ways to achieve this.
The first way is by specifying a type for the variable. Certain types make the actual
parameters turn into references to themselves:
=over 4
=item *
C<ARRAY $foo>
This turns an array into a reference to itself and stores the reference into C<$foo>.
=item *
C<HASH $foo>
This turns a hash into a reference to itself and stores the reference into C<$foo>.
=item *
C<CODE $foo>
This turns a subroutine into a reference to itself and stores the reference into
C<$foo>.
=item *
C<SCALAR $foo>
This turns a scalar into a reference to itself and stores the reference into C<$foo>.
=item *
C<GLOB $foo>
This turns a typeglob into a reference to itself and stores the reference into C<$foo>. Typeglobs will be going away in Perl 6;
this type exists in this module so that it's useful for general use in Perl 5.
=item *
C<REF $foo>
This turns any parameter into a reference to itself and stores it into C<$foo>.
This only works in Perl 5.8. Otherwise, it's treated the same as any other
unrecognized type name.
=item *
C<AnythingElse $foo>
This has no effect in this module; it's treated as though you'd typed C<$foo> without
the C<AnythingElse>.
=back
For example, if a subroutine had the parameters C<($foo, HASH $bar, CODE $baz)> and was
called with C<($scalar, %hash, &mysub)> the subroutine would get the contents of
C<$scalar>, a reference to C<%hash> and a reference to C<&mysub>.
The second way is by supplying an actual array or hash as a parameter name. This
requires an array or hash to be passed in for that parameter; it preserves the length
of the array or hash.
The final way is only available for the last parameter: if an array or hash is prefixed
with an asterisk, that array or hash will be filled with any additional parameters.
=head1 CAVEATS
=over 4
=item *
In Perl 6, parameters will be passed by constant reference; in this module parameters
are passed by value.
=item *
In Perl 6, putting an C<is rw> at the end of a parameter will make it read-write;
trying to use C<is rw> with this module will cause an error.
=item *
C<@_> and C<%_> may only be used for the last parameter, and then only when prefixed by
an asterisk; any other use causes undefined behavior.
=item *
In Perl 6 a definition like C<HASH $foo> will take either a literal hash (with a C<%>
sign in front of it) or a reference to a hash; this module requires a C<%> sign.
(Similar limitations apply for arrays.)
=back
=head1 BUGS
None known--but if you find any, send them to <bug-Perl6-Parameters@rt.cpan.org> and
CC <brentdax@cpan.org>.
=head1 AUTHOR
Brent Dax <brentdax1@earthlink.net>
=head1 COPYRIGHT
Copyright (C) 2001 Brent Dax.
This module is free software and may be used, redistributed and modified under the same
terms as Perl itself.
=cut