|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- gab.lua - Gabriela Avila's calculator for quantified
-- expressions, Lua version (full)
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2012may13
-- Licence: GPL3
--
-- The latest upstream version of this can be found at:
-- http://angg.twu.net/dednat5/gab.lua
-- http://angg.twu.net/dednat5/gab.lua.html
-- (find-dn5 "gab.lua")
--
-- Older version:
-- http://angg.twu.net/dednat5/gabriela.lua
-- http://angg.twu.net/dednat5/gabriela.lua.html
-- (find-dn5 "gabriela.lua")
-- http://angg.twu.net/dednat5/gabriela-app.lua
-- http://angg.twu.net/dednat5/gabriela-app.lua.html
-- (find-dn5 "gabriela-app.lua")
-- Quick index:
-- «.eoo.lua» (to "eoo.lua")
-- «.Expr» (to "Expr")
-- «.expr:infix» (to "expr:infix")
-- «.constructors» (to "constructors")
-- «.expr:tolisp» (to "expr:tolisp")
-- «.expr:eval» (to "expr:eval")
-- «.eval-quantifiers» (to "eval-quantifiers")
-- «.Rect» (to "Rect")
-- «.expr:print» (to "expr:print")
-- «.expr:Dbg» (to "expr:Dbg")
-- «.Context» (to "Context")
-- Quick index:
-- «.contexts» (to "contexts")
-- «.contexts-test» (to "contexts-test")
-- «.def-lambda-app» (to "def-lambda-app")
-- «.comprehension» (to "comprehension")
-- «.comprehension-test» (to "comprehension-test")
-- «.def-lambda-app-tests» (to "def-lambda-app-tests")
-- «.grids» (to "grids")
-- «.grids-tests» (to "grids-tests")
-- «.old-parser» (to "old-parser")
-- «.precedence-table» (to "precedence-table")
-- «.precedence» (to "precedence")
-- «.recursive-descent» (to "recursive-descent")
-- «.parser-grammar» (to "parser-grammar")
-- «.lpeg-parser» (to "lpeg-parser")
-- «.pe» (to "pe")
-- «.modal» (to "modal")
--
-- ___ ___ ___
-- / _ \/ _ \ / _ \
-- | __/ (_) | (_) |
-- \___|\___/ \___/
--
-- «eoo.lua» (to ".eoo.lua")
-- dofile "eoo.lua" -- (find-dn5 "eoo.lua")
-- Just the relevant definitions from eoo.lua, to make this self-contained.
-- The documentation is at:
-- (find-dn5 "eoo.lua" "test-eoo")
-- (find-dn5 "eoo.lua" "box-diagram")
Class = {
type = "Class",
__call = function (class, o) return setmetatable(o, class) end,
}
setmetatable(Class, Class)
otype = function (o) -- works like type, except on my "objects"
local mt = getmetatable(o)
return mt and mt.type or type(o)
end
-- end of eoo.lua
-- _
-- _ __ ___ __ _ _ __ ___ ___ _ __ ___ __ _| |_
-- | '_ ` _ \ / _` | '_ \ / __/ _ \| '_ \ / __/ _` | __|
-- | | | | | | (_| | |_) | (_| (_) | | | | (_| (_| | |_
-- |_| |_| |_|\__,_| .__/ \___\___/|_| |_|\___\__,_|\__|
-- |_|
--
-- And here are "mapconcat" and friends, from my init file:
-- (find-angg "LUA/lua50init.lua" "map" "mapconcat")
-- (find-lua51manualw3m "#pdf-table.concat")
map = function (f, A, i, j)
local B = {}
for k=(i or 1),(j or #A) do table.insert(B, (f(A[k]))) end
return B
end
mapconcat = function (f, A, sep, i, j)
return table.concat(map(f, A, i, j), sep)
end
foldl = function (f, a, B, i, j)
for k=(i or 1),(j or #B) do a = f(a, B[k]) end
return a
end
id = function (...) return ... end
sorted = function (T, lt) table.sort(T, lt); return T end
keys = function (T)
local ks = {}
for k,_ in pairs(T) do table.insert(ks, k) end
return ks
end
min = function (a, b) return a < b and a or b end
max = function (a, b) return a < b and b or a end
unpack = unpack or table.unpack
-- end of mapconcat
-- _____
-- | ____|_ ___ __ _ __
-- | _| \ \/ / '_ \| '__|
-- | |___ > <| |_) | |
-- |_____/_/\_\ .__/|_|
-- |_|
--
-- «Expr» (to ".Expr")
-- «expr:infix» (to ".expr:infix")
Expr = Class {
type = "Expr",
__index = {
print = function (e) print(e); return e end, -- uses __tostring
},
__tostring = function (e) return tostring(e:infix()) end,
__add = function (e1, e2) return Expr {[0]="+", e1, e2} end,
__sub = function (e1, e2) return Expr {[0]="-", e1, e2} end,
__mul = function (e1, e2) return Expr {[0]="*", e1, e2} end,
__div = function (e1, e2) return Expr {[0]="/", e1, e2} end,
__unm = function (e1) return Expr {[0]="u-", e1} end,
}
-- Constructors
-- «constructors» (to ".constructors")
Num = function (n) return Expr {[0]="n", n} end
Var = function (s) return Expr {[0]="v", s} end
Bool = function (b) return Expr {[0]="b", b} end
Unm = function (e1) return - e1 end
Mul = function (e1, e2) return e1 * e2 end
Div = function (e1, e2) return e1 / e2 end
Add = function (e1, e2) return e1 + e2 end
Sub = function (e1, e2) return e1 - e2 end
Eq = function (e1, e2) return Expr {[0]="==", e1, e2} end
Lt = function (e1, e2) return Expr {[0]="<", e1, e2} end
Le = function (e1, e2) return Expr {[0]="<=", e1, e2} end
Ge = function (e1, e2) return Expr {[0]=">=", e1, e2} end
Gt = function (e1, e2) return Expr {[0]="<", e1, e2} end
Neq = function (e1, e2) return Expr {[0]="!=", e1, e2} end
Not = function (e1) return Expr {[0]="nt", e1} end
And = function (e1, e2) return Expr {[0]="&", e1, e2} end
Or = function (e1, e2) return Expr {[0]="or", e1, e2} end
Imp = function (e1, e2) return Expr {[0]="->", e1, e2} end
Tuple = function (...) return Expr {[0]="()", ...} end
Set = function (...) return Expr {[0]="{}", ...} end
-- Fa = function (e1, e2, e3) return Expr {[0]="Fa", e1, e2, e3} end
-- Ex = function (e1, e2, e3) return Expr {[0]="Ex", e1, e2, e3} end
Fa = function (e1, e2) return Expr {[0]="Fa", e1, e2} end
Ex = function (e1, e2) return Expr {[0]="Ex", e1, e2} end
True = Bool(true)
False = Bool(false)
-- ___ _
-- __ ____ _ _ __ ___ ( _ ) ___ ___ _ __ ___| |_ ___
-- \ \ / / _` | '__/ __| / _ \/\ / __/ _ \| '_ \/ __| __/ __|
-- \ V / (_| | | \__ \ | (_> < | (_| (_) | | | \__ \ |_\__ \
-- \_/ \__,_|_| |___/ \___/\/ \___\___/|_| |_|___/\__|___/
--
-- Convenience: some expressions (variables and numeric constants)
-- that I use in tests
_0 = Num(0)
_1 = Num(1)
_2 = Num(2)
_3 = Num(3)
_4 = Num(4)
_5 = Num(5)
a = Var "a"
b = Var "b"
c = Var "c"
d = Var "d"
k = Var "k"
x = Var "x"
y = Var "y"
-- _ _ _
-- | |_ ___ | (_)___ _ __
-- | __/ _ \| | / __| '_ \
-- | || (_) | | \__ \ |_) |
-- \__\___/|_|_|___/ .__/
-- |_|
--
-- «expr:tolisp» (to ".expr:tolisp")
-- A Lisp-ish representation.
-- Note that our Exprs use 0-based arrays, not cons cells.
-- (find-elnode "Cons Cell Type")
-- (find-elnode "Box Diagrams")
tolisp = function (e)
if type(e) == "number" then return e
elseif type(e) == "string" then return "\""..e.."\""
elseif otype(e) == "Expr" then
return "("..tolisp(e[0]).." "..mapconcat(tolisp, e, " ")..")"
else return "<"..tostring(e)..">"
end
end
Expr.__index.tolisp = function (e) return tolisp(e) end
Expr.__index.lprint = function (e) print(e:tolisp()); return e end
-- _ __ _
-- (_)_ __ / _(_)_ __
-- | | '_ \| |_| \ \/ /
-- | | | | | _| |> <
-- |_|_| |_|_| |_/_/\_\
--
Expr.__index.infix = function (e, b)
local op, e1, e2, e3 = e[0], e[1], e[2], e[3]
local t, str
if op == "v" then t, str = 200, e[1]
elseif op == "n" then t, str = 200, tostring(e[1])
elseif op == "b" then t, str = 200, e[1] and "T" or "F"
elseif op == "u-" then t, str = 9, "-"..e1:infix(100)
elseif op == "*" then t, str = 8, e1:infix(7).."*"..e2:infix(8)
elseif op == "/" then t, str = 8, e1:infix(7).."*"..e2:infix(8)
elseif op == "+" then t, str = 7, e1:infix(6).."+"..e2:infix(7)
elseif op == "-" then t, str = 7, e1:infix(6).."-"..e2:infix(7)
elseif op == "==" then t, str = 6, e1:infix(6).." == "..e2:infix(6)
elseif op == "<=" then t, str = 6, e1:infix(6).." <= "..e2:infix(6)
elseif op == ">=" then t, str = 6, e1:infix(6).." >= "..e2:infix(6)
elseif op == "<" then t, str = 6, e1:infix(6).." < " ..e2:infix(6)
elseif op == ">" then t, str = 6, e1:infix(6).." > " ..e2:infix(6)
elseif op == "!=" then t, str = 6, e1:infix(6).." != "..e2:infix(6)
elseif op == "nt" then t, str = 5, "not "..e1:infix(4)
elseif op == "&" then t, str = 4, e1:infix(3).." & " ..e2:infix(4)
elseif op == "or" then t, str = 3, e1:infix(2).." or "..e2:infix(3)
elseif op == "->" then t, str = 2, e1:infix(2).." -> "..e2:infix(2)
elseif op == "()" then t, str = 200, "("..e:infixs()..")"
elseif op == "{}" then t, str = 200, "{"..e:infixs().."}"
elseif op == "Fa" then t, str = 1, "Fa "..e1:infix()..". "..e2:infix()
elseif op == "Ex" then t, str = 1, "Ex "..e1:infix()..". "..e2:infix()
-- elseif op == "Fa" then t, str = 1, "Fa "..e1:infix().." in "..
-- e2:infix()..". "..e3:infix()
-- elseif op == "Ex" then t, str = 1, "Ex "..e1:infix().." in "..
-- e2:infix()..". "..e3:infix()
elseif op == "Dg" then str, t = e1:infix()
--#ifdef HAS_LAMBDA
elseif op == "De" then t, str = 200, e1
elseif op == "Ap" then t, str = 200, e1:infix(3).."("..e2:infix()..")"
elseif op == "\\" then t, str = 3, "\\"..e1:infix().."."..e2:infix()
--#endif HAS_LAMBDA
--#ifdef HAS_COMPREHENSION
-- subset, set of images, generator, filter, collect
elseif op == "Su" then t, str = 200, "{"..e1:infix().." | "..
e:infixs(", ", 2, #e-1).."}"
elseif op == "So" then t, str = 200, "{"..e[#e]:infix().." | "..
e:infixs(", ", 1, #e-1).."}"
elseif op == "<-" then t, str = 200, e1:infix().." <- "..e2:infix()
--#endif HAS_COMPREHENSION
--#endif HAS_MODAL
elseif op == "Mo" then t, str = 200, e1
--#ifdef HAS_MODAL
-- else str, t = e:infix_other(b) -- all extensions
else error("Bad expr:"..tolisp(e))
end
if b and t <= b then str = "("..str..")" end
return str, t
end
Expr.__index.infixs = function (e, sep, i, j)
return mapconcat(e.infix, e, (sep or ", "), i, j)
end
-- _
-- _____ ____ _| |
-- / _ \ \ / / _` | |
-- | __/\ V / (_| | |
-- \___| \_/ \__,_|_|
--
-- «expr:eval» (to ".expr:eval")
-- Evaluation.
-- To avoid making the code above too big we inject new methods into
-- Expr, using a low-level syntax for that:
-- Expr.__index.newmethod = function (e, a, b, c) ... end
etype = function (e) return otype(e) == "Expr" and e[0] end
Expr.__index.neval = function (e)
local ee = e:eval()
if etype(ee) == "n" then return ee[1] end
error("Not a number: "..tostring(ee))
end
Expr.__index.beval = function (e)
local ee = e:eval()
if etype(ee) == "b" then return ee[1] end
error("Not a boolean: "..tostring(ee))
end
Expr.__index.seval = function (e)
local ee = e:eval()
if etype(ee) == "{}" then return ee end
error("Not a set: "..tostring(ee))
end
Expr.__index.eval_components = function (e)
local A = map(e.eval, e)
A[0] = e[0]
return Expr(A)
end
_and = function (P, Q) return P and Q end
_or = function (P, Q) return P or Q end
_imp = function (P, Q) return (not P) or Q end
context = {}
Expr.__index.eval = function (e)
local op, e1, e2, e3 = e[0], e[1], e[2], e[3]
if op == "n" then return e
elseif op == "b" then return e
elseif op == "v" then return context[e1] or error("Undef: "..e1)
elseif op == "u-" then return Num(- e1:neval())
elseif op == "*" then return Num(e1:neval() * e2:neval())
elseif op == "/" then return Num(e1:neval() / e2:neval())
elseif op == "+" then return Num(e1:neval() + e2:neval())
elseif op == "-" then return Num(e1:neval() - e2:neval())
elseif op == "==" then return Bool(e1:neval() == e2:neval())
elseif op == "<=" then return Bool(e1:neval() <= e2:neval())
elseif op == ">=" then return Bool(e1:neval() >= e2:neval())
elseif op == "<" then return Bool(e1:neval() < e2:neval())
elseif op == ">" then return Bool(e1:neval() > e2:neval())
elseif op == "!=" then return Bool(e1:neval() ~= e2:neval())
elseif op == "nt" then return Bool(not e1:beval())
elseif op == "&" then return Bool(_and(e1:beval(), e2:beval()))
elseif op == "or" then return Bool(_or (e1:beval(), e2:beval()))
elseif op == "->" then return Bool(_imp(e1:beval(), e2:beval()))
elseif op == "{}" then return e:eval_components()
elseif op == "()" then return e:eval_components()
elseif op == "Fa" then return Bool(e1[1]:_fold(true,_and,_beval, e1[2], e2))
elseif op == "Ex" then return Bool(e1[1]:_fold(false,_or,_beval, e1[2], e2))
-- elseif op == "Fa" then return Bool(e1:_fold(true, _and, _beval, e2, e3))
-- elseif op == "Ex" then return Bool(e1:_fold(false, _or, _beval, e2, e3))
elseif op == "Dg" then return e1:DbgEval() -- defined elsewhere
else return e:eval_other() -- all extensions
end
end
-- _ _ __ _
-- __ _ _ _ __ _ _ __ | |_(_)/ _(_) ___ _ __ ___
-- / _` | | | |/ _` | '_ \| __| | |_| |/ _ \ '__/ __|
-- | (_| | |_| | (_| | | | | |_| | _| | __/ | \__ \
-- \__, |\__,_|\__,_|_| |_|\__|_|_| |_|\___|_| |___/
-- |_|
-- «eval-quantifiers» (to ".eval-quantifiers")
-- The evaluation code for "Fa" and "Ex" calls "_fold" and "_beval",
-- that are defined below.
Expr.__index.varname = function (e)
if etype(e) == "v" then return e[1] end
error("Not a variable: "..tostring(ee))
end
Expr.__index.as = function (var, value, expr)
local vname = var:varname()
local oldvalue = context[vname]
context[vname] = value
local result = expr:eval()
context[vname] = oldvalue
return result
end
Expr.__index._fold = function (var, r, op, normalize, set, expr)
for _,value in ipairs(set) do
r = op(r, normalize(var:as(value, expr)))
end
return r
end
_beval = function (e) return e:beval() end
Expr.__index.peval = function (e)
local result = e:eval()
print(tostring(e).." --> "..tostring(result))
return result
end
-- __ ___
-- \ \ / / |__ ___ _ __
-- \ \ /\ / /| '_ \ / _ \ '_ \
-- \ V V / | | | | __/ | | |
-- \_/\_/ |_| |_|\___|_| |_|
--
-- Obsolete?
Expr.__index.When = function (var, value, expr)
return "When " ..tostring(var)..
"=" ..tostring(value)..
": " ..tostring(expr)..
" --> "..tostring(var:as(value, expr))
end
Expr.__index.Whens = function (var, set, expr)
for _,value in ipairs(set) do
print(var:When(value, expr))
end
end
-- ____ _
-- | _ \ ___ ___| |_
-- | |_) / _ \/ __| __|
-- | _ < __/ (__| |_
-- |_| \_\___|\___|\__|
--
-- «Rect» (to ".Rect")
-- Rectangles (for trees)
-- (find-luamanualw3m "#pdf-string.rep")
strrep = function (str, n) return string.rep(str, max(0, n)) end
strpad = function (str, n, char) return str..strrep(char or " ", n-#str) end
copy = function (A)
local B = {}
for k,v in pairs(A) do B[k] = v end
setmetatable(B, getmetatable(A))
return B
end
stringtorect = function (str, height)
local lines = splitlines(str)
lines.w = foldl(max, 0, map(string.len, lines))
return Rect(lines):raise(height or 0)
end
torect = function (o, height)
if otype(o) == "Rect" then return o end
if otype(o) == "Expr" then return o:torect() end
return stringtorect(tostring(o), height)
end
Rect = Class {
type = "Rect",
__index = {
copy = function (rect) return copy(rect) end,
min = function (rect)
for i=1,-100000,-1 do if rect[i-1] == nil then return i end end
end,
max = function (rect) return #rect end,
raise = function (rect, n)
if n == "b" then n = rect:max()-1 end
for i=rect:min(),rect:max()+n do rect[i-n] = rect[i] end
return rect
end,
lower = function (rect, n)
if n == "t" then n = -rect:min()+1 end
for i=rect:max(),rect:min()-n,-1 do rect[i+n] = rect[i] end
return rect
end,
lowert = function (rect)
return rect:min() == 1 and rect or rect:copy():lower("t")
end,
--
get = function (rect, y) return rect[y] or "" end,
getp = function (rect, y, c) return strpad(rect:get(y), rect.w, c) end,
adjw = function (rect, y) rect.w = max(rect.w, #rect:get(y)) end,
set = function (rect, y, str, fill)
for i=y+1,rect:min()-1 do rect[i] = fill or "" end
for i=#rect+1,y-1 do rect[i] = fill or "" end
rect[y] = str
rect:adjw(y)
return rect
end,
under = function (rect, str)
return rect:copy():set(rect:min()-2, str, "|"):lower(2)
end,
under_ = function (rect, str, n)
return rect:under(strpad(str, rect.w+(n or 2), "_"))
end,
},
__tostring = function (rect)
return mapconcat(id, rect, "\n", rect:min(), rect:max())
end,
__concat = function (r1, r2)
r1 = torect(r1)
r2 = torect(r2)
r3 = Rect {w=0}
for y=min(r1:min(), r2:min()),max(r1:max(), r2:max()) do
r3:set(y, r1:getp(y, " ")..r2:get(y))
end
r3.l = r1.l
r3.r = r2.r
return r3
end,
}
rectconcat = function (op, rects)
if #rects == 0 then return torect(op) end
if #rects == 1 then return torect(rects[1]):under(op) end
local out = torect(rects[1]):under_(op)
for i=2,#rects-1 do out = out..torect(rects[i]):under_(".") end
return out..torect(rects[#rects]):under(".")
end
Expr.__index.torect = function (e)
local op, e1 = e[0], e[1]
if op == "n" then return torect(e1) end
if op == "v" then return torect(e1) end
if op == "b" then return torect(e:infix()) end
-- local subrects = map(Expr.__index.torect, e)
local subrects = map(torect, e)
return rectconcat (op, subrects)
end
-- «expr:print» (to ".expr:print")
-- Some methods for printing
Expr.__index.rprint = function (e) print(e:torect()); return e end
Expr.__index.preval = function (e)
print(tostring(e))
print(torect(e))
print()
local result = e:eval()
print(" --> "..tostring(result))
print()
return result
end
-- ____ _
-- | _ \| |__ __ _
-- | | | | '_ \ / _` |
-- | |_| | |_) | (_| |
-- |____/|_.__/ \__, |
-- |___/
--
-- «expr:Dbg» (to ".expr:Dbg")
-- Support for debugging (verbose subexpressions)
Expr.__index.Dbg = function (e1) return Expr {[0]="Dg", e1} end
Expr.__index.DbgEval = function (expr)
local result = expr:eval()
print(contextstring()..tostring(expr).." --> "..tostring(result))
return result
end
contextstring = function ()
local sk = sorted(keys(context))
local f = function (name) return name.."="..tostring(context[name]) end
return "["..mapconcat(f, sk, " ").."] "
end
-- ____ _ _
-- / ___|___ _ __ | |_ _____ _| |_
-- | | / _ \| '_ \| __/ _ \ \/ / __|
-- | |__| (_) | | | | || __/> <| |_
-- \____\___/|_| |_|\__\___/_/\_\\__|
--
-- «Context» (to ".Context")
-- Contexts are used for variables and for substitutions.
Context = Class {
type = "Context",
__index = {
push = function (ctxt, name, expr)
local pair = {name, ctxt[name]}
table.insert(ctxt.__stack, pair)
ctxt[name] = expr
return ctxt
end,
pop = function (ctxt)
local pair = table.remove(ctxt.__stack) or error("Empty __stack")
local name, oldvalue = pair[1], pair[2]
ctxt[name] = oldvalue
return ctxt
end,
minus = function (ctxt, name)
if ctxt[name] == nil then return ctxt end
ctxt = copy(ctxt); ctxt[name] = nil; return ctxt
end,
keys = function (ctxt) return sorted(keys(ctxt:minus("__stack"))) end,
tostring = function (ctxt, sep)
local ks = ctxt:keys()
for i,name in ipairs(ks) do ks[i] = name.."="..tostring(ctxt[name]) end
return mapconcat(id, ks, sep or ", ")
end,
print = function (ctxt) print(ctxt); return ctxt end,
vprint = function (ctxt) print(ctxt:tostring"\n"); return ctxt end,
},
__tostring = function (ctxt) return ctxt:tostring() end,
}
newcontext = function (T) T.__stack = {}; return Context(T) end
context = newcontext {}
defs = newcontext {}
-- _ _ _
-- | | __ _ _ __ ___ | |__ __| | __ _
-- | |/ _` | '_ ` _ \| '_ \ / _` |/ _` |
-- | | (_| | | | | | | |_) | (_| | (_| |
-- |_|\__,_|_| |_| |_|_.__/ \__,_|\__,_|
--
-- «def-lambda-app» (to ".def-lambda-app")
-- A very simple implementation of definitions and application
Def = function (name) return Expr {[0]="De", name} end
App = function (e1, e2) return Expr {[0]="Ap", e1, e2} end
Lambda = function (var, expr) return Expr {[0]="\\", var, expr} end
Expr.__index.eval_other = function (e)
local op, e1, e2, e3 = e[0], e[1], e[2], e[3]
if op == "De" then return defs[e1]:eval()
elseif op == "\\" then return e
elseif op == "Ap" then return _app(e1:eval(), e2:eval())
elseif op == "Su" then return _evalcompr(e)
elseif op == "So" then return _evalcompr(e)
else print(tolisp(e)); error("Bad expr")
end
end
_app = function (f, a)
if otype(f) ~= "Expr" then error("f must be an expr") end
if otype(a) ~= "Expr" then error("a must be an expr") end
if f[1][0] ~= "v" then error("x must ber a var") end
local f0, fvarname, fexpr = f[0], f[1][1], f[2]
if f0 ~= "\\" then error("f must be a lambda form") end
context:push(fvarname, a)
local result = fexpr:eval()
context:pop()
return result
end
-- ____ _ _
-- / ___|___ _ __ ___ _ __ _ __ ___| |__ ___ _ __ ___(_) ___ _ __
-- | | / _ \| '_ ` _ \| '_ \| '__/ _ \ '_ \ / _ \ '_ \/ __| |/ _ \| '_ \
-- | |__| (_) | | | | | | |_) | | | __/ | | | __/ | | \__ \ | (_) | | | |
-- \____\___/|_| |_| |_| .__/|_| \___|_| |_|\___|_| |_|___/_|\___/|_| |_|
-- |_|
-- «comprehension» (to ".comprehension")
-- (find-dn5 "gab-tests.lua" "comprehension-1")
-- Inspired by:
-- (find-es "haskell" "comprehension")
-- http://www.haskell.org/tutorial/goodies.html#tut-list-comps
-- http://www.haskell.org/onlinereport/exps.html#list-comprehensions
-- http://www.haskell.org/haskellwiki/List_comprehension
-- http://en.wikipedia.org/wiki/List_comprehension
Subset = function (...) return Expr {[0]="Su", ...} end
Setof = function (...) return Expr {[0]="So", ...} end
Gen = function (var, set) return Expr {[0]="<-", var, set} end
_evalcompr_ = function (es, collect, i)
local e, op, e1, e2 = es[i], es[i][0], es[i][1], es[i][2]
if i == #es then collect(e:eval()); return end
if op == "<-" then -- generator
if e1[0] ~= "v" then error("Not a var") end
local varname = e1[1]
local set = e2:seval()
for _,value in ipairs(set) do
context:push(varname, value)
_evalcompr_(es, collect, i+1)
context:pop()
end
else -- filter
if not e:beval() then return end -- on F: abort
_evalcompr_(es, collect, i+1) -- on T: continue
end
end
_evalcompr = function (e)
local results = Set()
local collect = function (e) table.insert(results, e) end
_evalcompr_(e, collect, 1)
return results
end
-- _ _
-- __ _ _ __(_) __| |___
-- / _` | '__| |/ _` / __|
-- | (_| | | | | (_| \__ \
-- \__, |_| |_|\__,_|___/
-- |___/
--
-- «grids» (to ".grids")
-- Some functions to create tables.
-- Too many things are hardcoded at the moment.
--
withdef = function (name, def, expr)
defs:push(name, def)
local result = expr:eval()
defs:pop()
return result
end
cell = function (x, y)
if y == 1 then return Cols[x] end
if x == 1 then return Ps[y-1] end
return withdef("P", Lambda("k", Ps[y-1]), Cols[x])
end
column = function (x)
local C = Rect {w=0}
for y=1,#Ps+1 do C:set(y, cell(x, y):infix()) end
return C
end
columns = function (x1, x2)
x1 = x1 or 1
x2 = x2 or #Cols
local result = column(x1)
for x=x1+1,x2 do result = result.." "..column(x) end
return result
end
efold = function (f, a, ...)
local result = a
for _,b in ipairs {...} do result = f(result, b) end
return result
end
Ors = function (...) return efold(Or, ...) end
Ands = function (...) return efold(And, ...) end
P = Def "P"
P1, P2, P3, P4 = App(P, _1), App(P, _2), App(P, _3), App(P, _4)
defs.E_1 = Ors ( P2, P3 )
defs.E_2 = Ors (P1, P2, P3, P4)
defs.E_3 = Ands( P2, P3 )
defs.E_4 = Ands(P1, P2, P3, P4)
defs["E'_1"] = Or (Ors (P1, P2, P3), Ors (P2, P3, P4))
defs["E'_2"] = And(Ors (P1, P2, P3), Ors (P2, P3, P4))
defs["E'_3"] = Or (Ands(P1, P2, P3), Ands(P2, P3, P4))
defs["E'_4"] = And(Ands(P1, P2, P3), Ands(P2, P3, P4))
P123or = Ors (P1, P2, P3)
P123and = Ands(P1, P2, P3)
P234or = Ors (P2, P3, P4)
P234and = Ands(P2, P3, P4)
P123or = Ex(k, Set(_1, _2, _3), App(P, k))
P123and = Fa(k, Set(_1, _2, _3), App(P, k))
P234or = Ex(k, Set(_2, _3, _4), App(P, k))
P234and = Fa(k, Set(_2, _3, _4), App(P, k))
defs["E'_1"] = Or (P123or, P234or)
defs["E'_2"] = And(P123or, P234or)
defs["E'_3"] = Or (P123and, P234and)
defs["E'_4"] = And(P123and, P234and)
Cols = {
App(P, k),
P1, P2, P3, P4,
Def("E_1"), Def("E_2"), Def("E_3"), Def("E_4"),
}
Ps = {
Ge( k, _2),
Ge( _2*k, _2),
Eq( k, _1),
Lt( k, _1),
Neq( k, _2),
Neq( k, _3),
And(Neq(k, _2), Neq(k, _3)),
Neq( k, _0),
}
-- _ _
-- ___ | | __| | _ __ __ _ _ __ ___ ___ _ __
-- / _ \| |/ _` | | '_ \ / _` | '__/ __|/ _ \ '__|
-- | (_) | | (_| | | |_) | (_| | | \__ \ __/ |
-- \___/|_|\__,_| | .__/ \__,_|_| |___/\___|_|
-- |_|
-- Moved to:
-- (find-dn5 "gab-oldparser.lua")
-- «old-parser» (to ".old-parser")
-- «precedence-table» (to ".precedence-table")
-- «precedence» (to ".precedence")
-- «recursive-descent» (to ".recursive-descent")
-- «parser-grammar» (to ".parser-grammar")
-- _
-- | |_ __ ___ __ _ _ __ __ _ _ __ ___ ___ _ __
-- | | '_ \ / _ \/ _` | | '_ \ / _` | '__/ __|/ _ \ '__|
-- | | |_) | __/ (_| | | |_) | (_| | | \__ \ __/ |
-- |_| .__/ \___|\__, | | .__/ \__,_|_| |___/\___|_|
-- |_| |___/ |_|
--
-- «lpeg-parser» (to ".lpeg-parser")
-- A reimplementation in LPEG of the recursive-descent parser
if userocks
then userocks(); loadlpeg() -- (find-angg "LUA/lua50init.lua" "loadlpeg")
else require "lpeg" -- (find-vldifile "liblua5.1-lpeg2.list")
end
-- require "lpeg"
P = lpeg.P
V = lpeg.V
Cc = lpeg.Cc
Ct = lpeg.Ct
Cb = lpeg.Cb
Cg = lpeg.Cg
local ispattern = function (o)
return getmetatable(o) == getmetatable(lpeg.P"")
end
local set = function (name, o)
if ispattern(o) then return o:Cg(name) else return lpeg.Cc(o):Cg(name) end
end
local get = function (name) return lpeg.Cb(name) end
local group = function (cmds) return lpeg.Cg(cmds) end
local applys = function (e, T) return T[#T](e, unpack(T, 1, #T-1)) end
ops = {}
newbinop = function (l, t, r, str)
for op in str:gmatch("[^ ]+") do ops[op] = {l=l, t=t, r=r} end
end
newbinop(10, 11, 12, "->")
newbinop(12, 13, 14, "or")
newbinop(14, 15, 16, "&")
newbinop(18, 17, 18, "== <= >= < > != <-")
newbinop(18, 19, 20, "+ -")
newbinop(20, 21, 22, "* /")
above = function (lop, rop) return lop == "" or ops[lop].r < ops[rop].t end
is_binop = function (subj, pos, c) if ops[c] then return true, c end end
is_under = function (subj, pos, lop, op)
if above(lop, op) then return true, op end
end
pack_num = function (str) return Num(tonumber(str)) end
pack_var = function (str) return Var(str) end
pack_bin = function (e1, op, e2) return Expr {[0]=op, e1, e2} end
pack_app = function (e1, e2) return App(e1, e2) end
pack_tuple = function (L) return #L==1 and L[1] or Tuple(unpack(L)) end
pack_qlexpr = function (ql, a, b) -- quantifiers and lambda
if ql == "Fa" then return Fa(a, b) end
if ql == "Ex" then return Ex(a, b) end
if ql == "\\" then return Lambda(a, b) end
end
-- Sets come in four flavors:
-- {e1<-e2 | P, Q} => Subset(e1<-e2, P, Q, e1}
-- {e | a<-A, b<-B} => Setof(a<-A, b<-B, e}
-- {a, b, c} => Set(a, b, c)
-- {} => Set()
pack_subset = function (e, L)
table.insert(L, e[1])
return Subset(e, unpack(L))
end
pack_setof = function (e, L)
table.insert(L, e)
return Setof(unpack(L))
end
pack_set = function (a, b, c)
if b == "|" and a[0] == "<-" then return pack_subset(a, c) end
if b == "|" and a[0] ~= "<-" then return pack_setof (a, c) end
if a == "" or a == nil then return Set() end
return Set(a, unpack(b or {}))
end
sp = lpeg.S" \t\n"^0
sP = function (str) return sp * P(str) end
Expr_grammar = {
"Expr", -- initial rule name
Alpha = lpeg.R"AZ" + lpeg.R"az",
Alphanum = lpeg.R"AZ" + lpeg.R"az" + lpeg.R"09" + P"_",
Num = sp * (lpeg.R"09"^1):C() / pack_num,
Var = sp * (V"Alpha" * V"Alphanum"^0):C() / pack_var,
--
Commaexprs = (sP"," * V"Expr")^0,
Exprs = V"Expr" * V"Commaexprs",
Parenexpr = (sP"(" * V"Exprs" * sP")"):Ct() / pack_tuple,
Setexpr = sP"{" *
( sP"}" * Cc""
+ V"Expr" *
( sP"}"
+ V"Commaexprs":Ct() * sP"}"
+ sp * P"|":C() * V"Exprs":Ct() * sP"}")) / pack_set,
--
Ql = sp * (P"Fa" + P"Ex" + P"\\"):C(),
Qlexpr = V"Ql" * V"Expr" * sP"." * V"Expr" / pack_qlexpr,
--
Binop = sp * ((lpeg.P(2):Cmt(is_binop) +
lpeg.P(1):Cmt(is_binop))),
Binop_under = (get"lop" * V"Binop"):Cmt(is_under),
Binop_setlop = set("lop", V"Binop_under") * get("lop"),
--
Expr_wos = V"Parenexpr"
+ V"Setexpr"
+ V"Qlexpr"
+ V"Num"
+ V"Var",
Complement = group(V"Binop_setlop" * V"Expr_under" * Cc(pack_bin)):Ct()
+ (V"Parenexpr" * Cc(pack_app)):Ct(),
Expr_under = (V"Expr_wos" * V"Complement"^0):Cf(applys),
Expr = group(set("lop", "") * V"Expr_under"),
}
Expr_pattern = lpeg.P(Expr_grammar)
lpeg.prmatch = function (patt, ...) PP(patt:match(...)) end
etest = function (str)
local e = Expr_pattern:match(str)
print(e)
print(e:torect())
end
eteste = function (str)
local e = Expr_pattern:match(str)
print(e)
print(e:torect())
print(e:eval())
end
-- «pe» (to ".pe")
-- pe: parse expression
-- pev: parse expression, evaluate, print all
-- pep: parse expression and print (do not evaluate)
pe = function (str) return Expr_pattern:match(str) end
pep = function (str) return pe(str):print():rprint() end
pev = function (str) return pe(str):print():rprint():eval():print() end
-- __ __ _ _
-- | \/ | ___ __| | __ _| |
-- | |\/| |/ _ \ / _` |/ _` | |
-- | | | | (_) | (_| | (_| | |
-- |_| |_|\___/ \__,_|\__,_|_|
--
-- «modal» (to ".modal")
-- (find-angg "LUA/canvas3.lua")
-- (find-angg "LUA/canvas3.lua" "ZDag-functions")
-- It should be easy to make the logic of the calculator more
-- flexible... at present it is boolean, two-valued, with the same
-- truth values as the underlying Lua.
Vee_ = function (s)
local a, b, c = s:sub(1,1), s:sub(2,2), s:sub(3,3)
return Rect {w=3, a.." "..b, " "..c}
end
Vee = function (s)
return Expr {[0]="Mo", Vee_(s)}
end
-- (find-angg "LUA/canvas3.lua" "ZDag-functions")
-- A "shape" is a string made of digits, newlines, and spaces.
-- A "short" is a string made of "0"s and "1"s.
-- For example:
-- reh_shape = " 1\n" ..
-- "2 3\n" ..
-- "4"
-- and "0101" is a short that represents an open set on Reh
-- in a compact form.
cton = function (c) return tonumber(c, 36) end
intoshape = function (shape, short)
local f = function (c) return short:sub(cton(c), cton(c)) end
return (shape:gsub("(%w)", f))
end
shapetoarrows = function (shape)
local lines = splitlines(shape)
local arrows = {}
local registerbpm = function (v1, v2)
if v1 and v2 then table.insert(arrows, {v1, v2}) end
end
for y=1,#lines-1 do
for x=1,#lines[y] do
local c = cton(lines[y ]:sub(x, x ))
local sw = cton(lines[y+1]:sub(x-1, x-1))
local s = cton(lines[y+1]:sub(x, x ))
local se = cton(lines[y+1]:sub(x+1, x+1))
registerbpm(c, sw) -- is southwest a black pawn's move?
registerbpm(c, s) -- is south a black pawn's move?
registerbpm(c, se) -- is southeast a black pawn's move?
end
end
return arrows
end
shapetocoords = function (shape)
local lines = splitlines(shape)
local coords = {}
for y=1,#lines do
for x=1,#lines[y] do
local c = cton(lines[y]:sub(x, x))
if c then coords[c] = {x, y} end
end
end
return coords
end
-- This is just a library.
print("Loading: gab.lua")
io.stdout:setvbuf("no") -- (find-es "lua5" "setvbuf")
-- Local Variables:
-- coding: raw-text-unix
-- ee-anchor-format: "«%s»"
-- End: