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
Rice Wine
Iris
Commits
1a004a76
Commit
1a004a76
authored
May 03, 2018
by
Ralf Jung
Browse files
prove lemmas to compose atomic steps
parent
a8b812f9
Changes
2
Hide whitespace changes
Inline
Side-by-side
theories/bi/lib/atomic.v
View file @
1a004a76
...
...
@@ -24,16 +24,16 @@ Section definition.
((
α
x
={
Ei
,
Eo
}=
∗
P
)
∧
(
∀
y
,
β
x
y
={
Ei
,
Eo
}=
∗
Φ
x
y
))
)%
I
.
Lemma
atomic_step_
mono
Eo
Ei
α
P1
P2
β
Φ
:
□
(
P1
-
∗
P2
)
-
∗
□
(
atomic_step
Eo
Ei
α
P1
β
Φ
-
∗
atomic_step
Eo
Ei
α
P2
β
Φ
).
Lemma
atomic_step_
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
).
Proof
.
iIntros
"
#
HP12
!#
AS"
.
iMod
"AS"
as
(
x
)
"[Hα Hclose]"
.
iIntros
"HP12 AS"
.
iMod
"AS"
as
(
x
)
"[Hα Hclose]"
.
iModIntro
.
iExists
x
.
iFrame
"Hα"
.
iSplit
.
-
iIntros
"Hα"
.
iDestruct
"Hclose"
as
"[Hclose _]"
.
iApply
"HP12"
.
iApply
"Hclose"
.
done
.
-
iIntros
(
y
)
"Hβ"
.
iDestruct
"Hclose"
as
"[_ Hclose]"
.
iApply
"Hclose"
.
done
.
iApply
"HP12"
.
iApply
"Hclose"
.
done
.
Qed
.
Lemma
atomic_step_mask
Eo
Em
α
P
β
Φ
:
...
...
@@ -64,8 +64,8 @@ Section definition.
constructor
.
-
iIntros
(
P1
P2
)
"#HP12"
.
iIntros
([])
"AU"
.
iDestruct
"AU"
as
(
P
)
"[HP #AS]"
.
iExists
P
.
iFrame
.
iIntros
"!# HP"
.
iApply
(
atomic_step_
mono
with
"HP12"
).
i
Apply
"AS"
;
done
.
iIntros
"!# HP"
.
iApply
(
atomic_step_
wand
with
"
[
HP12
]
"
)
;
last
by
iApply
"AS"
.
i
Split
;
last
by
eauto
.
iApply
"HP12"
.
-
intros
??.
solve_proper
.
Qed
.
...
...
@@ -143,7 +143,7 @@ Section lemmas.
iApply
HAU
.
by
iFrame
.
Qed
.
Lemma
astep_intro
Eo
Ei
α
P
β
Φ
x
:
Lemma
astep_intro
x
Eo
Ei
α
P
β
Φ
:
Ei
⊆
Eo
→
α
x
-
∗
((
α
x
={
Eo
}=
∗
P
)
∧
(
∀
y
,
β
x
y
={
Eo
}=
∗
Φ
x
y
))
-
∗
atomic_step
Eo
Ei
α
P
β
Φ
.
...
...
@@ -179,6 +179,79 @@ Section lemmas.
iModIntro
.
destruct
(
γ
'
x'
)
;
iApply
"HΦ"
;
done
.
Qed
.
Lemma
astep_astep
{
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'
))
β
'
(
λ
x'
y'
,
(
α
x
∗
(
P
={
E1
}=
∗
Φ
'
x'
y'
))
∨
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_step
E1
E3
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
"Hupd Hstep"
.
iMod
(
"Hupd"
)
as
(
x
)
"[Hα Hclose]"
.
iMod
(
"Hstep"
with
"Hα"
)
as
(
x'
)
"[Hα' Hclose']"
.
iModIntro
.
iExists
x'
.
iFrame
"Hα'"
.
iSplit
.
-
iIntros
"Hα'"
.
iDestruct
"Hclose'"
as
"[Hclose' _]"
.
iMod
(
"Hclose'"
with
"Hα'"
)
as
"[Hα Hupd]"
.
iDestruct
"Hclose"
as
"[Hclose _]"
.
iMod
(
"Hclose"
with
"Hα"
).
iApply
"Hupd"
.
auto
.
-
iIntros
(
y'
)
"Hβ'"
.
iDestruct
"Hclose'"
as
"[_ Hclose']"
.
iMod
(
"Hclose'"
with
"Hβ'"
)
as
"[[Hα HΦ']|Hcont]"
.
+
(* Abort the step we are eliminating *)
iDestruct
"Hclose"
as
"[Hclose _]"
.
iMod
(
"Hclose"
with
"Hα"
)
as
"HP"
.
iApply
"HΦ'"
.
done
.
+
(* Complete the step we are eliminating *)
iDestruct
"Hclose"
as
"[_ Hclose]"
.
iDestruct
"Hcont"
as
(
y
)
"[Hβ HΦ']"
.
iMod
(
"Hclose"
with
"Hβ"
)
as
"HΦ"
.
iApply
"HΦ'"
.
done
.
Qed
.
Lemma
astep_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'
y'
,
(
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
Φ
'
x'
y'
))
∨
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_step
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
astep_astep
with
"[Hupd] Hstep"
).
iApply
aupd_acc
;
done
.
Qed
.
Lemma
astep_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'
y'
,
∃
y
,
β
x
y
∗
(
Φ
x
y
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_step
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
astep_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_step_wand
;
last
first
.
{
iApply
"Hstep"
.
done
.
}
iSplit
;
first
by
eauto
.
iIntros
(??)
"?"
.
by
iRight
.
Qed
.
Lemma
astep_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'
y'
,
α
x
∗
(
atomic_update
Eo
Em
α
β
Φ
={
E1
}=
∗
Φ
'
x'
y'
)))
-
∗
atomic_step
E1
E2
α
'
P'
β
'
Φ
'
.
Proof
.
iIntros
(?)
"Hupd Hstep"
.
iApply
(
astep_aupd
with
"Hupd"
)
;
first
done
.
iIntros
(
x
)
"Hα"
.
iApply
atomic_step_wand
;
last
first
.
{
iApply
"Hstep"
.
done
.
}
iSplit
;
first
by
eauto
.
iIntros
(??)
"?"
.
by
iLeft
.
Qed
.
End
lemmas
.
(** ProofMode support for atomic updates *)
...
...
theories/heap_lang/lib/increment.v
View file @
1a004a76
...
...
@@ -29,24 +29,24 @@ 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
.
iMod
(
aupd_acc
with
"AU"
)
as
(
x
)
"[H↦ [Hclose _]]"
;
first
solve_ndisj
.
iModIntro
.
iExists
(#
x
,
1
%
Qp
).
iFrame
"H↦"
.
iSplit
;
first
done
.
iIntros
([])
"H↦"
.
iMod
(
"Hclose"
with
"H↦"
)
as
"AU"
.
iIntros
"!> HQ"
.
iAuIntro
.
iApply
(
astep_aupd_abort
with
"AU"
)
;
first
done
.
iIntros
(
x
)
"H↦"
.
iApply
(
astep_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
.
i
Mod
(
aupd_acc
with
"AU"
)
a
s
(
x'
)
"
[
H↦
Hclose]"
;
first
solve_ndisj
.
i
ModIntro
.
iExists
#
x'
.
iFrame
.
iSplit
.
{
i
Destruct
"Hclose"
as
"[Hclose _]"
.
iApply
"Hclose
"
.
}
iIntros
([])
.
destruct
(
decide
(#
x'
=
#
x
))
as
[[=
Hx
]|
Hx
]
.
-
iIntros
"H↦"
.
iDestruct
"Hclose"
as
"[_ Hclose]"
.
subst
.
i
Mod
(
"Hclose"
$!
()
with
"H↦"
)
as
"HΦ"
.
iIntros
"!> HQ"
.
iAuIntro
.
iApply
(
astep_aupd
with
"AU"
)
;
first
done
.
i
Intro
s
(
x'
)
"H↦
"
.
i
Apply
(
astep_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|
iSplit
]
.
{
i
Intros
"$ !> $ !> //
"
.
}
iIntros
([])
"H↦ !>"
.
destruct
(
decide
(#
x'
=
#
x
))
as
[[=
->]|
Hx
]
.
-
i
Right
.
iExists
().
iFrame
.
iIntros
"
HΦ
!> HQ"
.
wp_if
.
by
iApply
"HΦ"
.
-
iDestruct
"Hclose"
as
"[Hclose _]"
.
iIntros
"H↦"
.
iMod
(
"Hclose"
with
"H↦"
)
as
"AU"
.
iIntros
"!> HQ"
.
-
iLeft
.
iFrame
.
iIntros
"AU !> HQ"
.
wp_if
.
iApply
(
"IH"
with
"HQ"
).
done
.
Qed
.
...
...
@@ -70,8 +70,8 @@ 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
(
astep_intro
with
"[H↦]"
)
;
[
solve_ndisj
|
done
|].
iSplit
;
first
by
eauto
10
.
iApply
(
astep_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 *)
done
.
...
...
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