Require Export paconotation pacotac pacodef pacotacuser.
Set Implicit Arguments.

(** ** Predicates of Arity 15
*)

(** 1 Mutual Coinduction *)

Section Arg15_1.

Definition monotone15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf: rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14) :=
  forall x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 r r' (IN: gf r x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) (LE: r <15= r'), gf r' x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable T7 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5), Type.
Variable T8 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6), Type.
Variable T9 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7), Type.
Variable T10 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8), Type.
Variable T11 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9), Type.
Variable T12 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10), Type.
Variable T13 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11), Type.
Variable T14 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11) (x13: @T13 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12), Type.
Variable gf : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14.
Implicit Arguments gf [].

Theorem paco15_acc: forall
  l r (OBG: forall rr (INC: r <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15 gf rr),
  l <15= paco15 gf r.
Proof.
  intros; assert (SIM: paco15 gf (r \15/ l) x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_mon: monotone15 (paco15 gf).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_mult_strong: forall r,
  paco15 gf (paco15 gf r \15/ r) <15= paco15 gf r.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Corollary paco15_mult: forall r,
  paco15 gf (paco15 gf r) <15= paco15 gf r.
Proof. intros; eapply paco15_mult_strong, paco15_mon; eauto. Qed.

Theorem paco15_fold: forall r,
  gf (paco15 gf r \15/ r) <15= paco15 gf r.
Proof. intros; econstructor; [ |eauto]; eauto. Qed.

Theorem paco15_unfold: forall (MON: monotone15 gf) r,
  paco15 gf r <15= gf (paco15 gf r \15/ r).
Proof. unfold monotone15; intros; destruct PR; eauto. Qed.

End Arg15_1.

Hint Unfold monotone15.
Hint Resolve paco15_fold.

Implicit Arguments paco15_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].

Instance paco15_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15 gf r x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_acc gf;
  pacomult   := paco15_mult gf;
  pacofold   := paco15_fold gf;
  pacounfold := paco15_unfold gf }.

(** 2 Mutual Coinduction *)

Section Arg15_2.

Definition monotone15_2 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf: rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14) :=
  forall x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 r_0 r_1 r'_0 r'_1 (IN: gf r_0 r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) (LE_0: r_0 <15= r'_0)(LE_1: r_1 <15= r'_1), gf r'_0 r'_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable T7 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5), Type.
Variable T8 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6), Type.
Variable T9 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7), Type.
Variable T10 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8), Type.
Variable T11 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9), Type.
Variable T12 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10), Type.
Variable T13 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11), Type.
Variable T14 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11) (x13: @T13 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12), Type.
Variable gf_0 gf_1 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

Theorem paco15_2_0_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_0 <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15_2_0 gf_0 gf_1 rr r_1),
  l <15= paco15_2_0 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco15_2_0 gf_0 gf_1 (r_0 \15/ l) r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_2_1_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_1 <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15_2_1 gf_0 gf_1 r_0 rr),
  l <15= paco15_2_1 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco15_2_1 gf_0 gf_1 r_0 (r_1 \15/ l) x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_2_0_mon: monotone15_2 (paco15_2_0 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_2_1_mon: monotone15_2 (paco15_2_1 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_2_0_mult_strong: forall r_0 r_1,
  paco15_2_0 gf_0 gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1) <15= paco15_2_0 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_2_1_mult_strong: forall r_0 r_1,
  paco15_2_1 gf_0 gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1) <15= paco15_2_1 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Corollary paco15_2_0_mult: forall r_0 r_1,
  paco15_2_0 gf_0 gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1) (paco15_2_1 gf_0 gf_1 r_0 r_1) <15= paco15_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco15_2_0_mult_strong, paco15_2_0_mon; eauto. Qed.

Corollary paco15_2_1_mult: forall r_0 r_1,
  paco15_2_1 gf_0 gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1) (paco15_2_1 gf_0 gf_1 r_0 r_1) <15= paco15_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco15_2_1_mult_strong, paco15_2_1_mon; eauto. Qed.

Theorem paco15_2_0_fold: forall r_0 r_1,
  gf_0 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1) <15= paco15_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco15_2_1_fold: forall r_0 r_1,
  gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1) <15= paco15_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco15_2_0_unfold: forall (MON: monotone15_2 gf_0) (MON: monotone15_2 gf_1) r_0 r_1,
  paco15_2_0 gf_0 gf_1 r_0 r_1 <15= gf_0 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1).
Proof. unfold monotone15_2; intros; destruct PR; eauto. Qed.

Theorem paco15_2_1_unfold: forall (MON: monotone15_2 gf_0) (MON: monotone15_2 gf_1) r_0 r_1,
  paco15_2_1 gf_0 gf_1 r_0 r_1 <15= gf_1 (paco15_2_0 gf_0 gf_1 r_0 r_1 \15/ r_0) (paco15_2_1 gf_0 gf_1 r_0 r_1 \15/ r_1).
Proof. unfold monotone15_2; intros; destruct PR; eauto. Qed.

End Arg15_2.

Hint Unfold monotone15_2.
Hint Resolve paco15_2_0_fold.
Hint Resolve paco15_2_1_fold.

Implicit Arguments paco15_2_0_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_0_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_0_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_0_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_0_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_0_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_2_1_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].

Instance paco15_2_0_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf_0 gf_1 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r_0 r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15_2_0 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_2_0_acc gf_0 gf_1;
  pacomult   := paco15_2_0_mult gf_0 gf_1;
  pacofold   := paco15_2_0_fold gf_0 gf_1;
  pacounfold := paco15_2_0_unfold gf_0 gf_1 }.

Instance paco15_2_1_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf_0 gf_1 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r_0 r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15_2_1 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_2_1_acc gf_0 gf_1;
  pacomult   := paco15_2_1_mult gf_0 gf_1;
  pacofold   := paco15_2_1_fold gf_0 gf_1;
  pacounfold := paco15_2_1_unfold gf_0 gf_1 }.

(** 3 Mutual Coinduction *)

Section Arg15_3.

Definition monotone15_3 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf: rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14) :=
  forall x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 r_0 r_1 r_2 r'_0 r'_1 r'_2 (IN: gf r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) (LE_0: r_0 <15= r'_0)(LE_1: r_1 <15= r'_1)(LE_2: r_2 <15= r'_2), gf r'_0 r'_1 r'_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable T7 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5), Type.
Variable T8 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6), Type.
Variable T9 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7), Type.
Variable T10 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8), Type.
Variable T11 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9), Type.
Variable T12 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10), Type.
Variable T13 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11), Type.
Variable T14 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4) (x6: @T6 x0 x1 x2 x3 x4 x5) (x7: @T7 x0 x1 x2 x3 x4 x5 x6) (x8: @T8 x0 x1 x2 x3 x4 x5 x6 x7) (x9: @T9 x0 x1 x2 x3 x4 x5 x6 x7 x8) (x10: @T10 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9) (x11: @T11 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) (x12: @T12 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11) (x13: @T13 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12), Type.
Variable gf_0 gf_1 gf_2 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 -> rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

Theorem paco15_3_0_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_0 <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15_3_0 gf_0 gf_1 gf_2 rr r_1 r_2),
  l <15= paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco15_3_0 gf_0 gf_1 gf_2 (r_0 \15/ l) r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_3_1_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_1 <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15_3_1 gf_0 gf_1 gf_2 r_0 rr r_2),
  l <15= paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco15_3_1 gf_0 gf_1 gf_2 r_0 (r_1 \15/ l) r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_3_2_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_2 <15= rr) (CIH: l <_paco_15= rr), l <_paco_15= paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 rr),
  l <15= paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 (r_2 \15/ l) x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) by eauto.
  clear PR; repeat (try left; do 16 paco_revert; paco_cofix_auto).
Qed.

Theorem paco15_3_0_mon: monotone15_3 (paco15_3_0 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_3_1_mon: monotone15_3 (paco15_3_1 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_3_2_mon: monotone15_3 (paco15_3_2 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_3_0_mult_strong: forall r_0 r_1 r_2,
  paco15_3_0 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_3_1_mult_strong: forall r_0 r_1 r_2,
  paco15_3_1 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Theorem paco15_3_2_mult_strong: forall r_0 r_1 r_2,
  paco15_3_2 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 16 paco_revert; paco_cofix_auto). Qed.

Corollary paco15_3_0_mult: forall r_0 r_1 r_2,
  paco15_3_0 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <15= paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco15_3_0_mult_strong, paco15_3_0_mon; eauto. Qed.

Corollary paco15_3_1_mult: forall r_0 r_1 r_2,
  paco15_3_1 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <15= paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco15_3_1_mult_strong, paco15_3_1_mon; eauto. Qed.

Corollary paco15_3_2_mult: forall r_0 r_1 r_2,
  paco15_3_2 gf_0 gf_1 gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <15= paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco15_3_2_mult_strong, paco15_3_2_mon; eauto. Qed.

Theorem paco15_3_0_fold: forall r_0 r_1 r_2,
  gf_0 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco15_3_1_fold: forall r_0 r_1 r_2,
  gf_1 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco15_3_2_fold: forall r_0 r_1 r_2,
  gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2) <15= paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco15_3_0_unfold: forall (MON: monotone15_3 gf_0) (MON: monotone15_3 gf_1) (MON: monotone15_3 gf_2) r_0 r_1 r_2,
  paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 <15= gf_0 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2).
Proof. unfold monotone15_3; intros; destruct PR; eauto. Qed.

Theorem paco15_3_1_unfold: forall (MON: monotone15_3 gf_0) (MON: monotone15_3 gf_1) (MON: monotone15_3 gf_2) r_0 r_1 r_2,
  paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 <15= gf_1 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2).
Proof. unfold monotone15_3; intros; destruct PR; eauto. Qed.

Theorem paco15_3_2_unfold: forall (MON: monotone15_3 gf_0) (MON: monotone15_3 gf_1) (MON: monotone15_3 gf_2) r_0 r_1 r_2,
  paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 <15= gf_2 (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_0) (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_1) (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 \15/ r_2).
Proof. unfold monotone15_3; intros; destruct PR; eauto. Qed.

End Arg15_3.

Hint Unfold monotone15_3.
Hint Resolve paco15_3_0_fold.
Hint Resolve paco15_3_1_fold.
Hint Resolve paco15_3_2_fold.

Implicit Arguments paco15_3_0_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_acc            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_0_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_mon            [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_0_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_0_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_mult           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_0_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_fold           [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_0_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_1_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].
Implicit Arguments paco15_3_2_unfold         [ T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 ].

Instance paco15_3_0_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf_0 gf_1 gf_2 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_3_0_acc gf_0 gf_1 gf_2;
  pacomult   := paco15_3_0_mult gf_0 gf_1 gf_2;
  pacofold   := paco15_3_0_fold gf_0 gf_1 gf_2;
  pacounfold := paco15_3_0_unfold gf_0 gf_1 gf_2 }.

Instance paco15_3_1_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf_0 gf_1 gf_2 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_3_1_acc gf_0 gf_1 gf_2;
  pacomult   := paco15_3_1_mult gf_0 gf_1 gf_2;
  pacofold   := paco15_3_1_fold gf_0 gf_1 gf_2;
  pacounfold := paco15_3_1_unfold gf_0 gf_1 gf_2 }.

