From: Lukas Mai <l.mai@web.de>
Date: Tue, 2 Aug 2011 01:00:36 +0000 (+0200)
Subject: autocurrying
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=04c1348d570a196ac06caf66bbcdd540e10ed73c;hp=4316201eec152b4dcf3895358df5633cf0151a2a;p=p5sagit%2FFunction-Parameters.git

autocurrying
---

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index ac410df..11e39a3 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -71,6 +71,13 @@ 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;
@@ -131,6 +138,12 @@ sub parser {
 		$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;
@@ -187,7 +200,14 @@ sub parser {
 		$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 '';
@@ -213,39 +233,50 @@ sub parser {
 		' ' . $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";
 	};
 }
 
@@ -261,9 +292,15 @@ Function::Parameters - subroutine definitions with parameter lists
 
  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;
@@ -300,6 +337,17 @@ 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