Require Import floyd.proofauto.
Import ListNotations.
Local Open Scope logic.

Require Import hmacdrbg.entropy.
Require Import hmacdrbg.entropy_lemmas.
Require Import hmacdrbg.hmac_drbg.
Require Import hmacdrbg.DRBG_functions.
Require Import hmacdrbg.HMAC_DRBG_algorithms.
Require Import hmacdrbg.spec_hmac_drbg.
Require Import hmacdrbg.spec_hmac_drbg_pure_lemmas.
Require Import hmacdrbg.HMAC_DRBG_common_lemmas.

Definition my_fold_right {A B} (f : B -> A -> A) (a : A):=
fix my_fold_right (l : list B) : A :=
  match l with
  | [] => a
  | b :: t => f b (my_fold_right t)
  end.
Lemma my_fold_right_eq {A B} (f : B -> A -> A) a: my_fold_right f a = fold_right f a.
Proof. extensionality l. induction l; auto. Qed.

Lemma FRZL_ax' ps: FRZL ps = my_fold_right sepcon emp ps.
Proof. rewrite FRZL_ax. rewrite my_fold_right_eq. trivial. Qed.

(*Tactic requires the resulting goal to be normalized manually.*)
Ltac my_thaw' name :=
  rewrite (FRZL_ax' name); unfold name, abbreviate; clear name.

(*add simplification of the list operations inside the freezer,
   flatten the sepcon, and eliminate the emp term*)
Ltac my_thaw name :=
  my_thaw' name; simpl nat_of_Z; unfold my_delete_nth, my_nth, my_fold_right;
  repeat flatten_sepcon_in_SEP; repeat flatten_emp.

Lemma isptrD v: isptr v -> exists b ofs, v = Vptr b ofs.
Proof. intros. destruct v; try contradiction. eexists; eexists; reflexivity. Qed.

Lemma REST: forall (Espec : OracleKind) (contents : list Z) additional add_len ctx
  md_ctx' V' reseed_counter' entropy_len' prediction_resistance' reseed_interval'
  key V reseed_counter entropy_len prediction_resistance reseed_interval kv
  info_contents (s : ENTROPY.stream)
(*Delta_specs := abbreviate : PTree.t funspec*)
  seed
  (XH : 0 <= add_len <= Int.max_unsigned)
  (XH0 : Zlength V = 32)
  (XH1 : add_len = Zlength contents)
  (contents' : list Z)
  (Heqcontents' : contents' = contents_with_add additional add_len contents)
  (ELc' : 0 < entropy_len + Zlength contents' (* <= 384*))
(*  (ELc' : 0 < entropy_len + Zlength contents (* <= 384*))*)
  (XH3 : Forall general_lemmas.isbyteZ V)
  (XH4 : Forall general_lemmas.isbyteZ contents)
  (XH5 : map Vint (map Int.repr V) = V')
  (XH6 : Vint (Int.repr reseed_counter) = reseed_counter')
  (XH7 : Vint (Int.repr entropy_len) = entropy_len')
  (XH8 : Vint (Int.repr reseed_interval) = reseed_interval')
  (XH9 : Val.of_bool prediction_resistance = prediction_resistance')
  (PNadditional : is_pointer_or_null additional)
  (Pctx : isptr ctx)
  (ELnonneg : 0 <= entropy_len)
  (ZLc' : Zlength contents' = 0 \/ Zlength contents' = Zlength contents)
  (*(H10 : zlt 256 add_len = false)
  (H11 : zlt 384 (entropy_len + add_len) = false)*)
  (Hfield : field_compatible (tarray tuchar 384) [] seed)
  (AL256 : (add_len >? 256) = false)
  (EAL384 : (entropy_len + add_len >? 384) = false)
  (entropy_bytes : list Z)
  (s0 : ENTROPY.stream)
  (Heqentropy_result : ENTROPY.success entropy_bytes s0 = ENTROPY.get_bytes (Z.to_nat entropy_len) s),
@semax hmac_drbg_compspecs.CompSpecs Espec
  (initialized_list [_entropy_len; _t'2; _t'1]
     (func_tycontext f_mbedtls_hmac_drbg_reseed HmacDrbgVarSpecs
        HmacDrbgFunSpecs))
  (PROP ( )
   LOCAL (temp _t'2 Vzero; temp _entropy_len (Vint (Int.repr entropy_len));
   lvar _seed (tarray tuchar 384) seed; temp _ctx ctx; temp _additional additional;
   temp _len (Vint (Int.repr add_len)); gvar sha._K256 kv)
   SEP (Stream (get_stream_result (get_entropy 0 entropy_len entropy_len false s));
   data_at Tsh (tarray tuchar entropy_len) (map Vint (map Int.repr entropy_bytes)) seed;
   data_at Tsh (tarray tuchar (384 - entropy_len))
     (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero))
     (offset_val entropy_len seed);
   da_emp Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents)) additional;
   md_full key md_ctx';
   data_at Tsh t_struct_mbedtls_md_info info_contents
     (hmac256drbgstate_md_info_pointer
        (md_ctx',
        (V', (reseed_counter', (entropy_len', (prediction_resistance', reseed_interval'))))));
   spec_sha.K_vector kv;
   data_at Tsh t_struct_hmac256drbg_context_st
     (md_ctx',
     (V', (reseed_counter', (entropy_len', (prediction_resistance', reseed_interval')))))
     ctx))
  (Ssequence (Sset _seedlen (Etempvar _entropy_len tuint))
     (Ssequence
        (Ssequence
           (Sifthenelse
              (Ebinop Cop.One (Etempvar _additional (tptr tuchar))
                 (Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint)
              (Sset _t'3
                 (Ecast
                    (Ebinop Cop.One (Etempvar _len tuint) (Econst_int (Int.repr 0) tint) tint)
                    tbool)) (Sset _t'3 (Econst_int (Int.repr 0) tint)))
           (Sifthenelse (Etempvar _t'3 tint)
              (Ssequence
                 (Scall None
                    (Evar _memcpy
                       (Tfunction
                          (Tcons (tptr tvoid) (Tcons (tptr tvoid) (Tcons tuint Tnil)))
                          (tptr tvoid) cc_default))
                    [Ebinop Oadd (Evar _seed (tarray tuchar 384))
                       (Etempvar _seedlen tuint) (tptr tuchar);
                    Etempvar _additional (tptr tuchar); Etempvar _len tuint])
                 (Sset _seedlen
                    (Ebinop Oadd (Etempvar _seedlen tuint) (Etempvar _len tuint) tuint)))
              Sskip))
        (Ssequence
           (Scall None
              (Evar _mbedtls_hmac_drbg_update
                 (Tfunction
                    (Tcons (tptr (Tstruct _mbedtls_hmac_drbg_context noattr))
                       (Tcons (tptr tuchar) (Tcons tuint Tnil))) tvoid cc_default))
              [Etempvar _ctx (tptr (Tstruct _mbedtls_hmac_drbg_context noattr));
              Evar _seed (tarray tuchar 384); Etempvar _seedlen tuint])
           (Ssequence
              (Sassign
                 (Efield
                    (Ederef
                       (Etempvar _ctx (tptr (Tstruct _mbedtls_hmac_drbg_context noattr)))
                       (Tstruct _mbedtls_hmac_drbg_context noattr)) _reseed_counter tint)
                 (Econst_int (Int.repr 1) tint))
              (Sreturn (Some (Econst_int (Int.repr 0) tint)))))))
 (frame_ret_assert
     (function_body_ret_assert tint
        (fun a : environ =>
         EX x : val,
         (PROP ( )
          LOCAL (temp ret_temp x)
          SEP (reseedPOST x contents additional add_len s
                 (HMAC256DRBGabs key V reseed_counter entropy_len prediction_resistance reseed_interval) ctx
                 info_contents kv
                 (md_ctx',
                 (V', (reseed_counter', (entropy_len', (prediction_resistance', reseed_interval'))))))) a))
     (fun a : environ =>
      EX x : val,
      local (lvar_denote _seed (tarray tuchar 384) x) a && ` (data_at_ Tsh (tarray tuchar 384) x) a)).
Proof.
  intros.
  assert (ZLbytes: Zlength entropy_bytes = entropy_len).
    { eapply get_bytes_Zlength. omega. eassumption. }
  apply Zgt_is_gt_bool_f in EAL384.
  abbreviate_semax.
(*  remember (contents_with_add additional add_len contents) as contents'.
  assert (ZLc': Zlength contents' = 0 \/ Zlength contents' = Zlength contents).
    { subst contents'. unfold contents_with_add.
      destruct (eq_dec add_len 0); simpl.
        rewrite andb_false_r. left; apply Zlength_nil.
        destruct (Memory.EqDec_val additional nullval); simpl. left; apply Zlength_nil.
        right; trivial.
    }
*)
  freeze [0;(*2;*)4;5;6;7] FR6. freeze [1;2] SEED.

  replace_SEP 0 (data_at Tsh (tarray tuchar 384)
         ((map Vint
            (map Int.repr entropy_bytes)) ++ (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero))) seed).
  {
    entailer!. thaw SEED; clear FR6. (*subst entropy_len.*) rewrite sepcon_emp.
    apply derives_refl'. symmetry.
    apply data_at_complete_split; repeat rewrite Zlength_map;
    try rewrite (*Hentropy_bytes_length,*) Zlength_list_repeat; try rewrite Zplus_minus; trivial; omega.
  }

  (* seedlen = entropy_len; *)
  clear SEED. freeze [0;1] FR7.
  forward.
(*  remember (if eq_dec additional nullval then false else if eq_dec add_len 0 then false else true) as non_empty_additional.*)
  remember (andb (negb (eq_dec additional nullval)) (negb (eq_dec add_len 0))) as non_empty_additional.

  forward_if (
      PROP  ()
      LOCAL  (temp _seedlen (Vint (Int.repr (entropy_len)));
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      temp _t'3 (Val.of_bool non_empty_additional);
      gvar sha._K256 kv)
      SEP  (FRZL FR7; da_emp Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents)) additional)).
  { destruct additional; simpl in PNadditional; try contradiction.
    + subst i. rewrite da_emp_null. entailer. reflexivity.
    + rewrite da_emp_ptr. normalize.
      eapply denote_tc_test_eq_split; auto 50 with valid_pointer.
      (* TODO regression, this should have solved it *)
      apply sepcon_valid_pointer2.
      apply data_at_valid_ptr; auto. }
  { (*nonnull additional*)
    destruct additional; simpl in PNadditional; try contradiction. subst i. elim H; trivial. clear H.
    forward. entailer!. simpl.
    destruct (initial_world.EqDec_Z (Zlength contents) 0).
    + rewrite e. simpl. reflexivity.
    + simpl in *. rewrite Int.eq_false; simpl. reflexivity.
      intros N.
      assert (Y: Int.unsigned (Int.repr (Zlength contents)) = Int.unsigned (Int.repr 0)) by (rewrite N; trivial).
      clear N. rewrite Int.unsigned_repr in Y. 2: omega. rewrite Int.unsigned_repr in Y; omega.
  }
  { (*nullval additional*)
    rewrite H in *.
    forward. entailer!.
  }
  thaw FR7.
(*  freeze [1;2] FR8.*) (*my_thaw FR6.*)
  forward_if (
      PROP  ()
      LOCAL  (temp _seedlen (Vint (Int.repr (entropy_len + Zlength contents')));
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP (data_at Tsh (tarray tuchar 384)
         (map Vint
            (map Int.repr entropy_bytes) ++ (map Vint (map Int.repr (*contents*)contents')) ++
          list_repeat (Z.to_nat (384 - entropy_len - Zlength (*contents*)contents')) (Vint Int.zero)) seed;
           (*FRZL FR8*)FRZL FR6;
       da_emp Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents)) additional)).
  + rewrite H in Heqnon_empty_additional. rename H into NEA.
    destruct additional; simpl in PNadditional; try contradiction.
    - subst i; simpl in *; discriminate.
    - destruct (eq_dec add_len 0); try discriminate.
      subst non_empty_additional; clear Heqnon_empty_additional.
    rename b into bb. rename i into ii.
    rewrite da_emp_ptr. Intros. rename H into addlen_pos.
    assert (contents' = contents).
    { subst contents'. unfold contents_with_add. simpl.
        destruct (initial_world.EqDec_Z add_len 0). omega. reflexivity. }
    clear Heqcontents'; subst contents'. clear ZLc'.
    replace_SEP 0 ((data_at Tsh (tarray tuchar entropy_len)
         (map Vint
            (map Int.repr entropy_bytes)) seed) * (data_at Tsh (tarray tuchar (384 - entropy_len))
         (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero)) (offset_val entropy_len seed))).
    {
      entailer!.
      apply derives_refl'; apply data_at_complete_split; trivial; try omega.
      rewrite Zlength_app in H; rewrite H; trivial.
      repeat rewrite Zlength_map; trivial.
      rewrite Zlength_list_repeat; omega.
    }
    flatten_sepcon_in_SEP. rewrite data_at_isptr with (p:=seed); Intros.
    apply isptrD in Pseed; destruct Pseed as [b [i SEED]]; rewrite SEED in *.
    change (offset_val entropy_len (Vptr b i)) with (Vptr b (Int.add i (Int.repr entropy_len))).
    assert_PROP (field_compatible (Tarray tuchar (384 - entropy_len) noattr)
          [] (Vptr b (Int.add i (Int.repr entropy_len)))) as FC_el by entailer!.
    simpl in *.
    replace_SEP 1 (
      (data_at Tsh (tarray tuchar (Zlength contents))
         (list_repeat (Z.to_nat (Zlength contents)) (Vint Int.zero)) (Vptr b (Int.add i (Int.repr entropy_len)))) *
      (data_at Tsh (tarray tuchar (384 - entropy_len - Zlength contents))
         (list_repeat (Z.to_nat (384 - entropy_len - Zlength contents)) (Vint Int.zero)) (offset_val (Zlength contents) (Vptr b (Int.add i (Int.repr entropy_len)))))).
    { (*
      subst entropy_len.
      replace (384 - 32) with 352 by omega.
      remember (Vptr b (Int.add i (Int.repr 32))) as seed'.
      clear Heqseed'.
      (*entailer!*) go_lower.
      replace (length contents) with (Z.to_nat (Zlength contents)) by
        (rewrite Zlength_correct; apply Nat2Z.id).
      apply derives_refl'; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto.
      {
        (*replace (Zlength contents + (352 - Zlength contents')) with (384 - 32) by omega.*)
        replace (Zlength contents + (352 - Zlength contents)) with 352 by omega.
        replace (384-32) with 352 in H11 by omega.
        assumption.
      }
      {
        rewrite list_repeat_app.
        rewrite <- Z2Nat.inj_add; try omega.
        replace (Zlength contents + (352 - Zlength contents)) with 352 by omega.
        reflexivity.
      }*)
      remember (Vptr b (Int.add i (Int.repr entropy_len))) as seed'.
      clear Heqseed'.
      (*entailer!*) go_lower.
      apply derives_refl'.
      apply data_at_complete_split; try rewrite Zlength_list_repeat; try omega; auto.
      + rewrite Zlength_list_repeat.
        replace (Zlength contents + (384 - entropy_len - Zlength contents)) with (384 - entropy_len); trivial; omega.
        omega.
      + rewrite list_repeat_app, <- Z2Nat.inj_add.
        replace (Zlength contents + (384 - entropy_len - Zlength contents)) with (384 - entropy_len); trivial; omega.
        omega. omega.
    }

    flatten_sepcon_in_SEP.
    replace_SEP 1 (memory_block Tsh (Zlength contents) (Vptr b (Int.add i (Int.repr entropy_len)))).
    { entailer!. replace (Zlength contents) with (sizeof (*cenv_cs*) (tarray tuchar (Zlength contents))) at 2.
      apply data_at_memory_block. simpl. rewrite Zmax0r; omega.
    }
    forward_call ((Tsh, Tsh), (Vptr b (Int.add i (Int.repr entropy_len))), (*additional*)Vptr bb ii, Zlength contents, map Int.repr contents).
    {
      (* type checking *)
      red in LV.
      unfold eval_var. destruct (Map.get (ve_of rho) _seed); try contradiction.
      destruct p; destruct LV  as [LV1 LV2]; inversion LV2. subst b0 i t; simpl; trivial.
    }
    {
      (* match up function parameter *)
      rewrite XH1; simpl.
      apply prop_right; trivial.
    }
    {
      (* match up SEP clauses *)
      change (fst (Tsh, Tsh)) with Tsh;
      change (snd (Tsh, Tsh)) with Tsh.
      (*change (@data_at spec_sha.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional) with (@data_at hmac_drbg_compspecs.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional).*)
      cancel. my_thaw FR6.
      rewrite XH1; cancel.
    }
    {
      (* prove the PROP clauses *)
      repeat split; auto; omega.
    }
    (*Intros memcpy_vret. subst memcpy_vret.*)
    forward.
    change (fst (Tsh, Tsh)) with Tsh;
    change (snd (Tsh, Tsh)) with Tsh.
    rewrite XH1, SEED.

    (* Time entailer!. (*8.5pl2: 1230secs*) *)
    go_lower. normalize.
    apply andp_right. apply prop_right. repeat split; auto.

    thaw FR6. rewrite (*H1,*) da_emp_ptr. normalize.
    apply andp_right. apply prop_right. simpl. (*specialize (Zlength_nonneg contents).*) subst add_len; omega.
    cancel.
    erewrite data_at_complete_split with
     (A:=map Vint (map Int.repr entropy_bytes))
     (p:=Vptr b i)(*(offset:=entropy_len)*)
     (AB:= (map Vint (map Int.repr entropy_bytes) ++
       map Vint (map Int.repr contents) ++
       list_repeat (Z.to_nat (384 - entropy_len - Zlength contents))
         (Vint Int.zero))).
    7: solve[reflexivity].
    cancel.
    6: solve[reflexivity].
    3: solve [repeat rewrite Zlength_map; omega].

    3: solve [reflexivity].
    3: solve [rewrite Zlength_app, Zlength_list_repeat; repeat rewrite Zlength_map; try omega].

    Focus 2. rewrite Zlength_app, (* <- H17, *) Zlength_list_repeat; try omega.
             repeat rewrite Zlength_map. rewrite ZLbytes(*, H2*).
             assert (X: entropy_len + (Zlength contents + (384 - entropy_len - Zlength contents)) = 384) by omega.
             rewrite X; assumption.

    rewrite Zlength_app; repeat rewrite Zlength_map; rewrite Zlength_list_repeat.
    assert (X: Zlength contents + (384 - entropy_len - Zlength contents) = 384 - entropy_len) by omega.
    rewrite X.
    erewrite data_at_complete_split with (AB:=map Vint (map Int.repr contents) ++
       list_repeat (Z.to_nat (384 - entropy_len - Zlength contents))
         (Vint Int.zero))
      (p:=(Vptr b (Int.add i (Int.repr entropy_len))))
      (A:= map Vint (map Int.repr contents)).
    7: reflexivity. 3: reflexivity. 5: reflexivity.
    3: reflexivity. 3: solve [rewrite Zlength_list_repeat; repeat rewrite Zlength_map; try omega].

    unfold offset_val. rewrite Int.add_assoc, add_repr. repeat rewrite Zlength_map. cancel. (*apply derives_refl.*)
    repeat rewrite Zlength_map. rewrite Zlength_list_repeat; try omega.
    apply derives_refl.
    rewrite Zlength_list_repeat; repeat rewrite Zlength_map; try omega. rewrite X; assumption.

    omega.

  + rewrite H in Heqnon_empty_additional; clear H.
    forward.
    go_lower. normalize.
    assert (contents' = nil).
    { subst contents'. unfold contents_with_add.
      destruct (eq_dec add_len 0); simpl in *.
      + rewrite e in *. rewrite andb_false_r; trivial.
      + destruct (Memory.EqDec_val additional nullval); simpl in *; trivial; discriminate. }
    clear Heqcontents'; subst contents'.
    rewrite Zlength_nil, Zplus_0_r.
    apply andp_right.
    apply prop_right. repeat split; trivial.
    do 2 rewrite map_nil. rewrite app_nil_l, Zminus_0_r. cancel.

  + (*continuation after conditional*)

  replace_SEP 0 (
    (data_at Tsh (tarray tuchar (entropy_len + Zlength contents')) (map Vint
            (map Int.repr entropy_bytes) ++
            map Vint (map Int.repr contents')) seed) *
    (data_at Tsh (tarray tuchar (384 - (entropy_len + Zlength contents'))) (list_repeat (Z.to_nat (384 - entropy_len - Zlength contents'))
            (Vint Int.zero)) (offset_val (entropy_len + Zlength contents') seed))
      ).
  {
    clear Heqcontents'.
    rewrite app_assoc.
    entailer!.
    rewrite Zlength_app, Zlength_list_repeat in H; try omega.
    apply derives_refl'.
    apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto;
      (* rewrite Zlength_app;*)try rewrite H; try rewrite Hentropy_bytes_length; repeat rewrite Zlength_map; auto.
  }
  flatten_sepcon_in_SEP.

  do 2 rewrite map_map.
  rewrite <- map_app.
  rewrite <- map_map.
  thaw FR6.
  rewrite data_at_isptr with (p:=seed). Intros.

  (*mbedtls_hmac_drbg_update( ctx, seed, seedlen )*)
  freeze [1;2;7] FR9.
  remember (entropy_len + Zlength contents') as ll.
  repeat rewrite Zlength_map in Hentropy_bytes_length.
  forward_call (entropy_bytes ++ contents', seed, ll,
                ctx,
                (md_ctx',
                 (map Vint (map Int.repr V),
                 (Vint (Int.repr reseed_counter),
                 (Vint (Int.repr entropy_len),
                 (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))),
                (HMAC256DRBGabs key V reseed_counter entropy_len prediction_resistance reseed_interval),
                kv, info_contents).
  {
    (* prove the SEP clauses match up *)
    destruct seed; simpl in Pseed; try contradiction.
    rewrite da_emp_ptr.
    rewrite Zlength_app.
    rewrite ZLbytes. simpl.
    normalize. apply andp_right. apply prop_right. repeat split; trivial.
      { omega. (*subst contents' add_len. unfold contents_with_add.
        destruct (eq_dec (Zlength contents) 0); simpl in *.
        + rewrite andb_false_r, Zlength_nil. rewrite e, Zplus_0_r in *.
          destruct ZL
          rewrite Z.max_r; omega.
        + rewrite andb_true_r.
          destruct (Memory.EqDec_val additional nullval); simpl in *. right. omega.*) }
    rewrite <- Heqll, XH5, XH6, XH7, XH8, XH9. cancel.
  }
  {
    (* prove the PROP clauses *)
    simpl in *. repeat split; trivial; try omega. (*
    rewrite H2 in *;*) rewrite int_max_unsigned_eq. omega.
    left; rewrite Zlength_app, ZLbytes; trivial.
    { apply isbyteZ_app; try assumption.
      eapply get_bytes_isbyteZ; eauto.
      subst contents'; unfold contents_with_add.
      destruct (eq_dec add_len 0); simpl.
        rewrite andb_false_r. constructor.
      destruct (Memory.EqDec_val additional nullval); simpl. constructor.
      trivial.
    }
  }
  unfold hmac256drbgabs_common_mpreds.
  repeat flatten_sepcon_in_SEP.
  thaw FR9.
  freeze [1;2;4;6;7] FR10.
  freeze [0;1] FR11.
  gather_SEP 1 2.
  replace_SEP 0 (data_at Tsh (tarray tuchar 384) ((map Vint
         (map Int.repr entropy_bytes)) ++ (map Vint (map Int.repr contents') ++
       list_repeat (Z.to_nat (384 - entropy_len - Zlength contents'))
         (Vint Int.zero))) seed).
  { (*
    subst entropy_len.
    replace (384 - 32) with 352 by omega.
    replace (384 - (32 + Zlength contents')) with (352 - Zlength contents') by omega.*)
    rewrite app_assoc.
    rewrite map_map.
    rewrite map_app.
    rewrite <- map_map.
    replace (map (fun x : Z => Vint (Int.repr x)) contents') with (map Vint (map Int.repr contents')) by (rewrite map_map; auto).
    clear Heqcontents'.
    rewrite Zlength_app, ZLbytes.
    entailer!.
    destruct seed; simpl in Pseed; try contradiction.
    rewrite da_emp_ptr. Intros.
    apply derives_refl'; symmetry; apply data_at_complete_split;
     repeat rewrite Zlength_list_repeat; try omega; auto; try rewrite Zlength_app;
     try rewrite ZLbytes; repeat rewrite Zlength_map; auto.
     replace (Zlength entropy_bytes + Zlength contents' +
      (384 - Zlength entropy_bytes - Zlength contents')) with 384 by omega.
     assumption.
  }

  (* ctx->reseed_counter = 1; *)
  my_thaw FR11.
  freeze [0;1] FR12. rewrite XH5, XH6, XH7, XH8, XH9.
  unfold hmac256drbgabs_to_state. simpl.
  remember (HMAC256_DRBG_functional_prog.HMAC256_DRBG_update
            (contents_with_add seed ll
               (entropy_bytes ++ contents')) key V).
  destruct p.
  simpl. normalize. rewrite XH6, XH7, XH8, XH9. drop_LOCAL 0%nat. drop_LOCAL 0%nat.
  subst contents'.
  unfold_data_at 1%nat. (*crucial: doing the field assignment without unfolding data_at results in the forward taking 1200secs*)
(*  freeze [0;1;2;4;5;6] FIELDS. optional wrt performance*)
  forward.

  (* return 0 *)
  idtac "Timing a forward (goal: 5secs)". Time forward. (*5 secs*)
  Exists seed (Vint (Int.repr 0)). normalize.
  entailer!.

  assert (ZL1: Zlength (contents_with_add additional (Zlength contents) contents) >? 256 = false).
  { clear - ZLc' AL256. destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc'; trivial. }

  apply Zgt_is_gt_bool_f in AL256.
  assert (Z: (zlt 256 (Zlength contents)
       || zlt 384
            (hmac256drbgabs_entropy_len
               (HMAC256DRBGabs key V reseed_counter (Zlength entropy_bytes) prediction_resistance
                  reseed_interval) + Zlength contents))%bool = false).
  { destruct (zlt 256 (Zlength contents)); simpl; try omega.
    destruct (zlt 384 (Zlength entropy_bytes + Zlength contents)); simpl; trivial. omega.
  }
  unfold reseedPOST. rewrite Z.
  entailer!.
  { unfold return_value_relate_result. simpl.
    rewrite andb_negb_r, ZL1.
    unfold get_entropy. rewrite <- Heqentropy_result. trivial. }
(*  remember (mbedtls_HMAC256_DRBG_reseed_function s
            (HMAC256DRBGabs key V reseed_counter (Zlength entropy_bytes) prediction_resistance reseed_interval)
            (contents_with_add additional (Zlength contents) contents)).*)
  simpl.
  rewrite andb_negb_r, ZL1.
  unfold get_entropy. rewrite <- Heqentropy_result.
  remember (HMAC_DRBG_update HMAC256_functional_prog.HMAC256
              (entropy_bytes ++ contents_with_add additional (Zlength contents) contents) key V) as q.
  destruct q. normalize.
  thaw FR12. thaw FR10. cancel. simpl. rewrite <- Heqp.
  unfold  hmac256drbgabs_common_mpreds. cancel.
  unfold get_entropy; rewrite <- Heqentropy_result. simpl. normalize. entailer!.
  { simpl in *. unfold HMAC_DRBG_update in Heqq.
    destruct (entropy_bytes ++
         contents_with_add additional (Zlength contents) contents); inv Heqq.
    + split. apply hmac_common_lemmas.HMAC_Zlength. apply hmac_common_lemmas.isbyte_hmac.
    + split. apply hmac_common_lemmas.HMAC_Zlength. apply hmac_common_lemmas.isbyte_hmac.
  }
  unfold_data_at 1%nat. cancel.
  unfold HMAC256_DRBG_functional_prog.HMAC256_DRBG_update in Heqp.
  destruct seed; simpl in Pseed; try contradiction.
  unfold contents_with_add in Heqp at 1. simpl in Heqp.
  destruct (initial_world.EqDec_Z (Zlength entropy_bytes +
                 Zlength (contents_with_add additional (Zlength contents) contents)) 0); simpl in Heqp.
  specialize (Zlength_nonneg (contents_with_add additional (Zlength contents) contents)).
  intros; omega.

  rewrite <- Heqp in *. inv Heqq.
idtac "Timing the Qed of REST (goal: 45secs)". cancel.
Time Qed. (*Feb 23 2017: 216.218 secs (135.625u,0.046s) (successful)*)
         (*was: Coq8.5pl2: 44secs*)

Lemma body_hmac_drbg_reseed: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
       f_mbedtls_hmac_drbg_reseed hmac_drbg_reseed_spec.
Proof.
  start_function.
  rename lvar0 into seed.
  destruct initial_state_abs.
  destruct initial_state as [md_ctx' [V' [reseed_counter' [entropy_len' [prediction_resistance' reseed_interval']]]]].
  unfold hmac256drbg_relate.
  Intros. simpl in *.
  rename H into XH1.
  rename H0 into XH2.
  rename H1 into XH3.
  rename H2 into XH4.
  rename H3 into El2.
  rename H4 into XH6.
  rename H5 into XH7.
  rename H6 into XH8.
  rename H7 into XH9.
  rename H8 into XH10.
  rename H9 into XH11.
  rename H10 into XH12.
  rename H11 into XH13.
  rewrite da_emp_isptrornull. (*needed later*)
  rewrite data_at_isptr with (p:=ctx).
  Intros.

  (* entropy_len = ctx->entropy_len *)
  simpl in *.
  remember (contents_with_add additional add_len contents) as contents'.
  assert (ZLc': Zlength contents' = 0 \/ Zlength contents' = Zlength contents).
    { subst contents'. unfold contents_with_add.
      destruct (eq_dec add_len 0); simpl.
        rewrite andb_false_r. left; apply Zlength_nil.
        destruct (Memory.EqDec_val additional nullval); simpl. left; apply Zlength_nil.
        right; trivial.
    }

  freeze [0;1;3;4;5;6] FR1.
  forward. (*{ rewrite <- H7; entailer!. }*)

  remember (orb (zlt 256 add_len) (zlt 384 (entropy_len + add_len))) as add_len_too_high.

  (* if (len > MBEDTLS_HMAC_DRBG_MAX_INPUT ||
        entropy_len + len > MBEDTLS_HMAC_DRBG_MAX_SEED_INPUT) *)
  freeze [0;1] FR2.
  forward_if (PROP  ()
      LOCAL  (temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      temp _t'1 (Val.of_bool add_len_too_high);
      gvar sha._K256 kv)
      SEP  (FRZL FR2)).
  { forward. entailer!. }
  { forward. entailer!. simpl.
      unfold Int.ltu; simpl.
      rewrite add_repr.
      rewrite Int.unsigned_repr. 2: rewrite int_max_unsigned_eq; omega.
      rewrite Int.unsigned_repr_eq, Zmod_small.
      + destruct (zlt 384 (entropy_len + (Zlength contents))); simpl; try reflexivity.
      + omega.
  }

  forward_if (PROP  (add_len_too_high = false)
      LOCAL  (temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP (FRZL FR2)
  ).
  { rewrite H in *. subst add_len_too_high. forward.
    Exists seed (Vint (Int.neg (Int.repr 5))). normalize. entailer!.
    unfold reseedPOST. simpl; rewrite <- Heqadd_len_too_high.
    (*remember (zlt 256 (Zlength contents) || zlt 384 (entropy_len + Zlength contents))%bool as c.
    destruct c; simpl in Heqadd_len_too_high; try discriminate.*)
    normalize. apply andp_right. apply prop_right; repeat split; trivial.
    thaw FR2. thaw FR1. cancel.
  }
  {
    forward.
    entailer!.
  }
  Intros. rewrite H in *; clear H add_len_too_high.
  symmetry in Heqadd_len_too_high; apply orb_false_iff in Heqadd_len_too_high; destruct Heqadd_len_too_high.

  assert (AL256: 256 >= add_len).
  { destruct (zlt 256 add_len); try discriminate; trivial. }
  assert (EL384 : 384 >= entropy_len + add_len).
  { destruct ( zlt 384 (entropy_len + add_len)); try discriminate; trivial. }

  thaw FR2. thaw FR1. freeze [1;2;3;4;5;6] FR3.
  (* memset( seed, 0, MBEDTLS_HMAC_DRBG_MAX_SEED_INPUT ); *)
  forward_call (Tsh, seed, 384, Int.zero).
  { rewrite data_at__memory_block.
    change (sizeof (*cenv_cs*) (tarray tuchar 384)) with 384.
    normalize. cancel.
  }

  (*freeze [1;2;3;4;5;6] FR3.*)
  assert_PROP (field_compatible (tarray tuchar 384) [] seed) as Hfield by entailer!.
  replace_SEP 0 ((data_at Tsh (tarray tuchar entropy_len)
         (list_repeat (Z.to_nat entropy_len) (Vint Int.zero)) seed) * (data_at Tsh (tarray tuchar (384 - entropy_len))
         (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero)) (offset_val entropy_len seed))).
  {
    (*subst entropy_len.*)
    erewrite <- data_at_complete_split with (length:=384)(AB:=list_repeat (Z.to_nat 384) (Vint Int.zero)); repeat rewrite Zlength_list_repeat; trivial; try omega.
    go_lower. apply derives_refl. rewrite Zplus_minus. assumption.
    rewrite list_repeat_app. rewrite Z2Nat.inj_sub; try omega. rewrite le_plus_minus_r. trivial. apply Z2Nat.inj_le; try omega.
  }
  flatten_sepcon_in_SEP.

  replace_SEP 0 (memory_block Tsh entropy_len seed).
  {
    (*subst entropy_len.*) go_lower.
     eapply derives_trans. apply data_at_memory_block. simpl. rewrite Z.max_r, Z.mul_1_l; trivial.
  }

  (* get_entropy(seed, entropy_len ) *)
  thaw FR3. freeze [1;2;3;4;6;7] FR4.
  forward_call (Tsh, s, seed, entropy_len).
  { split. split; try omega. rewrite int_max_unsigned_eq. omega.
    apply writable_share_top.
(*
    subst entropy_len; auto.*)
  }
  Intros vret. rename H1 into ENT.
  assert (AL256': add_len >? 256 = false).
  { remember (add_len >? 256) as d.
    destruct d; symmetry in Heqd; trivial.
    apply Zgt_is_gt_bool in Heqd.
    destruct (zlt 256 add_len); try discriminate; omega.
  }
  assert (EAL256': (entropy_len + add_len)  >? 384 = false).
  { remember (entropy_len + add_len >? 384) as d.
    destruct d; symmetry in Heqd; trivial.
    apply Zgt_is_gt_bool in Heqd.
    destruct (zlt 384 (entropy_len + add_len)); try discriminate; omega.
  }

  (* if( get_entropy(seed, entropy_len ) != 0 ) *)
  freeze [0;1;2] FR5.
  forward_if (
      PROP  (vret=Vzero)
      LOCAL  (temp _t'2 vret;
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP (FRZL FR5)
  ).
  {
    (* != 0 case *)
    forward.
    Exists seed (Vint (Int.neg (Int.repr (9)))). normalize. entailer!.
    unfold reseedPOST.
    remember ((zlt 256 (Zlength contents)
       || zlt 384
            (hmac256drbgabs_entropy_len
               (HMAC256DRBGabs key V reseed_counter entropy_len prediction_resistance
                  reseed_interval) + (Zlength contents)))%bool) as z.
    destruct z.
    { exfalso. simpl in Heqz. rewrite H, H0 in Heqz. inv Heqz. }
    clear Heqz.
    unfold return_value_relate_result, get_entropy in ENT.
    simpl in ENT.
    remember (ENTROPY.get_bytes (Z.to_nat entropy_len) s) as  GE.
    destruct GE.
    + inv ENT. discriminate.
    + thaw FR5. unfold get_entropy. rewrite <- HeqGE.
      remember (mbedtls_HMAC256_DRBG_reseed_function s
            (HMAC256DRBGabs key V reseed_counter 32 prediction_resistance
               reseed_interval) (contents_with_add additional (Zlength contents) contents)) as M.
      remember (mbedtls_HMAC256_DRBG_reseed_function s
             (HMAC256DRBGabs key V reseed_counter 32 prediction_resistance
                reseed_interval) contents).
      unfold mbedtls_HMAC256_DRBG_reseed_function, HMAC256_DRBG_functional_prog.HMAC256_DRBG_reseed_function in *.
      unfold DRBG_reseed_function in *. rewrite andb_negb_r in *.
      unfold return_value_relate_result in ENT.
      unfold get_entropy in *; simpl in *. rewrite <- HeqGE in *.

      rewrite AL256' in *.
      remember (Zlength (contents_with_add additional (Zlength contents) contents)) as ZLa.
      assert (ZLa256: ZLa >? 256 = false).
      { destruct ZLc' as [PP | PP]; rewrite PP; trivial. }
      rewrite ZLa256 in *. subst M r. normalize. simpl. cancel.
      unfold get_entropy. simpl. rewrite andb_negb_r, <- HeqGE.
      unfold hmac256drbgabs_common_mpreds. simpl. normalize.
      apply andp_right. apply prop_right. repeat split; trivial.
      thaw FR4. cancel.
      rewrite data_at__memory_block. entailer!.
      destruct seed; inv Pseed. unfold offset_val.
      rewrite <- repr_unsigned with (i:=i).
      assert (XX: sizeof (tarray tuchar 384) = entropy_len + (384 - entropy_len)).
      { simpl. omega. }
      rewrite XX.
      rewrite (memory_block_split Tsh b (Int.unsigned i) entropy_len (384 - entropy_len)), add_repr; try omega.
      cancel.
      eapply derives_trans. apply data_at_memory_block.
          simpl. rewrite Z.max_r, Z.mul_1_l; try omega; trivial.
      rewrite Zplus_minus. cbv; trivial.
      assert (Int.unsigned i >= 0) by (pose proof (Int.unsigned_range i); omega).
      split. omega.
      clear - Hfield. red in Hfield; simpl in Hfield. omega.
  }
  {
    forward.
    entailer!. clear FR4 FR5. (*subst add_len.*)
    apply negb_false_iff in H1. symmetry in H1; apply binop_lemmas2.int_eq_true in H1.
    subst vret; split; trivial.
  }
  Intros. subst vret. unfold return_value_relate_result in ENT.
  (* now that we know entropy call succeeded, use that fact to simplify the SEP clause *)
  remember (entropy.ENTROPY.get_bytes (Z.to_nat entropy_len) s) as entropy_result.
  unfold entropy.get_entropy in ENT;
  rewrite <- Heqentropy_result in ENT.
  destruct entropy_result; [|
    normalize;
    simpl in ENT; destruct e; [inversion ENT | inversion ENT ]
    (*assert (contra: False) by (apply ENT; reflexivity); inversion contra]*)
    ].
  Focus 2. destruct ENT_GenErrAx as [EC1 _]; elim EC1; trivial.
(*
  unfold entropy.get_entropy in ENT;
  rewrite <- Heqentropy_result in ENT;
  destruct entropy_result; [|
  normalize;
  simpl in ENT; destruct e; [inversion ENT |
  assert (contra: False) by (apply ENT; reflexivity); inversion contra]
  ].*)
  clear ENT.

  rename l into entropy_bytes.
  thaw FR5. thaw FR4.
  eapply REST with (s0:=s0)(contents':=contents'); trivial.
idtac "Timing the Qed of drbg_reseed (goal: 25secs)". omega.
Time Qed. (*Feb 23 2017: Finished transaction in 105.344 secs (74.078u,0.015s) (successful)*)
          (*earlier Coq8.5pl2: 24secs*)


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

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

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

Require Import MemoryReorder.
Require Import MemoryMerge.
Require Import FulfillStep.

Require Import SimMemory.
Require Import SimPromises.
Require Import SimLocal.

Require Import ReorderTView.

Set Implicit Arguments.

Lemma future_read_step
      lc1 mem1 mem1' loc ts val released ord lc2
      (WF: Local.wf lc1 mem1)
      (MEM: Memory.closed mem1)
      (FUTURE: Memory.future_weak mem1 mem1')
      (STEP: Local.read_step lc1 mem1 loc ts val released ord lc2):
  exists released' lc2',
    <<STEP: Local.read_step lc1 mem1' loc ts val released' ord lc2'>> /\
    <<REL: View.opt_le released' released>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>>.
Proof.
  inv STEP. exploit Memory.future_weak_get1; eauto. i. des. inv MSG_LE.
  esplits.
  - econs; eauto. eapply TViewFacts.readable_mon; eauto; refl.
  - auto.
  - econs; s.
    + apply TViewFacts.read_tview_mon; auto.
      * refl.
      * apply WF.
      * inv MEM. exploit CLOSED; eauto. i. des. inv MSG_WF. auto.
      * refl.
    + apply SimPromises.sem_bot.
Qed.

Lemma future_fulfill_step
      lc1 sc1 sc1' loc from to val releasedm releasedm' released ord lc2 sc2
      (REL_LE: View.opt_le releasedm' releasedm)
      (STEP: fulfill_step lc1 sc1 loc from to val releasedm released ord lc2 sc2):
  fulfill_step lc1 sc1' loc from to val releasedm' released ord lc2 sc1'.
Proof.
  assert (TVIEW: TView.write_tview (Local.tview lc1) sc1 loc to ord = TView.write_tview (Local.tview lc1) sc1' loc to ord).
  { unfold TView.write_tview. repeat (condtac; viewtac). }
  inversion STEP. subst lc2 sc2.
  rewrite TVIEW. econs; eauto.
  - etrans; eauto. unfold TView.write_released. condtac; econs. repeat apply View.join_spec.
    + rewrite <- View.join_l. apply View.unwrap_opt_le. auto.
    + rewrite <- ? View.join_r. rewrite TVIEW. refl.
  - econs; try apply WRITABLE.
Qed.

Lemma future_fence_step
      lc1 sc1 sc1' ordr ordw lc2 sc2
      (ORDW: Ordering.le ordw Ordering.acqrel)
      (SC_FUTURE: TimeMap.le sc1 sc1')
      (STEP: Local.fence_step lc1 sc1 ordr ordw lc2 sc2):
  Local.fence_step lc1 sc1' ordr ordw lc2 sc1'.
Proof.
  inv STEP.
  erewrite TViewFacts.write_fence_tview_acqrel; auto.
  erewrite <- TViewFacts.write_fence_sc_acqrel at 2; eauto.
Qed.

Lemma reorder_read_read
      loc1 ts1 val1 released1 ord1
      loc2 ts2 val2 released2 ord2
      lc0 mem0
      lc1
      lc2
      (LOC: loc1 = loc2 -> Ordering.le ord1 Ordering.plain /\ Ordering.le ord2 Ordering.plain)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.read_step lc1 mem0 loc2 ts2 val2 released2 ord2 lc2):
  exists lc1',
    <<STEP1: Local.read_step lc0 mem0 loc2 ts2 val2 released2 ord2 lc1'>> /\
    <<STEP2: Local.read_step lc1' mem0 loc1 ts1 val1 released1 ord1 lc2>>.
Proof.
  inv STEP1. inv STEP2. ss.
  esplits.
  - econs; eauto.
    eapply TViewFacts.readable_mon; try apply READABLE0; eauto; try refl.
    apply TViewFacts.read_tview_incr.
  - econs; eauto.
    + s. unfold View.singleton_ur_if.
      econs; repeat (try condtac; try splits; aggrtac; eauto; try apply READABLE;
                     unfold TimeMap.singleton, LocFun.add in *).
      * specialize (LOC eq_refl). des. viewtac.
      * specialize (LOC eq_refl). des. viewtac.
      * specialize (LOC eq_refl). des. viewtac.
    + inv MEM0. exploit CLOSED; try exact GET. i. des.
      exploit CLOSED; try exact GET0. i. des. f_equal.
      inv MSG_WF. inv MSG_WF0.
      apply TView.antisym; apply ReorderTView.read_read_tview;
        (try by apply WF0); eauto.
Qed.

Lemma reorder_read_promise
      loc1 ts1 val1 released1 ord1
      loc2 from2 to2 msg2 kind2
      lc0 mem0
      lc1
      lc2 mem2
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.promise_step lc1 mem0 loc2 from2 to2 msg2 lc2 mem2 kind2):
  exists lc1' lc2' released1',
    <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem2 kind2>> /\
    <<STEP2: Local.read_step lc1' mem2 loc1 ts1 val1 released1' ord1 lc2'>> /\
    <<REL1: View.opt_le released1' released1>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>>.
Proof.
  inv STEP1. inv STEP2. ss.
  exploit Memory.promise_future; try exact PROMISE; try apply WF0; eauto. i. des.
  destruct (Memory.op_kind_is_cancel kind2) eqn:KIND.
  { destruct kind2; ss. inv PROMISE.
    esplits; [eauto|..].
    - econs; eauto.
      erewrite Memory.remove_o; eauto. condtac; ss; eauto.
      des. subst. exploit Memory.remove_get0; try exact MEM. i. des. congr.
    - refl.
    - s. econs; ss.
      + apply TViewFacts.read_tview_mon; try refl; try apply WF0; eauto.
        inv MEM0. exploit CLOSED0; eauto. i. des. inv MSG_WF. auto.
      + apply SimPromises.sem_bot.
  }
  exploit Memory.promise_get1; eauto. i. des. inv MSG_LE.
  esplits; eauto.
  - econs; eauto.
    s. eapply TViewFacts.readable_mon; eauto; try refl.
  - s. econs; ss.
    + apply TViewFacts.read_tview_mon; try refl; try apply WF0; eauto.
      inv MEM0. exploit CLOSED0; eauto. i. des. inv MSG_WF. auto.
    + apply SimPromises.sem_bot.
Qed.

Lemma reorder_read_promise_diff
      loc1 ts1 val1 released1 ord1
      loc2 from2 to2 msg2 kind2
      lc0 mem0
      lc1
      lc2 mem2
      (DIFF: (loc1, ts1) <> (loc2, to2))
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.promise_step lc1 mem0 loc2 from2 to2 msg2 lc2 mem2 kind2):
  exists lc1',
    <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem2 kind2>> /\
    <<STEP2: Local.read_step lc1' mem2 loc1 ts1 val1 released1 ord1 lc2>>.
Proof.
  inv STEP1. inv STEP2. ss.
  exploit MemoryFacts.promise_get1_diff; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_read_fulfill
      loc1 ts1 val1 released1 ord1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      lc0 sc0 mem0
      lc1
      lc2 sc2
      (LOC: loc1 <> loc2)
      (ORD: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord2 Ordering.acqrel)
      (RELM_WF: View.opt_wf releasedm2)
      (RELM_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2):
  exists lc1' lc2',
    <<STEP1: fulfill_step lc0 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc2>> /\
    <<STEP2: Local.read_step lc1' mem0 loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>>.
Proof.
  guardH ORD.
  exploit Local.read_step_future; eauto. i. des.
  inv STEP1. inv STEP2.
  esplits.
  - econs; eauto.
    + etrans; eauto. unfold TView.write_released. s.
      condtac; econs. repeat (try condtac; aggrtac; try apply WF0).
    + eapply TViewFacts.writable_mon; eauto; try refl. apply TVIEW_FUTURE.
  - econs; eauto.
    s. inv READABLE.
    econs; repeat (try condtac; aggrtac; try apply WF0; eauto; unfold TimeMap.singleton).
  - s. econs; s.
    + apply ReorderTView.read_write_tview; try apply WF0; auto.
    + apply SimPromises.sem_bot.
Qed.

Lemma reorder_read_write
      loc1 ts1 val1 released1 ord1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      lc0 sc0 mem0
      lc1
      lc2 sc2 mem2
      kind
      (LOC: loc1 <> loc2)
      (ORD: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord2 Ordering.acqrel)
      (RELM_WF: View.opt_wf releasedm2)
      (RELM_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.write_step lc1 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2 mem2 kind):
  exists released2' mem2' lc1' lc2',
    <<STEP1: Local.write_step lc0 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2' ord2 lc1' sc2 mem2' kind>> /\
    <<STEP2: Local.read_step lc1' mem2' loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<RELEASED: View.opt_le released2' released2>> /\
    <<MEM: sim_memory mem2' mem2>>.
Proof.
  guardH ORD.
  exploit Local.read_step_future; eauto. i. des.
  exploit write_promise_fulfill; try exact STEP2; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit reorder_read_promise_diff; try exact STEP1; try exact STEP0; eauto.
  { ii. inv H. congr. }
  i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit reorder_read_fulfill; try exact STEP5; try exact STEP3; eauto; try by viewtac. i. des.
  exploit promise_fulfill_write_sim_memory; try exact x4; try exact STEP6; eauto; try by viewtac.
  { i. hexploit ORD0; eauto. i. des.
    splits; auto. inv STEP1. auto.
  }
  i. des.
  inv STEP1.
  inversion STEP. inv WRITE. hexploit MemoryFacts.promise_get1_diff; try exact PROMISE; eauto.
  { ii. inv H. congr. }
  i. des.
  esplits; eauto.
  inv STEP7. econs; eauto.
Qed.

Lemma reorder_read_update
      loc1 ts1 val1 released1 ord1
      loc2 ts2 val2 released2 ord2
      from3 to3 val3 released3 ord3
      lc0 sc0 mem0
      lc1
      lc2
      lc3 sc3 mem3
      kind
      (LOC: loc1 <> loc2)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (ORD3: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord3 Ordering.acqrel)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.read_step lc1 mem0 loc2 ts2 val2 released2 ord2 lc2)
      (STEP3: Local.write_step lc2 sc0 mem0 loc2 from3 to3 val3 released2 released3 ord3 lc3 sc3 mem3 kind):
  exists released3' mem3' lc1' lc2' lc3',
    <<STEP1: Local.read_step lc0 mem0 loc2 ts2 val2 released2 ord2 lc1'>> /\
    <<STEP2: Local.write_step lc1' sc0 mem0 loc2 from3 to3 val3 released2 released3' ord3 lc2' sc3 mem3' kind>> /\
    <<STEP3: Local.read_step lc2' mem3' loc1 ts1 val1 released1 ord1 lc3'>> /\
    <<LOCAL: sim_local SimPromises.bot lc3' lc3>> /\
    <<RELEASED: View.opt_le released3' released3>> /\
    <<MEM: sim_memory mem3' mem3>>.
Proof.
  guardH ORD3.
  exploit Local.read_step_future; try exact STEP1; eauto. i. des.
  exploit Local.read_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_read_read; try exact STEP1; try exact STEP2; eauto; try congr. i. des.
  exploit Local.read_step_future; try exact STEP0; eauto. i. des.
  hexploit reorder_read_write; try exact STEP4; try exact STEP_SRC; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_read_fence
      loc1 ts1 val1 released1 ord1
      ordr2 ordw2
      lc0 sc0 mem0
      lc1
      lc2 sc2
      (ORDR2: Ordering.le ordr2 Ordering.relaxed)
      (ORDW2: Ordering.le ordw2 Ordering.acqrel)
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: Local.fence_step lc1 sc0 ordr2 ordw2 lc2 sc2):
  exists lc1' lc2' sc2',
    <<STEP1: Local.fence_step lc0 sc0 ordr2 ordw2 lc1' sc2'>> /\
    <<STEP2: Local.read_step lc1' mem0 loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc2>>.
Proof.
  exploit Local.read_step_future; eauto. i. des.
  inv STEP1. inv STEP2. ss.
  esplits.
  - econs; eauto.
  - econs; eauto. s.
    unfold TView.write_fence_tview, TView.read_fence_tview, TView.write_fence_sc.
    econs; repeat (try condtac; try splits; aggrtac; try apply READABLE).
  - s. econs; s.
    + etrans.
      * apply ReorderTView.read_write_fence_tview; auto.
        eapply TViewFacts.read_fence_future; apply WF0.
      * apply TViewFacts.write_fence_tview_mon; try refl.
        apply ReorderTView.read_read_fence_tview; try apply WF0; auto.
        exploit TViewFacts.read_fence_future; try apply WF0; eauto. i. des.
        eapply TViewFacts.read_future; eauto.
    + apply SimPromises.sem_bot.
  - unfold TView.write_fence_sc, TView.read_fence_tview.
    repeat condtac; aggrtac.
Qed.

Lemma reorder_fulfill_read
      loc1 from1 to1 val1 releasedm1 released1 ord1
      loc2 ts2 val2 released2 ord2
      lc0 sc0 mem0
      lc1 sc1
      lc2
      (LOC: loc1 <> loc2)
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: fulfill_step lc0 sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc1 sc1)
      (STEP2: Local.read_step lc1 mem0 loc2 ts2 val2 released2 ord2 lc2):
  exists lc1',
    <<STEP1: Local.read_step lc0 mem0 loc2 ts2 val2 released2 ord2 lc1'>> /\
    <<STEP2: fulfill_step lc1' sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc2 sc1>>.
Proof.
  inv STEP1. inv STEP2.
  hexploit Memory.remove_future; try apply REMOVE; try apply WF0; eauto. i. des.
  esplits.
  - econs; eauto.
    eapply TViewFacts.readable_mon; try apply READABLE; eauto; try refl.
    apply TViewFacts.write_tview_incr. apply WF0.
  - unfold Local.tview at 2.
    unfold Local.promises at 2.
    rewrite ReorderTView.read_write_tview_eq; eauto; try apply WF0; cycle 1.
    { inv MEM0. exploit CLOSED; eauto. i. des. inv MSG_WF. eauto. }
    econs; try exact REMOVE; eauto.
    + etrans; eauto. unfold TView.write_released. s. condtac; econs.
      repeat (try condtac; aggrtac).
    + s. unfold View.singleton_ur_if.
      econs; repeat (try condtac; try splits; aggrtac; eauto; try apply WRITABLE;
                     unfold TimeMap.singleton, LocFun.add in *);
        (try by inv WRITABLE; eapply TimeFacts.le_lt_lt; eauto; aggrtac).
Qed.

Lemma reorder_fulfill_promise
      loc1 from1 to1 val1 releasedm1 released1 ord1
      loc2 from2 to2 msg2 kind2
      lc0 sc0 mem0
      lc1 sc1
      lc2 mem2
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: fulfill_step lc0 sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc1 sc1)
      (STEP2: Local.promise_step lc1 mem0 loc2 from2 to2 msg2 lc2 mem2 kind2):
  exists lc1',
    <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem2 kind2>> /\
    <<STEP2: fulfill_step lc1' sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc2 sc1>>.
Proof.
  inv STEP1. inv STEP2.
  hexploit Memory.remove_future; try apply WF0; eauto. i. des.
  hexploit Memory.promise_future; eauto.
  { ii. inv WF0.
    erewrite Memory.remove_o; eauto. condtac; ss. }
  i. des.
  exploit MemoryReorder.remove_promise; try apply WF0; eauto. i. des.
  esplits.
  - econs; eauto.
  - econs; eauto.
Qed.

Lemma reorder_fulfill_fulfill
      loc1 from1 to1 val1 releasedm1 released1 ord1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      lc0 sc0 mem0
      lc1 sc1
      lc2 sc2
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (LOC: loc1 <> loc2)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (REL1_WF: View.opt_wf releasedm1)
      (REL2_WF: View.opt_wf releasedm2)
      (REL2_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (STEP1: fulfill_step lc0 sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc1 sc1)
      (STEP2: fulfill_step lc1 sc1 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2):
  exists lc1' lc2' sc1' sc2',
    <<STEP1: fulfill_step lc0 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc1'>> /\
    <<STEP2: fulfill_step lc1' sc1' loc1 from1 to1 val1 releasedm1 released1 ord1 lc2' sc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc2>>.
Proof.
  inv STEP1. inv STEP2.
  hexploit Memory.remove_future; try apply WF0; eauto. i. des.
  exploit MemoryReorder.remove_remove; try apply REMOVE; try apply REMOVE0; eauto. i. des.
  unfold Local.promises in REMOVE0.
  esplits.
  - econs; eauto.
    + etrans; eauto. unfold TView.write_released. s. condtac; econs.
      repeat (try condtac; aggrtac; try apply WF0).
    + eapply TViewFacts.writable_mon; eauto; try refl.
      * apply TViewFacts.write_tview_incr. apply WF0.
  - econs; eauto.
    + etrans; eauto. unfold TView.write_released. s. condtac; econs.
      repeat (try condtac; aggrtac; try apply WF0).
    + inv WRITABLE. econs; i.
      * eapply TimeFacts.le_lt_lt; [|apply TS].
        repeat (try condtac; viewtac; unfold TimeMap.singleton in *).
  - s. econs; ss.
    + apply ReorderTView.write_write_tview; auto. apply WF0.
    + apply SimPromises.sem_bot.
  - refl.
Qed.

Lemma reorder_fulfill_write_sim_memory
      loc1 from1 to1 val1 releasedm1 released1 ord1
      loc2 from2 to2 val2 releasedm2 released2 ord2 kind2
      lc0 sc0 mem0
      lc1 sc1
      lc2 sc2 mem2
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (LOC: loc1 <> loc2)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (REL1_WF: View.opt_wf releasedm1)
      (REL1_CLOSED: Memory.closed_opt_view releasedm1 mem0)
      (REL2_WF: View.opt_wf releasedm2)
      (REL2_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (STEP1: fulfill_step lc0 sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc1 sc1)
      (STEP2: Local.write_step lc1 sc1 mem0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2 mem2 kind2):
  exists released2' lc1' lc2' sc1' sc2' mem2',
    <<STEP1: Local.write_step lc0 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2' ord2 lc1' sc1' mem2' kind2>> /\
    <<STEP2: fulfill_step lc1' sc1' loc1 from1 to1 val1 releasedm1 released1 ord1 lc2' sc2'>> /\
    <<RELEASED2: View.opt_le released2' released2>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc2>> /\
    <<MEM: sim_memory mem2' mem2>>.
Proof.
  exploit fulfill_step_future; eauto. i. des.
  exploit write_promise_fulfill; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit reorder_fulfill_promise; try exact STEP1; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit fulfill_step_future; try exact STEP5; try exact WF3;
    eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  exploit reorder_fulfill_fulfill; try exact STEP5; try exact STEP3;
    eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  exploit promise_fulfill_write_sim_memory; eauto.
  { i. hexploit ORD; eauto. i. des. splits; ss.
    ii. unfold Memory.get in GET.
    erewrite fulfill_step_promises_diff in GET; eauto.
    exploit H0; eauto.
  }
  i. des.
  esplits; eauto.
Qed.

Lemma reorder_fulfill_update
      loc1 from1 to1 val1 releasedm1 released1 ord1
      loc2 ts2 val2 released2 ord2
      from3 to3 val3 released3 ord3 kind3
      lc0 sc0 mem0
      lc1 sc1
      lc2
      lc3 sc3 mem3
      (LOC: loc1 <> loc2)
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (REL1_WF: View.opt_wf releasedm1)
      (REL1_CLOSED: Memory.closed_opt_view releasedm1 mem0)
      (STEP1: fulfill_step lc0 sc0 loc1 from1 to1 val1 releasedm1 released1 ord1 lc1 sc1)
      (STEP2: Local.read_step lc1 mem0 loc2 ts2 val2 released2 ord2 lc2)
      (STEP3: Local.write_step lc2 sc1 mem0 loc2 from3 to3 val3 released2 released3 ord3 lc3 sc3 mem3 kind3):
  exists released3' lc1' lc2' lc3' sc2' sc3' mem2',
    <<STEP1: Local.read_step lc0 mem0 loc2 ts2 val2 released2 ord2 lc1'>> /\
    <<STEP2: Local.write_step lc1' sc0 mem0 loc2 from3 to3 val3 released2 released3' ord3 lc2' sc2' mem2' kind3>> /\
    <<STEP3: fulfill_step lc2' sc2' loc1 from1 to1 val1 releasedm1 released1 ord1 lc3' sc3'>> /\
    <<LOCAL: sim_local SimPromises.bot lc3' lc3>> /\
    <<RELEASED: View.opt_le released3' released3>> /\
    <<SC: TimeMap.le sc3' sc3>> /\
    <<MEM: sim_memory mem2' mem3>>.
Proof.
  exploit fulfill_step_future; try exact STEP1; eauto. i. des.
  exploit Local.read_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_fulfill_read; try exact STEP1; try exact STEP2; eauto. i. des.
  exploit Local.read_step_future; try exact STEP0; eauto. i. des.
  exploit fulfill_step_future; try exact STEP4; eauto. i. des.
  hexploit sim_local_write_bot; try exact STEP3; try exact LOCAL; try refl; eauto. i. des.
  hexploit reorder_fulfill_write_sim_memory; try exact STEP4; try exact STEP3; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_update_read
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 ts3 val3 released3 ord3
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3
      (LOC: loc1 <> loc3)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (ORD3: Ordering.le ord3 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: Local.read_step lc2 mem0 loc3 ts3 val3 released3 ord3 lc3):
  exists lc1' lc2',
    <<STEP1: Local.read_step lc0 mem0 loc3 ts3 val3 released3 ord3 lc1'>> /\
    <<STEP2: Local.read_step lc1' mem0 loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<STEP3: fulfill_step lc2' sc0 loc1 from2 to2 val2 released1 released2 ord2 lc3 sc2>>.
Proof.
  exploit Local.read_step_future; try exact STEP1; eauto. i. des.
  exploit fulfill_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_fulfill_read; try exact STEP2; try exact STEP3; eauto. i. des.
  exploit Local.read_step_future; try exact STEP0; eauto. i. des.
  exploit reorder_read_read; try exact STEP1; try exact STEP0; eauto; try congr. i. des.
  esplits; eauto.
Qed.

Lemma reorder_update_promise
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 from3 to3 msg3 kind3
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3 mem3
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: Local.promise_step lc2 mem0 loc3 from3 to3 msg3 lc3 mem3 kind3):
  exists released1' lc1' lc2' lc3' sc3',
    <<STEP1: Local.promise_step lc0 mem0 loc3 from3 to3 msg3 lc1' mem3 kind3>> /\
    <<STEP2: Local.read_step lc1' mem3 loc1 ts1 val1 released1' ord1 lc2'>> /\
    <<STEP3: fulfill_step lc2' sc0 loc1 from2 to2 val2 released1' released2 ord2 lc3' sc3'>> /\
    <<RELEASED1: View.opt_le released1' released1>> /\
    <<LOCAL: sim_local SimPromises.bot lc3' lc3>> /\
    <<SC: TimeMap.le sc3' sc2>>.
Proof.
  exploit Local.read_step_future; try exact STEP1; eauto. i. des.
  exploit fulfill_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_fulfill_promise; try exact STEP2; try exact STEP3; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit reorder_read_promise; try exact STEP1; try exact STEP0; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit Local.read_step_future; eauto. i. des.
  exploit sim_local_fulfill_bot; try exact STEP4; try exact LOCAL; try exact REL1;
    try exact WF3; try exact WF5; try refl;
      eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  esplits; eauto.
Qed.

Lemma reorder_update_promise_diff
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 from3 to3 msg3 kind3
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3 mem3
      (DIFF: (loc1, ts1) <> (loc3, to3))
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: Local.promise_step lc2 mem0 loc3 from3 to3 msg3 lc3 mem3 kind3):
  exists lc1' lc2',
    <<STEP1: Local.promise_step lc0 mem0 loc3 from3 to3 msg3 lc1' mem3 kind3>> /\
    <<STEP2: Local.read_step lc1' mem3 loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<STEP3: fulfill_step lc2' sc0 loc1 from2 to2 val2 released1 released2 ord2 lc3 sc2>>.
Proof.
  exploit Local.read_step_future; try exact STEP1; eauto. i. des.
  exploit fulfill_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_fulfill_promise; try exact STEP2; try exact STEP3; eauto. i. des.
  exploit reorder_read_promise_diff; try exact STEP1; try exact STEP0; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_update_fulfill
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 from3 to3 val3 releasedm3 released3 ord3
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3 sc3
      (LOC: loc1 <> loc3)
      (TIME: ts1 <> to2)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (ORD3: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord3 Ordering.acqrel)
      (REL_WF: View.opt_wf releasedm3)
      (REL_CLOSED: Memory.closed_opt_view releasedm3 mem0)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: fulfill_step lc2 sc2 loc3 from3 to3 val3 releasedm3 released3 ord3 lc3 sc3):
  exists lc1' lc2' lc3' sc1' sc3',
    <<STEP1: fulfill_step lc0 sc0 loc3 from3 to3 val3 releasedm3 released3 ord3 lc1' sc1'>> /\
    <<STEP2: Local.read_step lc1' mem0 loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<STEP3: fulfill_step lc2' sc1' loc1 from2 to2 val2 released1 released2 ord2 lc3' sc3'>> /\
    <<LOCAL: sim_local SimPromises.bot lc3' lc3>> /\
    <<SC: TimeMap.le sc3' sc3>>.
Proof.
  guardH ORD3.
  exploit Local.read_step_future; try exact STEP1; eauto. i. des.
  exploit fulfill_step_future; try exact STEP2; eauto. i. des.
  exploit reorder_fulfill_fulfill; try exact STEP2; try exact STEP3; eauto. i. des.
  exploit fulfill_step_future; try exact STEP0; eauto; try by viewtac. i. des.
  exploit reorder_read_fulfill; try exact STEP1; try exact STEP0; eauto; try by viewtac. i. des.
  exploit fulfill_step_future; try exact STEP5; eauto; try by viewtac. i. des.
  exploit Local.read_step_future; try exact STEP6; eauto; try by viewtac. i. des.
  exploit sim_local_fulfill_bot; try exact STEP4; try exact LOCAL0; try refl; eauto. i. des.
  esplits; eauto.
  etrans; eauto.
Qed.

Lemma reorder_update_write
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 from3 to3 val3 releasedm3 released3 ord3 kind3
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3 sc3 mem3
      (LOC: loc1 <> loc3)
      (TIME: ts1 <> to2)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (ORD3: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord3 Ordering.acqrel)
      (REL_WF: View.opt_wf releasedm3)
      (REL_CLOSED: Memory.closed_opt_view releasedm3 mem0)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: Local.write_step lc2 sc2 mem0 loc3 from3 to3 val3 releasedm3 released3 ord3 lc3 sc3 mem3 kind3):
  exists released2' released3' lc1' lc2' lc3' sc1' sc3' mem1',
    <<STEP1: Local.write_step lc0 sc0 mem0 loc3 from3 to3 val3 releasedm3 released3' ord3 lc1' sc1' mem1' kind3>> /\
    <<STEP2: Local.read_step lc1' mem1' loc1 ts1 val1 released1 ord1 lc2'>> /\
    <<STEP3: fulfill_step lc2' sc1' loc1 from2 to2 val2 released1 released2' ord2 lc3' sc3'>> /\
    <<LOCAL: sim_local SimPromises.bot lc3' lc3>> /\
    <<RELEASED2: View.opt_le released2' released2>> /\
    <<RELEASED3: View.opt_le released3' released3>> /\
    <<SC: TimeMap.le sc3' sc3>> /\
    <<MEM: sim_memory mem1' mem3>>.
Proof.
  guardH ORD3.
  exploit Local.read_step_future; eauto. i. des.
  exploit fulfill_step_future; eauto. i. des.
  exploit write_promise_fulfill; eauto. i. des.
  exploit reorder_update_promise_diff; try exact STEP1; try exact STEP2; try exact STEP0; eauto.
  { ii. inv H. congr. }
  i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit Local.read_step_future; eauto. i. des.
  hexploit reorder_update_fulfill; try exact STEP6; try exact STEP7; try exact STEP4;
    eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  exploit fulfill_step_future; try exact STEP8; try exact WF3;
    eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  exploit promise_fulfill_write_sim_memory; eauto.
  { i. hexploit ORD; eauto. i. des.
    splits; auto.
    erewrite Local.read_step_promises; [|eauto].
    ii. unfold Memory.get in GET.
    erewrite fulfill_step_promises_diff in GET; eauto.
    exploit H0; eauto.
  }
  i. des.
  inv STEP1.
  inversion STEP. inv WRITE. hexploit MemoryFacts.promise_get1_diff; try exact PROMISE; eauto.
  { ii. inv H. congr. }
  i. des.
  esplits; try exact STEP10; eauto; try refl.
  inv STEP9. econs; eauto.
Qed.

Lemma reorder_update_update
      loc1 ts1 val1 released1 ord1
      from2 to2 val2 released2 ord2
      loc3 ts3 val3 released3 ord3
      from4 to4 val4 released4 ord4 kind4
      lc0 sc0 mem0
      lc1
      lc2 sc2
      lc3
      lc4 sc4 mem4
      (LOC: loc1 <> loc3)
      (TIME: ts1 <> to2)
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (ORD3: Ordering.le ord3 Ordering.relaxed)
      (ORD: Ordering.le ord1 Ordering.acqrel \/ Ordering.le ord4 Ordering.acqrel)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.read_step lc0 mem0 loc1 ts1 val1 released1 ord1 lc1)
      (STEP2: fulfill_step lc1 sc0 loc1 from2 to2 val2 released1 released2 ord2 lc2 sc2)
      (STEP3: Local.read_step lc2 mem0 loc3 ts3 val3 released3 ord3 lc3)
      (STEP4: Local.write_step lc3 sc2 mem0 loc3 from4 to4 val4 released3 released4 ord4 lc4 sc4 mem4 kind4):
  exists released2' released4' lc1' lc2' lc3' lc4' sc2' sc4' mem2',
    <<STEP1: Local.read_step lc0 mem0 loc3 ts3 val3 released3 ord3 lc1'>> /\
    <<STEP2: Local.write_step lc1' sc0 mem0 loc3 from4 to4 val4 released3 released4' ord4 lc2' sc2' mem2' kind4>> /\
    <<STEP3: Local.read_step lc2' mem2' loc1 ts1 val1 released1 ord1 lc3'>> /\
    <<STEP4: fulfill_step lc3' sc2' loc1 from2 to2 val2 released1 released2' ord2 lc4' sc4'>> /\
    <<LOCAL: sim_local SimPromises.bot lc4' lc4>> /\
    <<RELEASED2: View.opt_le released2' released2>> /\
    <<RELEASED4: View.opt_le released4' released4>> /\
    <<SC: TimeMap.le sc4' sc4>> /\
    <<MEM: sim_memory mem2' mem4>>.
Proof.
  guardH ORD.
  exploit reorder_update_read; try exact STEP2; try exact STEP1; try exact STEP3; eauto. i. des.
  exploit Local.read_step_future; try exact STEP0; eauto. i. des.
  hexploit reorder_update_write; try exact STEP5; try exact STEP6; try exact STEP4; eauto. i. des.
  esplits; eauto.
Qed.

Lemma reorder_fence_read
      ordr1 ordw1
      loc2 to2 val2 released2 ord2
      lc0 sc0 mem0
      lc1 sc1
      lc2
      (ORDR1: Ordering.le ordr1 Ordering.acqrel)
      (ORDW1: Ordering.le ordw1 Ordering.relaxed)
      (ORD2: Ordering.le ord2 Ordering.plain \/ Ordering.le Ordering.acqrel ord2)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.fence_step lc0 sc0 ordr1 ordw1 lc1 sc1)
      (STEP2: Local.read_step lc1 mem0 loc2 to2 val2 released2 ord2 lc2):
  exists lc1' lc2' sc2',
    <<STEP1: Local.read_step lc0 mem0 loc2 to2 val2 released2 ord2 lc1'>> /\
    <<STEP2: Local.fence_step lc1' sc0 ordr1 ordw1 lc2' sc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc1>>.
Proof.
  guardH ORD2. inv STEP1. inv STEP2.
  esplits.
  - econs; eauto.
    eapply TViewFacts.readable_mon; eauto; try refl.
    etrans.
    + apply TViewFacts.write_fence_tview_incr. apply WF0.
    + apply TViewFacts.write_fence_tview_mon; try refl; try apply WF0.
      apply TViewFacts.read_fence_tview_incr. apply WF0.
  - econs; eauto.
  - s. econs; s.
    + inversion MEM0. exploit CLOSED; eauto. i. des.
      exploit TViewFacts.read_future; try exact GET; try apply WF0; eauto.
      { inv MEM0. exploit CLOSED0; eauto. i. des. inv MSG_WF. ss. }
      i. des.
      exploit TViewFacts.read_fence_future; try apply WF0; eauto. i. des.
      etrans; [|etrans].
      * apply TViewFacts.write_fence_tview_mon; [|refl|refl|].
        { apply ReorderTView.read_fence_read_tview; auto. apply WF0. }
        { inversion MEM0. exploit CLOSED; eauto. i. des.
          eapply TViewFacts.read_fence_future; eauto.
        }
      * apply ReorderTView.write_fence_read_tview; eauto.
        { inv MEM0. exploit CLOSED0; eauto. i. des. inv MSG_WF. ss. }
      * apply TViewFacts.read_tview_mon; auto; try refl.
        { eapply TViewFacts.write_fence_future; eauto. }
        { inv MEM0. exploit CLOSED0; eauto. i. des. inv MSG_WF. ss. }
    + apply SimPromises.sem_bot.
  - s. etrans.
    + apply TViewFacts.write_fence_sc_mon; [|refl|refl].
      apply ReorderTView.read_fence_read_tview; auto. apply WF0.
    + eapply ReorderTView.write_fence_read_sc; auto.
      eapply TViewFacts.read_fence_future; eauto; apply WF0.
Qed.

Lemma reorder_fence_promise
      ordr1 ordw1
      loc2 from2 to2 msg2
      lc0 sc0 mem0
      lc1 sc1
      lc2 mem2
      kind
      (ORDW1: Ordering.le ordw1 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.fence_step lc0 sc0 ordr1 ordw1 lc1 sc1)
      (STEP2: Local.promise_step lc1 mem0 loc2 from2 to2 msg2 lc2 mem2 kind):
  exists lc1',
    <<STEP1: Local.promise_step lc0 mem0 loc2 from2 to2 msg2 lc1' mem2 kind>> /\
    <<STEP2: Local.fence_step lc1' sc0 ordr1 ordw1 lc2 sc1>>.
Proof.
  inv STEP1. inv STEP2. ss.
  esplits.
  - econs; eauto.
  - econs; eauto.
    + s. i. destruct ordw1; inv ORDW1; inv H.
    + s. i. destruct ordw1; inv ORDW1; inv H.
Qed.

Lemma reorder_fence_fulfill
      ordr1 ordw1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      lc0 sc0 mem0
      lc1 sc1
      lc2 sc2
      (ORDR1: Ordering.le ordr1 Ordering.acqrel)
      (ORDW1: Ordering.le ordw1 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (REL2_WF: View.opt_wf releasedm2)
      (REL2_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (STEP1: Local.fence_step lc0 sc0 ordr1 ordw1 lc1 sc1)
      (STEP2: fulfill_step lc1 sc1 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2):
  exists lc1' lc2' sc1' sc2',
    <<STEP1: fulfill_step lc0 sc0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc1' sc1'>> /\
    <<STEP2: Local.fence_step lc1' sc1' ordr1 ordw1 lc2' sc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc2>>.
Proof.
  inv STEP1. inv STEP2.
  exploit TViewFacts.read_fence_future; try apply WF0; eauto. i. des.
  hexploit TViewFacts.write_fence_future; eauto. i. des.
  esplits.
  - econs; eauto.
    + etrans; eauto. unfold TView.write_released. condtac; econs.
      repeat apply View.join_spec.
      * rewrite <- View.join_l. refl.
      * rewrite <- ? View.join_r.
        eapply TViewFacts.write_tview_mon; eauto; try refl.
        { etrans.
          - apply TViewFacts.write_fence_tview_incr. apply WF0.
          - apply TViewFacts.write_fence_tview_mon; try refl; try apply WF0.
            apply TViewFacts.read_fence_tview_incr. apply WF0.
        }
    + eapply TViewFacts.writable_mon; eauto; try refl.
      * etrans.
        { apply TViewFacts.read_fence_tview_incr. apply WF0. }
        { apply TViewFacts.write_fence_tview_incr.
          eapply TViewFacts.read_fence_future; apply WF0.
        }
      * apply TViewFacts.write_fence_sc_incr.
  - econs; eauto.
    + ss. ii. revert GET.
      erewrite Memory.remove_o; eauto. condtac; ss. i. eapply RELEASE; eauto.
    + ss. ii. subst. erewrite PROMISES in REMOVE; eauto.
      eapply Memory.remove_get0 in REMOVE. des.
      erewrite Memory.bot_get in *. ss.
  - s. econs; s.
    + etrans; [|etrans].
      * apply TViewFacts.write_fence_tview_mon; [|refl|refl|].
        { apply ReorderTView.read_fence_write_tview; auto. apply WF0. }
        { exploit Memory.remove_get0; eauto. s. i. des.
          inv WF0. exploit PROMISES0; eauto. i.
          exploit TViewFacts.write_future_fulfill; try exact SC0; eauto.
          { inv MEM0. exploit CLOSED; eauto. i. des. inv MSG_CLOSED. ss.  }
          i. des.
          eapply TViewFacts.read_fence_future; eauto.
        }
      * apply ReorderTView.write_fence_write_tview; auto.
      * apply TViewFacts.write_tview_mon; auto; try refl.
        apply TViewFacts.write_fence_sc_incr.
    + apply SimPromises.sem_bot.
  - etrans.
    + apply TViewFacts.write_fence_sc_mon; [|refl|refl].
      apply ReorderTView.read_fence_write_tview; auto. apply WF0.
    + eapply ReorderTView.write_fence_write_sc; auto.
Grab Existential Variables.
  { apply TimeMap.bot. }
Qed.

Lemma reorder_fence_write
      ordr1 ordw1
      loc2 from2 to2 val2 releasedm2 released2 ord2
      lc0 sc0 mem0
      lc1 sc1
      lc2 sc2 mem2 kind
      (ORDR1: Ordering.le ordr1 Ordering.acqrel)
      (ORDW1: Ordering.le ordw1 Ordering.relaxed)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (REL2_WF: View.opt_wf releasedm2)
      (REL2_CLOSED: Memory.closed_opt_view releasedm2 mem0)
      (STEP1: Local.fence_step lc0 sc0 ordr1 ordw1 lc1 sc1)
      (STEP2: Local.write_step lc1 sc1 mem0 loc2 from2 to2 val2 releasedm2 released2 ord2 lc2 sc2 mem2 kind):
  exists released2' lc1' lc2' sc1' sc2' mem1',
    <<STEP1: Local.write_step lc0 sc0 mem0 loc2 from2 to2 val2 releasedm2 released2' ord2 lc1' sc1' mem1' kind>> /\
    <<STEP2: Local.fence_step lc1' sc1' ordr1 ordw1 lc2' sc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<RELEASED2: View.opt_le released2' released2>> /\
    <<SC: TimeMap.le sc2' sc2>> /\
    <<MEM: sim_memory mem1' mem2>>.
Proof.
  exploit Local.fence_step_future; eauto. i. des.
  exploit write_promise_fulfill; eauto. i. des.
  exploit reorder_fence_promise; try exact STEP1; try exact STEP0; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des.
  exploit reorder_fence_fulfill; try exact STEP5; try exact STEP3;
    eauto using Memory.future_closed_opt_view, Memory.future_closed_timemap. i. des.
  exploit promise_fulfill_write_sim_memory; eauto.
  { i. hexploit ORD; eauto. i. des.
    splits; auto. inv STEP1. auto.
  }
  i. des.
  esplits; eauto.
Qed.

Lemma reorder_fence_fence
      ordr1 ordw1
      ordr2 ordw2
      lc0 sc0 mem0
      lc1 sc1
      lc2 sc2
      (ORDR1: Ordering.le ordr1 Ordering.acqrel)
      (ORDW1: Ordering.le ordw1 Ordering.relaxed)
      (ORDR2: Ordering.le ordr2 Ordering.relaxed)
      (ORDW2: Ordering.le ordw2 Ordering.acqrel)
      (WF0: Local.wf lc0 mem0)
      (SC0: Memory.closed_timemap sc0 mem0)
      (MEM0: Memory.closed mem0)
      (STEP1: Local.fence_step lc0 sc0 ordr1 ordw1 lc1 sc1)
      (STEP2: Local.fence_step lc1 sc1 ordr2 ordw2 lc2 sc2):
  exists lc1' lc2' sc1' sc2',
    <<STEP1: Local.fence_step lc0 sc0 ordr2 ordw2 lc1' sc1'>> /\
    <<STEP2: Local.fence_step lc1' sc1' ordr1 ordw1 lc2' sc2'>> /\
    <<LOCAL: sim_local SimPromises.bot lc2' lc2>> /\
    <<SC: TimeMap.le sc2' sc2>>.
Proof.
  inv STEP1. inv STEP2. ss.
  esplits.
  - econs; eauto.
  - econs; eauto.
  - ss. econs; ss.
    + unfold TView.write_fence_tview, TView.write_fence_sc.
      econs; repeat (try condtac; aggrtac; try apply WF0).
    + apply SimPromises.sem_bot.
  - unfold TView.write_fence_sc.
    repeat (try condtac; aggrtac; try apply WF0).
Qed.