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

Require Import Termes.
Require Import Conv.
Require Import Ered.
Require Export MyList.
Require Import Types.

Section Typage.

  Inductive Ewf : env -> Prop :=
    | Ewf_nil : Ewf nil
    | Ewf_var :
        forall (e : env) (T : term) (s : sort),
        Etyp e T (Srt s) -> Ewf (T :: e)
with Etyp : env -> term -> term -> Prop :=
  | Etype_prop : forall e : env, Ewf e -> Etyp e (Srt prop) (Srt kind)
  | Etype_set : forall e : env, Ewf e -> Etyp e (Srt set) (Srt kind)
  | Etype_var :
      forall e : env,
      Ewf e ->
      forall (v : nat) (t : term), item_lift t e v -> Etyp e (Ref v) t
  | Etype_abs :
      forall (e : env) (T : term) (s1 : sort),
      Etyp e T (Srt s1) ->
      forall (M U : term) (s2 : sort),
      Etyp (T :: e) U (Srt s2) ->
      Etyp (T :: e) M U -> Etyp e (Abs T M) (Prod T U)
  | Etype_app :
      forall (e : env) (v V : term),
      Etyp e v V ->
      forall u Ur : term,
      Etyp e u (Prod V Ur) -> Etyp e (App u v) (subst v Ur)
  | Etype_prod :
      forall (e : env) (T : term) (s1 : sort),
      Etyp e T (Srt s1) ->
      forall (U : term) (s2 : sort),
      Etyp (T :: e) U (Srt s2) -> Etyp e (Prod T U) (Srt s2)
  | Etype_Econv :
      forall (e : env) (t U V : term),
      Etyp e t U ->
      Econv U V -> forall s : sort, Etyp e V (Srt s) -> Etyp e t V.

  Hint Resolve Ewf_nil Etype_prop Etype_set Etype_var: ecoc.

Lemma typ_Etyp : forall (e : env) (a Ta : term), typ e a Ta -> Etyp e a Ta.
fix typ_Etyp 4.
intros.
case H; intros.
apply Etype_prop.
case H0.
apply Ewf_nil.

intros; apply Ewf_var with s.
apply typ_Etyp; trivial.

apply Etype_set.
case H0.
apply Ewf_nil.

intros; apply Ewf_var with s; auto.

apply Etype_var.
case H0.
apply Ewf_nil.

intros; apply Ewf_var with s.
apply typ_Etyp; trivial.

trivial.

apply Etype_abs with s1 s2; auto.

apply Etype_app with V; auto.

apply Etype_prod with s1; auto.

apply Etype_Econv with U s; auto.
apply conv_Econv; trivial.
Qed.

  Lemma Etype_prop_set :
   forall s : sort,
   is_prop s -> forall e : env, Ewf e -> Etyp e (Srt s) (Srt kind).
simple destruct 1; intros; rewrite H0.
apply Etype_prop; trivial.
apply Etype_set; trivial.
Qed.

  Lemma Etyp_free_db :
   forall (e : env) (t T : term), Etyp e t T -> free_db (length e) t.
simple induction 1; intros; auto with coc ecoc core arith datatypes.
inversion_clear H1.
apply db_ref.
elim H3; simpl in |- *; intros; auto with coc ecoc core arith datatypes.
Qed.

  Lemma Etyp_Ewf : forall (e : env) (t T : term), Etyp e t T -> Ewf e.
simple induction 1; auto with coc core arith datatypes.
Qed.

  Lemma Ewf_sort :
   forall (n : nat) (e f : env),
   trunc _ (S n) e f ->
   Ewf e ->
   forall t : term, item _ t e n -> exists s : sort, Etyp f t (Srt s).
simple induction n.
do 3 intro.
inversion_clear H.
inversion_clear H0.
intros.
inversion_clear H0.
inversion_clear H.
exists s; auto with coc core arith datatypes.

do 5 intro.
inversion_clear H0.
intros.
inversion_clear H2.
inversion_clear H0.
elim H with e0 f t; intros; auto with coc core arith datatypes.
exists x0; auto with coc core arith datatypes.

apply Etyp_Ewf with x (Srt s); auto with coc core arith datatypes.
Qed.

  Definition inv_Etype (P : Prop) (e : env) (t T : term) : Prop :=
    match t with
    | Srt prop => Econv T (Srt kind) -> P
    | Srt set => Econv T (Srt kind) -> P
    | Srt kind => True
    | Ref n => forall x : term, item _ x e n -> Econv T (lift (S n) x) -> P
    | Abs A M =>
        forall (s1 s2 : sort) (U : term),
        Etyp e A (Srt s1) ->
        Etyp (A :: e) M U ->
        Etyp (A :: e) U (Srt s2) -> Econv T (Prod A U) -> P
    | App u v =>
        forall Ur V : term,
        Etyp e v V -> Etyp e u (Prod V Ur) -> Econv T (subst v Ur) -> P
    | Prod A B =>
        forall s1 s2 : sort,
        Etyp e A (Srt s1) ->
        Etyp (A :: e) B (Srt s2) -> Econv T (Srt s2) -> P
    end.

  Lemma inv_Etype_Econv :
   forall (P : Prop) (e : env) (t U V : term),
   Econv U V -> inv_Etype P e t U -> inv_Etype P e t V.
do 6 intro.
cut (forall x : term, Econv V x -> Econv U x).
intro.
case t; simpl in |- *; intros.
generalize H1.
elim s; auto with coc ecoc core arith datatypes; intros.

apply H1 with x; auto with coc core arith datatypes.

apply H1 with s1 s2 U0; auto with coc core arith datatypes.

apply H1 with Ur V0; auto with coc core arith datatypes.

apply H1 with s1 s2; auto with coc core arith datatypes.

intros; apply trans_Econv_Econv with V; auto with coc core arith datatypes.
Qed.

  Theorem Etyp_inversion :
   forall (P : Prop) (e : env) (t T : term),
   Etyp e t T -> inv_Etype P e t T -> P.
simple induction 1; simpl in |- *; intros.
auto with coc ecoc core arith datatypes.

auto with coc ecoc core arith datatypes.

elim H1; intros.
apply H2 with x; auto with coc ecoc core arith datatypes.
rewrite H3; auto with coc ecoc core arith datatypes.

apply H6 with s1 s2 U; auto with coc ecoc core arith datatypes.

apply H4 with Ur V; auto with coc ecoc core arith datatypes.

apply H4 with s1 s2; auto with coc ecoc core arith datatypes.

apply H1.
apply inv_Etype_Econv with V; auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_kind : forall (e : env) (t : term), ~ Etyp e (Srt kind) t.
red in |- *; intros.
apply Etyp_inversion with e (Srt kind) t; simpl in |- *;
 auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_prop :
   forall (e : env) (T : term), Etyp e (Srt prop) T -> Econv T (Srt kind).
intros.
apply Etyp_inversion with e (Srt prop) T; simpl in |- *;
 auto with ecoc coc core arith datatypes.
Qed.

  Lemma inv_Etyp_set :
   forall (e : env) (T : term), Etyp e (Srt set) T -> Econv T (Srt kind).
intros.
apply Etyp_inversion with e (Srt set) T; simpl in |- *;
 auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_ref :
   forall (P : Prop) (e : env) (T : term) (n : nat),
   Etyp e (Ref n) T ->
   (forall U : term, item _ U e n -> Econv T (lift (S n) U) -> P) -> P.
intros.
apply Etyp_inversion with e (Ref n) T; simpl in |- *; intros;
 auto with coc ecoc core arith datatypes.
apply H0 with x; auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_abs :
   forall (P : Prop) (e : env) (A M U : term),
   Etyp e (Abs A M) U ->
   (forall (s1 s2 : sort) (T : term),
    Etyp e A (Srt s1) ->
    Etyp (A :: e) M T -> Etyp (A :: e) T (Srt s2) -> Econv (Prod A T) U -> P) ->
   P.
intros.
apply Etyp_inversion with e (Abs A M) U; simpl in |- *;
 auto with coc ecoc core arith datatypes; intros.
apply H0 with s1 s2 U0; auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_app :
   forall (P : Prop) (e : env) (u v T : term),
   Etyp e (App u v) T ->
   (forall V Ur : term,
    Etyp e u (Prod V Ur) -> Etyp e v V -> Econv T (subst v Ur) -> P) -> P.
intros.
apply Etyp_inversion with e (App u v) T; simpl in |- *;
 auto with coc ecoc core arith datatypes; intros.
apply H0 with V Ur; auto with coc ecoc core arith datatypes.
Qed.

  Lemma inv_Etyp_prod :
   forall (P : Prop) (e : env) (T U s : term),
   Etyp e (Prod T U) s ->
   (forall s1 s2 : sort,
    Etyp e T (Srt s1) -> Etyp (T :: e) U (Srt s2) -> Econv (Srt s2) s -> P) ->
   P.
intros.
apply Etyp_inversion with e (Prod T U) s; simpl in |- *;
 auto with coc ecoc core arith datatypes; intros.
apply H0 with s1 s2; auto with coc ecoc core arith datatypes.
Qed.

  Lemma Etyp_mem_kind :
   forall (e : env) (t T : term), mem_sort kind t -> ~ Etyp e t T.
red in |- *; intros.
apply Etyp_inversion with e t T; auto with coc core arith datatypes.
generalize e T.
clear H0.
elim H; simpl in |- *; auto with coc core arith datatypes; intros.
apply Etyp_inversion with e0 u (Srt s1); auto with coc core arith datatypes.

apply Etyp_inversion with (u :: e0) v (Srt s2);
 auto with coc core arith datatypes.

apply Etyp_inversion with e0 u (Srt s1); auto with coc core arith datatypes.

apply Etyp_inversion with (u :: e0) v U; auto with coc core arith datatypes.

apply Etyp_inversion with e0 u (Prod V Ur);
 auto with coc core arith datatypes.

apply Etyp_inversion with e0 v V; auto with coc core arith datatypes.
Qed.

Lemma inv_Etyp_Econv_kind :
 forall (e : env) (t T : term), Econv t (Srt kind) -> ~ Etyp e t T.
intros.
apply Etyp_mem_kind.
apply Ered_sort_mem.
elim Econv_church_rosser with t (Srt kind); intros;
 auto with ecoc coc core arith datatypes.
rewrite (Ered_Enormal (Srt kind) x); auto with ecoc coc core arith datatypes.
red in |- *; red in |- *; intros.
inversion_clear H2.
Qed.

End Typage.


(** Verification of a simple example template: a single-node structure *)

Require Import lock.
From iris.algebra Require Import excl auth gmap agree gset.
From iris.algebra.lib Require Import frac_agree.
From iris.heap_lang Require Export notation locations lang.
From iris.base_logic.lib Require Export invariants.
From iris.program_logic Require Export atomic.
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode.
From iris.bi.lib Require Import fractional.
Set Default Proof Using "All".
Require Import auth_ext search_str.

(** We use integers as keys. *)
Definition K := Z.

(* The keyspace is some arbitrary finite subset of K. *)
Parameter KS : gset K.

(** Definitions of cameras used in the template verification *)
Section One_Node_Cameras.

  (* RA for fractional set of keys *)
  Definition frackeysCmra : cmra := frac_agreeR (gsetUR K).

  Class frackeysG Σ :=
    FrackeyshG { frackeys_inG :> inG Σ  frackeysCmra}.
  Definition frackeysΣ : gFunctors := #[GFunctor frackeysCmra].

  Instance subG_frackeysΣ {Σ} : subG frackeysΣ Σ → frackeysG Σ.
  Proof. solve_inG. Qed.

End One_Node_Cameras.

(** Syntactic sugar for fraction-set RA *)
Notation "γ ⤇[ q ] m" := (own γ (to_frac_agree q m))
  (at level 20, q at level 50, format "γ ⤇[ q ]  m") : bi_scope.
Notation "γ ⤇½ m" := (own γ (to_frac_agree (1/2) m))
  (at level 20, format "γ ⤇½  m") : bi_scope.

(** Verification of the template *)
Section One_Node_Template.

  Context `{!heapG Σ, !frackeysG Σ}.
  Notation iProp := (iProp Σ).

  (** The code of the template. *)

  (* The following parameters are the implementation-specific helper functions
   * assumed by the template. *)

  Parameter allocRoot : val.
  Parameter decisiveOp : (dOp → val).

  Definition create : val :=
    λ: <>,
      let: "r" := allocRoot #() in
      "r".

  Definition CSSOp (Ψ: dOp) (r: Node) : val :=
    rec: "dictOp" "k" :=
      lockNode #r;;
      let: "res" := ((decisiveOp Ψ) #r "k") in
      unlockNode #r;;
      "res".

  (** Assumptions on the implementation made by the template proofs. *)

  (* The node predicate is specific to each template implementation. *)
  Parameter node : Node → gset K → iProp.

  (* The following assumption is justified by the fact that GRASShopper uses a
   * first-order separation logic. *)
  Parameter node_timeless_proof : ∀ n C, Timeless (node n C).
  Instance node_timeless n C: Timeless (node n C).
  Proof. apply node_timeless_proof. Qed.

  (* The following hypothesis is proved as GRASShopper lemmas in
   * hashtbl-give-up.spl and b+-tree.spl *)
  Hypothesis node_sep_star: ∀ n C C',
    node n C ∗ node n C' -∗ False.

  (** Helper functions specs *)

  (* The following specs are proved for each implementation in GRASShopper *)

  Parameter allocRoot_spec :
      ⊢ ({{{ True }}}
           allocRoot #()
         {{{ (r: Node),
             RET #r; node r ∅ ∗ (lockLoc r) ↦ #false  }}})%I.

  Parameter decisiveOp_spec : ∀ (dop: dOp) (n: Node) (k: K) (C: gset K),
      ⊢ ({{{ ⌜k ∈ KS⌝ ∗ node n C }}}
           decisiveOp dop #n #k
         {{{ (res: bool) (C1: gset K),
             RET #res;
             node n C1 ∗ ⌜Ψ dop k C C1 res⌝ }}})%I.

  (** The concurrent search structure invariant *)

  Definition nodePred γ n : iProp :=
    ∃ C, node n C
    ∗ γ ⤇½ C.

  Definition CSS γ r (C: gset K) : iProp :=
    ∃ (b: bool),
      γ ⤇½ C
      ∗ lockR b r (nodePred γ r).

  (** High-level lock specs **)

  Lemma lockNode_spec_high γ (r: Node) :
    ⊢  <<< ∀ (C: gset K), CSS γ r C >>>
         lockNode #r @ ⊤
       <<< CSS γ r C ∗ nodePred γ r, RET #() >>>.
  Proof.
    iIntros (Φ) "AU".
    awp_apply (lockNode_spec r).
    iApply (aacc_aupd_commit with "AU"); first done.
    iIntros (C) "Hcss". iDestruct "Hcss" as (b) "(HC & Hlock)".
    iAaccIntro with "Hlock".
    { iIntros "Hlockn". iModIntro. iSplitL.
      iFrame. iExists b. iFrame.
      eauto with iFrame.
    }
    iIntros "(Hlockn & Hnp)". iModIntro.
    iSplitL. iFrame. iExists true. iFrame.
    eauto with iFrame.
  Qed.

  Lemma unlockNode_spec_high γ (r: Node) :
    ⊢  nodePred γ r -∗
        <<< ∀ (C: gset K), CSS γ r C >>>
          unlockNode #r @ ⊤
       <<< CSS γ r C, RET #() >>>.
  Proof.
    iIntros "Hnp" (Φ) "AU".
    awp_apply (unlockNode_spec r).
    iApply (aacc_aupd_commit with "AU"); first done.
    iIntros (C) "Hcss".
    iDestruct "Hcss" as (b) "(HC & Hlock)".
    iAssert (⌜b = true⌝)%I as "%".
    { destruct b; try done.
      iDestruct "Hlock" as "(_ & Hnp')".
      iDestruct "Hnp" as (Cn)"(node & _)".
      iDestruct "Hnp'" as (Cn')"(node' & _)".
      iExFalso; iApply (node_sep_star r); try iFrame. }
    subst b.
    iCombine "Hlock Hnp" as "HlockR".
    iAaccIntro with "HlockR".
    { iIntros "(Hlockn & Hnp)". iModIntro. iSplitR "Hnp".
      iFrame. iExists true. iFrame.
      iIntros "AU". iModIntro. iFrame. }
    iIntros "Hlockn". iModIntro.
    iSplitL. iFrame. iExists false. iFrame.
    eauto with iFrame.
  Qed.

  (** Proof of CSSOp *)

  Theorem create_spec :
   ⊢ {{{ True }}}
        create #()
     {{{ γ (r: Node), RET #r; CSS γ r ∅ }}}.
  Proof.
    iIntros (Φ). iModIntro.
    iIntros "_ HΦ".
    wp_lam. wp_apply allocRoot_spec; try done.
    iIntros (r) "(node & Hl)". iApply fupd_wp.
    iMod (own_alloc (to_frac_agree (1) (∅: gset K)))
          as (γ)"Hf". { try done. }
    iEval (rewrite <-Qp_half_half) in "Hf".
    iEval (rewrite (frac_agree_op (1/2) (1/2) _)) in "Hf".
    iDestruct "Hf" as "(Hf & Hf')".
    iModIntro. wp_pures.
    iModIntro. iApply ("HΦ" $! γ r).
    iExists false. iFrame.
    iExists ∅. iFrame.
  Qed.

  Theorem CSSOp_spec (γ: gname) r (dop: dOp) (k: K):
   ⊢ ⌜k ∈ KS⌝ -∗ <<< ∀ C, CSS γ r C >>>
                          CSSOp dop r #k @ ⊤
                 <<< ∃ C' (res: bool), CSS γ r C'
                                     ∗ ⌜Ψ dop k C C' res⌝, RET #res >>>.
  Proof.
    iIntros "%" (Φ) "AU". wp_lam. wp_bind(lockNode _)%E.
    (* Open AU to get lockNode precondition *)
    awp_apply (lockNode_spec_high γ r); try done.
    iApply (aacc_aupd_abort with "AU"); first done.
    iIntros (C0) "HInv". iAaccIntro with "HInv".
    { iIntros "HInv". iModIntro. eauto with iFrame. }
    iIntros "(HInv & Hnode)".
    (* Close AU and move on *)
    iModIntro. iFrame. iIntros "AU". iModIntro.
    (* Execute decisiveOp *)
    wp_pures. wp_bind (decisiveOp _ _ _)%E.
    iDestruct "Hnode" as (Cn) "(Hn & Hcn)".
    wp_apply ((decisiveOp_spec dop r k) with "[Hn]"). eauto with iFrame.
    iIntros (res C') "(Hn & %)".
    wp_pures.

    awp_apply (unlockNode_spec_low).
    iApply (aacc_aupd_commit with "AU"); first done.
    iIntros (C) "Hcss".
    iDestruct "Hcss" as (b)"(HC & Hlock)".
    iAssert (⌜C = Cn⌝)%I as "%".
    { iPoseProof (own_valid_2 _ _ _ with "[$Hcn] [$HC]") as "H'".
      iDestruct "H'" as %H'. apply frac_agree_op_valid in H'.
      destruct H' as [_ H']. apply leibniz_equiv_iff in H'.
      by iPureIntro. } subst Cn.
    iAssert (⌜b = true⌝)%I with "[-]" as "%".
    {
      destruct b.
      - by iPureIntro.
      - iExFalso. iDestruct "Hlock" as "(_ & Hn')".
        iDestruct "Hn'" as (C1)"(Hn' & _)".
        iApply node_sep_star; iFrame.
    } subst b.
    iEval (unfold lockR) in "Hlock".
    iDestruct "Hlock" as "(Hl & _)".
    iAaccIntro with "Hl".
    { iIntros "Hl". iModIntro.
      iSplitR "Hcn Hn".
      { iExists true. iFrame. }
      iIntros "AU". iModIntro. iFrame. }
    iIntros "Hl".
    iCombine "Hcn HC" as "H'".
    iEval (rewrite <-frac_agree_op) in "H'".
    iEval (rewrite Qp_half_half) in "H'".
    iMod ((own_update (γ) (to_frac_agree 1 C)
                  (to_frac_agree 1 C')) with "[$H']") as "H'".
    { apply cmra_update_exclusive.
      unfold valid, cmra_valid. simpl. unfold prod_valid_instance.
      split; simpl; try done. }
    iEval (rewrite <-Qp_half_half) in "H'".
    iEval (rewrite frac_agree_op) in "H'".
    iDestruct "H'" as "(Hcn & HC)".
    iModIntro. iExists C', res.
    iSplitL. iFrame "∗%". iExists false. iFrame.
    iExists C'. iFrame.
    iIntros "HΦ". iModIntro. wp_pures.
    by iModIntro.
  Qed.

End One_Node_Template.


Require Import Lia.
Require Import Bool.
Require Import RelationClasses.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.

Require Import Event.
Require Import Time.
From PromisingLib Require Import Language.

Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.

Set Implicit Arguments.

Module ThreadEvent.
  Inductive t :=
  | promise (loc:Loc.t) (from to:Time.t) (msg:Message.t) (kind:Memory.op_kind)
  | silent
  | read (loc:Loc.t) (ts:Time.t) (val:Const.t) (released:option View.t) (ord:Ordering.t)
  | write (loc:Loc.t) (from to:Time.t) (val:Const.t) (released:option View.t) (ord:Ordering.t)
  | update (loc:Loc.t) (tsr tsw:Time.t) (valr valw:Const.t) (releasedr releasedw:option View.t) (ordr ordw:Ordering.t)
  | fence (ordr ordw:Ordering.t)
  | syscall (e:Event.t)
  | failure
  .
  #[global]
  Hint Constructors t: core.

  Inductive kind :=
  | kind_promise
  | kind_syscall
  | kind_others
  .
  #[global]
  Hint Constructors kind: core.

  Definition kinds_all := fun k: kind => True.
  #[global]
  Hint Unfold kinds_all: core.
  Definition kinds_promise := fun k: kind => k = kind_promise.
  #[global]
  Hint Unfold kinds_promise: core.
  Definition kinds_program := fun k: kind => k <> kind_promise.
  #[global]
  Hint Unfold kinds_program: core.
  Definition kinds_tau := fun k: kind => k <> kind_syscall.
  #[global]
  Hint Unfold kinds_tau: core.

  Definition get_kind (e:t): kind :=
    match e with
    | promise _ _ _ _ _ => kind_promise
    | syscall _ => kind_syscall
    | _ => kind_others
    end.

  Definition get_event (e:t): option Event.t :=
    match e with
    | syscall e => Some e
    | _ => None
    end.

  Definition get_program_event (e:t): ProgramEvent.t :=
    match e with
    | promise _ _ _ _ _  => ProgramEvent.silent
    | silent => ProgramEvent.silent
    | read loc _ val _ ord => ProgramEvent.read loc val ord
    | write loc _ _ val _ ord => ProgramEvent.write loc val ord
    | update loc _ _ valr valw _ _ ordr ordw => ProgramEvent.update loc valr valw ordr ordw
    | fence ordr ordw => ProgramEvent.fence ordr ordw
    | syscall ev => ProgramEvent.syscall ev
    | failure => ProgramEvent.failure
    end.

  Definition get_machine_event (e: t): MachineEvent.t :=
    match e with
    | syscall e => MachineEvent.syscall e
    | failure => MachineEvent.failure
    | _ => MachineEvent.silent
    end.

  Definition is_promising (e:t) : option (Loc.t * Time.t) :=
    match e with
    | promise loc from to msg kind => Some (loc, to)
    | _ => None
    end.

  Definition is_reading (e:t): option (Loc.t * Time.t * Const.t * option View.t * Ordering.t) :=
    match e with
    | read loc ts val released ord => Some (loc, ts, val, released, ord)
    | update loc tsr _ valr _ releasedr _ ordr _ => Some (loc, tsr, valr, releasedr, ordr)
    | _ => None
    end.

  Definition is_writing (e:t): option (Loc.t * Time.t * Time.t * Const.t * option View.t * Ordering.t) :=
    match e with
    | write loc from to val released ord => Some (loc, from, to, val, released, ord)
    | update loc tsr tsw _ valw _ releasedw _ ordw => Some (loc, tsr, tsw, valw, releasedw, ordw)
    | _ => None
    end.

  Definition is_accessing (e:t): option (Loc.t * Time.t) :=
    match e with
    | read loc ts _ _ _ => Some (loc, ts)
    | write loc _ ts _ _ _ => Some (loc, ts)
    | update loc _ ts _ _ _ _ _ _ => Some (loc, ts)
    | _ => None
    end.

  Definition is_accessing_loc (l: Loc.t) (e: t): Prop :=
    match is_accessing e with
    | Some (loc, _) => loc = l
    | None => False
    end.

  Lemma eq_program_event_eq_loc
        e1 e2 loc
        (EVENT: get_program_event e1 = get_program_event e2):
    is_accessing_loc loc e1 <-> is_accessing_loc loc e2.
  Proof.
    unfold is_accessing_loc.
    destruct e1, e2; ss; inv EVENT; ss.
  Qed.

  Inductive le: forall (lhs rhs:t), Prop :=
  | le_promise
      loc from to msg1 msg2 kind1 kind2
      (LEREL: Message.le msg1 msg2):
      le (promise loc from to msg1 kind1) (promise loc from to msg2 kind2)
  | le_silent:
      le silent silent
  | le_read
      loc ts val rel1 rel2 ord
      (LEREL: View.opt_le rel1 rel2):
      le (read loc ts val rel1 ord) (read loc ts val rel2 ord)
  | le_write
      loc from to val rel1 rel2 ord
      (LEREL: View.opt_le rel1 rel2):
      le (write loc from to val rel1 ord) (write loc from to val rel2 ord)
  | le_update
      loc tsr tsw valr valw relr1 relr2 relw1 relw2 ordr ordw
      (LEREL: View.opt_le relr1 relr2)
      (LEREL: View.opt_le relw1 relw2):
      le (update loc tsr tsw valr valw relr1 relw1 ordr ordw) (update loc tsr tsw valr valw relr2 relw2 ordr ordw)
  | le_fence ordr ordw:
      le (fence ordr ordw) (fence ordr ordw)
  | le_syscall e:
      le (syscall e) (syscall e)
  | le_failure:
      le failure failure
  .
  #[global]
  Hint Constructors le: core.

  Definition lift (ord0:Ordering.t) (e:t): t :=
    match e with
    | promise loc from to msg kind =>
      promise loc from to msg kind
    | silent => silent
    | read loc ts val released ord =>
      read loc ts val released (Ordering.join ord0 ord)
    | write loc from to val released ord =>
      write loc from to val released (Ordering.join ord0 ord)
    | update loc tsr tsw valr valw releasedr releasedw ordr ordw =>
      update loc tsr tsw valr valw releasedr releasedw (Ordering.join ord0 ordr) (Ordering.join ord0 ordw)
    | fence ordr ordw =>
      fence (Ordering.join ord0 ordr) (Ordering.join ord0 ordw)
    | syscall e =>
      syscall e
    | failure =>
      failure
    end.

  Lemma lift_plain e:
    lift Ordering.plain e = e.
  Proof. destruct e; ss. Qed.

End ThreadEvent.

Module Local.
  Structure t := mk {
    tview: TView.t;
    promises: Memory.t;
  }.

  Definition init := mk TView.bot Memory.bot.

  Inductive is_terminal (lc:t): Prop :=
  | is_terminal_intro
      (PROMISES: (promises lc) = Memory.bot)
  .
  #[global]
  Hint Constructors is_terminal: core.

  Inductive wf (lc:t) (mem:Memory.t): Prop :=
  | wf_intro
      (TVIEW_WF: TView.wf (tview lc))
      (TVIEW_CLOSED: TView.closed (tview lc) mem)
      (PROMISES: Memory.le (promises lc) mem)
      (FINITE: Memory.finite (promises lc))
      (BOT: Memory.bot_none (promises lc))
      (RESERVE: Memory.reserve_wf (promises lc) mem)
  .
  #[global]
  Hint Constructors wf: core.

  Lemma cap_wf
        lc promises mem1 mem2
        (CAP: Memory.cap promises mem1 mem2)
        (WF: wf lc mem1):
    wf lc mem2.
  Proof.
    inv WF. econs; eauto.
    - eapply TView.cap_closed; eauto.
    - eapply Memory.cap_le; eauto.
    - eapply Memory.cap_reserve_wf; eauto.
  Qed.

  Inductive disjoint (lc1 lc2:t): Prop :=
  | disjoint_intro
      (DISJOINT: Memory.disjoint (promises lc1) (promises lc2))
  .
  #[global]
  Hint Constructors disjoint: core.

  Global Program Instance disjoint_Symmetric: Symmetric disjoint.
  Next Obligation.
    econs. symmetry. apply H.
  Qed.

  Definition promise_consistent (lc:t): Prop :=
    forall loc ts from val released
       (PROMISE: Memory.get loc ts (promises lc) = Some (from, Message.full val released)),
      Time.lt ((TView.cur (tview lc)).(View.rlx) loc) ts.

  Lemma bot_promise_consistent
        lc
        (PROMISES: (promises lc) = Memory.bot):
    promise_consistent lc.
  Proof.
    ii. rewrite PROMISES, Memory.bot_get in *. ss.
  Qed.

  Lemma terminal_promise_consistent
        lc
        (TERMINAL: is_terminal lc):
    promise_consistent lc.
  Proof.
    inv TERMINAL. apply bot_promise_consistent. auto.
  Qed.

  Inductive promise_step (lc1:t) (mem1:Memory.t) (loc:Loc.t) (from to:Time.t) (msg:Message.t) (lc2:t) (mem2:Memory.t) (kind:Memory.op_kind): Prop :=
  | promise_step_intro
      promises2
      (PROMISE: Memory.promise (promises lc1) mem1 loc from to msg promises2 mem2 kind)
      (CLOSED: Memory.closed_message msg mem2)
      (LC2: lc2 = mk (tview lc1) promises2):
      promise_step lc1 mem1 loc from to msg lc2 mem2 kind
  .
  #[global]
  Hint Constructors promise_step: core.

  Inductive read_step (lc1:t) (mem1:Memory.t) (loc:Loc.t) (to:Time.t) (val:Const.t) (released:option View.t) (ord:Ordering.t) (lc2:t): Prop :=
  | read_step_intro
      from
      tview2
      (GET: Memory.get loc to mem1 = Some (from, Message.full val released))
      (READABLE: TView.readable (TView.cur (tview lc1)) loc to released ord)
      (TVIEW: TView.read_tview (tview lc1) loc to released ord = tview2)
      (LC2: lc2 = mk tview2 (promises lc1)):
      read_step lc1 mem1 loc to val released ord lc2
  .
  #[global]
  Hint Constructors read_step: core.

  Inductive write_step (lc1:t) (sc1:TimeMap.t) (mem1:Memory.t) (loc:Loc.t) (from to:Time.t) (val:Const.t) (releasedm released:option View.t) (ord:Ordering.t) (lc2:t) (sc2:TimeMap.t) (mem2:Memory.t) (kind:Memory.op_kind): Prop :=
  | write_step_intro
      promises2
      (RELEASED: released = TView.write_released (tview lc1) sc1 loc to releasedm ord)
      (WRITABLE: TView.writable (TView.cur (tview lc1)) sc1 loc to ord)
      (WRITE: Memory.write (promises lc1) mem1 loc from to val released promises2 mem2 kind)
      (RELEASE: Ordering.le Ordering.strong_relaxed ord -> Memory.nonsynch_loc loc (promises lc1))
      (LC2: lc2 = mk (TView.write_tview (tview lc1) sc1 loc to ord) promises2)
      (SC2: sc2 = sc1):
      write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
  .
  #[global]
  Hint Constructors write_step: core.

  Inductive fence_step (lc1:t) (sc1:TimeMap.t) (ordr ordw:Ordering.t) (lc2:t) (sc2:TimeMap.t): Prop :=
  | fence_step_intro
      tview2
      (READ: TView.read_fence_tview (tview lc1) ordr = tview2)
      (RELEASE: Ordering.le Ordering.strong_relaxed ordw -> Memory.nonsynch (promises lc1))
      (LC2: lc2 = mk (TView.write_fence_tview tview2 sc1 ordw) (promises lc1))
      (SC2: sc2 = TView.write_fence_sc tview2 sc1 ordw):
      fence_step lc1 sc1 ordr ordw lc2 sc2
  .
  #[global]
  Hint Constructors fence_step: core.

  Inductive failure_step (lc1:t): Prop :=
  | failure_step_intro
      (CONSISTENT: promise_consistent lc1)
  .
  #[global]
  Hint Constructors failure_step: core.

  Inductive program_step:
    forall (e:ThreadEvent.t) (lc1:t) (sc1:TimeMap.t) (mem1:Memory.t) (lc2:t) (sc2:TimeMap.t) (mem2:Memory.t), Prop :=
  | step_silent
      lc1 sc1 mem1:
      program_step ThreadEvent.silent lc1 sc1 mem1 lc1 sc1 mem1
  | step_read
      lc1 sc1 mem1
      loc ts val released ord lc2
      (LOCAL: Local.read_step lc1 mem1 loc ts val released ord lc2):
      program_step (ThreadEvent.read loc ts val released ord) lc1 sc1 mem1 lc2 sc1 mem1
  | step_write
      lc1 sc1 mem1
      loc from to val released ord lc2 sc2 mem2 kind
      (LOCAL: Local.write_step lc1 sc1 mem1 loc from to val None released ord lc2 sc2 mem2 kind):
      program_step (ThreadEvent.write loc from to val released ord) lc1 sc1 mem1 lc2 sc2 mem2
  | step_update
      lc1 sc1 mem1
      loc ordr ordw
      tsr valr releasedr releasedw lc2
      tsw valw lc3 sc3 mem3 kind
      (LOCAL1: Local.read_step lc1 mem1 loc tsr valr releasedr ordr lc2)
      (LOCAL2: Local.write_step lc2 sc1 mem1 loc tsr tsw valw releasedr releasedw ordw lc3 sc3 mem3 kind):
      program_step (ThreadEvent.update loc tsr tsw valr valw releasedr releasedw ordr ordw) lc1 sc1 mem1 lc3 sc3 mem3
  | step_fence
      lc1 sc1 mem1
      ordr ordw lc2 sc2
      (LOCAL: Local.fence_step lc1 sc1 ordr ordw lc2 sc2):
      program_step (ThreadEvent.fence ordr ordw) lc1 sc1 mem1 lc2 sc2 mem1
  | step_syscall
      lc1 sc1 mem1
      e lc2 sc2
      (LOCAL: Local.fence_step lc1 sc1 Ordering.seqcst Ordering.seqcst lc2 sc2):
      program_step (ThreadEvent.syscall e) lc1 sc1 mem1 lc2 sc2 mem1
  | step_failure
      lc1 sc1 mem1
      (LOCAL: Local.failure_step lc1):
      program_step ThreadEvent.failure lc1 sc1 mem1 lc1 sc1 mem1
  .
  #[global]
  Hint Constructors program_step: core.

  (* step_future *)

  Lemma promise_step_future
        lc1 sc1 mem1 loc from to msg lc2 mem2 kind
        (STEP: promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1):
    <<WF2: wf lc2 mem2>> /\
    <<SC2: Memory.closed_timemap sc1 mem2>> /\
    <<CLOSED2: Memory.closed mem2>> /\
    <<FUTURE: Memory.future mem1 mem2>> /\
    <<TVIEW_FUTURE: TView.le (tview lc1) (tview lc2)>> /\
    <<MSG_WF: Message.wf msg>> /\
    <<MSG_TS: Memory.message_to msg loc to>> /\
    <<MSG_CLOSED: Memory.closed_message msg mem2>>.
  Proof.
    inv WF1. inv STEP.
    exploit Memory.promise_future; eauto. i. des.
    splits; ss.
    - econs; ss. eapply TView.future_closed; eauto.
    - eapply Memory.future_closed_timemap; eauto.
    - refl.
    - inv PROMISE.
      + inv PROMISES0. inv ADD. auto.
      + inv PROMISES0. inv SPLIT. auto.
      + inv PROMISES0. inv LOWER. auto.
      + econs.
    - by inv PROMISE.
  Qed.

  Lemma read_step_future
        lc1 mem1 loc ts val released ord lc2
        (STEP: read_step lc1 mem1 loc ts val released ord lc2)
        (WF1: wf lc1 mem1)
        (CLOSED1: Memory.closed mem1):
    <<WF2: wf lc2 mem1>> /\
    <<TVIEW_FUTURE: TView.le (tview lc1) (tview lc2)>> /\
    <<REL_WF: View.opt_wf released>> /\
    <<REL_CLOSED: Memory.closed_opt_view released mem1>>.
  Proof.
    inv WF1. inv STEP.
    dup CLOSED1. inv CLOSED0. exploit CLOSED; eauto. i. des.
    inv MSG_WF. inv MSG_CLOSED.
    exploit TViewFacts.read_future; try exact GET; eauto.
    i. des. splits; auto.
    - econs; eauto.
    - apply TViewFacts.read_tview_incr.
  Qed.

  Lemma write_step_future
        lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
        (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
        (REL_WF: View.opt_wf releasedm)
        (REL_CLOSED: Memory.closed_opt_view releasedm mem1)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1):
    <<WF2: wf lc2 mem2>> /\
    <<SC2: Memory.closed_timemap sc2 mem2>> /\
    <<CLOSED2: Memory.closed mem2>> /\
    <<TVIEW_FUTURE: TView.le (tview lc1) (tview lc2)>> /\
    <<SC_FUTURE: TimeMap.le sc1 sc2>> /\
    <<MEM_FUTURE: Memory.future mem1 mem2>> /\
    <<REL_WF: View.opt_wf released>> /\
    <<REL_TS: Time.le ((View.rlx (View.unwrap released)) loc) to>> /\
    <<REL_CLOSED: Memory.closed_opt_view released mem2>>.
  Proof.
    inv WF1. inv STEP.
    exploit TViewFacts.write_future; eauto.
    { inv WRITE. eapply Memory.promise_op. eauto. }
    s. i. des.
    exploit Memory.write_future; try apply WRITE; eauto. i. des.
    exploit Memory.write_get2; try apply WRITE; eauto; try by viewtac. i. des.
    splits; eauto.
    - apply TViewFacts.write_tview_incr. auto.
    - refl.
    - inv WRITE. inv PROMISE; try inv TS; ss.
  Qed.

  Lemma write_step_non_cancel
        lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
        (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind):
    negb (Memory.op_kind_is_cancel kind).
  Proof.
    inv STEP. inv WRITE. inv PROMISE; ss.
  Qed.

  Lemma write_step_strong_relaxed
        lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
        (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
        (ORD: Ordering.le Ordering.strong_relaxed ord):
    negb (Memory.op_kind_is_lower kind).
  Proof.
    inv STEP. inv WRITE. ss.
    destruct kind; ss.
    inv PROMISE. des. subst.
    exploit Memory.lower_get0; try exact PROMISES. i. des.
    exploit RELEASE; eauto. inv MSG_LE; eauto. i. subst.
    inv RELEASED. revert H0.
    unfold TView.write_released. condtac; ss. destruct ord; ss.
  Qed.

  Lemma fence_step_future
        lc1 sc1 mem1 ordr ordw lc2 sc2
        (STEP: fence_step lc1 sc1 ordr ordw lc2 sc2)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1):
    <<WF2: wf lc2 mem1>> /\
    <<SC2: Memory.closed_timemap sc2 mem1>> /\
    <<TVIEW_FUTURE: TView.le (tview lc1) (tview lc2)>> /\
    <<SC_FUTURE: TimeMap.le sc1 sc2>>.
  Proof.
    inv WF1. inv STEP.
    exploit TViewFacts.read_fence_future; eauto. i. des.
    exploit TViewFacts.write_fence_future; eauto. i. des.
    splits; eauto.
    - etrans.
      + apply TViewFacts.write_fence_tview_incr. auto.
      + apply TViewFacts.write_fence_tview_mon; eauto; try refl.
        apply TViewFacts.read_fence_tview_incr. auto.
    - apply TViewFacts.write_fence_sc_incr.
  Qed.

  Lemma program_step_future
        e lc1 sc1 mem1 lc2 sc2 mem2
        (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1):
    <<WF2: wf lc2 mem2>> /\
    <<SC2: Memory.closed_timemap sc2 mem2>> /\
    <<CLOSED2: Memory.closed mem2>> /\
    <<TVIEW_FUTURE: TView.le (tview lc1) (tview lc2)>> /\
    <<SC_FUTURE: TimeMap.le sc1 sc2>> /\
    <<MEM_FUTURE: Memory.future mem1 mem2>>.
  Proof.
    inv STEP.
    - esplits; eauto; try refl.
    - exploit read_step_future; eauto. i. des.
      esplits; eauto; try refl.
    - exploit write_step_future; eauto; try by econs. i. des.
      esplits; eauto; try refl.
    - exploit read_step_future; eauto. i. des.
      exploit write_step_future; eauto; try by econs. i. des.
      esplits; eauto. etrans; eauto.
    - exploit fence_step_future; eauto. i. des. esplits; eauto; try refl.
    - exploit fence_step_future; eauto. i. des. esplits; eauto; try refl.
    - esplits; eauto; try refl.
  Qed.

  Lemma promise_step_inhabited
        lc1 mem1 loc from to msg lc2 mem2 kind
        (STEP: promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
        (INHABITED1: Memory.inhabited mem1):
    <<INHABITED2: Memory.inhabited mem2>>.
  Proof.
    inv STEP.
    inv PROMISE; eauto using Memory.add_inhabited, Memory.split_inhabited, Memory.lower_inhabited, Memory.cancel_inhabited.
  Qed.

  Lemma program_step_inhabited
        e lc1 sc1 mem1 lc2 sc2 mem2
        (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
        (INHABITED1: Memory.inhabited mem1):
    <<INHABITED2: Memory.inhabited mem2>>.
  Proof.
    inv STEP; eauto.
    - inv LOCAL. inv WRITE.
      inv PROMISE; eauto using Memory.add_inhabited, Memory.split_inhabited, Memory.lower_inhabited, Memory.cancel_inhabited.
    - inv LOCAL2. inv WRITE.
      inv PROMISE; eauto using Memory.add_inhabited, Memory.split_inhabited, Memory.lower_inhabited, Memory.cancel_inhabited.
  Qed.

  (* step_disjoint *)

  Lemma promise_step_disjoint
        lc1 sc1 mem1 loc from to msg lc2 mem2 lc kind
        (STEP: promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1)
        (DISJOINT1: disjoint lc1 lc)
        (WF: wf lc mem1):
    <<DISJOINT2: disjoint lc2 lc>> /\
    <<WF: wf lc mem2>>.
  Proof.
    inv WF1. inv DISJOINT1. inversion WF. inv STEP.
    exploit Memory.promise_future; try apply PROMISE; eauto. i. des.
    exploit Memory.promise_disjoint; try apply PROMISE; eauto. i. des.
    splits; ss. econs; eauto.
    eapply TView.future_closed; eauto.
  Qed.

  Lemma read_step_disjoint
        lc1 mem1 lc2 loc ts val released ord lc
        (STEP: read_step lc1 mem1 loc ts val released ord lc2)
        (WF1: wf lc1 mem1)
        (DISJOINT1: disjoint lc1 lc)
        (WF: wf lc mem1):
    disjoint lc2 lc.
  Proof.
    inv WF1. inv DISJOINT1. inv WF. inv STEP. ss.
  Qed.

  Lemma write_step_disjoint
        lc1 sc1 mem1 lc2 sc2 loc from to val releasedm released ord mem2 kind lc
        (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1)
        (DISJOINT1: disjoint lc1 lc)
        (WF: wf lc mem1):
    <<DISJOINT2: disjoint lc2 lc>> /\
    <<WF: wf lc mem2>>.
  Proof.
    inv WF1. inv DISJOINT1. inversion WF. inv STEP.
    exploit Memory.write_disjoint; try apply WRITE; eauto. i. des.
    splits; ss. econs; eauto.
    inv WRITE. eapply TView.promise_closed; eauto.
  Qed.

  Lemma fence_step_disjoint
        lc1 sc1 mem1 lc2 sc2 ordr ordw lc
        (STEP: fence_step lc1 sc1 ordr ordw lc2 sc2)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (DISJOINT1: disjoint lc1 lc)
        (WF: wf lc mem1):
    <<DISJOINT2: disjoint lc2 lc>> /\
    <<WF: wf lc mem1>>.
  Proof.
    inv WF1. inv DISJOINT1. inv WF. inv STEP. splits; ss.
  Qed.

  Lemma read_step_promises
        lc1 mem loc to val released ord lc2
        (READ: read_step lc1 mem loc to val released ord lc2):
    (promises lc1) = (promises lc2).
  Proof.
    inv READ. auto.
  Qed.

  Lemma program_step_disjoint
        e lc1 sc1 mem1 lc2 sc2 mem2 lc
        (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
        (WF1: wf lc1 mem1)
        (SC1: Memory.closed_timemap sc1 mem1)
        (CLOSED1: Memory.closed mem1)
        (DISJOINT1: disjoint lc1 lc)
        (WF: wf lc mem1):
    <<DISJOINT2: disjoint lc2 lc>> /\
    <<WF: wf lc mem2>>.
  Proof.
    inv STEP.
    - esplits; eauto.
    - exploit read_step_disjoint; eauto.
    - exploit write_step_disjoint; eauto.
    - exploit read_step_future; eauto. i. des.
      exploit read_step_disjoint; eauto. i. des.
      exploit write_step_disjoint; eauto.
    - exploit fence_step_disjoint; eauto.
    - exploit fence_step_disjoint; eauto.
    - esplits; eauto.
  Qed.

  (* step_no_reserve_except *)

  Lemma promise_step_no_reserve_except
        lc1 mem1 loc from to msg lc2 mem2 kind
        (STEP: promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
        (RESERVE1: Memory.reserve_wf (promises lc1) mem1)
        (NORESERVE1: Memory.no_reserve_except (promises lc1) mem1):
    Memory.no_reserve_except (promises lc2) mem2.
  Proof.
    ii. inv STEP. s.
    eapply Memory.promise_no_reserve_except; eauto.
  Qed.

  Lemma program_step_no_reserve_except
        e lc1 sc1 mem1 lc2 sc2 mem2
        (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
        (RESERVE1: Memory.reserve_wf (promises lc1) mem1)
        (NORESERVE1: Memory.no_reserve_except (promises lc1) mem1):
    Memory.no_reserve_except (promises lc2) mem2.
  Proof.
    ii. inv STEP; try inv LOCAL; eauto; ss.
    - inv WRITE.
      erewrite Memory.remove_o; eauto. condtac; ss.
      + des. subst.
        exploit Memory.promise_get0; eauto.
        { inv PROMISE; ss. }
        i. des. congr.
      + eapply Memory.promise_no_reserve_except; eauto.
    - inv LOCAL1. inv LOCAL2. inv WRITE. ss.
      erewrite Memory.remove_o; eauto. condtac; ss.
      + des. subst.
        exploit Memory.promise_get0; eauto.
        { inv PROMISE; ss. }
        i. des. congr.
      + eapply Memory.promise_no_reserve_except; eauto.
  Qed.

  Lemma program_step_promises_bot
        e lc1 sc1 mem1 lc2 sc2 mem2
        (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
        (PROMISES: (promises lc1) = Memory.bot):
    (promises lc2) = Memory.bot.
  Proof.
    inv STEP; try inv LOCAL; ss.
    - eapply Memory.write_promises_bot; eauto.
    - inv LOCAL1. inv LOCAL2.
      eapply Memory.write_promises_bot; eauto.
  Qed.
End Local.


Require Export concurrency.paco.src.paconotation concurrency.paco.src.pacotac concurrency.paco.src.pacodef concurrency.paco.src.pacotacuser.
Set Implicit Arguments.

(** ** Predicates of Arity 7
*)

(** 1 Mutual Coinduction *)

Section Arg7_1.

Definition monotone7 T0 T1 T2 T3 T4 T5 T6 (gf: rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6) :=
  forall x0 x1 x2 x3 x4 x5 x6 r r' (IN: gf r x0 x1 x2 x3 x4 x5 x6) (LE: r <7= r'), gf r' x0 x1 x2 x3 x4 x5 x6.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable gf : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf [].

Theorem paco7_acc: forall
  l r (OBG: forall rr (INC: r <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7 gf rr),
  l <7= paco7 gf r.
Proof.
  intros; assert (SIM: paco7 gf (r \7/ l) x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_mon: monotone7 (paco7 gf).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_mult_strong: forall r,
  paco7 gf (upaco7 gf r) <7= paco7 gf r.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Corollary paco7_mult: forall r,
  paco7 gf (paco7 gf r) <7= paco7 gf r.
Proof. intros; eapply paco7_mult_strong, paco7_mon; eauto. Qed.

Theorem paco7_fold: forall r,
  gf (upaco7 gf r) <7= paco7 gf r.
Proof. intros; econstructor; [ |eauto]; eauto. Qed.

Theorem paco7_unfold: forall (MON: monotone7 gf) r,
  paco7 gf r <7= gf (upaco7 gf r).
Proof. unfold monotone7; intros; destruct PR; eauto. Qed.

End Arg7_1.

Hint Unfold monotone7.
Hint Resolve paco7_fold.

Implicit Arguments paco7_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].

Instance paco7_inst  T0 T1 T2 T3 T4 T5 T6 (gf : rel7 T0 T1 T2 T3 T4 T5 T6->_) r x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7 gf r x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_acc gf;
  pacomult   := paco7_mult gf;
  pacofold   := paco7_fold gf;
  pacounfold := paco7_unfold gf }.

(** 2 Mutual Coinduction *)

Section Arg7_2.

Definition monotone7_2 T0 T1 T2 T3 T4 T5 T6 (gf: rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6) :=
  forall x0 x1 x2 x3 x4 x5 x6 r_0 r_1 r'_0 r'_1 (IN: gf r_0 r_1 x0 x1 x2 x3 x4 x5 x6) (LE_0: r_0 <7= r'_0)(LE_1: r_1 <7= r'_1), gf r'_0 r'_1 x0 x1 x2 x3 x4 x5 x6.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable gf_0 gf_1 : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].

Theorem paco7_2_0_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_0 <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7_2_0 gf_0 gf_1 rr r_1),
  l <7= paco7_2_0 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco7_2_0 gf_0 gf_1 (r_0 \7/ l) r_1 x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_2_1_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_1 <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7_2_1 gf_0 gf_1 r_0 rr),
  l <7= paco7_2_1 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco7_2_1 gf_0 gf_1 r_0 (r_1 \7/ l) x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_2_0_mon: monotone7_2 (paco7_2_0 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_2_1_mon: monotone7_2 (paco7_2_1 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_2_0_mult_strong: forall r_0 r_1,
  paco7_2_0 gf_0 gf_1 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_0 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_2_1_mult_strong: forall r_0 r_1,
  paco7_2_1 gf_0 gf_1 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_1 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Corollary paco7_2_0_mult: forall r_0 r_1,
  paco7_2_0 gf_0 gf_1 (paco7_2_0 gf_0 gf_1 r_0 r_1) (paco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco7_2_0_mult_strong, paco7_2_0_mon; eauto. Qed.

Corollary paco7_2_1_mult: forall r_0 r_1,
  paco7_2_1 gf_0 gf_1 (paco7_2_0 gf_0 gf_1 r_0 r_1) (paco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco7_2_1_mult_strong, paco7_2_1_mon; eauto. Qed.

Theorem paco7_2_0_fold: forall r_0 r_1,
  gf_0 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco7_2_1_fold: forall r_0 r_1,
  gf_1 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1) <7= paco7_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco7_2_0_unfold: forall (MON: monotone7_2 gf_0) (MON: monotone7_2 gf_1) r_0 r_1,
  paco7_2_0 gf_0 gf_1 r_0 r_1 <7= gf_0 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone7_2; intros; destruct PR; eauto. Qed.

Theorem paco7_2_1_unfold: forall (MON: monotone7_2 gf_0) (MON: monotone7_2 gf_1) r_0 r_1,
  paco7_2_1 gf_0 gf_1 r_0 r_1 <7= gf_1 (upaco7_2_0 gf_0 gf_1 r_0 r_1) (upaco7_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone7_2; intros; destruct PR; eauto. Qed.

End Arg7_2.

Hint Unfold monotone7_2.
Hint Resolve paco7_2_0_fold.
Hint Resolve paco7_2_1_fold.

Implicit Arguments paco7_2_0_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_0_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_0_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_0_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_0_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_0_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_2_1_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].

Instance paco7_2_0_inst  T0 T1 T2 T3 T4 T5 T6 (gf_0 gf_1 : rel7 T0 T1 T2 T3 T4 T5 T6->_) r_0 r_1 x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7_2_0 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_2_0_acc gf_0 gf_1;
  pacomult   := paco7_2_0_mult gf_0 gf_1;
  pacofold   := paco7_2_0_fold gf_0 gf_1;
  pacounfold := paco7_2_0_unfold gf_0 gf_1 }.

Instance paco7_2_1_inst  T0 T1 T2 T3 T4 T5 T6 (gf_0 gf_1 : rel7 T0 T1 T2 T3 T4 T5 T6->_) r_0 r_1 x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7_2_1 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_2_1_acc gf_0 gf_1;
  pacomult   := paco7_2_1_mult gf_0 gf_1;
  pacofold   := paco7_2_1_fold gf_0 gf_1;
  pacounfold := paco7_2_1_unfold gf_0 gf_1 }.

(** 3 Mutual Coinduction *)

Section Arg7_3.

Definition monotone7_3 T0 T1 T2 T3 T4 T5 T6 (gf: rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6) :=
  forall x0 x1 x2 x3 x4 x5 x6 r_0 r_1 r_2 r'_0 r'_1 r'_2 (IN: gf r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6) (LE_0: r_0 <7= r'_0)(LE_1: r_1 <7= r'_1)(LE_2: r_2 <7= r'_2), gf r'_0 r'_1 r'_2 x0 x1 x2 x3 x4 x5 x6.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable T4 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2), Type.
Variable T5 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3), Type.
Variable T6 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1) (x3: @T3 x0 x1 x2) (x4: @T4 x0 x1 x2 x3) (x5: @T5 x0 x1 x2 x3 x4), Type.
Variable gf_0 gf_1 gf_2 : rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6 -> rel7 T0 T1 T2 T3 T4 T5 T6.
Implicit Arguments gf_0 [].
Implicit Arguments gf_1 [].
Implicit Arguments gf_2 [].

Theorem paco7_3_0_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_0 <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7_3_0 gf_0 gf_1 gf_2 rr r_1 r_2),
  l <7= paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco7_3_0 gf_0 gf_1 gf_2 (r_0 \7/ l) r_1 r_2 x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_3_1_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_1 <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7_3_1 gf_0 gf_1 gf_2 r_0 rr r_2),
  l <7= paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco7_3_1 gf_0 gf_1 gf_2 r_0 (r_1 \7/ l) r_2 x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_3_2_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_2 <7= rr) (CIH: l <_paco_7= rr), l <_paco_7= paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 rr),
  l <7= paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 (r_2 \7/ l) x0 x1 x2 x3 x4 x5 x6) by eauto.
  clear PR; repeat (try left; do 8 paco_revert; paco_cofix_auto).
Qed.

Theorem paco7_3_0_mon: monotone7_3 (paco7_3_0 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_3_1_mon: monotone7_3 (paco7_3_1 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_3_2_mon: monotone7_3 (paco7_3_2 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_3_0_mult_strong: forall r_0 r_1 r_2,
  paco7_3_0 gf_0 gf_1 gf_2 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_3_1_mult_strong: forall r_0 r_1 r_2,
  paco7_3_1 gf_0 gf_1 gf_2 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Theorem paco7_3_2_mult_strong: forall r_0 r_1 r_2,
  paco7_3_2 gf_0 gf_1 gf_2 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 8 paco_revert; paco_cofix_auto). Qed.

Corollary paco7_3_0_mult: forall r_0 r_1 r_2,
  paco7_3_0 gf_0 gf_1 gf_2 (paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco7_3_0_mult_strong, paco7_3_0_mon; eauto. Qed.

Corollary paco7_3_1_mult: forall r_0 r_1 r_2,
  paco7_3_1 gf_0 gf_1 gf_2 (paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco7_3_1_mult_strong, paco7_3_1_mon; eauto. Qed.

Corollary paco7_3_2_mult: forall r_0 r_1 r_2,
  paco7_3_2 gf_0 gf_1 gf_2 (paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco7_3_2_mult_strong, paco7_3_2_mon; eauto. Qed.

Theorem paco7_3_0_fold: forall r_0 r_1 r_2,
  gf_0 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco7_3_1_fold: forall r_0 r_1 r_2,
  gf_1 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco7_3_2_fold: forall r_0 r_1 r_2,
  gf_2 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <7= paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco7_3_0_unfold: forall (MON: monotone7_3 gf_0) (MON: monotone7_3 gf_1) (MON: monotone7_3 gf_2) r_0 r_1 r_2,
  paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 <7= gf_0 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone7_3; intros; destruct PR; eauto. Qed.

Theorem paco7_3_1_unfold: forall (MON: monotone7_3 gf_0) (MON: monotone7_3 gf_1) (MON: monotone7_3 gf_2) r_0 r_1 r_2,
  paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 <7= gf_1 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone7_3; intros; destruct PR; eauto. Qed.

Theorem paco7_3_2_unfold: forall (MON: monotone7_3 gf_0) (MON: monotone7_3 gf_1) (MON: monotone7_3 gf_2) r_0 r_1 r_2,
  paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 <7= gf_2 (upaco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone7_3; intros; destruct PR; eauto. Qed.

End Arg7_3.

Hint Unfold monotone7_3.
Hint Resolve paco7_3_0_fold.
Hint Resolve paco7_3_1_fold.
Hint Resolve paco7_3_2_fold.

Implicit Arguments paco7_3_0_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_acc            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_0_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_mon            [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_0_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_mult_strong    [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_0_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_mult           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_0_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_fold           [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_0_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_1_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].
Implicit Arguments paco7_3_2_unfold         [ T0 T1 T2 T3 T4 T5 T6 ].

Instance paco7_3_0_inst  T0 T1 T2 T3 T4 T5 T6 (gf_0 gf_1 gf_2 : rel7 T0 T1 T2 T3 T4 T5 T6->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_3_0_acc gf_0 gf_1 gf_2;
  pacomult   := paco7_3_0_mult gf_0 gf_1 gf_2;
  pacofold   := paco7_3_0_fold gf_0 gf_1 gf_2;
  pacounfold := paco7_3_0_unfold gf_0 gf_1 gf_2 }.

Instance paco7_3_1_inst  T0 T1 T2 T3 T4 T5 T6 (gf_0 gf_1 gf_2 : rel7 T0 T1 T2 T3 T4 T5 T6->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_3_1_acc gf_0 gf_1 gf_2;
  pacomult   := paco7_3_1_mult gf_0 gf_1 gf_2;
  pacofold   := paco7_3_1_fold gf_0 gf_1 gf_2;
  pacounfold := paco7_3_1_unfold gf_0 gf_1 gf_2 }.

Instance paco7_3_2_inst  T0 T1 T2 T3 T4 T5 T6 (gf_0 gf_1 gf_2 : rel7 T0 T1 T2 T3 T4 T5 T6->_) r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6 : paco_class (paco7_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3 x4 x5 x6) :=
{ pacoacc    := paco7_3_2_acc gf_0 gf_1 gf_2;
  pacomult   := paco7_3_2_mult gf_0 gf_1 gf_2;
  pacofold   := paco7_3_2_fold gf_0 gf_1 gf_2;
  pacounfold := paco7_3_2_unfold gf_0 gf_1 gf_2 }.


(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*              Layers of VMM: MShareIntro                             *)
(*                                                                     *)
(*          Introduce the shared-memory                                *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)

(** This file defines the abstract data and the primitives for the PIPCIntro layer,
which will introduce the primtives of thread*)
Require Import Coqlib.
Require Import Maps.
Require Import ASTExtra.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Events.
Require Import Stacklayout.
Require Import Globalenvs.
Require Import AsmX.
Require Import Smallstep.
Require Import AuxStateDataType.
Require Import Constant.
Require Import GlobIdent.
Require Import FlatMemory.
Require Import CommonTactic.
Require Import AuxLemma.
Require Import RealParams.
Require Import PrimSemantics.
Require Import LAsm.
Require Import LoadStoreSem2.
Require Import XOmega.
Require Import ObservationImpl.

Require Import liblayers.logic.PTreeModules.
Require Import liblayers.logic.LayerLogicImpl.
Require Import liblayers.compat.CompatLayers.
Require Import liblayers.compat.CompatGenSem.

Require Import CalRealPTPool.
Require Import CalRealPT.
Require Import CalRealIDPDE.
Require Import CalRealInitPTE.
Require Import CalRealSMSPool.

Require Import INVLemmaContainer.
Require Import INVLemmaMemory.

Require Import AbstractDataType.

Require Export ObjCPU.
Require Export ObjFlatMem.
Require Export ObjContainer.
Require Export ObjVMM.
Require Export ObjLMM.
Require Export ObjShareMem.

(** * Abstract Data and Primitives at this layer*)
Section WITHMEM.

  Local Open Scope Z_scope.

  Context `{real_params: RealParams}.

  (*Record RData :=
    mkRData {
        HP: flatmem; (**r we model the memory from 1G to 3G as heap*)
        ti: trapinfo; (**r abstract of CR2, stores the address where page fault happens*)
        pg: bool; (**r abstract of CR0, indicates whether the paging is enabled or not*)
        ikern: bool; (**r pure logic flag, shows whether it's in kernel mode or not*)
        ihost: bool; (**r logic flag, shows whether it's in the host mode or not*)

        AT: LATable; (**r allocation table*)
        nps: Z; (**r number of the pages*)
        pperm: PPermT; (**r physical page permission table *)

        PT: Z; (**r the current page table index*)
        ptpool: PMapPool; (**r page table pool*)
        idpde: IDPDE; (**r shared identity maps *)
        ipt: bool; (**r pure logic flag, shows whether it's using the kernel's page table*)
        pb : PTBitMap; (**r [page table bit map], indicating which page table has been used*)
        smspool: SharedMemSTPool (**r the shared-memory pool for IPC*)
      }.*)

  (** ** Invariants at this layer *)
  (** [0th page map] is reserved for the kernel thread*)
  Record high_level_invariant (abd: RData) :=
    mkInvariant {
        valid_nps: pg abd = true -> kern_low <= nps abd <= maxpage;
        valid_AT_kern: pg abd = true -> LAT_kern (LAT abd) (nps abd);
        valid_AT_usr: pg abd = true -> LAT_usr (LAT abd) (nps abd);
        valid_kern: ipt abd = false -> pg abd = true;
        valid_iptt: ipt abd = true -> ikern abd = true;
        valid_iptf: ikern abd = false -> ipt abd = false;
        valid_ihost: ihost abd = false -> pg abd = true /\ ikern abd = true;
        valid_container: Container_valid (AC abd);
        valid_pperm_ppage: Lconsistent_ppage (LAT abd) (pperm abd) (nps abd);
        init_pperm: pg abd = false -> (pperm abd) = ZMap.init PGUndef;
        valid_PMap: pg abd = true ->
                    (forall i, 0<= i < num_proc ->
                               PMap_valid (ZMap.get i (ptpool abd)));
        (* 0th page map is reserved for the kernel thread*)
        valid_PT_kern: pg abd = true -> ipt abd = true -> (PT abd) = 0;
        valid_PMap_kern: pg abd = true -> PMap_kern (ZMap.get 0 (ptpool abd));
        valid_PT: pg abd = true -> 0<= PT abd < num_proc;
        valid_dirty: dirty_ppage (pperm abd) (HP abd);

        valid_idpde: pg abd = true -> IDPDE_init (idpde abd);
        valid_pperm_pmap: consistent_pmap (ptpool abd) (pperm abd) (LAT abd) (nps abd);
        valid_pmap_domain: consistent_pmap_domain (ptpool abd) (pperm abd) (LAT abd) (nps abd);
        valid_lat_domain: consistent_lat_domain (ptpool abd) (LAT abd) (nps abd);

        valid_root: pg abd = true -> cused (ZMap.get 0 (AC abd)) = true
      }.

  (** ** Definition of the abstract state ops *)
  Global Instance mshareintro_data_ops : CompatDataOps RData :=
    {
      empty_data := init_adt;
      high_level_invariant := high_level_invariant;
      low_level_invariant := low_level_invariant;
      kernel_mode adt := ikern adt = true /\ ihost adt = true;
      observe := ObservationImpl.observe
    }.

  (** ** Proofs that the initial abstract_data should satisfy the invariants*)
  Section Property_Abstract_Data.

    Lemma empty_data_high_level_invariant:
      high_level_invariant init_adt.
    Proof.
      constructor; simpl; intros; auto; try inv H.
      - apply empty_container_valid.
      - eapply Lconsistent_ppage_init.
      - eapply dirty_ppage_init.
      - eapply consistent_pmap_init.
      - eapply consistent_pmap_domain_init.
      - eapply consistent_lat_domain_init.
    Qed.

    (** ** Definition of the abstract state *)
    Global Instance mshareintro_data_prf : CompatData RData.
    Proof.
      constructor.
      - apply low_level_invariant_incr.
      - apply empty_data_low_level_invariant.
      - apply empty_data_high_level_invariant.
    Qed.

  End Property_Abstract_Data.

  Context `{Hstencil: Stencil}.
  Context `{Hmem: Mem.MemoryModel}.
  Context `{Hmwd: UseMemWithData mem}.

  (** * Proofs that the primitives satisfies the invariants at this layer *)
  Section INV.

    Global Instance flatmem_copy_inv: PreservesInvariants flatmem_copy_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant;
      try eapply dirty_ppage_gss_copy; eauto.
    Qed.

    Section ALLOC.

      Lemma alloc_high_level_inv:
        forall d d' i n,
          alloc_spec i d = Some (d', n) ->
          high_level_invariant d ->
          high_level_invariant d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        inv H0. constructor; simpl; eauto.
        - intros; eapply LAT_kern_norm; eauto. eapply _x.
        - intros; eapply LAT_usr_norm; eauto.
        - eapply alloc_container_valid'; eauto.
        - eapply Lconsistent_ppage_norm_alloc; eauto.
        - intros; congruence.
        - eapply dirty_ppage_gso_alloc; eauto.
        - eapply consistent_pmap_gso_at_false; eauto. apply _x.
        - eapply consistent_pmap_domain_gso_at_false; eauto. apply _x.
        - eapply consistent_lat_domain_gss_nil; eauto.
        - zmap_solve.
      Qed.

      Lemma alloc_low_level_inv:
        forall d d' n n' i,
          alloc_spec i d = Some (d', n) ->
          low_level_invariant n' d ->
          low_level_invariant n' d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        inv H0. constructor; eauto.
      Qed.

      Lemma alloc_kernel_mode:
        forall d d' i n,
          alloc_spec i d = Some (d', n) ->
          kernel_mode d ->
          kernel_mode d'.
      Proof.
        intros. functional inversion H; subst; eauto.
      Qed.

      Global Instance alloc_inv: PreservesInvariants alloc_spec.
      Proof.
        preserves_invariants_simpl'.
        - eapply alloc_low_level_inv; eassumption.
        - eapply alloc_high_level_inv; eassumption.
        - eapply alloc_kernel_mode; eassumption.
      Qed.

    End ALLOC.

    Global Instance pfree_inv: PreservesInvariants pfree_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
      - intros; eapply LAT_kern_norm; eauto.
      - intros; eapply LAT_usr_norm; eauto.
      - eapply Lconsistent_ppage_norm_undef; eauto.
      - eapply dirty_ppage_gso_undef; eauto.
      - eapply consistent_pmap_gso_pperm_alloc; eauto.
      - eapply consistent_pmap_domain_gso_at_0; eauto.
      - eapply consistent_lat_domain_gss_nil; eauto.
    Qed.

    Global Instance trapin_inv: PrimInvariants trapin_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance trapout_inv: PrimInvariants trapout_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance hostin_inv: PrimInvariants hostin_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance hostout_inv: PrimInvariants hostout_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance ptin_inv: PrimInvariants ptin_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance ptout_inv: PrimInvariants ptout_spec.
    Proof.
      PrimInvariants_simpl H H0.
    Qed.

    Global Instance fstore_inv: PreservesInvariants fstore_spec.
    Proof.
      split; intros; inv_generic_sem H; inv H0; functional inversion H2.
      - functional inversion H. split; trivial.
      - functional inversion H.
        split; subst; simpl;
        try (eapply dirty_ppage_store_unmaped; try reflexivity; try eassumption); trivial.
      - functional inversion H0.
        split; simpl; try assumption.
    Qed.

    Global Instance setPT_inv: PreservesInvariants setPT_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
    Qed.

    Global Instance pmap_init_inv: PreservesInvariants pmap_init_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant.
      - apply real_nps_range.
      - apply real_lat_kern_valid.
      - apply real_lat_usr_valid.
      - apply real_container_valid.
      - rewrite init_pperm0; try assumption.
        apply Lreal_pperm_valid.
      - eapply real_pt_PMap_valid; eauto.
      - apply real_pt_PMap_kern.
      - omega.
      - assumption.
      - apply real_idpde_init.
      - apply real_pt_consistent_pmap.
      - apply real_pt_consistent_pmap_domain.
      - apply Lreal_at_consistent_lat_domain.
    Qed.

    Global Instance clearCR2_inv: PreservesInvariants clearCR2_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto.
    Qed.

    Section PTINSERT.

      Section PTINSERT_PTE.

        Lemma ptInsertPTE_high_level_inv:
          forall d d' n vadr padr p,
            ptInsertPTE0_spec n vadr padr p d = Some d' ->
            high_level_invariant d ->
            high_level_invariant d'.
        Proof.
          intros. functional inversion H; subst; eauto.
          inv H0; constructor_gso_simpl_tac; intros.
          - eapply LAT_kern_norm; eauto.
          - eapply LAT_usr_norm; eauto.
          - eapply Lconsistent_ppage_norm; eassumption.
          - eapply PMap_valid_gso_valid; eauto.
          - functional inversion H2. functional inversion H1.
            eapply PMap_kern_gso; eauto.
          - functional inversion H2. functional inversion H0.
            eapply consistent_pmap_ptp_same; try eassumption.
            eapply consistent_pmap_gso_pperm_alloc'; eassumption.
          - functional inversion H2.
            eapply consistent_pmap_domain_append; eauto.
            destruct (ZMap.get pti pdt); try contradiction;
            red; intros (v0 & p0 & He); contra_inv.
          - eapply consistent_lat_domain_gss_append; eauto.
            subst pti; destruct (ZMap.get (PTX vadr) pdt); try contradiction;
            red; intros (v0 & p0 & He); contra_inv.
        Qed.

        Lemma ptInsertPTE_low_level_inv:
          forall d d' n vadr padr p n',
            ptInsertPTE0_spec n vadr padr p d = Some d' ->
            low_level_invariant n' d ->
            low_level_invariant n' d'.
        Proof.
          intros. functional inversion H; subst; eauto.
          inv H0. constructor; eauto.
        Qed.

        Lemma ptInsertPTE_kernel_mode:
          forall d d' n vadr padr p,
            ptInsertPTE0_spec n vadr padr p d = Some d' ->
            kernel_mode d ->
            kernel_mode d'.
        Proof.
          intros. functional inversion H; subst; eauto.
        Qed.

      End PTINSERT_PTE.

      Section PTALLOCPDE.

        Lemma ptAllocPDE_high_level_inv:
          forall d d' n vadr v,
            ptAllocPDE0_spec n vadr d = Some (d', v) ->
            high_level_invariant d ->
            high_level_invariant d'.
        Proof.
          intros. functional inversion H; subst; eauto.
          inv H0; constructor_gso_simpl_tac; intros.
          - eapply LAT_kern_norm; eauto. eapply _x.
          - eapply LAT_usr_norm; eauto.
          - eapply alloc_container_valid'; eauto.
          - apply Lconsistent_ppage_norm_hide; try assumption.
          - congruence.
          - eapply PMap_valid_gso_pde_unp; eauto.
            eapply real_init_PTE_defined.
          - functional inversion H3.
            eapply PMap_kern_gso; eauto.
          - eapply dirty_ppage_gss; eauto.
          - eapply consistent_pmap_ptp_gss; eauto; apply _x.
          - eapply consistent_pmap_domain_gso_at_false; eauto; try apply _x.
            eapply consistent_pmap_domain_ptp_unp; eauto.
            apply real_init_PTE_unp.
          - apply consistent_lat_domain_gss_nil; eauto.
            apply consistent_lat_domain_gso_p; eauto.
          - zmap_solve.
        Qed.

        Lemma ptAllocPDE_low_level_inv:
          forall d d' n vadr v n',
            ptAllocPDE0_spec n vadr d = Some (d', v) ->
            low_level_invariant n' d ->
            low_level_invariant n' d'.
        Proof.
          intros. functional inversion H; try congruence; subst; eauto.
          inv H0. constructor; eauto.
        Qed.

        Lemma ptAllocPDE_kernel_mode:
          forall d d' n vadr v,
            ptAllocPDE0_spec n vadr d = Some (d', v) ->
            kernel_mode d ->
            kernel_mode d'.
        Proof.
          intros. functional inversion H; try congruence; subst; eauto.
        Qed.

      End PTALLOCPDE.

      Lemma ptInsert_high_level_inv:
        forall d d' n vadr padr p v,
          ptInsert0_spec n vadr padr p d = Some (d', v) ->
          high_level_invariant d ->
          high_level_invariant d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        - eapply ptInsertPTE_high_level_inv; eassumption.
        - eapply ptAllocPDE_high_level_inv; eassumption.
        - eapply ptInsertPTE_high_level_inv; try eassumption.
          eapply ptAllocPDE_high_level_inv; eassumption.
      Qed.

      Lemma ptInsert_low_level_inv:
        forall d d' n vadr padr p n' v,
          ptInsert0_spec n vadr padr p d = Some (d', v) ->
          low_level_invariant n' d ->
          low_level_invariant n' d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        - eapply ptInsertPTE_low_level_inv; eassumption.
        - eapply ptAllocPDE_low_level_inv; eassumption.
        - eapply ptInsertPTE_low_level_inv; try eassumption.
          eapply ptAllocPDE_low_level_inv; eassumption.
      Qed.

      Lemma ptInsert_kernel_mode:
        forall d d' n vadr padr p v,
          ptInsert0_spec n vadr padr p d = Some (d', v) ->
          kernel_mode d ->
          kernel_mode d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        - eapply ptInsertPTE_kernel_mode; eassumption.
        - eapply ptAllocPDE_kernel_mode; eassumption.
        - eapply ptInsertPTE_kernel_mode; try eassumption.
          eapply ptAllocPDE_kernel_mode; eassumption.
      Qed.

    End PTINSERT.

    Section PTRESV.

      Lemma ptResv_high_level_inv:
        forall d d' n vadr p v,
          ptResv_spec n vadr p d = Some (d', v) ->
          high_level_invariant d ->
          high_level_invariant d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        eapply ptInsert_high_level_inv; try eassumption.
        eapply alloc_high_level_inv; eassumption.
      Qed.

      Lemma ptResv_low_level_inv:
        forall d d' n vadr p n' v,
          ptResv_spec n vadr p d = Some (d', v) ->
          low_level_invariant n' d ->
          low_level_invariant n' d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        eapply ptInsert_low_level_inv; try eassumption.
        eapply alloc_low_level_inv; eassumption.
      Qed.

      Lemma ptResv_kernel_mode:
        forall d d' n vadr p v,
          ptResv_spec n vadr p d = Some (d', v) ->
          kernel_mode d ->
          kernel_mode d'.
      Proof.
        intros. functional inversion H; subst; eauto.
        eapply ptInsert_kernel_mode; try eassumption.
        eapply alloc_kernel_mode; eassumption.
      Qed.

      Global Instance ptResv_inv: PreservesInvariants ptResv_spec.
      Proof.
        preserves_invariants_simpl'.
        - eapply ptResv_low_level_inv; eassumption.
        - eapply ptResv_high_level_inv; eassumption.
        - eapply ptResv_kernel_mode; eassumption.
      Qed.

    End PTRESV.

    Section PTRESV2.

      Lemma ptResv2_high_level_inv:
        forall d d' n vadr p n' vadr' p' v,
          ptResv2_spec n vadr p n' vadr' p' d = Some (d', v) ->
          high_level_invariant d ->
          high_level_invariant d'.
      Proof.
        intros; functional inversion H; subst; eauto;
        eapply ptInsert_high_level_inv; try eassumption.
        - eapply alloc_high_level_inv; eassumption.
        - eapply ptInsert_high_level_inv; try eassumption.
          eapply alloc_high_level_inv; eassumption.
      Qed.

      Lemma ptResv2_low_level_inv:
        forall d d' n vadr p n' vadr' p' l v,
          ptResv2_spec n vadr p n' vadr' p' d = Some (d', v) ->
          low_level_invariant l d ->
          low_level_invariant l d'.
      Proof.
        intros; functional inversion H; subst; eauto;
        eapply ptInsert_low_level_inv; try eassumption.
        - eapply alloc_low_level_inv; eassumption.
        - eapply ptInsert_low_level_inv; try eassumption.
          eapply alloc_low_level_inv; eassumption.
      Qed.

      Lemma ptResv2_kernel_mode:
        forall d d' n vadr p n' vadr' p' v,
          ptResv2_spec n vadr p n' vadr' p' d = Some (d', v) ->
          kernel_mode d ->
          kernel_mode d'.
      Proof.
        intros; functional inversion H; subst; eauto;
        eapply ptInsert_kernel_mode; try eassumption.
        - eapply alloc_kernel_mode; eassumption.
        - eapply ptInsert_kernel_mode; try eassumption.
          eapply alloc_kernel_mode; eassumption.
      Qed.

      Global Instance ptResv2_inv: PreservesInvariants ptResv2_spec.
      Proof.
        preserves_invariants_simpl'.
        - eapply ptResv2_low_level_inv; eassumption.
        - eapply ptResv2_high_level_inv; eassumption.
        - eapply ptResv2_kernel_mode; eassumption.
      Qed.

    End PTRESV2.

    Global Instance pt_new_inv: PreservesInvariants pt_new_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2;
       rename i into id, i0 into q, z into i.
      - exploit split_container_valid; eauto.
        eapply container_split_some; eauto.
        auto.
      - unfold update_cusage, update_cchildren; zmap_solve.
    Qed.

    Global Instance set_shared_mem_state_inv:
      PreservesInvariants set_shared_mem_state_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
    Qed.

    Global Instance set_shared_mem_seen_inv:
      PreservesInvariants set_shared_mem_seen_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
    Qed.

    Global Instance set_shared_mem_loc_inv:
      PreservesInvariants set_shared_mem_loc_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
    Qed.

    Global Instance clear_shared_mem_inv:
      PreservesInvariants clear_shared_mem_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; eauto 2.
    Qed.

    Global Instance device_output_inv: PreservesInvariants device_output_spec.
    Proof.
      preserves_invariants_simpl'' low_level_invariant high_level_invariant; eauto.
    Qed.

  End INV.

  (** * Specification of primitives that will be implemented at this layer*)
  Definition exec_loadex {F V} := exec_loadex2 (F := F) (V := V).

  Definition exec_storeex {F V} :=  exec_storeex2 (flatmem_store:= flatmem_store) (F := F) (V := V).

  Global Instance flatmem_store_inv: FlatmemStoreInvariant (flatmem_store:= flatmem_store).
  Proof.
    split; inversion 1; intros.
    - functional inversion H0. split; trivial.
    - functional inversion H1.
      split; simpl; try (eapply dirty_ppage_store_unmaped'; try reflexivity; try eassumption); trivial.
  Qed.

  Global Instance trapinfo_set_inv: TrapinfoSetInvariant.
  Proof.
    split; inversion 1; intros; constructor; auto.
  Qed.

  (** * Layer Definition *)
  Definition mshareintro_fresh : compatlayer (cdata RData) :=
    clear_shared_mem ↦ gensem clear_shared_mem_spec
                     ⊕ get_shared_mem_state ↦ gensem get_shared_mem_state_spec
                     ⊕ get_shared_mem_seen ↦ gensem get_shared_mem_seen_spec
                     ⊕ get_shared_mem_loc ↦ gensem get_shared_mem_loc_spec
                     ⊕ set_shared_mem_state ↦ gensem set_shared_mem_state_spec
                     ⊕ set_shared_mem_seen ↦ gensem set_shared_mem_seen_spec
                     ⊕ set_shared_mem_loc ↦ gensem set_shared_mem_loc_spec.

  Definition mshareintro_passthrough : compatlayer (cdata RData) :=
    fload ↦ gensem fload_spec
          ⊕ fstore ↦ gensem fstore_spec
          ⊕ flatmem_copy ↦ gensem flatmem_copy_spec
          ⊕ vmxinfo_get ↦ gensem vmxinfo_get_spec
          ⊕ device_output ↦ gensem device_output_spec
          ⊕ pfree ↦ gensem pfree_spec
          ⊕ set_pt ↦ gensem setPT_spec
          ⊕ pt_read ↦ gensem ptRead_spec
          ⊕ pt_resv ↦ gensem ptResv_spec
          ⊕ pt_resv2 ↦ gensem ptResv2_spec
          ⊕ pt_new ↦ gensem pt_new_spec
          (*⊕ pt_free ↦ gensem pt_free_spec*)
          ⊕ pmap_init ↦ gensem pmap_init_spec

          ⊕ pt_in ↦ primcall_general_compatsem' ptin_spec (prim_ident:= pt_in)
          ⊕ pt_out ↦ primcall_general_compatsem' ptout_spec (prim_ident:= pt_out)
          ⊕ clear_cr2 ↦ gensem clearCR2_spec
          ⊕ container_get_nchildren ↦ gensem container_get_nchildren_spec
          ⊕ container_get_quota ↦ gensem container_get_quota_spec
          ⊕ container_get_usage ↦ gensem container_get_usage_spec
          ⊕ container_can_consume ↦ gensem container_can_consume_spec
          ⊕ container_alloc ↦ gensem alloc_spec
          ⊕ trap_in ↦ primcall_general_compatsem trapin_spec
          ⊕ trap_out ↦ primcall_general_compatsem trapout_spec
          ⊕ host_in ↦ primcall_general_compatsem hostin_spec
          ⊕ host_out ↦ primcall_general_compatsem hostout_spec
          ⊕ trap_get ↦ primcall_trap_info_get_compatsem trap_info_get_spec
          ⊕ trap_set ↦ primcall_trap_info_ret_compatsem trap_info_ret_spec
          ⊕ accessors ↦ {| exec_load := @exec_loadex; exec_store := @exec_storeex |}.

  Definition mshareintro : compatlayer (cdata RData) := mshareintro_fresh ⊕ mshareintro_passthrough.

End WITHMEM.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
From extructures Require Import ord fset fmap.
From CoqUtils Require Import word.
Require Import lib.utils lib.ssr_list_utils common.types.
Require Import cfi.property cfi.classes.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Module Abs.

Open Scope bool_scope.

Section WithClasses.

Context (mt : machine_types).
Context {ops : machine_ops mt}.
Context {opss : machine_ops_spec ops}.

Open Scope word_scope.

Local Notation word := (mword mt).
Local Notation "x .+1" := (x + 1).

Local Notation imemory := {fmap word -> word}.
Local Notation dmemory := {fmap word -> word}.
Local Notation registers := {fmap reg mt -> word}.

Record state := State {
  imem : imemory;
  dmem : dmemory;
  regs : registers;
  pc   : word;
  cont : bool (* machine stops when this is false;
                 this starts out as true in initial state *)
}.

Definition cfi_abs_state_eq (s1 s2 : state) :=
  [&& imem s1 == imem s2,
      dmem s1 == dmem s2,
      regs s1 == regs s2,
      pc s1 == pc s2 &
      cont s1 == cont s2].

Lemma cfi_abs_state_eqP : Equality.axiom cfi_abs_state_eq.
Proof.
move=> [?????] [?????]; apply/(iffP idP).
  by case/and5P=> /=; do !move => /= /eqP ->.
by case; do !move => ->; rewrite /cfi_abs_state_eq !eqxx.
Qed.

Definition cfi_abs_state_eqMixin := EqMixin cfi_abs_state_eqP.
Canonical cfi_abs_state_eqType :=
  Eval hnf in EqType state cfi_abs_state_eqMixin.

(* Para-virtualizing system calls, since CFI doesn't have any system
   calls of its own and dealing with them is an interesting problem *)
Record syscall := Syscall {
  sem : state -> option state
}.

Definition syscall_table := {fmap word -> syscall}.

Variable table : syscall_table.

Context {ids : cfi_id mt}.

Variable cfg : id -> id -> bool.

Definition valid_jmp := classes.valid_jmp cfg.

Implicit Types imem : imemory.
Implicit Types dmem : dmemory.
Implicit Types reg : registers.

Inductive step : state -> state -> Prop :=
| step_nop : forall imem dmem reg pc i,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Nop _)),
             step (State imem dmem reg pc true) (State imem dmem reg pc.+1 true)
| step_const : forall imem dmem reg reg' pc i n r,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Const n r)),
             forall (UPD : updm reg r (swcast n) = Some reg'),
             step (State imem dmem reg pc true) (State imem dmem reg' pc.+1 true)
| step_mov : forall imem dmem reg reg' pc i r1 r2 w1,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Mov r1 r2)),
             forall (R1W : reg r1 = Some w1),
             forall (UPD : updm reg r2 w1 = Some reg'),
             step (State imem dmem reg pc true) (State imem dmem reg' pc.+1 true)
| step_binop : forall imem dmem reg reg' pc i f r1 r2 r3 w1 w2,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Binop f r1 r2 r3)),
             forall (R1W : reg r1 = Some w1),
             forall (R2W : reg r2 = Some w2),
             forall (UPD : updm reg r3 (binop_denote f w1 w2) = Some reg'),
             step (State imem dmem reg pc true) (State imem dmem reg' pc.+1 true)
| step_load : forall imem dmem reg reg' pc i r1 r2 w1 w2,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Load r1 r2)),
             forall (R1W : reg r1 = Some w1),
             forall (MEM1 : imem w1 = Some w2 \/ dmem w1 = Some w2),
             forall (UPD : updm reg r2 w2 = Some reg'),
             step (State imem dmem reg pc true) (State imem dmem reg' pc.+1 true)
| step_store : forall imem dmem dmem' reg pc i r1 r2 w1 w2,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Store r1 r2)),
             forall (R1W : reg r1 = Some w1),
             forall (R2W : reg r2 = Some w2),
             forall (UPD : updm dmem w1 w2 = Some dmem'),
             step (State imem dmem reg pc true) (State imem dmem' reg pc.+1 true)
| step_jump : forall imem dmem reg pc i r w b,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Jump r)),
             forall (RW : reg r = Some w),
             forall (VALID : valid_jmp pc w = b),
             step (State imem dmem reg pc true) (State imem dmem reg w b)
| step_bnz : forall imem dmem reg pc i r n w,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Bnz r n)),
             forall (RW : reg r = Some w),
             let pc' := pc + (if w == 0 then 1 else swcast n) in
             step (State imem dmem reg pc true) (State imem dmem reg pc' true)
| step_jal : forall imem dmem reg reg' pc i r w b,
             forall (FETCH : imem pc = Some i),
             forall (INST : decode_instr i = Some (Jal r)),
             forall (RW : reg r = Some w),
             forall (UPD : updm reg ra (pc.+1) = Some reg'),
             forall (VALID : valid_jmp pc w = b),
             step (State imem dmem reg pc true) (State imem dmem reg' w b)
| step_syscall : forall imem dmem dmem' reg reg' pc pc' sc,
                 forall (FETCH : imem pc = None),
                 forall (NOUSERM : dmem pc = None),
                 forall (GETCALL : table pc = Some sc),
                 forall (CALL : sem sc (State imem dmem reg pc true) =
                                Some (State imem dmem' reg' pc' true)),
                 step (State imem dmem reg pc true)
                      (State imem dmem' reg' pc' true).

Inductive step_a : state -> state -> Prop :=
| step_attack : forall imem dmem dmem' reg reg' pc b
             (MSAME: domm dmem = domm dmem')
             (RSAME: domm reg = domm reg'),
             step_a (State imem dmem reg pc b)
                    (State imem dmem' reg' pc b).

(* Extending valid_jmp to a complete allowed CFG *)
Definition succ (st : state) (st' : state) : bool :=
  let '(State imem dmem reg pc _) := st in
  let '(State _ _ _ pc' _) := st' in
  match (imem pc) with
    | Some i =>
      match decode_instr i with
        | Some (Jump r) => valid_jmp pc pc'
        | Some (Jal r) => valid_jmp pc pc'
        | Some (Bnz r imm) => (pc' == pc .+1) || (pc' == pc + swcast imm)
        | None => false
        | _ => pc' == pc .+1
      end
    | None =>
      match dmem pc with
        | Some _ => false
        | None =>
          match table pc with
            | Some sc => true
              (* This allows monitor service to return anywhere *)
              (* An alternative would be restricting this to the value
                 in the ra register (which should be the same at the end
                 of the system call to what it was before it) *)
            | None => false
          end
      end
  end.

Definition initial (s : state) :=
  cont s.

Definition all_attacker (xs : seq state) : Prop :=
  forall x1 x2, In2 x1 x2 xs -> step_a x1 x2.

Definition all_stuck (xs : seq state) : Prop :=
  forall x, x \in xs -> ~ exists s, step x s.

Definition stopping (xs : seq state) : Prop :=
  all_attacker xs /\ all_stuck xs.

Program Instance abstract_cfi_machine : cfi_machine := {
  state := [eqType of state];
  initial s := initial s;

  step := step;
  step_a := step_a;

  succ := succ;
  stopping := stopping
}.

Lemma step_succ_violation ast ast' :
   ~~ succ ast ast' ->
   step ast ast' ->
   cont ast /\ ~~ cont ast'.
Proof.
  intros SUCC STEP.
  inversion STEP; subst; simpl in SUCC; rewrite FETCH in SUCC;
  try rewrite INST in SUCC;
  try (rewrite eqxx in SUCC; congruence);
  try (destruct (w == 0)); try (rewrite eqxx ?orbT in SUCC);
  try (rewrite RW in SUCC);
  try rewrite GETCALL NOUSERM in SUCC;
  try congruence; auto.
Qed.

Lemma step_a_violation ast ast' :
   step_a ast ast' ->
   cont ast = cont ast'.
Proof.
  intros STEP.
  inversion STEP; subst. reflexivity.
Qed.

Lemma all_attacker_red ast ast' axs :
  all_attacker (ast :: ast' :: axs) ->
  all_attacker (ast' :: axs).
Proof.
  intros ATTACKER asi asj IN2.
  assert (IN2' : In2 asi asj (ast :: ast' :: axs))
    by (simpl; auto).
  apply ATTACKER in IN2'.
  assumption.
Qed.

Lemma all_stuck_red ast ast' axs :
  all_stuck (ast :: ast' :: axs) ->
  all_stuck (ast' :: axs).
Proof.
  intros ALLS asi IN.
  unfold all_stuck in ALLS.
  have IN' : asi \in (ast :: ast' :: axs)
    by rewrite inE IN orbT.
  auto.
Qed.

Lemma stuck_states_preserved_by_a asi tl :
  all_attacker (asi :: tl) ->
  ~~ cont asi ->
  forall asj, asj \in tl -> ~~ cont asj.
Proof.
  intros ALLATTACKER CONT asj IN.
  move: asi ALLATTACKER CONT.
  induction tl; intros.
  - done.
  - rewrite !inE in IN; case/orP: IN.
    + move=> /eqP ?; subst a.
      assert (IN2: In2 asi asj (asi :: asj :: tl))
        by (simpl; auto).
      apply ALLATTACKER in IN2.
      destruct (step_a_violation IN2).
      assumption.
    + assert (IN2: In2 asi a (asi :: a :: tl))
        by (simpl; auto).
      apply ALLATTACKER in IN2.
      assert (CONT' := step_a_violation IN2).
      rewrite CONT' in CONT.
      apply all_attacker_red in ALLATTACKER.
      move => /IHtl {IHtl} IHtl; eapply IHtl; eauto.
Qed.

Lemma stuck_trace s s' xs s'' :
  interm (@cfi_step abstract_cfi_machine) (s :: xs) s s'' ->
  ~~ cont s ->
  s' \in s :: xs ->
  ~ exists s''', step s' s'''.
Proof.
  intros INTERM CONT IN (s''' & STEP).
  induction INTERM as [? ? STEP'|? ? ? ? STEP' INTERM'].
  - rewrite !inE in IN. case/orP: IN; move=> /eqP *; subst.
    + inv STEP; by discriminate.
    + destruct STEP' as [STEPA | STEPN].
      * inv STEPA; simpl in *;
        inv STEP; by discriminate.
      * inv STEPN; by discriminate.
  - rewrite !inE in IN; case/orP: IN => [/eqP ? | IN]; subst;
    [inv STEP; by discriminate | subst].
    destruct STEP' as [STEPA | STEPN].
    + inv STEPA.
      simpl in *.
      by auto.
    + inv STEPN; by discriminate.
Qed.

Theorem cfi : cfi abstract_cfi_machine.
Proof.
  unfold cfi.
  intros.
  clear INIT.
  induction INTERM as [s s' STEP | s s' s'' xs STEP INTERM ].
  - unfold trace_has_at_most_one_violation.
    destruct STEP as [STEPA | STEPN].
    + left. unfold trace_has_cfi.
      intros si sj INTRACE STEP.
      have [SUCC//|SUCC] := boolP (succ si sj).
      destruct (step_succ_violation SUCC STEP) as [CONT1 CONT2].
      assert (CONTRA := step_a_violation STEPA).
      destruct INTRACE as [[? ?]|INTRACE]; subst.
      * by rewrite -CONTRA CONT1 in CONT2.
      * by (inv INTRACE).
    + unfold trace_has_cfi.
      have [SUCC|SUCC] := boolP (succ s s').
      * left. intros.
        destruct INTRACE as [[? ?]|INTRACE];
        [subst; by assumption | by (inv INTRACE)].
      * right.
        exists s; exists s'; do 2 exists [::].
        simpl; repeat split; try (auto || intros ? ? IN2; by (destruct IN2)).
        intros ? IN [s0 STEP]; rewrite inE in IN; move/eqP in IN; subst.
        destruct (step_succ_violation SUCC STEPN) as [H1 H2].
        inv STEP; simpl in H2; by discriminate.
  - unfold trace_has_at_most_one_violation in IHINTERM.
    destruct IHINTERM as [TCFI | [sv1 [sv2 [hs [tl VIOLATION]]]]].
    { (*case no violation in the trace*)
      destruct STEP as [STEPA | STEPN].
      - left. unfold trace_has_cfi.
        intros si sj INTRACE STEP.
        have [SUCC|SUCC] := boolP (succ si sj); first assumption.
        destruct (step_succ_violation SUCC STEP) as [CONT1 CONT2];
        assert (CONTRA := step_a_violation STEPA);
        destruct xs; first (by inv INTRACE);
        apply interm_first_step in INTERM; subst;
        destruct INTRACE as [[? ?]|INTRACE]; subst.
        + by rewrite -CONTRA CONT1 in CONT2.
        + by auto.
      - have [SUCC|SUCC] := boolP (succ s s').
        + left. intros ? ? INTRACE STEP.
          destruct xs; first (by inv INTRACE).
          apply interm_first_step in INTERM; subst.
          destruct INTRACE as [[? ?]|INTRACE];
            [subst; by assumption | by auto].
        + right.
          destruct xs; first (by inv INTERM).
          assert (EQ := interm_first_step INTERM); subst.
          exists s; exists s'; exists [::]; exists xs.
          simpl; repeat split;
          try (auto || intros ? ? IN2; by (destruct IN2)).
          { intros ? ? IN2.
            assert (STEP := interm_in2_step INTERM IN2).
            destruct STEP as [STEPA | STEPN']; first (by assumption).
            unfold trace_has_cfi in TCFI.
            exfalso.
            destruct (step_succ_violation SUCC STEPN) as [CONT1 CONT2].
            clear TCFI SUCC.
            apply In2_implies_In in IN2.
            eapply stuck_trace; eauto.
          }
          { intros x IN (s0 & STEP).
            destruct (step_succ_violation SUCC STEPN) as [CONT1 CONT2].
            eapply stuck_trace; eauto.
          }
    }
    { destruct VIOLATION as [LST [[STEPV SUCC] [HCFI [TCFI STOP]]]].
      right.
      exists sv1; exists sv2; exists (s :: hs); exists tl.
      repeat split;
        try solve [rewrite LST; reflexivity
                  | auto
                  | simpl in STOP; destruct STOP; assumption].
      intros si sj IN2 STEPN.
      destruct hs.
      - destruct IN2 as [[? ?]|CONTRA];
        [subst | destruct CONTRA].
        have [SUCC'|SUCC'] := boolP (succ si sj); first (by assumption).
        destruct (step_succ_violation SUCC' STEPN) as [CONT1 CONT2].
        inv STEPV; by discriminate.
      - destruct IN2 as [[? ?]|IN2]; subst.
        + have [SUCC'|SUCC'] := boolP (succ si sj); first (by assumption).
          destruct (step_succ_violation SUCC' STEPN) as [CONT1 CONT2].
          exfalso.
          simpl in INTERM.
          remember (hs ++ sv1 :: sv2 :: tl) as lst.
          assert (Heq: sj :: hs ++ sv1 :: sv2 :: tl = sj :: lst)
            by (rewrite Heqlst; reflexivity).
          rewrite Heq in INTERM.
          have IN: sv1 \in (sj :: hs) ++ sv1 :: (sv2 :: tl).
            by rewrite mem_cat !inE eqxx /= !orbT; auto.
          simpl ((sj :: hs) ++ sv1 :: sv2 :: tl) in IN.
          rewrite  Heq in IN.
          assert (EQ := interm_first_step INTERM); subst.
          eapply stuck_trace; eauto.
        + apply HCFI; by assumption.
    }
Qed.

End WithClasses.

Notation imemory mt := {fmap mword mt -> mword mt}.
Notation dmemory mt := {fmap mword mt -> mword mt}.
Notation registers mt := {fmap reg mt -> mword mt}.

End Abs.

Arguments Abs.State {_} _ _ _ _ _.

Canonical Abs.cfi_abs_state_eqType.