Permalink
Browse files

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.
  • Loading branch information...
1 parent 475d1c7 commit 4293e0722d05267accd66fe6ce312bee1f7a3e22 @jnthn jnthn committed May 26, 2010
Showing with 74 additions and 12 deletions.
  1. +74 −12 src/Perl6/Actions.pm
View
@@ -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 := create_code_object($past, 'Block', 0, $lazy_name);
+ $past := make_block_from($sig, PAST::Op.new(
+ :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

0 comments on commit 4293e07

Please sign in to comment.