--[[ Lisp 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 changes to build Lisp 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
-- BEGIN add for Lisp
local NILLIST, consList = vm.NILLIST,  vm.consList
local cons, car, cdr    = vm.cons, vm.car, vm.cdr
local getNum, getSym    = vm.getNum, vm.getSym
-- END add for Lisp


-- 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

-- BEGIN change/add for Lisp

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

local returnArg1 = function(t,env,...) return t end

-- Evaluate t = {NUMSXP, number} 
eval[NUMSXP]  = returnArg1

-- Evaluate t = {SYMSXP, name}
eval[SYMSXP]  = returnArg1

-- Evaluate t = {NILSXP} 
eval[NILSXP]  = returnArg1

-- Evaluate t = {LISTSXP, list} 
eval[LISTSXP] = returnArg1

-- END add for Lisp

-- 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)
    -- BEGIN change/add for Lisp
    -- return op(left,right)
    if hasOpCode(left,NUMSXP) and hasOpCode(right,NUMSXP) then
      return { NUMSXP, op(getNum(left),getNum(right)) }
    else
      error(msg2 .. treeConcat(t[3]) .. " and " .. 
            treeConcat(t[4]) .. ".")
    end
    -- END change/add for Lisp
  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)
    -- BEGIN change/add for Lisp
    left, right = getNum(left), getNum(right)
    -- END change for Lisp
    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

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

-- BEGIN change for Lisp
-- Equality comparison is more general than < and >

-- local function eq(l,r) return l == r end
-- eval[EQOP] = evalRelOp(eq,"=")

eval[EQOP] = function(t,env)
  assert(#t == 4, "= operation requires 2 arguments.")
  local left, right = doeval(t[3],env), doeval(t[4],env)
  if hasOpCode(left,NUMSXP) and hasOpCode(right,NUMSXP) then
    return boolAsVal(getNum(left) == getNum(right))
  elseif hasOpCode(left,SYMSXP) and hasOpCode(right,SYMSXP) then
    return boolAsVal(getSym(left) == getSym(right))
  elseif hasOpCode(left,NILSXP) and hasOpCode(right,NILSXP) then 
    return TRUEVAL
  else
    return FALSEVAL
  end 
end

-- END change for Lisp

-- 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

-- BEGIN add for Lisp

-- Evaluate t = {APPLYOP,CONSOP,expr1,expr2}
eval[CONSOP] = function(t,env)
  assert(#t == 4, "cons operation requires 2 arguments.")
  local head, tail = doeval(t[3],env), doeval(t[4],env)
  return cons(head,tail)
end

-- Function "deconsList" takes a unary list deconstruction "operator"
-- "op" and a string "disp" giving how to display the operator.  It
-- returns an evaluation function that evaluates value operations of
-- that type in the given environment.

local function deconsList(op,disp)
  local msg1 = disp .. " operation requires 1 argument."
  local oplist = function(t,env)
    assert(#t == 3, msg1)
    local val = doeval(t[3],env)
    return op(val)
  end
  return oplist
end
  
-- Evaluate t = {APPLYOP,list_operation,expr1}
eval[CAROP] = deconsList(car,"car")
eval[CDROP] = deconsList(cdr,"cdr")

-- Function "testVal" takes an "opcode" and a string "disp" giving how
-- to display that operator.  It returns a boolean evaluation function
-- that evaluates value operations of that type in the given
-- environment.

local function testVal(opcode,disp)
  local msg1 = disp .. " operation requires 1 argument."
  local relop = function(t,env)
    assert(#t == 3, msg1)
    local val = doeval(t[3],env)
    return boolAsVal(hasOpCode(val,opcode))
  end
  return relop
end

-- Evaluate t = {APPLYOP,predicate,expr1}
eval[NUMBERPOP]  = testVal(NUMSXP,"number?")
eval[SYMBOLPOP]  = testVal(SYMSXP,"symbol?")
eval[NULLPOP]    = testVal(NILSXP,"null?")
eval[LISTPOP]    = testVal(LISTSXP,"list?")

-- END add for Lisp


-- MODULE EXPORT LIST

return {
  evalScript    = evalScript
}