metalua/compiler/parser/meta.lua

   1 -------------------------------------------------------------------------------
   2 -- Copyright (c) 2006-2014 Fabien Fleutot and others.
   3 --
   4 -- All rights reserved.
   5 --
   6 -- This program and the accompanying materials are made available
   7 -- under the terms of the Eclipse Public License v1.0 which
   8 -- accompanies this distribution, and is available at
   9 -- http://www.eclipse.org/legal/epl-v10.html
  10 --
  11 -- This program and the accompanying materials are also made available
  12 -- under the terms of the MIT public license which accompanies this
  13 -- distribution, and is available at http://www.lua.org/license.html
  14 --
  15 -- Contributors:
  16 --     Fabien Fleutot - API and implementation
  17 --
  18 -------------------------------------------------------------------------------
  19
  20 -- Compile-time metaprogramming features: splicing ASTs generated during compilation,
  21 -- AST quasi-quoting helpers.
  22
  23 local gg       = require 'metalua.grammar.generator'
  24
  25 return function(M)
  26     local _M = gg.future(M)
  27     M.meta={ }
  28     local _MM = gg.future(M.meta)
  29
  30     --------------------------------------------------------------------------------
  31     -- External splicing: compile an AST into a chunk, load and evaluate
  32     -- that chunk, and replace the chunk by its result (which must also be
  33     -- an AST).
  34     --------------------------------------------------------------------------------
  35
  36     -- TODO: that's not part of the parser
  37     function M.meta.eval (ast)
  38         -- TODO: should there be one mlc per splice, or per parser instance?
  39         local mlc = require 'metalua.compiler'.new()
  40         local f = mlc :ast_to_function (ast, '=splice')
  41         local result=f(M) -- splices act on the current parser
  42         return result
  43     end
  44
  45     ----------------------------------------------------------------------------
  46     -- Going from an AST to an AST representing that AST
  47     -- the only hash-part key being lifted is `"tag"`.
  48     -- Doesn't lift subtrees protected inside a `Splice{ ... }.
  49     -- e.g. change `Foo{ 123 } into
  50     -- `Table{ `Pair{ `String "tag", `String "foo" }, `Number 123 }
  51     ----------------------------------------------------------------------------
  52     local function lift (t)
  53         --print("QUOTING:", table.tostring(t, 60,'nohash'))
  54         local cases = { }
  55         function cases.table (t)
  56             local mt = { tag = "Table" }
  57             --table.insert (mt, { tag = "Pair", quote "quote", { tag = "True" } })
  58             if t.tag == "Splice" then
  59                 assert (#t==1, "Invalid splice")
  60                 local sp = t[1]
  61                 return sp
  62             elseif t.tag then
  63                 table.insert (mt, { tag="Pair", lift "tag", lift(t.tag) })
  64             end
  65             for _, v in ipairs (t) do
  66                 table.insert (mt, lift(v))
  67             end
  68             return mt
  69         end
  70         function cases.number  (t) return { tag = "Number", t, quote = true } end
  71         function cases.string  (t) return { tag = "String", t, quote = true } end
  72         function cases.boolean (t) return { tag = t and "True" or "False", t, quote = true } end
  73         local f = cases [type(t)]
  74         if f then return f(t) else error ("Cannot quote an AST containing "..tostring(t)) end
  75     end
  76     M.meta.lift = lift
  77
  78     --------------------------------------------------------------------------------
  79     -- when this variable is false, code inside [-{...}] is compiled and
  80     -- avaluated immediately. When it's true (supposedly when we're
  81     -- parsing data inside a quasiquote), [-{foo}] is replaced by
  82     -- [`Splice{foo}], which will be unpacked by [quote()].
  83     --------------------------------------------------------------------------------
  84     local in_a_quote = false
  85
  86     --------------------------------------------------------------------------------
  87     -- Parse the inside of a "-{ ... }"
  88     --------------------------------------------------------------------------------
  89     function M.meta.splice_content (lx)
  90         local parser_name = "expr"
  91         if lx:is_keyword (lx:peek(2), ":") then
  92             local a = lx:next()
  93             lx:next() -- skip ":"
  94             assert (a.tag=="Id", "Invalid splice parser name")
  95             parser_name = a[1]
  96         end
  97         -- TODO FIXME running a new parser with the old lexer?!
  98         local parser = require 'metalua.compiler.parser'.new()
  99         local ast = parser [parser_name](lx)
 100         if in_a_quote then -- only prevent quotation in this subtree
 101             --printf("SPLICE_IN_QUOTE:\n%s", _G.table.tostring(ast, "nohash", 60))
 102             return { tag="Splice", ast }
 103         else -- convert in a block, eval, replace with result
 104             if parser_name == "expr" then ast = { { tag="Return", ast } }
 105             elseif parser_name == "stat"  then ast = { ast }
 106             elseif parser_name ~= "block" then
 107                 error ("splice content must be an expr, stat or block") end
 108             --printf("EXEC THIS SPLICE:\n%s", _G.table.tostring(ast, "nohash", 60))
 109             return M.meta.eval (ast)
 110         end
 111     end
 112
 113     M.meta.splice = gg.sequence{ "-{", _MM.splice_content, "}", builder=unpack }
 114
 115     --------------------------------------------------------------------------------
 116     -- Parse the inside of a "+{ ... }"
 117     --------------------------------------------------------------------------------
 118     function M.meta.quote_content (lx)
 119         local parser
 120         if lx:is_keyword (lx:peek(2), ":") then -- +{parser: content }
 121             local parser_name = M.id(lx)[1]
 122             parser = M[parser_name]
 123             lx:next() -- skip ":"
 124         else -- +{ content }
 125             parser = M.expr
 126         end
 127
 128         local prev_iq = in_a_quote
 129         in_a_quote = true
 130         --print("IN_A_QUOTE")
 131         local content = parser (lx)
 132         local q_content = M.meta.lift (content)
 133         in_a_quote = prev_iq
 134         return q_content
 135     end
 136
 137     return M
 138 end