metaprogramming.nom

(520 lines)
   1 #!/usr/bin/env nomsu -V7.0.0
   2 ###
   3     This File contains actions for making actions and compile-time actions and some helper
   4     functions to make that easier.
   5     
   6 lua> ("
   7     do
   8         local mangle_index = 0
   9         function mangler()
  10             local my_mangle_index = mangle_index
  11             mangle_index = mangle_index + 1
  12             return function(varname)
  13                 return (varname..(("\\3%X"):format(my_mangle_index))):as_lua_id()
  14             end
  15         end
  16     end
  17     COMPILE_RULES["define mangler"] = function(\(nomsu environment), _tree)
  18         return LuaCode("local mangle = mangler()")
  19     end
  20     COMPILE_RULES["this tree"] = function(\(nomsu environment), _tree)
  21         return LuaCode("_tree")
  22     end
  23 ")
  24 
  25 lua> ("
  26     COMPILE_RULES["1 ->"] = function(\(nomsu environment), _tree, \$args, \$body)
  27         if not \$args and not \$body then \$args, \$body = {}, SyntaxTree{type='Action', "do", "nothing"}
  28         elseif \$args and not \$body then \$args, \$body = {}, \$args end
  29         local body_lua = SyntaxTree:is_instance(\$body) and \(nomsu environment):compile(\$body) or \$body
  30         if SyntaxTree:is_instance(\$body) and \$body.type ~= "Block" then body_lua:prepend("return ") end
  31         local lua = LuaCode("(function(")
  32         if SyntaxTree:is_instance(\$args) and (\$args.type == "Action" or \$args.type == "MethodCall") then
  33             \$args = \$args:get_args()
  34         elseif SyntaxTree:is_instance(\$args) and \$args.type == "Var" then \$args = {\$args} end
  35         for i, arg in ipairs(\$args) do
  36             local arg_lua = SyntaxTree:is_instance(arg) and \(nomsu environment):compile(arg):text() or arg
  37             if arg_lua == "..." then
  38                 if i < #\$args then
  39                     at_1_fail(SyntaxTree:is_instance(arg) and arg or nil,
  40                         "Compile error: Extra arguments must come last. "..
  41                         "Hint: Try removing any arguments after (*extra arguments*)")
  42                 end
  43             elseif not arg_lua:is_lua_id() then
  44                 at_1_fail(SyntaxTree:is_instance(arg) and arg or nil,
  45                     "Compile error: This does not compile to a Lua identifier ("..arg_lua.."),"..
  46                     "so it can't be used as a function argument. "..
  47                     "Hint: This should probably be a Nomsu variable instead (like $x).")
  48             end
  49             lua:add(i > 1 and ", " or "", arg_lua)
  50             body_lua:remove_free_vars({arg_lua})
  51         end
  52         body_lua:declare_locals()
  53         lua:add(")\\n    ", body_lua, "\\nend)")
  54         return lua
  55     end
  56     COMPILE_RULES["->"] = COMPILE_RULES["1 ->"]
  57     COMPILE_RULES["for"] = COMPILE_RULES["1 ->"]
  58     
  59     COMPILE_RULES["\\\\"] = function(\(nomsu environment), _tree, escaped)
  60         local function escape(t)
  61             if t.type == "Action" and t:get_stub() == "\\\\" and #t == 2 then
  62                 return \(nomsu environment):compile(t[2])
  63             else
  64                 local bits = {}
  65                 table.insert(bits, "type="..t.type:as_lua())
  66                 if t.source then
  67                     table.insert(bits, "source="..t.source:as_lua())
  68                 end
  69                 for i,b in ipairs(t) do
  70                     table.insert(bits, lua_type_of(b) == 'string' and b:as_lua() or escape(b))
  71                 end
  72                 local lua = LuaCode:from(t.source, "SyntaxTree{")
  73                 lua:concat_add(bits, ", ")
  74                 lua:add("}")
  75                 return lua
  76             end
  77         end
  78         return escape(escaped)
  79     end
  80 ")
  81 
  82 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  83 
  84 test:
  85     (five) compiles to "5"
  86 
  87 test:
  88     unless ((five) == 5):
  89         fail "Compile to expression failed."
  90     (loc x) compiles to "local x = 99;"
  91 
  92 test:
  93     lua> "do"
  94     loc x
  95     unless ($x == 99):
  96         fail "Compile to statements with locals failed."
  97     lua> "end"
  98     unless ($x == (nil)):
  99         fail "Failed to properly localize a variable."
 100     
 101     (asdf) compiles to:
 102         $tmp = ""
 103         return (Lua $tmp)
 104 
 105 test:
 106     asdf
 107     unless ($tmp == (nil)):
 108         fail "compile to is leaking variables"
 109 
 110 lua> ("
 111     COMPILE_RULES["1 compiles to"] = function(\(nomsu environment), \(this tree), \$action, \$body)
 112         local \$args = a_List{"\(nomsu environment)", "\(this tree)"}
 113         if \$body.type == "Text" then
 114             \$body = SyntaxTree{source=\$body.source, type="Action", "Lua", \$body}
 115         end
 116         if not (\$action.type == "Action" or
 117                 (\$action.type == "EscapedNomsu" and \$action[1].type == "Action") or
 118                 \$action.type == "MethodCall") then
 119             at_1_fail(\$action.source, "Compile error: "..
 120                 "This first argument to (* compiles to *) is neither an action nor an escaped \
 121     ..action (it's a "..\$action.type.."). "..
 122                 "Hint: This should probably be an action like:\\n"
 123                 .."(foo $x) compiles to \\"(\\\\($x as lua) + 1)\\"")
 124         end
 125         if \$action.type == "EscapedNomsu" then
 126             for _,a in ipairs(\$action[1]) do
 127                 if a.type == "EscapedNomsu" then \$args:add(a[1]) end
 128             end
 129             return LuaCode("COMPILE_RULES[", \($action as lua), ":get_stub()] = ",
 130                 \(\(\$args -> \$body) as lua))
 131         else
 132             for _,a in ipairs(\$action:get_args()) do \$args:add(a) end
 133             return LuaCode("COMPILE_RULES[", \$action:get_stub():as_lua(),
 134                 "] = ", \(\(\$args -> \$body) as lua))
 135         end
 136     end
 137 ")
 138 
 139 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 140 
 141 ($actions all compile to $body) compiles to:
 142     lua> ("
 143         if \$actions.type ~= "List" then
 144             at_1_fail(\$actions, "Compile error: This should be a list of actions.")
 145         end
 146         local lua = \(\(\$actions.1 compiles to \$body) as lua)
 147         local \$args = a_List{"\(nomsu environment)", "\(this tree)", unpack(\$actions[1]:get_args())}
 148         local \$compiled_args = a_List{"\(nomsu environment)", "\(this tree)"};
 149         for i=3,#\$args do \$compiled_args[i] = \(nomsu environment):compile(\$args[i]) end
 150         for i=2,#\$actions do
 151             local alias = \$actions[i]
 152             local \$alias_args = a_List{"\(nomsu environment)", "\(this tree)", unpack(alias:get_args())}
 153             lua:add("\\nCOMPILE_RULES[", alias:get_stub():as_lua(), "] = ")
 154             if \$alias_args == \$args then
 155                 lua:add("COMPILE_RULES[", \$actions[1]:get_stub():as_lua(), "]")
 156             else
 157                 lua:add("function(")
 158                 local \$compiled_alias_args = a_List{"\(nomsu environment)", "\(this tree)"};
 159                 for i=3,#\$alias_args do \$compiled_alias_args[i] = \(nomsu environment):compile(\$alias_args[i]) end
 160                 lua:concat_add(\$compiled_alias_args, ", ")
 161                 lua:add(") return COMPILE_RULES[", \$actions[1]:get_stub():as_lua(), "](")
 162                 lua:concat_add(\$compiled_args, ", ")
 163                 lua:add(") end")
 164             end
 165         end
 166         return lua
 167     ")
 168 
 169 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 170 
 171 test:
 172     (foo $x) means "outer"
 173     with [$(foo $)]:
 174         (foo $x) means:
 175             $y = ($x + 1)
 176             return $y
 177         
 178         unless ((foo 10) == 11):
 179             fail "Action didn't work."
 180         
 181         unless ($y == (nil)):
 182             fail "Action leaked a local into globals."
 183         
 184         (baz $) parses as (foo $)
 185     assume ((foo 1) == "outer")
 186 
 187 ($action means $body) compiles to:
 188     lua> ("
 189         local lua = LuaCode()
 190         if \$action.type == "MethodCall" then
 191             lua:add(\(nomsu environment):compile(\$action[1]), ".", \$action[2]:get_stub():as_lua_id())
 192         elseif \$action.type == "Action" then
 193             lua:add(\$action:get_stub():as_lua_id())
 194             lua:add_free_vars({\$action:get_stub():as_lua_id()})
 195         else
 196             at_1_fail(\$action, "Compile error: This is not an action or method call.")
 197         end
 198         lua:add(" = ", \(\(\$action -> \$body) as lua), ";")
 199         return lua
 200     ")
 201 
 202 ($actions all mean $body) compiles to:
 203     lua> ("
 204         local lua = \(\(\$actions.1 means \$body) as lua)
 205         local first_def = (\$actions[1].type == "MethodCall"
 206             and LuaCode(\(nomsu environment):compile(\$actions[1][1]), ".", \$actions[1][2]:get_\
 207         ..stub():as_lua_id())
 208             or LuaCode(\$actions[1]:get_stub():as_lua_id()))
 209         local \$args = a_List(\$actions[1]:get_args())
 210         for i=2,#\$actions do
 211             local alias = \$actions[i]
 212             local \$alias_args = a_List(alias:get_args())
 213             lua:add("\\n")
 214             if alias.type == "MethodCall" then
 215                 lua:add(\(nomsu environment):compile(alias[1]), ".", alias[2]:get_stub():as_lua_id())
 216             else
 217                 lua:add(alias:get_stub():as_lua_id())
 218                 lua:add_free_vars({alias_name})
 219             end
 220             if \$args == \$alias_args then
 221                 lua:add(" = ", first_def, ";")
 222             else
 223                 lua:add(" = ", \(\(\$alias_args -> \$actions.1) as lua), ";")
 224             end
 225         end
 226         return lua
 227     ")
 228 
 229 test:
 230     $loc = 99
 231     external ($glob = 99)
 232 
 233 test:
 234     assume $loc == (nil)
 235     assume $glob == 99
 236 
 237 (external $body) compiles to:
 238     lua> ("
 239         local lua = \($body as lua)
 240         lua:remove_free_vars()
 241         return lua
 242     ")
 243 
 244 test:
 245     [$x, $y] = ["outer", "outer"]
 246     external:
 247         (set external x local y) means:
 248             with external [$x]:
 249                 $x = "inner"
 250                 $y = "inner"
 251     
 252     set external x local y
 253     unless (($x == "inner") and ($y == "outer")):
 254         fail "'with external' failed."
 255 
 256 (with external $externals $body) compiles to:
 257     lua> ("
 258         local body_lua = \($body as lua)
 259         local varnames = {}
 260         for i,\$v in ipairs(\$externals) do
 261             varnames[i] = \($v as lua):text()
 262         end
 263         body_lua:remove_free_vars(varnames)
 264         return body_lua
 265     ")
 266 
 267 test:
 268     (swap $x and $y) parses as
 269         do:
 270             $tmp = $x
 271             $x = $y
 272             $y = $tmp
 273 
 274 test:
 275     [$1, $2] = [1, 2]
 276     swap $1 and $2
 277     unless (($1 == 2) and ($2 == 1)):
 278         fail "'parse $ as $' failed on 'swap $ and $'"
 279     [$tmp, $tmp2] = [1, 2]
 280     swap $tmp and $tmp2
 281     unless (($tmp == 2) and ($tmp2 == 1)):
 282         fail "'parse $ as $' variable mangling failed."
 283 
 284 ($actions all parse as $body) compiles to:
 285     lua> ("
 286         local replacements = {}
 287         if \$actions.type ~= "List" then
 288             at_1_fail(\$actions, "Compile error: This should be a list.")
 289         end
 290         for i,arg in ipairs(\$actions[1]:get_args()) do
 291             replacements[arg[1]] = \(nomsu environment):compile(arg):text()
 292         end
 293         local function make_tree(t)
 294             if SyntaxTree:is_instance(t) and t.type == "Var" then
 295                 if replacements[t:as_var()] then
 296                     return replacements[t:as_var()]
 297                 else
 298                     return "SyntaxTree{mangle("..t:as_var():as_lua().."), type="..t.type:as_lua(\
 299         ..)..", source=".._1_as_text(t.source):as_lua().."}"
 300                 end
 301             elseif SyntaxTree:is_instance(t) then
 302                 local ret = {}
 303                 local i = 1
 304                 for k, v in pairs(t) do
 305                     if k == i then
 306                         ret[#ret+1] = make_tree(t[i])
 307                         i = i + 1
 308                     elseif k == "source" then
 309                         ret[#ret+1] = k.."= ".._1_as_text(v):as_lua()
 310                     elseif lua_type_of(k) == 'string' and k:is_a_lua_id() then
 311                         ret[#ret+1] = k.."= "..make_tree(v)
 312                     else
 313                         ret[#ret+1] = "["..make_tree(k).."]= "..make_tree(v)
 314                     end
 315                 end
 316                 return "SyntaxTree{"..table.concat(ret, ", ").."}"
 317             elseif lua_type_of(t) == 'number' then
 318                 return _1_as_text(t)
 319             else
 320                 return t:as_lua()
 321             end
 322         end
 323         local \$new_body = LuaCode:from(\$body.source,
 324             "local mangle = mangler()",
 325             "\\nreturn ", make_tree(\$body))
 326         return \(\(\$actions all compile to \$new_body) as lua)
 327     ")
 328 
 329 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 330 
 331 [$action parses as $body] all parse as ([$action] all parse as $body)
 332 (nomsu environment, $tree as lua expr) means:
 333     lua> ("
 334         local tree_lua = \(nomsu environment):compile(\$tree)
 335         if \$tree.type == 'Block' and #\$tree > 1 then
 336             tree_lua = LuaCode:from(\$tree.source, '(function()\\n    ', tree_lua, '\\nend)()')
 337         end
 338         return tree_lua
 339     ")
 340 
 341 ### Need to make sure the proper environment is used for compilation (i.e. the caller's environment)
 342 ($tree as lua expr) compiles to \(nomsu environment, \$tree as lua expr)
 343 
 344 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 345 
 346 external:
 347     [$var as lua identifier, $var as lua id] all mean:
 348         lua> ("
 349             local lua = \($var as lua)
 350             if not lua:text():is_a_lua_id() then
 351                 at_1_fail(\$var, "Compile error: "..
 352                     "This is supposed to be something that compiles to a valid Lua identifier. "..
 353                     "Hint: This should probably be a variable.")
 354             end
 355             return lua
 356         ")
 357 
 358 test:
 359     (num args (*extra arguments*)) means #(*extra arguments*)
 360     assume (num args 1 2 3) == 3
 361     (extra args (*extra arguments*)) means [*extra arguments*]
 362     assume (extra args 1 2 3) == [1, 2, 3]
 363     (third arg (*extra arguments*)) means (*extra arguments*).3
 364     assume (third arg 5 6 7 8) == 7
 365 
 366 (*extra arguments*) compiles to "..."
 367 ($ is syntax tree) compiles to "SyntaxTree:is_instance(\($ as lua expr))"
 368 external:
 369     ($ is $kind syntax tree) means
 370         =lua "SyntaxTree:is_instance(\$) and \$.type == \$kind"
 371 
 372 external:
 373     (match $tree with $patt) means:
 374         lua> ("
 375             if \$patt.type == "Var" then return a_Dict{[\$patt:as_var()]=\$tree} end
 376             if \$patt.type == "Action" and \$patt:get_stub() ~= \$tree:get_stub() then return nil end
 377             if #\$patt ~= #\$tree then return nil end
 378             local matches = a_Dict{}
 379             for \($i)=1,#\$patt do
 380                 if SyntaxTree:is_instance(\$tree[\$i]) then
 381                     local submatch = \(match $tree.$i with $patt.$i)
 382                     if not submatch then return nil end
 383                     for k,v in pairs(submatch) do
 384                         if matches[k] and matches[k] ~= v then return nil end
 385                         matches[k] = v
 386                     end
 387                 end
 388             end
 389             return matches
 390         ")
 391 
 392 test:
 393     assume
 394         (
 395             quote ("
 396                 one
 397                 "two"
 398             ")
 399         ) == "\"one\\n\\\"two\\\"\""
 400 
 401 external:
 402     (quote $) means ($ as text, as lua)
 403 
 404 test:
 405     assume (lua type of {}) == "table"
 406     assume (type of {}) == "a Dict"
 407     assume ((type of 5) == "a Number")
 408     assume ({} is "a Dict")
 409     assume ("" is text)
 410     assume ("" is "Text")
 411     assume (5 is "a Number")
 412     assume ((->) is "an Action")
 413     assume ((yes) is "a Boolean")
 414     assume ("" isn't "a Dict")
 415 
 416 external:
 417     ($ is text) means (=lua "\(lua type of $) == 'string'")
 418     [$ is not text, $ isn't text] all mean (=lua "\(lua type of $) ~= 'string'")
 419     (type of $) means:
 420         lua> ("
 421             local mt = getmetatable(\$)
 422             if mt and mt.__type then return mt.__type end
 423             if \$ == nil then return 'nil' end
 424             local lua_type = \(lua type of $)
 425             return 'a '..lua_type:capitalized()
 426         ")
 427     
 428     ($ is $type) means:
 429         lua> ("
 430             local class = getmetatable(\$)
 431             ::check_parent::
 432             if not class or not class.__type then return 'a '..\(lua type of $):capitalized() == \$type end
 433             if class.__type == \$type then return true end
 434             local class_mt = getmetatable(class)
 435             if class_mt.__index and class_mt.__index ~= class then
 436                 class = class_mt.__index
 437                 goto check_parent
 438             end
 439             return false
 440         ")
 441 
 442 [$ isn't $type, $ is not $type] all parse as (not ($ is $type))
 443 
 444 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 445 
 446 test:
 447     assume ("Action" tree with "foo" ("Var" tree with "x")) == \(foo $x)
 448 
 449 external:
 450     ($type tree with (*extra arguments*)) means
 451         SyntaxTree (=lua "{type=\$type, ...}")
 452     
 453     ($type tree from $source) means
 454         SyntaxTree (=lua "{type=\$type, source=\$source}")
 455     
 456     ($type tree from $source with (*extra arguments*)) means
 457         SyntaxTree (=lua "{type=\$type, source=\$source, ...}")
 458 
 459 test:
 460     (foo) means:
 461         return 100 200 300
 462     assume (select 2 (foo)) == 200
 463 
 464 ### Return statement is wrapped in a do..end block because Lua is unhappy if you
 465     put code after a return statement, unless you wrap it in a block.
 466 (return (*extra arguments*)) compiles to:
 467     lua> ("
 468         local lua = \(Lua "do return ")
 469         for i=1,select('#',...) do
 470             if i > 1 then lua:add(", ") end
 471             lua:add(\(nomsu environment):compile((select(i, ...))))
 472         end
 473         lua:add(" end")
 474         return lua
 475     ")
 476 
 477 ### Convenience helper:
 478 (return Lua (*extra arguments*)) compiles to \(return (Lua \(*extra arguments*)))
 479 
 480 ### Literals
 481 (yes) compiles to "(true)"
 482 (no) compiles to "(false)"
 483 [nothing, nil, null] all compile to "(nil)"
 484 (command line args) compiles to "COMMAND_LINE_ARGS"
 485 
 486 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 487 
 488 (at compilation $expr) compiles to:
 489     lua> ("
 490         local value = \(nomsu environment):run(\(\(return \$expr)))
 491         if lua_type_of(value) == 'table' or lua_type_of(value) == 'string' and value.as_lua then
 492             return LuaCode(value:as_lua())
 493         else
 494             return LuaCode(tostring(value))
 495         end
 496     ")
 497 
 498 test:
 499     using compile rules:
 500         (yes) compiles to "3"
 501         assume $(COMPILE RULES).yes
 502     ..do:
 503         assume (yes) == 3
 504     assume (yes) == (=lua "true")
 505 
 506 (using compile rules $rules do $body) compiles to:
 507     lua> ("
 508         local env = \(new environment)
 509         env:run(\$rules)
 510         local lua = env:compile(\$body)
 511         return lua
 512     ")
 513 
 514 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 515 
 516 ### TODO: Remove shim
 517 ($tree with $t -> $replacement) parses as ($tree, with ($t -> $replacement))
 518 [tree $tree with vars $replacements, $tree with vars $replacements] all parse as
 519     $tree, with $replacements
 520 ($tree has subtree $match_tree) parses as ($tree, contains $match_tree)