Require String. Open Scope string_scope.
Require Import Relations Omega NPeano Ensembles Finite_sets Finite_sets_facts List ListSet.
(* Case for clearer analysis *)
Ltac move_to_top x :=
  match reverse goal with
  | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

Definition subset {X:Type} (s s': set X) : Prop :=
  forall x, set_In x s -> set_In x s'.


From algebra Require Export base.
From program_logic Require Import ownership.
From program_logic Require Export namespaces pviewshifts weakestpre.
Import uPred.
Local Hint Extern 100 (@eq coPset _ _) => set_solver.
Local Hint Extern 100 (@subseteq coPset _ _) => set_solver.
Local Hint Extern 100 (_ ∉ _) => set_solver.
Local Hint Extern 99 ({[ _ ]} ⊆ _) => apply elem_of_subseteq_singleton.

(** Derived forms and lemmas about them. *)
Definition inv {Λ Σ} (N : namespace) (P : iProp Λ Σ) : iProp Λ Σ :=
  (∃ i, ■ (i ∈ nclose N) ∧ ownI i P)%I.
Instance: Params (@inv) 3.
Typeclasses Opaque inv.

Section inv.
Context {Λ : language} {Σ : iFunctor}.
Implicit Types i : positive.
Implicit Types N : namespace.
Implicit Types P Q R : iProp Λ Σ.
Implicit Types Φ : val Λ → iProp Λ Σ.

Global Instance inv_contractive N : Contractive (@inv Λ Σ N).
Proof. intros n ???. apply exist_ne=>i. by apply and_ne, ownI_contractive. Qed.

Global Instance inv_always_stable N P : AlwaysStable (inv N P).
Proof. rewrite /inv; apply _. Qed.

Lemma always_inv N P : (□ inv N P)%I ≡ inv N P.
Proof. by rewrite always_always. Qed.

(** Invariants can be opened around any frame-shifting assertion. *)
Lemma inv_fsa {A} (fsa : FSA Λ Σ A) `{!FrameShiftAssertion fsaV fsa} E N P Ψ R :
  fsaV → nclose N ⊆ E →
  R ⊑ inv N P →
  R ⊑ (▷ P -★ fsa (E ∖ nclose N) (λ a, ▷ P ★ Ψ a)) →
  R ⊑ fsa E Ψ.
Proof.
  intros ? HN Hinv Hinner.
  rewrite -[R](idemp (∧)%I) {1}Hinv Hinner =>{Hinv Hinner R}.
  rewrite always_and_sep_l /inv sep_exist_r. apply exist_elim=>i.
  rewrite always_and_sep_l -assoc. apply const_elim_sep_l=>HiN.
  rewrite -(fsa_open_close E (E ∖ {[encode i]})) //; last by set_solver+.
  (* Add this to the local context, so that set_solver finds it. *)
  assert ({[encode i]} ⊆ nclose N) by eauto.
  rewrite (always_sep_dup (ownI _ _)).
  rewrite {1}pvs_openI !pvs_frame_r.
  apply pvs_mask_frame_mono; [set_solver..|].
  rewrite (comm _ (▷_)%I) -assoc wand_elim_r fsa_frame_l.
  apply fsa_mask_frame_mono; [set_solver..|]. intros a.
  rewrite assoc -always_and_sep_l pvs_closeI pvs_frame_r left_id.
  apply pvs_mask_frame'; set_solver.
Qed.

(* Derive the concrete forms for pvs and wp, because they are useful. *)

Lemma pvs_open_close E N P Q R :
  nclose N ⊆ E →
  R ⊑ inv N P →
  R ⊑ (▷ P -★ pvs (E ∖ nclose N) (E ∖ nclose N) (▷ P ★ Q)) →
  R ⊑ (|={E}=> Q).
Proof. intros. by apply: (inv_fsa pvs_fsa). Qed.

Lemma wp_open_close E e N P Φ R :
  atomic e → nclose N ⊆ E →
  R ⊑ inv N P →
  R ⊑ (▷ P -★ #> e @ E ∖ nclose N {{ λ v, ▷ P ★ Φ v }}) →
  R ⊑ #> e @ E {{ Φ }}.
Proof. intros. by apply: (inv_fsa (wp_fsa e)). Qed.

Lemma inv_alloc N E P : nclose N ⊆ E → ▷ P ⊑ pvs E E (inv N P).
Proof.
  intros. rewrite -(pvs_mask_weaken N) //.
  by rewrite /inv (pvs_allocI N); last apply coPset_suffixes_infinite.
Qed.

End inv.


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Defining recursive functions by Noetherian induction.  This is a simplified
  interface to the [Wf] module of Coq's standard library, where the functions
  to be defined have non-dependent types, and function extensionality is assumed. *)

From CompCert Require Import Axioms.
Require Import Init.Wf.
Require Import Wf_nat.

Set Implicit Arguments.

Section FIX.

Variables A B: Type.
Variable R: A -> A -> Prop.
Hypothesis Rwf: well_founded R.
Variable F: forall (x: A), (forall (y: A), R y x -> B) -> B.

Definition Fix (x: A) : B := Wf.Fix Rwf (fun (x: A) => B) F x.

Theorem unroll_Fix:
  forall x, Fix x = F (fun (y: A) (P: R y x) => Fix y).
Proof.
  unfold Fix; intros. apply Wf.Fix_eq with (P := fun (x: A) => B).
  intros. assert (f = g). apply functional_extensionality_dep; intros.
  apply functional_extensionality; intros. auto.
  subst g; auto.
Qed.

End FIX.

(** Same, with a nonnegative measure instead of a well-founded ordering *)

Section FIXM.

Variables A B: Type.
Variable measure: A -> nat.
Variable F: forall (x: A), (forall (y: A), measure y < measure x -> B) -> B.

Definition Fixm (x: A) : B := Wf.Fix (well_founded_ltof A measure) (fun (x: A) => B) F x.

Theorem unroll_Fixm:
  forall x, Fixm x = F (fun (y: A) (P: measure y < measure x) => Fixm y).
Proof.
  unfold Fixm; intros. apply Wf.Fix_eq with (P := fun (x: A) => B).
  intros. assert (f = g). apply functional_extensionality_dep; intros.
  apply functional_extensionality; intros. auto.
  subst g; auto.
Qed.

End FIXM.


Require Import RelationClasses.
Require Import List.

From sflib Require Import sflib.

From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.

Require Import Event.

Set Implicit Arguments.

Module Reg := Ident.
Module RegSet := IdentSet.
Module RegMap := IdentMap.
Module RegFun := IdentFun.

Module Value.
  Inductive t :=
  | reg (reg:Reg.t)
  | const (const:Const.t)
  .

  Definition regs_of (v:t): RegSet.t :=
    match v with
    | reg r => RegSet.singleton r
    | const _ => RegSet.empty
    end.

  Fixpoint regs_of_list (l:list t): RegSet.t :=
    match l with
    | nil => RegSet.empty
    | (reg r)::l => RegSet.add r (regs_of_list l)
    | (const _)::l => regs_of_list l
    end.

  Definition of_nat (n:nat): t := const n.
End Value.
Coercion Value.reg: Reg.t >-> Value.t.
Coercion Value.const: Const.t >-> Value.t.
Coercion Value.of_nat: nat >-> Value.t.

Module Op1.
  Inductive t :=
  | not
  .

  Definition eval (op:t) (op1:Const.t): Const.t :=
    match op with
    | not =>
      if Const.eq_dec op1 Const.zero
      then Const.one
      else Const.zero
    end.
End Op1.

Module Op2.
  Inductive t :=
  | add
  | sub
  | mul
  .

  Definition eval (op:t): forall (op1 op2:Const.t), Const.t :=
    match op with
    | add => Const.add
    | sub => Const.sub
    | mul => Const.mul
    end.
End Op2.

Module Instr.
  Inductive expr :=
  | expr_val (val:Value.t)
  | expr_op1 (op:Op1.t) (op:Value.t)
  | expr_op2 (op:Op2.t) (op1 op2:Value.t)
  .

  Definition regs_of_expr (r:expr): RegSet.t :=
    match r with
    | expr_val val => Value.regs_of val
    | expr_op1 _ op => Value.regs_of op
    | expr_op2 _ op1 op2 => RegSet.union (Value.regs_of op1) (Value.regs_of op2)
    end.

  Inductive rmw :=
  | fetch_add (addendum:Value.t)
  | cas (old new:Value.t)
  .

  Inductive t :=
  | skip
  | assign (lhs:Reg.t) (rhs:expr)
  | load (lhs:Reg.t) (rhs:Loc.t) (ord:Ordering.t)
  | store (lhs:Loc.t) (rhs:Value.t) (ord:Ordering.t)
  | update (lhs:Reg.t) (loc:Loc.t) (rmw:rmw) (ordr ordw:Ordering.t)
  | fence (ordr ordw:Ordering.t)
  | syscall (lhs:Reg.t) (rhses:list Value.t)
  .

  Definition regs_of_rmw (rmw:rmw): RegSet.t :=
    match rmw with
    | fetch_add addendum => (Value.regs_of addendum)
    | cas old new => RegSet.union (Value.regs_of old) (Value.regs_of new)
    end.

  Definition regs_of (i:t): RegSet.t :=
    match i with
    | skip => RegSet.empty
    | assign reg rhs => RegSet.add reg (regs_of_expr rhs)
    | load reg _ _ => RegSet.singleton reg
    | store _ val _ => Value.regs_of val
    | update reg _ rmw _ _ => RegSet.add reg (regs_of_rmw rmw)
    | fence _ _ => RegSet.empty
    | syscall lhs rhses => RegSet.add lhs (Value.regs_of_list rhses)
    end.

  Inductive ord: forall (i_src i_tgt:Instr.t), Prop :=
  | ord_skip:
      ord Instr.skip Instr.skip
  | ord_assign
      r e:
      ord (Instr.assign r e) (Instr.assign r e)
  | ord_load
      r l o1 o2 (O: Ordering.le o1 o2):
      ord (Instr.load r l o1) (Instr.load r l o2)
  | ord_store
      l v o1 o2 (O: Ordering.le o1 o2):
      ord (Instr.store l v o1) (Instr.store l v o2)
  | ord_update
      r l rmw or1 or2 ow1 ow2
      (OR: Ordering.le or1 or2)
      (OW: Ordering.le ow1 ow2):
      ord (Instr.update r l rmw or1 ow1) (Instr.update r l rmw or2 ow2)
  | ord_fence
      or1 or2 ow1 ow2
      (OR: Ordering.le or1 or2)
      (OW: Ordering.le ow1 ow2):
      ord (Instr.fence or1 ow1) (Instr.fence or2 ow2)
  | ord_syscall
      o i:
      ord (Instr.syscall o i) (Instr.syscall o i)
  .

  Global Program Instance instr_ord_Reflexive: Reflexive ord.
  Next Obligation. destruct x; econs; refl. Qed.

  Lemma ord_regs_of
        instr_src instr_tgt
        (ORD: ord instr_src instr_tgt):
    Instr.regs_of instr_src = Instr.regs_of instr_tgt.
  Proof. inv ORD; auto. Qed.
End Instr.
Coercion Instr.expr_val: Value.t >-> Instr.expr.

Module Stmt.
  Inductive t :=
  | instr (i:Instr.t)
  | ite (cond:Instr.expr) (c1 c2:list t)
  | dowhile (c:list t) (cond:Instr.expr)
  .
End Stmt.
Coercion Stmt.instr: Instr.t >-> Stmt.t.

Module SyntaxNotations.
  Export ListNotations.

  Delimit Scope string_scope with string.
  Open Scope string_scope.

  Notation "'%r' var" := (Reg.of_string var) (at level 41).
  Notation "'%l' var" := (Loc.of_string var) (at level 41).

  Notation "'pln'" := (Ordering.plain) (at level 41).
  Notation "'rlx'" := (Ordering.relaxed) (at level 41).
  Notation "'ar'" := (Ordering.acqrel) (at level 41).
  Notation "'sc'" := (Ordering.seqcst) (at level 41).

  Notation "'NOT' e" := (Instr.expr_op1 Op1.not e) (at level 41).
  Notation "e1 'ADD' e2" := (Instr.expr_op2 Op2.add e1 e2) (at level 41).
  Notation "e1 'SUB' e2" := (Instr.expr_op2 Op2.sub e2 e2) (at level 41).
  Notation "e1 'MUL' e2" := (Instr.expr_op2 Op2.mul e2 e2) (at level 41).

  Notation "'SKIP'" := (Instr.skip) (at level 42).
  Notation "'LET' lhs '::=' rhs" := (Instr.assign lhs rhs) (at level 42).
  Notation "'LOAD' lhs '::=' rhs '@' ord" := (Instr.load lhs rhs ord) (at level 42).
  Notation "'STORE' lhs '::=' rhs '@' ord" := (Instr.store lhs rhs ord) (at level 42).
  Notation "'FETCH_ADD' lhs '::=' loc ',' addendum '@' ordr ',' ordw" := (Instr.update lhs loc (Instr.fetch_add addendum) ordr ordw) (at level 42).
  Notation "'CAS' lhs '::=' loc ',' old ',' new '@' ordr ',' ordw" := (Instr.update lhs loc (Instr.cas old new) ordr ordw) (at level 42).
  Notation "'FENCE' '@' ordr ',' ordw" := (Instr.fence ordr ordw) (at level 42).
  Notation "'SYSCALL' lhs '::=' rhses" := (Instr.syscall lhs rhses) (at level 42).

  Notation "'IF' cond 'THEN' c1 'ELSE' c2" := (Stmt.ite cond c1 c2) (at level 43).
  Notation "'DO' c 'WHILE' cond" := (Stmt.dowhile c cond) (at level 43).

  (* Program Definition example1: list Stmt.t := [ *)
  (*   DO [ *)
  (*     SKIP; *)
  (*     LOAD %r"r1" ::= %l"flag" @ ar; *)
  (*     LET %r"r2" ::= NOT %r"r1" *)
  (*   ] WHILE (%r"r2" ADD 0); *)
  (*   LOAD %r"r3" ::= %l"x" @ rlx *)
  (* ]. *)

  (* Program Definition example2: list Stmt.t := [ *)
  (*   DO [ *)
  (*     SKIP; *)
  (*     LOAD %r"r1" ::= %l"flag" @ rlx; *)
  (*     LET %r"r2" ::= NOT %r"r1" *)
  (*   ] WHILE (%r"r2" MUL 1); *)
  (*   FENCE @ ar, rlx; *)
  (*   LOAD %r"r3" ::= %l"x" @ rlx; *)
  (*   SYSCALL %r"r4" ::= [%r"r3"; 3; 4] *)
  (* ]. *)

  (* Program Definition example3: list Stmt.t := [ *)
  (*   FETCH_ADD %r"r1" ::= %l"x", 1 @ rlx, rlx; *)
  (*   CAS %r"r1" ::= %l"x", 1, 2 @ rlx, rlx *)
  (* ]. *)
End SyntaxNotations.


Require Import AutoSep.
Require Import List.

Set Implicit Arguments.

Section TopSection.

  Local Open Scope nat.

  Opaque mult.

  Lemma ptsto32m'_out : forall p ls n,
    ptsto32m' nil p n ls ===> ptsto32m nil p n ls.
    induction ls; simpl; intros.
    apply Himp_refl.
    eapply Himp_trans; [ apply Himp_star_frame; [ apply Himp_refl
      | apply IHls ] | ].
    destruct ls; simpl in *.
    destruct n.
    replace (p ^+ $0) with p by words.
    eapply Himp_trans; [ apply Himp_star_comm | ].
    apply Himp_star_Emp.
    eapply Himp_trans; [ apply Himp_star_comm | ].
    apply Himp_star_Emp.
    destruct n; simpl.
    replace (p ^+ $0) with p by words.
    apply Himp_refl.
    apply Himp_refl.
  Qed.

  Lemma ptsto32m'_in : forall p ls n,
    ptsto32m nil p n ls ===> ptsto32m' nil p n ls.
    induction ls; simpl; intros.
    apply Himp_refl.
    eapply Himp_trans; [ | apply Himp_star_frame; [ apply Himp_refl
      | apply IHls ] ].
    destruct ls; simpl in *.
    destruct n.
    replace (p ^+ $0) with p by words.
    eapply Himp_trans; [ | apply Himp_star_comm ].
    apply Himp_star_Emp'.
    eapply Himp_trans; [ | apply Himp_star_comm ].
    apply Himp_star_Emp'.
    destruct n; simpl.
    replace (p ^+ $0) with p by words.
    apply Himp_refl.
    apply Himp_refl.
  Qed.

  Lemma ptsto32m'_split' : forall p ls2 ls1 base,
    ptsto32m' nil p base (ls1 ++ ls2) ===>
    star (ptsto32m' nil p base ls1)
    (ptsto32m' nil (p ^+ $ (4 * length ls1)) base ls2).
    induction ls1; simpl; intros.

    change (4 * 0) with 0.
    replace (p ^+ $0) with p by words.
    apply Himp_star_Emp'.

    eapply Himp_trans; [ apply Himp_star_frame; [
      apply Himp_refl | apply IHls1 ] | ].
    sepLemma.
    eapply Himp_trans; [ apply ptsto32m'_shift_base' | ].
    instantiate (1 := 4).
    auto.
    apply Himp_refl'; f_equal; try omega.
    unfold natToW.
    rewrite <- wplus_assoc.
    rewrite <- natToWord_plus.
    do 2 f_equal.
    auto.
  Qed.

  Lemma ptsto32m'_split : forall p ls pos base,
    pos <= length ls
    -> ptsto32m' nil p base ls ===>
    star (ptsto32m' nil p base (firstn pos ls))
    (ptsto32m' nil (p ^+ $ (4 * pos)) base (skipn pos ls)).
    intros.
    pattern ls at 1.
    replace ls with (firstn pos ls ++ skipn pos ls).
    replace (4 * pos) with (4 * length (firstn pos ls)).
    apply ptsto32m'_split'.
    rewrite firstn_length.
    rewrite Min.min_l; auto.
    apply firstn_skipn.
  Qed.

  Lemma ptsto32m'_elim : forall p ls base,
    ptsto32m' nil p base ls ===> (p ^+ $ base) =?> length ls.
    induction ls; simpl; intros.

    apply Himp_refl.

    apply Himp_star_frame.
    sepLemma.
    eapply Himp_trans; [ | apply allocated_shift_base ].
    eapply Himp_trans; [ | apply IHls ].
    apply Himp_refl.
    do 2 rewrite <- wplus_assoc.
    do 2 rewrite <- natToWord_plus.
    do 2 f_equal.
    omega.
    auto.
  Qed.

End TopSection.


Require Export List Arith Utf8 Program Setoid Classes.Morphisms NPeano.
Require Export Tactics.Common.

Global Set Implicit Arguments.
Global Generalizable All Variables.

Local Open Scope list_scope.

Hint Extern 0 => match goal with H : False |- _ => destruct H end.
Hint Extern 0 => match goal with H : None = Some _ |- _ => inversion H end.
Hint Extern 0 => match goal with H : Some _ = None |- _ => inversion H end.
Hint Extern 0 => match goal with H : false = true |- _ => inversion H end.
Hint Extern 0 => match goal with H : true = false |- _ => inversion H end.
Hint Extern 0 => match goal with H0 : ?T, H1 : ?T -> False |- _ => destruct (H1 H0) end.
Hint Extern 0 => match goal with H0 : ?T, H1 : ~?T |- _ => destruct (H1 H0) end.
Hint Extern 0 => match goal with H : None = Some _ |- _ => inversion H end.
Hint Extern 0 => solve [ reflexivity ].
Hint Extern 0 => match goal with H : Forall _ (_ :: _) |- _ => inversion_clear H end.
Hint Extern 0 => match goal with H : ?x <> ?x |- _ => destruct (H eq_refl) end.
Hint Extern 0 => match goal with H : lt _ 0 |- _ => destruct (@lt_n_0 _ H) end.
Hint Extern 0 => match goal with |- appcontext[match ?E with end] => case E end.
Hint Resolve nil_cons.
Hint Extern 0 => match goal with H : S _ = 0 |- _ => destruct (Nat.neq_succ_0 _ H) end.
Hint Extern 0 => match goal with H : 0 = S _ |- _ => destruct (Nat.neq_0_succ _ H) end.
Hint Extern 0 => match goal with H : ?x < ?x |- _ => destruct (@lt_irrefl _ H) end.

Lemma eq_list_nil_dec {T} (l : list T) : {l = []} + {l <> []}.
Proof.
  destruct l; [ left; reflexivity | right; abstract inversion 1 ].
Defined.

Class Total {T} (R : relation T) := totality : forall x y, R x y \/ R y x.

Class Decidable (P : Prop) := decide : {P} + {~P}.

Arguments decide _ {_}.

Infix "∈" := List.In (at level 40, no associativity).

Section dec.
  Local Hint Extern 0 => apply partial_order_antisym.
  Local Hint Extern 2 => symmetry.

  Local Ltac t :=
    progress repeat (intro
                       || destruct_sig
                       || destruct_head_hnf @sumbool
                       || destruct_head_hnf @or
                       || destruct_head_hnf @and
                       || destruct_head_hnf @ex
                       || subst
                       || intro
                       || eauto
                       || split
                       || left
                       || right).

  Local Obligation Tactic := try abstract t.

  Global Instance in_decidable {A} `{H : forall x y : A, Decidable (x = y)}
         a (l : list A)
  : Decidable (a ∈ l)
    := in_dec H a l.

  Global Program Instance and_decidable `{a : Decidable A, b : Decidable B}
  : Decidable (A /\ B)
    := match a, b with
         | left a', left b' => left (conj a' b')
         | right a', _ => right _
         | _, right b' => right _
       end.
  Global Program Instance or_decidable `{a : Decidable A, b : Decidable B}
  : Decidable (A \/ B)
    := match a, b with
         | left a', _ => left (or_introl a')
         | _, left b' => left (or_intror b')
         | right a', right b' => right _
       end.
  Global Program Instance not_decidable `{a : Decidable A} : Decidable (~A)
    := match a with
         | left a' => right _
         | right a' => left _
       end.
  Fixpoint ex_in_list_decidable {A P}
         `{in_dec : forall (a : A) ls, Decidable (a ∈ ls)}
         `{P_dec : forall a : A, Decidable (P a)}
         (ls : list A)
  : Decidable (exists a, a ∈ ls /\ P a).
  Proof.
    refine match ls as ls return {exists a, a ∈ ls /\ P a} + {~exists a, a ∈ ls /\ P a} with
             | nil => right _
             | x::xs => match P_dec x with
                          | left Px => left (ex_intro _ x _)
                          | right H0 => match @ex_in_list_decidable A P in_dec P_dec xs with
                                          | left exa => left (match exa with
                                                                | ex_intro x Hx => ex_intro _ x _
                                                              end)
                                          | right H1 => right _
                                        end
                        end
           end;
    clear ex_in_list_decidable P_dec in_dec ls; abstract t.
  Defined.
  Global Existing Instance ex_in_list_decidable.

  Local Obligation Tactic :=
    try abstract (t; do 2 apply_hyp'; eauto).

  Global Program Instance eqv_partial_order_decidable
         `{@PartialOrder A eqA eqvA R preo}
         x y
         `{Proper _ (eqA ==> eqA ==> impl)%signature R}
         `{H0 : Decidable (R x y), H1 : Decidable (R y x)}
  : Decidable (eqA x y)
    := match H0, H1 with
         | left _, left _ => left _
         | right _, _ => right _
         | _, right _ => right _
       end.
End dec.

Instance le_total : Total le.
Proof.
  intros x y.
  destruct (le_lt_dec x y); [ left; assumption | right ].
  etransitivity; try eassumption; hnf; auto with arith.
Defined.

Lemma total_decidable_neg_flip `{Total T R, forall x y, Decidable (R x y)} x y
: ~R x y -> R y x.
Proof.
  intro HR.
  destruct (decide (R y x)); trivial.
  exfalso; destruct (totality x y); auto.
Qed.

Hint Extern 2 => match goal with H : ~?R ?x ?y |- _ => unique pose proof (@total_decidable_neg_flip _ R _ _ x y H); try clear H end.


(*
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

Require Import String.
Require Import List.
Require Import Sumbool.
Require Import Arith.
Require Import Bool.
Require Import EquivDec.
Require Import Utils.
Require Import BrandRelation.
Require Import ForeignData.
Require Import Data.

Section DataNorm.
  Context {fdata:foreign_data}.
  Context (h:brand_relation_t).
  Fixpoint normalize_data (d:data) : data :=
    match d with
    | drec rl =>
      drec (rec_sort (map (fun x => (fst x, normalize_data (snd x))) rl))
    | dcoll l => dcoll (map normalize_data l)
    | dleft l => dleft (normalize_data l)
    | dright l  => dright (normalize_data l)
    | dbrand b d => dbrand (canon_brands h b) (normalize_data d)
    | dforeign fd => dforeign (foreign_data_normalize fd)
    | _ => d
    end.

  Inductive data_normalized : data -> Prop :=
  | dnunit :
      data_normalized dunit
  | dnnat n :
      data_normalized (dnat n)
  | dnfloat n :
      data_normalized (dfloat n)
  | dnbool b :
      data_normalized (dbool b)
  | dnstring s :
      data_normalized (dstring s)
  | dncoll dl :
      Forall (fun x => data_normalized x) dl -> data_normalized (dcoll dl)
  | dnrec dl :
      Forall (fun d => data_normalized (snd d)) dl ->
      (is_list_sorted ODT_lt_dec (domain dl) = true) ->
      data_normalized (drec dl)
  | dnleft l :
      data_normalized l ->
      data_normalized (dleft l)
  | dnright r :
      data_normalized r ->
      data_normalized (dright r)
  | dnbrand b d :
      is_canon_brands h b ->
      data_normalized d ->
      data_normalized (dbrand b d)
  | dnforeign fd :
      foreign_data_normalized fd ->
      data_normalized (dforeign fd).

  Theorem normalize_normalizes :
    forall (d:data), data_normalized (normalize_data d).
  Proof.
    induction d using dataInd2; simpl.
    - apply dnunit.
    - apply dnnat.
    - apply dnfloat.
    - apply dnbool.
    - apply dnstring.
    - apply dncoll.
      apply Forall_forall; intros.
      induction c; elim H0; intros.
      rewrite <- H1.
      apply (H a); left; reflexivity.
      assert (forall x:data, In x c -> data_normalized (normalize_data x))
        by (intros; apply (H x0); right; assumption).
      specialize (IHc H2 H1).
      assumption.
    - apply dnrec.
      + apply Forall_sorted.
        apply Forall_forall; intros.
        induction r.
        contradiction.
        simpl in *.
        elim H0; intros; clear H0.
        rewrite <- H1.
        simpl.
        apply (H (fst a) (snd a)).
        left; destruct a; reflexivity.
        assert (forall (x : string) (y : data),
                   In (x, y) r -> data_normalized (normalize_data y)); intros.
        apply (H x0 y); right; assumption.
        apply (IHr H0).
        assumption.
      + apply (@rec_sort_sorted string ODT_string) with (l1 := (map (fun x : string * data => (fst x, normalize_data (snd x))) r)).
        reflexivity.
    - constructor; trivial.
    - constructor; trivial.
    - constructor; qtrivial.
    - constructor.
      apply foreign_data_normalize_normalizes.
  Qed.

  Theorem normalize_normalized_eq {d}:
    data_normalized d ->
    normalize_data d = d.
  Proof.
    induction d using dataInd2; simpl; trivial.
    - intros.
      rewrite (@map_eq _ _ normalize_data id).
      + rewrite map_id; trivial.
      + inversion H0; simpl; subst.
        revert H2. apply Forall_impl_in.
        auto.
    - intros.
      inversion H0; subst.
      rewrite (@map_eq _ _ (fun x : string * data => (fst x, normalize_data (snd x))) id).
      + rewrite map_id.
        rewrite rec_sorted_id; trivial.
      + revert H2. apply Forall_impl_in.
        destruct a; unfold id; simpl; intros.
        f_equal; eauto.
    - inversion 1; subst. rewrite (IHd H1); trivial.
    - inversion 1; subst. rewrite (IHd H1); trivial.
    - inversion 1; subst.
      rewrite IHd; trivial.
      rewrite is_canon_brands_canon_brands; trivial.
    - inversion 1; subst.
      f_equal.
      apply foreign_data_normalize_idempotent.
      trivial.
  Qed.

  Lemma map_normalize_normalized_eq c :
    Forall (fun x => data_normalized (snd x)) c ->
    (map
       (fun x0 : string * data => (fst x0, normalize_data (snd x0)))
       c) = c.
  Proof.
    induction c; simpl; trivial.
    destruct a; inversion 1; simpl in *; subst.
    rewrite normalize_normalized_eq; trivial.
    rewrite IHc; trivial.
  Qed.

  Corollary normalize_idem d :
    normalize_data (normalize_data d) = normalize_data d.
  Proof.
    apply normalize_normalized_eq.
    apply normalize_normalizes.
  Qed.

  Corollary normalize_data_eq_normalized {d} :
    normalize_data d = d -> data_normalized d.
  Proof.
    intros.
    generalize (normalize_normalizes d).
    congruence.
  Qed.

  Theorem normalized_data_dec d : {data_normalized d} + {~ data_normalized d}.
  Proof.
    destruct (normalize_data d == d); unfold equiv, complement in *.
    - left. apply normalize_data_eq_normalized; trivial.
    - right. intro dn; elim c. apply normalize_normalized_eq; trivial.
  Defined.

  Lemma data_normalized_dcoll a l :
    (data_normalized a /\ data_normalized (dcoll l)) <->
    data_normalized (dcoll (a :: l)).
  Proof.
    split.
    - destruct 1 as [d1 d2]. inversion d2; subst.
      constructor; auto.
    - inversion 1; subst. inversion H1; subst.
      split; trivial.
      constructor; auto.
  Qed.

  Lemma data_normalized_rec_sort_app l1 l2 :
    data_normalized (drec l1) ->
    data_normalized (drec l2) ->
    data_normalized (drec (rec_sort (l1 ++ l2))).
  Proof.
    inversion 1; inversion 1; subst.
    constructor; eauto 1 with qcert.
    apply Forall_sorted.
    apply Forall_app; qtrivial.
  Qed.

  Lemma data_normalized_rec_concat_sort l1 l2 :
    data_normalized (drec l1) ->
    data_normalized (drec l2) ->
    data_normalized (drec (rec_concat_sort l1 l2)).
  Proof.
    apply data_normalized_rec_sort_app.
  Qed.

  Lemma data_normalized_dcoll_in x l :
    In x l ->
    data_normalized (dcoll l) ->
    data_normalized x.
  Proof.
    inversion 2; subst.
    rewrite Forall_forall in H2.
    eauto.
  Qed.

  Lemma dnrec_nil : data_normalized (drec nil).
  Proof.
    econstructor; trivial.
  Qed.

  Lemma dnrec_sort_content c :
    Forall (fun d : string * data => data_normalized (snd d)) c ->
    Forall (fun d : string * data => data_normalized (snd d)) (rec_sort c).
  Proof.
    intros F.
    apply Forall_sorted; trivial.
  Qed.

  Lemma dnrec_sort c :
    Forall (fun d : string * data => data_normalized (snd d)) c ->
    data_normalized (drec (rec_sort c)).
  Proof.
    intros F; econstructor; trivial with qcert.
    apply Forall_sorted; trivial.
  Qed.

  Lemma data_normalized_dcoll_Forall l :
    data_normalized (dcoll l) <-> Forall data_normalized l.
  Proof.
    split; intros H.
    - invcs H; trivial.
    - constructor; trivial.
  Qed.

  Lemma normalize_data_forall_ndbool d :  (forall b, d <> dbool b) -> (forall b, normalize_data d <> dbool b).
  Proof.
    destruct d; simpl; intuition discriminate.
  Qed.

  Lemma normalize_data_forall_ndnat d :  (forall n, d <> dnat n) -> (forall n, normalize_data d <> dnat n).
  Proof.
    destruct d; simpl; intuition discriminate.
  Qed.

  Lemma normalize_data_forall_ndstring d :  (forall s, d <> dstring s) -> (forall s, normalize_data d <> dstring s).
  Proof.
    destruct d; simpl; intuition discriminate.
  Qed.

  Lemma normalize_data_forall_ndcoll d :  (forall c, d <> dcoll c) -> (forall c, normalize_data d <> dcoll c).
  Proof.
    destruct d; simpl; intuition try discriminate.
    apply (H _ (eq_refl _)).
  Qed.

  Lemma normalize_data_dbool d b : normalize_data d = dbool b <-> d = dbool b.
  Proof.
    destruct d; simpl; intuition discriminate.
  Qed.

End DataNorm.


Require Import HoareDef STB CannonRA Cannon0 Cannon1 SimModSem.
Require Import Coqlib.
Require Import ImpPrelude.
Require Import Skeleton.
Require Import PCM.
Require Import ModSem Behavior.
Require Import HTactics ProofMode.

Set Implicit Arguments.

Section SIMMODSEM.

  Context `{Σ: GRA.t}.
  Context `{@GRA.inG CannonRA Σ}.

  Let W: Type := Any.t * Any.t.

  Variable GlobalStb: Sk.t -> gname -> option fspec.

  Let wf: _ -> W -> Prop :=
    @mk_wf
      _
      unit
      (fun _ st_src st_tgt => ((⌜st_src = (1: Z)↑ /\ st_tgt = (1: Z)↑⌝ ** OwnM (Ready))
                               ∨ OwnM (Fired))%I)
  .

  Theorem correct: refines2 [Cannon0.Cannon] [Cannon1.Cannon GlobalStb].
  Proof.
    eapply adequacy_local2. econs; ss.
    i. econstructor 1 with (wf:=wf) (le:=top2); et; ss; cycle 1.
    { exists tt. red. econs. eapply to_semantic.
      iIntros "H". iLeft. iSplitR; ss. }
    econs; ss. init. unfold Cannon0.fire_body, Cannon1.fire_body. harg.
    mDesOr "INV".
    { mDesAll. des; clarify.
      steps. hret _; ss.
      iModIntro. iSplit; ss. iRight.
      iCombine "A" "A1" as "A".
      iEval (rewrite ReadyBall) in "A". ss.
    }
    { mDesAll. mAssertPure False; ss.
      iCombine "INV" "A" as "A". iOwnWf "A".
      exfalso. eapply FiredBall. et. }
    Unshelve. all: ss. all: try exact 0.
  Qed.

End SIMMODSEM.


Require Import Coq.Relations.Relation_Operators.
Require Import Logic.GeneralLogic.KripkeModel.
Require Import Logic.SeparationLogic.Model.SeparationAlgebra.
Require Import Logic.HoareLogic.ImperativeLanguage.
Require Import Logic.HoareLogic.ProgramState.

Local Open Scope kripke_model.
Import KripkeModelNotation_Intuitionistic.

Class BigStepSemantics (P: ProgrammingLanguage) (state: Type): Type := {
  access: state -> cmd -> MetaState state -> Prop
}.

Class NormalBigStepSemantics (P: ProgrammingLanguage) (state: Type) (BBS: BigStepSemantics P state): Type := {
  access_defined: forall s c, exists ms, access s c ms
}.

Definition lift_access
          {P: ProgrammingLanguage}
          {state: Type}
          {BSS: BigStepSemantics P state}
          (ms1: MetaState state)
          (c: cmd)
          (ms2: MetaState state): Prop :=
  lift_relation (fun s => access s c) ms1 ms2.

Definition safe
           {P: ProgrammingLanguage}
           {state: Type}
           {BSS: BigStepSemantics P state}
           (s: state)
           (c: cmd):
  Prop :=
  ~ access s c Error.

Definition term_norm
           {P: ProgrammingLanguage}
           {state: Type}
           {BSS: BigStepSemantics P state}
           (s: state)
           (c: cmd):
  Prop :=
  ~ access s c Error /\ ~ access s c NonTerminating.

Class SABigStepSemantics (P: ProgrammingLanguage) (state: Type) {J: Join state} {state_R: Relation state} (BSS: BigStepSemantics P state): Type := {
  frame_property: forall m mf m' c n', join m mf m' -> access m' c n' -> exists n nf, mf <= nf /\ lift_join n (Terminating nf) n' /\ access m c n
}.

Module ImpBigStepSemantics (F: FORWARD).

Export F.

Inductive loop_access_fin
          {state: Type}
          {state_R: Relation state}
          (R: state -> MetaState state -> Prop)
          (test: state -> Prop): state -> MetaState state -> Prop :=
| loop_access_Terminating:
    forall s1 ms2,
      ~ test s1 ->
      forward (Terminating s1) ms2 ->
      loop_access_fin R test s1 ms2
| loop_access_abnormal:
    forall s1 ms2 ms3,
      test s1 ->
      forward (Terminating s1) ms2 ->
      lift_relation R ms2 ms3 ->
      ms3 = Error \/ ms3 = NonTerminating ->
      loop_access_fin R test s1 ms3
| loop_access_step:
    forall s1 s2 s3 s4 ms,
      test s1 ->
      s1 <= s2 ->
      R s2 (Terminating s3) ->
      s3 <= s4 ->
      loop_access_fin R test s4 ms ->
      loop_access_fin R test s1 ms.

Inductive loop_access_inf
          {state: Type}
          {state_R: Relation state}
          (R: state -> MetaState state -> Prop)
          (test: state -> Prop): state -> Prop :=
| loop_access_inf_NonTerminating:
    forall (s1 s2 s3: nat -> state),
      (forall n, test (s1 n)) ->
      (forall n, s1 n <= s2 n) ->
      (forall n, R (s2 n) (Terminating (s3 n))) ->
      (forall n, s3 n <= s1 (S n)) ->
      loop_access_inf R test (s1 0).

Class ImpBigStepSemantics (P: ProgrammingLanguage) {iP: ImperativeProgrammingLanguage P} (state: Type) {state_R: Relation state} (BSS: BigStepSemantics P state): Type := {
  eval_bool: state -> bool_expr -> Prop;
  eval_bool_stable: forall b, Krelation_stable_Kdenote (fun s => eval_bool s b);
  access_Ssequence: forall c1 c2 s ms,
    access s (Ssequence c1 c2) ms ->
    exists ms' ms'',
      access s c1 ms' /\ forward ms' ms'' /\ lift_access ms'' c2 ms;
  access_Sifthenelse: forall b c1 c2 s ms,
    access s (Sifthenelse b c1 c2) ms ->
    (eval_bool s b /\ exists ms', forward (Terminating s) ms' /\ lift_access ms' c1 ms) \/
    (~ eval_bool s b /\ exists ms', forward (Terminating s) ms' /\ lift_access ms' c2 ms);
  access_Swhile: forall b c s ms,
    access s (Swhile b c) ms ->
    (loop_access_fin (fun s ms => access s c ms) (fun s => eval_bool s b) s ms) \/
    (loop_access_inf (fun s ms => access s c ms) (fun s => eval_bool s b) s /\ ms = NonTerminating)
}.

End ImpBigStepSemantics.

Module Total := ImpBigStepSemantics (ProgramState.Total).

Module Partial := ImpBigStepSemantics (ProgramState.Partial).

Instance Total2Partial_ImpBigStepSemantics {P: ProgrammingLanguage} {iP: ImperativeProgrammingLanguage P} (state: Type) {state_R: Relation state} {BSS: BigStepSemantics P state} (iBSS: Total.ImpBigStepSemantics P state BSS): Partial.ImpBigStepSemantics P state BSS.
Proof.
  refine (Partial.Build_ImpBigStepSemantics _ _ _ _ _ Total.eval_bool Total.eval_bool_stable _ _ _).
  + intros.
    pose proof Total.access_Ssequence c1 c2 s ms H
      as [ms' [ms'' [? [? ?]]]].
    exists ms', ms''; split; [| split]; auto.
    apply Total2Partial_forward; auto.
  + intros.
    pose proof Total.access_Sifthenelse b c1 c2 s ms H
      as [[? [ms' [? ?]]] | [? [ms' [? ?]]]].
    - left; split; auto; exists ms'; split; auto.
      apply Total2Partial_forward; auto.
    - right; split; auto; exists ms'; split; auto.
      apply Total2Partial_forward; auto.
  + intros.
    pose proof Total.access_Swhile b c s ms H.
    destruct H0 as [? | [? ?]].
    - left.
      clear H; induction H0.
      * apply Partial.loop_access_Terminating; auto.
        apply Total2Partial_forward; auto.
      * eapply Partial.loop_access_abnormal; eauto.
        apply Total2Partial_forward; auto.
      * apply (Partial.loop_access_step _ _ s1 s2 s3 s4); eauto.
    - right; split; auto.
      clear ms H1 H.
      inversion H0; subst.
      econstructor; eauto.
Defined.


(* Cyclone Semantics using TLC/LN in Coq Version 4 *)
(* "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".   Daniel Grossman, August 2003 *)
(* Definitions from Section 3.5.1 *)
(* Brian Milnes 2016 *)

Set Implicit Arguments.
Require Export Cyclone_Formal_Syntax Cyclone_LN_Types_In_Terms Cyclone_Dynamic_Semantics_Heap_Objects.
Require List.
Close Scope list_scope.
Import LibEnvNotations.

Inductive S : Heap -> St -> Heap -> St -> Prop :=
(* BUG: is this LN right? *)
 | S_let_3_1 : forall (x : var) (v : E) (h : Heap) (s: St),
                 Value v ->
                 get x h = None ->
                 S h (letx v s) (h & (single x v)) (TM.open_rec_st 0 x s)

 | S_seq_3_2 : forall (v : E) (h : Heap) (s: St),
                  Value v ->
                  S h (seqx (e_s v) s) h s

 | S_return_3_3: forall (v : E) (h : Heap) (s: St),
                    Value v ->
                    S h (seqx (retn v) s) h (retn v)

 | S_if0_3_4: forall (h : Heap) (s1 s2: St),
                 S h (if_s (i_e (i_i 0)) s1 s2)
                   h s1

 | S_if_ne_0_3_5: forall (h : Heap) (z : nat) (s1 s2: St),
                     z <> 0 ->
                     S h (if_s (i_e (i_i z)) s1 s2)
                       h s2

 | S_while_3_6: forall (h : Heap) (e : E) (s : St),
                     S h (while e s)
                       h (if_s e (seqx s (while e s)) (e_s (i_e (i_i 0))))

 | S_open_3_7:  forall (tau tau' : Tau) (v : E) (p : Phi) (k : Kappa)
                       (h : Heap) (s : St),
                  Value v ->
                  S h (openx (pack tau' v (etype p k tau)) s)
                    h (letx v (TTM.open_rec_st 0 tau' s))

 | S_openstar_3_8: forall (tau tau' : Tau) (v v' : E) (x : var) (q : Phi) (k : Kappa)
                          (h : Heap) (s : St) (p : Path),
                    Value v ->
                    get x h = Some v' ->
                    get' v' p (pack tau' v (etype q k tau)) ->
                    (* S is part of the context not the heap, overloading ; in DS3.8 *)
                    (* x' is right, openstar uses *x' but I am eliding it in the syntax. *)
                    S h (openstar (p_e (fevar x) p) s)
                      h (letx  (amp (p_e (fevar x) (app p (cons u_pe nil))))
                                     (TTM.open_rec_st 0 tau s))

| S_exp_3_9_1: forall (h h' : Heap) (e e' : E),
                   R h  e h'  e' ->
                   S h (e_s e) h' (e_s e')

| S_ret_3_9_2: forall (h h' : Heap) (e e' : E),
                   R h  e h'  e' ->
                   S h (retn e) h' (retn e')

| S_if_3_9_3: forall (h h' : Heap) (e e' : E) (s1 s2 : St),
                   R h  e h'  e' ->
                   S h (if_s e s1 s2) h' (if_s e' s1 s2)

| S_letx_3_9_4: forall (h h' : Heap) (e e' : E) (s : St),
                   R h  e h'  e' ->
                   S h (letx e s) h' (letx e' s)

| S_open_3_9_5: forall (h h' : Heap) (e e' : E) (s : St),
                   R h  e h'  e' ->
                   S h  (openx e  s)
                     h' (openx e' s)

| S_seq_3_10:  forall (h h' : Heap) (s s' s2: St),
                    S h s h' s' ->
                    S h (seqx s  s2) h' (seqx s' s2)

| S_openstar_3_11: forall (h h' : Heap) (e e' : E) (s : St),
                        L h   e h'  e' ->
                        S h  (openstar e  s)
                          h' (openstar e' s)
with R : Heap -> E -> Heap -> E -> Prop :=
 | R_get_3_1 : forall (h  : Heap) (x : var) (p : Path) (v v' : E),
                    get x h = Some v' ->
                    get' v' p v ->
                    Value v ->
                    Value v' ->
                    R h (p_e (fevar x) p)
                      h v
 | R_assign_3_2:
     forall (h : Heap) (v v' v'' : E) (x : var) (p : Path),
       get x h = Some v' ->
       set' v' p v v'' ->
       Value v   ->
       Value v'  ->
       Value v'' ->
       R h  (assign (p_e (fevar x) p) v)
         (h & (single x v'')) v

 | R_initial_assign_3_2:
     forall (h : Heap) (v : E) (x : var),
       get x h = None ->
       Value v   ->
       R h  (assign (p_e (fevar x) nil) v)
         (h & (single x v)) v

 | R_star_amp_3_3:
                 forall (h : Heap) (v : var) (p : Path),
                   R h (star (amp (p_e (fevar v)  p)))
                     h (p_e (fevar v) p)

 (* Split on 0 or 1. *)
 | R_dot_3_4_0:  forall (h : Heap) (v0 v1 : E),
                    R h (dot (cpair v0 v1) zero_pe)
                      h v0

 | R_dot_3_4_1:  forall (h : Heap) (v0 v1 : E),
                    R h (dot (cpair v0 v1) one_pe)
                      h v1

 | R_appl_3_5:   forall (h : Heap) (tau tau' : Tau) (v : E) (s : St),
                    Value v ->
                    R h (appl (f_e (dfun tau tau' s)) v)
                      h (call (letx v s))

 | R_call_3_6:    forall (h : Heap) (v : E),
                    Value v ->
                    R h (call (retn v))
                      h v

 | R_inst_3_7:  forall (h : Heap) (k : Kappa) (f : F) (tau : Tau),
                  R h (inst (f_e (ufun k f)) tau)
                    h (f_e (TTM.open_rec_f 0 tau f))

 | R_call_3_8:  forall (h h': Heap) (s s': St),
                  S h s h' s' ->
                  R h (call s) h' (call s')

 | R_amp_3_9_1: forall (h h' : Heap) (e e' : E),
                   L h e       h' e' ->
                   R h (amp e) h' (amp e')

 | R_assign_3_9_2: forall (h h' : Heap) (e e' e2: E),
                   L h e             h' e' ->
                   R h (assign e e2) h' (assign e' e2)

 | R_star_3_10_1: forall (h h' : Heap) (e e' : E),
                    R h e        h' e' ->
                    R h (star e) h' (star e')

 | R_dot_3_10_2: forall (h h' : Heap) (e e' : E) (ipe : IPE),
                    R h e h' e' ->
                    R h  (dot e  ipe) h' (dot e' ipe)

 | R_assign_3_10_3: forall (h h' : Heap) (e e' : E) (x : V) (p : Path),
                    R h e h' e' ->
                    R h  (assign (p_e x p) e)
                      h' (assign (p_e x p) e')

 | R_inst_3_10_4:  forall (h h' : Heap) (e e' : E) (tau : Tau),
                 R h e h' e' ->
                 R h  (inst e tau) h' (inst e' tau)

 | R_pack_3_10_5:  forall (h h' : Heap) (e e' : E) (tau tau' : Tau) (p : Phi) (k : Kappa),
                    R h  e        h'  e' ->
                    R h   (pack tau' e  (etype p k tau))
                      h'  (pack tau' e' (etype p k tau))

 | R_cpair_3_10_6:  forall (h h' : Heap) (e e' e2 : E),
                    R h  e h'  e' ->
                    R h   (cpair e e2)
                      h'  (cpair e' e2)

 | R_cpair_3_10_7:  forall (h h' : Heap) (e e' v : E),
                    Value v ->
                    R h  e h'  e' ->
                    R h   (cpair v e)
                      h'  (cpair v e')

 | R_cpair_3_10_8:  forall (h h' : Heap) (e e' e2 : E),
                    R h  e h'  e' ->
                    R h   (cpair e e2)
                      h'  (cpair e' e2)

 | R_appl_3_10_9:  forall (h h' : Heap) (e e' e2 : E),
                    R h   e h'  e' ->
                    R h   (appl e e2)
                      h'  (appl e' e2)

 | R_appl_3_10_10: forall (h h' : Heap) (v e e': E),
                     Value v ->
                     R h   e h'  e' ->
                     R h   (appl v e)
                       h'  (appl v e')

with L : Heap -> E -> Heap -> E -> Prop :=
 | L_xpi_3_1: forall (h : Heap) (x : var) (p : Path) (ipe : IPE),
                L h  (dot (p_e (fevar x) p) ipe)
                  h  (p_e (fevar x) (app p (cons (i_pe ipe) nil)))

 | L_staramp_3_2: forall (h : Heap) (x : V) (p : Path),
                    L h  (star (amp (p_e x p)))
                      h  (p_e x p)

 | L_star_3_3: forall (h h' : Heap) (e e': E),
                 R h  e        h'  e' ->
                 L h  (star e) h'  (star e')

 | L_ei_3_4: forall (h h' : Heap) (e e': E) (ipe : IPE),
               L h  e                h'  e' ->
               L h  (dot e ipe)  h'  (dot e' ipe).

Scheme S_ind_mutual := Induction for S Sort Prop
with   R_ind_mutual := Induction for R Sort Prop
with   L_ind_mutual := Induction for L Sort Prop.

Combined Scheme SRL_ind_mutual
         from S_ind_mutual, R_ind_mutual, L_ind_mutual.
(* Auto is not applying some of the rules. *)
Hint Constructors S.
Hint Constructors R.
Hint Constructors L.

Hint Extern 4 (S _ _ _ _) => (* idtac "(S _ _ _ _)";*) trace_goal; constructors~.
Hint Extern 4 (R _ _ _ _) => (* idtac "(R _ _ _ _)";*) trace_goal; constructors~.
Hint Extern 4 (L _ _ _ _) => (* idtac "(L _ _ _ _)";*) trace_goal; constructors~.
Hint Extern 4 (R _ (e_s (p_e (fevar _) _)) _ (e_s _)) => (* idtac "(R _ (e_s (p_e (fevar _) _)) _ (e_s _))";*) trace_goal; applys~ R_get_3_1.


Require Import Verdi.Verdi.
Require Import Verdi.HandlerMonad.
Require Import Verdi.NameOverlay.
Require Import Verdi.LabeledNet.

Require Import NameAdjacency.
Require Import FailureRecorderStaticLabeled.

Require Import InfSeqExt.infseq.
Require Import InfSeqExt.classical.

Require Import Sumbool.
Require Import MSetFacts.
Require Import MSetProperties.

Require Import mathcomp.ssreflect.ssreflect.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

Set Implicit Arguments.

Module FailureRecorderCorrect (Import NT : NameType)
 (NOT : NameOrderedType NT) (NSet : MSetInterface.S with Module E := NOT)
 (Import ANT : AdjacentNameType NT) (Import A : Adjacency NT NOT NSet ANT).

Module FR := FailureRecorder NT NOT NSet ANT A.
Import FR.

Module NSetFacts := Facts NSet.
Module NSetProps := Properties NSet.
Module NSetOrdProps := OrdProperties NSet.

Lemma Failure_node_not_adjacent_self :
forall net failed tr n,
 step_ordered_failure_star step_ordered_failure_init (failed, net) tr ->
 ~ In n failed ->
 ~ NSet.In n (onwState net n).(adjacent).
Proof.
move => net failed tr n H.
remember step_ordered_failure_init as y in *.
have ->: failed = fst (failed, net) by [].
have ->: net = snd (failed, net) by [].
move: Heqy.
induction H using refl_trans_1n_trace_n1_ind => H_init /=.
  rewrite H_init /step_ordered_failure_init /=.
  move => H_f.
  exact: not_adjacent_self.
move => H_f.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; rewrite /=.
- find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  rewrite /update /=.
  case name_eq_dec => H_dec /=; last exact: IHrefl_trans_1n_trace1.
  rewrite -H_dec in H3.
  net_handler_cases.
  find_apply_lem_hyp NSet.remove_spec.
  by break_and.
- by find_apply_lem_hyp input_handlers_IOHandler.
- exact: IHrefl_trans_1n_trace1.
Qed.

Lemma Failure_self_channel_empty :
forall onet failed tr,
 step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
 forall n, ~ In n failed ->
   onet.(onwPackets) n n = [].
Proof.
move => onet failed tr H.
have H_eq_f: failed = fst (failed, onet) by [].
have H_eq_o: onet = snd (failed, onet) by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in *.
move: Heqy.
induction H using refl_trans_1n_trace_n1_ind => H_init {failed}; first by rewrite H_init /step_ordered_failure_init /=.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /= /update2.
  case (sumbool_and _ _ _ _) => H_dec; last exact: IHrefl_trans_1n_trace1.
  move: H_dec => [H_dec H_dec'].
  rewrite H_dec H_dec' in H2.
  by rewrite IHrefl_trans_1n_trace1 in H2.
- by find_apply_lem_hyp input_handlers_IOHandler.
- move => n H_in.
  rewrite collate_neq.
  apply: IHrefl_trans_1n_trace1.
    move => H_in'.
    case: H_in.
    by right.
  move => H_eq.
  by case: H_in; left.
Qed.

Lemma Failure_not_failed_no_fail :
forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
  ~ In n failed ->
  ~ In Fail (onet.(onwPackets) n n').
Proof.
move => onet failed tr H.
have H_eq_f: failed = fst (failed, onet) by [].
have H_eq_o: onet = snd (failed, onet) by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in *.
move: Heqy.
induction H using refl_trans_1n_trace_n1_ind => H_init {failed}; first by rewrite H_init /step_ordered_failure_init /=.
concludes.
move => n n' H_in.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  simpl in *.
  contradict H4.
  have H_in' := IHrefl_trans_1n_trace1 _ n' H_in.
  rewrite /update2 /=.
  case (sumbool_and _ _ _ _) => H_dec //.
  move: H_dec => [H_eq H_eq'].
  rewrite H_eq H_eq' in H2.
  rewrite H2 in H_in'.
  move => H_inn.
  case: H_in'.
  by right.
- by find_apply_lem_hyp input_handlers_IOHandler.
- rewrite /= in H_in.
  have H_neq: h <> n by move => H_eq; case: H_in; left.
  have H_f: ~ In n failed by move => H_in''; case: H_in; right.
  rewrite collate_neq //.
  exact: IHrefl_trans_1n_trace1.
Qed.

Section SingleNodeInv.

Variable onet : ordered_network.

Variable failed : list name.

Variable tr : list (name * (input + output)).

Hypothesis H_step : step_ordered_failure_star step_ordered_failure_init (failed, onet) tr.

Variable n : name.

Hypothesis not_failed : ~ In n failed.

Variable P : Data -> Prop.

Hypothesis after_init : P (InitData n).

Hypothesis recv_fail :
  forall onet failed tr n',
    step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
    ~ In n failed ->
    P (onet.(onwState) n) ->
    P (mkData (NSet.remove n' (onet.(onwState) n).(adjacent))).

Theorem P_inv_n : P (onwState onet n).
Proof.
move: onet failed tr H_step not_failed.
clear onet failed not_failed tr H_step.
move => onet' failed' tr H'_step.
have H_eq_f: failed' = fst (failed', onet') by [].
have H_eq_o: onet' = snd (failed', onet') by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in H'_step.
move: Heqy.
induction H'_step using refl_trans_1n_trace_n1_ind => /= H_init.
  rewrite H_init /step_ordered_init /= => H_in_f.
  exact: after_init.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- move => H_in_f.
  find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /update /=.
  case name_eq_dec => H_dec //.
  repeat find_rewrite.
  destruct d.
  simpl in *.
  aggressive_rewrite_goal.
  exact: (recv_fail _ H'_step1).
- by find_apply_lem_hyp input_handlers_IOHandler.
- move => H_in_f.
  apply: IHH'_step1.
  move => H'_in_f.
  case: H_in_f.
  by right.
Qed.

End SingleNodeInv.

Section SingleNodeInvOut.

Variable onet : ordered_network.

Variable failed : list name.

Variable tr : list (name * (input + output)).

Hypothesis H_step : step_ordered_failure_star step_ordered_failure_init (failed, onet) tr.

Variables n n' : name.

Hypothesis not_failed : ~ In n failed.

Variable P : Data -> list msg -> Prop.

Hypothesis after_init : P (InitData n) [].

Hypothesis recv_fail_from_eq :
  forall onet failed tr ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  ~ In n failed ->
  In n' failed ->
  n' <> n ->
  onet.(onwPackets) n' n = Fail :: ms ->
  P (onet.(onwState) n) (onet.(onwPackets) n n') ->
  P (mkData (NSet.remove n' (onet.(onwState) n).(adjacent))) (onet.(onwPackets) n n').

Hypothesis recv_fail_from_neq :
  forall onet failed tr from ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  ~ In n failed ->
  In from failed ->
  from <> n ->
  from <> n' ->
  onet.(onwPackets) from n = Fail :: ms ->
  P (onet.(onwState) n) (onet.(onwPackets) n n') ->
  P (mkData (NSet.remove from (onet.(onwState) n).(adjacent))) (onet.(onwPackets) n n').

Theorem P_inv_n_out : P (onet.(onwState) n) (onet.(onwPackets) n n').
Proof.
move: onet failed tr H_step not_failed.
clear onet failed not_failed tr H_step.
move => onet' failed' tr H'_step.
have H_eq_f: failed' = fst (failed', onet') by [].
have H_eq_o: onet' = snd (failed', onet') by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2 3}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in H'_step.
move: Heqy.
induction H'_step using refl_trans_1n_trace_n1_ind => /= H_init.
  rewrite H_init /step_ordered_failure_init /= => H_in_f.
  exact: after_init.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- move => H_in_f.
  find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /update /=.
  case name_eq_dec => H_dec.
    rewrite -H_dec in H1 H6 H0.
    rewrite -H_dec /update2 /= {H_dec to H'_step2}.
    case (sumbool_and _ _ _ _) => H_dec.
      move: H_dec => [H_eq H_eq'].
      rewrite H_eq {H_eq from} in H6 H0.
      by rewrite (Failure_self_channel_empty H'_step1) in H0.
    case: d H6 => /=.
    move => adjacent0 H_eq.
    rewrite H_eq {adjacent0 H_eq}.
    case: H_dec => H_dec.
      case (name_eq_dec from n') => H_dec'.
        rewrite H_dec'.
        rewrite H_dec' in H0 H_dec.
        case (In_dec name_eq_dec n' failed) => H_in; first exact: (recv_fail_from_eq H'_step1 _ _ _ H0).
        have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in.
        rewrite H0 in H_inl.
        by case: H_inl; left.
      case (In_dec name_eq_dec from failed) => H_in; first exact: (recv_fail_from_neq H'_step1 _ _ _ _ H0).
      have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in.
      rewrite H0 in H_inl.
      by case: H_inl; left.
    case (name_eq_dec from n) => H_neq; first by rewrite H_neq (Failure_self_channel_empty H'_step1) in H0.
    case (name_eq_dec from n') => H_dec'.
      rewrite H_dec'.
      rewrite H_dec' in H0 H_dec.
      case (In_dec name_eq_dec n' failed) => H_in; first by apply: (recv_fail_from_eq H'_step1 _ _ _ H0) => //; auto.
      have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in.
      rewrite H0 in H_inl.
      by case: H_inl; left.
    case (In_dec name_eq_dec from failed) => H_in; first exact: (recv_fail_from_neq H'_step1 _ _ _ _ H0).
    have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in.
    rewrite H0 in H_inl.
    by case: H_inl; left.
  rewrite /update2 /=.
  case (sumbool_and _ _ _ _) => H_dec' //.
  move: H_dec' => [H_eq H_eq'].
  rewrite H_eq H_eq' in H0 H1 H5 H_dec.
  have H_f := Failure_not_failed_no_fail H'_step1 _ n' H_in_f.
  rewrite H0 in H_f.
  by case: H_f; left.
- by find_apply_lem_hyp input_handlers_IOHandler.
- move => H_in.
  have H_neq: h <> n by move => H_eq; case: H_in; left.
  have H_f: ~ In n failed by move => H_in'; case: H_in; right.
  rewrite collate_neq //.
  exact: IHH'_step1.
Qed.

End SingleNodeInvOut.

Section SingleNodeInvIn.

Variable onet : ordered_network.

Variable failed : list name.

Variable tr : list (name * (input + output)).

Hypothesis H_step : step_ordered_failure_star step_ordered_failure_init (failed, onet) tr.

Variables n n' : name.

Hypothesis not_failed : ~ In n failed.

Variable P : Data -> list msg -> Prop.

Hypothesis after_init : P (InitData n) [].

Hypothesis recv_fail_neq :
  forall onet failed tr ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  ~ In n failed ->
  In n' failed ->
  n <> n' ->
  onet.(onwPackets) n' n = Fail :: ms ->
  P (onet.(onwState) n) (onet.(onwPackets) n' n) ->
  P (mkData (NSet.remove n' (onet.(onwState) n).(adjacent))) ms.

Hypothesis recv_fail_other_neq :
  forall onet failed tr from ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  ~ In n failed ->
  n <> from ->
  n' <> from ->
  onet.(onwPackets) from n = Fail :: ms ->
  P (onet.(onwState) n) (onet.(onwPackets) n' n) ->
  P (mkData (NSet.remove from (onet.(onwState) n).(adjacent))) (onet.(onwPackets) n' n).

Hypothesis fail_adjacent :
  forall onet failed tr,
    step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
    n' <> n ->
    ~ In n failed ->
    ~ In n' failed ->
    adjacent_to n' n ->
    P (onet.(onwState) n) (onet.(onwPackets) n' n) ->
    P (onwState onet n) (onwPackets onet n' n ++ [Fail]).

Theorem P_inv_n_in : P (onet.(onwState) n) (onet.(onwPackets) n' n).
Proof.
move: onet failed tr H_step not_failed.
clear onet failed not_failed tr H_step.
move => onet' failed' tr H'_step.
have H_eq_f: failed' = fst (failed', onet') by [].
have H_eq_o: onet' = snd (failed', onet') by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2 3}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in H'_step.
move: Heqy.
induction H'_step using refl_trans_1n_trace_n1_ind => /= H_init.
  rewrite H_init /step_ordered_failure_init /= => H_in_f.
  exact: after_init.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- move => H_in_f.
  find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /update /=.
  case name_eq_dec => H_dec.
    rewrite -H_dec in H1 H6 H0.
    have H_neq: n <> from.
      move => H_eq.
      rewrite -H_eq in H0.
      by rewrite (Failure_self_channel_empty H'_step1) in H0.
    rewrite -H_dec /update2 /= {H_dec to H'_step2}.
    case (sumbool_and _ _ _ _) => H_dec.
      move: H_dec => [H_eq H_eq'].
      rewrite H_eq {H_eq from} in H0 H6 H_neq.
      case: d H6 => /= adjacent0 H_eq.
      rewrite H_eq {H_eq adjacent0}.
      case (In_dec name_eq_dec n' failed) => H_in; first exact: (recv_fail_neq H'_step1).
      have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in.
      rewrite H0 in H_inl.
      by case: H_inl; left.
    case: H_dec => H_dec //.
    case: d H6 => /= adjacent0 H_eq.
    rewrite H_eq {H_eq adjacent0}.
    apply: (recv_fail_other_neq H'_step1 _ _ _ H0) => //.
    move => H_neq'.
    by case: H_dec.
  rewrite /update2 /=.
  case (sumbool_and _ _ _ _) => H_dec' //.
  move: H_dec' => [H_eq H_eq'].
  by rewrite H_eq' in H_dec.
- by find_apply_lem_hyp input_handlers_IOHandler.
- move => H_in.
  have H_neq: h <> n by move => H_eq; case: H_in; left.
  have H_f: ~ In n failed by move => H_in'; case: H_in; right.
  case (name_eq_dec h n') => H_dec.
    rewrite H_dec in H0 H_neq H_f.
    rewrite H_dec {H_dec h H'_step2 H_in}.
    case (adjacent_to_dec n' n) => H_dec.
      rewrite collate_map2snd_not_in_related //.
      * apply (fail_adjacent H'_step1) => //.
        exact: IHH'_step1.
      * exact: all_names_nodes.
      * exact: no_dup_nodes.
    rewrite collate_map2snd_not_related //.
    exact: IHH'_step1.
  rewrite collate_neq //.
  exact: IHH'_step1.
Qed.

End SingleNodeInvIn.

Section DualNodeInv.

Variable onet : ordered_network.

Variable failed : list name.

Variable tr : list (name * (input + output)).

Hypothesis H_step : step_ordered_failure_star step_ordered_failure_init (failed, onet) tr.

Variables n n' : name.

Hypothesis not_failed_n : ~ In n failed.

Hypothesis not_failed_n' : ~ In n' failed.

Variable P : Data -> Data -> list msg -> list msg -> Prop.

(* FIXME *)
Hypothesis after_init : P (InitData n) (InitData n') [] [].

Hypothesis recv_fail_self :
  forall onet failed tr from ms,
    step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
    n' = n ->
    ~ In n failed ->
    onet.(onwPackets) from n = Fail :: ms ->
    n <> from ->
    P (onet.(onwState) n) (onet.(onwState) n) (onet.(onwPackets) n n) (onet.(onwPackets) n n) ->
    P (mkData (NSet.remove from (onet.(onwState) n).(adjacent)))
      (mkData (NSet.remove from (onet.(onwState) n).(adjacent)))
      (onet.(onwPackets) n n) (onet.(onwPackets) n n).

Hypothesis recv_fail_other :
  forall onet failed tr from ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
    ~ In n failed ->
    ~ In n' failed ->
    onet.(onwPackets) from n = Fail :: ms ->
    n <> n' ->
    from <> n ->
    from <> n' ->
    P (onet.(onwState) n) (onet.(onwState) n') (onet.(onwPackets) n n') (onet.(onwPackets) n' n) ->
    P (mkData (NSet.remove from (onet.(onwState) n).(adjacent))) (onet.(onwState) n')
      (onet.(onwPackets) n n') (onet.(onwPackets) n' n).

Hypothesis recv_other_fail :
  forall onet failed tr from ms,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
    ~ In n failed ->
    ~ In n' failed ->
    onet.(onwPackets) from n' = Fail :: ms ->
    n <> n' ->
    from <> n ->
    from <> n' ->
    P (onet.(onwState) n) (onet.(onwState) n') (onet.(onwPackets) n n') (onet.(onwPackets) n' n) ->
    P (onet.(onwState) n) (mkData (NSet.remove from (onet.(onwState) n').(adjacent)))
      (onet.(onwPackets) n n') (onet.(onwPackets) n' n).

Theorem P_dual_inv : P (onet.(onwState) n) (onet.(onwState) n') (onet.(onwPackets) n n') (onet.(onwPackets) n' n).
Proof.
move: onet failed tr H_step not_failed_n not_failed_n'.
clear onet failed not_failed_n not_failed_n' tr H_step.
move => onet' failed' tr H'_step.
have H_eq_f: failed' = fst (failed', onet') by [].
have H_eq_o: onet' = snd (failed', onet') by [].
rewrite H_eq_f {H_eq_f}.
rewrite {3 4 5 6}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in H'_step.
move: Heqy.
induction H'_step using refl_trans_1n_trace_n1_ind => /= H_init.
  rewrite H_init /step_ordered_failure_init /= => H_in_f H_in_f'.
  exact: after_init.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- rewrite /= in IHH'_step1.
  move {H'_step2}.
  move => H_in_f H_in_f'.
  find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /update /=.
  case name_eq_dec => H_dec_n.
    rewrite -H_dec_n.
    rewrite -H_dec_n {H_dec_n to} in H6 H7 H1 H0.
    case name_eq_dec => H_dec_n'.
      rewrite H_dec_n'.
      rewrite H_dec_n' in H_in_f' H7.
      rewrite /update2.
      case (sumbool_and _ _ _ _) => H_dec.
        move: H_dec => [H_eq H_eq'].
        rewrite H_eq in H0.
        by rewrite (Failure_self_channel_empty H'_step1) in H0.
      case: H_dec => H_dec //.
      case: d H6 => /= adjacent0 H_eq.
      rewrite H_eq {H_eq adjacent0}.
      apply (recv_fail_self H'_step1 H_dec_n' H1 H0) => //.
      move => H_neq.
      by rewrite H_neq in H_dec.
    case: d H6 => /= adjacent0 H_eq.
    rewrite H_eq {H_eq adjacent0}.
    rewrite /update2 /=.
    case (sumbool_and _ _ _ _) => H_dec; case (sumbool_and _ _ _ _) => H_dec'.
    * move: H_dec => [H_eq_n H_eq_n'].
      by rewrite H_eq_n' in H_dec_n'.
    * move: H_dec => [H_eq_n H_eq_n'].
      by rewrite H_eq_n' in H_dec_n'.
    * move: H_dec' => [H_eq_n H_eq_n'].
      rewrite H_eq_n in H0.
      have H_inl := Failure_not_failed_no_fail H'_step1 _ n H_in_f'.
      case: H_inl.
      by rewrite H0; left.
    * case: H_dec' => H_dec' //.
      have H_neq: from <> n.
        move => H_eq'.
        rewrite H_eq' in H0.
        by rewrite (Failure_self_channel_empty H'_step1) in H0.
      move {H_dec}.
      apply (recv_fail_other H'_step1 H_in_f H_in_f' H0) => //.
      move => H_neq'.
      by rewrite H_neq' in H_dec_n'.
    case name_eq_dec => H_dec_n'.
      rewrite -H_dec_n'.
      rewrite -H_dec_n' {to H_dec_n'} in H0 H_dec_n H1 H6.
      case: d H6 => /= adjacent0 H_eq.
      rewrite H_eq {adjacent0 H_eq}.
      rewrite /update2 /=.
      case (sumbool_and _ _ _ _) => H_dec; case (sumbool_and _ _ _ _) => H_dec'.
      * move: H_dec' => [H_eq H_eq'].
        by rewrite H_eq' in H_dec_n.
      * move: H_dec => [H_eq H_eq'].
        rewrite H_eq in H0.
        have H_inl := Failure_not_failed_no_fail H'_step1 _ n' H_in_f.
        case: H_inl.
        rewrite H0.
        by left.
      * move: H_dec' => [H_eq H_eq'].
        by rewrite H_eq' in H_dec_n.
      * case: H_dec => H_dec //.
        have H_neq: from <> n'.
          move => H_eq'.
          rewrite H_eq' in H0.
          by rewrite (Failure_self_channel_empty H'_step1) in H0.
        move {H_dec'}.
        exact: (recv_other_fail H'_step1 H_in_f H_in_f' H0).
      rewrite /update2 /=.
      case (sumbool_and _ _ _ _) => H_dec; case (sumbool_and _ _ _ _) => H_dec'.
      * move: H_dec => [H_eq H_eq'].
        by rewrite H_eq' in H_dec_n'.
      * move: H_dec => [H_eq H_eq'].
        by rewrite H_eq' in H_dec_n'.
      * move: H_dec' => [H_eq H_eq'].
        by rewrite H_eq' in H_dec_n.
      * exact: H7.
- rewrite /= in IHH'_step1.
  move {H'_step2}.
  move => H_in_f H_in_f'.
  find_apply_lem_hyp input_handlers_IOHandler; break_exists.
  by io_handler_cases.
- rewrite /= in IHH'_step1.
  move => H_nor H_nor'.
  have H_neq: h <> n.
    move => H_eq.
    case: H_nor.
    by left.
  have H_in_f: ~ In n failed.
    move => H_in_f.
    case: H_nor.
    by right.
  have H_neq': h <> n'.
    move => H_eq.
    case: H_nor'.
    by left.
  have H_in_f': ~ In n' failed.
    move => H_in_f'.
    case: H_nor'.
    by right.
  have IH := IHH'_step1 H_in_f H_in_f'.
  move {H_nor H_nor' IHH'_step1}.
  rewrite collate_neq //.
  by rewrite collate_neq.
Qed.

End DualNodeInv.

Lemma Failure_in_adj_adjacent_to :
forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall (n n' : name),
    ~ In n failed ->
    NSet.In n' (onet.(onwState) n).(adjacent) ->
    adjacent_to n' n.
Proof.
move => net failed tr H_st.
move => n n' H_f.
pose P_curr (d : Data) := NSet.In n' d.(adjacent) -> adjacent_to n' n.
rewrite -/(P_curr _).
apply: (P_inv_n H_st); rewrite /P_curr //= {P_curr net tr H_st failed H_f}.
- move => H_ins.
  apply adjacent_to_node_adjacency in H_ins.
  apply filter_rel_related in H_ins.
  move: H_ins => [H_in H_adj].
  by apply adjacent_to_symmetric in H_adj.
- move => net failed tr n0 H_st H_in_f IH H_adj.
  apply: IH.
  by apply NSetFacts.remove_3 in H_adj.
Qed.

Lemma Failure_in_adj_or_incoming_fail :
forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    NSet.In n' (onet.(onwState) n).(adjacent) ->
    ~ In n' failed \/ (In n' failed /\ In Fail (onet.(onwPackets) n' n)).
Proof.
move => onet failed tr H.
have H_eq_f: failed = fst (failed, onet) by [].
have H_eq_o: onet = snd (failed, onet) by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2 5}H_eq_o {H_eq_o}.
remember step_ordered_failure_init as y in *.
move: Heqy.
induction H using refl_trans_1n_trace_n1_ind => /= H_init.
  rewrite H_init /= {H_init}.
  move => n n' H_ins.
  by left.
concludes.
match goal with
| [ H : step_ordered_failure _ _ _ |- _ ] => invc H
end; simpl.
- move => n n' H_in_f H_ins.
  find_apply_lem_hyp net_handlers_NetHandler; break_exists.
  net_handler_cases.
  rewrite /= /update2 {H1}.
  case (sumbool_and _ _ _ _) => H_dec.
    move: H_dec => [H_eq H_eq'].
    rewrite H_eq H_eq' {H_eq H_eq' to from} in H8 H_ins H3 H2.
    rewrite /= in IHrefl_trans_1n_trace1.
    move: H_ins.
    rewrite /update /=.
    case name_eq_dec => H_dec //.
    move => H_ins.
    case: d H8 H_ins => /= adjacent0 H_eq H_adj.
    rewrite H_eq in H_adj.
    by apply NSetFacts.remove_1 in H_adj.
  move: H_ins.
  rewrite /update /=.
  case name_eq_dec => H_dec'.
    case: H_dec => H_dec; last by rewrite H_dec' in H_dec.
    case: d H8 => /= adjacent0 H_eq.
    move => H_ins.
    rewrite H_eq {adjacent0 H_eq} in H_ins.
    rewrite -H_dec' {to H_dec'} in H2 H3 H_ins.
    apply NSetFacts.remove_3 in H_ins.
    exact: IHrefl_trans_1n_trace1.
  move => H_ins.
  exact: IHrefl_trans_1n_trace1.
- find_apply_lem_hyp input_handlers_IOHandler; break_exists.
  by io_handler_cases.
- move => n n' H_in_f H_ins.
  rewrite /= in IHrefl_trans_1n_trace1.
  have H_neq: h <> n.
    move => H_eq.
    case: H_in_f.
    by left.
  have H_in_f': ~ In n failed0.
    move => H_in.
    case: H_in_f.
    by right.
  have IH := IHrefl_trans_1n_trace1 _ _ H_in_f' H_ins.
  case (name_eq_dec h n') => H_dec.
    rewrite H_dec.
    right.
    split; first by left.
    rewrite H_dec in H2.
    have H_adj := Failure_in_adj_adjacent_to H _ H_in_f' H_ins.
    rewrite collate_map2snd_not_in_related //.
    * apply in_or_app.
      by right; left.
    * exact: all_names_nodes.
    * exact: no_dup_nodes.
  case: IH => IH.
    left.
    move => H_or.
    by case: H_or => H_or.
  move: IH => [H_in H_fail].
  right.
  split; first by right.
  by rewrite collate_neq.
Qed.

Lemma Failure_le_one_fail :
  forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    count_occ Msg_eq_dec (onet.(onwPackets) n' n) Fail <= 1.
Proof.
move => onet failed tr H_st.
move => n n' H_in_f.
pose P_curr (d : Data) (l : list Msg) :=
  count_occ Msg_eq_dec l Fail <= 1.
rewrite -/(P_curr (onet.(onwState) n) _).
apply: (P_inv_n_in H_st); rewrite /P_curr //= {P_curr onet tr H_st failed H_in_f}.
- by auto with arith.
- move => onet failed tr ms.
  move => H_st H_in_f H_in_f' H_neq H_eq IH.
  rewrite H_eq /= in IH.
  by omega.
- move => onet failed tr H_st H_neq H_in_f H_in_f'.
  move => H_adj IH.
  have H_f := Failure_not_failed_no_fail H_st _ n H_in_f'.
  have H_cnt : ~ count_occ Msg_eq_dec (onwPackets onet n' n) Fail > 0.
    move => H_cnt.
    by apply count_occ_In in H_cnt.
  have H_cnt_eq: count_occ Msg_eq_dec (onwPackets onet n' n) Fail = 0 by omega.
  rewrite count_occ_app /= H_cnt_eq.
  by auto with arith.
Qed.

Lemma Failure_adjacent_to_in_adj :
forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    ~ In n' failed ->
    adjacent_to n' n ->
    NSet.In n' (onet.(onwState) n).(adjacent).
Proof.
move => onet failed tr H_st.
move => n n' H_f H_f'.
pose P_curr (d d' : Data) (l l' : list Msg) :=
  adjacent_to n' n ->
  NSet.In n' d.(adjacent).
rewrite -/(P_curr _ (onet.(onwState) n') (onet.(onwPackets) n n')
 (onet.(onwPackets) n' n)).
apply: (P_dual_inv H_st); rewrite /P_curr //= {P_curr onet tr H_st failed H_f H_f'}.
- move => H_adj.
  apply adjacent_to_node_adjacency.
  apply related_filter_rel; first exact: all_names_nodes.
  exact: adjacent_to_symmetric.
- move => onet failed tr from ms H_st H_eq H_in_f H_eq' H_neq H_adj H_adj_to.
  rewrite H_eq in H_adj_to.
  contradict H_adj_to.
  exact: adjacent_to_irreflexive.
- move => onet failed tr from ms H_st H_in_f H_in_f' H_eq H_neq H_neq_f H_neq_f' IH H_adj.
  concludes.
  by apply NSetFacts.remove_2.
Qed.

Lemma Failure_in_queue_fail_then_adjacent :
  forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    In Fail (onet.(onwPackets) n' n) ->
    NSet.In n' (onet.(onwState) n).(adjacent).
Proof.
move => onet failed tr H_st.
move => n n' H_in_f.
pose P_curr (d : Data) (l : list Msg) :=
  In Fail l ->
  NSet.In n' d.(adjacent).
rewrite -/(P_curr _ _).
apply: (P_inv_n_in H_st); rewrite /P_curr //= {P_curr onet tr H_st failed H_in_f}.
- move => onet failed tr ms H_st H_in_f H_in_f' H_neq H_eq IH H_in.
  have H_cnt: count_occ Msg_eq_dec ms Fail > 0 by apply count_occ_In.
  have H_cnt': count_occ Msg_eq_dec (onet.(onwPackets) n' n) Fail > 1 by rewrite H_eq /=; auto with arith.
  have H_le := Failure_le_one_fail H_st _ n' H_in_f.
  by omega.
- move => onet failed tr from ms H_st H_in_f H_neq H_neq'.
  move => H_eq IH H_in.
  apply NSetFacts.remove_2; first by move => H_eq'; rewrite H_eq' in H_neq'.
  exact: IH.
- move => onet failed tr H_st H_neq H_in_f H_in_f' H_adj IH H_in.
  exact (Failure_adjacent_to_in_adj H_st H_in_f H_in_f' H_adj).
Qed.

Lemma Failure_first_fail_in_adj :
  forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    head (onet.(onwPackets) n' n) = Some Fail ->
    NSet.In n' (onet.(onwState) n).(adjacent).
Proof.
move => onet failed tr H_st.
move => n n' H_in_f.
pose P_curr (d : Data) (l : list Msg) :=
  hd_error l = Some Fail ->
  NSet.In n' d.(adjacent).
rewrite -/(P_curr _ _).
apply: (P_inv_n_in H_st); rewrite /P_curr //= {P_curr onet tr H_st failed H_in_f}.
- move => onet failed tr ms H_st H_in_f H_in_f' H_neq H_eq IH H_hd.
  have H_neq' := hd_error_some_nil H_hd.
  case: ms H_eq H_hd H_neq' => //.
  case => ms H_eq H_hd H_neq'.
  have H_cnt: count_occ Msg_eq_dec (onwPackets onet n' n) Fail > 1 by rewrite H_eq /=; auto with arith.
  have H_le := Failure_le_one_fail H_st _ n' H_in_f.
  by omega.
- move => onet failed tr from ms H_st H_in_f H_neq H_neq' H_eq IH H_hd.
  concludes.
  apply NSetFacts.remove_2 => //.
  move => H_eq'.
  by rewrite H_eq' in H_neq'.
- move => onet failed tr H_st H_neq H_in_f H_in_f' H_adj IH H_hd.
  by have H_a := Failure_adjacent_to_in_adj H_st H_in_f H_in_f' H_adj.
Qed.

Lemma Failure_adjacent_failed_incoming_fail :
  forall onet failed tr,
  step_ordered_failure_star step_ordered_failure_init (failed, onet) tr ->
  forall n n',
    ~ In n failed ->
    NSet.In n' (onet.(onwState) n).(adjacent) ->
    In n' failed ->
    In Fail (onet.(onwPackets) n' n).
Proof.
move => onet failed tr H_st n n' H_in_f H_adj H_in_f'.
have H_or := Failure_in_adj_or_incoming_fail H_st _ H_in_f H_adj.
case: H_or => H_or //.
by move: H_or => [H_in H_in'].
Qed.

Definition head_message_enables_label m src dst l :=
  forall net failed,
  ~ In dst failed ->
  head (net.(onwPackets) src dst) = Some m ->
  lb_step_ex lb_step_ordered_failure l (failed, net).

Lemma Fail_enables_RecvFail :
  forall src dst, head_message_enables_label Fail src dst (RecvFail dst src).
Proof.
move => src dst.
rewrite /head_message_enables_label.
move => net failed H_f H_eq.
case H_eq_p: (onwPackets net src dst) => [|m ms]; first by find_rewrite.
find_rewrite.
simpl in *.
find_injection.
rewrite /enabled.
case H_hnd: (@lb_net_handlers _ FailureRecorder_LabeledMultiParams dst src Fail (onwState net dst)) => [[[lb' out] d'] l].
have H_lb := H_hnd.
rewrite /lb_net_handlers /= in H_hnd.
by net_handler_cases => //;
 exists (failed, {| onwPackets := update2 Net.name_eq_dec (onwPackets net) src dst ms; onwState := update name_eq_dec (onwState net) dst d' |}), []; apply: LabeledStepOrderedFailure_deliver; eauto.
Qed.

Lemma Tree_lb_step_ordered_failure_RecvFail_enabled :
  forall net net' net'' failed failed' failed'' tr tr' dst src l,
  l <> RecvFail dst src ->
  lb_step_ordered_failure (failed, net) l (failed', net') tr ->
  lb_step_ordered_failure (failed, net) (RecvFail dst src) (failed'', net'') tr' ->
  lb_step_ex lb_step_ordered_failure (RecvFail dst src) (failed', net').
Proof.
move => net net' net'' failed failed' failed'' tr tr' dst src l H_neq H_st H_st'.
destruct l => //.
- invcs H_st => //.
  * by net_handler_cases.
  * invcs H_st' => //.
    have H_hd: head (onwPackets net' src dst) = Some Fail by net_handler_cases => //; find_injection; find_rewrite.
    have H_f: ~ In dst failed'' by net_handler_cases => //; find_injection; find_rewrite.
    exact: Fail_enables_RecvFail.
- invcs H_st' => //.
  have H_eq: onwPackets net src dst = Fail :: ms by net_handler_cases => //; find_injection; find_rewrite.
  have H_f: ~ In dst failed'' by net_handler_cases => //; find_injection; find_rewrite.
  invcs H_st => //.
  set net' := {| onwPackets := _ ; onwState := _ |}.
  have H_hd': head (onwPackets net' src dst) = Some Fail.
    rewrite /net' /=.
    net_handler_cases => //=; rewrite /update2.
    * break_if.
      + by break_and; subst; intuition.
      + by find_rewrite.
  exact: Fail_enables_RecvFail.
Qed.

Lemma Failure_RecvFail_enabled_weak_until_occurred :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       forall src dst, enabled lb_step_ordered_failure (RecvFail dst src) (hd s) ->
                  weak_until (now (enabled lb_step_ordered_failure (RecvFail dst src)))
                             (now (occurred (RecvFail dst src)))
                             s.
Proof.
cofix c.
case => /=.
case; case => failed net l tr s H_exec src dst.
case (Label_eq_dec l (RecvFail dst src)) => H_eq H_en.
- find_rewrite.
  exact: W0.
- apply: W_tl; first by [].
  apply: c; first by find_apply_lem_hyp lb_step_execution_invar.
  unfold enabled in *.
  unfold lb_step_ex in H_en.
  break_exists.
  destruct s as [e s].
  inversion H_exec; subst_max.
  inversion H5; subst.
  destruct e, evt_a.
  destruct e', evt_a.
  destruct x.
  simpl in *.
  by apply: Tree_lb_step_ordered_failure_RecvFail_enabled; eauto.
Qed.

Lemma Failure_RecvFail_eventually_occurred :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall src dst, enabled lb_step_ordered_failure (RecvFail dst src) (hd s) ->
                  eventually (now (occurred (RecvFail dst src))) s.
Proof.
move => s H_exec H_fair src dst H_en.
have H_wu := Failure_RecvFail_enabled_weak_until_occurred H_exec H_en.
apply weak_until_until_or_always in H_wu.
case: H_wu; first exact: until_eventually.
move => H_al.
apply always_continuously in H_al.
apply H_fair in H_al => //.
destruct s as [x s].
by apply always_now in H_al.
Qed.

Lemma lb_step_ordered_failure_count_occ_Fail_neq_eq :
  forall net net' failed failed' lb src dst k tr,
  lb <> RecvFail dst src ->
  count_occ msg_eq_dec (net.(onwPackets) src dst) Fail = k ->
  lb_step_ordered_failure (failed, net) lb (failed', net') tr ->
  count_occ msg_eq_dec (net'.(onwPackets) src dst) Fail = k.
Proof.
move => net net' failed failed' lb src dst k tr H_neq H_cnt H_step.
invcs H_step => //=.
net_handler_cases.
rewrite /collate /= /update2.
break_if => //.
break_and; subst.
by case: H_neq.
Qed.

Lemma lb_step_ordered_failure_count_occ_Fail_recv :
  forall net net' failed failed' src dst k tr,
  count_occ msg_eq_dec (net.(onwPackets) src dst) Fail = S k ->
  lb_step_ordered_failure (failed, net) (RecvFail dst src) (failed', net') tr ->
  count_occ msg_eq_dec (net'.(onwPackets) src dst) Fail = k.
Proof.
move => net net' failed failed' src dst k tr H_cnt H_step.
invcs H_step => //=.
net_handler_cases.
rewrite /= /update2.
break_if.
  break_and; subst.
  rewrite H3 /= in H_cnt.
  by auto with arith.
find_injection.
by break_or_hyp.
Qed.

Lemma lb_step_ordered_failure_count_occ_Fail_le_monotonic :
  forall net net' failed failed' lb src dst k tr,
  count_occ msg_eq_dec (net.(onwPackets) src dst) Fail <= k ->
  lb_step_ordered_failure (failed, net) lb (failed', net') tr ->
  count_occ msg_eq_dec (net'.(onwPackets) src dst) Fail <= k.
Proof.
move => net net' failed failed' lb src dst k tr H_cnt H_step.
invcs H_step => //=.
net_handler_cases.
rewrite /update2 /=.
break_if => //.
break_and.
repeat find_rewrite.
rewrite H3 /= in H_cnt.
by auto with arith.
Qed.

Lemma lb_step_ordered_failure_not_in_failed :
  forall net net' failed failed' lb tr h,
  ~ In h failed ->
  lb_step_ordered_failure (failed, net) lb (failed', net') tr ->
  ~ In h failed'.
Proof.
move => net net' failed failed' lb tr h H_in_f H_step.
by invcs H_step.
Qed.

Lemma Failure_not_in_failed_always :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       forall h, ~ In h (fst (hd s).(evt_a)) ->
       always (now (fun e => ~ In h (fst e.(evt_a)))) s.
Proof.
cofix c.
move => s H_exec.
inversion H_exec => /=.
move => h H_in_f.
apply: Always; first by [].
rewrite /=.
apply: c; first by [].
rewrite /=.
destruct e, e', evt_a, evt_a0.
simpl in *.
by eapply lb_step_ordered_failure_not_in_failed; eauto.
Qed.

Lemma Failure_lb_step_ordered_failure_fails_occ_monotonic :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       forall src dst k,
         count_occ Msg_eq_dec ((snd (hd s).(evt_a)).(onwPackets) src dst) Fail <= k ->
         always (now (fun e => count_occ Msg_eq_dec ((snd e.(evt_a)).(onwPackets) src dst) Fail <= k)) s.
Proof.
cofix c.
move => s H_exec.
inversion H_exec => /=.
move => src dst k H_cnt.
apply: Always; first by [].
apply: c; first by [].
rewrite /=.
destruct e, e', evt_a, evt_a0.
simpl in *.
move: H.
exact: lb_step_ordered_failure_count_occ_Fail_le_monotonic.
Qed.

Lemma count_occ_fail_head :
  forall e src dst k,
  ~ In dst (fst (evt_a e)) ->
  count_occ Msg_eq_dec (onwPackets (snd (evt_a e)) src dst) Fail = S k ->
  enabled lb_step_ordered_failure (RecvFail dst src) e.
Proof.
case => /= [[failed net] lb] tr src dst k H_in_f H_cnt.
rewrite /enabled /= /lb_step_ex.
case H_m: (onwPackets net src dst) => [|m ms]; first by rewrite H_m in H_cnt.
destruct m.
case H_hnd: (@lb_net_handlers _ FailureRecorder_LabeledMultiParams dst src Fail (onwState net dst)) => [[[lb' out] d] l].
have H_lb := H_hnd.
rewrite /lb_net_handlers /= in H_hnd.
net_handler_cases.
exists (failed, {| onwPackets := update2 Net.name_eq_dec (onwPackets net) src dst ms; onwState := update name_eq_dec (onwState net) dst d |}).
exists [].
by apply: LabeledStepOrderedFailure_deliver; eauto.
Qed.

Lemma Failure_eventually_fewer_Fail :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall src dst k, ~ In dst (fst (hd s).(evt_a)) ->
                    count_occ Msg_eq_dec (onwPackets (snd (hd s).(evt_a)) src dst) Fail = S k ->
                    eventually (now (fun e => count_occ Msg_eq_dec (onwPackets (snd e.(evt_a)) src dst) Fail = k)) s.
Proof.
move => s H_exec H_fair src dst k H_in_f H_cnt.
have H_en := count_occ_fail_head _ _ _ H_in_f H_cnt.
apply Failure_RecvFail_eventually_occurred in H_en => //.
move: H_exec H_fair H_in_f H_cnt.
elim: H_en => {s}.
  case; case => /= [[failed net] lb] tr.
  case; case; case => /= failed' net' lb' tr' s.
  rewrite /occurred /= => H_eq.
  rewrite -H_eq {H_eq}.
  move => H_exec H_fair H_in H_cnt.
  apply: E_next.
  apply: E0.
  rewrite /=.
  inversion H_exec; subst_max.
  simpl in *.
  by eapply lb_step_ordered_failure_count_occ_Fail_recv; eauto.
move => e s H_ev IH H_exec H_fair H_in H_cnt.
inversion H_exec; subst.
destruct e, e'.
destruct evt_a as [failed net].
destruct evt_a0 as [failed' net'].
simpl in *.
case (Label_eq_dec (RecvFail dst src) evt_l) => H_eq.
  subst_max.
  apply: E_next.
  apply: E0.
  rewrite /=.
  by eapply lb_step_ordered_failure_count_occ_Fail_recv; eauto.
apply E_next.
apply IH.
- by [].
- by apply weak_fairness_invar in H_fair.
- by eapply lb_step_ordered_failure_not_in_failed; eauto.
- by eapply lb_step_ordered_failure_count_occ_Fail_neq_eq; eauto.
Qed.

Lemma Failure_lb_step_ordered_failure_eventually_le_0_fail :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall src dst,
       ~ In dst (fst (hd s).(evt_a)) ->
       eventually (now (fun e => count_occ Msg_eq_dec ((snd e.(evt_a)).(onwPackets) src dst) Fail = 0)) s.
Proof.
move => s H_exec H_fair src dst H_in_f.
have H_ex: exists k, count_occ Msg_eq_dec (onwPackets (snd (evt_a (hd s))) src dst) Fail = k.
  case count_occ; first by exists 0.
  move => k.
  by exists (S k).
break_exists.
elim/(well_founded_ind lt_wf): x s H_exec H_fair H_in_f H.
case => [|k] IH s H_exec H_fair H_in_f H_cnt.
  apply: E0.
  by destruct s.
have H_k: k < S k by auto.
have IH' := IH _ H_k.
have H_ev := Failure_eventually_fewer_Fail H_exec H_fair src dst H_in_f H_cnt.
elim: H_ev H_exec H_fair H_in_f.
  move => s0 H_now H_exec H_fair H_in_f.
  apply: IH' => //.
  rewrite /=.
  by destruct s0.
move => e s0 H_ev H_ev' H_exec H_fair H_in_f.
apply: E_next.
apply: H_ev'.
- by apply lb_step_execution_invar in H_exec.
- by apply weak_fairness_invar in H_fair.
- inversion H_exec.
  destruct e, e'.
  destruct evt_a, evt_a0.
  simpl in *.
  by apply: lb_step_ordered_failure_not_in_failed; eauto.
Qed.

Lemma Failure_lb_step_ordered_failure_continuously_no_fail :
  forall s, lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall src dst,
       ~ In dst (fst (hd s).(evt_a)) ->
       continuously (now (fun e => ~ In Fail ((snd e.(evt_a)).(onwPackets) src dst))) s.
Proof.
move => s H_exec H_fair src dst H_in_f.
have H_ev := Failure_lb_step_ordered_failure_eventually_le_0_fail H_exec H_fair src dst H_in_f.
move: H_exec H_fair {H_in_f}.
elim: H_ev.
- move => s0 H_n H_exec H_fair.
  apply: E0.
  inversion H_exec.
  rewrite -H2 /now in H_n.
  have H_al := Failure_lb_step_ordered_failure_fails_occ_monotonic H_exec src dst.
  rewrite -H2 /= in H_al.
  have H_le_n: count_occ Msg_eq_dec (onwPackets (snd (evt_a e)) src dst) Fail <= 0 by rewrite H_n.
  have H_al' := H_al _ H_le_n.
  move: H_al' {H_al}.
  rewrite H2.
  generalize s0.
  apply: always_monotonic.
  case => e2 s2.
  rewrite /=.
  move => H_occ.
  apply (count_occ_not_In Msg_eq_dec _ Fail).
  by auto with arith.
- move => e s0 H_ev IH H_exec H_fair.
  apply: E_next.
  apply: IH; first by apply lb_step_execution_invar in H_exec.
  by apply weak_fairness_invar in H_fair.
Qed.

Lemma Failure_lb_step_ordered_failure_no_fails_step_star_ex :
  forall s, event_step_star step_ordered_failure step_ordered_failure_init (hd s) ->
       lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall src dst,
       ~ In dst (fst (hd s).(evt_a)) ->
       continuously (now (fun e =>
         event_step_star step_ordered_failure step_ordered_failure_init e /\
         ~ In dst (fst e.(evt_a)) /\
         ~ In Fail ((snd e.(evt_a)).(onwPackets) src dst))) s.
Proof.
move => s H_star H_exec H_fair src dst H_in_f.
have H_al := step_ordered_failure_star_lb_step_execution H_star H_exec.
have H_al' := Failure_not_in_failed_always H_exec _ H_in_f.
apply always_continuously in H_al.
apply always_continuously in H_al'.
have H_cny := Failure_lb_step_ordered_failure_continuously_no_fail H_exec H_fair src _ H_in_f.
have H_both := continuously_and_tl H_al H_al'.
have H_both' := continuously_and_tl H_both H_cny.
move: H_both'.
apply continuously_monotonic.
case => /= e s0 H_and.
unfold now, and_tl in H_and.
by break_and.
Qed.

Lemma Failure_lb_step_ordered_failure_continuously_adj_not_failed :
  forall s, event_step_star step_ordered_failure step_ordered_failure_init (hd s) ->
       lb_step_execution lb_step_ordered_failure s ->
       weak_fairness lb_step_ordered_failure label_silent s ->
       forall n n',
       ~ In n (fst (hd s).(evt_a)) ->
       continuously (now (fun e =>
         NSet.In n' ((snd e.(evt_a)).(onwState) n).(adjacent) ->
         ~ In n' (fst e.(evt_a)) /\ adjacent_to n' n)) s.
Proof.
move => s H_star H_exec H_fair n n' H_in_f.
have H_cny := Failure_lb_step_ordered_failure_no_fails_step_star_ex H_star H_exec H_fair n' _ H_in_f.
move: H_cny.
apply continuously_monotonic.
case => /= e s0 H_and H_ins.
break_and.
destruct e, evt_a.
unfold event_step_star in *.
simpl in *.
break_exists.
have H_adj := Failure_in_adj_or_incoming_fail H _ H0 H_ins.
break_or_hyp; last by break_and.
split => //.
by eapply Failure_in_adj_adjacent_to; eauto.
Qed.

End FailureRecorderCorrect.