metaops.pm

sub METAOP_ASSIGN(\op) {
    -> Mu \a, Mu \b { a = op.( ( a.DEFINITE ?? a !! op.() ), b) }
}

sub METAOP_TEST_ASSIGN:<//>(\lhs, $rhs) is raw { lhs // (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<||>(\lhs, $rhs) is raw { lhs || (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<&&>(\lhs, $rhs) is raw { lhs && (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<or>(\lhs, $rhs) is raw { lhs or (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<and>(       \lhs, $rhs) is raw { lhs and        (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<andthen>(   \lhs, $rhs) is raw { lhs andthen    (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<notandthen>(\lhs, $rhs) is raw { lhs notandthen (lhs = $rhs()) }
sub METAOP_TEST_ASSIGN:<orelse>(    \lhs, $rhs) is raw { lhs orelse     (lhs = $rhs()) }

sub METAOP_NEGATE(\op) {
    -> |c { c.elems > 1 ?? !op.(|c) !! True }
}

sub METAOP_REVERSE(\op) {
    -> |args { op.(|args.reverse) }
}

sub METAOP_CROSS(\op, &reduce) {
    nqp::if(op.prec('thunky').starts-with('.'),
    -> +lol {
        my $rop = lol.elems == 2 ?? op !! &reduce(op);
        my $laze = False;
        my @loi = eager for lol -> \elem {
            if nqp::iscont(elem) {
                $laze = False;
                (elem,).iterator
            }
            else {
                $laze = True if elem.is-lazy;
                elem.iterator
            }
        }
        my Mu $cache := nqp::list();
        my int $i = 0;
        for ^lol.elems {
            $i = $_;
            my Mu $rpa := nqp::list();
            nqp::bindpos($cache, $i, $rpa);
        }
        my int $n = lol.elems - 1;
        my $j = 0;
        my @j;
        my @v;

        $i = 0;
        gather {
            while $i >= 0 {
                my Mu $sublist := nqp::atpos($cache, $i);
                if $j < nqp::elems($sublist) {
                    my Mu $o := nqp::atpos($sublist, $j);
                    @v[$i] := $o;
                    $j = $j + 1;
                    if $i >= $n { take lol.elems == 2 ?? $rop(|@v) !! $rop(@v); }
                    else { $i = $i + 1; @j.push($j); $j = 0; }
                }
                elsif nqp::not_i(nqp::eqaddr((my \value = @loi[$i].pull-one),IterationEnd)) {
                    nqp::bindpos($sublist, $j, value);
                    redo;
                }
                else {
                    $i = $i - 1;
                    if $i { $j = @j.pop if $i > 0 }  # continue previous dimension where we left off
                    else  {
                        $j = 0;
                        my Mu $sublist := nqp::atpos($cache,$i);
                        nqp::pop($sublist);          # don't cache 1st dimension (could be infinite)
                    }
                }
            }
        }.lazy-if($laze);
    },
    -> +lol {
        Seq.new(Rakudo::Iterator.CrossIterablesOp(lol,op))
    }
    )
}

sub METAOP_ZIP(\op, &reduce) {
   nqp::if(op.prec('thunky').starts-with('.'),
   -> +lol {
        my $arity = lol.elems;
        my $rop = $arity == 2 ?? op !! &reduce(op);
        my $laze = True;
        my @loi = eager for lol -> \elem {
            if nqp::iscont(elem) {
                $laze = False;
                Rakudo::Iterator.OneValue(elem)
            }
            else {
                $laze = False unless elem.is-lazy;
                Rakudo::Iterator.Whatever(elem.iterator)
            }
        }
        gather {
            loop {
                my \z = @loi.map: {
                    my \value = .pull-one;
                    last if nqp::eqaddr(value,IterationEnd);
                    value
                };
                my $z = List.from-iterator(z.iterator);
                $z.eager;
                last if $z.elems < $arity;
                take-rw $arity == 2 ?? $rop(|$z) !! $rop(@$z);
            }
        }.lazy-if($laze)
    },
    -> +lol {
        Seq.new(Rakudo::Iterator.ZipIterablesOp(lol,op))
    }
    )
}

