Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
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
96
Issues
96
List
Boards
Labels
Milestones
Merge Requests
14
Merge Requests
14
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Iris
Iris
Commits
fc83f26a
Commit
fc83f26a
authored
Jul 06, 2014
by
Filip Sieczkowski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Soundness/adequacy proved.
parent
afa3f82d
Changes
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
179 additions
and
7 deletions
+179
7
iris.v
iris.v
+179
7
No files found.
iris.v
View file @
fc83f26a
...
...
@@ 957,6 +957,185 @@ Qed.
End
HoareTriples
.
Section
Soundness
.
Local
Open
Scope
mask_scope
.
Local
Open
Scope
pcm_scope
.
Local
Open
Scope
bi_scope
.
Local
Open
Scope
lang_scope
.
Local
Open
Scope
list_scope
.
Inductive
stepn
:
nat
>
cfg
>
cfg
>
Prop
:
=

stepn_O
ρ
:
stepn
O
ρ
ρ

stepn_S
ρ
1
ρ
2
ρ
3
n
(
HS
:
step
ρ
1
ρ
2
)
(
HSN
:
stepn
n
ρ
2
ρ
3
)
:
stepn
(
S
n
)
ρ
1
ρ
3
.
Inductive
wptp
(
m
:
mask
)
(
w
:
Wld
)
(
n
:
nat
)
:
tpool
>
list
res
>
Prop
:
=

wp_emp
:
wptp
m
w
n
nil
nil

wp_cons
e
r
tp
rs
(
WPE
:
wp
m
e
(
umconst
⊤
)
w
n
r
)
(
WPTP
:
wptp
m
w
n
tp
rs
)
:
wptp
m
w
n
(
e
::
tp
)
(
r
::
rs
).
(* Trivial lemma about application split *)
Lemma
wptp_app
m
w
n
tp1
tp2
rs1
rs2
(
HW1
:
wptp
m
w
n
tp1
rs1
)
(
HW2
:
wptp
m
w
n
tp2
rs2
)
:
wptp
m
w
n
(
tp1
++
tp2
)
(
rs1
++
rs2
).
Proof
.
induction
HW1
;
[
constructor
]
;
now
trivial
.
Qed
.
(* Closure under future worlds and smaller steps *)
Lemma
wptp_closure
m
(
w1
w2
:
Wld
)
n1
n2
tp
rs
(
HSW
:
w1
⊑
w2
)
(
HLe
:
n2
<=
n1
)
(
HW
:
wptp
m
w1
n1
tp
rs
)
:
wptp
m
w2
n2
tp
rs
.
Proof
.
induction
HW
;
constructor
;
[
assumption
].
eapply
uni_pred
;
[
eassumption

reflexivity
].
rewrite
<
HSW
;
assumption
.
Qed
.
Lemma
wptp_app_tp
m
w
n
t1
t2
rs
(
HW
:
wptp
m
w
n
(
t1
++
t2
)
rs
)
:
exists
rs1
rs2
,
rs1
++
rs2
=
rs
/\
wptp
m
w
n
t1
rs1
/\
wptp
m
w
n
t2
rs2
.
Proof
.
revert
rs
HW
;
induction
t1
;
intros
;
inversion
HW
;
simpl
in
*
;
subst
;
clear
HW
.

exists
(@
nil
res
)
(@
nil
res
)
;
now
auto
using
wptp
.

exists
(@
nil
res
)
;
simpl
;
now
eauto
using
wptp
.

