develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34162 - in trunk/languages/perl6/src: builtins classes

From:
pmichaud
Date:
December 20, 2008 12:39
Subject:
[svn:parrot] r34162 - in trunk/languages/perl6/src: builtins classes
Message ID:
20081220203852.9E161CBA12@x12.develooper.com
Author: pmichaud
Date: Sat Dec 20 12:38:51 2008
New Revision: 34162

Modified:
   trunk/languages/perl6/src/builtins/any-list.pir
   trunk/languages/perl6/src/classes/List.pir

Log:
[rakudo]:  Refactor 'first' and 'reduce' methods to Any (RT #61560, cspencer++)
* Patch (slightly modified) courtesy Cory Spencer <cspencer  at sprocket.org>


Modified: trunk/languages/perl6/src/builtins/any-list.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/any-list.pir	(original)
+++ trunk/languages/perl6/src/builtins/any-list.pir	Sat Dec 20 12:38:51 2008
@@ -55,6 +55,45 @@
     .return ($I0)
 .end
 
+=item first(...)
+
+=cut
+
+.namespace []
+.sub 'first' :multi('Sub')
+    .param pmc test
+    .param pmc values :slurpy
+
+    .tailcall values.'first'(test)
+.end
+
+.namespace ['Any']
+.sub 'first' :method :multi(_, 'Sub')
+    .param pmc test
+    .local pmc retv
+    .local pmc iter
+    .local pmc block_res
+    .local pmc block_arg
+
+    iter = self.'iterator'()
+  loop:
+    unless iter goto nomatch
+    block_arg = shift iter
+    block_res = test(block_arg)
+    if block_res goto matched
+    goto loop
+
+  matched:
+    retv = block_arg
+    goto done
+
+  nomatch:
+    retv = '!FAIL'('Undefined value - first list match of no matches')
+
+  done:
+    .return(retv)
+.end
+
 =item grep(...)
 
 =cut
@@ -340,6 +379,66 @@
     .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 reverse()
 

Modified: trunk/languages/perl6/src/classes/List.pir
==============================================================================
--- trunk/languages/perl6/src/classes/List.pir	(original)
+++ trunk/languages/perl6/src/classes/List.pir	Sat Dec 20 12:38:51 2008
@@ -16,7 +16,7 @@
     p6meta.'register'('ResizablePMCArray', 'parent'=>listproto, 'protoobject'=>listproto)
 
     $P0 = get_hll_namespace ['List']
-    '!EXPORT'('first,keys,kv,pairs,reduce,values', $P0)
+    '!EXPORT'('keys,kv,pairs,values', $P0)
 .end
 
 =head2 Methods
@@ -297,45 +297,6 @@
 .end
 
 
-
-=item first(...)
-
-=cut
-
-.sub 'first' :method :multi('ResizablePMCArray', 'Sub')
-    .param pmc test
-    .local pmc retv
-    .local pmc iter
-    .local pmc block_res
-    .local pmc block_arg
-
-    iter = self.'iterator'()
-  loop:
-    unless iter goto nomatch
-    block_arg = shift iter
-    block_res = test(block_arg)
-    if block_res goto matched
-    goto loop
-
-  matched:
-    retv = block_arg
-    goto done
-
-  nomatch:
-    retv = '!FAIL'('Undefined value - first list match of no matches')
-
-  done:
-    .return(retv)
-.end
-
-
-.sub 'first' :multi('Sub')
-    .param pmc test
-    .param pmc values :slurpy
-
-    .tailcall values.'first'(test)
-.end
-
 =item fmt
 
  our Str multi List::fmt ( Str $format, $separator = ' ' )
@@ -465,69 +426,6 @@
     .tailcall values.'pairs'()
 .end
 
-
-=item reduce(...)
-
-=cut
-
-.sub 'reduce' :method :multi('ResizablePMCArray', '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 = new 'Failure'
-
-  push_elem:
-    push args, elem
-    inc i
-    goto args_loop
-
-  invoke:
-    retv = expression(retv, args :flat)
-    goto loop
-
-  empty:
-    retv = new 'Undef'
-    goto done
-
-  error:
-    'die'('Cannot reduce() using a unary or nullary function.')
-    goto done
-
-  done:
-    .return(retv)
-.end
-
-.sub 'reduce' :multi('Sub')
-    .param pmc expression
-    .param pmc values          :slurpy
-    .tailcall values.'reduce'(expression)
-.end
-
-
 =item uniq(...)
 
 =cut



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About