proto sub METAOP_REDUCE_LEFT(|) {*}
multi sub METAOP_REDUCE_LEFT(\op, \triangle) {
    if op.count > 2 and op.count < Inf {
        my $count = op.count;
        sub (+values) {
            my \source = values.iterator;

            my \first = source.pull-one;
            return () if nqp::eqaddr(first,IterationEnd);

            my @args.push: first;
            GATHER({
                take first;
                until nqp::eqaddr((my \current = source.pull-one),IterationEnd) {
                    @args.push: current;
                    if @args.elems == $count {
                        my \val = op.(|@args);
                        take val;
                        @args = ();
                        @args.push: val;  # use of push allows op to return a Slip
                    }
                }
            }).lazy-if(source.is-lazy);
        }
    }
    else {
        sub (+values) {
            my \source = values.iterator;

            my \first = source.pull-one;
            return () if nqp::eqaddr(first,IterationEnd);

            my $result := first;
            GATHER({
                take first;
                until nqp::eqaddr((my \value = source.pull-one),IterationEnd) {
                    take ($result := op.($result, value));
                }
            }).lazy-if(source.is-lazy);
        }
    }
}

multi sub METAOP_REDUCE_LEFT(\op) {
    if op.count > 2 and op.count < Inf {
        my $count = op.count;
        sub (+values) {
            my \iter = values.iterator;
            my \first = iter.pull-one;
            return op.() if nqp::eqaddr(first,IterationEnd);

            my @args.push: first;
            my $result := first;
            until nqp::eqaddr((my \value = iter.pull-one),IterationEnd) {
                @args.push: value;
                if @args.elems == $count {
                    my \val = op.(|@args);
                    @args = ();
                    @args.push: val;  # use of push allows op to return a Slip
                    $result := val;
                }
            }
            $result;
        }
    }
    else {
        nqp::eqaddr(op,&infix:<+>)
        ?? &sum
        !! sub (+values) {
            nqp::stmts(
              (my $iter := values.iterator),
              nqp::if(
                nqp::eqaddr((my $result := $iter.pull-one),IterationEnd),
                op.(),                         # identity
                nqp::if(
                  nqp::eqaddr((my $value := $iter.pull-one),IterationEnd),
                  nqp::if(
                    nqp::isle_i(op.arity,1),
                    op.($result),              # can call with 1 param
                    $result                    # what we got
                  ),
                  nqp::stmts(
                    ($result := op.($result,$value)),
                    nqp::until(
                      nqp::eqaddr(($value := $iter.pull-one),IterationEnd),
                      ($result := op.($result,$value))
                    ),
                    $result                    # final result
                  )
                )
              )
            )
        }
    }
}

