Commit 82a778ad authored by Dan Frumin's avatar Dan Frumin

Simplify the relational rules for locks

parent 918a5591
......@@ -93,22 +93,12 @@ Section proof.
Qed.
Lemma bin_log_related_newlock_r Γ K t τ :
( (l : loc), l ↦ₛ (#v false) - Γ t log fill K (Loc l) : τ)%I
( l : loc, l ↦ₛ (#v false) - Γ t log fill K (Loc l) : τ)%I
- Γ t log fill K newlock : τ.
Proof.
iIntros "Hlog".
pose (Φ := (fun w => l, w = (LocV l) l ↦ₛ (#v false))%I).
iApply (bin_log_related_step_r Φ with "[]").
{ autosubst. }
{ cbv[Φ].
iIntros (ρ j K') "#Hs Hj /=".
tp_apply j steps_newlock.
iDestruct "Hj" as (l) "[Hj Hl]".
iExists (LocV l). simpl. iFrame.
iModIntro. iSplitL; eauto. }
iIntros (v') "He'". iDestruct "He'" as (l) "[% Hl]". subst.
iApply "Hlog".
done.
unfold newlock.
iApply (bin_log_related_alloc_r); auto.
Qed.
Global Opaque newlock.
......@@ -125,6 +115,29 @@ Section proof.
by iFrame.
Qed.
(* TODO: those should be accompaied by lemmas; preferably so that
[change] does not change too much *)
Tactic Notation "rel_bind_l" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ (fill _ ?e) _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
| [ |- (_ bin_log_related _ _ _ ?e _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
end.
Tactic Notation "rel_bind_r" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ _ (fill _ ?e) _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
| [ |- (_ bin_log_related _ _ _ _ ?e _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
end.
Lemma bin_log_related_acquire_r Γ E1 E2 K l t τ
(Hspec : nclose specN E1) :
l ↦ₛ (#v false) -
......@@ -132,17 +145,13 @@ Section proof.
- {E1,E2;Γ} t log fill K (App acquire (Loc l)) : τ.
Proof.
iIntros "Hl Hlog".
pose (Φ := (fun w => w = UnitV l ↦ₛ (#v true))%I).
iApply (bin_log_related_step_r Φ with "[Hl]").
{ autosubst. }
{ cbv[Φ].
iIntros (ρ j K') "#Hs Hj /=".
tp_apply j steps_acquire with "Hl" as "Hl".
iExists UnitV. simpl. iFrame.
iModIntro. iSplitL; eauto. }
iIntros (v') "[% Hl]". subst.
iApply "Hlog".
done.
unfold acquire.
iApply bin_log_related_rec_r; auto. asimpl.
rel_bind_r (CAS _ _ _).
iApply (bin_log_related_cas_suc_r with "Hl"); auto.
iIntros "Hl". rewrite fill_app /=.
iApply bin_log_related_if_true_r; auto.
by iApply "Hlog".
Qed.
Global Opaque acquire.
......@@ -165,17 +174,9 @@ Section proof.
- {E1,E2;Γ} t log fill K (App release (Loc l)) : τ.
Proof.
iIntros "Hl Hlog".
pose (Φ := (fun w => w = UnitV l ↦ₛ (#v false))%I).
iApply (bin_log_related_step_r Φ with "[Hl]").
{ autosubst. }
{ cbv[Φ].
iIntros (ρ j K') "#Hs Hj /=".
tp_apply j steps_release with "Hl" as "Hl".
iExists UnitV. simpl. iFrame.
iModIntro. iSplitL; eauto. }
iIntros (v') "[% Hl]". subst.
iApply "Hlog".
done.
unfold release.
iApply (bin_log_related_rec_r); auto. simpl.
iApply (bin_log_related_store_r with "Hl"); auto.
Qed.
Global Opaque release.
......@@ -207,22 +208,6 @@ Section proof.
tp_normalise j. asimpl.
by iFrame.
Qed.
(* TODO: those should be accompaied by lemmas; preferably so that
[change] does not change too much *)
Tactic Notation "rel_bind_l" open_constr(efoc) :=
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ ?e _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
end.
Tactic Notation "rel_bind_r" open_constr(efoc) :=
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ _ (fill _ ?e) _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
end.
Lemma bin_log_related_with_lock_r' Γ K E1 E2 Q e ev ew v w l t τ :
(nclose specN E1)
......
......@@ -790,17 +790,18 @@ Section properties.
done.
Qed.
Lemma bin_log_related_cas_fail_r Γ K l e1 e2 v1 v2 v t τ
Lemma bin_log_related_cas_fail_r Γ E1 E2 K l e1 e2 v1 v2 v t τ
(Hclosed1 : f, e1.[f] = e1)
(Hclosed2 : f, e2.[f] = e2) :
(nclose specN E1)
(to_val e1 = Some v1)
(to_val e2 = Some v2)
(v <> v1)
l ↦ₛ v -
(l ↦ₛ v - Γ t log fill K (# false) : τ)
- Γ t log fill K (CAS (Loc l) e1 e2) : τ.
(l ↦ₛ v - {E1,E2;Γ} t log fill K (# false) : τ)
- {E1,E2;Γ} t log fill K (CAS (Loc l) e1 e2) : τ.
Proof.
iIntros (???) "Hl Hlog".
iIntros (????) "Hl Hlog".
pose (Φ := (fun w => w = BoolV false l ↦ₛ v)%I).
iApply (bin_log_related_step_r Φ with "[Hl]"); eauto.
rewrite_closed.
......@@ -814,17 +815,18 @@ Section properties.
done.
Qed.
Lemma bin_log_related_cas_suc_r Γ K l e1 e2 v1 v2 v t τ
Lemma bin_log_related_cas_suc_r Γ E1 E2 K l e1 e2 v1 v2 v t τ
(Hclosed1 : f, e1.[f] = e1)
(Hclosed2 : f, e2.[f] = e2) :
(nclose specN E1)
(to_val e1 = Some v1)
(to_val e2 = Some v2)
(v = v1)
l ↦ₛ v -
(l ↦ₛ v2 - Γ t log fill K (# true) : τ)
- Γ t log fill K (CAS (Loc l) e1 e2) : τ.
(l ↦ₛ v2 - {E1,E2;Γ} t log fill K (# true) : τ)
- {E1,E2;Γ} t log fill K (CAS (Loc l) e1 e2) : τ.
Proof.
iIntros (???) "Hl Hlog".
iIntros (????) "Hl Hlog".
pose (Φ := (fun w => w = BoolV true l ↦ₛ v2)%I).
iApply (bin_log_related_step_r Φ with "[Hl]"); eauto.
rewrite_closed.
......
......@@ -28,7 +28,7 @@ Ltac properness :=
| |- (_ _)%I (_ _)%I => apply or_proper
| |- (_ _)%I (_ _)%I => apply impl_proper
| |- (_ - _)%I (_ - _)%I => apply wand_proper
| |- (WP _ {{ _ }})%I (WP _ {{ _ }})%I => apply wp_proper =>?
| |- (WP _ @ _ {{ _ }})%I (WP _ @ _ {{ _ }})%I => apply wp_proper =>?
| |- ( _)%I ( _)%I => apply later_proper
| |- ( _)%I ( _)%I => apply always_proper
| |- (|={_,_}=> _ )%I (|={_,_}=> _ )%I => apply fupd_proper
......
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