From iris.algebra Require Export base.
Set Default Proof Using "Type".

(** This files defines (a shallow embedding of) the category of OFEs:
    Complete ordered families of equivalences. This is a cartesian closed
    category, and mathematically speaking, the entire development lives
    in this category. However, we will generally prefer to work with raw
    Coq functions plus some registered Proper instances for non-expansiveness.
    This makes writing such functions much easier. It turns out that it many
    cases, we do not even need non-expansiveness.
*)

(** Unbundeled version *)
Class Dist A := dist : nat → relation A.
Instance: Params (@dist) 3.
Notation "x ≡{ n }≡ y" := (dist n x y)
  (at level 70, n at next level, format "x  ≡{ n }≡  y").
Hint Extern 0 (_ ≡{_}≡ _) => reflexivity.
Hint Extern 0 (_ ≡{_}≡ _) => symmetry; assumption.
Notation NonExpansive f := (∀ n, Proper (dist n ==> dist n) f).
Notation NonExpansive2 f := (∀ n, Proper (dist n ==> dist n ==> dist n) f).

Tactic Notation "ofe_subst" ident(x) :=
  repeat match goal with
  | _ => progress simplify_eq/=
  | H:@dist ?A ?d ?n x _ |- _ => setoid_subst_aux (@dist A d n) x
  | H:@dist ?A ?d ?n _ x |- _ => symmetry in H;setoid_subst_aux (@dist A d n) x
  end.
Tactic Notation "ofe_subst" :=
  repeat match goal with
  | _ => progress simplify_eq/=
  | H:@dist ?A ?d ?n ?x _ |- _ => setoid_subst_aux (@dist A d n) x
  | H:@dist ?A ?d ?n _ ?x |- _ => symmetry in H;setoid_subst_aux (@dist A d n) x
  end.

Section mixin.
  Local Set Primitive Projections.
  Record OfeMixin A `{Equiv A, Dist A} := {
    mixin_equiv_dist x y : x ≡ y ↔ ∀ n, x ≡{n}≡ y;
    mixin_dist_equivalence n : Equivalence (dist n);
    mixin_dist_S n x y : x ≡{S n}≡ y → x ≡{n}≡ y
  }.
End mixin.

(** Bundeled version *)
Structure ofeT := OfeT' {
  ofe_car :> Type;
  ofe_equiv : Equiv ofe_car;
  ofe_dist : Dist ofe_car;
  ofe_mixin : OfeMixin ofe_car;
  _ : Type
}.
Arguments OfeT' _ {_ _} _ _.
Notation OfeT A m := (OfeT' A m A).
Add Printing Constructor ofeT.
Hint Extern 0 (Equiv _) => eapply (@ofe_equiv _) : typeclass_instances.
Hint Extern 0 (Dist _) => eapply (@ofe_dist _) : typeclass_instances.
Arguments ofe_car : simpl never.
Arguments ofe_equiv : simpl never.
Arguments ofe_dist : simpl never.
Arguments ofe_mixin : simpl never.

(** When declaring instances of subclasses of OFE (like CMRAs and unital CMRAs)
we need Coq to *infer* the canonical OFE instance of a given type and take the
mixin out of it. This makes sure we do not use two different OFE instances in
different places (see for example the constructors [CmraT] and [UcmraT] in the
file [cmra.v].)

In order to infer the OFE instance, we use the definition [ofe_mixin_of'] which
is inspired by the [clone] trick in ssreflect. It works as follows, when type
checking [@ofe_mixin_of' A ?Ac id] Coq faces a unification problem:

  ofe_car ?Ac  ~  A

which will resolve [?Ac] to the canonical OFE instance corresponding to [A]. The
definition [@ofe_mixin_of' A ?Ac id] will then provide the corresponding mixin.
Note that type checking of [ofe_mixin_of' A id] will fail when [A] does not have
a canonical OFE instance.

The notation [ofe_mixin_of A] that we define on top of [ofe_mixin_of' A id]
hides the [id] and normalizes the mixin to head normal form. The latter is to
ensure that we do not end up with redundant canonical projections to the mixin,
i.e. them all being of the shape [ofe_mixin_of' A id]. *)
Definition ofe_mixin_of' A {Ac : ofeT} (f : Ac → A) : OfeMixin Ac := ofe_mixin Ac.
Notation ofe_mixin_of A :=
  ltac:(let H := eval hnf in (ofe_mixin_of' A id) in exact H) (only parsing).

(** Lifting properties from the mixin *)
Section ofe_mixin.
  Context {A : ofeT}.
  Implicit Types x y : A.
  Lemma equiv_dist x y : x ≡ y ↔ ∀ n, x ≡{n}≡ y.
  Proof. apply (mixin_equiv_dist _ (ofe_mixin A)). Qed.
  Global Instance dist_equivalence n : Equivalence (@dist A _ n).
  Proof. apply (mixin_dist_equivalence _ (ofe_mixin A)). Qed.
  Lemma dist_S n x y : x ≡{S n}≡ y → x ≡{n}≡ y.
  Proof. apply (mixin_dist_S _ (ofe_mixin A)). Qed.
End ofe_mixin.

Hint Extern 1 (_ ≡{_}≡ _) => apply equiv_dist; assumption.

(** Discrete OFEs and discrete OFE elements *)
Class Discrete {A : ofeT} (x : A) := discrete y : x ≡{0}≡ y → x ≡ y.
Arguments discrete {_} _ {_} _ _.
Hint Mode Discrete + ! : typeclass_instances.
Instance: Params (@Discrete) 1.

Class OfeDiscrete (A : ofeT) := ofe_discrete_discrete (x : A) :> Discrete x.

(** OFEs with a completion *)
Record chain (A : ofeT) := {
  chain_car :> nat → A;
  chain_cauchy n i : n ≤ i → chain_car i ≡{n}≡ chain_car n
}.
Arguments chain_car {_} _ _.
Arguments chain_cauchy {_} _ _ _ _.

Program Definition chain_map {A B : ofeT} (f : A → B)
    `{!NonExpansive f} (c : chain A) : chain B :=
  {| chain_car n := f (c n) |}.
Next Obligation. by intros A B f Hf c n i ?; apply Hf, chain_cauchy. Qed.

Notation Compl A := (chain A%type → A).
Class Cofe (A : ofeT) := {
  compl : Compl A;
  conv_compl n c : compl c ≡{n}≡ c n;
}.
Arguments compl : simpl never.

Lemma compl_chain_map `{Cofe A, Cofe B} (f : A → B) c `(NonExpansive f) :
  compl (chain_map f c) ≡ f (compl c).
Proof. apply equiv_dist=>n. by rewrite !conv_compl. Qed.

Program Definition chain_const {A : ofeT} (a : A) : chain A :=
  {| chain_car n := a |}.
Next Obligation. by intros A a n i _. Qed.

Lemma compl_chain_const {A : ofeT} `{!Cofe A} (a : A) :
  compl (chain_const a) ≡ a.
Proof. apply equiv_dist=>n. by rewrite conv_compl. Qed.

(** General properties *)
Section ofe.
  Context {A : ofeT}.
  Implicit Types x y : A.
  Global Instance ofe_equivalence : Equivalence ((≡) : relation A).
  Proof.
    split.
    - by intros x; rewrite equiv_dist.
    - by intros x y; rewrite !equiv_dist.
    - by intros x y z; rewrite !equiv_dist; intros; trans y.
  Qed.
  Global Instance dist_ne n : Proper (dist n ==> dist n ==> iff) (@dist A _ n).
  Proof.
    intros x1 x2 ? y1 y2 ?; split; intros.
    - by trans x1; [|trans y1].
    - by trans x2; [|trans y2].
  Qed.
  Global Instance dist_proper n : Proper ((≡) ==> (≡) ==> iff) (@dist A _ n).
  Proof.
    by move => x1 x2 /equiv_dist Hx y1 y2 /equiv_dist Hy; rewrite (Hx n) (Hy n).
  Qed.
  Global Instance dist_proper_2 n x : Proper ((≡) ==> iff) (dist n x).
  Proof. by apply dist_proper. Qed.
  Global Instance Discrete_proper : Proper ((≡) ==> iff) (@Discrete A).
  Proof. intros x y Hxy. rewrite /Discrete. by setoid_rewrite Hxy. Qed.

  Lemma dist_le n n' x y : x ≡{n}≡ y → n' ≤ n → x ≡{n'}≡ y.
  Proof. induction 2; eauto using dist_S. Qed.
  Lemma dist_le' n n' x y : n' ≤ n → x ≡{n}≡ y → x ≡{n'}≡ y.
  Proof. intros; eauto using dist_le. Qed.
  Instance ne_proper {B : ofeT} (f : A → B) `{!NonExpansive f} :
    Proper ((≡) ==> (≡)) f | 100.
  Proof. by intros x1 x2; rewrite !equiv_dist; intros Hx n; rewrite (Hx n). Qed.
  Instance ne_proper_2 {B C : ofeT} (f : A → B → C) `{!NonExpansive2 f} :
    Proper ((≡) ==> (≡) ==> (≡)) f | 100.
  Proof.
     unfold Proper, respectful; setoid_rewrite equiv_dist.
     by intros x1 x2 Hx y1 y2 Hy n; rewrite (Hx n) (Hy n).
  Qed.

  Lemma conv_compl' `{Cofe A} n (c : chain A) : compl c ≡{n}≡ c (S n).
  Proof.
    transitivity (c n); first by apply conv_compl. symmetry.
    apply chain_cauchy. omega.
  Qed.

  Lemma discrete_iff n (x : A) `{!Discrete x} y : x ≡ y ↔ x ≡{n}≡ y.
  Proof.
    split; intros; auto. apply (discrete _), dist_le with n; auto with lia.
  Qed.
  Lemma discrete_iff_0 n (x : A) `{!Discrete x} y : x ≡{0}≡ y ↔ x ≡{n}≡ y.
  Proof. by rewrite -!discrete_iff. Qed.
End ofe.

(** Contractive functions *)
Definition dist_later `{Dist A} (n : nat) (x y : A) : Prop :=
  match n with 0 => True | S n => x ≡{n}≡ y end.
Arguments dist_later _ _ !_ _ _ /.

Global Instance dist_later_equivalence (A : ofeT) n : Equivalence (@dist_later A _ n).
Proof. destruct n as [|n]. by split. apply dist_equivalence. Qed.

Lemma dist_dist_later {A : ofeT} n (x y : A) : dist n x y → dist_later n x y.
Proof. intros Heq. destruct n; first done. exact: dist_S. Qed.

Lemma dist_later_dist {A : ofeT} n (x y : A) : dist_later (S n) x y → dist n x y.
Proof. done. Qed.

(* We don't actually need this lemma (as our tactics deal with this through
   other means), but technically speaking, this is the reason why
   pre-composing a non-expansive function to a contractive function
   preserves contractivity. *)
Lemma ne_dist_later {A B : ofeT} (f : A → B) :
  NonExpansive f → ∀ n, Proper (dist_later n ==> dist_later n) f.
Proof. intros Hf [|n]; last exact: Hf. hnf. by intros. Qed.

Notation Contractive f := (∀ n, Proper (dist_later n ==> dist n) f).

Instance const_contractive {A B : ofeT} (x : A) : Contractive (@const A B x).
Proof. by intros n y1 y2. Qed.

Section contractive.
  Local Set Default Proof Using "Type*".
  Context {A B : ofeT} (f : A → B) `{!Contractive f}.
  Implicit Types x y : A.

  Lemma contractive_0 x y : f x ≡{0}≡ f y.
  Proof. by apply (_ : Contractive f). Qed.
  Lemma contractive_S n x y : x ≡{n}≡ y → f x ≡{S n}≡ f y.
  Proof. intros. by apply (_ : Contractive f). Qed.

  Global Instance contractive_ne : NonExpansive f | 100.
  Proof. by intros n x y ?; apply dist_S, contractive_S. Qed.
  Global Instance contractive_proper : Proper ((≡) ==> (≡)) f | 100.
  Proof. apply (ne_proper _). Qed.
End contractive.

Ltac f_contractive :=
  match goal with
  | |- ?f _ ≡{_}≡ ?f _ => simple apply (_ : Proper (dist_later _ ==> _) f)
  | |- ?f _ _ ≡{_}≡ ?f _ _ => simple apply (_ : Proper (dist_later _ ==> _ ==> _) f)
  | |- ?f _ _ ≡{_}≡ ?f _ _ => simple apply (_ : Proper (_ ==> dist_later _ ==> _) f)
  end;
  try match goal with
  | |- @dist_later ?A _ ?n ?x ?y =>
         destruct n as [|n]; [exact I|change (@dist A _ n x y)]
  end;
  try simple apply reflexivity.

Ltac solve_contractive :=
  solve_proper_core ltac:(fun _ => first [f_contractive | f_equiv]).

(** Limit preserving predicates *)
Class LimitPreserving `{!Cofe A} (P : A → Prop) : Prop :=
  limit_preserving (c : chain A) : (∀ n, P (c n)) → P (compl c).
Hint Mode LimitPreserving + + ! : typeclass_instances.

Section limit_preserving.
  Context `{Cofe A}.
  (* These are not instances as they will never fire automatically...
     but they can still be helpful in proving things to be limit preserving. *)

  Lemma limit_preserving_ext (P Q : A → Prop) :
    (∀ x, P x ↔ Q x) → LimitPreserving P → LimitPreserving Q.
  Proof. intros HP Hlimit c ?. apply HP, Hlimit=> n; by apply HP. Qed.

  Global Instance limit_preserving_const (P : Prop) : LimitPreserving (λ _, P).
  Proof. intros c HP. apply (HP 0). Qed.

  Lemma limit_preserving_discrete (P : A → Prop) :
    Proper (dist 0 ==> impl) P → LimitPreserving P.
  Proof. intros PH c Hc. by rewrite (conv_compl 0). Qed.

  Lemma limit_preserving_and (P1 P2 : A → Prop) :
    LimitPreserving P1 → LimitPreserving P2 →
    LimitPreserving (λ x, P1 x ∧ P2 x).
  Proof. intros Hlim1 Hlim2 c Hc. split. apply Hlim1, Hc. apply Hlim2, Hc. Qed.

  Lemma limit_preserving_impl (P1 P2 : A → Prop) :
    Proper (dist 0 ==> impl) P1 → LimitPreserving P2 →
    LimitPreserving (λ x, P1 x → P2 x).
  Proof.
    intros Hlim1 Hlim2 c Hc HP1. apply Hlim2=> n; apply Hc.
    eapply Hlim1, HP1. apply dist_le with n; last lia. apply (conv_compl n).
  Qed.

  Lemma limit_preserving_forall {B} (P : B → A → Prop) :
    (∀ y, LimitPreserving (P y)) →
    LimitPreserving (λ x, ∀ y, P y x).
  Proof. intros Hlim c Hc y. by apply Hlim. Qed.
End limit_preserving.

(** Fixpoint *)
Program Definition fixpoint_chain {A : ofeT} `{Inhabited A} (f : A → A)
  `{!Contractive f} : chain A := {| chain_car i := Nat.iter (S i) f inhabitant |}.
Next Obligation.
  intros A ? f ? n.
  induction n as [|n IH]=> -[|i] //= ?; try omega.
  - apply (contractive_0 f).
  - apply (contractive_S f), IH; auto with omega.
Qed.

Program Definition fixpoint_def `{Cofe A, Inhabited A} (f : A → A)
  `{!Contractive f} : A := compl (fixpoint_chain f).
Definition fixpoint_aux : seal (@fixpoint_def). by eexists. Qed.
Definition fixpoint {A AC AiH} f {Hf} := unseal fixpoint_aux A AC AiH f Hf.
Definition fixpoint_eq : @fixpoint = @fixpoint_def := seal_eq fixpoint_aux.

Section fixpoint.
  Context `{Cofe A, Inhabited A} (f : A → A) `{!Contractive f}.

  Lemma fixpoint_unfold : fixpoint f ≡ f (fixpoint f).
  Proof.
    apply equiv_dist=>n.
    rewrite fixpoint_eq /fixpoint_def (conv_compl n (fixpoint_chain f)) //.
    induction n as [|n IH]; simpl; eauto using contractive_0, contractive_S.
  Qed.

  Lemma fixpoint_unique (x : A) : x ≡ f x → x ≡ fixpoint f.
  Proof.
    rewrite !equiv_dist=> Hx n. induction n as [|n IH]; simpl in *.
    - rewrite Hx fixpoint_unfold; eauto using contractive_0.
    - rewrite Hx fixpoint_unfold. apply (contractive_S _), IH.
  Qed.

  Lemma fixpoint_ne (g : A → A) `{!Contractive g} n :
    (∀ z, f z ≡{n}≡ g z) → fixpoint f ≡{n}≡ fixpoint g.
  Proof.
    intros Hfg. rewrite fixpoint_eq /fixpoint_def
      (conv_compl n (fixpoint_chain f)) (conv_compl n (fixpoint_chain g)) /=.
    induction n as [|n IH]; simpl in *; [by rewrite !Hfg|].
    rewrite Hfg; apply contractive_S, IH; auto using dist_S.
  Qed.
  Lemma fixpoint_proper (g : A → A) `{!Contractive g} :
    (∀ x, f x ≡ g x) → fixpoint f ≡ fixpoint g.
  Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_ne. Qed.

  Lemma fixpoint_ind (P : A → Prop) :
    Proper ((≡) ==> impl) P →
    (∃ x, P x) → (∀ x, P x → P (f x)) →
    LimitPreserving P →
    P (fixpoint f).
  Proof.
    intros ? [x Hx] Hincr Hlim. set (chcar i := Nat.iter (S i) f x).
    assert (Hcauch : ∀ n i : nat, n ≤ i → chcar i ≡{n}≡ chcar n).
    { intros n. rewrite /chcar. induction n as [|n IH]=> -[|i] //=;
        eauto using contractive_0, contractive_S with omega. }
    set (fp2 := compl {| chain_cauchy := Hcauch |}).
    assert (f fp2 ≡ fp2).
    { apply equiv_dist=>n. rewrite /fp2 (conv_compl n) /= /chcar.
      induction n as [|n IH]; simpl; eauto using contractive_0, contractive_S. }
    rewrite -(fixpoint_unique fp2) //.
    apply Hlim=> n /=. by apply Nat_iter_ind.
  Qed.
End fixpoint.

(** Fixpoint of f when f^k is contractive. **)
Definition fixpointK `{Cofe A, Inhabited A} k (f : A → A)
  `{!Contractive (Nat.iter k f)} := fixpoint (Nat.iter k f).

