--- lam.core --- core procedures

local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math

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
	------- numbers
	["number?"] = function (r) return isa(r[1], "number") end,
	["="] =
		function (r)
			local function go (a, b)
				if a ~= b then return false, 1 end
				return b
			end
			return fold(go, r[1], r[2]) and true
		end,
	["<"] =
		function (r)
			local function go (a, b)
				if a >= b then return false, 1 end
				return b
			end
			return fold(go, r[1], r[2]) and true
		end,
	[">"] =
		function (r)
			local function go (a, b)
				if a <= b then return false, 1 end
				return b
			end
			return fold(go, r[1], r[2]) and 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)
			if r == null then error("Wrong arity") end
			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