-- This file:
--   http://angg.twu.net/LUA/DFS.lua.html
--   http://angg.twu.net/LUA/DFS.lua
--           (find-angg "LUA/DFS.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun d  () (interactive) (find-angg "LUA/DFS.lua"))
-- (defun dt () (interactive) (find-angg "LUA/DFSTriangle.lua"))

-- «.test-triangle»	(to "test-triangle")
-- «.test-tname»	(to "test-tname")

transpose = function (A)
    local B = {}
    for k,v in pairs(A) do B[v] = k end
    return B
  end



-- Experimental, overridden by the next definition.
-- See: (find-angg "LUA/lua50init.lua" "SetL")
--      (find-angg "LUA/lua50init.lua" "SetL" " add =")
--

-- This is a class for doing depth-first searches on graphs that may
-- have loops. Remember that in DFSs we "open" a node A and then we
-- visit recursively all the nodes that are accessible from A; we only
-- "close" A when we have "closed" all nodes accessible from A. This
-- class allows setting a node B to "open" without doing the step that
-- visits the nodes that are accessible from B, has a method
-- :recurseopennodes() that... [TODO: finish explaining this]
--
DFS = Class {
  type = "DFS",
  new  = function ()
      return DFS {
        opened = SetL.new(),
        closed = SetL.new(),
	arrowsfrom = SetL.new(),
	named = SetL.new(),     -- used in some applications
      }
    end,
  __index = {
    --
    -- Very low-level DFS methods.
    isopened = function (d, node) return d.opened:has(node) end,
    isclosed = function (d, node) return d.closed:has(node) end,
    open0    = function (d, node) d.opened:add(node) end,
    close0   = function (d, node) d.closed:add(node) end,
    isnew    = function (d, node)
        return (not d:isopened(node))
           and (not d:isclosed(node))
      end,
    --
    -- Names and arrows.
    -- To register a new name or a new arrow, use name0 and arrow0.
    -- Calling d:name0(node, name2) again will not overwrite the old name.
    -- Calling d:arrow0(src, tgt, arrowname2) will add arrowname2 to
    --   the SetL that stores the names of arrows from src to tgt.
    name0  = function (d, node, name) d.named:add(node, name) end,
    arrow0 = function (d, src, tgt, arrowname)
        if not d.arrowsfrom:has(src) then 
	  d.arrowsfrom:add(src, SetL.new())
	end
	d.arrowsfrom:get(src):add(tgt, arrowname)
      end,
    getname = function (d, node) return d.named:val(node) end,
    genallarrows = function (d) return cow(function ()
	  for src,tgts in d.arrowsfrom:gen() do
	    for tgt,arrowname in tgts:gen() do
	      coy(src, tgt, arrowname)
	    end
	  end
	end)
      end,
    --
    -- These methods can be overriden.
    -- The :genarrowsfrom() below is for :nameluatables().
    -- The :ignorearrowsfrom() is an internal method that is used
    -- only by this implementation of :genarrowsfrom().
    ignorearrowsfrom = function (d, src)
        local ot = otype(src)
        return (ot == "Set") or (ot == "SetL") or (ot == "DFS")
      end,
    genarrowsfrom = function (d, src)
        if not (type(src) == "table") then return cow(nop) end
        if d:ignorearrowsfrom(src) then return cow(nop) end
        return cow(function ()
	    for name,tgt in pairs(src) do
              if type(name) == "string" and type(tgt) == "table" then
		coy(tgt, name)
	      end
	      local mt = getmetatable(o)
	      if type(mt) == "table" then
		coy(mt, "__mt")
	      end
	    end
          end)
      end,
    --
    -- Medium-level methods for DFSs.
    -- In standard DFSs users would only call d:openrec(node).
    -- In hackish DFSs users first call d:open0(nodei) on some nodes
    -- to delay recursion on them, then they call d:openrec(nodej) on
    -- some "normal" nodes, then they call d:recurseopennodes() to
    -- recurse on all the delayed nodes.
    close   = function (d, node) d:open0(node); d:close0(node); end,
    recurse = function (d, node)
        for tgt,arrowname in d:genarrowsfrom(node) do
	  d:arrow0(node, tgt, arrowname)
	  d:openrec(tgt)
	end
      end,
    openrec = function (d, node)
        if d:isnew(node) then
	  d:open0(node)
	  d:recurse(node)
	  d:close0(node)
	end
      end,
    recurseopennodes = function (d)
        for node in (d.opened - d.closed):gen() do
	  d:recurse(node)
	  d:close0(node)
	end
      end,
    --
    -- High-level methodes for DFSs with names.
    namenoderec = function (d, node, name)
        d:name0(node, name)
        d:open0(node, name)
	if not d:isclosed(node) then
	  d:recurse(node)
	  d:close0(node)
	end
      end,
    namenodenonrec = function (d, node, name)
        d:name0(node, name)
        d:open0(node, name)
      end,
    nameglobaltables = function (d)
        d:namenodenonrec(_G, "_G")
        for k,v in pairs(_G) do
	  if type(k) == "string" and type(v) == "table" then
	    local node, name = _G[k], k
	    d:namenodenonrec(node, name)
	  end
	end
      end,
    nameothertables = function (d)
      	for src,tgt,arrowname in d:genallarrows() do
	  local tgtname = d:getname(src) .. "." .. arrowname
	  d:name0(tgt, tgtname)
	end
      end,
    nameluatables = function (d)
        d:nameglobaltables()
	d:recurseopennodes()
        d:nameothertables()
	return d
      end,
    --
    namefunctionsin0 = function (d, tbl, prefix)
        if not type(tbl) == "table" then error("Not a table!") end
        for k,v in pairs(tbl) do
          if type(k) == "string" and type(v) == "function" then
            d:name0(v, prefix..k)
          end
        end
      end,
    namefunctionsin = function (d, o)
        local tbl, prefix
        if o == _G or o == ""      then tbl,prefix = _G, ""
        elseif type(o) == "table"  then tbl,prefix = o, d:getname(o).."." 
        elseif type(o) == "string" then tbl,prefix = expr(o), o.."." 
	end
	d:namefunctionsin0(tbl, prefix)
      end,
    nameallfunctions = function (d)
        d:namefunctionsin("")
        for tbl in d.closed:gen() do d:namefunctionsin(tbl) end
        return d
      end,
  },
}



--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "DFS.lua"

d = DFS.new():nameluatables()
for node in d.closed:gen() do
  print(d:getname(node))
end

= d:getname(_G)
= d:getname(Class)
= d:getname(Set.__index)

--]]



--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "DFS.lua"

d = DFS.new():nameluatables():nameallfunctions()
for a,b in d.named:gen() do
  print(a, b)
end
PPV(infomanual_basedir)

--]]



-- Local Variables:
-- coding:  utf-8-unix
-- End: