Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
I
iris-coq
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Michael Sammler
iris-coq
Commits
6edb53e7
Commit
6edb53e7
authored
8 years ago
by
Robbert Krebbers
Browse files
Options
Downloads
Patches
Plain Diff
Some clean up/tweaks of locks.
parent
86672bca
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
heap_lang/lib/lock.v
+24
-27
24 additions, 27 deletions
heap_lang/lib/lock.v
heap_lang/lib/spin_lock.v
+60
-66
60 additions, 66 deletions
heap_lang/lib/spin_lock.v
heap_lang/lib/ticket_lock.v
+92
-91
92 additions, 91 deletions
heap_lang/lib/ticket_lock.v
with
176 additions
and
184 deletions
heap_lang/lib/lock.v
+
24
−
27
View file @
6edb53e7
(** Abstract Lock Interface **)
From
iris
.
heap_lang
Require
Import
heap
notation
.
From
iris
.
heap_lang
Require
Import
heap
notation
.
Structure
lock
Σ
`{
!
heapG
Σ
}
:=
Structure
lock
Σ
`{
!
heapG
Σ
}
:=
Lock
{
Lock
{
(* -- operations -- *)
(* -- operations -- *)
newlock
:
val
;
newlock
:
val
;
acquire
:
val
;
acquire
:
val
;
release
:
val
;
release
:
val
;
(* -- predicates -- *)
(* -- predicates -- *)
(* name is used to associate locked with is_lock *)
(* name is used to associate locked with is_lock *)
name
:
Type
;
name
:
Type
;
is_lock
(
N
:
namespace
)
(
γ
:
name
)
(
lock
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
;
is_lock
(
N
:
namespace
)
(
γ
:
name
)
(
lock
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
;
locked
(
γ
:
name
)
:
iProp
Σ
;
locked
(
γ
:
name
)
:
iProp
Σ
;
(* -- general properties -- *)
(* -- general properties -- *)
is_lock_ne
N
γ
lk
n
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
N
γ
lk
);
is_lock_ne
N
γ
lk
n
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
N
γ
lk
);
is_lock_persistent
N
γ
lk
R
:
PersistentP
(
is_lock
N
γ
lk
R
);
is_lock_persistent
N
γ
lk
R
:
PersistentP
(
is_lock
N
γ
lk
R
);
locked_timeless
γ
:
TimelessP
(
locked
γ
);
locked_timeless
γ
:
TimelessP
(
locked
γ
);
locked_exclusive
γ
:
locked
γ
★
locked
γ
⊢
False
;
locked_exclusive
γ
:
locked
γ
★
locked
γ
⊢
False
;
(* -- operation specs -- *)
(* -- operation specs -- *)
newlock_spec
N
(
R
:
iProp
Σ
)
Φ
:
newlock_spec
N
(
R
:
iProp
Σ
)
Φ
:
heapN
⊥
N
→
heapN
⊥
N
→
heap_ctx
★
R
★
(
∀
l
γ
,
is_lock
N
γ
l
R
-★
Φ
l
)
⊢
WP
newlock
#
()
{{
Φ
}};
heap_ctx
★
R
★
(
∀
l
γ
,
is_lock
N
γ
l
R
-★
Φ
l
)
⊢
WP
newlock
#
()
{{
Φ
}};
acquire_spec
N
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
acquire_spec
N
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
is_lock
N
γ
lk
R
★
(
locked
γ
-★
R
-★
Φ
#
())
⊢
WP
acquire
lk
{{
Φ
}};
is_lock
N
γ
lk
R
★
(
locked
γ
-★
R
-★
Φ
#
())
⊢
WP
acquire
lk
{{
Φ
}};
release_spec
N
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
release_spec
N
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
is_lock
N
γ
lk
R
★
locked
γ
★
R
★
Φ
#
()
⊢
WP
release
lk
{{
Φ
}}
is_lock
N
γ
lk
R
★
locked
γ
★
R
★
Φ
#
()
⊢
WP
release
lk
{{
Φ
}}
}
.
}
.
Arguments
newlock
{_
_}
_
.
Arguments
newlock
{_
_}
_
.
Arguments
acquire
{_
_}
_
.
Arguments
acquire
{_
_}
_
.
...
...
This diff is collapsed.
Click to expand it.
heap_lang/lib/spin_lock.v
+
60
−
66
View file @
6edb53e7
...
@@ -21,71 +21,65 @@ Instance subG_lockΣ {Σ} : subG lockΣ Σ → lockG Σ.
...
@@ -21,71 +21,65 @@ Instance subG_lockΣ {Σ} : subG lockΣ Σ → lockG Σ.
Proof
.
intros
[?
%
subG_inG
_]
%
subG_inv
.
split
;
apply
_
.
Qed
.
Proof
.
intros
[?
%
subG_inG
_]
%
subG_inv
.
split
;
apply
_
.
Qed
.
Section
proof
.
Section
proof
.
Context
`{
!
heapG
Σ
,
!
lockG
Σ
}
(
N
:
namespace
)
.
Context
`{
!
heapG
Σ
,
!
lockG
Σ
}
(
N
:
namespace
)
.
Definition
lock_inv
(
γ
:
gname
)
(
l
:
loc
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
Definition
lock_inv
(
γ
:
gname
)
(
l
:
loc
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
(
∃
b
:
bool
,
l
↦
#
b
★
if
b
then
True
else
own
γ
(
Excl
())
★
R
)
%
I
.
(
∃
b
:
bool
,
l
↦
#
b
★
if
b
then
True
else
own
γ
(
Excl
())
★
R
)
%
I
.
Definition
is_lock
(
γ
:
gname
)
(
lk
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
Definition
is_lock
(
γ
:
gname
)
(
lk
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
(
∃
(
l
:
loc
),
heapN
⊥
N
∧
heap_ctx
∧
lk
=
#
l
∧
inv
N
(
lock_inv
γ
l
R
))
%
I
.
(
∃
l
:
loc
,
heapN
⊥
N
∧
heap_ctx
∧
lk
=
#
l
∧
inv
N
(
lock_inv
γ
l
R
))
%
I
.
Definition
locked
(
γ
:
gname
):
iProp
Σ
:=
own
γ
(
Excl
())
%
I
.
Definition
locked
(
γ
:
gname
):
iProp
Σ
:=
own
γ
(
Excl
())
.
Lemma
locked_exclusive
(
γ
:
gname
):
(
locked
γ
★
locked
γ
⊢
False
)
%
I
.
Lemma
locked_exclusive
(
γ
:
gname
)
:
locked
γ
★
locked
γ
⊢
False
.
Proof
.
Proof
.
rewrite
/
locked
-
own_op
own_valid
.
by
iIntros
(?)
.
Qed
.
iIntros
"[Hl Hl']"
.
iCombine
"Hl"
"Hl'"
as
"Hl"
.
by
iDestruct
(
own_valid
with
"Hl"
)
as
%
[]
.
Qed
.
Global
Instance
lock_inv_ne
n
γ
l
:
Proper
(
dist
n
==>
dist
n
)
(
lock_inv
γ
l
)
.
Proof
.
solve_proper
.
Qed
.
Global
Instance
lock_inv_ne
n
γ
l
:
Proper
(
dist
n
==>
dist
n
)
(
lock_inv
γ
l
)
.
Global
Instance
is_lock_ne
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
γ
l
)
.
Proof
.
solve_proper
.
Qed
.
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_ne
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
γ
l
)
.
Proof
.
solve_proper
.
Qed
.
(** The main proofs. *)
(* Global Instance locked_ne n γ : Proper (dist n ==> dist n) (locked γ). *)
Global
Instance
is_lock_persistent
γ
l
R
:
PersistentP
(
is_lock
γ
l
R
)
.
(* Proof. solve_proper. Qed. *)
Proof
.
apply
_
.
Qed
.
Global
Instance
locked_timeless
γ
:
TimelessP
(
locked
γ
)
.
(** The main proofs. *)
Proof
.
apply
_
.
Qed
.
Global
Instance
is_lock_persistent
γ
l
R
:
PersistentP
(
is_lock
γ
l
R
)
.
Proof
.
apply
_
.
Qed
.
Lemma
newlock_spec
(
R
:
iProp
Σ
)
Φ
:
heapN
⊥
N
→
(* Lemma locked_is_lock lk R : locked lk R ⊢ is_lock lk R. *)
heap_ctx
★
R
★
(
∀
lk
γ
,
is_lock
γ
lk
R
-★
Φ
lk
)
⊢
WP
newlock
#
()
{{
Φ
}}
.
(* Proof. rewrite /is_lock. iDestruct 1 as (γ l) "(?&?&?&?&_)". iExists γ, l. auto. Qed. *)
Proof
.
iIntros
(?)
"(#Hh & HR & HΦ)"
.
rewrite
/
newlock
/=.
Global
Instance
locked_timeless
γ
:
TimelessP
(
locked
γ
)
.
wp_seq
.
wp_alloc
l
as
"Hl"
.
Proof
.
apply
_
.
Qed
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
)
"Hγ"
;
first
done
.
iVs
(
inv_alloc
N
_
(
lock_inv
γ
l
R
)
with
"[-HΦ]"
)
as
"#?"
.
Lemma
newlock_spec
(
R
:
iProp
Σ
)
Φ
:
{
iIntros
"!>"
.
iExists
false
.
by
iFrame
.
}
heapN
⊥
N
→
iVsIntro
.
iApply
"HΦ"
.
iExists
l
.
eauto
.
heap_ctx
★
R
★
(
∀
lk
γ
,
is_lock
γ
lk
R
-★
Φ
lk
)
⊢
WP
newlock
#
()
{{
Φ
}}
.
Qed
.
Proof
.
iIntros
(?)
"(#Hh & HR & HΦ)"
.
rewrite
/
newlock
.
Lemma
acquire_spec
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
wp_seq
.
wp_alloc
l
as
"Hl"
.
is_lock
γ
lk
R
★
(
locked
γ
-★
R
-★
Φ
#
())
⊢
WP
acquire
lk
{{
Φ
}}
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
)
"Hγ"
;
first
done
.
Proof
.
iVs
(
inv_alloc
N
_
(
lock_inv
γ
l
R
)
with
"[-HΦ]"
)
as
"#?"
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
l
)
"(% & #? & % & #?)"
.
subst
.
{
iIntros
"!>"
.
iExists
false
.
by
iFrame
.
}
iLöb
as
"IH"
.
wp_rec
.
wp_bind
(
CAS
_
_
_)
%
E
.
iVsIntro
.
iApply
"HΦ"
.
iExists
l
.
eauto
.
iInv
N
as
([])
"[Hl HR]"
"Hclose"
.
Qed
.
-
wp_cas_fail
.
iVs
(
"Hclose"
with
"[Hl]"
);
first
(
iNext
;
iExists
true
;
eauto
)
.
iVsIntro
.
wp_if
.
by
iApply
"IH"
.
Lemma
acquire_spec
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
-
wp_cas_suc
.
iDestruct
"HR"
as
"[Hγ HR]"
.
is_lock
γ
lk
R
★
(
locked
γ
-★
R
-★
Φ
#
())
⊢
WP
acquire
lk
{{
Φ
}}
.
iVs
(
"Hclose"
with
"[Hl]"
);
first
(
iNext
;
iExists
true
;
eauto
)
.
Proof
.
iVsIntro
.
wp_if
.
iApply
(
"HΦ"
with
"[-HR] HR"
)
.
by
iFrame
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
l
)
"(% & #? & % & #?)"
.
subst
.
Qed
.
iLöb
as
"IH"
.
wp_rec
.
wp_bind
(
CAS
_
_
_)
%
E
.
iInv
N
as
([])
"[Hl HR]"
"Hclose"
.
Lemma
release_spec
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
-
wp_cas_fail
.
iVs
(
"Hclose"
with
"[Hl]"
);
first
(
iNext
;
iExists
true
;
eauto
)
.
is_lock
γ
lk
R
★
locked
γ
★
R
★
Φ
#
()
⊢
WP
release
lk
{{
Φ
}}
.
iVsIntro
.
wp_if
.
by
iApply
"IH"
.
Proof
.
-
wp_cas_suc
.
iDestruct
"HR"
as
"[Hγ HR]"
.
iIntros
"(Hlock & Hlocked & HR & HΦ)"
.
iVs
(
"Hclose"
with
"[Hl]"
);
first
(
iNext
;
iExists
true
;
eauto
)
.
iDestruct
"Hlock"
as
(
l
)
"(% & #? & % & #?)"
.
subst
.
iVsIntro
.
wp_if
.
iApply
(
"HΦ"
with
"[-HR] HR"
)
.
by
iFrame
.
rewrite
/
release
/=.
wp_let
.
iInv
N
as
(
b
)
"[Hl _]"
"Hclose"
.
Qed
.
wp_store
.
iFrame
"HΦ"
.
iApply
"Hclose"
.
iNext
.
iExists
false
.
by
iFrame
.
Qed
.
Lemma
release_spec
γ
lk
R
(
Φ
:
val
→
iProp
Σ
)
:
is_lock
γ
lk
R
★
locked
γ
★
R
★
Φ
#
()
⊢
WP
release
lk
{{
Φ
}}
.
Proof
.
iIntros
"(Hlock & Hlocked & HR & HΦ)"
.
iDestruct
"Hlock"
as
(
l
)
"(% & #? & % & #?)"
.
subst
.
rewrite
/
release
.
wp_let
.
iInv
N
as
(
b
)
"[Hl _]"
"Hclose"
.
wp_store
.
iFrame
"HΦ"
.
iApply
"Hclose"
.
iNext
.
iExists
false
.
by
iFrame
.
Qed
.
End
proof
.
End
proof
.
Definition
spin_lock
`{
!
heapG
Σ
,
!
lockG
Σ
}
:=
Definition
spin_lock
`{
!
heapG
Σ
,
!
lockG
Σ
}
:
lock
Σ
:=
Lock
_
_
newlock
acquire
release
gname
is_lock
locked
_
_
_
locked_exclusive
newlock_spec
acquire_spec
release_spec
.
{|
lock
.
locked_exclusive
:=
locked_exclusive
;
lock
.
newlock_spec
:=
newlock_spec
;
lock
.
acquire_spec
:=
acquire_spec
;
lock
.
release_spec
:=
release_spec
|}
.
This diff is collapsed.
Click to expand it.
heap_lang/lib/ticket_lock.v
+
92
−
91
View file @
6edb53e7
...
@@ -4,7 +4,7 @@ From iris.program_logic Require Import auth.
...
@@ -4,7 +4,7 @@ From iris.program_logic Require Import auth.
From
iris
.
proofmode
Require
Import
invariants
.
From
iris
.
proofmode
Require
Import
invariants
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
algebra
Require
Import
gset
.
From
iris
.
algebra
Require
Import
gset
.
From
iris
.
heap_lang
.
lib
Require
Im
port
lock
.
From
iris
.
heap_lang
.
lib
Require
Ex
port
lock
.
Import
uPred
.
Import
uPred
.
Definition
wait_loop
:
val
:=
Definition
wait_loop
:
val
:=
...
@@ -53,7 +53,7 @@ Section proof.
...
@@ -53,7 +53,7 @@ Section proof.
(
∃
(
o
n
:
nat
),
(
∃
(
o
n
:
nat
),
lo
↦
#
o
★
ln
↦
#
n
★
lo
↦
#
o
★
ln
↦
#
n
★
auth_inv
γ1
(
tickets_inv
n
)
★
auth_inv
γ1
(
tickets_inv
n
)
★
((
own
γ2
(
Excl
())
★
R
)
∨
auth_own
γ1
(
GSet
{[
o
]})))
%
I
.
((
own
γ2
(
Excl
())
★
R
)
∨
auth_own
γ1
(
GSet
{[
o
]})))
%
I
.
Definition
is_lock
(
γs
:
gname
*
gname
)
(
l
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
Definition
is_lock
(
γs
:
gname
*
gname
)
(
l
:
val
)
(
R
:
iProp
Σ
)
:
iProp
Σ
:=
(
∃
(
lo
ln
:
loc
),
(
∃
(
lo
ln
:
loc
),
...
@@ -68,7 +68,8 @@ Section proof.
...
@@ -68,7 +68,8 @@ Section proof.
Definition
locked
(
γs
:
gname
*
gname
)
:
iProp
Σ
:=
own
(
snd
γs
)
(
Excl
())
%
I
.
Definition
locked
(
γs
:
gname
*
gname
)
:
iProp
Σ
:=
own
(
snd
γs
)
(
Excl
())
%
I
.
Global
Instance
lock_inv_ne
n
γ1
γ2
lo
ln
:
Proper
(
dist
n
==>
dist
n
)
(
lock_inv
γ1
γ2
lo
ln
)
.
Global
Instance
lock_inv_ne
n
γ1
γ2
lo
ln
:
Proper
(
dist
n
==>
dist
n
)
(
lock_inv
γ1
γ2
lo
ln
)
.
Proof
.
solve_proper
.
Qed
.
Proof
.
solve_proper
.
Qed
.
Global
Instance
is_lock_ne
γs
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
γs
l
)
.
Global
Instance
is_lock_ne
γs
n
l
:
Proper
(
dist
n
==>
dist
n
)
(
is_lock
γs
l
)
.
Proof
.
solve_proper
.
Qed
.
Proof
.
solve_proper
.
Qed
.
...
@@ -78,14 +79,13 @@ Section proof.
...
@@ -78,14 +79,13 @@ Section proof.
Proof
.
apply
_
.
Qed
.
Proof
.
apply
_
.
Qed
.
Lemma
locked_exclusive
(
γs
:
gname
*
gname
)
:
(
locked
γs
★
locked
γs
⊢
False
)
%
I
.
Lemma
locked_exclusive
(
γs
:
gname
*
gname
)
:
(
locked
γs
★
locked
γs
⊢
False
)
%
I
.
Proof
.
Proof
.
rewrite
/
locked
-
own_op
own_valid
.
by
iIntros
(?)
.
Qed
.
iIntros
"[Hl Hl']"
.
iCombine
"Hl"
"Hl'"
as
"Hl"
.
by
iDestruct
(
own_valid
with
"Hl"
)
as
%
[]
.
Qed
.
Lemma
newlock_spec
(
R
:
iProp
Σ
)
Φ
:
Lemma
newlock_spec
(
R
:
iProp
Σ
)
Φ
:
heapN
⊥
N
→
heap_ctx
★
R
★
(
∀
lk
γs
,
is_lock
γs
lk
R
-★
Φ
lk
)
⊢
WP
newlock
#
()
{{
Φ
}}
.
heapN
⊥
N
→
heap_ctx
★
R
★
(
∀
lk
γs
,
is_lock
γs
lk
R
-★
Φ
lk
)
⊢
WP
newlock
#
()
{{
Φ
}}
.
Proof
.
Proof
.
iIntros
(
HN
)
"(#Hh & HR & HΦ)"
.
rewrite
/
newlock
.
iIntros
(
HN
)
"(#Hh & HR & HΦ)"
.
rewrite
/
newlock
/=
.
wp_seq
.
wp_alloc
lo
as
"Hlo"
.
wp_alloc
ln
as
"Hln"
.
wp_seq
.
wp_alloc
lo
as
"Hlo"
.
wp_alloc
ln
as
"Hln"
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ2
)
"Hγ2"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ2
)
"Hγ2"
;
first
done
.
iVs
(
own_alloc_strong
(
Auth
(
Excl'
∅
)
∅
)
{[
γ2
]})
as
(
γ1
)
"[% Hγ1]"
;
first
done
.
iVs
(
own_alloc_strong
(
Auth
(
Excl'
∅
)
∅
)
{[
γ2
]})
as
(
γ1
)
"[% Hγ1]"
;
first
done
.
...
@@ -99,95 +99,96 @@ Section proof.
...
@@ -99,95 +99,96 @@ Section proof.
by
iFrame
.
by
iFrame
.
+
iLeft
.
by
iFrame
.
+
iLeft
.
by
iFrame
.
-
iVsIntro
.
-
iVsIntro
.
i
Specialize
(
"HΦ"
$!
(
#
lo
,
#
ln
)
%
V
(
γ1
,
γ2
))
.
iApply
"HΦ"
.
i
Apply
(
"HΦ"
$!
(
#
lo
,
#
ln
)
%
V
(
γ1
,
γ2
))
.
iExists
lo
,
ln
.
iExists
lo
,
ln
.
iSplit
;
by
eauto
.
iSplit
;
by
eauto
.
Qed
.
Qed
.
Lemma
wait_loop_spec
γs
l
x
R
(
Φ
:
val
→
iProp
Σ
)
:
Lemma
wait_loop_spec
γs
l
x
R
(
Φ
:
val
→
iProp
Σ
)
:
issued
γs
l
x
R
★
(
locked
γs
-★
R
-★
Φ
#
())
⊢
WP
wait_loop
#
x
l
{{
Φ
}}
.
issued
γs
l
x
R
★
(
locked
γs
-★
R
-★
Φ
#
())
⊢
WP
wait_loop
#
x
l
{{
Φ
}}
.
Proof
.
Proof
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #? & Ht)"
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #? & Ht)"
.
iLöb
as
"IH"
.
wp_rec
.
subst
.
wp_let
.
wp_proj
.
wp_bind
(
!
_)
%
E
.
iLöb
as
"IH"
.
wp_rec
.
subst
.
wp_let
.
wp_proj
.
wp_bind
(
!
_)
%
E
.
iInv
N
as
(
o
n
)
"[Hlo [Hln Ha]]"
"Hclose"
.
iInv
N
as
(
o
n
)
"[Hlo [Hln Ha]]"
"Hclose"
.
wp_load
.
destruct
(
decide
(
x
=
o
))
as
[
->
|
Hneq
]
.
wp_load
.
destruct
(
decide
(
x
=
o
))
as
[
->
|
Hneq
]
.
-
iDestruct
"Ha"
as
"[Hainv [[Ho HR] | Haown]]"
.
-
iDestruct
"Ha"
as
"[Hainv [[Ho HR] | Haown]]"
.
+
iVs
(
"Hclose"
with
"[Hlo Hln Hainv Ht]"
)
.
+
iVs
(
"Hclose"
with
"[Hlo Hln Hainv Ht]"
)
.
{
iNext
.
iExists
o
,
n
.
iFrame
.
eauto
.
}
{
iNext
.
iExists
o
,
n
.
iFrame
.
eauto
.
}
iVsIntro
.
wp_let
.
wp_op
=>[_|[]]
//.
iVsIntro
.
wp_let
.
wp_op
=>[_|[]]
//.
wp_if
.
iVsIntro
.
wp_if
.
iVsIntro
.
iApply
(
"HΦ"
with
"[-HR] HR"
)
.
eauto
.
iApply
(
"HΦ"
with
"[-HR] HR"
)
.
eauto
.
+
iExFalso
.
iCombine
"Ht"
"Haown"
as
"Haown"
.
+
iExFalso
.
iCombine
"Ht"
"Haown"
as
"Haown"
.
iDestruct
(
auth_own_valid
with
"Haown"
)
as
%
?
%
gset_disj_valid_op
.
iDestruct
(
auth_own_valid
with
"Haown"
)
as
%
?
%
gset_disj_valid_op
.
set_solver
.
set_solver
.
-
iVs
(
"Hclose"
with
"[Hlo Hln Ha]"
)
.
-
iVs
(
"Hclose"
with
"[Hlo Hln Ha]"
)
.
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
iVsIntro
.
wp_let
.
wp_op
=>[[
/
Nat2Z
.
inj
//
]|?]
.
wp_if
.
iApply
(
"IH"
with
"Ht"
)
.
by
iExact
"HΦ"
.
Qed
.
Lemma
acquire_spec
γs
l
R
(
Φ
:
val
→
iProp
Σ
)
:
is_lock
γs
l
R
★
(
locked
γs
-★
R
-★
Φ
#
())
⊢
WP
acquire
l
{{
Φ
}}
.
Proof
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #?)"
.
iLöb
as
"IH"
.
wp_rec
.
wp_bind
(
!
_)
%
E
.
subst
.
wp_proj
.
iInv
N
as
(
o
n
)
"[Hlo [Hln Ha]]"
"Hclose"
.
wp_load
.
iVs
(
"Hclose"
with
"[Hlo Hln Ha]"
)
.
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
iVsIntro
.
wp_let
.
wp_op
=>[[
/
Nat2Z
.
inj
//
]|?]
.
iVsIntro
.
wp_let
.
wp_proj
.
wp_op
.
wp_if
.
iApply
(
"IH"
with
"Ht"
)
.
by
iExact
"HΦ"
.
wp_bind
(
CAS
_
_
_)
.
Qed
.
iInv
N
as
(
o'
n'
)
"[Hlo' [Hln' [Hainv Haown]]]"
"Hclose"
.
destruct
(
decide
(
#
n'
=
#
n
))
%
V
as
[[
=
->%
Nat2Z
.
inj
]
|
Hneq
]
.
Lemma
acquire_spec
γs
l
R
(
Φ
:
val
→
iProp
Σ
)
:
-
wp_cas_suc
.
is_lock
γs
l
R
★
(
locked
γs
-★
R
-★
Φ
#
())
⊢
WP
acquire
l
{{
Φ
}}
.
iDestruct
"Hainv"
as
(
s
)
"[Ho %]"
;
subst
.
Proof
.
iVs
(
own_update
with
"Ho"
)
as
"Ho"
.
iIntros
"[Hl HΦ]"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #?)"
.
{
eapply
auth_update_no_frag
,
(
gset_alloc_empty_local_update
n
)
.
iLöb
as
"IH"
.
wp_rec
.
wp_bind
(
!
_)
%
E
.
subst
.
wp_proj
.
rewrite
elem_of_seq_set
;
omega
.
}
iInv
N
as
(
o
n
)
"[Hlo [Hln Ha]]"
"Hclose"
.
iDestruct
"Ho"
as
"[Hofull Hofrag]"
.
wp_load
.
iVs
(
"Hclose"
with
"[Hlo Hln Ha]"
)
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Haown Hofull]"
)
.
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
{
rewrite
gset_disj_union
;
last
by
apply
(
seq_set_S_disjoint
0
)
.
iVsIntro
.
wp_let
.
wp_proj
.
wp_op
.
rewrite
-
(
seq_set_S_union_L
0
)
.
wp_bind
(
CAS
_
_
_)
.
iNext
.
iExists
o'
,
(
S
n
)
%
nat
.
iInv
N
as
(
o'
n'
)
"[Hlo' [Hln' [Hainv Haown]]]"
"Hclose"
.
rewrite
Nat2Z
.
inj_succ
-
Z
.
add_1_r
.
destruct
(
decide
(
#
n'
=
#
n
))
%
V
as
[[
=
->%
Nat2Z
.
inj
]
|
Hneq
]
.
iFrame
.
iExists
(
GSet
(
seq_set
0
(
S
n
)))
.
by
iFrame
.
}
-
wp_cas_suc
.
iVsIntro
.
wp_if
.
iDestruct
"Hainv"
as
(
s
)
"[Ho %]"
;
subst
.
iApply
(
wait_loop_spec
γs
(
#
lo
,
#
ln
))
.
iVs
(
own_update
with
"Ho"
)
as
"Ho"
.
iSplitR
"HΦ"
;
last
by
auto
.
{
eapply
auth_update_no_frag
,
(
gset_alloc_empty_local_update
n
)
.
rewrite
/
issued
/
auth_own
;
eauto
10
.
rewrite
elem_of_seq_set
;
omega
.
}
-
wp_cas_fail
.
iDestruct
"Ho"
as
"[Hofull Hofrag]"
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Hainv Haown]"
)
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Haown Hofull]"
)
.
{
iNext
.
iExists
o'
,
n'
.
by
iFrame
.
}
{
rewrite
gset_disj_union
;
last
by
apply
(
seq_set_S_disjoint
0
)
.
iVsIntro
.
wp_if
.
by
iApply
"IH"
.
rewrite
-
(
seq_set_S_union_L
0
)
.
Qed
.
iNext
.
iExists
o'
,
(
S
n
)
%
nat
.
rewrite
Nat2Z
.
inj_succ
-
Z
.
add_1_r
.
Lemma
release_spec
γs
l
R
(
Φ
:
val
→
iProp
Σ
):
iFrame
.
iExists
(
GSet
(
seq_set
0
(
S
n
)))
.
by
iFrame
.
}
is_lock
γs
l
R
★
locked
γs
★
R
★
Φ
#
()
⊢
WP
release
l
{{
Φ
}}
.
iVsIntro
.
wp_if
.
Proof
.
iApply
(
wait_loop_spec
γs
(
#
lo
,
#
ln
))
.
iIntros
"(Hl & Hγ & HR & HΦ)"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #?)"
.
iSplitR
"HΦ"
;
last
by
auto
.
iLöb
as
"IH"
.
wp_rec
.
subst
.
wp_proj
.
wp_bind
(
!
_)
%
E
.
rewrite
/
issued
/
auth_own
;
eauto
10
.
iInv
N
as
(
o
n
)
"[Hlo [Hln Hr]]"
"Hclose"
.
-
wp_cas_fail
.
wp_load
.
iVs
(
"Hclose"
with
"[Hlo Hln Hr]"
)
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Hainv Haown]"
)
.
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
{
iNext
.
iExists
o'
,
n'
.
by
iFrame
.
}
iVsIntro
.
wp_let
.
wp_bind
(
CAS
_
_
_
)
.
iVsIntro
.
wp_if
.
by
iApply
"IH"
.
wp_proj
.
wp_op
.
Qed
.
iInv
N
as
(
o'
n'
)
"[Hlo' [Hln' Hr]]"
"Hclose"
.
destruct
(
decide
(
#
o'
=
#
o
))
%
V
as
[[
=
->%
Nat2Z
.
inj
]
|
Hneq
]
.
Lemma
release_spec
γs
l
R
(
Φ
:
val
→
iProp
Σ
):
-
wp_cas_suc
.
is_lock
γs
l
R
★
locked
γs
★
R
★
Φ
#
()
⊢
WP
release
l
{{
Φ
}}
.
iDestruct
"Hr"
as
"[Hainv [[Ho _] | Hown]]"
.
Proof
.
+
iExFalso
.
iCombine
"Hγ"
"Ho"
as
"Ho"
.
iIntros
"(Hl & Hγ & HR & HΦ)"
.
iDestruct
"Hl"
as
(
lo
ln
)
"(% & #? & % & #?)"
.
iDestruct
(
own_valid
with
"#Ho"
)
as
%
[]
.
iLöb
as
"IH"
.
wp_rec
.
subst
.
wp_proj
.
wp_bind
(
!
_)
%
E
.
+
iVs
(
"Hclose"
with
"[Hlo' Hln' HR Hγ Hainv]"
)
.
iInv
N
as
(
o
n
)
"[Hlo [Hln Hr]]"
"Hclose"
.
{
iNext
.
iExists
(
o
+
1
)
%
nat
,
n'
%
nat
.
wp_load
.
iVs
(
"Hclose"
with
"[Hlo Hln Hr]"
)
.
iFrame
.
rewrite
Nat2Z
.
inj_add
.
{
iNext
.
iExists
o
,
n
.
by
iFrame
.
}
iFrame
.
iLeft
;
by
iFrame
.
}
iVsIntro
.
wp_let
.
wp_bind
(
CAS
_
_
_
)
.
iVsIntro
.
by
wp_if
.
wp_proj
.
wp_op
.
-
wp_cas_fail
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Hr]"
)
.
iInv
N
as
(
o'
n'
)
"[Hlo' [Hln' Hr]]"
"Hclose"
.
{
iNext
.
iExists
o'
,
n'
.
by
iFrame
.
}
destruct
(
decide
(
#
o'
=
#
o
))
%
V
as
[[
=
->%
Nat2Z
.
inj
]
|
Hneq
]
.
iVsIntro
.
wp_if
.
by
iApply
(
"IH"
with
"Hγ HR"
)
.
-
wp_cas_suc
.
Qed
.
iDestruct
"Hr"
as
"[Hainv [[Ho _] | Hown]]"
.
+
iExFalso
.
iCombine
"Hγ"
"Ho"
as
"Ho"
.
iDestruct
(
own_valid
with
"#Ho"
)
as
%
[]
.
+
iVs
(
"Hclose"
with
"[Hlo' Hln' HR Hγ Hainv]"
)
.
{
iNext
.
iExists
(
o
+
1
)
%
nat
,
n'
%
nat
.
iFrame
.
rewrite
Nat2Z
.
inj_add
.
iFrame
.
iLeft
;
by
iFrame
.
}
iVsIntro
.
by
wp_if
.
-
wp_cas_fail
.
iVs
(
"Hclose"
with
"[Hlo' Hln' Hr]"
)
.
{
iNext
.
iExists
o'
,
n'
.
by
iFrame
.
}
iVsIntro
.
wp_if
.
by
iApply
(
"IH"
with
"Hγ HR"
)
.
Qed
.
End
proof
.
End
proof
.
Typeclasses
Opaque
is_lock
issued
locked
.
Typeclasses
Opaque
is_lock
issued
locked
.
Definition
ticket_lock
`{
!
heapG
Σ
,
!
tlockG
Σ
}
:=
Definition
ticket_lock
`{
!
heapG
Σ
,
!
tlockG
Σ
}
:
lock
Σ
:=
Lock
_
_
newlock
acquire
release
(
gname
*
gname
)
is_lock
locked
_
_
_
locked_exclusive
newlock_spec
acquire_spec
release_spec
.
{|
lock
.
locked_exclusive
:=
locked_exclusive
;
lock
.
newlock_spec
:=
newlock_spec
;
lock
.
acquire_spec
:=
acquire_spec
;
lock
.
release_spec
:=
release_spec
|}
.
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment