path: root/Master/texmf-dist/tex/generic/gates/gates.lua

-- 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: December 2011.

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 = table.unpack or unpack

local function _copy (tb)
  local t = {}
  for a, b in pairs (tb) do
    if type(b) == "table" then
      t[a] = _copy(b)
    else
      t[a] = b
    end
  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 a = g.autoreturn and " (autoreturn)" or ""
  return s, c, l, u, a
end

local function _show (gate, tab)
  local g = _rawgate(gate.name)
  local s, c, l, u, 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
  _write(info)
  if g.list then
    for _, G in ipairs(g.list) do
      _show(G, tab .. ". ")
    end
  end
end

local function show (fam, name)
  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)
  if autoreturn then
    local argmax, orargmax = _getmax(arg), _getmax(orarg)
    for i = argmax + 1, orargmax do
      arg[i] = orarg[i]
    end
  end
  return arg
end

execute.__index = function (_, name)
  local f = _rawgate(name)
  if f then
    return function (...)
      local s = ""
      if f.status == _open or f.status == _ajar then
        if f.status == _ajar then
          s = " (ajar -> close)"
          f.status = _close
        end
        if f.conditional(...) then
          _report(name, "Executing %s-gate %s", f.list and "l" or "m", name, s)
          if not f.list and _trace_value(name) > 1 then
            local arg = _copy({...})
            for a, b in pairs(arg) do
              arg[a] = b
              for i = 1, a-1 do
                arg[i] = arg[i] or "nil"
              end
            end
            for a, b in ipairs(arg) do
              b = tostring(b)
              -- Can't use _write(), because it calls string.format(),
              -- and b might contain literal %'s.
              _write_nl(_white .. "#" .. a .. "<-" .. b)
            end
          end
          local orarg, arg = {...}, {...}
          if f.loop then
            while f.loop(unpack(arg)) do
              arg = {f.fct(unpack(arg))}
              orarg = _restoreargs(arg, orarg, f.autoreturn)
            end
            return unpack(arg)
          elseif f.loopuntil then
            repeat
              arg = {f.fct(unpack(arg))}
              orarg = _restoreargs(arg, orarg, f.autoreturn)
            until f.loopuntil(unpack(arg))
            return unpack(arg)
          else
            arg = {f.fct(unpack(arg))}
            orarg = _restoreargs(arg, orarg, f.autoreturn)
            return unpack(arg)
          end
        else
          _report(name, "Ignoring %s-gate %s%s (False conditional)", f.list and "l" or "m", name, s)
        end
      else
        if f.status == _skip then
          s = " (skip -> open)"
          f.status = _open
        else
          s = " (close)"
        end
        _report(name, "Ignoring %s-gate %s%s%s", f.list and "l" or "m", name, s, f.conditional() and "" or " (False conditional)")
        return ...
      end
    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 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,
    autoreturn  = tab.autoreturn}
  if not fct then
    tb.list = {}
    fct = function (...)
      _addtab()
      local orarg, arg = {...}, {...}
      for n, func in ipairs(tb.list) do
        local s = ""
        if func.status == _open or func.status == _ajar then
          if func.status == _ajar then
            s = " (ajar -> close)"
            func.status = _close
          end
          if func.conditional(unpack(arg)) then
            _reporttab(func.name, "Calling subgate %s%s", func.name, s)
            if func.loop then
              while func.loop(unpack(arg)) do
                arg = {execute[func.name](unpack(arg))}
                orarg = _restoreargs(arg, orarg, func.autoreturn)
              end
            elseif func.loopuntil then
              repeat
                arg = {execute[func.name](unpack(arg))}
                orarg = _restoreargs(arg, orarg, func.autoreturn)
              until func.loopuntil(unpack(arg))
            else
              arg = {execute[func.name](unpack(arg))}
              orarg = _restoreargs(arg, orarg, func.autoreturn)
            end
          else
            _reporttab(func.name, "Ignoring subgate %s%s (False conditional)", func.name, s)
          end
        else
          if func.status == _skip then
            s = " (skip -> open)"
            tb.list[n].status = _open
          else
            s = " (close)"
          end
          _reporttab(func.name, "Ignoring subgate %s%s%s", func.name, s, func.conditional() and "" or " (False conditional)")
        end
      end
      _untab()
      return unpack(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" 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)
    _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)
  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,
  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")