type-case

tests/TermImpls.idr

@@ -115,6 +115,19 @@ mutual
     (tm1 :# ty1) == (tm2 :# ty2) = tm1 == tm2 && ty1 == ty2
     (_ :# _) == _ = False
 
+    TypeCase ty1 ret1 univ1 pi1 sig1 enum1 eq1 nat1 box1
+      ==
+    TypeCase ty2 ret2 univ2 pi2 sig2 enum2 eq2 nat2 box2 =
+      ty1 == ty2 && ret1 == ret2 &&
+      pi1.term == pi2.term &&
+      sig1.term == sig2.term &&
+      enum1 == enum2 &&
+      eq1.term == eq2.term &&
+      nat1 == nat2 &&
+      box1.term == box2.term
+
+    TypeCase {} == _ = False
+
     CloE el1 th1 == CloE el2 th2 =
       case eqSubstLen th1 th2 of
            Just Refl => el1 == el2 && th1 == th2

tests/Tests/PrettyTerm.idr

@@ -138,8 +138,8 @@ tests = "pretty printing terms" :- [
   "case" :- [
     testPrettyE [<] [<]
       (CasePair One (F "a") (SN $ TYPE 1) (SN $ TYPE 0))
-      "case1 a return _ ⇒ ★₁ of { (_, _) ⇒ ★₀ }"
-      "case1 a return _ => Type1 of { (_, _) => Type0 }",
+      "case1 a return ★₁ of { (_, _) ⇒ ★₀ }"
+      "case1 a return Type1 of { (_, _) => Type0 }",
     testPrettyT [<] [<]
       ([< "u"] :\\
         E (CaseEnum One (F "u")
@@ -152,6 +152,35 @@ tests = "pretty printing terms" :- [
       """
   ],
 
+  "type-case" :- [
+    testPrettyE [<] [<]
+      {label = "type-case ℕ ∷ ★₀ return ★₀ of { ⋯ }"}
+      (TypeCase (Nat :# TYPE 0) (TYPE 0) Nat (SN Nat) (SN Nat) Nat
+        (SN Nat) Nat (SN Nat))
+      """
+        type-case ℕ ∷ ★₀ return ★₀ of {
+          ★            ⇒ ℕ;
+          (_ → _)      ⇒ ℕ;
+          (_ × _)      ⇒ ℕ;
+          {}           ⇒ ℕ;
+          Eq _ _ _ _ _ ⇒ ℕ;
+          ℕ            ⇒ ℕ;
+          [_]          ⇒ ℕ
+        }
+      """
+      """
+        type-case Nat :: Type0 return Type0 of {
+          Type         => Nat;
+          (_ -> _)     => Nat;
+          (_ ** _)     => Nat;
+          {}           => Nat;
+          Eq _ _ _ _ _ => Nat;
+          Nat          => Nat;
+          [_]          => Nat
+        }
+      """
+  ],
+
   "annotations" :- [
     testPrettyE [<] [<] (FT "a" :# FT "A") "a ∷ A" "a :: A",
     testPrettyE [<] [<]

tests/Tests/Typechecker.idr

@@ -448,6 +448,14 @@ tests = "typechecker" :- [
   todo "box values",
   todo "box elim",
 
+  "type-case" :- [
+    testTC "0 · type-case ℕ ∷ ★₀ return ★₀ of { _ ⇒ ℕ } ⇒ ★₀" $
+      inferAs empty szero
+        (TypeCase (Nat :# TYPE 0) (TYPE 0) Nat (SN Nat) (SN Nat) Nat
+          (SN Nat) Nat (SN Nat))
+        (TYPE 0)
+  ],
+
   "misc" :- [
     note "0·A : Type, 0·P : A → Type, ω·p : (1·x : A) → P x",
     note "⊢",