(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*              Layers of VMM: MPTOP                                   *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)

(** This file defines the abstract data and the primitives for the MPTOp layer, which will introduce high-level primitives to operate on page table*)
Require Import Coqlib.
Require Import Maps.
Require Import ASTExtra.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Events.
Require Import Stacklayout.
Require Import Globalenvs.
Require Import AsmX.
Require Import Smallstep.
Require Import AuxStateDataType.
Require Import Constant.
Require Import GlobIdent.
Require Import FlatMemory.
Require Import CommonTactic.
Require Import AuxLemma.
Require Import RealParams.
Require Import PrimSemantics.
Require Import LAsm.
Require Import LoadStoreSem2.

(*Require Import CalRealPTPool.*)

Require Import liblayers.logic.PTreeModules.
Require Import liblayers.logic.LayerLogicImpl.
Require Import liblayers.compat.CompatLayers.
Require Import liblayers.compat.CompatGenSem.

Require Import INVLemmaContainer.
Require Import INVLemmaMemory.
Require Import CalRealIDPDE.
Require Import CalRealInitPTE.
Require Import CalRealPTPool.

Require Export MPTIntro.
Require Import AbstractDataType.

Section WITHMEM.

  Local Open Scope Z_scope.

  Context `{Hstencil: Stencil}.
  Context `{Hmem: Mem.MemoryModel}.
  Context `{Hmwd: UseMemWithData mem}.
  Context `{real_params: RealParams}.

  (** * Proofs that the primitives satisfies the invariants at this layer *)
  Section INV.

    Global Instance ptInsertAux_inv: PreservesInvariants ptInsertAux_spec.
    Proof.
      unfold ptInsertAux_spec.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto;
      subdestruct; try (inv H8; rewrite ZMap.gso; auto).
    Qed.

    Global Instance ptInsertPDE_inv: PreservesInvariants ptInsertPDE_spec.
    Proof.
      unfold ptInsertPDE_spec.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto;
      try (rewrite ZMap.gso; eauto; fail).
      - apply consistent_ppage_alloc_hide; assumption.
      - apply dirty_ppage_gss; assumption.
    Qed.

    (** * Proofs that the primitives satisfies the invariants at this layer *)
    Global Instance ptRmvAux_inv: PreservesInvariants ptRmvAux_spec.
    Proof.
      unfold ptRmvAux_spec.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto;
      subdestruct; try (inv H7; rewrite ZMap.gso; auto).
    Qed.

    (** * Proofs that the primitives satisfies the invariants at this layer *)
    Global Instance ptRmvPDE_inv: PreservesInvariants ptRmvPDE_spec.
    Proof.
      unfold ptRmvPDE_spec.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto;
      try (rewrite ZMap.gso; eauto; fail).
      - eapply consistent_ppage_hide_alloc; eassumption.
      - eapply dirty_ppage_gso_alloc; eauto.
      - eapply consistent_ppage_hide_alloc; eassumption.
      - eapply dirty_ppage_gso_alloc; eauto.
    Qed.

    Global Instance idpde_init_inv: PreservesInvariants idpde_init_spec.
    Proof.
      preserves_invariants_simpl low_level_invariant high_level_invariant; auto.
      - apply real_nps_range.
      - apply real_at_kern_valid.
      - apply real_at_usr_valid.
      - apply real_container_valid.
      - apply real_quota_bounded_AT.
      - rewrite init_pperm; try assumption.
        apply real_pperm_valid.
    Qed.

  End INV.

  (** * Layer Definition *)
  (** ** Layer Definition newly introduced  *)
  Definition mptop_fresh : compatlayer (cdata RData) :=
    pt_read ↦ gensem ptRead_spec
            ⊕ pt_read_pde ↦ gensem ptReadPDE_spec
            ⊕ pt_insert_aux ↦ gensem ptInsertAux_spec
            ⊕ pt_insert_pde ↦ gensem ptInsertPDE_spec
            ⊕ pt_rmv_aux ↦ gensem ptRmvAux_spec
            ⊕ pt_rmv_pde ↦ gensem ptRmvPDE_spec
            ⊕ idpde_init ↦ gensem idpde_init_spec.

  (** ** Layer Definition passthrough  *)
  Definition mptop_passthrough : compatlayer (cdata RData) :=
    fload ↦ gensem fload_spec
          ⊕ fstore ↦ gensem fstore_spec
          ⊕ flatmem_copy ↦ gensem flatmem_copy_spec
          ⊕ vmxinfo_get ↦ gensem vmxinfo_get_spec
          ⊕ device_output ↦ gensem device_output_spec
          ⊕ set_pg ↦ gensem setPG1_spec
          ⊕ at_get_c ↦ gensem get_at_c_spec
          ⊕ at_set_c ↦ gensem set_at_c0_spec
          ⊕ pfree ↦ gensem pfree'_spec
          ⊕ set_pt ↦ gensem setPT'_spec
          ⊕ set_PDE ↦ gensem setPDE_spec
          ⊕ rmv_PDE ↦ gensem rmvPDE_spec
          ⊕ rmv_PTE ↦ gensem rmvPTE_spec
          ⊕ pt_in ↦ primcall_general_compatsem' ptin'_spec (prim_ident:= pt_in)
          ⊕ pt_out ↦ primcall_general_compatsem' ptout_spec (prim_ident:= pt_out)
          ⊕ clear_cr2 ↦ gensem clearCR2_spec
          ⊕ container_get_parent ↦ gensem container_get_parent_spec
          ⊕ container_get_nchildren ↦ gensem container_get_nchildren_spec
          ⊕ container_get_quota ↦ gensem container_get_quota_spec
          ⊕ container_get_usage ↦ gensem container_get_usage_spec
          ⊕ container_can_consume ↦ gensem container_can_consume_spec
          ⊕ container_split ↦ gensem container_split_spec
          ⊕ container_alloc ↦ gensem container_alloc_spec
          ⊕ trap_in ↦ primcall_general_compatsem trapin_spec
          ⊕ trap_out ↦ primcall_general_compatsem trapout_spec
          ⊕ host_in ↦ primcall_general_compatsem hostin_spec
          ⊕ host_out ↦ primcall_general_compatsem hostout_spec
          ⊕ trap_get ↦ primcall_trap_info_get_compatsem trap_info_get_spec
          ⊕ trap_set ↦ primcall_trap_info_ret_compatsem trap_info_ret_spec
          ⊕ accessors ↦ {| exec_load := (@exec_loadex _ _ Hmwd);
                           exec_store := (@exec_storeex _ _ Hmwd) |}.

  (** * Layer Definition *)
  Definition mptop : compatlayer (cdata RData) := mptop_fresh ⊕ mptop_passthrough.

  (* Definition semantics := LAsm.Lsemantics mptintro.*)

End WITHMEM.


From cap_machine Require Export logrel.
From iris.proofmode Require Import proofmode.
From iris.program_logic Require Import weakestpre adequacy lifting.
From stdpp Require Import base.
From cap_machine.ftlr Require Import ftlr_base interp_weakening.
From cap_machine.rules Require Import rules_base rules_Seal.

