quox/tests/Tests/Equal.idr

563 lines
21 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
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-04-01 13:16:43 -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")) ([< "x"] :\\ BVT 0)),
("eq-AB", mkPostulate gzero $ Eq0 (TYPE 0) (FT "A") (FT "B")),
("two", mkDef gany Nat (Succ (Succ Zero)))]
2023-02-10 15:40:44 -05:00
2023-04-01 13:16:43 -04:00
parameters (label : String) (act : Lazy (TC ()))
{default defGlobals globals : Definitions}
testEq : Test
2023-03-31 17:43:25 -04:00
testEq = test label $ runTC globals act
2022-04-27 14:06:39 -04:00
testNeq : Test
2023-03-31 17:43:25 -04:00
testNeq = testThrows label (const True) $ runTC globals act $> "()"
2022-04-27 14:06:39 -04:00
2023-04-01 13:16:43 -04:00
parameters (0 d : Nat) (ctx : TyContext d n)
subTD, equalTD : Term d n -> Term d n -> Term d n -> TC ()
subTD ty s t = Term.sub ctx ty s t
equalTD ty s t = Term.equal ctx ty s t
2023-04-01 13:16:43 -04:00
equalTyD : Term d n -> Term d n -> TC ()
2023-03-26 18:08:48 -04:00
equalTyD s t = Term.equalType ctx s t
2022-04-27 14:06:39 -04:00
2023-04-01 13:16:43 -04:00
subED, equalED : Elim d n -> Elim d n -> TC ()
subED e f = Elim.sub ctx e f
equalED e f = Elim.equal ctx e f
2022-04-27 14:06:39 -04:00
2023-04-01 13:16:43 -04:00
parameters (ctx : TyContext 0 n)
subT, equalT : Term 0 n -> Term 0 n -> Term 0 n -> TC ()
subT = subTD 0 ctx
equalT = equalTD 0 ctx
2023-04-01 13:16:43 -04:00
equalTy : Term 0 n -> Term 0 n -> TC ()
2023-03-26 18:08:48 -04:00
equalTy = equalTyD 0 ctx
2023-04-01 13:16:43 -04:00
subE, equalE : Elim 0 n -> Elim 0 n -> TC ()
subE = subED 0 ctx
equalE = equalED 0 ctx
2022-04-27 14:06:39 -04:00
2023-04-01 13:16:43 -04:00
empty01 : TyContext 0 0
empty01 = eqDim (K Zero) (K One) empty
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 "★₀ = ★₀" $
equalT empty (TYPE 1) (TYPE 0) (TYPE 0),
2023-02-12 15:30:08 -05:00
testNeq "★₀ ≠ ★₁" $
equalT empty (TYPE 2) (TYPE 0) (TYPE 1),
2023-02-12 15:30:08 -05:00
testNeq "★₁ ≠ ★₀" $
equalT empty (TYPE 2) (TYPE 1) (TYPE 0),
testEq "★₀ <: ★₀" $
subT empty (TYPE 1) (TYPE 0) (TYPE 0),
testEq "★₀ <: ★₁" $
subT empty (TYPE 2) (TYPE 0) (TYPE 1),
testNeq "★₁ ≮: ★₀" $
subT empty (TYPE 2) (TYPE 1) (TYPE 0)
],
2023-03-26 10:15:19 -04:00
"function types" :- [
2023-02-12 15:30:08 -05:00
note #""𝐴𝐵" for (1·𝐴)𝐵"#,
note #""𝐴𝐵" for (0·𝐴)𝐵"#,
testEq "★₀ ⇾ ★₀ = ★₀ ⇾ ★₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
equalT empty (TYPE 1) tm tm,
testEq "★₀ ⇾ ★₀ <: ★₀ ⇾ ★₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
subT empty (TYPE 1) tm tm,
2023-02-12 15:30:08 -05:00
testNeq "★₁ ⊸ ★₀ ≠ ★₀ ⇾ ★₀" $
let tm1 = Arr Zero (TYPE 1) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 0) in
equalT empty (TYPE 2) tm1 tm2,
testEq "★₁ ⊸ ★₀ <: ★₀ ⊸ ★₀" $
let tm1 = Arr One (TYPE 1) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 0) in
subT empty (TYPE 2) tm1 tm2,
testEq "★₀ ⊸ ★₀ <: ★₀ ⊸ ★₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT empty (TYPE 2) tm1 tm2,
testEq "★₀ ⊸ ★₀ <: ★₀ ⊸ ★₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT empty (TYPE 2) tm1 tm2,
2023-02-12 15:30:08 -05:00
testEq "A ⊸ B = A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
equalT empty (TYPE 0) tm tm,
2023-02-12 15:30:08 -05:00
testEq "A ⊸ B <: 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",
testNeq "★₀ ⊸ ★₀ ≠ ★₀ ⇾ ★₁" $
let tm1 = Arr Zero (TYPE 0) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 1) in
equalT empty (TYPE 2) tm1 tm2,
2023-02-12 15:30:08 -05:00
testNeq "A ⇾ B ≠ A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
equalT empty (TYPE 0) tm1 tm2,
2023-02-12 15:30:08 -05:00
testNeq "A ⇾ B ≮: A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
subT empty (TYPE 0) tm1 tm2,
2023-02-12 15:30:08 -05:00
testEq "0=1 ⊢ A ⇾ B = A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
equalT empty01 (TYPE 0) tm1 tm2,
2023-02-25 09:24:45 -05:00
todo "dependent function types",
2023-02-12 15:30:08 -05:00
note "[todo] should π ≤ ρ ⊢ (ρ·A) → B <: (π·A) → B?"
],
"lambda" :- [
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [x] = λ x ⇒ [x]" $
equalT empty (Arr One (FT "A") (FT "A"))
([< "x"] :\\ BVT 0)
([< "x"] :\\ BVT 0),
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [x] <: λ x ⇒ [x]" $
subT empty (Arr One (FT "A") (FT "A"))
([< "x"] :\\ BVT 0)
([< "x"] :\\ BVT 0),
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [x] = λ y ⇒ [y]" $
equalT empty (Arr One (FT "A") (FT "A"))
([< "x"] :\\ BVT 0)
([< "y"] :\\ BVT 0),
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [x] <: λ y ⇒ [y]" $
equalT empty (Arr One (FT "A") (FT "A"))
([< "x"] :\\ BVT 0)
([< "y"] :\\ BVT 0),
2023-03-04 15:02:51 -05:00
testNeq "λ x y ⇒ [x] ≠ λ x y ⇒ [y]" $
equalT empty (Arr One (FT "A") $ Arr One (FT "A") (FT "A"))
([< "x", "y"] :\\ BVT 1)
([< "x", "y"] :\\ BVT 0),
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [a] = λ x ⇒ [a] (Y vs N)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(Lam $ SY [< "x"] $ FT "a")
(Lam $ SN $ FT "a"),
2023-03-04 15:02:51 -05:00
testEq "λ x ⇒ [f [x]] = [f] (η)" $
equalT empty (Arr One (FT "A") (FT "A"))
([< "x"] :\\ E (F "f" :@ BVT 0))
2023-02-10 15:40:44 -05:00
(FT "f")
],
2023-01-26 13:54:46 -05:00
"eq type" :- [
2023-02-12 15:30:08 -05:00
testEq "(★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : ★₁)" $
2023-01-26 13:54:46 -05: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-04-01 13:16:43 -04:00
{globals = fromList [("A", mkDef gzero (TYPE 2) (TYPE 1))]} $
equalT empty (TYPE 2)
2023-02-10 15:40:44 -05:00
(Eq0 (TYPE 1) (TYPE 0) (TYPE 0))
2023-02-25 09:24:45 -05:00
(Eq0 (FT "A") (TYPE 0) (TYPE 0)),
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
refl a x = (DLam $ S [< "_"] $ N x) :# (Eq0 a x x)
2023-02-11 12:15:50 -05:00
in
[
2023-03-04 15:02:51 -05:00
note #""refl [A] x" is an abbreviation for "(δ i ⇒ x)(x ≡ x : A)""#,
2023-02-12 15:30:08 -05:00
note "binds before ∥ are globals, after it are BVs",
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-04-01 13:16:43 -04:00
let def = mkPostulate gzero $ Eq0 (FT "A") (FT "a") (FT "a'") in
2023-02-11 12:15:50 -05:00
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-04-01 13:16:43 -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)
(BV 0) (BV 1),
2023-02-12 15:30:08 -05: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-03-05 06:18:15 -05:00
E (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)
(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-04-01 13:16:43 -04:00
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("EE", mkDef gzero (TYPE 0) (FT "E"))]} $
2023-03-15 10:54:51 -04:00
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-04-01 13:16:43 -04:00
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("EE", mkDef gzero (TYPE 0) (FT "E"))]} $
2023-03-15 10:54:51 -04:00
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-04-01 13:16:43 -04:00
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
2023-03-15 10:54:51 -04:00
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-04-01 13:16:43 -04:00
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
let ty : forall n. Term 0 n :=
Sig (FT "E") $ S [< "_"] $ N $ FT "E" in
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
(BV 0) (BV 1),
2023-02-12 15:30:08 -05:00
testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : W ⊢ x = y"
2023-02-12 15:30:08 -05:00
{globals = defGlobals `mergeLeft` fromList
2023-04-01 13:16:43 -04:00
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
("W", mkDef gzero (TYPE 0) (FT "E" `And` FT "E"))]} $
equalE
2023-03-15 10:54:51 -04:00
(extendTyN [< (Any, "x", FT "W"), (Any, "y", FT "W")] empty)
(BV 0) (BV 1)
2023-02-11 12:15:50 -05:00
],
2023-01-26 13:54:46 -05:00
"term closure" :- [
2023-02-12 15:30:08 -05:00
testEq "[#0]{} = [#0] : A" $
2023-03-15 10:54:51 -04:00
equalT (extendTy Any "x" (FT "A") empty)
(FT "A")
2023-02-10 15:40:44 -05:00
(CloT (BVT 0) id)
(BVT 0),
2023-02-12 15:30:08 -05:00
testEq "[#0]{a} = [a] : A" $
equalT empty (FT "A")
2023-02-10 15:40:44 -05:00
(CloT (BVT 0) (F "a" ::: id))
(FT "a"),
2023-02-12 15:30:08 -05:00
testEq "[#0]{a,b} = [a] : A" $
equalT empty (FT "A")
2023-02-10 15:40:44 -05:00
(CloT (BVT 0) (F "a" ::: F "b" ::: id))
(FT "a"),
2023-02-12 15:30:08 -05:00
testEq "[#1]{a,b} = [b] : A" $
equalT empty (FT "A")
2023-02-12 15:30:08 -05:00
(CloT (BVT 1) (F "a" ::: F "b" ::: id))
(FT "b"),
2023-03-04 15:02:51 -05:00
testEq "(λy ⇒ [#1]){a} = λy ⇒ [a] : B ⇾ A (N)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(CloT (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S [< "y"] $ N $ FT "a"),
2023-03-04 15:02:51 -05:00
testEq "(λy ⇒ [#1]){a} = λy ⇒ [a] : B ⇾ A (Y)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(CloT ([< "y"] :\\ BVT 1) (F "a" ::: id))
([< "y"] :\\ FT "a")
],
2023-02-12 15:30:08 -05:00
"term d-closure" :- [
testEq "★₀‹𝟎› = ★₀ : ★₁" $
equalTD 1
(extendDim "𝑗" empty)
(TYPE 1) (DCloT (TYPE 0) (K Zero ::: id)) (TYPE 0),
2023-03-04 15:02:51 -05:00
testEq "(δ i ⇒ a)𝟎 = (δ i ⇒ a) : (a ≡ a : A)" $
equalTD 1
(extendDim "𝑗" empty)
2023-02-12 15:30:08 -05:00
(Eq0 (FT "A") (FT "a") (FT "a"))
(DCloT ([< "i"] :\\% FT "a") (K Zero ::: id))
([< "i"] :\\% 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-04-01 13:16:43 -04:00
[("A", mkDef gany (TYPE 1) (TYPE 0)),
("B", mkDef gany (TYPE 1) (TYPE 0))]
au_ba = fromList
2023-04-01 13:16:43 -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" $
equalE empty (F "A") (F "A"),
2023-02-12 15:30:08 -05:00
testNeq "A ≠ B" $
equalE empty (F "A") (F "B"),
2023-02-12 15:30:08 -05:00
testEq "0=1 ⊢ A = B" $
equalE empty01 (F "A") (F "B"),
2023-02-12 15:30:08 -05:00
testEq "A : ★₁ ≔ ★₀ ⊢ A = (★₀ ∷ ★₁)" {globals = au_bu} $
equalE empty (F "A") (TYPE 0 :# TYPE 1),
2023-02-12 15:30:08 -05:00
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} $
equalE empty (F "A") (F "B"),
2023-02-12 15:30:08 -05:00
testEq "A ≔ ★₀, B ≔ A ⊢ A = B" {globals = au_ba} $
equalE empty (F "A") (F "B"),
testEq "A <: A" $
subE empty (F "A") (F "A"),
testNeq "A ≮: B" $
subE empty (F "A") (F "B"),
testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
2023-04-01 13:16:43 -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-04-01 13:16:43 -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" $
subE empty01 (F "A") (F "B")
],
"bound var" :- [
2023-02-12 15:30:08 -05:00
testEq "#0 = #0" $
2023-03-15 10:54:51 -04:00
equalE (extendTy Any "A" (TYPE 0) empty) (BV 0) (BV 0),
2023-02-12 15:30:08 -05:00
testEq "#0 <: #0" $
2023-03-15 10:54:51 -04:00
subE (extendTy Any "A" (TYPE 0) empty) (BV 0) (BV 0),
2023-02-12 15:30:08 -05:00
testNeq "#0 ≠ #1" $
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "A", TYPE 0), (Any, "B", TYPE 0)] empty)
(BV 0) (BV 1),
2023-02-12 15:30:08 -05:00
testNeq "#0 ≮: #1" $
2023-03-15 10:54:51 -04:00
subE (extendTyN [< (Any, "A", TYPE 0), (Any, "B", TYPE 0)] empty)
(BV 0) (BV 1),
2023-02-12 15:30:08 -05:00
testEq "0=1 ⊢ #0 = #1" $
2023-03-15 10:54:51 -04:00
equalE (extendTyN [< (Any, "A", TYPE 0), (Any, "B", TYPE 0)] empty01)
(BV 0) (BV 1)
],
"application" :- [
2023-02-12 15:30:08 -05:00
testEq "f [a] = f [a]" $
equalE empty (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "f [a] <: f [a]" $
subE empty (F "f" :@ FT "a") (F "f" :@ FT "a"),
2023-03-04 15:02:51 -05:00
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a = ([a ∷ A] ∷ A) (β)" $
equalE empty
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(E (FT "a" :# FT "A") :# FT "A"),
2023-03-04 15:02:51 -05:00
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a = a (βυ)" $
equalE empty
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(F "a"),
2023-03-04 15:02:51 -05:00
testEq "(λ g ⇒ [g [a]] ∷ ⋯)) [f] = (λ y ⇒ [f [y]] ∷ ⋯) [a] (β↘↙)" $
let a = FT "A"; a2a = (Arr One a a) in
equalE empty
((([< "g"] :\\ E (BV 0 :@ FT "a")) :# Arr One a2a a) :@ FT "f")
((([< "y"] :\\ E (F "f" :@ BVT 0)) :# a2a) :@ FT "a"),
2023-03-04 15:02:51 -05:00
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a <: a" $
subE empty
((([< "x"] :\\ BVT 0) :# (Arr One (FT "A") (FT "A"))) :@ FT "a")
(F "a"),
2023-03-04 15:02:51 -05:00
note "id : A ⊸ A ≔ λ x ⇒ [x]",
testEq "id [a] = a" $ equalE empty (F "id" :@ FT "a") (F "a"),
testEq "id [a] <: a" $ subE empty (F "id" :@ FT "a") (F "a")
],
2023-03-05 06:18:15 -05:00
"dim application" :- [
testEq "eq-AB @0 = eq-AB @0" $
equalE empty (F "eq-AB" :% K Zero) (F "eq-AB" :% K Zero),
testNeq "eq-AB @0 ≠ eq-AB @1" $
equalE empty (F "eq-AB" :% K Zero) (F "eq-AB" :% K One),
testEq "𝑖 | ⊢ eq-AB @𝑖 = eq-AB @𝑖" $
equalED 1
(extendDim "𝑖" empty)
(F "eq-AB" :% BV 0) (F "eq-AB" :% BV 0),
2023-03-05 06:18:15 -05:00
testNeq "𝑖 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
equalED 1
(extendDim "𝑖" empty)
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
2023-03-05 06:18:15 -05:00
testEq "𝑖, 𝑖=0 | ⊢ eq-AB @𝑖 = eq-AB @0" $
equalED 1
(eqDim (BV 0) (K Zero) $ extendDim "𝑖" empty)
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
2023-03-05 06:18:15 -05:00
testNeq "𝑖, 𝑖=1 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
equalED 1
(eqDim (BV 0) (K One) $ extendDim "𝑖" empty)
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
2023-03-05 06:18:15 -05:00
testNeq "𝑖, 𝑗 | ⊢ eq-AB @𝑖 ≠ eq-AB @𝑗" $
equalED 2
(extendDim "𝑗" $ extendDim "𝑖" empty)
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
2023-03-05 06:18:15 -05:00
testEq "𝑖, 𝑗, 𝑖=𝑗 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
equalED 2
(eqDim (BV 0) (BV 1) $ extendDim "𝑗" $ extendDim "𝑖" empty)
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
testEq "𝑖, 𝑗, 𝑖=0, 𝑗=0 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
equalED 2
(eqDim (BV 0) (K Zero) $ eqDim (BV 1) (K Zero) $
extendDim "𝑗" $ extendDim "𝑖" empty)
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
2023-03-05 06:18:15 -05:00
testEq "0=1 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
equalED 2
(extendDim "𝑗" $ extendDim "𝑖" empty01)
2023-03-05 06:18:15 -05:00
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
testEq "eq-AB @0 = A" $ equalE empty (F "eq-AB" :% K Zero) (F "A"),
testEq "eq-AB @1 = B" $ equalE empty (F "eq-AB" :% K One) (F "B"),
testEq "((δ i ⇒ a) ∷ a ≡ a) @0 = a" $
equalE empty
(((DLam $ SN $ FT "a") :# Eq0 (FT "A") (FT "a") (FT "a")) :% K Zero)
(F "a"),
testEq "((δ i ⇒ a) ∷ a ≡ a) @0 = ((δ i ⇒ a) ∷ a ≡ a) @1" $
equalE empty
(((DLam $ SN $ FT "a") :# Eq0 (FT "A") (FT "a") (FT "a")) :% K Zero)
(((DLam $ SN $ FT "a") :# Eq0 (FT "A") (FT "a") (FT "a")) :% K One)
],
2023-01-26 13:54:46 -05:00
2023-02-12 15:30:08 -05:00
"annotation" :- [
2023-03-04 15:02:51 -05:00
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = [f] ∷ A ⊸ A" $
equalE empty
(([< "x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
2023-02-12 15:30:08 -05:00
(FT "f" :# Arr One (FT "A") (FT "A")),
testEq "[f] ∷ A ⊸ A = f" $
equalE empty (FT "f" :# Arr One (FT "A") (FT "A")) (F "f"),
2023-03-04 15:02:51 -05:00
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = f" $
equalE empty
(([< "x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
2023-02-12 15:30:08 -05:00
(F "f")
],
2023-03-26 18:08:48 -04:00
"natural type" :- [
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 10:15:19 -04:00
"natural numbers" :- [
testEq "zero = zero" $ equalT empty Nat Zero Zero,
testEq "succ two = succ two" $
equalT empty Nat (Succ (FT "two")) (Succ (FT "two")),
testNeq "succ two ≠ two" $
equalT empty Nat (Succ (FT "two")) (FT "two"),
testNeq "zero ≠ succ zero" $
equalT empty Nat Zero (Succ Zero),
testEq "0=1 ⊢ zero = succ zero" $
equalT empty01 Nat Zero (Succ Zero)
],
"natural elim" :- [
testEq "caseω 0 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'a" $
equalT empty
(enum ["a", "b"])
(E $ CaseNat Any Zero (Zero :# Nat)
(SN $ enum ["a", "b"])
(Tag "a")
(SN $ Tag "b"))
(Tag "a"),
testEq "caseω 1 return {a,b} of {zero ⇒ 'a; succ _ ⇒ 'b} = 'b" $
equalT empty
(enum ["a", "b"])
(E $ CaseNat Any Zero (Succ Zero :# Nat)
(SN $ enum ["a", "b"])
(Tag "a")
(SN $ Tag "b"))
(Tag "b"),
testEq "caseω 4 return of {0 ⇒ 0; succ n ⇒ n} = 3" $
equalT empty
Nat
(E $ CaseNat Any Zero (makeNat 4 :# Nat)
(SN Nat)
Zero
(SY [< "n", Unused] $ BVT 1))
(makeNat 3)
],
todo "pair types",
"pairs" :- [
testEq "('a, 'b) = ('a, 'b) : {a} × {b}" $
equalT empty
(enum ["a"] `And` enum ["b"])
(Tag "a" `Pair` Tag "b")
(Tag "a" `Pair` Tag "b"),
testNeq "('a, 'b) ≠ ('b, 'a) : {a,b} × {a,b}" $
equalT empty
(enum ["a", "b"] `And` enum ["a", "b"])
(Tag "a" `Pair` Tag "b")
(Tag "b" `Pair` Tag "a"),
testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : {a,b} × {a,b}" $
equalT empty01
(enum ["a", "b"] `And` enum ["a", "b"])
(Tag "a" `Pair` Tag "b")
(Tag "b" `Pair` Tag "a"),
testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : " $
equalT empty01
Nat
(Tag "a" `Pair` Tag "b")
(Tag "b" `Pair` Tag "a")
],
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" :- [
testEq "#0{a} = a" $
equalE empty (CloE (BV 0) (F "a" ::: id)) (F "a"),
2023-02-12 15:30:08 -05:00
testEq "#1{a} = #0" $
2023-03-15 10:54:51 -04:00
equalE (extendTy Any "x" (FT "A") empty)
(CloE (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-03-05 06:18:15 -05:00
note "0·eq-AB : (A ≡ B : ★₀)",
testEq "(eq-AB #0)𝟎 = eq-AB 𝟎" $
equalED 1
(extendDim "𝑖" empty)
2023-03-05 06:18:15 -05:00
(DCloE (F "eq-AB" :% BV 0) (K Zero ::: id))
(F "eq-AB" :% K Zero),
testEq "(eq-AB #0)𝟎 = A" $
equalED 1
(extendDim "𝑖" empty)
(DCloE (F "eq-AB" :% BV 0) (K Zero ::: id)) (F "A"),
2023-03-05 06:18:15 -05:00
testEq "(eq-AB #0)𝟏 = B" $
equalED 1
(extendDim "𝑖" empty)
(DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "B"),
2023-03-05 06:18:15 -05:00
testNeq "(eq-AB #0)𝟏 ≠ A" $
equalED 1
(extendDim "𝑖" empty)
(DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "A"),
2023-03-05 06:18:15 -05:00
testEq "(eq-AB #0)#0,𝟎 = (eq-AB #0)" $
equalED 2
(extendDim "𝑗" $ extendDim "𝑖" empty)
2023-03-05 06:18:15 -05:00
(DCloE (F "eq-AB" :% BV 0) (BV 0 ::: K Zero ::: id))
(F "eq-AB" :% BV 0),
testNeq "(eq-AB #0)𝟎 ≠ (eq-AB 𝟎)" $
equalED 2
(extendDim "𝑗" $ extendDim "𝑖" empty)
2023-03-05 06:18:15 -05:00
(DCloE (F "eq-AB" :% BV 0) (BV 0 ::: K Zero ::: id))
(F "eq-AB" :% K Zero),
2023-02-12 15:30:08 -05:00
testEq "#0𝟎 = #0 # term and dim vars distinct" $
equalED 1
2023-03-15 10:54:51 -04:00
(extendTy Any "x" (FT "A") $ extendDim "𝑖" empty)
(DCloE (BV 0) (K Zero ::: id)) (BV 0),
2023-02-12 15:30:08 -05:00
testEq "a𝟎 = a" $
equalED 1 (extendDim "𝑖" empty) (DCloE (F "a") (K Zero ::: id)) (F "a"),
2023-02-12 15:30:08 -05:00
testEq "(f [a])𝟎 = f𝟎 [a]𝟎" $
2023-02-19 11:51:44 -05:00
let th = K Zero ::: id in
equalED 1 (extendDim "𝑖" empty)
2023-02-12 15:30:08 -05:00
(DCloE (F "f" :@ FT "a") th)
(DCloE (F "f") th :@ DCloT (FT "a") th)
],
"clashes" :- [
2023-02-12 15:30:08 -05:00
testNeq "★₀ ≠ ★₀ ⇾ ★₀" $
equalT empty (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
2023-02-12 15:30:08 -05:00
testEq "0=1 ⊢ ★₀ = ★₀ ⇾ ★₀" $
equalT empty01 (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
todo "others"
2022-04-27 14:06:39 -04:00
]
]