Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Gaurav Parthasarathy
examples_rdcss_old
Commits
f7d2ab60
Commit
f7d2ab60
authored
Oct 17, 2016
by
Zhen Zhang
Browse files
Fix atomic_pcas
parent
eaeb15b7
Changes
5
Hide whitespace changes
Inline
Side-by-side
Makefile.coq
View file @
f7d2ab60
...
...
@@ -105,7 +105,8 @@ VFILES:=atomic.v\
treiber.v
\
misc.v
\
evmap.v
\
peritem.v
peritem.v
\
atomic_pcas.v
ifneq
($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),)
-include
$(addsuffix .d,$(VFILES))
...
...
_CoqProject
View file @
f7d2ab60
...
...
@@ -9,3 +9,4 @@ treiber.v
misc.v
evmap.v
peritem.v
atomic_pcas.v
atomic_pcas.v
View file @
f7d2ab60
...
...
@@ -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
.
lib
Require
Import
spin_lock
.
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
.
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
:
=
λ
:
"ls"
"ab"
,
...
...
@@ -34,11 +35,8 @@ Section atomic_pair.
Lemma
pcas_seq_spec
:
seq_spec
N
pcas_seq
ϕ
α
β
⊤
.
Proof
.
rewrite
/
seq_spec
.
intros
Φ
l
.
iIntros
"!# _"
.
wp_seq
.
iVsIntro
.
iPureIntro
.
clear
Φ
.
iIntros
(
_
l
)
"!# _"
.
wp_seq
.
iVsIntro
.
iPureIntro
.
iIntros
(
x
Φ
g
HN
)
"(#Hh & Hg & #Hα & HΦ)"
.
rewrite
/
ϕ
/
α
.
iDestruct
"Hg"
as
(
l1
l2
x1
x2
)
"(% & % & Hl1 & Hl2)"
.
iDestruct
"Hα"
as
(
a
b
)
"%"
.
subst
.
simpl
.
wp_let
.
wp_proj
.
wp_load
.
wp_proj
.
...
...
@@ -50,44 +48,33 @@ Section atomic_pair.
iDestruct
(
"HΦ"
$!
#
true
(
b
,
b
)%
V
)
as
"HΦ"
.
iApply
(
"HΦ"
with
"[Hl1 Hl2]"
).
{
iExists
l1
,
l2
,
b
,
b
.
iFrame
.
eauto
.
}
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
a
,
a
,
b
,
b
.
repeat
(
split
;
first
done
).
left
.
eauto
.
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
a
,
a
,
b
,
b
.
repeat
(
split
;
first
done
).
left
.
eauto
.
+
wp_if
.
iDestruct
(
"HΦ"
$!
#
false
(
a
,
x2
)%
V
)
as
"H"
.
iApply
(
"H"
with
"[Hl1 Hl2]"
).
{
iExists
l1
,
l2
,
a
,
x2
.
iFrame
.
eauto
.
}
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
a
,
x2
,
a
,
x2
.
repeat
(
split
;
first
done
).
right
.
eauto
.
-
subst
.
wp_if
.
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
a
,
x2
,
a
,
x2
.
repeat
(
split
;
first
done
).
right
.
eauto
.
-
subst
.
wp_if
.
iDestruct
(
"HΦ"
$!
#
false
(
x1
,
x2
)%
V
)
as
"H"
.
iApply
(
"H"
with
"[Hl1 Hl2]"
).
{
iExists
l1
,
l2
,
x1
,
x2
.
iFrame
.
eauto
.
}
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
x1
,
x2
,
x1
,
x2
.
repeat
(
split
;
first
done
).
right
.
eauto
.
rewrite
/
β
.
iPureIntro
.
exists
a
,
b
,
x1
,
x2
,
x1
,
x2
.
repeat
(
split
;
first
done
).
right
.
eauto
.
Qed
.
Lemma
pcas_atomic_spec
:
heapN
⊥
N
→
heap_ctx
⊢
WP
sync
(
λ
:
<>,
(
ref
#
0
,
ref
#
0
))%
V
pcas_seq
{{
f
,
∃
γ
,
gHalf
γ
(#
0
,
#
0
)
★
∀
x
,
□
atomic_triple'
α
β
⊤
⊤
f
x
γ
}}.
Lemma
pcas_atomic_spec
(
mk_syncer
:
val
)
(
l1
l2
:
loc
)
(
x1
x2
:
val
)
:
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
.
iIntros
(
HN
)
"#Hh"
.
iDestruct
(
atomic_spec
with
"[]"
)
as
"Hspec"
=>//.
iIntros
(
HN
Hmk_syncer
)
"
(
#Hh
& Hl1 & Hl2)
"
.
iDestruct
(
atomic_spec
with
"[
Hl1 Hl2
]"
)
as
"Hspec"
=>//.
-
apply
pcas_seq_spec
.
-
rewrite
/
cons_spec
.
iIntros
(
Φ
_
)
"[#Hh HΦ]"
.
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
.
-
iFrame
"Hh"
.
iExists
l1
,
l2
,
x1
,
x2
.
iFrame
.
eauto
.
Qed
.
End
atomic_pair
.
atomic_sync.v
View file @
f7d2ab60
...
...
@@ -40,10 +40,11 @@ Section atomic_sync.
(
∀
(
v
:
val
)
(
g'
:
A
),
ϕ
l
g'
-
★
β
x
g
g'
v
={
E
}=
★
Φ
v
)
⊢
WP
f'
x
@
E
{{
Φ
}}
)}}.
(* XXX (z
gze
hen): 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
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
:
∀
(
g0
:
A
),
...
...
sync.v
View file @
f7d2ab60
...
...
@@ -6,7 +6,8 @@ Section sync.
Context
`
{!
heapG
Σ
}
(
N
:
namespace
).
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
)
:
=
(
□
∀
(
f
:
val
),
WP
s
f
{{
f'
,
synced
R
f'
f
}})%
I
.
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment