(* ----------------------------------------------------- *)

(* lc support

   These are some general purpose tactics for solving local closure
   goals. The are used in the lc_mutual proofs, but may also
   be useful elsewhere in the development.

   These tactics generally support forward reasoning which is
   useful for exploratory proof development.

*)

(* apply a lc constructor for a term with binding. *)
Ltac apply_lc_exists x :=
  pick fresh x;
  ( apply lc_a_Abs_exists      with (x1 := x)
  || apply lc_a_Pi_exists       with (x1 := x)
  || apply lc_a_CPi_exists      with (c1 := x)
  || apply lc_a_CAbs_exists     with (c1 := x)
  || apply lc_a_UAbs_exists     with (x1:= x)
  || apply lc_a_UCAbs_exists    with (c1 := x)
  || apply lc_g_PiCong_exists   with (x1 := x)
  || apply lc_g_AbsCong_exists  with (x1 := x)
  || apply lc_g_CPiCong_exists  with (c1 := x)
  || apply lc_g_CAbsCong_exists with (c1 := x)
  || fail "invalid case for apply_lc_exists" );
  eauto 2.Ltac apply_lc_body :=
  match goal with
  | |- lc_tm (open_tm_wrt_tm ?a ?b) => eapply lc_body_tm_wrt_tm; auto
  | |- lc_tm (open_tm_wrt_co ?a ?b) => eapply lc_body_tm_wrt_co; auto
  end.(* --------------------------------------------------------- *)

Ltac invert_syntactic_equality :=
  repeat match goal with
  | [ H : a_Var_f _  = a_Var_f _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_Abs _ _ = a_Abs _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_UAbs _ _ = a_UAbs _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_Pi _ _ _ = a_Pi _ _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_App _ _ _ = a_App _ _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_Fam _  = a_Fam _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_Const _  = a_Const _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_Conv _ _ = a_Conv _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_UCAbs _ = a_UCAbs _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_CAbs + _ = a_CAbs _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_CApp _ _  = a_CApp _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : a_CPi _ _ = a_CPi _ _ |- _ ] =>
    inversion H; subst; clear H
  | [ H : Eq _ _ _ = Eq _ _ _ |- _ ] =>
    inversion H; subst; clear H
  end.(* --------------------------------------------------- *)
(* --------------------------------------------------- *)

(* Induction schemes *)

Scheme typing_ind' := Induction for Typing Sort Prop
   with wff_ind'   := Induction for PropWff Sort Prop
   with iso_ind'   := Induction for Iso Sort Prop
   with defeq_ind' := Induction for DefEq Sort Prop
   with ctx_ind'   := Induction for Ctx Sort Prop.Combined Scheme typing_wff_iso_defeq_mutual from typing_ind', wff_ind', iso_ind', defeq_ind', ctx_ind'.Scheme ann_typing_ind' := Induction for AnnTyping Sort Prop
   with ann_wff_ind'   := Induction for AnnPropWff Sort Prop
   with ann_iso_ind'   := Induction for AnnIso Sort Prop
   with ann_defeq_ind' := Induction for AnnDefEq Sort Prop
   with ann_ctx_ind'   := Induction for AnnCtx Sort Prop.Combined Scheme ann_typing_wff_iso_defeq_mutual
from ann_typing_ind', ann_wff_ind', ann_iso_ind',
     ann_defeq_ind', ann_ctx_ind'.Scheme CoercedValue_ind' := Induction for CoercedValue Sort Prop
                            with Value_ind' := Induction for Value Sort Prop.Combined Scheme CoercedValue_Value_mutual from CoercedValue_ind', Value_ind'.Ltac ensure_case C :=
  match goal with [ CON := C : ?A |- _ ] => idtac end.`notin` ?L) → _ _ (g_Var_f c) = a_CApp _ _ |- _ ] =>
    rewrite e; auto

  end.



(* Solver for the two lc_mutual proofs. *)
Ltac lc_solve :=
  let c := fresh in
  try lc_solve_binds;
  try apply_lc_exists c;
  lc_inversion cuto_rew_env :=
  multimatch goal with
    | [ |- context [([(?x, ?T)] ++ ?G1 ++ ?G2 ++ ?G3)] ] => rewrite_env (((x ~ (T)) ++ G1) ++ G2 ++ G3)
  end.


(* -------------- Pick fresh and apply for judgements with binding ----- *)

Ltac E_pick_fresh x :=
  match goal with
    | [ |- Typing _ ?shape _ ] =>
      let v := match shape with
            | a_Pi _ _ _ => E_Pi
            | a_UAbs _ _ => E_Abs
            | a_CPi _ _  => E_CPi
            | a_CAbs _ _ => E_CAbs
            | a_UCAbs _  => E_CAbs
           end
      in pick fresh x and apply v
    | [ |- DefEq _ _ ?shape ?s2 _ ] =>
      let v := match shape with
               | a_Pi _ _ _ => E_PiCong
               | a_UAbs Rel _ => match s2 with
                                | a_UAbs _ _ => E_AbsCong
                                | _ => E_EtaRel
                                end
               | a_UAbs Irrel _ => match s2 with 
                                | a_UAbs _ _ =>  E_AbsCong
                                | _ => E_EtaIrrel
                                end
               | a_CPi _ _  => E_CPiCong
               | a_CAbs _ _ => E_CAbsCong
               | a_UCAbs _  => match s2 with 
                                | a_UCAbs _ =>  E_CAbsCong
                                | _ => E_EtaCend
               end
      in pick fresh x and apply v
  end.

Ltac Par_pick_fresh x :=
  match goal with
    | [ |- Par _ _ ?shape ?s2 ] =>
      let v := match shape with
            | a_Pi _ _ _ => Par_Pi
            | a_UAbs Rel _ =>  match s2 with
                                | a_UAbs _ _ => Par_Abs
                                | _ => Par_Eta
                                end
            | a_UAbs Irrel _ =>  match s2 with
                                | a_UAbs _ _ => Par_Abs
                                | _ => Par_EtaIrrel
                                end
            | a_UAbs _ _ =>  Par_Abs
            | a_CPi _ _  => Par_CPi
            | a_CAbs _ _ => Par_CAbs
            | a_UCAbs _  => match s2 with
                                | a_UCAbs _ => Par_CAbs
                                | _ => Par_EtaCend
           end
      in pick fresh x and apply v
  end.



Ltac An_pick_fresh x :=
  let shape := match goal with
                 | [ |- AnnTyping _   ?shape _    ] => shape
                 | [ |- AnnDefEq  _ _ ?shape _  _ ] => shape
               end in
  let ctor  := match shape with
    | a_Pi     _ _ _ => An_Pi
    | a_Abs    _ _ _ => An_Abs
    | a_CPi      _ _ => An_CPi
    | a_CAbs     _ _ => An_CAbs
    | g_PiCong _ _ _ => An_PiCong
    | g_AbsCong _ _ _  => An_AbsCong
    | g_CPiCong  _ _   => An_CPiCong
    | g_CAbsCong _ _ _ => An_C

(* Putting this here because it's annoying to move elsewhere. *)