# New Ticket Created by dakkar # Please include the string: [perl #68296] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=68296 >
third patch from Lisbon: pick in the setting
>From 884a1799328f2bccaf7ec06d1910c4360227c625 Mon Sep 17 00:00:00 2001
From: dakkar <dak...@sardina.(none)>
Date: Thu, 6 Aug 2009 18:43:09 +0200
Subject: [PATCH] moved pick to setting
---
src/builtins/any-list.pir | 90 ---------------------------------------------
src/setting/Any-list.pm | 39 +++++++++++++++++++
2 files changed, 39 insertions(+), 90 deletions(-)
diff --git a/src/builtins/any-list.pir b/src/builtins/any-list.pir
index cd78d87..6cbefd6 100644
--- a/src/builtins/any-list.pir
+++ b/src/builtins/any-list.pir
@@ -94,96 +94,6 @@ Return a List with the keys of the invocant.
signature."!add_implicit_self"($P0)
.end
-=item pick($num, :$repl)
-
-=cut
-
-.namespace []
-.sub 'pick' :multi(_)
- .param int p_num
- .param pmc values :slurpy
- .param pmc p_repl :optional :named('repl')
- .param int has_repl :opt_flag
- if has_repl goto have_repl
- p_repl = get_hll_global ['Bool'], 'False'
- have_repl:
- .tailcall values.'pick'(p_num, 'repl'=>p_repl)
-.end
-
-.sub 'pick' :multi('Whatever')
- .param pmc whatever
- .param pmc values :slurpy
- .param pmc p_repl :optional :named('repl')
- .param int has_repl :opt_flag
- unless has_repl goto no_repl
- unless p_repl goto no_repl
- die "Infinite lazy pick not implemented"
- no_repl:
- .tailcall values.'pick'(whatever)
-.end
-
-.namespace ['Any']
-.sub 'pick' :method :multi()
- .param int p_num :optional
- .param int has_num :opt_flag
- .param pmc p_repl :optional :named('repl')
- .param int has_repl :opt_flag
-
- .local pmc list, result, rand
- .local int elems
- list = self.'list'()
- elems = list.'elems'()
- result = 'list'()
- rand = get_hll_global ['Any'], '$!random'
-
- if has_num goto have_num
- p_num = 1
- have_num:
-
- .local int repl
- repl = 0
- unless has_repl goto have_repl
- repl = istrue p_repl
- have_repl:
- if repl goto skip_clone
- list = clone list
- skip_clone:
-
- loop:
- unless p_num > 0 goto done
- unless elems > 0 goto done
- $N0 = rand
- $N0 *= elems
- $I0 = $N0
- $P0 = list[$I0]
- push result, $P0
- dec p_num
- if repl goto loop
- delete list[$I0]
- elems = list.'elems'()
- goto loop
- done:
- $I0 = result.'elems'()
- dec $I0
- unless $I0 goto single_item
- .return (result)
- single_item:
- $P0 = result[0]
- .return ($P0)
-.end
-
-.sub 'pick' :method :multi(_, 'Whatever')
- .param pmc whatever
- .param pmc p_repl :optional :named('repl')
- .param int has_repl :opt_flag
- unless has_repl goto no_repl
- unless p_repl goto no_repl
- die "Infinite lazy pick not implemented"
- no_repl:
- $I0 = self.'elems'()
- .tailcall self.'pick'($I0)
-.end
-
=item sort()
Sort list. In this case we copy into an FPA to make use of the
diff --git a/src/setting/Any-list.pm b/src/setting/Any-list.pm
index 9a9431a..18a31e2 100644
--- a/src/setting/Any-list.pm
+++ b/src/setting/Any-list.pm
@@ -36,6 +36,37 @@ class Any is also {
}
}
+ multi method pick(Int $num is copy = 1, :$repl) {
+
+ $num=floor($num);
+
+ if ($num == 1) {
+ return @.list[floor(@.list.elems.rand)];
+ }
+
+ my @l;
+ if ($repl) {
+ @l := @.list;
+ }
+ else {
+ @l = @.list;
+ }
+
+ gather {
+ while ($num > 0 and @l.elems > 0) {
+ my $idx = floor(@l.elems.rand());
+ take @l[$idx];
+ @l.splice($idx,1) unless $repl;
+ --$num;
+ }
+ }
+ }
+
+ multi method pick(Whatever $, :$repl) {
+ die "Infinite lazy pick not implemented" if $repl;
+ @.pick(@.elems);
+ }
+
# RT #63700 - parse failed on &infix:<cmp>
multi method max( $values: Code $by = sub { $^a cmp $^b } ) {
my @list = $values.list;
@@ -152,6 +183,14 @@ our List multi map(Code $expr, *...@values) {
@values.map($expr)
}
+multi pick(Int $num, :$repl, *...@values) {
+ @values.pick($num,:repl($repl));
+}
+
+multi pick(Whatever $, :$repl, *...@values) {
+ @values.pick(*,:repl($repl));
+}
+
multi max(Code $by, *...@values) {
@values.max($by);
}
--
1.5.6.3
signature.asc
Description: PGP signature
