-- This is the Gates package, Lua version. -- Relevant information can be found in gates-doc.pdf -- (or gates-doc.txt in a text editor). -- -- Author: Paul Isambert. -- E-mail: zappathustra AT free DOT fr -- Comments and suggestions are welcome. -- Date: May 2012. if gates then return end local _insert, _remove = table.insert, table.remove local _gsub, _match, _format = string.gsub, string.match, string.format local _write_nl, print_error if texio then _write_nl, print_error = texio.write_nl, tex.error else function _write_nl (s) print("\n" .. s) end print_error = error end local unpack, maxn = table.unpack or unpack if lua.version == "Lua 5.1" then maxn = table.maxn else local pairs, type = pairs, type function maxn (t) local max = 0 for i in pairs(t) do if type(i) == "number" then max = i > max and i or max end end return max end end local function unpackargs (t) return unpack(t, 1, maxn(t)) end local function _copy (tb) local t = {} for a, b in pairs (tb) do if type(b) == "table" then b = _copy(b) end t[a] = b end return t end -- Errors. local function _error (...) print_error("Lua-Gates error: " .. _format(...)) end local function _error_nogate (g) _error("`%s' isn't a gate", g) end local function _error_nogatelist (g) _error("`%s' isn't a gate list", g) end local function _error_nogatein (g, l) _error("No gate `%s' in list `%s'", g, l) end local function _check_family(fam, name) return _match(name, ":") and name or fam .. ":" .. name end -- Tracing and showing. local function _write (...) _write_nl(_format(...)) end local _tab, _white = "", "" local function _addtab () _tab = ". " .. _tab _white = " " .. _white end local function _untab () _tab = _gsub(_tab, ". ", "", 1) _white = _gsub(_white, " ", "", 1) end local _trace_values = {} local function trace (fam, n) _trace_values[fam] = n end local function _trace_value (name) return _trace_values[_match(name, "(.-):") or name] or 0 end local function _report (fam, s, ...) if _trace_value(fam) > 0 then if _white == "" then _write(" ") end _write(_white .. s, ...) end end local function _reporttab (fam, s, ...) if _trace_value(fam) > 0 then _write(_tab .. s, ...) end end local _rawgate local function _getinfo (g) local s = g.status == 1 and "open" or g.status == 2 and "ajar" or g.status == 3 and "skip" or g.status == 4 and "close" local c = tostring(g.conditional) local l = g.loop and tostring(g.loop) local u = g.loopuntil and tostring(g.loopuntil) local i = g.iterator and tostring(g.iterator) local a if type(g.autoreturn) == "function" then a = " (autoreturn: " .. tostring (g.autoreturn) .. ")" elseif g.autoreturn then a = " (autoreturn)" else a = "" end return s, c, l, u, i, a end local shown local function _show (gate, tab) local g = _rawgate(gate.name) local s, c, l, u, i, a = _getinfo(gate) local info = _format(tab .. "%s (%s-gate) (status: %s) (conditional: %s)%s", gate.name, g.list and "l" or "m", s, c, a) if l then info = _format(info .. " (loop: %s)", l) end if u then info = _format(info .. " (loopuntil: %s)", u) end if i then info = _format(info .. " (iterator: %s)", i) end _write(info) if g.list then if shown[g.name] then texio.write(" [subgates already shown]") else shown[g.name] = true for _, G in ipairs(g.list) do _show(G, tab .. ". ") end end end end local function show (fam, name) shown = {} name = _check_family(fam, name) local g = _rawgate(name) if g then _show(g, "") else _error_nogate(name) end end local _open = 1 local _ajar = 2 local _skip = 3 local _close = 4 local _statuses = { open = _open, ajar = _ajar, skip = _skip, close = _close } -- Some functions can take one argument or -- multiple arguments in a table. local function _totable (x) return type(x) == "table" and x or {x} end local _default = function (...) return ... end local execute = {[0] = {}} function _rawgate (name) -- Localized above. return execute[0][name] end local function _getmax (tb) local max = 0 for n in pairs (tb) do max = n > max and n or max end return max end local function _restoreargs (arg, orarg, autoreturn) -- autoreturn may be a function if autoreturn == true then local argmax, orargmax = _getmax(arg), _getmax(orarg) for i = argmax + 1, orargmax do arg[i] = orarg[i] end end return arg end local function _processfunction (fct, autoreturn, ...) if type(autoreturn) == "function" then return {autoreturn(...)} elseif autoreturn then local newarg = {fct(...)} local argmax, newargmax = _getmax(arg), _getmax(newarg) for i = newargmax + 1, argmax do newarg[i] = arg[i] end return newarg else return {fct(...)} end end local function _execute (f, sub, ...) local name, list, fct, status, conditional, loop, loopuntil, iterator, autoreturn = f.name, f.list, sub and execute[f.name] or f.fct, f.status, f.conditional, f.loop, f.loopuntil, f.iterator, f.autoreturn local action, report, t if sub then action, report, t = "Calling", _reporttab, "subgate " .. name else action, report, t = "Executing", _report, (list and "l" or "m") .. "-gate " .. name end local s = "" local orarg, arg = {...}, {...} if status == _open or status == _ajar then if status == _ajar then s = " (ajar -> close)" f.status = _close end if conditional(...) then report(name, "%s %s%s", action, t, s) if not sub and not list and _trace_value(name) > 1 then for i=1, maxn(arg) do _write_nl(_white .. "#" .. i .. "<-" .. tostring(arg[i])) end end if loop then while loop(unpackargs(arg)) do arg = {fct(unpackargs(arg))} orarg = _restoreargs(arg, orarg, autoreturn) end elseif loopuntil then repeat arg = {fct(unpackargs(arg))} orarg = _restoreargs(arg, orarg, autoreturn) until loopuntil(unpackargs(arg)) elseif iterator then local iter, state, var = iterator(unpackargs(arg)) while iter do local args = {iter(state, var)} if args[1] ~= nil then arg = {fct(unpackargs(args))} orarg = _restoreargs(arg, orarg, autoreturn) var = args[1] else break end end else arg = {fct(unpackargs(arg))} orarg = _restoreargs(arg, orarg, autoreturn) end if type(autoreturn) == "function" then arg = {autoreturn(...)} end else report(name, "Ignoring %s%s (False conditional)", t, s) end else if status == _skip then s = " (skip -> open)" f.status = _open else s = " (close)" end report(name, "Ignoring %s%s%s", t, s, conditional() and "" or " (False conditional)") end return unpackargs(arg) end execute.__index = function (_, name) local f = _rawgate(name) if f then return function (...) return _execute(f, nil, ...) end else _error_nogate(name) return _default end end setmetatable(execute, execute) local function _evertrue () return true end local function add (fam, tb, list, where) list = _check_family(fam, list) local gatelist = _rawgate(list) if gatelist and gatelist.list then tb = _totable(tb) local position if where then where = _match(where, "^%s*(.-)%s*$"):gsub("%s+", " ") if where == "first" or where == "before first" then position = 1 elseif where == "after first" then position = 2 elseif where == "last" or where == "after last" then position = #gatelist.list + 1 elseif where == "before last" then position = #gatelist.list else local prep, gate = _match(where, "^(.-)%s+(.-)$") if prep and gate and (prep == "before" or prep == "after") then gate = _check_family(fam, gate) for n, g in ipairs(gatelist.list) do if g.name == gate then position = prep == "before" and n or n+1 break end end if not position then _error_nogatein(gate, list) return end else _error("Unknown position: `%s'", where) return end end else position = #gatelist.list + 1 end local _tb = {} for _, x in ipairs(tb) do _insert(_tb, 1, x) end tb = _tb for _, name in ipairs(tb) do name = _check_family(fam, name) local macro = _rawgate(name) if macro then _insert(gatelist.list, position, { name = name, status = _open, conditional = _evertrue }) else _error_nogate(name) end end else _error_nogatelist(list) end end local function remove (fam, tb, list) list = _check_family(fam, list) local gatelist = _rawgate(list) if gatelist and gatelist.list then tb = _totable(tb) for _, fct in ipairs(tb) do fct = _check_family(fam, fct) local n, found = 1 while n <= #gatelist.list do if gatelist.list[n].name == fct then found = true _remove(gatelist.list, n) else n = n + 1 end end if not found then _error_nogatein(fct, list) end end else _error_nogatelist(list) end end local function subgates (fam, list, fct) list = _check_family(fam, list) local gatelist = _rawgate(list) if gatelist and gatelist.list then for _, g in ipairs (gatelist.list) do fct(g.name) end else _error_nogatelist(list) end end local function _status (fam, fct, list, key, value) if list then list = _check_family(fam, list) local gatelist = _rawgate(list) if gatelist then if type(fct) == "string" and (_match(fct, "^before ") or _match(fct, "^after ")) then local prep, gate = _match(fct, "^(.-)%s+(.-)$") if prep and gate and (prep == "before" or prep == "after") then local list, position = gatelist.list if gate == "first" then position = 1 elseif gate == "last" then position = #list else gate = _check_family(fam, gate) for n, g in ipairs(list) do if g.name == gate then position = n break end end end if position then if prep == "before" then for n, g in ipairs(list) do if n == position then break else g[key] = value end end else for n, g in ipairs(list) do if n > position then g[key] = value end end end else _error_nogatein(gate, list) end else _error("Unknown position `%s'", fct) end else fct = _totable(fct) for _, func in ipairs(fct) do func = _check_family(fam, func) local found for n, tb in ipairs(gatelist.list) do if tb.name == func then found = true gatelist.list[n][key] = value end end if not found then _error_nogatein(func, list) end end end else _error_nogatelist(list) end else fct = _totable(fct) for _, func in ipairs(fct) do func = _check_family(fam, func) local macro = _rawgate(func) if macro then macro[key] = value else _error_nogate(func) end end end end local function open (fam, fct, list) _status(fam, fct, list, "status", _open) end local function ajar (fam, fct, list) _status(fam, fct, list, "status", _ajar) end local function skip (fam, fct, list) _status(fam, fct, list, "status", _skip) end local function close (fam, fct, list) _status(fam, fct, list, "status", _close) end local function conditional (fam, fct, list, cond) if type(list) == "string" then _status(fam, fct, list, "conditional", cond) else _status(fam, fct, nil, "conditional", list) end end local function loop (fam, fct, list, cond) if type(list) == "string" then _status(fam, fct, list, "loop", cond) else _status(fam, fct, nil, "loop", list) end end local function loopuntil (fam, fct, list, cond) if type(list) == "string" then _status(fam, fct, list, "loopuntil", cond) else _status(fam, fct, nil, "loopuntil", list) end end local function iterator (fam, fct, list, cond) if type(list) == "string" then _status(fam, fct, list, "iterator", cond) else _status(fam, fct, nil, "iterator", list) end end local function autoreturn (fam, fct, list, cond) if type(list) == "string" then _status(fam, fct, list, "autoreturn", cond) else _status(fam, fct, nil, "autoreturn", list) end end local function _store (tab) local name = tab[1] local fct = tab[2] local tb = { name = name, status = _statuses[tab.status or "open"], conditional = tab.conditional or _evertrue, loop = tab.loop, loopuntil = tab.loopuntil, iterator = tab.iterator, autoreturn = tab.autoreturn} if not fct then tb.list = {} fct = function (...) _addtab() local arg = {...} for n, func in ipairs(tb.list) do arg = {_execute(func, true, unpackargs(arg))} end _untab() return unpackargs(arg) end end tb.fct = fct execute[0][name] = tb end local function def (fam, tab) tab[1] = _check_family(fam, tab[1]) _store(tab) end local function list (fam, tab) tab[1] = _check_family(fam, tab[1]) local subgates = {} for i = 2, #tab do _insert(subgates, tab[i]) tab[i] = nil end _store(tab) for _, g in ipairs(subgates) do g = type(g) == "string" and {g} or g g[1] = _check_family(fam, g[1]) if type(g[2]) == "function" then _store({g[1], g[2]}) elseif type(g[2]) == "table" or type(g[2]) == "string" then local a = {} for i = 2, #g do _insert(a, g[i]) end list(fam, {g[1], unpack(a)}) elseif not (_rawgate(g[1])) then _store({g[1]}) end add(fam, g[1], tab[1]) local s = g.status == "open" and _open or g.status == "ajar" and _ajar or g.status == "skip" and _skip or g.status == "close" and _close or _open _status(fam, g[1], tab[1], "status", s) local c = type(g.conditional) == "function" and g.conditional or _evertrue _status(fam, g[1], tab[1], "conditional", c) local l = type(g.loop) == "function" and g.loop _status(fam, g[1], tab[1], "loop", l) local L = type(g.loopuntil) == "function" and g.loopuntil _status(fam, g[1], tab[1], "loopuntil", L) local I = type(g.iterator) == "function" and g.iterator _status(fam, g[1], tab[1], "iterator", I) _status(fam, g[1], tab[1], "autoreturn", g.autoreturn) end end local function copy (fam, name1, name2) name1, name2 = _check_family(fam, name1), _check_family(fam, name2) local base = _rawgate(name2) if base then if base.list then _store(name1) _rawgate(name1).list = _copy(base.list) else _store(name1, base.fct) end _status(fam, name1, nil, "status", _open) -- Better than to copy the gate's status. _status(fam, name1, nil, "conditional", base.conditional) _status(fam, name1, nil, "loop", base.loop) _status(fam, name1, nil, "loopuntil", base.loopuntil) _status(fam, name1, nil, "iterator", base.iterator) else _error_nogate(name2) end end local function Type (fam, name) name = _check_family(fam, name) local macro = _rawgate(name) if macro then return macro.list and 2 or 1 else return 0 end end local function status (fam, gate, list) gate = _check_family(fam, gate) list = list and _check_family(fam, list) local fct = _rawgate(gate) list = list and _rawgate(list) and _rawgate(list).list if fct then if list then for _, g in ipairs(list) do if g.name == gate then return g.status end end else return fct.status end else return 0 end end local _mt = { trace = trace, show = show, def = def, list = list, copy = copy, add = add, remove = remove, open = open, ajar = ajar, skip = skip, close = close, type = Type, status = status, conditional = conditional, loop = loop, loopuntil = loopuntil, iterator = iterator, autoreturn = autoreturn, subgates = subgates, } local function new (_, fam) local t = {family = fam} setmetatable(t, _mt) return t end _mt.new = new _mt.__index = function (tb, name) if name == "execute" then return setmetatable({}, {__call = function (_, name, ...) name = _check_family(tb.family, name) return execute[name](...) end, __index = function (_, name) name = _check_family(tb.family, name) return execute[name] end}) elseif _mt[name] then return function (...) return _mt[name](tb.family, ...) end else name = _check_family(tb.family, name) local macro = _rawgate(name) if macro then return execute[name] -- The following was removed because a gate instance can contain other -- things than gates; for instance "gates.foo = 5" is valid. But one might -- want to know whether an entry exists or not (e.g. "if gates.foo then" or -- "if type(gates.foo) ~= 'nil' then"), in which case the next three lines -- would produce an error (and return a function). -- else -- _error("`%s' isn't an action or a gate", name) -- return _default end end end _mt.__newindex = function (tb, key, value) if _mt[key] then _error("You can't assign to key `%s', it is an action", key) else if type(value) == "function" then def(tb.family, {key, value}) else local name = _check_family(tb.family, key) if _rawgate(name) then _error("You can't assign to key `%s', it is already a gate", key) else rawset(tb, key, value) end end end end gates = new(nil, "gates")