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

local specials = {
	-- each of these takes R (a list of args) and E (an environment)
	quote =
		function (r, e) return r[1] end,
	define =
		function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end,
	lambda =
		function (r, e) return m.procedure(r[1], r[2], e) end,
	["set!"] =
		function (r, e) e[r[1]] = m.eval(r[2][1], e) end,
	["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
specials.lam = specials.lambda
specials.def = specials.define

function m.eval (x, env)
	local env = env or core.env
	if type.isa(x, "symbol") then
		return env[x]
	elseif not type.islist(x) then
		return x
	else
		local op, args = x[1], x[2]
		if specials[op] then
			return 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