Commit 416f4dfb authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Merge branch 'master' of gitlab.mpi-sws.org:FP/iris-coq

parents 0ed0d7f9 d6e6d71e
...@@ -116,3 +116,4 @@ proofmode/invariants.v ...@@ -116,3 +116,4 @@ proofmode/invariants.v
proofmode/weakestpre.v proofmode/weakestpre.v
proofmode/ghost_ownership.v proofmode/ghost_ownership.v
proofmode/sts.v proofmode/sts.v
proofmode/classes.v
...@@ -698,8 +698,8 @@ End discrete. ...@@ -698,8 +698,8 @@ End discrete.
Notation discreteR A ra_mix := Notation discreteR A ra_mix :=
(CMRAT A discrete_cofe_mixin (discrete_cmra_mixin ra_mix)). (CMRAT A discrete_cofe_mixin (discrete_cmra_mixin ra_mix)).
Notation discreteLeibnizR A ra_mix := Notation discreteUR A ra_mix ucmra_mix :=
(CMRAT A (@discrete_cofe_mixin _ equivL _) (discrete_cmra_mixin ra_mix)). (UCMRAT A discrete_cofe_mixin (discrete_cmra_mixin ra_mix) ucmra_mix).
Global Instance discrete_cmra_discrete `{Equiv A, PCore A, Op A, Valid A, Global Instance discrete_cmra_discrete `{Equiv A, PCore A, Op A, Valid A,
@Equivalence A ()} (ra_mix : RAMixin A) : CMRADiscrete (discreteR A ra_mix). @Equivalence A ()} (ra_mix : RAMixin A) : CMRADiscrete (discreteR A ra_mix).
......
...@@ -18,7 +18,6 @@ Context {A : Type} `{∀ x y : A, Decision (x = y)}. ...@@ -18,7 +18,6 @@ Context {A : Type} `{∀ x y : A, Decision (x = y)}.
Instance dec_agree_valid : Valid (dec_agree A) := λ x, Instance dec_agree_valid : Valid (dec_agree A) := λ x,
if x is DecAgree _ then True else False. if x is DecAgree _ then True else False.
Instance dec_agree_equiv : Equiv (dec_agree A) := equivL.
Canonical Structure dec_agreeC : cofeT := leibnizC (dec_agree A). Canonical Structure dec_agreeC : cofeT := leibnizC (dec_agree A).
Instance dec_agree_op : Op (dec_agree A) := λ x y, Instance dec_agree_op : Op (dec_agree A) := λ x y,
......
...@@ -46,8 +46,8 @@ Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ : ...@@ -46,8 +46,8 @@ Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ :
Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed. Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed.
Lemma wp_le E (n1 n2 : Z) P Φ : Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P Φ (LitV (LitBool true))) (n1 n2 P |={E}=> Φ (LitV (LitBool true)))
(n2 < n1 P Φ (LitV (LitBool false))) (n2 < n1 P |={E}=> Φ (LitV (LitBool false)))
P WP BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. P WP BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
...@@ -55,8 +55,8 @@ Proof. ...@@ -55,8 +55,8 @@ Proof.
Qed. Qed.
Lemma wp_lt E (n1 n2 : Z) P Φ : Lemma wp_lt E (n1 n2 : Z) P Φ :
(n1 < n2 P Φ (LitV (LitBool true))) (n1 < n2 P |={E}=> Φ (LitV (LitBool true)))
(n2 n1 P Φ (LitV (LitBool false))) (n2 n1 P |={E}=> Φ (LitV (LitBool false)))
P WP BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. P WP BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
...@@ -64,8 +64,8 @@ Proof. ...@@ -64,8 +64,8 @@ Proof.
Qed. Qed.
Lemma wp_eq E (n1 n2 : Z) P Φ : Lemma wp_eq E (n1 n2 : Z) P Φ :
(n1 = n2 P Φ (LitV (LitBool true))) (n1 = n2 P |={E}=> Φ (LitV (LitBool true)))
(n1 n2 P Φ (LitV (LitBool false))) (n1 n2 P |={E}=> Φ (LitV (LitBool false)))
P WP BinOp EqOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. P WP BinOp EqOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
......
...@@ -148,81 +148,82 @@ Section heap. ...@@ -148,81 +148,82 @@ Section heap.
Proof. by rewrite heap_mapsto_op_eq Qp_div_2. Qed. Proof. by rewrite heap_mapsto_op_eq Qp_div_2. Qed.
(** Weakest precondition *) (** Weakest precondition *)
(* FIXME: try to reduce usage of wp_pvs. We're losing view shifts here. *)
Lemma wp_alloc N E e v Φ : Lemma wp_alloc N E e v Φ :
to_val e = Some v nclose N E to_val e = Some v nclose N E
heap_ctx N ( l, l v - Φ (LitV (LitLoc l))) WP Alloc e @ E {{ Φ }}. heap_ctx N ( l, l v ={E}= Φ (LitV (LitLoc l))) WP Alloc e @ E {{ Φ }}.
Proof. Proof.
iIntros {??} "[#Hinv HΦ]". rewrite /heap_ctx. iIntros {??} "[#Hinv HΦ]". rewrite /heap_ctx.
iPvs (auth_empty heap_name) as "Hheap". iPvs (auth_empty heap_name) as "Hheap".
iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto. iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
iFrame "Hinv Hheap". iIntros {h}. rewrite left_id. iFrame "Hinv Hheap". iIntros {h}. rewrite left_id.
iIntros "[% Hheap]". rewrite /heap_inv. iIntros "[% Hheap]". rewrite /heap_inv.
iApply wp_alloc_pst; first done. iFrame "Hheap". iNext. iApply wp_alloc_pst; first done. iFrame "Hheap". iNext.
iIntros {l} "[% Hheap]". iExists {[ l := (1%Qp, DecAgree v) ]}. iIntros {l} "[% Hheap]"; iPvsIntro; iExists {[ l := (1%Qp, DecAgree v) ]}.
rewrite -of_heap_insert -(insert_singleton_op h); last by apply of_heap_None. rewrite -of_heap_insert -(insert_singleton_op h); last by apply of_heap_None.
iFrame "Hheap". iSplit; first iPureIntro. iFrame "Hheap". iSplitR; first iPureIntro.
{ by apply alloc_unit_singleton_local_update; first apply of_heap_None. } { by apply alloc_unit_singleton_local_update; first apply of_heap_None. }
iIntros "Hheap". iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def. iIntros "Hheap". iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
Qed. Qed.
Lemma wp_load N E l q v Φ : Lemma wp_load N E l q v Φ :
nclose N E nclose N E
heap_ctx N l {q} v (l {q} v - Φ v) heap_ctx N l {q} v (l {q} v ={E}= Φ v)
WP Load (Lit (LitLoc l)) @ E {{ Φ }}. WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof. Proof.
iIntros {?} "[#Hh [Hl HΦ]]". iIntros {?} "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto. iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv. iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
iApply (wp_load_pst _ (<[l:=v]>(of_heap h)));first by rewrite lookup_insert. iApply (wp_load_pst _ (<[l:=v]>(of_heap h)));first by rewrite lookup_insert.
rewrite of_heap_singleton_op //. iFrame "Hl". rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iExists _; iSplit; first done. iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame. rewrite of_heap_singleton_op //. by iFrame.
Qed. Qed.
Lemma wp_store N E l v' e v Φ : Lemma wp_store N E l v' e v Φ :
to_val e = Some v nclose N E to_val e = Some v nclose N E
heap_ctx N l v' (l v - Φ (LitV LitUnit)) heap_ctx N l v' (l v ={E}= Φ (LitV LitUnit))
WP Store (Lit (LitLoc l)) e @ E {{ Φ }}. WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof. Proof.
iIntros {??} "[#Hh [Hl HΦ]]". iIntros {??} "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto. iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv. iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
iApply (wp_store_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //. iApply (wp_store_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl". rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iExists {[l := (1%Qp, DecAgree v)]}; iSplit. iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v)]}; iSplit.
{ iPureIntro; by apply singleton_local_update, exclusive_local_update. } { iPureIntro; by apply singleton_local_update, exclusive_local_update. }
rewrite of_heap_singleton_op //; eauto. by iFrame. rewrite of_heap_singleton_op //; eauto. by iFrame.
Qed. Qed.
Lemma wp_cas_fail N E l q v' e1 v1 e2 v2 Φ : Lemma wp_cas_fail N E l q v' e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 v' v1 nclose N E to_val e1 = Some v1 to_val e2 = Some v2 v' v1 nclose N E
heap_ctx N l {q} v' (l {q} v' - Φ (LitV (LitBool false))) heap_ctx N l {q} v' (l {q} v' ={E}= Φ (LitV (LitBool false)))
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
iIntros {????} "[#Hh [Hl HΦ]]". iIntros {????} "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10. iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10.
iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv. iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
iApply (wp_cas_fail_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //. iApply (wp_cas_fail_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite of_heap_singleton_op //. iFrame "Hl". rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iExists _; iSplit; first done. iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame. rewrite of_heap_singleton_op //. by iFrame.
Qed. Qed.
Lemma wp_cas_suc N E l e1 v1 e2 v2 Φ : Lemma wp_cas_suc N E l e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 nclose N E to_val e1 = Some v1 to_val e2 = Some v2 nclose N E
heap_ctx N l v1 (l v2 - Φ (LitV (LitBool true))) heap_ctx N l v1 (l v2 ={E}= Φ (LitV (LitBool true)))
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
iIntros {???} "[#Hh [Hl HΦ]]". iIntros {???} "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10. iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10.
iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv. iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
iApply (wp_cas_suc_pst _ (<[l:=v1]>(of_heap h))); rewrite ?lookup_insert //. iApply (wp_cas_suc_pst _ (<[l:=v1]>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl". rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iExists {[l := (1%Qp, DecAgree v2)]}; iSplit. iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v2)]}; iSplit.
{ iPureIntro; by apply singleton_local_update, exclusive_local_update. } { iPureIntro; by apply singleton_local_update, exclusive_local_update. }
rewrite of_heap_singleton_op //; eauto. by iFrame. rewrite of_heap_singleton_op //; eauto. by iFrame.
Qed. Qed.
......
...@@ -100,7 +100,7 @@ Lemma newbarrier_spec (P : iProp) (Φ : val → iProp) : ...@@ -100,7 +100,7 @@ Lemma newbarrier_spec (P : iProp) (Φ : val → iProp) :
WP newbarrier #() {{ Φ }}. WP newbarrier #() {{ Φ }}.
Proof. Proof.
iIntros {HN} "[#? HΦ]". iIntros {HN} "[#? HΦ]".
rewrite /newbarrier. wp_seq. iApply wp_pvs. wp_alloc l as "Hl". rewrite /newbarrier. wp_seq. wp_alloc l as "Hl".
iApply "HΦ". iApply "HΦ".
iPvs (saved_prop_alloc (F:=idCF) _ P) as {γ} "#?". iPvs (saved_prop_alloc (F:=idCF) _ P) as {γ} "#?".
iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]") iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]")
...@@ -127,7 +127,7 @@ Proof. ...@@ -127,7 +127,7 @@ Proof.
rewrite /signal /send /barrier_ctx. rewrite /signal /send /barrier_ctx.
iIntros "(Hs&HP&HΦ)"; iDestruct "Hs" as {γ} "[#(%&Hh&Hsts) Hγ]". wp_let. iIntros "(Hs&HP&HΦ)"; iDestruct "Hs" as {γ} "[#(%&Hh&Hsts) Hγ]". wp_let.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]". iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_store. destruct p; [|done]. wp_store. iPvsIntro. destruct p; [|done].
iExists (State High I), ( : set token). iExists (State High I), ( : set token).
iSplit; [iPureIntro; by eauto using signal_step|]. iSplit; [iPureIntro; by eauto using signal_step|].
iSplitR "HΦ"; [iNext|by auto]. iSplitR "HΦ"; [iNext|by auto].
...@@ -143,7 +143,7 @@ Proof. ...@@ -143,7 +143,7 @@ Proof.
iIntros "[Hr HΦ]"; iDestruct "Hr" as {γ P Q i} "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)". iIntros "[Hr HΦ]"; iDestruct "Hr" as {γ P Q i} "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iLöb as "IH". wp_rec. wp_focus (! _)%E. iLöb as "IH". wp_rec. wp_focus (! _)%E.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]". iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_load. destruct p. wp_load. iPvsIntro. destruct p.
- (* a Low state. The comparison fails, and we recurse. *) - (* a Low state. The comparison fails, and we recurse. *)
iExists (State Low I), {[ Change i ]}; iSplit; [done|iSplitL "Hl Hr"]. iExists (State Low I), {[ Change i ]}; iSplit; [done|iSplitL "Hl Hr"].
{ iNext. rewrite {2}/barrier_inv /=. by iFrame. } { iNext. rewrite {2}/barrier_inv /=. by iFrame. }
......
...@@ -51,7 +51,7 @@ Lemma newlock_spec N (R : iProp) Φ : ...@@ -51,7 +51,7 @@ Lemma newlock_spec N (R : iProp) Φ :
heap_ctx heapN R ( l, is_lock l R - Φ #l) WP newlock #() {{ Φ }}. heap_ctx heapN R ( l, is_lock l R - Φ #l) WP newlock #() {{ Φ }}.
Proof. Proof.
iIntros {?} "(#Hh & HR & HΦ)". rewrite /newlock. iIntros {?} "(#Hh & HR & HΦ)". rewrite /newlock.
wp_seq. iApply wp_pvs. wp_alloc l as "Hl". wp_seq. wp_alloc l as "Hl".
iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done. iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
iPvs (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?"; first done. iPvs (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?"; first done.
{ iIntros ">". iExists false. by iFrame. } { iIntros ">". iExists false. by iFrame. }
...@@ -64,10 +64,10 @@ Proof. ...@@ -64,10 +64,10 @@ Proof.
iIntros "[Hl HΦ]". iDestruct "Hl" as {N γ} "(%&#?&#?)". iIntros "[Hl HΦ]". iDestruct "Hl" as {N γ} "(%&#?&#?)".
iLöb as "IH". wp_rec. wp_focus (CAS _ _ _)%E. iLöb as "IH". wp_rec. wp_focus (CAS _ _ _)%E.
iInv N as { [] } "[Hl HR]". iInv N as { [] } "[Hl HR]".
- wp_cas_fail. iSplitL "Hl". - wp_cas_fail. iPvsIntro; iSplitL "Hl".
+ iNext. iExists true; eauto. + iNext. iExists true; eauto.
+ wp_if. by iApply "IH". + wp_if. by iApply "IH".
- wp_cas_suc. iDestruct "HR" as "[Hγ HR]". iSplitL "Hl". - wp_cas_suc. iPvsIntro. iDestruct "HR" as "[Hγ HR]". iSplitL "Hl".
+ iNext. iExists true; eauto. + iNext. iExists true; eauto.
+ wp_if. iApply ("HΦ" with "[-HR] HR"). iExists N, γ; eauto. + wp_if. iApply ("HΦ" with "[-HR] HR"). iExists N, γ; eauto.
Qed. Qed.
...@@ -77,6 +77,6 @@ Lemma release_spec R l (Φ : val → iProp) : ...@@ -77,6 +77,6 @@ Lemma release_spec R l (Φ : val → iProp) :
Proof. Proof.
iIntros "(Hl&HR&HΦ)"; iDestruct "Hl" as {N γ} "(% & #? & #? & Hγ)". iIntros "(Hl&HR&HΦ)"; iDestruct "Hl" as {N γ} "(% & #? & #? & Hγ)".
rewrite /release. wp_let. iInv N as {b} "[Hl _]". rewrite /release. wp_let. iInv N as {b} "[Hl _]".
wp_store. iFrame "HΦ". iNext. iExists false. by iFrame. wp_store. iPvsIntro. iFrame "HΦ". iNext. iExists false. by iFrame.
Qed. Qed.
End proof. End proof.
...@@ -27,7 +27,8 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp) e (f1 f2 : val) (Φ : val → iProp) : ...@@ -27,7 +27,8 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp) e (f1 f2 : val) (Φ : val → iProp) :
v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V) v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V)
WP par e {{ Φ }}. WP par e {{ Φ }}.
Proof. Proof.
iIntros {??} "(#Hh&Hf1&Hf2&HΦ)". rewrite /par. wp_value. wp_let. wp_proj. iIntros {??} "(#Hh&Hf1&Hf2&HΦ)".
rewrite /par. wp_value. iPvsIntro. wp_let. wp_proj.
wp_apply spawn_spec; try wp_done. iFrame "Hf1 Hh". wp_apply spawn_spec; try wp_done. iFrame "Hf1 Hh".
iIntros {l} "Hl". wp_let. wp_proj. wp_focus (f2 _). iIntros {l} "Hl". wp_let. wp_proj. wp_focus (f2 _).
iApply wp_wand_l; iFrame "Hf2"; iIntros {v} "H2". wp_let. iApply wp_wand_l; iFrame "Hf2"; iIntros {v} "H2". wp_let.
......
...@@ -23,8 +23,7 @@ Class spawnG Σ := SpawnG { ...@@ -23,8 +23,7 @@ Class spawnG Σ := SpawnG {
(** The functor we need. *) (** The functor we need. *)
Definition spawnGF : gFunctorList := [GFunctor (constRF (exclR unitC))]. Definition spawnGF : gFunctorList := [GFunctor (constRF (exclR unitC))].
(* Show and register that they match. *) (* Show and register that they match. *)
Instance inGF_spawnG Instance inGF_spawnG `{H : inGFs heap_lang Σ spawnGF} : spawnG Σ.
`{H : inGFs heap_lang Σ spawnGF} : spawnG Σ.
Proof. destruct H as (?&?). split. apply: inGF_inG. Qed. Proof. destruct H as (?&?). split. apply: inGF_inG. Qed.
(** Now we come to the Iris part of the proof. *) (** Now we come to the Iris part of the proof. *)
...@@ -63,10 +62,10 @@ Proof. ...@@ -63,10 +62,10 @@ Proof.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done. iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done.
{ iNext. iExists (InjLV #0). iFrame; eauto. } { iNext. iExists (InjLV #0). iFrame; eauto. }
wp_apply wp_fork. iSplitR "Hf". wp_apply wp_fork. iSplitR "Hf".
- wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle. eauto. - iPvsIntro. wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle. eauto.
- wp_focus (f _). iApply wp_wand_l; iFrame "Hf"; iIntros {v} "Hv". - wp_focus (f _). iApply wp_wand_l; iFrame "Hf"; iIntros {v} "Hv".
iInv N as {v'} "[Hl _]"; first wp_done. iInv N as {v'} "[Hl _]"; first wp_done.
wp_store. iSplit; [iNext|done]. wp_store. iPvsIntro; iSplit; [iNext|done].
iExists (InjRV v); iFrame; eauto. iExists (InjRV v); iFrame; eauto.
Qed. Qed.
...@@ -76,10 +75,10 @@ Proof. ...@@ -76,10 +75,10 @@ Proof.
rewrite /join_handle; iIntros "[[% H] Hv]"; iDestruct "H" as {γ} "(#?&Hγ&#?)". rewrite /join_handle; iIntros "[[% H] Hv]"; iDestruct "H" as {γ} "(#?&Hγ&#?)".
iLöb as "IH". wp_rec. wp_focus (! _)%E. iInv N as {v} "[Hl Hinv]". iLöb as "IH". wp_rec. wp_focus (! _)%E. iInv N as {v} "[Hl Hinv]".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst. wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- iSplitL "Hl"; [iNext; iExists _; iFrame; eauto|]. - iPvsIntro; iSplitL "Hl"; [iNext; iExists _; iFrame; eauto|].
wp_match. iApply ("IH" with "Hγ Hv"). wp_match. iApply ("IH" with "Hγ Hv").
- iDestruct "Hinv" as {v'} "[% [HΨ|Hγ']]"; simplify_eq/=. - iDestruct "Hinv" as {v'} "[% [HΨ|Hγ']]"; simplify_eq/=.
+ iSplitL "Hl Hγ". + iPvsIntro; iSplitL "Hl Hγ".
{ iNext. iExists _; iFrame; eauto. } { iNext. iExists _; iFrame; eauto. }
wp_match. by iApply "Hv". wp_match. by iApply "Hv".
+ iCombine "Hγ" "Hγ'" as "Hγ". iDestruct (own_valid with "Hγ") as %[]. + iCombine "Hγ" "Hγ'" as "Hγ". iDestruct (own_valid with "Hγ") as %[].
......
...@@ -25,7 +25,7 @@ Proof. exact: weakestpre.wp_bind. Qed. ...@@ -25,7 +25,7 @@ Proof. exact: weakestpre.wp_bind. Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *) (** Base axioms for core primitives of the language: Stateful reductions. *)
Lemma wp_alloc_pst E σ e v Φ : Lemma wp_alloc_pst E σ e v Φ :
to_val e = Some v to_val e = Some v
( ownP σ ( l, σ !! l = None ownP (<[l:=v]>σ) - Φ (LitV (LitLoc l)))) ownP σ ( l, σ !! l = None ownP (<[l:=v]>σ) ={E}= Φ (LitV (LitLoc l)))
WP Alloc e @ E {{ Φ }}. WP Alloc e @ E {{ Φ }}.
Proof. Proof.
iIntros {?} "[HP HΦ]". iIntros {?} "[HP HΦ]".
...@@ -41,7 +41,7 @@ Qed. ...@@ -41,7 +41,7 @@ Qed.
Lemma wp_load_pst E σ l v Φ : Lemma wp_load_pst E σ l v Φ :
σ !! l = Some v σ !! l = Some v
( ownP σ (ownP σ - Φ v)) WP Load (Lit (LitLoc l)) @ E {{ Φ }}. ownP σ (ownP σ ={E}= Φ v) WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step σ v σ None) ?right_id //; intros. rewrite -(wp_lift_atomic_det_head_step σ v σ None) ?right_id //;
last (by intros; inv_head_step; eauto using to_of_val); simpl; by eauto. last (by intros; inv_head_step; eauto using to_of_val); simpl; by eauto.
...@@ -49,7 +49,7 @@ Qed. ...@@ -49,7 +49,7 @@ Qed.
Lemma wp_store_pst E σ l e v v' Φ : Lemma wp_store_pst E σ l e v v' Φ :
to_val e = Some v σ !! l = Some v' to_val e = Some v σ !! l = Some v'
( ownP σ (ownP (<[l:=v]>σ) - Φ (LitV LitUnit))) ownP σ (ownP (<[l:=v]>σ) ={E}= Φ (LitV LitUnit))
WP Store (Lit (LitLoc l)) e @ E {{ Φ }}. WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof. Proof.
intros. rewrite-(wp_lift_atomic_det_head_step σ (LitV LitUnit) (<[l:=v]>σ) None) intros. rewrite-(wp_lift_atomic_det_head_step σ (LitV LitUnit) (<[l:=v]>σ) None)
...@@ -58,7 +58,7 @@ Qed. ...@@ -58,7 +58,7 @@ Qed.
Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ : Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ :
to_val e1 = Some v1 to_val e2 = Some v2 σ !! l = Some v' v' v1 to_val e1 = Some v1 to_val e2 = Some v2 σ !! l = Some v' v' v1
( ownP σ (ownP σ - Φ (LitV $ LitBool false))) ownP σ (ownP σ ={E}= Φ (LitV $ LitBool false))
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool false) σ None) intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool false) σ None)
...@@ -68,7 +68,7 @@ Qed. ...@@ -68,7 +68,7 @@ Qed.
Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 σ !! l = Some v1 to_val e1 = Some v1 to_val e2 = Some v2 σ !! l = Some v1
( ownP σ (ownP (<[l:=v2]>σ) - Φ (LitV $ LitBool true))) ownP σ (ownP (<[l:=v2]>σ) ={E}= Φ (LitV $ LitBool true))
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool true) intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool true)
...@@ -78,18 +78,17 @@ Qed. ...@@ -78,18 +78,17 @@ Qed.
(** Base axioms for core primitives of the language: Stateless reductions *) (** Base axioms for core primitives of the language: Stateless reductions *)
Lemma wp_fork E e Φ : Lemma wp_fork E e Φ :
( Φ (LitV LitUnit) WP e {{ _, True }}) WP Fork e @ E {{ Φ }}. (|={E}=> Φ (LitV LitUnit)) WP e {{ _, True }} WP Fork e @ E {{ Φ }}.
Proof. Proof.
rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) (Some e)) //=; rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) (Some e)) //=;
last by intros; inv_head_step; eauto. last by intros; inv_head_step; eauto.
rewrite later_sep -(wp_value _ _ (Lit _)) //. rewrite later_sep -(wp_value_pvs _ _ (Lit _)) //.
Qed. Qed.
Lemma wp_rec E f x erec e1 e2 v2 Φ : Lemma wp_rec E f x erec e1 e2 v2 Φ :
e1 = Rec f x erec e1 = Rec f x erec
to_val e2 = Some v2 to_val e2 = Some v2
WP subst' x e2 (subst' f e1 erec) @ E {{ Φ }} WP subst' x e2 (subst' f e1 erec) @ E {{ Φ }} WP App e1 e2 @ E {{ Φ }}.
WP App e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros -> ?. rewrite -(wp_lift_pure_det_head_step (App _ _) intros -> ?. rewrite -(wp_lift_pure_det_head_step (App _ _)
(subst' x e2 (subst' f (Rec f x erec) erec)) None) //= ?right_id; (subst' x e2 (subst' f (Rec f x erec) erec)) None) //= ?right_id;
...@@ -98,18 +97,18 @@ Qed. ...@@ -98,18 +97,18 @@ Qed.
Lemma wp_un_op E op l l' Φ : Lemma wp_un_op E op l l' Φ :
un_op_eval op l = Some l' un_op_eval op l = Some l'
Φ (LitV l') WP UnOp op (Lit l) @ E {{ Φ }}. (|={E}=> Φ (LitV l')) WP UnOp op (Lit l) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (UnOp op _) (Lit l') None) intros. rewrite -(wp_lift_pure_det_head_step (UnOp op _) (Lit l') None)
?right_id -?wp_value //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_bin_op E op l1 l2 l' Φ : Lemma wp_bin_op E op l1 l2 l' Φ :
bin_op_eval op l1 l2 = Some l' bin_op_eval op l1 l2 = Some l'
Φ (LitV l') WP BinOp op (Lit l1) (Lit l2) @ E {{ Φ }}. (|={E}=> Φ (LitV l')) WP BinOp op (Lit l1) (Lit l2) @ E {{ Φ }}.
Proof. Proof.
intros Heval. rewrite -(wp_lift_pure_det_head_step (BinOp op _ _) (Lit l') None) intros Heval. rewrite -(wp_lift_pure_det_head_step (BinOp op _ _) (Lit l') None)
?right_id -?wp_value //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_if_true E e1 e2 Φ : Lemma wp_if_true E e1 e2 Φ :
...@@ -128,18 +127,18 @@ Qed. ...@@ -128,18 +127,18 @@ Qed.
Lemma wp_fst E e1 v1 e2 v2 Φ : Lemma wp_fst E e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
Φ v1 WP Fst (Pair e1 e2) @ E {{ Φ }}. (|={E}=> Φ v1) WP Fst (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None) intros. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None)
?right_id -?wp_value //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_snd E e1 v1 e2 v2 Φ : Lemma wp_snd E e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
Φ v2 WP Snd (Pair e1 e2) @ E {{ Φ }}. (|={E}=> Φ v2) WP Snd (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None) intros. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None)
?right_id -?wp_value //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_case_inl E e0 v0 e1 e2 Φ : Lemma wp_case_inl E e0 v0 e1 e2 Φ :
......
...@@ -22,7 +22,7 @@ Lemma tac_wp_alloc Δ Δ' N E j e v Φ : ...@@ -22,7 +22,7 @@ Lemma tac_wp_alloc Δ Δ' N E j e v Φ :
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
( l, Δ'', ( l, Δ'',
envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ'' envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ''