Implement bracketed infixes.

rakudo · May 28, 2010 · e659dd5 · e659dd5
1 parent 0c65df6
commit e659dd5
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 2 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2106,7 +2106,7 @@ method infixish($/) {
 
     if $<infix_prefix_meta_operator> {
         my $metaop := ~$<infix_prefix_meta_operator><sym>;
-        my $sym := ~$<infix_prefix_meta_operator><infixish>;
+        my $sym := ~$<infix_prefix_meta_operator><infixish><OPER>;
         my $opsub := "&infix:<$metaop$sym>";
         my $base_opsub := "&infix:<$sym>";
         if $opsub eq "&infix:<!=>" {
@@ -2140,6 +2140,10 @@ method infixish($/) {
 
         make PAST::Op.new( :name($opsub), :pasttype('call') );
     }
+
+    if $<infixish> {
+        make $<infixish>.ast;
+    }
 }
 
 method prefix_circumfix_meta_operator:sym<reduce>($/) {
@@ -2174,7 +2178,7 @@ method infix_circumfix_meta_operator:sym<« »>($/) {
 sub make_hyperop($/) {
     my $opsub := '&infix:<' ~ ~$/ ~ '>';
     unless %*METAOPGEN{$opsub} {
-        my $base_op := '&infix:<' ~ $<infixish>.Str ~ '>';
+        my $base_op := '&infix:<' ~ $<infixish><OPER>.Str ~ '>';
         my $dwim_lhs := $<opening> eq '<<' || $<opening> eq '«';
         my $dwim_rhs := $<closing> eq '>>' || $<closing> eq '»';
         get_outermost_block().loadinit.push(PAST::Op.new(

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1449,10 +1449,13 @@ token prefixish {
 }
 
 token infixish {
+    [
+    | '[' ~ ']' <infixish> <OPER=.copyOPER('infixish')>
     | <OPER=infix_circumfix_meta_operator>
     | <OPER=infix> <![=]>
     | <OPER=infix_prefix_meta_operator>
     | <infix> <OPER=infix_postfix_meta_operator>
+    ]
 }
 
 token postfixish {
@@ -1545,6 +1548,19 @@ method copyO($from) {
     };
 }
 
+method copyOPER($from) {
+    # There must be a a better way, but until pmichaud++ shows us it,
+    # this is the best I can come up with. :-) -- jnthn
+    my $m := self.MATCH();
+    my $r := $m{$from}<OPER>;
+    Q:PIR {
+        (%r, $I0) = self.'!cursor_start'()
+        %r.'!cursor_pass'($I0, '')
+        $P0 = find_lex '$r'
+        setattribute %r, '$!match', $P0
+    };
+}
+
 proto token dotty { <...> }
 token dotty:sym<.> {
     <sym> <dottyop>