quox/tests/Tests/Equal.idr

module Tests.Equal

import Quox.Equal
import Quox.Typechecker
import public TypingImpls
import TAP
import Quox.EffExtra
import AstExtra


defGlobals : Definitions
defGlobals = fromList
  [("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 ())
           {default defGlobals globals : Definitions}
  testEq : Test
  testEq = test label $ runEqual globals act

  testNeq : Test
  testNeq = testThrows label (const True) $ runTC globals act $> "()"


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

  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


export
tests : Test
tests = "equality & subtyping" :- [
  note #""s{t,…}" for term substs; "s‹p,…›" for dim substs"#,
  note #""0=1 ⊢ 𝒥" means that 𝒥 holds in an inconsistent dim context"#,

  "universes" :- [
    testEq "★₀ = ★₀" $
      equalT empty (^TYPE 1) (^TYPE 0) (^TYPE 0),
    testNeq "★₀ ≠ ★₁" $
      equalT empty (^TYPE 2) (^TYPE 0) (^TYPE 1),
    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)
  ],

  "function types" :- [
    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,
    note "incompatible quantities",
    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" :- [
    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")
  ],

  "eq type" :- [
    testEq "(★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : ★₁)" $
      let tm = ^Eq0 (^TYPE 1) (^TYPE 0) (^TYPE 0) in
      equalT empty (^TYPE 2) tm tm,
    testEq "A ≔ ★₁ ⊢ (★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : A)"
        {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)),
    todo "dependent equality types"
  ],

  "equalities and uip" :-
  let refl : Term d n -> Term d n -> Elim d n
      refl a x = ^Ann (^DLam (SN x)) (^Eq0 a x x)
  in
  [
    note "binds before ∥ are globals, after it are BVs",
    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")),

    testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ∥ ⊢ p = q  (free)"
           {globals =
              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"),

    testEq "∥ x : (a ≡ a' : A), y : (a ≡ a' : A) ⊢ x = y  (bound)" $
      let ty : forall n. Term 0 n := ^Eq0 (^FT "A") (^FT "a") (^FT "a'") in
      equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
        (^BV 0) (^BV 1),

    testEq "∥ x : (a ≡ a' : A) ∷ Type 0, y : [ditto] ⊢ x = y" $
      let ty : forall n. Term 0 n :=
            E $ ^Ann (^Eq0 (^FT "A") (^FT "a") (^FT "a'")) (^TYPE 0) in
      equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
        (^BV 0) (^BV 1),

    testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
           {globals = defGlobals `mergeLeft` fromList
              [("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),

    testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
           {globals = defGlobals `mergeLeft` fromList
              [("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),

    testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
           {globals = defGlobals `mergeLeft` fromList
              [("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),

    testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
           {globals = defGlobals `mergeLeft` fromList
              [("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
      equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
        (^BV 0) (^BV 1),

    testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : E×E ⊢ x = y"
           {globals = defGlobals `mergeLeft` fromList
              [("E", ^mkDef gzero (^TYPE 0)
                      (^Eq0 (^FT "A") (^FT "a") (^FT "a'"))),
               ("W", ^mkDef gzero (^TYPE 0) (^And (^FT "E") (^FT "E")))]} $
      equalE
        (extendTyN [< (Any, "x", ^FT "W"),
                      (Any, "y", ^And (^FT "E") (^FT "E"))] empty)
        (^BV 0) (^BV 1)
  ],

  "term closure" :- [
    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"))
  ],

  "term d-closure" :- [
    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")),
    note "it is hard to think of well-typed terms with big dctxs"
  ],

  "free var" :-
  let au_bu = fromList
        [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
         ("B", ^mkDef gany (^TYPE 1) (^TYPE 0))]
      au_ba = fromList
        [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
         ("B", ^mkDef gany (^TYPE 1) (^FT "A"))]
  in [
    testEq "A = A" $
      equalE empty (^F "A") (^F "A"),
    testNeq "A ≠ B" $
      equalE empty (^F "A") (^F "B"),
    testEq "0=1 ⊢ A = B" $
      equalE empty01 (^F "A") (^F "B"),
    testEq "A : ★₁ ≔ ★₀ ⊢ A = (★₀ ∷ ★₁)" {globals = au_bu} $
      equalE empty (^F "A") (^Ann (^TYPE 0) (^TYPE 1)),
    testEq "A : ★₁ ≔ ★₀ ⊢ A = ★₀" {globals = au_bu} $
      equalT empty (^TYPE 1) (^FT "A") (^TYPE 0),
    testEq "A ≔ ★₀, B ≔ ★₀ ⊢ A = B" {globals = au_bu} $
      equalE empty (^F "A") (^F "B"),
    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"
        {globals = fromList [("A", ^mkDef gany (^TYPE 3) (^TYPE 0)),
                             ("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
      subE empty (^F "A") (^F "B"),
    note "(A and B in different universes)",
    testEq "A : ★₁ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
        {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" :- [
    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" :- [
    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
        (^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
        (^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
        (^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
        (^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")
  ],

  "dim application" :- [
    testEq "eq-AB @0 = eq-AB @0" $
      equalE empty
        (^DApp (^F "eq-AB") (^K Zero))
        (^DApp (^F "eq-AB") (^K Zero)),
    testNeq "eq-AB @0 ≠ eq-AB @1" $
      equalE empty
        (^DApp (^F "eq-AB") (^K Zero))
        (^DApp (^F "eq-AB") (^K One)),
    testEq "𝑖 | ⊢ eq-AB @𝑖 = eq-AB @𝑖" $
      equalE
        (extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 0))
        (^DApp (^F "eq-AB") (^BV 0)),
    testNeq "𝑖 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
      equalE (extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 0))
        (^DApp (^F "eq-AB") (^K Zero)),
    testEq "𝑖, 𝑖=0 | ⊢ eq-AB @𝑖 = eq-AB @0" $
      equalE (eqDim (^BV 0) (^K Zero) $ extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 0))
        (^DApp (^F "eq-AB") (^K Zero)),
    testNeq "𝑖, 𝑖=1 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
      equalE (eqDim (^BV 0) (^K One) $ extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 0))
        (^DApp (^F "eq-AB") (^K Zero)),
    testNeq "𝑖, 𝑗 | ⊢ eq-AB @𝑖 ≠ eq-AB @𝑗" $
      equalE (extendDim "𝑗" $ extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 1))
        (^DApp (^F "eq-AB") (^BV 0)),
    testEq "𝑖, 𝑗, 𝑖=𝑗 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
      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 @𝑗" $
      equalE
        (eqDim (^BV 0) (^K Zero) $ eqDim (^BV 1) (^K Zero) $
          extendDim "𝑗" $ extendDim "𝑖" empty)
        (^DApp (^F "eq-AB") (^BV 1))
        (^DApp (^F "eq-AB") (^BV 0)),
    testEq "0=1 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
      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" $
      equalE empty
        (^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" $
      equalE empty
        (^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))
  ],

  "annotation" :- [
    testEq "(λ x ⇒ f x) ∷ 1.A → A = f ∷ 1.A → A" $
      equalE empty
        (^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
        (^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")
  ],

  "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 [])
  ],

  "natural numbers" :- [
    testEq "0 = 0" $ 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 "0 ≠ 1" $
      equalT empty (^Nat) (^Zero) (^Succ (^Zero)),
    testEq "0=1 ⊢ 0 = 1" $
      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 (^Ann (^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 (^Ann (^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 (^Ann (^makeNat 4) (^Nat))
          (SN $ ^Nat)
          (^Zero)
          (SY [< "n", ^BN Unused] $ ^BVT 1))
        (^makeNat 3)
  ],

  todo "pair types",

  "pairs" :- [
    testEq "('a, 'b) = ('a, 'b) : {a} × {b}" $
      equalT empty
        (^And (^enum ["a"]) (^enum ["b"]))
        (^Pair (^Tag "a") (^Tag "b"))
        (^Pair (^Tag "a") (^Tag "b")),
    testNeq "('a, 'b) ≠ ('b, 'a) : {a,b} × {a,b}" $
      equalT empty
        (^And (^enum ["a", "b"]) (^enum ["a", "b"]))
        (^Pair (^Tag "a") (^Tag "b"))
        (^Pair (^Tag "b") (^Tag "a")),
    testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : {a,b} × {a,b}" $
      equalT empty01
        (^And (^enum ["a", "b"]) (^enum ["a", "b"]))
        (^Pair (^Tag "a") (^Tag "b"))
        (^Pair (^Tag "b") (^Tag "a")),
    testEq "0=1 ⊢ ('a, 'b) = ('b, 'a) : ℕ" $
      equalT empty01
        (^Nat)
        (^Pair (^Tag "a") (^Tag "b"))
        (^Pair (^Tag "b") (^Tag "a"))
  ],

  todo "pair elim",

  todo "enum types",
  todo "enum",
  todo "enum elim",

  todo "box types",
  todo "boxes",
  todo "box elim",

  "elim closure" :- [
    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)
  ],

  "elim d-closure" :- [
    note "bold numbers for de bruijn indices",
    note "0·eq-AB : (A ≡ B : ★₀)",
    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 "a‹0› = a" $
      equalE empty
        (DCloE (Sub (^F "a") (^K Zero ::: id))) (^F "a"),
    testEq "(f a)‹0› = f‹0› a‹0›" $
      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)))
  ],

  "clashes" :- [
    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"
  ]
]