Standard library

err · graph · io · mat · math · queue · search · sort · stack · vector

err.intlang

-- basic Result Type Simulation
-- main downsides of doing this library side are: 
            -- 1. to return an error one still needs a value of the type that is returned when computation
            --    runs normally
            -- 2. No enforcement, that the value is checked with ok before its unwrapped
            -- 3. No nice shorthands like ? in Rust
            -- 4. Problems with language futures can not cleanly make use of the error system
-- the main upside is that its 4 lines instead of 100's

let res = \v. (0,v)
let err = \v. (1,v)

let ok = \res. let (tag, value) = res in tag == 0
let uwrp = \res. let (tag, value) = res in value

graph.intlang

include math
include vector
include search
include sort

--make empty assoc vector of size n
let genGraph = \n. vecmk[-1,n,0] 

-- if g has edge from v to u return 1 else 0, UNSAFE, does not check if v or u are a valid vertices
let _checkEdgeUnsave = \g v u. if (search.linearsearch_i32 vecget[g,v] u) == -1 then 0 else 1 end

-- if g has edge from v to u return 1 else 0
let checkEdge = \g v u. 
            let validverts = math.inbounds 0 (veclen[g]) in
            if (validverts v) & (validverts u) then
                _checkEdgeUnsave g v u
            else 
                0
            end

-- adds edge from v to u
let addEdge = \g v u. 
            let validverts = math.inbounds 0 (veclen[g]) in
            if (validverts v) & (validverts u) then
                if _checkEdgeUnsave g v u then
                    g
                else
                    let oldneighbors = vecget[g,v] in
                    let m1idx = search.linearsearch_i32 oldneighbors (-1) in
                    let newneighbors = 
                        if m1idx == -1 then
                            vecextend[oldneighbors, u, 1]
                        else
                            vecset[oldneighbors, u, m1idx]
                        end
                    in 
                    vecset[g, newneighbors, v]
                end                
            else 
                g
            end

-- removes edge from v to u
let removeEdge = \g v u. 
            let validverts = math.inbounds 0 (veclen[g]) in
            if (validverts v) & (validverts u) then
                if _checkEdgeUnsave g v u then
                    let oldneighbors = vecget[g,v] in
                    let uidx = search.linearsearch_i32 oldneighbors u in
                    let newneighbors = vecset[oldneighbors, -1, uidx] in
                    vecset[g, newneighbors, v]
                else
                    g
                end                
            else 
                g
            end

-- dfs: 
    -- assumes that all the entries in the graph and start are in [0,n-1] where n is veclen[g]
    -- and that ord only permutes
    -- ord is used to define the traversal order of neighbors
    -- g is the graph
    -- start is the starting vertex
    -- returned the discover time, finish time, and parent vectors
let dfs = \ (ord : [i32] -> [i32]) (g : [[i32]]) (start : i32) => [i32]*[i32]*[i32]. 
    let n = veclen[g] in
    let rec dfsaux = \p acc v.
        let (t, disct, fint, par) = acc in
        if vecget[disct, v] >= 0 then 
            --already visited case
            (t, disct, fint, par)
        else
            -- not yet visited
            let ndisct = vecset[disct, t, v] in
            let npar = vecset[par, p, v] in
            let nacc = (t+1, ndisct, fint, npar) in
            let neigh_unord = vecget[g, v] in
            let neigh = ord neigh_unord in
            let nnacc = vector.left_fold (\acc vloc. if vloc >= 0 then dfsaux v acc vloc else acc end) nacc neigh in
            let (t2, disct2, fint2, par2) = nnacc in
            let nfint = vecset[fint2, t2, v] in
            (t2+1, disct2, nfint, par2)
        end
    in
    let (_, disct, fint, par) = dfsaux (-1) (0, vecmk[-1,n], vecmk[-1, n],  vecmk[-1, n]) start in
    (disct, fint, par)

let dfs_canonicalord = dfs (sort.bubblesort_i32)

let dfs_defaultord = dfs (\x. x)

-- More ideas:
    -- BFS, shortest path and bipartite check
    -- Topsort, SCC, cycle detection with DFS

io.intlang

include err

-- READING
let read_str = \ (len : i32) => [i8].
    let rec read_str_aux = \ (len : i32) (i : i32) (acc : [i8]) => [i8].
        if i < len then
            let c = readi8 () in
            let next_acc = vecset[acc, c, i] in
            read_str_aux len (i+1) next_acc
        else
            acc
        end
    in
    read_str_aux len 0 (vecmk['\x00', len])