Section fundamental.
  Context {Σ:gFunctors} {memg:memG Σ} {regg:regG Σ} {sealsg: sealStoreG Σ}
          {nainv: logrel_na_invs Σ}
          `{MachineParameters}.

  Notation D := ((leibnizO Word) -n> iPropO Σ).
  Notation R := ((leibnizO Reg) -n> iPropO Σ).
  Implicit Types w : (leibnizO Word).
  Implicit Types interp : (D).

  (* Proving the meaning of sealing in the LR sane *)
  Lemma sealing_preserves_interp sb p0 b0 e0 a0:
        permit_seal p0 = true →
        withinBounds b0 e0 a0 = true →
        fixpoint interp1 (WSealable sb) -∗
        fixpoint interp1 (WSealRange p0 b0 e0 a0) -∗
        fixpoint interp1 (WSealed a0 sb).
  Proof.
    iIntros (Hpseal Hwb) "#HVsb #HVsr".
    rewrite (fixpoint_interp1_eq (WSealRange _ _ _ _)) (fixpoint_interp1_eq (WSealed _ _)) /= Hpseal /interp_sb.
    iDestruct "HVsr" as "[Hss _]".
    apply seq_between_dist_Some in Hwb.
    iDestruct (big_sepL_delete with "Hss") as "[HSa0 _]"; eauto.
    iDestruct "HSa0" as (P) "[% [HsealP HWcond]]".
    iExists P.
    repeat iSplitR; auto.
    by iApply "HWcond".
  Qed.

  Lemma seal_case (r : leibnizO Reg) (p : Perm)
        (b e a : Addr) (w : Word) (dst r1 r2 : RegName) (P:D):
    ftlr_instr r p b e a w (Seal dst r1 r2) P.
  Proof.
    intros Hp Hsome i Hbae Hi.
    iIntros "#IH #Hinv #Hinva #Hreg #[Hread Hwrite] Hown Ha HP Hcls HPC Hmap".
    rewrite delete_insert_delete.
    iDestruct ((big_sepM_delete _ _ PC) with "[HPC Hmap]") as "Hmap /=";
      [apply lookup_insert|rewrite delete_insert_delete;iFrame|]. simpl.
    iApply (wp_Seal with "[$Ha $Hmap]"); eauto.
    { simplify_map_eq; auto. }
    { rewrite /subseteq /map_subseteq /set_subseteq_instance. intros rr _.
      apply elem_of_dom. apply lookup_insert_is_Some'; eauto. }

    iIntros "!>" (regs' retv). iDestruct 1 as (HSpec) "[Ha Hmap]".
    destruct HSpec as [ * Hr1 Hr2 Hseal Hwb HincrPC | ].
    { apply incrementPC_Some_inv in HincrPC as (p''&b''&e''&a''& ? & HPC & Z & Hregs') .

      assert (p'' = p ∧ a'' = a ∧ b'' = b ∧ e'' = e) as (-> & -> & -> & ->).
      { destruct (decide (PC = dst)); simplify_map_eq; auto. }
      assert (r1 ≠ PC) as Hne.
      { destruct (decide (PC = r1)); last auto. simplify_map_eq; auto. }
      rewrite lookup_insert_ne in Hr1; auto.
      iAssert (fixpoint interp1 (WSealable sb)) as "HVsb". {
        destruct (decide (r2 = PC)) eqn:Heq.
        - subst r2. simplify_map_eq; auto.
        - simplify_map_eq. unshelve iSpecialize ("Hreg" $! r2 _ _ Hr2); eauto.
      }

      iApply wp_pure_step_later; auto.
      iMod ("Hcls" with "[HP Ha]");[iExists w;iFrame|iModIntro].
      iNext; iIntros "_".
      iApply ("IH" $! regs' with "[%] [] [Hmap] [$Hown]").
      { cbn. intros. subst regs'. by repeat (apply lookup_insert_is_Some'; right). }
      { iIntros (ri v Hri Hvs).
        subst regs'.
        rewrite lookup_insert_ne in Hvs; auto.
        destruct (decide (ri = dst)).
        { subst ri.
          rewrite lookup_insert in Hvs; inversion Hvs. simplify_eq.
          (* Sealrange is valid -> validity implies P *)
          unshelve iDestruct ("Hreg" $! r1 _ _ Hr1) as "HVsr"; eauto.
          iApply (sealing_preserves_interp with "HVsb HVsr"); auto. }
        { repeat (rewrite lookup_insert_ne in Hvs); auto.
          iApply "Hreg"; auto. } }
        { subst regs'. rewrite insert_insert. iApply "Hmap". }
      iModIntro.
      iApply (interp_weakening with "IH Hinv"); auto; try solve_addr.
      { destruct Hp; by subst p. }
      { by rewrite PermFlowsToReflexive. }
    }
    { iApply wp_pure_step_later; auto.
      iMod ("Hcls" with "[HP Ha]");[iExists w;iFrame|iModIntro].
      iNext; iIntros "_".
      iApply wp_value; auto. iIntros; discriminate. }
  Qed.

End fundamental.


(*
 * Copyright (c) Meta Platforms, Inc. and affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)
From stdpp Require Import base strings gmap stringmap fin_maps.
From iris.base_logic Require Import upred derived.
From iris.base_logic.lib Require Import iprop own.
From iris.algebra Require Import ofe cmra gmap_view.
From iris.proofmode Require Import tactics.

From shack Require Import lang progdef subtype eval.
From shack Require Import heap modality interp typing.
From shack.soundness Require Import expr defs.

Section proofs.
  (* assume a given set of class definitions and their SDT annotations. *)
  Context `{SDTCVS: SDTClassVarianceSpec}.

  (* Iris semantic context *)
  Context `{!sem_heapGS Θ}.

  Lemma get_priv_soundness C cdef Δ rigid Γ lhs name fty:
    wf_cdefs →
    wf_lty Γ →
    pdefs !! C = Some cdef →
    cdef.(classfields) !! name = Some (Private, fty) →
    ∀ t tdef Σt σ,
    pdefs !! t = Some tdef →
    length Σt = length tdef.(generics) →
    inherits_using t C σ →
    ∀ Σ st st' n,
    length Σ = rigid →
    rigid ≥ length cdef.(generics) →
    cmd_eval C st (GetC lhs ThisE name) st' n →
    let Σthis := interp_exact_tag interp_type t Σt in
    ⌜interp_list interp_nothing Σt σ ≡ take (length cdef.(generics)) Σ⌝ -∗
    □ interp_as_mixed Σthis -∗
    □ interp_env_as_mixed Σ -∗
    □ Σinterp Σthis Σ Δ -∗
    heap_models st.2 ∗ interp_local_tys Σthis Σ Γ st.1 -∗
    |=▷^n heap_models st'.2 ∗ interp_local_tys Σthis Σ (<[lhs:=fty]> Γ) st'.1.
  Proof.
    move => wfpdefs wflty hcdef hf.
    move => t tdef Σt σ htdef hlenΣt hin_t_C_σ.
    move => Σ st st' n hrigid hge hc /=.
    iIntros "%heq #hΣthis #hΣ #hΣΔ".
    elim/cmd_eval_getI: hc.
    move => {n}.
    move => Ω h vis _fty orig l t0 vs v heval hheap hvs hf0 hvis.
    iIntros "[Hh Hle]".
    iModIntro. (* keep the later *)
    destruct Ω as [vthis Ω].
    case: heval => ->.
    simpl in *.
    iDestruct "Hle" as "[#Hthis #Hle]" => /=.
    iAssert (interp_exact_tag interp_type t Σt (LocV l)) as "#Hl"; first by done.
    rewrite {3}interp_exact_tag_unseal /interp_exact_tag_def /=.
    iDestruct "Hthis" as (l0 ? fields ifields H) "(#hconstr & #hf0 & #H◯)".
    destruct H as ([= <-] & ? & hfields & hidom); simplify_eq.
    assert (hlen: length σ = length cdef.(generics) ∧
      Forall (λ ty : lang_ty, no_this ty) σ).
    { destruct wfpdefs.
      apply inherits_using_wf in hin_t_C_σ => //.
      destruct hin_t_C_σ as (? & ?& ? & hh & ?).
      apply wf_tyI in hh as (? & ? & hlenC & ?); simplify_eq.
      by eauto.
    }
    destruct hlen as (hlen & hnothis).
    iAssert (⌜t0 = t⌝ ∗ heap_models h ∗ ▷ interp_type fty (interp_exact_tag interp_type t Σt) Σ v)%I with "[Hh]" as "[%Ht [Hh Hv]]".
    { iDestruct "Hh" as (sh) "(H● & %hdom & #Hh)".
      iDestruct (sem_heap_own_valid_2 with "H● H◯") as "#HΦ".
      iDestruct ("Hh" with "[//]") as (iFs) "[H H▷]".
      iRewrite "H" in "HΦ".
      rewrite option_equivI prod_equivI /=.
      iDestruct "HΦ" as "[%Ht HΦ]".
      fold_leibniz; subst.
      iSplitR; first done.
      iSplitL. { iExists _. iFrame. by iSplit. }
      assert (hfC: has_field name t Private (subst_ty σ fty) C).
      { destruct wfpdefs.
        apply has_field_inherits_using with C => //.
        change Private with (Private, fty).1.
        by apply HasField with cdef.
      }
      case: (has_field_fun _ _ _ _ _ hf0 _ _ _ hfC) => hvis_ [hfty horig].
      simplify_eq.
      iSpecialize ("hf0" $! name Private (subst_ty σ fty) C hfC).
      iDestruct "H▷" as "[hdf h]".
      rewrite later_equivI.
      iNext.
      iDestruct "hf0" as (iF) "[hf0 hiff]".
      iRewrite -"HΦ" in "hf0".
      iSpecialize ("h" $! name _ with "[hf0]"); first done.
      iDestruct "h" as (w) "[%hw hiw]".
      simplify_eq.
      iDestruct ("hiff" with "hiw") as "hiw_"; iClear "hiw".
      iAssert (interp_type (subst_ty σ fty) (interp_exact_tag interp_type t Σt) Σt v) with "[hiw_]" as "#hiw".
      { rewrite /subst_gen -hlenΣt.
        by iApply interp_type_subst_this.
      }
      iClear "hiw_".
      rewrite interp_type_subst; last first.
      { destruct wfpdefs.
        apply wf_fields_bounded in hcdef.
        apply hcdef in hf.
        by rewrite hlen.
      }
      rewrite -(interp_type_take fty _ Σ); first last.
      { exact hge. }
      { destruct wfpdefs.
        apply wf_fields_bounded in hcdef.
        by apply hcdef in hf.
      }
      assert (heq2: interp_list (interp_exact_tag interp_type t Σt) Σt σ ≡
                    take (length cdef.(generics)) Σ).
      { rewrite -heq.
        by apply interp_list_no_this.
      }
      by rewrite heq2.
    }
    subst.
    iNext.
    iFrame.
    iApply interp_local_tys_update => //.
    by iSplit.
  Qed.

  Lemma get_pub_soundness C Δ kd rigid Γ lhs recv exact_ t σ name fty orig:
    wf_cdefs →
    wf_lty Γ →
    Forall wf_constraint Δ →
    expr_has_ty Δ Γ rigid kd recv (ClassT exact_ t σ) →
    has_field name t Public fty orig →
    (is_true exact_ ∨ no_this fty) →
    ∀ Σthis Σ st st' n,
    length Σ = rigid →
    cmd_eval C st (GetC lhs recv name) st' n →
    □ interp_as_mixed Σthis -∗
    □ interp_env_as_mixed Σ -∗
    □ Σinterp Σthis Σ Δ -∗
    heap_models st.2 ∗ interp_local_tys Σthis Σ Γ st.1 -∗
    |=▷^n heap_models st'.2 ∗ interp_local_tys Σthis Σ (<[lhs:=subst_fty exact_ t σ fty]> Γ) st'.1.
  Proof.
    move => wfpdefs ?? hrecv hf hex Σthis Σ st st' n hrigid hc.
    iIntros "hΣthis hΣ hΣΔ".
    elim/cmd_eval_getI: hc.
    move => {n}.
    move => Ω h vis0 fty0 orig0 l t0 vs v heval hheap hvs hf0 hvis.
    iIntros "[Hh #Hle]".
    iModIntro. (* keep the later *)
    assert (hwf0: wf_ty (ClassT exact_ t σ)) by (by apply expr_has_ty_wf in hrecv).
    assert (hwf0_ := hwf0).
    apply wf_tyI in hwf0_ as (tdef & htdef & hlen & hfσ); simplify_eq.
    iDestruct (expr_soundness with "hΣthis hΣ hΣΔ Hle") as "He" => //; try (by apply wfpdefs).
    destruct exact_.
    (* receiver class is exact *)
    - rewrite interp_exact_tag_unfold interp_exact_tag_unseal /interp_exact_tag_def /=.
      iDestruct "He" as (l0 tdef' fields ifields H) "(#hconstr & #hf0 & #H◯)".
      destruct H as ([= <-] & htdef' & hfields & hidom); simplify_eq.
      simpl.
      iAssert (⌜t0 = t⌝ ∗ heap_models h ∗
        ▷ interp_type (subst_gen t tdef fty) interp_nothing (interp_list Σthis Σ σ) v)%I with "[Hh]" as "[%Ht [Hh Hv]]".
      { iDestruct "Hh" as (sh) "(H● & %hdom & #Hh)".
        iDestruct (sem_heap_own_valid_2 with "H● H◯") as "#HΦ".
        iDestruct ("Hh" with "[//]") as (iFs) "[H H▷]".
        iRewrite "H" in "HΦ".
        rewrite option_equivI prod_equivI /=.
        iDestruct "HΦ" as "[%Ht HΦ]".
        fold_leibniz; subst.
        iSplitR; first done.
        iSplitL. { iExists _. iFrame. by iSplit. }
        iSpecialize ("hf0" $! name Public fty orig hf).
        iDestruct "hf0" as (iF) "[hf0 hiff]".
        iNext.
        iDestruct "H▷" as "[%hdf h]".
        iRewrite -"HΦ" in "hf0".
        iSpecialize ("h" $! name _ with "[hf0]"); first done.
        iDestruct "h" as (w) "[%hw hiw]".
        iApply "hiff".
        by simplify_eq.
      }
      subst; simpl.
      iNext.
      iFrame.
      destruct wfpdefs.
      iApply interp_local_tys_update => //.
      assert (hlen2: length (interp_list Σthis Σ σ) = length tdef.(generics)) by by rewrite /interp_list fmap_length.
      rewrite /subst_gen /subst_fty -hlen2.
      rewrite interp_type_subst_this => //.
      rewrite interp_type_subst; last first.
      { apply has_field_bounded in hf => //.
        destruct hf as (?&?&hf); simplify_eq.
        apply bounded_subst_this.
        + by rewrite hlen.
        + constructor.
          by apply bounded_gen_targs.
      }
      rewrite hlen -hlen2.
      rewrite interp_type_subst_this; first last.
      { by rewrite /interp_list map_length. }
      { by assumption. }
      done.
    - (* receiver is not exact, so it can't call anything using the `this`
       * type yet.
       *)
      case: hex => // hnothis.
      rewrite interp_tag_unfold interp_tag_equiv //; first last.
      { by rewrite /interp_list fmap_length. }
      { by apply wfpdefs. }
      iDestruct "He" as (?? def def1 σ0 ???) "(%H & #hmixed & #? & #hf0 & #hdyn & #H◯)".
      destruct H as ([= <-] & hdef & hdef0 & hlenΣt & hinherits & hfields & hidom).
      assert (hl0: length (generics def) = length σ0).
      { apply inherits_using_wf in hinherits; try (by apply wfpdefs).
        destruct hinherits as (?&?&?&hh&?).
        apply wf_tyI in hh as (? & ? & ? & ?); by simplify_eq.
      }
      assert (hl1: length σ0 = length σ).
      { rewrite -hl0.
        apply wf_tyI in hwf0 as (? & ? & ? & ?); by simplify_eq.
      }
      assert (hff: has_field name t1 Public (subst_ty σ0 fty) orig).
      { by apply has_field_inherits_using with (A := t1) (σB := σ0) in hf => //; try (by apply wfpdefs). }
      iAssert (⌜t0 = t1⌝ ∗ heap_models h ∗
        ▷ interp_type (subst_gen t1 def1 (subst_ty σ0 fty)) interp_nothing Σt v)%I with "[Hh]" as "[%Ht [Hh Hv]]".
      { iDestruct "Hh" as (sh) "(H● & %hdom & #Hh)".
        iDestruct (sem_heap_own_valid_2 with "H● H◯") as "#HΦ".
        iDestruct ("Hh" with "[//]") as (iFs) "[H H▷]".
        iRewrite "H" in "HΦ".
        rewrite option_equivI prod_equivI /=.
        iDestruct "HΦ" as "[%Ht HΦ]".
        fold_leibniz; subst.
        iSplitR; first done.
        iSplitL. { iExists _. iFrame. by iSplit. }
        iSpecialize ("hdyn" $! name Public (subst_ty σ0 fty) orig hff).
        iNext.
        iDestruct "H▷" as "[%hdf h]".
        iDestruct "hdyn" as (iF) "[hdyn hiff]".
        iRewrite -"HΦ" in "hdyn".
        iSpecialize ("h" $! name _ with "[hdyn]"); first done.
        iDestruct "h" as (w) "[%hw hiw]".
        iApply "hiff".
        by simplify_eq.
      }
      subst; simpl.
      iNext.
      iFrame.
      destruct wfpdefs.
      iApply interp_local_tys_update => //.
      rewrite /subst_gen -hlenΣt.
      rewrite interp_type_subst_this => //.
      rewrite interp_type_subst; last first.
      { apply has_field_bounded in hf => //.
        destruct hf as (?&?&hf); simplify_eq.
        by rewrite -hl0.
      }
      rewrite (interp_list_no_this _ _ (interp_exact_tag interp_type t1 Σt) interp_nothing); last first.
      { apply inherits_using_wf in hinherits => //.
        by destruct hinherits as (? & ? & ? & ? & hh); simplify_eq.
      }
      iAssert (interp_type fty (interp_exact_tag interp_type t1 Σt)
        (interp_list Σthis Σ σ) v) with "[Hv]" as "Hv".
      { iApply interp_with_mono => //.
        - apply has_field_mono in hf => //.
          destruct hf as (?&?&hh); simplify_eq.
          by destruct hh.
        - by apply has_field_wf in hf.
      }
      rewrite interp_type_subst; first last.
      { apply bounded_subst_this.
        - apply has_field_bounded in hf => //.
          destruct hf as (?&?&hf).
          apply wf_tyI in hwf0 as (? & ? & -> & ?).
          by simplify_eq.
        - constructor; by apply bounded_gen_targs.
      }
      rewrite subst_this_no_this_id; last done.
      by rewrite (interp_type_no_this _ _ _ _ Σthis); last done.
  Qed.

  (* TODO: factorize the priv vs pub mechanics. This proof is using both *)
  Lemma get_this_soundness C cdef Δ kd rigid Γ lhs recv name fty orig:
    wf_cdefs →
    wf_lty Γ →
    Forall wf_constraint Δ →
    pdefs !! C = Some cdef →
    expr_has_ty Δ Γ rigid kd recv ThisT →
    has_field name C Public fty orig →
    ∀ t tdef Σt σ,
    pdefs !! t = Some tdef →
    length Σt = length tdef.(generics) →
    inherits_using t C σ →
    ∀ Σ st st' n,
    length Σ = rigid →
    rigid ≥ length cdef.(generics) →
    cmd_eval C st (GetC lhs recv name) st' n →
    let Σthis := interp_exact_tag interp_type t Σt in
    ⌜interp_list interp_nothing Σt σ ≡ take (length cdef.(generics)) Σ⌝ -∗
    □ interp_as_mixed Σthis -∗
    □ interp_env_as_mixed Σ -∗
    □ Σinterp Σthis Σ Δ -∗
    heap_models st.2 ∗ interp_local_tys Σthis Σ Γ st.1 -∗
    |=▷^n heap_models st'.2 ∗ interp_local_tys Σthis Σ (<[lhs:=fty]> Γ) st'.1.
  Proof.
    move => wfpdefs ?? hcdef hrecv hf.
    move => t tdef Σt σ htdef hlenΣt hin_t_C.
    move => Σ st st' n hrigid hge hc Σthis.
    iIntros "%hΣeq hΣthis hΣ hΣΔ".
    elim/cmd_eval_getI: hc.
    move => {n}.
    move => Ω h vis0 fty0 orig0 l t0 vs v heval hheap hvs hf0 hvis.
    iIntros "[Hh #Hle]".
    iModIntro. (* keep the later *)
    iDestruct (expr_soundness with "hΣthis hΣ hΣΔ Hle") as "He" => //; try (by apply wfpdefs).
    rewrite interp_this_unfold /= {2}/Σthis.
    rewrite interp_exact_tag_unseal /interp_exact_tag_def /=.
    iDestruct "He" as (l0 tdef' fields ifields H) "(#hconstr & #hf0 & #H◯)".
    destruct H as ([= <-] & htdef' & hfields & hidom); simplify_eq.
    assert (hlen: length σ = length cdef.(generics) ∧
      Forall (λ ty : lang_ty, no_this ty) σ).
    { destruct wfpdefs.
      apply inherits_using_wf in hin_t_C => //.
      destruct hin_t_C as (? & ?& ? & hh & ?).
      apply wf_tyI in hh as (? & ? & hlenC & ?); simplify_eq.
      by eauto.
    }
    destruct hlen as (hlen & hnothis).
    iAssert (⌜t0 = t⌝ ∗ heap_models h ∗
      ▷ interp_type fty (interp_exact_tag interp_type t Σt) Σ v)%I with "[Hh]" as "[%Ht [Hh Hv]]".
    { iDestruct "Hh" as (sh) "(H● & %hdom & #Hh)".
      iDestruct (sem_heap_own_valid_2 with "H● H◯") as "#HΦ".
      iDestruct ("Hh" with "[//]") as (iFs) "[H H▷]".
      iRewrite "H" in "HΦ".
      rewrite option_equivI prod_equivI /=.
      iDestruct "HΦ" as "[%Ht HΦ]".
      fold_leibniz; subst.
      iSplitR; first done.
      iSplitL. { iExists _. iFrame. by iSplit. }
      assert (hff: has_field name t Public (subst_ty σ fty) orig).
      { apply has_field_inherits_using
        with (A := t) (σB := σ) in hf => //; by apply wfpdefs.
      }
      iSpecialize ("hf0" $! name Public (subst_ty σ fty) orig hff).
      iDestruct "hf0" as (iF) "[hf0 hiff]".
      iNext.
      iDestruct "H▷" as "[%hdf h]".
      iRewrite -"HΦ" in "hf0".
      iSpecialize ("h" $! name _ with "[hf0]"); first done.
      iDestruct "h" as (w) "[%hw hiw]".
      iDestruct ("hiff" with "hiw") as "hw".
      simplify_eq.
      rewrite /subst_gen -hlenΣt.
      iAssert (□ interp_type
        (subst_ty σ fty) (interp_exact_tag interp_type t Σt) Σt v)%I as "#hw2".
      { iModIntro.
        by rewrite -interp_type_subst_this.
      }
      iClear "hiw hiff hw".
      rewrite interp_type_subst; last first.
      { apply has_field_bounded in hf => //; try by apply wfpdefs.
        destruct hf as (? & ? & ?); simplify_eq.
        by rewrite hlen.
      }
      assert (heq:
        interp_list (interp_exact_tag interp_type t Σt) Σt σ ≡
        interp_list interp_nothing Σt σ).
      { by apply interp_list_no_this. }
      rewrite (interp_type_equivI _ _ _ heq).
      rewrite (interp_type_equivI _ _ _ hΣeq).
      rewrite interp_type_take //.
      { apply has_field_bounded in hf => //; try by apply wfpdefs.
        by destruct hf as (? & ? & ?); simplify_eq.
      }
    }
    subst; simpl.
    iNext.
    iFrame.
    destruct wfpdefs.
    by iApply interp_local_tys_update.
  Qed.
End proofs.


From Perennial.program_proof Require Import grove_prelude.
From Goose.github_com.mit_pdos.gokv.simplepb Require Export config.
From iris.base_logic Require Export lib.ghost_var mono_nat.
From iris.algebra Require Import dfrac_agree mono_list.
From Perennial.program_proof Require Import marshal_stateless_proof std_proof.
From Perennial.program_proof.simplepb Require Import config_marshal_proof.
From Perennial.program_proof.grove_shared Require Import urpc_proof urpc_spec.

Section config_global.

Record config_names :=
{
  epoch_gn:gname ;
  config_val_gn:gname;
}.

Class configG Σ := {
    config_epochG :> mono_natG Σ ;
    config_configG :> ghost_varG Σ (list u64) ;
    config_urpcG :> urpcregG Σ ;
}.

Definition configΣ := #[mono_natΣ ; ghost_varΣ (list u64) ; urpcregΣ].

Global Instance subG_configΣ {Σ} : subG configΣ Σ → configG Σ.
Proof. intros. solve_inG. Qed.

Implicit Type γ : config_names.

Context `{!gooseGlobalGS Σ}.
Context `{!configG Σ}.

Definition own_epoch γ (epoch:u64) : iProp Σ :=
  mono_nat_auth_own γ.(epoch_gn) (1/2) (int.nat epoch).

Definition is_epoch_lb γ (epoch:u64) : iProp Σ :=
  mono_nat_lb_own γ.(epoch_gn) (int.nat epoch).

Definition own_config γ (conf:list u64) : iProp Σ :=
  ghost_var γ.(config_val_gn) (1/2) conf
.

Program Definition GetEpochAndConfig_core_spec γ Φ :=
  (£ 1 ={⊤,∅}=∗ ∃ epoch conf, own_epoch γ epoch ∗ own_config γ conf ∗
    (⌜int.nat epoch < int.nat (word.add epoch (U64 1))⌝ -∗ own_epoch γ (word.add epoch (U64 1)) -∗ own_config γ conf ={∅,⊤}=∗
      Φ (word.add epoch 1) conf
      )
    )%I.

Program Definition GetConfig_core_spec γ Φ :=
  (£ 1 ={⊤,∅}=∗ ∃ conf, own_config γ conf ∗ (own_config γ conf ={∅,⊤}=∗ Φ conf))%I.

Program Definition WriteConfig_core_spec γ (epoch:u64) (new_conf:list u64) Φ : iProp Σ :=
  (£ 1 -∗ |={⊤,∅}=> ∃ latest_epoch, own_epoch γ latest_epoch ∗
      if (decide (latest_epoch = epoch)) then
        ∃ conf, own_config γ conf ∗ (own_config γ new_conf -∗ own_epoch γ epoch ={∅,⊤}=∗
                                            Φ (U64 0))
      else
        (own_epoch γ latest_epoch ={∅,⊤}=∗ (∀ (err:u64), ⌜err ≠ 0⌝ → Φ err))
  ).

Program Definition GetEpochAndConfig_spec γ :=
  λ (encoded_args:list u8), λne (Φ : list u8 -d> iPropO Σ) ,
  ( (* no args *)
    GetEpochAndConfig_core_spec γ (λ newEpoch conf,
                                  ∀ reply enc_conf,
                                   ⌜Config.has_encoding enc_conf conf⌝ -∗
                                   ⌜reply = u64_le newEpoch ++ enc_conf⌝ -∗
                                   Φ reply
                                  )
    )%I.
Next Obligation.
  solve_proper.
Defined.

Program Definition GetConfig_spec γ :=
  λ (encoded_args:list u8), λne (Φ : list u8 -d> iPropO Σ) ,
  ( (* no args *)
    GetConfig_core_spec γ (λ conf, ∀ reply,
                                   ⌜Config.has_encoding reply conf⌝ -∗
                                   Φ reply
                                  )
    )%I.
Next Obligation.
  solve_proper.
Defined.

Program Definition WriteConfig_spec γ :=
  λ (enc_args:list u8), λne (Φ : list u8 -d> iPropO Σ) ,
  ( ∃ epoch new_conf enc_new_conf,
    ⌜enc_args = u64_le epoch ++ enc_new_conf⌝ ∗
    ⌜Config.has_encoding enc_new_conf new_conf⌝ ∗
    WriteConfig_core_spec γ epoch new_conf (λ err, ∀ reply,
                                   ⌜reply = u64_le err⌝ -∗
                                   Φ reply
                                  )
    )%I.
Next Obligation.
  unfold WriteConfig_core_spec.
  solve_proper.
Defined.

Definition is_host (host:u64) γ : iProp Σ :=
  ∃ γrpc,
  handler_spec γrpc host (U64 0) (GetEpochAndConfig_spec γ) ∗
  handler_spec γrpc host (U64 1) (GetConfig_spec γ) ∗
  handler_spec γrpc host (U64 2) (WriteConfig_spec γ) ∗
  handlers_dom γrpc {[ (U64 0) ; (U64 1) ; (U64 2)]}
.

End config_global.

Section config_proof.

Context `{!heapGS Σ}.
Context `{!configG Σ}.

Definition is_Clerk (ck:loc) γ : iProp Σ :=
  ∃ (cl:loc) srv,
  "#Hcl" ∷ readonly (ck ↦[config.Clerk :: "cl"] #cl) ∗
  "#Hcl_rpc"  ∷ is_uRPCClient cl srv ∗
  "#Hhost" ∷ is_host srv γ
.

Lemma wp_MakeClerk configHost γ:
  {{{
      is_host configHost γ
  }}}
    config.MakeClerk #configHost
  {{{
      ck, RET #ck; is_Clerk ck γ
  }}}
.
Proof.
  iIntros (Φ) "#Hhost HΦ".
  wp_call.
  wp_apply (wp_MakeClient).
  iIntros (cl) "#Hcl".
  iApply wp_fupd.
  wp_apply (wp_allocStruct).
  { eauto. }
  iIntros (ck) "Hck".
  iDestruct (struct_fields_split with "Hck") as "HH".
  iNamed "HH".
  iMod (readonly_alloc_1 with "cl") as "#cl".
  iModIntro.
  iApply "HΦ".
  iExists _, _. iFrame "#".
Qed.

Definition own_Server (s:loc) γ : iProp Σ :=
  ∃ (epoch:u64) (conf:list u64) conf_sl,
  "Hepoch" ∷ s ↦[config.Server :: "epoch"] #epoch ∗
  "Hconf" ∷ s ↦[config.Server :: "config"] (slice_val conf_sl) ∗
  "Hconf_sl" ∷ is_slice_small conf_sl uint64T 1 conf ∗
  "Hepoch_ghost" ∷ own_epoch γ epoch ∗
  "Hconf_ghost" ∷ own_config γ conf
.

Definition configN := nroot .@ "config".

Definition is_Server (s:loc) γ : iProp Σ :=
  ∃ mu,
  "#Hmu" ∷ readonly (s ↦[config.Server :: "mu"] mu) ∗
  "#His_mu" ∷ is_lock configN mu (own_Server s γ).

Lemma wp_Server__GetEpochAndConfig (server:loc) γ :
  {{{
        is_Server server γ
  }}}
    config.Server__GetEpochAndConfig #server
  {{{
        (f:val), RET f; impl_handler_spec2 f (GetEpochAndConfig_spec γ)
  }}}.
Proof.
  iIntros (Φ) "#His_srv HΦ".
  wp_call.
  iApply "HΦ".
  iModIntro.
  unfold impl_handler_spec2.
  clear Φ.
  iIntros (enc_args Φ Ψ req_sl rep_ptr dummy_sl dummy) "!# Harg_sl Hrep _ HΦ HΨ".
  wp_call.

  iNamed "His_srv".
  wp_loadField.
  wp_apply (acquire_spec with "[$His_mu]").
  iIntros "[Hlocked Hown]".
  iNamed "Hown".
  wp_pures.
  wp_loadField.
  wp_apply (wp_SumAssumeNoOverflow).
  iIntros (Hno_overflow).
  wp_storeField.
  wp_loadField.
  wp_apply (wp_slice_len).
  wp_apply (wp_NewSliceWithCap).
  { apply encoding.unsigned_64_nonneg. }
  iIntros (ptr) "Hsl".
  wp_pure1_credit "Hlc".
  wp_store.
  wp_loadField.
  wp_load.
  wp_apply (wp_WriteInt with "Hsl").
  iIntros (enc_sl) "Hrep_sl".
  wp_store.
  wp_loadField.
  wp_apply (Config.wp_Encode with "[Hconf_sl]").
  { iFrame. }
  iIntros (enc_conf enc_conf_sl) "(%Hconf_enc & Hconf_sl & Henc_conf_sl)".
  wp_load.
  wp_apply (wp_WriteBytes with "[$Hrep_sl Henc_conf_sl]").
  {
    iDestruct (is_slice_to_small with "Henc_conf_sl") as "$".
  }
  iIntros (rep_sl) "[Hrep_sl Henc_conf_sl]".
  replace (int.nat 0%Z) with 0%nat by word.
  wp_store.
  wp_loadField.

  iApply fupd_wp.
  iMod ("HΨ" with "Hlc") as "HΨ".
  iDestruct "HΨ" as (??) "(Hepoch_ghost2 & Hconf_ghost2 & Hupd)".
  iDestruct (ghost_var_agree with "Hconf_ghost Hconf_ghost2") as %->.
  iDestruct (mono_nat_auth_own_agree with "Hepoch_ghost Hepoch_ghost2") as %[_ Heq].
  replace (epoch0) with (epoch) by word.
  iCombine "Hepoch_ghost Hepoch_ghost2" as "Hepoch_ghost".
  iMod (mono_nat_own_update (int.nat (word.add epoch 1)) with "Hepoch_ghost") as "[[Hepoch_ghost Hepoch_ghost2] _]".
  { word. }
  iSpecialize ("Hupd" with "[%] Hepoch_ghost2 Hconf_ghost2").
  { word. }
  iMod "Hupd".
  iModIntro.

  wp_apply (release_spec with "[$Hlocked $His_mu Hepoch Hconf Hconf_ghost Hconf_sl Hepoch_ghost]").
  {
    iNext.
    iExists _, _, _.
    eauto with iFrame.
  }
  wp_pures.
  iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_sl".
  iSpecialize ("Hupd" with "[% //] [% //]").
  iApply ("HΦ" with "Hupd Hrep Hrep_sl").
Qed.

Lemma wp_Server__GetConfig (server:loc) γ :
  {{{
        is_Server server γ
  }}}
    config.Server__GetConfig #server
  {{{
        (f:val), RET f; impl_handler_spec2 f (GetConfig_spec γ)
  }}}.
Proof.
  iIntros (Φ) "#His_srv HΦ".
  wp_call.
  iApply "HΦ".
  iModIntro.
  unfold impl_handler_spec2.
  clear Φ.
  iIntros (enc_args Φ Ψ req_sl rep_ptr dummy_sl dummy) "!# Harg_sl Hrep _ HΦ HΨ".
  wp_call.

  iNamed "His_srv".
  wp_loadField.
  wp_apply (acquire_spec with "[$His_mu]").
  iIntros "[Hlocked Hown]".
  iNamed "Hown".
  wp_pure1_credit "Hlc".
  wp_loadField.
  wp_apply (Config.wp_Encode with "[Hconf_sl]").
  { iFrame. }
  iIntros (enc_conf rep_sl) "(%Hconf_enc & Hconf_sl & Hrep_sl)".
  wp_store.
  wp_loadField.

  iApply fupd_wp.
  iMod ("HΨ" with "Hlc") as "HΨ".
  iDestruct "HΨ" as (?) "(Hconf_ghost2 & Hupd)".
  iDestruct (ghost_var_agree with "Hconf_ghost Hconf_ghost2") as %->.
  iMod ("Hupd" with "Hconf_ghost2") as "Hupd".
  iModIntro.

  wp_apply (release_spec with "[$Hlocked $His_mu Hepoch Hconf Hconf_ghost Hconf_sl Hepoch_ghost]").
  {
    iNext.
    iExists _, _, _.
    iFrame.
  }
  wp_pures.
  iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_sl".
  iSpecialize ("Hupd" with "[% //]").
  iApply ("HΦ" with "Hupd Hrep Hrep_sl").
Qed.

Lemma wp_Server__WriteConfig (server:loc) γ :
  {{{
        is_Server server γ
  }}}
    config.Server__WriteConfig #server
  {{{
        (f:val), RET f; impl_handler_spec2 f (WriteConfig_spec γ)
  }}}.
Proof.
  iIntros (Φ) "#His_srv HΦ".
  wp_call.
  iApply "HΦ".
  iModIntro.
  unfold impl_handler_spec2.
  clear Φ.
  iIntros (enc_args Φ Ψ req_sl rep_ptr dummy_sl dummy) "!# Harg_sl Hrep _ HΦ HΨ".
  wp_call.
  iNamed "His_srv".
  wp_loadField.
  wp_apply (acquire_spec with "[$His_mu]").
  iIntros "[Hlocked Hown]".
  iNamed "Hown".
  wp_pures.

  unfold WriteConfig_spec.
  iDestruct "HΨ" as (new_epoch new_conf enc_new_conf) "(%Henc & %Henc_conf & HΨ)".
  rewrite Henc.
  wp_apply (wp_ReadInt with "Harg_sl").
  iIntros (args_sl) "Hargs_sl".
  wp_pure1_credit "Hlc".

  replace (slice.nil) with (slice_val Slice.nil) by done.
  wp_loadField.
  wp_if_destruct.
  {
    wp_apply (wp_WriteInt with "[]").
    {
      iApply is_slice_zero.
    }
    iIntros (rep_sl) "Hrep_sl".
    wp_store.
    wp_loadField.

    iApply fupd_wp.
    iMod ("HΨ" with "Hlc") as "HΨ".
    iDestruct "HΨ" as (?) "(Hepoch_ghost2 & HΨ)".
    iDestruct (mono_nat_auth_own_agree with "Hepoch_ghost Hepoch_ghost2") as %[_ Heq].
    replace (epoch) with (latest_epoch) in * by word.
    destruct (decide (_)).
    {
      exfalso. rewrite e in Heqb.
      done.
    }
    simpl.
    iMod ("HΨ" with "Hepoch_ghost2") as "HΨ".
    iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_sl".
    iDestruct ("HΨ" with "[%] [% //]") as "HΨ".
    { instantiate (1:=1). done. }
    iDestruct ("HΦ" with "HΨ Hrep Hrep_sl") as "HΦ".
    iModIntro.

    wp_apply (release_spec with "[$Hlocked $His_mu Hepoch Hconf Hconf_sl Hepoch_ghost Hconf_ghost]").
    {
      iNext.
      iExists _,_,_.
      eauto with iFrame.
    }
    wp_pures.
    iModIntro.
    done.
  }
  {
    wp_apply (Config.wp_Decode with "[$Hargs_sl]").
    { done. }
    iIntros (new_conf_sl) "Hnew_conf_sl".
    wp_storeField.
    wp_apply (wp_WriteInt with "[]").
    {
      iApply is_slice_zero.
    }
    iIntros (rep_sl) "Hrep_sl".
    wp_store.

    iApply fupd_wp.
    iMod ("HΨ" with "Hlc") as "HΨ".
    iDestruct "HΨ" as (?) "[Hepoch_ghost2 HΨ]".
    iDestruct (mono_nat_auth_own_agree with "Hepoch_ghost Hepoch_ghost2") as %[_ Heq].
    replace (epoch) with (latest_epoch) in * by word.
    destruct (decide (_)); last first.
    {
      exfalso.
      done.
    }
    {
      iDestruct "HΨ" as (?) "[Hconf_ghost2 HΨ]".
      iDestruct (ghost_var_agree with "Hconf_ghost Hconf_ghost2") as %->.
      iCombine "Hconf_ghost Hconf_ghost2" as "Hconf_ghost".
      iMod (ghost_var_update new_conf with "Hconf_ghost") as "[Hconf_ghost Hconf_ghost2]".
      iMod ("HΨ" with "Hconf_ghost2 Hepoch_ghost2") as "HΨ".
      iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_sl".
      iSpecialize ("HΨ" with "[%]").
      { done. }
      iSpecialize ("HΦ" with "HΨ Hrep Hrep_sl").
      iModIntro.

      wp_loadField.
      wp_apply (release_spec with "[$Hlocked $His_mu Hepoch Hconf Hnew_conf_sl Hepoch_ghost Hconf_ghost]").
      {
        iNext.
        iExists _,_,_.
        eauto with iFrame.
      }
      wp_pures.
      iModIntro.
      done.
    }
  }
Qed.

Lemma wp_Clerk__GetEpochAndConfig (ck:loc) γ Φ :
  is_Clerk ck γ -∗
  □ (£ 1 ={⊤,∅}=∗ ∃ epoch conf, own_epoch γ epoch ∗
                                    own_config γ conf ∗
    (⌜int.nat epoch < int.nat (word.add epoch (U64 1))⌝ -∗ own_epoch γ (word.add epoch (U64 1)) -∗ own_config γ conf ={∅,⊤}=∗
      (∀ conf_sl, is_slice_small conf_sl uint64T 1 conf -∗ Φ (#(LitInt (word.add epoch (U64 1))), slice_val conf_sl)%V)
                                )
  ) -∗
  WP config.Clerk__GetEpochAndConfig #ck {{ Φ }}
.
Proof.
  iIntros "#Hck #HΦ".
  wp_call.
  wp_apply (wp_ref_of_zero).
  { done. }
  iIntros (reply_ptr) "Hreply".
  wp_pures.

  wp_forBreak.
  wp_pures.
  iNamed "Hck".

  wp_apply (wp_NewSlice).
  iIntros (dummy_args) "Hargs".
  wp_loadField.
  iDestruct (is_slice_to_small with "Hargs") as "Hargs_sl".
  iNamed "Hhost".
  wp_apply (wp_Client__Call2 with "Hcl_rpc [] Hargs_sl Hreply").
  {
    iDestruct "Hhost" as "[$ _]".
  }
  {
    iModIntro.
    iNext.
    iIntros "Hlc".
    iMod ("HΦ" with "Hlc") as "Hupd".
    iModIntro.
    iDestruct "Hupd" as (??) "(H1&H2&Hupd)".
    iExists _, _.
    iFrame "H1 H2".
    iIntros.
    iMod ("Hupd" with "[% //] [$] [$]") as "Hupd".
    iModIntro.
    iIntros (??) "%Hconf_enc %Henc Hargs_sl".
    iIntros (?) "Hrep Hrep_sl".
    wp_pures.
    iRight.
    iModIntro.
    iSplitR; first done.
    wp_pures.
    wp_apply (wp_ref_of_zero).
    { done. }
    iIntros (epoch_ptr) "Hepoch".
    wp_pures.
    wp_load.
    rewrite Henc.
    wp_apply (wp_ReadInt with "Hrep_sl").
    iIntros (rep_sl1) "Hrep_sl".
    wp_pures.
    wp_store.
    wp_store.
    wp_load.
    wp_apply (Config.wp_Decode with "[$Hrep_sl]").
    { done. }
    iIntros (?) "Hconf_own".
    wp_pures.
    wp_load.
    wp_pures.
    iModIntro.
    iApply "Hupd".
    iFrame.
  }
  {
    iIntros (err) "%Herr Hargs_sl Hrep".
    wp_pures.
    wp_if_destruct.
    {
      exfalso. done.
    }
    iLeft.
    iModIntro.
    iSplitR; first done.
    iFrame.
  }
Qed.

Lemma wp_Clerk__GetConfig (ck:loc) γ Φ :
  is_Clerk ck γ -∗
  □ (£ 1 ={⊤,∅}=∗ ∃ conf, own_config γ conf ∗ (own_config γ conf ={∅,⊤}=∗
      (∀ conf_sl, is_slice_small conf_sl uint64T 1 conf -∗ Φ (slice_val conf_sl)%V)
                                )
  ) -∗
  WP config.Clerk__GetConfig #ck {{ Φ }}
.
Proof.
  iIntros "#Hck #HΦ".
  wp_call.
  wp_apply (wp_ref_of_zero).
  { done. }
  iIntros (reply_ptr) "Hreply".
  wp_pures.

  wp_forBreak.
  wp_pures.
  iNamed "Hck".

  wp_apply (wp_NewSlice).
  iIntros (dummy_args) "Hargs".
  wp_loadField.
  iDestruct (is_slice_to_small with "Hargs") as "Hargs_sl".
  iNamed "Hhost".
  wp_apply (wp_Client__Call2 with "Hcl_rpc [] Hargs_sl Hreply").
  {
    iDestruct "Hhost" as "[_ [$ _]]".
  }
  {
    iModIntro.
    iNext.
    iIntros "Hlc".
    iMod ("HΦ" with "Hlc") as "Hupd".
    iModIntro.
    iDestruct "Hupd" as (?) "(H1&Hupd)".
    iExists _.
    iFrame "H1".
    iIntros.
    iMod ("Hupd" with "[$]") as "Hupd".
    iModIntro.
    iIntros (?) "%Henc_rep Hargs".
    iIntros (?) "Hrep Hrep_sl".
    wp_pures.
    iRight.
    iModIntro.
    iSplitR; first done.
    wp_pures.
    wp_load.
    wp_apply (Config.wp_Decode with "[$Hrep_sl]").
    { done. }
    iIntros (?) "Hconf_own".
    wp_pures.
    iModIntro.
    iApply "Hupd".
    iFrame.
  }
  {
    iIntros (err) "%Herr Hargs_sl Hrep".
    wp_pures.
    wp_if_destruct.
    {
      exfalso. done.
    }
    iLeft.
    iModIntro.
    iSplitR; first done.
    iFrame.
  }
Qed.

Lemma wp_Clerk__WriteConfig (ck:loc) new_conf new_conf_sl epoch γ Φ :
  is_Clerk ck γ -∗
  is_slice_small new_conf_sl uint64T 1 new_conf -∗
  □ (£ 1 -∗ |={⊤,∅}=> ∃ latest_epoch, own_epoch γ latest_epoch ∗
      if (decide (latest_epoch = epoch)) then
        ∃ conf, own_config γ conf ∗ (own_config γ new_conf -∗ own_epoch γ epoch ={∅,⊤}=∗
                                      is_slice_small new_conf_sl uint64T 1 new_conf -∗
                                            Φ #0)
      else
        (own_epoch γ latest_epoch ={∅,⊤}=∗ (∀ (err:u64), ⌜err ≠ 0⌝ →
                                                         is_slice_small new_conf_sl uint64T 1 new_conf -∗
                                                         Φ #err))
  ) -∗
  (∀ (err:u64) , ⌜err ≠ 0⌝ → is_slice_small new_conf_sl uint64T 1 new_conf -∗ Φ #err) -∗
  WP config.Clerk__WriteConfig #ck #epoch (slice_val new_conf_sl)
  {{ Φ }}
.
Proof.
  iIntros "#Hck Hconf_sl #HΦ Hfail".
  wp_call.
  wp_apply (wp_ref_of_zero).
  { done. }
  iIntros (reply_ptr) "Hreply".
  wp_pures.

  wp_pures.
  iNamed "Hck".
  wp_apply (wp_slice_len).
  wp_apply (wp_NewSliceWithCap).
  { apply encoding.unsigned_64_nonneg. }
  iIntros (?) "Hargs_sl".
  wp_apply (wp_ref_to).
  { done. }
  iIntros (args_ptr) "Hargs".
  wp_pures.

  wp_load.
  wp_apply (wp_WriteInt with "Hargs_sl").
  iIntros (args_sl) "Hargs_sl".
  wp_store.
  wp_apply (Config.wp_Encode with "Hconf_sl").
  iIntros (enc_new_conf enc_new_conf_sl) "(%Henc_new_conf & Hconf & Henc_conf_sl)".
  wp_load.
  iDestruct (is_slice_to_small with "Henc_conf_sl") as "Henc_conf_sl".
  wp_apply (wp_WriteBytes with "[$Hargs_sl $Henc_conf_sl]").
  iIntros (args_sl2) "[Hargs_sl Henc_conf_sl]".
  replace (int.nat 0%Z) with 0%nat by word.
  wp_store.

  wp_apply (wp_frame_wand with "Hconf").

  wp_load.
  wp_loadField.
  iDestruct (is_slice_to_small with "Hargs_sl") as "Hargs_sl".
  iNamed "Hhost".
  wp_apply (wp_Client__Call2 with "Hcl_rpc [] Hargs_sl Hreply").
  {
    iDestruct "Hhost" as "[_ [_ [$ _]]]".
  }
  {
    iModIntro.
    iNext.
    iExists _, _, _.
    iSplitR; first done.
    iSplitR; first done.
    iIntros "Hlc".
    iMod ("HΦ" with "Hlc") as "Hupd".
    iModIntro.
    iDestruct "Hupd" as (?) "(H1 & Hupd)".
    iExists _.
    iFrame "H1".
    destruct (decide (_)).
    {
      iDestruct "Hupd" as (?) "[H1 Hupd]".
      iExists _.
      iFrame "H1".
      iIntros "H1 H2".
      iMod ("Hupd" with "H1 H2") as "Hupd".
      iModIntro.
      iIntros (?) "%Henc_rep Hargs_sl".
      iIntros (?) "Hrep Hrep_sl".
      wp_pures.
      wp_load.
      rewrite Henc_rep.
      wp_apply (wp_ReadInt with "Hrep_sl").
      iIntros (?) "_".
      wp_pures.
      iModIntro.
      iIntros "Hconf".
      iApply "Hupd".
      iFrame.
    }
    {
      iIntros "H1".
      iMod ("Hupd" with "H1") as "Hupd".
      iModIntro.
      iIntros (err Herr_nz reply Henc_rep) "Hargs_sl".
      iIntros (?) "Hrep Hrep_sl".
      wp_pures.
      wp_load.
      rewrite Henc_rep.
      wp_apply (wp_ReadInt with "Hrep_sl").
      iIntros (?) "_".
      wp_pures.
      iModIntro.
      iIntros.
      iApply "Hupd".
      { done. }
      { iFrame. }
    }
  }
  {
    iIntros (err) "%Herr_nz Hargssl Hrep".
    wp_pures.
    wp_if_destruct.
    {
      exfalso. done.
    }
    iModIntro.
    iIntros.
    iApply "Hfail".
    { done. }
    done.
  }
Qed.

Definition makeConfigServer_pre γ conf : iProp Σ := own_epoch γ 0 ∗ own_config γ conf.

Lemma wp_MakeServer γ conf_sl conf :
  {{{
        makeConfigServer_pre γ conf ∗
        is_slice_small conf_sl uint64T 1 conf
  }}}
    config.MakeServer (slice_val conf_sl)
  {{{
        (s:loc), RET #s; is_Server s γ
  }}}.
Proof.
  iIntros (Φ) "([Hepoch Hconf] & Hconf_sl) HΦ".
  wp_call.
  wp_apply (wp_allocStruct).
  { Transparent slice.T. repeat econstructor. Opaque slice.T. }
  iIntros (s) "Hs".
  iDestruct (struct_fields_split with "Hs") as "HH".
  iNamed "HH".
  simpl.
  wp_pures.
  wp_apply (wp_new_free_lock).
  iIntros (mu) "Hmu_inv".
  wp_storeField.
  wp_storeField.
  wp_storeField.
  iMod (readonly_alloc_1 with "mu") as "#Hmu".
  iApply "HΦ".
  iExists _.
  iMod (alloc_lock with "Hmu_inv [Hepoch Hconf epoch config Hconf_sl]") as "$".
  {
    iNext.
    iExists _, _, _.
    iFrame.
  }
  iFrame "Hmu".
  done.
Qed.

Lemma wp_Server__Serve s γ host :
  is_host host γ -∗ is_Server s γ -∗
  {{{
        True
  }}}
    config.Server__Serve #s #host
  {{{
        RET #(); True
  }}}.
Proof.
  iIntros "#Hhost #His_srv !#" (Φ) "_ HΦ".
  wp_call.

  wp_apply (map.wp_NewMap).
  iIntros (handlers) "Hhandlers".

  wp_pures.
  wp_apply (wp_Server__GetEpochAndConfig).
  { done. }
  iIntros (getEpochFn) "#HgetEpochSpec".
  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_pures.
  wp_apply (wp_Server__GetConfig).
  { done. }
  iIntros (getFn) "#HgetSpec".
  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_pures.
  wp_apply (wp_Server__WriteConfig).
  { done. }
  iIntros (writeConfigFn) "#HwriteSpec".
  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_apply (urpc_proof.wp_MakeServer with "Hhandlers").
  iIntros (r) "Hr".
  wp_pures.

  iNamed "Hhost".
  wp_apply (wp_StartServer2 with "[$Hr]").
  {
    set_solver.
  }
  {
    iDestruct "Hhost" as "(H1&H2&H3&Hhandlers)".
    unfold handlers_complete.
    repeat rewrite dom_insert_L.
    rewrite dom_empty_L.
    iSplitL "".
    {
      iExactEq "Hhandlers".
      f_equal.
      set_solver.
    }

    iApply (big_sepM_insert_2 with "").
    {
      iExists _; iFrame "#".
    }
    iApply (big_sepM_insert_2 with "").
    {
      iExists _; iFrame "#".
    }
    iApply (big_sepM_insert_2 with "").
    {
      iExists _; iFrame "#".
    }
    by iApply big_sepM_empty.
  }
  wp_pures.
  by iApply "HΦ".
Qed.

End config_proof.

(*
  handler_spec γ.(urpc_gn) host (U64 0) (GetEpochAndConfig_spec γ) ∗
  handler_spec γ.(urpc_gn) host (U64 1) (GetConfig_spec γ) ∗
  handler_spec γ.(urpc_gn) host (U64 2) (WriteConfig_spec γ) ∗
  handlers_dom γ.(urpc_gn) {[ (U64 0) ; (U64 1) ; (U64 2)]}
*)

Section config_init.

Context `{!configG Σ}.
Context `{!gooseGlobalGS Σ}.

Definition config_spec_list γ :=
  [ (U64 0, GetEpochAndConfig_spec γ) ;
    (U64 1, GetConfig_spec γ) ;
    (U64 2, WriteConfig_spec γ)].

Lemma config_ghost_init conf :
  ⊢ |==> ∃ γ,
    makeConfigServer_pre γ conf ∗
    own_epoch γ 0 ∗ own_config γ conf.
Proof.
  iMod (mono_nat_own_alloc 0) as (γepoch) "[[Hepoch Hepoch2] _]".
  iMod (ghost_var_alloc conf) as (γconf) "[Hconf Hconf2]".
  iExists {| epoch_gn := _ ; config_val_gn:= _ |}.
  iModIntro.
  iFrame.
Qed.

Lemma config_server_init host γ :
  host c↦ ∅ ={⊤}=∗
  is_host host γ.
Proof.
  iIntros "Hchan".
  iMod (handler_is_init_list2 host (config_spec_list γ) with "Hchan") as (γrpc) "H".
  { simpl. set_solver. }
  iModIntro.
  iExists γrpc.
  simpl.
  iDestruct "H" as "(H1 & $ & $ & $ & _)".
  iExactEq "H1".
  f_equal.
  set_solver.
Qed.

End config_init.


Require Import CoqlibC Maps Integers AST Linking.
Require Import ValuesC Memory Events Globalenvs Smallstep.
Require Import Op Registers RTLC Conventions Tailcall.
Require Import sflib.
(** newly added **)
Require Export Tailcallproof.
Require Import Simulation.
Require Import Skeleton Mod ModSem SimMod SimModSem SimSymb SimMem AsmregsC MatchSimModSem.
Require SimMemExt.
Require SoundTop.

Set Implicit Arguments.

Section SIMMODSEM.

Variable skenv_link: SkEnv.t.
Variable sm_link: SimMem.t.
Variables prog tprog: program.
Let md_src: Mod.t := (RTLC.module prog).
Let md_tgt: Mod.t := (RTLC.module tprog).
Hypothesis (INCLSRC: SkEnv.includes skenv_link (Mod.sk md_src)).
Hypothesis (INCLTGT: SkEnv.includes skenv_link (Mod.sk md_tgt)).
Hypothesis (WF: SkEnv.wf skenv_link).

Hypothesis TRANSL: match_prog prog tprog.
Let ge := (SkEnv.revive (SkEnv.project skenv_link (Mod.sk md_src)) prog).
Let tge := (SkEnv.revive (SkEnv.project skenv_link (Mod.sk md_tgt)) tprog).
Definition msp: ModSemPair.t := ModSemPair.mk (md_src skenv_link) (md_tgt skenv_link) (SimSymbId.mk md_src md_tgt) sm_link.

Inductive match_states
          (idx: nat) (st_src0: RTL.state) (st_tgt0: RTL.state) (sm0: SimMem.t): Prop :=
| match_states_intro
    (MATCHST: Tailcallproof.match_states st_src0 st_tgt0)
    (MCOMPATSRC: (get_mem st_src0) = sm0.(SimMem.src))
    (MCOMPATTGT: (get_mem st_tgt0) = sm0.(SimMem.tgt))
    (MCOMPATIDX: idx = Tailcallproof.measure st_src0).

Theorem make_match_genvs :
  SimSymbId.sim_skenv (SkEnv.project skenv_link (Mod.sk md_src))
                      (SkEnv.project skenv_link (Mod.sk md_tgt)) ->
  Genv.match_genvs (match_globdef (fun cu f tf => tf = transf_fundef f) eq prog) ge tge.
Proof. subst_locals. eapply SimSymbId.sim_skenv_revive; eauto. Qed.

Let SEGESRC: senv_genv_compat skenv_link ge. Proof. eapply SkEnv.senv_genv_compat; et. Qed.
Let SEGETGT: senv_genv_compat skenv_link tge. Proof. eapply SkEnv.senv_genv_compat; et. Qed.

Theorem sim_modsem: ModSemPair.sim msp.
Proof.
  eapply match_states_sim with (match_states := match_states)
                               (match_states_at := fun _ _ => eq);
    eauto; ii; ss.
  - eapply Nat.lt_wf_0.
  - eapply SoundTop.sound_state_local_preservation.
  - (* init bsim *)
    destruct sm_arg; ss. clarify.
    inv INITTGT. inv SIMARGS; ss. clarify.
    exploit make_match_genvs; eauto. { apply SIMSKENV. } intro SIMGE. des.
    eexists. eexists (SimMemExt.mk _ _). esplits; eauto.
    + econs; eauto; ss.
      * inv TYP. rpapply match_states_call; eauto.
        { econs; eauto. }
        { eapply lessdef_list_typify_list; try apply VALS; eauto. rewrite <- LEN.
          symmetry. eapply lessdef_list_length; eauto. }
        folder. inv SAFESRC. inv TYP.
        exploit (Genv.find_funct_match_genv SIMGE); eauto. i; des. ss. folder. des_ifs.
        inv FPTR; ss. unfold transf_function in *. des_ifs.
  - (* init progress *)
    des. inv SAFESRC. inv SIMARGS; ss. inv FPTR; ss.
    exploit make_match_genvs; eauto. { apply SIMSKENV. } intro SIMGE.
    exploit (Genv.find_funct_match_genv SIMGE); eauto. i; des. ss. folder. des_ifs.
    inv TYP. erewrite <- (sig_preserved fd) in *. esplits; eauto. econs; eauto.
    + econs; eauto. erewrite <- lessdef_list_length; eauto.
    + erewrite <- lessdef_list_length; eauto.
  - (* call wf *)
    inv MATCH; ss. destruct sm0; ss. clarify. u in CALLSRC. des. inv CALLSRC. inv MATCHST; ss.
  - (* call fsim *)
    inv MATCH; ss. destruct sm0; ss. clarify. inv CALLSRC. inv MATCHST; ss.
    folder. esplits; eauto.
    + econs; eauto.
      * folder. des. r in TRANSL. r in TRANSL.
        exploit (SimSymbId.sim_skenv_revive TRANSL); eauto.
        { apply SIMSKENV. }
        intro GE. apply (fsim_external_funct_id GE); ss.
        folder. inv FPTR; ss.
      * des. esplits; eauto. eapply SimSymb.simskenv_func_fsim; eauto; ss.
    + econs; ss; eauto.
    + ss.
  - (* after fsim *)
    inv AFTERSRC. inv SIMRET; ss. exists sm_ret. destruct sm_ret; ss. clarify.
    inv MATCH; ss. inv MATCHST; ss. esplits; econs; ss; eauto.
    + econs; ss; eauto. eapply lessdef_typify; ss.
  - (* final fsim *)
    inv MATCH. inv FINALSRC; inv MATCHST; ss. inv H2. destruct sm0; ss. clarify.
    eexists (SimMemExt.mk _ _). esplits; ss; eauto. econs; eauto.
  - left; i. esplits; eauto.
    { apply modsem_receptive; et. }
    inv MATCH. ii. hexploit (@transf_step_correct prog skenv_link); eauto.
    { inv SIMSKENV. ss. }
    { apply make_match_genvs; eauto. apply SIMSKENV. }
    i; des.
    + esplits; eauto.
      * left. apply plus_one. ss. unfold DStep in *. des; ss. esplits; eauto. apply modsem_determinate; et.
      * instantiate (1:= (SimMemExt.mk _ _)). ss.
    + esplits; eauto.
      * right. subst tr. split. econs. eauto.
      * instantiate (1:= (SimMemExt.mk _ _)). ss.
Unshelve.
  all: ss. apply msp.
Qed.

End SIMMODSEM.

Section SIMMOD.

Variables prog tprog: program.
Hypothesis TRANSL: match_prog prog tprog.

Definition mp: ModPair.t := SimSymbId.mk_mp (RTLC.module prog) (RTLC.module tprog).

Theorem sim_mod: ModPair.sim mp.
Proof.
  econs; ss.
  - r. eapply Sk.match_program_eq; eauto. ii. destruct f1; ss.
    + clarify. right. esplits; eauto. rewrite sig_preserved; et.
    + clarify. left. esplits; eauto.
  - ii. inv SIMSKENVLINK. eapply sim_modsem; eauto.
Qed.

End SIMMOD.


From stdpp Require Import finite vector.
From trace_program_logic.prelude Require Import finitary classical quantifiers.
From trace_program_logic.program_logic Require Import traces.
From aneris.prelude Require Import misc.
From aneris.prelude Require Import time.
From aneris.aneris_lang Require Import state_interp adequacy.
From aneris.aneris_lang Require Import tactics proofmode.
From aneris_examples.crdt.gcounter_convergence Require Import
     crdt_model crdt_resources crdt_runner vc.
From trace_program_logic.traces Require Import trace_properties.

Import InfListNotations.

Local Instance: ∀ gcdata st st', ProofIrrel (GCounterM gcdata st st').
Proof. intros ?????; apply ProofIrrelevance. Qed.

Lemma GcounterM_rel_finitary gcdata : aneris_model_rel_finitary (GCounterM gcdata).
Proof.
  intros st.
  apply finite_smaller_card_nat.
  apply (@in_list_finite
            _ _ (λ st', GCounterM gcdata st st') _
            (all_crdt_states_smaller (GClen gcdata) (vmap S (max_vc st)))).
  intros ? ?.
  apply elem_of_all_crdt_states_smaller.
  intros ?.
  apply crdt_next_bounded; done.
Qed.

Definition oloc_less_defined (ol ol' : option loc) : Prop :=
  match ol with
  | Some l =>
    match ol' with
    | Some l' => l' = l
    | None => False
    end
  | None => True
  end.

Global Instance oloc_less_defined_PO : PartialOrder oloc_less_defined.
Proof.
  constructor; first constructor.
  - intros []; split; auto.
  - intros [] [] [] [] []; split; intros; simplify_eq/=; eauto.
  - intros [] [] [] []; auto.
Qed.

Definition locs_less_defined (locs locs' : list (option loc)) : Prop :=
  Forall2 oloc_less_defined locs locs'.

Lemma locs_less_defined_lookup locs locs' i :
  locs_less_defined locs locs' → oloc_less_defined (locs !!! i) (locs' !!! i).
Proof.
  rewrite /locs_less_defined Forall2_lookup.
  intros Hlocs.
  specialize (Hlocs i).
  rewrite !list_lookup_total_alt.
  destruct (locs !! i); destruct (locs' !! i); inversion Hlocs; simplify_eq; done.
Qed.

Global Instance locs_less_defined_PO : PartialOrder locs_less_defined.
Proof.
  constructor; first constructor.
  - intros l; apply (_ : Reflexive (Forall2 _)).
  - intros l1 l2 l3; apply (_ : Transitive (Forall2 _)).
  - intros l1 l2; apply (_ : AntiSymm _ (Forall2 _)).
Qed.

Lemma locs_all_defined locs locs' :
  locs_less_defined (Some <$> locs) locs' → locs' = (Some <$> locs).
  intros Hld.
  apply list_eq; intros i.
  destruct (decide (i < length locs)) as [Hlt|Hnlt].
  - destruct (lookup_lt_is_Some_2 locs i) as [l Hl]; first done.
    destruct (lookup_lt_is_Some_2 locs' i) as [ol Hol].
    { erewrite <- (Forall2_length); last apply Hld.
      rewrite fmap_length; done. }
    apply (locs_less_defined_lookup _ _ i) in Hld.
    revert Hld.
    rewrite list_lookup_fmap list_lookup_total_fmap //.
    erewrite !list_lookup_total_correct; eauto.
    intros Hld.
    rewrite Hl Hol; simpl.
    destruct ol; simplify_eq/=; done.
  - rewrite list_lookup_fmap (lookup_ge_None_2 locs); last lia.
    rewrite lookup_ge_None_2; first done.
    erewrite <- (Forall2_length); last apply Hld.
    rewrite fmap_length; lia.
Qed.

Section crdt_main_rel.
  Context (gcdata : GCData).

  Implicit Types ex : execution_trace aneris_lang.
  Implicit Types iex : inf_execution_trace aneris_lang.
  Implicit Types atr : finite_trace (GCounterM gcdata) ().
  Implicit Types iatr : inflist (() * GCounterM gcdata).

  Notation ith_sa i := (gcd_addr_list gcdata !!! i).

  Definition loc_of_trace_i (i : nat) (evs : event_obs aneris_lang) : option loc :=
    match evs with
    | [] => None
    | ev :: evs' =>
      match expr_e ev.(post_expr) with
      | Val #(LitLoc l) => Some l
      | _ => None
      end
    end.

  Definition locs_of_trace_now (ex : execution_trace aneris_lang) : list (option loc) :=
    (λ i, loc_of_trace_i i (events_of_trace (allocEV (StringOfZ i)) ex) ) <$> seq 0 (GClen gcdata).

  Fixpoint locs_of_trace (ex : execution_trace aneris_lang) : finite_trace (list (option loc)) () :=
    match ex with
    | trace_singleton _ => {tr[replicate (GClen gcdata) None]}
    | trace_extend ex' _ c => (locs_of_trace ex') :tr[()]: (locs_of_trace_now ex)
    end.

  Lemma locs_of_trace_last ex :
    trace_last (locs_of_trace ex) = locs_of_trace_now ex.
  Proof.
    destruct ex; last done.
    rewrite /locs_of_trace_now.
    rewrite (const_fmap _ _ None); first by rewrite seq_length.
    intros ?; rewrite events_of_singleton_trace; done.
  Qed.

  Lemma locs_of_trace_now_length ex : length (locs_of_trace_now ex) = GClen gcdata.
  Proof. rewrite /locs_of_trace fmap_length seq_length; done. Qed.

  Lemma locs_of_trace_length ex : trace_forall (λ tr, length tr = GClen gcdata) (locs_of_trace ex).
  Proof.
    induction ex as [|ex IHex c]; simpl in *.
    - constructor. rewrite replicate_length //.
    - constructor; first done. apply locs_of_trace_now_length.
  Qed.

  Lemma locs_of_trace_now_extend_less_defined ex c oζ:
    valid_exec (ex :tr[oζ]: c) →
    locs_less_defined (locs_of_trace_now ex) (locs_of_trace_now (ex :tr[oζ]: c)).
  Proof.
    intros Hvl.
    apply Forall2_lookup; intros i.
    destruct (decide (i < GClen gcdata)); last first.
    { rewrite !lookup_ge_None_2; first by constructor.
      - rewrite locs_of_trace_now_length; lia.
      - rewrite locs_of_trace_now_length; lia. }
    rewrite !list_lookup_fmap !lookup_seq_lt //=; [].
    constructor.
    destruct (events_of_trace_extend_app (allocEV (StringOfZ i)) ex c oζ) as (evs & _ & Heq & _);
      first done.
    rewrite Heq.
    destruct (events_of_trace (allocEV (StringOfZ i)) ex); reflexivity.
  Qed.

  Lemma locs_of_trace_less_defined ex :
    valid_exec ex → trace_steps (λ x _ y, locs_less_defined x y) (locs_of_trace ex).
  Proof.
    induction ex as [|ex IHex c]; simpl; first by constructor.
    intros Hvl.
    econstructor; [done| |by apply IHex; eapply valid_exec_exec_extend_inv; eauto].
    rewrite locs_of_trace_last.
    apply locs_of_trace_now_extend_less_defined; done.
  Qed.

  Lemma locs_of_trace_now_lookup_singleton i ex ip lbl l v σ h :
    i < GClen gcdata →
    events_of_trace (allocEV (StringOfZ i)) ex = [allocObs ip lbl l v σ h] →
    locs_of_trace_now ex !! i = Some (Some l).
  Proof.
    intros Hi Hevs.
    rewrite /locs_of_trace list_lookup_fmap lookup_seq_lt /=; last done.
    rewrite /loc_of_trace_i Hevs; done.
  Qed.

  Lemma locs_of_trace_now_lookup_nil i ex :
    i < GClen gcdata →
    events_of_trace (allocEV (StringOfZ i)) ex = [] →
    locs_of_trace_now ex !! i = Some None.
  Proof.
    intros Hi Hevs.
    rewrite /locs_of_trace list_lookup_fmap lookup_seq_lt /=; last done.
    rewrite /loc_of_trace_i Hevs; done.
  Qed.

  Definition valid_model_fin_trace (mtr : finite_trace (GCounterM gcdata) ()) : Prop :=
    trace_forall valid_crdt_state mtr ∧ trace_steps (λ st _ st', st = st' ∨ CrdtNext st tt st') mtr.

  Definition gcounter_values_related_now (lcs : (list (option loc)))
             (c : cfg aneris_lang) (δ : GCounterM gcdata) : Prop :=
    ∀ i : fin (GClen gcdata),
       match lcs !!! (fin_to_nat i) with
       | Some l =>
         ∃ h, c.2.(state_heaps) !! (ip_of_address (ith_sa (fin_to_nat i))) = Some h ∧
              h !! l = Some (vector_clock_to_val (vec_to_list (δ !!! i)))
       | None => δ !!! i = vreplicate (GClen gcdata) 0
       end.

  Definition gcounter_values_related (locs : finite_trace (list (option loc)) ())
             (ex : execution_trace aneris_lang) (mtr : finite_trace (GCounterM gcdata) ()) : Prop :=
    trace_forall3 gcounter_values_related_now locs ex mtr.

  Definition gcounter_values_related_now_locs_resolved (lcs : (list loc))
             (c : cfg aneris_lang) (δ : GCounterM gcdata) : Prop :=
    ∀ i : fin (GClen gcdata),
      ∃ h, c.2.(state_heaps) !! (ip_of_address (ith_sa (fin_to_nat i))) = Some h ∧
           h !! (lcs !!! (fin_to_nat i)) = Some (vector_clock_to_val (vec_to_list (δ !!! i))).

  Lemma gcounter_values_related_now_resolve_locs locs c δ :
    length locs = GClen gcdata →
    gcounter_values_related_now (Some <$> locs) c δ →
    gcounter_values_related_now_locs_resolved locs c δ.
  Proof.
    intros Hlen Hvrel i.
    specialize (Hvrel i).
    rewrite list_lookup_total_fmap in Hvrel; [done|by rewrite Hlen; apply fin_to_nat_lt].
  Qed.

  Definition gcounter_monotone (locs : finite_trace (list (option loc)) ())
             (ex : execution_trace aneris_lang) : Prop :=
    trace_steps2
       (λ lcs c _ _ lcs' c',
          ∀ i, i < GClen gcdata →
               match lcs !!! i with
               | Some l =>
                 match lcs' !!! i with
                 | Some l' =>
                   l' = l ∧
                   ∃ h h' (vc vc' : vector_clock (GClen gcdata)),
                      c.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h ∧
                      c'.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h' ∧
                      h !! l = Some (vector_clock_to_val vc) ∧
                      h' !! l = Some (vector_clock_to_val vc') ∧
                      vc_le vc vc'
                 | None => False
                 end
               | None => True
               end) locs ex.

  Definition gcounter_monotone_configs (lcs : list loc) (c c' : cfg aneris_lang) : Prop :=
    c = c' ∨
    ∀ i, i < GClen gcdata →
         ∃ h h' (vc vc' : vector_clock (GClen gcdata)),
            c.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h ∧
            c'.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h' ∧
            h !! (lcs !!! i) = Some (vector_clock_to_val vc) ∧
                 h' !! (lcs !!! i) = Some (vector_clock_to_val vc') ∧
                 vc_le vc vc'.

  Lemma gcounter_monotone_configs_vc_le lcs i c c' h h' (vc vc' : vector_clock (GClen gcdata)) :
    i < GClen gcdata →
    gcounter_monotone_configs lcs c c' →
    c.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h →
    c'.2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h' →
    h !! (lcs !!! i) = Some (vector_clock_to_val (vec_to_list vc)) →
    h' !! (lcs !!! i) = Some (vector_clock_to_val (vec_to_list vc')) →
    vc_le vc vc'.
  Proof.
    intros Hi Hgmc Hh Hh' Hvc Hvc'.
    destruct Hgmc as [<-|Hgmc].
    { simplify_eq.
      match goal with
      | Heq :  _ =  _ |- _ =>
        apply vec_to_list_inj2 in Heq; simplify_eq; done
      end. }
    specialize (Hgmc i Hi) as (?&?&?&?&?&?&?&?&?); simplify_eq.
    repeat
       match goal with
       | Heq :  _ =  _ |- _ =>
         apply vec_to_list_inj2 in Heq; simplify_eq
       end; done.
  Qed.

  Global Instance gcounter_monotone_configs_PreOrder lcs : PreOrder (gcounter_monotone_configs lcs).
  Proof.
    split.
    - by left.
    - intros c1 c2 c3 Hc12 Hc23.
      destruct Hc12 as [->|Hc12]; first done.
      destruct Hc23 as [<-|Hc23]; first by right.
      right.
      intros i Hi.
      destruct (Hc12 i Hi) as (h1&h2&vc1&vc2&?&?&?&?&?).
      destruct (Hc23 i Hi) as (h2'&h3&vc2'&vc3&?&?&?&?&?).
      simplify_eq/=.
      match goal with
       | Heq : _ =  _ |- _ =>
         apply vec_to_list_inj2 in Heq; simplify_eq
      end.
      eexists h1, h3, vc1, vc3; split_and!; [by eauto|by eauto|done|done|etrans; eauto].
  Qed.

  Definition gcounter_monotone_locs_resolved_simple
             (lcs : list loc) (l : list (cfg aneris_lang)) : Prop :=
    ∀ i c1 c2, l !! i = Some c1 → l !! (S i) = Some c2 → gcounter_monotone_configs lcs c1 c2.

  Definition gcounter_monotone_locs_resolved (lcs : list loc) (l : list (cfg aneris_lang)) : Prop :=
    ∀ i j c1 c2, i ≤ j → l !! i = Some c1 → l !! j = Some c2 → gcounter_monotone_configs lcs c1 c2.

  Lemma gcounter_monotone_locs_resolved_if_simple lcs l :
    gcounter_monotone_locs_resolved_simple lcs l → gcounter_monotone_locs_resolved lcs l.
  Proof.
    intros Hgms i j c1 c2 Hij Hi Hj.
    apply nat_le_sum in Hij as [k Hk].
    revert i j Hk c1 c2 Hi Hj.
    induction k as [|k IHk]; intros i j Hk c1 c2 Hi Hj.
    { assert (j = i) by lia; clear Hk; simplify_eq; reflexivity. }
    destruct (lookup_lt_is_Some_2 l (i + k)) as [c Hc].
    { apply lookup_lt_Some in Hj; lia. }
    etrans; first by apply (IHk i (i + k) eq_refl c1 c); auto.
    replace j with (S (i + k)) in Hj by lia.
    eapply Hgms; eauto.
  Qed.

  Lemma gcounter_monotone_resolve_locs lcs ex il l :
    length il = length l →
    length lcs = GClen gcdata →
    valid_exec (ex +trl+ l) →
    trace_last (locs_of_trace ex) = (Some <$> lcs) →
    trace_steps (λ x _ y, locs_less_defined x y) (locs_of_trace ex +trl+ il) →
    gcounter_monotone (locs_of_trace ex +trl+ il) (ex +trl+ l) →
    gcounter_monotone_locs_resolved lcs (trace_last ex :: map snd l).
  Proof.
    intros Hlen Hlcs Hvl Hld Hldl Hgms.
    apply gcounter_monotone_locs_resolved_if_simple.
    revert il Hlen Hvl Hld Hldl Hgms; induction l as [|[oζ c] l IHl] using rev_ind;
      intros il Hlen Hvl Hld Hldl Hgms.
    { intros i j c1 c2; rewrite list_lookup_singleton; done. }
    intros i c1 c2 Hi HSi.
    destruct il as [|[[] locs] il _] using rev_ind.
    { rewrite app_length /= in Hlen; lia. }
    rewrite -!trace_append_list_assoc /= in Hvl, Hgms, Hldl.
    assert (i < S (length l)).
    { cut (S i < length (trace_last ex :: map snd l ++ [c])).
      - rewrite /= app_length map_length /=; lia.
      - apply lookup_lt_is_Some_1; eauto.
        rewrite map_app in HSi. rewrite HSi; eauto. }
    rewrite map_app (lookup_app_l (_ :: _)) in Hi; last first.
    { list_simplifier. rewrite map_length //. }
    destruct (decide (i < length l)) as [Hlt|Hnlt].
    - rewrite /= map_app lookup_app_l in HSi; last by rewrite map_length.
      eapply (IHl il); [rewrite !app_length /= in Hlen| |done| | |by eauto|by eauto].
      + rewrite !Nat.add_1_r in Hlen. by injection Hlen.
      + eapply valid_exec_exec_extend_inv; eauto.
      + eapply trace_steps_step_inv in Hldl as [? ?]; done.
      + eapply trace_steps2_step_inv in Hgms as [? ?]; done.
    - assert (i = length l) as HSieq by lia.
      rewrite HSieq in HSi.
      rewrite map_app (lookup_app_r (_ :: _)) in HSi; last by rewrite /= map_length.
      rewrite /= map_length Nat.sub_diag in HSi; simplify_eq/=.
      apply trace_steps2_step_inv in Hgms as [_ Hgms].
      destruct Hgms as (? & ? & ?%last_eq_trace_ends_in & ?%last_eq_trace_ends_in & Hgms).
      simplify_eq.
      destruct l as [|[? c'] l _] using rev_ind.
      + assert (length il = 0) by by rewrite app_length /= in Hlen; lia.
        destruct il; last done.
        simplify_eq/=.
        rewrite Hld in Hgms.
        right; intros i Hi.
        specialize (Hgms i Hi).
        rewrite list_lookup_total_fmap in Hgms; last lia.
        destruct (locs !!! i); last done.
        destruct Hgms as [-> Hgms]; done.
      + rewrite -!trace_append_list_assoc /= in Hgms.
        rewrite app_length /= in Hi.
        rewrite map_app (lookup_app_r (_ ::_)) in Hi; last by rewrite /= map_length; lia.
        rewrite /= in Hi.
        replace (length l + 1 - S (length l)) with 0 in Hi by lia.
        simplify_eq/=.
        apply valid_exec_exec_extend_inv in Hvl as [Hvl _].
        apply locs_of_trace_less_defined in Hvl.
        apply trace_steps_step_inv in Hldl as [Hldl _].
        eapply trace_append_list_steps_rtc_nl in Hldl;
          [|apply trace_ends_in_last|apply trace_ends_in_last].
        revert Hldl; rewrite rt_rtc_same Hld; intros Hldl.
        right. intros i Hilen.
        apply (locs_less_defined_lookup _ _ i) in Hldl.
        rewrite list_lookup_total_fmap in Hldl; last lia.
        specialize (Hgms i Hilen).
        destruct (trace_last (locs_of_trace ex +trl+ il) !!! i) as [ol'|]; last done.
        simplify_eq/=.
        destruct (locs !!! i); last done.
        destruct Hgms as (-> & Hgms).
        by list_simplifier.
  Qed.

  Definition send_evs_rel (locs : list (option loc)) (ex : execution_trace aneris_lang) : Prop :=
    ∃ sevss,
       length sevss = GClen gcdata ∧
       ∀ i, i < GClen gcdata →
            ∃ sevs,
               sevss !! i = Some sevs ∧
               sendevs_valid sevs ∧
               match locs !!! i with
               | Some l =>
                 Forall2
                    (@send_events_correspond gcdata (ith_sa i) l)
                    (events_of_trace (sendonEV (ith_sa i)) ex)
                    sevs
               | None => events_of_trace (sendonEV (ith_sa i)) ex = [] ∧ sevs = []
               end.

  Definition send_evs_rel_locs_resolved
             (locs : list loc) (ex : execution_trace aneris_lang) : Prop :=
    ∃ sevss,
       length sevss = GClen gcdata ∧
       ∀ i, i < GClen gcdata →
            ∃ sevs,
               sevss !! i = Some sevs ∧
               sendevs_valid sevs ∧
               Forall2
                  (@send_events_correspond gcdata (ith_sa i) (locs !!! i))
                  (events_of_trace (sendonEV (ith_sa i)) ex)
                  sevs.

  Lemma send_evs_rel_resolve_locs locs ex :
    length locs = GClen gcdata →
    send_evs_rel (Some <$> locs) ex →
    send_evs_rel_locs_resolved locs ex.
  Proof.
    intros Hlen [sevss [? Hsevs]].
    exists sevss; split; first done.
    intros i Hi.
    specialize (Hsevs i Hi).
    setoid_rewrite list_lookup_total_fmap in Hsevs; [eauto|lia].
  Qed.

  Definition receive_evs_rel (locs : list (option loc)) (ex : execution_trace aneris_lang) : Prop :=
    ∃ revss,
       length revss = GClen gcdata ∧
       ∀ i, i < GClen gcdata →
            ∃ revs,
               revss !! i = Some revs ∧
               match locs !!! i with
               | Some l =>
                 Forall2 (rec_events_correspond (ith_sa i))
                         (events_of_trace (receiveonEV (ith_sa i)) ex) revs ∧
                 ∃ h (vc : vector_clock (GClen gcdata)),
                    (trace_last ex).2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h ∧
                    h !! l = Some (vector_clock_to_val vc) ∧
                 forall j rev, S j < length revs → revs !! j = Some rev → vc_le rev vc
               | None => events_of_trace (receiveonEV (ith_sa i)) ex = [] ∧ revs = []
               end.

  Definition receive_evs_rel_locs_resolved
             (locs : list loc) (ex : execution_trace aneris_lang) : Prop :=
    ∃ revss,
       length revss = GClen gcdata ∧
       ∀ i, i < GClen gcdata →
            ∃ revs,
               revss !! i = Some revs ∧
               Forall2 (rec_events_correspond (ith_sa i))
                         (events_of_trace (receiveonEV (ith_sa i)) ex) revs ∧
               ∃ h (vc : vector_clock (GClen gcdata)),
                  (trace_last ex).2.(state_heaps) !! (ip_of_address (ith_sa i)) = Some h ∧
                  h !! (locs !!! i) = Some (vector_clock_to_val vc) ∧
                  forall j rev, S j < length revs → revs !! j = Some rev → vc_le rev vc.

  Lemma receive_evs_rel_resolve_locs locs ex :
    length locs = GClen gcdata →
    receive_evs_rel (Some <$> locs) ex →
    receive_evs_rel_locs_resolved locs ex.
  Proof.
    intros Hlen [revss [? Hrevs]].
    exists revss; split; first done.
    intros i Hi.
    specialize (Hrevs i Hi).
    setoid_rewrite list_lookup_total_fmap in Hrevs; [eauto|lia].
  Qed.

  Definition crdt_main_rel (ex: execution_trace aneris_lang)
             (mtr : auxiliary_trace (@aneris_AS (GCounterM gcdata))) : Prop :=
    valid_exec ex ∧
    valid_model_fin_trace mtr ∧
    gcounter_values_related (locs_of_trace ex) ex mtr ∧
    send_evs_rel (trace_last (locs_of_trace ex)) ex ∧
    receive_evs_rel (trace_last (locs_of_trace ex)) ex.

  Lemma crdt_main_rel_monotone ex mtr :
    crdt_main_rel ex mtr → gcounter_monotone (locs_of_trace ex) ex.
  Proof.
    intros (Hvl & Hmvl & Hvrel & _).
    revert mtr Hvl Hmvl Hvrel.
    induction ex as [|ex IHex c]; simpl;
      intros mtr Hvl Hmvl Hvrel; first by apply trace_steps2_singleton.
    econstructor; [done|done| |]; last first.
    { apply trace_forall3_extend_inv_l in Hvrel as (? & ? & ? & mtr' & ? & [] & ? & ? & ? & ?); simplify_eq.
       eapply IHex; [by eapply valid_exec_exec_extend_inv; eauto| |by eauto].
       destruct Hmvl as [[? ?]%trace_forall_extend_inv [? [??]]%trace_steps_step_inv]; done.
    }
    apply trace_forall3_extend_inv_l in Hvrel as (c' & ex' & st & mtr' & oζ & ? & ? & ? & Hrel1 & Hrel2);
      simplify_eq/=.
    apply trace_forall3_last in Hrel1.
    intros i Hi.
    specialize (Hrel1 (nat_to_fin Hi)).
    specialize (Hrel2 (nat_to_fin Hi)).
    rewrite locs_of_trace_last in Hrel1.
    rewrite locs_of_trace_last.
    rewrite !fin_to_nat_to_fin in Hrel1, Hrel2.
    destruct (locs_of_trace_now (ex' :tr[ oζ ]: c') !!! i) eqn:Heq; last first.
    { pose proof (locs_of_trace_now_extend_less_defined ex' c' _ Hvl) as Hld.
      apply (locs_less_defined_lookup _ _ i) in Hld.
      rewrite Heq in Hld.
      destruct (locs_of_trace_now ex' !!! i); done. }
    pose proof (locs_of_trace_now_extend_less_defined ex' c' _ Hvl) as Hld.
    apply (locs_less_defined_lookup _ _ i) in Hld.
    rewrite Heq in Hld.
    destruct (locs_of_trace_now ex' !!! i); simplify_eq/=; last done.
    split; first done.
    destruct Hrel1 as (h & Hh1 & Hh2).
    destruct Hrel2 as (h' & Hh'1 & Hh'2).
    eexists _, _, _, _; split_and!; [by eauto|by eauto|by eauto|by eauto|].
    destruct Hmvl as [_ Hmvl].
    apply trace_steps_step_inv in Hmvl as [_ (st' & -> & [->|Hmvl])]; first done.
    apply crdt_next_vc_le; done.
  Qed.

  Lemma crdt_main_rel_initially (ps : programs_using_gcounters gcdata) v :
    crdt_main_rel
       {tr[ ([{| expr_n := "system"; expr_e := runner gcdata 0 (progs ps) v |}],
             init_state gcdata) ]}
       {tr[ initial_crdt_state (GClen gcdata) ]}.
  Proof.
    rewrite /crdt_main_rel /=; split_and!.
    - constructor.
    - repeat constructor. apply valid_initial_crdt_state.
    - constructor; intros i.
      rewrite lookup_total_replicate_2; last by apply fin_to_nat_lt.
      rewrite vlookup_replicate; done.
    - exists (replicate (length (gcd_addr_list gcdata)) []).
      split; first by rewrite replicate_length.
      intros i Hi.
      exists []; split; first by rewrite lookup_replicate_2.
      split.
      { intros ????; rewrite lookup_nil; done. }
      rewrite lookup_total_replicate_2; last done.
      rewrite events_of_singleton_trace; done.
    - exists (replicate (length (gcd_addr_list gcdata)) []).
      split; first by rewrite replicate_length.
      intros i Hi.
      exists []; split; first by rewrite lookup_replicate_2.
      rewrite lookup_total_replicate_2; last done.
      rewrite events_of_singleton_trace; done.
  Qed.

  Lemma crdt_main_rel_step (ps : programs_using_gcounters gcdata) v ex
        (atr atr': auxiliary_trace (@aneris_AS (GCounterM gcdata))) ex' oζ ℓ:
    valid_system_trace ex atr →
    trace_contract ex oζ ex' →
    trace_contract atr ℓ atr' →
    crdt_main_rel ex' atr' →
    trace_starts_in ex
      ([{| expr_n := "system"; expr_e := runner gcdata 0 (progs ps) v |}], init_state gcdata) →
    trace_starts_in atr (initial_crdt_state (GClen gcdata)) →
    valid_state_evolution ex' atr' oζ ℓ (trace_last ex) (trace_last atr) →
    (∀ i : fin (length (gcd_addr_list gcdata)),
      match locs_of_trace_now ex !!! (fin_to_nat i) with
      | Some l =>
        ∃ h : heap,
          (trace_last ex).2.(state_heaps) !! ip_of_address (ith_sa (fin_to_nat i)) = Some h ∧
          h !! l = Some (vector_clock_to_val (vec_to_list ((trace_last atr) !!! i)))
      | None => (trace_last atr) !!! i = vreplicate (length (gcd_addr_list gcdata)) 0
     end) →
    send_evs_rel (locs_of_trace_now ex) ex →
    receive_evs_rel (locs_of_trace_now ex) ex →
    crdt_main_rel ex atr.
  Proof.
    intros Hvls [c ->] [δ ->] Hmrel Hex's Hatr's Hvse Hstrel Hsevsrel Hrevsrel; simpl in *.
    rewrite /crdt_main_rel /=; split_and!.
    - eapply valid_system_trace_valid_exec_trace; by eauto.
    - split.
      + constructor; first by apply Hmrel.
        destruct Hmrel as (_ & [Hvst _] & _).
        apply trace_forall_last in Hvst.
        destruct Hvse as [<-|]; first done.
        eapply CrdtNext_preserves_validity; done.
      + destruct Hmrel as (_ & [_ Hststep] & _).
        econstructor; [done | | done].
        destruct Hvse as [<-|]; by auto.
    - constructor; [by apply Hmrel|done].
    - done.
    - done.
  Qed.

  CoFixpoint locs_of_inf_trace
             (ex : execution_trace aneris_lang)
             (iex: inf_execution_trace aneris_lang) : inflist (() * list (option loc)) :=
    match iex with
    | []%inflist => []
    | ((oζ, c) :: iex')%inflist =>
      (tt, (locs_of_trace_now (ex :tr[oζ]: c))) :: locs_of_inf_trace (ex :tr[oζ]: c) iex'
    end.

  Lemma locs_of_inf_trace_take ex iex n :
    ((locs_of_trace ex) +trl+ (inflist_take n (locs_of_inf_trace ex iex))) =
    locs_of_trace (ex +trl+ (inflist_take n iex)).
  Proof.
    revert ex iex; induction n as [|n IHn]; intros ex iex; simpl; first done.
    destruct iex as [|[??]?]; simpl; first done.
    rewrite -IHn; done.
  Qed.

  Lemma locs_of_inf_trace_length ex iex : inflist_same_length (locs_of_inf_trace ex iex) iex.
  Proof.
    intros n.
    revert ex iex.
    induction n; simpl; intros ex iex.
    - rewrite (inflist_unfold_fold (locs_of_inf_trace ex iex)).
      destruct iex as [|[??]?]; simpl; done.
    - destruct iex as [|[??]?]; done.
  Qed.

  Lemma locs_of_inf_trace_cons_inv ex iex lcs ilocs:
    locs_of_inf_trace ex iex = (lcs :: ilocs)%inflist →
    ∃ oζ c iex',
       iex = ((oζ, c):: iex')%inflist ∧
       lcs = (tt, locs_of_trace_now (ex :tr[oζ]: c)) ∧
       ilocs = locs_of_inf_trace (ex :tr[oζ]: c) iex'.
  Proof.
    rewrite (inflist_unfold_fold (locs_of_inf_trace ex iex)).
    destruct iex as [|[??]?]; simpl; first done.
    intros; simplify_eq; eauto 10.
  Qed.

  Lemma locs_of_inf_trace_less_defined ex iex :
    valid_inf_exec ex iex →
    always
       (λ locs ilocs, trace_steps (λ x _ y, locs_less_defined x y) locs)
       (locs_of_trace ex) (locs_of_inf_trace ex iex).
  Proof.
    intros Hvex.
    apply always_take_drop; intros n.
    rewrite locs_of_inf_trace_take.
    apply locs_of_trace_less_defined.
    eapply valid_inf_exe_valid_exec.
    apply valid_inf_exe_take_drop; done.
  Qed.

  Definition crdt_main_rel_ternary
             (locs : finite_trace (list (option loc)) ()) (ex: execution_trace aneris_lang)
             (mtr : finite_trace (GCounterM gcdata) ())
             (ilocs : inflist (() * list (option loc))) (iex: inf_execution_trace aneris_lang)
             (imtr : inflist (() * GCounterM gcdata)) : Prop :=
    valid_exec ex ∧
    valid_model_fin_trace mtr ∧
    gcounter_values_related locs ex mtr ∧
    send_evs_rel (trace_last locs) ex ∧
    receive_evs_rel (trace_last locs) ex.

  Lemma crdt_main_rel_ternary_crdt_main_rel ex mtr ilocs iex imtr :
    crdt_main_rel_ternary (locs_of_trace ex) ex mtr ilocs iex imtr → crdt_main_rel ex mtr.
  Proof. intros (?&?&?&?&?); split_and!; done. Qed.

  (* move *)
  Lemma valid_inf_system_trace_take_drop n
        {Λ : language} {AS : AuxState Λ} (φ : execution_trace Λ → auxiliary_trace AS → Prop)
        (ex : execution_trace Λ) (atr : auxiliary_trace AS)
        (iex : inf_execution_trace Λ) (iatr : inf_auxiliary_trace AS) :
    valid_inf_system_trace φ ex atr iex iatr →
    valid_inf_system_trace φ
      (ex +trl+ inflist_take n iex) (atr +trl+ inflist_take n iatr)
      (inflist_drop n iex) (inflist_drop n iatr).
  Proof.
    revert ex atr iex iatr.
    induction n as [|n IHn]; first done.
    intros ex atr iex iatr Hvisf.
    inversion Hvisf; simplify_eq/=; first done.
    apply IHn; done.
  Qed.
  Lemma valid_inf_system_trace_length
        {Λ : language} {AS : AuxState Λ} (φ : execution_trace Λ → auxiliary_trace AS → Prop)
        (ex : execution_trace Λ) (atr : auxiliary_trace AS)
        (iex : inf_execution_trace Λ) (iatr : inf_auxiliary_trace AS) :
    valid_inf_system_trace φ ex atr iex iatr → inflist_same_length iex iatr.
  Proof.
    intros Hvisf n.
    apply (valid_inf_system_trace_take_drop n) in Hvisf.
    inversion Hvisf; simplify_eq/=; done.
  Qed.
  Lemma valid_inf_system_trace_mono
        {Λ : language} {AS : AuxState Λ} (φ ψ : execution_trace Λ → auxiliary_trace AS → Prop)
        (ex : execution_trace Λ) (atr : auxiliary_trace AS)
        (iex : inf_execution_trace Λ) (iatr : inf_auxiliary_trace AS) :
    (∀ (ex' : execution_trace Λ) (atr' : auxiliary_trace AS), φ ex' atr' → ψ ex' atr') →
    valid_inf_system_trace φ ex atr iex iatr → valid_inf_system_trace ψ ex atr iex iatr.
  Proof.
    revert ex atr iex iatr; cofix IH; intros ex atr iex iatr Hφψ Hφ.
    inversion Hφ; simplify_eq.
    - constructor; apply Hφψ; done.
    - econstructor; eauto.
  Qed.
  Lemma valid_inf_system_trace_rel
        {Λ : language} {AS : AuxState Λ} (φ : execution_trace Λ → auxiliary_trace AS → Prop)
        (ex : execution_trace Λ) (atr : auxiliary_trace AS)
        (iex : inf_execution_trace Λ) (iatr : inf_auxiliary_trace AS) :
    valid_inf_system_trace φ ex atr iex iatr → φ ex atr.
  Proof. inversion 1; done. Qed.

  Lemma crdt_main_rel_always_ternary
        (ex : execution_trace aneris_lang) (iex : inf_execution_trace aneris_lang)
        (atr : auxiliary_trace (@aneris_AS (GCounterM gcdata))) :
    valid_inf_exec ex iex →
    continued_simulation crdt_main_rel ex atr →
    ∃ imtr,
       always3
          crdt_main_rel_ternary
          (locs_of_trace ex) ex atr (locs_of_inf_trace ex iex) iex imtr.
  Proof.
    intros Hvl Hcs.
    pose proof (produced_inf_aux_trace_valid_inf _ _ Hcs iex Hvl) as Hvisf.
    exists (produce_inf_aux_trace ex atr Hcs iex Hvl).
    pose proof (valid_inf_system_trace_length _ _ _ _ _ Hvisf) as Hlen.
    apply (valid_inf_system_trace_mono _ crdt_main_rel) in Hvisf; last first.
    { apply continued_simulation_rel. }
    revert Hlen Hvisf.
    generalize (produce_inf_aux_trace ex atr Hcs iex Hvl); intros iatr.
    clear Hcs.
    revert ex iex atr iatr Hvl.
    cofix IH; intros ex iex atr iatr Hvl Hlen Hvisf.
    constructor; [| | |].
    - apply valid_inf_system_trace_rel in Hvisf; done.
    - apply locs_of_inf_trace_length.
    - eapply inflist_same_length_trans; done.
    - simpl.
      intros ?????????
             (?&?&?&?&?&?)%locs_of_inf_trace_cons_inv
             -> ->; simplify_eq.
      apply (IH (_ :tr[_]: _)).
      + apply traces.valid_inf_exec_adjust; done.
      + rewrite -inflist_same_length_cons; done.
      + apply (valid_inf_system_trace_take_drop 1) in Hvisf; done.
  Qed.

  Lemma eventually_sent_eventually_exists_loc_one i ex iex mtr imtr :
    i < GClen gcdata →
    valid_inf_exec ex iex →
    eventually (λ ex' _, events_of_trace (sendonEV (ith_sa i)) ex' ≠ []) ex iex →
    always3 crdt_main_rel_ternary (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr →
    eventually3
       (always3 (λ locs _ _ _ _ _, ∃ l, (trace_last locs) !! i = Some (Some l)))
       (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr.
  Proof.
    intros Hi Hvex Hev Hal.
    apply eventually_take_drop in Hev as [n Hev].
    assert ((always (λ ex' _, events_of_trace (sendonEV (ith_sa i)) ex' ≠ []))
               (ex +trl+ inflist_take n iex) (inflist_drop n iex)) as Hev'.
    { apply always_take_drop; intros k.
      destruct (events_of_trace_app
                   (sendonEV (ith_sa i))
                   (ex +trl+ inflist_take n iex)
                   (inflist_take k (inflist_drop n iex))) as (evs & ? & -> & _).
      { rewrite trace_append_list_assoc -inflist_take_add.
        eapply valid_inf_exe_valid_exec; eapply valid_inf_exe_take_drop; done. }
      intros []%app_eq_nil; simplify_eq. }
    clear Hev.
    apply eventually3_take_drop; exists n.
    split; last by eapply always3_inflist_same_length; eauto.
    apply (always3_unroll_n _ n) in Hal.
    apply always3_take_drop; intros k.
    split; last by eapply always3_inflist_same_length; eauto.
    apply (always3_unroll_n _ k), always3_holds in Hal.
    apply (always_unroll_n _ k), always_holds in Hev'.
    revert Hal Hev'.
    rewrite !trace_append_list_assoc -!inflist_take_add.
    intros Hal Hev.
    destruct Hal as (_&_&_& (sevss & Hlen & Hsevs) &_).
    specialize (Hsevs i Hi) as (sevs & ? & ? & Hlocs).
    rewrite list_lookup_total_alt in Hlocs.
    revert Hlocs.
    rewrite locs_of_inf_trace_take locs_of_trace_last.
    destruct (lookup_lt_is_Some_2 (locs_of_trace_now (ex +trl+ inflist_take (n + k) iex)) i)
      as [ol Hol].
    { rewrite locs_of_trace_now_length; done. }
    rewrite Hol; simpl.
    destruct ol; first by eauto.
    intros [? ?]; simplify_eq.
  Qed.

  Lemma eventually_sent_eventually_exists_loc_all ex iex mtr imtr :
    (∀ i, i < GClen gcdata →
          eventually (λ ex' _, events_of_trace (sendonEV (ith_sa i)) ex' ≠ []) ex iex) →
    valid_inf_exec ex iex →
    always3 crdt_main_rel_ternary (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr →
    eventually3
       (λ locs ex' mtr' ilocs' iex' imtr',
          ∀ (j : fin (S (GClen gcdata))),
             always3 (λ locs' ex'' mtr'' ilocs'' iex'' imtr'',
                      match fin_to_nat j with
                      | 0 => crdt_main_rel_ternary locs' ex'' mtr'' ilocs'' iex'' imtr''
                      | S k => ∃ l, (trace_last locs') !! k = Some (Some l)
                      end) locs ex' mtr' ilocs' iex' imtr')
       (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr.
  Proof.
    intros Hev Hvex Hal.
    apply eventually3_forall_combine.
    intros j.
    destruct (fin_to_nat j) as [|j'] eqn:Hj'.
    - pose proof (always3_inflist_same_length _ _ _ _ _ _ _ Hal) as [? ?].
      apply holds_eventually3; done.
    - assert (j' < GClen gcdata).
      { assert (S j' < S (GClen gcdata)) by by rewrite -Hj'; apply fin_to_nat_lt. lia. }
      apply eventually_sent_eventually_exists_loc_one; auto.
  Qed.

  Lemma eventually_sent_eventually_allocated_helper len locs ex mtr ilocs iex imtr :
  (∀ j : fin (S len),
     always3
       (λ locs' ex'' mtr'' ilocs'' iex'' imtr'',
          match fin_to_nat j with
          | 0 => crdt_main_rel_ternary locs' ex'' mtr'' ilocs'' iex'' imtr''
          | S k => ∃ l : loc, trace_last locs' !! k = Some (Some l)
        end) locs ex mtr ilocs iex imtr) →
  ∃ lcssg : {lcs : list loc | length lcs = len},
     take len (trace_last locs) = Some <$> `lcssg ∧
     always3 crdt_main_rel_ternary locs ex mtr ilocs iex imtr.
  Proof.
    intros Hex.
    induction len as [|n IHn].
    - exists (exist (λ l, length l = 0) (@nil loc) eq_refl).
      rewrite take_0 /=.
      split; first done.
      specialize (Hex 0%fin); done.
    - destruct IHn as [[lcs Hlcslen] [Hlcs1 Hlcs2]].
      { intros j.
        assert (fin_to_nat j < S (S n)) as Hlt.
        { etrans; first apply fin_to_nat_lt; lia. }
        specialize (Hex (nat_to_fin Hlt)).
        eapply always3_mono; last apply Hex.
        clear.
        rewrite fin_to_nat_to_fin; done. }
      assert (S n < S (S n)) as Hlt by lia.
      specialize (Hex (nat_to_fin Hlt)).
      apply always3_holds in Hex.
      rewrite fin_to_nat_to_fin in Hex.
      destruct Hex as [l Hl].
      assert (length (lcs ++ [l]) = S n) as Hlcslen'.
      { rewrite app_length Hlcslen; simpl; lia. }
      exists (exist _ (lcs ++ [l]) Hlcslen').
      split; last done.
      erewrite take_S_r; last by eauto.
      rewrite Hlcs1 fmap_app; simpl; done.
  Qed.

  Lemma eventually_sent_eventually_allocated_helper' locs ex mtr ilocs iex imtr :
    length (trace_last locs) = GClen gcdata →
  (∀ j : fin (S (GClen gcdata)),
     always3
       (λ locs' ex'' mtr'' ilocs'' iex'' imtr'',
          match fin_to_nat j with
          | 0 => crdt_main_rel_ternary locs' ex'' mtr'' ilocs'' iex'' imtr''
          | S k => ∃ l : loc, trace_last locs' !! k = Some (Some l)
        end) locs ex mtr ilocs iex imtr) →
  ∃ lcssg : {lcs : list loc | length lcs = GClen gcdata},
     trace_last locs = Some <$> `lcssg ∧
     always3 crdt_main_rel_ternary locs ex mtr ilocs iex imtr.
  Proof.
    intros Hlen Hex.
    rewrite -(firstn_all (trace_last locs)) Hlen.
    apply eventually_sent_eventually_allocated_helper; done.
  Qed.

  Lemma eventually_sent_eventually_allocated ex iex mtr imtr :
    (∀ i, i < GClen gcdata →
          eventually (λ ex' _, events_of_trace (sendonEV (ith_sa i)) ex' ≠ []) ex iex) →
    valid_inf_exec ex iex →
    always3 crdt_main_rel_ternary (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr →
    ∃ lcs : list loc,
       length lcs = GClen gcdata ∧
       eventually3
          (λ locs ex' mtr' ilocs' iex' imtr',
           (trace_last locs = Some <$> lcs) ∧
           always3 crdt_main_rel_ternary locs ex' mtr' ilocs' iex' imtr')
          (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr.
  Proof.
    intros Hev Hvex Hal.
    cut (∃ lcssg : {lcs : list loc | length lcs = GClen gcdata},
             eventually3
                (λ locs ex' mtr' ilocs' iex' imtr',
                 (trace_last locs = Some <$> `lcssg) ∧
                 always3 crdt_main_rel_ternary locs ex' mtr' ilocs' iex' imtr')
                (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr).
    { intros [[? ?] ?]; eauto. }
    apply eventually3_exists.
    epose proof (eventually_sent_eventually_exists_loc_all _ _ _ _ Hev Hvex Hal) as Hex.
    apply eventually3_take_drop in Hex as [n [Hex [Hilen1 Hilen2]]].
    apply eventually3_take_drop.
    exists n; split; last done.
    apply eventually_sent_eventually_allocated_helper'; last done.
    rewrite locs_of_inf_trace_take locs_of_trace_last locs_of_trace_now_length; done.
  Qed.

  Definition crdt_main_rel_locs_resolved (locs : list loc) (ex: execution_trace aneris_lang)
             (mtr : finite_trace (GCounterM gcdata) ())
             (iex: inf_execution_trace aneris_lang)
             (imtr : inflist (() * GCounterM gcdata))  : Prop :=
    valid_model_fin_trace mtr ∧
    gcounter_values_related_now_locs_resolved locs (trace_last ex) (trace_last mtr) ∧
    send_evs_rel_locs_resolved locs ex ∧
    receive_evs_rel_locs_resolved locs ex.

  Definition monotone_from_now_on locs ex iex :=
    (always (λ ex' _,
             ∃ l, ex' = ex +trl+ l ∧
                  gcounter_monotone_locs_resolved locs (trace_last ex :: map snd l)) ex iex).

  (* TODO: put in aneris *)

  Lemma monotone_from_now_on_unroll_n n locs ex iex :
    monotone_from_now_on locs ex iex →
    monotone_from_now_on locs (ex +trl+ inflist_take n iex) (inflist_drop n iex).
  Proof.
    intros Hfno.
    apply always_take_drop; intros m.
    apply (always_unroll_n _ n) in Hfno.
    apply (always_unroll_n _ m) in Hfno.
    apply always_holds in Hfno.
    destruct Hfno as [l [Hl Hgms]].
    rewrite Hl.
    rewrite !trace_append_list_assoc -!inflist_take_add in Hl.
    apply trace_append_list_inj2 in Hl.
    rewrite inflist_take_add in Hl.
    simplify_eq.
    eexists _; split.
    { rewrite !trace_append_list_assoc; done. }
    intros i j ?????.
    apply (Hgms (length (inflist_take n iex) + i) (length (inflist_take n iex) + j)).
    - lia.
    - destruct i as [|i]; simpl in *.
      + rewrite map_app (lookup_app_l (_ :: _)) /=; last by rewrite map_length /=; lia.
        rewrite Nat.add_0_r.
        rewrite trace_last_of_append_list_map //.
      + rewrite Nat.add_comm /= Nat.add_comm.
        rewrite map_app lookup_app_r; last by rewrite map_length; lia.
        rewrite map_length minus_plus; done.
    - destruct j as [|j]; simpl in *.
      + rewrite map_app (lookup_app_l (_ :: _)); last by rewrite /= map_length /=; lia.
        rewrite Nat.add_0_r.
        rewrite trace_last_of_append_list_map; done.
      + rewrite Nat.add_comm /= Nat.add_comm.
        rewrite map_app lookup_app_r; last by rewrite map_length; lia.
        rewrite map_length minus_plus; done.
  Qed.

  Definition closed_model_relation locs ex mtr iex imtr :=
    (monotone_from_now_on locs ex iex) ∧
    always2 (crdt_main_rel_locs_resolved locs) ex mtr iex imtr.

  Lemma eventually_sent_eventually_locs_resolved ex iex mtr imtr :
    (∀ i, i < GClen gcdata →
          eventually (λ ex' _, events_of_trace (sendonEV (ith_sa i)) ex' ≠ []) ex iex) →
    valid_inf_exec ex iex →
    always3 crdt_main_rel_ternary (locs_of_trace ex) ex mtr (locs_of_inf_trace ex iex) iex imtr →
    ∃ locs, length locs = GClen gcdata ∧ eventually2 (closed_model_relation locs) ex mtr iex imtr.
  Proof.
    intros Hev Hvl Hal3.
    edestruct (eventually_sent_eventually_allocated ex iex mtr imtr) as (locs & Hlocslen & Hal);
      [done|done|done|].
    exists locs; split; first done.
    apply eventually3_take_drop in Hal as [n [[Hex1 Hex2] [Hilen1 Hilen2]]].
    apply eventually2_take_drop.
    exists n; split; last done.
    split.
    - apply always_take_drop; intros k.
      apply (always3_unroll_n _ n), (always3_unroll_n _ k), always3_holds in Hal3.
      rewrite !trace_append_list_assoc -!inflist_take_add in Hal3.
      rewrite !locs_of_inf_trace_take in Hal3.
      apply crdt_main_rel_ternary_crdt_main_rel in Hal3.
      apply crdt_main_rel_monotone in Hal3.
      rewrite !inflist_take_add -!trace_append_list_assoc in Hal3.
      pose proof (locs_of_inf_trace_less_defined _ _ Hvl) as Hld.
      apply (always_unroll_n _ n), (always_unroll_n _ k), always_holds in Hld.
      eexists _; split; first reflexivity.
      eapply (gcounter_monotone_resolve_locs
                 locs
                 (ex +trl+ inflist_take n iex)
                 (inflist_take
                     k
                     (locs_of_inf_trace (ex +trl+ inflist_take n iex) (inflist_drop n iex)))).
      + apply inflist_take_of_same_length, locs_of_inf_trace_length.
      + done.
      + eapply valid_inf_exe_valid_exec.
        do 2 apply valid_inf_exe_take_drop; done.
      + rewrite -locs_of_inf_trace_take; done.
      + rewrite !locs_of_inf_trace_take.
        rewrite trace_append_list_assoc -inflist_take_add.
        rewrite trace_append_list_assoc in Hld.
        rewrite -inflist_take_add in Hld.
        rewrite !locs_of_inf_trace_take in Hld.
        done.
      + rewrite !locs_of_inf_trace_take. done.
    - apply always2_take_drop; intros k; split; last by apply inflist_same_length_drop.
      apply (always3_unroll_n _ k), always3_holds in Hex2.
      pose proof (locs_of_inf_trace_less_defined _ _ Hvl) as Hld.
      apply (always_unroll_n _ n), (always_unroll_n _ k), always_holds in Hld.
      eapply trace_append_list_steps_rtc_nl in Hld; [|done|done].
      revert Hld; rewrite rt_rtc_same.
      rewrite !trace_append_list_assoc -!inflist_take_add.
      rewrite !trace_append_list_assoc -!inflist_take_add in Hex2.
      intros Hld.
      apply locs_all_defined in Hld.
      destruct Hex2 as (_ & vmf & Hvrel%trace_forall3_last & Hsevs & Hrevs).
      rewrite Hld in Hvrel, Hrevs, Hsevs.
      split_and!.
      + done.
      + apply gcounter_values_related_now_resolve_locs; auto.
      + apply send_evs_rel_resolve_locs; auto.
      + apply receive_evs_rel_resolve_locs; auto.
  Qed.

End crdt_main_rel.