apply
IHt1
in
WPTP
;
destruct
WPTP
as
[
rs1
[
rs2
[
EQrs
[
WP1
WP2
]
]
]
]
;
clear
IHt1
.
exists
(
r
::
rs1
)
rs2
;
simpl
;
subst
;
now
auto
using
wptp
.
Qed
.
Lemma
comp_list_app
rs1
rs2
:
comp_list
(
rs1
++
rs2
)
==
comp_list
rs1
·
comp_list
rs2
.
Proof
.
induction
rs1
;
simpl
comp_list
;
[
now
rewrite
pcm_op_unit
by
apply
_
].
now
rewrite
IHrs1
,
assoc
.
Qed
.
Definition
wf_nat_ind
:
=
well_founded_induction
Wf_nat
.
lt_wf
.
Lemma
unfold_wp
m
:
wp
m
==
(
wpF
m
)
(
wp
m
).
Proof
.
unfold
wp
;
apply
fixp_eq
.
Qed
.
Lemma
sound_tp
m
n
k
e
e'
tp
tp'
σ
σ
'
φ
w
r
rs
s
(
HSN
:
stepn
n
(
e
::
tp
,
σ
)
(
e'
::
tp'
,
σ
'
))
(
HV
:
is_value
e'
)
(
HWE
:
wp
m
e
φ
w
(
n
+
S
k
)
r
)
(
HWTP
:
wptp
m
w
(
n
+
S
k
)
tp
rs
)
(
HE
:
erasure
σ
m
(
Some
r
·
comp_list
rs
)
s
w
@
n
+
S
k
)
:
exists
w'
r'
s'
,
w
⊑
w'
/\
φ
(
exist
_
e'
HV
)
w'
(
S
k
)
r'
/\
erasure
σ
'
m
(
Some
r'
)
s'
w'
@
S
k
.
Proof
.
revert
e
tp
σ
w
r
rs
s
HSN
HWE
HWTP
HE
;
induction
n
using
wf_nat_ind
;
rename
H
into
HInd
.
intros
;
inversion
HSN
;
subst
;
clear
HSN
.
(* e is a value *)
{
rename
e'
into
e
;
clear
HInd
HWTP
;
simpl
plus
in
*
;
rewrite
unfold_wp
in
HWE
.
edestruct
(
HWE
w
k
)
as
[
HVal
_
]
;
[
reflexivity

unfold
lt
;
reflexivity

eassumption
].
specialize
(
HVal
HV
)
;
destruct
HVal
as
[
w'
[
r'
[
s'
[
HSW
[
H
φ
HE'
]
]
]
]
].
destruct
(
Some
r'
·
comp_list
rs
)
as
[
r''
]
eqn
:
EQr
.

exists
w'
r''
s'
;
split
;
[
assumption

split
;
[
assumption
]
].
eapply
uni_pred
,
H
φ
;
[
reflexivity
].
rewrite
ord_res_optRes
;
exists
(
comp_list
rs
)
;
rewrite
comm
,
EQr
;
reflexivity
.

exfalso
;
eapply
erasure_not_empty
,
HE'
.
now
erewrite
pcm_op_zero
by
apply
_
.
}
rename
n0
into
n
;
specialize
(
HInd
n
(
le_n
_
))
;
inversion
HS
;
subst
;
clear
HS
.
(* atomic step *)
{
destruct
t1
as
[
ee
t1
]
;
inversion
H0
;
subst
;
clear
H0
.
(* step in e *)

simpl
in
HSN0
;
rewrite
unfold_wp
in
HWE
;
edestruct
(
HWE
w
(
n
+
S
k
))
as
[
_
[
HS
_
]
]
;
[
reflexivity

apply
le_n

eassumption
].
edestruct
HS
as
[
w'
[
r'
[
s'
[
HSW
[
HWE'
HE'
]
]
]
]
]
;
[
reflexivity

eassumption

clear
HS
HWE
HE
].
setoid_rewrite
HSW
;
eapply
HInd
;
try
eassumption
.
eapply
wptp_closure
,
HWTP
;
[
assumption

now
auto
with
arith
].
(* step in a spawned thread *)

apply
wptp_app_tp
in
HWTP
;
destruct
HWTP
as
[
rs1
[
rs2
[
EQrs
[
HWTP1
HWTP2
]
]
]
].
inversion
HWTP2
;
subst
;
clear
HWTP2
;
rewrite
unfold_wp
in
WPE
.
edestruct
(
WPE
w
(
n
+
S
k
)
s
(
Some
r
·
comp_list
(
rs1
++
rs0
)))
as
[
_
[
HS
_
]
]
;
[
reflexivity

apply
le_n

eapply
erasure_equiv
,
HE
;
try
reflexivity
;
[]
].
+
rewrite
!
comp_list_app
;
simpl
comp_list
;
unfold
equiv
.
rewrite
assoc
,
(
comm
(
Some
r0
)),
<
assoc
;
apply
pcm_op_equiv
;
[
reflexivity
].
now
rewrite
assoc
,
(
comm
(
Some
r0
)),
<
assoc
.
+
edestruct
HS
as
[
w'
[
r0'
[
s'
[
HSW
[
WPE'
HE'
]
]
]
]
]
;
[
reflexivity

eassumption

clear
WPE
HS
].
setoid_rewrite
HSW
;
eapply
HInd
;
try
eassumption
;
[
].
*
rewrite
<
HSW
;
eapply
uni_pred
,
HWE
;
[
now
auto
with
arith

reflexivity
].
*
apply
wptp_app
;
[
eapply
wptp_closure
,
HWTP1
;
[
assumption

now
auto
with
arith
]
].
constructor
;
[
eassumption

eapply
wptp_closure
,
WPTP
;
[
assumption

now
auto
with
arith
]
].
*
eapply
erasure_equiv
,
HE'
;
try
reflexivity
;
[].
rewrite
assoc
,
(
comm
(
Some
r0'
)),
<
assoc
;
apply
pcm_op_equiv
;
[
reflexivity
].
rewrite
!
comp_list_app
;
simpl
comp_list
.
now
rewrite
assoc
,
(
comm
(
comp_list
rs1
)),
<
assoc
.
}
(* fork *)
destruct
t1
as
[
ee
t1
]
;
inversion
H
;
subst
;
clear
H
.
(* fork from e *)

