use strict;
use warnings;

use Perl6::MetaModel;

use PIL::Run::Container::Scalar;

sub mk_containers {
    map {
        my $c = PIL::Run::Container::Scalar->new;
        $c->scalar_store($_);
        $c;
    } @_;
}

role 'IArray' => {};

class 'PIL::Run::Container::Array' => {
    does => [ 'IArray' ],
    instance => {
        attrs => [ '@:slots' ],
        BUILD => sub {
            my $self = shift;
            $self->set_value('@:slots', []);
        },        
        methods => {
            'array_fetch' => sub { # evaluated in rvalue contexxt
                my $self = shift;
                @{$self->get_value('@:slots')}
            },

            'array_store' => sub { # evaluated in lvalue context as a list
                my $self = shift;
                my $repl = shift;
                @{$self->get_value('@:slots')} = @$repl;
            },

            'array_fetchKeys' => sub { # returns list of indices
                my $self = shift;
                0 .. $#{$self->get_value('@:slots')};
            },

            'array_fetchElem' => sub { # $idx -> $container # autovivification! - returns **CONTAINER**
                my $self = shift;
                my $idx = shift;
                $self->get_value('@:slots')->[$idx]; # type == Container::Scalar
            },
            
            'array_storeElem' => sub { # $idx -> $container -> ()
                my $self = shift;
                my $idx = shift;
                my $container = shift;
                $self->_extend_to_slot($idx);
                $self->get_value('@:slots')->[$idx] = $container;
            },

            'array_fetchVal' => sub { # $idx -> $value
                my $self = shift;
                my $idx = shift;
                $self->array_fetchElem($idx)->scalar_fetch;
            },
     
            'array_storeVal' => sub { # $idx -> $value -> ()
                my $self = shift;
                my $idx = shift;
                my $value = shift;
                $self->_extend_to_slot($idx);
                $self->array_fetchElem($idx)->scalar_store($value);
            },

            'array_fetchSize' => sub { # $int
                my $self = shift;
                my $idx = shift;
                my $value = shift;
                scalar @{$self->get_value('@:slots')};
            },

            'array_storeSize' => sub { # $int -> ()
                my $self = shift;
                my $size = shift;
                if ($size > (my $orig = $self->array_fetchSize)){
                    $self->array_extendSize($size - $orig);
                } else {
                    $#{$self->get_value('@:slots')} = ($size - 1);
                }
            },

            'array_extendSize' => sub { # $int -> () # +=?
                my $self = shift;
                my $size = shift;
                push @{$self->get_value('@:slots')}, mk_containers((undef) x ($size));
            },

            '_extend_to_slot' => sub {
                my $self = shift;
                my $idx = shift;
                my $size = $idx + 1;
                if ($self->array_fetchSize < $size){
                    $self->array_storeSize($size);
                }
            },

            'array_deleteElem' => sub { # $int -> (); # undef $array[$idx];
                my $self = shift;
                my $idx = shift;
                undef $self->get_value('@:slots')->[$idx];
            },

            'array_existsElem' => sub { # $int -> $bool;
                my $self = shift;
                my $idx = shift;
                exists $self->get_value('@:slots')->[$idx];
            },

            'array_clear' => sub {
                my $self = shift;
                @{$self->get_value('@:slots')} = (); # just ref = []?
            },

            'array_push' => sub { # @values -> ()
                my $self = shift;
                my $values = shift;
                push @{$self->get_value('@:slots')}, mk_containers(@$values);
            },

            'array_unshift' => sub { # @values -> ()
                my $self = shift;
                my $values = shift;
                unshift @{$self->get_value('@:slots')}, mk_containers(@$values);
            },

            'array_pop' => sub { # $val
                my $self = shift;
                (pop @{$self->get_value('@:slots')})->scalar_fetch;
            },

            'array_shift' => sub { # $val
                my $self = shift;
                (shift @{$self->get_value('@:slots')})->scalar_fetch;
            },

            'array_splice' => sub { # $idx_from -> $idx_to -> @replace_list -> @list
                my $self = shift;
                my $idx_from = shift;
                my $idx_to = shift;
                my $replacement =     shift;
                map { $_->scalar_fetch } splice(@{$self->get_value('@:slots')}, $idx_from, $idx_to, mk_containers(@$replacement));
            },
        },
    },
};

1;