Commit d3f1f876 authored by Marianna Rapoport's avatar Marianna Rapoport

Pass over Ralf's comments on Commit 851f05c2

parent a655f886
......@@ -490,11 +490,14 @@ Definition state_upd_used_proph_id (f: gset proph_id → gset proph_id) (σ: sta
{| heap := σ.(heap); used_proph_id := f σ.(used_proph_id) |}.
Arguments state_upd_used_proph_id _ !_ /.
Local Notation NONEV := (InjLV (LitV LitUnit)) (only parsing).
Local Notation SOMEV x := (InjRV x) (only parsing).
(** We extend CAS to support atomic resolution of prophecy variables as follows:
[CAS p e1 e1 pv1 pv2]
where [pv1] and [pv2] are values of type [option (proph * val)].
If [CAS p e1 e2] succeeds, and if [pv1 = Some (p, v)], we atomically resolve the
prophecy variable [p] to [v]. If the [CAS] fails, we do the same of [pv2]:
prophecy variable [p] to [v]. If the [CAS] fails, we do the same with [pv2]:
[let b = CAS p e1 e2 ;;
match (if b then pv1 else pv2) with
......@@ -504,12 +507,14 @@ Arguments state_upd_used_proph_id _ !_ /.
The following function takes a value and extracts its encoding
of an optional prophecy-value pair.
If [extract_proph_resolve] returns [None], it indicates an invalid encoding,
whereas [Some None] means that it's a valid encoding of no pair.
*)
Definition extract_proph_resolve (v : val) : option (option (proph_id * val)) :=
match v with
| InjLV (LitV LitUnit) =>
| NONEV =>
Some None
| InjRV (PairV (LitV (LitProphecy p)) v') =>
| SOMEV (PairV (LitV (LitProphecy p)) v') =>
Some (Some (p, v'))
| _ =>
None
......@@ -554,7 +559,7 @@ Inductive head_step : expr → state → list observation → expr → state →
(Val $ LitV $ LitLoc l) (state_upd_heap <[l:=v]> σ)
[]
| LoadS l v σ :
σ.(heap) !! l = Some v
σ.(heap) !! l = Some v
head_step (Load (Val $ LitV $ LitLoc l)) σ [] (of_val v) σ []
| StoreS l v σ :
is_Some (σ.(heap) !! l)
......@@ -562,21 +567,23 @@ Inductive head_step : expr → state → list observation → expr → state →
[]
(Val $ LitV LitUnit) (state_upd_heap <[l:=v]> σ)
[]
| CasFailS l v1 v2 v3 v4 pv pvs vl σ :
extract_proph_resolve v4 = Some pv
| CasFailS l v1 v2 p1 p2 pv pvs vl σ :
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some pv
pvs = option_list pv
σ.(heap) !! l = Some vl vl v1
vals_cas_compare_safe vl v1
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2)) σ
pvs
(Val $ LitV $ LitBool false) σ
[]
| CasSucS l v1 v2 v3 v4 pv pvs σ :
extract_proph_resolve v3 = Some pv
| CasSucS l v1 v2 p1 p2 pv pvs σ :
extract_proph_resolve p1 = Some pv
is_Some (extract_proph_resolve p2)
pvs = option_list pv
σ.(heap) !! l = Some v1
vals_cas_compare_safe v1 v1
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2)) σ
pvs
(Val $ LitV $ LitBool true) (state_upd_heap <[l:=v2]> σ)
[]
......
......@@ -32,22 +32,24 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap {
*or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed]
is outside the atomic triple, which makes it much easier to use -- and the
spec is still good enough for all our applications. *)
cas_spec (l : loc) (w1 w2 w3 w4 : val) :
extract_proph_resolve w3 = Some None
extract_proph_resolve w4 = Some None
cas_spec (l : loc) (w1 w2 p1 p2 : val) :
extract_proph_resolve p1 = Some None
extract_proph_resolve p2 = Some None
val_is_unboxed w1
<<< v, mapsto l 1 v >>> cas #l w1 w2 w3 w4 @
<<< v, mapsto l 1 v >>> cas #l w1 w2 p1 p2 @
<<< if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v,
RET #(if decide (v = w1) then true else false) >>>;
cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w3 = Some (Some (p, w))
cas_suc_proph_spec (l : loc) (w1 w2 p1 p2 w : val) v (p : proph_id) :
extract_proph_resolve p1 = Some (Some (p, w))
is_Some (extract_proph_resolve p2)
val_is_unboxed w1
<<< mapsto l 1 w1 proph p v >>> cas #l w1 w2 w3 w4 @
<<< mapsto l 1 w1 proph p v >>> cas #l w1 w2 p1 p2 @
<<< mapsto l 1 w2 v = Some w, RET #true>>>;
cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w4 = Some (Some (p, w))
cas_fail_proph_spec (l : loc) (w1 w2 p1 p2 w : val) v (p : proph_id) :
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some (Some (p, w))
val_is_unboxed w1
<<< v', v' w1 mapsto l 1 v' proph p v >>> cas #l w1 w2 w3 w4 @
<<< v', v' w1 mapsto l 1 v' proph p v >>> cas #l w1 w2 p1 p2 @
<<< mapsto l 1 v' v = Some w, RET #false>>>;
}.
Arguments atomic_heap _ {_}.
......@@ -67,6 +69,8 @@ Notation "! e" := (load e) : expr_scope.
Notation "e1 <- e2" := (store e1 e2) : expr_scope.
Notation CAS e1 e2 e3 e4 e5 := (cas e1 e2 e3 e4 e5).
Notation "'cas:' e1 ',' e2 ',' e3" := (cas e1 e2 e3 NONEV NONEV)
(at level 200, e1, e2, e3 at level 200) : expr_scope.
End notation.
......@@ -107,12 +111,12 @@ Section proof.
wp_store. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ".
Qed.
Lemma primitive_cas_spec (l : loc) (w1 w2 w3 w4: val) :
extract_proph_resolve w3 = Some None
extract_proph_resolve w4 = Some None
Lemma primitive_cas_spec (l : loc) (w1 w2 p1 p2 : val) :
extract_proph_resolve p1 = Some None
extract_proph_resolve p2 = Some None
val_is_unboxed w1
<<< (v : val), l v >>>
primitive_cas #l w1 w2 w3 w4 @
primitive_cas #l w1 w2 p1 p2 @
<<< if decide (v = w1) then l w2 else l v,
RET #(if decide (v = w1) then true else false) >>>.
Proof.
......@@ -122,27 +126,29 @@ Section proof.
iMod ("Hclose" with "H↦") as "HΦ"; by iApply "HΦ".
Qed.
Lemma primitive_cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w3 = Some (Some (p, w))
Lemma primitive_cas_suc_proph_spec (l : loc) (w1 w2 p1 p2 w : val) v (p : proph_id) :
extract_proph_resolve p1 = Some (Some (p, w))
is_Some (extract_proph_resolve p2)
val_is_unboxed w1
<<< l w1 proph p v >>>
primitive_cas #l w1 w2 w3 w4 @
primitive_cas #l w1 w2 p1 p2 @
<<< l w2 v = Some w, RET #true>>>.
Proof.
iIntros (?? Q Φ) "? AU". wp_lam. repeat wp_let.
iIntros (??? Q Φ) "? AU". wp_lam. repeat wp_let.
iMod "AU" as "[[H↦ Hp] [_ Hclose]]".
wp_apply (wp_cas_suc_proph with "[H↦ Hp]"); eauto with iFrame; first by left.
iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ".
Qed.
Lemma primitive_cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w4 = Some (Some (p, w))
Lemma primitive_cas_fail_proph_spec (l : loc) (w1 w2 p1 p2 w : val) v (p : proph_id) :
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some (Some (p, w))
val_is_unboxed w1
<<< v', v' w1 l v' proph p v >>>
primitive_cas #l w1 w2 w3 w4 @
primitive_cas #l w1 w2 p1 p2 @
<<< l v' v = Some w, RET #false>>>.
Proof.
iIntros (? ? Q Φ) "? AU". wp_lam. repeat wp_let.
iIntros (??? Q Φ) "? AU". wp_lam. repeat wp_let.
iMod "AU" as (v') "[(Hn & H↦ & Hp) [_ Hclose]]". iDestruct "Hn" as %Hn.
wp_apply (wp_cas_fail_proph with "[H↦ Hp]"); eauto with iFrame; first by right.
iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ".
......
......@@ -16,7 +16,7 @@ Section increment.
Definition incr: val :=
rec: "incr" "l" :=
let: "oldv" := !"l" in
if: CAS "l" "oldv" ("oldv" + #1) NONEV NONEV
if: (cas: "l", "oldv", "oldv" + #1)
then "oldv" (* return old value if success *)
else "incr" "l".
......
......@@ -235,36 +235,39 @@ Proof.
iModIntro. iSplit=>//. iSplit; first done. iFrame. by iApply "HΦ".
Qed.
Lemma wp_cas_fail s E l q v' v1 v2 v3 v4 :
Lemma wp_cas_fail s E l q v' v1 v2 p1 p2 :
v' v1 vals_cas_compare_safe v' v1
extract_proph_resolve v4 = Some None
{{{ l {q} v' }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some None
{{{ l {q} v' }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
{{{ RET LitV (LitBool false); l {q} v' }}}.
Proof.
iIntros (??? Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (???? Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κ κs n) "[Hσ Hκs] !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
Lemma twp_cas_fail s E l q v' v1 v2 v3 v4 :
Lemma twp_cas_fail s E l q v' v1 v2 p1 p2 :
v' v1 vals_cas_compare_safe v' v1
extract_proph_resolve v4 = Some None
[[{ l {q} v' }]] CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some None
[[{ l {q} v' }]] CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
[[{ RET LitV (LitBool false); l {q} v' }]].
Proof.
iIntros (??? Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (???? Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κs n) "[Hσ Hκs] !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iModIntro; iSplit=> //. iSplit; first done. iFrame. by iApply "HΦ".
Qed.
Lemma wp_cas_fail_proph s E l q v' v1 v2 v3 v4 p v w :
Lemma wp_cas_fail_proph s E l q v' v1 v2 p1 p2 p v w :
v' v1 vals_cas_compare_safe v' v1
extract_proph_resolve v4 = Some (Some (p, w))
{{{ (l {q} v' proph p v) }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some (Some (p, w))
{{{ (l {q} v' proph p v) }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
{{{ RET LitV (LitBool false); l {q} v' v = Some w}}}.
Proof.
iIntros (??? Φ) "[>Hl >Hp] HΦ".
iIntros (???? Φ) "[>Hl >Hp] HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κ κs n) "[Hσ HR] !>". iDestruct "HR" as (R [Hfr Hdom]) "HR".
iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
......@@ -279,13 +282,14 @@ Proof.
- iApply "HΦ". iFrame. iPureIntro. by eapply first_resolve_eq.
Qed.
Lemma wp_cas_suc s E l v1 v2 v3 v4 :
Lemma wp_cas_suc s E l v1 v2 p1 p2 :
vals_cas_compare_safe v1 v1
extract_proph_resolve v3 = Some None
{{{ l v1 }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
extract_proph_resolve p1 = Some None
is_Some (extract_proph_resolve p2)
{{{ l v1 }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
{{{ RET LitV (LitBool true); l v2 }}}.
Proof.
iIntros (?? Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (??? Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κ κs n) "[Hσ Hκs] !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
......@@ -294,13 +298,14 @@ Proof.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. iFrame. by iApply "HΦ".
Qed.
Lemma twp_cas_suc s E l v1 v2 v3 v4 :
Lemma twp_cas_suc s E l v1 v2 p1 p2 :
vals_cas_compare_safe v1 v1
extract_proph_resolve v3 = Some None
[[{ l v1 }]] CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
extract_proph_resolve p1 = Some None
is_Some (extract_proph_resolve p2)
[[{ l v1 }]] CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
[[{ RET LitV (LitBool true); l v2 }]].
Proof.
iIntros (?? Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (??? Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κs n) "[Hσ Hκs] !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
......@@ -310,13 +315,14 @@ Proof.
iModIntro. iSplit=>//. iSplit; first done. iFrame. by iApply "HΦ".
Qed.
Lemma wp_cas_suc_proph s E l v1 v2 v3 v4 p v w :
Lemma wp_cas_suc_proph s E l v1 v2 p1 p2 p v w :
vals_cas_compare_safe v1 v1
extract_proph_resolve v3 = Some (Some (p, w))
{{{ (l v1 proph p v) }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4) @ s; E
extract_proph_resolve p1 = Some (Some (p, w))
is_Some (extract_proph_resolve p2)
{{{ (l v1 proph p v) }}} CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val p1) (Val p2) @ s; E
{{{ RET LitV (LitBool true); l v2 v = Some w}}}.
Proof.
iIntros (?? Φ) "[>Hl >Hp] HΦ".
iIntros (??? Φ) "[>Hl >Hp] HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1 κ κs n) "[Hσ HR] !>". iDestruct "HR" as (R [Hfr Hdom]) "HR".
iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
......
......@@ -236,18 +236,20 @@ Proof.
rewrite right_id. by apply sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_cas Δ Δ' Δ'' s E i K l v v1 v2 v3 v4 Φ :
Lemma tac_wp_cas Δ Δ' Δ'' s E i K l v v1 v2 p1 p2 Φ :
MaybeIntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ''
vals_cas_compare_safe v v1
(v = v1
extract_proph_resolve v3 = Some None
extract_proph_resolve p1 = Some None
is_Some (extract_proph_resolve p2)
envs_entails Δ'' (WP fill K (Val $ LitV true) @ s; E {{ Φ }}))
(v v1
extract_proph_resolve v4 = Some None
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some None
envs_entails Δ' (WP fill K (Val $ LitV false) @ s; E {{ Φ }}))
envs_entails Δ (WP fill K (CAS (LitV l) (Val v1) (Val v2) (Val v3) (Val v4)) @ s; E {{ Φ }}).
envs_entails Δ (WP fill K (CAS (LitV l) (Val v1) (Val v2) (Val p1) (Val p2)) @ s; E {{ Φ }}).
Proof.
rewrite envs_entails_eq=> ???? Hsuc Hfail. destruct (decide (v = v1)) as [<-|Hne].
- rewrite -wp_bind. eapply wand_apply; first (apply wp_cas_suc; naive_solver).
......@@ -258,17 +260,19 @@ Proof.
rewrite into_laterN_env_sound -later_sep /= {1}envs_lookup_split //; simpl.
apply later_mono, sep_mono_r. apply wand_mono; naive_solver.
Qed.
Lemma tac_twp_cas Δ Δ' s E i K l v v1 v2 v3 v4 Φ :
Lemma tac_twp_cas Δ Δ' s E i K l v v1 v2 p1 p2 Φ :
envs_lookup i Δ = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ = Some Δ'
vals_cas_compare_safe v v1
(v = v1
extract_proph_resolve v3 = Some None
extract_proph_resolve p1 = Some None
is_Some (extract_proph_resolve p2)
envs_entails Δ' (WP fill K (Val $ LitV true) @ s; E [{ Φ }]))
(v v1
extract_proph_resolve v4 = Some None
is_Some (extract_proph_resolve p1)
extract_proph_resolve p2 = Some None
envs_entails Δ (WP fill K (Val $ LitV false) @ s; E [{ Φ }]))
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 v3 v4) @ s; E [{ Φ }]).
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 p1 p2) @ s; E [{ Φ }]).
Proof.
rewrite envs_entails_eq=> ??? Hsuc Hfail. destruct (decide (v = v1)) as [<-|Hne].
- rewrite -twp_bind. eapply wand_apply; first (apply twp_cas_suc; naive_solver).
......@@ -280,57 +284,60 @@ Proof.
apply sep_mono_r. apply wand_mono; naive_solver.
Qed.
Lemma tac_wp_cas_fail Δ Δ' s E i K l q v v1 v2 v3 v4 Φ :
Lemma tac_wp_cas_fail Δ Δ' s E i K l q v v1 v2 p1 p2 Φ :
MaybeIntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I
v v1 extract_proph_resolve v4 = Some None vals_cas_compare_safe v v1
v v1 is_Some (extract_proph_resolve p1) extract_proph_resolve p2 = Some None
vals_cas_compare_safe v v1
envs_entails Δ' (WP fill K (Val $ LitV false) @ s; E {{ Φ }})
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 v3 v4) @ s; E {{ Φ }}).
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 p1 p2) @ s; E {{ Φ }}).
Proof.
rewrite envs_entails_eq=> ??????.
rewrite envs_entails_eq=> ???????.
rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_fail.
rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_twp_cas_fail Δ s E i K l q v v1 v2 v3 v4 Φ :
Lemma tac_twp_cas_fail Δ s E i K l q v v1 v2 p1 p2 Φ :
envs_lookup i Δ = Some (false, l {q} v)%I
v v1 extract_proph_resolve v4 = Some None vals_cas_compare_safe v v1
v v1 is_Some (extract_proph_resolve p1) extract_proph_resolve p2 = Some None
vals_cas_compare_safe v v1
envs_entails Δ (WP fill K (Val $ LitV false) @ s; E [{ Φ }])
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 v3 v4) @ s; E [{ Φ }]).
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 p1 p2) @ s; E [{ Φ }]).
Proof.
rewrite envs_entails_eq. intros. rewrite -twp_bind.
eapply wand_apply; first exact: twp_cas_fail.
rewrite envs_lookup_split //=. by do 2 f_equiv.
Qed.
Lemma tac_wp_cas_suc Δ Δ' Δ'' s E i K l v v1 v2 v3 v4 Φ :
Lemma tac_wp_cas_suc Δ Δ' Δ'' s E i K l v v1 v2 p1 p2 Φ :
MaybeIntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ''
v = v1 extract_proph_resolve v3 = Some None val_is_unboxed v
v = v1 extract_proph_resolve p1 = Some None is_Some (extract_proph_resolve p2)
val_is_unboxed v
envs_entails Δ'' (WP fill K (Val $ LitV true) @ s; E {{ Φ }})
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 v3 v4) @ s; E {{ Φ }}).
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 p1 p2) @ s; E {{ Φ }}).
Proof.
rewrite envs_entails_eq=> ???????; subst.
rewrite envs_entails_eq=> ????????; subst.
rewrite -wp_bind. eapply wand_apply.
{ eapply wp_cas_suc; eauto. by left. }
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_twp_cas_suc Δ Δ' s E i K l v v1 v2 v3 v4 Φ :
Lemma tac_twp_cas_suc Δ Δ' s E i K l v v1 v2 p1 p2 Φ :
envs_lookup i Δ = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ = Some Δ'
v = v1 extract_proph_resolve v3 = Some None val_is_unboxed v
v = v1 extract_proph_resolve p1 = Some None is_Some (extract_proph_resolve p2)
val_is_unboxed v
envs_entails Δ' (WP fill K (Val $ LitV true) @ s; E [{ Φ }])
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 v3 v4) @ s; E [{ Φ }]).
envs_entails Δ (WP fill K (CAS (LitV l) v1 v2 p1 p2) @ s; E [{ Φ }]).
Proof.
rewrite envs_entails_eq=>??????; subst.
rewrite envs_entails_eq=>???????; subst.
rewrite -twp_bind. eapply wand_apply.
{ eapply twp_cas_suc; eauto. by left. }
rewrite envs_simple_replace_sound //; simpl.
rewrite right_id. by apply sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_faa Δ Δ' Δ'' s E i K l z1 z2 Φ :
MaybeIntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l LitV z1)%I
......@@ -463,8 +470,8 @@ Tactic Notation "wp_cas" "as" simple_intropattern(H1) "|" simple_intropattern(H2
|solve_mapsto ()
|pm_reflexivity
|try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|intros H1; split; first done; wp_expr_simpl; try wp_value_head
|intros H2; split; first done; wp_expr_simpl; try wp_value_head]
|intros H1; split; [done | split; [by eauto | wp_expr_simpl; try wp_value_head]]
|intros H2; split; [done | split; [by eauto | wp_expr_simpl; try wp_value_head]]]
| |- envs_entails _ (twp ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' => eapply (tac_twp_cas _ _ _ _ _ K))
......@@ -472,8 +479,8 @@ Tactic Notation "wp_cas" "as" simple_intropattern(H1) "|" simple_intropattern(H2
[solve_mapsto ()
|pm_reflexivity
|try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|intros H1; split; first done; wp_expr_simpl; try wp_value_head
|intros H2; split; first done; wp_expr_simpl; try wp_value_head]
|intros H1; split; [done | split; [by eauto | wp_expr_simpl; try wp_value_head]]
|intros H2; split; [done | split; [by eauto | wp_expr_simpl; try wp_value_head]]]
| _ => fail "wp_cas: not a 'wp'"
end.
......@@ -490,7 +497,8 @@ Tactic Notation "wp_cas_fail" :=
[iSolveTC
|solve_mapsto ()
|try congruence
|try done
|eauto
|try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|simpl; try wp_value_head]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
......@@ -519,7 +527,8 @@ Tactic Notation "wp_cas_suc" :=
|pm_reflexivity
|try congruence
|try fast_done (* vals_cas_compare_safe *)
|try done
|try done; eauto
|simpl; eauto
|simpl; try wp_value_head]
| |- envs_entails _ (twp ?E ?e ?Q) =>
first
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment