Commit f7d2ab60 authored by Zhen Zhang's avatar Zhen Zhang

Fix atomic_pcas

parent eaeb15b7
...@@ -105,7 +105,8 @@ VFILES:=atomic.v\ ...@@ -105,7 +105,8 @@ VFILES:=atomic.v\
treiber.v\ treiber.v\
misc.v\ misc.v\
evmap.v\ evmap.v\
peritem.v peritem.v\
atomic_pcas.v
ifneq ($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),) ifneq ($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),)
-include $(addsuffix .d,$(VFILES)) -include $(addsuffix .d,$(VFILES))
......
...@@ -9,3 +9,4 @@ treiber.v ...@@ -9,3 +9,4 @@ treiber.v
misc.v misc.v
evmap.v evmap.v
peritem.v peritem.v
atomic_pcas.v
...@@ -2,11 +2,12 @@ From iris.program_logic Require Export weakestpre hoare. ...@@ -2,11 +2,12 @@ From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang proofmode notation. From iris.heap_lang Require Export lang proofmode notation.
From iris.heap_lang.lib Require Import spin_lock. From iris.heap_lang.lib Require Import spin_lock.
From iris.algebra Require Import dec_agree frac. From iris.algebra Require Import dec_agree frac.
From iris_atomic Require Import atomic_pcas'. From iris_atomic Require Import sync atomic_sync.
Import uPred. Import uPred.
Section atomic_pair. Section atomic_pair.
Context `{!heapG Σ, !lockG Σ, !syncG Σ} (N : namespace). Context `{!heapG Σ, !lockG Σ, !syncG Σ,
!inG Σ (prodR fracR (dec_agreeR (val * val)))} (N : namespace).
Definition pcas_seq : val := Definition pcas_seq : val :=
λ: "ls" "ab", λ: "ls" "ab",
...@@ -34,11 +35,8 @@ Section atomic_pair. ...@@ -34,11 +35,8 @@ Section atomic_pair.
Lemma pcas_seq_spec: seq_spec N pcas_seq ϕ α β . Lemma pcas_seq_spec: seq_spec N pcas_seq ϕ α β .
Proof. Proof.
rewrite /seq_spec. iIntros (_ l) "!# _". wp_seq. iVsIntro. iPureIntro.
intros Φ l.
iIntros "!# _". wp_seq. iVsIntro. iPureIntro. clear Φ.
iIntros (x Φ g HN) "(#Hh & Hg & #Hα & HΦ)". iIntros (x Φ g HN) "(#Hh & Hg & #Hα & HΦ)".
rewrite /ϕ /α.
iDestruct "Hg" as (l1 l2 x1 x2) "(% & % & Hl1 & Hl2)". iDestruct "Hg" as (l1 l2 x1 x2) "(% & % & Hl1 & Hl2)".
iDestruct "Hα" as (a b) "%". iDestruct "Hα" as (a b) "%".
subst. simpl. wp_let. wp_proj. wp_load. wp_proj. subst. simpl. wp_let. wp_proj. wp_load. wp_proj.
...@@ -50,44 +48,33 @@ Section atomic_pair. ...@@ -50,44 +48,33 @@ Section atomic_pair.
iDestruct ("HΦ" $! #true (b, b)%V) as "HΦ". iDestruct ("HΦ" $! #true (b, b)%V) as "HΦ".
iApply ("HΦ" with "[Hl1 Hl2]"). iApply ("HΦ" with "[Hl1 Hl2]").
{ iExists l1, l2, b, b. iFrame. eauto. } { iExists l1, l2, b, b. iFrame. eauto. }
rewrite /β. rewrite /β. iPureIntro.
iPureIntro. exists a, b, a, a, b, b. repeat (split; first done). left. eauto. exists a, b, a, a, b, b.
repeat (split; first done). left. eauto.
+ wp_if. + wp_if.
iDestruct ("HΦ" $! #false (a, x2)%V) as "H". iDestruct ("HΦ" $! #false (a, x2)%V) as "H".
iApply ("H" with "[Hl1 Hl2]"). iApply ("H" with "[Hl1 Hl2]").
{ iExists l1, l2, a, x2. iFrame. eauto. } { iExists l1, l2, a, x2. iFrame. eauto. }
rewrite /β. rewrite /β. iPureIntro.
iPureIntro. exists a, b, a, x2, a, x2. repeat (split; first done). right. eauto. exists a, b, a, x2, a, x2. repeat (split; first done). right. eauto.
- subst. - subst. wp_if.
wp_if.
iDestruct ("HΦ" $! #false (x1, x2)%V) as "H". iDestruct ("HΦ" $! #false (x1, x2)%V) as "H".
iApply ("H" with "[Hl1 Hl2]"). iApply ("H" with "[Hl1 Hl2]").
{ iExists l1, l2, x1, x2. iFrame. eauto. } { iExists l1, l2, x1, x2. iFrame. eauto. }
rewrite /β. rewrite /β. iPureIntro.
iPureIntro. exists a, b, x1, x2, x1, x2. repeat (split; first done). right. eauto. exists a, b, x1, x2, x1, x2.
repeat (split; first done). right. eauto.
Qed. Qed.
Lemma pcas_atomic_spec: Lemma pcas_atomic_spec (mk_syncer: val) (l1 l2: loc) (x1 x2: val) :
heapN N heap_ctx WP sync (λ: <>, (ref #0, ref #0))%V pcas_seq {{ f, γ, gHalf γ (#0, #0) x, atomic_triple' α β f x γ }}. heapN N mk_syncer_spec N mk_syncer
heap_ctx l1 x1 l2 x2
WP sync mk_syncer pcas_seq (LitV l1, LitV l2)%V {{ f, γ, gHalf γ (x1, x2)%V x, atomic_triple' α β f x γ }}.
Proof. Proof.
iIntros (HN) "#Hh". iIntros (HN Hmk_syncer) "(#Hh & Hl1 & Hl2)".
iDestruct (atomic_spec with "[]") as "Hspec"=>//. iDestruct (atomic_spec with "[Hl1 Hl2]") as "Hspec"=>//.
- apply pcas_seq_spec. - apply pcas_seq_spec.
- rewrite /cons_spec. - iFrame "Hh". iExists l1, l2, x1, x2. iFrame. eauto.
iIntros (Φ _) "[#Hh HΦ]". Qed.
wp_seq.
wp_alloc l1 as "Hl1".
wp_alloc l2 as "Hl2".
iVs (own_alloc (gFullR (#0, #0) gHalfR (#0, #0))) as (γ) "[HgFull HgHalf]".
{ rewrite /gHalfR /gFullR. split; first by simpl. simpl. by rewrite dec_agree_idemp. }
rewrite /ϕ.
iSpecialize ("HΦ" $! (#l1, #l2)%V γ).
rewrite /gFull /gHalf.
iVsIntro.
iAssert (( (l0 l3 : loc) (x1 x2 : val),
(#l1, #l2)%V = (#l0, #l3)%V
(#0, #0)%V = (x1, x2)%V l0 x1 l3 x2))%I with "[Hl1 Hl2]" as "H'".
{ iExists l1, l2, #0, #0. iFrame. eauto. }
iApply ("HΦ" with "H' HgFull HgHalf").
Qed.
End atomic_pair. End atomic_pair.
...@@ -40,10 +40,11 @@ Section atomic_sync. ...@@ -40,10 +40,11 @@ Section atomic_sync.
( (v: val) (g': A), ( (v: val) (g': A),
ϕ l g' - β x g g' v ={E}= Φ v) ϕ l g' - β x g g' v ={E}= Φ v)
WP f' x @ E {{ Φ }} )}}. WP f' x @ E {{ Φ }} )}}.
(* XXX (zgzehen): The linear VS in the above post-condition is for the final step (* XXX (zhen): The linear VS in the above post-condition is for the final step
of computation. The client side of such triple will have to prove that the of computation. The client side of such triple will have to prove that the
specific post-condition he wants can be lvs'd from whatever threaded together specific post-condition he wants can be lvs'd from whatever threaded together
by magic wands. The library side ... *) by magic wands. The library side, when proving seq_spec, will always have
a view shift at the end of evalutation, which is exactly what we need. *)
Lemma atomic_spec (mk_syncer f_seq l: val) (ϕ: val A iProp Σ) α β Ei: Lemma atomic_spec (mk_syncer f_seq l: val) (ϕ: val A iProp Σ) α β Ei:
(g0: A), (g0: A),
......
...@@ -6,7 +6,8 @@ Section sync. ...@@ -6,7 +6,8 @@ Section sync.
Context `{!heapG Σ} (N : namespace). Context `{!heapG Σ} (N : namespace).
Definition synced R (f' f: val) := Definition synced R (f' f: val) :=
( P Q (x: val), ({{ R P x }} f x {{ v, R Q x v }}) ({{ P x }} f' x {{ v, Q x v }}))%I. ( P Q (x: val), ({{ R P x }} f x {{ v, R Q x v }})
({{ P x }} f' x {{ v, Q x v }}))%I.
Definition is_syncer (R: iProp Σ) (s: val) := Definition is_syncer (R: iProp Σ) (s: val) :=
( (f : val), WP s f {{ f', synced R f' f }})%I. ( (f : val), WP s f {{ f', synced R f' f }})%I.
......
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