Require Import FcEtt.sigs.

Require Import FcEtt.fc_dec_fuel.
Require Import FcEtt.fc_dec_aux.

Require Import FcEtt.imports.
Require Export FcEtt.ett_inf_cs.
Require Import FcEtt.ett_ind.
Require Export FcEtt.fc_invert.

Require Import FcEtt.dep_prog.

Require Import FcEtt.toplevel.

Require Import FcEtt.fc_get.
Require Import FcEtt.fc_context_fv.

Module fc_dec_fun (wf : fc_wf_sig) (weak : fc_weak_sig) (subst : fc_subst_sig) (unique: fc_unique_sig).

Module invert := fc_invert wf weak subst.
Module fuel := fc_dec_fuel wf weak subst unique.
Module aux := fc_dec_aux wf weak subst unique.
Module get := fc_get wf weak subst unique.

Import fuel aux unique wf subst invert get.

Unset Implicit Arguments.

Ltac obtacpre :=
  intros; simpl in *.

Ltac obtacsolve :=
  intros; simpl in *; try solve [ok].

Lemma An_IsoConv': ∀ (G : context) (D : available_props)
                     (a1 a2 A a1' a2' B : tm) phi1 phi2 (g : co),
  phi1 =  (Eq a1 a2 A)  →
  phi2 = (Eq a1' a2' B) →
  AnnDefEq G D g A B  →
  AnnPropWff G phi1 →
  AnnPropWff G phi2 →
  erase_tm a1 = erase_tm a1' →
  erase_tm a2 = erase_tm a2' →
  AnnIso G D (g_IsoConv phi1 phi2 g) phi1 phi2.
Proof.
  intros.
  subst phi1 phi2.
  eauto.
Qed.

(* More pratical version of these lemma (both forms are useful, though) *)
Lemma get_tpg_correct' : ∀ {G : context} {a A : tm},
    AnnTyping G a A → A = get_tpg G a.
Proof.
  move => G a A tpg.
  by rewrite (@get_tpg_correct _ _ _(get_tpg G a) tpg _).
Defined.

Lemma get_deq_correct' : ∀ {G : context} {D : available_props} {g : co} {A B},
    AnnDefEq G D g A B → get_deq G g = (A, B).
Proof.
  move => G ? g A B deq.
  have eq: get_deq G g = (fst (get_deq G g), snd (get_deq G g)) by destruct (get_deq G g).
  by move: (@get_deq_correct _ _ _ _ _ (fst (get_deq G g)) (snd (get_deq G g)) deq eq) => [-> ->].
Defined.

Lemma get_iso_correct' : ∀ {G : context} {D : available_props} {g : co} {phi1 phi2 : constraint}, AnnIso G D g phi1 phi2 → get_iso G g = (phi1, phi2).
Proof.
  move => G ? g phi1 phi2 iso.
  have eq: get_iso G g = (fst (get_iso G g), snd (get_iso G g)) by destruct (get_iso G g).
  by move: (@get_iso_correct _ _ _ _ _ (fst (get_iso G g)) (snd (get_iso G g)) iso eq) => [-> ->].
Defined.

