From iris.algebra Require Import auth excl csum gmap.
From iris_monotone Require Import monotone.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Import invariants.
From aneris.prelude Require Import gset_map.
From aneris.prelude Require Import time.
From aneris.aneris_lang Require Import network lang resources events.
From aneris.aneris_lang.lib.vector_clock Require Import vector_clock_proof.
From aneris_examples.crdt.gcounter_convergence Require Import crdt_code crdt_model vc.

Record GCData : Type := {
  gcd_addr_list : list socket_address;
  gcd_addr_list_NoDup_ips : NoDup (ip_of_address <$> gcd_addr_list);
  gcd_addr_list_nonSys : ∀ i sa, gcd_addr_list !! i = Some sa → ip_of_address sa ≠ "system";
}.

Lemma gcd_addr_list_NoDup gcdata : NoDup (gcd_addr_list gcdata).
Proof. eapply NoDup_fmap_1; apply gcdata. Qed.

Notation GClen gcdata := (length (gcd_addr_list gcdata)).

Canonical Structure vector_clockO n := leibnizO (vector_clock n).
Canonical Structure crdt_stateO n := leibnizO (crdt_state n).

Definition GCounterM gcdata : Model := model _ (λ x y, CrdtNext x tt y) (initial_crdt_state (GClen gcdata)).

Notation PrinGC c := (principal vc_le c).

Notation crdt_stateUR gcdata :=
  (authUR (gmapUR nat (@monotoneUR (vector_clockO (GClen gcdata)) vc_le))).
Notation crdt_locsUR := (authUR (gmapUR nat (csumR (exclR unitO) (agreeR (leibnizO loc))))).
Notation sendevO gcdata :=
  (prodO natO (prodO (vector_clockO (GClen gcdata)) (vector_clockO (GClen gcdata)))).
Notation crdt_sendEVUR gcdata := (authUR (gmapUR nat (exclR (listO (sendevO gcdata))))).
Notation crdt_recEVUR gcdata :=
  (authUR (gmapUR nat (exclR (listO (vector_clockO (GClen gcdata)))))).

Class GCounterG Σ (gcdata : GCData) := {
  GCG_view_monoΣ :> inG Σ (crdt_stateUR gcdata);
  GCG_locΣ :> inG Σ crdt_locsUR;
  GCG_sendEVΣ :> inG Σ (crdt_sendEVUR gcdata);
  GCG_recEVΣ :> inG Σ (crdt_recEVUR gcdata);
  GCG_vcs_name : gname;
  GCG_locs_name : gname;
  GCG_sendevs_name : gname;
  GCG_recevs_name : gname;
}.

Class GCounterPreG Σ (gcdata : GCData) := {
  GCPG_view_monoΣ :> inG Σ (crdt_stateUR gcdata);
  GCPG_locΣ :> inG Σ crdt_locsUR;
  GCPG_sendEVΣ :> inG Σ (crdt_sendEVUR gcdata);
  GCPG_recEVΣ :> inG Σ (crdt_recEVUR gcdata);
}.

Definition GCounterΣ (gcdata : GCData) :=
  #[GFunctor (crdt_stateUR gcdata); GFunctor crdt_locsUR;
   GFunctor (crdt_sendEVUR gcdata); GFunctor (crdt_recEVUR gcdata)].

Global Instance subG_GCounterPreG Σ gcdata : subG (GCounterΣ gcdata) Σ → GCounterPreG Σ gcdata.
Proof. constructor; solve_inG. Qed.

Section Resources.
  Context `{!anerisG (GCounterM gcdata) Σ, !GCounterG Σ gcdata}.

  Notation vector_clock := (vector_clock (GClen gcdata)).
  Notation crdt_state := (crdt_state (GClen gcdata)).

  Definition GCounters (st : crdt_state) : iProp Σ :=
    own (A := crdt_stateUR gcdata) GCG_vcs_name (● ((λ c, PrinGC c) <$> list_to_gmap id st)).

  Definition GCounterSnapShot (i : nat) (c : vector_clock) : iProp Σ :=
    own (A := crdt_stateUR gcdata) GCG_vcs_name (◯ {[i := PrinGC c]}).

  Definition oloc_to_one_shot (ol : option loc) : csum (excl unit) (agree loc) :=
    from_option (λ l, Cinr (to_agree l)) (Cinl (Excl ())) ol.

  Definition locations (l : list (option loc)) :=
    own (A:= crdt_locsUR) GCG_locs_name (● (list_to_gmap oloc_to_one_shot l)).

  Definition unallocated (i : nat) := own GCG_locs_name (◯ {[ i := Cinl (Excl ())]}).

  Definition allocated (i : nat) (l : loc) := own GCG_locs_name (◯ {[ i := Cinr (to_agree l)]}).

  Definition loc_coherence (i : nat) (ol : option loc) (vc : vector_clock) : iProp Σ :=
    match ol with
    | None => alloc_evs (StringOfZ i) [] ∗
              ⌜vc = (vreplicate (GClen gcdata) 0)⌝
    | Some l =>
        ∃ a,
          ⌜gcd_addr_list gcdata !! i = Some a⌝ ∗
          (∃ σ h, ⌜valid_allocObs (ip_of_address a) l σ h⌝ ∗
                   alloc_evs (StringOfZ i)
                   [allocObs (ip_of_address a) (StringOfZ i) l
                             (vector_clock_to_val (vreplicate (GClen gcdata) 0)) σ h]) ∗
          l ↦[ip_of_address a] (vector_clock_to_val vc)
    end.

  Definition locations_coherence (locs : list (option loc)) (st : crdt_state) : iProp Σ :=
    [∗ list] i ↦ ol; vc ∈ locs; st, loc_coherence i ol vc.

  Definition sendevs_auth (sevss : list (list (nat * (vector_clock * vector_clock)))) : iProp Σ :=
    own GCG_sendevs_name (● list_to_gmap Excl sevss).

  Definition sendevs_frag (i : nat) (sevs : list (nat * (vector_clock * vector_clock))) : iProp Σ :=
    own GCG_sendevs_name (◯ {[ i := Excl sevs ]}).

  Definition send_events_correspond (sa : socket_address) (l : loc)
             (ev : EventObservation aneris_lang)
             (sev : nat * (vector_clock * vector_clock)) : Prop :=
    ∃ sa' σ h sh skts skt r s,
      gcd_addr_list gcdata !! sev.1 = Some sa' ∧
      vc_is_ser (vector_clock_to_val sev.2.2) s ∧
      valid_sendonObs sa σ sh skts skt r ∧
      ev = sendonObs sa σ sh s sa' skt ∧
      σ.(state_heaps) !! (ip_of_address sa) = Some h ∧
      h !! l = Some (vector_clock_to_val sev.2.1).

  Definition sendevs_valid (sevss : list (nat * (vector_clock * vector_clock))) : Prop :=
    ∀ i j sev sev',
      sevss !! i = Some sev →
      j < i →
      sevss !! j = Some sev' →
      sev'.1 = sev.1 →
      vc_le sev'.2.1 sev.2.2.

  Definition sendev_coh (i : nat) (ol : option loc)
             (sevs : list (nat * (vector_clock * vector_clock))) : iProp Σ :=
    ∃ sa,
      ⌜gcd_addr_list gcdata !! i = Some sa⌝ ∧ ⌜sendevs_valid sevs⌝ ∧
      ([∗ list] sev ∈ sevs, GCounterSnapShot i sev.2.1) ∗
      match ol with
      | Some l => ∃ evs, sendon_evs sa evs ∗ ⌜Forall2 (send_events_correspond sa l) evs sevs⌝
      | None => sendon_evs sa [] ∧ ⌜sevs = []⌝
      end.

  Definition sendevs_coherence (locs : list (option loc))
             (sevss : list (list (nat * (vector_clock * vector_clock)))) : iProp Σ :=
    [∗ list] i ↦ ol; sevs ∈ locs; sevss, sendev_coh i ol sevs.

  Definition recevs_auth (evss : list (list vector_clock)) : iProp Σ :=
    own GCG_recevs_name (● list_to_gmap Excl evss).

  Definition recevs_frag (i : nat) (evs : list vector_clock) : iProp Σ :=
    own GCG_recevs_name (◯ {[ i := Excl evs ]}).

  Definition rec_events_correspond (sa : socket_address)
             (ev : EventObservation aneris_lang)
             (rev : vector_clock) : Prop :=
    ∃ σ sh skts skt msg r,
      vc_is_ser (vector_clock_to_val rev) (m_body msg) ∧
      valid_receiveonObs sa σ sh msg skts skt r ∧
      ev = receiveonObs sa σ sh msg skts skt r.

  Definition recev_coh (i : nat) (revs : list vector_clock) : iProp Σ :=
    ∃ sa evs, ⌜gcd_addr_list gcdata !! i = Some sa⌝ ∧
      (∀ rev j, ⌜S j < length revs⌝ → ⌜revs !! j = Some rev⌝ → GCounterSnapShot i rev) ∗
      (⌜evs ≠ []⌝ → ∃ l, allocated i l) ∗
      receiveon_evs sa evs ∗ ⌜Forall2 (rec_events_correspond sa) evs revs⌝.

  Definition recevs_coherence (revss : list (list vector_clock)) : iProp Σ :=
    [∗ list] i ↦ sa; revs ∈ gcd_addr_list gcdata; revss,
       (∀ rev j, ⌜S j < length revs⌝ → ⌜revs !! j = Some rev⌝ → GCounterSnapShot i rev) ∗
       ∃ evs,
         (⌜evs ≠ []⌝ → ∃ l, allocated i l) ∗
         receiveon_evs sa evs ∗ ⌜Forall2 (rec_events_correspond sa) evs revs⌝.

  (* Properties *)

  Lemma GCounterSnapShot_le (i : fin (GClen gcdata)) vc st :
    GCounterSnapShot i vc -∗ GCounters st -∗ ⌜vc_le vc (st !!! i)⌝.
  Proof.
    iIntros "H1 H2".
    iDestruct (own_valid_2 with "H2 H1") as %[Hv1 Hv2]%auth_both_valid_discrete.
    apply singleton_included_l in Hv1 as (vc' & Hvc'1 & Hvc'2).
    rewrite /= lookup_fmap list_to_gmap_lookup in Hvc'1.
    destruct ((vec_to_list st) !! (fin_to_nat i)) as [vc''|] eqn:Heq; last by inversion Hvc'1.
    apply vlookup_lookup in Heq as ->.
    apply Some_equiv_inj in Hvc'1.
    revert Hvc'2; rewrite -Hvc'1 Some_included_total principal_included; done.
  Qed.

  Lemma GCounters_update (i : fin (GClen gcdata)) vc' (st : crdt_state):
    vc_le (st !!! i) vc' → GCounters st ==∗ GCounters (vinsert i vc' st) ∗ GCounterSnapShot i vc'.
  Proof.
    iIntros (Hle) "Ho".
    rewrite /GCounterSnapShot /GCounters.
    iMod (own_update _ _ (● _ ⋅ ◯ _) with "Ho") as "[$ $]"; last done.
    apply auth_update_alloc.
    rewrite vec_to_list_insert -list_to_gmap_insert;
      last by rewrite vec_to_list_length; apply fin_to_nat_lt.
    rewrite fmap_insert.
    eapply insert_alloc_local_update; [|done|].
    { rewrite lookup_fmap list_to_gmap_lookup.
      pose proof (eq_refl : st !!! i = st !!! i) as Hlu.
      apply vlookup_lookup in Hlu as ->; done. }
    apply monotone_local_update_grow; done.
  Qed.

  Lemma get_GCounterSnapShot_weaken (i : fin (GClen gcdata)) st vc :
    vc_le vc (st !!! i) →
     GCounters st ==∗ GCounters st ∗ GCounterSnapShot i vc.
  Proof.
    iIntros (Hle) "Ho".
    rewrite /GCounterSnapShot /GCounters.
    iMod (own_update _ _ (● _ ⋅ ◯ _) with "Ho") as "[$ $]"; last done.
    apply auth_update_alloc.
    rewrite -{2}(vlookup_insert_self i st).
    rewrite vec_to_list_insert -list_to_gmap_insert;
      last by rewrite vec_to_list_length; apply fin_to_nat_lt.
    rewrite fmap_insert.
    eapply insert_alloc_local_update; [|done|].
    { rewrite lookup_fmap list_to_gmap_lookup.
      pose proof (eq_refl : st !!! i = st !!! i) as Hlu.
      apply vlookup_lookup in Hlu as ->; done. }
    apply monotone_local_update_get_frag; done.
  Qed.

  Lemma get_GCounterSnapShot (i : fin (GClen gcdata)) st :
     GCounters st ==∗ GCounters st ∗ GCounterSnapShot i (st !!! i).
  Proof. rewrite -{2}(vlookup_insert_self i st); apply GCounters_update; done. Qed.

  Lemma locations_is_unallocated i locs :
    locations locs -∗ unallocated i -∗ ⌜locs !! i = Some None⌝.
  Proof.
    iIntros "H1 H2".
    iDestruct (own_valid_2 with "H1 H2")
      as %[(z & Hz1 & Hz2)%singleton_included_l ?]%auth_both_valid_discrete.
    rewrite list_to_gmap_lookup in Hz1.
    destruct (locs !! i) as [[]|]; simpl in *; [|done|by inversion Hz1].
    revert Hz2; rewrite -Hz1 Some_included; intros [Hinc|Hinc]; first by inversion Hinc.
    apply csum_included in Hinc as [|[(?&?&?&?&?&?)|(?&?&?&?&?)]]; done.
  Qed.

  Lemma locations_is_allocated i locs l :
    locations locs -∗ allocated i l -∗ ⌜locs !! i = Some (Some l)⌝.
  Proof.
    iIntros "H1 H2".
    iDestruct (own_valid_2 with "H1 H2")
      as %[(z & Hz1 & Hz2)%singleton_included_l ?]%auth_both_valid_discrete.
    rewrite list_to_gmap_lookup in Hz1.
    destruct (locs !! i) as [[]|]; simpl in *; [| |by inversion Hz1].
    - revert Hz2; rewrite -Hz1 Some_included; intros [Hinc|Hinc].
      + apply Cinr_inj, to_agree_inj, leibniz_equiv in Hinc as <-; done.
      + apply Cinr_included, to_agree_included, leibniz_equiv in Hinc as <-; done.
    - revert Hz2; rewrite -Hz1 Some_included; intros [Hinc|Hinc]; first by inversion Hinc.
      apply csum_included in Hinc as [|[(?&?&?&?&?&?)|(?&?&?&?&?)]]; done.
  Qed.

  Lemma locations_alloc i locs l :
    locations locs -∗ unallocated i ==∗ locations (<[i := Some l]> locs) ∗ allocated i l.
  Proof.
    iIntros "Hlocs Hua".
    iDestruct (locations_is_unallocated with "Hlocs Hua") as %Hlu.
    iMod (own_update_2 _ _ _ (● _ ⋅ ◯ _) with "Hlocs Hua") as "[$ $]"; last done.
    apply auth_update.
    rewrite -list_to_gmap_insert; last by apply lookup_lt_is_Some_1; eauto.
    apply: singleton_local_update; first by rewrite list_to_gmap_lookup Hlu.
    apply exclusive_local_update; done.
  Qed.

  Lemma locations_coherence_length locs st :
    locations_coherence locs st -∗ ⌜length locs = GClen gcdata⌝.
  Proof.
    iIntros "H".
    iDestruct (big_sepL2_length with "H") as %Hlen.
    rewrite vec_to_list_length in Hlen; done.
  Qed.

  Lemma locations_coherence_insert_acc (i : fin (GClen gcdata)) locs ol st :
    locs !! (fin_to_nat i) = Some ol →
    locations_coherence locs st -∗
    loc_coherence i ol (st !!! i) ∗
    (∀ ol' vc,
        loc_coherence i ol' vc -∗
        locations_coherence (<[fin_to_nat i := ol']> locs) (vinsert i vc st)).
  Proof.
    iIntros (Hiol) "Hlc"; rewrite /locations_coherence.
    iDestruct (big_sepL2_insert_acc with "Hlc") as "[$ Hlc]";
      [apply Hiol|by apply vlookup_lookup|].
    setoid_rewrite vec_to_list_insert; done.
  Qed.

  Lemma sendevs_agree sevss i sevs :
    sendevs_auth sevss -∗ sendevs_frag i sevs -∗ ⌜sevss !! i = Some sevs⌝.
  Proof.
    iIntros "H1 H2".
    iDestruct (own_valid_2 with "H1 H2") as %[Hv1 Hv2]%auth_both_valid_discrete.
    apply singleton_included_l in Hv1 as (vc' & Hvc'1 & Hvc'2).
    rewrite /= list_to_gmap_lookup in Hvc'1.
    apply leibniz_equiv in Hvc'1.
    specialize (Hv2 i); rewrite /= list_to_gmap_lookup in Hv2.
    destruct (sevss !! i) as [vc''|] eqn:Heq; last by inversion Hvc'1.
    destruct vc'; last by simplify_eq/=.
    simplify_eq/=.
    apply Excl_included, leibniz_equiv in Hvc'2; simplify_eq; done.
  Qed.

  Lemma sendevs_update sevss i sevs sevs' :
    sendevs_auth sevss -∗
    sendevs_frag i sevs ==∗
    sendevs_auth (<[i := sevs']>sevss) ∗ sendevs_frag i sevs'.
  Proof.
    iIntros "H1 H2".
    iDestruct (sendevs_agree with "H1 H2") as %Hlu.
    rewrite /sendevs_auth /sendevs_frag.
    iMod (own_update_2 _ _ _ (● _ ⋅ ◯ _) with "H1 H2") as "[$ $]"; last done.
    apply auth_update.
    rewrite -list_to_gmap_insert; last by apply lookup_lt_Some in Hlu.
    eapply singleton_local_update; first by rewrite list_to_gmap_lookup Hlu.
    apply exclusive_local_update; done.
  Qed.

  Lemma recevs_agree revss i revs :
    recevs_auth revss -∗ recevs_frag i revs -∗ ⌜revss !! i = Some revs⌝.
  Proof.
    iIntros "H1 H2".
    iDestruct (own_valid_2 with "H1 H2") as %[Hv1 Hv2]%auth_both_valid_discrete.
    apply singleton_included_l in Hv1 as (vc' & Hvc'1 & Hvc'2).
    rewrite /= list_to_gmap_lookup in Hvc'1.
    apply leibniz_equiv in Hvc'1.
    specialize (Hv2 i); rewrite /= list_to_gmap_lookup in Hv2.
    destruct (revss !! i) as [vc''|] eqn:Heq; last by inversion Hvc'1.
    destruct vc'; last by simplify_eq/=.
    simplify_eq/=.
    apply Excl_included, leibniz_equiv in Hvc'2; simplify_eq; done.
  Qed.

  Lemma recevs_update revss i revs revs' :
    recevs_auth revss -∗
    recevs_frag i revs ==∗
    recevs_auth (<[i := revs']>revss) ∗ recevs_frag i revs'.
  Proof.
    iIntros "H1 H2".
    iDestruct (recevs_agree with "H1 H2") as %Hlu.
    rewrite /recevs_auth /recevs_frag.
    iMod (own_update_2 _ _ _ (● _ ⋅ ◯ _) with "H1 H2") as "[$ $]"; last done.
    apply auth_update.
    rewrite -list_to_gmap_insert; last by apply lookup_lt_Some in Hlu.
    eapply singleton_local_update; first by rewrite list_to_gmap_lookup Hlu.
    apply exclusive_local_update; done.
  Qed.

  Lemma sendevs_coherence_length locs sevss :
    sendevs_coherence locs sevss -∗ ⌜length locs = length sevss⌝.
  Proof. iApply big_sepL2_length. Qed.

  Lemma sendevs_coherence_insert_acc i locs ol sevss sevs :
    locs !! i = Some ol →
    sevss !! i = Some sevs →
    sendevs_coherence locs sevss -∗
    sendev_coh i ol sevs ∗
    (∀ ol' sevs',
        sendev_coh i ol' sevs' -∗
        sendevs_coherence (<[i := ol']> locs) (<[i := sevs']>sevss)).
  Proof.
    iIntros (Hiol Hsevs) "Hsc"; rewrite /sendevs_coherence.
    iDestruct (big_sepL2_insert_acc with "Hsc") as "[$ Hsc]";
      [apply Hiol|apply Hsevs|]; done.
  Qed.

  Lemma recevs_coherence_length revss :
    recevs_coherence revss -∗ ⌜length revss = GClen gcdata⌝.
  Proof.
    iIntros "H".
    iDestruct (big_sepL2_length with "H") as %?; done.
  Qed.

  Lemma recevs_coherence_insert_acc i revss revs :
    revss !! i = Some revs →
    recevs_coherence revss -∗
    recev_coh i revs ∗
    (∀ revs',
        recev_coh i revs' -∗
        recevs_coherence (<[i := revs']>revss)).
  Proof.
    iIntros (Hrevs) "Hrc"; rewrite /recevs_coherence.
    iDestruct (recevs_coherence_length with "Hrc") as %Hlen.
    destruct (lookup_lt_is_Some_2 (gcd_addr_list gcdata) i) as [sa Hsa].
    { rewrite -Hlen; apply lookup_lt_is_Some_1; eauto. }
    iDestruct (big_sepL2_insert_acc with "Hrc") as "[[Hi1 Hi2] Hrc]";
      [apply Hsa|apply Hrevs|].
    iSplitL "Hi1 Hi2".
    - iDestruct "Hi2" as (?) "Hi2".
      iExists _, _; iSplit; first done.
      iFrame.
    - iIntros (revs').
      iSpecialize ("Hrc" $! sa revs').
      rewrite (list_insert_id (gcd_addr_list gcdata) i sa); last done.
      iDestruct 1 as (sa' ? Hsa') "(H1 & H2 & H3)".
      rewrite Hsa' in Hsa; simplify_eq.
      iApply "Hrc".
      iFrame; iExists _; iFrame.
  Qed.

  Lemma sendevs_valid_extend sevs sevs' trpl :
    (∀ sev, sev ∈ sevs → vc_le sev.2.1 trpl.2.2) →
    (∀ sev, sev ∈ sevs' → sev.1 ≠ trpl.1) →
    sendevs_valid (sevs ++ sevs') → sendevs_valid (sevs ++ sevs' ++ [trpl]).
  Proof.
    intros Hsevs Hsevs' Hvl.
    intros i j sev sev' Hisev Hij Hjsev' Hfst.
    destruct (decide (i < length (sevs ++ sevs'))) as [|Hnlt].
    - eapply Hvl; [|apply Hij| |done].
      + rewrite assoc_L lookup_app_l in Hisev; done.
      + rewrite assoc_L lookup_app_l in Hjsev'; [done|lia].
    - assert (i = length (sevs ++ sevs')) as ->.
      { eapply lookup_lt_Some in Hisev.
        rewrite !app_length in Hisev, Hnlt.
        rewrite !app_length; simpl in *;lia. }
      rewrite assoc_L lookup_app_r in Hisev; last lia.
      rewrite Nat.sub_diag in Hisev; simplify_eq/=.
      rewrite assoc_L lookup_app_l in Hjsev'; last lia.
      destruct (decide (j < length sevs)).
      + rewrite lookup_app_l in Hjsev'; last done.
        apply Hsevs; apply elem_of_list_lookup; eauto.
      + rewrite lookup_app_r in Hjsev'; last lia.
        exfalso; eapply Hsevs'; last by apply Hfst.
        apply elem_of_list_lookup; eauto.
  Qed.

End Resources.

Section Resources_alloc.
  Context `{!anerisG (GCounterM gcdata) Σ, !GCounterPreG Σ gcdata}.

  Notation vector_clock := (vector_clock (GClen gcdata)).
  Notation crdt_state := (crdt_state (GClen gcdata)).

  Lemma Gcounter_init :
    ⊢ |==> ∃ γ, own (A := crdt_stateUR gcdata) γ
                    (● ((λ c, PrinGC c) <$> list_to_gmap id (initial_crdt_state (GClen gcdata)))).
  Proof.
    apply own_alloc.
    apply auth_auth_valid; intros ?.
    rewrite lookup_fmap list_to_gmap_lookup.
    destruct (vec_to_list (initial_crdt_state (GClen gcdata)) !! i) eqn:Heq; done.
  Qed.

  Lemma locations_init :
    ⊢ |==> ∃ γ, own γ (● list_to_gmap oloc_to_one_shot (replicate (GClen gcdata) None)) ∗
            [∗ list] i ∈ (seq 0 (GClen gcdata)), own γ (◯ {[i := Cinl (Excl ())]}).
  Proof.
    iIntros "".
    iMod (own_alloc (● list_to_gmap oloc_to_one_shot (replicate (GClen gcdata) None) ⋅
                     ◯ list_to_gmap oloc_to_one_shot (replicate (GClen gcdata) None)))
      as (γ) "[Hlocs Hua]".
    { apply auth_both_valid_2; last done.
      intros ?; rewrite list_to_gmap_lookup.
      destruct (replicate (GClen gcdata) None !! i) as [[]|]; done. }
    iModIntro; iExists _; iFrame "Hlocs".
    generalize 0; intros n.
    iInduction (GClen gcdata) as [|k IHk] "IH" forall (n); simpl; first done.
    rewrite list_to_gmap_go_cons insert_singleton_op; last by apply list_to_gmap_go_lookup_lt; lia.
    iDestruct "Hua" as "[$ Hua]".
    iApply "IH"; done.
  Qed.

  Lemma sendevs_init k :
    ⊢ |==> ∃ γ, own γ (● list_to_gmap_go 0 Excl
                        (replicate k (@nil (nat * (vector_clock * vector_clock))))) ∗
             [∗ list] i ∈ (seq 0 k),
               own γ (◯ {[i := Excl (@nil (nat * (vector_clock * vector_clock))) ]}).
  Proof.
    iIntros "".
    iMod (own_alloc (● list_to_gmap Excl (replicate k
                                            (@nil (nat * (vector_clock * vector_clock)))) ⋅
                     ◯ list_to_gmap Excl (replicate k
                                            (@nil (nat * (vector_clock * vector_clock))))))
      as (γ) "[Hevs Hua]".
    { apply auth_both_valid_2; last done.
      intros ?; rewrite list_to_gmap_lookup.
      destruct (replicate k [] !! i) as [[]|]; done. }
    iModIntro; iExists _; iFrame "Hevs".
    generalize 0; intros n.
    iInduction k as [|k IHk] "IH" forall (n); simpl; first done.
    rewrite list_to_gmap_go_cons insert_singleton_op; last by apply list_to_gmap_go_lookup_lt; lia.
    iDestruct "Hua" as "[$ Hua]".
    iApply "IH"; done.
  Qed.

  Lemma recevs_init k :
    ⊢ |==> ∃ γ, own γ (● list_to_gmap_go 0 Excl (replicate k (@nil vector_clock))) ∗
             [∗ list] i ∈ (seq 0 k), own γ (◯ {[i := Excl (@nil vector_clock) ]}).
  Proof.
    iIntros "".
    iMod (own_alloc (● list_to_gmap Excl (replicate k (@nil vector_clock)) ⋅
                     ◯ list_to_gmap Excl (replicate k (@nil vector_clock))))
      as (γ) "[Hevs Hua]".
    { apply auth_both_valid_2; last done.
      intros ?; rewrite list_to_gmap_lookup.
      destruct (replicate k [] !! i) as [[]|]; done. }
    iModIntro; iExists _; iFrame "Hevs".
    generalize 0; intros n.
    iInduction k as [|k IHk] "IH" forall (n); simpl; first done.
    rewrite list_to_gmap_go_cons insert_singleton_op; last by apply list_to_gmap_go_lookup_lt; lia.
    iDestruct "Hua" as "[$ Hua]".
    iApply "IH"; done.
  Qed.

End Resources_alloc.

Section Resources_alloc.
  Context `{!anerisG (GCounterM gcdata) Σ, !GCounterG Σ gcdata}.

  Lemma locations_coh_init_helper k n :
    ([∗ list] i ∈ seq k n, alloc_evs (StringOfZ (i : nat)) []) -∗
    [∗ list] i↦ol;vc ∈ (replicate n None); (vreplicate n (vreplicate (GClen gcdata) 0)),
      loc_coherence (k + i) ol vc.
  Proof.
    iIntros "H".
    rewrite big_sepL2_replicate_l /=; last by rewrite vec_to_list_length.
    rewrite vec_to_list_replicate.
    iInduction n as [|n] "IH" forall (k); simpl; first done.
    rewrite Nat.add_0_r.
    iDestruct "H" as "[$ H]".
    iSplit; first done.
    iSpecialize ("IH" with "H").
    iApply (big_sepL_impl with "IH").
    iIntros "!#" (??) "? ?".
    rewrite plus_Snm_nSm; iFrame.
  Qed.

  Lemma locations_coh_init :
    ([∗ list] i ∈ seq 0 (GClen gcdata), alloc_evs (StringOfZ (i : nat)) []) -∗
    locations_coherence (replicate (GClen gcdata) None) (initial_crdt_state (GClen gcdata)).
  Proof. iApply locations_coh_init_helper. Qed.

  Lemma sendevs_coh_init :
    ([∗ list] a ∈ gcd_addr_list gcdata, sendon_evs a []) -∗
    sendevs_coherence (replicate (GClen gcdata) None) (replicate (GClen gcdata) []).
  Proof.
    iIntros "H".
    rewrite /sendevs_coherence.
    rewrite big_sepL2_replicate_l /=; last by rewrite replicate_length.
    rewrite -(const_fmap (λ _, [])); last done.
    rewrite big_sepL_fmap.
    iApply (big_sepL_impl with "H").
    iIntros "!#" (?? ?) "H".
    iExists _; simpl; iFrame; done.
  Qed.

  Lemma recevs_coh_init :
    ([∗ list] a ∈ gcd_addr_list gcdata, receiveon_evs a []) -∗
    recevs_coherence (replicate (GClen gcdata) []).
  Proof.
    iIntros "H".
    rewrite /recevs_coherence.
    rewrite big_sepL2_replicate_r; last done.
    iApply (big_sepL_impl with "H").
    iIntros "!#" (?? ?) "H"; simpl.
    iSplit.
    { iIntros (? ? ?); lia. }
    iExists _; simpl; iFrame.
    iSplit; [by iIntros (?)|done].
  Qed.

End Resources_alloc.

Section Sockets.
  Context `{!anerisG (crdt_model gcdata) Σ, !GCounterG Σ gcdata}.
  Context (GCG_vcs_name : gname).

  Notation vector_clock := (vector_clock (GClen gcdata)).
  Notation crdt_state := (crdt_state (GClen gcdata)).

  Definition GCounter_socket_proto : socket_interp Σ :=
    (λ m,
     let mb := m_body m in
     ∃ (t : vector_clock) (i j : nat),
       ⌜vc_is_ser (vector_clock_to_val t) mb⌝
       ∧ ⌜gcd_addr_list gcdata !! i = Some (m_sender m)⌝
       ∧ ⌜gcd_addr_list gcdata !! j = Some (m_destination m)⌝
       ∧ ⌜i ≠ j⌝
       ∧ ⌜length t = GClen gcdata⌝
       ∧ GCounterSnapShot i t)%I.

