Module fc_subst (wf : fc_wf_sig) (weak : fc_weak_sig) <: fc_subst_sig.
Export wf.
Export weak.
Set Bullet Behavior "Strict Subproofs".
Set Implicit Arguments.
(* --------------------------------------- *)
induction G0; auto; try done.
destruct a as [x s].
intros a b A c H H0.
destruct s; auto; try done.
case H0; try done.
+ move => h0;
simpl_env;
eapply AnnPropWff_weakening with (F:=nil); eauto; simpl_env;
inversion H; subst;
apply (IHG0 _ _ _ c); eauto.
+ destruct H0; subst.
inversion H0; subst.
inversion H; subst.
rewrite_env (nil ++ [(c, Co (Eq a b A))] ++ G0).
eapply AnnPropWff_weakening; eauto.
rewrite_env (nil ++ [(x, Co phi)] ++ G0).
eapply AnnPropWff_weakening; eauto.
simpl.
inversion H; subst.
apply (IHG0 _ _ _ c); auto.
Qed.
(* --------------------------------------- *)
(* Lemma co_subst_fresh : forall G phi a0 x s, AnnPropWff G phi -> AnnCtx ((x ~ s) ++ G) -> tm_subst_tm_constraint a0 x phi = phi. *)
(* --------------------------------------- *)
(* ------------------------------------------- *)
(* In the case of a binding term, prepare the environment in the goal for a use of the induction hypothesis *)
Ltac prepare_env :=
match goal with
[ |- context[ (?x' ~ (?S (?sub ?a1 ?x ?A))) ++ map (?tm_subst_tm_sort ?a1 ?x) ?F ++ ?G ] ] =>
rewrite -app_assoc;
replace (x' ~ (S (sub a1 x A)) ++  map (tm_subst_tm_sort a1 x) F) with
(map (tm_subst_tm_sort a1 x) (x' ~ S A ++ F)); eauto using map_app
end.
(* Find a binding for a prop in a well-formed context and invert it. *)
Ltac binds_PropWff_inversion :=
let wff := fresh in
match goal with
[ bind_c : binds ?c (Co (Eq ?a ?b ?A)) ?G0 |- _ ] =>
move: (@binds_to_AnnPropWff G0 _ _ _ _ ltac:(eauto with ctx_wff) bind_c) => wff;
inversion wff; subst
end.
(* --------------------------------------- *)
(* Convenience lemmas for working with substitution. *)
(* --------------------------------- *)
(* Convenience tactic for applying the coercion lemma above when there is an appropriate hypothesis in the context.  This tactic is useful when the goal is not in the right form for backwards reasoning (i.e. has metavariables in it, doesn't have the substitution at the top.)  *)
Ltac co_subst_hyp :=
match goal with
| [a0 : AnnTyping _ (a_Abs ?rho ?A1 ?b) _  |-  AnnTyping _ (a_Abs ?rho (_ ?A1) (_ ?b)) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [a0 :  AnnTyping _ (a_Pi ?rho ?A1 ?B1) _ |- AnnTyping _ (a_Pi ?rho (_ ?A1) (_ ?B1)) _  ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [a0 : AnnTyping _ (a_CAbs ?phi ?B) _  |- AnnTyping _ (a_CAbs (_ ?phi) (_ ?B)) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [a0 : AnnTyping _ (a_CPi ?phi ?B) _ |- AnnTyping _ (a_CPi (_ ?phi) (_ ?B)) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [ a0 : AnnTyping _ (a_App ?a1 ?rho ?a2) _ |- AnnTyping _ (a_App (_ ?a1) ?rho (_ ?a2)) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [ a0 : AnnTyping _ (a_CApp ?a1 ?g2) _ |- AnnTyping _ (a_CApp (_ ?a1) (_ ?g2)) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [a0 : AnnDefEq _  _ _ (a_CPi ?phi1 ?B1) (a_CPi ?phi2 ?B2)  |-
AnnDefEq _ _ _ (a_CPi (_ ?phi1) _) (a_CPi (_ ?phi2) _) ] =>
eapply AnnDefEq_weaken_available;
eapply (fourth ann_co_substitution_mutual _ _ _ _ _ a0);
eauto
| [a0 : AnnPropWff _ (Eq ?a ?b ?A) |- AnnPropWff _ (Eq (_ ?a) (_ ?b) (_ ?A)) ] =>
eapply (second ann_co_substitution_mutual _ _ a0); eauto
| [ a0 : AnnTyping _ ?a _ |- AnnTyping _ (_ ?a) _ ] =>
eapply (first ann_co_substitution_mutual _ _ _ a0); eauto
| [a0 : AnnDefEq _ _ _ ?a _ |- AnnDefEq _ _ _ (_ ?a) _ ] =>
eapply AnnDefEq_weaken_available;
eapply (fourth ann_co_substitution_mutual _ _ _ _ _ a0);
eauto
| [ a0 : AnnDefEq _ _ ?g _ _ |- AnnDefEq _ _ (_ ?g) _ _ ] =>
eapply AnnDefEq_weaken_available;
eapply (fourth ann_co_substitution_mutual _ _ _ _ _ a0);
eauto
end.
(* 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_co_subst_co := match goal with | [ |- context [co_subst_co_tm ?g ?c _] ] => match goal with | [ |- AnnTyping _ ?a ?A ] => expand (co_subst_co_tm g c) a; expand (co_subst_co_tm g c) A | [ |- AnnDefEq _ _ ?a ?b ] => expand (co_subst_co_tm g c) a; expand (co_subst_co_tm g c) b | [ |- AnnPropWff ?phi ] => expand_constraint (co_subst_co_tm g c) (co_subst_co_constraint g c) phi end end. *)
(* (* Pull a substitution out to prepare for an application of the substution lemma above *)
Ltac un_co_subst_co_tm' C :=
match goal with
| [ |- context [co_subst_co_tm ?g ?c ?a] ] =>
replace C with (co_subst_co_tm g c C); auto
end.
(* This doesn't work. *)
Ltac un_co_subst_co_tm :=
match goal with
| [ |- context [ a_Pi ?rho (co_subst_co_tm ?g ?c ?A1) (co_subst_co_tm ?g ?c ?B1)] ] =>
replace (a_Pi rho (co_subst_co_tm g c A1) (co_subst_co_tm g c B1))
with (co_subst_co_tm (a_Pi rho A1 B1)); auto
| [ |- context[ (Eq (co_subst_co_tm ?g ?c ?a) (co_subst_co_tm ?g ?c ?b)
(co_subst_co_tm ?g ?c ?A)) ] ] =>
replace (Eq (co_subst_co_tm g c a) (co_subst_co_tm g c b)
(co_subst_co_tm g c A)) with
(co_subst_co_constraint g c (Eq a b A)); auto
| [ |- AnnTyping _ _ a_Star ] => un_co_subst_co_tm' a_Star
| [ |- AnnTyping _ a_Star _ ] => un_co_subst_co_tm' a_Star
| [ |- AnnDefEq _ _ a_Star _ _ ] => un_co_subst_co_tm' a_Star
| [ |- AnnDefEq _ _ _ a_Star _ ] => un_co_subst_co_tm' a_Star                                               | [ |- AnnDefEq _ _ _ _ a_Star ] => un_co_subst_co_tm' a_Star
| [ |- AnnTyping (a_Const ?T) _ ] => un_co_subst_co_tm' (a_Const T)
| [ |- AnnTyping _ (a_Const ?T) ] => un_co_subst_co_tm' (a_Const T)
| [ |- AnnTyping (a_Fam ?T) _ ] => un_co_subst_co_tm' (a_Fam T)
| [ |- AnnTyping _ (a_Fam ?T) ] => un_co_subst_co_tm' (a_Fam T)
end.
*)

Lemma ann_co_substitution_mutual2 :
(forall G0 b B, AnnTyping G0 b B -> True) /\
(forall G0 phi, AnnPropWff G0 phi -> True) /\
(forall G0 D0 g1 p1 p2 (H : AnnIso G0 D0 g1 p1 p2),
forall D G g A1 A2 A3 F c, G0 = (F ++ (c ~ Co (Eq A1 A2 A3)) ++ G)
-> AnnDefEq G D g A1 A2
-> c `notin` D0
-> AnnIso (map (co_subst_co_sort g c) F ++ G)
D0
(co_subst_co_co g c g1)
(co_subst_co_constraint g c p1)
(co_subst_co_constraint g c p2)) /\
(forall G0 D0 g1 A B (H : AnnDefEq G0 D0 g1 A B),
forall G D g F c A1 A2 A3, G0 = (F ++ (c ~ Co (Eq A1 A2 A3)) ++ G)
-> AnnDefEq G D g A1 A2
-> c `notin` D0
-> AnnDefEq (map (co_subst_co_sort g c) F ++ G) D0
(co_subst_co_co g c g1)
(co_subst_co_tm g c A) (co_subst_co_tm g c B)) /\
(forall G0, AnnCtx G0 -> True).