-- \() => [i8]. unit lambda annotation might be nice
let read_ln = \()
    let rec read_ln_aux = \ (acc : [i8]) (i : i32) => [i8].
        let acc_w_space = if i < veclen[acc] then acc else vecextend[acc, '\x00', veclen[acc]] end in
        let c = readi8 () in
        if c ==i8 '\n' then
            vecslice[acc_w_space, 0, i] --resize to use the valid part of the buffer
        else
            read_ln_aux vecset[acc_w_space, c, i] (i+1)
        end
    in
    read_ln_aux (vecmk['\x00', 128]) 0


-- WRITING
let write_str = \s : [i8] => unit.
    let rec write_str_aux = \ (s : [i8]) (i : i32) => unit.
        if i < veclen[s] then
            (writei8 vecget[s, i];
            write_str_aux s (i+1))
        else
            ()
        end
    in
    write_str_aux s 0

let write_ln = \s : [i8] => unit.
    let rec write_ln_aux = \ (s : [i8]) (i : i32) => unit.
        if i < veclen[s] then
            (writei8 vecget[s, i];
            write_ln_aux s (i+1))
        else
            writei8 '\n'
        end
    in
    write_ln_aux s 0


-- HANDLING I32
let ascii_is_dig = \c : i8 => i32. ('\x30' <=i8 c) & (c <=i8 '\x39')

let ascii_dig_to_i32 = \c : i8 => i32. i8_to_i32 c - 48

let i32_dig_to_ascii = \i : i32 => i8. i32_to_i8 (i + 48)

let str_to_i32 = \s : [i8] => i32 * i32.
    let rec strtoi32aux = \ (s : [i8]) (i : i32) (acc : i32) => i32 * i32.
        if i < veclen[s] then
            let c = vecget[s, i] in
            if ascii_is_dig c then
                let digit = ascii_dig_to_i32 c in
                strtoi32aux s (i+1) (acc * 10 + digit)
            else
                err.err acc
            end
        else
            err.res acc
        end
    in
    if (0 < veclen[s]) & (vecget[s, 0] ==i8 '-') then 
        let res = strtoi32aux s 1 0 in
        if err.ok res then err.res (-(err.uwrp res)) else err.err 0 end
    else 
        strtoi32aux s 0 0 
    end

-- one could add error handling (or automatic buffer extension) here but it is a method that 
-- should only be called form inside the io lib so I trust that the acc buffer that is passed is long enough
let i32_to_str_buff = \ (i : i32) -- i32 to convert
                        (idx : i32) -- buffer index to count down from
                        (acc : [i8]) -- buffer
                        => (i32 * [i8]). -- updated buffer index and buffer

    let rec _get_digits = \ (i : i32) -- the rest of the i32
                            (idx : i32) -- index into acc to use for the next char
                            (acc : [i8]) -- accumulator to make the thing tail recursive
                            => i32 * [i8]. -- return the vector and the next usable index
        let dig = i32_dig_to_ascii (i % 10) in
        let next_i = i / 10 in -- think some weird shift and mutl can do this faster
        let next_acc = vecset[acc, dig, idx] in
        let next_idx = idx - 1 in
        if next_i == 0 then
            (next_idx, next_acc)
        else
            _get_digits next_i next_idx next_acc
        end
    in

    -- range is +2147483647 to -2147483648
    -- so we need 10 chars for the digits, on negative numbers 1 for the sign
    if i == -2147483648 then --special case where we cant flip, we just "unroll" once and then flip
        let acc = vecset[acc, '8', idx] in
        let idx = idx - 1 in
        let (idx, acc) = _get_digits (214748364) idx acc in
        let acc = vecset[acc, '-', idx] in
        let idx = idx - 1 in
        (idx, acc)
    else if 0 <= i then
        let (idx, acc) = _get_digits i idx acc in
        (idx, acc)
    else 
        let (idx, acc) = _get_digits (-i) idx acc in
        let acc = vecset[acc, '-', idx] in
        let idx = idx - 1 in
        (idx, acc)
    end end

let i32_to_str = \i : i32 => [i8].
    let (idx, acc) = i32_to_str_buff i 11 (vecmk['\x00', 12]) in
    vecslice[acc, idx+1, veclen[acc]-(idx+1)] -- resize to the valid part of the buffer