End Sockets.

Section Global_invariant.
  Context `{!anerisG (GCounterM gcdata) Σ, !GCounterG Σ gcdata}.
  Context (GCG_locs_name GCG_vcs_name : gname).

  Notation vector_clock := (vector_clock (GClen gcdata)).
  Notation crdt_state := (crdt_state (GClen gcdata)).

  Definition CvRDT_InvName := nroot .@ "CRDT".

  Definition Global_Inv :=
    inv CvRDT_InvName
        (∃ st locs sevss revss,
            frag_st st ∗ GCounters st ∗ locations locs ∗ sendevs_auth sevss ∗ recevs_auth revss ∗
            locations_coherence locs st ∗
            sendevs_coherence locs sevss ∗ recevs_coherence revss ∗
            ([∗ list] a ∈ gcd_addr_list gcdata,
                ∃ R T, a ⤳[true, true] (R, T) ∗ [∗ set] m ∈ R, GCounter_socket_proto m)).

End Global_invariant.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section Spec.

  Definition get_realm_params_spec (realm_params_addr: Z64) (adt: RData) : option (RData * Z) :=
    match realm_params_addr with
    | VZ64 addr =>
      rely is_int64 addr;
      let gidx := __addr_to_gidx addr in
      if (GRANULE_ALIGNED addr) && (is_gidx gidx) then
        rely prop_dec ((buffer (priv adt)) @ SLOT_NS = None);
        let e := EVT CPU_ID (COPY_NS gidx READ_REALM_PARAMS) in
        let gn := (gs (share adt)) @ gidx in
        if (g_tag (ginfo gn) =? GRANULE_STATE_NS) then
          let ns_data := g_data (gnorm gn) in
          Some (adt {log: e :: (log adt)} {priv: (priv adt) {realm_params: ns_data}}, 0)
        else
          Some (adt {log: e :: (log adt)}, 1)
      else
        Some (adt, 1)
    end.

End Spec.


Require Import VST.floyd.base.
Require Import VST.floyd.find_nth_tactic.
Require Import VST.floyd.seplog_tactics.
Local Open Scope logic.

Ltac backtrack_find_nth_rec tac :=
  first [ simple eapply find_nth_preds_rec_nil
        | (simple eapply find_nth_preds_rec_cons_head; tac) +
          (simple eapply find_nth_preds_rec_cons_tail; backtrack_find_nth_rec tac)].

Ltac backtrack_find_nth tac :=
  eapply find_nth_preds_constr; backtrack_find_nth_rec tac.

Inductive syntactic_cancel: list mpred -> list mpred -> list mpred -> list mpred -> Prop :=
| syntactic_cancel_nil: forall R, syntactic_cancel R nil R nil
| syntactic_cancel_free: forall R L0 L F Res,
    emp |-- L0 ->
    syntactic_cancel R L F Res ->
    syntactic_cancel R (L0 :: L) F Res
| syntactic_cancel_cons_succeed_full: forall n R0 R L0 L F Res,
    nth_error R n = Some R0 ->
    R0 |-- L0 ->
    syntactic_cancel (delete_nth n R) L F Res ->
    syntactic_cancel R (L0 :: L) F Res
| syntactic_cancel_cons_succeed_partial: forall n R0 R L0 L F0 F Res,
    nth_error R n = Some R0 ->
    R0 * F0 |-- L0 ->
    syntactic_cancel (delete_nth n R) (F0 :: L) F Res ->
    syntactic_cancel R (L0 :: L) F Res
| syntactic_cancel_cons_fail: forall R L0 L F Res,
    syntactic_cancel R L F Res ->
    syntactic_cancel R (L0 :: L) F (L0 :: Res).

Lemma syntactic_cancel_cons: forall nR0 R L0 L F0 F Res,
  find_nth_preds (fun R0 => R0 * F0 |-- L0) R nR0 ->
  syntactic_cancel match nR0 with
                   | Some (n, _) => delete_nth n R
                   | None => R
                   end
                   L F Res /\ (F0 = emp \/ nR0 = None) \/
  syntactic_cancel match nR0 with
                   | Some (n, _) => delete_nth n R
                   | None => R
                   end
                   (F0 :: L) F Res /\ isSome nR0 ->
  syntactic_cancel R (L0 :: L) F (let Res' := Res in
                                 match nR0 with
                                 | Some _ => Res'
                                 | None => L0 :: Res'
                                 end).
Proof.
  intros.
  destruct nR0 as [[? ?]|]; [destruct H0 |].
  + destruct H0.
    destruct H1; [| congruence].
    subst F0.
    apply find_nth_preds_Some in H.
    destruct H.
    rewrite sepcon_emp in H1.
    eapply syntactic_cancel_cons_succeed_full; eauto.
  + apply find_nth_preds_Some in H.
    destruct H0.
    destruct H.
    eapply syntactic_cancel_cons_succeed_partial; eauto.
  + destruct H0 as [[? _] | [? ?]]; [| tauto].
    eapply syntactic_cancel_cons_fail; eauto.
Qed.

Lemma delete_nth_SEP: forall R n R0,
  nth_error R n = Some R0 ->
  fold_right_sepcon R |-- R0 * fold_right_sepcon (delete_nth n R).
Proof.
  intros.
  revert R H; induction n; intros; destruct R; try solve [inv H].
  + inv H.
    simpl.
    auto.
  + simpl in H.
    apply IHn in H.
    simpl.
    rewrite <- sepcon_assoc, (sepcon_comm _ m), sepcon_assoc.
    apply sepcon_derives; auto.
Qed.

Lemma syntactic_cancel_spec1: forall G1 L1 G2 L2 F,
  syntactic_cancel G1 L1 G2 L2 ->
  fold_right_sepcon G2 |-- fold_right_sepcon L2 * F ->
  fold_right_sepcon G1 |-- fold_right_sepcon L1 * F.
Proof.
  intros.
  revert F H0; induction H; intros.
  + auto.
  + apply IHsyntactic_cancel in H1.
    simpl.
    rewrite sepcon_assoc.
    eapply derives_trans; [| apply sepcon_derives; [apply H | apply H1]].
    rewrite emp_sepcon; auto.
  + apply IHsyntactic_cancel in H2.
    simpl.
    rewrite sepcon_assoc.
    eapply derives_trans; [| apply sepcon_derives; [apply derives_refl | apply H2]].
    clear IHsyntactic_cancel H2.
    eapply derives_trans; [apply delete_nth_SEP; eauto |].
    apply sepcon_derives; auto.
  + apply IHsyntactic_cancel in H2.
    simpl.
    rewrite sepcon_assoc.
    simpl in H2.
    eapply derives_trans; [| apply sepcon_derives; [apply H0 | apply derives_refl]].
    rewrite sepcon_assoc.
    rewrite <- (sepcon_assoc F0).
    eapply derives_trans; [| apply sepcon_derives; [apply derives_refl | apply H2]].
    clear IHsyntactic_cancel H2.
    eapply derives_trans; [apply delete_nth_SEP; eauto |].
    apply derives_refl.
  + simpl in H0.
    rewrite (sepcon_comm L0), sepcon_assoc in H0.
    apply (IHsyntactic_cancel (L0*F0)) in H0.
    eapply derives_trans; [exact H0 |].
    simpl.
    rewrite <- sepcon_assoc.
    apply sepcon_derives; auto.
    rewrite sepcon_comm; auto.
Qed.

Lemma syntactic_cancel_solve3:
  fold_right_sepcon nil |-- fold_right_sepcon nil.
Proof.
  auto.
Qed.

Lemma syntactic_cancel_spec3: forall G1 L1 G2 L2,
  syntactic_cancel G1 L1 G2 L2 ->
  fold_right_sepcon G2 |-- fold_right_sepcon L2 ->
  fold_right_sepcon G1 |-- fold_right_sepcon L1.
Proof.
  intros.
  rewrite <- (sepcon_emp (fold_right_sepcon L1)).
  eapply syntactic_cancel_spec1; eauto.
  rewrite sepcon_emp; auto.
Qed.

Ltac advanced_syntactic_cancel local_tac :=
  repeat first
         [ simple apply syntactic_cancel_nil
         | simple apply syntactic_cancel_free;
           [ local_tac
           | ]
         | simple eapply syntactic_cancel_cons;
           [ find_nth local_tac
           | match goal with
             | |- _ /\ (emp = emp \/ _) \/ _ =>
                    left;
                    split; [| left; reflexivity]
             | |- _ /\ (_ \/ None = None) \/ _ =>
                    left;
                    split; [| left; reflexivity]
                  (* This is intensional "left".
                     This is used to instantiate the unused F0 *)
             | |- _ \/ (_ /\ isSome (Some _)) =>
                    right;
                    split; [| exact I]
             end;
             cbv iota; unfold delete_nth; cbv zeta iota
           ]
         ].

Ltac try_one_syntactic_cancel local_tac :=
          (simple apply syntactic_cancel_free;
           [ local_tac
           | ])
          +
          (simple eapply syntactic_cancel_cons;
           [ backtrack_find_nth local_tac
           | match goal with
             | |- _ /\ (emp = emp \/ _) \/ _ =>
                    left;
                    split; [| left; reflexivity]
             | |- _ /\ (_ \/ None = None) \/ _ =>
                    left;
                    split; [| left; reflexivity]
                  (* This is intensional "left".
                     This is used to instantiate the unused F0 *)
             | |- _ \/ (_ /\ isSome (Some _)) =>
                    right;
                    split; [| exact I]
             end;
             cbv iota; unfold delete_nth; cbv zeta iota
           ]).

Ltac conservative_syntactic_cancel local_ctac :=
  repeat progress
    (eapply syntactic_cancel_spec3;
     [advanced_syntactic_cancel local_ctac |
      cbv iota; cbv zeta beta ]).

Ltac aggresive_syntactic_cancel local_atac local_ctac :=
  once repeat
   (conservative_syntactic_cancel local_ctac;
    first [ apply derives_refl
          | eapply syntactic_cancel_spec3;
            [ try_one_syntactic_cancel local_atac;
              advanced_syntactic_cancel local_ctac
            | cbv iota; cbv zeta beta ]]).
(*
Module Test.
Section Test.

Parameters A B C D E F: mpred.
Axiom Foo1: A * B |-- C.
Axiom Foo2: C * D |-- E.

Ltac foo :=
  idtac;
  match goal with
  | |- ?P * _ |-- ?P => rewrite <- (sepcon_emp P) at 2; apply derives_refl
  | |- D * _ |-- E => eapply derives_trans; [| apply Foo2];
                      rewrite (sepcon_comm C D); apply derives_refl
  | |- A * _ |-- C => eapply derives_trans; [| apply Foo1];
                      apply derives_refl
  end.

Goal A * B * F * D |-- E * F.
eapply symbolic_cancel_setup;
  [ construct_fold_right_sepcon
  | construct_fold_right_sepcon
  | fold_abnormal_mpred
  | cbv iota beta delta [before_symbol_cancel];
    conservative_syntactic_cancel foo].

  auto.
Qed.

End Test.
End Test.

Module Test2.
Section Test2.

Parameter A: nat -> nat -> mpred.
Parameter B: nat -> mpred.
Axiom Foo: forall x y, A x y * B y |-- B x.

Ltac cfoo :=
  idtac;
  match goal with
  | |- ?P * _ |-- ?P => rewrite <- (sepcon_emp P) at 2; apply derives_refl
  | |- A ?x _ * _ |-- B ?x => apply (Foo x)
  end.

Ltac afoo :=
  idtac;
  match goal with
  | |- ?P * _ |-- ?P => rewrite <- (sepcon_emp P) at 2; apply derives_refl
  | |- A ?x _ * _ |-- B _ => apply (Foo x)
  | |- B ?x * _ |-- B _ => rewrite (sepcon_emp (B x)); apply derives_refl
  end.

Goal forall x y, exists z, A x y * B y |-- B z.
  intros.
  eexists.
  eapply symbolic_cancel_setup;
  [ construct_fold_right_sepcon
  | construct_fold_right_sepcon
  | fold_abnormal_mpred
  | cbv iota beta delta [before_symbol_cancel]].
  aggresive_syntactic_cancel afoo cfoo.
Qed.
End Test2.
End Test2.
*)


(** Start of prelude for coq translation of .cat files *)
From Coq Require Import Ensembles List String RelationClasses.
(** This prelude uses definitions from RelationAlgebra *)
From RelationAlgebra Require Import all.

Definition set := Ensemble.
Definition relation A := hrel A A.

Class SetLike A :=
  { union : A -> A -> A;
    intersection : A -> A -> A;
    diff : A -> A -> A;
    universal : A;
    incl : A -> A -> Prop }.

Instance SetLike_set (A : Type) : SetLike (set A) :=
  {| union := Union A;
     intersection := Intersection A;
     diff := Setminus A;
     universal := Full_set A;
     incl := Included A |}.

Instance SetLike_relation (A : Type) : SetLike (relation A) :=
  {| union := cup;
     intersection := cap;
     diff := fun R S => cap R (neg S);
     universal := top;
     incl := leq |}.

Definition complement {A} `{SetLike A} (x : A) := diff universal x.

