--*-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 'bytecode'
require '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(msg) end
   x = f:read'*a'
   f:close()
   
   POINT 'luastring', 'string' -- x is the source

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

   local status -- status = compilation success
   local lx=x
   if SHOW_METABUGS
   -- If SHOW_METABUGS is true, errors should be attributed to a parser bug.
   then status, x = true, mlp.chunk (lx)
   -- If SHOW_METABUGS is false, errors should be attributed to an invalid entry.
   else status, x = pcall (mlp.chunk, lx) end
   -- FIXME: this test seems wrong ???
   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:match "[^:]+:[0-9]+: (.*)" or x
      printf("Parsing error in %s line %s, char %s: \n%s",
             filename or "?", lx.line, lx.i, x)
      return nil
   end
   
   POINT 'ast', 'table' -- x is the AST
   x = bytecode.metalua_compile(x) 
   x.source = name
   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 error "Bad converter name" end
   local osrc, odst = mlc.order[src], mlc.order[dst]   
   if not src or not dst then error ("malformed mlc function "..name) end
   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.

function loadstring(str, name)
   if type(str) ~= 'string' then error 'string expected' end
   if str:match '^\027LuaQ' then return string.undump(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)
   return mlc.function_of_luastring(str, name)
end

function loadfile(filename)
   local f = io.open(filename, 'rb')
   local src = f:read '*a'
   f:close()
   return loadstring(src, '@'..filename)
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



debug.getregistry().loadstring = metalua_loadstring
debug.getregistry().loadfile = metalua_loadfile