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 Trace.
Require Import MemoryProps.
Require Import Mapping.
Require Import JoinedView.

Require Import PFStep.
Require Import OrdStep.
Require Import RAStep.
Require Import Stable.
Require Import PFtoRASimThread.

Set Implicit Arguments.

Module PFtoRAThread.
  Section PFtoRAThread.
    Variable lang: language.
    Variable L: Loc.t -> bool.

    Definition closed_views (views: Loc.t -> Time.t -> list View.t) (mem: Memory.t): Prop :=
      forall loc ts view (LOC: ~ L loc) (IN: List.In view (views loc ts)),
        Memory.closed_view view mem.

    Definition normal_views (views: Loc.t -> Time.t -> list View.t): Prop :=
      forall loc ts view (LOC: ~ L loc) (IN: List.In view (views loc ts)),
        Stable.normal_view L view.

    Definition stable_views (mem: Memory.t) (views: Loc.t -> Time.t -> list View.t): Prop :=
      forall loc ts view (LOC: ~ L loc) (IN: List.In view (views loc ts)),
        Stable.stable_view L mem view.

    Lemma joined_opt_view_normal_view
          views loc ts released
          (NORMAL: normal_views views)
          (LOC: ~ L loc)
          (JOINED: joined_opt_view (views loc ts) (Some released)):
      Stable.normal_view L released.
    Proof.
      specialize (NORMAL loc ts).
      inv JOINED. induction JOINED0; ss.
      apply Stable.join_normal_view; eauto.
    Qed.

    Lemma joined_opt_view_stable_view
          mem views loc ts released
          (MEM: Memory.closed mem)
          (STABLE: stable_views mem views)
          (LOC: ~ L loc)
          (JOINED: joined_opt_view (views loc ts) (Some released)):
      Stable.stable_view L mem released.
    Proof.
      specialize (STABLE loc ts).
      inv JOINED. induction JOINED0.
      { ii. inv MEM. rewrite INHABITED in *. inv GET. }
      apply Stable.join_stable_view; eauto.
    Qed.

    Lemma future_closed_views
          views mem1 mem2
          (CLOSED1: closed_views views mem1)
          (FUTURE: Memory.future mem1 mem2):
      closed_views views mem2.
    Proof.
      ii. eapply Memory.future_closed_view; eauto.
    Qed.

    Lemma future_stable_views
          views mem1 mem2
          (STABLE1: stable_views mem1 views)
          (CLOSED1: closed_views views mem1)
          (FUTURE: Memory.future mem1 mem2):
      stable_views mem2 views.
    Proof.
      ii. exploit CLOSED1; eauto. i.
      inv x. specialize (RLX loc0). des.
      exploit Memory.future_get1; try exact RLX; eauto. i. des.
      rewrite GET0 in *. inv GET. inv MSG_LE. inv RELEASED.
      etrans; eauto. eapply STABLE1; eauto.
    Qed.

    Lemma step_closed_views
          views1 views2 rel mem
          (MEM: Memory.closed mem)
          (CLOSED1: closed_views views1 mem)
          (CLOSED_REL: forall loc, Memory.closed_view (rel loc) mem)
          (VIEW: forall loc ts (LOC: ~ L loc) (NEQ: views2 loc ts <> views1 loc ts),
              exists from val released,
                Memory.get loc ts mem = Some (from, Message.concrete val released) /\
                views2 loc ts = (View.join (rel loc) (View.singleton_ur loc ts))
                                  :: (all_join_views (View.singleton_ur loc ts) (views1 loc from))):
      closed_views views2 mem.
    Proof.
      ii. destruct (classic (views2 loc ts = views1 loc ts)).
      { rewrite H in *. eauto. }
      hexploit VIEW; eauto. i. des.
      rewrite H1 in *. ss. des.
      { subst. apply Memory.join_closed_view; eauto.
        econs; ss.
        - ii. unfold TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
          condtac; ss; subst; eauto. esplits. eapply MEM.
        - ii. unfold TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
          condtac; ss; subst; eauto. esplits. eapply MEM.
      }
      specialize (CLOSED1 loc from).
      remember (views1 loc from) as views.
      clear rel Heqviews CLOSED_REL VIEW H H1.
      induction views; ss. des; eauto.
      subst. apply Memory.join_closed_view; eauto.
      econs; ss.
      - ii. unfold TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
        condtac; ss; subst; eauto. esplits. eapply MEM.
      - ii. unfold TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
        condtac; ss; subst; eauto. esplits. eapply MEM.
    Qed.

    Lemma step_normal_views
          views1 views2 rel
          (NORMAL1: normal_views views1)
          (NORMAL_REL: forall loc (LOC: ~ L loc), Stable.normal_view L (rel loc))
          (VIEW: forall loc ts (LOC: ~ L loc) (NEQ: views2 loc ts <> views1 loc ts),
              exists from, views2 loc ts = (View.join (rel loc) (View.singleton_ur loc ts))
                                        :: (all_join_views (View.singleton_ur loc ts) (views1 loc from))):
      normal_views views2.
    Proof.
      ii. destruct (classic (views2 loc ts = views1 loc ts)).
      { rewrite H in *. eapply NORMAL1; eauto. }
      hexploit VIEW; eauto. i. des.
      rewrite H0 in *. ss. des.
      { subst. eapply Stable.join_normal_view; eauto.
        apply Stable.singleton_ur_normal_view. }
      specialize (NORMAL1 loc from).
      remember (views1 loc from) as views.
      clear rel Heqviews NORMAL_REL VIEW H H0.
      induction views; ss. des; eauto.
      subst. eapply Stable.join_normal_view; eauto.
      apply Stable.singleton_ur_normal_view.
    Qed.

    Lemma step_stable_views
          views1 views2 rel mem
          (STABLE1: stable_views mem views1)
          (STABLE_REL: forall loc (LOC: ~ L loc), Stable.stable_view L mem (rel loc))
          (VIEW: forall loc ts (LOC: ~ L loc) (NEQ: views2 loc ts <> views1 loc ts),
              exists from, views2 loc ts = (View.join (rel loc) (View.singleton_ur loc ts))
                                        :: (all_join_views (View.singleton_ur loc ts) (views1 loc from))):
      stable_views mem views2.
    Proof.
      ii. destruct (classic (views2 loc ts = views1 loc ts)).
      { rewrite H in *. eapply STABLE1; eauto. }
      hexploit VIEW; eauto. i. des.
      rewrite H0 in *. ss. des.
      { subst. etrans; [|eapply View.join_l].
        revert GET. unfold View.join, View.singleton_ur. ss.
        unfold TimeMap.join, TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
        condtac; ss; try congr.
        rewrite TimeFacts.le_join_l; try apply Time.bot_spec. i.
        eapply STABLE_REL; eauto.
      }
      specialize (STABLE1 loc from0).
      remember (views1 loc from0) as views.
      clear rel from0 Heqviews STABLE_REL VIEW H H0.
      induction views; ss. des; eauto.
      subst. etrans; [|eapply View.join_l].
      revert GET. unfold View.join, View.singleton_ur. ss.
      unfold TimeMap.join, TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
      condtac; ss; try congr.
      rewrite TimeFacts.le_join_l; try apply Time.bot_spec. i.
      eapply STABLE1; eauto.
    Qed.

    (* well-formedness *)

    Inductive wf_pf (e: Thread.t lang): Prop :=
    | wf_pf_intro
        (WF: Local.wf (Thread.local e) (Thread.memory e))
        (SC: Memory.closed_timemap (Thread.sc e) (Thread.memory e))
        (MEM: Memory.closed (Thread.memory e))
    .
    Hint Constructors wf_pf.

    Inductive wf_j (views: Loc.t -> Time.t -> list View.t) (e: Thread.t lang): Prop :=
    | wf_j_intro
        (WF: Local.wf (Thread.local e) (Thread.memory e))
        (SC: Memory.closed_timemap (Thread.sc e) (Thread.memory e))
        (MEM: Memory.closed (Thread.memory e))
        (JOINED_REL: joined_released views (Local.promises (Thread.local e)) (Local.tview (Thread.local e)).(TView.rel))
        (JOINED_MEM: joined_memory views (Thread.memory e))
        (JOINED_VIEWS: wf_views views)
    .
    Hint Constructors wf_j.

    Inductive wf_ra (rels: ReleaseWrites.t) (e: Thread.t lang): Prop :=
    | wf_ra_intro
        (WF: Local.wf (Thread.local e) (Thread.memory e))
        (SC: Memory.closed_timemap (Thread.sc e) (Thread.memory e))
        (MEM: Memory.closed (Thread.memory e))
        (RELS: ReleaseWrites.wf rels (Local.promises (Thread.local e)) (Thread.memory e))
    .
    Hint Constructors wf_ra.

    Lemma step_pf_future
          pf e e1 e2
          (WF1: wf_pf e1)
          (STEP: Thread.step pf e e1 e2):
      <<WF2_PF: wf_pf e2>>.
    Proof.
      inv WF1. exploit Thread.step_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma step_j_future
          pf e e1 e2 views1 views2
          (WF1: wf_j views1 e1)
          (STEP: JThread.step pf e e1 e2 views1 views2):
      <<WF2_J: wf_j views2 e2>>.
    Proof.
      inv WF1. exploit JThread.step_future; eauto. i. des. eauto.
    Qed.

    Lemma step_ra_future
          rels1 rels2 e e1 e2
          (WF1: wf_ra rels1 e1)
          (STEP: RAThread.step L rels1 rels2 e e1 e2):
      <<WF2_RA: wf_ra rels2 e2>>.
    Proof.
      inv WF1.
      hexploit RAThread.step_rels_wf; eauto. i.
      exploit RAThread.step_future; eauto. i. des. eauto.
    Qed.

    Lemma opt_step_pf_future
          e e1 e2
          (WF1: wf_pf e1)
          (STEP: Thread.opt_step e e1 e2):
      <<WF2_PF: wf_pf e2>>.
    Proof.
      inv STEP; eauto using step_pf_future.
    Qed.

    Lemma opt_step_j_future
          e e1 e2 views1 views2
          (WF1: wf_j views1 e1)
          (STEP: JThread.opt_step e e1 e2 views1 views2):
      <<WF2_J: wf_j views2 e2>>.
    Proof.
      inv STEP; eauto using step_j_future.
    Qed.

    Lemma opt_step_ra_future
          rels1 rels2 e e1 e2
          (WF1: wf_ra rels1 e1)
          (STEP: RAThread.opt_step L rels1 rels2 e e1 e2):
      <<WF2_RA: wf_ra rels2 e2>>.
    Proof.
      inv STEP; eauto using step_ra_future.
    Qed.

    Lemma reserve_step_pf_future
          e1 e2
          (WF1: wf_pf e1)
          (STEP: Thread.reserve_step e1 e2):
      wf_pf e2.
    Proof.
      inv STEP. inv WF1.
      exploit Thread.step_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma reserve_step_j_future
          e1 e2 views
          (WF1: wf_j views e1)
          (STEP: JThread.reserve_step views e1 e2):
      wf_j views e2.
    Proof.
      inv STEP. inv WF1.
      exploit JThread.step_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma reserve_step_ra_future
          rels e1 e2
          (WF1: wf_ra rels e1)
          (STEP: Thread.reserve_step e1 e2):
      wf_ra rels e2.
    Proof.
      inv STEP. inv WF1.
      exploit Thread.step_future; eauto. i. des.
      econs; eauto.
      inv STEP0; inv STEP; inv LOCAL. inv PROMISE. ss.
      ii. exploit RELS; eauto. i. des. split.
      - erewrite Memory.add_o; eauto. condtac; ss. des. subst.
        exploit Memory.add_get0; try exact MEM0. i. des. congr.
      - erewrite Memory.add_o; eauto. condtac; ss; eauto. des. subst.
        exploit Memory.add_get0; try exact MEM0. i. des. congr.
    Qed.

    Lemma cancel_step_pf_future
          e1 e2
          (WF1: wf_pf e1)
          (STEP: Thread.cancel_step e1 e2):
      wf_pf e2.
    Proof.
      inv STEP. inv WF1.
      exploit Thread.step_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma cancel_step_j_future
          e1 e2 views
          (WF1: wf_j views e1)
          (STEP: JThread.cancel_step views e1 e2):
      wf_j views e2.
    Proof.
      inv STEP. inv WF1.
      exploit JThread.step_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma cancel_step_ra_future
          rels e1 e2
          (WF1: wf_ra rels e1)
          (STEP: Thread.cancel_step e1 e2):
      wf_ra rels e2.
    Proof.
      inv STEP. inv WF1.
      exploit Thread.step_future; eauto. i. des.
      econs; eauto.
      inv STEP0; inv STEP; inv LOCAL. inv PROMISE. ss.
      ii. exploit RELS; eauto. i. des. split.
      - erewrite Memory.remove_o; eauto. condtac; ss.
      - erewrite Memory.remove_o; eauto. condtac; ss; eauto. des. subst.
        exploit Memory.remove_get0; try exact MEM0. i. des. congr.
    Qed.

    Lemma steps_pf_future
          tr e1 e2
          (WF1: wf_pf e1)
          (STEPS: Trace.steps tr e1 e2):
      <<WF2_PF: wf_pf e2>>.
    Proof.
      inv WF1. exploit Trace.steps_future; eauto. i. des.
      econs; eauto.
    Qed.

    Lemma steps_j_future
          e1 e2 views1 views2
          (WF1: wf_j views1 e1)
          (STEPS: JThread.rtc_tau e1 e2 views1 views2):
      <<WF2_J: wf_j views2 e2>>.
    Proof.
      inv WF1. exploit JThread.tau_steps_future; eauto. i. des. eauto.
    Qed.

    Lemma steps_ra_future
          rels1 rels2 e1 e2
          (WF1: wf_ra rels1 e1)
          (STEPS: RAThread.steps L rels1 rels2 e1 e2):
      <<WF2_RA: wf_ra rels2 e2>>.
    Proof.
      induction STEPS; eauto.
      exploit step_ra_future; eauto.
    Qed.

    Lemma reserve_steps_pf_future
          e1 e2
          (WF1: wf_pf e1)
          (STEP: rtc (@Thread.reserve_step _) e1 e2):
      wf_pf e2.
    Proof.
      induction STEP; ss.
      eauto using reserve_step_pf_future.
    Qed.

    Lemma reserve_steps_j_future
          e1 e2 views
          (WF1: wf_j views e1)
          (STEP: rtc (@JThread.reserve_step views _) e1 e2):
      wf_j views e2.
    Proof.
      induction STEP; ss.
      eauto using reserve_step_j_future.
    Qed.

    Lemma reserve_steps_ra_future
          rels e1 e2
          (WF1: wf_ra rels e1)
          (STEP: rtc (@Thread.reserve_step _) e1 e2):
      wf_ra rels e2.
    Proof.
      induction STEP; ss.
      eauto using reserve_step_ra_future.
    Qed.

    Lemma cancel_steps_pf_future
          e1 e2
          (WF1: wf_pf e1)
          (STEP: rtc (@Thread.cancel_step _) e1 e2):
      wf_pf e2.
    Proof.
      induction STEP; ss.
      eauto using cancel_step_pf_future.
    Qed.

    Lemma cancel_steps_j_future
          e1 e2 views
          (WF1: wf_j views e1)
          (STEP: rtc (@JThread.cancel_step views _) e1 e2):
      wf_j views e2.
    Proof.
      induction STEP; ss.
      eauto using cancel_step_j_future.
    Qed.

    Lemma cancel_steps_ra_future
          rels e1 e2
          (WF1: wf_ra rels e1)
          (STEP: rtc (@Thread.cancel_step _) e1 e2):
      wf_ra rels e2.
    Proof.
      induction STEP; ss.
      eauto using cancel_step_ra_future.
    Qed.

    (* sim_thread *)

    Inductive sim_thread (views: Loc.t -> Time.t -> list View.t) (rels: ReleaseWrites.t)
                         (e_pf e_j e_ra: Thread.t lang): Prop :=
    | sim_thread_intro
        (SIM_JOINED: JSim.sim_thread views e_j e_pf)
        (SIM_RA: PFtoRASimThread.sim_thread L rels e_ra e_j)

        (NORMAL_J: PFtoRASimThread.normal_thread L e_j)
        (NORMAL_RA: PFtoRASimThread.normal_thread L e_ra)
        (STABLE_RA: PFtoRASimThread.stable_thread L rels e_ra)
        (CLOSED_VIEWS: closed_views views (Thread.memory e_ra))
        (NORMAL_VIEWS: normal_views views)
        (STABLE_VIEWS: stable_views (Thread.memory e_ra) views)
    .

    Lemma sim_thread_step_aux
          views1 rels1 e1_pf e1_j e1_ra
          pf e_pf e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (JOINED_REL: joined_released views1 (Local.promises (Thread.local e1_j)) (Local.tview (Thread.local e1_j)).(TView.rel))
          (JOINED_MEM: joined_memory views1 (Thread.memory e1_j))
          (JOINED_VIEWS: wf_views views1)
          (WF1_PF: Local.wf (Thread.local e1_pf) (Thread.memory e1_pf))
          (SC1_PF: Memory.closed_timemap (Thread.sc e1_pf) (Thread.memory e1_pf))
          (MEM1_PF: Memory.closed (Thread.memory e1_pf))
          (WF1_J: Local.wf (Thread.local e1_j) (Thread.memory e1_j))
          (SC1_J: Memory.closed_timemap (Thread.sc e1_j) (Thread.memory e1_j))
          (MEM1_J: Memory.closed (Thread.memory e1_j))
          (WF1_RA: Local.wf (Thread.local e1_ra) (Thread.memory e1_ra))
          (SC1_RA: Memory.closed_timemap (Thread.sc e1_ra) (Thread.memory e1_ra))
          (MEM1_RA: Memory.closed (Thread.memory e1_ra))
          (STEP_PF: Thread.step pf e_pf e1_pf e2_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf))
          (PROMISE: PF.pf_event L e_pf):
      exists views2 e_j pf_j e2_j e_ra e2_ra,
        (<<STEP_J: JThread.step pf_j e_j e1_j e2_j views1 views2>>) /\
        (<<EVENT_J: JSim.sim_event e_j e_pf>>) /\
        (<<STEP_RA: OrdThread.step L Ordering.acqrel pf_j e_ra e1_ra e2_ra>>) /\
        __guard__
          ((<<SIM2: sim_thread views2 (ReleaseWrites.append L e_ra rels1) e2_pf e2_j e2_ra>>) /\
           (<<EVENT_RA: PFtoRASimThread.sim_event e_ra e_j>>) \/
           (<<CONS: Local.promise_consistent (Thread.local e1_ra)>>) /\
           (<<RACE: exists loc to val released ord,
               ThreadEvent.is_reading e_ra = Some (loc, to, val, released, ord) /\
               RARaceW.ra_race L rels1 (Local.tview (Thread.local e1_ra)) loc to ord>>)).
    Proof.
      hexploit JSim.sim_thread_step; try exact STEP; try eapply SIM1; eauto. i. des.
      destruct (classic (exists loc from to msg kind,
                            e_src = ThreadEvent.promise loc from to msg kind /\ ~ L loc)); cycle 1.
      { (* normal step *)
        inv STEP.
        hexploit PFtoRASimThread.thread_step; try exact STEP1; try eapply SIM1; eauto.
        { i. subst. destruct (L loc) eqn:LOC.
          - split; ss. inv EVENT. destruct msg; ss. inv MSG.
            exploit PROMISE; eauto; ss.
          - exfalso. apply H. esplits; eauto. congr.
        }
        i. unguard. des.
        - esplits; eauto. left. split; ss.
          exploit Thread.step_future; try exact STEP_PF; eauto. i. des.
          exploit Thread.step_future; try eapply STEP0; eauto. i. des.
          exploit OrdThread.step_future; try exact STEP_SRC; eauto. i. des.
          econs; eauto.
          + hexploit future_closed_views; try eapply SIM1; eauto. i.
            eapply step_closed_views; try eapply SIM1; eauto.
            * inv WF1. inv TVIEW_CLOSED. apply REL.
            * i. exploit VIEWSLE; eauto. i. des.
              inv SIM2. inv MEMORY0.
              exploit COMPLETE; try exact GET. i. des. inv MSG.
              inv LOCAL. inv TVIEW. specialize (REL loc). des_ifs.
              rewrite REL. esplits; eauto.
          + eapply step_normal_views; try eapply SIM1; eauto.
            * inv NORMAL2_SRC. inv NORMAL_TVIEW. i. eapply (REL loc).
            * i. exploit VIEWSLE; eauto. i. des.
              inv SIM2. inv MEMORY0.
              exploit COMPLETE; try exact GET. i. des. inv MSG.
              inv LOCAL. inv TVIEW. specialize (REL loc). des_ifs.
              rewrite REL. esplits; eauto.
          + hexploit future_stable_views; try eapply SIM1; eauto. i.
            eapply step_stable_views; try eapply SIM1; eauto.
            * inv STABLE2_SRC. inv STABLE_TVIEW. i. eapply (REL loc); eauto.
            * i. exploit VIEWSLE; eauto. i. des.
              inv SIM2. inv MEMORY0.
              exploit COMPLETE; try exact GET. i. des. inv MSG.
              inv LOCAL. inv TVIEW. specialize (REL loc). des_ifs.
              rewrite REL. esplits; eauto.
        - esplits; eauto. right. esplits; eauto.
          hexploit step_promise_consistent; try exact STEP_PF; try apply SIM1; eauto. i.
          inv SIM1. inv SIM_JOINED. inv SIM_RA.
          apply inj_pair2 in H4. subst.
          apply inj_pair2 in H5. subst. ss.
          hexploit JSim.sim_local_promise_consistent; try exact LOCAL; eauto. i. des.
          eapply PFtoRASimThread.sim_local_promise_consistent; eauto.
      }

      (* promise on ~ L *)
      des. subst. dup STEP. inv STEP0.
      inv STEP1; [|inv STEP0; inv LOCAL]. inv STEP0. ss.
      hexploit PFtoRASimThread.promise_step; try exact LOCAL; try eapply SIM1; eauto; try congr. s. i. des.
      destruct e1_ra. esplits; eauto.
      { econs.
        - econs; eauto.
        - ii. inv PROMISE1. ss.
      }
      left.
      assert (MSG: forall (val: Const.t) (released: View.t) (MSG: msg = Message.concrete val (Some released)),
                 Stable.normal_view L released /\ Stable.stable_view L mem2_src released).
      { i. subst. split.
        - hexploit (@step_normal_views views1 views0); try eapply SIM1; eauto.
          { inv SIM1. ss. inv NORMAL_RA. inv NORMAL_TVIEW. i. eapply (REL loc0). }
          { s. i. exploit VIEWSLE; eauto. i. des.
            inv MEM2.
            exploit COMPLETE; try exact GET. i. des. inv MSG.
            inv LC2. inv TVIEW. specialize (REL loc0). des_ifs.
            inv STEP_SRC. ss. rewrite REL. esplits; eauto. }
          i. exploit PROMISE0; eauto. i. des.
          eapply joined_opt_view_normal_view; eauto.
        - exploit Local.promise_step_future; try exact STEP_SRC; eauto. s. i. des.
          hexploit future_closed_views; try eapply SIM1; try exact FUTURE. i.
          hexploit future_stable_views; try eapply SIM1; try exact FUTURE. i.
          hexploit (@step_stable_views views1 views0); try exact H1; eauto.
          { inv SIM1. ss. inv STABLE_RA. ss. inv STABLE_TVIEW.
            i. hexploit (REL loc0); ss. i.
            hexploit Stable.future_stable_view; try exact H2; try exact FUTURE; try eapply WF1_RA. i.
            eapply H3. }
          { i. exploit VIEWSLE; eauto. i. des.
            inv MEM2.
            exploit COMPLETE; try exact GET. i. des. inv MSG.
            inv LC2. inv TVIEW. specialize (REL loc0). des_ifs.
            inv STEP_SRC. ss. rewrite REL. esplits; eauto. }
          i. exploit PROMISE0; eauto. i. des.
          eapply joined_opt_view_stable_view; eauto.
      }
      hexploit PFtoRASimThread.sim_memory_stable_tview; try eapply SIM1. s. i.
      hexploit PFtoRASimThread.sim_memory_stable_memory; try eapply SIM1. s. i.
      exploit PFtoRASimThread.sim_release_writes_wf; try eapply SIM1. s. i. des.
      hexploit Stable.promise_step; try exact LOCAL; try eapply SIM1; eauto.
      { i. subst. exploit MSG; eauto. i. des. split; ss.
        eapply PFtoRASimThread.sim_memory_stable_view; eauto. }
      i. des.
      hexploit Stable.promise_step; try exact STEP_SRC; try eapply SIM1; eauto. i. des.
      split; try by econs.
      exploit Thread.step_future; try exact STEP_PF; eauto. i. des.
      exploit Local.promise_step_future; try exact LOCAL; eauto. s. i. des.
      exploit Local.promise_step_future; try exact STEP_SRC; eauto. s. i. des.
      econs; ss; eauto.
      - inv SIM1. inv SIM_RA. econs; ss; eauto.
      - unfold ReleaseWrites.append. ss. econs; ss; eauto.
        inv SIM1. ss.
        eapply Stable.future_stable_view; try exact FUTURE0; try eapply SIM; ss.
        apply STABLE_RA.
      - hexploit future_closed_views; try eapply SIM1; eauto. i.
        eapply step_closed_views; try eapply SIM1; eauto.
        + inv WF1. inv TVIEW_CLOSED. apply REL.
        + i. exploit VIEWSLE; eauto. i. des.
          inv MEM2.
          exploit COMPLETE; try exact GET. i. des. inv MSG0.
          inv LC2. inv TVIEW. specialize (REL loc0). des_ifs.
          rewrite REL. esplits; eauto.
      - eapply step_normal_views; try eapply SIM1; eauto.
        + inv NORMAL_TVIEW0. i. eapply (REL loc0).
        + i. exploit VIEWSLE; eauto. i. des.
          inv MEM2.
          exploit COMPLETE; try exact GET. i. des. inv MSG0.
          inv LC2. inv TVIEW. specialize (REL loc0). des_ifs.
          rewrite REL. esplits; eauto.
      - hexploit future_stable_views; try eapply SIM1; eauto. i.
        eapply step_stable_views; try eapply SIM1; eauto.
        + inv STABLE_TVIEW0. i. eapply (REL loc0); eauto.
        + i. exploit VIEWSLE; eauto. i. des.
          inv MEM2.
          exploit COMPLETE; try exact GET. i. des. inv MSG0.
          inv LC2. inv TVIEW. specialize (REL loc0). des_ifs.
          rewrite REL. esplits; eauto.
    Qed.

    Lemma sim_thread_step
          views1 rels1 e1_pf e1_j e1_ra
          pf e_pf e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: Thread.step pf e_pf e1_pf e2_pf)
          (PF: PF.pf_event L e_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      (exists views2 rels2 pf_j e_j e2_j e_ra e2_ra,
          (<<STEP_J: JThread.step pf_j e_j e1_j e2_j views1 views2>>) /\
          (<<STEP_RA: RAThread.step L rels1 rels2 e_ra e1_ra e2_ra>>) /\
          (<<EVENT_J: JSim.sim_event e_j e_pf>>) /\
          (<<EVENT_RA: PFtoRASimThread.sim_event e_ra e_j>>) /\
          (<<SIM2: sim_thread views2 rels2 e2_pf e2_j e2_ra>>)) \/
      (exists rels2 e_ra e2_ra loc to val released ord,
          (<<CONS_RA: Local.promise_consistent (Thread.local e1_ra)>>) /\
          (<<STEP_RA: RAThread.step L rels1 rels2 e_ra e1_ra e2_ra>>) /\
          (<<READ: ThreadEvent.is_reading e_ra = Some (loc, to, val, released, ord)>>) /\
          (<<RACE: RARaceW.ra_race L rels1 (Local.tview (Thread.local e1_ra)) loc to ord>>)).
    Proof.
      exploit sim_thread_step_aux; eauto; try apply WF1_PF; try apply WF1_J; try apply WF1_RA.
      i. unguard. des.
      - left. esplits; eauto.
        + econs 1. eauto.
      - right. esplits; eauto. econs; eauto.
    Qed.

    Lemma sim_thread_opt_step
          views1 rels1 e1_pf e1_j e1_ra
          e_pf e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: Thread.opt_step e_pf e1_pf e2_pf)
          (PF: PF.pf_event L e_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      (exists views2 rels2 e_j e2_j e_ra e2_ra,
          (<<STEP_J: JThread.opt_step e_j e1_j e2_j views1 views2>>) /\
          (<<STEP_RA: RAThread.opt_step L rels1 rels2 e_ra e1_ra e2_ra>>) /\
          (<<EVENT_J: JSim.sim_event e_j e_pf>>) /\
          (<<EVENT_RA: PFtoRASimThread.sim_event e_ra e_j>>) /\
          (<<SIM2: sim_thread views2 rels2 e2_pf e2_j e2_ra>>)) \/
      (exists rels2 e_ra e2_ra loc to val released ord,
          (<<CONS_RA: Local.promise_consistent (Thread.local e1_ra)>>) /\
          (<<STEP_RA: RAThread.step L rels1 rels2 e_ra e1_ra e2_ra>>) /\
          (<<READ: ThreadEvent.is_reading e_ra = Some (loc, to, val, released, ord)>>) /\
          (<<RACE: RARaceW.ra_race L rels1 (Local.tview (Thread.local e1_ra)) loc to ord>>)).
    Proof.
      inv STEP.
      - left. esplits; eauto; try econs 1. econs.
      - exploit sim_thread_step; eauto. i. des.
        + left. esplits.
          * econs 2; eauto.
          * econs 2; eauto.
          * ss.
          * ss.
          * ss.
        + right. esplits; eauto.
    Qed.

    Lemma sim_thread_steps
          views1 rels1 e1_pf e1_j e1_ra
          tr e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEPS: Trace.steps tr e1_pf e2_pf)
          (SILENT: List.Forall (fun the => ThreadEvent.get_machine_event (snd the) = MachineEvent.silent) tr)
          (PF: List.Forall (compose (PF.pf_event L) snd) tr)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      (exists views2 rels2 e2_j e2_ra,
          (<<STEPS_J: JThread.rtc_tau e1_j e2_j views1 views2>>) /\
          (<<STEPS_RA: RAThread.tau_steps L rels1 rels2 e1_ra e2_ra>>) /\
          (<<SIM2: sim_thread views2 rels2 e2_pf e2_j e2_ra>>)) \/
      (exists rels2 rels3 e_ra e2_ra e3_ra loc to val released ord,
          (<<STEPS_RA: RAThread.tau_steps L rels1 rels2 e1_ra e2_ra>>) /\
          (<<CONS_RA: Local.promise_consistent (Thread.local e2_ra)>>) /\
          (<<STEP_RA: RAThread.step L rels2 rels3 e_ra e2_ra e3_ra>>) /\
          (<<READ: ThreadEvent.is_reading e_ra = Some (loc, to, val, released, ord)>>) /\
          (<<RACE: RARaceW.ra_race L rels2 (Local.tview (Thread.local e2_ra)) loc to ord>>)).
    Proof.
      revert views1 rels1 e1_j e1_ra SIM1 WF1_PF WF1_J WF1_RA SILENT PF CONS.
      induction STEPS; i; ss.
      { left. esplits; eauto. econs 1; eauto. }
      subst. exploit sim_thread_step; try exact SIM1; eauto.
      { ii. inv PF. exploit H1; ss; eauto. }
      { exploit Thread.step_future; try exact STEP; try apply WF1_PF. i. des.
        eapply rtc_tau_step_promise_consistent; try eapply Trace.silent_steps_tau_steps; eauto.
        inv SILENT. ss. }
      i. unguard. des.
      - exploit step_pf_future; eauto. i. des.
        exploit step_j_future; eauto. i. des.
        exploit step_ra_future; eauto. i. des.
        exploit IHSTEPS; eauto.
        { inv SILENT. ss. }
        { inv PF. ss. }
        i. des.
        + left. esplits; try exact SIM0; eauto.
          * econs 2; [eauto|..]; eauto.
            inv SILENT. ss. inv EVENT_J; ss.
          * econs 2; [eauto|..]; eauto.
            inv SILENT. ss. inv EVENT_J; inv EVENT_RA; ss.
        + right. esplits; eauto.
          econs 2; [eauto|..]; eauto.
          inv SILENT. ss. inv EVENT_J; inv EVENT_RA; ss.
      - right. esplits; eauto. econs 1.
    Qed.

    Lemma sim_thread_reserve_step
          views1 rels1 e1_pf e1_j e1_ra
          e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: Thread.reserve_step e1_pf e2_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      exists e2_j e2_ra,
        (<<STEP_J: JThread.reserve_step views1 e1_j e2_j>>) /\
        (<<STEP_RA: Thread.reserve_step e1_ra e2_ra>>) /\
        (<<SIM2: sim_thread views1 rels1 e2_pf e2_j e2_ra>>).
    Proof.
      exploit JSim.sim_thread_reserve_step;
        try eapply SIM1; try eapply WF1_PF; try eapply WF1_J; eauto.
      i. des. inv STEP0. inv STEP1.
      exploit PFtoRASimThread.reserve_step;
        try eapply SIM1; try eapply WF1_J; try eapply WF1_RA.
      { econs; eauto. }
      i. des.
      esplits; eauto.
      exploit Thread.rtc_reserve_step_future; [econs 2|..];
        try eapply STEP_SRC; try eapply WF1_RA; eauto. i. des.
      hexploit future_closed_views; try eapply SIM1; eauto. i.
      hexploit future_stable_views; try eapply SIM1; eauto. i.
      econs; eauto. apply SIM1.
    Qed.

    Lemma sim_thread_reserve_steps
          views1 rels1 e1_pf e1_j e1_ra
          e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: rtc (@Thread.reserve_step _) e1_pf e2_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      exists e2_j e2_ra,
        (<<STEP_J: rtc (@JThread.reserve_step views1 _) e1_j e2_j>>) /\
        (<<STEP_RA: rtc (@Thread.reserve_step _) e1_ra e2_ra>>) /\
        (<<SIM2: sim_thread views1 rels1 e2_pf e2_j e2_ra>>).
    Proof.
      revert e1_j e1_ra SIM1 WF1_PF WF1_J WF1_RA.
      induction STEP; i; [esplits; eauto|].
      exploit sim_thread_reserve_step; eauto.
      { eapply rtc_reserve_step_promise_consistent; eauto. }
      i. des.
      exploit reserve_step_pf_future; eauto. i.
      exploit reserve_step_j_future; eauto. i.
      exploit reserve_step_ra_future; eauto. i.
      exploit IHSTEP; eauto. i. des.
      esplits.
      - econs 2; eauto.
      - econs 2; eauto.
      - ss.
    Qed.

    Lemma sim_thread_cancel_step
          views1 rels1 e1_pf e1_j e1_ra
          e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: Thread.cancel_step e1_pf e2_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      exists e2_j e2_ra,
        (<<STEP_J: JThread.cancel_step views1 e1_j e2_j>>) /\
        (<<STEP_RA: Thread.cancel_step e1_ra e2_ra>>) /\
        (<<SIM2: sim_thread views1 rels1 e2_pf e2_j e2_ra>>).
    Proof.
      exploit JSim.sim_thread_cancel_step;
        try eapply SIM1; try eapply WF1_PF; try eapply WF1_J; eauto.
      i. des. inv STEP0. inv STEP1.
      exploit PFtoRASimThread.cancel_step;
        try eapply SIM1; try eapply WF1_J; try eapply WF1_RA.
      { econs; eauto. }
      i. des.
      esplits; eauto.
      exploit Thread.rtc_cancel_step_future; [econs 2|..];
        try eapply STEP_SRC; try eapply WF1_RA; eauto. i. des.
      hexploit future_closed_views; try eapply SIM1; eauto. i.
      hexploit future_stable_views; try eapply SIM1; eauto. i.
      econs; eauto. apply SIM1.
    Qed.

    Lemma sim_thread_cancel_steps
          views1 rels1 e1_pf e1_j e1_ra
          e2_pf
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (STEP: rtc (@Thread.cancel_step _) e1_pf e2_pf)
          (CONS: Local.promise_consistent (Thread.local e2_pf)):
      exists e2_j e2_ra,
        (<<STEP_J: rtc (@JThread.cancel_step views1 _) e1_j e2_j>>) /\
        (<<STEP_RA: rtc (@Thread.cancel_step _) e1_ra e2_ra>>) /\
        (<<SIM2: sim_thread views1 rels1 e2_pf e2_j e2_ra>>).
    Proof.
      revert e1_j e1_ra SIM1 WF1_PF WF1_J WF1_RA.
      induction STEP; i; [esplits; eauto|].
      exploit sim_thread_cancel_step; eauto.
      { eapply rtc_cancel_step_promise_consistent; eauto. }
      i. des.
      exploit cancel_step_pf_future; eauto. i.
      exploit cancel_step_j_future; eauto. i.
      exploit cancel_step_ra_future; eauto. i.
      exploit IHSTEP; eauto. i. des.
      esplits.
      - econs 2; eauto.
      - econs 2; eauto.
      - ss.
    Qed.

    (* consistency *)

    Lemma cap_wf_pf
          e sc mem
          (WF: wf_pf e)
          (CAP: Memory.cap (Thread.memory e) mem)
          (SC: Memory.max_concrete_timemap mem sc):
      wf_pf (Thread.mk lang (Thread.state e) (Thread.local e) sc mem).
    Proof.
      inv WF.
      exploit Local.cap_wf; eauto. i.
      exploit Memory.cap_closed; eauto. i.
      hexploit Memory.max_concrete_timemap_closed; eauto.
    Qed.

    Lemma cap_wf_j
          views e sc mem
          (WF: wf_j views e)
          (CAP: Memory.cap (Thread.memory e) mem)
          (SC: Memory.max_concrete_timemap mem sc):
      wf_j views (Thread.mk lang (Thread.state e) (Thread.local e) sc mem).
    Proof.
      inv WF.
      exploit Local.cap_wf; eauto. i.
      exploit Memory.cap_closed; eauto. i.
      hexploit Memory.max_concrete_timemap_closed; eauto. i.
      exploit JSim.joined_memory_cap; eauto.
    Qed.

    Lemma cap_wf_ra
          rels e sc mem
          (WF: wf_ra rels e)
          (CAP: Memory.cap (Thread.memory e) mem)
          (SC: Memory.max_concrete_timemap mem sc):
      wf_ra rels (Thread.mk lang (Thread.state e) (Thread.local e) sc mem).
    Proof.
      inv WF.
      exploit Local.cap_wf; eauto. i.
      exploit Memory.cap_closed; eauto. i.
      hexploit Memory.max_concrete_timemap_closed; eauto. i.
      econs; ss.
      ii. exploit RELS; eauto. i. des.
      inv CAP. exploit SOUND; eauto.
    Qed.

    Lemma sim_thread_cap
          views rels e_pf e_j e_ra
          sc_pf mem_pf sc_j mem_j sc_ra mem_ra
          (SIM: sim_thread views rels e_pf e_j e_ra)
          (WF_PF: wf_pf e_pf)
          (WF_J: wf_j views e_j)
          (WF_RA: wf_ra rels e_ra)
          (CAP_PF: Memory.cap (Thread.memory e_pf) mem_pf)
          (SC_PF: Memory.max_concrete_timemap mem_pf sc_pf)
          (CAP_J: Memory.cap (Thread.memory e_j) mem_j)
          (SC_J: Memory.max_concrete_timemap mem_j sc_j)
          (CAP_RA: Memory.cap (Thread.memory e_ra) mem_ra)
          (SC_RA: Memory.max_concrete_timemap mem_ra sc_ra):
      (<<SIM_CAP: sim_thread views rels
                             (Thread.mk lang (Thread.state e_pf) (Thread.local e_pf) sc_pf mem_pf)
                             (Thread.mk lang (Thread.state e_j) (Thread.local e_j) sc_j mem_j)
                             (Thread.mk lang (Thread.state e_ra) (Thread.local e_ra) sc_ra mem_ra)>>) /\
      (<<WF_PF_CAP: wf_pf (Thread.mk lang (Thread.state e_pf) (Thread.local e_pf) sc_pf mem_pf)>>) /\
      (<<WF_J_CAP: wf_j views (Thread.mk lang (Thread.state e_j) (Thread.local e_j) sc_j mem_j)>>) /\
      (<<WF_RA_CAP: wf_ra rels (Thread.mk lang (Thread.state e_ra) (Thread.local e_ra) sc_ra mem_ra)>>).
    Proof.
      exploit cap_wf_pf; eauto. i.
      exploit cap_wf_j; eauto. i.
      exploit cap_wf_ra; eauto. i.
      splits; ss.
      inv SIM. econs; ss.
      - inv WF_PF. inv WF_J. inv x0. inv x1. inv SIM_JOINED.
        apply inj_pair2 in H2. apply inj_pair2 in H3. subst. ss.
        econs; eauto.
        + eapply SimMemory.sim_memory_cap; eauto.
        + eapply SimMemory.sim_memory_cap in MEM; eauto.
          eapply SimMemory.sim_memory_max_concrete_timemap in MEM; eauto.
          subst. refl.
      - inv SIM_RA. econs; ss.
        + exploit PFtoRASimThread.sim_memory_cap; eauto; try apply WF_J; try apply WF_RA. i.
          eapply PFtoRASimThread.sim_memory_max_concrete_timemap; eauto.
        + eapply PFtoRASimThread.sim_memory_cap; eauto; try apply WF_J; try apply WF_RA.
      - inv NORMAL_J. econs; ss.
        eapply Stable.cap_normal_memory; eauto. apply WF_J.
      - inv NORMAL_RA. econs; ss.
        eapply Stable.cap_normal_memory; eauto. apply WF_RA.
      - inv WF_RA. inv STABLE_RA. econs; ss.
        + eapply Stable.cap_stable_tview; eauto.
        + eapply Stable.max_concrete_timemap_stable; eauto; try apply x2.
        + eapply Stable.cap_stable_memory; eauto.
      - ii. eapply Memory.cap_closed_view; eauto.
      - ii. exploit Memory.cap_inv; try exact CAP_RA; eauto; try apply WF_RA. i. des; ss.
        exploit STABLE_VIEWS; eauto.
    Qed.

    Lemma local_map_promise_consistent
          lc1 lc2
          (LOCAL: local_map ident_map lc1 lc2)
          (CONS: Local.promise_consistent lc1):
      Local.promise_consistent lc2.
    Proof.
      destruct lc1, lc2. ss. inv LOCAL. ss.
      eapply promise_consistent_mon.
      { eapply promise_consistent_map; eauto.
        - apply ident_map_le.
        - apply ident_map_eq. }
      { eauto. }
      { refl. }
    Qed.

    Lemma local_map_ra_race
          lc1 lc2 rels loc to ordr
          (LOCAL: local_map ident_map lc1 lc2)
          (RARACE: RARaceW.ra_race L rels (Local.tview lc1) loc to ordr):
      RARaceW.ra_race L rels (Local.tview lc2) loc to ordr.
    Proof.
      destruct lc1, lc2. ss. inv LOCAL. ss.
      unfold RARaceW.ra_race in *. des; splits; eauto.
      - eapply TimeFacts.le_lt_lt; eauto.
        inv TVIEW. inv map_cur. rewrite map_rlx. apply TVIEWLE.
      - eapply TimeFacts.le_lt_lt; eauto.
        inv TVIEW. inv map_cur. rewrite map_rlx. apply TVIEWLE.
    Qed.

    Lemma sim_thread_consistent
          views1 rels1 e1_pf e1_j e1_ra
          (SIM1: sim_thread views1 rels1 e1_pf e1_j e1_ra)
          (WF1_PF: wf_pf e1_pf)
          (WF1_J: wf_j views1 e1_j)
          (WF1_RA: wf_ra rels1 e1_ra)
          (CONSISTENT: PF.pf_consistent L e1_pf):
      (<<CONSISTENT_J: JThread.consistent e1_j views1>>) /\
      ((<<CONSISTENT_RA: OrdThread.consistent L Ordering.acqrel e1_ra>>) \/
       exists rels2 rels3 e_ra e2_ra e3_ra loc to val released ord,
         (<<STEPS_RA: RAThread.tau_steps L rels1 rels2 e1_ra e2_ra>>) /\
         (<<CONS: Local.promise_consistent (Thread.local e2_ra)>>) /\
         (<<STEP_RA: RAThread.step L rels2 rels3 e_ra e2_ra e3_ra>>) /\
         (<<READ: ThreadEvent.is_reading e_ra = Some (loc, to, val, released, ord)>>) /\
         (<<RACE: RARaceW.ra_race L rels2 (Local.tview (Thread.local e2_ra)) loc to ord>>)).
    Proof.
      split.
      { eapply JSim.sim_thread_consistent;
          try eapply SIM1; try eapply WF1_PF; try eapply WF1_J.
        inv CONSISTENT. des.
        eapply Trace.consistent_thread_consistent; eauto. }
      exploit Memory.cap_exists; try apply WF1_PF. i. des.
      exploit Memory.cap_exists; try apply WF1_J. i. des.
      exploit Memory.cap_exists; try apply WF1_RA. i. des.
      exploit Memory.cap_closed; try eapply WF1_PF; eauto. i.
      exploit Memory.cap_closed; try eapply WF1_J; eauto. i.
      exploit Memory.cap_closed; try eapply WF1_RA; eauto. i.
      exploit Memory.max_concrete_timemap_exists; try eapply x0. i. des.
      exploit Memory.max_concrete_timemap_exists; try eapply x1. i. des.
      exploit Memory.max_concrete_timemap_exists; try eapply x2. i. des.
      exploit sim_thread_cap; eauto. i. des.
      inv CONSISTENT. des. exploit CONSISTENT; eauto. i. des.
      - exploit sim_thread_steps; try exact STEPS; eauto.
        { inv FAILURE; inv STEP. inv LOCAL. inv LOCAL0. ss. }
        i. des.
        + exploit steps_pf_future; try exact STEPS; eauto. i. des.
          exploit steps_j_future; try exact STEPS_J; eauto. i. des.
          exploit steps_ra_future; try eapply RAThread.tau_steps_steps;
            try exact STEPS_RA; eauto. i. des.
          exploit sim_thread_step; try exact FAILURE; eauto; ss.
          { inv FAILURE; inv STEP. inv LOCAL. inv LOCAL0. ss. }
          i. des.
          * left. ii. left.
            exploit Memory.cap_inj; [exact CAP2|exact CAP1|..]; try apply WF1_RA. i. subst.
            exploit Memory.max_concrete_timemap_inj; [exact SC_MAX|exact x5|]. i. subst.
            inv EVENT_J; inv EVENT_RA.
            exploit RAThread.tau_steps_ord_tau_steps; try exact STEPS_RA. i.
            inv STEP_RA. dup STEP. inv STEP0; [inv STEP1|].
            unfold OrdThread.steps_failure. esplits; eauto.
          * right.
            exploit RAThread.cap_plus_step_current_plus_step;
              try exact STEPS_RA; eauto; try apply WF1_RA. i. des.
            destruct e_ra; inv READ.
            { inv EVENT. inv TO. esplits; eauto; ss.
              - eapply local_map_promise_consistent; eauto.
              - eapply local_map_ra_race; eauto. }
            { inv EVENT. inv FROM. esplits; eauto; ss.
              - eapply local_map_promise_consistent; eauto.
              - eapply local_map_ra_race; eauto. }
        + right.
          exploit RAThread.cap_plus_step_current_plus_step;
            try exact STEPS_RA; eauto; try apply WF1_RA. i. des.
          destruct e_ra; inv READ.
          { inv EVENT. inv TO. esplits; eauto; ss.
            - eapply local_map_promise_consistent; eauto.
            - eapply local_map_ra_race; eauto. }
          { inv EVENT. inv FROM. esplits; eauto; ss.
            - eapply local_map_promise_consistent; eauto.
            - eapply local_map_ra_race; eauto. }
      - exploit sim_thread_steps; try exact STEPS; eauto.
        { ii. rewrite PROMISES in *. rewrite Memory.bot_get in *. ss. }
        i. des.
        + left. ii. right.
          exploit Memory.cap_inj; [exact CAP2|exact CAP1|..]; try apply WF1_RA. i. subst.
          exploit Memory.max_concrete_timemap_inj; [exact SC_MAX|exact x5|]. i. subst.
          exploit RAThread.tau_steps_ord_tau_steps; try exact STEPS_RA. i.
          esplits; eauto.
          inv SIM2. inv SIM_JOINED.
          apply inj_pair2 in H2. apply inj_pair2 in H3. subst. ss.
          exploit JSim.sim_local_memory_bot; eauto. i.
          inv SIM_RA. ss. subst. inv LOCAL0. congr.
        + right.
          exploit RAThread.cap_plus_step_current_plus_step;
            try exact STEPS_RA; eauto; try apply WF1_RA. i. des.
          destruct e_ra; inv READ.
          { inv EVENT. inv TO. esplits; eauto; ss.
            - eapply local_map_promise_consistent; eauto.
            - eapply local_map_ra_race; eauto. }
          { inv EVENT. inv FROM. esplits; eauto; ss.
            - eapply local_map_promise_consistent; eauto.
            - eapply local_map_ra_race; eauto. }
    Qed.
  End PFtoRAThread.
