Commit 2c6727dc authored by Robbert Krebbers's avatar Robbert Krebbers

Use Φ and Ψ for (value-) indexed uPreds/iProps.

This avoids ambiguity with P and Q that we were using before for both
uPreds/iProps and indexed uPreds/iProps.
parent 5e9653fb
This diff is collapsed.
......@@ -16,17 +16,17 @@ Notation "'Π★' Ps" := (uPred_big_sep Ps) (at level 20) : uPred_scope.
(** * Other big ops *)
(** We use a type class to obtain overloaded notations *)
Definition uPred_big_sepM {M} `{Countable K} {A}
(m : gmap K A) (P : K A uPred M) : uPred M :=
uPred_big_sep (curry P <$> map_to_list m).
(m : gmap K A) (Φ : K A uPred M) : uPred M :=
uPred_big_sep (curry Φ <$> map_to_list m).
Instance: Params (@uPred_big_sepM) 6.
Notation "'Π★{map' m } P" := (uPred_big_sepM m P)
(at level 20, m at level 10, format "Π★{map m } P") : uPred_scope.
Notation "'Π★{map' m } Φ" := (uPred_big_sepM m Φ)
(at level 20, m at level 10, format "Π★{map m } Φ") : uPred_scope.
Definition uPred_big_sepS {M} `{Countable A}
(X : gset A) (P : A uPred M) : uPred M := uPred_big_sep (P <$> elements X).
(X : gset A) (Φ : A uPred M) : uPred M := uPred_big_sep (Φ <$> elements X).
Instance: Params (@uPred_big_sepS) 5.
Notation "'Π★{set' X } P" := (uPred_big_sepS X P)
(at level 20, X at level 10, format "Π★{set X } P") : uPred_scope.
Notation "'Π★{set' X } Φ" := (uPred_big_sepS X Φ)
(at level 20, X at level 10, format "Π★{set X } Φ") : uPred_scope.
(** * Always stability for lists *)
Class AlwaysStableL {M} (Ps : list (uPred M)) :=
......@@ -97,56 +97,56 @@ Proof. induction 1; simpl; auto with I. Qed.
Section gmap.
Context `{Countable K} {A : Type}.
Implicit Types m : gmap K A.
Implicit Types P : K A uPred M.
Implicit Types Φ Ψ : K A uPred M.
Lemma big_sepM_mono P Q m1 m2 :
m2 m1 ( x k, m2 !! k = Some x P k x Q k x)
(Π★{map m1} P) (Π★{map m2} Q).
Lemma big_sepM_mono Φ Ψ m1 m2 :
m2 m1 ( x k, m2 !! k = Some x Φ k x Ψ k x)
(Π★{map m1} Φ) (Π★{map m2} Ψ).
Proof.
intros HX HP. transitivity (Π★{map m2} P)%I.
intros HX HΦ. transitivity (Π★{map m2} Φ)%I.
- by apply big_sep_contains, fmap_contains, map_to_list_contains.
- apply big_sep_mono', Forall2_fmap, Forall2_Forall.
apply Forall_forall=> -[i x] ? /=. by apply HP, elem_of_map_to_list.
apply Forall_forall=> -[i x] ? /=. by apply HΦ, elem_of_map_to_list.
Qed.
Global Instance big_sepM_ne m n :
Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> (dist n))
(uPred_big_sepM (M:=M) m).
Proof.
intros P1 P2 HP. apply big_sep_ne, Forall2_fmap.
apply Forall2_Forall, Forall_true=> -[i x]; apply HP.
intros Φ1 Φ2 HΦ. apply big_sep_ne, Forall2_fmap.
apply Forall2_Forall, Forall_true=> -[i x]; apply HΦ.
Qed.
Global Instance big_sepM_proper m :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ())
(uPred_big_sepM (M:=M) m).
Proof.
intros P1 P2 HP; apply equiv_dist=> n.
apply big_sepM_ne=> k x; apply equiv_dist, HP.
intros Φ1 Φ2 HΦ; apply equiv_dist=> n.
apply big_sepM_ne=> k x; apply equiv_dist, HΦ.
Qed.
Global Instance big_sepM_mono' m :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ())
(uPred_big_sepM (M:=M) m).
Proof. intros P1 P2 HP. apply big_sepM_mono; intros; [done|apply HP]. Qed.
Proof. intros Φ1 Φ2 HΦ. apply big_sepM_mono; intros; [done|apply HΦ]. Qed.
Lemma big_sepM_empty P : (Π★{map } P)%I True%I.
Lemma big_sepM_empty Φ : (Π★{map } Φ)%I True%I.
Proof. by rewrite /uPred_big_sepM map_to_list_empty. Qed.
Lemma big_sepM_insert P (m : gmap K A) i x :
m !! i = None (Π★{map <[i:=x]> m} P)%I (P i x Π★{map m} P)%I.
Lemma big_sepM_insert Φ (m : gmap K A) i x :
m !! i = None (Π★{map <[i:=x]> m} Φ)%I (Φ i x Π★{map m} Φ)%I.
Proof. intros ?; by rewrite /uPred_big_sepM map_to_list_insert. Qed.
Lemma big_sepM_singleton P i x : (Π★{map {[i := x]}} P)%I (P i x)%I.
Lemma big_sepM_singleton Φ i x : (Π★{map {[i := x]}} Φ)%I (Φ i x)%I.
Proof.
rewrite -insert_empty big_sepM_insert/=; last auto using lookup_empty.
by rewrite big_sepM_empty right_id.
Qed.
Lemma big_sepM_sepM P Q m :
(Π★{map m} (λ i x, P i x Q i x))%I (Π★{map m} P Π★{map m} Q)%I.
Lemma big_sepM_sepM Φ Ψ m :
(Π★{map m} (λ i x, Φ i x Ψ i x))%I (Π★{map m} Φ Π★{map m} Ψ)%I.
Proof.
rewrite /uPred_big_sepM.
induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?right_id //.
by rewrite IH -!assoc (assoc _ (Q _ _)) [(Q _ _ _)%I]comm -!assoc.
by rewrite IH -!assoc (assoc _ (Ψ _ _)) [(Ψ _ _ _)%I]comm -!assoc.
Qed.
Lemma big_sepM_later P m : ( Π★{map m} P)%I (Π★{map m} (λ i x, P i x))%I.
Lemma big_sepM_later Φ m : ( Π★{map m} Φ)%I (Π★{map m} (λ i x, Φ i x))%I.
Proof.
rewrite /uPred_big_sepM.
induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?later_True //.
......@@ -158,56 +158,56 @@ End gmap.
Section gset.
Context `{Countable A}.
Implicit Types X : gset A.
Implicit Types P : A uPred M.
Implicit Types Φ : A uPred M.
Lemma big_sepS_mono P Q X Y :
Y X ( x, x Y P x Q x) (Π★{set X} P) (Π★{set Y} Q).
Lemma big_sepS_mono Φ Ψ X Y :
Y X ( x, x Y Φ x Ψ x) (Π★{set X} Φ) (Π★{set Y} Ψ).
Proof.
intros HX HP. transitivity (Π★{set Y} P)%I.
intros HX HΦ. transitivity (Π★{set Y} Φ)%I.
- by apply big_sep_contains, fmap_contains, elements_contains.
- apply big_sep_mono', Forall2_fmap, Forall2_Forall.
apply Forall_forall=> x ? /=. by apply HP, elem_of_elements.
apply Forall_forall=> x ? /=. by apply HΦ, elem_of_elements.
Qed.
Lemma big_sepS_ne X n :
Proper (pointwise_relation _ (dist n) ==> dist n) (uPred_big_sepS (M:=M) X).
Proof.
intros P1 P2 HP. apply big_sep_ne, Forall2_fmap.
apply Forall2_Forall, Forall_true=> x; apply HP.
intros Φ1 Φ2 HΦ. apply big_sep_ne, Forall2_fmap.
apply Forall2_Forall, Forall_true=> x; apply HΦ.
Qed.
Lemma big_sepS_proper X :
Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X).
Proof.
intros P1 P2 HP; apply equiv_dist=> n.
apply big_sepS_ne=> x; apply equiv_dist, HP.
intros Φ1 Φ2 HΦ; apply equiv_dist=> n.
apply big_sepS_ne=> x; apply equiv_dist, HΦ.
Qed.
Lemma big_sepS_mono' X :
Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X).
Proof. intros P1 P2 HP. apply big_sepS_mono; naive_solver. Qed.
Proof. intros Φ1 Φ2 HΦ. apply big_sepS_mono; naive_solver. Qed.
Lemma big_sepS_empty P : (Π★{set } P)%I True%I.
Lemma big_sepS_empty Φ : (Π★{set } Φ)%I True%I.
Proof. by rewrite /uPred_big_sepS elements_empty. Qed.
Lemma big_sepS_insert P X x :
x X (Π★{set {[ x ]} X} P)%I (P x Π★{set X} P)%I.
Lemma big_sepS_insert Φ X x :
x X (Π★{set {[ x ]} X} Φ)%I (Φ x Π★{set X} Φ)%I.
Proof. intros. by rewrite /uPred_big_sepS elements_union_singleton. Qed.
Lemma big_sepS_delete P X x :
x X (Π★{set X} P)%I (P x Π★{set X {[ x ]}} P)%I.
Lemma big_sepS_delete Φ X x :
x X (Π★{set X} Φ)%I (Φ x Π★{set X {[ x ]}} Φ)%I.
Proof.
intros. rewrite -big_sepS_insert; last set_solver.
by rewrite -union_difference_L; last set_solver.
Qed.
Lemma big_sepS_singleton P x : (Π★{set {[ x ]}} P)%I (P x)%I.
Lemma big_sepS_singleton Φ x : (Π★{set {[ x ]}} Φ)%I (Φ x)%I.
Proof. intros. by rewrite /uPred_big_sepS elements_singleton /= right_id. Qed.
Lemma big_sepS_sepS P Q X :
(Π★{set X} (λ x, P x Q x))%I (Π★{set X} P Π★{set X} Q)%I.
Lemma big_sepS_sepS Φ Ψ X :
(Π★{set X} (λ x, Φ x Ψ x))%I (Π★{set X} Φ Π★{set X} Ψ)%I.
Proof.
rewrite /uPred_big_sepS.
induction (elements X) as [|x l IH]; csimpl; first by rewrite ?right_id.
by rewrite IH -!assoc (assoc _ (Q _)) [(Q _ _)%I]comm -!assoc.
by rewrite IH -!assoc (assoc _ (Ψ _)) [(Ψ _ _)%I]comm -!assoc.
Qed.
Lemma big_sepS_later P X : ( Π★{set X} P)%I (Π★{set X} (λ x, P x))%I.
Lemma big_sepS_later Φ X : ( Π★{set X} Φ)%I (Π★{set X} (λ x, Φ x))%I.
Proof.
rewrite /uPred_big_sepS.
induction (elements X) as [|x l IH]; csimpl; first by rewrite ?later_True.
......
......@@ -123,12 +123,12 @@ Section proof.
( γ, barrier_ctx γ l P sts_ownS γ low_states {[ Send ]})%I.
Definition recv (l : loc) (R : iProp) : iProp :=
( γ (P Q : iProp) i, barrier_ctx γ l P sts_ownS γ (i_states i) {[ Change i ]}
( γ P Q i, barrier_ctx γ l P sts_ownS γ (i_states i) {[ Change i ]}
saved_prop_own i Q (Q - R))%I.
Lemma newchan_spec (P : iProp) (Q : val iProp) :
(heap_ctx heapN l, recv l P send l P - Q (LocV l))
wp (newchan '()) Q.
Lemma newchan_spec (P : iProp) (Φ : val iProp) :
(heap_ctx heapN l, recv l P send l P - Φ (LocV l))
wp (newchan '()) Φ.
Proof.
rewrite /newchan. wp_rec. (* TODO: wp_seq. *)
rewrite -wp_pvs. wp> eapply wp_alloc; eauto with I ndisj.
......@@ -177,8 +177,8 @@ Section proof.
rewrite !mkSet_elem_of /=. set_solver.
Qed.
Lemma signal_spec l P (Q : val iProp) :
heapN N (send l P P Q '()) wp (signal (LocV l)) Q.
Lemma signal_spec l P (Φ : val iProp) :
heapN N (send l P P Φ '()) wp (signal (LocV l)) Φ.
Proof.
intros Hdisj. rewrite /signal /send /barrier_ctx. rewrite sep_exist_r.
apply exist_elim=>γ. wp_rec. (* FIXME wp_let *)
......@@ -201,19 +201,19 @@ Section proof.
apply sep_mono; last first.
{ apply wand_intro_l. eauto with I. }
(* Now we come to the core of the proof: Updating from waiting to ress. *)
rewrite /waiting /ress sep_exist_l. apply exist_elim=>{Q} Q.
rewrite /waiting /ress sep_exist_l. apply exist_elim=>{Φ} Φ.
rewrite later_wand {1}(later_intro P) !assoc wand_elim_r.
rewrite big_sepS_later -big_sepS_sepS. apply big_sepS_mono'=>i.
rewrite -(exist_intro (Q i)) comm. done.
rewrite -(exist_intro (Φ i)) comm. done.
Qed.
Lemma wait_spec l P (Q : val iProp) :
heapN N (recv l P (P - Q '())) wp (wait (LocV l)) Q.
Lemma wait_spec l P (Φ : val iProp) :
heapN N (recv l P (P - Φ '())) wp (wait (LocV l)) Φ.
Proof.
Abort.
Lemma split_spec l P1 P2 Q :
(recv l (P1 P2) (recv l P1 recv l P2 - Q '())) wp Skip Q.
Lemma split_spec l P1 P2 Φ :
(recv l (P1 P2) (recv l P1 recv l P2 - Φ '())) wp Skip Φ.
Proof.
Abort.
......
......@@ -12,49 +12,49 @@ Notation Skip := (Seq (Lit LitUnit) (Lit LitUnit)).
Section derived.
Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val iProp heap_lang Σ.
Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ.
(** Proof rules for the sugar *)
Lemma wp_lam' E x ef e v Q :
to_val e = Some v wp E (subst ef x v) Q wp E (App (Lam x ef) e) Q.
Lemma wp_lam' E x ef e v Φ :
to_val e = Some v wp E (subst ef x v) Φ wp E (App (Lam x ef) e) Φ.
Proof. intros. by rewrite -wp_rec' ?subst_empty. Qed.
Lemma wp_let' E x e1 e2 v Q :
to_val e1 = Some v wp E (subst e2 x v) Q wp E (Let x e1 e2) Q.
Lemma wp_let' E x e1 e2 v Φ :
to_val e1 = Some v wp E (subst e2 x v) Φ wp E (Let x e1 e2) Φ.
Proof. apply wp_lam'. Qed.
Lemma wp_seq E e1 e2 Q : wp E e1 (λ _, wp E e2 Q) wp E (Seq e1 e2) Q.
Lemma wp_seq E e1 e2 Φ : wp E e1 (λ _, wp E e2 Φ) wp E (Seq e1 e2) Φ.
Proof.
rewrite -(wp_bind [LetCtx "" e2]). apply wp_mono=>v.
by rewrite -wp_let' //= ?to_of_val ?subst_empty.
Qed.
Lemma wp_skip E Q : (Q (LitV LitUnit)) wp E Skip Q.
Lemma wp_skip E Φ : (Φ (LitV LitUnit)) wp E Skip Φ.
Proof. rewrite -wp_seq -wp_value // -wp_value //. Qed.
Lemma wp_le E (n1 n2 : Z) P Q :
(n1 n2 P Q (LitV $ LitBool true))
(n2 < n1 P Q (LitV $ LitBool false))
P wp E (BinOp LeOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Q.
Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P Φ (LitV $ LitBool true))
(n2 < n1 P Φ (LitV $ LitBool false))
P wp E (BinOp LeOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Φ.
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 Q :
(n1 < n2 P Q (LitV $ LitBool true))
(n2 n1 P Q (LitV $ LitBool false))
P wp E (BinOp LtOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Q.
Lemma wp_lt E (n1 n2 : Z) P Φ :
(n1 < n2 P Φ (LitV $ LitBool true))
(n2 n1 P Φ (LitV $ LitBool false))
P wp E (BinOp LtOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Φ.
Proof.
intros. rewrite -wp_bin_op //; [].
destruct (bool_decide_reflect (n1 < n2)); by eauto with omega.
Qed.
Lemma wp_eq E (n1 n2 : Z) P Q :
(n1 = n2 P Q (LitV $ LitBool true))
(n1 n2 P Q (LitV $ LitBool false))
P wp E (BinOp EqOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Q.
Lemma wp_eq E (n1 n2 : Z) P Φ :
(n1 = n2 P Φ (LitV $ LitBool true))
(n1 n2 P Φ (LitV $ LitBool false))
P wp E (BinOp EqOp (Lit $ LitInt n1) (Lit $ LitInt n2)) Φ.
Proof.
intros. rewrite -wp_bin_op //; [].
destruct (bool_decide_reflect (n1 = n2)); by eauto with omega.
......
......@@ -31,7 +31,8 @@ Notation "l ↦ v" := (heap_mapsto l v) (at level 20) : uPred_scope.
Section heap.
Context {Σ : iFunctorG}.
Implicit Types N : namespace.
Implicit Types P : iPropG heap_lang Σ.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ.
Implicit Types σ : state.
Implicit Types h g : heapRA.
......@@ -95,11 +96,11 @@ Section heap.
Qed.
(** Weakest precondition *)
Lemma wp_alloc N E e v P Q :
Lemma wp_alloc N E e v P Φ :
to_val e = Some v nclose N E
P heap_ctx N
P ( l, l v - Q (LocV l))
P wp E (Alloc e) Q.
P ( l, l v - Φ (LocV l))
P wp E (Alloc e) Φ.
Proof.
rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? Hctx HP.
transitivity (pvs E E (auth_own heap_name P))%I.
......@@ -122,16 +123,16 @@ Section heap.
apply later_intro.
Qed.
Lemma wp_load N E l v P Q :
Lemma wp_load N E l v P Φ :
nclose N E
P heap_ctx N
P ( l v (l v - Q v))
P wp E (Load (Loc l)) Q.
P ( l v (l v - Φ v))
P wp E (Load (Loc l)) Φ.
Proof.
rewrite /heap_ctx /heap_inv /heap_mapsto=>HN ? HPQ.
rewrite /heap_ctx /heap_inv /heap_mapsto=>HN ? HPΦ.
apply (auth_fsa' heap_inv (wp_fsa _) id)
with N heap_name {[ l := Excl v ]}; simpl; eauto with I.
rewrite HPQ{HPQ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite HPΦ{HPΦ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite -assoc; apply const_elim_sep_l=> ?.
rewrite {1}[(ownP _)%I]pvs_timeless pvs_frame_r; apply wp_strip_pvs.
rewrite -(wp_load_pst _ (<[l:=v]>(of_heap h))) ?lookup_insert //.
......@@ -141,16 +142,16 @@ Section heap.
apply sep_mono_r, later_mono, wand_intro_l. by rewrite -later_intro.
Qed.
Lemma wp_store N E l v' e v P Q :
Lemma wp_store N E l v' e v P Φ :
to_val e = Some v nclose N E
P heap_ctx N
P ( l v' (l v - Q (LitV LitUnit)))
P wp E (Store (Loc l) e) Q.
P ( l v' (l v - Φ (LitV LitUnit)))
P wp E (Store (Loc l) e) Φ.
Proof.
rewrite /heap_ctx /heap_inv /heap_mapsto=>? HN ? HPQ.
rewrite /heap_ctx /heap_inv /heap_mapsto=>? HN ? HPΦ.
apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v) l))
with N heap_name {[ l := Excl v' ]}; simpl; eauto with I.
rewrite HPQ{HPQ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite HPΦ{HPΦ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite -assoc; apply const_elim_sep_l=> ?.
rewrite {1}[(ownP _)%I]pvs_timeless pvs_frame_r; apply wp_strip_pvs.
rewrite -(wp_store_pst _ (<[l:=v']>(of_heap h))) ?lookup_insert //.
......@@ -161,17 +162,17 @@ Section heap.
apply sep_mono_r, later_mono, wand_intro_l. by rewrite left_id -later_intro.
Qed.
Lemma wp_cas_fail N E l v' e1 v1 e2 v2 P Q :
Lemma wp_cas_fail N E l v' e1 v1 e2 v2 P Φ :
to_val e1 = Some v1 to_val e2 = Some v2 v' v1
nclose N E
P heap_ctx N
P ( l v' (l v' - Q (LitV (LitBool false))))
P wp E (Cas (Loc l) e1 e2) Q.
P ( l v' (l v' - Φ (LitV (LitBool false))))
P wp E (Cas (Loc l) e1 e2) Φ.
Proof.
rewrite /heap_ctx /heap_inv /heap_mapsto=>??? HN ? HPQ.
rewrite /heap_ctx /heap_inv /heap_mapsto=>??? HN ? HPΦ.
apply (auth_fsa' heap_inv (wp_fsa _) id)
with N heap_name {[ l := Excl v' ]}; simpl; eauto 10 with I.
rewrite HPQ{HPQ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite HPΦ{HPΦ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite -assoc; apply const_elim_sep_l=> ?.
rewrite {1}[(ownP _)%I]pvs_timeless pvs_frame_r; apply wp_strip_pvs.
rewrite -(wp_cas_fail_pst _ (<[l:=v']>(of_heap h))) ?lookup_insert //.
......@@ -181,17 +182,17 @@ Section heap.
apply sep_mono_r, later_mono, wand_intro_l. by rewrite -later_intro.
Qed.
Lemma wp_cas_suc N E l e1 v1 e2 v2 P Q :
Lemma wp_cas_suc N E l e1 v1 e2 v2 P Φ :
to_val e1 = Some v1 to_val e2 = Some v2
nclose N E
P heap_ctx N
P ( l v1 (l v2 - Q (LitV (LitBool true))))
P wp E (Cas (Loc l) e1 e2) Q.
P ( l v1 (l v2 - Φ (LitV (LitBool true))))
P wp E (Cas (Loc l) e1 e2) Φ.
Proof.
rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? HN ? HPQ.
rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? HN ? HPΦ.
apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v2) l))
with N heap_name {[ l := Excl v1 ]}; simpl; eauto 10 with I.
rewrite HPQ{HPQ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite HPΦ{HPΦ}; apply sep_mono_r, forall_intro=> h; apply wand_intro_l.
rewrite -assoc; apply const_elim_sep_l=> ?.
rewrite {1}[(ownP _)%I]pvs_timeless pvs_frame_r; apply wp_strip_pvs.
rewrite -(wp_cas_suc_pst _ (<[l:=v1]>(of_heap h))) ?lookup_insert //.
......
......@@ -9,25 +9,25 @@ Local Hint Extern 0 (language.reducible _ _) => do_step ltac:(eauto 2).
Section lifting.
Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val iProp heap_lang Σ.
Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ.
Implicit Types K : ectx.
Implicit Types ef : option expr.
(** Bind. *)
Lemma wp_bind {E e} K Q :
wp E e (λ v, wp E (fill K (of_val v)) Q) wp E (fill K e) Q.
Lemma wp_bind {E e} K Φ :
wp E e (λ v, wp E (fill K (of_val v)) Φ) wp E (fill K e) Φ.
Proof. apply weakestpre.wp_bind. Qed.
Lemma wp_bindi {E e} Ki Q :
wp E e (λ v, wp E (fill_item Ki (of_val v)) Q) wp E (fill_item Ki e) Q.
Lemma wp_bindi {E e} Ki Φ :
wp E e (λ v, wp E (fill_item Ki (of_val v)) Φ) wp E (fill_item Ki e) Φ.
Proof. apply weakestpre.wp_bind. Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *)
Lemma wp_alloc_pst E σ e v Q :
Lemma wp_alloc_pst E σ e v Φ :
to_val e = Some v
(ownP σ ( l, σ !! l = None ownP (<[l:=v]>σ) - Q (LocV l)))
wp E (Alloc e) Q.
(ownP σ ( l, σ !! l = None ownP (<[l:=v]>σ) - Φ (LocV l)))
wp E (Alloc e) Φ.
Proof.
(* TODO RJ: This works around ssreflect bug #22. *)
intros. set (φ v' σ' ef := l,
......@@ -42,42 +42,42 @@ Proof.
by rewrite (forall_elim l) right_id const_equiv // left_id wand_elim_r.
Qed.
Lemma wp_load_pst E σ l v Q :
Lemma wp_load_pst E σ l v Φ :
σ !! l = Some v
(ownP σ (ownP σ - Q v)) wp E (Load (Loc l)) Q.
(ownP σ (ownP σ - Φ v)) wp E (Load (Loc l)) Φ.
Proof.
intros. rewrite -(wp_lift_atomic_det_step σ v σ None) ?right_id //;
last by intros; inv_step; eauto using to_of_val.
Qed.
Lemma wp_store_pst E σ l e v v' Q :
Lemma wp_store_pst E σ l e v v' Φ :
to_val e = Some v σ !! l = Some v'
(ownP σ (ownP (<[l:=v]>σ) - Q (LitV LitUnit))) wp E (Store (Loc l) e) Q.
(ownP σ (ownP (<[l:=v]>σ) - Φ (LitV LitUnit))) wp E (Store (Loc l) e) Φ.
Proof.
intros. rewrite -(wp_lift_atomic_det_step σ (LitV LitUnit) (<[l:=v]>σ) None)
?right_id //; last by intros; inv_step; eauto.
Qed.
Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Q :
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
(ownP σ (ownP σ - Q (LitV $ LitBool false))) wp E (Cas (Loc l) e1 e2) Q.
(ownP σ (ownP σ - Φ (LitV $ LitBool false))) wp E (Cas (Loc l) e1 e2) Φ.
Proof.
intros. rewrite -(wp_lift_atomic_det_step σ (LitV $ LitBool false) σ None)
?right_id //; last by intros; inv_step; eauto.
Qed.
Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Q :
Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 σ !! l = Some v1
(ownP σ (ownP (<[l:=v2]>σ) - Q (LitV $ LitBool true)))
wp E (Cas (Loc l) e1 e2) Q.
(ownP σ (ownP (<[l:=v2]>σ) - Φ (LitV $ LitBool true)))
wp E (Cas (Loc l) e1 e2) Φ.
Proof.
intros. rewrite -(wp_lift_atomic_det_step σ (LitV $ LitBool true) (<[l:=v2]>σ) None)
?right_id //; last by intros; inv_step; eauto.
Qed.
(** Base axioms for core primitives of the language: Stateless reductions *)
Lemma wp_fork E e Q :
( Q (LitV LitUnit) wp (Σ:=Σ) e (λ _, True)) wp E (Fork e) Q.