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
Gaurav Parthasarathy
examples_rdcss_old
Commits
b2ba5bcb
Commit
b2ba5bcb
authored
Sep 08, 2016
by
Zhen Zhang
Browse files
srv client side with minor admit
parent
bb9d4d91
Changes
2
Hide whitespace changes
Inline
Sidebyside
misc.v
View file @
b2ba5bcb
...
...
@@ 20,8 +20,13 @@ Section lemmas.
eapply
cmra_update_exclusive
.
done
.
Qed
.
Lemma
pair_l_frac_op
(
g
g'
:
val
)
:
((((
1
/
2
)%
Qp
,
DecAgree
g'
)
⋅
((
1
/
2
)%
Qp
,
DecAgree
g'
)))
~~>
(
1
%
Qp
,
DecAgree
g'
).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op'
Qp_div_2
.
Qed
.
Lemma
pair_l_frac_op'
(
g
g'
:
val
)
:
(
1
%
Qp
,
DecAgree
g'
)
~~>
((((
1
/
2
)%
Qp
,
DecAgree
g'
)
⋅
((
1
/
2
)%
Qp
,
DecAgree
g'
))).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op'
Qp_div_2
.
Qed
.
End
lemmas
.
srv.v
View file @
b2ba5bcb
...
...
@@ 60,23 +60,23 @@ Section proof.
Context
`
{!
heapG
Σ
,
!
lockG
Σ
,
!
srvG
Σ
}
(
N
:
namespace
).
Definition
srv_inv
(
γ
x
γ
1
γ
2
:
gname
)
(
p
:
loc
)
(
γ
x
γ
1
γ
2
γ
3
:
gname
)
(
p
:
loc
)
(
Q
:
val
→
val
→
Prop
)
:
iProp
Σ
:
=
((
∃
(
x
:
val
),
p
↦
InjRV
x
★
own
γ
1
(
Excl
()))
∨
(
∃
(
x
:
val
),
p
↦
InjLV
x
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
own
γ
1
(
Excl
()))
∨
(
∃
(
x
y
:
val
),
p
↦
InjRV
y
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
■
Q
x
y
★
own
γ
2
(
Excl
())))%
I
.
(
∃
(
x
:
val
),
p
↦
InjLV
x
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
own
γ
2
(
Excl
()))
∨
(
∃
(
x
y
:
val
),
p
↦
InjRV
y
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
■
Q
x
y
★
own
γ
3
(
Excl
())))%
I
.
Lemma
srv_inv_timeless
γ
x
γ
1
γ
2
p
Q
:
TimelessP
(
srv_inv
γ
x
γ
1
γ
2
p
Q
).
Lemma
srv_inv_timeless
γ
x
γ
1
γ
2
γ
3
p
Q
:
TimelessP
(
srv_inv
γ
x
γ
1
γ
2
γ
3
p
Q
).
Proof
.
apply
_
.
Qed
.
Lemma
wait_spec
(
Φ
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
Prop
)
x
γ
x
γ
1
γ
2
p
:
Lemma
wait_spec
(
Φ
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
Prop
)
x
γ
x
γ
1
γ
2
γ
3
p
:
heapN
⊥
N
→
heap_ctx
★
inv
N
(
srv_inv
γ
x
γ
1
γ
2
p
Q
)
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
own
γ
1
(
Excl
())
★
(
∀
x
y
,
own
γ
2
(
Excl
())

★
own
γ
x
(
1
%
Qp
,
DecAgree
x
)

★
■
Q
x
y

★
Φ
y
)
heap_ctx
★
inv
N
(
srv_inv
γ
x
γ
1
γ
2
γ
3
p
Q
)
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
own
γ
1
(
Excl
())
★
own
γ
3
(
Excl
())
★
(
∀
y
,
own
γ
1
(
Excl
())
★
own
γ
2
(
Excl
())

★
own
γ
x
(
1
%
Qp
,
DecAgree
x
)

★
■
Q
x
y

★
Φ
y
)
⊢
WP
wait
#
p
{{
Φ
}}.
Proof
.
iIntros
(
HN
)
"(#Hh & #Hsrv & Hx & Hempty & HΦ)"
.
iIntros
(
HN
)
"(#Hh & #Hsrv & Hx & Hempty &
Hfinished &
HΦ)"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_bind
(!
#
p
)%
E
.
iInv
N
as
">[Hinv[HinvHinv]]"
"Hclose"
.
...
...
@@ 87,39 +87,12 @@ Section proof.
wp_load
.
iVs
(
"Hclose"
with
"[Hp Hx' Hissued]"
).
{
iNext
.
iRight
.
iLeft
.
iExists
x'
.
by
iFrame
.
}
iVsIntro
.
wp_match
.
by
iApply
(
"IH"
with
"Hx Hempty"
).
+
iDestruct
"Hinv"
as
(
x'
y'
)
"(Hp & Hx' & % & Hissued)"
.
wp_load
.
destruct
(
decide
(
x
=
x'
))
as
[>
Hneq
].
{
subst
.
iVs
(
"Hclose"
with
"[Hp Hx' Hissued]"
).
{
iNext
.
iRight
.
iRight
.
iExists
x'
,
y'
.
by
iFrame
.
}
iVsIntro
.
wp_match
.
wp_bind
(
_
<
_
)%
E
.
iInv
N
as
">[Hinv[HinvHinv]]"
"Hclose"
.

iExFalso
.
iDestruct
"Hinv"
as
(?)
"[_ Ho1]"
.
iCombine
"Hempty"
"Ho1"
as
"Hempty"
.
iDestruct
(
own_valid
with
"Hempty"
)
as
"%"
.
done
.

iExFalso
.
iDestruct
"Hinv"
as
(?)
"[_ [_ Ho1]]"
.
iCombine
"Hempty"
"Ho1"
as
"Hempty"
.
iDestruct
(
own_valid
with
"Hempty"
)
as
"%"
.
done
.

iDestruct
"Hinv"
as
(
x''
y''
)
"(Hp & Hx'' & % & Hissued)"
.
iCombine
"Hx"
"Hx''"
as
"Hx"
.
destruct
(
decide
(
x'
=
x''
))
as
[>
Hneq
].
+
wp_store
.
iVs
(
"Hclose"
with
"[Hp Hempty]"
).
{
iNext
.
iLeft
.
iExists
#
0
.
by
iFrame
.
}
iVsIntro
.
wp_seq
.
iDestruct
(
own_update
with
"Hx"
)
as
"Hx"
;
first
by
apply
pair_l_frac_op
.
iVs
"Hx"
.
iVsIntro
.
by
iApply
(
"HΦ"
$!
x''
y'
with
"Hissued Hx"
).
+
iExFalso
.
iDestruct
(
own_valid
with
"Hx"
)
as
"%"
.
iPureIntro
.
apply
Hneq
.
destruct
H1
as
[
_
Hag
].
apply
dec_agree_op_inv
in
Hag
.
by
inversion
Hag
.
}
{
iCombine
"Hx"
"Hx'"
as
"Hx"
.
iExFalso
.
iDestruct
(
own_valid
with
"Hx"
)
as
"%"
.
iPureIntro
.
apply
Hneq
.
destruct
H0
as
[
_
Hag
].
apply
dec_agree_op_inv
in
Hag
.
by
inversion
Hag
.
}
iVsIntro
.
wp_match
.
by
iApply
(
"IH"
with
"Hx Hempty Hfinished"
).
+
iDestruct
"Hinv"
as
(
x'
y'
)
"(Hp & Hx' & % & Ho3)"
.
iCombine
"Hfinished"
"Ho3"
as
"Hfinished"
.
by
iDestruct
(
own_valid
with
"Hfinished"
)
as
"%"
.
Qed
.
Lemma
mk_srv_spec
(
f
:
val
)
Q
:
heapN
⊥
N
→
heap_ctx
★
□
(
∀
x
:
val
,
WP
f
x
{{
v
,
■
Q
x
v
}})
...
...
@@ 127,14 +100,15 @@ Section proof.
Proof
.
iIntros
(
HN
)
"[#Hh #Hf]"
.
wp_let
.
wp_alloc
p
as
"Hp"
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
1
)
"Hempty"
;
first
done
.
(* black token *)
iVs
(
own_alloc
(
Excl
()))
as
(
γ
2
)
"Hissued"
;
first
done
.
(* white token *)
iVs
(
own_alloc
(
Excl
()))
as
(
γ
1
)
"Hempty"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
2
)
"Hissued"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
3
)
"Hfinished"
;
first
done
.
iVs
(
own_alloc
(
1
%
Qp
,
DecAgree
#
0
))
as
(
γ
x
)
"Hx"
;
first
done
.
iVs
(
inv_alloc
N
_
(
srv_inv
γ
x
γ
1
γ
2
p
Q
)
with
"[Hp Hempty]"
)
as
"#?"
.
iVs
(
inv_alloc
N
_
(
srv_inv
γ
x
γ
1
γ
2
γ
3
p
Q
)
with
"[Hp Hempty]"
)
as
"#?"
.
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
#
0
.
by
iFrame
.
}
wp_let
.
wp_bind
(
newlock
_
).
iApply
newlock_spec
=>//.
iFrame
"Hh"
.
iAssert
(
∃
x
,
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
★
own
γ
2
(
Excl
()))%
I
with
"[Hissued Hx]"
as
"Hinv"
.
iAssert
(
∃
x
,
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
★
own
γ
2
(
Excl
())
★
own
γ
3
(
Excl
()))%
I
with
"[Hissued
Hfinished
Hx]"
as
"Hinv"
.
{
iExists
#
0
.
by
iFrame
.
}
iFrame
"Hinv"
.
iIntros
(
lk
γ
lk
)
"#Hlk"
.
wp_let
.
wp_apply
wp_fork
.
...
...
@@ 144,35 +118,41 @@ Section proof.
iAlways
.
iIntros
(
x
).
wp_let
.
wp_bind
(
acquire
_
).
iApply
acquire_spec
.
iFrame
"Hlk"
.
iIntros
"Hlked Ho"
.
iDestruct
"Ho"
as
(
x'
)
"[Hx Hissued]"
.
iDestruct
"Ho"
as
(
x'
)
"[Hx
[
Hissued
Hfinished]
]"
.
wp_seq
.
wp_bind
(
_
<
_
)%
E
.
iInv
N
as
">Hinv"
"Hclose"
.
rewrite
/
srv_inv
.
iDestruct
"Hinv"
as
"[Hinv[HinvHinv]]"
.
+
iDestruct
"Hinv"
as
(
x''
)
"[Hp Hempty]"
.
wp_store
.
iAssert
(
own
γ
x
(
1
%
Qp
,
DecAgree
x'
)

★
(
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)
★
own
γ
x
((
1
/
2
)%
Qp
,
DecAgree
x
)))%
I
as
"Hsplit"
.
{
admit
.
}
iDestruct
(
"Hsplit"
with
"Hx"
)
as
"[Hx1 Hx2]"
.
iVs
(
"Hclose"
with
"[Hp Hissued Hx1]"
).
iAssert
(=
r
=>
own
γ
x
(
1
%
Qp
,
DecAgree
x
))%
I
with
"[Hx]"
as
"Ho"
.
{
iDestruct
(
own_update
with
"Hx"
)
as
"Hx"
;
last
by
iAssumption
.
apply
cmra_update_exclusive
.
done
.
}
iVs
"Ho"
.
iDestruct
(
own_update
with
"Ho"
)
as
"==>[Ho1 Ho2]"
;
first
by
apply
pair_l_frac_op'
.
iVs
(
"Hclose"
with
"[Hp Hissued Ho1]"
).
{
rewrite
/
locked
.
iNext
.
iRight
.
iLeft
.
iExists
x
.
by
iFrame
.
}
(* now prove things about wait *)
iVsIntro
.
wp_seq
.
wp_bind
(
wait
_
).
iApply
(
wait_spec
with
"[Hempty Hx2 Hlked]"
)
;
first
by
auto
.
{
iFrame
"Hh"
.
iFrame
"~"
.
iFrame
.
iIntros
(
y
)
"Hempty Hx HQ"
.
wp_let
.
wp_bind
(
release
_
).
iApply
release_spec
.
iFrame
"Hlk Hlked"
.
iSplitL
"Hempty Hx"
.

iExists
x
.
by
iFrame
.

by
wp_seq
.
iApply
(
wait_spec
with
"[Hempty Hfinished Ho2 Hlked]"
)
;
first
by
done
.
{
iFrame
"Hh"
.
iFrame
"#"
.
iFrame
.
iIntros
(
y3
)
"[Hempty Hissued] Hx %"
.
wp_let
.
wp_bind
(
release
_
).
iApply
pvs_wp
.
iInv
N
as
">[Hinv[HinvHinv]]"
"Hclose"
.

admit
.

admit
.

iDestruct
"Hinv"
as
(
x4
y4
)
"(Hp & _ & _ & Hfinished)"
.
iVs
(
"Hclose"
with
"[Hp Hempty]"
).
{
iNext
.
iLeft
.
iExists
y4
.
by
iFrame
.
}
iApply
release_spec
.
iFrame
"Hlk Hlked"
.
iSplitL
"Hissued Hfinished Hx"
.
{
iExists
x
.
by
iFrame
.
}
by
wp_seq
.
}
+
(* Impossible: reenter locked *)
iExFalso
.
admit
.
+
(*
Impossible: reenter locked
*)
iExFalso
.
admit
.
+
admit
.
+
admit
.

(*
server side
*)
Admitted
.
Write
Preview
Supports
Markdown
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