Warning: this is an htmlized version!
The original is here, and
the conversion rules are here.
-- This file:
-- http://angg.twu.net/dednat4/newtrees.lua
-- http://angg.twu.net/dednat4/newtrees.lua.html
-- (find-dn4file "newtrees.lua")

-- This is going to be one module of dednat5 - a rewrite of dednat4.
-- Rationale: in dednat4 there is no way to generate the TeX code for
-- trees without creating first a 2D ascii representation for them. I
-- am feeling more and more the need to generate trees
-- "automatically" - see the slides below for details -
--
--           (find-angg "LATEX/2010unilog-current.tex")
--   http://angg.twu.net/LATEX/2010unilog-current.dvi
--   http://angg.twu.net/LATEX/2010unilog-current.pdf
--
-- (More later. 2010jul04)

-- Very preliminary announcement:
--   (find-TH "dednat4" "quick-start")

-- «.metatables»	(to "metatables")
-- «.trees»		(to "trees")
-- «.wordsin»		(to "wordsin")
-- «.segs»		(to "segs")
-- «.trees-to-tex»	(to "trees-to-tex")
-- «.tests»		(to "tests")




-- «metatables»  (to ".metatables")
--
---  __  __      _        _        _     _           
--- |  \/  | ___| |_ __ _| |_ __ _| |__ | | ___  ___ 
--- | |\/| |/ _ \ __/ _` | __/ _` | '_ \| |/ _ \/ __|
--- | |  | |  __/ || (_| | || (_| | |_) | |  __/\__ \
--- |_|  |_|\___|\__\__,_|\__\__,_|_.__/|_|\___||___/
---                                                  
-- It is hard to dump and inspect structures like doubly-linked lists,
-- so use a further level of indirection: instead of representing
-- 
--   +-----+   +-----+         (this is the "abstract" representation.
--   | foo |r l| bar |     <-- We use labels between the boxes to       
--   +-----+   +-----+         indicate which field of each box points     
--			       to the other one)                      
-- as:
--   nodefoo = { tex="foo" }               -- this is the "direct"
--   nodebar = { tex="bar", l=nodefoo }    -- representation, which
--   nodefoo.r = nodebar                   -- we will _not_ use.
--
-- we will use a table called "objs" and a string id in each table
-- that stands for a box in the abstract representation, as this:
--
--   objs._node1 = { id="_node1", tex="foo", r="_node2" }
--   objs._node2 = { id="_node2", tex="bar", r="_node1" }
--
-- Let me introduce a term. A "tort" will be a "tag or table" - a
-- string id or a table. In the example above, "_node1" (a string) and
-- objs._node1 (a table) are two different torts that represent the
-- same "box".

-- The metatable tricks will let us convert between the two torts for
-- each box very easily, by just appending ".id"s and ".T"s. A ".id"
-- converts a table to its string id, but leaves strings unchanged; a
-- ".T" converts a string id to its corresponding table, but leaves
-- table objects unchanged. Note that superfluous ".id"s and ".T"s do
-- nothing:
--
--   objs._node1 .T.T.id.T.id.id   ==     "_node1"
--   objs._node1 .T.T.id.T.id.id.T == objs._node1
--       "_node1".T.T.id.T.id.id.T == objs._node1
--
-- The code:

objs = {}

string_mt = getmetatable("foo")
string_mt.__index = function (str, key)
    if key == "id" then return str end         -- str.id = str
    if key == "T"  then return objs[str] end   -- str.T  = objs[str]
    return string[key]                         -- str.f  = string.f
  end

obj_mt = obj_mt or {}
obj_mt.__index = function (T, key)
    if key == "T" then return T end
  end

setobjid = function (T, id)
    setmetatable(T, obj_mt)          -- add a metatable to T
    T.id = id                        -- set T.id = id       
    objs[id] = T                     -- set objs[id] = T    
    return T
  end

obj_newid = function (kind)
    local nkinds = "n"..kind.."s"
    objs[nkinds] = objs[nkinds] + 1  -- objs.nfoos = objs.nfoos + 1
    local n = objs[nkinds]           -- n = objs.nfoos
    local id = "_"..kind..n          -- return "_foo"..n
    return id
  end
obj_setid = function (kind, T)
    setmetatable(T, obj_mt)	     -- add a metatable to T
    local id = obj_newid(kind)	     -- id   = "_foo42"
    T.id = id                        -- T.id = "_foo42"
    objs[id] = T		     -- objs._foo42 = T
    return T
  end

obj_link = function (obj1, dir1, dir2, obj2)
    obj1.T[dir1] = obj2.id           -- obj1.T.r = "_obj2"
    obj2.T[dir2] = obj1.id           -- obj2.T.l = "_obj1"
  end
obj_adjustchildren = function (dir, this)
    this = this.T
    for i=1,#this do
      local child = this[i].T
      this[i]         = child.id     -- this[1]   = "_child1"
      child[dir]      = this.id      -- child1.L  = "_this"
      child[dir.."n"] = i            -- child1.Ln = 1
    end
  end
obj_appendto = function (parent, dir, this)
    tinsert(parent.T, this.id)
    this.T[dir] = parent.id
    this.T[dir.."n"] = #(parent.T)
  end
obj_next = function (this, dir)
    local parent = this.T[dir]
    local n = this.T[dir.."n"]
    return parent.T[n+1]
  end


-- «trees»  (to ".trees")
--
---  _____                   
--- |_   _| __ ___  ___  ___ 
---   | || '__/ _ \/ _ \/ __|
---   | || | |  __/  __/\__ \
---   |_||_|  \___|\___||___/
---                          
--
-- Our internal representation for trees will use two kinds of
-- "objects" (a.k.a. "boxes"): "nodes" and "bars". Here is an example:
--
--   +------+    +-------+
--   |   b  |    | b|->c |
--   +------+    +-------+
--    b bn=1      b bn=2
--      1           2
--   +-------------------+
--   |         -         |
--   +-------------------+
--             b
--             a
--          +-----+
--          |  c  |
--          +-----+
--
--   objs._node1 = newnode { tex="b",     b="_bar1", bn=1 }
--   objs._node2 = newnode { tex="b|->c", b="_bar1", bn=2 }
--   objs._bar1  = newbar  { rulechar="-", "_node1", "_node2", b="_node3" }
--   objs._node3 = newnode { tex="c",     a="_bar1" }

-- objs.nnodes = 0
-- newnode_ = function (T)
--     objs.nnodes = objs.nnodes + 1
--     return setobjid(T, "_node"..objs.nnodes)
--   end
-- newnode = function (tex, a)
--     return newnode_{tex=tex, a=(a and a.id)}
--   end
-- 
-- objs.nbars = 0
-- newbar_ = function (T)
--     objs.nbars = objs.nbars + 1
--     return setobjid(T, "_bar"..objs.nbars)
--   end
-- newbar = function (rulechar, rtex, ...)
--     local bar = newbar_{rulechar=rulechar, rtex=rtex, ...}
--     for i=1,#bar.T do
--       bar.T[i]      = bar.T[i].id
--       bar.T[i].T.b  = bar.id
--       bar.T[i].T.bn = i
--     end
--     return bar
--   end

newnode = function (tex, a)
    return obj_setid("node", {tex=tex, a=(a and a.id)})
  end
newbar = function (rulechar, rtex, ...)
    return obj_adjustchildren("b",
           obj_setid("bar", {rulechar=rulechar, rtex=rtex, ...}))
  end


-- «wordsin»  (to ".wordsin")
-- wordsin(str, ncharstoskip):
-- An iterator to generate words from a string.
-- Example:
--   s = "%:foo bar"; for l,w,r in wordsin(s, 2) do PP(l,w,r, s:sub(l,r)) end
-- prints:
--   3 "foo" 5 "foo"
--   7 "bar" 9 "bar"
-- Note that l and r follow the string:sub convention.
-- See: (find-angg "LUA/lua50init.lua" "mysortedpairs")
--      (find-luamanualw3m "#pdf-string.gmatch")
--      (find-luamanualw3m "#pdf-string.match")
--
wordsin = function (str, skip)
    str = untabify(str)
    skip = skip or 0
    return function ()
        local spaces, l, word, r = str:match("(%s*)()(%S+)()", skip + 1)
        if l then
          skip = r - 1
          return l, word, r - 1
        end
      end
  end


-- «segs»  (to ".segs")
--
---  ____                 
--- / ___|  ___  __ _ ___ 
--- \___ \ / _ \/ _` / __|
---  ___) |  __/ (_| \__ \
--- |____/ \___|\__, |___/
---             |___/     
--

-- Each line that starts with "%:" in a .tex file is split into
-- "segs", and these segs can be traversed bidimensionally to form
-- trees... The main data structure is this: in a line like
--
--   %:  foo  baaar
--            11111
--   12345678901234
--

-- the span of the segment "foo" is from columns 5 to 7, and the span
-- of "baaar" is from 10 to 14; in box notation, we will store these
-- segs as:

--   +--+       +---------+
--   |  |1     L| foo 5 7 |
--   |  |   Ln=1+---------+   +-----
--   |  |2  
--   |  |  
--   |  |  
--   |  |  
--   |  |  
--   |  |  
--   |  |  
--   
--   
--   
--   




-- «trees-to-tex»  (to ".trees-to-tex")
--
---  _____                         __    _____   __  __
--- |_   _| __ ___  ___  ___       \ \  |_   _|__\ \/ /
---   | || '__/ _ \/ _ \/ __|  _____\ \   | |/ _ \\  / 
---   | || | |  __/  __/\__ \ |_____/ /   | |  __//  \ 
---   |_||_|  \___|\___||___/      /_/    |_|\___/_/\_\
---                                                    
-- Functions to convert the box structure for trees into TeX.
-- Note that these are NOT the functions that process the "%:"
-- lines and generate the box structures...
--
-- At some point these functions will replace the ones in dednat4:
--   (find-dn4 "dednat4.lua" "tree-out")
--   (find-dn4 "dednat4.lua" "tree-out" "tex_node_tatsuta")
--   (find-dn4 "dednat4.lua" "tree-out" "tex_node_paultaylor")
-- but right now they are still in an experimental stage.
--   (find-TH "dednat4" "trees_and_abbrevs")

mathstrut = mathstrut or "{|} "
unabbrev  = unabbrev  or function (str) return str end


new_tex_node_tatsuta = function (indent, node)
    node = node.T
    if not node.a then return indent..mathstrut..unabbrev(node.tex) end
    local bar = node.a.T
    local barchar, bartext = bar.rulechar, bar.rtex
    local rulemodifier =
      (barchar=="=" and "=" or (barchar==":" and "*" or "")) ..
      (bartext=="" and "" or "[{"..unabbrev(bartext).."}]")
    local newindent = indent.." "
    local uppertex
    local n = #bar
    if n==0 then
      return format("%s\\infer%s{ %s%s }{ }", indent, rulemodifier,
          mathstrut, unabbrev(node.tex))
    else
      uppertex = new_tex_node_tatsuta(newindent, bar[1])
      for i=2,n do
        uppertex = uppertex .. " &\n" .. new_tex_node_tatsuta(newindent, bar[i])
      end
    end
    return format("%s\\infer%s{ %s%s }{\n%s }",
        indent, rulemodifier,
        mathstrut, unabbrev(node.tex),
        uppertex)
  end

test_dot_tex = [[
%L standardabbrevs()
%:
%:     -
%:     c  d
%:     ====?
%:  a  a->b
%:  -------
%:     b
%:
%:  ^tree1
%:
]]



-- «tests»  (to ".tests")
--[[

* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
ee_dofile "~/dednat4/newtrees.lua"

wordsin = function (str, skip)
    str = untabify(str)
    return string.gmatch(str, "%s*()(%S+)()", skip)
  end

s = "%:foo bar"
--   1234567890
for a,b,c in wordsin(s, 2) do
  PP(a,b,c, s:sub(a,c))
end

PP(("%:foo"):match("%s*()(%S+)()", 3))


-- skip is the # of chars to skip at the beginning
-- l and r follow the string:sub convention

s = "%:foo bar"
--   1234567890
for a,b,c in wordsin(s, 2) do
  PP(a,b,c, s:sub(a,c))
end


mathstrut = "{|} "
unabbrev = function (str) return str end
-- PP(newnode"foo")
-- PP(objs)
root = newnode("c", newbar("-", "app", newnode"b", newnode"b|->c"))
PP(root)
PP(objs)

dednat4dir = ee_expand "~/dednat4/"
ee_dofile "~/dednat4/dednat4.lua"
writefile("/tmp/test.tex", test_dot_tex)
processfile("/tmp/test.tex")

PP(tlines)

PP(headfor "Foo bar")
PP(headfor "%: bbb")

nop = function () end
closeblock = function ()
    ((prevhead and prevhead.afterlast) or nop)()
    prevhead = nil
  end
openblock = function ()
    ((thishead and thishead.beforefirst) or nop)(linestr)
  end
processline = function (linestr_)
    prevhead = thishead              -- may be nil
    linen    = linen + 1
    linestr  = linestr_
    thishead = headfor(linestr)     -- never nil
    PP(thishead)
    if prevhead ~= thishead then
      closeblock()
      openblock()
    end
    ((thishead and thishead.aftereach) or nop)(linestr)
  end

linen = 0
processline "%L print 'foo'"
processline ""
PP(heads)


closeblock = function ()
    

if prevhead and prevhead ~= thishead then
  prevhead.afterlast()
  prevhead = nil
end


-- (find-dn4 "dednat4.lua" "main")
-- (find-dn4 "dednat4.lua" "main" "processtex")
-- (find-dn4 "dednat4.lua" "process")
-- (find-dn4 "dednat4.lua" "process" "processtex")
-- (find-dn4 "dednat4.lua" "process" "processtex" "processfile")
-- (find-dn4 "dednat4.lua" "processfile")
-- (find-dn4 "dednat4.lua" "tree-head")
-- (find-dn4 "dednat4.lua" "tree-out")

= tex_node_tatsuta("", root)




tex_node_tatsuta = function (indent, lowerseg)
    local n, barseg, upperseg = stuffabovenode(lowerseg)
    if not barseg then
      return indent..mathstrut..unabbrev(lowerseg.text)
    end
    local barchar, bartext = barcharandtext(barseg)
    -- PP(barseg, barchar, bartext)
    local rulemodifier =
      (barchar=="=" and "=" or (barchar==":" and "*" or "")) ..
      (bartext=="" and "" or "[{"..unabbrev(bartext).."}]")
    local newindent = indent.." "
    local uppertex
    if n==0 then
      return format("%s\\infer%s{ %s%s }{ }", indent, rulemodifier,
          mathstrut, unabbrev(lowerseg.text))
    else
      uppertex = tex_node_tatsuta(newindent, upperseg)
      for i=2,n do
        upperseg = nextseg(upperseg)
        uppertex = uppertex .. " &\n" .. tex_node_tatsuta(newindent, upperseg)
      end
    end
    return format("%s\\infer%s{ %s%s }{\n%s }",
        indent, rulemodifier,
        mathstrut, unabbrev(lowerseg.text),
        uppertex)
  end




-- (find-dn4 "dednat4.lua" "diag-forth")





--]]

-- Local Variables:
-- coding: raw-text-unix
-- End: