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
Pierre-Marie Pédrot
Iris
Commits
ffa92c50
Commit
ffa92c50
authored
Feb 19, 2016
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Introduce notation || e @ E {{ Φ }} for weakest pre.
parent
01eb6f6a
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
113 additions
and
89 deletions
+113
-89
barrier/barrier.v
barrier/barrier.v
+4
-4
heap_lang/derived.v
heap_lang/derived.v
+16
-13
heap_lang/heap.v
heap_lang/heap.v
+6
-6
heap_lang/lifting.v
heap_lang/lifting.v
+21
-22
heap_lang/notation.v
heap_lang/notation.v
+6
-1
heap_lang/substitution.v
heap_lang/substitution.v
+9
-8
heap_lang/tests.v
heap_lang/tests.v
+5
-4
program_logic/hoare.v
program_logic/hoare.v
+3
-2
program_logic/invariants.v
program_logic/invariants.v
+2
-2
program_logic/lifting.v
program_logic/lifting.v
+6
-6
program_logic/weakestpre.v
program_logic/weakestpre.v
+35
-21
No files found.
barrier/barrier.v
View file @
ffa92c50
...
@@ -146,7 +146,7 @@ Section proof.
...
@@ -146,7 +146,7 @@ Section proof.
Lemma
newchan_spec
(
P
:
iProp
)
(
Φ
:
val
→
iProp
)
:
Lemma
newchan_spec
(
P
:
iProp
)
(
Φ
:
val
→
iProp
)
:
(
heap_ctx
heapN
★
∀
l
,
recv
l
P
★
send
l
P
-
★
Φ
(
LocV
l
))
(
heap_ctx
heapN
★
∀
l
,
recv
l
P
★
send
l
P
-
★
Φ
(
LocV
l
))
⊑
wp
⊤
(
newchan
'
())
Φ
.
⊑
||
newchan
'
()
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
newchan
.
wp_rec
.
(* TODO: wp_seq. *)
rewrite
/
newchan
.
wp_rec
.
(* TODO: wp_seq. *)
rewrite
-
wp_pvs
.
wp
>
eapply
wp_alloc
;
eauto
with
I
ndisj
.
rewrite
-
wp_pvs
.
wp
>
eapply
wp_alloc
;
eauto
with
I
ndisj
.
...
@@ -196,7 +196,7 @@ Section proof.
...
@@ -196,7 +196,7 @@ Section proof.
Qed
.
Qed
.
Lemma
signal_spec
l
P
(
Φ
:
val
→
iProp
)
:
Lemma
signal_spec
l
P
(
Φ
:
val
→
iProp
)
:
heapN
⊥
N
→
(
send
l
P
★
P
★
Φ
'
())
⊑
wp
⊤
(
signal
(
LocV
l
))
Φ
.
heapN
⊥
N
→
(
send
l
P
★
P
★
Φ
'
())
⊑
||
signal
(
LocV
l
)
{{
Φ
}}
.
Proof
.
Proof
.
intros
Hdisj
.
rewrite
/
signal
/
send
/
barrier_ctx
.
rewrite
sep_exist_r
.
intros
Hdisj
.
rewrite
/
signal
/
send
/
barrier_ctx
.
rewrite
sep_exist_r
.
apply
exist_elim
=>
γ
.
wp_rec
.
(* FIXME wp_let *)
apply
exist_elim
=>
γ
.
wp_rec
.
(* FIXME wp_let *)
...
@@ -226,12 +226,12 @@ Section proof.
...
@@ -226,12 +226,12 @@ Section proof.
Qed
.
Qed
.
Lemma
wait_spec
l
P
(
Φ
:
val
→
iProp
)
:
Lemma
wait_spec
l
P
(
Φ
:
val
→
iProp
)
:
heapN
⊥
N
→
(
recv
l
P
★
(
P
-
★
Φ
'
()))
⊑
wp
⊤
(
wait
(
LocV
l
))
Φ
.
heapN
⊥
N
→
(
recv
l
P
★
(
P
-
★
Φ
'
()))
⊑
||
wait
(
LocV
l
)
{{
Φ
}}
.
Proof
.
Proof
.
Abort
.
Abort
.
Lemma
split_spec
l
P1
P2
Φ
:
Lemma
split_spec
l
P1
P2
Φ
:
(
recv
l
(
P1
★
P2
)
★
(
recv
l
P1
★
recv
l
P2
-
★
Φ
'
()))
⊑
wp
⊤
Skip
Φ
.
(
recv
l
(
P1
★
P2
)
★
(
recv
l
P1
★
recv
l
P2
-
★
Φ
'
()))
⊑
||
Skip
{{
Φ
}}
.
Proof
.
Proof
.
Abort
.
Abort
.
...
...
heap_lang/derived.v
View file @
ffa92c50
...
@@ -17,44 +17,47 @@ Implicit Types Φ : val → iProp heap_lang Σ.
...
@@ -17,44 +17,47 @@ Implicit Types Φ : val → iProp heap_lang Σ.
(** Proof rules for the sugar *)
(** Proof rules for the sugar *)
Lemma
wp_lam'
E
x
ef
e
v
Φ
:
Lemma
wp_lam'
E
x
ef
e
v
Φ
:
to_val
e
=
Some
v
→
▷
wp
E
(
subst
ef
x
v
)
Φ
⊑
wp
E
(
App
(
Lam
x
ef
)
e
)
Φ
.
to_val
e
=
Some
v
→
▷
||
subst
ef
x
v
@
E
{{
Φ
}}
⊑
||
App
(
Lam
x
ef
)
e
@
E
{{
Φ
}}.
Proof
.
intros
.
by
rewrite
-
wp_rec'
?subst_empty
.
Qed
.
Proof
.
intros
.
by
rewrite
-
wp_rec'
?subst_empty
.
Qed
.
Lemma
wp_let'
E
x
e1
e2
v
Φ
:
Lemma
wp_let'
E
x
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
▷
wp
E
(
subst
e2
x
v
)
Φ
⊑
wp
E
(
Let
x
e1
e2
)
Φ
.
to_val
e1
=
Some
v
→
▷
||
subst
e2
x
v
@
E
{{
Φ
}}
⊑
||
Let
x
e1
e2
@
E
{{
Φ
}}.
Proof
.
apply
wp_lam'
.
Qed
.
Proof
.
apply
wp_lam'
.
Qed
.
Lemma
wp_seq
E
e1
e2
Φ
:
wp
E
e1
(
λ
_
,
▷
wp
E
e2
Φ
)
⊑
wp
E
(
Seq
e1
e2
)
Φ
.
Lemma
wp_seq
E
e1
e2
Φ
:
||
e1
@
E
{{
λ
_
,
▷
||
e2
@
E
{{
Φ
}}
}}
⊑
||
Seq
e1
e2
@
E
{{
Φ
}}.
Proof
.
Proof
.
rewrite
-(
wp_bind
[
LetCtx
""
e2
]).
apply
wp_mono
=>
v
.
rewrite
-(
wp_bind
[
LetCtx
""
e2
]).
apply
wp_mono
=>
v
.
by
rewrite
-
wp_let'
//=
?to_of_val
?subst_empty
.
by
rewrite
-
wp_let'
//=
?to_of_val
?subst_empty
.
Qed
.
Qed
.
Lemma
wp_skip
E
Φ
:
▷
(
Φ
(
LitV
LitUnit
))
⊑
wp
E
Skip
Φ
.
Lemma
wp_skip
E
Φ
:
▷
Φ
(
LitV
LitUnit
)
⊑
||
Skip
@
E
{{
Φ
}}
.
Proof
.
rewrite
-
wp_seq
-
wp_value
//
-
wp_value
//.
Qed
.
Proof
.
rewrite
-
wp_seq
-
wp_value
//
-
wp_value
//.
Qed
.
Lemma
wp_le
E
(
n1
n2
:
Z
)
P
Φ
:
Lemma
wp_le
E
(
n1
n2
:
Z
)
P
Φ
:
(
n1
≤
n2
→
P
⊑
▷
Φ
(
LitV
$
LitBool
true
))
→
(
n1
≤
n2
→
P
⊑
▷
Φ
(
LitV
(
LitBool
true
)
))
→
(
n2
<
n1
→
P
⊑
▷
Φ
(
LitV
$
LitBool
false
))
→
(
n2
<
n1
→
P
⊑
▷
Φ
(
LitV
(
LitBool
false
)
))
→
P
⊑
wp
E
(
BinOp
LeOp
(
Lit
$
LitInt
n1
)
(
Lit
$
LitInt
n2
))
Φ
.
P
⊑
||
BinOp
LeOp
(
Lit
(
LitInt
n1
))
(
Lit
(
LitInt
n2
))
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-
wp_bin_op
//
;
[].
intros
.
rewrite
-
wp_bin_op
//
;
[].
destruct
(
bool_decide_reflect
(
n1
≤
n2
))
;
by
eauto
with
omega
.
destruct
(
bool_decide_reflect
(
n1
≤
n2
))
;
by
eauto
with
omega
.
Qed
.
Qed
.
Lemma
wp_lt
E
(
n1
n2
:
Z
)
P
Φ
:
Lemma
wp_lt
E
(
n1
n2
:
Z
)
P
Φ
:
(
n1
<
n2
→
P
⊑
▷
Φ
(
LitV
$
LitBool
true
))
→
(
n1
<
n2
→
P
⊑
▷
Φ
(
LitV
(
LitBool
true
)
))
→
(
n2
≤
n1
→
P
⊑
▷
Φ
(
LitV
$
LitBool
false
))
→
(
n2
≤
n1
→
P
⊑
▷
Φ
(
LitV
(
LitBool
false
)
))
→
P
⊑
wp
E
(
BinOp
LtOp
(
Lit
$
LitInt
n1
)
(
Lit
$
LitInt
n2
))
Φ
.
P
⊑
||
BinOp
LtOp
(
Lit
(
LitInt
n1
))
(
Lit
(
LitInt
n2
))
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-
wp_bin_op
//
;
[].
intros
.
rewrite
-
wp_bin_op
//
;
[].
destruct
(
bool_decide_reflect
(
n1
<
n2
))
;
by
eauto
with
omega
.
destruct
(
bool_decide_reflect
(
n1
<
n2
))
;
by
eauto
with
omega
.
Qed
.
Qed
.
Lemma
wp_eq
E
(
n1
n2
:
Z
)
P
Φ
:
Lemma
wp_eq
E
(
n1
n2
:
Z
)
P
Φ
:
(
n1
=
n2
→
P
⊑
▷
Φ
(
LitV
$
LitBool
true
))
→
(
n1
=
n2
→
P
⊑
▷
Φ
(
LitV
(
LitBool
true
)
))
→
(
n1
≠
n2
→
P
⊑
▷
Φ
(
LitV
$
LitBool
false
))
→
(
n1
≠
n2
→
P
⊑
▷
Φ
(
LitV
(
LitBool
false
)
))
→
P
⊑
wp
E
(
BinOp
EqOp
(
Lit
$
LitInt
n1
)
(
Lit
$
LitInt
n2
))
Φ
.
P
⊑
||
BinOp
EqOp
(
Lit
(
LitInt
n1
))
(
Lit
(
LitInt
n2
))
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-
wp_bin_op
//
;
[].
intros
.
rewrite
-
wp_bin_op
//
;
[].
destruct
(
bool_decide_reflect
(
n1
=
n2
))
;
by
eauto
with
omega
.
destruct
(
bool_decide_reflect
(
n1
=
n2
))
;
by
eauto
with
omega
.
...
...
heap_lang/heap.v
View file @
ffa92c50
...
@@ -65,7 +65,7 @@ Section heap.
...
@@ -65,7 +65,7 @@ Section heap.
(** Allocation *)
(** Allocation *)
Lemma
heap_alloc
E
N
σ
:
Lemma
heap_alloc
E
N
σ
:
authG
heap_lang
Σ
heapRA
→
nclose
N
⊆
E
→
authG
heap_lang
Σ
heapRA
→
nclose
N
⊆
E
→
ownP
σ
⊑
(|={
E
}=>
∃
(
_
:
heapG
Σ
)
,
heap_ctx
N
∧
Π★
{
map
σ
}
heap_mapsto
).
ownP
σ
⊑
(|={
E
}=>
∃
_
:
heapG
Σ
,
heap_ctx
N
∧
Π★
{
map
σ
}
heap_mapsto
).
Proof
.
Proof
.
intros
.
rewrite
-{
1
}(
from_to_heap
σ
).
etransitivity
.
intros
.
rewrite
-{
1
}(
from_to_heap
σ
).
etransitivity
.
{
rewrite
[
ownP
_
]
later_intro
.
{
rewrite
[
ownP
_
]
later_intro
.
...
@@ -100,7 +100,7 @@ Section heap.
...
@@ -100,7 +100,7 @@ Section heap.
to_val
e
=
Some
v
→
nclose
N
⊆
E
→
to_val
e
=
Some
v
→
nclose
N
⊆
E
→
P
⊑
heap_ctx
N
→
P
⊑
heap_ctx
N
→
P
⊑
(
▷
∀
l
,
l
↦
v
-
★
Φ
(
LocV
l
))
→
P
⊑
(
▷
∀
l
,
l
↦
v
-
★
Φ
(
LocV
l
))
→
P
⊑
wp
E
(
Alloc
e
)
Φ
.
P
⊑
||
Alloc
e
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
??
Hctx
HP
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
??
Hctx
HP
.
transitivity
(|={
E
}=>
auth_own
heap_name
∅
★
P
)%
I
.
transitivity
(|={
E
}=>
auth_own
heap_name
∅
★
P
)%
I
.
...
@@ -127,7 +127,7 @@ Section heap.
...
@@ -127,7 +127,7 @@ Section heap.
nclose
N
⊆
E
→
nclose
N
⊆
E
→
P
⊑
heap_ctx
N
→
P
⊑
heap_ctx
N
→
P
⊑
(
▷
l
↦
v
★
▷
(
l
↦
v
-
★
Φ
v
))
→
P
⊑
(
▷
l
↦
v
★
▷
(
l
↦
v
-
★
Φ
v
))
→
P
⊑
wp
E
(
Load
(
Loc
l
))
Φ
.
P
⊑
||
Load
(
Loc
l
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
HN
?
HP
Φ
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
HN
?
HP
Φ
.
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
id
)
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
id
)
...
@@ -146,7 +146,7 @@ Section heap.
...
@@ -146,7 +146,7 @@ Section heap.
to_val
e
=
Some
v
→
nclose
N
⊆
E
→
to_val
e
=
Some
v
→
nclose
N
⊆
E
→
P
⊑
heap_ctx
N
→
P
⊑
heap_ctx
N
→
P
⊑
(
▷
l
↦
v'
★
▷
(
l
↦
v
-
★
Φ
(
LitV
LitUnit
)))
→
P
⊑
(
▷
l
↦
v'
★
▷
(
l
↦
v
-
★
Φ
(
LitV
LitUnit
)))
→
P
⊑
wp
E
(
Store
(
Loc
l
)
e
)
Φ
.
P
⊑
||
Store
(
Loc
l
)
e
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>?
HN
?
HP
Φ
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>?
HN
?
HP
Φ
.
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
(
alter
(
λ
_
,
Excl
v
)
l
))
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
(
alter
(
λ
_
,
Excl
v
)
l
))
...
@@ -167,7 +167,7 @@ Section heap.
...
@@ -167,7 +167,7 @@ Section heap.
nclose
N
⊆
E
→
nclose
N
⊆
E
→
P
⊑
heap_ctx
N
→
P
⊑
heap_ctx
N
→
P
⊑
(
▷
l
↦
v'
★
▷
(
l
↦
v'
-
★
Φ
(
LitV
(
LitBool
false
))))
→
P
⊑
(
▷
l
↦
v'
★
▷
(
l
↦
v'
-
★
Φ
(
LitV
(
LitBool
false
))))
→
P
⊑
wp
E
(
Cas
(
Loc
l
)
e1
e2
)
Φ
.
P
⊑
||
Cas
(
Loc
l
)
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>???
HN
?
HP
Φ
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>???
HN
?
HP
Φ
.
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
id
)
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
id
)
...
@@ -187,7 +187,7 @@ Section heap.
...
@@ -187,7 +187,7 @@ Section heap.
nclose
N
⊆
E
→
nclose
N
⊆
E
→
P
⊑
heap_ctx
N
→
P
⊑
heap_ctx
N
→
P
⊑
(
▷
l
↦
v1
★
▷
(
l
↦
v2
-
★
Φ
(
LitV
(
LitBool
true
))))
→
P
⊑
(
▷
l
↦
v1
★
▷
(
l
↦
v2
-
★
Φ
(
LitV
(
LitBool
true
))))
→
P
⊑
wp
E
(
Cas
(
Loc
l
)
e1
e2
)
Φ
.
P
⊑
||
Cas
(
Loc
l
)
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
??
HN
?
HP
Φ
.
rewrite
/
heap_ctx
/
heap_inv
/
heap_mapsto
=>
??
HN
?
HP
Φ
.
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
(
alter
(
λ
_
,
Excl
v2
)
l
))
apply
(
auth_fsa'
heap_inv
(
wp_fsa
_
)
(
alter
(
λ
_
,
Excl
v2
)
l
))
...
...
heap_lang/lifting.v
View file @
ffa92c50
...
@@ -16,18 +16,14 @@ Implicit Types ef : option expr.
...
@@ -16,18 +16,14 @@ Implicit Types ef : option expr.
(** Bind. *)
(** Bind. *)
Lemma
wp_bind
{
E
e
}
K
Φ
:
Lemma
wp_bind
{
E
e
}
K
Φ
:
wp
E
e
(
λ
v
,
wp
E
(
fill
K
(
of_val
v
))
Φ
)
⊑
wp
E
(
fill
K
e
)
Φ
.
||
e
@
E
{{
λ
v
,
||
fill
K
(
of_val
v
)
@
E
{{
Φ
}}}}
⊑
||
fill
K
e
@
E
{{
Φ
}}.
Proof
.
apply
weakestpre
.
wp_bind
.
Qed
.
Lemma
wp_bindi
{
E
e
}
Ki
Φ
:
wp
E
e
(
λ
v
,
wp
E
(
fill_item
Ki
(
of_val
v
))
Φ
)
⊑
wp
E
(
fill_item
Ki
e
)
Φ
.
Proof
.
apply
weakestpre
.
wp_bind
.
Qed
.
Proof
.
apply
weakestpre
.
wp_bind
.
Qed
.
(** Base axioms for core primitives of the language: Stateful reductions. *)
(** Base axioms for core primitives of the language: Stateful reductions. *)
Lemma
wp_alloc_pst
E
σ
e
v
Φ
:
Lemma
wp_alloc_pst
E
σ
e
v
Φ
:
to_val
e
=
Some
v
→
to_val
e
=
Some
v
→
(
ownP
σ
★
▷
(
∀
l
,
σ
!!
l
=
None
∧
ownP
(<[
l
:
=
v
]>
σ
)
-
★
Φ
(
LocV
l
)))
(
ownP
σ
★
▷
(
∀
l
,
σ
!!
l
=
None
∧
ownP
(<[
l
:
=
v
]>
σ
)
-
★
Φ
(
LocV
l
)))
⊑
wp
E
(
Alloc
e
)
Φ
.
⊑
||
Alloc
e
@
E
{{
Φ
}}
.
Proof
.
Proof
.
(* TODO RJ: This works around ssreflect bug #22. *)
(* TODO RJ: This works around ssreflect bug #22. *)
intros
.
set
(
φ
v'
σ
'
ef
:
=
∃
l
,
intros
.
set
(
φ
v'
σ
'
ef
:
=
∃
l
,
...
@@ -44,7 +40,7 @@ Qed.
...
@@ -44,7 +40,7 @@ Qed.
Lemma
wp_load_pst
E
σ
l
v
Φ
:
Lemma
wp_load_pst
E
σ
l
v
Φ
:
σ
!!
l
=
Some
v
→
σ
!!
l
=
Some
v
→
(
ownP
σ
★
▷
(
ownP
σ
-
★
Φ
v
))
⊑
wp
E
(
Load
(
Loc
l
))
Φ
.
(
ownP
σ
★
▷
(
ownP
σ
-
★
Φ
v
))
⊑
||
Load
(
Loc
l
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
v
σ
None
)
?right_id
//
;
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
v
σ
None
)
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
using
to_of_val
.
last
by
intros
;
inv_step
;
eauto
using
to_of_val
.
...
@@ -52,7 +48,8 @@ Qed.
...
@@ -52,7 +48,8 @@ Qed.
Lemma
wp_store_pst
E
σ
l
e
v
v'
Φ
:
Lemma
wp_store_pst
E
σ
l
e
v
v'
Φ
:
to_val
e
=
Some
v
→
σ
!!
l
=
Some
v'
→
to_val
e
=
Some
v
→
σ
!!
l
=
Some
v'
→
(
ownP
σ
★
▷
(
ownP
(<[
l
:
=
v
]>
σ
)
-
★
Φ
(
LitV
LitUnit
)))
⊑
wp
E
(
Store
(
Loc
l
)
e
)
Φ
.
(
ownP
σ
★
▷
(
ownP
(<[
l
:
=
v
]>
σ
)
-
★
Φ
(
LitV
LitUnit
)))
⊑
||
Store
(
Loc
l
)
e
@
E
{{
Φ
}}.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
LitUnit
)
(<[
l
:
=
v
]>
σ
)
None
)
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
LitUnit
)
(<[
l
:
=
v
]>
σ
)
None
)
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
...
@@ -60,7 +57,8 @@ Qed.
...
@@ -60,7 +57,8 @@ Qed.
Lemma
wp_cas_fail_pst
E
σ
l
e1
v1
e2
v2
v'
Φ
:
Lemma
wp_cas_fail_pst
E
σ
l
e1
v1
e2
v2
v'
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
v'
→
v'
≠
v1
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
v'
→
v'
≠
v1
→
(
ownP
σ
★
▷
(
ownP
σ
-
★
Φ
(
LitV
$
LitBool
false
)))
⊑
wp
E
(
Cas
(
Loc
l
)
e1
e2
)
Φ
.
(
ownP
σ
★
▷
(
ownP
σ
-
★
Φ
(
LitV
$
LitBool
false
)))
⊑
||
Cas
(
Loc
l
)
e1
e2
@
E
{{
Φ
}}.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
$
LitBool
false
)
σ
None
)
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
$
LitBool
false
)
σ
None
)
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
...
@@ -69,15 +67,15 @@ Qed.
...
@@ -69,15 +67,15 @@ Qed.
Lemma
wp_cas_suc_pst
E
σ
l
e1
v1
e2
v2
Φ
:
Lemma
wp_cas_suc_pst
E
σ
l
e1
v1
e2
v2
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
v1
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
σ
!!
l
=
Some
v1
→
(
ownP
σ
★
▷
(
ownP
(<[
l
:
=
v2
]>
σ
)
-
★
Φ
(
LitV
$
LitBool
true
)))
(
ownP
σ
★
▷
(
ownP
(<[
l
:
=
v2
]>
σ
)
-
★
Φ
(
LitV
$
LitBool
true
)))
⊑
wp
E
(
Cas
(
Loc
l
)
e1
e2
)
Φ
.
⊑
||
Cas
(
Loc
l
)
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
$
LitBool
true
)
(<[
l
:
=
v2
]>
σ
)
None
)
intros
.
rewrite
-(
wp_lift_atomic_det_step
σ
(
LitV
$
LitBool
true
)
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
(<[
l
:
=
v2
]>
σ
)
None
)
?right_id
//
;
last
by
intros
;
inv_step
;
eauto
.
Qed
.
Qed
.
(** Base axioms for core primitives of the language: Stateless reductions *)
(** Base axioms for core primitives of the language: Stateless reductions *)
Lemma
wp_fork
E
e
Φ
:
Lemma
wp_fork
E
e
Φ
:
(
▷
Φ
(
LitV
LitUnit
)
★
▷
wp
(
Σ
:
=
Σ
)
⊤
e
(
λ
_
,
True
))
⊑
wp
E
(
Fork
e
)
Φ
.
(
▷
Φ
(
LitV
LitUnit
)
★
▷
||
e
{{
λ
_
,
True
}})
⊑
||
Fork
e
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
-(
wp_lift_pure_det_step
(
Fork
e
)
(
Lit
LitUnit
)
(
Some
e
))
//=
;
rewrite
-(
wp_lift_pure_det_step
(
Fork
e
)
(
Lit
LitUnit
)
(
Some
e
))
//=
;
last
by
intros
;
inv_step
;
eauto
.
last
by
intros
;
inv_step
;
eauto
.
...
@@ -88,7 +86,8 @@ Qed.
...
@@ -88,7 +86,8 @@ Qed.
The final version is defined in substitution.v. *)
The final version is defined in substitution.v. *)
Lemma
wp_rec'
E
f
x
e1
e2
v
Φ
:
Lemma
wp_rec'
E
f
x
e1
e2
v
Φ
:
to_val
e2
=
Some
v
→
to_val
e2
=
Some
v
→
▷
wp
E
(
subst
(
subst
e1
f
(
RecV
f
x
e1
))
x
v
)
Φ
⊑
wp
E
(
App
(
Rec
f
x
e1
)
e2
)
Φ
.
▷
||
subst
(
subst
e1
f
(
RecV
f
x
e1
))
x
v
@
E
{{
Φ
}}
⊑
||
App
(
Rec
f
x
e1
)
e2
@
E
{{
Φ
}}.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
App
_
_
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
App
_
_
)
(
subst
(
subst
e1
f
(
RecV
f
x
e1
))
x
v
)
None
)
?right_id
//=
;
(
subst
(
subst
e1
f
(
RecV
f
x
e1
))
x
v
)
None
)
?right_id
//=
;
...
@@ -97,7 +96,7 @@ Qed.
...
@@ -97,7 +96,7 @@ Qed.
Lemma
wp_un_op
E
op
l
l'
Φ
:
Lemma
wp_un_op
E
op
l
l'
Φ
:
un_op_eval
op
l
=
Some
l'
→
un_op_eval
op
l
=
Some
l'
→
▷
Φ
(
LitV
l'
)
⊑
wp
E
(
UnOp
op
(
Lit
l
))
Φ
.
▷
Φ
(
LitV
l'
)
⊑
||
UnOp
op
(
Lit
l
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
UnOp
op
_
)
(
Lit
l'
)
None
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
UnOp
op
_
)
(
Lit
l'
)
None
)
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
...
@@ -105,21 +104,21 @@ Qed.
...
@@ -105,21 +104,21 @@ Qed.
Lemma
wp_bin_op
E
op
l1
l2
l'
Φ
:
Lemma
wp_bin_op
E
op
l1
l2
l'
Φ
:
bin_op_eval
op
l1
l2
=
Some
l'
→
bin_op_eval
op
l1
l2
=
Some
l'
→
▷
Φ
(
LitV
l'
)
⊑
wp
E
(
BinOp
op
(
Lit
l1
)
(
Lit
l2
))
Φ
.
▷
Φ
(
LitV
l'
)
⊑
||
BinOp
op
(
Lit
l1
)
(
Lit
l2
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
Heval
.
rewrite
-(
wp_lift_pure_det_step
(
BinOp
op
_
_
)
(
Lit
l'
)
None
)
intros
Heval
.
rewrite
-(
wp_lift_pure_det_step
(
BinOp
op
_
_
)
(
Lit
l'
)
None
)
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
Qed
.
Qed
.
Lemma
wp_if_true
E
e1
e2
Φ
:
Lemma
wp_if_true
E
e1
e2
Φ
:
▷
wp
E
e1
Φ
⊑
wp
E
(
If
(
Lit
$
LitBool
true
)
e1
e2
)
Φ
.
▷
||
e1
@
E
{{
Φ
}}
⊑
||
If
(
Lit
(
LitBool
true
))
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
-(
wp_lift_pure_det_step
(
If
_
_
_
)
e1
None
)
rewrite
-(
wp_lift_pure_det_step
(
If
_
_
_
)
e1
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
?right_id
//
;
intros
;
inv_step
;
eauto
.
Qed
.
Qed
.
Lemma
wp_if_false
E
e1
e2
Φ
:
Lemma
wp_if_false
E
e1
e2
Φ
:
▷
wp
E
e2
Φ
⊑
wp
E
(
If
(
Lit
$
LitBool
false
)
e1
e2
)
Φ
.
▷
||
e2
@
E
{{
Φ
}}
⊑
||
If
(
Lit
(
LitBool
false
))
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
rewrite
-(
wp_lift_pure_det_step
(
If
_
_
_
)
e2
None
)
rewrite
-(
wp_lift_pure_det_step
(
If
_
_
_
)
e2
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
?right_id
//
;
intros
;
inv_step
;
eauto
.
...
@@ -127,7 +126,7 @@ Qed.
...
@@ -127,7 +126,7 @@ Qed.
Lemma
wp_fst
E
e1
v1
e2
v2
Φ
:
Lemma
wp_fst
E
e1
v1
e2
v2
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
▷
Φ
v1
⊑
wp
E
(
Fst
$
Pair
e1
e2
)
Φ
.
▷
Φ
v1
⊑
||
Fst
(
Pair
e1
e2
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Fst
_
)
e1
None
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Fst
_
)
e1
None
)
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
...
@@ -135,7 +134,7 @@ Qed.
...
@@ -135,7 +134,7 @@ Qed.
Lemma
wp_snd
E
e1
v1
e2
v2
Φ
:
Lemma
wp_snd
E
e1
v1
e2
v2
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
▷
Φ
v2
⊑
wp
E
(
Snd
$
Pair
e1
e2
)
Φ
.
▷
Φ
v2
⊑
||
Snd
(
Pair
e1
e2
)
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Snd
_
)
e2
None
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Snd
_
)
e2
None
)
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
?right_id
-
?wp_value
//
;
intros
;
inv_step
;
eauto
.
...
@@ -143,7 +142,7 @@ Qed.
...
@@ -143,7 +142,7 @@ Qed.
Lemma
wp_case_inl'
E
e0
v0
x1
e1
x2
e2
Φ
:
Lemma
wp_case_inl'
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
▷
wp
E
(
subst
e1
x1
v0
)
Φ
⊑
wp
E
(
Case
(
InjL
e0
)
x1
e1
x2
e2
)
Φ
.
▷
||
subst
e1
x1
v0
@
E
{{
Φ
}}
⊑
||
Case
(
InjL
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Case
_
_
_
_
_
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Case
_
_
_
_
_
)
(
subst
e1
x1
v0
)
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
(
subst
e1
x1
v0
)
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
...
@@ -151,7 +150,7 @@ Qed.
...
@@ -151,7 +150,7 @@ Qed.
Lemma
wp_case_inr'
E
e0
v0
x1
e1
x2
e2
Φ
:
Lemma
wp_case_inr'
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
▷
wp
E
(
subst
e2
x2
v0
)
Φ
⊑
wp
E
(
Case
(
InjR
e0
)
x1
e1
x2
e2
)
Φ
.
▷
||
subst
e2
x2
v0
@
E
{{
Φ
}}
⊑
||
Case
(
InjR
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Case
_
_
_
_
_
)
intros
.
rewrite
-(
wp_lift_pure_det_step
(
Case
_
_
_
_
_
)
(
subst
e2
x2
v0
)
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
(
subst
e2
x2
v0
)
None
)
?right_id
//
;
intros
;
inv_step
;
eauto
.
...
...
heap_lang/notation.v
View file @
ffa92c50
From
heap_lang
Require
Export
derived
.
From
heap_lang
Require
Export
derived
.
(* What about Arguments for hoare triples?. *)
Arguments
wp
{
_
_
}
_
_
%
L
_
.
Arguments
wp
{
_
_
}
_
_
%
L
_
.
Notation
"|| e @ E {{ Φ } }"
:
=
(
wp
E
e
%
L
Φ
)
(
at
level
20
,
e
,
Φ
at
level
200
,
format
"|| e @ E {{ Φ } }"
)
:
uPred_scope
.
Notation
"|| e {{ Φ } }"
:
=
(
wp
⊤
e
%
L
Φ
)
(
at
level
20
,
e
,
Φ
at
level
200
,
format
"|| e {{ Φ } }"
)
:
uPred_scope
.
Coercion
LitInt
:
Z
>->
base_lit
.
Coercion
LitInt
:
Z
>->
base_lit
.
Coercion
LitBool
:
bool
>->
base_lit
.
Coercion
LitBool
:
bool
>->
base_lit
.
...
...
heap_lang/substitution.v
View file @
ffa92c50
...
@@ -26,10 +26,10 @@ to be unfolded. For example, consider the rule [wp_rec'] from below:
...
@@ -26,10 +26,10 @@ to be unfolded. For example, consider the rule [wp_rec'] from below:
<<
<<
Definition foo : val := rec: "f" "x" := ... .
Definition foo : val := rec: "f" "x" := ... .
Lemma wp_rec
' E e1 f x erec e2 v Q
:
Lemma wp_rec
E e1 f x erec e2 v Φ
:
e1 = Rec f x erec →
e1 = Rec f x erec →
to_val e2 = Some v →
to_val e2 = Some v →
▷
wp E (gsubst (gsubst erec f e1) x e2) Q ⊑ wp E (App e1 e2) Q
.
▷
|| gsubst (gsubst erec f e1) x e2 @ E {{ Φ }} ⊑ || App e1 e2 @ E {{ Φ }}
.
>>
>>
We ensure that [e1] is substituted instead of [RecV f x erec]. So, for example
We ensure that [e1] is substituted instead of [RecV f x erec]. So, for example
...
@@ -123,7 +123,7 @@ Hint Resolve to_of_val.
...
@@ -123,7 +123,7 @@ Hint Resolve to_of_val.
Lemma
wp_rec
E
e1
f
x
erec
e2
v
Φ
:
Lemma
wp_rec
E
e1
f
x
erec
e2
v
Φ
:
e1
=
Rec
f
x
erec
→
e1
=
Rec
f
x
erec
→
to_val
e2
=
Some
v
→
to_val
e2
=
Some
v
→
▷
wp
E
(
gsubst
(
gsubst
erec
f
e1
)
x
e2
)
Φ
⊑
wp
E
(
App
e1
e2
)
Φ
.
▷
||
gsubst
(
gsubst
erec
f
e1
)
x
e2
@
E
{{
Φ
}}
⊑
||
App
e1
e2
@
E
{{
Φ
}}
.
Proof
.
Proof
.
intros
->
<-%
of_to_val
.
intros
->
<-%
of_to_val
.
rewrite
(
gsubst_correct
_
_
(
RecV
_
_
_
))
gsubst_correct
.
rewrite
(
gsubst_correct
_
_
(
RecV
_
_
_
))
gsubst_correct
.
...
@@ -131,21 +131,22 @@ Proof.
...
@@ -131,21 +131,22 @@ Proof.
Qed
.
Qed
.
Lemma
wp_lam
E
x
ef
e
v
Φ
:
Lemma
wp_lam
E
x
ef
e
v
Φ
:
to_val
e
=
Some
v
→
▷
wp
E
(
gsubst
ef
x
e
)
Φ
⊑
wp
E
(
App
(
Lam
x
ef
)
e
)
Φ
.
to_val
e
=
Some
v
→
▷
||
gsubst
ef
x
e
@
E
{{
Φ
}}
⊑
||
App
(
Lam
x
ef
)
e
@
E
{{
Φ
}}.
Proof
.
intros
<-%
of_to_val
;
rewrite
gsubst_correct
.
by
apply
wp_lam'
.
Qed
.
Proof
.
intros
<-%
of_to_val
;
rewrite
gsubst_correct
.
by
apply
wp_lam'
.
Qed
.
Lemma
wp_let
E
x
e1
e2
v
Φ
:
Lemma
wp_let
E
x
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
▷
wp
E
(
gsubst
e2
x
e1
)
Φ
⊑
wp
E
(
Let
x
e1
e2
)
Φ
.
to_val
e1
=
Some
v
→
▷
||
gsubst
e2
x
e1
@
E
{{
Φ
}}
⊑
||
Let
x
e1
e2
@
E
{{
Φ
}}.
Proof
.
apply
wp_lam
.
Qed
.
Proof
.
apply
wp_lam
.
Qed
.
Lemma
wp_case_inl
E
e0
v0
x1
e1
x2
e2
Φ
:
Lemma
wp_case_inl
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
▷
wp
E
(
gsubst
e1
x1
e0
)
Φ
⊑
wp
E
(
Case
(
InjL
e0
)
x1
e1
x2
e2
)
Φ
.
▷
||
gsubst
e1
x1
e0
@
E
{{
Φ
}}
⊑
||
Case
(
InjL
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}
.
Proof
.
intros
<-%
of_to_val
;
rewrite
gsubst_correct
.
by
apply
wp_case_inl'
.
Qed
.
Proof
.
intros
<-%
of_to_val
;
rewrite
gsubst_correct
.
by
apply
wp_case_inl'
.
Qed
.
Lemma
wp_case_inr
E
e0
v0
x1
e1
x2
e2
Φ
:
Lemma
wp_case_inr
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
▷
wp
E
(
gsubst
e2
x2
e0
)
Φ
⊑
wp
E
(
Case
(
InjR
e0
)
x1
e1
x2
e2
)
Φ
.
▷
||
gsubst
e2
x2
e0
@
E
{{
Φ
}}