End PFtoRAThread.


Require Import Raft.

Section LastAppliedLeCommitIndexInterface.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition lastApplied_le_commitIndex net :=
    forall h,
      lastApplied (nwState net h) <= commitIndex (nwState net h).

  Class lastApplied_le_commitIndex_interface : Prop :=
    {
      lastApplied_le_commitIndex_invariant :
        forall net,
          raft_intermediate_reachable net ->
          lastApplied_le_commitIndex net
    }.
End LastAppliedLeCommitIndexInterface.


Require Import Prelude.
Require Import Expr Scoping Reduction RedScoping.

Notation typ := exp.
Notation con := (seq exp).

Hint Resolve subtyp_cong1.
Hint Resolve leP ltP eqP.

Variable const_tys : env exp.
(* Variable (conv : relation exp). *)

(* Notation dget Gamma n := (nth (ids 0) Gamma n).[wk n.+1]. *)
Fixpoint dget {T} `{Ids T} `{Subst T} (Gamma : seq T) (n : var) {struct n} : T :=
  match Gamma, n with
    | [::], _ => ids 0
    | A :: _, 0 => A.[wk 1]
    | _ :: Gamma, n.+1 => (dget Gamma n).[wk 1]
  end.

Reserved Notation "'[' C '|+' e ':<' t ']'" (at level 20).
Reserved Notation "'[' C '|+' T ']'" (at level 20).
Reserved Notation "'[' C '|+' ']'" (at level 20).
Open Scope list_scope.
(* Definition max (i j : Univ) := match i,j with typ,_|_,typ => typ | _,_ => set end. *)
Definition imax (i j : nat) := match j with 0 => 0 | _ => max i j end.

(* Fixpoint has_type (Gamma : list exp) (e T : exp) : Prop *)
(*   match e,T with *)
(*     | Bind i,_ => (i < size Gamma) /\ (dget Gamma i = T) *)
(*     | Free nm,_ => const_tys nm = Some *)
(*     | Sort i, Sort j => i < j *)
(*     | (A :>> B), Sort k => exists i j, [Gamma |+ A :< Sort i] /\ [A :: Gamma |+ B :< Sort j] /\ imax i j < k *)
(*     | (Sigma A B), Sort k => exists i j, [Gamma |+ A :< Sort i] /\ [A :: Gamma |+ B :< Sort j] /\ imax i j < k *)
(*     | (Sum A B), Sort k => exists i j, [Gamma |+ A :< Sort i] /\ [Gamma |+ B :< Sort j] /\ i < k /\ j < k *)
(*   end *)
(* where "[ C |+ e :< t ]" := (has_type C e T). *)

Inductive has_type (Gamma : seq exp) : exp ->  exp -> Prop :=
  T_bind : forall i u, i < size Gamma -> u = dget Gamma i -> [Gamma |+ Bind i :< u]
| T_free : forall nm t, const_tys nm = Some t -> [Gamma |+ Free nm :< t]
| T_sort : forall s, [Gamma |+ Sort s :< Sort s.+1]
(* | T_cumu : forall i j, [Gamma |+ i :< Sort j] -> [Gamma |+ i :< Sort j.+1] *)
(* | T_set : [Gamma |+ Sort set :< Sort typ] *)
| T_pi : forall A B l1 l2, [Gamma |+ A :< Sort l1] -> [(A :: Gamma) |+ B :< Sort l2] -> [Gamma |+ (A :>> B) :< Sort (imax l1 l2)]
| T_lam : forall A B b, [(A :: Gamma) |+ b :< B] -> [Gamma |+ (Lam b) :< (A :>> B)]
| T_app : forall A B f a u, [Gamma |+ f :< (A :>> B)] -> [Gamma |+ a :< A] -> u = B.[a/] -> [Gamma |+ (f :$: a) :< u]
| T_sig : forall A B l1 l2, [Gamma |+ A :< Sort l1] -> [(A :: Gamma) |+ B :< Sort l2] -> [Gamma |+ Sigma A B :< Sort (imax l1 l2)]
| T_smk : forall A B a b u, [Gamma |+ a :< A] ->
                       u = B.[a/] -> [Gamma |+ b :< u] ->
                       [Gamma |+ S_mk a b :< Sigma A B]
