apfl/src/globals.apfl

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

    Some := (builtins.getsym-Some)

    -named := { name f ->
        builtins.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 := builtins.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 := builtins.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
        builtins.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 }
    }

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

            i = ++ i
        }

        out
    }

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

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

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

    tonumber := {
    x ->
        tonumber 10 x
    10 x?(has type 'number) ->
        x
    base x ->
        builtins.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 (builtins.cmod-searcher m) { loader ->
                Some::{
                    Some::(loader)
                }
            }
        }

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

            {
                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)]
    }

    # 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
        '-serialize-bytecode -> -serialize-bytecode
        '-unserialize-bytecode -> -unserialize-bytecode
        '& -> &
        'substr -> substr
        'strsearch -> strsearch
        'split -> split
        'partial -> partial
        'compose -> compose
        'has -> has
        'identity -> identity
        'is -> is
        '!= -> !=
        '!> -> !>
        '!< -> !<
        '!>= -> !>=
        '!<= -> !<=
        '++ -> ++
        '-- -> --
        'keach -> keach
        'each -> each
        'get-optional -> get-optional
        'raise -> raise
        'has-key -> has-key
        'symbol -> symbol
        'Some -> Some
        'get-argv -> builtins.get-argv
        'andalso -> andalso
        'orelse -> orelse
        'find-first -> find-first
        'unwrap-some -> unwrap-some
        'import -> modules.import
        'map -> map
    ]
}