Require Import sflib.

Require Import Axioms.
Require Import Basic.
Require Import DataStructure.
Require Import DenseOrder.
Require Import Loc.

Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import MemoryFacts.
Require Import MemoryProps.

Set Implicit Arguments.

Inductive split_reserve
          (promises1 mem1:Memory.t)
          (loc:Loc.t) (from to:Time.t) (msg:Message.t)
          (promises2 mem2:Memory.t): forall (kind:Memory.op_kind), Prop :=
| split_reserve_intro
    ts3
    (PROMISES: Memory.split promises1 loc from to ts3 msg Message.reserve promises2)
    (MEM: Memory.split mem1 loc from to ts3 msg Message.reserve mem2)
    (TS: Memory.message_to msg loc to)
    (RESERVE: exists val' released', msg = Message.concrete val' released'):
    split_reserve promises1 mem1 loc from to msg promises2 mem2 (Memory.op_kind_split ts3 Message.reserve)
.
Hint Constructors split_reserve.

Lemma split_reserve_write prom0 mem0 loc from to val released prom1 mem1 ts3 prom2
      (SEMI: split_reserve prom0 mem0 loc from to (Message.concrete val released) prom1 mem1 (Memory.op_kind_split ts3 Message.reserve))
      (REMOVE: Memory.remove prom1 loc from to (Message.concrete val released) prom2)
      (MLE: Memory.le prom0 mem0)
  :
    exists prom_mid0 mem_mid0 mem_mid1,
      (<<REMOVE: Memory.promise prom0 mem0 loc from ts3 Message.reserve prom_mid0 mem_mid0 Memory.op_kind_cancel>>) /\
      (<<ADDMESSAGE: Memory.write prom_mid0 mem_mid0 loc from to val released prom_mid0 mem_mid1 Memory.op_kind_add>>) /\
      (<<ADDRESERVE: Memory.promise prom_mid0 mem_mid1 loc to ts3 Message.reserve prom2 mem1 Memory.op_kind_add>>).
Proof.
Admitted.
  (* inv SEMI. des. clarify.
  hexploit split_succeed_wf; try apply PROMISES. i. des.
  exploit Memory.split_get0; [eapply PROMISES|]. intros. des.
  exploit (@Memory.remove_exists prom0 loc from ts3 Message.reserve); eauto.
  intros [prom_mid0 PROMREMOVE].
  exploit (@Memory.remove_exists_le prom0 mem0 loc from ts3 Message.reserve); eauto.
  intros [mem_mid0 MEMREMOVE].
  assert (PROMISE0: Memory.promise prom0 mem0 loc from ts3 Message.reserve prom_mid0 mem_mid0 Memory.op_kind_cancel).
  { econs; eauto. }
  hexploit promise_memory_le; try apply PROMISE0; eauto. intros MLEMID0.
  exploit (@Memory.add_exists mem_mid0 loc from to (Message.concrete val' released')); eauto.
  { ii. erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply x1; eauto. inv LHS. econs; eauto.
      ss. etrans; eauto. left. auto. }
  }
  intros [mem_mid1 MEMADDMESSAGE].
  exploit (@Memory.add_exists_le prom_mid0 mem_mid0 loc from to (Message.concrete val' released')); eauto.
  intros [prom_mid1 PROMADDMESSAGE].
  exploit (@Memory.remove_exists prom_mid1 loc from to (Message.concrete val' released')).
  { eapply Memory.add_get0; eauto. }
  intros [prom_mid2 PROMFULFILL].
  assert (prom_mid2 = prom_mid0).
  { eapply MemoryFacts.add_remove_eq; eauto. } subst.
  assert (WRTIE0: Memory.write prom_mid0 mem_mid0 loc from to val' released' prom_mid0 mem_mid1 Memory.op_kind_add).
  { econs; eauto. econs; eauto. i.
    erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply memory_get_ts_strong in GET4. des.
      { subst. exfalso. eapply Time.lt_strorder.
        eapply TimeFacts.lt_le_lt; try apply TS12. eapply Time.bot_spec. }
      eapply x0.
      { instantiate (1:=Time.meet to' ts3). unfold Time.meet. des_ifs.
        { econs; ss. refl. }
        { econs; ss. left. auto. }
      }
      { unfold Time.meet. des_ifs.
        { econs; ss. transitivity to; eauto. }
        { econs; ss.
          { transitivity to; eauto. }
          { refl. }
        }
      }
    }
  }
  hexploit write_memory_le; try apply WRITE0; eauto. intros MLEMID1.
  exploit (@Memory.add_exists mem_mid1 loc to ts3 Message.reserve); eauto.
  { ii. erewrite Memory.add_o in GET4; eauto. des_ifs.
    { ss. des; clarify. inv LHS. inv RHS. ss. timetac. }
    guardH o. erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o0.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply x1; eauto. inv LHS. econs; eauto. }
  }
  { econs. }
  intros [mem_mid2 MEMADDRESERVE].
  exploit (@Memory.add_exists_le prom_mid0 mem_mid1 loc to ts3 Message.reserve); eauto.
  intros [prom_mid2 PROMADDRESERVE].
  assert (PROMEQ: prom_mid2 = prom2).
  { eapply Memory.ext. intros.
    erewrite (@Memory.add_o prom_mid2 prom_mid0); eauto.
    erewrite (@Memory.remove_o prom_mid0 prom0); eauto.
    erewrite (@Memory.remove_o prom2 prom1); eauto.
    erewrite (@Memory.split_o prom1 prom0); eauto. des_ifs.
    { ss. des; clarify. }
    { ss. des; clarify. }
  }
  assert (MEMEQ: mem_mid2 = mem1).
  { eapply Memory.ext. intros.
    erewrite (@Memory.add_o mem_mid2 mem_mid1); eauto.
    erewrite (@Memory.add_o mem_mid1 mem_mid0); eauto.
    erewrite (@Memory.remove_o mem_mid0 mem0); eauto.
    erewrite (@Memory.split_o mem1 mem0); eauto. des_ifs.
    ss. des; clarify.
  }
  subst. esplits; eauto. econs; eauto. ss.
