stdlib.sts

# this file is released into the public domain

# This is the STS standard library. It is written in STS
# instead of C to keep the source of the interpreter
# smaller than it would be if this were entirely C.

# The following implements hashmaps, string management,
# file parsing, and other uncategorized utility functions.


# stdlib globals ========================


global stdlib-current-error ""

# sts type globals (are functions to make constant)
function STS_EXTERNAL {copy 0}
function STS_NIL {copy 1}
function STS_NUMBER {copy 2}
function STS_STRING {copy 3}
function STS_ARRAY {copy 4}
function STS_FUNCTION {copy 5}
function STS_BOOLEAN {copy 6}

# (incorrect, but unfortunately stuck) hashmap implementation ================
# hashmap structure:
#   [array
#       [array *hash* *key string* *value*]
#       [array *hash* *key string* *value*]
#       ...
#   ]

function hashmap {
    local ret $nil
    local row $nil
    local break 0
    local i 0

    # TODO: possibly insert at 0 so its 3 less function calls

    if(! (sizeof $...)) {
        set $ret [array]
    }
    elseif(% (sizeof $...) 2) {
        stdlib-set-error hashmap "arguments provided were not an even number"
    }
    else {
        set $ret [array]

        loop(&& [< $i (sizeof $...)] [! $break]) {
            if(!= (typeof [get $... $i]) (STS_STRING)) {
                stdlib-set-error hashmap "keys need to be strings"
                set $ret $nil
                ++ $break
            }
            else {
                set $row [array (string-hash [get $... $i]) (get $... $i) (get $... (+ $i 1))]

                # theres a quirk with the language that results in just inserting the literal
                # row value itself. This makes all rows the extact same and just duplicates forever.
                # The solution is to just create space in the array and set the new space to
                # the new row. The set action shallow copies the value so the array itself is
                # duplicated but all row values are just references to the originals passed.
                # The most important part is initializing the space with anything that is generated
                # rather than part of the ast (so literals will NOT work). $nil is special because
                # the eval function creates a new nil value every time it is used. This makes it
                # perfect for this.

                insert $ret (sizeof $ret) $nil
                set (get $ret [- (sizeof $ret) 1]) $row


                # unfortunately, this will not work

                # insert $ret (sizeof $ret) $row
            }

            += $i 2
        }
    }

    pass $ret
}

function hashmap-get map key {
    local ret $nil
    local hash $nil
    local break 0
    local i 0

    if(&& [!= (typeof $map) (STS_ARRAY)] [!= (typeof $key) (STS_STRING)]) {
        stdlib-set-error hashmap "the map arg must be an array and the key must be a string"
    }
    else {
        set $hash (string-hash $key)

        loop(&& [< $i (sizeof $map)] [! $break]) {
            if(== $hash [get [get $map $i] 0]) {
                set $ret [get [get $map $i] 2]
                ++ $break
            }

            ++ $i
        }
    }

    if(== $ret $nil) {
        stdlib-set-error hashmap "could not find value for key provided"
    }

    pass $ret
}

function hashmap-exists map key {
    local ret 1


    if(&& [== [hashmap-get $map $key] $nil] [== (stdlib-get-error) "hashmap: could not find value for key provided"]) {
        set $ret 0
    }

    pass $ret
}

# hashmap-set returns 0 if the key already existed and 1 if a new one had to be created
function hashmap-set map key value {
    local ret $nil
    local row $nil
    local hash $nil
    local break 0
    local i 0

    if(&& [!= (typeof $map) (STS_ARRAY)] [!= (typeof $key) (STS_STRING)]) {
        stdlib-set-error hashmap "the map arg must be an array and the key must be a string"
    }
    else {
        set $hash (string-hash $key)

        loop(&& [< $i (sizeof $map)] [! $break]) {
            if(== $hash [get [get $map $i] 0]) {
                set [get [get $map $i] 2] $value
                set $ret 0
                ++ $break
            }

            ++ $i
        }
    }

    # add new key instead
    if(== $ret $nil) {
        set $row [array (string-hash $key) $key $value]

        insert $map (sizeof $map) $nil
        set (get $map [- (sizeof $map) 1]) $row

        set $ret 1
    }

    pass $ret
}

