--- lam.eval

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

local function Type (x)
	if type(x) == "string" then
		return "Symbol"
	elseif type(x) == "number" then
		return "Number"
	elseif getmetatable(x) and getmetatable(x).__type then
		return x.__type
	elseif type(x) == "table" then
		return "List"
	else
		return type(x)
	end
end

local Symbol = tostring
local Number = tonumber

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

local global_env = {
	-- 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 Type(x) == "Number"
		end,
	["symbol?"] =
		function(x)
			return 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 Type(x) == "Symbol" then
		return env[x]
	elseif type(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)
			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 params = util.car(args)
			local body = util.cdr(args)[1]
			return Proc(params, body, env)
		else		-- procedure call
			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))))))
	-- ]]