Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 916b56d60d
Fetching contributors…

Cannot retrieve contributors at this time

279 lines (247 sloc) 7.516 kb
class Range { ... }
augment class Any {
our Str multi method join($separator = '') {
pir::join__SsP($separator, self.list.eager);
}
multi method elems() {
1;
}
our multi method map(&block) {
Q:PIR {
.local pmc self, block, map
self = find_lex 'self'
block = find_lex '&block'
$P0 = self.'list'()
$P0 = $P0.'iterator'()
map = new ['MapIterator']
setattribute map, '$!iter', $P0
setattribute map, '&!block', block
%r = map
};
}
multi method first($test) {
for @.list {
if $_ ~~ $test {
return $_;
}
}
fail('No values matched');
}
our multi method grep(Mu $test) {
gather {
for @.list {
take $_ if $_ ~~ $test;
}
}
}
multi method reverse() {
my @result = ();
for @.list {
@result.unshift($_);
}
return @result;
}
multi method end() { self.elems - 1; }
# CHEAT: this should take an ordering parameter
# And use the FIRST: phaser
multi method min($by = { $^a cmp $^b}) {
my $min = +Inf;
my $first-time = Bool::True;
for @.list {
if $first-time {
$min = $_;
$first-time = Bool::False;
next;
}
if $by($_, $min) == -1 {
$min = $_;
}
}
$min;
}
# CHEAT: this should take an ordering parameter
# And use the FIRST: phaser
multi method max($by = { $^a cmp $^b}) {
my $max = -Inf;
my $first-time = Bool::True;
for @.list {
if $first-time {
$max = $_;
$first-time = Bool::False;
next;
}
if $by($_, $max) == 1 {
$max = $_;
}
}
$max;
}
# CHEAT: this should take an ordering parameter
# And use the FIRST: phaser
multi method minmax($by = { $^a cmp $^b}) {
my $min = +Inf;
my $max = -Inf;
my $excludes_min = Bool::False;
my $excludes_max = Bool::False;
my $first-time = Bool::True;
for @.list {
when Range {
if $first-time {
$min = $_.min;
$max = $_.max;
$excludes_min = $_.excludes_min;
$excludes_max = $_.excludes_max;
$first-time = Bool::False;
next;
}
if $by($_.min, $min) == -1 {
$min = $_;
$excludes_min = $_.excludes_min;
}
if $by($_.max, $max) == 1 {
$max = $_;
$excludes_max = $_.excludes_max;
}
}
if $first-time {
$min = $_;
$max = $_;
$first-time = Bool::False;
next;
}
if $by($_, $min) == -1 {
$min = $_;
$excludes_min = Bool::False;
}
if $by($_, $max) == 1 {
$max = $_;
$excludes_max = Bool::False;
}
}
Range.new($min,
$max,
:excludes_min($excludes_min),
:excludes_max($excludes_max));
}
#CHEAT: Simplified version which we can hopefully sneak by ng.
multi method pick() {
my @l = @.list.Seq;
@l[floor(@l.elems.rand)];
}
multi method pick($num is copy = 1, :$replace) {
my @l = @.list.Seq;
if ($num == 1) {
return @l[floor(@l.elems.rand)];
}
if $replace {
gather {
while ($num > 0) {
my $idx = floor(@l.elems.rand());
take @l[$idx];
--$num;
}
}
} else {
gather {
while ($num > 0 and @l.elems > 0) {
my $idx = floor(@l.elems.rand());
take @l[$idx];
@l.splice($idx,1);
--$num;
}
}
}
}
multi method pick(Whatever, :$replace) {
self.pick(Inf, :$replace);
}
multi method classify($test) {
my %result;
for @.list {
my $k = $_ ~~ $test;
%result{$k} //= [];
%result{$k}.push: $_;
}
%result.pairs;
}
multi method reduce(Code $expression is rw) {
my $arity = $expression.?count || 2; # second half is a CHEAT
fail('Cannot reduce() using a unary or nullary function.')
if $arity < 2;
fail('Can only reduce() using a binary function for now.')
if $arity > 2;
my @args = ();
for @.list {
@args.push($_);
if (@args == $arity) {
my $res = $expression.(@args[0], @args[1]);
# my $res = $expression.(|@args);
@args = ($res);
}
}
fail('Cannot reduce() empty list') unless @args > 0;
if @args > 1 {
if @args < $expression.arity {
warn (@args -1) ~ " trailing item(s) in reduce";
} else {
return $( $expression.(@args[0], @args[1]) );
# return $( $expression.(|@args) );
}
}
return @args[0];
}
# This needs a way of taking a user-defined comparison
# specifier, but AFAIK nothing has been spec'd yet.
# CHEAT: Almost certainly should be hashed on something
# other than the stringification of the objects.
multi method uniq() {
my %seen;
gather for @.list {
unless %seen{$_} {
take $_;
%seen{$_} = 1;
}
}
}
multi method kv() {
my $i = 0;
gather for $.list -> $value {
my $key = $i++;
take $key;
take $value;
}
}
multi method keys() {
my $i = 0;
gather for $.list -> $value {
my $key = $i++;
take $key;
}
}
multi method values() {
gather for $.list -> $value {
take $value;
}
}
multi method pairs() {
self.kv.map(-> $key, $value { $key => $value; });
}
}
proto sub classify($matcher, *@values) { @values.classify($matcher) }
proto sub join (Str $separator = '', *@values) { @values.join($separator); }
proto sub reverse(@values) { @values.reverse; }
multi sub reverse(*@v) { @v.reverse; }
proto sub end(@array) { @array.end; }
proto sub grep(Mu $test, *@values) { @values.grep($test); }
proto sub first($test, @values) { @values.first($test); }
proto sub min($by, *@values) { @values.min($by); }
proto sub max($by, *@values) { @values.max($by); }
proto sub minmax($by, *@values) { @values.minmax($by); }
proto sub uniq(@values) { @values.uniq; }
proto sub pick ($num, :$replace, *@values) { @values.pick($num, :$replace); }
proto sub map(&mapper, @values) { @values.map(&mapper); }
proto sub kv(@array) { @array.kv; }
proto sub keys(@array) { @array.keys; }
proto sub values(@array) { @array.values; }
proto sub pairs(@array) { @array.pairs; }
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.