(* ------------------------------- Find a better place for these tactics *)
Ltac expand sub_tm tm :=
match tm with
| (a_Abs ?rho (_ ?A1) (_ ?b)) =>
replace (a_Abs rho (sub_tm A1) (sub_tm b)) with (sub_tm (a_Abs rho A1 b)); auto
| (a_Pi ?rho (_ ?A1) (_ ?B1)) =>
replace (a_Pi rho (sub_tm A1) (sub_tm B1)) with (sub_tm (a_Pi rho A1 B1)); auto
| (a_CAbs (?sc ?phi) (_ ?B)) =>
replace (a_CAbs (sc phi) (sub_tm B)) with (sub_tm (a_CAbs phi B)); auto
| (a_CPi (?sc ?phi) (_ ?B)) =>
replace (a_CPi (sc phi) (sub_tm B)) with (sub_tm (a_CPi phi B)); auto
| a_Star => replace a_Star with (sub_tm a_Star); auto
| _ => idtac
end.
Ltac expand_constraint sub_tm sub_constraint constraint :=
match constraint with
| (Eq (_ _ _ ?a) (_ _ _  ?b) (_ _ _ ?A)) =>
replace (Eq (sub_tm a) (sub_tm b) (sub_tm A)) with
(sub_constraint (Eq a b A)); auto
| _ => idtac
end.
Ltac un_subst_tm :=
match goal with
| [ |- context [tm_subst_tm_tm ?g ?c _] ] =>
match goal with
| [ |- Typing _ ?a ?A ] => expand (tm_subst_tm_tm g c) a; expand (tm_subst_tm_tm g c) A
| [ |- DefEq _ _ ?a ?b ] => expand (tm_subst_tm_tm g c) a; expand (tm_subst_tm_tm g c) b
| [ |- PropWff ?phi ] => expand_constraint (tm_subst_tm_tm g c) (tm_subst_tm_constraint g c) phi
end
| [ |- context [co_subst_co_tm ?g ?c _] ] =>
match goal with
| [ |- Typing _ ?a ?A ] => expand (co_subst_co_tm g c) a; expand (co_subst_co_tm g c) A
| [ |- DefEq _ _ ?a ?b ] => expand (co_subst_co_tm g c) a; expand (co_subst_co_tm g c) b
| [ |- PropWff ?phi ] => expand_constraint (co_subst_co_tm g c) (co_subst_co_constraint g c) phi
end
end.
(* --------------------------------------------------------------- *)

(* Specifications: *)
Lemma Typing_regularity : forall e A G, Typing G e A -> Typing G A a_Star.
(* --------------------------------------------------- *)
Lemma refl_iso: forall G D phi, PropWff G phi -> Iso G D phi phi.
Lemma sym_iso: forall G D phi1 phi2, Iso G D phi1 phi2 -> Iso G D phi2 phi1.
(* --------------------------------------------------- *)
Lemma invert_a_UAbs:
forall G rho A b0,
Typing G (a_UAbs rho b0) A
-> exists A1 B1, DefEq G (dom G) A (a_Pi rho A1 B1) a_Star
/\ (exists L, forall x, x `notin` L ->
Typing ([(x, Tm A1)] ++ G)
(open_tm_wrt_tm b0 (a_Var_f x))
(open_tm_wrt_tm B1 (a_Var_f x))
/\ Typing ([(x, Tm A1)] ++ G)
(open_tm_wrt_tm B1 (a_Var_f x)) a_Star
/\ RhoCheck rho x (open_tm_wrt_tm b0 (a_Var_f x)))
/\ Typing G A1 a_Star.
Lemma invert_a_UCAbs: forall G A b0,
Typing G (a_UCAbs b0) A ->
exists a b T B1, PropWff G (Eq a b T) /\ DefEq G (dom G) A (a_CPi (Eq a b T) B1) a_Star
/\ (exists L, forall c, c `notin` L ->
Typing ([(c, Co (Eq a b T))] ++ G)
(open_tm_wrt_co b0 (g_Var_f c)) (open_tm_wrt_co B1 (g_Var_f c))
/\ Typing ([(c, Co (Eq a b T))] ++ G) (open_tm_wrt_co B1 (g_Var_f c)) a_Star).
Lemma invert_a_App_Rel : forall G a b C,
Typing G (a_App a Rel b) C ->
exists A B, Typing G a (a_Pi Rel A B) /\
Typing G b A /\
DefEq G (dom G) C (open_tm_wrt_tm B b) a_Star.
Lemma invert_a_App_Irrel : forall G a b C,
Typing G (a_App a Irrel b) C ->
exists A B b0, Typing G a (a_Pi Irrel A B) /\
Typing G b0 A /\
DefEq G (dom G) C (open_tm_wrt_tm B b0) a_Star.
Lemma invert_a_CApp : forall G a g A,
Typing G (a_CApp a g) A ->
g = g_Triv /\
exists a1 b1 A1 B, Typing G a (a_CPi (Eq a1 b1 A1) B) /\
DefEq G (dom G) a1 b1 A1 /\
DefEq G (dom G) A (open_tm_wrt_co B g_Triv) a_Star.