makeNATIVE_CANDIDATES.raku

#!/usr/bin/env raku

# This script reads the native_array.pm6 file, and generates the
# intarray, numarray and strarray postcircumfix candidates and
# writes it back to the file.

# always use highest version of Raku
use v6.*;

my $generator = $*PROGRAM-NAME;
my $generated = DateTime.now.gist.subst(/\.\d+/,'');
my $start     = '#- start of postcircumfix candidates of ';
my $idpos     = $start.chars;
my $idchars   = 3;
my $end       = '#- end of postcircumfix candidates of ';

my %type_mapper = (
  int => ( :nullval("0"),
           :postfix<i>,
           :postfix_push<i>,
           :postfix_cmp<i>,
           :type<int>,
           :Type<Int>,
           :value<int>,
           :Value<Int>,
         ).Map,
  num => ( :nullval("0e0"),
           :postfix<n>,
           :postfix_push<n>,
           :postfix_cmp<n>,
           :type<num>,
           :Type<Num>,
           :value<num>,
           :Value<Num>,
         ).Map,
  str => ( :nullval('""'),
           :postfix<s>,
           :postfix_push<s>,
           :postfix_cmp<s>,
           :type<str>,
           :Type<Str>,
           :value<str>,
           :Value<Str>,
         ).Map,
  uint => ( :nullval("0"),
            :postfix<u>,
            :postfix_push<i>,
            :postfix_cmp<i>,
            :type<uint>,
            :Type<UInt>,
            :value<int>,
            :Value<Int>,
          ).Map,
);

# slurp the whole file and set up writing to it
my $filename = "src/core.c/native_array.pm6";
my @lines = $filename.IO.lines;
$*OUT = $filename.IO.open(:w);

# for all the lines in the source that don't need special handling
while @lines {
    my $line := @lines.shift;

    # nothing to do yet
    unless $line.starts-with($start) {
        say $line;
        next;
    }

    # found header, check validity and set up mapper
    my $type = $line.substr($idpos,$idchars);
    $type = "uint" if $type eq "uin";
    die "Don't know how to handle $type"
      unless my %mapper := %type_mapper{$type};

    say $start ~ $type ~ "array -------------------------------";
    say "#- Generated on $generated by $generator";
    say "#- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE";

    # skip the old version of the code
    while @lines {
        last if @lines.shift.starts-with($end);
    }

    # spurt the candidates
    say Q:to/SOURCE/.subst(/ '#' (\w+) '#' /, -> $/ { %mapper{$0} }, :g).chomp;

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, uint $pos
) is raw {
    nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}
multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, uint $pos, #Type#:D \assignee
) is raw {
    nqp::bindpos_#postfix#(nqp::decont(SELF),$pos,assignee)
}
multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, #Type#:D \assignee
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! nqp::bindpos_#postfix#(nqp::decont(SELF),$pos,assignee);
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D, Int:D, :$BIND!
) {
    X::Bind.new(target => 'a native #type# array').throw
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$exists!, *%_
) {
    my int $state =
      nqp::isge_i($pos,0) && nqp::islt_i($pos,nqp::elems(nqp::decont(SELF)));
    my $value := nqp::hllbool($exists ?? $state !! nqp::not_i($state));

    $state
      ?? nqp::elems(my $adverbs := nqp::getattr(%_,Map,'$!storage'))
        ?? nqp::atkey($adverbs,'kv')
          ?? ($pos,$value)
          !! nqp::atkey($adverbs,'p')
            ?? Pair.new($pos,$value)
            !! X::Adverb.new(
                 what   => "slice",
                 source => "a native #type# array",
                 nogo   => ('exists', |%_.keys).sort
               ).Failure
        !! $value
      !! $value
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$delete!, *%_
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! $delete
        ?? X::Delete.new(target => 'a native #type# array').throw
        !! nqp::elems(nqp::getattr(%_,Map,'$!storage'))
          ?? postcircumfix:<[ ]>(SELF, $pos, |%_)
          !! nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$kv!
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! $kv
        ?? nqp::list($pos,nqp::atpos_#postfix#(nqp::decont(SELF),$pos))
        !! nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$p!
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! $p
        ?? Pair.new($pos,nqp::atpos_#postfix#(nqp::decont(SELF),$pos))
        !! nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$k!
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! $k
        ?? $pos
        !! nqp::atposref_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Int:D $pos, :$v!
) is raw {
    nqp::islt_i($pos,0)
      ?? X::OutOfRange.new(:what<Index>, :got($pos), :range<0..^Inf>).throw
      !! $v
        ?? nqp::isge_i($pos,0) && nqp::islt_i($pos,nqp::elems(nqp::decont(SELF)))
          ?? nqp::list(nqp::atpos_#postfix#(nqp::decont(SELF),$pos))
          !! ()
        !! nqp::atpos_#postfix#(nqp::decont(SELF),$pos)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Callable:D $pos
) is raw {
    nqp::istype((my $got := $pos.POSITIONS(SELF)),Int)
      ?? nqp::islt_i($got,0)
        ?? X::OutOfRange.new(:what<Index>, :$got, :range<0..^Inf>).throw
        !! nqp::atposref_#postfix#(nqp::decont(SELF),$got)
      !! postcircumfix:<[ ]>(SELF, $got)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Iterable:D $pos is rw
) is raw {
    nqp::islt_i((my int $got = $pos.Int),0)
      ?? X::OutOfRange.new(:what<Index>, :$got, :range<0..^Inf>).throw
      !! nqp::atposref_#postfix#(nqp::decont(SELF),$got)
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Iterable:D $pos
) is raw {
    my $self    := nqp::decont(SELF);
    my $indices := $pos.iterator;
    my #type# @result;

    nqp::until(
      nqp::eqaddr((my $pulled := $indices.pull-one),IterationEnd),
      nqp::if(
        nqp::istype(
          (my $got = nqp::if(
            nqp::istype($pulled,Callable),
            $pulled.POSITIONS($self),
            $pulled
          )),
          Int
        ) && nqp::isge_i($got,0),
        nqp::push_#postfix_push#(@result,nqp::atpos_#postfix#($self,$got)),
        nqp::if(
          nqp::istype($got,Int),
          X::OutOfRange.new(:what<Index>, :$got, :range<0..^Inf>).throw,
          (die "Cannot handle {$got.raku} as an index in an Iterable when slicing a native #type# array".naive-word-wrapper)
        )
      )
    );

    @result
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Iterable:D $pos, array::#type#array:D $values
) is raw {
    my $self    := nqp::decont(SELF);
    my $indices := $pos.iterator;
    my int $i    = -1;
    my #type# @result;

    nqp::until(
      nqp::eqaddr((my $pulled := $indices.pull-one),IterationEnd),
      nqp::if(
        nqp::istype(
          (my $got = nqp::if(
            nqp::istype($pulled,Callable),
            $pulled.POSITIONS($self),
            $pulled
          )),
          Int
        ) && nqp::isge_i($got,0),
        nqp::push_#postfix_push#(
          @result,
          nqp::bindpos_#postfix#($self,$got,nqp::atpos_#postfix#($values,++$i))
        ),
        nqp::if(
          nqp::istype($got,Int),
          X::OutOfRange.new(:what<Index>, :$got, :range<0..^Inf>).throw,
          (die "Cannot handle {$got.raku} as an index in an Iterable when assigning to a native #type# array slice".naive-word-wrapper)
        )
      )
    );

    @result
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Iterable:D $pos, \values
) is raw {
    my $self    := nqp::decont(SELF);
    my $indices := $pos.iterator;
    my $values  := Rakudo::Iterator.TailWith(values.iterator,#nullval#);
    my #type# @result;

    nqp::until(
      nqp::eqaddr((my $pulled := $indices.pull-one),IterationEnd),
      nqp::if(
        nqp::istype(
          (my $got = nqp::if(
            nqp::istype($pulled,Callable),
            $pulled.POSITIONS($self),
            $pulled
          )),
          Int
        ) && nqp::isge_i($got,0),
        nqp::push_#postfix_push#(
          @result,
          nqp::bindpos_#postfix#(
            $self,
            $got,
            $values.pull-one.#Type#
          )
        ),
        nqp::if(
          nqp::istype($got,Int),
          X::OutOfRange.new(:what<Index>, :$got, :range<0..^Inf>).throw,
          (die "Cannot handle {$got.raku} as an index in an Iterable when assigning to a native #type# array slice".naive-word-wrapper)
        )
      )
    );

    @result
}

multi sub postcircumfix:<[ ]>(
  array::#type#array:D \SELF, Whatever
) {
    nqp::decont(SELF)
}

multi sub infix:<cmp>(array::#type#array:D \a, array::#type#array:D \b) {
    my int $elems-a = nqp::elems(a);
    my int $elems-b = nqp::elems(b);
    my int $elems   = nqp::islt_i($elems-a,$elems-b) ?? $elems-a !! $elems-b;

    my int $i = -1;
    nqp::until(
      nqp::isge_i(++$i,$elems)
        || (my $res = nqp::cmp_#postfix_cmp#(nqp::atpos_#postfix#(a,$i),nqp::atpos_#postfix#(b,$i))),
      nqp::null
    );
    ORDER($res || nqp::cmp_i($elems-a,$elems-b))
}

SOURCE

    # we're done for this role
    say "#- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE";
    say $end ~ $type ~ "array ---------------------------------";
}

# close the file properly
$*OUT.close;

# vim: expandtab sw=4