cap_machine.proofmode.region

From cap_machine Require Export stdpp_extra cap_lang rules_base.
From cap_machine Require Import rules_binary_base.
From iris.proofmode Require Import tactics.
From machine_utils Require Import finz_interval.
From cap_machine Require Import addr_reg. (* Required because of a weird Coq bug related to imports *)

Section region.
  Context `{MachineParameters, memG Σ, regG Σ, cfg: cfgSG Σ}.

  Lemma isWithin_finz_seq_between_decomposition {z} (a0 a1 b e : finz z):
    (b e )%f
    finz.seq_between b e = finz.seq_between b
                           finz.seq_between
                           finz.seq_between e.
  Proof with try (unfold finz.dist; solve_addr) using.
    intros ( & Ha1e & Ha0a1).
    rewrite (finz_seq_between_split b e)... f_equal.
    rewrite (finz_seq_between_split e)...
  Unshelve. Fail idtac. Admitted.


  (*--------------------------------------------------------------------------*)

  Definition region_pointsto (b e : Addr) (ws : list Word) : iProp Σ :=
    ([∗ list] ky1;y2 (finz.seq_between b e);ws, ↦ₐ )%I.

  Definition included (b' e' : Addr) (b e : Addr) : iProp Σ :=
    ((b b')%a (e' e)%a)%I.

  Definition in_range (a b e : Addr) : Prop :=
    (b a)%a (a < e)%a.

  Lemma pointsto_decomposition:
     l1 l2 ws1 ws2,
      length = length
      ([∗ list] k y1;y2 ( );( ), ↦ₐ )%I ⊣⊢
      ([∗ list] k y1;y2 ;, ↦ₐ )%I ([∗ list] k y1;y2 ;, ↦ₐ )%I.
  Proof. intros. rewrite big_sepL2_app' //. Qed.

  Lemma extract_from_region b e a ws φ :
    let n := length (finz.seq_between b a) in
    (b a a < e)%a
    (region_pointsto b e ws ([∗ list] w ws, φ w)) ⊣⊢
     ( w,
        ws = take n ws (w::drop (S n) ws)
         region_pointsto b a (take n ws)
         ([∗ list] w (take n ws), φ w)
         a ↦ₐ w φ w
         region_pointsto ((a^+1))%a e (drop (S n) ws)
         ([∗ list] w (drop (S n) ws), φ w)%I).
  Proof.
    intros. iSplit.
    - iIntros "[A B]". unfold region_pointsto.
      iDestruct (big_sepL2_length with "A") as %Hlen.
      rewrite (finz_seq_between_decomposition b a e) //.
      assert (Hlnws: n = length (take n ws)).
      { rewrite length_take. rewrite Nat.min_l; auto.
        rewrite Hlen. subst n. rewrite !finz_seq_between_length /finz.dist.
        solve_addr. }
      generalize (take_drop n ws). intros HWS.
      rewrite HWS. simpl.
      iDestruct "B" as "[HB1 HB2]".
      iDestruct (pointsto_decomposition _ _ _ _ Hlnws with "A") as "[HA1 HA2]".
      case_eq (drop n ws); intros.
      + auto.
      + iDestruct "HA2" as "[HA2 HA3]".
        iDestruct "HB2" as "[HB2 HB3]".
        generalize (drop_S' _ _ _ _ _ ). intros Hdws.
        rewrite . rewrite HWS. rewrite Hdws.
        iExists w. iFrame. by rewrite .
    - iIntros "A". iDestruct "A" as (w Hws) "[A1 [B1 [A2 [B2 AB]]]]".
      unfold region_pointsto. rewrite (finz_seq_between_decomposition b a e) //.
      iDestruct "AB" as "[A3 B3]".
      rewrite {5}Hws. iFrame. rewrite {3}Hws. iFrame.
  Unshelve. Fail idtac. Admitted.


  Lemma extract_from_region' b e a ws φ `{!∀ x, Persistent x)}:
    let n := length (finz.seq_between b a) in
    (b a a < e)%a
    (region_pointsto b e ws ([∗ list] w ws, φ w)) ⊣⊢
     ( w,
        ws = take n ws (w::drop (S n) ws)
         region_pointsto b a (take n ws)
         ([∗ list] w ws, φ w)
         a ↦ₐ w φ w
         region_pointsto (a^+1)%a e (drop (S n) ws))%I.
  Proof.
    intros. iSplit.
    - iIntros "H".
      iDestruct (extract_from_region with "H") as (w Hws) "(?&?&?&#Hφ&?&?)"; eauto.
      iExists _. iFrame. iSplitR. iPureIntro. by rewrite {1}Hws //.
      rewrite {3}Hws. iFrame. iSplit; iApply "Hφ".
    - iIntros "H". iApply (extract_from_region with "[H]"); eauto.
      iDestruct "H" as (w Hws) "(?&Hl&?&#Hφ&?)". iExists _. iFrame.
      iSplitR. iPureIntro. by rewrite {1}Hws //.
      rewrite {1}Hws. iDestruct (big_sepL_app with "Hl") as "[? ?]".
      cbn. iFrame.
  Unshelve. Fail idtac. Admitted.


  Lemma extract_from_region_inv b e a (φ : Addr iProp Σ) `{!∀ x, Persistent x)}:
    (b a a < e)%a
     (([∗ list] a' (finz.seq_between b e), φ a')
     φ a)%I.
  Proof.
    iIntros (Ha) "#Hreg".
    generalize (finz_seq_between_decomposition _ _ _ Ha); intro HRA. rewrite HRA.
    iDestruct (big_sepL_app with "Hreg") as "[Hlo Hhi] /=".
    iDestruct "Hhi" as "[$ _]".
  Unshelve. Fail idtac. Admitted.


  Lemma extract_from_region_inv_2 b e a ws (φ : Addr Word iProp Σ)
        `{!∀ x y, Persistent x y)}:
    let n := length (finz.seq_between b a) in
    (b a a < e)%a
     (([∗ list] a';w' (finz.seq_between b e);ws, φ a' w')
      w, φ a w ws = (take n ws) w :: (drop (S n) ws))%I.
  Proof.
    iIntros (n Ha) "#Hreg".
    iDestruct (big_sepL2_length with "Hreg") as %Hlen.
    rewrite (finz_seq_between_decomposition b a e) //.
    assert (Hlnws: n = length (take n ws)).
    { rewrite length_take. rewrite Nat.min_l; auto.
      rewrite Hlen. subst n. rewrite !finz_seq_between_length /finz.dist.
      solve_addr. }
    generalize (take_drop n ws). intros HWS.
    rewrite HWS.
    iDestruct (big_sepL2_app_inv_l _ (finz.seq_between b a) (a :: finz.seq_between _ e)
                 with "Hreg") as ( ) "[Hl1 Hl2]".
    destruct ; auto.
    simpl. iDestruct "Hl2" as "[Ha Hl2]".
    iExists w. iFrame "#".
    iDestruct (big_sepL2_length with "Hl1") as %.
    iDestruct (big_sepL2_length with "Hl2") as %.
    iPureIntro.
    rewrite take_app_length' //.
    assert (drop n ws = w :: ) as .
    { apply app_inj_1 in as [_ Heq]; auto.
        by rewrite -Hlnws. }
    rewrite (drop_S' _ (take n ws drop n ws) n w ()); try congruence.
  Unshelve. Fail idtac. Admitted.


  Notation "[[ b , e ]] ↦ₐ [[ ws ]]" := (region_pointsto b e ws)
            (at level 50, format "[[ b , e ]] ↦ₐ [[ ws ]]") : bi_scope.

  Lemma region_pointsto_cons
      (b b' e : Addr) (w : Word) (ws : list Word) :
    (b + 1)%a = Some b' (b' e)%a
    [[b, e]] ↦ₐ [[ w :: ws ]] ⊣⊢ b ↦ₐ w [[b', e]] ↦ₐ [[ ws ]].
  Proof.
    intros Hb' .
    rewrite /region_pointsto.
    rewrite (finz_seq_between_decomposition b b e).
    2: revert Hb' ; clear; intros; split; solve_addr.
    rewrite finz_seq_between_empty /=.
    2: clear; solve_addr.
    rewrite (_: (b ^+ 1) = b')%a.
    2: revert Hb' ; clear; intros; solve_addr.
    eauto.
  Unshelve. Fail idtac. Admitted.


  Lemma region_pointsto_single b e l:
    (b+1)%a = Some e
    [[b,e]] ↦ₐ [[l]] -∗
     v, b ↦ₐ v l = [v].
  Proof.
    iIntros (Hbe) "H". rewrite /region_pointsto finz_seq_between_singleton //.
    iDestruct (big_sepL2_length with "H") as %Hlen.
    cbn in Hlen. destruct l as [|x l']; [by inversion Hlen|].
    destruct l'; [| by inversion Hlen]. iExists x. cbn.
    iDestruct "H" as "(H & _)". eauto.
  Unshelve. Fail idtac. Admitted.


  Lemma region_pointsto_split (b e a : Addr) (w1 w2 : list Word) :
     (b a e)%Z
     (length ) = (finz.dist b a)
     ([[b,e]]↦ₐ[[ ]] ⊣⊢ [[b,a]]↦ₐ[[]] [[a,e]]↦ₐ[[]])%I.
   Proof with try (rewrite /finz.dist; solve_addr).
     intros [Hba Hae] Hsize.
     iSplit.
     - iIntros "Hbe".
       rewrite /region_pointsto /finz.seq_between.
       rewrite (finz_seq_decomposition _ _ (finz.dist b a))...
       iDestruct (big_sepL2_app' with "Hbe") as "[Hba Ha'b]".
       + by rewrite finz_seq_length.
       + iFrame.
         rewrite (_: (b ^+ finz.dist b a)%a = a)...
         rewrite (_: finz.dist a e = finz.dist b e - finz.dist b a)...
         (* todo: turn these two into lemmas *)
     - iIntros "[Hba Hae]".
       rewrite /region_pointsto /finz.seq_between. (* todo: use a proper region splitting lemma *)
       rewrite (finz_seq_decomposition (finz.dist b e) _ (finz.dist b a))...
       iApply (big_sepL2_app with "Hba [Hae]"); cbn.
       rewrite (_: (b ^+ finz.dist b a)%a = a)...
       rewrite (_: finz.dist b e - finz.dist b a = finz.dist a e)...
   Unshelve. Fail idtac. Admitted.


   (*--------------------------------------------------------------------------*)

  Definition region_pointsto_spec (b e : Addr) (ws : list Word) : iProp Σ :=
    ([∗ list] ky1;y2 (finz.seq_between b e);ws, ↣ₐ )%I.

  Lemma pointsto_decomposition_spec:
     l1 l2 ws1 ws2,
      length = length
      ([∗ list] k y1;y2 ( );( ), ↣ₐ )%I ⊣⊢
      ([∗ list] k y1;y2 ;, ↣ₐ )%I ([∗ list] k y1;y2 ;, ↣ₐ )%I.
  Proof. intros. rewrite big_sepL2_app' //. Qed.

  Lemma extract_from_region_spec b e a ws φ :
    let n := length (finz.seq_between b a) in
    (b a a < e)%a
    (region_pointsto_spec b e ws ([∗ list] w ws, φ w)) ⊣⊢
     ( w,
        ws = take n ws (w::drop (S n) ws)
         region_pointsto_spec b a (take n ws)
         ([∗ list] w (take n ws), φ w)
         a ↣ₐ w φ w
         region_pointsto_spec (a^+1)%a e (drop (S n) ws)
         ([∗ list] w (drop (S n) ws), φ w)%I).
  Proof.
    intros. iSplit.
    - iIntros "[A B]". unfold region_pointsto_spec.
      iDestruct (big_sepL2_length with "A") as %Hlen.
      rewrite (finz_seq_between_decomposition b a e) //.
      assert (Hlnws: n = length (take n ws)).
      { rewrite length_take. rewrite Nat.min_l; auto.
        rewrite Hlen. subst n. rewrite !finz_seq_between_length /finz.dist.
        solve_addr. }
      generalize (take_drop n ws). intros HWS.
      rewrite HWS. simpl.
      iDestruct "B" as "[HB1 HB2]".
      iDestruct (pointsto_decomposition_spec _ _ _ _ Hlnws with "A") as "[HA1 HA2]".
      case_eq (drop n ws); intros.
      + auto.
      + iDestruct "HA2" as "[HA2 HA3]".
        iDestruct "HB2" as "[HB2 HB3]".
        generalize (drop_S' _ _ _ _ _ ). intros Hdws.
        rewrite . rewrite HWS. rewrite Hdws.
        iExists w. iFrame. by rewrite .
    - iIntros "A". iDestruct "A" as (w Hws) "[A1 [B1 [A2 [B2 AB]]]]".
      unfold region_pointsto_spec. rewrite (finz_seq_between_decomposition b a e) //.
      iDestruct "AB" as "[A3 B3]".
      rewrite {5}Hws. iFrame. rewrite {3}Hws. iFrame.
  Unshelve. Fail idtac. Admitted.


  Lemma extract_from_region_spec' b e a ws φ `{!∀ x, Persistent x)}:
    let n := length (finz.seq_between b a) in
    (b a a < e)%a
    (region_pointsto_spec b e ws ([∗ list] w ws, φ w)) ⊣⊢
     ( w,
        ws = take n ws (w::drop (S n) ws)
         region_pointsto_spec b a (take n ws)
         ([∗ list] w ws, φ w)
         a ↣ₐ w φ w
         region_pointsto_spec (a^+1)%a e (drop (S n) ws))%I.
  Proof.
    intros. iSplit.
    - iIntros "H".
      iDestruct (extract_from_region_spec with "H") as (w Hws) "(?&?&?&#Hφ&?&?)"; eauto.
      iExists _. iFrame. iSplitR. iPureIntro. by rewrite {1}Hws //.
      rewrite {3}Hws. iFrame. iSplit; iApply "Hφ".
    - iIntros "H". iApply (extract_from_region_spec with "[H]"); eauto.
      iDestruct "H" as (w Hws) "(?&Hl&?&#Hφ&?)". iExists _. iFrame.
      iSplitR. iPureIntro. by rewrite {1}Hws //.
      rewrite {1}Hws. iDestruct (big_sepL_app with "Hl") as "[? ?]".
      cbn. iFrame.
  Unshelve. Fail idtac. Admitted.


  Notation "[[ b , e ]] ↣ₐ [[ ws ]]" := (region_pointsto_spec b e ws)
            (at level 50, format "[[ b , e ]] ↣ₐ [[ ws ]]") : bi_scope.

  Lemma region_pointsto_cons_spec
      (b b' e : Addr) (w : Word) (ws : list Word) :
    (b + 1)%a = Some b' (b' e)%a
    [[b, e]] ↣ₐ [[ w :: ws ]] ⊣⊢ b ↣ₐ w [[b', e]] ↣ₐ [[ ws ]].
  Proof.
    intros Hb' .
    rewrite /region_pointsto_spec.
    rewrite (finz_seq_between_decomposition b b e).
    2: revert Hb' ; clear; intros; split; solve_addr.
    rewrite finz_seq_between_empty /=.
    2: clear; solve_addr.
    rewrite (_: (b ^+ 1) = b')%a.
    2: revert Hb' ; clear; intros; solve_addr.
    eauto.
  Unshelve. Fail idtac. Admitted.


  Lemma region_pointsto_single_spec b e l:
    (b+1)%a = Some e
    [[b,e]] ↣ₐ [[l]] -∗
     v, b ↣ₐ v l = [v].
  Proof.
    iIntros (Hbe) "H". rewrite /region_pointsto_spec finz_seq_between_singleton //.
    iDestruct (big_sepL2_length with "H") as %Hlen.
    cbn in Hlen. destruct l as [|x l']; [by inversion Hlen|].
    destruct l'; [| by inversion Hlen]. iExists x. cbn.
    iDestruct "H" as "(H & _)". eauto.
  Unshelve. Fail idtac. Admitted.


  Lemma region_pointsto_split_spec (b e a : Addr) (w1 w2 : list Word) :
     (b a e)%Z
     (length ) = (finz.dist b a)
     ([[b,e]]↣ₐ[[ ]] ⊣⊢ [[b,a]]↣ₐ[[]] [[a,e]]↣ₐ[[]])%I.
   Proof with try (rewrite /finz.dist; solve_addr).
     intros [Hba Hae] Hsize.
     iSplit.
     - iIntros "Hbe".
       rewrite /region_pointsto_spec /finz.seq_between.
       rewrite (finz_seq_decomposition _ _ (finz.dist b a))...
       iDestruct (big_sepL2_app' with "Hbe") as "[Hba Ha'b]".
       + by rewrite finz_seq_length.
       + iFrame.
         rewrite (_: (b ^+ finz.dist b a)%a = a)...
         rewrite (_: finz.dist a e = finz.dist b e - finz.dist b a)...
         (* todo: turn these two into lemmas *)
     - iIntros "[Hba Hae]".
       rewrite /region_pointsto_spec /finz.seq_between. (* todo: use a proper region splitting lemma *)
       rewrite (finz_seq_decomposition (finz.dist b e) _ (finz.dist b a))...
       iApply (big_sepL2_app with "Hba [Hae]"); cbn.
       rewrite (_: (b ^+ finz.dist b a)%a = a)...
       rewrite (_: finz.dist b e - finz.dist b a = finz.dist a e)...
   Unshelve. Fail idtac. Admitted.


End region.

Global Notation "[[ b , e ]] ↦ₐ [[ ws ]]" := (region_pointsto b e ws)
            (at level 50, format "[[ b , e ]] ↦ₐ [[ ws ]]") : bi_scope.

Global Notation "[[ b , e ]] ⊂ₐ [[ b' , e' ]]" := (included b e b' e')
            (at level 50, format "[[ b , e ]] ⊂ₐ [[ b' , e' ]]") : bi_scope.

Global Notation "a ∈ₐ [[ b , e ]]" := (in_range a b e)
            (at level 50, format "a ∈ₐ [[ b , e ]]") : bi_scope.

Global Notation "[[ b , e ]] ↣ₐ [[ ws ]]" := (region_pointsto_spec b e ws)
            (at level 50, format "[[ b , e ]] ↣ₐ [[ ws ]]") : bi_scope.

Section codefrag.
  Context {Σ:gFunctors} {memg:memG Σ} {regg:regG Σ}
    `{MP: MachineParameters}.

  Definition codefrag (a0: Addr) (cs: list Word) :=
    ([[ , ( ^+ length cs)%a ]] ↦ₐ [[ cs ]])%I.

  Lemma codefrag_contiguous_region a0 cs :
    codefrag cs -∗
      ContiguousRegion (length cs).
  Proof using.
    iIntros "Hcs". unfold codefrag.
    iDestruct (big_sepL2_length with "Hcs") as %Hl.
    set an := ( + length cs)%a in Hl |- *.
    unfold ContiguousRegion.
    destruct an eqn:Han; subst an; [ by eauto |]. cbn.
    exfalso. rewrite finz_seq_between_length /finz.dist in Hl.
    solve_addr.
  Unshelve. Fail idtac. Admitted.


End codefrag.