Commit de0c6689 authored by Hai Dang's avatar Hai Dang

Merge branch 'master' into hai/auth_frac

parents b8172744 3e8fcd4c
*.v gitlab-language=coq
...@@ -30,7 +30,6 @@ build-coq.8.8.2: ...@@ -30,7 +30,6 @@ build-coq.8.8.2:
<<: *template <<: *template
variables: variables:
OPAM_PINS: "coq version 8.8.2" OPAM_PINS: "coq version 8.8.2"
TIMING_PROJECT: "iris-examples"
TIMING_CONF: "coq-8.8.2" TIMING_CONF: "coq-8.8.2"
tags: tags:
- fp-timing - fp-timing
......
...@@ -8,7 +8,7 @@ all: Makefile.coq ...@@ -8,7 +8,7 @@ all: Makefile.coq
clean: Makefile.coq clean: Makefile.coq
+@make -f Makefile.coq clean +@make -f Makefile.coq clean
find theories $$(test -d tests && echo tests) \( -name "*.d" -o -name "*.vo" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete find theories tests \( -name "*.d" -o -name "*.vo" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true
rm -f Makefile.coq rm -f Makefile.coq
.PHONY: clean .PHONY: clean
......
...@@ -23,11 +23,11 @@ theories/spanning_tree/mon.v ...@@ -23,11 +23,11 @@ theories/spanning_tree/mon.v
theories/spanning_tree/spanning.v theories/spanning_tree/spanning.v
theories/spanning_tree/proof.v theories/spanning_tree/proof.v
theories/concurrent_stacks/specs.v
theories/concurrent_stacks/concurrent_stack1.v theories/concurrent_stacks/concurrent_stack1.v
#theories/concurrent_stacks/concurrent_stack2.v theories/concurrent_stacks/concurrent_stack2.v
theories/concurrent_stacks/concurrent_stack3.v theories/concurrent_stacks/concurrent_stack3.v
#theories/concurrent_stacks/concurrent_stack4.v theories/concurrent_stacks/concurrent_stack4.v
theories/concurrent_stacks/spec.v
theories/logrel/prelude/base.v theories/logrel/prelude/base.v
theories/logrel/stlc/lang.v theories/logrel/stlc/lang.v
...@@ -87,6 +87,7 @@ theories/hocap/concurrent_runners.v ...@@ -87,6 +87,7 @@ theories/hocap/concurrent_runners.v
theories/hocap/parfib.v theories/hocap/parfib.v
theories/logatom/treiber.v theories/logatom/treiber.v
theories/logatom/treiber2.v
theories/logatom/elimination_stack/hocap_spec.v theories/logatom/elimination_stack/hocap_spec.v
theories/logatom/elimination_stack/stack.v theories/logatom/elimination_stack/stack.v
theories/logatom/elimination_stack/spec.v theories/logatom/elimination_stack/spec.v
......
...@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"] ...@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"] install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"] remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [ depends: [
"coq-iris" { (= "dev.2019-01-27.0.9896799d") | (= "dev") } "coq-iris" { (= "dev.2019-04-17.0.60d28bbb") | (= "dev") }
"coq-autosubst" { = "dev.coq86" } "coq-autosubst" { = "dev.coq86" }
] ]
...@@ -41,8 +41,8 @@ Section client. ...@@ -41,8 +41,8 @@ Section client.
Proof. Proof.
iIntros ""; rewrite /client. wp_alloc y as "Hy". wp_let. iIntros ""; rewrite /client. wp_alloc y as "Hy". wp_let.
wp_apply (newbarrier_spec N (y_inv 1 y) with "[//]"). wp_apply (newbarrier_spec N (y_inv 1 y) with "[//]").
iIntros (l) "[Hr Hs]". wp_let. iIntros (l) "[Hr Hs]".
iApply (wp_par (λ _, True%I) (λ _, True%I) with "[Hy Hs] [Hr]"); last auto. wp_apply (wp_par (λ _, True%I) (λ _, True%I) with "[Hy Hs] [Hr]"); last auto.
- (* The original thread, the sender. *) - (* The original thread, the sender. *)
wp_store. iApply (signal_spec with "[-]"); last by iNext; auto. wp_store. iApply (signal_spec with "[-]"); last by iNext; auto.
iSplitR "Hy"; first by eauto. iSplitR "Hy"; first by eauto.
...@@ -51,7 +51,7 @@ Section client. ...@@ -51,7 +51,7 @@ Section client.
iDestruct (recv_weaken with "[] Hr") as "Hr". iDestruct (recv_weaken with "[] Hr") as "Hr".
{ iIntros "Hy". by iApply (y_inv_split with "Hy"). } { iIntros "Hy". by iApply (y_inv_split with "Hy"). }
iMod (recv_split with "Hr") as "[H1 H2]"; first done. iMod (recv_split with "Hr") as "[H1 H2]"; first done.
iApply (wp_par (λ _, True%I) (λ _, True%I) with "[H1] [H2]"); last auto. wp_apply (wp_par (λ _, True%I) (λ _, True%I) with "[H1] [H2]"); last auto.
+ by iApply worker_safe. + by iApply worker_safe.
+ by iApply worker_safe. + by iApply worker_safe.
Qed. Qed.
......
...@@ -122,7 +122,7 @@ Proof. ...@@ -122,7 +122,7 @@ Proof.
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto. as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
destruct p; [|done]. wp_store. destruct p; [|done]. wp_store.
iSpecialize ("HΦ" with "[#]") => //. iFrame "HΦ". iSpecialize ("HΦ" with "[#]") => //. iFrame "HΦ".
iMod ("Hclose" $! (State High I) ( : set token) with "[-]"); last done. iMod ("Hclose" $! (State High I) ( : propset token) with "[-]"); last done.
iSplit; [iPureIntro; by eauto using signal_step|]. iSplit; [iPureIntro; by eauto using signal_step|].
rewrite /barrier_inv /ress /=. iNext. iFrame "Hl". rewrite /barrier_inv /ress /=. iNext. iFrame "Hl".
iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp". iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
...@@ -165,8 +165,8 @@ Proof. ...@@ -165,8 +165,8 @@ Proof.
iIntros (?). iDestruct 1 as (γ P Q i) "(#Hsts & Hγ & #HQ & HQR)". iIntros (?). iDestruct 1 as (γ P Q i) "(#Hsts & Hγ & #HQ & HQR)".
iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]") iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto. as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
iMod (saved_prop_alloc_strong I) as (i1) "[% #Hi1]". iMod (saved_prop_alloc_cofinite I) as (i1) "[% #Hi1]".
iMod (saved_prop_alloc_strong (I {[i1]})) iMod (saved_prop_alloc_cofinite (I {[i1]}))
as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2. as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2.
rewrite ->not_elem_of_union, elem_of_singleton in Hi2; destruct Hi2. rewrite ->not_elem_of_union, elem_of_singleton in Hi2; destruct Hi2.
iMod ("Hclose" $! (State p ({[i1; i2]} I {[i]})) iMod ("Hclose" $! (State p ({[i1; i2]} I {[i]}))
......
...@@ -19,7 +19,7 @@ Inductive prim_step : relation state := ...@@ -19,7 +19,7 @@ Inductive prim_step : relation state :=
| ChangeI p I2 I1 : prim_step (State p I1) (State p I2) | ChangeI p I2 I1 : prim_step (State p I1) (State p I2)
| ChangePhase I : prim_step (State Low I) (State High I). | ChangePhase I : prim_step (State Low I) (State High I).
Definition tok (s : state) : set token := Definition tok (s : state) : propset token :=
{[ t | i, t = Change i i state_I s ]} {[ t | i, t = Change i i state_I s ]}
(if state_phase s is High then {[ Send ]} else ). (if state_phase s is High then {[ Send ]} else ).
Global Arguments tok !_ /. Global Arguments tok !_ /.
...@@ -27,10 +27,10 @@ Global Arguments tok !_ /. ...@@ -27,10 +27,10 @@ Global Arguments tok !_ /.
Canonical Structure sts := sts.Sts prim_step tok. Canonical Structure sts := sts.Sts prim_step tok.
(* The set of states containing some particular i *) (* The set of states containing some particular i *)
Definition i_states (i : gname) : set state := {[ s | i state_I s ]}. Definition i_states (i : gname) : propset state := {[ s | i state_I s ]}.
(* The set of low states *) (* The set of low states *)
Definition low_states : set state := {[ s | state_phase s = Low ]}. Definition low_states : propset state := {[ s | state_phase s = Low ]}.
Lemma i_states_closed i : sts.closed (i_states i) {[ Change i ]}. Lemma i_states_closed i : sts.closed (i_states i) {[ Change i ]}.
Proof. Proof.
...@@ -77,7 +77,7 @@ Proof. ...@@ -77,7 +77,7 @@ Proof.
- destruct p; set_solver. - destruct p; set_solver.
- apply elem_of_equiv=> /= -[j|]; last set_solver. - apply elem_of_equiv=> /= -[j|]; last set_solver.
set_unfold; rewrite !(inj_iff Change). set_unfold; rewrite !(inj_iff Change).
assert (Change j match p with Low => : set token | High => {[Send]} end False) assert (Change j match p with Low => : propset token | High => {[Send]} end False)
as -> by (destruct p; set_solver). as -> by (destruct p; set_solver).
destruct (decide (i1 = j)) as [->|]; first naive_solver. destruct (decide (i1 = j)) as [->|]; first naive_solver.
destruct (decide (i2 = j)) as [->|]; first naive_solver. destruct (decide (i2 = j)) as [->|]; first naive_solver.
......
From stdpp Require Import namespaces.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export proofmode notation.
(** General (HoCAP-style) spec for a concurrent bag ("per-elemt spec") *)
Record concurrent_bag {Σ} `{!heapG Σ} := ConcurrentBag {
mk_bag : val;
mk_bag_spec (N : namespace) (P : val iProp Σ) :
{{{ True }}}
mk_bag #()
{{{ (f f : val), RET (f, f);
( WP f #() {{ v, ( (v' : val), v SOMEV v' P v') v NONEV }})
( (v : val), (P v - WP f v {{ v, True }}))
}}}
}.
Arguments concurrent_bag _ {_}.
(** General (HoCAP-style) spec for a concurrent stack *)
Record concurrent_stack {Σ} `{!heapG Σ} := ConcurrentStack {
mk_stack : val;
mk_stack_spec (N : namespace) (P : list val iProp Σ)
(Q : val iProp Σ) (Q' Q'' : iProp Σ) :
{{{ P [] }}}
mk_stack #()
{{{ (f f : val), RET (f, f);
( ( ( v vs, P (v :: vs) ={ N}= Q v P vs)
(P [] ={ N}= Q' P []) -
WP f #() {{ v, ( (v' : val), v SOMEV v' Q v') (v NONEV Q')}}))
( (v : val),
(( vs, P vs ={ N}= P (v :: vs) Q'') - WP f v {{ v, Q'' }}))
}}}
}.
Arguments concurrent_stack _ {_}.
From stdpp Require Import namespaces.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export proofmode notation.
(** General (HoCAP-style) spec for a concurrent bag ("per-elemt spec") *)
Record concurrent_bag {Σ} `{!heapG Σ} := ConcurrentBag {
is_bag (P : val iProp Σ) (s : val) : iProp Σ;
bag_pers (P : val iProp Σ) (s : val) : Persistent (is_bag P s);
new_bag : val;
bag_push : val;
bag_pop : val;
mk_bag_spec (P : val iProp Σ) :
{{{ True }}}
new_bag #()
{{{ s, RET s; is_bag P s }}};
bag_push_spec (P : val iProp Σ) s v :
{{{ is_bag P s P v }}} bag_push s v {{{ RET #(); True }}};
bag_pop_spec (P : val iProp Σ) s :
{{{ is_bag P s }}} bag_pop s {{{ ov, RET ov; ov = NONEV v, ov = SOMEV v P v }}}
}.
Arguments concurrent_bag _ {_}.
(** General (CAP-style) spec for a concurrent stack *)
Record concurrent_stack {Σ} `{!heapG Σ} := ConcurrentStack {
is_stack (N : namespace) (P : list val iProp Σ) (s : val) : iProp Σ;
stack_pers (N : namespace) (P : list val iProp Σ) (s : val) : Persistent (is_stack N P s);
new_stack : val;
stack_push : val;
stack_pop : val;
new_stack_spec (N : namespace) (P : list val iProp Σ) :
{{{ P [] }}} new_stack #() {{{ v, RET v; is_stack N P v }}};
stack_push_spec (N : namespace) (P : list val iProp Σ) (Ψ : val iProp Σ) s v :
{{{ is_stack N P s xs, P xs ={ N}= P (v :: xs) Ψ #()}}}
stack_push s v
{{{ RET #(); Ψ #() }}};
stack_pop_spec (N : namespace) (P : list val iProp Σ) Ψ s :
{{{ is_stack N P s
( v xs, P (v :: xs) ={ N}= P xs Ψ (SOMEV v))
(P [] ={ N}= P [] Ψ NONEV) }}}
stack_pop s
{{{ v, RET v; Ψ v }}};
}.
Arguments concurrent_stack _ {_}.
...@@ -31,13 +31,13 @@ Structure bag Σ `{!heapG Σ} := Bag { ...@@ -31,13 +31,13 @@ Structure bag Σ `{!heapG Σ} := Bag {
{{{ True }}} newBag #() {{{ x γ, RET x; is_bag N γ x bag_contents γ }}}; {{{ True }}} newBag #() {{{ x γ, RET x; is_bag N γ x bag_contents γ }}};
pushBag_spec N P Q γ b v : pushBag_spec N P Q γ b v :
( (X : gmultiset val), bag_contents γ X P ( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) - ={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag N γ b P }}} {{{ is_bag N γ b P }}}
pushBag b (of_val v) pushBag b (of_val v)
{{{ RET #(); Q }}}; {{{ RET #(); Q }}};
popBag_spec N P Q γ b : popBag_spec N P Q γ b :
( (X : gmultiset val) (y : val), ( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) - ={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) - (bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag N γ b P }}} {{{ is_bag N γ b P }}}
......
...@@ -52,7 +52,7 @@ Section proof. ...@@ -52,7 +52,7 @@ Section proof.
Fixpoint bag_of_val (ls : val) : gmultiset val := Fixpoint bag_of_val (ls : val) : gmultiset val :=
match ls with match ls with
| NONEV => | NONEV =>
| SOMEV (v1, t) => {[v1]} bag_of_val t | SOMEV (v1, t) => {[v1]} bag_of_val t
| _ => | _ =>
end. end.
Fixpoint val_of_list (ls : list val) : val := Fixpoint val_of_list (ls : list val) : val :=
...@@ -62,7 +62,7 @@ Section proof. ...@@ -62,7 +62,7 @@ Section proof.
end. end.
Definition bag_inv (γb : gname) (b : loc) : iProp Σ := Definition bag_inv (γb : gname) (b : loc) : iProp Σ :=
( ls : list val, b (val_of_list ls) own γb ((1/2)%Qp, to_agree (of_list ls)))%I. ( ls : list val, b (val_of_list ls) own γb ((1/2)%Qp, to_agree (list_to_set_disj ls)))%I.
Definition is_bag (γb : gname) (x : val) := Definition is_bag (γb : gname) (x : val) :=
( (lk : val) (b : loc) (γ : gname), ( (lk : val) (b : loc) (γ : gname),
...@@ -116,7 +116,7 @@ Section proof. ...@@ -116,7 +116,7 @@ Section proof.
Local Opaque acquire release. (* so that wp_pure doesn't stumble *) Local Opaque acquire release. (* so that wp_pure doesn't stumble *)
Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) : Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) :
( (X : gmultiset val), bag_contents γ X P ( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) - ={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag γ x P }}} {{{ is_bag γ x P }}}
pushBag x (of_val v) pushBag x (of_val v)
{{{ RET #(); Q }}}. {{{ RET #(); Q }}}.
...@@ -141,7 +141,7 @@ Section proof. ...@@ -141,7 +141,7 @@ Section proof.
Lemma popBag_spec (P : iProp Σ) (Q : val iProp Σ) γ x : Lemma popBag_spec (P : iProp Σ) (Q : val iProp Σ) γ x :
( (X : gmultiset val) (y : val), ( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) - ={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) - (bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag γ x P }}} {{{ is_bag γ x P }}}
......
...@@ -23,19 +23,19 @@ Section proof. ...@@ -23,19 +23,19 @@ Section proof.
(own γ (!{q} X))%I. (own γ (!{q} X))%I.
Lemma bagPart_compose (γ: gname) (q1 q2: Qp) (X Y : gmultiset val) : Lemma bagPart_compose (γ: gname) (q1 q2: Qp) (X Y : gmultiset val) :
bagPart γ q1 X - bagPart γ q2 Y - bagPart γ (q1+q2) (X Y). bagPart γ q1 X - bagPart γ q2 Y - bagPart γ (q1+q2) (X Y).
Proof. Proof.
iIntros "Hp1 Hp2". iIntros "Hp1 Hp2".
rewrite /bagPart -gmultiset_op_union -frac_op'. rewrite /bagPart -gmultiset_op_disj_union -frac_op'.
rewrite frac_auth_frag_op own_op. iFrame. rewrite frac_auth_frag_op own_op. iFrame.
Qed. Qed.
Lemma bagPart_decompose (γ: gname) (q: Qp) (X Y : gmultiset val) : Lemma bagPart_decompose (γ: gname) (q: Qp) (X Y : gmultiset val) :
bagPart γ q (X Y) - bagPart γ (q/2) X bagPart γ (q/2) Y. bagPart γ q (X Y) - bagPart γ (q/2) X bagPart γ (q/2) Y.
Proof. Proof.
iIntros "Hp". iIntros "Hp".
assert (q = (q/2)+(q/2))%Qp as Hq by (by rewrite Qp_div_2). assert (q = (q/2)+(q/2))%Qp as Hq by (by rewrite Qp_div_2).
rewrite /bagPart {1}Hq. rewrite /bagPart {1}Hq.
rewrite -gmultiset_op_union -frac_op'. rewrite -gmultiset_op_disj_union -frac_op'.
rewrite frac_auth_frag_op own_op. iFrame. rewrite frac_auth_frag_op own_op. iFrame.
Qed. Qed.
...@@ -59,17 +59,17 @@ Section proof. ...@@ -59,17 +59,17 @@ Section proof.
Lemma pushBag_spec γb γ x v q Y : Lemma pushBag_spec γb γ x v q Y :
{{{ bagM γb γ x bagPart γ q Y }}} {{{ bagM γb γ x bagPart γ q Y }}}
pushBag b x (of_val v) pushBag b x (of_val v)
{{{ RET #(); bagPart γ q ({[v]} Y) }}}. {{{ RET #(); bagPart γ q ({[v]} Y) }}}.
Proof. Proof.
iIntros (Φ) "[#[Hbag Hinv] HP] HΦ". rewrite /bagM_inv. iIntros (Φ) "[#[Hbag Hinv] HP] HΦ". rewrite /bagM_inv.
iApply (pushBag_spec b NB (bagPart γ q Y)%I (bagPart γ q ({[v]} Y))%I with "[] [Hbag HP]"); eauto. iApply (pushBag_spec b NB (bagPart γ q Y)%I (bagPart γ q ({[v]} Y))%I with "[] [Hbag HP]"); eauto.
iAlways. iIntros (X) "[Hb1 HP]". iAlways. iIntros (X) "[Hb1 HP]".
iInv NI as (X') "[>Hb2 >Hown]" "Hcl". iInv NI as (X') "[>Hb2 >Hown]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-. iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b ({[v]} X) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]". iMod (bag_contents_update b ({[v]} X) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
rewrite /bagPart. rewrite /bagPart.
iMod (own_update_2 with "Hown HP") as "[Hown HP]". iMod (own_update_2 with "Hown HP") as "[Hown HP]".
{ apply (frac_auth_update _ _ _ ({[v]} X) ({[v]} Y)). { apply (frac_auth_update _ _ _ ({[v]} X) ({[v]} Y)).
do 2 rewrite (comm _ {[v]}). do 2 rewrite (comm _ {[v]}).
apply gmultiset_local_update_alloc. } apply gmultiset_local_update_alloc. }
iFrame. iApply "Hcl". iFrame. iApply "Hcl".
...@@ -78,7 +78,7 @@ Section proof. ...@@ -78,7 +78,7 @@ Section proof.
Local Ltac multiset_solver := Local Ltac multiset_solver :=
intro; intro;
repeat (rewrite multiplicity_difference || rewrite multiplicity_union); repeat (rewrite multiplicity_difference || rewrite multiplicity_disj_union);
(lia || naive_solver). (lia || naive_solver).
Lemma popBag_spec γb γ x X : Lemma popBag_spec γb γ x X :
...@@ -97,20 +97,20 @@ Section proof. ...@@ -97,20 +97,20 @@ Section proof.
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-. iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b Y with "[$Hb1 $Hb2]") as "[Hb1 Hb2]". iMod (bag_contents_update b Y with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
rewrite /bagPart. rewrite /bagPart.
iAssert (X = ({[y]} Y))%I with "[Hpart HPs]" as %->. iAssert (X = ({[y]} Y))%I with "[Hpart HPs]" as %->.
{ iDestruct (own_valid_2 with "HPs Hpart") as %Hfoo. { iDestruct (own_valid_2 with "HPs Hpart") as %Hfoo.
apply frac_auth_agree in Hfoo. by unfold_leibniz. } apply frac_auth_agree in Hfoo. by unfold_leibniz. }
iMod (own_update_2 with "HPs Hpart") as "Hown". iMod (own_update_2 with "HPs Hpart") as "Hown".
{ apply (frac_auth_update _ _ _ (({[y]} Y) {[y]}) (({[y]} Y) {[y]})). { apply (frac_auth_update _ _ _ (({[y]} Y) {[y]}) (({[y]} Y) {[y]})).
apply gmultiset_local_update_dealloc; multiset_solver. } apply gmultiset_local_update_dealloc; multiset_solver. }
iDestruct "Hown" as "[HPs Hpart]". iDestruct "Hown" as "[HPs Hpart]".
iMod ("Hcl" with "[-Hpart Hb1]") as "_". iMod ("Hcl" with "[-Hpart Hb1]") as "_".
{ iNext. iExists _; iFrame. { iNext. iExists _; iFrame.
assert (Y = (({[y]} Y) {[y]})) as <- assert (Y = (({[y]} Y) {[y]})) as <-
by (unfold_leibniz; multiset_solver). by (unfold_leibniz; multiset_solver).
iFrame. } iFrame. }
iModIntro. iNext. iFrame. iRight. iExists y; repeat iSplit; eauto. iModIntro. iNext. iFrame. iRight. iExists y; repeat iSplit; eauto.
iPureIntro. by apply elem_of_union_l, elem_of_singleton. } iPureIntro. apply gmultiset_elem_of_disj_union. left. by apply elem_of_singleton. }
{ iAlways. iIntros "[Hb1 Hpart]". { iAlways. iIntros "[Hb1 Hpart]".
iInv NI as (X') "[>Hb2 >HPs]" "Hcl". iInv NI as (X') "[>Hb2 >HPs]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-. iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
......
...@@ -33,14 +33,14 @@ Section proof. ...@@ -33,14 +33,14 @@ Section proof.
Lemma pushBag_spec γ x X v : Lemma pushBag_spec γ x X v :
{{{ bagE γ x X }}} {{{ bagE γ x X }}}
pushBag b x (of_val v) pushBag b x (of_val v)
{{{ RET #(); bagE γ x ({[v]} X) }}}. {{{ RET #(); bagE γ x ({[v]} X) }}}.
Proof. Proof.
iIntros (Φ) "Hbag HΦ". iIntros (Φ) "Hbag HΦ".
iApply (pushBag_spec b N (bagE γ x X)%I (bagE γ x ({[v]} X))%I with "[] [Hbag]"); eauto. iApply (pushBag_spec b N (bagE γ x X)%I (bagE γ x ({[v]} X))%I with "[] [Hbag]"); eauto.
{ iAlways. iIntros (Y) "[Hb1 Hb2]". { iAlways. iIntros (Y) "[Hb1 Hb2]".
iDestruct "Hb2" as "[#Hbag Hb2]". iDestruct "Hb2" as "[#Hbag Hb2]".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-. iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]". iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
by iFrame. } by iFrame. }
{ iDestruct "Hbag" as "[#Hbag Hb]". iFrame "Hbag". eauto. } { iDestruct "Hbag" as "[#Hbag Hb]". iFrame "Hbag". eauto. }
Qed. Qed.
...@@ -49,11 +49,11 @@ Section proof. ...@@ -49,11 +49,11 @@ Section proof.
{{{ bagE γ x X }}} {{{ bagE γ x X }}}
popBag b x popBag b x
{{{ v, RET v; (X = ∅⌝ v = NONEV bagE γ x ) {{{ v, RET v; (X = ∅⌝ v = NONEV bagE γ x )
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y)}}}. ( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y)}}}.
Proof. Proof.
iIntros (Φ) "Hbag HΦ". iIntros (Φ) "Hbag HΦ".
iApply (popBag_spec b N (bagE γ x X)%I (fun v => (X = ∅⌝ v = NONEV bagE γ x ) iApply (popBag_spec b N (bagE γ x X)%I (fun v => (X = ∅⌝ v = NONEV bagE γ x )
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y))%I γ with "[] [] [Hbag]"); eauto. ( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y))%I γ with "[] [] [Hbag]"); eauto.
{ iAlways. iIntros (Y y) "[Hb1 Hb2]". { iAlways. iIntros (Y y) "[Hb1 Hb2]".
iDestruct "Hb2" as "[#Hbag Hb2]". iDestruct "Hb2" as "[#Hbag Hb2]".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-. iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
......
...@@ -87,11 +87,11 @@ Section proof. ...@@ -87,11 +87,11 @@ Section proof.
iDestruct (mapsto_agree l' q q' (PairV x tl) (PairV y tl') iDestruct (mapsto_agree l' q q' (PairV x tl) (PairV y tl')
with "Hro Hro'") as %?. simplify_eq/=. with "Hro Hro'") as %?. simplify_eq/=.
iDestruct ("IH" with "Hls Hls'") as %->. done. iDestruct ("IH" with "Hls Hls'") as %->. done.
Qed. Qed.
Definition bag_inv (γb : gname) (b : loc) : iProp Σ := Definition bag_inv (γb : gname) (b : loc) : iProp Σ :=
( (hd : val) (ls : list val), ( (hd : val) (ls : list val),
b hd is_list hd ls own γb ((1/2)%Qp, to_agree (of_list ls)))%I. b hd is_list hd ls own γb ((1/2)%Qp, to_agree (list_to_set_disj ls)))%I.
Definition is_bag (γb : gname) (x : val) := Definition is_bag (γb : gname) (x : val) :=
( (b : loc), x = #b inv N (bag_inv γb b))%I. ( (b : loc), x = #b inv N (bag_inv γb b))%I.
Definition bag_contents (γb : gname) (X : gmultiset val) : iProp Σ := Definition bag_contents (γb : gname) (X : gmultiset val) : iProp Σ :=
...@@ -142,7 +142,7 @@ Section proof. ...@@ -142,7 +142,7 @@ Section proof.
Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) :