Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Pierre-Marie Pédrot
Iris
Commits
28c4a0bf
Commit
28c4a0bf
authored
Feb 10, 2016
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Change wp to have a view shift in the value case.
parent
877ff848
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
83 additions
and
76 deletions
+83
-76
program_logic/adequacy.v
program_logic/adequacy.v
+6
-8
program_logic/hoare.v
program_logic/hoare.v
+11
-16
program_logic/hoare_lifting.v
program_logic/hoare_lifting.v
+1
-1
program_logic/invariants.v
program_logic/invariants.v
+1
-4
program_logic/lifting.v
program_logic/lifting.v
+1
-1
program_logic/weakestpre.v
program_logic/weakestpre.v
+63
-46
No files found.
program_logic/adequacy.v
View file @
28c4a0bf
...
@@ -55,21 +55,19 @@ Lemma ht_adequacy_steps P Q k n e1 t2 σ1 σ2 r1 :
...
@@ -55,21 +55,19 @@ Lemma ht_adequacy_steps P Q k n e1 t2 σ1 σ2 r1 :
nsteps
step
k
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
nsteps
step
k
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
1
<
n
→
wsat
(
k
+
n
)
coPset_all
σ
1
r1
→
1
<
n
→
wsat
(
k
+
n
)
coPset_all
σ
1
r1
→
P
(
k
+
n
)
r1
→
P
(
k
+
n
)
r1
→
∃
rs2
Qs'
,
wptp
n
t2
((
λ
v
,
pvs
coPset_all
coPset_all
(
Q
v
))
::
Qs'
)
rs2
∧
∃
rs2
Qs'
,
wptp
n
t2
(
Q
::
Qs'
)
rs2
∧
wsat
n
coPset_all
σ
2
(
big_op
rs2
).
wsat
n
coPset_all
σ
2
(
big_op
rs2
).
Proof
.
Proof
.
intros
Hht
????
;
apply
(
nsteps_wptp
[
pvs
coPset_all
coPset_all
∘
Q
]
k
n
intros
Hht
????
;
apply
(
nsteps_wptp
[
Q
]
k
n
([
e1
],
σ
1
)
(
t2
,
σ
2
)
[
r1
])
;
([
e1
],
σ
1
)
(
t2
,
σ
2
)
[
r1
])
;
rewrite
/
big_op
?right_id
;
auto
.
rewrite
/
big_op
?right_id
;
auto
.
constructor
;
last
constructor
.
constructor
;
last
constructor
.
apply
Hht
with
r1
(
k
+
n
)
;
eauto
using
cmra_included_unit
.
apply
Hht
with
r1
(
k
+
n
)
;
eauto
using
cmra_included_unit
.
by
destruct
(
k
+
n
)
.
eapply
uPred
.
const_intro
;
eauto
.
Qed
.
Qed
.
Lemma
ht_adequacy_own
Q
e1
t2
σ
1
m
σ
2
:
Lemma
ht_adequacy_own
Q
e1
t2
σ
1
m
σ
2
:
✓
m
→
✓
m
→
{{
ownP
σ
1
★
ownG
m
}}
e1
@
coPset_all
{{
Q
}}
→
{{
ownP
σ
1
★
ownG
m
}}
e1
@
coPset_all
{{
Q
}}
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
∃
rs2
Qs'
,
wptp
3
t2
((
λ
v
,
pvs
coPset_all
coPset_all
(
Q
v
))
::
Qs'
)
rs2
∧
∃
rs2
Qs'
,
wptp
3
t2
(
Q
::
Qs'
)
rs2
∧
wsat
3
coPset_all
σ
2
(
big_op
rs2
).
wsat
3
coPset_all
σ
2
(
big_op
rs2
).
Proof
.
Proof
.
intros
Hv
?
[
k
?]%
rtc_nsteps
.
intros
Hv
?
[
k
?]%
rtc_nsteps
.
eapply
ht_adequacy_steps
with
(
r1
:
=
(
Res
∅
(
Excl
σ
1
)
(
Some
m
)))
;
eauto
;
[|].
eapply
ht_adequacy_steps
with
(
r1
:
=
(
Res
∅
(
Excl
σ
1
)
(
Some
m
)))
;
eauto
;
[|].
...
@@ -103,7 +101,7 @@ Proof.
...
@@ -103,7 +101,7 @@ Proof.
destruct
(
ht_adequacy_own
Q
e1
t2
σ
1
m
σ
2
)
as
(
rs2
&
Qs
&?&?)
;
auto
.
destruct
(
ht_adequacy_own
Q
e1
t2
σ
1
m
σ
2
)
as
(
rs2
&
Qs
&?&?)
;
auto
.
{
by
rewrite
-(
ht_mask_weaken
E
coPset_all
).
}
{
by
rewrite
-(
ht_mask_weaken
E
coPset_all
).
}
destruct
(
Forall3_lookup_l
(
λ
e
Q
r
,
wp
coPset_all
e
Q
3
r
)
t2
destruct
(
Forall3_lookup_l
(
λ
e
Q
r
,
wp
coPset_all
e
Q
3
r
)
t2
(
pvs
coPset_all
coPset_all
∘
Q
::
Qs
)
rs2
i
e2
)
as
(
Q'
&
r2
&?&?&
Hwp
)
;
auto
.
(
Q
::
Qs
)
rs2
i
e2
)
as
(
Q'
&
r2
&?&?&
Hwp
)
;
auto
.
destruct
(
wp_step_inv
coPset_all
∅
Q'
e2
2
3
σ
2
r2
(
big_op
(
delete
i
rs2
)))
;
destruct
(
wp_step_inv
coPset_all
∅
Q'
e2
2
3
σ
2
r2
(
big_op
(
delete
i
rs2
)))
;
rewrite
?right_id_L
?big_op_delete
;
auto
.
rewrite
?right_id_L
?big_op_delete
;
auto
.
Qed
.
Qed
.
...
...
program_logic/hoare.v
View file @
28c4a0bf
Require
Export
program_logic
.
weakestpre
program_logic
.
viewshifts
.
Require
Export
program_logic
.
weakestpre
program_logic
.
viewshifts
.
Definition
ht
{
Λ
Σ
}
(
E
:
coPset
)
(
P
:
iProp
Λ
Σ
)
Definition
ht
{
Λ
Σ
}
(
E
:
coPset
)
(
P
:
iProp
Λ
Σ
)
(
e
:
expr
Λ
)
(
Q
:
val
Λ
→
iProp
Λ
Σ
)
:
iProp
Λ
Σ
:
=
(
e
:
expr
Λ
)
(
Q
:
val
Λ
→
iProp
Λ
Σ
)
:
iProp
Λ
Σ
:
=
(
□
(
P
→
wp
E
e
Q
))%
I
.
(
□
(
P
→
wp
E
e
(
λ
v
,
pvs
E
E
(
Q
v
))))%
I
.
Instance
:
Params
(@
ht
)
3
.
Instance
:
Params
(@
ht
)
3
.
Notation
"{{ P } } e @ E {{ Q } }"
:
=
(
ht
E
P
e
Q
)
Notation
"{{ P } } e @ E {{ Q } }"
:
=
(
ht
E
P
e
Q
)
...
@@ -25,16 +24,16 @@ Global Instance ht_proper E :
...
@@ -25,16 +24,16 @@ Global Instance ht_proper E :
Proof
.
by
intros
P
P'
HP
e
?
<-
Q
Q'
HQ
;
rewrite
/
ht
HP
;
setoid_rewrite
HQ
.
Qed
.
Proof
.
by
intros
P
P'
HP
e
?
<-
Q
Q'
HQ
;
rewrite
/
ht
HP
;
setoid_rewrite
HQ
.
Qed
.
Lemma
ht_mono
E
P
P'
Q
Q'
e
:
Lemma
ht_mono
E
P
P'
Q
Q'
e
:
P
⊑
P'
→
(
∀
v
,
Q'
v
⊑
Q
v
)
→
{{
P'
}}
e
@
E
{{
Q'
}}
⊑
{{
P
}}
e
@
E
{{
Q
}}.
P
⊑
P'
→
(
∀
v
,
Q'
v
⊑
Q
v
)
→
{{
P'
}}
e
@
E
{{
Q'
}}
⊑
{{
P
}}
e
@
E
{{
Q
}}.
Proof
.
by
intros
HP
HQ
;
rewrite
/
ht
-
HP
;
setoid_rewrite
HQ
.
Qed
.
Proof
.
by
intros
;
apply
always_mono
,
impl_mono
,
wp_mono
.
Qed
.
Global
Instance
ht_mono'
E
:
Global
Instance
ht_mono'
E
:
Proper
(
flip
(
⊑
)
==>
eq
==>
pointwise_relation
_
(
⊑
)
==>
(
⊑
))
(@
ht
Λ
Σ
E
).
Proper
(
flip
(
⊑
)
==>
eq
==>
pointwise_relation
_
(
⊑
)
==>
(
⊑
))
(@
ht
Λ
Σ
E
).
Proof
.
by
intros
P
P'
HP
e
?
<-
Q
Q'
HQ
;
apply
ht_mono
.
Qed
.
Proof
.
by
intros
P
P'
HP
e
?
<-
Q
Q'
HQ
;
apply
ht_mono
.
Qed
.
Lemma
ht_val
E
v
:
Lemma
ht_val
E
v
:
{{
True
:
iProp
Λ
Σ
}}
of_val
v
@
E
{{
λ
v'
,
■
(
v
=
v'
)
}}.
{{
True
:
iProp
Λ
Σ
}}
of_val
v
@
E
{{
λ
v'
,
v
=
v'
}}.
Proof
.
Proof
.
apply
(
always_intro'
_
_
),
impl_intro_l
.
apply
(
always_intro'
_
_
),
impl_intro_l
.
by
rewrite
-
wp_value
-
pvs_intro
;
apply
const_intro
.
by
rewrite
-
wp_value
;
apply
const_intro
.
Qed
.
Qed
.
Lemma
ht_vs
E
P
P'
Q
Q'
e
:
Lemma
ht_vs
E
P
P'
Q
Q'
e
:
(
P
={
E
}=>
P'
∧
{{
P'
}}
e
@
E
{{
Q'
}}
∧
∀
v
,
Q'
v
={
E
}=>
Q
v
)
(
P
={
E
}=>
P'
∧
{{
P'
}}
e
@
E
{{
Q'
}}
∧
∀
v
,
Q'
v
={
E
}=>
Q
v
)
...
@@ -42,9 +41,9 @@ Lemma ht_vs E P P' Q Q' e :
...
@@ -42,9 +41,9 @@ Lemma ht_vs E P P' Q Q' e :
Proof
.
Proof
.
apply
(
always_intro'
_
_
),
impl_intro_l
.
apply
(
always_intro'
_
_
),
impl_intro_l
.
rewrite
(
associative
_
P
)
{
1
}/
vs
always_elim
impl_elim_r
.
rewrite
(
associative
_
P
)
{
1
}/
vs
always_elim
impl_elim_r
.
rewrite
(
associative
_
)
pvs_impl_r
pvs_always_r
wp_always_r
.
rewrite
associative
pvs_impl_r
pvs_always_r
wp_always_r
.
rewrite
wp_pvs
;
apply
wp_mono
=>
v
.
rewrite
-(
pvs_wp
E
e
Q
)
-(
wp_pvs
E
e
Q
)
;
apply
pvs_mono
,
wp_mono
=>
v
.
by
rewrite
(
forall_elim
v
)
pvs_impl_r
!
pvs_trans'
.
by
rewrite
(
forall_elim
v
)
{
1
}/
vs
always_elim
impl_elim_r
.
Qed
.
Qed
.
Lemma
ht_atomic
E1
E2
P
P'
Q
Q'
e
:
Lemma
ht_atomic
E1
E2
P
P'
Q
Q'
e
:
E2
⊆
E1
→
atomic
e
→
E2
⊆
E1
→
atomic
e
→
...
@@ -55,7 +54,7 @@ Proof.
...
@@ -55,7 +54,7 @@ Proof.
rewrite
(
associative
_
P
)
{
1
}/
vs
always_elim
impl_elim_r
.
rewrite
(
associative
_
P
)
{
1
}/
vs
always_elim
impl_elim_r
.
rewrite
(
associative
_
)
pvs_impl_r
pvs_always_r
wp_always_r
.
rewrite
(
associative
_
)
pvs_impl_r
pvs_always_r
wp_always_r
.
rewrite
-(
wp_atomic
E1
E2
)
//
;
apply
pvs_mono
,
wp_mono
=>
v
.
rewrite
-(
wp_atomic
E1
E2
)
//
;
apply
pvs_mono
,
wp_mono
=>
v
.
rewrite
(
forall_elim
v
)
pvs_impl_r
-(
pvs_intro
E1
)
pvs_trans
;
solve
_el
e
m_
of
.
by
rewrite
(
forall_elim
v
)
{
1
}/
vs
always_elim
impl
_el
i
m_
r
.
Qed
.
Qed
.
Lemma
ht_bind
`
{
LanguageCtx
Λ
K
}
E
P
Q
Q'
e
:
Lemma
ht_bind
`
{
LanguageCtx
Λ
K
}
E
P
Q
Q'
e
:
({{
P
}}
e
@
E
{{
Q
}}
∧
∀
v
,
{{
Q
v
}}
K
(
of_val
v
)
@
E
{{
Q'
}})
({{
P
}}
e
@
E
{{
Q
}}
∧
∀
v
,
{{
Q
v
}}
K
(
of_val
v
)
@
E
{{
Q'
}})
...
@@ -64,21 +63,17 @@ Proof.
...
@@ -64,21 +63,17 @@ Proof.
intros
;
apply
(
always_intro'
_
_
),
impl_intro_l
.
intros
;
apply
(
always_intro'
_
_
),
impl_intro_l
.
rewrite
(
associative
_
P
)
{
1
}/
ht
always_elim
impl_elim_r
.
rewrite
(
associative
_
P
)
{
1
}/
ht
always_elim
impl_elim_r
.
rewrite
wp_always_r
-
wp_bind
//
;
apply
wp_mono
=>
v
.
rewrite
wp_always_r
-
wp_bind
//
;
apply
wp_mono
=>
v
.
rewrite
(
forall_elim
v
)
pvs_impl_r
wp_pvs
;
apply
wp_mono
=>
v'
.
by
rewrite
(
forall_elim
v
)
/
ht
always_elim
impl_elim_r
.
by
rewrite
pvs_trans'
.
Qed
.
Qed
.
Lemma
ht_mask_weaken
E1
E2
P
Q
e
:
Lemma
ht_mask_weaken
E1
E2
P
Q
e
:
E1
⊆
E2
→
{{
P
}}
e
@
E1
{{
Q
}}
⊑
{{
P
}}
e
@
E2
{{
Q
}}.
E1
⊆
E2
→
{{
P
}}
e
@
E1
{{
Q
}}
⊑
{{
P
}}
e
@
E2
{{
Q
}}.
Proof
.
Proof
.
intros
.
by
apply
always_mono
,
impl_mono
,
wp_mask_frame_mono
.
Qed
.
intros
;
apply
always_mono
,
impl_intro_l
;
rewrite
impl_elim_r
.
by
rewrite
-(
wp_mask_weaken
E1
)
//
;
apply
wp_mono
=>
v
;
apply
pvs_mask_weaken
.
Qed
.
Lemma
ht_frame_l
E
P
Q
R
e
:
Lemma
ht_frame_l
E
P
Q
R
e
:
{{
P
}}
e
@
E
{{
Q
}}
⊑
{{
R
★
P
}}
e
@
E
{{
λ
v
,
R
★
Q
v
}}.
{{
P
}}
e
@
E
{{
Q
}}
⊑
{{
R
★
P
}}
e
@
E
{{
λ
v
,
R
★
Q
v
}}.
Proof
.
Proof
.
apply
always_intro
,
impl_intro_l
.
apply
always_intro
,
impl_intro_l
.
rewrite
always_and_sep_r
-(
associative
_
)
(
sep_and
P
)
always_elim
impl_elim_r
.
rewrite
always_and_sep_r
-(
associative
_
)
(
sep_and
P
)
always_elim
impl_elim_r
.
by
rewrite
wp_frame_l
;
apply
wp_mono
=>
v
;
rewrite
pvs_frame_l
.
by
rewrite
wp_frame_l
.
Qed
.
Qed
.
Lemma
ht_frame_r
E
P
Q
R
e
:
Lemma
ht_frame_r
E
P
Q
R
e
:
{{
P
}}
e
@
E
{{
Q
}}
⊑
{{
P
★
R
}}
e
@
E
{{
λ
v
,
Q
v
★
R
}}.
{{
P
}}
e
@
E
{{
Q
}}
⊑
{{
P
★
R
}}
e
@
E
{{
λ
v
,
Q
v
★
R
}}.
...
...
program_logic/hoare_lifting.v
View file @
28c4a0bf
...
@@ -68,7 +68,7 @@ Proof.
...
@@ -68,7 +68,7 @@ Proof.
by
repeat
apply
and_intro
;
try
apply
const_intro
.
by
repeat
apply
and_intro
;
try
apply
const_intro
.
*
apply
(
always_intro'
_
_
),
impl_intro_l
;
rewrite
and_elim_l
.
*
apply
(
always_intro'
_
_
),
impl_intro_l
;
rewrite
and_elim_l
.
rewrite
-
always_and_sep_r'
;
apply
const_elim_r
=>-[[
v
Hv
]
?].
rewrite
-
always_and_sep_r'
;
apply
const_elim_r
=>-[[
v
Hv
]
?].
rewrite
-(
of_to_val
e2
v
)
//
-
wp_value
-
pvs_intro
.
rewrite
-(
of_to_val
e2
v
)
//
-
wp_value
.
rewrite
-(
exist_intro
σ
2
)
-(
exist_intro
ef
)
(
of_to_val
e2
)
//.
rewrite
-(
exist_intro
σ
2
)
-(
exist_intro
ef
)
(
of_to_val
e2
)
//.
by
rewrite
-
always_and_sep_r'
;
apply
and_intro
;
try
apply
const_intro
.
by
rewrite
-
always_and_sep_r'
;
apply
and_intro
;
try
apply
const_intro
.
Qed
.
Qed
.
...
...
program_logic/invariants.v
View file @
28c4a0bf
...
@@ -110,9 +110,6 @@ Proof.
...
@@ -110,9 +110,6 @@ Proof.
Qed
.
Qed
.
Lemma
pvs_alloc
N
P
:
▷
P
⊑
pvs
N
N
(
inv
N
P
).
Lemma
pvs_alloc
N
P
:
▷
P
⊑
pvs
N
N
(
inv
N
P
).
Proof
.
Proof
.
by
rewrite
/
inv
(
pvs_allocI
N
)
;
last
apply
coPset_suffixes_infinite
.
Qed
.
rewrite
/
inv
(
pvs_allocI
N
)
;
first
done
.
apply
coPset_suffixes_infinite
.
Qed
.
End
inv
.
End
inv
.
program_logic/lifting.v
View file @
28c4a0bf
...
@@ -74,7 +74,7 @@ Proof.
...
@@ -74,7 +74,7 @@ Proof.
apply
const_elim_l
=>-[
v2'
[
Hv
?]]
/=.
apply
const_elim_l
=>-[
v2'
[
Hv
?]]
/=.
rewrite
-
pvs_intro
.
rewrite
-
pvs_intro
.
rewrite
(
forall_elim
v2'
)
(
forall_elim
σ
2
'
)
(
forall_elim
ef
)
const_equiv
//.
rewrite
(
forall_elim
v2'
)
(
forall_elim
σ
2
'
)
(
forall_elim
ef
)
const_equiv
//.
by
rewrite
left_id
wand_elim_r
-(
wp_value'
_
_
e2'
).
by
rewrite
left_id
wand_elim_r
-(
wp_value'
_
_
e2'
v2'
).
Qed
.
Qed
.
Lemma
wp_lift_atomic_det_step
{
E
Q
e1
}
σ
1
v2
σ
2
ef
:
Lemma
wp_lift_atomic_det_step
{
E
Q
e1
}
σ
1
v2
σ
2
ef
:
...
...
program_logic/weakestpre.v
View file @
28c4a0bf
...
@@ -3,6 +3,7 @@ Require Import program_logic.wsat.
...
@@ -3,6 +3,7 @@ Require Import program_logic.wsat.
Local
Hint
Extern
10
(
_
≤
_
)
=>
omega
.
Local
Hint
Extern
10
(
_
≤
_
)
=>
omega
.
Local
Hint
Extern
100
(@
eq
coPset
_
_
)
=>
eassumption
||
solve_elem_of
.
Local
Hint
Extern
100
(@
eq
coPset
_
_
)
=>
eassumption
||
solve_elem_of
.
Local
Hint
Extern
100
(
_
∉
_
)
=>
solve_elem_of
.
Local
Hint
Extern
100
(
_
∉
_
)
=>
solve_elem_of
.
Local
Hint
Extern
100
(@
subseteq
coPset
_
_
_
)
=>
solve_elem_of
.
Local
Hint
Extern
10
(
✓
{
_
}
_
)
=>
Local
Hint
Extern
10
(
✓
{
_
}
_
)
=>
repeat
match
goal
with
H
:
wsat
_
_
_
_
|-
_
=>
apply
wsat_valid
in
H
end
;
repeat
match
goal
with
H
:
wsat
_
_
_
_
|-
_
=>
apply
wsat_valid
in
H
end
;
solve_validN
.
solve_validN
.
...
@@ -19,7 +20,7 @@ Record wp_go {Λ Σ} (E : coPset) (Q Qfork : expr Λ → nat → iRes Λ Σ →
...
@@ -19,7 +20,7 @@ Record wp_go {Λ Σ} (E : coPset) (Q Qfork : expr Λ → nat → iRes Λ Σ →
}.
}.
CoInductive
wp_pre
{
Λ
Σ
}
(
E
:
coPset
)
CoInductive
wp_pre
{
Λ
Σ
}
(
E
:
coPset
)
(
Q
:
val
Λ
→
iProp
Λ
Σ
)
:
expr
Λ
→
nat
→
iRes
Λ
Σ
→
Prop
:
=
(
Q
:
val
Λ
→
iProp
Λ
Σ
)
:
expr
Λ
→
nat
→
iRes
Λ
Σ
→
Prop
:
=
|
wp_pre_value
n
r
v
:
Q
v
n
r
→
wp_pre
E
Q
(
of_val
v
)
n
r
|
wp_pre_value
n
r
v
:
pvs
E
E
(
Q
v
)
n
r
→
wp_pre
E
Q
(
of_val
v
)
n
r
|
wp_pre_step
n
r1
e1
:
|
wp_pre_step
n
r1
e1
:
to_val
e1
=
None
→
to_val
e1
=
None
→
(
∀
rf
k
Ef
σ
1
,
(
∀
rf
k
Ef
σ
1
,
...
@@ -62,33 +63,45 @@ Implicit Types v : val Λ.
...
@@ -62,33 +63,45 @@ Implicit Types v : val Λ.
Implicit
Types
e
:
expr
Λ
.
Implicit
Types
e
:
expr
Λ
.
Transparent
uPred_holds
.
Transparent
uPred_holds
.
Lemma
wp_weaken
E1
E2
e
Q1
Q2
r
n
n'
:
Global
Instance
wp_ne
E
e
n
:
E1
⊆
E2
→
(
∀
v
r
n'
,
n'
≤
n
→
✓
{
n'
}
r
→
Q1
v
n'
r
→
Q2
v
n'
r
)
→
Proper
(
pointwise_relation
_
(
dist
n
)
==>
dist
n
)
(@
wp
Λ
Σ
E
e
).
n'
≤
n
→
✓
{
n'
}
r
→
wp
E1
e
Q1
n'
r
→
wp
E2
e
Q2
n'
r
.
Proof
.
Proof
.
intros
HE
HQ
;
revert
e
r
;
induction
n'
as
[
n'
IH
]
using
lt_wf_ind
;
intros
e
r
.
cut
(
∀
Q1
Q2
,
(
∀
v
,
Q1
v
={
n
}=
Q2
v
)
→
destruct
3
as
[|
n'
r
e1
?
Hgo
]
;
constructor
;
eauto
.
∀
r
n'
,
n'
≤
n
→
✓
{
n'
}
r
→
wp
E
e
Q1
n'
r
→
wp
E
e
Q2
n'
r
).
intros
rf
k
Ef
σ
1
???.
{
by
intros
help
Q
Q'
HQ
;
split
;
apply
help
.
}
assert
(
E2
∪
Ef
=
E1
∪
(
E2
∖
E1
∪
Ef
))
as
HE'
.
intros
Q1
Q2
HQ
r
n'
;
revert
e
r
.
{
by
rewrite
associative_L
-
union_difference_L
.
}
induction
n'
as
[
n'
IH
]
using
lt_wf_ind
=>
e
r
.
destruct
(
Hgo
rf
k
((
E2
∖
E1
)
∪
Ef
)
σ
1
)
as
[
Hsafe
Hstep
]
;
rewrite
-
?HE'
;
auto
.
destruct
3
as
[
n'
r
v
HpvsQ
|
n'
r
e1
?
Hgo
].
{
constructor
.
by
eapply
pvs_ne
,
HpvsQ
;
eauto
.
}
constructor
;
[
done
|]=>
rf
k
Ef
σ
1
???.
destruct
(
Hgo
rf
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
split
;
[
done
|
intros
e2
σ
2
ef
?].
split
;
[
done
|
intros
e2
σ
2
ef
?].
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&?&?)
;
auto
.
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&?&?)
;
auto
.
exists
r2
,
r2'
;
split_ands
;
[
rewrite
HE'
|
eapply
IH
|]
;
eauto
.
exists
r2
,
r2'
;
split_ands
;
[|
eapply
IH
|]
;
eauto
.
Qed
.
Qed
.
Global
Instance
wp_ne
E
e
n
:
Proper
(
pointwise_relation
_
(
dist
n
)
==>
dist
n
)
(@
wp
Λ
Σ
E
e
).
Proof
.
by
intros
Q
Q'
HQ
;
split
;
apply
wp_weaken
with
n
;
try
apply
HQ
.
Qed
.
Global
Instance
wp_proper
E
e
:
Global
Instance
wp_proper
E
e
:
Proper
(
pointwise_relation
_
(
≡
)
==>
(
≡
))
(@
wp
Λ
Σ
E
e
).
Proper
(
pointwise_relation
_
(
≡
)
==>
(
≡
))
(@
wp
Λ
Σ
E
e
).
Proof
.
Proof
.
by
intros
Q
Q'
?
;
apply
equiv_dist
=>
n
;
apply
wp_ne
=>
v
;
apply
equiv_dist
.
by
intros
Q
Q'
?
;
apply
equiv_dist
=>
n
;
apply
wp_ne
=>
v
;
apply
equiv_dist
.
Qed
.
Qed
.
Lemma
wp_mask_frame_mono
E1
E2
e
Q1
Q2
:
E1
⊆
E2
→
(
∀
v
,
Q1
v
⊑
Q2
v
)
→
wp
E1
e
Q1
⊑
wp
E2
e
Q2
.
Proof
.
intros
HE
HQ
r
n
;
revert
e
r
;
induction
n
as
[
n
IH
]
using
lt_wf_ind
=>
e
r
.
destruct
2
as
[
n'
r
v
HpvsQ
|
n'
r
e1
?
Hgo
].
{
constructor
;
eapply
pvs_mask_frame_mono
,
HpvsQ
;
eauto
.
}
constructor
;
[
done
|]=>
rf
k
Ef
σ
1
???.
assert
(
E2
∪
Ef
=
E1
∪
(
E2
∖
E1
∪
Ef
))
as
HE'
.
{
by
rewrite
associative_L
-
union_difference_L
.
}
destruct
(
Hgo
rf
k
((
E2
∖
E1
)
∪
Ef
)
σ
1
)
as
[
Hsafe
Hstep
]
;
rewrite
-
?HE'
;
auto
.
split
;
[
done
|
intros
e2
σ
2
ef
?].
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&?&?)
;
auto
.
exists
r2
,
r2'
;
split_ands
;
[
rewrite
HE'
|
eapply
IH
|]
;
eauto
.
Qed
.
Lemma
wp_value_inv
E
Q
v
n
r
:
wp
E
(
of_val
v
)
Q
n
r
→
Q
v
n
r
.
Lemma
wp_value_inv
E
Q
v
n
r
:
wp
E
(
of_val
v
)
Q
n
r
→
pvs
E
E
(
Q
v
)
n
r
.
Proof
.
Proof
.
inversion
1
as
[|???
He
]
;
simplify_equality
;
auto
.
by
inversion
1
as
[|???
He
]
;
[|
rewrite
?to_of_val
in
He
]
;
simplify_equality
.
by
rewrite
?to_of_val
in
He
.
Qed
.
Qed
.
Lemma
wp_step_inv
E
Ef
Q
e
k
n
σ
r
rf
:
Lemma
wp_step_inv
E
Ef
Q
e
k
n
σ
r
rf
:
to_val
e
=
None
→
1
<
k
<
n
→
E
∩
Ef
=
∅
→
to_val
e
=
None
→
1
<
k
<
n
→
E
∩
Ef
=
∅
→
...
@@ -97,22 +110,27 @@ Lemma wp_step_inv E Ef Q e k n σ r rf :
...
@@ -97,22 +110,27 @@ Lemma wp_step_inv E Ef Q e k n σ r rf :
Proof
.
intros
He
;
destruct
3
;
[
by
rewrite
?to_of_val
in
He
|
eauto
].
Qed
.
Proof
.
intros
He
;
destruct
3
;
[
by
rewrite
?to_of_val
in
He
|
eauto
].
Qed
.
Lemma
wp_value
E
Q
v
:
Q
v
⊑
wp
E
(
of_val
v
)
Q
.
Lemma
wp_value
E
Q
v
:
Q
v
⊑
wp
E
(
of_val
v
)
Q
.
Proof
.
by
constructor
.
Qed
.
Proof
.
by
constructor
;
apply
pvs_intro
.
Qed
.
Lemma
wp_mono
E
e
Q1
Q2
:
(
∀
v
,
Q1
v
⊑
Q2
v
)
→
wp
E
e
Q1
⊑
wp
E
e
Q2
.
Lemma
pvs_wp
E
e
Q
:
pvs
E
E
(
wp
E
e
Q
)
⊑
wp
E
e
Q
.
Proof
.
by
intros
HQ
r
n
?
;
apply
wp_weaken
with
n
;
intros
;
try
apply
HQ
.
Qed
.
Lemma
wp_pvs
E
e
Q
:
pvs
E
E
(
wp
E
e
Q
)
⊑
wp
E
e
(
λ
v
,
pvs
E
E
(
Q
v
)).
Proof
.
Proof
.
intros
r
[|
n
]
?
;
[
done
|]
;
intros
Hvs
.
intros
r
[|
n
]
?
;
[
done
|]
;
intros
Hvs
.
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
He
;
[
apply
of_to_val
in
He
;
subst
|].
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
He
;
[
apply
of_to_val
in
He
;
subst
|].
{
by
constructor
;
eapply
pvs_mono
,
Hvs
;
[
intros
???
;
apply
wp_value_inv
|].
}
{
constructor
;
eapply
pvs_trans'
,
pvs_mono
,
Hvs
;
eauto
.
constructor
;
[
done
|
intros
rf
k
Ef
σ
1
???].
intros
???
;
apply
wp_value_inv
.
}
constructor
;
[
done
|]=>
rf
k
Ef
σ
1
???.
destruct
(
Hvs
rf
(
S
k
)
Ef
σ
1
)
as
(
r'
&
Hwp
&?)
;
auto
.
destruct
(
Hvs
rf
(
S
k
)
Ef
σ
1
)
as
(
r'
&
Hwp
&?)
;
auto
.
inversion
Hwp
as
[|????
Hgo
]
;
subst
;
[
by
rewrite
to_of_val
in
He
|].
eapply
wp_step_inv
with
(
S
k
)
r'
;
eauto
.
destruct
(
Hgo
rf
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
Qed
.
Lemma
wp_pvs
E
e
Q
:
wp
E
e
(
λ
v
,
pvs
E
E
(
Q
v
))
⊑
wp
E
e
Q
.
Proof
.
intros
r
n
;
revert
e
r
;
induction
n
as
[
n
IH
]
using
lt_wf_ind
=>
e
r
Hr
HQ
.
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
He
;
[
apply
of_to_val
in
He
;
subst
|].
{
constructor
;
apply
pvs_trans'
,
(
wp_value_inv
_
(
pvs
E
E
∘
Q
))
;
auto
.
}
constructor
;
[
done
|]=>
rf
k
Ef
σ
1
???.
destruct
(
wp_step_inv
E
Ef
(
pvs
E
E
∘
Q
)
e
k
n
σ
1
r
rf
)
as
[?
Hstep
]
;
auto
.
split
;
[
done
|
intros
e2
σ
2
ef
?].
split
;
[
done
|
intros
e2
σ
2
ef
?].
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&
Hwp'
&?)
;
auto
.
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&
Hwp'
&?)
;
auto
.
exists
r2
,
r2'
;
split_ands
;
auto
.
exists
r2
,
r2'
;
split_ands
;
[|
apply
(
IH
k
)|]
;
auto
.
eapply
wp_mono
,
Hwp'
;
auto
using
pvs_intro
.
Qed
.
Qed
.
Lemma
wp_atomic
E1
E2
e
Q
:
Lemma
wp_atomic
E1
E2
e
Q
:
E2
⊆
E1
→
atomic
e
→
pvs
E1
E2
(
wp
E2
e
(
λ
v
,
pvs
E2
E1
(
Q
v
)))
⊑
wp
E1
e
Q
.
E2
⊆
E1
→
atomic
e
→
pvs
E1
E2
(
wp
E2
e
(
λ
v
,
pvs
E2
E1
(
Q
v
)))
⊑
wp
E1
e
Q
.
...
@@ -120,24 +138,27 @@ Proof.
...
@@ -120,24 +138,27 @@ Proof.
intros
?
He
r
n
?
Hvs
;
constructor
;
eauto
using
atomic_not_val
.
intros
?
He
r
n
?
Hvs
;
constructor
;
eauto
using
atomic_not_val
.
intros
rf
k
Ef
σ
1
???.
intros
rf
k
Ef
σ
1
???.
destruct
(
Hvs
rf
(
S
k
)
Ef
σ
1
)
as
(
r'
&
Hwp
&?)
;
auto
.
destruct
(
Hvs
rf
(
S
k
)
Ef
σ
1
)
as
(
r'
&
Hwp
&?)
;
auto
.
inversion
Hwp
as
[|????
Hgo
]
;
subst
;
[
by
destruct
(
atomic_of_val
v
)|].
destruct
(
wp_step_inv
E2
Ef
(
pvs
E2
E1
∘
Q
)
e
k
(
S
k
)
σ
1
r'
rf
)
destruct
(
Hgo
rf
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
clear
Hgo
;
a
u
to
.
as
[
Hsafe
Hstep
]
;
auto
using
ato
mic_not_val
.
split
;
[
done
|
intros
e2
σ
2
ef
?
]
.
split
;
[
done
|
]=>
e2
σ
2
ef
?.
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&
Hwp'
&?)
;
clear
Hsafe
Hstep
;
auto
.
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&
Hwp'
&?)
;
clear
Hsafe
Hstep
;
auto
.
destruct
Hwp'
as
[
k
r2
v
Hvs'
|
k
r2
e2
Hgo
]
;
destruct
Hwp'
as
[
k
r2
v
Hvs'
|
k
r2
e2
Hgo
]
;
[|
destruct
(
atomic_step
e
σ
1 e2
σ
2
ef
)
;
naive_solver
].
[|
destruct
(
atomic_step
e
σ
1 e2
σ
2
ef
)
;
naive_solver
].
apply
pvs_trans
in
Hvs'
;
auto
.
destruct
(
Hvs'
(
r2'
⋅
rf
)
k
Ef
σ
2
)
as
(
r3
&[])
;
rewrite
?(
associative
_
)
;
auto
.
destruct
(
Hvs'
(
r2'
⋅
rf
)
k
Ef
σ
2
)
as
(
r3
&[])
;
rewrite
?(
associative
_
)
;
auto
.
by
exists
r3
,
r2'
;
split_ands
;
[
rewrite
-(
associative
_
)|
constructor
|].
exists
r3
,
r2'
;
split_ands
;
last
done
.
*
by
rewrite
-(
associative
_
).
*
constructor
;
apply
pvs_intro
;
auto
.
Qed
.
Qed
.
Lemma
wp_mask_weaken
E1
E2
e
Q
:
E1
⊆
E2
→
wp
E1
e
Q
⊑
wp
E2
e
Q
.
Proof
.
by
intros
HE
r
n
?
;
apply
wp_weaken
with
n
.
Qed
.
Lemma
wp_frame_r
E
e
Q
R
:
(
wp
E
e
Q
★
R
)
⊑
wp
E
e
(
λ
v
,
Q
v
★
R
).
Lemma
wp_frame_r
E
e
Q
R
:
(
wp
E
e
Q
★
R
)
⊑
wp
E
e
(
λ
v
,
Q
v
★
R
).
Proof
.
Proof
.
intros
r'
n
Hvalid
(
r
&
rR
&
Hr
&
Hwp
&?)
;
revert
Hvalid
.
intros
r'
n
Hvalid
(
r
&
rR
&
Hr
&
Hwp
&?)
;
revert
Hvalid
.
rewrite
Hr
;
clear
Hr
;
revert
e
r
Hwp
.
rewrite
Hr
;
clear
Hr
;
revert
e
r
Hwp
.
induction
n
as
[
n
IH
]
using
lt_wf_ind
;
intros
e
r1
.
induction
n
as
[
n
IH
]
using
lt_wf_ind
;
intros
e
r1
.
destruct
1
as
[|
n
r
e
?
Hgo
]
;
constructor
;
[
exists
r
,
rR
;
eauto
|
auto
|].
destruct
1
as
[|
n
r
e
?
Hgo
]=>?.
intros
rf
k
Ef
σ
1
???
;
destruct
(
Hgo
(
rR
⋅
rf
)
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
{
constructor
;
apply
pvs_frame_r
;
auto
.
exists
r
,
rR
;
eauto
.
}
constructor
;
[
done
|]=>
rf
k
Ef
σ
1
???.
destruct
(
Hgo
(
rR
⋅
rf
)
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
{
by
rewrite
(
associative
_
).
}
{
by
rewrite
(
associative
_
).
}
split
;
[
done
|
intros
e2
σ
2
ef
?].
split
;
[
done
|
intros
e2
σ
2
ef
?].
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&?&?)
;
auto
.
destruct
(
Hstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&?&?&?)
;
auto
.
...
@@ -164,9 +185,10 @@ Qed.
...
@@ -164,9 +185,10 @@ Qed.
Lemma
wp_bind
`
{
LanguageCtx
Λ
K
}
E
e
Q
:
Lemma
wp_bind
`
{
LanguageCtx
Λ
K
}
E
e
Q
:
wp
E
e
(
λ
v
,
wp
E
(
K
(
of_val
v
))
Q
)
⊑
wp
E
(
K
e
)
Q
.
wp
E
e
(
λ
v
,
wp
E
(
K
(
of_val
v
))
Q
)
⊑
wp
E
(
K
e
)
Q
.
Proof
.
Proof
.
intros
r
n
;
revert
e
r
;
induction
n
as
[
n
IH
]
using
lt_wf_ind
;
intros
e
r
?.
intros
r
n
;
revert
e
r
;
induction
n
as
[
n
IH
]
using
lt_wf_ind
=>
e
r
?.
destruct
1
as
[|
n
r
e
?
Hgo
]
;
[|
constructor
]
;
auto
using
fill_not_val
.
destruct
1
as
[|
n
r
e
?
Hgo
]
;
[
by
apply
pvs_wp
|].
intros
rf
k
Ef
σ
1
???
;
destruct
(
Hgo
rf
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
constructor
;
auto
using
fill_not_val
=>
rf
k
Ef
σ
1
???.
destruct
(
Hgo
rf
k
Ef
σ
1
)
as
[
Hsafe
Hstep
]
;
auto
.
split
.
split
.
{
destruct
Hsafe
as
(
e2
&
σ
2
&
ef
&?).
{
destruct
Hsafe
as
(
e2
&
σ
2
&
ef
&?).
by
exists
(
K
e2
),
σ
2
,
ef
;
apply
fill_step
.
}
by
exists
(
K
e2
),
σ
2
,
ef
;
apply
fill_step
.
}
...
@@ -179,6 +201,8 @@ Qed.
...
@@ -179,6 +201,8 @@ Qed.
(* Derived rules *)
(* Derived rules *)
Opaque
uPred_holds
.
Opaque
uPred_holds
.
Import
uPred
.
Import
uPred
.
Lemma
wp_mono
E
e
Q1
Q2
:
(
∀
v
,
Q1
v
⊑
Q2
v
)
→
wp
E
e
Q1
⊑
wp
E
e
Q2
.
Proof
.
by
apply
wp_mask_frame_mono
.
Qed
.
Global
Instance
wp_mono'
E
e
:
Global
Instance
wp_mono'
E
e
:
Proper
(
pointwise_relation
_
(
⊑
)
==>
(
⊑
))
(@
wp
Λ
Σ
E
e
).
Proper
(
pointwise_relation
_
(
⊑
)
==>
(
⊑
))
(@
wp
Λ
Σ
E
e
).
Proof
.
by
intros
Q
Q'
?
;
apply
wp_mono
.
Qed
.
Proof
.
by
intros
Q
Q'
?
;
apply
wp_mono
.
Qed
.
...
@@ -186,13 +210,6 @@ Lemma wp_value' E Q e v : to_val e = Some v → Q v ⊑ wp E e Q.
...
@@ -186,13 +210,6 @@ Lemma wp_value' E Q e v : to_val e = Some v → Q v ⊑ wp E e Q.
Proof
.
intros
;
rewrite
-(
of_to_val
e
v
)
//
;
by
apply
wp_value
.
Qed
.
Proof
.
intros
;
rewrite
-(
of_to_val
e
v
)
//
;
by
apply
wp_value
.
Qed
.
Lemma
wp_frame_l
E
e
Q
R
:
(
R
★
wp
E
e
Q
)
⊑
wp
E
e
(
λ
v
,
R
★
Q
v
).
Lemma
wp_frame_l
E
e
Q
R
:
(
R
★
wp
E
e
Q
)
⊑
wp
E
e
(
λ
v
,
R
★
Q
v
).
Proof
.
setoid_rewrite
(
commutative
_
R
)
;
apply
wp_frame_r
.
Qed
.
Proof
.
setoid_rewrite
(
commutative
_
R
)
;
apply
wp_frame_r
.
Qed
.
Lemma
wp_mask_frame_mono
E
E'
e
(
P
Q
:
val
Λ
→
iProp
Λ
Σ
)
:
E'
⊆
E
→
(
∀
v
,
P
v
⊑
Q
v
)
→
wp
E'
e
P
⊑
wp
E
e
Q
.
Proof
.
intros
HE
HPQ
.
rewrite
wp_mask_weaken
;
last
eexact
HE
.
by
apply
wp_mono
.
Qed
.
Lemma
wp_frame_later_l
E
e
Q
R
:
Lemma
wp_frame_later_l
E
e
Q
R
:
to_val
e
=
None
→
(
▷
R
★
wp
E
e
Q
)
⊑
wp
E
e
(
λ
v
,
R
★
Q
v
).
to_val
e
=
None
→
(
▷
R
★
wp
E
e
Q
)
⊑
wp
E
e
(
λ
v
,
R
★
Q
v
).
Proof
.
Proof
.
...
@@ -207,7 +224,7 @@ Lemma wp_always_r E e Q R `{!AlwaysStable R} :
...
@@ -207,7 +224,7 @@ Lemma wp_always_r E e Q R `{!AlwaysStable R} :
Proof
.
by
setoid_rewrite
(
always_and_sep_r'
_
_
)
;
rewrite
wp_frame_r
.
Qed
.
Proof
.
by
setoid_rewrite
(
always_and_sep_r'
_
_
)
;
rewrite
wp_frame_r
.
Qed
.
Lemma
wp_impl_l
E
e
Q1
Q2
:
((
□
∀
v
,
Q1
v
→
Q2
v
)
∧
wp
E
e
Q1
)
⊑
wp
E
e
Q2
.
Lemma
wp_impl_l
E
e
Q1
Q2
:
((
□
∀
v
,
Q1
v
→
Q2
v
)
∧
wp
E
e
Q1
)
⊑
wp
E
e
Q2
.
Proof
.
Proof
.
rewrite
wp_always_l
;
apply
wp_mono
=>
v
.
rewrite
wp_always_l
;
apply
wp_mono
=>
//
v
.
by
rewrite
always_elim
(
forall_elim
v
)
impl_elim_l
.
by
rewrite
always_elim
(
forall_elim
v
)
impl_elim_l
.
Qed
.
Qed
.
Lemma
wp_impl_r
E
e
Q1
Q2
:
(
wp
E
e
Q1
∧
□
∀
v
,
Q1
v
→
Q2
v
)
⊑
wp
E
e
Q2
.
Lemma
wp_impl_r
E
e
Q1
Q2
:
(
wp
E
e
Q1
∧
□
∀
v
,
Q1
v
→
Q2
v
)
⊑
wp
E
e
Q2
.
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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