# hashmap-replace returns 0 if the key already existed and 1 if a new one had to be created
function hashmap-replace map key value {
    local ret $nil
    local row $nil
    local hash $nil
    local break 0
    local i 0

    if(&& [!= (typeof $map) (STS_ARRAY)] [!= (typeof $key) (STS_STRING)]) {
        stdlib-set-error hashmap "the map arg must be an array and the key must be a string"
    }
    else {
        set $hash (string-hash $key)

        loop(&& [< $i (sizeof $map)] [! $break]) {
            if(== $hash [get [get $map $i] 0]) {
                # set [get [get $map $i] 2] $value
                replace (get $map $i) 2 $value
                set $ret 0
                ++ $break
            }

            ++ $i
        }
    }

    # add new key instead
    if(== $ret $nil) {
        set $ret (hashmap-set $map $key $value)
    }

    pass $ret
}

function hashmap-remove map key {
    local ret 0
    local hash $nil
    local break 0
    local i 0

    if(&& [!= (typeof $map) (STS_ARRAY)] [!= (typeof $key) (STS_STRING)]) {
        stdlib-set-error hashmap "the map arg must be an array and the key must be a string"
    }
    else {
        set $hash (string-hash $key)

        loop(&& [< $i (sizeof $map)] [! $break]) {
            if(== $hash [get [get $map $i] 0]) {
                remove $map $i
                set $ret 1
                ++ $break
            }

            ++ $i
        }
    }

    pass $ret
}

function hashmap-keys map {
    local ret $nil
    local i 0


    if(!= (typeof $map) (STS_ARRAY)) {
        stdlib-set-error hashmap "the map arg must be an array"
    }
    else {
        set $ret [array]

        loop(< $i (sizeof $map)) {
            insert $ret (sizeof $ret) [get [get $map $i] 1]

            ++ $i
        }
    }

    pass $ret
}

function hashmap-values map {
    local ret $nil
    local i 0


    if(!= (typeof $map) (STS_ARRAY)) {
        stdlib-set-error hashmap "the map arg must be an array"
    }
    else {
        set $ret [array]

        loop(< $i (sizeof $map)) {
            insert $ret (sizeof $ret) [get [get $map $i] 2]

            ++ $i
        }
    }

    pass $ret
}

# because keys are passed by reference and stored in the row rather than
# copied into the row, the key could change at some point and thats mostly
# ok, but the string hash needs to be updated as well. Call this if theres
# a possibility that the keys updated in the hashmap
function hashmap-update map {
    local ret $nil
    local i 0


    if(!= $map (STS_ARRAY)) {
        stdlib-set-error hashmap "the map arg must be an array"
    }
    else {
        loop(< $i (sizeof $map)) {
            set [get [get $map $i] 0]   (string-hash [get [get $map $i] 1])

            ++ $i
        }
    }

    pass $ret
}


# string management =====================


function string-tokenize string token {
    local ret [array]
    local break 0
    local last 0
    local found 0
    local at 0


    loop(&& [<= (+ $last [sizeof $token]) (sizeof $string)] [! $break]) {
        set $at (string-search $string $token $last)

        if(!= $at -1) {
            ++ $found

            if(== $at 0) {
                insert $ret (sizeof $ret) (copy "")
            }
            else {
                if(== $last $at) {
                    insert $ret (sizeof $ret) (copy "")
                }
                else {
                    insert $ret (sizeof $ret) (string-range $string $last [- $at 1])
                }
            }

            set $last (+ $at [sizeof $token])
        }
        else {
            ++ $break
        }
    }
    if(! $found) {
        insert $ret (sizeof $ret) (copy $string)
    }
    elseif(< $last [sizeof $string]) { # copy the remaining part of the string if there is any
        insert $ret (sizeof $ret) (string-range $string $last [- (sizeof $string) 1])
    }
    else {
        insert $ret (sizeof $ret) (copy "")
    }

    pass $ret
}

