Skip to content
GitLab
Menu
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
1847520d
Commit
1847520d
authored
Dec 22, 2016
by
David Swasey
Browse files
Do not try to lift with conditional head_reducibility.
parent
e2d12989
Changes
3
Hide whitespace changes
Inline
Side-by-side
theories/program_logic/ectx_language.v
View file @
1847520d
...
...
@@ -61,6 +61,8 @@ Section ectx_language.
∃
e'
σ
'
efs
,
head_step
e
σ
e'
σ
'
efs
.
Definition
head_irreducible
(
e
:
expr
)
(
σ
:
state
)
:
=
∀
e'
σ
'
efs
,
¬
head_step
e
σ
e'
σ
'
efs
.
Definition
head_progressive
(
e
:
expr
)
(
σ
:
state
)
:
=
is_Some
(
to_val
e
)
∨
∃
K
e'
,
e
=
fill
K
e'
∧
head_reducible
e'
σ
.
(* All non-value redexes are at the root. In other words, all sub-redexes are
values. *)
...
...
@@ -117,6 +119,14 @@ Section ectx_language.
rewrite
-
not_reducible
-
not_head_reducible
.
eauto
using
prim_head_reducible
.
Qed
.
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
.
Lemma
ectx_language_strong_atomic
e
:
(
∀
σ
e'
σ
'
efs
,
head_step
e
σ
e'
σ
'
efs
→
is_Some
(
to_val
e'
))
→
sub_redexes_are_values
e
→
...
...
theories/program_logic/ectx_lifting.v
View file @
1847520d
...
...
@@ -13,17 +13,6 @@ Implicit Types v : val.
Implicit
Types
e
:
expr
.
Hint
Resolve
head_prim_reducible
head_reducible_prim_step
.
Hint
Resolve
(
reducible_not_val
_
inhabitant
).
Definition
head_progressive
(
e
:
expr
)
(
σ
:
state
)
:
=
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
Φ
:
...
...
@@ -50,25 +39,6 @@ Proof.
iApply
"H"
;
eauto
.
Qed
.
(*
PDS: Discard. It's confusing. In practice, we just need rules
like wp_lift_head_{step,stuck}.
*)
Lemma
wp_strong_lift_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
,
∅
}=
∗
⌜
if
p
then
head_reducible
e1
σ
1
else
True
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1 e2
σ
2
efs
⌝
={
∅
,
E
}=
∗
state_interp
σ
2
∗
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_lift_step
=>//.
iIntros
(
σ
1
)
"Hσ"
.
iMod
(
"H"
with
"Hσ"
)
as
"[% H]"
;
iModIntro
.
iSplit
;
first
by
destruct
p
;
eauto
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"%"
.
iApply
"H"
;
eauto
.
Qed
.
Lemma
wp_lift_head_stuck
E
Φ
e
:
to_val
e
=
None
→
(
∀
σ
,
state_interp
σ
={
E
,
∅
}=
∗
⌜
¬
head_progressive
e
σ⌝
)
...
...
@@ -91,18 +61,6 @@ Proof using Hinh.
iIntros
(????).
iApply
"H"
;
eauto
.
Qed
.
(* PDS: Discard. *)
Lemma
wp_strong_lift_pure_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
σ
2
efs
,
prim_step
e1
σ
1 e2
σ
2
efs
→
σ
1
=
σ
2
)
→
(
▷
∀
e2
efs
σ
,
⌜
prim_step
e1
σ
e2
σ
efs
⌝
→
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
iIntros
(???)
"H"
.
iApply
wp_lift_pure_step
;
eauto
.
by
destruct
p
;
auto
.
Qed
.
Lemma
wp_lift_pure_head_stuck
E
Φ
e
:
to_val
e
=
None
→
(
∀
K
e1
σ
1 e2
σ
2
efs
,
e
=
fill
K
e1
→
¬
head_step
e1
σ
1 e2
σ
2
efs
)
→
...
...
@@ -114,43 +72,28 @@ Proof using Hinh.
move
=>[]
K
[]
e1
[]
Hfill
[]
e2
[]
σ
2
[]
efs
/=
Hstep
.
exact
:
Hnstep
.
Qed
.
Lemma
wp_lift_atomic_head_step
{
E
Φ
}
e1
:
Lemma
wp_lift_atomic_head_step
{
p
E
Φ
}
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
}=
∗
⌜
head_reducible
e1
σ
1
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
={
E
}=
∗
state_interp
σ
2
∗
default
False
(
to_val
e2
)
Φ
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_lift_atomic_step
;
eauto
.
iIntros
(
σ
1
)
"Hσ1"
.
iMod
(
"H"
$!
σ
1
with
"Hσ1"
)
as
"[% H]"
;
iModIntro
.
iSplit
;
first
by
eauto
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"%"
.
iApply
"H"
;
auto
.
Qed
.
(* PDS: Discard. *)
Lemma
wp_strong_lift_atomic_head_step
{
p
E
Φ
}
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
}=
∗
⌜
if
p
then
head_reducible
e1
σ
1
else
True
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1 e2
σ
2
efs
⌝
={
E
}=
∗
state_interp
σ
2
∗
default
False
(
to_val
e2
)
Φ
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
default
False
(
to_val
e2
)
Φ
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_lift_atomic_step
;
eauto
.
iIntros
(
σ
1
)
"Hσ1"
.
iMod
(
"H"
$!
σ
1
with
"Hσ1"
)
as
"[% H]"
;
iModIntro
.
iSplit
;
first
by
destruct
p
;
e
auto
.
by
iNext
;
iIntros
(
e2
σ
2
efs
?)
;
iApply
"H"
;
e
auto
.
iIntros
(
σ
1
)
"Hσ1"
.
iMod
(
"H"
with
"Hσ1"
)
as
"[% H]"
;
iModIntro
.
iSplit
;
first
by
destruct
p
;
auto
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"%"
.
iApply
"H"
;
auto
.
Qed
.
Lemma
wp_lift_atomic_head_step_no_fork
{
E
Φ
}
e1
:
Lemma
wp_lift_atomic_head_step_no_fork
{
p
E
Φ
}
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
}=
∗
⌜
head_reducible
e1
σ
1
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
={
E
}=
∗
⌜
efs
=
[]
⌝
∗
state_interp
σ
2
∗
default
False
(
to_val
e2
)
Φ
)
⊢
WP
e1
@
E
{{
Φ
}}.
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_lift_atomic_head_step
;
eauto
.
iIntros
(
σ
1
)
"Hσ1"
.
iMod
(
"H"
$!
σ
1
with
"Hσ1"
)
as
"[$ H]"
;
iModIntro
.
...
...
@@ -158,22 +101,6 @@ Proof.
iMod
(
"H"
$!
v2
σ
2
efs
with
"[# //]"
)
as
"(% & $ & $)"
;
subst
;
auto
.
Qed
.
(* PDS: Discard. *)
Lemma
wp_strong_lift_atomic_head_step_no_fork
{
p
E
Φ
}
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
state_interp
σ
1
={
E
}=
∗
⌜
if
p
then
head_reducible
e1
σ
1
else
True
⌝
∗
▷
∀
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1 e2
σ
2
efs
⌝
={
E
}=
∗
⌜
efs
=
[]
⌝
∗
state_interp
σ
2
∗
default
False
(
to_val
e2
)
Φ
)
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
wp_strong_lift_atomic_head_step
;
eauto
.
iIntros
(
σ
1
)
"Hσ1"
.
iMod
(
"H"
with
"Hσ1"
)
as
"[$ H]"
;
iModIntro
.
iNext
;
iIntros
(
v2
σ
2
efs
)
"%"
.
iMod
(
"H"
with
"[#]"
)
as
"(% & $ & $)"
=>//
;
subst
.
by
iApply
big_sepL_nil
.
Qed
.
Lemma
wp_lift_pure_det_head_step
{
p
E
E'
Φ
}
e1
e2
efs
:
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
...
...
@@ -185,19 +112,6 @@ Proof using Hinh.
destruct
p
;
by
auto
.
Qed
.
(* PDS: Discard. *)
Lemma
wp_strong_lift_pure_det_head_step
{
p
E
Φ
}
e1
e2
efs
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
efs
=
efs'
)
→
▷
(
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
iIntros
(???)
"H"
;
iApply
wp_lift_pure_det_step
;
eauto
.
by
destruct
p
;
eauto
.
Qed
.
Lemma
wp_lift_pure_det_head_step_no_fork
{
p
E
E'
Φ
}
e1
e2
:
to_val
e1
=
None
→
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
...
...
@@ -219,16 +133,4 @@ Proof using Hinh.
intros
.
rewrite
-[(
WP
e1
@
_
{{
_
}})%
I
]
wp_lift_pure_det_head_step_no_fork
//.
rewrite
-
step_fupd_intro
//.
Qed
.
(* PDS: Discard. *)
Lemma
wp_strong_lift_pure_det_head_step_no_fork
{
p
E
Φ
}
e1
e2
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
[]
=
efs'
)
→
▷
WP
e2
@
p
;
E
{{
Φ
}}
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
intros
.
rewrite
-(
wp_lift_pure_det_step
e1
e2
[])
?big_sepL_nil
?right_id
;
eauto
.
by
destruct
p
;
eauto
.
Qed
.
End
wp
.
theories/program_logic/ownp.v
View file @
1847520d
...
...
@@ -201,140 +201,82 @@ Section ectx_lifting.
Implicit
Types
Φ
:
val
→
iProp
Σ
.
Implicit
Types
e
:
expr
.
Hint
Resolve
head_prim_reducible
head_reducible_prim_step
.
Hint
Resolve
(
reducible_not_val
_
inhabitant
).
Hint
Resolve
progressive_head_progressive
.
Lemma
ownP_lift_head_step
E
Φ
e1
:
Lemma
ownP_lift_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(|={
E
,
∅
}=>
∃
σ
1
,
⌜
head_reducible
e1
σ
1
⌝
∗
▷
ownP
σ
1
∗
▷
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
-
∗
ownP
σ
2
={
∅
,
E
}=
∗
WP
e2
@
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
={
∅
,
E
}=
∗
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
ownP_lift_step
;
first
done
.
iMod
"H"
as
(
σ
1
?)
"[Hσ1 Hwp]"
.
iModIntro
.
iExists
σ
1
.
iSplit
;
first
by
eauto
.
iFrame
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"% ?"
.
iSplit
;
first
by
destruct
p
;
eauto
.
iFrame
.
iNext
.
iIntros
(
e2
σ
2
efs
)
"% ?"
.
iApply
(
"Hwp"
with
"[]"
)
;
eauto
.
Qed
.
(* PDS: Discard *)
Lemma
ownP_strong_lift_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(|={
E
,
∅
}=>
∃
σ
1
,
⌜
if
p
then
head_reducible
e1
σ
1
else
True
⌝
∗
▷
ownP
σ
1
∗
▷
∀
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1 e2
σ
2
efs
⌝
-
∗
ownP
σ
2
={
∅
,
E
}=
∗
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Lemma
ownP_lift_head_stuck
E
Φ
e
:
(|={
E
,
∅
}=>
∃
σ
,
⌜
¬
head_progressive
e
σ⌝
∗
▷
ownP
σ
)
⊢
WP
e
@
E
?{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
;
iApply
ownP_lift_step
;
first
done
.
iMod
"H"
as
(
σ
1
)
"(%&Hσ1&Hwp)"
.
iModIntro
.
iExists
σ
1
.
iSplit
;
first
by
destruct
p
;
eauto
.
by
iFrame
.
iIntros
"H"
.
iApply
ownP_lift_stuck
.
iMod
"H"
as
(
σ
)
"[% >Hσ]"
.
iModIntro
.
iExists
σ
.
iFrame
"Hσ"
.
by
eauto
.
Qed
.
Lemma
ownP_lift_pure_head_step
E
Φ
e1
:
Lemma
ownP_lift_pure_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1 e2
σ
2
efs
,
head_step
e1
σ
1 e2
σ
2
efs
→
σ
1
=
σ
2
)
→
(
▷
∀
e2
efs
σ
,
⌜
head_step
e1
σ
e2
σ
efs
⌝
→
WP
e2
@
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
using
Hinh
.
iIntros
(??)
"H"
.
iApply
ownP_lift_pure_step
;
simpl
;
eauto
using
(
reducible_not_val
_
inhabitant
).
iNext
.
iIntros
(????).
iApply
"H"
;
eauto
.
Qed
.
(* PDS: Discard. *)
Lemma
ownP_strong_lift_pure_head_step
p
E
Φ
e1
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
σ
2
efs
,
prim_step
e1
σ
1 e2
σ
2
efs
→
σ
1
=
σ
2
)
→
(
▷
∀
e2
efs
σ
,
⌜
prim_step
e1
σ
e2
σ
efs
⌝
→
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
iIntros
(???)
"H"
.
iApply
ownP_lift_pure_step
;
eauto
.
by
destruct
p
;
eauto
.
iIntros
(???)
"H"
.
iApply
ownP_lift_pure_step
;
eauto
.
{
by
destruct
p
;
auto
.
}
iNext
.
iIntros
(????).
iApply
"H"
;
eauto
.
Qed
.
Lemma
ownP_lift_atomic_head_step
{
E
Φ
}
e1
σ
1
:
Lemma
ownP_lift_atomic_head_step
{
p
E
Φ
}
e1
σ
1
:
to_val
e1
=
None
→
head_reducible
e1
σ
1
→
▷
ownP
σ
1
∗
▷
(
∀
e2
σ
2
efs
,
⌜
head_step
e1
σ
1 e2
σ
2
efs
⌝
-
∗
ownP
σ
2
-
∗
default
False
(
to_val
e2
)
Φ
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"[? H]"
.
iApply
ownP_lift_atomic_step
;
simpl
;
eauto
using
reducible_not_val
.
iFrame
.
iNext
.
iIntros
(???)
"% ?"
.
iApply
(
"H"
with
"[]"
)
;
eauto
.
Qed
.
(* PDS: Discard. *)
Lemma
ownP_strong_lift_atomic_head_step
{
p
E
Φ
}
e1
σ
1
:
to_val
e1
=
None
→
(
if
p
then
head_reducible
e1
σ
1
else
True
)
→
▷
ownP
σ
1
∗
▷
(
∀
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1 e2
σ
2
efs
⌝
-
∗
ownP
σ
2
-
∗
default
False
(
to_val
e2
)
Φ
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
iIntros
(??)
"[? H]"
.
iApply
ownP_lift_atomic_step
;
eauto
;
try
iFrame
.
by
destruct
p
;
eauto
.
iIntros
(??)
"[? H]"
.
iApply
ownP_lift_atomic_step
;
eauto
.
{
by
destruct
p
;
eauto
.
}
iFrame
.
iNext
.
iIntros
(???)
"% ?"
.
iApply
(
"H"
with
"[]"
)
;
eauto
.
Qed
.
Lemma
ownP_lift_atomic_det_head_step
{
E
Φ
e1
}
σ
1
v2
σ
2
efs
:
Lemma
ownP_lift_atomic_det_head_step
{
p
E
Φ
e1
}
σ
1
v2
σ
2
efs
:
to_val
e1
=
None
→
head_reducible
e1
σ
1
→
(
∀
e2'
σ
2
'
efs'
,
head_step
e1
σ
1 e2
'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
efs
=
efs'
)
→
▷
ownP
σ
1
∗
▷
(
ownP
σ
2
-
∗
Φ
v2
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
.
by
eauto
10
using
ownP_lift_atomic_det_step
,
reducible_not_val
.
Qed
.
Lemma
ownP_strong_lift_atomic_det_head_step
{
p
E
Φ
e1
}
σ
1
v2
σ
2
efs
:
to_val
e1
=
None
→
(
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
efs
=
efs'
)
→
▷
ownP
σ
1
∗
▷
(
ownP
σ
2
-
∗
Φ
v2
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
.
by
destruct
p
;
eauto
10
using
ownP_lift_atomic_det_step
.
Qed
.
Lemma
ownP_lift_atomic_det_head_step_no_fork
{
E
e1
}
σ
1
v2
σ
2
:
Lemma
ownP_lift_atomic_det_head_step_no_fork
{
p
E
e1
}
σ
1
v2
σ
2
:
to_val
e1
=
None
→
head_reducible
e1
σ
1
→
(
∀
e2'
σ
2
'
efs'
,
head_step
e1
σ
1 e2
'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
[]
=
efs'
)
→
{{{
▷
ownP
σ
1
}}}
e1
@
E
{{{
RET
v2
;
ownP
σ
2
}}}.
Proof
.
by
eauto
10
using
ownP_lift_atomic_det_step_no_fork
,
reducible_not_val
.
Qed
.
(* PDS: Discard. *)
Lemma
ownP_strong_lift_atomic_det_head_step_no_fork
{
p
E
e1
}
σ
1
v2
σ
2
:
to_val
e1
=
None
→
(
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
[]
=
efs'
)
→
{{{
▷
ownP
σ
1
}}}
e1
@
p
;
E
{{{
RET
v2
;
ownP
σ
2
}}}.
Proof
.
intros
???
;
apply
ownP_lift_atomic_det_step_no_fork
;
eauto
.
by
destruct
p
;
eauto
.
Qed
.
Lemma
ownP_lift_pure_det_head_step
{
E
Φ
}
e1
e2
efs
:
Lemma
ownP_lift_pure_det_head_step
{
p
E
Φ
}
e1
e2
efs
:
to_val
e1
=
None
→
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
head_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
efs
=
efs'
)
→
▷
(
WP
e2
@
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
{{
_
,
True
}})
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
using
Hinh
.
intros
.
rewrite
-[(
WP
e1
@
_
{{
_
}})%
I
]
wp_lift_pure_det_step
;
eauto
using
(
reducible_not_val
_
inhabitant
).
Qed
.
(* PDS: Discard. *)
Lemma
ownP_strong_lift_pure_det_head_step
{
p
E
Φ
}
e1
e2
efs
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
efs
=
efs'
)
→
▷
(
WP
e2
@
p
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
p
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
...
...
@@ -342,18 +284,10 @@ Section ectx_lifting.
by
destruct
p
;
eauto
.
Qed
.
Lemma
ownP_lift_pure_det_head_step_no_fork
{
E
Φ
}
e1
e2
:
Lemma
ownP_lift_pure_det_head_step_no_fork
{
p
E
Φ
}
e1
e2
:
to_val
e1
=
None
→
(
∀
σ
1
,
head_reducible
e1
σ
1
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
head_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
[]
=
efs'
)
→
▷
WP
e2
@
E
{{
Φ
}}
⊢
WP
e1
@
E
{{
Φ
}}.
Proof
using
Hinh
.
by
eauto
using
ownP_lift_pure_det_step_no_fork
.
Qed
.
(* PDS: Discard. *)
Lemma
ownP_strong_lift_pure_det_head_step_no_fork
{
p
E
Φ
}
e1
e2
:
to_val
e1
=
None
→
(
∀
σ
1
,
if
p
then
head_reducible
e1
σ
1
else
True
)
→
(
∀
σ
1 e2
'
σ
2
efs'
,
prim_step
e1
σ
1 e2
'
σ
2
efs'
→
σ
1
=
σ
2
∧
e2
=
e2'
∧
[]
=
efs'
)
→
▷
WP
e2
@
p
;
E
{{
Φ
}}
⊢
WP
e1
@
p
;
E
{{
Φ
}}.
Proof
using
Hinh
.
iIntros
(???)
"H"
.
iApply
ownP_lift_pure_det_step_no_fork
;
eauto
.
...
...
Write
Preview
Supports
Markdown
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