path: root/core/metaprogramming.nom

#!/usr/bin/env nomsu -V6.12.12.8
#
    This File contains actions for making actions and compile-time actions and some helper
    functions to make that easier.
    
lua> "NOMSU_CORE_VERSION = 12"
lua> "NOMSU_LIB_VERSION = 8"
lua> ("
    do
        local mangle_index = 0
        function mangler()
            local my_mangle_index = mangle_index
            mangle_index = mangle_index + 1
            return function(varname)
                return (varname..(("\\3%X"):format(my_mangle_index))):as_lua_id()
            end
        end
    end
    compile.action["define mangler"] = function(compile)
        return LuaCode("local mangle = mangler()")
    end
")

lua> ("
    compile.action["1 ->"] = function(compile, \$args, \$body)
        if \$args and not \$body then \$args, \$body = {}, \$args end
        local body_lua = SyntaxTree:is_instance(\$body) and compile(\$body) or \$body
        if SyntaxTree:is_instance(\$body) and \$body.type ~= "Block" then body_lua:prepend("\
    ..return ") end
        local lua = LuaCode("(function(")
        if SyntaxTree:is_instance(\$args) and (\$args.type == "Action" or \$args.type == "MethodCall") then
            \$args = \$args:get_args()
        elseif SyntaxTree:is_instance(\$args) and \$args.type == "Var" then \$args = {\$args} end
        for i, arg in ipairs(\$args) do
            local arg_lua = SyntaxTree:is_instance(arg) and compile(arg):text() or arg
            if arg_lua == "..." then
                if i < #\$args then
                    compile_error_at(SyntaxTree:is_instance(arg) and arg or nil,
                        "Extra arguments must come last.", "Try removing any arguments after \
    ..(*extra arguments*)")
                end
            elseif not arg_lua:is_lua_id() then
                compile_error_at(SyntaxTree:is_instance(arg) and arg or nil,
                    "This does not compile to a Lua identifier, so it can't be used as a function \
    ..argument.",
                    "This should probably be a Nomsu variable instead (like $x).")
            end
            lua:add(i > 1 and ", " or "", arg_lua)
            body_lua:remove_free_vars({arg_lua})
        end
        body_lua:declare_locals()
        lua:add(")\\n    ", body_lua, "\\nend)")
        return lua
    end
    compile.action["->"] = compile.action["1 ->"]
    compile.action["for"] = compile.action["1 ->"]
")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

test:
    (five) compiles to "5"

test:
    assume ((five) == 5) or barf "Compile to expression failed."
    (loc x) compiles to "local x = 99;"

test:
    lua> "do"
    loc x
    assume ($x is 99) or barf "Compile to statements with locals failed."
    lua> "end"
    assume ($x is (nil)) or barf "Failed to properly localize a variable."
    (asdf) compiles to:
        $tmp = ""
        return (Lua $tmp)

test:
    asdf
    assume ($tmp is (nil)) or barf "compile to is leaking variables"

lua> ("
    compile.action["1 compiles to"] = function(compile, \$action, \$body)
        local \$args = List{\(\$compile), unpack(\$action:get_args())}
        if \$body.type == "Text" then
            \$body = SyntaxTree{source=\$body.source, type="Action", "Lua", \$body}
        end
        return LuaCode("compile.action[", \$action:get_stub():as_lua(),
            "] = ", \(\($args -> $body) as lua))
    end
")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

($actions all compile to $body) compiles to:
    lua> ("
        if \$actions.type ~= "List" then
            compile_error(\$actions, "This should be a list of actions.")
        end
        local lua = \(\($actions.1 compiles to $body) as lua)
        local \$args = List{\(\$compile), unpack(\$actions[1]:get_args())}
        local \$compiled_args = List(table.map(\$args, compile))
        for i=2,#\$actions do
            local alias = \$actions[i]
            local \$alias_args = List{\(\$compile), unpack(alias:get_args())}
            lua:add("\\ncompile.action[", alias:get_stub():as_lua(), "] = ")
            if \$alias_args == \$args then
                lua:add("compile.action[", \$actions[1]:get_stub():as_lua(), "]")
            else
                lua:add("function(")
                lua:concat_add(table.map(\$alias_args, compile), ", ")
                lua:add(") return compile.action[", \$actions[1]:get_stub():as_lua(), "](")
                lua:concat_add(\$compiled_args, ", ")
                lua:add(") end")
            end
        end
        return lua
    ")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

test:
    (foo $x) means "outer"
    with [(foo $)'s meaning]:
        (foo $x) means:
            $y = ($x + 1)
            return $y
        assume ((foo 10) == 11) or barf "Action didn't work."
        assume ($y is (nil)) or barf "Action leaked a local into globals."
        (baz $) parses as (foo $)
    assume ((foo 1) == "outer")

($action means $body) compiles to:
    lua> ("
        
        local lua = LuaCode()
        if \$action.type == "MethodCall" then
            lua:add(compile(\$action[1]), ".", \$action[2]:get_stub():as_lua_id())
        elseif \$action.type == "Action" then
            lua:add(\$action:get_stub():as_lua_id())
            lua:add_free_vars({\$action:get_stub():as_lua_id()})
        else
            compile_error_at(\$action, "Expected an action or method call here")
        end
        lua:add(" = ", \(\($action -> $body) as lua), ";")
        return lua
    ")

($actions all mean $body) compiles to:
    lua> ("
        local lua = \(\($actions.1 means $body) as lua)
        local first_def = (\$actions[1].type == "MethodCall"
            and LuaCode(compile(\$actions[1][1]), ".", \$actions[1]:get_stub():as_lua_id())
            or LuaCode(\$actions[1]:get_stub():as_lua_id()))
        local \$args = List(\$actions[1]:get_args())
        for i=2,#\$actions do
            local alias = \$actions[i]
            local \$alias_args = List(alias:get_args())
            lua:add("\\n")
            if alias.type == "MethodCall" then
                lua:add(compile(alias[1]), ".", alias:get_stub():as_lua_id())
            else
                lua:add(alias:get_stub():as_lua_id())
                lua:add_free_vars({alias_name})
            end
            if \$args == \$alias_args then
                lua:add(" = ", first_def, ";")
            else
                lua:add(" = ", \(\($alias_args -> $actions.1) as lua), ";")
            end
        end
        return lua
    ")

test:
    externally (baz1) means:
        return "baz1"
    externally (baz2) means "baz2"

test:
    assume ((baz1) == "baz1")
    assume ((baz2) == "baz2")

(externally $action means $body) compiles to:
    lua> ("
        local lua = \(\($action means $body) as lua)
        lua:remove_free_vars({\$action:get_stub():as_lua_id()})
        return lua
    ")

(externally $actions all mean $body) compiles to:
    lua> ("
        local lua = \(\($actions all mean $body) as lua)
        lua:remove_free_vars(table.map(\$actions, function(a) return a:get_stub():as_lua_id() end))
        return lua
    ")

test:
    assume (((say $)'s meaning) == (=lua "say"))

($action's meaning) compiles to (Lua ($action, get stub, as lua id))
test:
    (swap $x and $y) parses as
        do:
            $tmp = $x
            $x = $y
            $y = $tmp

test:
    [$1, $2] = [1, 2]
    swap $1 and $2
    assume (($1 == 2) and ($2 == 1)) or barf
    .."'parse % as %' failed on 'swap % and %'"
    
    [$tmp, $tmp2] = [1, 2]
    
    swap $tmp and $tmp2
    assume (($tmp == 2) and ($tmp2 == 1)) or barf
    .."'parse % as %' variable mangling failed."

($actions all parse as $body) compiles to:
    lua> ("
        local replacements = {}
        if \$actions.type ~= "List" then
            compile_error(\$actions, "This should be a list.")
        end
        for i,arg in ipairs(\$actions[1]:get_args()) do
            replacements[arg[1]] = compile(arg):text()
        end
        local function make_tree(t)
            if SyntaxTree:is_instance(t) and t.type == "Var" then
                if replacements[t[1]] then
                    return replacements[t[1]]
                else
                    return "SyntaxTree{mangle("..t[1]:as_lua().."), type="..t.type:as_lua()..", \
        ..source="..tostring(t.source):as_lua().."}"
                end
            elseif SyntaxTree:is_instance(t) then
                local ret = {}
                local i = 1
                for k, v in pairs(t) do
                    if k == i then
                        ret[#ret+1] = make_tree(t[i])
                        i = i + 1
                    elseif k == "source" then
                        ret[#ret+1] = k.."= "..tostring(v):as_lua()
                    elseif lua_type_of(k) == 'string' and k:is_a_lua_id() then
                        ret[#ret+1] = k.."= "..make_tree(v)
                    else
                        ret[#ret+1] = "["..make_tree(k).."]= "..make_tree(v)
                    end
                end
                return "SyntaxTree{"..table.concat(ret, ", ").."}"
            elseif lua_type_of(t) == 'number' then
                return tostring(t)
            else
                return t:as_lua()
            end
        end
        local \$new_body = LuaCode:from(\$body.source,
            "local mangle = mangler()",
            "\\nreturn ", make_tree(\$body))
        local ret = \(\($actions all compile to $new_body) as lua)
        return ret
    ")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[$action parses as $body] all parse as ([$action] all parse as $body)

#(%tree as lua expr) compiles to "compile(\(=lua "compile(\%tree, true)"), true)"
externally ($tree as lua expr) means:
    lua> ("
        local tree_lua = compile(\$tree)
        if \$tree.type == 'Block' then
            tree_lua = LuaCode:from(\$tree.source, '(function()\\n    ', tree_lua, '\\nend)()')
        elseif \$tree.type == 'MethodCall' and #\$tree > 2 then
            compile_error_at(\$tree, "This must be a single value instead of "..(#\$tree - 1).."\
        .. method calls.",
                "Replace this with a single method call.")
        end
        return tree_lua
    ")

externally [$var as lua identifier, $var as lua id] all mean:
    lua> ("
        local lua = \($var as lua)
        if not lua:text():is_a_lua_id() then
            compile_error(\$var,
                "This is supposed to be something that compiles to a valid Lua identifier.",
                "This should probably be a variable.")
        end
        return lua
    ")

test:
    (num args (*extra arguments*)) means (select "#" (*extra arguments*))
    assume (num args 1 2 3) == 3
    (extra args (*extra arguments*)) means [*extra arguments*]
    assume (extra args 1 2 3) == [1, 2, 3]
    (third arg (*extra arguments*)) means (select 3 (*extra arguments*))
    assume (third arg 5 6 7 8) == 7

(*extra arguments*) compiles to "..."

($ is syntax tree) compiles to "SyntaxTree:is_instance(\($ as lua expr))"

externally ($ is $kind syntax tree) means
    =lua "SyntaxTree:is_instance(\$) and \$.type == \$kind"

($tree with $t -> $replacement) compiles to ("
    \($tree as lua expr):map(function(\($t as lua expr))
        \(=lua "\$replacement.type == 'Block' and \($replacement as lua) or 'return '..\($replacement as lua expr)")
    end)
")

externally ($tree with vars $replacements) means
    =lua ("
        \$tree:map(function(\$t)
            if \$t.type == "Var" then
                return \$replacements[\$t[1]]
            end
        end)
    ")

(tree $tree with vars $replacements) compiles to ("
    \(=lua "(\$tree):as_lua()"):map(function(t)
        if t.type == "Var" then
            return \($replacements as lua expr)[t[1]]
        end
    end)
")

($tree has subtree $match_tree) compiles to ("
    (function()
        local match_tree = \($match_tree as lua expr)
        for subtree in coroutine_wrap(function() \($tree as lua expr):map(yield) end) do
            if subtree == match_tree then return true end
        end
    end)()
")

externally (match $tree with $patt) means:
    lua> ("
        if \$patt.type == "Var" then return Dict{[\$patt[1]]=\$tree} end
        if \$patt.type == "Action" and \$patt:get_stub() ~= \$tree:get_stub() then return nil end
        if #\$patt ~= #\$tree then return nil end
        local matches = Dict{}
        for \($i)=1,#\$patt do
            if SyntaxTree:is_instance(\$tree[\$i]) then
                local submatch = \(match $tree.$i with $patt.$i)
                if not submatch then return nil end
                for k,v in pairs(submatch) do
                    if matches[k] and matches[k] ~= v then return nil end
                    matches[k] = v
                end
            end
        end
        return matches
    ")

test:
    assume ((quote "one\n\"two\"") == "\"one\\n\\\"two\\\"\"")

(quote $s) compiles to "tostring(\($s as lua expr)):as_lua()"
test:
    assume (lua type of {}) == "table"
    assume (type of {}) == "Dict"
    assume ({} is a "Dict")
    assume ("" is text)
    assume ("" isn't a "Dict")
externally ($ is text) means (=lua "\(lua type of $) == 'string'")
externally [$ is not text, $ isn't text] all mean
    =lua "\(lua type of $) ~= 'string'"

externally (type of $) means:
    lua> ("
        local lua_type = \(lua type of $)
        if lua_type == 'string' then return 'Text'
        elseif lua_type == 'table' or lua_type == 'userdata' then
            local mt = getmetatable(\$)
            if mt and mt.__type then return mt.__type end
        end
        return lua_type
    ")

[$ is a $type, $ is an $type] all parse as ((type of $) == $type)
[$ isn't a $type, $ isn't an $type, $ is not a $type, $ is not an $type]
..all parse as ((type of $) != $type)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

test:
    assume ((run "return (2 + 99)") == 101)
    $x = 0
    externally (set to $) means:
        external $x = $
    run "set to 1"
    assume $x == 1
    assume (run \(return \(\(5) + \(5)))) == 10
(run $nomsu_code) compiles to "run_1_in(\($nomsu_code as lua expr), _ENV)"
[compile $block, compiled $block, $block compiled] all compile to
.."compile(\($block as lua))"

test:
    (foo) means:
        return 100 200 300
    assume (select 2 (foo)) == 200

# Return statement is wrapped in a do..end block because Lua is unhappy if you
    put code after a return statement, unless you wrap it in a block.
(return (*extra arguments*)) compiles to:
    lua> ("
        local lua = \(Lua "do return ")
        for i=1,select('#',...) do
            if i > 1 then lua:add(", ") end
            lua:add(_1_as_lua((select(i, ...))))
        end
        lua:add(" end")
        return lua
    ")

# Literals
(yes) compiles to "true"
(no) compiles to "false"
[nothing, nil, null] all compile to "nil"
(Nomsu syntax version) compiles to "NOMSU_SYNTAX_VERSION"
(Nomsu compiler version) compiles to "NOMSU_COMPILER_VERSION"
(core version) compiles to "NOMSU_CORE_VERSION"
(lib version) compiles to "NOMSU_LIB_VERSION"
(command line args) compiles to "COMMAND_LINE_ARGS"

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(with local compile actions $body) compiles to ("
    do
        --local compile = _1_forked(compile)
        local old_action = compile.action
        compile.action = _1_forked(old_action)
        \($body as lua)
        compile.action = old_action
    end
")

externally (Nomsu version) means:
    return "\(Nomsu syntax version).\(core version).\(Nomsu compiler version).\(lib version)"