Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
I
iris-coq
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Dan Frumin
iris-coq
Commits
6b5ee4fa
Commit
6b5ee4fa
authored
8 years ago
by
Jacques-Henri Jourdan
Browse files
Options
Downloads
Patches
Plain Diff
Lifting lemmas : get rid of \phi when it has became useless
parent
76a7d9a2
No related branches found
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
program_logic/ectx_lifting.v
+8
-10
8 additions, 10 deletions
program_logic/ectx_lifting.v
program_logic/hoare_lifting.v
+16
-18
16 additions, 18 deletions
program_logic/hoare_lifting.v
program_logic/lifting.v
+10
-14
10 additions, 14 deletions
program_logic/lifting.v
with
34 additions
and
42 deletions
program_logic/ectx_lifting.v
+
8
−
10
View file @
6b5ee4fa
...
@@ -18,19 +18,17 @@ Lemma wp_ectx_bind {E e} K Φ :
...
@@ -18,19 +18,17 @@ Lemma wp_ectx_bind {E e} K Φ :
WP
e
@
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
E
{{
Φ
}}
}}
⊢
WP
fill
K
e
@
E
{{
Φ
}}
.
WP
e
@
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
E
{{
Φ
}}
}}
⊢
WP
fill
K
e
@
E
{{
Φ
}}
.
Proof
.
apply
:
weakestpre
.
wp_bind
.
Qed
.
Proof
.
apply
:
weakestpre
.
wp_bind
.
Qed
.
Lemma
wp_lift_head_step
E1
E2
Lemma
wp_lift_head_step
E1
E2
Φ
e1
:
(
φ
:
expr
→
state
→
option
expr
→
Prop
)
Φ
e1
:
E2
⊆
E1
→
to_val
e1
=
None
→
E2
⊆
E1
→
to_val
e1
=
None
→
(
|={
E1
,
E2
}=>
∃
σ
1
,
(
|={
E1
,
E2
}=>
∃
σ
1
,
■
head_reducible
e1
σ
1
∧
■
head_reducible
e1
σ
1
∧
▷
ownP
σ
1
★
▷
∀
e2
σ
2
ef
,
(
■
head_step
e1
σ
1
e2
σ
2
ef
∧
ownP
σ
2
)
■
(
∀
e2
σ
2
ef
,
head_step
e1
σ
1
e2
σ
2
ef
→
φ
e2
σ
2
ef
)
∧
={
E2
,
E1
}=
★
WP
e2
@
E1
{{
Φ
}}
★
wp_fork
ef
)
▷
ownP
σ
1
★
▷
∀
e2
σ
2
ef
,
(
■
φ
e2
σ
2
ef
∧
ownP
σ
2
)
={
E2
,
E1
}=
★
WP
e2
@
E1
{{
Φ
}}
★
wp_fork
ef
)
⊢
WP
e1
@
E1
{{
Φ
}}
.
⊢
WP
e1
@
E1
{{
Φ
}}
.
Proof
.
Proof
.
iIntros
{??}
"H"
.
iApply
(
wp_lift_step
E1
E2
φ
);
try
done
.
iIntros
{??}
"H"
.
iApply
(
wp_lift_step
E1
E2
);
try
done
.
iPvs
"H"
as
{
σ
1
}
"(%&%&Hσ1&?)"
.
set_solver
.
iPvsIntro
.
iExists
σ
1.
iPvs
"H"
as
{
σ
1
}
"(%&Hσ1&Hwp)"
.
set_solver
.
iPvsIntro
.
iExists
σ
1.
repeat
iSplit
;
eauto
.
by
iFrame
.
iSplit
;
first
by
eauto
.
iFrame
.
iNext
.
iIntros
{
e2
σ
2
ef
}
"[% ?]"
.
iApply
"Hwp"
.
by
eauto
.
Qed
.
Qed
.
Lemma
wp_lift_pure_head_step
E
(
φ
:
expr
→
option
expr
→
Prop
)
Φ
e1
:
Lemma
wp_lift_pure_head_step
E
(
φ
:
expr
→
option
expr
→
Prop
)
Φ
e1
:
...
...
This diff is collapsed.
Click to expand it.
program_logic/hoare_lifting.v
+
16
−
18
View file @
6b5ee4fa
...
@@ -18,24 +18,22 @@ Implicit Types e : expr Λ.
...
@@ -18,24 +18,22 @@ Implicit Types e : expr Λ.
Implicit
Types
P
Q
R
:
iProp
Λ
Σ
.
Implicit
Types
P
Q
R
:
iProp
Λ
Σ
.
Implicit
Types
Ψ
:
val
Λ
→
iProp
Λ
Σ
.
Implicit
Types
Ψ
:
val
Λ
→
iProp
Λ
Σ
.
Lemma
ht_lift_step
E1
E2
Lemma
ht_lift_step
E1
E2
P
P
σ
1
Φ
1
Φ
2
Ψ
e1
:
(
φ
:
expr
Λ
→
state
Λ
→
option
(
expr
Λ
)
→
Prop
)
P
P
'
Φ
1
Φ
2
Ψ
e1
:
E2
⊆
E1
→
to_val
e1
=
None
→
E2
⊆
E1
→
to_val
e1
=
None
→
(
P
={
E1
,
E2
}=>
∃
σ
1
,
(
P
={
E1
,
E2
}=>
∃
σ
1
,
■
reducible
e1
σ
1
∧
■
reducible
e1
σ
1
∧
▷
ownP
σ
1
★
▷
P
σ
1
σ
1
)
∧
■
(
∀
e2
σ
2
ef
,
prim_step
e1
σ
1
e2
σ
2
ef
→
φ
e2
σ
2
ef
)
∧
(
∀
σ
1
e2
σ
2
ef
,
■
prim_step
e1
σ
1
e2
σ
2
ef
★
ownP
σ
2
★
P
σ
1
σ
1
▷
ownP
σ
1
★
▷
P
'
)
∧
={
E2
,
E1
}=>
Φ
1
e2
σ
2
ef
★
Φ
2
e2
σ
2
ef
)
∧
(
∀
e2
σ
2
ef
,
■
φ
e2
σ
2
ef
★
ownP
σ
2
★
P
'
={
E2
,
E1
}=>
Φ
1
e2
σ
2
ef
★
Φ
2
e2
σ
2
ef
)
∧
(
∀
e2
σ
2
ef
,
{{
Φ
1
e2
σ
2
ef
}}
e2
@
E1
{{
Ψ
}}
)
∧
(
∀
e2
σ
2
ef
,
{{
Φ
1
e2
σ
2
ef
}}
e2
@
E1
{{
Ψ
}}
)
∧
(
∀
e2
σ
2
ef
,
{{
Φ
2
e2
σ
2
ef
}}
ef
?@
⊤
{{
_
,
True
}}
)
(
∀
e2
σ
2
ef
,
{{
Φ
2
e2
σ
2
ef
}}
ef
?@
⊤
{{
_
,
True
}}
)
⊢
{{
P
}}
e1
@
E1
{{
Ψ
}}
.
⊢
{{
P
}}
e1
@
E1
{{
Ψ
}}
.
Proof
.
Proof
.
iIntros
{??}
"#(#Hvs&HΦ&He2&Hef) ! HP"
.
iIntros
{??}
"#(#Hvs&HΦ&He2&Hef) ! HP"
.
iApply
(
wp_lift_step
E1
E2
φ
_
e1
);
auto
.
iApply
(
wp_lift_step
E1
E2
_
e1
);
auto
.
iPvs
(
"Hvs"
with
"HP"
)
as
{
σ
1
}
"(%&
%&
Hσ&HP)"
;
first
set_solver
.
iPvs
(
"Hvs"
with
"HP"
)
as
{
σ
1
}
"(%&Hσ&HP)"
;
first
set_solver
.
iPvsIntro
.
iExists
σ
1.
repeat
iSplit
;
eauto
.
iFrame
.
iPvsIntro
.
iExists
σ
1.
repeat
iSplit
.
by
eauto
.
iFrame
.
iNext
.
iIntros
{
e2
σ
2
ef
}
"[#Hφ Hown]"
.
iNext
.
iIntros
{
e2
σ
2
ef
}
"[#Hφ Hown]"
.
iSpecialize
(
"HΦ"
$
!
e2
σ
2
ef
with
"[-]"
).
by
iFrame
"Hφ HP Hown"
.
iSpecialize
(
"HΦ"
$
!
σ
1
e2
σ
2
ef
with
"[-]"
).
by
iFrame
"Hφ HP Hown"
.
iPvs
"HΦ"
as
"[H1 H2]"
;
first
by
set_solver
.
iPvsIntro
.
iSplitL
"H1"
.
iPvs
"HΦ"
as
"[H1 H2]"
;
first
by
set_solver
.
iPvsIntro
.
iSplitL
"H1"
.
-
by
iApply
"He2"
.
-
by
iApply
"He2"
.
-
destruct
ef
as
[
e
|
];
last
done
.
by
iApply
(
"Hef"
$
!
_
_
(
Some
e
)).
-
destruct
ef
as
[
e
|
];
last
done
.
by
iApply
(
"Hef"
$
!
_
_
(
Some
e
)).
...
@@ -50,15 +48,15 @@ Lemma ht_lift_atomic_step
...
@@ -50,15 +48,15 @@ Lemma ht_lift_atomic_step
{{
▷
ownP
σ
1
★
▷
P
}}
e1
@
E
{{
v
,
∃
σ
2
ef
,
ownP
σ
2
★
■
φ
(
of_val
v
)
σ
2
ef
}}
.
{{
▷
ownP
σ
1
★
▷
P
}}
e1
@
E
{{
v
,
∃
σ
2
ef
,
ownP
σ
2
★
■
φ
(
of_val
v
)
σ
2
ef
}}
.
Proof
.
Proof
.
iIntros
{?
Hsafe
Hstep
}
"#Hef"
.
iIntros
{?
Hsafe
Hstep
}
"#Hef"
.
set
(
φ'
e
σ
ef
:=
is_Some
(
to_val
e
)
∧
φ
e
σ
ef
).
set
(
φ'
(
_
:
state
Λ
)
e
σ
ef
:=
is_Some
(
to_val
e
)
∧
φ
e
σ
ef
).
iApply
(
ht_lift_step
E
E
φ'
_
P
iApply
(
ht_lift_step
E
E
_
(
λ
σ
1
'
,
P
∧
σ
1
=
σ
1
'
)
%
I
(
λ
e2
σ
2
ef
,
ownP
σ
2
★
■
(
φ'
e2
σ
2
ef
))
%
I
(
λ
e2
σ
2
ef
,
■
φ
e2
σ
2
ef
★
P
)
%
I
);
(
λ
e2
σ
2
ef
,
ownP
σ
2
★
■
(
φ'
σ
1
e2
σ
2
ef
))
%
I
(
λ
e2
σ
2
ef
,
■
φ
e2
σ
2
ef
★
P
)
%
I
);
try
by
(
eauto
using
atomic_not_val
).
try
by
(
eauto
using
atomic_not_val
).
repeat
iSplit
.
repeat
iSplit
.
-
iIntros
"![Hσ1 HP]"
.
iExists
σ
1.
iPvsIntro
.
unfold
φ'
.
-
iIntros
"![Hσ1 HP]"
.
iExists
σ
1.
iPvsIntro
.
repeat
iSplit
;
eauto
using
atomic_step
.
by
iFrame
.
iSplit
.
by
eauto
using
atomic_step
.
iFrame
.
by
auto
.
-
iIntros
{
e2
σ
2
ef
}
"! (
#Hφ
&Hown&HP)"
;
iPvsIntro
.
-
iIntros
{
?
e2
σ
2
ef
}
"! (
%
&Hown&HP
&%
)"
.
iPvsIntro
.
subst
.
i
SplitL
"Hown"
.
by
iSplit
.
iSplit
.
by
iDestruct
"Hφ"
as
%
[
_
?
].
done
.
i
Frame
.
iSplit
;
iPureIntro
;
auto
.
split
;
eauto
using
atomic_step
.
-
iIntros
{
e2
σ
2
ef
}
"! [Hown #Hφ]"
;
iDestruct
"Hφ"
as
%
[[
v2
<-%
of_to_val
]
?
].
-
iIntros
{
e2
σ
2
ef
}
"! [Hown #Hφ]"
;
iDestruct
"Hφ"
as
%
[[
v2
<-%
of_to_val
]
?
].
iApply
wp_value
'
.
iExists
σ
2
,
ef
.
by
iSplit
.
iApply
wp_value
'
.
iExists
σ
2
,
ef
.
by
iSplit
.
-
done
.
-
done
.
...
...
This diff is collapsed.
Click to expand it.
program_logic/lifting.v
+
10
−
14
View file @
6b5ee4fa
...
@@ -18,19 +18,16 @@ Implicit Types Φ : val Λ → iProp Λ Σ.
...
@@ -18,19 +18,16 @@ Implicit Types Φ : val Λ → iProp Λ Σ.
Notation
wp_fork
ef
:=
(
default
True
ef
(
flip
(
wp
⊤
)
(
λ
_
,
True
)))
%
I
.
Notation
wp_fork
ef
:=
(
default
True
ef
(
flip
(
wp
⊤
)
(
λ
_
,
True
)))
%
I
.
Lemma
wp_lift_step
E1
E2
Lemma
wp_lift_step
E1
E2
Φ
e1
:
(
φ
:
expr
Λ
→
state
Λ
→
option
(
expr
Λ
)
→
Prop
)
Φ
e1
:
E2
⊆
E1
→
to_val
e1
=
None
→
E2
⊆
E1
→
to_val
e1
=
None
→
(
|={
E1
,
E2
}=>
∃
σ
1
,
(
|={
E1
,
E2
}=>
∃
σ
1
,
■
reducible
e1
σ
1
∧
▷
ownP
σ
1
★
■
reducible
e1
σ
1
∧
▷
∀
e2
σ
2
ef
,
(
■
prim_step
e1
σ
1
e2
σ
2
ef
∧
ownP
σ
2
)
■
(
∀
e2
σ
2
ef
,
prim_step
e1
σ
1
e2
σ
2
ef
→
φ
e2
σ
2
ef
)
∧
={
E2
,
E1
}=
★
WP
e2
@
E1
{{
Φ
}}
★
wp_fork
ef
)
▷
ownP
σ
1
★
▷
∀
e2
σ
2
ef
,
(
■
φ
e2
σ
2
ef
∧
ownP
σ
2
)
={
E2
,
E1
}=
★
WP
e2
@
E1
{{
Φ
}}
★
wp_fork
ef
)
⊢
WP
e1
@
E1
{{
Φ
}}
.
⊢
WP
e1
@
E1
{{
Φ
}}
.
Proof
.
Proof
.
intros
?
He
.
rewrite
pvs_eq
wp_eq
.
intros
?
He
.
rewrite
pvs_eq
wp_eq
.
uPred
.
unseal
;
split
=>
n
r
?
Hvs
;
constructor
;
auto
.
intros
k
Ef
σ
1
'
rf
???
.
uPred
.
unseal
;
split
=>
n
r
?
Hvs
;
constructor
;
auto
.
intros
k
Ef
σ
1
'
rf
???
.
destruct
(
Hvs
(
S
k
)
Ef
σ
1
'
rf
)
as
(
r
'
&
(
σ
1
&
Hsafe
&
Hstep
&
r1
&
r2
&?&?&
Hwp
)
&
Hws
);
destruct
(
Hvs
(
S
k
)
Ef
σ
1
'
rf
)
as
(
r
'
&
(
σ
1
&
Hsafe
&
r1
&
r2
&?&?&
Hwp
)
&
Hws
);
auto
;
clear
Hvs
;
cofe_subst
r
'
.
auto
;
clear
Hvs
;
cofe_subst
r
'
.
destruct
(
wsat_update_pst
k
(
E2
∪
Ef
)
σ
1
σ
1
'
r1
(
r2
⋅
rf
))
as
[
->
Hws
'
].
destruct
(
wsat_update_pst
k
(
E2
∪
Ef
)
σ
1
σ
1
'
r1
(
r2
⋅
rf
))
as
[
->
Hws
'
].
{
apply
equiv_dist
.
rewrite
-
(
ownP_spec
k
);
auto
.
}
{
apply
equiv_dist
.
rewrite
-
(
ownP_spec
k
);
auto
.
}
...
@@ -38,7 +35,7 @@ Proof.
...
@@ -38,7 +35,7 @@ Proof.
constructor
;
[
done
|
intros
e2
σ
2
ef
?
;
specialize
(
Hws
'
σ
2
)].
constructor
;
[
done
|
intros
e2
σ
2
ef
?
;
specialize
(
Hws
'
σ
2
)].
destruct
(
λ
H1
H2
H3
,
Hwp
e2
σ
2
ef
k
(
update_pst
σ
2
r1
)
H1
H2
H3
k
Ef
σ
2
rf
)
destruct
(
λ
H1
H2
H3
,
Hwp
e2
σ
2
ef
k
(
update_pst
σ
2
r1
)
H1
H2
H3
k
Ef
σ
2
rf
)
as
(
r
'
&
(
r1
'
&
r2
'
&?&?&?
)
&?
);
auto
;
cofe_subst
r
'
.
as
(
r
'
&
(
r1
'
&
r2
'
&?&?&?
)
&?
);
auto
;
cofe_subst
r
'
.
{
split
.
by
eapply
Hstep
.
apply
ownP_spec
;
auto
.
}
{
split
.
done
.
apply
ownP_spec
;
auto
.
}
{
rewrite
(
comm
_
r2
)
-
assoc
;
eauto
using
wsat_le
.
}
{
rewrite
(
comm
_
r2
)
-
assoc
;
eauto
using
wsat_le
.
}
exists
r1
'
,
r2
'
;
split_and
?
;
try
done
.
by
uPred
.
unseal
;
intros
?
->
.
exists
r1
'
,
r2
'
;
split_and
?
;
try
done
.
by
uPred
.
unseal
;
intros
?
->
.
Qed
.
Qed
.
...
@@ -71,11 +68,10 @@ Lemma wp_lift_atomic_step {E Φ} e1
...
@@ -71,11 +68,10 @@ Lemma wp_lift_atomic_step {E Φ} e1
■
φ
(
of_val
v2
)
σ
2
ef
∧
ownP
σ
2
-
★
(
|={
E
}=>
Φ
v2
)
★
wp_fork
ef
)
■
φ
(
of_val
v2
)
σ
2
ef
∧
ownP
σ
2
-
★
(
|={
E
}=>
Φ
v2
)
★
wp_fork
ef
)
⊢
WP
e1
@
E
{{
Φ
}}
.
⊢
WP
e1
@
E
{{
Φ
}}
.
Proof
.
Proof
.
iIntros
{???}
"[Hσ1 Hwp]"
.
iApply
(
wp_lift_step
E
E
(
λ
e2
σ
2
ef
,
iIntros
{???}
"[Hσ1 Hwp]"
.
iApply
(
wp_lift_step
E
E
_
e1
);
auto
using
atomic_not_val
.
is_Some
(
to_val
e2
)
∧
φ
e2
σ
2
ef
)
_
e1
);
auto
using
atomic_not_val
.
iPvsIntro
.
iExists
σ
1.
repeat
iSplit
;
eauto
10
using
atomic_step
.
iApply
pvs_intro
.
iExists
σ
1.
repeat
iSplit
;
eauto
using
atomic_step
.
iFrame
.
iNext
.
iIntros
{
e2
σ
2
ef
}
"[% Hσ2]"
.
iFrame
.
iNext
.
iIntros
{
e2
σ
2
ef
}
"[#He2 Hσ2]"
.
edestruct
@
atomic_step
as
[
v2
Hv
%
of_to_val
];
eauto
.
subst
e2
.
iDestruct
"He2"
as
%
[[
v2
Hv
%
of_to_val
]
?
].
subst
e2
.
iDestruct
(
"Hwp"
$
!
v2
σ
2
ef
with
"[Hσ2]"
)
as
"[HΦ ?]"
.
by
eauto
.
iDestruct
(
"Hwp"
$
!
v2
σ
2
ef
with
"[Hσ2]"
)
as
"[HΦ ?]"
.
by
eauto
.
iFrame
.
iPvs
"HΦ"
.
iPvsIntro
.
iApply
wp_value
;
auto
using
to_of_val
.
iFrame
.
iPvs
"HΦ"
.
iPvsIntro
.
iApply
wp_value
;
auto
using
to_of_val
.
Qed
.
Qed
.
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment