Require Export FcEtt.ett_inf_cs.
Require Export FcEtt.ett_ind.
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.

Lemma unique_mutual :
(forall G a A1, AnnTyping G a A1 -> forall {A2}, AnnTyping G a A2 -> A1 = A2) /\
(forall G phi, AnnPropWff G phi -> True) /\
(forall G D g p1 p2, AnnIso G D g p1 p2 -> forall {q1 q2}, AnnIso G D g q1 q2 -> p1 = q1 /\ p2 = q2) /\
(forall G D g a b, AnnDefEq G D g a b -> forall {a1 b1}, AnnDefEq G D g a1 b1 -> a = a1 /\ b = b1) /\
(forall G, AnnCtx G -> True).