From ConCert.Execution Require Import Blockchain.
From ConCert.Execution Require Import Containers.
From ConCert.Execution Require Import Serializable.
From ConCert.Execution.Test Require Import QCTest.
From ConCert.Examples.BAT Require Import BATCommon.
From ConCert.Examples.BAT Require Import BATPrinters.
From ConCert.Examples.EIP20 Require Import EIP20TokenGens.
From Coq Require Import List.
From Coq Require Import ZArith.
Import ListNotations.
Import MonadNotation.

Module Type BATGensInfo.
  Parameter trace_length : nat.
  Parameter gAccount : G Address.
  Parameter contract_addr : Address.
  Parameter accounts : list Address.
  Parameter accounts_total_balance : Z.
  Parameter bat_addr : Address.
  Parameter fund_addr : Address.
  Parameter bat_addr_refundable : bool.
  Parameter bat_addr_fundable : bool.
  Parameter eip20_transactions_before_finalized : bool.
End BATGensInfo.

Module BATGens (Info : BATGensInfo).
  Import Info.
  Arguments SerializedValue : clear implicits.
  Arguments deserialize : clear implicits.
  Arguments serialize : clear implicits.

  Definition account_balance (env : Environment) (addr : Address) : Amount :=
    (env_account_balances env) addr.

  Definition get_refundable_accounts state : list (G (option Address)) :=
    let balances_list := FMap.elements (balances state) in
    let filtered_balances := filter (fun x => (bat_addr_refundable || (address_neqb bat_addr (fst x))) && (0 <? (snd x))%N) balances_list in
      map returnGen (map Some (map fst filtered_balances)).

  Definition get_fundable_accounts env : G (option Address) :=
    let freq_accounts := map (fun addr => (if bat_addr_fundable || (address_neqb addr bat_addr) then Z.to_nat (account_balance env addr) else 0, returnGenSome addr)) accounts in
      freq_ (returnGen None) freq_accounts.

  Definition gFund_amount env state addr : G Z :=
    (choose (1, Z.min (account_balance env addr) (Z.of_N ((state.(tokenCreationCap) - (total_supply state)) / state.(tokenExchangeRate)))))%Z.

  Definition gCreateTokens (env : Environment) (state : BATCommon.State) : GOpt (Address * Amount * Msg) :=
    let current_slot := S (current_slot (env_chain env)) in
    if (state.(isFinalized)
            || (Nat.ltb current_slot state.(fundingStart))
            || (Nat.ltb state.(fundingEnd) current_slot) (* Funding can only happen in funding period *)
            || (N.ltb (state.(tokenCreationCap) - (total_supply state)) state.(tokenExchangeRate))) (* No funding if cap was hit or if we are too close to it *)
    then
      returnGen None
    else
      from_addr <- get_fundable_accounts env ;;
      value <- bindGen (gFund_amount env state from_addr) returnGenSome ;;
      returnGenSome (from_addr, value, create_tokens).

  Definition gCreateTokensInvalid (env : Environment) (state : BATCommon.State) : GOpt (Address * Amount * Msg) :=
    from_addr <- get_fundable_accounts env ;;
    value <- bindGen (choose (1, account_balance env from_addr)%Z) returnGenSome ;;
    returnGenSome (from_addr, value, create_tokens).

  Definition gRefund (env : Environment) (state : BATCommon.State) : GOpt (Address * Msg) :=
    let current_slot := S (current_slot (env_chain env)) in
    let accounts := get_refundable_accounts state in
    if ((state.(isFinalized)
            || (Nat.leb current_slot state.(fundingEnd))
            || (state.(tokenCreationMin) <=? (total_supply state))%N))
    then
      returnGen None
    else
      from_addr <- oneOf_ (returnGen None) accounts ;;
      returnGenSome (from_addr, refund).

  Definition gRefundInvalid (env : Environment) (state : BATCommon.State) : G (Address * Msg) :=
    from_addr <- gAccount ;;
    returnGen (from_addr, refund).

  Definition gFinalize (env : Environment) (state : BATCommon.State) : GOpt (Address * Msg) :=
    let current_slot := S (current_slot (env_chain env)) in
    if (state.(isFinalized)
          || ((total_supply state) <? state.(tokenCreationMin))%N
          || ((Nat.leb current_slot state.(fundingEnd)) && negb ((total_supply state) =? state.(tokenCreationCap))%N))
    then
      returnGen None
    else
      returnGenSome (fund_addr, finalize).

  Definition gFinalizeInvalid (env : Environment) (state : BATCommon.State) : G (Address * Msg) :=
    from_addr <- gAccount ;;
    returnGen (from_addr, finalize).

  Module EIP20 := EIP20Gens Info.

  Definition gTransfer (env : Environment) (state : BATCommon.State) : GOpt (Address * Msg) :=
    if eip20_transactions_before_finalized || state.(isFinalized)
    then
      '(caller, msg) <- EIP20.gTransfer env (token_state state) ;;
      returnGenSome (caller, tokenMsg msg)
    else
      returnGen None.

  Definition gApprove (state : BATCommon.State) : GOpt (Address * Msg) :=
    if eip20_transactions_before_finalized || state.(isFinalized)
    then
      bindGenOpt (EIP20.gApprove (token_state state))
          (fun '(caller, msg) => returnGenSome (caller, tokenMsg msg))
    else
      returnGen None.

  Definition gTransfer_from (state : BATCommon.State) : GOpt (Address * Msg) :=
    if eip20_transactions_before_finalized || state.(isFinalized)
    then
      bindGenOpt (EIP20.gTransfer_from (token_state state))
          (fun '(caller, msg) => returnGenSome (caller, tokenMsg msg))
    else
      returnGen None.

  (* BAT valid call generator.
    Generator that will always return BAToken contract calls that are valid on their own,
    i.e. guaranteed to be valid if it is the first action executed in the block.
  *)
  Definition gBATActionValid (env : Environment) : GOpt Action :=
    let call contract_addr caller_addr value msg :=
      returnGenSome (build_call caller_addr contract_addr value msg) in
    state <- returnGen (get_contract_state BATCommon.State env contract_addr) ;;
    backtrack [
      (* transfer *)
      (1, bindGenOpt (gTransfer env state)
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) msg
          )
      );
      (* transfer_from *)
      (2, bindGenOpt (gTransfer_from state)
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) msg
          )
      );
      (* approve *)
      (1, bindGenOpt (gApprove state)
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) msg
          )
      );
      (* create_tokens *)
      (5, bindGenOpt (gCreateTokens env state)
          (fun '(caller, value, msg) =>
            call contract_addr caller value msg
          )
      );
      (* refund *)
      (10, bindGenOpt (gRefund env state)
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) msg
          )
      );
      (* finalize *)
      (10, bindGenOpt (gFinalize env state)
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) msg
          )
      )
    ].

  (* BAT invalid call generator.
    Generator likely to generate invalid BAToken contract calls.
    It treats the BAToken code mostly as blackbox and only know the expected types of input
      but does not make any assumptions/checks on which values will result in valid or invalid calls
  *)
  Definition gBATActionInvalid (env : Environment) : GOpt Action :=
    let call contract_addr caller_addr value msg :=
      returnGenSome (build_call caller_addr contract_addr value msg) in
    state <- returnGen (get_contract_state BATCommon.State env contract_addr) ;;
    backtrack [
      (* transfer *)
      (1, '(caller, msg) <- EIP20.gTransfer env (token_state state) ;;
          call contract_addr caller (0%Z) (tokenMsg msg)
      ) ;
      (* transfer_from *)
      (2, bindGenOpt (EIP20.gTransfer_from (token_state state))
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) (tokenMsg msg)
          )
      );
      (* approve *)
      (1, bindGenOpt (EIP20.gApprove (token_state state))
          (fun '(caller, msg) =>
            call contract_addr caller (0%Z) (tokenMsg msg)
          )
      );
      (* create_tokens *)
      (5, bindGenOpt (gCreateTokensInvalid env state)
          (fun '(caller, value, msg) =>
            call contract_addr caller value msg
          )
      );
      (* refund *)
      (1, '(caller, msg) <- gRefundInvalid env state ;;
          call contract_addr caller (0%Z) msg
      );
      (* finalize *)
      (1, '(caller, msg) <- gFinalizeInvalid env state ;;
          call contract_addr caller (0%Z) msg
      )
    ].

  (* BAT call generator
    Has a 7% chance to attempt to generate an invalid contract call
      More specifically it has:
      - 0.5% chance of generating a valid call and then replacing the amount of money sent with that call.
        For BAT contract this is likely to result in an invalid call as most contract calls on BAToken are
        not allowed to include money in them.
      - 6.5% chance of using the invalid action generator. This generator is likely to generate an invalid call
        since it treats the contract as a black box and thus does not check any of the expected requirements for
        a contract call to be valid.
      The remaining 90% of the time it will generate a call that is guaranteed to be valid (only guaranteed to
      be valid on its own, since the generator cannot know what other calls may be included in the same block and
      which order they will be executed in)
  *)
  Definition gBATAction (env : Environment) : GOpt Action :=
    state <- returnGen (get_contract_state BATCommon.State env contract_addr) ;;
    freq [
      (5, bindGenOpt (gBATActionValid env)
          (fun '(action) =>
            match action.(act_body) with
            | act_transfer _ _ => returnGen None
            | act_deploy _ _ _ => returnGen None
            | act_call to _ msg =>
              amount <- choose (0, account_balance env action.(act_from))%Z ;;
              returnGenSome (build_call action.(act_from) to amount msg)
            end
          ));
      (65, gBATActionInvalid env);
      (930, gBATActionValid env)
    ].

  Definition gBATSetup : G Setup :=
    fundingStart <- choose (0, (trace_length - 1)) ;;
    fundingEnd <- choose (0, (trace_length - 1)) ;;
    exchangeRate <- choose (0, Z.to_N accounts_total_balance)%N ;;
    initSupply <- choose (0, Z.to_N accounts_total_balance)%N ;;
    tokenMin <- choose (0, Z.to_N accounts_total_balance)%N ;;
    tokenCap <- choose (0, Z.to_N accounts_total_balance)%N ;;
    returnGen (BATCommon.build_setup initSupply
                              fund_addr
                              bat_addr
                              fundingStart
                              fundingEnd
                              exchangeRate
                              tokenCap
                              tokenMin).

End BATGens.


Require Import Relations.
Require Import Permutation.
Require Import NArith.
Require Import PArith.
Require Import ZArith.
Require Import Lia.
Require Import FMapPositive.
Require Import FSetPositive.
Require Import EquivDec.
Require Import sflib.
Require Import PacoNotation.
Require Import HahnRelationsBasic.

Require Import PromisingArch.lib.Basic.
Require Import PromisingArch.lib.HahnRelationsMore.
Require Import PromisingArch.lib.Order.
Require Import PromisingArch.lib.Time.
Require Import PromisingArch.lib.Lang.
Require Import PromisingArch.promising.TsoPromising.
Require Import PromisingArch.promising.CommonPromising.
Require Import PromisingArch.promising.TsoStateExecFacts.
Require Import PromisingArch.axiomatic.TsoAxiomatic.
Require Import PromisingArch.equiv.TsoSimLocal.

Set Implicit Arguments.

Inductive sim_trace (p: program) (mem: Memory.t) (tid: Id.t):
  forall (tr: list (ExecUnit.t)) (atr: list AExecUnit.t)
     (wl: list (nat -> option (Loc.t * Time.t))) (rl: list (nat -> option (Loc.t * Time.t))) (fl: list (nat -> option (Loc.t * Time.t)))
     (cov: list (nat -> Time.t)) (vext: list (nat -> Time.t)), Prop :=
