Ltac simplJM :=
  repeat match goal with [H: ?x |- _] =>
    match x with
    | _paco_id (JMeq _ _) => apply paco_JMeq_eq in H
    | _paco_id (?a = _) => unfold _paco_id in H; subst a
    end
  end.Ltac paco_generalize_hyp mark :=
  let y := fresh "_paco_rel_" in
  match goal with
  | [x: ?A |- _] =>
    match A with
    | mark => clear x
    | _ => intro y;
      match type of y with
        | context[x] => revert x y;
          match goal with [|-forall x, @?f x -> _] =>
            intros x y; generalize (ex_intro f x y)
          end
        | _ => generalize (conj (ex_intro _ x _paco_foo_cons) y)
      end; clear x y; paco_generalize_hyp mark
    end
  end.Ltac paco_convert e x EQ :=
  generalize (eq_refl e); generalize e at 2; intros x EQ;
  hrewrite_last e EQ; apply eq_sym, paco_eq_JMeq in EQ; revert x EQ.Ltac paco_destruct_hyp mark :=
  match goal with
  | [x: ?A |- _] =>
    match A with
    | mark => idtac
    | _paco_foo => clear x; paco_destruct_hyp mark
    | exists n, ?p => let n' := fresh n in destruct x as (n', x); paco_destruct_hyp mark
    | ?p /\ ?q => let x' := fresh x in destruct x as (x,x'); paco_destruct_hyp mark
    end
  end.Ltac paco_revert_hyp mark :=
  match goal with [x: ?A |- _] =>
  match A with
    | mark => clear x
    | _ => revert x; paco_revert_hyp mark
  end end.Ltac paco_post_var INC pr cr := let TMP := fresh "_paco_tmp_" in
  repeat (
    match goal with [H: context f [pr] |-_] =>
      let cih := context f [cr] in rename H into TMP;
      assert(H : cih) by (repeat intro; eapply INC, TMP; eassumption); clear TMP
    end);
  clear INC pr.Ltac paco_rename_last :=
  let x := fresh "_paco_xxx_" in match goal with [H: _|-_] => rename H into x end.Ltac paco_simp_hyp CIH :=
  let EP := fresh "_paco_EP_" in
  let FP := fresh "_paco_FF_" in
  let TP := fresh "_paco_TP_" in
  let XP := fresh "_paco_XP_" in
  let PP := type of CIH in
  evar (EP: Prop);
  assert (TP: False -> PP) by (
    intros FP; generalize _paco_mark_cons;
    repeat intro; paco_rename_last; paco_destruct_hyp _paco_mark;
    simplJM; paco_revert_hyp _paco_mark;
    let con := get_concl in set (TP:=con); revert EP; instantiate (1:= con); destruct FP);
  clear TP;
  assert (XP: EP) by (unfold EP; clear -CIH; repeat intro; apply CIH;
    first [
      (repeat match goal with | [ |- @ex _ _ ] => eexists | [ |- _ /\ _ ] => split end;
       try (apply paco_eq_JMeq; reflexivity);
       first [eassumption|apply _paco_foo_cons]); fail
    | (repeat match goal with | [ |- @ex _ _ ] => eexists | [ |- _ /\ _ ] => split end;
       eauto using paco_eq_JMeq, _paco_foo_cons)]);
  unfold EP in *; clear EP CIH; rename XP into CIH.Ltac paco_post_simp CIH :=
  let CIH := fresh CIH in let TMP := fresh "_paco_TMP_" in
  intro CIH; paco_simp_hyp CIH;
  generalize _paco_mark_cons; intro TMP;
  repeat intro; paco_rename_last; paco_destruct_hyp _paco_mark;
  simplJM; paco_revert_hyp _paco_mark.Ltac paco_ren_r nr cr :=
  first [rename cr into nr | let nr := fresh nr in rename cr into nr].Ltac paco_ren_pr pr cr := rename cr into pr.(** *** Arity 0
*)

Ltac paco_cont0 :=
generalize _paco_foo_cons; paco_generalize_hyp _paco_mark.Ltac paco_pre0 :=
generalize _paco_mark_cons; repeat intro; paco_cont0.Ltac paco_post_match0 INC tac1 tac2 :=
let cr := fresh "_paco_cr_" in intros cr INC; repeat (red in INC);
match goal with [H: ?x |- _] => match x with
| (pacoid _) -> _ => clear H; tac1 cr
| ?pr -> _ => paco_post_var INC pr cr; tac2 pr cr
| _ => tac1 cr
end end.(** *** Arity 1
*)

Ltac paco_cont1 e0 :=
let x0 := fresh "_paco_v_" in let EQ0 := fresh "_paco_EQ_" in
paco_convert e0 x0 EQ0;
intros x0 EQ0;
generalize EQ0; clear EQ0;
move x0 at top;
paco_generalize_hyp _paco_mark; revert x0.

Lemma _paco_pre1: forall T0 (gf: rel1 T0) x0 (X: let gf' := gf in gf' x0), gf x0.