quox/tests/Tests/Equal.idr

397 lines
15 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")),
("id", mkDef Any (Arr One (FT "A") (FT "A")) (["x"] :\\ BVT 0)),
("eq-ab", mkAbstract Zero $ Eq0 (TYPE 0) (FT "A") (FT "B"))]
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 #""s{t,…}" for term substs; "sp,…›" for dim substs"#,
note #""0=1 ⊢ 𝒥" means that 𝒥 holds in an inconsistent dim context"#,
"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 #""𝐴𝐵" for (1·𝐴)𝐵"#,
note #""𝐴𝐵" for (0·𝐴)𝐵"#,
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,
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,
testEq "A ⊸ B = A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
equalT [<] (TYPE 0) tm tm,
testEq "A ⊸ B <: A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
subT [<] (TYPE 0) tm tm,
note "incompatible quantities",
testNeq "★₀ ⊸ ★₀ ≠ ★₀ ⇾ ★₁" $
let tm1 = Arr Zero (TYPE 0) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 1) in
equalT [<] (TYPE 2) tm1 tm2,
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,
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 "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},
note "[todo] should π ≤ ρ ⊢ (ρ·A) → B <: (π·A) → B?"
],
"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 and uip" :-
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)""#,
note "binds before ∥ are globals, after it are BVs",
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},
testEq "∥ x : [(a ≡ a' : A) ∷ Type 0], y : [ditto] ⊢ x = y" $
let ty : forall n. Term Three 0 n
:= E (Eq0 (FT "A") (FT "a") (FT "a'") :# TYPE 0) in
equalE [< ty, ty] (BV 0) (BV 1) {n = 2},
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("EE", mkDef zero (TYPE 0) (FT "E"))]} $
equalE [< FT "EE", FT "EE"] (BV 0) (BV 1) {n = 2},
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("EE", mkDef zero (TYPE 0) (FT "E"))]} $
equalE [< FT "EE", FT "E"] (BV 0) (BV 1) {n = 2},
testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
equalE [< FT "E", FT "E"] (BV 0) (BV 1) {n = 2},
testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
let ty : forall n. Term Three 0 n
:= Sig "_" (FT "E") $ TUnused $ FT "E" in
equalE [< ty, ty] (BV 0) (BV 1) {n = 2},
testEq "E ≔ a ≡ a' : A, F ≔ E × E ∥ x : F, y : F ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("W", mkDef zero (TYPE 0) (FT "E" `And` FT "E"))]} $
equalE [< FT "W", FT "W"] (BV 0) (BV 1) {n = 2}
],
"term closure" :- [
testEq "[#0]{} = [#0] : A" $
equalT [< FT "A"] (FT "A") {n = 1}
(CloT (BVT 0) id)
(BVT 0),
testEq "[#0]{a} = [a] : A" $
equalT [<] (FT "A")
(CloT (BVT 0) (F "a" ::: id))
(FT "a"),
testEq "[#0]{a,b} = [a] : A" $
equalT [<] (FT "A")
(CloT (BVT 0) (F "a" ::: F "b" ::: id))
(FT "a"),
testEq "[#1]{a,b} = [b] : A" $
equalT [<] (FT "A")
(CloT (BVT 1) (F "a" ::: F "b" ::: id))
(FT "b"),
testEq "(λy. [#1]){a} = λy. [a] : B ⇾ 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. [#1]){a} = λy. [a] : B ⇾ A (TUsed)" $
equalT [<] (Arr Zero (FT "B") (FT "A"))
(CloT (["y"] :\\ BVT 1) (F "a" ::: id))
(["y"] :\\ FT "a")
],
"term d-closure" :- [
testEq "★₀‹𝟎› = ★₀ : ★₁" $
equalT {d = 1} [<] (TYPE 1) (DCloT (TYPE 0) (K Zero ::: id)) (TYPE 0),
testEq "(λᴰ i ⇒ a)𝟎 = (λᴰ i ⇒ a) : (a ≡ a : A)" $
equalT {d = 1} [<]
(Eq0 (FT "A") (FT "a") (FT "a"))
(DCloT (["i"] :\\% FT "a") (K Zero ::: id))
(["i"] :\\% FT "a"),
note "it is hard to think of well-typed terms with big dctxs"
],
"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 : ★₁ ≔ ★₀ ⊢ [A] = ★₀" {globals = au_bu} $
equalT [<] (TYPE 1) (FT "A") (TYPE 0),
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"),
note "(A and B in different universes)",
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" :- [
testEq "#0 = #0" $
equalE [< TYPE 0] (BV 0) (BV 0) {n = 1},
testEq "#0 <: #0" $
subE [< TYPE 0] (BV 0) (BV 0) {n = 1},
testNeq "#0 ≠ #1" $
equalE [< TYPE 0, TYPE 0] (BV 0) (BV 1) {n = 2},
testNeq "#0 ≮: #1" $
subE [< TYPE 0, TYPE 0] (BV 0) (BV 1) {n = 2},
testEq "0=1 ⊢ #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"),
note "id : A ⊸ A ≔ λ x ⇒ [x]",
testEq "id [a] = a" $ equalE [<] (F "id" :@ FT "a") (F "a"),
testEq "id [a] <: a" $ subE [<] (F "id" :@ FT "a") (F "a")
],
todo "dim application",
"annotation" :- [
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = [f] ∷ A ⊸ A" $
equalE [<]
((["x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(FT "f" :# Arr One (FT "A") (FT "A")),
testEq "[f] ∷ A ⊸ A = f" $
equalE [<] (FT "f" :# Arr One (FT "A") (FT "A")) (F "f"),
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = f" $
equalE [<]
((["x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(F "f")
],
"elim closure" :- [
testEq "#0{a} = a" $
equalE [<] (CloE (BV 0) (F "a" ::: id)) (F "a"),
testEq "#1{a} = #0" $
equalE [< FT "A"] (CloE (BV 1) (F "a" ::: id)) (BV 0) {n = 1}
],
"elim d-closure" :- [
note "0·eq-ab : (A ≡ B : ★₀)",
testEq "(eq-ab #0)𝟎 = eq-ab 𝟎" $
equalE {d = 1} [<]
(DCloE (F "eq-ab" :% BV 0) (K Zero ::: id))
(F "eq-ab" :% K Zero),
testEq "(eq-ab #0)𝟎 = A" $
equalE {d = 1} [<] (DCloE (F "eq-ab" :% BV 0) (K Zero ::: id)) (F "A"),
testEq "(eq-ab #0)𝟏 = B" $
equalE {d = 1} [<] (DCloE (F "eq-ab" :% BV 0) (K One ::: id)) (F "B"),
testNeq "(eq-ab #0)𝟏 ≠ A" $
equalE {d = 1} [<] (DCloE (F "eq-ab" :% BV 0) (K One ::: id)) (F "A"),
testEq "(eq-ab #0)#0,𝟎 = (eq-ab #0)" $
equalE {d = 2} [<]
(DCloE (F "eq-ab" :% BV 0) (BV 0 ::: K Zero ::: id))
(F "eq-ab" :% BV 0),
testNeq "(eq-ab #0)𝟎 ≠ (eq-ab 𝟎)" $
equalE {d = 2} [<]
(DCloE (F "eq-ab" :% BV 0) (BV 0 ::: K Zero ::: id))
(F "eq-ab" :% K Zero),
testEq "#0𝟎 = #0 # term and dim vars distinct" $
equalE {d = 1, n = 1} [< FT "A"] (DCloE (BV 0) (K Zero ::: id)) (BV 0),
testEq "a𝟎 = a" $
equalE {d = 1} [<] (DCloE (F "a") (K Zero ::: id)) (F "a"),
testEq "(f [a])𝟎 = f𝟎 [a]𝟎" $
let th = (K Zero ::: id) in
equalE {d = 1} [<]
(DCloE (F "f" :@ FT "a") th)
(DCloE (F "f") th :@ DCloT (FT "a") th)
],
"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"
]
]