Module fc_unique (wf : fc_wf_sig) (subst : fc_subst_sig) <: fc_unique_sig.
Set Bullet Behavior "Strict Subproofs".
Set Implicit Arguments.
(* The typing relation for FC produces unique types. *)
Hint Resolve AnnCtx_uniq.
Hint Rewrite tm_subst_tm_tm_var co_subst_co_co_var.
(* Automatically apply the IH of typing_unique on the specified tm/coercion *)
Ltac apply_ind a :=
match goal with
| H : (forall A2 : tm, AnnTyping ?G a A2 -> ?B = A2), Y : AnnTyping ?G a ?C |- _  =>
apply H in Y; inversion Y
| H : forall A B, AnnDefEq ?G ?D a A B -> ?A1 = A /\ ?B1 = B, Y : AnnDefEq ?G ?D a ?A2 ?B2 |- _ =>
apply H in Y; split_hyp; subst
| H : ∀ q1 q2 : constraint, AnnIso ?G ?D a q1 q2 → ?phi1 = q1 ∧ ?phi2 = q2,
Y : AnnIso ?G ?D a ?q1 ?q2 |- _ =>
apply H in Y; split_hyp; subst
end.
(* Apply induction in the case where we need a "fresh" variable. *)
Ltac apply_ind_var c a :=
match goal with
| H7 : ∀ c : atom,
¬ c `in` ?L0
→ AnnTyping ?G (open_tm_wrt_co a (g_Var_f c)) ?B,
H0 : ∀ c : atom,
¬ c `in` ?L
→ ∀ A2 : tm,
AnnTyping ?G (open_tm_wrt_co a (g_Var_f c)) A2 → ?C = A2 |- _ =>
specialize H7 with c; apply H0 in H7; eauto
| H8 : ∀ x : atom,
¬ x `in` ?L0
→ AnnDefEq ?G ?D (open_co_wrt_tm a (a_Var_f x)) ?B0 ?B5,
H0 : ∀ x : atom,
¬ x `in` ?L
→ ∀ a1 b1 : tm,
AnnDefEq ?G ?D (open_co_wrt_tm a (a_Var_f x)) a1 b1
→ ?B1 = a1 ∧ ?B2  = b1 |- _ =>
specialize H8 with c; edestruct (H0 c); eauto
end.
(* For working with PiCong and AbsCong. Look for hypothses that introduce new equations about the bodies of the terms. (Should be used after induction hypothesis.  *)
Ltac equate_bodies x :=
match goal with
H11 : ∀ x : atom,
¬ x `in` ?L0 → open_tm_wrt_tm ?B4 (a_Var_f x) = open_tm_wrt_tm ?B2 ?C,
e : ∀ x : atom, ¬ x `in` ?L → open_tm_wrt_tm ?B3 (a_Var_f x) =
open_tm_wrt_tm ?B2 ?C
|- _ =>
let FR := fresh in
let FR2 := fresh in
specialize H11 with x;
assert (FR: ¬ x `in` L0); eauto; apply H11 in FR;
specialize e with x;
assert (FR2 : ¬ x `in` L); eauto; apply e in FR2;
rewrite -FR in FR2;
apply open_tm_wrt_tm_inj in FR2; try fsetdec_fast
end.
(* Find matching assumptions about binds, produce an equality EQ between their sorts. *)
Ltac resolve_binds_unique :=
let EQ := fresh in
let h  := fresh in
match goal with
|   b : binds ?c ?A ?G,  H4 : binds ?c ?B ?G  |- _  =>
assert (EQ : uniq G); eauto using AnnCtx_uniq,uniq_an_toplevel;
move: (binds_unique _ _ _ _ _ b H4 EQ) => h; inversion h
end.
Definition AnnTyping_unique := first unique_mutual.
Definition AnnDefEq_unique  := fourth unique_mutual.
Definition AnnIso_unique    := third unique_mutual.
(* These two tactics look for terms in the context that are typed with two different types and automatically applies the uniqueness lemma.  The first tactic uses subst to resolve the equalities. The second tries to only eliminate equations between variables.  *)
Ltac resolve_unique_subst  :=
match goal with
|   _ : AnnTyping ?G ?a ?A,  H :AnnTyping ?G ?a ?B  |- _  =>
assert (A = B); try (eapply (first unique_mutual); eauto 1); subst; clear H
|   H1 : AnnDefEq ?G ?D ?g ?A1 ?B1,  H2 :AnnDefEq ?G ?D ?g ?A2 ?B2  |- _  =>
destruct (fourth unique_mutual _ _ _ _ _ H1 _ _ H2); subst; clear H2
end.
Ltac resolve_unique_nosubst  :=
match goal with
|   H1 : AnnTyping ?G ?a ?A,  H2 :AnnTyping ?G ?a ?B  |- _  =>
assert (A = B); [ eapply (first unique_mutual);
[eapply H1 | eapply H2]|]; subst B; clear H2
|   H1 : AnnDefEq ?G ?D ?g ?A1 ?B1,  H2 :AnnDefEq ?G ?D ?g ?A2 ?B2  |- _  =>
destruct (fourth unique_mutual _ _ _ _ _ H1 _ _ H2);
try subst A2; try subst B2; try subst A1; try subst B1;
clear H2
end.

(* Coerced values and values are terminal. *)
Lemma no_reduction_mutual :
(forall a, CoercedValue a -> forall G b, not (head_reduction G a b)) /\
(forall a, Value a -> forall G b, not (head_reduction G a b)).