MOOSE/Utils/luarocks/share/lua/5.1/metalua/compiler/bytecode/compile.lua

-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Kein-Hong Man, Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
--     Kein-Hong Man  - Initial implementation for Lua 5.0, part of Yueliang
--     Fabien Fleutot - Port to Lua 5.1, integration with Metalua
--
-------------------------------------------------------------------------------

----------------------------------------------------------------------
--
-- This code mainly results from the borrowing, then ruthless abuse, of
-- Yueliang's implementation of Lua 5.0 compiler.
--
---------------------------------------------------------------------

local pp = require 'metalua.pprint'

local luaK = require 'metalua.compiler.bytecode.lcode'
local luaP = require 'metalua.compiler.bytecode.lopcodes'

local debugf = function() end
--local debugf=printf

local stat = { }
local expr = { }

local M = { }

M.MAX_INT            = 2147483645 -- INT_MAX-2 for 32-bit systems (llimits.h)
M.MAXVARS            = 200        -- (llimits.h)
M.MAXUPVALUES        = 32         -- (llimits.h)
M.MAXPARAMS          = 100        -- (llimits.h)
M.LUA_MAXPARSERLEVEL = 200        -- (llimits.h)

-- from lobject.h
M.VARARG_HASARG   = 1
M.VARARG_ISVARARG = 2
M.VARARG_NEEDSARG = 4

local function hasmultret (k) 
   return k=="VCALL" or k=="VVARARG"
end

-----------------------------------------------------------------------
-- Some ASTs take expression lists as children; it should be
-- acceptible to give an expression instead, and to automatically
-- interpret it as a single element list. That's what does this
-- function, adding a surrounding list iff needed.
--
-- WARNING: "Do" is the tag for chunks, which are essentially lists.
-- Therefore, we don't listify stuffs with a "Do" tag.
-----------------------------------------------------------------------
local function ensure_list (ast)
   return ast.tag and ast.tag ~= "Do" and {ast} or ast end

-----------------------------------------------------------------------
-- Get a localvar structure { varname, startpc, endpc } from a 
-- (zero-based) index of active variable. The catch is: don't get
-- confused between local index and active index.
--
-- locvars[x] contains { varname, startpc, endpc };
-- actvar[i] contains the index of the variable in locvars
-----------------------------------------------------------------------
local function getlocvar (fs, i)
  return fs.f.locvars[fs.actvar[i]] 
end

local function removevars (fs, tolevel)
  while fs.nactvar > tolevel do
     fs.nactvar = fs.nactvar - 1
     -- There may be dummy locvars due to expr.Stat
     -- FIXME: strange that they didn't disappear?!
     local locvar = getlocvar (fs, fs.nactvar)
     --printf("[REMOVEVARS] removing var #%i = %s", fs.nactvar,
     --    locvar and tostringv(locvar) or "<nil>")
     if locvar then locvar.endpc = fs.pc end
  end
end

-----------------------------------------------------------------------
-- [f] has a list of all its local variables, active and inactive.
-- Some local vars can correspond to the same register, if they exist
-- in different scopes. 
-- [fs.nlocvars] is the total number of local variables, not to be
-- confused with [fs.nactvar] the numebr of variables active at the
-- current PC.
-- At this stage, the existence of the variable is not yet aknowledged,
-- since [fs.nactvar] and [fs.freereg] aren't updated.
-----------------------------------------------------------------------
local function registerlocalvar (fs, varname)
   --debugf("[locvar: %s = reg %i]", varname, fs.nlocvars)
   local f = fs.f
   f.locvars[fs.nlocvars] = { } -- LocVar
   f.locvars[fs.nlocvars].varname = varname
   local nlocvars = fs.nlocvars
   fs.nlocvars = fs.nlocvars + 1
   return nlocvars
end

