|
Warning: this is an htmlized version!
The original is here, 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: