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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.
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 BoolMap.
Require Import Promises.
Require Import Cell.
Require Import Memory.
Require Import Global.
Require Import TView.
Require Import Local.

Require Import SimLocal.
Require Import SimMemory.
Require Import SimGlobal.

Set Implicit Arguments.

(** rel-fenced *)

Definition local_relfenced (lc:Local.t) :=
  (Local.mk (TView.mk
               (fun _ => (TView.cur (Local.tview lc)))
               (TView.cur (Local.tview lc))
               (TView.acq (Local.tview lc)))
            (Local.promises lc)
            (Local.reserves lc)).

Lemma local_relfenced_wf
      lc gl
      (WF: Local.wf lc gl):
  Local.wf (local_relfenced lc) gl.
Proof.
  inv WF. econs; ss; eauto.
  - inv TVIEW_WF. econs; ss. refl.
  - inv TVIEW_CLOSED. econs; ss.
Qed.

Lemma local_relfenced_sim_local
      lc gl
      (WF: Local.wf lc gl):
  sim_local lc (local_relfenced lc).
Proof.
  econs; ss. econs; try refl; apply WF.
Qed.

Lemma sim_local_relfenced
      lc_src
      lc_tgt gl_tgt
      (LOCAL: sim_local lc_src lc_tgt)
      (LC_WF_TGT: Local.wf lc_tgt gl_tgt):
  sim_local lc_src (local_relfenced lc_tgt).
Proof.
  etrans; eauto using local_relfenced_sim_local.
Qed.

Lemma sim_local_internal_relfenced
      e
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      (STEP_TGT: Local.internal_step e lc1_tgt gl1_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists lc2_src gl2_src,
    <<STEP_SRC: Local.internal_step e lc1_src gl1_src lc2_src gl2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_relfenced lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  exploit local_relfenced_wf; try exact LC_WF1_TGT. i.
  exploit sim_local_internal; try exact LOCAL1; eauto.
  unfold local_relfenced. destruct lc1_tgt.
  inv STEP_TGT; inv LOCAL; ss; eauto.
Qed.

Lemma sim_local_read_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      loc ts val released_tgt ord_src ord_tgt
      (STEP_TGT: Local.read_step lc1_tgt gl1_tgt loc ts val released_tgt ord_tgt lc2_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt)
      (ORD: Ordering.le ord_src ord_tgt):
  exists released_src lc2_src,
    <<REL: View.opt_le released_src released_tgt>> /\
    <<STEP_SRC: Local.read_step lc1_src gl1_src loc ts val released_src ord_src lc2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_relfenced lc2_tgt)>>.
Proof.
  inv LOCAL1. inv STEP_TGT.
  exploit sim_memory_get; try exact GET; try apply GLOBAL1. i. des. inv MSG.
  esplits; eauto.
  - econs; eauto; try by etrans; eauto.
    eapply TViewFacts.readable_mon; eauto. apply TVIEW.
  - econs; eauto. inv TVIEW. ss. econs; s.
    + i. unfold LocFun.find. etrans; [apply LC_WF1_SRC|].
      eauto using View.join_l.
    + repeat apply View.join_le; ss.
      * unfold View.singleton_ur_if. repeat condtac; viewtac.
      * repeat condtac; viewtac.
    + repeat apply View.join_le; ss.
      * unfold View.singleton_ur_if. repeat condtac; viewtac.
      * repeat condtac; viewtac.
Qed.

Lemma sim_local_write_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      loc from to val releasedm_src releasedm_tgt released_tgt ord_src ord_tgt
      (RELM_LE: View.opt_le releasedm_src releasedm_tgt)
      (RELM_WF_SRC: View.opt_wf releasedm_src)
      (RELM_CLOSED_SRC: Memory.closed_opt_view releasedm_src (Global.memory gl1_src))
      (RELM_WF_TGT: View.opt_wf releasedm_tgt)
      (ORD_TGT: Ordering.le ord_tgt Ordering.plain \/ Ordering.le Ordering.acqrel ord_tgt)
      (ORD: Ordering.le ord_src ord_tgt)
      (STEP_TGT: Local.write_step lc1_tgt gl1_tgt loc from to val releasedm_tgt released_tgt ord_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists released_src lc2_src gl2_src,
    <<STEP_SRC: Local.write_step lc1_src gl1_src loc from to val releasedm_src released_src ord_src lc2_src gl2_src>> /\
    <<RELEASED: View.opt_le released_src released_tgt>> /\
    <<LOCAL2: sim_local lc2_src (local_relfenced lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  guardH ORD_TGT. inv STEP_TGT.
  assert (REL:
   View.opt_le
     (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)
     (TView.write_released (Local.tview lc1_tgt) loc to releasedm_tgt ord_tgt)).
  { unfold TView.write_released.
    condtac; [|econs].
    condtac; try by (destruct ord_src, ord_tgt; ss).
    econs. unfold TView.write_tview. s.
    repeat (condtac; aggrtac); try by apply LC_WF1_TGT.
    + rewrite <- View.join_r. rewrite <- ? View.join_l. apply LOCAL1.
    + rewrite <- View.join_r. rewrite <- ? View.join_l.
      etrans; [|apply LOCAL1]. apply LC_WF1_SRC.
    + unguard. des; destruct ord_src, ord_tgt; ss.
  }
  assert (REL_WF:
   View.opt_wf (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)).
  { unfold TView.write_released. condtac; econs.
    repeat (try condtac; viewtac; try apply LC_WF1_SRC).
  }
  exploit sim_memory_add_exists; try exact WRITE; try apply GLOBAL1.
  { econs 1. exact REL_WF. }
  { econs; try exact REL; try refl.
    apply ord_implb. eassumption.
  }
  i. des.
  exploit sim_local_fulfill; try apply LOCAL1; eauto. i.
  esplits.
  - econs; eauto.
    eapply TViewFacts.writable_mon; try exact WRITABLE; eauto. apply LOCAL1.
  - ss.
  - inv LOCAL1. ss. econs; ss. inv TVIEW. econs; ss.
    + i. rewrite LocFun.add_spec. condtac; ss.
      * subst. unfold LocFun.find.
        condtac; apply View.join_le; viewtac.
        etrans; eauto. refl.
      * unfold LocFun.find. etrans; [apply LC_WF1_SRC|].
        eauto using View.join_l.
    + apply View.join_le; viewtac.
    + apply View.join_le; viewtac.
  - econs; ss. apply GLOBAL1.
Qed.

Lemma sim_local_update_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      lc3_tgt gl3_tgt
      loc ts1 val1 released1_tgt ord1_src ord1_tgt
      from2 to2 val2 released2_tgt ord2_src ord2_tgt
      (STEP1_TGT: Local.read_step lc1_tgt gl1_tgt loc ts1 val1 released1_tgt ord1_tgt lc2_tgt)
      (STEP2_TGT: Local.write_step lc2_tgt gl1_tgt loc from2 to2 val2 released1_tgt released2_tgt ord2_tgt lc3_tgt gl3_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt)
      (ORD1: Ordering.le ord1_src ord1_tgt)
      (ORD2: Ordering.le ord2_src ord2_tgt)
      (ORD2_TGT: Ordering.le ord2_tgt Ordering.plain \/ Ordering.le Ordering.acqrel ord2_tgt):
  exists released1_src released2_src lc2_src lc3_src gl3_src,
    <<REL1: View.opt_le released1_src released1_tgt>> /\
    <<REL2: View.opt_le released2_src released2_tgt>> /\
    <<STEP1_SRC: Local.read_step lc1_src gl1_src loc ts1 val1 released1_src ord1_src lc2_src>> /\
    <<STEP2_SRC: Local.write_step lc2_src gl1_src loc from2 to2 val2 released1_src released2_src ord2_src lc3_src gl3_src>> /\
    <<LOCAL3: sim_local lc3_src (local_relfenced lc3_tgt)>> /\
    <<GLOBAL3: sim_global gl3_src gl3_tgt>>.
Proof.
  guardH ORD2_TGT.
  exploit Local.read_step_future; eauto. i. des.
  exploit sim_local_read_relfenced; eauto. i. des.
  exploit Local.read_step_future; eauto. i. des.
  hexploit sim_local_write_relfenced; eauto. i. des.
  esplits; eauto.
Qed.

Lemma sim_local_fence_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      ordr_src ordw_src
      ordr_tgt ordw_tgt
      (STEP_TGT: Local.fence_step lc1_tgt gl1_tgt ordr_tgt ordw_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (ORDR: Ordering.le ordr_src ordr_tgt)
      (ORDW: Ordering.le ordw_src ordw_tgt)
      (ORDR_TGT: Ordering.le ordr_tgt Ordering.acqrel)
      (ORDW_TGT: Ordering.le ordw_tgt Ordering.relaxed):
  exists lc2_src gl2_src,
    <<STEP_SRC: Local.fence_step lc1_src gl1_src ordr_src ordw_src lc2_src gl2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_relfenced lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  inv STEP_TGT. esplits.
  - econs; eauto.
    i. inv LOCAL1. ss. rewrite PROMISES0.
    apply PROMISES. destruct ordw_src, ordw_tgt; ss.
  - inv LOCAL1. inv TVIEW. econs; ss.
    econs; s; unfold LocFun.find; repeat condtac; aggrtac.
    + etrans; eauto. apply LC_WF1_TGT.
    + etrans; eauto. apply LC_WF1_TGT.
    + etrans; eauto. apply LC_WF1_TGT.
  - inv GLOBAL1. econs; ss.
    unfold TView.write_fence_sc.
    repeat (condtac; viewtac).
Qed.

Lemma sim_local_is_racy_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to ord_src ord_tgt
      (STEP_TGT: Local.is_racy lc1_tgt gl1_tgt loc to ord_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (ORD: Ordering.le ord_src ord_tgt):
  <<STEP_SRC: Local.is_racy lc1_src gl1_src loc to ord_src>>.
Proof.
  inv LOCAL1. inv GLOBAL1. inv STEP_TGT; ss.
  - econs; congr.
  - exploit sim_memory_get; try exact GET; try eassumption. i. des. inv MSG0.
    econs; try exact GET0.
    + eapply TViewFacts.racy_view_mon; eauto. apply TVIEW.
    + i. destruct na, na1; ss.
      exploit MSG; ss. destruct ord_src, ord_tgt; ss.
Qed.

Lemma sim_local_racy_read_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to val ord_src ord_tgt
      (STEP_TGT: Local.racy_read_step lc1_tgt gl1_tgt loc to val ord_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (ORD: Ordering.le ord_src ord_tgt):
  <<STEP_SRC: Local.racy_read_step lc1_src gl1_src loc to val ord_src>>.
Proof.
  inv STEP_TGT.
  exploit sim_local_is_racy_relfenced; eauto.
Qed.

Lemma sim_local_racy_write_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to ord_src ord_tgt
      (STEP_TGT: Local.racy_write_step lc1_tgt gl1_tgt loc to ord_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (ORD: Ordering.le ord_src ord_tgt):
  <<STEP_SRC: Local.racy_write_step lc1_src gl1_src loc to ord_src>>.
Proof.
  inv STEP_TGT.
  exploit sim_local_is_racy_relfenced; eauto.
Qed.

Lemma sim_local_racy_update_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to ordr_src ordw_src ordr_tgt ordw_tgt
      (STEP_TGT: Local.racy_update_step lc1_tgt gl1_tgt loc to ordr_tgt ordw_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (ORDR: Ordering.le ordr_src ordr_tgt)
      (ORDW: Ordering.le ordw_src ordw_tgt):
  <<STEP_SRC: Local.racy_update_step lc1_src gl1_src loc to ordr_src ordw_src>>.
Proof.
  inv STEP_TGT; eauto.
  exploit sim_local_is_racy_relfenced; eauto.
Qed.

Lemma sim_local_fence_src_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt):
  exists lc2_src gl2_src,
    <<STEP_SRC: Local.fence_step lc1_src gl1_src Ordering.plain Ordering.acqrel lc2_src gl2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_relfenced lc1_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl1_tgt>>.
Proof.
  inv LOCAL1. inv TVIEW. ss.
  esplits.
  - econs; eauto. i. ss.
  - econs; eauto. econs; ss; eauto.
    repeat (condtac; aggrtac).
  - inv GLOBAL1. ss.
Qed.

Lemma sim_local_fence_tgt_relfenced
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      (STEP_TGT: Local.fence_step lc1_tgt gl1_tgt Ordering.plain Ordering.acqrel lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_relfenced lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt):
  <<LOCAL2: sim_local lc1_src lc2_tgt>> /\
  <<GLOBAL2: sim_global gl1_src gl2_tgt>>.
Proof.
  inv LOCAL1. inv TVIEW. inv STEP_TGT. splits.
  - econs; ss.
    unfold TView.read_fence_tview. condtac; ss.
    unfold TView.write_fence_tview. econs; repeat (condtac; aggrtac).
  - inv GLOBAL1. ss.
Qed.

(** acquired *)

Definition local_acquired (lc:Local.t) :=
  (Local.mk
     (TView.read_fence_tview (Local.tview lc) Ordering.acqrel)
     (Local.promises lc)
     (Local.reserves lc)).

Lemma local_acquired_wf
      lc gl
      (WF: Local.wf lc gl):
  Local.wf (local_acquired lc) gl.
Proof.
  inv WF. econs; ss.
  - inv TVIEW_WF. econs; ss.
    + condtac; ss. etrans; eauto.
    + condtac; ss. refl.
  - inv TVIEW_CLOSED. econs; ss.
Qed.

Lemma sim_local_internal_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      e lc2_tgt gl2_tgt
      (STEP_TGT: Local.internal_step e lc1_tgt gl1_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_acquired lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists lc2_src gl2_src,
    <<STEP_SRC: Local.internal_step e lc1_src gl1_src lc2_src gl2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_acquired lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  exploit local_acquired_wf; try exact LC_WF1_TGT. i.
  exploit sim_local_internal; try exact LOCAL1; eauto.
  unfold local_acquired. destruct lc1_tgt.
  inv STEP_TGT; inv LOCAL; ss; eauto.
Qed.

Lemma sim_local_read_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      loc ts val released_tgt
      (STEP_TGT: Local.read_step lc1_tgt gl1_tgt loc ts val released_tgt Ordering.relaxed lc2_tgt)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists released_src lc2_src,
    <<REL: View.opt_le released_src released_tgt>> /\
    <<STEP_SRC: Local.read_step lc1_src gl1_src loc ts val released_src Ordering.acqrel lc2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_acquired lc2_tgt)>>.
Proof.
  inv LOCAL1. inv STEP_TGT.
  exploit sim_memory_get; try apply GET; try apply GLOBAL1. i. des. inv MSG.
  esplits; eauto.
  - econs; eauto; try by (etrans; eauto). inv READABLE. econs; ss; i.
    + rewrite <- PLN. apply TVIEW.
    + rewrite <- RLX; ss. apply TVIEW.
  - econs; eauto. s.
    unfold TView.read_tview, TView.read_fence_tview. ss.
    econs; repeat (condtac; aggrtac).
    all: try by apply TVIEW.
    all: try by apply LC_WF1_TGT.
    + rewrite <- ? View.join_l. etrans; [apply TVIEW|]. apply LC_WF1_TGT.
    + inv GL_WF1_TGT. inv MEM_CLOSED.
      exploit CLOSED; eauto. i. des.
      apply View.unwrap_opt_wf. inv MSG_WF. ss.
    + rewrite <- ? View.join_l. apply TVIEW.
    + inv GL_WF1_TGT. inv MEM_CLOSED.
      exploit CLOSED; eauto. i. des.
      apply View.unwrap_opt_wf. inv MSG_WF. ss.
Qed.

Lemma sim_local_write_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      loc from to val releasedm_src releasedm_tgt released_tgt ord_src ord_tgt
      (RELM_LE: View.opt_le releasedm_src releasedm_tgt)
      (RELM_WF_SRC: View.opt_wf releasedm_src)
      (RELM_CLOSED_SRC: Memory.closed_opt_view releasedm_src (Global.memory gl1_src))
      (RELM_WF_TGT: View.opt_wf releasedm_tgt)
      (RELM_TO_TGT: Time.le (View.rlx (View.unwrap releasedm_tgt) loc) from)
      (ORD: Ordering.le ord_src ord_tgt)
      (ORD_TGT: Ordering.le ord_tgt Ordering.strong_relaxed)
      (STEP_TGT: Local.write_step lc1_tgt gl1_tgt loc from to val releasedm_tgt released_tgt ord_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_acquired lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt)
      (ACQUIRED1: View.le (TView.cur (Local.tview lc1_src))
                          (View.join (TView.cur (Local.tview lc1_tgt)) (View.unwrap releasedm_tgt))):
  exists released_src lc2_src gl2_src,
    <<STEP_SRC: Local.write_step lc1_src gl1_src loc from to val releasedm_src released_src ord_src lc2_src gl2_src>> /\
    <<REL: View.opt_le released_src released_tgt>> /\
    <<LOCAL2: sim_local lc2_src (local_acquired lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  inv STEP_TGT.
  assert (REL:
   View.opt_le
     (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)
     (TView.write_released (Local.tview lc1_tgt) loc to releasedm_tgt ord_tgt)).
  { unfold TView.write_released, TView.write_tview. ss. viewtac.
    repeat (condtac; aggrtac;
            try match goal with
                | [|- View.opt_le _ _] => econs
                end);
      try apply LC_WF1_TGT.
    - etrans; eauto. aggrtac.
    - etrans; [apply LC_WF1_SRC|]. etrans; eauto. aggrtac.
    - etrans; [apply LOCAL1|]. aggrtac.
  }
  assert (REL_WF:
   View.opt_wf (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)).
  { unfold TView.write_released. condtac; econs.
    repeat (try condtac; viewtac; try apply LC_WF1_SRC).
  }
  exploit sim_memory_add_exists; try exact WRITE; try apply GLOBAL1.
  { econs 1. exact REL_WF. }
  { econs; try exact REL; try refl.
    apply ord_implb. eassumption.
  }
  i. des.
  exploit sim_local_fulfill; try apply LOCAL1; try exact ORD; eauto. i.
  esplits.
  - econs; eauto.
    inv WRITABLE. econs.
    eapply TimeFacts.le_lt_lt; [apply ACQUIRED1|]. viewtac.
    eapply TimeFacts.le_lt_lt; eauto.
    exploit Memory.add_ts; eauto.
  - ss.
  - inv LOCAL1. ss. econs; ss.
    unfold TView.write_tview, TView.read_fence_tview. ss.
    econs; ss; repeat (try condtac; aggrtac).
    all: try by destruct ord_src, ord_tgt.
    all: try by apply LC_WF1_TGT.
    + etrans; [apply TVIEW|]. aggrtac.
    + etrans; [apply TVIEW|]. aggrtac.
    + etrans; [apply LC_WF1_SRC|].
      etrans; [apply TVIEW|]. aggrtac.
    + etrans; [apply TVIEW|]. aggrtac.
  - econs; ss. apply GLOBAL1.
Qed.

Lemma sim_local_update_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      lc3_tgt gl3_tgt
      loc ts1 val1 released1_tgt
      to2 val2 released2_tgt ord2_src ord2_tgt
      (STEP1_TGT: Local.read_step lc1_tgt gl1_tgt loc ts1 val1 released1_tgt Ordering.relaxed lc2_tgt)
      (STEP2_TGT: Local.write_step lc2_tgt gl1_tgt loc ts1 to2 val2 released1_tgt released2_tgt ord2_tgt lc3_tgt gl3_tgt)
      (ORD2: Ordering.le ord2_src ord2_tgt)
      (ORD2_TGT: Ordering.le ord2_tgt Ordering.strong_relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists released1_src released2_src lc2_src lc3_src gl3_src,
    <<REL1: View.opt_le released1_src released1_tgt>> /\
    <<REL2: View.opt_le released2_src released2_tgt>> /\
    <<STEP1_SRC: Local.read_step lc1_src gl1_src loc ts1 val1 released1_src Ordering.acqrel lc2_src>> /\
    <<STEP2_SRC: Local.write_step lc2_src gl1_src loc ts1 to2 val2 released1_src released2_src ord2_src lc3_src gl3_src>> /\
    <<LOCAL3: sim_local lc3_src (local_acquired lc3_tgt)>> /\
    <<GLOBAL3: sim_global gl3_src gl3_tgt>>.
Proof.
  exploit sim_local_read_acquired; eauto. i. des.
  exploit Local.read_step_future; try exact STEP1_TGT; eauto. i. des.
  exploit Local.read_step_future; try exact STEP_SRC; eauto. i. des.
  exploit sim_local_write_acquired; try exact STEP2_TGT; try exact LOCAL2; eauto.
  { inv STEP1_TGT. inv STEP_SRC. ss.
    do 2 (condtac; ss).
    rewrite View.join_bot_r.
    repeat apply View.join_le; try apply LOCAL1; try refl.
    inv REL; ss. apply View.bot_spec.
  }
  i. des.
  esplits; try exact STEP_SRC; try exact STEP_SRC0; eauto.
Qed.

Lemma sim_local_is_racy_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to
      (STEP_TGT: Local.is_racy lc1_tgt gl1_tgt loc to Ordering.relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt):
  <<STEP_SRC: Local.is_racy lc1_src gl1_src loc to Ordering.acqrel>>.
Proof.
  exploit sim_local_is_racy; try exact STEP_TGT;
    try exact LOCAL1; try exact GLOBAL1; try refl; eauto. i. des.
  inv x0; eauto.
Qed.

Lemma sim_local_racy_read_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to val
      (STEP_TGT: Local.racy_read_step lc1_tgt gl1_tgt loc to val Ordering.relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt):
  <<STEP_SRC: Local.racy_read_step lc1_src gl1_src loc to val Ordering.acqrel>>.
Proof.
  inv STEP_TGT.
  exploit sim_local_is_racy_acquired; eauto.
Qed.

Lemma sim_local_racy_update_acquired
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to ow
      (STEP_TGT: Local.racy_update_step lc1_tgt gl1_tgt loc to Ordering.relaxed ow)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt):
  <<STEP_SRC: Local.racy_update_step lc1_src gl1_src loc to Ordering.acqrel ow>>.
Proof.
  inv STEP_TGT; eauto.
  exploit sim_local_is_racy_acquired; eauto.
Qed.

(* released *)

Lemma sim_local_fulfill_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc prm2 gprm2
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (FULFILL_TGT: Promises.fulfill lc1_tgt.(Local.promises) gl1_tgt.(Global.promises) loc Ordering.strong_relaxed prm2 gprm2):
  Promises.fulfill lc1_src.(Local.promises) gl1_src.(Global.promises) loc Ordering.acqrel prm2 gprm2.
Proof.
  destruct lc1_src, lc1_tgt, gl1_src, gl1_tgt.
  inv LOCAL1. inv GLOBAL1. ss. subst.
  inv FULFILL_TGT; eauto.
Qed.

Lemma sim_local_write_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      loc from to val releasedm_src releasedm_tgt released_tgt
      (RELM_LE: View.opt_le releasedm_src releasedm_tgt)
      (RELM_WF_SRC: View.opt_wf releasedm_src)
      (RELM_CLOSED_SRC: Memory.closed_opt_view releasedm_src (Global.memory gl1_src))
      (RELM_WF_TGT: View.opt_wf releasedm_tgt)
      (STEP_TGT: Local.write_step lc1_tgt gl1_tgt loc from to val releasedm_tgt released_tgt Ordering.strong_relaxed lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt)
      (RELEASED1: View.le (TView.cur (Local.tview lc1_tgt))
                          (View.join ((TView.rel (Local.tview lc1_tgt)) loc) (View.singleton_ur loc to))):
  exists released_src lc2_src gl2_src,
    <<STEP_SRC: Local.write_step lc1_src gl1_src loc from to val releasedm_src released_src Ordering.acqrel lc2_src gl2_src>> /\
    <<REL: View.opt_le released_src released_tgt>> /\
    <<LOCAL2: sim_local lc2_src lc2_tgt>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  inv STEP_TGT.
  assert (REL:
   View.opt_le
     (TView.write_released (Local.tview lc1_src) loc to releasedm_src Ordering.acqrel)
     (TView.write_released (Local.tview lc1_tgt) loc to releasedm_tgt Ordering.strong_relaxed)).
  { unfold TView.write_released, TView.write_tview. ss. viewtac;
      try econs; repeat (condtac; aggrtac); try apply LC_WF1_TGT.
    rewrite <- View.join_r. etrans; eauto. apply LOCAL1.
  }
  assert (REL_WF:
   View.opt_wf (TView.write_released (Local.tview lc1_src) loc to releasedm_src Ordering.acqrel)).
  { unfold TView.write_released. condtac; econs.
    repeat (try condtac; viewtac; try apply LC_WF1_SRC).
  }
  exploit sim_memory_add_exists; try exact WRITE; try apply GLOBAL1.
  { econs 1. exact REL_WF. }
  { econs; try exact REL; [refl|].
    instantiate (1:=Ordering.le Ordering.acqrel Ordering.na).
    refl.
  }
  i. des.
  exploit sim_local_fulfill_released; try apply LOCAL1; eauto. i.
  esplits.
  - econs; eauto.
    inv WRITABLE. econs; ss. eapply TimeFacts.le_lt_lt; [apply LOCAL1|apply TS].
  - ss.
  - inv LOCAL1. econs; eauto. ss.
    unfold TView.write_tview, View.singleton_ur_if. repeat (condtac; aggrtac).
    econs; repeat (condtac; aggrtac);
      (try by etrans; [apply LOCAL1|aggrtac]);
      (try by rewrite <- ? View.join_r; econs; aggrtac);
      (try apply LC_WF1_TGT).
    + ss. i. unfold LocFun.find. repeat (condtac; aggrtac).
      * etrans; eauto. apply TVIEW.
      * apply TVIEW.
    + ss. aggrtac; try apply LC_WF1_TGT.
      rewrite <- ? View.join_l. apply TVIEW.
    + ss. aggrtac; try apply LC_WF1_TGT.
      rewrite <- ? View.join_l. apply TVIEW.
  - inv GLOBAL1. econs; ss.
Qed.

Lemma sim_local_update_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      lc3_tgt gl3_tgt
      loc ts1 val1 released1_tgt ord1_src ord1_tgt
      to2 val2 released2_tgt
      (STEP1_TGT: Local.read_step lc1_tgt gl1_tgt loc ts1 val1 released1_tgt ord1_tgt lc2_tgt)
      (STEP2_TGT: Local.write_step lc2_tgt gl1_tgt loc ts1 to2 val2 released1_tgt released2_tgt Ordering.strong_relaxed lc3_tgt gl3_tgt)
      (ORD1: Ordering.le ord1_src ord1_tgt)
      (ORD1_TGT: Ordering.le ord1_tgt Ordering.strong_relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt)
      (RELEASED1: View.le (TView.cur (Local.tview lc1_tgt)) ((TView.rel (Local.tview lc1_tgt)) loc)):
  exists released1_src released2_src lc2_src lc3_src gl3_src,
    <<STEP1_SRC: Local.read_step lc1_src gl1_src loc ts1 val1 released1_src ord1_src lc2_src>> /\
    <<STEP2_SRC: Local.write_step lc2_src gl1_src loc ts1 to2 val2 released1_src released2_src Ordering.acqrel lc3_src gl3_src>> /\
    <<REL1: View.opt_le released1_src released1_tgt>> /\
    <<REL2: View.opt_le released2_src released2_tgt>> /\
    <<LOCAL3: sim_local lc3_src lc3_tgt>> /\
    <<GLOBAL3: sim_global gl3_src gl3_tgt>>.
Proof.
  exploit sim_local_read; try exact STEP1_TGT; eauto. i. des.
  exploit Local.read_step_future; try exact STEP1_TGT; eauto. i. des.
  exploit Local.read_step_future; try exact STEP_SRC; eauto. i. des.
  exploit sim_local_write_released; try exact STEP2_TGT; eauto.
  { inv STEP1_TGT. ss.
    condtac; try by (destruct ord1_tgt; ss).
    rewrite View.join_bot_r.
    apply View.join_le; ss.
    inv STEP2_TGT. exploit Memory.add_ts; eauto. i.
    aggrtac. condtac; aggrtac.
  }
  i. des.
  esplits; eauto.
Qed.

Lemma sim_local_is_racy_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to
      (STEP_TGT: Local.is_racy lc1_tgt gl1_tgt loc to Ordering.strong_relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  <<STEP_SRC: Local.is_racy lc1_src gl1_src loc to Ordering.acqrel>>.
Proof.
  exploit sim_local_is_racy;
    try exact LOCAL1; try exact GLOBAL1; try refl; eauto. i. des.
  inv x0; eauto.
Qed.

Lemma sim_local_racy_write_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to
      (STEP_TGT: Local.racy_write_step lc1_tgt gl1_tgt loc to Ordering.strong_relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  <<STEP_SRC: Local.racy_write_step lc1_src gl1_src loc to Ordering.acqrel>>.
Proof.
  inv STEP_TGT.
  exploit sim_local_is_racy_released; eauto.
Qed.

Lemma sim_local_racy_update_released
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      loc to ordr
      (STEP_TGT: Local.racy_update_step lc1_tgt gl1_tgt loc to ordr Ordering.strong_relaxed)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  <<STEP_SRC: Local.racy_update_step lc1_src gl1_src loc to ordr Ordering.acqrel>>.
Proof.
  exploit sim_local_racy_update;
    try exact LOCAL1; try exact GLOBAL1; try refl; eauto. i. des.
  inv x0.
  - econs 1; eauto.
  - econs 2; eauto.
  - econs 3; eauto.
Qed.

(** acqrel *)

Definition local_acqrel (lc:Local.t) :=
  (Local.mk (TView.write_fence_tview
               (TView.read_fence_tview (Local.tview lc) Ordering.acqrel)
               TimeMap.bot
               Ordering.acqrel)
            (Local.promises lc)
            (Local.reserves lc)).

Lemma local_acqrel_wf
      lc gl
      (WF: Local.wf lc gl):
  Local.wf (local_acqrel lc) gl.
Proof.
  inv WF. econs; ss.
  - inv TVIEW_WF. econs; ss; repeat (condtac; ss).
    + rewrite View.join_bot_r. apply ACQ.
    + refl.
    + rewrite View.join_bot_r. refl.
  - inv TVIEW_CLOSED.
    econs; ss. condtac; ss.
    rewrite View.join_bot_r. apply ACQ.
Qed.

Lemma sim_local_internal_acqrel
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      e lc2_tgt gl2_tgt
      (STEP_TGT: Local.internal_step e lc1_tgt gl1_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_acqrel lc1_tgt))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists lc2_src gl2_src,
    <<STEP_SRC: Local.internal_step e lc1_src gl1_src lc2_src gl2_src>> /\
    <<LOCAL2: sim_local lc2_src (local_acqrel lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  exploit local_acqrel_wf; try exact LC_WF1_TGT. i.
  exploit sim_local_internal; try exact LOCAL1; eauto.
  destruct lc1_tgt.
  inv STEP_TGT; inv LOCAL; ss; eauto.
Qed.

Lemma sim_local_write_acqrel
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt gl2_tgt
      loc from to val releasedm_src releasedm_tgt released_tgt ord_src ord_tgt
      (RELM_LE: View.opt_le releasedm_src releasedm_tgt)
      (RELM_WF_SRC: View.opt_wf releasedm_src)
      (RELM_CLOSED_SRC: Memory.closed_opt_view releasedm_src (Global.memory gl1_src))
      (RELM_WF_TGT: View.opt_wf releasedm_tgt)
      (RELM_TGT: Time.le (View.rlx (View.unwrap releasedm_tgt) loc) from)
      (ORD: Ordering.le ord_src ord_tgt)
      (ORD_TGT: Ordering.le ord_tgt Ordering.acqrel)
      (STEP_TGT: Local.write_step lc1_tgt gl1_tgt loc from to val releasedm_tgt released_tgt ord_tgt lc2_tgt gl2_tgt)
      (LOCAL1: sim_local lc1_src (local_acquired lc1_tgt))
      (ACQUIRED1: View.le (TView.cur (Local.tview lc1_src))
                          (View.join (TView.cur (Local.tview lc1_tgt)) (View.unwrap releasedm_tgt)))
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists released_src lc2_src gl2_src,
    <<STEP_SRC: Local.write_step lc1_src gl1_src loc from to val releasedm_src released_src ord_src lc2_src gl2_src>> /\
    <<REL: View.opt_le released_src released_tgt>> /\
    <<LOCAL2: sim_local lc2_src (local_acqrel lc2_tgt)>> /\
    <<GLOBAL2: sim_global gl2_src gl2_tgt>>.
Proof.
  inv STEP_TGT.
  assert (REL:
   View.opt_le
     (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)
     (TView.write_released (Local.tview lc1_tgt) loc to releasedm_tgt ord_tgt)).
  { unfold TView.write_released, TView.write_tview. ss. viewtac.
    repeat (condtac; aggrtac;
            try match goal with
                | [|- View.opt_le _ _] => econs
                end);
      try apply LC_WF1_TGT.
    - etrans; eauto. aggrtac.
    - etrans; [apply LC_WF1_SRC|]. etrans; eauto. aggrtac.
    - etrans; [apply LOCAL1|]. aggrtac.
  }
  assert (REL_WF:
   View.opt_wf (TView.write_released (Local.tview lc1_src) loc to releasedm_src ord_src)).
  { unfold TView.write_released. condtac; econs.
    repeat (try condtac; viewtac; try apply LC_WF1_SRC).
  }
  exploit sim_memory_add_exists; try exact WRITE; try apply GLOBAL1.
  { econs 1. exact REL_WF. }
  { econs; try exact REL; try refl.
    apply ord_implb. eassumption.
  }
  i. des.
  exploit sim_local_fulfill; try apply LOCAL1; try exact ORD; eauto. i.
  exploit Memory.add_ts; eauto. i.
  esplits.
  - econs; eauto.
    inv WRITABLE. econs.
    eapply TimeFacts.le_lt_lt; [apply ACQUIRED1|]. viewtac.
    eapply TimeFacts.le_lt_lt; eauto.
  - ss.
  - inv LOCAL1. ss. econs; ss.
    unfold TView.write_tview, TView.write_fence_tview, TView.read_fence_tview. ss.
    econs; ss; repeat (condtac; aggrtac).
    all: try by destruct ord_src, ord_tgt.
    all: try by apply LC_WF1_TGT.
    + etrans; [apply TVIEW|]. repeat (try condtac; aggrtac).
    + etrans; [apply TVIEW|]. aggrtac.
      etrans; [apply LC_WF1_TGT|].
      etrans; [apply LC_WF1_TGT|]. aggrtac.
    + etrans; [apply TVIEW|]. aggrtac.
      etrans; [apply LC_WF1_TGT|].
      etrans; [apply LC_WF1_TGT|]. aggrtac.
    + etrans; [apply TVIEW|]. repeat (try condtac; aggrtac).
      etrans; [apply LC_WF1_TGT|].
      etrans; [apply LC_WF1_TGT|]. aggrtac.
    + etrans; [apply TVIEW|]. ss. condtac; aggrtac.
    + etrans; [apply TVIEW|]. aggrtac.
  - inv GLOBAL1. ss.
Qed.

Lemma sim_local_update_acqrel
      lc1_src gl1_src
      lc1_tgt gl1_tgt
      lc2_tgt
      lc3_tgt gl3_tgt
      loc ts1 val1 released1_tgt
      to2 val2 released2_tgt ord2_src ord2_tgt
      (STEP1_TGT: Local.read_step lc1_tgt gl1_tgt loc ts1 val1 released1_tgt Ordering.relaxed lc2_tgt)
      (STEP2_TGT: Local.write_step lc2_tgt gl1_tgt loc ts1 to2 val2 released1_tgt released2_tgt ord2_tgt lc3_tgt gl3_tgt)
      (ORD2: Ordering.le ord2_src ord2_tgt)
      (ORD2_TGT: Ordering.le ord2_tgt Ordering.acqrel)
      (LOCAL1: sim_local lc1_src lc1_tgt)
      (GLOBAL1: sim_global gl1_src gl1_tgt)
      (LC_WF1_SRC: Local.wf lc1_src gl1_src)
      (LC_WF1_TGT: Local.wf lc1_tgt gl1_tgt)
      (GL_WF1_SRC: Global.wf gl1_src)
      (GL_WF1_TGT: Global.wf gl1_tgt):
  exists released1_src released2_src lc2_src lc3_src gl3_src,
    <<REL1: View.opt_le released1_src released1_tgt>> /\
    <<REL2: View.opt_le released2_src released2_tgt>> /\
    <<STEP1_SRC: Local.read_step lc1_src gl1_src loc ts1 val1 released1_src Ordering.acqrel lc2_src>> /\
    <<STEP2_SRC: Local.write_step lc2_src gl1_src loc ts1 to2 val2 released1_src released2_src ord2_src lc3_src gl3_src>> /\
    <<LOCAL3: sim_local lc3_src (local_acqrel lc3_tgt)>> /\
    <<GLOBAL3: sim_global gl3_src gl3_tgt>>.
Proof.
  exploit sim_local_read_acquired; eauto. i. des.
  exploit Local.read_step_future; try exact STEP1_TGT; eauto. i. des.
  exploit Local.read_step_future; try exact STEP_SRC; eauto. i. des.
  exploit sim_local_write_acqrel; try exact STEP2_TGT; try exact LOCAL2; eauto.
  { inv STEP1_TGT. inv STEP_SRC. ss.
    do 2 (condtac; ss).
    rewrite View.join_bot_r.
    repeat apply View.join_le; try apply LOCAL1; try refl.
    inv REL; ss. apply View.bot_spec.
  }
  i. des.
  esplits; try exact STEP_SRC; try exact STEP_SRC0; eauto.
Qed.


Require Import VST.floyd.proofauto.
Import ListNotations.
Local Open Scope logic.
Require Import VST.zlist.sublist.

Require Import sha.HMAC256_functional_prog.
Require Import sha.general_lemmas.
Require Import sha.spec_sha.

Require Import hmacdrbg.entropy.
Require Import hmacdrbg.entropy_lemmas.
Require Import hmacdrbg.DRBG_functions.
Require Import hmacdrbg.HMAC_DRBG_algorithms.
Require Import hmacdrbg.HMAC256_DRBG_functional_prog.
Require Import hmacdrbg.hmac_drbg.
Require Import hmacdrbg.HMAC_DRBG_pure_lemmas.
Require Import hmacdrbg.spec_hmac_drbg.
Require Import hmacdrbg.HMAC_DRBG_common_lemmas.
Require Import hmacdrbg.spec_hmac_drbg_pure_lemmas.
Require Import VST.floyd.library.

Require Import hmacdrbg.verif_hmac_drbg_seed_common.

Module Instantiate_eq.

Definition OptionalNonce: option (list byte) := None. (*The implementation takes nonce from entropy, using the el*3/2 calculation*)

(*NIST, Section 10.1: highest supported sec strength is given by the hash function's
security strength for preimage resistance. For SHA256, this is
(according to NIST SP 800-107, Table 1, page 11) 256 bits. See also Appendix B2 of NIST SP 800-90A. *)
Definition highest_supported_security_strength := 32. (* in bytes -- see comment for reseed*)

(*Q: should we use the sec strength of HMAC, calculated according to Section 5.3.4 of
NIST SP 800-107 instead?*)
Definition requested_security_strength:= 32.  (*same as in reseed*)

Definition prediction_resistance_supported:bool:=true.

Definition mbedtls_HMAC256_DRBG_instantiate_function (entropy_stream: ENTROPY.stream)
         entropy_len pr_flag (personalization_string: list byte): ENTROPY.result DRBG_state_handle :=
    HMAC256_DRBG_instantiate_function entropy_len entropy_len OptionalNonce
            highest_supported_security_strength max_personalization_string_length
            prediction_resistance_supported entropy_stream
            requested_security_strength pr_flag personalization_string.

Definition entlen:Z := 32.

Parameter Entropy_addSuccess1: forall n m s s1 l1 s2 l2,
        ENTROPY.get_bytes n s = ENTROPY.success l1 s1 ->
        ENTROPY.get_bytes m s1 = ENTROPY.success l2 s2 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.success (l1++l2) s2.

Parameter Entropy_addSuccess2: forall n m s s1 l1 s2 e,
        ENTROPY.get_bytes n s = ENTROPY.success l1 s1 ->
        ENTROPY.get_bytes m s1 = ENTROPY.error e s2 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.error e s2.

Parameter Entropy_addError: forall n m s s1 e, ENTROPY.get_bytes n s = ENTROPY.error e s1 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.error e s1.

Lemma Entropy_le n s l ss: ENTROPY.success l ss = ENTROPY.get_bytes n s ->
  forall m, (m <= n)%nat -> exists l' s', ENTROPY.success l' s' = ENTROPY.get_bytes m s.
Proof. intros.
  remember (ENTROPY.get_bytes m s) as d.
  destruct d. eexists; eexists; trivial.
  symmetry in H; symmetry in Heqd.
  specialize (Entropy_addError _ (n-m)%nat _ _ _ Heqd).
     rewrite Nat.add_comm, Nat.sub_add; trivial.
  intros HH; rewrite HH in *. discriminate.
Qed.

Lemma Entropy_addSuccess3: forall n m s ss l,
        ENTROPY.get_bytes n s = ENTROPY.success l ss -> (m <= n)%nat ->
        exists l1 s1, ENTROPY.get_bytes m s = ENTROPY.success l1 s1 /\
        exists l2, ENTROPY.get_bytes (n-m)%nat s1 = ENTROPY.success l2 ss /\ l=l1++l2.
Proof. intros.
  remember (ENTROPY.get_bytes m s). destruct r.
+ exists l0, s0; split; trivial.
  symmetry in Heqr.
  remember (ENTROPY.get_bytes (n-m)%nat s0) as t.
  destruct t; symmetry in Heqt.
  - specialize (Entropy_addSuccess1 m (n-m)%nat s s0). rewrite Heqr, Heqt, Nat.add_comm, Nat.sub_add; trivial.
    intros X. rewrite (X _ _ _ (eq_refl _) (eq_refl _)) in H; clear X Heqr Heqt. inv H. exists l1; split; trivial.
  - specialize (Entropy_addSuccess2 m (n-m)%nat s s0). rewrite Heqr, Heqt, Nat.add_comm, Nat.sub_add; trivial.
    intros X. rewrite (X _ _ _ (eq_refl _) (eq_refl _)) in H; clear X Heqr Heqt. inv H.
+ symmetry in Heqr; exfalso.
  specialize (Entropy_addError m (n-m)%nat s). rewrite Heqr, Nat.add_comm, Nat.sub_add; trivial.
  intros X. rewrite (X _ _ (eq_refl _)) in H. inv H.
Qed.

Lemma instantiate_eq es prflag pers:
      instantiate_function_256 es prflag pers =
      mbedtls_HMAC256_DRBG_instantiate_function es entlen prflag pers.
Proof. unfold instantiate_function_256, mbedtls_HMAC256_DRBG_instantiate_function,
   HMAC256_DRBG_instantiate_function, DRBG_instantiate_function, HMAC256_DRBG_instantiate_algorithm; simpl; intros.
destruct (Zlength pers >? max_personalization_string_length).
+ destruct prflag; trivial.
+ unfold entlen, get_entropy; simpl.
  remember (ENTROPY.get_bytes 48 es) as r.
  destruct r; symmetry in Heqr.
  - destruct (Entropy_addSuccess3 _ 32 _ _ _ Heqr) as [l1 [s1 [E32 [l2 [E16 L]]]]]. lia.
    simpl in E16. rewrite E32, E16; subst.
    unfold HMAC_DRBG_instantiate_algorithm. simpl. rewrite app_assoc. destruct prflag; trivial.
  - remember  (ENTROPY.get_bytes 32 es) as t; destruct t; symmetry in Heqt.
    * remember (ENTROPY.get_bytes 16 s0) as w; destruct w; symmetry in Heqw.
      ++ specialize (Entropy_addSuccess1 _ _ _ _ _ _ _ Heqt Heqw). simpl. rewrite Heqr. congruence.
      ++ specialize (Entropy_addSuccess2 _ _ _ _ _ _ _ Heqt Heqw). simpl. rewrite Heqr; intros X. inv X; destruct prflag; trivial.
    * specialize (Entropy_addError _ 16 _ _ _ Heqt). simpl. rewrite Heqr; intros X. inv X; destruct prflag; trivial.
Qed.

Lemma instantiate_reseed d s pr_flag rc ri (ZLc'256F : (Zlength d >? 256) = false):
      mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag  d =
      mbedtls_HMAC256_DRBG_reseed_function s (HMAC256DRBGabs initial_key initial_value rc 48 pr_flag ri) d.
Proof. rewrite <- instantiate256_reseed, instantiate_eq; trivial. Qed.

Opaque mbedtls_HMAC256_DRBG_reseed_function.
Opaque initial_key. Opaque initial_value.
Opaque mbedtls_HMAC256_DRBG_reseed_function.
Opaque repeat.

(*specification for the expected case, in which 0<=len<=256.
  But use mbedtls_HMAC256_DRBG_instantiate_function PROP of PRE and assume SUCCESS*)
Definition hmac_drbg_seed_simple_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH dp:_, ctx: val, info:val, len: Z, data:val, Data: list byte,
        Ctx: hmac256drbgstate,
        Info: md_info_state, s:ENTROPY.stream, rc:Z, pr_flag:bool, ri:Z,
        handle_ss: DRBG_state_handle * ENTROPY.stream, gv: globals
    PRE [(*_ctx OF*) tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         (*_md_info OF*) tptr (Tstruct _mbedtls_md_info_t noattr),
         (*_custom OF*) tptr tuchar, (*_len OF*) tuint ]
       PROP (len = Zlength Data /\ 0 <= len <=256 /\
             mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag
                                       (contents_with_add data (Zlength Data) Data)
             = ENTROPY.success (fst handle_ss) (snd handle_ss))
       (*LOCAL (temp _ctx ctx; temp _md_info info;
              temp _len (Vint (Int.repr len)); temp _custom data; gvars gv)*)
       PARAMS (ctx; info; data; Vint (Int.repr len)) GLOBALS (gv)
       SEP (
         data_at Ews t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate dp rc pr_flag ri Ctx;
         data_at Ews t_struct_mbedtls_md_info Info info;
         da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
         K_vector gv; Stream s; mem_mgr gv)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Ews t_struct_mbedtls_md_info Info info;
            da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
            K_vector gv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Ews t_struct_hmac256drbg_context_st Ctx ctx *
                 preseed_relate dp rc pr_flag ri Ctx * Stream s
            else md_empty (fst Ctx) *
                 EX p:val,
                 match (fst Ctx, fst handle_ss) with ((M1, (M2, M3)), ((((newV, newK), newRC), newEL), newPR))
                   => let CtxFinal := ((info, (M2, p)), (map Vubyte newV, (Vint (Int.repr newRC), (Vint (Int.repr 32), (bool2val newPR, Vint (Int.repr 10000)))))) in
                      !!(ret_value = Int.zero)
                      && data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                         hmac256drbg_relate (HMAC256DRBGabs newK newV newRC 32 newPR 10000) CtxFinal *
                         Stream (snd handle_ss)
                end;
            mem_mgr gv).

Lemma body_hmac_drbg_seed_simple: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_simple_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as [HDlen1 [HDlen2 RES]]. destruct handle_ss as [handle ss]. simpl in RES.
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Ews, Vint (Int.repr 1), info, gv).

  Intros v. rename H into Hv.
  forward.
  forward_if.
  { destruct Hv; try lia. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; auto. }
  subst v. clear Hv. simpl.
  Intros. Intros p.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!.
  forward_call (info).

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  assert (ZL_VV: Zlength initial_key =32) by reflexivity.
  thaw FIELDS.
  freeze [2;4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;4;5;6;8] FR2.
  forward_call (Vptr b i, Ews, ((info,(M2,p)):mdstate), 32, initial_key, b, Ptrofs.add i (Ptrofs.repr 12), Ews, gv).
  { split; auto; computable. }

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Ews, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite sepcon_comm. apply sepcon_derives.
     - apply data_at_memory_block.
     - cancel. }
  my_auto.
  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Ews t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  thaw FIELDS1. forward.

  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.
  forward_if (temp _t'4 (Vint (Int.repr 32))).
  { discriminate. }
  { clear H.
    forward_if.
    + discriminate.
    + clear H. forward. forward. entailer!. }
  forward. simpl. deadvars!. (*drop_LOCAL 7%nat. _t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl; auto.
(*    all: rewrite Int.unsigned_repr by rep_lia; reflexivity.  for Coq 8.13 and before *)
  }
  set (myABS := HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (repeat Int.one 32), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (bool2val pr_flag, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze [0;3;4;5;9] FR_CTX.
  freeze [1;7;8;9] KVStreamInfoDataFreeBlk.

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;3;4;5] INI.
  replace_SEP 0 (
         data_at Ews t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { entailer!. thaw INI. clear - FC_V. (*KVStreamInfoDataFreeBlk.*) thaw FR_CTX.
    simpl. entailer!.
    unfold_data_at 2%nat.
    cancel. unfold md_full; simpl.
    rewrite field_at_data_at; simpl.
    unfold field_address. rewrite if_true; simpl; trivial.
    cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [6] OLD_MD.
  forward_call (Data, data, Ews, Zlength Data, Vptr b i, Ews, ST, myABS, Info, s, gv).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. rewrite <- initialize.max_unsigned_modulus in *.
    split. computable. split. rep_lia. (* rewrite int_max_unsigned_eq; lia.*)
     unfold contents_with_add. simple_if_tac. rep_lia. rewrite Zlength_nil; rep_lia.
  }

  Intros v.
  assert (ZLc': Zlength (contents_with_add data (Zlength Data) Data) = 0 \/
                 Zlength (contents_with_add data (Zlength Data) Data) = Zlength Data).
         { unfold contents_with_add. simple_if_tac. right; trivial. left; trivial. }
  forward.
  deadvars!.
  forward_if (v = nullval).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST.

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + lia.
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try lia.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. Intros.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { apply Zgt_is_gt_bool_f. destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc'; lia. }
      unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - simpl. Intros. Exists p. thaw OLD_MD. cancel.
        subst myABS. rewrite <- instantiate_reseed in HeqMRS; trivial.
        rewrite RES in HeqMRS. inv HeqMRS.
  }
  { rename H into Hv. forward. entailer!.
    apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv; subst v. trivial.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros. inv H.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.

  assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { destruct ZLc' as [HH | HH]; rewrite HH. reflexivity.
        apply Zgt_is_gt_bool_f. lia. }
  rewrite <- instantiate_reseed, RES in HeqMRS; trivial. subst MRS. clear H RES Heqd.
  destruct handle as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11;12] ALLSEP.
  forward. forward.
  Exists Int.zero. simpl.
  apply andp_right. apply prop_right; split; trivial.
  thaw ALLSEP. thaw OLD_MD. Exists p.
  cancel;  normalize.
  apply andp_right. solve [apply prop_right; repeat split; trivial].
  cancel.
  unfold_data_at 1%nat. cancel.
  apply hmac_interp_empty.
Time Qed. (*Coq8.6: 26secs*)

(*Spec that does not assume len<=256 and includes a clause
  for the case where mbedtls_HMAC256_DRBG_instantiate_function yields
  Entropy.ERROR, ie no hypothesis about mbedtls_HMAC256_DRBG_instantiate_function in PROP of PRE*)
Definition hmac_drbg_seed_full_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH dp:_, ctx: val, info:val, len: Z, data:val, Data: list byte,
        Ctx: hmac256drbgstate,
        Info: md_info_state, s:ENTROPY.stream, rc:Z, pr_flag:bool, ri:Z, gv: globals
    PRE [(*_ctx OF*) tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         (*_md_info OF*) tptr (Tstruct _mbedtls_md_info_t noattr),
         (*_custom OF*) tptr tuchar, (*_len OF*) tuint ]
       PROP ( (len = Zlength Data) /\
              0 <= len /\
              48 + len < Int.modulus /\
              0 < 48 + Zlength (contents_with_add data len Data) < Int.modulus)
       PARAMS (ctx; info; data; Vint (Int.repr len)) GLOBALS (gv)
       SEP (
         data_at Ews t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate dp rc pr_flag ri Ctx;
         data_at Ews t_struct_mbedtls_md_info Info info;
         da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
         K_vector gv; Stream s; mem_mgr gv)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Ews t_struct_mbedtls_md_info Info info;
            da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
            K_vector gv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Ews t_struct_hmac256drbg_context_st Ctx ctx *
                 preseed_relate dp rc pr_flag ri Ctx * Stream s
            else md_empty (fst Ctx) *
                 EX p:val,
                 match (fst Ctx) with (M1, (M2, M3)) =>
                   if (zlt 256 (Zlength Data) || (zlt 384 (48 + Zlength Data)))%bool
                   then !!(ret_value = Int.repr (-5)) &&
                     (Stream s *
                     ( let CtxFinal:= ((info, (M2, p)), (repeat (Vint Int.one) 32, (Vint (Int.repr rc),
                                       (Vint (Int.repr 48), (bool2val pr_flag, Vint (Int.repr 10000)))))) in
                       let CTXFinal:= HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000 in
                       data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                     hmac256drbg_relate CTXFinal CtxFinal))

                   else match mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag
                                       (contents_with_add data (Zlength Data) Data)
                        with
                         | ENTROPY.error e ss =>
                            (!!(match e with
                               | ENTROPY.generic_error => Vint ret_value = Vint (Int.repr ENT_GenErr)
                               | ENTROPY.catastrophic_error => Vint ret_value = Vint (Int.repr (-9))
                              end) && (Stream ss *
                                       let CtxFinal:= ((info, (M2, p)), (repeat (Vint Int.one) 32, (Vint (Int.repr rc),
                                                (Vint (Int.repr 48), (bool2val pr_flag, Vint (Int.repr 10000)))))) in
                                       let CTXFinal:= HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000 in
                                       data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                       hmac256drbg_relate CTXFinal CtxFinal))
                        | ENTROPY.success handle ss => !!(ret_value = Int.zero) &&
                                    match handle with ((((newV, newK), newRC), newEL), newPR) =>
                                      let CtxFinal := ((info, (M2, p)), (map Vubyte newV, (Vint (Int.repr newRC), (Vint (Int.repr 32), (bool2val newPR, Vint (Int.repr 10000)))))) in
                                      let CTXFinal := HMAC256DRBGabs newK newV newRC 32 newPR 10000 in
                                    data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                    hmac256drbg_relate CTXFinal CtxFinal *
                                    Stream ss end
                        end
                end;
             mem_mgr gv).

Lemma body_hmac_drbg_seed_full: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_full_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as (*[PREQ*) [HDlen1 [HDlen2 [DHlen3 [DHlen4 HData]]]](*]*).
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Ews, Vint (Int.repr 1), info, gv).

  Intros v. rename H into Hv.
  freeze [0] FR1. forward. thaw FR1.
  forward_if.
  { destruct Hv; try lia. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; auto. }
  subst v. clear Hv. simpl.
  Intros. Intros p.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!.
  forward_call info.

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  assert (ZL_VV: Zlength initial_key =32) by reflexivity.
  thaw FIELDS.
  freeze [2;4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;4;5;6;8] FR2.
(*
  replace_SEP 1 (UNDER_SPEC.EMPTY Ews p).
  { entailer!.
    eapply derives_trans. 2: apply UNDER_SPEC.mkEmpty.
    fix_hmacdrbg_compspecs. apply derives_refl.
  }
*)
  forward_call (Vptr b i, Ews, ((info,(M2,p)):mdstate), 32, initial_key, b, Ptrofs.add i (Ptrofs.repr 12), Ews, gv).
  { split; my_auto. }

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Ews, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite sepcon_comm. apply sepcon_derives.
     - apply data_at_memory_block.
     - cancel. }
  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Ews t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  deadvars!.
  thaw FIELDS1. forward.
  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.

  forward_if (temp _t'4 (Vint (Int.repr 32))).
  { discriminate. }
  { clear H.
    forward_if.
    + discriminate.
    + clear H. forward. forward. entailer!. }
  forward. simpl. deadvars!. (*drop_LOCAL 7%nat. _t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl; auto.
(*    all: rewrite Int.unsigned_repr by rep_lia; reflexivity.  for Coq 8.13 and before *)
  }
  set (myABS := HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (repeat Int.one 32), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (bool2val pr_flag, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze [0;3;4;5;9] FR_CTX.
  freeze [1;7;8;9] KVStreamInfoDataFreeBlk.

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;3;4;5] INI.
  replace_SEP 0 (
         data_at Ews t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { entailer!. thaw INI. clear - FC_V. (*KVStreamInfoDataFreeBlk.*) thaw FR_CTX.
    simpl; entailer!.
    unfold_data_at 2%nat.
    cancel. unfold md_full; simpl.
    rewrite field_at_data_at; simpl.
    unfold field_address. rewrite if_true; simpl; trivial.
    cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [6] OLD_MD.
  forward_call (Data, data, Ews, Zlength Data, Vptr b i, Ews, ST, myABS, Info, s, gv).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. computable.
  }

  Intros v.
  assert (ZLc': Zlength (contents_with_add data (Zlength Data) Data) = 0 \/
                 Zlength (contents_with_add data (Zlength Data) Data) = Zlength Data).
         { unfold contents_with_add. simple_if_tac. right; trivial. left; trivial. }
  forward.
  deadvars!.
  forward_if (v = nullval).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST.

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + subst d. unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl.
      simpl. subst myABS. normalize. cancel. simpl.
      Exists p. thaw OLD_MD. normalize.
      apply andp_right. apply prop_right; repeat split; trivial. cancel.
      apply hmac_interp_empty.
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try lia.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. Intros.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { apply Zgt_is_gt_bool_f. destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc';  lia. }
      unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - simpl. Intros. Exists p. thaw OLD_MD. cancel.
        subst myABS. rewrite <- instantiate_reseed in HeqMRS; trivial.
        rewrite <- HeqMRS.
        normalize.
        apply andp_right. apply prop_right; repeat split; trivial.
        cancel. apply hmac_interp_empty.
  }
  { rename H into Hv. forward. entailer!.
    apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv; subst v. trivial.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros. inv H.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.
  unfold return_value_relate_result in H.
  destruct MRS. 2:{ exfalso. destruct e. inv H.
                     destruct ENT_GenErrAx as [EL1 _]. rewrite <- H in EL1. elim EL1; trivial.
  }
  clear H.
  destruct d as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11;12] ALLSEP.
  forward. forward.
  Exists Int.zero. simpl.
  apply andp_right. apply prop_right; split; trivial.
  symmetry in Heqd. apply orb_false_iff in Heqd. destruct Heqd as [Heqd1 Heqd2].
  destruct (zlt 256 (Zlength Data)); try discriminate. simpl in *. rewrite Heqd2.
  thaw ALLSEP. thaw OLD_MD. Exists p. cancel.
  normalize.
  assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { destruct ZLc' as [HH | HH]; rewrite HH. reflexivity.
        apply Zgt_is_gt_bool_f. lia. }
  rewrite <- instantiate_reseed in HeqMRS; trivial.
  rewrite <- HeqMRS.
  normalize.
  apply andp_right. apply prop_right; repeat split; trivial.
  cancel.
  unfold_data_at 1%nat. cancel.
  apply hmac_interp_empty.
Time Qed. (*Coq8.6: 32secs*)
   (*Feb 22nd 2017: 245.406 secs (233.843u,0.203s) (successful)*)
   (*earlier: 69.671 secs (59.578u,0.015s) (successful)*)

End Instantiate_eq.

Lemma ReseedRes: forall X r v, @return_value_relate_result X r (Vint v) -> Int.eq v (Int.repr (-20864)) = false.
Proof. intros.
  unfold return_value_relate_result in H.
  destruct r. inv H; reflexivity.
  destruct e; inv H; try reflexivity.
  apply Int.eq_false. eapply ENT_GenErrAx.
Qed.

Definition preseed_relate V rc pr ri (r : hmac256drbgstate):mpred:=
    match r with
     (md_ctx', (V', (reseed_counter', (entropy_len', (prediction_resistance', reseed_interval'))))) =>
    md_empty md_ctx' &&
    !! (map Vubyte V = V' /\
        Zlength V = 32 /\
        Vint (Int.repr rc) = reseed_counter'(* /\
        Vint (Int.repr entropy_len) = entropy_len'*) /\
        Vint (Int.repr ri) = reseed_interval' /\
        bool2val pr = prediction_resistance')
   end.

Definition hmac_drbg_seed_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH ctx: val, info:val, len: Z, data:val, Data: list byte,
        Ctx: hmac256drbgstate,
        (*CTX: hmac256drbgabs,*)
        Info: md_info_state, s:ENTROPY.stream, rc:Z, pr:bool, ri:Z, VV:list byte, gv: globals
    PRE [(*_ctx OF*) tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         (*_md_info OF*) tptr (Tstruct _mbedtls_md_info_t noattr),
         (*_custom OF*) tptr tuchar, (*_len OF*) tuint ]
       PROP ( (len = Zlength Data) /\
              0 <= len (*<= 336 Int.max_unsigned*) /\
              48 + len < Int.modulus /\
              0 < 48 + Zlength (contents_with_add data len Data) < Int.modulus)
       (*LOCAL (temp _ctx ctx; temp _md_info info;
              temp _len (Vint (Int.repr len)); temp _custom data; gvars gv)*)
       PARAMS (ctx; info; data; Vint (Int.repr len)) GLOBALS (gv)
       SEP (
         data_at Ews t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate VV rc pr ri Ctx;
         (*hmac256drbg_relate CTX Ctx;*)
         data_at Ews t_struct_mbedtls_md_info Info info;
         da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
         K_vector gv; Stream s; mem_mgr gv)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Ews t_struct_mbedtls_md_info Info info;
            da_emp Ews (tarray tuchar (Zlength Data)) (map Vubyte Data) data;
            K_vector gv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Ews t_struct_hmac256drbg_context_st Ctx ctx *
                  (*hmac256drbg_relate CTX Ctx *) preseed_relate VV rc pr ri Ctx *
                  Stream s
            else md_empty (fst Ctx) *
                 EX p:val, (* malloc_token Tsh (Tstruct _hmac_ctx_st noattr) p * *)
                 match (fst Ctx) with (M1, (M2, M3)) =>
                   if (zlt 256 (Zlength Data) || (zlt 384 ((*hmac256drbgabs_entropy_len initial_state_abs*)48 + Zlength Data)))%bool
                   then !!(ret_value = Int.repr (-5)) &&
                     (Stream s *
                     ( let CtxFinal:= ((info, (M2, p)), (repeat (Vint Int.one) 32, (Vint (Int.repr rc),
                                       (Vint (Int.repr 48), (bool2val pr, Vint (Int.repr 10000)))))) in
                       let CTXFinal:= HMAC256DRBGabs VV (repeat Byte.one 32) rc 48 pr 10000 in
                       data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                     hmac256drbg_relate CTXFinal CtxFinal))

                   else let myABS := HMAC256DRBGabs VV (repeat Byte.one 32) rc 48 pr 10000
                      in match mbedtls_HMAC256_DRBG_reseed_function s myABS
                                (contents_with_add data (Zlength Data) Data)
                         with
                         | ENTROPY.error e ss =>
                            (!!(match e with
                               | ENTROPY.generic_error => Vint ret_value = Vint (Int.repr ENT_GenErr)
                               | ENTROPY.catastrophic_error => Vint ret_value = Vint (Int.repr (-9))
                              end) && (Stream ss *
                                       let CtxFinal:= ((info, (M2, p)), (repeat (Vint Int.one) 32, (Vint (Int.repr rc),
                                                (Vint (Int.repr 48), (bool2val pr, Vint (Int.repr 10000)))))) in
                                       let CTXFinal:= HMAC256DRBGabs VV (repeat Byte.one 32) rc 48 pr 10000 in
                                       data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                       hmac256drbg_relate CTXFinal CtxFinal))
                        | ENTROPY.success handle ss => !!(ret_value = Int.zero) &&
                                    match handle with ((((newV, newK), newRC), newEL), newPR) =>
                                      let CtxFinal := ((info, (M2, p)), (map Vubyte newV, (Vint (Int.repr newRC), (Vint (Int.repr 32), (bool2val newPR, Vint (Int.repr 10000)))))) in
                                      let CTXFinal := HMAC256DRBGabs newK newV newRC 32 newPR 10000 in
                                    data_at Ews t_struct_hmac256drbg_context_st CtxFinal ctx *
                                    hmac256drbg_relate CTXFinal CtxFinal *
                                    Stream ss end
                        end
                end;
         mem_mgr gv).

Opaque mbedtls_HMAC256_DRBG_reseed_function.

Lemma body_hmac_drbg_seed: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as [HDlen1 [HDlen2 [DHlen3 [DHlen4 HData]]]].
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Ews, Vint (Int.repr 1), info, gv).
  Intros v. rename H into Hv.
  freeze [0] FR1. forward. thaw FR1.

  forward_if.
  { destruct Hv; try lia. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; auto. }
  subst v. clear Hv. simpl.
  Intros p.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!.
  forward_call info.

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  rename H1 into ZL_VV.
  thaw FIELDS.
  freeze [2;4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;4;5;6;8] FR2.
  forward_call (Vptr b i, Ews, ((info,(M2,p)):mdstate), 32, VV, b, Ptrofs.add i (Ptrofs.repr 12), Ews, gv).
  { entailer!. simpl. rewrite ZL_VV, ptrofs_add_repr_0_r; trivial.
  }
  { split; auto. computable. }
  Intros.

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Ews, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite ZL_VV; entailer!.
  }
  { rewrite sepcon_comm. apply sepcon_derives.
      eapply derives_trans. apply data_at_memory_block.
        rewrite ZL_VV. simpl. cancel. cancel. }
  (*{ split. apply semax_call.writable_share_top.
    rewrite ZL_V0, client_lemmas.int_max_unsigned_eq. lia. }*)

  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Ews t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  thaw FIELDS1. forward.
  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.
(*  set (ent_len := new_ent_len (Zlength V0)) in *.*)

  forward_if (temp _t'4 (Vint (Int.repr 32))).
  { discriminate. }
  { clear H.
    forward_if.
    { discriminate. }
    { clear H. forward. forward. entailer!. }
  }
  forward. simpl. drop_LOCAL 1%nat. (*_t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl; auto.
(*    all: rewrite Int.unsigned_repr by rep_lia; reflexivity.  for Coq 8.13 and before *)
  }

  set (myABS := HMAC256DRBGabs VV (repeat Byte.one 32) rc 48 pr 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (repeat Int.one 32), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (bool2val pr, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze FR_CTX := (data_at _ _ _ (Vptr b (Ptrofs.add i (Ptrofs.repr 12))))
         (field_at _ _ [StructField _reseed_counter] _ (Vptr b i))
         (field_at _ _ [StructField _entropy_len] _ (Vptr b i))
         (UNDER_SPEC.REP _ _ p)
         (malloc_token _ _ p).
  freeze KVStreamInfoDataFreeBlk :=
      (K_vector gv)
      (data_at _ _ _ info)
      (da_emp _ _ _ data)
      (Stream s).

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;3;4;5] INI.
  replace_SEP 0 (
         data_at Ews t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { go_lower. thaw INI. clear KVStreamInfoDataFreeBlk. thaw FR_CTX.
    unfold_data_at 2%nat.
    subst ST; simpl. cancel. normalize.
    apply andp_right. apply prop_right. repeat split; trivial.
    unfold md_full. simpl.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [6] OLD_MD.
  forward_call (Data, data, Ews, Zlength Data, Vptr b i, Ews, ST, myABS, Info, s, gv).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. computable.  }

  Intros v.

  forward.
  forward_if (v = nullval).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST. (*rename H into Mcompat.*)

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + subst d. unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl.
      simpl. subst myABS. Intros. subst v; simpl. cancel.
      Exists p. thaw OLD_MD. cancel.
      apply andp_right; [ apply prop_right; trivial |  cancel; entailer!].
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try lia.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. Intros. cancel.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
                                                     (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer; simpl.
        Intros. Exists p. thaw OLD_MD. cancel.
        apply andp_right. apply prop_right; trivial.
        cancel. entailer!.
  }
  { rename H into Hv. forward. simpl in Hv. entailer!.
    apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv. subst v; trivial.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros. inv H.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold return_value_relate_result in H.
  destruct MRS. 2:{ exfalso. destruct e. inv H.
                     destruct ENT_GenErrAx as [EL1 _]. rewrite <- H in EL1. elim EL1; trivial.
  }
  clear H. unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.
  destruct d as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11] XX.
  forward. forward.
  Exists Int.zero. simpl. symmetry in Heqd. apply orb_false_iff in Heqd. destruct Heqd as [Heqd1 Heqd2].
  destruct (zlt 256 (Zlength Data)); try discriminate.
  apply andp_right. apply prop_right; split; trivial.
  thaw XX. thaw OLD_MD. cancel. simpl in *.
  rewrite Heqd2. (* rewrite <- HeqMRS. *)
  Exists p.
  apply andp_right. apply prop_right; trivial.
  unfold_data_at 1%nat. cancel. entailer!.
Time Qed. (*Coq8.6: 40secs*)
          (*Jan 22nd 2017: 267.171 secs (182.812u,0.015s) (successful)*)
          (*earlier: Finished transaction in 121.296 secs (70.921u,0.062s) (successful)*)
          (*Coq8.9, April 2019: 8.3s*)


(* seplog (c) AIST 2005-2013. R. Affeldt, N. Marti, et al. GNU GPLv3. *)
(* seplog (c) AIST 2014-2018. R. Affeldt et al. GNU GPLv3. *)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Require Import ssrZ ZArith_ext seq_ext uniq_tac.
Require Import machine_int multi_int encode_decode integral_type.
Import MachineInt.
Require Import mips_bipl mips_tactics mips_syntax mips_mint mips_frame.
Import mips_bipl.expr_m.
Require Import simu.
Import simu.simu_m.

Require Import multi_negate_prg multi_negate_triple.

Local Open Scope heap_scope.
Local Open Scope assoc_scope.
Local Open Scope uniq_scope.
Local Open Scope machine_int_scope.
Local Open Scope zarith_ext_scope.
Local Open Scope simu_scope.

(** x <- - x, x signed *)

Lemma pfwd_sim_multi_negate (x : bipl.var.v) d k rx a0 :
  uniq(rx, a0, r0) ->
  disj (mints_regs (assoc.cdom d)) (a0 :: nil) ->
  x \notin assoc.dom d ->
  signed k rx \notin assoc.cdom d ->
  (x <- .--e (var_e x))%pseudo_expr%pseudo_cmd
    <=p( state_mint (x |=> signed k rx \U+ d), fun _ _ _ => 0 < Z_of_nat k < 2 ^^ 31 )
  multi_negate rx a0.
Proof.
move=> Hset Hdisj x_d rx_d.
rewrite /pfwd_sim.
move=> s st h [s_st_h k_231] s' exec_pseudo st' h' exec_asm.

move: (proj1 s_st_h x (signed k rx)).
rewrite assoc.get_union_sing_eq.
case/(_ (refl_equal _)) => slen ptr A rx_fit encoding ptr_fit memA.

move: (multi_negate_triple rx a0 slen ptr A Hset) => hoare_triple.

have [st'' [h'' exec_triple_proj]] : exists st'' h'',
  (Some (st, heap.proj h (heap.dom (heap_mint (signed k rx) st h))) --
  multi_negate rx a0 ---> Some (st'', h''))%asm_cmd.
  exists st', (heap.proj h' (heap.dom (heap_mint (signed k rx) st h))).
  apply: (mips_syntax.triple_exec_proj _ _ _ hoare_triple) => //.
  move: (heap_inclu_heap_mint_signed h st k rx).
  move/heap.incluE => ->; exact memA.

set postcond := (_ |--> cplt2 _ :: _ ** _)%asm_assert in hoare_triple.

have {hoare_triple}hoare_triple_postcond : (postcond ** assert_m.TT)%asm_assert st' h'.
  move: {hoare_triple}(frame_rule_R _ _ _ hoare_triple assert_m.TT (assert_m.inde_TT _) (mips_frame.inde_cmd_mult_TT _)).
  move/mips_seplog.hoare_prop_m.soundness.
  rewrite /while.hoare_semantics.
  move/(_ st h) => Hhoare_triple.
  lapply Hhoare_triple; last first.
    exists (heap_mint (signed k rx) st h), (h \D\ heap.dom (heap_mint (signed k rx) st h)).
    split; first exact/heap.disj_difs'/inc_refl.
    split; last by [].
    apply heap.union_difsK; last by [].
    exact: heap_inclu_heap_mint_signed.
  case=> _.
  by move/(_ _ _ exec_asm).
have rx_st_st' : ([rx ]_ st = [rx]_st')%asm_expr.
  Reg_unchanged. rewrite [modified_regs _]/=. by Uniq_not_In.
rewrite /state_mint; split.
- move=> z mz.
  case/assoc.get_union_Some_inv => [z_is_x | z_in_y_or_d].
  + case/assoc.get_sing_inv : z_is_x => ? ?; subst z mz.
    have not_weird_slen : ~ weird slen.
      rewrite weirdE2.
      case: encoding => H1 -> H3 H4.
      move=> abs.
      have : sgZ (s2Z slen) = -1.
        case: (Zsgn_spec (s2Z slen)).
          case=> _ abs'.
          rewrite abs' in abs.
          lia.
        case.
          case=> abs'.
          by rewrite -abs' /= in abs.
        by case.
      move=> abs'.
      rewrite abs' mulN1Z in abs.
      apply Z.opp_inj in abs.
      rewrite abs in k_231.
      by case: k_231 => _ /ltZZ.
    apply mkVarSigned with (cplt2 slen) ptr A => //.
    * by rewrite -rx_st_st'.
    * move/syntax_m.seplog_m.semop_prop_m.exec_cmd0_inv : exec_pseudo.
      case/syntax_m.seplog_m.exec0_assign_inv => _ -> /=.
      syntax_m.seplog_m.assert_m.expr_m.Store_upd.
      case: encoding => H1 H2 H3 H4.
      apply mkSignMagn => //.
      rewrite s2Z_cplt2 // H2 Zsgn_Zopp Zsgn_Zmult ZsgnK.
      suff : sgZ (Z_of_nat k) = 1 by move=> ->; rewrite mulZ1; ring.
      case: k_231 => k_231 _.
      by apply Zsgn_pos in k_231.
      by rewrite Zsgn_Zopp s2Z_cplt2 // Zsgn_Zopp H3.
      rewrite s2Z_cplt2 // Zsgn_Zopp H4; ring.
    * case: hoare_triple_postcond => h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]].
      apply con_heap_mint_signed_cons with h1 => //.
      - rewrite h1Uh2.
        apply heap.inclu_union_L => //.
        by apply heap.inclu_refl.
      - by rewrite -rx_st_st'.
      - case: encoding => H1 H2 H3 H4.
        by rewrite H1.
      - by case: encoding.
  + (* z \in d *) have z_x : z <> x.
      move=> ?; subst z.
      apply assoc.get_Some_in in z_in_y_or_d.
      rewrite -assoc.elts_dom in x_d.
      move/negP : x_d; apply.
      apply/mapP.
      by exists (x, mz).
    move: (proj2 s_st_h _ _ z_x mz (signed k rx)).
    rewrite assoc.get_union_sing_neq; last by [].
    rewrite assoc.get_union_sing_eq.
    move/(_ z_in_y_or_d (refl_equal _)) => heap_mint_disj.
    move: (mips_syntax.exec_deter_proj _ _ _ _ _ exec_asm _ _ _ exec_triple_proj) => [st'_st'' [h''_h' h_h']].
    have Hd_unchanged : forall v r, assoc.get v d = Some r ->
      disj (mint_regs r) (mips_frame.modified_regs (multi_negate rx a0)).
      move=> v r Hvr; rewrite [mips_frame.modified_regs _]/=; Disj_remove_dup.
      apply (disj_incl_LR Hdisj); last by apply incl_refl_Permutation; PermutProve.
      exact/incP/inc_mint_regs/(assoc.get_Some_in_cdom _ v).
    have <- : heap_mint mz st h = heap_mint mz st' h'.
      apply (heap_mint_state_invariant (heap_mint (signed k rx) st h) z s) => //.
      move=> ry Hry; Reg_unchanged.
      apply (@disj_not_In _ (mint_regs mz)); last by [].
      exact/disj_sym/(Hd_unchanged z).
      move: (proj1 s_st_h z mz).
      rewrite assoc.get_union_sing_neq; last by [].
      exact.
    apply var_mint_invariant with s st => //.
    * move=> ry ry_my; Reg_unchanged.
      apply (@disj_not_In _ (mint_regs mz)); last by [].
      exact/disj_sym/(Hd_unchanged z).
    * Var_unchanged. rewrite /= mem_seq1; exact/negP/eqP.
    * move: (proj1 s_st_h z mz).
      rewrite assoc.get_union_sing_neq //; by apply.
- have Hdom : heap.dom (heap_mint (signed k rx) st' h') = heap.dom (heap_mint (signed k rx) st h).
    symmetry.
    case: hoare_triple_postcond => h1 [h2 [h1_d_h2 [h1_U_h2 [Hh1 Hh2]]]].
    rewrite /postcond in Hh1.
    apply (dom_heap_mint_sign_state_invariant _ _ _ _ _ _ x s slen (cplt2 slen)) => //.
      by move/assert_m.mapstos_get1/heap_get_heap_mint_inv : memA.
    apply assert_m.mapstos_get1 in Hh1.
    rewrite h1_U_h2. by apply heap.get_union_L => //.
    apply assert_m.mapstos_get2 in memA.
    apply assert_m.mapstos_get2 in Hh1.
    rewrite h1_U_h2.
    apply heap_get_heap_mint_inv in memA.
    rewrite memA.
    symmetry.
    by apply heap.get_union_L.
    apply mkVarSigned with slen ptr A => //.
    by eapply dom_heap_invariant; eauto.
  apply (state_mint_part2_one_variable _ _ _ _ _ _ _ _ s_st_h Hdom).
  + move=> t x0 Ht Hx0.
    Reg_unchanged. simpl mips_frame.modified_regs.
    case/assoc.in_cdom_union_inv : Ht => Ht.
    * rewrite assoc.cdom_sing /= seq.mem_seq1 in Ht.
      move/eqP in Ht; subst t.
      apply (@disj_not_In _ (mint_regs (signed k rx))); last by [].
      Disj_remove_dup.
      rewrite /=.
      apply uniq_disj. rewrite [cat _ _]/=. by Uniq_uniq r0.
    * apply (@disj_not_In _ (mint_regs t)); last by [].
      Disj_remove_dup.
      apply/disj_sym/(disj_incl_LR Hdisj); last by apply incl_refl_Permutation; PermutProve.
      exact/incP/inc_mint_regs.
  + move: (mips_syntax.exec_deter_proj _ _ _ _ _ exec_asm _ _ _ exec_triple_proj); tauto.
  + exact: (mips_syntax.dom_heap_invariant _ _ _ _ _ exec_asm).
Qed.