Set Warnings "-notation-overridden".

Require Import Category.Lib.
Require Export Category.Theory.Functor.
Require Export Category.Construction.Opposite.

Generalizable All Variables.
Set Primitive Projections.
Set Universe Polymorphism.
Unset Transparent Obligations.

(* This is the category of three objects and two arrows, from the first object
   to the other two (as well as the three identity morphisms):

                x
              /   \
           f /     \ g
            /       \
           v         v
          y           z

  This is used to build diagrams that identify spans and pullbacks. *)

Inductive RoofObj : Type := RNeg | RZero | RPos.

Inductive RoofHom : RoofObj -> RoofObj -> Type :=
  | IdNeg   : RoofHom RNeg  RNeg
  | ZeroNeg : RoofHom RZero RNeg
  | IdZero  : RoofHom RZero RZero
  | ZeroPos : RoofHom RZero RPos
  | IdPos   : RoofHom RPos  RPos.

Definition RoofHom_inv_t : forall x y, RoofHom x y -> Prop.
Proof.
  intros [] [] f.
  exact (f = IdNeg).
  exact False.          (* Unused, any Prop is ok here *)
  exact False.          (* Unused, any Prop is ok here *)
  exact (f = ZeroNeg).
  exact (f = IdZero).
  exact (f = ZeroPos).
  exact False.          (* Unused, any Prop is ok here *)
  exact False.          (* Unused, any Prop is ok here *)
  exact (f = IdPos).
Defined.

Corollary RoofHom_inv x y f : RoofHom_inv_t x y f.
Proof. destruct f; reflexivity. Qed.

Lemma RNeg_RNeg_id (f : RoofHom RNeg RNeg) : f = IdNeg.
Proof. exact (RoofHom_inv _ _ f). Qed.

Lemma RZero_RPos_id (f : RoofHom RZero RPos) : f = ZeroPos.
Proof. exact (RoofHom_inv _ _ f). Qed.

Lemma RNeg_RZero_absurd : RoofHom RNeg RZero -> False.
Proof. inversion 1. Qed.

Hint Extern 4 => contradiction RNeg_RZero_absurd : roof_laws.

Lemma RPos_RZero_absurd : RoofHom RPos RZero -> False.
Proof. inversion 1. Qed.

Hint Extern 4 => contradiction RPos_RZero_absurd : roof_laws.

Lemma RNeg_RPos_absurd : RoofHom RNeg RPos -> False.
Proof. inversion 1. Qed.

Hint Extern 4 => contradiction RNeg_RPos_absurd : roof_laws.

Lemma RPos_RNeg_absurd : RoofHom RPos RNeg -> False.
Proof. inversion 1. Qed.

Hint Extern 4 => contradiction RPos_RNeg_absurd : roof_laws.

Program Definition Roof : Category := {|
  obj    := RoofObj;
  hom    := RoofHom;
  (* Any hom that typechecks is valid. *)
  homset := fun x y => {| equiv := fun (f g : RoofHom x y) => True |};
  id     := fun x => match x return RoofHom x x with
    | RNeg  => IdNeg
    | RZero => IdZero
    | RPos  => IdPos
    end
|}.
Next Obligation.
  destruct x, y, z;
  try constructor;
  try inversion f;
  try inversion g.
Defined.


Require Import isla.isla.
Require Import isla.aarch64.aarch64.
Require Export isla.instructions.binary_search.a2c.

Lemma a2c_spec `{!islaG Σ} `{!threadG} pc:
  instr pc (Some a2c) -∗
  instr_body pc (sub_R_R_R_spec pc "R8" "R20" "R23").
Proof.
  iStartProof.
  repeat liAStep; liShow.
  Unshelve. all: prepare_sidecond.
  all: bv_solve.
Qed.

Definition a2c_spec_inst `{!islaG Σ} `{!threadG} pc :=
  entails_to_simplify_hyp 0 (a2c_spec pc).
Global Existing Instance a2c_spec_inst.


Require Import Clight.
Require Import Ctypes.
Require Import VST.veric.expr.
Require Import VST.floyd.efield_lemmas.
Require Import mc_reify.clight_expr_eq.
Require Import compcert.common.AST.
Require Import ExtLib.Core.RelDec.

Definition efield_beq a b :=
  match a, b with
  | eStructField x, eStructField y => eqb_ident x y
  | eUnionField x, eUnionField y => eqb_ident x y
  | eArraySubsc x, eArraySubsc y => expr_beq x y
  | _, _ => false
  end.

Lemma efield_beq_spec: forall a b, efield_beq a b = true <-> a = b.
Proof.
  intros.
  destruct a, b; split; intros; try solve [inversion H]; simpl in H.
  + apply expr_beq_spec in H.
    subst.
    reflexivity.
  + inversion H.
    subst.
    simpl.
    apply expr_beq_spec.
    reflexivity.
  + apply eqb_ident_spec in H.
    subst.
    reflexivity.
  + inversion H.
    subst.
    simpl.
    apply eqb_ident_spec.
    reflexivity.
  + apply eqb_ident_spec in H.
    subst.
    reflexivity.
  + inversion H.
    subst.
    simpl.
    apply eqb_ident_spec.
    reflexivity.
Qed.

Instance RelDec_efield_beq: RelDec (@eq efield) := { rel_dec := efield_beq }.

Instance RelDec_Correct_efield_beq : RelDec_Correct RelDec_efield_beq.
Proof.
  constructor.
  unfold rel_dec; simpl.
  exact efield_beq_spec.
Qed.

Instance RelDec_list_efield_beq: RelDec (@eq (list efield)) := List.RelDec_eq_list RelDec_efield_beq.
Instance RelDec_Correct_list_efield_beq: RelDec_Correct RelDec_list_efield_beq :=
  List.RelDec_Correct_eq_list RelDec_Correct_efield_beq.


Require Export paconotation.
Set Implicit Arguments.

(** * Formalization of Parameterized Coinduction: the Internal Approach

    We use the strict positivization trick (Section 6.1 of the paper)
    in order to define G for arbitrary functions (here called paco{n}).
*)

Section Arg0_def.
Variable gf : rel0 -> rel0.
Implicit Arguments gf [].

CoInductive paco0( r: rel0) : Prop :=
| paco0_pfold pco
    (LE : pco <0= (paco0 r \0/ r))
    (SIM: gf pco)
.
Definition upaco0( r: rel0) := paco0 r \0/ r.
End Arg0_def.
Implicit Arguments paco0 [ ].
Implicit Arguments upaco0 [ ].
Hint Unfold upaco0.

Section Arg0_2_def.
Variable gf_0 gf_1 : rel0 -> rel0 -> rel0.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco0_2_0( r_0 r_1: rel0) : Prop :=
| paco0_2_0_pfold pco_0 pco_1
    (LE : pco_0 <0= (paco0_2_0 r_0 r_1 \0/ r_0))
    (LE : pco_1 <0= (paco0_2_1 r_0 r_1 \0/ r_1))
    (SIM: gf_0 pco_0 pco_1)
with paco0_2_1( r_0 r_1: rel0) : Prop :=
| paco0_2_1_pfold pco_0 pco_1
    (LE : pco_0 <0= (paco0_2_0 r_0 r_1 \0/ r_0))
    (LE : pco_1 <0= (paco0_2_1 r_0 r_1 \0/ r_1))
    (SIM: gf_1 pco_0 pco_1)
.
Definition upaco0_2_0( r_0 r_1: rel0) := paco0_2_0 r_0 r_1 \0/ r_0.
Definition upaco0_2_1( r_0 r_1: rel0) := paco0_2_1 r_0 r_1 \0/ r_1.
End Arg0_2_def.
Implicit Arguments paco0_2_0 [ ].
Implicit Arguments upaco0_2_0 [ ].
Hint Unfold upaco0_2_0.
Implicit Arguments paco0_2_1 [ ].
Implicit Arguments upaco0_2_1 [ ].
Hint Unfold upaco0_2_1.

