Module ext_subst (weak : ext_weak_sig) <: ext_subst_sig.
Include weak.
induction G2; [ | inversion 1]; simpl; auto.
Qed.
(* Rewrite the context in to the appropriate form for the induction hypothesis (in the cases with binding). This rewriting is specific for substitution lemmas. *)
Ltac rewrite_subst_context :=
match goal with
| [ |- context [([(?y, ?C (_ _ _ ?T))] ++ map ?sub ?F ++ ?G0)] ] =>
rewrite_env (map sub ((y ~ (C T)) ++ F) ++ G0)
end.
(* These are constructors for the E judgements that - do not bind variables - are syntax directed - are not variables Therefore, they are safe to just use in the substitution lemmas below. *)
Ltac eapply_E_subst :=
first [ eapply E_Star     |
eapply E_App      |
eapply E_IApp     |
eapply E_CApp     |
eapply E_Const    |
eapply E_IsoConv  |
eapply E_AppCong  |
eapply E_IAppCong |
eapply E_CAppCong |
eapply E_PiSnd    |
eapply E_CPiSnd].
eapply typing_wff_iso_defeq_mutual;
intros; subst; simpl. Focus 23. destruct rho. Unfocus.
all: try first [ E_pick_fresh y; autorewrite with subst_open_var; eauto 2 with lc;
try rewrite_subst_context; eauto 3 |
autorewrite with subst_open; eauto 2 with lc ].
all: try solve [econstructor; simpl in *; eauto 2].
all: try eapply_E_subst.
all: try solve [eapply subst_rho; eauto 2].
all: try solve [eapply_first_hyp; eauto].
all: try solve [eapply DefEq_weaken_available; eauto].
- destruct (x == x0).
+ subst.
assert (HA: Tm A = Tm A0). eapply binds_mid_eq; eauto.
inversion HA. subst.
assert (S : tm_subst_tm_tm a x0 A0 = A0). eapply tm_subst_fresh_1. eauto.
apply Ctx_strengthen with (G2 := F). eauto.
rewrite S.
rewrite_env (nil ++ map (tm_subst_tm_sort a x0) F ++ G0).
eapply Typing_weakening; eauto 2. simpl_env.
apply (H _ _ A0); auto.
+ apply binds_remove_mid in b; auto.
destruct (binds_app_1 _ _ _ _ _ b).
(* after x *)
eapply E_Var; eauto.
eapply binds_app_2.
assert (EQ : tm_subst_tm_sort a x0 (Tm A) = Tm (tm_subst_tm_tm a x0 A)). auto.
rewrite <- EQ.
eapply binds_map_2. auto.
(* before x *)
eapply E_Var; eauto.
apply Ctx_strengthen in c.
assert (EQ: tm_subst_tm_tm a x0 A = A). eapply tm_subst_fresh_1.
eapply E_Var.
eapply Ctx_strengthen. eauto. eauto. eauto.
rewrite EQ.
eauto.
- (* conversion *)
econstructor; try eapply DefEq_weaken_available; eauto.
- have h0: Typing nil A a_Star by eauto using toplevel_closed.
eapply tm_subst_fresh_2 with (x:=x )in h0; eauto.
erewrite h0. auto.
- have h0: Typing nil A a_Star.  eapply toplevel_to_const; eauto.
erewrite tm_subst_fresh_2; eauto.
-
have h0: Typing nil a A by eauto using toplevel_closed.
eapply E_Fam with (a:= tm_subst_tm_tm a0 x a); eauto.
erewrite (tm_subst_fresh_2 _ h0); auto.
erewrite (tm_subst_fresh_1 _ h0); auto.
erewrite (tm_subst_fresh_1 _ h0); auto.
- destruct (c == x).
+ subst.
apply binds_mid_eq in b0; auto; try done.
+ apply binds_remove_mid in b0; auto.
destruct (binds_app_1 _ _ _ _ _ b0).
* apply (E_Assn _ D _ _ _ c); auto.
by apply (H _ _ A0).
have:  binds c (Co (Eq (tm_subst_tm_tm a0 x a) (tm_subst_tm_tm a0 x b) (tm_subst_tm_tm a0 x A))) (map (tm_subst_tm_sort a0 x) F); auto.
apply bind_map_tm_subst_tm_sort; auto.
* apply (E_Assn _ D _ _ _ c); auto.
by apply (H _ _ A0).
have: Ctx ([(x, Tm A0)] ++ G0) by apply (Ctx_strengthen _ F); auto.
inversion 1; subst.
have: PropWff G0 (Eq a b A) by apply (binds_to_PropWff _ _ _ c); auto.
inversion 1; subst.
repeat rewrite tm_subst_tm_tm_fresh_eq; auto.
-- move: (Typing_context_fv H10) => ?. split_hyp. auto.
-- move: (Typing_context_fv H10) => ?. split_hyp. auto.
-- move: (Typing_context_fv H9) => ?. split_hyp. auto.
- eapply E_Beta; eauto.
eapply Beta_tm_subst; eauto with lc.
- eapply E_EqConv; eauto 2.
eapply DefEq_weaken_available; eauto.
- have h0: (y <> x) by eauto.
rewrite e; eauto.
simpl; destruct eq_dec; try done.
(* Left/Right.  Do not remove - eapply E_LeftRel with (b := tm_subst_tm_tm a0 x b) (b':= tm_subst_tm_tm a0 x b'); eauto 2. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply Path_tm_subst_tm_tm; eauto 2 with lc. autorewrite with open_subst; eauto 2 with lc. autorewrite with open_subst; eauto 2 with lc. eapply DefEq_weaken_available; eauto 2.  - eapply E_LeftIrrel with (b := tm_subst_tm_tm a0 x b) (b':= tm_subst_tm_tm a0 x b'); eauto 2. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply Path_tm_subst_tm_tm; eauto 2 with lc. autorewrite with open_subst; eauto 2 with lc. eapply H3; eauto. autorewrite with open_subst; eauto 2 with lc. eapply DefEq_weaken_available; eauto 2. - eapply E_Right with (a := tm_subst_tm_tm a0 x a) (a':= tm_subst_tm_tm a0 x a'); eauto 2. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply H; eauto 2. eapply H1; eauto 2. autorewrite with open_subst; eauto 2 with lc. autorewrite with open_subst; eauto 2 with lc. eapply DefEq_weaken_available; eauto 2. - eapply E_CLeft; eauto 2. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply Path_tm_subst_tm_tm; eauto 2 with lc. eapply H; eauto 2. eapply H0; eauto 2. eapply DefEq_weaken_available; eauto 2. replace g_Triv with (tm_subst_tm_co a0 x g_Triv). autorewrite with open_subst; eauto 2 with lc. auto.  *)
- have h0: (y <> x) by eauto.
rewrite e; eauto.
- have h0: (y <> x) by eauto.
rewrite e; eauto.
- destruct  F; try done.
- induction F; try done.
simpl; simpl in H2.
inversion H2; subst; auto.
destruct a0.
destruct s.
+ simpl.
apply E_ConsTm; auto.
* simpl in H2.
inversion H2.
apply (H _ _ _ H1); auto.
* simpl in H0.
inversion H2; subst; clear H2.
apply (H0 _ _ _ H1); auto.
* inversion H2; subst; clear H2; auto.
+ inversion H2.
- inversion H2; subst; clear H2.
induction F; try done.
destruct a0.
destruct s.
+ simpl; subst.
inversion H4.
+ simpl; subst.
apply E_ConsCo; auto.
* apply (H _ _ _ H1); auto.
inversion H4; auto.
* inversion H4; subst; clear H4.
apply (H0 _ _ A); auto.
* inversion H4; subst; clear H4.
auto.
Qed.

