From hahn Require Import Hahn.
Require Import Logic.IndefiniteDescription.
From Promising Require Import Configuration TView View Time Event Cell Thread Memory.
Require Import PromisingLib.
Require Import MaxValue.
Require Import MemoryAux.

Set Implicit Arguments.
Remove Hints plus_n_O.

(* Proposition "up_memory memory memory'" states that each message in memory' has
   a counterpart in memory w/ smaller or equal left timestamp border. *)
Record up_memory memory memory' :=
  { TOU :
      forall loc t val f' view'
             (INT : Memory.get loc t memory' =
                    Some (f', Message.mk val view')),
      exists f view,
        ⟪ INF : Memory.get loc t memory =
                 Some (f, Message.mk val view) ⟫ /\
        ⟪ FFT : Time.le f' f ⟫ /\
        ⟪ VVT : View.opt_le view view' ⟫ ;
    TOUIN :
      forall loc t' val' f' view' m
             (IMU : Interval.mem (f', t') m)
             (INT : Memory.get loc t' memory' =
                    Some (f', Message.mk val' view')),
      exists t f val view,
        ⟪ INF : Memory.get loc t memory =
                 Some (f, Message.mk val view) ⟫ /\
        ⟪ IMP : Interval.mem (f, t) m ⟫ ;
    FROMU :
      forall loc t val f view
             (INT : Memory.get loc t memory =
                    Some (f, Message.mk val view)),
      exists f' t' val' view',
        ⟪ INT : Memory.get loc t' memory' =
                 Some (f', Message.mk val' view') ⟫ /\
        ⟪ ILE : Interval.le (f, t) (f', t') ⟫;
  }.

Lemma up_memory_refl memory :
  up_memory memory memory.
Proof using.
  constructor; ins.
  { eexists. eexists. splits; eauto.
    all: reflexivity. }
  { repeat eexists; eauto.
    all: apply IMU. }
  repeat eexists; eauto.
  all: reflexivity.
Qed.

Lemma exists_all_conj_disj (A B : Type) (P Q R : A -> B -> Prop)
      (HH : exists f, forall a : A, P a f /\ Q a f /\ R a f) :
  exists f, (forall a : A, P a f) /\ (forall a : A, Q a f) /\
            (forall a : A, R a f).
Proof using. desf. exists f. splits; apply HH. Qed.

Lemma up_memory_closed_bigger_timemap memory memory' tmap
      (FUTURE  : Memory.future Memory.init memory)
      (INHAB   : Memory.inhabited memory')
      (TM_CLOS : Memory.closed_timemap tmap memory)
      (UP_MEM  : up_memory memory memory') :
  exists tmap',
    ⟪ TM_LE  : TimeMap.le tmap tmap' ⟫ /\
    ⟪ TM_CLOS : Memory.closed_timemap tmap' memory' ⟫ /\
    ⟪ TM_EQ :
      forall loc to from val view view'
             (TS_LT'     : ts_lt_or_bot memory')
             (MSG_DISJ   : message_disjoint memory')
             (GET  : Memory.get loc to memory =
                     Some (from, Message.mk val view))
             (GET' : Memory.get loc to memory' =
                     Some (from, Message.mk val view'))
             (TLE  : Time.le (tmap loc) to),
        Time.le (tmap' loc) to ⟫.
Proof using.
  unnw.
  unfold TimeMap.le.
  unfold Memory.closed_timemap.
  unfold TimeMap.t.
  apply exists_all_conj_disj.

  set (R := fun a b =>
    Time.le (tmap a) b /\
    (exists (from : Time.t) (val : Const.t) (released : option View.t),
       Memory.get a b memory' =
       Some (from, {| Message.val := val; Message.released := released |})) /\
    (forall to from val view view',
        ts_lt_or_bot memory' ->
        message_disjoint memory' ->
        Memory.get a to memory =
          Some (from, Message.mk val view) ->
        Memory.get a to memory' =
          Some (from, Message.mk val view') ->
        Time.le (tmap a) to ->
        Time.le b to)).
  apply functional_choice with (R:=R).
  unfold R. clear R.
  intros l.
  specialize (TM_CLOS l). desf.

  set (GET := TM_CLOS).
  apply ts_lt_or_bot_future_init in GET; auto.
  desf.
  { eexists. splits; auto.
    { reflexivity. }
    2: by ins.
    rewrite GET in *. repeat eexists.
    apply INHAB. }
  assert (tmap l <> Time.bot) as XX.
  { intros HH. rewrite HH in *.
    eapply MaxValue.time_lt_bot. eauto. }
  set (TM_CLOS' := TM_CLOS).
  eapply UP_MEM in TM_CLOS'.
  desf.
  eexists. splits; eauto.
  { apply ILE. }
  ins.
  destruct (Time.le_lt_dec t' to) as [|LT]; auto.
  exfalso.

  set (CC := H2).
  eapply H in CC.
  desf.
  { apply Time.le_lteq in H3.
    desf. eapply MaxValue.time_lt_bot; eauto. }
  eapply H0 in H2. apply H2 in INT.
  destruct INT as [AA|AA].
  { subst. eapply Time.lt_strorder. eauto. }
  eapply AA; constructor; simpls.
  2: reflexivity.
  { done. }
  2: { apply Time.le_lteq. by left. }
  eapply TimeFacts.lt_le_lt; eauto.
  eapply TimeFacts.le_lt_lt.
  { apply ILE. }
  simpls.
Qed.

Lemma up_memory_closed_bigger_view memory memory' view
      (FUTURE  : Memory.future Memory.init memory)
      (INHAB   : Memory.inhabited memory')
      (VW_CLOS : Memory.closed_opt_view view memory)
      (VW_WF : View.opt_wf view)
      (UP_MEM : up_memory memory memory') :
  exists view',
    ⟪ VW_LE  : View.opt_le view view' ⟫ /\
    ⟪ VW_CLOS : Memory.closed_opt_view view' memory' ⟫ /\
    ⟪ VW_WF : View.opt_wf view' ⟫ /\
    ⟪ VW_EQ :
      forall loc to from val released released'
             (TS_LT'     : ts_lt_or_bot memory')
             (MSG_DISJ   : message_disjoint memory')
             (GET  : Memory.get loc to memory =
                     Some (from, Message.mk val released))
             (GET' : Memory.get loc to memory' =
                     Some (from, Message.mk val released'))
             (TLE  : Time.le (View.rlx (View.unwrap view) loc) to),
        Time.le (View.rlx (View.unwrap view') loc) to ⟫.
Proof using.
  destruct view as [view|].
  2: { exists None. splits; auto.
       { reflexivity. }
       constructor. }
  destruct view as [tmap_pln tmap].
  edestruct up_memory_closed_bigger_timemap with
      (memory:=memory) (memory':=memory') as [tmap']; eauto.
  { inv VW_CLOS. destruct CLOSED. apply RLX. }
  desc.
  exists (Some (View.mk tmap' tmap')).
  splits; auto.
  { constructor. constructor; simpls.
    etransitivity; eauto.
    inv VW_WF. inv WF. }
  { constructor. constructor; simpls. }
  constructor. constructor.
  reflexivity.
Qed.

Lemma up_memory_add_exists_r_view_eq memory memory' memory_add
           loc from to val released released'
           (ADD      : Memory.add memory loc from to val released memory_add)
           (VW_WF    : View.opt_wf released')
           (LE       : View.opt_le released released')
           (UP_MEM   : up_memory memory memory') :
  exists memory_add',
    ⟪ ADDU       : Memory.add memory' loc from to val released' memory_add' ⟫ /\
    ⟪ UP_MEM_ADD : up_memory memory_add memory_add' ⟫.
Proof using.
  assert (ADD':=ADD).
  destruct ADD'. destruct ADD0.
  edestruct Memory.add_exists with (mem1:=memory') (released:=released')
    as [memory_add' MM]; eauto.
  { ins. destruct msg2 as [v rel].
    red. ins.
    eapply UP_MEM in RHS; eauto. desc.
    eapply DISJOINT; eauto. }
  exists memory_add'. splits; eauto.
  constructor; ins.
  { erewrite Memory.add_o; eauto.
    erewrite Memory.add_o in INT; eauto.
    destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
    2: by apply UP_MEM.
    desf. repeat eexists; unnw; auto.
    reflexivity. }
  { erewrite Memory.add_o in INT; eauto.
    desf.
    { simpls. desf.
      repeat eexists.
      2,3: by apply IMU.
      erewrite Memory.add_o; eauto.
      rewrite loc_ts_eq_dec_eq; eauto. }
    eapply UP_MEM in IMU; eauto.
    desc.
    repeat eexists.
    2,3: by apply IMP.
    eapply Memory.add_get1; eauto. }
  erewrite Memory.add_o in INT; eauto.
  destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
  { desf. repeat eexists; eauto.
    2,3: reflexivity.
    erewrite Memory.add_o; eauto.
    rewrite loc_ts_eq_dec_eq. eauto. }
  apply UP_MEM in INT. desc.
  destruct ILE.
  repeat eexists; eauto.
  eapply Memory.add_get1; eauto.
Qed.

Lemma up_memory_add_bigger_view memory_add memory' memory_add''
           loc from to val released released'
           (VW_LE : View.opt_le released released')
           (VW_WF : View.opt_wf released')
           (ADDU : Memory.add memory' loc from to val released memory_add'')
           (UP_MEM_ADD : up_memory memory_add memory_add'') :
  exists memory_add',
    ⟪ ADDU : Memory.add memory' loc from to val released' memory_add' ⟫ /\
    ⟪ UP_MEM_ADD : up_memory memory_add memory_add' ⟫.
Proof using.
  inv ADDU. inv ADD.
  edestruct Memory.add_exists with (released:=released')
    as [memory_add' ADD']; eauto.
  eexists. splits; eauto.
  constructor; ins.
  { assert (exists view'',
               ⟪ VLE : View.opt_le view'' view' ⟫ /\
               ⟪ INT' :
                 Memory.get loc0 t (LocFun.add loc r memory') =
                 Some (f', Message.mk val0 view'') ⟫) as [view''].
    { erewrite Memory.add_o in INT; eauto.
      desf.
      { simpls; desf.
        eexists. splits; eauto.
        erewrite Memory.add_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      erewrite Memory.add_o; eauto.
      rewrite loc_ts_eq_dec_neq; auto.
      eexists. splits; [|by eauto].
      reflexivity. }
    desc.
    eapply (TOU UP_MEM_ADD) in INT'.
    desc. eexists. eexists.
    splits; eauto. etransitivity; eauto. }
  { assert (exists view'',
               ⟪ VLE : View.opt_le view'' view' ⟫ /\
               ⟪ INT' :
                 Memory.get loc0 t' (LocFun.add loc r memory') =
                 Some (f', Message.mk val' view'') ⟫) as [view''].
    { erewrite Memory.add_o in INT; eauto.
      desf.
      { simpls; desf.
        eexists. splits; eauto.
        erewrite Memory.add_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      erewrite Memory.add_o; eauto.
      rewrite loc_ts_eq_dec_neq; auto.
      eexists. splits; [|by eauto].
      reflexivity. }
    desc.
    eapply (TOUIN UP_MEM_ADD) in INT'; eauto. }
  eapply (FROMU UP_MEM_ADD) in INT; eauto.
  desc.
  erewrite Memory.add_o in INT0; eauto.
  desf.
  { simpls; desf. repeat eexists.
    2,3: by apply ILE.
    erewrite Memory.add_o; eauto.
    rewrite loc_ts_eq_dec_eq. by unnw. }
  repeat eexists.
  2,3: by apply ILE.
  erewrite Memory.add_o; eauto.
  rewrite loc_ts_eq_dec_neq; auto. eauto.
Qed.

Lemma up_memory_add_exists_r memory memory' memory_add
           loc from to val released
           (FUTURE  : Memory.future Memory.init memory)
           (FUTURE' : Memory.future Memory.init memory')
           (FUTURE_ADD : Memory.future memory memory_add)
           (VW_CLOS : Memory.closed_opt_view released memory_add)
           (ULE : Time.le (View.rlx (View.unwrap released) loc) to)
           (ADD : Memory.add memory loc from to val released memory_add)
           (UP_MEM: up_memory memory memory') :
  exists released' memory_add',
    ⟪ LE : View.opt_le released released' ⟫ /\
    ⟪ VW_WF : View.opt_wf released' ⟫ /\
    ⟪ ADDU : Memory.add memory' loc from to val released' memory_add' ⟫ /\
    ⟪ FUTURE : Memory.future Memory.init memory_add' ⟫ /\
    ⟪ UP_MEM_ADD : up_memory memory_add memory_add' ⟫.
Proof using.
  assert (View.opt_wf released) as VW_WF.
  { inv ADD. inv ADD0. }
  edestruct up_memory_add_exists_r_view_eq as [memory_add'']; eauto.
  { reflexivity. }
  desc.
  edestruct up_memory_closed_bigger_view with
      (memory:=memory_add) (memory':=memory_add'') as [released']; eauto.
  { etransitivity; [|by eauto].
    done. }
  { eapply Memory.add_inhabited; eauto.
      by apply inhabited_future_init. }
  desc.
  edestruct up_memory_add_bigger_view as [memory_add']; eauto.
  desc.
  eexists. eexists. splits; eauto.
  etransitivity; eauto.
  apply clos_rt1n_step.

  assert (Time.le (View.rlx (View.unwrap released') loc) to) as TT.
  { eapply VW_EQ; eauto.
    { eapply ts_lt_or_bot_add; [|by eauto].
        by apply ts_lt_or_bot_future_init. }
    { eapply message_disjoint_add; eauto.
        by apply message_disjoint_future_init. }
    all: erewrite Memory.add_o; eauto.
    all: by rewrite loc_ts_eq_dec_eq. }

  econstructor.
  { apply Memory.op_add. eauto. }
  2: done.
  eapply Memory.add_closed with (mem1:=memory') (released:=released'); eauto.
  { eapply Memory.future_closed; eauto.
    apply Memory.init_closed. }
  2: { erewrite Memory.add_o; eauto.
         by rewrite loc_ts_eq_dec_eq. }
  destruct released'; constructor.
  inv VW_CLOS0.
  destruct CLOSED as [AA BB].
  red in AA. red in BB.
  clear -AA BB ADDU ADDU0.
  constructor.
  all: red; intros loc'.
  all:  specialize (AA loc'); specialize (BB loc').
  all: desc.
  all: erewrite Memory.add_o; eauto.
  all: erewrite Memory.add_o in AA; [|by eauto].
  all: erewrite Memory.add_o in BB; [|by eauto].
  all: desf; eauto.
Qed.

Lemma up_memory_add_exists_l memory memory' memory_add'
           loc from to val released released'
           (ADD : Memory.add memory' loc from to val released' memory_add')
           (MSG_DISJ : message_disjoint memory)
           (TS_LT    : ts_lt_or_bot memory)
           (INHAB'   : Memory.inhabited memory')
           (LE : View.opt_le released released')
           (VWF : View.opt_wf released)
           (UP_MEM: up_memory memory memory') :
  exists memory_add,
    ⟪ ADDU : Memory.add memory loc from to val released memory_add ⟫ /\
    ⟪ UP_MEM_ADD : up_memory memory_add memory_add' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_add ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_add ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_add' ⟫.
Proof using.
  assert (ADD':=ADD).
  destruct ADD'. destruct ADD0.
  edestruct Memory.add_exists with (mem1:=memory) (released:=released)
    as [memory_add MM]; eauto.
  { ins. destruct msg2 as [v rel].
    apply (FROMU UP_MEM) in GET2.
    desc. apply DISJOINT in INT.
    symmetry.
    eapply Interval.le_disjoint; eauto.
    by symmetry. }
  exists memory_add; splits; eauto.
  4: by eapply Memory.add_inhabited; eauto.
  3: by eapply ts_lt_or_bot_add; eauto.
  2: by eapply message_disjoint_add; eauto.
  constructor; ins.
  { erewrite Memory.add_o; eauto.
    erewrite Memory.add_o in INT; eauto.
    destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
    2: by apply UP_MEM.
    desf. repeat eexists; unnw; auto.
    reflexivity. }
  { erewrite Memory.add_o in INT; eauto.
    desf.
    { simpls. desf.
      repeat eexists.
      2,3: by apply IMU.
      erewrite Memory.add_o; eauto.
      rewrite loc_ts_eq_dec_eq; eauto. }
    eapply UP_MEM in IMU; eauto. desc.
    repeat eexists.
    2,3: by apply IMP.
    eapply Memory.add_get1; eauto. }
  erewrite Memory.add_o in INT; eauto.
  destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
  { desf. repeat eexists; eauto.
    2,3: reflexivity.
    erewrite Memory.add_o; eauto.
    rewrite loc_ts_eq_dec_eq. eauto. }
  apply UP_MEM in INT. desc.
  destruct ILE.
  repeat eexists; eauto.
  eapply Memory.add_get1; eauto.
Qed.

Lemma up_memory_add_exists_l_view_eq memory memory' memory_add'
           loc from to val released
           (ADD : Memory.add memory' loc from to val released memory_add')
           (MSG_DISJ : message_disjoint memory)
           (TS_LT    : ts_lt_or_bot memory)
           (INHAB'   : Memory.inhabited memory')
           (UP_MEM: up_memory memory memory') :
  exists memory_add,
    ⟪ ADDU : Memory.add memory loc from to val released memory_add ⟫ /\
    ⟪ UP_MEM_ADD : up_memory memory_add memory_add' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_add ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_add ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_add' ⟫.
Proof using.
  eapply up_memory_add_exists_l; eauto.
  { reflexivity. }
  inv ADD. inv ADD0.
Qed.

Lemma up_memory_closed_view view memory memory'
      (UP_MEM : up_memory memory memory')
      (CLOS : Memory.closed_view view memory') :
  Memory.closed_view view memory.
Proof using.
  destruct CLOS.
  constructor; red; ins.
  2: specialize (RLX loc).
  specialize (PLN loc).
  all: desc.
  2: apply UP_MEM in RLX.
  apply UP_MEM in PLN.
  all: desc.
  all: repeat eexists; eauto.
Qed.

Lemma up_memory_closed_opt_view view memory memory'
      (UP_MEM : up_memory memory memory')
      (CLOS : Memory.closed_opt_view view memory') :
  Memory.closed_opt_view view memory.
Proof using.
  destruct view.
  2: by apply Memory.closed_opt_view_none.
  apply Memory.closed_opt_view_some.
  inv CLOS.
  eapply up_memory_closed_view; eauto.
Qed.

(* TODO: add explanation *)
Lemma future_memory_to_append_memory
      memory memory'
      (FUTURE_INIT : Memory.future Memory.init memory)
      (FUTURE : Memory.future memory memory') :
  exists memory'',
    ⟪ FUTURE : Memory.future Memory.init memory'' ⟫ /\
    ⟪ MEM_LE   : Memory.le memory memory'' ⟫ /\
    ⟪ UP_MEM   : up_memory memory' memory'' ⟫.
Proof using.
  assert (Memory.future Memory.init memory') as FUTURE_INIT'.
  { etransitivity; eauto. }
  apply clos_rt1n_rt in FUTURE.
  apply clos_rt_rtn1 in FUTURE.
  induction FUTURE.
  { eexists. splits; eauto.
    { reflexivity. }
    apply up_memory_refl. }
  assert (Memory.future Memory.init y) as YY.
  { etransitivity; [by apply FUTURE_INIT|].
    apply clos_rt_rt1n_iff.
      by apply clos_rt_rtn1_iff. }
  destruct IHFUTURE as [memory'']; auto.
  desc.
  set (H':=H).
  destruct H'.
  destruct OP.
  { edestruct up_memory_add_exists_r with
        (released:=released) (memory:=y) (memory':=memory'') (memory_add:=z)
      as [released' [memory_add]]; eauto.
    { by apply clos_rt1n_step. }
    desc.
    exists memory_add. splits; auto.
    etransitivity; eauto.
    eapply memory_add_le; eauto. }
  2: { exists memory''. splits; auto.
       constructor; ins.
       { apply (TOU UP_MEM) in INT.
         desc.
         assert (UU := INF).
         eapply Memory.lower_get1 in UU; eauto.
         desc. rewrite UU.
         eexists. eexists. splits; eauto.
         etransitivity; eauto. }
       { ins. eapply (TOUIN UP_MEM) in INT; eauto.
         desc.
         eapply Memory.lower_get1 in INF; eauto.
         desc. repeat eexists; eauto.
         all: apply IMP. }
       erewrite Memory.lower_o in INT; eauto.
       destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
       2: by eapply FROMU; eauto.
       desf.
       destruct LOWER. destruct LOWER.
       eapply FROMU in GET2; eauto. }
  exists memory''. splits; auto.
  constructor; ins.
  { apply (TOU UP_MEM) in INT. desc.
    assert (UU := INF).
    eapply Memory.split_get1 in UU; eauto.
    desc. rewrite UU.
    eexists. eexists. splits; eauto. }
  { eapply UP_MEM in IMU; eauto. desc.
    destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls; subst.
    { edestruct Memory.split_get0 as [HH _]; eauto.
      rewrite HH in INF. inv INF. }
    destruct (loc_ts_eq_dec (loc0, t) (loc, to3)) as [[BB CC]|BB]; simpls; subst.
    2: { repeat eexists.
         2,3: by apply IMP.
         erewrite Memory.split_o; eauto.
         repeat (rewrite loc_ts_eq_dec_neq; eauto). }
    assert (f = from); subst.
    { destruct SPLIT. destruct SPLIT.
      unfold Memory.get, Cell.get in INF.
      rewrite GET2 in INF. desf. }
    destruct (Time.le_lt_dec m to) as [BB|BB].
    { repeat eexists.
      3: by apply BB.
      2: by apply IMP.
      erewrite Memory.split_o; eauto.
      rewrite loc_ts_eq_dec_eq.
      eauto. }
    exists to3. exists to. repeat eexists; simpls.
    2: by apply IMP.
    erewrite Memory.split_o; eauto.
    rewrite loc_ts_eq_dec_neq; auto.
    rewrite loc_ts_eq_dec_eq; auto. }
  erewrite Memory.split_o in INT; eauto.
  destruct (loc_ts_eq_dec (loc0, t) (loc, to)) as [[AA BB]|AA]; simpls.
  { desf.
    destruct SPLIT. destruct SPLIT.
    eapply FROMU in GET2; eauto. desc.
    eexists. eexists. eexists. eexists.
    splits; eauto.
    destruct ILE.
    constructor; splits; simpls.
    apply Time.le_lteq. left.
    eapply TimeFacts.lt_le_lt; eauto. }
  destruct (loc_ts_eq_dec (loc0, t) (loc, to3)) as [[BB CC]|BB]; simpls.
  2: by eapply FROMU; eauto.
  desf.
  destruct SPLIT. destruct SPLIT.
  eapply FROMU in GET2; eauto. desc.
  eexists. eexists. eexists. eexists.
  splits; eauto.
  destruct ILE.
  constructor; simpls.
  apply Time.le_lteq. left.
  eapply TimeFacts.le_lt_lt; eauto.
Qed.

Lemma up_memory_split_exists memory memory' memory_split'
      loc from to ts val val' released released' view
      (UP_MEM   : up_memory memory memory')
      (MSG_DISJ : message_disjoint memory)
      (TS_LT    : ts_lt_or_bot memory)
      (INHAB'   : Memory.inhabited memory')
      (VWF : View.opt_wf released)
      (VLE : View.opt_le released released')
      (SP' : Memory.split
               memory' loc from to ts val val' released' view memory_split')
      (GET : Memory.get loc ts memory = Some (from, Message.mk val' view)):
  exists memory_split,
    ⟪ SP : Memory.split memory loc from to ts val val' released view memory_split ⟫ /\
    ⟪ UP_SP : up_memory memory_split memory_split' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_split ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_split ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_split' ⟫.
Proof using.
  assert (Memory.get loc ts memory' = Some (from, Message.mk val' view)) as GET'.
  { eapply memory_split_get_old. eauto. }
  assert (ts <> to) as TT.
  { intros HH. subst. inv SP'. inv SPLIT.
      by apply Time.lt_strorder in TS23. }
  set (SP'' := SP'). destruct SP''.
  destruct SPLIT.
  edestruct Memory.split_exists with (mem1:=memory) (released2:=released) as [memory_split];
    eauto.
  exists memory_split. splits; eauto.
  constructor; ins.
  { erewrite Memory.split_o in INT; eauto.
    erewrite Memory.split_o; eauto.
    desf; simpls; desc; subst.
    3: by apply UP_MEM.
    all: eexists; eexists; splits; eauto; reflexivity. }
  { erewrite Memory.split_o in INT; eauto.
    desf; simpls; desc; subst.
    { repeat eexists; simpls; eauto.
      2,3: by apply IMU.
      erewrite Memory.split_o; eauto.
      rewrite loc_ts_eq_dec_eq; simpls. }
    { repeat eexists; simpls; eauto.
      2,3: by apply IMU.
      erewrite Memory.split_o; eauto.
      rewrite loc_ts_eq_dec_neq; simpls.
      rewrite (loc_ts_eq_dec_eq loc ts); simpls. }
    eapply (TOUIN UP_MEM) in INT; eauto. desc.
    destruct (loc_ts_eq_dec (loc0,t) (loc,ts)) as [[AA BB]|BB]; simpls; subst.
    { destruct (Time.le_lt_dec m to) as [LL|LL].
      { repeat eexists; simpls; eauto.
        2: by apply IMP.
        erewrite Memory.split_o; eauto.
        rewrite loc_ts_eq_dec_eq; simpls.
        rewrite INF in GET. inv GET. }
      repeat eexists; simpls; eauto.
      2: by apply IMP.
      erewrite Memory.split_o; eauto.
      erewrite loc_ts_eq_dec_neq; eauto.
      erewrite loc_ts_eq_dec_eq; eauto. }
    repeat eexists; simpls; eauto.
    2,3: by apply IMP.
    simpls.
    erewrite Memory.split_o; eauto.
    repeat erewrite loc_ts_eq_dec_neq; eauto.
    destruct (classic (loc0 = loc)) as [|LNEQ]; [subst; right| by left].
    intros HH. subst.
    edestruct Memory.split_get0 as [AA]; eauto.
    rewrite AA in INF. inv INF. }
  4: by eapply Memory.split_inhabited; eauto.
  3: by eapply ts_lt_or_bot_split; eauto.
  2: by eapply message_disjoint_split; eauto.
  ins.
  erewrite Memory.split_o in INT; eauto.
  desf; simpls; desc; subst.
  { repeat eexists; simpls.
    2,3: reflexivity.
    erewrite Memory.split_o; eauto.
    rewrite loc_ts_eq_dec_eq; eauto. }
  { repeat eexists; simpls.
    2,3: reflexivity.
    erewrite Memory.split_o; eauto.
    rewrite loc_ts_eq_dec_neq; eauto.
    rewrite loc_ts_eq_dec_eq; eauto. }
  set (INT' := INT).
  apply (FROMU UP_MEM) in INT'. desc.
  destruct (loc_ts_eq_dec (loc0,t') (loc,ts)) as [[AA BB]|BB]; simpls; subst.
  2: { repeat eexists; simpls; eauto.
       2,3: by apply ILE.
       simpls.
       erewrite Memory.split_o; eauto.
       repeat erewrite loc_ts_eq_dec_neq; eauto.
       destruct (classic (loc0 = loc)) as [|LNEQ]; [subst; right| by left].
       intros HH. subst.
       clear -INT0 SP'.
       edestruct Memory.split_get0 as [AA]; eauto.
       rewrite AA in INT0. inv INT0. }
  desf.
  set (UU := INT).
  eapply TS_LT in UU; eauto. desf.
  { assert (Memory.inhabited (LocFun.add loc r memory')) as XX.
    { eapply Memory.split_inhabited; eauto. }
    repeat eexists.
    2,3: reflexivity.
    apply XX. }
  desf.
  exfalso.
  clear -ILE o0 GET INT H FTLT MSG_DISJ.
  eapply interval_le_not_disjoint.
  3,4: by eauto.
  all: eauto.
  { inv ILE. simpls.
    eapply TimeFacts.lt_le_lt; eauto.
    eapply TimeFacts.le_lt_lt; eauto. }
  eapply MSG_DISJ in INT; eauto. eapply INT in GET; eauto.
  desf.
Qed.

Lemma up_memory_split_exists_view_eq memory memory' memory_split'
      loc from to ts val val' released released'
      (UP_MEM : up_memory memory memory')
      (MSG_DISJ : message_disjoint memory)
      (TS_LT    : ts_lt_or_bot memory)
      (INHAB'   : Memory.inhabited memory')
      (SP' : Memory.split
               memory' loc from to ts val val' released released' memory_split')
      (GET : Memory.get loc ts memory = Some (from, Message.mk val' released')):
  exists memory_split,
    ⟪ SP : Memory.split memory loc from to ts val val' released released' memory_split ⟫ /\
    ⟪ UP_SP : up_memory memory_split memory_split' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_split ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_split ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_split' ⟫.
Proof using.
  eapply up_memory_split_exists; eauto.
  2: reflexivity.
  inv SP'. inv SPLIT.
Qed.

Lemma up_memory_lower_exists memory memory' memory_lower'
      loc from to val view released released'
      (UP_MEM : up_memory memory memory')
      (MSG_DISJ : message_disjoint memory)
      (TS_LT    : ts_lt_or_bot memory)
      (INHAB'   : Memory.inhabited memory')
      (VWF : View.opt_wf released)
      (VLE : View.opt_le released released')
      (LW' : Memory.lower
               memory' loc from to val view released' memory_lower')
      (GET : Memory.get loc to memory = Some (from, Message.mk val view)):
  exists memory_lower,
    ⟪ LW : Memory.lower memory loc from to val view released memory_lower ⟫ /\
    ⟪ UP_LW : up_memory memory_lower memory_lower' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_lower ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_lower ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_lower' ⟫.
Proof using.
  inv LW'. inv LOWER.
  edestruct Memory.lower_exists with (mem1:=memory) (released1:=view) (released2:=released)
    as [memory_lower]; eauto.
  { etransitivity; eauto. }
  exists memory_lower. splits; eauto.
  constructor; ins.
  { erewrite Memory.lower_o in INT; eauto.
    erewrite Memory.lower_o; eauto.
    desf; simpls; desc; subst.
    2: by apply UP_MEM.
    eexists; eexists. splits; eauto; reflexivity. }
  { erewrite Memory.lower_o in INT; eauto.
    desf; simpls; desc; subst.
    { repeat eexists; simpls; eauto.
      2,3: by apply IMU.
      erewrite Memory.lower_o; eauto.
      rewrite loc_ts_eq_dec_eq; simpls. }
    eapply (TOUIN UP_MEM) in INT; eauto. desc.
    destruct (loc_ts_eq_dec (loc0, t) (loc, to)); simpls.
    { clear o. desf. repeat eexists.
      2,3: by apply IMP.
      erewrite Memory.lower_o; eauto.
        by rewrite loc_ts_eq_dec_eq. }
    repeat eexists.
    2,3: by apply IMP.
    erewrite Memory.lower_o; eauto.
    rewrite loc_ts_eq_dec_neq; eauto. }
  4: by eapply Memory.lower_inhabited; eauto.
  3: by eapply ts_lt_or_bot_lower; eauto.
  2: by eapply message_disjoint_lower; eauto.
  ins.
  erewrite Memory.lower_o in INT; eauto.
  desf; simpls; desc; subst.
  { repeat eexists; simpls.
    2,3: reflexivity.
    erewrite Memory.lower_o; eauto.
    rewrite loc_ts_eq_dec_eq; eauto. }
  apply UP_MEM in INT. desc.
  destruct (loc_ts_eq_dec (loc0, t') (loc, to)); simpls.
  { desf. repeat eexists.
    2,3: by apply ILE.
    erewrite Memory.lower_o; eauto.
    rewrite loc_ts_eq_dec_eq; eauto.
    inv LW'. inv LOWER0. unfold Memory.get, Cell.get in INT0.
    rewrite INT0 in GET0. inv GET0. }
  repeat eexists.
  2,3: by apply ILE.
  erewrite Memory.lower_o; eauto.
  rewrite loc_ts_eq_dec_neq; eauto.
Qed.

Lemma up_memory_lower_exists_view_eq memory memory' memory_lower'
      loc from to val released released'
      (UP_MEM : up_memory memory memory')
      (MSG_DISJ : message_disjoint memory)
      (TS_LT    : ts_lt_or_bot memory)
      (INHAB'   : Memory.inhabited memory')
      (LW' : Memory.lower
               memory' loc from to val released released' memory_lower')
      (GET : Memory.get loc to memory = Some (from, Message.mk val released)):
  exists memory_lower,
    ⟪ LW : Memory.lower memory loc from to val released released' memory_lower ⟫ /\
    ⟪ UP_LW : up_memory memory_lower memory_lower' ⟫ /\
    ⟪ MSG_DISJ : message_disjoint memory_lower ⟫ /\
    ⟪ TS_LT    : ts_lt_or_bot memory_lower ⟫ /\
    ⟪ INHAB'   : Memory.inhabited memory_lower' ⟫.
Proof using.
  eapply up_memory_lower_exists; eauto.
  2: reflexivity.
  inv LW'. inv LOWER.
Qed.

Record future_sim_rel lang (tc tc' : Thread.t lang) :=
  { ST     : tc.(Thread.state) = tc'.(Thread.state);
    PROM   : tc.(Thread.local).(Local.promises) = tc'.(Thread.local).(Local.promises);
    TVIEW  : TView.le_ tc.(Thread.local).(Local.tview) tc'.(Thread.local).(Local.tview);
    SC_LE  : TimeMap.le tc.(Thread.sc) tc'.(Thread.sc);
    UP_MEM : up_memory tc.(Thread.memory) tc'.(Thread.memory);
    MSG_DISJ : message_disjoint tc.(Thread.memory);
    TS_LT    : ts_lt_or_bot tc.(Thread.memory);
    REL_WF   : message_view_wf tc.(Thread.memory);
    INHAB'   : Memory.inhabited tc'.(Thread.memory);
  }.

Lemma future_sim_step lang (tc tc' tc_new' : Thread.t lang)
      (WF  : Local.wf tc .(Thread.local) tc .(Thread.memory))
      (WF' : Local.wf tc'.(Thread.local) tc'.(Thread.memory))
      (STEP : Thread.tau_step (lang:=lang) tc' tc_new')
      (SIM : future_sim_rel tc tc') :
  exists tc_new,
      ⟪ STEP : (Thread.tau_step (lang:=lang))⁺ tc tc_new ⟫ /\
      ⟪ SIM : future_sim_rel tc_new tc_new' ⟫.
Proof using.
  destruct SIM.
  destruct STEP. destruct TSTEP.
  destruct STEP.
  { destruct STEP.
    destruct lc1. destruct lc2.
    destruct tc  as [st_ [] sc_ mem_].
    simpls; subst.
    destruct LOCAL. simpls.
    assert (exists mem_2,
               ⟪ MM1 : Memory.promise promises mem_ loc from to val released
                              promises2 mem_2 kind ⟫ /\
               ⟪ MM2 : Memory.closed_opt_view released mem_2 ⟫ /\
               ⟪ MM3 : Time.le (View.rlx (View.unwrap released) loc) to ⟫ /\
               ⟪ MMU : up_memory mem_2 mem2 ⟫ /\
               ⟪ MMD : message_disjoint mem_2 ⟫ /\
               ⟪ MMT : ts_lt_or_bot mem_2 ⟫ /\
               ⟪ MMI : Memory.inhabited mem2 ⟫
           ) as [mem_2].
    { destruct PROMISE.
      { edestruct up_memory_add_exists_l_view_eq with (memory:=mem_) as [mem_2]; eauto.
        desc. exists mem_2. splits; auto.
        { by apply Memory.promise_add. }
        eapply up_memory_closed_opt_view; eauto. }
      { edestruct up_memory_split_exists_view_eq with
            (memory:=mem_) (memory':=mem1) as [mem_2]; eauto.
        { inv PROMISES. inv SPLIT. by apply WF in GET2. }
        desc.
        exists mem_2. splits; auto.
        { by apply Memory.promise_split. }
        eapply up_memory_closed_opt_view; eauto. }
      edestruct up_memory_lower_exists_view_eq with (memory:=mem_) (memory':=mem1) as [mem_2];
          eauto.
      { inv PROMISES. inv LOWER. by apply WF in GET2. }
      desc.
      exists mem_2. splits; auto.
      { by apply Memory.promise_lower. }
      eapply up_memory_closed_opt_view; eauto. }
    desc.
    eexists. splits.
    { apply t_step. econstructor.
      { econstructor. eapply Thread.step_promise.
        repeat (econstructor; eauto). }
      done. }
    constructor; simpls.
    eapply message_view_wf_promise; eauto. }
  destruct STEP. simpls.
  destruct lc1. destruct lc2.
  destruct tc  as [st_ [] sc_ mem_].
  simpls; subst.
  inv LOCAL.
  { eexists. splits.
    { apply t_step. econstructor.
      { econstructor. eapply Thread.step_program.
        econstructor; eauto.
        econstructor. }
      done. }
    constructor; simpls. }
  { destruct LOCAL0. simpls.
    apply (TOU UP_MEM0) in GET. desc.
    eexists. splits.
    { apply t_step. econstructor.
      { econstructor. eapply Thread.step_program.
        econstructor.
        2: { eapply Local.step_read.
             econstructor; eauto.
             eapply TViewFacts.readable_mon; eauto.
             2: reflexivity.
             apply TVIEW0. }
        eauto. }
      done. }
    constructor; simpls. subst.
    unfold TView.read_tview.
    constructor; simpls.
    { by apply TVIEW0. }
    all: apply view_le_rect; [|desf; [by apply View.unwrap_opt_le|reflexivity]].
    all: apply view_le_rect; [|reflexivity].
    all: apply TVIEW0. }
  { destruct LOCAL0. simpls.
    destruct WRITE.
    set (released_ := TView.write_released tview1 sc_ loc to None ord).
    assert (View.opt_le released_ released) as RLE.
    { subst. unfold released_, TView.write_released.
      desf; [|reflexivity].
      apply View.opt_le_some.
      apply view_le_rect; [reflexivity|].
      unfold TView.write_tview. simpls.
      unfold LocFun.add. desf.
      all: apply view_le_rect; [|reflexivity].
      all: apply TVIEW0. }
    assert (View.opt_wf released_) as VWF.
    { unfold released_, TView.write_released.
      desf; constructor.
      rewrite View.join_bot_l.
      unfold TView.write_tview; simpls.
      unfold LocFun.add. rewrite Loc.eq_dec_eq.
      unfold View.join. constructor; desf; simpls.
      all: apply timemap_le_rect; [|reflexivity].
      all: apply WF. }
    assert (TView.le_ (TView.write_tview tview1 sc_ loc to ord)
                      (TView.write_tview tview sc1 loc to ord)) as WV.
    { unfold TView.write_tview. constructor; simpls.
      ins. unfold LocFun.find, LocFun.add.
      desf.
      all: try (apply view_le_rect; [apply TVIEW0|reflexivity]).
      apply TVIEW0. }
    destruct PROMISE.
    { (* add case *)
      edestruct up_memory_add_exists_l with (memory:=mem_) (released:=released_)
        as [mem_']; eauto.
      desc.
      assert (exists (promise_ : Memory.t),
                 Memory.add promises loc from to val released_ promise_)
        as [promise_ PP].
      { eapply Memory.add_exists_le.
        { apply WF. }
        apply ADDU. }
      assert (exists (promise_' : Memory.t),
                 Memory.remove promise_ loc from to val released_ promise_')
        as [promise_' RR].
      { apply Memory.remove_exists.
        erewrite Memory.add_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      eexists. splits.
      { apply t_step.
        econstructor.
        { econstructor. eapply Thread.step_program.
          econstructor.
          2: { eapply Local.step_write.
               econstructor.
               { done. }
               { constructor. eapply TimeFacts.le_lt_lt.
                 2: by apply WRITABLE.
                 apply TVIEW0. }
               2: by eauto.
               econstructor; eauto.
               apply Memory.promise_add; eauto.
               etransitivity; eauto.
               subst.
               unfold TView.write_released.
               desf; simpls.
               2: by apply Time.bot_spec.
               repeat (rewrite TimeMap.le_join_r; [|by apply TimeMap.bot_spec]).
               unfold LocFun.add. rewrite !Loc.eq_dec_eq.
               desf; unfold View.join; simpls.
               all: apply timemap_le_rect; [apply TVIEW0|reflexivity]. }
          eauto. }
        done. }
      constructor; simpls.
      all: try by apply UP_EXTRA.
      apply Memory.ext.
      ins.
      erewrite Memory.remove_o; eauto.
      erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
      desf.
      erewrite Memory.add_o; eauto.
      erewrite Memory.add_o with (mem2:=promises1); [|by apply PROMISES].
      desf; simpls; desf.
      eapply message_view_wf_add; eauto. }
    { (* split case *)
      edestruct up_memory_split_exists with (memory:=mem_) (released:=released_) as [mem_'];
        eauto.
      { inv PROMISES. inv SPLIT. by apply WF in GET2. }
      desc.
      assert (exists (promise_ : Memory.t),
                 Memory.split promises loc from to ts3 val val3 released_ released3 promise_)
        as [promise_ PP].
      { inv PROMISES. inv SPLIT.
        apply Memory.split_exists; auto. }
      assert (exists (promise_' : Memory.t),
                 Memory.remove promise_ loc from to val released_ promise_')
        as [promise_' RR].
      { apply Memory.remove_exists.
        erewrite Memory.split_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      eexists. splits.
      { apply t_step.
        econstructor.
        { econstructor. eapply Thread.step_program.
          econstructor.
          2: { eapply Local.step_write.
               econstructor.
               { done. }
               { constructor. eapply TimeFacts.le_lt_lt.
                 2: by apply WRITABLE.
                 apply TVIEW0. }
               2: by eauto.
               econstructor; eauto.
               apply Memory.promise_split; eauto.
               etransitivity; eauto.
               subst.
               unfold TView.write_released.
               desf; simpls.
               2: by apply Time.bot_spec.
               repeat (rewrite TimeMap.le_join_r; [|by apply TimeMap.bot_spec]).
               unfold LocFun.add. rewrite !Loc.eq_dec_eq.
               desf; unfold View.join; simpls.
               all: apply timemap_le_rect; [apply TVIEW0|reflexivity]. }
          eauto. }
        done. }
      constructor; simpls.
      apply Memory.ext.
      ins.
      erewrite Memory.remove_o; eauto.
      erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
      desf.
      erewrite Memory.split_o; eauto.
      erewrite Memory.split_o with (mem2:=promises1); [|by apply PROMISES].
      desf; simpls; desf.
      eapply message_view_wf_split; eauto. }
    (* lower case *)
    edestruct up_memory_lower_exists with (memory:=mem_) (released:=released_) as [mem_'];
      eauto.
    { inv PROMISES. inv LOWER. by apply WF in GET2. }
    assert (exists (promise_ : Memory.t),
               Memory.lower promises loc from to val released0 released_ promise_)
      as [promise_ PP].
    { inv PROMISES. inv LOWER.
      apply Memory.lower_exists; auto.
      etransitivity; eauto. }
    assert (exists (promise_' : Memory.t),
               Memory.remove promise_ loc from to val released_ promise_')
      as [promise_' RR].
    { apply Memory.remove_exists.
      erewrite Memory.lower_o; eauto.
        by rewrite loc_ts_eq_dec_eq. }
    desc.
    eexists. splits.
    { apply t_step.
      econstructor.
      { econstructor. eapply Thread.step_program.
        econstructor.
        2: { eapply Local.step_write.
             econstructor.
             { done. }
             { constructor. eapply TimeFacts.le_lt_lt.
               2: by apply WRITABLE.
               apply TVIEW0. }
             2: by eauto.
             econstructor; eauto.
             apply Memory.promise_lower; eauto.
             etransitivity; eauto.
             subst.
             unfold TView.write_released.
             desf; simpls.
             2: by apply Time.bot_spec.
             repeat (rewrite TimeMap.le_join_r; [|by apply TimeMap.bot_spec]).
             unfold LocFun.add. rewrite !Loc.eq_dec_eq.
             desf; unfold View.join; simpls.
             all: apply timemap_le_rect; [apply TVIEW0|reflexivity]. }
        eauto. }
      done. }
    constructor; simpls.
    apply Memory.ext.
    ins.
    erewrite Memory.remove_o; eauto.
    erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
    desf.
    erewrite Memory.lower_o; eauto.
    erewrite Memory.lower_o with (mem2:=promises1); [|by apply PROMISES].
    desf; simpls; desf.
    eapply message_view_wf_lower; eauto. }
  { (* RMW cover case *)
    destruct LOCAL1. simpls.
    destruct LOCAL2. simpls.
    destruct WRITE.
    set (GET' := GET).
    apply (TOU UP_MEM0) in GET'. desc.
    set (tview_ := TView.read_tview tview1 loc tsr view ordr).
    set (released_ := TView.write_released tview_ sc_ loc tsw view ordw).
    assert (View.le (View.unwrap view) (View.unwrap releasedr)) as XX.
    { by apply View.unwrap_opt_le. }
    assert (View.opt_le released_ releasedw) as RLE.
    { subst. unfold released_, TView.write_released.
      desf; [|reflexivity].
      apply View.opt_le_some.
      apply view_le_rect; auto.
      unfold TView.write_tview. simpls.
      unfold LocFun.add. desf.
      all: repeat (apply view_le_rect); auto.
      all: try reflexivity.
      all: by apply TVIEW0. }
    assert (View.wf (View.unwrap view)) as VVWF.
    { apply REL_WF0 in INF. inv INF. apply View.bot_wf. }
    assert (View.opt_wf released_) as VWF.
    { unfold released_, TView.write_released.
      desf; constructor.
      apply View.join_wf; auto.
      unfold TView.write_tview; simpls.
      unfold LocFun.add. rewrite Loc.eq_dec_eq.
      unfold View.join. constructor; desf; simpls.
      all: repeat (apply timemap_le_rect).
      all: try by apply WF.
      all: try reflexivity.
      2: by apply VVWF.
      all: unfold View.singleton_ur_if, View.singleton_ur, View.singleton_rw.
      all: desf; simpls.
      all: try reflexivity.
      all: apply TimeMap.bot_spec. }
    assert (TimeMap.le (View.rlx (View.unwrap view)) (View.rlx (View.unwrap releasedr)))
      as VLE.
    { by apply View.unwrap_opt_le. }
    assert (TimeMap.le
              (View.rlx (TView.cur tview_))
              (View.rlx (TView.cur tview2))) as TLE.
    { intros ll.
      rewrite <- TVIEW1. unfold TView.read_tview. simpls.
      repeat apply timemap_le_rect.
      { apply TVIEW0. }
      { reflexivity. }
      desf.
      reflexivity. }
    assert (TView.le_ (TView.write_tview tview_ sc_ loc tsw ordw)
                      (TView.write_tview tview2 sc1 loc tsw ordw)) as WV.
    { rewrite <- TVIEW1.
      unfold TView.write_tview. constructor; simpls.
      all: ins; unfold LocFun.find, LocFun.add.
      all: desf.
      all: repeat apply view_le_rect; auto.
      all: try reflexivity.
      all: apply TVIEW0. }
    destruct PROMISE.
    { (* add case *)
      edestruct up_memory_add_exists_l with (memory:=mem_) (released:=released_)
        as [mem_']; eauto.
      desc.
      assert (exists (promise_ : Memory.t),
                 Memory.add promises loc tsr tsw valw released_ promise_)
        as [promise_ PP].
      { eapply Memory.add_exists_le.
        { apply WF. }
        apply ADDU. }
      assert (exists (promise_' : Memory.t),
                 Memory.remove promise_ loc tsr tsw valw released_ promise_')
        as [promise_' RR].
      { apply Memory.remove_exists.
        erewrite Memory.add_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      eexists. splits.
      { apply t_step.
        econstructor.
        { econstructor. eapply Thread.step_program.
          econstructor.
          2: { eapply Local.step_update.
               { econstructor; eauto.
                 eapply TViewFacts.readable_mon; eauto.
                 2: reflexivity.
                 apply TVIEW0. }
               econstructor.
               { done. }
               { constructor. eapply TimeFacts.le_lt_lt; auto.
                   by apply WRITABLE. }
               2: by eauto.
               econstructor; eauto.
               apply Memory.promise_add; eauto.
               etransitivity; eauto.
               subst.
               unfold TView.write_released.
               desf; simpls.
               2: by apply Time.bot_spec.
               apply timemap_le_rect; auto.
               unfold LocFun.add. rewrite !Loc.eq_dec_eq.
               desf; unfold View.join; simpls.
               all: repeat apply timemap_le_rect; auto.
               all: try reflexivity.
               all: apply TVIEW0. }
          eauto. }
        done. }
      constructor; simpls.
      2: by eapply message_view_wf_add; eauto.
      apply Memory.ext.
      ins.
      erewrite Memory.remove_o; eauto.
      erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
      desf.
      all: erewrite Memory.add_o; eauto.
      all: erewrite Memory.add_o with (mem2:=promises1); [|by apply PROMISES].
      all: desf; simpls; desf. }
    { (* split case *)
      edestruct up_memory_split_exists with (memory:=mem_) (released:=released_) as [mem_'];
        eauto.
      { inv PROMISES. inv SPLIT. by apply WF in GET2. }
      desc.
      assert (exists (promise_ : Memory.t),
                 Memory.split promises loc tsr tsw ts3 valw val3 released_ released3 promise_)
        as [promise_ PP].
      { inv PROMISES. inv SPLIT.
        apply Memory.split_exists; auto. }
      assert (exists (promise_' : Memory.t),
                 Memory.remove promise_ loc tsr tsw valw released_ promise_')
        as [promise_' RR].
      { apply Memory.remove_exists.
        erewrite Memory.split_o; eauto.
          by rewrite loc_ts_eq_dec_eq. }
      eexists. splits.
      { apply t_step.
        econstructor.
        { econstructor. eapply Thread.step_program.
          econstructor.
          2: { eapply Local.step_update.
               { econstructor; eauto.
                 eapply TViewFacts.readable_mon; eauto.
                 2: reflexivity.
                 apply TVIEW0. }
               econstructor.
               { done. }
               { constructor. eapply TimeFacts.le_lt_lt; auto.
                   by apply WRITABLE. }
               2: by eauto.
               econstructor; eauto.
               apply Memory.promise_split; eauto.
               etransitivity; eauto.
               subst.
               unfold TView.write_released.
               desf; simpls.
               2: by apply Time.bot_spec.
               apply timemap_le_rect; auto.
               unfold LocFun.add. rewrite !Loc.eq_dec_eq.
               desf; unfold View.join; simpls.
               all: repeat apply timemap_le_rect; auto.
               all: try reflexivity.
               all: apply TVIEW0. }
          eauto. }
        done. }
      constructor; simpls.
      apply Memory.ext.
      ins.
      erewrite Memory.remove_o; eauto.
      erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
      desf.
      3: { eapply message_view_wf_split; eauto. }
      all: erewrite Memory.split_o; eauto.
      all: erewrite Memory.split_o with (mem2:=promises1); [|by apply PROMISES].
      all: desf; simpls; desf. }
    (* lower case *)
    edestruct up_memory_lower_exists with (memory:=mem_) (released:=released_) as [mem_'];
      eauto.
    { inv PROMISES. inv LOWER. by apply WF in GET2. }
    assert (exists (promise_ : Memory.t),
               Memory.lower promises loc tsr tsw valw released0 released_ promise_)
      as [promise_ PP].
    { inv PROMISES. inv LOWER.
      apply Memory.lower_exists; auto.
      etransitivity; eauto. }
    assert (exists (promise_' : Memory.t),
               Memory.remove promise_ loc tsr tsw valw released_ promise_')
      as [promise_' RR].
    { apply Memory.remove_exists.
      erewrite Memory.lower_o; eauto.
        by rewrite loc_ts_eq_dec_eq. }
    desc.
    eexists. splits.
    { apply t_step.
        econstructor.
        { econstructor. eapply Thread.step_program.
          econstructor.
          2: { eapply Local.step_update.
               { econstructor; eauto.
                 eapply TViewFacts.readable_mon; eauto.
                 2: reflexivity.
                 apply TVIEW0. }
               econstructor.
               { done. }
               { constructor. eapply TimeFacts.le_lt_lt; auto.
                   by apply WRITABLE. }
               2: by eauto.
               econstructor; eauto.
               apply Memory.promise_lower; eauto.
               etransitivity; eauto.
               subst.
               unfold TView.write_released.
               desf; simpls.
               2: by apply Time.bot_spec.
               apply timemap_le_rect; auto.
               unfold LocFun.add. rewrite !Loc.eq_dec_eq.
               desf; unfold View.join; simpls.
               all: repeat apply timemap_le_rect; auto.
               all: try reflexivity.
               all: apply TVIEW0. }
          eauto. }
        done. }
    constructor; simpls.
    apply Memory.ext.
    ins.
    erewrite Memory.remove_o; eauto.
    erewrite Memory.remove_o with (mem2:=promises2); [|by apply REMOVE].
    desf.
    3: { eapply message_view_wf_lower; eauto. }
    all: erewrite Memory.lower_o; eauto.
    all: erewrite Memory.lower_o with (mem2:=promises1); [|by apply PROMISES].
    all: desf; simpls; desf. }
  destruct LOCAL0. simpls.
  eexists. splits.
  { apply t_step. econstructor.
    { econstructor. eapply Thread.step_program.
      econstructor.
      2: { eapply Local.step_fence.
           econstructor; eauto. }
      eauto. }
    done. }
  constructor; simpls; subst.
  { unfold TView.write_fence_tview.
    constructor; simpls.
    { ins. unfold LocFun.find.
      desf.
      2-4: by apply TVIEW0.
      constructor; simpls.
      all: unfold TView.write_fence_sc, TView.read_fence_tview; desf; simpls.
      all: apply timemap_le_rect; auto.
      all: apply TVIEW0. }
    { desf.
      2-3: by apply TVIEW0.
      constructor; simpls.
      all: unfold TView.write_fence_sc, TView.read_fence_tview; desf; simpls.
      all: apply timemap_le_rect; auto.
      all: apply TVIEW0. }
    desf.
    2: by rewrite !view_join_bot_r; apply TVIEW0.
    constructor; simpls.
    all: unfold TView.write_fence_sc, TView.read_fence_tview; desf; simpls.
    all: repeat (apply timemap_le_rect); auto.
    all: apply TVIEW0. }
  unfold TView.write_fence_sc, TView.read_fence_tview; desf; simpls.
  all: repeat (apply timemap_le_rect); auto.
  all: apply TVIEW0.
Qed.

Lemma future_memory_switch
      lang (state : Language.Language.state lang)
      local sc_view memory sc_view' memory'
      (FUTURE_INIT : Memory.future Memory.init memory)
      (FUTURE      : Memory.future memory memory')
      (SC_LE       : TimeMap.le sc_view sc_view')
      (PROMISES    : Memory.le (Local.promises local) memory')
      (LOCAL_WF    : Local.wf local memory)
      (SC_CLOS     : Memory.closed_timemap sc_view' memory') :
  exists sc_view'' memory'',
    ⟪ MEM_LE : Memory.le memory memory'' ⟫ /\
    ⟪ FUTURE : Memory.future Memory.init memory'' ⟫ /\
    ⟪ SC_LE  : TimeMap.le sc_view sc_view'' ⟫ /\
    ⟪ LOCAL_WF : Local.wf local memory'' ⟫ /\
    ⟪ SC_CLOS : Memory.closed_timemap sc_view'' memory'' ⟫ /\
    ⟪ MEM_CLOS : Memory.closed memory' ⟫ /\
    ⟪ STEPS :
      forall (thread_conf : Thread.t lang)
             (EXEC : rtc (Thread.tau_step (lang:=lang))
                         (Thread.mk lang state local sc_view'' memory'')
                         thread_conf),
      exists (thread_conf' : Thread.t lang),
        ⟪ STEPS :
          rtc (Thread.tau_step (lang:=lang))
              (Thread.mk lang state local sc_view' memory')
              thread_conf' ⟫ /\
        ⟪ SIM : future_sim_rel thread_conf' thread_conf ⟫ ⟫.
Proof using.
  assert (Memory.closed memory') as MEM_CLOS'.
  { eapply Memory.future_closed; eauto.
    eapply Memory.future_closed; eauto.
    apply Memory.init_closed. }
  edestruct future_memory_to_append_memory with (memory:=memory) (memory':=memory')
    as [memory'']; eauto.
  desc.
  edestruct up_memory_closed_bigger_timemap with (memory:=memory') (memory':=memory'')
    as [sc_view'']; eauto.
  { by etransitivity; [|by eauto]. }
  { by apply inhabited_future_init. }
  desc.
  exists sc_view''. exists memory''.
  assert (Local.wf local memory') as LOCAL_WF'.
  { constructor; auto.
    1,3: by apply LOCAL_WF.
    constructor; ins.
    all: eapply Memory.future_closed_view; eauto.
    all: apply LOCAL_WF. }
  assert (Local.wf local memory'') as LOCAL_WF''.
  { constructor.
    1,4: by apply LOCAL_WF.
    { constructor; ins.
      all: eapply closed_view_le; eauto.
      all: apply LOCAL_WF. }
    etransitivity; [apply LOCAL_WF|apply MEM_LE]. }
  splits; auto.
  { etransitivity; eauto. }
  ins.
  assert (future_sim_rel
            (Thread.mk _ state local sc_view'  memory' )
            (Thread.mk _ state local sc_view'' memory'')) as XX.
  { constructor; simpls.
    { reflexivity. }
    { apply message_disjoint_future_init.
        by etransitivity; [|by eauto]. }
    { apply ts_lt_or_bot_future_init.
        by etransitivity; [|by eauto]. }
    2: by apply inhabited_future_init.
    apply message_view_wf_future_init.
      by etransitivity; [|by eauto]. }
  clear -EXEC LOCAL_WF LOCAL_WF' LOCAL_WF'' MEM_CLOS' XX SC_CLOS TM_CLOS FUTURE0.
  apply clos_rt_rt1n_iff in EXEC.
  apply clos_rt_rtn1_iff in EXEC.
  induction EXEC.
  { eexists. splits.
    { reflexivity. }
    done. }
  desc.
  assert (Local.wf (Thread.local thread_conf') (Thread.memory thread_conf')) as AA.
  { eapply Thread.rtc_tau_step_future; eauto. }
  assert (Local.wf (Thread.local y) (Thread.memory y)) as BB.
  { apply clos_rt_rtn1_iff in EXEC.
    apply clos_rt_rt1n in EXEC.
    eapply Thread.rtc_tau_step_future; eauto.
    all: simpls.
    eapply Memory.future_closed; [|by eauto].
    apply Memory.init_closed. }
  eapply future_sim_step in H.
  { desc. eexists. splits.
    2: by eauto.
    apply clos_rt_rt1n_iff.
    eapply rt_trans.
    { apply clos_rt_rt1n_iff. eauto. }
    apply clos_trans_in_rt; eauto. }
  all: auto.
Qed.


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

Require Export DistributedReferenceCounting.machine4.machine.
Require Export DistributedReferenceCounting.machine4.cardinal.
Require Export DistributedReferenceCounting.machine4.comm.

Unset Standard Proposition Elimination Names.

(** Changes with machine1:
   - As receive table owner equals 1, initally,
     I should add -1
   - Base cases had to be changed
   - inductive case, proof is unchanged
*)

Section INVARIANT1.

Remark add_reduce1 :
 forall x1 x2 y : Z, x1 = x2 -> (y + x1 - 1)%Z = (y + x2 - 1)%Z.
Proof.
  intros; omega.
Qed.

Lemma invariant1_init :
 sigma_send_table send_init =
 (sigma_receive_table rec_init + sigma_weight bag_init - 1)%Z.
Proof.
  unfold send_init, rec_init, bag_init in |- *.
  unfold sigma_send_table, sigma_receive_table, sigma_weight in |- *.
  unfold sigma_table in |- *.
  simpl in |- *.
  rewrite sigma_null.
  replace
   (sigma2_table Site LS LS (queue Message) (fun _ _ : Site => cardinal)
      (fun _ _ : Site => empty Message)) with 0%Z.
  rewrite (sigma_sigma_but Site owner eq_site_dec).
  case (eq_site_dec owner owner); intro.
  unfold Int in |- *.
  rewrite sigma_but_null.
  omega.

  intros.
  case (eq_site_dec s owner).
  intro; elim H; auto.

  auto.

  elim n; auto.

  apply finite_site.

  unfold sigma2_table in |- *.
  unfold sigma_table in |- *.
  symmetry  in |- *.
  simpl in |- *.
  rewrite sigma_null.
  apply sigma_null.
Qed.

Lemma invariant1_inductive :
 forall (c : Config) (t : class_trans c),
 legal c ->
 sigma_send_table (st c) =
 (sigma_receive_table (rt c) + sigma_weight (bm c) - 1)%Z ->
 sigma_send_table (st (transition c t)) =
 (sigma_receive_table (rt (transition c t)) +
  sigma_weight (bm (transition c t)) - 1)%Z.

Proof.
  simple induction t.

  (* 1 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_inc_send_table.
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.

  (* 2 *)

  intros; simpl in |- *.
  rewrite (sigma_weight_collect_message dec).
  rewrite sigma_dec_send_table.
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.

  (* 3 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_inc_send_table.
  rewrite sigma_weight_collect_message with (m := inc_dec s3).
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.

  (* 4 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_weight_collect_message with (m := copy).
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.

  (* 5 *)

  intros; simpl in |- *.
  rewrite sigma_weight_collect_message with (m := copy).
  rewrite sigma_set_receive_table.
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.
  auto.

  (* 6 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_weight_collect_message with (m := copy).
  rewrite sigma_set_receive_table.
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.
  auto.

  (* 7 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_reset_receive_table.
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  rewrite H0; omega.
  auto.

  (* optim 1 *)

  intros; simpl in |- *.
  rewrite sigma_weight_post_message.
  rewrite sigma_weight_change_queue with (s3 := s2).
  unfold cardinal_count in |- *; unfold fun_sum in |- *; simpl in |- *.
  omega.
  auto.

  (* optim 2 *)

  simpl in |- *; intros.
  rewrite H0.
  apply add_reduce1.
  unfold sigma_weight in |- *.
  unfold sigma2_table in |- *.
  apply sigma_table_simpl.
  apply funct_eq.
  intro.
  unfold sigma_table in |- *.
  apply sigma_simpl.
  intros.
  case (eq_queue_dec e1 s1 x s2); intro.
  decompose [and] a.
  rewrite H2; rewrite H3.
  rewrite that_queue.
  rewrite e.
  cut (cardinal (append Message q1 q2) = cardinal (append Message q3 q4)).
  unfold cardinal in |- *.
  rewrite reduce_append.
  rewrite reduce_append.
  omega.
  rewrite e0; auto.
  rewrite other_queue.
  auto.
  auto.
Qed.

Lemma invariant1 :
 forall c : Config,
 legal c ->
 sigma_send_table (st c) =
 (sigma_receive_table (rt c) + sigma_weight (bm c) - 1)%Z.
Proof.
  intros.
  elim H.
  apply invariant1_init.
  exact invariant1_inductive.
Qed.

End INVARIANT1.


From stdpp Require Export set.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import auth.
From iris.base_logic Require Import big_op.
From iris.base_logic.lib Require Import fractional.
From iris.program_logic Require Import hoare.
From iris.heap_lang Require Export proofmode lang lifting notation.
From iris.heap_lang.lib Require Export lock.
From iris_hashtable Require Export hashtable_model.
From iris_hashtable Require Import util modulo forloop array hashtable_buckets.

Section hashtable.

  Context Σ Key Hash map `{FinMap Key map , heapG Σ, !Hashable Σ Key Hash, !Array Σ(*, !tableG Σ*)}.
  Variable lck : lock Σ.

  Definition create_table : val :=
    λ: "n", let: "arr" := make_array ("n",#()) in
            (for: "i" := #0 to "n" do "arr".["i"] :=
               (ref NONE, newlock lck #())) ;;
            ("arr", "n").

  Definition index : val :=
    λ: "k" "n", modulo (hashf "k", "n").

  Definition table_insert : val :=
    λ: "t" "k" "x", let: "arr" := Fst "t" in
                    let: "n" := Snd "t" in
                    let: "bl" := "arr".[index "k" "n"] in
                    let: "b" := Fst "bl" in
                    let: "l" := Snd "bl" in
                    acquire lck "l" ;;
                    "b" <- SOME ("k", "x", !"b") ;;
                    release lck "l".

  Definition table_lookup : val :=
    λ: "t" "k",
      let: "arr" := Fst "t" in
      let: "n" := Snd "t" in
      let: "b" := !(Fst ("arr".[index "k" "n"])) in
      (rec: "go" "b" :=
            match: "b" with
              NONE => NONE
            | SOME "kxb" => let: "k'" := Fst (Fst "kxb") in
                            let: "x" := Snd (Fst "kxb") in
                            let: "b" := Snd "kxb" in
                            if: equalf "k" "k'"
                            then SOME "x"
                            else "go" "b"
            end) "b".

  Definition table_remove : val :=
    λ: "t" "k",
      let: "arr" := Fst "t" in
      let: "n" := Snd "t" in
      let: "bl" := ("arr".[index "k" "n"]) in
      let: "b" := Fst "bl" in
      let: "l" := Snd "bl" in
      acquire lck "l" ;;
      let: "res" :=
         (rec: "go" "b" :=
            match: "b" with
              NONE => NONE
            | SOME "kxb" => let: "k'" := Fst (Fst "kxb") in
                            let: "x" := Snd (Fst "kxb") in
                            let: "b" := Snd "kxb" in
                            if: equalf "k" "k'"
                            then SOME ("x", "b")
                            else match: "go" "b" with
                                   NONE => NONE
                                 | SOME "p" => SOME (Fst "p", SOME ("k'", "x", Snd "p"))
                                 end
            end) !"b" in
      match: "res" with
        NONE => release lck "l" ;; NONE
      | SOME "p" => "b" <- Snd "p" ;;
                    release lck "l" ;;
                    SOME (Fst "p")
      end.

  Definition table_fold : val :=
    λ: "f" "t" "a",
      (rec: "outer" "i" "a" :=
        if: "i" < (Snd "t") then
          let: "b" := !(Fst ((Fst "t").["i"])) in
          let: "a" :=
             (rec: "inner" "b" "a" :=
                match: "b" with
                  NONE => "a"
                | SOME "b"
                  => let: "k" := Fst (Fst "b") in
                     let: "x" := Snd (Fst "b") in
                     let: "b" := Snd "b" in
                     let: "a" := "f" "k" "x" "a" in
                     "inner" "b" "a"
                end) "b" "a" in

          "outer" ("i" + #1) "a"
        else
          "a") #0 "a".

  Implicit Type m : map (list val).
  Local Arguments content {_ _ _ _ _ _ _ _} _ _.
  Local Arguments no_garbage {_ _ _ _ _ _} _.
  Local Arguments have_keys {_ _ _ _ _ _} _.

  Definition is_table N P t :=
   (∃ arr refs locks,
      ⌜t = (arr, #(length refs))%V⌝ ∗
      ⌜length refs > 0⌝ ∗
      ⌜length refs = length locks⌝ ∗
      ([∗ list] i ↦ lr ∈ zip locks refs,
        let '(l, r) := lr in
        ∃ lname, is_lock lck (N.@(S i)) lname l (r ↦{1/2} -)) ∗
      inv (N.@0)
       (array arr (zip_with PairV (LitV ∘ LitLoc <$> refs) locks) ∗
        ∃ m data,
          ⌜table_wf m⌝ ∗
          ⌜content m data⌝ ∗
          ⌜no_garbage data⌝ ∗
          ⌜have_keys data⌝ ∗
          ⌜length data = length refs⌝ ∗
          P m ∗
          [∗ list] rb ∈ zip refs data,
           let '(r, b) := rb in
           r ↦{1/2} bucket b))%I.

  Instance is_locks_persistent N `(lr : (val * B)) P:
    PersistentP
      (let (l, r) := lr in
          ∃ γ, is_lock lck (N.@(S i)) γ l (P l r))%I.
  Proof. destruct lr as [? ?]. typeclasses eauto. Qed.

  Global Instance is_table_persistent N P t : PersistentP (is_table N P t).
  Proof. typeclasses eauto. Qed.

  Lemma create_table_spec N P n : n > 0 -> {{{P ∅}}} create_table #n {{{t, RET t ; is_table N P t}}}.
  Proof.
    iIntros (Hn Φ) "HP HΦ".
    wp_lam. wp_bind (make_array _). iApply wp_wand.
    iApply (make_array_spec _ #()). iIntros (arr) "Harr". wp_lam.

    wp_for (fun i' : Z =>
              ∃ locks refs (i : nat),
                ⌜i' = i⌝ ∗
                ⌜i = length refs⌝ ∗
                ⌜i = length locks⌝ ∗
                array arr (zip_with PairV (LitV ∘ LitLoc <$> refs) locks ++ replicate (n - i) #()) ∗
                [∗ list] i ↦ lr ∈ zip locks refs,
                  (lr.2) ↦{1/2} NONEV ∗
                  ∃ lname, is_lock lck (N.@(S i)) lname (lr.1)
                               ((lr.2) ↦{1/2}-))%I with "[Harr]".
    - iExists [], [], 0. rewrite big_sepL_nil -minus_n_O /=. by iFrame.
    - iIntros (i') "% HInv".
      iDestruct "HInv" as (locks refs i) "[% [% [% [Harr Hlr]]]]".
      simplify_eq. wp_alloc r as "Hr".
      iDestruct (fractional_half_1 with "Hr") as "[Hr1 Hr2]".
      wp_apply (newlock_spec _ _ (N.@(S (length refs))) with "[Hr1]") ; last first.
      iIntros (lk lname) "Hlk".
      wp_apply (array_store_spec _ _ (#r, lk) with "[Harr]") ; [|done|].
      rewrite app_length replicate_length zip_with_length fmap_length. lia.
      iIntros "Harr". iExists (locks ++ [lk]), (refs ++ [r]), (S (length refs)).
      do 2 rewrite app_length. simpl.
      do 3 (iSplit ; first (iPureIntro ; lia)).
      iSplitL "Harr". rewrite fmap_app zip_with_app ; last by rewrite fmap_length.
      rewrite {1}(plus_n_O (length refs))
        -{1}(fmap_length (LitV ∘ LitLoc) refs)
        -(zip_with_length_l_eq PairV (LitV ∘ LitLoc <$> refs) locks) ; last by rewrite fmap_length.
      rewrite insert_app_r.
      rewrite (_:n = S (pred n)) ; last lia.
      rewrite -minus_Sn_m ; last lia.
      rewrite replicate_S /= cons_middle app_assoc. iFrame.
      rewrite zip_with_app ; last done.
      iApply big_sepL_app. iFrame.
      rewrite -plus_n_O zip_with_length_r_eq /= //. eauto.
      eauto.
    - iIntros "HInv". iDestruct "HInv" as (locks refs ?) "[% [% [% [Harr Hlrs]]]]".
      iDestruct (big_sepL_sepL with "Hlrs") as "[Hparts #Hlks]".
      simplify_eq. iMod (inv_alloc (N.@0) _  with "[-HΦ]") as "#HInv" ; last first.
      wp_lam. iApply "HΦ". iExists arr, refs, locks.
      repeat (iSplit ; first eauto).
      repeat rewrite big_sepL_zip_with.
      iApply (big_sepL_mono with "Hlks").
      iIntros (i lk ?) "Hlks". iIntros (r ?).
      iDestruct ("Hlks" $! r with "[]") as "$". done.
      iExact "HInv".
      iNext. rewrite -minus_n_n /= app_nil_r.
      iFrame. iExists ∅, (replicate (length refs) []).
      repeat (iSplit ; first eauto using table_wf_empty, content_empty, no_garbage_empty, have_keys_empty, replicate_length).
      iFrame.
      rewrite {2}(zip_with_flip _ refs).
      repeat rewrite big_sepL_zip_with.
      iApply (big_sepL_mono with "Hparts").
      iIntros (i r ?) "Hlrs". iIntros (b Hb).
      apply lookup_replicate in Hb. destruct Hb as [-> ?].
      assert (is_Some (locks !! i)) as [lk ?].
      { apply lookup_lt_is_Some. by rewrite -(_:length refs = length locks). }
      iDestruct ("Hlrs" $! lk with "[]") as "Hlr" ; done.
  Qed.

  Lemma index_spec (k : val) k' (n : nat) :
    as_key k = Some k' ->
    WP index k #n {{v, ⌜ v = #(Hash k' mod n)%nat⌝}}%I.
  Proof.
    intro HKey.
    do 2 wp_lam.
    wp_bind (hashf _).
    iApply (wp_wand).
    iApply (hash_spec _ _ HKey).
    iIntros (h) "%".
    iSimplifyEq.
    iApply (wp_wand).
    iApply (modulo_spec).
    iIntros (f) "%". iPureIntro. simplify_eq.
    by rewrite Z2Nat_inj_mod.
  Qed.

  Lemma table_insert_spec N P Q k k' x t:
    as_key k' = Some k ->
    {{{is_table N P t ∗ ∀ m, P m ={⊤∖↑N}=∗ P (insert_val m k x) ∗ Q }}}
      table_insert t k' x {{{RET #(); Q}}}.
  Proof.
    iIntros (Hkey Φ) "[#HTable HPins] HΦ".
    iDestruct "HTable" as (arr refs locks) "[% [% [% [Hlocks HInv]]]]".
    rename_last Hrefs_locks.
    simplify_eq.
    do 3 wp_lam. wp_proj. wp_lam. wp_proj. wp_lam. wp_bind (index _ _).
    iApply wp_wand. iApply (index_spec _ _ _ Hkey).
    iIntros (?) "%". simplify_eq. wp_bind (array_load _).
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    assert (is_Some (locks !! (Hash k `mod` length refs))) as [lk Hlk].
    { apply lookup_lt_is_Some. rewrite -Hrefs_locks.
      apply mod_bound_pos. lia. done. }
    assert (is_Some (refs !! (Hash k `mod` length refs))) as [r Hr].
    { apply lookup_lt_is_Some. apply mod_bound_pos. lia. done. }
    wp_apply (array_load_spec _ _ (#r, lk) (Hash k `mod` length refs) with "Harr").
    by rewrite lookup_zip_with list_lookup_fmap Hlk Hr.
    iIntros "Harr". iMod ("HClose" with "[Harr Hrest]") as "_"; first (iNext; iFrame).
    iModIntro. wp_lam. wp_proj. wp_lam. wp_proj. wp_lam.
    iDestruct (big_sepL_lookup _ _ _ (lk, r)  with "Hlocks") as (lname) "Hlock".
    by erewrite lookup_zip_with, Hlk, Hr.
    wp_apply (acquire_spec with "Hlock").
    iIntros "[Hlocked Hr1]". iDestruct "Hr1" as (?) "Hr1".
    wp_lam. wp_bind (! _)%E.
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    iDestruct "Hrest" as (m data) "[>% [>% [>% [>% [>% [HP Hrbs]]]]]]".
    rename_last Hdata_refs.
    assert (is_Some (data !! (Hash k `mod` length refs))) as [b Hb].
    { apply lookup_lt_is_Some. rewrite Hdata_refs.
      apply mod_bound_pos. lia. done. }
    iDestruct (big_sepL_lookup_acc _ _ _ (r, b) with "Hrbs") as "[>Hr2 Hrbs]".
    by erewrite lookup_zip_with, Hr, Hb.
    iDestruct (mapsto_agree with "Hr1 Hr2") as "%". simplify_eq.
    wp_load.
    iMod ("HClose" with "[Harr HP Hr2 Hrbs]") as "_".
    iDestruct ("Hrbs" with "Hr2") as "?". iFrame. iExists m, data. iFrame. eauto.
    iModIntro. clear dependent m data. wp_bind (_ <- _)%E.
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    iDestruct "Hrest" as (m data) "[>% [>% [>% [>% [>% [HP Hrbs]]]]]]".
    rename_last Hdata_refs.
    assert (is_Some (data !! (Hash k `mod` length refs))) as [b' Hb'].
    { apply lookup_lt_is_Some. rewrite Hdata_refs.
      apply mod_bound_pos. lia. done. }
    rewrite -{1}(take_drop_middle _ _ _ Hb') -{7}(take_drop_middle _ _ _ Hr).
    repeat rewrite zip_with_app. repeat rewrite zip_with_cons.
    iDestruct (big_sepL_app with "Hrbs") as "[Htake Hdrop]".
    iDestruct (big_sepL_cons with "Hdrop") as "[>Hr2 Hdrop]".
    iDestruct (mapsto_agree with "Hr1 Hr2") as "%". rename_last HbEq. rewrite HbEq.
    iDestruct (fractional_half_2 with "Hr1 Hr2") as "Hr". apply _. wp_store.
    iDestruct ("HPins" with "HP") as "HPins".
    iDestruct (fupd_mask_mono _ (⊤ ∖ ↑N.@0) with "HPins") as ">[HP HQ]". solve_ndisj.
    iDestruct "Hr" as "[Hr1 Hr2]".
    iMod ("HClose" with "[-Hr1 HΦ Hlocked HQ]") as "_".
    {
      iFrame. iExists (insert_val m k x), (insert_data _ _ data k (k', x)). iFrame. iNext.
      iSplit. iPureIntro. by apply table_wf_insert_val.
      iSplit. iPureIntro. eapply content_insert ; try first [done | apply _ | lia].
      iSplit. iPureIntro. by apply no_garbage_insert.
      iSplit. iPureIntro. by apply have_keys_insert.
      iSplit. iPureIntro. by rewrite /insert_data insert_length.
      erewrite <-(take_drop_middle (insert_data _ _ _ _ _)).
      rewrite /insert_data take_insert ; last reflexivity.
      rewrite drop_insert ; last lia.
      rewrite -{12}(take_drop_middle _ _ _ Hr).
      repeat rewrite zip_with_app. repeat rewrite zip_with_cons.
      rewrite big_sepL_app big_sepL_cons Hdata_refs.
      iFrame. rewrite /bucket -/(bucket ((k', x) :: b')). iApply "Hr2".
      rewrite take_length take_length Hdata_refs //.
      rewrite /insert_data /lookup_data Hdata_refs.
      rewrite Hb' /=. apply list_lookup_insert.
      rewrite Hdata_refs.
      apply mod_bound_pos ; [lia|done].
    }
    iModIntro. wp_lam.
    wp_apply (release_spec with "[Hlocked Hr1]"). iFrame "Hlock Hlocked".
    eauto. iIntros. iApply ("HΦ" with "HQ").

    rewrite 2!take_length Hdata_refs //.
  Qed.

  Lemma table_remove_spec N P Q Q' k k' t:
    as_key k' = Some k ->
    {{{is_table N P t ∗
       (∀ m,
         ⌜m !! k = None⌝ -∗ P m ={⊤∖↑N}=∗ P m ∗ Q') ∧
       ∀ m x xs,
         ⌜m !! k = Some (x :: xs)⌝ -∗ P m ={⊤∖↑N}=∗ P (remove_val m k) ∗ Q k x}}}
      table_remove t k'
      {{{v x, RET v; ⌜v = NONEV⌝ ∗ Q' ∨ (⌜v = SOMEV x⌝ ∗ Q k x)}}}.
  Proof.
    iIntros (HKey Φ) "[HTable HQ] HΦ".
    iDestruct "HTable" as (arr refs locks) "[% [% [% [#Hlocks #HInv]]]]".
    rename_last Hrefs_locks. simplify_eq.
    do 2 wp_lam. wp_proj. wp_lam. wp_proj. wp_lam.
    wp_bind (index _ _). iApply wp_wand. iApply index_spec. exact HKey.
    iIntros (?) "%". simplify_eq.
    wp_bind (array_load _).
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    assert (is_Some (locks !! (Hash k `mod` length refs))) as [lk Hlk].
    { apply lookup_lt_is_Some. rewrite -Hrefs_locks.
      apply mod_bound_pos. lia. done. }
    assert (is_Some (refs !! (Hash k `mod` length refs))) as [r Hr].
    { apply lookup_lt_is_Some. apply mod_bound_pos. lia. done. }
    wp_apply (array_load_spec _ _ (#r, lk) (Hash k `mod` length refs) with "Harr").
    by rewrite lookup_zip_with list_lookup_fmap Hlk Hr.
    iIntros "Harr". iMod ("HClose" with "[$Harr $Hrest]") as "_".
    iModIntro. wp_lam. wp_proj. wp_lam. wp_proj. wp_lam.
    iDestruct (big_sepL_lookup _ _ _ (lk, r) with "Hlocks") as (lname) "Hlock".
    erewrite lookup_zip_with, Hlk, Hr. reflexivity.
    wp_apply (acquire_spec with "Hlock").
    iIntros "[Hlocked Hr1]".
    iDestruct "Hr1" as (?) "Hr1". wp_lam. wp_bind (! _)%E.
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    iDestruct "Hrest" as (m data) "[>% [>% [>% [>% [>% [HP Hrbs]]]]]]".
    rename_last Hdata_refs. rename_last HHKeys. rename_last HNG. rename_last Hcontent. rename_last Hwf.
    assert (is_Some (data !! (Hash k `mod` length refs))) as [b Hb].
    { apply lookup_lt_is_Some. rewrite (_:length data = length refs) ; last done.
      apply mod_bound_pos. lia. done. }
    iDestruct (big_sepL_lookup_acc _ _ _ (r, b) with "Hrbs") as "[>Hr2 Hrbs]".
    by erewrite lookup_zip_with, Hr, Hb.
    iDestruct (mapsto_agree with "Hr1 Hr2") as "%". simplify_eq.
    wp_load.

    iAssert (WP (rec: "go" "b"
                 := match: "b" with
                      InjL <> => InjL #()
                    | InjR "kxb" =>
                      let: "k'" := Fst (Fst "kxb") in
                      let: "x" := Snd (Fst "kxb") in
                      let: "b" := Snd "kxb" in
                      if: (equalf k') "k'" then InjR ("x", "b")
                      else match: "go" "b" with
                             InjL <> => InjL #()
                           | InjR "p" =>
                             InjR (Fst "p", InjR ("k'", "x", Snd "p"))
                           end
                    end) (bucket b)
                {{v,  ⌜(v = NONEV /\ bucket_filter _ _ Hash k b = []) ∨
                       (∃ k'' x b' b'',
                           bucket_filter _ _ Hash k b = (k'', x)::b'' /\
                           v = SOMEV (x, bucket b') /\
                           b' = bucket_remove _ _ Hash k b)⌝}})%I as "Hloop".
    { assert (Hsuff: b = [] ++ b) by done.
      assert (Hpref: [] = bucket_filter _ _ Hash k []) by done.
      revert Hsuff Hpref. generalize b at 2 3 4 5 6. generalize ([] : bucket_data) at 1 3.
      intros b'' b' Hsuff Hpref. iRevert (b'' Hsuff Hpref).
      iInduction b' as [|[k'' x] b'] "IH".
      - iIntros. wp_rec. wp_match. iFrame. by iLeft.
      - iIntros (b'') "% %". rename_last Hpref. simplify_eq. simpl.
        pose proof (proj1 (Forall_lookup _ _) HHKeys _ _ Hb) as HKeysb.
        rewrite ->Forall_app, Forall_cons in HKeysb.
        destruct HKeysb as [? [[k''' Hkey'] ?]].
        wp_rec. wp_match. wp_proj. wp_proj. wp_lam. do 2 wp_proj. wp_lam. wp_proj. wp_lam.
        wp_bind (equalf _ _). iApply wp_wand. by iApply equal_spec.
        iIntros (?) "%". simplify_eq.
        case_bool_decide.
        + simplify_eq. wp_if. iPureIntro. right.
          exists k'', x, b'.
          rewrite /bucket_filter /filter /= decide_True ; last done.
          rewrite decide_True ; eauto.
        + assert (as_key k'' ≠ Some k).
          rewrite Hkey'. injection. intros <-. contradiction.
          wp_if. wp_bind ((rec: _ _ := _) _)%E. iApply (wp_wand with "[-]").
          iApply ("IH" $! (b'' ++ [(k'', x)])).
          iPureIntro. by rewrite -app_assoc.
          iPureIntro. unfold bucket_filter in *. rewrite filter_app -Hpref /=.
          by rewrite /filter /= decide_False.
          iIntros (?) "%". rename_last HInv.
          decompose [and or ex] HInv.
          * simplify_eq. wp_match. rewrite /bucket_filter /filter /= decide_False ; eauto.
          * simplify_eq/=. wp_match. do 2 wp_proj. iFrame. iRight. iPureIntro.
            eexists _ , _ , ((_,_)::_).
            rewrite /bucket_filter /filter /= decide_False ; last done.
            rewrite decide_False ; eauto.
    }
    assert (HlookupData: lookup_data _ Hash data k = b) by by rewrite /lookup_data Hdata_refs Hb.

    case_eq (m !! k) ; [intros [|x ?] Hx | intros HNone] ;
      [destruct (Hwf _ _ Hx) as [? [? ?]] ; discriminate |..] ;
      last (iDestruct "HQ" as "[HQ' _]" ; iDestruct ("HQ'" with "[%] HP") as "HQ'" ; try done ;
            iDestruct (fupd_mask_mono _ (⊤ ∖ ↑N.@0) with "HQ'") as ">[HP HQ']" ; try solve_ndisj).
    all: iMod ("HClose" with "[Harr HP Hr2 Hrbs]") as "_" ;
      try (iDestruct ("Hrbs" with "Hr2") as "?" ; iFrame ; iExists m, data ; iFrame ; eauto).
    all: iModIntro ; wp_bind ((rec: _ _ := _) (bucket _))%E ; iApply (wp_wand with "Hloop") ;
      iIntros (?) "%" ; rename_last HInv ;
      destruct HInv as [[-> Hfilt] | [x' [k'' [? [? [Hfilt [-> ->]]]]]]].

    all: destruct Hcontent as [Hin Hnin] ; try specialize (Hin _ _ Hx) ; try specialize (Hnin _ HNone).
    all: try rewrite Hin HlookupData Hfilt /= in Hx ; try destruct (Hwf _ _ Hx) as [? [? ?]].
    all: try by rewrite -HlookupData -Hnin in Hfilt.
    - wp_lam. wp_match. wp_proj. wp_bind (_ <- _)%E.
      iInv (N.@0) as "[Harr Hrest]" "HClose". clear dependent m data.
      iDestruct "Hrest" as (m data) "[>% [>% [>% [>% [>% [HP Hrbs]]]]]]".
      rename_last Hdata_refs. rename_last HHKeys. rename_last HNG. rename_last Hcontent.
      assert (is_Some (data !! (Hash k `mod` length refs))) as [b' Hb'].
      { apply lookup_lt_is_Some. rewrite Hdata_refs.
        apply mod_bound_pos. lia. done. }
      rewrite -{1}(take_drop_middle _ _ _ Hb') -{7}(take_drop_middle _ _ _ Hr).
      repeat rewrite zip_with_app. repeat rewrite zip_with_cons.
      iDestruct (big_sepL_app with "Hrbs") as "[Htake Hdrop]".
      iDestruct (big_sepL_cons with "Hdrop") as "[>Hr2 Hdrop]".
      iDestruct (mapsto_agree with "Hr2 Hr1") as "%".
      rename_last HbEq. apply (inj bucket) in HbEq. simplify_eq.
      iDestruct (fractional_half_2 with "Hr1 Hr2") as "Hr". apply _. wp_store.
      iDestruct "Hr" as "[Hr1 Hr2]".
      iDestruct "HQ" as "[_ HQ]". iDestruct ("HQ" with "[%] HP") as "HQ".
      { assert (HlookupData: lookup_data _ Hash data k = b).
        rewrite /lookup_data Hdata_refs Hb' //.
        destruct Hcontent as [Hin Hnin]. case_eq (m !! k).
        - intros ? Hlookup. rewrite (Hin _ _ Hlookup) HlookupData Hfilt //.
        - intros Hn. rewrite -HlookupData -(Hnin _ Hn) // in Hfilt.
      }
      iDestruct (fupd_mask_mono _ (⊤ ∖ ↑N.@0) with "HQ") as ">[HP HQ]". solve_ndisj.
      iMod ("HClose" with "[-Hr1 HΦ Hlocked HQ]") as "_".
      {
        iFrame. iNext.
        iExists (remove_val m k),
        (<[Hash k mod length data := bucket_remove _ _ _ k (lookup_data _ _ data k)]>data).
        iSplit. iPureIntro. by apply table_wf_remove_val.
        iSplit. iPureIntro. eapply content_remove ; try first [done | apply _ | lia].
        iSplit. iPureIntro. by apply no_garbage_remove.
        iSplit. iPureIntro. by apply have_keys_remove.
        iSplit. iPureIntro. by rewrite /insert_data insert_length.
        erewrite <-(take_drop_middle (<[_ := _]> _)).
        rewrite /insert_data take_insert ; last reflexivity.
        rewrite drop_insert ; last lia.
        rewrite -{12}(take_drop_middle _ _ _ Hr).
        repeat rewrite zip_with_app. repeat rewrite zip_with_cons.
        rewrite big_sepL_app big_sepL_cons Hdata_refs.
        iFrame.
        rewrite 2!take_length Hdata_refs //.
        rewrite /insert_data /lookup_data Hdata_refs.
        rewrite Hb' /= list_lookup_insert. done.
        rewrite Hdata_refs. apply mod_bound_pos ; [lia|done].
      }
      iModIntro. wp_lam.
      wp_apply (release_spec with "[Hlocked Hr1]"). iFrame "Hlock Hlocked". eauto.
      iIntros "_". wp_lam. wp_proj. iApply "HΦ". eauto.
      rewrite 2!take_length Hdata_refs //.
    - wp_lam. wp_match. wp_apply (release_spec with "[$Hlock $Hlocked Hr1]").
      eauto. iIntros "_". wp_lam. iApply "HΦ". iLeft. eauto.
      Unshelve. exact #().
  Qed.

  Lemma table_lookup_spec N P Q Q' k k' t:
    as_key k' = Some k ->
    {{{is_table N P t ∗
       (∀ m,
          ⌜m !! k = None⌝ -∗ P m ={⊤∖↑N}=∗ P m ∗ Q') ∧
       ∀ m x xs,
         ⌜m !! k = Some (x :: xs)⌝ -∗ P m ={⊤∖↑N}=∗ P m ∗ Q k x}}}
      table_lookup t k'
      {{{v x, RET v; ⌜v = NONEV⌝ ∗ Q' ∨ (⌜v = SOMEV x⌝ ∗ Q k x)}}}.
  Proof.
    iIntros (HKey Φ) "[HTable HQ] HΦ".
    iDestruct "HTable" as (arr refs locks) "[% [% [% [_ #Inv]]]]".
    rename_last Hrefs_locks. simplify_eq.
    do 2 wp_lam. wp_proj. wp_lam. wp_proj. wp_lam.
    wp_bind (index _ _). iApply wp_wand. iApply index_spec. exact HKey.
    iIntros (?) "%". simplify_eq.
    wp_bind (array_load _).
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    assert (is_Some (locks !! (Hash k `mod` length refs))) as [lk Hlk].
    { apply lookup_lt_is_Some. rewrite -Hrefs_locks.
      apply mod_bound_pos. lia. done. }
    assert (is_Some (refs !! (Hash k `mod` length refs))) as [r Hr].
    { apply lookup_lt_is_Some. apply mod_bound_pos. lia. done. }
    wp_apply (array_load_spec _ _ (#r, lk) (Hash k `mod` length refs) with "Harr").
    by rewrite lookup_zip_with list_lookup_fmap Hlk Hr.
    iIntros "Harr". iMod ("HClose" with "[$Harr $Hrest]") as "_".
    iModIntro. wp_proj. wp_bind (! _)%E.
    iInv (N.@0) as "[Harr Hrest]" "HClose".
    iDestruct "Hrest" as (m data) "[>% [>% [>% [>% [>% [HP Hrbs]]]]]]".
    rename_last Hdata_refs. rename_last HHKeys. rename_last HNG. rename_last Hcontent. rename_last Hwf.
    assert (is_Some (data !! (Hash k `mod` length refs))) as [b Hb].
    { apply lookup_lt_is_Some. rewrite (_:length data = length refs) ; last done.
      apply mod_bound_pos. lia. done. }
    iDestruct (big_sepL_lookup_acc _ _ _ (r, b) with "Hrbs") as "[Hr1 Hrbs]".
    by erewrite lookup_zip_with, Hr, Hb.
    wp_load.

    iAssert
      (WP (rec: "go" "b"
           := match: "b" with
                InjL <> => InjL #()
              | InjR "kxb" =>
                let: "k'" := Fst (Fst "kxb") in
                let: "x" := Snd (Fst "kxb") in
                let: "b" := Snd "kxb" in
                if: (equalf k') "k'"
                then InjR "x"
                else "go" "b" end)
          (bucket b)
          {{ v, ⌜v = InjLV #() ∧ bucket_filter Σ Key Hash k b = [] ∨
                (∃ (x k'' : val) b',
                    v = InjRV x ∧
                    bucket_filter Σ Key Hash k b = (k'', x)::b')⌝ }})%I as "Hloop".
    {
      assert (Hsuff: b = [] ++ b) by done.
      assert (Hpref: [] = bucket_filter _ _ Hash k []) by done.
      revert Hsuff Hpref. generalize b at 2 3 4 5. generalize ([] : bucket_data) at 1 3.
      intros b'' b' Hsuff Hpref. iRevert (b'' Hsuff Hpref).
      iInduction b' as [|[k'' x] b'] "IH".
      - iIntros. wp_rec. wp_match. by iLeft.
      - iIntros (b'') "% %".
        rename_last Hpref. simplify_eq.
        pose proof (proj1 (Forall_lookup _ _) HHKeys _ _ Hb) as HKeysb.
        rewrite ->Forall_app, Forall_cons in HKeysb.
        destruct HKeysb as [? [[k''' Hkey'] ?]].
        wp_rec. wp_match. repeat first [wp_proj | wp_lam].
        wp_bind (equalf _ _). iApply wp_wand. by iApply equal_spec.
        iIntros (?) "%". simplify_eq.
        case_bool_decide.
        + simplify_eq.
          wp_if. iPureIntro. right.
          exists x, k''.
          rewrite /bucket_filter /filter /= decide_True ; eauto.
        + wp_if.
          assert (as_key k'' ≠ Some k).
          rewrite Hkey'. injection. intros <-. contradiction.
          iApply (wp_wand with "[-]"). iApply ("IH" $! (b'' ++ [(k'', x)])).
          iPureIntro. by rewrite -app_assoc.
          iPureIntro. unfold bucket_filter in *. rewrite filter_app -Hpref /=.
          by rewrite /filter /= decide_False.
          iIntros (?) "%". rename_last HInv.
          decompose [and or ex] HInv.
          * simplify_eq. rewrite /bucket_filter /filter /= decide_False ; eauto.
          * simplify_eq. iPureIntro. right.
            eexists _ , _ .
            rewrite /bucket_filter /filter /= decide_False ; eauto.
    }
    assert (HlookupData: lookup_data _ Hash data k = b).
    by rewrite /lookup_data Hdata_refs Hb.

    case_eq (m !! k) ; [intros [|x ?] Hx | intros HNone] ;
      [destruct (Hwf _ _ Hx) as [? [? ?]] ; discriminate |..] ;
      [ iDestruct "HQ" as "[_ HQ]" | iDestruct "HQ" as "[HQ _]"] ;
      iDestruct ("HQ" with "[%] HP") as "HQ" ; try done ;
      iDestruct (fupd_mask_mono _ (⊤ ∖ ↑N.@0) with "HQ") as ">[HP HQ]" ; try solve_ndisj.
    all: iMod ("HClose" with "[Harr HP Hr1 Hrbs]") as "_" ;
      try (iDestruct ("Hrbs" with "Hr1") as "?" ; iFrame ; iExists m, data ; iFrame ; eauto).
    all: iModIntro ; wp_lam ; iApply (wp_wand with "Hloop") ;
      iIntros (?) "%" ; rename_last HInv ;
      destruct HInv as [[-> Hfilt] | [x' [k'' [? [-> Hfilt]]]]] ; iApply "HΦ".

    all: destruct Hcontent as [Hin Hnin] ;
      first [specialize (Hin _ _ Hx) ; clear Hnin | specialize (Hnin _ HNone)].
    all: try rewrite Hin HlookupData Hfilt /= in Hx ; try by destruct (Hwf _ _ Hx) as [? [? ?]].
    all: try rewrite -HlookupData -Hnin // in Hfilt.
    - rewrite HlookupData Hfilt in Hin. injection Hin as ->. eauto.
    - eauto.
    Unshelve. all: exact #().
  Qed.

End hashtable.


Require Import Coq.Lists.List.
From MetaCoq.Lob.Template Require Export QuoteGround.Coq.Init.
Import ListNotations.

Local Notation iffT A B := (prod (A -> B) (B -> A)).
Lemma iff_forall_eq_some {A v P} : iffT match v return Type with Some v => P v | None => True end (forall a : A, v = Some a -> P a).
Proof.
  split; destruct v; auto; intros ??; inversion 1; subst; assumption.
Defined.
Lemma iff_forall_neq_nil {A} {v : list A} {P} : iffT match v return Type with nil => True | _ => P end (v <> nil -> P).
Proof.
  split; destruct v; intuition congruence.
Defined.
#[export] Instance quote_forall_eq_some {A v P} {q : ground_quotable (match v return Type with Some v => P v | None => True end)} {qv : quotation_of v} {qA : quotation_of A} {qP : quotation_of P} : ground_quotable (forall a : A, v = Some a -> P a)
  := ground_quotable_of_iffT iff_forall_eq_some.
#[export] Instance quote_forall_neq_nil {A v P} {q : ground_quotable (match v return Type with nil => True | _ => P end)} {qv : quotation_of v} {qA : quotation_of A} {qP : quotation_of P} : ground_quotable (v <> @nil A -> P)
  := ground_quotable_of_iffT iff_forall_neq_nil.
#[export] Instance quote_is_true_or_l {b} {P : Prop} {qP : quotation_of P} {quoteP : ground_quotable P} : ground_quotable (is_true b \/ P).
Proof.
  apply quote_or_dec_l; try exact _; cbv [is_true]; decide equality.
Defined.
#[export] Instance quote_is_true_or_r {b} {P : Prop} {qP : quotation_of P} {quoteP : ground_quotable P} : ground_quotable (P \/ is_true b).
Proof.
  apply quote_or_dec_r; try exact _; cbv [is_true]; decide equality.
Defined.

#[export] Hint Cut [ ( _ *) quote_forall_eq_some ( _ * ) quote_forall_eq_some ] : typeclass_instances.
#[export] Hint Cut [ ( _ *) quote_forall_neq_nil ( _ * ) quote_forall_neq_nil ] : typeclass_instances.


Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import AbsAccessor.Spec.
Require Import RealmTimerHandler.Spec.
Require Import RealmSyncHandlerAux.Specs.handle_timer_sysreg_trap.
Require Import RealmSyncHandlerAux.LowSpecs.handle_timer_sysreg_trap.
Require Import RealmSyncHandlerAux.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       ESR_EL2_SYSREG_IS_WRITE_spec
       sysreg_write_spec
       sysreg_read_spec
    .

  Lemma handle_sysreg_access_trap_spec_exists:
    forall habd habd'  labd rec esr
      (Hspec: handle_timer_sysreg_trap_spec rec esr habd = Some habd')
      (Hrel: relate_RData habd labd),
    exists labd', handle_timer_sysreg_trap_spec0 rec esr labd = Some labd' /\ relate_RData habd' labd'.
  Proof.
    Local Opaque
          handle_vtimer_sysreg_write_spec
          handle_ptimer_sysreg_write_spec
          handle_vtimer_sysreg_read_spec
          handle_ptimer_sysreg_read_spec.
    intros. destruct Hrel. destruct rec.
    unfold handle_timer_sysreg_trap_spec, handle_timer_sysreg_trap_spec0 in *.
    repeat autounfold in *. simpl in *.
    hsimpl_hyp Hspec; inv Hspec; simpl_query_oracle; extract_prop_dec;
      repeat (repeat destruct_con; repeat destruct_dis); simpl in *; srewrite; repeat simpl_update_reg;
        repeat (simpl_htarget; grewrite; simpl in *; try solve_bool_range);
        try solve[eexists; split; [reflexivity|constructor; reflexivity]].
  Qed.

End Refine.


Require Import Events.
Require Import Values.
Require Import AST.
Require Import Memory.
Require Import Globalenvs.
Require Import Smallstep.
Require Import CoqlibC.
Require Import Skeleton.
Require Import ModSem.
Require Import SimSymb.
Require Import Integers.
Require Import ASTC.
Require Import Maps.
Require Import LinkingC.

Require Import Syntax Sem Mod ModSem.
Require Import SimMem SimModSem SimMod.
Require Import Sound SemProps.

Set Implicit Arguments.

Module ProgPair.
Section PROGPAIR.
Context `{SM: SimMem.class} {SS: SimSymb.class SM} {SU: Sound.class}.

  Definition t := list ModPair.t.

  Definition sim (pp: t) := List.Forall ModPair.sim pp.

  Definition src (pp: t): program := List.map ModPair.src pp.
  Definition tgt (pp: t): program := List.map ModPair.tgt pp.

  (* Definition ss_link (pp: t): option SimSymb.t := link_list (List.map ModPair.ss pp). *)
  (* ############ TODO: *)
  (* ModPair.wf mp0 /\ ModPair.wf mp1 /\ link mp0.(src) mp1.(src) = Some /\ link mp1.(tgt) mp1.(tgt) = Some *)
  (* =================> link mp0.(ss) mp1.(ss) suceeds. *)
  (* Move ModPair.wf into SimSymb and obligate its proof? *)

End PROGPAIR.
End ProgPair.

Hint Unfold ProgPair.sim ProgPair.src ProgPair.tgt.
(* Hint Unfold ProgPair.ss_link. *)

Section SIM.
Context `{SM: SimMem.class} {SS: SimSymb.class SM} {SU: Sound.class}.

  Variable pp: ProgPair.t.
  Hypothesis SIMPROG: ProgPair.sim pp.
  Let p_src := (ProgPair.src pp).
  Let p_tgt := (ProgPair.tgt pp).

  Theorem sim_link_sk
          sk_link_src
          (LOADSRC: (link_sk p_src) = Some sk_link_src)
          (WF: forall md, In md p_src -> <<WF: Sk.wf md>>):
      exists ss_link sk_link_tgt,
        <<LOADTGT: (link_sk p_tgt) = Some sk_link_tgt>>
        /\ <<SIMSK: SimSymb.wf ss_link>>
        /\ <<SKSRC: ss_link.(SimSymb.src) = sk_link_src>>
        /\ <<SKTGT: ss_link.(SimSymb.tgt) = sk_link_tgt>>
        /\ <<LE: Forall (fun mp => (SimSymb.le mp.(ModPair.ss) ss_link)) pp>>.
  Proof.
    u. subst_locals. ginduction pp; ii; ss. destruct a; ss.
    unfold ProgPair.src in *. unfold link_sk in *. ss. destruct (classic (t = [])).
    { clarify; ss. cbn in *. clarify. clear IHt. inv SIMPROG. inv H2. inv H1. ss.
      esplits; eauto. econs; eauto. ss. refl.
    }
    rename H into NNIL. eapply link_list_cons_inv in LOADSRC; cycle 1.
    { destruct t; ss. }
    des. rename sk_link_src into sk_link_link_src. rename restl into sk_link_src.
    inv SIMPROG. exploit IHt; eauto. intro IH; des.
    inv H1. ss. exploit (SimSymb.wf_link).
    3: { rewrite SKSRC. eapply HD. }
    all: eauto.
    { rewrite SKSRC. eapply WF; et. }
    { eapply link_list_preserves_wf_sk; eauto. }
    { eapply SimSymb.wf_preserves_wf; et. rewrite SKSRC. eapply WF; et. }
    { eapply SimSymb.wf_preserves_wf; et. eapply link_list_preserves_wf_sk; eauto. }
    i; des. esplits; eauto.
    - eapply link_list_cons; eauto.
      rewrite SKTGT in LINKTGT. ss.
    - econs; eauto. rewrite Forall_forall in *. ii.
      all ltac:(fun H => apply link_list_linkorder in H). des.
      rewrite Forall_forall in *. etrans; eauto.
  Qed.

End SIM.