spl/std.spl

def null
func =null { | pop
    "`null` must not be assigned a value!" panic
}

def program-name

func println { |
    print "\n" print
}

construct error {
    kind
    message
    object
    trace
    mr-trace
}

construct FrameInfo {
    file
    function
}

construct _str_ext {
    ;
    new { any | with this ;
        null clone this settype:construct
    }
    to-bytes { [int] | str-to-bytes }
    split { str | with splitter this ;
        def bytes splitter:to-bytes =bytes
        def iter this:to-bytes:iter =iter
        def item 0 =item
        [ while { item null eq not } {
            def match 0 =match
            [
                while { match bytes:len eq not } {
                    iter:next =item
                    item null eq if {
                        3 stop
                    }
                    item dup (match bytes:get) eq dup if {
                        match ++ =match
                    } not if {
                        0 =match
                    }
                } 
                { | pop pop } match:foreach
            ] _str
        } ]
    }
} include _str_ext in str

construct _mega-ext {
    ;
    swap { .. | with this ;
        this mswap
        this -- mswap
    }
    mswap { .. | mswap }
    foreach { | with callable this ;
        def i 0 =i
        while { i this lt } { i callable call i ++ =i }
    }
} include _mega-ext in mega

construct _array-ext {
    ;
    get { any | array-get }
    sget { any|null | with idx this ;
        idx this:len lt idx -1 gt and dup if {
            pop
            idx this:get 
            2 stop
        } not if {
            null
        }
    }
    len { mega | array-len }
    set { any | array-set }
    to-stack { .. | with this ;
        def len this:len =len
        def i 0 =i
        while { i len lt } {
            i this:get
            i ++ =i
        }
    }
    foreach { | with callable this ; 
        def i 0 =i
        while { i this:len lt } { i this:get callable call i ++ =i }
    }
    to-str { str | bytes-to-str }
    sub { [any] | with begin end this ;
        this (end begin - anew) begin 0 (end begin -) acopy
    }
    0 { any | with this ;
        0 this:get
    }
    1 { any | with this ;
        1 this:get
    }
    2 { any | with this ;
        2 this:get
    }
    3 { any | with this ;
        3 this:get
    }
    4 { any | with this ;
        4 this:get
    }
} include _array-ext in array

"#iter.spl" import

construct List {
    array
    ;
    construct { this | with this ; 
        0 anew this:=array
        this
    }
    from { this | with array this ;
        array this:=array
        this
    }
    foreach { | :array:foreach }
    get { any | :array:get }
    sget { any|null | :array:sget }
    len { mega | :array:len }
    set { any | :array:set }
    to-stack { .. | :array:to-stack }
    to-str { str | :array:to-str }
    sub { [any] | :array:sub }
}
construct _GrowingArray {
    ;
    push-front { | with item this ;
        [ item this:array:to-stack ] this:=array
    }
    push { | with item this ;
        [ this:array:to-stack item ] this:=array
    }
    insert { | with item index this ;
        this:array:len index - =index
        [ this:array:to-stack index:mswap item (index ++):mswap ] this:=array
    }
}
construct _ShrinkingArray {
    ;
    pop-front { any | with this ;
        0 this:remove
    }
    pop { any | with this ; 
        this:array:len not if {
            null 2 stop
        }
        def item
        [ this:array:to-stack =item ] this:=array
        item
    }
    remove { any | with index this ;
        this:array:len not if {
            null 2 stop
        }
        def item
        this:array:len index - =index
        [ this:array:to-stack index:mswap =item (index --):mswap ] this:=array
        item
    }
}

include _GrowingArray in List
include _ShrinkingArray in List

construct ArrayIter {
    array
    idx
    ;
    construct { this | with array this ;
        array this:=array
        0 this:=idx
        this
    }
    next { any | with this ; 
        this:idx dup ++ this:=idx this:array:sget
    }
}
construct _IterableArray {
    ;
    iter { ArrayIter | with this ;
        this gettype "array" eq dup if {
            pop
            this ArrayIter:new
            2 stop
        } not if {
            this:array ArrayIter:new
        }
    }
}
include _Iter in ArrayIter
include _IterableArray in List
include _IterableArray in array

