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
R
ReLoC-v1
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
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
Dan Frumin
ReLoC-v1
Commits
bc89b4bd
Commit
bc89b4bd
authored
Jun 06, 2018
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Ticket lock refinement (almost) from the HOCAP-like counter specs
parent
4a665ad0
Pipeline
#9446
failed with stage
in 6 minutes and 11 seconds
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
315 additions
and
3 deletions
+315
-3
_CoqProject
_CoqProject
+1
-0
theories/examples/counter.v
theories/examples/counter.v
+3
-0
theories/examples/hospec/modular_counter.v
theories/examples/hospec/modular_counter.v
+55
-1
theories/examples/hospec/ticket_lock_refinement.v
theories/examples/hospec/ticket_lock_refinement.v
+256
-0
theories/examples/ticket_lock.v
theories/examples/ticket_lock.v
+0
-2
No files found.
_CoqProject
View file @
bc89b4bd
...
...
@@ -45,6 +45,7 @@ theories/examples/generative.v
theories/examples/Y.v
theories/examples/FAI.v
theories/examples/hospec/modular_counter.v
theories/examples/hospec/ticket_lock_refinement.v
theories/tests/typetest.v
theories/tests/ghosttp.v
theories/tests/tactics.v
...
...
theories/examples/counter.v
View file @
bc89b4bd
...
...
@@ -22,6 +22,9 @@ Definition FG_increment : val := rec: "inc" "v" :=
then
"c"
else
"inc"
"v"
.
Definition
wkincr
:
val
:=
λ
:
"l"
,
"l"
<-
!
"l"
+
#
1.
Definition
FG_counter
:
val
:=
λ
:
<>
,
let:
"x"
:=
ref
#
0
in
((
λ
:
<>
,
FG_increment
"x"
),
counter_read
"x"
).
...
...
theories/examples/hospec/modular_counter.v
View file @
bc89b4bd
...
...
@@ -2,7 +2,7 @@ From iris.proofmode Require Import tactics.
From
iris
.
algebra
Require
Import
frac
agree
.
From
iris
.
base_logic
.
lib
Require
Import
invariants
viewshifts
.
From
iris_logrel
Require
Export
logrel
.
From
iris_logrel
.
examples
Require
Im
port
counter
.
From
iris_logrel
.
examples
Require
Ex
port
counter
.
Definition
cntCmra
:
cmraT
:=
(
prodR
fracR
(
agreeR
natC
)).
...
...
@@ -196,6 +196,60 @@ Section cnt_spec.
by
iApply
bin_log_related_nat
.
Qed
.
Theorem
read_l
(
γ
:
gname
)
(
E
:
coPset
)
(
ℓ
:
loc
)
Δ
Γ
K
t
τ
:
↑
(
N
.
@
"internal"
)
##
E
→
Cnt
ℓ
γ
-
∗
(
∀
(
n
:
nat
),
γ
⤇½
n
={
⊤∖
↑
(
N
.
@
"internal"
),
⊤∖↑
(
N
.
@
"internal"
)
∖
E
}=
∗
γ
⤇½
n
∗
{
⊤∖
E
;
Δ
;
Γ
}
⊨
fill
K
#
n
≤
log
≤
t
:
τ
)
-
∗
{
Δ
;
Γ
}
⊨
fill
K
(
!
#
ℓ
)
≤
log
≤
t
:
τ
.
Proof
.
iIntros
(
?
)
"#Hcnt Hupd"
.
rel_load_l_atomic
.
iMod
(
inv_open_strong
with
"Hcnt"
)
as
"[HH Hcl]"
;
first
done
.
iDestruct
"HH"
as
(
m
'
)
"[>Hl >Hown]"
.
iModIntro
.
iExists
_
;
iFrame
.
iNext
.
iIntros
"Hl"
.
iMod
(
"Hupd"
with
"Hown"
)
as
"[Hown Hlog]"
.
iMod
(
"Hcl"
with
"[Hl Hown]"
)
as
"_"
.
{
iNext
.
iExists
_.
iFrame
.
}
assert
(
⊤
∖
↑
N
.
@
"internal"
∖
E
=
((
⊤
∖
E
)
∖
↑
N
.
@
"internal"
:
coPset
))
as
->
by
set_solver
.
rewrite
-
union_difference_L
;
last
set_solver
.
by
iApply
"Hlog"
.
Qed
.
Theorem
wkincr_l
(
γ
:
gname
)
(
E
:
coPset
)
(
ℓ
:
loc
)
(
n
:
nat
)
(
q
:
Qp
)
Δ
Γ
K
t
τ
:
↑
(
N
.
@
"internal"
)
##
E
→
Cnt
ℓ
γ
-
∗
γ
⤇
[
q
]
n
-
∗
(
γ
⤇½
n
∗
γ
⤇
[
q
]
n
={
⊤∖
↑
(
N
.
@
"internal"
),
⊤∖↑
(
N
.
@
"internal"
)
∖
E
}=
∗
γ
⤇½
(
n
+
1
)
∗
γ
⤇
[
q
]
(
n
+
1
))
-
∗
(
γ
⤇
[
q
]
(
n
+
1
)
-
∗
{
⊤∖
E
;
Δ
;
Γ
}
⊨
fill
K
#()
≤
log
≤
t
:
τ
)
-
∗
{
Δ
;
Γ
}
⊨
fill
K
(
wkincr
#
ℓ
)
≤
log
≤
t
:
τ
.
Proof
.
iIntros
(
?
)
"#Hcnt Hγ Hupd H"
.
unlock
wkincr
.
rel_rec_l
.
rel_load_l_atomic
.
iInv
(
N
.
@
"internal"
)
as
(
n
'
)
"[>Hl >Hown]"
"Hcl"
.
iDestruct
(
makeElem_eq
with
"Hγ Hown"
)
as
%<-
.
iModIntro
.
iExists
_
;
iFrame
.
iNext
.
iIntros
"Hl"
.
iMod
(
"Hcl"
with
"[Hl Hown]"
)
as
"_"
.
{
iNext
.
iExists
_.
iFrame
.
}
rel_op_l
.
rel_store_l_atomic
.
iMod
(
inv_open_strong
with
"Hcnt"
)
as
"[HH Hcl]"
;
first
solve_ndisj
.
iDestruct
"HH"
as
(
m
)
"[>Hl >Hown]"
.
iDestruct
(
makeElem_eq
with
"Hγ Hown"
)
as
%<-
.
iModIntro
.
iExists
_
;
iFrame
.
iNext
.
iIntros
"Hl"
.
iMod
(
"Hupd"
with
"[$Hown $Hγ]"
)
as
"[Hown Hγ]"
.
assert
(
⊤
∖
↑
N
.
@
"internal"
∖
E
=
((
⊤
∖
E
)
∖
↑
N
.
@
"internal"
:
coPset
))
as
->
by
set_solver
.
iMod
(
"Hcl"
with
"[Hl Hown]"
)
as
"_"
.
{
iNext
.
iExists
_.
iFrame
.
}
rewrite
-
union_difference_L
;
last
set_solver
.
by
iApply
"H"
.
Qed
.
(
**
Proving
the
refinement
with
the
WP
rule
doesn
'
t
really
work
out
that
well
:
*
)
Theorem
incr_spec
(
γ
:
gname
)
(
P
:
iProp
Σ
)
(
Q
:
nat
→
iProp
Σ
)
(
ℓ
:
loc
)
:
□
(
∀
(
n
:
nat
),
γ
⤇½
n
∗
P
={
⊤
∖
↑
(
N
.
@
"internal"
)
}=
∗
γ
⤇½
(
n
+
1
)
∗
Q
n
)
⊢
...
...
theories/examples/hospec/ticket_lock_refinement.v
0 → 100644
View file @
bc89b4bd
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
algebra
Require
Export
auth
gset
excl
.
From
iris
.
base_logic
Require
Import
auth
.
From
iris_logrel
Require
Export
logrel
.
From
iris_logrel
.
examples
Require
Import
lock
ticket_lock
hospec
.
modular_counter
.
(
**
Here
we
prove
the
ticket
lock
refinement
using
the
modular
specifications
for
the
counter
*
)
Section
refinement
.
Context
`
{
logrelG
Σ
,
tlockG
Σ
,
cntG
Σ
}
.
(
**
*
Invariants
and
abstracts
for
them
*
)
Definition
lockInv
(
γ
lo
γ
ln
:
gname
)
(
γ
:
gname
)
(
l
'
:
loc
)
:
iProp
Σ
:=
(
∃
(
o
n
:
nat
)
(
b
:
bool
),
γ
lo
⤇½
o
∗
γ
ln
⤇½
n
∗
issuedTickets
γ
n
∗
l
'
↦ₛ
#
b
∗
if
b
then
ticket
γ
o
else
True
)
%
I
.
Instance
ifticket_timeless
(
b
:
bool
)
γ
o
:
Timeless
(
if
b
then
ticket
γ
o
else
True
%
I
).
Proof
.
destruct
b
;
apply
_.
Qed
.
Instance
lockInv_timeless
lo
ln
γ
l
'
:
Timeless
(
lockInv
lo
ln
γ
l
'
).
Proof
.
apply
_.
Qed
.
Definition
N
:=
nroot
.
@
"locked"
.
Program
Definition
lockInt
:=
λ
ne
vv
,
(
∃
(
γ
ln
γ
lo
:
gname
)
(
lo
ln
:
loc
)
(
γ
:
gname
)
(
l
'
:
loc
),
⌜
vv
.1
=
(#
lo
,
#
ln
)
%
V
⌝
∗
⌜
vv
.2
=
#
l
'⌝
∗
Cnt
(
N
.
@
"cnt1"
)
ln
γ
ln
∗
Cnt
(
N
.
@
"cnt2"
)
lo
γ
lo
∗
inv
(
N
.
@
"lock"
)
(
lockInv
γ
lo
γ
ln
γ
l
'
))
%
I
.
Next
Obligation
.
solve_proper
.
Qed
.
Instance
lockInt_persistent
ww
:
Persistent
(
lockInt
ww
).
Proof
.
apply
_.
Qed
.
Lemma
wait_loop_refinement
Δ
Γ
(
lo
ln
:
loc
)
(
γ
lo
γ
ln
γ
:
gname
)
(
l
'
:
loc
)
(
m
:
nat
)
:
inv
(
N
.
@
"lock"
)
(
lockInv
γ
lo
γ
ln
γ
l
'
)
-
∗
Cnt
(
N
.
@
"cnt1"
)
ln
γ
ln
-
∗
Cnt
(
N
.
@
"cnt2"
)
lo
γ
lo
-
∗
ticket
γ
m
-
∗
{
(
lockInt
::
Δ
);
⤉Γ
}
⊨
wait_loop
#
m
(#
lo
,
#
ln
)
≤
log
≤
lock
.
acquire
#
l
'
:
TUnit
.
Proof
.
iIntros
"#Hinv #Hcntn #Hcnto Hticket"
.
rel_rec_l
.
iL
ö
b
as
"IH"
.
unlock
{
2
}
wait_loop
.
simpl
.
rel_let_l
.
rel_proj_l
.
rel_apply_l
(
read_l
_
_
_
_
(
↑
N
.
@
"lock"
)
with
"Hcnto"
);
first
solve_ndisj
.
Unshelve
.
2
,
3
:
solve_ndisj
.
iIntros
(
o
)
"Hlo"
.
iMod
(
inv_open_strong
with
"Hinv"
)
as
"[HH Hcl]"
;
first
solve_ndisj
.
iDestruct
"HH"
as
(
o
'
n
b
)
"(>Hlo' & >Hln & >Hissued & >[Hl' Hbticket])"
.
iDestruct
(
makeElem_eq
with
"Hlo Hlo'"
)
as
%<-
.
iModIntro
.
iFrame
.
rel_op_l
.
case_decide
;
subst
;
rel_if_l
.
(
*
Whether
the
ticket
is
called
out
*
)
-
destruct
b
.
{
iDestruct
(
ticket_nondup
with
"Hticket Hbticket"
)
as
%
[].
}
rel_apply_r
(
bin_log_related_acquire_r
with
"Hl'"
).
{
solve_ndisj
.
}
iIntros
"Hl'"
.
iMod
(
"Hcl"
with
"[-]"
)
as
"_"
.
{
iNext
;
iExists
_
,
_
,
_
;
iFrame
.
}
rewrite
-
union_difference_L
;
last
done
.
iApply
bin_log_related_unit
.
-
iMod
(
"Hcl"
with
"[-Hticket]"
)
as
"_"
.
{
iNext
.
iExists
_
,
_
,
_
;
by
iFrame
.
}
rel_rec_l
.
unlock
wait_loop
.
simpl_subst
/=
.
rewrite
-
union_difference_L
;
last
done
.
by
iApply
"IH"
.
Qed
.
Lemma
acquire_refinement_direct
Δ
Γ
:
{
(
lockInt
::
Δ
);
⤉Γ
}
⊨
acquire
≤
log
≤
lock
.
acquire
:
(
TVar
0
→
Unit
).
Proof
.
unlock
acquire
;
simpl
.
iApply
bin_log_related_arrow_val
;
eauto
.
{
by
unlock
lock
.
acquire
.
}
iAlways
.
iIntros
(
?
?
)
"/= #Hl"
.
iDestruct
"Hl"
as
(
γ
ln
γ
lo
lo
ln
γ
l
'
)
"(% & % & Hcntn & Hcnto & Hin)"
.
simplify_eq
/=
.
rel_let_l
.
repeat
rel_proj_l
.
rel_apply_l
(
FG_increment_l
_
_
_
_
∅
with
"Hcntn"
);
eauto
;
try
by
(
solve_ndisj
||
set_solver
).
Unshelve
.
2
,
3
:
solve_ndisj
.
(
*
TODO
:
this
is
annoying
*
)
(
*
the
viewshift
*
)
iIntros
(
n
)
"Hln"
.
iInv
(
N
.
@
"lock"
)
as
(
o
n
'
b
)
"(Hlo & >Hln' & >Hissued & >Hb)"
"Hcl"
.
iDestruct
(
makeElem_eq
with
"Hln Hln'"
)
as
%<-
.
iMod
(
issueNewTicket
with
"Hissued"
)
as
"[Hissued Hticket]"
.
iMod
(
makeElem_update
_
_
_
(
n
+
1
)
with
"Hln Hln'"
)
as
"[Hln Hln']"
.
iMod
(
"Hcl"
with
"[Hissued Hlo Hln Hb]"
)
as
"_"
.
{
iNext
.
iExists
_
,
_
,
_
;
iFrame
.
assert
(
n
+
1
=
S
n
)
as
->
;
try
omega
;
done
.
}
iFrame
.
rewrite
!
difference_empty_L
.
iModIntro
.
rel_let_l
.
by
iApply
wait_loop_refinement
.
Qed
.
(
*
TODO
:
cannot
use
the
hocap
rule
Here
we
run
into
a
similar
problem
that
we
had
when
proving
the
release
refinement
against
the
abstract
specification
:
what
if
we
don
'
t
have
access
to
`locked
`
?
I
.
e
.
what
if
we
call
release
without
acquiring
a
lock
first
?
We
cannot
reasonably
provide
the
γ
lo
⤇
[
q
]
-
resource
.
*
)
Lemma
logrel_mask_mono
E1
E2
Δ
Γ
e
e
'
τ
:
E1
⊆
E2
→
{
E1
;
Δ
;
Γ
}
⊨
e
≤
log
≤
e
'
:
τ
-
∗
{
E2
;
Δ
;
Γ
}
⊨
e
≤
log
≤
e
'
:
τ
.
Proof
.
iIntros
(
?
)
"Hlog"
.
rewrite
bin_log_related_eq
/
bin_log_related_def
.
iIntros
(
vvs
ρ
)
"Hspec HΓ"
.
rewrite
/
interp_expr
.
iIntros
(
j
K
)
"Hj"
.
iSpecialize
(
"Hlog"
with
"Hspec HΓ Hj"
).
assert
(
E2
=
E1
∪
(
E2
∖
E1
))
as
->
.
rewrite
-
union_difference_L
;
eauto
.
assert
(
⊤
=
⊤
∪
(
E2
∖
E1
))
as
Ht
.
set_solver
.
rewrite
{
4
}
Ht
.
iApply
fupd_mask_frame_r
.
set_solver
.
iApply
"Hlog"
.
Qed
.
(
*
we
prove
an
atomic
relational
triple
,
by
breaking
the
abstraction
this
is
actually
different
from
the
lax
atomic
triple
you
would
normally
see
a
standard
version
would
say
that
the
environment
does
not
interfere
with
the
value
of
lo
,
until
a
certain
moment
,
e
.
g
:
the
value
of
the
counter
is
constant
until
the
linearization
point
this
specification
,
otoh
,
says
that
the
environment
is
resiliant
to
"incorrect"
/
non
-
atomic
changes
of
the
counter
.
*
)
Lemma
wkincr_l_atomic
R1
R2
Δ
Γ
E
K
x
γ
lo
t
τ
:
Cnt
(
N
.
@
"cnt2"
)
x
γ
lo
-
∗
R2
-
∗
□
(
|={
⊤
∖
↑
N
.
@
"cnt2"
.
@
"internal"
,
E
∖
↑
N
.
@
"cnt2"
.
@
"internal"
}=>
∃
o
:
nat
,
γ
lo
⤇½
o
∗
R1
o
∗
(
γ
lo
⤇½
o
∗
R1
o
={
E
∖↑
N
.
@
"cnt2"
.
@
"internal"
,
⊤∖↑
N
.
@
"cnt2"
.
@
"internal"
}=
∗
True
)
∧
((
∃
o
:
nat
,
γ
lo
⤇½
(
o
+
1
))
∗
R1
o
-
∗
R2
-
∗
{
E
;
Δ
;
Γ
}
⊨
fill
K
Unit
≤
log
≤
t
:
τ
))
-
∗
(
{
Δ
;
Γ
}
⊨
fill
K
(
wkincr
#
x
)
≤
log
≤
t
:
τ
).
Proof
.
iIntros
"#Hcnt HR2 #H"
.
unlock
wkincr
.
rel_rec_l
.
rel_apply_l
(
read_l
_
_
_
_
∅
with
"Hcnt"
);
first
set_solver
.
Unshelve
.
2
,
3
:
solve_ndisj
.
iIntros
(
o
)
"Hγlo"
.
rewrite
!
difference_empty_L
.
iPoseProof
"H"
as
"H2"
.
iMod
"H"
as
(
n
)
"[Hx [HR1 [Hrev _]]]"
.
iDestruct
(
makeElem_eq
with
"Hx Hγlo"
)
as
%->
.
iFrame
"Hx"
.
iMod
(
"Hrev"
with
"[$HR1 $Hγlo]"
)
as
"_"
;
simpl
.
iModIntro
.
rel_op_l
.
rel_store_l_atomic
.
iMod
(
inv_open_strong
with
"Hcnt"
)
as
"[HH Hcl]"
;
first
solve_ndisj
.
iDestruct
"HH"
as
(
o
'
)
"[>Hl >Hown]"
.
iModIntro
.
iExists
_
;
iFrame
.
iNext
.
iIntros
"Hx"
.
iMod
"H2"
as
(
o
''
)
"[Hγlo [HR1 [_ Hcomm]]]"
.
iDestruct
(
makeElem_eq
with
"Hγlo Hown"
)
as
%->
.
iMod
(
makeElem_update
_
_
_
(
o
+
1
)
with
"Hγlo Hown"
)
as
"[Hγlo Hown]"
.
simpl
.
iMod
(
"Hcl"
with
"[Hx Hγlo]"
)
as
"_"
.
{
iNext
.
iExists
_.
iFrame
.
}
rewrite
(
union_comm_L
_
(
E
∖
_
))
difference_union_L
.
iApply
(
logrel_mask_mono
E
);
first
set_solver
.
iApply
(
"Hcomm"
with
"[$HR1 Hown] HR2"
).
iExists
_
;
by
iFrame
.
Qed
.
Lemma
release_refinement
Δ
Γ
:
{
(
lockInt
::
Δ
);
⤉Γ
}
⊨
release
≤
log
≤
lock
.
release
:
(
TVar
0
→
Unit
).
Proof
.
unlock
release
.
iApply
bin_log_related_arrow_val
;
eauto
.
{
by
unlock
lock
.
release
.
}
iAlways
.
iIntros
(
?
?
)
"/= #Hl"
.
iDestruct
"Hl"
as
(
γ
ln
γ
lo
lo
ln
γ
l
'
)
"(% & % & Hcntn & Hcnto & Hinv)"
.
simplify_eq
/=
.
rel_let_l
.
rel_proj_l
.
(
*
rel_apply_l
*
)
(
*
(
wkincr_l
_
_
_
_
∅
*
)
(
*
with
"Hcnto []"
);
eauto
;
try
by
(
solve_ndisj
||
set_solver
).
*
)
pose
(
R
:=
fun
(
o
:
nat
)
=>
(
∃
(
n
:
nat
)
(
b
:
bool
),
γ
ln
⤇½
n
∗
issuedTickets
γ
n
∗
l
'
↦ₛ
#
b
∗
if
b
then
ticket
γ
o
else
True
)
%
I
).
rel_apply_l
(
wkincr_l_atomic
R
True
%
I
_
_
(
⊤∖↑
N
.
@
"lock"
)
with
"Hcnto"
);
first
done
.
iAlways
.
iMod
(
inv_open_strong
with
"Hinv"
)
as
"[HH Hcl]"
;
first
solve_ndisj
.
iDestruct
"HH"
as
(
o
n
b
)
"(>Hlo & >Hln & >Hissued & >Hb)"
.
(
*
iInv
(
N
.
@
"lock"
)
as
(
o
n
b
)
"(>Hlo & >Hln & >Hissued & >Hb)"
"Hcl"
.
*
)
assert
((
⊤∖↑
N
.
@
"cnt2"
.
@
"internal"
∖↑
N
.
@
"lock"
)
=
(
⊤∖↑
N
.
@
"lock"
∖↑
N
.
@
"cnt2"
.
@
"internal"
))
as
->
.
{
set_solver
.
}
iModIntro
.
iExists
o
;
iFrame
.
rewrite
{
1
}/
R
.
iSplitR
"Hcl"
.
{
iExists
_
,
_
;
by
iFrame
.
}
iSplit
.
-
iIntros
"[Hlo HR]"
.
unfold
R
.
iDestruct
"HR"
as
(
n
'
b
'
)
"HR"
.
iMod
(
"Hcl"
with
"[-]"
)
as
"_"
.
{
iNext
.
iExists
_
,
_
,
_
;
by
iFrame
.
}
assert
(
⊤
∖
↑
N
.
@
"lock"
∖
↑
N
.
@
"cnt2"
.
@
"internal"
=
⊤
∖
↑
N
.
@
"cnt2"
.
@
"internal"
∖
↑
N
.
@
"lock"
)
as
->
by
set_solver
.
rewrite
-
union_difference_L
;
last
solve_ndisj
.
done
.
-
iIntros
"[Hlo HR] _"
.
iDestruct
"Hlo"
as
(
o
'
)
"Hlo"
.
unfold
R
.
iDestruct
"HR"
as
(
n
'
b
'
)
"(Hln & Hissued & Hl' & Hticket)"
.
rel_apply_r
(
bin_log_related_release_r
with
"Hl'"
).
{
(
*
wtf
is
this
monstrosity
?
*
)
assert
(
nclose
specN
⊆
⊤
∖
↑
N
.
@
"lock"
)
as
HZ
by
solve_ndisj
.
etransitivity
.
apply
HZ
.
set_solver
.
}
iIntros
"Hl'"
.
iMod
(
"Hcl"
with
"[-]"
)
as
"_"
.
{
iNext
.
iExists
_
,
_
,
_.
by
iFrame
.
}
assert
(
⊤
=
↑
N
.
@
"lock"
∪
⊤
∖
↑
N
.
@
"lock"
)
as
<-
.
{
rewrite
(
union_comm_L
_
(
⊤∖
_
))
difference_union_L
.
set_solver
.
}
iApply
bin_log_related_unit
.
Qed
.
Lemma
newlock_refinement
Δ
Γ
:
{
(
lockInt
::
Δ
);
⤉Γ
}
⊨
newlock
≤
log
≤
lock
.
newlock
:
(
Unit
→
TVar
0
).
Proof
.
unlock
newlock
.
iApply
bin_log_related_arrow_val
;
eauto
.
{
by
unlock
lock
.
newlock
.
}
iAlways
.
iIntros
(
?
?
)
"/= [% %]"
;
simplify_eq
.
(
*
Reducing
to
a
value
on
the
LHS
*
)
rel_let_l
.
rel_alloc_l
as
lo
"Hlo"
.
rel_alloc_l
as
ln
"Hln"
.
iMod
(
Cnt_alloc
with
"Hlo"
)
as
(
γ
lo
)
"[#Hcnto Hγlo]"
.
iMod
(
Cnt_alloc
with
"Hln"
)
as
(
γ
ln
)
"[#Hcntn Hγln]"
.
(
*
Reducing
to
a
value
on
the
RHS
*
)
rel_apply_r
bin_log_related_newlock_r
.
{
solve_ndisj
.
}
iIntros
(
l
'
)
"Hl'"
.
(
*
Establishing
the
invariant
*
)
iMod
newIssuedTickets
as
(
γ
)
"Hγ"
.
iMod
(
inv_alloc
(
N
.
@
"lock"
)
_
(
lockInv
γ
lo
γ
ln
γ
l
'
)
with
"[-]"
)
as
"#Hinv"
.
{
iNext
.
iExists
_
,
_
,
_.
iFrame
.
}
rel_vals
.
iModIntro
.
iAlways
.
iExists
_
,
_
,
_
,
_
,
_
,
_.
iFrame
"Hinv Hcnto Hcntn"
.
eauto
.
Qed
.
Lemma
ticket_lock_refinement
Γ
:
Γ
⊨
Pack
(
newlock
,
acquire
,
release
)
≤
log
≤
Pack
(
lock
.
newlock
,
lock
.
acquire
,
lock
.
release
)
:
lockT
.
Proof
.
iIntros
(
Δ
).
iApply
(
bin_log_related_pack
lockInt
).
repeat
iApply
bin_log_related_pair
.
-
by
iApply
newlock_refinement
.
-
by
iApply
acquire_refinement_direct
.
-
by
iApply
release_refinement
.
Qed
.
End
refinement
.
theories/examples/ticket_lock.v
View file @
bc89b4bd
...
...
@@ -16,8 +16,6 @@ Definition acquire : val := λ: "lk",
let:
"n"
:=
FG_increment
(
Snd
"lk"
)
in
wait_loop
"n"
"lk"
.
Definition
wkincr
:
val
:=
λ
:
"l"
,
"l"
<-
!
"l"
+
#
1.
Definition
release
:
val
:=
λ
:
"lk"
,
wkincr
(
Fst
"lk"
).
Definition
LockType
:
type
:=
ref
TNat
×
ref
TNat
.
...
...
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