Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Joshua Yanovski
iris-coq
Commits
c35b8a65
Commit
c35b8a65
authored
Aug 02, 2016
by
Zhen Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ticket lock
parent
fcc1c439
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
277 additions
and
1 deletion
+277
-1
_CoqProject
_CoqProject
+1
-0
algebra/gset.v
algebra/gset.v
+4
-1
program_logic/auth.v
program_logic/auth.v
+4
-0
tests/ticket_lock.v
tests/ticket_lock.v
+268
-0
No files found.
_CoqProject
View file @
c35b8a65
...
...
@@ -110,6 +110,7 @@ tests/proofmode.v
tests/barrier_client.v
tests/list_reverse.v
tests/tree_sum.v
tests/ticket_lock.v
proofmode/coq_tactics.v
proofmode/pviewshifts.v
proofmode/environments.v
...
...
algebra/gset.v
View file @
c35b8a65
...
...
@@ -54,8 +54,9 @@ Section gset.
Canonical
Structure
gset_disjUR
:=
discreteUR
(
gset_disj
K
)
gset_disj_ra_mixin
gset_disj_ucmra_mixin
.
Context
`
{
Fresh
K
(
gset
K
),
!
FreshSpec
K
(
gset
K
)
}
.
Arguments
op
_
_
_
_
:
simpl
never
.
Section
fpu
.
Context
`
{
Fresh
K
(
gset
K
),
!
FreshSpec
K
(
gset
K
)
}
.
Lemma
gset_alloc_updateP_strong
P
(
Q
:
gset_disj
K
→
Prop
)
X
:
(
∀
Y
,
X
⊆
Y
→
∃
j
,
j
∉
Y
∧
P
j
)
→
...
...
@@ -98,6 +99,8 @@ Section gset.
Lemma
gset_alloc_empty_updateP
'
:
GSet
∅
~~>:
λ
Y
,
∃
i
,
Y
=
GSet
{
[
i
]
}
.
Proof
.
eauto
using
gset_alloc_empty_updateP
.
Qed
.
End
fpu
.
Lemma
gset_alloc_local_update
X
i
Xf
:
i
∉
X
→
i
∉
Xf
→
GSet
X
~
l
~>
GSet
(
{
[
i
]
}
∪
X
)
@
Some
(
GSet
Xf
).
Proof
.
...
...
program_logic/auth.v
View file @
c35b8a65
...
...
@@ -56,6 +56,10 @@ Section auth.
Lemma
auth_own_op
γ
a
b
:
auth_own
γ
(
a
⋅
b
)
⊣⊢
auth_own
γ
a
★
auth_own
γ
b
.
Proof
.
by
rewrite
/
auth_own
-
own_op
auth_frag_op
.
Qed
.
Global
Instance
from_sep_own_authM
γ
a
b
:
FromSep
(
auth_own
γ
(
a
⋅
b
))
(
auth_own
γ
a
)
(
auth_own
γ
b
)
|
90.
Proof
.
by
rewrite
/
FromSep
auth_own_op
.
Qed
.
Lemma
auth_own_mono
γ
a
b
:
a
≼
b
→
auth_own
γ
b
⊢
auth_own
γ
a
.
Proof
.
intros
[
?
->
].
by
rewrite
auth_own_op
sep_elim_l
.
Qed
.
...
...
tests/ticket_lock.v
0 → 100644
View file @
c35b8a65
From
iris
.
program_logic
Require
Export
global_functor
auth
.
From
iris
.
proofmode
Require
Import
invariants
ghost_ownership
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
algebra
Require
Import
gset
.
From
iris
.
prelude
Require
Import
set
.
Import
uPred
.
Definition
wait_loop
:
val
:=
rec:
"wait_loop"
"x"
"l"
:=
let:
"o"
:=
Fst
!
"l"
in
if:
"x"
=
"o"
then
#()
(
*
my
turn
*
)
else
"wait_loop"
"x"
"l"
.
Definition
newlock
:
val
:=
λ
:
<>
,
ref
((
*
owner
*
)
#
0
,
(
*
next
*
)
#
0
).
Definition
acquire
:
val
:=
rec:
"acquire"
"l"
:=
let:
"oldl"
:=
!
"l"
in
if:
CAS
"l"
"oldl"
(
Fst
"oldl"
,
Snd
"oldl"
+
#
1
)
then
wait_loop
(
Snd
"oldl"
)
"l"
else
"acquire"
"l"
.
Definition
release
:
val
:=
rec:
"release"
"l"
:=
let:
"oldl"
:=
!
"l"
in
if:
CAS
"l"
"oldl"
(
Fst
"oldl"
+
#
1
,
Snd
"oldl"
)
then
#()
else
"release"
"l"
.
Global
Opaque
newlock
acquire
release
wait_loop
.
(
**
The
CMRA
we
need
.
*
)
Class
tlockG
Σ
:=
TlockG
{
tlock_G
:>
authG
heap_lang
Σ
(
gset_disjUR
nat
);
tlock_exclG
:>
inG
heap_lang
Σ
(
exclR
unitC
)
}
.
Definition
tlockGF
:
gFunctorList
:=
[
authGF
(
gset_disjUR
nat
)
;
GFunctor
(
constRF
(
exclR
unitC
))].
Instance
inGF_tlockG
`
{
H
:
inGFs
heap_lang
Σ
tlockGF
}
:
tlockG
Σ
.
Proof
.
destruct
H
as
(
?
&
?
&
?
).
split
.
apply
_.
apply
:
inGF_inG
.
Qed
.
Section
proof
.
Context
`
{!
heapG
Σ
,
!
tlockG
Σ
}
(
N
:
namespace
).
Local
Notation
iProp
:=
(
iPropG
heap_lang
Σ
).
Section
natstuff
.
Open
Scope
nat_scope
.
Fixpoint
natset
(
s
len
:
nat
)
:
gset
nat
:=
match
len
with
|
O
=>
∅
|
S
len
'
=>
natset
s
len
'
∪
{
[
s
+
len
'
]
}
end
.
Lemma
natset_range
:
∀
(
len
s
x
:
nat
),
x
∈
natset
s
len
->
x
<
(
s
+
len
).
Proof
.
intros
len
.
elim
len
.
+
intros
.
simpl
in
H
.
set_solver
.
+
intros
.
simpl
in
H0
.
apply
elem_of_union
in
H0
.
destruct
H0
.
-
apply
H
in
H0
.
omega
.
-
assert
(
x
=
s
+
n
).
set_solver
.
omega
.
Qed
.
Lemma
natset_not_in
:
∀
x
,
x
∉
natset
0
x
.
Proof
.
intros
x
H
.
apply
natset_range
in
H
.
omega
.
Qed
.
Lemma
natset_incr
:
∀
x
,
{
[
x
]
}
∪
natset
0
x
=
natset
0
(
x
+
1
).
Proof
.
intros
.
rewrite
Nat
.
add_1_r
.
simpl
.
set_solver
.
Qed
.
Lemma
natset_disj
:
∀
x
,
{
[
x
]
}
⊥
natset
0
x
.
Proof
.
intros
.
assert
(
x
∉
natset
0
x
).
apply
natset_not_in
.
set_solver
.
Qed
.
End
natstuff
.
Definition
tickets_inv
(
n
:
nat
)
(
gs
:
gset_disjUR
nat
)
:
iProp
:=
(
∃
gs
'
,
GSet
gs
'
=
gs
∧
gs
'
=
natset
0
n
)
%
I
.
Definition
lock_inv
(
γ
1
γ
2
:
gname
)
(
l
:
loc
)
(
R
:
iProp
)
:
iProp
:=
(
∃
(
o
n
:
nat
),
l
↦
(#
o
,
#
n
)
★
auth_inv
γ
1
(
tickets_inv
n
)
★
((
own
γ
2
(
Excl
())
★
R
)
∨
auth_own
γ
1
(
GSet
{
[
o
]
}
)))
%
I
.
Definition
is_lock
(
l
:
loc
)
(
R
:
iProp
)
:
iProp
:=
(
∃
γ
1
γ
2
,
heapN
⊥
N
∧
heap_ctx
∧
inv
N
(
lock_inv
γ
1
γ
2
l
R
))
%
I
.
Definition
issued
(
l
:
loc
)
(
x
:
nat
)
(
R
:
iProp
)
:
iProp
:=
(
∃
γ
1
γ
2
,
heapN
⊥
N
∧
heap_ctx
∧
inv
N
(
lock_inv
γ
1
γ
2
l
R
)
∧
auth_own
γ
1
(
GSet
{
[
x
]
}
))
%
I
.
Definition
locked
(
l
:
loc
)
(
R
:
iProp
)
:
iProp
:=
(
∃
γ
1
γ
2
,
heapN
⊥
N
∧
heap_ctx
∧
inv
N
(
lock_inv
γ
1
γ
2
l
R
)
∧
own
γ
2
(
Excl
()))
%
I
.
Global
Instance
lock_inv_ne
n
γ
1
γ
2
l
:
Proper
(
dist
n
==>
dist
n
)
(
lock_inv
γ
1
γ
2
l
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_ne
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
l
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
locked_ne
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
locked
l
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_persistent
l
R
:
PersistentP
(
is_lock
l
R
).
Proof
.
apply
_.
Qed
.
Lemma
newlock_spec
(
R
:
iProp
)
Φ
:
heapN
⊥
N
→
heap_ctx
★
R
★
(
∀
l
,
is_lock
l
R
-
★
Φ
#
l
)
⊢
WP
newlock
#()
{{
Φ
}}
.
Proof
.
iIntros
(
?
)
"(#Hh & HR & HΦ)"
.
rewrite
/
newlock
.
wp_seq
.
wp_alloc
l
as
"Hl"
.
iPvs
(
own_alloc
(
Excl
()))
as
(
γ
2
)
"Hγ2"
;
first
done
.
iPvs
(
own_alloc_strong
(
Auth
(
Excl
'
∅
)
∅
)
_
{
[
γ
2
]
}
)
as
(
γ
1
)
"[% Hγ1]"
;
first
done
.
iPvs
(
inv_alloc
N
_
(
lock_inv
γ
1
γ
2
l
R
)
with
"[-HΦ]"
);
first
done
.
{
iNext
.
rewrite
/
lock_inv
.
iExists
0
%
nat
,
0
%
nat
.
iFrame
.
iSplitL
"Hγ1"
.
{
rewrite
/
auth_inv
.
iExists
(
GSet
∅
).
iFrame
.
rewrite
/
tickets_inv
.
iExists
∅
;
by
iSplit
.
}
iLeft
.
by
iFrame
.
}
iPvsIntro
.
iApply
"HΦ"
.
iExists
γ
1
,
γ
2.
iSplit
;
by
auto
.
Qed
.
Lemma
wait_loop_spec
l
x
R
(
Φ
:
val
→
iProp
)
:
issued
l
x
R
★
(
∀
l
,
locked
l
R
-
★
R
-
★
Φ
#())
⊢
WP
wait_loop
#
x
#
l
{{
Φ
}}
.
Proof
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
γ
1
γ
2
)
"(% & #? & #? & Ht)"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_let
.
wp_focus
(
!
_
)
%
E
.
iInv
N
as
(
o
n
)
"[Hl Ha]"
.
wp_load
.
iPvsIntro
.
destruct
(
decide
(
x
=
o
))
as
[
Heq
|
Hneq
].
-
subst
.
iDestruct
"Ha"
as
"[Hainv [[Ho HR] | Haown]]"
.
+
iSplitL
"Hl Hainv Ht"
.
*
iNext
.
iExists
o
,
n
.
iFrame
.
by
iRight
.
*
wp_proj
.
wp_let
.
wp_op
=>
Ho
;
last
by
contradiction
Ho
.
clear
Ho
.
wp_if
.
iPvsIntro
.
iApply
(
"HΦ"
with
"[-HR] HR"
).
iExists
γ
1
,
γ
2
;
eauto
.
+
iExFalso
.
iCombine
"Ht"
"Haown"
as
"Haown"
.
iDestruct
(
auth_own_valid
with
"Haown"
)
as
"%"
.
apply
gset_disj_valid_op
in
H0
.
set_solver
.
-
iSplitL
"Hl Ha"
.
+
iNext
.
iExists
o
,
n
.
by
iFrame
.
+
wp_proj
.
wp_let
.
wp_op
=>?
.
*
subst
.
contradiction
Hneq
.
omega
.
*
wp_if
.
by
iApply
(
"IH"
with
"Ht"
).
Qed
.
Lemma
acquire_spec
l
R
(
Φ
:
val
→
iProp
)
:
is_lock
l
R
★
(
∀
l
,
locked
l
R
-
★
R
-
★
Φ
#())
⊢
WP
acquire
#
l
{{
Φ
}}
.
Proof
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
γ
1
γ
2
)
"(% & #? & #?)"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_focus
(
!
_
)
%
E
.
iInv
N
as
(
o
n
)
"[Hl Ha]"
.
wp_load
.
iPvsIntro
.
iSplitL
"Hl Ha"
.
-
iNext
.
iExists
o
,
n
.
by
iFrame
.
-
wp_let
.
wp_focus
(
CAS
_
_
_
).
wp_proj
.
wp_proj
.
wp_op
.
iInv
N
as
(
o
'
n
'
)
"[Hl [Hainv Haown]]"
.
destruct
(
decide
((#
o
'
,
#
n
'
)
%
V
=
(#
o
,
#
n
)
%
V
))
as
[
Heq
|
Hneq
].
+
wp_cas_suc
.
inversion
Heq
;
subst
.
iDestruct
"Hainv"
as
(
s
)
"[Ho Ht]"
.
iDestruct
(
own_valid
with
"#Ho"
)
as
"Hvalid"
.
iDestruct
(
auth_validI
_
with
"Hvalid"
)
as
"[_ %]"
;
simpl
;
iClear
"Hvalid"
.
destruct
s
as
[
s
|
];
last
by
contradiction
.
iDestruct
"Ht"
as
(
gs
)
"[% %]"
.
inversion
H3
.
subst
.
subst
.
clear
H3
.
iPvs
(
own_update
with
"Ho"
)
as
"Ho"
.
{
eapply
auth_update_no_frag
,
gset_alloc_empty_local_update
.
eapply
natset_not_in
.
}
iDestruct
"Ho"
as
"[Hofull Hofrag]"
.
iSplitL
"Hl Haown Hofull"
.
*
replace
(
GSet
{
[
n
'
]
}
⋅
GSet
(
natset
0
n
'
))
with
(
GSet
(
natset
0
(
n
'
+
1
))).
{
iPvsIntro
.
iNext
.
iExists
o
'
,
(
n
'
+
1
)
%
nat
.
rewrite
Nat2Z
.
inj_add
.
iFrame
.
iExists
(
GSet
(
natset
0
(
n
'
+
1
))).
iFrame
.
iExists
(
natset
0
(
n
'
+
1
)).
by
auto
.
}
{
rewrite
gset_disj_union
.
replace
(
natset
0
(
n
'
+
1
))
with
(
{
[
n
'
]
}
∪
natset
0
n
'
).
-
auto
.
-
apply
natset_incr
.
-
apply
natset_disj
.
}
*
iPvsIntro
.
wp_if
.
wp_proj
.
iApply
wait_loop_spec
.
iSplitR
"HΦ"
;
last
by
done
.
iExists
γ
1
,
γ
2.
(
*
FIXME
:
iFrame
should
be
able
to
make
progress
here
.
*
)
repeat
(
iSplit
;
first
by
auto
).
by
rewrite
/
auth_own
.
+
wp_cas_fail
.
iPvsIntro
.
iSplitL
"Hl Hainv Haown"
.
{
iNext
.
iExists
o
'
,
n
'
.
by
iFrame
.
}
{
wp_if
.
by
iApply
"IH"
.
}
Qed
.
Lemma
release_spec
R
l
(
Φ
:
val
→
iProp
)
:
locked
l
R
★
R
★
Φ
#()
⊢
WP
release
#
l
{{
Φ
}}
.
Proof
.
iIntros
"(Hl & HR & HΦ)"
;
iDestruct
"Hl"
as
(
γ
1
γ
2
)
"(% & #? & #? & Hγ)"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_focus
(
!
_
)
%
E
.
iInv
N
as
(
o
n
)
"[Hl Hr]"
.
wp_load
.
iPvsIntro
.
iSplitL
"Hl Hr"
.
-
iNext
.
iExists
o
,
n
.
by
iFrame
.
-
wp_let
.
wp_focus
(
CAS
_
_
_
).
wp_proj
.
wp_op
.
wp_proj
.
iInv
N
as
(
o
'
n
'
)
"[Hl Hr]"
.
destruct
(
decide
((#
o
'
,
#
n
'
)
%
V
=
(#
o
,
#
n
)
%
V
))
as
[
Heq
|
Hneq
].
+
inversion
Heq
;
subst
.
wp_cas_suc
.
iDestruct
"Hr"
as
"[Hainv [[Ho _] | Hown]]"
.
*
iExFalso
.
iCombine
"Hγ"
"Ho"
as
"Ho"
.
iDestruct
(
own_valid
with
"#Ho"
)
as
"Hvalid"
.
by
iDestruct
(
excl_validI
_
with
"Hvalid"
)
as
"%"
.
*
iSplitL
"Hl HR Hγ Hainv"
.
{
iPvsIntro
.
iNext
.
iExists
(
o
'
+
1
)
%
nat
,
n
'
%
nat
.
iFrame
.
rewrite
Nat2Z
.
inj_add
.
iFrame
.
iLeft
;
by
iFrame
.
}
{
iPvsIntro
.
by
wp_if
.
}
+
wp_cas_fail
.
iPvsIntro
.
iSplitL
"Hl Hr"
.
*
iNext
.
iExists
o
'
,
n
'
.
by
iFrame
.
*
wp_if
.
by
iApply
(
"IH"
with
"Hγ HR"
).
Qed
.
End
proof
.
Typeclasses
Opaque
is_lock
issued
locked
.
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