Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: ebc730c249
Fetching contributors…

Cannot retrieve contributors at this time

256 lines (228 sloc) 7.62 kB
sub METAOP_ASSIGN(\op) {
-> Mu \a, Mu \b { a = op.( a // op.(), b) }
}
sub METAOP_TEST_ASSIGN:<//>(\lhs, $rhs) is rw { lhs // (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<||>(\lhs, $rhs) is rw { lhs || (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<&&>(\lhs, $rhs) is rw { lhs && (lhs = $rhs()) }
sub METAOP_NEGATE(\op) {
-> Mu \a, Mu \b { !op.(a ,b) }
}
sub METAOP_REVERSE(\op) {
-> Mu \a, Mu \b { op.(b, a) }
}
sub METAOP_CROSS(\op, &reduce) {
-> **@lol {
my $rop = @lol.elems == 2 ?? op !! &reduce(op);
my @l;
my @v;
@l[0] = (@lol[0].flat,).list;
my int $i = 0;
my int $n = @lol.elems - 1;
gather {
while $i >= 0 {
if @l[$i].gimme(1) {
@v[$i] = @l[$i].shift;
if $i >= $n { my @x = @v; take $rop(|@x); }
else {
$i = $i + 1;
@l[$i] = (@lol[$i].flat,).list;
}
}
else { $i = $i - 1; }
}
}
}
}
sub METAOP_ZIP(\op, &reduce) {
-> **@lol {
my $rop = @lol.elems == 2 ?? op !! &reduce(op);
my @l = @lol.map({ (.flat,).list.item });
gather {
my $loop = 1;
while $loop {
my @z = @l.map({ $loop = 0 unless $_; .shift });
take-rw $rop(|@z) if $loop;
}
}
}
}
sub METAOP_REDUCE_LEFT(\op, :$triangle) {
my $x := $triangle ??
(sub (*@values) {
return () unless @values.gimme(1);
GATHER({
my $result := @values.shift;
take $result;
take ($result := op.($result, @values.shift))
while @values.gimme(1);
}, :infinite(@values.infinite))
}) !!
(sub (*@values) {
return op.() unless @values.gimme(1);
my $result := @values.shift;
return op.($result) unless @values.gimme(1);
my int $i;
while my int $c = @values.gimme(1000) {
$i = 0;
$result := op.($result, @values.shift)
while ($i = $i + 1) <= $c;
}
$result;
})
}
sub METAOP_REDUCE_RIGHT(\op, :$triangle) {
my $x :=
sub (*@values) {
my $list = @values.reverse;
if $triangle {
return () unless $list.gimme(1);
gather {
my $result := $list.shift;
take $result;
take ($result := op.($list.shift, $result))
while $list.gimme(1);
}
}
else {
return op.() unless $list.gimme(1);
my $result := $list.shift;
return op.($result) unless $list.gimme(1);
my int $i;
while my int $c = $list.gimme(1000) {
$i = 0;
$result := op.($list.shift, $result)
while ($i = $i + 1) <= $c;
}
$result;
}
}
}
sub METAOP_REDUCE_LIST(\op, :$triangle) {
$triangle
?? sub (*@values) {
return () unless @values.gimme(1);
GATHER({
my @list;
while @values {
@list.push(@values.shift);
take op.(|@list);
}
}, :infinite(@values.infinite))
}
!! sub (*@values) { op.(|@values) }
}
sub METAOP_REDUCE_CHAIN(\op, :$triangle) {
$triangle
?? sub (*@values) {
my Mu $current = @values.shift;
my $state = op.();
gather {
take $state;
while $state && @values.gimme(1) {
$state = op.($current, @values[0]);
take $state;
$current = @values.shift;
}
take False for @values;
}
}
!! sub (*@values) {
my $state = op.();
my Mu $current = @values.shift;
while @values.gimme(1) {
$state = op.($current, @values[0]);
$current = @values.shift;
return $state unless $state;
}
$state;
}
}
sub METAOP_REDUCE_XOR(\op, :$triangle) {
X::NYI.new(feature => 'xor reduce').throw;
}
sub METAOP_HYPER(\op, *%opt) {
-> Mu \a, Mu \b { hyper(op, a, b, |%opt) }
}
sub METAOP_HYPER_POSTFIX(\obj, \op) { hyper(op, obj) }
sub METAOP_HYPER_PREFIX(\op, \obj) { hyper(op, obj) }
sub METAOP_HYPER_CALL(\list, |args) { hyper(-> $c { $c(|args) }, list) }
proto sub hyper(|) { * }
multi sub hyper(\op, \a, \b, :$dwim-left, :$dwim-right) {
my @alist := a.flat;
my @blist := b.flat;
my $elems = 0;
if $dwim-left && $dwim-right { $elems = max(@alist.elems, @blist.elems) }
elsif $dwim-left { $elems = @blist.elems }
elsif $dwim-right { $elems = @alist.elems }
else {
X::HyperOp::NonDWIM.new(
operator => op,
left-elems => @alist.elems,
right-elems => @blist.elems,
).throw
if @alist.elems != @blist.elems
}
@alist := (@alist xx *).munch($elems) if @alist.elems < $elems;
@blist := (@blist xx *).munch($elems) if @blist.elems < $elems;
(@alist Z @blist).map(
-> \x, \y {
Iterable.ACCEPTS(x)
?? x.new(hyper(op, x, y, :$dwim-left, :$dwim-right)).item
!! (Iterable.ACCEPTS(y)
?? y.new(hyper(op, x, y, :$dwim-left, :$dwim-right)).item
!! op.(x, y))
}
).eager
}
multi sub hyper(\op, \obj) {
my Mu $rpa := nqp::list();
my Mu $items := nqp::p6listitems(obj.flat.eager);
my Mu $o;
# We process the elements in two passes, end to start, to
# prevent users from relying on a sequential ordering of hyper.
# Also, starting at the end pre-allocates $rpa for us.
my int $i = nqp::elems($items) - 1;
nqp::while(
nqp::isge_i($i, 0),
nqp::stmts(
($o := nqp::atpos($items, $i)),
nqp::bindpos($rpa, $i,
nqp::if(nqp::istype($o, Iterable),
$o.new(hyper(op, $o)).item,
op.($o))),
$i = nqp::sub_i($i, 2)
)
);
$i = nqp::elems($items) - 2;
nqp::while(
nqp::isge_i($i, 0),
nqp::stmts(
($o := nqp::atpos($items, $i)),
nqp::bindpos($rpa, $i,
nqp::if(nqp::istype($o, Iterable),
$o.new(hyper(op, $o)).item,
op.($o))),
$i = nqp::sub_i($i, 2)
)
);
nqp::p6parcel($rpa, Nil);
}
multi sub hyper(\op, Associative \h) {
my @keys = h.keys;
hash @keys Z hyper(op, h{@keys})
}
multi sub hyper(\op, Associative \a, Associative \b, :$dwim-left, :$dwim-right) {
my %k;
for a.keys { %k{$_} = 1 if !$dwim-left || b.exists($_) }
for b.keys { %k{$_} = 1 if !$dwim-right }
my @keys = %k.keys;
hash @keys Z hyper(op, a{@keys}, b{@keys}, :$dwim-left, :$dwim-right)
}
multi sub hyper(\op, Associative \a, \b, :$dwim-left, :$dwim-right) {
my @keys = a.keys;
hash @keys Z hyper(op, a{@keys}, b, :$dwim-left, :$dwim-right);
}
multi sub hyper(\op, \a, Associative \b, :$dwim-left, :$dwim-right) {
my @keys = b.keys;
hash @keys Z hyper(op, a, b{@keys}, :$dwim-left, :$dwim-right);
}
Jump to Line
Something went wrong with that request. Please try again.