Quick implementation of reverse metaop.

rakudo · Mar 15, 2010 · 01c8cc2 · 01c8cc2
1 parent ef3cd20
commit 01c8cc2
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 4 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1918,10 +1918,19 @@ method infixish($/) {
         my $sym := ~$<infix><sym>;
         my $opsub := "&infix:<$metaop$sym>";
         unless %*METAOPGEN{$opsub} {
-            @BLOCK[0].loadinit.push(
-                PAST::Op.new( :name('!gen_not_metaop'), $sym,
-                              :pasttype('call') )
-            );
+            if $metaop eq '!' {
+                @BLOCK[0].loadinit.push(
+                    PAST::Op.new( :name('!gen_not_metaop'), $sym,
+                                  :pasttype('call') )
+                );
+            }
+            if $metaop eq 'R' {
+                @BLOCK[0].loadinit.push(
+                    PAST::Op.new( :name('!gen_reverse_metaop'), $sym,
+                                  :pasttype('call') )
+                );
+            }
+
             %*METAOPGEN{$opsub} := 1;
         }
         make PAST::Op.new( :name($opsub), :pasttype('call') );

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1216,6 +1216,7 @@ token infix:sym<?? !!> {
 
 # item_assignment is probably wrong, but I don't know how to do what is right...
 token infix_prefix_meta_operator:sym<!> { <sym> <O('%item_assignment')> }
+token infix_prefix_meta_operator:sym<R> { <sym> <O('%item_assignment')> }
 
 token infix:sym<:=> {
     <sym>  <O('%item_assignment, :reducecheck<bindish_check>')>

diff --git a/src/builtins/metaops.pir b/src/builtins/metaops.pir
@@ -35,6 +35,33 @@ src/builtins/metaops.pir - meta-op operations
     .tailcall '&prefix:<!>'($P1)
 .end
 
+.sub '!gen_reverse_metaop'
+    .param string sym
+    .local string opname, metaname
+    $S0 = concat sym, '>'
+    opname = concat '&infix:<', $S0
+    metaname = concat '&infix:<R', $S0
+    $P0 = get_global metaname
+    unless null $P0 goto done
+    $P1 = box opname
+    .lex '$opname', $P1
+    .const 'Sub' metasub = '!reverse_metaop'
+    $P0 = newclosure metasub
+    set_global metaname, $P0
+  done:
+.end
+
+# XXX -- we might want this to be a Perl6MultiSub
+.sub '!reverse_metaop' :anon :outer('!gen_reverse_metaop')
+    .param pmc a
+    .param pmc b
+    $P0 = find_lex '$opname'
+    $S0 = $P0
+    $P0 = get_global $S0
+    $P1 = $P0(b, a)
+    .return ($P1)
+.end
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100