nomsu/core/metaprogramming.nom

#!/usr/bin/env nomsu -V4.10.12.7
#
    This File contains actions for making actions and compile-time actions and some helper
    functions to make that easier.
    
lua> "NOMSU_CORE_VERSION = 11"
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" 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:append(i > 1 and ", " or "", arg_lua)
            body_lua:remove_free_vars({arg_lua})
        end
        body_lua:declare_locals()
        lua:append(")\\n    ", body_lua, "\\nend)")
        return lua
    end
    compile.action["->"] = compile.action["1 ->"]
    compile.action["for"] = compile.action["1 ->"]"

lua> "\
    ..compile.action["what 1 compiles to"] = function(compile, \%action)
        local lua = LuaCode("compile.action[", \%action.stub:as_lua(), "](")
        local lua_args = table.map(\%action:get_args(), compile)
        table.insert(lua_args, 1, "compile")
        lua:concat_append(lua_args, ", ")
        lua:append(")")
        return lua
    end"

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

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.stub:as_lua(),
            "] = ", \(what (%args -> %body) compiles to))
    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 = \(what (%actions.1 compiles to %body) compiles to)
        local \%args = List{\(\%compile), unpack(\%actions[1]:get_args())}
        for i=2,#\%actions do
            local alias = \%actions[i]
            local \%alias_args = List{\(\%compile), unpack(alias:get_args())}
            lua:append("\\ncompile.action[", alias.stub:as_lua(), "] = ")
            if \%alias_args == \%args then
                lua:append("compile.action[", \%actions[1].stub:as_lua(), "]")
            else
                lua:append(\(what (%alias_args -> \(what %actions.1 compiles to)) compiles to))
            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()
        local fn_name = \%action.stub:as_lua_id()
        if \%action.target then lua:append(compile(\%action.target), ".")
        else lua:add_free_vars({fn_name}) end
        lua:append(fn_name, " = ", \(what (%action -> %body) compiles to), ";")
        return lua"

(%actions all mean %body) compiles to:
    lua> "\
        ..local fn_name = \%actions[1].stub:as_lua_id()
        local target = \%actions[1].target and compile(\%actions[1].target) or nil
        local \%args = List(\%actions[1]:get_args())
        local lua = \(what (%actions.1 means %body) compiles to)
        for i=2,#\%actions do
            local alias = \%actions[i]
            local alias_name = alias.stub:as_lua_id()
            local \%alias_args = List(alias:get_args())
            lua:append("\\n")
            if alias.target then
                lua:append(compile(alias.target), ".")
            else
                lua:add_free_vars({alias_name})
            end
            lua:append(alias_name, " = ")
            if \%args == \%alias_args then
                if target then lua:append(target, ".") end
                lua:append(fn_name, ";")
            else
                lua:append(\(what (%alias_args -> %actions.1) compiles to), ";")
            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 = \(what (%action means %body) compiles to)
        lua:remove_free_vars({\%action.stub:as_lua_id()})
        return lua"

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

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

(%action's meaning) compiles to (Lua (%action.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:match("[_a-zA-Z][_a-zA-Z0-9]*") 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 = \(what (%actions all compile to %new_body) compiles to)
        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)()')
        end
        return tree_lua"


externally [%var as lua identifier, %var as lua id] all mean:
    lua> "\
        ..if lua_type_of(\%var) == 'string' then return \%var:as_lua_id()
        elseif SyntaxTree:is_instance(\%var, 'Var') then return \%var[1]:as_lua_id()
        elseif SyntaxTree:is_instance(\%var) then
            local lua = \(%var as lua expr)
            if not lua:text():match("^[_a-zA-Z][_a-zA-Z0-9]*$") then
                compile_error(\%var, "This is not a valid Lua identifier.")
            end
            return lua
        else error("Unknown type: "..tostring(\%var))
        end"

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))
        \(..)
        (%replacement as lua) if (%replacement.type == "Block") else "\
            ..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.stub ~= \%tree.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"

externally (%tree with %patt ~> %replacement) means:
    lua> "\
        ..return \%tree:map(function(\%t)
            local \%vars = \(match %t with %patt)
            if not \%vars then return nil end
            for \%k,\%v in pairs(\%vars) do
                \%vars[\%k] = \(%v with %patt ~> %replacement)
            end
            return \%replacement:map(function(\%t)
                if \%t.type == "Var" then
                    return \%vars[\%t[1]]
                end
            end)
        end)"

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)
    external %passed = (no)
    run "external %passed = (yes)"
    assume %passed
    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:append(", ") end
            lua:append(_1_as_lua((select(i, ...))))
        end
        lua:append(" 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)"