simpl
in
HSN0
;
rewrite
unfold_wp
in
HWE
;
edestruct
(
HWE
w
(
n
+
S
k
))
as
[
_
[
_
HF
]
]
;
[
reflexivity

apply
le_n

eassumption
].
specialize
(
HF
_
_
eq_refl
)
;
destruct
HF
as
[
w'
[
rfk
[
rret
[
s'
[
HSW
[
HWE'
[
HWFK
HE'
]
]
]
]
]
]
].
clear
HWE
HE
;
setoid_rewrite
HSW
;
eapply
HInd
with
(
rs
:
=
rs
++
[
rfk
])
;
try
eassumption
;
[].
+
apply
wptp_app
;
[
now
auto
using
wptp
].
eapply
wptp_closure
,
HWTP
;
[
assumption

now
auto
with
arith
].
+
eapply
erasure_equiv
,
HE'
;
try
reflexivity
;
[]
;
unfold
equiv
;
clear
.
rewrite
(
comm
(
Some
rfk
)),
<
assoc
;
apply
pcm_op_equiv
;
[
reflexivity
].
rewrite
comp_list_app
;
simpl
comp_list
;
rewrite
comm
.
now
erewrite
(
comm
_
1
),
pcm_op_unit
by
apply
_
.
(* fork from a spawned thread *)

