Warning: this is an htmlized version!
The original is here, and
the conversion rules are here.
-- The latest upstream version of this can be found at:
--   http://angg.twu.net/dednat5/gab-tests.lua
--   http://angg.twu.net/dednat5/gab-tests.lua.html
--                    (find-dn5 "gab-tests.lua")
--
-- This file tests the functions defined in:
--   http://angg.twu.net/dednat5/gab.lua
--   http://angg.twu.net/dednat5/gab.lua.html
--                    (find-dn5 "gab.lua")
--
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2012may15
-- License: GPL3

-- «.intro»		(to "intro")
-- «.infix-algorithm»	(to "infix-algorithm")
-- «.infix-1»		(to "infix-1")
-- «.rect-0»		(to "rect-0")
-- «.rect-1»		(to "rect-1")
-- «.prints»		(to "prints")
-- «.internal-vs-infix»	(to "internal-vs-infix")
-- «.eval-basic»	(to "eval-basic")
-- «.eval-basic-2»	(to "eval-basic-2")
-- «.infix-pyramids»	(to "infix-pyramids")
-- «.context-0»		(to "context-0")
-- «.context-1»		(to "context-1")
-- «.app-lambda-1»	(to "app-lambda-1")
-- «.app-lambda-def-1»	(to "app-lambda-def-1")
-- «.comprehension-1»	(to "comprehension-1")
-- «.grids-1»		(to "grids-1")
-- «.parse-1»		(to "parse-1")
-- «.parse-2»		(to "parse-2")
-- «.parse-3»		(to "parse-3")
-- «.modal»		(to "modal")
-- «.parse-lpeg»	(to "parse-lpeg")


-- «intro»  (to ".intro")
-- Consider a quantified expression, like this one (and note that to
-- keep everything in ascii we write "Fa" for "for all" and "Ex" for
-- "exists"):
--
--   Fa x in {2, 3, 4}. Ex y in {3, 4, 5}. 2*x <= y+3
--
-- using the constructors defined in this library we can create a
-- tree-ish repreresentation of that expression in memory with:
--
--   x = Var "x"
--   y = Var "y"
--   _2, _3, _4, _5 = Num(2), Num(3), Num(4), Num(5)
--   comparison    = Le(_2*x, y+_3)
--   ex_expression = Ex(y, Set(_3, _4, _5), comparison)
--   fa_expression = Fa(x, Set(_2, _3, _4), ex_expression)
--
-- All the subexpressions of "fa_expression", i.e., the ones marked
-- below (even numbers!),
--
--   Fa x in {2, 3, 4}. Ex y in {3, 4, 5}. 2*x <= y+3
--      -     -  -  -      -     -  -  -   - -    - -
--           \-------/          \-------/  \-/    \-/
--                                         \--------/
--                      \---------------------------/
--   \----------------------------------------------/
--
-- are represented internally as objects of the class "Expr", and so
-- they know how to respond to all the methods for Expr objects - most
-- importantly, they have a special "__tostring" that prints them in
-- infix notation using only the parentheses that are essential, and
-- they have an "eval". Here is a quick test:


--[[
-- «infix-algorithm»  (to ".infix-algorithm")
--
-- The algorith for displaying infix expressions
-- =============================================
-- The code for displaying expressions in infix notation was inspired
-- by something that I learned in the code for Andrej Bauer's PLZoo:
--
--    (find-es "ml" "plzoo")
--    (find-es "ml" "levy")
--    (find-levyfile "syntax.ml" "string_of_expr")
--    http://andrej.com/plzoo/
--    http://andrej.com/plzoo/html/miniml.html
--      ^ look for "string_of_expr"
--
-- The basic idea is that each fully parenthesised expression like
--
--   22 + (33 * ((44 - 55) - (66 - 77)))
--
-- has a unique representation with minimal parenthesisation, which in
-- the case of the expression above is:
--
--   22 +  33 *  (44 - 55  - (66 - 77))
--
-- to discover where those essential parentheses are, let's mark them
-- in the edges of the representation of the expression as a tree:
--
--          +
--        /   \
--     22       *
--            /   \()
--         33       -
--                /   \()
--              -       -
--            /   \   /   \
--         44     55 66     77
--
-- If we write certain numbers at the top and the bottom of each
-- connective, the rule becomes evident. Each edge connects a bottom
-- number (above) to a top number (below). When b >= t, use
-- parentheses.
--                ___
--               / 7 \
--              /  +  \
--             |_6___7_|
--           /           \
--        22              ___   
--                       / 8 \  
--                      /  *  \ 
--                     |_7___8_|
--                   /           \()
--                33              ___                   
--                               / 7 \          
--                              /  -  \         
--                             |_6___7_|        
--                           /           \()      
--                        ___             ___   
--                       / 7 \           / 7 \  
--                      /  -  \         /  -  \ 
--                     |_6___7_|       |_6___7_|
--                   /           \   /           \
--                44            55  66             77
--]]


-- (find-angg ".emacs" "to-shadow")
-- (find-eapropos "shadow")

--[[
-- «infix-1»  (to ".infix-1")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
x = Var "x"
y = Var "y"
_2, _3, _4, _5 = Num(2), Num(3), Num(4), Num(5)
comparison    = Le(_2*x, y+_3)
ex_expression = Ex(y, Set(_3, _4, _5), comparison)
fa_expression = Fa(x, Set(_2, _3, _4), ex_expression)
ex_expression:print()   -->                    Ex y in {3, 4, 5}. 2*x <= y+3
fa_expression:print()   --> Fa x in {2, 3, 4}. Ex y in {3, 4, 5}. 2*x <= y+3
fa_expression:eval():print()  --> T

x:Whens(Set(_2, _3, _4), ex_expression)




--[[
-- «rect-0»  (to ".rect-0")
-- Low-level tests for Rect
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
r = Rect {w=3, "a", "ab", "abc"}
= r
= r..r
= r.."foo"
= "--"..r
= rectconcat("+", {2, 3})
= rectconcat("+", {2, 34, 5})
= r:under_("Fa")..r:under(".")
= r:under_("Fa")
= r:under(".")


-- High-level tests for Rect
-- «rect-1»  (to ".rect-1")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
= (_2 * _3 + _4 * - _5):torect()
comparison    = Le(_2*x, y+_3)
ex_expression = Ex(y, Set(_3, _4, _5), comparison)
fa_expression = Fa(x, Set(_2, _3, _4), ex_expression)

=        fa_expression
= tolisp(fa_expression)
      PP(fa_expression)
=        fa_expression:torect()

= fa_expression

e = fa_expression
= "eval( "..e:torect().." ) --> "..e:eval():torect()

-- Output:
--   eval( Fa_.________.                      ) --> T
--         |  |        |                     
--         x  {}_.__.  Ex_.________.         
--            |  |  |  |  |        |         
--            2  3  4  y  {}_.__.  <=____.   
--                        |  |  |  |     |   
--                        3  4  5  *__.  +__.
--                                 |  |  |  |
--                                 2  x  y  3





--[[
-- «prints»  (to ".prints")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- Some ways of printing an expression and its result
A = Set(_2, _3, _5)
B = Set(_2, _3)
expr = Le(a*a, Num(10))
a:Whens(A, expr)
a:Whens(B, expr)
Fa(a, A, expr):peval()
Fa(a, B, expr):peval()

= _2 * _3 + _4 * _5
 (_2 * _3 + _4 * _5):peval()
= (_2 * _3):Dbg() + (_4 * _5):Dbg()
 ((_2 * _3):Dbg() + (_4 * _5):Dbg()):peval()


--[[
-- «internal-vs-infix»  (to ".internal-vs-infix")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- The internal representation vs. the infix representation
PP(2)
PP(_2, otype(_2))
=  _2 + _3
PP(_2 + _3)
  (_2 + _3):lprint()


--[[
-- «eval-basic»  (to ".eval-basic")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- Basic evaluation
=   _2 +   _3
=  (_2 +   _3):eval()
=  (_2 + - _3):eval()
PP((_2 + - _3):eval())
= Le(_2, _3)
= Le(_2, _3):eval()
= Ge(_2, _3):eval()


--[[
-- «eval-basic-2»  (to ".eval-basic-2")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
=  Ge(a+(b*(c-d)), a)
=  Ge(a, a+(b*(c-d)))
PP(Ge(a, a+(b*(c-d))))
  (Ge(a, a+(b*(c-d)))):lprint()
= Set(a*a, b, c, Tuple(a, b))
 (Set(a*a, b, c, Tuple(a, b))):lprint()
= Fa(a, Set(b, c), Le(a, d))
 (Fa(a, Set(b, c), Le(a, d))):lprint()


e   = Le(_2*a, b+_3)
ee  = Ex(b, Set(_3, _4, _5), e)
eee = Fa(a, Set(_2, _3, _4), ee)
= And(ee, ee)
= And(e, eee)

= _2:eval()
= _2 + _3
= (_2 + _3):eval()
= (_2 * - _3):eval()
PP(_2)
PP(- _3)
PP(   _3 :neval())
PP((- _3):neval())



--[[
-- «infix-pyramids»  (to ".infix-pyramids")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- Tests for the parenthesisation algorithm (using "pyramids")
= And(And(a, b), And(c, d))
= Or (Or (a, b), Or (c, d))
= Imp(Imp(a, b), Imp(c, d))
pyr  = function (F) print(F(F(a, b), F(c, d))) end
pyr2 = function (F, G) print(F(G(a, b), G(c, d)), G(F(a, b), F(c, d))) end
pyrs = function (T)
    for i=1,#T-1 do pyr(T[i]); pyr2(T[i], T[i+1]) end
    pyr(T[#T])
  end
pyr(And)
pyr(Or)
pyr(Imp)
pyr2(And, Or)
pyr2(And, Not)
pyrs {
  Unm, Mul, Div, Add, Sub,
  Eq, Lt, Le, Ge, Gt,
  Not, And, Or, Imp,
}


--[[
-- «context-0»  (to ".context-0")
-- This is obsolete, see:
-- (find-dn5 "gab.lua")
-- (find-dn5 "gab.lua" "contexts-test")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- Printing the context
comparison    = Le(_2*x, y+_3)
comparison    = Le(_2*x, y+_3):Dbg()
ex_expression = Ex(y, Set(_3, _4, _5), comparison)
ex_expression = Ex(y, Set(_3, _4, _5), comparison):Dbg()
fa_expression = Fa(x, Set(_2, _3, _4), ex_expression)
= fa_expression
fa_expression:peval()

-- [x=2 y=3]                             2*x <= y+3  -->  T
-- [x=2 y=4]                             2*x <= y+3  -->  T
-- [x=2 y=5]                             2*x <= y+3  -->  T
-- [x=2]              Ex y in {3, 4, 5}. 2*x <= y+3  -->  T
-- [x=3 y=3]                             2*x <= y+3  -->  T
-- [x=3 y=4]                             2*x <= y+3  -->  T
-- [x=3 y=5]                             2*x <= y+3  -->  T
-- [x=3]              Ex y in {3, 4, 5}. 2*x <= y+3  -->  T
-- [x=4 y=3]                             2*x <= y+3  -->  F
-- [x=4 y=4]                             2*x <= y+3  -->  F
-- [x=4 y=5]                             2*x <= y+3  -->  T
-- [x=4]              Ex y in {3, 4, 5}. 2*x <= y+3  -->  T
-- Fa x in {2, 3, 4}. Ex y in {3, 4, 5}. 2*x <= y+3  -->  T



--[[
-- «context-1»  (to ".context-1")
-- Basic tests for contexts
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
-- dofile "gab.lua"
c = newcontext {x=22, y=33}
c:print()
c:push("z", 44):print()
c:push("x", 99):print()
c:push("y", nil):print()
PP(c)
c:pop():print()
c:pop():print()
c:pop():print()
c:pop():print()   -- error



--[[
-- «app-lambda-1»  (to ".app-lambda-1")
-- Basic tests for lambda and app
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
f = Lambda(x, x + _2)
f7 = App(f, _3 + _4)
f:print()
f:peval()
f7:print()
f7:lprint()
f7:rprint()
f7:peval()

-- «app-lambda-def-1»  (to ".app-lambda-def-1")
P = Def "P"
defs.P = Lambda(x, Le(x, _2))
App(P, _1):peval()
App(P, _2):peval()
App(P, _3):peval()



-- «comprehension-1»  (to ".comprehension-1")
-- (find-dn5 "gab.lua" "comprehension")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
_10 = Num(10)
A = Set(_1, _2, _3)
B = Setof(Gen(x, A), Gen(y, A), Filt(Le(x, y)), Collect(_10*x+y))
C = Setof(Gen(x, A), Gen(y, A), Filt(Le(x, y)), Collect(Tuple(x, y)))
D = Subset(Gen(x, A), Filt(Neq(x, _2)), Collect(x))
    Setof(Gen(x, A), Collect(Tuple(x, x*x))):preval()
B:preval()
C:preval()
D:preval()



--[[
-- «grids-1»  (to ".grids-1")
-- Test the code for drawing tables
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
defs:vprint()
print(columns())

Cols = {
  App(P,  k),
  P1, P2, P3, P4,
  False,
  Def("E_4"), Def("E'_3"), Def("E_3"), Def("E_1"), Def("E'_2"), Def("E_2"),
  True,
}
Ps = {
   False,
   Ge(k, _4),
   Or(Eq(k, _1), Eq(k, _4)),
   Ge(k, _3),
   Or(Eq(k, _2), Eq(k, _3)),
   Ge(k, _2),
   True,
}
defs:vprint()
= columns()



-- «parse-1»  (to ".parse-1")
-- «parse-2»  (to ".parse-2")
-- (find-dn5file "gab.lua" "Expr.__index.infix =")
-- (find-dn5 "gab.lua" "Context")
-- (find-dn5 "gab.lua" "precedence")



--[[
-- «parse-3»  (to ".parse-3")
-- (find-dn5 "gab.lua" "precedence-table")
-- Parsing expressions (very preliminary)
-- (find-es "lua5" "lpeg-quickref")
-- (find-dn5 "gab.lua" "recursive-descent")
-- (find-dn5 "gab.lua" "recursive-descent" "pa_expr =")

* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
pparsee "2 * 3 + 4 * 5"
pparsee "Fa x in { 2 , 3 , 4 } . x * x < 10"
pparsee "Ex x in { 2 , 3 , 4 } . x * x < 10"
pparsee "Fa x in { } . x * x < 10"
pparsee "Ex x in { } . x * x < 10"

pparsee "{ 10 * x + y | x <- { 2 , 3 } , y <- { 3 , 4 } }"
pparsee "{ 10 * x + y | x <- { 2 , 3 } , y <- { 3 , 4 } , x < y }"
pparsee "{  ( x , y ) | x <- { 2 , 3 } , y <- { 3 , 4 } , x < y }"
pparsee "  \\ x . x + 2        "
pparsee "( \\ x . x + 2 )   3  "    -- here the "3" is not parsed
pparsee "( \\ x . x + 2 ) ( 3 )"

pparsee "( )"

pparsee "2 * 3"

pparse  "2 + 3 * 4 + 5 * 6 * 7 (eof)"
pparse  "2 * ( 3 * 4 + 5 * 6 ) + 7"

pparse  "2 in { 2 , 3 , 4 }"
pparse  "2 in { 2 | 3 , 4 }"
pparse  "2 in { 10 * x + y | x <- A , y <- B }"
pparsee "{ 10 * x + y | x <- { 2 , 3 } , y <- { 3 , 4 } }"
pparsee "{ 10 * x + y | x <- { 2 , 3 } , y <- { 3 , 4 } , x < y }"
pparse  "x <= 4"
pparse  "2 in { x <- A | x <= 4 }"
pparse  "{ x , y }"





--[[
-- «modal»  (to ".modal")
-- (find-dn5 "gab.lua" "modal")
-- (find-dn5file "gab.lua" "rectconcat =")
-- (find-dn5file "gab.lua" "op == \"Mo\"")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
sr = stringtorect
pp = function (f1, s1, f2, s2)
    PP(f1(s1))
    PP(f2(s2))
    print(f1(s1)..f2(s2)..","..f1(s1)..","..f2(s2))
  end
pp(sr, "abc\ndef", sr, " &")
pp(sr, "abc"     , sr, " &")

PP(sr"abc\ndef")
PP(sr"abc\nde")
PP(sr"abc\nde" .. sr" &")
PP(sr"abc\nde" .. sr" &\nfg")
PP(sr"abc\nde" .. sr"abc\nde")
PP(splitlines " &\nfg")


a = Vee_ "123"
b = Vee  "123"
= b
= And(b, b)
= And(b, b):tolisp()
= And(b, b):torect()
= And(_2, _3)
= b .. "!"
=  b:infix()
PP(b:infix())
= b:tolisp()
print(otype(b:infix()))
print(otype(b))
= b
= b[1].."abc"
= b[1].." bc"
= b[1].." & "
= b[1]..torect(" & ")
= b[1].."&"



--[[
-- «parse-lpeg»  (to ".parse-lpeg")
-- Suffixes on patterns:
--   Pat_c    is a pattern with exactly one capture
--   Pat_scp  is OptSpaces * Pat_c * lpeg.Cp()

* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "gab.lua"
--]]
etest "2 <= 3 + 4*5*6 & 7 < 8"
eteste "Fa a<-{2,3,4}. Ex b<-{2,3,4}. a*b>10"
eteste "Ex a<-{2,3,4}. Ex b<-{2,3,4}. a*b>10"

eteste "2*3+4*5"

etest "{1,2}"
etest "{1}"
etest "{}"
etest "{1|2}"
etest "{1|2,3}"
etest "{1<-2|3,4}"

eteste "    {2, 3, 4}        "
eteste "{a<-{2, 3, 4} | a<=3}"
eteste "Fa a<-{2,3,4}. Ex b<-{2,3,4}. a*b>10"
eteste "Ex a<-{2,3,4}. Ex b<-{2,3,4}. a*b>10"
eteste "Ex a<-{2,3,4}. Ex b<-{2,3,4}. a*b>10"
eteste "\\ a. 2+a*a"
eteste "(\\ a. a*a)(5)"

etest "2 <= 3 + 4*5*6 & 7 < 8"


eteste "2*3+4*5"
eteste "Fa x<-{2,3,4}. x*x<10"
eteste "Ex x<-{2,3,4}. x*x<10"
eteste "Fa x<-{}.x*x<10"
eteste "Ex x<-{}.x*x<10"

eteste "{10*x+y | x<-{2,3}, y<-{3,4}}"
eteste "{10*x+y |x <-{2,3} ,y<-{3,4} ,x<y}"
eteste "{(x,y) | x<-{2,3} ,y<-{3,4}, x<y}"
eteste "\\x.x+2"
eteste "(\\x.x+2)3"   -- here the "3" is not parsed
eteste "(\\x.x+2)(3)"

eteste "()"

eteste "2*3"

etest  "2+3*4+5*6*7 (eof)"
etest  "2*(3*4+5*6)+7"

etest  "2<-{2,3,4}"
etest  "2<-{2|3,4}"
etest  "2 in {10*x+y | x<-A ,y<-B}"
eteste "{10*x+y | x<-{2,3}, y<-{3,4}}"
eteste "{10*x+y | x<-{2,3} ,y<-{3,4} , x<y}"
eteste "{(x,y) | x<-{2,3} ,y<-{3,4} , x<y}"
etest  "x<=4"






-- Local Variables:
-- coding:             raw-text-unix
-- ee-anchor-format:   "«%s»"
-- End: