The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# EVIL hacks here! E.g. method map and sub JS::Root::map!

method JS::Root::shift(@self:) is rw {
  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var array = args[1].FETCH(), cc = args.pop();
    var ret   = array.shift();
    cc(ret == undefined ? new PIL2JS.Box.Constant(undefined) : ret);
  })')(@self);
}

method JS::Root::pop(@self:) is rw {
  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var array = args[1].FETCH(), cc = args.pop();
    var ret   = array.pop();
    cc(ret == undefined ? new PIL2JS.Box.Constant(undefined) : ret);
  })')(@self);
}

method JS::Root::unshift($self is rw: *@things) is rw {
  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var array = args[1].FETCH(), add = args[2].FETCH(), cc = args.pop();
    if(array == undefined) args[1].STORE(new PIL2JS.Box.Constant(array = []));
    if(array.referencee && array.autoderef) array = array.referencee.FETCH();

    for(var i = add.length - 1; i >= 0; i--) {
      array.unshift(new PIL2JS.Box(add[i].FETCH()));
    }
    cc(new PIL2JS.Box.Constant(array.length));
  })')($self, @things);
}

method JS::Root::push($self is rw: *@things) is rw {
  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var array = args[1].FETCH(), add = args[2].FETCH(), cc = args.pop();
    if(array == undefined) args[1].STORE(new PIL2JS.Box.Constant(array = []));
    if(array.referencee && array.autoderef) array = array.referencee.FETCH();

    for(var i = 0; i < add.length; i++) {
      array.push(new PIL2JS.Box(add[i].FETCH()));
    }
    cc(new PIL2JS.Box.Constant(array.length));
  })')($self, @things);
}

method join(@self: Str $sep) { join $sep, @self }
sub JS::Root::join(Str $sep, *@things) is primitive {
  JS::inline('(
    function (arr, sep) {
      return arr.join(String(sep));
    }
  )')(@things.map:{ ~$_ }, $sep);
}

method JS::Root::elems(@self:) {
  JS::inline('(function (arr) { return arr.length })')(@self);
}

method JS::Root::end(@self:) {
  JS::inline('(function (arr) { return arr.length - 1 })')(@self);
}

method map(@self is rw: Code $code) { map $code, @self }
sub JS::Root::map(Code $code, *@array is rw) is primitive {
  die "&map needs a Code as first argument!" unless $code.isa("Code");
  my $arity = $code.arity;
  # die "Can't use 0-ary subroutine as \"map\" body!" if $arity == 0;
  $arity ||= 1;

  my @res;
  my @args;
  while +@array > 0 {
    @args = ();
    my $i; loop ($i = 0; $i < $arity; $i++) {
      # Slighly hacky
      push @args: undef;
      @args[-1] := @array.shift;
    }
    push @res, $code([,] @args);
  }

  @res;
}

# XXX XXX XXX XXX ("luckily", the fully qualified name of a method doesn't
# matter. XXX XXX evil hack)
method sort(@self: Code $cmp = &infix:<cmp>) { sort $cmp, @self }
method PIL2JS::Internals::This::Is::A::Truly::Horrible::Hack::sort(%self: Code $cmp = &infix:<cmp>) { sort $cmp, %self.pairs }
sub JS::Root::sort(Code $cmp is copy = &infix:<cmp>, *@array) is primitive {
  # Hack
  unless $cmp.isa("Code") {
    unshift @array, @$cmp;
    $cmp := &infix:<cmp>;
  }

  die "&sort needs a Code as first argument!" unless $cmp.isa("Code");
  my $arity = $cmp.arity;
  $arity ||= 2; # hack
  die "Can't use $arity-ary subroutine as comparator block for &sort!"
    unless $arity == 2;

  JS::inline('new PIL2JS.Box.Constant(function (args) {
    // [].concat(...): Defeat modifying of the original array.
    var array = [].concat(args[1].FETCH()), cmp = args[2].FETCH(), cc = args.pop();
    var jscmp = function (a, b) {
      return PIL2JS.cps2normal(cmp, [PIL2JS.Context.ItemAny, a, b]).toNative();
    };
    array.sort(jscmp);
    cc(new PIL2JS.Box.Constant(array));
  })')(@array, $cmp);
}

method reduce(@self: Code $code) { reduce $code, @self }
sub JS::Root::reduce(Code $code, *@array) is primitive {
  die "&reduce needs a Code as first argument!" unless $code.isa("Code");
  my $arity = $code.arity;
  die "Can't use an unary or nullary block for &reduce!" if $arity < 2;

  my $ret = @array.shift;
  while +@array > 0 {
    my @args;
    my $i; loop ($i = 0; $i < $arity - 1; $i++) {
      # Slighly hacky
      push @args: undef;
      @args[-1] := @array.shift;
    }
    $ret = $code($ret, @args);
  }

  $ret;
}

method min(@self: Code $cmp = &infix:«<=>») { min $cmp, @self }
method max(@self: Code $cmp = &infix:«<=>») { max $cmp, @self }
sub JS::Root::min(Code $cmp = &infix:«<=>», *@array) is primitive {
  # Hack, see comment at &sort.
  unless $cmp.isa("Code") {
    unshift @array, @$cmp;
    $cmp := &infix:«<=>»;
  }
  @array.max:{ $cmp($^b, $^a) };
}
sub JS::Root::max(Code $cmp = &infix:«<=>», *@array) is primitive {
  # Hack, see comment at &sort.
  unless $cmp.isa("Code") {
    unshift @array, @$cmp;
    $cmp := &infix:«<=>»;
  }

  my $max = @array.shift;
  $max = ($cmp($max, $_)) < 0 ?? $_ !! $max for @array;
  $max;
}

method grep(@self: Code $code) { grep $code, @self }
sub JS::Root::grep(Code $code, *@array) is primitive {
  #die "Code block for \"grep\" must be unary!" unless $code.arity == 1;

  my @res;
  for @array -> $item is rw {
    push @res, $item if $code($item);
  }
  @res;
}

method sum(@self:) { sum @self }
sub JS::Root::sum(*@vals) is primitive {
  my $sum = 0;
  $sum += +$_ for @vals;
  @vals ?? $sum !! undef;
  # We should return undef if we haven't been giving @vals to sum.
}

method uniq(@self: Code $cmp = &infix:<===>) { uniq $cmp, @self }
sub JS::Root::uniq(Code $cmp is copy = &infix:<cmp>, *@array) is primitive {
  # Hack
  unless $cmp.isa("Code") {
    unshift @array, @$cmp;
    $cmp := &infix:<===>;
  }

  # XXX O(n²) implementation, needing .WHICH or === hashes for a better
  # implementation
  my @res;
  for @array -> $elem {
    unless $cmp($elem, any(@res)) {
      push @res, $elem;
    }
  }

  @res;
}

sub JS::Root::zip(Array *@arrays) is primitive is rw {
  my $maxlen = max map { +$_ }, @arrays;  # XXX wanting hyperops
  map {
    my $i := $_;
    map { @arrays[$_][$i] }, 0..@arrays.end;
  }, 0..$maxlen-1;
}

method reverse(*@things is copy:) {
  # Hack, should of course use context info, but that's not here yet.
  if @things == 1 {
    JS::inline('(function (str) { return str.split("").reverse().join("") })')(@things[0]);
  } else {
    JS::inline('new PIL2JS.Box.Constant(function (args) {
      var arr = [].concat(args[1].FETCH()), cc = args.pop();
      arr.reverse();
      cc(new PIL2JS.Box.Constant(arr));
    })')(@things);
  }
}

sub infix:<..>(Num $from, Num $to) is primitive {
  my $i;
  my @res;

  loop ($i = $from; $i <= $to; $i++) {
    push @res, $i;
  }

  @res;
}
sub infix:<^..>  (Num $from, Num $to) is primitive { ($from + 1)..$to }
sub infix:<..^>  (Num $from, Num $to) is primitive { $from..($to - 1) }
sub infix:<^..^> (Num $from, Num $to) is primitive { ($from + 1)..($to - 1) }

