--- lam.core --- core procedures

local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math
local proc = require("util").proc

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?"] = proc(1, function (r) return isa(r[1], "number") end),
	["="] =
		proc({0}, 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),
	["<"] =
		proc({0}, 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),
	[">"] =
		proc({0}, 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),
	["<="] = proc({0}, function (r) return not m.env[">"](r) end),
	[">="] = proc({0}, function (r) return not m.env["<"](r) end),
	------- math
	["+"] =
		proc({0}, function (r)
				return fold(function (a, b)
						return a + b
				end, 0, r)
		end),
	["-"] =
		proc({0}, 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),
	["*"] =
		proc({0}, 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),
	["/"] =
		proc({1}, function (r)
				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