-- COMMA SEPARATED I32
let csi32str_to_i32vec = \s : [i8] => i32 * [i32].
    let n = veclen[s] in
    let rec aux = \ (l : i32) (r : i32) (idx : i32) (acc : [i32]) => i32 * [i32].
        if r < n then
            let c = vecget[s, r] in
            if c ==i8 ',' then
                let num_str = vecslice[s, l, r-l] in
                let num_res = str_to_i32 num_str in
                if err.ok num_res then
                    aux (r+1) (r+1) (idx+1) vecset[acc, err.uwrp num_res, idx]
                else
                    err.err vec[]
                end
            else
                aux l (r+1) idx acc
            end
        else
            let num_str = vecslice[s, l, n-l] in
            let num_res = str_to_i32 num_str in
            if err.ok num_res then
                err.res vecslice[vecset[acc, err.uwrp num_res, idx], 0, idx+1]
            else
                err.err vec[]
            end
        end
    in
    aux 0 0 0 vecmk[0, n/2 + 1] -- there are at most veclen[s]/2 numbers in the string (only 0 to 9 for all numbers)

let i32vec_to_csi32str = \v : [i32] => [i8].
    let n = veclen[v] in
    let rec aux = \ (i : i32) 
                    (idx : i32) 
                    (acc : [i8]) 
                    => [i8].
        if 0 <= i then
            let (idx, acc) = i32_to_str_buff (vecget[v, i]) idx acc in
            let acc = vecset[acc, ',', idx] in
            let idx = idx - 1 in
            aux (i-1) idx acc
        else
            vecslice[acc, idx+2, veclen[acc]-(idx+2)] --also remove the last comma that was added
        end
    in
    if n == 0 then
        vecmk['\x00', 0]
    else    
        aux (n-1) (n * 12 - 1) (vecmk['\x00', n * 12]) -- the max string size is 12 characters (10 digits + 1 sign + 1 comma per number)
    end

-- Some shorthands for convenience
-- the read short hands do use functions that can return errors
-- but for the sake of simplicity they will return a default value on fail
-- but not 0 or similar since these small numbers might appear in the test sometimes
-- so just some big random number, it is a bit dirty but just makes the code in the test
-- so much more readable. This would be different if the Result Type was builtin
-- and well integrated
let readln_i32 = \() let res = str_to_i32 (read_ln ()) in if err.ok res then err.uwrp res else 987654 end
let readln_i32vec = \() let res = csi32str_to_i32vec (read_ln ()) in if err.ok res then err.uwrp res else vec[987654] end

let writeln_i32 = \i : i32 => unit. write_ln (i32_to_str i)
let write_i32 = \i : i32 => unit. write_str (i32_to_str i)
let writeln_i32vec = \v. write_ln (i32vec_to_csi32str v)

mat.intlang

-- lib for row major matrices
include math
include vector

-- create an identity matrix of size n x n
let matid = \n. 
    let n = math.abs n in
    let rec matidaux = \i A.
        let updtA = vecset[A, 1, i*n+i] in
        if i < (n-1) then 
            matidaux (i+1) updtA 
        else 
            updtA 
        end
    in
    matidaux 0 vecmk[0,n*n]

-- "classic triple loop untiled" matmul
-- A is a nxl mat
-- B is a lxm mat
let matmul = \n l m A B.
    -- C is a nxm mat (in here for tail recursion, the initial call must pass it as 0)
    -- i,j,k are the loop/recursion vars
    -- i is in [0,n]
    -- j is in [0,m]
    -- k is in [0,l]
    let rec matmulaux = \C i j k.
                let updtC = vecset[C, 
                                   vecget[C, i*m+j] + vecget[A,i*l+k]*vecget[B,k*m+j],
                                   i*m+j
                                  ] in
                if k < (l-1) then 
                    matmulaux updtC i j (k+1)
                else if j < (m-1) then
                    matmulaux updtC i (j+1) 0
                else if i < (n-1) then
                    matmulaux updtC (i+1) 0 0
                else 
                    updtC
                end end end 
    in
    if (veclen[A] == n*l)*(veclen[B] == l*m) then
        err.res (matmulaux vecmk[0,n*m] 0 0 0)
    else 
        err.err vec[]
    end

let matadd = \A B.
    let rec mataddaux = \C i.
                let updtC = vecset[C, 
                                   vecget[A,i] + vecget[B,i],
                                   i
                                  ] in
                if i < (veclen[A]-1) then 
                    mataddaux updtC (i+1)
                else 
                    updtC
                end 
    in
    if (veclen[A] == veclen[B]) then
        err.res (mataddaux vecmk[0,veclen[A]] 0)
    else 
        err.err vec[]
    end

let matsmul = \A s. vector.map (\x. x*s) A

let matsub = \A B. matadd A (matsmul B (-1)) --haha mb I should add negative int literals, haha I did

