Commit c4d5aec7 authored by Dan Frumin's avatar Dan Frumin

Flock v 2

parent 9bcba503
......@@ -2,6 +2,7 @@
-arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files
theories/lib/mset.v
theories/lib/spin_lock.v
theories/lib/flock.v
theories/lib/locking_heap.v
theories/lib/U.v
......
......@@ -2,6 +2,7 @@ From iris.heap_lang Require Export proofmode notation.
From iris.heap_lang Require Import adequacy spin_lock assert par.
From iris.algebra Require Import frac.
From iris_c.lib Require Import mset flock locking_heap.
From iris.bi Require Import fractional.
(* M A := ref (list loc) → Mutex → A *)
......@@ -19,7 +20,10 @@ Notation "a ;;; b" := (a_bind (λ: <>, b) a)%E (at level 80, right associativity
Definition a_run : val := λ: "x",
let: "env" := mset_create #() in
let: "l" := newlock #() in
"x" "env" "l".
let: "v" := "x" "env" "l"
in "v". (* TODO: we have a dummy step here :(
but potentially we would have a free(l) operation here
*)
(* M A → M A *)
Definition a_atomic : val := λ: "x" "env" "l",
......@@ -67,9 +71,8 @@ Section a_wp.
(R : iProp Σ) (Φ : val iProp Σ) : iProp Σ :=
tc_opaque (WP e {{ ev, (γ : flock_name) (π : frac) (env : val) (l : val),
is_flock amonadN γ l -
flock_res γ (env_inv env R) -
unflocked γ π -
WP ev env l {{ v, Φ v unflocked γ π }}
flock_res γ (env_inv env R) π -
WP ev env l {{ v, Φ v flock_res γ (env_inv env R) π }}
}})%I.
Global Instance elim_bupd_awp p e Φ :
......@@ -104,20 +107,21 @@ Section a_wp_rules.
Lemma awp_insert_res e Φ R1 R2 :
R1 -
awp e (R1 R2) Φ -
awp e (R1 R2) (λ v, R1 - Φ v) -
awp e R2 Φ.
Proof.
iIntros "HR1 Hawp". rewrite /awp /=.
iApply (wp_wand with "Hawp").
iIntros (v) "HΦ".
iIntros (γ π env l) "#Hflock Hres Hunfl".
iMod (flock_res_insert_unflocked with "Hflock Hres Hunfl HR1")
as "(#Hres & Hunfl)"; first done.
iApply ("HΦ" with "Hflock [Hres] Hunfl").
rewrite (comm ()%I R1 R2).
rewrite (assoc ()%I _ R2 R1).
by iFrame "Hres".
Qed.
iIntros (γ π env l) "#Hflock Hres".
(* iMod (flock_res_insert_unflocked with "Hflock Hres Hunfl HR1") *)
(* as "(#Hres & Hunfl)"; first done. *)
(* iApply ("HΦ" with "Hflock [Hres] Hunfl"). *)
(* rewrite (comm (∗)%I R1 R2). *)
(* rewrite (assoc (∗)%I _ R2 R1). *)
(* by iFrame "Hres". *)
(* Qed. *)
Abort.
Lemma awp_wand e (Φ Ψ : val iProp Σ) R :
awp e R Φ -
......@@ -127,8 +131,8 @@ Section a_wp_rules.
iIntros "HAWP Hv". rewrite /awp /=.
iApply (wp_wand with "HAWP").
iIntros (v) "HΦ".
iIntros (γ π env l) "#Hflock #Hres Hunfl".
iApply (wp_wand with "[HΦ Hunfl]"); first by iApply "HΦ".
iIntros (γ π env l) "#Hflock Hres".
iApply (wp_wand with "[HΦ Hres]"); first by iApply "HΦ".
iIntros (w) "[HΦ $]". by iApply "Hv".
Qed.
......@@ -147,7 +151,7 @@ Section a_wp_rules.
Proof.
iIntros "Hwp". rewrite /awp /a_ret /=. wp_apply (wp_wand with "Hwp").
iIntros (v) "HΦ". wp_lam.
iIntros (γ π env l) "#Hlock #Hres Hunfl". do 2 wp_lam. iFrame.
iIntros (γ π env l) "#Hlock Hres". do 2 wp_lam. iFrame.
Qed.
Lemma awp_bind (f e : expr) R Φ :
......@@ -157,53 +161,63 @@ Section a_wp_rules.
Proof.
iIntros ([fv <-%of_to_val]) "Hwp". rewrite /awp /a_bind /=. wp_lam. wp_bind e.
iApply (wp_wand with "Hwp"). iIntros (ev) "Hwp". wp_lam.
iIntros (γ π env l) "#Hlock #Hres Hunfl". do 2 wp_lam. wp_bind (ev env l).
iApply (wp_wand with "[Hwp Hunfl]"); first by iApply "Hwp".
iIntros (w) "[Hwp Hunfl]". wp_let. wp_apply (wp_wand with "Hwp").
iIntros (γ π env l) "#Hlock Hres". do 2 wp_lam. wp_bind (ev env l).
iApply (wp_wand with "[Hwp Hres]"); first by iApply "Hwp".
iIntros (w) "[Hwp Hres]". wp_let. wp_apply (wp_wand with "Hwp").
iIntros (v) "H". by iApply ("H" with "[$]").
Qed.
Lemma awp_atomic (e : expr) (ev : val) R Φ :
IntoVal e ev
(R - R', R' awp (ev #()) R' (λ w, R' - R Φ w)) -
(R - R', R' awp (ev #()) R' (λ w, R' - R Φ w)) -
awp (a_atomic e) R Φ.
Proof.
iIntros (<-%of_to_val) "Hwp". rewrite /awp /a_atomic /=. wp_lam.
iIntros (γ π env l) "#Hlock1 #Hres Hunfl1". do 2 wp_let.
iIntros (γ π env l) "#Hlock1 Hres". do 2 wp_let.
wp_apply (acquire_cancel_spec with "[$]").
iIntros (f) "([Henv HR] & Hcl)". wp_seq.
iDestruct ("Hwp" with "HR") as (R') "[HR' Hwp]".
iDestruct 1 as (R') "(HR' & #Heq & Hcl)". wp_seq.
iAssert ( (env_inv env R))%I with "[HR']" as "[Henv HR]".
{ iNext. iRewrite "Heq". done. }
iDestruct ("Hwp" with "HR") as (Q) "[HQ Hwp]".
wp_apply (newlock_cancel_spec amonadN); first done.
iIntros (k γ') "[#Hlock2 Hunfl2]". wp_let.
iMod (flock_res_alloc_unflocked _ _ _ _ (env_inv env R')%I
with "Hlock2 Hunfl2 [$Henv $HR']") as "[#Hres2 Hunfl2]"; first done.
iIntros (k γ') "#Hlock2".
iMod (flock_res_single_alloc _ _ _ (env_inv env Q)%I
with "Hlock2 [$Henv $HQ]") as "Hres"; first done.
wp_let.
wp_apply (wp_wand with "Hwp"); iIntros (ev') "Hwp". wp_bind (ev' _ _).
iApply (wp_wand with "[Hwp Hunfl2]"); first by iApply "Hwp".
iIntros (w) "[HR Hunfl2]".
iMod (cancel_lock with "Hlock2 Hres2 Hunfl2") as "[Henv HR']"; first done.
iApply (wp_wand with "[Hwp Hres]"); first by iApply "Hwp".
iIntros (w) "[HR Hres]".
iMod (flock_res_single_dealloc with "Hlock2 Hres") as (Q') "[HQ' #HeqQ]"; first done.
wp_let.
iDestruct ("HR" with "HR'") as "[HR HΦ]".
wp_apply (release_cancel_spec with "[$Hlock1 Hcl Henv HR]").
{ iApply "Hcl". by iNext; iFrame. }
iIntros "Hunfl1". wp_seq. iFrame.
iAssert ( (env_inv env Q))%I with "[HQ']" as "[Henv HQ]".
{ iNext. by iRewrite "HeqQ". }
iDestruct ("HR" with "HQ") as "[HR HΦ]".
iAssert ( R')%I with "[HR Henv]" as "HR'".
{ iNext. iRewrite -"Heq". iFrame. }
iMod ("Hcl" with "HR'") as "[Hflocked Hres]".
wp_apply (release_cancel_spec with "[$Hlock1 $Hflocked]").
iIntros "_". wp_seq. iFrame.
Qed.
Lemma awp_atomic_env (e : expr) (ev : val) R Φ :
IntoVal e ev
( env, env_inv env - R -
WP ev env {{ w, env_inv env R Φ w }}) -
( env, env_inv env - R -
WP ev env {{ w, env_inv env R Φ w }}) -
awp (a_atomic_env e) R Φ.
Proof.
iIntros (<-%of_to_val) "Hwp". rewrite /awp /a_atomic_env /=. wp_lam.
iIntros (γ π env l) "#Hlock #Hres Hunfl". do 2 wp_lam.
iIntros (γ π env l) "#Hlock Hres". do 2 wp_lam.
wp_apply (acquire_cancel_spec with "[$]").
iIntros (f) "([Henv HR] & Hcl)". wp_seq.
iDestruct 1 as (R') "(HR' & #Heq & Hcl)". wp_seq.
iAssert ( (env_inv env R))%I with "[HR']" as "[Henv HR]".
{ iNext. iRewrite "Heq". done. }
iDestruct ("Hwp" with "Henv HR") as "Hwp".
wp_apply (wp_wand with "Hwp").
iIntros (w) "[Henv [HR HΦ]]". wp_let.
wp_apply (release_cancel_spec with "[$Hlock Hcl Henv HR]").
{ iApply "Hcl". by iNext; iFrame. }
iIntros "Hunfl". wp_seq. iFrame.
iRewrite -"Heq" in "Hcl".
iMod ("Hcl" with "[$HR $Henv]") as "[Hflocked Hres]".
wp_apply (release_cancel_spec with "[$Hlock $Hflocked]").
iIntros "_". wp_seq. iFrame.
Qed.
Lemma awp_par (Ψ1 Ψ2 : val iProp Σ) e1 e2 R (Φ : val iProp Σ) :
......@@ -217,12 +231,12 @@ Section a_wp_rules.
iIntros (ev1) "Hwp1". wp_lam.
wp_bind e2. iApply (wp_wand with "Hwp2").
iIntros (ev2) "Hwp2". wp_lam.
iIntros (γ π env l) "#Hlock #Hres [Hunfl1 Hunfl2]". do 2 wp_lam.
iApply (par_spec (λ v, Ψ1 v unflocked _ (π/2))%I
(λ v, Ψ2 v unflocked _ (π/2))%I
with "[Hwp1 Hunfl1] [Hwp2 Hunfl2]").
- wp_lam. iApply ("Hwp1" with "Hlock Hres Hunfl1").
- wp_lam. iApply ("Hwp2" with "Hlock Hres Hunfl2").
iIntros (γ π env l) "#Hlock [Hres1 Hres2]". do 2 wp_lam.
iApply (par_spec (λ v, Ψ1 v flock_res _ _ (π/2))%I
(λ v, Ψ2 v flock_res _ _ (π/2))%I
with "[Hwp1 Hres1] [Hwp2 Hres2]").
- wp_lam. iApply ("Hwp1" with "Hlock Hres1").
- wp_lam. iApply ("Hwp2" with "Hlock Hres2").
- iNext. iIntros (w1 w2) "[[HΨ1 $] [HΨ2 $]]".
iApply ("HΦ" with "[$] [$]").
Qed.
......@@ -233,7 +247,7 @@ Section a_wp_run.
Lemma awp_run (e : expr) R Φ :
AsVal e
R - ( `{amonadG Σ}, awp e R (λ w, R ={}= Φ w)) -
R - ( `{amonadG Σ}, awp e R (λ w, R ={}= Φ w)) -
WP a_run e {{ Φ }}.
Proof.
iIntros ([ev <-%of_to_val]) "HR Hwp". rewrite /awp /a_run /=. wp_let.
......@@ -242,16 +256,18 @@ Section a_wp_run.
iMod (locking_heap_init ) as (?) "Hσ".
pose (amg := AMonadG Σ _ _ _ _).
wp_apply (newlock_cancel_spec amonadN); first done.
iIntros (k γ') "[#Hlock Hunfl]". wp_let. rewrite- wp_fupd.
iMod (flock_res_alloc_unflocked _ _ _ _ (env_inv env R)%I
with "Hlock Hunfl [Henv Hσ $HR]") as "[#Hres Hunfl]"; first done.
iIntros (k γ') "#Hlock". rewrite- wp_fupd.
iMod (flock_res_single_alloc _ _ _ (env_inv env R)%I
with "Hlock [Henv Hσ $HR]") as "Hres"; first done.
{ iNext. iExists , . iFrame. eauto. }
iSpecialize ("Hwp" $! amg).
wp_apply (wp_wand with "Hwp"). iIntros (v') "Hwp".
iApply (wp_wand with "[Hwp Hunfl]"); first by iApply "Hwp".
iIntros (w) "[HΦ Hunfl]".
iMod (cancel_lock with "Hlock Hres Hunfl") as "[HEnv HR]"; first done.
by iApply "HΦ".
iMod (wp_value_inv with "Hwp") as "Hwp".
wp_let. wp_bind (ev env k).
iApply (wp_wand with "[Hwp Hres]"); first by iApply "Hwp".
iIntros (w) "[HΦ Hres]".
iMod (flock_res_single_dealloc with "Hlock Hres") as (R') "[HR' #Heq]"; first done.
wp_let.
iApply "HΦ". iNext. iRewrite -"Heq" in "HR'". iDestruct "HR'" as "[_ $]".
Qed.
End a_wp_run.
......
......@@ -67,10 +67,10 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)". wp_lam.
iDestruct "Hlocks" as %Hlocks.
iApply wp_fupd.
wp_let. wp_alloc l as "Hl".
wp_alloc l as "Hl".
iAssert (⌜σ !! l = None)%I with "[Hl Hls]" as %Hl.
{ remember (σ !! l) as σl. destruct σl; simplify_eq; eauto.
iExFalso. rewrite (big_sepM_lookup _ σ l _); last eauto.
......@@ -101,13 +101,13 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)". wp_lam.
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hv Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_let. wp_proj.
wp_proj.
wp_apply (mset_add_spec with "[$HX]"); eauto.
iIntros "HX". wp_seq.
iAssert (⌜σ !! l = Some ULvl%I) with "[Hσ Hv]" as %?.
......@@ -148,13 +148,12 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)". wp_lam.
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_let.
wp_apply wp_assert.
wp_apply (mset_member_spec #l env with "HX").
iIntros "Henv /=". case_decide; first by exfalso. simpl.
......@@ -204,9 +203,9 @@ Section proofs.
iIntros (env) "Henv HR".
iApply wp_fupd.
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)". wp_lam.
iDestruct "Hlocks" as %Hlocks.
wp_let. iApply (mset_clear_spec with "HX").
iApply (mset_clear_spec with "HX").
iNext. iIntros "HX".
iDestruct "HΦ" as (us) "[Hus HΦ]".
clear Hlocks.
......@@ -279,7 +278,7 @@ Section proofs.
iSpecialize ("Hfa" with "HΨ").
iModIntro.
awp_let.
iApply awp_atomic. iIntros "HR".
iApply awp_atomic. iNext. iIntros "HR".
iDestruct ("Hfa" with "HR") as (R') "[HR' Hfa]".
iExists R'. iFrame. by awp_let.
Qed.
......
(** Cancellable locks *)
From iris.heap_lang Require Export proofmode notation.
From iris.heap_lang Require Import spin_lock.
(* From iris.heap_lang Require Import spin_lock. *)
From iris_c.lib Require Export spin_lock.
From iris.base_logic.lib Require Import cancelable_invariants auth saved_prop.
From iris.algebra Require Import auth agree excl frac gmap.
From iris.algebra Require Import auth agree excl frac gmap gset.
From iris.bi.lib Require Import fractional.
Inductive lockstate :=
| Locked : frac lockstate
| Locked
| Unlocked.
Canonical Structure lockstateC := leibnizC lockstate.
......@@ -14,7 +14,6 @@ Instance lockstate_inhabited : Inhabited lockstate := populate Unlocked.
Record flock_name := {
flock_lock_name : gname;
flock_cinv_name : gname;
flock_state_name : gname;
flock_props_name : gname;
flock_props_active_name : gname
......@@ -22,320 +21,208 @@ Record flock_name := {
(* positive so that we have a `Fresh` instance for `gset positive` *)
Definition prop_id := positive.
Canonical Structure gnameC := leibnizC gname.
Class flockG Σ :=
FlockG {
flock_stateG :> inG Σ (authR (optionUR (exclR lockstateC)));
flock_cinvG :> cinvG Σ;
flock_lockG :> lockG Σ;
flock_props :> authG Σ (optionUR (exclR (gmapC prop_id (iProp Σ))));
flock_props_activeG :> authG Σ (gmapUR prop_id (agreeR (iProp Σ)))
flock_savedProp :> savedPropG Σ;
flock_tokens :> inG Σ fracR;
flock_props_active :> inG Σ (authR (optionUR (exclR (gmapC prop_id (prodC fracC (prodC gnameC gnameC))))));
flock_props :> inG Σ (authR (gmapUR prop_id (prodR fracR (agreeR (prodC gnameC gnameC)))))
}.
Section cinv_lemmas.
Context `{invG Σ, cinvG Σ}.
Definition flockΣ : gFunctors :=
#[GFunctor (authR (optionUR (exclR lockstateC)))
;lockΣ
;savedPropΣ
;GFunctor fracR
;GFunctor (authR (optionUR (exclR (gmapC prop_id (prodC fracC (prodC gnameC gnameC))))))
;GFunctor (authR (gmapUR prop_id (prodR fracR (agreeR (prodC gnameC gnameC)))))%CF].
Lemma cinv_alloc_strong (G : gset gname) E N (Φ : gname iProp Σ) :
( γ, ⌜γ G Φ γ) ={E}= γ, ⌜γ G cinv N γ (Φ γ) cinv_own γ 1.
Proof.
iIntros "HP".
iMod (own_alloc_strong 1%Qp G) as (γ) "[% H1]"; first done.
iMod (inv_alloc N _ (Φ γ own γ 1%Qp)%I with "[HP]") as "#Hinv".
- iNext. iLeft. by iApply "HP".
- iExists γ. iModIntro. rewrite /cinv /cinv_own. iFrame "H1".
iSplit; eauto. iExists _. iFrame "Hinv".
iIntros "!# !>". iSplit; by iIntros "?".
Qed.
Lemma cinv_cancel_vs (P Q : iProp Σ) E N γ :
N E cinv N γ P
- (cinv_own γ 1 P ={E∖↑N}= cinv_own γ 1 Q)
- cinv_own γ 1 ={E}= Q.
Proof.
iIntros (?) "#Hinv Hvs Hγ". rewrite /cinv.
iDestruct "Hinv" as (P') "[#HP' Hinv]".
iInv N as "[HP|>Hγ']" "Hclose"; last first.
- iDestruct (cinv_own_1_l with "Hγ Hγ'") as %[].
- iMod ("Hvs" with "[$Hγ HP]") as "[Hγ HQ]".
{ by iApply "HP'". }
iFrame. iApply "Hclose". iNext. by iRight.
Qed.
End cinv_lemmas.
Instance subG_flockΣ Σ : subG flockΣ Σ flockG Σ.
Proof. solve_inG. Qed.
Section flock.
Context `{heapG Σ, flockG Σ}.
(* because flock_res_op is admitted, it has to go before the Variable N part *)
Definition flock_res (γ : flock_name) (R : iProp Σ) (π : Qp) : iProp Σ :=
( s ρ, saved_prop_own ρ.1 R own ρ.2 π
own (flock_props_name γ) ( {[s := (π, to_agree ρ)]}))%I.
Lemma flock_res_op (γ : flock_name) (R : iProp Σ) (π1 π2 : frac) :
flock_res γ R (π1+π2) flock_res γ R π1 flock_res γ R π2.
Proof. rewrite /flock_res. admit. Admitted.
Global Instance flock_res_fractional γ R : Fractional (flock_res γ R).
Proof. intros p q. apply flock_res_op. Qed.
Global Instance flock_res_as_fractional γ R π :
AsFractional (flock_res γ R π) (flock_res γ R) π.
Proof. split. done. apply _. Qed.
Variable N : namespace.
Definition flockN := N.@"flock".
Definition to_props_map (f : gmap prop_id (iProp Σ))
: gmapUR prop_id (agreeR (iProp Σ)) := to_agree <$> f.
Definition to_props_map (f : gmap prop_id (gname * gname))
: gmapUR prop_id (prodR fracR (agreeR (prodC gnameC gnameC))) :=
(λ x, (1%Qp, to_agree (x.1, x.2))) <$> f.
Lemma to_props_map_singleton_included fp i q ρ:
{[i := (q, to_agree ρ)]} to_props_map fp fp !! i = Some ρ.
Proof.
rewrite singleton_included=> -[[q' av] []].
rewrite /to_props_map lookup_fmap fmap_Some_equiv => -[v' [Hi [/= -> ->]]].
move=> /Some_pair_included_total_2 [_] /to_agree_included /leibniz_equiv_iff -> //.
rewrite Hi. by destruct v'.
Qed.
Definition from_active (f : gmap prop_id (frac * (gname * gname)))
: gmap prop_id (gname * gname) := fmap snd f.
Lemma from_active_empty : from_active = .
Proof. by rewrite /from_active fmap_empty. Qed.
Definition all_props (f : gmap prop_id (gname*gname)) : iProp Σ :=
([ map] i ρ f, R, saved_prop_own ρ.1 R R)%I.
Definition all_props (f : gmap prop_id (iProp Σ)) : iProp Σ :=
([ map] i R f, R)%I.
Definition all_tokens (f : gmap prop_id (frac * (gname*gname))) : iProp Σ :=
([ map] i ρ f, own ρ.2.2 ρ.1)%I.
Definition flock_inv (γ : flock_name) : iProp Σ :=
( (s : lockstate) (fp fa : gmap prop_id (iProp Σ)),
(** fa -- active propositions, fp -- inactive propositions *)
( (s : lockstate)
(fp : gmap prop_id (gname * gname))
(fa : gmap prop_id (frac * (gname * gname))),
(** fa -- active propositions, fp -- pending propositions *)
fp ## from_active fa
own (flock_state_name γ) ( (Excl' s))
own (flock_props_name γ) ( to_props_map (fp fa))
own (flock_props_name γ) ( to_props_map (fp from_active fa))
own (flock_props_active_name γ) ( Excl' fa)
all_props fp
match s with
| Locked q =>
cinv_own (flock_cinv_name γ) (q/2)
| Locked =>
locked (flock_lock_name γ)
all_props fp
| Unlocked => own (flock_props_active_name γ) ( Excl' fa)
all_props fa
fp = ∅⌝ (** all the propositions are active *)
all_tokens fa
| Unlocked => own (flock_props_active_name γ) ( Excl' )
end)%I.
Definition is_flock (γ : flock_name) (lk : val) : iProp Σ :=
(cinv (flockN .@ "inv") (flock_cinv_name γ) (flock_inv γ)
(inv (flockN .@ "inv") (flock_inv γ)
is_lock (flockN .@ "lock") (flock_lock_name γ) lk
(own (flock_state_name γ) ( (Excl' Unlocked))))%I.
Definition unflocked (γ : flock_name) (q : frac) : iProp Σ :=
cinv_own (flock_cinv_name γ) q.
Definition flocked
(γ : flock_name) (q : frac) (f : gmap prop_id (iProp Σ)) : iProp Σ :=
(own (flock_state_name γ) ( (Excl' (Locked q)))
cinv_own (flock_cinv_name γ) (q/2)
(γ : flock_name) (f : gmap prop_id (frac * (gname * gname))) : iProp Σ :=
(own (flock_state_name γ) ( (Excl' Locked))
own (flock_props_active_name γ) ( Excl' f)
all_props f)%I.
Definition flock_res (γ : flock_name) (R : iProp Σ) : iProp Σ :=
( f, R all_props f own (flock_props_name γ) ( to_props_map f))%I.
Definition flock_res_single (γ : flock_name) (s : prop_id) (R : iProp Σ) : iProp Σ :=
(own (flock_props_name γ) ( {[ s := to_agree R ]}))%I.
(** **************************************** *)
(** to_props_map lemmas *)
Lemma to_props_map_insert f i P :
to_props_map (<[i:=P]>f) = <[i:=to_agree P]>(to_props_map f).
Proof. by rewrite /to_props_map fmap_insert. Qed.
Lemma to_props_map_lookup f i :
to_props_map f !! i = to_agree <$> f !! i.
Proof. by rewrite /to_props_map lookup_fmap. Qed.
Lemma to_props_map_dom f :
dom (gset prop_id) (to_props_map f) = dom (gset prop_id) f.
Proof. by rewrite /to_props_map dom_fmap_L. Qed.
Lemma to_props_map_singleton s R : to_props_map {[s := R]} = {[s := to_agree R]}.
Proof. by rewrite /to_props_map map_fmap_singleton. Qed.
(** all_props lemmas *)
Lemma all_props_empty : all_props .
Proof. by rewrite /all_props big_sepM_empty. Qed.
Lemma all_props_singleton s R : all_props {[s := R]} R.
Proof. by rewrite /all_props big_sepM_singleton. Qed.
Lemma all_props_insert s (R : iProp Σ) f :
f !! s = None
all_props (<[s := R]>f) (R all_props f)%I.
Proof. intros ?. rewrite /all_props big_sepM_insert //. Qed.
Lemma all_props_union f g :
all_props f all_props g all_props (f g).
Proof.
revert g.
simple refine (map_ind (fun f => g, all_props f all_props g - all_props (f g)) _ _ f); simpl; rewrite /all_props.
- intros g. by rewrite big_sepM_empty !left_id.
- intros i P f' Hi IH.
intros g. rewrite big_sepM_insert; last done.
iIntros "[[HP Hf] Hg]".
rewrite -insert_union_l.
remember (g !! i) as Z. destruct Z as [R|].
+ assert (g = <[i:=R]>(delete i g)) as Hfoo.
{ rewrite insert_delete insert_id; eauto. }
rewrite {1}Hfoo.
rewrite big_sepM_insert; last first.
{ apply lookup_delete. }
iDestruct "Hg" as "[HR Hg]".
iApply (big_sepM_insert_override_2 _ _ i R P with "[-HP] [HP]"); simpl.
{ apply lookup_union_Some_raw. right. eauto. }
* iApply (IH g).
rewrite Hfoo big_sepM_insert; last by apply lookup_delete.
rewrite delete_insert; last by apply lookup_delete. iFrame.
* eauto.
+ rewrite big_sepM_insert; last first.
{ apply lookup_union_None. eauto. }
iFrame. iApply (IH g). iFrame.
Qed.
Global Instance all_props_proper : Proper (() ==> ())
(all_props : gmapC prop_id (iProp Σ) iProp Σ).
Proof.
intros f. rewrite /all_props. (* rewrite /all_props /big_opM. *)
simple refine (map_ind (fun f => g, f g _ _) _ _ f); simpl.
- intros g. rewrite big_sepM_empty.
simple refine (map_ind (fun g => g _ _) _ _ g); simpl.
+ by rewrite big_sepM_empty.
+ intros j R g' Hj IH Hg'.
exfalso. specialize (Hg' j). revert Hg'.
rewrite lookup_insert lookup_empty. inversion 1.
- intros i P f' Hi IH g Hf'.
rewrite big_sepM_insert; last done.
specialize (IH (delete i g)).
assert (f' delete i g) as Hf'g.
{ by rewrite -Hf' delete_insert. }
specialize (IH Hf'g). rewrite IH.
assert ( R, g !! i = Some R P R) as [R [Hg HR]].
{ specialize (Hf' i).
destruct (g !! i) as [R|]; last first.
- exfalso. revert Hf'. rewrite lookup_insert. inversion 1.
- exists R. split; auto.
revert Hf'. rewrite lookup_insert. by inversion 1. }
rewrite (big_sepM_delete _ g i R); eauto.
by apply bi.sep_proper.
Qed.
all_props (from_active f))%I.
(** **************************************** *)
(** rules & properties of the predicates *)
Global Instance is_flock_persistent γ lk : Persistent (is_flock γ lk).
Proof. apply _. Qed.
Global Instance flock_res_persistent γ R : Persistent (flock_res γ R).
Proof. apply _. Qed.
Global Instance flock_res_single_persistent γ s R : Persistent (flock_res_single γ s R).
Proof. apply _. Qed.
Global Instance flock_res_proper : Proper ((=) ==> () ==> ()) flock_res.
Proof.
intros ? γ -> P R HPR. rewrite /flock_res.
apply bi.exist_proper=>f. by rewrite HPR.
Qed.
Lemma unflocked_op (γ : flock_name) (π1 π2 : frac) :
unflocked γ (π1+π2) unflocked γ π1 unflocked γ π2.
Proof. by rewrite /unflocked fractional. Qed.
Global Instance unflocked_fractional γ : Fractional (unflocked γ).
Proof. intros p q. apply unflocked_op. Qed.
Global Instance unflocked_as_fractional γ π :
AsFractional (unflocked γ π) (unflocked γ) π.
Proof. split. done. apply _. Qed.
Lemma flock_res_single_alloc_unflocked (X : gset prop_id) γ lk π R E :