--- lam.eval

local m = {}
local core = require "core"
local type = require "type"

function m.environ (inner, outer)
	local mt = {
		__type = "environment",
		__index = outer,
		__newindex =
			function (self, key, val)
				if rawget(self, key) then
					rawset(self, key, val)
				else
					getmetatable(self).__index[key] = val
				end
			end,
	}
	return setmetatable(inner, mt)
end

function m.procedure (params, body, env)
	local t = {
		params = params,
		body = body,
		env = env,
	}
	local mt = {
		__type = "procedure",
		__call =
			function (self, args)
				local inner = {}
				local p, a = self.params, args
				while p[2] and a[2] do
					inner[p[1]] = a[1]
					p, a = p[2], a[2]
				end
				local b = self.body
				local e = m.environ(inner, self.env)
				while not b[2] == type.null do
					m.eval(b[1], e)
					b = b[2]
				end
				return m.eval(b[1], e)
			end,
	}
	return setmetatable(t, mt)
end

m.specials = {
	-- each of these takes R (a list of args) and E (an environment)
	quote = function (r, e) return r[1] end,
	quasiquote =
		function (r, e)
			local x = r[1]
			if not type.islist(x) or x == type.null then
				return x
			end
			local QQ, fin = {}, nil
			local car, cdr = x[1], x[2]
			while cdr do
				if type.islist(car) then
					if car[1] == "unquote" then
						table.insert(QQ,
							m.eval(car[2][1], e))
					elseif car[1] == "unquote-splicing" then
						local usl = m.eval(car[2][1], e)
						if not type.islist(usl) then
							fin = usl
							break
						end
						while usl[2] do
							table.insert(QQ, usl[1])
							usl = usl[2]
						end
					end
				else
					table.insert(QQ, car)
				end
				car, cdr = cdr[1], cdr[2]
			end
			return type.list(QQ, fin)
		end,
	-- if not inside quasiquote, unquote and unquote-splicing are errors
	unquote = function () error("Unexpected unquote") end,
	["unquote-splicing"] =
		function () error("Unexpected unquote-splicing") end,
	-- define variables
	define = function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end,
	["set!"] = function (r, e) e[r[1]] = m.eval(r[2][1], e) end,
	-- y'know, ... lambda
	lambda = function (r, e) return m.procedure(r[1], r[2], e) end,
	-- control flow
	["if"] =
		function (r, e)
			local test, conseq, alt =
				r[1], r[2][1], r[2][2][1]
			if m.eval(test)
			then return m.eval(conseq)
			else return m.eval(alt)
			end
		end,
	-- TODO: include, import, define-syntax, ...
}
-- Aliases
m.specials.lam = m.specials.lambda
m.specials.def = m.specials.define

function m.eval (x, env)
	local env = env or core.env
	if type.isa(x, "symbol") then
		if env[x] == nil then
			error(string.format("Unbound variable: %s", x))
		end
		return env[x]
	elseif not type.islist(x) then
		return x
	else
		local op, args = x[1], x[2]
		if m.specials[op] then
			return m.specials[op](args, env)
		else		-- procedure call
			local fn = m.eval(op, env)
			local params = {}
			local r = args
			while r[2] do
				table.insert(params, m.eval(r[1], env))
				r = r[2]
			end
			return fn(type.list(params))
		end
	end
end

--------
return m