The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# --------------------------------------------------------------------------- #
# Array Container
# --------------------------------------------------------------------------- #

^Array := ^Class.new({});
^Array.set_name('Array');
^Array.set_version('0.0.1');
^Array.set_authority('url:pugscode.org');

^Array.set_superclasses([ ^List ]);

^Array.add_method('new',      -> %params { 
    "inside Array.new ..."`trace();
    ^Array`create('p6array', %params) 
});
^Array.add_method('BUILDALL', -> %params { 
    "inside Array.BUILDALL ..."`trace();
    nil 
});
^Array.add_method('BUILD',    -> %params { 
    "inside Array.BUILD ..."`trace();
    nil 
});

^Array.add_method('FETCH',  -> $i     { self`fetch_elem($i)           } );
^Array.add_method('STORE',  -> $i, $x { self`store_elem($i, $x); self } );
^Array.add_method('FETCH_LIST', ->    { self`fetch_list()             } );
^Array.add_method('STORE_LIST', -> @x { self`store_list(@x); self     } );

# override the immutable List.reverse
# with this mutable version
^Array.add_method('reverse', -> {
    self.STORE_LIST(self.FETCH_LIST()`reverse());
});

# --------------------------------------------------------------------------- #
# Array Role
# --------------------------------------------------------------------------- #

^rArray := ^Role.new({});
^rArray.set_name('Array');
^rArray.set_version('0.0.1');
^rArray.set_authority('url:pugscode.org');

^rArray.add_method('pop', -> {
    $elem := self.FETCH(self.elems()`decrement());
    # this is a ugly kludge for now :-/
    self.STORE_LIST(self.FETCH_LIST()`reverse()`splice(1)`reverse()); 
    $elem;
});

^rArray.add_method('push', -> $elem {
    self.STORE_LIST(self.FETCH_LIST()`concat([ $elem ]));
});

^rArray.add_method('shift', -> {
    $elem := self.FETCH(0);
    self.STORE_LIST(self.FETCH_LIST()`splice(1));
    $elem;
});

^rArray.add_method('unshift', -> $elem {
    self.STORE_LIST([ $elem ]`concat(self.FETCH_LIST()));
});

^rArray.add_method('delete', -> @indices {});
^rArray.add_method('exists', -> @indices {});
^rArray.add_method('splice', -> $offset, $length, @values {});

^rArray.add_method('keys', -> {
    -> @list, @acc {
        &redo := &?SUB;
        @list`is_empty()`if_else(
            -> { $?CLASS`create('p6array', @acc) },
            -> { &redo`(@list`splice(1), @acc`push(@acc`length())) }
        );
    }`(self.FETCH_LIST(), []);
});

^rArray.add_method('values', -> { self });

^rArray.add_method('pairs', -> {
    -> @list, @acc {
        &redo := &?SUB;
        @list`is_empty()`if_else(
            -> { $?CLASS`create('p6array', @acc) },
            -> { 
                &redo`(
                    @list`splice(1), 
                    @acc`push(^Pair.new({ 
                        'k' => @acc`length(), 
                        'v' => @list`fetch(0) 
                    }))
                ) 
            }
        );
    }`(self.FETCH_LIST(), []);
});

^rArray.add_method('kv', -> {
    -> @list, @acc {
        &redo := &?SUB;
        @list`is_empty()`if_else(
            -> { $?CLASS`create('p6array', @acc) },
            -> { 
                &redo`(
                    @list`splice(1), 
                    @acc`push(^Array`create('p6array', [ 
                        @acc`length(), 
                        @list`fetch(0) 
                    ]))
                ) 
            }
        );
    }`(self.FETCH_LIST(), []);
});

# --------------------------------------------------------------------------- #
# Bootstrap Array Container to Array Role
# --------------------------------------------------------------------------- #

^Array.set_roles([ ^rArray ]);
^Array.resolve();