use strict;
use warnings;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
use Devel::Declare;
use B::Hooks::EndOfScope;
sub _fun ($) { $_[0] }
-sub import {
- my $class = shift;
- my $caller = guess_caller;
- #warn "caller = $caller";
+sub _croak {
+ require Carp;
+ {
+ no warnings qw(redefine);
+ *_croak = \&Carp::croak;
+ }
+ goto &Carp::croak;
+}
+
+sub import_into {
+ my $victim = shift;
+ my $keyword = @_ ? shift : 'fun';
+
+ _croak qq["$_" is not exported by the ${\__PACKAGE__} module] for @_;
+
+ $keyword =~ /^[[:alpha:]_]\w*\z/ or _croak qq{"$keyword" does not look like a valid identifier};
Devel::Declare->setup_for(
- $caller,
- { fun => { const => \&parser } }
+ $victim,
+ { $keyword => { const => \&parser } }
);
no strict 'refs';
- *{$caller . '::fun'} = \&_fun;
+ *{$victim . '::' . $keyword} = \&_fun;
+}
+
+sub import {
+ my $class = shift;
+
+ my $caller = guess_caller;
+ #warn "caller = $caller";
+
+ import_into $caller, @_;
}
sub report_pos {
print STDERR "$name($offset)>> $line\n";
}
+sub _quote {
+ my ($str) = @_;
+ $str =~ s/([\$\@\\"])/\\$1/g;
+ $str =~ s/\n/\\n/g;
+ qq{"$str"}
+}
+
sub parser {
my ($declarator, $start) = @_;
my $offset = $start;
$skipws->();
}
+ my $peek_str = sub {
+ my ($str) = @_;
+ my $len = length $str;
+ substr($line, $offset, $len) eq $str
+ };
+
my $scan_token = sub {
my ($str) = @_;
my $len = length $str;
$try->($scan_var)
});
+ #report_pos $offset, "param";
my @param = $scan_params->();
+ my @extra;
+ #report_pos $offset, "extra";
+ while ($peek_str->('(')) {
+ push @extra, [$scan_params->()];
+ #report_pos $offset, "extra";
+ }
my $scan_pargroup_opt = sub {
substr($line, $offset, 1) eq '(' or return '';
' ' . $proto, \@attrs
});
+ #report_pos $offset, "attr";
my ($proto, $attributes) = $scan_attributes->();
my $attr = @$attributes ? ' : ' . join(' ', @$attributes) : '';
+ #report_pos $offset, "'{'";
$scan_token->('{');
my $manip_end = $offset;
my $manip_len = $manip_end - $manip_start;
#print STDERR "($manip_start:$manip_len:$manip_end)\n";
- my $params = @param ? 'my (' . join(', ', @param) . ') = @_;' : '';
+ my $params = @param ? 'my (' . join(', ', @param) . ') = @_; ' : '';
+ my $extra_a = join '', map 'sub { ' . (@$_ ? 'my (' . join(', ', @$_) . ') = @_; ' : ''), @extra;
+ my $extra_z = '}' x @extra;
#report_pos $offset;
$proto =~ tr[\n][ ];
+ my $term = sub {
+ my ($str) = @_;
+ $str eq '' and return '';
+ 'BEGIN { ' . __PACKAGE__ . '::_terminate_me(' . _quote($str) . '); } '
+ };
+
if (defined $name) {
- my $pkg = __PACKAGE__;
#print STDERR "($manip_start:$manip_len) [$line]\n";
- substr $line, $manip_start, $manip_len, " do { sub $name$proto; sub $name$proto$attr { BEGIN { ${pkg}::terminate_me(q[$name]); } $params ";
+ substr $line, $manip_start, $manip_len, " do { sub $name$proto; sub $name$proto$attr { $params$extra_a${\$term->(qq[$extra_z \\&$name };])}";
} else {
- substr $line, $manip_start, $manip_len, " sub$proto$attr { $params ";
+ substr $line, $manip_start, $manip_len, " sub$proto$attr { $params$extra_a${\$term->(qq[$extra_z])}";
}
- #print STDERR ".> $line\n";
+ print STDERR ".> $line\n";
Devel::Declare::set_linestr($line);
+ print STDERR ".< $line\n";
}
-sub terminate_me {
- my ($name) = @_;
+sub _terminate_me {
+ print STDERR "..>\n";
+ my ($str) = @_;
on_scope_end {
my $line = Devel::Declare::get_linestr();
- #print STDERR "~~> $line\n";
+ print STDERR "~~> $line\n";
my $offset = Devel::Declare::get_linestr_offset();
- substr $line, $offset, 0, " \\&$name };";
+ substr $line, $offset, 0, $str;
Devel::Declare::set_linestr($line);
- #print STDERR "??> $line\n";
+ print STDERR "??> $line\n";
};
}
use Function::Parameters;
- fun foo($bar, $baz) {
- return $bar + $baz;
+ fun foo($x, $y) {
+ return $x + $y;
+ }
+ foo(2, 3); # 5
+
+ fun bar($x)($y) {
+ return $x + $y;
}
+ bar(2)(3); # 5
fun mymap($fun, @args) :(&@) {
my @res;
print "$_\n" for mymap { $_ * 2 } 1 .. 4;
+ use Function::Parameters 'proc';
+ my $f = proc ($x) { $x * 2 };
+
=head1 DESCRIPTION
This module lets you use parameter lists in your subroutines. Thanks to
C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
copied into C<my> and initialized from L<@_|perlvar/"@_">.
+=head2 Autocurrying
+
+You can actually use multiple parameter lists:
+C<fun foo(LIST1)(LIST2)(LIST3)...> is valid (and the parameter lists
+are completely separate). You use the same syntax to call the function:
+C<foo(1)(2, 3)(4, 5, 6)>.
+
+What this actually does is to generate nested subs, each returning a reference
+to the next, as if you'd written
+C<fun foo(LIST1) { fun (LIST2) { fun (LIST3) { ... } } }>.
+
=head2 Advanced stuff
+You can change the name of the new keyword from C<fun> to anything you want by
+specifying it in the import list, i.e. C<use Function::Parameters 'spork'> lets
+you write C<spork> instead of C<fun>.
+
If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
put them after the parameter list with their usual syntax. There's one
exception, though: you can only use one colon (to start the attribute list);
body. Thus C<fun foo($x) :($) { $x }> really turns into
C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
+If you want to wrap C<Function::Parameters>, you may find C<import_into>
+helpful. It lets you specify a target package for the syntax magic, as in:
+
+ package Some::Wrapper;
+ use Function::Parameters ();
+ sub import {
+ my $caller = caller;
+ Function::Parameters::import_into $caller;
+ # or Function::Parameters::import_into $caller, 'other_keyword';
+ }
+
+C<import_into> is not exported by this module, so you have to use a fully
+qualified name to call it.
+
=head1 AUTHOR
Lukas Mai, C<< <l.mai at web.de> >>
=head1 COPYRIGHT & LICENSE
-Copyright 2009 Lukas Mai.
+Copyright 2010 Lukas Mai.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
projects / p5sagit/Function-Parameters.git / blobdiff