-----------------------------------------------------------------------
-- update the active vars counter in [fs] by adding [nvars] of them,
-- and sets those variables' [startpc] to the current [fs.pc].
-- These variables were allready created, but not yet counted, by
-- new_localvar.
-----------------------------------------------------------------------
local function adjustlocalvars (fs, nvars)
   --debugf("adjustlocalvars, nvars=%i, previous fs.nactvar=%i,"..
   --       " #locvars=%i, #actvar=%i", 
   --       nvars, fs.nactvar, #fs.f.locvars, #fs.actvar)

   fs.nactvar = fs.nactvar + nvars
   for i = nvars, 1, -1 do
      --printf ("adjusting actvar #%i", fs.nactvar - i)
      getlocvar (fs, fs.nactvar - i).startpc = fs.pc
   end
end

------------------------------------------------------------------------
-- check whether, in an assignment to a local variable, the local variable
-- is needed in a previous assignment (to a table). If so, save original
-- local value in a safe place and use this safe copy in the previous
-- assignment.
------------------------------------------------------------------------
local function check_conflict (fs, lh, v)
  local extra = fs.freereg  -- eventual position to save local variable
  local conflict = false
  while lh do
    if lh.v.k == "VINDEXED" then
      if lh.v.info == v.info then  -- conflict?
        conflict = true
        lh.v.info = extra  -- previous assignment will use safe copy
      end
      if lh.v.aux == v.info then  -- conflict?
        conflict = true
        lh.v.aux = extra  -- previous assignment will use safe copy
      end
    end
    lh = lh.prev
  end
  if conflict then
    luaK:codeABC (fs, "OP_MOVE", fs.freereg, v.info, 0)  -- make copy
    luaK:reserveregs (fs, 1)
  end
end

-----------------------------------------------------------------------
-- Create an expdesc. To be updated when expdesc is lua-ified.
-----------------------------------------------------------------------
local function init_exp (e, k, i)
  e.f, e.t, e.k, e.info = luaK.NO_JUMP, luaK.NO_JUMP, k, i end

-----------------------------------------------------------------------
-- Reserve the string in tthe constant pool, and return an expdesc
-- referring to it.
-----------------------------------------------------------------------
local function codestring (fs, e, str)
  --printf( "codestring(%s)", disp.ast(str))
  init_exp (e, "VK", luaK:stringK (fs, str))
end

-----------------------------------------------------------------------
-- search for a local variable named [name] in the function being
-- built by [fs]. Doesn't try to visit upvalues.
-----------------------------------------------------------------------
local function searchvar (fs, name)
   for i = fs.nactvar - 1, 0, -1 do
      -- Because of expr.Stat, there can be some actvars which don't
      -- correspond to any locvar. Hence the checking for locvar's 
      -- nonnilness before getting the varname.
      local locvar = getlocvar(fs, i)
      if locvar and name == locvar.varname then 
         --printf("Found local var: %s; i = %i", tostringv(locvar), i)
         return i 
      end
   end
   return -1  -- not found
end

-----------------------------------------------------------------------
-- create and return a new proto [f]
-----------------------------------------------------------------------
local function newproto () 
  local f = {}
  f.k = {}
  f.sizek = 0
  f.p = {}
  f.sizep = 0
  f.code = {}
  f.sizecode = 0
  f.sizelineinfo = 0
  f.sizeupvalues = 0
  f.nups = 0
  f.upvalues = {}
  f.numparams = 0
  f.is_vararg = 0
  f.maxstacksize = 0
  f.lineinfo = {}
  f.sizelocvars = 0
  f.locvars = {}
  f.lineDefined = 0
  f.source = nil
  return f
end

------------------------------------------------------------------------
-- create and return a function state [new_fs] as a sub-funcstate of [fs].
------------------------------------------------------------------------
local function open_func (old_fs)
  local new_fs = { }
  new_fs.upvalues = { }
  new_fs.actvar = { }
  local f = newproto ()
  new_fs.f = f
  new_fs.prev = old_fs  -- linked list of funcstates
  new_fs.pc = 0
  new_fs.lasttarget = -1
  new_fs.jpc = luaK.NO_JUMP
  new_fs.freereg = 0
  new_fs.nk = 0
  new_fs.h = {}  -- constant table; was luaH_new call
  new_fs.np = 0
  new_fs.nlocvars = 0
  new_fs.nactvar = 0
  new_fs.bl = nil
  new_fs.nestlevel =  old_fs and old_fs.nestlevel or 0
  f.maxstacksize = 2  -- registers 0/1 are always valid
  new_fs.lastline = 0
  new_fs.forward_gotos = { }
  new_fs.labels = { }
  return new_fs
end

------------------------------------------------------------------------
-- Finish to set up [f] according to final state of [fs]
------------------------------------------------------------------------
local function close_func (fs)
  local f = fs.f
  --printf("[CLOSE_FUNC] remove any remaining var")
  removevars (fs, 0)
  luaK:ret (fs, 0, 0)
  f.sizecode = fs.pc
  f.sizelineinfo = fs.pc
  f.sizek = fs.nk
  f.sizep = fs.np
  f.sizelocvars = fs.nlocvars
  f.sizeupvalues = f.nups
  assert (fs.bl == nil)
  if next(fs.forward_gotos) then
     local x = pp.tostring(fs.forward_gotos)
     error ("Unresolved goto: "..x)
  end
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function pushclosure(fs, func, v)
   local f = fs.f
   f.p [fs.np] = func.f
   fs.np = fs.np + 1
   init_exp (v, "VRELOCABLE", luaK:codeABx (fs, "OP_CLOSURE", 0, fs.np - 1))
  for i = 0, func.f.nups - 1 do
    local o = (func.upvalues[i].k == "VLOCAL") and "OP_MOVE" or "OP_GETUPVAL"
    luaK:codeABC (fs, o, 0, func.upvalues[i].info, 0)
  end
end

------------------------------------------------------------------------
-- FIXME: is there a need for f=fs.f? if yes, why not always using it? 
------------------------------------------------------------------------
local function indexupvalue(fs, name, v)
   local f = fs.f
   for i = 0, f.nups - 1 do
      if fs.upvalues[i].k == v.k and fs.upvalues[i].info == v.info then
         assert(fs.f.upvalues[i] == name)
         return i
      end
   end
  -- new one
  f.upvalues[f.nups] = name
  assert (v.k == "VLOCAL" or v.k == "VUPVAL")
  fs.upvalues[f.nups] = { k = v.k; info = v.info }
  local nups = f.nups
  f.nups = f.nups + 1
  return nups
end

------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function markupval(fs, level)
  local bl = fs.bl
  while bl and bl.nactvar > level do bl = bl.previous end
  if bl then bl.upval = true end
end


--for debug only
--[[
local function bldepth(fs)
   local i, x= 1, fs.bl
   while x do i=i+1; x=x.previous end
   return i
end
--]]

------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function enterblock (fs, bl, isbreakable)
  bl.breaklist = luaK.NO_JUMP
  bl.isbreakable = isbreakable
  bl.nactvar = fs.nactvar
  bl.upval = false
  bl.previous = fs.bl
  fs.bl = bl
  assert (fs.freereg == fs.nactvar)
end

------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function leaveblock (fs)
   local bl = fs.bl
   fs.bl = bl.previous
   --printf("[LEAVEBLOCK] Removing vars...")
   removevars (fs, bl.nactvar)
   --printf("[LEAVEBLOCK] ...Vars removed")
   if bl.upval then
      luaK:codeABC (fs, "OP_CLOSE", bl.nactvar, 0, 0)
   end
   -- a block either controls scope or breaks (never both)
   assert (not bl.isbreakable or not bl.upval)
   assert (bl.nactvar == fs.nactvar)
   fs.freereg = fs.nactvar  -- free registers
   luaK:patchtohere (fs, bl.breaklist)
end


------------------------------------------------------------------------
-- read a list of expressions from a list of ast [astlist]
-- starts at the [offset]th element of the list (defaults to 1)
------------------------------------------------------------------------
local function explist(fs, astlist, v, offset)
  offset = offset or 1
  if #astlist < offset then error "I don't handle empty expr lists yet" end
  --printf("[EXPLIST] about to precompile 1st element %s", disp.ast(astlist[offset]))
  expr.expr (fs, astlist[offset], v)
  --printf("[EXPLIST] precompiled first element v=%s", tostringv(v))
  for i = offset+1, #astlist do
    luaK:exp2nextreg (fs, v)
    --printf("[EXPLIST] flushed v=%s", tostringv(v))
    expr.expr (fs, astlist[i], v)
    --printf("[EXPLIST] precompiled element v=%s", tostringv(v))
  end
  return #astlist - offset + 1
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function funcargs (fs, ast, v, idx_from)
  local args = { }  -- expdesc
  local nparams
  if #ast < idx_from then args.k = "VVOID" else
     explist(fs, ast, args, idx_from)
     luaK:setmultret(fs, args)
  end
  assert(v.k == "VNONRELOC")
  local base = v.info  -- base register for call
  if hasmultret(args.k) then nparams = luaK.LUA_MULTRET else -- open call
    if args.k ~= "VVOID" then 
       luaK:exp2nextreg(fs, args) end -- close last argument
    nparams = fs.freereg - (base + 1)
  end
  init_exp(v, "VCALL", luaK:codeABC(fs, "OP_CALL", base, nparams + 1, 2))
  if ast.lineinfo then
     luaK:fixline(fs, ast.lineinfo.first.line)
  else 
    luaK:fixline(fs, ast.line)
  end
  fs.freereg = base + 1  -- call remove function and arguments and leaves
                         -- (unless changed) one result
end

------------------------------------------------------------------------
-- calculates log value for encoding the hash portion's size
------------------------------------------------------------------------
local function log2(x)
  -- math result is always one more than lua0_log2()
  local mn, ex = math.frexp(x)
  return ex - 1
end

------------------------------------------------------------------------
-- converts an integer to a "floating point byte", represented as
-- (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm)
------------------------------------------------------------------------

-- local function int2fb(x)
--   local m = 0  -- mantissa
--   while x >= 8 do x = math.floor((x + 1) / 2); m = m + 1 end
--   return m * 8 + x
-- end

local function int2fb(x)
   local e = 0
   while x >= 16 do
      x = math.floor ( (x+1) / 2)
      e = e+1
   end
   if x<8 then return x
   else return (e+1) * 8 + x - 8 end
end


------------------------------------------------------------------------
-- FIXME: to be unified with singlevar
------------------------------------------------------------------------
local function singlevaraux(fs, n, var, base)
--[[
print("\n\nsinglevaraux: fs, n, var, base")
printv(fs)
printv(n)
printv(var)
printv(base)
print("\n")
--]]
   if fs == nil then  -- no more levels?
      init_exp(var, "VGLOBAL", luaP.NO_REG)  -- default is global variable
      return "VGLOBAL"
   else
      local v = searchvar(fs, n)  -- look up at current level
      if v >= 0 then
         init_exp(var, "VLOCAL", v)
         if not base then
            markupval(fs, v)  -- local will be used as an upval
         end
      else  -- not found at current level; try upper one
         if singlevaraux(fs.prev, n, var, false) == "VGLOBAL" then
            return "VGLOBAL" end
         var.info = indexupvalue (fs, n, var)
         var.k = "VUPVAL"
         return "VUPVAL"
      end
   end
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function singlevar(fs, varname, var)   
  if singlevaraux(fs, varname, var, true) == "VGLOBAL" then
     var.info = luaK:stringK (fs, varname) end
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function new_localvar (fs, name, n)
  assert (type (name) == "string")
  if fs.nactvar + n > M.MAXVARS then error ("too many local vars") end
  fs.actvar[fs.nactvar + n] = registerlocalvar (fs, name)
  --printf("[NEW_LOCVAR] %i = %s", fs.nactvar+n, name)
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function parlist (fs, ast_params)
   local dots = (#ast_params > 0 and ast_params[#ast_params].tag == "Dots")
   local nparams = dots and #ast_params - 1 or #ast_params
   for i = 1, nparams do
      assert (ast_params[i].tag == "Id", "Function parameters must be Ids")
      new_localvar (fs, ast_params[i][1], i-1)
   end
   -- from [code_param]:
   --checklimit (fs, fs.nactvar, self.M.MAXPARAMS, "parameters")
   fs.f.numparams = fs.nactvar
   fs.f.is_vararg = dots and M.VARARG_ISVARARG or 0 
   adjustlocalvars (fs, nparams)
   fs.f.numparams = fs.nactvar --FIXME vararg must be taken in account
   luaK:reserveregs (fs, fs.nactvar)  -- reserve register for parameters
end

------------------------------------------------------------------------
-- if there's more variables than expressions in an assignment,
-- some assignations to nil are made for extraneous vars.
-- Also handles multiret functions
------------------------------------------------------------------------
local function adjust_assign (fs, nvars, nexps, e)
  local extra = nvars - nexps
  if hasmultret (e.k) then
    extra = extra+1  -- includes call itself
    if extra <= 0 then extra = 0 end
    luaK:setreturns(fs, e, extra)  -- call provides the difference
    if extra > 1 then luaK:reserveregs(fs, extra-1) end
  else
    if e.k ~= "VVOID" then 
       luaK:exp2nextreg(fs, e) end  -- close last expression
    if extra > 0 then
      local reg = fs.freereg
      luaK:reserveregs(fs, extra)
      luaK:_nil(fs, reg, extra)
    end
  end
end


------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function enterlevel (fs)
   fs.nestlevel = fs.nestlevel + 1
   assert (fs.nestlevel <= M.LUA_MAXPARSERLEVEL, "too many syntax levels")
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function leavelevel (fs)
  fs.nestlevel = fs.nestlevel - 1
end

------------------------------------------------------------------------
-- Parse conditions in if/then/else, while, repeat
------------------------------------------------------------------------
local function cond (fs, ast)
   local v = { }
   expr.expr(fs, ast, v)  -- read condition
   if v.k == "VNIL" then v.k = "VFALSE" end  -- 'falses' are all equal here
   luaK:goiftrue (fs, v)
   return v.f
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function chunk (fs, ast)
   enterlevel (fs)
   assert (not ast.tag)
   for i=1, #ast do 
      stat.stat (fs, ast[i]); 
      fs.freereg = fs.nactvar
   end
   leavelevel (fs)
end

------------------------------------------------------------------------
-- 
------------------------------------------------------------------------
local function block (fs, ast)
  local bl = {}
  enterblock (fs, bl, false)
  for i=1, #ast do
     stat.stat (fs, ast[i])
     fs.freereg = fs.nactvar
  end
  assert (bl.breaklist == luaK.NO_JUMP)
  leaveblock (fs)
end  

------------------------------------------------------------------------
-- Forin / Fornum body parser
-- [fs]
-- [body]
-- [base]
-- [nvars]
-- [isnum]
------------------------------------------------------------------------
local function forbody (fs, ast_body, base, nvars, isnum)
   local bl = {}  -- BlockCnt
   adjustlocalvars (fs, 3)  -- control variables
   local prep = 
      isnum and luaK:codeAsBx (fs, "OP_FORPREP", base, luaK.NO_JUMP)
      or luaK:jump (fs) 
   enterblock (fs, bl, false)  -- loop block
   adjustlocalvars (fs, nvars)  -- scope for declared variables
   luaK:reserveregs (fs, nvars)
   block (fs, ast_body)
   leaveblock (fs)
   --luaK:patchtohere (fs, prep-1)
   luaK:patchtohere (fs, prep)
   local endfor = 
      isnum and luaK:codeAsBx (fs, "OP_FORLOOP", base, luaK.NO_JUMP)
      or luaK:codeABC (fs, "OP_TFORLOOP", base, 0, nvars)
   luaK:fixline (fs, ast_body.line)  -- pretend that 'OP_FOR' starts the loop
   luaK:patchlist (fs, isnum and endfor or luaK:jump(fs), prep + 1)
end


------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function recfield (fs, ast, cc)
  local reg = fs.freereg
  local key, val = {}, {}  -- expdesc
  --FIXME: expr + exp2val = index -->
  --       check reduncancy between exp2val and exp2rk
  cc.nh = cc.nh + 1
  expr.expr(fs, ast[1], key); 
  luaK:exp2val (fs, key) 
  local keyreg = luaK:exp2RK (fs, key)
  expr.expr(fs, ast[2], val)
  local valreg = luaK:exp2RK (fs, val)
  luaK:codeABC(fs, "OP_SETTABLE", cc.t.info, keyreg, valreg)
  fs.freereg = reg  -- free registers
end


------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function listfield(fs, ast, cc)
  expr.expr(fs, ast, cc.v)
  assert (cc.na <= luaP.MAXARG_Bx) -- FIXME check <= or <
  cc.na = cc.na + 1
  cc.tostore = cc.tostore + 1
end

------------------------------------------------------------------------
--
------------------------------------------------------------------------
local function closelistfield(fs, cc)
   if cc.v.k == "VVOID" then return end  -- there is no list item
   luaK:exp2nextreg(fs, cc.v)
   cc.v.k = "VVOID"
   if cc.tostore == luaP.LFIELDS_PER_FLUSH then
      luaK:setlist (fs, cc.t.info, cc.na, cc.tostore)
      cc.tostore = 0
   end
end

------------------------------------------------------------------------
-- The last field might be a call to a multireturn function. In that
-- case, we must unfold all of its results into the list.
------------------------------------------------------------------------
local function lastlistfield(fs, cc)
  if cc.tostore == 0 then return end
  if hasmultret (cc.v.k) then
    luaK:setmultret(fs, cc.v)
    luaK:setlist (fs, cc.t.info, cc.na, luaK.LUA_MULTRET)
    cc.na = cc.na - 1
  else
    if cc.v.k ~= "VVOID" then luaK:exp2nextreg(fs, cc.v) end
    luaK:setlist (fs, cc.t.info, cc.na, cc.tostore)
  end
end
------------------------------------------------------------------------
------------------------------------------------------------------------
-- 
-- Statement parsers table
-- 
------------------------------------------------------------------------
------------------------------------------------------------------------

function stat.stat (fs, ast)
   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end
   --debugf (" - Statement %s", table.tostring (ast) )

   if not ast.tag then chunk (fs, ast) else

      local parser = stat [ast.tag]
      if not parser then 
         error ("A statement cannot have tag `"..ast.tag) end
      parser (fs, ast)
   end
   --debugf (" - /Statement `%s", ast.tag)
end

------------------------------------------------------------------------

stat.Do = block

------------------------------------------------------------------------

function stat.Break (fs, ast)
   --   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line
   local bl, upval = fs.bl, false
   while bl and not bl.isbreakable do
      if bl.upval then upval = true end
      bl = bl.previous
   end
   assert (bl, "no loop to break")
   if upval then luaK:codeABC(fs, "OP_CLOSE", bl.nactvar, 0, 0) end
   bl.breaklist = luaK:concat(fs, bl.breaklist, luaK:jump(fs))
end

------------------------------------------------------------------------

function stat.Return (fs, ast)
   local e = {}  -- expdesc
   local first -- registers with returned values
   local nret = #ast

   if nret == 0 then first = 0
   else
      --printf("[RETURN] compiling explist")
      explist (fs, ast, e)
      --printf("[RETURN] explist e=%s", tostringv(e))
      if hasmultret (e.k) then
         luaK:setmultret(fs, e)
         if e.k == "VCALL" and nret == 1 then
            luaP:SET_OPCODE(luaK:getcode(fs, e), "OP_TAILCALL")
            assert(luaP:GETARG_A(luaK:getcode(fs, e)) == fs.nactvar)
         end
         first = fs.nactvar
         nret = luaK.LUA_MULTRET  -- return all values
      elseif nret == 1 then
         first = luaK:exp2anyreg(fs, e)
      else
         --printf("* Return multiple vals in nextreg %i", fs.freereg)
         luaK:exp2nextreg(fs, e)  -- values must go to the 'stack'
         first = fs.nactvar  -- return all 'active' values
         assert(nret == fs.freereg - first)
      end
   end
   luaK:ret(fs, first, nret)
end
------------------------------------------------------------------------

function stat.Local (fs, ast)
  local names, values = ast[1], ast[2] or { }
  for i = 1, #names do new_localvar (fs, names[i][1], i-1) end
  local e = { }
  if #values == 0 then e.k = "VVOID" else explist (fs, values, e) end
  adjust_assign (fs, #names, #values, e)
  adjustlocalvars (fs, #names)
end

------------------------------------------------------------------------

function stat.Localrec (fs, ast)
   assert(#ast[1]==1 and #ast[2]==1, "Multiple letrecs not implemented yet")
   local ast_var, ast_val, e_var, e_val = ast[1][1], ast[2][1], { }, { }
   new_localvar (fs, ast_var[1], 0)
   init_exp (e_var, "VLOCAL", fs.freereg)
   luaK:reserveregs (fs, 1)
   adjustlocalvars (fs, 1)
   expr.expr (fs, ast_val, e_val)
   luaK:storevar (fs, e_var, e_val)
   getlocvar (fs, fs.nactvar-1).startpc = fs.pc
end

------------------------------------------------------------------------

function stat.If (fs, ast)
  local astlen = #ast
  -- Degenerate case #1: no statement
  if astlen==0 then return block(fs, { }) end
  -- Degenerate case #2: only an else statement
  if astlen==1 then return block(fs, ast[1]) end   

  local function test_then_block (fs, test, body)
    local condexit = cond (fs, test); 
    block (fs, body) 
    return condexit
  end

  local escapelist = luaK.NO_JUMP

  local flist = test_then_block (fs, ast[1], ast[2]) -- 'then' statement
  for i = 3, #ast - 1, 2 do -- 'elseif' statement
    escapelist = luaK:concat( fs, escapelist, luaK:jump(fs))
    luaK:patchtohere (fs, flist)
    flist = test_then_block (fs, ast[i], ast[i+1])
  end
  if #ast % 2 == 1 then -- 'else' statement
    escapelist = luaK:concat(fs, escapelist, luaK:jump(fs))
    luaK:patchtohere(fs, flist)
    block (fs, ast[#ast])
  else
    escapelist = luaK:concat(fs, escapelist, flist)
  end
  luaK:patchtohere(fs, escapelist)
end

------------------------------------------------------------------------

function stat.Forin (fs, ast)
   local vars, vals, body = ast[1], ast[2], ast[3]
   -- imitating forstat:
   local bl = { }
   enterblock (fs, bl, true)
   -- imitating forlist:
   local e, base = { }, fs.freereg
   new_localvar (fs, "(for generator)", 0)
   new_localvar (fs, "(for state)", 1)
   new_localvar (fs, "(for control)", 2)
   for i = 1, #vars do new_localvar (fs, vars[i][1], i+2) end
   explist (fs, vals, e)
   adjust_assign (fs, 3, #vals, e)
   luaK:checkstack (fs, 3)
   forbody (fs, body, base, #vars, false)
   -- back to forstat:
   leaveblock (fs)
end

------------------------------------------------------------------------

function stat.Fornum (fs, ast)

   local function exp1 (ast_e)
      local e = { }
      expr.expr (fs, ast_e, e)
      luaK:exp2nextreg (fs, e)
   end
   -- imitating forstat:
   local bl = { }
   enterblock (fs, bl, true)
   -- imitating fornum:
   local base = fs.freereg
   new_localvar (fs, "(for index)", 0)
   new_localvar (fs, "(for limit)", 1)
   new_localvar (fs, "(for step)", 2)
   new_localvar (fs, ast[1][1], 3) 
   exp1 (ast[2]) -- initial value
   exp1 (ast[3]) -- limit
   if #ast == 5 then exp1 (ast[4]) else -- default step = 1
      luaK:codeABx(fs, "OP_LOADK", fs.freereg, luaK:numberK(fs, 1))
      luaK:reserveregs(fs, 1)
   end
   forbody (fs, ast[#ast], base, 1, true)
   -- back to forstat:
   leaveblock (fs)
end

------------------------------------------------------------------------
function stat.Repeat (fs, ast)
  local repeat_init = luaK:getlabel (fs)
  local bl1, bl2 = { }, { }
  enterblock (fs, bl1, true)
  enterblock (fs, bl2, false)
  chunk (fs, ast[1])
  local condexit = cond (fs, ast[2])
  if not bl2.upval then
    leaveblock (fs)
    luaK:patchlist (fs, condexit, repeat_init)
  else
    stat.Break (fs)
    luaK:patchtohere (fs, condexit)
    leaveblock (fs)
    luaK:patchlist (fs, luaK:jump (fs), repeat_init)
  end
  leaveblock (fs)
end

------------------------------------------------------------------------

function stat.While (fs, ast)
   local whileinit = luaK:getlabel (fs)
   local condexit = cond (fs, ast[1])
   local bl = { }
   enterblock (fs, bl, true)
   block (fs, ast[2])
   luaK:patchlist (fs, luaK:jump (fs), whileinit)
   leaveblock (fs)
   luaK:patchtohere (fs, condexit);
end

------------------------------------------------------------------------

-- FIXME: it's cumbersome to write this in this semi-recursive way.
function stat.Set (fs, ast)
   local ast_lhs, ast_vals, e = ast[1], ast[2], { }

   --print "\n\nSet ast_lhs ast_vals:"
   --print(disp.ast(ast_lhs))
   --print(disp.ast(ast_vals))

   local function let_aux (lhs, nvars)
      local legal = { VLOCAL=1, VUPVAL=1, VGLOBAL=1, VINDEXED=1 }
      --printv(lhs)
      if not legal [lhs.v.k] then 
         error ("Bad lhs expr: "..pp.tostring(ast_lhs)) 
      end
      if nvars < #ast_lhs then -- this is not the last lhs
         local nv = { v = { }, prev = lhs }
         expr.expr (fs, ast_lhs [nvars+1], nv.v)
         if nv.v.k == "VLOCAL" then check_conflict (fs, lhs, nv.v) end
         let_aux (nv, nvars+1)
      else -- this IS the last lhs
         explist (fs, ast_vals, e)
         if #ast_vals < nvars then            
            adjust_assign (fs, nvars, #ast_vals, e)
         elseif #ast_vals > nvars then 
            adjust_assign (fs, nvars, #ast_vals, e)
            fs.freereg = fs.freereg - #ast_vals + nvars
         else -- #ast_vals == nvars (and we're at last lhs)
            luaK:setoneret (fs, e)  -- close last expression
            luaK:storevar (fs, lhs.v, e)
            return  -- avoid default
         end
      end
      init_exp (e, "VNONRELOC", fs.freereg - 1)  -- default assignment
      luaK:storevar (fs, lhs.v, e)
   end

   local lhs = { v = { }, prev = nil }
   expr.expr (fs, ast_lhs[1], lhs.v)
   let_aux( lhs, 1)
end  

------------------------------------------------------------------------

function stat.Call (fs, ast)
   local v = {  }
   expr.Call (fs, ast, v)
   luaP:SETARG_C (luaK:getcode(fs, v), 1)
end

------------------------------------------------------------------------

function stat.Invoke (fs, ast)
   local v = {  }
   expr.Invoke (fs, ast, v)
   --FIXME: didn't check that, just copied from stat.Call
   luaP:SETARG_C (luaK:getcode(fs, v), 1)
end


local function patch_goto (fs, src, dst)

end


------------------------------------------------------------------------
-- Goto/Label data:
-- fs.labels        :: string => { nactvar :: int; pc :: int }
-- fs.forward_gotos :: string => list(int)
--
-- fs.labels goes from label ids to the number of active variables at
-- the label's PC, and that PC
--
-- fs.forward_gotos goes from label ids to the list of the PC where
-- some goto wants to jump to this label. Since gotos are actually made
-- up of two instructions OP_CLOSE and OP_JMP, it's the first instruction's
-- PC that's stored in fs.forward_gotos
--
-- Note that backward gotos aren't stored: since their destination is knowns
-- when they're compiled, their target is directly set.
------------------------------------------------------------------------

------------------------------------------------------------------------
-- Set a Label to jump to with Goto
------------------------------------------------------------------------
function stat.Label (fs, ast)
   local label_id = ast[1]
   if type(label_id)=='table' then label_id=label_id[1] end
   -- printf("Label %s at PC %i", label_id, fs.pc)
   -------------------------------------------------------------------
   -- Register the label, so that future gotos can use it.
   -------------------------------------------------------------------
   if   fs.labels [label_id] then error "Duplicate label in function"
   else fs.labels [label_id] = { pc = fs.pc; nactvar = fs.nactvar } end
   local gotos = fs.forward_gotos [label_id]
   if gotos then 
      ----------------------------------------------------------------
      -- Patch forward gotos which were targetting this label.
      ----------------------------------------------------------------
      for _, goto_pc in ipairs(gotos) do
         local close_instr  = fs.f.code[goto_pc]
         local jmp_instr    = fs.f.code[goto_pc+1]
         local goto_nactvar = luaP:GETARG_A (close_instr)
         if fs.nactvar < goto_nactvar then 
            luaP:SETARG_A (close_instr, fs.nactvar) end
         luaP:SETARG_sBx (jmp_instr, fs.pc - goto_pc - 2)
      end
      ----------------------------------------------------------------
      -- Gotos are patched, they can be forgotten about (when the
      -- function will be finished, it will be checked that all gotos
      -- have been patched, by checking that forward_goto is empty).
      ----------------------------------------------------------------
      fs.forward_gotos[label_id] = nil
   end 
end

------------------------------------------------------------------------
-- jumps to a label set with stat.Label. 
-- Argument must be a String or an Id
-- FIXME/optim: get rid of useless OP_CLOSE when nactvar doesn't change.
-- Thsi must be done both here for backward gotos, and in
-- stat.Label for forward gotos.
------------------------------------------------------------------------
function stat.Goto (fs, ast)
   local label_id = ast[1]
   if type(label_id)=='table' then label_id=label_id[1] end
   -- printf("Goto %s at PC %i", label_id, fs.pc)
   local label = fs.labels[label_id]
   if label then
      ----------------------------------------------------------------
      -- Backward goto: the label already exists, so I can get its
      -- nactvar and address directly. nactvar is used to close
      -- upvalues if we get out of scoping blocks by jumping.
      ----------------------------------------------------------------
      if fs.nactvar > label.nactvar then
         luaK:codeABC  (fs, "OP_CLOSE", label.nactvar, 0, 0) end
      local offset = label.pc - fs.pc - 1
      luaK:codeAsBx (fs, "OP_JMP", 0, offset)
   else
      ----------------------------------------------------------------
      -- Forward goto: will be patched when the matching label is
      -- found, forward_gotos[label_id] keeps the PC of the CLOSE
      -- instruction just before the JMP. [stat.Label] will use it to
      -- patch the OP_CLOSE and the OP_JMP.
      ----------------------------------------------------------------
      if not fs.forward_gotos[label_id] then 
         fs.forward_gotos[label_id] = { } end
      table.insert (fs.forward_gotos[label_id], fs.pc)
      luaK:codeABC  (fs, "OP_CLOSE", fs.nactvar, 0, 0)
      luaK:codeAsBx (fs, "OP_JMP", 0, luaK.NO_JUMP)
   end
end

------------------------------------------------------------------------
------------------------------------------------------------------------
-- 
-- Expression parsers table
-- 
------------------------------------------------------------------------
------------------------------------------------------------------------

function expr.expr (fs, ast, v)
   if type(ast) ~= "table" then 
      error ("Expr AST expected, got "..pp.tostring(ast)) end

   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end

   --debugf (" - Expression %s", table.tostring (ast))
   local parser = expr[ast.tag]
   if parser then parser (fs, ast, v)
   elseif not ast.tag then 
       error ("No tag in expression "..
              pp.tostring(ast, {line_max=80, hide_hash=1, metalua_tag=1}))
   else 
      error ("No parser for node `"..ast.tag) end
   --debugf (" - /Expression `%s", ast.tag)
end

------------------------------------------------------------------------

function expr.Nil (fs, ast, v) init_exp (v, "VNIL", 0) end
function expr.True (fs, ast, v) init_exp (v, "VTRUE", 0) end
function expr.False (fs, ast, v) init_exp (v, "VFALSE", 0) end
function expr.String (fs, ast, v) codestring (fs, v, ast[1]) end
function expr.Number (fs, ast, v)
   init_exp (v, "VKNUM", 0)
   v.nval = ast[1] 
end

function expr.Paren (fs, ast, v) 
   expr.expr (fs, ast[1], v)
   luaK:setoneret (fs, v)
end

function expr.Dots (fs, ast, v)
   assert (fs.f.is_vararg ~= 0, "No vararg in this function")
   -- NEEDSARG flag is set if and only if the function is a vararg,
   -- but no vararg has been used yet in its code.
   if fs.f.is_vararg < M.VARARG_NEEDSARG then 
      fs.f.is_varag = fs.f.is_vararg - M.VARARG_NEEDSARG end
   init_exp (v, "VVARARG", luaK:codeABC (fs, "OP_VARARG", 0, 1, 0))
end

------------------------------------------------------------------------

function expr.Table (fs, ast, v)
  local pc = luaK:codeABC(fs, "OP_NEWTABLE", 0, 0, 0)
  local cc = { v = { } , na = 0, nh = 0, tostore = 0, t = v }  -- ConsControl
  init_exp (v, "VRELOCABLE", pc)
  init_exp (cc.v, "VVOID", 0)  -- no value (yet)
  luaK:exp2nextreg (fs, v)  -- fix it at stack top (for gc)
  for i = 1, #ast do
    assert(cc.v.k == "VVOID" or cc.tostore > 0)
    closelistfield(fs, cc);
    (ast[i].tag == "Pair" and recfield or listfield) (fs, ast[i], cc)
  end    
  lastlistfield(fs, cc)

  -- Configure [OP_NEWTABLE] dimensions
  luaP:SETARG_B(fs.f.code[pc], int2fb(cc.na)) -- set initial array size
  luaP:SETARG_C(fs.f.code[pc], int2fb(cc.nh))  -- set initial table size
  --printv(fs.f.code[pc])
end  


------------------------------------------------------------------------

function expr.Function (fs, ast, v)
   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end

  local new_fs = open_func(fs)
  if ast.lineinfo then 
    new_fs.f.lineDefined, new_fs.f.lastLineDefined = 
        ast.lineinfo.first.line, ast.lineinfo.last.line
  end
  parlist (new_fs, ast[1])
  chunk (new_fs, ast[2])
  close_func (new_fs)
  pushclosure(fs, new_fs, v)
end  

------------------------------------------------------------------------

function expr.Op (fs, ast, v)
   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end
   local op = ast[1]

   if #ast == 2 then
      expr.expr (fs, ast[2], v)
      luaK:prefix (fs, op, v)
   elseif #ast == 3 then
      local v2 = { }
      expr.expr (fs, ast[2], v)
      luaK:infix (fs, op, v)
      expr.expr (fs, ast[3], v2)
      luaK:posfix (fs, op, v, v2)
   else
      error "Wrong arg number"
   end
end  

------------------------------------------------------------------------

function expr.Call (fs, ast, v)
   expr.expr (fs, ast[1], v)
   luaK:exp2nextreg (fs, v)
   funcargs(fs, ast, v, 2)
   --debugf("after expr.Call: %s, %s", v.k, luaP.opnames[luaK:getcode(fs, v).OP])
end  

------------------------------------------------------------------------
-- `Invoke{ table key args }
function expr.Invoke (fs, ast, v)
   expr.expr (fs, ast[1], v)
   luaK:dischargevars (fs, v)
   local key = { }
   codestring (fs, key, ast[2][1])
   luaK:_self (fs, v, key)
   funcargs (fs, ast, v, 3)
end  

------------------------------------------------------------------------

function expr.Index (fs, ast, v)
   if #ast ~= 2 then
      print"\n\nBAD INDEX AST:"
      pp.print(ast)
      error "generalized indexes not implemented" end

   if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end

   --assert(fs.lastline ~= 0, ast.tag)

   expr.expr (fs, ast[1], v)
   luaK:exp2anyreg (fs, v)

   local k = { }
   expr.expr (fs, ast[2], k)
   luaK:exp2val (fs, k)
   luaK:indexed (fs, v, k)
end  

------------------------------------------------------------------------

function expr.Id (fs, ast, v)
   assert (ast.tag == "Id")
   singlevar (fs, ast[1], v)
end

------------------------------------------------------------------------

function expr.Stat (fs, ast, v)
   --printf(" * Stat: %i actvars, first freereg is %i", fs.nactvar, fs.freereg)
   --printf("   actvars: %s", table.tostring(fs.actvar))

   -- Protect temporary stack values by pretending they are local
   -- variables. Local vars are in registers 0 ... fs.nactvar-1, 
   -- and temporary unnamed variables in fs.nactvar ... fs.freereg-1
   local save_nactvar = fs.nactvar

   -- Eventually, the result should go on top of stack *after all
   -- `Stat{ } related computation and string usage is over. The index
   -- of this destination register is kept here:
   local dest_reg = fs.freereg

   -- There might be variables in actvar whose register is > nactvar,
   -- and therefore will not be protected by the "nactvar := freereg"
   -- trick. Indeed, `Local only increases nactvar after the variable
   -- content has been computed. Therefore, in 
   -- "local foo = -{`Stat{...}}", variable foo will be messed up by
   -- the compilation of `Stat.
   -- FIX: save the active variables at indices >= nactvar in
   -- save_actvar, and restore them after `Stat has been computed.
   --
   -- I use a while rather than for loops and length operators because
   -- fs.actvar is a 0-based array...
   local save_actvar = { } do
      local i = fs.nactvar
      while true do
         local v = fs.actvar[i]
         if not v then break end
         --printf("save hald-baked actvar %s at index %i", table.tostring(v), i)
         save_actvar[i] = v
         i=i+1
      end
   end

   fs.nactvar = fs.freereg -- Now temp unnamed registers are protected
   enterblock (fs, { }, false)
   chunk (fs, ast[1])
   expr.expr (fs, ast[2], v)
   luaK:exp2nextreg (fs, v)
   leaveblock (fs)
   luaK:exp2reg (fs, v, dest_reg)

   -- Reserve the newly allocated stack level
   -- Puzzled note: here was written "fs.freereg = fs.freereg+1".
   -- I'm pretty sure it should rather be dest_reg+1, but maybe
   -- both are equivalent?
   fs.freereg = dest_reg+1

   -- Restore nactvar, so that intermediate stacked value stop
   -- being protected.
   --printf("   nactvar back from %i to %i", fs.nactvar, save_nactvar)
   fs.nactvar = save_nactvar

   -- restore messed-up unregistered local vars
   for i, j in pairs(save_actvar) do
      --printf("   Restoring actvar %i", i)
      fs.actvar[i] = j
   end
   --printf(" * End of Stat")
end

------------------------------------------------------------------------
-- Main function: ast --> proto
------------------------------------------------------------------------
function M.ast_to_proto (ast, source)
  local fs = open_func (nil)
  fs.f.is_vararg = M.VARARG_ISVARARG
  chunk (fs, ast)
  close_func (fs)
  assert (fs.prev == nil)
  assert (fs.f.nups == 0)
  assert (fs.nestlevel == 0)
  if source then fs.f.source = source end
  return fs.f, source
end

return M