cortav  sirsem.lua at [c50482b020]

File sirsem.lua artifact 7e67a3ff12 part of check-in c50482b020


-- [ʞ] sirsem.lua
--  ~ lexi hale <lexi@hale.su>
--    glowpelt (hsl conversion)
--  ? utility library with functionality common to
--    cortav.lua and its extensions
--  \ from Ranuir "software utility"
--  > local ss = require 'sirsem.lua'

local ss
do -- pull ourselves up by our own bootstraps
	local package = _G.package
	-- prevent namespace from being broken by env shenanigans
	local function namespace(name, tbl)
		local pkg = tbl or {}
		if package then
			package.loaded[name] = pkg
		end
		return pkg
	end
	ss = namespace 'sirsem'
	ss.namespace = namespace
end

-- the C shim provides extra functionality that cannot
-- be implemented in pure Lua. this functionality is
-- accessed through the _G.native namespace. native
-- functions should not be called directly; rather,
-- they should be called from sirsem.lua wrappers that
-- can provide alternative implementations or error
-- messages when cortav is build in plain lua mode
local native = _G.native

function ss.map(fn, lst)
	local new = {}
	for k,v in pairs(lst) do
		table.insert(new, fn(v,k))
	end
	return new
end
function ss.reduce(fn, acc, lst)
	for i,v in ipairs(lst) do
		acc = fn(acc, v, i)
	end
	return acc
end
function ss.filter(list, fn)
	local new = {}
	for i, v in ipairs(list) do
		if fn(v,i) then table.insert(new, v) end
	end
	return new
end
function ss.kmap(fn, list)
	local new = {}
	for k, v in pairs(list) do
		local nk,nv = fn(k,v)
		new[nk or k] = nv or v
	end
	return new
end
function ss.tmap(fn, a, ...)
	if a == nil then return end
	return fn(a), ss.tmap(fn, ...)
end

function ss.kfilter(list, fn)
	local new = {}
	for k, v in pairs(list) do
		if fn(k,v) then new[k] = v end
	end
	return new
end

function ss.find(tbl, pred, ...)
	pred = pred or function(a,b)
		return a == b
	end
	for k,v in pairs(tbl) do
		if pred(v,k,...) then return k,v end
	end
	return nil
end

function ss.clone(tbl) -- performs a shallow copy
	if tbl.clone then return tbl:clone() end
	local new = {}
	for k,v in pairs(tbl) do
		new[k] = v
	end
	return new
end

function ss.copy(tbl) -- performs a deep copy
	local new = {}
	for k,v in pairs(tbl) do
		if type(v) == 'table' then
			if v.clone then
				new[k] = v:clone() -- this may or may not do a deep copy!
			else
				new[k] = ss.copy(v)
			end
		else
			new[k] = v
		end
	end
	return new
end

function ss.push(tbl, ...)
	local idx = #tbl + 1
	local function rec(v, ...)
		tbl[idx] = v
		idx = idx + 1
		if ss.tuple.any(...) then rec(...) end
	end
	rec(...)
	return tbl
end

function ss.delegate(tbl,tpl) -- returns a table that looks up keys it lacks from
                              -- tbl (lightweight alternative to shallow copies)
	tpl = tpl or {}
	return setmetatable({}, {__index=tbl})
end

ss.str = {}

if native then
	function ss.str.begins(str, pfx)
		return native.strutils.rangematch(str,1,pfx)
	end
else
	function ss.str.begins(str, pfx)
		-- appallingly, this is actually ~2/5ths faster than either
		-- of the below. i hate scripting languages so much
		return string.find(str, pfx, 1, true) == 1
		-- to my shock, disgust, and horror, even writing my own
		-- string scanning library for lua IN C only sped this up by
		-- a tiny fraction. i am just speechless.
	-- 	return string.sub(str, 1, #pfx) == pfx

	-- 	local pl = string.len(pfx)
	-- 	local sl = string.len(str)
	-- 	if sl < pl then return false end
	-- 	for i=1,pl do
	-- 		if string.byte(str,i) ~= string.byte(pfx,i) then
	-- 			return false
	-- 		end
	-- 	end
	-- 	return true
	end
end

function ss.enum(syms)
	local e = {}
	for i,v in pairs(syms) do
		e[v] = i
		e[i] = v
	end
	return e
end

function ss.bitmask_bytes(n,ofs)
	ofs = ofs or 0
	local function rec(i)
		if i > n then return end
		return 1<<(i+ofs), rec(i+1)
	end
	return 1<<ofs, rec(1)
end

function ss.bitmask(tbl,ofs)
	local codes = {ss.bitmask_bytes(#tbl,ofs)}
	local m = {}
	local maxbit
	for i, s in ipairs(tbl) do
		m[s] = codes[i]
		m[codes[i]] = s
		maxbit = i
	end
	m[true] = {ofs or 0,maxbit}
	return m
end

ss.str.charclass = ss.enum {
	'numeral'; 'letter'; 'symbol'; 'punct';
	'space'; 'ctl'; 'glyph'; -- hanji
}
ss.str.charprop = ss.bitmask({
	'hexnumeral', -- character that can be used to write hexadecimal notation
	'upper', 'lower';
	'diac'; -- diacritic/modifier letter
	'wordbreak'; -- char causes following characters to be treated as a separate word (e.g. punctuation)
	'wordsep'; -- char causes previous and following characters to be treated as separate words; char constitutes a word of its own in between (e.g. interpunct)
	'breakokay'; -- is it okay to break words at this character? (eg hyphen)
	'mathop'; -- char is a mathematical operator
	'disallow', -- char is not allowed in narrative text
	'brack', 'right', 'left', -- brackets
	'noprint', -- character deposits no ink
	'superimpose' -- character is superimposed over previous
}, 3)

ss.str.enc_generics = {
	pfxescape = function(ch, enc, chain)
		local bytes = #ch
		local codes = enc.len(ch)
		return function(s)
			if s == ch then
				return 0, 0, ch
			elseif ss.str.begins(s, ch) then
				local nc = enc.char(enc.codepoint(s, bytes + 1))
				return bytes, codes, nc
			elseif chain then
				return chain(s)
			end
		end
	end;
};

local cc,cp = ss.str.charclass, ss.str.charprop
ss.str.enc = {
	utf8 = {
		char = utf8.char;
		codepoint = utf8.codepoint;
		len = utf8.len;
		encodeUCS = function(str) return str end;
		iswhitespace = function(c)
			return (c == ' ') or (c == '\t') or (c == '\n')
				or (c == '\u{3000}')
				or (c == '\u{200B}')
      end;
	};
	ascii = {
		len = string.len; char = string.char; codepoint = string.byte;
		iswhitespace = function(c)
			return (c == ' ') or (c == '\t') or (c == '\n')
      end;
		ranges = {
			{0x00,0x1a, cc.ctl};
			{0x1b,0x1b, cc.ctl | cp.disallow};
			{0x1c,0x1f, cc.ctl};
			{0x20,0x20, cc.space};
			{0x21,0x22, cc.punct};
			{0x23,0x26, cc.symbol};
			{0x27,0x29, cc.punct};
			{0x2a,0x2b, cc.symbol};
			{0x2c,0x2f, cc.punct};
			{0x30,0x39, cc.numeral | cp.hexnumeral};
			{0x3a,0x3b, cc.punct};
			{0x3c,0x3e, cc.symbol | cp.mathop};
			{0x3f,0x3f, cc.punct};
			{0x40,0x40, cc.symbol};
			{0x41,0x46, cc.letter | cp.upper | cp.hexnumeral};
			{0x47,0x5a, cc.letter | cp.upper};
			{0x5b,0x5d, cc.symbol | cp.mathop};
			{0x5e,0x5e, cc.symbol | cp.mathop};
			{0x5f,0x60, cc.symbol};
			{0x61,0x66, cc.letter | cp.lower | cp.hexnumeral};
			{0x67,0x7a, cc.letter | cp.lower};
			{0x7b,0x7e, cc.symbol};
			{0x7f,0x7f, cc.ctl, cp.disallow};
		}
	};
	raw = {len = string.len; char = string.char; codepoint = string.byte;
		encodeUCS = function(str) return str end;
		iswhitespace = function(c)
			return (c == ' ') or (c == '\t') or (c == '\n')
      end;
   };
}

-- unicode ranges are optionally generated from consortium data
-- files and injected through a generated source file. if this
-- part of the build process is disabled (e.g. due to lack of
-- internet access, or to keep the size of the executable as
-- small as possible), we still at least can make the ascii
-- ranges available to UTF8 (UTF8 being a superset of ascii)
ss.str.enc.utf8.ranges = ss.str.enc.ascii.ranges

function ss.str.enc.ascii.encodeUCS(str)
	local newstr = ''
	for c,p in ss.str.each(ss.str.enc.utf8, str, true) do
		if c > 0x7F then
			newstr = newstr .. '?'
		else
			newstr = newstr .. string.char(c)
		end
	end
end

for _, v in pairs{'utf8','ascii','raw'} do
	ss.str.enc[v].parse_escape = ss.str.enc_generics.pfxescape('\\',ss.str.enc[v])
end

function ss.bitmask_expand(ty, v)
	local bitrange = ty[true]
	local fb
	if bitrange[1] ~= 0 then
		fb = v & ((1<<bitrange[1]) - 1) -- first N bits
	end
	local tbl = {}
	for j=bitrange[1], bitrange[2] do
		if (fb & (1<<j)) ~= 0 then
			tbl[ty[1<<j]] = true
		end
	end
	return tbl, fb
end

function ss.str.classify(enc, ch)
	if not enc.ranges then return {} end
	if type(ch)=='string' then ch = enc.codepoint(ch) end

	for _, r in pairs(enc.ranges) do
		if ch >= r[1] and ch <= r[2] then
			local p,b = ss.bitmask_expand(ss.str.charprop, r[3])
			if b then p[ss.str.charclass[b]] = true end
			return p
		end
	end

	return {}
end


function ss.str.each(enc, str, ascode)
	if enc.each then return enc.each(enc,str,ascode) end
	local pm = {
		__index = {
			esc = function(self)
				local ba, bc, nc = enc.parse_escape(str:sub(self.byte))
				if ba then
					self.next.byte = self.next.byte + ba - 1
					self.next.code = self.next.code + bc - 1
					return nc
				end
			end;
		};
	}
	local pos = {
		code = 1;
		byte = 1;
	}
	return function()
		if pos.byte > #str then return nil end
		local thischar = enc.codepoint(str, pos.byte)
		local lastpos = setmetatable({
			code = pos.code;
			byte = pos.byte;
			next = pos;
		},pm)
		if not ascode then
			thischar = enc.char(thischar)
			pos.byte = pos.byte + #thischar
		else
			pos.byte = pos.byte + #enc.char(thischar)
		end
		pos.code = pos.code + 1
		return thischar, lastpos
	end
end

function ss.str.breakwords(enc, str, max, opts)
	if enc.breakwords then return enc.breakwords(str) end
	local words = {}
	opts = opts or {}
	local buf = ''
	local flush = function()
		if buf ~= '' then table.insert(words,buf) buf = '' end
	end
	for c, p in ss.str.each(enc,str) do
		local nc
		if opts.escape then
			nc = p:esc()
		end
		if nc then
			buf = buf + nc
		elseif enc.iswhitespace(c) then
			flush()
			if max and #words == max then
				local rs = str:sub(p.next.byte)
				if rs ~= '' then
					table.insert(words, rs)
				end
				break
			end
		else
			buf = buf .. c
		end
	end
	flush()
	return words
end
function ss.str.mergewords(enc, lst)
	if enc.mergewords then return enc.mergewords(lst) end
	return table.concat(lst, enc.wordsep or ' ')
end
function ss.str.breaklines(enc, str, opts)
	if enc.breaklines then return enc.breaklines(lst,opts) end
	return ss.str.split(enc, str, enc.encodeUCS'\n', opts)
end

function ss.str.split(enc, str, delim, opts)
	if enc.split then return enc.split(str,delim,opts) end
	opts = opts or {}
	local elts = {}
	local buf = ''
	local flush = function()
		if buf ~= '' or opts.keep_empties then
			table.insert(elts,buf)
			buf = ''
		end
	end
	local esc = enc.parse_escape
	local tryesc if opts.escape then
		tryesc = function(str, p)
			local ba, ca, escd = enc.parse_escape(str:sub(p.byte))
			if ba then
				p.next.byte = p.next.byte + ba
				p.next.code = p.next.code + ca
				buf = buf .. escd
				return true
			end
		end
	else
		tryesc = function(...)  end
	end

	if type(delim) == 'function' then
		for c, p in ss.str.each(enc,str) do
			if not tryesc(str,p) then
				local skip = delim(str:sub(p.byte))
				if skip then
					flush()
					p.next.byte = p.next.byte + skip - 1
				else
					buf = buf .. c
				end
			end
		end
	elseif enc.len(delim) == 1 then
		for c, p in ss.str.each(enc,str) do
			if not tryesc(str,p) then
				if c == delim then
					flush()
				else
					buf = buf .. c
				end
			end
		end
	else
		local dlcode = enc.len(delim)
		for c, p in ss.str.each(enc,str) do
			if not tryesc(str,p) then
				if str:sub(p.byte, p.byte+#delim-1) == delim then
					flush()
					p.next.byte = p.next.byte + #delim - 1
					p.next.code = p.next.code + dlcode
				else
					buf = buf .. c
				end
			end
		end
	end
	flush()
	return elts
end

function ss.str.langmatch(tbl, lang, enc)
	-- this performs primitive language matching. NOTE: THIS IS NOT
	-- STANDARDS COMPLIANT. it's "good enough" for now, but in the
	-- long term it needs to be rewritten to actually understand the
	-- format, primarily so that e.g. 'en-US-Latn' and 'en-Latn-US'
	-- match -- currently order is significant. it shouldn't be
	-- ref: IETF BCP 47 (RFC 5646) https://www.ietf.org/rfc/bcp/bcp47.html
	local dash = enc.encodeUCS'-'
	local tags = ss.str.split(enc, lang, dash, {escape=true})
	local bestlen = 0
	local bestmatch
	for k,v in pairs(tbl) do
		if k ~= true then
			local kt = ss.str.split(enc, k, dash, {escape=true})
			for i=1,math.min(#kt,#tags) do
				if kt[i] ~= tags[i] then goto skip end
			end
			if #kt > bestlen then
				-- match the most specific matching tag
				bestmatch = k
				bestlen = #kt
			end
		end
	::skip::end
	return tbl[bestmatch] or tbl[true], bestmatch
end

function ss.str.b64e(str)
	local bytes = {}
	local n = 1
	for i=1, #str, 3 do
		local triple = {string.byte(str, i, i+2)}
		local T = function(q)
			return triple[q] or 0
		end
		local B = function(q)
			if q <= 25 then
				return string.char(0x41 + q)
			elseif q <= 51 then
				return string.char(0x61 + (q-26))
			elseif q <= 61 then
				return string.char(0x30 + (q-52))
			elseif q == 62 then
				return '+'
			elseif q == 63 then
				return '/'
			else error('base64 algorithm broken') end
		end
		local quads = {
			((T(1) & 0xFC) >> 2);
			((T(1) & 0x03) << 4) | ((T(2) & 0xF0) >> 4);
			((T(2) & 0x0F) << 2) | ((T(3) & 0xC0) >> 6);
			((T(3) & 0x3F));
		}

		bytes[n + 0] = B(quads[1])
		bytes[n + 1] = B(quads[2])
		if triple[2] then
			bytes[n + 2] = B(quads[3])
			if triple[3] then
				bytes[n + 3] = B(quads[4])
			else
				bytes[n + 3] = '='
			end
		else
			bytes[n + 2] = '='
			bytes[n + 3] = '='
		end

		n = n + 4
	end

	return table.concat(bytes)
end

function ss.str.b64d(str)
end

ss.math = {}

function ss.math.lerp(t, a, b)
	return (1-t)*a + (t*b)
end

function ss.dump(o, state, path, depth)
	state = state or {tbls = {}}
	depth = depth or 0
	local pfx = string.rep('   ', depth)
	if type(o) == "table" then
		local str = ''
		for k,p in pairs(o) do
			local done = false
			local exp
			if type(p) == 'table' then
				if state.tbls[p] then
					exp = '<' .. state.tbls[p] ..'>'
					done = true
				else
					state.tbls[p] = path and string.format('%s.%s', path, k) or k
				end
			end
			if not done then
				local function dodump() return ss.dump(
					p, state,
					path and string.format("%s.%s", path, k) or k,
					depth + 1
				) end
				-- boy this is ugly
				if type(p) ~= 'table' or
					getmetatable(p) == nil or
					getmetatable(p).__tostring == nil then
					exp = dodump()
				end
				if type(p) == 'table' then
					exp = string.format('{\n%s%s}', exp, pfx)
					local meta = getmetatable(p)
					if meta then
						if meta.__tostring then
							exp = tostring(p)
						end
						if meta.__name then
							exp = meta.__name .. ' ' .. exp
						end
					end
				end
			end
			str = str .. pfx .. string.format("%s = %s\n", k, exp)
		end
		return str
	elseif type(o) == "string" then
		return string.format('“%s”', o)
	else
		return tostring(o)
	end
end

function ss.hexdump(s)
	local hexlines, charlines = {},{}
	for i=1,#s do
		local line = math.floor((i-1)/16) + 1
		hexlines[line] = (hexlines[line] or '') .. string.format("%02x ",string.byte(s, i))
		charlines[line] = (charlines[line] or '') .. ' ' .. string.gsub(string.sub(s, i, i), '[^%g ]', '\x1b[;35m·\x1b[36;1m') .. ' '
	end
	local str = ''
	for i=1,#hexlines do
		str = str .. '\x1b[1;36m' .. charlines[i] .. '\x1b[m\n' .. hexlines[i] .. '\n'
	end
	return str
end

function ss.declare(c)
	local cls = setmetatable({
		__name = c.ident;
	}, {
		__name = 'class';
		__tostring = function() return c.ident or '(class)' end;
	   __index = c.cfns;
	})

	cls.__call = c.call
	cls.__index = function(self, k)
		if c.default and c.default[k] then
			return c.default[k]
		end
		if k == 'clone' then
			return function(self)
				local new = cls.mk()
				for k,v in pairs(self) do
					new[k] = v
				end
				if c.clonesetup then
					c.clonesetup(new, self)
				end
				return new
			end
		elseif k == 'to' then
			return function(self, to, ...)
				if to == 'string' then return tostring(self)
				elseif to == 'number' then return tonumber(self)
				elseif to == 'int' then return math.floor(tonumber(self))
				elseif c.cast and c.cast[to] then
					return c.cast[to](self, ...)
				elseif type(to) == 'table' and getmetatable(to) and getmetatable(to).cvt and getmetatable(to).cvt[cls] then
				else error((c.ident or 'class') .. ' is not convertible to ' .. (type(to) == 'string' and to or tostring(to))) end
			end
		end
		if c.fns and c.fns[k] then return c.fns[k] end
		if c.index then return c.index(self,k) end
	end

	if c.cast then
		if c.cast.string then
			cls.__tostring = c.cast.string
		end
		if c.cast.number then
			cls.__tonumber = c.cast.number
		end
	end

	if c.op then
		cls.__add = c.op.sum
		cls.__sub = c.op.sub
		cls.__div = c.op.div
		cls.__mul = c.op.mul
		cls.__concat = c.op.cat
		cls.__eq = c.op.eq
		cls.__lt = c.op.lt
	end

	cls.mk = function(...)
		local val = setmetatable(c.mk and c.mk(...) or {}, cls)
		if c.init then
			for k,v in pairs(c.init) do
				val[k] = v
			end
		end
		if c.construct then
			c.construct(val, ...)
		end
		return val
	end
	getmetatable(cls).__call = function(_, ...) return cls.mk(...) end
	cls.is = function(o) return getmetatable(o) == cls end
	cls.__metatable = cls -- lock metatable
	return cls
end

-- tidy exceptions

ss.exn = ss.declare {
	ident = 'exn';
	mk = function(kind, ...)
		return {
			vars = {...};
			kind = kind;
		}
	end;
	cast = {
		string = function(me)
			return me.kind.report(table.unpack(me.vars))
		end;
	};
	fns = {
		throw = function(me) error(me) end;
	}
}
ss.exnkind = ss.declare {
	ident = 'exn-kind';
	mk = function(desc, report)
		return {
			desc = desc;
			report = report or function(msg,...)
				return string.format(msg,...)
			end;
		}
	end;
	call = function(me, ...)
		return ss.exn(me, ...)
	end;
}
ss.str.exn = ss.exnkind 'failure while string munging'
ss.bug = ss.exnkind 'tripped over bug'

function ss.str.delimit(encoding, start, stop, s)
	local depth = 0
	encoding = encoding or ss.str.enc.utf8
	if not ss.str.begins(s, start) then return nil end
	for c,p in ss.str.each(encoding,s) do
		if c == (encoding.escape or '\\') then
			p.next.byte = p.next.byte + #encoding.char(encoding.codepoint(s, p.next.byte))
			p.next.code = p.next.code + 1
		elseif c == start then
			depth = depth + 1
		elseif c == stop then
			depth = depth - 1
			if depth == 0 then
				return s:sub(1+#start, p.byte - #stop), p.byte -- FIXME
			elseif depth < 0 then
				ss.str.exn('out of place token “%s”', stop):throw()
			end
		end
	end

	ss.str.exn('token “%s” expected before end of line', stop):throw()
end

ss.version = ss.declare {
	name = 'version';
	mk = function(tbl) return tbl end;
	fns = {
		pre = function(self,other) end;
		post = function(self,other) end;
		string = function(self) return tostring(self) end;
	};
	cast = {
		string = function(vers)
			if not(next(vers)) then return '0.0' end
			local str = ''
			for _,v in pairs(vers) do
				if type(v) == 'string' then
					if str ~= '' then str = str .. '-' end
					str = str .. v
				else
					if str ~= '' then str = str .. '.' end
					str = str .. tostring(v)
				end
			end
			return str
		end
	};
}

function ss.classinstance(o)
	local g = getmetatable(o)
	if not g then return nil end
	local mm = getmetatable(g)
	if not mm then return nil end
	if mm.__name == 'class' then
		return g
	else
		return nil
	end
end

function ss.walk(o, key, ...)
	if o[key] then
		if select('#', ...) == 0 then
			return o[key]
		else
			return ss.walk(o[key], ...)
		end
	end
	return nil
end

function ss.coalesce(x, ...)
	if x ~= nil then
		return x
	elseif select('#', ...) == 0 then
		return nil
	else
		return ss.coalesce(...)
	end
end

ss.tuple = {}
function ss.tuple.any(...)
	return select('#',...) > 0
end

function ss.tuple.cat(...)
	local a = {...}
	return function(...)
		ss.push(a, ...)
		return table.unpack(a)
	end
end

function ss.tuple.suffix(sfx,n,...)
	if n ~= nil then
		return n, ss.tuple.suffix(...)
	else
		return sfx
	end
end

function ss.tuple.cdr(x, ...) return ... end

ss.stack = ss.declare {
	ident = 'stack';
	mk = function() return {
		top = 0;
		store = {};
	} end;
	index = function(me, i)
		if i <= 0 then
			return me.store[me.top + i]
		else
			return me.store[i]
		end
	end;
	fns = {
		push = function(me, val, ...)
			if val~=nil then
				me.top = me.top + 1
				me.store[me.top] = val
				me:push(...)
			end
			return val, ...
		end;
		pop = function(me,n) n = n or 1
			local r = {}
			if n < me.top then
				for i = 0,n-1 do
					r[i+1] = me.store[me.top - i]
					me.store[me.top - i] = nil
				end
				me.top = me.top - n
			else
				r = me.store
				me.store = {}
			end
			return table.unpack(r)
		end;
		set = function(me,val)
			if me.top == 0 then
				me.top = me.top + 1 --autopush
			end
			me.store[me.top] = val
		end;
		all = function(me) return table.unpack(me.store) end;
		each = function(me,forward)
			if forward then
				local idx = 0
				return function()
					idx = idx + 1
					if idx > me.top
						then return nil
						else return me.store[idx], idx
					end
				end
			else
				local idx = me.top + 1
				return function()
					idx = idx - 1
					if idx == 0
						then return nil
						else return me.store[idx], idx
					end
				end
			end
		end;
	};
}

ss.automat = ss.declare {
	ident = 'automat';
	mk = function() return {
		state = ss.stack();
		states = {};
		ttns = {};
		mem = {};
		match = function(sym, ttn, mach)
			if ttn.pred and ttn:pred(mach, sym)~=true then
				return false
			end
			if ttn.on then
				return sym == ttn.on
			end
			return false
		end;
	} end;

	construct = function(me, def)
		for k,v in pairs{'states','ttns','mem','syms'} do
			if def[k] then me[k] = v end
		end
	end;

	fns = {
		react = function(me,sym)
			local s = me.states[me.state.id]
			if s and s.input then
				s:react(me, sym)
			end
		end;

		drop = function(me,n)
			for i = 0, math.min(n-1,me.state.top-1) do
				local s = me.states[me.state[-i].id]
				if s.exit then s:exit(s.mem, me) end
			end
			if n < me.state.top then
				local newtop = me.states[me.state[-n].id]
				if newtop.activate then newtop:activate(me.state[-n].mem, me, n) end
			end
			return me.state:pop(n)
		end;
		clear = function(me) return me:drop(me.state.top) end;

		transition = function(me,ttn,oldstates)
			local s = me.state:push {id = ttn.to, mem = {}}
			local to = me.states[ttn.to]
			if to.enter then
				to:enter(s.mem, me)
			end
		end;

		input = function(me,sym)
			local ttns = me.ttns[me.state.id]
			local _, ttn = ss.find(ttns, function(ttn)
			                        return me.match(sym, ttn, me)
			                       end)
			if ttn then
				if ttn.pop then
					local oldstates = {me.state:drop(ttn.pop)}
					me:transition(ttn, sym, oldstates)
				else
					me:transition(ttn, sym)
				end
			else
				me:react(sym)
			end
		end;
	};
}

function ss.math.clamp(v, l, h)
	return math.max(math.min(v, h or 1), l or 0)
end

-- convenience buffer for holding strings under
-- construction, accumulating and compiling then in
-- as quick a way as lua permits
ss.strac = ss.declare {
	ident = 'string-accumulator';
	mk = function() return {
		strs = {};
		strc = 0;
		plain = true;
	} end;
	call = function(self, s, ...)
		if s == nil then return end
		self.strc = self.strc + 1
		self.strs[self.strc] = s
		if type(s) ~= 'string' then self.plain = false end
		self(...)
	end;
	cast = {
		string = function(self)
			return self:compile()
		end;
	};
	fns = {
		compile = function(self, delim)
			if self.plain then
				return table.concat(self.strs, delim)
			end
			local tbl = {}
			local function delve(a)
				for i=1,a.strc do
					local s = a.strs[i]
					if type(s) == 'string' then
						table.insert(tbl, s)
					elseif ss.strac.is(s) then
						delve(s)
					elseif s ~= nil then
						table.insert(tbl, tostring(s))
					end
				end
			end
			delve(self)
			return table.concat(tbl, delim)
		end;
		wrap = function(self,a,b)
			table.insert(self.strs, 1, a)
			table.insert(self.strs, b)
		end;
	};
}

-- color class based on c.hale.su/sorcery's, hsl conversion
-- code written by glowpelt. TODO switch to LCH
local function clip(v, ...)
	if v == nil then return end
	return math.max(0,math.min(0xFF,math.floor(v))), clip(...)
end;
local function bytefrac(f, ...)
	if f == nil then return end
	return clip(f*0xFF), bytefrac(...)
end
ss.color = ss.declare {
	ident = 'color';
	mk = function(h,s,l,a) return {
		hue = h or 0.0;
		sat = s or 0.0;
		lum = l or 0.0;
		alpha = a or 1.0;
	} end;
	cfns = {
		byteclip = clip;
		bytefrac = bytefrac;
	};
	cast = {
		string = function(self) return self:hex() end;
		number = function(self) return self:u32() end;
	};
	op = {
		sum = function(self, other)
			if ss.color.is(other) then
				local fac = ss.math.lerp(self.alpha, 1, other.alpha)
				return self:blend(other, fac):warp(function(c)
					c.alpha = ss.math.clamp(self.alpha+other.alpha)
				end)
			else -- color + number = brighter color
				return self:warp(function(c)
					c.lum = c.lum + other
				end)
			end
		end;
		mul = function(self, other)
			if ss.color.is(other) then
				ss.color.exn 'how the heck do you multiply in hsl anyway':throw()
			else
				return self:warp(function(c)
					c.lum = c.lum * other
				end)
			end
		end;
	};
	fns = {
		tuple = function(self)
			return self.hue, self.sat, self.lum, self.alpha
		end;
		warp = function(self, func)
			local n = self:clone()
			func(n)
			return n
		end;
		blend = function(self, other, fac)
			return ss.color(
				ss.math.lerp(fac, self.hue, other.hue),
				ss.math.lerp(fac, self.sat, other.sat),
				ss.math.lerp(fac, self.lum, other.lum),
				ss.math.lerp(fac, self.alpha, other.alpha))
		end;
		hex = function(self)
			local r,g,b,a = bytefrac(self:rgb_t())
			if self.alpha == 1 then a = nil end
			return string.format('#'..string.rep('%02x',a and 4 or 3),
				r,g,b,a)
		end;
		u32 = function(self)
			local r,g,b,a = bytefrac(self:rgb_t())
			return r<<24 | g << 16 | b << 8 | a
		end;
		bytes = function(self)
			return { bytefrac(self:rgb_t()) }
		end;
		alt = function(self, fld, new)
			if self[fld] then
				return self:warp(function(c) c[fld]=new end)
			else
				ss.color.exn('no such field %s in color', fld):throw()
			end
		end;
		rgb = function(self)
			-- convenience function to get a standardized struct
			local r,g,b,a = self:rgb_t()
			return {
				red = r;
				green = g;
				blue = b;
				alpha = a;
			}
		end;
		rgb_t = function(self)
			-- returns rgba values as a tuple
			local value = function(n1, n2, hue)
				if hue > 360 then
					hue = hue - 360
				elseif hue < 0 then
					hue = hue + 360
				end
				if hue < 60 then
					return n1 + (n2 - n1) * hue/60
				elseif hue < 180 then
					return n2
				elseif hue < 240 then
					return n1 + (n2 - n1) * (240 - hue)/60
				else
					return n1
				end
			end
			local h,s,l,alpha = self:tuple()
			local m2
			if l < 0.5 then
				m2 = l * (1 + s)
			else
				m2 = l + s - l * s
			end
			local m1 = 2 * l - m2
			if s == 0 then
				-- Achromatic, there is no hue
				-- In book this errors if hue is not undefined, but we set hue to 0 in this case, not nil or something, so
				return l, l, l, alpha
			else
				-- Chromatic case, so there is a hue
				return
					value(m1, m2, h + 120),
					value(m1, m2, h),
					value(m1, m2, h - 120),
					alpha
			end
		end;
	};
};
ss.color.exn = ss.exnkind 'color error'

ss.cmdfmt = function(cmd, ...)
	return string.format(cmd, ss.tmap(function(s)
		if typeof(s) == 'string' then
			return string.format("%q", s)
			-- FIXME this is incredibly lazy and uses lua quoting, not
			-- bourne shell quoting. it *will* cause problems if anything
			-- exotic finds its way in and needs to be fixed.
			-- TODO provide a proper popen in the C wrapper so wrapped
			-- versions at least can launch programs in a sane and secure
			-- way.
		else
			return s
		end
	end, ...))
end

local fetchexn = ss.exnkind 'fetch'
local fetchableProtocols = {
	http = {
		proto = {
			{'http'};
			{'https'};
			{'http', 'tls'};
		};
		fetch = native and native.net and function(uri)
			-- translate to a curl-compatible URI
			if uri.path and uri.path ~= '' and uri.path:sub(1,1) ~= '/' then
				fetchexn('relative HTTP URIs like “%s” are not fetchable', uri):throw()
			end
			uri = uri:clone()
			if uri.class[2] == 'tls' then
				uri.class = {'https'}
			end
			if not uri.namespace then
				uri.namespace = 'localhost'
			end
			local body, e = native.net.fetchURI(tostring(uri))
			if e then
				fetchexn('could not fetch URI “%s”: %s',uri,e):throw()
			end
			return body
		end or function(uri)
			fetchexn('cortav must be compiled with the C shim and libcurl support to use http fetch'):throw()
		end;
	};
	file = {
		proto = {
			{'file'};
			{'file', 'txt'};
			{'file', 'bin'};
			{'asset'};
			{'asset', 'txt'};
			{'asset', 'bin'};
		};
		fetch = function(uri, env)
			local assetDir = env.asset_base or '.'
			if uri.namespace then
				fetchexn('authority (hostname) segment is not supported in file: URIs'):throw()
			end
			if uri.svc then
				fetchexn('service segment is not supported in file: URIs'):throw()
			end
			local mode = 'r'
			local path = uri.path
			if uri.class[1] == 'asset' then path = assetDir ..'/'.. path end
			if uri.class[2] == 'bin'   then mode = 'rb' end
			local fd,e = io.open(path, mode)
			if not fd then
				fetchexn('IO error fetching URI “%s” (%s)', tostring(uri), e):throw()
			end
			local data = fd:read '*a'
			fd:close()
			return data
		end;
	};
}

function ss.match(a,b, eq)
	if #a ~= #b then return false end
	eq = eq or function(p,q) return p == q end
	for i = 1, #a do
		if not eq(a[i],b[i]) then return false end
	end
	return true
end

ss.os = {}
function ss.os.getcwd()
	return os.getenv 'PWD' -- :((( HAX
end

ss.path = ss.declare {
	ident = 'path';
	mk = function() return {
		relative = true;
		elts = {};
	} end;
	construct = function(me, o, rel)
		if type(o) == 'string' then
			if o:sub(1,1) == '/' then
				me.relative = false
			end
			me.elts = ss.str.split(ss.str.enc.ascii, o, '/')
		elseif type(o) == 'table' then
			me.elts = o
			me.relative = rel
		end
	end;
	clonesetup = function(me)
		me.elts = ss.clone(me.elts)
	end;
	cast = {
		string = function(me)
			return (me.relative and '' or '/') ..
				table.concat(me.elts, '/')
		end;
	};
	op = {
		sub = function(a,b)
			if a.relative ~= b.relative then
				return nil
			end

			local np = ss.path({}, true)
			local brk = false
			for i=1, math.max(#a.elts,#b.elts) do
				if not brk then
					if a.elts[i] ~= b.elts[i] then
						brk = true
					end
				end
				if brk then
					table.insert(np.elts, b.elts[i])
				end
			end

			return np
		end;
		sum = function(a,b)
			if b.relative == false then
				return nil
			end
			local n = a:clone()
			local i = #n.elts
			for j, v in ipairs(b.elts) do
				n.elts[i+j] = v
			end
			return n
		end;
		lt = function(a,b)
			-- '/a/b/c' < '/a/b/c/d'
			-- 'q/f/g' < 'q/f/g/p/d'
			-- '/a' !< '/b', '/a' !< 'a'
			if a.relative ~= b.relative then
				return false
			end
			if #a.elts > #b.elts then return false end
			for i=1, #a.elts do
				if a.elts[i] ~= b.elts[i] then
					return false
				end
			end
			return true
		end;
	};
	fns = {
		dir = function(me)
			local n = ss.copy(me.elts)
			n[#n] = nil
			local p = ss.path(n, me.relative)
		end;
		normalize = function(me)
			local np = ss.path({}, me.relative)
			for i, e in ipairs(me.elts) do
				if e == '..' then
					if me.relative and (
						next(np.elts) == nil or
						np.elts[#np.elts] == '..'
					) then
						table.insert(np.elts, '..')
					else
						table.remove(np.elts)
					end
				elseif e ~= '.' then
					table.insert(np.elts, e)
				end
			end
			return np
		end
	};
	cfns = {
		cwd = function()
			return ss.path(ss.os.getcwd())
		end;
	};
}

ss.uri = ss.declare {
	ident = 'uri';
	mk = function() return {
		class = nil;
		namespace = nil;
		path = nil;
		query = nil;
		frag = nil;
		auth = nil;
	} end;
	clonesetup = function(me)
		me.class = ss.clone(me.class)
	end;
	construct = function(me, str)
		local enc = ss.str.enc.utf8
		-- URIs must be either ASCII or utf8, so we  read and
		-- store as UTF8. to use a URI in another encoding, it
		-- must be manually converted to and fro using the
		-- appropriate functions, such as encodeUCS
		if not str then return end
		me.raw = str
		local rem = str
		local s_class do
			local s,r = rem:match '^([^:]+):(.*)$'
			s_class, rem = s,r
		end
		if not rem then
			ss.uri.exn('invalid URI “%s”', str):throw()
		end
		local s_ns do
			local s,r = rem:match '^//([^/?#]*)(.*)$'
			if s then s_ns, rem = s,r end
		end
		local h_query
		local s_frag
		local s_path if rem ~= '' then
			local s,q,r = rem:match '^([^?#]*)([?#]?)(.*)$'
			if s == '' then s = nil end
			s_path, rem = s,r

			if q == '#' then
				s_frag = rem
			elseif q == '?' then
				h_query = true
			end
		else s_path = '' end

		local s_query if h_query then
			local s,q,r = rem:match '^([^#]*)(#?)(.*)$'
			s_query, rem = s,r
			if q~='' then s_frag = rem end
		end

		local function dec(str)
			if not str then return end
			return str:gsub('%%([0-9A-Fa-f][0-9A-Fa-f])', function(hex)
				return string.char(tonumber(hex,16))
			end)
		end

		local s_auth if s_ns then
			local s,r = s_ns:match('^([^@]*)@(.*)$')
			if s then
				s_ns = r
				if s ~= '' then
					 s_auth = s
				end
			end
		end

		local s_svc if s_ns then
			local r,s = s_ns:match('^(.*):(.-)$')
			if r then
				s_ns = r
				if s and s ~= '' then
					s_svc = s
				end
			end
		end

		me.class = ss.str.split(enc, s_class, '+', {keep_empties=true})
		for i,v in ipairs(me.class) do me.class[i] = dec(v) end
		me.auth = dec(s_auth)
		me.svc = dec(s_svc)
		me.namespace = dec(s_ns)
		me.path = dec(s_path)
		me.query = dec(s_query)
		me.frag = dec(s_frag)
	end;
	cast = {
		string = function(me)
			return me:construct('class','namespace','path','query','frag')
		end;
	};
	fns = {
		canfetch = function(me)
			for id, pr in pairs(fetchableProtocols) do
				for _, p in ipairs(pr.proto) do
					if ss.match(me.class, p) then return id end
				end
			end
			return false
		end;
		construct = function(me, ...)
			local parts = {}
			local function add(n, ...)
				if n == nil then return end
				table.insert(parts, me:part(n))
				add(...)
			end
			add(...)
			return table.concat(parts)
		end;
		part = function(me, p)
			local function san(str, chars)
				-- TODO IRI support
				chars = chars or ''
				local ptn = '-a-zA-Z0-9_.,;'
				ptn = ptn .. chars
				return (str:gsub('[^'..ptn..']', function(c)
					if c == ' ' then return '+' end
					return string.format('%%%02X', string.byte(c))
				end))
			end
			if p == 'class' then
				if me.class == nil or next(me.class) == nil then
					return 'none:'
				end
				return table.concat(ss.map(san,me.class), '+') .. ':';
			else
				if me[p] == nil then return '' end
				if p == 'namespace' then
					local parts = {}
					if me.namespace or me.auth or me.svc then
						table.insert(parts, '//')
						if me.auth then
							table.insert(parts, san(me.auth,':') .. '@')
						end
						if me.namespace then
							table.insert(parts, san(me.namespace))
						end
						if me.svc then
							table.insert(parts, ':' .. san(me.svc))
						end
						if me.path and not ss.str.begins(me.path, '/') then
							table.insert(parts, '/')
						end
					end
					return table.concat(parts)
				elseif p == 'path' then
					return san(me.path,'+/=&')
				elseif p == 'query' then
					return '?' .. san(me.query,'?+/=&')
				elseif p == 'frag' then
					return '#' .. san(me.frag,'+/=&')
				end
			end
		end;
		fetch = function(me, env)
			local pid = me:canfetch()
			if (not pid) or fetchableProtocols[pid].fetch == nil then
				ss.uri.exn("URI “%s” is unfetchable", tostring(me)):throw()
			end
			local proto = fetchableProtocols[pid]
			return proto.fetch(me, env or {})
		end;
	};
}
ss.uri.exn = ss.exnkind 'URI'

ss.mime = ss.declare {
	ident = 'mime-type';
	mk = function() return {
		class = nil;
		kind = nil;
		opts = {};
	} end;
	construct = function(me,str)
		if not str then return end
		local p,o = str:match '^([^;]+);?%s*(.-)$'
		if not p then ss.mime.exn('invalid type syntax %s',str):throw() end
		local c,k = p:match '^([^/]+)/?(.-)$'
		me.class = (c ~= '') and c or nil
		me.kind = (k ~= '') and k or nil
		if o and o ~= '' then
			for key, e, val in o:gmatch '%s*([^=;]+)(=?)([^;]*)' do
				if me.opts[key] then
					ss.mime.exn('mime type cannot contain multiple %s options',key):throw()
				elseif me.opts.hex    and key == 'base64'
				    or me.opts.base64 and key == 'hex' then
					ss.mime.exn('mime type cannot more than one of (base64, hex)',key):throw()
				end
				if e == '' then val = true end
				me.opts[key] = val
			end
		end
	end;
	op = {
		eq = function(self, other)
		-- exact match operator
			if not ss.mime.is(other) then return ss.mime.exn("tried to compare MIME type %s against %s (%s)", tostring(self), type(other), tostring(other)):throw() end
			if (self.kind  == other.kind  or (self.kind == '*' or other.kind == '*')) and
			   (self.class == other.class or (self.class == '*' or other.class == '*')) and
			  (#self.opts  ==#other.opts) then
				for k,v in pairs(self.opts) do
					if not(other.opts[k] == '*' or (v == '*' and other.opts[k])) then
						if other.opts[k] ~= v then return false end
					end
				end
				for k,v in pairs(other.opts) do
					if not(self.opts[k] == '*' or (v == '*' and self.opts[k])) then
						if self.opts[k] ~= v then return false end
					end
				end
				return true
			else
				return false
			end
		end;
		lt = function(self,other)
		-- lt is the "subset?" operator -- it returns true if self
		-- matches at least as many fields as other has. use this
		-- when you have a base type and want to check whether
		-- another type is compatible with that type. say all you
		-- care about is whether a file is "text/plain", and it
		-- can be encoded however as long as that much fits.
		-- you would then ask ss.mime'text/plain' < file.mime
			return other:superset_of(self)
		end;
	};
	cast = {
		string = function(me)
			local r
			if me.kind and me.class then
				r = string.format('%s/%s',me.class,me.kind)
			elseif me.class then
				r = me.class
			end
			for k,v in pairs(me.opts) do
				if v and v ~= true then
					r = r .. string.format(';%s=%s',k,v)
				elseif v == true then
					r = r .. string.format(';%s',k)
				end
			end
			return r
		end;
	};
	fns = {
		superset_of = function(self, other)
		-- a mime type is greater than another if all the fields
		-- other has have a matching field in self. think of this
		-- as the "superset?" operator -- all fields and options
		-- on other must either match self or be unset
			if not ss.mime.is(other) then return ss.mime.exn("tried to compare MIME type %s against %s (%s)", tostring(self), type(other), tostring(other)):throw() end
			if (other.class and self.class ~= other.class and other.class ~='*')
			or (other.kind  and self.kind  ~= other.kind  and other.kind ~= '*')
				then return false end
			for k,v in pairs(other.opts) do
				if self.opts[k] and self.opts[k] ~= v and v ~='*' then
					return false
				end
			end
			return true
		end;
		is = function(me, pc)
			local mimeclasses = {
				['application/svg+xml'] = 'image';
				['application/x-tar'] = 'archive';
			}
			local c = me.class
			for k,v in pairs(mimeclasses) do
				if me > ss.mime(k) then
					c = v break
				end
			end
			return c == pc
		end;
	};
}
ss.mime.exn = ss.exnkind 'MIME error'


-- a composition table maps from a compose sequence to the tuple
-- {UTF8, htmlentity, UCS codepoint}
ss.compseq = {
	math = {
		{'*', '×', 'times', 0x2A2F};
		{'/', '÷', 'divide', 0x00F7};
		{'-', '−', 'minus', 0x2212};
		{'+-', '±', 'plusmn', 0x00B1};
		{'&&', '∧', 'and', 0x2227};
		{'||', '∨', 'or', 0x2228};
		{'&', '⋏', nil, 0x22CF};
		{'|', '⋎', nil, 0x22CE};
		{'~', '¬', 'not', 0x00AC};
		{'~=', '≠', 'ne', 0x2260};
		{'^=', '≜', 'trie', 0x225C};
		{':=', '≔', 'coloneq', 0x2254};
		{'::=', '⩴', nil, 0x2A74};
		{'==', '≡', 'equiv', 0x2261};
		{'===', '≣', nil, 0x2263};
		{'<=', '≤', 'le', 0x2264};
		{'>=', '≥', 'ge', 0x2265};
		{'?=', '≟', 'questeq', 0x225F};
		{'@<', '∝', 'prop', 0x221D};
		{'<>', '⋄', nil, 0x22C4};
		{'~~', '≈', 'asymp', 0x2248};
		{'<==>', '⟺', 'Longleftrightarrow', 0x27FA};
		{'<=>', '⇔', 'hArr', 0x21D4};
		{'==>', '⟹', 'DoubleLongRightArrow', 0x27F9};
		{'=>', '⇒', 'rArr', 0x21D2};
		{'<->', '↔', 'harr', 0x2194};
		{'->', '→', 'rarr', 0x2192};
		{'<-', '←', 'ShortLeftArrow', 0x2190};
		{'~|', '⊕', 'oplus', 0x2295};
		{'@A', '∀', 'forall', 0x2200};
		{'~@E', '∄', 'NotExists', 0x2204};
		{'@E', '∃', 'exist', 0x2203};
		{'.*.', '∴', 'therefore', 0x2234};
		{'*.*', '∵', 'because', 0x2235};
	};
};