--- lam.core --- core procedures

local dump = require("dump")
local type = require("type")
local null = type.null
local assert_arity = type.assert_arity

local function fold (kons, knil, r)
	if r == null then
		return knil
	else
		local step, early_return = kons(r[1], knil)
		if early_return then return early_return end
		return fold(kons, step, r[2])
	end
end

local env = {}

---[[ EQUIVALENCE ]]---

env["eqv?"] = function (r)
	assert_arity(r,2,2)
	return r[1] == r[2][1]
end
-- from what i understand of the spec, it's okay that eqv? and eq? are the same
env["eq?"] = env["eqv?"]

---[[ TYPES ]]---

env["boolean?"] = function (r)
	assert_arity(r,1,1)
	return r[1] == false or r[1] == true
end

env["port?"] = function (r)
	assert_arity(r,1,1)
	return type.isp(r[1], "input-port") or type.isp(r[1], "output-port")
end

for _, t in ipairs {
	"symbol",
	-- todo: vector
	"procedure",
	"pair",
	"number",
	"string",
	"port",
} do
	env[t.."?"] = function (r)
		assert_arity(r,1,1)
		return type.isp(r[1], t)
	end
end

---[[ NUMBERS ]]---

env["="] = function (r)
	if r[1] == nil then return true end
	if r[2] == nil then return true end
	while r[2] ~= null do
		if r[1] ~= r[2][1] then return false end
		r = r[2]
	end
	return true
end

env["<"] = function (r)
	if r[1] == nil then return true end
	if r[2] == nil then return true end
	while r[2] ~= null do
		if r[1] >= r[2][1] then return false end
		r = r[2]
	end
	return true
end
env[">"] = function (r)
	if r[1] == nil then return true end
	if r[2] == nil then return true end
	while r[2] ~= null do
		if r[1] <= r[2][1] then return false end
		r = r[2]
	end
	return true
end
env["<="] = function (r) return not env[">"](r) end
env[">="] = function (r) return not env["<"](r) end

env["+"] = function (r)
	return fold(function (a, b) return a + b end, 0, r)
end

env["-"] = function (r)
	if r == null then return -1 end
	if r[2] == null then return (- r[1]) end
	return fold(function (a, b)
			return a - b
	end, r[1], r[2])
end

env["*"] = function (r)
	local function go (a, b)
		if a == 0 or b == 0 then
			return 0, 1
		end
		return a * b
	end
	return fold(go, 1, r)
end

env["/"] = function (r)
	assert_arity(r,1)
	if r[2] == null then return (1 / r[1]) end
	return fold(function (a, b) return a / b end,
		r[1], r[2])
end

---[[ INPUT / OUTPUT ]]---

env.dump = function (r)
	assert_arity(r,1,1)
	return dump.dump(r[1])
end

env.display = function (r)
	assert_arity(r,1,1)
	io.write(r[1])
end

env.newline = function (r)
	assert_arity(r,0,0)
	io.write("\n")
end

--------
return {
	environment = env,
}