#!/usr/bin/env raku

# This script reads the native_array.rakumod file, and generates the intarray,
# numarray and strarray roles in it, 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 generated part of Buf ';
my $idpos     = $start.chars;
my $idchars   = 3;
my $end       = '#- end of generated part of Buf ';

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

my %type_mapper = (
  Signed => ( :name<SignedBuf>,
              :postfix<i>,
            ).Map,
  Unsigned => ( :name<UnsignedBuf>,
                :postfix<u>,
              ).Map,
);


# 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;
    }

    my $type = $line.substr($idpos).words.head;

    # found header, check validity and set up mapper
    die "Don't know how to handle $type"
      unless my %mapper := %type_mapper{$type};

    say $start ~ $type ~ " role --------------------------------";
    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 role
    say Q:to/SOURCE/.subst(/ '#' (\w+) '#' /, -> $/ { %mapper{$0} }, :g).chomp;

    my role #name#[::T] is repr('VMArray') is array_type(T) is implementation-detail {
        multi method AT-POS(::?ROLE:D: uint $pos) is raw is default {
            nqp::atposref_#postfix#(self,$pos)
        }
        multi method AT-POS(::?ROLE:D: Int:D $pos) is raw is default {
            nqp::islt_i($pos,0)
              ?? self!fail-range($pos)
              !! nqp::atposref_#postfix#(self,$pos)
        }

        multi method ASSIGN-POS(::?ROLE:D: uint $pos, Mu \assignee) {
            nqp::bindpos_#postfix#(self,$pos,assignee)
        }
        multi method ASSIGN-POS(::?ROLE:D: Int:D $pos, Mu \assignee) {
            nqp::islt_i($pos,0)
              ?? self!fail-range($pos)
              !! nqp::bindpos_#postfix#(self,$pos,assignee)
        }

        multi method list(::?ROLE:D:) is default {
            my int $elems = nqp::elems(self);

            # presize memory, but keep it empty, so we can just push
            my $buffer := nqp::setelems(
              nqp::setelems(nqp::create(IterationBuffer),$elems),
              0
            );

            my int $i = -1;
            nqp::while(
              nqp::islt_i(++$i,$elems),
              nqp::push($buffer,nqp::atposref_#postfix#(self,$i))
            );
            $buffer.List
        }

        method write-ubits(::?ROLE \SELF:
          int $pos, Int:D $bits, UInt:D \value
        ) is raw {

            # sanity check
            POS-OOR(SELF, $pos) if $pos < 0;
            my $self := nqp::isconcrete(self) ?? self !! nqp::create(self);

            # set up basic info
            my int $first-bit = $pos +& 7;
            my int $last-bit  = ($pos + $bits) +& 7;
            my int $first-byte = $pos +> 3;
            my int $last-byte  = ($pos + $bits - 1) +> 3;

            my $value := value +& (1 +< $bits - 1);            # mask valid part
            $value := $value +< (8 - $last-bit) if $last-bit;  # move into position

            my int $lmask = nqp::sub_i(1 +< $first-bit,1) +< (8 - $first-bit)
              if $first-bit;
            my int $rmask = 1 +< nqp::sub_i(8 - $last-bit,1)
              if $last-bit;

            # all done in a single byte
            if $first-byte == $last-byte {
                nqp::bindpos_#postfix#($self,$first-byte,
                  $value +| (nqp::atpos_#postfix#($self,$first-byte) +& ($lmask +| $rmask))
                );
            }

            # spread over multiple bytes
            else {
                my int $i = $last-byte;

                # process last byte first if it is a partial
                if $last-bit {
                    nqp::bindpos_#postfix#($self,$i,
                      ($value +& 255) +| (nqp::atpos_#postfix#($self,$i) +& $rmask)
                    );
                    $value := $value +> 8;
                }

                # not a partial, so make sure we process last byte later
                else {
                    ++$i;
                }

                # walk from right to left, exclude left-most is partial
                my int $last = $first-byte + nqp::isgt_i($first-bit,0);
                nqp::while(
                  nqp::isge_i(--$i,$last),
                  nqp::stmts(
                    nqp::bindpos_#postfix#($self,$i,($value +& 255)),
                    ($value := $value +> 8)
                  )
                );

                # process last byte if it was a partial
                nqp::bindpos_#postfix#($self,$i,($value +& 255)
                  +| (nqp::atpos_#postfix#($self,$i) +& $lmask))
                  if $first-bit;
            }

            $self
        }
    }
SOURCE

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

# close the file properly
$*OUT.close;

# vim: expandtab sw=4