# --------------------------------------------------------------------------- #
# List Container
# --------------------------------------------------------------------------- #

^List := ^Class.new({});

^List.set_name('List');
^List.set_version('0.0.1');
^List.set_authority('url:pugscode.org');

^List.set_superclasses([ ^Object ]);

^List.add_attribute('@!list', []);

^List.add_method('FETCH',      -> $i { self`get_attr('@!list')`fetch($i) });
^List.add_method('FETCH_LIST', ->    { self`get_attr('@!list')           });

# NOTE: 
# I am cheating below, since i know that %params 
# can easily have a @list in it (they are only names)
# however, this might be a problem later on.
# Ideally I would also override new, bless and maybe CREATE too
# I think the new (as yet unimplemented) approach (ala the new S12) 
# might fix this though.

^List.add_method('BUILDALL', -> %params { self.BUILD(%params) });
^List.add_method('BUILD',    -> %params {
    self`set_attr('@!list', %params);
});

# --------------------------------------------------------------------------- #
# List Role
# --------------------------------------------------------------------------- #

^rList := ^Role.new({});

^rList.set_name('List');
^rList.set_version('0.0.1');
^rList.set_authority('url:pugscode.org');

^rList.add_method('elems', -> { 
    self.FETCH_LIST()`length() 
});

^rList.add_method('join', -> $sep {
    -> @elems, $acc {
        &redo := &?SUB;
        @elems`is_empty()`if_else(
            -> { $acc },
            -> { 
                &redo`(
                    @elems`splice(1), 
                    @elems`length()`eq(1)`if_else(
                        -> { $acc`concat(@elems`fetch(0)`as_str()) },
                        -> { $acc`concat(@elems`fetch(0)`as_str())`concat($sep`as_str()) }
                    )
                );
            }
        );
    }`(self.FETCH_LIST(), '');
});

^rList.add_method('map', -> &func {
    $?CLASS.new(
        -> $elem {
            &func`($elem)
        }`do_for(self.FETCH_LIST())
    );
});

^rList.add_method('grep', -> &func {
    -> @list, @acc {
        &redo := &?SUB;
        @list`is_empty()`if_else(
            -> { $?CLASS.new(@acc) },
            -> {
                $elem := @list`fetch(0);
                &func`($elem)`as_bit()`if_else(
                    -> { &redo`(@list`splice(1), @acc`push($elem)) },
                    -> { &redo`(@list`splice(1), @acc)             }            
                );
            }
        );
    }`(self.FETCH_LIST(), []);
});

^rList.add_method('reverse', -> {
    $?CLASS.new(self.FETCH_LIST()`reverse());
});

^rList.add_method('reduce', -> &func {
    -> @list, $acc {
        &redo := &?SUB;
        @list`is_empty()`if_else(
            -> { $acc },
            -> { &redo`(@list`splice(1), &func`($acc, @list`fetch(0))) }
        );        
    }`(self.FETCH_LIST()`splice(1), self.FETCH(0));
});

^rList.add_method('zip', -> @values {
    -> @l, @r, @acc {
        &redo := &?SUB;
        @l`is_empty()`if_else(
            -> { $?CLASS.new(@acc) },
            -> { &redo`(@l`splice(1), @r`splice(1), @acc`concat([ @l`fetch(0), @r`fetch(0) ])) }
        );
    }`(self.FETCH_LIST(), @values.FETCH_LIST(), []);
});

# bottom up merge sort
^rList.add_method('sort', -> {
    self.elems()`le(1)`if_else(
        -> { self },
        -> {         
            &compare := -> $a, $b { 
                $a`eq($b)`if_else(
                    -> { 0 }, 
                    -> { 
                        $a`lt($b)`if_else(
                            -> { -1 }, 
                            -> { 1 }
                        );
                    }
                ); 
            };

            &split := -> @lst, @acc { 
                &redo := &?SUB;            
                @lst`length()`eq(0)`if_else(
                    -> { @acc },
                    -> { &redo`(@lst`splice(1), @acc`push([ @lst`fetch(0) ])) } 
                ); 
            };   

            &merge := -> @l1, @l2 { 
                &redo := &?SUB;
                @l1`is_nil()`if_else(
                    -> { @l2 },
                    -> {
                        @l1`is_empty()`if_else(
                            -> { @l2 },
                            -> { 
                                @l2`is_nil()`if_else(
                                    -> { @l1 },
                                    -> {
                                        @l2`is_empty()`if_else(
                                            -> { @l1 },
                                            -> { 
                                                $hl1 := @l1`fetch(0);
                                                $hl2 := @l2`fetch(0);
                                                &compare`($hl1, $hl2)`lt(0)`if_else(
                                                    ->{ 
                                                        [ $hl1 ]`concat( &redo`( @l1`splice(1), @l2 ) ) 
                                                    },
                                                    ->{ 
                                                        [ $hl2 ]`concat( &redo`( @l1, @l2`splice(1) ) ) 
                                                    }
                                                ); 
                                            } 
                                        );
                                    }
                                ); 
                            } 
                        );
                    }
                ); 
            };                           

            &mergepairs := -> @lst { 
                &redo := &?SUB;
                @lst`length()`le(1)`if_else(
                    -> { @lst`fetch(0) },
                    -> { 
                        &merge`(
                            &merge`(@lst`fetch(0), @lst`fetch(1)), 
                            &redo`(@lst`splice(2))
                        );
                    } 
                );
            };           

            &mergesort := -> @lst { 
                &redo := &?SUB;            
                @lst`length()`eq(1)`if_else(
                    -> { @lst`fetch(0) },
                    -> { &mergepairs`(@lst) } 
                ) 
            };

            $?CLASS.new(&mergesort`(&split`(self.FETCH_LIST(), [])));
        }
    );
});

^rList.add_method('pop', -> {
    self.FETCH(self.elems()`decrement());
});

^rList.add_method('push', -> $elem {
    $?CLASS.new(self.FETCH_LIST()`concat([ $elem ]));
});

^rList.add_method('shift', -> {
    self.FETCH(0);
});

^rList.add_method('unshift', -> $elem {
    $?CLASS.new([ $elem ]`concat(self.FETCH_LIST()));
});

# --------------------------------------------------------------------------- #
# Bootstrap List Container to List Role
# --------------------------------------------------------------------------- #

^List.set_roles([ ^rList ]);
^List.resolve();