sub infix:<,>(*@xs is rw) is primitive is rw {
  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var cxt   = args.shift();
    var cc    = args.pop();
    var iarr  = args[0].FETCH();

    // We don\'t create new containers (new PIL2JS.Boxes) *here* -- lists
    // don\'t create new containers. Assigning to an array will take care of
    // this.

    var mk_magicalarray = function () {
      var marray = [];

      for(var i = 0; i < iarr.length; i++) {
        marray[i] = new PIL2JS.Box(undefined).BINDTO(
          // Slighly hacky way to determine if iarr[i] is undef, i.e.
          // it\'s needed to make
          //   my ($a, undef, $b) = (3,4,5);
          // work.
          iarr[i].isConstant && iarr[i].FETCH() == undefined
            ? new PIL2JS.Box(undefined)
            : iarr[i]
        );
      }

      return marray;
    };

    // Proxy needed for ($a, $b) = (3, 4) which really is
    // &infix:<,>($a, $b) = (3, 4);
    var proxy = new PIL2JS.Box.Proxy(
      function ()  { return iarr },
      function (n) {
        var marray = mk_magicalarray();
        var arr    = new PIL2JS.Box([]).STORE(n).FETCH();

        for(var i = 0; i < arr.length; i++) {
          if(marray[i]) marray[i].STORE(arr[i]);
        }

        return this;
      }
    );

    proxy.BINDTO = function (other) {
      var arr = other.FETCH();

      if(!(arr instanceof Array)) {
        PIL2JS.die("Can\'t bind list literal to non-array object!");
      }

      var backup_arr = [];
      for(var i = 0; i < arr.length; i++) {
        backup_arr[i]        = new PIL2JS.Box;
        backup_arr[i].FETCH  = arr[i].FETCH;
        backup_arr[i].STORE  = arr[i].STORE;
        backup_arr[i].BINDTO = arr[i].BINDTO;
      }

      for(var i = 0; i < backup_arr.length; i++) {
        if(iarr[i].isConstant && iarr[i].FETCH() == undefined) {
          // ($a, **undef**, $b) := (1,2,3);
          // (i.e., do nothing)
        } else {
          iarr[i].BINDTO(backup_arr[i]);
        }
      }

      return this;
    };

    cc(proxy);
  })')(@xs);
}
our &list := &infix:<,>;
our &pair := &infix:<,>;  # XXX wrong

sub circumfix:<[]>(*@xs is rw) is primitive { my @copy; @copy = @xs; \@copy }
method postcircumfix:<[]>(@self: Int *@idxs) is rw {
  die "Can't use object of type {@self.ref} as an array!"
    unless @self.isa("Array");

  # *Important*: We have to calculate the idx only *once*:
  #   my @a  = (1,2,3,4);
  #   my $z := @a[-1];
  #   say $z;               # 4
  #   push @a, 5;
  #   say $z;               # 4 (!!)

  JS::inline('new PIL2JS.Box.Constant(function (args) {
    var cxt   = args.shift();
    var cc    = args.pop();
    var array = args[0].FETCH();
    var idxs  = args[1].toNative();

    var orig_value = [];
    for(var i = 0; i < idxs.length; i++) {
      idxs[i] = Number(idxs[i]);
      if(idxs[i] < 0) {
        var orig = Number(idxs[i]);
        idxs[i] = array.length + idxs[i];
        orig_value[idxs[i]] = orig;
      }
    }

    if(idxs.length == 0) PIL2JS.die("No indices given to &postcircumfix:<[ ]>!");

    // Relay .FETCH and .STORE to array[idx].
    var proxy_for = function (idx) {
      var ret = new PIL2JS.Box.Proxy(
        function () {
          var ret = array[idx];
          return ret == undefined ? undefined : ret.FETCH();
        },
        function (n) {
          if(idx < 0)
            PIL2JS.die("Modification of non-creatable array value attempted, subscript " + orig_value[idx]);

          // Support (in a slightly hacky manner) ($a, undef, $b) = (3,4,5).
          if(
            array[idx] == undefined || (
              array[idx].isConstant &&
              array[idx].FETCH() == undefined
            )
          ) {
            array[idx] = new PIL2JS.Box(undefined);
          }
          array[idx].STORE(n);
          return n;
        }
      );

      ret.uid = array[idx] == undefined ? undefined : array[idx].uid;

      // @a[$idx] := $foo should autovivify @a[$idx] if necessary.
      ret.BINDTO = function (other) {
        if(idx < 0)
          PIL2JS.die("Modification of non-creatable array value attempted, subscript " + orig_value[idx]);

        if(array[idx] == undefined)
          array[idx] = new PIL2JS.Box(undefined);

        return array[idx].BINDTO(other);
      };

      return ret;
    };

    if(idxs.length == 1) {
      cc(proxy_for(idxs[0]));
    } else {
      var ret = [];
      for(var i = 0; i < idxs.length; i++) {
        ret.push(proxy_for(idxs[i]));
      }

      // Needed for @a[1,2] = (3,4).
      var proxy = new PIL2JS.Box.Proxy(
        function ()  { return ret },
        function (n) {
          var arr = new PIL2JS.Box([]).STORE(n).FETCH();
          for(var i = 0; i < arr.length; i++) {
            if(ret[i]) ret[i].STORE(arr[i]);
          }

          return this;
        }
      );
      proxy.BINDTO = function (other) {
        var arr = other.FETCH();

        if(!(arr instanceof Array)) {
          PIL2JS.die("Can\'t bind array slice to non-array object!");
        }

        var backup_arr = [];
        for(var i = 0; i < arr.length; i++) {
          backup_arr[i]        = new PIL2JS.Box;
          backup_arr[i].FETCH  = arr[i].FETCH;
          backup_arr[i].STORE  = arr[i].STORE;
          backup_arr[i].BINDTO = arr[i].BINDTO;
        }

        for(var i = 0; i < backup_arr.length; i++) {
          ret[i].BINDTO(backup_arr[i]);
        }

        return this;
      };

      cc(proxy);
    }
  })')(@self, @idxs);
}

