#!/usr/bin/env nomsu -V7.0.0
###
    This File contains actions for making actions and compile-time actions and some helper
    functions to make that easier.
    
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_RULES["define mangler"] = function(\(nomsu environment), _tree)
        return LuaCode("local mangle = mangler()")
    end
    COMPILE_RULES["this tree"] = function(\(nomsu environment), _tree)
        return LuaCode("_tree")
    end
")

lua> ("
    COMPILE_RULES["1 ->"] = function(\(nomsu environment), _tree, \$args, \$body)
        if not \$args and not \$body then \$args, \$body = {}, SyntaxTree{type='Action', "do", "nothing"}
        elseif \$args and not \$body then \$args, \$body = {}, \$args end
        local body_lua = SyntaxTree:is_instance(\$body) and \(nomsu environment):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 \(nomsu environment):compile(arg):text() or arg
            if arg_lua == "..." then
                if i < #\$args then
                    at_1_fail(SyntaxTree:is_instance(arg) and arg or nil,
                        "Compile error: Extra arguments must come last. "..
                        "Hint: Try removing any arguments after (*extra arguments*)")
                end
            elseif not arg_lua:is_lua_id() then
                at_1_fail(SyntaxTree:is_instance(arg) and arg or nil,
                    "Compile error: This does not compile to a Lua identifier ("..arg_lua.."),"..
                    "so it can't be used as a function argument. "..
                    "Hint: 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_RULES["->"] = COMPILE_RULES["1 ->"]
    COMPILE_RULES["for"] = COMPILE_RULES["1 ->"]
    
    COMPILE_RULES["\\\\"] = function(\(nomsu environment), _tree, escaped)
        local function escape(t)
            if t.type == "Action" and t:get_stub() == "\\\\" and #t == 2 then
                return \(nomsu environment):compile(t[2])
            else
                local bits = {}
                table.insert(bits, "type="..t.type:as_lua())
                if t.source then
                    table.insert(bits, "source="..t.source:as_lua())
                end
                for i,b in ipairs(t) do
                    table.insert(bits, lua_type_of(b) == 'string' and b:as_lua() or escape(b))
                end
                local lua = LuaCode:from(t.source, "SyntaxTree{")
                lua:concat_add(bits, ", ")
                lua:add("}")
                return lua
            end
        end
        return escape(escaped)
    end
")

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

test:
    (five) compiles to "5"

test:
    unless ((five) == 5):
        fail "Compile to expression failed."
    (loc x) compiles to "local x = 99;"

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

test:
    asdf
    unless ($tmp == (nil)):
        fail "compile to is leaking variables"

lua> ("
    COMPILE_RULES["1 compiles to"] = function(\(nomsu environment), \(this tree), \$action, \$body)
        local \$args = a_List{"\(nomsu environment)", "\(this tree)"}
        if \$body.type == "Text" then
            \$body = SyntaxTree{source=\$body.source, type="Action", "Lua", \$body}
        end
        if not (\$action.type == "Action" or
                (\$action.type == "EscapedNomsu" and \$action[1].type == "Action") or
                \$action.type == "MethodCall") then
            at_1_fail(\$action.source, "Compile error: "..
                "This first argument to (* compiles to *) is neither an action nor an escaped \
    ..action (it's a "..\$action.type.."). "..
                "Hint: This should probably be an action like:\\n"
                .."(foo $x) compiles to \\"(\\\\($x as lua) + 1)\\"")
        end
        if \$action.type == "EscapedNomsu" then
            for _,a in ipairs(\$action[1]) do
                if a.type == "EscapedNomsu" then \$args:add(a[1]) end
            end
            return LuaCode("COMPILE_RULES[", \($action as lua), ":get_stub()] = ",
                \(\(\$args -> \$body) as lua))
        else
            for _,a in ipairs(\$action:get_args()) do \$args:add(a) end
            return LuaCode("COMPILE_RULES[", \$action:get_stub():as_lua(),
                "] = ", \(\(\$args -> \$body) as lua))
        end
    end
")

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

($actions all compile to $body) compiles to:
    lua> ("
        if \$actions.type ~= "List" then
            at_1_fail(\$actions, "Compile error: This should be a list of actions.")
        end
        local lua = \(\(\$actions.1 compiles to \$body) as lua)
        local \$args = a_List{"\(nomsu environment)", "\(this tree)", unpack(\$actions[1]:get_args())}
        local \$compiled_args = a_List{"\(nomsu environment)", "\(this tree)"};
        for i=3,#\$args do \$compiled_args[i] = \(nomsu environment):compile(\$args[i]) end
        for i=2,#\$actions do
            local alias = \$actions[i]
            local \$alias_args = a_List{"\(nomsu environment)", "\(this tree)", unpack(alias:get_args())}
            lua:add("\\nCOMPILE_RULES[", alias:get_stub():as_lua(), "] = ")
            if \$alias_args == \$args then
                lua:add("COMPILE_RULES[", \$actions[1]:get_stub():as_lua(), "]")
            else
                lua:add("function(")
                local \$compiled_alias_args = a_List{"\(nomsu environment)", "\(this tree)"};
                for i=3,#\$alias_args do \$compiled_alias_args[i] = \(nomsu environment):compile(\$alias_args[i]) end
                lua:concat_add(\$compiled_alias_args, ", ")
                lua:add(") return COMPILE_RULES[", \$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 $)]:
        (foo $x) means:
            $y = ($x + 1)
            return $y
        
        unless ((foo 10) == 11):
            fail "Action didn't work."
        
        unless ($y == (nil)):
            fail "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(\(nomsu environment):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
            at_1_fail(\$action, "Compile error: This is not an action or method call.")
        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(\(nomsu environment):compile(\$actions[1][1]), ".", \$actions[1][2]:get_\
        ..stub():as_lua_id())
            or LuaCode(\$actions[1]:get_stub():as_lua_id()))
        local \$args = a_List(\$actions[1]:get_args())
        for i=2,#\$actions do
            local alias = \$actions[i]
            local \$alias_args = a_List(alias:get_args())
            lua:add("\\n")
            if alias.type == "MethodCall" then
                lua:add(\(nomsu environment):compile(alias[1]), ".", alias[2]: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:
    $loc = 99
    external ($glob = 99)

test:
    assume $loc == (nil)
    assume $glob == 99

(external $body) compiles to:
    lua> ("
        local lua = \($body as lua)
        lua:remove_free_vars()
        return lua
    ")

test:
    [$x, $y] = ["outer", "outer"]
    external:
        (set external x local y) means:
            with external [$x]:
                $x = "inner"
                $y = "inner"
    
    set external x local y
    unless (($x == "inner") and ($y == "outer")):
        fail "'with external' failed."

(with external $externals $body) compiles to:
    lua> ("
        local body_lua = \($body as lua)
        local varnames = {}
        for i,\$v in ipairs(\$externals) do
            varnames[i] = \($v as lua):text()
        end
        body_lua:remove_free_vars(varnames)
        return body_lua
    ")

test:
    (swap $x and $y) parses as
        do:
            $tmp = $x
            $x = $y
            $y = $tmp

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

($actions all parse as $body) compiles to:
    lua> ("
        local replacements = {}
        if \$actions.type ~= "List" then
            at_1_fail(\$actions, "Compile error: This should be a list.")
        end
        for i,arg in ipairs(\$actions[1]:get_args()) do
            replacements[arg[1]] = \(nomsu environment):compile(arg):text()
        end
        local function make_tree(t)
            if SyntaxTree:is_instance(t) and t.type == "Var" then
                if replacements[t:as_var()] then
                    return replacements[t:as_var()]
                else
                    return "SyntaxTree{mangle("..t:as_var():as_lua().."), type="..t.type:as_lua(\
        ..)..", source=".._1_as_text(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.."= ".._1_as_text(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 _1_as_text(t)
            else
                return t:as_lua()
            end
        end
        local \$new_body = LuaCode:from(\$body.source,
            "local mangle = mangler()",
            "\\nreturn ", make_tree(\$body))
        return \(\(\$actions all compile to \$new_body) as lua)
    ")

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

[$action parses as $body] all parse as ([$action] all parse as $body)
(nomsu environment, $tree as lua expr) means:
    lua> ("
        local tree_lua = \(nomsu environment):compile(\$tree)
        if \$tree.type == 'Block' and #\$tree > 1 then
            tree_lua = LuaCode:from(\$tree.source, '(function()\\n    ', tree_lua, '\\nend)()')
        end
        return tree_lua
    ")

### Need to make sure the proper environment is used for compilation (i.e. the caller's environment)
($tree as lua expr) compiles to \(nomsu environment, \$tree as lua expr)

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

external:
    [$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
                at_1_fail(\$var, "Compile error: "..
                    "This is supposed to be something that compiles to a valid Lua identifier. "..
                    "Hint: This should probably be a variable.")
            end
            return lua
        ")

test:
    (num args (*extra arguments*)) means #(*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 (*extra arguments*).3
    assume (third arg 5 6 7 8) == 7

(*extra arguments*) compiles to "..."
($ is syntax tree) compiles to "SyntaxTree:is_instance(\($ as lua expr))"
external:
    ($ is $kind syntax tree) means
        =lua "SyntaxTree:is_instance(\$) and \$.type == \$kind"

external:
    (match $tree with $patt) means:
        lua> ("
            if \$patt.type == "Var" then return a_Dict{[\$patt:as_var()]=\$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 = a_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
                "two"
            ")
        ) == "\"one\\n\\\"two\\\"\""

external:
    (quote $) means ($ as text, as lua)

test:
    assume (lua type of {}) == "table"
    assume (type of {}) == "a Dict"
    assume ((type of 5) == "a Number")
    assume ({} is "a Dict")
    assume ("" is text)
    assume ("" is "Text")
    assume (5 is "a Number")
    assume ((->) is "an Action")
    assume ((yes) is "a Boolean")
    assume ("" isn't "a Dict")

external:
    ($ is text) means (=lua "\(lua type of $) == 'string'")
    [$ is not text, $ isn't text] all mean (=lua "\(lua type of $) ~= 'string'")
    (type of $) means:
        lua> ("
            local mt = getmetatable(\$)
            if mt and mt.__type then return mt.__type end
            if \$ == nil then return 'nil' end
            local lua_type = \(lua type of $)
            return 'a '..lua_type:capitalized()
        ")
    
    ($ is $type) means:
        lua> ("
            local class = getmetatable(\$)
            ::check_parent::
            if not class or not class.__type then return 'a '..\(lua type of $):capitalized() == \$type end
            if class.__type == \$type then return true end
            local class_mt = getmetatable(class)
            if class_mt.__index and class_mt.__index ~= class then
                class = class_mt.__index
                goto check_parent
            end
            return false
        ")

[$ isn't $type, $ is not $type] all parse as (not ($ is $type))

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

test:
    assume ("Action" tree with "foo" ("Var" tree with "x")) == \(foo $x)

external:
    ($type tree with (*extra arguments*)) means
        SyntaxTree (=lua "{type=\$type, ...}")
    
    ($type tree from $source) means
        SyntaxTree (=lua "{type=\$type, source=\$source}")
    
    ($type tree from $source with (*extra arguments*)) means
        SyntaxTree (=lua "{type=\$type, source=\$source, ...}")

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(\(nomsu environment):compile((select(i, ...))))
        end
        lua:add(" end")
        return lua
    ")

### Convenience helper:
(return Lua (*extra arguments*)) compiles to \(return (Lua \(*extra arguments*)))

### Literals
(yes) compiles to "(true)"
(no) compiles to "(false)"
[nothing, nil, null] all compile to "(nil)"
(command line args) compiles to "COMMAND_LINE_ARGS"

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

(at compilation $expr) compiles to:
    lua> ("
        local value = \(nomsu environment):run(\(\(return \$expr)))
        if lua_type_of(value) == 'table' or lua_type_of(value) == 'string' and value.as_lua then
            return LuaCode(value:as_lua())
        else
            return LuaCode(tostring(value))
        end
    ")

test:
    using compile rules:
        (yes) compiles to "3"
        assume $(COMPILE RULES).yes
    ..do:
        assume (yes) == 3
    assume (yes) == (=lua "true")

(using compile rules $rules do $body) compiles to:
    lua> ("
        local env = \(new environment)
        env:run(\$rules)
        local lua = env:compile(\$body)
        return lua
    ")

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

### TODO: Remove shim
($tree with $t -> $replacement) parses as ($tree, with ($t -> $replacement))
[tree $tree with vars $replacements, $tree with vars $replacements] all parse as
    $tree, with $replacements
($tree has subtree $match_tree) parses as ($tree, contains $match_tree)