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

Simplifying thread local invariants

By using the global ghost maps instead of our own ones.
parent df6f1918
No related branches found
No related tags found
No related merge requests found
...@@ -127,8 +127,7 @@ Section sts. ...@@ -127,8 +127,7 @@ Section sts.
around accessors". *) around accessors". *)
iVs (sts_accS with "[Hinv Hγf]") as (s) "(?&?& HclSts)"; first by iFrame. iVs (sts_accS with "[Hinv Hγf]") as (s) "(?&?& HclSts)"; first by iFrame.
iVsIntro. iExists s. iFrame. iIntros (s' T') "H". iVsIntro. iExists s. iFrame. iIntros (s' T') "H".
iVs ("HclSts" $! s' T' with "H") as "(Hinv & ?)". iFrame. iVs ("HclSts" $! s' T' with "H") as "(Hinv & ?)". by iVs ("Hclose" with "Hinv").
iVs ("Hclose" with "Hinv"). done.
Qed. Qed.
Lemma sts_open E N γ s0 T : Lemma sts_open E N γ s0 T :
......
...@@ -2,14 +2,10 @@ From iris.algebra Require Export gmap gset coPset. ...@@ -2,14 +2,10 @@ From iris.algebra Require Export gmap gset coPset.
From iris.proofmode Require Import invariants tactics. From iris.proofmode Require Import invariants tactics.
Import uPred. Import uPred.
Definition thread_id := positive. Definition thread_id := gname.
Class thread_localG Σ := { Class thread_localG Σ :=
tl_enabled_inG :> inG Σ (gmapUR thread_id coPset_disjR); tl_inG :> inG Σ (prodUR coPset_disjUR (gset_disjUR positive)).
tl_disabled_inG :> inG Σ (gmapUR thread_id (gset_disjR positive));
tl_enabled_name : gname;
tl_disabled_name : gname
}.
Definition tlN : namespace := nroot .@ "tl". Definition tlN : namespace := nroot .@ "tl".
...@@ -17,12 +13,11 @@ Section defs. ...@@ -17,12 +13,11 @@ Section defs.
Context `{irisG Λ Σ, thread_localG Σ}. Context `{irisG Λ Σ, thread_localG Σ}.
Definition tl_tokens (tid : thread_id) (E : coPset) : iProp Σ := Definition tl_tokens (tid : thread_id) (E : coPset) : iProp Σ :=
own tl_enabled_name {[ tid := CoPset E ]}. own tid (CoPset E, ).
Definition tl_inv (tid : thread_id) (N : namespace) (P : iProp Σ) : iProp Σ := Definition tl_inv (tid : thread_id) (N : namespace) (P : iProp Σ) : iProp Σ :=
( i, (i nclose N) ( i, (i nclose N)
inv tlN (P own tl_disabled_name {[ tid := GSet {[i]} ]} inv tlN (P own tid (, GSet {[i]}) tl_tokens tid {[i]}))%I.
tl_tokens tid {[i]}))%I.
End defs. End defs.
Instance: Params (@tl_tokens) 2. Instance: Params (@tl_tokens) 2.
...@@ -33,41 +28,35 @@ Section proofs. ...@@ -33,41 +28,35 @@ Section proofs.
Lemma tid_alloc : Lemma tid_alloc :
True =r=> tid, tl_tokens tid . True =r=> tid, tl_tokens tid .
Proof. Proof. by apply own_alloc. Qed.
iIntros.
iVs (own_empty (A:=gmapUR thread_id coPset_disjR) tl_enabled_name) as "Hempty".
iVs (own_updateP with "Hempty") as (m) "[Hm Hown]".
by apply alloc_updateP' with (x:=CoPset ).
iDestruct "Hm" as %(tid & -> & _). eauto.
Qed.
Lemma tl_tokens_disj tid E1 E2 : Lemma tl_tokens_disj tid E1 E2 :
tl_tokens tid E1 tl_tokens tid E2 (E1 E2). tl_tokens tid E1 tl_tokens tid E2 (E1 E2).
Proof. Proof.
by rewrite /tl_tokens -own_op op_singleton own_valid -coPset_disj_valid_op rewrite /tl_tokens -own_op own_valid -coPset_disj_valid_op discrete_valid.
discrete_valid singleton_valid. by iIntros ([? _])"!%".
Qed. Qed.
Lemma tl_tokens_union tid E1 E2 : Lemma tl_tokens_union tid E1 E2 :
E1 E2 tl_tokens tid (E1 E2) ⊣⊢ tl_tokens tid E1 tl_tokens tid E2. E1 E2 tl_tokens tid (E1 E2) ⊣⊢ tl_tokens tid E1 tl_tokens tid E2.
Proof. Proof.
intros ?. by rewrite /tl_tokens -own_op op_singleton coPset_disj_union. intros ?. by rewrite /tl_tokens -own_op pair_op left_id coPset_disj_union.
Qed. Qed.
Lemma tl_inv_alloc tid E N P : P ={E}=> tl_inv tid N P. Lemma tl_inv_alloc tid E N P :
P ={E}=> tl_inv tid N P.
Proof. Proof.
iIntros "HP". iIntros "HP".
iVs (own_empty (A:=gmapUR thread_id (gset_disjR positive)) tl_disabled_name) iVs (own_empty tid) as "Hempty".
as "Hempty". iVs (own_updateP with "Hempty") as ([m1 m2]) "[Hm Hown]".
iVs (own_updateP with "Hempty") as (m) "[Hm Hown]". { apply prod_updateP'. apply cmra_updateP_id, (reflexivity (R:=eq)).
{ eapply alloc_unit_singleton_updateP' with (u:=) (i:=tid). done. apply _.
apply (gset_alloc_empty_updateP_strong' (λ i, i nclose N)). apply (gset_alloc_empty_updateP_strong' (λ i, i nclose N)).
intros Ef. exists (coPpick (nclose N coPset.of_gset Ef)). intros Ef. exists (coPpick (nclose N coPset.of_gset Ef)).
rewrite -coPset.elem_of_of_gset comm -elem_of_difference. rewrite -coPset.elem_of_of_gset comm -elem_of_difference.
apply coPpick_elem_of=> Hfin. apply coPpick_elem_of=> Hfin.
eapply nclose_infinite, (difference_finite_inv _ _), Hfin. eapply nclose_infinite, (difference_finite_inv _ _), Hfin.
apply of_gset_finite. } apply of_gset_finite. }
iDestruct "Hm" as %(? & -> & i & -> & ?). simpl. iDestruct "Hm" as %(<- & i & -> & ?).
iVs (inv_alloc tlN with "[-]"). 2:iVsIntro; iExists i; eauto. iVs (inv_alloc tlN with "[-]"). 2:iVsIntro; iExists i; eauto.
iNext. iLeft. by iFrame. iNext. iLeft. by iFrame.
Qed. Qed.
...@@ -87,9 +76,8 @@ Section proofs. ...@@ -87,9 +76,8 @@ Section proofs.
iIntros "!==>[HP ?]". iFrame. iIntros "!==>[HP ?]". iFrame.
iInv tlN as "[[_ >Hdis2]|>Hitok]" "Hclose". iInv tlN as "[[_ >Hdis2]|>Hitok]" "Hclose".
+ iCombine "Hdis" "Hdis2" as "Hdis". + iCombine "Hdis" "Hdis2" as "Hdis".
iDestruct (own_valid with "Hdis") as %Hval. iDestruct (own_valid with "Hdis") as %[_ Hval]. revert Hval.
revert Hval. rewrite op_singleton singleton_valid gset_disj_valid_op. rewrite gset_disj_valid_op. set_solver.
set_solver.
+ iFrame. iApply "Hclose". iNext. iLeft. by iFrame. + iFrame. iApply "Hclose". iNext. iLeft. by iFrame.
- iDestruct (tl_tokens_disj tid {[i]} {[i]} with "[-]") as %?. by iFrame. - iDestruct (tl_tokens_disj tid {[i]} {[i]} with "[-]") as %?. by iFrame.
set_solver. set_solver.
......
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