|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- This file:
-- http://angg.twu.net/LUA/Prad1.lua.html
-- http://angg.twu.net/LUA/Prad1.lua
-- (find-angg "LUA/Prad1.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun l () (interactive) (find-angg "LUA/Prad1.lua"))
-- (defun o () (interactive) (find-angg "LUA/Pis1.lua"))
-- «.PradOutput» (to "PradOutput")
-- «.PradOutput-tests» (to "PradOutput-tests")
-- «.PradContext» (to "PradContext")
-- «.PradContext-tests» (to "PradContext-tests")
-- «.PradStruct» (to "PradStruct")
-- «.PradStruct-tests» (to "PradStruct-tests")
-- «.PradClass» (to "PradClass")
-- «.PradClass-tests» (to "PradClass-tests")
spaces = function (n)
return string.rep(" ", n)
end
delnewline = function (str)
return (str:gsub("\n$", ""))
end
-- ____ _ ___ _ _
-- | _ \ _ __ __ _ __| |/ _ \ _ _| |_ _ __ _ _| |_
-- | |_) | '__/ _` |/ _` | | | | | | | __| '_ \| | | | __|
-- | __/| | | (_| | (_| | |_| | |_| | |_| |_) | |_| | |_
-- |_| |_| \__,_|\__,_|\___/ \__,_|\__| .__/ \__,_|\__|
-- |_|
-- «PradOutput» (to ".PradOutput")
-- The "print"s that are run by a Prad object
-- are "redirected" to a PradOutput object.
--
PradOutput = Class {
new = function () return PradOutput({}) end,
type = "PradOutput",
__tostring = function (po) return po:tostring("contract") end,
__index = {
add0 = function (po, line)
table.insert(po, line)
return po
end,
add1 = function (po, ctx, line, suffix)
return po:add0(ctx.indent .. line .. (suffix or ctx.suffix) .. "\n")
end,
--
contractible0 = function (po, i) -- if it ends with a "{\n"
return po[i]:match("^(.*{)%%?\n$") -- then return its left part
end,
contractible1 = function (po, j, n)
if po[j]:sub(1, n) == spaces(n) -- if its starts with n spaces
then return po[j]:sub(n+1) -- then return its right part
end
end,
contractifpossible = function (po, i)
local a = po:contractible0(i)
local b = a and po:contractible1(i + 1, #a)
if b then
po[i] = a
po[i+1] = b
end
end,
contract = function (po)
local po = copy(po)
for i=#po-1,1,-1 do
po:contractifpossible(i)
end
return po
end,
--
tostring = function (po, contract)
if contract then po = po:contract() end
return delnewline(table.concat(po))
end,
},
}
-- «PradOutput-tests» (to ".PradOutput-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "Prad1.lua"
po = PradOutput({
"abcd{%\n",
" foo\n"
})
PPP(po)
= po:tostring()
= po:tostring("contract")
= po
--]]
-- ____ _ ____ _ _
-- | _ \ _ __ __ _ __| |/ ___|___ _ __ | |_ _____ _| |_
-- | |_) | '__/ _` |/ _` | | / _ \| '_ \| __/ _ \ \/ / __|
-- | __/| | | (_| | (_| | |__| (_) | | | | || __/> <| |_
-- |_| |_| \__,_|\__,_|\____\___/|_| |_|\__\___/_/\_\\__|
--
-- «PradContext» (to ".PradContext")
--
PradContext = Class {
type = "PradContext",
new = function (indent, suffix)
return PradContext {indent=(indent or ""), suffix=(suffix or "")}
end,
__tostring = mytostringp,
__index = {
copy = function (pc) return copy(pc) end,
set = function (pc, key, val) pc[key] = val; return pc end,
copyset = function (pc, key, val) return pc:copy():set(key, val) end,
copyindent = function (pc, extraindent)
return pc:copyset("indent", pc.indent .. (extraindent or " "))
end,
},
}
-- «PradContext-tests» (to ".PradContext-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "Prad1.lua"
= PradContext.new()
= PradContext.new():copyindent()
= PradContext.new():copyindent(" ")
= PradContext.new():copy()
= PradContext.new():copy():set("foo", "bar")
= PradContext.new():copyset("foo", "bar")
--]]
-- ____ _ ____ _ _
-- | _ \ _ __ __ _ __| / ___|| |_ _ __ _ _ ___| |_
-- | |_) | '__/ _` |/ _` \___ \| __| '__| | | |/ __| __|
-- | __/| | | (_| | (_| |___) | |_| | | |_| | (__| |_
-- |_| |_| \__,_|\__,_|____/ \__|_| \__,_|\___|\__|
--
-- «PradStruct» (to ".PradStruct")
-- The class PradStruct implements a way to print
-- the low-level structure of a Prad object... like this:
--
-- > a = PradList {"aa", PradSub {b="BEGIN", e="END", 20, 24}, "aaa"}
-- > = a:tostruct()
-- PradList {(
-- 1 = "aa",
-- 2 = PradSub {(
-- b = "BEGIN",
-- e = "END",
-- 1 = 20,
-- 2 = 24
-- )},
-- 3 = "aaa"
-- )}
PradStruct = Class {
type = "PradStruct",
tostring = function (o, ctx)
return PradStruct.print(o, nil, ctx):tostring()
end,
--
comparekeys = function (key1, key2)
local type1, type2 = type(key1), type(key2)
if type1 ~= type2
then return type1 > type2
else return key1 < key2
end
end,
sortedkeys = function (A)
local lt = PradStruct.comparekeys
return sorted(keys(A), lt)
end,
keyprefix = function (key)
if key == nil then return "" end
return format("%s = ", key)
end,
genkvpcs = function (A)
return cow(function ()
local keys = PradStruct.sortedkeys(A)
for i,key in ipairs(keys) do
local val = A[key]
local keyprefix = PradStruct.keyprefix(key)
local comma = (i < #keys) and "," or ""
coy(key, val, keyprefix, comma)
end
end)
end,
be = function (o, keyprefix, comma)
keyprefix = keyprefix or ""
comma = comma or ""
if type(o) ~= "table" then error() end
if getmetatable(o) == nil then return keyprefix.."{", "}"..comma end
local b = format("%s%s {(", keyprefix, otype(o))
local e = format(")}%s", comma)
return b,e
end,
--
printitem = function (o, out, ctx, key, comma)
if type(o) == "table" then
local keyprefix = PradStruct.keyprefix(key)
local b,e = PradStruct.be(o, keyprefix, comma)
local newctx = ctx:copyindent(" ")
out:add1(ctx, b)
for key,val,keyprefix,comma in PradStruct.genkvpcs(o) do
PradStruct.printitem(val, out, newctx, key, comma)
end
out:add1(ctx, e)
else
local keyprefix = PradStruct.keyprefix(key)
out:add1(ctx, keyprefix..mytostring(o)..(comma or ""))
end
end,
print = function (o, out, ctx, key, comma)
if type(ctx) == "string" then
ctx = PradContext.new(ctx)
end
out = out or PradOutput.new()
ctx = ctx or PradContext.new()
PradStruct.printitem(o, out, ctx, key, comma)
return out
end,
--
__index = {
},
}
-- «PradStruct-tests» (to ".PradStruct-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "Prad1.lua"
a = {b="BB", e="EE", "a", "aa", 42}
b = PradSub {b="BB", e="EE", "a", "aa", 42}
c = PradList {b, 333, {"foo", 200}}
PP(PradStruct.sortedkeys(a))
for key,val,keyprefix,comma in PradStruct.genkvpcs(a) do
print(key,val,keyprefix,comma)
end
PP(PradStruct.be(a))
PP(PradStruct.be(a, "foo = ", ","))
PP(PradStruct.be(b))
PP(PradStruct.be(b, "foo = ", ","))
out = PradOutput.new()
ctx = PradContext.new()
PradStruct.print(c, out, ctx)
PradStruct.print("foo", out, ctx)
PradStruct.print("foo", out, ctx, "k", ",")
= out
= PradStruct.print(c)
= PradStruct.print(c):tostring()
= PradStruct.print(c, nil, ":: "):tostring()
= PradStruct.tostring(c)
= PradStruct.tostring(c, ":: ")
--]]
-- ____ _ ____ _
-- | _ \ _ __ __ _ __| |/ ___| | __ _ ___ ___
-- | |_) | '__/ _` |/ _` | | | |/ _` / __/ __|
-- | __/| | | (_| | (_| | |___| | (_| \__ \__ \
-- |_| |_| \__,_|\__,_|\____|_|\__,_|___/___/
--
-- «PradClass» (to ".PradClass")
-- Our printable algebraic datatypes are objects of classes that
-- inherit from PradClass. An example:
--
-- > = PradList {"aa", PradSub {b="BEGIN", e="END", "20", "42"}, "aaa"}
-- aa
-- BEGIN
-- 20
-- 42
-- END
-- aaa
--
PradClass = Class {
type = "PradClass",
from = function (classtable)
Class(classtable)
setmetatable(classtable.__index, { __index = PradClass.__index })
return classtable
end,
__index = {
add0 = function (prad, out, ctx, line)
return out:add0(line)
end,
add1 = function (prad, out, ctx, line, suffix)
return out:add0(ctx.indent .. line .. (suffix or ctx.suffix) .. "\n")
end,
--
printitem = function (prad, out, ctx, item)
if type(item) == "string"
then prad:add1(out, ctx, item)
else item:print(out, ctx)
end
end,
printitems = function (prad, out, ctx)
for i,item in ipairs(prad) do
prad:printitem(out, ctx, item)
end
end,
--
tostring = function (prad, out, ctx)
return prad:tooutput(out, ctx):tostring("contract")
end,
tooutput = function (prad, out, ctx)
if type(ctx) == "string" then
ctx = PradContext.new(ctx)
end
out = out or PradOutput.new()
ctx = ctx or PradContext.new()
prad:print(out, ctx)
return out
end,
tostruct = function (prad)
return PradStruct.tostring(prad)
end,
},
}
PradList = PradClass.from {
type = "PradList",
__tostring = function (pl) return pl:tostring() end,
__index = {
print = function (pl, out, ctx)
pl:printitems(out, ctx)
end,
},
}
PradSub = PradClass.from {
type = "PradSub",
__tostring = function (ps) return ps:tostring() end,
__index = {
print = function (ps, out, ctx)
local newctx = ctx:copyindent()
ps:add1(out, ctx, (ps.b or "{"))
ps:printitems(out, newctx)
ps:add1(out, ctx, (ps.e or "}"))
end,
},
}
-- «PradClass-tests» (to ".PradClass-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "Prad1.lua"
a = PradList {"aa", "aaa"}
b = PradList {"bb", a, "bbb"}
c = PradSub {"cc", "ccc"}
d = PradList {"dd", b, c, "ddd"}
e = PradSub {b="BEGIN", e="END", "ee", d, "eee"}
= a
= b
= c
= d
= d:tostring(nil, ":: ")
= e
= PradStruct.tostring(e)
= PradList {"aa", PradSub {b="BEGIN", e="END", "20", "42"}, "aaa"}
--]]
-- Local Variables:
-- coding: utf-8-unix
-- End: