Commit 791a505d authored by Ralf Jung's avatar Ralf Jung

port to gen_proofmode

parent 3aa2c6c8
Pipeline #10266 passed with stage
in 10 minutes
...@@ -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.2018-06-23.0.a6e581d0") | (= "dev") } "coq-iris" { (= "branch.gen_proofmode.2018-06-21.3.94b2c6c1") | (= "dev") }
"coq-autosubst" { = "dev.coq86" } "coq-autosubst" { = "dev.coq86" }
] ]
...@@ -57,10 +57,12 @@ Proof. ...@@ -57,10 +57,12 @@ Proof.
iDestruct 1 as (x) "[#Hγ Hx]"; iDestruct 1 as (x') "[#Hγ' Hx']". iDestruct 1 as (x) "[#Hγ Hx]"; iDestruct 1 as (x') "[#Hγ' Hx']".
iAssert ( (x x'))%I as "Hxx". iAssert ( (x x'))%I as "Hxx".
{ iCombine "Hγ" "Hγ'" as "Hγ2". iClear "Hγ Hγ'". { iCombine "Hγ" "Hγ'" as "Hγ2". iClear "Hγ Hγ'".
rewrite own_valid csum_validI /= agree_validI agree_equivI uPred.later_equivI /=. rewrite own_valid csum_validI /= agree_validI agree_equivI bi.later_equivI /=.
rewrite -{2}[x]cFunctor_id -{2}[x']cFunctor_id. rewrite -{2}[x]cFunctor_id -{2}[x']cFunctor_id.
rewrite (ne_proper (cFunctor_map F) (cid, cid) (_ _, _ _)); last first. assert (HF : cFunctor_map F (cid, cid) cFunctor_map F (iProp_fold (Σ:=Σ) iProp_unfold, iProp_fold (Σ:=Σ) iProp_unfold)).
{ by split; intro; simpl; symmetry; apply iProp_fold_unfold. } { apply ne_proper; first by apply _.
by split; intro; simpl; symmetry; apply iProp_fold_unfold. }
rewrite (HF x). rewrite (HF x').
rewrite !cFunctor_compose. iNext. by iRewrite "Hγ2". } rewrite !cFunctor_compose. iNext. by iRewrite "Hγ2". }
iNext. iRewrite -"Hxx" in "Hx'". iNext. iRewrite -"Hxx" in "Hx'".
iExists x; iFrame "Hγ". iApply (Ψ_join with "Hx Hx'"). iExists x; iFrame "Hγ". iApply (Ψ_join with "Hx Hx'").
......
From iris.program_logic Require Export weakestpre. From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang. From iris.heap_lang Require Export lang.
From stdpp Require Import functions. From stdpp Require Import functions.
From iris.base_logic Require Import big_op lib.saved_prop lib.sts. From iris.base_logic Require Import lib.saved_prop lib.sts.
From iris.heap_lang Require Import proofmode. From iris.heap_lang Require Import proofmode.
From iris_examples.barrier Require Export barrier. From iris_examples.barrier Require Export barrier.
From iris_examples.barrier Require Import protocol. From iris_examples.barrier Require Import protocol.
...@@ -148,7 +148,7 @@ Proof. ...@@ -148,7 +148,7 @@ Proof.
return to the client *) return to the client *)
iDestruct "Hr" as (Ψ) "[HΨ Hsp]". iDestruct "Hr" as (Ψ) "[HΨ Hsp]".
iDestruct (big_opS_delete _ _ i with "Hsp") as "[#HΨi Hsp]"; first done. iDestruct (big_opS_delete _ _ i with "Hsp") as "[#HΨi Hsp]"; first done.
iAssert ( Ψ i [ set] j I {[i]}, Ψ j)%I with "[HΨ]" as "[HΨ HΨ']". iAssert ( (Ψ i [ set] j I {[i]}, Ψ j))%I with "[HΨ]" as "[HΨ HΨ']".
{ iNext. iApply (big_opS_delete _ _ i); first done. by iApply "HΨ". } { iNext. iApply (big_opS_delete _ _ i); first done. by iApply "HΨ". }
iMod ("Hclose" $! (State High (I {[ i ]})) with "[HΨ' Hl Hsp]"). iMod ("Hclose" $! (State High (I {[ i ]})) with "[HΨ' Hl Hsp]").
{ iSplit; [iPureIntro; by eauto using wait_step|]. { iSplit; [iPureIntro; by eauto using wait_step|].
......
...@@ -91,7 +91,7 @@ Section stack_works. ...@@ -91,7 +91,7 @@ Section stack_works.
- The resources for the successful and failing pop must be disjoint. - The resources for the successful and failing pop must be disjoint.
Instead, there should be a normal conjunction between them. Instead, there should be a normal conjunction between them.
Open question: How does this relate to a logically atomic spec? *) Open question: How does this relate to a logically atomic spec? *)
Theorem stack_works ι P Q Q' Q'' Φ : Theorem stack_works ι P Q Q' Q'' (Φ : val iProp Σ) :
( (f f : val), ( (f f : val),
((( v vs, P (v :: vs) ={∖↑ι}= Q v P vs) (* pop *) ((( v vs, P (v :: vs) ={∖↑ι}= Q v P vs) (* pop *)
(P [] ={∖↑ι}= Q' P []) - (P [] ={∖↑ι}= Q' P []) -
......
...@@ -144,7 +144,7 @@ Section stack_works. ...@@ -144,7 +144,7 @@ Section stack_works.
Qed. Qed.
(* Whole-stack invariant (P). *) (* Whole-stack invariant (P). *)
Theorem stack_works {channelG0 : channelG Σ} N P Q Q' Q'' Φ : Theorem stack_works {channelG0 : channelG Σ} N P Q Q' Q'' (Φ : val iProp Σ) :
( (f f : val), ( (f f : val),
(((( v vs, P (v :: vs) ={ N}= Q v P vs) (((( v vs, P (v :: vs) ={ N}= Q v P vs)
(P [] ={ N}= Q' P []) - (P [] ={ N}= Q' P []) -
......
...@@ -76,7 +76,7 @@ Section proof. ...@@ -76,7 +76,7 @@ Section proof.
Lemma bag_contents_agree γb X Y : Lemma bag_contents_agree γb X Y :
bag_contents γb X - bag_contents γb Y - X = Y. bag_contents γb X - bag_contents γb Y - X = Y.
Proof. Proof.
rewrite /bag_contents. apply uPred.wand_intro_r. rewrite /bag_contents. apply bi.wand_intro_r.
rewrite -own_op own_valid uPred.discrete_valid. rewrite -own_op own_valid uPred.discrete_valid.
f_equiv=> /=. rewrite pair_op. f_equiv=> /=. rewrite pair_op.
by intros [_ ?%agree_op_invL']. by intros [_ ?%agree_op_invL'].
......
...@@ -3,9 +3,9 @@ ...@@ -3,9 +3,9 @@
<http://www.kasv.dk/articles/hocap-ext.pdf> <http://www.kasv.dk/articles/hocap-ext.pdf>
*) *)
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.bi.lib Require Import fractional.
From iris.algebra Require Import cmra agree frac csum excl. From iris.algebra Require Import cmra agree frac csum excl.
From iris.heap_lang.lib Require Import assert. 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. From iris_examples.hocap Require Export abstract_bag shared_bag lib.oneshot.
Set Default Proof Using "Type". Set Default Proof Using "Type".
...@@ -208,11 +208,11 @@ Section contents. ...@@ -208,11 +208,11 @@ Section contents.
( (body bag : val), r = (body, bag)%V ( (body bag : val), r = (body, bag)%V
bagS b (N.@"bag") (λ x y, γ γ', isTask (body,x) γ γ' y P Q) γ bag 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. 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. Proof. rewrite /runner. by rewrite {1}(fixpoint_unfold (pre_runner _ _ _) r). Qed.
Global Instance runner_persistent γ r P Q : Global Instance runner_persistent γ r P Q :
Persistent (runner γ P Q r). Persistent (runner γ P Q r).
Proof. rewrite /runner fixpoint_unfold. apply _. Qed. Proof. rewrite /runner (fixpoint_unfold (pre_runner _ _ _) r). apply _. Qed.
Lemma newTask_spec γb (r a : val) P (Q : val val iProp Σ) : Lemma newTask_spec γb (r a : val) P (Q : val val iProp Σ) :
{{{ runner γb P Q r P a }}} {{{ runner γb P Q r P a }}}
...@@ -231,14 +231,13 @@ Section contents. ...@@ -231,14 +231,13 @@ Section contents.
iFrame. iSplitL; iExists _,_,_; iFrame "Hinv"; eauto. iFrame. iSplitL; iExists _,_,_; iFrame "Hinv"; eauto.
Qed. Qed.
Lemma task_Join_spec γb γ γ' (te : expr) (r t a : val) P Q Lemma task_Join_spec γb γ γ' (te : expr) (r t a : val) P Q :
`{!IntoVal te t}: IntoVal te t
{{{ runner γb P Q r task γ γ' t a P Q }}} {{{ runner γb P Q r task γ γ' t a P Q }}}
task_Join te task_Join te
{{{ res, RET res; Q a res }}}. {{{ res, RET res; Q a res }}}.
Proof. Proof.
iIntros (Φ) "[#Hrunner Htask] HΦ". iIntros (<- Φ) "[#Hrunner Htask] HΦ".
rewrite -(of_to_val te t into_val).
iLöb as "IH". iLöb as "IH".
rewrite {2}/task_Join. rewrite {2}/task_Join.
iDestruct "Htask" as (r' state res) "(% & Htoken & #Htask)". simplify_eq. iDestruct "Htask" as (r' state res) "(% & Htoken & #Htask)". simplify_eq.
...@@ -386,16 +385,14 @@ Section contents. ...@@ -386,16 +385,14 @@ Section contents.
- iNext. by iApply runner_runTasks_spec. - iNext. by iApply runner_runTasks_spec.
Qed. Qed.
Lemma newRunner_spec P Q (fe ne : expr) (f : val) (n : nat) Lemma newRunner_spec P Q (fe ne : expr) (f : val) (n : nat) :
`{!IntoVal fe f} `{!IntoVal ne (#n)}: IntoVal fe f IntoVal ne (#n)
{{{ (γ: name Σ b) (r: val), {{{ (γ: name Σ b) (r: val),
a: val, (runner γ P Q r P a - WP f r a {{ v, Q a v }}) }}} a: val, (runner γ P Q r P a - WP f r a {{ v, Q a v }}) }}}
newRunner fe ne newRunner fe ne
{{{ γb r, RET r; runner γb P Q r }}}. {{{ γb r, RET r; runner γb P Q r }}}.
Proof. Proof.
iIntros (Φ) "#Hf HΦ". iIntros (<- <- Φ) "#Hf HΦ".
rewrite -(of_to_val fe f into_val).
rewrite -(of_to_val ne #n into_val).
unfold newRunner. iApply wp_fupd. unfold newRunner. iApply wp_fupd.
repeat wp_pure _. repeat wp_pure _.
wp_bind (newBag b #()). wp_bind (newBag b #()).
...@@ -408,15 +405,13 @@ Section contents. ...@@ -408,15 +405,13 @@ Section contents.
iNext. iIntros (r) "Hr". by iApply "HΦ". iNext. iIntros (r) "Hr". by iApply "HΦ".
Qed. Qed.
Lemma runner_Fork_spec γb (re ae:expr) (r a:val) P Q Lemma runner_Fork_spec γb (re ae:expr) (r a:val) P Q :
`{!IntoVal re r} `{!IntoVal ae a}: IntoVal re r IntoVal ae a
{{{ runner γb P Q r P a }}} {{{ runner γb P Q r P a }}}
runner_Fork re ae runner_Fork re ae
{{{ γ γ' t, RET t; task γ γ' t a P Q }}}. {{{ γ γ' t, RET t; task γ γ' t a P Q }}}.
Proof. Proof.
iIntros (Φ) "[#Hrunner HP] HΦ". iIntros (<- <- Φ) "[#Hrunner HP] HΦ".
rewrite -(of_to_val re r into_val).
rewrite -(of_to_val ae a into_val).
rewrite /runner_Fork runner_unfold. rewrite /runner_Fork runner_unfold.
iDestruct "Hrunner" as (body bag) "(% & #Hbag & #Hbody)". simplify_eq. iDestruct "Hrunner" as (body bag) "(% & #Hbag & #Hbody)". simplify_eq.
Local Opaque newTask. Local Opaque newTask.
......
...@@ -97,7 +97,7 @@ Section proof. ...@@ -97,7 +97,7 @@ Section proof.
Lemma bag_contents_agree γb X Y : Lemma bag_contents_agree γb X Y :
bag_contents γb X - bag_contents γb Y - X = Y. bag_contents γb X - bag_contents γb Y - X = Y.
Proof. Proof.
rewrite /bag_contents. apply uPred.wand_intro_r. rewrite /bag_contents. apply bi.wand_intro_r.
rewrite -own_op own_valid uPred.discrete_valid. rewrite -own_op own_valid uPred.discrete_valid.
f_equiv=> /=. rewrite pair_op. f_equiv=> /=. rewrite pair_op.
by intros [_ ?%agree_op_invL']. by intros [_ ?%agree_op_invL'].
......
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris.bi.lib Require Import fractional.
From iris.algebra Require Import cmra agree frac csum. From iris.algebra Require Import cmra agree frac csum.
From iris.base_logic.lib Require Import fractional.
From iris_examples.hocap Require Export abstract_bag shared_bag. From iris_examples.hocap Require Export abstract_bag shared_bag.
Set Default Proof Using "Type". Set Default Proof Using "Type".
......
...@@ -10,7 +10,6 @@ From iris.proofmode Require Import tactics. ...@@ -10,7 +10,6 @@ From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import cmra agree frac csum excl. From iris.algebra Require Import cmra agree frac csum excl.
From iris.heap_lang.lib Require Import lock spin_lock. From iris.heap_lang.lib Require Import lock spin_lock.
From iris.base_logic.lib Require Import fractional.
From iris_examples.hocap Require Import abstract_bag shared_bag concurrent_runners. From iris_examples.hocap Require Import abstract_bag shared_bag concurrent_runners.
Section contents. Section contents.
......
...@@ -70,7 +70,7 @@ Section proof. ...@@ -70,7 +70,7 @@ Section proof.
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 %<-.
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 big_sepMS_union uPred.later_sep big_sepMS_singleton. rewrite big_sepMS_union bi.later_sep big_sepMS_singleton.
iDestruct "HPs" as "[HP HPs]". iDestruct "HPs" as "[HP HPs]".
iMod ("Hcl" with "[-HP Hb1]") as "_". iMod ("Hcl" with "[-HP Hb1]") as "_".
{ iNext. iExists _; iFrame. } { iNext. iExists _; iFrame. }
......
...@@ -43,7 +43,7 @@ Section ccounter. ...@@ -43,7 +43,7 @@ Section ccounter.
Lemma is_ccounter_op γ₁ γ₂ q1 q2 (n1 n2 : nat) : Lemma is_ccounter_op γ₁ γ₂ q1 q2 (n1 n2 : nat) :
is_ccounter γ₁ γ₂ (q1 + q2) (n1 + n2)%nat is_ccounter γ₁ γ₂ q1 n1 is_ccounter γ₁ γ₂ q2 n2. is_ccounter γ₁ γ₂ (q1 + q2) (n1 + n2)%nat is_ccounter γ₁ γ₂ q1 n1 is_ccounter γ₁ γ₂ q2 n2.
Proof. Proof.
apply uPred.equiv_spec; split; rewrite /is_ccounter frac_auth_frag_op own_op. apply bi.equiv_spec; split; rewrite /is_ccounter frac_auth_frag_op own_op.
- iIntros "[? #?]". - iIntros "[? #?]".
iFrame "#"; iFrame. iFrame "#"; iFrame.
- iIntros "[[? #?] [? _]]". - iIntros "[[? #?] [? _]]".
......
...@@ -593,7 +593,7 @@ Section ccounter. ...@@ -593,7 +593,7 @@ Section ccounter.
Lemma is_ccounter_op γ q1 q2 (n1 n2 : nat) : Lemma is_ccounter_op γ q1 q2 (n1 n2 : nat) :
is_ccounter γ (q1 + q2) (n1 + n2)%nat is_ccounter γ q1 n1 is_ccounter γ q2 n2. is_ccounter γ (q1 + q2) (n1 + n2)%nat is_ccounter γ q1 n1 is_ccounter γ q2 n2.
Proof. Proof.
apply uPred.equiv_spec; split; rewrite /is_ccounter frac_auth_frag_op own_op. apply bi.equiv_spec; split; rewrite /is_ccounter frac_auth_frag_op own_op.
- iIntros "[? #?]". - iIntros "[? #?]".
iFrame "#"; iFrame. iFrame "#"; iFrame.
- iIntros "[[? #?] [? _]]". - iIntros "[[? #?] [? _]]".
......
...@@ -304,8 +304,8 @@ Qed. ...@@ -304,8 +304,8 @@ Qed.
The specifications are explained in the Iris Lecture Notes. *) The specifications are explained in the Iris Lecture Notes. *)
Lemma foldr_spec_PI P I (f a hd : val) (e_f e_a e_hd : expr) (xs : list val) Lemma foldr_spec_PI P I (f a hd : val) (e_f e_a e_hd : expr) (xs : list val) :
`{Hef : !IntoVal e_f f} `{Hea : !IntoVal e_a a} `{Hehd : !IntoVal e_hd hd} : IntoVal e_f f IntoVal e_a a IntoVal e_hd hd
{{{ ( (x a' : val) (ys : list val), {{{ ( (x a' : val) (ys : list val),
{{{ P x I ys a'}}} {{{ P x I ys a'}}}
e_f (x, a') e_f (x, a')
...@@ -320,10 +320,7 @@ Lemma foldr_spec_PI P I (f a hd : val) (e_f e_a e_hd : expr) (xs : list val) ...@@ -320,10 +320,7 @@ Lemma foldr_spec_PI P I (f a hd : val) (e_f e_a e_hd : expr) (xs : list val)
I xs r I xs r
}}}. }}}.
Proof. Proof.
apply of_to_val in Hef as <-. iIntros (<- <- <- ϕ) "(#H_f & H_isList & H_Px & H_Iempty) H_inv".
apply of_to_val in Hea as <-.
apply of_to_val in Hehd as <-.
iIntros (ϕ) "(#H_f & H_isList & H_Px & H_Iempty) H_inv".
iInduction xs as [|x xs'] "IH" forall (ϕ a hd); wp_rec; do 2 wp_let; iSimplifyEq. iInduction xs as [|x xs'] "IH" forall (ϕ a hd); wp_rec; do 2 wp_let; iSimplifyEq.
- wp_match. iApply "H_inv". eauto. - wp_match. iApply "H_inv". eauto.
- iDestruct "H_isList" as (l hd') "[% [H_l H_isList]]". - iDestruct "H_isList" as (l hd') "[% [H_l H_isList]]".
...@@ -338,8 +335,8 @@ Proof. ...@@ -338,8 +335,8 @@ Proof.
iExists l, hd'. by iFrame. iExists l, hd'. by iFrame.
Qed. Qed.
Lemma foldr_spec_PPI P I (f a hd : val ) (e_f e_a e_hd : expr) (xs : list val) Lemma foldr_spec_PPI P I (f a hd : val ) (e_f e_a e_hd : expr) (xs : list val) :
`{Hef : !IntoVal e_f f} `{Hea : !IntoVal e_a a} `{Hehd : !IntoVal e_hd hd} : IntoVal e_f f IntoVal e_a a IntoVal e_hd hd
{{{ ( (x a' : val) (ys : list val), {{{ ( (x a' : val) (ys : list val),
{{{ P x I ys a'}}} {{{ P x I ys a'}}}
e_f (x, a') e_f (x, a')
...@@ -353,10 +350,7 @@ Lemma foldr_spec_PPI P I (f a hd : val ) (e_f e_a e_hd : expr) (xs : list val) ...@@ -353,10 +350,7 @@ Lemma foldr_spec_PPI P I (f a hd : val ) (e_f e_a e_hd : expr) (xs : list val)
I xs r I xs r
}}}. }}}.
Proof. Proof.
apply of_to_val in Hef as <-. iIntros (<- <- <- ϕ) "(#H_f & H_isList & H_Iempty) H_inv".
apply of_to_val in Hea as <-.
apply of_to_val in Hehd as <-.
iIntros (ϕ) "(#H_f & H_isList & H_Iempty) H_inv".
rewrite about_isList. iDestruct "H_isList" as "(H_isList & H_Pxs)". rewrite about_isList. iDestruct "H_isList" as "(H_isList & H_Pxs)".
iApply (foldr_spec_PI with "[-H_inv]"). iApply (foldr_spec_PI with "[-H_inv]").
- iFrame. by iFrame "H_f". - iFrame. by iFrame "H_f".
...@@ -426,8 +420,8 @@ Proof. ...@@ -426,8 +420,8 @@ Proof.
Qed. Qed.
Lemma map_spec P Q (e_f e_hd : expr) (f hd : val) (xs : list val) Lemma map_spec P Q (e_f e_hd : expr) (f hd : val) (xs : list val) :
`{Hef : !IntoVal e_f f} `{Hehd : !IntoVal e_hd hd} : IntoVal e_f f IntoVal e_hd hd
{{{ {{{
is_list hd xs is_list hd xs
( (x : val), {{{ P x }}} ( (x : val), {{{ P x }}}
...@@ -442,9 +436,7 @@ Lemma map_spec P Q (e_f e_hd : expr) (f hd : val) (xs : list val) ...@@ -442,9 +436,7 @@ Lemma map_spec P Q (e_f e_hd : expr) (f hd : val) (xs : list val)
List.length ys = List.length xs List.length ys = List.length xs
}}}. }}}.
Proof. Proof.
apply of_to_val in Hef as <-. iIntros (<- <- ϕ) "[H_is_list [#H1 H_P_xs]] H_ϕ".
apply of_to_val in Hehd as <-.
iIntros (ϕ) "[H_is_list [#H1 H_P_xs]] H_ϕ".
do 3 (wp_pure _). do 3 (wp_pure _).
iApply (foldr_spec_PI iApply (foldr_spec_PI
P P
......
...@@ -5,7 +5,7 @@ From iris.heap_lang Require Export lang proofmode notation. ...@@ -5,7 +5,7 @@ From iris.heap_lang Require Export lang proofmode notation.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris.algebra Require Import agree frac frac_auth. From iris.algebra Require Import agree frac frac_auth.
From iris.base_logic.lib Require Import fractional. From iris.bi.lib Require Import fractional.
From iris.heap_lang.lib Require Import par. From iris.heap_lang.lib Require Import par.
...@@ -39,9 +39,9 @@ Section cnt_model. ...@@ -39,9 +39,9 @@ Section cnt_model.
Definition makeElem (q : Qp) (m : Z) : cntCmra := (q, to_agree m). Definition makeElem (q : Qp) (m : Z) : cntCmra := (q, to_agree m).
Notation "γ ⤇[ q ] m" := (own γ (makeElem q m)) Notation "γ ⤇[ q ] m" := (own γ (makeElem q m))
(at level 20, q at level 50, format "γ ⤇[ q ] m") : uPred_scope. (at level 20, q at level 50, format "γ ⤇[ q ] m") : bi_scope.
Notation "γ ⤇½ m" := (own γ (makeElem (1/2) m)) Notation "γ ⤇½ m" := (own γ (makeElem (1/2) m))
(at level 20, format "γ ⤇½ m") : uPred_scope. (at level 20, format "γ ⤇½ m") : bi_scope.
Global Instance makeElem_fractional γ m: Fractional (λ q, γ [q] m)%I. Global Instance makeElem_fractional γ m: Fractional (λ q, γ [q] m)%I.
Proof. Proof.
...@@ -98,9 +98,9 @@ Section cnt_model. ...@@ -98,9 +98,9 @@ Section cnt_model.
End cnt_model. End cnt_model.
Notation "γ ⤇[ q ] m" := (own γ (makeElem q m)) Notation "γ ⤇[ q ] m" := (own γ (makeElem q m))
(at level 20, q at level 50, format "γ ⤇[ q ] m") : uPred_scope. (at level 20, q at level 50, format "γ ⤇[ q ] m") : bi_scope.
Notation "γ ⤇½ m" := (own γ (makeElem (1/2) m)) Notation "γ ⤇½ m" := (own γ (makeElem (1/2) m))
(at level 20, format "γ ⤇½ m") : uPred_scope. (at level 20, format "γ ⤇½ m") : bi_scope.
Section cnt_spec. Section cnt_spec.
Context `{!heapG Σ, !cntG Σ} (N : namespace). Context `{!heapG Σ, !cntG Σ} (N : namespace).
...@@ -158,7 +158,7 @@ Section cnt_spec. ...@@ -158,7 +158,7 @@ Section cnt_spec.
{{{ Cnt γ P }}} incr # @ E {{{ (m : Z), RET #m; Cnt γ Q m}}}. {{{ Cnt γ P }}} incr # @ E {{{ (m : Z), RET #m; Cnt γ Q m}}}.
Proof. Proof.
iIntros (Hsubset) "#HVS". iIntros (Hsubset) "#HVS".
iIntros (Φ) "!# [HInc HP] HCont". iIntros (Φ) "!# [#HInc HP] HCont".
iLöb as "IH". iLöb as "IH".
wp_rec. wp_rec.
wp_bind (! _)%E. wp_bind (! _)%E.
...@@ -178,13 +178,13 @@ Section cnt_spec. ...@@ -178,13 +178,13 @@ Section cnt_spec.
{ iNext; iExists _; iFrame. } { iNext; iExists _; iFrame. }
iModIntro. iModIntro.
wp_if. wp_if.
iApply "HCont"; iFrame. iApply "HCont"; by iFrame.
- wp_cas_fail. - wp_cas_fail.
iMod ("HClose" with "[Hpt Hown]") as "_". iMod ("HClose" with "[Hpt Hown]") as "_".
{ iNext; iExists _; iFrame. } { iNext; iExists _; iFrame. }
iModIntro. iModIntro.
wp_if. wp_if.
iApply ("IH" with "HInc HP HCont"). iApply ("IH" with "HP HCont").
Qed. Qed.
Theorem wk_incr_spec (γ : gname) (E : coPset) (P Q : iProp Σ) ( : loc) (n : Z) (q : Qp): Theorem wk_incr_spec (γ : gname) (E : coPset) (P Q : iProp Σ) ( : loc) (n : Z) (q : Qp):
...@@ -193,7 +193,7 @@ Section cnt_spec. ...@@ -193,7 +193,7 @@ Section cnt_spec.
{{{ Cnt γ γ [q] n P}}} wk_incr # @ E {{{ RET #(); Cnt γ Q}}}. {{{ Cnt γ γ [q] n P}}} wk_incr # @ E {{{ RET #(); Cnt γ Q}}}.
Proof. Proof.
iIntros (Hsubset) "#HVS". iIntros (Hsubset) "#HVS".
iIntros (Φ) "!# [HInc [Hγ HP]] HCont". iIntros (Φ) "!# [#HInc [Hγ HP]] HCont".
wp_lam. wp_lam.
wp_bind (! _)%E. wp_bind (! _)%E.
iInv (N .@ "internal") as (m) "[>Hpt >Hown]" "HClose". iInv (N .@ "internal") as (m) "[>Hpt >Hown]" "HClose".
...@@ -211,7 +211,7 @@ Section cnt_spec. ...@@ -211,7 +211,7 @@ Section cnt_spec.
iMod ("HClose" with "[Hpt Hown]") as "_". iMod ("HClose" with "[Hpt Hown]") as "_".
{ iNext; iExists _; iFrame. } { iNext; iExists _; iFrame. }
iModIntro. iModIntro.
iApply "HCont"; iFrame. iApply "HCont"; by iFrame.
Qed. Qed.
Theorem wk_incr_spec' (γ : gname) (E : coPset) (P Q : iProp Σ) ( : loc) (n : Z) (q : Qp): Theorem wk_incr_spec' (γ : gname) (E : coPset) (P Q : iProp Σ) ( : loc) (n : Z) (q : Qp):
......
...@@ -50,8 +50,8 @@ Definition myrec : val := ...@@ -50,8 +50,8 @@ Definition myrec : val :=
(* Here is the specification for the recursion through the store function. (* Here is the specification for the recursion through the store function.
See the Iris Lecture Notes for an in-depth discussion of both the specification and See the Iris Lecture Notes for an in-depth discussion of both the specification and
the proof. *) the proof. *)
Lemma myrec_spec (P: val -> iProp Σ) (Q: val -> val -> iProp Σ) (F v1: val) (e_F e_v : expr) Lemma myrec_spec (P: val -> iProp Σ) (Q: val -> val -> iProp Σ) (F v1: val) (e_F e_v : expr) :
`{HeF : !IntoVal e_F F} `{Hev1 : !IntoVal e_v v1}: IntoVal e_F F IntoVal e_v v1
{{{ {{{
( e_f:expr,f : val, v2:val, IntoVal e_f f - {{{( v3 :val, {{{P v3 }}} e_f v3 {{{u, RET u; Q u v3 }}}) ( e_f:expr,f : val, v2:val, IntoVal e_f f - {{{( v3 :val, {{{P v3 }}} e_f v3 {{{u, RET u; Q u v3 }}})
P v2 }}} P v2 }}}
...@@ -62,9 +62,7 @@ Lemma myrec_spec (P: val -> iProp Σ) (Q: val -> val -> iProp Σ) (F v1: val) (e ...@@ -62,9 +62,7 @@ Lemma myrec_spec (P: val -> iProp Σ) (Q: val -> val -> iProp Σ) (F v1: val) (e
myrec e_F e_v myrec e_F e_v
{{{u, RET u; Q u v1}}}. {{{u, RET u; Q u v1}}}.
Proof. Proof.
apply of_to_val in HeF as <-. iIntros (<- <- ϕ) "[#H P] Q".
apply of_to_val in Hev1 as <-.
iIntros (ϕ) "[#H P] Q".
wp_lam. wp_lam.
wp_alloc r as "r". wp_alloc r as "r".
wp_let. wp_let.
...@@ -183,11 +181,10 @@ Section factorial_client. ...@@ -183,11 +181,10 @@ Section factorial_client.
myfac n myfac n
{{{v, RET v; v = #(fac_int n')}}}. {{{v, RET v; v = #(fac_int n')}}}.
Proof. Proof.
iIntros (H%of_to_val Hleq Φ) "_ ret"; simplify_eq. iIntros (<- Hleq Φ) "_ ret"; simplify_eq.
iApply (myrec_spec (fun v => m' : Z, 0 m' to_val v = Some #m'%I) iApply (myrec_spec (fun v => m' : Z, 0 m' to_val v = Some #m'%I)
(fun u => fun v => m' : Z, to_val v = Some #m' u = #(fac_int m')%I)). (fun u => fun v => m' : Z, to_val v = Some #m' u = #(fac_int m')%I)).
- iSplit; last eauto. iIntros (e_f f v) "%". iAlways. iIntros (Φ') "spec_f ret". - iSplit; last eauto. iIntros (e_f f v <-). iAlways. iIntros (Φ') "spec_f ret".
apply of_to_val in a as <-.
wp_lam. wp_lam. iDestruct "spec_f" as "[spec_f %]". wp_lam. wp_lam. iDestruct "spec_f" as "[spec_f %]".
destruct H as [m' [Hleqm' Heq%of_to_val]]; simplify_eq. destruct H as [m' [Hleqm' Heq%of_to_val]]; simplify_eq.
wp_binop. wp_binop.
......
...@@ -2,7 +2,6 @@ From iris_examples.logrel.F_mu Require Export logrel. ...@@ -2,7 +2,6 @@ From iris_examples.logrel.F_mu Require Export logrel.
From iris.program_logic Require Import lifting. From iris.program_logic Require Import lifting.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris_examples.logrel.F_mu Require Import rules. From iris_examples.logrel.F_mu Require Import rules.
From iris.base_logic Require Export big_op.
Definition log_typed `{irisG F_mu_lang Σ} (Γ : list type) (e : expr) (τ : type) := Δ vs, Definition log_typed `{irisG F_mu_lang Σ} (Γ : list type) (e : expr) (τ : type) := Δ vs,
env_Persistent Δ env_Persistent Δ
...@@ -74,12 +73,12 @@ Section fundamental. ...@@ -74,12 +73,12 @@ Section fundamental.
iIntros (w) "?". by rewrite interp_subst. iIntros (w) "?". by rewrite interp_subst.
- (* Fold *) - (* Fold *)
smart_wp_bind FoldCtx v "#Hv" IHtyped; cbn. iApply wp_value. smart_wp_bind FoldCtx v "#Hv" IHtyped; cbn. iApply wp_value.
rewrite /= -interp_subst fixpoint_unfold /=.