--- lam.eval

local eval = {}
local read = require "read"
local util = require "util"
local pp = require "pp"
local global = require "global"
local types = require("types")

if not table.unpack then table.unpack = unpack end

local function Env(inner, outer)
	return setmetatable(inner, { __type = "environment", __index = outer, })
end

local function Proc(params, body, env)
	local p = {
		params = params,
		body = body,
		env = env,
	}
	local mt = {
		__type = "procedure",
		__call =
			function (self, ...)
				local inner = {}
				for _, p in ipairs(self.params) do
					for _, a in ipairs({...}) do
						inner[p] = a
					end
				end
				return eval(self.body, Env(inner, self.env))
			end,
	}
	return setmetatable(p, mt)
end

function eval.eval (x, e)
	e = e or global
	if types.lamtype(x) == "symbol" then
		return e[x]
	elseif types.luatype(x) ~= "table" then
		return x
	else
		local op = util.car(x)
		local args = util.cdr(x)
		if op == "quote" then
			return args[1]
		elseif op == "define" then
			local sym, exp = table.unpack(args)
			e[sym] = eval(exp, e)
			--[[
				elseif op == "set!" then
				local sym, exp = table.unpack(args)
				e[sym] = eval(exp, e) --]]
		elseif op == "lambda" then
			local params = util.car(args)
			local body = util.cdr(args)
			table.insert(body, 1, "begin")
			return Proc(params,
				    body,
				    e)
		else		-- procedure call
			local proc = eval(op, e)
			local vals = {}
			for k, v in pairs(args) do
				vals[k] = eval(v, e)
			end
			return proc(table.unpack(vals))
		end
	end
end

---
return setmetatable(eval, { __call =
				    function(_, x, e)
					    local success, result =
						    pcall(eval.eval, x, e)
					    if success then return result
					    else return ("ERROR: " .. result)
					    end
				    end
})