Module ext_invert (subst : ext_subst_sig) <: ext_invert_sig.
Include subst.
Set Bullet Behavior "Strict Subproofs".
Set Implicit Arguments.
(* ------------------------------- 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.
(* --------------------------------------------------------------- *)
(* --------------------------------------------------- *)
(* --------------------------------------------------- *)
(* --------------------------------------------------- *)
Inductive context_DefEq : available_props -> context -> context -> Prop :=
| Nul_Eqcontext: forall D, context_DefEq D nil nil
| Factor_Eqcontext_tm: forall G1 G2 D A A' x,
context_DefEq D G1 G2 ->
DefEq G1 D A A' a_Star ->
DefEq G2 D A A' a_Star ->
context_DefEq D ([(x, Tm A)] ++ G1) ([(x, Tm A')] ++ G2)
| Factor_Eqcontext_co: forall D G1 G2 Phi1 Phi2 c,
context_DefEq D G1 G2 ->
Iso G1 D Phi1 Phi2 ->
Iso G2 D Phi1 Phi2 ->
context_DefEq D ([(c, Co Phi1)] ++ G1) ([(c, Co Phi2)] ++ G2).
Hint Constructors context_DefEq.
(* -------------------------------------------------------------- *)
(* ----------------------------------------------------------------------------- *)

(* could also be an exists form *)
Lemma E_Pi2 : forall L G rho A B,
(∀ x : atom, x `notin` L → Typing ([(x, Tm A)] ++ G) (open_tm_wrt_tm B (a_Var_f x)) a_Star) ->
Typing G (a_Pi rho A B) a_Star.