Definition empty {A} `{SetLike A} : A := diff universal universal.

Definition is_empty {A} `{SetLike A} (x : A) : Prop := incl x (diff universal universal).

Definition rel_seq {A} : relation A -> relation A -> relation A := dot A A A.

Definition rel_inv {A} : relation A -> relation A := cnv A A.

Definition cartesian {A} : set A -> set A -> relation A := fun X Y x y => X x /\ Y y.

Definition id {A} : relation A := eq.

Definition domain {A} : relation A -> set A := fun R x => exists y, R x y.

Definition range {A} : relation A -> set A := fun R y => exists x, R x y.

Definition irreflexive {A} (R : relation A) := forall x, ~R x x.

Notation refl_clos := (fun R => union R id) (only parsing).

Notation trans_clos := (hrel_str _) (only parsing).

Notation refl_trans_clos := (hrel_itr _) (only parsing).

Definition acyclic {A} (R : relation A) := incl (intersection (trans_clos R) id) empty.

Class StrictTotalOrder {A} (R : relation A) :=
  { StrictTotalOrder_Strict :> StrictOrder R;
    StrictTotalOrder_Total : forall a b, a <> b -> (R a b \/ R b a) }.

Definition linearisations {A} (X : set A) (R : relation A) : set (relation A) :=
  fun S => StrictTotalOrder S /\ incl R S.

