Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Iris
Actris
Commits
8cc34257
Commit
8cc34257
authored
Jul 01, 2019
by
Robbert Krebbers
Browse files
Fractional spin lock.
parent
198e38f7
Changes
2
Hide whitespace changes
Inline
Side-by-side
_CoqProject
View file @
8cc34257
...
...
@@ -4,6 +4,7 @@ theories/utils/auth_excl.v
theories/utils/encodable.v
theories/utils/list.v
theories/utils/compare.v
theories/utils/spin_lock.v
theories/channel/channel.v
theories/channel/proto_model.v
theories/channel/proto_channel.v
...
...
theories/utils/spin_lock.v
0 → 100644
View file @
8cc34257
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
algebra
Require
Import
excl
auth
frac
csum
.
From
iris
.
base_logic
.
lib
Require
Import
cancelable_invariants
.
From
iris
.
bi
.
lib
Require
Import
fractional
.
Set
Default
Proof
Using
"Type"
.
Definition
newlock
:
val
:
=
λ
:
<>,
ref
#
false
.
Definition
try_acquire
:
val
:
=
λ
:
"l"
,
CAS
"l"
#
false
#
true
.
Definition
acquire
:
val
:
=
rec
:
"acquire"
"l"
:
=
if
:
try_acquire
"l"
then
#()
else
"acquire"
"l"
.
Definition
release
:
val
:
=
λ
:
"l"
,
"l"
<-
#
false
.
Class
lockG
Σ
:
=
LockG
{
lock_tokG
:
>
inG
Σ
(
authR
(
optionUR
(
exclR
fracR
)))
;
lock_cinvG
:
>
cinvG
Σ
;
}.
Definition
lock
Σ
:
gFunctors
:
=
#[
GFunctor
(
authR
(
optionUR
(
exclR
fracR
)))
;
cinv
Σ
].
Instance
subG_lock
Σ
{
Σ
}
:
subG
lock
Σ
Σ
→
lockG
Σ
.
Proof
.
solve_inG
.
Qed
.
Section
proof
.
Context
`
{!
heapG
Σ
,
!
lockG
Σ
}
(
N
:
namespace
).
Definition
lock_inv
(
γ
γ
i
:
gname
)
(
lk
:
loc
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:
=
(
∃
b
:
bool
,
lk
↦
#
b
∗
if
b
then
(
∃
p
,
own
γ
(
●
(
Excl'
p
))
∗
cinv_own
γ
i
(
p
/
2
))
else
own
γ
(
●
None
)
∗
R
)%
I
.
Definition
is_lock
(
lk
:
loc
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:
=
(
∃
γ
γ
i
:
gname
,
meta
lk
N
(
γ
,
γ
i
)
∗
cinv
N
γ
i
(
lock_inv
γ
γ
i
lk
R
))%
I
.
Definition
unlocked
(
lk
:
loc
)
(
q
:
Qp
)
:
iProp
Σ
:
=
(
∃
γ
γ
i
:
gname
,
meta
lk
N
(
γ
,
γ
i
)
∗
cinv_own
γ
i
q
)%
I
.
Definition
locked
(
lk
:
loc
)
(
q
:
Qp
)
:
iProp
Σ
:
=
(
∃
γ
γ
i
:
gname
,
meta
lk
N
(
γ
,
γ
i
)
∗
cinv_own
γ
i
(
q
/
2
)
∗
own
γ
(
◯
(
Excl'
q
)))%
I
.
Global
Instance
unlocked_fractional
lk
:
Fractional
(
unlocked
lk
).
Proof
.
intros
q1
q2
.
iSplit
.
-
iDestruct
1
as
(
γ
γ
i
)
"[#Hm [Hq Hq']]"
.
iSplitL
"Hq"
;
iExists
γ
,
γ
i
;
by
iSplit
.
-
iIntros
"[Hq1 Hq2]"
.
iDestruct
"Hq1"
as
(
γ
γ
i
)
"[#Hm Hq1]"
.
iDestruct
"Hq2"
as
(
γ
'
γ
i'
)
"[#Hm' Hq2]"
.
iDestruct
(
meta_agree
with
"Hm Hm'"
)
as
%[=
<-
<-].
iExists
γ
,
γ
i
;
iSplit
;
first
done
.
by
iSplitL
"Hq1"
.
Qed
.
Global
Instance
unlocked_as_fractional
γ
:
AsFractional
(
unlocked
γ
p
)
(
unlocked
γ
)
p
.
Proof
.
split
.
done
.
apply
_
.
Qed
.
Global
Instance
lock_inv_ne
γ
γ
i
lk
:
NonExpansive
(
lock_inv
γ
γ
i
lk
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_ne
lk
:
NonExpansive
(
is_lock
lk
).
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_persistent
lk
R
:
Persistent
(
is_lock
lk
R
).
Proof
.
apply
_
.
Qed
.
Global
Instance
locked_timeless
lk
q
:
Timeless
(
locked
lk
q
).
Proof
.
apply
_
.
Qed
.
Global
Instance
unlocked_timeless
lk
q
:
Timeless
(
unlocked
lk
q
).
Proof
.
apply
_
.
Qed
.
Lemma
newlock_spec
(
R
:
iProp
Σ
)
:
{{{
R
}}}
newlock
#()
{{{
lk
,
RET
#
lk
;
is_lock
lk
R
∗
unlocked
lk
1
}}}.
Proof
.
iIntros
(
Φ
)
"HR HΦ"
.
rewrite
-
wp_fupd
/
newlock
/=.
wp_lam
.
wp_apply
(
wp_alloc
with
"[//]"
)
;
iIntros
(
l
)
"[Hl Hm]"
.
iDestruct
(
meta_token_difference
_
(
↑
N
)
with
"Hm"
)
as
"[Hm1 Hm2]"
;
first
done
.
iMod
(
own_alloc
(
●
None
))
as
(
γ
)
"Hγ"
;
first
by
apply
auth_auth_valid
.
iMod
(
cinv_alloc_strong
(
λ
_
,
True
))
as
(
γ
i
_
)
"[Hγi H]"
;
first
by
apply
pred_infinite_True
.
iMod
(
meta_set
_
_
(
γ
,
γ
i
)
with
"Hm1"
)
as
"#Hm1"
;
first
done
.
iMod
(
"H"
$!
(
lock_inv
γ
γ
i
l
R
)
with
"[HR Hl Hγ]"
)
as
"#?"
.
{
iIntros
"!>"
.
iExists
false
.
by
iFrame
.
}
iModIntro
.
iApply
"HΦ"
.
iSplit
;
iExists
γ
,
γ
i
;
auto
.
Qed
.
Lemma
try_acquire_spec
lk
R
q
:
{{{
is_lock
lk
R
∗
unlocked
lk
q
}}}
try_acquire
#
lk
{{{
b
,
RET
#
b
;
if
b
is
true
then
locked
lk
q
∗
R
else
unlocked
lk
q
}}}.
Proof
.
iIntros
(
Φ
)
"[#Hl Hq] HΦ"
.
iDestruct
"Hl"
as
(
γ
γ
i
)
"#[Hm Hinv]"
.
iDestruct
"Hq"
as
(
γ
'
γ
i'
)
"[Hm' Hq]"
.
iDestruct
(
meta_agree
with
"Hm Hm'"
)
as
%[=
<-
<-]
;
iClear
"Hm'"
.
wp_rec
.
wp_bind
(
CmpXchg
_
_
_
).
iInv
N
as
"[HR Hq]"
;
iDestruct
"HR"
as
([])
"[Hl HR]"
.
-
wp_cmpxchg_fail
.
iModIntro
.
iSplitL
"Hl HR"
;
first
(
iExists
true
;
iFrame
).
wp_pures
.
iApply
(
"HΦ"
$!
false
).
iExists
γ
,
γ
i
;
auto
.
-
wp_cmpxchg_suc
.
iDestruct
"HR"
as
"[Hγ HR]"
.
iDestruct
"Hq"
as
"[Hq Hq']"
.
iMod
(
own_update
with
"Hγ"
)
as
"[Hγ Hγ']"
.
{
by
apply
auth_update_alloc
,
(
alloc_option_local_update
(
Excl
q
)).
}
iModIntro
.
iSplitL
"Hl Hγ Hq"
;
first
(
iNext
;
iExists
true
;
eauto
with
iFrame
).
wp_pures
.
iApply
(
"HΦ"
$!
true
with
"[$HR Hγ' Hq']"
).
iExists
γ
,
γ
i
;
by
iFrame
.
Qed
.
Lemma
acquire_spec
lk
R
q
:
{{{
is_lock
lk
R
∗
unlocked
lk
q
}}}
acquire
#
lk
{{{
RET
#()
;
locked
lk
q
∗
R
}}}.
Proof
.
iIntros
(
Φ
)
"[#Hlk Hq] HΦ"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_apply
(
try_acquire_spec
with
"[$Hlk $Hq]"
)
;
iIntros
([]).
-
iIntros
"[Hlked HR]"
.
wp_if
.
iApply
"HΦ"
;
iFrame
.
-
iIntros
"Hq"
.
wp_if
.
iApply
(
"IH"
with
"[$]"
)
;
auto
.
Qed
.
Lemma
release_spec
lk
R
q
:
{{{
is_lock
lk
R
∗
locked
lk
q
∗
R
}}}
release
#
lk
{{{
RET
#()
;
unlocked
lk
q
}}}.
Proof
.
iIntros
(
Φ
)
"(Hlock & Hlocked & HR) HΦ"
.
iDestruct
"Hlock"
as
(
γ
γ
i
)
"#[Hm Hinv]"
.
iDestruct
"Hlocked"
as
(
γ
'
γ
i'
)
"(#Hm' & Hq & Hγ')"
.
iDestruct
(
meta_agree
with
"Hm Hm'"
)
as
%[=
<-
<-].
wp_lam
.
iInv
N
as
"[HR' Hq]"
;
iDestruct
"HR'"
as
([])
"[Hl HR']"
.
-
iDestruct
"HR'"
as
(
p
)
">[Hγ Hq']"
.
iDestruct
(
own_valid_2
with
"Hγ Hγ'"
)
as
%[<-%
Excl_included
%
leibniz_equiv
_
]%
auth_both_valid
.
iMod
(
own_update_2
with
"Hγ Hγ'"
)
as
"Hγ"
.
{
eapply
auth_update_dealloc
,
delete_option_local_update
;
apply
_
.
}
wp_store
.
iIntros
"!>"
.
iSplitL
"Hl Hγ HR"
;
first
(
iExists
false
)
;
iFrame
.
iApply
"HΦ"
.
iExists
γ
,
γ
i
.
iSplit
;
first
done
.
by
iSplitL
"Hq"
.
-
iDestruct
"HR'"
as
"[>Hγ _]"
.
by
iDestruct
(
own_valid_2
with
"Hγ Hγ'"
)
as
%[[[]
?%
leibniz_equiv
]
_
]%
auth_both_valid
.
Qed
.
End
proof
.
Typeclasses
Opaque
is_lock
locked
.
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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