function string-combine array between_string {
    local ret $nil
    local i 1 # need to start after the first token


    if(== (sizeof $array) 1) {
        set $ret (copy [get $array 0])
    }
    elseif(== (sizeof $array) 2) {
        set $ret (string [get $array 0] $between_string [get $array 1])
    }
    else {
        set $ret (copy [get $array 0])

        #loop(< $i [- (sizeof $array) 1]) {
        loop(< $i (sizeof $array)) {

            set $ret (string $ret $between_string [get $array $i])

            ++ $i
        }

        # set $ret (string $ret $between_string ENDING_REPLACE)
    }

    pass $ret
}

function string-range string start end {
    local ret $nil
    local i 0


    if(&& [<= $start $end] [< $start (sizeof $string)] [< $end (sizeof $string)] [<= 0 $start] [<= 0 $end]) {
        set $i $start
        set $ret ""
        loop(<= $i $end) {
            set $ret (string $ret [get $string $i])

            ++ $i
        }
    }
    else {
        stdlib-set-error string "the range must be inside the bounds of the string length - 1"
    }

    pass $ret
}

# optionally takes one more argument for an offset from the start
function string-search string needle {
    local ret -1
    local break 0
    local i 0


    if(< (sizeof $string) (sizeof $needle)) {
        stdlib-set-error string "the needle must be as big or smaller than the source string"
        ++ $break
    }

    if(&& [== (sizeof $...) 1] [== (typeof (get $... 0)) (STS_NUMBER)] [< (get $... 0) (sizeof $string)]) {
        set $i (get $... 0)
    }

    loop(&& [< $i [- (sizeof $string) (sizeof $needle) -1]] [! $break]) {
        if(== (string-range $string $i (+ $i [- (sizeof $needle) 1])) $needle) {
            set $ret $i
            ++ $break
        }

        ++ $i
    }

    pass $ret
}

function string-rsearch string needle {
    local ret -1
    local break 0
    local i [- (sizeof $string) (sizeof $needle)]


    if(< (sizeof $string) (sizeof $needle)) {
        stdlib-set-error string "the needle must be as big or smaller than the source string"
        ++ $break
    }

    loop(&& [>= $i 0] [! $break]) {
        if(== (string-range $string $i (+ $i [- (sizeof $needle) 1])) $needle) {
            set $ret $i
            ++ $break
        }

        -- $i
    }

    pass $ret
}

function string-insert string position instring {
    local ret $nil


    if(>= $position 0) {
        if(>= $position (sizeof $string)) { # append
            set $ret (string $string $instring)
        }
        elseif(&& [< $position (sizeof $string)] [> $position 0]) { # insert at any point after 0
            set $ret (string [string-range $string 0 (- $position 1)] $instring [string-range $string $position (- [sizeof $string] 1)])
        }
        else { # insert at 0
            set $ret (string $instring $string)
        }
    }
    else {
        stdlib-set-error string "the position must be inside the string bounds"
    }

    pass $ret
}

function string-remove string position {
    local ret $nil


    if(&& [>= $position 0] [< $position (sizeof $string)]) {
        if(== (- [sizeof $string] 1) $position) { # pop off of the end
            set $ret (string-range $string 0 (- (sizeof $string) 2))
        }
        elseif(&& [< $position (sizeof $string)] [> $position 0]) { # remove at any point after 0
            set $ret [string (string-range $string 0 (- $position 1)) (string-range $string (+ $position 1) (- (sizeof $string) 1))]
        }
        else { # remove at 0
            set $ret (string-range $string 1 (- (sizeof $string) 1))
        }
    }
    else {
        stdlib-set-error string "the position must be inside the string bounds"
    }

    pass $ret
}

function string-replace string replacee replacement {
    local ret ""
    local break 0
    local last 0
    local replaced 0
    local at 0


    loop(&& [<= (+ $last [sizeof $replacee]) (sizeof $string)] [! $break]) {
        set $at (string-search $string $replacee $last)

        if(!= $at -1) {
            ++ $replaced

            if(== $at 0) {
                set $ret [string $ret $replacement]
            }
            else {
                if(== $last $at) {
                    set $ret [string $ret $replacement]
                }
                else {
                    set $ret [string $ret (string-range $string $last [- $at 1]) $replacement]
                }
            }

            set $last (+ $at [sizeof $replacee])
        }
        else {
            ++ $break
        }
    }
    if(! $replaced) {
        set $ret (copy $string)
    }
    elseif(< $last [sizeof $string]) { # copy the remaining part of the string if there is any
        set $ret [string $ret (string-range $string $last [- (sizeof $string) 1])]
    }

    pass $ret
}