Section fixpointK.
  Local Set Default Proof Using "Type*".
  Context `{Cofe A, Inhabited A} (f : A → A) (k : nat).
  Context {f_contractive : Contractive (Nat.iter k f)} {f_ne : NonExpansive f}.
  (* Note than f_ne is crucial here:  there are functions f such that f^2 is contractive,
     but f is not non-expansive.
     Consider for example f: SPred → SPred (where SPred is "downclosed sets of natural numbers").
     Define f (using informative excluded middle) as follows:
     f(N) = N  (where N is the set of all natural numbers)
     f({0, ..., n}) = {0, ... n-1}  if n is even (so n-1 is at least -1, in which case we return the empty set)
     f({0, ..., n}) = {0, ..., n+2} if n is odd
     In other words, if we consider elements of SPred as ordinals, then we decreaste odd finite
     ordinals by 1 and increase even finite ordinals by 2.
     f is not non-expansive:  Consider f({0}) = ∅ and f({0,1}) = f({0,1,2,3}).
     The arguments are clearly 0-equal, but the results are not.

     Now consider g := f^2. We have
     g(N) = N
     g({0, ..., n}) = {0, ... n+1}  if n is even
     g({0, ..., n}) = {0, ..., n+4} if n is odd
     g is contractive.  All outputs contain 0, so they are all 0-equal.
     Now consider two n-equal inputs. We have to show that the outputs are n+1-equal.
     Either they both do not contain n in which case they have to be fully equal and
     hence so are the results.  Or else they both contain n, so the results will
     both contain n+1, so the results are n+1-equal.
   *)

  Let f_proper : Proper ((≡) ==> (≡)) f := ne_proper f.
  Local Existing Instance f_proper.

  Lemma fixpointK_unfold : fixpointK k f ≡ f (fixpointK k f).
  Proof.
    symmetry. rewrite /fixpointK. apply fixpoint_unique.
    by rewrite -Nat_iter_S_r Nat_iter_S -fixpoint_unfold.
  Qed.

  Lemma fixpointK_unique (x : A) : x ≡ f x → x ≡ fixpointK k f.
  Proof.
    intros Hf. apply fixpoint_unique. clear f_contractive.
    induction k as [|k' IH]=> //=. by rewrite -IH.
  Qed.

  Section fixpointK_ne.
    Context (g : A → A) `{g_contractive : !Contractive (Nat.iter k g)}.
    Context {g_ne : NonExpansive g}.

    Lemma fixpointK_ne n : (∀ z, f z ≡{n}≡ g z) → fixpointK k f ≡{n}≡ fixpointK k g.
    Proof.
      rewrite /fixpointK=> Hfg /=. apply fixpoint_ne=> z.
      clear f_contractive g_contractive.
      induction k as [|k' IH]=> //=. by rewrite IH Hfg.
    Qed.

    Lemma fixpointK_proper : (∀ z, f z ≡ g z) → fixpointK k f ≡ fixpointK k g.
    Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpointK_ne. Qed.
  End fixpointK_ne.

  Lemma fixpointK_ind (P : A → Prop) :
    Proper ((≡) ==> impl) P →
    (∃ x, P x) → (∀ x, P x → P (f x)) →
    LimitPreserving P →
    P (fixpointK k f).
  Proof.
    intros. rewrite /fixpointK. apply fixpoint_ind; eauto.
    intros; apply Nat_iter_ind; auto.
  Qed.
End fixpointK.

(** Mutual fixpoints *)
Section fixpointAB.
  Local Unset Default Proof Using.

  Context `{Cofe A, Cofe B, !Inhabited A, !Inhabited B}.
  Context (fA : A → B → A).
  Context (fB : A → B → B).
  Context `{∀ n, Proper (dist_later n ==> dist n ==> dist n) fA}.
  Context `{∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB}.

  Local Definition fixpoint_AB (x : A) : B := fixpoint (fB x).
  Local Instance fixpoint_AB_contractive : Contractive fixpoint_AB.
  Proof.
    intros n x x' Hx; rewrite /fixpoint_AB.
    apply fixpoint_ne=> y. by f_contractive.
  Qed.

  Local Definition fixpoint_AA (x : A) : A := fA x (fixpoint_AB x).
  Local Instance fixpoint_AA_contractive : Contractive fixpoint_AA.
  Proof. solve_contractive. Qed.

  Definition fixpoint_A : A := fixpoint fixpoint_AA.
  Definition fixpoint_B : B := fixpoint_AB fixpoint_A.

  Lemma fixpoint_A_unfold : fA fixpoint_A fixpoint_B ≡ fixpoint_A.
  Proof. by rewrite {2}/fixpoint_A (fixpoint_unfold _). Qed.
  Lemma fixpoint_B_unfold : fB fixpoint_A fixpoint_B ≡ fixpoint_B.
  Proof. by rewrite {2}/fixpoint_B /fixpoint_AB (fixpoint_unfold _). Qed.

  Instance: Proper ((≡) ==> (≡) ==> (≡)) fA.
  Proof.
    apply ne_proper_2=> n x x' ? y y' ?. f_contractive; auto using dist_S.
  Qed.
  Instance: Proper ((≡) ==> (≡) ==> (≡)) fB.
  Proof.
    apply ne_proper_2=> n x x' ? y y' ?. f_contractive; auto using dist_S.
  Qed.

  Lemma fixpoint_A_unique p q : fA p q ≡ p → fB p q ≡ q → p ≡ fixpoint_A.
  Proof.
    intros HfA HfB. rewrite -HfA. apply fixpoint_unique. rewrite /fixpoint_AA.
    f_equiv=> //. apply fixpoint_unique. by rewrite HfA HfB.
  Qed.
  Lemma fixpoint_B_unique p q : fA p q ≡ p → fB p q ≡ q → q ≡ fixpoint_B.
  Proof. intros. apply fixpoint_unique. by rewrite -fixpoint_A_unique. Qed.
End fixpointAB.

Section fixpointAB_ne.
  Context `{Cofe A, Cofe B, !Inhabited A, !Inhabited B}.
  Context (fA fA' : A → B → A).
  Context (fB fB' : A → B → B).
  Context `{∀ n, Proper (dist_later n ==> dist n ==> dist n) fA}.
  Context `{∀ n, Proper (dist_later n ==> dist n ==> dist n) fA'}.
  Context `{∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB}.
  Context `{∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB'}.

  Lemma fixpoint_A_ne n :
    (∀ x y, fA x y ≡{n}≡ fA' x y) → (∀ x y, fB x y ≡{n}≡ fB' x y) →
    fixpoint_A fA fB ≡{n}≡ fixpoint_A fA' fB'.
  Proof.
    intros HfA HfB. apply fixpoint_ne=> z.
    rewrite /fixpoint_AA /fixpoint_AB HfA. f_equiv. by apply fixpoint_ne.
  Qed.
  Lemma fixpoint_B_ne n :
    (∀ x y, fA x y ≡{n}≡ fA' x y) → (∀ x y, fB x y ≡{n}≡ fB' x y) →
    fixpoint_B fA fB ≡{n}≡ fixpoint_B fA' fB'.
  Proof.
    intros HfA HfB. apply fixpoint_ne=> z. rewrite HfB. f_contractive.
    apply fixpoint_A_ne; auto using dist_S.
  Qed.

  Lemma fixpoint_A_proper :
    (∀ x y, fA x y ≡ fA' x y) → (∀ x y, fB x y ≡ fB' x y) →
    fixpoint_A fA fB ≡ fixpoint_A fA' fB'.
  Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_A_ne. Qed.
  Lemma fixpoint_B_proper :
    (∀ x y, fA x y ≡ fA' x y) → (∀ x y, fB x y ≡ fB' x y) →
    fixpoint_B fA fB ≡ fixpoint_B fA' fB'.
  Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_B_ne. Qed.
End fixpointAB_ne.

(** Non-expansive function space *)
Record ofe_mor (A B : ofeT) : Type := CofeMor {
  ofe_mor_car :> A → B;
  ofe_mor_ne : NonExpansive ofe_mor_car
}.
Arguments CofeMor {_ _} _ {_}.
Add Printing Constructor ofe_mor.
Existing Instance ofe_mor_ne.

Notation "'λne' x .. y , t" :=
  (@CofeMor _ _ (λ x, .. (@CofeMor _ _ (λ y, t) _) ..) _)
  (at level 200, x binder, y binder, right associativity).

Section ofe_mor.
  Context {A B : ofeT}.
  Global Instance ofe_mor_proper (f : ofe_mor A B) : Proper ((≡) ==> (≡)) f.
  Proof. apply ne_proper, ofe_mor_ne. Qed.
  Instance ofe_mor_equiv : Equiv (ofe_mor A B) := λ f g, ∀ x, f x ≡ g x.
  Instance ofe_mor_dist : Dist (ofe_mor A B) := λ n f g, ∀ x, f x ≡{n}≡ g x.
  Definition ofe_mor_ofe_mixin : OfeMixin (ofe_mor A B).
  Proof.
    split.
    - intros f g; split; [intros Hfg n k; apply equiv_dist, Hfg|].
      intros Hfg k; apply equiv_dist=> n; apply Hfg.
    - intros n; split.
      + by intros f x.
      + by intros f g ? x.
      + by intros f g h ?? x; trans (g x).
    - by intros n f g ? x; apply dist_S.
  Qed.
  Canonical Structure ofe_morC := OfeT (ofe_mor A B) ofe_mor_ofe_mixin.

  Program Definition ofe_mor_chain (c : chain ofe_morC)
    (x : A) : chain B := {| chain_car n := c n x |}.
  Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed.
  Program Definition ofe_mor_compl `{Cofe B} : Compl ofe_morC := λ c,
    {| ofe_mor_car x := compl (ofe_mor_chain c x) |}.
  Next Obligation.
    intros ? c n x y Hx. by rewrite (conv_compl n (ofe_mor_chain c x))
      (conv_compl n (ofe_mor_chain c y)) /= Hx.
  Qed.
  Global Program Instance ofe_mor_cofe `{Cofe B} : Cofe ofe_morC :=
    {| compl := ofe_mor_compl |}.
  Next Obligation.
    intros ? n c x; simpl.
    by rewrite (conv_compl n (ofe_mor_chain c x)) /=.
  Qed.

  Global Instance ofe_mor_car_ne :
    NonExpansive2 (@ofe_mor_car A B).
  Proof. intros n f g Hfg x y Hx; rewrite Hx; apply Hfg. Qed.
  Global Instance ofe_mor_car_proper :
    Proper ((≡) ==> (≡) ==> (≡)) (@ofe_mor_car A B) := ne_proper_2 _.
  Lemma ofe_mor_ext (f g : ofe_mor A B) : f ≡ g ↔ ∀ x, f x ≡ g x.
  Proof. done. Qed.
End ofe_mor.

Arguments ofe_morC : clear implicits.
Notation "A -n> B" :=
  (ofe_morC A B) (at level 99, B at level 200, right associativity).
Instance ofe_mor_inhabited {A B : ofeT} `{Inhabited B} :
  Inhabited (A -n> B) := populate (λne _, inhabitant).

(** Identity and composition and constant function *)
Definition cid {A} : A -n> A := CofeMor id.
Instance: Params (@cid) 1.
Definition cconst {A B : ofeT} (x : B) : A -n> B := CofeMor (const x).
Instance: Params (@cconst) 2.

Definition ccompose {A B C}
  (f : B -n> C) (g : A -n> B) : A -n> C := CofeMor (f ∘ g).
Instance: Params (@ccompose) 3.
Infix "◎" := ccompose (at level 40, left associativity).
Global Instance ccompose_ne {A B C} :
  NonExpansive2 (@ccompose A B C).
Proof. intros n ?? Hf g1 g2 Hg x. rewrite /= (Hg x) (Hf (g2 x)) //. Qed.

(* Function space maps *)
Definition ofe_mor_map {A A' B B'} (f : A' -n> A) (g : B -n> B')
  (h : A -n> B) : A' -n> B' := g ◎ h ◎ f.
Instance ofe_mor_map_ne {A A' B B'} n :
  Proper (dist n ==> dist n ==> dist n ==> dist n) (@ofe_mor_map A A' B B').
Proof. intros ??? ??? ???. by repeat apply ccompose_ne. Qed.

Definition ofe_morC_map {A A' B B'} (f : A' -n> A) (g : B -n> B') :
  (A -n> B) -n> (A' -n>  B') := CofeMor (ofe_mor_map f g).
Instance ofe_morC_map_ne {A A' B B'} :
  NonExpansive2 (@ofe_morC_map A A' B B').
Proof.
  intros n f f' Hf g g' Hg ?. rewrite /= /ofe_mor_map.
  by repeat apply ccompose_ne.
Qed.

(** unit *)
Section unit.
  Instance unit_dist : Dist unit := λ _ _ _, True.
  Definition unit_ofe_mixin : OfeMixin unit.
  Proof. by repeat split; try exists 0. Qed.
  Canonical Structure unitC : ofeT := OfeT unit unit_ofe_mixin.

  Global Program Instance unit_cofe : Cofe unitC := { compl x := () }.
  Next Obligation. by repeat split; try exists 0. Qed.

  Global Instance unit_ofe_discrete : OfeDiscrete unitC.
  Proof. done. Qed.
End unit.

(** Product *)
Section product.
  Context {A B : ofeT}.

  Instance prod_dist : Dist (A * B) := λ n, prod_relation (dist n) (dist n).
  Global Instance pair_ne :
    NonExpansive2 (@pair A B) := _.
  Global Instance fst_ne : NonExpansive (@fst A B) := _.
  Global Instance snd_ne : NonExpansive (@snd A B) := _.
  Definition prod_ofe_mixin : OfeMixin (A * B).
  Proof.
    split.
    - intros x y; unfold dist, prod_dist, equiv, prod_equiv, prod_relation.
      rewrite !equiv_dist; naive_solver.
    - apply _.
    - by intros n [x1 y1] [x2 y2] [??]; split; apply dist_S.
  Qed.
  Canonical Structure prodC : ofeT := OfeT (A * B) prod_ofe_mixin.

  Global Program Instance prod_cofe `{Cofe A, Cofe B} : Cofe prodC :=
    { compl c := (compl (chain_map fst c), compl (chain_map snd c)) }.
  Next Obligation.
    intros ?? n c; split. apply (conv_compl n (chain_map fst c)).
    apply (conv_compl n (chain_map snd c)).
  Qed.

  Global Instance prod_discrete (x : A * B) :
    Discrete (x.1) → Discrete (x.2) → Discrete x.
  Proof. by intros ???[??]; split; apply (discrete _). Qed.
  Global Instance prod_ofe_discrete :
    OfeDiscrete A → OfeDiscrete B → OfeDiscrete prodC.
  Proof. intros ?? [??]; apply _. Qed.
End product.

Arguments prodC : clear implicits.
Typeclasses Opaque prod_dist.

Instance prod_map_ne {A A' B B' : ofeT} n :
  Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==>
           dist n ==> dist n) (@prod_map A A' B B').
Proof. by intros f f' Hf g g' Hg ?? [??]; split; [apply Hf|apply Hg]. Qed.
Definition prodC_map {A A' B B'} (f : A -n> A') (g : B -n> B') :
  prodC A B -n> prodC A' B' := CofeMor (prod_map f g).
Instance prodC_map_ne {A A' B B'} :
  NonExpansive2 (@prodC_map A A' B B').
Proof. intros n f f' Hf g g' Hg [??]; split; [apply Hf|apply Hg]. Qed.

(** Functors *)
Structure cFunctor := CFunctor {
  cFunctor_car : ofeT → ofeT → ofeT;
  cFunctor_map {A1 A2 B1 B2} :
    ((A2 -n> A1) * (B1 -n> B2)) → cFunctor_car A1 B1 -n> cFunctor_car A2 B2;
  cFunctor_ne {A1 A2 B1 B2} :
    NonExpansive (@cFunctor_map A1 A2 B1 B2);
  cFunctor_id {A B : ofeT} (x : cFunctor_car A B) :
    cFunctor_map (cid,cid) x ≡ x;
  cFunctor_compose {A1 A2 A3 B1 B2 B3}
      (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
    cFunctor_map (f◎g, g'◎f') x ≡ cFunctor_map (g,g') (cFunctor_map (f,f') x)
}.
Existing Instance cFunctor_ne.
Instance: Params (@cFunctor_map) 5.

Delimit Scope cFunctor_scope with CF.
Bind Scope cFunctor_scope with cFunctor.

Class cFunctorContractive (F : cFunctor) :=
  cFunctor_contractive A1 A2 B1 B2 :> Contractive (@cFunctor_map F A1 A2 B1 B2).

Definition cFunctor_diag (F: cFunctor) (A: ofeT) : ofeT := cFunctor_car F A A.
Coercion cFunctor_diag : cFunctor >-> Funclass.

Program Definition constCF (B : ofeT) : cFunctor :=
  {| cFunctor_car A1 A2 := B; cFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done.
Coercion constCF : ofeT >-> cFunctor.

Instance constCF_contractive B : cFunctorContractive (constCF B).
Proof. rewrite /cFunctorContractive; apply _. Qed.

Program Definition idCF : cFunctor :=
  {| cFunctor_car A1 A2 := A2; cFunctor_map A1 A2 B1 B2 f := f.2 |}.
Solve Obligations with done.
Notation "∙" := idCF : cFunctor_scope.

Program Definition prodCF (F1 F2 : cFunctor) : cFunctor := {|
  cFunctor_car A B := prodC (cFunctor_car F1 A B) (cFunctor_car F2 A B);
  cFunctor_map A1 A2 B1 B2 fg :=
    prodC_map (cFunctor_map F1 fg) (cFunctor_map F2 fg)
|}.
Next Obligation.
  intros ?? A1 A2 B1 B2 n ???; by apply prodC_map_ne; apply cFunctor_ne.
Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !cFunctor_id. Qed.
Next Obligation.
  intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [??]; simpl.
  by rewrite !cFunctor_compose.
Qed.
Notation "F1 * F2" := (prodCF F1%CF F2%CF) : cFunctor_scope.

Instance prodCF_contractive F1 F2 :
  cFunctorContractive F1 → cFunctorContractive F2 →
  cFunctorContractive (prodCF F1 F2).
Proof.
  intros ?? A1 A2 B1 B2 n ???;
    by apply prodC_map_ne; apply cFunctor_contractive.
Qed.

Program Definition ofe_morCF (F1 F2 : cFunctor) : cFunctor := {|
  cFunctor_car A B := cFunctor_car F1 B A -n> cFunctor_car F2 A B;
  cFunctor_map A1 A2 B1 B2 fg :=
    ofe_morC_map (cFunctor_map F1 (fg.2, fg.1)) (cFunctor_map F2 fg)
|}.
Next Obligation.
  intros F1 F2 A1 A2 B1 B2 n [f g] [f' g'] Hfg; simpl in *.
  apply ofe_morC_map_ne; apply cFunctor_ne; split; by apply Hfg.
Qed.
Next Obligation.
  intros F1 F2 A B [f ?] ?; simpl. rewrite /= !cFunctor_id.
  apply (ne_proper f). apply cFunctor_id.
Qed.
Next Obligation.
  intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [h ?] ?; simpl in *.
  rewrite -!cFunctor_compose. do 2 apply (ne_proper _). apply cFunctor_compose.
Qed.
Notation "F1 -n> F2" := (ofe_morCF F1%CF F2%CF) : cFunctor_scope.

Instance ofe_morCF_contractive F1 F2 :
  cFunctorContractive F1 → cFunctorContractive F2 →
  cFunctorContractive (ofe_morCF F1 F2).
Proof.
  intros ?? A1 A2 B1 B2 n [f g] [f' g'] Hfg; simpl in *.
  apply ofe_morC_map_ne; apply cFunctor_contractive; destruct n, Hfg; by split.
Qed.

(** Sum *)
Section sum.
  Context {A B : ofeT}.

  Instance sum_dist : Dist (A + B) := λ n, sum_relation (dist n) (dist n).
  Global Instance inl_ne : NonExpansive (@inl A B) := _.
  Global Instance inr_ne : NonExpansive (@inr A B) := _.
  Global Instance inl_ne_inj : Inj (dist n) (dist n) (@inl A B) := _.
  Global Instance inr_ne_inj : Inj (dist n) (dist n) (@inr A B) := _.

  Definition sum_ofe_mixin : OfeMixin (A + B).
  Proof.
    split.
    - intros x y; split=> Hx.
      + destruct Hx=> n; constructor; by apply equiv_dist.
      + destruct (Hx 0); constructor; apply equiv_dist=> n; by apply (inj _).
    - apply _.
    - destruct 1; constructor; by apply dist_S.
  Qed.
  Canonical Structure sumC : ofeT := OfeT (A + B) sum_ofe_mixin.

  Program Definition inl_chain (c : chain sumC) (a : A) : chain A :=
    {| chain_car n := match c n return _ with inl a' => a' | _ => a end |}.
  Next Obligation. intros c a n i ?; simpl. by destruct (chain_cauchy c n i). Qed.
  Program Definition inr_chain (c : chain sumC) (b : B) : chain B :=
    {| chain_car n := match c n return _ with inr b' => b' | _ => b end |}.
  Next Obligation. intros c b n i ?; simpl. by destruct (chain_cauchy c n i). Qed.

  Definition sum_compl `{Cofe A, Cofe B} : Compl sumC := λ c,
    match c 0 with
    | inl a => inl (compl (inl_chain c a))
    | inr b => inr (compl (inr_chain c b))
    end.
  Global Program Instance sum_cofe `{Cofe A, Cofe B} : Cofe sumC :=
    { compl := sum_compl }.
  Next Obligation.
    intros ?? n c; rewrite /compl /sum_compl.
    feed inversion (chain_cauchy c 0 n); first by auto with lia; constructor.
    - rewrite (conv_compl n (inl_chain c _)) /=. destruct (c n); naive_solver.
    - rewrite (conv_compl n (inr_chain c _)) /=. destruct (c n); naive_solver.
  Qed.

  Global Instance inl_discrete (x : A) : Discrete x → Discrete (inl x).
  Proof. inversion_clear 2; constructor; by apply (discrete _). Qed.
  Global Instance inr_discrete (y : B) : Discrete y → Discrete (inr y).
  Proof. inversion_clear 2; constructor; by apply (discrete _). Qed.
  Global Instance sum_ofe_discrete :
    OfeDiscrete A → OfeDiscrete B → OfeDiscrete sumC.
  Proof. intros ?? [?|?]; apply _. Qed.
End sum.

Arguments sumC : clear implicits.
Typeclasses Opaque sum_dist.

Instance sum_map_ne {A A' B B' : ofeT} n :
  Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==>
           dist n ==> dist n) (@sum_map A A' B B').
Proof.
  intros f f' Hf g g' Hg ??; destruct 1; constructor; [by apply Hf|by apply Hg].
Qed.
Definition sumC_map {A A' B B'} (f : A -n> A') (g : B -n> B') :
  sumC A B -n> sumC A' B' := CofeMor (sum_map f g).
Instance sumC_map_ne {A A' B B'} :
  NonExpansive2 (@sumC_map A A' B B').
Proof. intros n f f' Hf g g' Hg [?|?]; constructor; [apply Hf|apply Hg]. Qed.

Program Definition sumCF (F1 F2 : cFunctor) : cFunctor := {|
  cFunctor_car A B := sumC (cFunctor_car F1 A B) (cFunctor_car F2 A B);
  cFunctor_map A1 A2 B1 B2 fg :=
    sumC_map (cFunctor_map F1 fg) (cFunctor_map F2 fg)
|}.
Next Obligation.
  intros ?? A1 A2 B1 B2 n ???; by apply sumC_map_ne; apply cFunctor_ne.
Qed.
Next Obligation. by intros F1 F2 A B [?|?]; rewrite /= !cFunctor_id. Qed.
Next Obligation.
  intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [?|?]; simpl;
    by rewrite !cFunctor_compose.
Qed.
Notation "F1 + F2" := (sumCF F1%CF F2%CF) : cFunctor_scope.

Instance sumCF_contractive F1 F2 :
  cFunctorContractive F1 → cFunctorContractive F2 →
  cFunctorContractive (sumCF F1 F2).
Proof.
  intros ?? A1 A2 B1 B2 n ???;
    by apply sumC_map_ne; apply cFunctor_contractive.
Qed.

(** Discrete OFE *)
Section discrete_ofe.
  Context `{Equiv A} (Heq : @Equivalence A (≡)).

  Instance discrete_dist : Dist A := λ n x y, x ≡ y.
  Definition discrete_ofe_mixin : OfeMixin A.
  Proof using Type*.
    split.
    - intros x y; split; [done|intros Hn; apply (Hn 0)].
    - done.
    - done.
  Qed.

  Global Instance discrete_ofe_discrete : OfeDiscrete (OfeT A discrete_ofe_mixin).
  Proof. by intros x y. Qed.

  Global Program Instance discrete_cofe : Cofe (OfeT A discrete_ofe_mixin) :=
    { compl c := c 0 }.
  Next Obligation.
    intros n c. rewrite /compl /=;
    symmetry; apply (chain_cauchy c 0 n). omega.
  Qed.
End discrete_ofe.

Notation discreteC A := (OfeT A (discrete_ofe_mixin _)).
Notation leibnizC A := (OfeT A (@discrete_ofe_mixin _ equivL _)).

(** In order to define a discrete CMRA with carrier [A] (in the file [cmra.v])
we need to determine the [Equivalence A] proof that was used to construct the
OFE instance of [A] (note that this proof is not the same as the one we obtain
via [ofe_equivalence]).

We obtain the proof of [Equivalence A] by inferring the canonical OFE mixin
using [ofe_mixin_of A], and then check whether it is indeed a discrete OFE. This
will fail if no OFE, or an OFE other than the discrete OFE, was registered. *)
Notation discrete_ofe_equivalence_of A := ltac:(
  match constr:(ofe_mixin_of A) with
  | discrete_ofe_mixin ?H => exact H
  end) (only parsing).

Instance leibnizC_leibniz A : LeibnizEquiv (leibnizC A).
Proof. by intros x y. Qed.

Canonical Structure boolC := leibnizC bool.
Canonical Structure natC := leibnizC nat.
Canonical Structure positiveC := leibnizC positive.
Canonical Structure NC := leibnizC N.
Canonical Structure ZC := leibnizC Z.

(* Option *)
Section option.
  Context {A : ofeT}.

  Instance option_dist : Dist (option A) := λ n, option_Forall2 (dist n).
  Lemma dist_option_Forall2 n mx my : mx ≡{n}≡ my ↔ option_Forall2 (dist n) mx my.
  Proof. done. Qed.

  Definition option_ofe_mixin : OfeMixin (option A).
  Proof.
    split.
    - intros mx my; split; [by destruct 1; constructor; apply equiv_dist|].
      intros Hxy; destruct (Hxy 0); constructor; apply equiv_dist.
      by intros n; feed inversion (Hxy n).
    - apply _.
    - destruct 1; constructor; by apply dist_S.
  Qed.
  Canonical Structure optionC := OfeT (option A) option_ofe_mixin.

  Program Definition option_chain (c : chain optionC) (x : A) : chain A :=
    {| chain_car n := from_option id x (c n) |}.
  Next Obligation. intros c x n i ?; simpl. by destruct (chain_cauchy c n i). Qed.
  Definition option_compl `{Cofe A} : Compl optionC := λ c,
    match c 0 with Some x => Some (compl (option_chain c x)) | None => None end.
  Global Program Instance option_cofe `{Cofe A} : Cofe optionC :=
    { compl := option_compl }.
  Next Obligation.
    intros ? n c; rewrite /compl /option_compl.
    feed inversion (chain_cauchy c 0 n); auto with lia; [].
    constructor. rewrite (conv_compl n (option_chain c _)) /=.
    destruct (c n); naive_solver.
  Qed.

  Global Instance option_ofe_discrete : OfeDiscrete A → OfeDiscrete optionC.
  Proof. destruct 2; constructor; by apply (discrete _). Qed.

  Global Instance Some_ne : NonExpansive (@Some A).
  Proof. by constructor. Qed.
  Global Instance is_Some_ne n : Proper (dist n ==> iff) (@is_Some A).
  Proof. destruct 1; split; eauto. Qed.
  Global Instance Some_dist_inj : Inj (dist n) (dist n) (@Some A).
  Proof. by inversion_clear 1. Qed.
  Global Instance from_option_ne {B} (R : relation B) (f : A → B) n :
    Proper (dist n ==> R) f → Proper (R ==> dist n ==> R) (from_option f).
  Proof. destruct 3; simpl; auto. Qed.

  Global Instance None_discrete : Discrete (@None A).
  Proof. inversion_clear 1; constructor. Qed.
  Global Instance Some_discrete x : Discrete x → Discrete (Some x).
  Proof. by intros ?; inversion_clear 1; constructor; apply discrete. Qed.

  Lemma dist_None n mx : mx ≡{n}≡ None ↔ mx = None.
  Proof. split; [by inversion_clear 1|by intros ->]. Qed.
  Lemma dist_Some_inv_l n mx my x :
    mx ≡{n}≡ my → mx = Some x → ∃ y, my = Some y ∧ x ≡{n}≡ y.
  Proof. destruct 1; naive_solver. Qed.
  Lemma dist_Some_inv_r n mx my y :
    mx ≡{n}≡ my → my = Some y → ∃ x, mx = Some x ∧ x ≡{n}≡ y.
  Proof. destruct 1; naive_solver. Qed.
  Lemma dist_Some_inv_l' n my x : Some x ≡{n}≡ my → ∃ x', Some x' = my ∧ x ≡{n}≡ x'.
  Proof. intros ?%(dist_Some_inv_l _ _ _ x); naive_solver. Qed.
  Lemma dist_Some_inv_r' n mx y : mx ≡{n}≡ Some y → ∃ y', mx = Some y' ∧ y ≡{n}≡ y'.
  Proof. intros ?%(dist_Some_inv_r _ _ _ y); naive_solver. Qed.
End option.

Typeclasses Opaque option_dist.
Arguments optionC : clear implicits.

Instance option_fmap_ne {A B : ofeT} n:
  Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@fmap option _ A B).
Proof. intros f f' Hf ?? []; constructor; auto. Qed.
Definition optionC_map {A B} (f : A -n> B) : optionC A -n> optionC B :=
  CofeMor (fmap f : optionC A → optionC B).
Instance optionC_map_ne A B : NonExpansive (@optionC_map A B).
Proof. by intros n f f' Hf []; constructor; apply Hf. Qed.

Program Definition optionCF (F : cFunctor) : cFunctor := {|
  cFunctor_car A B := optionC (cFunctor_car F A B);
  cFunctor_map A1 A2 B1 B2 fg := optionC_map (cFunctor_map F fg)
|}.
Next Obligation.
  by intros F A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, cFunctor_ne.
Qed.
Next Obligation.
  intros F A B x. rewrite /= -{2}(option_fmap_id x).
  apply option_fmap_equiv_ext=>y; apply cFunctor_id.
Qed.
Next Obligation.
  intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -option_fmap_compose.
  apply option_fmap_equiv_ext=>y; apply cFunctor_compose.
Qed.

Instance optionCF_contractive F :
  cFunctorContractive F → cFunctorContractive (optionCF F).
Proof.
  by intros ? A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, cFunctor_contractive.
Qed.

(** Later *)
Inductive later (A : Type) : Type := Next { later_car : A }.
Add Printing Constructor later.
Arguments Next {_} _.
Arguments later_car {_} _.
Instance: Params (@Next) 1.

Section later.
  Context {A : ofeT}.
  Instance later_equiv : Equiv (later A) := λ x y, later_car x ≡ later_car y.
  Instance later_dist : Dist (later A) := λ n x y,
    dist_later n (later_car x) (later_car y).
  Definition later_ofe_mixin : OfeMixin (later A).
  Proof.
    split.
    - intros x y; unfold equiv, later_equiv; rewrite !equiv_dist.
      split. intros Hxy [|n]; [done|apply Hxy]. intros Hxy n; apply (Hxy (S n)).
    - split; rewrite /dist /later_dist.
      + by intros [x].
      + by intros [x] [y].
      + by intros [x] [y] [z] ??; trans y.
    - intros [|n] [x] [y] ?; [done|]; rewrite /dist /later_dist; by apply dist_S.
  Qed.
  Canonical Structure laterC : ofeT := OfeT (later A) later_ofe_mixin.

  Program Definition later_chain (c : chain laterC) : chain A :=
    {| chain_car n := later_car (c (S n)) |}.
  Next Obligation. intros c n i ?; apply (chain_cauchy c (S n)); lia. Qed.
  Global Program Instance later_cofe `{Cofe A} : Cofe laterC :=
    { compl c := Next (compl (later_chain c)) }.
  Next Obligation.
    intros ? [|n] c; [done|by apply (conv_compl n (later_chain c))].
  Qed.

  Global Instance Next_contractive : Contractive (@Next A).
  Proof. by intros [|n] x y. Qed.
  Global Instance Later_inj n : Inj (dist n) (dist (S n)) (@Next A).
  Proof. by intros x y. Qed.

  Instance later_car_anti_contractive n :
    Proper (dist n ==> dist_later n) later_car.
  Proof. move=> [x] [y] /= Hxy. done. Qed.

  (* f is contractive iff it can factor into `Next` and a non-expansive function. *)
  Lemma contractive_alt {B : ofeT} (f : A → B) :
    Contractive f ↔ ∃ g : later A → B, NonExpansive g ∧ ∀ x, f x ≡ g (Next x).
  Proof.
    split.
    - intros Hf. exists (f ∘ later_car); split=> // n x y ?. by f_equiv.
    - intros (g&Hg&Hf) n x y Hxy. rewrite !Hf. by apply Hg.
  Qed.
End later.

Arguments laterC : clear implicits.

Definition later_map {A B} (f : A → B) (x : later A) : later B :=
  Next (f (later_car x)).
Instance later_map_ne {A B : ofeT} (f : A → B) n :
  Proper (dist (pred n) ==> dist (pred n)) f →
  Proper (dist n ==> dist n) (later_map f) | 0.
Proof. destruct n as [|n]; intros Hf [x] [y] ?; do 2 red; simpl; auto. Qed.
Lemma later_map_id {A} (x : later A) : later_map id x = x.
Proof. by destruct x. Qed.
Lemma later_map_compose {A B C} (f : A → B) (g : B → C) (x : later A) :
  later_map (g ∘ f) x = later_map g (later_map f x).
Proof. by destruct x. Qed.
Lemma later_map_ext {A B : ofeT} (f g : A → B) x :
  (∀ x, f x ≡ g x) → later_map f x ≡ later_map g x.
Proof. destruct x; intros Hf; apply Hf. Qed.
Definition laterC_map {A B} (f : A -n> B) : laterC A -n> laterC B :=
  CofeMor (later_map f).
Instance laterC_map_contractive (A B : ofeT) : Contractive (@laterC_map A B).
Proof. intros [|n] f g Hf n'; [done|]; apply Hf; lia. Qed.

Program Definition laterCF (F : cFunctor) : cFunctor := {|
  cFunctor_car A B := laterC (cFunctor_car F A B);
  cFunctor_map A1 A2 B1 B2 fg := laterC_map (cFunctor_map F fg)
|}.
Next Obligation.
  intros F A1 A2 B1 B2 n fg fg' ?.
  by apply (contractive_ne laterC_map), cFunctor_ne.
Qed.
Next Obligation.
  intros F A B x; simpl. rewrite -{2}(later_map_id x).
  apply later_map_ext=>y. by rewrite cFunctor_id.
Qed.
Next Obligation.
  intros F A1 A2 A3 B1 B2 B3 f g f' g' x; simpl. rewrite -later_map_compose.
  apply later_map_ext=>y; apply cFunctor_compose.
Qed.
Notation "▶ F"  := (laterCF F%CF) (at level 20, right associativity) : cFunctor_scope.

Instance laterCF_contractive F : cFunctorContractive (laterCF F).
Proof.
  intros A1 A2 B1 B2 n fg fg' Hfg. apply laterC_map_contractive.
  destruct n as [|n]; simpl in *; first done. apply cFunctor_ne, Hfg.
Qed.

(* Dependently-typed functions over a discrete domain *)
(* We make [ofe_fun] a definition so that we can register it as a canonical
structure. *)
Definition ofe_fun {A} (B : A → ofeT) := ∀ x : A, B x.

Section ofe_fun.
  Context {A : Type} {B : A → ofeT}.
  Implicit Types f g : ofe_fun B.

  Instance ofe_fun_equiv : Equiv (ofe_fun B) := λ f g, ∀ x, f x ≡ g x.
  Instance ofe_fun_dist : Dist (ofe_fun B) := λ n f g, ∀ x, f x ≡{n}≡ g x.
  Definition ofe_fun_ofe_mixin : OfeMixin (ofe_fun B).
  Proof.
    split.
    - intros f g; split; [intros Hfg n k; apply equiv_dist, Hfg|].
      intros Hfg k; apply equiv_dist=> n; apply Hfg.
    - intros n; split.
      + by intros f x.
      + by intros f g ? x.
      + by intros f g h ?? x; trans (g x).
    - by intros n f g ? x; apply dist_S.
  Qed.
  Canonical Structure ofe_funC := OfeT (ofe_fun B) ofe_fun_ofe_mixin.

  Program Definition ofe_fun_chain `(c : chain ofe_funC)
    (x : A) : chain (B x) := {| chain_car n := c n x |}.
  Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed.
  Global Program Instance ofe_fun_cofe `{∀ x, Cofe (B x)} : Cofe ofe_funC :=
    { compl c x := compl (ofe_fun_chain c x) }.
  Next Obligation. intros ? n c x. apply (conv_compl n (ofe_fun_chain c x)). Qed.

  Global Instance ofe_fun_inhabited `{∀ x, Inhabited (B x)} : Inhabited ofe_funC :=
    populate (λ _, inhabitant).
  Global Instance ofe_fun_lookup_discrete `{EqDecision A} f x :
    Discrete f → Discrete (f x).
  Proof.
    intros Hf y ?.
    set (g x' := if decide (x = x') is left H then eq_rect _ B y _ H else f x').
    trans (g x).
    { apply Hf=> x'. unfold g. by destruct (decide _) as [[]|]. }
    unfold g. destruct (decide _) as [Hx|]; last done.
    by rewrite (proof_irrel Hx eq_refl).
  Qed.
End ofe_fun.

Arguments ofe_funC {_} _.
Notation "A -c> B" :=
  (@ofe_funC A (λ _, B)) (at level 99, B at level 200, right associativity).

Definition ofe_fun_map {A} {B1 B2 : A → ofeT} (f : ∀ x, B1 x → B2 x)
  (g : ofe_fun B1) : ofe_fun B2 := λ x, f _ (g x).

Lemma ofe_fun_map_ext {A} {B1 B2 : A → ofeT} (f1 f2 : ∀ x, B1 x → B2 x)
  (g : ofe_fun B1) :
  (∀ x, f1 x (g x) ≡ f2 x (g x)) → ofe_fun_map f1 g ≡ ofe_fun_map f2 g.
Proof. done. Qed.
Lemma ofe_fun_map_id {A} {B : A → ofeT} (g : ofe_fun B) :
  ofe_fun_map (λ _, id) g = g.
Proof. done. Qed.
Lemma ofe_fun_map_compose {A} {B1 B2 B3 : A → ofeT}
    (f1 : ∀ x, B1 x → B2 x) (f2 : ∀ x, B2 x → B3 x) (g : ofe_fun B1) :
  ofe_fun_map (λ x, f2 x ∘ f1 x) g = ofe_fun_map f2 (ofe_fun_map f1 g).
Proof. done. Qed.

Instance ofe_fun_map_ne {A} {B1 B2 : A → ofeT} (f : ∀ x, B1 x → B2 x) n :
  (∀ x, Proper (dist n ==> dist n) (f x)) →
  Proper (dist n ==> dist n) (ofe_fun_map f).
Proof. by intros ? y1 y2 Hy x; rewrite /ofe_fun_map (Hy x). Qed.

Definition ofe_funC_map {A} {B1 B2 : A → ofeT} (f : ofe_fun (λ x, B1 x -n> B2 x)) :
  ofe_funC B1 -n> ofe_funC B2 := CofeMor (ofe_fun_map f).
Instance ofe_funC_map_ne {A} {B1 B2 : A → ofeT} :
  NonExpansive (@ofe_funC_map A B1 B2).
Proof. intros n f1 f2 Hf g x; apply Hf. Qed.

Program Definition ofe_funCF {C} (F : C → cFunctor) : cFunctor := {|
  cFunctor_car A B := ofe_funC (λ c, cFunctor_car (F c) A B);
  cFunctor_map A1 A2 B1 B2 fg := ofe_funC_map (λ c, cFunctor_map (F c) fg)
|}.
Next Obligation.
  intros C F A1 A2 B1 B2 n ?? g. by apply ofe_funC_map_ne=>?; apply cFunctor_ne.
Qed.
Next Obligation.
  intros C F A B g; simpl. rewrite -{2}(ofe_fun_map_id g).
  apply ofe_fun_map_ext=> y; apply cFunctor_id.
Qed.
Next Obligation.
  intros C F A1 A2 A3 B1 B2 B3 f1 f2 f1' f2' g. rewrite /= -ofe_fun_map_compose.
  apply ofe_fun_map_ext=>y; apply cFunctor_compose.
Qed.

Notation "T -c> F" := (@ofe_funCF T%type (λ _, F%CF)) : cFunctor_scope.

Instance ofe_funCF_contractive {C} (F : C → cFunctor) :
  (∀ c, cFunctorContractive (F c)) → cFunctorContractive (ofe_funCF F).
Proof.
  intros ? A1 A2 B1 B2 n ?? g.
  by apply ofe_funC_map_ne=>c; apply cFunctor_contractive.
Qed.

(** Constructing isomorphic OFEs *)
Lemma iso_ofe_mixin {A : ofeT} `{Equiv B, Dist B} (g : B → A)
  (g_equiv : ∀ y1 y2, y1 ≡ y2 ↔ g y1 ≡ g y2)
  (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) : OfeMixin B.
Proof.
  split.
  - intros y1 y2. rewrite g_equiv. setoid_rewrite g_dist. apply equiv_dist.
  - split.
    + intros y. by apply g_dist.
    + intros y1 y2. by rewrite !g_dist.
    + intros y1 y2 y3. rewrite !g_dist. intros ??; etrans; eauto.
  - intros n y1 y2. rewrite !g_dist. apply dist_S.
Qed.

Section iso_cofe_subtype.
  Context {A B : ofeT} `{Cofe A} (P : A → Prop) (f : ∀ x, P x → B) (g : B → A).
  Context (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2).
  Let Hgne : NonExpansive g.
  Proof. intros n y1 y2. apply g_dist. Qed.
  Existing Instance Hgne.
  Context (gf : ∀ x Hx, g (f x Hx) ≡ x).
  Context (Hlimit : ∀ c : chain B, P (compl (chain_map g c))).
  Program Definition iso_cofe_subtype : Cofe B :=
    {| compl c := f (compl (chain_map g c)) _ |}.
  Next Obligation. apply Hlimit. Qed.
  Next Obligation.
    intros n c; simpl. apply g_dist. by rewrite gf conv_compl.
  Qed.
End iso_cofe_subtype.

Lemma iso_cofe_subtype' {A B : ofeT} `{Cofe A}
  (P : A → Prop) (f : ∀ x, P x → B) (g : B → A)
  (Pg : ∀ y, P (g y))
  (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2)
  (gf : ∀ x Hx, g (f x Hx) ≡ x)
  (Hlimit : LimitPreserving P) : Cofe B.
Proof. apply: (iso_cofe_subtype P f g)=> // c. apply Hlimit=> ?; apply Pg. Qed.

Definition iso_cofe {A B : ofeT} `{Cofe A} (f : A → B) (g : B → A)
  (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2)
  (gf : ∀ x, g (f x) ≡ x) : Cofe B.
Proof. by apply (iso_cofe_subtype (λ _, True) (λ x _, f x) g). Qed.

(** Sigma *)
Section sigma.
  Context {A : ofeT} {P : A → Prop}.
  Implicit Types x : sig P.

  (* TODO: Find a better place for this Equiv instance. It also
     should not depend on A being an OFE. *)
  Instance sig_equiv : Equiv (sig P) := λ x1 x2, `x1 ≡ `x2.
  Instance sig_dist : Dist (sig P) := λ n x1 x2, `x1 ≡{n}≡ `x2.

  Definition sig_equiv_alt x y : x ≡ y ↔ `x ≡ `y := reflexivity _.
  Definition sig_dist_alt n x y : x ≡{n}≡ y ↔ `x ≡{n}≡ `y := reflexivity _.

  Lemma exist_ne n a1 a2 (H1 : P a1) (H2 : P a2) :
    a1 ≡{n}≡ a2 → a1 ↾ H1 ≡{n}≡ a2 ↾ H2.
  Proof. done. Qed.

  Global Instance proj1_sig_ne : NonExpansive (@proj1_sig _ P).
  Proof. by intros n [a Ha] [b Hb] ?. Qed.
  Definition sig_ofe_mixin : OfeMixin (sig P).
  Proof. by apply (iso_ofe_mixin proj1_sig). Qed.
  Canonical Structure sigC : ofeT := OfeT (sig P) sig_ofe_mixin.

  Global Instance sig_cofe `{Cofe A, !LimitPreserving P} : Cofe sigC.
  Proof. apply (iso_cofe_subtype' P (exist P) proj1_sig)=> //. by intros []. Qed.

  Global Instance sig_discrete (x : sig P) :  Discrete (`x) → Discrete x.
  Proof. intros ? y. rewrite sig_dist_alt sig_equiv_alt. apply (discrete _). Qed.
  Global Instance sig_ofe_discrete : OfeDiscrete A → OfeDiscrete sigC.
  Proof. intros ??. apply _. Qed.
End sigma.

Arguments sigC {_} _.


Require Import VST.floyd.proofauto.
Require Import Iterative.floatlib.
From Iterative.sparse Require Import sparse sparse_model.
Require Import vcfloat.VCFloat.
Require Import vcfloat.FPCompCert.
Require Import VSTlib.spec_math.

#[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

Set Bullet Behavior "Strict Subproofs".

Open Scope logic.

Definition t_crs := Tstruct _crs_matrix noattr.

Definition crs_rep (sh: share) (mval: matrix Tdouble) (p: val) : mpred :=
  EX v: val, EX ci: val, EX rp: val,
  EX cols, EX vals: list (ftype Tdouble), EX col_ind: list Z, EX row_ptr: list Z,
  !! crs_rep_aux mval cols vals col_ind row_ptr &&
  data_at sh t_crs (v,(ci,(rp,(Vint (Int.repr (matrix_rows mval)), Vint (Int.repr cols))))) p *
  data_at sh (tarray tdouble (Zlength col_ind)) (map Vfloat vals) v *
  data_at sh (tarray tuint (Zlength col_ind)) (map Vint (map Int.repr col_ind)) ci *
  data_at sh (tarray tuint (matrix_rows mval + 1)) (map Vint (map Int.repr row_ptr)) rp.

Definition crs_matrix_rows_spec :=
 DECLARE _crs_matrix_rows
 WITH sh: share, m: val, mval: matrix Tdouble
 PRE [ tptr t_crs ]
    PROP (readable_share sh; matrix_rows mval < Int.max_unsigned)
    PARAMS (m)
    SEP (crs_rep sh mval m)
 POST [ tuint ]
    PROP ()
    RETURN (Vint (Int.repr (matrix_rows mval)))
    SEP (crs_rep sh mval m).

Definition crs_row_vector_multiply_spec :=
 DECLARE _crs_row_vector_multiply
 WITH sh1: share, sh2: share, sh3: share,
      m: val, mval: matrix Tdouble, v: val, vval: vector Tdouble, i: Z
 PRE [ tptr t_crs, tptr tdouble, tuint ]
    PROP(readable_share sh1; readable_share sh2; writable_share sh3;
             matrix_cols mval (Zlength vval);
             matrix_rows mval < Int.max_unsigned;
             Zlength vval < Int.max_unsigned;
             0 <= i < matrix_rows mval;
             Forall finite vval;
             Forall (Forall finite) mval)
    PARAMS(m; v; Vint (Int.repr i))
    SEP (crs_rep sh1 mval m;
         data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v)
 POST [ tdouble ]
   EX s: ftype Tdouble,
    PROP(feq s (dotprod (Znth i mval) vval))
    RETURN(Vfloat s)
    SEP (crs_rep sh1 mval m;
          data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v).

Definition crs_matrix_vector_multiply_byrows_spec :=
 DECLARE _crs_matrix_vector_multiply_byrows
 WITH sh1: share, sh2: share, sh3: share,
      m: val, mval: matrix Tdouble, v: val, vval: vector Tdouble, p: val
 PRE [ tptr t_crs, tptr tdouble, tptr tdouble ]
    PROP(readable_share sh1; readable_share sh2; writable_share sh3;
             matrix_cols mval (Zlength vval);
             matrix_rows mval < Int.max_unsigned;
             Zlength vval < Int.max_unsigned;
             Forall finite vval;
             Forall (Forall finite) mval)
    PARAMS(m; v; p)
    SEP (crs_rep sh1 mval m;
         data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v;
         data_at_ sh3 (tarray tdouble (matrix_rows mval)) p)
 POST [ tvoid ]
   EX result: vector Tdouble,
    PROP(Forall2 feq result (matrix_vector_mult mval vval))
    RETURN()
    SEP (crs_rep sh1 mval m;
          data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v;
          data_at sh3 (tarray tdouble (matrix_rows mval))
             (map Vfloat result) p).

Definition crs_matrix_vector_multiply_spec :=
 DECLARE _crs_matrix_vector_multiply
 WITH sh1: share, sh2: share, sh3: share,
      m: val, mval: matrix Tdouble, v: val, vval: vector Tdouble, p: val
 PRE [ tptr t_crs, tptr tdouble, tptr tdouble ]
    PROP(readable_share sh1; readable_share sh2; writable_share sh3;
             matrix_cols mval (Zlength vval);
             matrix_rows mval < Int.max_unsigned;
             Zlength vval < Int.max_unsigned;
             Forall finite vval;
             Forall (Forall finite) mval)
    PARAMS(m; v; p)
    SEP (crs_rep sh1 mval m;
         data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v;
         data_at_ sh3 (tarray tdouble (matrix_rows mval)) p)
 POST [ tvoid ]
   EX result: vector Tdouble,
    PROP(Forall2 feq result (matrix_vector_mult mval vval))
    RETURN()
    SEP (crs_rep sh1 mval m;
          data_at sh2 (tarray tdouble (Zlength vval)) (map Vfloat vval) v;
          data_at sh3 (tarray tdouble (matrix_rows mval))
             (map Vfloat result) p).

Definition SparseASI : funspecs := [
   crs_matrix_rows_spec;
   crs_row_vector_multiply_spec;
   crs_matrix_vector_multiply_byrows_spec;
   crs_matrix_vector_multiply_spec ].


Require Import GraphBasics.Graphs.
Require Import Coq.Logic.Classical_Prop.
Require Import Verdi.Verdi.

Require Export StructTact.Fin.

Require Import ExtrOcamlBasic.
Require Import ExtrOcamlNatInt.

Require Import Verdi.ExtrOcamlBasicExt.
Require Import Verdi.ExtrOcamlList.

Require Import FunInd.

Load CDAInterface.

Section ConnectedChecker.

(* All components are already indexed by natural numbers via GraphBasics. *)
Definition Component_Index := nat.
(* A distance for how long a message has traveled to the recipient. *)
Definition Distance := nat.

(* This is the content of a message. It consists of:
  - var
  - local leader for the var
  - distance from where it was sent (the temporary local leader)
  - last sender (parent), so that the receiving node can make a parent towards the temporary local leader
*)
Inductive Msg := leader : (Var * Component_Index * Distance * Name) -> Msg.

Definition Msg_eq_dec : forall x y : Msg, {x = y} + {x <> y}.
Proof.
Admitted.
(* Proof.
  intros x y.
  decide equality.
  destruct p.
  destruct p0.
  assert (H1: {n = n0} + {n <> n0}).
  apply Nat.eq_dec.
  destruct H1.
  rewrite e.
  assert (H2: {v0 = v1} + {v0 <> v1}).
  (* This worked because Var was nat before *)
  unfold Nat in *.
  apply Nat.eq_dec.
  destruct H2.
  left.
  rewrite e0.
  reflexivity.
  right.
  intuition.
  inversion H.
  intuition.
  right.
  intuition.
  inversion H.
  intuition.
Qed.
 *)
Record Data := mkData{
  checkerknowledge: Checkerknowledge;
  checkerinput : Checkerinput;
  leaders : list Msg
}.

(* all components first are their own leader for all fact_vars *)
Fixpoint init_leader_list (n:Name) (c: Certificate) :=
  match c with
  | [] => []
  | hd :: tl => (leader (assignment_var hd, component_index (name_component n), 0, n)) :: init_leader_list n tl
  end.

(* initialization of the network *)
Definition init_Data (me: Name) :=
  mkData (init_Checkerknowledge me) (init_Checkerinput me) (init_leader_list me (certificate (init_Checkerinput me))).

Definition set_leaders (d : Data) (new_leaders : list Msg) := mkData (checkerknowledge d) (checkerinput d) new_leaders.

Fixpoint sendlist (neighbors: list Component) (new_l: Msg): list (Name * Msg) :=
  match neighbors with
    | nil => []
    | hd :: tl => (Checker hd, new_l) :: (sendlist tl new_l)
  end.

(* The component sends itself as the leader for all its fact_vars to all its neighbours *)
Fixpoint initial_send_list (me : Name) (var_l : list Var) neighbours: list (Name * Msg) :=
  match var_l with
    | [] => []
    | hd :: tl => sendlist neighbours (leader (hd, component_index (name_component me), 0, me)) ++ initial_send_list me tl neighbours
  end.

(* This input starts a checker *)
Inductive Input := alg_terminated : Input.

(* kann weggelassen werden? *)
Definition Output := Msg.

(* Sendet zu Beginn die Initial-Liste an alle Nachbarn *)
Definition InputHandler (me : Name) (c : Input) (state: Data) :
            (list Output) * Data * list (Name * Msg) :=
	match me  with
    | Checker x => let myneighbours := (neighbors v a g x) in
      ([] , (mkData (checkerknowledge state) (checkerinput state) (leaders state)), initial_send_list me (var_l (checkerknowledge state)) myneighbours)
    end.

Fixpoint find_leader (k : Var) (leaders : list Msg) : option nat :=
  match leaders with
  | [] => None
  | leader (var, ind, dis, par) :: tl => if var_beq k var
                            then Some ind
                            else find_leader k tl
  end.

Definition get_leader_index k (leaders: list Msg) : nat :=
  match (find_leader k leaders) with
  | Some x => x
  | None => 0
  end.

Fixpoint set_leader var n d p (ls: list Msg) : list Msg :=
  match ls with
  | [] => [leader (var, n, d, p)]
  | leader (k, ind, dis, par) :: tl => if var_beq k var
                                 then leader (k, n, dis, par) :: tl
                                 else set_leader var n d p tl
  end.

Notation "a =/= b" := (beq_nat (Some a) (Some b)) (at level 70).
Notation "a == b" := (beq_nat a b) (at level 70).

Lemma beq_false_nat : forall n m : nat,
  n <> m -> (n == m) = false.
Proof.
  induction n; induction m; intros.
  intuition.
  intuition.
  intuition.
  simpl.
  intuition.
Qed.

Lemma set_leader_sets_leader: forall var n (ls: list Msg) d p,
    n = get_leader_index var (set_leader var n d p ls).
Proof.
  intros var n ls d p.
  induction ls.
    simpl.
    unfold get_leader_index.
    simpl.
    rewrite var_eq_refl.
    reflexivity.

    destruct a0.
    destruct p0.
    destruct p0.
    destruct p0.
    assert (v0 = var \/ v0 <> var).
    apply classic.
    destruct H.

    rewrite H.
    simpl.
    rewrite var_eq_refl.
    unfold get_leader_index.
    simpl.
    rewrite var_eq_refl.
    reflexivity.

    assert (var_beq v0 var = false).
    unfold var_beq.
    destruct var_eq_dec.
    intuition.
    reflexivity.
    simpl.
    rewrite H0.
    apply IHls.
Qed.

Fixpoint varList_has_varb (vl : list Var) (v : Var) : bool :=
  match vl with
  | nil => false
  | hd :: tl => var_beq hd v && varList_has_varb tl v
  end.

Definition varList_has_var (vl : list Var) (v : Var) : Prop :=
  varList_has_varb vl v = true.

Definition NetHandler (me : Name) (src: Name) (le : Msg) (state: Data) :
    (list Output) * Data * list (Name * Msg) :=
    match le with
      | leader (var, n, d, p)  => if (varList_has_varb (var_l (checkerknowledge state)) var) && Nat.ltb (get_leader_index var (leaders state)) n
        then ([], set_leaders state (set_leader var n d p (leaders state)), sendlist (neighbor_l (checkerknowledge state)) (leader (var, n, d+1, me)))
          else ([], state, [])
    end.

Definition isa_aVarComponent (aVar : Var) (c : Component) : Prop :=
  varList_has_var (init_var_l (component_name c)) aVar.

Inductive aVarTree : Var -> V_set -> A_set -> Set :=
  | CC_isolated : forall (aVar : Var) (x : Component), isa_aVarComponent aVar x -> v x -> aVarTree aVar (V_single x) A_empty
  | CC_leaf: forall (aVar : Var) (vT : V_set) (aT : A_set) x y,
      vT x -> ~ vT y -> v y -> a (A_ends x y) -> isa_aVarComponent aVar y -> aVarTree aVar vT aT -> aVarTree aVar (V_union (V_single y) vT) (A_union (E_set x y) aT)
  | CC_eq: forall aVar vT vT' aT aT',
    vT = vT' -> aT = aT' -> aVarTree aVar vT aT -> aVarTree aVar vT' aT'.

Lemma aVarTree_is_Connected : forall (aVar : Var) (vT: V_set) (aT: A_set),
  aVarTree aVar vT aT -> Connected vT aT.
Proof.
  intros aVar vT aT cc.
  induction cc.
  + apply C_isolated.
  + apply C_leaf.
    apply IHcc.
    apply v0.
    apply n.
  + rewrite <- e in *.
    rewrite <- e0 in *.
    apply IHcc.
Qed.

Definition max_aVarVset (aVar : Var) (vT : V_set) : Prop :=
  (forall c1 c2 : Component, (vT c1 /\ a (A_ends c1 c2) /\ isa_aVarComponent aVar c2) -> vT c2).

Lemma only_aVars_inaVarTree: forall (vT : V_set) (aT : A_set) (aVar : Var) (cc : aVarTree aVar vT aT) (x : Component),
  vT x -> isa_aVarComponent aVar x.
Proof.
  intros vT aT aVar cc x vTx.
  induction cc.
  + inversion vTx.
    rewrite H in *.
    apply i.
  + inversion vTx.
    inversion H.
    rewrite <- H1 ; auto.
    apply (IHcc H).
  + rewrite <- e in vTx.
    apply (IHcc vTx).
Qed.

Lemma only_vs_inaVarTree: forall (vT : V_set) (aT : A_set) (aVar : Var) (cc : aVarTree aVar vT aT) (x : Component),
  vT x -> v x.
Proof.
  intros vT aT aVar cc x H.
  induction cc.
  + inversion H.
    rewrite <- H0.
    apply v0.
  + inversion H.
    inversion H0.
    rewrite <- H2.
    apply v1.
    apply IHcc.
    apply H0.
  + rewrite <- e in *.
    apply (IHcc H).
Qed.

Lemma only_as_inaVarTree: forall (vT : V_set) (aT : A_set) (aVar : Var) (cc : aVarTree aVar vT aT) (x : Arc),
  aT x -> a x.
Proof.
  intros vT aT aVar cc x H.
  induction cc.
  + inversion H.
  + inversion H.
    inversion H0.
    apply a0.
    assert (Graph v a).
    apply (Connected_Isa_Graph v a g).
    apply (G_non_directed v a H3 x0 y a0).
    apply IHcc.
    apply H0.
  + rewrite <- e0 in *.
    apply (IHcc H).
Qed.

Lemma Walk_in_bigger_conn : forall (v vB : V_set) (a aB : A_set) (v1 v2 : Component) (vl : V_list) (el : E_list),
  V_included v vB -> A_included a aB -> Walk v a v1 v2 vl el -> Walk vB aB v1 v2 vl el.
Proof.
  intros v vB a aB v1 v2 vl el vI aI w.
  induction w.
  + apply W_null.
    unfold V_included in vI.
    unfold Included in vI.
    apply (vI x v0).
  + apply W_step.
    apply IHw.
    unfold V_included in vI.
    unfold Included in vI.
    apply (vI x v0).
    unfold A_included in aI.
    unfold Included in aI.
    apply (aI (A_ends x y) a0).
Qed.

Definition aVarWalk (aVar : Var) (c1 c2 : Component) (vl : V_list) (el : E_list) (w : Walk v a c1 c2 vl el) :=
  forall (c : Component), In c (c1 :: vl) -> isa_aVarComponent aVar c.

Lemma W_endx_inv :
 forall (v : V_set) (a : A_set) (x y : Vertex) (vl : V_list) (el : E_list), Walk v a x y vl el -> v x.
Proof.
        intros v a x y vl el w; elim w; auto.
Qed.

Lemma W_endy_inv :
 forall (v : V_set) (a : A_set) (x y : Vertex) (vl : V_list) (el : E_list), Walk v a x y vl el -> v y.
Proof.
        intros v a x y vl el w; elim w; auto.
Qed.

Lemma W_invl_inv :
 forall (v : V_set) (a : A_set) (x y : Vertex) (vl : V_list) (el : E_list),
 Walk v a x y vl el -> forall z : Vertex, In z vl -> v z.
Proof.
        intros v a x y vl el w; elim w; intros.
        inversion H.

        inversion H0.
        rewrite <- H1; apply (W_endx_inv _ _ _ _ _ _ w0).

        auto.
Qed.

Lemma W_iny_vl :
 forall (v : V_set) (a : A_set) (x y : Vertex) (vl : V_list) (el : E_list),
 Walk v a x y vl el -> vl <> V_nil -> In y vl.
Proof.
        intros v a x y vl el w; elim w; intros.
        absurd (V_nil = V_nil); auto.

        inversion w0.
        simpl; auto.

        rewrite H6; simpl; right.
        apply H; rewrite <- H6; discriminate.
Qed.

Lemma aVarTrees_are_aVarWalks: forall (aVar : Var) (vT : V_set) (aT : A_set) (cc : aVarTree aVar vT aT),
 (forall (v1 v2 : Component), vT v1 -> vT v2 -> {vl : V_list & {el : E_list & {w : Walk v a v1 v2 vl el & aVarWalk aVar v1 v2 vl el w}}}).
Proof.
  intros aVar vT aT cc v1 v2 vTv1 vTv2.
  assert (cc' := cc).
  apply aVarTree_is_Connected in cc.
  apply (Connected_path) with (x := v1) (y := v2) in cc.
  destruct cc.
  destruct s.
  exists x.
  exists x0.
  apply Path_isa_trail in p.
  apply Trail_isa_walk in p.
  assert (p' := p).
  apply (Walk_in_bigger_conn vT v aT a v1 v2 x x0) in p.
  exists p.
  unfold aVarWalk.
  intros.
  inversion H.
  rewrite <- H0.
  apply W_endx_inv in p'.
  apply (only_aVars_inaVarTree vT aT aVar cc' v1 p').
  assert (vT c).
  apply (W_invl_inv vT aT v1 v2 x x0 p' c H0).
  apply (only_aVars_inaVarTree vT aT aVar cc' c H1).
  unfold V_included. unfold Included.
  intros.
  apply (only_vs_inaVarTree vT aT aVar cc') in H.
  apply H.
  unfold A_included. unfold Included.
  intros.
  apply (only_as_inaVarTree vT aT aVar cc') in H.
  apply H.
  apply vTv1.
  apply vTv2.
Qed.

Lemma aVarWalk_in_aVarTree: forall (aVar : Var) (vT : V_set) (aT : A_set) (cc : aVarTree aVar vT aT)
                       (v1 v2: Component) (vl : V_list) (el : E_list) (w : Walk v a v1 v2 vl el),
  max_aVarVset aVar vT -> vT v1 -> aVarWalk aVar v1 v2 vl el w -> vT v2.
Proof.
  intros aVar vT aT cc v1 v2 vl el w CC vTv1 aWalk.
  induction w ; unfold max_aVarVset in CC.
  + apply vTv1.
  + apply IHw.
    unfold aVarWalk in aWalk.
    specialize (aWalk y).
    simpl in aWalk.
    intuition.
    apply (CC x y).
    auto.
    unfold aVarWalk in *.
    intros.
    apply aWalk.
    inversion H.
    simpl.
    right. left. auto.
    simpl. right. right. auto.
Qed.

(* wenn sich zwei CCs in c \u00fcberschneiden, so sind \u00fcber c aVar-Walks m\u00f6glich und daher CC1 = CC2 *)
Lemma two_aVarTrees_same_v: forall (aVar : Var) (v1 v2: V_set) (a1 a2: A_set) (c1 : aVarTree aVar v1 a1) (c2: aVarTree aVar v2 a2),
  max_aVarVset aVar v1 -> max_aVarVset aVar v2 -> {c : Component & (v1 c /\ v2 c)} ->
    (forall x : Component, v1 x -> v2 x).
Proof.
  intros aVar v1 v2 a1 a2 c1 c2 acc1 acc2 same.
  destruct same.
  destruct a0. intros.
  apply (aVarTrees_are_aVarWalks aVar v1 a1 c1 x x0) in H1.
  destruct H1.
  destruct s.
  destruct s.
  apply (aVarWalk_in_aVarTree aVar v2 a2 c2 x x0 x1 x2 x3 acc2 H0 a0).
  apply H.
Qed.

Lemma aVarTree_a_means_v: forall (aVar : Var) (vT : V_set) (aT : A_set) (cc : aVarTree aVar vT aT)
                       (v1 v2: Component),
  aT (A_ends v1 v2) -> (vT v1 /\ vT v2).
Proof.
  intros aVar vT aT cc v1 v2 acca.
  induction cc.
  + inversion acca.
  + inversion acca.
    - inversion H.
      rewrite <- H2 in *.
      rewrite <- H3 in *.
      split.
      apply In_right. apply v0.
      apply In_left.
      apply In_single.
      split.
      apply In_left ; apply In_single.
      rewrite <- H2 in *.
      rewrite <- H3 in *.
      apply In_right. apply v0.
    - apply IHcc in H.
      destruct H.
      split ; apply In_right.
      apply H.
      apply H1.
  + rewrite <- e in *.
    rewrite <- e0 in *.
    apply (IHcc acca).
Qed.

Lemma aVarTree_a_means_a: forall (aVar : Var) (vT : V_set) (aT : A_set) (cc : aVarTree aVar vT aT)
                       (ar: Arc),
  aT ar -> a ar.
Proof.
  intros aVar vT aT cc ar acca.
  induction cc.
  + inversion acca.
  + inversion acca.
    inversion H.
    apply a0.
    assert (Graph v a).
    apply (Connected_Isa_Graph v a g).
    apply (G_non_directed v a H2 x y a0).
    apply (IHcc H).
  + rewrite <- e0 in *.
    apply (IHcc acca).
Qed.

Lemma two_aVarTrees_same: forall (aVar : Var) (v1 v2: V_set) (a1 a2: A_set) (c1 : aVarTree aVar v1 a1) (c2: aVarTree aVar v2 a2),
  max_aVarVset aVar v1 -> max_aVarVset aVar v2 -> {c : Component & (v1 c /\ v2 c)} ->
    (v1 = v2).
Proof.
  intros aVar v1 v2 a1 a2 c1 c2 acc1 acc2 same.
  + assert (forall x : Component, v1 x -> v2 x).
    intros.
    apply (two_aVarTrees_same_v aVar v1 v2 a1 a2 c1 c2 acc1 acc2 same x) in H.
    apply H.
    assert ({c : Component & v2 c /\ v1 c}).
    destruct same.
    destruct a0.
    exists x. auto.
    assert (forall x : Component, v2 x -> v1 x).
    intros.
    apply (two_aVarTrees_same_v aVar v2 v1 a2 a1 c2 c1 acc2 acc1 H0 x) in H1.
    apply H1.
    apply U_set_eq.
    split.
    apply H.
    apply H1.
Qed.

Lemma two_aVarTrees_same': forall (aVar : Var) (v1 v2: V_set) (a1 a2: A_set) (c1 : aVarTree aVar v1 a1) (c2: aVarTree aVar v2 a2),
  max_aVarVset aVar v1 -> max_aVarVset aVar v2 -> {ar : Arc & (a1 ar /\ a2 ar)} ->
    (v1 = v2).
Proof.
  intros aVar v1 v2 a1 a2 c1 c2 acc1 acc2 same.
  destruct same.
  destruct a0.
  assert (forall v1 v2 v a aVar (c1 : aVarTree aVar v a), a (A_ends v1 v2) -> (v v1 /\ v v2)).
  - intros.
    induction c0.
    + inversion H1.
    + inversion H1.
      inversion H2.
      rewrite <- H5 in *.
      rewrite <- H6 in *.
      split.
      apply In_right.
      apply v4.
      apply In_left.
      apply In_single.
      split.
      apply In_left.
      apply In_single.
      rewrite <- H5 in *.
      rewrite <- H6 in *.
      apply In_right.
      apply v4.
      apply (aVarTree_a_means_v aVar0 vT aT c0) in H2.
      destruct H2.
      split.
      apply In_right.
      apply H2.
      apply In_right.
      apply H4.
    + rewrite <- e in *.
      rewrite <- e0 in *.
      apply (IHc0 H1).
  - destruct x.
    specialize (H1 v0 v3).
    assert (v1 v0 /\ v1 v3).
    apply (H1 v1 a1 aVar c1 H).
    assert (v2 v0 /\ v2 v3).
    apply (H1 v2 a2 aVar c2 H0).
    destruct H2.
    destruct H3.
    apply (two_aVarTrees_same aVar _ _ _ _ c1 c2 acc1 acc2).
    exists v0.
    auto.
Qed.

Definition root_of_Vset (vT : V_set) (root: Component) : Prop :=
  (vT root /\ forall (c : Component), vT c -> component_index c <= component_index root).

Lemma root_same_aVarTrees_same : forall (aVar : Var) (vT1 vT2 : V_set) (aT1 aT2 : A_set),
  aVarTree aVar vT1 aT1 -> aVarTree aVar vT2 aT2 -> max_aVarVset aVar vT1 -> max_aVarVset aVar vT2 ->
  {c : Component & (root_of_Vset vT1 c /\ root_of_Vset vT2 c)} -> vT1 = vT2.
Proof.
  intros aVar vT1 vT2 aT1 aT2 aTree1 aTree2 maTree1 maTree2 H.
  destruct H.
  destruct a0 as [rmaTree1 rmaTree2].
  unfold root_of_Vset in *.
  destruct rmaTree1. destruct rmaTree2.
  apply (two_aVarTrees_same aVar vT1 vT2 aT1 aT2 aTree1 aTree2 maTree1 maTree2).
  exists x.
  auto.
Qed.

Lemma components_comparable : forall (c1 c2 : Component),
  {component_index c1 <= component_index c2} +
  {component_index c1 > component_index c2}.
Proof.
  intros c1.
  destruct c1.
  induction n.
  + left.
    destruct c2.
    simpl.
    induction n.
    reflexivity.
    auto.
  + intros c2.
    specialize (IHn c2).
    destruct c2.
    simpl in *.
    destruct IHn.
    assert ({n = n0} + {n <> n0}).
    apply Nat.eq_dec.
    destruct H.
    right.
    intuition.
    left.
    intuition.
    right.
    intuition.
Qed.

Lemma aVarTree_root_exists : forall (aVar : Var) (vT : V_set) (aT : A_set) (aTree : aVarTree aVar vT aT),
  {c : Component & root_of_Vset vT c}.
Proof.
  intros aVar vT aT aTree.
  induction aTree.
  + exists x.
    unfold root_of_Vset.
    auto.
    split.
    apply In_single.
    intros.
    inversion H. auto.
  + destruct IHaTree.
    assert ({component_index x0 <= component_index  y} +
            {component_index x0 > component_index y}).
    apply components_comparable.
    destruct H.
    exists y.
    unfold root_of_Vset.
    split.
    apply In_left. apply In_single.
    intros.
    unfold root_of_Vset in r.
    destruct r.
    inversion H.
    inversion H2. auto.
    apply H1 in H2.
    intuition.
    exists x0.
    unfold root_of_Vset in *.
    destruct r.
    split.
    apply In_right.
    apply H.
    intros.
    inversion H1.
    inversion H2.
    rewrite <- H4 in *.
    intuition.
    apply H0.
    apply H2.
  + rewrite <- e in *.
    apply IHaTree.
Qed.

Lemma aVarTrees_same_root_same : forall (aVar : Var) (vT1 vT2 : V_set) (aT1 aT2 : A_set),
  aVarTree aVar vT1 aT1 -> aVarTree aVar vT2 aT2 -> max_aVarVset aVar vT1 -> max_aVarVset aVar vT2 ->
  vT1 = vT2 -> {c : Component & (root_of_Vset vT1 c /\ root_of_Vset vT2 c)}.
Proof.
  intros aVar vT1 vT2 aT1 aT2 aTree1 aTree2 maTree1 maTree2 vT1vT2.
  apply aVarTree_root_exists in aTree1.
  apply aVarTree_root_exists in aTree2.
  destruct aTree1. destruct aTree2.
  unfold root_of_Vset in *.
  destruct r. destruct r0.
  exists x.
  split.
  auto.
  split ; rewrite <- vT1vT2 in *.
  apply H.
  apply H0.
Qed.

Definition is_aVarspanning (aVar : Var) (vT : V_set) : Prop :=
  forall c, (v c /\ isa_aVarComponent aVar c) -> vT c.

Definition all_maxaVarTreesSame (aVar : Var) : Prop :=
(forall vT1 vT2 aT1 aT2 (aTree1 : aVarTree aVar vT1 aT1) (aTree2 : aVarTree aVar vT2 aT2),
    (max_aVarVset aVar vT1 /\ max_aVarVset aVar vT2) ->
    vT1 = vT2).

Lemma aVarTree_no_notaVars : forall (aVar : Var) (vT : V_set) (aT : A_set)
  (aTree : aVarTree aVar vT aT) (c : Component),
  ~ isa_aVarComponent aVar c -> ~ vT c.
Proof.
  intros aVar vT aT atree c not.
  induction atree.
  + intuition.
    inversion H.
    rewrite <- H0 in not.
    intuition.
  + intuition.
    inversion H.
    inversion H1.
    rewrite <- H3 in *.
    intuition.
    intuition.
  + rewrite <- e.
    apply (IHatree not).
Qed.

Lemma maxaVarTree_remains : forall (aVar : Var) (v0 vT: V_set) (a0 aT: A_set)
  (g : Connected v0 a0) (x y : Component) (aTree : aVarTree aVar vT aT),
  ~(isa_aVarComponent aVar x /\ isa_aVarComponent aVar y) ->
  (forall c1 c2 : Component,
 vT c1 /\
 a0 (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
 vT c2) ->

 (forall c1 c2 : Component,
 vT c1 /\
 (A_union (E_set x y) a0) (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
 vT c2).
Proof.
  intros aVar v0 vT a0 aT g x y aTree onenot matree.
  intros.
  destruct H.
  destruct H0.
  assert (~ isa_aVarComponent aVar x \/ ~ isa_aVarComponent aVar y).
  assert (isa_aVarComponent aVar x \/ ~ isa_aVarComponent aVar x).
  apply classic.
  assert (isa_aVarComponent aVar y \/ ~isa_aVarComponent aVar y).
  apply classic.
  destruct H2.
  destruct H3.
  assert ((isa_aVarComponent aVar x /\ isa_aVarComponent aVar y)).
  auto.
  intuition.
  right ; auto.
  left ; auto.
  clear onenot.
  inversion H0.
  + inversion H3.
    rewrite <- H6 in *.
    rewrite <- H7 in *.
    clear H7 H6 H4 H3 x0 H0 c1 c2.
    destruct H2.
    apply (aVarTree_no_notaVars aVar vT aT aTree x) in H0.
    intuition.
    intuition.
    rewrite <- H6 in *.
    rewrite <- H7 in *.
    clear H7 H6 H4 H3 x0 H0 c1 c2.
    destruct H2.
    intuition.
    apply (aVarTree_no_notaVars aVar vT aT aTree y) in H0.
    intuition.
  + apply (matree c1 c2) ; auto.
Qed.

Lemma maxaVarTree_remains' : forall (aVar : Var) (v0 vT: V_set) (a0 aT: A_set)
  (g : Connected v0 a0) (x y : Component) (aTree : aVarTree aVar vT aT),
  (vT x /\ vT y) ->
  (forall c1 c2 : Component,
 vT c1 /\
 a0 (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
 vT c2) ->

 (forall c1 c2 : Component,
 vT c1 /\
 (A_union (E_set x y) a0) (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
 vT c2).
Proof.
  intros aVar v0 vT a0 aT g x y aTree both matree.
  intros.
  destruct both as [vtx vty].
  destruct H.
  destruct H0.
  inversion H0.
  + inversion H2.
    rewrite <- H6 ; auto.
    rewrite <- H6 ; auto.
  + apply (matree c1 c2) ; auto.
Qed.

Axiom dontuse1 : forall (c : Component),
  v c.

Axiom dontuse2 : forall (ar : Arc),
  a ar.

Lemma combine_aTrees : forall (aVar : Var) (vX vY v0: V_set) (aX aY a0: A_set) (xTree : aVarTree aVar vX aX)
    (yTree : aVarTree aVar vY aY) (x y : Component) (c0 : Connected v0 a0),
  vX x -> vY y -> ~ vX y ->
  forall c1 c2 : Component,
       vX c1 /\ a0 (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
       vX c2 ->
  forall c1 c2 : Component,
       vY c1 /\ a0 (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
       vY c2 ->
  aVarTree aVar (V_union vX vY) (A_union (A_union (E_set x y) aX) aY) (* /\
  forall c1 c2 : Component,
       (V_union vX vY) c1 /\ (A_union (A_union (E_set x y) aX) aY) (A_ends c1 c2) /\ isa_aVarComponent aVar c2 ->
       (V_union vX vY) c2 . *)
Proof.

Admitted.

Lemma exists_maxaVarTree : forall (aVar : Var) (c : Component),
  v c -> isa_aVarComponent aVar c -> exists (vT : V_set) (aT : A_set) (aTree : aVarTree aVar vT aT),
  (vT c /\ max_aVarVset aVar vT).
Proof.
  intros aVar.
  assert (forall c : Component, v c -> isa_aVarComponent aVar c -> aVarTree aVar (V_single c) A_empty).
  intros.
  apply CC_isolated ; auto.
  unfold max_aVarVset. induction g ; intros d vd isad.
  + exists (V_single d).
    exists (A_empty).
    assert (aVarTree aVar (V_single d) A_empty).
    apply (H d vd isad).
    exists H0.
    clear H0.
    split.
    apply In_single.
    unfold max_aVarVset.
    intros.
    destruct H0.
    destruct H1.
    inversion H1.
  + assert (isa_aVarComponent aVar y \/ ~ isa_aVarComponent aVar y).
    apply classic.
    destruct H0. (* ist die neue Komponente eine aVar? j/n*)
    - assert (isa_aVarComponent aVar x \/ ~ isa_aVarComponent aVar x).
      apply classic.
      destruct H1.
      { admit.
     (* destruct vd.
        + admit.
        + admit. *)
      }
      { destruct vd.
        inversion H2.
        rewrite <- H3 in *.
        exists (V_single y).
        exists (A_empty).
        assert (aVarTree aVar (V_single y) A_empty).
        apply (H y).
        apply In_left.
        apply In_single.
        auto.
        exists H4.
        split.
        auto.
        intros.
        destruct H5.
        inversion H5.
        rewrite <- H7 in *.
        destruct H6.
        inversion H6.
        inversion H9.
        rewrite <- H12 in n.
        intuition.
        rewrite <- H12 in *.
        intuition.
        apply Connected_Isa_Graph in c.
        apply (G_ina_inv1 v0 a0 c y c2) in H9.
        intuition.
        apply IHc in H2.
        destruct H2.
        destruct H2.
        destruct H2.
        destruct H2.
        exists x1.
        exists x2.
        exists x3.
        split.
        auto.
        apply (maxaVarTree_remains aVar v0 x1 a0 x2 c x y x3).
        intuition.
        intuition.
        intros.
        apply (H c0).
        apply In_right.
        auto. auto. auto.
      }
    - destruct vd. (* ist die Komponente f\u00fcr die wir zeigen sollen, dass sie drin ist die neue Komponente? j/n*)
      { inversion H1.
        rewrite <- H2 in *.
        assert (V_single y y).
        apply In_single.
        assert (aVarTree aVar (V_single y) A_empty).
        apply (H y).
        apply In_left.
        apply In_single.
        auto.
        apply (only_aVars_inaVarTree (V_single y) A_empty aVar H4) in H3.
        intuition.
      }
      { apply IHc in H1.
        clear IHc.
        destruct H1.
        destruct H1.
        destruct H1.
        destruct H1.
        exists x1.
        exists x2.
        exists x3.
        split.
        auto.
        apply (maxaVarTree_remains aVar v0 x1 a0 x2 c x y x3).
        intuition.
        intuition.
        intros.
        apply (H c0).
        apply In_right.
        auto. auto. auto.
      }
  + assert (isa_aVarComponent aVar x \/ ~isa_aVarComponent aVar x).
    apply classic.
    destruct H0.
    - assert (isa_aVarComponent aVar y \/ ~isa_aVarComponent aVar y).
      apply classic.
      destruct H1.
      { assert (forall c : Component,
      v0 c ->
      isa_aVarComponent aVar c ->
      exists (vT : V_set) (aT : A_set) (_ : aVarTree aVar vT aT),
        vT c /\
        (forall c1 c2 : Component,
         vT c1 /\ a0 (A_ends c1 c2) /\ isa_aVarComponent aVar c2 -> vT c2)).
        apply (IHc H).
        clear IHc H.
        assert (Hx := H2 x v1 H0).
        assert (Hy := H2 y v2 H1).
        assert (Hd := H2 d vd isad).
        clear H2.
        destruct Hx as [vX Hx].
        destruct Hx as [aX Hx].
        destruct Hx as [xTree Hx].
        destruct Hx as [vXx maxX].
        destruct Hy as [vY Hy].
        destruct Hy as [aY Hy].
        destruct Hy as [yTree Hy].
        destruct Hy as [vYy maxY].
        destruct Hd as [vD Hd].
        destruct Hd as [aD Hd].
        destruct Hd as [dTree Hd].
        destruct Hd as [vDd maxD].
        (*
           Zwei F\u00e4lle: d liegt in (vTx oder vTy) oder nicht
             ja: zwei F\u00e4lle: (vTx und vTy haben gemeinsame Knoten) oder nicht
                ja : nehme vTd (alle drei sind die gleichen Knotenmengen)
                nein : nehme Union vTx vTy
             nein: nehme vTd und trivial
        *)
        assert ((vD x \/ vD y) \/ ~(vD x \/ vD y)).
        apply classic.
        destruct H.
        + assert (vX y \/ ~ vX y).
          apply classic.
          destruct H2.
          - exists vD.
            exists aD.
            exists dTree.
            split.
            auto.
            assert (vD x /\ vD y).
            assert (vX = vY).
            apply (two_aVarTrees_same aVar vX vY aX aY xTree yTree).
            unfold max_aVarVset. (* apply maxX. *)
            admit. admit. admit.
            assert (vD = vX).
            admit.
            split.
            rewrite H4 ; auto.
            rewrite H4 ; rewrite H3 ; auto.
            apply (maxaVarTree_remains' aVar v0 vD a0 aD c x y dTree H3 maxD).
          - exists (V_union vX vY).
            exists (A_union (A_union (E_set x y) aX) aY).
            assert (aVarTree aVar (V_union vX vY) (A_union (A_union (E_set x y) aX) aY)).

            admit.
(*             beweise, dass zwei bisher getrennte maxTrees vereint ein neuer maxtree sind *)
            admit.
        + exists vD.
          exists aD.
          exists dTree.
          split.
          auto.
          intros.
          apply (maxD c1 c2).
          destruct H2.
          destruct H3.
          split. auto.
          split.
          inversion H3.
          inversion H5.
          rewrite <- H8 in H2.
          assert (False).
          apply H ; auto.
          intuition.
          rewrite <- H8 in H2.
          assert (False).
          apply H ; auto.
          intuition.
          auto.
          auto.
      }
      { apply IHc in vd.
        clear IHc.
        destruct vd.
        destruct H2.
        destruct H2.
        destruct H2.
        exists x0. exists x1. exists x2.
        split. auto.
        apply (maxaVarTree_remains aVar v0 x0 a0 x1 c x y x2).
        intuition.
        apply H3.
        intros.
        apply (H c0).
        auto. auto. auto.
      }
    - apply IHc in vd.
      clear IHc.
      destruct vd.
      destruct H1.
      destruct H1.
      destruct H1.
      exists x0. exists x1. exists x2.
      split. auto.
      apply (maxaVarTree_remains aVar v0 x0 a0 x1 c x y x2).
      intuition.
      apply H2.
      intros.
      apply (H c0).
      auto. auto. auto.
  + rewrite <- e0 in *.
    rewrite <- e in *.
    apply (IHc H d vd isad).
Admitted.

Lemma allMaxTreesSame_spanningTree : forall (aVar : Var) (vT : V_set) (aT : A_set),
  all_maxaVarTreesSame aVar -> aVarTree aVar vT aT -> max_aVarVset aVar vT ->
  is_aVarspanning aVar vT.
Proof.
  intros aVar vT aT allSame aTree maTree.
  unfold is_aVarspanning.
  intros.
  destruct H.
  apply (exists_maxaVarTree aVar) in H.
  destruct H.
  destruct H.
  destruct H.
  destruct H.
  unfold all_maxaVarTreesSame in allSame.
  specialize (allSame vT x aT x0).
  assert (vT = x).
  apply allSame.
  auto.
  auto.
  split ; auto.
  rewrite H2.
  apply H.
  apply H0.
Qed.

Lemma spanningTree_max : forall (aVar : Var) (vT : V_set) (aT : A_set),
  is_aVarspanning aVar vT -> aVarTree aVar vT aT ->
  max_aVarVset aVar vT.
Proof.
  intros aVar vT aT isspanning spanningtree.
  unfold max_aVarVset ; intros.
  destruct H.
  destruct H0.
  unfold is_aVarspanning in isspanning.
  assert (v c2).
  assert (Graph v a).
  apply Connected_Isa_Graph.
  apply g.
  apply (G_ina_inv2 v a H2 c1 c2 H0).
  apply (isspanning c2).
  auto.
Qed.

Lemma aVarTree_means_component : forall (aVar : Var) (vT : V_set) (aT : A_set),
  aVarTree aVar vT aT -> {x : Component & vT x}.
Proof.
  intros aVar vT aT atree.
  induction atree.
  + exists x.
    apply In_single.
  + destruct IHatree.
    exists x.
    apply In_right.
    apply v0.
  + rewrite <- e in *.
    apply IHatree.
Qed.

Lemma cdr_app :
 forall vl vl' : V_list, vl <> nil -> cdr (vl ++ vl') = cdr vl ++ vl'.
Proof.
        simple induction vl; simpl; intros.
        absurd (V_nil = V_nil); auto.

        trivial.
Qed.

Lemma neq_symm: forall (X : Type) {p q: X}, p <> q -> q <> p.
Proof.
  intros X p q pq.
  unfold not.
  intros.
  apply pq.
  symmetry.
  apply H.
Qed.

Lemma cdr_rev: forall (x: Component) (vl: V_list),
  In x (cdr (rev vl)) -> In x vl.
Proof.
  intros x vl i.
  induction vl.
  simpl in i.
  inversion i.
  unfold In.
  simpl in i.
  destruct vl.
  simpl in i.
  inversion i.
  rewrite cdr_app in i.
  apply in_app_or in i.
  destruct i.
  right.
  apply IHvl.
  apply H.
  left.
  inversion H.
  apply H0.
  inversion H0.
  apply neq_symm.
  apply app_cons_not_nil.
Qed.

Lemma aVarwalk_reverse: forall (aVar : Var) (vl : V_list) (el : E_list) (x y : Component)
  (w : Walk v a x y vl el) (aw : aVarWalk aVar x y vl el w),
  {vl0 : V_list & {el0 : E_list & {ww: Walk v a y x vl0 el0 & aVarWalk aVar y x vl0 el0 ww
                                /\ vl0 = (cdr (rev (x :: vl)))
                                /\ el0 = (E_reverse el)}}}.
Proof.
  intros aVar vl el x y w aw.
  induction w.
  + exists V_nil.
    exists E_nil.
    exists (W_null v a x v0).
    split.
    apply aw.
    split.
    auto.
    auto.
  + assert (Walk v a x z (y :: vl) (E_ends x y :: el)).
    apply W_step ; auto.
    assert (Graph v a).
    apply Connected_Isa_Graph.
    apply g.
    apply (Walk_reverse v a H0 x z (y :: vl) (E_ends x y :: el)) in H.
    exists (cdr (rev (x :: y :: vl))).
    exists (E_reverse (E_ends x y :: el)).
    exists H.
    split.
    unfold aVarWalk in aw.
    unfold aVarWalk.
    intros.
    destruct vl.
    inversion H1.
    rewrite <- H2 in *.
    inversion w.
    rewrite <- H5 in *.
    apply (aw y).
    simpl.
    right. left. auto.
    simpl in H2.
    destruct H2.
    rewrite <- H2.
    apply (aw x).
    simpl.
    auto.
    inversion H2.
    inversion H1.
    rewrite <- H2 in *.
    assert (w' := w).
    apply (W_iny_vl v a y z (v1 :: vl) el) in w'.
    apply (aw z).
    simpl.
    destruct w'.
    right. right. left. auto.
    right. right. right. auto.
    intuition.
    inversion H3.
    apply cdr_rev in H2.
    apply (aw c H2).
    split ; auto.
Qed.

Lemma spanningTree_aTree_max : forall (aVar : Var) (vT1 vT2 : V_set) (aT1 aT2 : A_set),
  is_aVarspanning aVar vT1 -> aVarTree aVar vT1 aT1 ->
  aVarTree aVar vT2 aT2 -> max_aVarVset aVar vT2 -> vT1 = vT2.
Proof.
  intros aVar vt1 vt2 at1 at2 isspanning spantree atree maxtree.
  apply U_set_eq.
  split ; intros.
  + assert (atree' := atree).
    apply (aVarTree_means_component aVar vt2 at2) in atree'.
    destruct atree'.
    assert (v0' := v0).
    assert (v0'' := v0).
    apply (only_aVars_inaVarTree vt2 at2 aVar atree) in v0.
    apply (only_vs_inaVarTree vt2 at2 aVar atree) in v0'.
    unfold is_aVarspanning in isspanning.
    assert (vt1 x0).
    apply (isspanning x0) ; auto.
    assert (H0' := H0).
    apply (aVarTrees_are_aVarWalks aVar vt1 at1 spantree x x0) in H0'.
    destruct H0'.
    destruct s.
    destruct s.
    assert (Graph v a).
    apply Connected_Isa_Graph.
    apply g.
    assert (x3' := x3).
    apply (Walk_reverse v a H1 x x0 x1 x2) in x3'.
    apply (aVarWalk_in_aVarTree aVar vt2 at2 atree x0 x (cdr (rev (x :: x1))) (E_reverse x2) x3') ; auto.
    apply (aVarwalk_reverse aVar x1 x2 x x0 x3) in a0.
    destruct a0.
    destruct s.
    destruct s.
    destruct a0.
    destruct H3.
    unfold aVarWalk in *.
    intros.
    apply (H2 c).
    simpl in H5.
    destruct H5.
    rewrite H5.
    simpl. left. auto.
    rewrite H3.
    simpl.
    right. apply H5.
    apply H.
  + assert (H' := H).
    apply (only_aVars_inaVarTree vt2 at2 aVar atree) in H.
    unfold is_aVarspanning in isspanning.
    apply (only_vs_inaVarTree vt2 at2 aVar atree) in H'.
    apply (isspanning x) ; auto.
Qed.

Lemma spanningTree_allMaxTreesSame : forall (aVar : Var) (vT : V_set) (aT : A_set),
  is_aVarspanning aVar vT -> aVarTree aVar vT aT ->
  all_maxaVarTreesSame aVar.
Proof.
  intros aVar vT aT isspanning atree.
  unfold all_maxaVarTreesSame.
  intros.
  destruct H.
  unfold is_aVarspanning in isspanning.
  assert (vT = vT1).
  apply (spanningTree_aTree_max aVar vT vT1 aT aT1) ; auto.
  assert (vT = vT2).
  apply (spanningTree_aTree_max aVar vT vT2 aT aT2) ; auto.
  rewrite <- H1.
  auto.
Qed.

Variable state_of : Component -> Data.

Definition get_aVar_leader (aVar : Var) (c : Component) : Component :=
  index (get_leader_index aVar (leaders (state_of c))).

Variable get_aVar_CC : Var -> Component -> (V_set * A_set).
  (* v muss endlich sein, um das vllt \u00fcber CV_list zu definieren:
     man \u00fcbergibt get_aVar_CC aVar c [CV-Liste] V_nil A_nil
     in jedem Schritt wird c abgearbeitet, indem die Nachbarn untersucht werden
     wenn Nachbar aVar und in [CV-Liste], dann werden dessen Nachbarn untersucht,
     Nachbar wird von [CV-Liste] gestrichen und n\u00e4chster Nachbar untersucht. *)

Axiom get_aVar_vTaT_is_CC : forall (aVar : Var) (c : Component),
  let (vT, aT) := get_aVar_CC aVar c in
  {v2 : V_set & {a2 : A_set & {_: aVarTree aVar v2 a2 & (vT = v2 /\ aT = a2 /\ v2 c /\ max_aVarVset aVar v2 a2)}}}.

Definition is_aVar_vcc_leader (aVar : Var) (vT : V_set) (c : Component) : Prop :=
  vT c /\ forall (v : Component), vT v -> get_aVar_leader aVar v = c.

Definition is_local_aVar_leader (aVar : Var) (c : Component) : Prop :=
  let (vT, aT) := get_aVar_CC aVar c in
    is_aVar_vcc_leader aVar vT c.

Definition all_leaders_correctly_voted : Prop :=
  forall (aVar : Var), In aVar allVar ->
   (forall (v1 : Component), v v1 -> is_local_aVar_leader aVar (get_aVar_leader aVar v1)).

(*

  Theorem: F\u00fcr jeden a-Teilgraph T gilt: in jeder Zusammenhangskomponente K von T gibt es genau einen Leader, der Teil von K ist.

  Invarianten: Nachrichten k\u00f6nnen nur eine Komponente au\u00dferhalb des a-Teilgraphen geschickt werden
  Invarianten: Von allen Komponenten, die man gesehen hat, nimmt man die "h\u00f6chst"-m\u00f6gliche.

  Lemma: Man nimmt nie einen kleineren Leader, als man schon hat.
  Lemma: Man nimmt nur einen Leader von alpha, wenn alpha Teil vom Zeugen des Leaders ist.
  Lemma: Man kann keine Komponente als Leader w\u00e4hlen, wenn der "Zeugenschnitt" mit der Komponente leer ist.

*)
(* TODO: bipartition pr\u00fcfen und mit master mergen *)
End ConnectedChecker.


Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import AbsAccessor.Spec.
Require Import TableAux.Specs.table_maps_block.
Require Import TableAux.LowSpecs.table_maps_block.
Require Import TableAux.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       pgte_read_spec
       entry_to_phys_spec
       addr_is_level_aligned_spec
    .

  Lemma table_maps_block_spec_exists:
    forall habd  labd table level ipa_state res
           (Hspec: table_maps_block_spec table level ipa_state habd = Some res)
            (Hrel: relate_RData habd labd),
    table_maps_block_spec0 table level ipa_state labd = Some res.
  Proof.
    intros. destruct Hrel. inv id_rdata. destruct table.
    unfold table_maps_block_spec, table_maps_block_spec0 in *. autounfold in *.
    repeat simpl_hyp Hspec; inv Hspec. extract_prop_dec.
    rewrite Prop0. solve_bool_range; grewrite.
    assert(forall n (Hn: 0 <= Z.of_nat n <= PGTES_PER_TABLE),
              let gn := (gs (share labd)) @ z2 in
              table_maps_block_loop0 n 0 1 (p, z) (__entry_to_phys (g_data (gnorm (gs (share labd)) @ z2)) @ 0 z0) z0 z1 labd =
              Some (Z.of_nat n, if prop_dec (forall i (Hi: 0 <= i < Z.of_nat n),
                                                let e := (g_data (gnorm (gs (share labd)) @ z2)) @ i in
                                                let pa := __entry_to_phys e z0 in
                                                let base_pa := __entry_to_phys (g_data (gnorm (gs (share labd)) @ z2)) @ 0 z0 in
                                                PTE_TO_IPA_STATE e = z1 /\ pa = base_pa + i * GRANULE_SIZE)
                                then 1 else 0)).
    { induction n.
      - simpl. intros. destruct_if. reflexivity. red in n. exploit n. intros. omega. intro F; inv F.
      - rewrite Nat2Z.inj_succ, succ_plus_1 in *. intros.
        simpl in *. exploit IHn. autounfold in *. omega. intro T. rewrite T. autounfold in *.
        solve_bool_range. grewrite. repeat destruct_con.
        extract_if. destruct_if; reflexivity. grewrite.
        extract_prop_dec. repeat (simpl_htarget; grewrite; simpl). rewrite Prop0.
        assert(0 <= Z.of_nat n < 512) by omega.
        solve_bool_range. grewrite. pose proof entry_to_phys_range as er. autounfold in er.
        rewrite er; try apply Prop0.
        repeat destruct_if; try reflexivity; bool_rel; extract_prop_dec; clear_hyp.
        red in n0. exploit n0. intros. destruct (i =? Z.of_nat n) eqn:Hii; bool_rel.
        rewrite <- Hii in *. split; assumption. apply a. omega. intro F; inv F.
        red in n0. exploit n0. intros. apply a. omega. intro F; inv F.
        pose proof (a (Z.of_nat n)). destruct H0. omega. omega.
        pose proof (a (Z.of_nat n)). destruct H0. omega. omega. }
    rewrite H. simpl.
    extract_if. destruct_if; reflexivity. grewrite. reflexivity. autounfold; simpl. omega.
    simpl. extract_prop_dec. rewrite Prop0. solve_bool_range. grewrite. reflexivity.
  Qed.

End Refine.


From iris.base_logic Require Import invariants viewshifts.
From iris.proofmode Require Import tactics.
From iris_io Require Import petrinet.

Section AbsPetrinet.
  Context `{invG Σ}.

  Definition abs_place := iProp Σ.

  Definition abs_token (P : abs_place) : iProp Σ := P.

  Definition abs_split P Q1 Q2 :=
    (abs_token P ={⊤}=> abs_token Q1 ∗ abs_token Q2)%I.

  Definition abs_join P1 P2 Q :=
    (abs_token P1 -∗ abs_token P2 ={⊤}=> abs_token Q)%I.

  Definition abs_noop P Q := (abs_token P ={⊤}=> abs_token Q)%I.

End AbsPetrinet.