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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Language.
From PromisingLib Require Import Loc.

From PromisingLib Require Import Event.
Require Import Configuration.
Require Import Behavior.

Require Import NoMix.
Require Import DelayedSimulation.
Require Import DelayedStep.
Require Import DelayedAdequacy.
Require Import SeqLiftSim.
Require Import Sequential.
Require Import SequentialBehavior.
Require Import SequentialRefinement.
Require Import Program.

Set Implicit Arguments.

Section ADEQUACY.
  Variable loc_na: Loc.t -> Prop.
  Variable loc_at: Loc.t -> Prop.
  Hypothesis LOCDISJOINT: forall loc (NA: loc_na loc) (AT: loc_at loc), False.

  Theorem sequential_adequacy (progs_src progs_tgt: Threads.syntax)
          (SIM: forall tid,
              option_rel
                (fun '(existT _ lang_src prog_src) '(existT _ lang_tgt prog_tgt) =>
                   exists sim_ret, @sim_seq_all
                                     _ _ sim_ret
                                     (lang_src.(Language.init) prog_src)
                                     (lang_tgt.(Language.init) prog_tgt))
                (IdentMap.find tid progs_src)
                (IdentMap.find tid progs_tgt))
          (NOMIX_SRC:
             forall tid lang syn
                    (FIND: IdentMap.find tid progs_src = Some (existT _ lang syn)),
               nomix loc_na loc_at lang (lang.(Language.init) syn))
          (NOMIX_TGT:
             forall tid lang syn
                    (FIND: IdentMap.find tid progs_tgt = Some (existT _ lang syn)),
               nomix loc_na loc_at lang (lang.(Language.init) syn))
    :
      behaviors
        Configuration.step
        (Configuration.init progs_tgt)
      <2=
      behaviors
        Configuration.step
        (Configuration.init progs_src).
  Proof.
    i. eapply DelayedAdequacy.sim_init.
    { eapply SeqLiftSim.world_messages_le_PreOrder. }
    { eapply SeqLiftSim.world_messages_le_mon. }
    { eapply SeqLiftSim.world_messages_le_frame. }
    { i. specialize (SIM tid). unfold option_rel in *. des_ifs.
      { rewrite Heq1 in Heq0. dependent destruction Heq0.
        des. eapply SeqLiftSim.sim_lift_init; eauto.
      }
      { clarify. }
      { clarify. }
    }
    { eapply SeqLiftSim.initial_sim_memory_lift. }
    eapply DConfiguration.delayed_refinement; eauto.
  Qed.

  Theorem sequential_adequacy_concurrent_context
          (ctx: Threads.syntax) (tid: Ident.t)
          (lang_src: language) (prog_src: lang_src.(Language.syntax))
          (lang_tgt: language) (prog_tgt: lang_tgt.(Language.syntax))
          (SIM: exists sim_ret, @sim_seq_all
                                  _ _ sim_ret
                                  (lang_src.(Language.init) prog_src)
                                  (lang_tgt.(Language.init) prog_tgt))
          (NOMIX_SRC: nomix loc_na loc_at _ (lang_src.(Language.init) prog_src))
          (NOMIX_TGT: nomix loc_na loc_at _ (lang_tgt.(Language.init) prog_tgt))
          (NOMIX_CTX:
             forall tid lang syn
                    (FIND: IdentMap.find tid ctx = Some (existT _ lang syn)),
               nomix loc_na loc_at lang (lang.(Language.init) syn))
    :
      behaviors
        Configuration.step
        (Configuration.init (IdentMap.add tid (existT _ lang_tgt prog_tgt) ctx))
      <2=
      behaviors
        Configuration.step
        (Configuration.init (IdentMap.add tid (existT _ lang_src prog_src) ctx)).
  Proof.
    eapply sequential_adequacy.
    { i. rewrite ! IdentMap.gsspec. des_ifs; ss.
      destruct (IdentMap.find tid0 ctx) as [[lang prog]|]; ss.
      esplits. eapply sim_seq_all_refl.
    }
    { ii. rewrite IdentMap.gsspec in FIND. des_ifs; eauto.
      dependent destruction H0. auto.
    }
    { ii. rewrite IdentMap.gsspec in FIND. des_ifs; eauto.
      dependent destruction H0. auto.
    }
  Qed.

  Theorem sequential_refinement_adequacy_concurrent_context
          (ctx: Threads.syntax) (tid: Ident.t)
          (lang_src: language) (prog_src: lang_src.(Language.syntax))
          (lang_tgt: language) (prog_tgt: lang_tgt.(Language.syntax))
          (REFINE: SeqBehavior.refine _ _ (lang_tgt.(Language.init) prog_tgt) (lang_src.(Language.init) prog_src))
          (DETERM: deterministic _ (lang_src.(Language.init) prog_src))
          (RECEPTIVE: receptive _ (lang_tgt.(Language.init) prog_tgt))
          (MONOTONE: monotone_read_state lang_src (lang_src.(Language.init) prog_src))
          (NOMIX_SRC: nomix loc_na loc_at _ (lang_src.(Language.init) prog_src))
          (NOMIX_TGT: nomix loc_na loc_at _ (lang_tgt.(Language.init) prog_tgt))
          (NOMIX_CTX:
             forall tid lang syn
                    (FIND: IdentMap.find tid ctx = Some (existT _ lang syn)),
               nomix loc_na loc_at lang (lang.(Language.init) syn))
    :
      behaviors
        Configuration.step
        (Configuration.init (IdentMap.add tid (existT _ lang_tgt prog_tgt) ctx))
      <2=
      behaviors
        Configuration.step
        (Configuration.init (IdentMap.add tid (existT _ lang_src prog_src) ctx)).
  Proof.
    eapply sequential_adequacy_concurrent_context; eauto.
    esplits. eapply refinement_implies_simulation; eauto.
  Qed.
End ADEQUACY.


Require Import ucos_include.
Require Import os_ucos_h.
Require Import sep_lemmas_ext.
Require Import linv_solver.
Require Import taskcreate_pure.
Require Import protect.
Local Open Scope code_scope.
Local Open Scope Z_scope.
Local Open Scope int_scope.

Theorem TaskCreateProof:
  forall  vl p r tid,
    Some p =
    BuildPreA' os_api OSTaskCreate taskcreapi vl  OSLInv tid init_lg ->
    Some r =
    BuildRetA' os_api OSTaskCreate taskcreapi vl  OSLInv tid init_lg ->
    exists t d1 d2 s,
      os_api OSTaskCreate = Some (t, d1, d2, s) /\
      {|OS_spec , GetHPrio, OSLInv, I, r, Afalse|}|-tid {{p}}s {{Afalse}}.
Proof.
  init_spec.
  hoare unfold.
  hoare forward.
  math simpls.
  destruct ( Int.ltu ($ OS_LOWEST_PRIO) i); simpl; intro; tryfalse.
  hoare unfold.
  hoare abscsq.
  apply noabs_oslinv.
  eapply absimp_taskcre_prio_invalid.
  go.
  unfold OS_LOWEST_PRIO in *.
  int auto.

  hoare forward.
  hoare forward.
  hoare unfold.
  hoare forward prim.
  hoare normal pre.
  hoare unfold.
  assert (Int.unsigned i < 64).
  clear -H.

  unfold OS_LOWEST_PRIO in *.
  int auto.
  destruct H; simpl in H; tryfalse.
  clear H.
  assert (   rule_type_val_match OS_TCB ∗ (nth_val' (Z.to_nat (Int.unsigned i)) v'5) = true).
  apply symbolic_lemmas.array_type_vallist_match_imp_rule_type_val_match.
  rewrite H8.
  clear -H9; mauto.
  auto.

  hoare forward.
  math simpls.
  auto.
  unfolds in H.
  destruct ( nth_val' (Z.to_nat (Int.unsigned i)) v'5 ); tryfalse.
  simpl.
  intro; tryfalse.

  simpl.
  destruct a.
  intro; tryfalse.
  instantiate (1 := Afalse).
  Focus 2.
  (* error path *)
  hoare forward.
  hoare unfold.
  hoare abscsq.
  apply noabs_oslinv.

  eapply absimp_taskcre_prio_already_exists.
  go.
  hoare forward prim.
  unfold AOSTCBPrioTbl.
  sep pauto.
  go.
  hoare forward.

  (* right path *)

  hoare unfold.
  hoare_assert_pure (   array_type_vallist_match Int8u v'11/\ length v'11 = ∘ OS_RDY_TBL_SIZE ) .
  unfold AOSRdyTblGrp in H13.
  unfold AOSRdyTbl in H13.
  sep normal in H13.
  sep split in H13.
  auto.
  hoare_split_pure_all.
  rename H13 into somehyp.
  protect somehyp.

  assert ((nth_val' (Z.to_nat (Int.unsigned i)) v'5) = Vnull).
  remember (nth_val' (Z.to_nat (Int.unsigned i)) v'5).

  destruct H.

  auto.
  simpljoin.
  rewrite H in *.
  simpl in *.
  destruct x; simpl in *.
  tryfalse.
  clear H10 H11 H12.
  hoare unfold.
  unfold AOSTCBList.
  hoare unfold.
  hoare forward.
  math simpls.
  sep cancel Aie.
  sep cancel Ais.
  sep cancel Aisr.
  sep cancel Acs.
  sep cancel AOSTCBFreeList.
  sep cancel Aop.
  sep cancel AOSRdyTblGrp.
  sep cancel 9%nat 1%nat.
  sep cancel 3%nat 1%nat.
  sep cancel 1%nat 1%nat.
  sep cancel 1%nat 1%nat.
  eauto.
  eauto.

  go.
  go.
  math simpl.
  clear -H9 l.
  unfold OS_LOWEST_PRIO in l.
  int auto.
  go.
  apply retpost_tcbinitpost.

  math simpl.
  clear -H1 H15.
  change Byte.max_unsigned with 255 in H15.
  omega.

  repeat intro.

  sep normal in H15.
  sep destruct H15.
  sep lift 6%nat in H15.

  disj_asrt_destruct H15.
  sep normal in H15.
  sep destruct H15.
  sep eexists.
  sep cancel p_local.
  simpl; auto.

  sep normal in H15.
  sep destruct H15.
  sep eexists.
  sep cancel p_local.
  simpl; auto.

  linv_solver.

  hoare unfold.
  hoare lift 6%nat pre.
  eapply backward_rule1.
  intro.
  intros.
  eapply disj_star_elim_disj in H15.
  eauto.
  hoare forward.
  hoare unfold.
  inverts H18.

  (* no more tcb *)
  hoare forward.
  hoare unfold.
  false.
  change (Int.eq ($ OS_NO_MORE_TCB) ($ OS_NO_ERR)) with false in *.
  simpl in *.
  apply H18; auto.
  hoare unfold.

  hoare abscsq.
  apply noabs_oslinv.

  eapply absimp_taskcre_no_more_tcb.
  go.

  instantiate (1 :=    <|| END Some (V$ OS_NO_MORE_TCB) ||>  **
                               Aisr empisr **
                               Aie true **
                               Ais nil ** Acs nil ** p_local OSLInv tid init_lg **
                               A_dom_lenv
                               ((prio, Int8u)
                                  :: (os_code_defs.pdata, (Void) ∗)
                                  :: (task, (Void) ∗) :: (err, Int8u) :: nil) **
                               LV err @ Int8u |-> (V$ OS_NO_MORE_TCB)  ** LV prio @ Int8u |-> Vint32 i **
                               LV os_code_defs.pdata @ (Void) ∗ |-> x0 ** LV task @ (Void) ∗ |-> x1
              ).

  hoare forward prim.
  sep cancel tcbdllflag.

  sep cancel A_dom_lenv.
  sep pauto.
  unfold AOSTCBPrioTbl.
  unfold AOSTCBList.
  sep pauto.
  sep cancel 3%nat 1%nat.

  sep cancel 3%nat 1%nat.
  sep cancel 2%nat 1%nat.

  assumption.
  go.
  go.
  go.
  go.
  go.
  go.

  hoare forward.
  hoare_split_pure_all.
  false.
  clear -H18.
  simpljoin.
  change (Int.eq ($ OS_NO_MORE_TCB) ($ OS_NO_ERR)) with false in *.
  simpl in *.
  apply H; auto.

  (* right path *)
  hoare forward.

  hoare unfold.
  inverts H19.

  hoare forward.

  hoare unfold.
  Focus 2.
  hoare unfold.
  false.
  clear -H17.
  change (Int.eq ($ OS_NO_ERR) ($ OS_NO_ERR)) with true in H17.
  simpl in H17; destruct H17; tryfalse.

  hoare abscsq.
  apply noabs_oslinv.
  apply absimp_taskcre_succ.
  go.

  hoare_assert_pure (GoodLInvAsrt OSLInv).
  unfold p_local in H21.
  unfold LINV in H21.
  sep normal in H21.
  sep split in H21.
  auto.
  instantiate (1 :=
                 EX x, (
                   POST [OS_SchedPost, nil, x,
                         logic_code (END Some (V$ NO_ERR)) :: nil, tid] **
                        LV err @ Int8u |-> (V$ OS_NO_ERR) **
                        LV prio @ Int8u |-> Vint32 v'42 **
                        LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
                        LV task @ (Void) ∗ |-> x1 **
                        A_dom_lenv
                        ((prio, Int8u)
                           :: (os_code_defs.pdata, (Void) ∗)
                           :: (task, (Void) ∗) :: (err, Int8u) :: nil)
                 )).

  hoare_assert_pure(exists new_tcbmod, TcbJoin v'34 (v'42, rdy, Vnull) v'14 new_tcbmod).

    unfold TcbJoin.
    eexists.
    eapply map_join_comm.

    unfold join; simpl.
    eapply TcbMod.join_sig_set.
    auto.
    intro.
    eapply (join_in_or H11) in H24.
    destruct H23.
    simpljoin.
    unfolds in H27.
    inverts H27.
    destruct H24.
    gen H23.
    eapply sometcblist_lemma.
    instantiate ( 8:= s0).
    sep cancel 13%nat 1%nat.
    sep cancel 14%nat 1%nat.
    eauto.
    eauto.

    gen H23.
    eapply sometcblist_lemma.
    instantiate ( 8:= s0).
    sep cancel 13%nat 1%nat.
    sep cancel 16%nat 1%nat.
    eauto.
    eapply  tcblist_p_hold_for_upd_1.
    eauto.

    simpljoin.
    unfolds in H26.
    inverts H26.

    destruct v'35.
    inverts H28.
    inverts H28.

    destruct H24.
    gen H24.
    eapply sometcblist_lemma.
    instantiate ( 8:= s0).
    sep cancel 13%nat 1%nat.
    sep cancel 14%nat 1%nat.
    eauto.
    eapply  tcblist_p_hold_for_upd_1.
    eauto.

    gen H24.
    eapply sometcblist_lemma.
    instantiate ( 8:= s0).
    sep cancel 13%nat 1%nat.
    sep cancel 16%nat 1%nat.
    eauto.
    eauto.
  hoare_split_pure_all.
  simpljoin.

  eapply backward_rule1.
  intro.
  Set Printing Depth 999.
  intros.

  instantiate (1 :=
    (<||
       scrt (x1 :: x0 :: Vint32 v'42 :: nil);;
       isched;; END Some (V$ NO_ERR)
       ||>  **
       (
       HECBList v'13 **
       HTime v'15 **
       AOSTCBFreeList v'24 v'25 **
       AOSMapTbl **
       GAarray OSTCBPrioTbl (Tarray OS_TCB ∗ 64)
       (update_nth_val (Z.to_nat (Int.unsigned v'42)) v'28 (Vptr v'34)) **
       G& OSPlaceHolder @ Int8u == v'43 **
       PV v'43 @ Int8u |-> v'45 **
       GV OSTCBList @ OS_TCB ∗ |-> Vptr v'34 **
       node (Vptr v'34) v'39 OS_TCB_flag **
       PV get_off_addr v'34 ($ 24) @ Int8u |-r-> (V$ 1) **
       tcbdllseg v'30 (Vptr v'34) v'32 (Vptr tid) v'36 **
       GV OSTCBCur @ OS_TCB ∗ |-r-> Vptr tid **
       tcbdllseg (Vptr tid) v'32 v'33 Vnull v'38 **
       AOSRdyTblGrp
       (update_nth_val (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26
                       (val_inj
                          (or
                             (nth_val' (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26)
                             (nth_val' (Z.to_nat (Int.unsigned (v'42&ᵢ$ 7)))
                                       OSMapVallist)))) v'41 **
       p_local OSLInv tid init_lg **

       LV err @ Int8u |-> (V$ OS_NO_ERR) **
       AOSEventFreeList v'0 **
       AOSQFreeList v'1 **
       AOSQFreeBlk v'2 **
       AECBList v'4 v'3 v'13 v'14 **
       AOSUnMapTbl **
       AOSIntNesting **
       AOSTime (Vint32 v'15) **
       AGVars **
       tcbdllflag v'30 (v'35 ++ v'9 :: v'10) **
       atoy_inv' **
       LV prio @ Int8u |-> Vint32 v'42 **
       LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
       LV task @ (Void) ∗ |-> x1 **
       A_dom_lenv
       ((prio, Int8u)
          :: (os_code_defs.pdata, (Void) ∗)
          :: (task, (Void) ∗) :: (err, Int8u) :: nil)
       ) **
       OSLInv v'34 init_lg **
       HTCBList v'14  **
       HCurTCB tid **
       OS [ empisr, false, nil, (true::nil)]
    )).
  remember (
       HECBList v'13 **
       HTime v'15 **
       AOSTCBFreeList v'24 v'25 **
       AOSMapTbl **
       GAarray OSTCBPrioTbl (Tarray OS_TCB ∗ 64)
         (update_nth_val (Z.to_nat (Int.unsigned v'42)) v'28 (Vptr v'34)) **
       G& OSPlaceHolder @ Int8u == v'43 **
       PV v'43 @ Int8u |-> v'45 **
       GV OSTCBList @ OS_TCB ∗ |-> Vptr v'34 **
       node (Vptr v'34) v'39 OS_TCB_flag **
       PV get_off_addr v'34 ($ 24) @ Int8u |-r-> (V$ 1) **
       tcbdllseg v'30 (Vptr v'34) v'32 (Vptr tid) v'36 **
       GV OSTCBCur @ OS_TCB ∗ |-r-> Vptr tid **
       tcbdllseg (Vptr tid) v'32 v'33 Vnull v'38 **
       AOSRdyTblGrp
         (update_nth_val (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26
            (val_inj
               (or (nth_val' (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26)
                  (nth_val' (Z.to_nat (Int.unsigned (v'42&ᵢ$ 7)))
                     OSMapVallist)))) v'41 **
       p_local OSLInv tid init_lg **
       LV err @ Int8u |-> (V$ OS_NO_ERR) **
       AOSEventFreeList v'0 **
       AOSQFreeList v'1 **
       AOSQFreeBlk v'2 **
       AECBList v'4 v'3 v'13 v'14 **
       AOSUnMapTbl **
       AOSIntNesting **
       AOSTime (Vint32 v'15) **
       AGVars **
       tcbdllflag v'30 (v'35 ++ v'9 :: v'10) **
       atoy_inv' **
       LV prio @ Int8u |-> Vint32 v'42 **
       LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
       LV task @ (Void) ∗ |-> x1 **
       A_dom_lenv
         ((prio, Int8u)
          :: (os_code_defs.pdata, (Void) ∗)
          :: (task, (Void) ∗) :: (err, Int8u) :: nil)).

  sep lifts (6::8:: nil)%nat.
  eapply elim_a_isr_is_prop.

  sep pauto.
  sep cancel Aisr.
  sep cancel Aie.
  sep cancel Ais.
  sep cancel Acs.
  sep cancel A_isr_is_prop.
  sep cancel 1%nat 1%nat.
  sep cancel 1%nat 1%nat.
  repeat sep cancel 2%nat 1%nat.
  repeat sep cancel 5%nat 3%nat.
  repeat sep cancel 4%nat 1%nat.
  unfold OSLInv.
  sep pauto.
  unfold init_lg.
  go.
  unfolds.
  left; auto.
  unfold scrt.

  eapply seq_rule.

  eapply cre_rule.
  assumption.
  go.
  unfold p_local.
  go.
  unfold CurTid.
  go.
  unfold LINV.
  go.
  unfold OSLInv.
  go.
  exact H21.
  clear -H4.
  unfolds in H4.
  simpljoin.
  unfolds.
  eauto.
  intro.
  intros.
  split.
  sep get rv.
  clear -H3.
  pauto.
  split.
  sep get rv.
  clear -H2.
  pauto.
  split.
  sep get rv.
  math simpls.
  apply len_lt_update_get_eq.
  rewrite H8.
  bsimplr.
  assumption.
  unfold CurLINV.
  unfold p_local in H26.
  sep pauto.
  sep cancel LINV.
  simpl; auto.
  eapply backward_rule1.
  intro; intros.
remember (
       HECBList v'13 **
       HTime v'15 **
       AOSTCBFreeList v'24 v'25 **
       AOSMapTbl **
       GAarray OSTCBPrioTbl (Tarray OS_TCB ∗ 64)
         (update_nth_val (Z.to_nat (Int.unsigned v'42)) v'28 (Vptr v'34)) **
       G& OSPlaceHolder @ Int8u == v'43 **
       PV v'43 @ Int8u |-> v'45 **
       GV OSTCBList @ OS_TCB ∗ |-> Vptr v'34 **
       node (Vptr v'34) v'39 OS_TCB_flag **
       PV get_off_addr v'34 ($ 24) @ Int8u |-r-> (V$ 1) **
       tcbdllseg v'30 (Vptr v'34) v'32 (Vptr tid) v'36 **
       GV OSTCBCur @ OS_TCB ∗ |-r-> Vptr tid **
       tcbdllseg (Vptr tid) v'32 v'33 Vnull v'38 **
       AOSRdyTblGrp
         (update_nth_val (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26
            (val_inj
               (or (nth_val' (Z.to_nat (Int.unsigned (v'42 >>ᵢ $ 3))) v'26)
                  (nth_val' (Z.to_nat (Int.unsigned (v'42&ᵢ$ 7)))
                     OSMapVallist)))) v'41 **
       p_local OSLInv tid init_lg **
       LV err @ Int8u |-> (V$ OS_NO_ERR) **
       AOSEventFreeList v'0 **
       AOSQFreeList v'1 **
       AOSQFreeBlk v'2 **
       AECBList v'4 v'3 v'13 v'14 **
       AOSUnMapTbl **
       AOSIntNesting **
       AOSTime (Vint32 v'15) **
       AGVars **
       tcbdllflag v'30 (v'35 ++ v'9 :: v'10) **
       atoy_inv' **
       LV prio @ Int8u |-> Vint32 v'42 **
       LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
       LV task @ (Void) ∗ |-> x1 **
       A_dom_lenv
         ((prio, Int8u)
          :: (os_code_defs.pdata, (Void) ∗)
          :: (task, (Void) ∗) :: (err, Int8u) :: nil)).

  sep lifts (5::7::nil)%nat in H26.

  eapply add_a_isr_is_prop in H26.
  subst a.
  eauto.

  (***** two part ******)
    destruct H23.
      simpljoin.

      unfold tcbls_change_prev_ptr in H27.
      inverts H27.

      hoare forward prim.
      unfold AOSTCBPrioTbl.
      unfold AOSTCBList.
      sep pauto.
      sep cancel 1%nat 5%nat.
      sep cancel 1%nat 3%nat.
      instantiate (1 :=  (LV err @ Int8u |-> (V$ OS_NO_ERR) **
                                  LV prio @ Int8u |-> Vint32 v'42 **
                                  LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
                                  LV task @ (Void) ∗ |-> x1 **
                                  A_dom_lenv
                                  ((prio, Int8u)
                                     :: (os_code_defs.pdata, (Void) ∗)
                                     :: (task, (Void) ∗) :: (err, Int8u) :: nil))).
      sep pauto.
      sep cancel A_dom_lenv.
      Focus 10.
      hoare forward.
      unfold init_lg in H23.
      sep cancel p_local.
      sep cancel Aie.
      sep cancel Ais.
      sep cancel Aisr.
      sep cancel Acs.
      sep cancel Aop.
      eauto.
      unfolds; auto.
      go.
      linv_solver.
      linv_solver.

      unfold AECBList in *.
      sep pauto.
      sep cancel 1%nat 1%nat.
      sep cancel 4%nat 2%nat.
      instantiate (1 := (v'39 ::nil ) ++ nil).
      eapply inv_prop.tcbdllseg_compose.
      sep cancel 3%nat 2%nat.
      change (  (((v'39 :: nil) ++ nil) ++ update_nth_val 1 v'9 (Vptr v'34) :: v'10) ) with (v'39 :: update_nth_val 1 v'9 (Vptr v'34) :: v'10) .
      unfold tcbdllseg.
      unfold dllseg.
      sep pauto.
      unfold tcbdllflag.
      remember ( update_nth_val 1 v'9 (Vptr v'34) :: v'10).
      unfold1 dllsegflag.
      sep pauto.
      sep cancel 1%nat 1%nat.
      change (nil ++ v'9 :: v'10) with (v'9 :: v'10) in H23.
      unfold tcbdllflag in H23.
      unfold dllsegflag in *.
      sep destruct H23.

      sep pauto.
      unfolds.
      eapply nth_upd_neqrev.
      omega.
      auto.
      clear -H18.
      unfolds in H18.
      simpljoin; auto.

      clear -H18.
      unfolds in H18.
      simpljoin; auto.

      clear -H18.
      unfolds in H18.
      simpljoin; auto.
      eapply ecblist_hold_for_add_tcb; eauto.

      assert (v'43 <> v'34).

        unfold node in H23.
        sep normal in H23.
        sep destruct H23.
        sep split in H23.
        simpljoin.
        inverts H27.
        intro.
        eapply struct_pv_overlap.
(* ** ac:         Show. *)
(* ** ac:         Show. *)
        rewrite H27 in H23.
        sep lift 4%nat in H23.
        sep lift 2%nat in H23.
        exact H23.

      eapply r_priotbl_p_hold_for_add_tcb; eauto.
      assumption.
(* ** ac:       Print TCBList_P. *)
      instantiate (1:= v'23).
      eapply tcblist_p_hold_for_add_tcb.
      clear -H9.
      int auto.
      clear -somehyp.
      unprotect somehyp.
      tauto.

      clear -somehyp.
      unprotect somehyp.
      tauto.

      assumption.

        clear -H7 H13 H11.
        unfolds in H7.
        simpljoin.
        intro.
        simpljoin.
        assert (get v'14 x = Some (v'42, x0, x1)).
        unfold get,join in *; simpl in *.
        go.

        lets bb: H0 H3.
        simpljoin.
        eapply nth_val_nth_val'_some_eq in H4.
        unfold nat_of_Z in H4.
        rewrite H4 in H13.
        inverts H13.

      instantiate (1:= (sig v'34 (v'42, rdy, Vnull))).
      eapply tcblist_p_hold_for_add_tcb''.
      clear -H9.
      int auto.
      clear -somehyp .
      unprotect somehyp.
      tauto.
      clear -somehyp .
      unprotect somehyp.
      tauto.
        instantiate (1 := v'22).
        intro.
        simpljoin.
        assert (get v'14 x = Some (v'42, x2, x3)).
        unfold get,join,sig in *; simpl in *.
        go.
        eapply not_in_priotbl_no_priotcb; eauto.
      eauto.
      auto.

      eapply TCBList_P_nil_empty in H12.
      subst v'22.
      clear.
      join auto.
      simpl in H12.
      subst v'22.
      assert (v'23 = v'14).
      clear -H11.
      join auto.
      subst v'14.
      assumption.
      unfolds.
      unfolds in H4.
      simpljoin.
      clear -H4 H21.
      do 3 eexists.
      unfold get in *; simpl in *.
      eapply TcbMod.join_get_get_r.
      exact H21.
      eauto.

      eapply rh_t_e_p_hold_for_add_tcb.
      eauto.
      eauto.
      go.
      assert (exists t, join (sig v'34 (v'42, rdy, Vnull)) v'22 t ).
      clear -H21 H11.
      unfold TcbJoin in H21.
      join auto.
      simpljoin.

      unfold tcbls_change_prev_ptr in H27.
      destruct v'35.
      clear -H23; tryfalse.
      inverts H27.

      hoare forward prim.
      unfold AOSTCBPrioTbl.
      unfold AOSTCBList.
      sep pauto.
      sep cancel 1%nat 5%nat.
      sep cancel 1%nat 3%nat.
      instantiate (1 :=  (LV err @ Int8u |-> (V$ OS_NO_ERR) **
                                  LV prio @ Int8u |-> Vint32 v'42 **
                                  LV os_code_defs.pdata @ (Void) ∗ |-> x0 **
                                  LV task @ (Void) ∗ |-> x1 **
                                  A_dom_lenv
                                  ((prio, Int8u)
                                     :: (os_code_defs.pdata, (Void) ∗)
                                     :: (task, (Void) ∗) :: (err, Int8u) :: nil))).
      sep pauto.
      sep cancel A_dom_lenv.
      Focus 10.
      hoare forward.
      unfold init_lg in H27.
      sep cancel p_local.
      sep cancel Aie.
      sep cancel Ais.
      sep cancel Aisr.
      sep cancel Acs.
      sep cancel Aop.
      eauto.
      unfolds; auto.
      go.
      linv_solver.
      linv_solver.

      unfold AECBList in *.
      sep pauto.
      sep cancel 1%nat 1%nat.
      sep cancel 4%nat 2%nat.
      instantiate (1 := (v'39 ::nil ) ++ ( (update_nth_val 1 v (Vptr v'34) :: v'35))).
      eapply inv_prop.tcbdllseg_compose.
      sep cancel 3%nat 2%nat.
      unfold tcbdllseg.
      unfold dllseg.
      sep pauto.
      unfold tcbdllflag.
      change ((v'39 :: nil) ++ update_nth_val 1 v (Vptr v'34) :: v'35) with (v'39 :: update_nth_val 1 v (Vptr v'34) :: v'35) .
      change (((v'39 :: update_nth_val 1 v (Vptr v'34) :: v'35) ++ v'9 :: v'10)) with (v'39 :: ((update_nth_val 1 v (Vptr v'34) :: v'35) ++ v'9 :: v'10)).
      remember ((update_nth_val 1 v (Vptr v'34) :: v'35) ++ v'9 :: v'10).

      unfold1 dllsegflag.
      sep pauto.
      sep cancel 1%nat 1%nat.
      change  ((update_nth_val 1 v (Vptr v'34) :: v'35) ++ v'9 :: v'10) with  (update_nth_val 1 v (Vptr v'34) :: v'35 ++ v'9::v'10).
      change ((v :: v'35) ++ v'9 :: v'10) with (v :: v'35 ++ v'9 :: v'10) in H27.
      unfold tcbdllflag in H27.
      unfold dllsegflag in *.
      sep destruct H27.

      sep pauto.
      unfolds.
      eapply nth_upd_neqrev.
      omega.
      auto.
      clear -H18.
      unfolds in H18.
      simpljoin; auto.

      clear -H18.
      unfolds in H18.
      simpljoin; auto.

      clear -H18.
      unfolds in H18.
      simpljoin; auto.

      eapply ecblist_hold_for_add_tcb; eauto.

      eapply r_priotbl_p_hold_for_add_tcb; eauto.
        unfold node in H27.
        sep normal in H27.
        sep destruct H27.
        sep split in H27.
        simpljoin.
        inverts H29.
        intro.
        eapply struct_pv_overlap.
        rewrite H29 in H27.
        sep lift 4%nat in H27.
        sep lift 2%nat in H27.
        exact H27.
      assumption.
      instantiate (1:= v'23).

      assert (exists x, nth_val 1 v'9 = Some x).
      clear -H14.
      unfold1 TCBList_P in H14.
      simpljoin.
      unfolds in H2.
      destruct x2; destruct p.
      simpljoin.
      unfolds in H2.
      destruct v'9.
      inverts H2.
      destruct v'9.
      inverts H2.
      eexists.
      simpl.
      eauto.
      simpljoin.
      erewrite (update_eq v'9).

      eapply tcblist_p_hold_for_add_tcb.
      clear -H9.
      int auto.
      clear -somehyp.
      unprotect somehyp.
      tauto.
      clear -somehyp.
      unprotect somehyp.
      tauto.
      assumption.
        clear -H7 H13 H11.
        unfolds in H7.
        simpljoin.
        intro.
        simpljoin.
        assert (get v'14 x = Some (v'42, x0, x1)).
        unfold get,join in *; simpl in *.
        go.

        lets bb: H0 H3.
        simpljoin.
        eapply nth_val_nth_val'_some_eq in H4.
        unfold nat_of_Z in H4.
        rewrite H4 in H13.
        inverts H13.

      eauto.

      instantiate (1 := x).
      eapply tcblist_p_hold_for_add_tcb''.
      clear -H9.
      int auto.
      clear -somehyp.
      unprotect somehyp.
      tauto.
      clear -somehyp.
      unprotect somehyp.
      tauto.
        instantiate (1 := v'22).
        intro.
        simpljoin.
        assert (get v'14 x2 = Some (v'42, x3, x4)).
        unfold get,join,sig in *; simpl in *.
        go.
        eapply not_in_priotbl_no_priotcb; eauto.

      eapply tcblist_p_hold_for_upd_1.
      eauto.
      eauto.
      go.
      clear -H21 H26 H11.
      unfold TcbJoin in H21.
      join auto.
      unfolds.
      unfolds in H4.
      simpljoin.
      clear -H4 H21.
      do 3 eexists.
      unfold get in *; simpl in *.
      eapply TcbMod.join_get_get_r.
      exact H21.
      eauto.

      eapply rh_t_e_p_hold_for_add_tcb.
      eauto.
      eauto.
      go.

  hoare forward.
  hoare unfold.
  unfold OS_SchedPost .
  unfold OS_SchedPost'.
  unfold getasrt.
  hoare unfold.
  hoare forward.
  inverts H21.
  reflexivity.
  hoare_split_pure_all.
  false.
  clear -H17.
  int auto.
  destruct H17; tryfalse.

  Grab Existential Variables.
  exact (Afalse).
  exact (Afalse).

Qed.


Require Import Raft.
Require Import SpecLemmas.

Require Import NoAppendEntriesToSelfInterface.

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

  Lemma doLeader_no_messages_to_self :
    forall st h os st' ms m,
      doLeader st h = (os, st', ms) ->
      In m ms ->
      fst m <> h.
  Proof using.
    intros.
    unfold doLeader in *.
    repeat break_match; try solve [find_inversion; simpl in *; congruence].
    find_inversion.
    do_in_map.
    subst. simpl in *.
    find_apply_lem_hyp filter_In.
    intuition. subst.
    break_match; congruence.
  Qed.

  Lemma no_append_entries_to_self_do_leader :
    raft_net_invariant_do_leader no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    do_in_map.
    subst. simpl in *.
    find_eapply_lem_hyp doLeader_no_messages_to_self; eauto.
  Qed.

  Lemma no_append_entries_to_self_do_generic_server :
    raft_net_invariant_do_generic_server no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    do_in_map.
    subst. simpl in *.
    find_eapply_lem_hyp doGenericServer_packets. subst. simpl in *. intuition.
  Qed.

  Lemma no_append_entries_to_self_append_entries :
    raft_net_invariant_append_entries no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    subst. simpl in *. subst.
    find_apply_lem_hyp handleAppendEntries_not_append_entries.
    intuition. find_false. repeat eexists; eauto.
  Qed.

  Lemma no_append_entries_to_self_append_entries_reply :
    raft_net_invariant_append_entries_reply no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    do_in_map. subst. simpl in *.
    find_apply_lem_hyp handleAppendEntriesReply_packets.
    subst. intuition.
  Qed.

  Lemma no_append_entries_to_self_request_vote :
    raft_net_invariant_request_vote no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    subst. simpl in *. subst.
    find_apply_lem_hyp handleRequestVote_no_append_entries.
    intuition. find_false. repeat eexists; eauto.
  Qed.

  Lemma no_append_entries_to_self_request_vote_reply :
    raft_net_invariant_request_vote_reply no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
  Qed.

  Lemma no_append_entries_to_self_client_request :
    raft_net_invariant_client_request no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    do_in_map. subst. simpl in *.
    find_eapply_lem_hyp handleClientRequest_no_append_entries; eauto.
    intuition. find_false. repeat eexists; eauto.
  Qed.

  Lemma no_append_entries_to_self_timeout :
    raft_net_invariant_timeout no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
    do_in_map. subst. simpl in *.
    find_eapply_lem_hyp handleTimeout_not_is_append_entries; eauto.
    intuition. find_false. repeat eexists; eauto.
  Qed.

  Lemma no_append_entries_to_self_state_same_packet_subset :
    raft_net_invariant_state_same_packet_subset no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_apply_hyp_hyp. intuition eauto.
  Qed.

  Lemma no_append_entries_to_self_reboot :
    raft_net_invariant_reboot no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *.
    find_reverse_rewrite. intuition eauto.
  Qed.

  Lemma no_append_entries_to_self_init :
    raft_net_invariant_init no_append_entries_to_self.
  Proof using.
    red. red. intros. simpl in *. intuition.
  Qed.

  Theorem no_append_entries_to_self_invariant :
    forall net,
      raft_intermediate_reachable net ->
      no_append_entries_to_self net.
  Proof using.
    intros.
    apply raft_net_invariant; auto.
    - apply no_append_entries_to_self_init.
    - apply no_append_entries_to_self_client_request.
    - apply no_append_entries_to_self_timeout.
    - apply no_append_entries_to_self_append_entries.
    - apply no_append_entries_to_self_append_entries_reply.
    - apply no_append_entries_to_self_request_vote.
    - apply no_append_entries_to_self_request_vote_reply.
    - apply no_append_entries_to_self_do_leader.
    - apply no_append_entries_to_self_do_generic_server.
    - apply no_append_entries_to_self_state_same_packet_subset.
    - apply no_append_entries_to_self_reboot.
  Qed.

  Instance noaetsi : no_append_entries_to_self_interface.
  split. exact no_append_entries_to_self_invariant.
  Qed.

End NoAppendEntriesToSelf.


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Recognition of combined operations, addressing modes and conditions
  during the [CSE] phase. *)

Require Import Coqlib.
Require Import AST.
Require Import Integers.
Require Import Values.
Require Import Memory.
Require Import Op.
Require Import Registers.
Require Import RTL.
Require Import CombineOp.
Require Import CSE.

Section COMBINE.

Variable ge: genv.
Variable sp: val.
Variable m: mem.
Variable get: valnum -> option rhs.
Variable valu: valnum -> val.
Hypothesis get_sound: forall v rhs, get v = Some rhs -> equation_holds valu ge sp m v rhs.

Lemma combine_compimm_ne_0_sound:
  forall x cond args,
  combine_compimm_ne_0 get x = Some(cond, args) ->
  eval_condition cond (map valu args) m = Val.cmp_bool Cne (valu x) (Vint Int.zero) /\
  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Cne (valu x) (Vint Int.zero).
Proof.
  intros until args. functional induction (combine_compimm_ne_0 get x); intros EQ; inv EQ.
  (* of cmp *)
  exploit get_sound; eauto. unfold equation_holds. simpl. intro EQ; inv EQ.
  destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto.
  (* of and *)
  exploit get_sound; eauto. unfold equation_holds; simpl.
  destruct args; try discriminate. destruct args; try discriminate. simpl.
  intros EQ; inv EQ. destruct (valu v); simpl; auto.
Qed.

Lemma combine_compimm_eq_0_sound:
  forall x cond args,
  combine_compimm_eq_0 get x = Some(cond, args) ->
  eval_condition cond (map valu args) m = Val.cmp_bool Ceq (valu x) (Vint Int.zero) /\
  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Ceq (valu x) (Vint Int.zero).
Proof.
  intros until args. functional induction (combine_compimm_eq_0 get x); intros EQ; inv EQ.
  (* of cmp *)
  exploit get_sound; eauto. unfold equation_holds. simpl. intro EQ; inv EQ.
  rewrite eval_negate_condition.
  destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto.
  (* of and *)
  exploit get_sound; eauto. unfold equation_holds; simpl.
  destruct args; try discriminate. destruct args; try discriminate. simpl.
  intros EQ; inv EQ. destruct (valu v); simpl; auto.
Qed.

Lemma combine_compimm_eq_1_sound:
  forall x cond args,
  combine_compimm_eq_1 get x = Some(cond, args) ->
  eval_condition cond (map valu args) m = Val.cmp_bool Ceq (valu x) (Vint Int.one) /\
  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Ceq (valu x) (Vint Int.one).
Proof.
  intros until args. functional induction (combine_compimm_eq_1 get x); intros EQ; inv EQ.
  (* of cmp *)
  exploit get_sound; eauto. unfold equation_holds. simpl. intro EQ; inv EQ.
  destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto.
Qed.

Lemma combine_compimm_ne_1_sound:
  forall x cond args,
  combine_compimm_ne_1 get x = Some(cond, args) ->
  eval_condition cond (map valu args) m = Val.cmp_bool Cne (valu x) (Vint Int.one) /\
  eval_condition cond (map valu args) m = Val.cmpu_bool (Mem.valid_pointer m) Cne (valu x) (Vint Int.one).
Proof.
  intros until args. functional induction (combine_compimm_ne_1 get x); intros EQ; inv EQ.
  (* of cmp *)
  exploit get_sound; eauto. unfold equation_holds. simpl. intro EQ; inv EQ.
  rewrite eval_negate_condition.
  destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto.
Qed.

Theorem combine_cond_sound:
  forall cond args cond' args',
  combine_cond get cond args = Some(cond', args') ->
  eval_condition cond' (map valu args') m = eval_condition cond (map valu args) m.
Proof.
  intros. functional inversion H; subst.
  (* compimm ne zero *)
  simpl; eapply combine_compimm_ne_0_sound; eauto.
  (* compimm ne one *)
  simpl; eapply combine_compimm_ne_1_sound; eauto.
  (* compimm eq zero *)
  simpl; eapply combine_compimm_eq_0_sound; eauto.
  (* compimm eq one *)
  simpl; eapply combine_compimm_eq_1_sound; eauto.
  (* compuimm ne zero *)
  simpl; eapply combine_compimm_ne_0_sound; eauto.
  (* compuimm ne one *)
  simpl; eapply combine_compimm_ne_1_sound; eauto.
  (* compuimm eq zero *)
  simpl; eapply combine_compimm_eq_0_sound; eauto.
  (* compuimm eq one *)
  simpl; eapply combine_compimm_eq_1_sound; eauto.
Qed.

Theorem combine_addr_sound:
  forall addr args addr' args',
  combine_addr get addr args = Some(addr', args') ->
  eval_addressing ge sp addr' (map valu args') = eval_addressing ge sp addr (map valu args).
Proof.
  intros. functional inversion H; subst.
  exploit get_sound; eauto. unfold equation_holds; simpl; intro EQ.
  assert (forall vl,
         eval_addressing ge sp (SelectOp.offset_addressing a n) vl =
         option_map (fun v => Val.add v (Vint n)) (eval_addressing ge sp a vl)).
    intros. destruct a; simpl; repeat (destruct vl; auto); simpl.
    rewrite Val.add_assoc. auto.
    repeat rewrite Val.add_assoc. auto.
    rewrite Val.add_assoc. auto.
    repeat rewrite Val.add_assoc. auto.
    unfold symbol_address. destruct (Globalenvs.Genv.find_symbol ge i); auto.
    unfold symbol_address. destruct (Globalenvs.Genv.find_symbol ge i); auto.
      repeat rewrite <- (Val.add_commut v). rewrite Val.add_assoc. auto.
    unfold symbol_address. destruct (Globalenvs.Genv.find_symbol ge i0); auto.
      repeat rewrite <- (Val.add_commut (Val.mul v (Vint i))). rewrite Val.add_assoc. auto.
    rewrite Val.add_assoc; auto.
  rewrite H0. rewrite EQ. auto.
Qed.

Theorem combine_op_sound:
  forall op args op' args',
  combine_op get op args = Some(op', args') ->
  eval_operation ge sp op' (map valu args') m = eval_operation ge sp op (map valu args) m.
Proof.
  intros. functional inversion H; subst.
(* lea *)
  simpl. eapply combine_addr_sound; eauto.
(* cmp *)
  simpl. decEq; decEq. eapply combine_cond_sound; eauto.
Qed.

End COMBINE.


Require Import VST.sepcomp.semantics.
Require Import VST.sepcomp.semantics_lemmas.
Require Import VST.sepcomp.mem_lemmas.
Require Import VST.veric.Clight_base.
Require Import VST.veric.Clight_core.

Lemma alloc_variables_mem_step: forall cenv vars m e e2 m'
      (M: alloc_variables cenv e m vars e2 m'), mem_step m m'.
Proof. intros.
  induction M.
  apply mem_step_refl.
  eapply semantics.mem_step_trans.
    eapply semantics.mem_step_alloc; eassumption. eassumption.
Qed.

Lemma assign_loc_mem_step g t m b z v m' (A:assign_loc g t m b z v m'):
    mem_step m m'.
Proof.
  inv A.
  { simpl in H0. eapply mem_step_storebytes. eapply Mem.store_storebytes; eauto. }
  { eapply mem_step_storebytes; eauto. }
Qed.

Lemma bind_parameters_mem_step: forall cenv e m pars vargs m'
      (M: bind_parameters cenv e m pars vargs m'), semantics.mem_step m m'.
Proof. intros.
  induction M.
  apply mem_step_refl.
  inv H0.
+ eapply semantics.mem_step_trans; try eassumption. simpl in H2.
  eapply mem_step_store; eassumption.
+ eapply semantics.mem_step_trans; try eassumption.
  eapply semantics.mem_step_storebytes; eassumption.
Qed.

Lemma inline_assembly_memstep: forall text sg g vargs m t vres m' (IA:Events.inline_assembly_sem text sg g vargs m t vres m'),
    mem_step m m'.
Admitted. (*Maybe include mem_step in Events.extcall_properties.?*)

Lemma extcall_sem_mem_step: forall name sg g vargs m t vres m' (E:Events.external_functions_sem name sg g vargs m t vres m'),
  mem_step m m'.
Admitted. (*Maybe include mem_step in Events.extcall_properties.?*)

Lemma extcall_mem_step g: forall ef vargs m t vres m' (E:Events.external_call ef g vargs m t vres m'),
  mem_step m m'.
Proof.
  destruct ef; simpl; intros; try solve [inv E; apply mem_step_refl].
  { eapply extcall_sem_mem_step; eassumption. }
  { eapply extcall_sem_mem_step; eassumption. }
  { eapply extcall_sem_mem_step; eassumption. }
  { inv E. inv H. eapply mem_step_refl.
    apply Mem.store_storebytes in H1. eapply mem_step_storebytes. eassumption. }
  { inv E. apply Mem.store_storebytes in H0.
    eapply mem_step_trans. eapply mem_step_alloc; eassumption.
    eapply mem_step_storebytes; eassumption. }
  { inv E. eapply mem_step_free; eassumption. }
  { inv E. eapply mem_step_storebytes. eassumption. }
  { eapply inline_assembly_memstep; eassumption. }
Qed.

Lemma CLC_corestep_mem:
  forall (g : genv) c (m : mem) c'  (m' : mem),
    semantics.corestep (cl_core_sem g) c m c' m' ->
    semantics.mem_step m m'.
Proof. simpl; intros. inv H; simpl in *;
  try apply mem_step_refl.
   eapply assign_loc_mem_step; eauto.
   eapply mem_step_freelist; eauto.
   eapply mem_step_freelist; eauto.
   eapply mem_step_freelist; eauto.
   inv H0.
   eapply alloc_variables_mem_step; eauto.
   apply extcall_mem_step in H1; auto.
Qed.

Program Definition CLC_memsem  (ge : Clight.genv) :
  @MemSem state.
apply Build_MemSem with (csem := cl_core_sem ge).
eapply CLC_corestep_mem.
Defined.

(*
Lemma assign_loc_forward:
      forall cenv t m b ofs v m'
      (A: assign_loc cenv t m b ofs v m'),
      mem_forward m m'.
Proof.
intros.
induction A.
 unfold Mem.storev in H0.
 eapply store_forward; eassumption.
 eapply storebytes_forward; eassumption.
Qed.

Lemma alloc_variables_forward: forall cenv vars m e e2 m'
      (M: alloc_variables cenv e m vars e2 m'),
      mem_forward m m'.
Proof. intros.
  induction M.
  apply mem_forward_refl.
  apply alloc_forward in H.
  eapply mem_forward_trans; eassumption.
Qed.

Lemma cln_forward: forall (g : genv) (c : corestate)
  (m : mem) (c' : corestate) (m' : mem),
  corestep cl_core_sem g c m c' m' -> mem_forward m m'.
Proof.
intros.
induction H; try apply mem_forward_refl; trivial.
  eapply assign_loc_forward; eassumption.
  eapply alloc_variables_forward; eassumption.
  eapply freelist_forward; eassumption.
Qed.
Program Definition CLN_coop_sem :
  CoopCoreSem Clight.genv (*(Genv.t fundef type)*) corestate.
apply Build_CoopCoreSem with (coopsem := cl_core_sem).
apply cln_forward.
admit. (*This is the new readonly condition which should be easy to prove.*)
Admitted.
*)


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 Language.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import MemoryFacts.
Require Import TView.
Require Import Local.
Require Import Thread.

Require Import MemoryReorder.
Require Import PromiseConsistent.
Require Import FulfillStep.

Set Implicit Arguments.

Lemma reorder_promise_read
      lc0 mem0
      lc1 mem1
      lc2
      loc1 from1 to1 msg1 kind1
      loc2 to2 val2 released2 ord2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.read_step lc1 mem1 loc2 to2 val2 released2 ord2 lc2)
      (LOCAL0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (LOCTS: (loc1, to1) <> (loc2, to2)):
  exists lc1',
    <<STEP1: Local.read_step lc0 mem0 loc2 to2 val2 released2 ord2 lc1'>> /\
    <<STEP2: Local.promise_step lc1' mem0 loc1 from1 to1 msg1 lc2 mem1 kind1>>.
Proof.
  inv STEP1. inv STEP2.
  hexploit MemoryFacts.promise_get_inv_diff; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_promise_promise_lower_None
      lc0 mem0
      lc1 mem1
      lc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 val2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.promise_step lc1 mem1 loc2 from2 to2 (Message.concrete val2 None) lc2 mem2 kind2)
      (LOCAL0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (KIND1: Memory.op_kind_is_cancel kind1 = false)
      (KIND2: Memory.op_kind_is_lower kind2 = true):
  (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ Message.le (Message.concrete val2 None) msg1 /\ kind2 = Memory.op_kind_lower msg1 /\
   exists kind1', <<STEP: Local.promise_step lc0 mem0 loc1 from1 to1 (Message.concrete val2 None) lc2 mem2 kind1'>>) \/
  (exists lc1' mem1' from2' kind1',
      <<STEP1: Local.promise_step lc0 mem0 loc2 from2' to2 (Message.concrete val2 None) lc1' mem1' kind2>> /\
      <<STEP2: Local.promise_step lc1' mem1' loc1 from1 to1 msg1 lc2 mem2 kind1'>>).
Proof.
  inv STEP1. inv STEP2. ss.
  inv PROMISE0; inv KIND2. des. subst.
  inv PROMISE; ss.
  - exploit MemoryReorder.add_lower; try exact PROMISES0; try exact PROMISES; eauto. i. des.
    + subst.
      exploit MemoryReorder.add_lower; try exact MEM1; try exact MEM; eauto. i. des; [|congr].
      left. esplits; ss.
      * inv MEM. inv LOWER. ss.
      * econs; eauto. econs; eauto.
        i. inv MEM. inv LOWER. inv MSG_LE; ss; eauto.
        eapply ATTACH; eauto. ss.
    + exploit MemoryReorder.add_lower; try exact MEM1; try exact MEM; eauto. i. des; [congr|].
      right. esplits; eauto; econs; eauto.
      * econs; eauto.
        i. revert GET.
        erewrite Memory.lower_o; eauto. condtac; ss.
        { i. des. subst. inv GET.
          exploit Memory.lower_get0; try exact MEM. i. des.
          revert GET. erewrite Memory.add_o; eauto. condtac; ss; eauto.
          des. subst. inv MEM. inv LOWER. timetac. }
        { i. exploit Memory.lower_get1; try exact GET; eauto. }
      * eapply Memory.lower_closed_message; eauto.
  - des. subst.
    destruct (classic ((loc1, ts3) = (loc2, to2))).
    { inv H.
      exploit MemoryReorder.split_lower_same; try exact PROMISES0; try exact PROMISES; eauto. i. des.
      exploit MemoryReorder.split_lower_same; try exact MEM1; try exact MEM; eauto. i. des.
      subst. right. esplits; eauto; econs; eauto.
      eapply Memory.lower_closed_message; eauto.
    }
    { exploit MemoryReorder.split_lower_diff; try exact PROMISES0; try exact PROMISES; eauto. i. des.
      - subst.
        exploit MemoryReorder.split_lower_diff; try exact MEM1; try exact MEM; eauto. i. des; [|congr].
        left. esplits; eauto. inv MEM. inv LOWER. ss.
      - exploit MemoryReorder.split_lower_diff; try exact MEM1; try exact MEM; eauto. i. des; [congr|].
        right. esplits; eauto; econs; eauto.
        eapply Memory.lower_closed_message; eauto.
    }
  - des. subst.
    exploit MemoryReorder.lower_lower; try exact PROMISES0; try exact PROMISES; eauto. i. des.
    + subst.
      exploit MemoryReorder.lower_lower; try exact MEM1; try exact MEM; eauto. i. des; [|congr].
      left. esplits; eauto. inv MEM. inv LOWER. ss.
    + exploit MemoryReorder.lower_lower; try exact MEM1; try exact MEM; eauto. i. des; [congr|].
      right. esplits; eauto; econs; eauto.
      eapply Memory.lower_closed_message; cycle 1; eauto.
Qed.

Lemma reorder_promise_promise_cancel
      lc0 mem0
      lc1 mem1
      lc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 msg2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.promise_step lc1 mem1 loc2 from2 to2 msg2 lc2 mem2 kind2)
      (KIND2: Memory.op_kind_is_cancel kind2 = true):
  (loc1 = loc2 /\ from1 = from2 /\ to1 = to2 /\ msg1 = Message.reserve /\ kind1 = Memory.op_kind_add /\
   lc0 = lc2 /\ mem0 = mem2) \/
  (exists lc1' mem1',
      <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem1' kind2>> /\
      <<STEP2: Local.promise_step lc1' mem1' loc1 from1 to1 msg1 lc2 mem2 kind1>>).
Proof.
  inv STEP1. inv STEP2. ss. destruct kind2; ss.
  exploit MemoryReorder.promise_cancel; try exact PROMISE; eauto. i. des.
  - left. splits; auto. destruct lc0; ss. subst. ss.
  - right. esplits.
    + econs; eauto.
      inv CANCEL1. eapply Memory.cancel_closed_message; eauto.
    + econs; eauto.
      inv PROMISE0. eapply Memory.cancel_closed_message; eauto.
Qed.

Lemma reorder_promise_promise
      lc0 mem0
      lc1 mem1
      lc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 msg2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.promise_step lc1 mem1 loc2 from2 to2 msg2 lc2 mem2 kind2)
      (REL_CLOSED: forall promises1' mem1' kind1'
                     (PROMISE1: Memory.promise (Local.promises lc0) mem0 loc2 from2 to2 msg2 promises1' mem1' kind1'),
          Memory.closed_message msg2 mem1')
      (LOCAL0: Local.wf lc0 mem0)
      (CLOSED0: Memory.closed mem0)
      (KIND1: Memory.op_kind_is_cancel kind1 = false)
      (MSG2: msg2 <> Message.reserve)
      (LOCTS1: forall to1' msg1'
                (LOC: loc1 = loc2)
                (KIND: kind1 = Memory.op_kind_split to1' msg1'),
          to1' <> to2 /\
          (forall msg2', kind2 <> Memory.op_kind_split to1' msg2'))
      (LOCTS2: forall (LOC: loc1 = loc2)
                 (KIND1: kind1 = Memory.op_kind_add)
                 (KIND2: kind2 = Memory.op_kind_add)
                 (MSG1: msg1 <> Message.reserve),
               Time.lt to2 to1):
  exists lc1' mem1' kind2',
    <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem1' kind2'>> /\
    <<STEP2: __guard__
               ((lc2, mem2, loc1, from1, to1) = (lc1', mem1', loc2, from2, to2) \/
                (exists from1' kind1',
                    (loc1, to1) <> (loc2, to2) /\
                    (forall to1' msg1'
                       (LOC: loc1 = loc2)
                       (KIND: kind1' = Memory.op_kind_split to1' msg1'),
                        to1' <> to2 /\
                        (forall msg2', kind2 <> Memory.op_kind_split to1' msg2')) /\
                    Local.promise_step lc1' mem1' loc1 from1' to1 msg1 lc2 mem2 kind1' /\
                    Memory.op_kind_is_cancel kind1' = false /\
                    (Memory.op_kind_is_lower kind1 = false -> Memory.op_kind_is_lower kind1' = false))
               )>> /\
    <<KIND2: kind2 = Memory.op_kind_add -> kind2' = Memory.op_kind_add>>.
Proof.
  inv STEP1. inv STEP2. ss.
  inv PROMISE; ss.
  { inv PROMISE0; ss.
    - (* add/add *)
      exploit MemoryReorder.add_add; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      exploit MemoryReorder.add_add; try exact MEM; try exact MEM0; eauto. i. des.
      esplits.
      + cut (Memory.promise (Local.promises lc0) mem0 loc2 from2 to2 msg2
                            mem1' mem1'0 Memory.op_kind_add).
        { i. econs; eauto. }
        econs; eauto; try congr.
        i. exploit Memory.add_get1; try exact MEM; eauto.
      + right. esplits; eauto. econs; eauto.
        * econs; eauto. i. revert GET.
          erewrite Memory.add_o; eauto. condtac; ss; eauto.
          i. des. inv GET.
          exploit LOCTS2; eauto. intros x.
          inv ADD0. inv ADD. rewrite x in TO. timetac.
        * eapply Memory.add_closed_message; cycle 1; eauto.
      + auto.
    - (* add/split *)
      exploit MemoryReorder.add_split; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      + subst.
        exploit MemoryReorder.add_split; try exact MEM; try exact MEM0; eauto. i. des; [|congr].
        esplits.
        * cut (Memory.promise (Local.promises lc0) mem0 loc2 from2 to2 msg2
                              mem1' mem1'0 Memory.op_kind_add).
          { i. econs; eauto. }
          econs; eauto; try congr.
          i. exploit Memory.add_get1; try exact GET; try exact MEM. i.
          exploit Memory.add_get0; try exact MEM. i. des.
          clear GET GET0.
          exploit Memory.get_ts; try exact x4. i. des.
          { subst. inv ADD0. inv ADD. inv TO. }
          exploit Memory.get_ts; try exact GET1. i. des.
          { subst. inv ADD3. inv ADD. inv TO. }
          exploit Memory.get_disjoint; [exact x4|exact GET1|..]. i. des.
          { subst. inv ADD0. inv ADD. timetac. }
          destruct (TimeFacts.le_lt_dec to' ts3).
          { apply (x7 to'); econs; ss; try refl.
            inv ADD0. inv ADD. etrans; eauto. }
          { apply (x7 ts3); econs; ss; try refl.
            - inv ADD3. inv ADD. ss.
            - econs. ss. }
        * right. esplits; eauto.
          { ii. inv H. inv ADD3. inv ADD. timetac. }
          { econs.
            - econs; eauto.
              i. revert GET.
              erewrite Memory.add_o; eauto. condtac; ss; eauto. i. des. inv GET.
              inv ADD0. inv ADD. inv ADD3. inv ADD. rewrite TO in TO0. timetac.
            - eapply Memory.split_closed_message; eauto.
            - auto. }
        * auto.
      + exploit MemoryReorder.add_split; try exact MEM; try exact MEM0; eauto. i. des; [congr|].
        esplits.
        * econs.
          { econs 2; eauto. }
          { eapply REL_CLOSED. econs 2; eauto. }
          { auto. }
        * right. esplits; eauto.
          { ii. inv H. exploit Memory.split_get0; try exact MEM0; eauto. i. des.
            revert GET. erewrite Memory.add_o; eauto. condtac; ss. des; congr. }
          { econs; eauto.
            - econs; eauto.
              i. revert GET.
              erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
              + i. des. inv GET.
                exploit Memory.split_get0; try exact MEM0. i. des.
                revert GET0. erewrite Memory.add_o; eauto. condtac; ss; eauto.
                i. des. inv GET0.
                inv MEM0. inv SPLIT. rewrite TS12 in TS23. timetac.
              + guardH o. i. des. inv GET.
                exploit Memory.split_get0; try exact SPLIT0. i. des.
                exploit Memory.add_get0; try exact ADD0. i. des.
                exploit Memory.add_get1; try exact GET1; eauto. i.
                clear GET GET0 GET1 GET2 GET3.
                exploit Memory.get_ts; try exact GET4. i. des.
                { subst. inv SPLIT0. inv SPLIT. inv TS12. }
                exploit Memory.get_ts; try exact x0. i. des.
                { subst. inv ADD0. inv ADD. inv TO. }
                exploit Memory.get_disjoint; [exact GET4|exact x0|..]. i. des.
                { subst. exploit Memory.split_get0; try exact SPLIT0. i. des.
                  inv ADD0. inv ADD.
                  hexploit DISJOINT; try eapply GET1. i.
                  apply (H to1); econs; ss; try refl. }
                apply (x3 to1); econs; ss; try refl.
            - eapply Memory.split_closed_message; eauto. }
        * auto.
    - (* add/lower *)
      des. subst.
      exploit MemoryReorder.add_lower; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      + subst.
        exploit MemoryReorder.add_lower; try exact MEM; try exact MEM0; eauto. i. des; [|congr].
        esplits.
        * econs; eauto. econs; eauto.
          i. inv MEM0. inv LOWER. inv MSG_LE; ss; eauto.
          eapply ATTACH; eauto. ss.
        * left. auto.
        * auto.
      + exploit MemoryReorder.add_lower; try exact MEM; try exact MEM0; eauto. i. des; [congr|].
        esplits.
        * econs; eauto.
        * right. esplits; eauto. econs; eauto.
          { econs; eauto.
            i. revert GET.
            erewrite Memory.lower_o; eauto. condtac; ss; eauto.
            i. des. inv GET.
            exploit Memory.lower_get0; try exact LOWER0. i. des. eauto. }
          { eapply Memory.lower_closed_message; eauto. }
        * auto.
  }

  { des. subst. inv PROMISE0; ss.
    - (* split/add *)
      exploit MemoryReorder.split_add; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      exploit MemoryReorder.split_add; try exact MEM; try exact MEM0; eauto. i. des.
      esplits.
      + cut (Memory.promise (Local.promises lc0) mem0 loc2 from2 to2 msg2
                            mem1' mem1'0 Memory.op_kind_add).
        { i. econs; eauto. }
        econs; eauto; try congr.
        i. exploit Memory.split_get1; try exact GET; eauto. i. des.
        dup GET2. revert GET2.
        erewrite Memory.split_o; eauto. repeat condtac; ss.
        * i. des. inv GET2.
          exploit Memory.split_get0; try exact MEM. i. des.
          rewrite GET in *. ss.
        * guardH o. i. des. inv GET2.
          exploit Memory.split_get0; try exact MEM. i. des.
          rewrite GET in *. inv GET2. eauto.
        * i. rewrite GET in *. inv GET2. eauto.
      + right. esplits; eauto. econs; eauto.
        eapply Memory.add_closed_message; eauto.
      + auto.
    - (* split/split *)
      des.
      exploit MemoryReorder.split_split; try exact PROMISES; try exact PROMISES0; eauto.
      { ii. inv H. eapply LOCTS1; eauto. }
      i. des.
      + subst. exploit MemoryReorder.split_split; try exact MEM; try exact MEM0; eauto.
        { ii. inv H. inv SPLIT2. inv SPLIT. timetac. }
        i. des; [|congr].
        esplits.
        * econs.
          { econs 2; eauto. }
          { eapply REL_CLOSED. econs 2; eauto. }
          { auto. }
        * right. esplits; eauto.
          { ii. inv H. inv SPLIT2. inv SPLIT. timetac. }
          { econs; eauto.
            eapply Memory.split_closed_message; cycle 1; eauto. }
        * congr.
      + exploit MemoryReorder.split_split; try exact MEM; try exact MEM0; eauto.
        { ii. inv H. eapply LOCTS1; eauto. }
        i. des; [congr|].
        esplits.
        * econs.
          { econs 2; eauto. }
          { eapply REL_CLOSED. econs 2; eauto. }
          { auto. }
        * right. esplits; eauto.
          { ii. inv H. exploit Memory.split_get0; try exact MEM1; eauto. i. des.
            revert GET. erewrite Memory.split_o; eauto. repeat condtac; ss.
            guardH o0. des; congr. }
          { econs; eauto.
            eapply Memory.split_closed_message; cycle 1; eauto. }
        * auto.
    - (* split/lower *)
      des. subst.
      exploit MemoryReorder.split_lower_diff; try exact PROMISES; try exact PROMISES0; eauto.
      { ii. inv H. exploit LOCTS1; eauto. i. des. congr. }
      i. des.
      + subst.
        exploit MemoryReorder.split_lower_diff; try exact MEM; try exact MEM0; eauto.
        { ii. inv H. exploit LOCTS1; eauto. i. des. congr. }
        i. des; [|congr].
        esplits.
        * econs.
          { econs 2; eauto. }
          { eapply REL_CLOSED. econs 2; eauto. }
          { auto. }
        * left. auto.
        * congr.
      + subst. exploit MemoryReorder.split_lower_diff; try exact MEM; try exact MEM0; eauto.
        { ii. inv H. exploit LOCTS1; eauto. i. des. congr. }
        i. des; [congr|].
        esplits.
        * econs; eauto.
        * right. esplits; eauto. econs; eauto.
          eapply Memory.lower_closed_message; eauto.
        * congr.
  }

  { des. subst. inv PROMISE0; ss.
    - (* lower/add *)
      exploit MemoryReorder.lower_add; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      exploit MemoryReorder.lower_add; try exact MEM; try exact MEM0; eauto. i. des.
      esplits.
      + cut (Memory.promise (Local.promises lc0) mem0 loc2 from2 to2 msg2
                            mem1' mem1'0 Memory.op_kind_add).
        { i. econs; eauto. }
        econs; eauto; try congr.
        i. exploit Memory.lower_get1; try exact GET; eauto. i. des. eauto.
      + right. esplits; eauto. econs; eauto.
        eapply Memory.add_closed_message; eauto.
      + auto.
    - (* lower/split *)
      des.
      exploit MemoryReorder.lower_split; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      exploit MemoryReorder.lower_split; try exact MEM; try exact MEM0; eauto. i. des.
      unguardH FROM1. des.
      + inv FROM1. unguardH FROM0. des; [|congr]. inv FROM0.
        esplits.
        * econs.
          { econs 2; eauto. inv LOWER0. inv LOWER. inv MSG_LE; ss. }
          { eapply REL_CLOSED. econs 2; eauto.
            inv LOWER0. inv LOWER. inv MSG_LE; ss. }
          { auto. }
        * right. esplits; eauto.
          { ii. inv H. inv SPLIT1. inv SPLIT. timetac. }
          { econs; eauto. eapply Memory.split_closed_message; eauto. }
        * congr.
      + inv FROM2. unguardH FROM0. des; [congr|]. inv FROM2.
        esplits.
        * econs.
          { econs 2; eauto. }
          { eapply REL_CLOSED. econs 2; eauto. }
          { auto. }
        * right. esplits; eauto.
          { ii. inv H. exploit Memory.lower_get0; try exact MEM; eauto.
            exploit Memory.split_get0; try exact SPLIT0; eauto. i. des. congr. }
          { econs; eauto. eapply Memory.split_closed_message; eauto. }
        * auto.
    - (* lower/lower *)
      des. subst.
      exploit MemoryReorder.lower_lower; try exact PROMISES; try exact PROMISES0; eauto. i. des.
      + subst.
        exploit MemoryReorder.lower_lower; try exact MEM; try exact MEM0; eauto. i. des; [|congr].
        esplits.
        * econs; eauto.
        * left. auto.
        * congr.
      + exploit MemoryReorder.lower_lower; try exact MEM; try exact MEM0; eauto. i. des; [congr|].
        esplits.
        * econs; eauto.
        * right. esplits; eauto. econs; eauto.
          eapply Memory.lower_closed_message; cycle 1; eauto.
        * auto.
  }
Qed.

Lemma reorder_promise_fulfill
      lc0 sc0 mem0
      lc1 mem1
      lc2 sc2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: fulfill_step lc1 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2)
      (LOCAL0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (LOCTS1: (loc1, to1) <> (loc2, to2))
      (LOCTS2: forall to1' msg1'
                 (LOC: loc1 = loc2)
                 (KIND: kind1 = Memory.op_kind_split to1' msg1'),
          to1' <> to2):
  exists lc1',
    <<STEP1: fulfill_step lc0 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc2>> /\
    <<STEP2: Local.promise_step lc1' mem0 loc1 from1 to1 msg1 lc2 mem1 kind1>>.
Proof.
  inv STEP1. inv STEP2. ss.
  inv PROMISE; ss.
  - exploit MemoryReorder.add_remove; try exact REMOVE; eauto. i. des.
    esplits.
    + econs; eauto.
    + econs; ss. econs; ss.
  - exploit MemoryReorder.split_remove; try exact PROMISES; try exact REMOVE; eauto.
    { ii. inv H. eapply LOCTS2; eauto. }
    i. des.
    esplits.
    + econs; eauto.
    + econs; ss. econs; ss; eauto.
  - des. subst.
    exploit MemoryReorder.lower_remove; try exact REMOVE; eauto. i. des.
    esplits.
    + econs; eauto.
    + econs; ss. econs; eauto.
  - exploit MemoryReorder.remove_remove; try exact PROMISES; eauto. i. des.
    esplits.
    + econs; eauto.
    + econs; ss. econs; ss.
Qed.

Lemma promise_step_nonsynch_loc_inv
      lc1 mem1 loc from to msg lc2 mem2 kind l
      (WF1: Local.wf lc1 mem1)
      (STEP: Local.promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
      (NONPF: Memory.op_kind_is_lower kind = false \/ ~ Message.is_released_none msg)
      (NONSYNCH: Memory.nonsynch_loc l lc2.(Local.promises)):
  Memory.nonsynch_loc l lc1.(Local.promises).
Proof.
  guardH NONPF.
  ii. inv STEP. inv PROMISE; ss.
  - exploit Memory.add_get1; try exact GET; eauto. i. des.
    exploit NONSYNCH; eauto.
  - exploit Memory.split_get1; try exact GET; eauto. i. des.
    exploit NONSYNCH; eauto.
  - exploit Memory.lower_o; try exact PROMISES; eauto.
    instantiate (1 := t). instantiate (1 := l). condtac; ss.
    + i. des. subst. exploit NONSYNCH; eauto.
      destruct msg; destruct msg0; ss.
      * i. subst. unguard. des; ss.
      * exploit Memory.lower_get0; try exact PROMISES. i. des.
        rewrite GET0 in *. inv GET. inv MSG_LE.
    + rewrite GET. i. exploit NONSYNCH; eauto.
  - exploit Memory.remove_get1; try exact GET; eauto. i. des.
    + subst. exploit Memory.remove_get0; try exact PROMISES. i. des.
      rewrite GET0 in GET. inv GET. ss.
    + exploit NONSYNCH; eauto.
Qed.

Lemma reorder_promise_write_aux
      lc0 sc0 mem0
      lc1 mem1
      lc2 sc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 val2 releasedm2 released2 ord2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.write_step lc1 sc0 mem1 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2 mem2 kind2)
      (NONPF: Memory.op_kind_is_lower kind1 = false \/ ~ Message.is_released_none msg1)
      (REL_WF: View.opt_wf releasedm2)
      (REL_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (LOCAL0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (KIND1: Memory.op_kind_is_cancel kind1 = false)
      (LOCTS1: forall to1' msg1'
                (LOC: loc1 = loc2)
                (KIND: kind1 = Memory.op_kind_split to1' msg1'),
          to1' <> to2 /\
          (forall msg2', kind2 <> Memory.op_kind_split to1' msg2'))
      (LOCTS2: forall (LOC: loc1 = loc2)
                 (KIND1: kind1 = Memory.op_kind_add)
                 (KIND2: kind2 = Memory.op_kind_add)
                 (MSG1: msg1 <> Message.reserve),
               Time.lt to2 to1):
  exists kind2' lc1' mem1',
    <<STEP1: Local.write_step lc0 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc2 mem1' kind2'>> /\
    <<STEP2: __guard__
               ((lc2, mem2, loc1, from1, to1) = (lc1', mem1', loc2, from2, to2) \/
                ((loc1, to1) <> (loc2, to2) /\
                 exists from1' kind1',
                   <<STEP2: Local.promise_step lc1' mem1' loc1 from1' to1 msg1 lc2 mem2 kind1'>>))>> /\
    <<KIND2: kind2 = Memory.op_kind_add -> kind2' = Memory.op_kind_add>>.
Proof.
  guardH NONPF.
  exploit Local.promise_step_future; eauto. i. des.
  exploit write_promise_fulfill; eauto; try by viewtac. i. des.
  exploit reorder_promise_promise; try exact STEP1; eauto; ss.
  { i. subst.
    exploit Memory.promise_op; eauto. i.
    econs. eapply TViewFacts.op_closed_released; try exact x0; eauto.
    inv STEP1. apply LOCAL0.
  }
  i. des.
  unguardH STEP5. des.
  - inv STEP5.
    exploit promise_fulfill_write; try exact STEP4; eauto.
    { i. hexploit ORD; eauto. i.
      eapply promise_step_nonsynch_loc_inv; try exact STEP1; eauto.
    }
    { inv STEP1. ss. }
    i. esplits; eauto. left; eauto.
  - exploit Local.promise_step_future; try exact STEP4; eauto. i. des.
    exploit reorder_promise_fulfill; try exact STEP6; eauto.
    { i. eapply STEP6; eauto. }
    i. des.
    exploit fulfill_step_future; try exact STEP7; try exact WF0; eauto; try by viewtac. i. des.
    exploit promise_fulfill_write; try exact STEP4; eauto; try by viewtac.
    { i. hexploit ORD; eauto. i.
      eapply promise_step_nonsynch_loc_inv; try exact STEP1; eauto.
    }
    { subst. inv STEP1. ss. }
    i. esplits; eauto. right. esplits; eauto.
Qed.

Lemma reorder_promise_write
      lc0 sc0 mem0
      lc1 mem1
      lc2 sc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 val2 releasedm2 released2 ord2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.write_step lc1 sc0 mem1 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2 mem2 kind2)
      (NONPF: Memory.op_kind_is_lower kind1 = false \/ ~ Message.is_released_none msg1)
      (REL_WF: View.opt_wf releasedm2)
      (REL_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (LOCAL0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (KIND1: Memory.op_kind_is_cancel kind1 = false)
      (CONS: Local.promise_consistent lc2):
  (exists kind2' lc1' mem1',
     <<STEP1: Local.write_step lc0 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc2 mem1' kind2'>> /\
     <<STEP2: __guard__
                ((lc2, mem2, loc1, from1, to1) = (lc1', mem1', loc2, from2, to2) \/
                 ((loc1, to1) <> (loc2, to2) /\
                  exists from1' kind1', <<STEP2: Local.promise_step lc1' mem1' loc1 from1' to1 msg1 lc2 mem2 kind1'>>))>> /\
     <<KIND2: kind2 = Memory.op_kind_add -> kind2' = Memory.op_kind_add>>).
Proof.
  guardH NONPF. eapply reorder_promise_write_aux; eauto.
  { i. subst. split.
    - ii. subst. ss. inv STEP1.
      exploit Memory.promise_get2; eauto. i. des. inv PROMISE.
      exploit promise_consistent_promise_write; eauto; try by destruct msg1. i.
      inv MEM. inv SPLIT. timetac.
    - ii. subst. ss. inv STEP1.
      exploit Memory.promise_get2; eauto. i. des. inv PROMISE.
      exploit promise_consistent_promise_write; eauto. i.
      exploit Memory.split_get0; try exact PROMISES. i. des.
      inv STEP2. ss. inv WRITE. inv PROMISE.
      exploit Memory.split_get0; try exact PROMISES0. i. des.
      rewrite GET2 in *. inv GET4.
      inv MEM1. inv SPLIT. timetac. }
  { i. subst. inv STEP1. inv PROMISE.
    exploit Memory.add_get0; try exact PROMISES. i. des.
    exploit promise_consistent_promise_write; try exact GET0; eauto; ss. i.
    inv x0; ss. inv H.
    inv STEP2. inv WRITE. inv PROMISE. ss.
    exploit Memory.add_get0; try exact MEM. i. des.
    exploit Memory.add_get0; try exact MEM1. i. des. congr. }
Qed.

Lemma reorder_promise_write_memory
      promises0 mem0
      promises1 mem1
      promises2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 msg2 kind2
      (PROMISE: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 kind1)
      (WRITE: Memory.write promises1 mem1 loc2 from2 to2 msg2 promises2 mem2 kind2)
      (NONPF: Memory.op_kind_is_cancel kind1 = false)
      (CONS: forall f t m
               (GET: Memory.get loc2 t promises2 = Some (f, m))
               (RESERVE: m <> Message.reserve),
          Time.lt to2 t):
  exists kind2' promises1' mem1',
    (<<WRITE: Memory.write promises0 mem0 loc2 from2 to2 msg2 promises1' mem1' kind2'>>) /\
    (<<PROMISE: __guard__
                  ((promises2, mem2, loc1) = (promises1', mem1', loc2) \/
                   (exists from1' kind1',
                       Memory.promise promises1' mem1' loc1 from1' to1 msg1 promises2 mem2 kind1' /\
                       Memory.op_kind_is_cancel kind1' = false))>>).
Proof.
  exploit Memory.write_not_cancel; eauto. intro KIND2.
  inv WRITE. inv PROMISE; inv PROMISE0; ss.
  { (* add-add *)
    exploit MemoryReorder.add_add; try exact PROMISES; eauto. i. des.
    exploit MemoryReorder.add_add; try exact MEM; eauto. i. des.
    exploit MemoryReorder.add_remove; try exact ADD2; eauto. i. des.
    esplits.
    - econs; eauto. econs 1; eauto. i.
      exploit Memory.add_get1; try exact MEM; eauto.
    - right. esplits.
      + econs 1; eauto. i.
        revert GET. erewrite Memory.add_o; eauto. condtac; ss; eauto.
        i. des. inv GET.
        exploit Memory.add_get0; try exact ADD4. i. des.
        exploit CONS; eauto. intros x.
        inv MEM0. inv ADD. rewrite x in TO. timetac.
      + ss.
  }

  { (* add-split *)
    exploit MemoryReorder.add_split; try exact PROMISES; eauto. i.
    exploit MemoryReorder.add_split; try exact MEM; eauto. i.
    des; subst; ss.
    { clear x1 x2 x3 x4.
      exploit MemoryReorder.add_remove; try exact ADD3; eauto.
      { ii. inv H. inv ADD3. inv ADD. timetac. }
      i. des. esplits.
      - econs; eauto. econs 1; eauto. i.
        exploit Memory.split_get0; try exact MEM0. i. des.
        exploit Memory.add_get1; try exact MEM; eauto. i.
        exploit Memory.get_disjoint; [exact GET1|exact x0|]. i. des.
        + subst. inv ADD0. inv ADD. timetac.
        + inv MEM0. inv SPLIT.
          destruct (TimeFacts.le_lt_dec ts3 to').
          * apply (x1 ts3); econs; ss; try refl. etrans; eauto.
          * apply (x1 to'); econs; ss; try refl.
            { exploit Memory.get_ts; try exact x0. i. des.
              - subst. timetac.
              - etrans; eauto.
            }
            { econs. ss. }
            { exploit Memory.get_ts; try exact x0. i. des; ss.
              subst. inv TS12.
            }
      - right. esplits.
        + econs 1; eauto. i.
          exploit Memory.add_get1; try exact GET; eauto.
          erewrite Memory.split_o; eauto. repeat (condtac; ss).
          { i. des. inv x0.
            inv MEM0. inv SPLIT. rewrite TS12 in TS23. timetac. }
          { guardH o. i. des. inv x0.
            inv MEM0. inv SPLIT. timetac. }
          guardH o. guardH o0.
          erewrite Memory.add_o; eauto. condtac; ss; eauto.
        + ss.
    }
    { exploit MemoryReorder.add_remove; try exact ADD0; try exact REMOVE; eauto.
      { ii. inv H.
        exploit Memory.add_get0; try exact PROMISES. i. des.
        exploit Memory.split_get0; try exact PROMISES0. i. des.
        exploit Memory.get_disjoint; [exact GET0|exact GET2|]. i. des.
        { subst. inv MEM0. inv SPLIT. timetac. }
        inv MEM0. inv SPLIT. apply (x0 to2); econs; ss; try refl.
        - inv MEM. inv ADD. ss.
        - econs. ss.
      }
      i. des. esplits; eauto.
      right. esplits.
      - econs 1; eauto. i. revert GET.
        erewrite Memory.split_o; eauto. repeat (condtac; ss); eauto.
        + i. des. inv GET.
          exploit Memory.split_get0; try exact MEM0. i. des. revert GET0.
          erewrite Memory.add_o; eauto. condtac; ss; eauto.
          i. des. inv GET0. inv MEM. inv ADD. timetac.
        + guardH o. i. des. inv GET.
          exploit Memory.add_get0; try exact MEM. i. des.
          exploit Memory.split_get0; try exact MEM0. i. des. congr.
      - ss.
    }
  }

  { (* add-lower *)
    exploit MemoryReorder.add_lower; try exact PROMISES; eauto. i.
    exploit MemoryReorder.add_lower; try exact MEM; eauto. i.
    des; subst; ss.
    { clear x1 x2 x3 x4.
      exploit Memory.add_get0; try exact x9. intros x. des.
      exploit Memory.remove_exists; try exact GET0. i. des.
      esplits.
      - econs; try exact x0. econs 1; eauto. i.
        eapply ATTACH; eauto. ii. subst.
        inv MEM0. inv LOWER. inv MSG_LE. ss.
      - left. f_equal. f_equal.
        apply Memory.ext. i.
        erewrite (@Memory.remove_o promises2); eauto.
        erewrite (@Memory.remove_o mem3); eauto.
    }
    { exploit MemoryReorder.add_remove; try exact ADD0; eauto. i. des.
      esplits; eauto. right. esplits.
      - econs 1; eauto. i. revert GET.
        erewrite Memory.lower_o; eauto. condtac; ss; eauto.
        i. des. inv GET.
        exploit Memory.add_get0; try exact PROMISES. i. des.
        exploit Memory.lower_get1; try exact GET0; eauto. i. des.
        exploit Memory.remove_get1; try exact GET2; eauto. i. des; subst; ss.
        exploit CONS; try exact GET1; eauto.
        { ii. subst. inv MSG_LE. ss. }
        intros x. inv PROMISES0. inv LOWER. rewrite TS1 in x. timetac.
      - ss.
    }
  }

  { (* split-add *)
    exploit MemoryReorder.split_add; try exact PROMISES; eauto. i. des.
    exploit MemoryReorder.split_add; try exact MEM; eauto. i. des.
    exploit MemoryReorder.split_remove; try exact SPLIT2; eauto. i. des.
    esplits.
    - econs; eauto. econs 1; eauto. i.
      destruct (Memory.get loc2 to' mem1) as [[]|] eqn:GET'; cycle 1.
      { revert GET'. erewrite Memory.split_o; eauto.
        repeat condtac; ss. congr.
      }
      exploit Memory.split_get0; try exact MEM. i. des.
      dup GET'. revert GET'. erewrite Memory.split_o; eauto.
      repeat (condtac; ss).
      + i. des. inv GET'. congr.
      + guardH o. i. des. inv GET'.
        rewrite GET in *. inv GET1. eauto.
      + i. rewrite GET in *. inv GET'. eauto.
    - right. esplits; eauto.
  }

  { (* split-split *)
    assert (LOCTS: (loc1, ts3) <> (loc2, ts0)).
    { ii. inv H.
      exploit Memory.split_get0; try exact PROMISES. intros x. des.
      exploit Memory.split_get0; try exact PROMISES0. intros x. des.
      rewrite GET2 in *. inv GET4.
      destruct (Memory.get loc2 from2 promises2) as [[]|] eqn:GET'.
      { exploit CONS; try exact GET'.
        - ii. subst. revert GET'.
          erewrite Memory.remove_o; eauto. condtac; ss. guardH o.
          erewrite Memory.split_o; eauto. repeat (condtac; ss); eauto.
          + guardH o0. i. des. inv GET'. ss.
          + guardH o0. guardH o1. i. rewrite GET' in *. inv GET1. ss.
        - intros x. inv PROMISES0. inv SPLIT. rewrite x in TS12. timetac.
      }
      { revert GET'. erewrite Memory.remove_o; eauto. condtac; ss.
        - des. subst. inv MEM0. inv SPLIT. timetac.
        - erewrite Memory.split_o; eauto. repeat (condtac; ss); eauto. congr.
      }
    }
    exploit MemoryReorder.split_split; try exact PROMISES; eauto. i.
    exploit MemoryReorder.split_split; try exact MEM; eauto. i.
    des; subst; ss.
    - exploit MemoryReorder.split_remove; try exact SPLIT3; try exact REMOVE; eauto.
      { ii. inv H. inv MEM0. inv SPLIT. timetac. }
      { ii. inv H. inv MEM. inv SPLIT. inv MEM0. inv SPLIT.
        rewrite TS23 in TS2. timetac. }
      i. des. esplits; eauto.
      right. esplits; eauto.
    - exploit MemoryReorder.split_remove; try exact SPLIT3; try exact REMOVE; eauto.
      { ii. inv H.
        exploit Memory.split_get0; try exact MEM. i. des.
        exploit Memory.split_get0; try exact MEM0. i. des. congr. }
      { ii. inv H.
        exploit Memory.split_get0; try exact MEM. i. des.
        exploit Memory.split_get0; try exact MEM0. i. des. congr. }
      i. des. esplits; eauto.
      right. esplits; eauto.
  }

  { (* split-lower *)
    destruct (classic ((loc1, ts3) = (loc2, to2))).
    { inv H. exfalso.
      exploit Memory.split_get0; try exact PROMISES. i. des.
      destruct (Memory.get loc2 to1 promises2) as [[]|] eqn:GET'.
      { dup GET'. revert GET'.
        erewrite Memory.remove_o; eauto. condtac; ss.
        erewrite Memory.lower_o; eauto. condtac; ss.
        i. rewrite GET' in *. inv GET1.
        exploit CONS; try exact GET'0; eauto. intros x.
        inv MEM. inv SPLIT. rewrite x in TS23. timetac.
      }
      { revert GET'.
        erewrite Memory.remove_o; eauto. condtac; ss.
        - des. subst. inv MEM. inv SPLIT. timetac.
        - erewrite Memory.lower_o; eauto. condtac; ss. congr.
      }
    }
    exploit MemoryReorder.split_lower_diff; try exact PROMISES; eauto. i.
    exploit MemoryReorder.split_lower_diff; try exact MEM; eauto. i.
    des; subst; ss.
    - clear x1 x2 x3 x4. esplits; eauto. left. ss.
    - exploit MemoryReorder.split_remove; try exact SPLIT0; eauto. i. des.
      esplits; eauto.
      right. esplits; eauto.
  }

  { (* lower-add *)
    exploit MemoryReorder.lower_add; try exact PROMISES; eauto. i. des.
    exploit MemoryReorder.lower_add; try exact MEM; eauto. i. des.
    exploit MemoryReorder.lower_remove; try exact LOWER2; eauto. i. des.
    esplits.
    - econs; eauto. econs 1; eauto. i.
      exploit Memory.lower_get1; try exact GET; eauto. i. des.
      eapply ATTACH; try exact GET2; eauto.
    - right. esplits; eauto.
  }

  { (* lower-split *)
    exploit MemoryReorder.lower_split; try exact PROMISES; eauto. i.
    exploit MemoryReorder.lower_split; try exact MEM; eauto. i.
    unguardH x0. unguardH x1. des; try inv FROM0; try inv FROM1; ss.
    { exploit MemoryReorder.lower_remove; try exact LOWER0; eauto.
      { ii. inv H. inv SPLIT0. inv SPLIT. timetac. }
      i. des. esplits.
      - econs; eauto. econs 2; eauto. ii. subst.
        inv MEM. inv LOWER. inv MSG_LE. ss.
      - right. esplits; eauto.
    }
    { inv FROM3. inv FROM2.
      exploit MemoryReorder.lower_remove; try exact LOWER0; try exact REMOVE; eauto.
      { ii. inv H.
        exploit Memory.lower_get0; try exact MEM. i. des.
        exploit Memory.split_get0; try exact MEM0. i. des. congr.
      }
      i. des. esplits; eauto. right. eauto.
    }
  }

  { (* lower-lower *)
    exploit MemoryReorder.lower_lower; try exact PROMISES; eauto. i.
    exploit MemoryReorder.lower_lower; try exact MEM; eauto. i.
    des; subst; ss.
    { esplits; eauto. left. ss. }
    { exploit MemoryReorder.lower_remove; try exact LOWER3; eauto. i. des.
      esplits; eauto. right. eauto.
    }
  }
Qed.

Lemma write_promise_consistent
      ts
      promises1 mem1 loc from to msg promises2 mem2 kind
      (WRITE: Memory.write promises1 mem1 loc from to msg promises2 mem2 kind)
      (CONS: forall f t m
               (GET: Memory.get loc t promises2 = Some (f, m))
               (RESERVE: m <> Message.reserve),
          Time.lt to t)
      (TS: Time.lt ts to):
  forall f t m
    (GET: Memory.get loc t promises1 = Some (f, m))
    (RESERVE: m <> Message.reserve),
    Time.lt ts t.
Proof.
  exploit Memory.write_not_cancel; eauto. i.
  inv WRITE. inv PROMISE; ss; i.
  - exploit Memory.add_get1; try exact GET; eauto. i.
    exploit Memory.remove_get1; try exact x1; eauto. i. des.
    { subst. exploit Memory.add_get0; try exact PROMISES. i. des. congr. }
    exploit CONS; try exact GET2; eauto.
  - exploit Memory.split_get1; try exact GET; eauto. i. des.
    exploit Memory.remove_get1; try exact GET2; eauto. i. des.
    { subst. exploit Memory.split_get0; try exact PROMISES. i. des. congr. }
    exploit CONS; try exact GET0; eauto.
  - exploit Memory.lower_get1; try exact GET; eauto. i. des.
    exploit Memory.remove_get1; try exact GET2; eauto. i. des.
    { subst. exploit Memory.lower_get0; try exact PROMISES. i. des. congr. }
    exploit CONS; try exact GET0; eauto.
    { ii. subst. inv MSG_LE. ss. }
Qed.

Lemma write_na_promise_consistent
      ts promises1 mem1 loc from to val promises2 mem2 msgs kinds kind
      (WRITE: Memory.write_na ts promises1 mem1 loc from to val promises2 mem2 msgs kinds kind)
      (CONS: forall f t m
               (GET: Memory.get loc t promises2 = Some (f, m))
               (RESERVE: m <> Message.reserve),
          Time.lt to t):
  forall f t m
    (GET: Memory.get loc t promises1 = Some (f, m))
    (RESERVE: m <> Message.reserve),
    Time.lt ts t.
Proof.
  induction WRITE; eauto using write_promise_consistent.
Qed.

Lemma reorder_promise_write_na_memory
      promises0 mem0
      promises1 mem1
      promises2 mem2
      loc1 from1 to1 msg1 kind1
      ts loc2 from2 to2 val2 msgs2 kinds2 kind2
      (PROMISE: Memory.promise promises0 mem0 loc1 from1 to1 msg1 promises1 mem1 kind1)
      (WRITE: Memory.write_na ts promises1 mem1 loc2 from2 to2 val2 promises2 mem2 msgs2 kinds2 kind2)
      (NONPF: Memory.op_kind_is_cancel kind1 = false)
      (CONS: forall f t m
               (GET: Memory.get loc2 t promises2 = Some (f, m))
               (RESERVE: m <> Message.reserve),
          Time.lt to2 t):
  exists kinds2' kind2' promises1' mem1',
    <<WRITE: Memory.write_na ts promises0 mem0 loc2 from2 to2 val2 promises1' mem1' msgs2 kinds2' kind2'>> /\
    (<<PROMISE: __guard__
                  ((promises2, mem2, loc1) = (promises1', mem1', loc2) \/
                   (exists from1' kind1',
                       Memory.promise promises1' mem1' loc1 from1' to1 msg1 promises2 mem2 kind1'))>>).
Proof.
  revert promises0 mem0 loc1 from1 to1 msg1 kind1 PROMISE NONPF.
  induction WRITE; i.
  { exploit reorder_promise_write_memory; eauto. i. des.
    esplits; eauto.
    unguardH PROMISE0. des; [left|right]; eauto.
    }
  exploit reorder_promise_write_memory; try exact PROMISE; eauto.
  { eapply write_na_promise_consistent; eauto. }
  i. unguardH x0. des.
  { inv PROMISE0. esplits; eauto. left. ss. }
  exploit IHWRITE; try exact PROMISE0; eauto.
  intros x. unguardH x. des.
  - inv PROMISE1. esplits; eauto. left. ss.
  - esplits; eauto. right. esplits; eauto.
Qed.

Lemma reorder_promise_write_na
      lc0 sc0 mem0
      lc1 mem1
      lc2 sc2 mem2
      loc1 from1 to1 msg1 kind1
      loc2 from2 to2 val2 ord2 msgs2 kinds2 kind2
      (STEP1: Local.promise_step lc0 mem0 loc1 from1 to1 msg1 lc1 mem1 kind1)
      (STEP2: Local.write_na_step lc1 sc0 mem1 loc2 from2 to2 val2 ord2 lc2 sc2 mem2 msgs2 kinds2 kind2)
      (NONPF: Memory.op_kind_is_cancel kind1 = false)
      (LOCAL0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (CONS: Local.promise_consistent lc2):
  (exists kinds2' kind2' lc1' mem1',
     <<STEP1: Local.write_na_step lc0 sc0 mem0 loc2 from2 to2 val2 ord2 lc1' sc2 mem1' msgs2 kinds2' kind2'>> /\
     <<STEP2: __guard__
                ((lc2, mem2, loc1) = (lc1', mem1', loc2) \/
                 (exists from1' kind1',
                     <<STEP2: Local.promise_step lc1' mem1' loc1 from1' to1 msg1 lc2 mem2 kind1'>>))>>).
Proof.
  exploit Local.promise_step_future; eauto. i. des.
  exploit Local.write_na_step_future; eauto. i. des.
  inv STEP1. inv STEP2. ss.
  exploit reorder_promise_write_na_memory; eauto.
  { i. exploit CONS; eauto. s. i.
    eapply TimeFacts.le_lt_lt; eauto.
    unfold TimeMap.join, TimeMap.singleton, Loc.LocFun.add, Loc.LocFun.find.
    condtac; ss. apply Time.join_r.
  }
  i. des. esplits; eauto.
  unguardH PROMISE0. des.
  - inv PROMISE0. left. ss.
  - right. esplits. econs; eauto.
    eapply Memory.future_closed_message; eauto.
Qed.

#[export] Hint Constructors Thread.program_step: core.
#[export] Hint Constructors Thread.step: core.

Lemma reorder_nonpf_program
      lang
      e1 e2 th0 th1 th2
      (STEP1: @Thread.step lang false e1 th0 th1)
      (STEP2: Thread.program_step e2 th1 th2)
      (CONS2: Local.promise_consistent (Thread.local th2))
      (LOCAL: Local.wf (Thread.local th0) (Thread.memory th0))
      (SC: Memory.closed_timemap (Thread.sc th0) (Thread.memory th0))
      (MEMORY: Memory.closed (Thread.memory th0)):
  exists th1',
     <<STEP1: Thread.program_step e2 th0 th1'>> /\
     <<STEP2: __guard__ (th2 = th1' \/ exists pf2' e2', Thread.promise_step pf2' e2' th1' th2)>>.
Proof.
  exploit Thread.step_future; eauto. i. des.
  inv STEP1. inv STEP. ss. inv STEP2. inv LOCAL1; ss.
  - (* silent *)
    esplits; eauto.
    right. esplits. econs; eauto.
  - (* read *)
    exploit reorder_promise_read; try exact LOCAL0; eauto; try by viewtac.
    { ii. inv H.
      inv LOCAL0. exploit Memory.promise_get2; eauto.
      { destruct kind, msg; ss. }
      i. des.
      dup LOCAL2. inv LOCAL0. ss.
      rewrite GET in *. inv GET_MEM.
      hexploit promise_consistent_promise_read; eauto. i. timetac.
    }
    i. des. esplits.
    + econs; eauto.
    + right. esplits. econs; eauto.
  - (* write *)
    exploit reorder_promise_write; try exact LOCAL0; eauto.
    { destruct kind, msg; ss; eauto. repeat condtac; ss; eauto. }
    { destruct kind, msg; ss. }
    i. des. esplits.
    + econs; eauto.
    + unguardH STEP2. des.
      * inv STEP2. left. auto.
      * right. esplits. econs; eauto.
  - (* update *)
    exploit reorder_promise_read; try exact LOCAL1; eauto; try by viewtac.
    { ii. inv H.
      inv LOCAL0. exploit Memory.promise_get2; eauto.
      { destruct kind, msg; ss. }
      i. des.
      dup LOCAL2. inv LOCAL0. ss.
      rewrite GET in *. inv GET_MEM.
      exploit promise_consistent_promise_read; eauto.
      { eapply write_step_promise_consistent; eauto. }
      i. eapply Time.lt_strorder. eauto.
    }
    i. des.
    exploit Local.read_step_future; eauto. i. des.
    exploit reorder_promise_write; try exact LOCAL2; eauto; try by viewtac.
    { destruct kind, msg; ss; eauto. repeat condtac; ss; eauto. }
    { destruct kind, msg; ss. }
    i. des. esplits.
    + econs; eauto.
    + unguardH STEP3. des.
      * inv STEP3. left. auto.
      * right. esplits. econs; eauto.
  - (* fence *)
    inv LOCAL0. inv LOCAL2.
    esplits; eauto.
    + econs; eauto. econs 5; eauto. econs; eauto; cycle 1.
      { i. subst. ss. erewrite PROMISES in *; eauto.
        eapply Memory.ext. i. erewrite Memory.bot_get.
        destruct (Memory.get loc0 ts (Local.promises lc1)) as [[from0 msg0]|] eqn:GET; auto.
        eapply Memory.promise_get1_promise in GET; try apply PROMISE.
        { des. erewrite Memory.bot_get in *. ss. }
        { destruct kind; ss. }
      }
      ss. intros ORDW l. eapply promise_step_nonsynch_loc_inv; eauto.
      * destruct msg, kind; ss; eauto. repeat condtac; ss; eauto.
      * apply RELEASE. ss.
    + right. esplits. econs; eauto.
  - (* syscall *)
    inv LOCAL0. inv LOCAL2.
    esplits; eauto.
    + econs; eauto. econs 6; eauto. econs; eauto; cycle 1.
      { i. subst. ss. erewrite PROMISES in *; eauto.
        eapply Memory.ext. i. erewrite Memory.bot_get.
        destruct (Memory.get loc0 ts (Local.promises lc1)) as [[from0 msg0]|] eqn:GET; auto.
        eapply Memory.promise_get1_promise in GET; try apply PROMISE.
        { des. erewrite Memory.bot_get in *. ss. }
        { destruct kind; ss. }
      }
      intros ORDW l. eapply promise_step_nonsynch_loc_inv; eauto.
      * destruct msg, kind; ss; eauto. repeat condtac; ss; eauto.
      * apply RELEASE. ss.
    + right. esplits. econs; eauto.
  - (* failure *)
    inv LOCAL2.
    hexploit promise_step_promise_consistent; eauto. i.
    esplits; eauto.
    right. esplits. econs; eauto.
  - (* na write *)
    exploit reorder_promise_write_na; try exact LOCAL0; eauto.
    { destruct kind, msg; ss. }
    i. des. esplits.
    + econs; eauto.
    + unguardH STEP2. des.
      * inv STEP2. left. auto.
      * right. esplits. econs; eauto.
  - (* racy read *)
    inv LOCAL0. inv LOCAL2. inv RACE. ss.
    exploit MemoryFacts.promise_get_inv_diff; try exact PROMISE; eauto.
    { ii. inv H.
      exploit Memory.promise_get2; try exact PROMISE; try by (destruct kind; ss). i. des. congr. }
    i. des.
    destruct (Memory.get loc0 to0 lc1.(Local.promises)) as [[]|] eqn:GETP1.
    { exploit Memory.promise_get1_promise; eauto; try by (destruct kind; ss). i. des. congr. }
    esplits; eauto. right. esplits. econs; eauto.
  - (* racy write *)
    inv LOCAL0. inv LOCAL2. inv RACE. ss.
    hexploit promise_step_promise_consistent; eauto. i.
    exploit MemoryFacts.promise_get_inv_diff; try exact PROMISE; eauto.
    { ii. inv H0.
      exploit Memory.promise_get2; try exact PROMISE; try by (destruct kind; ss). i. des. congr. }
    i. des.
    destruct (Memory.get loc0 to0 lc1.(Local.promises)) as [[]|] eqn:GETP1.
    { exploit Memory.promise_get1_promise; eauto; try by (destruct kind; ss). i. des. congr. }
    esplits; eauto. right. esplits. econs; eauto.
  - (* racy update *)
    hexploit promise_step_promise_consistent; eauto. i.
    inv LOCAL0. inv LOCAL2; ss.
    { esplits; eauto. right. esplits. econs; eauto. }
    { esplits; eauto. right. esplits. econs; eauto. }
    inv RACE. ss.
    exploit MemoryFacts.promise_get_inv_diff; try exact PROMISE; eauto.
    { ii. inv H0.
      exploit Memory.promise_get2; try exact PROMISE; try by (destruct kind; ss). i. des. congr. }
    i. des.
    destruct (Memory.get loc0 to0 lc1.(Local.promises)) as [[]|] eqn:GETP1.
    { exploit Memory.promise_get1_promise; eauto; try by (destruct kind; ss). i. des. congr. }
    esplits; eauto.
    right. esplits. econs; eauto.
Qed.

Lemma reorder_nonpf_pf
      lang
      e1 e2 th0 th1 th2
      (STEP1: @Thread.step lang false e1 th0 th1)
      (STEP2: Thread.step true e2 th1 th2)
      (CONS2: Local.promise_consistent (Thread.local th2))
      (LOCAL: Local.wf (Thread.local th0) (Thread.memory th0))
      (SC: Memory.closed_timemap (Thread.sc th0) (Thread.memory th0))
      (MEMORY: Memory.closed (Thread.memory th0)):
  (th0 = th2) \/
  (exists pf2' e2',
      <<STEP: Thread.step pf2' e2' th0 th2>> /\
      <<EVENT: __guard__ (e2' = e2 \/ (ThreadEvent.is_promising e2' /\ ThreadEvent.is_promising e2))>>) \/
  (exists e2' pf1' e1' th1',
      <<STEP1: Thread.step true e2' th0 th1'>> /\
      <<STEP2: Thread.promise_step pf1' e1' th1' th2>> /\
      <<EVENT: __guard__ (e2' = e2 \/ (ThreadEvent.is_promising e2' /\ ThreadEvent.is_promising e2))>>).
Proof.
  inv STEP2; ss.
  - inv STEP. ss.
    inv STEP1. inv STEP. ss.
    destruct kind; ss.
    + destruct msg1, msg; ss; cycle 1.
      { inv LOCAL0. inv PROMISE. inv MEM. inv LOWER. inv MSG_LE. }
      { inv LOCAL0. inv PROMISE. inv MEM. inv LOWER. inv MSG_LE. }
      destruct released0; ss.
      exploit reorder_promise_promise_lower_None; eauto.
      { destruct kind0; ss. }
      i. des; subst.
      * right. left. esplits.
        { econs 1. econs; eauto. }
        { right. ss. }
      * right. right. esplits.
        { econs 1. econs; eauto. }
        { econs; eauto. }
        { right. ss. }
    + exploit reorder_promise_promise_cancel; eauto.
      i. des; subst; eauto.
      right. right. esplits.
      { econs 1. econs; eauto. }
      { econs; eauto. }
      { right. ss. }
  - exploit reorder_nonpf_program; eauto. i. des.
    unguardH STEP2. des.
    + subst. right. left. esplits; eauto. left. ss.
    + right. right. esplits; eauto. left. ss.
Qed.