Qed. *)

Lemma split_reserve_promise prom0 mem0 loc from to msg prom1 mem1 ts3
      (SEMI: split_reserve prom0 mem0 loc from to msg prom1 mem1 (Memory.op_kind_split ts3 Message.reserve))
      (MLE: Memory.le prom0 mem0)
  :
    exists prom_mid0 mem_mid0 prom_mid1 mem_mid1,
      (<<REMOVE: Memory.promise prom0 mem0 loc from ts3 Message.reserve prom_mid0 mem_mid0 Memory.op_kind_cancel>>) /\
      (<<ADDMESSAGE: Memory.promise prom_mid0 mem_mid0 loc from to msg prom_mid1 mem_mid1 Memory.op_kind_add>>) /\
      (<<ADDRESERVE: Memory.promise prom_mid1 mem_mid1 loc to ts3 Message.reserve prom1 mem1 Memory.op_kind_add>>) /\
      (<<CLOSEDMSG: Memory.closed_message msg mem1 -> Memory.closed_message msg mem_mid1>>).
Proof.
Admitted.
  (* inv SEMI. des. clarify.
  hexploit split_succeed_wf; try apply PROMISES. i. des.
  exploit Memory.split_get0; [eapply PROMISES|]. intros. des.
  exploit (@Memory.remove_exists prom0 loc from ts3 Message.reserve); eauto.
  intros [prom_mid0 PROMREMOVE].
  exploit (@Memory.remove_exists_le prom0 mem0 loc from ts3 Message.reserve); eauto.
  intros [mem_mid0 MEMREMOVE].
  assert (PROMISE0: Memory.promise prom0 mem0 loc from ts3 Message.reserve prom_mid0 mem_mid0 Memory.op_kind_cancel).
  { econs; eauto. }
  hexploit promise_memory_le; try apply PROMISE0; eauto. intros MLEMID0.
  exploit (@Memory.add_exists mem_mid0 loc from to (Message.concrete val' released')); eauto.
  { ii. erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply x1; eauto. inv LHS. econs; eauto.
      ss. etrans; eauto. left. auto. }
  }
  intros [mem_mid1 MEMADDMESSAGE].
  exploit (@Memory.add_exists_le prom_mid0 mem_mid0 loc from to (Message.concrete val' released')); eauto.
  intros [prom_mid1 PROMADDMESSAGE].
  assert (PROMISE1: Memory.promise prom_mid0 mem_mid0 loc from to (Message.concrete val' released') prom_mid1 mem_mid1 Memory.op_kind_add).
  { econs; eauto. i.
    erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply memory_get_ts_strong in GET4. des.
      { subst. exfalso. eapply Time.lt_strorder.
        eapply TimeFacts.lt_le_lt; try apply TS12. eapply Time.bot_spec. }
      eapply x0.
      { instantiate (1:=Time.meet to' ts3). unfold Time.meet. des_ifs.
        { econs; ss. refl. }
        { econs; ss. left. auto. }
      }
      { unfold Time.meet. des_ifs.
        { econs; ss. transitivity to; eauto. }
        { econs; ss.
          { transitivity to; eauto. }
          { refl. }
        }
      }
    }
  }
  hexploit promise_memory_le; try apply PROMISE1; eauto. intros MLEMID1.
  exploit (@Memory.add_exists mem_mid1 loc to ts3 Message.reserve); eauto.
  { ii. erewrite Memory.add_o in GET4; eauto. des_ifs.
    { ss. des; clarify. inv LHS. inv RHS. ss. timetac. }
    guardH o. erewrite Memory.remove_o in GET4; eauto. des_ifs. guardH o0.
    exploit Memory.get_disjoint.
    { eapply GET4. }
    { eapply Memory.split_get0 in MEM. des. apply GET6. }
    i. des.
    { unguard. ss. des; clarify. }
    { eapply x1; eauto. inv LHS. econs; eauto. }
  }
  { econs. }
  intros [mem_mid2 MEMADDRESERVE].
  exploit (@Memory.add_exists_le prom_mid1 mem_mid1 loc to ts3 Message.reserve); eauto.
  intros [prom_mid2 PROMADDRESERVE].
  assert (PROMEQ: prom_mid2 = prom1).
  { eapply Memory.ext. intros.
    erewrite (@Memory.add_o prom_mid2 prom_mid1); eauto.
    erewrite (@Memory.add_o prom_mid1 prom_mid0); eauto.
    erewrite (@Memory.remove_o prom_mid0 prom0); eauto.
    erewrite (@Memory.split_o prom1 prom0); eauto. des_ifs.
    ss. des; clarify.
  }
  assert (MEMEQ: mem_mid2 = mem1).
  { eapply Memory.ext. intros.
    erewrite (@Memory.add_o mem_mid2 mem_mid1); eauto.
    erewrite (@Memory.add_o mem_mid1 mem_mid0); eauto.
    erewrite (@Memory.remove_o mem_mid0 mem0); eauto.
    erewrite (@Memory.split_o mem1 mem0); eauto. des_ifs.
    ss. des; clarify.
  }
  subst. esplits; eauto.
  { econs; eauto. ss. }
  { i. eapply memory_concrete_le_closed_msg; try apply H. ii.
    erewrite (@Memory.split_o mem1 mem0) in GET4; eauto.
    erewrite (@Memory.add_o mem_mid1 mem_mid0); eauto.
    erewrite (@Memory.remove_o mem_mid0 mem0); eauto. des_ifs.
  }
