Implement auto-currying at compile time of infix, prefix and postfix …

…operators. Also factors a little code out that we can share/re-use to make the block construction a little less ugly.
rakudo · May 26, 2010 · 4293e07 · 4293e07
1 parent 475d1c7
commit 4293e07
Showing 1 changed file with 74 additions and 12 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1882,7 +1882,7 @@ method term:sym<pir::op>($/) {
 method term:sym<*>($/) {
     my @name := Perl6::Grammar::parse_name('Whatever');
     make PAST::Op.new(
-        :pasttype('callmethod'), :name('new'), :node($/), :lvalue(1),
+        :pasttype('callmethod'), :name('new'), :node($/), :lvalue(1), :returns('Whatever'),
         PAST::Var.new( :name(@name.pop), :namespace(@name), :scope('package') )
     )
 }
@@ -2065,6 +2065,9 @@ method EXPR($/, $key?) {
     else {
         for $/.list { if $_.ast { $past.push($_.ast); } }
     }
+    if $key eq 'PREFIX' || $key eq 'INFIX' || $key eq 'POSTFIX' {
+        $past := whatever_curry($past);
+    }
     make $past;
 }
 
@@ -2991,21 +2994,15 @@ sub where_blockify($expr) {
         $past := create_code_object($expr<past_block>, 'Block', 0, $lazy_name);
     }
     else {
-        $past := PAST::Block.new( :blocktype('declaration'),
-            PAST::Stmts.new( ),
-            PAST::Stmts.new(
-                PAST::Op.new( :pasttype('call'), :name('&infix:<~~>'),
-                    PAST::Var.new( :name('$_'), :scope('lexical') ),
-                    $expr
-                )
-            )
-        );
         my $sig := Perl6::Compiler::Signature.new();
         my $param := Perl6::Compiler::Parameter.new();
         $param.var_name('$_');
         $sig.add_parameter($param);
-        my $lazy_name := add_signature($past, $sig, 1);
+        $past := make_block_from($sig, PAST::Op.new(
-        $past := create_code_object($past, 'Block', 0, $lazy_name);
+            :pasttype('call'), :name('&infix:<~~>'),
+            PAST::Var.new( :name('$_'), :scope('lexical') ),
+            $expr
+        ));
     }
     $past
 }
@@ -3029,4 +3026,69 @@ sub capture_or_parcel($args, $name) {
     }
 }
 
+# This checks if we have something of the form * op *, * op <thing> or
+# <thing> op * and if so, and if it's not one of the ops we do not
+# auto-curry for, emits a closure instead. We hard-code the things not
+# to curry for now; in the future, we will inspect the multi signatures
+# of the op to decide, or likely store things in this hash from that
+# introspection and keep it as a quick cache.
+our %not_curried;
+INIT {
+    %not_curried{'&infix:<...>'} := 1;
+    %not_curried{'&infix:<..>'}  := 1;
+}
+sub whatever_curry($past) {
+    if $past.isa(PAST::Op) && !%not_curried{$past.name} {
+        if +@($past) == 2 && $past[0] ~~ PAST::Op && $past[0].returns eq 'Whatever'
+                          && $past[1] ~~ PAST::Op && $past[1].returns eq 'Whatever' {
+            # Curry left and right, two args.
+            $past.shift; $past.shift;
+            $past.push(PAST::Var.new( :name('$x'), :scope('lexical') ));
+            $past.push(PAST::Var.new( :name('$y'), :scope('lexical') ));
+            my $sig := Perl6::Compiler::Signature.new();
+            my $param1 := Perl6::Compiler::Parameter.new();
+            $param1.var_name('$x');
+            $sig.add_parameter($param1);
+            my $param2 := Perl6::Compiler::Parameter.new();
+            $param2.var_name('$y');
+            $sig.add_parameter($param2);
+            $past := make_block_from($sig, $past);
+        }
+        elsif +@($past) == 2 && $past[1] ~~ PAST::Op && $past[1].returns eq 'Whatever' {
+            # Curry right arg.
+            $past.pop;
+            $past.push(PAST::Var.new( :name('$y'), :scope('lexical') ));
+            my $sig := Perl6::Compiler::Signature.new();
+            my $param := Perl6::Compiler::Parameter.new();
+            $param.var_name('$y');
+            $sig.add_parameter($param);
+            $past := make_block_from($sig, $past);
+        }
+        elsif (+@($past) == 1 || +@($past) == 2) && $past[0] ~~ PAST::Op && $past[0].returns eq 'Whatever' {
+            # Curry left (or for unary, only) arg.
+            $past.shift;
+            $past.unshift(PAST::Var.new( :name('$x'), :scope('lexical') ));
+            my $sig := Perl6::Compiler::Signature.new();
+            my $param := Perl6::Compiler::Parameter.new();
+            $param.var_name('$x');
+            $sig.add_parameter($param);
+            $past := make_block_from($sig, $past);
+        }
+    }
+    $past
+}
+
+# Helper for constructing a simple Perl 6 Block with the given signature
+# and body.
+sub make_block_from($sig, $body) {
+    my $past := PAST::Block.new( :blocktype('declaration'),
+        PAST::Stmts.new( ),
+        PAST::Stmts.new(
+            $body
+        )
+    );
+    my $lazy_name := add_signature($past, $sig, 1);
+    create_code_object($past, 'Block', 0, $lazy_name);
+}
+
 # vim: ft=perl6