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
Rice Wine
Iris
Commits
20c479dd
Commit
20c479dd
authored
Jul 18, 2018
by
Marianna Rapoport
Committed by
Ralf Jung
Oct 05, 2018
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Adding support for prophecy variables to heap_lang
parent
0b7b5ad0
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
346 additions
and
65 deletions
+346
-65
_CoqProject
_CoqProject
+1
-0
theories/heap_lang/adequacy.v
theories/heap_lang/adequacy.v
+13
-10
theories/heap_lang/lang.v
theories/heap_lang/lang.v
+53
-28
theories/heap_lang/lifting.v
theories/heap_lang/lifting.v
+96
-27
theories/heap_lang/proph_map.v
theories/heap_lang/proph_map.v
+183
-0
No files found.
_CoqProject
View file @
20c479dd
...
@@ -87,6 +87,7 @@ theories/heap_lang/notation.v
...
@@ -87,6 +87,7 @@ theories/heap_lang/notation.v
theories/heap_lang/proofmode.v
theories/heap_lang/proofmode.v
theories/heap_lang/adequacy.v
theories/heap_lang/adequacy.v
theories/heap_lang/total_adequacy.v
theories/heap_lang/total_adequacy.v
theories/heap_lang/proph_map.v
theories/heap_lang/prophecy.v
theories/heap_lang/prophecy.v
theories/heap_lang/lib/spawn.v
theories/heap_lang/lib/spawn.v
theories/heap_lang/lib/par.v
theories/heap_lang/lib/par.v
...
...
theories/heap_lang/adequacy.v
View file @
20c479dd
From
iris
.
program_logic
Require
Export
weakestpre
adequacy
.
From
iris
.
program_logic
Require
Export
weakestpre
adequacy
.
From
iris
.
algebra
Require
Import
auth
.
From
iris
.
algebra
Require
Import
auth
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
proph_map
.
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
proofmode
Require
Import
tactics
.
Set
Default
Proof
Using
"Type"
.
Set
Default
Proof
Using
"Type"
.
Class
heapPreG
Σ
:
=
HeapPreG
{
Class
heap_prophPreG
Σ
:
=
HeapProphPreG
{
heap_preG_iris
:
>
invPreG
Σ
;
heap_proph_preG_iris
:
>
invPreG
Σ
;
heap_preG_heap
:
>
gen_heapPreG
loc
val
Σ
heap_proph_preG_heap
:
>
gen_heapPreG
loc
val
Σ
;
heap_proph_preG_proph
:
>
proph_mapPreG
proph
val
Σ
}.
}.
Definition
heap
Σ
:
gFunctors
:
=
#[
inv
Σ
;
gen_heap
Σ
loc
val
].
Definition
heap
Σ
:
gFunctors
:
=
#[
inv
Σ
;
gen_heap
Σ
loc
val
;
proph_map
Σ
proph
val
].
Instance
subG_heapPreG
{
Σ
}
:
subG
heap
Σ
Σ
→
heapPreG
Σ
.
Instance
subG_heapPreG
{
Σ
}
:
subG
heap
Σ
Σ
→
heap
_proph
PreG
Σ
.
Proof
.
solve_inG
.
Qed
.
Proof
.
solve_inG
.
Qed
.
Definition
heap_adequacy
Σ
`
{
heapPreG
Σ
}
s
e
σ
φ
:
Definition
heap_adequacy
Σ
`
{
heap
_proph
PreG
Σ
}
s
e
σ
φ
:
(
∀
`
{
heapG
Σ
},
WP
e
@
s
;
⊤
{{
v
,
⌜φ
v
⌝
}}%
I
)
→
(
∀
`
{
heapG
Σ
},
WP
e
@
s
;
⊤
{{
v
,
⌜φ
v
⌝
}}%
I
)
→
adequate
s
e
σ
(
λ
v
_
,
φ
v
).
adequate
s
e
σ
(
λ
v
_
,
φ
v
).
Proof
.
Proof
.
intros
Hwp
;
eapply
(
wp_adequacy
_
_
)
;
iIntros
(??)
""
.
intros
Hwp
;
eapply
(
wp_adequacy
_
_
)
;
iIntros
(??)
""
.
iMod
(
gen_heap_init
σ
)
as
(?)
"Hh"
.
iMod
(
gen_heap_init
σ
.
1
)
as
(?)
"Hh"
.
iModIntro
.
iExists
(
fun
σ
_
=>
gen_heap_ctx
σ
).
iFrame
"Hh"
.
iMod
(
proph_map_init
κ
s
σ
.
2
)
as
(?)
"Hp"
.
iApply
(
Hwp
(
HeapG
_
_
_
)).
iModIntro
.
iExists
(
fun
σ
κ
s
=>
(
gen_heap_ctx
σ
.
1
∗
proph_map_ctx
κ
s
σ
.
2
)%
I
).
iFrame
.
iApply
(
Hwp
(
HeapG
_
_
_
_
)).
Qed
.
Qed
.
theories/heap_lang/lang.v
View file @
20c479dd
...
@@ -76,7 +76,10 @@ Inductive expr :=
...
@@ -76,7 +76,10 @@ Inductive expr :=
|
Load
(
e
:
expr
)
|
Load
(
e
:
expr
)
|
Store
(
e1
:
expr
)
(
e2
:
expr
)
|
Store
(
e1
:
expr
)
(
e2
:
expr
)
|
CAS
(
e0
:
expr
)
(
e1
:
expr
)
(
e2
:
expr
)
|
CAS
(
e0
:
expr
)
(
e1
:
expr
)
(
e2
:
expr
)
|
FAA
(
e1
:
expr
)
(
e2
:
expr
).
|
FAA
(
e1
:
expr
)
(
e2
:
expr
)
(* Prophecy *)
|
NewProph
|
ResolveProph
(
e1
:
expr
)
(
e2
:
expr
).
Bind
Scope
expr_scope
with
expr
.
Bind
Scope
expr_scope
with
expr
.
...
@@ -84,10 +87,10 @@ Fixpoint is_closed (X : list string) (e : expr) : bool :=
...
@@ -84,10 +87,10 @@ Fixpoint is_closed (X : list string) (e : expr) : bool :=
match
e
with
match
e
with
|
Var
x
=>
bool_decide
(
x
∈
X
)
|
Var
x
=>
bool_decide
(
x
∈
X
)
|
Rec
f
x
e
=>
is_closed
(
f
:
b
:
x
:
b
:
X
)
e
|
Rec
f
x
e
=>
is_closed
(
f
:
b
:
x
:
b
:
X
)
e
|
Lit
_
=>
true
|
Lit
_
|
NewProph
=>
true
|
UnOp
_
e
|
Fst
e
|
Snd
e
|
InjL
e
|
InjR
e
|
Fork
e
|
Alloc
e
|
Load
e
=>
|
UnOp
_
e
|
Fst
e
|
Snd
e
|
InjL
e
|
InjR
e
|
Fork
e
|
Alloc
e
|
Load
e
=>
is_closed
X
e
is_closed
X
e
|
App
e1
e2
|
BinOp
_
e1
e2
|
Pair
e1
e2
|
Store
e1
e2
|
FAA
e1
e2
=>
|
App
e1
e2
|
BinOp
_
e1
e2
|
Pair
e1
e2
|
Store
e1
e2
|
FAA
e1
e2
|
ResolveProph
e1
e2
=>
is_closed
X
e1
&&
is_closed
X
e2
is_closed
X
e1
&&
is_closed
X
e2
|
If
e0
e1
e2
|
Case
e0
e1
e2
|
CAS
e0
e1
e2
=>
|
If
e0
e1
e2
|
Case
e0
e1
e2
|
CAS
e0
e1
e2
=>
is_closed
X
e0
&&
is_closed
X
e1
&&
is_closed
X
e2
is_closed
X
e0
&&
is_closed
X
e1
&&
is_closed
X
e2
...
@@ -108,7 +111,7 @@ Inductive val :=
...
@@ -108,7 +111,7 @@ Inductive val :=
Bind
Scope
val_scope
with
val
.
Bind
Scope
val_scope
with
val
.
Definition
observation
:
=
Empty
val
.
Definition
observation
:
Set
:
=
proph
*
val
.
Fixpoint
of_val
(
v
:
val
)
:
expr
:
=
Fixpoint
of_val
(
v
:
val
)
:
expr
:
=
match
v
with
match
v
with
...
@@ -163,7 +166,7 @@ Definition val_is_unboxed (v : val) : Prop :=
...
@@ -163,7 +166,7 @@ Definition val_is_unboxed (v : val) : Prop :=
end
.
end
.
(** The state: heaps of vals. *)
(** The state: heaps of vals. *)
Definition
state
:
=
gmap
loc
val
.
Definition
state
:
Type
:
=
gmap
loc
val
*
gset
proph
.
(** Equality and other typeclass stuff *)
(** Equality and other typeclass stuff *)
Lemma
to_of_val
v
:
to_val
(
of_val
v
)
=
Some
v
.
Lemma
to_of_val
v
:
to_val
(
of_val
v
)
=
Some
v
.
...
@@ -230,12 +233,12 @@ Instance expr_countable : Countable expr.
...
@@ -230,12 +233,12 @@ Instance expr_countable : Countable expr.
Proof
.
Proof
.
set
(
enc
:
=
fix
go
e
:
=
set
(
enc
:
=
fix
go
e
:
=
match
e
with
match
e
with
|
Var
x
=>
GenLeaf
(
inl
(
inl
x
))
|
Var
x
=>
GenLeaf
(
Some
(
inl
(
inl
x
)
))
|
Rec
f
x
e
=>
GenNode
0
[
GenLeaf
(
inl
(
inr
f
))
;
GenLeaf
(
inl
(
inr
x
))
;
go
e
]
|
Rec
f
x
e
=>
GenNode
0
[
GenLeaf
(
Some
((
inl
(
inr
f
))))
;
GenLeaf
(
Some
(
inl
(
inr
x
)
))
;
go
e
]
|
App
e1
e2
=>
GenNode
1
[
go
e1
;
go
e2
]
|
App
e1
e2
=>
GenNode
1
[
go
e1
;
go
e2
]
|
Lit
l
=>
GenLeaf
(
inr
(
inl
l
))
|
Lit
l
=>
GenLeaf
(
Some
(
inr
(
inl
l
)
))
|
UnOp
op
e
=>
GenNode
2
[
GenLeaf
(
inr
(
inr
(
inl
op
)))
;
go
e
]
|
UnOp
op
e
=>
GenNode
2
[
GenLeaf
(
Some
(
inr
(
inr
(
inl
op
)
)))
;
go
e
]
|
BinOp
op
e1
e2
=>
GenNode
3
[
GenLeaf
(
inr
(
inr
(
inr
op
)))
;
go
e1
;
go
e2
]
|
BinOp
op
e1
e2
=>
GenNode
3
[
GenLeaf
(
Some
(
inr
(
inr
(
inr
op
)
)))
;
go
e1
;
go
e2
]
|
If
e0
e1
e2
=>
GenNode
4
[
go
e0
;
go
e1
;
go
e2
]
|
If
e0
e1
e2
=>
GenNode
4
[
go
e0
;
go
e1
;
go
e2
]
|
Pair
e1
e2
=>
GenNode
5
[
go
e1
;
go
e2
]
|
Pair
e1
e2
=>
GenNode
5
[
go
e1
;
go
e2
]
|
Fst
e
=>
GenNode
6
[
go
e
]
|
Fst
e
=>
GenNode
6
[
go
e
]
...
@@ -249,15 +252,17 @@ Proof.
...
@@ -249,15 +252,17 @@ Proof.
|
Store
e1
e2
=>
GenNode
14
[
go
e1
;
go
e2
]
|
Store
e1
e2
=>
GenNode
14
[
go
e1
;
go
e2
]
|
CAS
e0
e1
e2
=>
GenNode
15
[
go
e0
;
go
e1
;
go
e2
]
|
CAS
e0
e1
e2
=>
GenNode
15
[
go
e0
;
go
e1
;
go
e2
]
|
FAA
e1
e2
=>
GenNode
16
[
go
e1
;
go
e2
]
|
FAA
e1
e2
=>
GenNode
16
[
go
e1
;
go
e2
]
|
NewProph
=>
GenLeaf
None
|
ResolveProph
e1
e2
=>
GenNode
17
[
go
e1
;
go
e2
]
end
).
end
).
set
(
dec
:
=
fix
go
e
:
=
set
(
dec
:
=
fix
go
e
:
=
match
e
with
match
e
with
|
GenLeaf
(
inl
(
inl
x
))
=>
Var
x
|
GenLeaf
(
Some
(
inl
(
inl
x
)
))
=>
Var
x
|
GenNode
0
[
GenLeaf
(
inl
(
inr
f
))
;
GenLeaf
(
inl
(
inr
x
))
;
e
]
=>
Rec
f
x
(
go
e
)
|
GenNode
0
[
GenLeaf
(
Some
(
inl
(
inr
f
)))
;
GenLeaf
(
Some
(
inl
(
inr
x
)
))
;
e
]
=>
Rec
f
x
(
go
e
)
|
GenNode
1
[
e1
;
e2
]
=>
App
(
go
e1
)
(
go
e2
)
|
GenNode
1
[
e1
;
e2
]
=>
App
(
go
e1
)
(
go
e2
)
|
GenLeaf
(
inr
(
inl
l
))
=>
Lit
l
|
GenLeaf
(
Some
(
inr
(
inl
l
)
))
=>
Lit
l
|
GenNode
2
[
GenLeaf
(
inr
(
inr
(
inl
op
)))
;
e
]
=>
UnOp
op
(
go
e
)
|
GenNode
2
[
GenLeaf
(
Some
(
inr
(
inr
(
inl
op
)
)))
;
e
]
=>
UnOp
op
(
go
e
)
|
GenNode
3
[
GenLeaf
(
inr
(
inr
(
inr
op
)))
;
e1
;
e2
]
=>
BinOp
op
(
go
e1
)
(
go
e2
)
|
GenNode
3
[
GenLeaf
(
Some
(
inr
(
inr
(
inr
op
)
)))
;
e1
;
e2
]
=>
BinOp
op
(
go
e1
)
(
go
e2
)
|
GenNode
4
[
e0
;
e1
;
e2
]
=>
If
(
go
e0
)
(
go
e1
)
(
go
e2
)
|
GenNode
4
[
e0
;
e1
;
e2
]
=>
If
(
go
e0
)
(
go
e1
)
(
go
e2
)
|
GenNode
5
[
e1
;
e2
]
=>
Pair
(
go
e1
)
(
go
e2
)
|
GenNode
5
[
e1
;
e2
]
=>
Pair
(
go
e1
)
(
go
e2
)
|
GenNode
6
[
e
]
=>
Fst
(
go
e
)
|
GenNode
6
[
e
]
=>
Fst
(
go
e
)
...
@@ -271,6 +276,8 @@ Proof.
...
@@ -271,6 +276,8 @@ Proof.
|
GenNode
14
[
e1
;
e2
]
=>
Store
(
go
e1
)
(
go
e2
)
|
GenNode
14
[
e1
;
e2
]
=>
Store
(
go
e1
)
(
go
e2
)
|
GenNode
15
[
e0
;
e1
;
e2
]
=>
CAS
(
go
e0
)
(
go
e1
)
(
go
e2
)
|
GenNode
15
[
e0
;
e1
;
e2
]
=>
CAS
(
go
e0
)
(
go
e1
)
(
go
e2
)
|
GenNode
16
[
e1
;
e2
]
=>
FAA
(
go
e1
)
(
go
e2
)
|
GenNode
16
[
e1
;
e2
]
=>
FAA
(
go
e1
)
(
go
e2
)
|
GenLeaf
None
=>
NewProph
|
GenNode
17
[
e1
;
e2
]
=>
ResolveProph
(
go
e1
)
(
go
e2
)
|
_
=>
Lit
LitUnit
(* dummy *)
|
_
=>
Lit
LitUnit
(* dummy *)
end
).
end
).
refine
(
inj_countable'
enc
dec
_
).
intros
e
.
induction
e
;
f_equal
/=
;
auto
.
refine
(
inj_countable'
enc
dec
_
).
intros
e
.
induction
e
;
f_equal
/=
;
auto
.
...
@@ -308,7 +315,9 @@ Inductive ectx_item :=
...
@@ -308,7 +315,9 @@ Inductive ectx_item :=
|
CasMCtx
(
e0
:
expr
)
(
v2
:
val
)
|
CasMCtx
(
e0
:
expr
)
(
v2
:
val
)
|
CasRCtx
(
e0
:
expr
)
(
e1
:
expr
)
|
CasRCtx
(
e0
:
expr
)
(
e1
:
expr
)
|
FaaLCtx
(
v2
:
val
)
|
FaaLCtx
(
v2
:
val
)
|
FaaRCtx
(
e1
:
expr
).
|
FaaRCtx
(
e1
:
expr
)
|
ProphLCtx
(
v2
:
val
)
|
ProphRCtx
(
e1
:
expr
).
Definition
fill_item
(
Ki
:
ectx_item
)
(
e
:
expr
)
:
expr
:
=
Definition
fill_item
(
Ki
:
ectx_item
)
(
e
:
expr
)
:
expr
:
=
match
Ki
with
match
Ki
with
...
@@ -334,6 +343,8 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
...
@@ -334,6 +343,8 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
|
CasRCtx
e0
e1
=>
CAS
e0
e1
e
|
CasRCtx
e0
e1
=>
CAS
e0
e1
e
|
FaaLCtx
v2
=>
FAA
e
(
of_val
v2
)
|
FaaLCtx
v2
=>
FAA
e
(
of_val
v2
)
|
FaaRCtx
e1
=>
FAA
e1
e
|
FaaRCtx
e1
=>
FAA
e1
e
|
ProphLCtx
v2
=>
ResolveProph
e
(
of_val
v2
)
|
ProphRCtx
e1
=>
ResolveProph
e1
e
end
.
end
.
(** Substitution *)
(** Substitution *)
...
@@ -359,6 +370,8 @@ Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
...
@@ -359,6 +370,8 @@ Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
|
Store
e1
e2
=>
Store
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
Store
e1
e2
=>
Store
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
CAS
e0
e1
e2
=>
CAS
(
subst
x
es
e0
)
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
CAS
e0
e1
e2
=>
CAS
(
subst
x
es
e0
)
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
FAA
e1
e2
=>
FAA
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
FAA
e1
e2
=>
FAA
(
subst
x
es
e1
)
(
subst
x
es
e2
)
|
NewProph
=>
NewProph
|
ResolveProph
e1
e2
=>
ResolveProph
(
subst
x
es
e1
)
(
subst
x
es
e2
)
end
.
end
.
Definition
subst'
(
mx
:
binder
)
(
es
:
expr
)
:
expr
→
expr
:
=
Definition
subst'
(
mx
:
binder
)
(
es
:
expr
)
:
expr
→
expr
:
=
...
@@ -450,28 +463,35 @@ Inductive head_step : expr → state → option observation -> expr → state
...
@@ -450,28 +463,35 @@ Inductive head_step : expr → state → option observation -> expr → state
|
ForkS
e
σ
:
|
ForkS
e
σ
:
head_step
(
Fork
e
)
σ
None
(
Lit
LitUnit
)
σ
[
e
]
head_step
(
Fork
e
)
σ
None
(
Lit
LitUnit
)
σ
[
e
]
|
AllocS
e
v
σ
l
:
|
AllocS
e
v
σ
l
:
to_val
e
=
Some
v
→
σ
!!
l
=
None
→
to_val
e
=
Some
v
→
σ
.
1
!!
l
=
None
→
head_step
(
Alloc
e
)
σ
None
(
Lit
$
LitLoc
l
)
(<[
l
:
=
v
]>
σ
)
[]
head_step
(
Alloc
e
)
σ
None
(
Lit
$
LitLoc
l
)
(<[
l
:
=
v
]>
σ
.
1
,
σ
.
2
)
[]
|
LoadS
l
v
σ
:
|
LoadS
l
v
σ
:
σ
!!
l
=
Some
v
→
σ
.
1
!!
l
=
Some
v
→
head_step
(
Load
(
Lit
$
LitLoc
l
))
σ
None
(
of_val
v
)
σ
[]
head_step
(
Load
(
Lit
$
LitLoc
l
))
σ
None
(
of_val
v
)
σ
[]
|
StoreS
l
e
v
σ
:
|
StoreS
l
e
v
σ
:
to_val
e
=
Some
v
→
is_Some
(
σ
!!
l
)
→
to_val
e
=
Some
v
→
is_Some
(
σ
.
1
!!
l
)
→
head_step
(
Store
(
Lit
$
LitLoc
l
)
e
)
σ
None
(
Lit
LitUnit
)
(<[
l
:
=
v
]>
σ
)
[]
head_step
(
Store
(
Lit
$
LitLoc
l
)
e
)
σ
None
(
Lit
LitUnit
)
(<[
l
:
=
v
]>
σ
.
1
,
σ
.
2
)
[]
|
CasFailS
l
e1
v1
e2
v2
vl
σ
:
|
CasFailS
l
e1
v1
e2
v2
vl
σ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
vl
→
vl
≠
v1
→
σ
.
1
!!
l
=
Some
vl
→
vl
≠
v1
→
vals_cas_compare_safe
vl
v1
→
vals_cas_compare_safe
vl
v1
→
head_step
(
CAS
(
Lit
$
LitLoc
l
)
e1
e2
)
σ
None
(
Lit
$
LitBool
false
)
σ
[]
head_step
(
CAS
(
Lit
$
LitLoc
l
)
e1
e2
)
σ
None
(
Lit
$
LitBool
false
)
σ
[]
|
CasSucS
l
e1
v1
e2
v2
σ
:
|
CasSucS
l
e1
v1
e2
v2
σ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
v1
→
σ
.
1
!!
l
=
Some
v1
→
vals_cas_compare_safe
v1
v1
→
vals_cas_compare_safe
v1
v1
→
head_step
(
CAS
(
Lit
$
LitLoc
l
)
e1
e2
)
σ
None
(
Lit
$
LitBool
true
)
(<[
l
:
=
v2
]>
σ
)
[]
head_step
(
CAS
(
Lit
$
LitLoc
l
)
e1
e2
)
σ
None
(
Lit
$
LitBool
true
)
(<[
l
:
=
v2
]>
σ
.
1
,
σ
.
2
)
[]
|
FaaS
l
i1
e2
i2
σ
:
|
FaaS
l
i1
e2
i2
σ
:
to_val
e2
=
Some
(
LitV
(
LitInt
i2
))
→
to_val
e2
=
Some
(
LitV
(
LitInt
i2
))
→
σ
!!
l
=
Some
(
LitV
(
LitInt
i1
))
→
σ
.
1
!!
l
=
Some
(
LitV
(
LitInt
i1
))
→
head_step
(
FAA
(
Lit
$
LitLoc
l
)
e2
)
σ
None
(
Lit
$
LitInt
i1
)
(<[
l
:
=
LitV
(
LitInt
(
i1
+
i2
))]>
σ
)
[].
head_step
(
FAA
(
Lit
$
LitLoc
l
)
e2
)
σ
None
(
Lit
$
LitInt
i1
)
(<[
l
:
=
LitV
(
LitInt
(
i1
+
i2
))]>
σ
.
1
,
σ
.
2
)
[]
|
NewProphS
σ
p
:
p
∉
σ
.
2
→
head_step
NewProph
σ
None
(
Lit
$
LitProphecy
p
)
(
σ
.
1
,
{[
p
]}
∪
σ
.
2
)
[]
|
ResolveProphS
e1
p
e2
v
σ
:
to_val
e1
=
Some
(
LitV
$
LitProphecy
p
)
→
to_val
e2
=
Some
v
→
head_step
(
ResolveProph
e1
e2
)
σ
(
Some
(
p
,
v
))
(
Lit
LitUnit
)
σ
[].
(** Basic properties about the language *)
(** Basic properties about the language *)
Instance
fill_item_inj
Ki
:
Inj
(=)
(=)
(
fill_item
Ki
).
Instance
fill_item_inj
Ki
:
Inj
(=)
(=)
(
fill_item
Ki
).
...
@@ -499,10 +519,15 @@ Proof.
...
@@ -499,10 +519,15 @@ Proof.
Qed
.
Qed
.
Lemma
alloc_fresh
e
v
σ
:
Lemma
alloc_fresh
e
v
σ
:
let
l
:
=
fresh
(
dom
(
gset
loc
)
σ
)
in
let
l
:
=
fresh
(
dom
(
gset
loc
)
σ
.
1
)
in
to_val
e
=
Some
v
→
head_step
(
Alloc
e
)
σ
None
(
Lit
(
LitLoc
l
))
(<[
l
:
=
v
]>
σ
)
[].
to_val
e
=
Some
v
→
head_step
(
Alloc
e
)
σ
None
(
Lit
(
LitLoc
l
))
(<[
l
:
=
v
]>
σ
.
1
,
σ
.
2
)
[].
Proof
.
by
intros
;
apply
AllocS
,
(
not_elem_of_dom
(
D
:
=
gset
loc
)),
is_fresh
.
Qed
.
Proof
.
by
intros
;
apply
AllocS
,
(
not_elem_of_dom
(
D
:
=
gset
loc
)),
is_fresh
.
Qed
.
Lemma
new_proph_fresh
σ
:
let
p
:
=
fresh
σ
.
2
in
head_step
NewProph
σ
None
(
Lit
$
LitProphecy
p
)
(
σ
.
1
,
{[
p
]}
∪
σ
.
2
)
[].
Proof
.
constructor
.
apply
is_fresh
.
Qed
.
(* Misc *)
(* Misc *)
Lemma
to_val_rec
f
x
e
`
{!
Closed
(
f
:
b
:
x
:
b
:
[])
e
}
:
Lemma
to_val_rec
f
x
e
`
{!
Closed
(
f
:
b
:
x
:
b
:
[])
e
}
:
to_val
(
Rec
f
x
e
)
=
Some
(
RecV
f
x
e
).
to_val
(
Rec
f
x
e
)
=
Some
(
RecV
f
x
e
).
...
...
theories/heap_lang/lifting.v
View file @
20c479dd
From
iris
.
algebra
Require
Import
auth
gmap
.
From
iris
.
base_logic
Require
Export
gen_heap
.
From
iris
.
base_logic
Require
Export
gen_heap
.
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
program_logic
Require
Import
ectx_lifting
total_ectx_lifting
.
From
iris
.
program_logic
Require
Import
ectx_lifting
total_ectx_lifting
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Export
lang
proph_map
.
From
iris
.
heap_lang
Require
Import
tactics
.
From
iris
.
heap_lang
Require
Import
tactics
.
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
proofmode
Require
Import
tactics
.
From
stdpp
Require
Import
fin_maps
.
From
stdpp
Require
Import
fin_maps
.
...
@@ -9,12 +10,14 @@ Set Default Proof Using "Type".
...
@@ -9,12 +10,14 @@ Set Default Proof Using "Type".
Class
heapG
Σ
:
=
HeapG
{
Class
heapG
Σ
:
=
HeapG
{
heapG_invG
:
invG
Σ
;
heapG_invG
:
invG
Σ
;
heapG_gen_heapG
:
>
gen_heapG
loc
val
Σ
heapG_gen_heapG
:
>
gen_heapG
loc
val
Σ
;
heapG_proph_mapG
:
>
proph_mapG
proph
val
Σ
}.
}.
Instance
heapG_irisG
`
{
heapG
Σ
}
:
irisG
heap_lang
Σ
:
=
{
Instance
heapG_irisG
`
{
heapG
Σ
}
:
irisG
heap_lang
Σ
:
=
{
iris_invG
:
=
heapG_invG
;
iris_invG
:
=
heapG_invG
;
state_interp
σ
κ
s
:
=
gen_heap_ctx
σ
state_interp
σ
κ
s
:
=
(
gen_heap_ctx
σ
.
1
∗
proph_map_ctx
κ
s
σ
.
2
)%
I
}.
}.
(** Override the notations so that scopes and coercions work out *)
(** Override the notations so that scopes and coercions work out *)
...
@@ -26,6 +29,9 @@ Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
...
@@ -26,6 +29,9 @@ Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
(
at
level
20
,
q
at
level
50
,
format
"l ↦{ q } -"
)
:
bi_scope
.
(
at
level
20
,
q
at
level
50
,
format
"l ↦{ q } -"
)
:
bi_scope
.
Notation
"l ↦ -"
:
=
(
l
↦
{
1
}
-)%
I
(
at
level
20
)
:
bi_scope
.
Notation
"l ↦ -"
:
=
(
l
↦
{
1
}
-)%
I
(
at
level
20
)
:
bi_scope
.
Notation
"p ⥱ v"
:
=
(
p_mapsto
p
v
)
(
at
level
20
,
format
"p ⥱ v"
)
:
bi_scope
.
Notation
"p ⥱ -"
:
=
(
∃
v
,
p
⥱
v
)%
I
(
at
level
20
)
:
bi_scope
.
(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
[head_step]. The tactic will discharge head-reductions starting from values, and
[head_step]. The tactic will discharge head-reductions starting from values, and
simplifies hypothesis related to conversions from and to values, and finite map
simplifies hypothesis related to conversions from and to values, and finite map
...
@@ -127,7 +133,9 @@ Lemma wp_alloc s E e v :
...
@@ -127,7 +133,9 @@ Lemma wp_alloc s E e v :
{{{
True
}}}
Alloc
e
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
}}}.
{{{
True
}}}
Alloc
e
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
}}}.
Proof
.
Proof
.
iIntros
(<-
Φ
)
"_ HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(<-
Φ
)
"_ HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
;
iSplit
;
first
by
eauto
.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
;
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
by
apply
alloc_fresh
.
}
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_alloc
with
"Hσ"
)
as
"[Hσ Hl]"
;
first
done
.
iMod
(@
gen_heap_alloc
with
"Hσ"
)
as
"[Hσ Hl]"
;
first
done
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
...
@@ -137,7 +145,9 @@ Lemma twp_alloc s E e v :
...
@@ -137,7 +145,9 @@ Lemma twp_alloc s E e v :
[[{
True
}]]
Alloc
e
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
}]].
[[{
True
}]]
Alloc
e
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
}]].
Proof
.
Proof
.
iIntros
(<-
Φ
)
"_ HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(<-
Φ
)
"_ HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
;
iSplit
;
first
by
eauto
.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
;
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
by
apply
alloc_fresh
.
}
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_alloc
with
"Hσ"
)
as
"[Hσ Hl]"
;
first
done
.
iMod
(@
gen_heap_alloc
with
"Hσ"
)
as
"[Hσ Hl]"
;
first
done
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
...
@@ -147,7 +157,7 @@ Lemma wp_load s E l q v :
...
@@ -147,7 +157,7 @@ Lemma wp_load s E l q v :
{{{
▷
l
↦
{
q
}
v
}}}
Load
(
Lit
(
LitLoc
l
))
@
s
;
E
{{{
RET
v
;
l
↦
{
q
}
v
}}}.
{{{
▷
l
↦
{
q
}
v
}}}
Load
(
Lit
(
LitLoc
l
))
@
s
;
E
{{{
RET
v
;
l
↦
{
q
}
v
}}}.
Proof
.
Proof
.
iIntros
(
Φ
)
">Hl HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
Φ
)
">Hl HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"
Hσ
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"
[Hσ Hκs]
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iSplit
;
first
by
eauto
.
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
...
@@ -156,7 +166,7 @@ Lemma twp_load s E l q v :
...
@@ -156,7 +166,7 @@ Lemma twp_load s E l q v :
[[{
l
↦
{
q
}
v
}]]
Load
(
Lit
(
LitLoc
l
))
@
s
;
E
[[{
RET
v
;
l
↦
{
q
}
v
}]].
[[{
l
↦
{
q
}
v
}]]
Load
(
Lit
(
LitLoc
l
))
@
s
;
E
[[{
RET
v
;
l
↦
{
q
}
v
}]].
Proof
.
Proof
.
iIntros
(
Φ
)
"Hl HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
Φ
)
"Hl HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"
Hσ
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"
[Hσ Hκs]
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iSplit
;
first
by
eauto
.
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
...
@@ -168,10 +178,13 @@ Lemma wp_store s E l v' e v :
...
@@ -168,10 +178,13 @@ Lemma wp_store s E l v' e v :
Proof
.
Proof
.
iIntros
(<-
Φ
)
">Hl HΦ"
.
iIntros
(<-
Φ
)
">Hl HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
6
.
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
constructor
;
eauto
.
}
iNext
;
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iModIntro
.
iSplit
=>//.
by
iApply
"HΦ"
.
iModIntro
.
iSplit
=>//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
Lemma
twp_store
s
E
l
v'
e
v
:
Lemma
twp_store
s
E
l
v'
e
v
:
IntoVal
e
v
→
IntoVal
e
v
→
...
@@ -179,10 +192,13 @@ Lemma twp_store s E l v' e v :
...
@@ -179,10 +192,13 @@ Lemma twp_store s E l v' e v :
Proof
.
Proof
.
iIntros
(<-
Φ
)
"Hl HΦ"
.
iIntros
(<-
Φ
)
"Hl HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
6
.
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
constructor
;
eauto
.
}
iIntros
(
κ
κ
s'
v2
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iModIntro
.
iSplit
=>//.
by
iApply
"HΦ"
.
iModIntro
.
iSplit
=>//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
Lemma
wp_cas_fail
s
E
l
q
v'
e1
v1
e2
:
Lemma
wp_cas_fail
s
E
l
q
v'
e1
v1
e2
:
...
@@ -192,7 +208,7 @@ Lemma wp_cas_fail s E l q v' e1 v1 e2 :
...
@@ -192,7 +208,7 @@ Lemma wp_cas_fail s E l q v' e1 v1 e2 :
Proof
.
Proof
.
iIntros
(<-
[
v2
<-]
??
Φ
)
">Hl HΦ"
.
iIntros
(<-
[
v2
<-]
??
Φ
)
">Hl HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"
Hσ
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"
[Hσ Hκs]
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iNext
;
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
;
first
by
eauto
.
iNext
;
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
...
@@ -203,7 +219,7 @@ Lemma twp_cas_fail s E l q v' e1 v1 e2 :
...
@@ -203,7 +219,7 @@ Lemma twp_cas_fail s E l q v' e1 v1 e2 :
Proof
.
Proof
.
iIntros
(<-
[
v2
<-]
??
Φ
)
"Hl HΦ"
.
iIntros
(<-
[
v2
<-]
??
Φ
)
"Hl HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"
Hσ
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"
[Hσ Hκs]
!>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
;
first
by
eauto
.
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
iModIntro
;
iSplit
=>
//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
...
@@ -215,10 +231,13 @@ Lemma wp_cas_suc s E l e1 v1 e2 v2 :
...
@@ -215,10 +231,13 @@ Lemma wp_cas_suc s E l e1 v1 e2 v2 :
Proof
.
Proof
.
iIntros
(<-
<-
?
Φ
)
">Hl HΦ"
.
iIntros
(<-
<-
?
Φ
)
">Hl HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iNext
;
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
by
econstructor
.
}
iNext
;
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iModIntro
.
iSplit
=>//.
by
iApply
"HΦ"
.
iModIntro
.
iSplit
=>//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
Lemma
twp_cas_suc
s
E
l
e1
v1
e2
v2
:
Lemma
twp_cas_suc
s
E
l
e1
v1
e2
v2
:
IntoVal
e1
v1
→
IntoVal
e2
v2
→
vals_cas_compare_safe
v1
v1
→
IntoVal
e1
v1
→
IntoVal
e2
v2
→
vals_cas_compare_safe
v1
v1
→
...
@@ -227,10 +246,13 @@ Lemma twp_cas_suc s E l e1 v1 e2 v2 :
...
@@ -227,10 +246,13 @@ Lemma twp_cas_suc s E l e1 v1 e2 v2 :
Proof
.
Proof
.
iIntros
(<-
<-
?
Φ
)
"Hl HΦ"
.
iIntros
(<-
<-
?
Φ
)
"Hl HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
)
"Hσ !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iIntros
(
σ
1
κ
s
)
"[Hσ Hκs] !>"
.
iDestruct
(@
gen_heap_valid
with
"Hσ Hl"
)
as
%?.
iSplit
;
first
by
eauto
.
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iSplit
.
(* TODO (MR) this used to be done by eauto. Why does it not work any more? *)
{
iPureIntro
.
repeat
eexists
.
by
econstructor
.
}
iIntros
(
κ
κ
s'
v2'
σ
2
efs
[
Hstep
->])
;
inv_head_step
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iMod
(@
gen_heap_update
with
"Hσ Hl"
)
as
"[$ Hl]"
.
iModIntro
.
iSplit
=>//.
by
iApply
"HΦ"
.
iModIntro
.
iSplit
=>//.
iFrame
.
by
iApply
"HΦ"
.
Qed
.
Qed
.