Set Universe Polymorphism.
Set Printing Universes.

Set Polymorphic Inductive Cumulativity.

Inductive foo := C : (forall A : Type -> Type, A Type) -> foo.
(* anomaly invalid subtyping relation *)


Set Implicit Arguments.
Set Maximal Implicit Insertion.
Set Contextual Implicit.

From Coq Require Import
     Relation_Definitions
     RelationClasses
.

Require Import Fix.
Require Import GHC.Base.

Require Import Adverb.Composable.Repeatedly.
Require Import ClassesOfFunctors.AppKleenePlus.

Section RefinesKleenePlusLaws.

    Variable D : (Set -> Set) -> Set -> Set.
    Context `{ReifiedKleenePlus -≪ D} `{Functor1 D}.
    Context `{Monad (Fix1 D)}.

    Fixpoint seq {A : Set} (a : Fix1 D A) (n : nat) : Fix1 D A :=
      match n with
      | 0 => a
      | S n => a >> @seq _ a n
      end.

    Variant RefinesKleenePlusLaws
            (Kr : forall (A : Set), relation (Fix1 D A))
            {A : Set} : relation (Fix1 D A) :=
    | RefinesSeq : forall (a b : Fix1 D A) n,
        Kr _ a b ->
        RefinesKleenePlusLaws Kr (@seq _ a n) (@kleenePlus _ _ _ _ _ b)
    | RefinesKleenePlus : forall (a b : Fix1 D A),
        Kr _ a (@kleenePlus _ _ _ _ _ b) ->
        RefinesKleenePlusLaws Kr (@kleenePlus _ _ _ _ _ a) (@kleenePlus _ _ _ _ _ b)
    (* TODO: move to a separate data type. *)
    | RefinesKleenePlusCong : forall (a b : Fix1 D A),
        Kr _ a b ->
        RefinesKleenePlusLaws Kr (@kleenePlus _ _ _ _ _ a) (@kleenePlus _ _ _ _ _ b).

    Global Instance FunctorRel__RefinesKleenePlusLaws :
      FunctorRel (F:=Fix1 D) RefinesKleenePlusLaws.
    constructor. intros. destruct H5.
    - constructor; auto.
    - constructor; auto.
    - apply RefinesKleenePlusCong. auto.
    Qed.

End RefinesKleenePlusLaws.

Section RefinesKleenePlusLaws_SmartConstructors.

  Variable D : (Set -> Set) -> Set -> Set.
  Context `{ReifiedKleenePlus -≪ D} `{Functor1 D}.
  Context `{Monad (Fix1 D)}.

  Variable R : (forall (A : Set), relation (Fix1 D A)) ->
               forall (A : Set), relation (Fix1 D A).
  Context `{FunctorRel _ R} `{RefinesKleenePlusLaws -⋘ R}.

  Lemma refinesSeq :
    forall {A : Set} (a b : Fix1 D A) n,
      FixRel R _ a b ->
      FixRel R _ (@seq _ _ _ _ _ a n) (@kleenePlus _ _ _ _ _ b).
  Proof.
    intros. apply inFRel, injRel.
    constructor; assumption.
  Qed.

  Lemma refinesKleenePlus :
    forall {A : Set} (a b : Fix1 D A),
      FixRel R _ a (@kleenePlus _ _ _ _ _ b) ->
      FixRel R _ (@kleenePlus _ _ _ _ _ a) (@kleenePlus _ _ _ _ _ b).
  Proof.
    intros. apply inFRel, injRel.
    constructor; assumption.
  Qed.

  Lemma refinesKleenePlusCong :
    forall {A : Set} (a b : Fix1 D A),
      FixRel R _ a b ->
      FixRel R _ (@kleenePlus _ _ _ _ _ a) (@kleenePlus _ _ _ _ _ b).
  Proof.
    intros. apply inFRel, injRel.
    constructor; assumption.
  Qed.

End RefinesKleenePlusLaws_SmartConstructors.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.
Require Import PSCIAux.Spec.

Local Open Scope Z_scope.

Section Spec.

  Definition psci_cpu_on_target_spec (g_target_rec: Pointer) (target_rec: Pointer) (rec: Pointer) (entry_point_address: Z64) (target_cpu: Z64) (adt: RData) : option RData :=
    match entry_point_address, target_cpu with
    | VZ64 ep, VZ64 tc =>
      rely is_int64 ep; rely is_int64 tc;
      rely (peq (base g_target_rec) ginfo_loc);
      rely (peq (base target_rec) buffer_loc);
      rely (peq (base rec) buffer_loc);
      when rec_gidx == ((buffer (priv adt)) @ (offset rec));
      when target_gidx == ((buffer (priv adt)) @ (offset target_rec));
      rely prop_dec (rec_gidx <> target_gidx);
      rely is_gidx target_gidx;
      rely (offset g_target_rec =? target_gidx);
      let gn_rec := (gs (share adt)) @ rec_gidx in
      let gn := (gs (share adt)) @ target_gidx in
      rely (g_tag (ginfo gn_rec) =? GRANULE_STATE_REC);
      rely (g_tag (ginfo gn) =? GRANULE_STATE_REC);
      rely prop_dec (glock gn = Some CPU_ID);
      rely (ref_accessible gn CPU_ID);
      rely (ref_accessible gn_rec CPU_ID);
      rely is_int (g_runnable (gnorm gn));
      if g_runnable (gnorm gn) =? 0 then
        let sctlr := r_sctlr_el1 (g_regs (grec gn_rec)) in
        rely is_int64 sctlr;
        let g' := gn {grec : (grec gn) {g_pstate : 965}
                                       {g_pc: ep}
                                       {g_regs : set_reg sctlr_el1 (Z.lor SCTLR_EL1_FLAGS (Z.land sctlr SCTLR_EL1_EE)) (g_regs (grec gn))}}
                     {gnorm: (gnorm gn) {g_runnable: 1}} in
        rely (g_tag (ginfo gn) =? gtype gn);
        let e := EVT CPU_ID (REL target_gidx g') in
        Some adt {log: e :: log adt}
             {priv: (priv adt) {buffer: (buffer (priv adt)) # (offset target_rec) == None} {psci_x0: 0}
                               {psci_forward_psci_call: 1} {psci_forward_x1: tc}}
             {share: (share adt) {gs: (gs (share adt)) # target_gidx == (g' {glock: None})}}
      else
        rely (g_tag (ginfo gn) =? gtype gn);
        let e := EVT CPU_ID (REL target_gidx gn) in
        Some adt {log: e :: log adt}
             {priv: (priv adt) {buffer: (buffer (priv adt)) # (offset target_rec) == None} {psci_x0: PSCI_RETURN_ALREADY_ON}}
             {share: (share adt) {gs: (gs (share adt)) # target_gidx == (gn {glock: None})}}
     end.

End Spec.


Require Import Coqlib.
Require Import Maps.
Require Import LibTactics.

Require Import Integers.
Open Scope Z_scope.
Import ListNotations.

Set Asymmetric Patterns.

Require Import state.
Require Import language.

Set Implicit Arguments.
Unset Strict Implicit.

Require Import logic.

Require Import lemmas.
Require Import lemmas_ins.

Require Import Coq.Logic.FunctionalExtensionality.

Require Import integer_lemma.

Require Import sep_lemma.
Require Import reg_lemma.
Require Import derived_rule.

Require Import tm_dly_lemma.

Require Import code.
Require Import ctxswitch_spec.

Require Import lemma1.

Open Scope nat.
Open Scope code_scope.
Open Scope mem_scope.

(*+ Proof +*)
Theorem Ta0AdjustCWPProof :
  forall vl,
    spec |- {{ ta0_adjust_cwp_pre vl }}
             ta0_adjust_cwp
           {{ ta0_adjust_cwp_post vl }}.
Proof.
  intros.
  unfold ta0_adjust_cwp_pre.
  unfold ta0_adjust_cwp_post.
  hoare_ex_intro_pre.
  renames x' to fmg, x'0 to fmo, x'1 to fml, x'2 to fmi.
  renames x'3 to id, x'6 to vi, x'4 to F, x'5 to vy.
  renames x'8 to i, x'13 to vz, x'14 to vn.
  renames x'7 to ll, x'9 to ct, x'10 to nt, x'11 to nctx, x'12 to nstk, x'15 to oid.
  eapply Pure_intro_rule.
  introv Hlgvl.
  hoare_lift_pre 13.
  eapply Pure_intro_rule.
  introv Hpure.
  hoare_lift_pre 13.
  eapply Pure_intro_rule.
  introv Hnctx.
  destruct fmg, fmo, fml, fmi.
  eapply backward_rule.
  introv Hs.
  simpl_sep_liftn_in Hs 2.
  eapply Regs_Global_combine_GenRegs in Hs; eauto.
  unfold ta0_adjust_cwp.

  destruct Hpure as [Hg4 [Hrot [Hoid_range [Hvl_g4 [Hg7 Hct] ] ] ] ].
  simpl in Hg4.
  inversion Hg4; subst.
  simpl in Hg7.
  inversion Hg7; subst.

  (** sll g4 1 g5 *)
  eapply seq_rule.
  TimReduce_simpl.
  eapply sll_rule_reg; eauto.
  simpl; eauto.
  rewrite in_range1; eauto.
  simpl upd_genreg.

  (** srl g4 (OS_WINDOWS - 1) g5 *)
  unfold OS_WINDOWS.
  assert (Heq7 : ($ 8) -ᵢ ($ 1) = ($ 7)).
  eauto.
  rewrite Heq7.
  eapply seq_rule.
  TimReduce_simpl.
  eapply srl_rule_reg; eauto.
  simpl; eauto.
  rewrite in_range7; eauto.
  simpl upd_genreg.
  rewrite get_range_0_4_stable; eauto.
  rewrite get_range_0_4_stable; eauto.

  (** or g4 g5 g4 *)
  eapply seq_rule.
  TimReduce_simpl.
  eapply or_rule_reg; eauto.
  simpl; eauto.
  simpl upd_genreg.

  eapply hoare_pure_gen' with (pu := $ 0 <=ᵤᵢ id <=ᵤᵢ $ 7 /\ $ 0 <=ᵤᵢ vi <=ᵤᵢ $ 7).
  {
    introv Hs.
    simpl_sep_liftn_in Hs 2.
    unfold FrameState in Hs.
    asrt_to_line_in Hs 3.
    simpl_sep_liftn_in Hs 4.
    eapply sep_pure_l_elim in Hs; eauto.
    simpljoin1; eauto.
  }
  eapply Pure_intro_rule.
  introv Hid_inrange.
  destruct Hid_inrange as [Hid_inrange Hvi_inrange].

  (** andcc g4 g7 g0 *)
  hoare_lift_pre 4.
  hoare_lift_pre 5.
  hoare_lift_pre 3.
  eapply seq_rule.
  TimReduce_simpl.
  eapply andcc_rule_reg; eauto.
  simpl upd_genreg.
  simpl get_genreg_val.
  assert (Hiszero : iszero ((i >>ᵢ ($ 7)) |ᵢ (i <<ᵢ ($ 1))) &ᵢ (($ 1) <<ᵢ vi) =
         iszero (get_range 0 7 ((i >>ᵢ ($ 7)) |ᵢ (i <<ᵢ ($ 1)))) &ᵢ (($ 1) <<ᵢ vi)).
  {
    rewrite in_range_0_7_and; eauto.
  }
  rewrite Hiszero.
  rewrite g4_val_get_range_0_7_equal with (id := id); eauto.

  (** bne Ta0_Switch; nop *)
  eapply Bne_rule; eauto.
  {
    eval_spec.
  }
  {
    TimReduce_simpl.
    eapply nop_rule; eauto.
  }
  {
    TimReduce_simpl.
    introv Hs.
    simpl_sep_liftn_in Hs 3.
    sep_cancel1 1 1.
    simpl; eauto.
  }

  Focus 3.
  introv Hne.
  unfold iszero in Hne.
  destruct (Int.eq_dec (($ 1) <<ᵢ (post_cwp id)) &ᵢ (($ 1) <<ᵢ vi) $ 0); tryfalse.
  clear Hne.
  renames n to Hne.
  eapply and_not_zero_eq in Hne; eauto.
  2 : eapply in_range_0_7_post_cwp_still; eauto.
  split.

    introv Hs.
    unfold ta0_task_switch_newcontext_pre.
    sep_ex_intro.
    asrt_to_line 14.
    eapply sep_pure_l_intro; eauto.
    simpl_sep_liftn 2.
    eapply GenRegs_split_Regs_Global; eauto.
    sep_cancel1 1 1.
    sep_cancel1 3 1.
    sep_cancel1 1 3.
    sep_cancel1 1 2.
    do 7 sep_cancel1 1 1.
    instantiate (1 := Aemp).
    eapply astar_emp_intro_r; eauto.
    instantiate (1 := Aemp).
    eapply sep_pure_l_intro; eauto.
    eapply sep_pure_l_intro; eauto.

    introv Hs.
    unfold ta0_task_switch_newcontext_post in Hs.
    sep_ex_elim_in Hs.
    asrt_to_line_in Hs 13.
    eapply sep_pure_l_elim in Hs.
    destruct Hs as [Hlgvl1 Hs].
    symmetry in Hlgvl1.
    inversion Hlgvl1; subst.
    sep_ex_intro.
    eapply sep_pure_l_intro; eauto.
    do 12 sep_cancel1 1 1.
    match goal with
    | H : _ |= _ |- _ => renames H to Hs
    end.
    eapply sep_pure_l_elim in Hs; eauto.

  2 : DlyFrameFree_elim.

  introv Heq.
  unfold iszero in Heq.
  destruct (Int.eq_dec (($ 1) <<ᵢ (post_cwp id)) &ᵢ (($ 1) <<ᵢ vi) $ 0); tryfalse.
  clear Heq.
  renames e to Heq.
  eapply and_zero_not_eq in Heq; eauto.
  2 : eapply in_range_0_7_post_cwp_still; eauto.

  eapply hoare_pure_gen' with (length F = 13).
  {
    introv Hs.
    simpl_sep_liftn_in Hs 4.
    unfold FrameState in Hs.
    asrt_to_line_in Hs 3.
    simpl_sep_liftn_in Hs 3.
    eapply sep_pure_l_elim in Hs.
    simpljoin1; eauto.
  }
  eapply Pure_intro_rule.
  introv Hlen_F.

  destruct F; simpl in Hlen_F; tryfalse.
  destruct F; simpl in Hlen_F; tryfalse.
  destruct f, f0.
  hoare_lift_pre 4.
  unfold FrameState at 1.
  eapply backward_rule.
  introv Hs.
  asrt_to_line_in Hs 3.
  simpl_sep_liftn_in Hs 3.
  eapply sep_pure_l_elim in Hs.
  destruct Hs as [_ Hs].
  simpl_sep_liftn_in Hs 3.
  eapply sep_pure_l_elim in Hs.
  destruct Hs as [_ Hs].
  eauto.

  (** restore *)
  hoare_lift_pre 2.
  hoare_lift_pre 3.
  eapply seq_rule; eauto.
  TimReduce_simpl.
  eapply restore_rule_reg; eauto.
  simpl; eauto.
  unfold win_masked.
  destruct (((($ 1) <<ᵢ (post_cwp id)) &ᵢ (($ 1) <<ᵢ vi)) !=ᵢ ($ 0)) eqn:Heqe; eauto.
  unfold negb in Heqe.
  destruct (((($ 1) <<ᵢ (post_cwp id)) &ᵢ (($ 1) <<ᵢ vi)) =ᵢ ($ 0)) eqn:Heqe1; tryfalse.
  eapply int_eq_false_neq in Heqe1.
  eapply and_not_zero_eq in Heqe1; eauto.
  subst; tryfalse.
  eapply in_range_0_7_post_cwp_still; eauto.
  simpl upd_genreg.

  (** jumpl Ta0_adjust_cwp; nop *)
  eapply J1_rule; eauto.
  {
    TimReduce_simpl.
    introv Hs.
    simpl.
    unfold Ta0_adjust_CWP at 1 2.
    unfold Ta0_adjust_CWP at 1 2.
    rewrite in_range344; eauto.
  }
  {
    eval_spec.
  }
  {
    TimReduce_simpl.
    introv Hs.
    eapply GenRegs_split_one with (rr := g0) in Hs.
    simpl get_genreg_val' in Hs.
    eauto.
  }
  {
    TimReduce_simpl.
    eapply nop_rule; eauto.
    introv Hs.
    eapply GenRegs_upd_combine_one in Hs.
    simpl upd_genreg in Hs.
    simpl_sep_liftn_in Hs 2.
    simpl_sep_liftn_in Hs 3.
    eapply FrameState_combine in Hs; eauto.
    unfold ta0_adjust_cwp_pre.
    sep_ex_intro.
    asrt_to_line 14.
    eapply sep_pure_l_intro; eauto.
    simpl_sep_liftn 2.
    eapply GenRegs_split_Regs_Global; eauto.
    sep_cancel1 2 1.
    sep_cancel1 4 2.
    sep_cancel1 1 1.
    sep_cancel1 1 2.
    do 7 sep_cancel1 1 1.
    instantiate (1 := Aemp).
    eapply astar_emp_intro_r; eauto.
    instantiate (1 := Aemp).
    simpl get_frame_nth.
    eapply sep_pure_l_intro; eauto.
    split; eauto.
    split.
    {
      instantiate (1 := oid).
      eapply rotate_cons; eauto.
    }
    repeat (split; eauto).
    eapply g4_rot_stable with (oid := oid); eauto.
    eapply sep_pure_l_intro; eauto.
    clear - Hlen_F.
    rewrite app_length.
    simpl; omega.
    split; eauto.
    eapply in_range_0_7_post_cwp_still; eauto.
  }

  introv Hs.
  unfold ta0_adjust_cwp_post in Hs.
  sep_ex_elim_in Hs.
  asrt_to_line_in Hs 13.
  sep_ex_intro.
  do 13 sep_cancel1 1 1.
  match goal with
  | H : _ |= _ |- _ => rename H into Hs
  end.
  eapply sep_pure_l_elim in Hs; eauto.

  DlyFrameFree_elim.
Qed.


Require Import Omega.
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.
From PromisingLib Require Import Language.

Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.

Require Import PromiseConsistent.
Require Import Mapping.

Require Import PFStep.

Set Implicit Arguments.

Module OrdLocal.
  Section OrdLocal.
    Variable L: Loc.t -> bool.
    Variable ordc: Ordering.t.

    Inductive read_step (lc1:Local.t) (mem1:Memory.t) (loc:Loc.t) (to:Time.t) (val:Const.t) (released:option View.t) (ord:Ordering.t) (lc2:Local.t): Prop :=
    | read_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordc else ord)
        (STEP: Local.read_step lc1 mem1 loc to val released ord' lc2)
    .
    Hint Constructors read_step.

    Inductive write_step (lc1:Local.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:Local.t) (sc2:TimeMap.t) (mem2:Memory.t) (kind:Memory.op_kind): Prop :=
    | write_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordc else ord)
        (STEP: Local.write_step lc1 sc1 mem1 loc from to val releasedm released ord' lc2 sc2 mem2 kind)
    .
    Hint Constructors write_step.

    Inductive program_step:
      forall (e:ThreadEvent.t) (lc1:Local.t) (sc1:TimeMap.t) (mem1:Memory.t) (lc2:Local.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: 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: 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: read_step lc1 mem1 loc tsr valr releasedr ordr lc2)
        (LOCAL2: 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
    .
    Hint Constructors program_step.

    (* step_future *)

    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. eapply Local.write_step_non_cancel; eauto.
    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. eapply Local.write_step_strong_relaxed; eauto.
      etrans; eauto. des_ifs; try refl.
      eapply Ordering.join_l.
    Qed.

    Lemma program_step_future
          e lc1 sc1 mem1 lc2 sc2 mem2
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (WF1: Local.wf lc1 mem1)
          (SC1: Memory.closed_timemap sc1 mem1)
          (CLOSED1: Memory.closed mem1):
      <<WF2: Local.wf lc2 mem2>> /\
      <<SC2: Memory.closed_timemap sc2 mem2>> /\
      <<CLOSED2: Memory.closed mem2>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview lc1) (Local.tview lc2)>> /\
      <<SC_FUTURE: TimeMap.le sc1 sc2>> /\
      <<MEM_FUTURE: Memory.future mem1 mem2>>.
    Proof.
      inv STEP.
      - esplits; eauto; try refl.
      - inv LOCAL.
        exploit Local.read_step_future; eauto. i. des.
        esplits; eauto; try refl.
      - inv LOCAL.
        exploit Local.write_step_future; eauto; try by econs. i. des.
        esplits; eauto; try refl.
      - inv LOCAL1. inv LOCAL2.
        exploit Local.read_step_future; eauto. i. des.
        exploit Local.write_step_future; eauto; try by econs. i. des.
        esplits; eauto. etrans; eauto.
      - exploit Local.fence_step_future; eauto. i. des. esplits; eauto; try refl.
      - exploit Local.fence_step_future; eauto. i. des. esplits; eauto; try refl.
      - esplits; eauto; try refl.
    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 STEP. inv WRITE.
        inv PROMISE; eauto using Memory.add_inhabited, Memory.split_inhabited, Memory.lower_inhabited, Memory.cancel_inhabited.
      - inv LOCAL2. inv STEP. inv WRITE.
        inv PROMISE; eauto using Memory.add_inhabited, Memory.split_inhabited, Memory.lower_inhabited, Memory.cancel_inhabited.
    Qed.

    (* step_disjoint *)

    Lemma program_step_disjoint
          e lc1 sc1 mem1 lc2 sc2 mem2 lc
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (WF1: Local.wf lc1 mem1)
          (SC1: Memory.closed_timemap sc1 mem1)
          (CLOSED1: Memory.closed mem1)
          (DISJOINT1: Local.disjoint lc1 lc)
          (WF: Local.wf lc mem1):
      <<DISJOINT2: Local.disjoint lc2 lc>> /\
      <<WF: Local.wf lc mem2>>.
    Proof.
      inv STEP.
      - esplits; eauto.
      - inv LOCAL. exploit Local.read_step_disjoint; eauto.
      - inv LOCAL. exploit Local.write_step_disjoint; eauto.
      - inv LOCAL1. inv LOCAL2.
        exploit Local.read_step_future; eauto. i. des.
        exploit Local.read_step_disjoint; eauto. i. des.
        exploit Local.write_step_disjoint; eauto.
      - exploit Local.fence_step_disjoint; eauto.
      - exploit Local.fence_step_disjoint; eauto.
      - esplits; 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: (Local.promises lc1) = Memory.bot):
      (Local.promises lc2) = Memory.bot.
    Proof.
      inv STEP; try inv LOCAL; ss; try inv STEP; ss.
      - eapply Memory.write_promises_bot; eauto.
      - inv LOCAL1. inv LOCAL2. inv STEP. inv STEP0.
        eapply Memory.write_promises_bot; eauto.
    Qed.
  End OrdLocal.
End OrdLocal.

Module OrdThread.
  Section OrdThread.
    Variable lang: language.
    Variable L: Loc.t -> bool.
    Variable ordc: Ordering.t.

    Inductive program_step (e:ThreadEvent.t): forall (e1 e2:Thread.t lang), Prop :=
    | program_step_intro
        st1 lc1 sc1 mem1
        st2 lc2 sc2 mem2
        (STATE: (Language.step lang) (ThreadEvent.get_program_event e) st1 st2)
        (LOCAL: OrdLocal.program_step L ordc e lc1 sc1 mem1 lc2 sc2 mem2):
        program_step e (Thread.mk lang st1 lc1 sc1 mem1) (Thread.mk lang st2 lc2 sc2 mem2)
    .
    Hint Constructors program_step.

    Inductive step: forall (pf:bool) (e:ThreadEvent.t) (e1 e2:Thread.t lang), Prop :=
    | step_promise
        pf e e1 e2
        (STEP: Thread.promise_step pf e e1 e2)
        (PF: PF.pf_event L e):
        step pf e e1 e2
    | step_program
        e e1 e2
        (STEP: program_step e e1 e2):
        step true e e1 e2
    .
    Hint Constructors step.

    Inductive step_allpf (e: ThreadEvent.t) (e1 e2: Thread.t lang): Prop :=
    | step_nopf_intro
        pf
        (STEP: step pf e e1 e2)
    .
    Hint Constructors step_allpf.

    Lemma allpf pf: step pf <3= step_allpf.
    Proof.
      i. econs. eauto.
    Qed.

    Definition pf_tau_step := tau (step true).
    Hint Unfold pf_tau_step.

    Definition tau_step := tau step_allpf.
    Hint Unfold tau_step.

    Definition all_step := union step_allpf.
    Hint Unfold all_step.

    Inductive opt_step: forall (e: ThreadEvent.t) (e1 e2: Thread.t lang), Prop :=
    | step_none
        e:
        opt_step ThreadEvent.silent e e
    | step_some
        pf e e1 e2
        (STEP: step pf e e1 e2):
        opt_step e e1 e2
    .
    Hint Constructors opt_step.

    Definition steps_failure (e1: Thread.t lang): Prop :=
      exists e2 e3,
        <<STEPS: rtc tau_step e1 e2>> /\
        <<FAILURE: step true ThreadEvent.failure e2 e3>>.
    Hint Unfold steps_failure.

    Definition consistent (e: Thread.t lang): Prop :=
      forall mem1 sc1
        (CAP: Memory.cap (Thread.memory e) mem1)
        (SC_MAX: Memory.max_concrete_timemap mem1 sc1),
        <<FAILURE: steps_failure (Thread.mk lang (Thread.state e) (Thread.local e) sc1 mem1)>> \/
        exists e2,
          <<STEPS: rtc tau_step (Thread.mk lang (Thread.state e) (Thread.local e) sc1 mem1) e2>> /\
          <<PROMISES: (Local.promises (Thread.local e2)) = Memory.bot>>.

    (* future *)

    Lemma program_step_future
          e e1 e2
          (STEP: program_step e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      inv STEP. ss. eapply OrdLocal.program_step_future; eauto.
    Qed.

    Lemma step_future
          pf e e1 e2
          (STEP: step pf e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      inv STEP.
      - eapply Thread.promise_step_future; eauto.
      - eapply program_step_future; eauto.
    Qed.

    Lemma rtc_all_step_future
          e1 e2
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      revert WF1 SC1 CLOSED1. induction STEPS; i.
      - esplits; eauto; refl.
      - inv H. inv USTEP. exploit step_future; eauto. i. des.
        exploit IHSTEPS; eauto. i. des.
        esplits; eauto; etrans; eauto.
    Qed.

    Lemma rtc_tau_step_future
          e1 e2
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      eapply rtc_all_step_future; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    (* disjoint *)

    Lemma step_disjoint
          pf e e1 e2 lc
          (STEP: step pf e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      inv STEP.
      - eapply Thread.promise_step_disjoint; eauto.
      - inv STEP0. eapply OrdLocal.program_step_disjoint; eauto.
    Qed.

    Lemma rtc_all_step_disjoint
          e1 e2 lc
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      revert WF1 SC1 CLOSED1 DISJOINT1 WF.
      induction STEPS; i; eauto.
      inv H. inv USTEP.
      exploit step_future; eauto. i. des.
      exploit step_disjoint; eauto. i. des.
      eauto.
    Qed.

    Lemma rtc_tau_step_disjoint
          e1 e2 lc
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      eapply rtc_all_step_disjoint; try exact DISJOINT1; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    (* promise_consistent *)

    Lemma step_promise_consistent
          pf e e1 e2
          (STEP: step pf e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      inv STEP; ss.
      - inv STEP0. s.
        eapply promise_step_promise_consistent; eauto.
      - inv STEP0. inv LOCAL; ss.
        + inv LOCAL0. eapply read_step_promise_consistent; eauto.
        + inv LOCAL0. eapply write_step_promise_consistent; eauto.
        + inv LOCAL1. inv LOCAL2.
          exploit Local.read_step_future; eauto. i. des.
          eapply read_step_promise_consistent; eauto.
          eapply write_step_promise_consistent; eauto.
        + eapply fence_step_promise_consistent; eauto.
        + eapply fence_step_promise_consistent; eauto.
    Qed.

    Lemma rtc_all_step_promise_consistent
          e1 e2
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      revert WF1 SC1 CLOSED1 CONS. induction STEPS; ss. i.
      inv H. inv USTEP. exploit step_future; eauto. i. des.
      eapply step_promise_consistent; eauto.
    Qed.

    Lemma rtc_tau_step_promise_consistent
          e1 e2
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      eapply rtc_all_step_promise_consistent; try exact CONS; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    Lemma cap_step_current_step
          pf e e0 e1 fe0
          (THREAD: thread_map ident_map e0 fe0)
          (STEP: step pf e e0 e1)
          (LOCAL: Local.wf (Thread.local e0) (Thread.memory e0))
          (FLOCAL: Local.wf (Thread.local fe0) (Thread.memory fe0))
          (MEMORY: Memory.closed (Thread.memory e0))
          (FMEMORY: Memory.closed (Thread.memory fe0))
          (SC: Memory.closed_timemap (Thread.sc e0) (Thread.memory e0))
          (FSC: Memory.closed_timemap (Thread.sc fe0) (Thread.memory fe0))
      :
        exists fe fe1,
          (<<THREAD: thread_map ident_map e1 fe1>>) /\
          (<<STEP: step pf fe fe0 fe1>>) /\
          (<<EVENT: tevent_map ident_map fe e>>).
    Proof.
      assert (MAPLT: mapping_map_lt ident_map).
      { eapply ident_map_lt. }
      assert (MAPLE: mapping_map_le ident_map).
      { eapply ident_map_le. }
      assert (MAPEQ: mapping_map_eq ident_map).
      { eapply ident_map_eq. }

      inv THREAD. ss. inv STEP.
      { inv STEP0. inv LOCAL1.
        exploit promise_map; try apply PROMISE; eauto; ss.
        { eapply FLOCAL. }
        { eapply LOCAL0. }
        { eapply mapping_map_lt_non_collapsable; eauto. }
        { eapply ident_map_message. }
        i. des. inv LOCAL0.
        eexists _, (Thread.mk _ st (Local.mk (Local.tview flc) fprom1) fsc fmem1).
        esplits; eauto.
        { econs; eauto.
          { econs; eauto. }
          { eapply mapping_map_lt_collapsable_unwritable; eauto. }
        }
        { econs 1. econs.
          { econs; eauto. eapply closed_message_map; eauto.
            eapply ident_map_message. }
          { inv KIND; ss. inv MSG; ss. }
          { unfold PF.pf_event in *. i. inv PROMISE1. eauto. }
        }
        { econs; eauto; ss. eapply ident_map_message. }
      }
      { inv STEP0. inv LOCAL1.
        { esplits; eauto.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 1; eauto. }
          { econs; eauto. }
        }
        { inv LOCAL2. exploit read_step_map; eauto.
          { eapply ident_map_bot. }
          { eapply FLOCAL. } i. des.
          exists (ThreadEvent.read loc fto val freleased ord). esplits.
          { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 2; eauto. econs; eauto. }
          { econs; eauto. }
        }
        { inv LOCAL2. hexploit write_step_map; try eassumption; eauto.
          { eapply ident_map_bot. }
          { eapply FLOCAL. }
          { eapply FLOCAL. }
          { econs 2. }
          { refl. }
          { refl. }
          { eapply mapping_map_lt_non_collapsable; eauto. }
          i. des.
          exists (ThreadEvent.write loc from to val freleasedw ord). esplits.
          { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 3; eauto. econs; eauto. }
          { econs; eauto; ss. }
        }
        { inv LOCAL2. inv LOCAL3. exploit read_step_map; eauto.
          { eapply ident_map_bot. }
          { eapply FLOCAL. } i. des.
          hexploit Local.read_step_future; try apply STEP; eauto. i. des.
          hexploit Local.read_step_future; try apply READ; eauto. i. des.
          hexploit write_step_map; try eapply STEP0; try eassumption; eauto.
          { eapply ident_map_bot. }
          { eapply WF0. }
          { eapply WF0. }
          { eapply mapping_map_lt_collapsable_unwritable; eauto. }
          { refl. }
          { eapply mapping_map_lt_non_collapsable; eauto. }
          i. des.
          exists (ThreadEvent.update loc fto tsw valr valw freleased freleasedw ordr ordw). esplits.
          { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 4; eauto.
            { econs; eauto. }
            { econs; eauto. }
          }
          { econs; eauto; ss. }
        }
        { inv LOCAL2. exploit fence_step_map; try apply FENCE; eauto.
          { eapply ident_map_bot. }
          { eapply FLOCAL. } i. des.
          exists (ThreadEvent.fence ordr ordw). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 5; eauto. }
          { econs; eauto; ss. }
        }
        { inv LOCAL2. exploit fence_step_map; eauto.
          { eapply ident_map_bot. }
          { eapply FLOCAL. } i. des.
          exists (ThreadEvent.syscall e0). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 6; eauto. }
          { econs; eauto; ss. }
        }
        { inv LOCAL2. exploit failure_step_map; eauto. i.
          exists (ThreadEvent.failure). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 7; eauto. }
          { econs; eauto; ss. }
        }
      }
    Qed.
  End OrdThread.
End OrdThread.

Module OrdConfiguration.
  Section OrdConfiguration.
    Variable L: Loc.t -> bool.
    Variable ordc: Ordering.t.

    Inductive step: forall (e: ThreadEvent.t) (tid: Ident.t) (c1 c2: Configuration.t), Prop :=
    | step_intro
        e tid c1 lang st1 lc1 e2 e3 st4 lc4 sc4 memory4
        (TID: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st1, lc1))
        (CANCELS: rtc (@Thread.cancel_step _) (Thread.mk _ st1 lc1 (Configuration.sc c1) (Configuration.memory c1)) e2)
        (STEP: OrdThread.opt_step L ordc e e2 e3)
        (RESERVES: rtc (@Thread.reserve_step _) e3 (Thread.mk _ st4 lc4 sc4 memory4))
        (CONSISTENT: e <> ThreadEvent.failure ->
                     OrdThread.consistent L ordc (Thread.mk _ st4 lc4 sc4 memory4)):
        step e tid c1 (Configuration.mk (IdentMap.add tid (existT _ _ st4, lc4) (Configuration.threads c1)) sc4 memory4)
    .
    Hint Constructors step.

    Inductive all_step (c1 c2: Configuration.t): Prop :=
    | all_step_intro
        e tid
        (STEP: step e tid c1 c2)
    .
    Hint Constructors all_step.

    Inductive machine_step: forall (e: MachineEvent.t) (tid: Ident.t) (c1 c2: Configuration.t), Prop :=
    | machine_step_instro
        e tid c1 c2
        (STEP: step e tid c1 c2):
        machine_step (ThreadEvent.get_machine_event e) tid c1 c2
    .
    Hint Constructors machine_step.
  End OrdConfiguration.
End OrdConfiguration.