# uncategorized =========================

function num2bin number {
    local ret (string "")
    local i 0
    local observe 0

    if(== [typeof $number] [STS_NUMBER]) {
        loop (< $i 4) {
            set $observe [& (>> $number [* $i 8]) 0xFF]
            set $ret (string $ret [asc $observe])
            ++ $i
        }
    }
    else {
        set $ret $nil
    }

    pass $ret
}

function getpwd self {
    local str $nil
    local pos 0


    set $pos (string-rsearch $self /)

    if(< 0 $pos) {
        set $str (string-range $self 0 $pos)
    }
    else {
        set $str [string ""]
    }

    pass $str
}

function relimport self script {
    pass (import [string (getpwd $self) $script])
}

function stdlib-get-error {
    local ret "no error"

    if(== (typeof $stdlib-current-error) (STS_STRING)) {
        set $ret (copy $stdlib-current-error)
    }

    # clear the error
    set $stdlib-current-error $nil
    
    pass $ret
}

function stdlib-set-error component_str error_str {
    set $stdlib-current-error (string $component_str ": " $error_str)
}

# returns a string of a recursively indexed value. Useful for debugging data structures
function string-value-print value {
    local ret $nil
    local i 0


    if(== (typeof $value) (STS_NIL)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string $value)}
    }
    elseif(== (typeof $value) (STS_FUNCTION)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string $value)}
    }
    elseif(== (typeof $value) (STS_EXTERNAL)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string $value)}
    }
    elseif(== (typeof $value) (STS_ARRAY)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string "[array (" (sizeof $value) " elements):")}
        
        loop(< $i (sizeof $value)) {
            set $ret (string $ret ", " [string-value-print (get $value $i)])
            ++ $i
        }

        set $ret (string $ret "]")
    }
    elseif(== (typeof $value) (STS_NUMBER)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string $value)}
    }
    elseif(== (typeof $value) (STS_STRING)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string "\"" $value "\"")}
    }
     elseif(== (typeof $value) (STS_BOOLEAN)) {
        if(!= (typeof $ret) (STS_STRING)) {set $ret (string $value)}
    }

    pass $ret
}

function typeof-string value {
    local ret $nil


    if(== (typeof $value) (STS_NIL)) {
        set $ret (copy "STS_NIL")
    }
    elseif(== (typeof $value) (STS_FUNCTION)) {
        set $ret (copy "STS_FUNCTION")
    }
    elseif(== (typeof $value) (STS_EXTERNAL)) {
        set $ret (copy "STS_EXTERNAL")
    }
    elseif(== (typeof $value) (STS_ARRAY)) {
        set $ret (copy "STS_ARRAY")
    }
    elseif(== (typeof $value) (STS_NUMBER)) {
        set $ret (copy "STS_NUMBER")
    }
    elseif(== (typeof $value) (STS_STRING)) {
        set $ret (copy "STS_STRING")
    }
    elseif(== (typeof $value) (STS_BOOLEAN)) {
        set $ret (copy "STS_BOOLEAN")
    }

    pass $ret
}

function expr { # turn arguments into an expression and evaluate it
    local $ret 0



    pass $ret
}

function enum {
    local i 0


    loop(< $i (sizeof $...)) {
        global (get $... $i) $i

        ++ $i
    }
}

function += lvalue rvalue {set $lvalue (+ $lvalue $rvalue); pass $lvalue} # because all arguments are passed by value, this passes the value and performs the operation on it
function -= lvalue rvalue {set $lvalue (- $lvalue $rvalue); pass $lvalue}
function *= lvalue rvalue {set $lvalue (* $lvalue $rvalue); pass $lvalue}
function /= lvalue rvalue {set $lvalue (/ $lvalue $rvalue); pass $lvalue}
function %= lvalue rvalue {set $lvalue (% $lvalue $rvalue); pass $lvalue}
function **= lvalue rvalue {set $lvalue (** $lvalue $rvalue); pass $lvalue}