quox/tests/Tests/Equal.idr

575 lines
22 KiB
Idris
Raw Normal View History

2022-04-27 14:06:39 -04:00
module Tests.Equal
2023-02-11 12:15:50 -05:00
import Quox.Equal
2023-03-31 17:43:25 -04:00
import Quox.Typechecker
2023-02-11 12:15:50 -05:00
import public TypingImpls
2022-04-27 14:06:39 -04:00
import TAP
2023-03-31 17:43:25 -04:00
import Quox.EffExtra
2023-05-01 21:06:25 -04:00
import AstExtra
2022-04-27 14:06:39 -04:00
2023-04-01 13:16:43 -04:00
defGlobals : Definitions
2023-02-10 15:40:44 -05:00
defGlobals = fromList
2023-05-01 21:06:25 -04:00
[("A", ^mkPostulate gzero (^TYPE 0)),
("B", ^mkPostulate gzero (^TYPE 0)),
("a", ^mkPostulate gany (^FT "A")),
("a'", ^mkPostulate gany (^FT "A")),
("b", ^mkPostulate gany (^FT "B")),
("f", ^mkPostulate gany (^Arr One (^FT "A") (^FT "A"))),
("id", ^mkDef gany (^Arr One (^FT "A") (^FT "A")) (^LamY "x" (^BVT 0))),
("eq-AB", ^mkPostulate gzero (^Eq0 (^TYPE 0) (^FT "A") (^FT "B"))),
("two", ^mkDef gany (^Nat) (^Succ (^Succ (^Zero))))]
parameters (label : String) (act : Equal ())
2023-04-01 13:16:43 -04:00
{default defGlobals globals : Definitions}
testEq : Test
2023-05-01 21:06:25 -04:00
testEq = test label $ runEqual globals act
2022-04-27 14:06:39 -04:00
testNeq : Test
testNeq = testThrows label (const True) $ runTC globals act $> "()"
2022-04-27 14:06:39 -04:00
2023-05-01 21:06:25 -04:00
parameters (ctx : TyContext d n)
subT, equalT : Term d n -> Term d n -> Term d n -> TC ()
subT ty s t = lift $ Term.sub noLoc ctx ty s t
equalT ty s t = lift $ Term.equal noLoc ctx ty s t
equalTy : Term d n -> Term d n -> TC ()
equalTy s t = lift $ Term.equalType noLoc ctx s t
2022-04-27 14:06:39 -04:00
2023-05-01 21:06:25 -04:00
subE, equalE : Elim d n -> Elim d n -> TC ()
subE e f = lift $ Elim.sub noLoc ctx e f
equalE e f = lift $ Elim.equal noLoc ctx e f
2022-04-27 14:06:39 -04:00
export
tests : Test
tests = "equality & subtyping" :- [
2023-02-12 15:30:08 -05:00
note #""s{t,…}" for term substs; "sp,…›" for dim substs"#,
note #""0=1𝒥" means that 𝒥 holds in an inconsistent dim context"#,
"universes" :- [
2023-02-12 15:30:08 -05:00
testEq "★₀ = ★₀" $
2023-05-01 21:06:25 -04:00
equalT empty (^TYPE 1) (^TYPE 0) (^TYPE 0),
2023-02-12 15:30:08 -05:00
testNeq "★₀ ≠ ★₁" $
2023-05-01 21:06:25 -04:00
equalT empty (^TYPE 2) (^TYPE 0) (^TYPE 1),
2023-02-12 15:30:08 -05:00
testNeq "★₁ ≠ ★₀" $
2023-05-01 21:06:25 -04:00
equalT empty (^TYPE 2) (^TYPE 1) (^TYPE 0),
testEq "★₀ <: ★₀" $
2023-05-01 21:06:25 -04:00
subT empty (^TYPE 1) (^TYPE 0) (^TYPE 0),
testEq "★₀ <: ★₁" $
2023-05-01 21:06:25 -04:00
subT empty (^TYPE 2) (^TYPE 0) (^TYPE 1),
testNeq "★₁ ≮: ★₀" $
2023-05-01 21:06:25 -04:00
subT empty (^TYPE 2) (^TYPE 1) (^TYPE 0)
],
2023-03-26 10:15:19 -04:00
"function types" :- [
2023-05-01 21:06:25 -04:00
note "cumulativity",
testEq "0.★₀ → ★₀ = 0.★₀ → ★₀" $
let tm = ^Arr Zero (^TYPE 0) (^TYPE 0) in
equalT empty (^TYPE 1) tm tm,
testEq "0.★₀ → ★₀ <: 0.★₀ → ★₀" $
let tm = ^Arr Zero (^TYPE 0) (^TYPE 0) in
subT empty (^TYPE 1) tm tm,
testNeq "0.★₁ → ★₀ ≠ 0.★₀ → ★₀" $
let tm1 = ^Arr Zero (^TYPE 1) (^TYPE 0)
tm2 = ^Arr Zero (^TYPE 0) (^TYPE 0) in
equalT empty (^TYPE 2) tm1 tm2,
testEq "1.★₁ → ★₀ <: 1.★₀ → ★₀" $
let tm1 = ^Arr One (^TYPE 1) (^TYPE 0)
tm2 = ^Arr One (^TYPE 0) (^TYPE 0) in
subT empty (^TYPE 2) tm1 tm2,
testEq "1.★₀ → ★₀ <: 1.★₀ → ★₁" $
let tm1 = ^Arr One (^TYPE 0) (^TYPE 0)
tm2 = ^Arr One (^TYPE 0) (^TYPE 1) in
subT empty (^TYPE 2) tm1 tm2,
testEq "1.★₀ → ★₀ <: 1.★₀ → ★₁" $
let tm1 = ^Arr One (^TYPE 0) (^TYPE 0)
tm2 = ^Arr One (^TYPE 0) (^TYPE 1) in
subT empty (^TYPE 2) tm1 tm2,
testEq "1.A → B = 1.A → B" $
let tm = ^Arr One (^FT "A") (^FT "B") in
equalT empty (^TYPE 0) tm tm,
testEq "1.A → B <: 1.A → B" $
let tm = ^Arr One (^FT "A") (^FT "B") in
subT empty (^TYPE 0) tm tm,
2023-02-12 15:30:08 -05:00
note "incompatible quantities",
2023-05-01 21:06:25 -04:00
testNeq "1.★₀ → ★₀ ≠ 0.★₀ → ★₁" $
let tm1 = ^Arr Zero (^TYPE 0) (^TYPE 0)
tm2 = ^Arr Zero (^TYPE 0) (^TYPE 1) in
equalT empty (^TYPE 2) tm1 tm2,
testNeq "0.A → B ≠ 1.A → B" $
let tm1 = ^Arr Zero (^FT "A") (^FT "B")
tm2 = ^Arr One (^FT "A") (^FT "B") in
equalT empty (^TYPE 0) tm1 tm2,
testNeq "0.A → B ≮: 1.A → B" $
let tm1 = ^Arr Zero (^FT "A") (^FT "B")
tm2 = ^Arr One (^FT "A") (^FT "B") in
subT empty (^TYPE 0) tm1 tm2,
testEq "0=1 ⊢ 0.A → B = 1.A → B" $
let tm1 = ^Arr Zero (^FT "A") (^FT "B")
tm2 = ^Arr One (^FT "A") (^FT "B") in
equalT empty01 (^TYPE 0) tm1 tm2,
todo "dependent function types"
],
"lambda" :- [
2023-05-01 21:06:25 -04:00
testEq "λ x ⇒ x = λ x ⇒ x" $
equalT empty (^Arr One (^FT "A") (^FT "A"))
(^LamY "x" (^BVT 0))
(^LamY "x" (^BVT 0)),
testEq "λ x ⇒ x <: λ x ⇒ x" $
subT empty (^Arr One (^FT "A") (^FT "A"))
(^LamY "x" (^BVT 0))
(^LamY "x" (^BVT 0)),
testEq "λ x ⇒ x = λ y ⇒ y" $
equalT empty (^Arr One (^FT "A") (^FT "A"))
(^LamY "x" (^BVT 0))
(^LamY "y" (^BVT 0)),
testEq "λ x ⇒ x <: λ y ⇒ y" $
subT empty (^Arr One (^FT "A") (^FT "A"))
(^LamY "x" (^BVT 0))
(^LamY "y" (^BVT 0)),
testNeq "λ x y ⇒ x ≠ λ x y ⇒ y" $
equalT empty
(^Arr One (^FT "A") (^Arr One (^FT "A") (^FT "A")))
(^LamY "x" (^LamY "y" (^BVT 1)))
(^LamY "x" (^LamY "y" (^BVT 0))),
testEq "λ x ⇒ a = λ x ⇒ a (Y vs N)" $
equalT empty
(^Arr Zero (^FT "B") (^FT "A"))
(^LamY "x" (^FT "a"))
(^LamN (^FT "a")),
testEq "λ x ⇒ f x = f (η)" $
equalT empty
(^Arr One (^FT "A") (^FT "A"))
(^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^FT "f")
],
2023-01-26 13:54:46 -05:00
"eq type" :- [
2023-02-12 15:30:08 -05:00
testEq "(★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : ★₁)" $
2023-05-01 21:06:25 -04:00
let tm = ^Eq0 (^TYPE 1) (^TYPE 0) (^TYPE 0) in
equalT empty (^TYPE 2) tm tm,
2023-02-12 15:30:08 -05:00
testEq "A ≔ ★₁ ⊢ (★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : A)"
2023-05-01 21:06:25 -04:00
{globals = fromList [("A", ^mkDef gzero (^TYPE 2) (^TYPE 1))]} $
equalT empty (^TYPE 2)
(^Eq0 (^TYPE 1) (^TYPE 0) (^TYPE 0))
(^Eq0 (^FT "A") (^TYPE 0) (^TYPE 0)),
2023-02-25 09:24:45 -05:00
todo "dependent equality types"
2023-01-26 13:54:46 -05:00
],
2023-02-12 15:30:08 -05:00
"equalities and uip" :-
2023-04-01 13:16:43 -04:00
let refl : Term d n -> Term d n -> Elim d n
2023-05-01 21:06:25 -04:00
refl a x = ^Ann (^DLam (SN x)) (^Eq0 a x x)
2023-02-11 12:15:50 -05:00
in
[
2023-02-12 15:30:08 -05:00
note "binds before ∥ are globals, after it are BVs",
2023-05-01 21:06:25 -04:00
note #"refl A x is an abbreviation for "(δ i ⇒ x)(x ≡ x : A)""#,
testEq "refl A a = refl A a" $
equalE empty (refl (^FT "A") (^FT "a")) (refl (^FT "A") (^FT "a")),
2023-02-12 15:30:08 -05:00
testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ∥ ⊢ p = q (free)"
2023-02-11 12:15:50 -05:00
{globals =
2023-05-01 21:06:25 -04:00
let def = ^mkPostulate gzero (^Eq0 (^FT "A") (^FT "a") (^FT "a'"))
in defGlobals `mergeLeft` fromList [("p", def), ("q", def)]} $
equalE empty (^F "p") (^F "q"),
2023-02-12 15:30:08 -05:00
testEq "∥ x : (a ≡ a' : A), y : (a ≡ a' : A) ⊢ x = y (bound)" $
2023-05-01 21:06:25 -04:00
let ty : forall n. Term 0 n := ^Eq0 (^FT "A") (^FT "a") (^FT "a'") in
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
2023-05-01 21:06:25 -04:00
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
2023-05-01 21:06:25 -04:00
testEq "∥ x : (a ≡ a' : A) ∷ Type 0, y : [ditto] ⊢ x = y" $
2023-04-01 13:16:43 -04:00
let ty : forall n. Term 0 n :=
2023-05-01 21:06:25 -04:00
E $ ^Ann (^Eq0 (^FT "A") (^FT "a") (^FT "a'")) (^TYPE 0) in
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
2023-05-01 21:06:25 -04:00
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
2023-05-01 21:06:25 -04:00
[("E", ^mkDef gzero (^TYPE 0)
(^Eq0 (^FT "A") (^FT "a") (^FT "a'"))),
("EE", ^mkDef gzero (^TYPE 0) (^FT "E"))]} $
equalE (extendTyN [< (Any, "x", ^FT "EE"), (Any, "y", ^FT "EE")] empty)
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
2023-05-01 21:06:25 -04:00
[("E", ^mkDef gzero (^TYPE 0)
(^Eq0 (^FT "A") (^FT "a") (^FT "a'"))),
("EE", ^mkDef gzero (^TYPE 0) (^FT "E"))]} $
equalE (extendTyN [< (Any, "x", ^FT "EE"), (Any, "y", ^FT "E")] empty)
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
2023-05-01 21:06:25 -04:00
[("E", ^mkDef gzero (^TYPE 0)
(^Eq0 (^FT "A") (^FT "a") (^FT "a'")))]} $
equalE (extendTyN [< (Any, "x", ^FT "E"), (Any, "y", ^FT "E")] empty)
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
2023-05-01 21:06:25 -04:00
[("E", ^mkDef gzero (^TYPE 0)
(^Eq0 (^FT "A") (^FT "a") (^FT "a'")))]} $
let ty : forall n. Term 0 n := ^Sig (^FT "E") (SN $ ^FT "E") in
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
2023-05-01 21:06:25 -04:00
(^BV 0) (^BV 1),
2023-02-12 15:30:08 -05:00
2023-05-01 21:06:25 -04:00
testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : E×E ⊢ x = y"
2023-02-12 15:30:08 -05:00
{globals = defGlobals `mergeLeft` fromList
2023-05-01 21:06:25 -04:00
[("E", ^mkDef gzero (^TYPE 0)
(^Eq0 (^FT "A") (^FT "a") (^FT "a'"))),
("W", ^mkDef gzero (^TYPE 0) (^And (^FT "E") (^FT "E")))]} $
equalE
2023-05-01 21:06:25 -04:00
(extendTyN [< (Any, "x", ^FT "W"),
(Any, "y", ^And (^FT "E") (^FT "E"))] empty)
(^BV 0) (^BV 1)
2023-02-11 12:15:50 -05:00
],
2023-01-26 13:54:46 -05:00
"term closure" :- [
2023-05-01 21:06:25 -04:00
note "bold numbers for de bruijn indices",
testEq "𝟎{} = 𝟎 : A" $
equalT (extendTy Any "x" (^FT "A") empty)
(^FT "A")
(CloT (Sub (^BVT 0) id))
(^BVT 0),
testEq "𝟎{a} = a : A" $
equalT empty (^FT "A")
(CloT (Sub (^BVT 0) (^F "a" ::: id)))
(^FT "a"),
testEq "𝟎{a,b} = a : A" $
equalT empty (^FT "A")
(CloT (Sub (^BVT 0) (^F "a" ::: ^F "b" ::: id)))
(^FT "a"),
testEq "𝟏{a,b} = b : A" $
equalT empty (^FT "A")
(CloT (Sub (^BVT 1) (^F "a" ::: ^F "b" ::: id)))
(^FT "b"),
testEq "(λy ⇒ 𝟏){a} = λy ⇒ a : 0.B → A (N)" $
equalT empty (^Arr Zero (^FT "B") (^FT "A"))
(CloT (Sub (^LamN (^BVT 0)) (^F "a" ::: id)))
(^LamN (^FT "a")),
testEq "(λy ⇒ 𝟏){a} = λy ⇒ a : 0.B → A (Y)" $
equalT empty (^Arr Zero (^FT "B") (^FT "A"))
(CloT (Sub (^LamY "y" (^BVT 1)) (^F "a" ::: id)))
(^LamY "y" (^FT "a"))
],
2023-02-12 15:30:08 -05:00
"term d-closure" :- [
2023-05-01 21:06:25 -04:00
testEq "★₀0 = ★₀ : ★₁" $
equalT (extendDim "𝑗" empty)
(^TYPE 1) (DCloT (Sub (^TYPE 0) (^K Zero ::: id))) (^TYPE 0),
testEq "(δ i ⇒ a)0 = (δ i ⇒ a) : (a ≡ a : A)" $
equalT (extendDim "𝑗" empty)
(^Eq0 (^FT "A") (^FT "a") (^FT "a"))
(DCloT (Sub (^DLamN (^FT "a")) (^K Zero ::: id)))
(^DLamN (^FT "a")),
2023-02-12 15:30:08 -05:00
note "it is hard to think of well-typed terms with big dctxs"
],
"free var" :-
let au_bu = fromList
2023-05-01 21:06:25 -04:00
[("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 1) (^TYPE 0))]
au_ba = fromList
2023-05-01 21:06:25 -04:00
[("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 1) (^FT "A"))]
in [
2023-02-12 15:30:08 -05:00
testEq "A = A" $
2023-05-01 21:06:25 -04:00
equalE empty (^F "A") (^F "A"),
2023-02-12 15:30:08 -05:00
testNeq "A ≠ B" $
2023-05-01 21:06:25 -04:00
equalE empty (^F "A") (^F "B"),
2023-02-12 15:30:08 -05:00
testEq "0=1 ⊢ A = B" $
2023-05-01 21:06:25 -04:00
equalE empty01 (^F "A") (^F "B"),
2023-02-12 15:30:08 -05:00
testEq "A : ★₁ ≔ ★₀ ⊢ A = (★₀ ∷ ★₁)" {globals = au_bu} $
2023-05-01 21:06:25 -04:00
equalE empty (^F "A") (^Ann (^TYPE 0) (^TYPE 1)),
testEq "A : ★₁ ≔ ★₀ ⊢ A = ★₀" {globals = au_bu} $
equalT empty (^TYPE 1) (^FT "A") (^TYPE 0),
2023-02-12 15:30:08 -05:00
testEq "A ≔ ★₀, B ≔ ★₀ ⊢ A = B" {globals = au_bu} $
2023-05-01 21:06:25 -04:00
equalE empty (^F "A") (^F "B"),
2023-02-12 15:30:08 -05:00
testEq "A ≔ ★₀, B ≔ A ⊢ A = B" {globals = au_ba} $
2023-05-01 21:06:25 -04:00
equalE empty (^F "A") (^F "B"),
testEq "A <: A" $
2023-05-01 21:06:25 -04:00
subE empty (^F "A") (^F "A"),
testNeq "A ≮: B" $
2023-05-01 21:06:25 -04:00
subE empty (^F "A") (^F "B"),
testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
2023-05-01 21:06:25 -04:00
{globals = fromList [("A", ^mkDef gany (^TYPE 3) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
subE empty (^F "A") (^F "B"),
2023-02-12 15:30:08 -05:00
note "(A and B in different universes)",
testEq "A : ★₁ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
2023-05-01 21:06:25 -04:00
{globals = fromList [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
subE empty (^F "A") (^F "B"),
testEq "0=1 ⊢ A <: B" $
2023-05-01 21:06:25 -04:00
subE empty01 (^F "A") (^F "B")
],
"bound var" :- [
2023-05-01 21:06:25 -04:00
note "bold numbers for de bruijn indices",
testEq "𝟎 = 𝟎" $
equalE (extendTy Any "A" (^TYPE 0) empty) (^BV 0) (^BV 0),
testEq "𝟎 <: 𝟎" $
subE (extendTy Any "A" (^TYPE 0) empty) (^BV 0) (^BV 0),
testNeq "𝟎𝟏" $
equalE (extendTyN [< (Any, "A", ^TYPE 0), (Any, "B", ^TYPE 0)] empty)
(^BV 0) (^BV 1),
testNeq "𝟎 ≮: 𝟏" $
subE (extendTyN [< (Any, "A", ^TYPE 0), (Any, "B", ^TYPE 0)] empty)
(^BV 0) (^BV 1),
testEq "0=1 ⊢ 𝟎 = 𝟏" $
equalE (extendTyN [< (Any, "A", ^TYPE 0), (Any, "B", ^TYPE 0)] empty01)
(^BV 0) (^BV 1)
],
"application" :- [
2023-05-01 21:06:25 -04:00
testEq "f a = f a" $
equalE empty (^App (^F "f") (^FT "a")) (^App (^F "f") (^FT "a")),
testEq "f a <: f a" $
subE empty (^App (^F "f") (^FT "a")) (^App (^F "f") (^FT "a")),
testEq "(λ x ⇒ x ∷ 1.A → A) a = ((a ∷ A) ∷ A) (β)" $
equalE empty
2023-05-01 21:06:25 -04:00
(^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a"))
(^Ann (E $ ^Ann (^FT "a") (^FT "A")) (^FT "A")),
testEq "(λ x ⇒ x ∷ A ⊸ A) a = a (βυ)" $
equalE empty
2023-05-01 21:06:25 -04:00
(^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a"))
(^F "a"),
testEq "((λ g ⇒ g a) ∷ 1.(1.A → A) → A) f = ((λ y ⇒ f y) ∷ 1.A → A) a # β↘↙" $
let a = ^FT "A"; a2a = ^Arr One a a; aa2a = ^Arr One a2a a in
equalE empty
2023-05-01 21:06:25 -04:00
(^App (^Ann (^LamY "g" (E $ ^App (^BV 0) (^FT "a"))) aa2a) (^FT "f"))
(^App (^Ann (^LamY "y" (E $ ^App (^F "f") (^BVT 0))) a2a) (^FT "a")),
testEq "((λ x ⇒ x) ∷ 1.A → A) a <: a" $
subE empty
2023-05-01 21:06:25 -04:00
(^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a"))
(^F "a"),
note "id : A ⊸ A ≔ λ x ⇒ x",
testEq "id a = a" $ equalE empty (^App (^F "id") (^FT "a")) (^F "a"),
testEq "id a <: a" $ subE empty (^App (^F "id") (^FT "a")) (^F "a")
],
2023-03-05 06:18:15 -05:00
"dim application" :- [
testEq "eq-AB @0 = eq-AB @0" $
2023-05-01 21:06:25 -04:00
equalE empty
(^DApp (^F "eq-AB") (^K Zero))
(^DApp (^F "eq-AB") (^K Zero)),
2023-03-05 06:18:15 -05:00
testNeq "eq-AB @0 ≠ eq-AB @1" $
2023-05-01 21:06:25 -04:00
equalE empty
(^DApp (^F "eq-AB") (^K Zero))
(^DApp (^F "eq-AB") (^K One)),
2023-03-05 06:18:15 -05:00
testEq "𝑖 | ⊢ eq-AB @𝑖 = eq-AB @𝑖" $
2023-05-01 21:06:25 -04:00
equalE
(extendDim "𝑖" empty)
2023-05-01 21:06:25 -04:00
(^DApp (^F "eq-AB") (^BV 0))
(^DApp (^F "eq-AB") (^BV 0)),
2023-03-05 06:18:15 -05:00
testNeq "𝑖 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
2023-05-01 21:06:25 -04:00
equalE (extendDim "𝑖" empty)
(^DApp (^F "eq-AB") (^BV 0))
(^DApp (^F "eq-AB") (^K Zero)),
2023-03-05 06:18:15 -05:00
testEq "𝑖, 𝑖=0 | ⊢ eq-AB @𝑖 = eq-AB @0" $
2023-05-01 21:06:25 -04:00
equalE (eqDim (^BV 0) (^K Zero) $ extendDim "𝑖" empty)
(^DApp (^F "eq-AB") (^BV 0))
(^DApp (^F "eq-AB") (^K Zero)),
2023-03-05 06:18:15 -05:00
testNeq "𝑖, 𝑖=1 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
2023-05-01 21:06:25 -04:00
equalE (eqDim (^BV 0) (^K One) $ extendDim "𝑖" empty)
(^DApp (^F "eq-AB") (^BV 0))
(^DApp (^F "eq-AB") (^K Zero)),
2023-03-05 06:18:15 -05:00
testNeq "𝑖, 𝑗 | ⊢ eq-AB @𝑖 ≠ eq-AB @𝑗" $
2023-05-01 21:06:25 -04:00
equalE (extendDim "𝑗" $ extendDim "𝑖" empty)
(^DApp (^F "eq-AB") (^BV 1))
(^DApp (^F "eq-AB") (^BV 0)),
2023-03-05 06:18:15 -05:00
testEq "𝑖, 𝑗, 𝑖=𝑗 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
2023-05-01 21:06:25 -04:00
equalE (eqDim (^BV 0) (^BV 1) $ extendDim "𝑗" $ extendDim "𝑖" empty)
(^DApp (^F "eq-AB") (^BV 1))
(^DApp (^F "eq-AB") (^BV 0)),
testEq "𝑖, 𝑗, 𝑖=0, 𝑗=0 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
2023-05-01 21:06:25 -04:00
equalE
(eqDim (^BV 0) (^K Zero) $ eqDim (^BV 1) (^K Zero) $
extendDim "𝑗" $ extendDim "𝑖" empty)
2023-05-01 21:06:25 -04:00
(^DApp (^F "eq-AB") (^BV 1))
(^DApp (^F "eq-AB") (^BV 0)),
2023-03-05 06:18:15 -05:00
testEq "0=1 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
2023-05-01 21:06:25 -04:00
equalE (extendDim "𝑗" $ extendDim "𝑖" empty01)
(^DApp (^F "eq-AB") (^BV 1))
(^DApp (^F "eq-AB") (^BV 0)),
testEq "eq-AB @0 = A" $
equalE empty (^DApp (^F "eq-AB") (^K Zero)) (^F "A"),
testEq "eq-AB @1 = B" $
equalE empty (^DApp (^F "eq-AB") (^K One)) (^F "B"),
testEq "((δ i ⇒ a) ∷ a ≡ a : A) @0 = a" $
2023-03-05 06:18:15 -05:00
equalE empty
2023-05-01 21:06:25 -04:00
(^DApp (^Ann (^DLamN (^FT "a")) (^Eq0 (^FT "A") (^FT "a") (^FT "a")))
(^K Zero))
(^F "a"),
testEq "((δ i ⇒ a) ∷ a ≡ a : A) @0 = ((δ i ⇒ a) ∷ a ≡ a : A) @1" $
2023-03-05 06:18:15 -05:00
equalE empty
2023-05-01 21:06:25 -04:00
(^DApp (^Ann (^DLamN (^FT "a")) (^Eq0 (^FT "A") (^FT "a") (^FT "a")))
(^K Zero))
(^DApp (^Ann (^DLamN (^FT "a")) (^Eq0 (^FT "A") (^FT "a") (^FT "a")))
(^K One))
2023-03-05 06:18:15 -05:00
],
2023-01-26 13:54:46 -05:00
2023-02-12 15:30:08 -05:00
"annotation" :- [
2023-05-01 21:06:25 -04:00
testEq "(λ x ⇒ f x) ∷ 1.A → A = f ∷ 1.A → A" $
equalE empty
2023-05-01 21:06:25 -04:00
(^Ann (^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^Arr One (^FT "A") (^FT "A")))
(^Ann (^FT "f") (^Arr One (^FT "A") (^FT "A"))),
testEq "f ∷ 1.A → A = f" $
equalE empty
2023-05-01 21:06:25 -04:00
(^Ann (^FT "f") (^Arr One (^FT "A") (^FT "A")))
(^F "f"),
testEq "(λ x ⇒ f x) ∷ 1.A → A = f" $
equalE empty
(^Ann (^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^Arr One (^FT "A") (^FT "A")))
(^F "f")
2023-02-12 15:30:08 -05:00
],
2023-03-26 18:08:48 -04:00
"natural type" :- [
2023-05-01 21:06:25 -04:00
testEq " = " $ equalTy empty (^Nat) (^Nat),
testEq " = : ★₀" $ equalT empty (^TYPE 0) (^Nat) (^Nat),
testEq " = : ★₆₉" $ equalT empty (^TYPE 69) (^Nat) (^Nat),
testNeq " ≠ {}" $ equalTy empty (^Nat) (^enum []),
testEq "0=1 ⊢ = {}" $ equalTy empty01 (^Nat) (^enum [])
2023-03-26 18:08:48 -04:00
],
2023-03-26 10:15:19 -04:00
"natural numbers" :- [
2023-05-01 21:06:25 -04:00
testEq "0 = 0" $ equalT empty (^Nat) (^Zero) (^Zero),
2023-03-26 10:15:19 -04:00
testEq "succ two = succ two" $
2023-05-01 21:06:25 -04:00
equalT empty (^Nat) (^Succ (^FT "two")) (^Succ (^FT "two")),
2023-03-26 10:15:19 -04:00
testNeq "succ two ≠ two" $
2023-05-01 21:06:25 -04:00
equalT empty (^Nat) (^Succ (^FT "two")) (^FT "two"),
testNeq "0 ≠ 1" $
equalT empty (^Nat) (^Zero) (^Succ (^Zero)),
testEq "0=1 ⊢ 0 = 1" $
equalT empty01 (^Nat) (^Zero) (^Succ (^Zero))
2023-03-26 10:15:19 -04:00
],
"natural elim" :- [
testEq "caseω 0 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'a" $
equalT empty
2023-05-01 21:06:25 -04:00
(^enum ["a", "b"])
(E $ ^CaseNat Any Zero (^Ann (^Zero) (^Nat))
(SN $ ^enum ["a", "b"])
(^Tag "a")
(SN $ ^Tag "b"))
(^Tag "a"),
2023-03-26 10:15:19 -04:00
testEq "caseω 1 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'b" $
equalT empty
2023-05-01 21:06:25 -04:00
(^enum ["a", "b"])
(E $ ^CaseNat Any Zero (^Ann (^Succ (^Zero)) (^Nat))
(SN $ ^enum ["a", "b"])
(^Tag "a")
(SN $ ^Tag "b"))
(^Tag "b"),
2023-03-26 10:15:19 -04:00
testEq "caseω 4 return of {0 ⇒ 0; succ n ⇒ n} = 3" $
equalT empty
2023-05-01 21:06:25 -04:00
(^Nat)
(E $ ^CaseNat Any Zero (^Ann (^makeNat 4) (^Nat))
(SN $ ^Nat)
(^Zero)
(SY [< "n", ^BN Unused] $ ^BVT 1))
(^makeNat 3)
2023-03-26 10:15:19 -04:00
],
todo "pair types",
"pairs" :- [
testEq "('a, 'b) = ('a, 'b) : {a} × {b}" $
equalT empty
2023-05-01 21:06:25 -04:00
(^And (^enum ["a"]) (^enum ["b"]))
(^Pair (^Tag "a") (^Tag "b"))
(^Pair (^Tag "a") (^Tag "b")),
2023-03-26 10:15:19 -04:00
testNeq "('a, 'b) ≠ ('b, 'a) : {a,b} × {a,b}" $
equalT empty
2023-05-01 21:06:25 -04:00
(^And (^enum ["a", "b"]) (^enum ["a", "b"]))
(^Pair (^Tag "a") (^Tag "b"))
(^Pair (^Tag "b") (^Tag "a")),
2023-03-26 10:15:19 -04:00
testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : {a,b} × {a,b}" $
equalT empty01
2023-05-01 21:06:25 -04:00
(^And (^enum ["a", "b"]) (^enum ["a", "b"]))
(^Pair (^Tag "a") (^Tag "b"))
(^Pair (^Tag "b") (^Tag "a")),
2023-03-26 10:15:19 -04:00
testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : " $
equalT empty01
2023-05-01 21:06:25 -04:00
(^Nat)
(^Pair (^Tag "a") (^Tag "b"))
(^Pair (^Tag "b") (^Tag "a"))
2023-03-26 10:15:19 -04:00
],
todo "pair elim",
todo "enum types",
todo "enum",
todo "enum elim",
2023-03-31 13:11:35 -04:00
todo "box types",
todo "boxes",
todo "box elim",
2023-02-12 15:30:08 -05:00
"elim closure" :- [
2023-05-01 21:06:25 -04:00
note "bold numbers for de bruijn indices",
testEq "𝟎{a} = a" $
equalE empty (CloE (Sub (^BV 0) (^F "a" ::: id))) (^F "a"),
testEq "𝟏{a} = 𝟎" $
equalE (extendTy Any "x" (^FT "A") empty)
(CloE (Sub (^BV 1) (^F "a" ::: id))) (^BV 0)
2023-02-12 15:30:08 -05:00
],
2023-02-12 15:30:08 -05:00
"elim d-closure" :- [
2023-05-01 21:06:25 -04:00
note "bold numbers for de bruijn indices",
2023-03-05 06:18:15 -05:00
note "0·eq-AB : (A ≡ B : ★₀)",
2023-05-01 21:06:25 -04:00
testEq "(eq-AB @𝟎)0 = eq-AB @0" $
equalE empty
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^K Zero ::: id)))
(^DApp (^F "eq-AB") (^K Zero)),
testEq "(eq-AB @𝟎)0 = A" $
equalE empty
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^K Zero ::: id)))
(^F "A"),
testEq "(eq-AB @𝟎)1 = B" $
equalE empty
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^K One ::: id)))
(^F "B"),
testNeq "(eq-AB @𝟎)1 ≠ A" $
equalE empty
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^K One ::: id)))
(^F "A"),
testEq "(eq-AB @𝟎)𝟎,0 = (eq-AB 𝟎)" $
equalE (extendDim "𝑖" empty)
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^BV 0 ::: ^K Zero ::: id)))
(^DApp (^F "eq-AB") (^BV 0)),
testNeq "(eq-AB 𝟎)0 ≠ (eq-AB 0)" $
equalE (extendDim "𝑖" empty)
(DCloE (Sub (^DApp (^F "eq-AB") (^BV 0)) (^BV 0 ::: ^K Zero ::: id)))
(^DApp (^F "eq-AB") (^K Zero)),
testEq "𝟎0 = 𝟎 # term and dim vars distinct" $
equalE
(extendTy Any "x" (^FT "A") empty)
(DCloE (Sub (^BV 0) (^K Zero ::: id))) (^BV 0),
testEq "a0 = a" $
equalE empty
(DCloE (Sub (^F "a") (^K Zero ::: id))) (^F "a"),
testEq "(f a)0 = f0 a0" $
let th = ^K Zero ::: id in
equalE empty
(DCloE (Sub (^App (^F "f") (^FT "a")) th))
(^App (DCloE (Sub (^F "f") th)) (DCloT (Sub (^FT "a") th)))
2023-02-12 15:30:08 -05:00
],
"clashes" :- [
2023-05-01 21:06:25 -04:00
testNeq "★₀ ≠ 0.★₀ → ★₀" $
equalT empty (^TYPE 1) (^TYPE 0) (^Arr Zero (^TYPE 0) (^TYPE 0)),
testEq "0=1 ⊢ ★₀ = 0.★₀ → ★₀" $
equalT empty01 (^TYPE 1) (^TYPE 0) (^Arr Zero (^TYPE 0) (^TYPE 0)),
todo "others"
2022-04-27 14:06:39 -04:00
]
]