| sim_trace_init
    st lc stmts
    (FIND: IdMap.find tid (Machine.init_with_promises p mem).(Machine.tpool) = Some (st, lc))
    (STMT: IdMap.find tid p = Some stmts):
    sim_trace p mem tid [ExecUnit.mk st lc mem] [AExecUnit.mk (State.init stmts) ALocal.init]
              [fun _ => None] [fun _ => None] [fun _ => None] [fun _ => Time.bot] [fun _ => Time.bot]
| sim_trace_step
    e ae tr eu1 eu2 atr aeu1 aeu2 rl r1 r2 wl w1 w2 fl f1 f2 covl cov1 cov2 vextl vext1 vext2
    (STEP: ExecUnit.state_step0 tid e e eu1 eu2)
    (ASTATE_STEP: State.step ae aeu1.(AExecUnit.state) aeu2.(AExecUnit.state))
    (ALOCAL_STEP: ALocal.step ae aeu1.(AExecUnit.local) aeu2.(AExecUnit.local))
    (EVENT: sim_event e ae)
    (STATE: sim_state_weak eu2.(ExecUnit.state) aeu2.(AExecUnit.state))
    (W: w2 = match e with
             | Event.write _ _ vloc _ (ValA.mk _ 0 _)
             | Event.rmw _ _ vloc _ _ =>
               (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                          then Some (vloc.(ValA.val),
                                     (eu2.(ExecUnit.local).(Local.coh) vloc.(ValA.val)).(View.ts))
                         else w1 eid)
             | _ => w1
             end)
    (R: r2 = match e with
               | Event.read _ _ _ vloc _ =>
                 (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                            then Some (vloc.(ValA.val),
                                       (eu2.(ExecUnit.local).(Local.coh) vloc.(ValA.val)).(View.ts))
                            else r1 eid)
               | Event.rmw _ _ vloc _ _ =>
                 (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                            then Some (vloc.(ValA.val),
                                       Memory.latest_ts
                                         vloc.(ValA.val)
                                         (pred ((eu2.(ExecUnit.local).(Local.coh) vloc.(ValA.val)).(View.ts)))
                                         mem)
                            else r1 eid)
               | _ => r1
               end)
    (F: f2 = match e with
               | Event.flush vloc =>
                 (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                            then Some (vloc.(ValA.val),
                                       (eu2.(ExecUnit.local).(Local.vpc) vloc.(ValA.val)).(View.ts))
                            else f1 eid)
               | Event.flushopt vloc =>
                 (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                            then Some (vloc.(ValA.val),
                                       (eu2.(ExecUnit.local).(Local.vpa) vloc.(ValA.val)).(View.ts))
                            else f1 eid)
               | _ => f1
               end)
    (COV: cov2 = match e with
                 | Event.read _ _ _ vloc _
                 | Event.write _ _ vloc _ (ValA.mk _ 0 _)
                 | Event.rmw _ _ vloc _ _ =>
                   (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                              then (eu2.(ExecUnit.local).(Local.coh) vloc.(ValA.val)).(View.ts)
                              else cov1 eid)
                 | Event.flush vloc =>
                   (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                               then (eu2.(ExecUnit.local).(Local.vpc) vloc.(ValA.val)).(View.ts)
                               else cov1 eid)
                 | Event.flushopt vloc =>
                   (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                               then (eu2.(ExecUnit.local).(Local.vpa) vloc.(ValA.val)).(View.ts)
                               else cov1 eid)
                 | _ => cov1
                 end)
    (VEXT: vext2 = match e with
                   | Event.read _ _ _ vloc _ =>
                     (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                                then (eu2.(ExecUnit.local).(Local.vrn).(View.ts))
                                else vext1 eid)
                   | Event.write _ _ vloc _ (ValA.mk _ 0 _)
                   | Event.rmw _ _ vloc _ _ =>
                     (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                                then (eu2.(ExecUnit.local).(Local.coh) vloc.(ValA.val)).(View.ts)
                                else vext1 eid)
                   | Event.flush vloc =>
                     (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                                 then (eu2.(ExecUnit.local).(Local.vpc) vloc.(ValA.val)).(View.ts)
                                 else vext1 eid)
                   | Event.flushopt vloc =>
                     (fun eid => if Nat.eqb eid (ALocal.next_eid aeu1.(AExecUnit.local))
                                 then (eu2.(ExecUnit.local).(Local.vpa) vloc.(ValA.val)).(View.ts)
                                 else vext1 eid)
                   | _ => vext1
                   end)
    (TRACE: sim_trace p mem tid (eu1::tr) (aeu1::atr) (w1::wl) (r1::rl) (f1::fl) (cov1::covl) (vext1::vextl)):
    sim_trace p mem tid (eu2::eu1::tr) (aeu2::aeu1::atr) (w2::w1::wl) (r2::r1::rl) (f2::f1::fl) (cov2::cov1::covl) (vext2::vext1::vextl)
.

Definition sim_traces
           (p: program) (mem: Memory.t)
           (trs: IdMap.t (list (ExecUnit.t)))
           (atrs: IdMap.t (list AExecUnit.t))
           (ws: IdMap.t (list (nat -> option (Loc.t * Time.t))))
           (rs: IdMap.t (list (nat -> option (Loc.t * Time.t))))
           (fs: IdMap.t (list (nat -> option (Loc.t * Time.t))))
           (covs: IdMap.t (list (nat -> Time.t)))
           (vexts: IdMap.t (list (nat -> Time.t)))
  : Prop :=
  IdMap.Forall7 (sim_trace p mem) trs atrs ws rs fs covs vexts.

Lemma sim_trace_last
      p mem tid tr atr wl rl fl covl vextl
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl):
  exists eu tr' aeu atr' w wl' r rl' f fl' cov covl' vext vextl',
    <<HDTR: tr = eu :: tr'>> /\
    <<HDATR: atr = aeu :: atr'>> /\
    <<HDWL: wl = w :: wl'>> /\
    <<HDRL: rl = r :: rl'>> /\
    <<HDFL: fl = f :: fl'>> /\
    <<HDCOVL: covl = cov :: covl'>> /\
    <<HDVEXTL: vextl = vext :: vextl'>>.
Proof.
  inv SIM; esplits; eauto.
Qed.

Lemma sim_trace_length
      p mem tid tr atr wl rl fl covl vextl
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl):
  <<LENGTH_ATR: List.length atr = List.length tr>> /\
  <<LENGTH_WL: List.length wl = List.length tr>> /\
  <<LENGTH_RL: List.length rl = List.length tr>> /\
  <<LENGTH_FL: List.length fl = List.length tr>> /\
  <<LENGTH_COVL: List.length covl = List.length tr>> /\
  <<LENGTH_VEXTL: List.length vextl = List.length tr>>.
Proof.
  induction SIM; ss. des. splits; congr.
Qed.

Lemma sim_trace_memory
      p mem tid tr atr wl rl fl covl vextl
      eu tr'
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl)
      (EU: tr = eu :: tr'):
  mem = eu.(ExecUnit.mem).
Proof.
  revert eu tr' EU.
  induction SIM.
  - ii. inv EU. ss.
  - ii. inv EU. exploit IHSIM; try refl. i.
    inv STEP. ss.
Qed.

Lemma sim_traces_memory
      p trs atrs ws rs fs covs vexts
      m
      ts loc val tid
      (STEP: Machine.pf_exec p m)
      (SIM: sim_traces p m.(Machine.mem) trs atrs ws rs fs covs vexts)
      (TR: IdMap.Forall2
             (fun tid tr sl => exists l, tr = (ExecUnit.mk (fst sl) (snd sl) m.(Machine.mem)) :: l)
             trs m.(Machine.tpool))
      (GET: Memory.get_msg ts m.(Machine.mem) = Some (Msg.mk loc val tid)):
  exists eu, IdMap.find tid trs = Some eu.
Proof.
  generalize (SIM tid). intro X. inv X; eauto.
  generalize (TR tid). rewrite <- H0. intro X. inv X.
  inv STEP. hexploit state_exec_rtc_state_step; [by eauto|]. i. des.
  exploit Machine.step_get_msg_tpool.
  - etrans.
    + eapply Machine.rtc_step_mon; [|by eauto]. right. ss.
    + eapply Machine.rtc_step_mon; [|by eauto]. left. ss.
  - inv EQUIV. rewrite <- MEM. eauto.
  - s. i. des. inv EQUIV. generalize (TPOOL tid). congr.
Qed.

Ltac simplify :=
  repeat
    (try match goal with
         | [H1: _ = IdMap.find ?id ?m, H2: _ = IdMap.find ?id ?m |- _] =>
           rewrite <- H1 in H2; inv H2
         | [H1: IdMap.find ?id ?m = _, H2: IdMap.find ?id ?m = _ |- _] =>
           rewrite H1 in H2; inv H2
         | [H1: IdMap.find ?id ?m = _, H2: _ = IdMap.find ?id ?m |- _] =>
           rewrite H1 in H2; inv H2
         | [H: Some _ = Some _ |- _] => inv H
         | [H: _::_ = _::_ |- _] => inv H
         end).

Lemma promising_pf_sim_step
      tid e (eu1 eu2:ExecUnit.t) aeu1
      (STATE1: sim_state_weak eu1.(ExecUnit.state) aeu1.(AExecUnit.state))
      (STEP: ExecUnit.state_step0 tid e e eu1 eu2):
  exists ae aeu2,
    <<ASTATE_STEP: State.step ae aeu1.(AExecUnit.state) aeu2.(AExecUnit.state)>> /\
    <<ALOCAL_STEP: ALocal.step ae aeu1.(AExecUnit.local) aeu2.(AExecUnit.local)>> /\
    <<EVENT: sim_event e ae>> /\
    <<STATE2: sim_state_weak eu2.(ExecUnit.state) aeu2.(AExecUnit.state)>>.
Proof.
  destruct eu1 as [st1 lc1 mem1].
  destruct eu2 as [st2 lc2 mem2].
  destruct aeu1 as [[astmt1 armap1] alc1].
  inv STATE1. inv STEP. ss. subst. inv STATE; inv LOCAL; inv EVENT; ss.
  - eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 1.
    + econs; ss.
    + ss.
    + ss.
  - eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 2. ss.
    + econs; ss.
    + econs; ss.
    + econs; ss. eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 3; ss.
    + econs 2; ss.
    + econs; ss. eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
    + econs; ss. eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 4; ss.
    + econs 3; ss.
    + econs; ss.
      * eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
      * eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
    + econs; ss. eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 5; ss. eapply sim_rmap_weak_sem_rmw; eauto.
    + econs 4; ss.
    + econs; ss.
      eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
    + econs; ss.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 6; ss. inv RMW. econs; eauto.
    + econs 2; ss.
    + econs; ss.
      eauto using sim_rmap_weak_add, sim_rmap_weak_expr.
    + econs; ss.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 7; ss.
    + econs 5; ss.
    + econs; ss.
    + econs; ss.
  - inv STEP.
    eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 7; ss.
    + econs 6; ss.
    + econs; ss.
    + econs; ss.
  - eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 9. ss.
    + econs; ss.
    + ss.
    + ss.
  - eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 10. ss.
    + econs 8; ss.
    + econs. eauto using sim_rmap_weak_expr.
    + ss.
  - eexists _, (AExecUnit.mk (State.mk _ _) _). splits; ss.
    + econs 11. ss.
    + econs 7; ss.
    + econs. eauto using sim_rmap_weak_expr.
    + ss.
Qed.

Lemma promising_pf_sim_traces
      p m
      (STEP: Machine.pf_exec p m):
  exists trs atrs ws rs fs covs vexts ex (PRE: Valid.pre_ex p ex),
    <<SIM: sim_traces p m.(Machine.mem) trs atrs ws rs fs covs vexts>> /\
    <<TR: IdMap.Forall2
            (fun tid tr sl => exists l, tr = (ExecUnit.mk (fst sl) (snd sl) m.(Machine.mem)) :: l)
            trs m.(Machine.tpool)>> /\
    <<ATR: IdMap.Forall2
             (fun tid atr aeu => exists l, atr = aeu :: l)
             atrs PRE.(Valid.aeus)>>.
Proof.
  inv STEP. exploit state_exec_rtc_state_step; eauto. i. des.
  eapply Machine.equiv_no_promise in NOPROMISE; eauto. revert NOPROMISE.
  cut (exists trs atrs ws rs fs covs vexts ex (PRE: Valid.pre_ex p ex),
    <<SIM: sim_traces p (Machine.mem m2') trs atrs ws rs fs covs vexts>> /\
    <<TR: forall tid, opt_rel
            (fun tr sl => exists l, tr = (ExecUnit.mk (fst sl) (snd sl) (Machine.mem m2')) :: l)
            (IdMap.find tid trs)
            (IdMap.find tid (Machine.tpool m2'))>> /\
    <<ATR: IdMap.Forall2
             (fun tid atr aeu => exists l, atr = aeu :: l)
             atrs PRE.(Valid.aeus)>>).
  { inv EQUIV. rewrite MEM. i. des. esplits; eauto. ii. rewrite TPOOL. ss. }
  clear m STEP2 EQUIV.
  apply clos_rt_rt1n_iff, clos_rt_rtn1_iff in EXEC. induction EXEC.
  { eexists (IdMap.map (fun x => [x]) (IdMap.mapi (fun _ _ => _) p)).
    eexists (IdMap.map (fun x => [x]) (IdMap.mapi (fun _ _ => _) p)).
    eexists (IdMap.mapi (fun _ _ => [fun _ => None]) p).
    eexists (IdMap.mapi (fun _ _ => [fun _ => None]) p).
    eexists (IdMap.mapi (fun _ _ => [fun _ => None]) p).
    eexists (IdMap.mapi (fun _ _ => [bot]) p).
    eexists (IdMap.mapi (fun _ _ => [bot]) p).
    eexists (Execution.mk (IdMap.mapi (fun _ _ => _) p) bot bot bot).
    eexists (@Valid.mk_pre_ex _ _ (IdMap.mapi (fun tid stmts => AExecUnit.mk (State.init stmts) ALocal.init) p)  _ _).
    hexploit Machine.rtc_promise_step_spec; eauto. s. intro X.
    s. splits; cycle 1.
    - i. specialize (X tid). rewrite ? IdMap.map_spec, ? IdMap.mapi_spec in *.
      rewrite X. destruct (IdMap.find tid p); ss. econs. eauto.
    - ii. rewrite ? IdMap.map_spec, ? IdMap.mapi_spec. destruct (IdMap.find id p); ss. eauto.
    - ii. rewrite ? IdMap.map_spec, ? IdMap.mapi_spec. destruct (IdMap.find id p) eqn:STMTS; ss. econs.
      econs 1; ss. rewrite IdMap.mapi_spec, STMTS. s. ss.
  }
  des.
  destruct y as [tpool1 mem1].
  destruct z as [tpool2 mem2].
  ss. inv H. ss. subst. inv STEP. inv STEP0. ss. subst.
  generalize (TR tid). rewrite FIND. intro Y. inv Y. des. subst. rename H0 into TRS. symmetry in TRS.
  generalize (SIM tid). intro Y. inv Y; [congr|]. rewrite TRS in H0. inv H0.
  hexploit sim_trace_last; eauto. i. des. subst. simplify.
  exploit promising_pf_sim_step; eauto.
  { inv REL7; eauto. s.
    unfold Machine.init_with_promises in FIND0. ss.
    rewrite IdMap.mapi_spec, STMT in *. inv FIND0.
    apply sim_state_weak_init.
  }
  { instantiate (1 := ExecUnit.mk _ _ _). econs; ss; eauto. }
  i. des.

  eexists (IdMap.add tid _ trs).
  eexists (IdMap.add tid _ atrs).
  eexists (IdMap.add tid _ ws).
  eexists (IdMap.add tid _ rs).
  eexists (IdMap.add tid _ fs).
  eexists (IdMap.add tid _ covs).
  eexists (IdMap.add tid _ vexts).
  eexists (Execution.mk _ _ _ _).
  eexists (@Valid.mk_pre_ex _ _ (IdMap.add tid _ PRE.(Valid.aeus)) _ _).
  s. splits; cycle 1.
  - i. rewrite ? IdMap.add_spec. condtac; eauto.
  - ii. rewrite ? IdMap.add_spec. condtac; eauto.
  - s. ii. rewrite ? IdMap.add_spec. condtac; eauto. inversion e0. subst. clear e0 X. econs.
    econs 2; eauto. econs; eauto.
Grab Existential Variables.
all: ss.
1: { ii. generalize (PRE.(Valid.AEUS) id). intro X.
     rewrite IdMap.add_spec. condtac; ss. inversion e0. subst. clear e0 X0.
     generalize (ATR tid). rewrite <- H. intro Y. inv Y. des. inv REL.
     rewrite <- H7 in X. inv X. econs. etrans; eauto with tso.
}
5: { ii. rewrite IdMap.mapi_spec. destruct (IdMap.find id p); ss. econs. refl. }
4: { unfold IdMap.map. rewrite IdMap.mapi_mapi. f_equal. }
1: { apply bot. (* it's ex's co. *) }
1: { apply bot. (* it's ex's rf. *) }
1: { apply bot. (* it's ex's pf. *) }
Qed.

Inductive sim_th
          (p:program) (mem:Memory.t) (tid:Id.t)
          (eu:ExecUnit.t)
          (aeu:AExecUnit.t)
          (w: nat -> option (Loc.t * Time.t))
          (r: nat -> option (Loc.t * Time.t))
          (f: nat -> option (Loc.t * Time.t))
          (cov: nat -> Time.t)
          (vext: nat -> Time.t): Prop := mk {
  WPROP1:
    forall ts loc val
      (GET: Memory.get_msg ts mem = Some (Msg.mk loc val tid)),
      ((Promises.lookup ts eu.(ExecUnit.local).(Local.promises) = true /\
        forall eid, w eid <> Some (loc, ts)) \/
       (Promises.lookup ts eu.(ExecUnit.local).(Local.promises) = false /\
        exists eid l,
          w eid = Some (loc, ts) /\
          List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
          Label.is_kinda_writing_val loc val l));
  WPROP2:
    forall eid loc val l
      (GET: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
            Label.is_kinda_writing_val loc val l),
    exists ts,
      w eid = Some (loc, ts) /\
      Memory.get_msg ts mem = Some (Msg.mk loc val tid);
  WPROP2':
    forall eid loc l
      (GET: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
            Label.is_kinda_writing loc l),
    exists ts val,
      w eid = Some (loc, ts) /\
      Memory.get_msg ts mem = Some (Msg.mk loc val tid);
  WPROP3:
    forall eid loc ts (GET: w eid = Some (loc, ts)),
      Time.lt Time.bot ts /\
      cov eid = ts /\
      vext eid = ts /\
      ts <= (eu.(ExecUnit.local).(Local.coh) loc).(View.ts) /\
      exists val l,
        List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
        Label.is_kinda_writing_val loc val l /\
        Memory.get_msg ts mem = Some (Msg.mk loc val tid);
  WPROP4:
    forall eid1 loc1 eid2 loc2 ts (W1: w eid1 = Some (loc1, ts)) (W2: w eid2 = Some (loc2, ts)),
      eid1 = eid2;
  RPROP1:
    forall eid loc val l
      (GET: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
            Label.is_kinda_reading_val loc val l),
    exists ts tid',
      r eid = Some (loc, ts) /\
      <<READ_TS_SPEC:
          __guard__ ((ts = Time.bot /\ val = Val.default) \/
          Memory.get_msg ts mem = Some (Msg.mk loc val tid')) >>;
  RPROP2:
    forall eid loc ts (GET: r eid = Some (loc, ts)),
    (cov eid = ts /\
    ts <= (eu.(ExecUnit.local).(Local.coh) loc).(View.ts) /\
    exists l val tid',
      List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
      Label.is_reading_val loc val l /\
      <<READ_TS_SPEC:
          __guard__ ((ts = Time.bot /\ val = Val.default) \/
          Memory.get_msg ts mem = Some (Msg.mk loc val tid'))>>) \/
    (cov eid > ts /\
    ts <= (eu.(ExecUnit.local).(Local.coh) loc).(View.ts) /\
    exists l vold tid',
      List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
      Label.is_kinda_reading_val loc vold l /\
      Label.is_kinda_write l /\
      <<READ_TS_SPEC:
          __guard__ ((ts = Time.bot /\ vold = Val.default) \/
          Memory.get_msg ts mem = Some (Msg.mk loc vold tid'))>>);
  UPROP:
    forall eid loc old_ts ts
           (R: r eid = Some (loc, old_ts))
           (W: w eid = Some (loc, ts)),
      old_ts < ts /\
      Memory.latest loc old_ts (pred ts) mem;
  FPROP1:
    forall eid loc1 l
           (GET: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
                 Label.is_persisting loc1 l),
    exists perv,
      <<FEID: f eid = Some (loc1, perv)>> /\
      <<CL_REL:
        forall loc2 (CL: Loc.cl loc1 loc2),
          exists ts tid' val,
          ts = Memory.latest_ts loc2 perv mem /\
          <<FLUSH_TS_SPEC:
              __guard__ ((ts = Time.bot /\ val = Val.default) \/
              Memory.get_msg ts mem = Some (Msg.mk loc2 val tid'))>>>>;
  FPROP2:
    forall eid loc1 perv
           (GET: f eid = Some (loc1, perv)),
    <<COV_EQ: cov eid = perv>> /\
    <<VEXT_EQ: vext eid = perv>> /\
    exists l,
      List.nth_error aeu.(AExecUnit.local).(ALocal.labels) eid = Some l /\
      Label.is_persisting loc1 l /\
      <<CL_REL:
          forall loc2 (CL: Loc.cl loc1 loc2),
            exists ts tid' val,
            ts = Memory.latest_ts loc2 perv mem /\
            <<FLUSH_TS_SPEC:
                __guard__ ((ts = Time.bot /\ val = Val.default) \/
                Memory.get_msg ts mem = Some (Msg.mk loc2 val tid'))>>>>;
  COVPROP:
    forall eid (COV: cov eid > 0),
      AExecUnit.label_is aeu.(AExecUnit.local).(ALocal.labels) Label.is_access_persist eid;
  VEXTPROP:
    forall eid (VEXT: vext eid > 0),
      AExecUnit.label_is aeu.(AExecUnit.local).(ALocal.labels) Label.is_access_persist eid;

  PO: forall iid1 iid2 label1 label2
     (PO: iid1 < iid2)
     (LABEL1: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) iid1 = Some label1)
     (LABEL2: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) iid2 = Some label2)
     (REL: Execution.label_loc label1 label2),
      <<PO_LOC_WRITE:
        Label.is_kinda_write label2 ->
        cov iid1 < cov iid2>> /\
      <<PO_LOC_READ:
        Label.is_read label2 ->
        cov iid1 <= cov iid2>>;
  PO_FL: forall iid1 iid2 label1 label2
     (PO: iid1 < iid2)
     (LABEL1: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) iid1 = Some label1)
     (LABEL2: List.nth_error aeu.(AExecUnit.local).(ALocal.labels) iid2 = Some label2)
     (WR: Label.is_write label1)
     (FL: Label.is_flush label2),
    vext iid1 <= vext iid2;
  EU_WF: ExecUnit.wf tid eu;
  AEU_WF: AExecUnit.wf aeu;
  MEM: eu.(ExecUnit.mem) = mem;
}.

Lemma sim_trace_sim_state_weak
      p mem tid
      tr eu tr'
      atr aeu atr'
      wl w wl'
      rl r rl'
      fl f fl'
      covl cov covl'
      vextl vext vextl'
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl)
      (EU: tr = eu :: tr')
      (AEU: atr = aeu :: atr')
      (WL: wl = w :: wl')
      (RL: rl = r :: rl')
      (FL: fl = f :: fl')
      (COV: covl = cov :: covl')
      (VEXT: vextl = vext :: vextl'):
  sim_state_weak eu.(ExecUnit.state) aeu.(AExecUnit.state).
Proof.
  subst. inv SIM; ss.
  rewrite IdMap.mapi_spec, STMT in FIND. inv FIND.
  eapply sim_state_weak_init.
Qed.

Lemma sim_trace_lastn
      p mem tid tr atr wl rl fl covl vextl
      n
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl):
  sim_trace p mem tid
            (lastn (S n) tr) (lastn (S n) atr) (lastn (S n) wl) (lastn (S n) rl)
            (lastn (S n) fl) (lastn (S n) covl) (lastn (S n) vextl).
Proof.
  revert n atr wl rl fl covl vextl SIM. induction tr; i; [by inv SIM|].
  exploit sim_trace_length; eauto. s. i. des.
  destruct (le_lt_dec (length tr) n).
  { rewrite ? lastn_all in *; ss; try lia. }
  exploit sim_trace_last; eauto. i. des. simplify. ss.
  rewrite ? lastn_cons; try lia. eapply IHtr.
  inv SIM; ss. lia.
Qed.

Lemma sim_trace_lastn_rtc_step
      p mem tid tr atr wl rl fl covl vextl
      n k
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl)
      (SIM_N: sim_trace p mem tid
              (lastn (S n) tr) (lastn (S n) atr) (lastn (S n) wl) (lastn (S n) rl)
              (lastn (S n) fl) (lastn (S n) covl) (lastn (S n) vextl))
      (SIM_NK: sim_trace p mem tid
               (lastn ((S n) + k) tr) (lastn ((S n) + k) atr) (lastn ((S n) + k) wl) (lastn ((S n) + k) rl)
               (lastn ((S n) + k) fl) (lastn ((S n) + k) covl) (lastn ((S n) + k) vextl)):
  forall eu1 eu2 l l'
         (TR: lastn (S n) tr = eu1 :: l)
         (TR2: lastn ((S n) + k) tr = eu2 :: l'),
  rtc (ExecUnit.state_step tid) eu1 eu2.
Proof.
  induction k; ss.
  - ii. rewrite plus_comm in TR2. ss.
    rewrite TR in TR2. inv TR2. auto.
  - ii. rewrite <- plus_Sn_m in *. rewrite <- plus_n_Sm in *. ss.
    exploit sim_trace_length; try exact SIM; eauto. intro X. des.
    destruct (le_lt_dec (length tr) (S (n + k))).
    + assert (EQ_S:
                lastn (S (S (n + k))) tr = lastn (S (n + k)) tr /\
                lastn (S (S (n + k))) atr = lastn (S (n + k)) atr /\
                lastn (S (S (n + k))) wl = lastn (S (n + k)) wl /\
                lastn (S (S (n + k))) rl = lastn (S (n + k)) rl /\
                lastn (S (S (n + k))) fl = lastn (S (n + k)) fl /\
                lastn (S (S (n + k))) covl = lastn (S (n + k)) covl /\
                lastn (S (S (n + k))) vextl = lastn (S (n + k)) vextl).
      { repeat rewrite lastn_all; ss; try lia. splits; ss. }
      des. rewrite EQ_S, EQ_S0, EQ_S1, EQ_S2, EQ_S3, EQ_S4, EQ_S5 in SIM_NK.
      eapply IHk; eauto. rewrite <- EQ_S. eauto.
    + inversion SIM_NK.
      * exploit lastn_length_incr; eauto. intro LT_NK.
        rewrite <- Nat.add_1_r in H0. rewrite <- H0 in LT_NK. ss.
        assert (1 <= length (lastn (S n) tr)).
        { rewrite TR. ss. lia. }
        destruct k.
        { rewrite plus_comm in LT_NK. ss. lia. }
        exploit lastn_length_incr.
        { instantiate (1 := tr). instantiate (1 := S n). lia. }
        rewrite plus_Sn_m. rewrite LT_NK. lia.
      * clear W R COV VEXT.
        rewrite <- H0 in TR2. inversion TR2. rewrite H7 in *. clear H7 H8.
        symmetry in H0. eapply lastn_S1 in H0; ss. rewrite <- H0 in TRACE.
        symmetry in H. eapply lastn_S1 in H; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H in TRACE.
        symmetry in H2. eapply lastn_S1 in H2; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H2 in TRACE.
        symmetry in H3. eapply lastn_S1 in H3; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H3 in TRACE.
        symmetry in H4. eapply lastn_S1 in H4; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H4 in TRACE.
        symmetry in H5. eapply lastn_S1 in H5; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H5 in TRACE.
        symmetry in H6. eapply lastn_S1 in H6; [| eapply lt_le_trans]; eauto; try lia. rewrite <- H6 in TRACE.
        etrans; cycle 1.
        { econs 2; eauto. econs; eauto. }
        eapply IHk; eauto.
Qed.

Lemma sim_trace_rtc_step
      p mem tid tr atr wl rl fl covl vextl
      n
      (SIM: sim_trace p mem tid tr atr wl rl fl covl vextl):
  forall eu_to l eu_from l'
      (TR: tr = eu_to :: l)
      (TR_N: lastn (S n) tr = eu_from :: l'),
  rtc (ExecUnit.state_step tid) eu_from eu_to.
Proof.
  exploit sim_trace_length; eauto. i. des.
  exploit sim_trace_lastn; eauto. instantiate (1 := n). intro SIM_N.
  destruct (le_lt_dec (length tr) (S n)).
  { exploit sim_trace_length; try exact SIM; eauto. intro X. des.
    rewrite ? lastn_all in *; try lia. ii. rewrite TR in TR_N. inv TR_N. eauto. }
  assert (exists k, S n + k = length tr).
  { exists (((length tr) - (S n))). lia. }
  des.
  exploit lastn_all.
  { instantiate (1 := tr). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := atr). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := wl). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := rl). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := fl). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := covl). instantiate (1 := S n + k). lia. }
  exploit lastn_all.
  { instantiate (1 := vextl). instantiate (1 := S n + k). lia. }
  i.
  generalize SIM. intro SIM_NK.
  rewrite <- x0 in SIM_NK.
  rewrite <- x1 in SIM_NK.
  rewrite <- x2 in SIM_NK.
  rewrite <- x3 in SIM_NK.
  rewrite <- x4 in SIM_NK.
  rewrite <- x5 in SIM_NK.
  rewrite <- x6 in SIM_NK.
  rewrite <- x6 in TR.
  eapply sim_trace_lastn_rtc_step.
  3: exact SIM_NK.
  all: eauto.
Qed.

Lemma sim_trace_sim_th
      p m tid
      trs tr eu tr' trt
      atrs atr aeu atr'
      ws wl w wl'
      rs rl r rl'
      fs fl f fl'
      covs covl cov covl'
      vexts vextl vext vextl'
      (PF: Machine.pf_exec p m)
      (SIM: sim_trace p m.(Machine.mem) tid tr atr wl rl fl covl vextl)
      (SIMS: sim_traces p m.(Machine.mem) trs atrs ws rs fs covs vexts)
      (TR: IdMap.Forall2
           (fun _ tr sl => exists l, tr = (ExecUnit.mk (fst sl) (snd sl) m.(Machine.mem)) :: l)
           trs m.(Machine.tpool))
      (TRS: Some trt = IdMap.find tid trs)
      (EU: tr = eu :: tr')
      (AEU: atr = aeu :: atr')
      (WL: wl = w :: wl')
      (RL: rl = r :: rl')
      (FL: fl = f :: fl')
      (COV: covl = cov :: covl')
      (VEXT: vextl = vext :: vextl'):
  forall trt' (TRT: trt = trt' ++ tr),
    sim_th p m.(Machine.mem) tid eu aeu w r f cov vext.
Proof.
  revert f fl' r rl' r rl' w wl' eu tr' aeu atr' cov covl' vext vextl' FL RL WL EU AEU COV VEXT. induction SIM.
  { i. simplify. ss. econs; ss.
    - rewrite IdMap.mapi_spec, STMT in FIND. inv FIND. s. i.
      left. splits; ss. destruct ts; ss.
      eapply Promises.promises_from_mem_lookup. eauto.
    - i. des. destruct eid; ss.
    - i. des. destruct eid; ss.
    - i. des. destruct eid; ss.
    - i. des. destruct eid; ss.
    - unfold Time.bot. i. lia.
    - unfold Time.bot. i. lia.
    - i. destruct iid1; ss.
    - rewrite IdMap.mapi_spec, STMT in FIND. inv FIND.
      econs; ss.
      econs; ss; i; try by apply bot_spec.
      + econs; esplits; ss.
      + destruct ts; ss.
        rewrite Promises.promises_from_mem_spec in IN. des.
        apply lt_le_S. rewrite <- List.nth_error_Some. ii. congr.
      + destruct ts; ss.
        unfold Memory.get_msg in *. ss. destruct msg.
        exploit Promises.promises_from_mem_lookup; eauto. ss. subst. ss.
      + econs; viewtac; try by i; apply bot_spec.
        econs; ss. instantiate (1 := Loc.default). econs; ss.
      + rewrite TS. ss.
      + left. apply bot_spec.
  }
  i. simplify.
  destruct eu1 as [st1 lc1 mem1] eqn: EU1. guardH EU1.
  destruct eu as [st2 lc2 mem2] eqn: EU. guardH EU.
  destruct aeu1 as [ast1 alc1].
  destruct aeu as [ast2 alc2].
  assert (mem1 = m.(Machine.mem)); subst.
  { exploit sim_trace_memory; eauto. }
  ss. exploit IHSIM; eauto.
  { instantiate (1 := trt' ++ [eu]). rewrite <- List.app_assoc. rewrite EU. ss. }
  i. rename x into IH.
  assert (EU_WF2: ExecUnit.wf tid (ExecUnit.mk st2 lc2 mem2)).
  { destruct IH.
    eapply ExecUnit.state_step_wf; eauto. econs; eauto. }
  assert (AEU_WF2: AExecUnit.wf (AExecUnit.mk ast2 alc2)).
  { destruct IH.
    eapply AExecUnit.step_future; eauto with tso. }
  inv STEP. inv ALOCAL_STEP; inv EVENT; ss; eauto.
  { (* internal *)
    inv LOCAL; ss. inv EVENT. econs; ss; try by apply IH.
  }
  { (* read *)
    inv LOCAL; ss.
    { (* pure read *)
      generalize IH.(EU_WF). i. inv H.
      specialize (Local.read_spec LOCAL STEP). intro READ_SPEC. guardH READ_SPEC.
      inv STEP. inv STATE0; inv EVENT; ss.
      exploit sim_trace_sim_state_weak; eauto. s. intro Y. inv Y. ss. inv STMTS.
      exploit sim_rmap_weak_expr; eauto. intro Y. inv Y.
      inv ASTATE_STEP.
      all: econs; ss.
      clear EU_WF2 AEU_WF2.
      - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
        eapply nth_error_app_mon. eauto.
      - i. exploit IH.(WPROP2); eauto. des.
        apply nth_error_snoc_inv in GET. des; eauto. split; ss. destruct l; ss.
      - i. exploit IH.(WPROP2'); eauto. des.
        apply nth_error_snoc_inv in GET. des; eauto. split; ss. destruct l; ss.
      - i. exploit IH.(WPROP3); eauto. s. i. des. des_ifs.
        { exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        }
        esplits; eauto.
        + rewrite fun_add_spec. des_ifs; eauto. inv e.
          ss. etrans; eauto.
        + eapply nth_error_app_mon. eauto.
      - eapply IH.(WPROP4).
      - i. des. apply nth_error_snoc_inv in GET. des.
        + exploit IH.(RPROP1); eauto. i. des. esplits; eauto.
          des_ifs. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *. lia.
        + des_ifs; cycle 1.
          { apply Nat.eqb_neq in Heq. unfold ALocal.next_eid in *. congr. }
          ss. eqvtac. rewrite fun_add_spec in *. condtac; [|congr].
          inv VLOC. inv VAL. ss. subst. rewrite VAL1 in *.
          move READ_SPEC at bottom. desH READ_SPEC.
          exploit Memory.read_get_msg; eauto. i. des; esplits; eauto.
      - i. des_ifs.
        + left. apply Nat.eqb_eq in Heq. subst.
          rewrite fun_add_spec in *. des_ifs; [|congr].
          inv VLOC. inv VAL. ss. subst. rewrite VAL1 in *.
          move READ_SPEC at bottom. desH READ_SPEC.
          exploit Memory.read_get_msg; eauto. i. des; esplits; ss; eauto with tso.
          all: try by rewrite List.nth_error_app2, Nat.sub_diag; [|refl]; ss; eauto with tso.
        + exploit IH.(RPROP2); eauto. s. i. des; [left|right]; esplits; eauto with tso.
          all: try by eapply nth_error_app_mon; eauto.
          * rewrite fun_add_spec. des_ifs; eauto.
            inv e. etrans; eauto.
          * rewrite fun_add_spec. des_ifs; eauto.
            inv e. etrans; eauto.
      - i. eapply IH.(UPROP); eauto. des_ifs.
        exploit IH.(WPROP3); eauto. i. des.
        exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *. ss.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
      - i. exploit IH.(FPROP2); eauto. s. i. des. des_ifs; cycle 1.
        { esplits; eauto. eapply nth_error_app_mon in x0. eauto. }
        exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      - unfold ALocal.next_eid in *. s. i. des_ifs.
        { apply Nat.eqb_eq in Heq. subst. econs; eauto.
          - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
          - econs; ss.
        }
        apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
      - unfold ALocal.next_eid in *. s. i. des_ifs.
        { apply Nat.eqb_eq in Heq. subst. econs; eauto.
          - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
          - econs; ss.
        }
        apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
      - i. unfold ALocal.next_eid in *.
        apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
        + repeat condtac.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
          eapply IH.(PO); eauto.
        + lia.
        + unfold le in *.
          subst. repeat condtac; ss.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_neq in X0; ss; try lia.
          splits; ss. rewrite fun_add_spec. des_ifs; [|congr].
          inv REL. destruct label1; ss; eqvtac.
          * exploit IH.(RPROP1); eauto with tso. i. des.
            exploit IH.(RPROP2); eauto. s. i.
            exploit sim_rmap_weak_expr; eauto. i. inv x2. rewrite VAL1 in *.
            des; cycle 1.
            { rewrite LABEL3 in x3. destruct l; ss. }
            subst. desH READ_TS_SPEC.
            { rewrite READ_TS_SPEC. apply bot_spec. }
            lia.
          * exploit IH.(WPROP2); eauto with tso. i. des.
            exploit IH.(WPROP3); eauto. s. i. des. subst.
            exploit sim_rmap_weak_expr; eauto. i. inv x3. rewrite VAL1 in *.
            lia.
          * exploit IH.(WPROP2); eauto with tso. i. des.
            exploit IH.(WPROP3); eauto. s. i. des. subst.
            exploit sim_rmap_weak_expr; eauto. i. inv x3. rewrite VAL1 in *.
            lia.
        + subst. repeat condtac; ss.
          all: try apply Nat.eqb_eq in X; ss; try lia.
      - i. i. unfold ALocal.next_eid in *.
        apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
        + repeat condtac.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
          eapply IH.(PO_FL); eauto.
        + lia.
        + subst. ss.
        + subst. ss.
    }
    { (* rmw_fail *)
      generalize IH.(EU_WF). i. inv H.
      specialize (Local.rmw_failure_spec LOCAL STEP). intro RMW_FAILURE_SPEC. guardH RMW_FAILURE_SPEC.
      inv STEP. inv STATE0; inv EVENT; ss.
      exploit sim_trace_sim_state_weak; eauto. s. intro Y. inv Y. ss. inv STMTS.
      exploit sim_rmap_weak_expr; eauto. intro Y. inv Y.
      inv ASTATE_STEP.
      all: econs; ss.
      clear EU_WF2 AEU_WF2.
      - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
        eapply nth_error_app_mon. eauto.
      - i. exploit IH.(WPROP2); eauto. des.
        apply nth_error_snoc_inv in GET. des; eauto. split; ss. destruct l; ss.
      - i. exploit IH.(WPROP2'); eauto. des.
        apply nth_error_snoc_inv in GET. des; eauto. split; ss. destruct l; ss.
      - i. exploit IH.(WPROP3); eauto. s. i. des. des_ifs.
        { exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        }
        esplits; eauto.
        + rewrite fun_add_spec. des_ifs; eauto. inv e.
          ss. etrans; eauto.
        + eapply nth_error_app_mon. eauto.
      - eapply IH.(WPROP4).
      - i. des. apply nth_error_snoc_inv in GET. des.
        + exploit IH.(RPROP1); eauto. i. des. esplits; eauto.
          des_ifs. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *. lia.
        + des_ifs; cycle 1.
          { apply Nat.eqb_neq in Heq. unfold ALocal.next_eid in *. congr. }
          ss. eqvtac. rewrite fun_add_spec in *. condtac; [|congr].
          inv VLOC. inv VAL. ss. subst. rewrite VAL1 in *.
          move RMW_FAILURE_SPEC at bottom. desH RMW_FAILURE_SPEC.
          exploit Memory.read_get_msg; eauto. i. des; esplits; eauto.
      - i. des_ifs.
        + left. apply Nat.eqb_eq in Heq. subst.
          rewrite fun_add_spec in *. des_ifs; [|congr].
          inv VLOC. inv VAL. ss. subst. rewrite VAL1 in *.
          move RMW_FAILURE_SPEC at bottom. desH RMW_FAILURE_SPEC.
          exploit Memory.read_get_msg; eauto. i. des; esplits; ss; eauto with tso.
          all: try by rewrite List.nth_error_app2, Nat.sub_diag; [|refl]; ss; eauto with tso.
        + exploit IH.(RPROP2); eauto. s. i. des; [left|right]; esplits; eauto with tso.
          all: try by eapply nth_error_app_mon; eauto.
          * rewrite fun_add_spec. des_ifs; eauto.
            inv e. etrans; eauto.
          * rewrite fun_add_spec. des_ifs; eauto.
            inv e. etrans; eauto.
      - i. eapply IH.(UPROP); eauto. des_ifs.
        exploit IH.(WPROP3); eauto. i. des.
        exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *. ss.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
      - i. exploit IH.(FPROP2); eauto. s. i. des. des_ifs; cycle 1.
        { esplits; eauto. eapply nth_error_app_mon in x0. eauto. }
        exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      - unfold ALocal.next_eid in *. s. i. des_ifs.
        { apply Nat.eqb_eq in Heq. subst. econs; eauto.
          - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
          - econs; ss.
        }
        apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
      - unfold ALocal.next_eid in *. s. i. des_ifs.
        { apply Nat.eqb_eq in Heq. subst. econs; eauto.
          - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
          - econs; ss.
        }
        apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
      - i. unfold ALocal.next_eid in *.
        apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
        + repeat condtac.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
          eapply IH.(PO); eauto.
        + lia.
        + unfold le in *.
          subst. repeat condtac; ss.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_neq in X0; ss; try lia.
          splits; ss. rewrite fun_add_spec. des_ifs; [|congr].
          inv REL. destruct label1; ss; eqvtac.
          * exploit IH.(RPROP1); eauto with tso. i. des.
            exploit IH.(RPROP2); eauto. s. i.
            exploit sim_rmap_weak_expr; eauto. i. inv x2. rewrite VAL1 in *.
            des; cycle 1.
            { rewrite LABEL3 in x3. destruct l; ss. }
            subst. desH READ_TS_SPEC.
            { rewrite READ_TS_SPEC. apply bot_spec. }
            lia.
          * exploit IH.(WPROP2); eauto with tso. i. des.
            exploit IH.(WPROP3); eauto. s. i. des. subst.
            exploit sim_rmap_weak_expr; eauto. i. inv x3. rewrite VAL1 in *.
            lia.
          * exploit IH.(WPROP2); eauto with tso. i. des.
            exploit IH.(WPROP3); eauto. s. i. des. subst.
            exploit sim_rmap_weak_expr; eauto. i. inv x3. rewrite VAL1 in *.
            lia.
        + subst. repeat condtac; ss.
          all: try apply Nat.eqb_eq in X; ss; try lia.
      - i. unfold ALocal.next_eid in *.
        apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
        + repeat condtac.
          all: try apply Nat.eqb_eq in X; ss; subst; try lia.
          all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
          eapply IH.(PO_FL); eauto.
        + lia.
        + subst. ss.
        + subst. ss.
    }
  }
  { (* write *)
    inv LOCAL; ss; inv EVENT; inv RES; inv STEP; ss. inv STATE. ss.
    destruct IH.(EU_WF).
    econs; ss; clear EU_WF2 AEU_WF2.
    - i. exploit IH.(WPROP1); eauto. s. i. rewrite Promises.unset_o. des_ifs.
      { inv e. right. rewrite MSG in GET. inv GET. esplits; ss.
        - instantiate (1 := ALocal.next_eid alc1). des_ifs; cycle 1.
          { apply Nat.eqb_neq in Heq. congr. }
          rewrite fun_add_spec. des_ifs; ss; try congr.
        - rewrite List.nth_error_app2, Nat.sub_diag; ss.
        - inv VLOC. inv VVAL. rewrite VAL0, VAL1. eauto with tso.
      }
      des; [left|right]; splits; ss.
      + i. des_ifs; eauto. apply Nat.eqb_eq in Heq. subst. ii. inv H.
        rewrite fun_add_spec in *. des_ifs; [|congr]. ss. apply c. ss.
      + esplits; eauto.
        * des_ifs; eauto. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon. eauto.
    - i. des. unfold ALocal.next_eid in *. apply nth_error_snoc_inv in GET. des.
      + des_ifs.
        { apply Nat.eqb_eq in Heq. subst. lia. }
        eapply IH.(WPROP2); eauto.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. lia. }
        ss. eqvtac. esplits; eauto.
        * inv VLOC. rewrite VAL. eauto.
        * rewrite fun_add_spec in *. des_ifs; [|congr]. ss.
          inv VLOC. inv VVAL. rewrite <- VAL, <- VAL0. ss.
    - i. des. unfold ALocal.next_eid in *. apply nth_error_snoc_inv in GET. des.
      + des_ifs.
        { apply Nat.eqb_eq in Heq. subst. lia. }
        eapply IH.(WPROP2'); eauto.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. lia. }
        ss. eqvtac. esplits; eauto.
        * inv VLOC. rewrite VAL. eauto.
        * rewrite fun_add_spec in *. des_ifs; [|congr]. ss.
          inv VLOC. inv VVAL. rewrite <- VAL. eauto.
    - i. unfold ALocal.next_eid in *. des_ifs.
      + apply Nat.eqb_eq in Heq. subst. rewrite fun_add_spec. des_ifs; [|congr]. inv e.
        destruct ts; ss. esplits; eauto using Label.write_is_kinda_writing_val; ss.
        { unfold Time.lt, Time.bot. lia. }
        rewrite List.nth_error_app2, Nat.sub_diag; ss.
        inv VLOC. inv VVAL. rewrite <- VAL0, <-VAL1. eauto.
      + exploit IH.(WPROP3); eauto. s. i. des. esplits; eauto.
        * rewrite fun_add_spec. des_ifs; eauto. inv e. etrans; eauto.
          inv WRITABLE. inv COHMAX. s.
          exploit MAX. intro X. inv X. unfold le in *.
          rewrite TS. lia.
        * eapply nth_error_app_mon. eauto.
    - i. unfold ALocal.next_eid in *.
      des_ifs.
      + apply Nat.eqb_eq in Heq. apply Nat.eqb_eq in Heq0. subst. ss.
      + clear Heq0. rewrite fun_add_spec in *. des_ifs; [|congr].
        exploit IH.(WPROP3); eauto. s. i. des.
        exploit IH.(WPROP1); eauto. s. rewrite PROMISE. i. des; ss.
        rewrite MSG in x6. inv x6. inv WRITABLE.
        inv COHMAX. specialize (MAX (ValA.val vloc0)). inv MAX.
        unfold le in *. lia.
      + rewrite fun_add_spec in *. des_ifs; [|congr].
        exploit IH.(WPROP3); eauto. s. i. des.
        exploit IH.(WPROP1); eauto. s. rewrite PROMISE. i. des; ss.
        rewrite MSG in x6. inv x6. inv WRITABLE.
        inv COHMAX. specialize (MAX (ValA.val vloc0)). inv MAX.
        unfold le in *. lia.
      + eapply IH.(WPROP4); eauto.
    - i. des. exploit IH.(RPROP1); eauto.
      apply nth_error_snoc_inv in GET. des; esplits; eauto.
      rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(RPROP2); eauto. s. i. des; [left|right].
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * rewrite fun_add_spec. des_ifs; eauto. inv e. etrans; eauto.
          inv WRITABLE. inv COHMAX. s.
          exploit MAX. intro X. inv X. unfold le in *.
          rewrite TS. lia.
        * eapply nth_error_app_mon in x2. eauto.
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * rewrite fun_add_spec. des_ifs; eauto. inv e. etrans; eauto.
          inv WRITABLE. inv COHMAX. s.
          exploit MAX. intro X. inv X. unfold le in *.
          rewrite TS. lia.
        * eapply nth_error_app_mon in x2. eauto.
    - i. eapply IH.(UPROP); eauto. des_ifs.
      exfalso. apply Nat.eqb_eq in Heq. subst.
      unfold ALocal.next_eid in *. ss.
      exploit IH.(RPROP2); eauto. i. des; ss.
      + assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      + assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
    - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(FPROP2); eauto. s. i. des. des_ifs; cycle 1.
      { esplits; eauto. eapply nth_error_app_mon in x0. eauto. }
      exfalso. apply Nat.eqb_eq in Heq. subst.
      unfold ALocal.next_eid in *.
      assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
      apply List.nth_error_Some in H. lia.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - inv ASTATE_STEP; ss; eauto. subst.
      inv VLOC. inv VVAL. rewrite VAL0, VAL1 in *. unfold ALocal.next_eid in *.
      i. apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO); eauto.
      + lia.
      + subst. repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_neq in X0; ss; try lia.
        splits; ss.
        rewrite fun_add_spec. des_ifs; [|congr].
        inv REL. destruct label1; ss; eqvtac.
        * exploit IH.(RPROP1); eauto with tso. i. des.
          exploit IH.(RPROP2); eauto. s. i. des; cycle 1.
          { rewrite LABEL3 in x3. destruct l; ss. }
          inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap eloc))). inv MAX.
          unfold le in *. lia.
        * exploit IH.(WPROP2); eauto with tso. i. des.
          exploit IH.(WPROP3); eauto. s. i. des. subst.
          inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap eloc))). inv MAX.
          unfold le in *. lia.
        * exploit IH.(WPROP2); eauto with tso. i. des.
          exploit IH.(WPROP3); eauto. s. i. des. subst.
          inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap eloc))). inv MAX.
          unfold le in *. lia.
      + subst. repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; try lia.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. ss.
      + subst. ss.
  }
  { (* rmw *)
    inv LOCAL; ss.
    generalize IH.(EU_WF). i. inv H.
    inversion STEP. guardH LC2.
    inv STATE0; inv EVENT; ss.
    inv ASTATE_STEP.
    exploit sim_trace_sim_state_weak; eauto. s. intro Y. inv Y. ss. inv STMTS.
    exploit sim_rmap_weak_expr; eauto. intro Y. inv Y.
    inv VLOC. rewrite VAL0 in *. clear VAL.

    assert (PRED: old_ts = Memory.latest_ts (ValA.val (sem_expr rmap0 eloc0)) (Init.Nat.pred ts) m.(Machine.mem)).
    { generalize (SIMS tid). intro SIM_TID. inv SIM_TID; try congr. simplify.
      generalize (TR tid). intro TR_TID. inv TR_TID; try congr. simplify.
      rewrite <- EU1 in *. rewrite <- EU in *.
      exploit lastn_sub_S; ss.
      { instantiate (1 := eu :: eu1 :: tr). ss. lia. }
      instantiate (1 := trt'). i. des.
      exploit sim_trace_rtc_step; try exact REL6; eauto. intro RTC_STEP.
      replace (m.(Machine.mem)) with (ExecUnit.mem eu1); cycle 1.
      { rewrite EU1. ss. }
      rewrite <- VAL0.
      eapply ExecUnit.no_promise_rmw_spec; try exact RTC_STEP; try rewrite EU1; try rewrite EU; eauto.
      inv PF. inv NOPROMISE. rename H7 into PROMBOT.
      symmetry in PROMBOT. destruct b0. eapply PROMISES in PROMBOT. ss.
    }
    unguardH LC2. inv LC2.

    econs; ss; clear EU_WF2 AEU_WF2.
    - i. exploit IH.(WPROP1); eauto. s. i. rewrite Promises.unset_o. des_ifs.
      { inv e. right. rewrite MSG in GET. inv GET. esplits; ss.
        - instantiate (1 := ALocal.next_eid alc1). des_ifs; cycle 1.
          { apply Nat.eqb_neq in Heq. congr. }
          rewrite fun_add_spec. des_ifs; ss; try congr.
        - rewrite List.nth_error_app2, Nat.sub_diag; ss.
        - inv NEW. rewrite VAL. eauto with tso.
      }
      des; [left|right]; splits; ss.
      + i. des_ifs; eauto. apply Nat.eqb_eq in Heq. subst. ii. inv H.
        rewrite fun_add_spec in *. des_ifs; [|congr]. ss. apply c.
        specialize (Memory.latest_ts_spec (ValA.val (sem_expr rmap eloc0)) ts m.(Machine.mem)). i. des.
        destruct ts; ss.
      + esplits; eauto.
        * des_ifs; eauto. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon. eauto.
    - i. des. unfold ALocal.next_eid in *. apply nth_error_snoc_inv in GET. des.
      + des_ifs.
        { apply Nat.eqb_eq in Heq. subst. lia. }
        eapply IH.(WPROP2); eauto.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. lia. }
        ss. eqvtac. esplits; eauto.
        rewrite fun_add_spec in *. des_ifs; try congr. ss.
        inv NEW. rewrite <- VAL. ss.
    - i. des. unfold ALocal.next_eid in *. apply nth_error_snoc_inv in GET. des.
      + des_ifs.
        { apply Nat.eqb_eq in Heq. subst. lia. }
        eapply IH.(WPROP2'); eauto.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. lia. }
        inv GET0. eqvtac.
        rewrite fun_add_spec in *. des_ifs; try congr. ss. esplits; eauto.
    - i. unfold ALocal.next_eid in *. des_ifs.
      + apply Nat.eqb_eq in Heq. subst. rewrite fun_add_spec. des_ifs; [|congr]. inv e.
        destruct ts; ss. esplits; eauto using Label.update_is_kinda_writing_val.
        * unfold Time.lt, Time.bot. lia.
        * rewrite List.nth_error_app2, Nat.sub_diag; ss.
          inv NEW. rewrite <- VAL. ss.
      + exploit IH.(WPROP3); eauto. s. i. des. esplits; eauto.
        * rewrite fun_add_spec. des_ifs; eauto. inv e. etrans; eauto.
          inv WRITABLE. inv COHMAX. s.
          exploit MAX. intro X. inv X. unfold le in *.
          rewrite TS. lia.
        * eapply nth_error_app_mon. eauto.
    - i. unfold ALocal.next_eid in *.
      des_ifs.
      + apply Nat.eqb_eq in Heq. apply Nat.eqb_eq in Heq0. subst. ss.
      + clear Heq0. rewrite fun_add_spec in *. des_ifs; [|congr].
        exploit IH.(WPROP3); eauto. s. i. des.
        exploit IH.(WPROP1); eauto. s. rewrite PROMISE. i. des; ss.
        rewrite MSG in x6. inv x6. inv WRITABLE. inv COHMAX.
        specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
        unfold le in *. lia.
      + rewrite fun_add_spec in *. des_ifs; [|congr].
        exploit IH.(WPROP3); eauto. s. i. des.
        exploit IH.(WPROP1); eauto. s. rewrite PROMISE. i. des; ss.
        rewrite MSG in x6. inv x6. inv WRITABLE. inv COHMAX.
        specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
        unfold le in *. lia.
      + eapply IH.(WPROP4); eauto.
    - i. des. apply nth_error_snoc_inv in GET. des.
      + exploit IH.(RPROP1); eauto. i. des. esplits; eauto.
        des_ifs. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *. lia.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. unfold ALocal.next_eid in *. congr. }
        rewrite fun_add_spec in *. condtac; [|congr].
        inv OLD. ss. eqvtac. rewrite <- VAL.
        exploit Memory.read_get_msg; eauto. i. unguard. des; esplits; eauto.
    - i. des_ifs.
      + right. apply Nat.eqb_eq in Heq. subst.
        rewrite fun_add_spec in *. des_ifs; [|congr].
        inv VAL0. ss. subst. rewrite H0 in *.
        splits; try lia.
        inv OLD. rewrite VAL in *.
        exploit Memory.read_get_msg; eauto. i.
        assert (TS_GT: lt (Memory.latest_ts (ValA.val (sem_expr rmap0 eloc0)) (Init.Nat.pred ts) m.(Machine.mem)) ts).
        { eapply le_lt_trans with (Init.Nat.pred ts); [apply Memory.latest_ts_spec | lia]. }
        des.
        * esplits.
          { rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss. }
          all: eauto with tso.
          left. rewrite x0, x1. ss.
        * esplits.
          { rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss. }
          all: eauto with tso.
          right. eauto.
      + inv WRITABLE.
        exploit sim_rmap_weak_expr; eauto. intro Y. inv Y. rewrite VAL in *.
        exploit IH.(RPROP2); eauto. s. i. des; [left|right]; esplits; eauto with tso.
        all: try by eapply nth_error_app_mon; eauto.
        * rewrite fun_add_spec. des_ifs; eauto.
          inv e. etrans; eauto. s. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
          unfold le in *. lia.
        * rewrite fun_add_spec. des_ifs; eauto.
          inv e. etrans; eauto. ss. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
          unfold le in *. lia.
    - i. des_ifs; cycle 1.
      { exploit IH.(UPROP); eauto. }
      rewrite fun_add_spec. condtac; ss; try congr.
      split; ss. eapply Memory.latest_ts_latest. ss.
    - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(FPROP2); eauto. s. i. des. des_ifs; cycle 1.
      { esplits; eauto. eapply nth_error_app_mon in x0. eauto. }
      exfalso. apply Nat.eqb_eq in Heq. subst.
      unfold ALocal.next_eid in *.
      assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
      apply List.nth_error_Some in H. lia.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - inv NEW. rewrite VAL in *. unfold ALocal.next_eid in *.
      i. apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO); eauto.
      + lia.
      + subst. repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_neq in X0; ss; try lia.
        rewrite fun_add_spec. des_ifs; [|congr].
        inv REL. ss. split; ss. ii.
        destruct label1; ss; eqvtac.
        * exploit IH.(RPROP1); eauto with tso. i. des.
          exploit IH.(RPROP2); eauto. s. i. des; cycle 1.
          { rewrite LABEL3 in x3. destruct l; ss. }
          subst. inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
          unfold le in *. lia.
        * exploit IH.(WPROP2); eauto with tso. i. des.
          exploit IH.(WPROP3); eauto. s. i. des.
          subst. inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
          unfold le in *. lia.
        * exploit IH.(WPROP2); eauto with tso. i. des.
          exploit IH.(WPROP3); eauto. s. i. des.
          subst. inv WRITABLE. inv COHMAX.
          specialize (MAX (ValA.val (sem_expr rmap0 eloc0))). inv MAX.
          unfold le in *. lia.
      + subst. repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; try lia.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. ss.
      + subst. ss.
  }
  { (* mfence *)
    inv LOCAL; ss; cycle 1.
    { destruct b; destruct b0; ss. inv EVENT. destruct wr0; destruct ww0; ss. }
    inv STEP. inv ASTATE_STEP. ss. inv EVENT. econs; ss.
    - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - i. des. exploit IH.(WPROP2); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. des. exploit IH.(WPROP2'); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. exploit IH.(WPROP3); eauto. s. i. des. esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - eapply IH.(WPROP4).
    - i. des. exploit IH.(RPROP1); eauto.
      apply nth_error_snoc_inv in GET. des.
      + esplits; eauto.
      + rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(RPROP2); eauto. s. i. des; [left|right]; esplits; eauto.
      all: eapply nth_error_app_mon; eauto.
    - i. eapply IH.(UPROP); eauto.
    - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(FPROP2); eauto. s. i. des; esplits; eauto.
      eapply nth_error_app_mon; eauto.
    - i. apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - i. apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - i. apply nth_error_snoc_inv in LABEL1. des; cycle 1.
      { subst. inv REL. inv X. }
      apply nth_error_snoc_inv in LABEL2. des; cycle 1.
      { subst. inv REL. inv Y. }
      eapply IH.(PO); eauto.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. ss.
      + subst. ss.
  }
  { (* sfence *)
    inv LOCAL; ss.
    { destruct b; destruct b0; ss. inv EVENT. destruct wr0; destruct ww0; ss. }
    inv STEP. inv ASTATE_STEP. ss. inv EVENT. econs; ss.
    - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - i. des. exploit IH.(WPROP2); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. des. exploit IH.(WPROP2'); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. exploit IH.(WPROP3); eauto. s. i. des. esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - eapply IH.(WPROP4).
    - i. des. exploit IH.(RPROP1); eauto.
      apply nth_error_snoc_inv in GET. des.
      + esplits; eauto.
      + rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(RPROP2); eauto. s. i. des; [left|right]; esplits; eauto.
      all: eapply nth_error_app_mon; eauto.
    - i. eapply IH.(UPROP); eauto.
    - i. des. exploit IH.(FPROP1); eauto.
        apply nth_error_snoc_inv in GET. des; eauto.
        rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(FPROP2); eauto. s. i. des; esplits; eauto.
      eapply nth_error_app_mon; eauto.
    - i. apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - i. apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - i. apply nth_error_snoc_inv in LABEL1. des; cycle 1.
      { subst. inv REL. inv X. }
      apply nth_error_snoc_inv in LABEL2. des; cycle 1.
      { subst. inv REL. inv Y. }
      eapply IH.(PO); eauto.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. ss.
      + subst. ss.
  }
  { (* flush *)
    inv LOCAL; ss.
    inv STEP. inv ASTATE_STEP. ss. inv EVENT. econs; ss.
    - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - i. des. exploit IH.(WPROP2); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. des. exploit IH.(WPROP2'); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. exploit IH.(WPROP3); eauto. s. i. des. des_ifs.
      { exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      }
      esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - eapply IH.(WPROP4).
    - i. des. exploit IH.(RPROP1); eauto.
      apply nth_error_snoc_inv in GET. des.
      + esplits; eauto.
      + rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(RPROP2); eauto. s. i. des; [left|right].
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon in x2. eauto.
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon in x2. eauto.
    - i. eapply IH.(UPROP); eauto.
    - i. des. apply nth_error_snoc_inv in GET. des.
      + exploit IH.(FPROP1); eauto. i. des. esplits; eauto.
        des_ifs. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *. lia.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. unfold ALocal.next_eid in *. congr. }
        ss. eqvtac. inv VLOC. inv VAL.
        esplits; eauto. i.
        exploit Memory.latest_ts_spec. i. des.
        exploit Memory.read_get_msg; eauto. i. des; esplits; eauto; [left|right]; eauto.
    - i. des_ifs.
      + split; ss.
        apply Nat.eqb_eq in Heq. subst.
        inv VLOC. inv VAL. ss.
        esplits; cycle 1.
        { rewrite List.nth_error_app2, Nat.sub_diag; [|refl]; ss; eauto with tso. }
        all: eauto with tso.
        i.
        exploit Memory.latest_ts_spec. i. des.
        exploit Memory.read_get_msg; eauto. i. des; esplits; ss; [left | right]; eauto.
      + exploit IH.(FPROP2); eauto. s. i. des; esplits; eauto with tso.
        eapply nth_error_app_mon; eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - unfold ALocal.next_eid in *.
      i. apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO); eauto.
      + lia.
      + subst. repeat condtac; ss.
      + subst. repeat condtac; ss.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. condtac.
        { apply Nat.eqb_eq in X. lia. }
        condtac; cycle 1.
        { assert (length (ALocal.labels alc1) =? length (ALocal.labels alc1)); try apply Nat.eqb_eq; ss.
          rewrite H in *. ss.
        }
        destruct label1; ss.
        exploit IH.(WPROP2); eauto with tso. i. des.
        exploit IH.(WPROP3); eauto. s. i. des. subst.
        rewrite x4. etrans; eauto.
        rewrite <- join_r. rewrite Loc.cl_refl. s.
        inv COHMAX. specialize (MAX loc). inv MAX. unfold le in *. ss.
      + subst. lia.
  }
  { (* flushopt *)
    inv LOCAL; ss.
    inv STEP. inv ASTATE_STEP. ss. inv EVENT. econs; ss.
    - i. exploit IH.(WPROP1); eauto. s. i. des; [left|right]; esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - i. des. exploit IH.(WPROP2); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. des. exploit IH.(WPROP2'); eauto.
      apply nth_error_snoc_inv in GET. des; eauto. destruct l; ss.
    - i. exploit IH.(WPROP3); eauto. s. i. des. des_ifs.
      { exfalso. apply Nat.eqb_eq in Heq. subst.
        unfold ALocal.next_eid in *.
        assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
        apply List.nth_error_Some in H. lia.
      }
      esplits; eauto.
      eapply nth_error_app_mon. eauto.
    - eapply IH.(WPROP4).
    - i. des. exploit IH.(RPROP1); eauto.
      apply nth_error_snoc_inv in GET. des.
      + esplits; eauto.
      + rewrite <- GET1 in GET0. ss.
    - i. exploit IH.(RPROP2); eauto. s. i. des; [left|right].
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon in x2. eauto.
      + esplits; eauto.
        * des_ifs.
          exfalso. apply Nat.eqb_eq in Heq. subst.
          unfold ALocal.next_eid in *.
          assert (H: List.nth_error (ALocal.labels alc1) (length (ALocal.labels alc1)) <> None) by (ii; congr).
          apply List.nth_error_Some in H. lia.
        * eapply nth_error_app_mon in x2. eauto.
    - i. eapply IH.(UPROP); eauto.
    - i. des. apply nth_error_snoc_inv in GET. des.
      + exploit IH.(FPROP1); eauto. i. des. esplits; eauto.
        des_ifs. apply Nat.eqb_eq in Heq. subst. unfold ALocal.next_eid in *. lia.
      + des_ifs; cycle 1.
        { apply Nat.eqb_neq in Heq. unfold ALocal.next_eid in *. congr. }
        ss. eqvtac. inv VLOC. inv VAL.
        esplits; eauto. i.
        exploit Memory.latest_ts_spec. i. des.
        exploit Memory.read_get_msg; eauto. i. des; esplits; eauto; [left|right]; eauto.
    - i. des_ifs.
      + split; ss.
        apply Nat.eqb_eq in Heq. subst.
        inv VLOC. inv VAL. ss.
        esplits; cycle 1.
        { rewrite List.nth_error_app2, Nat.sub_diag; [|refl]; ss; eauto with tso. }
        all: eauto with tso.
        i.
        exploit Memory.latest_ts_spec. i. des.
        exploit Memory.read_get_msg; eauto. i. des; esplits; ss; [left | right]; eauto.
      + exploit IH.(FPROP2); eauto. s. i. des; esplits; eauto with tso.
        eapply nth_error_app_mon; eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(COVPROP); eauto.
    - unfold ALocal.next_eid in *. s. i. des_ifs.
      { apply Nat.eqb_eq in Heq. subst. econs; eauto.
        - rewrite List.nth_error_app2, Nat.sub_diag; [|refl]. ss.
        - econs; ss.
      }
      apply AExecUnit.label_is_mon. eapply IH.(VEXTPROP); eauto.
    - unfold ALocal.next_eid in *.
      i. apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac; ss.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO); eauto.
      + lia.
      + subst. repeat condtac; ss.
      + subst. repeat condtac; ss.
    - i. unfold ALocal.next_eid in *.
      apply nth_error_snoc_inv in LABEL1. apply nth_error_snoc_inv in LABEL2. des.
      + repeat condtac.
        all: try apply Nat.eqb_eq in X; ss; subst; try lia.
        all: try apply Nat.eqb_eq in X0; ss; subst; try lia.
        eapply IH.(PO_FL); eauto.
      + lia.
      + subst. ss.
      + subst. ss.
  }

  Grab Existential Variables.
  all: auto. (* tid *)
Qed.


Require Import RelationClasses.
Require Import List.

Require Import sflib.
From Paco Require Import paco.

Require Import Basic.
Require Import Axioms.
Require Import Loc.
Require Import LibTactics.
Require Import Integers.
Require Import Language.
Require Import ZArith.
Require Import Maps.
Require Import FSets.
Require Import FSetInterface.
Require Import Lattice.
Require Import Event.
Require Import Syntax.
Require Import Semantics.

Require Import Kildall.
Require Import CorrectOpt.
Require Import ValAnalysis.
Require Import ConstProp.
Require Import CSEProofMState.

Require Import Language.
Require Import Time.
Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import MsgMapping.
Require Import DelaySet.
Require Import LocalSim.

(** ** Invariant in ConstProp proof *)
Definition I_cp (lo: Ordering.LocOrdMap) (inj: Mapping) (S: Rss) :=
  <<ID_INJ: inj = spec_inj (T_MEM S)>> /\
  <<SC_EQ: T_SC S = S_SC S>> /\ <<MEM_EQ: T_MEM S = S_MEM S>>.

(** ** Match state in ConstProp proof *)
(** Interpretation/semantics of the result of the value analysis at each program point. *)
Definition sem_val_reg (R_src: RegFile.t) (aregs: vreg) :=
  forall r, match (VALSET.get r aregs) with
       | LVal.VAL v => RegFun.find r R_src = v
       | LVal.vtop => True
       | LVal.vbot => False
       end.

Definition sem_val_loc (tview_src: TView.t) (mem_src: Memory.t) (amem: vmem) (lo: Ordering.LocOrdMap) :=
  forall loc,
    match (VALSET.get loc amem) with
    | LVal.VAL v => exists from R, Memory.get loc (View.pln (TView.cur tview_src) loc) mem_src =
                             Some (from, Message.concrete v R) /\
                             lo loc = Ordering.nonatomic
    | LVal.vtop => True
    | LVal.vbot => False
    end.

Definition val_interp (R_src: RegFile.t) (tview_src: TView.t) (mem_src: Memory.t)
           (ae: ValLat.t) (lo: Ordering.LocOrdMap) :=
  sem_val_reg R_src (fst ae) /\ sem_val_loc tview_src mem_src (snd ae) lo.

(** Match state for current stack frame *)
Inductive match_state_cur_stkframe:
  Ordering.LocOrdMap -> TView.t -> Memory.t ->
  (RegFile.t * BBlock.t * CodeHeap) ->
  (RegFile.t * BBlock.t * CodeHeap) -> Prop :=
| match_state_cur_stkframe_intro
    lo R_tgt BB_tgt C_tgt R_src BB_src C_src tview_src mem_src
    afunc ep ae fid
    (* function analysis *)
    (FUNC_ANALYSIS: ValDS.analyze_func (C_src, fid) succ ep transf_blk = Some afunc)
    (* transformation code heap *)
    (FUNC_TRANS: transform_cdhp C_src afunc = C_tgt)
    (* current source and target blocks transformation *)
    (TRANS_PBLK: transform_blk (transf_blk ae BB_src) BB_src = BB_tgt)
    (* current ai interpretation *)
    (AI_INTERP: val_interp R_src tview_src mem_src ae lo)
    (* RegFile eq *)
    (REGS_EQ: R_tgt = R_src)
    (* link *)
    (LINK: forall s BB_src',
        In s (succ BB_src) -> C_src ! s = Some BB_src' ->
        ValDS.L.ge (ValDS.AI.getFirst (afunc !! s)) (ValDS.AI.getLast (transf_blk ae BB_src))):
    match_state_cur_stkframe lo tview_src mem_src (R_tgt, BB_tgt, C_tgt) (R_src, BB_src, C_src).

(** Match state for stack frames. *)
Inductive match_state_stkframes:
  Ordering.LocOrdMap ->
  Continuation.t -> Continuation.t -> Prop :=
| match_state_stkframes_done
    lo:
    match_state_stkframes lo Continuation.done Continuation.done
| match_state_stkframes_cont
    lo
    R_tgt BB_tgt C_tgt cont_tgt
    R_src BB_src C_src cont_src
    (CUR_MATCH:
       forall tview_src mem_src,
         match_state_cur_stkframe lo tview_src mem_src
                                  (R_tgt, BB_tgt, C_tgt) (R_src, BB_src, C_src)
    )
    (CONT_MATCH: match_state_stkframes lo cont_tgt cont_src):
    match_state_stkframes lo
                          (Continuation.stack R_tgt BB_tgt C_tgt cont_tgt)
                          (Continuation.stack R_src BB_src C_src cont_src).

(** Match state for the thread-local state *)
Inductive match_state_tlocal:
  Mapping -> Ordering.LocOrdMap -> Memory.t ->
  (State.t * TView.t * Memory.t) -> (State.t * TView.t * Memory.t) -> Prop :=
| match_state_tlocal_intro
    inj lo mem_src
    R_tgt BB_tgt C_tgt cont_tgt Prog_tgt tview_tgt prm_tgt
    R_src BB_src C_src cont_src Prog_src tview_src prm_src
    (PROG_TRANS: transform_prog Prog_src = Some Prog_tgt)
    (CUR_STK_FRAME: match_state_cur_stkframe lo tview_src mem_src
                                             (R_tgt, BB_tgt, C_tgt)
                                             (R_src, BB_src, C_src))
    (STK_FRAMES: match_state_stkframes lo cont_tgt cont_src)
    (TVIEW_EQ: tview_tgt = tview_src)
    (PRM_EQ: prm_tgt = prm_src)
    (PRM_INDOM: forall loc to from val R,
        Memory.get loc to prm_tgt = Some (from, Message.concrete val R) ->
        exists to', inj loc to = Some to'):
    match_state_tlocal inj lo mem_src
                       (State.mk R_tgt BB_tgt C_tgt cont_tgt Prog_tgt, tview_tgt, prm_tgt)
                       (State.mk R_src BB_src C_src cont_src Prog_src, tview_src, prm_src).

(** Match state for the thread state *)
Inductive match_state_cp:
  Mapping -> Ordering.LocOrdMap -> bool ->
  Thread.t rtl_lang -> Thread.t rtl_lang -> Prop :=
| match_state_cp_intro
    inj inj' lo b
    state_tgt tview_tgt prm_tgt sc_tgt mem_tgt
    state_src tview_src prm_src sc_src mem_src
    (INV: I_cp lo inj' (Build_Rss sc_tgt mem_tgt sc_src mem_src))
    (MATCH_THRD_LOCAL:
       match_state_tlocal inj lo mem_src (state_tgt, tview_tgt, prm_tgt) (state_src, tview_src, prm_src))
    (ATM_BIT: (b = false /\ (forall loc t t', inj loc t = Some t' -> inj' loc t = Some t')) \/
              (b = true /\ inj = inj'))
    (* wf local, closed sc, closed memory *)
    (LOCAL_WF_TGT: Local.wf (Local.mk tview_tgt prm_tgt) mem_tgt)
    (CLOSED_SC_TGT: Memory.closed_timemap sc_tgt mem_tgt)
    (MEM_CLOSED_TGT: Memory.closed mem_tgt):
    match_state_cp inj lo b
                   (Thread.mk rtl_lang state_tgt (Local.mk tview_tgt prm_tgt) sc_tgt mem_tgt)
                   (Thread.mk rtl_lang state_src (Local.mk tview_src prm_src) sc_src mem_src).

Lemma sem_val_reg_ge
      aregs aregs' R
      (SEM_VAL_REG: sem_val_reg R aregs)
      (GE: VALSET.ge aregs' aregs):
  sem_val_reg R aregs'.
Proof.
  unfold sem_val_reg in *. ii.
  specialize (SEM_VAL_REG r).
  destruct (VALSET.get r aregs) eqn:Heqe1; ss.
  unfold VALSET.ge in *.
  specialize (GE r).
  unfold LVal.ge in *.
  destruct (VALSET.get r aregs') eqn:Heqe2; ss.
  rewrite Heqe1 in GE. ss.
  rewrite Heqe1 in GE. ss.
  destruct (VALSET.get r aregs') eqn:Heqe2; ss.
  unfold VALSET.ge in *.
  specialize (GE r).
  unfold LVal.ge in *.
  rewrite Heqe2, Heqe1 in GE; ss.
  des_ifH GE; ss. subst; eauto.
  unfold VALSET.ge in *.
  specialize (GE r).
  unfold LVal.ge in *.
  rewrite Heqe2, Heqe1 in GE; ss.
Qed.

Lemma sem_val_loc_ge
      tview mem amem amem' lo
      (SEM_VAL_LOC: sem_val_loc tview mem amem lo)
      (GE: VALSET.ge amem' amem):
  sem_val_loc tview mem amem' lo.
Proof.
  unfold sem_val_loc in *. ii.
  specialize (SEM_VAL_LOC loc).
  destruct (VALSET.get loc amem) eqn:Heqe1; ss.
  unfold VALSET.ge in GE. specialize (GE loc).
  unfold LVal.ge in GE.
  rewrite Heqe1 in GE.
  destruct (VALSET.get loc amem') eqn:Heqe2; ss.
  unfold VALSET.ge in GE. specialize (GE loc).
  unfold LVal.ge in GE.
  rewrite Heqe1 in GE.
  destruct (VALSET.get loc amem') eqn:Heqe2; ss.
  des_ifH GE; ss. subst. eauto.
Qed.

Lemma ge_val_interp_prsv
      ae ae' R tview mem lo
      (GE: ValDS.AI.ge ae' ae)
      (VAL_INTERP: val_interp R tview mem ae lo):
  val_interp R tview mem ae' lo.
Proof.
  destruct ae, ae'; ss. inv GE; ss.
  unfold val_interp in *; ss. des.
  split. eapply sem_val_reg_ge; eauto.
  eapply sem_val_loc_ge; eauto.
Qed.

Lemma vreg_ge_top
      aregs R
      (GE: VALSET.ge aregs VALSET.top):
  sem_val_reg R aregs.
Proof.
  unfold VALSET.ge in *.
  unfold sem_val_reg; ii.
  specialize (GE r).
  destruct (VALSET.get r aregs) eqn:AREGS; ss.
  rewrite PTree.gempty in GE. ss.
  rewrite PTree.gempty in GE. ss.
Qed.

Lemma vloc_ge_top
      tview mem amem lo
      (GE: VALSET.ge amem VALSET.top):
  sem_val_loc tview mem amem lo.
Proof.
  unfold VALSET.ge in *; ss.
  unfold sem_val_loc; ii.
  specialize (GE loc).
  rewrite PTree.gempty in GE.
  unfold LVal.ge in *; ss.
  destruct (VALSET.get loc amem) eqn:Heqe; ss.
Qed.

Lemma val_ge_top
      ae R tview mem lo
      (GE_TOP: ValDS.L.ge ae ValLat.top):
  val_interp R tview mem ae lo.
Proof.
  destruct ae; ss.
  unfold ValDS.L.ge in *; ss. des.
  unfold val_interp. ss.
  split.
  eapply vreg_ge_top; eauto.
  eapply vloc_ge_top; eauto.
Qed.