Refactor to pass reduction type to CROSS and ZIP metaoperators.

rakudo · Jun 27, 2012 · 433956d · 433956d
1 parent 46dacb9
commit 433956d
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 11 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -4075,12 +4075,12 @@ class Perl6::Actions is HLL::Actions {
     }
 
     sub baseop_reduce($/) {
-        my $reduce := 'left';
+        my $reduce := 'LEFT';
         if    $<assoc> eq 'right'  
-           || $<assoc> eq 'list'   { $reduce := $<assoc>; }
-        elsif $<prec> eq 'm='      { $reduce := 'chain'; }
-        elsif $<pasttype> eq 'xor' { $reduce := 'xor'; }
-        $reduce;
+           || $<assoc> eq 'list'   { $reduce := nqp::uc($<assoc>); }
+        elsif $<prec> eq 'm='      { $reduce := 'CHAIN'; }
+        elsif $<pasttype> eq 'xor' { $reduce := 'XOR'; }
+        '&METAOP_REDUCE_' ~ $reduce;
     }
 
     method infixish($/) {
@@ -4117,9 +4117,12 @@ class Perl6::Actions is HLL::Actions {
             elsif $metasym eq 'X' { $helper := '&METAOP_CROSS'; }
             elsif $metasym eq 'Z' { $helper := '&METAOP_ZIP'; }
 
-            make PAST::Op.new( :node($/),
-                     PAST::Op.new( :pasttype<call>,
-                         :name($helper), $basepast ));
+            my $metapast := PAST::Op.new( :pasttype<call>, :name($helper),
+                                $basepast);
+            $metapast.push(PAST::Var.new(:name(baseop_reduce($base<OPER><O>)),
+                                         :scope<lexical_6model>))
+                if $metasym eq 'X' || $metasym eq 'Z';
+            make PAST::Op.new( :node($/), $metapast );
         }
 
         if $<infixish> {
@@ -4133,7 +4136,7 @@ class Perl6::Actions is HLL::Actions {
                           ?? $base.ast[0]
                           !! PAST::Var.new(:name("&infix:<" ~ $base<OPER><sym> ~ ">"),
                                            :scope<lexical_6model>);
-        my $metaop   := '&METAOP_REDUCE_' ~ nqp::uc(baseop_reduce($base<OPER><O>));
+        my $metaop   := baseop_reduce($base<OPER><O>);
         my $metapast := PAST::Op.new( :pasttype<call>, :name($metaop), $basepast);
         if $<triangle> {
             my $tri := $*W.add_constant('Int', 'int', 1);

diff --git a/src/core/metaops.pm b/src/core/metaops.pm
@@ -15,7 +15,7 @@ sub METAOP_REVERSE(\$op) {
     -> Mu \$a, Mu \$b { $op($b, $a) }
 }
 
-sub METAOP_CROSS(\$op) {
+sub METAOP_CROSS(\$op, &reduce) {
     -> **@lol {
         my $rop = @lol.elems == 2 ?? $op !! METAOP_REDUCE_LEFT($op);
         my @l;
@@ -39,7 +39,7 @@ sub METAOP_CROSS(\$op) {
     }
 }
 
-sub METAOP_ZIP(\$op) {
+sub METAOP_ZIP(\$op, &reduce) {
     -> **@lol {
         my $rop = METAOP_REDUCE_LEFT($op);
         my @l = @lol.map({ (.flat,).list.item });