Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Reimplement List.reduce in Perl6. #748

Closed
p6rt opened this issue Mar 8, 2009 · 9 comments
Closed

Reimplement List.reduce in Perl6. #748

p6rt opened this issue Mar 8, 2009 · 9 comments
Labels

Comments

@p6rt
Copy link

p6rt commented Mar 8, 2009

Migrated from rt.perl.org#63698 (status was 'resolved')

Searchable as RT63698$

@p6rt
Copy link
Author

p6rt commented Mar 8, 2009

From @bacek


src/builtins/any-list.pir | 61 ---------------------------------------------
src/setting/Any-list.pm | 24 +++++++++++++++++
2 files changed, 24 insertions(+), 61 deletions(-)

@p6rt
Copy link
Author

p6rt commented Mar 8, 2009

From @bacek

4603381c4d4c0b311ee3f6276a79bbb637013670.diff
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

@p6rt
Copy link
Author

p6rt commented Mar 10, 2009

From @bacek

After some discussions on #perl6 I've created new version of Any.reduce.

pmichaud++ as usual :)

--
Bacek

@p6rt
Copy link
Author

p6rt commented Mar 10, 2009

From @bacek


src/builtins/any-list.pir | 61 ---------------------------------------------
src/setting/Any-list.pm | 21 ++++++++++++++-
2 files changed, 20 insertions(+), 62 deletions(-)

Inline Patch
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

@p6rt
Copy link
Author

p6rt commented Mar 10, 2009

From @bacek

Hello.

This one is latest vesion. Sorry for messing with git-send-email :-/

--
Bacek

@p6rt
Copy link
Author

p6rt commented Mar 10, 2009

@bacek - Status changed from 'new' to 'open'

@p6rt
Copy link
Author

p6rt commented Mar 10, 2009

From @pmichaud

On Tue, Mar 10, 2009 at 03​:40​:20AM -0700, Vasily Chekalkin wrote​:

+ 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');

Why is one condition 'die' and the other condition 'fail'?

+ my $res = $list.shift;

Note that $list might not be something that can be shifted -- 'shift'
is only available for Arrays and Iterators.

So, patch rejected, at least this version of it.

Pm

@p6rt
Copy link
Author

p6rt commented Mar 11, 2009

From @bacek

On Sat Mar 07 16​:14​:01 2009, bacek wrote​:

---
src/builtins/any-list.pir | 61
---------------------------------------------
src/setting/Any-list.pm | 24 +++++++++++++++++
2 files changed, 24 insertions(+), 61 deletions(-)

After few iterations moritz++ implemented final version. Resolving ticket.

--
Bacek

@p6rt
Copy link
Author

p6rt commented Mar 11, 2009

@bacek - Status changed from 'open' to 'resolved'

@p6rt p6rt closed this as completed Mar 11, 2009
@p6rt p6rt added the patch label Jan 5, 2020
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

1 participant