--- lam.core --- core procedures

local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math
local dump = require("dump").dump
-- local load = require("repl").load -- circular dependency :<
local util = require "util"
local assert_arity = util.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 step end
		return fold(kons, step, r[2])
	end
end

m.env = { -- all functions here take R, which is the list of arguments
	------- equivalence
	["eqv?"] =
		function (r)
			assert_arity(r, 2, 2)
			return r[1] == r[2][1]
		end,
	["eq?"] =
		function (r)
			assert_arity(r, 2, 2)
			-- from how i understand the Scheme spec, it's okay to
			-- make `eqv?' and `eq?' the same.
			return r[1] == r[2][1]
		end,
	-- equal? can be done in-library
	------- i/o
	display =
		function (r)
			assert_arity(r, 1, 1)
			io.write(tostring(r[1]))
		end,
	newline =
		function (r)
			assert_arity(r, 0, 0)
			io.write("\n")
		end,
	dump =
		function (r)
			assert_arity(r, 1, 1)
			return dump(r[1])
		end,
	--[[	load = -- circular dependency :<
		function (r)
		assert_arity(r, 1, 1)
		load(r[1])
		end,
	--]]
	------- numbers
	-- todo: assert all of these are numbers
	["number?"] =
		function (r)
			assert_arity(r, 1, 1)
			return isa(r[1], "number")
		end,
	["="] =
		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,
	["<"] =
		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,
	[">"] =
		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,
	["<="] = function (r) return not m.env[">"](r) end,
	[">="] = function (r) return not m.env["<"](r) end,
	------- math
	["+"] =
		function (r)
			return fold(function (a, b) return a + b end, 0, r)
		end,
	["-"] =
		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,
	["*"] =
		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,
	["/"] =
		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,
}

--------
return m