--- lam.base --- base environment

local base = {}
local type = require "type"
local isNull, isa, totable = type.isNull, type.isa, type.totable
local math = math

base.env = {
	-- Equivalence
	["eqv?"] =
		function (r)
			local a, b = r.car, r.cdr.car
			if a == b then
				return true
			else
				return false
			end
 		end,
	-- ["eq?"] = function (r) end, -- how would this be different to eqv?
	-- Numbers
	["number?"] = function (r) return isa(r.car, "Number") end,
	-- ["complex?"] = function (r) end,
	-- ["real?"] = function (r) end,
	-- ["rational?"] = function (r) end,
	-- ["integer?"] = function (r) end,
	-- ["exact?"] = function (r) end,
	-- ["inexact?"] = function (r) end,
	-- ["exact-integer?"] = function (r) end,
	-- ["finite?"] = function (r) end,
	-- ["infinite?"] = function (r) end,
	["="] =
		function (r)
			local n, r = r.car, r.cdr
			while r.cdr do
				if n ~= r.car then return false end
				r = r.cdr
			end
			return true
		end,
	["<"] =
		function (r)
			local n, r = r.car, r.cdr
			while r.cdr do
				if n >= r.car then return false end
				r = r.cdr
			end
			return true
		end,
	[">"] =
		function (r)
			local n, r = r.car, r.cdr
			while r.cdr do
				if n <= r.car then return false end
				r = r.cdr
			end
			return true
		end,
	["<="] =
		function (r)
			local n, r = r.car, r.cdr
			while r.cdr do
				if n > r.car then return false end
				r = r.cdr
			end
			return true
		end,
	[">="] =
		function (r)
			local n, r = r.car, r.cdr
			while r.cdr do
				if n < r.car then return false end
				r = r.cdr
			end
			return true
		end,
	-- Math
	["+"] =
		function (r)
			local r, a = r, 0
			while r.cdr do
				r, a = r.cdr, a + r.car
			end
			return a
		end,
	["-"] =
		function (r)
			if isNull(r) then return -1 end
			if isNull(r.cdr) then return (- r.car) end
			local r, a = r.cdr, r.car
			while r.cdr do
				r, a = r.cdr, a - r.car
			end
			return a
		end,
	["*"] =
		function (r)
			local r, a = r, 1
			while r.cdr do
				if r.cdr == 0 then return 0 end
				r, a = r.cdr, a * r.car
			end
			return a
		end,
	["/"] =
		function (r)
			if isNull(r) then error("Wrong arity") end
			if isNull(r.cdr) then return (1 / r.car) end
			local r, a = r.cdr, r.car
			while r.cdr do
				r, a = r.cdr, a / r.car
			end
			return a
		end,
	quotient =
		function (r)
		end,
	remainder =
		function (r)
		end,
	modulo =
		function (r)
		end,
	-- numerator = function (r) end,
	-- denominator = function (r) end,
	abs = function (r) return math.abs(r.car) end,
	floor = -- largest integer <= x
		function (r) return math.floor(r.car) end,
	ceiling = -- smallest integer >= x
		function (r) return math.ceil(r.car) end,
	truncate = -- smallest |integer| <= |x|
		function (r)
			local i, _ = math.modf(r.car)
			return i
		end,
	round = -- closest integer to x (ties go even)
		function (r)
			local i, f = math.modf(r.car)
			if f == 0.5 then
				if i % 2 == 0 then
					return i
				else
					return i+1
				end
			else
				return i -- is this right?
			end
		end,
	-- Trig
	exp = function (r) return math.exp(r.car) end,
	log = function (r) return math.log(r.car) end,
	pi = math.pi, -- extension
	sin = function (r) return math.sin(r.car) end,
	cos = function (r) return math.cos(r.car) end,
	tan = function (r) return math.tan(r.car) end,
	asin = function (r) return math.asin(r.car) end,
	acos = function (r) return math.acos(r.car) end,
	atan = -- the two-argument variant of atan computes
		-- (angle (make-rectangular x y)), even in implementations that
		-- don't support general complex numbers [ed. note: whatever
		-- that means] --- atan2 ???
		function (r) return math.atan(r.car) end,
	sqrt = function (r) return math.sqrt(r.car) end,
	expt = function (r) return r.car ^ r.cdr.car end,
	-- ["make-rectangular"] = function (r) end,
	-- ["make-polar"] = function (r) end,
	-- ["real-part"] = function (r) end,
	-- ["imag-part"] = function (r) end,
	-- ["magnitude"] = function (r) end,
	-- ["angle"] = function (r) end,
	-- ["exact->inexact"] = function (r) end,
	-- ["inexact->exact"] = function (r) end,
	["number->string"] =
		function (r)
			-- this will be somewhat complicated
		end,
	["string->number"] =
		function (r)
			local n = r.car
			if not isNull(r.cdr) then
				local radix = r.cdr.car
			end
			-- This is technically an extension to r5rs
			return tonumber(n, radix)
		end,
	-- Pairs
	["pair?"] = function (r) end,
	cons = function (r) return type.Cons(r.car, r.cdr.car) end,
	car = function (r) return r.car.car end,
	cdr = function (r) return r.car.cdr end,
	["set-car!"] = function (r) r.car.car = r.cdr.car end,
	["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
	-- cxr
	["null?"] = function (r) return isNull(r.car) end,
	["list?"] = function (r) return type.isList(r.car) end,
	list = function (r) return r end, -- r is already a list
	-- Symbols
	["symbol?"] = function (r) return isa(r.car, "Symbol") end,
	["symbol->string"] = function (r) return type.String(r.car) end,
	["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
	-- Characters
	["char?"] = function (r) end,
	["char=?"] = function (r) end,
	["char<?"] = function (r) end,
	["char>?"] = function (r) end,
	["char<=?"] = function (r) end,
	["char>=?"] = function (r) end,
	["char->integer"] = function (r) end,
	["integer->char"] = function (r) end,
	-- Strings
	["string?"] = function (r) end,
	["make-string"] = function (r) end,
	["string-length"] = function (r) end,
	["string-ref"] = function (r) end,
	-- ["string-set!"] = function (r) end, -- not sure if i'll implement
	-- Vectors
	["vector?"] = function (r) end,
	["make-vector"] = function (r) end,
	["vector-length"] = function (r) end,
	["vector-ref"] = function (r) end,
	["vector-set!"] = function (r) end,
	-- Control
	["procedure?"] = function (r) end,
	apply = function (r) end,
	["call-with-current-continuation"] = function (r) end,
	values = function (r) end,
	["call-with-values"] = function (r) end,
	["dynamic-wind"] = function (r) end,
	-- Eval
	eval = function (r) end,
	["scheme-report-environment"] = function (r) end,
	["null-environment"] = function (r) end,
	-- Ports
	["input-port?"] = function (r) end,
	["output-port?"] = function (r) end,
	["current-input-port"] = function (r) end,
	["current-output-port"] = function (r) end,
	["open-input-file"] = function (r) end,
	["open-output-file"] = function (r) end,
	["close-input-port"] = function (r) end,
	["close-output-port"] = function (r) end,
	-- Input
	read = function (r) end,
	["read-char"] = function (r) end,
	["peek-char"] = function (r) end,
	["eof-object?"] = function (r) end,
	["char-ready?"] = function (r) end,
	-- Output
	write = function (r) end,
	display = function (r) end,
	newline = function (r) end,
	["write-char"] = function (r) end,
	-- System
	load = function (r) end,
}

---
return base