--- lam.eval

local eval = {}
local read = require "read"
local types = require "types"
local util = require "util"
local pp = require "pp"

Env = types.Object:new {
	__type = "Environment",
	__extend =
		function(self, parms, args, outer)
			for _, p in ipairs(parms) do
				for _, a in ipairs(args) do
					self[p] = a
				end
			end
			getmetatable(self).__index = outer
		end,
}

Proc = types.Object:new {
	__type = "Procedure",
	__call =
		function (self, args)
			local e = Env:new()
			e:__extend(self.parms,
				   util.table(args),
				   self.env)
			return eval(self.body[1], e)
		end
}

global_env = Env:new {
	-- constants
	["#t"] = true,
	["#f"] = false,
	-- basic math
	["+"] =
		function (...)
			print(...)
			return util.reduce(
				{...}, 0,
				function (a, b) return a + b end)
		end,
	["*"] =
		function (...)
			return util.reduce(
				{...}, 1,
				function (a, b) return a * b end)
		end,
	-- scheme predicates
	["null?"] =
		function(x)
			return x == {}
		end,
	["number?"] =
		function(x)
			return types.Type(x) == "Number"
		end,
	["symbol?"] =
		function(x)
			return types.Type(x) == "Symbol"
		end,
	-- scheme functions
	["apply"] =
		function(fn, ...)
			local args = {...}
			local last = args[#args]
			assert(type(last)=="table", "Bad apply")
			table.remove(args)
			for _,v in ipairs(last) do
				table.insert(args, v)
			end
			return fn(table.unpack(args))
		end,
	["begin"] =
		function(...)
			local xs = {...}
			return xs[#xs]
		end,
	["map"] =
		function(fn, ...)
			return util.map(fn, {...})
		end,
	["car"] = util.car,
	["cdr"] = util.cdr,
	["list"] = function(...) return {...} end,
}

-- Math
for k, v in pairs(math) do
	global_env[k] = v
end

function eval.eval (x, env)
	env = env or global_env
	if types.Type(x) == "Symbol" then
		return env[x]
	elseif types.Type(x) ~= "List" 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)
			env[sym] = eval(exp, env)
		elseif op == "set!" then
			local sym, exp = table.unpack(args)
			env[sym] = eval(exp, env)
		elseif op == "lambda" then
			local parms = util.car(args)
			local body = util.cdr(args)
			return Proc:new {
				parms = parms,
				body = body,
				env = env,
			}
		else		-- procedure call
			pp(op)
			local proc = eval(op, env)
			local vals = util.map(
				function(v) return eval(v, env) end,
				args)
			return proc(table.unpack(vals))
		end
	end
end

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

--[[
	(begin (define sq (lambda (x) (* x x))) (define rep (lambda (f) (lambda (x) (f (f x))))))
-- ]]