Commit 18c334bc authored by Ralf Jung's avatar Ralf Jung

Merge branch 'hocap' into 'master'

Implement modular specifications from the HOCAP paper

See merge request FP/iris-examples!5
parents feae9588 3d9137d6
Pipeline #9967 failed with stage
in 9 minutes and 36 seconds
......@@ -57,6 +57,7 @@ This repository contains the following case studies:
[report](http://iris-project.org/pdfs/2017-case-study-concurrent-stacks-with-helping.pdf).
* [lecture-notes](theories/lecture_notes): Coq examples for the
[Iris lecture notes](http://iris-project.org/tutorial-material.html).
* [hocap](theories/hocap): Formalisations of the concurrent bag and concurrent runners libraries from the [HOCAP paper](https://dl.acm.org/citation.cfm?id=2450283). See the associated [README](theories/hocap/README.md).
## For Developers: How to update the Iris dependency
......
......@@ -70,3 +70,13 @@ theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v
theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/refinement.v
theories/hocap/abstract_bag.v
theories/hocap/cg_bag.v
theories/hocap/fg_bag.v
theories/hocap/exclusive_bag.v
theories/hocap/shared_bag.v
theories/hocap/contrib_bag.v
theories/hocap/lib/oneshot.v
theories/hocap/concurrent_runners.v
theories/hocap/parfib.v
These examples are meant to demonstrate the applicability in Iris of the specification style for concurrent data structures described in the paper
[Modular reasoning about separation of concurrent data structures](https://link.springer.com/chapter/10.1007/978-3-642-37036-6_11).
## Overview
* [abstract_bag](abstract_bag.v) describes the generic abstract bag specification (Section 1);
* in [exclusive_bag](exclusive_bag.v) and [shared_bag](shared_bag.v) the exclusive/sequential and shared/concurrent specifications are derived from the generic abstract specification (Section 3);
* [cg_bag.v](cg_bag.v) and [fg_bag](fg_bag.v) provide two implementations for the abstract bag specification (Section 3);
* [concurrent_runners](concurrent_runners.v) implements the (impredicative) concurrent runner specification from Section 4;
* [parfib](parfib.v) demonstrates the usage of the concurrent runners library (Section 4).
* [contrib_bag.v](contrib_bag.v) -- bag specification "with contributions" a-la counter with contributions, allows for multiple concurrent `push` operations and a sequential `pop` operation.
## Differences with the paper proofs
### Circularity in `concurrent_runners`
There is a circularity in the proof of `newRunner`, which is perhaps more poignant in ML/Heap-lang than in C#.
On the first line of `newRunner`, one creates a bag and has to pick a predicate that should hold for every element in the bag.
However, the predicate that we want to have refers to the runner itself -- which is a pair of a `bag` and a `body`.
In this setting, the runner is not yet available at this point in time.
There are (at least) two potential ways of resolving this circularity:
1. Allow the `P` predicate in the `shared_bag` specification to refer to the bag itself (as a formal parameter);
2. Have a specification that would construct a bag in several steps: the `newBag_spec` will return a token that can be view-shifted later at an arbitrary point in time to `bagS b P` -- this will allow the client to pick `P` at a more comfortable point.
We chose to go with option 1 in this formalisation.
(** Concurrent bag specification from the HOCAP paper.
"Modular Reasoning about Separation of Concurrent Data Structures"
<http://www.kasv.dk/articles/hocap-ext.pdf>
This file: abstract bag specification
*)
From iris.heap_lang Require Export lifting notation.
From iris.base_logic.lib Require Export invariants.
From stdpp Require Import gmultiset.
Set Default Proof Using "Type".
Structure bag Σ `{!heapG Σ} := Bag {
(* -- operations -- *)
newBag : val;
pushBag : val;
popBag : val;
(* -- predicates -- *)
(* name is used to associate bag_contents with is_bag *)
name : Type;
is_bag (N: namespace) (γ: name) (b: val) : iProp Σ;
bag_contents (γ: name) (X: gmultiset val) : iProp Σ;
(* -- ghost state theory -- *)
is_bag_persistent N γ b : Persistent (is_bag N γ b);
bag_contents_timeless γ X : Timeless (bag_contents γ X);
bag_contents_agree γ X Y: bag_contents γ X - bag_contents γ Y - X = Y;
bag_contents_update γ X X' Y:
bag_contents γ X bag_contents γ X' ==
bag_contents γ Y bag_contents γ Y;
(* -- operation specs -- *)
newBag_spec N :
{{{ True }}} newBag #() {{{ x γ, RET x; is_bag N γ x bag_contents γ }}};
pushBag_spec N P Q γ b v :
( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag N γ b P }}}
pushBag b (of_val v)
{{{ RET #(); Q }}};
popBag_spec N P Q γ b :
( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag N γ b P }}}
popBag b
{{{ v, RET v; Q v }}};
}.
Arguments newBag {_ _} _.
Arguments popBag {_ _} _.
Arguments pushBag {_ _} _.
Arguments newBag_spec {_ _} _ _ _.
Arguments popBag_spec {_ _} _ _ _ _ _ _.
Arguments pushBag_spec {_ _} _ _ _ _ _ _ _.
Arguments is_bag {_ _} _ _ _ _.
Arguments bag_contents {_ _} _ _.
Arguments bag_contents_update {_ _} _ {_ _ _}.
Existing Instances is_bag_persistent bag_contents_timeless.
(** Concurrent bag specification from the HOCAP paper.
"Modular Reasoning about Separation of Concurrent Data Structures"
<http://www.kasv.dk/articles/hocap-ext.pdf>
Coarse-grained implementation of a bag
*)
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import cmra agree frac.
From iris.heap_lang.lib Require Import lock spin_lock.
From iris_examples.hocap Require Import abstract_bag.
Set Default Proof Using "Type".
(** Coarse-grained bag implementation using a spin lock *)
Definition newBag : val := λ: <>,
(ref NONE, newlock #()).
Definition pushBag : val := λ: "b" "v",
let: "l" := Snd "b" in
let: "r" := Fst "b" in
acquire "l";;
let: "t" := !"r" in
"r" <- SOME ("v", "t");;
release "l".
Definition popBag : val := λ: "b",
let: "l" := Snd "b" in
let: "r" := Fst "b" in
acquire "l";;
let: "v" := match: !"r" with
NONE => NONE
| SOME "s" =>
"r" <- Snd "s";;
SOME (Fst "s")
end in
release "l";;
"v".
Canonical Structure valmultisetC := leibnizC (gmultiset valC).
Class bagG Σ := BagG
{ bag_bagG :> inG Σ (prodR fracR (agreeR valmultisetC));
lock_bagG :> lockG Σ
}.
(** Generic specification for the bag, using view shifts. *)
Section proof.
Context `{heapG Σ, bagG Σ}.
Variable N : namespace.
Fixpoint bag_of_val (ls : val) : gmultiset val :=
match ls with
| NONEV =>
| SOMEV (v1, t) => {[v1]} bag_of_val t
| _ =>
end.
Fixpoint val_of_list (ls : list val) : val :=
match ls with
| [] => NONEV
| x::xs => SOMEV (x, val_of_list xs)
end.
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.
Definition is_bag (γb : gname) (x : val) :=
( (lk : val) (b : loc) (γ : gname),
x = PairV #b lk is_lock N γ lk (bag_inv γb b))%I.
Definition bag_contents (γb : gname) (X : gmultiset val) : iProp Σ :=
own γb ((1/2)%Qp, to_agree X).
Global Instance is_bag_persistent γb x : Persistent (is_bag γb x).
Proof. apply _. Qed.
Global Instance bag_contents_timeless γb X : Timeless (bag_contents γb X).
Proof. apply _. Qed.
Lemma bag_contents_agree γb X Y :
bag_contents γb X - bag_contents γb Y - X = Y.
Proof.
rewrite /bag_contents. apply uPred.wand_intro_r.
rewrite -own_op own_valid uPred.discrete_valid.
f_equiv=> /=. rewrite pair_op.
by intros [_ ?%agree_op_invL'].
Qed.
Lemma bag_contents_update γb X X' Y :
bag_contents γb X bag_contents γb X' == bag_contents γb Y bag_contents γb Y.
Proof.
iIntros "[Hb1 Hb2]".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (own_update_2 with "Hb1 Hb2") as "Hb".
{ rewrite pair_op frac_op'.
assert ((1 / 2 + 1 / 2)%Qp = 1%Qp) as -> by apply Qp_div_2.
by apply (cmra_update_exclusive (1%Qp, to_agree Y)). }
iDestruct "Hb" as "[Hb1 Hb2]".
rewrite /bag_contents. by iFrame.
Qed.
Lemma newBag_spec :
{{{ True }}}
newBag #()
{{{ x γ, RET x; is_bag γ x bag_contents γ }}}.
Proof.
iIntros (Φ) "_ HΦ".
unfold newBag. wp_rec.
wp_alloc r as "Hr".
iMod (own_alloc (1%Qp, to_agree )) as (γb) "[Ha Hf]"; first done.
wp_apply (newlock_spec N (bag_inv γb r) with "[Hr Ha]").
{ iExists []. iFrame. }
iIntros (lk γ) "#Hlk".
iApply wp_value. iApply "HΦ".
rewrite /is_bag /bag_contents. iFrame.
iExists _,_,_. by iFrame "Hlk".
Qed.
Local Opaque acquire release. (* so that wp_pure doesn't stumble *)
Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) :
( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag γ x P }}}
pushBag x (of_val v)
{{{ RET #(); Q }}}.
Proof.
iIntros "#Hvs".
iIntros (Φ). iAlways. iIntros "[#Hbag HP] HΦ".
unfold pushBag. do 2 wp_rec.
rewrite /is_bag /bag_inv.
iDestruct "Hbag" as (lk b γl) "[% #Hlk]"; simplify_eq/=.
repeat wp_pure _.
wp_apply (acquire_spec with "Hlk"). iIntros "[Htok Hb1]".
iDestruct "Hb1" as (ls) "[Hb Ha]".
wp_seq. wp_load. wp_let.
wp_bind (_ <- _)%E.
iApply (wp_mask_mono _ (∖↑N)); first done.
iMod ("Hvs" with "[$Ha $HP]") as "[Hbc HQ]".
wp_store. wp_let.
wp_apply (release_spec with "[$Hlk $Htok Hbc Hb]").
{ iExists (v::ls); iFrame. }
iIntros "_". by iApply "HΦ".
Qed.
Lemma popBag_spec (P : iProp Σ) (Q : val iProp Σ) γ x :
( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag γ x P }}}
popBag x
{{{ v, RET v; Q v }}}.
Proof.
iIntros "#Hvs1 #Hvs2".
iIntros (Φ). iAlways. iIntros "[#Hbag HP] HΦ".
unfold popBag. wp_rec.
rewrite /is_bag /bag_inv.
iDestruct "Hbag" as (lk b γl) "[% #Hlk]"; simplify_eq/=.
repeat wp_pure _.
wp_apply (acquire_spec with "Hlk"). iIntros "[Htok Hb1]".
iDestruct "Hb1" as (ls) "[Hb Ha]".
wp_seq. wp_bind (!#b)%E.
iApply (wp_mask_mono _ (∖↑N)); first done.
destruct ls as [|v ls]; simpl.
- iMod ("Hvs2" with "[$Ha $HP]") as "[Hbc HQ]".
wp_load. repeat wp_pure _.
wp_apply (release_spec with "[$Hlk $Htok Hbc Hb]").
{ iExists []; iFrame. }
iIntros "_". repeat wp_pure _. by iApply "HΦ".
- iMod ("Hvs1" with "[$Ha $HP]") as "[Hbc HQ]".
wp_load. repeat wp_pure _. wp_store. do 2 wp_pure _.
wp_apply (release_spec with "[$Hlk $Htok Hbc Hb]").
{ iExists ls; iFrame. }
iIntros "_". repeat wp_pure _. by iApply "HΦ".
Qed.
End proof.
Typeclasses Opaque bag_contents is_bag.
Canonical Structure cg_bag `{!heapG Σ, !bagG Σ} : bag Σ :=
{| abstract_bag.is_bag := is_bag;
abstract_bag.is_bag_persistent := is_bag_persistent;
abstract_bag.bag_contents_timeless := bag_contents_timeless;
abstract_bag.bag_contents_agree := bag_contents_agree;
abstract_bag.bag_contents_update := bag_contents_update;
abstract_bag.newBag_spec := newBag_spec;
abstract_bag.pushBag_spec := pushBag_spec;
abstract_bag.popBag_spec := popBag_spec |}.
(** Concurrent Runner example from
"Modular Reasoning about Separation of Concurrent Data Structures"
<http://www.kasv.dk/articles/hocap-ext.pdf>
*)
From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import cmra agree frac csum excl.
From iris.heap_lang.lib Require Import assert.
From iris.base_logic.lib Require Import fractional.
From iris_examples.hocap Require Export abstract_bag shared_bag lib.oneshot.
Set Default Proof Using "Type".
(** RA describing the evolution of a task *)
(** INIT = task has been initiated
SET_RES v = the result of the task has been computed and it is v
FIN v = the task has been completed with the result v *)
(* We use this RA to verify the Task.run() method *)
Definition saR := csumR fracR (csumR (prodR fracR (agreeR valC)) (agreeR valC)).
Class saG Σ := { sa_inG :> inG Σ saR }.
Definition INIT `{saG Σ} γ (q: Qp) := own γ (Cinl q%Qp).
Definition SET_RES `{saG Σ} γ (q: Qp) (v: val) := own γ (Cinr (Cinl (q%Qp, to_agree v))).
Definition FIN `{saG Σ} γ (v: val) := own γ (Cinr (Cinr (to_agree v))).
Global Instance INIT_fractional `{saG Σ} γ : Fractional (INIT γ)%I.
Proof.
intros p q. rewrite /INIT.
rewrite -own_op. f_equiv.
Qed.
Global Instance INIT_as_fractional `{saG Σ} γ q:
AsFractional (INIT γ q) (INIT γ)%I q.
Proof.
split; [done | apply _].
Qed.
Global Instance SET_RES_fractional `{saG Σ} γ v : Fractional (fun q => SET_RES γ q v)%I.
Proof.
intros p q. rewrite /SET_RES.
rewrite -own_op Cinr_op Cinl_op pair_op agree_idemp. f_equiv.
Qed.
Global Instance SET_RES_as_fractional `{saG Σ} γ q v:
AsFractional (SET_RES γ q v) (fun q => SET_RES γ q v)%I q.
Proof.
split; [done | apply _].
Qed.
Lemma new_INIT `{saG Σ} : (|==> γ, INIT γ 1%Qp)%I.
Proof. by apply own_alloc. Qed.
Lemma INIT_not_SET_RES `{saG Σ} γ q q' v :
(INIT γ q - SET_RES γ q' v - False)%I.
Proof.
iIntros "Hs Hp".
iDestruct (own_valid_2 with "Hs Hp") as %[].
Qed.
Lemma INIT_not_FIN `{saG Σ} γ q v :
(INIT γ q - FIN γ v - False)%I.
Proof.
iIntros "Hs Hp".
iDestruct (own_valid_2 with "Hs Hp") as %[].
Qed.
Lemma SET_RES_not_FIN `{saG Σ} γ q v v' :
(SET_RES γ q v - FIN γ v' - False)%I.
Proof.
iIntros "Hs Hp".
iDestruct (own_valid_2 with "Hs Hp") as %[].
Qed.
Lemma SET_RES_agree `{saG Σ} (γ: gname) (q q': Qp) (v w: val) :
SET_RES γ q v - SET_RES γ q' w - v = w.
Proof.
iIntros "Hs1 Hs2".
iDestruct (own_valid_2 with "Hs1 Hs2") as %Hfoo.
iPureIntro. rewrite Cinr_op Cinl_op pair_op in Hfoo.
by destruct Hfoo as [_ ?%agree_op_invL'].
Qed.
Lemma FIN_agree `{saG Σ} (γ: gname) (v w: val) :
FIN γ v - FIN γ w - v = w.
Proof.
iIntros "Hs1 Hs2".
iDestruct (own_valid_2 with "Hs1 Hs2") as %Hfoo.
iPureIntro. rewrite Cinr_op Cinr_op in Hfoo.
by apply agree_op_invL'.
Qed.
Lemma INIT_SET_RES `{saG Σ} (v: val) γ :
INIT γ 1%Qp == SET_RES γ 1%Qp v.
Proof.
apply own_update.
by apply cmra_update_exclusive.
Qed.
Lemma SET_RES_FIN `{saG Σ} (v w: val) γ :
SET_RES γ 1%Qp v == FIN γ w.
Proof.
apply own_update.
by apply cmra_update_exclusive.
Qed.
Section contents.
Context `{heapG Σ, !oneshotG Σ, !saG Σ}.
Variable b : bag Σ.
Variable N : namespace.
(* new Task : Runner<A,B> -> A -> Task<A,B> *)
Definition newTask : val := λ: "r" "a", ("r", "a", ref #0, ref NONEV).
(* task_runner == Fst Fst Fst *)
(* task_arg == Snd Fst Fst *)
(* task_state == Snd Fst *)
(* task_res == Snd *)
(* Task.Run : Task<A,B> -> () *)
Definition task_Run : val := λ: "t",
let: "runner" := Fst (Fst (Fst "t")) in
let: "arg" := Snd (Fst (Fst "t")) in
let: "state" := Snd (Fst "t") in
let: "res" := Snd "t" in
let: "tmp" := (Fst "runner") "runner" "arg"
(* runner.body(runner,arg)*) in
"res" <- (SOME "tmp");;
"state" <- #1.
(* Task.Join : Task<A,B> -> B *)
Definition task_Join : val := rec: "join" "t" :=
let: "runner" := Fst (Fst (Fst "t")) in
let: "arg" := Snd (Fst (Fst "t")) in
let: "state" := Snd (Fst "t") in
let: "res" := Snd "t" in
if: (!"state" = #1)
then match: !"res" with
NONE => assert #false
| SOME "v" => "v"
end
else "join" "t".
(* runner_body == Fst *)
(* runner_bag == Snd *)
(* Runner.Fork : Runner<A,B> -> A -> Task<A,B> *)
Definition runner_Fork : val := λ: "r" "a",
let: "bag" := Snd "r" in
let: "t" := newTask "r" "a" in
pushBag b "bag" "t";;
"t".
(* Runner.runTask : Runner<A,B> -> () *)
Definition runner_runTask : val := λ: "r",
let: "bag" := Snd "r" in
match: popBag b "bag" with
NONE => #()
| SOME "t" => task_Run "t"
end.
(* Runner.runTasks : Runner<A,B> -> () *)
Definition runner_runTasks : val := rec: "runTasks" "r" :=
runner_runTask "r";; "runTasks" "r".
(* newRunner : (Runner<A,B> -> A -> B) -> nat -> Runner<A,B> *)
Definition newRunner : val := λ: "body" "n",
let: "bag" := newBag b #() in
let: "r" := ("body", "bag") in
let: "loop" :=
(rec: "loop" "i" :=
if: ("i" < "n")
then Fork (runner_runTasks "r");; "loop" ("i"+#1)
else "r"
) in
"loop" #0.
Definition task_inv (γ γ': gname) (state res: loc) (Q: val iProp Σ) : iProp Σ :=
((state #0 res NONEV pending γ (1/2)%Qp INIT γ' (1/2)%Qp)
( v, state #0 res SOMEV v pending γ (1/2)%Qp SET_RES γ' (1/2)%Qp v)
( v, state #1 res SOMEV v FIN γ' v (Q v pending γ (1/2)%Qp shot γ v)))%I.
Definition isTask (r: val) (γ γ': gname) (t: val) (P: val iProp Σ) (Q: val val iProp Σ) : iProp Σ :=
( (arg : val) (state res : loc),
t = (r, arg, #state, #res)%V
P arg INIT γ' (1/2)%Qp
inv (N.@"task") (task_inv γ γ' state res (Q arg)))%I.
Definition task (γ γ': gname) (t arg: val) (P: val iProp Σ) (Q: val val iProp Σ) : iProp Σ :=
( (r: val) (state res : loc),
t = (r, arg, #state, #res)%V
pending γ (1/2)%Qp
inv (N.@"task") (task_inv γ γ' state res (Q arg)))%I.
Ltac auto_equiv :=
(* Deal with "pointwise_relation" *)
repeat lazymatch goal with
| |- pointwise_relation _ _ _ _ => intros ?
end;
(* Normalize away equalities. *)
repeat match goal with
| H : _ {_} _ |- _ => apply (discrete_iff _ _) in H
| _ => progress simplify_eq
end;
(* repeatedly apply congruence lemmas and use the equalities in the hypotheses. *)
try (f_equiv; fast_done || auto_equiv).
Ltac solve_proper ::= solve_proper_core ltac:(fun _ => simpl; auto_equiv).
Program Definition pre_runner (γ : name Σ b) (P: val iProp Σ) (Q: val val iProp Σ) :
(valC -n> iProp Σ) -n> (valC -n> iProp Σ) := λne R r,
( (body bag : val), r = (body, bag)%V
bagS b (N.@"bag") (λ x y, γ γ', isTask (body,x) γ γ' y P Q) γ bag
r a: val, (R r P a - WP body r a {{ v, Q a v }}))%I.
Solve Obligations with solve_proper.
Global Instance pre_runner_contractive (γ : name Σ b) P Q :
Contractive (pre_runner γ P Q).
Proof. unfold pre_runner. solve_contractive. Qed.
Definition runner (γ: name Σ b) (P: val iProp Σ) (Q: val val iProp Σ) :
valC -n> iProp Σ :=
(fixpoint (pre_runner γ P Q))%I.
Lemma runner_unfold γ r P Q :
runner γ P Q r
( (body bag : val), r = (body, bag)%V
bagS b (N.@"bag") (λ x y, γ γ', isTask (body,x) γ γ' y P Q) γ bag
r a: val, (runner γ P Q r P a - WP body r a {{ v, Q a v }}))%I.
Proof. rewrite /runner. by rewrite {1}fixpoint_unfold. Qed.
Global Instance runner_persistent γ r P Q :
Persistent (runner γ P Q r).
Proof. rewrite /runner fixpoint_unfold. apply _. Qed.
Lemma newTask_spec γb (r a : val) P (Q : val val iProp Σ) :
{{{ runner γb P Q r P a }}}
newTask r a
{{{ γ γ' t, RET t; isTask r γ γ' t P Q task γ γ' t a P Q }}}.
Proof.
iIntros (Φ) "[#Hrunner HP] HΦ".
unfold newTask. do 2 wp_rec. iApply wp_fupd.
wp_alloc status as "Hstatus".
wp_alloc res as "Hres".
iMod (new_pending) as (γ) "[Htoken Htask]".
iMod (new_INIT) as (γ') "[Hinit Hinit']".
iMod (inv_alloc (N.@"task") _ (task_inv γ γ' status res (Q a))%I with "[-HP HΦ Htask Hinit]") as "#Hinv".
{ iNext. iLeft. iFrame. }
iModIntro. iApply "HΦ".
iFrame. iSplitL; iExists _,_,_; iFrame "Hinv"; eauto.
Qed.
Lemma task_Join_spec γb γ γ' (te : expr) (r t a : val) P Q
`{!IntoVal te t}:
{{{ runner γb P Q r task γ γ' t a P Q }}}
task_Join te
{{{ res, RET res; Q a res }}}.
Proof.
iIntros (Φ) "[#Hrunner Htask] HΦ".
rewrite -(of_to_val te t into_val).
iLöb as "IH".
rewrite {2}/task_Join.
iDestruct "Htask" as (r' state res) "(% & Htoken & #Htask)". simplify_eq.
repeat wp_pure _.
wp_bind (! #state)%E. iInv (N.@"task") as "Hstatus" "Hcl".
rewrite {2}/task_inv.
iDestruct "Hstatus" as "[>(Hstate & Hres)|[Hstatus|Hstatus]]".
- wp_load.
iMod ("Hcl" with "[Hstate Hres]") as "_".
{ iNext; iLeft; iFrame. }
iModIntro. wp_op. wp_if.
rewrite /task_Join. iApply ("IH" with "[$Htoken] HΦ").
iExists _,_,_; iFrame "Htask"; eauto.
- iDestruct "Hstatus" as (v) "(>Hstate & >Hres & HQ)".
wp_load.
iMod ("Hcl" with "[Hstate Hres HQ]") as "_".
{ iNext; iRight; iLeft. iExists _; iFrame. }
iModIntro. wp_op. wp_if.
rewrite /task_Join. iApply ("IH" with "[$Htoken] HΦ").
iExists _,_,_; iFrame "Htask"; eauto.
- iDestruct "Hstatus" as (v) "(>Hstate & >Hres & #HFIN & HQ)".
wp_load.
iDestruct "HQ" as "[[HQ Htoken2]|Hshot]"; last first.
{ iExFalso. iApply (shot_not_pending with "Hshot Htoken"). }
iMod (shoot v γ with "[Htoken Htoken2]") as "#Hshot".
{ iApply (fractional_split_2 with "Htoken Htoken2").
assert ((1 / 2 + 1 / 2)%Qp = 1%Qp) as -> by apply Qp_div_2.
apply _. }
iMod ("Hcl" with "[Hstate Hres]") as "_".
{ iNext. iRight. iRight. iExists _. iFrame. iFrame "HFIN".
iRight. eauto. }
iModIntro. wp_op. wp_if. wp_bind (!#res)%E.
iInv (N.@"task") as "[>(Hstate & Hres & Hpending & HINIT)|[Hstatus|Hstatus]]" "Hcl".
{ iExFalso. iApply (shot_not_pending with "Hshot Hpending"). }
{ iDestruct "Hstatus" as (v') "(Hstate & Hres & Hpending & >HSETRES)".
iExFalso. iApply (SET_RES_not_FIN with "HSETRES HFIN"). }
iDestruct "Hstatus" as (v') "(Hstate & Hres & _ & HQ')".
iDestruct "HQ'" as "[[? >Hpending]|>Hshot']".
{ iExFalso. iApply (shot_not_pending with "Hshot Hpending"). }
iDestruct (shot_agree with "Hshot Hshot'") as %->.
wp_load.
iMod ("Hcl" with "[Hres Hstate]") as "_".
{ iNext. iRight. iRight. iExists _; iFrame. iFrame "HFIN". by iRight. }
iModIntro. wp_match. iApply "HΦ"; eauto.
Qed.
Lemma task_Run_spec γb γ γ' r t P Q :
{{{ runner γb P Q r isTask r γ γ' t P Q }}}
task_Run t
{{{ RET #(); True }}}.
Proof.
iIntros (Φ) "[#Hrunner Htask] HΦ".
rewrite runner_unfold.
iDestruct "Hrunner" as (body bag) "(% & #Hbag & #Hbody)".
iDestruct "Htask" as (arg state res) "(% & HP & HINIT & #Htask)".
simplify_eq. rewrite /task_Run.
repeat wp_pure _.
wp_bind (body _ arg).
iDestruct ("Hbody" $! (PairV body bag)