apply
wptp_app_tp
in
HWTP
;
destruct
HWTP
as
[
rs1
[
rs2
[
EQrs
[
HWTP1
HWTP2
]
]
]
].
inversion
HWTP2
;
subst
;
clear
HWTP2
;
rewrite
unfold_wp
in
WPE
.
edestruct
(
WPE
w
(
n
+
S
k
)
s
(
Some
r
·
comp_list
(
rs1
++
rs0
)))
as
[
_
[
_
HF
]
]
;
[
reflexivity

apply
le_n

eapply
erasure_equiv
,
HE
;
try
reflexivity
;
[]
].
+
rewrite
assoc
,
(
comm
(
Some
r0
)),
<
assoc
;
apply
pcm_op_equiv
;
[
reflexivity
].
rewrite
!
comp_list_app
;
simpl
comp_list
;
now
rewrite
assoc
,
(
comm
(
Some
r0
)),
<
assoc
.
+
specialize
(
HF
_
_
eq_refl
)
;
destruct
HF
as
[
w'
[
rfk
[
rret
[
s'
[
HSW
[
WPE'
[
WPS
HE'
]
]
]
]
]
]
]
;
clear
WPE
.
setoid_rewrite
HSW
;
eapply
HInd
;
try
eassumption
;
[
].
*
rewrite
<
HSW
;
eapply
uni_pred
,
HWE
;
[
now
auto
with
arith

reflexivity
].
*
apply
wptp_app
;
[
eapply
wptp_closure
,
HWTP1
;
[
assumption

now
auto
with
arith
]
].
constructor
;
[
eassumption

apply
wptp_app
;
[
now
eauto
using
wptp
]
].
eapply
wptp_closure
,
WPTP
;
[
assumption

now
auto
with
arith
].
*
eapply
erasure_equiv
,
HE'
;
try
reflexivity
;
[].
rewrite
(
assoc
_
(
Some
r
)),
(
comm
_
(
Some
r
)),
<
assoc
.
apply
pcm_op_equiv
;
[
reflexivity
].
rewrite
(
comm
(
Some
rfk
)),
<
assoc
,
comp_list_app
;
simpl
comp_list
.
rewrite
assoc
,
(
comm
_
(
Some
rret
)),
<
assoc
.
apply
pcm_op_equiv
;
[
reflexivity
].
rewrite
(
comm
(
Some
rfk
)),
!
comp_list_app
;
simpl
comp_list
.
rewrite
assoc
;
apply
pcm_op_equiv
;
[
reflexivity
].
now
erewrite
comm
,
pcm_op_unit
by
apply
_
.
Qed
.
Lemma
unit_min
r
:
pcm_unit
_
⊑
r
.
Proof
.
exists
r
;
now
erewrite
comm
,
pcm_op_unit
by
apply
_
.
Qed
.
(** This is a (relatively) generic soundness statement; one can
simplify it for certain classes of assertions (e.g.,
independent of the worlds) and obtain easy corollaries. *)
Theorem
soundness
m
e
p
φ
n
k
e'
tp
σ
σ
'
w
r
s
(
HT
:
valid
(
ht
m
p
e
φ
))
(
HSN
:
stepn
n
([
e
],
σ
)
(
e'
::
tp
,
σ
'
))
(
HV
:
is_value
e'
)
(
HP
:
p
w
(
n
+
S
k
)
r
)
(
HE
:
erasure
σ
m
(
Some
r
)
s
w
@
n
+
S
k
)
:
exists
w'
r'
s'
,
w
⊑
w'
/\
φ
(
exist
_
e'
HV
)
w'
(
S
k
)
r'
/\
erasure
σ
'
m
(
Some
r'
)
s'
w'
@
S
k
.
Proof
.
specialize
(
HT
w
(
n
+
S
k
)
r
).
eapply
sound_tp
;
[
eassumption


constructor

eapply
erasure_equiv
,
HE
;
try
reflexivity
;
[]
].

apply
HT
in
HP
;
try
reflexivity
;
[
eassumption

apply
unit_min
].

simpl
comp_list
;
now
erewrite
comm
,
pcm_op_unit
by
apply
_
.
Qed
.
End
Soundness
.
Section
HoareTripleProperties
.
Local
Open
Scope
mask_scope
.
Local
Open
Scope
pcm_scope
.
...
...
@@ 1016,13 +1195,6 @@ Qed.
rewrite
EQv
;
reflexivity
.
Qed
.
Lemma
unit_min
r
:
pcm_unit
_
⊑
r
.
Proof
.
exists
r
;
now
erewrite
comm
,
pcm_op_unit
by
apply
_
.
Qed
.
Definition
wf_nat_ind
:
=
well_founded_induction
Wf_nat
.
lt_wf
.
Lemma
htBind
P
φ
φ
'
K
e
m
:
ht
m
P
e
φ
∧
all
(
plugV
m
φ
φ
'
K
)
⊑
ht
m
P
(
K
[[
e
]])
φ
'
.
Proof
.
...
...
Write
Preview
Markdown
is supported
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