Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Dan Frumin
ReLoC-v1
Commits
fc8c86f6
Commit
fc8c86f6
authored
Sep 22, 2017
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use Iris' PureExec typeclass
parent
08bc474f
Changes
18
Hide whitespace changes
Inline
Side-by-side
Showing
18 changed files
with
351 additions
and
460 deletions
+351
-460
theories/F_mu_ref_conc/lang.v
theories/F_mu_ref_conc/lang.v
+1
-1
theories/F_mu_ref_conc/pureexec.v
theories/F_mu_ref_conc/pureexec.v
+20
-81
theories/F_mu_ref_conc/reflection.v
theories/F_mu_ref_conc/reflection.v
+4
-0
theories/F_mu_ref_conc/rules.v
theories/F_mu_ref_conc/rules.v
+9
-92
theories/F_mu_ref_conc/subst.v
theories/F_mu_ref_conc/subst.v
+112
-18
theories/F_mu_ref_conc/tactics.v
theories/F_mu_ref_conc/tactics.v
+5
-5
theories/examples/counter.v
theories/examples/counter.v
+4
-3
theories/examples/lock.v
theories/examples/lock.v
+47
-1
theories/examples/stack/helping.v
theories/examples/stack/helping.v
+7
-7
theories/examples/stack/mailbox.v
theories/examples/stack/mailbox.v
+7
-7
theories/examples/stack/stack_rules.v
theories/examples/stack/stack_rules.v
+3
-3
theories/examples/various.v
theories/examples/various.v
+13
-1
theories/logrel/fundamental_binary.v
theories/logrel/fundamental_binary.v
+7
-6
theories/logrel/proofmode/tactics_rel.v
theories/logrel/proofmode/tactics_rel.v
+7
-7
theories/logrel/proofmode/tactics_threadpool.v
theories/logrel/proofmode/tactics_threadpool.v
+2
-77
theories/logrel/rules.v
theories/logrel/rules.v
+83
-76
theories/logrel/rules_threadpool.v
theories/logrel/rules_threadpool.v
+19
-74
theories/prelude/base.v
theories/prelude/base.v
+1
-1
No files found.
theories/F_mu_ref_conc/lang.v
View file @
fc8c86f6
...
...
@@ -373,7 +373,7 @@ Module lang.
Lemma
alloc_fresh
e
v
σ
:
let
l
:=
fresh
(
dom
(
gset
loc
)
σ
)
in
to_val
e
=
Some
v
→
head_step
(
Alloc
e
)
σ
(
Lit
(
Loc
l
))
(
<
[
l
:=
v
]
>
σ
)
[].
Proof
.
by
intros
;
apply
AllocS
,
(
not_elem_of_dom
(
D
:=
gset
_
)),
is_fresh
.
Qed
.
Proof
.
by
intros
;
apply
AllocS
,
(
not_elem_of_dom
(
D
:=
gset
loc
)),
is_fresh
.
Qed
.
End
lang
.
(
**
Language
instance
for
Iris
*
)
...
...
theories/F_mu_ref_conc/pureexec.v
View file @
fc8c86f6
From
iris_logrel
.
prelude
Require
Export
hax
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
lang
subst
notation
.
Class
PureExec
(
P
:
Prop
)
(
e1
e2
:
expr
)
:=
{
pure_exec_safe
:
P
->
∀
σ
,
head_reducible
e1
σ
;
pure_exec_puredet
:
P
->
∀
σ
1
e2
'
σ
2
efs
,
head_step
e1
σ
1
e2
'
σ
2
efs
->
σ
1
=
σ
2
/
\
e2
=
e2
'
/
\
[]
=
efs
;
}
.
(
*
DF
:
Some
tactics
will
loop
pretty
badly
and
consume
lots
of
memory
if
you
make
this
an
instance
*
)
Lemma
PureExec_Closed
P
e1
e2
`
{
HP
:
PureExec
P
e1
e2
}
`
{
Hcl
:
Closed
X
e1
}
:
P
->
Closed
X
e2
.
Proof
.
destruct
HP
as
[
Hpure
Hstep
].
intros
p
.
specialize
(
Hpure
p
).
specialize
(
Hstep
p
).
specialize
(
Hpure
inhabitant
).
unfold
head_reducible
in
*
.
destruct
Hpure
as
(
e
'
&
σ'
&
efs
&
Hst
).
destruct
(
Hstep
inhabitant
e
'
σ'
efs
Hst
)
as
(
?
&
?
&
?
);
subst
.
destruct
e1
;
inv_head_step
;
unfold
Closed
in
*
;
simpl
in
Hcl
;
simpl
;
destruct_and
?
;
split_and
?
;
eauto
.
-
apply
Closed_mono
with
∅
;
[
|
set_solver
].
destruct
f
,
x
;
simpl
in
*
;
eauto
;
repeat
apply
is_closed_subst_preserve
;
eauto
;
try
apply
of_val_closed
.
-
apply
of_val_closed
'
.
Qed
.
Local
Ltac
solve_exec_safe
:=
intros
;
subst
;
do
3
eexists
;
econstructor
;
eauto
.
Local
Ltac
solve_exec_puredet
:=
simpl
;
intros
;
by
inv_head_step
.
Local
Ltac
solve_pureexec
:=
apply
hoist_pred_pureexec
;
intros
;
destruct_and
?
;
apply
det_head_step_pureexec
;
[
solve_exec_safe
|
solve_exec_puredet
].
Instance
pure_binop
op
e1
v1
e2
v2
v
`
(
to_val
e1
=
Some
v1
)
`
(
to_val
e2
=
Some
v2
)
:
PureExec
(
binop_eval
op
v1
v2
=
Some
v
)
(
BinOp
op
e1
e2
)
(
of_val
v
).
Proof
.
split
;
intros
Hval
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_rec
f
x
e1
e2
v2
`
{
Closed
∅
(
Rec
f
x
e1
)
}
`
(
to_val
e2
=
Some
v2
)
:
PureExec
True
(
App
(
Rec
f
x
e1
)
e2
)
(
subst
'
f
(
Rec
f
x
e1
)
(
subst
'
x
e2
e1
)).
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
(
*
TODO
:
give
this
one
a
correct
priority
?
*
)
Instance
pure_rec_locked
e
f
x
e1
e2
v2
`
(
to_val
e2
=
Some
v2
)
`
(
e
=
Rec
f
x
e1
)
`
{
Closed
(
x
:
b
:
f
:
b
:
∅
)
e1
}
:
...
...
@@ -51,81 +25,46 @@ Instance pure_rec_locked e f x e1 e2 v2 `(to_val e2 = Some v2) `(e = Rec f x e1)
(
App
e
e2
)
(
e
$
/
v2
)
|
100.
Proof
.
split
;
intros
?
;
subst
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
destruct
f
;
by
inv_head_step
.
apply
hoist_pred_pureexec
;
intros
;
destruct_and
?
;
apply
det_head_step_pureexec
.
-
solve_exec_safe
.
-
destruct
f
;
solve_exec_puredet
.
Qed
.
Instance
pure_fst
e1
v1
e2
v2
`
(
to_val
e1
=
Some
v1
)
`
(
to_val
e2
=
Some
v2
)
:
PureExec
True
(
Fst
(
Pair
e1
e2
))
e1
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_snd
e1
v1
e2
v2
`
(
to_val
e1
=
Some
v1
)
`
(
to_val
e2
=
Some
v2
)
:
PureExec
True
(
Snd
(
Pair
e1
e2
))
e2
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_unfold
e1
v1
`
(
to_val
e1
=
Some
v1
)
:
PureExec
True
(
Unfold
(
Fold
e1
))
e1
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_unpack
e1
e2
v1
`
(
to_val
e1
=
Some
v1
)
:
PureExec
True
(
Unpack
(
Pack
e1
)
e2
)
(
e2
e1
).
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_if_true
e1
e2
:
PureExec
True
(
If
#
true
e1
e2
)
e1
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_if_false
e1
e2
:
PureExec
True
(
If
#
false
e1
e2
)
e2
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_case_inl
e0
v
`
(
to_val
e0
=
Some
v
)
e1
e2
:
PureExec
True
(
Case
(
InjL
e0
)
e1
e2
)
(
e1
e0
).
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_case_inr
e0
v
`
(
to_val
e0
=
Some
v
)
e1
e2
:
PureExec
True
(
Case
(
InjR
e0
)
e1
e2
)
(
e2
e0
).
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
Instance
pure_tlam
e
`
{
Closed
∅
e
}
:
PureExec
True
(
TApp
(
TLam
e
))
e
.
Proof
.
split
;
intros
?
.
-
intros
.
do
3
eexists
.
econstructor
;
eauto
using
to_of_val
.
-
intros
.
by
inv_head_step
.
Qed
.
Proof
.
solve_pureexec
.
Qed
.
theories/F_mu_ref_conc/reflection.v
View file @
fc8c86f6
...
...
@@ -231,12 +231,16 @@ Ltac solve_to_val :=
|
|-
to_val
?
e
=
Some
?
v
=>
let
e
'
:=
R
.
of_expr
e
in
change
(
to_val
(
R
.
to_expr
e
'
)
=
Some
v
);
apply
R
.
to_val_Some
;
simpl
;
unfold
R
.
to_expr
;
unlock
;
reflexivity
|
|-
IntoVal
?
e
?
v
=>
let
e
'
:=
R
.
of_expr
e
in
change
(
to_val
(
R
.
to_expr
e
'
)
=
Some
v
);
apply
R
.
to_val_Some
;
simpl
;
unfold
R
.
to_expr
;
reflexivity
|
|-
is_Some
(
to_val
?
e
)
=>
let
e
'
:=
R
.
of_expr
e
in
change
(
is_Some
(
to_val
(
R
.
to_expr
e
'
)));
apply
R
.
to_val_is_Some
,
(
bool_decide_unpack
_
);
vm_compute
;
exact
I
end
.
Hint
Extern
0
(
to_val
_
=
Some
_
)
=>
solve_to_val
:
typeclass_instances
.
Hint
Extern
0
(
is_Some
(
to_val
_
))
=>
solve_to_val
:
typeclass_instances
.
Hint
Extern
0
(
IntoVal
_
_
)
=>
solve_to_val
:
typeclass_instances
.
Ltac
solve_closed
:=
match
goal
with
...
...
theories/F_mu_ref_conc/rules.v
View file @
fc8c86f6
...
...
@@ -4,7 +4,7 @@ From iris.base_logic Require Export invariants big_op.
From
iris
.
algebra
Require
Import
auth
frac
agree
gmap
.
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
base_logic
Require
Export
gen_heap
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
lang
notation
pureexec
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
lang
notation
pureexec
reflection
.
Import
uPred
.
(
**
The
CMRA
for
the
heap
of
the
implementation
.
This
is
linked
to
the
...
...
@@ -108,15 +108,7 @@ Section lang_rules.
PureExec
φ
e1
e2
→
φ
→
▷
WP
e2
@
E
{{
Φ
}}
⊢
WP
e1
@
E
{{
Φ
}}
.
Proof
.
iIntros
(
?
H
φ
)
"HWP"
.
iApply
(
wp_lift_pure_det_head_step_no_fork
'
with
"HWP"
).
{
destruct
(
pure_exec_safe
H
φ
∅
)
as
(
e
'
&
σ'
&
efs
&
Hst
).
eapply
val_stuck
.
apply
Hst
.
}
{
apply
(
pure_exec_safe
H
φ
).
}
{
apply
(
pure_exec_puredet
H
φ
).
}
Qed
.
Proof
.
apply
wp_pure_step_later
.
Qed
.
Lemma
wp_rec
E
f
x
erec
e1
e2
Φ
:
e1
=
Rec
f
x
erec
→
...
...
@@ -125,7 +117,7 @@ Section lang_rules.
▷
WP
subst
'
f
e1
(
subst
'
x
e2
erec
)
@
E
{{
Φ
}}
⊢
WP
App
e1
e2
@
E
{{
Φ
}}
.
Proof
.
iIntros
(
?
[
v
?
]
?
)
"HWP"
.
subst
.
iApply
(
wp_pure
with
"HWP"
);
[
eapply
pure_rec
|
exact
I
];
eauto
.
iApply
(
wp_pure
with
"HWP"
);
eauto
.
Qed
.
Lemma
wp_tlam
E
e
Φ
{
Hcl
:
Closed
∅
e
}
:
▷
WP
e
@
E
{{
Φ
}}
⊢
WP
TApp
(
TLam
e
)
@
E
{{
Φ
}}
.
...
...
@@ -133,90 +125,15 @@ Section lang_rules.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
TApp
_
)
e
);
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_fold
E
e
v
Φ
:
to_val
e
=
Some
v
→
▷
(
|={
E
}=>
Φ
v
)
⊢
WP
Unfold
(
Fold
e
)
@
E
{{
Φ
}}
.
Proof
.
intros
<-%
of_to_val
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Unfold
_
)
(
of_val
v
))
-?
wp_value_fupd
;
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_pack
E
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
▷
WP
(
App
e2
e1
)
@
E
{{
Φ
}}
⊢
WP
Unpack
(
Pack
e1
)
e2
@
E
{{
Φ
}}
.
Proof
.
intros
<-%
of_to_val
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Unpack
_
_
)
_
);
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_fst
E
e1
v1
e2
v2
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
▷
(
|={
E
}=>
Φ
v1
)
⊢
WP
Fst
(
Pair
e1
e2
)
@
E
{{
Φ
}}
.
Proof
.
intros
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Fst
_
)
e1
)
-?
wp_value_fupd
;
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_snd
E
e1
v1
e2
v2
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
▷
(
|={
E
}=>
Φ
v2
)
⊢
WP
Snd
(
Pair
e1
e2
)
@
E
{{
Φ
}}
.
Proof
.
intros
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Snd
_
)
e2
)
-?
wp_value_fupd
;
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_case_inl
E
e0
v0
e1
e2
Φ
:
to_val
e0
=
Some
v0
→
▷
WP
App
e1
e0
@
E
{{
Φ
}}
⊢
WP
Case
(
InjL
e0
)
e1
e2
@
E
{{
Φ
}}
.
Proof
.
intros
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Case
_
_
_
)
_
);
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_case_inr
E
e0
v0
e1
e2
Φ
:
to_val
e0
=
Some
v0
→
▷
WP
App
e2
e0
@
E
{{
Φ
}}
⊢
WP
Case
(
InjR
e0
)
e1
e2
@
E
{{
Φ
}}
.
Proof
.
intros
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
Case
_
_
_
));
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_fork
E
e
Φ
:
▷
(
|={
E
}=>
Φ
#())
∗
▷
WP
e
{{
_
,
True
}}
⊢
WP
Fork
e
@
E
{{
Φ
}}
.
Proof
.
rewrite
-
(
wp_lift_pure_det_head_step
(
Fork
e
)
#()
[
e
])
//=; eauto.
-
rewrite
-
(
wp_value_fupd
_
_
#());
auto
.
by
rewrite
-
step_fupd_intro
// right_id later_sep.
-
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_if_true
E
e1
e2
Φ
:
▷
WP
e1
@
E
{{
Φ
}}
⊢
WP
If
#
true
e1
e2
@
E
{{
Φ
}}
.
Proof
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
If
_
_
_
)
e1
);
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_if_false
E
e1
e2
Φ
:
▷
WP
e2
@
E
{{
Φ
}}
⊢
WP
If
#
false
e1
e2
@
E
{{
Φ
}}
.
Proof
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
If
_
_
_
)
e2
);
eauto
.
intros
;
inv_head_step
;
eauto
.
rewrite
-
(
wp_lift_pure_det_head_step
(
Fork
e
)
#()
[
e
])
//=; eauto.
-
(
*
TODO
typeclass
inference
fail
*
)
erewrite
<-
(
wp_value_fupd
_
_
#());
eauto
;
last
solve_to_val
.
by
rewrite
-
step_fupd_intro
// right_id later_sep.
-
intros
;
inv_head_step
;
eauto
.
Qed
.
Lemma
wp_nat_binop
E
op
e1
e2
v1
v2
v
Φ
:
to_val
e1
=
Some
v1
→
to_val
e2
=
Some
v2
→
binop_eval
op
v1
v2
=
Some
v
→
▷
(
|={
E
}=>
Φ
v
)
⊢
WP
BinOp
op
e1
e2
@
E
{{
Φ
}}
.
Proof
.
intros
.
rewrite
-
(
wp_lift_pure_det_head_step_no_fork
(
BinOp
op
_
_
)
(
of_val
_
))
-?
wp_value_fupd
'
;
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
End
lang_rules
.
theories/F_mu_ref_conc/subst.v
View file @
fc8c86f6
...
...
@@ -413,6 +413,26 @@ Proof.
[
apply
lookup_delete
|
rewrite
delete_commute
;
apply
lookup_delete
].
Qed
.
(
**
Properties
of
the
context
substitution
*
)
Lemma
fill_item_subst_p
(
es
:
stringmap
val
)
(
Ki
:
ectx_item
)
(
e
:
expr
)
:
subst_p
es
(
fill_item
Ki
e
)
=
fill_item
(
subst_ctx_item
es
Ki
)
(
subst_p
es
e
).
Proof
.
induction
Ki
;
simpl
;
rewrite
?
of_val_subst_p
;
eauto
.
Qed
.
Lemma
fill_subst
(
es
:
stringmap
val
)
(
K
:
list
ectx_item
)
(
e
:
expr
)
:
subst_p
es
(
fill
K
e
)
=
fill
(
subst_ctx
es
K
)
(
subst_p
es
e
).
Proof
.
generalize
dependent
e
.
generalize
dependent
es
.
induction
K
as
[
|
Ki
K
];
eauto
.
intros
es
e
.
simpl
.
rewrite
IHK
.
by
rewrite
?
fill_item_subst_p
.
Qed
.
(
**
Substitutions
and
reductions
*
)
Lemma
subst_p_head_step
e
e
'
vs
efs
σ
σ'
:
head_step
e
σ
e
'
σ'
efs
→
head_step
(
subst_p
vs
e
)
σ
(
subst_p
vs
e
'
)
σ'
(
subst_p
vs
<
$
>
efs
).
...
...
@@ -438,7 +458,18 @@ Proof.
-
econstructor
.
by
rewrite
Closed_subst_p_id
.
Qed
.
Lemma
subst_p_safe
e
es
:
Lemma
subst_p_prim_step
e
e
'
vs
efs
σ
σ'
:
prim_step
e
σ
e
'
σ'
efs
→
prim_step
(
subst_p
vs
e
)
σ
(
subst_p
vs
e
'
)
σ'
(
subst_p
vs
<
$
>
efs
).
Proof
.
intros
Hst
.
destruct
Hst
as
[
K
e1
e2
??
Hst
];
subst
.
rewrite
!
fill_subst
.
eapply
Ectx_step
with
(
subst_ctx
vs
K
)
(
subst_p
vs
e1
)
(
subst_p
vs
e2
);
eauto
.
simpl
.
by
apply
subst_p_head_step
.
Qed
.
Lemma
subst_p_safe_head
e
es
:
(
∀
σ
,
head_reducible
e
σ
)
→
(
∀
σ
,
head_reducible
(
subst_p
es
e
)
σ
).
Proof
.
rewrite
/
head_reducible
.
...
...
@@ -447,7 +478,19 @@ Proof.
do
3
eexists
.
apply
subst_p_head_step
;
eauto
.
Qed
.
Lemma
subst_p_det
e
e
'
es
:
Lemma
subst_p_safe
e
es
:
(
∀
σ
,
reducible
e
σ
)
→
(
∀
σ
,
reducible
(
subst_p
es
e
)
σ
).
Proof
.
rewrite
/
reducible
.
intros
Hsafe
.
intros
σ
.
destruct
(
Hsafe
σ
)
as
(
e
'
&
σ'
&
efs
&
Hstep
).
destruct
Hstep
as
[
K
?
?
?
?
Hstep
].
subst
.
do
3
eexists
.
rewrite
fill_subst
.
eapply
Ectx_step
;
eauto
.
apply
subst_p_head_step
;
eauto
.
Qed
.
Lemma
subst_p_det_head
e
e
'
es
:
(
∀
σ
,
head_step
e
σ
e
'
σ
[])
→
(
∀
σ
1
e2
σ
2
efs
,
head_step
e
σ
1
e2
σ
2
efs
->
σ
1
=
σ
2
/
\
e
'
=
e2
/
\
[]
=
efs
)
→
(
∀
σ
1
e2
σ
2
efs
,
head_step
(
subst_p
es
e
)
σ
1
e2
σ
2
efs
->
σ
1
=
σ
2
/
\
(
subst_p
es
e
'
)
=
e2
/
\
[]
=
efs
).
...
...
@@ -482,20 +525,71 @@ Proof.
by
simplify_eq
.
Qed
.
(
**
Properties
of
the
context
substitution
*
)
Lemma
fill_item_subst_p
(
es
:
stringmap
val
)
(
Ki
:
ectx_item
)
(
e
:
expr
)
:
subst_p
es
(
fill_item
Ki
e
)
=
fill_item
(
subst_ctx_item
es
Ki
)
(
subst_p
es
e
).
Proof
.
induction
Ki
;
simpl
;
rewrite
?
of_val_subst_p
;
eauto
.
Qed
.
Lemma
subst_p_det
e
e
'
es
:
(
∀
σ
,
prim_step
e
σ
e
'
σ
[])
→
(
∀
σ
1
e2
σ
2
efs
,
prim_step
e
σ
1
e2
σ
2
efs
->
σ
1
=
σ
2
/
\
e
'
=
e2
/
\
[]
=
efs
)
→
(
∀
σ
1
e2
σ
2
efs
,
prim_step
(
subst_p
es
e
)
σ
1
e2
σ
2
efs
->
σ
1
=
σ
2
/
\
(
subst_p
es
e
'
)
=
e2
/
\
[]
=
efs
).
Proof
.
admit
.
Admitted
.
(
*
intros
Hstep
Hdet
σ
1
e2
σ
2
efs
Hst
.
*
)
(
*
assert
(
Hstep
'
:=
Hstep
).
*
)
(
*
specialize
(
Hdet
σ
1
).
*
)
(
*
specialize
(
Hstep
σ
1
).
*
)
(
*
destruct
Hstep
as
[
K0
e0
e0
'
??
Hstep
].
subst
.
simpl
in
*
.
*
)
(
*
rewrite
fill_subst
in
Hst
.
*
)
(
*
rewrite
fill_subst
.
*
)
(
*
destruct
Hst
as
[
K1
t0
t2
Hfill
?
Hst
].
subst
.
simpl
in
*
.
*
)
(
*
assert
(
to_val
(
subst_p
es
e0
)
=
None
)
as
Hnoval
.
*
)
(
*
{
pose
(
Hstuck
:=
val_prim_stuck
).
*
)
(
*
simpl
in
Hstuck
.
*
)
(
*
eapply
Hstuck
.
*
)
(
*
apply
head_prim_step
.
*
)
(
*
by
apply
subst_p_head_step
.
}
*
)
(
*
destruct
(
step_by_val
_
_
_
_
_
_
_
_
Hfill
Hnoval
Hst
)
*
)
(
*
as
[
K2
Hctx
].
subst
.
clear
Hnoval
.
*
)
(
*
rewrite
fill_app
in
Hfill
.
*
)
(
*
apply
fill_inj
in
Hfill
.
*
)
(
*
rewrite
fill_app
.
*
)
(
*
inversion
Hstep
;
subst
;
simplify_eq
/=
.
*
)
(
*
Focus
3.
*
)
(
*
inversion
Hst
;
subst
;
simplify_eq
/=
.
*
)
(
*
split_and
!
;
eauto
.
*
)
(
*
f_equal
.
*
)
(
*
rewrite
-
(
of_to_val
_
_
H0
).
*
)
(
*
rewrite
-
(
of_to_val
_
_
H1
).
*
)
(
*
inversion
Hstep
;
subst
;
simplify_eq
/=
.
*
)
(
*
inversion
Hfill
.
*
)
(
*
apply
fill_inj
.
*
)
(
*
repeat
(
split
;
eauto
).
*
)
(
*
apply
*
)
(
*
simpl
in
Hst
.
*
)
(
*
simpl
in
Hst
.
*
)
(
*
simpl
in
Hst
;
inversion
Hst
;
simplify_eq
/=
;
eauto
;
*
)
Lemma
fill_subst
(
es
:
stringmap
val
)
(
K
:
list
ectx_item
)
(
e
:
expr
)
:
subst_p
es
(
fill
K
e
)
=
fill
(
subst_ctx
es
K
)
(
subst_p
es
e
).
Proof
.
generalize
dependent
e
.
generalize
dependent
es
.
induction
K
as
[
|
Ki
K
];
eauto
.
intros
es
e
.
simpl
.
rewrite
IHK
.
by
rewrite
?
fill_item_subst_p
.
Qed
.
(
*
inversion
Hstep
;
subst
;
simplify_eq
/=
;
*
)
(
*
simpl
in
Hst
;
inversion
Hst
;
simplify_eq
/=
;
eauto
;
*
)
(
*
repeat
lazymatch
goal
with
*
)
(
*
|
[
H
:
to_val
?
e
=
Some
?
v
,
H
'
:
to_val
(
subst_p
es
?
e
)
=
Some
?
v2
|-
_
]
=>
*
)
(
*
rewrite
-
(
of_to_val
_
_
H
)
in
H
'
;
*
)
(
*
rewrite
of_val_subst_p
in
H
'
;
*
)
(
*
rewrite
to_of_val
in
H
'
*
)
(
*
|
[
H
:
to_val
?
e
=
Some
?
v
,
H
'
:
context
[
subst_p
_
?
e
]
|-
_
]
=>
*
)
(
*
rewrite
-
(
of_to_val
_
_
H
)
in
H
'
;
*
)
(
*
rewrite
of_val_subst_p
in
H
'
;
*
)
(
*
rewrite
(
of_to_val
_
_
H
)
in
H
'
*
)
(
*
end
;
simplify_eq
/=
;
*
)
(
*
rewrite
?
of_val_subst_p
;
*
)
(
*
split_and
!
;
eauto
.
*
)
(
*
-
rewrite
!
subst_p_delete
.
*
)
(
*
rewrite
!
(
delete_commute_binder
_
f
x
).
*
)
(
*
rewrite
(
Closed_subst_p_id
'
_
_
e1
);
eauto
.
*
)
(
*
rewrite
(
to_val_subst_p
e0
v0
_
);
eauto
.
*
)
(
*
apply
elem_of_rec_lookup
.
*
)
(
*
-
destruct
(
Hdet
_
_
_
Hst
)
as
(
?&?&?
).
*
)
(
*
by
simplify_eq
.
*
)
(
*
-
destruct
(
Hdet
_
_
_
Hst
)
as
(
?&?&?
).
*
)
(
*
by
simplify_eq
.
*
)
(
*
-
destruct
(
Hdet
_
_
_
Hst
)
as
(
?&?&?
).
*
)
(
*
by
simplify_eq
.
*
)
(
*
apply
subst_p_det_head
.
*
)
theories/F_mu_ref_conc/tactics.v
View file @
fc8c86f6
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
program_logic
Require
Export
weakestpre
lifting
.
From
iris
.
proofmode
Require
Export
tactics
coq_tactics
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
rules
lang
reflection
.
Set
Default
Proof
Using
"Type"
.
...
...
@@ -97,9 +97,9 @@ Tactic Notation "wp_bind" open_constr(efoc) :=
(
**
*
Symbolic
execution
WP
tactics
*
)
(
**
**
Pure
reductions
*
)
Lemma
tac_wp_pure
`
{
heapG
Σ
}
K
φ
e1
e2
ℶ
1
ℶ
2
E
Φ
:
IntoLaterNEnvs
1
ℶ
1
ℶ
2
→
PureExec
φ
e1
e2
→
φ
→
IntoLaterNEnvs
1
ℶ
1
ℶ
2
→
(
ℶ
2
⊢
WP
fill
K
e2
@
E
{{
Φ
}}
)
→
(
ℶ
1
⊢
WP
fill
K
e1
@
E
{{
Φ
}}
).
Proof
.
...
...
@@ -108,7 +108,7 @@ Proof.
rewrite
Hgoal
.
iIntros
"HWP"
.
wp_bind_core
K
.
iApply
wp_pure
;
eauto
.
iApply
wp_pure
_step_later
;
eauto
.
iApply
(
wp_bind_inv
with
"HWP"
).
{
(
*
TODO
:
how
to
get
rid
of
this
?
*
)
change
lang
with
(
ectx_lang
expr
).
...
...
@@ -122,9 +122,9 @@ Tactic Notation "wp_pure" open_constr(efoc) :=
|
|-
_
⊢
wp
?
E
?
e
?
Q
=>
reshape_expr
e
ltac
:
(
fun
K
e
'
=>
unify
e
'
efoc
;
eapply
(
tac_wp_pure
K
);
[
apply
_
(
*
IntoLaters
*
)
|
apply
_
(
*
PureExec
*
)
[
apply
_
(
*
PureExec
*
)
|
try
(
exact
I
||
reflexivity
||
tac_rel_done
)
|
apply
_
(
*
IntoLaters
*
)
|
simpl_subst
/=
(
*
new
goal
*
)])
end
.
...
...
theories/examples/counter.v
View file @
fc8c86f6
...
...
@@ -86,7 +86,7 @@ Section CG_Counter.
unfold
FG_increment
.
unlock
.
iApply
wp_rec
;
eauto
.
iNext
.
simpl
.
iApply
wp_value
;
eauto
.
simpl
.
by
rewrite
decide_left
.
iApply
wp_value
;
eauto
.
iApply
wp_rec
;
eauto
.
iNext
.
simpl
.
wp_bind
(
Load
(#
x
)).
...
...
@@ -95,11 +95,12 @@ Section CG_Counter.
iApply
wp_rec
;
eauto
.
iNext
.
simpl
.
wp_bind
(
BinOp
_
_
_
).
iApply
(
wp_nat_binop
);
eauto
.
iNext
.
iModIntro
.
simpl
.
wp_binop
.
iApply
wp_value
.
wp_bind
(
CAS
_
_
_
).
iApply
(
wp_cas_suc
with
"[Hx]"
);
auto
.
iNext
.
iIntros
"Hx"
.
iApply
wp_if_true
.
iNext
.
wp_if
.
iApply
wp_value
;
auto
.
by
iApply
"Hlog"
.
Qed
.
...
...
theories/examples/lock.v
View file @
fc8c86f6
...
...
@@ -67,6 +67,17 @@ Section proof.
iApply
(
"Hlog"
with
"Hl"
).
Qed
.
Lemma
bin_log_related_newlock_l
Γ
K
t
τ
:
(
∀
l
:
loc
,
l
↦ᵢ
#
false
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
#
l
≤
log
≤
t
:
τ
)
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
(
newlock
#())
≤
log
≤
t
:
τ
.
Proof
.
iIntros
"Hlog"
.
unfold
newlock
.
unlock
.
rel_rec_l
.
rel_alloc_l
as
l
"Hl"
.
iApply
(
"Hlog"
with
"Hl"
).
Qed
.
Global
Opaque
newlock
.
Transparent
acquire
.
...
...
@@ -96,7 +107,42 @@ Section proof.
rel_if_r
.
by
iApply
"Hlog"
.
Qed
.
Lemma
bin_log_related_acquire_suc_l
Γ
K
l
t
τ
:
l
↦ᵢ
#
false
-
∗
(
l
↦ᵢ
#
true
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
(#())
≤
log
≤
t
:
τ
)
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
(
acquire
#
l
)
≤
log
≤
t
:
τ
.
Proof
.
iIntros
"Hl Hlog"
.
unfold
acquire
.
unlock
.
rel_rec_l
.
rel_cas_l_atomic
.
iModIntro
.
iExists
_
;
iFrame
"Hl"
.
iSplitR
.
{
iIntros
(
Hfoo
).
congruence
.
}
iIntros
(
_
).
iNext
.
iIntros
"Hl"
.
rel_if_l
.
by
iApply
"Hlog"
.
Qed
.
Lemma
bin_log_related_acquire_fail_l
Γ
K
l
t
τ
:
l
↦ᵢ
#
true
-
∗
(
l
↦ᵢ
#
false
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
(
acquire
#
l
)
≤
log
≤
t
:
τ
)
-
∗
{
E1
,
E1
;
Δ
;
Γ
}
⊨
fill
K
(
acquire
#
l
)
≤
log
≤
t
:
τ
.
Proof
.
iIntros
"Hl Hlog"
.
iL
ö
b
as
"IH"
.
unfold
acquire
.
unlock
.
rel_rec_l
.