Commit b72a3301 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

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

parents 5cbe3c8e f6355c05
......@@ -10,8 +10,10 @@ Coq development, but not every API-breaking change is listed. Changes marked
backwards compatibility and will be removed in a future version of Iris.
* View shifts are radically simplified to just internalize frame-preserving
updates. Weakestpre is defined inside the logic, and invariants and view
shifts with masks are also coded up inside Iris. Adequacy of weakestpre
is proven in the logic.
shifts with masks are also coded up inside Iris. Adequacy of weakestpre is
proven in the logic. [#] The old ownership of the entire physical state is
replaced by a user-selected predicate over physical state that is maintained
by weakestpre.
* Use OFEs instead of COFEs everywhere. COFEs are only used for solving the
recursive domain equation. As a consequence, CMRAs no longer need a proof
of completeness.
......
......@@ -92,13 +92,13 @@ program_logic/language.v
program_logic/ectx_language.v
program_logic/ectxi_language.v
program_logic/ectx_lifting.v
program_logic/gen_heap.v
program_logic/ownp.v
heap_lang/lang.v
heap_lang/tactics.v
heap_lang/wp_tactics.v
heap_lang/lifting.v
heap_lang/derived.v
heap_lang/rules.v
heap_lang/notation.v
heap_lang/heap.v
heap_lang/lib/spawn.v
heap_lang/lib/par.v
heap_lang/lib/assert.v
......
......@@ -275,7 +275,7 @@ Lemma auth_map_ext {A B : ofeT} (f g : A → B) x :
( x, f x g x) auth_map f x auth_map g x.
Proof.
constructor; simpl; auto.
apply option_fmap_setoid_ext=> a; by apply excl_map_ext.
apply option_fmap_equiv_ext=> a; by apply excl_map_ext.
Qed.
Instance auth_map_ne {A B : ofeT} n :
Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@auth_map A B).
......
......@@ -1250,11 +1250,11 @@ Next Obligation.
Qed.
Next Obligation.
intros F A B x. rewrite /= -{2}(option_fmap_id x).
apply option_fmap_setoid_ext=>y; apply rFunctor_id.
apply option_fmap_equiv_ext=>y; apply rFunctor_id.
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -option_fmap_compose.
apply option_fmap_setoid_ext=>y; apply rFunctor_compose.
apply option_fmap_equiv_ext=>y; apply rFunctor_compose.
Qed.
Instance optionURF_contractive F :
......
......@@ -475,11 +475,11 @@ Next Obligation.
Qed.
Next Obligation.
intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
apply map_fmap_setoid_ext=>y ??; apply cFunctor_id.
apply map_fmap_equiv_ext=>y ??; apply cFunctor_id.
Qed.
Next Obligation.
intros K ?? F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -map_fmap_compose.
apply map_fmap_setoid_ext=>y ??; apply cFunctor_compose.
apply map_fmap_equiv_ext=>y ??; apply cFunctor_compose.
Qed.
Instance gmapCF_contractive K `{Countable K} F :
cFunctorContractive F cFunctorContractive (gmapCF K F).
......@@ -496,11 +496,11 @@ Next Obligation.
Qed.
Next Obligation.
intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
apply map_fmap_setoid_ext=>y ??; apply rFunctor_id.
apply map_fmap_equiv_ext=>y ??; apply rFunctor_id.
Qed.
Next Obligation.
intros K ?? F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -map_fmap_compose.
apply map_fmap_setoid_ext=>y ??; apply rFunctor_compose.
apply map_fmap_equiv_ext=>y ??; apply rFunctor_compose.
Qed.
Instance gmapRF_contractive K `{Countable K} F :
rFunctorContractive F urFunctorContractive (gmapURF K F).
......
......@@ -108,11 +108,11 @@ Next Obligation.
Qed.
Next Obligation.
intros F A B x. rewrite /= -{2}(list_fmap_id x).
apply list_fmap_setoid_ext=>y. apply cFunctor_id.
apply list_fmap_equiv_ext=>y. apply cFunctor_id.
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -list_fmap_compose.
apply list_fmap_setoid_ext=>y; apply cFunctor_compose.
apply list_fmap_equiv_ext=>y; apply cFunctor_compose.
Qed.
Instance listCF_contractive F :
......@@ -452,11 +452,11 @@ Next Obligation.
Qed.
Next Obligation.
intros F A B x. rewrite /= -{2}(list_fmap_id x).
apply list_fmap_setoid_ext=>y. apply urFunctor_id.
apply list_fmap_equiv_ext=>y. apply urFunctor_id.
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -list_fmap_compose.
apply list_fmap_setoid_ext=>y; apply urFunctor_compose.
apply list_fmap_equiv_ext=>y; apply urFunctor_compose.
Qed.
Instance listURF_contractive F :
......
......@@ -820,11 +820,11 @@ Next Obligation.
Qed.
Next Obligation.
intros F A B x. rewrite /= -{2}(option_fmap_id x).
apply option_fmap_setoid_ext=>y; apply cFunctor_id.
apply option_fmap_equiv_ext=>y; apply cFunctor_id.
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -option_fmap_compose.
apply option_fmap_setoid_ext=>y; apply cFunctor_compose.
apply option_fmap_equiv_ext=>y; apply cFunctor_compose.
Qed.
Instance optionCF_contractive F :
......
......@@ -37,11 +37,14 @@ Section proofs.
AsFractional (cinv_own γ q) (cinv_own γ) q.
Proof. done. Qed.
Lemma cinv_own_valid γ q1 q2 : cinv_own γ q1 cinv_own γ q2 (q1 + q2)%Qp.
Proof. rewrite /cinv_own -own_op own_valid. by iIntros "% !%". Qed.
Lemma cinv_own_valid γ q1 q2 : cinv_own γ q1 - cinv_own γ q2 - (q1 + q2)%Qp.
Proof. apply (own_valid_2 γ q1 q2). Qed.
Lemma cinv_own_1_l γ q : cinv_own γ 1 cinv_own γ q False.
Proof. rewrite cinv_own_valid. by iIntros (?%(exclusive_l 1%Qp)). Qed.
Lemma cinv_own_1_l γ q : cinv_own γ 1 - cinv_own γ q - False.
Proof.
iIntros "H1 H2".
iDestruct (cinv_own_valid with "H1 H2") as %[]%(exclusive_l 1%Qp).
Qed.
Lemma cinv_alloc E N P : P ={E}= γ, cinv N γ P cinv_own γ 1.
Proof.
......@@ -54,7 +57,7 @@ Section proofs.
Proof.
rewrite /cinv. iIntros (?) "#Hinv Hγ".
iInv N as "[$|>Hγ']" "Hclose"; first iApply "Hclose"; eauto.
iDestruct (cinv_own_1_l with "[$Hγ $Hγ']") as %[].
iDestruct (cinv_own_1_l with "Hγ Hγ'") as %[].
Qed.
Lemma cinv_open E N γ p P :
......@@ -62,8 +65,8 @@ Section proofs.
cinv N γ P - cinv_own γ p ={E,E∖↑N}= P cinv_own γ p ( P ={E∖↑N,E}= True).
Proof.
rewrite /cinv. iIntros (?) "#Hinv Hγ".
iInv N as "[$|>Hγ']" "Hclose".
iInv N as "[$ | >Hγ']" "Hclose".
- iIntros "!> {$Hγ} HP". iApply "Hclose"; eauto.
- iDestruct (cinv_own_1_l with "[$Hγ $Hγ']") as %[].
- iDestruct (cinv_own_1_l with "Hγ' Hγ") as %[].
Qed.
End proofs.
From iris.program_logic Require Export weakestpre adequacy.
From iris.heap_lang Require Export heap.
From iris.program_logic Require Export weakestpre adequacy gen_heap.
From iris.heap_lang Require Export rules.
From iris.algebra Require Import auth.
From iris.base_logic.lib Require Import wsat auth.
From iris.heap_lang Require Import proofmode notation.
From iris.proofmode Require Import tactics.
Class heapPreG Σ := HeapPreG {
heap_preG_iris :> irisPreG heap_lang Σ;
heap_preG_heap :> authG Σ heapUR
heap_preG_iris :> invPreG Σ;
heap_preG_heap :> gen_heapPreG loc val Σ
}.
Definition heapΣ : gFunctors :=
#[irisΣ state; authΣ heapUR].
Definition heapΣ : gFunctors := #[invΣ; gen_heapΣ loc val].
Instance subG_heapPreG {Σ} : subG heapΣ Σ heapPreG Σ.
Proof. intros [? ?]%subG_inv. split; apply _. Qed.
Proof. intros [? ?]%subG_inv; split; apply _. Qed.
Definition heap_adequacy Σ `{heapPreG Σ} e σ φ :
( `{heapG Σ}, heap_ctx WP e {{ v, ⌜φ v }})
( `{heapG Σ}, True WP e {{ v, ⌜φ v }})
adequate e σ φ.
Proof.
intros Hwp; eapply (wp_adequacy Σ); iIntros (?) "Hσ".
iMod (auth_alloc to_heap _ heapN _ σ with "[Hσ]") as (γ) "[Hh _]";[|by iNext|].
{ exact: to_heap_valid. }
set (Hheap := HeapG _ _ _ γ).
iApply (Hwp _). by rewrite /heap_ctx.
intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "".
iMod (own_alloc ( to_gen_heap σ)) as (γ) "Hh".
{ apply: auth_auth_valid. exact: to_gen_heap_valid. }
iModIntro. iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
set (Hheap := GenHeapG loc val Σ _ _ _ _ γ).
iApply (Hwp (HeapG _ _ _)).
Qed.
From iris.heap_lang Require Export lifting.
Import uPred.
(** Define some derived forms, and derived lemmas about them. *)
Notation Lam x e := (Rec BAnon x e).
Notation Let x e1 e2 := (App (Lam x e2) e1).
Notation Seq e1 e2 := (Let BAnon e1 e2).
Notation LamV x e := (RecV BAnon x e).
Notation LetCtx x e2 := (AppRCtx (LamV x e2)).
Notation SeqCtx e2 := (LetCtx BAnon e2).
Notation Skip := (Seq (Lit LitUnit) (Lit LitUnit)).
Notation Match e0 x1 e1 x2 e2 := (Case e0 (Lam x1 e1) (Lam x2 e2)).
Section derived.
Context `{irisG heap_lang Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
(** Proof rules for the sugar *)
Lemma wp_lam E x elam e1 e2 Φ :
e1 = Lam x elam
is_Some (to_val e2)
Closed (x :b: []) elam
WP subst' x e2 elam @ E {{ Φ }} WP App e1 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -(wp_rec _ BAnon) //. Qed.
Lemma wp_let E x e1 e2 Φ :
is_Some (to_val e1) Closed (x :b: []) e2
WP subst' x e1 e2 @ E {{ Φ }} WP Let x e1 e2 @ E {{ Φ }}.
Proof. by apply wp_lam. Qed.
Lemma wp_seq E e1 e2 Φ :
is_Some (to_val e1) Closed [] e2
WP e2 @ E {{ Φ }} WP Seq e1 e2 @ E {{ Φ }}.
Proof. intros ??. by rewrite -wp_let. Qed.
Lemma wp_skip E Φ : Φ (LitV LitUnit) WP Skip @ E {{ Φ }}.
Proof. rewrite -wp_seq; last eauto. by rewrite -wp_value. Qed.
Lemma wp_match_inl E e0 x1 e1 x2 e2 Φ :
is_Some (to_val e0) Closed (x1 :b: []) e1
WP subst' x1 e0 e1 @ E {{ Φ }} WP Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inl // -[X in _ X]later_intro -wp_let. Qed.
Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
is_Some (to_val e0) Closed (x2 :b: []) e2
WP subst' x2 e0 e2 @ E {{ Φ }} WP Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed.
Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P Φ (LitV (LitBool true)))
(n2 < n1 P Φ (LitV (LitBool false)))
P WP BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof.
intros. rewrite -wp_bin_op //; [].
destruct (bool_decide_reflect (n1 n2)); by eauto with omega.
Qed.
Lemma wp_lt E (n1 n2 : Z) P Φ :
(n1 < n2 P Φ (LitV (LitBool true)))
(n2 n1 P Φ (LitV (LitBool false)))
P WP BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof.
intros. rewrite -wp_bin_op //; [].
destruct (bool_decide_reflect (n1 < n2)); by eauto with omega.
Qed.
Lemma wp_eq E e1 e2 v1 v2 P Φ :
to_val e1 = Some v1 to_val e2 = Some v2
(v1 = v2 P Φ (LitV (LitBool true)))
(v1 v2 P Φ (LitV (LitBool false)))
P WP BinOp EqOp e1 e2 @ E {{ Φ }}.
Proof.
intros. rewrite -wp_bin_op //; [].
destruct (bool_decide_reflect (v1 = v2)); by eauto.
Qed.
End derived.
From iris.heap_lang Require Export lifting.
From iris.algebra Require Import auth gmap frac dec_agree.
From iris.base_logic.lib Require Export invariants.
From iris.base_logic.lib Require Import wsat auth fractional.
From iris.proofmode Require Import tactics.
Import uPred.
(* TODO: The entire construction could be generalized to arbitrary languages that have
a finmap as their state. Or maybe even beyond "as their state", i.e. arbitrary
predicates over finmaps instead of just ownP. *)
Definition heapN : namespace := nroot .@ "heap".
Definition heapUR : ucmraT := gmapUR loc (prodR fracR (dec_agreeR val)).
(** The CMRA we need. *)
Class heapG Σ := HeapG {
heapG_iris_inG :> irisG heap_lang Σ;
heap_inG :> authG Σ heapUR;
heap_name : gname
}.
Definition to_heap : state heapUR := fmap (λ v, (1%Qp, DecAgree v)).
Section definitions.
Context `{heapG Σ}.
Definition heap_mapsto_def (l : loc) (q : Qp) (v: val) : iProp Σ :=
auth_own heap_name ({[ l := (q, DecAgree v) ]}).
Definition heap_mapsto_aux : { x | x = @heap_mapsto_def }. by eexists. Qed.
Definition heap_mapsto := proj1_sig heap_mapsto_aux.
Definition heap_mapsto_eq : @heap_mapsto = @heap_mapsto_def :=
proj2_sig heap_mapsto_aux.
Definition heap_ctx : iProp Σ := auth_ctx heap_name heapN to_heap ownP.
End definitions.
Typeclasses Opaque heap_ctx heap_mapsto.
Notation "l ↦{ q } v" := (heap_mapsto l q v)
(at level 20, q at level 50, format "l ↦{ q } v") : uPred_scope.
Notation "l ↦ v" := (heap_mapsto l 1 v) (at level 20) : uPred_scope.
Notation "l ↦{ q } -" := ( v, l {q} v)%I
(at level 20, q at level 50, format "l ↦{ q } -") : uPred_scope.
Notation "l ↦ -" := (l {1} -)%I (at level 20) : uPred_scope.
Section heap.
Context {Σ : gFunctors}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
Implicit Types σ : state.
Implicit Types h g : heapUR.
(** Conversion to heaps and back *)
Lemma to_heap_valid σ : to_heap σ.
Proof. intros l. rewrite lookup_fmap. by case (σ !! l). Qed.
Lemma lookup_to_heap_None σ l : σ !! l = None to_heap σ !! l = None.
Proof. by rewrite /to_heap lookup_fmap=> ->. Qed.
Lemma heap_singleton_included σ l q v :
{[l := (q, DecAgree v)]} to_heap σ σ !! l = Some v.
Proof.
rewrite singleton_included=> -[[q' av] [/leibniz_equiv_iff Hl Hqv]].
move: Hl. rewrite /to_heap lookup_fmap fmap_Some=> -[v' [Hl [??]]]; subst.
by move: Hqv=> /Some_pair_included_total_2 [_ /DecAgree_included ->].
Qed.
Lemma heap_singleton_included' σ l q v :
{[l := (q, DecAgree v)]} to_heap σ to_heap σ !! l = Some (1%Qp,DecAgree v).
Proof.
intros Hl%heap_singleton_included. by rewrite /to_heap lookup_fmap Hl.
Qed.
Lemma to_heap_insert l v σ :
to_heap (<[l:=v]> σ) = <[l:=(1%Qp, DecAgree v)]> (to_heap σ).
Proof. by rewrite /to_heap fmap_insert. Qed.
Context `{heapG Σ}.
(** General properties of mapsto *)
Global Instance heap_ctx_persistent : PersistentP heap_ctx.
Proof. rewrite /heap_ctx. apply _. Qed.
Global Instance heap_mapsto_timeless l q v : TimelessP (l {q} v).
Proof. rewrite heap_mapsto_eq /heap_mapsto_def. apply _. Qed.
Global Instance heap_mapsto_fractional l v : Fractional (λ q, l {q} v)%I.
Proof.
unfold Fractional; intros.
by rewrite heap_mapsto_eq -auth_own_op op_singleton pair_op dec_agree_idemp.
Qed.
Global Instance heap_mapsto_as_fractional l q v :
AsFractional (l {q} v) (λ q, l {q} v)%I q.
Proof. done. Qed.
Lemma heap_mapsto_agree l q1 q2 v1 v2 :
l {q1} v1 l {q2} v2 v1 = v2.
Proof.
rewrite heap_mapsto_eq -auth_own_op auth_own_valid discrete_valid
op_singleton singleton_valid.
f_equiv. move=>[_ ] /=.
destruct (decide (v1 = v2)) as [->|?]; first done. by rewrite dec_agree_ne.
Qed.
Global Instance heap_ex_mapsto_fractional l : Fractional (λ q, l {q} -)%I.
Proof.
intros p q. iSplit.
- iDestruct 1 as (v) "[H1 H2]". iSplitL "H1"; eauto.
- iIntros "[H1 H2]". iDestruct "H1" as (v1) "H1". iDestruct "H2" as (v2) "H2".
iDestruct (heap_mapsto_agree with "[$H1 $H2]") as %->. iExists v2. by iFrame.
Qed.
Global Instance heap_ex_mapsto_as_fractional l q :
AsFractional (l {q} -) (λ q, l {q} -)%I q.
Proof. done. Qed.
Lemma heap_mapsto_valid l q v : l {q} v q.
Proof.
rewrite heap_mapsto_eq /heap_mapsto_def auth_own_valid !discrete_valid.
by apply pure_mono=> /singleton_valid [??].
Qed.
Lemma heap_mapsto_valid_2 l q1 q2 v1 v2 :
l {q1} v1 l {q2} v2 (q1 + q2)%Qp.
Proof.
iIntros "[H1 H2]". iDestruct (heap_mapsto_agree with "[$H1 $H2]") as %->.
iApply (heap_mapsto_valid l _ v2). by iFrame.
Qed.
(** Weakest precondition *)
Lemma wp_alloc E e v :
to_val e = Some v heapN E
{{{ heap_ctx }}} Alloc e @ E {{{ l, RET LitV (LitLoc l); l v }}}.
Proof.
iIntros (<-%of_to_val ? Φ) "#Hinv HΦ". rewrite /heap_ctx.
iMod (auth_empty heap_name) as "Ha".
iMod (auth_open with "[$Hinv $Ha]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_alloc_pst with "Hσ"). iNext. iIntros (l) "[% Hσ]".
iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert.
eapply alloc_singleton_local_update; by auto using lookup_to_heap_None. }
iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
Qed.
Lemma wp_load E l q v :
heapN E
{{{ heap_ctx l {q} v }}} Load (Lit (LitLoc l)) @ E
{{{ RET v; l {q} v }}}.
Proof.
iIntros (? Φ) "[#Hinv >Hl] HΦ".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_load_pst _ σ with "Hσ"); first eauto using heap_singleton_included.
iNext; iIntros "Hσ".
iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ".
Qed.
Lemma wp_store E l v' e v :
to_val e = Some v heapN E
{{{ heap_ctx l v' }}} Store (Lit (LitLoc l)) e @ E
{{{ RET LitV LitUnit; l v }}}.
Proof.
iIntros (<-%of_to_val ? Φ) "[#Hinv >Hl] HΦ".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_store_pst _ σ with "Hσ"); first eauto using heap_singleton_included.
iNext; iIntros "Hσ". iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert.
eapply singleton_local_update, exclusive_local_update; last done.
by eapply heap_singleton_included'. }
by iApply "HΦ".
Qed.
Lemma wp_cas_fail E l q v' e1 v1 e2 v2 :
to_val e1 = Some v1 to_val e2 = Some v2 v' v1 heapN E
{{{ heap_ctx l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{ RET LitV (LitBool false); l {q} v' }}}.
Proof.
iIntros (<-%of_to_val <-%of_to_val ?? Φ) "[#Hinv >Hl] HΦ".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_cas_fail_pst _ σ with "Hσ"); [eauto using heap_singleton_included|done|].
iNext; iIntros "Hσ".
iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ".
Qed.
Lemma wp_cas_suc E l e1 v1 e2 v2 :
to_val e1 = Some v1 to_val e2 = Some v2 heapN E
{{{ heap_ctx l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{ RET LitV (LitBool true); l v2 }}}.
Proof.
iIntros (<-%of_to_val <-%of_to_val ? Φ) "[#Hinv >Hl] HΦ".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_cas_suc_pst _ σ with "Hσ"); first by eauto using heap_singleton_included.
iNext. iIntros "Hσ". iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert.
eapply singleton_local_update, exclusive_local_update; last done.
by eapply heap_singleton_included'. }
by iApply "HΦ".
Qed.
End heap.
......@@ -402,3 +402,13 @@ Canonical Structure heap_lang := ectx_lang (heap_lang.expr).
(* Prefer heap_lang names over ectx_language names. *)
Export heap_lang.
(** Define some derived forms *)
Notation Lam x e := (Rec BAnon x e).
Notation Let x e1 e2 := (App (Lam x e2) e1).
Notation Seq e1 e2 := (Let BAnon e1 e2).
Notation LamV x e := (RecV BAnon x e).
Notation LetCtx x e2 := (AppRCtx (LamV x e2)).
Notation SeqCtx e2 := (LetCtx BAnon e2).
Notation Skip := (Seq (Lit LitUnit) (Lit LitUnit)).
Notation Match e0 x1 e1 x2 e2 := (Case e0 (Lam x1 e1) (Lam x2 e2)).
......@@ -9,7 +9,7 @@ Definition assert : val :=
Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope.
Lemma wp_assert `{heapG Σ} E (Φ : val iProp Σ) e `{!Closed [] e} :
WP e @ E {{ v, v = #true Φ #() }} WP assert: e @ E {{ Φ }}.
WP e @ E {{ v, v = #true Φ #() }} - WP assert: e @ E {{ Φ }}.
Proof.
iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
iApply (wp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if.
......
......@@ -38,7 +38,7 @@ Definition barrier_inv (l : loc) (P : iProp Σ) (s : state) : iProp Σ :=
(l s ress (state_to_prop s P) (state_I s))%I.
Definition barrier_ctx (γ : gname) (l : loc) (P : iProp Σ) : iProp Σ :=
(heapN N heap_ctx sts_ctx γ N (barrier_inv l P))%I.
sts_ctx γ N (barrier_inv l P).
Definition send (l : loc) (P : iProp Σ) : iProp Σ :=
( γ, barrier_ctx γ l P sts_ownS γ low_states {[ Send ]})%I.
......@@ -73,11 +73,11 @@ Proof. solve_proper. Qed.
(** Helper lemmas *)
Lemma ress_split i i1 i2 Q R1 R2 P I :
i I i1 I i2 I i1 i2
saved_prop_own i Q saved_prop_own i1 R1 saved_prop_own i2 R2
(Q - R1 R2) ress P I
ress P ({[i1;i2]} I {[i]}).
saved_prop_own i Q - saved_prop_own i1 R1 - saved_prop_own i2 R2 -
(Q - R1 R2) - ress P I -
ress P ({[i1;i2]} I {[i]}).
Proof.
iIntros (????) "(#HQ&#H1&#H2&HQR&H)"; iDestruct "H" as (Ψ) "[HPΨ HΨ]".
iIntros (????) "#HQ #H1 #H2 HQR"; iDestruct 1 as (Ψ) "[HPΨ HΨ]".
iDestruct (big_sepS_delete _ _ i with "HΨ") as "[#HΨi HΨ]"; first done.
iExists (<[i1:=R1]> (<[i2:=R2]> Ψ)). iSplitL "HQR HPΨ".
- iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by iSplit.
......@@ -91,10 +91,9 @@ Qed.
(** Actual proofs *)
Lemma newbarrier_spec (P : iProp Σ) :
heapN N
{{{ heap_ctx }}} newbarrier #() {{{ l, RET #l; recv l P send l P }}}.
{{{ True }}} newbarrier #() {{{ l, RET #l; recv l P send l P }}}.
Proof.
iIntros (HN Φ) "#? HΦ".
iIntros (Φ) "HΦ".
rewrite -wp_fupd /newbarrier /=. wp_seq. wp_alloc l as "Hl".
iApply ("HΦ" with ">[-]").
iMod (saved_prop_alloc (F:=idCF) P) as (γ) "#?".
......@@ -120,7 +119,7 @@ Lemma signal_spec l P :
{{{ send l P P }}} signal #l {{{ RET #(); True }}}.
Proof.
rewrite /signal /send /barrier_ctx /=.
iIntros (Φ) "(Hs&HP) HΦ"; iDestruct "Hs" as (γ) "[#(%&Hh&Hsts) Hγ]". wp_let.
iIntros (Φ) "[Hs HP] HΦ". iDestruct "Hs" as (γ) "[#Hsts Hγ]". wp_let.
iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
destruct p; [|done]. wp_store.
......@@ -136,7 +135,7 @@ Lemma wait_spec l P:
{{{ recv l P }}} wait #l {{{ RET #(); P }}}.
Proof.
rename P into