Definition set_flatten {A} : set (set A) -> set A := fun xss x => exists xs, xss xs /\ xs x.

Definition map {A B} (f : A -> B) (X : set A) : set B := fun y => exists x, X x /\ y = f x.

Definition co_locs {A} (pco : relation A) (wss : set (set A)) : set (set (relation A)) :=
  map (fun ws => linearisations ws pco) wss.

Definition cross {A} (Si : set (set (relation A))) : set (relation A) :=
  fun ei : relation A => exists (l : list (relation A)) (L : list (set (relation A))),
      (forall x y, ei x y <-> exists e, In e l /\ e x y) /\
      (forall X, Si X <-> In X L) /\
      Forall2 (fun ei Si => Si ei) l L.

Definition diagonal {A} : set A -> relation A := fun X x y => X x /\ x = y.

Declare Scope cat_scope.
Notation " [ x ] " := (diagonal x) : cat_scope.

(* Execution given as an argument to the model *)

Record candidate :=
  {
    (* Documentation for names:
       http://diy.inria.fr/doc/herd.html#language:identifier *)
    events : Set;
    W   : set events; (* read events *)
    R   : set events; (* write events *)
    IW  : set events; (* initial writes *)
    FW  : set events; (* final writes *)
    B   : set events; (* branch events *)
    RMW : set events; (* read-modify-write events *)
    F   : set events; (* fence events *)

    po  : relation events; (* program order *)
    addr: relation events; (* address dependency *)
    data: relation events; (* data dependency *)
    ctrl: relation events; (* control dependency *)
    rmw : relation events; (* read-exclusive write-exclusive pair *)
    amo : relation events; (* atomic modify *)

    rf  : relation events; (* read-from *)
    loc : relation events; (* same location *)
    ext : relation events; (* external *)
    int : relation events; (* internal *)

    (* Two functions for unknown sets or relations that are found in
    .cat files. cat2coq uses [unknown_set "ACQ"] when translating
    some parts of cat files about C11 *)
    unknown_set : string -> set events;
    unknown_relation : string -> relation events;
  }.

Hint Unfold events W R IW FW B RMW F po addr data ctrl rmw amo rf loc ext int unknown_set unknown_relation : cat_record.
Hint Unfold union intersection diff universal incl SetLike_set SetLike_relation rel_seq rel_inv : cat_defs.

(** End of prelude *)


From isla Require Import opsem.

Definition a7430 : isla_trace :=
  Smt (DeclareConst 0%Z (Ty_BitVec 16%N)) Mk_annot :t:
  Smt (DeclareConst 92%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "R6" [] (RegVal_Base (Val_Symbolic 92%Z)) Mk_annot :t:
  Smt (DefineConst 95%Z (Manyop (Bvmanyarith Bvor) [Manyop (Bvmanyarith Bvand) [Val (Val_Symbolic 92%Z) Mk_annot; Val (Val_Bits (BV 64%N 0xffff0000ffffffff%Z)) Mk_annot] Mk_annot; Binop ((Bvarith Bvshl)) (Unop (ZeroExtend 48%N) (Val (Val_Symbolic 0%Z) Mk_annot) Mk_annot) (Val (Val_Bits (BV 64%N 0x20%Z)) Mk_annot) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "R6" [] (RegVal_Base (Val_Symbolic 95%Z)) Mk_annot :t:
  Smt (DeclareConst 96%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "_PC" [] (RegVal_Base (Val_Symbolic 96%Z)) Mk_annot :t:
  Smt (DefineConst 97%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 96%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "_PC" [] (RegVal_Base (Val_Symbolic 97%Z)) Mk_annot :t:
  tnil
.


Require Import CertiGraph.CertiGC.gc_spec.

Local Open Scope Z_scope.

Lemma body_create_space: semax_body Vprog Gprog f_create_space create_space_spec.
Proof.
  start_function.
  forward_if True.
  - exfalso. rewrite MSS_eq_unsigned, Int.unsigned_repr in H0;
               [lia | apply MSS_max_unsigned_range; assumption].
  - forward. entailer!.
  - forward_call (Tarray int_or_ptr_type n noattr, gv).
    + entailer!. simpl. rewrite Z.max_r by lia. now rewrite Z.mul_comm.
    + split; [|split].
      * simpl. replace (Z.max 0 n) with n. 1: apply MSS_max_4_unsigned_range, H.
        rewrite Z.max_r; [reflexivity | destruct H; assumption].
      * simpl; tauto.
      * compute; tauto.
    + Intros p. if_tac.
      * subst p. forward_if False.
        -- unfold all_string_constants. Intros.
           forward_call ((gv ___stringlit_7),
                         (map init_data2byte (gvar_init v___stringlit_7)), rsh).
           exfalso; assumption.
        -- inversion H0.
      * Intros. forward_if (
                    PROP ( )
                    LOCAL (temp _p p; temp _s s; temp _n (Vint (Int.repr n)))
                    SEP (mem_mgr gv; all_string_constants rsh gv;
                         malloc_token Ews (Tarray int_or_ptr_type n noattr) p;
                         data_at_ Ews (Tarray int_or_ptr_type n noattr) p;
                         data_at_ sh space_type s)).
        -- contradiction.
        -- forward. entailer!.
        -- do 3 forward. Exists p. unfold tarray. entailer!.
Qed.


Require Import ExtLib_Any.

Set Implicit Arguments.
Set Strict Implicit.

Polymorphic Class Functor@{d c} (F : Type@{d} -> Type@{c}) : Type :=
{ fmap : forall {A B : Type@{d}}, (A -> B) -> F A -> F B }.

Polymorphic Definition ID@{d} {T : Type@{d}} (f : T -> T) : Prop :=
  forall x : T, f x = x.

Module FunctorNotation.
  Notation "f <$> x" := (@fmap _ _ _ _ f x) (at level 52, left associativity).
End FunctorNotation.