# New Ticket Created by Vasily Chekalkin
# Please include the string: [perl #63764]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=63764 >
---
src/builtins/any-list.pir | 61 ---------------------------------------------
src/setting/Any-list.pm | 21 ++++++++++++++-
2 files changed, 20 insertions(+), 62 deletions(-)
diff --git a/src/builtins/any-list.pir b/src/builtins/any-list.pir
index a61edd5..6540465 100644
--- a/src/builtins/any-list.pir
+++ b/src/builtins/any-list.pir
@@ -296,67 +296,6 @@ Return a List with the keys of the invocant.
.tailcall self.'pick'($I0)
.end
-=item reduce(...)
-
-=cut
-
-.namespace []
-.sub 'reduce' :multi('Sub')
- .param pmc expression
- .param pmc values :slurpy
- .tailcall values.'reduce'(expression)
-.end
-
-.namespace ['Any']
-.sub 'reduce' :method :multi(_, 'Sub')
- .param pmc expression
- .local pmc retv
- .local pmc iter
- .local pmc elem
- .local pmc args
- .local int i, arity
-
- arity = expression.'arity'()
- if arity < 2 goto error
-
- iter = self.'iterator'()
- unless iter goto empty
- retv = shift iter
- loop:
- unless iter goto done
-
- # Create arguments for closure
- args = new 'ResizablePMCArray'
- # Start with 1. First argument is result of previous call
- i = 1
-
- args_loop:
- if i == arity goto invoke
- unless iter goto elem_undef
- elem = shift iter
- goto push_elem
- elem_undef:
- elem = 'undef'()
-
- push_elem:
- push args, elem
- inc i
- goto args_loop
-
- invoke:
- retv = expression(retv, args :flat)
- goto loop
-
- empty:
- .tailcall '!FAIL'('Cannot reduce an empty list')
-
- error:
- 'die'('Cannot reduce() using a unary or nullary function.')
-
- done:
- .return(retv)
-.end
-
=item sort()
diff --git a/src/setting/Any-list.pm b/src/setting/Any-list.pm
index 9af5a33..5cb7ed6 100644
--- a/src/setting/Any-list.pm
+++ b/src/setting/Any-list.pm
@@ -3,7 +3,22 @@ class Any is also {
gather {
take $_ if $test($_) for $values.list;
}
- }
+ };
+
+ multi method reduce(Code $expression) {
+ my Int $arity = $expression.count;
+ die('Cannot reduce() using a unary or nullary function.') if $arity <
2;
+
+ my $list := @.list or fail('Cannot reduce() empty list');
+
+ my $res = $list.shift;
+ while $list {
+ my @args = gather { take $list.shift if $list for 2..$arity };
+ $res = &$expression($res, |@args);
+ }
+
+ $res;
+ };
our List multi method map(Code *&expr) {
return gather {
@@ -52,6 +67,10 @@ our List multi grep(Code $test, *...@values) {
@values.grep($test)
}
+multi reduce ( Code $expression ;; *...@values ) {
+ @values.reduce($expression);
+}
+
our List multi map(Code $expr, *...@values) {
@values.map($expr)
}
--
1.6.2.rc0