proto sub METAOP_REDUCE_RIGHT(|) {*}
multi sub METAOP_REDUCE_RIGHT(\op, \triangle) {
    nqp::if(
      op.count < Inf && nqp::isgt_i((my int $count = op.count),2),
      sub (+values) {
          Seq.new(nqp::if(
            nqp::isge_i((my int $i = (my $v :=
                nqp::if(nqp::istype(values,List),values,values.List)
              ).elems),                                       # reifies
              $count
            ),   # reifies
            class :: does Iterator {
                has $!op;
                has $!reified;
                has $!result;
                has int $!count;
                has int $!i;
                method !SET-SELF(\op,\list,\count,\index) {
                    nqp::stmts(
                      ($!op := op),
                      ($!reified := nqp::getattr(list,List,'$!reified')),
                      ($!count = count),
                      ($!i = index),
                      self
                    )
                }
                method new(\op,\list,\count,\index) {
                    nqp::create(self)!SET-SELF(op,list,count,index)
                }
                method pull-one() is raw {
                    nqp::if(
                      nqp::attrinited(self,self.WHAT,'$!result'),
                      nqp::stmts(
                        (my $args := nqp::list($!result)),
                        nqp::until(
                          nqp::iseq_i(nqp::elems($args),$!count)
                            || nqp::islt_i(($!i = nqp::sub_i($!i,1)),0),
                          nqp::unshift($args,nqp::atpos($!reified,$!i))
                        ),
                        nqp::if(
                          nqp::isgt_i(nqp::elems($args),1),
                          ($!result := op.(|nqp::hllize($args))),
                          IterationEnd
                        )
                      ),
                      ($!result := nqp::atpos(
                        $!reified,
                        ($!i = nqp::sub_i($!i,1))
                      ))
                    )
                }
                method bool-only(--> True) { };
                method count-only() { nqp::p6box_i($!i) }
            }.new(op,$v,$count,$i),
            Rakudo::Iterator.OneValue(
              nqp::if(
                $i,
                op.(|nqp::getattr($v,List,'$!reified')),
                op.()
              )
            )
          ))
      },
      sub (+values) {
          Seq.new(nqp::if(
            nqp::isgt_i((my int $i = (my $v :=
                nqp::if(nqp::istype(values,List),values,values.List)
              ).elems),                                       # reifies
              1
            ),
            class :: does Iterator {
                has $!op;
                has $!reified;
                has $!result;
                has int $!i;
                method !SET-SELF(\op,\list,\count) {
                    nqp::stmts(
                      ($!op := op),
                      ($!reified := nqp::getattr(list,List,'$!reified')),
                      ($!i = count),
                      self
                    )
                }
                method new(\op,\li,\co) { nqp::create(self)!SET-SELF(op,li,co) }
                method pull-one() is raw {
                    nqp::if(
                      nqp::attrinited(self,self.WHAT,'$!result'),
                      nqp::if(
                        nqp::isge_i(($!i = nqp::sub_i($!i,1)),0),
                        ($!result := $!op.(nqp::atpos($!reified,$!i),$!result)),
                        IterationEnd
                      ),
                      ($!result := nqp::atpos(
                        $!reified,
                        ($!i = nqp::sub_i($!i,1))
                      ))
                    )
                }
                method bool-only(--> True) { };
                method count-only() { nqp::p6box_i($!i) }
            }.new(op,$v,$i),
            Rakudo::Iterator.OneValue(
              nqp::if(
                $i,
                op.(nqp::atpos(nqp::getattr($v,List,'$!reified'),0)),
                op.()
              )
            )
          ))
      }
    )
}
multi sub METAOP_REDUCE_RIGHT(\op) {
    nqp::if(
      op.count < Inf && nqp::isgt_i((my int $count = op.count),2),
      sub (+values) {
          nqp::if(
            nqp::isge_i((my int $i = (my $v :=
                nqp::if(nqp::istype(values,List),values,values.List)
              ).elems),                                       # reifies
              $count
            ),   # reifies
            nqp::stmts(
              (my $args := nqp::list(
                my $result := nqp::atpos(
                  (my $reified := nqp::getattr($v,List,'$!reified')),
                  ($i = nqp::sub_i($i,1))
                )
              )),
              nqp::until(
                nqp::islt_i(($i = nqp::sub_i($i,1)),0),
                nqp::stmts(
                  nqp::unshift($args,nqp::atpos($reified,$i)),
                  nqp::if(
                    nqp::iseq_i(nqp::elems($args),$count),
                    nqp::stmts(
                      ($result := op.(|nqp::hllize($args))),
                      nqp::bindpos(nqp::setelems($args,1),0,$result)
                    )
                  )
                )
              ),
              nqp::if(
                nqp::isgt_i(nqp::elems($args),1),
                op.(|nqp::hllize($args)),    # something left to process
                $result
              )
            ),
            nqp::if(
              $i,
              op.(|nqp::getattr($v,List,'$!reified')),
              op.()
            )
        )
      },
      sub (+values) {
          nqp::if(
            nqp::isgt_i((my int $i = (my $v :=
                nqp::if(nqp::istype(values,List),values,values.List)
              ).elems),                                       # reifies
              1
            ),
            nqp::stmts(
              (my $result := nqp::atpos(
                nqp::getattr($v,List,'$!reified'),
                ($i = nqp::sub_i($i,1))
              )),
              nqp::while(
                nqp::isge_i(($i = nqp::sub_i($i,1)),0),
                ($result := op.(
                  nqp::atpos(nqp::getattr($v,List,'$!reified'),$i),
                  $result
                ))
              ),
              $result
            ),
            nqp::if(
              $i,
              op.(nqp::atpos(nqp::getattr($v,List,'$!reified'),0)),
              op.()
            )
          )
      }
    )
}

proto sub METAOP_REDUCE_LIST(|) {*}
multi sub METAOP_REDUCE_LIST(\op, \triangle) {
    sub (+values) {
        GATHER({
            my @list;
            for values -> \v {
                @list.push(v);
                take op.(|@list);
            }
        }).lazy-if(values.is-lazy);
    }
}
multi sub METAOP_REDUCE_LIST(\op) {
    sub (+values) { op.(|values) }
}

proto sub METAOP_REDUCE_LISTINFIX(|) {*}
multi sub METAOP_REDUCE_LISTINFIX(\op, \triangle) {
    sub (|values) {
        my \p = values[0];
        return () unless p.elems;

        my int $i;
        GATHER({
            my @list;
            while $i < p.elems {
                @list.push(p[$i++]);
                take op.(|@list.map({nqp::decont($_)}));
            }
        }).lazy-if(p.is-lazy);
    }
}
multi sub METAOP_REDUCE_LISTINFIX(\op) {
    sub (+values) {
        op.(|values.map({nqp::decont($_)}));
    }
}

proto sub METAOP_REDUCE_CHAIN(|) {*}
multi sub METAOP_REDUCE_CHAIN(\op, \triangle) {
    sub (+values) {
        my $state = True;
        my \iter = values.iterator;
        my Mu $current = iter.pull-one;
        gather {
            take $state;
            while $state && nqp::not_i(nqp::eqaddr((my $next := iter.pull-one),IterationEnd)) {
                $state = op.($current, $next);
                take $state;
                $current := $next;
            }
            unless $state {
                take False until nqp::eqaddr(iter.pull-one,IterationEnd);
            }
        }.lazy-if(values.is-lazy);
    }
}
multi sub METAOP_REDUCE_CHAIN(\op) {
    sub (+values) {
        nqp::if(
          nqp::eqaddr(
            (my $current := (my $iter := values.iterator).pull-one),
            IterationEnd
          ),
          True,
          nqp::stmts(
            nqp::while(
              nqp::not_i(nqp::eqaddr((my $next := $iter.pull-one),IterationEnd))
                && op.($current,$next),
              $current := $next
            ),
            nqp::p6bool(nqp::eqaddr($next,IterationEnd))
          )
        )
    }
}

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) }
}

proto sub METAOP_HYPER_POSTFIX(|) {*}
multi sub METAOP_HYPER_POSTFIX(\op) {
    nqp::if(
      nqp::can(op,"nodal"),
      (-> \obj { nodemap(op, obj) }),
      (-> \obj { deepmap(op, obj) })
    )
}

# no indirection for subscripts and such
proto sub METAOP_HYPER_POSTFIX_ARGS(|) {*}
multi sub METAOP_HYPER_POSTFIX_ARGS(\obj,\op) {
    nqp::if(
      nqp::can(op,"nodal"),
      nodemap(op, obj),
      deepmap(op, obj)
    )
}
multi sub METAOP_HYPER_POSTFIX_ARGS(\obj, @args, \op) {
    nqp::if(
      nqp::can(op,"nodal"),
      nodemap( -> \o { op.(o,@args) }, obj ),
      deepmap( -> \o { op.(o,@args) }, obj )
    )
}
multi sub METAOP_HYPER_POSTFIX_ARGS(\obj, \args, \op) {
    nqp::if(
      nqp::can(op,"nodal"),
      nodemap( -> \o { op.(o,|args) }, obj ),
      deepmap( -> \o { op.(o,|args) }, obj )
    )
}

sub METAOP_HYPER_PREFIX(\op) {
    nqp::if(
      nqp::can(op,"nodal"),      # rarely true for prefixes
      (-> \obj { nodemap(op, obj) }),
      (-> \obj { deepmap(op, obj) })
    )
}

sub METAOP_HYPER_CALL(\list, |args) { deepmap(-> $c { $c(|args) }, list) }

proto sub HYPER(|) {*}

multi sub HYPER(&op, \left, \right, :$dwim-left, :$dwim-right) {
    op(left, right);
}

multi sub HYPER(&op, Associative:D \left, Associative:D \right, :$dwim-left, :$dwim-right) {
    my %keyset;
    if !$dwim-left {
        %keyset{$_} = 1 for left.keys;
    }
    else {
        %keyset{$_} = 1 if right.EXISTS-KEY($_) for left.keys;
    }
    if !$dwim-right {
        %keyset{$_} = 1 for right.keys;
    }
    my @keys = %keyset.keys;
    my $type = left.WHAT;
    my \result := $type.new;
    result = quietly @keys Z=> HYPER(&op, left{@keys}, right{@keys}, :$dwim-left, :$dwim-right);
    nqp::iscont(left) ?? result.item !! result;
}

multi sub HYPER(&op, Associative:D \left, \right, :$dwim-left, :$dwim-right) {
    my @keys = left.keys;
    my $type = left.WHAT;
    my \result := $type.new;
    result = @keys Z=> HYPER(&op, left{@keys}, right, :$dwim-left, :$dwim-right);
    nqp::iscont(left) ?? result.item !! result;
}

multi sub HYPER(&op, \left, Associative:D \right, :$dwim-left, :$dwim-right) {
    my @keys = right.keys;
    my $type = right.WHAT;
    my \result := $type.new;
    result = @keys Z=> HYPER(&op, left, right{@keys}, :$dwim-left, :$dwim-right);
    nqp::iscont(right) ?? result.item !! result;
}

multi sub HYPER(&operator, Positional:D \left, \right, :$dwim-left, :$dwim-right) {
    my @result;
    X::HyperOp::Infinite.new(:side<left>, :&operator).throw if left.is-lazy;
    my int $elems = left.elems;
    X::HyperOp::NonDWIM.new(:&operator, :left-elems($elems), :right-elems(1), :recursing(callframe(3).code.name eq 'HYPER')).throw
        unless $elems == 1 or $elems > 1 and $dwim-right or $elems == 0 and $dwim-left || $dwim-right;
    my \lefti := left.iterator;
    my int $i = 0;
    until nqp::eqaddr((my \value := lefti.pull-one),IterationEnd) {
        @result[$i++] := HYPER(&operator, value, right, :$dwim-left, :$dwim-right);
    }
    # Coerce to the original type if it's a subtype of List
    my $type = nqp::istype(left, List) ?? left.WHAT !! List;
    nqp::iscont(left) ?? $type(|@result.eager).item !! $type(|@result.eager)
}

multi sub HYPER(&operator, \left, Positional:D \right, :$dwim-left, :$dwim-right) {
    my @result;
    X::HyperOp::Infinite.new(:side<right>, :&operator).throw if right.is-lazy;
    my int $elems = right.elems;
    X::HyperOp::NonDWIM.new(:&operator, :left-elems(1), :right-elems($elems), :recursing(callframe(3).code.name eq 'HYPER')).throw
        unless $elems == 1 or $elems > 1 and $dwim-left or $elems == 0 and $dwim-left || $dwim-right;
    my \righti := right.iterator;
    my int $i = 0;
    until nqp::eqaddr((my \value := righti.pull-one),IterationEnd) {
        @result[$i++] := HYPER(&operator, left, value, :$dwim-left, :$dwim-right);
    }
    # Coerce to the original type if it's a subtype of List
    my $type = nqp::istype(right, List) ?? right.WHAT !! List;
    nqp::iscont(right) ?? $type(|@result.eager).item !! $type(|@result.eager)
}

multi sub HYPER(&operator, Iterable:D \left, Iterable:D \right, :$dwim-left, :$dwim-right) {
    my \left-iterator = left.iterator;
    my \right-iterator = right.iterator;

    # Check whether any side is lazy. They must not be to proceed.
    if left-iterator.is-lazy {
        X::HyperOp::Infinite.new(:side<both>, :&operator).throw if right-iterator.is-lazy;
        X::HyperOp::Infinite.new(:side<left>, :&operator).throw if not $dwim-left or $dwim-right;
    }
    X::HyperOp::Infinite.new(:side<right>, :&operator).throw if right-iterator.is-lazy and
        (not $dwim-right or $dwim-left);

    my \lefti  := Rakudo::Iterator.DWIM(left-iterator);
    my \righti := Rakudo::Iterator.DWIM(right-iterator);

    my \result := IterationBuffer.new;
    loop {
        my \leftv := lefti.pull-one;
        my \rightv := righti.pull-one;

        X::HyperOp::NonDWIM.new(:&operator, :left-elems(lefti.count-elems), :right-elems(righti.count-elems), :recursing(callframe(3).code.name eq 'HYPER')).throw
            if !$dwim-left and !$dwim-right and (lefti.ended != righti.ended);

        last if ($dwim-left and $dwim-right) ?? (lefti.ended and righti.ended) !!
               (($dwim-left or lefti.ended) and ($dwim-right or righti.ended));
        last if $++ == 0 and ($dwim-left and lefti.ended or $dwim-right and righti.ended);

        nqp::push(result,HYPER(&operator, leftv, rightv, :$dwim-left, :$dwim-right));
    }

    # Coerce to the original type
    my $type = nqp::istype(left, List) ?? left.WHAT !! List; # keep subtypes of List
    my \retval = $type.new;
    nqp::bindattr(retval, List, '$!reified', result);
    nqp::iscont(left) ?? retval.item !! retval;
}

multi sub HYPER(\op, \obj) {
    nqp::if(
      nqp::can(op,"nodal"),
      nodemap(op, obj),
      deepmap(op,obj)
    )
}

proto sub deepmap(|) {*}

multi sub deepmap(\op, \obj) {
    Rakudo::Internals.coremap(op, obj, :deep)
}

multi sub deepmap(\op, Associative \h) {
    my @keys = h.keys;
    hash @keys Z deepmap(op, h{@keys})
}

proto sub nodemap(|) {*}
multi sub nodemap(\op, \obj) {
    my Mu $rpa := nqp::create(IterationBuffer);
    my \objs := obj.list;
    # as a wanted side-effect is-lazy reifies the list
    fail X::Cannot::Lazy.new(:action('deepmap')) if objs.is-lazy;
    my Mu $items := nqp::getattr(objs, List, '$!reified');
    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(Mu,             # hack cuz I don't understand nqp
                        $o.new(nodemap(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(Mu,             # hack cuz I don't understand nqp
                        $o.new(nodemap(op, $o)).item,
                        op.($o))),
            $i = nqp::sub_i($i, 2)
        )
    );
    nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', $rpa)
}

multi sub nodemap(\op, Associative \h) {
    my @keys = h.keys;
    hash @keys Z nodemap(op, h{@keys})
}

proto sub duckmap(|) {*}
multi sub duckmap(\op, \obj) {
    Rakudo::Internals.coremap(sub (\arg) { CATCH { return arg ~~ Iterable:D ?? duckmap(op,arg) !! arg }; op.(arg); }, obj);
}

multi sub duckmap(\op, Associative \h) {
    my @keys = h.keys;
    hash @keys Z duckmap(op, h{@keys})
}

# vim: ft=perl6 expandtab sw=4