Section Arg0_3_def.
Variable gf_0 gf_1 gf_2 : rel0 -> rel0 -> rel0 -> rel0.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco0_3_0( r_0 r_1 r_2: rel0) : Prop :=
| paco0_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <0= (paco0_3_0 r_0 r_1 r_2 \0/ r_0))
    (LE : pco_1 <0= (paco0_3_1 r_0 r_1 r_2 \0/ r_1))
    (LE : pco_2 <0= (paco0_3_2 r_0 r_1 r_2 \0/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2)
with paco0_3_1( r_0 r_1 r_2: rel0) : Prop :=
| paco0_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <0= (paco0_3_0 r_0 r_1 r_2 \0/ r_0))
    (LE : pco_1 <0= (paco0_3_1 r_0 r_1 r_2 \0/ r_1))
    (LE : pco_2 <0= (paco0_3_2 r_0 r_1 r_2 \0/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2)
with paco0_3_2( r_0 r_1 r_2: rel0) : Prop :=
| paco0_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <0= (paco0_3_0 r_0 r_1 r_2 \0/ r_0))
    (LE : pco_1 <0= (paco0_3_1 r_0 r_1 r_2 \0/ r_1))
    (LE : pco_2 <0= (paco0_3_2 r_0 r_1 r_2 \0/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2)
.
Definition upaco0_3_0( r_0 r_1 r_2: rel0) := paco0_3_0 r_0 r_1 r_2 \0/ r_0.
Definition upaco0_3_1( r_0 r_1 r_2: rel0) := paco0_3_1 r_0 r_1 r_2 \0/ r_1.
Definition upaco0_3_2( r_0 r_1 r_2: rel0) := paco0_3_2 r_0 r_1 r_2 \0/ r_2.
End Arg0_3_def.
Implicit Arguments paco0_3_0 [ ].
Implicit Arguments upaco0_3_0 [ ].
Hint Unfold upaco0_3_0.
Implicit Arguments paco0_3_1 [ ].
Implicit Arguments upaco0_3_1 [ ].
Hint Unfold upaco0_3_1.
Implicit Arguments paco0_3_2 [ ].
Implicit Arguments upaco0_3_2 [ ].
Hint Unfold upaco0_3_2.

Section Arg1_def.
Variable T0 : Type.
Variable gf : rel1 T0 -> rel1 T0.
Implicit Arguments gf [].

CoInductive paco1( r: rel1 T0) x0 : Prop :=
| paco1_pfold pco
    (LE : pco <1= (paco1 r \1/ r))
    (SIM: gf pco x0)
.
Definition upaco1( r: rel1 T0) := paco1 r \1/ r.
End Arg1_def.
Implicit Arguments paco1 [ T0 ].
Implicit Arguments upaco1 [ T0 ].
Hint Unfold upaco1.

Section Arg1_2_def.
Variable T0 : Type.
Variable gf_0 gf_1 : rel1 T0 -> rel1 T0 -> rel1 T0.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco1_2_0( r_0 r_1: rel1 T0) x0 : Prop :=
| paco1_2_0_pfold pco_0 pco_1
    (LE : pco_0 <1= (paco1_2_0 r_0 r_1 \1/ r_0))
    (LE : pco_1 <1= (paco1_2_1 r_0 r_1 \1/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0)
with paco1_2_1( r_0 r_1: rel1 T0) x0 : Prop :=
| paco1_2_1_pfold pco_0 pco_1
    (LE : pco_0 <1= (paco1_2_0 r_0 r_1 \1/ r_0))
    (LE : pco_1 <1= (paco1_2_1 r_0 r_1 \1/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0)
.
Definition upaco1_2_0( r_0 r_1: rel1 T0) := paco1_2_0 r_0 r_1 \1/ r_0.
Definition upaco1_2_1( r_0 r_1: rel1 T0) := paco1_2_1 r_0 r_1 \1/ r_1.
End Arg1_2_def.
Implicit Arguments paco1_2_0 [ T0 ].
Implicit Arguments upaco1_2_0 [ T0 ].
Hint Unfold upaco1_2_0.
Implicit Arguments paco1_2_1 [ T0 ].
Implicit Arguments upaco1_2_1 [ T0 ].
Hint Unfold upaco1_2_1.

Section Arg1_3_def.
Variable T0 : Type.
Variable gf_0 gf_1 gf_2 : rel1 T0 -> rel1 T0 -> rel1 T0 -> rel1 T0.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco1_3_0( r_0 r_1 r_2: rel1 T0) x0 : Prop :=
| paco1_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <1= (paco1_3_0 r_0 r_1 r_2 \1/ r_0))
    (LE : pco_1 <1= (paco1_3_1 r_0 r_1 r_2 \1/ r_1))
    (LE : pco_2 <1= (paco1_3_2 r_0 r_1 r_2 \1/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0)
with paco1_3_1( r_0 r_1 r_2: rel1 T0) x0 : Prop :=
| paco1_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <1= (paco1_3_0 r_0 r_1 r_2 \1/ r_0))
    (LE : pco_1 <1= (paco1_3_1 r_0 r_1 r_2 \1/ r_1))
    (LE : pco_2 <1= (paco1_3_2 r_0 r_1 r_2 \1/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0)
with paco1_3_2( r_0 r_1 r_2: rel1 T0) x0 : Prop :=
| paco1_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <1= (paco1_3_0 r_0 r_1 r_2 \1/ r_0))
    (LE : pco_1 <1= (paco1_3_1 r_0 r_1 r_2 \1/ r_1))
    (LE : pco_2 <1= (paco1_3_2 r_0 r_1 r_2 \1/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0)
.
Definition upaco1_3_0( r_0 r_1 r_2: rel1 T0) := paco1_3_0 r_0 r_1 r_2 \1/ r_0.
Definition upaco1_3_1( r_0 r_1 r_2: rel1 T0) := paco1_3_1 r_0 r_1 r_2 \1/ r_1.
Definition upaco1_3_2( r_0 r_1 r_2: rel1 T0) := paco1_3_2 r_0 r_1 r_2 \1/ r_2.
End Arg1_3_def.
Implicit Arguments paco1_3_0 [ T0 ].
Implicit Arguments upaco1_3_0 [ T0 ].
Hint Unfold upaco1_3_0.
Implicit Arguments paco1_3_1 [ T0 ].
Implicit Arguments upaco1_3_1 [ T0 ].
Hint Unfold upaco1_3_1.
Implicit Arguments paco1_3_2 [ T0 ].
Implicit Arguments upaco1_3_2 [ T0 ].
Hint Unfold upaco1_3_2.

Section Arg2_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf : rel2 T0 T1 -> rel2 T0 T1.
Implicit Arguments gf [].

CoInductive paco2( r: rel2 T0 T1) x0 x1 : Prop :=
| paco2_pfold pco
    (LE : pco <2= (paco2 r \2/ r))
    (SIM: gf pco x0 x1)
.
Definition upaco2( r: rel2 T0 T1) := paco2 r \2/ r.
End Arg2_def.
Implicit Arguments paco2 [ T0 T1 ].
Implicit Arguments upaco2 [ T0 T1 ].
Hint Unfold upaco2.

Section Arg2_2_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf_0 gf_1 : rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco2_2_0( r_0 r_1: rel2 T0 T1) x0 x1 : Prop :=
| paco2_2_0_pfold pco_0 pco_1
    (LE : pco_0 <2= (paco2_2_0 r_0 r_1 \2/ r_0))
    (LE : pco_1 <2= (paco2_2_1 r_0 r_1 \2/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1)
with paco2_2_1( r_0 r_1: rel2 T0 T1) x0 x1 : Prop :=
| paco2_2_1_pfold pco_0 pco_1
    (LE : pco_0 <2= (paco2_2_0 r_0 r_1 \2/ r_0))
    (LE : pco_1 <2= (paco2_2_1 r_0 r_1 \2/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1)
.
Definition upaco2_2_0( r_0 r_1: rel2 T0 T1) := paco2_2_0 r_0 r_1 \2/ r_0.
Definition upaco2_2_1( r_0 r_1: rel2 T0 T1) := paco2_2_1 r_0 r_1 \2/ r_1.
End Arg2_2_def.
Implicit Arguments paco2_2_0 [ T0 T1 ].
Implicit Arguments upaco2_2_0 [ T0 T1 ].
Hint Unfold upaco2_2_0.
Implicit Arguments paco2_2_1 [ T0 T1 ].
Implicit Arguments upaco2_2_1 [ T0 T1 ].
Hint Unfold upaco2_2_1.

Section Arg2_3_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf_0 gf_1 gf_2 : rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco2_3_0( r_0 r_1 r_2: rel2 T0 T1) x0 x1 : Prop :=
| paco2_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <2= (paco2_3_0 r_0 r_1 r_2 \2/ r_0))
    (LE : pco_1 <2= (paco2_3_1 r_0 r_1 r_2 \2/ r_1))
    (LE : pco_2 <2= (paco2_3_2 r_0 r_1 r_2 \2/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1)
with paco2_3_1( r_0 r_1 r_2: rel2 T0 T1) x0 x1 : Prop :=
| paco2_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <2= (paco2_3_0 r_0 r_1 r_2 \2/ r_0))
    (LE : pco_1 <2= (paco2_3_1 r_0 r_1 r_2 \2/ r_1))
    (LE : pco_2 <2= (paco2_3_2 r_0 r_1 r_2 \2/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1)
with paco2_3_2( r_0 r_1 r_2: rel2 T0 T1) x0 x1 : Prop :=
| paco2_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <2= (paco2_3_0 r_0 r_1 r_2 \2/ r_0))
    (LE : pco_1 <2= (paco2_3_1 r_0 r_1 r_2 \2/ r_1))
    (LE : pco_2 <2= (paco2_3_2 r_0 r_1 r_2 \2/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1)
.
Definition upaco2_3_0( r_0 r_1 r_2: rel2 T0 T1) := paco2_3_0 r_0 r_1 r_2 \2/ r_0.
Definition upaco2_3_1( r_0 r_1 r_2: rel2 T0 T1) := paco2_3_1 r_0 r_1 r_2 \2/ r_1.
Definition upaco2_3_2( r_0 r_1 r_2: rel2 T0 T1) := paco2_3_2 r_0 r_1 r_2 \2/ r_2.
End Arg2_3_def.
Implicit Arguments paco2_3_0 [ T0 T1 ].
Implicit Arguments upaco2_3_0 [ T0 T1 ].
Hint Unfold upaco2_3_0.
Implicit Arguments paco2_3_1 [ T0 T1 ].
Implicit Arguments upaco2_3_1 [ T0 T1 ].
Hint Unfold upaco2_3_1.
Implicit Arguments paco2_3_2 [ T0 T1 ].
Implicit Arguments upaco2_3_2 [ T0 T1 ].
Hint Unfold upaco2_3_2.

Section Arg3_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable gf : rel3 T0 T1 T2 -> rel3 T0 T1 T2.
Implicit Arguments gf [].

CoInductive paco3( r: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_pfold pco
    (LE : pco <3= (paco3 r \3/ r))
    (SIM: gf pco x0 x1 x2)
.
Definition upaco3( r: rel3 T0 T1 T2) := paco3 r \3/ r.
End Arg3_def.
Implicit Arguments paco3 [ T0 T1 T2 ].
Implicit Arguments upaco3 [ T0 T1 T2 ].
Hint Unfold upaco3.

Section Arg3_2_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable gf_0 gf_1 : rel3 T0 T1 T2 -> rel3 T0 T1 T2 -> rel3 T0 T1 T2.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco3_2_0( r_0 r_1: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_2_0_pfold pco_0 pco_1
    (LE : pco_0 <3= (paco3_2_0 r_0 r_1 \3/ r_0))
    (LE : pco_1 <3= (paco3_2_1 r_0 r_1 \3/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2)
with paco3_2_1( r_0 r_1: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_2_1_pfold pco_0 pco_1
    (LE : pco_0 <3= (paco3_2_0 r_0 r_1 \3/ r_0))
    (LE : pco_1 <3= (paco3_2_1 r_0 r_1 \3/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2)
.
Definition upaco3_2_0( r_0 r_1: rel3 T0 T1 T2) := paco3_2_0 r_0 r_1 \3/ r_0.
Definition upaco3_2_1( r_0 r_1: rel3 T0 T1 T2) := paco3_2_1 r_0 r_1 \3/ r_1.
End Arg3_2_def.
Implicit Arguments paco3_2_0 [ T0 T1 T2 ].
Implicit Arguments upaco3_2_0 [ T0 T1 T2 ].
Hint Unfold upaco3_2_0.
Implicit Arguments paco3_2_1 [ T0 T1 T2 ].
Implicit Arguments upaco3_2_1 [ T0 T1 T2 ].
Hint Unfold upaco3_2_1.

Section Arg3_3_def.
Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable gf_0 gf_1 gf_2 : rel3 T0 T1 T2 -> rel3 T0 T1 T2 -> rel3 T0 T1 T2 -> rel3 T0 T1 T2.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco3_3_0( r_0 r_1 r_2: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <3= (paco3_3_0 r_0 r_1 r_2 \3/ r_0))
    (LE : pco_1 <3= (paco3_3_1 r_0 r_1 r_2 \3/ r_1))
    (LE : pco_2 <3= (paco3_3_2 r_0 r_1 r_2 \3/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2)
with paco3_3_1( r_0 r_1 r_2: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <3= (paco3_3_0 r_0 r_1 r_2 \3/ r_0))
    (LE : pco_1 <3= (paco3_3_1 r_0 r_1 r_2 \3/ r_1))
    (LE : pco_2 <3= (paco3_3_2 r_0 r_1 r_2 \3/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2)
with paco3_3_2( r_0 r_1 r_2: rel3 T0 T1 T2) x0 x1 x2 : Prop :=
| paco3_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <3= (paco3_3_0 r_0 r_1 r_2 \3/ r_0))
    (LE : pco_1 <3= (paco3_3_1 r_0 r_1 r_2 \3/ r_1))
    (LE : pco_2 <3= (paco3_3_2 r_0 r_1 r_2 \3/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2)
.
Definition upaco3_3_0( r_0 r_1 r_2: rel3 T0 T1 T2) := paco3_3_0 r_0 r_1 r_2 \3/ r_0.
Definition upaco3_3_1( r_0 r_1 r_2: rel3 T0 T1 T2) := paco3_3_1 r_0 r_1 r_2 \3/ r_1.
Definition upaco3_3_2( r_0 r_1 r_2: rel3 T0 T1 T2) := paco3_3_2 r_0 r_1 r_2 \3/ r_2.
End Arg3_3_def.
Implicit Arguments paco3_3_0 [ T0 T1 T2 ].
Implicit Arguments upaco3_3_0 [ T0 T1 T2 ].
Hint Unfold upaco3_3_0.
Implicit Arguments paco3_3_1 [ T0 T1 T2 ].
Implicit Arguments upaco3_3_1 [ T0 T1 T2 ].
Hint Unfold upaco3_3_1.
Implicit Arguments paco3_3_2 [ T0 T1 T2 ].
Implicit Arguments upaco3_3_2 [ T0 T1 T2 ].
Hint Unfold upaco3_3_2.

Section Arg4_def.
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 gf : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf [].

CoInductive paco4( r: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_pfold pco
    (LE : pco <4= (paco4 r \4/ r))
    (SIM: gf pco x0 x1 x2 x3)
.
Definition upaco4( r: rel4 T0 T1 T2 T3) := paco4 r \4/ r.
End Arg4_def.
Implicit Arguments paco4 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4 [ T0 T1 T2 T3 ].
Hint Unfold upaco4.

Section Arg4_2_def.
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 gf_0 gf_1 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco4_2_0( r_0 r_1: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_2_0_pfold pco_0 pco_1
    (LE : pco_0 <4= (paco4_2_0 r_0 r_1 \4/ r_0))
    (LE : pco_1 <4= (paco4_2_1 r_0 r_1 \4/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3)
with paco4_2_1( r_0 r_1: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_2_1_pfold pco_0 pco_1
    (LE : pco_0 <4= (paco4_2_0 r_0 r_1 \4/ r_0))
    (LE : pco_1 <4= (paco4_2_1 r_0 r_1 \4/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3)
.
Definition upaco4_2_0( r_0 r_1: rel4 T0 T1 T2 T3) := paco4_2_0 r_0 r_1 \4/ r_0.
Definition upaco4_2_1( r_0 r_1: rel4 T0 T1 T2 T3) := paco4_2_1 r_0 r_1 \4/ r_1.
End Arg4_2_def.
Implicit Arguments paco4_2_0 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4_2_0 [ T0 T1 T2 T3 ].
Hint Unfold upaco4_2_0.
Implicit Arguments paco4_2_1 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4_2_1 [ T0 T1 T2 T3 ].
Hint Unfold upaco4_2_1.

Section Arg4_3_def.
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 gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco4_3_0( r_0 r_1 r_2: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <4= (paco4_3_0 r_0 r_1 r_2 \4/ r_0))
    (LE : pco_1 <4= (paco4_3_1 r_0 r_1 r_2 \4/ r_1))
    (LE : pco_2 <4= (paco4_3_2 r_0 r_1 r_2 \4/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3)
with paco4_3_1( r_0 r_1 r_2: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <4= (paco4_3_0 r_0 r_1 r_2 \4/ r_0))
    (LE : pco_1 <4= (paco4_3_1 r_0 r_1 r_2 \4/ r_1))
    (LE : pco_2 <4= (paco4_3_2 r_0 r_1 r_2 \4/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3)
with paco4_3_2( r_0 r_1 r_2: rel4 T0 T1 T2 T3) x0 x1 x2 x3 : Prop :=
| paco4_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <4= (paco4_3_0 r_0 r_1 r_2 \4/ r_0))
    (LE : pco_1 <4= (paco4_3_1 r_0 r_1 r_2 \4/ r_1))
    (LE : pco_2 <4= (paco4_3_2 r_0 r_1 r_2 \4/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3)
.
Definition upaco4_3_0( r_0 r_1 r_2: rel4 T0 T1 T2 T3) := paco4_3_0 r_0 r_1 r_2 \4/ r_0.
Definition upaco4_3_1( r_0 r_1 r_2: rel4 T0 T1 T2 T3) := paco4_3_1 r_0 r_1 r_2 \4/ r_1.
Definition upaco4_3_2( r_0 r_1 r_2: rel4 T0 T1 T2 T3) := paco4_3_2 r_0 r_1 r_2 \4/ r_2.
End Arg4_3_def.
Implicit Arguments paco4_3_0 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4_3_0 [ T0 T1 T2 T3 ].
Hint Unfold upaco4_3_0.
Implicit Arguments paco4_3_1 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4_3_1 [ T0 T1 T2 T3 ].
Hint Unfold upaco4_3_1.
Implicit Arguments paco4_3_2 [ T0 T1 T2 T3 ].
Implicit Arguments upaco4_3_2 [ T0 T1 T2 T3 ].
Hint Unfold upaco4_3_2.

Section Arg5_def.
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 gf : rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4.
Implicit Arguments gf [].

CoInductive paco5( r: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_pfold pco
    (LE : pco <5= (paco5 r \5/ r))
    (SIM: gf pco x0 x1 x2 x3 x4)
.
Definition upaco5( r: rel5 T0 T1 T2 T3 T4) := paco5 r \5/ r.
End Arg5_def.
Implicit Arguments paco5 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5.

Section Arg5_2_def.
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 gf_0 gf_1 : rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco5_2_0( r_0 r_1: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_2_0_pfold pco_0 pco_1
    (LE : pco_0 <5= (paco5_2_0 r_0 r_1 \5/ r_0))
    (LE : pco_1 <5= (paco5_2_1 r_0 r_1 \5/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3 x4)
with paco5_2_1( r_0 r_1: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_2_1_pfold pco_0 pco_1
    (LE : pco_0 <5= (paco5_2_0 r_0 r_1 \5/ r_0))
    (LE : pco_1 <5= (paco5_2_1 r_0 r_1 \5/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3 x4)
.
Definition upaco5_2_0( r_0 r_1: rel5 T0 T1 T2 T3 T4) := paco5_2_0 r_0 r_1 \5/ r_0.
Definition upaco5_2_1( r_0 r_1: rel5 T0 T1 T2 T3 T4) := paco5_2_1 r_0 r_1 \5/ r_1.
End Arg5_2_def.
Implicit Arguments paco5_2_0 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5_2_0 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5_2_0.
Implicit Arguments paco5_2_1 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5_2_1 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5_2_1.

Section Arg5_3_def.
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 gf_0 gf_1 gf_2 : rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4 -> rel5 T0 T1 T2 T3 T4.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco5_3_0( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <5= (paco5_3_0 r_0 r_1 r_2 \5/ r_0))
    (LE : pco_1 <5= (paco5_3_1 r_0 r_1 r_2 \5/ r_1))
    (LE : pco_2 <5= (paco5_3_2 r_0 r_1 r_2 \5/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4)
with paco5_3_1( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <5= (paco5_3_0 r_0 r_1 r_2 \5/ r_0))
    (LE : pco_1 <5= (paco5_3_1 r_0 r_1 r_2 \5/ r_1))
    (LE : pco_2 <5= (paco5_3_2 r_0 r_1 r_2 \5/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4)
with paco5_3_2( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) x0 x1 x2 x3 x4 : Prop :=
| paco5_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <5= (paco5_3_0 r_0 r_1 r_2 \5/ r_0))
    (LE : pco_1 <5= (paco5_3_1 r_0 r_1 r_2 \5/ r_1))
    (LE : pco_2 <5= (paco5_3_2 r_0 r_1 r_2 \5/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4)
.
Definition upaco5_3_0( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) := paco5_3_0 r_0 r_1 r_2 \5/ r_0.
Definition upaco5_3_1( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) := paco5_3_1 r_0 r_1 r_2 \5/ r_1.
Definition upaco5_3_2( r_0 r_1 r_2: rel5 T0 T1 T2 T3 T4) := paco5_3_2 r_0 r_1 r_2 \5/ r_2.
End Arg5_3_def.
Implicit Arguments paco5_3_0 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5_3_0 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5_3_0.
Implicit Arguments paco5_3_1 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5_3_1 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5_3_1.
Implicit Arguments paco5_3_2 [ T0 T1 T2 T3 T4 ].
Implicit Arguments upaco5_3_2 [ T0 T1 T2 T3 T4 ].
Hint Unfold upaco5_3_2.

Section Arg6_def.
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 gf : rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5.
Implicit Arguments gf [].

CoInductive paco6( r: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_pfold pco
    (LE : pco <6= (paco6 r \6/ r))
    (SIM: gf pco x0 x1 x2 x3 x4 x5)
.
Definition upaco6( r: rel6 T0 T1 T2 T3 T4 T5) := paco6 r \6/ r.
End Arg6_def.
Implicit Arguments paco6 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6.

Section Arg6_2_def.
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 gf_0 gf_1 : rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco6_2_0( r_0 r_1: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_2_0_pfold pco_0 pco_1
    (LE : pco_0 <6= (paco6_2_0 r_0 r_1 \6/ r_0))
    (LE : pco_1 <6= (paco6_2_1 r_0 r_1 \6/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3 x4 x5)
with paco6_2_1( r_0 r_1: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_2_1_pfold pco_0 pco_1
    (LE : pco_0 <6= (paco6_2_0 r_0 r_1 \6/ r_0))
    (LE : pco_1 <6= (paco6_2_1 r_0 r_1 \6/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3 x4 x5)
.
Definition upaco6_2_0( r_0 r_1: rel6 T0 T1 T2 T3 T4 T5) := paco6_2_0 r_0 r_1 \6/ r_0.
Definition upaco6_2_1( r_0 r_1: rel6 T0 T1 T2 T3 T4 T5) := paco6_2_1 r_0 r_1 \6/ r_1.
End Arg6_2_def.
Implicit Arguments paco6_2_0 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6_2_0 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6_2_0.
Implicit Arguments paco6_2_1 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6_2_1 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6_2_1.

Section Arg6_3_def.
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 gf_0 gf_1 gf_2 : rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5 -> rel6 T0 T1 T2 T3 T4 T5.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco6_3_0( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <6= (paco6_3_0 r_0 r_1 r_2 \6/ r_0))
    (LE : pco_1 <6= (paco6_3_1 r_0 r_1 r_2 \6/ r_1))
    (LE : pco_2 <6= (paco6_3_2 r_0 r_1 r_2 \6/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5)
with paco6_3_1( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <6= (paco6_3_0 r_0 r_1 r_2 \6/ r_0))
    (LE : pco_1 <6= (paco6_3_1 r_0 r_1 r_2 \6/ r_1))
    (LE : pco_2 <6= (paco6_3_2 r_0 r_1 r_2 \6/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5)
with paco6_3_2( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) x0 x1 x2 x3 x4 x5 : Prop :=
| paco6_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <6= (paco6_3_0 r_0 r_1 r_2 \6/ r_0))
    (LE : pco_1 <6= (paco6_3_1 r_0 r_1 r_2 \6/ r_1))
    (LE : pco_2 <6= (paco6_3_2 r_0 r_1 r_2 \6/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5)
.
Definition upaco6_3_0( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) := paco6_3_0 r_0 r_1 r_2 \6/ r_0.
Definition upaco6_3_1( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) := paco6_3_1 r_0 r_1 r_2 \6/ r_1.
Definition upaco6_3_2( r_0 r_1 r_2: rel6 T0 T1 T2 T3 T4 T5) := paco6_3_2 r_0 r_1 r_2 \6/ r_2.
End Arg6_3_def.
Implicit Arguments paco6_3_0 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6_3_0 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6_3_0.
Implicit Arguments paco6_3_1 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6_3_1 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6_3_1.
Implicit Arguments paco6_3_2 [ T0 T1 T2 T3 T4 T5 ].
Implicit Arguments upaco6_3_2 [ T0 T1 T2 T3 T4 T5 ].
Hint Unfold upaco6_3_2.

Section Arg7_def.
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 gf : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf [].

CoInductive paco7( r: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_pfold pco
    (LE : pco <7= (paco7 r \7/ r))
    (SIM: gf pco x0 x1 x2 x3 x4 x5 x6)
.
Definition upaco7( r: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7 r \7/ r.
End Arg7_def.
Implicit Arguments paco7 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7.

Section Arg7_2_def.
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 gf_0 gf_1 : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco7_2_0( r_0 r_1: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_2_0_pfold pco_0 pco_1
    (LE : pco_0 <7= (paco7_2_0 r_0 r_1 \7/ r_0))
    (LE : pco_1 <7= (paco7_2_1 r_0 r_1 \7/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6)
with paco7_2_1( r_0 r_1: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_2_1_pfold pco_0 pco_1
    (LE : pco_0 <7= (paco7_2_0 r_0 r_1 \7/ r_0))
    (LE : pco_1 <7= (paco7_2_1 r_0 r_1 \7/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6)
.
Definition upaco7_2_0( r_0 r_1: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7_2_0 r_0 r_1 \7/ r_0.
Definition upaco7_2_1( r_0 r_1: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7_2_1 r_0 r_1 \7/ r_1.
End Arg7_2_def.
Implicit Arguments paco7_2_0 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7_2_0 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7_2_0.
Implicit Arguments paco7_2_1 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7_2_1 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7_2_1.

Section Arg7_3_def.
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 gf_0 gf_1 gf_2 : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco7_3_0( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <7= (paco7_3_0 r_0 r_1 r_2 \7/ r_0))
    (LE : pco_1 <7= (paco7_3_1 r_0 r_1 r_2 \7/ r_1))
    (LE : pco_2 <7= (paco7_3_2 r_0 r_1 r_2 \7/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6)
with paco7_3_1( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <7= (paco7_3_0 r_0 r_1 r_2 \7/ r_0))
    (LE : pco_1 <7= (paco7_3_1 r_0 r_1 r_2 \7/ r_1))
    (LE : pco_2 <7= (paco7_3_2 r_0 r_1 r_2 \7/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6)
with paco7_3_2( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) x0 x1 x2 x3 x4 x5 x6 : Prop :=
| paco7_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <7= (paco7_3_0 r_0 r_1 r_2 \7/ r_0))
    (LE : pco_1 <7= (paco7_3_1 r_0 r_1 r_2 \7/ r_1))
    (LE : pco_2 <7= (paco7_3_2 r_0 r_1 r_2 \7/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6)
.
Definition upaco7_3_0( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7_3_0 r_0 r_1 r_2 \7/ r_0.
Definition upaco7_3_1( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7_3_1 r_0 r_1 r_2 \7/ r_1.
Definition upaco7_3_2( r_0 r_1 r_2: rel7 T0 T1 T2 T3 T4 T5 T6) := paco7_3_2 r_0 r_1 r_2 \7/ r_2.
End Arg7_3_def.
Implicit Arguments paco7_3_0 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7_3_0 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7_3_0.
Implicit Arguments paco7_3_1 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7_3_1 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7_3_1.
Implicit Arguments paco7_3_2 [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments upaco7_3_2 [ T0 T1 T2 T3 T4 T5 T6 ].
Hint Unfold upaco7_3_2.

Section Arg8_def.
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 gf : rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7.
Implicit Arguments gf [].

CoInductive paco8( r: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_pfold pco
    (LE : pco <8= (paco8 r \8/ r))
    (SIM: gf pco x0 x1 x2 x3 x4 x5 x6 x7)
.
Definition upaco8( r: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8 r \8/ r.
End Arg8_def.
Implicit Arguments paco8 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8.

Section Arg8_2_def.
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 gf_0 gf_1 : rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco8_2_0( r_0 r_1: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_2_0_pfold pco_0 pco_1
    (LE : pco_0 <8= (paco8_2_0 r_0 r_1 \8/ r_0))
    (LE : pco_1 <8= (paco8_2_1 r_0 r_1 \8/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6 x7)
with paco8_2_1( r_0 r_1: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_2_1_pfold pco_0 pco_1
    (LE : pco_0 <8= (paco8_2_0 r_0 r_1 \8/ r_0))
    (LE : pco_1 <8= (paco8_2_1 r_0 r_1 \8/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6 x7)
.
Definition upaco8_2_0( r_0 r_1: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8_2_0 r_0 r_1 \8/ r_0.
Definition upaco8_2_1( r_0 r_1: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8_2_1 r_0 r_1 \8/ r_1.
End Arg8_2_def.
Implicit Arguments paco8_2_0 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8_2_0 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8_2_0.
Implicit Arguments paco8_2_1 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8_2_1 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8_2_1.

Section Arg8_3_def.
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 gf_0 gf_1 gf_2 : rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7 -> rel8 T0 T1 T2 T3 T4 T5 T6 T7.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco8_3_0( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <8= (paco8_3_0 r_0 r_1 r_2 \8/ r_0))
    (LE : pco_1 <8= (paco8_3_1 r_0 r_1 r_2 \8/ r_1))
    (LE : pco_2 <8= (paco8_3_2 r_0 r_1 r_2 \8/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7)
with paco8_3_1( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <8= (paco8_3_0 r_0 r_1 r_2 \8/ r_0))
    (LE : pco_1 <8= (paco8_3_1 r_0 r_1 r_2 \8/ r_1))
    (LE : pco_2 <8= (paco8_3_2 r_0 r_1 r_2 \8/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7)
with paco8_3_2( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) x0 x1 x2 x3 x4 x5 x6 x7 : Prop :=
| paco8_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <8= (paco8_3_0 r_0 r_1 r_2 \8/ r_0))
    (LE : pco_1 <8= (paco8_3_1 r_0 r_1 r_2 \8/ r_1))
    (LE : pco_2 <8= (paco8_3_2 r_0 r_1 r_2 \8/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7)
.
Definition upaco8_3_0( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8_3_0 r_0 r_1 r_2 \8/ r_0.
Definition upaco8_3_1( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8_3_1 r_0 r_1 r_2 \8/ r_1.
Definition upaco8_3_2( r_0 r_1 r_2: rel8 T0 T1 T2 T3 T4 T5 T6 T7) := paco8_3_2 r_0 r_1 r_2 \8/ r_2.
End Arg8_3_def.
Implicit Arguments paco8_3_0 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8_3_0 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8_3_0.
Implicit Arguments paco8_3_1 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8_3_1 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8_3_1.
Implicit Arguments paco8_3_2 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Implicit Arguments upaco8_3_2 [ T0 T1 T2 T3 T4 T5 T6 T7 ].
Hint Unfold upaco8_3_2.

Section Arg9_def.
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 gf : rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8.
Implicit Arguments gf [].

CoInductive paco9( r: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_pfold pco
    (LE : pco <9= (paco9 r \9/ r))
    (SIM: gf pco x0 x1 x2 x3 x4 x5 x6 x7 x8)
.
Definition upaco9( r: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9 r \9/ r.
End Arg9_def.
Implicit Arguments paco9 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9.

Section Arg9_2_def.
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 gf_0 gf_1 : rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

CoInductive paco9_2_0( r_0 r_1: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_2_0_pfold pco_0 pco_1
    (LE : pco_0 <9= (paco9_2_0 r_0 r_1 \9/ r_0))
    (LE : pco_1 <9= (paco9_2_1 r_0 r_1 \9/ r_1))
    (SIM: gf_0 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6 x7 x8)
with paco9_2_1( r_0 r_1: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_2_1_pfold pco_0 pco_1
    (LE : pco_0 <9= (paco9_2_0 r_0 r_1 \9/ r_0))
    (LE : pco_1 <9= (paco9_2_1 r_0 r_1 \9/ r_1))
    (SIM: gf_1 pco_0 pco_1 x0 x1 x2 x3 x4 x5 x6 x7 x8)
.
Definition upaco9_2_0( r_0 r_1: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9_2_0 r_0 r_1 \9/ r_0.
Definition upaco9_2_1( r_0 r_1: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9_2_1 r_0 r_1 \9/ r_1.
End Arg9_2_def.
Implicit Arguments paco9_2_0 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9_2_0 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9_2_0.
Implicit Arguments paco9_2_1 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9_2_1 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9_2_1.

Section Arg9_3_def.
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 gf_0 gf_1 gf_2 : rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8 -> rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

CoInductive paco9_3_0( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_3_0_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <9= (paco9_3_0 r_0 r_1 r_2 \9/ r_0))
    (LE : pco_1 <9= (paco9_3_1 r_0 r_1 r_2 \9/ r_1))
    (LE : pco_2 <9= (paco9_3_2 r_0 r_1 r_2 \9/ r_2))
    (SIM: gf_0 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7 x8)
with paco9_3_1( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_3_1_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <9= (paco9_3_0 r_0 r_1 r_2 \9/ r_0))
    (LE : pco_1 <9= (paco9_3_1 r_0 r_1 r_2 \9/ r_1))
    (LE : pco_2 <9= (paco9_3_2 r_0 r_1 r_2 \9/ r_2))
    (SIM: gf_1 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7 x8)
with paco9_3_2( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) x0 x1 x2 x3 x4 x5 x6 x7 x8 : Prop :=
| paco9_3_2_pfold pco_0 pco_1 pco_2
    (LE : pco_0 <9= (paco9_3_0 r_0 r_1 r_2 \9/ r_0))
    (LE : pco_1 <9= (paco9_3_1 r_0 r_1 r_2 \9/ r_1))
    (LE : pco_2 <9= (paco9_3_2 r_0 r_1 r_2 \9/ r_2))
    (SIM: gf_2 pco_0 pco_1 pco_2 x0 x1 x2 x3 x4 x5 x6 x7 x8)
.
Definition upaco9_3_0( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9_3_0 r_0 r_1 r_2 \9/ r_0.
Definition upaco9_3_1( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9_3_1 r_0 r_1 r_2 \9/ r_1.
Definition upaco9_3_2( r_0 r_1 r_2: rel9 T0 T1 T2 T3 T4 T5 T6 T7 T8) := paco9_3_2 r_0 r_1 r_2 \9/ r_2.
End Arg9_3_def.
Implicit Arguments paco9_3_0 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9_3_0 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9_3_0.
Implicit Arguments paco9_3_1 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9_3_1 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9_3_1.
Implicit Arguments paco9_3_2 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Implicit Arguments upaco9_3_2 [ T0 T1 T2 T3 T4 T5 T6 T7 T8 ].
Hint Unfold upaco9_3_2.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** THIS FILE IS DEPRECATED. Use [PeanoNat.Nat] instead. *)

Require Import PeanoNat.

Local Open Scope nat_scope.
Implicit Types m n p : nat.

Notation max := Nat.max (only parsing).

Definition max_0_l := Nat.max_0_l.
Definition max_0_r := Nat.max_0_r.
Definition succ_max_distr := Nat.succ_max_distr.
Definition plus_max_distr_l := Nat.add_max_distr_l.
Definition plus_max_distr_r := Nat.add_max_distr_r.
Definition max_case_strong := Nat.max_case_strong.
Definition max_spec := Nat.max_spec.
Definition max_dec := Nat.max_dec.
Definition max_case := Nat.max_case.
Definition max_idempotent := Nat.max_id.
Definition max_assoc := Nat.max_assoc.
Definition max_comm := Nat.max_comm.
Definition max_l := Nat.max_l.
Definition max_r := Nat.max_r.
Definition le_max_l := Nat.le_max_l.
Definition le_max_r := Nat.le_max_r.
Definition max_lub_l := Nat.max_lub_l.
Definition max_lub_r := Nat.max_lub_r.
Definition max_lub := Nat.max_lub.

(* begin hide *)
(* Compatibility *)
Notation max_case2 := max_case (only parsing).
Notation max_SS := Nat.succ_max_distr (only parsing).
(* end hide *)

Hint Resolve
 Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith.

Hint Resolve
 Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith.


(** Correctness of in-place list reversal *)
From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang.
From iris.proofmode Require Export tactics.
From iris.heap_lang Require Import proofmode notation.
Set Default Proof Using "Type".

Section list_reverse.
Context `{!heapG Σ, probG Σ}.
Implicit Types l : loc.

Fixpoint is_list (hd : val) (xs : list val) : iProp Σ :=
  match xs with
  | [] => ⌜hd = NONEV⌝
  | x :: xs => ∃ l hd', ⌜hd = SOMEV #l⌝ ∗ l ↦ (x,hd') ∗ is_list hd' xs
  end%I.

Definition rev : val :=
  rec: "rev" "hd" "acc" :=
    match: "hd" with
      NONE => "acc"
    | SOME "l" =>
       let: "tmp1" := Fst !"l" in
       let: "tmp2" := Snd !"l" in
       "l" <- ("tmp1", "acc");;
       "rev" "tmp2" "hd"
    end.

Lemma rev_acc_wp hd acc xs ys :
  {{{ is_list hd xs ∗ is_list acc ys }}}
    rev hd acc
  {{{ w, RET w; is_list w (reverse xs ++ ys) }}}.
Proof.
  iIntros (Φ) "[Hxs Hys] HΦ".
  iLöb as "IH" forall (hd acc xs ys Φ). wp_rec. wp_let.
  destruct xs as [|x xs]; iSimplifyEq.
  - wp_match. by iApply "HΦ".
  - iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]".
    wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store.
    iApply ("IH" $! hd' (SOMEV #l) xs (x :: ys) with "Hxs [Hx Hys]"); simpl.
    { iExists l, acc; by iFrame. }
    iNext. iIntros (w). rewrite cons_middle assoc -reverse_cons. iApply "HΦ".
Qed.

Lemma rev_wp hd xs :
  {{{ is_list hd xs }}} rev hd (InjL #()) {{{ w, RET w; is_list w (reverse xs) }}}.
Proof.
  iIntros (Φ) "Hxs HΦ".
  iApply (rev_acc_wp hd NONEV xs [] with "[$Hxs //]").
  iNext; iIntros (w). rewrite right_id_L. iApply "HΦ".
Qed.
End list_reverse.


Require Import
        Fiat.Computation
        Fiat.Common.DecideableEnsembles
        Fiat.BinEncoders.Env.Common.Specs
        Fiat.BinEncoders.Env.Common.Notations.

Set Implicit Arguments.

Definition compose E B
           (transformer : Transformer B)
           (encode1 : E -> Comp (B * E))
           (encode2 : E -> Comp (B * E)) :=
  (fun e0 =>
    `(p, e1) <- encode1 e0;
    `(q, e2) <- encode2 e1;
    ret (transform p q, e2))%comp.

Notation "x 'ThenC' y" := (compose _ x y) : binencoders_scope .
Notation "x 'DoneC'"   := (x ThenC fun e => ret (transform_id, e)) : binencoders_scope.

Lemma refineEquiv_compose_compose E B
           (transformer : Transformer B)
           (encode1 encode2 encode3 : E -> Comp (B * E))
  : forall ctx,
    refineEquiv (compose _ (compose _ encode1 encode2) encode3 ctx)
                (compose _ encode1 (compose _ encode2 encode3) ctx).
Proof.
  unfold compose; intros.
  rewrite refineEquiv_bind2_bind.
  eapply refineEquiv_bind; [ reflexivity | ].
  intro; rewrite refineEquiv_bind2_bind.
  symmetry; rewrite refineEquiv_bind2_bind.
  eapply refineEquiv_bind; [ reflexivity | ].
  intro; rewrite refineEquiv_bind2_bind.
  rewrite refineEquiv_bind2_unit.
  eapply refineEquiv_bind; [ reflexivity | ].
  intro; rewrite refineEquiv_bind2_unit; simpl.
  rewrite transform_assoc; reflexivity.
Qed.

Lemma refineEquiv_compose_Done E B
           (transformer : Transformer B)
           (encode2 : E -> Comp (B * E))
  : forall ctx,
    refineEquiv (compose _ (fun ctx => ret (transform_id, ctx)) encode2 ctx)
                  (encode2 ctx).
Proof.
  unfold compose; simpl; intros.
  rewrite refineEquiv_bind2_unit; simpl.
  split; unfold Bind2; intros v Comp_v.
  - computes_to_econstructor; eauto; destruct v; simpl;
      rewrite transform_id_left; eauto.
  - computes_to_inv; subst; destruct v0;
    rewrite transform_id_left; eauto.
Qed.

Lemma refineEquiv_under_compose E B
           (transformer : Transformer B)
           (encode1 encode2 encode2' : E -> Comp (B * E))
  : (forall ctx', refineEquiv (encode2 ctx') (encode2' ctx'))
    -> forall ctx,
      refineEquiv (compose _ encode1 encode2 ctx)
                  (compose _ encode1 encode2' ctx).
Proof.
  unfold compose; intros.
  eapply refineEquiv_bind; [ reflexivity | ].
  intro ab; destruct ab; simpl.
  eapply refineEquiv_bind; [ apply H | reflexivity ].
Qed.

Lemma compose_encode_correct
      {A A' B}
      {cache : Cache}
      {P  : CacheDecode -> Prop}
      {P_inv1 P_inv2 : (CacheDecode -> Prop) -> Prop}
      (P_inv_pf : cache_inv_Property P (fun P => P_inv1 P /\ P_inv2 P))
      (transformer : Transformer B)
      (project : A -> A')
      (predicate : A -> Prop)
      (predicate' : A' -> Prop)
      (predicate_rest' : A -> B -> Prop)
      (predicate_rest : A' -> B -> Prop)
      (encode1 : A' -> CacheEncode -> Comp (B * CacheEncode))
      (encode2 : A -> CacheEncode -> Comp (B * CacheEncode))
      (decode1 : B -> CacheDecode -> option (A' * B * CacheDecode))
      (decode1_pf :
         cache_inv_Property P P_inv1
         -> encode_decode_correct_f
              cache transformer predicate'
              predicate_rest
              encode1 decode1 P)
      (pred_pf : forall data, predicate data -> predicate' (project data))
      (predicate_rest_impl :
         forall a' b
                a ce ce' ce'' b' b'',
           computes_to (encode1 a' ce) (b', ce')
           -> project a = a'
           -> predicate a
           -> computes_to (encode2 a ce') (b'', ce'')
           -> predicate_rest' a b
          -> predicate_rest a' (transform b'' b))
      (decode2 : A' -> B -> CacheDecode -> option (A * B * CacheDecode))
      (decode2_pf : forall proj,
          predicate' proj ->
          cache_inv_Property P P_inv2 ->
          encode_decode_correct_f cache transformer
            (fun data => predicate data /\ project data = proj)
            predicate_rest'
            encode2
            (decode2 proj) P)
  : encode_decode_correct_f
      cache transformer
      (fun a => predicate a)
      predicate_rest'
      (fun (data : A) (ctx : CacheEncode) =>
         compose _ (encode1 (project data)) (encode2 data)  ctx
      )%comp
     (fun (bin : B) (env : CacheDecode) =>
        `(proj, rest, env') <- decode1 bin env;
          decode2 proj rest env') P.
Proof.
  unfold cache_inv_Property in *; split.
  { intros env env' xenv data bin ext ? env_pm pred_pm pred_pm_rest com_pf.
    unfold compose, Bind2 in com_pf; computes_to_inv; destruct v;
      destruct v0.
    destruct (fun H' => proj1 (decode1_pf (proj1 P_inv_pf)) _ _ _ _ _ (transform b0 ext) env_OK env_pm (pred_pf _ pred_pm) H' com_pf); intuition; simpl in *; injections; eauto.
    setoid_rewrite <- transform_assoc; rewrite H2.
    simpl.
    destruct (fun H'' => proj1 (decode2_pf (project data) (pred_pf _ pred_pm) H1)
                               _ _ _ _ _ ext H4 H (conj pred_pm (eq_refl _)) H'' com_pf');
      intuition; simpl in *; injections.
    eauto. }
  { intros.
    destruct (decode1 bin env') as [ [ [? ?] ? ] | ] eqn : ? ;
      simpl in *; try discriminate.
    eapply (proj2 (decode1_pf (proj1 P_inv_pf))) in Heqo; eauto.
      destruct Heqo as [? [? [? [? [? [? ?] ] ] ] ] ].
    eapply (proj2 (decode2_pf a H5 (proj2 P_inv_pf))) in H2; eauto.
    destruct H2 as [? ?]; destruct_ex; intuition; subst.
    eexists; eexists; repeat split.
    repeat computes_to_econstructor; eauto.
    simpl; rewrite transform_assoc; reflexivity.
    eassumption.
    eassumption.
  }
Qed.

(* For decoding fixed fields that do no depend on the object *)
(* being encoded, e.g. version numbers in an IP packet. This *)
(* allows us to avoid polluting the data invariant with  *)
(* extraneous clauses. *)

(* SUGGESTION: If we're using a deterministic encoder, we *)
(* could compare the binary values of the field instead of *)
(* decoding and comparing. *)

Lemma compose_encode_correct_no_dep
      {A A' B}
      (* Need decideable equality on the type of the fixed field. *)
      (A'_eq_dec : Query_eq A')
      {cache : Cache}
      {P  : CacheDecode -> Prop}
      {P_inv1 P_inv2 : (CacheDecode -> Prop) -> Prop}
      (P_inv_pf : cache_inv_Property P (fun P => P_inv1 P /\ P_inv2 P))
      (transformer : Transformer B)
      (a' : A')
      (predicate : A -> Prop)
      (predicate' : A' -> Prop)
      (predicate_rest' : A -> B -> Prop)
      (predicate_rest : A' -> B -> Prop)
      (encode1 : A' -> CacheEncode -> Comp (B * CacheEncode))
      (encode2 : A -> CacheEncode -> Comp (B * CacheEncode))
      (decode1 : B -> CacheDecode -> option (A' * B * CacheDecode))
      (decode1_pf :
         cache_inv_Property P P_inv1
         -> encode_decode_correct_f cache transformer predicate' predicate_rest
                                    encode1 decode1 P)
      (predicate_a' : predicate' a')
      (predicate_rest_impl :
         forall a' b
                a ce ce' ce'' b' b'',
           computes_to (encode1 a' ce) (b', ce')
           -> predicate a
           -> computes_to (encode2 a ce') (b'', ce'')
           -> predicate_rest' a b
           -> predicate_rest a' (transform b'' b))
      (decode2 : B -> CacheDecode -> option (A * B * CacheDecode))
      (decode2_pf :
         predicate' a' ->
          cache_inv_Property P P_inv2 ->
          encode_decode_correct_f cache transformer
                                  (fun data => predicate data)
                                  predicate_rest'
            encode2
            decode2 P)
  : encode_decode_correct_f
      cache transformer
      (fun a => predicate a)
      predicate_rest'
      (fun (data : A) (ctx : CacheEncode) =>
         compose _ (encode1 a') (encode2 data)  ctx
      )%comp
     (fun (bin : B) (env : CacheDecode) =>
        `(a, rest, env') <- decode1 bin env;
          (if A_eq_dec a a' then decode2 rest env' else None)) P.
Proof.
  unfold cache_inv_Property in *; split.
  { intros env env' xenv data bin ext ? env_pm pred_pm pred_pm_rest com_pf.
    unfold compose, Bind2 in com_pf; computes_to_inv; destruct v;
      destruct v0.
    destruct (fun H => proj1 (decode1_pf (proj1 P_inv_pf)) _ _ _ _ _ (transform b0 ext) env_OK env_pm predicate_a' H com_pf); intuition; simpl in *; injections.
    eapply predicate_rest_impl; eauto.
    setoid_rewrite <- transform_assoc; rewrite H2.
    simpl.
    destruct (A_eq_dec a' a'); try congruence.
    subst.
    destruct (fun H => proj1 H6 (*decode2_pf _ (conj (eq_refl _) predicate_a') H1*)
                    _ _ _ _ _ ext H4 H pred_pm pred_pm_rest com_pf');
      intuition; simpl in *; injections.
    eauto. }
  { intros.
    destruct (decode1 bin env') as [ [ [? ?] ? ] | ] eqn : ? ;
      simpl in *; try discriminate;
        destruct (A_eq_dec a a'); try discriminate;
          eapply (proj2 (decode1_pf (proj1 P_inv_pf))) in Heqo; eauto;
            destruct Heqo; destruct_ex; intuition; subst;
              eapply (proj2 H11 (*decode2_pf a' (conj (eq_refl _) H7) H5)*)) in H1; eauto;
                destruct H1; destruct_ex; intuition; subst.
    eexists; eexists; repeat split.
    repeat computes_to_econstructor; eauto.
    simpl; rewrite transform_assoc; reflexivity.
    eassumption.
    eassumption.
  }
Qed.

Lemma encode_decode_correct_finish {A B}
  : forall (cache : Cache)
           (transformer : Transformer B)
           (predicate : A -> Prop)
           (rest_predicate : A -> B -> Prop)
           (decode_inv : CacheDecode -> Prop)
           (a : A)
           (b : bool),
    (forall a', predicate a' -> a' = a)
    -> decides b (predicate a)
    -> encode_decode_correct_f
         cache
         transformer
         predicate
         rest_predicate
         (fun a' ctxE => ret (transform_id, ctxE))
         (fun b' ctxD => if b then Some (a, b', ctxD) else None)
         decode_inv.
Proof.
  unfold encode_decode_correct_f; split; intros.
  - eexists env'; pose proof (H _ H2); subst; find_if_inside;
      simpl in *; intuition eauto; computes_to_inv; injections.
    rewrite transform_id_left; eauto.
    eassumption.
  - find_if_inside; injections; try discriminate;
      simpl in *; intuition eauto.
    eexists; eexists; intuition eauto.
    rewrite transform_id_left; reflexivity.
Qed.

Lemma decides_and :
  forall b b' P Q,
    decides b P
    -> decides b' Q
    -> decides (andb b b') (P /\ Q).
Proof.
  destruct b; destruct b'; simpl in *; intuition.
Qed.

Lemma decides_assumption :
  forall (P : Prop),
    P -> decides true P.
Proof. simpl in *; intuition. Qed.

Lemma decides_eq_refl {A} :
  forall (a : A), decides true (a = a).
Proof. simpl in *; intuition. Qed.

Lemma decides_dec_eq {A} :
  forall (A_eqb : A -> A -> bool)
         (A_eqb_sound : forall a a', a = a' <-> A_eqb a a' = true)
        (a a' : A), decides (A_eqb a a') (a = a').
Proof.
  simpl in *; intros; pose proof (A_eqb_sound a a');
    destruct (A_eqb a a'); simpl; intuition.
Qed.

Lemma decides_dec_lt
  : forall n n', decides (if (Compare_dec.lt_dec n n') then true else false) (lt n n').
Proof.
  intros; find_if_inside; simpl; eauto.
Qed.


Require Import Prog.
Require Import Mem Pred.
Require Import Word.
Require Import PredCrash.
Require Import AsyncDisk.

Set Implicit Arguments.

Hint Constructors fail_step step exec.

Definition buf_ne sz1 (buf1: word sz1) sz2 (buf2: word sz2)
  := forall (H: sz1 = sz2), eq_rect _ _ buf1 _ H <> buf2.

Lemma buf_ne_sz_same : forall sz (buf1 buf2: word sz),
    buf1 <> buf2 ->
    buf_ne buf1 buf2.
Proof.
  unfold buf_ne; intros.
  rewrite <- Eqdep_dec.eq_rect_eq_dec; auto.
  apply addr_eq_dec.
Qed.

Lemma buf_ne_sz_neq : forall sz1 sz2 (buf1: word sz1) (buf2: word sz2),
    sz1 <> sz2 ->
    buf_ne buf1 buf2.
Proof.
  unfold buf_ne; intros.
  congruence.
Qed.

Hint Resolve buf_ne_sz_same buf_ne_sz_neq.

Lemma possible_sync_refl : forall A AEQ (m: @mem A AEQ valuset),
    possible_sync m m.
Proof.
  unfold possible_sync; intros.
  destruct (m a).
  - right.
    destruct p.
    exists w, l, l; intuition auto.
    apply List.incl_refl.
  - left; auto.
Qed.

Hint Resolve possible_sync_refl.

Definition hash_safe_dec hm h sz (buf: word sz) : {hash_safe hm h buf} + {~hash_safe hm h buf}.
Proof.
  unfold hash_safe.
  case_eq (hashmap_get hm h); intros.
  destruct s.
  destruct (addr_eq_dec sz x); subst.
  destruct (weq buf w); subst.
  - (* hash is in hm with correct buffer *)
    eauto.
  - (* hash is in hm and buffers are same size, but unequal *)
    right; intro.
    intuition (try congruence).
    inversion H1.
    apply Eqdep_dec.inj_pair2_eq_dec in H2; eauto.
    apply addr_eq_dec.
  - (* hash is in hm but buffers are not same size *)
    right; intro.
    intuition (try congruence).
  - (* new hash *)
    left; eauto.
Defined.

Inductive hashmap_wf : hashmap -> Prop :=
| empty_hashmap_wf : hashmap_wf empty_hashmap
| upd_hashmap_wf : forall hm sz (buf: word sz),
    hashmap_wf hm ->
    hashmap_wf (upd_hashmap hm (hash_fwd buf) (existT _ _ buf)).

Lemma hashmap_wf_get : forall hm sz1 (buf1: word sz1) sz2 (buf2: word sz2),
    hashmap_wf hm ->
    hashmap_get hm (hash_fwd buf1) = Some (existT _ _ buf2) ->
    hash_fwd buf1 = hash_fwd buf2.
Proof.
  induction hm; intros.
  - unfold hashmap_get in H0.
    destruct (weq (hash_fwd buf1) default_hash); subst.
    inversion H0; subst.
    apply Eqdep_dec.inj_pair2_eq_dec in H3; subst.
    eauto.
    apply addr_eq_dec.
    congruence.
  - unfold hashmap_get in H0.
    destruct (weq (hash_fwd buf1) default_hash); subst.
    inversion H0; subst.
    apply Eqdep_dec.inj_pair2_eq_dec in H3; subst.
    eauto.
    apply addr_eq_dec.
    fold (hashmap_get hm (hash_fwd buf1)) in H0.
    inversion H; subst.
    destruct (weq (hash_fwd buf) (hash_fwd buf1)); eauto.
    inversion H0; subst.
    apply Eqdep_dec.inj_pair2_eq_dec in H4; subst.
    eauto.
    apply addr_eq_dec.
Qed.

Lemma de_morgan : forall (P Q:Prop),
    ~(P \/ Q) ->
    ~P /\ ~Q.
Proof.
  tauto.
Qed.

Theorem not_hash_safe_conflict : forall hm sz (buf: word sz),
    hashmap_wf hm ->
    ~hash_safe hm (hash_fwd buf) buf ->
    exists sz' (buf': word sz'),
      buf_ne buf buf' /\
      hash_fwd buf = hash_fwd buf'.
Proof.
  unfold hash_safe; intros.
  apply de_morgan in H0; intuition.
  case_eq (hashmap_get hm (hash_fwd buf)); intros;
    try solve [ exfalso; eauto ].
  destruct s.
  destruct (addr_eq_dec sz x); subst.
  destruct (weq buf w); subst.
  exfalso; eauto.
  exists _, w.
  apply hashmap_wf_get in H0; auto.
  exists _,  w.
  apply hashmap_wf_get in H0; eauto.
Qed.

Hint Constructors hashmap_wf.

Theorem exec_preserves_hashmap_wf : forall T (p: prog T) d vm hm d' vm' hm' v,
    hashmap_wf hm ->
    exec d vm hm p (Finished d' vm' hm' v) ->
    hashmap_wf hm'.
Proof.
  intros.
  remember (Finished d' vm' hm' v).
  generalize dependent d'.
  generalize dependent vm'.
  generalize dependent hm'.
  generalize dependent v.
  induction H0; intros;
    repeat match goal with
        | [ H: @eq (outcome _) _ _ |- _ ] =>
          inversion H; subst; clear H
           end; eauto.
  match goal with
  | [ H: step _ _ _ _ _ _ _ _ |- _ ] =>
    inversion H; subst; eauto
  end.
  unfold upd_hashmap'; eauto.
  unfold upd_hashmap'; eauto.
Qed.

Hint Resolve exec_preserves_hashmap_wf.
Hint Resolve tt.

(**
 * XXX [exec_progress] is no longer true because type equality is not
 * decidable for [VarGet].
 *)

(*
Theorem exec_progress : forall T (p: prog T) d hm,
    hashmap_wf hm ->
    (exists d' hm' v', exec d hm p (Finished d' hm' v')) \/
    (exec d hm p (Failed T)) \/
    (exists sz1 (buf1: word sz1) sz2 (buf2: word sz2),
        buf_ne buf1 buf2 /\
        hash_fwd buf1 = hash_fwd buf2).
Proof.
  induction p; intros.
  - eauto.
  - case_eq (d a); intros; eauto.
    destruct p.
    eauto 10.
  - case_eq (d a); intros; eauto.
    destruct p.
    left.
    eexists.
    exists hm, tt.
    econstructor; eauto.
    eapply StepWrite; eauto.
  - left.
    eauto 10.
  - case_eq (d a); intros; eauto.
    left.
    eexists.
    exists hm, tt.
    econstructor; eauto.
    eapply StepTrim with (vs':=p); eauto.
  - destruct (hash_safe_dec hm (hash_fwd buf) buf).
    eauto 10.
    apply not_hash_safe_conflict in n; eauto.
  - specialize (IHp d hm).
    intuition eauto.
    repeat deex.
    specialize (H v' d' hm').
    assert (hashmap_wf hm') by eauto.
    intuition eauto.
    repeat deex.
    eauto 10.
Qed.
*)


Require Import ZArith coqutil.Z.div_mod_to_equations.
Require Import bedrock2.NotationsCustomEntry.
Import Syntax BinInt String List.ListNotations ZArith.
Require Import coqutil.Z.Lia.
Require Import bedrock2Examples.rpmul.
Local Open Scope string_scope. Local Open Scope Z_scope. Local Open Scope list_scope.

(* Variant of "ipow" implementing multiplication in terms of addition instead
* of exponentiation in terms of multiplication. *)

Definition softmul :=
  ("softmul", (["inst"; "a_regs"], @nil String.string, bedrock_func_body:(
  a = a_regs + ((inst>>$15)&$(Z.ones 5))<<$2;
  b = a_regs + ((inst>>$20)&$(Z.ones 5))<<$2;
  d = a_regs + ((inst>>$ 7)&$(Z.ones 5))<<$2;
  a = load(a);
  b = load(b);
  unpack! c = rpmul(a, b);
  store(d, c)
))).

From bedrock2 Require Import Semantics BasicC32Semantics WeakestPrecondition ProgramLogic.
From coqutil Require Import Word.Properties Word.Interface Tactics.letexists.
Require Import riscv.Spec.Decode riscv.Utility.Utility.
Require Import bedrock2.SepAutoArray bedrock2.SepAutoExports.
Open Scope bool_scope.

(* like (decode RV32I), but additionally also accepts the Mul instruction
   (but no other instructions from the M extension) *)
Definition mdecode(inst: Z): Instruction :=
  let opcode := bitSlice inst 0 7 in
  let rd := bitSlice inst 7 12 in
  let funct3 := bitSlice inst 12 15 in
  let rs1 := bitSlice inst 15 20 in
  let rs2 := bitSlice inst 20 25 in
  let funct7 := bitSlice inst 25 32 in
  if (opcode =? opcode_OP) && (funct3 =? funct3_MUL) && (funct7 =? funct7_MUL)
  then MInstruction (Mul rd rs1 rs2)
  else decode RV32I inst.

Definition idecode: Z -> Instruction := decode RV32I.

#[export] Instance spec_of_softmul : spec_of "softmul" :=
  fnspec! "softmul" inst a_regs / rd rs1 rs2 regvals R,
  { requires t m :=
      mdecode (word.unsigned inst) = MInstruction (Mul rd rs1 rs2) /\
      List.length regvals = 32%nat /\
      sep (a_regs :-> regvals : word_array) R m;
      (* Alternative way of expressing the length constraint:
      sep (a_regs |-> with_len 32 word_array regvals) R m; *)
    ensures t' m' :=
      t = t' /\
      sep (a_regs :-> List.upd regvals (Z.to_nat rd) (word.mul
               (List.nth (Z.to_nat rs1) regvals default)
               (List.nth (Z.to_nat rs2) regvals default)) : word_array) R m'
 }.

Lemma decode_RV32I_not_MInstruction i mi : decode RV32I i <> MInstruction mi.
Proof.
  cbv beta delta [decode].
  repeat lazymatch goal with
         | |- (let x := ?a in ?b) <> ?c =>
             change (let x := a in b <> c); intro
         | x := ?t : ?T |- _ =>
             pose proof (eq_refl t : x = t); clearbody x
         end.
  destruct_one_match. 1: clear; congruence.
  clear -H H0 H8.
  subst. cbn.
  destruct_one_match; cbn. 1: clear; congruence.
  destruct_one_match; cbn; congruence.
Qed.

Lemma softmul_ok : program_logic_goal_for_function! softmul.
Proof.
  repeat straightline.

  cbv [mdecode] in *.
  case (_&&_) eqn:? in *; cycle 1; [|clear Heqb0].
  { edestruct decode_RV32I_not_MInstruction; eauto. }
  set (word.unsigned inst) as w in *; inversion H0; clear H0; cbv [bitSlice] in *;subst w.
  repeat match goal with H : context G [?e] |- _ =>
    let e' := groundcbv.groundcbv e in
    let H' := context G[e'] in
    progress change H' in H
  end.
  repeat match goal with
    | x := ?v |- _ =>
        idtac x;
        let H := fresh "H" x in
        pose proof (eq_refl x : x = v) as H; move H before x; clearbody x; move x at top
    end.
  1:rewrite <-(word.of_Z_unsigned (word.and _ _)), ?word.unsigned_and_nowrap, ?word.unsigned_sru_nowrap, ?unsigned_sru_nowrap, 2word.unsigned_of_Z_nowrap, H4 in Hd.
  1:rewrite <-(word.of_Z_unsigned (word.and _ _)), ?word.unsigned_and_nowrap, ?word.unsigned_sru_nowrap, ?unsigned_sru_nowrap, 2word.unsigned_of_Z_nowrap, H5 in Ha.
  1:rewrite <-(word.of_Z_unsigned (word.and _ _)), ?word.unsigned_and_nowrap, ?word.unsigned_sru_nowrap, ?unsigned_sru_nowrap, 2word.unsigned_of_Z_nowrap, H6 in Hb.
  all:[> | rewrite ?word.unsigned_of_Z_nowrap; clear; blia .. ].

  change (31) with (Z.ones 5) in *.
  rewrite !Z.land_ones in * by better_lia.

  eexists; split.
  { eexists; split; repeat straightline.
    eexists; split; repeat straightline.
    eapply Scalars.load_word_of_sep.
    match goal with
    | |- (Scalars.scalar ?a ?v * ?b)%sep ?m => change (sep (a :-> v : Scalars.scalar) b m)
    end.
    scancel_asm. }

  repeat straightline.

  eexists; split.
  { eexists; split; repeat straightline.
    eexists; split; repeat straightline.
    eapply Scalars.load_word_of_sep.
    match goal with
    | |- (Scalars.scalar ?a ?v * ?b)%sep ?m => change (sep (a :-> v : Scalars.scalar) b m)
    end.
    scancel_asm. }

  repeat (straightline || straightline_call).

  eapply Scalars.array_store_of_sep with (sz:=access_size.word) (n:=Z.to_nat rd) (size:=word.of_Z 4%Z).
  { subst d. f_equal. ZnWords. }
  { use_sep_assumption; cbn [seps]; unfold word_array.
    reflexivity. }
  { ZnWords. }

  intro_new_mem.
  repeat straightline; ssplit; trivial.
  use_sep_assumption; cbn [seps]; unfold word_array.

  rewrite <-!Z.land_ones in * by better_lia.
  Morphisms.f_equiv.
  Morphisms.f_equiv.
  f_equal.
  { subst rd. reflexivity. }
  eapply word.unsigned_inj; rewrite H8, word.unsigned_mul, Z.land_ones by (clear;blia).
  cbv [a b]; subst rs1; subst rs2; rewrite !word.word_sub_add_l_same_l.
  cbv [word.wrap].
  repeat match goal with |- context G [Z.lnot ?e] =>
    let e' := groundcbv.groundcbv (Z.lnot e) in
    let H' := context G[e'] in
    progress change H'
  end.
  rewrite !Z.land_ones, !(Z.land_ones _ 5) by (clear;blia).
  do 5 f_equal.
  all:ZnWords.

  Unshelve.
  all : exact (word.of_Z 0).
Qed.


(** This file contains generic environment information for the Bedrock IL
 **)
Require Import Coq.Lists.List.
Require Import Bedrock.Word.
Require Import Bedrock.Expr.
Require Import Bedrock.Env.
Require Import Bedrock.Memory Bedrock.IL.
Require Import Bedrock.TypedPackage.
Require Import Coq.Arith.Arith.

Set Implicit Arguments.
Set Strict Implicit.

(*
Definition test_seq l r : bool :=
  match l as l , r as r with
    | IL.Eq , IL.Eq => true
    | IL.Ne , IL.Ne => true
    | IL.Le , IL.Le => true
    | IL.Lt , IL.Lt => true
    | _ , _ => false
  end.

Theorem test_seq_compare : forall x y, test_seq x y = true -> x = y.
  destruct x; destruct y; simpl; (reflexivity || congruence).
Defined.
*)

Definition reg_seq l r : bool :=
  match l as l , r as r with
    | IL.Sp , IL.Sp => true
    | IL.Rp , IL.Rp => true
    | IL.Rv , IL.Rv => true
    | _ , _ => false
  end.

Theorem reg_seq_compare : forall x y, reg_seq x y = true -> x = y.
  destruct x; destruct y; simpl; (reflexivity || congruence).
Defined.

Definition W_seq (l r : W) : bool := Word.weqb l r.

Theorem W_seq_compare : forall x y, W_seq x y = true -> x = y.
  intros. apply weqb_sound. unfold W_seq in *. apply H.
Defined.

Lemma all_false_compare T : forall x y : T, false = true -> x = y.
  congruence.
Defined.

Definition bedrock_type_W : type :=
  {| Expr.Impl := W
   ; Expr.Eqb := W_seq
   ; Expr.Eqb_correct := W_seq_compare
  |}.
Definition bedrock_type_setting_X_state : type :=
  {| Expr.Impl := settings * state
   ; Expr.Eqb := fun _ _ => false
   ; Expr.Eqb_correct := @all_false_compare _
   |}.
Definition bedrock_type_state : type :=
  {| Expr.Impl := state
   ; Expr.Eqb := fun _ _ => false
   ; Expr.Eqb_correct := @all_false_compare _
   |}.
(*
Definition bedrock_type_test : type :=
  {| Expr.Impl := IL.test
   ; Expr.Eqb := test_seq
   ; Expr.Eqb_correct := test_seq_compare
  |}.
*)
Definition bedrock_type_reg : type :=
  {| Expr.Impl := IL.reg
   ; Expr.Eqb := reg_seq
   ; Expr.Eqb_correct := reg_seq_compare
  |}.

Definition bedrock_type_nat : type :=
  {| Expr.Impl := nat
   ; Expr.Eqb := beq_nat
   ; Expr.Eqb_correct := beq_nat_true
  |}.

Definition core_bedrock_types : list Expr.type :=
  bedrock_type_W ::
  bedrock_type_setting_X_state :: nil.

Definition core_bedrock_types_r : Repr Expr.type :=
  Eval cbv beta iota zeta delta [ listToRepr core_bedrock_types ]
    in (listToRepr core_bedrock_types Expr.EmptySet_type).

Definition bedrock_types : list Expr.type :=
  bedrock_type_W ::
  bedrock_type_setting_X_state ::
  bedrock_type_state ::
(*  bedrock_type_test :: *)
  bedrock_type_reg ::
  bedrock_type_nat :: nil.

Definition bedrock_types_r : Repr Expr.type :=
  Eval cbv beta iota zeta delta [ listToRepr bedrock_types ]
    in (listToRepr bedrock_types Expr.EmptySet_type).

Definition comparator (t : IL.test) (l r : W) : Prop :=
  match t with
    | IL.Eq => l = r
    | IL.Ne => l = r -> False
    | IL.Lt => wlt l r
    | IL.Le => not (wlt r l)
  end.

Section typed_ext.
  Variable types' : list type.
  (* Local Notation "'types'" := (repr bedrock_types_r types'). *)

  Local Notation "'pcT'" := (tvType 0).
  Local Notation "'tvWord'" := (tvType 0).
  Local Notation "'stT'" := (tvType 1).
  Local Notation "'tvState'" := (tvType 2).
(*Local Notation "'tvTest'" := (tvType 3).*)
  Local Notation "'tvReg'" := (tvType 3).
  Local Notation "'natT'" := (tvType 4).

  Definition word_types_r : Repr Expr.type :=
    Eval cbv beta iota zeta delta [ listToRepr ]
      in (listToRepr (bedrock_type_W :: nil) Expr.EmptySet_type).

  Definition wplus_r : signature (repr word_types_r types').
    refine {| Domain := tvWord :: tvWord :: nil; Range := tvWord |}.
    exact (@wplus 32).
  Defined.

  Definition wminus_r : signature (repr word_types_r types').
    refine {| Domain := tvWord :: tvWord :: nil; Range := tvWord |}.
    exact (@wminus 32).
  Defined.

  Definition wmult_r : signature (repr word_types_r types').
    refine {| Domain := tvWord :: tvWord :: nil; Range := tvWord |}.
    exact (@wmult 32).
  Defined.

(*
  Definition word_test_r : Repr Expr.type :=
    Eval cbv beta iota zeta delta [ listToRepr ]
      in (listOptToRepr (Some bedrock_type_W :: None :: None :: Some bedrock_type_test :: nil) Expr.EmptySet_type).

  Definition wcomparator_r : signature (repr word_test_r types').
    refine {| Domain := tvTest :: tvWord :: tvWord :: nil ; Range := tvProp |}.
    exact (comparator).
  Defined.
*)

  Definition word_state_r : Repr Expr.type :=
    Eval cbv beta iota zeta delta [ listToRepr ]
      in (listOptToRepr (Some bedrock_type_W :: None :: Some bedrock_type_state :: Some bedrock_type_reg :: nil) Expr.EmptySet_type).

  Definition Regs_r : signature (repr word_state_r types').
    refine {| Domain := tvState :: tvReg :: nil ; Range := tvWord |}.
    exact (Regs).
  Defined.

  Definition wlt_r : signature (repr word_types_r types').
    refine {| Domain := tvWord :: tvWord :: nil; Range := tvProp |}.
    exact (@wlt 32).
  Defined.

  Definition word_nat_r : Repr Expr.type :=
    Eval cbv beta iota zeta delta [ listToRepr ]
      in (listOptToRepr (Some bedrock_type_W :: None :: None :: None :: Some bedrock_type_nat :: nil) Expr.EmptySet_type).

  Definition natToW_r : signature (repr word_nat_r types').
    refine {| Domain := natT :: nil; Range := tvWord |}.
    exact natToW.
  Defined.
End typed_ext.

  Definition bedrock_funcs types' : functions (repr bedrock_types_r types') :=
    let types := repr bedrock_types_r types' in
    wplus_r types ::
    wminus_r types ::
    wmult_r types ::
    (* wcomparator_r types :: *)
    Regs_r types ::
    wlt_r types ::
    natToW_r types :: nil.

  Definition bedrock_funcs_r types' : Repr (signature (repr bedrock_types_r types')) :=
    Eval cbv beta iota zeta delta [ listToRepr bedrock_funcs ]
      in (listToRepr (bedrock_funcs types') (Default_signature _)).

Section func_ext.
  Local Notation "'pcT'" := (tvType 0).
  Local Notation "'tvWord'" := (tvType 0).
  Local Notation "'stT'" := (tvType 1).
  Local Notation "'tvState'" := (tvType 2).
(*Local Notation "'tvTest'" := (tvType 3).*)
  Local Notation "'tvReg'" := (tvType 3).
  Local Notation "'natT'" := (tvType 4).

  Variable types' : list type.
  Definition types := repr bedrock_types_r types'.

  Variable funcs' : functions types.
  Definition funcs := repr (bedrock_funcs_r types') funcs'.

  Definition fPlus (l r : expr types) : expr types :=
    Expr.Func 0 (l :: r :: nil).
  Definition fMinus (l r : expr types) : expr types :=
    Expr.Func 1 (l :: r :: nil).
  Definition fMult (l r : expr types) : expr types :=
    Expr.Func 2 (l :: r :: nil).

  Theorem fPlus_correct : forall l r uvars vars,
    match exprD funcs uvars vars l (tvType 0) , exprD funcs uvars vars r (tvType 0) with
      | Some lv , Some rv =>
        exprD funcs uvars vars (fPlus l r) (tvType 0) = Some (wplus lv rv)
      | _ , _ => True
    end.
  Proof.
    intros; simpl; unfold eq_ind_r; simpl;
      repeat match goal with
               | [ |- match ?X with
                        | Some _ => _
                        | None => _
                      end ] => destruct X
             end; auto.
  Qed.
  Theorem fMinus_correct : forall l r uvars vars,
    match exprD funcs uvars vars l tvWord , exprD funcs uvars vars r tvWord with
      | Some lv , Some rv =>
        exprD funcs uvars vars (fMinus l r) tvWord = Some (wminus lv rv)
      | _ , _ => True
    end.
  Proof.
    intros; simpl; unfold eq_ind_r; simpl;
      repeat match goal with
               | [ |- match ?X with
                        | Some _ => _
                        | None => _
                      end ] => destruct X
             end; auto.
  Qed.
  Theorem fMult_correct : forall l r uvars vars,
    match exprD funcs uvars vars l tvWord , exprD funcs uvars vars r tvWord with
      | Some lv , Some rv =>
        exprD funcs uvars vars (fMult l r) tvWord = Some (wmult lv rv)
      | _ , _ => True
    end.
  Proof.
    intros; simpl; unfold eq_ind_r; simpl;
      repeat match goal with
               | [ |- match ?X with
                        | Some _ => _
                        | None => _
                      end ] => destruct X
             end; auto.
  Qed.
End func_ext.

Module BedrockCoreEnv <: CoreEnv.
  Definition core :=
    Eval unfold bedrock_types_r in bedrock_types_r.

  Definition pc := tvType 0.
  Definition st := tvType 1.
End BedrockCoreEnv.

(*Require SepIL. *)


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

Require Import Bool.
Require Import Arith.
Require Import ZArith.
From IntMap Require Import Allmaps.
Require Import EqNat.
Require Import bases.

(* définition inductive du type des termes : *)
Inductive term : Set :=
    app : ad -> term_list -> term
with term_list : Set :=
  | tnil : term_list
  | tcons : term -> term_list -> term_list.

(* les principes d'induction *)
Scheme term_term_list_rec := Induction for term
  Sort Set
  with term_list_term_rec := Induction for term_list
  Sort Set.

Scheme term_term_list_ind := Induction for term
  Sort Prop
  with term_list_term_ind := Induction for term_list
  Sort Prop.

Lemma term_list_disj :
 forall l : term_list,
 l = tnil \/ (exists hd : term, (exists tl : term_list, l = tcons hd tl)).
Proof.
	simple induction l. left. trivial. right. split with t. split with t0.
	trivial.
Qed.

Fixpoint lst_length (l : term_list) : nat :=
  match l with
  | tnil => 0
  | tcons _ l' => S (lst_length l')
  end.

Fixpoint term_high (t : term) : nat :=
  match t with
  | app a l => S (term_high_0 l)
  end

 with term_high_0 (l : term_list) : nat :=
  match l with
  | tnil => 0
  | tcons hd tl => max (term_high hd) (term_high_0 tl)
  end.

Lemma high_aux_0 :
 forall (a : ad) (l : term_list), S (term_high_0 l) <= term_high (app a l).
Proof.
	intros. unfold term_high in |- *. unfold term_high_0 in |- *. exact (le_n_n _).
Qed.

Lemma high_aux_1 :
 forall (a : ad) (l : term_list), S (term_high_0 l) = term_high (app a l).
Proof.
	intros. unfold term_high in |- *. unfold term_high_0 in |- *. trivial.
Qed.

Lemma high_aux_2 : forall (l : term_list) (c : ad), 1 <= term_high (app c l).
Proof.
	intros. cut (S (term_high_0 l) <= term_high (app c l)).
	intro. cut (1 <= S (term_high_0 l)). intro.
	exact (le_trans 1 (S (term_high_0 l)) (term_high (app c l)) H0 H).
	exact (le_n_S 0 (term_high_0 l) (le_O_n (term_high_0 l))).
	exact (high_aux_0 c l).
Qed.

Lemma high_aux_3 :
 forall (t : term) (tl : term_list), term_high t <= term_high_0 (tcons t tl).
Proof.
	intros. simpl in |- *. unfold term_high in |- *. exact (le_max_l _ (term_high_0 tl)).
Qed.

Lemma high_aux_4 :
 forall (t : term) (tl : term_list),
 term_high_0 tl <= term_high_0 (tcons t tl).
Proof.
	intros.
	cut (term_high_0 (tcons t tl) = max (term_high t) (term_high_0 tl)).
	intro. rewrite H. exact (le_max_r (term_high t) (term_high_0 tl)).
	unfold term_high_0 in |- *. trivial.
Qed.

(* taille des termes : *)

Fixpoint taille_term (t : term) : nat :=
  match t with
  | app c l => S (mtaille_term_list l)
  end

 with mtaille_term_list (l : term_list) : nat :=
  match l with
  | tnil => 0
  | tcons hd tl => max (taille_term hd) (mtaille_term_list tl)
  end.

(* définition des structures prec_list : adjacence des états de l'automate *)

Inductive prec_list : Set :=
  | prec_cons : ad -> prec_list -> prec_list -> prec_list
  | prec_empty : prec_list.

Lemma pl_sum :
 forall pl : prec_list,
 pl = prec_empty \/
 (exists a : ad,
    (exists la : prec_list, (exists ls : prec_list, pl = prec_cons a la ls))).
Proof.
	intros. induction  pl as [a pl1 Hrecpl1 pl0 Hrecpl0| ]. right. split with a. split with pl1.
	split with pl0. reflexivity. left. reflexivity.
Qed.

(* définition des états *)

Definition state := Map prec_list.

(* définition des automates *)

Definition preDTA := Map state.

Inductive DTA : Set :=
    dta : preDTA -> ad -> DTA.

(* calcul de la taille de l'automate : *)

Fixpoint taille_0 (l : prec_list) : nat :=
  match l with
  | prec_empty => 0
  | prec_cons x y z => S (taille_0 y + taille_0 z)
  end.

Fixpoint taille_1 (s : state) : nat :=
  match s with
  | M0 => 0
  | M1 x y => taille_0 y
  | M2 x y => max (taille_1 x) (taille_1 y)
  end.

Fixpoint DTA_taille (d : preDTA) : nat :=
  match d with
  | M0 => 0
  | M1 x y => taille_1 y
  | M2 x y => max (DTA_taille x) (DTA_taille y)
  end.

Lemma taille_aux_0 :
 forall (a : ad) (la ls : prec_list),
 S (taille_0 la) <= taille_0 (prec_cons a la ls).
Proof.
	intros. simpl in |- *.
	apply (le_n_S (taille_0 la) (taille_0 la + taille_0 ls)).
	exact (le_plus_l (taille_0 la) (taille_0 ls)).
Qed.

Lemma taille_aux_1 :
 forall (a : ad) (la ls : prec_list), 1 <= taille_0 (prec_cons a la ls).
Proof.
	intros. unfold taille_0 in |- *.
	exact (le_n_S 0 _ (le_O_n _)).
Qed.

Lemma taille_aux_2 :
 forall (a : ad) (la ls : prec_list),
 S (taille_0 ls) <= taille_0 (prec_cons a la ls).
Proof.
	intros. simpl in |- *.
	apply (le_n_S (taille_0 ls) (taille_0 la + taille_0 ls)).
	exact (le_plus_r (taille_0 la) (taille_0 ls)).
Qed.

(* relation d'une adresse d'occurence dans les prec_list *)

Inductive prec_occur : prec_list -> ad -> Prop :=
  | prec_hd :
      forall (a : ad) (pl0 pl1 : prec_list),
      prec_occur (prec_cons a pl0 pl1) a
  | prec_int0 :
      forall (a b : ad) (pl0 pl1 : prec_list),
      prec_occur pl0 b -> prec_occur (prec_cons a pl0 pl1) b
  | prec_int1 :
      forall (a b : ad) (pl0 pl1 : prec_list),
      prec_occur pl1 b -> prec_occur (prec_cons a pl0 pl1) b.

(* relation de "contenu" pour les prec_list *)

Inductive prec_contained : prec_list -> prec_list -> Prop :=
  | prec_id : forall p : prec_list, prec_contained p p
  | prec_c_int0 :
      forall (p p0 p1 : prec_list) (a : ad),
      prec_contained p p0 -> prec_contained p (prec_cons a p0 p1)
  | prec_c_int1 :
      forall (p p0 p1 : prec_list) (a : ad),
      prec_contained p p1 -> prec_contained p (prec_cons a p0 p1).

(* définition de l'appartenance d'un état à un pre dta *)

Definition state_in_dta (d : preDTA) (s : state) : Prop :=
  exists a : ad, MapGet state d a = Some s.

Definition state_in_dta_diff (d : preDTA) (s : state)
  (a : ad) : Prop := exists b : ad, MapGet state d b = Some s /\ a <> b.

(* définition de l'appartenance d'une adjacence à un pre dta *)

Definition prec_in_dta (d : preDTA) (p : prec_list) : Prop :=
  exists s : state,
    (exists a : ad,
       (exists c : ad,
          MapGet state d a = Some s /\
          MapGet prec_list s c = Some p)).

Definition prec_in_dta_cont (d : preDTA) (p : prec_list) : Prop :=
  exists s : state,
    (exists b : ad,
       (exists c : ad,
          (exists p0 : prec_list,
             MapGet state d b = Some s /\
             MapGet prec_list s c = Some p0 /\ prec_contained p p0))).

Definition prec_in_dta_diff (d : preDTA) (p : prec_list)
  (a : ad) : Prop :=
  exists s : state,
    (exists b : ad,
       (exists c : ad,
          MapGet state d b = Some s /\
          MapGet prec_list s c = Some p /\ a <> b)).

Definition prec_in_dta_diff_cont (d : preDTA) (p : prec_list)
  (a : ad) : Prop :=
  exists s : state,
    (exists b : ad,
       (exists c : ad,
          (exists p0 : prec_list,
             MapGet state d b = Some s /\
             MapGet prec_list s c = Some p0 /\
             prec_contained p p0 /\ a <> b))).

(* définition de l'appartenance d'une adjacence à un etat *)

Definition prec_in_state (s : state) (p : prec_list) : Prop :=
  exists c : ad, MapGet prec_list s c = Some p.

Lemma prec_in_state_M0_false :
 forall p : prec_list, ~ prec_in_state (M0 prec_list) p.
Proof.
	intros. exact (in_M0_false prec_list p).
Qed.

Lemma state_in_dta_M0_false : forall s : state, ~ state_in_dta (M0 state) s.
Proof.
	intros. exact (in_M0_false state s).
Qed.

(* lemmes sur prec_occur, contained : *)

Lemma prec_occur_1 :
 forall (a : ad) (p0 p1 p2 : prec_list),
 prec_contained (prec_cons a p0 p1) p2 -> prec_occur p2 a.
Proof.
	intros. induction  p2 as [a0 p2_1 Hrecp2_1 p2_0 Hrecp2_0| ]. inversion H. exact (prec_hd a0 p2_1 p2_0).
	exact (prec_int0 a0 a p2_1 p2_0 (Hrecp2_1 H2)).
	exact (prec_int1 a0 a p2_1 p2_0 (Hrecp2_0 H2)).
	inversion H.
Qed.

Lemma prec_contained_0 :
 forall (a : ad) (p0 p1 p2 : prec_list),
 prec_contained (prec_cons a p0 p1) p2 -> prec_contained p0 p2.
Proof.
	intros. induction  p2 as [a0 p2_1 Hrecp2_1 p2_0 Hrecp2_0| ]. inversion H.
	exact (prec_c_int0 p2_1 p2_1 p2_0 a0 (prec_id p2_1)).
	exact (prec_c_int0 _ _ _ _ (Hrecp2_1 H2)).
	exact (prec_c_int1 _ _ _ _ (Hrecp2_0 H2)).
	inversion H.
Qed.

Lemma prec_contained_1 :
 forall (a : ad) (p0 p1 p2 : prec_list),
 prec_contained (prec_cons a p0 p1) p2 -> prec_contained p1 p2.
Proof.
	intros. induction  p2 as [a0 p2_1 Hrecp2_1 p2_0 Hrecp2_0| ]. inversion H.
	exact (prec_c_int1 _ _ _ _ (prec_id p2_0)).
	exact (prec_c_int0 _ _ _ _ (Hrecp2_1 H2)).
	exact (prec_c_int1 _ _ _ _ (Hrecp2_0 H2)).
	inversion H.
Qed.

(* occurence de termes dans les listes *)

Inductive term_occur : term -> term -> Prop :=
  | to_eq : forall t : term, term_occur t t
  | to_st :
      forall (t : term) (a : ad) (tl : term_list),
      term_list_occur t tl -> term_occur t (app a tl)
with term_list_occur : term -> term_list -> Prop :=
  | tlo_head :
      forall (t hd : term) (tl : term_list),
      term_occur t hd -> term_list_occur t (tcons hd tl)
  | tlo_tail :
      forall (t hd : term) (tl : term_list),
      term_list_occur t tl -> term_list_occur t (tcons hd tl).

Definition term_occur_def_0 (t : term) :=
  forall u : term, term_occur u t -> term_high u <= term_high t.

Definition term_occur_def_1 (t : term_list) :=
  forall u : term, term_list_occur u t -> term_high u <= term_high_0 t.

Lemma term_occur_0_0 :
 forall (a : ad) (t : term_list),
 term_occur_def_1 t -> term_occur_def_0 (app a t).
Proof.
	unfold term_occur_def_1 in |- *. unfold term_occur_def_0 in |- *. intros. inversion H0.
	exact (le_n_n _). apply
  (le_trans (term_high u) (term_high_0 t) (term_high (app a t)) (H u H3)). unfold term_high in |- *. exact (le_n_Sn _).
Qed.

Lemma term_occur_0_1 : term_occur_def_1 tnil.
Proof.
	unfold term_occur_def_1 in |- *. intros. induction  u as (a, t). inversion H.
Qed.

Lemma term_occur_0_2 :
 forall t : term,
 term_occur_def_0 t ->
 forall t0 : term_list, term_occur_def_1 t0 -> term_occur_def_1 (tcons t t0).
Proof.
	unfold term_occur_def_0 in |- *. unfold term_occur_def_1 in |- *. intros. inversion H1.
	apply (le_trans (term_high u) (term_high t) (term_high_0 (tcons t t0))).
	exact (H u H4). exact (le_max_l _ _). apply (le_trans (term_high u) (term_high_0 t0) (term_high_0 (tcons t t0))). exact (H0 u H4).
	exact (le_max_r _ _).
Qed.

Lemma term_occur_0 :
 forall t u : term, term_occur u t -> term_high u <= term_high t.
Proof.
	exact
  (term_term_list_ind term_occur_def_0 term_occur_def_1 term_occur_0_0
     term_occur_0_1 term_occur_0_2).
Qed.

Lemma term_occur_1 :
 forall (t : term_list) (u : term),
 term_list_occur u t -> term_high u <= term_high_0 t.
Proof.
	exact
  (term_list_term_ind term_occur_def_0 term_occur_def_1 term_occur_0_0
     term_occur_0_1 term_occur_0_2).
Qed.

Definition indprinciple_3_aux (n : nat) :=
  forall P : term -> Prop,
  (forall (a : ad) (tl : term_list),
   (forall u : term, term_list_occur u tl -> P u) -> P (app a tl)) ->
  forall t : term, term_high t <= n -> P t.

Lemma indprinciple_3_0 : indprinciple_3_aux 0.
Proof.
	unfold indprinciple_3_aux in |- *. intros. induction  t as (a, t). simpl in H0. inversion H0.
Qed.

Lemma indprinciple_3_1 :
 forall n : nat, indprinciple_3_aux n -> indprinciple_3_aux (S n).
Proof.
	unfold indprinciple_3_aux in |- *. intros. induction  t as (a, t). apply (H0 a t).
	intros. apply (H P H0 u). apply (le_trans (term_high u) (term_high_0 t) n).
	exact (term_occur_1 t u H2). exact (le_S_n _ _ H1).
Qed.

Lemma indprinciple_3_2 :
 forall (n : nat) (P : term -> Prop),
 (forall (a : ad) (tl : term_list),
  (forall u : term, term_list_occur u tl -> P u) -> P (app a tl)) ->
 forall t : term, term_high t <= n -> P t.
Proof.
	exact (nat_ind indprinciple_3_aux indprinciple_3_0 indprinciple_3_1).
Qed.

Lemma indprinciple_term :
 forall P : term -> Prop,
 (forall (a : ad) (tl : term_list),
  (forall u : term, term_list_occur u tl -> P u) -> P (app a tl)) ->
 forall t : term, P t.
Proof.
	intros. exact (indprinciple_3_2 (term_high t) P H t (le_n_n _)).
Qed.

(* lemmes sur Ndouble, Ndouble_plus_one *)

Lemma Ndouble_inv_N0 : forall x : ad, Ndouble x = N0 -> x = N0.
Proof.
	simple induction x. intros. reflexivity. simpl in |- *. intros. inversion H.
Qed.

Lemma Ndouble_inv_xO :
 forall (x : ad) (p : positive), Ndouble x = Npos (xO p) -> x = Npos p.
Proof.
	simple induction x. intros. inversion H. intros. simpl in H.
	inversion H. reflexivity.
Qed.

Lemma Ndouble_plus_one_inv_xH :
 forall x : ad, Ndouble_plus_one x = Npos 1 -> x = N0.
Proof.
	simple induction x. intros. reflexivity. simpl in |- *. intros. inversion H.
Qed.

Lemma Ndouble_plus_one_inv_xI :
 forall (x : ad) (p : positive),
 Ndouble_plus_one x = Npos (xI p) -> x = Npos p.
Proof.
	simple induction x. intros. inversion H. intros. simpl in H.
	inversion H. reflexivity.
Qed.


From mathcomp Require Import
     all_ssreflect.

(** * Paramters
    This file contains basic paramters for the protocol, as well as a few synononyms.
**)

Parameter Hash : eqType.
Parameter Party : finType.

(* Type synononyms *)
Definition Slot := nat.
Definition SlotZero := 0.
Definition Delay := nat.
Definition Parties := seq Party.

(* List of initial parites *)
Parameter InitParties : Parties.

(* Lottery parameter *)
Parameter Winner: Party -> Slot -> bool.


(* test the strength of pretyping unification *)

Require Import List.
Definition listn A n := {l : list A | length l = n}.
Definition make_ln A n (l : list A) (h : (fun l => length l = n) l) :=
  exist _ l h.