--[[ Kamin Core Language Evaluator Module
     KILT -- Kamin Interpreters in Lua Toolset
     H. Conrad Cunningham, Professor
     Computer and Information Science
     University of Mississippi

Developed for CSci 658, Software Language Engineering, Fall 2013

2013-08-21: Built Scheme module from Scheme interpreter evaluator code
2013-08-24: Reverted Scheme/Lisp changes to build Core module
2013-08-29: Modified to use Opcode and Values Factory modules
2013-11-13: Corrected function environment scoping

1234567890123456789012345678901234567890123456789012345678901234567890

The Evaluator takes the semantic representations of the expressions
and the Symbol Tables generated by the Parser, evaluates the
expression, and returns the resulting value.

The implementation of the evaluator uses a table eval indexed by the
OpCodes used in semantic representation.  The corresponding entry for
an OpCode is a closure that evaluates the corresponding semantic
structure.

--]]

-- KILT Interpreter Opcode Global Constants
local opcodes = require "opcodes"

-- KILT tree utilities library
local util = require "utilities"
local treeConcat = util.treeConcat

-- KILT Environment Module
local evm = require "environment"
local globalEnv, newEnv      = evm.globalEnv, evm.newEnv
local getVal, assign, setVal = evm.getVal, evm.assign, evm.setVal 

-- KILT Function Table Module
local ftm = require "funtab"
local defFun, getFun, dumpFun = ftm.defFun, ftm.getFun, ftm.dumpFun

-- KILT Values module
local vm = require "values"
local FALSEVAL, TRUEVAL = vm.FALSEVAL, vm.TRUEVAL
local isFalse, isTrue   = vm.isFalse,  vm.isTrue
local boolAsVal         = vm.boolAsVal
local hasOpCode         = vm.hasOpCode


-- EVALUATION TABLE (indexed by OpCode)

local eval = {}

-- Trap any attempts to evaluate invalid OpCodes 
setmetatable(eval,eval)

eval.__index = function(_,key)
  error("Attempt to evaluate invalid OpCode " .. treeConcat(key),2)
end

-- Function "doeval" evaluates the semantic form "t" in the
-- environment "env".  It calls the entry in the "eval" table based on
-- the opcode stored in element "t[i]".  "i" defaults to 1 if the
-- argument is nil or unspecified.

local function doeval(t,env,i) 
  i = i or 1 
  return eval[t[i]](t,env)
end

-- Function "evalScript" evaluates each semantic form in the script
-- "t" (a list) in the environment "env".  Each semantic form in this
-- script is an abstract syntax tree (AST) for a Scheme expression.

local function evalScript(t,env)
  local res = {}
  for i = 1, #t do
    res[i] = doeval(t[i],env)
  end
  return res
end