Qed. *)


Require Import Platform.AutoSep.

Require Import Platform.Malloc Platform.Cito.examples.Cell.

Module Type ADT.
  Parameter cell : W -> W -> HProp.

  Axiom cell_fwd : forall n c, cell n c ===> [| c <> 0 |] * [| freeable c 2 |]
    * Ex junk, c ==*> n, junk.
  Axiom cell_bwd : forall n (c : W), [| c <> 0 |] * [| freeable c 2 |]
    * (Ex junk, c ==*> n, junk) ===> cell n c.
End ADT.

Module Adt : ADT.
  Open Scope Sep_scope.

  Definition cell (n c : W) : HProp :=
    [| c <> 0 |] * [| freeable c 2 |]
    * Ex junk, c ==*> n, junk.

  Theorem cell_fwd : forall n c, cell n c ===> [| c <> 0 |] * [| freeable c 2 |]
    * Ex junk, c ==*> n, junk.
    unfold cell; sepLemma.
  Qed.

  Theorem cell_bwd : forall n (c : W), [| c <> 0 |] * [| freeable c 2 |]
    * (Ex junk, c ==*> n, junk) ===> cell n c.
    unfold cell; sepLemma.
  Qed.
End Adt.

Import Adt.
Export Adt.

Definition hints : TacPackage.
  prepare cell_fwd cell_bwd.
Defined.

Definition newS := newS cell 8.
Definition deleteS := deleteS cell 6.
Definition readS := readS cell 0.
Definition writeS := writeS cell 0.

Definition m := bimport [[ "malloc"!"malloc" @ [mallocS], "malloc"!"free" @ [freeS] ]]
  bmodule "SimpleCell" {{
    bfunction "new"("extra_stack", "x") [newS]
      "x" <-- Call "malloc"!"malloc"(0, 2)
      [PRE[_, R] R =?> 2 * [| R <> 0 |] * [| freeable R 2 |] * mallocHeap 0
       POST[R'] cell 0 R' * mallocHeap 0];;

      "x" *<- 0;;
      Return "x"
    end

    with bfunction "delete"("extra_stack", "self") [deleteS]
      Call "malloc"!"free"(0, "self", 2)
      [PRE[_] Emp
       POST[_] Emp];;

      Return 0
    end

    with bfunction "read"("extra_stack", "self") [readS]
      "self" <-* "self";;
      Return "self"
    end

    with bfunction "write"("extra_stack", "self", "n") [writeS]
      "self" *<- "n";;
      Return 0
    end
  }}.

Local Hint Extern 1 (@eq W _ _) => words.

Theorem ok : moduleOk m.
  vcgen; abstract (sep hints; eauto).
Qed.


Require Import Coq.Strings.String Coq.Strings.Ascii Coq.Lists.List.
Require Import Fiat.Parsers.ContextFreeGrammar.Core.
Require Import Fiat.Common.List.Operations.
Require Import Fiat.Common.Equality.
Require Import Fiat.Common.Gensym.

Global Arguments nat_of_ascii !_ / .
Global Arguments Compare_dec.leb !_ !_ / .
Global Arguments BinPos.Pos.to_nat !_ / .

Delimit Scope item_scope with item.
Bind Scope item_scope with item.
Delimit Scope production_scope with production.
Delimit Scope production_assignment_scope with prod_assignment.
Bind Scope production_scope with production.
Delimit Scope productions_scope with productions.
Delimit Scope productions_assignment_scope with prods_assignment.
Bind Scope productions_scope with productions.
Delimit Scope grammar_scope with grammar.
Bind Scope grammar_scope with grammar.

(** [abstract] doesn't work in definitions *)
Class NoDupR {T} beq (ls : list T) := nodupr : uniquize beq ls = ls.
Hint Extern 5 (NoDupR _ _) => clear; (*abstract*) (vm_compute; reflexivity) : typeclass_instances.

Definition list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T
  := fun nt
     => option_rect
          (fun _ => T)
          snd
          default
          (find (fun k => string_beq nt (fst k)) ls).

Record pregrammar (Char : Type) :=
  {
    pregrammar_productions :> list (string * productions Char);
    pregrammar_nonterminals : list string
    := map fst pregrammar_productions;
    invalid_nonterminal : string
    := gensym pregrammar_nonterminals;
    Lookup_idx : nat -> productions Char
    := fun n => nth n (map snd pregrammar_productions) nil;
    Lookup_string : string -> productions Char
    := list_to_productions nil pregrammar_productions;
    nonterminals_unique
    : NoDupR string_beq pregrammar_nonterminals
  }.

Global Arguments pregrammar_nonterminals / .
Global Arguments Lookup_idx {_} !_ !_  / .
Global Arguments Lookup_string {_} !_ !_ / .

Existing Instance nonterminals_unique.
Arguments nonterminals_unique {_} _.

Coercion grammar_of_pregrammar {Char} (g : pregrammar Char) : grammar Char
  := {| Start_symbol := hd ""%string (pregrammar_nonterminals g);
        Lookup := Lookup_string g;
        Valid_nonterminals := (pregrammar_nonterminals g) |}.

Global Instance valid_nonterminals_unique {Char} {G : pregrammar Char}
: NoDupR string_beq (Valid_nonterminals G)
  := nonterminals_unique _.

Definition list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T
  := {| Start_symbol := hd ""%string (map fst ls);
        Lookup := list_to_productions default ls;
        Valid_nonterminals := map fst ls |}.

Global Arguments list_to_grammar {_} _ _.
Global Arguments nat_of_ascii !_ / .
Global Arguments Compare_dec.leb !_ !_ / .
Global Arguments BinPos.Pos.to_nat !_ / .

(** Variant of [nat_of_ascii] that will extract more cleanly, because
    it doesn't depend on various other constants (only inductives) *)
(** Keep this outside the module so it doesn't get extracted. *)
Definition nat_of_ascii_sig ch : { n : nat | n = nat_of_ascii ch }.
Proof.
  unfold nat_of_ascii.
  unfold N_of_ascii, N_of_digits.
  eexists.
  refine (_ : (let (a0, a1, a2, a3, a4, a5, a6, a7) := ch in _) = _).
  destruct ch as [a0 a1 a2 a3 a4 a5 a6 a7].
  repeat rewrite ?Nnat.N2Nat.inj_add, ?Nnat.N2Nat.inj_mul.
  repeat match goal with
           | [ |- context[BinNat.N.to_nat (if ?b then ?x else ?y)] ]
             => replace (BinNat.N.to_nat (if b then x else y))
                with (if b then BinNat.N.to_nat x else BinNat.N.to_nat y)
               by (destruct b; reflexivity)
         end.
  simpl @BinNat.N.to_nat.
  rewrite Mult.mult_0_r, Plus.plus_0_r.
  reflexivity.
Defined.

Module opt.
  Definition nat_of_ascii ch
    := Eval cbv beta iota zeta delta [proj1_sig nat_of_ascii_sig] in
        proj1_sig (nat_of_ascii_sig ch).
End opt.

Global Arguments opt.nat_of_ascii !_ / .


From iris.algebra Require Import excl auth cmra gmap agree gset numbers.
From iris.algebra.lib Require Import frac_agree.
From iris.heap_lang Require Export notation locations lang.
From iris.base_logic.lib Require Export invariants.
From iris.program_logic Require Export atomic.
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode par.
From iris.bi.lib Require Import fractional.
Set Default Proof Using "All".
Require Export multicopy_lsm multicopy_lsm_util.

Section multicopy_lsm_upsert.
  Context {Σ} `{!heapG Σ, !multicopyG Σ, !multicopy_lsmG Σ}.
  Notation iProp := (iProp Σ).
  Local Notation "m !1 i" := (nzmap_total_lookup i m) (at level 20).

  Lemma upsert_spec N γ_te γ_he γ_s Prot γ_I γ_J γ_f γ_gh r (k: K) (v: V) :
    ⊢ ⌜k ∈ KS⌝ -∗
        (ghost_update_protocol N γ_te γ_he Prot k) -∗
        mcs_inv N γ_te γ_he γ_s Prot
          (Inv_LSM γ_s γ_I γ_J γ_f γ_gh r) -∗
            <<< ∀ t H, MCS γ_te γ_he t H >>>
                   upsert r #k #v @ ⊤ ∖ (↑(mcsN N))
            <<< MCS γ_te γ_he (t + 1) (H ∪ {[(k, (v, t))]}), RET #() >>>.
  Proof.
    iIntros "%". iLöb as "IH".
    rename H into k_in_KS.
    iIntros "Ghost_updP #HInv" (Φ) "AU". wp_lam. wp_pures.
    iApply fupd_wp.
    (** Open invariant to establish root node in footprint **)
    iInv "HInv" as (t0 H0)"(mcs_high & >Inv_LSM)".
    iDestruct "Inv_LSM" as (hγ0 I0 J0)"(Hglob & Hstar)".
    iDestruct "Hglob" as "(HI & Out_I & HR
            & Out_J & Inf_J & Hf & Hγ & #FP_r & domm_IR & domm_Iγ)".
    iModIntro. iSplitR "AU Ghost_updP". iNext.
    iExists t0, H0. iFrame "mcs_high".
    iExists hγ0, I0, J0. iFrame "∗ #". iModIntro.
    (** Lock the node r **)
    awp_apply lockNode_spec_high without "Ghost_updP"; try done.
    iAaccIntro with ""; try eauto with iFrame.
    iIntros (Cr Qr)"HnP_n". iModIntro.
    iIntros "Ghost_updP". wp_pures.
    iDestruct "HnP_n" as (γ_er γ_cr γ_qr γ_cirr es Vr Tr)
                      "(node_r & #HnP_gh & HnP_frac & HnP_C & HnP_cts)".
    wp_apply (addContents_spec with "[$node_r]"); try done.
    iIntros (b Vr')"(node_r & Hif)".
    (** Case analysis on whether addContents is successful **)
    destruct b; last first.
    - (** Case : addContents fails. Unlock root node and apply
                 inductive hypothesis IH **)
      iDestruct "Hif" as %HVr. replace Vr'. wp_pures.
      awp_apply (unlockNode_spec_high
          with "[] [] [HnP_gh HnP_frac HnP_C HnP_cts node_r]")
            without "Ghost_updP" ; try done.
      { iExists γ_er, γ_cr, γ_qr, γ_cirr, es, Vr, Tr.
        iFrame "∗#". }
      iAaccIntro with ""; try eauto with iFrame.
      iIntros "_". iModIntro.
      iIntros "Ghost_updP". wp_pures.
      iApply ("IH" with "Ghost_updP"); try done.
    - (** Case : addContent successful **)
      (** Linearization Point: open invariant and update the resources **)
      wp_pures.

      (* Need to unfold unlockNode here in order to apply
         ghost_udpate_protocol, which requires stripping off
         a later modality. This requires a physical step in heapLang,
         which is available by unfolding the unlockNode *)

      unfold unlockNode.
      wp_pures. wp_bind(getLockLoc _)%E.
      wp_apply getLockLoc_spec; first done.
      iIntros (l) "%"; subst l; wp_pures.

      iInv "HInv" as (t1 H1)"(mcs_high & >Inv_LSM)".
      iDestruct "Inv_LSM" as (hγ1 I1 J1)"(Hglob & Hstar)".
      iDestruct "mcs_high" as "(>MCS_auth & >HH & >HInit & >HClock & >HUniq & Prot)".
      iDestruct "Hglob" as "(HI & Out_I & HR
            & Out_J & Inf_J & Hf & Hγ & _ & domm_IR & domm_Iγ)".
      iDestruct "Hif" as %HVr'.

      set (Tr' := <[k := t1]> Tr).
      set (Cr' := <[k := (v, t1)]> Cr).
      set (H1' := H1 ∪ {[(k, (v, t1))]}).

      iPoseProof ((auth_own_incl γ_s H1 _) with "[$HH $HnP_C]") as "%".
      rename H into Cr_sub_H1. apply gset_included in Cr_sub_H1.
      iDestruct "HClock" as %HClock_H1.
      (** Re-establish maxTS for updated T and H **)
      assert (HClock (t1 + 1) H1') as HClock_H1'.
      { subst H1'. intros k' v' t' H'.
        assert (((k', (v', t')) ∈ H1) ∨ (k' = k ∧ v' = v ∧ t' = t1))
              as Hor by set_solver.
        destruct Hor as [Hor | Hor].
        pose proof HClock_H1 k' v' t' Hor as Hres. lia.
        destruct Hor as [_ [_ Hor]]. replace t'. lia. }
      iAssert (⌜set_of_map Cr' ⊆ H1'⌝)%I as %Cr'_sub_H1'.
      { subst H1'. iPureIntro. subst Cr'.
        pose proof (set_of_map_insert_subseteq Cr k v t1) as H'.
        assert (set_of_map Cr = set_of_map Cr) as H'' by done.
        set_solver. }
      (** Update the (● H) resource **)
      iMod (own_update γ_s (● H1) (● H1')
          with "[$HH]") as "HH".
      { apply (auth_update_auth _ _ H1').
        apply gset_local_update. set_solver. }
      iMod (own_update γ_s (● H1')
             (● H1' ⋅ ◯ (set_of_map Cr'))
              with "[$HH]") as "HH".
      { subst H1'.
        apply (auth_update_alloc _ (H1 ∪ {[(k, (v, t1))]}) (set_of_map Cr')).
        apply local_update_discrete. intros m Valid_H1 H1_eq.
        split; try done. rewrite /(ε ⋅? m) in H1_eq.
        destruct m. rewrite gset_op in H1_eq.
        rewrite left_id in H1_eq *; intros H1_eq.
        rewrite <-H1_eq.
        rewrite /(set_of_map Cr' ⋅? Some (H1 ∪ {[k, (v, t1)]})).
        rewrite gset_op.
        rewrite /(ε) in H1_eq. unfold ucmra_unit in H1_eq.
        simpl in H1_eq.
        assert ((k, (v, t1)) ∈ set_of_map Cr') as H'.
        { subst Cr'. apply set_of_map_member.
          apply lookup_insert. }
        clear - H' Cr_sub_H1 Cr'_sub_H1'. set_solver.
        exfalso. clear -H1_eq. set_solver. }
      (** Re-establish HInit **)
      iAssert (⌜HInit H1'⌝)%I with "[HInit]" as "HInit".
      { subst H1'. iDestruct "HInit" as %HInit.
        unfold multicopy.HInit. iPureIntro.
        clear -HInit k_in_KS. intros k' Hk'.
        pose proof HInit k' Hk' as H'. set_solver. }
      iDestruct "HnP_C" as "_".
      iDestruct "HH" as "(HH & HnP_C)".
      iAssert (⌜r ∈ domm I1⌝)%I as %r_in_I.
      { by iPoseProof (inFP_domm _ _ _ with "[$FP_r] [$Hf]") as "H'". }
      rewrite (big_sepS_delete _ (domm I1) r); last by eauto.
      iDestruct "Hstar" as "(H_r & Hstar')".
      iDestruct "H_r" as (br Cr'' Qr'')"(Hl_r & HnS_r)".
      iPoseProof (nodePred_lockR_true with "[$node_r] [$Hl_r]")
         as "%". subst br.
      iDestruct "HnS_r" as (γ_er' γ_cr' γ_qr' γ_cirr' es' Tr'' Br Ir Jr) "HnS_r'".
      iPoseProof (nodePred_nodeShared_eq with "[$HnP_gh] [$HnP_frac] [$HnS_r']")
           as "(HnP_frac & HnS_r' &%&%&%)". subst es' Tr'' Qr''.
      iDestruct "HnS_r'" as "(HnS_gh & HnS_frac & HnS_si & HnS_FP
                            & HnS_cl & HnS_oc & HnS_Bn & HnS_H & HnS_star & Hφ)".

      (** Update contents-in-reach of r **)
      set (Br' := <[k := t1]>Br).
      assert (Br' = <[k := t1]>Br) as HBr'. try done.
      iEval (rewrite decide_True) in "HnS_H".
      iDestruct "HnS_H" as "(% & %)".
      rename H into Br_eq_H1. rename H2 into Infz_Ir.

      iAssert (⌜contents_in_reach Br' Tr' Qr⌝)%I with "[HnS_Bn]" as "HnS_Bn".
      { iDestruct "HnS_Bn" as %H'. iPureIntro.
        intros k' t' HKS. destruct (decide (k' = k)).
        - subst k'. subst Tr' Br'.
          rewrite !lookup_insert.
          split; try done.
        - subst Tr' Br'.
          rewrite !lookup_insert_ne; try done.
          pose proof H' k' t' HKS; try done. }

      iAssert (⌜∀ k : K, Br' !!! k = (map_of_set H1' !!! k).2⌝)%I as %Br'_eq_H1'.
      { iDestruct "HUniq" as %HUniq.
        iPureIntro. subst Br' H1'. intros k'.
        rewrite <-map_of_set_insert_eq; try done.
        destruct (decide (k' = k)).
        - subst k'. rewrite !lookup_total_insert; by simpl.
        - rewrite !lookup_total_insert_ne; try done. }
      iEval (rewrite (big_sepS_delete (_) (KS) k); last by eauto) in "HnS_star".
      iDestruct "HnS_star" as "(Hk & HnS_star')".
      iAssert (⌜Br !!! k ≤ t1⌝)%I as %Br_le_t1.
      { iPureIntro. rewrite lookup_total_alt.
        destruct (Br !! k) eqn: Hbrk; last first.
        - rewrite Hbrk. simpl; clear; lia.
        - rewrite Hbrk. simpl.
          pose proof Br_eq_H1 k as Br_eq_H1.
          (* rewrite Br_eq_H1 in Hbrk. *)
          pose proof map_of_set_lookup_cases H1 k as H'.
          destruct H' as [H' | [_ H']]; last first.
          + rewrite !lookup_total_alt in Br_eq_H1.
            rewrite H' Hbrk in Br_eq_H1. simpl in Br_eq_H1.
            subst t; clear; lia.
          + destruct H' as [v' [t' [H' [H'' H''']]]].
            rewrite !lookup_total_alt in Br_eq_H1.
            rewrite H''' Hbrk in Br_eq_H1. simpl in Br_eq_H1.
            subst t'.
            pose proof HClock_H1 k v' t H' as H''''.
            clear -H''''; lia. }
      iMod (own_update (γ_cirr !!! k) (● (MaxNat (Br !!! k)))
                (● (MaxNat (Br' !!! k))) with "Hk") as "Hk".
      { apply (auth_update_auth _ _ (MaxNat (Br' !!! k))).
        apply max_nat_local_update.
        simpl. rewrite HBr'.
        by rewrite lookup_total_insert. }
      iAssert ([∗ set] k0 ∈ KS, own (γ_cirr !!! k0)
                  (● {| max_nat_car := Br' !!! k0 |}))%I
          with "[HnS_star' Hk]" as "HnS_star".
      { iEval (rewrite (big_sepS_delete (_) (KS) k); last by eauto).
        iFrame "Hk".
        iApply (big_opS_proper
             (λ y, own (γ_cirr !!! y) (● {| max_nat_car := Br' !!! y |}))
             (λ y, own (γ_cirr !!! y) (● {| max_nat_car := Br !!! y |}))
             (KS ∖ {[k]})).
        intros x Hx. assert (x ≠ k) as H' by set_solver.
        iFrame. iSplit.
        iIntros "H". iEval (rewrite HBr') in "H".
        assert (<[k := t1]> Br !!! x = Br !!! x) as H''.
        { apply lookup_total_insert_ne; try done. }
        by iEval (rewrite H'') in "H".
        iIntros "H". iEval (rewrite HBr').
        assert (<[k:= t1]> Br !!! x = Br !!! x) as H''.
        { apply lookup_total_insert_ne; try done. }
        by iEval (rewrite H'').
        done. }
      iMod ((frac_update γ_er γ_cr γ_qr es Tr Qr es Tr' Qr)
                  with "[$HnP_frac $HnS_frac]") as "(HnP_frac & HnS_frac)".
      iDestruct "Inf_J" as %Inf_J.
      iPoseProof ((auth_own_incl γ_J J1 Jr) with "[HR HnS_si]")
                                    as (Ro) "%".
      { unfold singleton_interfaces_ghost_state.
        iDestruct "HnS_si" as "(_ & H' & _)".
        iFrame. } rename H into Incl_J1.
      iPoseProof (own_valid with "HR") as "%".
      rename H into Valid_J1.
      iAssert (⌜domm Jr = {[r]}⌝)%I as "%".
      { by iDestruct "HnS_si" as "(_&_&_&H')". }
      rename H into Domm_Jr.
      iAssert (⌜φ1 es Qr⌝ ∗ ⌜φ2 r Br' Ir⌝ ∗ ⌜φ3 Br' Qr⌝
                ∗ ⌜φ4 r Br' Jr⌝ ∗ ⌜φ5 r Jr⌝
                ∗ ⌜φ6 r es Jr Qr⌝ ∗ ⌜φ7 r Ir⌝)%I
            with "[Hφ]" as "Hφ".
      { iDestruct "Hφ" as %Hφ.
        destruct Hφ as [Hφ1 [Hφ2 [Hφ3 [Hφ4 [Hφ5 [Hφ6 Hφ7]]]]]].
        iPureIntro. repeat split; try done.
        - intros k' t' HKS Hins.
          pose proof Infz_Ir r as Infz_Ir.
          rewrite Infz_Ir in Hins.
          exfalso. clear -Hins. set_solver.
        - intros k' HKS. subst Br'. destruct (decide (k' = k)).
          + subst k'. rewrite lookup_total_insert.
            apply (Nat.le_trans _ (Br !!! k) _); try done.
            apply Hφ3; try done.
          + rewrite lookup_total_insert_ne; try done.
            apply Hφ3; try done.
        - intros k' HKS. right.
          apply (inset_monotone J1 Jr Ro); try done.
          by rewrite <-auth_auth_valid.
          pose proof Inf_J r k' HKS as Inf_J.
          by rewrite decide_True in Inf_J.
          rewrite Domm_Jr. clear. set_solver. }

      iAssert (⌜HUnique H1'⌝)%I with "[HUniq]" as %HUniq.
      { iDestruct "HUniq" as %HUniq.
        iPureIntro. subst H1'.
        intros k' t' v' v'' H' H''.
        assert (((k', (v', t')) ∈ H1) ∨ (k' = k ∧ v' = v ∧ t' = t1))
              as Hor by set_solver.
        assert (((k', (v'', t')) ∈ H1) ∨ (k' = k ∧ v'' = v ∧ t' = t1))
              as Hor' by set_solver.
        destruct Hor as [Hor | Hor].
        - destruct Hor' as [Hor' | Hor'].
          + apply (HUniq k' t' v' v'' Hor Hor'); try done.
          + destruct Hor' as [? [? ?]]. subst k' v'' t'.
            apply (HClock_H1 k v' t1) in Hor.
            clear -Hor; lia.
        - destruct Hor as [? [? ?]]. subst k' v' t'.
          destruct Hor' as [Hor' | Hor'].
          + apply (HClock_H1 k v'' t1) in Hor'.
            clear -Hor'; lia.
          + destruct Hor' as [? [? ?]]. by subst v''. }

      iAssert (contents_proj Cr' Vr' Tr')%I with "[HnP_cts]" as "HnP_cts".
      { iDestruct "HnP_cts" as "(% & % & %)".
        rename H into dom_Cr_Vr; rename H2 into dom_Cr_Tr;
        rename H3 into Cr_eq_Vr_Tr.
        iPureIntro. subst Cr' Vr' Tr'. split; last split.
        - apply leibniz_equiv. rewrite !dom_insert.
          rewrite dom_Cr_Vr. clear; set_solver.
        - apply leibniz_equiv. rewrite !dom_insert.
          rewrite dom_Cr_Tr. clear; set_solver.
        - intros k' v' t'. destruct (decide (k' = k)).
          + subst k'. rewrite !lookup_insert. split.
            * intros H'; by inversion H'.
            * intros [H' H'']; inversion H'; by inversion H''.
          + rewrite !lookup_insert_ne; try done. }

      iDestruct "Hl_r" as "(Hlockr & _)". wp_store.

      (** Linearization **)
      iMod "AU" as (t' H1'')"[MCS [_ Hclose]]".
      iAssert (⌜t' = t1 ∧ H1'' = H1⌝)%I as "(% & %)".
      { iPoseProof (MCS_agree with "[$MCS_auth] [$MCS]") as "(% & %)".
        by iPureIntro. } subst t' H1''.
      iDestruct "MCS" as "(MCS◯t & MCS◯h & _)".
      iDestruct "MCS_auth" as "(MCS●t & MCS●h)".
      iMod ((auth_excl_update γ_te (t1+1) t1 t1) with "MCS●t MCS◯t")
                                          as "(MCS●t & MCS◯t)".
      iMod ((auth_excl_update γ_he (H1 ∪ {[(k, (v, t1))]}) H1 H1) with "MCS●h MCS◯h")
                                          as "(MCS●h & MCS◯h)".
      iCombine "MCS◯t MCS◯h" as "(MCS_t & MCS_h)".
      iCombine "MCS●t MCS●h" as "MCS_auth".
      iMod ("Hclose" with "[MCS_t MCS_h]") as "HΦ".
      iFrame. by iPureIntro.

      (** Use ghost_update_protocol to update Prot(H) **)
      iSpecialize ("Ghost_updP" $! v t1 H1).

      iMod ("Ghost_updP" with "[] [$MCS_auth] [$Prot]")
                        as "(Prot & MCS_auth)".
      { assert ((k, (v, t1)) ∈ H1') as H' by set_solver.
        assert ((∀ (v' : V) (t' : nat), (k, (v', t')) ∈ H1' → t' ≤ t1))
          as H''.
        { intros v' t' Hvt'. subst H1'.
          rewrite elem_of_union in Hvt'*; intros Hvt'.
          destruct Hvt' as [Hvt' | Hvt'].
          - apply HClock_H1 in Hvt'. clear -Hvt'; lia.
          - assert (t' = t1) by (clear -Hvt'; set_solver).
            subst t'; clear; lia. }
        pose proof map_of_set_lookup H1' k v t1 HUniq H' H'' as H'''.
        iPureIntro. rewrite lookup_total_alt.
        rewrite H'''. by simpl. }

      iModIntro. iFrame "HΦ". iNext.
      iExists (t1+1), (H1 ∪ {[(k, (v, t1))]}).

      iSplitL "MCS_auth Prot HInit HH".
      { iFrame "∗". iPureIntro. done. }
      iExists hγ1, I1, J1. iFrame "∗ %".
      rewrite (big_sepS_delete _ (domm I1) r); last by eauto.
      iSplitR "Hstar'"; last first.
      { iApply (big_sepS_mono
                (λ y, ∃ (bn : bool) (Cn : gmap K (V * T)) (Qn : gmap K T),
                        lockR bn y (nodePred γ_gh γ_s r y Cn Qn)
                      ∗ nodeShared γ_I γ_J γ_f γ_gh r y Qn H1)%I
                (λ y, ∃ (bn : bool) (Cn : gmap K (V * T)) (Qn : gmap K T),
                        lockR bn y (nodePred γ_gh γ_s r y Cn Qn)
                      ∗ nodeShared γ_I γ_J γ_f γ_gh r y Qn (H1 ∪ {[k, (v, t1)]}))%I
                (domm I1 ∖ {[r]})); try done.
      intros y y_dom. assert (y ≠ r) as Hy by set_solver. iFrame.
      iIntros "Hstar". iDestruct "Hstar" as (b C Q)"(Hl & HnS)".
      iExists b, C, Q. iFrame.
      iDestruct "HnS" as (γ_e γ_c γ_q γ_cir esy Ty By Iy Jy)
                  "(HnS_gh & domm_γcir & HnS_frac & HnS_si & HnS_FP
                            & HnS_cl & HnS_oc & HnS_Bn & HnS_H & HnS_star
                            & Hφ0 & Hφ2 & Hφ3 & Hφ4 & Hφ5 & Hφ7)".
      iExists γ_e, γ_c, γ_q, γ_cir, esy, Ty, By, Iy. iExists Jy. iFrame.
      destruct (decide (y = r)); try done. }
      { iExists false, Cr', Qr.
        iSplitL "node_r Hlockr HnP_C HnP_frac HnP_cts".
        iFrame. iExists γ_er, γ_cr, γ_qr, γ_cirr, es, Vr', Tr'. iFrame "∗#".
        iExists γ_er, γ_cr, γ_qr, γ_cirr, es, Tr', Br', Ir. iExists Jr.
        iFrame "∗#". iEval (rewrite decide_True).
        iFrame "%∗". }
  Qed.

End multicopy_lsm_upsert.