Lemma co_substitution_mutual :
(forall G0 b B (H : Typing G0 b B),
forall G D A1 A2 T F c ,
G0 = (F ++ (c ~ Co (Eq A1 A2 T) ) ++ G)
-> DefEq G D A1 A2 T
-> Typing (map (co_subst_co_sort g_Triv c) F ++ G) (co_subst_co_tm g_Triv c b) (co_subst_co_tm g_Triv c B)) /\
(forall G0 phi (H : PropWff G0 phi),
forall G D A1 A2 T F c,
G0 = (F ++ (c ~ Co (Eq A1 A2 T) ) ++ G)
-> DefEq G D A1 A2 T
-> PropWff (map (co_subst_co_sort g_Triv c) F ++ G) (co_subst_co_constraint g_Triv c phi)) /\
(forall G0 D0 p1 p2 (H : Iso G0 D0 p1 p2),
forall G D A1 A2 T F c,
G0 = (F ++ (c ~ Co (Eq A1 A2 T) ) ++ G)
-> DefEq G D A1 A2 T
-> Iso (map (co_subst_co_sort g_Triv c) F ++ G) (union D (remove c D0))
(co_subst_co_constraint g_Triv c p1)
(co_subst_co_constraint g_Triv c p2)) /\
(forall G0 D0 A B T (H : DefEq G0 D0 A B T),
forall G D F c A1 A2 T1,
G0 = (F ++ (c ~ Co (Eq A1 A2 T1) ) ++ G)
-> DefEq G D A1 A2 T1
-> DefEq (map (co_subst_co_sort g_Triv c) F ++ G) (union D (remove c D0))
(co_subst_co_tm g_Triv c A) (co_subst_co_tm g_Triv c B)
(co_subst_co_tm g_Triv c T)) /\
(forall G0 (H : Ctx G0),
forall G D F c A1 A2 T,
G0 = (F ++ (c ~ Co (Eq A1 A2 T) ) ++ G)
-> DefEq G D A1 A2 T
-> Ctx (map (co_subst_co_sort g_Triv c) F ++ G)).