local returnVal = function(t,env)
  assert(#t == 2, "OpCode must have one argument.")
  return t[2]
end    

-- The following define entries in the "eval" table for each OpCode
-- type (i.e., for control operation, value operation, and
-- user-defined function).

-- Evaluate t = {FUNDEF, name}
eval[FUNDEF] = returnVal

-- Evaluate t = {VARVAL, name}
eval[VARVAL]  = function(t,env)
  local val = getVal(t[2],env)
  if val then 
    return val
  else
    error("Attempt to access value of undefined variable " ..
          tostring(t[2]))
  end
end

-- Evaluate t = {NUMVAL, number}
eval[NUMVAL]  = returnVal

-- Evaluate t = {IFOP, test, thenExpr, elseExpr}
eval[IFOP] = function(t,env)
  local test, thenExp, elseExp = t[2], t[3], t[4]
  if isTrue(doeval(test,env)) then 
    return doeval(thenExp,env)
  else 
    return doeval(elseExp,env)
  end
end

-- Evaluate t = {WHILEOP, test, body} 
eval[WHILEOP] = function(t,env)
  local test, body = t[2], t[3]
  local res
  while isTrue(doeval(test,env)) do
    res = doeval(body,env)
  end
  return FALSEVAL
end

-- Evaluate t = {SETOP, var, exp}
eval[SETOP] = function(t,env)
  local var, exp = t[2], t[3]
  local val = doeval(exp,env)
  return setVal(var,val,env) -- SIDE EFFECT
end

-- Evaluate t = {BEGINOP, expr1 ...} one or more expr
eval[BEGINOP] = function(t,env)
  local res
  for i = 2, #t do
    res = doeval(t[i],env)
  end
  return res
end
  
-- Evaluate t = {APPLYFUN,name,arg1,arg2,...} zero or more arg
eval[APPLYFUN] = function(t,env)
  local name = t[2]
  local fdef = getFun(name)
  if not fdef then 
    error("Function " .. name .. " not defined.",2)
  end

    -- Entry funTab[name] = {arity, formals, body}
  local numargs = #t - 2
  local arity, formal, body = fdef[1], fdef[2], fdef[3]
  if numargs < arity then
    error("Function "..name.." called with too few arguments.",2)
  elseif numargs > arity then 
    error("Function "..name.." called with too many arguments.",2)
  end

--local localEnv = newEnv(env) -- new environment frame for args
  local localEnv = newEnv()  -- new environment frame for args
  for i = 3, #t do
    local val = doeval(t[i],env)  -- evaluate argument
    local var = formal[i-2]    
    assign(var,val,localEnv)      -- assign to parameter name
  end
  return doeval(body,localEnv)
end

-- Evaluate t = {APPLYOP, operator, arg1, arg2, ...}
eval[APPLYOP] = function(t,env)
  return doeval(t,env,2) -- dispatch again on builtin operator
end


-- Functions for the builtin binary operators on numbers

-- Function "evalArithOp" takes an arithmetic operator function "op"
-- and a string "disp" giving how to display the operator. It returns
-- an evaluation function that evaluates the corresponding value
-- operator in the given environment.

local function evalArithOp(op,disp)
  local msg1  = disp .. " operation requires 2 arguments."
  local msg2  = disp .. " applied to nonnumeric values "
  local arith = function(t,env)
    assert(#t == 4, msg1)
    local left, right = doeval(t[3],env), doeval(t[4],env)
    return op(left,right)
  end
  return arith
end 

-- Lua's numbers are all double floating point numbers.  Function
-- "roundTowardZero" is used to round results of division to give the
-- usual truncating integer division result.

local function roundTowardZero(i) 
  if i < 0 then 
    return math.ceil(i) 
  else
    return math.floor(i) 
  end 
end

-- Functions for the arithmetic operators
local add = function(l,r) return l + r end
local sub = function(l,r) return l - r end
local mul = function(l,r) return l * r end
local div = function(l,r) return roundTowardZero(l / r) end

-- Evaluate t = {APPLYOP, arithmetic_op, expr1, expr2}
eval[ADDOP] = evalArithOp(add,"+")
eval[SUBOP] = evalArithOp(sub,"-")
eval[MULOP] = evalArithOp(mul,"*")
eval[DIVOP] = evalArithOp(div,"*")


-- Functions for builtin relational operators

-- Function "evalRelOp" takes an relational operator function "op" and
-- a string "disp" giving how to display the operator. It returns a
-- "boolean" function that evaluates the corresponding value operator
-- in the given environment.

local function evalRelOp(op,disp)
  local msg1  = disp .. " comparison requires 2 arguments."
  local order = function(t,env)
    assert(#t == 4, msg1)
    local left, right = doeval(t[3],env), doeval(t[4],env)
    return boolAsVal(op(left,right))
  end
  return order
end 

-- Functions for the relational operators
local function lt(l,r) return l < r  end
local function gt(l,r) return l > r  end
local function eq(l,r) return l == r end

-- Evaluate t = {APPLYOP, relational_op, expr1, expr2}
eval[LTOP] = evalRelOp(lt,"<")
eval[GTOP] = evalRelOp(gt,">")
eval[EQOP] = evalRelOp(eq,"=")

-- Evaluate t = {PRINTOP, expression}
eval[PRINTOP] = function(t,env)
  assert(#t == 3, "print operation requires 1 argument.")
  local res = doeval(t[3],env)
  print(valToString(res))  -- SIDE EFFECT
  return res
end


-- MODULE EXPORT LIST

return {
  evalScript    = evalScript
}