(**** Tactics ****)
(* TODO: reorganize the tactics, and move the ones which don't belong here *)

(* FIXME: that may be defined in fc_dec_fun *)
Ltac clear_annoying :=
  repeat match goal with
    | [H: <<_>> = _ |- _ ] => clear H
    | [H: <<_, _>> = _ |- _ ] => clear H
    | [H: !! = _ |- _ ] => clear H
    | [H: yeah = _ |- _ ] => clear H
    | [H: nope = _ |- _ ] => clear H
    | [ H :     !! = _     |- _ ] => clear H
    | [ H :     _ + { _ } |- _ ] => clear H
    | [ H : { _ } + { _ } |- _ ] => clear H
    | [ H : { _ | _} + { _ } |- _ ] => clear H
    | [ H : { _, _ | _} + { _ } |- _ ] => clear H
  end.

Ltac intro_uniq_full H :=
    match type of H with
      | AnnTyping ?G ?a ?A =>
        let x := fresh "u" in
        move : (@AnnTyping_unique G a A H) => x;
        (* Apply uniqueness to other hyps about the same term (and ctx) and discard them *)
        repeat match goal with
          | [H' : AnnTyping G a ?A' |- _ ] =>  move: (x _ H') => ?; wrap_hyp H'
        end
      | AnnDefEq ?G ?L ?g ?A1 ?A2 =>
        let x := fresh "u" in
        move : (@AnnDefEq_unique G L g A1 A2 H) => x;
        (* Apply uniqueness to other hyps about the same term (and ctx) and discard them *)
        repeat match goal with
          | [H' : AnnDefEq G L g ?A1' ?A2' |- _ ] =>  move: (x _ _ H') => ?; wrap_hyp H'
        end
      | AnnIso ?G ?L ?g ?phi1 ?phi2 =>
        let x := fresh "u" in
        move : (@AnnIso_unique G L g phi1 phi2 H) => x;
        (* Apply uniqueness to other hyps about the same term (and ctx) and discard them *)
        repeat match goal with
          | [H' : AnnIso G L g ?phi1' ?phi2' |- _ ] =>  move: (x _ _ H') => ?; wrap_hyp H'
        end
    end.

(* Apply uniqueness of type to existing typing hyps *)
Ltac auto_uniq_full :=
  revert_all_with intro_uniq_full; intros; pcess_hyps.

Ltac terminator := auto_uniq_full; subst_forall; subst; cbn; pcess_hyps;
  (* FIXME: eauto db version: basic_nosolve_n 3 *)
  (* FIXME: eauto doesn't (always, at least) use the typing constructors, while in theory it should... *)
  try solve [try econstructor; intuition (subst; eauto 3) | intuition (subst; eauto 3 with smart_cons_exists)].

Ltac hacky :=
  do 3 (
    intros;
    (*
    repeat match goal with
      | [ p : tm * tm |- _ ] => destruct p; cbn in *
    end; *)
  try(
  try (multimatch goal with
    | [ |- ¬ _ ] => let H := fresh in intro H; inversion H; terminator
    | _ => idtac
  end);
  try (multimatch goal with
    | [ H : ¬ _ |-  _ ] => solve [edestruct H; terminator]
    | [ H : forall _, ¬ _ |-  _ ] => solve [edestruct H; terminator]
    | [ H : forall _ _, ¬ _ |-  _ ] => solve [edestruct H; terminator]
  end); terminator)).

(* Cleanup tactics
   TODO: do we want them here or elsewhere? *)
Ltac clearbodies :=
  repeat match goal with
    | [ H := _ : _ |- _] => clearbody H
  end.
(* TODO: should be in tactics.v *)
Ltac clearbodies' :=
  repeat match goal with
    | [ x := ?bdy : _ |- _] =>
      move: (eq_refl x);
      rewrite -{2}[x]/bdy;
      clearbody x;
      let eqname := fresh "eq" x in
      move => eqname
  end.

(* Ugly to have to grab them by their types, but we can't refer to their names (even after the definitions) *)
Ltac clean_fun :=
  match goal with
    | [
        AnnTyping_dec : Tactics.fix_proto (∀ (G : context) (t : tm), fuel_tpg t → AnnCtx G → {T : tm | AnnTyping G t T} + {(∀ T : tm, ¬ AnnTyping G t T)}),
        AnnPropWff_dec : Tactics.fix_proto (∀ (G : context) (phi : constraint), fuel_pwf phi → AnnCtx G → {AnnPropWff G phi} + {¬ AnnPropWff G phi}),
        AnnDefEq_dec : Tactics.fix_proto (∀ (G : context) (S : available_props) (g : co), fuel_deq g → AnnCtx G → {A, B | AnnDefEq G S g A B} + {(∀ A B : tm, ¬ AnnDefEq G S g A B)}),
        AnnIso_dec : Tactics.fix_proto (∀ (G : context) (S : available_props) (g : co), fuel_iso g → AnnCtx G → {phi1, phi2 | AnnIso G S g phi1 phi2} + {(∀ phi1 phi2 : constraint, ¬ AnnIso G S g phi1 phi2)})
      |- _ ] => clear AnnTyping_dec AnnPropWff_dec AnnDefEq_dec AnnIso_dec
  end.

Ltac clear_sums :=
  repeat match goal with
    | [ H :     !! = _     |- _ ] => clear H
    | [ H :     _ + { _ } |- _ ] => clear H
    | [ H : { _ } + { _ } |- _ ] => clear H
  end.

Ltac cleanup_param cbodies sbst:=
  clear_annoying;
  intros; simpl in *;
  cbodies;
  try solve [ok];
  try clean_fun;
  clear_sums;
  sbst. (* FIXME: for some reason, that subst breaks clear_fun if placed before it *)

Ltac cleanup := cleanup_param clearbodies subst.
Ltac cleanup' := cleanup_param clearbodies' idtac.

Obligation Tactic := try solve [hacky].

(* We need an unfueled version for AnnIso_dec - in that case, we have the subterms and a typing for them (by regularity), but no *fuel* *)
Program Definition AnnPropWff_dec' (G: context) (a b A : tm) (A' B': tm) (H : AnnCtx G)
                                  (pA: AnnTyping G a A') (pB: AnnTyping G b B') : {AnnPropWff G (Eq a b A)} + {¬ AnnPropWff G (Eq a b A)} :=
  tm_eq_dec A A' >-->
  tm_eq_dec (erase A) (erase B') >-->
  yeah.

Obligation Tactic := obtacpre; first [match goal with [|- tm] => idtac end | eassumption].

(** A system FC development wouldn't be right without a good, Haskell-style code. So please, enjoy. **)

(* Naming scheme: fX is the name of the fuel for X *)
Program Fixpoint AnnTyping_dec (G : context) (t : tm) (fuel : fuel_tpg t) (H : AnnCtx G) {struct fuel} : {T : tm | AnnTyping G t T } + {(forall T, ¬ AnnTyping G t T)}  :=
  match fuel with
    | FT_Star =>  << a_Star >>

    | FT_Var_f x =>
      A <- binds_dec_tm x G;
      << A >>

    | FT_Pi rho A B fB fA =>
      let (x, p) := atom_fresh (dom G \u fv_tm_tm_tm B) in
      KA <- AnnTyping_dec G A fA _;
      tm_eq_dec KA a_Star >--->
      KB <- AnnTyping_dec ([(x, Tm A)] ++ G) (open_tm_wrt_tm B (a_Var_f x)) (fB x _) _;
      tm_eq_dec KB a_Star >--->
      << a_Star >>

    | FT_Abs rho a A fa fA =>
      (* (∀ x : atom, ¬ x `in` L → Typing ([(x, Tm A)] ++ G) (open_tm_wrt_tm a (a_Var_f x)) (open_tm_wrt_tm B (a_Var_f x))) *)
      let (x, p) := atom_fresh (dom G \u fv_tm_tm_tm a) in
      KA <- AnnTyping_dec G A fA _;
      tm_eq_dec KA a_Star >--->
      B <- AnnTyping_dec ([(x, Tm A)] ++ G) (open_tm_wrt_tm a (a_Var_f x)) (fa x _) _;
      RhoCheck_erase_dec rho x (open_tm_wrt_tm a (a_Var_f x)) _ >--->
      << a_Pi rho A (close_tm_wrt_tm x B )>>

    | FT_App rho b a fb fa =>
      A <- AnnTyping_dec G a fa _;
      Tf <- AnnTyping_dec G b fb _;
      match Tf with
        | a_Pi rho' A' B =>
          tm_eq_dec A' A >--->
          rho_eq_dec rho rho' >---> << open_tm_wrt_tm B a >>
        | _ => !!
      end

    | FT_Conv a g fa fg =>
      A <- AnnTyping_dec G a fa _;
      A' & B <- AnnDefEq_dec G (dom G) g fg _;
      let K := get_tpg G B in
  (*  K <- AnnTyping_dec G B _ _;  *)
      tm_eq_dec K a_Star >--->
      tm_eq_dec A A' >--->
      << B >>

    | FT_CApp b g fb fg =>
      TB <- AnnTyping_dec G b fb _ ;
      A1' & A2' <- AnnDefEq_dec G (dom G) g fg _;
      match TB with
        | (a_CPi (Eq A1 A2 K) B) =>
          tm_eq_dec A1 A1' >--->
          tm_eq_dec A2 A2' >--->
          << open_tm_wrt_co B g >>
        | _ => !!
      end

    | FT_Const T =>
      K <- binds_dec_cs T an_toplevel;
      (@DataTy_Star_dec K) _ >--->
      << K >>

    | FT_CPi phi B fB fphi =>
      AnnPropWff_dec G phi fphi _ >--->
      let (c, p) := atom_fresh (dom G \u fv_co_co_tm B) in
      KB <- AnnTyping_dec ([(c, Co phi)] ++ G) (open_tm_wrt_co B (g_Var_f c)) (fB c _) _;
      tm_eq_dec KB a_Star >--->
      << a_Star >>

    | FT_CAbs a phi fa fphi =>
      AnnPropWff_dec G phi fphi _ >--->
      let (c, p) := atom_fresh (dom G \u fv_co_co_constraint phi \u fv_co_co_tm a) in
      Bc <- AnnTyping_dec ((c ~ Co  phi ) ++  G) (open_tm_wrt_co a (g_Var_f c)) (fa c _) _;
      << a_CPi phi (close_tm_wrt_co c Bc) >>

    (* Erased language side: not typable in the annotated *)
    | FT_UAbs _ _ => !!
    | FT_UCAbs _  => !!
    | FT_Bullet   => !!

    | FT_Var_b _ => !!
  (*  | a_FamApp _ _ => !! *)
    | FT_DataCon _ => !!
    | FT_Case _ _ => !!

    | FT_Fam F =>
      a & A <- binds_dec_ax F an_toplevel;
        << A >>
  end

with AnnPropWff_dec (G: context) (phi : constraint) (fuel : fuel_pwf phi)
                    (H : AnnCtx G) {struct fuel} : {AnnPropWff G phi} + {¬ AnnPropWff G phi} :=
  match fuel with
    | FP_fuel_pwf a b K fa fb =>
      Ka <-- AnnTyping_dec G a fa _;
      Kb <-- AnnTyping_dec G b fb _;
      tm_eq_dec K Ka >-->
      tm_eq_dec (erase K) (erase Kb) >--> yeah
  end

with AnnDefEq_dec (G: context) (S : available_props) (g : co) (fuel : fuel_deq g)
                  (H: AnnCtx G) {struct fuel} : {A, B | AnnDefEq G S g A B} + {(forall A B, ¬ AnnDefEq G S g A B)} :=
  match fuel with
    | FD_Assn c =>
        in_dec c S >--->
        AB & K <- binds_dec_co c G;
        << fst AB, snd AB >>

    | FD_Refl a fa =>
        A <- AnnTyping_dec G a fa _;
        <<a, a>>

    | FD_Refl2 a b g fa fb fg =>
        A <- AnnTyping_dec G a fa _;
        B <- AnnTyping_dec G b fb _;
        tm_eq_dec (erase_tm a) (erase_tm b) >--->
        A' & B' <- AnnDefEq_dec G (dom G) g fg _;
        tm_eq_dec A A' >--->
        tm_eq_dec B B' >--->
        << a, b >>

    | FD_Sym g fg =>
        b & a <- AnnDefEq_dec G S g fg _;
        << a, b >>

    | FD_Trans g1 g2 fg1 fg2 =>
        a & c <- AnnDefEq_dec G S g1 fg1 _;
        d & b <- AnnDefEq_dec G S g2 fg2 _;
        tm_eq_dec c d >--->
        << a, b >>

    | FD_Beta a1 a2 fa1 fa2 =>
        A1 <- AnnTyping_dec G a1 fa1 _;
        A2 <- AnnTyping_dec G a2 fa2 _;
        tm_eq_dec (erase_tm A1) (erase_tm A2) >--->
        @beta_dec (erase_tm a1) (erase_tm a2) _ >--->
        << a1, a2 >>

    | FD_PiCong rho g1 g2 fg1 fg2 =>
      A1 & A2 <- AnnDefEq_dec G S g1 fg1 _;
      tm_eq_dec (get_tpg G A1) a_Star >--->
      tm_eq_dec (get_tpg G A2) a_Star >--->
      let (x, _) := atom_fresh (dom G \u fv_tm_tm_co g1 \u fv_tm_tm_co g2) in
      B1x & B2x <- AnnDefEq_dec ([(x, Tm A1)] ++ G) S (open_co_wrt_tm g2 (a_Var_f x)) (fg2 x _) _;
      let B1  := close_tm_wrt_tm x B1x in
      let B2  := close_tm_wrt_tm x B2x in
      let B3x := tm_subst_tm_tm (a_Conv (a_Var_f x) (g_Sym g1)) x B2x in
      let B3  := close_tm_wrt_tm x B3x in
      (* let B3 := close_tm_wrt_tm x (tm_subst_tm_tm (a_Conv (a_Var_f x) (g_Sym g1)) x B2x) in *)
      tm_eq_dec (get_tpg ([(x, Tm A1)] ++ G) B1x) a_Star >--->
      tm_eq_dec (get_tpg ([(x, Tm A1)] ++ G) B2x) a_Star >--->
      tm_eq_dec (get_tpg ([(x, Tm A2)] ++ G) B3x) a_Star >--->
      << a_Pi rho A1 B1, a_Pi rho A2 B3 >>

    | FD_AbsCong rho g1 g2 fg1 fg2 =>
      A1 & A2 <- AnnDefEq_dec G S g1 fg1 _;
      tm_eq_dec (get_tpg G A1) a_Star >--->
      tm_eq_dec (get_tpg G A2) a_Star >--->
      let (x, p) := atom_fresh (dom G \u fv_tm_tm_co g1 \u fv_tm_tm_co g2) in
      B1x & B2x <- AnnDefEq_dec ([(x, Tm A1)] ++ G) S (open_co_wrt_tm g2 (a_Var_f x)) (fg2 x _) _;
      let B1 := close_tm_wrt_tm x B1x in
      let B2 := close_tm_wrt_tm x B2x in
      let B3x := tm_subst_tm_tm (a_Conv (a_Var_f x) (g_Sym g1)) x B2x in
      let B3  := close_tm_wrt_tm x B3x in
      (* let B3 := close_tm_wrt_tm x (open_tm_wrt_tm B2 (a_Conv (a_Var_f x) (g_Sym g1))) in *)
      (* let B3 := close_tm_wrt_tm x (tm_subst_tm_tm (a_Conv (a_Var_f x) (g_Sym g1)) x B2x) in *)
      RhoCheck_erase_dec rho x B1x _ >--->
      RhoCheck_erase_dec rho x B3x _ >--->
      (* B <- AnnTyping_dec G (a_Abs rho A1 B2) _ _; *)
      << a_Abs rho A1 B1, a_Abs rho A2 B3 >>

    | FD_AppCong g1 g2 rho fg1 fg2 =>
      a1 & a2 <- AnnDefEq_dec G S g1 fg1 _;
      b1 & b2 <- AnnDefEq_dec G S g2 fg2 _;
      let Ta1 := get_tpg G a1 in
      let Ta2 := get_tpg G a2 in
      let Tb1 := get_tpg G b1 in
      let Tb2 := get_tpg G b2 in
      match Ta1, Ta2 with
        | a_Pi rho1 A1 _, a_Pi rho2 A2 _ =>
          tm_eq_dec A1 Tb1 >--->
          tm_eq_dec A2 Tb2 >--->
          rho_eq_dec rho rho1 >--->
          rho_eq_dec rho rho2 >--->
          << a_App a1 rho b1, a_App a2 rho b2 >>
        | _, _ => !!
      end

    | FD_CPiCong g1 g3 fg1 fg3 =>
        phi1 & phi2 <- AnnIso_dec G S g1 fg1 _;
        let (c, _) := atom_fresh (S \u dom G \u fv_co_co_co g1 \u fv_co_co_co g3) in
        B1c & B2c <- AnnDefEq_dec ([(c, Co phi1)] ++ G) S (open_co_wrt_co g3 (g_Var_f c)) (fg3 c _) _;
        let B1  := close_tm_wrt_co c B1c in
        let B2  := close_tm_wrt_co c B2c in
        let B3c := open_tm_wrt_co B2 (g_Cast (g_Var_f c) (g_Sym g1)) in
        let B3  := close_tm_wrt_co c (B3c) in
        tm_eq_dec (get_tpg ([(c,Co phi1)] ++ G) B1c) a_Star >--->
        tm_eq_dec (get_tpg ([(c,Co phi2)] ++ G) B3c) a_Star >--->
        tm_eq_dec (get_tpg ([(c,Co phi1)] ++ G) B2c) a_Star >--->
        << a_CPi phi1 B1, a_CPi phi2 B3 >>

    | FD_CAbsCong g1 g3 g4 fg1 fg3 fg4 =>
        phi1 & phi2 <- AnnIso_dec G S g1 fg1 _;
        let (c, _) := atom_fresh (S \u dom G \u fv_co_co_co g1 \u fv_co_co_co g3) in
        a1c & a2c <- AnnDefEq_dec ([(c, Co phi1)] ++ G) S (open_co_wrt_co g3 (g_Var_f c)) (fg3 c _) _;
        let a1  := close_tm_wrt_co c a1c in
        let a2  := close_tm_wrt_co c a2c in
        let a3c := open_tm_wrt_co a2 (g_Cast (g_Var_f c) (g_Sym g1)) in
        let a3  := close_tm_wrt_co c a3c in
        let B1c := get_tpg ([(c, Co phi1)] ++ G) a1c in
        let B3c := get_tpg ([(c, Co phi2)] ++ G) a3c in
        CPi1 & CPi2 <- AnnDefEq_dec G (dom G) g4 fg4 _;
        tm_eq_dec CPi1 (a_CPi phi1 (close_tm_wrt_co c B1c)) >--->
        tm_eq_dec CPi2 (a_CPi phi2 (close_tm_wrt_co c B3c)) >--->
        << a_CAbs phi1 a1, a_CAbs phi2 a3 >>

    | FD_CAppCong g1 g2 g3 fg1 fg2 fg3 =>
      a1 & a2 <- AnnDefEq_dec G S g1 fg1 _;
      b1 & b2 <- AnnDefEq_dec G (dom G) g2 fg2 _;
      c1 & c2 <- AnnDefEq_dec G (dom G) g3 fg3 _;
      let Ta1 := get_tpg G a1 in
      let Ta2 := get_tpg G a2 in
      match Ta1, Ta2 with
        | a_CPi (Eq Ta11 Ta12 _) _, a_CPi (Eq Ta21 Ta22 _) _ =>
          (* TODO: in theory, one would want to do a cons_eq_dec - but DeqEq_dec doesn't return the type *)
          tm_eq_dec Ta11 b1 >--->
          tm_eq_dec Ta12 b2 >--->
          tm_eq_dec Ta21 c1 >--->
          tm_eq_dec Ta22 c2 >--->
          << a_CApp a1 g2, a_CApp a2 g3 >>
        | _, _ => !!
      end

    | FD_CPiSnd g1 g2 g3 fg1 fg2 fg3 =>
      a1 & a2 <- AnnDefEq_dec G S g1 fg1 _;
      a & a' <- AnnDefEq_dec G (dom G) g2 fg2 _;
      b & b' <- AnnDefEq_dec G (dom G) g3 fg3 _;
      match a1, a2 with
        | a_CPi (Eq a_ a_' _) B1, a_CPi (Eq b_ b_' _) B2 =>
          tm_eq_dec a  a_  >--->
          tm_eq_dec a' a_' >--->
          tm_eq_dec b  b_  >--->
          tm_eq_dec b' b_' >--->
          << open_tm_wrt_co B1 g2, open_tm_wrt_co B2 g3 >>
        | _, _ => !!
      end

    | FD_Cast g1 g2 fg1 fg2 =>
      a & a' <- AnnDefEq_dec G S g1 fg1 _;
      phi1 & phi2 <- AnnIso_dec G S g2 fg2 _;
      match phi1, phi2 with
        | Eq a_ a'_ _, Eq b b' _ =>
          tm_eq_dec a  a_  >--->
          tm_eq_dec a' a'_ >--->
          << b, b' >>
      end

    | FD_PiFst g fg =>
      T1 & T2 <- AnnDefEq_dec G S g fg _;
      match T1, T2 with
        | a_Pi rho1 A1 B1, a_Pi rho2 A2 B2 => rho_eq_dec rho1 rho2 >---> << A1, A2 >>
        | _, _ => !!
      end

    | FD_PiSnd g1 g2 fg1 fg2 =>
        T1 & T2 <- AnnDefEq_dec G S g1 fg1 _;
        a1 & a2 <- AnnDefEq_dec G S g2 fg2 _;
     (* A1 <- AnnTyping_dec G a1 _ _;
        A2 <- AnnTyping_dec G a2 _ _; *)
        let A1 := get_tpg G a1 in
        let A2 := get_tpg G a2 in
        match T1 with
          | a_Pi rho A1' B1 =>
            tm_eq_dec A1 A1' >--->
            match T2 with
              | a_Pi rho' A2' B2 =>
                tm_eq_dec A2 A2' >--->
                rho_eq_dec rho rho' >--->
                << open_tm_wrt_tm B1 a1, open_tm_wrt_tm B2 a2 >>
              | _ => !!
            end
          | _ => !!
        end

    | FD_IsoSnd g fg =>
      phi1 & phi2 <- AnnIso_dec G S g fg _;
      match phi1, phi2 with
        | (Eq _ _ A), (Eq _ _ B) => << A, B>>
      end

    | FD_Eta b fb =>
      let (x, p) := atom_fresh (dom G \u fv_tm_tm_tm b) in
      T <- AnnTyping_dec G b fb _;
      match T with
      | a_Pi Rel A B =>
        << a_Abs Rel A (close_tm_wrt_tm x (a_App b Rel (a_Var_f x))), b >>
      | a_Pi Irrel A B =>
        << a_Abs Irrel A (close_tm_wrt_tm x (a_App b Irrel (a_Var_f x))), b >>
      | a_CPi phi B =>
        << a_CAbs phi (close_tm_wrt_co x (a_CApp b (g_Var_f x))), b >>
      | _ => !!
      end

    | FD_Left g1  g2 fg1 fg2  => !!
    | FD_Right _ _ _ _ => !!
(* Left/Right.   This doesn't work yet.
    | FD_Left g1  g2 fg1 fg2  =>
      s1 & s2 <- AnnDefEq_dec G S g1 fg1 _;
      t1 & t2 <- AnnDefEq_dec G (dom G) g2 fg2 _ ;
      match s1 with
      | (a_App a1 Rel a2) =>
        match s2 with
        | (a_App a1' Rel a2') =>
          match t1 with
          | (a_Pi Rel A1 B1) =>
            match t2 with
            | (a_Pi Rel A2 B2) =>
              path_dec a1 >--->
              path_dec a1' >--->
              let A := get_tpg G a1  in
              let A' := get_tpg G a1' in
              tm_eq_dec A (a_Pi Rel A1 B1) >--->
              tm_eq_dec A' (a_Pi Rel A2 B2) >--->
              << a1 , a1' >>
            | _ => !!
            end
          | _ => !!
          end
        | _ => !!
        end
      | _ => !!
      end
        (*
      | (a_App a1 Irrel a2, a_App a1' Irrel a2', a_Pi Irrel A1 B1, a_Pi Irrel A2 B2) =>
          let A := get_tpg G a1  in
          let A' := get_tpg G a1' in
          tm_eq_dec A (a_Pi Irrel A1 B1) >--->
          tm_eq_dec A' (a_Pi Irrel A2 B2) >--->
          << a1 , a1' >>

      | (a_CApp a1 a2, a_CApp a1' a2', a_CPi A1 B1, a_CPi A2 B2) =>
          let A := get_tpg G a1  in
          let A' := get_tpg G a1' in
          tm_eq_dec A (a_CPi A1 B1) >--->
          tm_eq_dec A' (a_CPi A2 B2) >--->
          << a1 , a1' >>

      | _ => !!
      end *)

    | FD_Right g1  g2 fg1 fg2  =>
      s1 & s2 <- AnnDefEq_dec G S g1 fg1 _;
      t1 & t2 <- AnnDefEq_dec G (dom G) g2 fg2 _ ;
      match (s1, s2, t1, t2) with
      | (a_App a1 r1 a2, a_App a1' r2 a2', a_Pi r3 A1 B1, a_Pi r4 A2 B2) =>
          let A := get_tpg G a1  in
          let A' := get_tpg G a1' in
          tm_eq_dec A (a_Pi r3 A1 B1) >--->
          tm_eq_dec A' (a_Pi r4 A2 B2) >--->
          rho_eq_dec r1 r2 >--->
          rho_eq_dec r1 r3 >--->
          rho_eq_dec r1 r4 >--->
          << a2 , a2' >>
      | _ => !!
      end
*)
    (* Trivial cases *)
    | FD_Triv          => !!
    | FD_Var_b _       => !!
    | FD_CPiFst _      => !!
    | FD_Cong _ _ _    => !!
    | FD_IsoConv _ _ _ => !!

  end

with AnnIso_dec (G: context) (S : available_props) (g : co) (fuel : fuel_iso g)
                (H: AnnCtx G) {struct fuel} : {phi1, phi2 | AnnIso G S g phi1 phi2} + {(forall phi1 phi2, ¬ AnnIso G S g phi1 phi2)} :=
  match fuel with
    | FI_Cong g1 A g2 fg1 fg2 =>
      A1 & A2 <- AnnDefEq_dec G S g1 fg1 _;
      B1 & B2 <- AnnDefEq_dec G S g2 fg2 _;
      AnnPropWff_dec' G A1 B1 A (get_tpg G A1) (get_tpg G B1) _ _ _ >--->
      AnnPropWff_dec' G A2 B2 A (get_tpg G A2) (get_tpg G B2) _ _ _ >--->
      << Eq A1 B1 A, Eq A2 B2 A >>

    | FI_CPiFst g fg =>
      pi1 & pi2 <- AnnDefEq_dec G S g fg _;
      match pi1, pi2 with
        | a_CPi phi1 _, a_CPi phi2 _ =>
          << phi1, phi2 >>
        | _, _ => !!
      end

    | FI_IsoSym g fg =>
      phi2 & phi1 <- AnnIso_dec G S g fg _;
      << phi1, phi2 >>

    | FI_IsoConv g phi1 phi2 fg fpwf1 fpwf2  =>
      A' & B' <- AnnDefEq_dec G S g fg _;
      AnnPropWff_dec G phi1 fpwf1 _ >--->
      AnnPropWff_dec G phi2 fpwf2 _ >--->
      match phi1, phi2 with
        | Eq a1 a2 A, Eq a1' a2' B =>
          tm_eq_dec (erase_tm  a1) (erase_tm  a1') >--->
          tm_eq_dec (erase_tm  a2) (erase_tm  a2') >--->
          tm_eq_dec A A' >--->
          tm_eq_dec B B' >--->
          << phi1, phi2 >>
      end

    (* Non-iso coercions *)
    | FI_Var_f c => !!
    | FI_Var_b _ => !!
    | FI_Refl a => !!
    | FI_Refl2 a b g => !!
    | FI_Trans g1 g2 =>  !!
    | FI_Beta a1 a2 => !!
    | FI_PiCong rho g1 g2 => !!
    | FI_AbsCong _ _ _ => !!
    | FI_AppCong g1 rho g2 => !!
    | FI_CAbsCong _ _ _ => !!
    | FI_CAppCong g1 g2 g3 => !!
    | FI_PiFst g => !!
    | FI_Cast g1 g2 => !!
    | FI_PiSnd g1 g2 => !!
    | FI_Triv => !!
    | FI_CPiCong _ _ => !!
    | FI_CPiSnd _ _ _ => !!
    | FI_IsoSnd _ => !!
    | FI_Eta _ => !!
    | FI_Left _ _ => !!
    | FI_Right _ _ => !!
  end

.

(*
Solve Obligations of AnnDefEq_dec with obtacpre; first [match goal with [|- tm] => idtac end | eassumption].
*)

Obligation Tactic :=
  obtacsolve.

(******** AnnDefEq_dec ********)

Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
Defined.
Next Obligation.
  hacky.
Defined.

(* An_EraseEq *)
Next Obligation.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
Defined.

(* An_Sym *)
Next Obligation.
  hacky.
Defined.

Obligation Tactic := obtacpre.

Next Obligation.
  eauto using An_Sym2.
Defined.

(* An_Trans *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  subst.
  eauto using An_Trans2.
Defined.

(* An_Beta *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  move: lc_erase => [h0 _].
  eapply h0.
  move: (AnnTyping_lc wildcard'0) => [h1 _].
  auto.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup.
Defined.

(* FIXME: in the following hard cases (Abs/CAbs/Pi/CPi -Cong), the code likely contains a lot of junk
    It could also be made more concise, by using more ssr magic *)

(* TODO: this belongs in tactics *)
  Ltac reg H :=
  match type of H with
    | AnnTyping _ ?a ?A =>
      first
        [ let tpgA := fresh "tpg" A in move: (AnnTyping_regularity H) => tpgA
        | let tpgA := fresh "tpg"   in move: (AnnTyping_regularity H) => tpgA]
    | AnnDefEq _ _ ?g ?A ?B =>
      let KA := fresh "K" A in
      let KB := fresh "K" B in
      let g' := fresh "g" in
      let tpgA := fresh "tpg" A in
      let tpgB := fresh "tpg" B in
      (* let deqg' := fresh "deq" g' in *)
      move: (AnnDefEq_regularity H) => [KA [KB [g' [tpgA [tpgB (* deqg' *) _]]]]]
    (* FIXME: this is the same case than above, with less informative fresh names.
       This is needed because fresh can fail (like, seriously?)
       TODO: failproof version of fresh *)
    | AnnDefEq _ _ ?g ?A ?B =>
      let KA := fresh "K" in
      let KB := fresh "K" in
      let g' := fresh "g" in
      let tpgA := fresh "tpg" in
      let tpgB := fresh "tpg" in
      (* let deqg' := fresh "deq" g' in *)
      move: (AnnDefEq_regularity H) => [KA [KB [g' [tpgA [tpgB (* deqg' *) _]]]]]

    | AnnIso _ _ ?g ?phi1 ?phi2 =>
      let pwfp1 := fresh "pwf" phi1 in
      let pwfp2 := fresh "pwf" phi2 in
      move: (AnnIso_regularity H) => [pwfp1 pwfp2]
  end.

Ltac cleanup_getcor :=
  repeat match goal with
    | [ _: get_tpg _ _ = get_tpg _ _ |- _ ] => fail
    | [ eq: _ = get_tpg _ _ |- _ ] => symmetry in eq
  end.

(* FIXME: same, should be elsewhere (fc_invert.v?) *)
Ltac getcor a :=
  cleanup_getcor;
  match goal with
    | [ eq: get_tpg ?G a = _,
        tpg : AnnTyping ?G a ?A |- _ ] =>
          let t := fresh tpg in
          move: (get_tpg_correct tpg eq) => t; subst A
  end.

(* TODO: location *)
(* For now, this assumes that we only need regularity on defeq hyps *)
Ltac autoreg :=
  repeat match goal with
    | [ H: AnnDefEq _ _ _ _ _ |- _ ] =>
      reg H; wrap_hyp H
    | [ H: AnnIso _ _ _ _ _ |- _ ] =>
      reg H; wrap_hyp H
  end;
  pcess_hyps.

Ltac clearget :=
  cleanup_getcor;
  repeat match goal with
    | [ H: get_tpg _ _ = get_tpg _ _ |- _ ] => fail
    | [ eqTa : get_tpg ?G ?a = ?Ta,
        tpga : AnnTyping ?G ?a ?Ta' |- _ ] =>
      let eq := fresh in
      (* FIXME: in the following subst, we don't control which equation gets rewritten -> inconsistent results *)
      move:(get_tpg_correct' tpga); move=> eq; rewrite <- eq in *; clear eq; subst Ta'
  end.

(* An_PiCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup.
  inversion 1.
  auto_uniq_full.
  apply wildcard'.
  have: A0 = A1 by done. move => <-.
  inversion H9.
  by move: (get_tpg_correct' H21) => <-.
Defined.
Next Obligation.
  cleanup.
  inversion 1.
  auto_uniq_full.
  apply wildcard'.
  have: A3 = A2 by done. move => <-.
  inversion H12.
  by move: (get_tpg_correct' H21) => <-.
Defined.
Next Obligation. (* Fuel: aux obligation *)
  fsetdec.
Defined.
Next Obligation. (* Ctx wf *)
  econstructor; try eassumption.
  - cleanup.
    reg wildcard'0.
    by getcor A1.
  - fsetdec.
Defined.
Next Obligation.
  cleanup.
  move /An_PiCong_inversion.
  move => [a1 [b1 [a2 [b2 [b3 [eqA [eqB [tpg1 [tpg2 [tpg3 [defeq h]]]]]]]]]]].
  apply: wildcard'.
  have xnotin: x `notin` dom G by fsetdec.
  move: (h _ xnotin) => [h' _].
  auto_uniq_full; subst.
  by apply: h'.
Defined.
Next Obligation.
  cleanup'.
  move /An_PiCong_inversion.
  move => [a1 [b1 [a2 [b2 [b3 [eqA [eqB [tpg1 [tpg2 [tpg3 [defeq h]]]]]]]]]]].
  eapply wildcard'.
  have xG: x `notin` dom G by fsetdec.
  move: (h _ xG) => /= [h' _].
  have: A1 = a1 by cleanup; auto_uniq_full. move => ?; subst A1.
  auto_uniq_full.
  move: (An_Pi_inversion tpg1) => [_ [_]] /(_ _ xG).
  by move: (u3 _ _ wildcard'3) => [<- _] => /(get_tpg_correct') ->.
Defined.
Next Obligation.
  cleanup'.
  move /An_PiCong_inversion.
  move => [a1 [b1 [a2 [b2 [b3 [eqA [eqB [tpg1 [tpg2 [tpg3 [defeq h]]]]]]]]]]].
  eapply wildcard'.
  have xG: x `notin` dom G by fsetdec.
  move: (h _ xG) => /= [h' _].
  have: A1 = a1 by cleanup; auto_uniq_full. move => ?; subst A1.
  clearbodies'.
  auto_uniq_full.
  move: (An_Pi_inversion tpg3) => [_ [_]] /(_ _ xG).
  by move: (u3 _ _ wildcard'3) => [_ <-] => /(get_tpg_correct') ->.
Defined.
Next Obligation.
  cleanup'.
  move /An_PiCong_inversion.
  move => [a1 [b1 [a2 [b2 [b3 [eqA [eqB [tpg1 [tpg2 [tpg3 [defeq h]]]]]]]]]]].
  eapply wildcard'.
  have xG: x `notin` dom G by fsetdec.
  move: (h _ xG) => /= [h' eqb3].
  have: A1 = a1 by cleanup; auto_uniq_full. move => ?; subst A1.
  have: A2 = a2 by cleanup; auto_uniq_full. move => ?; subst A2.
  clearbodies'.
  auto_uniq_full.
  move: (An_Pi_inversion tpg2) => [_ [_]] /(_ _ xG).
  have realeq : B3x = open_tm_wrt_tm B2 (a_Conv (a_Var_f x) (g_Sym g1)) by rewrite eqB3x eqB2 tm_subst_tm_tm_spec.
  move: realeq eqb3 eqB2 H2 => -> -> -> <-. rewrite close_tm_wrt_tm_open_tm_wrt_tm.
  - by move => /(get_tpg_correct') ->.
  - (* Fv in context for tpg hyp *) (* TODO: tactic *)
    move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _  tpg3) /= [htmco [hcoco [htmtm hcotm ] ] ].
    by fsetdec.
Defined.
Next Obligation.
  cleanup'.
  rewrite eqB1 eqB3.
  eapply An_PiCong_exists3 with (x := x); try eassumption.
  fsetdec.
Defined.

(* An_AbsCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup.
  move /An_AbsCong_inversion => [a1' [a2' [b1' [b2' [b3' [B' h]]]]]].
  move: h => [eqA [eqB [tpga1' [tpga2' [defg1 [tpga1b2' h]]]]]].
  apply: wildcard'.
  have: A1 = a1' by auto_uniq_full.
  move=> ->.
  by rewrite (get_tpg_correct' tpga1').
Defined.
Next Obligation.
  cleanup.
  move /An_AbsCong_inversion => [a1' [a2' [b1' [b2' [b3' [B' h]]]]]].
  move: h => [eqA [eqB [tpga1' [tpga2' [defg1 [tpga1b2' h]]]]]].
  apply: wildcard'.
  have: A2 = a2' by auto_uniq_full.
  move=> ->.
  by rewrite (get_tpg_correct' tpga2').
Defined.
Next Obligation. (* Fuel: aux obligation *)
  fsetdec.
Defined.
Next Obligation. (* Ctx wf *)
  econstructor; try eassumption.
  - cleanup.
    reg wildcard'0.
    by getcor A1.
  - fsetdec.
Defined.
Next Obligation.
  cleanup.
  move /An_AbsCong_inversion => [a1' [a2' [b1' [b2' [b3' [B' h]]]]]].
  move: h => [eqA [eqB [tpga1' [tpga2' [defg1 [tpga1b2' h]]]]]].
  apply: wildcard'.
  auto_uniq_full.
  have: A1 = a1' /\ A2 = a2' by split; congruence.
  move=> [? ?]. subst A1 A2.
  have xG: x `notin` dom G by fsetdec.
  move: (h x xG) => [tpgg2 [_ [h' _] ] ].
  eassumption.
Defined.
Next Obligation.
  by move: (wf.AnnDefEq_lc1 wildcard').
Defined.
Next Obligation.
  cleanup.
  move /An_AbsCong_inversion => [a1' [a2' [b1' [b2' [b3' [B' h]]]]]].
  move: h => [eqA [eqB [tpga1' [tpga2' [defg1 [tpga1b2' h]]]]]].
  have p': x `notin` dom G by fsetdec.
  move: (h x p') => [tpgg2 [_ [h' _] ] ].
  apply wildcard'.
  suff eq: B1x = open_tm_wrt_tm b1' (a_Var_f x) by rewrite eq.
  auto_uniq_full.
  move: (u2 _ _ wildcard'0) => [eqA1 _].
  rewrite eqA1 in tpgg2.
  by move: (u _ _ tpgg2) => [->].
Defined.
Next Obligation.
  cleanup'.
  move: (wf.AnnDefEq_lc2 wildcard'3).
  rewrite eqB3x => ?.
  apply: tm_subst_tm_tm_lc_tm => /=.
  + done.
  + apply lc_a_Conv.
    - done.
    - move: (wf.AnnDefEq_lc3 wildcard'0) => ?.
      econstructor; eassumption.
Defined.
Next Obligation.
  clear dependent filtered_var.
  cleanup'.
  move=> tpgg1g2. move: (tpgg1g2).
  move /An_AbsCong_inversion => [a1' [a2' [b1' [b2' [b3' [B' h]]]]]].
  move: h => [eqA [eqB [tpga1' [tpga2' [defg1 [tpga1b2' h]]]]]].
  apply wildcard'.
  have p': x `notin` dom G by fsetdec.
  move: (h x p') => [tpgg2 [eqb3' [_ h'] ] ].
  suff eq: B3x = open_tm_wrt_tm b3' (a_Var_f x) by rewrite eq.
  auto_uniq_full.
  have: A1 = a1' /\ A2 = a2' by split; congruence.
  move=> [? ?]. subst A1 A2.
  rewrite eqB3x.
  move: (u5 _ _ wildcard'3) => [_ eqb2'].
  rewrite -eqb2' eqb3' tm_subst_tm_tm_spec close_tm_wrt_tm_open_tm_wrt_tm.
  - done.
  - (* Fv in context for tpg hyp *)
    move: ann_context_fv_mutual => [h''' [_ [_ [_ _] ] ] ]; move: h''' => /(_ _ _ _ tpga1b2') /= [htmco'' [hcoco'' [htmtm'' hcotm'' ] ] ].
    by fsetdec.
Defined.
Next Obligation.
  clear dependent filtered_var.
  cleanup'.
  rewrite eqB1 eqB3.
  eapply An_AbsCong_exists3; try eassumption.
  - fsetdec.
  - reflexivity.
Defined.

(* An_AppCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  inversion 1.
  apply wildcard'.
  reg wildcard'2.
  reg wildcard'1.
  getcor a1.
  getcor b1.
  subst Ta1 Tb1.
  auto_uniq_full.
  intro_uniq_full wildcard'2. (* FIXME: auto_uniq_full not working here *)
  intro_uniq_full wildcard'1. (* FIXME: auto_uniq_full not working here *)
  have: a0 = a1 by congruence => [-> _].
  move=> ?.
  subst a0. subst a3.
  inversion H8.
  intro_uniq_full H19. (* TODO: this proof is messy *)
  have: A1 = A3 by congruence. move => ->.
  by move: (get_tpg_correct' H21).
Defined.
Next Obligation.
  cleanup'.
  inversion 1.
  apply wildcard'.
  reg wildcard'2.
  reg wildcard'1.
  getcor a2.
  getcor b2.
  subst Ta2 Tb2.
  auto_uniq_full.
  intro_uniq_full wildcard'2. (* FIXME: auto_uniq_full not working here *)
  intro_uniq_full wildcard'1. (* FIXME: auto_uniq_full not working here *)
  have: a0 = a1 by congruence => [-> _].
  move=> ?.
  subst b0. subst b2.
  inversion H11.
  intro_uniq_full H20. (* TODO: this proof is messy *)
  have: A2 = A3 by congruence. move => ->.
  by move: (get_tpg_correct' H21).
Defined.
Next Obligation.
  cleanup'.
  cleanup_getcor.
  autoreg.
  clearget.
  inversion 1. inversion H8.
  apply: wildcard'.
  auto_uniq_full. subst a0.
  move: (u9 _ tpga1).
  congruence.
Defined.
Next Obligation.
  cleanup'.
  cleanup_getcor.
  autoreg.
  clearget.
  inversion 1. inversion H11.
  apply: wildcard'.
  auto_uniq_full. subst b0.
  move: (u9 _ tpga2).
  congruence.
Defined.
Next Obligation.
  (* FIXME: cleanup' not working *)
  clear dependent filtered_var.
  clear dependent filtered_var1.
  clear dependent filtered_var0.
  clear dependent filtered_var2.
  clear dependent filtered_var4.
  clear dependent filtered_var3. subst. clear dependent fuel.
  clean_fun. clearbodies'.

  autoreg.
  clearget.
  auto_uniq_full.
  eapply An_AppCong2; try eassumption.
  all: econstructor;
  eauto using An_AppCong2.
  subst Ta1. eassumption.
  subst Ta2. eassumption.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  hacky.
Defined.

(* The numerous cases for the pattern match have been inlined -> solving them automatically *)
Ltac discr_pat_match :=
  solve [obtacpre; solve [ let eq1 := fresh in let eq2 := fresh in move=> [eq1 eq2]; try discriminate eq1; discriminate eq2
                         | subst; inversion 1 ] ].

Solve Obligations of AnnDefEq_dec with discr_pat_match.

(* An_CPiCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: Aux *)
  fsetdec.
Defined.
Next Obligation.
  econstructor.
  - eassumption.
  - cleanup'. by autoreg.
  - fsetdec.
Defined.
Next Obligation.
  cleanup.
  move /An_CPiCong_inversion.
  move => [ph1 [ph2 [b1 [b2 [b3 [eqA [eqB [isoph1 [tpgp1 [tpgp2 [tpg3 h]]]]]]]]]]].
  apply: wildcard'.
  have cG: c `notin` dom G by ok.
  move: (h _ cG) => /= [h' _].
  auto_uniq_full; subst.
  by apply: h'.
Defined.
Next Obligation.
  cleanup'.
  pcess_hyps.
  move /An_CPiCong_inversion.
  move => [ph1 [ph2 [b1 [b2 [b3 [eqA [eqB [isoph1 [tpgp1 [tpgp2 [tpg3 h]]]]]]]]]]].
  apply: wildcard'.
  auto_uniq_full.
  have cG: c `notin` dom G by ok.
  have: phi1 = ph1 by congruence. move=> eqphi. rewrite eqphi.
  move: (An_CPi_inversion tpgp1). do 2 move=> [_]. move => /(_ c cG) h'.
  move: (get_tpg_correct' h') => ->.
  suff: B1c = (open_tm_wrt_co b1 (g_Var_f c)) by move=> ->.
  move: (h _ cG) => /= [h'' _].
  auto_uniq_full.
  (* Fv in context for tpg hyp *)
  move: ann_context_fv_mutual => [h''' [_ [_ [_ _] ] ] ]; move: h''' => /(_ _ _ _ tpgp1) /= [? [? [? ?]]].
  rewrite eqphi in wildcard'1.
  by move:  (u10 _ _ wildcard'1) => [<- _].
Defined.
Next Obligation.
  cleanup'.
  move /An_CPiCong_inversion.
  move => [ph1 [ph2 [b1 [b2 [b3 [eqA [eqB [isoph1 [tpgp1 [tpgp2 [tpg3 h]]]]]]]]]]].
  apply: wildcard'.
  auto_uniq_full.
  have cG: c `notin` dom G by ok.
  have: phi1 = ph1 by congruence. move=> eqph1.
  have: phi2 = ph2 by congruence. move=> eqph2. rewrite eqph2.
  move: (An_CPi_inversion tpgp2). do 2 move=> [_]. move => /(_ c cG) h'.
  move: (get_tpg_correct' h') => ->.
  suff: B3c = (open_tm_wrt_co b3 (g_Var_f c)) by move=> ->.
  move: (h _ cG) => /= [h'' eqb3].
  auto_uniq_full.
  (* Fv in context for tpg hyp *)
  move: ann_context_fv_mutual => [h''' [_ [_ [_ _] ] ] ]; move: h''' => /(_ _ _ _ tpg3) /= [? [? [? ?]]].
  rewrite eqph1 in wildcard'2.
  rewrite eqB3c eqB2 eqb3.
  subst phi1.
  move:  (u10 _ _ wildcard'1) => [_ <-].
  rewrite close_tm_wrt_co_open_tm_wrt_co; by [|fsetdec].
Defined.
Next Obligation.
  cleanup'.
  move /An_CPiCong_inversion.
  move => [ph1 [ph2 [b1 [b2 [b3 [eqA [eqB [isoph1 [tpgp1 [tpgp2 [tpg3 h]]]]]]]]]]].
  apply: wildcard'.
  auto_uniq_full.
  have cG: c `notin` dom G by ok.
  have: phi1 = ph1 by congruence. move=> eqph1.
  have: phi2 = ph2 by congruence. move=> eqph2. rewrite eqph1.
  move: (An_CPi_inversion tpg3). do 2 move=> [_]. move => /(_ c cG) h'.
  move: (get_tpg_correct' h') => ->.
  suff: B2c = (open_tm_wrt_co b2 (g_Var_f c)) by move=> ->.
  move: (h _ cG) => /= [h'' eqb3].
  auto_uniq_full.
  (* Fv in context for tpg hyp *)
  move: ann_context_fv_mutual => [h''' [_ [_ [_ _] ] ] ]; move: h''' => /(_ _ _ _ tpg3) /= [? [? [? ?]]].
  rewrite eqph1 in wildcard'2.
  subst ph1.
  by move:  (u10 _ _ wildcard'1) => [_ <-].
Defined.
Next Obligation.
  cleanup'.
  (* Fv in context for eqdec hyp *)
  move: ann_context_fv_mutual => [_ [_ [_ [h''' _] ] ] ]; move: h''' => /(_ _ _ _  _ _ wildcard'1) /= [? [? [? ?]]].
  autoreg.
  rewrite eqB1 eqB3.
  eapply An_CPiCong_exists_3 with (c := c) (B2 := B2c);
    try eassumption.
  - fsetdec.
  - move: co_subst_co_tm_spec. congruence.
Defined.

(* An_CAbsCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: aux *)
  fsetdec.
Defined.
Next Obligation. (* Ctx wf *)
  cleanup'.
  autoreg.
  econstructor; try eassumption.
  fsetdec.
Defined.
Next Obligation.
  cleanup.
  move /An_CAbsCong_inversion.
  move => [ph1 [ph2 [a1' [a2' [a3' [B1' [B2' [B3' [eqA [eqB [isoph12 [tpg1 [tpg2 [tpg3 [defeq4 h]]]]]]]]]]]]]]].
  have cG: c `notin` dom G by ok.
  move: (h _ cG) => /= [defeq3 eq23].
  apply: wildcard'.
  auto_uniq_full; subst.
  by apply: defeq3.
Defined.
Next Obligation.
  eassumption.
Defined.
Next Obligation.
  cleanup_param clearbodies' idtac.
  move /An_CAbsCong_inversion.
  move => [ph1 [ph2 [a1' [a2' [a3' [B1' [B2' [B3' [eqA [eqB [isoph12 [tpg1 [tpg2 [tpg3 [defeq4 h]]]]]]]]]]]]]]].
  (* Fv in context for eqdec hyp *)
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg1) /= [? [? [? ?] ] ].
  have cG: c `notin` dom G by ok.
  move: (h _ cG) => /= [defeq3 eq23].
  apply: wildcard'.
  auto_uniq_full. (* TODO: it needs to be smarter on the opened contexts/when things are just congruent *)
  have eqphi1: phi1 = ph1 by move: (u0 _ _ wildcard'0) => [-> _].
  suff: a1 = a1' by move: (eqphi1) => [-> ->]; eassumption.
  rewrite eqphi1 in wildcard'1.
  move: (eqa1) (u5 _ _ wildcard'1) close_tm_wrt_co_open_tm_wrt_co => -> [<- _] ->; ok.
Defined.
Next Obligation.
  cleanup'.
  move /An_CAbsCong_inversion.
  move => [ph1 [ph2 [a1' [a2' [a3' [B1' [B2' [B3' [eqA [eqB [isoph12 [tpg1 [tpg2 [tpg3 [defeq4 h]]]]]]]]]]]]]]].
  (* Fv in context for eqdec hyp *)
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg1) /= [? [? [? ?] ] ].
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg2) /= [? [? [? ?] ] ].
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg3) /= [? [? [? ?] ] ].
  have cG: c `notin` dom G by ok.
  move: (h _ cG) => /= [defeq3 eq23].
  apply: wildcard'.
  auto_uniq_full. (* TODO: it needs to be smarter on the opened contexts/when things are just congruent *)
  have [eqphi1 eqphi2] : phi1 = ph1 /\ phi2 = ph2 by move: (u0 _ _ wildcard'0) => [-> ->]. subst ph1 ph2.

  subst CPi1.
  have: a1 = a1' by move: eqa1 (u _ _ defeq3) => -> [-> _]; autorewrite with lngen.
  intros; subst a1'.
  rewrite eqB1c.
  move: (An_CAbs_inversion tpg1) => [B0 [tmp h'']]. injection tmp.
  intros; subst B0.
  move: (h'' c cG) => [_ tpga1].
  move: (get_tpg_correct' tpga1).
  rewrite eqa1. autorewrite with lngen.
  move=> <-.
  by autorewrite with lngen.
Defined.
Next Obligation.
  cleanup'.
  move /An_CAbsCong_inversion.
  move => [ph1 [ph2 [a1' [a2' [a3' [B1' [B2' [B3' [eqA [eqB [isoph12 [tpg1 [tpg2 [tpg3 [defeq4 h]]]]]]]]]]]]]]].
  (* Fv in context for eqdec hyp *)
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg1) /= [? [? [? ?] ] ].
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg2) /= [? [? [? ?] ] ].
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ tpg3) /= [? [? [? ?] ] ].
  have cG: c `notin` dom G by ok.
  move: (h _ cG) => /= [defeq3 eq23].
  apply: wildcard'.
  auto_uniq_full. (* TODO: it needs to be smarter on the opened contexts/when things are just congruent *)
  have [eqphi1 eqphi2] : phi1 = ph1 /\ phi2 = ph2 by move: (u0 _ _ wildcard'0) => [-> ->]. subst ph1 ph2.

  subst CPi2.
  have: a2 = a2' by move: eqa2 (u _ _ defeq3) => -> [_ ->]; autorewrite with lngen.
  intros; subst a2'.
  have: a3 = a3' by rewrite eqa3 eqa3c -eq23; autorewrite with lngen.
  intros; subst a3'.
  rewrite eqB3c.
  move: (An_CAbs_inversion tpg2) => [B0 [tmp h'']]. injection tmp.
  intros; subst B0.
  move: (h'' c cG) => [_ tpga2].
  move: (get_tpg_correct' tpga2).
  rewrite eqa3. autorewrite with lngen.
  move=> <-.
  by autorewrite with lngen.
Defined.
Next Obligation.
  cleanup'.
  (* Fv in context for eqdec hyp *)
  move: ann_context_fv_mutual => [_ [_ [_ [h''' _]]]]; move: h''' => /(_ _ _ _  _ _ wildcard'2) /= [? [? [? ?]]].
  rewrite eqa1 eqa3.
  autoreg.
  (* FIXME: clearget not working here (losing an eq) *)
  (* clearget. *)
  eapply An_CAbsCong_exists3 with (c := c) (a2 := a2c) (B1 := B1c) (B3 := B3c); try eassumption; try congruence.
  - fsetdec.
  - rewrite co_subst_co_tm_spec.
    congruence.
  - by rewrite eqB1c.
  - by rewrite eqB3c.
Defined.
Next Obligation.
  hacky.
Defined.

(* An_CAppCong *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  subst Ta1 Ta2.

  (* Inversion and glueing *)
  inversion 1.
  have: a0 = a1 /\ b0 = a2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a0 b0; clear H4.
  have: a3 = b1 /\ b3 = b2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a3 b3; clear H5.

  (* Contra *)
  apply wildcard'.
  inversion H9.
  have: Ta11 = a0 by auto_uniq_full; congruence.
  move=> ?; subst a0.
  by auto_uniq_full.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  subst Ta1 Ta2.

  (* Inversion and glueing *)
  inversion 1.
  have: a0 = a1 /\ b0 = a2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a0 b0; clear H4.
  have: a3 = b1 /\ b3 = b2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a3 b3; clear H5.

  (* Contra *)
  apply wildcard'.
  inversion H9.
  have: Ta12 = b2 by auto_uniq_full; congruence.
  move=> ?; subst b2.
  by auto_uniq_full.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  subst Ta1 Ta2.

  (* Inversion and glueing *)
  inversion 1.
  have: a0 = a1 /\ b0 = a2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a0 b0; clear H4.
  have: a3 = b1 /\ b3 = b2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a3 b3; clear H5.

  (* Contra *)
  apply wildcard'.
  inversion H12.
  have: Ta21 = c1 by auto_uniq_full; congruence.
  move=> ?; subst c1.
  by auto_uniq_full.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  subst Ta1 Ta2.

  (* Inversion and glueing *)
  inversion 1.
  have: a0 = a1 /\ b0 = a2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a0 b0; clear H4.
  have: a3 = b1 /\ b3 = b2 by auto_uniq_full; split; congruence.
  move=> [? ?]; subst a3 b3; clear H5.

  (* Contra *)
  apply wildcard'.
  inversion H12.
  have: Ta22 = c2 by auto_uniq_full; congruence.
  move=> ?; subst c2.
  by auto_uniq_full.
Defined.
Next Obligation.
  (* FIXME: cleanup' not working *)
  clear dependent filtered_var.
  clear dependent filtered_var2.
  clear dependent filtered_var1.
  clear dependent filtered_var0.
  clear dependent filtered_var4.
  clear dependent filtered_var3. subst. clear dependent fuel.
  clean_fun. clearbodies'.

  autoreg.
  clearget.
  subst.

  apply: An_CAppCong2;
    try econstructor; eassumption.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  hacky.
Defined.

Solve Obligations of AnnDefEq_dec with discr_pat_match.

(* An_CPiSnd *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

Solve Obligations of AnnDefEq_dec with discr_pat_match.

(* FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME

   Make the pattern-match inversion tactic check whether or not it is applied to a goal it can solve (too slow to run on everything)

   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
   FIXME FIXME FIXME FIXME FIXME
*)

(* An_CastCo *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

(* An_PiFst *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

Solve Obligations of AnnDefEq_dec with discr_pat_match.

(* An_PiSnd *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  apply: An_PiSnd;
    subst; eauto.
Defined.
Next Obligation.
  hacky.
Defined.

Solve Obligations of AnnDefEq_dec with discr_pat_match.

Next Obligation.
  hacky.
Defined.

Solve Obligations of AnnDefEq_dec with discr_pat_match.

(* An_IsoSnd *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

(* FIXME: old cases. Currently, DefEq_dec is done at that point *)
(*
(* g_triv (impossible) *)
Next Obligation.
  (* FIXME: discriminate doesn't work *)
  inversion 1; ok.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'. autoreg.

  econstructor.
      move: (AnnDefEq_regularity wildcard'6). => [KA [KB [g' [tpgA [tpgB (* deqg' *) _]]]]]
  reg wildcard'6.
  ok.
Defined.
Next Obligation.
  ok.
Defined.
Next Obligation.
  ok.
Defined.
Next Obligation.
  ok.
Defined.
*)

(* An_Eta *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  eapply An_Eta with (L := dom G)(B := B).
  subst. auto.
  intros.
  rewrite -tm_subst_tm_tm_spec.
  simpl. destruct eq_dec; try done.
  rewrite tm_subst_tm_tm_fresh_eq. auto.
  auto.
Defined.
Next Obligation.
  eapply An_Eta with (L := dom G)(B := B).
  subst. auto.
  intros.
  rewrite -tm_subst_tm_tm_spec.
  simpl. edestruct eq_dec; try done.
  rewrite tm_subst_tm_tm_fresh_eq. auto.
  auto.
Defined.
Next Obligation.
  eapply An_EtaC with (L := dom G).
  subst. eapply wildcard'.
  intros.
  rewrite -co_subst_co_tm_spec.
  simpl. edestruct eq_dec; try done.
  rewrite co_subst_co_tm_fresh_eq. auto.
  move: (AnnTyping_context_fv wildcard') => h0.
  fsetdec.
Defined.
Next Obligation.
  cleanup. inversion 1; subst;
  inversion H0; clear H0;
  inversion H4; clear H4.
  destruct rho.
  move: (H5 A0 B0) => h0.
  destruct h0.
  eapply AnnTyping_unique. eauto. eauto.
  move: (H2 A0 B0) => h0.
  destruct h0.
  eapply AnnTyping_unique. eauto. eauto.
  move: (H0 phi) => h0.
  edestruct h0.
  eapply AnnTyping_unique. eauto. eauto.
Defined.

Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.
Next Obligation.
  unfold wildcard'.
  repeat split; intros; discriminate.
Defined.

 (* cleanup'.
  subst.
  move=> h0.
  inversion h0. subst.
  apply (H0 A0 B0).
  auto_uniq_full.
  apply u0.
  auto. admit. admit. *)

(*

Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.    *)

(*
(* An_Left *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  intro h0; inversion h0. subst.
  eapply wildcard'.
  erewrite <- get_tpg_correct'. eauto.
  auto_uniq_full.
  eauto.
  subst. eapply wildcard'.
  erewrite <- get_tpg_correct'. eauto.
  auto_uniq_full.
  try done.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  intro h0; inversion h0. subst.
  eapply wildcard'.
  erewrite <- get_tpg_correct'. eauto.
  auto_uniq_full.
  try done.
  subst.   eapply wildcard'.
  erewrite <- get_tpg_correct'. eauto.
  auto_uniq_full.
  try done.
Defined.
Next Obligation.
  eapply An_Left2; try eassumption.
 *)

(******** AnnIso_dec ********)

(* An_Cong *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  erewrite <- get_tpg_correct'; eassumption.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  erewrite <- get_tpg_correct'; eassumption.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  eassumption.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  erewrite <- get_tpg_correct'; eassumption.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  erewrite <- get_tpg_correct'; eassumption.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  eauto.
Defined.

(* An_CPiFst *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

Solve Obligations of AnnIso_dec with discr_pat_match.

(* An_IsoSym *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  eauto.
Defined.

(* An_IsoConv *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  rewrite Heq_phi1 Heq_phi2.
  subst A' B'.
  eapply An_IsoConv'.
   rewrite -Heq_phi1. reflexivity.
   rewrite -Heq_phi2. reflexivity.
  all: try eassumption.
Defined.

(******** AnnPropWff_dec ********)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

(******** AnnTyping_dec ********)
(* An_Star *)
Next Obligation.
  hacky.
Defined.

(* An_Var *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.

(* An_Pi *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: aux *)
  fsetdec.
Defined.
Next Obligation. (* Ctx Wf *)
  cleanup'.
  autoreg.
  subst.
  econstructor; eauto.
Defined.
Next Obligation.
  move /An_Pi_inversion => [_ [_] ].
  have xG: x `notin` dom G by fsetdec.
  move /(_ x xG).
  ok.
Defined.
Next Obligation.
  move /An_Pi_inversion => [? ?].
  cleanup.
  apply: wildcard'.
  auto_uniq_full.
  ok.
Defined.
Next Obligation.
  apply An_Pi_exists2 with (x := x); ok.
Defined.

(* An_Abs *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: aux *)
  fsetdec.
Defined.
Next Obligation. (* Ctx Wf *)
  cleanup'.
  autoreg.
  subst.
  econstructor; eauto.
Defined.
Next Obligation.
  cleanup.
  move /An_Abs_inversion => [? [_ [_] ] ].
  have xG: x `notin` dom G by fsetdec.
  move /(_ x xG).
  ok.
Defined.
Next Obligation.
  by move: (wf.AnnTyping_lc1 wildcard').
Defined.
Next Obligation.
  cleanup.
  move /An_Abs_inversion => [? [_ [_] ] ].
  have xG: x `notin` dom G by fsetdec.
  move /(_ x xG) => [h _].
  by apply wildcard'.
Defined.
Next Obligation.
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ wildcard'2) /= [? [? [? ?] ] ].
  eapply An_Abs_exists with (x := x); try done.
  - autorewrite with lngen. fsetdec.
  - by subst.
  - by autorewrite with lngen.
Defined.

(* An_App *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  subst.
  apply: An_App; eassumption.
Defined.
Next Obligation.
  hacky.
Defined.

Solve All Obligations with discr_pat_match.

(* An_Cast *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  hacky.
Defined.
Next Obligation.
  hacky.
  Unshelve.
  all: apply a_Star.
Defined.
Next Obligation.
  cleanup'.
  autoreg.
  clearget.
  subst.
  apply: An_Conv; eassumption.
Defined.

(* An_CApp *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  hacky.
Defined.
Next Obligation.
  subst.
  apply: An_CApp; eassumption.
Defined.
Next Obligation.
  hacky.
Defined.

Solve All Obligations with discr_pat_match.

(* An_Const *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  move: (an_toplevel_to_const wildcard') => AT.
  move: (AnnTyping_lc AT) => [lc1 lc2].
  eapply lc_set_tm_of_lc_tm. eauto.
Defined.
Next Obligation.
  inversion 1.
  (* TODO: uniq should be discharged via typeclasses/CS *)
  move: (binds_unique _ _ _ _ _ H3 wildcard'0 uniq_an_toplevel).
  intro h0. inversion h0. subst.
  move: (binds_to_type _ _ AnnSig_an_toplevel H3) => h1. done.
Defined.
Next Obligation.
  subst.
  apply: An_Const; eauto.
  eapply an_toplevel_to_const; eauto.
Defined.

(* An_CPi *)
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: aux *)
  fsetdec.
Defined.
Next Obligation.
  cleanup'.
  econstructor; try eassumption.
  fsetdec.
Defined.
Next Obligation.
  move /An_CPi_inversion => [_ [_] ].
  have cG: c `notin` dom G by fsetdec.
  move /(_ c cG).
  ok.
Defined.
Next Obligation.
  move /An_CPi_inversion => [_ [_] ].
  have cG: c `notin` dom G by fsetdec.
  move /(_ c cG) => /= h.
  apply wildcard'.
  auto_uniq_full.
  by move: (u0 _ wildcard'1) => ->.
Defined.
Next Obligation.
  apply An_CPi_exists with (c := c);
  ok.
Defined.

(* An_CAbs *)
Next Obligation.
  hacky.
Defined.
Next Obligation. (* Fuel: aux *)
  fsetdec.
Defined.
Next Obligation.
  cleanup'.
  econstructor; try eassumption.
  fsetdec.
Defined.
Next Obligation.
  move /An_CAbs_inversion => [? [? ] ].
  have cG: c `notin` dom G by fsetdec.
  move /(_ _ cG).
  ok.
Defined.
Next Obligation.
  move: ann_context_fv_mutual => [h'' [_ [_ [_ _] ] ] ]; move: h'' => /(_ _ _ _ wildcard') /= [? [? [? ?] ] ].
  apply An_CAbs_exists with (c := c); try eassumption.
  - autorewrite with lngen. fsetdec.
  - autorewrite with lngen. eassumption.
Defined.

(* An_Fam *)
Next Obligation.
  hacky.
Defined.
Next Obligation.
  clear_annoying.
  subst.
  move: (an_toplevel_closed wildcard') => tpg.
  autoreg. (* TODO: autoreg should do this one too (only use case though...) *)
  move: (AnnTyping_regularity tpg) => kdg.
  econstructor; eassumption.
Defined.

End fc_dec_fun.


From Undecidability.L.Tactics Require Import LTactics.
From Undecidability.L Require Import UpToC.
From Undecidability.L.Datatypes Require Export List.List_enc LBool LNat.
From Undecidability.Shared.Libs.PSL.Lists Require Export Filter.

Set Default Proof Using "Type".

Definition c__app := 16.
#[global]
Instance termT_append X {intX : registered X} : computableTime' (@List.app X) (fun A _ => (5,fun B _ => (length A * c__app + c__app,tt))).
Proof.
  extract.
  solverec. all: now unfold c__app.
Qed.

Definition c__map := 12.
Fixpoint map_time {X} (fT:X -> nat) xs :=
  match xs with
    [] => c__map
  | x :: xs => fT x + map_time fT xs + c__map
  end.

#[global]
Instance term_map (X Y:Type) (Hx : registered X) (Hy:registered Y): computableTime' (@map X Y) (fun _ fT => (1,fun l _ => (map_time (fun x => fst (fT x tt)) l,tt))).
Proof.
  extract.
  solverec. all: unfold c__map; solverec.
Defined. (*because other extract*)

Lemma map_time_const {X} c (xs:list X):
  map_time (fun _ => c) xs = length xs * (c + c__map) + c__map.
Proof.
  induction xs;cbn. all:lia.
Qed.

Lemma mapTime_upTo X (t__f : X -> nat):
  map_time t__f <=c (fun l => length l + sumn (map t__f l) + 1 ).
Proof.
  unfold map_time. exists c__map; unfold c__map.
  induction x; cbn - [plus mult]; nia.
Qed.

#[global]
Instance term_map_noTime (X Y:Type) (Hx : registered X) (Hy:registered Y): computable (@map X Y).
Proof.
  extract.
Defined. (*because other extract*)

#[global]
Instance termT_rev_append X `{registered X}: computableTime' (@rev_append X) (fun l _ => (5,fun res _ => (length l*13+4,tt))).
Proof.
  extract.
  recRel_prettify.
  solverec.
Qed.

Definition c__rev := 13.
#[global]
Instance termT_rev X `{registered X}: computableTime' (@rev X) (fun l _ => ((length l + 1) *c__rev,tt)).
Proof.
  eapply computableTimeExt with (x:= fun l => rev_append l []).
  {intro. rewrite rev_alt. reflexivity. }
  extract. solverec. unfold c__rev; solverec.
Qed.

Section Fix_X.
  Variable (X:Type).
  Context {intX : registered X}.

  Global Instance term_filter: computableTime' (@filter X) (fun p pT => (1,fun l _ => (fold_right (fun x res => 16 + res + fst (pT x tt)) 8 l ,tt))).
  Proof using intX.
    change (filter (A:=X)) with ((fun (f : X -> bool) =>
                                    fix filter (l : list X) : list X := match l with
                                                                        | [] => []
                                                                        | x :: l0 => (fun r => if f x then x :: r else r) (filter l0)
                                                                        end)).
    extract.
    solverec.
  Defined. (*because other extract*)

  Global Instance term_filter_notime: computable (@filter X).
  Proof using intX.
  pose (t:= extT (@filter X)). hnf in t.
    computable using t.
  Defined. (*because other extract*)

  Global Instance term_repeat: computable (@repeat X).
  Proof using intX.
    extract.
  Qed.

End Fix_X.

Section concat.
  Context X `{registered X}.

  Fixpoint rev_concat acc (xs : list (list X)) :=
    match xs with
      [] => acc
    | x::xs => rev_concat (rev_append x acc) xs
    end.

  Lemma rev_concat_rev xs acc:
    rev (rev_concat acc xs) = rev acc ++ concat xs.
  Proof.
    induction xs in acc|-*. all:cbn. 2:rewrite IHxs,rev_append_rev. all:autorewrite with list in *. all:easy.
  Qed.

  Lemma rev_concat_length xs acc:
    length (rev_concat acc xs) = length acc + length (concat xs).
  Proof.
    specialize (rev_concat_rev xs acc) as H1%(f_equal (@length _)).
    autorewrite with list in H1. nia.
  Qed.

  Lemma _term_rev_concat :
    { time : UpToC (fun l => sumn (map (@length _) l) + length l + 1) &
             computableTime' (@rev_concat) (fun _ _ => (5,fun l _ => (time l,tt)))}.
  Proof.
    evar (c1 : nat).
    exists_UpToC (fun l => c1 * (sumn (map (@length _) l) + length l + 1) ).
    { extract. recRel_prettify2.
      all:cbn - [plus mult].
      all:enough (c1>=20) by nia.
      instantiate (c1:=20). all:subst c1;nia.
    }
    smpl_upToC_solve.
  Qed.
  Global Instance term_rev_concat : computableTime' rev_concat _ := projT2 _term_rev_concat.

  Lemma _term_concat :
    { time : UpToC (fun l => sumn (map (@length _) l) + length l + 1) &
             computableTime' (@concat X) (fun l _ => (time l,tt))}.
  Proof.
    eexists_UpToC time. [time]: intros x.
    eapply computableTimeExt with (x := fun l => rev (rev_concat [] l)).
    -intros l;hnf. rewrite rev_concat_rev. easy.
    -extract. solverec. unfold time. reflexivity.
    -unfold time. smpl_upToC; try smpl_upToC_solve.
     setoid_rewrite rev_concat_length. setoid_rewrite length_concat. smpl_upToC_solve.
  Qed.

  Global Instance term_concat : computableTime' (@concat X) _ := projT2 _term_concat.

End concat.


(* Distributed under the terms of the MIT license. *)
From MetaCoq.Utils Require Import utils.
From MetaCoq.Common Require Import config.
From MetaCoq.Erasure Require Import EAstUtils Extract EArities EWcbvEval.
From MetaCoq.PCUIC Require Import PCUICTyping PCUICAst PCUICAstUtils
     PCUICSubstitution PCUICLiftSubst PCUICClosedTyp
     PCUICReduction PCUICWcbvEval PCUICSR PCUICInversion PCUICGeneration
     PCUICContextConversion PCUICArities PCUICWellScopedCumulativity PCUICConversion
     PCUICWeakeningEnvTyp PCUICCanonicity.
From MetaCoq.SafeChecker Require Import PCUICErrors.
From Coq Require Import Program ssreflect.

Local Existing Instance extraction_checker_flags.

Ltac inv H := inversion H; subst; clear H.

Lemma typing_spine_inv args arg a Σ x2 x3 :
  nth_error args (arg) = Some a ->
  typing_spine Σ [] x2 args x3 ->
  {T & Σ;;; [] |- a : T}.
Proof.
  intros. revert arg H.
  dependent induction X; intros arg H17.
  - rewrite nth_error_nil in H17. congruence.
  - destruct (arg)%nat eqn:EAst.
    + cbn in H17. invs H17. eauto.
    + cbn in H17. eauto.
Qed.

Definition well_typed Σ Γ t := ∑ T, Σ ;;; Γ |- t : T.

Lemma typing_spine_wt args Σ x2 x3 :  wf Σ.1 ->
  typing_spine Σ [] x2 args x3 ->
  All (well_typed Σ []) args.
Proof.
  intros wfΣ sp.
  dependent induction sp; constructor; auto.
  now exists A.
Qed.

Lemma typing_spine_eval:
  forall (Σ : global_env_ext) (args args' : list PCUICAst.term)
  (X : All2 (PCUICWcbvEval.eval Σ) args args') (bla : wf Σ)
    (T x x0 : PCUICAst.term) (t0 : typing_spine Σ [] x args x0)
    (c : Σ;;; [] ⊢ x0 ≤ T) (x1 : PCUICAst.term)
    (c0 : Σ;;; [] ⊢ x1 ≤ x), isType Σ [] x1 -> isType Σ [] T -> typing_spine Σ [] x1 args' T.
Proof.
  intros. eapply typing_spine_red; eauto.
  eapply typing_spine_wt in t0; auto.
  eapply All2_All_mix_left in X; eauto. simpl in X.
  eapply All2_impl. eassumption. simpl. intros t u [ct et]. eapply wcbeval_red; eauto.
  eapply (projT2 ct).
Qed.

Lemma cumul_Sort_Prod_discr {Σ Γ T s na A B} :
  wf_ext Σ ->
  Σ ;;; Γ ⊢ T ≤ tSort s ->
  Σ ;;; Γ ⊢ T ≤ tProd na A B -> False.
Proof.
  intros wfΣ hs hs'.
  eapply ws_cumul_pb_Sort_r_inv in hs as [s' []].
  eapply ws_cumul_pb_Prod_r_inv in hs' as [dom' [codom' [T' []]]].
  destruct (closed_red_confluence c c1) as [nf []].
  eapply invert_red_sort in c2; subst.
  eapply invert_red_prod in c3 as [? [? []]]. discriminate.
Qed.

(** ** on mkApps *)

Lemma emkApps_snoc a l b :
  EAst.mkApps a (l ++ [b]) = EAst.tApp (EAst.mkApps a l) b.
Proof.
  revert a; induction l; cbn; congruence.
Qed.

Lemma mkApps_snoc a l b :
  PCUICAst.mkApps a (l ++ [b]) = PCUICAst.tApp (PCUICAst.mkApps a l) b.
Proof.
  revert a; induction l; cbn; congruence.
Qed.

Lemma mkAppBox_repeat n a :
  mkAppBox a n = EAst.mkApps a (repeat EAst.tBox n).
Proof.
  revert a; induction n; cbn; firstorder congruence.
Qed.

Lemma decompose_app_rec_inv2 {t l' f l} :
  decompose_app_rec t l' = (f, l) ->
  isApp f = false.
Proof.
  induction t in f, l', l |- *; try intros [= <- <-]; try reflexivity.
  simpl. apply IHt1.
Qed.

Module Ee := EWcbvEval.

Lemma fst_decompose_app_rec t l : fst (EAstUtils.decompose_app_rec t l) = fst (EAstUtils.decompose_app t).
Proof.
  induction t in l |- *; simpl; auto. rewrite IHt1.
  unfold decompose_app. simpl. now rewrite (IHt1 [t2]).
Qed.

(** ** Prelim on fixpoints *)

Lemma fix_subst_nth mfix n :
  n < #|mfix| ->
  nth_error (fix_subst mfix) n = Some (tFix mfix (#|mfix| - n - 1)).
Proof.
  unfold fix_subst. generalize (#|mfix|).
  intros m. revert n. induction m; cbn; intros.
  - destruct n; inv H.
  - destruct n.
    + cbn. now rewrite Nat.sub_0_r.
    + cbn. rewrite IHm. lia. reflexivity.
Qed.

Lemma efix_subst_nth mfix n :
  n < #|mfix| ->
  nth_error (EGlobalEnv.fix_subst mfix) n = Some (EAst.tFix mfix (#|mfix| - n - 1)).
Proof.
  unfold EGlobalEnv.fix_subst. generalize (#|mfix|).
  intros m. revert n. induction m; cbn; intros.
  - destruct n; inv H.
  - destruct n.
    + cbn. now rewrite Nat.sub_0_r.
    + cbn. rewrite IHm. lia. reflexivity.
Qed.

Lemma subslet_fix_subst `{cf : checker_flags} Σ mfix1 T n :
  wf Σ.1 ->
  Σ ;;; [] |- tFix mfix1 n : T ->
  subslet Σ [] (fix_subst mfix1) (fix_context mfix1).
Proof.
  intro hΣ.
  unfold fix_subst, fix_context.
  assert (exists L, mfix1 = mfix1 ++ L) by (exists []; now simpl_list). revert H.
  generalize mfix1 at 2 5 6.  intros.
  induction mfix0 using rev_ind.
  - econstructor.
  - rewrite mapi_app. cbn in *. rewrite rev_app_distr. cbn in *.
    rewrite app_length. cbn. rewrite Nat.add_comm /=; econstructor.
    + eapply IHmfix0. destruct H as [L]. exists (x :: L). subst. now rewrite <- app_assoc.
    + rewrite <- plus_n_O.
      rewrite PCUICLiftSubst.simpl_subst_k. clear. induction l; cbn; try congruence.
      eapply inversion_Fix in X as (? & ? & ? & ? & ? & ? & ?) ; auto.
      econstructor; eauto. destruct H. subst.
      rewrite <- app_assoc, nth_error_app_ge; try lia.
      now rewrite Nat.sub_diag.
Qed.

Lemma cofix_subst_nth mfix n :
  n < #|mfix| ->
  nth_error (cofix_subst mfix) n = Some (tCoFix mfix (#|mfix| - n - 1)).
Proof.
  unfold cofix_subst. generalize (#|mfix|).
  intros m. revert n. induction m; cbn; intros.
  - destruct n; inv H.
  - destruct n.
    + cbn. now rewrite Nat.sub_0_r.
    + cbn. rewrite IHm; lia_f_equal.
Qed.

Lemma ecofix_subst_nth mfix n :
  n < #|mfix| ->
  nth_error (EGlobalEnv.cofix_subst mfix) n = Some (EAst.tCoFix mfix (#|mfix| - n - 1)).
Proof.
  unfold EGlobalEnv.cofix_subst. generalize (#|mfix|).
  intros m. revert n. induction m; cbn; intros.
  - destruct n; inv H.
  - destruct n.
    + cbn. now rewrite Nat.sub_0_r.
    + cbn. rewrite IHm. lia. reflexivity.
Qed.

Lemma subslet_cofix_subst `{cf : checker_flags} Σ mfix1 T n :
  wf Σ.1 ->
  Σ ;;; [] |- tCoFix mfix1 n : T ->
  subslet Σ [] (cofix_subst mfix1) (fix_context mfix1).
Proof.
  intro hΣ.
  unfold cofix_subst, fix_context.
  assert (exists L, mfix1 = mfix1 ++ L)%list by (exists []; now simpl_list). revert H.
  generalize mfix1 at 2 5 6.  intros.
  induction mfix0 using rev_ind.
  - econstructor.
  - rewrite mapi_app. cbn in *. rewrite rev_app_distr. cbn in *.
    rewrite app_length /= Nat.add_comm /=. econstructor.
    + eapply IHmfix0. destruct H as [L]. exists (x :: L). subst. now rewrite <- app_assoc.
    + rewrite <- plus_n_O.
      rewrite PCUICLiftSubst.simpl_subst_k. clear. induction l; cbn; try congruence.
      eapply inversion_CoFix in X as (? & ? & ? & ? & ? & ? & ?) ; auto.
      econstructor; eauto. destruct H. subst.
      rewrite <- app_assoc. rewrite nth_error_app_ge. lia.
      now rewrite Nat.sub_diag.
Qed.

Lemma unfold_cofix_type Σ mfix idx args narg fn ty :
  wf Σ.1 ->
  Σ ;;; [] |- mkApps (tCoFix mfix idx) args : ty ->
  unfold_cofix mfix idx = Some (narg, fn) ->
  Σ ;;; [] |- mkApps fn args : ty.
Proof.
  intros wfΣ ht.
  pose proof (typing_wf_local ht).
  eapply PCUICValidity.inversion_mkApps in ht as (? & ? & ?); eauto.
  eapply inversion_CoFix in t; auto.
  destruct_sigma t.
  rewrite /unfold_cofix e => [=] harg hfn.
  subst fn.
  eapply PCUICSpine.typing_spine_strengthen in t0; eauto.
  eapply PCUICSpine.type_mkApps; eauto.
  pose proof a0 as a0'.
  eapply nth_error_all in a0'; eauto. simpl in a0'.
  eapply (substitution (Δ := [])) in a0'; eauto.
  2:{ eapply subslet_cofix_subst; pcuic. constructor; eauto. }
  rewrite PCUICLiftSubst.simpl_subst_k in a0'. now autorewrite with len.
  eapply a0'. now eapply nth_error_all in a; tea.
Qed.

(** Assumption contexts: constructor arguments/case branches contexts contain only assumptions, no local definitions *)

Lemma is_assumption_context_spec Γ :
  is_true (is_assumption_context Γ) <-> PCUICLiftSubst.assumption_context Γ.
Proof.
 induction Γ; cbn.
 - split; econstructor.
 - split; intros H.
   + destruct a; cbn in *. destruct decl_body; inversion H. now econstructor.
   + invs H. cbn. now eapply IHΓ.
Qed.

Lemma assumption_context_map2_binders nas Γ :
  assumption_context Γ ->
  assumption_context (map2 set_binder_name nas Γ).
Proof.
  induction 1 in nas |- *; cbn. destruct nas; cbn; auto; constructor.
  destruct nas; cbn; auto; constructor. auto.
Qed.

Lemma declared_constructor_assumption_context (wfl := default_wcbv_flags) {Σ c mdecl idecl cdecl} {wfΣ : wf_ext Σ} :
  declared_constructor Σ c mdecl idecl cdecl ->
  assumption_context (cstr_args cdecl).
Proof.
  intros.
  destruct (on_declared_constructor H) as [? [cu [_ onc]]].
  destruct onc.
  now eapply is_assumption_context_spec.
Qed.

Lemma assumption_context_cstr_branch_context (wfl := default_wcbv_flags) {Σ} {wfΣ : wf_ext Σ} {c mdecl idecl cdecl} :
  declared_constructor Σ c mdecl idecl cdecl ->
  assumption_context (cstr_branch_context c.1 mdecl cdecl).
Proof.
  intros decl.
  eapply declared_constructor_assumption_context in decl.
  rewrite /cstr_branch_context. pcuic.
Qed.

Lemma expand_lets_erasure (wfl := default_wcbv_flags) {Σ mdecl idecl cdecl c brs p} {wfΣ : wf_ext Σ} :
  declared_constructor Σ c mdecl idecl cdecl ->
  wf_branches idecl brs ->
  All2i (fun i cdecl br =>
   All2 (PCUICEquality.compare_decls eq eq) (bcontext br)
      (cstr_branch_context c.1 mdecl cdecl)) 0 idecl.(ind_ctors) brs ->
  All (fun br =>
    expand_lets (inst_case_branch_context p br) (bbody br) = bbody br) brs.
Proof.
  intros decl wfbrs.
  red in wfbrs.
  eapply Forall2_All2 in wfbrs.
  intros ai.
  eapply All2i_nth_hyp in ai.
  eapply All2i_All2_mix_left in ai; tea. clear wfbrs.
  solve_all.
  red in a. red in a.
  erewrite <- PCUICCasesContexts.inst_case_branch_context_eq; tea.
  rewrite PCUICSigmaCalculus.expand_lets_assumption_context //.
  eapply assumption_context_map2_binders.
  rewrite /pre_case_branch_context_gen /inst_case_context.
  eapply PCUICInductiveInversion.assumption_context_subst_context.
  eapply PCUICInductiveInversion.assumption_context_subst_instance.
  destruct c. cbn.
  eapply (assumption_context_cstr_branch_context (c:=(i0, i))). split. apply decl. tea.
Qed.

Lemma assumption_context_compare_decls Γ Δ :
  PCUICEquality.eq_context_upto_names Γ Δ ->
  assumption_context Γ ->
  assumption_context Δ.
Proof.
  induction 1; auto.
  intros H; depelim H.
  depelim r; econstructor; auto.
Qed.

Lemma smash_assumption_context Γ Δ : assumption_context Γ ->
  smash_context Δ Γ = Γ ,,, Δ.
Proof.
  intros ass; induction ass in Δ |- *; cbn; auto.
  - now rewrite app_context_nil_l.
  - rewrite PCUICSigmaCalculus.smash_context_acc /app_context.
    rewrite IHass /=.
    rewrite -(app_tip_assoc Δ _ Γ). f_equal.
    rewrite -/(expand_lets_k_ctx Γ 0 _).
    rewrite [expand_lets_k_ctx _ _ _]PCUICSigmaCalculus.expand_lets_ctx_assumption_context //.
Qed.

Import PCUICGlobalEnv PCUICSpine.
Lemma subslet_cstr_branch_context {cf : checker_flags} {Σ : global_env_ext} {wfΣ : wf Σ}
  {Γ pars parsubst parsubst' s' inst' ind n mdecl idecl cdecl u p br napp} :
  declared_constructor Σ (ind, n) mdecl idecl cdecl ->
  consistent_instance_ext Σ (ind_universes mdecl) u ->
  consistent_instance_ext Σ (ind_universes mdecl) (puinst p) ->
  PCUICEquality.R_global_instance Σ (eq_universe Σ) (leq_universe Σ) (IndRef ind) napp u (puinst p) ->
  spine_subst Σ Γ pars parsubst (ind_params mdecl)@[u] ->
  spine_subst Σ Γ (pparams p) parsubst' (ind_params mdecl)@[puinst p] ->
  assumption_context cdecl.(cstr_args) ->
  ws_cumul_pb_terms Σ Γ pars (pparams p) ->
  wf_predicate mdecl idecl p ->
  wf_branch cdecl br ->
  PCUICSpine.spine_subst Σ Γ s' inst'
    (subst_context parsubst 0 (subst_context (inds (inductive_mind ind) u (ind_bodies mdecl)) #|ind_params mdecl| (cstr_args cdecl)@[u])) ->
  subslet Σ Γ (List.rev s') (case_branch_context ind mdecl p (forget_types (bcontext br)) cdecl).
Proof.
  intros declc cu cu' hr sppars sppars' assargs eqp wfp wfbr spargs.
  rewrite /case_branch_context /case_branch_context_gen.
  eapply PCUICSpine.subslet_eq_context_alpha.
  symmetry. eapply PCUICCasesContexts.eq_binder_annots_eq.
  eapply PCUICInductiveInversion.wf_pre_case_branch_context_gen; tea.
  rewrite /pre_case_branch_context_gen /inst_case_context.
  rewrite /cstr_branch_context.
  rewrite PCUICInductiveInversion.subst_instance_expand_lets_ctx PCUICUnivSubstitutionConv.subst_instance_subst_context.
  rewrite PCUICInductives.instantiate_inds //. exact declc.
  epose proof (PCUICInductiveInversion.constructor_cumulative_indices declc cu cu' hr _ _ _ _ _ sppars sppars' eqp) as [eqctx _].
  cbn in eqctx.
  epose proof (spine_subst_smash spargs).
  eapply spine_subst_cumul in X. eapply X.
  pcuic. pcuic. apply X.
  { eapply substitution_wf_local. eapply (spine_subst_smash sppars').
    eapply PCUICInductives.wf_local_expand_lets.
    rewrite -app_context_assoc.
    eapply PCUICWeakeningTyp.weaken_wf_local => //. eapply sppars.
    eapply (PCUICSR.on_constructor_wf_args declc) => //. }
  rewrite /=.
  rewrite -(spine_subst_inst_subst sppars').
  assert (smash_context [] (cstr_args cdecl)@[puinst p] = (cstr_args cdecl)@[puinst p]).
  { rewrite smash_assumption_context //. pcuic. }
  rewrite -H.
  rewrite -PCUICClosed.smash_context_subst /= subst_context_nil.
  rewrite -PCUICClosed.smash_context_subst /= subst_context_nil. apply eqctx.
Qed.

(** ** Prelim on typing *)

Inductive red_decls Σ Γ Γ' : forall (x y : context_decl), Type :=
| conv_vass na na' T T' : isType Σ Γ' T' -> red Σ Γ T T' ->
  eq_binder_annot na na' ->
  red_decls Σ Γ Γ' (vass na T) (vass na' T')

| conv_vdef_type na na' b T T' : isType Σ Γ' T' -> red Σ Γ T T' ->
  eq_binder_annot na na' ->
  red_decls Σ Γ Γ' (vdef na b T) (vdef na' b T')

| conv_vdef_body na na' b b' T : isType Σ Γ' T ->
  eq_binder_annot na na' ->
  Σ ;;; Γ' |- b' : T -> red Σ Γ b b' ->
  red_decls Σ Γ Γ' (vdef na b T) (vdef na' b' T).

Notation red_context Σ := (All2_fold (red_decls Σ)).

Lemma conv_context_app (Σ : global_env_ext) (Γ1 Γ2 Γ1' : context) :
  wf Σ ->
  wf_local Σ (Γ1 ,,, Γ2) ->
  conv_context cumulSpec0 Σ Γ1 Γ1' -> conv_context cumulSpec0 Σ (Γ1 ,,, Γ2) (Γ1' ,,, Γ2).
Proof.
  intros. induction Γ2.
  - cbn; eauto.
  - destruct a. destruct decl_body.
    + cbn. econstructor. inv X0. apply IHΓ2. eauto.
      depelim X0; econstructor; reflexivity.
    + cbn. econstructor. inv X0. apply IHΓ2. eauto. now econstructor.
Qed.


(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)

(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*                Solange Coupet-Grimal & Line Jakubiec-Jamet               *)
(*                                                                          *)
(*                                                                          *)
(*             Laboratoire d'Informatique Fondamentale de Marseille         *)
(*                   CMI et Faculté des Sciences de Luminy                  *)
(*                                                                          *)
(*           e-mail:{Solange.Coupet,Line.Jakubiec}@lif.univ-mrs.fr          *)
(*                                                                          *)
(*                                                                          *)
(*                            Developped in Coq v6                          *)
(*                            Ported to Coq v7                              *)
(*                            Translated to Coq v8                          *)
(*                                                                          *)
(*                             July 12nd 2005                               *)
(*                                                                          *)
(****************************************************************************)
(*                             Timing_Arbiter.v                             *)
(****************************************************************************)

Require Export Tools_Inf.
Require Export Behaviour_Struct_lemmas.

Set Implicit Arguments.
Unset Strict Implicit.

Section Timing_Arbiter_Proof.

  Variable Fs : Stream bool.
  Variable Act : Stream (d_list bool 4).

(** Hypothesis on the input signals fs and act **)

  Hypothesis fs_0 : S_head Fs = false.

  Hypothesis
    fs_act_signals : EqS sig_false (S_map2 andb (S_tail Fs) (S_Ackor Act)).

  Definition P_Timing (fs : bool) (st : label_t) :=
    false = fs && Out_Timing st.

 CoInductive Inv_P_Timing : Stream bool -> Stream label_t -> Prop :=
     C_Inv_t :
       forall (i : Stream bool) (s : Stream label_t),
       P_Timing (S_head i) (S_head s) ->
       Inv_P_Timing (S_tail i) (S_tail s) -> Inv_P_Timing i s.

 Lemma eqS_Inv_P_Timing :
  forall (i i' : Stream bool) (s s' : Stream label_t),
  EqS i i' -> EqS s s' -> Inv_P_Timing i' s' -> Inv_P_Timing i s.
  Proof.
  cofix eqS_Inv_P_Timing.
  intros i i' s s' H_i H_s H_P.
  inversion_clear H_i.
  inversion_clear H_s.
  inversion_clear H_P.
  apply C_Inv_t.
  rewrite H; rewrite H1; try trivial.
  apply eqS_Inv_P_Timing with (S_tail i') (S_tail s'); trivial.
  Qed.

(** P_Timing is an invariant property **)

  Lemma eq_fs_and_RouteE_false :
   forall (e : bool * d_list bool 4) (s : label_t),
   P_Timing (fst e) (Trans_Timing e s).
 Proof.
 unfold P_Timing in |- *.
 intros e s; elim e; clear e; intros fs act.
 elim (Lib_Bool.bool_dec fs); intros H_fs.
 rewrite H_fs; simpl in |- *.
 case s; case (Ackor act); simpl in |- *; auto.
 rewrite H_fs; simpl in |- *; auto.
 Qed.

 Lemma Is_Inv_P_Timing :
  forall s : label_t, Inv_P_Timing Fs (States_TIMING (Compact Fs Act) s).
 Proof.
 intro s.
 apply C_Inv_t.
 simpl in |- *; rewrite fs_0; unfold P_Timing in |- *; auto.
 generalize Fs Act s fs_act_signals.
 clear fs_act_signals fs_0 s Act Fs.
 cofix Is_Inv_P_Timing.
 intros fs act s H_sig.
 inversion_clear H_sig.
 apply C_Inv_t.
 simpl in |- *.
 generalize
  (eq_fs_and_RouteE_false (S_head (S_tail fs), S_head (S_tail act))
     (Trans_Timing (S_head fs, S_head act) s)); simpl in |- *;
  auto.
 simpl in H.
 generalize H.
 case (S_head (S_tail fs)); simpl in |- *.
 intros h; elim h; simpl in |- *.
 intros h'; clear h'.
 case s; case (S_head fs); unfold P_Timing in |- *; simpl in |- *; auto.
 unfold P_Timing in |- *; auto.
 simpl in Is_Inv_P_Timing; simpl in |- *.
 apply Is_Inv_P_Timing.
 apply H0.

 Qed.

(* Proof that the property P_a4 taken for the FOUR_ARBITERS proof holds *)
(* for the output of TIMING : we exhibit an invariant Inv_t_a4 *)
(* Proof that : sa=AT_LEAST_ONE_IS_ACTIVE_a4 \/ sa=WAIT_a4 -> RouteE=false *)
(* Avec RouteE=(Out_Timing st) *)

Definition Inv_t_a4 (s_a4 : STATE_a4) (st : label_t) :=
  let (sa4, _) := s_a4 in
  sa4 = START_a4 /\ st = START_t \/
  sa4 = START_a4 /\ st = WAIT_t \/
  sa4 = START_a4 /\ st = ROUTE_t \/
  sa4 = AT_LEAST_ONE_IS_ACTIVE_a4 /\ st = START_t \/
  sa4 = WAIT_a4 /\ st = START_t.

(** Inv_t_a4 is an invariant **)

Lemma Inv_Init_states_t_a4 :
 forall (g : d_list (bool * bool) 4) (o : d_list bool 4),
 Inv_t_a4 (WAIT_a4, (g, o)) START_t.
Proof.
unfold Inv_t_a4 in |- *; intros g o; do 3 right; auto.
Qed.

Lemma Inv_t_a4_Ok :
 forall (sa4 : STATE_a4) (st : label_t) (fs : bool)
   (act : d_list bool 4) (ltReq : d_list (d_list bool 4) 4),
 P_Timing fs st ->
 Inv_t_a4 sa4 st ->
 Inv_t_a4 (Trans_Four_Arbiters (fs, (Out_Timing st, ltReq)) sa4)
   (Trans_Timing (fs, act) st).
Proof.
unfold Inv_t_a4 at 1 in |- *.
intros sa4 st fs' act' ltReq'; elim sa4; clear sa4.
intros sa4 g P H.
elim g; clear g; intros g o.
elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *.
case fs'; simpl in |- *; auto.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *.
case (Ackor act'); simpl in |- *; auto.
case fs'; simpl in |- *; auto.

elim H; clear H; intros H.
generalize P; clear P.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *.
case fs'; simpl in |- *.
unfold P_Timing in |- *; simpl in |- *; intros Abs.
absurd (false = true); auto.

intro H0; clear H0.
case (Ackor (d_map (Ackor (n:=3)) ltReq')); simpl in |- *; auto.
right; right; right; auto.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *.
case fs'; simpl in |- *; auto.
right; right; right; right; auto.

elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *.
case fs'; simpl in |- *; auto.
right; right; right; right; auto.

Qed.

Lemma P_a4_inv :
 forall (sa4 : STATE_a4) (st : label_t) (fs : bool)
   (ltReq : d_list (d_list bool 4) 4)
   (old_a4 : d_list bool 2 * bool * (d_list bool 2 * bool) *
             (d_list bool 2 * bool * (d_list bool 2 * bool))),
 Inv_t_a4 sa4 st -> P_a4 (fs, (Out_Timing st, ltReq)) sa4 old_a4.
Proof.
unfold Inv_t_a4 in |- *; unfold P_a4 in |- *.
intros sa4 st fs' ltReq' old_a4; clear fs' ltReq' old_a4.
elim sa4; clear sa4; simpl in |- *.
intros sa4 g H.
elim g; clear g; intros g o.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *; auto.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *; auto.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *; auto.
intro H; elim H; clear H; intro Abs.
absurd (START_a4 = AT_LEAST_ONE_IS_ACTIVE_a4); auto.
discriminate.
absurd (START_a4 = WAIT_a4); auto.
discriminate.

elim H; clear H; intros H.
elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *; auto.

elim H; clear H; intros H1 H2; rewrite H1; rewrite H2; simpl in |- *; auto.

Qed.

(* Proof that P_a4 is invariant *)

Lemma Inv_a4 :
 forall (sa4 : STATE_a4) (st : label_t)
   (old_a4 : d_list bool 2 * bool * (d_list bool 2 * bool) *
             (d_list bool 2 * bool * (d_list bool 2 * bool)))
   (ltReq : Stream (d_list (d_list bool 4) 4)),
 Inv_t_a4 sa4 st ->
 Inv P_a4 (Compact Fs (Compact (Behaviour_TIMING (Compact Fs Act) st) ltReq))
   (States_FOUR_ARBITERS
      (Compact Fs (Compact (Behaviour_TIMING (Compact Fs Act) st) ltReq)) sa4)
   (Structure_States_FOUR_ARBITERS
      (Compact Fs (Compact (Behaviour_TIMING (Compact Fs Act) st) ltReq))
      old_a4).
Proof.
intros sa st old_a4 ltReq H_I.
generalize (Is_Inv_P_Timing st).
generalize sa st old_a4 Fs Act ltReq H_I.
cofix Inv_a4.
intros sa' st' old_a4' fs' act' ltReq' H_I' H_P'.
inversion_clear H_P'.
apply C_Inv.
simpl in H.
rewrite S_head_Compact.
rewrite S_head_Compact.
rewrite S_head_Behaviour_TIMING.
apply P_a4_inv; try trivial.

generalize
 (Inv_a4
    (Trans_Four_Arbiters
       (S_head
          (Compact fs'
             (Compact (Behaviour_TIMING (Compact fs' act') st') ltReq'))) sa')
    (Trans_Timing (S_head (Compact fs' act')) st')
    (Trans_Struct_four_arbiters
       (S_head
          (Compact fs'
             (Compact (Behaviour_TIMING (Compact fs' act') st') ltReq')))
       old_a4') (S_tail fs') (S_tail act') (S_tail ltReq')).
clear Inv_a4.
intro a4_I; apply a4_I.
rewrite S_head_Compact.
rewrite S_head_Compact.
rewrite S_head_Behaviour_TIMING.
rewrite S_head_Compact.
apply Inv_t_a4_Ok; try trivial.
try trivial.
Qed.

End Timing_Arbiter_Proof.

Require Import Arbitration_beh_sc.

Lemma S_tail_Behaviour_TIMINGPDECODE_ID :
 forall
   (i : Stream
          (bool *
           (d_list bool 4 * (d_list bool 4 * d_list (d_list bool 2) 4))))
   (s : state_id * (label_t * STATE_p)),
 S_tail (Behaviour_TIMINGPDECODE_ID i s) =
 Behaviour_TIMINGPDECODE_ID (S_tail i) (Trans_TimingPDecode_Id (S_head i) s).
Proof.
auto.
Qed.

Lemma Equiv_Behaviour_TIMINGPDECODE_ID :
 forall
   (i : Stream
          (bool *
           (d_list bool 4 * (d_list bool 4 * d_list (d_list bool 2) 4))))
   (si : state_id) (st : label_t) (sp : STATE_p),
 EqS (Behaviour_TIMINGPDECODE_ID i (si, (st, sp)))
   (Compact (S_map fstS i)
      (Compact
         (Behaviour_TIMING
            (Compact (S_map fstS i)
               (S_map fstS (S_map sndS i))) st)
         (Behaviour_PRIORITY_DECODE
            (Compact (S_map fstS (S_map sndS i))
               (Compact
                  (S_map fstS
                     (S_map sndS (S_map sndS i)))
                  (S_map sndS
                     (S_map sndS (S_map sndS i))))) sp))).
Proof.
cofix Equiv_Behaviour_TIMINGPDECODE_ID.
intros i si st sp.
apply eqS.
clear Equiv_Behaviour_TIMINGPDECODE_ID; simpl in |- *.
unfold Out_id in |- *; unfold Out_Timing_Mealy in |- *;
 unfold Out_PriorityDecode_Mealy in |- *.
elim (S_head i); simpl in |- *.
intros y y0; elim y0; simpl in |- *.
intros y1 y2; elim y2; simpl in |- *; auto.

rewrite S_tail_Behaviour_TIMINGPDECODE_ID.
unfold Trans_TimingPDecode_Id in |- *.
unfold Trans_Timing_PDecode in |- *; unfold Trans_PC in |- *.
do 2 rewrite S_tail_Compact.
rewrite S_tail_Behaviour_TIMING; rewrite S_tail_Behaviour_PDECODE.
simpl in |- *.
elim (S_head i); intros y y0.
elim y0; intros y1 y2.
elim y2; intros y3 y4.
simpl in |- *.

generalize
 (Equiv_Behaviour_TIMINGPDECODE_ID (S_tail i) (Trans_id y si)
    (Trans_Timing (y, y1) st) (Trans_PriorityDecode (y1, (y3, y4)) sp)).
clear Equiv_Behaviour_TIMINGPDECODE_ID.
intro H; apply H.

Qed.

Section Verif_hyp.

  Let Input_type :=
    (bool * (d_list bool 4 * (d_list bool 4 * d_list (d_list bool 2) 4)))%type.

  Variable i : Stream Input_type.

  Let Fs := S_map fstS i.

  Let Act := S_map fstS (S_map sndS i).

  Let Pri := S_map fstS (S_map sndS (S_map sndS i)).

  Let Route := S_map sndS (S_map sndS (S_map sndS i)).

  (** Hypothesis on the input signals fs and act **)

  Hypothesis fs_0 : S_head Fs = false.

  Hypothesis
    fs_act_signals : EqS sig_false (S_map2 andb (S_tail Fs) (S_Ackor Act)).

Lemma Inv_a4' :
 forall (si : state_id) (st : label_t) (sp : STATE_p)
   (sa4 : STATE_a4)
   (ra4 : d_list bool 2 * bool * (d_list bool 2 * bool) *
          (d_list bool 2 * bool * (d_list bool 2 * bool))),
 Inv_t_a4 sa4 st ->
 Inv P_a4 (Behaviour_TIMINGPDECODE_ID i (si, (st, sp)))
   (States_FOUR_ARBITERS (Behaviour_TIMINGPDECODE_ID i (si, (st, sp))) sa4)
   (Structure_States_FOUR_ARBITERS
      (Behaviour_TIMINGPDECODE_ID i (si, (st, sp))) ra4).
Proof.
intros si st sp sa4 ra4 HI.

generalize
 (Inv_a4 fs_0 fs_act_signals (sa4:=sa4) (st:=st) ra4
    (Behaviour_PRIORITY_DECODE (Compact Act (Compact Pri Route)) sp)).
intro P.
apply
 eqS_about_P
  with
    (i' := Compact Fs
             (Compact (Behaviour_TIMING (Compact Fs Act) st)
                (Behaviour_PRIORITY_DECODE (Compact Act (Compact Pri Route))
                   sp)))
    (s1' := States_FOUR_ARBITERS
              (Compact Fs
                 (Compact (Behaviour_TIMING (Compact Fs Act) st)
                    (Behaviour_PRIORITY_DECODE
                       (Compact Act (Compact Pri Route)) sp))) sa4)
    (s2' := Structure_States_FOUR_ARBITERS
              (Compact Fs
                 (Compact (Behaviour_TIMING (Compact Fs Act) st)
                    (Behaviour_PRIORITY_DECODE
                       (Compact Act (Compact Pri Route)) sp))) ra4).
unfold Fs in |- *; unfold Act in |- *; unfold Pri in |- *;
 unfold Route in |- *; apply Equiv_Behaviour_TIMINGPDECODE_ID.
unfold States_FOUR_ARBITERS in |- *.
apply EqS_States_Mealy; auto.
unfold Fs in |- *; unfold Act in |- *; unfold Pri in |- *;
 unfold Route in |- *; apply Equiv_Behaviour_TIMINGPDECODE_ID.
unfold Structure_States_FOUR_ARBITERS in |- *; unfold States_PC in |- *.
apply EqS_States_Mealy; auto.
unfold Fs in |- *; unfold Act in |- *; unfold Pri in |- *;
 unfold Route in |- *; apply Equiv_Behaviour_TIMINGPDECODE_ID.
apply P.
try trivial.
Qed.

End Verif_hyp.

Section From_init_states.

  Let Input_type :=
    (bool * (d_list bool 4 * (d_list bool 4 * d_list (d_list bool 2) 4)))%type.

  Variable i : Stream Input_type.

  Let Fs := S_map fstS i.

  Let Act := S_map fstS (S_map sndS i).

  Let Pri := S_map fstS (S_map sndS (S_map sndS i)).

  Let Route := S_map sndS (S_map sndS (S_map sndS i)).

  (** Hypothesis on the input signals fs and act **)

  Hypothesis fs_0 : S_head Fs = false.

  Hypothesis
    fs_act_signals : EqS sig_false (S_map2 andb (S_tail Fs) (S_Ackor Act)).

 (* P_a4 is an invariant (from the initial states) *)

  Variable g11_0 g12_0 g21_0 g22_0 : bool * bool.      (* lasts *)
  Variable p_0 : d_list (d_list bool 4) 4.    (* ltReq *)

Lemma P_a4_Ok :
 Inv P_a4
   (Behaviour_TIMINGPDECODE_ID i (IDENTITY, (START_t, (START_p, p_0))))
   (States_FOUR_ARBITERS
      (Behaviour_TIMINGPDECODE_ID i (IDENTITY, (START_t, (START_p, p_0))))
      (WAIT_a4, (List4 g11_0 g12_0 g21_0 g22_0, l4_ffff)))
   (Structure_States_FOUR_ARBITERS
      (Behaviour_TIMINGPDECODE_ID i (IDENTITY, (START_t, (START_p, p_0))))
      (pdt_List2 g11_0, false, (pdt_List2 g12_0, false),
      (pdt_List2 g21_0, false, (pdt_List2 g22_0, false)))).

Proof.
apply Inv_a4'; auto.
apply Inv_Init_states_t_a4.
Qed.

End From_init_states.


(* Generated by coq-of-rust *)
Require Import CoqOfRust.CoqOfRust.

Import Root.std.prelude.rust_2015.

Module thread := std.thread.

Definition main (_ : unit) : unit :=
  let data :=
    "86967897737416471853297327050364959\n11861322575564723963297542624962850\n70856234701860851907960690014725639\n38397966707106094172783238747669219\n52380795257888236525459303330302837\n58495327135744041048897885734297812\n69920216438980873548808413720956532\n16278424637452589860345374828574668" in
  let children := _crate.vec.ImplVec.new tt in
  let chunked_data := method "split_whitespace" data in
  match into_iter (method "enumerate" chunked_data) with
  | iter =>
    loop
      match next iter with
      | None => Break
      | Some {| Some.0 := (i, data_segment); |} =>
        _crate.io._print
          (_crate.fmt.ImplArguments.new_v1
            [ "data segment "; " is \""; "\"\n" ]
            [
              _crate.fmt.ImplArgumentV1.new_display i;
              _crate.fmt.ImplArgumentV1.new_display data_segment
            ]) ;;
        tt ;;
        method
          "push"
          children
          (thread.spawn
            (fun  =>
              let result :=
                method
                  "sum"
                  (method
                    "map"
                    (method "chars" data_segment)
                    (fun c =>
                      method
                        "expect"
                        (method "to_digit" c 10)
                        "should be a digit")) in
              _crate.io._print
                (_crate.fmt.ImplArguments.new_v1
                  [ "processed segment "; ", result="; "\n" ]
                  [
                    _crate.fmt.ImplArgumentV1.new_display i;
                    _crate.fmt.ImplArgumentV1.new_display result
                  ]) ;;
              tt ;;
              result)) ;;
        tt
      end ;;
      tt
      from
      for
  end ;;
  let final_result :=
    method
      "sum"
      (method
        "map"
        (method "into_iter" children)
        (fun c => method "unwrap" (method "join" c))) in
  _crate.io._print
    (_crate.fmt.ImplArguments.new_v1
      [ "Final sum result: "; "\n" ]
      [ _crate.fmt.ImplArgumentV1.new_display final_result ]) ;;
  tt ;;
  tt.


Require Export Sets.
Require Export SemChecker.
Require Export CheckerProofs.
Require Export EnumProofs.
Require Export GenProofs.