Skip to content
Snippets Groups Projects
Commit 1381523f authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan
Browse files

Port other kinds of borrows.

parent bd38fde2
No related branches found
No related tags found
No related merge requests found
...@@ -7,3 +7,5 @@ theories/lifetime/primitive.v ...@@ -7,3 +7,5 @@ theories/lifetime/primitive.v
theories/lifetime/todo.v theories/lifetime/todo.v
theories/lifetime/borrow.v theories/lifetime/borrow.v
theories/lifetime/shr_borrow.v theories/lifetime/shr_borrow.v
theories/lifetime/frac_borrow.v
theories/lifetime/tl_borrow.v
...@@ -2,64 +2,64 @@ From Coq Require Import Qcanon. ...@@ -2,64 +2,64 @@ From Coq Require Import Qcanon.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris.base_logic Require Import lib.fractional. From iris.base_logic Require Import lib.fractional.
From iris.algebra Require Import frac. From iris.algebra Require Import frac.
From lrust Require Export lifetime shr_borrow. From lrust.lifetime Require Export shr_borrow .
Class frac_borrowG Σ := frac_borrowG_inG :> inG Σ fracR. Class frac_borG Σ := frac_borG_inG :> inG Σ fracR.
Definition frac_borrow `{invG Σ, lifetimeG Σ, frac_borrowG Σ} κ (Φ : Qp iProp Σ) := Definition frac_bor `{invG Σ, lftG Σ, frac_borG Σ} κ (Φ : Qp iProp Σ) :=
( γ κ', κ κ' &shr{κ'} q, Φ q own γ q ( γ κ', κ κ' &shr{κ'} q, Φ q own γ q
(q = 1%Qp q', (q + q' = 1)%Qp q'.[κ']))%I. (q = 1%Qp q', (q + q' = 1)%Qp q'.[κ']))%I.
Notation "&frac{ κ } P" := (frac_borrow κ P) Notation "&frac{ κ } P" := (frac_bor κ P)
(format "&frac{ κ } P", at level 20, right associativity) : uPred_scope. (format "&frac{ κ } P", at level 20, right associativity) : uPred_scope.
Section frac_borrow. Section frac_bor.
Context `{invG Σ, lifetimeG Σ, frac_borrowG Σ}. Context `{invG Σ, lftG Σ, frac_borG Σ}.
Implicit Types E : coPset. Implicit Types E : coPset.
Global Instance frac_borrow_proper : Global Instance frac_bor_proper :
Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (frac_borrow κ). Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (frac_bor κ).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
Global Instance frac_borrow_persistent : PersistentP (&frac{κ}Φ) := _. Global Instance frac_bor_persistent : PersistentP (&frac{κ}Φ) := _.
Lemma borrow_fracture φ E κ : Lemma bor_fracture φ E κ :
lftN E lft_ctx -∗ &{κ}(φ 1%Qp) ={E}=∗ &frac{κ}φ. lftN E lft_ctx -∗ &{κ}(φ 1%Qp) ={E}=∗ &frac{κ}φ.
Proof. Proof.
iIntros (?) "#LFT Hφ". iMod (own_alloc 1%Qp) as (γ) "?". done. iIntros (?) "#LFT Hφ". iMod (own_alloc 1%Qp) as (γ) "?". done.
iMod (borrow_acc_atomic_strong with "LFT Hφ") as "[[Hφ Hclose]|[H† Hclose]]". done. iMod (bor_acc_atomic_strong with "LFT Hφ") as "[[Hφ Hclose]|[H† Hclose]]". done.
- iMod ("Hclose" with "*[-]") as "Hφ"; last first. - iMod ("Hclose" with "*[-]") as "Hφ"; last first.
{ iExists γ, κ. iSplitR; last by iApply (borrow_share with "Hφ"). { iExists γ, κ. iSplitR; last by iApply (bor_share with "Hφ").
iApply lft_incl_refl. } iApply lft_incl_refl. }
iSplitL. by iExists 1%Qp; iFrame; auto. iSplitL. by iExists 1%Qp; iFrame; auto.
iIntros "!>H† HΦ!>". iNext. iDestruct "HΦ" as (q') "(HΦ & _ & [%|Hκ])". by subst. iIntros "!>H† HΦ!>". iNext. iDestruct "HΦ" as (q') "(HΦ & _ & [%|Hκ])". by subst.
iDestruct "Hκ" as (q'') "[_ Hκ]". iDestruct "Hκ" as (q'') "[_ Hκ]".
iDestruct (lft_own_dead with "Hκ H†") as "[]". iDestruct (lft_tok_dead with "Hκ H†") as "[]".
- iMod ("Hclose" with "*") as "HΦ"; last first. - iMod ("Hclose" with "*") as "HΦ"; last first.
iExists γ, κ. iSplitR. by iApply lft_incl_refl. iExists γ, κ. iSplitR. by iApply lft_incl_refl.
iMod (borrow_fake with "LFT H†"). done. by iApply borrow_share. iMod (bor_fake with "LFT H†"). done. by iApply bor_share.
Qed. Qed.
Lemma frac_borrow_atomic_acc E κ φ : Lemma frac_bor_atomic_acc E κ φ :
lftN E lftN E
lft_ctx -∗ &frac{κ}φ ={E,E∖↑lftN}=∗ ( q, φ q ( φ q ={E∖↑lftN,E}=∗ True)) lft_ctx -∗ &frac{κ}φ ={E,E∖↑lftN}=∗ ( q, φ q ( φ q ={E∖↑lftN,E}=∗ True))
[κ] |={E∖↑lftN,E}=> True. [κ] |={E∖↑lftN,E}=> True.
Proof. Proof.
iIntros (?) "#LFT #Hφ". iDestruct "Hφ" as (γ κ') "[Hκκ' Hshr]". iIntros (?) "#LFT #Hφ". iDestruct "Hφ" as (γ κ') "[Hκκ' Hshr]".
iMod (shr_borrow_acc with "LFT Hshr") as "[[Hφ Hclose]|[H† Hclose]]". done. iMod (shr_bor_acc with "LFT Hshr") as "[[Hφ Hclose]|[H† Hclose]]". done.
- iLeft. iDestruct "Hφ" as (q) "(Hφ & Hγ & H)". iExists q. iFrame. - iLeft. iDestruct "Hφ" as (q) "(Hφ & Hγ & H)". iExists q. iFrame.
iIntros "!>Hφ". iApply "Hclose". iExists q. iFrame. iIntros "!>Hφ". iApply "Hclose". iExists q. iFrame.
- iRight. iMod "Hclose" as "_". iMod (lft_incl_dead with "Hκκ' H†") as "$". done. - iRight. iMod "Hclose" as "_". iMod (lft_incl_dead with "Hκκ' H†") as "$". done.
iApply fupd_intro_mask. set_solver. done. iApply fupd_intro_mask. set_solver. done.
Qed. Qed.
Lemma frac_borrow_acc_strong E q κ Φ: Lemma frac_bor_acc_strong E q κ Φ:
lftN E lftN E
lft_ctx -∗ ( q1 q2, Φ (q1+q2)%Qp Φ q1 Φ q2) -∗ lft_ctx -∗ ( q1 q2, Φ (q1+q2)%Qp Φ q1 Φ q2) -∗
&frac{κ}Φ -∗ q.[κ] ={E}=∗ q', Φ q' ( Φ q' ={E}=∗ q.[κ]). &frac{κ}Φ -∗ q.[κ] ={E}=∗ q', Φ q' ( Φ q' ={E}=∗ q.[κ]).
Proof. Proof.
iIntros (?) "#LFT #HΦ Hfrac Hκ". unfold frac_borrow. iIntros (?) "#LFT #HΦ Hfrac Hκ". unfold frac_bor.
iDestruct "Hfrac" as (γ κ') "#[#Hκκ' Hshr]". iDestruct "Hfrac" as (γ κ') "#[#Hκκ' Hshr]".
iMod (lft_incl_acc with "Hκκ' Hκ") as (qκ') "[[Hκ1 Hκ2] Hclose]". done. iMod (lft_incl_acc with "Hκκ' Hκ") as (qκ') "[[Hκ1 Hκ2] Hclose]". done.
iMod (shr_borrow_acc_tok with "LFT Hshr Hκ1") as "[H Hclose']". done. iMod (shr_bor_acc_tok with "LFT Hshr Hκ1") as "[H Hclose']". done.
iDestruct "H" as () "(HΦqΦ & >Hown & Hq)". iDestruct "H" as () "(HΦqΦ & >Hown & Hq)".
destruct (Qp_lower_bound (qκ'/2) (/2)) as (qq & qκ'0 & qΦ0 & Hqκ' & HqΦ). destruct (Qp_lower_bound (qκ'/2) (/2)) as (qq & qκ'0 & qΦ0 & Hqκ' & HqΦ).
iExists qq. iExists qq.
...@@ -74,7 +74,7 @@ Section frac_borrow. ...@@ -74,7 +74,7 @@ Section frac_borrow.
- iDestruct "Hq" as (q') "[% Hq'κ]". iExists (qq + q')%Qp. - iDestruct "Hq" as (q') "[% Hq'κ]". iExists (qq + q')%Qp.
iIntros "{$Hκq $Hq'κ}!%". by rewrite assoc (comm _ _ qq) assoc -HqΦ Qp_div_2. } iIntros "{$Hκq $Hq'κ}!%". by rewrite assoc (comm _ _ qq) assoc -HqΦ Qp_div_2. }
clear HqΦ qΦ0. iIntros "!>HqΦ". clear HqΦ qΦ0. iIntros "!>HqΦ".
iMod (shr_borrow_acc_tok with "LFT Hshr Hκ1") as "[H Hclose']". done. iMod (shr_bor_acc_tok with "LFT Hshr Hκ1") as "[H Hclose']". done.
iDestruct "H" as () "(HΦqΦ & >Hown & >[%|Hq])". iDestruct "H" as () "(HΦqΦ & >Hown & >[%|Hq])".
{ subst. iCombine "Hown" "Hownq" as "Hown". { subst. iCombine "Hown" "Hownq" as "Hown".
by iDestruct (own_valid with "Hown") as %Hval%Qp_not_plus_q_ge_1. } by iDestruct (own_valid with "Hown") as %Hval%Qp_not_plus_q_ge_1. }
...@@ -97,33 +97,33 @@ Section frac_borrow. ...@@ -97,33 +97,33 @@ Section frac_borrow.
iApply "Hclose". iFrame. rewrite Hqκ'. by iFrame. iApply "Hclose". iFrame. rewrite Hqκ'. by iFrame.
Qed. Qed.
Lemma frac_borrow_acc E q κ `{Fractional _ Φ} : Lemma frac_bor_acc E q κ `{Fractional _ Φ} :
lftN E lftN E
lft_ctx -∗ &frac{κ}Φ -∗ q.[κ] ={E}=∗ q', Φ q' ( Φ q' ={E}=∗ q.[κ]). lft_ctx -∗ &frac{κ}Φ -∗ q.[κ] ={E}=∗ q', Φ q' ( Φ q' ={E}=∗ q.[κ]).
Proof. Proof.
iIntros (?) "LFT". iApply (frac_borrow_acc_strong with "LFT"). done. iIntros (?) "LFT". iApply (frac_bor_acc_strong with "LFT"). done.
iIntros "!#*". rewrite fractional. iSplit; auto. iIntros "!#*". rewrite fractional. iSplit; auto.
Qed. Qed.
Lemma frac_borrow_shorten κ κ' Φ: κ κ' -∗ &frac{κ'}Φ -∗ &frac{κ}Φ. Lemma frac_bor_shorten κ κ' Φ: κ κ' -∗ &frac{κ'}Φ -∗ &frac{κ}Φ.
Proof. Proof.
iIntros "Hκκ' H". iDestruct "H" as (γ κ0) "[#H⊑ ?]". iExists γ, κ0. iFrame. iIntros "Hκκ' H". iDestruct "H" as (γ κ0) "[#H⊑ ?]". iExists γ, κ0. iFrame.
iApply (lft_incl_trans with "Hκκ' []"). auto. iApply (lft_incl_trans with "Hκκ' []"). auto.
Qed. Qed.
Lemma frac_borrow_incl κ κ' q: Lemma frac_bor_incl κ κ' q:
lft_ctx -∗ &frac{κ}(λ q', (q * q').[κ']) -∗ κ κ'. lft_ctx -∗ &frac{κ}(λ q', (q * q').[κ']) -∗ κ κ'.
Proof. Proof.
iIntros "#LFT#Hbor!#". iSplitR. iIntros "#LFT#Hbor!#". iSplitR.
- iIntros (q') "Hκ'". - iIntros (q') "Hκ'".
iMod (frac_borrow_acc with "LFT Hbor Hκ'") as (q'') "[>? Hclose]". done. iMod (frac_bor_acc with "LFT Hbor Hκ'") as (q'') "[>? Hclose]". done.
iExists _. iFrame. iIntros "!>Hκ'". iApply "Hclose". auto. iExists _. iFrame. iIntros "!>Hκ'". iApply "Hclose". auto.
- iIntros "H†'". - iIntros "H†'".
iMod (frac_borrow_atomic_acc with "LFT Hbor") as "[H|[$ $]]". done. iMod (frac_bor_atomic_acc with "LFT Hbor") as "[H|[$ $]]". done.
iDestruct "H" as (q') "[>Hκ' _]". iDestruct "H" as (q') "[>Hκ' _]".
iDestruct (lft_own_dead with "Hκ' H†'") as "[]". iDestruct (lft_tok_dead with "Hκ' H†'") as "[]".
Qed. Qed.
End frac_borrow. End frac_bor.
Typeclasses Opaque frac_borrow. Typeclasses Opaque frac_bor.
From lrust Require Export lifetime. From lrust.lifetime Require Export derived.
From iris.base_logic.lib Require Export thread_local. From iris.base_logic.lib Require Export thread_local.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
Definition tl_borrow `{invG Σ, lifetimeG Σ, thread_localG Σ} Definition tl_bor `{invG Σ, lftG Σ, thread_localG Σ}
(κ : lifetime) (tid : thread_id) (N : namespace) (P : iProp Σ) := (κ : lft) (tid : thread_id) (N : namespace) (P : iProp Σ) :=
( i, idx_borrow κ i P tl_inv tid N (idx_borrow_own 1 i))%I. ( i, idx_bor κ i P tl_inv tid N (idx_bor_own 1 i))%I.
Notation "&tl{ κ , tid , N } P" := (tl_borrow κ tid N P) Notation "&tl{ κ , tid , N } P" := (tl_bor κ tid N P)
(format "&tl{ κ , tid , N } P", at level 20, right associativity) : uPred_scope. (format "&tl{ κ , tid , N } P", at level 20, right associativity) : uPred_scope.
Section tl_borrow. Section tl_bor.
Context `{invG Σ, lifetimeG Σ, thread_localG Σ} Context `{invG Σ, lftG Σ, thread_localG Σ}
(tid : thread_id) (N : namespace) (P : iProp Σ). (tid : thread_id) (N : namespace) (P : iProp Σ).
Global Instance tl_borrow_persistent κ : PersistentP (&tl{κ,tid,N} P) := _. Global Instance tl_bor_persistent κ : PersistentP (&tl{κ,tid,N} P) := _.
Global Instance tl_borrow_proper κ : Global Instance tl_bor_proper κ :
Proper ((⊣⊢) ==> (⊣⊢)) (tl_borrow κ tid N). Proper ((⊣⊢) ==> (⊣⊢)) (tl_bor κ tid N).
Proof. Proof.
intros P1 P2 EQ. apply uPred.exist_proper. intros i. by rewrite EQ. intros P1 P2 EQ. apply uPred.exist_proper. intros i. by rewrite EQ.
Qed. Qed.
Lemma borrow_tl κ E : lftN E &{κ}P ={E}=∗ &tl{κ,tid,N}P. Lemma bor_tl κ E : lftN E &{κ}P ={E}=∗ &tl{κ,tid,N}P.
Proof. Proof.
iIntros (?) "HP". unfold borrow. iDestruct "HP" as (i) "[#? Hown]". iIntros (?) "HP". rewrite bor_unfold_idx. iDestruct "HP" as (i) "[#? Hown]".
iExists i. iFrame "#". iApply (tl_inv_alloc tid E N with "[Hown]"). auto. iExists i. iFrame "#". iApply (tl_inv_alloc tid E N with "[Hown]"). auto.
Qed. Qed.
Lemma tl_borrow_acc q κ E F : Lemma tl_bor_acc q κ E F :
lftN E tlN E N F lftN E tlN E N F
lft_ctx -∗ &tl{κ,tid,N}P -∗ q.[κ] -∗ tl_own tid F ={E}=∗ lft_ctx -∗ &tl{κ,tid,N}P -∗ q.[κ] -∗ tl_own tid F ={E}=∗
P tl_own tid (F N) P tl_own tid (F N)
...@@ -35,17 +35,17 @@ Section tl_borrow. ...@@ -35,17 +35,17 @@ Section tl_borrow.
iIntros (???) "#LFT#HP Hκ Htlown". iIntros (???) "#LFT#HP Hκ Htlown".
iDestruct "HP" as (i) "(#Hpers&#Hinv)". iDestruct "HP" as (i) "(#Hpers&#Hinv)".
iMod (tl_inv_open with "Hinv Htlown") as "(>Hown&Htlown&Hclose)"; try done. iMod (tl_inv_open with "Hinv Htlown") as "(>Hown&Htlown&Hclose)"; try done.
iMod (idx_borrow_acc with "LFT Hpers Hown Hκ") as "[HP Hclose']". done. iMod (idx_bor_acc with "LFT Hpers Hown Hκ") as "[HP Hclose']". done.
iIntros "{$HP $Htlown}!>HP Htlown". iIntros "{$HP $Htlown}!>HP Htlown".
iMod ("Hclose'" with "HP") as "[Hown $]". iApply "Hclose". by iFrame. iMod ("Hclose'" with "HP") as "[Hown $]". iApply "Hclose". by iFrame.
Qed. Qed.
Lemma tl_borrow_shorten κ κ': κ κ' -∗ &tl{κ'|tid|N}P -∗ &tl{κ,tid,N}P. Lemma tl_bor_shorten κ κ': κ κ' -∗ &tl{κ',tid,N}P -∗ &tl{κ,tid,N}P.
Proof. Proof.
iIntros "Hκκ' H". iDestruct "H" as (i) "[??]". iExists i. iFrame. iIntros "Hκκ' H". iDestruct "H" as (i) "[??]". iExists i. iFrame.
iApply (idx_borrow_shorten with "Hκκ' H"). iApply (idx_bor_shorten with "Hκκ' H").
Qed. Qed.
End tl_borrow. End tl_bor.
Typeclasses Opaque tl_borrow. Typeclasses Opaque tl_bor.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment