quox/tests/Tests/Equal.idr

293 lines
10 KiB
Idris
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Tests.Equal
import Quox.Equal
import Quox.Syntax.Qty.Three
import public TypingImpls
import TAP
0 M : Type -> Type
M = ReaderT (Definitions Three) (Either (Error Three))
defGlobals : Definitions Three
defGlobals = fromList
[("A", mkAbstract Zero $ TYPE 0),
("B", mkAbstract Zero $ TYPE 0),
("a", mkAbstract Any $ FT "A"),
("a'", mkAbstract Any $ FT "A"),
("b", mkAbstract Any $ FT "B"),
("f", mkAbstract Any $ Arr One (FT "A") (FT "A"))]
parameters (label : String) (act : Lazy (M ()))
{default defGlobals globals : Definitions Three}
testEq : Test
testEq = test label $ runReaderT globals act
testNeq : Test
testNeq = testThrows label (const True) $ runReaderT globals act
parameters {default 0 d, n : Nat}
{default new eqs : DimEq d}
(ctx : TContext Three d n)
subT : Term Three d n -> Term Three d n -> Term Three d n -> M ()
subT ty s t = Term.sub eqs ctx ty s t
equalT : Term Three d n -> Term Three d n -> Term Three d n -> M ()
equalT ty s t = Term.equal eqs ctx ty s t
subE : Elim Three d n -> Elim Three d n -> M ()
subE e f = Elim.sub eqs ctx e f
equalE : Elim Three d n -> Elim Three d n -> M ()
equalE e f = Elim.equal eqs ctx e f
export
tests : Test
tests = "equality & subtyping" :- [
note #""0=1𝒥" means that 𝒥 holds in an inconsistent dim context"#,
note #""s{…}" for term substs; "s" for dim substs"#,
"universes" :- [
testEq "★₀ ≡ ★₀" $
equalT [<] (TYPE 1) (TYPE 0) (TYPE 0),
testNeq "★₀ ≢ ★₁" $
equalT [<] (TYPE 2) (TYPE 0) (TYPE 1),
testNeq "★₁ ≢ ★₀" $
equalT [<] (TYPE 2) (TYPE 1) (TYPE 0),
testEq "★₀ <: ★₀" $
subT [<] (TYPE 1) (TYPE 0) (TYPE 0),
testEq "★₀ <: ★₁" $
subT [<] (TYPE 2) (TYPE 0) (TYPE 1),
testNeq "★₁ ≮: ★₀" $
subT [<] (TYPE 2) (TYPE 1) (TYPE 0)
],
"pi" :- [
note #""AB" for (1·A) → B"#,
note #""AB" for (0·A) → B"#,
testEq "A ⊸ B ≡ A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
equalT [<] (TYPE 0) tm tm,
testNeq "A ⇾ B ≢ A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
equalT [<] (TYPE 0) tm1 tm2,
testEq "0=1 ⊢ A ⇾ B ≢ A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
equalT [<] (TYPE 0) tm1 tm2 {eqs = ZeroIsOne},
testEq "A ⊸ B <: A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
subT [<] (TYPE 0) tm tm,
testNeq "A ⇾ B ≮: A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
subT [<] (TYPE 0) tm1 tm2,
testEq "★₀ ⇾ ★₀ ≡ ★₀ ⇾ ★₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
equalT [<] (TYPE 1) tm tm,
testEq "★₀ ⇾ ★₀ <: ★₀ ⇾ ★₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
subT [<] (TYPE 1) tm tm,
testNeq "★₁ ⊸ ★₀ ≢ ★₀ ⇾ ★₀" $
let tm1 = Arr Zero (TYPE 1) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 0) in
equalT [<] (TYPE 2) tm1 tm2,
testEq "★₁ ⊸ ★₀ <: ★₀ ⊸ ★₀" $
let tm1 = Arr One (TYPE 1) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 0) in
subT [<] (TYPE 2) tm1 tm2,
testNeq "★₀ ⊸ ★₀ ≢ ★₀ ⇾ ★₁" $
let tm1 = Arr Zero (TYPE 0) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 1) in
equalT [<] (TYPE 2) tm1 tm2,
testEq "★₀ ⊸ ★₀ <: ★₀ ⊸ ★₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT [<] (TYPE 2) tm1 tm2,
testEq "★₀ ⊸ ★₀ <: ★₀ ⊸ ★₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT [<] (TYPE 2) tm1 tm2
],
"lambda" :- [
testEq "λ x ⇒ [x] ≡ λ x ⇒ [x]" $
equalT [<] (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["x"] :\\ BVT 0),
testEq "λ x ⇒ [x] <: λ x ⇒ [x]" $
subT [<] (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["x"] :\\ BVT 0),
testEq "λ x ⇒ [x] ≡ λ y ⇒ [y]" $
equalT [<] (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["y"] :\\ BVT 0),
testEq "λ x ⇒ [x] <: λ y ⇒ [y]" $
equalT [<] (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["y"] :\\ BVT 0),
testNeq "λ x y ⇒ [x] ≢ λ x y ⇒ [y]" $
equalT [<] (Arr One (FT "A") $ Arr One (FT "A") (FT "A"))
(["x", "y"] :\\ BVT 1)
(["x", "y"] :\\ BVT 0),
testEq "λ x ⇒ [a] ≡ λ x ⇒ [a] (TUsed vs TUnused)" $
equalT [<] (Arr Zero (FT "B") (FT "A"))
(Lam "x" $ TUsed $ FT "a")
(Lam "x" $ TUnused $ FT "a"),
testEq "λ x ⇒ [f [x]] ≡ [f] (η)" $
equalT [<] (Arr One (FT "A") (FT "A"))
(["x"] :\\ E (F "f" :@ BVT 0))
(FT "f")
],
"eq type" :- [
testEq "(★₀ = ★₀ : ★₁) ≡ (★₀ = ★₀ : ★₁)" $
let tm = Eq0 (TYPE 1) (TYPE 0) (TYPE 0) in
equalT [<] (TYPE 2) tm tm,
testEq "A ≔ ★₁ ⊢ (★₀ = ★₀ : ★₁) ≡ (★₀ = ★₀ : A)"
{globals = fromList [("A", mkDef zero (TYPE 2) (TYPE 1))]} $
equalT [<] (TYPE 2)
(Eq0 (TYPE 1) (TYPE 0) (TYPE 0))
(Eq0 (FT "A") (TYPE 0) (TYPE 0))
],
"equalities" :-
let refl : Term q d n -> Term q d n -> Elim q d n
refl a x = (DLam "_" $ DUnused x) :# (Eq0 a x x)
in
[
note #""refl [A] x" is an abbreviation for "(λᴰi ⇒ x)(x ≡ x : A)""#,
testEq "refl [A] a ≡ refl [A] a" $
equalE [<] (refl (FT "A") (FT "a")) (refl (FT "A") (FT "a")),
testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ⊢ p ≡ q (free)"
{globals =
let def = mkAbstract Zero $ Eq0 (FT "A") (FT "a") (FT "a'") in
defGlobals `mergeLeft` fromList [("p", def), ("q", def)]} $
equalE [<] (F "p") (F "q"),
testEq "x : (a ≡ a' : A), y : (a ≡ a' : A) ⊢ x ≡ y (bound)" $
let ty : forall n. Term Three 0 n := Eq0 (FT "A") (FT "a") (FT "a'") in
equalE [< ty, ty] (BV 0) (BV 1) {n = 2}
],
"term closure" :- [
note "𝑖, 𝑗 for bound variables pointing outside of the current expr",
testEq "[𝑖]{} ≡ [𝑖]" $
equalT [< FT "A"] (FT "A") {n = 1}
(CloT (BVT 0) id)
(BVT 0),
testEq "[𝑖]{a/𝑖} ≡ [a]" $
equalT [<] (FT "A")
(CloT (BVT 0) (F "a" ::: id))
(FT "a"),
testEq "[𝑖]{a/𝑖,b/𝑗} ≡ [a]" $
equalT [<] (FT "A")
(CloT (BVT 0) (F "a" ::: F "b" ::: id))
(FT "a"),
testEq "(λy. [𝑖]){y/y, a/𝑖} ≡ λy. [a] (TUnused)" $
equalT [<] (Arr Zero (FT "B") (FT "A"))
(CloT (Lam "y" $ TUnused $ BVT 0) (F "a" ::: id))
(Lam "y" $ TUnused $ FT "a"),
testEq "(λy. [𝑖]){y/y, a/𝑖} ≡ λy. [a] (TUsed)" $
equalT [<] (Arr Zero (FT "B") (FT "A"))
(CloT (["y"] :\\ BVT 1) (F "a" ::: id))
(["y"] :\\ FT "a")
],
todo "term d-closure",
"free var" :-
let au_bu = fromList
[("A", mkDef Any (TYPE (U 1)) (TYPE (U 0))),
("B", mkDef Any (TYPE (U 1)) (TYPE (U 0)))]
au_ba = fromList
[("A", mkDef Any (TYPE (U 1)) (TYPE (U 0))),
("B", mkDef Any (TYPE (U 1)) (FT "A"))]
in [
testEq "A ≡ A" $
equalE [<] (F "A") (F "A"),
testNeq "A ≢ B" $
equalE [<] (F "A") (F "B"),
testEq "0=1 ⊢ A ≡ B" $
equalE {eqs = ZeroIsOne} [<] (F "A") (F "B"),
testEq "A : ★₁ ≔ ★₀ ⊢ A ≡ (★₀ ∷ ★₁)" {globals = au_bu} $
equalE [<] (F "A") (TYPE 0 :# TYPE 1),
testEq "A ≔ ★₀, B ≔ ★₀ ⊢ A ≡ B" {globals = au_bu} $
equalE [<] (F "A") (F "B"),
testEq "A ≔ ★₀, B ≔ A ⊢ A ≡ B" {globals = au_ba} $
equalE [<] (F "A") (F "B"),
testEq "A <: A" $
subE [<] (F "A") (F "A"),
testNeq "A ≮: B" $
subE [<] (F "A") (F "B"),
testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
{globals = fromList [("A", mkDef Any (TYPE 3) (TYPE 0)),
("B", mkDef Any (TYPE 3) (TYPE 2))]} $
subE [<] (F "A") (F "B"),
testEq "A : ★₁👈 ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
{globals = fromList [("A", mkDef Any (TYPE 1) (TYPE 0)),
("B", mkDef Any (TYPE 3) (TYPE 2))]} $
subE [<] (F "A") (F "B"),
testEq "0=1 ⊢ A <: B" $
subE [<] (F "A") (F "B") {eqs = ZeroIsOne}
],
"bound var" :- [
note "𝑖, 𝑗 for distinct bound variables",
testEq "𝑖𝑖" $
equalE [< TYPE 0] (BV 0) (BV 0) {n = 1},
testNeq "𝑖𝑗" $
equalE [< TYPE 0, TYPE 0] (BV 0) (BV 1) {n = 2},
testEq "0=1 ⊢ 𝑖𝑗" $
equalE [< TYPE 0, TYPE 0] (BV 0) (BV 1)
{n = 2, eqs = ZeroIsOne}
],
"application" :- [
testEq "f [a] ≡ f [a]" $
equalE [<] (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "f [a] <: f [a]" $
subE [<] (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a ≡ ([a ∷ A] ∷ A) (β)" $
equalE [<]
(((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(E (FT "a" :# FT "A") :# FT "A"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a ≡ a (βυ)" $
equalE [<]
(((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(F "a"),
testEq "(λ g ⇒ [g [a]] ∷ ⋯)) [f] ≡ (λ y ⇒ [f [y]] ∷ ⋯) [a] (β↘↙)" $
let a = FT "A"; a2a = (Arr One a a) in
equalE [<]
(((["g"] :\\ E (BV 0 :@ FT "a")) :# Arr One a2a a) :@ FT "f")
(((["y"] :\\ E (F "f" :@ BVT 0)) :# a2a) :@ FT "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a <: a" $
subE [<]
(((["x"] :\\ BVT 0) :# (Arr One (FT "A") (FT "A"))) :@ FT "a")
(F "a"),
testEq "id : A ⊸ A ≔ λ x ⇒ [x] ⊢ id [a] ≡ a"
{globals = defGlobals `mergeLeft` fromList
[("id", mkDef Any (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0))]} $
equalE [<] (F "id" :@ FT "a") (F "a")
],
todo "dim application",
todo "annotation",
todo "elim closure",
todo "elim d-closure",
"clashes" :- [
testNeq "★₀ ≢ ★₀ ⇾ ★₀" $
equalT [<] (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
testEq "0=1 ⊢ ★₀ ≡ ★₀ ⇾ ★₀" $
equalT [<] (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0))
{eqs = ZeroIsOne},
todo "others"
]
]