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

local function procedure_call (proc, r)
	local function doargs (p, r, e)
		if p == type.null and r == type.null then return e end
		if type.isa(p, "symbol") then
			e[p] = r
			return e
		end
		if p[1] == nil then error("Too many arguments") end
		if r[1] == nil then error("Too few arguments") end
		e[p[1]] = r[1]
		doargs(p[2], r[2], e)
	end

	local e = doargs(proc.params, r, m.environ({}, proc.env))
	local b = proc.body
	while b[2] ~= type.null do
		m.eval(b[1], e)
		b = b[2]
	end
	return m.eval(b[1], e)
end

function m.procedure (params, body, env)
	local t = {
		params = params,
		body = body,
		env = env,
	}
	local mt = {
		__type = "procedure",
		__call = procedure_call,
	}
	return setmetatable(t, mt)
end

local function handle_quasiquote (r, e)
	assert_arity(r, 1, 1)
	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

m.specials = {
	-- each of these takes R (a list of args) and E (an environment)
	quote =
		function (r, e)
			assert_arity(r, 1, 1)
			return r[1]
		end,
	quasiquote = handle_quasiquote,
	-- 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)
			assert_arity(r, 2, 2)
			rawset(e, r[1], m.eval(r[2][1], e))
		end,
	["set!"] =
		function (r, e)
			assert_arity(r, 2, 2)
			e[r[1]] = m.eval(r[2][1], e)
		end,
	-- y'know, ... lambda
	lambda =
		function (r, e)
			assert_arity(r, 2)
			return m.procedure(r[1], r[2], e)
		end,
	-- control flow
	["if"] =
		function (r, e)
			assert_arity(r, 3, 3)
			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