construct MicroMap {
    pairs
    ;
    construct { this | with this ;
        List:new this:=pairs
        this
    }
    from { this | with pairs this ;
        pairs this:=pairs
        this
    }
    get-entry { [any,any]|null | with key this ;
        this:pairs:iter
            { mega | 0 swap:get key eq } swap:filter
            :next
    }
    get-or-create-entry { [any,any] | with key this ;
        { [any,any] | 
            [ key null ] dup this:pairs:push
        } key this:get-entry:unwrap-or
    }
    get { any | with key this ;
        this:pairs:iter
            { mega | 0 swap:get key eq } swap:filter
            { any | 1 swap:get } swap:map
            :next
    }
    set { any | with key val this ;
        val 1 (key this:get-or-create-entry):set
    }
    remove { any | with key this ;
        this:pairs:iter
            { mega | 0 swap:get key eq not } swap:filter
            :collect
            List:new:from
            =pairs
    }
    iter { ArrayIter | with this ;
        this:pairs:iter
    }
    foreach { | with callable this ;
        callable this:pairs:foreach
    }
}

construct Range {
    lower 
    upper 
    step
    ;
    construct { this | with lower upper this ;
        lower _mega this:=lower
        upper _mega this:=upper
        1 this:=step
        this
    }
    set-step { this | with step this ; 
        step this:=step
        this
    }
    iter { RangeIter | with this ;
        this RangeIter:new
    }
    item { mega|null | with index this ;
        def itm index this:step * this:lower + =itm
        (itm this:upper lt) (itm this:lower lt not) and dup if {
            pop
            itm
            2 stop
        } not if {
            null
            2 stop
        }
    }
}

construct RangeIter {
    range
    idx
    ;
    construct { this | with range this ;
        range this:=range
        0 this:=idx
        this
    }
    next { mega | with this ;
        this:idx dup ++ this:=idx this:range:item
    }
}

include _Iter in RangeIter

construct shadow { }

func aadd { array | with arr1 arr2 ;

    def newarr arr1:len arr2:len + anew =newarr

    arr1 newarr 0 0        arr1:len acopy;
    arr2 newarr 0 arr1:len arr2:len acopy;

    newarr
}

func concat { str | with a b ;
    a _array b _array aadd _str
}

func nconcat { str | with amt ;
    _array
    (amt 1 -):foreach <{ { | pop
        swap _array swap aadd
    } }
    _str
}

def cached-results MicroMap:new =cached-results
func cache { ... | with arg-amt id body ;
    def args arg-amt anew =args
    def i arg-amt -- =i
    while { i 0 lt not } {
        "from stack"; i args:set;
        i -- =i
    }
    def result [ args id ] cached-results:get =result
    result null eq if {
        args:to-stack body call dup =result [ args id ] swap cached-results:set;
    }
    result
}

func handle-panic { | with msg trace ;
    program-name dup if {
        program-name print " panicked at:" println
    } not if {
        "Program panicked at:" println
    }
    &println trace:foreach 
    "\nPanic message:" println
    "    " print msg println
    def map env =map
    "SPL_PANIC_DUMP" env:get dup if {
        "Dumping because SPL_PANIC_DUMP is set." println
        null =map
        dyn-__dump
    } not if {
        "SPL_PLAIN_PANIC" map:get dup if {
            "Not dumping because SPL_PLAIN_PANIC is set." println
        } not if {
            "Type 'Yes^M' to dump. You can set SPL_PANIC_DUMP to always dump "
            "on panic, or SPL_PLAIN_PANIC to never dump." concat println
            readln "Yes" eq if {
                null =map
                dyn-__dump
            }
        }
    }
    "Exiting." println
    1 exit
}

func panic { | trace handle-panic }

{ | with msg this ;
    this not if {
        "Assertion failed!" panic
    }
} "assert" "int" dyn-def-method

{ | with msg this ;
    this if {
        "Assertion failed!" panic
    }
} "nassert" "int" dyn-def-method

func assert-eq { any any | with a b ;
    a b eq not if {
        "Equality assertion failed!" panic
    }
    a b
}

func [ { shadow |
    "array" "shadow" settype
}

func ] { array |
    [ alit-end
}

func env { MicroMap |
    get-env List:new:from MicroMap:new:from
}

func ++ { mega |
    1 +
}

func -- { mega |
    1 -
}

def _'has-been-called 0 =_'has-been-called
func _ { | 
    _'has-been-called not if {
        "WARN: The _ function is deprecated!" println
        1 =_'has-been-called
    }
}

func call-main-on-file { | with file ;
    catch {
        "@" file concat import 
        update-types
        argv main exit
    }
    with { with err ;
        err:message dup null eq if {
            pop
            "Uncaught error."
        } err:trace handle-panic
    }
}

func update-types { | 
    { | with type ;
        { self | } "unwrap" type dyn-def-method
        { self | swap pop } "unwrap-or" type dyn-def-method
    } dyn-all-types:foreach
    { | with this ;
        "null cannot be unwrapped." panic
    } "unwrap" "null" dyn-def-method
    { any | with fb this ;
        fb call
    } "unwrap-or" "null" dyn-def-method
}
update-types