--- lam.type

local m = {}
local utf8 = require "utf8"
utf_char, utf_codepoint = utf8.char, utf8.codepoint

--- atomic types

-- true, false and nil are just ... true, false, and nil

-- Characters contain both their string reputations and their codepoints
function m.character (x)
	-- is storing a character with its string and numerical representation
	-- overkill?  ... maybe.
	local s = tostring(x)
	local uc = utf_codepoint(s)
	local t = { -- String representation of the character
		v = utf_char(uc),
		u = uc,
	}
	local mt = {
		__type = "character",
		__eq = function (self) return self.v end,
		__lt = function (a, b) return a.u < b.u end,
		__tostring =
			function (self)
				local v = self.v
				if v == "\n" then
					return "#\\newline"
				elseif v == " " then
					return "#\\space"
				else
					return "#\\" .. v
				end
			end,
	}
	return setmetatable(t, mt)
end

-- a symbol is just a string, unadorned.  I was going to have a character be
-- represented by a one-character string, but then it would be indistinguishable
-- from a one-character symbol internally.
m.symbol = tostring

-- for now, number will just be lua's number.  At *some* point, it will be the
-- whole numeric tower, yaaayyy
m.number = tonumber

-- strings are wrapped strings
function m.string (x)
	local x = tostring(x)
	local t = {
		v = x,
		escape =
			function (self)
				return self.v:gsub("[\\\"]", "\\%1")
			end,
	}
	local mt = {
		__type = "string",
		__tostring =
			function (self)
				return "\"" .. self:escape() .. "\""
			end,
	}
	return setmetatable(t, mt)
end

-- null () is both an atom and a list (yay)
-- this one is NOT a function
m.null = setmetatable({}, {
		__type = "null",
		__tostring = function (self) return "()" end,
})

--- collection types

-- cons are lisp's fundamental collection type
function m.cons (a, b)
	local t = { a, b, }
	local mt = {
		__type = "cons",
		__tostring =
			function (self)
				local out = {}
				local car, cdr = self[1], self[2]
				while cdr do
					table.insert(out, tostring(car))
					if m.luatype(cdr) == "table" then
						car = cdr[1]
						cdr = cdr[2]
					else
						table.insert(out, ".")
						table.insert(out, cdr)
						break
					end
				end
				return "(" .. table.concat(out, " ") .. ")"
			end,
		__len =
			function (self)
				local function go (lis, acc)
					-- improper lists don't have lengths
					-- ... but don't error here.
					if not m.isa(lis, "cons") then
						return nil
					end
					if lis[2] == m.null then return acc
					else return go(lis[2], acc+1)
					end
				end
				return go(self, 1)
			end,
	}
	return setmetatable(t, mt)
end

-- lists are singly-linked cons cells
function m.list (items, last)
	-- ITEMS is a table and LAST is an optional final cdr.  If it's nil, the
	-- list is a "proper" list; that is, it ends in ().
	local function tolist (base, items)
		if #items == 0 then return base end
		return tolist(m.cons(table.remove(items), base), items)
	end
	return tolist(last or m.null, items)
end

-- convert a list to a lua table
function m.totable (cons)
	local t = {}
	local car, cdr = cons[1], cons[2]
	while cdr do
		table.insert(t, car)
		if m.luatype(cdr) == "table" then
			car = cdr[1]
			cdr = cdr[2]
		else
			table.insert(t, cdr)
		end
	end
	return t
end

-- testing types

-- we love name collisions
m.luatype = type

function m.lamtype (x)
	if m.luatype(x) == "string" then
		return "symbol"
	elseif getmetatable(x) and getmetatable(x).__type then
		return getmetatable(x).__type
	else
		return m.luatype(x)
	end
end

function m.isa (x, t)
	return m.lamtype(x) == t
end

function m.islist (x)
	-- TODO: detect circular lists
	if x == m.null then
		return true
	elseif m.isa(x, "cons") then
		return m.islist(x[2])
	else
		return false
	end
end

--------
return m