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
Lennard Gäher
Iris
Commits
8eea9afe
Commit
8eea9afe
authored
Jul 26, 2018
by
Marianna Rapoport
Committed by
Ralf Jung
Oct 05, 2018
Browse files
Proving ownp.v and including it back into the build
parent
7a6f4567
Changes
2
Hide whitespace changes
Inline
Side-by-side
_CoqProject
View file @
8eea9afe
...
...
@@ -76,7 +76,7 @@ theories/program_logic/language.v
theories/program_logic/ectx_language.v
theories/program_logic/ectxi_language.v
theories/program_logic/ectx_lifting.v
#
theories/program_logic/ownp.v
theories/program_logic/ownp.v
theories/program_logic/total_lifting.v
theories/program_logic/total_ectx_lifting.v
theories/program_logic/atomic.v
...
...
theories/program_logic/ownp.v
View file @
8eea9afe
...
...
@@ -7,24 +7,29 @@ Set Default Proof Using "Type".
Class
ownPG'
(
Λ
state
Λ
observation
:
Type
)
(
Σ
:
gFunctors
)
:
=
OwnPG
{
ownP_invG
:
invG
Σ
;
ownP_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
prodC
(
leibnizC
Λ
state
)
(
leibnizC
(
list
Λ
observation
))))))
;
ownP_name
:
gname
;
ownP_state_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
leibnizC
Λ
state
))))
;
ownP_obs_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
leibnizC
(
list
Λ
observation
)))))
;
ownP_state_name
:
gname
;
ownP_obs_name
:
gname
}.
Notation
ownPG
Λ
Σ
:
=
(
ownPG'
(
state
Λ
)
(
observation
Λ
)
Σ
).
Instance
ownPG_irisG
`
{
ownPG'
Λ
state
Λ
observation
Σ
}
:
irisG'
Λ
state
Λ
observation
Σ
:
=
{
iris_invG
:
=
ownP_invG
;
state_interp
σ
κ
s
:
=
own
ownP_name
(
●
(
Excl'
((
σ
:
leibnizC
Λ
state
),
(
κ
s
:
leibnizC
(
list
Λ
observation
)))))
state_interp
σ
κ
s
:
=
(
own
ownP_state_name
(
●
(
Excl'
(
σ
:
leibnizC
Λ
state
)))
∗
own
ownP_obs_name
(
●
(
Excl'
(
κ
s
:
leibnizC
(
list
Λ
observation
)))))%
I
}.
Global
Opaque
iris_invG
.
Definition
ownP
Σ
(
Λ
state
Λ
observation
:
Type
)
:
gFunctors
:
=
#[
inv
Σ
;
GFunctor
(
authUR
(
optionUR
(
exclR
(
prodC
(
leibnizC
Λ
state
)
(
leibnizC
(
list
Λ
observation
))))))].
GFunctor
(
authR
(
optionUR
(
exclR
(
leibnizC
Λ
state
))))
;
GFunctor
(
authR
(
optionUR
(
exclR
(
leibnizC
(
list
Λ
observation
)))))].
Class
ownPPreG'
(
Λ
state
Λ
observation
:
Type
)
(
Σ
:
gFunctors
)
:
Set
:
=
IrisPreG
{
ownPPre_invG
:
>
invPreG
Σ
;
ownPPre_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
prodC
(
leibnizC
Λ
state
)
(
leibnizC
(
list
Λ
observation
))))))
ownPPre_state_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
leibnizC
Λ
state
))))
;
ownPPre_obs_inG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
(
leibnizC
(
list
Λ
observation
)))))
}.
Notation
ownPPreG
Λ
Σ
:
=
(
ownPPreG'
(
state
Λ
)
(
observation
Λ
)
Σ
).
...
...
@@ -32,40 +37,54 @@ Instance subG_ownPΣ {Λstate Λobservation Σ} : subG (ownPΣ Λstate Λobserva
Proof
.
solve_inG
.
Qed
.
(** Ownership *)
Definition
ownP
`
{
ownPG'
Λ
state
Λ
observation
Σ
}
(
σ
:
Λ
state
)
(
κ
s
:
list
Λ
observation
)
:
iProp
Σ
:
=
own
ownP_name
(
◯
(
Excl'
(
σ
,
κ
s
))).
Typeclasses
Opaque
ownP
.
Instance
:
Params
(@
ownP
)
3
.
Definition
ownP_state
`
{
ownPG'
Λ
state
Λ
observation
Σ
}
(
σ
:
Λ
state
)
:
iProp
Σ
:
=
own
ownP_state_name
(
◯
(
Excl'
(
σ
:
leibnizC
Λ
state
))).
Definition
ownP_obs
`
{
ownPG'
Λ
state
Λ
observation
Σ
}
(
κ
s
:
list
Λ
observation
)
:
iProp
Σ
:
=
own
ownP_obs_name
(
◯
(
Excl'
(
κ
s
:
leibnizC
(
list
Λ
observation
)))).
Typeclasses
Opaque
ownP_state
ownP_obs
.
Instance
:
Params
(@
ownP_state
)
3
.
Instance
:
Params
(@
ownP_obs
)
3
.
(* Adequacy *)
Theorem
ownP_adequacy
Σ
`
{
ownPPreG
Λ
Σ
}
s
e
σ
φ
:
(
∀
`
{
ownPG
Λ
Σ
}
κ
s
,
ownP
σ
κ
s
⊢
WP
e
@
s
;
⊤
{{
v
,
⌜φ
v
⌝
}})
→
(
∀
`
{
ownPG
Λ
Σ
}
κ
s
,
ownP
_state
σ
∗
ownP_obs
κ
s
⊢
WP
e
@
s
;
⊤
{{
v
,
⌜φ
v
⌝
}})
→
adequate
s
e
σ
(
λ
v
_
,
φ
v
).
Proof
.
intros
Hwp
.
apply
(
wp_adequacy
Σ
_
).
iIntros
(?
κ
s
).
iMod
(
own_alloc
(
●
(
Excl'
(
σ
:
leibnizC
_
,
κ
s
:
leibnizC
_
))
⋅
◯
(
Excl'
(
σ
,
κ
s
))))
iIntros
(?
κ
s
).
iMod
(
own_alloc
(
●
(
Excl'
(
σ
:
leibnizC
_
))
⋅
◯
(
Excl'
σ
)))
as
(
γσ
)
"[Hσ Hσf]"
;
first
done
.
iModIntro
.
iExists
(
λ
σ
κ
s
,
own
γσ
(
●
(
Excl'
(
σ
:
leibnizC
_
,
κ
s
:
leibnizC
_
)))).
iFrame
"Hσ"
.
iApply
(
Hwp
(
OwnPG
_
_
_
_
_
γσ
)).
by
rewrite
/
ownP
.
iMod
(
own_alloc
(
●
(
Excl'
(
κ
s
:
leibnizC
_
))
⋅
◯
(
Excl'
κ
s
)))
as
(
γκ
s
)
"[Hκs Hκsf]"
;
first
done
.
iModIntro
.
iExists
(
λ
σ
κ
s
,
own
γσ
(
●
(
Excl'
(
σ
:
leibnizC
_
)))
∗
own
γκ
s
(
●
(
Excl'
(
κ
s
:
leibnizC
_
))))%
I
.
iFrame
"Hσ Hκs"
.
iApply
(
Hwp
(
OwnPG
_
_
_
_
_
_
γσ
γκ
s
)).
rewrite
/
ownP_state
/
ownP_obs
.
iFrame
.
Qed
.
Theorem
ownP_invariance
Σ
`
{
ownPPreG
Λ
Σ
}
s
e
σ
1
t2
σ
2
φ
:
(
∀
`
{
ownPG
Λ
Σ
}
κ
s
,
ownP
σ
1
κ
s
={
⊤
}=
∗
WP
e
@
s
;
⊤
{{
_
,
True
}}
∗
|={
⊤
,
∅
}=>
∃
σ
'
κ
s'
,
ownP
σ
'
κ
s'
∧
⌜φ
σ
'
⌝
)
→
ownP_state
σ
1
∗
ownP_obs
κ
s
={
⊤
}=
∗
WP
e
@
s
;
⊤
{{
_
,
True
}}
∗
|={
⊤
,
∅
}=>
∃
σ
'
κ
s'
,
ownP_state
σ
'
∗
ownP_obs
κ
s'
∧
⌜φ
σ
'
⌝
)
→
rtc
erased_step
([
e
],
σ
1
)
(
t2
,
σ
2
)
→
φ
σ
2
.
Proof
.
intros
Hwp
Hsteps
.
eapply
(
wp_invariance
Σ
Λ
s
e
σ
1
t2
σ
2
_
)=>
//.
iIntros
(?
κ
s
κ
s'
).
iMod
(
own_alloc
(
●
(
Excl'
(
(
σ
1
:
leibnizC
_
,
κ
s
++
κ
s'
:
leibnizC
_
)
))
⋅
◯
(
Excl'
(
σ
1
,
κ
s
++
κ
s'
)
)))
iMod
(
own_alloc
(
●
(
Excl'
(
σ
1
:
leibnizC
_
))
⋅
◯
(
Excl'
σ
1
)))
as
(
γσ
)
"[Hσ Hσf]"
;
first
done
.
iExists
(
λ
σ
κ
s'
,
own
γσ
(
●
(
Excl'
(
σ
:
leibnizC
_
,
κ
s'
:
leibnizC
_
)))).
iFrame
"Hσ"
.
iMod
(
Hwp
(
OwnPG
_
_
_
_
_
γσ
)
with
"[Hσf]"
)
as
"[$ H]"
;
first
by
rewrite
/
ownP
.
iIntros
"!> Hσ"
.
iMod
"H"
as
(
σ
2
'
κ
s''
)
"[Hσf %]"
.
rewrite
/
ownP
.
iMod
(
own_alloc
(
●
(
Excl'
(
κ
s
++
κ
s'
:
leibnizC
_
))
⋅
◯
(
Excl'
(
κ
s
++
κ
s'
))))
as
(
γκ
s
)
"[Hκs Hκsf]"
;
first
done
.
iExists
(
λ
σ
κ
s'
,
own
γσ
(
●
(
Excl'
(
σ
:
leibnizC
_
)))
∗
own
γκ
s
(
●
(
Excl'
(
κ
s'
:
leibnizC
_
))))%
I
.
iFrame
"Hσ Hκs"
.
iMod
(
Hwp
(
OwnPG
_
_
_
_
_
_
γσ
γκ
s
)
with
"[Hσf Hκsf]"
)
as
"[$ H]"
;
first
by
rewrite
/
ownP_state
/
ownP_obs
;
iFrame
.
iIntros
"!> [Hσ Hκs]"
.
iMod
"H"
as
(
σ
2
'
κ
s''
)
"[Hσf [Hκsf %]]"
.
rewrite
/
ownP_state
/
ownP_obs
.
iDestruct
(
own_valid_2
with
"Hσ Hσf"
)
as
%[
Hp
_
]%
auth_valid_discrete_2
.
pose
proof
(
Excl_included
_
_
Hp
)
as
Hp'
.
apply
leibniz_equiv
in
Hp'
.
inversion
Hp'
;
subst
.
auto
.
(* TODO (MR) inline this proof in introduction pattern? *)
Qed
.
...
...
@@ -76,22 +95,31 @@ Section lifting.
Implicit
Types
e
:
expr
Λ
.
Implicit
Types
Φ
:
val
Λ
→
iProp
Σ
.
Lemma
ownP_eq
σ
1
σ
2
κ
s1
κ
s2
:
state_interp
σ
1
κ
s1
-
∗
ownP
σ
2
κ
s2
-
∗
⌜σ
1
=
σ
2
∧
κ
s1
=
κ
s2
⌝
.
Lemma
ownP_eq
σ
1
σ
2
κ
s1
κ
s2
:
state_interp
σ
1
κ
s1
-
∗
ownP
_state
σ
2
-
∗
ownP_obs
κ
s2
-
∗
⌜σ
1
=
σ
2
∧
κ
s1
=
κ
s2
⌝
.
Proof
.
iIntros
"Hσ1 Hσ2"
;
rewrite
/
ownP
.
iDestruct
(
own_valid_2
with
"Hσ1 Hσ2"
)
as
%[
Hp
_
]%
auth_valid_discrete_2
.
pose
proof
(
Excl_included
_
_
Hp
)
as
Hp'
.
apply
leibniz_equiv
in
Hp'
.
inversion
Hp'
;
subst
.
auto
.
(* TODO (MR) inline this proof in introduction pattern? *)
iIntros
"[Hσ● Hκs●] Hσ◯ Hκs◯"
.
rewrite
/
ownP_state
/
ownP_obs
.
iDestruct
(
own_valid_2
with
"Hσ● Hσ◯"
)
as
%[
Hps
_
]%
auth_valid_discrete_2
.
iDestruct
(
own_valid_2
with
"Hκs● Hκs◯"
)
as
%[
Hpo
_
]%
auth_valid_discrete_2
.
pose
proof
(
leibniz_equiv
_
_
(
Excl_included
_
_
Hps
))
as
->.
pose
proof
(
leibniz_equiv
_
_
(
Excl_included
_
_
Hpo
))
as
->.
done
.
Qed
.
Lemma
ownP_twice
σ
1
σ
2
κ
s1
κ
s2
:
ownP
σ
1
κ
s1
∗
ownP
σ
2
κ
s2
⊢
False
.
Proof
.
rewrite
/
ownP
-
own_op
own_valid
.
by
iIntros
(?).
Qed
.
Global
Instance
ownP_timeless
σ
κ
s
:
Timeless
(@
ownP
(
state
Λ
)
(
observation
Λ
)
Σ
_
σ
κ
s
).
Proof
.
rewrite
/
ownP
;
apply
_
.
Qed
.
Lemma
ownP_state_twice
σ
1
σ
2
:
ownP_state
σ
1
∗
ownP_state
σ
2
⊢
False
.
Proof
.
rewrite
/
ownP_state
-
own_op
own_valid
.
by
iIntros
(?).
Qed
.
Lemma
ownP_obs_twice
κ
s1
κ
s2
:
ownP_obs
κ
s1
∗
ownP_obs
κ
s2
⊢
False
.
Proof
.
rewrite
/
ownP_obs
-
own_op
own_valid
.
by
iIntros
(?).
Qed
.
Global
Instance
ownP_state_timeless
σ
:
Timeless
(@
ownP_state
(
state
Λ
)
(
observation
Λ
)
Σ
_
σ
).
Proof
.
rewrite
/
ownP_state
;
apply
_
.
Qed
.
Global
Instance
ownP_obs_timeless
κ
s
:
Timeless
(@
ownP_obs
(
state
Λ
)
(
observation
Λ
)
Σ
_
κ
s
).
Proof
.
rewrite
/
ownP_obs
;
apply
_
.
Qed
.
Lemma
ownP_lift_step
s
E
Φ
e1
:
(|={
E
,
∅
}=>
∃
σ
1
κ
s
,
⌜
if
s
is
NotStuck
then
reducible
e1
σ
1
else
to_val
e1
=
None
⌝
∗
▷
ownP
σ
1
κ
s
∗
▷
∀
κ
κ
s'
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1
κ
e2
σ
2
efs
∧
κ
s
=
cons_obs
κ
κ
s'
⌝
-
∗
ownP
σ
2
κ
s'
(|={
E
,
∅
}=>
∃
σ
1
κ
s
,
⌜
if
s
is
NotStuck
then
reducible
e1
σ
1
else
to_val
e1
=
None
⌝
∗
▷
ownP_state
σ
1
∗
▷
ownP_obs
κ
s
∗
▷
∀
κ
κ
s'
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1
κ
e2
σ
2
efs
∧
κ
s
=
cons_obs
κ
κ
s'
⌝
-
∗
ownP_state
σ
2
∗
ownP_obs
κ
s'
={
∅
,
E
}=
∗
WP
e2
@
s
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
...
...
@@ -100,26 +128,31 @@ Section lifting.
iMod
"H"
as
(
σ
1
κ
s
)
"[Hred _]"
;
iDestruct
"Hred"
as
%
Hred
.
destruct
s
;
last
done
.
apply
reducible_not_val
in
Hred
.
move
:
Hred
;
by
rewrite
to_of_val
.
-
iApply
wp_lift_step
;
[
done
|]
;
iIntros
(
σ
1
κ
s
)
"Hσ"
.
iMod
"H"
as
(
σ
1
'
κ
s'
?)
"[>Hσf
H
]"
.
iDestruct
(
ownP_eq
with
"Hσ Hσf"
)
as
%[->
->].
-
iApply
wp_lift_step
;
[
done
|]
;
iIntros
(
σ
1
κ
s
)
"Hσ
κs
"
.
iMod
"H"
as
(
σ
1
'
κ
s'
?)
"[>Hσf
[>Hκsf H]
]"
.
iDestruct
(
ownP_eq
with
"Hσ
κs
Hσf
Hκsf
"
)
as
%[->
->].
iModIntro
;
iSplit
;
[
by
destruct
s
|]
;
iNext
;
iIntros
(
κ
κ
s''
e2
σ
2
efs
[
Hstep
->]).
rewrite
/
ownP
;
iMod
(
own_update_2
with
"Hσ Hσf"
)
as
"[Hσ Hσf]"
.
{
apply
auth_update
.
apply
option_local_update
.
(
exclusive_local_update
_
(
Excl
(
σ
2
,
_
))).
}
iFrame
"Hσ"
.
iApply
(
"H"
with
"[]"
)
;
eauto
.
iDestruct
"Hσκs"
as
"[Hσ Hκs]"
.
rewrite
/
ownP_state
/
ownP_obs
.
iMod
(
own_update_2
with
"Hσ Hσf"
)
as
"[Hσ Hσf]"
.
{
apply
auth_update
.
apply
:
option_local_update
.
by
apply
:
(
exclusive_local_update
_
(
Excl
σ
2
)).
}
iMod
(
own_update_2
with
"Hκs Hκsf"
)
as
"[Hκs Hκsf]"
.
{
apply
auth_update
.
apply
:
option_local_update
.
by
apply
:
(
exclusive_local_update
_
(
Excl
(
κ
s''
:
leibnizC
_
))).
}
iFrame
"Hσ Hκs"
.
iApply
(
"H"
with
"[]"
)
;
eauto
with
iFrame
.
Qed
.
Lemma
ownP_lift_stuck
E
Φ
e
:
(|={
E
,
∅
}=>
∃
σ
,
⌜
stuck
e
σ⌝
∗
▷
ownP
σ
)
(|={
E
,
∅
}=>
∃
σ
κ
s
,
⌜
stuck
e
σ⌝
∗
▷
(
ownP
_state
σ
∗
ownP_obs
κ
s
)
)
⊢
WP
e
@
E
?{{
Φ
}}.
Proof
.
iIntros
"H"
.
destruct
(
to_val
e
)
as
[
v
|]
eqn
:
EQe
.
-
apply
of_to_val
in
EQe
as
<-.
iApply
fupd_wp
.
iMod
"H"
as
(
σ
1
)
"[H _]"
.
iDestruct
"H"
as
%[
Hnv
_
].
exfalso
.
iMod
"H"
as
(
σ
1
κ
s
)
"[H _]"
.
iDestruct
"H"
as
%[
Hnv
_
].
exfalso
.
by
rewrite
to_of_val
in
Hnv
.
-
iApply
wp_lift_stuck
;
[
done
|].
iIntros
(
σ
1
)
"Hσ"
.
iMod
"H"
as
(
σ
1
'
)
"(% & >Hσf)"
.
by
iDestruct
(
ownP_eq
with
"Hσ Hσf"
)
as
%
→
.
-
iApply
wp_lift_stuck
;
[
done
|].
iIntros
(
σ
1
κ
s
)
"Hσ"
.
iMod
"H"
as
(
σ
1
'
κ
s'
)
"(% & >
[
Hσf
Hκsf]
)"
.
by
iDestruct
(
ownP_eq
with
"Hσ Hσf
Hκsf
"
)
as
%
[->
_
]
.
Qed
.
Lemma
ownP_lift_pure_step
`
{
Inhabited
(
state
Λ
)}
s
E
Φ
e1
:
...
...
@@ -132,49 +165,53 @@ Section lifting.
iIntros
(
Hsafe
Hstep
)
"H"
;
iApply
wp_lift_step
.
{
specialize
(
Hsafe
inhabitant
).
destruct
s
;
last
done
.
by
eapply
reducible_not_val
.
}
iIntros
(
σ
1
)
"Hσ"
.
iMod
(
fupd_intro_mask'
E
∅
)
as
"Hclose"
;
first
set_solver
.
iModIntro
;
iSplit
;
[
by
destruct
s
|]
;
iNext
;
iIntros
(
κ
e2
σ
2
efs
?
).
iIntros
(
σ
1
κ
s
)
"Hσ"
.
iMod
(
fupd_intro_mask'
E
∅
)
as
"Hclose"
;
first
set_solver
.
iModIntro
;
iSplit
;
[
by
destruct
s
|]
;
iNext
;
iIntros
(
κ
κ
s'
e2
σ
2
efs
[??]
).
destruct
(
Hstep
σ
1
κ
e2
σ
2
efs
)
;
auto
;
subst
.
by
iMod
"Hclose"
;
iModIntro
;
iFrame
;
iApply
"H"
.
Qed
.
(** Derived lifting lemmas. *)
Lemma
ownP_lift_atomic_step
{
s
E
Φ
}
e1
σ
1
:
Lemma
ownP_lift_atomic_step
{
s
E
Φ
}
e1
σ
1
κ
s
:
(
if
s
is
NotStuck
then
reducible
e1
σ
1
else
to_val
e1
=
None
)
→
(
▷
ownP
σ
1
∗
▷
∀
κ
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1
κ
e2
σ
2
efs
⌝
-
∗
ownP
σ
2
-
∗
(
▷
(
ownP_state
σ
1
∗
ownP_obs
κ
s
)
∗
▷
∀
κ
κ
s'
e2
σ
2
efs
,
⌜
prim_step
e1
σ
1
κ
e2
σ
2
efs
∧
κ
s
=
cons_obs
κ
κ
s'
⌝
-
∗
ownP_state
σ
2
-
∗
ownP_obs
κ
s'
-
∗
from_option
Φ
False
(
to_val
e2
)
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"[Hσ H]"
;
iApply
ownP_lift_step
.
iIntros
(?)
"[
[
Hσ
Hκs]
H]"
;
iApply
ownP_lift_step
.
iMod
(
fupd_intro_mask'
E
∅
)
as
"Hclose"
;
first
set_solver
.
iModIntro
;
iExists
σ
1
;
iFrame
;
iSplit
;
first
by
destruct
s
.
iNext
;
iIntros
(
κ
e2
σ
2
efs
)
"% Hσ
"
.
iDestruct
(
"H"
$!
κ
e2
σ
2
efs
with
"[] [Hσ]"
)
as
"[HΦ $]"
;
[
by
eauto
..|].
iModIntro
;
iExists
σ
1
,
κ
s
;
iFrame
;
iSplit
;
first
by
destruct
s
.
iNext
;
iIntros
(
κ
κ
s'
e2
σ
2
efs
[??])
"[Hσ Hκs]
"
.
iDestruct
(
"H"
$!
κ
κ
s'
e2
σ
2
efs
with
"[] [Hσ]
[Hκs]
"
)
as
"[HΦ $]"
;
[
by
eauto
..|].
destruct
(
to_val
e2
)
eqn
:
?
;
last
by
iExFalso
.
iMod
"Hclose"
;
iApply
wp_value
;
last
done
.
by
apply
of_to_val
.
Qed
.
Lemma
ownP_lift_atomic_det_step
{
s
E
Φ
e1
}
σ
1
v2
σ
2
efs
:
Lemma
ownP_lift_atomic_det_step
{
s
E
Φ
e1
}
σ
1
κ
κ
s
v2
σ
2
efs
:
(
if
s
is
NotStuck
then
reducible
e1
σ
1
else
to_val
e1
=
None
)
→
(
∀
κ
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1
κ
e2'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
efs
=
efs'
)
→
▷
ownP
σ
1
∗
▷
(
ownP
σ
2
-
∗
(
∀
κ
'
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1
κ
'
e2'
σ
2
'
efs'
→
κ
=
κ
'
∧
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
efs
=
efs'
)
→
▷
(
ownP
_state
σ
1
∗
ownP_obs
(
cons_obs
κ
κ
s
))
∗
▷
(
ownP_state
σ
2
-
∗
ownP_obs
κ
s
-
∗
Φ
v2
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
iIntros
(?
Hdet
)
"[Hσ1 Hσ2]"
;
iApply
ownP_lift_atomic_step
;
try
done
.
iFrame
;
iNext
;
iIntros
(
κ
e2'
σ
2
'
efs'
)
"% Hσ2'"
.
edestruct
Hdet
as
(
→
&
Hval
&
→
).
done
.
by
rewrite
Hval
;
iApply
"Hσ2"
.
iIntros
(?
Hdet
)
"[[Hσ1 Hκs] Hσ2]"
;
iApply
ownP_lift_atomic_step
;
try
done
.
iFrame
;
iNext
;
iIntros
(
κ
'
κ
s'
e2'
σ
2
'
efs'
(?
&
Heq
))
"Hσ2' Hκs'"
.
edestruct
(
Hdet
κ
'
)
as
(->&->&
Hval
&->)
;
first
done
.
rewrite
Hval
.
apply
app_inv_head
in
Heq
as
->.
iApply
(
"Hσ2"
with
"Hσ2' Hκs'"
).
Qed
.
Lemma
ownP_lift_atomic_det_step_no_fork
{
s
E
e1
}
σ
1
v2
σ
2
:
Lemma
ownP_lift_atomic_det_step_no_fork
{
s
E
e1
}
σ
1
κ
κ
s
v2
σ
2
:
(
if
s
is
NotStuck
then
reducible
e1
σ
1
else
to_val
e1
=
None
)
→
(
∀
κ
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1
κ
e2'
σ
2
'
efs'
→
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
[]
=
efs'
)
→
{{{
▷
ownP
σ
1
}}}
e1
@
s
;
E
{{{
RET
v2
;
ownP
σ
2
}}}.
(
∀
κ
'
e2'
σ
2
'
efs'
,
prim_step
e1
σ
1
κ
'
e2'
σ
2
'
efs'
→
κ
=
κ
'
∧
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
[]
=
efs'
)
→
{{{
▷
(
ownP
_state
σ
1
∗
ownP_obs
(
cons_obs
κ
κ
s
))
}}}
e1
@
s
;
E
{{{
RET
v2
;
ownP
_state
σ
2
∗
ownP_obs
κ
s
}}}.
Proof
.
intros
.
rewrite
-(
ownP_lift_atomic_det_step
σ
1
v2
σ
2
[])
;
[|
done
..].
rewrite
big_sepL_nil
right_id
.
by
apply
bi
.
wand_intro_r
.
intros
.
rewrite
-(
ownP_lift_atomic_det_step
σ
1
κ
κ
s
v2
σ
2
[])
;
[|
done
..].
rewrite
big_sepL_nil
right_id
.
apply
bi
.
wand_intro_r
.
iIntros
"[Hs Hs']"
.
iSplitL
"Hs"
;
first
by
iFrame
.
iModIntro
.
iIntros
"Hσ2 Hκs"
.
iApply
"Hs'"
.
iFrame
.
Qed
.
Lemma
ownP_lift_pure_det_step
`
{
Inhabited
(
state
Λ
)}
{
s
E
Φ
}
e1
e2
efs
:
...
...
@@ -184,7 +221,7 @@ Section lifting.
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
iIntros
(?
Hpuredet
)
"?"
;
iApply
ownP_lift_pure_step
=>//.
naive_solver
.
by
iNext
;
iIntros
(
κ
e'
efs'
σ
(
→
&
_
&
→
&
→
)%
Hpuredet
).
naive_solver
.
by
iNext
;
iIntros
(
κ
e'
efs'
σ
(
->
&
_
&
->&->
)%
Hpuredet
).
Qed
.
Lemma
ownP_lift_pure_det_step_no_fork
`
{
Inhabited
(
state
Λ
)}
{
s
E
Φ
}
e1
e2
:
...
...
@@ -207,25 +244,26 @@ Section ectx_lifting.
Hint
Resolve
head_stuck_stuck
.
Lemma
ownP_lift_head_step
s
E
Φ
e1
:
(|={
E
,
∅
}=>
∃
σ
1
,
⌜
head_reducible
e1
σ
1
⌝
∗
▷
ownP
σ
1
∗
▷
∀
κ
e2
σ
2
efs
,
⌜
head_step
e1
σ
1
κ
e2
σ
2
efs
⌝
-
∗
ownP
σ
2
(|={
E
,
∅
}=>
∃
σ
1
κ
s
,
⌜
head_reducible
e1
σ
1
⌝
∗
▷
(
ownP_state
σ
1
∗
ownP_obs
κ
s
)
∗
▷
∀
κ
κ
s'
e2
σ
2
efs
,
⌜
head_step
e1
σ
1
κ
e2
σ
2
efs
∧
κ
s
=
cons_obs
κ
κ
s'
⌝
-
∗
ownP_state
σ
2
-
∗
ownP_obs
κ
s'
={
∅
,
E
}=
∗
WP
e2
@
s
;
E
{{
Φ
}}
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
iIntros
"H"
.
iApply
ownP_lift_step
.
iMod
"H"
as
(
σ
1
?)
"[Hσ1 Hwp]"
.
iModIntro
.
iExists
σ
1
.
iSplit
.
iMod
"H"
as
(
σ
1
κ
s
?)
"[
>[
Hσ1
Hκs]
Hwp]"
.
iModIntro
.
iExists
σ
1
,
κ
s
.
iSplit
.
{
destruct
s
;
try
by
eauto
using
reducible_not_val
.
}
iFrame
.
iNext
.
iIntros
(
κ
e2
σ
2
efs
)
"% ?
"
.
iApply
(
"Hwp"
with
"[]"
)
;
eauto
.
iFrame
.
iNext
.
iIntros
(
κ
κ
s'
e2
σ
2
efs
[?
->])
"[Hσ2 Hκs']
"
.
iApply
(
"Hwp"
with
"[]
Hσ2
"
)
;
eauto
.
Qed
.
Lemma
ownP_lift_head_stuck
E
Φ
e
:
sub_redexes_are_values
e
→
(|={
E
,
∅
}=>
∃
σ
,
⌜
head_stuck
e
σ⌝
∗
▷
ownP
σ
)
(|={
E
,
∅
}=>
∃
σ
κ
s
,
⌜
head_stuck
e
σ⌝
∗
▷
(
ownP
_state
σ
∗
ownP_obs
κ
s
)
)
⊢
WP
e
@
E
?{{
Φ
}}.
Proof
.
iIntros
(?)
"H"
.
iApply
ownP_lift_stuck
.
iMod
"H"
as
(
σ
)
"[% >Hσ]"
.
iExists
σ
.
by
auto
.
iIntros
(?)
"H"
.
iApply
ownP_lift_stuck
.
iMod
"H"
as
(
σ
κ
s
)
"[% >
[
Hσ
Hκs]
]"
.
iExists
σ
,
κ
s
.
iModIntro
.
by
auto
with
iFrame
.
Qed
.
Lemma
ownP_lift_pure_head_step
s
E
Φ
e1
:
...
...
@@ -240,34 +278,35 @@ Section ectx_lifting.
iNext
.
iIntros
(?????).
iApply
"H"
;
eauto
.
Qed
.
Lemma
ownP_lift_atomic_head_step
{
s
E
Φ
}
e1
σ
1
:
Lemma
ownP_lift_atomic_head_step
{
s
E
Φ
}
e1
σ
1
κ
s
:
head_reducible
e1
σ
1
→
▷
ownP
σ
1
∗
▷
(
∀
κ
e2
σ
2
efs
,
⌜
head_step
e1
σ
1
κ
e2
σ
2
efs
⌝
-
∗
ownP
σ
2
-
∗
▷
(
ownP
_state
σ
1
∗
ownP_obs
κ
s
)
∗
▷
(
∀
κ
κ
s'
e2
σ
2
efs
,
⌜
head_step
e1
σ
1
κ
e2
σ
2
efs
∧
κ
s
=
cons_obs
κ
κ
s'
⌝
-
∗
ownP_state
σ
2
-
∗
ownP_obs
κ
s'
-
∗
from_option
Φ
False
(
to_val
e2
)
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
iIntros
(?)
"[
?
H]"
.
iApply
ownP_lift_atomic_step
;
eauto
.
iIntros
(?)
"[
Hst
H]"
.
iApply
ownP_lift_atomic_step
;
eauto
.
{
by
destruct
s
;
eauto
using
reducible_not_val
.
}
iFrame
.
iNext
.
iIntros
(????)
"% ?"
.
iApply
(
"H"
with
"[]"
)
;
eauto
.
iSplitL
"Hst"
;
first
done
.
iNext
.
iIntros
(?????
[?
->])
"Hσ ?"
.
iApply
(
"H"
with
"[] Hσ"
)
;
eauto
.
Qed
.
Lemma
ownP_lift_atomic_det_head_step
{
s
E
Φ
e1
}
σ
1
v2
σ
2
efs
:
Lemma
ownP_lift_atomic_det_head_step
{
s
E
Φ
e1
}
σ
1
κ
κ
s
v2
σ
2
efs
:
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
@
s
;
⊤
{{
_
,
True
}})
(
∀
κ
'
e2'
σ
2
'
efs'
,
head_step
e1
σ
1
κ
'
e2'
σ
2
'
efs'
→
κ
=
κ
'
∧
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
efs
=
efs'
)
→
▷
(
ownP_state
σ
1
∗
ownP_obs
(
cons_obs
κ
κ
s
))
∗
▷
(
ownP_state
σ
2
-
∗
ownP_obs
κ
s
-
∗
Φ
v2
∗
[
∗
list
]
ef
∈
efs
,
WP
ef
@
s
;
⊤
{{
_
,
True
}})
⊢
WP
e1
@
s
;
E
{{
Φ
}}.
Proof
.
intros
.
destruct
s
;
apply
ownP_lift_atomic_det_step
;
try
naive_solver
.
eauto
using
reducible_not_val
.
intros
Hr
Hs
.
destruct
s
;
apply
ownP_lift_atomic_det_step
;
eauto
using
reducible_not_val
.
Qed
.
Lemma
ownP_lift_atomic_det_head_step_no_fork
{
s
E
e1
}
σ
1
v2
σ
2
:
Lemma
ownP_lift_atomic_det_head_step_no_fork
{
s
E
e1
}
σ
1
κ
κ
s
v2
σ
2
:
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
@
s
;
E
{{{
RET
v2
;
ownP
σ
2
}}}.
(
∀
κ
'
e2'
σ
2
'
efs'
,
head_step
e1
σ
1
κ
'
e2'
σ
2
'
efs'
→
κ
=
κ
'
∧
σ
2
=
σ
2
'
∧
to_val
e2'
=
Some
v2
∧
[]
=
efs'
)
→
{{{
▷
(
ownP
_state
σ
1
∗
ownP_obs
(
cons_obs
κ
κ
s
))
}}}
e1
@
s
;
E
{{{
RET
v2
;
ownP
_state
σ
2
∗
ownP_obs
κ
s
}}}.
Proof
.
intros
???
;
apply
ownP_lift_atomic_det_step_no_fork
;
last
naive_solver
.
by
destruct
s
;
eauto
using
reducible_not_val
.
...
...
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