let sqmattrans = \n A.
    let rec sqmattransaux = \A i j.
        let tmp = vecget[A, i*n+j] in
        let partA = vecset[A, vecget[A,j*n+i], i*n+j] in
        let updtA = vecset[partA, tmp, j*n+i] in
        if j < (n-1) then
            sqmattransaux updtA i (j+1)
        else if i < (n-2) then
            sqmattransaux updtA (i+1) (i+2)
        else
            updtA
        end end
    in
    if veclen[A] == n*n then
        err.res (sqmattransaux A 0 0)
    else 
        err.err vec[]
    end

math.intlang

-- general math functions
-- Note: as of now they are not optimized just written to work :)

-- exp < 1 is just return base
let abstracpow = \mulf. \base. \exp. 
    let rec apowaux = \acc. \cnt.
        if cnt < exp then
            apowaux (mulf acc base) (cnt+1)
        else 
            acc
        end
    in
    apowaux base 1

-- here could work for exp = 0 but this way its so elegant, I refuse to change it
let pow = abstracpow (\x. \y. x * y)

let abs = \x. if x < 0 then -x else x end

let min = \a. \b. if a < b then a else b end

let max = \a. \b. if a > b then a else b end

-- sqrt only makes sense for possitive numbers, so the input will be 
-- treated as unsigned
let sqrt = \x. 
    let rec sqrtaux = \guess.
        if guess*guess <=u x then
            sqrtaux (guess+1)
        else
            guess-1
        end
    in
    sqrtaux 0


-- one could want a gcd for signed numbers but
-- this would mean more complexity for something not really needed
-- so the gcd is only defined for unsigned numbers
let rec gcd = \a. \b. 
            if b == 0 then 
                a 
            else 
                gcd b (a %u b)
            end

let prime = \n. 
    let rec isprimeaux = \i.
        if i*i <=u n then
            if n %u i == 0 then
                0
            else
                isprimeaux (i+1)
            end
        else
            1
        end
    in
    if n < 2 then 
        0 
    else 
        isprimeaux 2 
    end


let cmp_i32 = \a. \b. 
    if a < b then 
        -1
    else if a > b then 
        1
    else 
        0
    end end


-- if low <= val < high then 1 else 0
let inbounds = \low high val. ((low <= val) & (val < high))

queue.intlang

-- a queue is (front, back, vec) where
-- the actual elements start at index front and end at index back-1 (all in the mod n group)

include err
include math


let mkQueue = \() (0,0, vec[])

let sizeQueue = \q. 
            let (front, back, v) = q in
            if front <= back then back - front else veclen[v] - front + back end

let isemptyQueue = \q. sizeQueue q == 0

let isfullQueue = \q.
            let (_, _, v) = q in
            sizeQueue q >= veclen[v]-1 -- >= is for the zero edge case

let extendQueue = \q x. 
            let (front, back, oldvec) = q in
            let oldlen = veclen[oldvec] in
            let newvec = vecextend[oldvec, x, math.max oldlen 32] in -- the main reason to pass x and use it here is to keep the polymorphism
            let rec aux = \acc i.
                if i < back then
                    aux vecset[acc, vecget[oldvec, i], oldlen + i] (i+1)
                else 
                    (front, oldlen + i, acc)
                end
            in
            if front > back then
                aux newvec 0
            else 
                (front, back, newvec)
            end

let enQueue = \q x. 
            let (front, back, v) = if isfullQueue q then extendQueue q x else q end in
            let newback = (back + 1) % veclen[v] in
            (front, newback, vecset[v, x, back])


let deQueue = \q. 
            let (front, back, v) = q in
            if isemptyQueue q then
                err.err (vecget[v, 0], q)
            else
                let elm = vecget[v, front] in
                let newfront = (front + 1) % veclen[v] in
                err.res (elm, (newfront, back, v))
            end

search.intlang

-- searching things in vectors
include math

-- should do as a left fold
let linearsearch = \cmpf arr target.
    let rec linearsearchaux = \i.
        if i < veclen[arr] then
            if cmpf vecget[arr, i] target then
                linearsearchaux (i+1)   -- cmpf yields -1 or 1
            else
                i                       -- cmpf yields 0
            end
        else
            -1
        end
    in
    linearsearchaux 0

let linearsearch_i32 = linearsearch math.cmp_i32

