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
Jonas Kastberg
iris
Commits
24f054ec
Commit
24f054ec
authored
Jun 04, 2018
by
Ralf Jung
Browse files
rename atomic_step -> atomic_acc
parent
1a004a76
Changes
2
Hide whitespace changes
Inline
Side-by-side
theories/bi/lib/atomic.v
View file @
24f054ec
...
...
@@ -18,15 +18,16 @@ Section definition.
(
Φ
:
A
→
B
→
PROP
)
(* post-condition *)
.
(** atomic_step as the "introduction form" of atomic updates *)
Definition
atomic_step
Eo
Ei
α
P
β
Φ
:
PROP
:
=
(** atomic_acc as the "introduction form" of atomic updates: An accessor
that can be aborted back to [P]. *)
Definition
atomic_acc
Eo
Ei
α
P
β
Φ
:
PROP
:
=
(|={
Eo
,
Ei
}=>
∃
x
,
α
x
∗
((
α
x
={
Ei
,
Eo
}=
∗
P
)
∧
(
∀
y
,
β
x
y
={
Ei
,
Eo
}=
∗
Φ
x
y
))
)%
I
.
Lemma
atomic_
step
_wand
Eo
Ei
α
P1
P2
β
Φ
1
Φ
2
:
Lemma
atomic_
acc
_wand
Eo
Ei
α
P1
P2
β
Φ
1
Φ
2
:
((
P1
-
∗
P2
)
∧
(
∀
x
y
,
Φ
1
x
y
-
∗
Φ
2
x
y
))
-
∗
(
atomic_
step
Eo
Ei
α
P1
β
Φ
1
-
∗
atomic_
step
Eo
Ei
α
P2
β
Φ
2
).
(
atomic_
acc
Eo
Ei
α
P1
β
Φ
1
-
∗
atomic_
acc
Eo
Ei
α
P2
β
Φ
2
).
Proof
.
iIntros
"HP12 AS"
.
iMod
"AS"
as
(
x
)
"[Hα Hclose]"
.
iModIntro
.
iExists
x
.
iFrame
"Hα"
.
iSplit
.
...
...
@@ -36,8 +37,8 @@ Section definition.
iApply
"HP12"
.
iApply
"Hclose"
.
done
.
Qed
.
Lemma
atomic_
step
_mask
Eo
Em
α
P
β
Φ
:
atomic_
step
Eo
(
Eo
∖
Em
)
α
P
β
Φ
⊣
⊢
∀
E
,
⌜
Eo
⊆
E
⌝
→
atomic_
step
E
(
E
∖
Em
)
α
P
β
Φ
.
Lemma
atomic_
acc
_mask
Eo
Em
α
P
β
Φ
:
atomic_
acc
Eo
(
Eo
∖
Em
)
α
P
β
Φ
⊣
⊢
∀
E
,
⌜
Eo
⊆
E
⌝
→
atomic_
acc
E
(
E
∖
Em
)
α
P
β
Φ
.
Proof
.
iSplit
;
last
first
.
{
iIntros
"Hstep"
.
iApply
(
"Hstep"
with
"[% //]"
).
}
...
...
@@ -50,21 +51,22 @@ Section definition.
-
iIntros
(
y
)
"Hβ"
.
iApply
"Hclose'"
.
iApply
"Hclose"
.
done
.
Qed
.
(** atomic_update as a fixed-point of the equation
(** atomic_update as a fixed-point of the equation
AU = ∃ P. ▷ P ∗ □ (▷ P ==∗ α ∗ (α ==∗ AU) ∧ (β ==∗ Q))
*)
= ∃ P. ▷ P ∗ □ (▷ P -∗ atomic_acc α AU β Q)
*)
Context
Eo
Em
α
β
Φ
.
Definition
atomic_update_pre
(
Ψ
:
()
→
PROP
)
(
_
:
())
:
PROP
:
=
(
∃
(
P
:
PROP
),
▷
P
∗
□
(
▷
P
-
∗
atomic_
step
Eo
(
Eo
∖
Em
)
α
(
Ψ
())
β
Φ
))%
I
.
□
(
▷
P
-
∗
atomic_
acc
Eo
(
Eo
∖
Em
)
α
(
Ψ
())
β
Φ
))%
I
.
Local
Instance
atomic_update_pre_mono
:
BiMonoPred
atomic_update_pre
.
Proof
.
constructor
.
-
iIntros
(
P1
P2
)
"#HP12"
.
iIntros
([])
"AU"
.
iDestruct
"AU"
as
(
P
)
"[HP #AS]"
.
iExists
P
.
iFrame
.
iIntros
"!# HP"
.
iApply
(
atomic_
step
_wand
with
"[HP12]"
)
;
last
by
iApply
"AS"
.
iIntros
"!# HP"
.
iApply
(
atomic_
acc
_wand
with
"[HP12]"
)
;
last
by
iApply
"AS"
.
iSplit
;
last
by
eauto
.
iApply
"HP12"
.
-
intros
??.
solve_proper
.
Qed
.
...
...
@@ -87,14 +89,14 @@ Section lemmas.
Local
Existing
Instance
atomic_update_pre_mono
.
Global
Instance
atomic_
step
_ne
Eo
Em
n
:
Global
Instance
atomic_
acc
_ne
Eo
Em
n
:
Proper
(
pointwise_relation
A
(
dist
n
)
==>
dist
n
==>
pointwise_relation
A
(
pointwise_relation
B
(
dist
n
))
==>
pointwise_relation
A
(
pointwise_relation
B
(
dist
n
))
==>
dist
n
)
(
atomic_
step
(
PROP
:
=
PROP
)
Eo
Em
).
)
(
atomic_
acc
(
PROP
:
=
PROP
)
Eo
Em
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
atomic_update_ne
Eo
Em
n
:
...
...
@@ -112,12 +114,12 @@ Section lemmas.
Lemma
aupd_acc
Eo
Em
E
α
β
Φ
:
Eo
⊆
E
→
atomic_update
Eo
Em
α
β
Φ
-
∗
atomic_
step
E
(
E
∖
Em
)
α
(
atomic_update
Eo
Em
α
β
Φ
)
β
Φ
.
atomic_
acc
E
(
E
∖
Em
)
α
(
atomic_update
Eo
Em
α
β
Φ
)
β
Φ
.
Proof
using
Type
*.
rewrite
atomic_update_eq
{
1
}/
atomic_update_def
/=.
iIntros
(
HE
)
"HUpd"
.
iPoseProof
(
greatest_fixpoint_unfold_1
with
"HUpd"
)
as
"HUpd"
.
iDestruct
"HUpd"
as
(
P
)
"(HP & Hshift)"
.
iRevert
(
E
HE
).
iApply
atomic_
step
_mask
.
iRevert
(
E
HE
).
iApply
atomic_
acc
_mask
.
iApply
"Hshift"
.
done
.
Qed
.
...
...
@@ -132,7 +134,7 @@ Section lemmas.
Lemma
aupd_intro
P
Q
α
β
Eo
Em
Φ
:
Affine
P
→
Persistent
P
→
Laterable
Q
→
(
P
∗
Q
-
∗
atomic_
step
Eo
(
Eo
∖
Em
)
α
Q
β
Φ
)
→
(
P
∗
Q
-
∗
atomic_
acc
Eo
(
Eo
∖
Em
)
α
Q
β
Φ
)
→
P
∗
Q
-
∗
atomic_update
Eo
Em
α
β
Φ
.
Proof
.
rewrite
atomic_update_eq
{
1
}/
atomic_update_def
/=.
...
...
@@ -143,10 +145,10 @@ Section lemmas.
iApply
HAU
.
by
iFrame
.
Qed
.
Lemma
a
step
_intro
x
Eo
Ei
α
P
β
Φ
:
Lemma
a
acc
_intro
x
Eo
Ei
α
P
β
Φ
:
Ei
⊆
Eo
→
α
x
-
∗
((
α
x
={
Eo
}=
∗
P
)
∧
(
∀
y
,
β
x
y
={
Eo
}=
∗
Φ
x
y
))
-
∗
atomic_
step
Eo
Ei
α
P
β
Φ
.
atomic_
acc
Eo
Ei
α
P
β
Φ
.
Proof
.
iIntros
(?)
"Hα Hclose"
.
iMod
fupd_intro_mask'
as
"Hclose'"
;
last
iModIntro
;
first
set_solver
.
...
...
@@ -155,10 +157,10 @@ Section lemmas.
-
iIntros
(
y
)
"Hβ"
.
iMod
"Hclose'"
as
"_"
.
iApply
"Hclose"
.
done
.
Qed
.
Global
Instance
elim_acc_a
step
{
X
}
E1
E2
Ei
(
α
'
β
'
:
X
→
PROP
)
γ
'
α
β
Pas
Φ
:
Global
Instance
elim_acc_a
acc
{
X
}
E1
E2
Ei
(
α
'
β
'
:
X
→
PROP
)
γ
'
α
β
Pas
Φ
:
ElimAcc
(
X
:
=
X
)
(
fupd
E1
E2
)
(
fupd
E2
E1
)
α
'
β
'
γ
'
(
atomic_
step
E1
Ei
α
Pas
β
Φ
)
(
λ
x'
,
atomic_
step
E2
Ei
α
(
β
'
x'
∗
coq_tactics
.
maybe_wand
(
γ
'
x'
)
Pas
)%
I
β
(
atomic_
acc
E1
Ei
α
Pas
β
Φ
)
(
λ
x'
,
atomic_
acc
E2
Ei
α
(
β
'
x'
∗
coq_tactics
.
maybe_wand
(
γ
'
x'
)
Pas
)%
I
β
(
λ
x
y
,
β
'
x'
∗
coq_tactics
.
maybe_wand
(
γ
'
x'
)
(
Φ
x
y
)))%
I
.
Proof
.
rewrite
/
ElimAcc
.
...
...
@@ -179,14 +181,14 @@ Section lemmas.
iModIntro
.
destruct
(
γ
'
x'
)
;
iApply
"HΦ"
;
done
.
Qed
.
Lemma
a
step_astep
{
A'
B'
}
E1
E2
E3
Lemma
a
acc_aacc
{
A'
B'
}
E1
E2
E3
α
P
β
Φ
(
α
'
:
A'
→
PROP
)
P'
(
β
'
Φ
'
:
A'
→
B'
→
PROP
)
:
atomic_
step
E1
E2
α
P
β
Φ
-
∗
(
∀
x
,
α
x
-
∗
atomic_
step
E2
E3
α
'
(
α
x
∗
(
P
={
E1
}=
∗
P'
))
β
'
atomic_
acc
E1
E2
α
P
β
Φ
-
∗
(
∀
x
,
α
x
-
∗
atomic_
acc
E2
E3
α
'
(
α
x
∗
(
P
={
E1
}=
∗
P'
))
β
'
(
λ
x'
y'
,
(
α
x
∗
(
P
={
E1
}=
∗
Φ
'
x'
y'
))
∨
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_
step
E1
E3
α
'
P'
β
'
Φ
'
.
atomic_
acc
E1
E3
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
"Hupd Hstep"
.
iMod
(
"Hupd"
)
as
(
x
)
"[Hα Hclose]"
.
iMod
(
"Hstep"
with
"Hα"
)
as
(
x'
)
"[Hα' Hclose']"
.
...
...
@@ -208,46 +210,46 @@ Section lemmas.
iApply
"HΦ'"
.
done
.
Qed
.
Lemma
a
step
_aupd
{
A'
B'
}
E1
E2
Eo
Em
Lemma
a
acc
_aupd
{
A'
B'
}
E1
E2
Eo
Em
α
β
Φ
(
α
'
:
A'
→
PROP
)
P'
(
β
'
Φ
'
:
A'
→
B'
→
PROP
)
:
Eo
⊆
E1
→
atomic_update
Eo
Em
α
β
Φ
-
∗
(
∀
x
,
α
x
-
∗
atomic_
step
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
∀
x
,
α
x
-
∗
atomic_
acc
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
λ
x'
y'
,
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
Φ
'
x'
y'
))
∨
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_
step
E1
E2
α
'
P'
β
'
Φ
'
.
atomic_
acc
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
step_astep
with
"[Hupd] Hstep"
).
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
acc_aacc
with
"[Hupd] Hstep"
).
iApply
aupd_acc
;
done
.
Qed
.
Lemma
a
step
_aupd_commit
{
A'
B'
}
E1
E2
Eo
Em
Lemma
a
acc
_aupd_commit
{
A'
B'
}
E1
E2
Eo
Em
α
β
Φ
(
α
'
:
A'
→
PROP
)
P'
(
β
'
Φ
'
:
A'
→
B'
→
PROP
)
:
Eo
⊆
E1
→
atomic_update
Eo
Em
α
β
Φ
-
∗
(
∀
x
,
α
x
-
∗
atomic_
step
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
∀
x
,
α
x
-
∗
atomic_
acc
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
λ
x'
y'
,
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_
step
E1
E2
α
'
P'
β
'
Φ
'
.
atomic_
acc
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
step
_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_
step
_wand
;
last
first
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
acc
_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_
acc
_wand
;
last
first
.
{
iApply
"Hstep"
.
done
.
}
iSplit
;
first
by
eauto
.
iIntros
(??)
"?"
.
by
iRight
.
Qed
.
Lemma
a
step
_aupd_abort
{
A'
B'
}
E1
E2
Eo
Em
Lemma
a
acc
_aupd_abort
{
A'
B'
}
E1
E2
Eo
Em
α
β
Φ
(
α
'
:
A'
→
PROP
)
P'
(
β
'
Φ
'
:
A'
→
B'
→
PROP
)
:
Eo
⊆
E1
→
atomic_update
Eo
Em
α
β
Φ
-
∗
(
∀
x
,
α
x
-
∗
atomic_
step
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
∀
x
,
α
x
-
∗
atomic_
acc
(
E1
∖
Em
)
E2
α
'
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
P'
))
β
'
(
λ
x'
y'
,
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_
step
E1
E2
α
'
P'
β
'
Φ
'
.
atomic_
acc
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
step
_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_
step
_wand
;
last
first
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
a
acc
_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_
acc
_wand
;
last
first
.
{
iApply
"Hstep"
.
done
.
}
iSplit
;
first
by
eauto
.
iIntros
(??)
"?"
.
by
iLeft
.
Qed
.
...
...
@@ -264,13 +266,13 @@ Section proof_mode.
Timeless
(
PROP
:
=
PROP
)
emp
→
TCForall
Laterable
(
env_to_list
Γ
s
)
→
P
=
prop_of_env
Γ
s
→
envs_entails
(
Envs
Γ
p
Γ
s
n
)
(
atomic_
step
Eo
(
Eo
∖
Em
)
α
P
β
Φ
)
→
envs_entails
(
Envs
Γ
p
Γ
s
n
)
(
atomic_
acc
Eo
(
Eo
∖
Em
)
α
P
β
Φ
)
→
envs_entails
(
Envs
Γ
p
Γ
s
n
)
(
atomic_update
Eo
Em
α
β
Φ
).
Proof
.
intros
?
H
Γ
s
->.
rewrite
envs_entails_eq
of_envs_eq'
/
atomic_
step
/=.
intros
?
H
Γ
s
->.
rewrite
envs_entails_eq
of_envs_eq'
/
atomic_
acc
/=.
setoid_rewrite
prop_of_env_sound
=>
HAU
.
apply
aupd_intro
;
[
apply
_
..|].
done
.
Qed
.
Qed
.
End
proof_mode
.
(** Now the coq-level tactics *)
...
...
theories/heap_lang/lib/increment.v
View file @
24f054ec
...
...
@@ -29,18 +29,18 @@ Section increment.
iIntros
(
Q
Φ
)
"HQ AU"
.
iL
ö
b
as
"IH"
.
wp_let
.
wp_apply
(
load_spec
with
"[HQ]"
)
;
first
by
iAccu
.
(* Prove the atomic shift for load *)
iAuIntro
.
iApply
(
a
step
_aupd_abort
with
"AU"
)
;
first
done
.
iAuIntro
.
iApply
(
a
acc
_aupd_abort
with
"AU"
)
;
first
done
.
iIntros
(
x
)
"H↦"
.
iApply
(
a
step
_intro
(
_
,
_
)
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
iApply
(
a
acc
_intro
(
_
,
_
)
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
{
iIntros
"$ !> $ !> //"
.
}
iIntros
([])
"$ !> AU !> HQ"
.
(* Now go on *)
wp_let
.
wp_op
.
wp_bind
(
aheap
.(
cas
)
_
)%
I
.
wp_apply
(
cas_spec
with
"[HQ]"
)
;
first
by
iAccu
.
(* Prove the atomic shift for CAS *)
iAuIntro
.
iApply
(
a
step
_aupd
with
"AU"
)
;
first
done
.
iAuIntro
.
iApply
(
a
acc
_aupd
with
"AU"
)
;
first
done
.
iIntros
(
x'
)
"H↦"
.
iApply
(
a
step
_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
iApply
(
a
acc
_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
{
iIntros
"$ !> $ !> //"
.
}
iIntros
([])
"H↦ !>"
.
destruct
(
decide
(#
x'
=
#
x
))
as
[[=
->]|
Hx
].
...
...
@@ -70,7 +70,7 @@ Section increment_client.
iAssert
(
□
WP
incr
primitive_atomic_heap
#
l
{{
_
,
True
}})%
I
as
"#Aupd"
.
{
iAlways
.
wp_apply
(
incr_spec
with
"[]"
)
;
first
by
iAccu
.
clear
x
.
iAuIntro
.
iInv
nroot
as
(
x
)
">H↦"
.
iApply
(
a
step
_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
iApply
(
a
acc
_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
].
{
by
eauto
10
.
}
iIntros
([])
"H↦ !>"
.
iSplitL
"H↦"
;
first
by
eauto
10
.
(* The continuation: From after the atomic triple to the postcondition of the WP *)
...
...
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