Rough but working implementations of Xop and Zop. (Had to disable X a…

…nd Z to make this work, alas, but I'm sure we'll work around that shortly.)
rakudo · Mar 16, 2010 · 2f19219 · 2f19219
1 parent 1c75cfe
commit 2f19219
Show file tree

Hide file tree

Showing 3 changed files with 53 additions and 18 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1917,23 +1917,36 @@ method infixish($/) {
         my $metaop := ~$<infix_prefix_meta_operator><sym>;
         my $sym := ~$<infixish>;
         my $opsub := "&infix:<$metaop$sym>";
-        unless %*METAOPGEN{$opsub} {
-            if $metaop eq '!' {
-                @BLOCK[0].loadinit.push(
-                    PAST::Op.new( :name('!gen_not_metaop'), $sym,
-                                  :pasttype('call') )
-                );
+        my $base_opsub := "&infix:<$sym>";
+        if $metaop eq '!' || $metaop eq 'R' || $metaop eq 'S' {
+            unless %*METAOPGEN{$opsub} {
+                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;
             }
-            if $metaop eq 'R' {
-                @BLOCK[0].loadinit.push(
-                    PAST::Op.new( :name('!gen_reverse_metaop'), $sym,
-                                  :pasttype('call') )
-                );
+            make PAST::Op.new( :name($opsub), :pasttype('call') );
+        }
+        else {
+            if $metaop eq 'X' {
+                make PAST::Op.new( :name("&crosswith"), :pasttype('call'),
+                                   PAST::Var.new( :name($base_opsub), :scope('package') ) );
+            }
+            if $metaop eq 'Z' {
+                make PAST::Op.new( :name("&zipwith"), :pasttype('call'),
+                                   PAST::Var.new( :name($base_opsub), :scope('package') ) );
             }
-
-            %*METAOPGEN{$opsub} := 1;
         }
-        make PAST::Op.new( :name($opsub), :pasttype('call') );
     }
 }
 

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1223,8 +1223,8 @@ token infix:sym<?? !!> {
 token infix_prefix_meta_operator:sym<!> { <sym> <O('%item_assignment')> }
 token infix_prefix_meta_operator:sym<R> { <sym> <O('%item_assignment')> }
 token infix_prefix_meta_operator:sym<S> { <sym> <O('%item_assignment')> }
-token infix_prefix_meta_operator:sym<X> { <sym> <O('%item_assignment')> }
-token infix_prefix_meta_operator:sym<Z> { <sym> <O('%item_assignment')> }
+token infix_prefix_meta_operator:sym<X> { <sym> <O('%list_infix')> }
+token infix_prefix_meta_operator:sym<Z> { <sym> <O('%list_infix')> }
 
 token infix:sym<:=> {
     <sym>  <O('%item_assignment, :reducecheck<bindish_check>')>
@@ -1255,8 +1255,8 @@ token prefix:sym<not>  { <sym> >> <O('%loose_unary')> }
 
 token infix:sym<,>    { <sym>  <O('%comma')> }
 
-token infix:sym<Z>    { <sym>  <O('%list_infix')> }
-token infix:sym<X>    { <sym>  <O('%list_infix')> }
+# token infix:sym<Z>    { <sym>  <O('%list_infix')> }
+# token infix:sym<X>    { <sym>  <O('%list_infix')> }
 
 token infix:sym<...>  { <sym>  <O('%list_infix')> }
 # token term:sym<...>   { <sym> <args>? <O(|%list_prefix)> }

diff --git a/src/core/metaops.pm b/src/core/metaops.pm
@@ -0,0 +1,22 @@
+our multi sub zipwith(&op, Iterable $a-iterable, Iterable $b-iterable) {
+    my $ai = $a-iterable.iterator;
+    my $bi = $b-iterable.iterator;
+    gather loop {
+        my $a = $ai.get;
+        my $b = $bi.get;
+        last if ($a ~~ EMPTY) || ($b ~~ EMPTY);
+        take &op($a, $b);
+    }
+}
+
+our multi sub crosswith(&op, Iterable $a-iterable, Iterable $b-iterable) {
+    my $ai = $a-iterable.iterator;
+    my @b = $b-iterable.Seq;
+    gather loop {
+        my $a = $ai.get;
+        last if ($a ~~ EMPTY);
+        for @b -> $b {
+            take &op($a, $b);
+        }
+    }
+}