let binarysearch = \cmpf arr target.
    let rec binarysearchaux = \left right.
        if left < right then
            let mid = (left + right) / 2 in
            let cmpresult = cmpf vecget[arr, mid] target in
            if cmpresult == 0 then
                let rec findleft = \i. -- makes the binary search O(n) in the worst case (while one could do the findleft as binary search too, I am simply too lazy to optimize this edge case)
                    if (0 < i) then
                        if cmpf vecget[arr, (i-1)] target == 0 then -- no logic shortcutting as of now :(
                            findleft (i-1)
                        else 
                            i
                        end
                    else
                        i
                    end
                in findleft mid
            else if cmpresult < 0 then
                binarysearchaux (mid+1) right
            else
                binarysearchaux left mid
            end end
        else
            -1
        end
    in
    binarysearchaux 0 veclen[arr]

let binarysearch_i32 = binarysearch math.cmp_i32

sort.intlang

include math

let bubblesort = \cmpf arr.
    let len = veclen[arr] in
    let rec bubblesortaux = \arr n i.
        let arrupdt =
                    let left = vecget[arr, i] in
                    let right = vecget[arr, n] in 
                    if cmpf left right < 0 then 
                        arr
                    else
                        let temp = right in
                        let arr1 = vecset[arr, left, n] in
                        vecset[arr1, temp, i]
                    end 
        in
        if i < (len-1) then 
            bubblesortaux arrupdt n (i+1)
        else if n < (len-1) then
            bubblesortaux arrupdt (n+1) 0
        else 
            arr
        end end
    in
    if len <= 1 then
        arr
    else
        bubblesortaux arr 0 0
    end
    
let bubblesort_i32 = bubblesort math.cmp_i32

stack.intlang

-- TODO

vector.intlang

-- lib for vectors

include err

let map = \f v.
    let rec mapaux = \acc i.
        if i < veclen[v] then
            mapaux vecset[acc, f vecget[v, i], i] (i+1)
        else
            acc
        end
    in
    if veclen[v] == 0 then
        vec[]
    else
        mapaux vecmk[f vecget[v, 0], veclen[v]] 0
    end

let map2 = \f v0 v1.
    let rec mapaux = \acc i.
        if i < veclen[v0] then
            mapaux vecset[acc, f vecget[v0, i] vecget[v1, i], i] (i+1)
        else
            acc
        end
    in
    if veclen[v0] != veclen[v1] then
        err.err vec[]
    else if veclen[v0] == 0 then
        err.res vec[]
    else
        err.res (mapaux vecmk[f vecget[v0, 0] vecget[v1, 0], veclen[v0]] 0)
    end end

let left_fold = \f acc v.
    let rec leftfoldaux = \acc i.
        if i < veclen[v] then
            leftfoldaux (f acc vecget[v, i]) (i+1)
        else
            acc
        end
    in
    leftfoldaux acc 0

let left_fold2 = \f acc v0 v1.
    let rec leftfoldaux = \acc i.
        if i < veclen[v0] then
            leftfoldaux (f acc vecget[v0, i] vecget[v1, i]) (i+1)
        else
            acc
        end
    in
    if veclen[v0] != veclen[v1] then
        err.err acc
    else
        err.res (leftfoldaux acc 0)
    end

let right_fold = \f v acc.
    let rec rightfoldaux = \acc i.
        if 0 <= i then
            rightfoldaux (f (vecget[v, i]) acc) (i-1)
        else
            acc
        end
    in
    rightfoldaux acc (veclen[v]-1)

let iter = \f v.
    let rec iteraux = \f v i.
        if i < veclen[v] then
            (f vecget[v, i];
            iteraux f v (i+1))
        else
            ()
        end
    in
    iteraux f v 0

let concat = \v1 v2.
    let rec concataux = \acc i.
        if i < veclen[v2] then
            concataux (vecset[acc, vecget[v2, i], i + veclen[v1]]) (i+1)
        else 
            acc
        end
    in
    if veclen[v1] == 0 then
        v2
    else if veclen[v2] == 0 then
        v1
    else
        concataux (vecextend[v1, vecget[v2, 0], veclen[v2]]) 0
    end end

let rev = \v.
    let rec revaux = \ vrev (i : i32) (irev :i32) .
        if 0 <= irev then
            revaux vecset[vrev, vecget[v,i], irev] (i+1) (irev-1)
        else
            vrev
        end in
    if veclen[v] <= 1 then
        v
    else
        revaux vecmk[vecget[v,0], veclen[v]] 0 (veclen[v]-1)
    end

    

let cmp = \cmpelm v1 v2.
    let n1 = veclen[v1] in
    let n2 = veclen[v2] in
    let rec cmpaux = \i.
        if i < n1 then
            let elcmp_val = cmpelm vecget[v1, i] vecget[v2, i] in
            if elcmp_val == 0 then
                cmpaux (i+1)
            else
                elcmp_val
            end
        else
            0
        end
    in
    if n1 < n2 then
        -1
    else if n1 > n2 then
        1
    else
        cmpaux 0
    end end