apfl/src/globals.apfl

{ C ->
    if                    := C.if
    ==                    := C.==
    >                     := C.>
    <                     := C.<
    >=                    := C.>=
    <=                    := C.<=
    +                     := C.+
    -                     := C.-
    *                     := C.*
    /                     := C./
    join                  := C.join
    print                 := C.print
    dump                  := C.dump
    disasm                := C.disasm
    tostring              := C.tostring
    not                   := C.not
    len                   := C.len
    type                  := C.type
    loop                  := C.loop
    gc                    := C.gc
    backtrace             := C.backtrace
    fopen                 := C.fopen
    fread                 := C.fread
    fwrite                := C.fwrite
    fclose                := C.fclose
    load-file             := C.load-file
    load-string           := C.load-string
    get-optional          := C.get-optional
    raise                 := C.raise
    symbol                := C.symbol
    splice                := C.splice

    Some := (C.getsym-Some)

    -named := { name f ->
        C.set-func-name f name
    }

    while := { cond body ->
        res := nil
        loop {
            if (cond) {
                res = (body)
                true
            } {
                false
            }
        }
        res
    }

    for := {
    end body ->
        for 0 end body
    start end body ->
        if (> start end) {
            for start -1 end body
        } {
            for start 1 end body
        }
    start step end body ->
        end-not-reached := if (> step 0) {{ < start end }} {{ > start end }}
        out := nil
        while end-not-reached {
            out = body start
            start = + start step
        }
        out
    }

    & := { ~strings ->
        join "" strings
    }

    partial := { f ~a1 ->
        { ~a2 ->
            f ~a1 ~a2
        }
    }

    compose := {
    f -> f
    f ~fs ->
        fs-composed := compose ~fs
        { ~args ->
            f (fs-composed ~args)
        }
    }

    != := -named '!= (compose not ==)
    !> := -named '!> (compose not >)
    !< := -named '!< (compose not <)
    !>= := -named '!>= (compose not >=)
    !<= := -named '!<= (compose not <=)

    has := {
    pred cmp y ->
        { x ->
            cmp (pred x) y
        }
    pred y ->
        has pred == y
    }

    identity := { x -> x }

    is := -named 'is (partial has identity)

    ++ := { x -> + x 1 }
    -- := { x -> - x 1 }

    -raw-substring := C.substring
    substr := {
    start s ->
        substr start (len s) s
    start?(is < 0) newlen s ->
        substr (+ start (len s)) newlen s
    start newlen?(is < 0) s ->
        substr start (+ newlen (- (len s) start)) s
    start newlen s ->
        -raw-substring s start newlen
    }

    -raw-stringsearch := C.stringsearch
    strsearch := {
    needle haystack ->
        -raw-stringsearch haystack needle
    needle start?(is < 0) haystack ->
        strsearch needle (+ start (len s)) haystack
    needle start haystack ->
        off := (strsearch needle (substr start haystack))
        if (== off nil) { nil } { + start off }
    }

    split := ({
        split-aux := { maxlen-reached sep s ->
            sep-len := len sep
            parts := []
            loop {
                if (maxlen-reached (++ (len parts))) {
                    parts = [~parts s]
                    false
                } {
                    off := strsearch sep s
                    if (== nil off) {
                        parts = [~parts s]
                        false
                    } {
                        parts = [~parts (substr 0 off s)]
                        s = substr (+ off sep-len) s
                        true
                    }
                }
            }

            parts
        }

        split := {
        sep s ->
            split-aux {false} sep s
        sep maxlen s ->
            split-aux (is >= maxlen) sep s
        }
    })

    keach := {
    d?(has type 'dict) body ->
        out := nil
        C.iterate-dict d { k v ->
            out = body k v
            true
        }
        out
    l?(has type 'list) body ->
        out := nil
        for (len l) { i ->
            out = body i l@i
        }
        out
    }

    each := { container body ->
        keach container { _ v ->
            body v
        }
    }

    andalso := {
    f ->
        (f)
    f ~fs ->
        result := (f)
        if result { andalso ~fs } { result }
    }

    orelse := {
    f ->
        (f)
    f ~fs ->
        result := (f)
        if result { result } { orelse ~fs }
    }

    ifind-first := { f l ->
        out := nil
        i := 0
        n := len l
        while {andalso {== out nil} {< i n}} {
            {
            Some:x ->
                out = Some::x
            nil ->
            } (f i l@i)

            i = ++ i
        }

        out
    }

    find-first := { f l ->
        ifind-first { _ x -> f x } l
    }

    find-index := { pred l ->
        ifind-first { i x ->
            if (pred x) { Some::i } { nil }
        }
    }

    unwrap-some := {
    Some:x then _ -> then x
    x _ else -> else x
    x then -> unwrap-some x then identity
    }

    unwrap-nil := {
    nil _ else -> (else)
    x then _ -> then x
    x then -> unwrap-nil x then {nil}
    }

    pipe := {
    val -> val
    val [f ~args] ~fs ->
        pipe (f ~args val) ~fs
    val f ~fs ->
        pipe (f val) ~fs
    }

    has-key := { k container ->
        {
            Some: _ -> true
            nil -> false
        } (get-optional k container)
    }

    get-or-default := { k container default ->
        {
            Some:x -> x
            nil -> def
        } (get-optional k container)
    }

    run-file := { f ->
        ((load-file f))
    }

    tonumber := {
    x ->
        tonumber 10 x
    10 x?(has type 'number) ->
        x
    base x ->
        C.tonumber base (tostring x)
    }

    modules := ({
        loaded-modules := [->]
        searchers := []

        ImportError := symbol 'ImportError

        add-searcher := { s ->
            searchers = [~searchers s]
        }

        add-searcher { m ->
            unwrap-some (get-optional m loaded-modules) { mod ->
                Some::{ Some::mod }
            }
        }

        add-searcher { m ->
            unwrap-some (C.cmod-searcher m) { loader ->
                Some::{
                    Some::(loader)
                }
            }
        }

        import := { name ->
            maybe-mod := find-first { s ->
                unwrap-some (s name) { loader ->
                    loader name
                }
            } searchers

            {
                Some:mod ->
                    loaded-modules@name = mod
                    mod
                nil ->
                    raise ImportError::(& "Module " name " not found")
            } maybe-mod
        }

        add-preloaded-module := { name mod ->
            loaded-modules@name = mod
        }

        modules := [
            'import -> import
            'add-searcher -> add-searcher
            'add-preloaded-module -> add-preloaded-module
            'ImportError -> ImportError
        ]

        add-preloaded-module 'modules modules

        modules
    })

    map := {
    _ [] -> []
    f [x ~xs] ->
        [(f x) ~(map f xs)]
    }

    foldl := {
    f [x ~xs] -> foldl f x xs
    _ carry [] -> carry
    f carry [x ~xs] -> foldl f (f x carry) xs
    }

    splice := {
    a off -> splice a off nil
    a off len -> splice a off len []
    a a-off a-len b  -> splice a a-off a-len b 0 nil
    a a-off a-len b b-off -> splice a a-off a-len b b-off nil
    a a-off a-len b b-off b-len ->
        C.splice a a-off a-len b b-off b-len
    }

    slice := {
    off l -> slice off nil l
    off len l -> splice [] 0 nil l off len
    }

    # Dictionary of exported functions
    [
        'if -> if
        '== -> ==
        '> -> >
        '< -> <
        '>= -> >=
        '<= -> <=
        '+ -> +
        '- -> -
        '* -> *
        '/ -> /
        'join -> join
        'print -> print
        'dump -> dump
        'disasm -> disasm
        'tostring -> tostring
        'tonumber -> tonumber
        'not -> not
        'len -> len
        'type -> type
        'loop -> loop
        'while -> while
        'for -> for
        'gc -> gc
        'backtrace -> backtrace
        'fopen -> fopen
        'fread -> fread
        'fwrite -> fwrite
        'fclose -> fclose
        'load-file -> load-file
        'load-string -> load-string
        'run-file -> run-file
        '& -> &
        'substr -> substr
        'strsearch -> strsearch
        'split -> split
        'partial -> partial
        'compose -> compose
        'has -> has
        'identity -> identity
        'is -> is
        '!= -> !=
        '!> -> !>
        '!< -> !<
        '!>= -> !>=
        '!<= -> !<=
        '++ -> ++
        '-- -> --
        'keach -> keach
        'each -> each
        'get-optional -> get-optional
        'get-or-default -> get-or-default
        'raise -> raise
        'has-key -> has-key
        'symbol -> symbol
        'Some -> Some
        'get-argv -> C.get-argv
        'andalso -> andalso
        'orelse -> orelse
        'find-first -> find-first
        'find-index -> find-index
        'unwrap-some -> unwrap-some
        'unwrap-nil -> unwrap-nil
        'import -> modules.import
        'map -> map
        'splice -> splice
        'slice -> slice
        'pipe -> pipe
        'foldl -> foldl
    ]
}