[p5sagit/Function-Parameters.git] / lib / Function / Parameters.pm

package Function::Parameters;

use strict;
use warnings;

our $VERSION = '0.04';

use Devel::Declare;
use B::Hooks::EndOfScope;
use B::Compiling;

sub guess_caller {
	my ($start) = @_;
	$start ||= 1;

	my $defcaller = (caller $start)[0];
	my $caller = $defcaller;

	for (my $level = $start; ; ++$level) {
		my ($pkg, $function) = (caller $level)[0, 3] or last;
		#warn "? $pkg, $function";
		$function =~ /::import\z/ or return $caller;
		$caller = $pkg;
	}
	$defcaller
}

sub _fun ($) { $_[0] }

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(
		$victim,
		{ $keyword => { const => \&parser } }
	);

	no strict 'refs';
	*{$victim . '::' . $keyword} = \&_fun;
}

sub import {
	my $class = shift;
	
	my $caller = guess_caller;
	#warn "caller = $caller";

	import_into $caller, @_;
}

sub report_pos {
	my ($offset, $name) = @_;
	$name ||= '';
	my $line = Devel::Declare::get_linestr();
	substr $line, $offset + 1, 0, "\x{20de}\e[m";
	substr $line, $offset, 0, "\e[31;1m";
	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;
	my $line = Devel::Declare::get_linestr();

	my $fail = do {
		my $_file = PL_compiling->file;
		my $_line = PL_compiling->line;
		sub {
			my $n = $_line + substr($line, $start, $offset - $start) =~ tr[\n][];
			die join('', @_) . " at $_file line $n\n";
		}
	};

	my $atomically = sub {
		my ($pars) = @_;
		sub {
			my $tmp = $offset;
			my @ret = eval { $pars->(@_) };
			if ($@) {
				$offset = $tmp;
				die $@;
			}
			wantarray ? @ret : $ret[0]
		}
	};

	my $try = sub {
		my ($pars) = @_;
		my @ret = eval { $pars->() };
		if ($@) {
			return;
		}
		wantarray ? @ret : $ret[0]
	};

	my $skipws = sub {
		#warn ">> $line";
		my $skip = Devel::Declare::toke_skipspace($offset);
		if ($skip < 0) {
			$skip == -$offset or die "Internal error: offset=$offset, skip=$skip";
			Devel::Declare::set_linestr($line);
			return;
		}
		$line = Devel::Declare::get_linestr();
		#warn "toke_skipspace($offset) = $skip\n== $line";
		$offset += $skip;
	};

	$offset += Devel::Declare::toke_move_past_token($offset);
	$skipws->();
	my $manip_start = $offset;

	my $name;
	if (my $len = Devel::Declare::toke_scan_word($offset, 1)) {
		$name = substr $line, $offset, $len;
		$offset += $len;
		$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;
		substr($line, $offset, $len) eq $str or $fail->(qq{Missing "$str"});
		$offset += $len;
		$skipws->();
	};

	my $scan_id = sub {
		my $len = Devel::Declare::toke_scan_word($offset, 0) or $fail->('Missing identifier');
		my $name = substr $line, $offset, $len;
		$offset += $len;
		$skipws->();
		$name
	};

	my $scan_var = $atomically->(sub {
		(my $sigil = substr($line, $offset, 1)) =~ /^[\$\@%]\z/ or $fail->('Missing [$@%]');
		$offset += 1;
		$skipws->();
		my $name = $scan_id->();
		$sigil . $name
	});

	my $separated_by = $atomically->(sub {
		my ($sep, $pars) = @_;
		my $len = length $sep;
		defined(my $x = $try->($pars)) or return;
		my @res = $x;
		while () {
			substr($line, $offset, $len) eq $sep or return @res;
			$offset += $len;
			$skipws->();
			push @res, $pars->();
		}
	});

	my $many_till = $atomically->(sub {
		my ($end, $pars) = @_;
		my $len = length $end;
		my @res;
		until (substr($line, $offset, $len) eq $end) {
			push @res, $pars->();
		}
		@res
	});

	my $scan_params = $atomically->(sub {
		if ($try->(sub { $scan_token->('('); 1 })) {
			my @param = $separated_by->(',', $scan_var);
			$scan_token->(')');
			return @param;
		}
		$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 '';
		my $len = Devel::Declare::toke_scan_str($offset);
		my $res = Devel::Declare::get_lex_stuff();
		Devel::Declare::clear_lex_stuff();
		$res eq '' and $fail->(qq{Can't find ")" anywhere before EOF});
		$offset += $len;
		$skipws->();
		"($res)"
	};

	my $scan_attr = sub {
		my $name = $scan_id->();
		my $param = $scan_pargroup_opt->() || '';
		$name . $param
	};

	my $scan_attributes = $atomically->(sub {
		$try->(sub { $scan_token->(':'); 1 }) or return '', [];
		my $proto = $scan_pargroup_opt->();
		my @attrs = $many_till->('{', $scan_attr);
		' ' . $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 $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) {
		#print STDERR "($manip_start:$manip_len) [$line]\n";
		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$extra_a${\$term->(qq[$extra_z])}";
	}
	print STDERR ".> $line\n";
	Devel::Declare::set_linestr($line);
	print STDERR ".< $line\n";
}

sub _terminate_me {
	print STDERR "..>\n";
	my ($str) = @_;
	on_scope_end {
		my $line = Devel::Declare::get_linestr();
		print STDERR "~~> $line\n";
		my $offset = Devel::Declare::get_linestr_offset();
		substr $line, $offset, 0, $str;
		Devel::Declare::set_linestr($line);
		print STDERR "??> $line\n";
	};
}

1

__END__

=head1 NAME

Function::Parameters - subroutine definitions with parameter lists

=head1 SYNOPSIS

 use Function::Parameters;
 
 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;
   for (@args) {
     push @res, $fun->($_);
   }
   @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
L<Devel::Declare> it works without source filters.

WARNING: This is my first attempt at using L<Devel::Declare> and I have
almost no experience with perl's internals. So while this module might
appear to work, it could also conceivably make your programs segfault.
Consider this module alpha quality.

=head2 Basic stuff

To use this new functionality, you have to use C<fun> instead of C<sub> -
C<sub> continues to work as before. The syntax is almost the same as for
C<sub>, but after the subroutine name (or directly after C<fun> if you're
writing an anonymous sub) you can write a parameter list in parens. This
list consists of comma-separated variables.

The effect of C<fun foo($bar, $baz) {> is as if you'd written
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);
multiple attributes have to be separated by spaces.

Syntactically, these new parameter lists live in the spot normally occupied
by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
specifying it as the first attribute (this is syntactically unambiguous
because normal attributes have to start with a letter).

Normally, Perl subroutines are not in scope in their own body, meaning the
parser doesn't know the name C<foo> or its prototype when processing
C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
a I<foo() called too early to check prototype> warning. This module attempts
to fix all of this by adding a subroutine declaration before the definition,
so the parser knows the name (and possibly prototype) while it processes the
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 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
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut
Commit	Line	Data
7a63380c	1	package Function::Parameters;
	2
	3	use strict;
	4	use warnings;
	5
4316201e	6	our $VERSION = '0.04';
7a63380c	7
	8	use Devel::Declare;
	9	use B::Hooks::EndOfScope;
	10	use B::Compiling;
	11
	12	sub guess_caller {
	13	my ($start) = @_;
	14	$start \|\|= 1;
	15
	16	my $defcaller = (caller $start)[0];
	17	my $caller = $defcaller;
	18
	19	for (my $level = $start; ; ++$level) {
	20	my ($pkg, $function) = (caller $level)[0, 3] or last;
	21	#warn "? $pkg, $function";
	22	$function =~ /::import\z/ or return $caller;
	23	$caller = $pkg;
	24	}
	25	$defcaller
	26	}
	27
	28	sub _fun ($) { $_[0] }
	29
c9a39f6b	30	sub _croak {
	31	require Carp;
	32	{
	33	no warnings qw(redefine);
	34	*_croak = \&Carp::croak;
	35	}
	36	goto &Carp::croak;
	37	}
	38
eeb7df5f	39	sub import_into {
eeb7df5f	40	my $victim = shift;
c9a39f6b	41	my $keyword = @_ ? shift : 'fun';
c9a39f6b	42
eeb7df5f	43	_croak qq["$_" is not exported by the ${\__PACKAGE__} module] for @_;
c9a39f6b	44
c9a39f6b	45	$keyword =~ /^[[:alpha:]_]\w*\z/ or _croak qq{"$keyword" does not look like a valid identifier};
7a63380c	46
7a63380c	47	Devel::Declare->setup_for(
eeb7df5f	48	$victim,
b4fcf7d0	49	{ $keyword => { const => \&parser } }
7a63380c	50	);
	51
	52	no strict 'refs';
eeb7df5f	53	*{$victim . '::' . $keyword} = \&_fun;
	54	}
	55
	56	sub import {
	57	my $class = shift;
	58
	59	my $caller = guess_caller;
	60	#warn "caller = $caller";
	61
	62	import_into $caller, @_;
7a63380c	63	}
	64
	65	sub report_pos {
	66	my ($offset, $name) = @_;
	67	$name \|\|= '';
	68	my $line = Devel::Declare::get_linestr();
	69	substr $line, $offset + 1, 0, "\x{20de}\e[m";
	70	substr $line, $offset, 0, "\e[31;1m";
	71	print STDERR "$name($offset)>> $line\n";
	72	}
	73
04c1348d	74	sub _quote {
	75	my ($str) = @_;
	76	$str =~ s/([\$\@\\"])/\\$1/g;
	77	$str =~ s/\n/\\n/g;
	78	qq{"$str"}
	79	}
	80
7a63380c	81	sub parser {
	82	my ($declarator, $start) = @_;
	83	my $offset = $start;
	84	my $line = Devel::Declare::get_linestr();
	85
	86	my $fail = do {
	87	my $_file = PL_compiling->file;
	88	my $_line = PL_compiling->line;
	89	sub {
	90	my $n = $_line + substr($line, $start, $offset - $start) =~ tr[\n][];
	91	die join('', @_) . " at $_file line $n\n";
	92	}
	93	};
	94
	95	my $atomically = sub {
	96	my ($pars) = @_;
	97	sub {
	98	my $tmp = $offset;
	99	my @ret = eval { $pars->(@_) };
	100	if ($@) {
	101	$offset = $tmp;
	102	die $@;
	103	}
	104	wantarray ? @ret : $ret[0]
	105	}
	106	};
	107
	108	my $try = sub {
	109	my ($pars) = @_;
	110	my @ret = eval { $pars->() };
	111	if ($@) {
	112	return;
	113	}
	114	wantarray ? @ret : $ret[0]
	115	};
	116
	117	my $skipws = sub {
	118	#warn ">> $line";
	119	my $skip = Devel::Declare::toke_skipspace($offset);
	120	if ($skip < 0) {
	121	$skip == -$offset or die "Internal error: offset=$offset, skip=$skip";
	122	Devel::Declare::set_linestr($line);
	123	return;
	124	}
	125	$line = Devel::Declare::get_linestr();
	126	#warn "toke_skipspace($offset) = $skip\n== $line";
	127	$offset += $skip;
	128	};
	129
	130	$offset += Devel::Declare::toke_move_past_token($offset);
	131	$skipws->();
	132	my $manip_start = $offset;
	133
	134	my $name;
	135	if (my $len = Devel::Declare::toke_scan_word($offset, 1)) {
	136	$name = substr $line, $offset, $len;
	137	$offset += $len;
	138	$skipws->();
	139	}
	140
04c1348d	141	my $peek_str = sub {
	142	my ($str) = @_;
	143	my $len = length $str;
	144	substr($line, $offset, $len) eq $str
	145	};
	146
7a63380c	147	my $scan_token = sub {
	148	my ($str) = @_;
	149	my $len = length $str;
	150	substr($line, $offset, $len) eq $str or $fail->(qq{Missing "$str"});
	151	$offset += $len;
	152	$skipws->();
	153	};
	154
	155	my $scan_id = sub {
	156	my $len = Devel::Declare::toke_scan_word($offset, 0) or $fail->('Missing identifier');
	157	my $name = substr $line, $offset, $len;
	158	$offset += $len;
	159	$skipws->();
	160	$name
	161	};
	162
	163	my $scan_var = $atomically->(sub {
	164	(my $sigil = substr($line, $offset, 1)) =~ /^[\$\@%]\z/ or $fail->('Missing [$@%]');
	165	$offset += 1;
	166	$skipws->();
	167	my $name = $scan_id->();
	168	$sigil . $name
	169	});
	170
	171	my $separated_by = $atomically->(sub {
	172	my ($sep, $pars) = @_;
	173	my $len = length $sep;
	174	defined(my $x = $try->($pars)) or return;
	175	my @res = $x;
	176	while () {
	177	substr($line, $offset, $len) eq $sep or return @res;
	178	$offset += $len;
	179	$skipws->();
	180	push @res, $pars->();
	181	}
	182	});
	183
	184	my $many_till = $atomically->(sub {
	185	my ($end, $pars) = @_;
	186	my $len = length $end;
	187	my @res;
	188	until (substr($line, $offset, $len) eq $end) {
	189	push @res, $pars->();
	190	}
	191	@res
	192	});
	193
	194	my $scan_params = $atomically->(sub {
	195	if ($try->(sub { $scan_token->('('); 1 })) {
	196	my @param = $separated_by->(',', $scan_var);
	197	$scan_token->(')');
	198	return @param;
	199	}
	200	$try->($scan_var)
	201	});
	202
04c1348d	203	#report_pos $offset, "param";
7a63380c	204	my @param = $scan_params->();
04c1348d	205	my @extra;
	206	#report_pos $offset, "extra";
	207	while ($peek_str->('(')) {
	208	push @extra, [$scan_params->()];
	209	#report_pos $offset, "extra";
	210	}
7a63380c	211
	212	my $scan_pargroup_opt = sub {
	213	substr($line, $offset, 1) eq '(' or return '';
	214	my $len = Devel::Declare::toke_scan_str($offset);
	215	my $res = Devel::Declare::get_lex_stuff();
	216	Devel::Declare::clear_lex_stuff();
	217	$res eq '' and $fail->(qq{Can't find ")" anywhere before EOF});
	218	$offset += $len;
	219	$skipws->();
	220	"($res)"
	221	};
	222
	223	my $scan_attr = sub {
	224	my $name = $scan_id->();
	225	my $param = $scan_pargroup_opt->() \|\| '';
	226	$name . $param
	227	};
	228
	229	my $scan_attributes = $atomically->(sub {
	230	$try->(sub { $scan_token->(':'); 1 }) or return '', [];
	231	my $proto = $scan_pargroup_opt->();
	232	my @attrs = $many_till->('{', $scan_attr);
	233	' ' . $proto, \@attrs
	234	});
	235
04c1348d	236	#report_pos $offset, "attr";
7a63380c	237	my ($proto, $attributes) = $scan_attributes->();
	238	my $attr = @$attributes ? ' : ' . join(' ', @$attributes) : '';
	239
04c1348d	240	#report_pos $offset, "'{'";
7a63380c	241	$scan_token->('{');
	242
	243	my $manip_end = $offset;
	244	my $manip_len = $manip_end - $manip_start;
	245	#print STDERR "($manip_start:$manip_len:$manip_end)\n";
	246
04c1348d	247	my $params = @param ? 'my (' . join(', ', @param) . ') = @_; ' : '';
	248	my $extra_a = join '', map 'sub { ' . (@$_ ? 'my (' . join(', ', @$_) . ') = @_; ' : ''), @extra;
	249	my $extra_z = '}' x @extra;
7a63380c	250	#report_pos $offset;
	251	$proto =~ tr[\n][ ];
	252
04c1348d	253	my $term = sub {
	254	my ($str) = @_;
	255	$str eq '' and return '';
	256	'BEGIN { ' . __PACKAGE__ . '::_terminate_me(' . _quote($str) . '); } '
	257	};
	258
7a63380c	259	if (defined $name) {
7a63380c	260	#print STDERR "($manip_start:$manip_len) [$line]\n";
04c1348d	261	substr $line, $manip_start, $manip_len, " do { sub $name$proto; sub $name$proto$attr { $params$extra_a${\$term->(qq[$extra_z \\&$name };])}";
7a63380c	262	} else {
04c1348d	263	substr $line, $manip_start, $manip_len, " sub$proto$attr { $params$extra_a${\$term->(qq[$extra_z])}";
7a63380c	264	}
04c1348d	265	print STDERR ".> $line\n";
7a63380c	266	Devel::Declare::set_linestr($line);
04c1348d	267	print STDERR ".< $line\n";
7a63380c	268	}
7a63380c	269
04c1348d	270	sub _terminate_me {
	271	print STDERR "..>\n";
	272	my ($str) = @_;
7a63380c	273	on_scope_end {
7a63380c	274	my $line = Devel::Declare::get_linestr();
04c1348d	275	print STDERR "~~> $line\n";
7a63380c	276	my $offset = Devel::Declare::get_linestr_offset();
04c1348d	277	substr $line, $offset, 0, $str;
7a63380c	278	Devel::Declare::set_linestr($line);
04c1348d	279	print STDERR "??> $line\n";
7a63380c	280	};
	281	}
	282
	283	1
	284
	285	__END__
	286
	287	=head1 NAME
	288
	289	Function::Parameters - subroutine definitions with parameter lists
	290
	291	=head1 SYNOPSIS
	292
	293	use Function::Parameters;
	294
04c1348d	295	fun foo($x, $y) {
	296	return $x + $y;
	297	}
	298	foo(2, 3); # 5
	299
	300	fun bar($x)($y) {
	301	return $x + $y;
7a63380c	302	}
04c1348d	303	bar(2)(3); # 5
7a63380c	304
	305	fun mymap($fun, @args) :(&@) {
	306	my @res;
	307	for (@args) {
	308	push @res, $fun->($_);
	309	}
	310	@res
	311	}
	312
	313	print "$_\n" for mymap { $_ * 2 } 1 .. 4;
	314
c9a39f6b	315	use Function::Parameters 'proc';
	316	my $f = proc ($x) { $x * 2 };
	317
7a63380c	318	=head1 DESCRIPTION
	319
	320	This module lets you use parameter lists in your subroutines. Thanks to
	321	L<Devel::Declare> it works without source filters.
	322
	323	WARNING: This is my first attempt at using L<Devel::Declare> and I have
	324	almost no experience with perl's internals. So while this module might
	325	appear to work, it could also conceivably make your programs segfault.
	326	Consider this module alpha quality.
	327
	328	=head2 Basic stuff
	329
	330	To use this new functionality, you have to use C<fun> instead of C<sub> -
	331	C<sub> continues to work as before. The syntax is almost the same as for
	332	C<sub>, but after the subroutine name (or directly after C<fun> if you're
	333	writing an anonymous sub) you can write a parameter list in parens. This
	334	list consists of comma-separated variables.
	335
	336	The effect of C<fun foo($bar, $baz) {> is as if you'd written
	337	C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
	338	copied into C<my> and initialized from L<@_\|perlvar/"@_">.
	339
04c1348d	340	=head2 Autocurrying
	341
	342	You can actually use multiple parameter lists:
	343	C<fun foo(LIST1)(LIST2)(LIST3)...> is valid (and the parameter lists
	344	are completely separate). You use the same syntax to call the function:
	345	C<foo(1)(2, 3)(4, 5, 6)>.
	346
	347	What this actually does is to generate nested subs, each returning a reference
	348	to the next, as if you'd written
	349	C<fun foo(LIST1) { fun (LIST2) { fun (LIST3) { ... } } }>.
	350
7a63380c	351	=head2 Advanced stuff
7a63380c	352
c9a39f6b	353	You can change the name of the new keyword from C<fun> to anything you want by
	354	specifying it in the import list, i.e. C<use Function::Parameters 'spork'> lets
	355	you write C<spork> instead of C<fun>.
	356
7a63380c	357	If you need L<subroutine attributes\|perlsub/"Subroutine Attributes">, you can
	358	put them after the parameter list with their usual syntax. There's one
	359	exception, though: you can only use one colon (to start the attribute list);
	360	multiple attributes have to be separated by spaces.
	361
	362	Syntactically, these new parameter lists live in the spot normally occupied
	363	by L<prototypes\|perlsub/"Prototypes">. However, you can include a prototype by
	364	specifying it as the first attribute (this is syntactically unambiguous
	365	because normal attributes have to start with a letter).
	366
	367	Normally, Perl subroutines are not in scope in their own body, meaning the
	368	parser doesn't know the name C<foo> or its prototype when processing
	369	C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
	370	C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
	371	interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
	372	a I<foo() called too early to check prototype> warning. This module attempts
	373	to fix all of this by adding a subroutine declaration before the definition,
	374	so the parser knows the name (and possibly prototype) while it processes the
	375	body. Thus C<fun foo($x) :($) { $x }> really turns into
	376	C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
	377
eeb7df5f	378	If you want to wrap C<Function::Parameters>, you may find C<import_into>
	379	helpful. It lets you specify a target package for the syntax magic, as in:
	380
	381	package Some::Wrapper;
	382	use Function::Parameters ();
	383	sub import {
	384	my $caller = caller;
	385	Function::Parameters::import_into $caller;
	386	# or Function::Parameters::import_into $caller, 'other_keyword';
	387	}
	388
	389	C<import_into> is not exported by this module, so you have to use a fully
	390	qualified name to call it.
	391
7a63380c	392	=head1 AUTHOR
	393
	394	Lukas Mai, C<< <l.mai at web.de> >>
	395
	396	=head1 COPYRIGHT & LICENSE
	397
eeb7df5f	398	Copyright 2010 Lukas Mai.
7a63380c	399
	400	This program is free software; you can redistribute it and/or modify it
	401	under the terms of either: the GNU General Public License as published
	402	by the Free Software Foundation; or the Artistic License.
	403
	404	See http://dev.perl.org/licenses/ for more information.
	405
	406	=cut