| T_srec : forall C A B r p u1 u2,
             u1 = C.[S_mk (Bind 1) (Bind 0) .: wk 2] -> [B :: A :: Gamma |+ r :< u1] ->
             [Gamma |+ p :< Sigma A B] ->
             u2 = C.[p/] -> [Gamma |+ S_rec r p :< u2]
(* | T_p1  : forall A B s, [Gamma |+ s :< Sigma A B] -> [Gamma |+ S_p1 s :< A] *)
(* | T_p2  : forall A B s, [Gamma |+ s :< Sigma A B] -> [Gamma |+ S_p2 s :< B.[S_p1 s/]] *)

(* | T_sum : forall A B l1 l2, [Gamma |+ A :< Sort l1] -> [Gamma |+ B :< Sort l2] -> [Gamma |+ Sum A B :< Sort (max l1 l2)] *)
| T_inl : forall A B a, [Gamma |+ a :< A] -> [Gamma |+ Sum_inl a :< Sum A B]
| T_inr : forall A B b, [Gamma |+ b :< B] -> [Gamma |+ Sum_inr b :< Sum A B]
| T_split : forall P A B a b ab u1 u2 u3,
              u1 = P.[Sum_inl (Bind 0) .: wk 1] -> [(A :: Gamma) |+ a :< u1] ->
              u2 = P.[Sum_inr (Bind 0) .: wk 1] -> [(B :: Gamma) |+ b :< u2] ->
              u3 = P.[ab/] -> [Gamma |+ Split a b ab :< u3]

(* | T_Unit : [Gamma |+ Unit :< Sort set] *)
| T_unit : [Gamma |+ unit :< Unit]

(* | T_Mu  : forall D, [Gamma |+ Mu D :< Sort set] *)
(* | T_Wrap : forall d D, [Gamma |+ d :< D_efunc D (Mu D)] -> [Gamma |+ Wrap d :< Mu D] *)
(* | T_Unwrap : forall d D, [Gamma |+ d :< Mu D] -> [Gamma |+ Unwrap d :< D_efunc D (Mu D)] *)
| T_mu : forall D C r d u1 u2 u3,
         forall n, [(Mu D :: Gamma) |+ C :< Sort n] ->
           (* [(Mu D :: Gamma) |+ C] -> *)
              u1 = All D C.[up (wk 1)] (Bind 0) ->
              u2 = C.[Bind 1 .: wk 2] ->
              [u1 :: Mu D :: Gamma |+ r :< u2] ->
              [Gamma   |+ d :< Mu D] ->
              u3 = C.[d/] ->
              [Gamma   |+ mu D r d :< u3]

(* | T_conv : forall A A', conv A A' -> forall a, [Gamma |+ a :< A] -> [Gamma |+ a :< A'] *)
| T_wrap   : forall D d, [Gamma |+ d :< D_efunc D (Mu D)] -> [Gamma |+ d :< Mu D]
| T_unwrap : forall D d u, [Gamma |+ d :< Mu D] -> u = D_efunc D (Mu D) -> [Gamma |+ d :< u]
| T_subty : forall a A A', A ::<< A' -> [Gamma |+ a :< A] -> [Gamma |+ a :< A']
where "[ C |+ e :< t ]" := (has_type C e t).

Hypothesis const_tys_vals : forall nm t e, const_tys nm = Some t /\ Reduction.const_vals nm = Some e -> [nil |+ e :< t].

(* Fixpoint has_type_rec (Gamma : list exp) (e : exp) (T : exp) : Prop := *)
(*   match e with *)
(*     | Bind i => (i < ⟦Gamma⟧) /\ conv T (dget Gamma i) *)
(*     | Free nm => exists t, const_tys nm = Some t /\ conv T t *)
(*     | Sort i => exists j, i < j /\ conv T (Sort j) *)
(*     | A :>> B => exists i j k, has_type_rec Gamma A (Sort i) /\ has_type_rec (A :: Gamma) B (Sort j) /\ k > imax i j /\ conv T (Sort k) *)
(*     | Lam b => exists A B, has_type_rec (A :: Gamma) b B /\ conv T (A :>> B) *)
(*     | _ => False *)
(*   end. *)
(* with is_type (Gamma : list exp) : exp -> Prop := *)
(*   T_typ : forall e, [Gamma |+ e :< Typ] -> [Gamma |+ e] *)
(* | T_pi : forall A B, [Gamma |+ A] -> [(A :: Gamma) |+ B] -> [Gamma |+ Pi A B] *)
(* | T_sig : forall A B, [Gamma |+ A] -> [(A :: Gamma) |+ B] -> [Gamma |+ Sigma A B] *)
(* | T_sum : forall A B, [Gamma |+ A] -> [Gamma |+ B] -> [Gamma |+ Sum A B] *)
(* | T_Mu : forall D, [Gamma |+ Mu D] *)
(* where "[ C |+ T ]" := (is_type C T). *)

Notation "[ Delta |+ sigma +| Gamma ]" := (forall x, x < size Gamma -> [Delta |+ sigma x :< (dget Gamma x).[sigma]]) (at level 20).

Lemma sub_cons_var sigma e E Gamma Delta : [Delta |+ sigma +| Gamma] ->
                                             [Delta |+ e :< E.[sigma]] ->
                                             [Delta |+ e .: sigma +| E :: Gamma].
Proof. intros; destruct x; asimpl; eauto. Qed.

Hint Constructors has_type.
Lemma sub_id_ref : forall Gamma, [Gamma |+ ids +| Gamma]. intros; asimpl; auto. Qed.
Lemma sub_wk_var : forall Gamma A, [A :: Gamma |+ wk 1 +| Gamma]. intros; asimpl; constructor; auto. Qed.

Hint Resolve sub_id_ref sub_wk_var sub_cons_var.

Lemma dget_nth : forall Gamma n, n <  size Gamma -> dget Gamma n = (nth (ids 0) Gamma n).[wk n.+1].
  induction Gamma; simpl.
  { inversion 1. }
  { intros. destruct n; simpl; auto.
    rewrite IHGamma; autosubst. }
Qed.

Functional Scheme sub_ind := Induction for minus Sort Prop.

Hypothesis const_tys_closed : forall nm e, const_tys nm = Some e -> closed e.

Hint Resolve const_tys_closed.
Hint Resolve efunc_closed.
Hint Resolve red_conv sred_cong1.

Lemma upren_dget Gamma Delta xi A : (forall v, v < size Gamma -> (dget Gamma v).[ren xi] = dget Delta (xi v)) ->
                           forall v, v < (size Gamma).+1 -> (dget (A :: Gamma) v).[ren (upren xi)] = dget (A.[ren xi] :: Delta) (upren xi v).
Proof. simpl in *; intros; destruct v; asimpl; auto. rewrite <- H; autosubst. Qed.
Hint Resolve upren_dget.

Lemma ty_renaming xi Gamma Delta a A :
  [ Gamma |+ a :< A ] ->
  ren_scop xi (size Gamma) (size Delta) ->
  (forall v, v < size Gamma -> (dget Gamma v).[ren xi] = dget Delta (xi v)) ->
  [ Delta |+ a.[ren xi] :< A.[ren xi]].
Proof. move=>Ha; move:xi Delta; induction Ha; simpl; intros; try solve[subst;auto].
  { rewrite closed_sub_id; try eapply const_tys_closed; eassumption || auto. }
  { asimpl. constructor; try solve[eauto].
    apply IHHa2; intros; simpl in *; auto.
    eapply ren_upren; eassumption. }
  { asimpl; constructor.
    apply IHHa; intros; simpl in *; try eapply ren_upren; eassumption || auto. }
  { subst; econstructor; solve[autosubst|eauto]. }
  { constructor; try solve[eauto]; asimpl.
    apply IHHa2; intros; simpl in *; auto.
    eapply ren_upren; eassumption. }
  { subst; econstructor; try (eapply IHHa1 || eapply IHHa2; eassumption).
    autosubst. }
  { eapply T_srec with (C := C.[up (ren xi)]) (u1 := u1.[upn 2 (ren xi)]).
    { subst; autosubst. }
    { rewrite up_upren_n_internal; auto. eapply IHHa1.
      { simpl. intros. change (size Delta).+2 with (2 + size Delta). eapply ren_upnren; try eassumption. }
      { repeat rewrite iterate_S; rewrite iterate_0; auto. } }
    { simpl in *. rewrite <- up_upren_internal; auto. }
    { subst. autosubst. } }
  { asimpl; eapply T_split with (A := A.[ren xi]) (B := B.[ren xi]) (P := P.[up (ren xi)]).
    shelve.
    { eapply IHHa1; intros; destruct v; simpl in *; auto.
      - apply H2; auto.
      - autosubst.
      - rewrite <- H3; autosubst. }
    shelve.
    { apply IHHa2; intros; destruct v; simpl in *; auto.
      - apply H2; auto.
      - autosubst.
      - rewrite <- H3; autosubst. }
    Unshelve. subst; autosubst. subst; autosubst. subst; autosubst. }
  { specialize (IHHa1 (upren xi) (Mu D :: Delta)); specialize (IHHa2 (upnren 2 xi) (u1.[up (ren xi)] :: Mu D :: Delta));
    specialize (IHHa3 xi Delta); simpl in *; intuition.
    apply T_mu with (C := C.[up (ren xi)]) (u1 := u1.[up (ren xi)]) (u2 := u2.[upn 2 (ren xi)]) (n := n);
      try solve [subst;autosubst|auto].
    { asimpl. eapply IHHa1; simpl; apply ren_upren || apply upren_dget; auto. }
    { rewrite up_upren_n_internal; auto.
      apply IHHa2; repeat rewrite ?iterate_S ?iterate_0; simpl;
      repeat apply ren_upren; auto.
      rewrite up_upren_internal; auto.
      change (size Gamma).+2 with (size (Mu D :: Gamma)).+1.
      repeat (apply upren_dget; simpl); auto. } }
  { apply T_wrap.
    replace (D_efunc D (Mu D)) with (D_efunc D (Mu D)).[ren xi]; auto. }
  { simpl in *; apply T_unwrap with (D := D); auto.
    subst; apply closed_sub_id; auto. }
  { eauto. }
Qed.

Lemma wk_i_up_jk : forall i j k, sub_eq (wk i >> upn j (wk k)) (upn (j - i) (wk k) >> wk i).
  intros i j.
  refine (sub_ind (fun j i ij => forall k, sub_eq (wk i >> upn j (wk k)) (upn ij (wk k) >> wk i)) _ _ _ j i);
    intros; subst.
  { asimpl; f_equal; omega. }
  { autosubst. }
  { replace ((wk l.+1 >> upn k.+1 (wk k0)) v) with ((wk l >> upn k (wk k0)) v).[wk 1] by autosubst.
    rewrite H; autosubst. }
Qed.

Hint Resolve wk_i_up_jk.

(* Hint Rewrite sub_vars_tms using solve[eauto]. *)

Lemma closed_upn : forall i j sigma, closed_sub j sigma -> closed_sub (i + j) (upn i sigma).
Proof. induction i; move=>j sigma; rewrite ?iterate_S; solve[eauto]. Qed.

Hint Resolve closed_upn.

Lemma wk_ty A Gamma e T : [Gamma |+ e :< T] -> [A :: Gamma |+ e.[wk 1] :< T.[wk 1]]. intros; apply ty_renaming with (Gamma := Gamma); auto. Qed.
Hint Resolve wk_ty.
Lemma wk2_ty_eq A B Gamma e T u : [Gamma |+ e :< T] -> u = T.[wk 2] -> [A :: B :: Gamma |+ e.[wk 2] :< u].
Proof. intros; subst; apply ty_renaming with (Gamma := Gamma); intros; asimpl; auto.  Qed.
Hint Resolve wk2_ty_eq.
Lemma wk2_ty A B Gamma e T : [Gamma |+ e :< T] -> [A :: B :: Gamma |+ e.[wk 2] :< T.[wk 2]].
Proof. intros; subst; apply ty_renaming with (Gamma := Gamma); intros; asimpl; auto.  Qed.
Hint Resolve wk2_ty.

Lemma up_ty A Gamma Delta sigma : [Gamma |+ sigma +| Delta] -> [A.[sigma] :: Gamma |+ up sigma +| A :: Delta].
Proof. destruct x; simpl; intros; auto; asimpl; rewrite <- subst_comp; try constructor; auto. Qed.
Hint Resolve up_ty.

Hint Extern 1 (_.[_] = _.[_]) => autosubst.

Lemma sub_var_cor : forall e Delta T, [Delta |+ e :< T] -> forall sigma Gamma, [Gamma |+ sigma +| Delta] -> [Gamma |+ e.[sigma] :< T.[sigma]].
Proof. induction 1; simpl; intros; auto;
  asimpl; rewrite <- ?subst_comp; simpl in *;
  try solve [subst;auto].
  { rewrite closed_sub_id; try eapply const_tys_closed; eassumption || eauto. }
  { eapply T_app; subst; eauto. }
  { eapply T_smk; try eapply IHhas_type2; subst; auto. }
  { eapply T_srec with (A := A.[sigma]) (B := B.[up sigma]) (C := C.[up sigma]). shelve.
    { eapply IHhas_type1.
      destruct x; intros; auto; asimpl.
      - constructor; autosubst.
      - destruct x; asimpl.
        +  constructor; autosubst.
        + rewrite <- subst_comp; auto. }
    { eapply IHhas_type2; auto. }
    Unshelve. subst; autosubst. subst; autosubst. }
  { eapply T_split with (P := P.[up sigma]) (A := A.[sigma]) (B := B.[sigma]). shelve.
    { specialize (IHhas_type1 (up sigma)). asimpl in *. auto. }
    shelve.
    { specialize (IHhas_type2 (up sigma)). asimpl in *. auto. }
    Unshelve. subst; autosubst. subst; autosubst. subst; autosubst. }
  { eapply T_mu with (C := C.[up sigma]).
    { eapply IHhas_type1. destruct x; intros.
      { asimpl. constructor; auto. }
      { asimpl; rewrite <- subst_comp; auto. } }
    shelve. shelve.
    { eapply IHhas_type2.
      destruct x; intros.
      { asimpl. rewrite <- subst_comp. constructor; simpl; auto. }
      { destruct x; asimpl.
        { constructor; auto. }
        { eapply wk2_ty_eq; eauto. } } }
    { auto. }
    Unshelve. subst; autosubst. subst; autosubst. subst; autosubst. }
  { apply T_wrap.
    replace (D_efunc D (Mu D)) with (D_efunc D (Mu D)).[sigma]; auto. }
  { eapply T_unwrap; auto.
    subst; apply closed_sub_id; auto. }
  { eauto. }
Qed.

Hint Resolve sub_var_cor.
(* Notation "x .[ sigma ]" := (map (fun y => y.[sigma]) x). *)
Hint Rewrite <- subst_comp.

Lemma sub_comp_cor Gamma Delta Sigma delta sigma : [Gamma |+ delta +| Delta] -> [Delta |+ sigma +| Sigma] -> [Gamma |+ sigma >> delta +| Sigma].
Proof. intros; asimpl; autorewrite with core; solve[eauto]. Qed.

Lemma conv_Pi A B A' B' : (A :>> B) <:::> (A' :>> B') <-> (A <:::> A') /\ (B <:::> B').
Proof. split; autorewrite with unconv; intros; destr_logic;eauto.
  autorewrite with core in *; destr_logic; subst.
  inverts H0. split; eexists; eauto.
Qed.

Hint Rewrite conv_Pi.

Lemma T_conv Gamma e A B : A <:::> B -> [Gamma |+ e :< B] -> [Gamma |+ e :< A].
Proof. intros; eapply T_subty; try (constructor; symmetry); eassumption. Qed.

(* Lemma typed_closed Gamma e E : [Gamma |+ e :< E] -> closed_at (size Gamma) e. *)
(* Proof. induction 1; simpl in *; repeat (apply andb_true_intro; split); auto 10. Qed. *)

(* Print exp. *)

(* (* Hint Extern 1 (conv (dget (?A :: ?Delta) ?i) (dget (?A' :: ?Gamma) ?i)) => destruct i; simpl. *) *)
(* (* Theorem preservation Gamma Delta e e' T : conv_con Gamma Delta -> e ::> e' -> [Gamma |+ e :< T] -> [Delta |+ e' :< T]. *) *)
(* (* Proof. move=>Hgd He' He. move: e' He' Delta Hgd.  *) *)
(* (*   induction He; simpl; intros; destruct Hgd as [Hl Hi]; inverts He'; try (try econstructor; solve[eauto]). *) *)
(* (*   Local Hint Extern 1 (conv (dget (?A :: ?Delta) ?i) (dget (?A' :: ?Gamma) ?i)) => destruct i; simpl. *) *)
(* (*   Hint Resolve step_back_conv. *) *)
(* (*   { constructor. apply IHHe1; auto. apply IHHe2; auto; simpl; split; auto. } *) *)
(* (*   { constructor. apply IHHe1; auto. apply IHHe2; auto. simpl; split; auto. } *) *)
(* (*   { constructor. apply IHHe; auto. simpl; split; auto. } *) *)
(* (*   { constructor. apply IHHe; auto. simpl; split; auto. } *) *)
(* (*   { apply T_conv with (A := B.[a'/]); auto. apply T_app with (A := A); auto. } *) *)
(* (*   { apply T_conv with (A := B.[a'/]); auto.  *) *)
(* (*     assert (H: [Delta |+ Lam b :< (A :>> B)]) by auto. *) *)
(* (*     - eapply sub_var_cor; try eassumption. inversion H; subst; try eassumption.  *) *)


From iris.bi Require Export notation.
From iris.algebra Require Export ofe.
From iris Require Import options.
Set Primitive Projections.

Section bi_mixin.
  Context {PROP : Type} `{Dist PROP, Equiv PROP}.
  Context (bi_entails : PROP → PROP → Prop).
  Context (bi_emp : PROP).
  Context (bi_pure : Prop → PROP).
  Context (bi_and : PROP → PROP → PROP).
  Context (bi_or : PROP → PROP → PROP).
  Context (bi_impl : PROP → PROP → PROP).
  Context (bi_forall : ∀ A, (A → PROP) → PROP).
  Context (bi_exist : ∀ A, (A → PROP) → PROP).
  Context (bi_sep : PROP → PROP → PROP).
  Context (bi_wand : PROP → PROP → PROP).
  Context (bi_persistently : PROP → PROP).

  Bind Scope bi_scope with PROP.
  Local Infix "⊢" := bi_entails.
  Local Notation "'emp'" := bi_emp : bi_scope.
  Local Notation "'True'" := (bi_pure True) : bi_scope.
  Local Notation "'False'" := (bi_pure False) : bi_scope.
  Local Notation "'⌜' φ '⌝'" := (bi_pure φ%type%stdpp) : bi_scope.
  Local Infix "∧" := bi_and : bi_scope.
  Local Infix "∨" := bi_or : bi_scope.
  Local Infix "→" := bi_impl : bi_scope.
  Local Notation "∀ x .. y , P" :=
    (bi_forall _ (λ x, .. (bi_forall _ (λ y, P%I)) ..)) : bi_scope.
  Local Notation "∃ x .. y , P" :=
    (bi_exist _ (λ x, .. (bi_exist _ (λ y, P%I)) ..)) : bi_scope.
  Local Infix "∗" := bi_sep : bi_scope.
  Local Infix "-∗" := bi_wand : bi_scope.
  Local Notation "'<pers>' P" := (bi_persistently P) : bi_scope.

  (** * Axioms for a general BI (logic of bunched implications) *)

  (** The following axioms are satisifed by both affine and linear BIs, and BIs
  that combine both kinds of resources. In particular, we have an "ordered RA"
  model satisfying all these axioms. For this model, we extend RAs with an
  arbitrary partial order, and up-close resources wrt. that order (instead of
  extension order).  We demand composition to be monotone wrt. the order: [x1 ≼
  x2 → x1 ⋅ y ≼ x2 ⋅ y].  We define [emp := λ r, ε ≼ r]; persistently is still
  defined with the core: [persistently P := λ r, P (core r)].  This is uplcosed
  because the core is monotone.  *)

  Record BiMixin := {
    bi_mixin_entails_po : PreOrder bi_entails;
    bi_mixin_equiv_spec P Q : (P ≡ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P);

    (** Non-expansiveness *)
    bi_mixin_pure_ne n : Proper (iff ==> dist n) bi_pure;
    bi_mixin_and_ne : NonExpansive2 bi_and;
    bi_mixin_or_ne : NonExpansive2 bi_or;
    bi_mixin_impl_ne : NonExpansive2 bi_impl;
    bi_mixin_forall_ne A n :
      Proper (pointwise_relation _ (dist n) ==> dist n) (bi_forall A);
    bi_mixin_exist_ne A n :
      Proper (pointwise_relation _ (dist n) ==> dist n) (bi_exist A);
    bi_mixin_sep_ne : NonExpansive2 bi_sep;
    bi_mixin_wand_ne : NonExpansive2 bi_wand;
    bi_mixin_persistently_ne : NonExpansive bi_persistently;

    (** Higher-order logic *)
    bi_mixin_pure_intro (φ : Prop) P : φ → P ⊢ ⌜ φ ⌝;
    bi_mixin_pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P;

    bi_mixin_and_elim_l P Q : P ∧ Q ⊢ P;
    bi_mixin_and_elim_r P Q : P ∧ Q ⊢ Q;
    bi_mixin_and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R;

    bi_mixin_or_intro_l P Q : P ⊢ P ∨ Q;
    bi_mixin_or_intro_r P Q : Q ⊢ P ∨ Q;
    bi_mixin_or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R;

    bi_mixin_impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R;
    bi_mixin_impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R;

    bi_mixin_forall_intro {A} P (Ψ : A → PROP) : (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a;
    bi_mixin_forall_elim {A} {Ψ : A → PROP} a : (∀ a, Ψ a) ⊢ Ψ a;

    bi_mixin_exist_intro {A} {Ψ : A → PROP} a : Ψ a ⊢ ∃ a, Ψ a;
    bi_mixin_exist_elim {A} (Φ : A → PROP) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q;

    (** BI connectives *)
    bi_mixin_sep_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q';
    bi_mixin_emp_sep_1 P : P ⊢ emp ∗ P;
    bi_mixin_emp_sep_2 P : emp ∗ P ⊢ P;
    bi_mixin_sep_comm' P Q : P ∗ Q ⊢ Q ∗ P;
    bi_mixin_sep_assoc' P Q R : (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R);
    bi_mixin_wand_intro_r P Q R : (P ∗ Q ⊢ R) → P ⊢ Q -∗ R;
    bi_mixin_wand_elim_l' P Q R : (P ⊢ Q -∗ R) → P ∗ Q ⊢ R;

    (** Persistently *)
    (* In the ordered RA model: Holds without further assumptions. *)
    bi_mixin_persistently_mono P Q : (P ⊢ Q) → <pers> P ⊢ <pers> Q;
    (* In the ordered RA model: `core` is idempotent *)
    bi_mixin_persistently_idemp_2 P : <pers> P ⊢ <pers> <pers> P;

    (* In the ordered RA model: [ε ≼ core x]. *)
    bi_mixin_persistently_emp_2 : emp ⊢ <pers> emp;

    bi_mixin_persistently_forall_2 {A} (Ψ : A → PROP) :
      (∀ a, <pers> (Ψ a)) ⊢ <pers> (∀ a, Ψ a);
    bi_mixin_persistently_exist_1 {A} (Ψ : A → PROP) :
      <pers> (∃ a, Ψ a) ⊢ ∃ a, <pers> (Ψ a);

    (* In the ordered RA model: [core x ≼ core (x ⋅ y)]. *)
    bi_mixin_persistently_absorbing P Q : <pers> P ∗ Q ⊢ <pers> P;
    (* In the ordered RA model: [x ⋅ core x = x]. *)
    bi_mixin_persistently_and_sep_elim P Q : <pers> P ∧ Q ⊢ P ∗ Q;
  }.

  (** We equip any BI with a later modality. This avoids an additional layer in
  the BI hierachy and improves performance significantly (see Iris issue #303).

  For non step-indexed BIs the later modality can simply be defined as the
  identity function, as the Löb axiom or contractiveness of later is not part of
  [BiLaterMixin]. For step-indexed BIs one should separately prove an instance
  of the class [BiLaterContractive PROP] or [BiLöb PROP]. (Note that there is an
  instance [BiLaterContractive PROP → BiLöb PROP] in [derived_laws_later].)

  For non step-indexed BIs one can get a "free" instance of [BiLaterMixin] using
  the smart constructor [bi_later_mixin_id] below. *)
  Context (bi_later : PROP → PROP).
  Local Notation "▷ P" := (bi_later P) : bi_scope.

  Record BiLaterMixin := {
    bi_mixin_later_ne : NonExpansive bi_later;

    bi_mixin_later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q;
    bi_mixin_later_intro P : P ⊢ ▷ P;

    bi_mixin_later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a;
    bi_mixin_later_exist_false {A} (Φ : A → PROP) :
      (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a);
    bi_mixin_later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q;
    bi_mixin_later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q);
    bi_mixin_later_persistently_1 P : ▷ <pers> P ⊢ <pers> ▷ P;
    bi_mixin_later_persistently_2 P : <pers> ▷ P ⊢ ▷ <pers> P;

    bi_mixin_later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P);
  }.

  Lemma bi_later_mixin_id :
    (∀ (P : PROP), (▷ P)%I = P) →
    BiMixin → BiLaterMixin.
  Proof.
    intros Hlater Hbi. pose proof (bi_mixin_entails_po Hbi).
    split; repeat intro; rewrite ?Hlater ?Hequiv //.
    - apply (bi_mixin_forall_intro Hbi)=> a.
      etrans; [apply (bi_mixin_forall_elim Hbi a)|]. by rewrite Hlater.
    - etrans; [|apply (bi_mixin_or_intro_r Hbi)].
      apply (bi_mixin_exist_elim Hbi)=> a.
      etrans; [|apply (bi_mixin_exist_intro Hbi a)]. by rewrite /= Hlater.
    - etrans; [|apply (bi_mixin_or_intro_r Hbi)].
      apply (bi_mixin_impl_intro_r Hbi), (bi_mixin_and_elim_l Hbi).
  Qed.
End bi_mixin.

Structure bi := Bi {
  bi_car :> Type;
  bi_dist : Dist bi_car;
  bi_equiv : Equiv bi_car;
  bi_entails : bi_car → bi_car → Prop;
  bi_emp : bi_car;
  bi_pure : Prop → bi_car;
  bi_and : bi_car → bi_car → bi_car;
  bi_or : bi_car → bi_car → bi_car;
  bi_impl : bi_car → bi_car → bi_car;
  bi_forall : ∀ A, (A → bi_car) → bi_car;
  bi_exist : ∀ A, (A → bi_car) → bi_car;
  bi_sep : bi_car → bi_car → bi_car;
  bi_wand : bi_car → bi_car → bi_car;
  bi_persistently : bi_car → bi_car;
  bi_later : bi_car → bi_car;
  bi_ofe_mixin : OfeMixin bi_car;
  bi_cofe : Cofe (OfeT bi_car bi_ofe_mixin);
  bi_bi_mixin : BiMixin bi_entails bi_emp bi_pure bi_and bi_or bi_impl bi_forall
                        bi_exist bi_sep bi_wand bi_persistently;
  bi_bi_later_mixin : BiLaterMixin bi_entails bi_pure bi_or bi_impl
                                   bi_forall bi_exist bi_sep bi_persistently bi_later;
}.

Coercion bi_ofeO (PROP : bi) : ofeT := OfeT PROP (bi_ofe_mixin PROP).
Canonical Structure bi_ofeO.
Global Instance bi_cofe' (PROP : bi) : Cofe PROP.
Proof. apply bi_cofe. Qed.

Instance: Params (@bi_entails) 1 := {}.
Instance: Params (@bi_emp) 1 := {}.
Instance: Params (@bi_pure) 1 := {}.
Instance: Params (@bi_and) 1 := {}.
Instance: Params (@bi_or) 1 := {}.
Instance: Params (@bi_impl) 1 := {}.
Instance: Params (@bi_forall) 2 := {}.
Instance: Params (@bi_exist) 2 := {}.
Instance: Params (@bi_sep) 1 := {}.
Instance: Params (@bi_wand) 1 := {}.
Instance: Params (@bi_persistently) 1 := {}.
Instance: Params (@bi_later) 1  := {}.

Arguments bi_car : simpl never.
Arguments bi_dist : simpl never.
Arguments bi_equiv : simpl never.
Arguments bi_entails {PROP} _%I _%I : simpl never, rename.
Arguments bi_emp {PROP} : simpl never, rename.
Arguments bi_pure {PROP} _%stdpp : simpl never, rename.
Arguments bi_and {PROP} _%I _%I : simpl never, rename.
Arguments bi_or {PROP} _%I _%I : simpl never, rename.
Arguments bi_impl {PROP} _%I _%I : simpl never, rename.
Arguments bi_forall {PROP _} _%I : simpl never, rename.
Arguments bi_exist {PROP _} _%I : simpl never, rename.
Arguments bi_sep {PROP} _%I _%I : simpl never, rename.
Arguments bi_wand {PROP} _%I _%I : simpl never, rename.
Arguments bi_persistently {PROP} _%I : simpl never, rename.
Arguments bi_later {PROP} _%I : simpl never, rename.

Hint Extern 0 (bi_entails _ _) => reflexivity : core.
Instance bi_rewrite_relation (PROP : bi) : RewriteRelation (@bi_entails PROP) := {}.
Instance bi_inhabited {PROP : bi} : Inhabited PROP := populate (bi_pure True).

Notation "P ⊢ Q" := (bi_entails P%I Q%I) : stdpp_scope.
Notation "P '⊢@{' PROP } Q" := (bi_entails (PROP:=PROP) P%I Q%I) (only parsing) : stdpp_scope.
Notation "(⊢)" := bi_entails (only parsing) : stdpp_scope.
Notation "'(⊢@{' PROP } )" := (bi_entails (PROP:=PROP)) (only parsing) : stdpp_scope.

Notation "P ⊣⊢ Q" := (equiv (A:=bi_car _) P%I Q%I) : stdpp_scope.
Notation "P '⊣⊢@{' PROP } Q" := (equiv (A:=bi_car PROP) P%I Q%I) (only parsing) : stdpp_scope.
Notation "(⊣⊢)" := (equiv (A:=bi_car _)) (only parsing) : stdpp_scope.
Notation "'(⊣⊢@{' PROP } )" := (equiv (A:=bi_car PROP)) (only parsing) : stdpp_scope.
Notation "( P ⊣⊢.)" := (equiv (A:=bi_car _) P) (only parsing) : stdpp_scope.
Notation "(.⊣⊢ Q )" := (λ P, P ≡@{bi_car _} Q) (only parsing) : stdpp_scope.

Notation "P -∗ Q" := (P ⊢ Q) : stdpp_scope.

Notation "'emp'" := (bi_emp) : bi_scope.
Notation "'⌜' φ '⌝'" := (bi_pure φ%type%stdpp) : bi_scope.
Notation "'True'" := (bi_pure True) : bi_scope.
Notation "'False'" := (bi_pure False) : bi_scope.
Infix "∧" := bi_and : bi_scope.
Notation "(∧)" := bi_and (only parsing) : bi_scope.
Infix "∨" := bi_or : bi_scope.
Notation "(∨)" := bi_or (only parsing) : bi_scope.
Infix "→" := bi_impl : bi_scope.
Notation "¬ P" := (P → False)%I : bi_scope.
Infix "∗" := bi_sep : bi_scope.
Notation "(∗)" := bi_sep (only parsing) : bi_scope.
Notation "P -∗ Q" := (bi_wand P Q) : bi_scope.
Notation "∀ x .. y , P" :=
  (bi_forall (λ x, .. (bi_forall (λ y, P)) ..)%I) : bi_scope.
Notation "∃ x .. y , P" :=
  (bi_exist (λ x, .. (bi_exist (λ y, P)) ..)%I) : bi_scope.
Notation "'<pers>' P" := (bi_persistently P) : bi_scope.

Notation "▷ P" := (bi_later P) : bi_scope.

Definition bi_emp_valid {PROP : bi} (P : PROP) : Prop := emp ⊢ P.

Arguments bi_emp_valid {_} _%I : simpl never.
Typeclasses Opaque bi_emp_valid.

Notation "⊢ Q" := (bi_emp_valid Q%I) : stdpp_scope.
Notation "'⊢@{' PROP } Q" := (bi_emp_valid (PROP:=PROP) Q%I) (only parsing) : stdpp_scope.
(** Work around parsing issues: see [notation.v] for details. *)
Notation "'(⊢@{' PROP } Q )" := (bi_emp_valid (PROP:=PROP) Q%I) (only parsing) : stdpp_scope.
Notation "(.⊢ Q )" := (λ P, P ⊢ Q) (only parsing) : stdpp_scope.
Notation "( P ⊢.)" := (bi_entails P) (only parsing) : stdpp_scope.

Module bi.
Section bi_laws.
Context {PROP : bi}.
Implicit Types φ : Prop.
Implicit Types P Q R : PROP.
Implicit Types A : Type.

(* About the entailment *)
Global Instance entails_po : PreOrder (@bi_entails PROP).
Proof. eapply bi_mixin_entails_po, bi_bi_mixin. Qed.
Lemma equiv_spec P Q : P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P).
Proof. eapply bi_mixin_equiv_spec, bi_bi_mixin. Qed.

(* Non-expansiveness *)
Global Instance pure_ne n : Proper (iff ==> dist n) (@bi_pure PROP).
Proof. eapply bi_mixin_pure_ne, bi_bi_mixin. Qed.
Global Instance and_ne : NonExpansive2 (@bi_and PROP).
Proof. eapply bi_mixin_and_ne, bi_bi_mixin. Qed.
Global Instance or_ne : NonExpansive2 (@bi_or PROP).
Proof. eapply bi_mixin_or_ne, bi_bi_mixin. Qed.
Global Instance impl_ne : NonExpansive2 (@bi_impl PROP).
Proof. eapply bi_mixin_impl_ne, bi_bi_mixin. Qed.
Global Instance forall_ne A n :
  Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_forall PROP A).
Proof. eapply bi_mixin_forall_ne, bi_bi_mixin. Qed.
Global Instance exist_ne A n :
  Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_exist PROP A).
Proof. eapply bi_mixin_exist_ne, bi_bi_mixin. Qed.
Global Instance sep_ne : NonExpansive2 (@bi_sep PROP).
Proof. eapply bi_mixin_sep_ne, bi_bi_mixin. Qed.
Global Instance wand_ne : NonExpansive2 (@bi_wand PROP).
Proof. eapply bi_mixin_wand_ne, bi_bi_mixin. Qed.
Global Instance persistently_ne : NonExpansive (@bi_persistently PROP).
Proof. eapply bi_mixin_persistently_ne, bi_bi_mixin. Qed.

(* Higher-order logic *)
Lemma pure_intro (φ : Prop) P : φ → P ⊢ ⌜ φ ⌝.
Proof. eapply bi_mixin_pure_intro, bi_bi_mixin. Qed.
Lemma pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P.
Proof. eapply bi_mixin_pure_elim', bi_bi_mixin. Qed.

Lemma and_elim_l P Q : P ∧ Q ⊢ P.
Proof. eapply bi_mixin_and_elim_l, bi_bi_mixin. Qed.
Lemma and_elim_r P Q : P ∧ Q ⊢ Q.
Proof. eapply bi_mixin_and_elim_r, bi_bi_mixin. Qed.
Lemma and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R.
Proof. eapply bi_mixin_and_intro, bi_bi_mixin. Qed.

Lemma or_intro_l P Q : P ⊢ P ∨ Q.
Proof. eapply bi_mixin_or_intro_l, bi_bi_mixin. Qed.
Lemma or_intro_r P Q : Q ⊢ P ∨ Q.
Proof. eapply bi_mixin_or_intro_r, bi_bi_mixin. Qed.
Lemma or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R.
Proof. eapply bi_mixin_or_elim, bi_bi_mixin. Qed.

Lemma impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R.
Proof. eapply bi_mixin_impl_intro_r, bi_bi_mixin. Qed.
Lemma impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R.
Proof. eapply bi_mixin_impl_elim_l', bi_bi_mixin. Qed.

Lemma forall_intro {A} P (Ψ : A → PROP) : (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a.
Proof. eapply bi_mixin_forall_intro, bi_bi_mixin. Qed.
Lemma forall_elim {A} {Ψ : A → PROP} a : (∀ a, Ψ a) ⊢ Ψ a.
Proof. eapply (bi_mixin_forall_elim bi_entails), bi_bi_mixin. Qed.

Lemma exist_intro {A} {Ψ : A → PROP} a : Ψ a ⊢ ∃ a, Ψ a.
Proof. eapply bi_mixin_exist_intro, bi_bi_mixin. Qed.
Lemma exist_elim {A} (Φ : A → PROP) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q.
Proof. eapply bi_mixin_exist_elim, bi_bi_mixin. Qed.

(* BI connectives *)
Lemma sep_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q'.
Proof. eapply bi_mixin_sep_mono, bi_bi_mixin. Qed.
Lemma emp_sep_1 P : P ⊢ emp ∗ P.
Proof. eapply bi_mixin_emp_sep_1, bi_bi_mixin. Qed.
Lemma emp_sep_2 P : emp ∗ P ⊢ P.
Proof. eapply bi_mixin_emp_sep_2, bi_bi_mixin. Qed.
Lemma sep_comm' P Q : P ∗ Q ⊢ Q ∗ P.
Proof. eapply (bi_mixin_sep_comm' bi_entails), bi_bi_mixin. Qed.
Lemma sep_assoc' P Q R : (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R).
Proof. eapply bi_mixin_sep_assoc', bi_bi_mixin. Qed.
Lemma wand_intro_r P Q R : (P ∗ Q ⊢ R) → P ⊢ Q -∗ R.
Proof. eapply bi_mixin_wand_intro_r, bi_bi_mixin. Qed.
Lemma wand_elim_l' P Q R : (P ⊢ Q -∗ R) → P ∗ Q ⊢ R.
Proof. eapply bi_mixin_wand_elim_l', bi_bi_mixin. Qed.

(* Persistently *)
Lemma persistently_mono P Q : (P ⊢ Q) → <pers> P ⊢ <pers> Q.
Proof. eapply bi_mixin_persistently_mono, bi_bi_mixin. Qed.
Lemma persistently_idemp_2 P : <pers> P ⊢ <pers> <pers> P.
Proof. eapply bi_mixin_persistently_idemp_2, bi_bi_mixin. Qed.

Lemma persistently_emp_2 : emp ⊢@{PROP} <pers> emp.
Proof. eapply bi_mixin_persistently_emp_2, bi_bi_mixin. Qed.

Lemma persistently_forall_2 {A} (Ψ : A → PROP) :
  (∀ a, <pers> (Ψ a)) ⊢ <pers> (∀ a, Ψ a).
Proof. eapply bi_mixin_persistently_forall_2, bi_bi_mixin. Qed.
Lemma persistently_exist_1 {A} (Ψ : A → PROP) :
  <pers> (∃ a, Ψ a) ⊢ ∃ a, <pers> (Ψ a).
Proof. eapply bi_mixin_persistently_exist_1, bi_bi_mixin. Qed.

Lemma persistently_absorbing P Q : <pers> P ∗ Q ⊢ <pers> P.
Proof. eapply (bi_mixin_persistently_absorbing bi_entails), bi_bi_mixin. Qed.
Lemma persistently_and_sep_elim P Q : <pers> P ∧ Q ⊢ P ∗ Q.
Proof. eapply (bi_mixin_persistently_and_sep_elim bi_entails), bi_bi_mixin. Qed.

(* Later *)
Global Instance later_ne : NonExpansive (@bi_later PROP).
Proof. eapply bi_mixin_later_ne, bi_bi_later_mixin. Qed.

Lemma later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q.
Proof. eapply bi_mixin_later_mono, bi_bi_later_mixin. Qed.
Lemma later_intro P : P ⊢ ▷ P.
Proof. eapply bi_mixin_later_intro, bi_bi_later_mixin. Qed.

Lemma later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a.
Proof. eapply bi_mixin_later_forall_2, bi_bi_later_mixin. Qed.
Lemma later_exist_false {A} (Φ : A → PROP) :
  (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a).
Proof. eapply bi_mixin_later_exist_false, bi_bi_later_mixin. Qed.
Lemma later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q.
Proof. eapply bi_mixin_later_sep_1, bi_bi_later_mixin. Qed.
Lemma later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q).
Proof. eapply bi_mixin_later_sep_2, bi_bi_later_mixin. Qed.
Lemma later_persistently_1 P : ▷ <pers> P ⊢ <pers> ▷ P.
Proof. eapply (bi_mixin_later_persistently_1 bi_entails), bi_bi_later_mixin. Qed.
Lemma later_persistently_2 P : <pers> ▷ P ⊢ ▷ <pers> P.
Proof. eapply (bi_mixin_later_persistently_2 bi_entails), bi_bi_later_mixin. Qed.

Lemma later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P).
Proof. eapply bi_mixin_later_false_em, bi_bi_later_mixin. Qed.
End bi_laws.
End bi.