# New Ticket Created by Vasily Chekalkin # Please include the string: [perl #63698] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=63698 >
--- src/builtins/any-list.pir | 61 --------------------------------------------- src/setting/Any-list.pm | 24 +++++++++++++++++ 2 files changed, 24 insertions(+), 61 deletions(-)
diff --git a/src/builtins/any-list.pir b/src/builtins/any-list.pir index 1967fbf..b87666b 100644 --- a/src/builtins/any-list.pir +++ b/src/builtins/any-list.pir @@ -429,67 +429,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 3849a86..5758dce 100644 --- a/src/setting/Any-list.pm +++ b/src/setting/Any-list.pm @@ -3,6 +3,26 @@ class Any is also { gather { take $_ if $test($_) for $values.list; } + }; + + multi method reduce( $values: Code $expression ) { + my $arity = $expression.arity; + die('Cannot reduce() using a unary or nullary function.') if $arity < 2; + + my @list = $values.list; + fail ('Cannot reduce() empty list') if @list.elems == 0; + + my $res = shift @list; + $arity--; + while @list { + my @args = @list.splice(0, $arity); + if @args.elems < $arity { + # Extend args if list exausted early + @args.push(undef x ($arity - @args.elems)); + } + $res = &$expression($res, |@args); + } + $res; } } @@ -10,4 +30,8 @@ our List multi grep(Code $test, *...@values) { @values.grep($test) } +multi reduce ( Code $expression ;; *...@values ) { + @values.reduce($expression); +} + # vim: ft=perl6