Warning: this is an htmlized version!
The original is across this link,
and the conversion rules are here.
-- This file:
-- http://angg.twu.net/dednat5/stacks.lua
-- http://angg.twu.net/dednat5/stacks.lua.html
--  (find-angg        "dednat5/stacks.lua")
--
-- The easiest way to work with user-given expressions in dednat6 is
-- to build them as syntactic trees using a stack-based, Forth-like
-- language. We want to generate two kinds of output from these
-- expressions: 1) 2D ascii diagrams like the one below, for debugging
-- (built using the "Rect" class),
--
--   > = synttorect {[0]="+", {[0]="*", "2", "3"}, {[0]="*", "4", "5"}}
--   +_____.
--   |     |
--   *__.  *__.
--   |  |  |  |
--   2  3  4  5
--
-- and 2) LaTeX output, mainly for "underbrace structures" like this
-- one:
--
--    P & Q -> P
--   \-/ \-/  \-/
--    0   1    0
--   \-----/
--      0
--   \----------/
--          1
--
-- This file defines the classes "Rect" and "Stack", and some
-- high-level words that use them.
--
-- «.Rect»		(to "Rect")
-- «.Rect-tests»	(to "Rect-tests")
-- «.syntotorect»	(to "syntotorect")
-- «.synttorect-tests»	(to "synttorect-tests")
-- «.dedtorect»		(to "dedtorect")
-- «.dedtorect-tests»	(to "dedtorect-tests")
-- «.Stack»		(to "Stack")
-- «.Stack-tests»	(to "Stack-tests")
-- «.synttotex»		(to "synttotex")
-- «.ubs»		(to "ubs")
-- «.ubs-tests»		(to "ubs-tests")





--  ____           _   
-- |  _ \ ___  ___| |_ 
-- | |_) / _ \/ __| __|
-- |  _ <  __/ (__| |_ 
-- |_| \_\___|\___|\__|
--                     
-- This is a total rewrite (different data structures, methods, etc) of:
-- (find-dn5 "gab.lua" "Rect")
-- «Rect» (to ".Rect")

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

torect = function (o)
    if otype(o) == "Rect" then return o end
    if type(o) == "string" then return Rect.new(o) end
    error()
  end

Rect = Class {
  type = "Rect",
  new  = function (str) return Rect(splitlines(str)) end,
  rep  = function (str, n) local r=Rect{}; for i=1,n do r[i]=str end; return r end,
  __tostring = function (rect) return rect:tostring() end,
  __concat = function (r1, r2) return torect(r1):concat(torect(r2)) end,
  __index = {
    tostring = function (rect) return table.concat(rect, "\n") end,
    copy = function (rect) return copy(rect) end,
    width = function (rect) return foldl(max, 0, map(string.len, rect)) end,
    push1 = function (rect, str) table.insert(rect, 1, str); return rect end,
    push2 = function (rect, str1, str2) return rect:push1(str2):push1(str1) end,
    pad0  = function (rect, y, w, c, rstr)
        rect[y] = ((rect[y] or "")..(c or " "):rep(w)):sub(1, w)..(rstr or "")
        return rect
      end,
    lower = function (rect, n, str)
        for i=1,n do rect:push1(str or "") end
        return rect
      end,
    concat = function (r1, r2, w, dy)
        r1 = r1:copy()
        w = w or r1:width()
        dy = dy or 0
        for y=#r1+1,#r2+dy do r1[y] = "" end
        for y=1,#r2 do r1:pad0(y+dy, w, nil, r2[y]) end
        return r1
      end,
    prepend = function (rect, str) return Rect.rep(str, #rect)..rect end,
    --
    syn1 = function (r1, opname) return r1:copy():push2(opname or ".", "|") end,
    synconcat = function (r1, r2)
        return r1:copy():pad0(1, r1:width()+2, "_")..r2:copy():push2(".", "|")
      end,
    --
    dedconcat = function (r1, r2)
        local w = r1:width() + 2
        if #r1 <  #r2 then return r1:copy():lower(#r2-#r1):concat(r2, w) end
        if #r1 == #r2 then return r1:copy():concat(r2, w) end
        if #r1  > #r2 then return r1:copy():concat(r2, w, #r1-#r2) end
      end,
    dedroot = function (rect, str)
        table.insert(rect, ""); table.insert(rect, str); return rect
      end,
    dedbar = function (rect, c, label)
        local abovebar, belowbar = rect[#rect-2], rect[#rect]
        local w = max(#(abovebar or ""), #belowbar)
        rect:pad0(#rect-1, w, c or "-", label)
        return rect
      end,
  },
}

-- «Rect-tests» (to ".Rect-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "stacks.lua"

r = Rect.new "a\nbb\nccc"
= r
PP(r)
= r:width()
= r:copy():pad0(1, 4, nil, "d")
= r:copy():pad0(1, 4, "_", "d")
= r:copy():push2("op", "|")
= r:copy():push2("op", "|"):pad0(1, r:width()+1, "_")..r:copy():push2(".", "|")
= "This => "..r.." <="

= torect("a"):dedconcat(torect("b"))
= torect("a"):dedconcat(torect("b")):dedroot("c"):dedbar("-", "foo")
= torect("a"):dedconcat(torect("bbbbbb")):dedroot("c"):dedbar("-", "foo")
= torect("a"):dedconcat(torect("b")):dedroot("cccccc"):dedbar("-", "foo")
= torect("2"):syn1("*"):synconcat(torect("3"))

--]]



--                  _   _                      _   
--  ___ _   _ _ __ | |_| |_ ___  _ __ ___  ___| |_ 
-- / __| | | | '_ \| __| __/ _ \| '__/ _ \/ __| __|
-- \__ \ |_| | | | | |_| || (_) | | |  __/ (__| |_ 
-- |___/\__, |_| |_|\__|\__\___/|_|  \___|\___|\__|
--      |___/                                      
--
-- «syntotorect» (to ".syntotorect")

synttorect = function (o)
    if type(o) == "string" then return torect(o) end
    if type(o) == "table" then
      local r = synttorect(o[1]):syn1(o[0])
      for i=2,#o do r = r:synconcat(synttorect(o[i])) end
      return r
    end
    error()
  end

-- «synttorect-tests» (to ".synttorect-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "stacks.lua"
tree = {[0]="+", {[0]="*", "2", "3"}, {[0]="*", "4", "5"}}
tree = {[0]="+", {[0]="*", "2", "3"}, {[0]="*", "4", "5"}, b="=", label="hi"}
= synttorect(tree)
= dedtorect (tree)
--]]


-- «dedtorect» (to ".dedtorect")
dedtorect = function (o)
    if type(o) == "string" then return torect(o) end
    if type(o) == "table" then
      local r = dedtorect(o[1])
      for i=2,#o do r = r:dedconcat(dedtorect(o[i])) end
      return r:dedroot(o[0] or "?"):dedbar(o.b or "-", o.label)
    end
    error()
  end

-- «dedtorect-tests» (to ".dedtorect-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "stacks.lua"
tree = { { { "[P&Q]^1",
             [0]="P"
           },
           { { "[P&Q]^1",
               [0]="Q"
             },
             "Q->R",
             [0]="R"
           },
           [0]="P&R"
         },
         label="1",
         [0]="P&Q->P&R"
       }
= dedtorect (tree)

--]]





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

Stack = Class {
  type    = "Stack",
  new     = function () return Stack {} end,
  __index = {
    push  = function (s, o) table.insert(s, o); return s end,
    dropn = function (s, n) for i=1,n do s[#s] = nil end end,
    pop   = function (s) return                            s[#s], s:dropn(1) end,
    pop2  = function (s) return                   s[#s-1], s[#s], s:dropn(2) end,
    pop3  = function (s) return          s[#s-2], s[#s-1], s[#s], s:dropn(3) end,
    pop4  = function (s) return s[#s-3], s[#s-2], s[#s-1], s[#s], s:dropn(4) end,
    clean = function (s) s:dropn(#s); return s end,
    PP    = function (s) PP(s); return s end,
    --
    doword = function (s, word)
        if     word == "()"  then s:push {"(", s:pop(), ")", tex="(<2>)"}
        elseif word == "u"   then s:push {[0]=s:pop(), s:pop(), tex="\\underbrace{\n<1>\n}_{<0>}"}
        elseif word == "bin" then s:push {[2]=s:pop(), [3]=s:pop(), [1]=s:pop(), tex="<1> <2>\n <3>"}
        elseif word == "pre" then s:push {[1]=s:pop(), [2]=s:pop(), tex="<1> <2>"}
        else   s:push(word)
        end
        return s
      end,
    dowords = function (s, bigstr)
        for _,word in ipairs(split(bigstr)) do s:doword(word) end
        return s
      end,
  },
}

--[==[
-- «Stack-tests» (to ".Stack-tests")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "istanbulall.lua"
s = Stack.new()
s:push(22):push(33):PP()
= s:clean():push(22):push(33):PP():push(44):PP():dropn(2):PP():pop()

--]==]



-- «synttotex» (to ".synttotex")
synttotex = function (o)
    if type(o) == "string" then return o end
    if type(o) == "table" then
      return (o.tex:gsub("<([%d])>", function (n) return synttotex(o[n+0]) end))
    end
    error()
  end



--        _         
--  _   _| |__  ___ 
-- | | | | '_ \/ __|
-- | |_| | |_) \__ \
--  \__,_|_.__/|___/
--                  
-- «ubs» (to ".ubs")
ubs0 = function (bigstr) return Stack.new():dowords(bigstr):pop() end
ubstree = function (bigstr) return synttorect(ubs0(bigstr)) end
ubstex  = function (bigstr) return synttotex (ubs0(bigstr)) end

ubs = function (bigstr) return ubstex(bigstr) end
ubs = function (bigstr) print(ubstree(bigstr)); print(); return ubstex(bigstr) end


--[==[
-- «ubs-tests» (to ".ubs-tests")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "stacks.lua"
--
-- (find-istfile "1.org" "Some non-tautologies: DeMorgan")
--
-- (P  & Q)->( P v   Q)
--   10  01      10    01
--     00      02    20
-- 32              22
--          22
--
= ubs "P Q \\& bin () 2 + bin"
= ubs [[
  P 10 u   Q 01 u   \& bin 00 u    () \neg pre 32 u
  P 10 u   \neg pre 02 u   Q 01 u \neg pre 20 u   \lor bin 22 u ()
  \to bin 22 u
]]

PP(ubs("a () ()"))
= synttorect(ubs("a () ()"))
= synttorect(ubs([[ P 10 u ]]))
= synttorect(ubs([[ P 10 u Q 01 u \& bin ]]))
= synttorect(ubs([[ P 10 u Q 01 u \& bin 00 u    () \neg pre 32 u ]]))
= ubs [[ P 10 u Q 01 u \& bin 00 u    () \neg pre 32 u ]]

= ubstree [[ P 0 u Q 1 u \& bin 0 u ]] 
= ubstree  [[ P 0 u   Q 1 u   \& bin 0 u   P 0 u   -> bin 1 u ]] 
= ubs      [[ P 0 u   Q 1 u   \& bin 0 u   P 0 u   -> bin 1 u ]] 
= ubstreetex [[ P 0 u   Q 1 u   \& bin 0 u   P 0 u   \to bin 1 u ]] 

--]==]




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

--]]


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