View source for Module:Wikilisp

local export = {}

local wikilispversion = "0.19 (November 4, 2019)"

--[[ some basic abstractions ]]

local function stype( x ) -- type of sexpr
	local t = type( x )
	if t == "table" then t = x.type end
	return t
end

local function seterr( x, ... )
	if type(x) ~= "table" then
		return seterr( {}, x, ... )
	else
		x.type = "error"
		x.msg = mw.ustring.format( ... )
		return x
	end
end

--[[ parse text to a sequence of sexprs ]]

local function tok3( ls, t )
	-- tokenize lua string t, with no string literals comments or parens;
	--   append to ls
	local p1,p2 = mw.ustring.find( t, "[^%s]+" )
	while p1 ~= nil do
		local t1 = mw.ustring.sub(t, p1, p2)
		local n1 = tonumber(t1)
		if n1 ~= nil then
			ls[1 + #ls] = n1
		elseif t1 == "true" then
			ls[1 + #ls] = true
		elseif t1 == "false" then
			ls[1 + #ls] = false
		else
			ls[1 + #ls] = {
				type = "symbol",
				name = t1
			}
		end
		t = mw.ustring.sub(t, (p2 + 1))
		p1,p2 = mw.ustring.find( t, "[^%s]+" )
	end
end

local function tok2( ls, t )
	-- tokenize lua string t, with no string literals or comments; append to ls
	local p1 = mw.ustring.find( t, "[()\\]" )
	while p1 ~= nil do
		tok3( ls, mw.ustring.sub(t, 1, (p1 - 1)) )
		ls[1 + #ls] = { type = mw.ustring.sub(t, p1, p1) }
		if ls[#ls].type == "\\" then
			ls[#ls].name = ls[#ls].type
			ls[#ls].type = "symbol"
		end
		t = mw.ustring.sub(t, (p1 + 1))
		p1 = mw.ustring.find( t, "[()\\]" )
	end
	tok3( ls, t )
end

local function tok1( ls, t )
	-- tokenize lua string t, thru first string literal or comment; append to ls
	-- if not finished, append untokenized remainder string and return true
	local p0 = mw.ustring.find( t, ';' )
	local p1 = mw.ustring.find( t, '"' )
	local p2 = mw.ustring.find( t, "'" )
	if (p0 ~= nil) and (((p1 == nil) or (p0 < p1)) and
						((p2 == nil) or (p0 < p2))) then
		-- process a comment
		tok2( ls, mw.ustring.sub( t, 1, (p0 - 1) ) )
		p1 = mw.ustring.find( t, '\n', (p0 + 1) )
		if p1 == nil then
			return false
		else
			ls[1 + #ls] = mw.ustring.sub( t, (p1 + 1) )
			return true
		end
	elseif (p1 ~= nil) and ((p2 == nil) or (p1 < p2)) then
		-- process a string literal starting with double-quote
		p2 = p1 + 1
		while true do
			p2 = mw.ustring.find( t, '"', p2 )
			if p2 == nil then
				seterr(ls, 'mismatched string-literal delimiter (")')
				return false
			elseif (p2 < mw.ustring.len( t )) and
				(mw.ustring.codepoint( t, (p2 + 1) ) == 34)
			then
				p2 = (p2 + 2)
			else
				tok2( ls, mw.ustring.sub( t, 1, (p1 - 1) ) )
				ls[1 + #ls] = mw.ustring.gsub(
					mw.ustring.sub( t, (p1 + 1), (p2 - 1) ),
					'""', '"') -- inverse operation is at write_sexpr
				ls[1 + #ls] = mw.ustring.sub( t, (p2 + 1) )
				return true
			end
		end
	elseif p2 ~= nil then
		-- process a string literal starting with single-quote
		-- side benefit: precludes Lisp shorthand for "suppress eval"
		p1 = p2
		p2 = mw.ustring.find( t, "'", (p1 + 1) )
		if p2 == nil then
			seterr(ls, "mismatched string-literal delimiter (')")
			return false
		else
			tok2( ls, mw.ustring.sub( t, 1, (p1 - 1) ) )
			ls[1 + #ls] = mw.ustring.sub( t, (p1 + 1), (p2 - 1) )
			ls[1 + #ls] = mw.ustring.sub( t, (p2 + 1) )
			return true
		end
	else
		tok2( ls, t )
		return false
	end
end

local function parse_next( x1, p1, x2 )
	-- parse one sexpr from token list x1 position p1, append sexpr to p2
	-- return new value for p1
	if stype(x1[p1]) == ")" then
		seterr(x2, "unmatched right-paren")
		return 1 + #x1
	elseif stype(x1[p1]) ~= "(" then
		x2[1 + #x2] = x1[p1]
		return p1 + 1
	else
		p1 = p1 + 1
		local x3 = { type = "list" }
		x2[1 + #x2] = x3
		while p1 <= #x1 do
			if stype(x1[p1]) == ")" then
				return p1 + 1
			end
			p1 = parse_next( x1, p1, x3 )
		end
		seterr(x2, "unmatched left-paren")
		return p1
	end
end

local function parse_sexpr( x1 )
	-- x1 is an error or a list of tokens
	if x1.type ~= "list" then
		return x1
	else
		local p1 = 1 --next item to read from x1
		local x2 = { type = "list" }
		while p1 <= #x1 do
			p1 = parse_next( x1, p1, x2 )
		end
		return x2
	end
end

local function text_to_sexpr( t )
	local ls = { type = "list" }
	while tok1( ls, t ) do
		t = ls[#ls]
		ls[#ls] = nil
	end
	ls = parse_sexpr( ls )
	return ls
end

--[[ write/display a sexpr ]]

local function write_sexpr( x )
	if type(x) == "number" then
		return tostring( x )
	elseif type(x) == "string" then
		return mw.ustring.format('"%s"', mw.ustring.gsub( x, '"', '""' )) -- inverse operation is at tok1
	elseif type(x) == "boolean" then
		if x then return "true" else return "false" end
	elseif type(x) ~= "table" then
		return mw.ustring.format("&lt;unrecognized internal type: %s&gt;", type(x))
	elseif x.type == "symbol" then
		return x.name
	elseif x.type == "fn" then
		return mw.ustring.format("&lt;%s&gt;", write_sexpr( x.comb ))
	elseif x.type == "op" then
		if x.name ~= nil then
			return mw.ustring.format("[op: %s]", x.name)
		else
			return "[op]"
		end
	elseif x.type == "list" then
		local r = {}
		r[1] = "("
		for k = 1, #x do
			r[k+1] = write_sexpr( x[k] )
		end
		r[#r + 1] = ")"
		return table.concat(r, " ")
	elseif x.type == "error" then
		return mw.ustring.format("&lt;error: %s&gt;", x.msg)
	elseif x.type == "pattern" then
		return mw.ustring.format('&lt;pattern: "%s"&gt;', x.pat)
	elseif x.type ~= nil then
		return mw.ustring.format("&lt;unrecognized type: %s&gt;", x.type)
	else
		return "&lt;missing type&gt;"
	end
end

local function display_sexpr( x )
	if stype(x) == "string" then
		return x
	else
		return write_sexpr( x )
	end
end

--[[ evaluation tools ]]

local maxdepth = 4 -- maximum call-nesting depth

local combine

local function eval( x, env, depth )
	if type(x) ~= "table" then -- literal
		return x
	elseif x.type == "symbol" then
		local v = env[x.name]
		if v == nil then
			return seterr("undefined symbol: %s", x.name)
		else
			return v
		end
	elseif x.type ~= "list" then -- literal
		return x
	elseif #x == 0 then -- empty list
		return x
	else -- combination
		local c = eval( x[1], env, depth )
		if stype(c) == "error" then return c end
		local ls = { type = "list" }
		for k = 2, #x do
			ls[k - 1] = x[k]
		end
		return combine( c, ls, env, depth )
	end
end

combine = function( c, ls, env, depth )
	while stype(c) == "fn" do
		local ls2 = { type = "list" }
		for k = 1, #ls do
			ls2[k] = eval( ls[k], env, depth )
			if stype(ls2[k]) == "error" then return ls2[k] end
		end
		c = c.comb
		ls = ls2
	end
	if stype(c) ~= "op" then
		return seterr("called object is not a combiner: %s", write_sexpr(c))
	elseif (c.shallow ~= nil) then
		return c.op(ls, env, depth)
	elseif (depth == nil) or (depth < 1) then
		if maxdepth > 1 then
			return seterr(
				"exceeded maximum call-nesting depth (%i)",
				maxdepth)
		else
			return seterr("exceeded maximum call-nesting depth")
		end
	else
		return c.op(ls, env, (depth - 1))
	end
end

local function eval_seq( ls, env, depth )
	-- ls must be an error or a list
	if ls.type == "error" then return ls end
	if #ls == 0 then return ls end
	for k = 1, (#ls - 1) do
		local x = eval( ls[k], env, depth )
		if stype(x) == "error" then return x end
	end
	return eval( ls[#ls], env, depth )
end

local function eval_all( ls, env, depth, cutoff )
	-- ls must be an error or a list
	if ls.type == "error" then return ls end
	local ls2 = { type="list" }
	for k = 1, #ls do
		ls2[k] = eval( ls[k], env, depth )
		if stype(ls2[k]) == "error" then return ls2[k] end
		if (cutoff ~= nil) and cutoff(ls2[k]) then return ls2 end
	end
	return ls2
end

local function combine_all( ops, args, env, depth, cutoff )
	-- ops must be a list; args must be an error or a list
	if args.type == "error" then return args end
	local ls2 = { type="list" }
	for k = 1, #ops do
		ls2[k] = combine( ops[k], args, env, depth )
		if stype(ls2[k]) == "error" then return ls2[k] end
		if (cutoff ~= nil) and cutoff(ls2[k]) then return ls2 end
	end
	return ls2
end

--[[ generic combiner constructors ]]

local function make_op( f, nm, sh )
	return {
		type = "op",
		op = f,
		name = nm,
		shallow = sh
	}
end

local function checktype( t, o, k ) -- types list, operands list, index
	if #t == 0 then return "" end
	o = o[k] -- particular operand
	if k > #t then k = #t end
	t = t[k] -- particular type
	-- t should now be a string or internal function
	if type(t) == "string" then
		if stype(o) == t then t = "" end -- clear if no error
	else
		t = t(o) -- assume internal function works correctly
	end
	-- t should now be type name if error, empty string if okay
	return t
end

local function type_err( cname, tname, x )
	-- combiner name, type name(s), operand
	-- type name may be a string or an array of strings
	local where = ""
	if cname ~= nil then where = " to [op: " .. cname .. "]" end
	if type(tname) == "table" then
		if #tname == 0 then tname = "[unknown]"
		else
			for k = 1, #tname do
				while tname[k] == "" do
					for j = (k + 1), #tname do tname[j - 1] = tname[j] end
					tname[#tname] = nil
				end
				if tname[k] ~= nil then
					for j = (k + 1), #tname do
						if tname[k] == tname[j] then tname[j] = "" end
					end
				end
			end
			if #tname == 1 then tname = tname[1]
			else
				tname[#tname] = "or " .. tname[#tname]
				if #tname == 2
				then tname = table.concat( tname, " " )
				else tname = table.concat( tname, ", " )
				end
			end
		end
	end
	local what = write_sexpr(x)
	if #what > 64 then what = stype(x) end
	return seterr(
		"bad operand%s: expected %s, got %s", where, tname, what)
end

local function typed_op( ... )
	-- alternating type (string or function) and op (table or function)
	-- strong recommendation: first op should be a table
	local ls0 = { ... }
	local n0 = select( '#', ... )
	local opname, shallow
	if type(ls0[2]) == "table" then
		opname = ls0[2].name
		shallow = ls0[2].shallow
	end
	local f = function(ls, env, depth)
		if #ls == 0 then
			local op = ls0[2]
			if type(op) == "table" then op = op.op end
			return op( ls, env, depth )
		end
		local ek = 1 -- operand number of accumulated error type names
		local enames = {} -- list of failed types for ls[ek]
		for j = 1, n0, 2 do
			local types = ls0[j]
			local op = ls0[j + 1]
			if type(op) == "table" then op = op.op end
			local t = ""
			for k = 1, #ls do
				if #t == 0 then
					t = checktype( types, ls, k )
					if #t > 0 then
						if k > ek then
							ek = k
							enames = { t }
						elseif k == ek then
							enames[1 + #enames] = t
						end
					end
				end
			end
			if #t == 0 then return op( ls, env, depth ) end
		end
		return type_err( opname, enames, ls[ek] )
	end
	return make_op( f, opname, shallow )
end

local function nary_op( c, n, m )
	local f = function(ls, env, depth)
		if n < 0 then
			if #ls < -n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too few operands%s: expected at least %i, got %i",
					where, -n, #ls)
			end
		elseif m == nil then
			if #ls ~= n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"wrong number of operands%s: expected %i, got %i",
					where, n, #ls)
			end
		else
			if #ls < n then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too few operands%s: expected at least %i, got %i",
					where, n, #ls)
			elseif #ls > m then
				local where = ""
				if c.name ~= nil then where = " to [op: " .. c.name .. "]" end
				return seterr(
					"too many operands%s: expected at most %i, got %i",
					where, m, #ls)
			end
		end
		return c.op( ls, env, depth )
	end
	return make_op( f, c.name, c.shallow )
end

local function binary_pred( test, nm )
	return make_op(function (ls)
			for k = 2, #ls do
				if not test(ls[k - 1], ls[k]) then
					return false
				end
			end
			return true
		end, nm, true)
end

local function unary_pred( test, nm )
	return make_op(function (ls)
			for k = 1, #ls do
				if not test(ls[k]) then
					return false
				end
			end
			return true
		end, nm, true)
end

local function wrap( c )
	return {
		type = "fn",
		comb = c
	}
end

--[[ wiki parsing stuff
	entry:  (char-code  (first-pos  last-pos  left-index))
	        (descriptor  (first-pos  last-pos  left-index)  entry  entry  ...)
	item entries contain part entries, part entries contain item entries
	left-index is removed at end of parse
]]

local lsquare,rsquare, lcurly,rcurly, pipe = 91,93, 123,125, 124

local function wikileft(e) -- is entry a left-delimiter?
	return ((e[1] == lsquare) or (e[1] == lcurly)) and (e[2][1] ~= e[2][2])
end

local function wikilen(e) -- how long is this entry?
	return 1 + e[2][2] - e[2][1]
end

local function wikisub( m, d ) -- parse, descriptor
	local k2 = #m          -- index of right delimiter
	local k1 = m[k2][2][3] -- index of left delimiter
	local p = { type = "list", "part", { type = "list" } } -- first part
	p[2][1] = (m[k1][2][2] + 1) -- start of first part
	local e = { -- entry containing parts
		type = "list",
		d,
		{ type = "list",
		  (m[k1][2][2] - (m[k2][2][2] - m[k2][2][1])),
		  m[k2][2][2],
		  k1
		},
		p
	}
	for k = (k1 + 1), (k2 - 1) do
		if type(m[k][1]) ~= "number" then
			m[k][2][3] = nil
			p[1 + #p] = m[k]
		elseif m[k][1] == pipe then
			p[2][2] = (m[k][2][1] - 1) -- end of current part
			p = { type = "list", "part", { type = "list" } } -- next part
			p[2][1] = (m[k][2][2] + 1) -- start of this part
			e[1 + #e] = p -- add to list of parts
		end
		m[k] = nil
	end
	p[2][2] = (m[k2][2][1] - 1) -- end of last part
	m[k2] = nil
	m[k1][2][2] = (e[2][1] - 1)
	if (m[k1][2][1] > m[k1][2][2]) then
		e[2][3] = m[k1][2][3]
		m[k1] = nil
	end
	m[1 + #m] = e
end

local function parse_wiki( ls )
	local s = ls[1]                             -- string to parse
	local m = { type = "list" }                 -- result of parse
	local k = mw.ustring.find( s, "[%[%]{}|]" ) -- position in string
	while k ~= nil do
		local c = mw.ustring.codepoint(s,k)
		if #m == 0 then
			if (c == lsquare) or (c == lcurly) then
				m[1] = {type="list", c, {type="list", k, k, 0}}
			end
		elseif (k == (m[#m][2][2] + 1)) and (c == m[#m][1]) and (c ~= pipe) then
			m[#m][2][2] = k
			if m[#m][2][3] > 0 then
				local e2 = m[#m]
				local e1 = m[e2[2][3]]
				if (e2[1] == rcurly) and (e1[1] == lcurly) and
					(wikilen(e2) == 3) and (wikilen(e1) > 2)
				then
					wikisub( m, "param" )
				elseif (e2[1] == rsquare) and (e1[1] == lsquare) and
					(wikilen(e2) == 2) and (wikilen(e1) > 1)
				then
					wikisub( m, "link" )
				end
			end
		else
			if m[#m][2][3] > 0 then
				local e2 = m[#m]
				local e1 = m[e2[2][3]]
				if (e2[1] == rcurly) and (e1[1] == lcurly) and
					(wikilen(e2) == 2) and (wikilen(e1) > 1)
				then
					wikisub( m, "call" )
				end
			end
			m[1 + #m] = {type="list", c, {type="list", k, k}}
			if wikileft(m[#m - 1]) then
				m[#m][2][3] = (#m - 1)
			else
				m[#m][2][3] = m[#m - 1][2][3]
			end
		end
		k = mw.ustring.find( s, "[%[%]{}|]", (k + 1) )
	end
	if #m == 0 then return m end
	if m[#m][2][3] > 0 then
		local e2 = m[#m]
		local e1 = m[e2[2][3]]
		if (e2[1] == rcurly) and (e1[1] == lcurly) and
			(wikilen(e2) == 2) and (wikilen(e1) > 1)
		then
			wikisub( m, "call" )
		end
	end
	local m2 = { type = "list" }
	for j = 1, #m do
		if type(m[j][1]) ~= "number" then
			m[j][2][3] = nil
			m2[1 + #m2] = m[j]
		end
	end
	return m2
end

--[[ miscellaneous ]]

local function int_tc(x)
	if (type(x) ~= "number") or (x ~= math.floor(x)) then
		return "integer"
	else
		return ""
	end
end

local function posint_tc(x)
	if (type(x) ~= "number") or (x ~= math.floor(x)) or (x < 1) then
		return "positive integer"
	else
		return ""
	end
end

local function logical_and( ls ) -- for and?
	for k = 1, #ls do
		if stype(ls[k]) ~= "boolean" then
			return seterr(
				"bad operand to [op: and?]: expected boolean, got %s",
				write_sexpr(ls[k]))
		end
	end
	for k = 1, #ls do if not ls[k] then return false end end
	return true
end

local function logical_or( ls ) -- for or?
	for k = 1, #ls do
		if stype(ls[k]) ~= "boolean" then
			return seterr(
				"bad operand to [op: or?]: expected boolean, got %s",
				write_sexpr(ls[k]))
		end
	end
	for k = 1, #ls do if ls[k] then return true end end
	return false
end

local function and_fn(ls, env, depth)
	ls = eval_all( ls, env, depth,
		function (x)
			return (stype(x) == "boolean") and not x
		end)
	if stype(ls) == "error" then return ls end
	if (#ls == 0) or (stype(ls[1]) == "boolean") then
		return logical_and(ls)
	end
	local ops = { type="list" }
	for k = 1, #ls do
		if stype(ls[k]) == "fn" then ops[k] = ls[k].comb
		elseif stype(ls[k]) == "op" then ops[k] = ls[k]
		elseif k == 1 then
			return seterr(
				"bad operand to [op: and?]: expected boolean or combiner, got %s",
				write_sexpr(ls[k]))
		else
			return seterr(
				"bad operand to [op: and?]: expected combiner, got %s",
				write_sexpr(ls[k]))
		end
	end
	return wrap(make_op(function (ls, env, depth)
			ls = combine_all(ops, ls, env, depth,
				function (x)
					return (stype(x) ~= "boolean") or not x
				end)
			if ls.type == "error" then return ls end
			return logical_and(ls)
		end, "and?", true))
end

local function or_fn(ls, env, depth)
	ls = eval_all(ls, env, depth,
		function (x)
			return (stype(x) == "boolean") and x
		end)
	if stype(ls) == "error" then return ls end
	if (#ls == 0) or (stype(ls[1]) == "boolean") then
		return logical_or(ls)
	end
	local ops = { type="list" }
	for k = 1, #ls do
		if stype(ls[k]) == "fn" then ops[k] = ls[k].comb
		elseif stype(ls[k]) == "op" then ops[k] = ls[k]
		elseif k == 1 then
			return seterr(
				"bad operand to [op: or?]: expected boolean or combiner, got %s",
				write_sexpr(ls[k]))
		else
			return seterr(
				"bad operand to [op: or?]: expected combiner, got %s",
				write_sexpr(ls[k]))
		end
	end
	return wrap(make_op(function (ls, env, depth)
			ls = combine_all(ops, ls, env, depth,
				function (x)
					return (stype(x) ~= "boolean") or x
				end)
			if ls.type == "error" then return ls end
			return logical_or(ls)
		end, "or?", true))
end

local function valid_parmlist( ls ) -- for \
	if stype(ls) ~= "list" then return false end
	for k = 1, #ls do
		if stype(ls[k]) ~= "symbol" then return false end
	end
	return true
end

local function match_parmlist( parms, ls ) -- for \
	local env = {}
	for k = 1, #parms do env[parms[k].name] = ls[k] end
	return env
end

local function lambda_fn(ls, senv)
	local parms = ls[1]
	if stype(parms) == "symbol" then
		parms = { type="list", parms }
	elseif not valid_parmlist(parms) then
		return seterr(
			"bad parameter-list operand to [op: \\]: %s",
			write_sexpr(parms))
	end
	local body = { type = "list" }
	for k = 2, #ls do body[k - 1] = ls[k] end
	return wrap(nary_op(make_op(function (ls, denv, depth)
		-- denv is ignored
		local env = match_parmlist( parms, ls )
		setmetatable(env, { __index = senv })
		return eval_seq(body, env, depth)
	end), #parms))
end

local relevantFrame = mw.getCurrentFrame()

local function getarg_fn(ls)
	local args = relevantFrame.args
	local t = nil
	if stype(ls[1]) == "number" then
		t = ls[1]
	else -- must be number or string
		t = ls[1]
	end
	t = args[t]
	if t == nil then return { type = "list" } end
	return t
end

local function getargexpr_fn(ls)
	local args = relevantFrame.args
	local t = nil
	if stype(ls[1]) == "number" then
		t = ls[1]
	else -- must be number or string
		t = ls[1]
	end
	t = args[t]
	if t == nil then return { type = "list" } end
	t = text_to_sexpr(t)
	if stype(t) == "error" then return { type = "list" } end
	if #t ~= 1 then return { type = "list" } end
	return t[1]
end

local function filter_fn(ls, env, depth)
	local preds = { type = "list" }
	for k = 2, #ls do preds[k - 1] = ls[k].comb end -- predicates
	local function hof(ls, n, f, app)
		-- copy first n elements of ls, apply f to later elements
		-- if app, instead skip first n, and return result,app
		if app == nil then app = false end
		local ls2 = { type = "list" }
		if #ls <= n then
			if app then return ls2,app else return ls end
		end
		if not app then for k = 1, n do ls2[k] = ls[k] end end
		for k = (n + 1), #ls do
			local x,app2 = f(ls[k])
			if stype(x) == "error" then return x end
			if app2 == nil then app2 = false end
			if app2 then
				for j = 1, #x do ls2[1 + #ls2] = x[j] end
			else
				ls2[1 + #ls2] = x
			end
		end
		return ls2,app
	end
	local function filter_entry(entry)
		local b = combine_all(preds, {type="list", entry}, env, depth,
			function (x)
				return (stype(x) ~= "boolean") or not x
			end)
		if stype(b) == "error" then return b end
		b = logical_and(b)
		if stype(b) == "error" then return b end
		if b then
			if stype(entry) == "list" then
				return hof(entry, 2, function (part)
						return hof(part, 2, filter_entry)
					end)
			else
				return entry
			end
		else
			if stype(entry) == "list" then
				return hof(entry, 2, function (part)
						return hof(part, 2, filter_entry, true)
					end, true)
			else
				return { type = "list" }, true
			end
		end
	end
	return hof(ls[1], 0, filter_entry)
end

local function item_tc(x)
	if (stype(x) == "list") and (#x > 1) and
		(stype(x[1]) == "string") and (x[1] ~= "part") and
		(stype(x[2]) == "list") and (#x[2] == 2) and
		(int_tc(x[2][1]) == "") and (int_tc(x[2][2]) == "")
	then
		return ""
	else
		return "item"
	end
end

local function part_tc(x)
	if (stype(x) == "list") and (#x > 1) and (x[1] == "part") and
		(stype(x[2]) == "list") and (#x[2] == 2) and
		(int_tc(x[2][1]) == "") and (int_tc(x[2][2]) == "")
	then
		return ""
	else
		return "part"
	end
end

local function cd_tc(x)
	if (stype(x) == "list") and (#x > 0) then
		if stype(x[1]) == "string" then x = x[2] end
		if (x ~= nil) and (stype(x) == "list") and (#x == 2) and
			(int_tc(x[1]) == "") and (int_tc(x[2]) == "")
		then
			return ""
		end
	end
	return "coordinates descriptor"
end

local function cd_ls_tc(x)
	local ok = true
	if stype(x) ~= "list" then ok = false
	else for k = 1, #x do if cd_tc(x[k]) ~= "" then ok = false end end
	end
	if ok then return ""
	else return "list of coordinates descriptors"
	end
end

local function getsubstr_ntv(s, k1, k2) -- k1, k2 ints if provided
	if k1 == nil then return s end
	if k1 < 1 then k1 = 1 end
	if k2 ~= nil then
		if k2 >= mw.ustring.len(s) then k2 = nil end
	end
	return mw.ustring.sub( s, k1, k2 )
end

local function cd_norm(x) -- assumes cd_tc
	if stype(x[1]) == "number" then return x else return x[2] end
end

local function getsubstr_int_fn(ls)
	local s = ls[1]
	return getsubstr_ntv(s, ls[2], ls[3])
end

local function getsubstr_cd_fn(ls)
	local s = ls[1]
	local c = cd_norm(ls[2])
	return getsubstr_ntv(s, c[1], c[2])
end

local function getsubstr_ls_fn(ls)
	local s = ls[1]
	local r = { type = "list" }
	for k = 1, #ls[2] do
		r[k] = cd_norm(ls[2][k])
	end
	for k = 1, #r do r[k] = getsubstr_ntv(s, r[k][1], r[k][2]) end
	return r
end

local function setsubstr_ls(s, lsc, lss)
	-- string, array of cds, array of strings
	local n = math.min(#lsc, #lss) -- just ignore extras of either
	if n == 0 then return s end
	local function berr(...)
		return seterr("bounds violation in [op: set-substring]: %s",
			mw.ustring.format( ... ))
	end
	if lsc[1][1] < 1 then
		return berr("segment starts left of string start (%i)", lsc[1][1])
	end
	if lsc[n][2] > mw.ustring.len(s) then
		return berr("segment ends right of string end (%i, %i)",
			lsc[n][2], mw.ustring.len(s))
	end
	local r = {}
	for k = 1, n do
		if lsc[k][1] > (lsc[k][2] + 1) then
			return berr("segment starts right of its own end (%i, %i)",
				lsc[k][1], lsc[k][2])
		end
		r[2 * k] = lss[k]
	end
	r[1] = mw.ustring.sub(s, 1, (lsc[1][1] - 1))
	r[1 + (2 * n)] = mw.ustring.sub(s, (lsc[n][2] + 1))
	for k = 2, n do
		if lsc[k - 1][2] >= lsc[k][1] then
			return berr("segment ends right of next segment start (%i, %i)",
				lsc[k - 1][2], lsc[k][1])
		end
		r[(2 * k) - 1] = mw.ustring.sub(s,
			(lsc[k - 1][2] + 1),
			(lsc[k][1] - 1))
	end
	return table.concat(r)
end

local function str_ls_tc(x)
	local ok = true
	if stype(x) ~= "list" then ok = false
	else for k = 1, #x do if stype(x[k]) ~= "string" then ok = false end end
	end
	if ok then return ""
	else return "list of strings"
	end
end

local function getsublist_fn(ls)
	local n1 = ls[2]
	local n2 = ls[3]
	local ls = ls[1]
	local x = { type = "list" }
	if n1 < 1 then n1 = 1 end
	if n2 == nil then n2 = #ls elseif n2 > #ls then ns = #ls end
	for k = n1, n2 do x[1 + #x] = ls[k] end
	return x
end

local function setsublist_fn(ls)
	local base = ls[1]
	local n1 = ls[2] - 1
	local n2 = ls[3] + 1
	local seg = ls[4]
	if n1 < 0 then n1 = 0 end
	if n2 <= n1 then n2 = n1 + 1 end
	local r = { type = "list" }
	for k = 1, n1 do r[k] = base[k] end
	for k = 1, #seg do r[1 + #r] = seg[k] end
	for k = n2, #base do r[1 + #r] = base[k] end
	return r
end

local function findprd_fn(ls, env, depth)
	local x = ls[1]
	local p = ls[2].comb
	local x2 = { type = "list" }
	for k = 1, #x do
		local q = combine( p, { type="list", x[k] }, env, depth )
		if stype(q) == "error" then return q end
		if stype(q) ~= "boolean" then
			return seterr(
				"bad predicate result type to [op: find]: got %s",
				stype(q))
		end
		if q then x2[1 + #x2] = k end
	end
	return x2
end

local function findstr_fn(ls)
	local s = ls[1]
	local p = ls[2]
	local x2 = { type = "list" }
	if #p == 0 then return x2 end
	local k = 1
	repeat
		local x3 = { mw.ustring.find( s, p, k, true ) }
		if #x3 == 0 then return x2 end
		x2[1 + #x2] = { type = "list", x3[1], x3[2] }
		k = 1 + x3[2]
	until false
end

local function findpat_fn(ls)
	local s = ls[1]
	local p = ls[2].pat
	local x2 = { type = "list" }
	local k = 1
	repeat
		local x3 = { mw.ustring.find( s, p, k ) }
		if #x3 == 0 then return x2 end
		x2[1 + #x2] = { type = "list", x3[1], x3[2] }
		k = 1 + x3[2]
	until false
end

local function any_tc(x) return "" end
local function none_tc(x) return "no operand here" end

local function member_fn(ls) -- 1 or 2 operands, second must be a list
	local t = write_sexpr(ls[1])
	if ls[2] ~= nil then
		ls = ls[2]
		for k = 1, #ls do
			if write_sexpr(ls[k]) == t then return true end
		end
		return false
	else
		return wrap(nary_op(typed_op({ "list" }, make_op(function(ls)
			ls = ls[1]
			for k = 1, #ls do
				if write_sexpr(ls[k]) == t then return true end
			end
			return false
		end, nil, true)), 1))
	end
end

local lang = mw.language.getContentLanguage()

local function let_tc(x)
	if (stype(x) == "list") and (#x == 2) and (stype(x[1]) == "symbol")
	then return ""
	else return "symbol-value binding"
	end
end

local function sorp_tc(x)
	if (stype(x) == "string") or (stype(x) == "pattern")
	then return ""
	else return "string or pattern"
	end
end

local function split_tc(x)
	if (stype(x) == "list") and (#x >= 1) and (sorp_tc(x[1]) == "") and
		((#x == 1) or
		 ((#x == 2) and ((sorp_tc(x[2]) == "") or (split_tc(x[2]) == ""))) or
		 ((#x == 3) and (sorp_tc(x[2]) == "") and (split_tc(x[3]) == "")))
	then
		return ""
	else
		return "valid string-split descriptor"
	end
end

local function strnest_tc(x)
	if stype(x) == "string" then return ""
	elseif stype(x) == "list" then
		for k = 1, #x do
			local msg = strnest_tc(x[k])
			if msg ~= "" then return msg end
		end
		return ""
	end
	return "string or tree of strings"
end

local function splitsep_fn(s, p)
	local x
	if (stype(p) == "string")
	then x = mw.text.split( s, p, true )
	else x = mw.text.split( s, p.pat )
	end
	x.type = "list"
	return x
end

local function splitdelim_fn(s, lt, rt)
	local lp = (stype(lt) == "string")
	local rp = (stype(rt) == "string")
	if not lp then lt = lt.pat end
	if not rp then rt = rt.pat end
	local snarf -- find next unmatched right-delimiter
	snarf = function (k)
		repeat
			local xl = { mw.ustring.find( s, lt, k, lp ) }
			local xr = { mw.ustring.find( s, rt, k, rp ) }
			if #xr == 0 then return xr end
			if #xl == 0 then return xr end
			if xr[1] <= xl[1] then return xr end
			xr = snarf(xl[2] + 1)
			if #xr == 0 then return xr end
			k = (xr[2] + 1)
		until false
	end
	local results = { type = "list" }
	local k = 1 -- leftmost character of interest
	repeat
		local xl = { mw.ustring.find( s, lt, k, lp ) }
		if #xl == 0 then return results end
		k = xl[2] + 1
		local xr = snarf(k)
		if #xr > 0 then
			results[1 + #results] = mw.ustring.sub( s, k, (xr[1] - 1) )
			k = xr[2] + 1
		end
	until false
end

local function splitrec_fn(s, rc)
	local ls
	if (#rc > 1) and (stype(rc[2]) ~= "list") then
		ls = splitdelim_fn(s, rc[1], rc[2])
	else
		ls = splitsep_fn(s, rc[1])
	end
	ls.type = "list"
	rc = rc[#rc]
	if (stype(rc) == "list") then
		for k = 1, #ls do
			ls[k] = splitrec_fn(ls[k], rc)
		end
	end
	return ls
end

local function splitnest_fn(s, rc)
	if stype(s) == "string" then return splitrec_fn(s, rc) end
	local result = { type="list" }
	for k = 1, #s do
		result[k] = splitnest_fn(s[k], rc)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function split_fn(ls)
	local rc = { type = "list" }
	for k = 2, #ls do rc[k - 1] = ls[k] end
	return splitnest_fn(ls[1], rc)
end

local function join_tc(x)
	if (stype(x) == "list") and (#x >= 1) and (stype(x[1]) == "string") and
		((#x == 1) or
		 ((#x == 2) and ((stype(x[2]) == "string") or (join_tc(x[2]) == ""))) or
		 ((#x == 3) and (stype(x[2]) == "string") and (join_tc(x[3]) == "")))
	then
		return ""
	else
		return "valid string-join descriptor"
	end
end

local function neststr_tc(x)
	if stype(x) == "list" then
		for k = 1, #x do
			if stype(x[k]) ~= "string" then
				local msg = neststr_tc(x[k])
				if msg ~= "" then return msg end
			end
		end
		return ""
	end
	return "tree of strings"
end

local function joinsep_fn(t, s)
	if #t == 0 then return "" end
	if stype(t[1]) == "string" then
		for k = 2, #t do if stype(t[k]) ~= "string" then
			return seterr("bad target for [op: join]: uneven tree depth")
		end end
		return table.concat( t, s )
	end
	for k = 2, #t do if stype(t[k]) == "string" then
		return seterr("bad target for [op: join]: uneven tree depth")
	end end
	local result = { type = "list" }
	for k = 1, #t do
		result[k] = joinsep_fn(t[k], s)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function joindelim_fn(t, lf, rg)
	if #t == 0 then return "" end
	if stype(t[1]) == "string" then
		for k = 2, #t do if stype(t[k]) ~= "string" then
			return seterr("bad target for [op: join]: uneven tree depth")
		end end
		return lf .. table.concat( t, (rg .. lf) ) .. rg
	end
	for k = 2, #t do if stype(t[k]) == "string" then
		return seterr("bad target for [op: join]: uneven tree depth")
	end end
	local result = { type = "list" }
	for k = 1, #t do
		result[k] = joindelim_fn(t[k], lf, rg)
		if stype(result[k]) == "error" then return result[k] end
	end
	return result
end

local function joinnest_fn(t, rc)
	if stype(t) == "error" then return t end
	if stype(t) == "string" then
		return seterr("bad target for [op: join]: tree not deep enough")
	end
	if #rc == 1 then
		return joinsep_fn(t, rc[1])
	elseif #rc == 3 then
		return joinnest_fn(joindelim_fn(t, rc[1], rc[2]), rc[3])
	elseif stype(rc[2]) == "string" then
		return joindelim_fn(t, rc[1], rc[2])
	else
		return joinnest_fn(joinsep_fn(t, rc[1]), rc[2])
	end
end

local function join_fn(ls)
	local rc = { type = "list" }
	for k = 2, #ls do rc[k - 1] = ls[k] end
	return joinnest_fn(ls[1], rc)
end

local function xformer_fn(pred, basis, succ, n)
	return wrap(nary_op(typed_op({ "fn", "fn", any_tc },
		make_op(function (ls, denv, depth)
			local leaf = ls[1]
			local parent = ls[2]
			local data = ls[3]
			local function xform(basis, data)
				local recurse = false
				if stype(data) == "list" then
					if stype(pred) ~= "fn" then
						recurse = true
					else
						recurse = combine( pred.comb, { type="list", data }, env, depth )
						if stype(recurse) ~= "boolean" then
							if stype(recurse) == "error" then return recurse end
							return seterr(
								"bad predicate result type to [op transform]: %s",
								stype(recurse))
						end
					end
				end
				local comb
				if recurse then
					local b2
					if stype(succ) == "fn"
					then b2 = combine( succ.comb, { type="list", basis }, env, depth )
					else b2 = basis
					end
					local d2 = { type="list" }
					for k = 1, #data do
						if k <= n then
							d2[k] = data[k]
						else
							d2[k] = xform(b2, data[k])
							if stype(d2[k]) == "error" then return d2[k] end
						end
					end
					data = d2
					comb = parent.comb
				else
					comb = leaf.comb
				end
				if stype(succ) == "fn"
				then data = { type="list", basis, data }
				else data = { type="list",        data }
				end
				return combine( comb, data, env, depth )
			end
			return xform(basis, data)
		end, "transform", true)), 3))
end

--[[ standard environment ]]

local ground_env = {
	list = wrap(make_op(function (ls) return ls end, "list", true)),
	["+"] = wrap(typed_op(
		{ "number" }, make_op(function (ls)
			local sum = 0
			for k = 1, #ls do sum = sum + ls[k] end
			return sum
		end, "add", true),
		{ "string" }, function (ls)
			local s = {}
			for k = 1, #ls do s[k] = ls[k] end
			return table.concat(s)
		end,
		{ "boolean" }, function (ls)
			local sum = true
			for k = 1, #ls do sum = sum and ls[k] end
			return sum
		end,
		{ "list" }, function (ls)
			local x = { type = "list" }
			for j = 1, #ls do
				for k = 1, #ls[j] do
					x[1 + #x] = ls[j][k]
				end
			end
			return x
		end)),
	["*"] = wrap(typed_op({ "number" }, make_op(function (ls)
			local product = 1
			for k = 1, #ls do product = product * ls[k] end
			return product
		end, "multiply", true))),
	["-"] = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			local result = ls[1]
			for k = 2, #ls do result = result - ls[k] end
			return result
		end, "subtract", true)), -2)),
	["/"] = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			local result = ls[1]
			for k = 2, #ls do result = result / ls[k] end
			return result
		end, "divide", true)), -2)),
	["^"] = wrap(nary_op(typed_op({ "number" }, make_op(function  (ls)
			return ls[1] ^ ls[2]
		end, "exponentiation", true)), 2)),
	["\\"] = nary_op(make_op(lambda_fn, "\\", true), -1),
	abs = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.abs(ls[1])
		end, "abs", true)), 1)),
	anchorencode = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return mw.uri.anchorEncode( ls[1] )
		end, "anchorencode", true)), 1)),
	["and?"] = make_op(and_fn, "and?", true),
	apply = wrap(nary_op(typed_op(
		{ "fn", "list" }, make_op(function (ls, env, depth)
			return combine(ls[1].comb, ls[2], env, depth)
		end, "apply", true)), 2)),
	["boolean?"] = wrap(unary_pred(function (x)
			return stype(x) == "boolean"
		end, "boolean?")),
	["call?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "call")
		end, "call?")),
	canonicalurl = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1
			then return tostring( mw.uri.canonicalUrl( ls[1] ) )
			else return tostring( mw.uri.canonicalUrl( ls[1], ls[2] ) )
			end
		end, "canonicalurl", true)), 1, 2)),
	ceil = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.ceil(ls[1])
		end, "ceil", true)), 1)),
	curry = wrap(nary_op(typed_op(
		{ "fn", any_tc }, make_op(function (ls1, env, depth)
			return wrap(make_op(function (ls2, env, depth)
					local ls3 = { type = "list" }
					for k = 2, #ls1 do ls3[k - 1] = ls1[k] end
					for k = 1, #ls2 do ls3[k + #ls1 - 1] = ls2[k] end
					return combine(ls1[1].comb, ls3, env, depth)
				end, nil, true))
		end, "curry", true)), -2)),
	define = nary_op(make_op(function (ls, env, depth)
			if stype(ls[1]) ~= "symbol" then
				return seterr(
					"bad definiend to [op: define]: expected symbol, got %s",
					write_sexpr(ls[1]))
			end
			local x = eval(ls[2], env, depth)
			if stype(x) == "error" then return x end
			env[ls[1].name] = x
			while stype(x) == "fn" do x = x.comb end
			if stype(x) == "op" and x.name == nil then x.name = ls[1].name end
			return { type = "list" }
		end, "define", true), 2),
	["equal?"] = wrap(make_op(function (ls)
			if #ls >= 2 then
				local t = write_sexpr(ls[1])
				for k = 2, #ls do
					if write_sexpr(ls[k]) ~= t then
						return false
					end
				end
			end
			return true
		end, "equal?", true)),
	filter = wrap(nary_op(typed_op({ "list", "fn" }, make_op(filter_fn,
		"filter", true)), -1)),
	find = wrap(nary_op(typed_op(
		{ "list", "fn" }, make_op(findprd_fn, "find", true),
		{ "string", "string" }, findstr_fn,
		{ "string", "pattern" }, findpat_fn
		), 2)),
	floor = wrap(nary_op(typed_op({ "number" }, make_op(function (ls)
			return math.floor(ls[1])
		end, "floor", true)), 1)),
	["fn?"] = wrap(unary_pred(function (x)
			return stype(x) == "fn"
		end, "fn?")),
	fullurl = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1
			then return tostring( mw.uri.fullUrl( ls[1] ) )
			else return tostring( mw.uri.fullUrl( ls[1], ls[2] ) )
			end
		end, "fullurl", true)), 1, 2)),
	["ge?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 >= x2 end, "ge?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 >= x2 end))),
	['get-arg'] = wrap(nary_op(typed_op(
		{ "number" }, make_op(getarg_fn, "get-arg", true),
		{ "string" }, getarg_fn), 1)),
	['get-arg-expr'] = wrap(nary_op(typed_op(
		{ "number" }, make_op(getargexpr_fn, "get-arg-expr", true),
		{ "string" }, getargexpr_fn), 1)),
	['get-args'] = nary_op(make_op(function ()
			local ls = { type = "list" }
			for v, k in pairs( relevantFrame.args ) do
				ls[1 + #ls] = v
			end
			return ls
		end, "get-args"), 0),
	['get-coords'] = wrap(nary_op(typed_op({ cd_tc },make_op(function (ls)
			ls = ls[1]
			if stype(ls[1]) == "string" then ls = ls[2] end
			return { type="list", ls[1], ls[2] }
		end, "get-coords", true)), 1)),
	["get-items"] = wrap(nary_op(typed_op({ part_tc }, make_op(function (ls)
			ls = ls[1]
			local ls2 = { type="list" }
			for k = 3, #ls do ls2[k - 2] = ls[k] end
			return ls2
		end, "get-items", true)), 1)),
	["get-parts"] = wrap(nary_op(typed_op({ item_tc }, make_op(function (ls)
			ls = ls[1]
			local ls2 = { type="list" }
			for k = 3, #ls do ls2[k - 2] = ls[k] end
			return ls2
		end, "get-parts", true)), 1)),
	["get-sublist"] = wrap(nary_op(typed_op(
		{ "list", int_tc },
		make_op(getsublist_fn, "get-sublist", true)), 2, 3)),
	["get-substring"] = wrap(typed_op(
		{ "string", int_tc },
		nary_op(make_op(getsubstr_int_fn, "get-substring", true), 2, 3),
		{ "string", cd_tc },
		nary_op(make_op(getsubstr_cd_fn, "get-substring", true), 2),
		{ "string", cd_ls_tc },
		nary_op(make_op(getsubstr_ls_fn, "get-substring", true), 2))),
	["gt?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 > x2 end, "gt?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 > x2 end))),
	["if"] = nary_op(make_op(function (ls, env, depth)
			local test = eval(ls[1], env, depth)
			if stype(test) == "error" then return test end
			if stype(test) ~= "boolean" then
				return seterr(
					"bad test-result in [op: if]: %s",
					write_sexpr(test))
			elseif test then
				return eval(ls[2], env, depth)
			else
				return eval(ls[3], env, depth)
			end
		end, "if", true), 3),
	join = wrap(typed_op(
		{ neststr_tc, "string", join_tc },
		nary_op(make_op(join_fn, "join", true), 2, 3),
		{ neststr_tc, "string", "string", join_tc },
		nary_op(make_op(join_fn, "split", true), 3, 4))),
	lc = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:lc(ls[1])
		end, "lc", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:lc(ls[k]) end
			return r
		end), 1)),
	lcfirst = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:lcfirst(ls[1])
		end, "lcfirst", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:lcfirst(ls[k]) end
			return r
		end), 1)),
	["le?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 <= x2 end, "le?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 <= x2 end))),
	length = wrap(nary_op(typed_op(
		{ "list" }, make_op(function (ls)
			return #ls[1]
		end, "length", true),
		{ "string" }, function (ls)
			return mw.ustring.len( ls[1] )
		end), 1)),
	let = nary_op(typed_op({ let_tc, any_tc }, make_op(function (ls, env, depth)
			local p = ls[1][1]
			local v = eval( ls[1][2], env, depth )
			if stype(v) == "error" then return v end
			local body = { type = "list" }
			for k = 2, #ls do body[k - 1] = ls[k] end
			local e = {}
			e[p.name] = v
			setmetatable(e, { __index = env})
			return eval_seq(body, e, depth)
		end, "let", true)), -1),
	["link?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "link")
		end, "link?")),
	["list?"] = wrap(unary_pred(function (x)
			return stype(x) == "list"
		end, "list?")),
	["lt?"] = wrap(typed_op(
		{ "number" }, binary_pred(function (x1, x2) return x1 < x2 end, "lt?"),
		{ "string" }, binary_pred(function (x1, x2) return x1 < x2 end))),
	map = wrap(nary_op(typed_op({ "fn", "list" }, make_op(
		function (ls, env, depth)
			local n = #ls[2]
			for k = 3, #ls do if #ls[k] < n then n = #ls[k] end end
			local x = { type = "list" }
			for j = 1, n do
				local x2 = { type = "list" }
				for k = 2, #ls do x2[k - 1] = ls[k][j] end
				x[j] = combine( ls[1].comb, x2, env, depth )
				if stype(x[j]) == "error" then return x[j] end
			end
			return x
		end, "map", true)), -2)),
	["member?"] = wrap(nary_op(typed_op(
		{ any_tc, "list" }, make_op(member_fn, "member?", true)), 1, 2)),
	merge = wrap(nary_op(typed_op({ "fn", "list" }, make_op(
		function (ls, env, depth)
			local ks = {}
			for k = 2, #ls do ks[k] = 1 end
			local result = { type = "list" }
			while true do
				local j = nil
				for k = 2, #ls do
					if ks[k] <= #ls[k] then
						if j == nil then j = k else
							local x = combine( ls[1].comb,
								{ ls[k][ks[k]], ls[j][ks[j]] }, env, depth )
							if stype(x) == "error" then return x end
							if x then j = k end
						end
					end
				end
				if j == nil then return result else
					result[#result + 1] = ls[j][ks[j]]
					ks[j] = ks[j] + 1
				end
			end
		end, "merge", true)), -2)),
	["not?"] = wrap(nary_op(typed_op({ "boolean" }, make_op(function (ls)
			return not ls[1]
		end, "not?", true)), 1)),
	nth = wrap(nary_op(typed_op({ "list", posint_tc }, make_op(function (ls)
			local x = ls[1]
			for k = 2, #ls do
				local n = ls[k]
				if #x < n then
					return seterr(
						"bad index to [op: nth]: asked for %i, list length is %i",
						n, #x)
				end
				x = x[n]
				if (k < #ls) and (stype(x) ~= "list") then
					return seterr("bad multi-index to [op: nth]: tree too shallow")
				end
			end
			return x
		end, "nth", true)), -2)),
	["number?"] = wrap(unary_pred(function (x)
			return stype(x) == "number"
		end, "number?")),
	["op?"] = wrap(unary_pred(function (x)
			return stype(x) == "op"
		end, "op?")),
	["or?"] = make_op(or_fn, "or?", true),
	["param?"] = wrap(unary_pred(function (x)
			return (stype(x) == "list") and (#x > 0) and
				(stype(x[1]) == "string") and (x[1] == "param")
		end, "param?")),
	parse = wrap(nary_op(typed_op({ "string" }, make_op(parse_wiki,
		"parse", true)), 1)),
	pattern = wrap(nary_op(typed_op({ "string" }, make_op(function (ls)
			local p = ls[1]
			if #p == 0 then p = "[^%z%Z]" end -- disable null pattern
			return { type="pattern", pat=p }
		end, "pattern", true)), 1)),
	sequence = make_op(function (ls, env, depth)
			return eval_seq(ls, env, depth)
		end, "sequence", true),
	["set-sublist"] = wrap(nary_op(typed_op(
		{ "list", int_tc, int_tc, "list" },
		make_op(setsublist_fn, "set-sublist", true)), 4)),
	["set-substring"] = wrap(typed_op(
		{ "string", int_tc, int_tc, "string" },
		nary_op(make_op(function (ls)
				return setsubstr_ls(ls[1], { { ls[2], ls[3] } }, { ls[4] })
			end, "set-substring", true), 4),
		{ "string", cd_tc, "string" },
		nary_op(make_op(function (ls)
				return setsubstr_ls(ls[1], { cd_norm(ls[2]) }, { ls[3] })
			end, "set-substring", true), 3),
		{ "string", cd_ls_tc, str_ls_tc },
		nary_op(make_op(function (ls)
				local lsc = {}
				for k = 1, #ls[2] do lsc[k] = cd_norm(ls[2][k]) end
				return setsubstr_ls(ls[1], lsc, ls[3])
			end, "set-substring", true), 3)
		)),
	split = wrap(typed_op(
		{ strnest_tc, sorp_tc, split_tc },
		nary_op(make_op(split_fn, "split", true), 2, 3),
		{ strnest_tc, sorp_tc, sorp_tc, split_tc },
		nary_op(make_op(split_fn, "split", true), 3, 4))),
	["string?"] = wrap(unary_pred(function (x)
			return stype(x) == "string"
		end, "string?")),
	["symbol?"] = wrap(unary_pred(function (x)
			return stype(x) == "symbol"
		end, "symbol?")),
	["to-entity"] = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			local s = ls[1]
			if #s == 0 then return s end
			return "&#" .. mw.ustring.codepoint(s, 1) .. ";"
		end, "to-entity", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do
				local s = ls[k]
				if #s == 0 then r[k] = s
				else r[k] = "&#" .. mw.ustring.codepoint(s, 1) .. ";"
				end
			end
			return r
		end), 1)),
	["to-number"] = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			local n = tonumber(ls[1])
			if n == nil then return { type="list" } else return n end
		end, "to-number", true)), 1)),
	["to-string"] = wrap(nary_op(typed_op(
		{ "number" }, make_op(function (ls)
			return write_sexpr(ls[1])
		end, "to-string", true)),1)),
	transformer = wrap(typed_op(
		{ none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0,     0,     0,     0)
			end, "transformer", true),
		{ "fn", none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1],     0,     0,     0)
			end, "transformer", true),
		{ posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0,     0,     0, ls[1])
			end, "transformer", true),
		{ any_tc, "fn", none_tc },
		nary_op(make_op(function (ls, env, depth)
				return xformer_fn(    0, ls[1], ls[2],     0)
			end, "transformer", true), -2),
		{ "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1],     0,     0, ls[2])
			end, "transformer", true),
		{ "fn", any_tc, "fn", none_tc },
		nary_op(make_op(function (ls, env, depth)
				return xformer_fn(ls[1], ls[2], ls[3],     0)
			end, "transformer", true), -3),
		{ any_tc, "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(    0, ls[1], ls[2], ls[3])
			end, "transformer", true),
		{ "fn", any_tc, "fn", posint_tc, none_tc },
		make_op(function (ls, env, depth)
				return xformer_fn(ls[1], ls[2], ls[3], ls[4])
			end, "transformer", true)
		)),
	trim = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return mw.text.trim(ls[1])
		end, "trim", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = mw.text.trim(ls[k]) end
			return r
		end), 1)),
	uc = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:uc(ls[1])
		end, "uc", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:uc(ls[k]) end
			return r
		end), 1)),
	ucfirst = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			return lang:ucfirst(ls[1])
		end, "ucfirst", true),
		{ str_ls_tc }, function (ls)
			ls = ls[1]
			local r = { type = "list" }
			for k = 1, #ls do r[k] = lang:ucfirst(ls[k]) end
			return r
		end), 1)),
	urlencode = wrap(nary_op(typed_op(
		{ "string" }, make_op(function (ls)
			if #ls == 1 then ls[2] = 'QUERY' end
			return mw.uri.encode( ls[1], ls[2] )
		end, "urlencode", true)), 1, 2)),
	["wikilisp-version"] = wrap(nary_op(make_op(function (ls)
			return wikilispversion
		end, "wikilisp-version", true), 0)),
	write = wrap(nary_op(make_op(function (ls)
			return write_sexpr(ls[1])
		end, "write", true), 1))
}

local function make_standard_env()
	local standard_env = {}
	setmetatable(standard_env, { __index = ground_env})
	return standard_env
end

--[[ read-eval-print]]

function export.rep( frame )
	local t = frame.args[1]
	if t == nil then t = "" end
	return display_sexpr(
		eval_seq(
			text_to_sexpr(t),
			make_standard_env(),
			maxdepth))
end

function export.trep( frame )
	relevantFrame = frame:getParent()
	return export.rep(frame)
end

return export