Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Dan Frumin
ReLoC-v1
Commits
dcf43df0
Commit
dcf43df0
authored
Apr 11, 2017
by
Dan Frumin
Browse files
Modify the relational interpretation to account for masks/invariants
parent
8fad37e8
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
F_mu_ref_conc/examples/counter.v
View file @
dcf43df0
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
algebra
Require
Import
auth
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
examples
.
lock
.
From
iris_logrel
.
F_mu_ref_conc
Require
Import
tactics
soundness_binary
.
From
iris_logrel
.
F_mu_ref_conc
Require
Import
tactics
soundness_binary
relational_properties
.
From
iris
.
program_logic
Require
Import
adequacy
.
Definition
CG_increment
(
x
:
expr
)
:
expr
:=
...
...
@@ -123,6 +123,24 @@ Section CG_Counter.
Unshelve
.
all
:
trivial
.
Qed
.
Lemma
bin_log_related_CG_locked_increment
Γ
K
E1
E2
t
τ
x
n
l
:
nclose
specN
⊆
E1
→
(
x
↦ₛ
(#
nv
n
)
-
∗
l
↦ₛ
(#
♭
v
false
)
-
∗
(
x
↦ₛ
(#
nv
S
n
)
-
∗
l
↦ₛ
(#
♭
v
false
)
-
∗
(
{
E1
,
E2
;
Γ
}
⊨
t
≤
log
≤
fill
K
Unit
:
τ
))
-
∗
{
E1
,
E2
;
Γ
}
⊨
t
≤
log
≤
fill
K
(
App
(
CG_locked_increment
(
Loc
x
)
(
Loc
l
))
Unit
)
:
τ
)
%
I
.
Proof
.
iIntros
(
?
)
"Hx Hl Hlog"
.
unfold
CG_locked_increment
.
change
Unit
with
(
of_val
UnitV
).
iApply
(
bin_log_related_with_lock_r
Γ
K
E1
E2
(
x
↦ₛ
(#
nv
n
))
%
I
(
x
↦ₛ
(#
nv
S
n
))
(
CG_increment
(
Loc
x
))
UnitV
UnitV
l
t
τ
with
"[Hx] [Hl] [Hlog]"
);
auto
.
-
iIntros
(
ρ
j
K
'
)
"#Hspec Hx Hj /="
.
tp_apply
j
steps_CG_increment
with
"Hx"
as
"Hx"
.
iModIntro
.
iFrame
.
-
iIntros
"Hl Hx"
.
iApply
(
"Hlog"
with
"Hx Hl"
).
Qed
.
Global
Opaque
CG_locked_increment
.
Lemma
counter_read_to_val
x
:
to_val
(
counter_read
x
)
=
Some
(
counter_readV
x
).
...
...
@@ -242,103 +260,236 @@ Section CG_Counter.
Definition
counterN
:
namespace
:=
nroot
.
@
"counter"
.
(
*
TODO
:
those
should
be
accompaied
by
lemmas
;
preferably
so
that
[
change
]
does
not
change
too
much
*
)
Ltac
rel_bind_l
efoc
:=
lazymatch
goal
with
|
[
|-
(
_
⊢
bin_log_related
_
_
_
?
e
_
_
)
]
=>
reshape_expr
e
ltac
:
(
fun
K
e
'
=>
unify
e
'
efoc
;
change
e
with
(
fill
K
e
'
))
end
.
Ltac
rel_bind_r
efoc
:=
lazymatch
goal
with
|
[
|-
(
_
⊢
bin_log_related
_
_
_
_
?
e
_
)
]
=>
reshape_expr
e
ltac
:
(
fun
K
e
'
=>
unify
e
'
efoc
;
change
e
with
(
fill
K
e
'
))
end
.
Lemma
bin_log_related_arrow
Γ
(
e
e
'
:
expr
)
τ
τ'
(
Hclosed
:
∀
f
,
e
.[
upn
2
f
]
=
e
)
(
Hclosed
'
:
∀
f
,
e
'
.[
upn
2
f
]
=
e
'
)
:
□
(
∀
Δ
vv
,
⟦
τ
⟧
Δ
vv
-
∗
[]
⊨
App
(
Rec
e
)
(
of_val
(
vv
.1
))
≤
log
≤
App
(
Rec
e
'
)
(
of_val
(
vv
.2
))
:
τ'
)
-
∗
Γ
⊨
(
Rec
e
)
≤
log
≤
(
Rec
e
'
)
:
TArrow
τ
τ'
.
Proof
.
iIntros
"#H"
.
iIntros
(
Δ
vvs
ρ
)
"#Hs #HΓ"
;
iIntros
(
j
K
)
"Hj /="
.
iModIntro
.
iApply
wp_value
;
auto
.
iModIntro
.
iExists
(
RecV
e
'
).
rewrite
Hclosed
Hclosed
'
.
simpl
.
iFrame
"Hj"
.
iAlways
.
iIntros
(
vv
)
"Hvv"
.
iSpecialize
(
"H"
$
!
Δ
vv
with
"Hvv"
).
iSpecialize
(
"H"
$
!
Δ
with
"* Hs []"
).
{
iAlways
.
iApply
interp_env_nil
.
}
rewrite
?
fmap_nil
.
rewrite
?
empty_env_subst
.
done
.
Qed
.
Lemma
FG_CG_counter_refinement
:
[]
⊨
FG_counter
≤
log
≤
CG_counter
:
TProd
(
TArrow
TUnit
TUnit
)
(
TArrow
TUnit
TNat
).
Proof
.
iIntros
(
Δ
[
|??
]
ρ
)
"#Hspec #HΓ"
;
iIntros
(
j
K
)
"Hj"
;
last
first
.
{
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%
[
=
].
}
iClear
"HΓ"
.
cbn
-
[
FG_counter
CG_counter
].
rewrite
?
empty_env_subst
/
CG_counter
/
FG_counter
.
iApply
fupd_wp
.
tp_bind
j
newlock
.
tp_apply
j
steps_newlock
.
iDestruct
"Hj"
as
(
l
)
"[Hj Hl]"
.
tp_rec
j
.
asimpl
.
rewrite
CG_locked_increment_subst
/=
.
unfold
FG_counter
,
CG_counter
.
iApply
(
bin_log_related_alloc_l
[]
_
_
[
AppRCtx
(
RecV
(
FG_counter_body
(
Var
1
)))]);
auto
;
simpl
.
iModIntro
.
iIntros
(
cnt
)
"Hcnt"
.
rel_bind_r
newlock
.
iApply
(
bin_log_related_newlock_r
);
auto
;
simpl
.
iIntros
(
l
)
"Hl"
.
iApply
(
bin_log_related_rec_r
[]
[]);
auto
.
asimpl
.
rewrite
CG_locked_increment_subst
/=
.
rewrite
counter_read_subst
/=
.
tp_alloc
j
as
cnt
'
"Hcnt'"
.
tp_normalise
j
.
tp_rec
j
.
tp_normalise
j
.
asimpl
.
rewrite
CG_locked_increment_subst
/=
.
rewrite
counter_read_subst
/=
.
iModIntro
.
wp_bind
(
Alloc
_
).
iApply
wp_alloc
;
eauto
.
iNext
.
iIntros
(
cnt
)
"Hcnt /="
.
rel_bind_r
(
Alloc
(#
n
0
)).
iApply
(
bin_log_related_alloc_r
);
auto
.
iIntros
(
cnt
'
)
"Hcnt' /="
.
(
*
establishing
the
invariant
*
)
iAssert
((
∃
n
,
l
↦ₛ
(#
♭
v
false
)
∗
cnt
↦ᵢ
(#
nv
n
)
∗
cnt
'
↦ₛ
(#
nv
n
)
)
%
I
)
with
"[Hl Hcnt Hcnt']"
as
"Hinv"
.
{
iExists
_.
by
iFrame
.
}
iApply
fupd_wp
.
iMod
(
inv_alloc
counterN
with
"[Hinv]"
)
as
"#Hinv"
;
trivial
.
{
iNext
;
iExact
"Hinv"
.
}
(
*
splitting
increment
and
read
*
)
iApply
wp_rec
;
trivial
.
iNext
.
asimpl
.
iApply
(
bin_log_related_rec_l
[]
[]);
auto
.
iNext
.
asimpl
.
rewrite
counter_read_subst
/=
.
iApply
wp_value
;
simpl
.
{
by
rewrite
counter_read_to_val
.
}
iExists
(
PairV
(
CG_locked_incrementV
_
_
)
(
counter_readV
_
));
simpl
.
rewrite
CG_locked_increment_of_val
counter_read_of_val
.
iFrame
"Hj"
.
iExists
(
_
,
_
),
(
_
,
_
);
simpl
;
repeat
iSplit
;
trivial
.
-
(
*
refinement
of
increment
*
)
iAlways
.
clear
j
K
.
iIntros
(
v
)
"#Heq"
.
iIntros
(
j
K
)
"Hj"
.
rewrite
CG_locked_increment_of_val
/=
.
destruct
v
;
iDestruct
"Heq"
as
"[% %]"
;
simplify_eq
/=
.
iL
ö
b
as
"Hlat"
.
iApply
wp_rec
;
trivial
.
asimpl
.
iNext
.
(
*
fine
-
grained
reads
the
counter
*
)
wp_bind
(
Load
_
).
iApply
wp_atomic
;
eauto
.
iInv
counterN
as
(
n
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
iApply
(
wp_load
with
"[Hcnt]"
);
[
iNext
;
by
iFrame
|
].
iNext
.
iIntros
"Hcnt"
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
_.
iFrame
"Hl Hcnt Hcnt'"
.
}
iApply
wp_rec
;
trivial
.
asimpl
.
iNext
.
(
*
fine
-
grained
performs
increment
*
)
wp_bind
(
BinOp
Add
_
_
).
iApply
wp_nat_binop
;
simpl
.
iNext
.
iModIntro
.
wp_bind
(
CAS
_
_
_
).
iApply
wp_atomic
;
eauto
.
iInv
counterN
as
(
n
'
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
(
*
performing
CAS
*
)
destruct
(
decide
(
n
=
n
'
))
as
[
|
Hneq
];
subst
.
+
(
*
CAS
succeeds
*
)
(
*
In
this
case
,
we
perform
increment
in
the
coarse
-
grained
one
*
)
tp_apply
j
steps_CG_locked_increment
with
"Hcnt' Hl"
as
"[Hcnt' Hl]"
.
iApply
(
wp_cas_suc
with
"[Hcnt]"
);
auto
.
iNext
.
iIntros
"Hcnt"
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
_.
iFrame
"Hl Hcnt Hcnt'"
;
trivial
.
}
simpl
.
iApply
wp_if_true
.
iNext
.
iApply
wp_value
;
trivial
.
iExists
UnitV
;
iFrame
;
auto
.
+
(
*
CAS
fails
*
)
(
*
In
this
case
,
we
perform
a
recursive
call
*
)
iApply
(
wp_cas_fail
_
_
_
(#
nv
n
'
)
with
"[Hcnt]"
);
auto
;
[
inversion
1
;
subst
;
auto
|
].
iNext
.
iIntros
"Hcnt"
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
_
;
iFrame
"Hl Hcnt Hcnt'"
.
}
iApply
wp_if_false
.
iNext
.
by
iApply
"Hlat"
.
-
(
*
refinement
of
read
*
)
iAlways
.
clear
j
K
.
iIntros
(
v
)
"#Heq"
.
iIntros
(
j
K
)
"Hj"
.
rewrite
?
counter_read_of_val
.
iDestruct
"Heq"
as
"[% %]"
;
destruct
v
;
simplify_eq
/=
.
Transparent
counter_read
.
unfold
counter_read
at
2.
iApply
wp_rec
;
trivial
.
simpl
.
iNext
.
iApply
wp_atomic
;
eauto
.
iInv
counterN
as
(
n
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
tp_apply
j
steps_counter_read
with
"Hcnt'"
as
"Hcnt'"
.
iApply
(
wp_load
with
"[Hcnt]"
);
eauto
.
iNext
.
iIntros
"Hcnt"
.
iApply
(
bin_log_related_rec_r
[]
[]);
auto
.
simpl
.
rewrite
CG_locked_increment_subst
/=
.
rewrite
counter_read_subst
/=
.
iApply
(
bin_log_related_pair
[]
with
"[]"
);
last
first
.
-
Transparent
counter_read
.
unfold
counter_read
.
iApply
(
bin_log_related_rec
);
auto
.
iAlways
.
asimpl
.
rel_bind_l
(
Load
(
Loc
cnt
)).
iApply
(
bin_log_related_load_l
).
iInv
counterN
as
(
n
)
"[>Hl [Hcnt >Hcnt']]"
"Hclose"
.
iModIntro
.
iExists
(#
nv
n
).
iFrame
"Hcnt"
.
iSplit
;
eauto
.
iIntros
"Hcnt"
.
simpl
.
iApply
(
bin_log_related_load_r
_
[]
with
"[Hcnt']"
);
auto
.
{
solve_ndisj
.
}
{
by
compute
.
}
iIntros
"Hcnt'"
.
iApply
fupd_logrel
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
_
;
iFrame
"Hl Hcnt Hcnt'"
.
}
iExists
(#
nv
_
);
eauto
.
{
iNext
.
iExists
_.
by
iFrame
.
}
simpl
.
iModIntro
.
iPoseProof
(
bin_log_related_nat
[
TArrow
TUnit
TNat
;
TUnit
]
⊤
n
)
as
"H"
.
iFrame
"H"
.
(
*
TODO
:
iApply
does
not
work
in
this
case
*
)
-
Transparent
CG_locked_increment
.
unfold
CG_locked_increment
.
Transparent
with_lock
.
unfold
with_lock
.
iApply
(
bin_log_related_arrow
);
auto
.
iAlways
.
iIntros
(
Δ
[
v
v
'
])
"[% %]"
;
simpl
in
*
;
subst
.
clear
Δ
.
(
*
fold
this
stuff
back
*
)
change
(
Rec
(
App
(
Rec
(
App
(
Rec
(
App
(
Rec
(
Var
3
))
(
App
release
(
Loc
l
))))
(
App
(
CG_increment
(
Loc
cnt
'
)).[
ren
(
+
4
)]
(
Var
3
))))
(
App
acquire
(
Loc
l
))))
with
(
CG_locked_increment
(
Loc
cnt
'
)
(
Loc
l
)).
iL
ö
b
as
"Hlat"
.
iApply
(
bin_log_related_rec_l
_
[]);
auto
.
iNext
.
asimpl
.
rel_bind_l
(
Load
(
Loc
cnt
)).
iApply
(
bin_log_related_load_l
).
iInv
counterN
as
(
n
)
"[>Hl [Hcnt >Hcnt']]"
"Hclose"
.
iModIntro
.
iExists
(#
nv
n
).
iSplit
;
eauto
.
iFrame
"Hcnt"
.
iIntros
"Hcnt"
.
simpl
.
iApply
fupd_logrel
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
_.
iFrame
"Hl Hcnt Hcnt'"
.
}
iApply
(
bin_log_related_rec_l
_
[]);
auto
.
iNext
.
asimpl
.
rel_bind_l
(
BinOp
Add
(#
n
1
)
(#
n
n
)).
iApply
(
bin_log_related_binop_l
).
iNext
.
simpl
.
rel_bind_l
(
CAS
(
Loc
cnt
)
(#
n
n
)
(#
n
(
S
n
))).
iApply
(
bin_log_related_cas_l
);
auto
.
iInv
counterN
as
(
m
)
"[>Hl [Hcnt >Hcnt']]"
"Hclose"
.
iModIntro
.
iExists
(#
nv
m
).
iFrame
"Hcnt"
.
destruct
(
decide
(
n
=
m
)).
+
(
*
CAS
succeeds
*
)
subst
.
iSplitR
;
eauto
.
{
iDestruct
1
as
%
Hfoo
.
by
exfalso
.
}
iIntros
"_ Hcnt"
.
simpl
.
iApply
(
bin_log_related_CG_locked_increment
_
[]
with
"Hcnt' Hl"
);
auto
.
solve_ndisj
.
iIntros
"Hcnt' Hl"
.
iApply
fupd_logrel
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
(
S
m
).
iFrame
.
}
iApply
(
bin_log_related_if_true_l
_
[]);
auto
.
iNext
.
simpl
.
iPoseProof
(
bin_log_related_unit
[]
⊤
)
as
"H"
.
iExact
"H"
.
(
*
TODO
iApply
does
not
work
*
)
+
(
*
CAS
fails
*
)
iSplitL
;
eauto
;
last
first
.
{
iDestruct
1
as
%
Hfoo
.
injection
Hfoo
.
intro
.
by
exfalso
.
}
iIntros
"_ Hcnt"
.
simpl
.
iApply
fupd_logrel
.
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
{
iNext
.
iExists
m
.
iFrame
.
}
iApply
(
bin_log_related_if_false_l
[]
[]);
auto
.
Qed
.
(
*
iIntros
(
Δ
[
|??
]
ρ
)
"#Hspec #HΓ"
;
iIntros
(
j
K
)
"Hj"
;
last
first
.
*
)
(
*
{
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%
[
=
].
}
*
)
(
*
iClear
"HΓ"
.
cbn
-
[
FG_counter
CG_counter
].
*
)
(
*
rewrite
?
empty_env_subst
/
CG_counter
/
FG_counter
.
*
)
(
*
iApply
fupd_wp
.
*
)
(
*
tp_bind
j
newlock
.
*
)
(
*
tp_apply
j
steps_newlock
.
*
)
(
*
iDestruct
"Hj"
as
(
l
)
"[Hj Hl]"
.
*
)
(
*
tp_rec
j
.
*
)
(
*
asimpl
.
rewrite
CG_locked_increment_subst
/=
.
*
)
(
*
rewrite
counter_read_subst
/=
.
*
)
(
*
tp_alloc
j
as
cnt
'
"Hcnt'"
.
tp_normalise
j
.
*
)
(
*
tp_rec
j
.
tp_normalise
j
.
*
)
(
*
asimpl
.
rewrite
CG_locked_increment_subst
/=
.
*
)
(
*
rewrite
counter_read_subst
/=
.
*
)
(
*
iModIntro
.
wp_bind
(
Alloc
_
).
*
)
(
*
iApply
wp_alloc
;
eauto
.
iNext
.
*
)
(
*
iIntros
(
cnt
)
"Hcnt /="
.
*
)
(
*
(
*
establishing
the
invariant
*
)
*
)
(
*
iAssert
((
∃
n
,
l
↦ₛ
(#
♭
v
false
)
∗
cnt
↦ᵢ
(#
nv
n
)
∗
cnt
'
↦ₛ
(#
nv
n
)
)
%
I
)
*
)
(
*
with
"[Hl Hcnt Hcnt']"
as
"Hinv"
.
*
)
(
*
{
iExists
_.
by
iFrame
.
}
*
)
(
*
iApply
fupd_wp
.
*
)
(
*
iMod
(
inv_alloc
counterN
with
"[Hinv]"
)
as
"#Hinv"
;
trivial
.
*
)
(
*
{
iNext
;
iExact
"Hinv"
.
}
*
)
(
*
(
*
splitting
increment
and
read
*
)
*
)
(
*
iApply
wp_rec
;
trivial
.
iNext
.
asimpl
.
*
)
(
*
rewrite
counter_read_subst
/=
.
*
)
(
*
iApply
wp_value
;
simpl
.
*
)
(
*
{
by
rewrite
counter_read_to_val
.
}
*
)
(
*
iExists
(
PairV
(
CG_locked_incrementV
_
_
)
(
counter_readV
_
));
simpl
.
*
)
(
*
rewrite
CG_locked_increment_of_val
counter_read_of_val
.
*
)
(
*
iFrame
"Hj"
.
*
)
(
*
iExists
(
_
,
_
),
(
_
,
_
);
simpl
;
repeat
iSplit
;
trivial
.
*
)
(
*
-
(
*
refinement
of
increment
*
)
*
)
(
*
iAlways
.
clear
j
K
.
iIntros
(
v
)
"#Heq"
.
iIntros
(
j
K
)
"Hj"
.
*
)
(
*
rewrite
CG_locked_increment_of_val
/=
.
*
)
(
*
destruct
v
;
iDestruct
"Heq"
as
"[% %]"
;
simplify_eq
/=
.
*
)
(
*
iL
ö
b
as
"Hlat"
.
*
)
(
*
iApply
wp_rec
;
trivial
.
asimpl
.
iNext
.
*
)
(
*
(
*
fine
-
grained
reads
the
counter
*
)
*
)
(
*
wp_bind
(
Load
_
).
*
)
(
*
iApply
wp_atomic
;
eauto
.
*
)
(
*
iInv
counterN
as
(
n
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
*
)
(
*
iApply
(
wp_load
with
"[Hcnt]"
);
[
iNext
;
by
iFrame
|
].
*
)
(
*
iNext
.
iIntros
"Hcnt"
.
*
)
(
*
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
*
)
(
*
{
iNext
.
iExists
_.
iFrame
"Hl Hcnt Hcnt'"
.
}
*
)
(
*
iApply
wp_rec
;
trivial
.
asimpl
.
iNext
.
*
)
(
*
(
*
fine
-
grained
performs
increment
*
)
*
)
(
*
wp_bind
(
BinOp
Add
_
_
).
*
)
(
*
iApply
wp_nat_binop
;
simpl
.
*
)
(
*
iNext
.
iModIntro
.
*
)
(
*
wp_bind
(
CAS
_
_
_
).
*
)
(
*
iApply
wp_atomic
;
eauto
.
*
)
(
*
iInv
counterN
as
(
n
'
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
*
)
(
*
(
*
performing
CAS
*
)
*
)
(
*
destruct
(
decide
(
n
=
n
'
))
as
[
|
Hneq
];
subst
.
*
)
(
*
+
(
*
CAS
succeeds
*
)
*
)
(
*
(
*
In
this
case
,
we
perform
increment
in
the
coarse
-
grained
one
*
)
*
)
(
*
tp_apply
j
steps_CG_locked_increment
with
"Hcnt' Hl"
*
)
(
*
as
"[Hcnt' Hl]"
.
*
)
(
*
iApply
(
wp_cas_suc
with
"[Hcnt]"
);
auto
.
*
)
(
*
iNext
.
iIntros
"Hcnt"
.
*
)
(
*
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
*
)
(
*
{
iNext
.
iExists
_.
iFrame
"Hl Hcnt Hcnt'"
;
trivial
.
}
*
)
(
*
simpl
.
*
)
(
*
iApply
wp_if_true
.
iNext
.
iApply
wp_value
;
trivial
.
*
)
(
*
iExists
UnitV
;
iFrame
;
auto
.
*
)
(
*
+
(
*
CAS
fails
*
)
*
)
(
*
(
*
In
this
case
,
we
perform
a
recursive
call
*
)
*
)
(
*
iApply
(
wp_cas_fail
_
_
_
(#
nv
n
'
)
with
"[Hcnt]"
);
auto
;
*
)
(
*
[
inversion
1
;
subst
;
auto
|
].
*
)
(
*
iNext
.
iIntros
"Hcnt"
.
*
)
(
*
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
*
)
(
*
{
iNext
.
iExists
_
;
iFrame
"Hl Hcnt Hcnt'"
.
}
*
)
(
*
iApply
wp_if_false
.
iNext
.
by
iApply
"Hlat"
.
*
)
(
*
-
(
*
refinement
of
read
*
)
*
)
(
*
iAlways
.
clear
j
K
.
iIntros
(
v
)
"#Heq"
.
iIntros
(
j
K
)
"Hj"
.
*
)
(
*
rewrite
?
counter_read_of_val
.
*
)
(
*
iDestruct
"Heq"
as
"[% %]"
;
destruct
v
;
simplify_eq
/=
.
*
)
(
*
Transparent
counter_read
.
*
)
(
*
unfold
counter_read
at
2.
*
)
(
*
iApply
wp_rec
;
trivial
.
simpl
.
*
)
(
*
iNext
.
*
)
(
*
iApply
wp_atomic
;
eauto
.
*
)
(
*
iInv
counterN
as
(
n
)
">[Hl [Hcnt Hcnt']]"
"Hclose"
.
*
)
(
*
tp_apply
j
steps_counter_read
with
"Hcnt'"
as
"Hcnt'"
.
*
)
(
*
iApply
(
wp_load
with
"[Hcnt]"
);
eauto
.
*
)
(
*
iNext
.
iIntros
"Hcnt"
.
*
)
(
*
iMod
(
"Hclose"
with
"[Hl Hcnt Hcnt']"
).
*
)
(
*
{
iNext
.
iExists
_
;
iFrame
"Hl Hcnt Hcnt'"
.
}
*
)
(
*
iExists
(#
nv
_
);
eauto
.
*
)
End
CG_Counter
.
Theorem
counter_ctx_refinement
:
...
...
F_mu_ref_conc/examples/lock.v
View file @
dcf43df0
From
iris
.
proofmode
Require
Import
tactics
.
From
iris_logrel
.
F_mu_ref_conc
Require
Import
tactics
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
rules_binary
typing
fundamental_binary
.
From
iris_logrel
.
F_mu_ref_conc
Require
Export
rules_binary
typing
fundamental_binary
relational_properties
.
From
iris
.
base_logic
Require
Import
namespaces
.
(
**
[
newlock
=
alloc
false
]
*
)
...
...
@@ -206,18 +206,19 @@ Section proof.
by
iFrame
.
Qed
.
Lemma
bin_log_related_with_lock_r
Γ
K
P
Q
e
v
w
l
t
τ
:
Lemma
bin_log_related_with_lock_r
Γ
K
E1
E2
P
Q
e
v
w
l
t
τ
:
(
nclose
specN
⊆
E1
)
→
(
∀
f
,
e
.[
f
]
=
e
)
(
*
e
is
a
closed
term
*
)
→
(
∀
f
,
(
of_val
v
).[
f
]
=
of_val
v
)
(
*
v
is
a
closed
term
*
)
→
(
∀
f
,
(
of_val
w
).[
f
]
=
of_val
w
)
(
*
w
is
a
closed
term
*
)
→
(
∀
ρ
j
K
'
,
spec_ctx
ρ
-
∗
P
-
∗
j
⤇
fill
K
'
(
App
e
(
of_val
w
))
={
⊤
}=
∗
j
⤇
fill
K
'
(
of_val
v
)
∗
Q
)
→
={
E1
}=
∗
j
⤇
fill
K
'
(
of_val
v
)
∗
Q
)
→
P
-
∗
l
↦ₛ
(#
♭
v
false
)
-
∗
(
l
↦ₛ
(#
♭
v
false
)
-
∗
Q
-
∗
Γ
⊨
t
≤
log
≤
fill
K
(
of_val
v
)
:
τ
)
%
I
-
∗
Γ
⊨
t
≤
log
≤
fill
K
(
App
(
with_lock
e
(
Loc
l
))
(
of_val
w
))
:
τ
.
(
l
↦ₛ
(#
♭
v
false
)
-
∗
Q
-
∗
{
E1
,
E2
;
Γ
}
⊨
t
≤
log
≤
fill
K
(
of_val
v
)
:
τ
)
%
I
-
∗
{
E1
,
E2
;
Γ
}
⊨
t
≤
log
≤
fill
K
(
App
(
with_lock
e
(
Loc
l
))
(
of_val
w
))
:
τ
.
Proof
.
iIntros
(
????
)
"HP Hl Hlog"
.
iIntros
(
????
?
)
"HP Hl Hlog"
.
pose
(
Φ
:=
(
fun
(
w
:
val
)
=>
⌜
w
=
v
⌝
∗
Q
∗
l
↦ₛ
(#
♭
v
false
))
%
I
).
iApply
(
bin_log_related_step_r
Φ
with
"[HP Hl]"
).
{
intros
.
...
...
F_mu_ref_conc/examples/stack/refinement.v
View file @
dcf43df0
...
...
@@ -92,8 +92,9 @@ Section Stack_refinement.
tp_bind
j
(
App
(
of_val
f2
)
_
).
iSpecialize
(
"Hff"
$
!
(
y1
,
y2
)
with
"[Hy]"
);
first
by
iFrame
.
iSpecialize
(
"Hff"
$
!
j
(
K
++
_
)
with
"Hj"
).
simpl
.
iApply
fupd_wp
.
iMod
"Hff"
.
iModIntro
.
iApply
(
wp_wand
with
"Hff"
).
iIntros
(
v
).
i
Destruct
1
as
(
v2
)
"[Hj [% %]]"
.
iIntros
(
v
).
i
Mod
1
as
(
v2
)
"[Hj [% %]]"
.
tp_normalise
j
.
asimpl
.
iApply
fupd_wp
.
tp_rec
j
;
auto
using
to_of_val
.
asimpl
.
...
...
@@ -161,7 +162,8 @@ Section Stack_refinement.
congruence
.
iNext
.
iIntros
"Hst"
.
close_sinv
"Hclose"
"[HLK Hst Hoe Hl Hst' Histk']"
.
iApply
wp_if_false
.
iNext
.
iApply
"IH"
.
iFrame
.
iMod
(
"IH"
with
"Hj"
)
as
"IH'"
.
iApply
"IH'"
.
Qed
.
Lemma
FG_CG_pop_refinement
ρ
st
st
'
(
τ
i
:
D
)
l
Δ
{
τ
P
:
∀
ww
,
PersistentP
(
τ
i
ww
)
}
{
SH
:
stackG
Σ
}:
...
...
@@ -198,7 +200,7 @@ Section Stack_refinement.
iApply
wp_case_inl
;
auto
.
iNext
.
iApply
wp_value
;
auto
.
iExists
(
InjLV
())
%
V
.
iFrame
"Hj"
.
iLeft
.
iExists
(
_
,
_
).
iSplit
;
auto
.
iLeft
.
iExists
(
_
,
_
).
iModIntro
.
iSplit
;
auto
.
+
close_sinv
"Hclose"
"[Hoe Hst' Hst Hl]"
.
wp_bind
(
Unfold
_
).
iApply
wp_fold
;
first
auto
.
iNext
.
iApply
wp_rec
;
first
auto
.
iNext
.
asimpl
.
...
...
@@ -250,14 +252,14 @@ Section Stack_refinement.
iModIntro
.
iApply
wp_value
;
try
by
rewrite
/=
?
to_of_val
/=
.
iExists
(
InjRV
zn1
).
iFrame
"Hj"
.
iRight
.
iExists
(
_
,
_
).
simpl
.
iSplit
;
auto
.
iRight
.
iExists
(
_
,
_
).
simpl
.
iModIntro
.
iSplit
;
auto
.
*
(
*
CAS
fails
*
)
iApply
(
wp_cas_fail
with
"Hst"
);
try
by
(
rewrite
/=
?
to_of_val
/=
).
congruence
.
iNext
.
iIntros
"Hst"
.
close_sinv
"Hclose"
"[-Hj]"
.
iApply
wp_if_false
.
iNext
.
by
i
Apply
"IH"
.
by
i
Mod
(
"IH"
with
"Hj"
)
.
Qed
.
(
*
∀
α
.
(
α
→
Unit
)
*
(
Unit
→
Unit
+
α
)
*
((
α
→
Unit
)
→
Unit
)
*
)
...
...
@@ -278,7 +280,7 @@ Section Stack_refinement.
(
TArrow
(
TVar
0
)
TUnit
)
(
TArrow
TUnit
(
TSum
TUnit
(
TVar
0
))))
(
TArrow
(
TArrow
(
TVar
0
)
TUnit
)
TUnit
))).
clear
j
K
.
iAlways
.
iIntros
(
τ
i
)
"%"
.
clear
j
K
.
iModIntro
.
iAlways
.
iIntros
(
τ
i
)
"%"
.
iIntros
(
j
K
)
"Hj /="
.
iApply
fupd_wp
.
tp_tlam
j
.
...
...
@@ -324,7 +326,7 @@ Section Stack_refinement.
iApply
wp_value
;
first
by
eauto
.
iExists
(
PairV
(
PairV
(
CG_locked_pushV
_
_
)
(
CG_locked_popV
_
_
))
(
RecV
_
)).
simpl
.
rewrite
CG_locked_push_of_val
CG_locked_pop_of_val
.
iFrame
"Hj"
.
iExists
(
_
,
_
),
(
_
,
_
);
iSplit
;
eauto
.
iExists
(
_
,
_
),
(
_
,
_
);
iModIntro
;
iSplit
;
eauto
.
iSplit
.
(
*
refinement
of
push
and
pop
*
)
-
iExists
(
_
,
_
),
(
_
,
_
);
iSplit
;
eauto
.
iSplit
.
...
...
@@ -332,7 +334,7 @@ Section Stack_refinement.
(
*
TODO
:
fold
(
interp
(...))
does
not
work
here
*
)
change
(
□
(
∀
vv
:
prodC
valC
valC
,
□
τ
i
vv
→
interp_expr
interp_unit
(
τ
i
::
Δ
)
→
interp_expr
⊤
⊤
interp_unit
(
τ
i
::
Δ
)
((
rec
:
(
rec
:
if
:
CAS
#
stk
(
Var
1
)
(
Fold
(
ref
InjR
(
Var
3
,
Var
1
)))
then
()
else
(
Var
2
)
(
Var
3
))
...
...
F_mu_ref_conc/fundamental_binary.v
View file @
dcf43df0
This diff is collapsed.
Click to expand it.
F_mu_ref_conc/logrel_binary.v
View file @
dcf43df0
...
...
@@ -32,13 +32,13 @@ Section logrel.
Implicit
Types
Δ
:
listC
D
.
Implicit
Types
interp
:
listC
D
→
D
.
Definition
interp_expr
(
τ
i
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
Definition
interp_expr
(
E1
E2
:
coPset
)
(
τ
i
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
(
ee
:
expr
*
expr
)
:
iProp
Σ
:=
(
∀
j
K
,
j
⤇
fill
K
(
ee
.2
)
-
∗
WP
ee
.1
{{
v
,
∃
v
'
,
j
⤇
fill
K
(
of_val
v
'
)
∗
τ
i
Δ
(
v
,
v
'
)
}}
)
%
I
.
Global
Instance
interp_expr_ne
n
:
Proper
(
dist
n
==>
dist
n
==>
(
=
)
==>
dist
n
)
interp_expr
.
Proof
.
solve_proper
.
Qed
.
|={
E1
,
E2
}=>
WP
ee
.1
@
E2
{{
v
,
|={
E2
}=>
∃
v
'
,
j
⤇
fill
K
(
of_val
v
'
)
∗
τ
i
Δ
(
v
,
v
'
)
}}
)
%
I
.
Global
Instance
interp_expr_ne
n
E1
E2
:
Proper
(
dist
n
==>
dist
n
==>
(
=
)
==>
dist
n
)
(
interp_expr
E1
E2
)
.
Proof
.
solve_proper
.
Qed
.
Program
Definition
ctx_lookup
(
x
:
var
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
□
from_option
id
(
cconst
True
)
%
I
(
Δ
!!
x
)
ww
)
%
I
.
...
...
@@ -71,7 +71,7 @@ Section logrel.
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
□
∀
vv
,
interp1
Δ
vv
→
interp_expr
interp_expr
⊤
⊤
interp2
Δ
(
App
(
of_val
(
ww
.1
))
(
of_val
(
vv
.1
)),
App
(
of_val
(
ww
.2
))
(
of_val
(
vv
.2
))))
%
I
.
Solve
Obligations
with
solve_proper
.
...
...
@@ -80,7 +80,7 @@ Section logrel.
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
□
∀
τ
i
,
⌜∀
ww
,
PersistentP
(
τ
i
ww
)
⌝
→
interp_expr
interp_expr
⊤
⊤
interp
(
τ
i
::
Δ
)
(
TApp
(
of_val
(
ww
.1
)),
TApp
(
of_val
(
ww
.2
))))
%
I
.
Solve
Obligations
with
solve_proper
.
...
...
@@ -245,5 +245,5 @@ End logrel.
Typeclasses
Opaque
interp_env
.
Notation
"⟦ τ ⟧"
:=
(
interp
τ
).
Notation
"⟦ τ ⟧ₑ"
:=
(
interp_expr
(
interp
τ
)).
Notation
"⟦ τ ⟧ₑ"
:=
(
interp_expr
⊤
⊤
(
interp
τ
)).
Notation
"⟦ Γ ⟧*"
:=
(
interp_env
Γ
).
F_mu_ref_conc/relational_properties.v
0 → 100644
View file @
dcf43df0
This diff is collapsed.
Click to expand it.
F_mu_ref_conc/soundness_binary.v
View file @
dcf43df0
...
...
@@ -25,15 +25,20 @@ Proof.
{
iNext
.
iExists
[
e
'
],
∅
.
rewrite
/
to_gen_heap
fin_maps
.
map_fmap_empty
.
auto
.
}
set
(
Heap
Σ
:=
(
HeapIG
Σ
Hinv
(
GenHeapG
_
_
Σ
_
_
_
γ
))).
iExists
(
λ
σ
,
own
γ
(
●
to_gen_heap
σ
));
iFrame
.
iApply
wp_fupd
.
iApply
wp_wand_r
.
iApply
wp_fupd
.
iApply
wp_wand_r
.
iSplitL
.
iPoseProof
(
Hlog
_
_
)
as
"Hrel"
.
iSpecialize
(
"Hrel"
$
!
[]
[]
with
"* [$Hcfg] []"
).
{
iAlways
.
iApply
logrel_binary
.
interp_env_nil
.
}
simpl
.
rewrite
empty_env_subst
empty_env_subst
.
iApply
(
"Hrel"
$
!
0
[]).
rewrite
empty_env_subst
empty_env_subst
.
iSpecialize
(
"Hrel"
$
!
0
[]).
iAssert
(
0
⤇
e
'
)
%
I
with
"[Hcfg2]"
as
"H0"
.
{
rewrite
tpool_mapsto_eq
/
tpool_mapsto_def
.
asimpl
.
iFrame
.
}
iIntros
(
v1
);
iDestruct
1
as
(
v2
)
"[Hj #Hinterp]"
.
iApply
fupd_wp
.
iApply
"Hrel"
;
auto
.
iIntros
(
v1
).
iMod
1
as
(
v2
)
"[Hj #Hinterp]"
.
iInv
specN
as
(
tp
σ
)
">[Hown Hsteps]"
"Hclose"
;
iDestruct
"Hsteps"
as
%
Hsteps
'
.
rewrite
tpool_mapsto_eq
/
tpool_mapsto_def
/=
.
iDestruct
(
own_valid_2
with
"Hown Hj"
)
as
%
Hvalid
.
...
...
F_mu_ref_conc/weakestpre.v
View file @
dcf43df0
...
...
@@ -14,8 +14,8 @@ Implicit Types v : val.
Implicit
Types
e
:
expr
.
(
*
Inverse
bind
lemma
*
)
Lemma
wp_bind_inv
K
e
Φ
:
WP
fill
K
e
{{
Φ
}}
⊢
WP
e
{{
v
,
WP
fill
K
(
of_val
v
)
{{
Φ
}}
}}
.
Lemma
wp_bind_inv
K
E
e
Φ
:
WP
fill
K
e
@
E
{{
Φ
}}
⊢
WP
e
@
E
{{
v
,
WP
fill
K
(
of_val
v
)
@
E
{{
Φ
}}
}}
.
Proof
.
iIntros
"H"
.
iL
ö
b
as
"IH"
forall
(
e
Φ
).
rewrite
wp_unfold
/
wp_pre
.
iDestruct
"H"
as
"[Hv|[% H]]"
.
...
...
@@ -33,7 +33,7 @@ Proof.
destruct
eval
.
-
iApply
wp_value
.
symmetry
.
eauto
.
replace
e
with
(
of_val
v
)
in
H
;
last
first
.
{
by
rewrite
(
of_to_val
e
).
}
{
by
rewrite
(
of_to_val
e
).
}
rewrite
wp_unfold
/
wp_pre
;
iRight
;
iSplit
;
eauto
.
iIntros
(
σ
1
)
"Hσ"
.
iMod
(
"H"
$
!
_
with
"Hσ"
)
as
"[% H]"
.
iModIntro
;
iSplit
.
...
...
Makefile
View file @
dcf43df0
# Makefile originally taken from coq-club
all
:
Makefile.coq
+make
-f
Makefile.coq all
#############################################################################
## v # The Coq Proof Assistant ##
## <O___,, # INRIA - CNRS - LIX - LRI - PPS ##
## \VV/ # ##
## // # Makefile automagically generated by coq_makefile V8.6 ##
#############################################################################