Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Refactor to pass reduction type to CROSS and ZIP metaoperators.

  • Loading branch information...
commit 433956df606c58269b042c5eb824ef90cb626423 1 parent 46dacb9
Patrick R. Michaud authored June 27, 2012
21  src/Perl6/Actions.pm
@@ -4075,12 +4075,12 @@ class Perl6::Actions is HLL::Actions {
4075 4075
     }
4076 4076
 
4077 4077
     sub baseop_reduce($/) {
4078  
-        my $reduce := 'left';
  4078
+        my $reduce := 'LEFT';
4079 4079
         if    $<assoc> eq 'right'  
4080  
-           || $<assoc> eq 'list'   { $reduce := $<assoc>; }
4081  
-        elsif $<prec> eq 'm='      { $reduce := 'chain'; }
4082  
-        elsif $<pasttype> eq 'xor' { $reduce := 'xor'; }
4083  
-        $reduce;
  4080
+           || $<assoc> eq 'list'   { $reduce := nqp::uc($<assoc>); }
  4081
+        elsif $<prec> eq 'm='      { $reduce := 'CHAIN'; }
  4082
+        elsif $<pasttype> eq 'xor' { $reduce := 'XOR'; }
  4083
+        '&METAOP_REDUCE_' ~ $reduce;
4084 4084
     }
4085 4085
 
4086 4086
     method infixish($/) {
@@ -4117,9 +4117,12 @@ class Perl6::Actions is HLL::Actions {
4117 4117
             elsif $metasym eq 'X' { $helper := '&METAOP_CROSS'; }
4118 4118
             elsif $metasym eq 'Z' { $helper := '&METAOP_ZIP'; }
4119 4119
 
4120  
-            make PAST::Op.new( :node($/),
4121  
-                     PAST::Op.new( :pasttype<call>,
4122  
-                         :name($helper), $basepast ));
  4120
+            my $metapast := PAST::Op.new( :pasttype<call>, :name($helper),
  4121
+                                $basepast);
  4122
+            $metapast.push(PAST::Var.new(:name(baseop_reduce($base<OPER><O>)),
  4123
+                                         :scope<lexical_6model>))
  4124
+                if $metasym eq 'X' || $metasym eq 'Z';
  4125
+            make PAST::Op.new( :node($/), $metapast );
4123 4126
         }
4124 4127
 
4125 4128
         if $<infixish> {
@@ -4133,7 +4136,7 @@ class Perl6::Actions is HLL::Actions {
4133 4136
                           ?? $base.ast[0]
4134 4137
                           !! PAST::Var.new(:name("&infix:<" ~ $base<OPER><sym> ~ ">"),
4135 4138
                                            :scope<lexical_6model>);
4136  
-        my $metaop   := '&METAOP_REDUCE_' ~ nqp::uc(baseop_reduce($base<OPER><O>));
  4139
+        my $metaop   := baseop_reduce($base<OPER><O>);
4137 4140
         my $metapast := PAST::Op.new( :pasttype<call>, :name($metaop), $basepast);
4138 4141
         if $<triangle> {
4139 4142
             my $tri := $*W.add_constant('Int', 'int', 1);
4  src/core/metaops.pm
@@ -15,7 +15,7 @@ sub METAOP_REVERSE(\$op) {
15 15
     -> Mu \$a, Mu \$b { $op($b, $a) }
16 16
 }
17 17
 
18  
-sub METAOP_CROSS(\$op) {
  18
+sub METAOP_CROSS(\$op, &reduce) {
19 19
     -> **@lol {
20 20
         my $rop = @lol.elems == 2 ?? $op !! METAOP_REDUCE_LEFT($op);
21 21
         my @l;
@@ -39,7 +39,7 @@ sub METAOP_CROSS(\$op) {
39 39
     }
40 40
 }
41 41
 
42  
-sub METAOP_ZIP(\$op) {
  42
+sub METAOP_ZIP(\$op, &reduce) {
43 43
     -> **@lol {
44 44
         my $rop = METAOP_REDUCE_LEFT($op);
45 45
         my @l = @lol.map({ (.flat,).list.item });

0 notes on commit 433956d

Please sign in to comment.
Something went wrong with that request. Please try again.