Module pres := fc_preservation wf weak subst e_subst.
(* Why does this cause so many messages? *)
Hint Resolve erased_tm_erase : erased.
Definition AnnGood G D := Good (erase_context G) D.
unfold AnnGood. simpl. unfold Good. unfold erased_context.
split. auto.
intros.
unfold binds in H. inversion H.
Qed.
(* --------- Paths infect the cannonical forms lemmas for functions --------- *)
Definition irrelevant G D (a : tm) :=
(forall x A, binds x (Tm A) G -> x `notin` fv_tm (erase a)) /\ AnnGood G D.
(* ------------------------------------- *)
(* This is proved in the preservation file. Lemma reduction_erasure : forall G a a', head_reduction G a a' -> reduction_in_one (erase a) (erase a') \/ erase a = erase a'. *)
(* ------------------------------------- *)
Inductive multi (rel : tm -> tm -> Prop) : tm -> tm -> Prop :=
| multi_refl : forall a, lc_tm a -> multi rel a a
| multi_step : forall a b c, rel a b -> multi rel b c -> multi rel a c.
(* ------------------------------------- *)
(* ------------------------------------- *)
(* ------------------------------------- *)
(* TODO: move elsewhere?  ext_consist for the first two? *)
(* ------------------------------------- *)
(* A specialized version of eauto that only uses the most common lc lemmas to cut down the search space. *)
Ltac eauto_lc := simpl; eauto using AnnTyping_lc1, Value_lc,
AnnDefEq_lc3, AnnPropWff_lc.
(* simple solver for irrelevant goals *)
(* TODO replace args y AA b0 h0 with "fresh" *)
Ltac solve_irrelevant y AA b0 h0 :=
match goal with
[ H1 : irrelevant _ _ _ |- _ ] => inversion H1 end;
match goal with
[ H4 : forall x A, binds x _ _ -> x `notin` _ |- _ ] =>
simpl in H4; econstructor; eauto;
try (intros y AA b0; move: (H4 y AA b0) => h0; fsetdec) end.
Ltac no_paths:=
match goal with
[ EE : erase (a_App ?b0 ?rho ?a) = a_UAbs _ ?b, H : Path ?T ?b0 |- _ ] =>
destruct rho; simpl in EE;
match goal with
[ FF : ?a = a_UAbs _ ?b |- _ ] =>
have P: (Path T a); by eauto using lc_tm_erase end end.
(* Each of the subcases are by induction on a0 to account for top-level coercions on the term. This tactic handles all of the inductive cases. *)
Ltac induction_a0 :=
let IR := fresh  in
let a0' := fresh in
let y := fresh in
let AA := fresh in
let b0 := fresh in
let h0 := fresh in
match goal with
[ IHa0 : ∀ A0 : tm, irrelevant ?G (dom ?G) ?a0 → _,
H1 : irrelevant ?G _ (a_Conv ?a0 ?g),
H2 : AnnTyping ?G (a_Conv ?a0 ?g) ?A0 |- _ ] =>
inversion H2; subst;
(have IR: irrelevant G (dom G) a0 by solve_irrelevant y AA b0 h0);
move: (IHa0 _ IR ltac:(eauto) ltac:(auto)) =>
[a0' [? ?]];
exists (a_Conv a0' g);
split; [ eapply multi_An_ConvTerm; eauto with lc | simpl; auto ]
end.

Lemma reduction_annotation : forall a a',
reduction_in_one a a' ->
forall G a0 A0, irrelevant G (dom G) a0 -> AnnTyping G a0 A0 -> erase a0 = a ->
exists a0', multi (head_reduction G) a0 a0' /\ erase a0' = a'.