mlc.mlua

--*-lua-*-----------------------------------------------------------------------
-- This module is written in a more hackish way than necessary, just
-- because I can.  Its core feature is to dynamically generate a
-- function that converts from a source format to a destination
-- format; these formats are the various ways to represent a piece of
-- program, from the source file to the executable function. Legal
-- formats are:
--
-- * luafile:    the name of a file containing sources.
-- * luastring:  these sources as a single string.
-- * lexstream:  a stream of lexemes.
-- * ast:        an abstract syntax tree.
-- * proto:      a (Yueliang) struture containing a high level 
--               representation of bytecode. Largely based on the 
--               Proto structure in Lua's VM.
-- * luacstring: a string dump of the function, as taken by 
--               loadstring() and produced by string.dump().
-- * function:   an executable lua function in RAM.
--
--------------------------------------------------------------------------------

require 'metalua.bytecode'
require 'metalua.mlp'

mlc = { }
setmetatable(mlc, mlc)
mlc.metabugs = false

--------------------------------------------------------------------------------
-- Order of the transformations. if 'a' is on the left of 'b', then a 'a' can
-- be transformed into a 'b' (but not the other way around). Since the table
-- is transposed, the test is 'if mlc.order.a > mlc.order.b then error(...) end'
--------------------------------------------------------------------------------
mlc.order = table.transpose{ 
   'luafile',  'luastring', 'lexstream', 'ast', 'proto', 
   'luacstring', 'function' }

--------------------------------------------------------------------------------
-- The macro 'POINT(point_name, expected_type)' creates an entry point in the
-- 'mlc.convert' function. When we convert a 'a' into a 'b', FIXME
--------------------------------------------------------------------------------
-{ block:
   jump_to_point = `If{ }
   function point_builder(args)
      local name, point_type, code = unpack(args)
      table.insert(jump_to_point, +{src_fmt == -{name}}) -- if source format is 'name'
      table.insert(jump_to_point, { `Goto{name} })       -- then jump to label  'name'
      return {
         ---------------------------------------------------
         -- Stop if this is the destination format
         ---------------------------------------------------
         +{stat: if dst_fmt == -{name} then return x end },
         ---------------------------------------------------
         -- Start here if the source format matches
         ---------------------------------------------------
         `Label{ name },
         -- +{print(" *** point "..-{name})}, -- debug trace
         ---------------------------------------------------
         -- Check that the type matches
         ---------------------------------------------------
         +{stat: assert (-{point_type} == type(x), "Invalid source type") },
         -- perform transformation operations to the next type
         }
   end
   mlp.lexer:add 'POINT'
   mlp.stat:add{ 'POINT', mlp.string, ',', mlp.string, builder = point_builder }
} -- end of meta-block

function mlc.convert (x, src_fmt, dst_fmt, name)
   -- printf(" *** Convert a %s into a %s", src_fmt, dst_fmt)

   -{ jump_to_point }
   error "Can't perform this conversion (bad src name)"

   POINT 'luafile', 'string' -- x is the src file's name

   if not name then name = '@'..x end
   local f, msg = io.open(x, "rb")
   if not f then error("While trying to open file '"..x.."': "..msg) end
   x = f:read'*a'
   f:close()
   
   POINT 'luastring', 'string' -- x is the source

   x = mlp.lexer:newstream(x, name)      
   
   POINT 'lexstream', 'table' -- x is the lexeme stream

   local status -- status = compilation success
   local lx=x
   if mlc.metabugs
   -- If metabugs is true, errors should be attributed to a parser bug.
   then status, x = true, mlp.chunk (lx)
   -- If metabugs is false, errors should be attributed to an invalid entry.
   else status, x = pcall (mlp.chunk, lx) end
   -- FIXME: this test seems wrong ??? Or is it the message?
   if status and lx:peek().tag ~= "Eof"
   then status, x = false, "Premature Eof" 
   elseif status and lx:peek().tag == "End"
   then status, x = false, "Unexpected 'end' keyword" end
   if not status and x then 
      -- x = error msg; get rid of ???
      x = x:strmatch "[^:]+:[0-9]+: (.*)" or x
      local li = lx:lineinfo_left()
      error (string.format (
         "Parsing error in %s line %s, column %i, char %s: \n%s",
         name or "<nofilename>", li[1], li[2], li[3], x), 2)
      return nil
   end
   
   if x then x.source = name end -- TODO [EVE] store debug info in the special part of ast

   POINT 'ast', 'table' -- x is the AST
   x = bytecode.metalua_compile(x, name or x.source) 
   POINT 'proto', 'table' 
   x = bytecode.dump_string (x)
   POINT 'luacstring', 'string' -- normally x is a bytecode dump
   x = string.undump(x, name)
   POINT 'function', 'function' 
   error "Can't perform this conversion (bad dst name)"
end

--------------------------------------------------------------------------------
-- Dynamically compose a conversion function from a function name
-- xxx_of_yyy() or yyy_to_xxx().
--------------------------------------------------------------------------------
function mlc.__index(_, name)   
   local  dst, src = name:strmatch '^([a-z]+)_of_([a-z]+)$'
   if not dst then src, dst = name:strmatch '^([a-z]+)_to_([a-z]+)$' end
   if not (src and dst) then return nil end -- not a converter
   local  osrc, odst = mlc.order[src], mlc.order[dst] -- check existence of formats
   if not osrc then error ("unknown source format "..src) end
   if not odst then error ("unknown destination format "..src) end
   if osrc > odst then error "Can't convert in this direction" end
   return |x, name| mlc.convert(x, src, dst, name) 
end

--------------------------------------------------------------------------------
-- This case isn't handled by the __index method, as it goes "in the wrong direction"
--------------------------------------------------------------------------------
mlc.function_to_luacstring = string.dump
mlc.luacstring_of_function = string.dump

--------------------------------------------------------------------------------
-- These are drop-in replacement for loadfile() and loadstring(). The
-- C functions will call them instead of the original versions if
-- they're referenced in the registry.
--------------------------------------------------------------------------------

lua_loadstring = loadstring
local lua_loadstring = loadstring
lua_loadfile = loadfile
local lua_loadfile = loadfile

function loadstring(str, name)
   if type(str) ~= 'string' then error 'string expected' end
   if str:match '^\027LuaQ' then return lua_loadstring(str) end
   local n = str:match '^#![^\n]*\n()'
   if n then str=str:sub(n, -1) end
   -- FIXME: handle erroneous returns (return nil + error msg)
   local success, f = pcall (mlc.function_of_luastring, str, name)
   if success then return f else return nil, f end
end

function loadfile(filename)
   local f, err_msg = io.open(filename, 'rb')
   if not f then return nil, err_msg end
   local success, src = pcall( f.read, f, '*a')
   pcall(f.close, f)
   if success then return loadstring (src, '@'..filename)
   else return nil, src end
end

function load(f, name)
   while true do
      local x = f()
      if not x then break end
      assert(type(x)=='string', "function passed to load() must return strings")
      table.insert(acc, x)
   end
   return loadstring(table.concat(x))
end

function dostring(src)
   local f, msg = loadstring(src)
   if not f then error(msg) end
   return f()
end

function dofile(name)
   local f, msg = loadfile(name)
   if not f then error(msg) end
   return f()
end