Instance paco15_3_2_inst  T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 (gf_0 gf_1 gf_2 : rel15 T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 : paco_class (paco15_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14) :=
{ pacoacc    := paco15_3_2_acc gf_0 gf_1 gf_2;
  pacomult   := paco15_3_2_mult gf_0 gf_1 gf_2;
  pacofold   := paco15_3_2_fold gf_0 gf_1 gf_2;
  pacounfold := paco15_3_2_unfold gf_0 gf_1 gf_2 }.


(*** Coq coding by choukh, Sep 2022 ***)

Require Import Lib.
From Category.Instance Require Import Cat Fun.

Global Instance functor_respects_iso :
  Proper (Isomorphism ==> Isomorphism ==> iffT) (@Functor).
Proof.
  intros A B AB C D CD. split; intros F.
  - refine {|
      fobj x := CD.(to) (F (AB⁻¹ x));
      fmap _ _ f := fmap[CD.(to)] (fmap[F] (fmap[AB⁻¹] f));
    |}.
    + proper; now rewrite X.
    + intros; now rewrite !fmap_id.
    + intros; now rewrite !fmap_comp.
  - refine {|
      fobj x := CD⁻¹ (F (AB.(to) x));
      fmap _ _ f := fmap[CD⁻¹] (fmap[F] (fmap[AB.(to)] f));
    |}.
    + proper; now rewrite X.
    + intros; now rewrite !fmap_id.
    + intros; now rewrite !fmap_comp.
Defined.

Global Program Instance fun_respects_iso :
  Proper (Isomorphism ==> Isomorphism ==> Isomorphism) (@Fun) :=
  λ A B AB C D CD, {|
    to := {|
      fobj F := fst (functor_respects_iso AB CD) F;
      fmap _ _ f := {|
        transform x := fmap[CD.(to)] (f (AB⁻¹ x))
      |}
    |};
    from := {|
      fobj F := snd (functor_respects_iso AB CD) F;
      fmap _ _ f := {|
        transform x := fmap[CD⁻¹] (f (AB.(to) x))
      |}
    |}
  |}.
(* to.fmap.naturality *)
Next Obligation. rewrite <- !fmap_comp. f_equiv. apply f. Defined.
(* to.fmap.naturality_sym *)
Next Obligation. rewrite <- !fmap_comp. f_equiv. apply f. Defined.
(* to.fmap_respects *)
Next Obligation. proper. f_equiv. apply X. Defined.
(* to.fmap_comp *)
Next Obligation. now rewrite <- fmap_comp. Defined.
(* from.fmap.naturality *)
Next Obligation. rewrite <- !fmap_comp. f_equiv. apply f. Defined.
(* from.fmap.naturality_sym *)
Next Obligation. rewrite <- !fmap_comp. f_equiv. apply f. Defined.
(* from.fmap_respects *)
Next Obligation. proper. f_equiv. apply X. Defined.
(* from.fmap_comp *)
Next Obligation. now rewrite <- fmap_comp. Defined.
(* iso_to_from.functor_equiv *)
Next Obligation. unshelve eexists.
  - (* iso *) intros F. construct.
    + (* to *) transform; simpl.
      * intros x. eapply compose.
        apply (iso_to_from CD). simpl.
        apply (fmap[CD.(to)]), (fmap[CD⁻¹]), (fmap[F]).
        apply (iso_to_from AB).
      * (* natuality *)
        destruct (iso_to_from AB) as [i1 e1];
        destruct (iso_to_from CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, !comp_assoc.
        rewrite iso_to_from, id_left.
        rewrite <- (comp_assoc (fmap[F] f)).
        rewrite iso_to_from, id_right.
        rewrite <- (comp_assoc (fmap[F] (i1 y))).
        rewrite iso_to_from, id_right.
        rewrite <- !fmap_comp, !comp_assoc.
        rewrite iso_to_from, id_left. reflexivity.
      * (* natuality_sym *)
        destruct (iso_to_from AB) as [i1 e1];
        destruct (iso_to_from CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, !comp_assoc.
        rewrite iso_to_from, id_left.
        rewrite <- (comp_assoc (fmap[F] f)).
        rewrite iso_to_from, id_right.
        rewrite <- (comp_assoc (fmap[F] (i1 y))).
        rewrite iso_to_from, id_right.
        rewrite <- !fmap_comp, !comp_assoc.
        rewrite iso_to_from, id_left. reflexivity.
    + (* from *) transform; simpl.
      * intros x. eapply compose; revgoals.
        apply (iso_to_from CD). simpl.
        apply (fmap[CD.(to)]), (fmap[CD⁻¹]), (fmap[F]).
        apply (iso_to_from AB).
      * (* natuality *)
        destruct (iso_to_from AB) as [i1 e1];
        destruct (iso_to_from CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, <- !comp_assoc. f_equiv.
        rewrite !fmap_comp, <- !comp_assoc. f_equiv.
        rewrite iso_to_from, id_right.
        rewrite (comp_assoc ((i2 (fobj[F] (fobj[AB.(to)] (fobj[AB⁻¹] x)))))).
        rewrite iso_to_from, id_left.
        rewrite (comp_assoc (i2 (fobj[F] y))).
        rewrite iso_to_from, id_left.
        rewrite <- !fmap_comp, iso_to_from, id_right. reflexivity.
      * (* natuality_sym *)
        destruct (iso_to_from AB) as [i1 e1];
        destruct (iso_to_from CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, <- !comp_assoc. f_equiv.
        rewrite !fmap_comp, <- !comp_assoc. f_equiv.
        rewrite iso_to_from, id_right.
        rewrite (comp_assoc ((i2 (fobj[F] (fobj[AB.(to)] (fobj[AB⁻¹] x)))))).
        rewrite iso_to_from, id_left.
        rewrite (comp_assoc (i2 (fobj[F] y))).
        rewrite iso_to_from, id_left.
        rewrite <- !fmap_comp, iso_to_from, id_right. reflexivity.
    + (* iso_to_from *) simpl.
      destruct (iso_to_from AB) as [i1 e1];
      destruct (iso_to_from CD) as [i2 e2]; simpl in *.
      rewrite !e2, !comp_assoc.
      rewrite iso_to_from, id_left.
      rewrite <- (comp_assoc (fmap[F] (i1 A0))).
      rewrite iso_to_from, id_right.
      rewrite <- fmap_comp.
      rewrite iso_to_from, fmap_id, id_left.
      rewrite iso_to_from. reflexivity.
    + (* iso_from_to *) simpl.
      destruct (iso_to_from AB) as [i1 e1];
      destruct (iso_to_from CD) as [i2 e2]; simpl in *.
      rewrite !e2, <- !comp_assoc; f_equiv.
      rewrite !comp_assoc; f_equiv.
      rewrite <- (comp_assoc (fmap[F] (i1 A0)⁻¹)).
      rewrite iso_to_from, id_right.
      rewrite <- (comp_assoc (fmap[F] (i1 A0)⁻¹)).
      rewrite iso_to_from, id_right.
      rewrite <- fmap_comp, iso_from_to, !fmap_id. reflexivity.
  - (* functor_equiv.iso.condition *) simpl.
    destruct (iso_to_from AB) as [i1 e1];
    destruct (iso_to_from CD) as [i2 e2]; simpl in *.
    intros F G n x. rewrite !e2.
    rewrite <- !comp_assoc; f_equiv.
    rewrite !comp_assoc; f_equiv.
    rewrite <- (comp_assoc (fmap[G] (i1 x)⁻¹)).
    rewrite iso_to_from, id_right.
    rewrite <- (comp_assoc (fmap[G] (i1 x)⁻¹ ∘ n x)).
    rewrite iso_to_from, id_right.
    destruct n; simpl. rewrite naturality.
    rewrite <- comp_assoc, <- fmap_comp.
    rewrite iso_from_to, fmap_id, id_right. reflexivity.
Defined.
(* iso_from_to.functor_setoid *)
Next Obligation. unshelve eexists.
  - (* iso *) intros F. construct.
    + (* to *) transform; simpl.
      * intros x. eapply compose.
        apply (iso_from_to CD). simpl.
        apply (fmap[CD⁻¹]), (fmap[CD.(to)]), (fmap[F]).
        apply (iso_from_to AB).
      * (* natuality *)
        destruct (iso_from_to AB) as [i1 e1];
        destruct (iso_from_to CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, !comp_assoc.
        rewrite iso_to_from, id_left.
        rewrite <- (comp_assoc (fmap[F] f)).
        rewrite iso_to_from, id_right.
        rewrite <- (comp_assoc (fmap[F] (i1 y))).
        rewrite iso_to_from, id_right.
        rewrite <- !fmap_comp, !comp_assoc.
        rewrite iso_to_from, id_left. reflexivity.
      * (* natuality_sym *)
        destruct (iso_from_to AB) as [i1 e1];
        destruct (iso_from_to CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, !comp_assoc.
        rewrite iso_to_from, id_left.
        rewrite <- (comp_assoc (fmap[F] f)).
        rewrite iso_to_from, id_right.
        rewrite <- (comp_assoc (fmap[F] (i1 y))).
        rewrite iso_to_from, id_right.
        rewrite <- !fmap_comp, !comp_assoc.
        rewrite iso_to_from, id_left. reflexivity.
    + (* from *) transform; simpl.
      * intros x. eapply compose; revgoals.
        apply (iso_from_to CD). simpl.
        apply (fmap[CD⁻¹]), (fmap[CD.(to)]), (fmap[F]).
        apply (iso_from_to AB).
      * (* natuality *)
        destruct (iso_from_to AB) as [i1 e1];
        destruct (iso_from_to CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, <- !comp_assoc. f_equiv.
        rewrite !fmap_comp, <- !comp_assoc. f_equiv.
        rewrite iso_to_from, id_right.
        rewrite (comp_assoc ((i2 (fobj[F] (fobj[AB⁻¹] (fobj[AB.(to)] x)))))).
        rewrite iso_to_from, id_left.
        rewrite (comp_assoc (i2 (fobj[F] y))).
        rewrite iso_to_from, id_left.
        rewrite <- !fmap_comp, iso_to_from, id_right. reflexivity.
      * (* natuality_sym *)
        destruct (iso_from_to AB) as [i1 e1];
        destruct (iso_from_to CD) as [i2 e2]; simpl in *.
        rewrite e1, !e2, <- !comp_assoc. f_equiv.
        rewrite !fmap_comp, <- !comp_assoc. f_equiv.
        rewrite iso_to_from, id_right.
        rewrite (comp_assoc ((i2 (fobj[F] (fobj[AB⁻¹] (fobj[AB.(to)] x)))))).
        rewrite iso_to_from, id_left.
        rewrite (comp_assoc (i2 (fobj[F] y))).
        rewrite iso_to_from, id_left.
        rewrite <- !fmap_comp, iso_to_from, id_right. reflexivity.
    + (* iso_to_from *) simpl.
      destruct (iso_from_to AB) as [i1 e1];
      destruct (iso_from_to CD) as [i2 e2]; simpl in *.
      rewrite !e2, !comp_assoc.
      rewrite iso_to_from, id_left.
      rewrite <- (comp_assoc (fmap[F] (i1 A0))).
      rewrite iso_to_from, id_right.
      rewrite <- fmap_comp.
      rewrite iso_to_from, fmap_id, id_left.
      rewrite iso_to_from. reflexivity.
    + (* iso_from_to *) simpl.
      destruct (iso_from_to AB) as [i1 e1];
      destruct (iso_from_to CD) as [i2 e2]; simpl in *.
      rewrite !e2, <- !comp_assoc; f_equiv.
      rewrite !comp_assoc; f_equiv.
      rewrite <- (comp_assoc (fmap[F] (i1 A0)⁻¹)).
      rewrite iso_to_from, id_right.
      rewrite <- (comp_assoc (fmap[F] (i1 A0)⁻¹)).
      rewrite iso_to_from, id_right.
      rewrite <- fmap_comp, iso_from_to, !fmap_id. reflexivity.
  - (* functor_setoid.iso.condition *) simpl.
    destruct (iso_from_to AB) as [i1 e1];
    destruct (iso_from_to CD) as [i2 e2]; simpl in *.
    intros F G n x. rewrite !e2.
    rewrite <- !comp_assoc; f_equiv.
    rewrite !comp_assoc; f_equiv.
    rewrite <- (comp_assoc (fmap[G] (i1 x)⁻¹)).
    rewrite iso_to_from, id_right.
    rewrite <- (comp_assoc (fmap[G] (i1 x)⁻¹ ∘ n x)).
    rewrite iso_to_from, id_right.
    destruct n; simpl. rewrite naturality.
    rewrite <- comp_assoc, <- fmap_comp.
    rewrite iso_from_to, fmap_id, id_right. reflexivity.
Defined.


From Coq Require Import ZArith List.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq ssrfun.
From BitBlasting Require Import QFBV CNF BBCommon BBUlt.
From ssrlib Require Import ZAriths Seqs Tactics.
From nbits Require Import NBits.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(* ===== bit_blast_slt ===== *)

Definition bit_blast_slt g ls1 ls2: generator * cnf * literal :=
  let (tls1, sign1) := eta_expand (splitmsl ls1) in
  let (tls2, sign2) := eta_expand (splitmsl ls2) in
  let '(g_tl, cs_tl, r_tl) := bit_blast_ult g tls1 tls2 in
  let (gr, r) := gen g_tl in
  (* r <->  (((s1 <-> s2) && u) || (s1 && ~s2)) *)
  let csr := [::
                 [:: neg_lit r; sign1; neg_lit sign2];
                 [:: neg_lit r; sign1; r_tl];
                 [:: neg_lit r; neg_lit sign2; r_tl];
                 [:: r; neg_lit sign1; sign2];
                 [:: r; neg_lit sign1; neg_lit r_tl];
                 [:: r; sign2; neg_lit r_tl]
             ] in
  (gr, catrev cs_tl csr, r).

Lemma bit_blast_slt_correct g bs1 bs2 E ls1 ls2 g' cs lr :
  bit_blast_slt g ls1 ls2 = (g', cs, lr) ->
  enc_bits E ls1 bs1 -> enc_bits E ls2 bs2 -> interp_cnf E (add_prelude cs) ->
  enc_bit E lr (sltB bs1 bs2).
Proof.
  rewrite /bit_blast_slt /gen.
  case Hbb_tl : (bit_blast_ult g (splitmsl ls1).1 (splitmsl ls2).1) => [[g_tl cs_tl] r_tl].
  rewrite (lock splitmsl). case=> _ <- <- Henc1 Henc2 Hics.
  rewrite add_prelude_catrev in Hics. move: Hics => /andP [Hics_tl Hics].
  rewrite add_prelude_expand in Hics. move: Hics => /andP [Htt Hics].
  move: (enc_bits_splitmsb Htt Henc1) => /andP [Henc_t1 Henc_s1].
  move: (enc_bits_splitmsb Htt Henc2) => /andP [Henc_t2 Henc_s2].
  move: (bit_blast_ult_correct Hbb_tl Henc_t1 Henc_t2 Hics_tl).
  rewrite /enc_bit => /eqP Hr_tl. rewrite /sltB /interp_lit -Hr_tl.
  rewrite /= !interp_lit_neg_lit -lock in Hics; t_clear.
  rewrite /enc_bit in Henc_s1 Henc_s2.
  move: Henc_s1 Henc_s2 Hics => /eqP -> /eqP ->.
  by case (E g_tl); case ((splitmsb bs1).2); case ((splitmsb bs2).2); case (interp_lit E r_tl).
Qed.

Definition mk_env_slt E g ls1 ls2: env * generator * cnf * literal :=
  let (tls1, sign1) := eta_expand (splitmsl ls1) in
  let (tls2, sign2) := eta_expand (splitmsl ls2) in
  let '(E_tl, g_tl, cs_tl, r_tl) := mk_env_ult E g tls1 tls2 in
  let (gr, r) := gen g_tl in
  let Er := env_upd E_tl (var_of_lit r) (
                      ((interp_lit E_tl sign1 == interp_lit E_tl sign2)
                         &&
                         interp_lit E_tl r_tl)
                      || (interp_lit E_tl sign1 && ~~ interp_lit E_tl sign2)
                    ) in
  (* r <->  (((s1 <-> s2) && u) || (s1 && ~s2)) *)
  let csr := [::
                 [:: neg_lit r; sign1; neg_lit sign2];
                 [:: neg_lit r; sign1; r_tl];
                 [:: neg_lit r; neg_lit sign2; r_tl];
                 [:: r; neg_lit sign1; sign2];
                 [:: r; neg_lit sign1; neg_lit r_tl];
                 [:: r; sign2; neg_lit r_tl]
             ] in
  (Er, gr, catrev cs_tl csr, r).

Lemma mk_env_slt_is_bit_blast_slt E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    bit_blast_slt g ls1 ls2 = (g', cs, lr).
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  dcase (mk_env_ult E g (splitmsl ls1).1 (splitmsl ls2).1)
        => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  rewrite (mk_env_ult_is_bit_blast_ult Henv_tl).
  by case=> _ <- <- <-.
Qed.

Lemma mk_env_slt_newer_gen E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    (g <=? g')%positive.
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  dcase (mk_env_ult E g (splitmsl ls1).1 (splitmsl ls2).1)
        => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  case=> _ <- _ _.
  move: (mk_env_ult_newer_gen Henv_tl) => {Henv_tl} Hggt.
  eapply pos_leb_trans.
  exact: Hggt.
  exact: pos_leb_add_diag_r.
Qed.

Lemma mk_env_slt_newer_res E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    newer_than_lit g' lr.
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  dcase (mk_env_ult E g (splitmsl ls1).1 (splitmsl ls2).1)
        => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  case=> _ <- _ <-.
  by apply newer_than_lit_add_diag_r.
Qed.

Lemma mk_env_slt_newer_cnf E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    newer_than_lit g lit_tt ->
    newer_than_lits g ls1 -> newer_than_lits g ls2 ->
    newer_than_cnf g' cs.
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  case Hls1: (splitmsl ls1) => [tl1 sign1].
  case Hls2: (splitmsl ls2) => [tl2 sign2].
  simpl [fst snd].
  dcase (mk_env_ult E g tl1 tl2) => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  case=> _ <- <- _ => Hgtt Hgls1 Hgls2.
  rewrite newer_than_cnf_catrev.
  move: (newer_than_lits_splitmsl Hgtt Hgls1).
  rewrite Hls1 /fst /snd => /andP [Hgtl1 Hgs1].
  move: (newer_than_lits_splitmsl Hgtt Hgls2).
  rewrite Hls2 /fst /snd => /andP [Hgtl2 Hgs2].
  move: (mk_env_ult_newer_cnf Henv_tl Hgtt Hgtl1 Hgtl2) => Hncnf_tl.
  move: (pos_leb_add_diag_r g_tl 1) => Hgtgt1.
  rewrite (newer_than_cnf_le_newer Hncnf_tl Hgtgt1).
  rewrite andTb /newer_than_cnf /newer_than_lit /=.
  rewrite !newer_than_lit_neg.
  move: (mk_env_ult_newer_gen Henv_tl) => Hggt.
  move: (pos_leb_trans Hggt Hgtgt1) => Hggt1.
  rewrite !(newer_than_lit_le_newer Hgs1 Hggt1).
  rewrite !(newer_than_lit_le_newer Hgs2 Hggt1).
  move: (mk_env_ult_newer_res Henv_tl Hgtt) => Hgtrt.
  rewrite !(newer_than_lit_le_newer Hgtrt Hgtgt1).
  rewrite /newer_than_lit /newer_than_var /=.
  by rewrite (pos_ltb_add_diag_r g_tl 1).
Qed.

Lemma mk_env_slt_preserve E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    env_preserve E E' g.
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  case Hls1: (splitmsl ls1) => [tl1 sign1].
  case Hls2: (splitmsl ls2) => [tl2 sign2].
  simpl [fst snd].
  dcase (mk_env_ult E g tl1 tl2) => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  case=> <- _ _ _.
  move: (mk_env_ult_preserve Henv_tl) => Hpre_tl.
  move: (mk_env_ult_newer_gen Henv_tl) => Hggtl.
  eapply env_preserve_trans.
  exact: Hpre_tl.
  eapply env_preserve_le.
  exact: env_upd_eq_preserve.
  exact: Hggtl.
Qed.

Lemma mk_env_slt_sat E g ls1 ls2 E' g' cs lr:
    mk_env_slt E g ls1 ls2 = (E', g', cs, lr) ->
    newer_than_lit g lit_tt ->
    newer_than_lits g ls1 -> newer_than_lits g ls2 ->
    interp_cnf E' cs.
Proof.
  rewrite /mk_env_slt /bit_blast_slt /gen.
  case Hls1: (splitmsl ls1) => [tl1 sign1].
  case Hls2: (splitmsl ls2) => [tl2 sign2].
  simpl [fst snd].
  dcase (mk_env_ult E g tl1 tl2) => [[[[E_tl g_tl] cs_tl] r_tl] Henv_tl].
  case=> <- _ <- _ Hgtt Hgls1 Hgls2.
  rewrite !interp_cnf_catrev.
  move: (newer_than_lits_splitmsl Hgtt Hgls1).
  rewrite Hls1 /fst /snd => /andP [Hgtl1 Hgs1].
  move: (newer_than_lits_splitmsl Hgtt Hgls2).
  rewrite Hls2 /fst /snd => /andP [Hgtl2 Hgs2].
  move: (mk_env_ult_newer_cnf Henv_tl Hgtt Hgtl1 Hgtl2) => Hncnf_tl.
  rewrite (interp_cnf_env_upd_newer _ _ Hncnf_tl).
  rewrite (mk_env_ult_sat Henv_tl Hgtt Hgtl1 Hgtl2) andTb.
  (* interp_cnf Er csr *)
  rewrite /= env_upd_eq !interp_lit_neg_lit.
  move: (mk_env_ult_newer_res Henv_tl Hgtt) => Hgtrt.
  rewrite (interp_lit_env_upd_newer _ _ Hgtrt).
  move: (mk_env_ult_newer_gen Henv_tl) => Hggt.
  move: (newer_than_lit_le_newer Hgs1 Hggt) => Hgts1.
  move: (newer_than_lit_le_newer Hgs2 Hggt) => Hgts2.
  rewrite (interp_lit_env_upd_newer _ _ Hgts1) (interp_lit_env_upd_newer _ _ Hgts2).
  by case (interp_lit E_tl sign1);
    case (interp_lit E_tl sign2);
    case (interp_lit E_tl r_tl).
Qed.

(*
Lemma toNegZCons n b  (p:BITS n) : toNegZ (consB b p) = if b then Zdouble (toNegZ p) else Zsucc (Zdouble (toNegZ p)).
Proof. done. Qed.

Lemma toPosZCons n b  (p:BITS n) : toPosZ (consB b p) = if b then Zsucc (Zdouble (toPosZ p)) else Zdouble (toPosZ p).
Proof. done. Qed.

Lemma splitmsb_ones :
  forall n, splitmsb (ones n.+1) = (true, ones n).
Proof.
  move => n.
  apply injective_projections.
  rewrite  splitmsb_msb msb_ones /=; reflexivity.
  simpl.
  induction n.
  rewrite /ones /copy /= nseqCons beheadCons; reflexivity.
  rewrite /ones /copy nseqCons tupleE/= beheadCons.
  replace (splitmsb (nseq_tuple n.+1 true)) with (eta_expand (splitmsb (nseq_tuple n.+1 true))).
  rewrite IHn /= theadE /= /joinlsb /=.
  rewrite /ones /copy /= nseqCons tupleE; reflexivity.
    by (symmetry; apply injective_projections).
Qed.

Lemma joinmsb_ones :
  forall n, joinmsb (true, ones n) =  ones n.+1.
Proof.
  move => n.
  induction n.
  simpl. replace (joinlsb (nilB, true)) with (singleBit true) by done.
  rewrite /ones /copy nseqCons tuple0 tupleE; done.
  rewrite /ones /copy /= nseqCons beheadCons theadE.
  rewrite IHn.
  rewrite /joinlsb /= nseqCons tupleE; done.
Qed.

Lemma dropmsb_ones :
  forall n , dropmsb (ones n.+1) = (ones n).
Proof.
  move => n.
  rewrite /dropmsb.
  rewrite splitmsb_ones /=; done.
Qed.

Lemma toZ_zero: forall n, toZ (zero n.+1) = 0%Z.
Proof.
  move => n.
  induction n.
  - rewrite /toZ /= /toPosZ /=; done.
  - rewrite -fromNat0 in IHn. rewrite -fromNat0.
    rewrite /toZ splitmsb_fromNat /= div.div0n /=.
    rewrite /toZ splitmsb_fromNat /= div.div0n /= in IHn.
    replace (# (0)) with (consB false (@fromNat n 0)) by done.
    rewrite toPosZCons. rewrite IHn /=.
    done.
Qed.

Lemma toZ_ones : forall n, toZ (ones n.+1) = (-1)%Z.
Proof.
  move => n.
  induction n.
  - rewrite /toZ.
    replace (splitmsb (ones 1)) with (true, (splitmsb (ones 1)).2) by
        (apply injective_projections; [rewrite splitmsb_msb; reflexivity|simpl; reflexivity]).
    simpl; reflexivity.
  - rewrite /toZ.
    rewrite splitmsb_ones.
    rewrite Z.opp_succ -Z.sub_1_r.
    symmetry; apply Zplus_minus_eq; simpl.
    rewrite /ones /copy nseqCons toNegZCons.
    rewrite /toZ splitmsb_ones Z.opp_succ -Z.sub_1_r in IHn.
    rewrite -Z.add_opp_r -Z.opp_add_distr in IHn.
    apply Z.opp_inj_wd in IHn. rewrite Z.opp_involutive /= in IHn.
    apply Z.add_move_r in IHn; simpl in IHn.
    rewrite IHn.
    done.
Qed.

Lemma toZ_joinmsb0 n: forall (p: BITS n),
    toZ (joinmsb (false, p)) = toPosZ p.
Proof.
  move => p.
  rewrite /toZ joinmsbK; reflexivity.
Qed.

Lemma toPosZ_joinmsb0 n: forall (p: BITS n),
    toPosZ (joinmsb (false, p)) = toPosZ p.
Proof.
  induction n.
  - move => p.
    rewrite (tuple0 p)/= /joinmsb /joinlsb /toPosZ/=; reflexivity.
  - case/tupleP => [p_hd p_tl].
    move : (IHn p_tl).
    case Hpd : p_hd.
    + replace (toPosZ [tuple of false :: p_tl]) with (toPosZ (consB false p_tl)) by done.
      rewrite /= !theadE !beheadCons/= /joinlsb/= !toPosZCons /=.
      move => IHm.
      rewrite IHm !Z.double_spec; reflexivity.
    + replace (toPosZ [tuple of false :: p_tl]) with (toPosZ (consB false p_tl)) by done.
      rewrite /= !theadE !beheadCons/= /joinlsb/= !toPosZCons /=.
      move => IHm.
      rewrite IHm; reflexivity.
Qed.

Lemma toZ_joinmsb1 n : forall (p: BITS n),
    toZ (joinmsb (true, p)) = (Zopp (Zsucc (toNegZ p)))%Z.
Proof.
  move => p.
  rewrite /toZ joinmsbK; reflexivity.
Qed.

Lemma toPosZ_joinmsb1 n : forall (p: BITS n),
    toPosZ (joinmsb (true, p)) = ((toPosZ p) + 2^(Z.of_nat n))%Z.
Proof.
  induction n.
  - move => p.
    rewrite (tuple0 p)/= /joinmsb /joinlsb /toPosZ/=; reflexivity.
  - case/tupleP => [p_hd p_tl].
    move : (IHn p_tl).
    case Hpd : p_hd.
    + replace (toPosZ [tuple of true :: p_tl]) with (toPosZ (consB true p_tl)) by done.
      rewrite /= !theadE !beheadCons/= /joinlsb/= !toPosZCons /=.
      move => IHm.
      rewrite IHm Z.pow_pos_fold Zpos_P_of_succ_nat !Z.double_spec Z.mul_add_distr_l.
      rewrite Z.pow_succ_r; try omega.
    + replace (toPosZ [tuple of false :: p_tl]) with (toPosZ (consB false p_tl)) by done.
      rewrite /= !theadE !beheadCons/= /joinlsb/= !toPosZCons /=.
      move => IHm.
      rewrite IHm Z.pow_pos_fold Zpos_P_of_succ_nat !Z.double_spec Z.mul_add_distr_l.
      rewrite Z.pow_succ_r; try omega.
Qed.

Lemma toNat_joinmsb1 n (p: BITS n) : toNat (joinmsb (true, p)) = toNat p + 2^n.
Proof. rewrite toNat_joinmsb /=. ring. Qed.

Lemma ltB_joinmsb1 n: forall (p q : BITS n),
    ltB (joinmsb (true,p)) (joinmsb (true, q)) = ltB p q.
Proof.
  move => p q.
  rewrite ltB_nat. rewrite !toNat_joinmsb1.
  replace (toNat p + 2 ^ n < toNat q + 2 ^ n) with (toNat p < toNat q).
  symmetry; apply ltB_nat.
  rewrite ltn_add2r.
  done.
Qed.

Lemma toNegZ_toNat n : forall (p: BITS n),
    toNegZ p = Z.of_nat ((2^n-1) - (toNat p)).
Proof.
  induction n.
  - move => p. rewrite (tuple0 p) /toNegZ /=; reflexivity.
  - case/tupleP => [p_hd p_tl].
    case p_hd.
    + replace [tuple of true :: p_tl] with (consB true p_tl) by done.
      rewrite toNegZCons toNatCons /= (IHn p_tl).
      rewrite Z.double_spec expnS.
      rewrite Nat2Z.inj_sub;
        [| move : (toNatBounded p_tl) => Hnb; apply lt_n_Sm_le; rewrite -addn1 subnK; move/ltP :Hnb => Hnb; [done|apply Nats.expn2_gt0]].
      rewrite Z.mul_sub_distr_l.
      replace (Z.of_nat (2 * 2 ^ n - 1 - (1 + (toNat p_tl).*2))) with
          (Z.of_nat (2 * 2 ^ n - 1) - Z.of_nat (1 + (toNat p_tl).*2))%Z by
          (rewrite -Nat2Z.inj_sub;
           [done|
            rewrite -muln2; apply/leP /Nats.ltn_leq_sub; apply/ltP; rewrite mulnC;
            apply Nat.mul_2_mono_l; apply/ltP /toNatBounded]).
      rewrite !Nat2Z.inj_add Z.sub_add_distr -muln2 !Nat2Z.inj_mul !Nat2Z.inj_sub .
      rewrite Nat2Z.inj_mul.
      assert (Z.of_nat 2 = 2%Z) as H2 by done; assert (Z.of_nat 1= 1%Z) as H1 by done.
      rewrite !H1 !H2 Z.mul_sub_distr_l Z.mul_1_r. ring.
      rewrite -expnS; apply/leP /Nats.expn2_gt0.
      apply/leP /Nats.expn2_gt0.
    + replace [tuple of false :: p_tl] with (consB false p_tl) by done.
      rewrite toNegZCons toNatCons /= (IHn p_tl) /= Z.double_spec add0n.
      rewrite !Nat2Z.inj_sub. rewrite -muln2 expnS !Nat2Z.inj_mul.
      assert (Z.of_nat 2 = 2%Z) as H2 by done;
      assert (Z.of_nat 1= 1%Z) as H1 by done.
      rewrite !H1 !H2 !Z.mul_sub_distr_l Z.mul_1_r -Z.add_1_r. ring.
      apply/leP /Nats.expn2_gt0.
      rewrite expnS -muln2 mulnC. apply/leP /Nats.ltn_leq_sub.
      apply/ltP /mult_lt_compat_l.
      apply/ltP /toNatBounded. omega. apply/leP /Nats.expn2_gt0.
      apply lt_n_Sm_le. rewrite -addn1 subnK. apply/ltP /toNatBounded. apply Nats.expn2_gt0.
Qed.

Lemma fromPosZ_fromNat n:
  forall z,
    (z >= 0)%Z ->
    @fromPosZ n z = @fromNat n (Z.to_nat z).
Proof.
  move=> z H. rewrite -extra.fromPosZ_fromNat (Z2Nat.id _ (Z.ge_le _ _ H)).
  reflexivity.
Qed.

Lemma ltB_toZ_Pos :
  forall n (p1 p2 :BITS n.+1),
    ~~((splitmsb p1).1 || (splitmsb p2).1) -> ltB p1 p2 = Z.ltb (toZ p1) (toZ p2)%Z.
Proof.
  move => n.
  move => p1 p2 Hmsb.
  move : (splitmsbK p1) => <-; move : (splitmsbK p2) => <-.
  case Hmsb1 : ((splitmsb p1).1); rewrite Hmsb1 in Hmsb; try discriminate.
  rewrite orFb in Hmsb.
  move/eqP/eqP: Hmsb=> Hmsb2.
  apply Bool.negb_true_iff in Hmsb2.
  case Hspl1: (splitmsb p1) => [b1 ps1];
  case Hspl2: (splitmsb p2) => [b2 ps2].
  rewrite Hspl1 /= in Hmsb1; rewrite Hspl2 /= in Hmsb2.
  rewrite Hmsb1 Hmsb2.
  rewrite /toZ !joinmsbK ltB_joinmsb0 !toPosZ_toNat ltB_nat.
  case Hlt : (toNat ps1 < toNat ps2).
  - move/ltP : Hlt => Hlt.
    apply inj_lt in Hlt.
    rewrite /Z.ltb Hlt; reflexivity.
  - move/ltP in Hlt. apply not_lt in Hlt.
    apply inj_ge in Hlt.
    rewrite /Z.ge in Hlt. rewrite /Z.ltb.
    case Hge : ((Z.of_nat (toNat ps1) ?= Z.of_nat (toNat ps2))%Z); try reflexivity.
    rewrite Hge in Hlt. destruct Hlt; reflexivity.
Qed.

Lemma ltB_toZ_Neg n :
  forall (p1 p2 : BITS n.+1),
    ((splitmsb p1).1 && (splitmsb p2).1) -> ltB p1 p2 = (Z.ltb (toZ p1) (toZ p2)%Z).
Proof.
  move => p1 p2 Hmsb.
  move : (splitmsbK p1) => <-; move : (splitmsbK p2) => <-.
  case Hmsb1 : ((splitmsb p1).1); rewrite Hmsb1 in Hmsb; try discriminate.
  rewrite andTb in Hmsb. move/eqP/eqP: Hmsb => Hmsb2.
  case Hspl1: (splitmsb p1) => [b1 ps1];
  case Hspl2: (splitmsb p2) => [b2 ps2].
  rewrite Hspl1 /= in Hmsb1; rewrite Hspl2 /= in Hmsb2.
  rewrite Hmsb1 Hmsb2.
  rewrite /toZ !joinmsbK ltB_joinmsb1 !toNegZ_toNat ltB_nat.
  case Hlt : ((toNat ps1 < toNat ps2)).
  - move/ltP : Hlt => Hlt.
    apply inj_lt in Hlt.
    symmetry.
    rewrite !Nat2Z.inj_sub; try (apply/ltP /Nats.expn2_gt0).
    apply Z.opp_lt_mono  in Hlt.
    apply Zplus_lt_compat_l with (p:=(Z.of_nat (2 ^ n) - Z.of_nat 1)%Z) in Hlt.
    apply Zsucc_lt_compat, Z.opp_lt_mono, Z.ltb_lt in Hlt.
    rewrite Hlt; reflexivity.
    apply/leP; rewrite -ltnS; replace ((2 ^ n - 1).+1) with ((2 ^ n - 1)+1) by (rewrite addn1; reflexivity).
    rewrite subnK; [apply toNatBounded|apply Nats.expn2_gt0].
    apply/leP; rewrite -ltnS; replace ((2 ^ n - 1).+1) with ((2 ^ n - 1)+1) by (rewrite addn1; reflexivity).
    rewrite subnK; [apply toNatBounded|apply Nats.expn2_gt0].
  - rewrite ltnNge in Hlt.
    apply Bool.negb_false_iff in Hlt.
    move/leP : Hlt => Hlt.
    apply inj_le in Hlt.
    symmetry; rewrite !Nat2Z.inj_sub; try (apply/ltP /Nats.expn2_gt0).
    apply Z.opp_le_mono in Hlt.
    apply Zplus_le_compat_l with (p:=(Z.of_nat (2 ^ n) - Z.of_nat 1)%Z) in Hlt.
    apply Zsucc_le_compat, Z.opp_le_mono in Hlt.
    rewrite -Z.gtb_ltb /Z.gtb.
    apply Z.leb_le in Hlt.
    rewrite /Z.leb in Hlt.
    case Hcomp: ((- Z.succ (Z.of_nat (2 ^ n) - Z.of_nat 1 + - Z.of_nat (toNat ps2))
                           ?= - Z.succ (Z.of_nat (2 ^ n) - Z.of_nat 1 + - Z.of_nat (toNat ps1)))%Z); try done.
    + rewrite Hcomp in Hlt; discriminate.
    + apply/leP. rewrite -ltnS.
      replace ((2 ^ n - 1).+1) with ((2 ^ n - 1)+1) by (rewrite addn1; reflexivity);
        rewrite subnK; [apply toNatBounded|apply Nats.expn2_gt0].
      apply/leP. rewrite -ltnS. replace ((2 ^ n - 1).+1) with ((2 ^ n - 1)+1) by (rewrite addn1; reflexivity);
    rewrite subnK; [apply toNatBounded|apply Nats.expn2_gt0].
Qed.

Lemma ltB_toZ_SameSign n :
  forall (p1 p2 : BITS n.+1),
    ((splitmsb p1).1 = (splitmsb p2).1) -> ltB p1 p2 = (Z.ltb (toZ p1) (toZ p2)%Z).
Proof.
  move => p1 p2.
  case Hp1 : ((splitmsb p1).1); case Hp2: ((splitmsb p2).1);
    try discriminate.
  - move => _; apply ltB_toZ_Neg; rewrite Hp1 Hp2; done.
  - move => _; apply ltB_toZ_Pos; rewrite Hp1 Hp2; done.
Qed.

Lemma ltB_toZ_SameSign2 n :
  forall (p1 p2 : BITS n.+1) sign1 utl1 sign2 utl2,
    splitmsb p1 = (sign1, utl1) ->
    splitmsb p2 = (sign2, utl2) ->
    sign1 = sign2 ->
    ltB utl1 utl2 = (Z.ltb (toZ p1) (toZ p2)%Z).
Proof.
  move => p1 p2 sign1 utl1 sign2 utl2 Hmsb1 Hmsb2.
  case Hsign1: sign1; case Hsign2: sign2; try discriminate; move=> eq.
  all: rewrite Hsign1 in Hmsb1; rewrite Hsign2 in Hmsb2.
  - have tmp: ((splitmsb p1).1 && (splitmsb p2).1) by rewrite Hmsb1 Hmsb2.
    move: (ltB_toZ_Neg tmp) => <-.
    have tmp1: (p1 = joinmsb (true, utl1)) by rewrite -Hmsb1 splitmsbK.
    have tmp2: (p2 = joinmsb (true, utl2)) by rewrite -Hmsb2 splitmsbK.
    by rewrite tmp1 tmp2 -ltB_joinmsb1.
  - have tmp: (~~ ((splitmsb p1).1 || (splitmsb p2).1)) by rewrite Hmsb1 Hmsb2.
    move: (ltB_toZ_Pos tmp) => <-.
    have tmp1: (p1 = joinmsb (false, utl1)) by rewrite -Hmsb1 splitmsbK.
    have tmp2: (p2 = joinmsb (false, utl2)) by rewrite -Hmsb2 splitmsbK.
    by rewrite tmp1 tmp2 -ltB_joinmsb0.
Qed.

Lemma ltB_toZ_DiffSign n:forall (p1 p2 : BITS n.+1),
    ~((splitmsb p1).1 = (splitmsb p2).1) -> ltB p1 p2 = (Z.ltb (toZ p2) (toZ p1)%Z).
Proof.
  move => p1 p2 Hcmp.
  rewrite ltB_nat.
  move : (splitmsbK p1) => <-; move : (splitmsbK p2) => <-.
  case Hspl1: (splitmsb p1) => [b1 ps1]; case Hspl2: (splitmsb p2) => [b2 ps2].
  case Hp1 : ((splitmsb p1).1); case Hp2: ((splitmsb p2).1);
    rewrite Hp1 Hp2 in Hcmp; move/eqP : Hcmp => Hcmp; try discriminate.
  -
    rewrite Hspl1 Hspl2 /= in Hp1 Hp2. rewrite Hp1 Hp2.
    rewrite toNat_joinmsb0 toNat_joinmsb1 toZ_joinmsb0 toZ_joinmsb1.
    move : (toNatBounded ps2) => Hb2.
    assert ((toNat ps1 + 2 ^ n < toNat ps2) = false) as Hlt.
    move/ltP : Hb2 => Hb2.
    apply plus_lt_le_compat with (toNat ps2) (2^n) 0 (toNat ps1) in Hb2;
      [|apply Peano.le_0_n].
    rewrite -plus_n_O in Hb2.
    apply/ltP /gt_asym. move/ltP : Hb2 => Hb2.
    apply/ltP. rewrite -Nats.addn_add addnC in Hb2. exact.
    rewrite Hlt; symmetry.
    rewrite toNegZ_toNat toPosZ_toNat.
    rewrite /Z.ltb /=.
    case Hlt2: ((Z.of_nat (toNat ps2) ?= - Z.succ (Z.of_nat (2 ^ n - 1 - toNat ps1)))%Z); try reflexivity.
    apply -> Z.compare_lt_iff in Hlt2.
    omega.
  -
    rewrite Hspl1 Hspl2 /= in Hp1 Hp2. rewrite Hp1 Hp2.
    rewrite toNat_joinmsb0 toNat_joinmsb1 toZ_joinmsb0 toZ_joinmsb1.
    rewrite toNegZ_toNat toPosZ_toNat.
    assert ((toNat ps1 < toNat ps2 + 2 ^ n) = true) as Hlt.
    move : (toNatBounded ps1) => Hps1b.
    move/ltP /lt_plus_trans in Hps1b.
    move : (Hps1b (toNat ps2)) => Hps1.
    rewrite -Nats.addn_add addnC in Hps1.
    apply/ltP. exact.
    rewrite Hlt; symmetry.
    rewrite Z.ltb_lt. omega.
Qed.

Lemma toNat_joinmsb_lt n : forall (p1 p2 : BITS n),
    ltB (joinmsb (false, p2)) (joinmsb (true, p1)).
Proof.
  move => p1 p2.
  rewrite ltB_nat.
  rewrite !toNat_joinmsb /= addnC mul0n mul1n.
  apply/ltP /plus_lt_le_compat.
  apply/ltP /toNatBounded.
  apply Nat.le_0_l.
Qed.

Lemma ltB_toZ_DiffSign2 n :
  forall (p1 p2 : BITS n.+1) sign1 utl1 sign2 utl2,
    splitmsb p1 = (sign1, utl1) ->
    splitmsb p2 = (sign2, utl2) ->
    sign1 <> sign2 ->
    (sign1 && ~~sign2) = (Z.ltb (toZ p1) (toZ p2)%Z).
Proof.
  move => p1 p2 sign1 utl1 sign2 utl2 Hmsb1 Hmsb2.
  case Hsign1: sign1; case Hsign2: sign2; try discriminate; move=> eq; try (by destruct eq).
  all: rewrite Hsign1 in Hmsb1; rewrite Hsign2 in Hmsb2.
  - have tmp: ((splitmsb p2).1 <> (splitmsb p1).1) by rewrite Hmsb1 Hmsb2.
    rewrite /=.
    move: (ltB_toZ_DiffSign tmp) => <-.
    have tmp1: (p1 = joinmsb (true, utl1)) by rewrite -Hmsb1 splitmsbK.
    have tmp2: (p2 = joinmsb (false, utl2)) by rewrite -Hmsb2 splitmsbK.
    by rewrite tmp1 tmp2 toNat_joinmsb_lt.
  - have tmp: ((splitmsb p2).1 <> (splitmsb p1).1) by rewrite Hmsb1 Hmsb2.
    rewrite /=.
    move: (ltB_toZ_DiffSign tmp) => <-.
    have tmp1: (p1 = joinmsb (false, utl1)) by rewrite -Hmsb1 splitmsbK.
    have tmp2: (p2 = joinmsb (true, utl2)) by rewrite -Hmsb2 splitmsbK.
    have contra: (p1<p2)%bits.
    {
        by rewrite tmp1 tmp2 toNat_joinmsb_lt.
    }
    apply leB_weaken in contra.
    rewrite leBNlt in contra.
    move/eqP/eqP: contra.
    by rewrite Bool.negb_true_iff.
Qed.
*)

Lemma mk_env_slt_env_equal E1 E2 g ls1 ls2 E1' E2' g1' g2' cs1 cs2 lrs1 lrs2 :
  env_equal E1 E2 ->
  mk_env_slt E1 g ls1 ls2 = (E1', g1', cs1, lrs1) ->
  mk_env_slt E2 g ls1 ls2 = (E2', g2', cs2, lrs2) ->
  env_equal E1' E2' /\ g1' = g2' /\ cs1 = cs2 /\ lrs1 = lrs2.
Proof.
  rewrite /mk_env_slt => Heq.
  dcase (mk_env_ult E1 g (splitmsl ls1).1 (splitmsl ls2).1)
  => [[[[E_tl1 g_tl1] cs_tl1] lrs_tl1] Htl1].
  dcase (mk_env_ult E2 g (splitmsl ls1).1 (splitmsl ls2).1)
  => [[[[E_tl2 g_tl2] cs_tl2] lrs_tl2] Htl2].
  move: (mk_env_ult_env_equal Heq Htl1 Htl2) => {Heq Htl1 Htl2} [Heq [? [? ?]]]; subst.
  dcase (gen g_tl2) => [[g' r'] Hg']. case=> ? ? ? ?; case=> ? ? ? ?; subst.
  repeat split. rewrite !(env_equal_interp_lit _ Heq). apply: env_equal_upd.
  assumption.
Qed.


From mathcomp.ssreflect
Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path.

From mathcomp.ssreflect
Require Import tuple.

From Probchain
Require Import FixedList AddressList Parameters.
Set Implicit Arguments.

(* To ensure that all blocks are unqiue, each block contains a random nonce *)
Definition Nonce := ordinal_finType (Hash_value.+1).
(* Hashed can not be a parameter, as it has to be comparable to a numerical T *)
Definition Hashed := ordinal_finType (Hash_value.+1).
(* Simmilarly, Addr must be an index into the honest actors, thus not a parameter*)
Definition Addr := ordinal (n_max_actors + 2).

Canonical nonce_of_eqType := Eval hnf in [eqType of Nonce].
Canonical nonce_of_choiceType := Eval hnf in [choiceType of Nonce].
Canonical nonce_of_countType := Eval hnf in [countType of Nonce].
Canonical nonce_of_finType := Eval hnf in [finType of Nonce].

Canonical hashed_of_eqType := Eval hnf in [eqType of Hashed].
Canonical hashed_of_choiceType := Eval hnf in [choiceType of Hashed].
Canonical hashed_of_countType := Eval hnf in [countType of Hashed].
Canonical hashed_of_finType := Eval hnf in [finType of Hashed].

Canonical addr_of_eqType := Eval hnf in [eqType of Addr].
Canonical addr_of_choiceType := Eval hnf in [choiceType of Addr].
Canonical addr_of_countType := Eval hnf in [countType of Addr].
Canonical addr_of_finType := Eval hnf in [finType of Addr].

Definition validate_transactions (xs : seq Transaction) : bool :=
  match xs with
    | [::] => true (* Vacously true *)
    | h :: t => Transaction_valid h t (* Thank's to the consistency axiom *)
  end.

Inductive TransactionMessage :=
  | BroadcastTransaction of Transaction
  | MulticastTransaction of (Transaction * AddressList).

Definition transaction_message_sum (m : TransactionMessage) := match m with
    | MulticastTransaction (addr, bc) =>  inl (addr, bc)
    | BroadcastTransaction bc      => inr bc
    end.

Definition sum_transaction_message m := match m with
    | inl (addr, bc) => MulticastTransaction (addr, bc)
    | inr bc      => BroadcastTransaction bc
    end.

Lemma transaction_message_cancel : cancel transaction_message_sum sum_transaction_message.
Proof.
  case.
  by [].
  move=> [addr bc]  //=.
Qed.

Definition transaction_message_eqMixin :=
  CanEqMixin transaction_message_cancel.
Canonical transaction_message_eqType :=
  Eval hnf in EqType TransactionMessage transaction_message_eqMixin.

Definition transaction_message_choiceMixin :=
  CanChoiceMixin transaction_message_cancel.
Canonical transaction_message_choiceType :=
  Eval hnf in ChoiceType TransactionMessage transaction_message_choiceMixin.

Definition transaction_message_countMixin :=
  CanCountMixin transaction_message_cancel.
Canonical transaction_message_countType :=
  Eval hnf in CountType TransactionMessage transaction_message_countMixin.

Definition transaction_message_finMixin :=
  CanFinMixin transaction_message_cancel.
Canonical transaction_message_finType :=
  Eval hnf in FinType TransactionMessage transaction_message_finMixin.

Canonical transaction_of_eqType := Eval hnf in [eqType of Transaction].
Canonical transaction_of_choiceType := Eval hnf in [choiceType of Transaction].
Canonical transaction_of_countType := Eval hnf in [countType of Transaction].
Canonical transaction_of_finType := Eval hnf in [finType of Transaction].

Definition TransactionPool := fixlist [eqType of TransactionMessage] TransactionPool_length.
Definition initTransactionPool : TransactionPool := fixlist_empty [eqType of TransactionMessage] TransactionPool_length .

Definition BlockRecord := fixlist Transaction Transactions_per_block.
Definition initBlockRecord : BlockRecord := fixlist_empty Transaction Transactions_per_block.

Canonical transaction_pool_of_eqType := Eval hnf in [eqType of TransactionPool].
Canonical transaction_pool_of_choiceType := Eval hnf in [choiceType of TransactionPool].
Canonical transaction_pool_of_countType := Eval hnf in [countType of TransactionPool].
Canonical transaction_pool_of_finType := Eval hnf in [finType of TransactionPool].

Canonical block_record_of_eqType := Eval hnf in [eqType of BlockRecord].
Canonical block_record_of_choiceType := Eval hnf in [choiceType of BlockRecord].
Canonical block_record_of_countType := Eval hnf in [countType of BlockRecord].
Canonical block_record_of_finType := Eval hnf in [finType of BlockRecord].

(* RndGen will be passed down from the probabilistic component and used to simulate any probabilistic components *)
(* RndGen encodes the random/unknown aspects of the system
  specifically,
      - creating transaction
      - droppping transactions
      - minting blocks
      - adversary corrupting
      - adversary broadcasting
          - *)
(* together with the restrictions imposed by world step, all valid
   sequences of actions can be considered *)
Inductive RndGen  :=
    (* used by Honest Parties to generate transactions - nat specifies which actor *)
    | HonestTransactionGen of (Transaction * ('I_n_max_actors))
    | TransactionDrop of (ordinal TransactionPool_length)
    (* used by both Honest Parties to mint blocks*)
    (* Hashed represents the return value of the random oracle if the block is new*)
    (* Nonce represents the nonce used to create the block*)
    (* Both parameters will be probabilistically generated *)
    | HonestMintBlock
    (* the adversary gets an additional parameter specifying which chain
       in it's pool it should mint onto *)
    | AdvMintBlock
    (* Used to represent the adversary corrupting players - nat is an index into
       which player to corrupt*)
    | AdvCorrupt of ('I_n_max_actors)
    (* used by adversary parties to broadcast chains - nat is an index into
       the adversaries local blockchain pool*)
    | AdvBroadcast of AddressList
    (* Used by adversary parties to create transactions at any round *)
    | AdvTransactionGen
    | RoundEnd
    | AdversaryEnd
    .

Record Block : Type := Bl {
  block_nonce: Nonce;
  block_link: Hashed;
  block_records: BlockRecord;

  (* extra information - can't be kept on block, as it may be modified by the adversary*)
  (* block_is_adversarial: bool; *)
  (* block_hash_round: nat; *)
}.

Definition block_prod (b : Block) :=
  (block_nonce b, block_link b, block_records b).
Definition prod_block (product: (Nonce * Hashed * BlockRecord)%type) : Block :=
    let (tuple1, br1) := product in
      let (n1, h1) := tuple1 in
        Bl n1 h1 br1 .

Definition block_prod_enum := (prod_finType (prod_finType [finType of Nonce] [finType of Hashed]) [finType of BlockRecord]).

Lemma block_cancel : cancel block_prod prod_block.
Proof.
  rewrite /cancel.
  move=> b.
  destruct b => //=.
Qed.

Definition block_eqMixin := CanEqMixin block_cancel.
Canonical block_eqType := Eval hnf in EqType Block block_eqMixin.

Definition block_choiceMixin := CanChoiceMixin block_cancel.
Canonical block_choiceType := Eval hnf in ChoiceType Block block_choiceMixin.
Definition block_countMixin := CanCountMixin block_cancel.
Canonical block_countType := Eval hnf in CountType Block block_countMixin.

Definition block_finMixin := CanFinMixin block_cancel.
Canonical block_finType := Eval hnf in FinType Block block_finMixin.

Canonical block_of_eqType := Eval hnf in [eqType of Block].
Canonical block_of_choiceType := Eval hnf in [choiceType of Block].
Canonical block_of_countType := Eval hnf in [countType of Block].
Canonical block_of_finType := Eval hnf in [finType of Block].

Definition BlockChain := fixlist [eqType of Block] Maximum_blockchain_length.
Definition initBlockChain := fixlist_empty [eqType of Block] Maximum_blockchain_length.
(* converts a blockchain into a transaction sequence *)

Canonical block_chain_of_eqType := Eval hnf in [eqType of BlockChain].
Canonical block_chain_of_choiceType := Eval hnf in [choiceType of BlockChain].
Canonical block_chain_of_countType := Eval hnf in [countType of BlockChain].
Canonical block_chain_of_finType := Eval hnf in [finType of BlockChain].

Definition BlockChain_unwrap (b : BlockChain) := flatten (map (fun block => fixlist_unwrap (block_records block)) (fixlist_unwrap b)).

Inductive Message :=
  | MulticastMsg (addr : AddressList) (bc : BlockChain)
  | BroadcastMsg (bc : BlockChain).

Definition message_eq (m1 m2 : Message) :=
  match m1, m2 with
    | MulticastMsg a1 b1 , MulticastMsg a2 b2 => (a1 == a2) && (b1 == b2)
    | BroadcastMsg b1, BroadcastMsg b2 => b1 == b2
    | _, _ => false
    end.

Lemma message_eqP : Equality.axiom message_eq.
Proof.
  move=> m1 m2.
  case m1 eqn: Hm1, m2 eqn: Hm2 => //=.
    case (_ && _) eqn: H; move:H => /andP H; constructor.
      by destruct H; move: H H0 => /eqP <- /eqP <-.
    move=> H0.
    move: H.
    injection H0 => <- <-.
    move=> H.
    by apply H.

  by constructor.
  by constructor.
  case (_ == _) eqn: H; constructor.
  by move: H => /eqP <-.
  rewrite /not.
  move=> H0.
  move: H => /eqP.
  injection H0.
  move=> <- H.
  by apply H.
Qed.

Definition message_eqMixin := @EqMixin Message message_eq message_eqP.
Canonical message_eqType := Eval hnf in EqType Message message_eqMixin.

Definition message_sum (m : Message) := match m with
    | MulticastMsg addr bc => inl (addr, bc)
    | BroadcastMsg bc      => inr bc
    end.

Definition sum_message m := match m with
    | inl (addr, bc) => MulticastMsg addr bc
    | inr bc      => BroadcastMsg bc
    end.
    About sum_message.

Lemma message_cancel : cancel message_sum sum_message.
Proof.
  rewrite /cancel.
  move=> m.
  destruct m => //=.
Qed.

Definition message_choiceMixin :=
  CanChoiceMixin message_cancel.
Canonical message_choiceType :=
  Eval hnf in ChoiceType Message message_choiceMixin.
Definition message_countMixin :=
  CanCountMixin message_cancel.
Canonical message_countType :=
  Eval hnf in CountType Message message_countMixin.
Definition message_finMixin :=
  CanFinMixin message_cancel.
Canonical message_finType :=
  Eval hnf in FinType Message message_finMixin.

Canonical message_of_eqType := Eval hnf in [eqType of Message].
Canonical message_of_choiceType := Eval hnf in [choiceType of Message].
Canonical message_of_countType := Eval hnf in [countType of Message].
Canonical message_of_finType := Eval hnf in [finType of Message].

Definition MessagePool := fixlist [eqType of Message] MessagePool_length.
Definition initMessagePool := fixlist_empty [eqType of Message] MessagePool_length.

Canonical message_pool_of_eqType := Eval hnf in [eqType of MessagePool].
Canonical message_pool_of_choiceType := Eval hnf in [choiceType of MessagePool].
Canonical message_pool_of_countType := Eval hnf in [countType of MessagePool].
Canonical message_pool_of_finType := Eval hnf in [finType of MessagePool].

Parameter BlockChain_compare_lt : BlockChain -> BlockChain -> bool.


Require Import cons_listat_spec.

Definition type_LF_155 :=  PLAN ->  nat ->  nat ->  nat -> (Prop * (List.list term)).

Definition F_155 : type_LF_155:= (fun   u1 u2 _ _ => (u1 = Nil -> (listAt u1 u2) = Nil, (model_PLAN u1)::(Term id_Nil nil)::(Term id_listAt ((model_PLAN u1):: (model_nat u2)::nil))::(Term id_Nil nil)::nil)).
Definition F_167 : type_LF_155:= (fun    _  _ _ _ => (Nil = Nil -> Nil = Nil, (Term id_Nil nil)::(Term id_Nil nil)::(Term id_Nil nil)::(Term id_Nil nil)::nil)).
Definition F_173 : type_LF_155:= (fun   u5 u2 u6 u7 => ((Cons (C u6 u7) u5) = Nil -> (le (time (C u6 u7)) u2) = true -> (Cons (C u6 u7) u5) = Nil, (Term id_Cons ((Term id_C ((model_nat u6):: (model_nat u7)::nil)):: (model_PLAN u5)::nil))::(Term id_Nil nil)::(Term id_le ((Term id_time ((Term id_C ((model_nat u6):: (model_nat u7)::nil))::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_Cons ((Term id_C ((model_nat u6):: (model_nat u7)::nil)):: (model_PLAN u5)::nil))::(Term id_Nil nil)::nil)).
Definition F_179 : type_LF_155:= (fun   u5 u2 u6 u7 => ((Cons (C u6 u7) u5) = Nil -> (le (time (C u6 u7)) u2) = false -> (listAt u5 u2) = Nil, (Term id_Cons ((Term id_C ((model_nat u6):: (model_nat u7)::nil)):: (model_PLAN u5)::nil))::(Term id_Nil nil)::(Term id_le ((Term id_time ((Term id_C ((model_nat u6):: (model_nat u7)::nil))::nil)):: (model_nat u2)::nil))::(Term id_false nil)::(Term id_listAt ((model_PLAN u5):: (model_nat u2)::nil))::(Term id_Nil nil)::nil)).

Definition LF_155 := [F_155, F_167, F_173, F_179].

Function f_155 (u1: PLAN) (u2: nat) {struct u1} : PLAN :=
 match u1, u2 with
| Nil, _ => Nil
| (Cons (C u6 u7) u5), _ => Nil
end.

Lemma main_155 : forall F, In F LF_155 -> forall u1, forall u2, forall u3, forall u4, (forall F', In F' LF_155 -> forall e1, forall e2, forall e3, forall e4, less (snd (F' e1 e2 e3 e4)) (snd (F u1 u2 u3 u4)) -> fst (F' e1 e2 e3 e4)) -> fst (F u1 u2 u3 u4).
Proof.
intros F HF u1 u2 u3 u4; case_In HF; intro Hind.

	(* GENERATE on [ 155 ] *)

rename u1 into _u1. rename u2 into _u2. rename u3 into d_u3. rename u4 into d_u4.
rename _u1 into u1. rename _u2 into u2.

revert Hind.

pattern u1, u2, (f_155 u1 u2). apply f_155_ind.

(* case [ 167 ] *)

intros _u1 _u2.  intro eq_1. intro. intro Heq2. rewrite <- Heq2.  intro HFabs0.
assert (Hind := HFabs0 F_167). clear HFabs0.
assert (HFabs0 : fst (F_167 Nil 0 0 0)).
apply Hind. trivial_in 1. unfold snd. unfold F_167. unfold F_155. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_155. unfold F_167.
auto.

intros _u1 _u2. intro u6. intro u7. intro u5.  intro eq_1. intro. intro Heq2. rewrite <- Heq2.  intro HFabs0.
case_eq (le (time (C u6 u7)) _u2); [intro H | intro H].

(* case [ 173 ] *)

assert (Hind := HFabs0 F_173). clear HFabs0.
assert (HFabs0 : fst (F_173 u5 _u2 u6 u7)).
apply Hind. trivial_in 2. unfold snd. unfold F_173. unfold F_155. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_155. unfold F_173. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

(* case [ 179 ] *)

assert (Hind := HFabs0 F_179). clear HFabs0.
assert (HFabs0 : fst (F_179 u5 _u2 u6 u7)).
apply Hind. trivial_in 3. unfold snd. unfold F_179. unfold F_155. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_155. unfold F_179. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

	(* TAUTOLOGY on [ 167 ] *)

unfold fst. unfold F_167.
auto.

	(* TAUTOLOGY on [ 173 ] *)

unfold fst. unfold F_173.
auto.

	(* NEGATIVE CLASH on [ 179 ] *)

unfold fst. unfold F_179. intros. try discriminate.

Qed.

(* the set of all formula instances from the proof *)
Definition S_155 := fun f => exists F, In F LF_155 /\ exists e1, exists e2, exists e3, exists e4, f = F e1 e2 e3 e4.

Theorem all_true_155: forall F, In F LF_155 -> forall u1: PLAN, forall u2: nat, forall u3: nat, forall u4: nat, fst (F u1 u2  u3  u4).
Proof.
let n := constr:(4) in
let p := constr:(S(S(n))) in
intros;
let G := fresh "G" in
let x := fresh "x" in
apply wf_subset with (R:=@snd_rpo_mul P Prop max_size) (S:=S_155);
[(* 1 *) apply wf_snd_rpo_mul, prec_wf
|(* 2 *) idtac
|(* 3 *) eexists; split; [ eassumption | idtac]; do_nat n ltac:(eexists); reflexivity
];

intros x G;
do_nat p ltac:(elim G; intro; clear G; intro G);
rewrite G in * |- *; clear G; clear x;
intro G;
apply main_155;
 [assumption | idtac];
intros;
apply G;
 [ idtac | assumption ];
eexists; split;
 [idtac | do_nat n ltac:(eexists); reflexivity];
assumption.
Qed.

Theorem true_155: forall (u1: PLAN) (u2: nat), u1 = Nil -> (listAt u1 u2) = Nil.
Proof.
do 2 intro.
apply (all_true_155 F_155);
 (trivial_in 0) ||
 (repeat constructor).
Qed.


(*
Compilation time increases greatly by nomming vertices with let,
relativily to the number of sum types.
Slow down occurs when computing "induced S".
The given run times are at best inaccurate.
*)
Set Warnings "-notation-overridden". (* to ignore warnings due to the import of ssreflect *)
From mathcomp Require Import all_ssreflect.
Set Warnings "notation-overridden".
From GraphTheory Require Import mgraph.
Open Scope graph_scope.
Set Default Timeout 10. (* Stop running after 10 secondes *)

Time Definition quick_lv2 {Lv Le : Type} (l0 l1 l2 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 in
  let G2 := G1 ∔ [inl (inl (inl (source e))), elabel e, inr tt]
               ∔ [inr tt, elabel e, inl (inr tt)]
               ∔ [inl (inr tt), elabel e, inl (inl (inr tt))] in
  let S : {set G2} := setT :\ inl (inl (inl (target e))) in
  induced S. (* 0.02 secs *)

Time Definition inter_lv2 {Lv Le : Type} (l0 l1 l2 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 in
  let s := inl (inl (inl (source e))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2] in
  let S : {set G2} := setT :\ inl (inl (inl (target e))) in
  induced S. (* 0.13 secs *)

Time Definition slow_lv2 {Lv Le : Type} (l0 l1 l2 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 in
  let s := inl (inl (inl (source e))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2] in
  let t := inl (inl (inl (target e))) : G2 in
  let S : {set G2} := setT :\ t in
  induced S. (* 0.5 secs *)

Time Definition quick_lv3 {Lv Le : Type} (l0 l1 l2 l3 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 in
  let G2 := G1 ∔ [inl (inl (inl (inl (source e)))), elabel e, inr tt]
               ∔ [inr tt, elabel e, inl (inr tt)]
               ∔ [inl (inr tt), elabel e, inl (inl (inr tt))]
               ∔ [inl (inl (inr tt)), elabel e, inl (inl (inl (inr tt)))] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (target e)))) in
  induced S. (* 0.03 secs *)

Time Definition inter_lv3 {Lv Le : Type} (l0 l1 l2 l3 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 in
  let s := inl (inl (inl (inl (source e)))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let v3 := inl (inl (inl (inr tt))) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2]
               ∔ [v2, elabel e, v3] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (target e)))) in
  induced S. (* 3 secs *)

Fail Time Definition slow_lv3 {Lv Le : Type} (l0 l1 l2 l3 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 in
  let s := inl (inl (inl (inl (source e)))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let v3 := inl (inl (inl (inr tt))) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2]
               ∔ [v2, elabel e, v3] in
  let t := inl (inl (inl (inl (target e)))) : G2 in
  let S : {set G2} := setT :\ t in
  induced S. (* > 10 secs + crash computer if remove timeout *)

Time Definition quick_lv4 {Lv Le : Type} (l0 l1 l2 l3 l4 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 ∔ l4 in
  let G2 := G1 ∔ [inl (inl (inl (inl (inl (source e))))), elabel e, inr tt]
               ∔ [inr tt, elabel e, inl (inr tt)]
               ∔ [inl (inr tt), elabel e, inl (inl (inr tt))]
               ∔ [inl (inl (inr tt)), elabel e, inl (inl (inl (inr tt)))]
               ∔ [inl (inl (inl (inr tt))), elabel e, inl (inl (inl (inl (inr tt))))] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (inl (target e))))) in
  induced S. (* 0.2 secs *)

Time Definition inter_lv4 {Lv Le : Type} (l0 l1 l2 l3 l4 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 ∔ l4 in
  let s := inl (inl (inl (inl (inl (source e))))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let v3 := inl (inl (inl (inr tt))) : G1 in
  let v4 := inl (inl (inl (inl (inr tt)))) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2]
               ∔ [v2, elabel e, v3]
               ∔ [v3, elabel e, v4] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (inl (target e))))) in
  @induced Lv Le G2 S. (* > 10 secs + crash computer if remove timeout *)
(* donner les types resoud le probleme -> voir où exactement *)

(* unification matchcomp, inference structure canonique ? *)
(* classe ? échelle coq *) (* TOTHINK Damien Pous *)
(* TODO deconstruct induced to see where the problem arise *)

(* Unfold the definition of induced *)
Time Definition inter_lv3' {Lv Le : Type} (l0 l1 l2 l3 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 in
  let s := inl (inl (inl (inl (source e)))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let v3 := inl (inl (inl (inr tt))) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2]
               ∔ [v2, elabel e, v3] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (target e)))) in
  subgraph_for (@induced_proof Lv Le G2 S). (* 3 secs *)

Time Definition inter_lv3'' {Lv Le : Type} (l0 l1 l2 l3 : Lv) {G : graph Lv Le} (e : edge G) :=
  let G1 := G ∔ l0 ∔ l1 ∔ l2 ∔ l3 in
  let s := inl (inl (inl (inl (source e)))) : G1 in
  let v0 := inr tt : G1 in
  let v1 := inl (inr tt) : G1 in
  let v2 := inl (inl (inr tt)) : G1 in
  let v3 := inl (inl (inl (inr tt))) : G1 in
  let G2 := G1 ∔ [s, elabel e, v0]
               ∔ [v0, elabel e, v1]
               ∔ [v1, elabel e, v2]
               ∔ [v2, elabel e, v3] in
  let S : {set G2} := setT :\ inl (inl (inl (inl (target e)))) in
  (@induced_proof Lv Le G2 S).


(** * Finite Modular Maps: Main Interface *)

(** Author: Pierre Letouzey (Université de Paris - INRIA),
    adapted from earlier works in Coq Standard Library, see README.md.
    License: LGPL-2.1-only, see file LICENSE. *)

From Coq Require Export Bool Equalities Orders SetoidList.
From MMaps Require Import Comparisons.

Set Implicit Arguments.
Unset Strict Implicit.

(** This MMap library of finite modular maps aims at associating keys
    to data efficiently. It is strongly inspired by the OCaml Map library.
    When compared with OCaml, the main signature is here split in two:

    - The first part [WS] proposes a signature for "weak" maps,
      i.e. maps with no ordering on the key type nor the data type.
      For obtaining an instance of this interface, a decidable equality
      on keys in enough, see for example [MMaps.WeakList].
      This signature contains the usual operators: [add], [find]...
      Note that the [equal] function on maps expects as first argument
      a boolean comparison on data, as in OCaml. More details about map
      equalities and comparison at the bottom of this file.

    - Then comes signature [S], that extends [WS] to the case where
      the key type is ordered. The main novelty is that [bindings] is
      required to produce sorted lists. A ternary [compare] function
      on maps is also provided, whose first argument should be a ternary
      comparison on data.

    If unsure, what you're looking for is probably [S], and one
    of its implementation such as [MMaps.RBT].

    Some additional differences with OCaml:

    - No [iter] function, useless since Coq is purely functional

    - [option] types are used instead of [Not_found] exceptions.
      Said otherwise, [find] below is OCaml's recent [find_opt] function.
*)

Definition Cmp {elt:Type}(cmp:elt->elt->bool) e1 e2 := cmp e1 e2 = true.

Definition Fst {A B}(R:relation A) : relation (A*B) :=
 fun p p' => R (fst p) (fst p').

Definition Duo {A B}(RA:relation A)(RB:relation B) : relation (A*B) :=
 fun p p' => RA (fst p) (fst p') /\ RB (snd p) (snd p').

Definition prodmap {A B} (f:A->B) '(a1,a2) := (f a1, f a2).

(** ** Weak signature for maps

    No requirements for an ordering on keys nor elements, only decidability
    of equality on keys [K]. *)

Module Type WS (K : DecidableType).

 Definition key := K.t.

 Parameter t : Type -> Type.
 (** the abstract type of maps *)

 Section Ops.
 Parameter empty : forall {elt}, t elt.
 (** The empty map. *)

 Variable elt:Type.

 Parameter is_empty : t elt -> bool.
 (** Test whether a map is empty or not. *)

 Parameter singleton : key -> elt -> t elt.
 (** [singleton x y] returns the one-element map that contains
     a binding of [x] to [y]. *)

 Parameter add : key -> elt -> t elt -> t elt.
 (** [add x y m] returns a map containing the same bindings as [m],
     plus a binding of [x] to [y]. If [x] was already bound in [m],
     its previous binding disappears. *)

 Parameter find : key -> t elt -> option elt.
 (** [find x m] returns the current binding of [x] in [m],
     or [None] if no such binding exists. *)

 Parameter remove : key -> t elt -> t elt.
 (** [remove x m] returns a map containing the same bindings as [m],
     except for [x] which is unbound in the returned map. *)

 Parameter mem : key -> t elt -> bool.
 (** [mem x m] returns [true] if [m] contains a binding for [x],
     and [false] otherwise. *)

 Parameter bindings : t elt -> list (key*elt).
 (** [bindings m] returns an assoc list corresponding to the bindings
     of [m], in any order. *)

 Parameter cardinal : t elt -> nat.
 (** [cardinal m] returns the number of bindings in [m]. *)

 Parameter fold : forall A: Type, (key -> elt -> A -> A) -> t elt -> A -> A.
 (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
     where [k1] ... [kN] are the keys of all bindings in [m]
     (in any order), and [d1] ... [dN] are the associated data. *)

 Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool.
 (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal,
     that is, contain equal keys and associate them with equal data.
     [cmp] is the boolean equality used to compare the data associated
     with the keys. *)

 Parameter filter : (key -> elt -> bool) -> t elt -> t elt.
 (** [filter f m] returns the map with all the bindings in [m] that
     satisfy [f]. *)

 Parameter partition : (key -> elt -> bool) -> t elt -> t elt * t elt.
 (** [partition f m] returns a pair of maps [(m1, m2)], where [m1] contains
     all the bindings of [m] that satisfy [f], and [m2] is the map
     with all the bindings of [m] that do not satisfy [f]. *)

 Parameter for_all : (key -> elt -> bool) -> t elt -> bool.
 (** [for_all f m] checks if all the bindings of the map satisfy [f]. *)

 Parameter exists_ : (key -> elt -> bool) -> t elt -> bool.
 (** [exists_ f m] checks if at least one binding of the map satisfies [f]. *)

 Variable elt' elt'' : Type.

 Parameter map : (elt -> elt') -> t elt -> t elt'.
 (** [map f m] returns a map with same domain as [m], where the associated
     value a of all bindings of [m] has been replaced by the result of the
     application of [f] to [a]. Since Coq is purely functional, the order
     in which the bindings are passed to [f] is irrelevant. *)

 Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'.
 (** Same as [map], but the function receives as arguments both the
     key and the associated value for each binding of the map. *)

 Parameter merge : (key -> option elt -> option elt' -> option elt'') ->
                   t elt -> t elt' ->  t elt''.
 (** [merge f m m'] creates a new map whose keys are a subset of keys of
     [m] and [m']. The presence of each such binding, and the corresponding
     value, is determined with the function [f]. More precisely, for
     a key [k], if its optional bindings [oe] in [m] and [oe'] in [m']
     are not both [None], then the presence and value of key [k] in the
     merged map is determined by [f k oe oe']. Note that [f k None None]
     will never be considered, and may differ from [None]. *)

 End Ops.
 Section FirstSpecs.
 Variable elt:Type.

 Parameter MapsTo : key -> elt -> t elt -> Prop.

 Definition In (k:key)(m: t elt) : Prop := exists e:elt, MapsTo k e m.

 #[export]
 Declare Instance MapsTo_compat :
   Proper (K.eq==>Logic.eq==>Logic.eq==>iff) MapsTo.

 Variable m : t elt.
 Variable x y : key.
 Variable e : elt.

 Parameter find_spec : find x m = Some e <-> MapsTo x e m.
 Parameter mem_spec : mem x m = true <-> In x m.
 Parameter empty_spec : find x (@empty elt) = None.
 Parameter is_empty_spec : is_empty m = true <-> forall x, find x m = None.
 Parameter add_spec1 : find x (add x e m) = Some e.
 Parameter add_spec2 : ~K.eq x y -> find y (add x e m) = find y m.
 Parameter remove_spec1 : find x (remove x m) = None.
 Parameter remove_spec2 : ~K.eq x y -> find y (remove x m) = find y m.

 Parameter bindings_spec1 :
   InA (Duo K.eq Logic.eq) (x,e) (bindings m) <-> MapsTo x e m.
 (** When compared with ordered maps, here comes the only
     property that is really weaker: *)
 Parameter bindings_spec2w : NoDupA (Fst K.eq) (bindings m).

 (* A few functions are now specified in term of [bindings].
    If [K.eq] is setoid, this is slightly stronger than using [find]
    or [MapsTo]. See functor [Facts.Properties] for other statements. *)

 Parameter singleton_spec : bindings (singleton x e) = (x,e)::nil.
 Parameter cardinal_spec : cardinal m = length (bindings m).

 Parameter fold_spec :
   forall {A} (i : A) (f : key -> elt -> A -> A),
     fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.

 End FirstSpecs.

 Section FilterSpecs.
 Variable elt : Type.
 Variable f : key -> elt -> bool.
 Variable m : t elt.
 Local Notation f' := (fun '(k,e) => f k e).

 Parameter filter_spec : bindings (filter f m) = List.filter f' (bindings m).
 Parameter partition_spec :
   prodmap (@bindings _) (partition f m) = List.partition f' (bindings m).
 Parameter for_all_spec : for_all f m = List.forallb f' (bindings m).
 Parameter exists_spec : exists_ f m = List.existsb f' (bindings m).
 End FilterSpecs.

 Section EqualSpec.
 Variable elt : Type.

 (** More details about map equalities and comparison in the last comment
     of this file. *)

 Definition Equal (m m':t elt) := forall y, find y m = find y m'.
 Definition Eqdom (m m':t elt) := forall y, In y m <-> In y m'.
 Definition Equiv (R:elt->elt->Prop) m m' :=
   Eqdom m m' /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> R e e').
 Definition Equivb (cmp: elt->elt->bool) := Equiv (Cmp cmp).

 Parameter equal_spec : forall (cmp : elt -> elt -> bool)(m m':t elt),
   equal cmp m m' = true <-> Equivb cmp m m'.
 End EqualSpec.
 Section MapsSpecs.
 Variable elt elt' elt'' : Type.

 (** Specifications of [map] and [mapi], now via [bindings]. In the case
     of [mapi], the function [f] need not be a morphism w.r.t. [K.eq].
     Earlier weaker specs via [find] could be found in the [Properties]
     functor, see for instance [map_find] and [mapi_find]. *)

 Parameter map_spec : forall (f:elt->elt') m,
   bindings (map f m) = List.map (fun '(k,e) => (k,f e)) (bindings m).

 Parameter mapi_spec : forall (f:key->elt->elt') m,
   bindings (mapi f m) = List.map (fun '(k,e) => (k,f k e)) (bindings m).

 (** Note : the specifications for [merge] below are
     general enough to work even when [f] is not a morphism w.r.t.
     [K.eq]. For [merge], we could also have [f k None None <> None].
     Alas, this leads to relatively awkward statements.
     See the [Properties] functor for more usual and pratical statements,
     for instance [merge_spec1mn]. *)

 Parameter merge_spec1 :
   forall (f:key->option elt->option elt'->option elt'') m m' x,
   In x m \/ In x m' ->
   exists y:key, K.eq y x /\ find x (merge f m m') = f y (find x m) (find x m').

 Parameter merge_spec2 :
   forall (f:key->option elt->option elt'->option elt'') m m' x,
   In x (merge f m m') -> In x m \/ In x m'.

 End MapsSpecs.
End WS.

(** ** Maps on ordered keys *)

Module Type S (K : OrderedType).
 Include WS K.

 (** Additional specification of [bindings] *)

 Parameter bindings_spec2 :
    forall {elt}(m : t elt), sort (Fst K.lt) (bindings m).

 (** Remark: since [fold] is specified via [bindings], this stronger
     specification of [bindings] has an indirect impact on [fold],
     which can now be proved to receive bindings in increasing order. *)

 Parameter compare :
   forall {elt}, (elt -> elt -> comparison) -> t elt -> t elt -> comparison.
 (** [compare cmp m m'] compares the maps [m] and [m'], in a way compatible
     with a lexicographic ordering of [bindings m] and [bindings m'],
     using [K.compare] on keys and [cmp] on values. *)

 Parameter compare_spec :
   forall {elt} (cmp : elt -> elt -> comparison) (m m':t elt),
     compare cmp m m' =
     list_compare (pair_compare K.compare cmp) (bindings m) (bindings m').

End S.

(** Note: Equalities of maps

 Only one [equal] function on maps is provided, but several
 equivalence predicates on maps are considered, for different purposes:

 Predicate | On keys | On datas     | Decided by
 ----------------------------------------------------------------
 Equal     | K.eq    | Logic.eq     | equal eqb, if eqb decides (@Logic.eq elt)
 Equivb    | K.eq    | a test cmp   | equal cmp
 Equiv     | K.eq    | a relation R | equal cmp, if cmp decides R
 Eqdom     | K.eq    | True         | equal (fun _ _ => true)

 If [R] is an equivalence on datas, and [cmp] implements it, then we have
 the following implications:
 [m = m' -> Equal m m' -> Equiv R m m' <-> Equivb cmp m m' -> Eqdom m m']

 - In general, Leibniz equality on maps is not adequate here,
   since it is frequent that several maps may encode the same
   bindings, even when [K.eq] is Leibniz (think of tree re-balancing).

 - [Equal] is then the most precise predicate, and probably the most
   natural, corresponding to an observational equivalence : [Equal]
   maps will give (Leibniz) equal results by [find].

 - [Equivb] and [Equiv] are somewhat ad-hoc, but necessary to fully
   specify the [equal] function. [Equivb] is parametrized by a boolean
   test [cmp] on datas, and its logical counterpart [Equiv] is parametrized
   by some relation on datas (possibly not an equivalence nor decidable).

 - [Eqdom] is only comparing the map domains. Said otherwise, it only
   considers the keys (via [K.eq]) but ignore datas altogether. Some
   properties are already shared amongst [Eqdom] maps, for instance
   they have the same cardinal.

 Finally, for maps with ordered keys, the [compare] function is specified
 via a different approach, i.e. referring to the lexicographic comparison
 of [bindings] lists. In this case, [equal] can be seen as a particular
 case of [compare], see [compare_equiv] in [MMaps.Facts].
*)