Merge branch 'master' of git@github.com:rakudo/rakudo

rakudo · Mar 19, 2010 · 50392a2 · 50392a2
2 parents e252983 + 53ace9a
commit 50392a2
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 0 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1976,6 +1976,23 @@ method infixish($/) {
     }
 }
 
+method prefix_circumfix_meta_operator:sym<reduce>($/) {
+    my $opsub := '&prefix:<' ~ ~$/ ~ '>';
+    unless %*METAOPGEN{$opsub} {
+        my $base_op := '&infix:<' ~ $<op>.Str ~ '>';
+        @BLOCK[0].loadinit.push(PAST::Op.new(
+            :pasttype('bind'),
+            PAST::Var.new( :name($opsub), :scope('package') ),
+            PAST::Op.new(
+                :pasttype('callmethod'), :name('assuming'),
+                PAST::Op.new( :pirop('find_sub_not_null__Ps'), '&reduce' ),
+                PAST::Op.new( :pirop('find_sub_not_null__Ps'), $base_op )
+            )
+        ));
+    }
+    make PAST::Op.new( :name($opsub), :pasttype('call') );
+}
+
 method postfixish($/) {
     if $<postfix_prefix_meta_operator> {
         my $past := $<OPER>.ast;

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1048,6 +1048,13 @@ INIT {
     Perl6::Grammar.O(':prec<c=>, :assoc<left>',  '%loose_or');
 }
 
+token prefixish { 
+    [
+    | <OPER=prefix>
+    | <OPER=prefix_circumfix_meta_operator>
+    ]
+    <.ws>
+}
 
 token infixish {
     | <OPER=infix> <![=]>
@@ -1075,12 +1082,29 @@ token postop {
     | <postcircumfix>
 }
 
+proto token prefix_circumfix_meta_operator { <...> }
+
 proto token infix_postfix_meta_operator { <...> }
 
 proto token infix_prefix_meta_operator { <...> }
 
 proto token postfix_prefix_meta_operator { <...> }
 
+regex prefix_circumfix_meta_operator:sym<reduce> {
+    :my $*IN_REDUCE := 1;
+    <?before '['\S+']'>
+
+    '['
+    [
+    || <op=.infixish> <?before ']'>
+#    || \\<op=.infixish> <?before ']'>
+    || <!>
+    ]
+    ']'
+
+    <O('%list_prefix, :assoc<unary>, :uassoc<left>')>
+}
+
 token postfix_prefix_meta_operator:sym<»> {
     [ <sym> | '>>' ] <!before '('>
 }

diff --git a/src/core/metaops.pm b/src/core/metaops.pm
@@ -20,3 +20,7 @@ our multi sub crosswith(&op, Iterable $a-iterable, Iterable $b-iterable) {
         }
     }
 }
+
+our multi reduce(&op, $list) {
+    $list.reduce(&op)
+}