# Array autovification
# Needs PIL2 and MMD to be done without hacks
sub PIL2JS::Internals::Hacks::array_postcircumfix_for_undefs (
  $array is rw, Int *@idxs,
) is primitive is rw {
  if defined $array {
    die "\"$array\" can't be autovivified to an array!";
  }

  $array = [];
  $array[@idxs];
}

sub PIL2JS::Internals::Hacks::init_undef_array_postcircumfix_method () is primitive {
  JS::inline('(function () {
    PIL2JS.addmethod(
      _3aMain_3a_3aItem,
      "postcircumfix:[]",
      _26PIL2JS_3a_3aInternals_3a_3aHacks_3a_3aarray_postcircumfix_for_undefs
    );
  })')();
}

# Code from Prelude::PIR
sub splice (@a is rw, $offset=0, $length?, *@list) is primitive {
    my $off = +$offset;
    my $len = $length;
    my $size = +@a;

    $off += $size if $off < 0;
    if $off > $size {
        warn "splice() offset past end of array\n";
        $off = $size;
    }
    # $off is now ready

    $len = +$len if defined($len);
    $len = $size - $off if !defined($len);
    $len = $size + $len - $off if $len < 0;
    $len = 0 if $len < 0;
    # $len is now ready

    my $listlen = +@list;
    my $size_change = $listlen - $len;
    my @result;

    if 1 {
        my $i = $off;
        my $stop = $off + $len;
        while $i < $stop {
            push(@result,@a[$i]);
            $i++;
        }
    }

    if $size_change > 0 {
        my $i = $size + $size_change -1;
        my $final = $off + $size_change;
        while $i >= $final {
            # The .delete here is necessary to destroy all possible bindings
            # user code has to @a[$i], see t/operators/binding/arrays.t.
            @a.delete($i);
            @a[$i] = @a[$i-$size_change];
            $i--;
        }
    } elsif $size_change < 0 {
        my $i = $off;
        my $final = $size + $size_change -1;
        while $i <= $final {
            # The .delete here is necessary to destroy all possible bindings
            # user code has to @a[$i], see t/operators/binding/arrays.t.
            @a.delete($i);
            @a[$i] = @a[$i-$size_change];
            $i++;
        }
        # +@a = $size + $size_change;
        #   doesnt exist yet, so...
        my $n = 0;
        while $n-- > $size_change {
            pop(@a);
        }
    }

    if $listlen > 0 {
        my $i = 0;
        while $i < $listlen {
            # The .delete here is necessary to destroy all possible bindings
            # user code has to @a[$off+$i], see t/operators/binding/arrays.t.
            @a.delete($off+$i);
            @a[$off+$i] = @list[$i];
            $i++;
        }
    }

    #  want.List ?? @result !! pop(@result)
    #  want.List ?? @result !! +@result ?? @result[-1] !! undef;
    #  @result;
    @result;
}