Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
I
iris
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Tej Chajed
iris
Commits
5b4cd196
Commit
5b4cd196
authored
Dec 06, 2016
by
David Swasey
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add progress bit to wp (and slightly generalize wp_step, wp_safe).
parent
726366bb
Changes
15
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
482 additions
and
271 deletions
+482
-271
naming.txt
naming.txt
+1
-1
theories/heap_lang/adequacy.v
theories/heap_lang/adequacy.v
+1
-1
theories/heap_lang/lifting.v
theories/heap_lang/lifting.v
+1
-1
theories/heap_lang/proofmode.v
theories/heap_lang/proofmode.v
+8
-8
theories/heap_lang/tactics.v
theories/heap_lang/tactics.v
+6
-7
theories/program_logic/adequacy.v
theories/program_logic/adequacy.v
+34
-28
theories/program_logic/ectx_language.v
theories/program_logic/ectx_language.v
+10
-0
theories/program_logic/ectx_lifting.v
theories/program_logic/ectx_lifting.v
+56
-24
theories/program_logic/hoare.v
theories/program_logic/hoare.v
+71
-47
theories/program_logic/language.v
theories/program_logic/language.v
+4
-0
theories/program_logic/lifting.v
theories/program_logic/lifting.v
+40
-15
theories/program_logic/ownp.v
theories/program_logic/ownp.v
+80
-54
theories/program_logic/weakestpre.v
theories/program_logic/weakestpre.v
+168
-83
theories/tests/heap_lang.v
theories/tests/heap_lang.v
+1
-1
theories/tests/ipm_paper.v
theories/tests/ipm_paper.v
+1
-1
No files found.
naming.txt
View file @
5b4cd196
...
@@ -14,7 +14,7 @@ l
...
@@ -14,7 +14,7 @@ l
m : iGst = ghost state
m : iGst = ghost state
n
n
o
o
p
p
: progress bits
q
q
r : iRes = resources
r : iRes = resources
s : state (STSs)
s : state (STSs)
...
...
theories/heap_lang/adequacy.v
View file @
5b4cd196
...
@@ -16,7 +16,7 @@ Proof. solve_inG. Qed.
...
@@ -16,7 +16,7 @@ Proof. solve_inG. Qed.
Definition
heap_adequacy
Σ
`
{
heapPreG
Σ
}
e
σ
φ
:
Definition
heap_adequacy
Σ
`
{
heapPreG
Σ
}
e
σ
φ
:
(
∀
`
{
heapG
Σ
},
WP
e
{{
v
,
⌜φ
v
⌝
}}%
I
)
→
(
∀
`
{
heapG
Σ
},
WP
e
{{
v
,
⌜φ
v
⌝
}}%
I
)
→
adequate
e
σ
φ
.
adequate
true
e
σ
φ
.
Proof
.
Proof
.
intros
Hwp
;
eapply
(
wp_adequacy
_
_
)
;
iIntros
(?)
""
.
intros
Hwp
;
eapply
(
wp_adequacy
_
_
)
;
iIntros
(?)
""
.
iMod
(
own_alloc
(
●
to_gen_heap
σ
))
as
(
γ
)
"Hh"
.
iMod
(
own_alloc
(
●
to_gen_heap
σ
))
as
(
γ
)
"Hh"
.
...
...
theories/heap_lang/lifting.v
View file @
5b4cd196
...
@@ -76,7 +76,7 @@ Lemma wp_fork E e Φ :
...
@@ -76,7 +76,7 @@ Lemma wp_fork E e Φ :
▷
Φ
(
LitV
LitUnit
)
∗
▷
WP
e
{{
_
,
True
}}
⊢
WP
Fork
e
@
E
{{
Φ
}}.
▷
Φ
(
LitV
LitUnit
)
∗
▷
WP
e
{{
_
,
True
}}
⊢
WP
Fork
e
@
E
{{
Φ
}}.
Proof
.
Proof
.
rewrite
-(
wp_lift_pure_det_head_step
(
Fork
e
)
(
Lit
LitUnit
)
[
e
])
//=
;
eauto
.
rewrite
-(
wp_lift_pure_det_head_step
(
Fork
e
)
(
Lit
LitUnit
)
[
e
])
//=
;
eauto
.
-
by
rewrite
-
step_fupd_intro
//
later_sep
-(
wp_value
_
_
(
Lit
_
))
//
right_id
.
-
by
rewrite
-
step_fupd_intro
//
later_sep
-(
wp_value
_
_
_
(
Lit
_
))
//
right_id
.
-
intros
;
inv_head_step
;
eauto
.
-
intros
;
inv_head_step
;
eauto
.
Qed
.
Qed
.
...
...
theories/heap_lang/proofmode.v
View file @
5b4cd196
...
@@ -27,7 +27,7 @@ Ltac wp_value_head := eapply tac_wp_value; [apply _|lazy beta].
...
@@ -27,7 +27,7 @@ Ltac wp_value_head := eapply tac_wp_value; [apply _|lazy beta].
Tactic
Notation
"wp_pure"
open_constr
(
efoc
)
:
=
Tactic
Notation
"wp_pure"
open_constr
(
efoc
)
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
unify
e'
efoc
;
unify
e'
efoc
;
eapply
(
tac_wp_pure
K
)
;
eapply
(
tac_wp_pure
K
)
;
[
simpl
;
apply
_
(* PureExec *)
[
simpl
;
apply
_
(* PureExec *)
...
@@ -66,7 +66,7 @@ Ltac wp_bind_core K :=
...
@@ -66,7 +66,7 @@ Ltac wp_bind_core K :=
Tactic
Notation
"wp_bind"
open_constr
(
efoc
)
:
=
Tactic
Notation
"wp_bind"
open_constr
(
efoc
)
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
unify
e'
efoc
;
wp_bind_core
K
)
reshape_expr
e
ltac
:
(
fun
K
e'
=>
unify
e'
efoc
;
wp_bind_core
K
)
||
fail
"wp_bind: cannot find"
efoc
"in"
e
||
fail
"wp_bind: cannot find"
efoc
"in"
e
|
_
=>
fail
"wp_bind: not a 'wp'"
|
_
=>
fail
"wp_bind: not a 'wp'"
...
@@ -151,7 +151,7 @@ End heap.
...
@@ -151,7 +151,7 @@ End heap.
Tactic
Notation
"wp_apply"
open_constr
(
lem
)
:
=
Tactic
Notation
"wp_apply"
open_constr
(
lem
)
:
=
iPoseProofCore
lem
as
false
true
(
fun
H
=>
iPoseProofCore
lem
as
false
true
(
fun
H
=>
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
wp_bind_core
K
;
iApplyHyp
H
;
try
iNext
;
simpl
)
||
wp_bind_core
K
;
iApplyHyp
H
;
try
iNext
;
simpl
)
||
lazymatch
iTypeOf
H
with
lazymatch
iTypeOf
H
with
...
@@ -163,7 +163,7 @@ Tactic Notation "wp_apply" open_constr(lem) :=
...
@@ -163,7 +163,7 @@ Tactic Notation "wp_apply" open_constr(lem) :=
Tactic
Notation
"wp_alloc"
ident
(
l
)
"as"
constr
(
H
)
:
=
Tactic
Notation
"wp_alloc"
ident
(
l
)
"as"
constr
(
H
)
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
first
first
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_alloc
_
_
_
H
K
)
;
[
apply
_
|..])
eapply
(
tac_wp_alloc
_
_
_
H
K
)
;
[
apply
_
|..])
...
@@ -182,7 +182,7 @@ Tactic Notation "wp_alloc" ident(l) :=
...
@@ -182,7 +182,7 @@ Tactic Notation "wp_alloc" ident(l) :=
Tactic
Notation
"wp_load"
:
=
Tactic
Notation
"wp_load"
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
first
first
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_load
_
_
_
_
K
))
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_load
_
_
_
_
K
))
|
fail
1
"wp_load: cannot find 'Load' in"
e
]
;
|
fail
1
"wp_load: cannot find 'Load' in"
e
]
;
...
@@ -196,7 +196,7 @@ Tactic Notation "wp_load" :=
...
@@ -196,7 +196,7 @@ Tactic Notation "wp_load" :=
Tactic
Notation
"wp_store"
:
=
Tactic
Notation
"wp_store"
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
first
first
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_store
_
_
_
_
_
K
)
;
[
apply
_
|..])
eapply
(
tac_wp_store
_
_
_
_
_
K
)
;
[
apply
_
|..])
...
@@ -212,7 +212,7 @@ Tactic Notation "wp_store" :=
...
@@ -212,7 +212,7 @@ Tactic Notation "wp_store" :=
Tactic
Notation
"wp_cas_fail"
:
=
Tactic
Notation
"wp_cas_fail"
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
first
first
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_cas_fail
_
_
_
_
K
)
;
[
apply
_
|
apply
_
|..])
eapply
(
tac_wp_cas_fail
_
_
_
_
K
)
;
[
apply
_
|
apply
_
|..])
...
@@ -228,7 +228,7 @@ Tactic Notation "wp_cas_fail" :=
...
@@ -228,7 +228,7 @@ Tactic Notation "wp_cas_fail" :=
Tactic
Notation
"wp_cas_suc"
:
=
Tactic
Notation
"wp_cas_suc"
:
=
iStartProof
;
iStartProof
;
lazymatch
goal
with
lazymatch
goal
with
|
|-
envs_entails
_
(
wp
?E
?e
?Q
)
=>
|
|-
envs_entails
_
(
wp
true
?E
?e
?Q
)
=>
first
first
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
[
reshape_expr
e
ltac
:
(
fun
K
e'
=>
eapply
(
tac_wp_cas_suc
_
_
_
_
_
K
)
;
[
apply
_
|
apply
_
|..])
eapply
(
tac_wp_cas_suc
_
_
_
_
_
K
)
;
[
apply
_
|
apply
_
|..])
...
...
theories/heap_lang/tactics.v
View file @
5b4cd196
...
@@ -187,11 +187,10 @@ Definition is_atomic (e : expr) :=
...
@@ -187,11 +187,10 @@ Definition is_atomic (e : expr) :=
|
App
(
Rec
_
_
(
Lit
_
))
(
Lit
_
)
=>
true
|
App
(
Rec
_
_
(
Lit
_
))
(
Lit
_
)
=>
true
|
_
=>
false
|
_
=>
false
end
.
end
.
Lemma
is_atomic_correct
e
:
is_atomic
e
→
Atomic
(
to_expr
e
).
Lemma
is_atomic_correct
e
:
is_atomic
e
→
Strongly
Atomic
(
to_expr
e
).
Proof
.
Proof
.
intros
He
.
apply
ectx_language_atomic
.
intros
He
.
apply
ectx_language_strongly_atomic
.
-
intros
σ
e'
σ
'
ef
Hstep
;
simpl
in
*.
-
intros
σ
e'
σ
'
ef
Hstep
;
simpl
in
*.
revert
Hstep
.
apply
language
.
val_irreducible
;
revert
Hstep
.
destruct
e
=>
//=
;
repeat
(
simplify_eq
/=
;
case_match
=>//)
;
destruct
e
=>
//=
;
repeat
(
simplify_eq
/=
;
case_match
=>//)
;
inversion
1
;
simplify_eq
/=
;
rewrite
?to_of_val
;
eauto
.
inversion
1
;
simplify_eq
/=
;
rewrite
?to_of_val
;
eauto
.
unfold
subst'
;
repeat
(
simplify_eq
/=
;
case_match
=>//)
;
eauto
.
unfold
subst'
;
repeat
(
simplify_eq
/=
;
case_match
=>//)
;
eauto
.
...
@@ -227,11 +226,11 @@ Hint Extern 10 (AsVal _) => solve_as_val : typeclass_instances.
...
@@ -227,11 +226,11 @@ Hint Extern 10 (AsVal _) => solve_as_val : typeclass_instances.
Ltac
solve_atomic
:
=
Ltac
solve_atomic
:
=
match
goal
with
match
goal
with
|
|-
Atomic
?e
=>
|
|-
Strongly
Atomic
?e
=>
let
e'
:
=
W
.
of_expr
e
in
change
(
Atomic
(
W
.
to_expr
e'
))
;
let
e'
:
=
W
.
of_expr
e
in
change
(
Strongly
Atomic
(
W
.
to_expr
e'
))
;
apply
W
.
is_atomic_correct
;
vm_compute
;
exact
I
apply
W
.
is_atomic_correct
;
vm_compute
;
exact
I
end
.
end
.
Hint
Extern
10
(
Atomic
_
)
=>
solve_atomic
:
typeclass_instances
.
Hint
Extern
10
(
Strongly
Atomic
_
)
=>
solve_atomic
:
typeclass_instances
.
(** Substitution *)
(** Substitution *)
Ltac
simpl_subst
:
=
Ltac
simpl_subst
:
=
...
...
theories/program_logic/adequacy.v
View file @
5b4cd196
...
@@ -34,23 +34,24 @@ Proof.
...
@@ -34,23 +34,24 @@ Proof.
Qed
.
Qed
.
(* Program logic adequacy *)
(* Program logic adequacy *)
Record
adequate
{
Λ
}
(
e1
:
expr
Λ
)
(
σ
1
:
state
Λ
)
(
φ
:
val
Λ
→
Prop
)
:
=
{
Record
adequate
{
Λ
}
(
p
:
bool
)
(
e1
:
expr
Λ
)
(
σ
1
:
state
Λ
)
(
φ
:
val
Λ
→
Prop
)
:
=
{
adequate_result
t2
σ
2
v2
:
adequate_result
t2
σ
2
v2
:
rtc
step
([
e1
],
σ
1
)
(
of_val
v2
::
t2
,
σ
2
)
→
φ
v2
;
rtc
step
([
e1
],
σ
1
)
(
of_val
v2
::
t2
,
σ
2
)
→
φ
v2
;
adequate_safe
t2
σ
2 e2
:
adequate_safe
t2
σ
2 e2
:
p
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
e2
∈
t2
→
(
is_Some
(
to_val
e2
)
∨
reducible
e2
σ
2
)
e2
∈
t2
→
progressive
e2
σ
2
}.
}.
Theorem
adequate_tp_safe
{
Λ
}
(
e1
:
expr
Λ
)
t2
σ
1
σ
2
φ
:
Theorem
adequate_tp_safe
{
Λ
}
(
e1
:
expr
Λ
)
t2
σ
1
σ
2
φ
:
adequate
e1
σ
1
φ
→
adequate
true
e1
σ
1
φ
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
rtc
step
([
e1
],
σ
1
)
(
t2
,
σ
2
)
→
Forall
(
λ
e
,
is_Some
(
to_val
e
))
t2
∨
∃
t3
σ
3
,
step
(
t2
,
σ
2
)
(
t3
,
σ
3
).
Forall
(
λ
e
,
is_Some
(
to_val
e
))
t2
∨
∃
t3
σ
3
,
step
(
t2
,
σ
2
)
(
t3
,
σ
3
).
Proof
.
Proof
.
intros
Had
?.
intros
Had
?.
destruct
(
decide
(
Forall
(
λ
e
,
is_Some
(
to_val
e
))
t2
))
as
[|
Ht2
]
;
[
by
left
|].
destruct
(
decide
(
Forall
(
λ
e
,
is_Some
(
to_val
e
))
t2
))
as
[|
Ht2
]
;
[
by
left
|].
apply
(
not_Forall_Exists
_
),
Exists_exists
in
Ht2
;
destruct
Ht2
as
(
e2
&?&
He2
).
apply
(
not_Forall_Exists
_
),
Exists_exists
in
Ht2
;
destruct
Ht2
as
(
e2
&?&
He2
).
destruct
(
adequate_safe
e1
σ
1
φ
Had
t2
σ
2 e2
)
as
[?|(
e3
&
σ
3
&
efs
&?)]
;
destruct
(
adequate_safe
true
e1
σ
1
φ
Had
t2
σ
2 e2
)
as
[?|(
e3
&
σ
3
&
efs
&?)]
;
rewrite
?eq_None_not_Some
;
auto
.
rewrite
?eq_None_not_Some
;
auto
.
{
exfalso
.
eauto
.
}
{
exfalso
.
eauto
.
}
destruct
(
elem_of_list_split
t2
e2
)
as
(
t2'
&
t2''
&->)
;
auto
.
destruct
(
elem_of_list_split
t2
e2
)
as
(
t2'
&
t2''
&->)
;
auto
.
...
@@ -58,19 +59,22 @@ Proof.
...
@@ -58,19 +59,22 @@ Proof.
Qed
.
Qed
.
Section
adequacy
.
Section
adequacy
.
Context
`
{
irisG
Λ
Σ
}.
Context
`
{
irisG
Λ
Σ
}
(
p
:
bool
)
.
Implicit
Types
e
:
expr
Λ
.
Implicit
Types
e
:
expr
Λ
.
Implicit
Types
P
Q
:
iProp
Σ
.
Implicit
Types
P
Q
:
iProp
Σ
.
Implicit
Types
Φ
:
val
Λ
→
iProp
Σ
.
Implicit
Types
Φ
:
val
Λ
→
iProp
Σ
.
Implicit
Types
Φ
s
:
list
(
val
Λ
→
iProp
Σ
).
Implicit
Types
Φ
s
:
list
(
val
Λ
→
iProp
Σ
).
Notation
world
σ
:
=
(
wsat
∗
ownE
⊤
∗
state_interp
σ
)%
I
.
Notation
world'
E
σ
:
=
(
wsat
∗
ownE
E
∗
state_interp
σ
)%
I
.
Notation
world
σ
:
=
(
world'
⊤
σ
).
Notation
wptp
t
:
=
([
∗
list
]
ef
∈
t
,
WP
ef
{{
_
,
True
}})%
I
.
Notation
wp'
E
e
Φ
:
=
(
WP
e
@
p
;
E
{{
Φ
}})%
I
.
Notation
wp
e
Φ
:
=
(
wp'
⊤
e
Φ
).
Notation
wptp
t
:
=
([
∗
list
]
ef
∈
t
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})%
I
.
Lemma
wp_step
e1
σ
1 e2
σ
2
efs
Φ
:
Lemma
wp_step
E
e1
σ
1 e2
σ
2
efs
Φ
:
prim_step
e1
σ
1 e2
σ
2
efs
→
prim_step
e1
σ
1 e2
σ
2
efs
→
world
σ
1
∗
WP
e1
{{
Φ
}}
==
∗
▷
|==>
◇
(
world
σ
2
∗
WP
e2
{{
Φ
}}
∗
wptp
efs
).
world
'
E
σ
1
∗
wp'
E
e1
Φ
==
∗
▷
|==>
◇
(
world'
E
σ
2
∗
wp'
E
e2
Φ
∗
wptp
efs
).
Proof
.
Proof
.
rewrite
{
1
}
wp_unfold
/
wp_pre
.
iIntros
(?)
"[(Hw & HE & Hσ) H]"
.
rewrite
{
1
}
wp_unfold
/
wp_pre
.
iIntros
(?)
"[(Hw & HE & Hσ) H]"
.
rewrite
(
val_stuck
e1
σ
1 e2
σ
2
efs
)
//
fupd_eq
/
fupd_def
.
rewrite
(
val_stuck
e1
σ
1 e2
σ
2
efs
)
//
fupd_eq
/
fupd_def
.
...
@@ -81,8 +85,8 @@ Qed.
...
@@ -81,8 +85,8 @@ Qed.
Lemma
wptp_step
e1
t1
t2
σ
1
σ
2
Φ
:
Lemma
wptp_step
e1
t1
t2
σ
1
σ
2
Φ
:
step
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
step
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
world
σ
1
∗
WP
e1
{{
Φ
}}
∗
wptp
t1
world
σ
1
∗
wp
e1
Φ
∗
wptp
t1
==
∗
∃
e2
t2'
,
⌜
t2
=
e2
::
t2'
⌝
∗
▷
|==>
◇
(
world
σ
2
∗
WP
e2
{{
Φ
}}
∗
wptp
t2'
).
==
∗
∃
e2
t2'
,
⌜
t2
=
e2
::
t2'
⌝
∗
▷
|==>
◇
(
world
σ
2
∗
wp
e2
Φ
∗
wptp
t2'
).
Proof
.
Proof
.
iIntros
(
Hstep
)
"(HW & He & Ht)"
.
iIntros
(
Hstep
)
"(HW & He & Ht)"
.
destruct
Hstep
as
[
e1'
σ
1
'
e2'
σ
2
'
efs
[|?
t1'
]
t2'
??
Hstep
]
;
simplify_eq
/=.
destruct
Hstep
as
[
e1'
σ
1
'
e2'
σ
2
'
efs
[|?
t1'
]
t2'
??
Hstep
]
;
simplify_eq
/=.
...
@@ -95,9 +99,9 @@ Qed.
...
@@ -95,9 +99,9 @@ Qed.
Lemma
wptp_steps
n
e1
t1
t2
σ
1
σ
2
Φ
:
Lemma
wptp_steps
n
e1
t1
t2
σ
1
σ
2
Φ
:
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
world
σ
1
∗
WP
e1
{{
Φ
}}
∗
wptp
t1
⊢
world
σ
1
∗
wp
e1
Φ
∗
wptp
t1
⊢
Nat
.
iter
(
S
n
)
(
λ
P
,
|==>
▷
P
)
(
∃
e2
t2'
,
Nat
.
iter
(
S
n
)
(
λ
P
,
|==>
▷
P
)
(
∃
e2
t2'
,
⌜
t2
=
e2
::
t2'
⌝
∗
world
σ
2
∗
WP
e2
{{
Φ
}}
∗
wptp
t2'
).
⌜
t2
=
e2
::
t2'
⌝
∗
world
σ
2
∗
wp
e2
Φ
∗
wptp
t2'
).
Proof
.
Proof
.
revert
e1
t1
t2
σ
1
σ
2
;
simpl
;
induction
n
as
[|
n
IH
]=>
e1
t1
t2
σ
1
σ
2
/=.
revert
e1
t1
t2
σ
1
σ
2
;
simpl
;
induction
n
as
[|
n
IH
]=>
e1
t1
t2
σ
1
σ
2
/=.
{
inversion_clear
1
;
iIntros
"?"
;
eauto
10
.
}
{
inversion_clear
1
;
iIntros
"?"
;
eauto
10
.
}
...
@@ -121,7 +125,7 @@ Qed.
...
@@ -121,7 +125,7 @@ Qed.
Lemma
wptp_result
n
e1
t1
v2
t2
σ
1
σ
2
φ
:
Lemma
wptp_result
n
e1
t1
v2
t2
σ
1
σ
2
φ
:
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
of_val
v2
::
t2
,
σ
2
)
→
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
of_val
v2
::
t2
,
σ
2
)
→
world
σ
1
∗
WP
e1
{{
v
,
⌜φ
v
⌝
}}
∗
wptp
t1
⊢
▷
^(
S
(
S
n
))
⌜φ
v2
⌝
.
world
σ
1
∗
wp
e1
(
λ
v
,
⌜φ
v
⌝
)
∗
wptp
t1
⊢
▷
^(
S
(
S
n
))
⌜φ
v2
⌝
.
Proof
.
Proof
.
intros
.
rewrite
wptp_steps
//
laterN_later
.
apply
:
bupd_iter_laterN_mono
.
intros
.
rewrite
wptp_steps
//
laterN_later
.
apply
:
bupd_iter_laterN_mono
.
iDestruct
1
as
(
e2
t2'
?)
"((Hw & HE & _) & H & _)"
;
simplify_eq
.
iDestruct
1
as
(
e2
t2'
?)
"((Hw & HE & _) & H & _)"
;
simplify_eq
.
...
@@ -129,18 +133,20 @@ Proof.
...
@@ -129,18 +133,20 @@ Proof.
iMod
(
"H"
with
"[Hw HE]"
)
as
">(_ & _ & $)"
;
iFrame
;
auto
.
iMod
(
"H"
with
"[Hw HE]"
)
as
">(_ & _ & $)"
;
iFrame
;
auto
.
Qed
.
Qed
.
Lemma
wp_safe
e
σ
Φ
:
Lemma
wp_safe
E
e
σ
Φ
:
world
σ
-
∗
WP
e
{{
Φ
}}
==
∗
▷
⌜
is_Some
(
to_val
e
)
∨
reducible
e
σ
⌝
.
world
'
E
σ
-
∗
wp'
E
e
Φ
==
∗
▷
⌜
if
p
then
progressive
e
σ
else
True
⌝
.
Proof
.
Proof
.
rewrite
wp_unfold
/
wp_pre
.
iIntros
"(Hw&HE&Hσ) H"
.
rewrite
wp_unfold
/
wp_pre
.
iIntros
"(Hw&HE&Hσ) H"
.
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
?
;
[
eauto
10
|].
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
?.
rewrite
fupd_eq
.
iMod
(
"H"
with
"Hσ [-]"
)
as
">(?&?&%&?)"
;
eauto
10
with
iFrame
.
{
destruct
p
;
last
done
.
iIntros
"!> !> !%"
.
left
.
by
exists
v
.
}
rewrite
fupd_eq
.
iMod
(
"H"
with
"Hσ [-]"
)
as
">(?&?&%&?)"
;
first
by
iFrame
.
destruct
p
;
last
done
.
iIntros
"!> !> !%"
.
by
right
.
Qed
.
Qed
.
Lemma
wptp_safe
n
e1
e2
t1
t2
σ
1
σ
2
Φ
:
Lemma
wptp_safe
n
e1
e2
t1
t2
σ
1
σ
2
Φ
:
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
e2
∈
t2
→
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
e2
∈
t2
→
world
σ
1
∗
WP
e1
{{
Φ
}}
∗
wptp
t1
⊢
world
σ
1
∗
wp
e1
Φ
∗
wptp
t1
⊢
▷
^(
S
(
S
n
))
⌜
i
s_Some
(
to_val
e2
)
∨
reducible
e2
σ
2
⌝
.
▷
^(
S
(
S
n
))
⌜
i
f
p
then
progressive
e2
σ
2
else
True
⌝
.
Proof
.
Proof
.
intros
?
He2
.
rewrite
wptp_steps
//
laterN_later
.
apply
:
bupd_iter_laterN_mono
.
intros
?
He2
.
rewrite
wptp_steps
//
laterN_later
.
apply
:
bupd_iter_laterN_mono
.
iDestruct
1
as
(
e2'
t2'
?)
"(Hw & H & Htp)"
;
simplify_eq
.
iDestruct
1
as
(
e2'
t2'
?)
"(Hw & H & Htp)"
;
simplify_eq
.
...
@@ -151,7 +157,7 @@ Qed.
...
@@ -151,7 +157,7 @@ Qed.
Lemma
wptp_invariance
n
e1
e2
t1
t2
σ
1
σ
2
φ
Φ
:
Lemma
wptp_invariance
n
e1
e2
t1
t2
σ
1
σ
2
φ
Φ
:
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
nsteps
step
n
(
e1
::
t1
,
σ
1
)
(
t2
,
σ
2
)
→
(
state_interp
σ
2
={
⊤
,
∅
}=
∗
⌜φ⌝
)
∗
world
σ
1
∗
WP
e1
{{
Φ
}}
∗
wptp
t1
(
state_interp
σ
2
={
⊤
,
∅
}=
∗
⌜φ⌝
)
∗
world
σ
1
∗
wp
e1
Φ
∗
wptp
t1
⊢
▷
^(
S
(
S
n
))
⌜φ⌝
.
⊢
▷
^(
S
(
S
n
))
⌜φ⌝
.
Proof
.
Proof
.
intros
?.
rewrite
wptp_steps
//
bupd_iter_frame_l
laterN_later
.
intros
?.
rewrite
wptp_steps
//
bupd_iter_frame_l
laterN_later
.
...
@@ -162,12 +168,12 @@ Proof.
...
@@ -162,12 +168,12 @@ Proof.
Qed
.
Qed
.
End
adequacy
.
End
adequacy
.
Theorem
wp_adequacy
Σ
Λ
`
{
invPreG
Σ
}
e
σ
φ
:
Theorem
wp_adequacy
Σ
Λ
`
{
invPreG
Σ
}
p
e
σ
φ
:
(
∀
`
{
Hinv
:
invG
Σ
},
(
∀
`
{
Hinv
:
invG
Σ
},
(|={
⊤
}=>
∃
stateI
:
state
Λ
→
iProp
Σ
,
(|={
⊤
}=>
∃
stateI
:
state
Λ
→
iProp
Σ
,
let
_
:
irisG
Λ
Σ
:
=
IrisG
_
_
Hinv
stateI
in
let
_
:
irisG
Λ
Σ
:
=
IrisG
_
_
Hinv
stateI
in
stateI
σ
∗
WP
e
{{
v
,
⌜φ
v
⌝
}})%
I
)
→
stateI
σ
∗
WP
e
@
p
;
⊤
{{
v
,
⌜φ
v
⌝
}})%
I
)
→
adequate
e
σ
φ
.
adequate
p
e
σ
φ
.
Proof
.
Proof
.
intros
Hwp
;
split
.
intros
Hwp
;
split
.
-
intros
t2
σ
2
v2
[
n
?]%
rtc_nsteps
.
-
intros
t2
σ
2
v2
[
n
?]%
rtc_nsteps
.
...
@@ -176,19 +182,19 @@ Proof.
...
@@ -176,19 +182,19 @@ Proof.
rewrite
fupd_eq
in
Hwp
;
iMod
(
Hwp
with
"[$Hw $HE]"
)
as
">(Hw & HE & Hwp)"
.
rewrite
fupd_eq
in
Hwp
;
iMod
(
Hwp
with
"[$Hw $HE]"
)
as
">(Hw & HE & Hwp)"
.
iDestruct
"Hwp"
as
(
Istate
)
"[HI Hwp]"
.
iDestruct
"Hwp"
as
(
Istate
)
"[HI Hwp]"
.
iApply
(@
wptp_result
_
_
(
IrisG
_
_
Hinv
Istate
))
;
eauto
with
iFrame
.
iApply
(@
wptp_result
_
_
(
IrisG
_
_
Hinv
Istate
))
;
eauto
with
iFrame
.
-
intros
t2
σ
2 e2
[
n
?]%
rtc_nsteps
?.
-
destruct
p
;
last
done
.
intros
t2
σ
2 e2
_
[
n
?]%
rtc_nsteps
?.
eapply
(
soundness
(
M
:
=
iResUR
Σ
)
_
(
S
(
S
n
))).
eapply
(
soundness
(
M
:
=
iResUR
Σ
)
_
(
S
(
S
n
))).
iMod
wsat_alloc
as
(
Hinv
)
"[Hw HE]"
.
iMod
wsat_alloc
as
(
Hinv
)
"[Hw HE]"
.
rewrite
fupd_eq
in
Hwp
;
iMod
(
Hwp
with
"[$Hw $HE]"
)
as
">(Hw & HE & Hwp)"
.
rewrite
fupd_eq
in
Hwp
;
iMod
(
Hwp
with
"[$Hw $HE]"
)
as
">(Hw & HE & Hwp)"
.
iDestruct
"Hwp"
as
(
Istate
)
"[HI Hwp]"
.
iDestruct
"Hwp"
as
(
Istate
)
"[HI Hwp]"
.
iApply
(@
wptp_safe
_
_
(
IrisG
_
_
Hinv
Istate
))
;
eauto
with
iFrame
.
iApply
(@
wptp_safe
_
_
(
IrisG
_
_
Hinv
Istate
)
true
)
;
eauto
with
iFrame
.
Qed
.
Qed
.
Theorem
wp_invariance
Σ
Λ
`
{
invPreG
Σ
}
e
σ
1
t2
σ
2
φ
:
Theorem
wp_invariance
Σ
Λ
`
{
invPreG
Σ
}
p
e
σ
1
t2
σ
2
φ
:
(
∀
`
{
Hinv
:
invG
Σ
},
(
∀
`
{
Hinv
:
invG
Σ
},
(|={
⊤
}=>
∃
stateI
:
state
Λ
→
iProp
Σ
,
(|={
⊤
}=>
∃
stateI
:
state
Λ
→
iProp
Σ
,
let
_
:
irisG
Λ
Σ
:
=
IrisG
_
_
Hinv
stateI
in
let
_
:
irisG
Λ
Σ
:
=
IrisG
_
_
Hinv
stateI
in
stateI
σ
1
∗
WP
e
{{
_
,
True
}}
∗
(
stateI
σ
2
={
⊤
,
∅
}=
∗
⌜φ⌝
))%
I
)
→
stateI
σ
1
∗
WP
e
@
p
;
⊤
{{
_
,
True
}}
∗
(
stateI
σ
2
={
⊤
,
∅
}=
∗
⌜φ⌝
))%
I
)
→
rtc
step
([
e
],
σ
1
)
(
t2
,
σ
2
)
→
rtc
step
([
e
],
σ
1
)
(
t2
,
σ
2
)
→
φ
.
φ
.
Proof
.
Proof
.
...
...
theories/program_logic/ectx_language.v
View file @
5b4cd196
...
@@ -127,6 +127,16 @@ Section ectx_language.
...
@@ -127,6 +127,16 @@ Section ectx_language.
rewrite
fill_empty
.
eapply
Hatomic_step
.
by
rewrite
fill_empty
.
rewrite
fill_empty
.
eapply
Hatomic_step
.
by
rewrite
fill_empty
.
Qed
.
Qed
.
Lemma
ectx_language_strongly_atomic
e
:
(
∀
σ
e'
σ
'
efs
,
head_step
e
σ
e'
σ
'
efs
→
is_Some
(
to_val
e'
))
→
sub_values
e
→
StronglyAtomic
e
.
Proof
.
intros
Hatomic_step
Hatomic_fill
σ
e'
σ
'
efs
[
K
e1'
e2'
->
->
Hstep
].
assert
(
K
=
empty_ectx
)
as
->
by
eauto
10
using
val_stuck
.
rewrite
fill_empty
.
eapply
Hatomic_step
.
by
rewrite
fill_empty
.
Qed
.
Lemma
head_reducible_prim_step
e1
σ
1 e2
σ
2
efs
:
Lemma
head_reducible_prim_step
e1
σ
1 e2
σ
2
efs
:
head_reducible
e1
σ
1
→
head_reducible
e1
σ
1
→
prim_step
e1
σ
1 e2
σ
2
efs
→
prim_step
e1
σ
1 e2
σ
2
efs
→
...
...
theories/program_logic/ectx_lifting.v
View file @
5b4cd196
...
@@ -12,61 +12,93 @@ Implicit Types v : val.
...
@@ -12,61 +12,93 @@ Implicit Types v : val.
Implicit
Types
e
:
expr
.
Implicit
Types
e
:
expr
.
Hint
Resolve
head_prim_reducible
head_reducible_prim_step
.
Hint
Resolve
head_prim_reducible
head_reducible_prim_step
.
Lemma
wp_ectx_bind
{
E
Φ
}
K
e
:
Definition
head_progressive
(
e
:
expr
)
(
σ
:
state
)
:
=
WP
e
@
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
E
{{
Φ
}}
}}
⊢
WP
fill
K
e
@
E
{{
Φ
}}.
is_Some
(
to_val
e
)
∨
∃
K
e'
,
e
=
fill
K
e'
∧
head_reducible
e'
σ
.
Lemma
progressive_head_progressive
e
σ
:
progressive
e
σ
→
head_progressive
e
σ
.
Proof
.
case
=>[?|
Hred
]
;
first
by
left
.
right
.
move
:
Hred
=>
[]
e'
[]
σ
'
[]
efs
[]
K
e1'
e2'
EQ
EQ'
Hstep
.
subst
.
exists
K
,
e1'
.
split
;
first
done
.
by
exists
e2'
,
σ
'
,
efs
.
Qed
.
Hint
Resolve
progressive_head_progressive
.
Lemma
wp_ectx_bind
{
p
E
e
}
K
Φ
:
WP
e
@
p
;
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
p
;
E
{{
Φ
}}
}}
⊢
WP
fill
K
e
@
p
;
E
{{
Φ
}}.
Proof
.
apply
:
weakestpre
.
wp_bind
.
Qed
.
Proof
.
apply
:
weakestpre
.
wp_bind
.
Qed
.
Lemma
wp_ectx_bind_inv
{
E
Φ
}
K
e
:
Lemma
wp_ectx_bind_inv
{
p
E
Φ
}
K
e
:
WP
fill
K
e
@
E
{{
Φ
}}
⊢
WP
e
@
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
E
{{
Φ
}}
}}.
WP
fill
K
e
@
p
;
E
{{
Φ
}}
⊢
WP
e
@
p
;
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
p
;
E
{{
Φ
}}
}}.
Proof
.
apply
:
weakestpre
.
wp_bind_inv
.
Qed
.
Proof
.
apply
:
weakestpre
.
wp_bind_inv
.
Qed
.
Lemma
wp_lift_head_step
{
E
Φ
}
e1
:
Lemma
wp_lift_head_step
{
p
E
Φ
}
e1
:
to_val
e1
=
None
→
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
,
∅
}=
∗
(
∀
σ
1
,
state_interp
σ
1
={
E
,
∅
}=
∗
⌜
head_reducible
e1
σ
1
⌝
∗
⌜
head_reducible
e1
σ
1
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
={
∅
,
E
}=
∗
▷
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
={
∅
,
E
}=
∗
state_interp
σ
2
∗
WP
e2
@
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
state_interp
σ
2
∗
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
Proof
.
iIntros
(?)
"H"
.
iApply
(
wp_lift_step
E
)
=>//.
iIntros
(
σ
1
)
"Hσ"
.
iIntros
(?)
"H"
.
iApply
wp_lift_step
=>//.
iIntros
(
σ
1
)
"Hσ"
.
iMod
(
"H"
$!
σ
1
with
"Hσ"
)
as
"[% H]"
;
iModIntro
.
iMod
(
"H"
$!
σ
1
with
"Hσ"
)
as
"[% H]"
;
iModIntro
.
iSplit
;
first
by
eauto
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"%"
.
iSplit
;
first
by
eauto
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"%"
.
iApply
"H"
.
by
eauto
.
iApply
"H"
.
by
eauto
.
Qed
.
Qed
.
Lemma
wp_lift_pure_head_step
{
E
E'
Φ
}
e1
:
Lemma
wp_lift_head_stuck
E
Φ
e
:
to_val
e
=
None
→
(
∀
σ
,
state_interp
σ
={
E
,
∅
}=
∗
⌜
¬
head_progressive
e
σ⌝
)
⊢
WP
e
@
E
?{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_lift_stuck
;
first
done
.
iIntros
(
σ
)
"Hσ"
.
iMod
(
"H"
$!
_
with
"Hσ"
)
as
"%"
.
iModIntro
.
by
auto
.
Qed
.
Lemma
wp_lift_pure_head_step
{
p
E
E'
Φ
}
e1
:
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1 e2
σ
2
efs
,
head_step
e1
σ
1 e2
σ
2
efs
→
σ
1
=
σ
2
)
→
(
∀
σ
1 e2
σ
2
efs
,
head_step
e1
σ
1 e2
σ
2
efs
→
σ
1
=
σ
2
)
→
(|={
E
,
E'
}
▷
=>
∀
e2
efs
σ
,
⌜
head_step
e1
σ
e2
σ
efs
⌝
→
(|={
E
,
E'
}
▷
=>
∀
e2
efs
σ
,
⌜
head_step
e1
σ
e2
σ
efs
⌝
→
WP
e2
@
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
Proof
using
Hinh
.
iIntros