diff --git a/theories/typing/mem_instructions.v b/theories/typing/mem_instructions.v index 3e82fbb7b684881d4697c2757eaad0716a1b9f9b..8c7d31e81716fea037723cec8c45fe01f0dd92a7 100644 --- a/theories/typing/mem_instructions.v +++ b/theories/typing/mem_instructions.v @@ -11,6 +11,111 @@ From lrust.typing Require Import typing product perm uninit own uniq_bor shr_bor Section typing. Context `{typeG Σ}. + + Lemma update_strong ty1 ty2 n: + ty1.(ty_size) = ty2.(ty_size) → + update ty1 (λ ν, ν â— own n ty2)%P (λ ν, ν â— own n ty1)%P. + Proof. + iIntros (Hsz ν tid Φ E ?) "_ Hâ— HΦ". iApply (has_type_wp with "Hâ—"). + iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". + iDestruct "Heq" as %[= ->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". + rewrite ty2.(ty_size_eq) -Hsz. iDestruct "Hown" as ">%". iApply "HΦ". iFrame "∗%". + iIntros (vl') "[H↦ Hown']!>". rewrite /has_type Hνv. + iExists _. iSplit. done. iFrame. iExists _. iFrame. + Qed. + + Lemma consumes_copy_own ty n: + Copy ty → consumes ty (λ ν, ν â— own n ty)%P (λ ν, ν â— own n ty)%P. + Proof. + iIntros (? ν tid Φ E ?) "_ Hâ— Htl HΦ". iApply (has_type_wp with "Hâ—"). + iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". + iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ #Hown]". + iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". + by rewrite ty.(ty_size_eq). + iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦!>". + rewrite /has_type Hνv. iExists _. iSplit. done. iFrame. iExists vl. eauto. + Qed. + + Lemma consumes_move ty n: + consumes ty (λ ν, ν â— own n ty)%P (λ ν, ν â— own n (uninit ty.(ty_size)))%P. + Proof. + iIntros (ν tid Φ E ?) "_ Hâ— Htl HΦ". iApply (has_type_wp with "Hâ—"). + iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". + iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". + iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">Hlen". + by rewrite ty.(ty_size_eq). iDestruct "Hlen" as %Hlen. + iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦!>". + rewrite /has_type Hνv. iExists _. iSplit. done. iSplitR "H†". + - rewrite -Hlen. iExists vl. iIntros "{$H↦}!>". clear. + iInduction vl as [|v vl] "IH". done. + iExists [v], vl. iSplit. done. by iSplit. + - rewrite uninit_sz; auto. + Qed. + + + Lemma consumes_copy_uniq_bor `(!Copy ty) κ κ' q: + consumes ty (λ ν, ν â— &uniq{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P + (λ ν, ν â— &uniq{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. + Proof. + iIntros (ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) Htl HΦ". + iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l' P) "[[Heq #HPiff] HP]". + iDestruct "Heq" as %[=->]. + iMod (bor_iff with "LFT [] HP") as "H↦". set_solver. by eauto. + iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. + iMod (bor_acc with "LFT H↦ Htok") as "[H↦ Hclose']". set_solver. + iDestruct "H↦" as (vl) "[>H↦ #Hown]". + iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". + by rewrite ty.(ty_size_eq). + iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦". + iMod ("Hclose'" with "[H↦]") as "[H↦ Htok]". by iExists _; iFrame. + iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. + iExists _, _. erewrite <-uPred.iff_refl. auto. + Qed. + + Lemma update_weak ty q κ κ': + update ty (λ ν, ν â— &uniq{κ} ty ∗ κ' ⊑ κ ∗ q.[κ'])%P + (λ ν, ν â— &uniq{κ} ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. + Proof. + iIntros (ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) HΦ". + iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l P) "[[Heq #HPiff] HP]". + iDestruct "Heq" as %[=->]. + iMod (bor_iff with "LFT [] HP") as "H↦". set_solver. by eauto. + iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. + iMod (bor_acc with "LFT H↦ Htok") as "[H↦ Hclose']". set_solver. + iDestruct "H↦" as (vl) "[>H↦ Hown]". rewrite ty.(ty_size_eq). + iDestruct "Hown" as ">%". iApply "HΦ". iFrame "∗%#". iIntros (vl') "[H↦ Hown]". + iMod ("Hclose'" with "[H↦ Hown]") as "[Hbor Htok]". by iExists _; iFrame. + iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. + iExists _, _. erewrite <-uPred.iff_refl. auto. + Qed. + + Lemma consumes_copy_shr_bor ty κ κ' q: + Copy ty → + consumes ty (λ ν, ν â— &shr{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P + (λ ν, ν â— &shr{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. + Proof. + iIntros (? ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) Htl HΦ". + iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. + rewrite has_type_value. iDestruct "Hâ—" as (l') "[Heq #Hshr]". iDestruct "Heq" as %[=->]. + iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. + rewrite (union_difference_L (↑lrustN) ⊤); last done. + setoid_rewrite ->na_own_union; try set_solver. iDestruct "Htl" as "[Htl ?]". + iMod (copy_shr_acc with "LFT Hshr [$Htok $Htl]") as (q'') "[H↦ Hclose']". + { assert (↑shrN ⊆ (↑lrustN : coPset)) by solve_ndisj. set_solver. } (* FIXME: some tactic should solve this in one go. *) + { rewrite ->shr_locsE_shrN. solve_ndisj. } + iDestruct "H↦" as (vl) "[>H↦ #Hown]". + iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". + by rewrite ty.(ty_size_eq). + iModIntro. iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦". + iMod ("Hclose'" with "[H↦]") as "[Htok $]". iExists _; by iFrame. + iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. iExists _. eauto. + Qed. + Lemma typed_new Ï (n : nat): 0 ≤ n → typed_step_ty Ï (new [ #n]%E) (own n (uninit n)). Proof. diff --git a/theories/typing/own.v b/theories/typing/own.v index b0ecdd9e449a0e44c38cb30b5eafa9f3e4df2042..6bef64032d5e73f3907d3d9a61db7e7e29c8ff0e 100644 --- a/theories/typing/own.v +++ b/theories/typing/own.v @@ -4,7 +4,7 @@ From iris.base_logic Require Import big_op. From lrust.lifetime Require Import borrow frac_borrow. From lrust.lang Require Export new_delete. From lrust.typing Require Export type. -From lrust.typing Require Import perm typing uninit uniq_bor type_context. +From lrust.typing Require Import perm typing uniq_bor type_context. Section own. Context `{typeG Σ}. @@ -132,46 +132,4 @@ Section own. Qed. - Lemma update_strong ty1 ty2 n: - ty1.(ty_size) = ty2.(ty_size) → - update ty1 (λ ν, ν â— own n ty2)%P (λ ν, ν â— own n ty1)%P. - Proof. - iIntros (Hsz ν tid Φ E ?) "_ Hâ— HΦ". iApply (has_type_wp with "Hâ—"). - iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". - iDestruct "Heq" as %[= ->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". - rewrite ty2.(ty_size_eq) -Hsz. iDestruct "Hown" as ">%". iApply "HΦ". iFrame "∗%". - iIntros (vl') "[H↦ Hown']!>". rewrite /has_type Hνv. - iExists _. iSplit. done. iFrame. iExists _. iFrame. - Qed. - - Lemma consumes_copy_own ty n: - Copy ty → consumes ty (λ ν, ν â— own n ty)%P (λ ν, ν â— own n ty)%P. - Proof. - iIntros (? ν tid Φ E ?) "_ Hâ— Htl HΦ". iApply (has_type_wp with "Hâ—"). - iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". - iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ #Hown]". - iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". - by rewrite ty.(ty_size_eq). - iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦!>". - rewrite /has_type Hνv. iExists _. iSplit. done. iFrame. iExists vl. eauto. - Qed. - - Lemma consumes_move ty n: - consumes ty (λ ν, ν â— own n ty)%P (λ ν, ν â— own n (uninit ty.(ty_size)))%P. - Proof. - iIntros (ν tid Φ E ?) "_ Hâ— Htl HΦ". iApply (has_type_wp with "Hâ—"). - iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l) "(Heq & H↦ & >H†)". - iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". - iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">Hlen". - by rewrite ty.(ty_size_eq). iDestruct "Hlen" as %Hlen. - iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦!>". - rewrite /has_type Hνv. iExists _. iSplit. done. iSplitR "H†". - - rewrite -Hlen. iExists vl. iIntros "{$H↦}!>". clear. - iInduction vl as [|v vl] "IH". done. - iExists [v], vl. iSplit. done. by iSplit. - - rewrite uninit_sz; auto. - Qed. End own. diff --git a/theories/typing/shr_bor.v b/theories/typing/shr_bor.v index 1b0fefad6b242f7372f3ca96d922e38831e1d75c..aba596321c3a0a7130bc1cd24e21faedcd1b78c8 100644 --- a/theories/typing/shr_bor.v +++ b/theories/typing/shr_bor.v @@ -55,25 +55,4 @@ Section typing. - iExists _. iSplit. done. iIntros "_". eauto. Qed. - Lemma consumes_copy_shr_bor ty κ κ' q: - Copy ty → - consumes ty (λ ν, ν â— &shr{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P - (λ ν, ν â— &shr{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. - Proof. - iIntros (? ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) Htl HΦ". - iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l') "[Heq #Hshr]". iDestruct "Heq" as %[=->]. - iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. - rewrite (union_difference_L (↑lrustN) ⊤); last done. - setoid_rewrite ->na_own_union; try set_solver. iDestruct "Htl" as "[Htl ?]". - iMod (copy_shr_acc with "LFT Hshr [$Htok $Htl]") as (q'') "[H↦ Hclose']". - { assert (↑shrN ⊆ (↑lrustN : coPset)) by solve_ndisj. set_solver. } (* FIXME: some tactic should solve this in one go. *) - { rewrite ->shr_locsE_shrN. solve_ndisj. } - iDestruct "H↦" as (vl) "[>H↦ #Hown]". - iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". - by rewrite ty.(ty_size_eq). - iModIntro. iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦". - iMod ("Hclose'" with "[H↦]") as "[Htok $]". iExists _; by iFrame. - iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. iExists _. eauto. - Qed. End typing. diff --git a/theories/typing/uniq_bor.v b/theories/typing/uniq_bor.v index 44cbc58469ccc29d416f8719f2fd9ac64b0d355d..3d5faf027f9876f3ca96100f22778f369632c67b 100644 --- a/theories/typing/uniq_bor.v +++ b/theories/typing/uniq_bor.v @@ -139,41 +139,4 @@ Section typing. iExists _, _. erewrite <-uPred.iff_refl. eauto. Qed. - Lemma consumes_copy_uniq_bor `(!Copy ty) κ κ' q: - consumes ty (λ ν, ν â— &uniq{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P - (λ ν, ν â— &uniq{κ}ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. - Proof. - iIntros (ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) Htl HΦ". - iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l' P) "[[Heq #HPiff] HP]". - iDestruct "Heq" as %[=->]. - iMod (bor_iff with "LFT [] HP") as "H↦". set_solver. by eauto. - iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. - iMod (bor_acc with "LFT H↦ Htok") as "[H↦ Hclose']". set_solver. - iDestruct "H↦" as (vl) "[>H↦ #Hown]". - iAssert (â–· ⌜length vl = ty_size tyâŒ)%I with "[#]" as ">%". - by rewrite ty.(ty_size_eq). - iApply "HΦ". iFrame "∗#%". iIntros "!>!>!>H↦". - iMod ("Hclose'" with "[H↦]") as "[H↦ Htok]". by iExists _; iFrame. - iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. - iExists _, _. erewrite <-uPred.iff_refl. auto. - Qed. - - Lemma update_weak ty q κ κ': - update ty (λ ν, ν â— &uniq{κ} ty ∗ κ' ⊑ κ ∗ q.[κ'])%P - (λ ν, ν â— &uniq{κ} ty ∗ κ' ⊑ κ ∗ q.[κ'])%P. - Proof. - iIntros (ν tid Φ E ?) "#LFT (Hâ— & #H⊑ & Htok) HΦ". - iApply (has_type_wp with "Hâ—"). iIntros (v) "Hνv Hâ—". iDestruct "Hνv" as %Hνv. - rewrite has_type_value. iDestruct "Hâ—" as (l P) "[[Heq #HPiff] HP]". - iDestruct "Heq" as %[=->]. - iMod (bor_iff with "LFT [] HP") as "H↦". set_solver. by eauto. - iMod (lft_incl_acc with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. - iMod (bor_acc with "LFT H↦ Htok") as "[H↦ Hclose']". set_solver. - iDestruct "H↦" as (vl) "[>H↦ Hown]". rewrite ty.(ty_size_eq). - iDestruct "Hown" as ">%". iApply "HΦ". iFrame "∗%#". iIntros (vl') "[H↦ Hown]". - iMod ("Hclose'" with "[H↦ Hown]") as "[Hbor Htok]". by iExists _; iFrame. - iMod ("Hclose" with "Htok") as "$". rewrite /has_type Hνv. - iExists _, _. erewrite <-uPred.iff_refl. auto. - Qed. End typing.