nomsu/lib/core/metaprogramming.nom
Bruce Hill a1849da175 Autoformat (mostly just to do with the new
blank-line-after-end-of-multi-indent-block rule
2019-03-27 15:22:46 -07:00

520 lines
18 KiB
Plaintext

#!/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)