Merge branch 'series'

rakudo · Mar 11, 2010 · 26a9a3e · 26a9a3e
2 parents 9786b03 + 88032ee
commit 26a9a3e
Show file tree

Hide file tree

Showing 2 changed files with 110 additions and 23 deletions.
diff --git a/src/core/Rat.pm b/src/core/Rat.pm
@@ -123,6 +123,10 @@ multi sub infix:</>(Int $a, Int $b) {
     Rat.new($a, $b);
 }
 
+multi sub infix:<cmp>(Rat $a, Rat $b) { $a.Num <=> $b.Num; }
+multi sub infix:<cmp>(Rat $a, $b)     { $a.Num <=> $b.Num; }
+multi sub infix:<cmp>($a, Rat $b)     { $a.Num <=> $b.Num; }
+
 augment class Int {
     # CHEAT: Comes from Int.pm, moved here for the moment.
     our Rat multi method Rat() { Rat.new(self, 1); }

diff --git a/src/core/operators.pm b/src/core/operators.pm
@@ -245,40 +245,123 @@ our multi sub infix:<...>($lhs, $rhs) {
     }
 }
 
-our multi sub infix:<...>($lhs, Code $rhs) {
-    if $rhs.count != 1 {
-        die "Series operator currently cannot handle blocks with count != 1";
-    }
-
-    my $i = $lhs;
+# our multi sub infix:<...>($lhs, Code $rhs) {
+#     if $rhs.count != 1 {
+#         die "Series operator currently cannot handle blocks with count != 1";
+#     }
+#
+#     my $i = $lhs;
+#     gather {
+#         my $j = $i;
+#         take $j;
+#         my $last = $i;
+#         loop {
+#             $i = $rhs.($last);
+#             my $j = $i;
+#             take $j;
+#             $last = $i;
+#         }
+#     }
+# }
+#
+# our multi sub infix:<...>(@lhs, Whatever) {
+#     given @lhs.elems {
+#         when 2 {
+#             @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
+#         }
+#         when 3 {
+#             if @lhs[1] - @lhs[0] == @lhs[2] - @lhs[1] {
+#                 @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
+#             } elsif @lhs[1] / @lhs[0] == @lhs[2] / @lhs[1] {
+#                 @lhs[0] ... { $_ * (@lhs[1] / @lhs[0]) };
+#             } else {
+#                 fail "Unable to figure out pattern of series";
+#             }
+#         }
+#         default { fail "Unable to figure out pattern of series"; }
+#     }
+# }
+
+our multi sub infix:<...>(Code $lhs, $rhs) {
+    my $limit;
+    $limit = $rhs if !($rhs ~~ Whatever);
+    my $last;
     gather {
-        my $j = $i;
-        take $j;
-        my $last = $i;
         loop {
-            $i = $rhs.($last);
+            my $i = $lhs.();
             my $j = $i;
+            last if $limit.defined && $last.defined && !($j eqv $limit)
+                 && ($last before $limit before $j || $j before $limit before $last);
             take $j;
-            $last = $i;
+            last if $limit.defined && $j eqv $limit;
+            $last = $j;
         }
     }
 }
 
-our multi sub infix:<...>(@lhs, Whatever) {
-    given @lhs.elems {
-        when 2 {
-            @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
+our multi sub infix:<...>(@lhs is copy, $rhs) {
+    my $limit;
+    $limit = $rhs if !($rhs ~~ Whatever);
+
+    my $next;
+    if @lhs[@lhs.elems - 1] ~~ Code {
+        $next = @lhs.pop;
+    } else {
+        given @lhs.elems {
+            when 1 {
+                if @lhs[0] cmp $rhs == 1 {
+                    $next = { $.prec };
+                } else {
+                    $next = { $.succ };
+                }
+            }
+            when 2 {
+                $next = { $_ + (@lhs[1] - @lhs[0]) };
+            }
+            when 3 {
+                if @lhs[1] - @lhs[0] == @lhs[2] - @lhs[1] {
+                    $next = { $_ + (@lhs[1] - @lhs[0]) };
+                } elsif @lhs[1] / @lhs[0] == @lhs[2] / @lhs[1] {
+                    $next = { $_ * (@lhs[1] / @lhs[0]) };
+                } else {
+                    fail "Unable to figure out pattern of series";
+                }
+            }
+            default { fail "Unable to figure out pattern of series"; }
         }
-        when 3 {
-            if @lhs[1] - @lhs[0] == @lhs[2] - @lhs[1] {
-                @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
-            } elsif @lhs[1] / @lhs[0] == @lhs[2] / @lhs[1] {
-                @lhs[0] ... { $_ * (@lhs[1] / @lhs[0]) };
-            } else {
-                fail "Unable to figure out pattern of series";
+    }
+
+    my $arity = any( $next.signature.params>>.slurpy ) ?? Inf !! $next.count;
+
+    gather {
+        my @args;
+        my $j;
+        my $top = $arity min @lhs.elems;
+        for 0..^$top -> $i {
+            $j = @lhs[$i];
+            take $j;
+            @args.push($j);
+        }
+
+        if !$limit.defined || $limit cmp $j != 0 {
+            loop {
+                my $i = $next.(|@args);
+                my $j = $i;
+
+                my $cur_cmp = 1;
+                if $limit.defined {
+                    $cur_cmp = $limit cmp $j;
+                    last if (@args[@args.elems - 1] cmp $limit) == $cur_cmp;
+                }
+                take $j;
+                last if $cur_cmp == 0;
+
+                @args.push($j);
+                while @args.elems > $arity {
+                    @args.shift;
+                }
             }
         }
-        default { fail "Unable to figure out pattern of series"; }
     }
 }