Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
FP
iris-atomic
Commits
5c18c7eb
Commit
5c18c7eb
authored
Sep 09, 2016
by
Zhen Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
redesign protocols
parent
d344c353
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
60 additions
and
66 deletions
+60
-66
misc.v
misc.v
+6
-6
srv.v
srv.v
+54
-60
No files found.
misc.v
View file @
5c18c7eb
...
@@ -21,12 +21,12 @@ Section lemmas.
...
@@ -21,12 +21,12 @@ Section lemmas.
done
.
done
.
Qed
.
Qed
.
Lemma
pair_l_frac_op
(
g
g
'
:
val
)
:
Lemma
pair_l_frac_op
(
p
q
:
Qp
)
(
g
g
'
:
val
)
:
(((
(
1
/
2
)
%
Q
p
,
DecAgree
g
'
)
⋅
(
(
1
/
2
)
%
Qp
,
DecAgree
g
'
)))
~~>
(
1
%
Qp
,
DecAgree
g
'
).
(((
p
,
DecAgree
g
'
)
⋅
(
q
,
DecAgree
g
'
)))
~~>
(
(
p
+
q
)
%
Qp
,
DecAgree
g
'
).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
Qp_div_2
.
Qed
.
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
.
Qed
.
Lemma
pair_l_frac_op
'
(
g
g
'
:
val
)
:
Lemma
pair_l_frac_op
'
(
p
q
:
Qp
)
(
g
g
'
:
val
)
:
(
1
%
Qp
,
DecAgree
g
'
)
~~>
(((
(
1
/
2
)
%
Q
p
,
DecAgree
g
'
)
⋅
(
(
1
/
2
)
%
Qp
,
DecAgree
g
'
))).
(
(
p
+
q
)
%
Qp
,
DecAgree
g
'
)
~~>
(((
p
,
DecAgree
g
'
)
⋅
(
q
,
DecAgree
g
'
))).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
Qp_div_2
.
Qed
.
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
.
Qed
.
End
lemmas
.
End
lemmas
.
srv.v
View file @
5c18c7eb
...
@@ -60,52 +60,42 @@ Section proof.
...
@@ -60,52 +60,42 @@ Section proof.
Context
`
{!
heapG
Σ
,
!
lockG
Σ
,
!
srvG
Σ
}
(
N
:
namespace
).
Context
`
{!
heapG
Σ
,
!
lockG
Σ
,
!
srvG
Σ
}
(
N
:
namespace
).
Definition
srv_inv
Definition
srv_inv
(
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
:
gname
)
(
p
:
loc
)
(
γ
x
γ
1
γ
2
γ
3
γ
4
:
gname
)
(
p
:
loc
)
(
Q
:
val
→
val
→
Prop
)
:
iProp
Σ
:=
(
Q
:
val
→
val
→
Prop
)
:
iProp
Σ
:=
((
∃
(
x
:
val
),
p
↦
InjRV
x
★
own
γ
1
(
Excl
())
★
own
γ
3
(
Excl
()))
∨
((
∃
(
y
:
val
),
p
↦
InjRV
y
★
own
γ
1
(
Excl
())
★
own
γ
3
(
Excl
()))
∨
(
∃
(
x
y
:
val
),
p
↦
Inj
R
V
y
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
■
Q
x
y
★
own
γ
2
(
Excl
())
★
own
γ
3
(
Excl
()))
∨
(
∃
(
x
:
val
),
p
↦
Inj
L
V
x
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
own
γ
1
(
Excl
())
★
own
γ
4
(
Excl
()))
∨
(
∃
(
x
:
val
),
p
↦
InjLV
x
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
own
γ
5
(
Excl
())
★
own
γ
3
(
Excl
()))
∨
(
∃
(
x
:
val
),
p
↦
InjLV
x
★
own
γ
x
((
1
/
4
)
%
Qp
,
DecAgree
x
)
★
own
γ
2
(
Excl
())
★
own
γ
4
(
Excl
()))
∨
(
∃
(
x
:
val
),
p
↦
Inj
L
V
x
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
own
γ
5
(
Excl
())
★
own
γ
4
(
Excl
())))
%
I
.
(
∃
(
x
y
:
val
),
p
↦
Inj
R
V
y
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
■
Q
x
y
★
own
γ
1
(
Excl
())
★
own
γ
4
(
Excl
())))
%
I
.
Lemma
srv_inv_timeless
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
p
Q
:
TimelessP
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
p
Q
).
Lemma
srv_inv_timeless
γ
x
γ
1
γ
2
γ
3
γ
4
p
Q
:
TimelessP
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
p
Q
).
Proof
.
apply
_.
Qed
.
Proof
.
apply
_.
Qed
.
Lemma
wait_spec
(
Φ
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
Prop
)
x
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
p
:
Lemma
wait_spec
(
Φ
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
Prop
)
x
γ
x
γ
1
γ
2
γ
3
γ
4
p
:
heapN
⊥
N
→
heapN
⊥
N
→
heap_ctx
★
inv
N
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
p
Q
)
★
heap_ctx
★
inv
N
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
p
Q
)
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
own
γ
1
(
Excl
())
★
own
γ
5
(
Excl
())
★
own
γ
x
((
1
/
2
)
%
Qp
,
DecAgree
x
)
★
own
γ
3
(
Excl
())
★
(
∀
y
,
own
γ
2
(
Excl
())
-
★
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
-
★
■
Q
x
y
-
★
Φ
y
)
(
∀
y
,
own
γ
4
(
Excl
())
-
★
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
-
★
■
Q
x
y
-
★
Φ
y
)
⊢
WP
wait
#
p
{{
Φ
}}
.
⊢
WP
wait
#
p
{{
Φ
}}
.
Proof
.
Proof
.
iIntros
(
HN
)
"(#Hh & #Hsrv & Hx & H
empty & Hfinished
& HΦ)"
.
iIntros
(
HN
)
"(#Hh & #Hsrv & Hx & H
o3
& HΦ)"
.
iL
ö
b
as
"IH"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_bind
(
!
#
p
)
%
E
.
wp_rec
.
wp_bind
(
!
#
p
)
%
E
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
-
iExFalso
.
iDestruct
"Hinv"
as
(
?
)
"[_ [Ho1 _]]"
.
-
iExFalso
.
iDestruct
"Hinv"
as
(
?
)
"[_ [_ Ho3']]"
.
iCombine
"Hempty"
"Ho1"
as
"Hempty"
.
iCombine
"Ho3"
"Ho3'"
as
"Ho3"
.
by
iDestruct
(
own_valid
with
"Hempty"
)
as
"%"
.
by
iDestruct
(
own_valid
with
"Ho3"
)
as
"%"
.
-
iDestruct
"Hinv"
as
(
x
'
y
'
)
"(Hp & Hx' & % & Ho2 & Ho3)"
.
-
admit
.
-
admit
.
-
iDestruct
"Hinv"
as
(
x
'
y
'
)
"(Hp & Hx' & % & Ho1 & Ho4)"
.
destruct
(
decide
(
x
=
x
'
))
as
[
->|
Hneq
].
destruct
(
decide
(
x
=
x
'
))
as
[
->|
Hneq
].
+
wp_load
.
iVs
(
"Hclose"
with
"[Hp Hx' Ho2 Ho3]"
).
+
wp_load
.
iVs
(
"Hclose"
with
"[Hp Ho1 Ho3]"
).
{
iNext
.
rewrite
/
srv_inv
.
iRight
.
iLeft
.
iExists
x
'
,
y
'
.
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
y
'
.
by
iFrame
.
}
by
iFrame
.
}
iVsIntro
.
wp_match
.
iVsIntro
.
wp_match
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
iCombine
"Hx"
"Hx'"
as
"Hx"
.
*
admit
.
iDestruct
(
own_update
with
"Hx"
)
as
"==>Hx"
;
first
by
apply
pair_l_frac_op
.
*
iDestruct
"Hinv"
as
(
x
''
y
''
)
"(Hp & Hx'' & % & Ho2 & Ho3)"
.
rewrite
Qp_div_2
.
iVs
(
"Hclose"
with
"[Hp Hempty Ho3]"
).
iApply
(
"HΦ"
with
"Ho4 Hx"
).
done
.
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
y
''
.
by
iFrame
.
}
destruct
(
decide
(
x
'
=
x
''
))
as
[
->|
Hneq
].
{
iCombine
"Hx"
"Hx''"
as
"Hx"
.
iDestruct
(
own_update
with
"Hx"
)
as
"==>Hx"
;
first
by
apply
pair_l_frac_op
.
by
iApply
(
"HΦ"
with
"Ho2 Hx"
).
}
{
admit
.
}
*
admit
.
*
admit
.
+
admit
.
+
admit
.
-
admit
.
-
admit
.
Admitted
.
Admitted
.
Lemma
mk_srv_spec
(
f
:
val
)
Q
:
Lemma
mk_srv_spec
(
f
:
val
)
Q
:
...
@@ -115,23 +105,20 @@ Section proof.
...
@@ -115,23 +105,20 @@ Section proof.
Proof
.
Proof
.
iIntros
(
HN
)
"[#Hh #Hf]"
.
iIntros
(
HN
)
"[#Hh #Hf]"
.
wp_let
.
wp_alloc
p
as
"Hp"
.
wp_let
.
wp_alloc
p
as
"Hp"
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
1
)
"Hempty"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
1
)
"Ho1"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
2
)
"Hissued"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
2
)
"Ho2"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
3
)
"Hblack"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
3
)
"Ho3"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
4
)
"Hwhite"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
4
)
"Ho4"
;
first
done
.
iVs
(
own_alloc
(
Excl
()))
as
(
γ
5
)
"Hfinished"
;
first
done
.
iVs
(
own_alloc
(
1
%
Qp
,
DecAgree
#
0
))
as
(
γ
x
)
"Hx"
;
first
done
.
iVs
(
own_alloc
(
1
%
Qp
,
DecAgree
#
0
))
as
(
γ
x
)
"Hx"
;
first
done
.
iVs
(
inv_alloc
N
_
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
γ
5
p
Q
)
with
"[Hp H
empty Hblack
]"
)
as
"#?"
.
iVs
(
inv_alloc
N
_
(
srv_inv
γ
x
γ
1
γ
2
γ
3
γ
4
p
Q
)
with
"[Hp H
o1 Ho3
]"
)
as
"#?"
.
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
#
0.
by
iFrame
.
}
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
#
0.
by
iFrame
.
}
(
*
iVs
(
inv_alloc
N
_
(
own
γ
3
(
Excl
())
∨
own
γ
4
(
Excl
()))
%
I
with
"[Hwhite]"
)
as
"#Hsinv"
.
*
)
(
*
{
iNext
.
by
iRight
.
}
*
)
wp_let
.
wp_bind
(
newlock
_
).
wp_let
.
wp_bind
(
newlock
_
).
iApply
newlock_spec
=>
//. iFrame "Hh".
iApply
newlock_spec
=>
//. iFrame "Hh".
iAssert
(
∃
x
,
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
★
own
γ
2
(
Excl
())
★
own
γ
5
(
Excl
()
)
)
%
I
with
"[H
issued Hfinished
Hx]"
as
"Hinv"
.
iAssert
(
∃
x
,
own
γ
x
(
1
%
Qp
,
DecAgree
x
)
★
own
γ
4
(
Excl
()))
%
I
with
"[H
o4
Hx]"
as
"Hinv"
.
{
iExists
#
0.
by
iFrame
.
}
{
iExists
#
0.
by
iFrame
.
}
iFrame
"Hinv"
.
iIntros
(
lk
γ
lk
)
"#Hlk"
.
iFrame
"Hinv"
.
iIntros
(
lk
γ
lk
)
"#Hlk"
.
wp_let
.
wp_apply
wp_fork
.
wp_let
.
wp_apply
wp_fork
.
iSplitR
"H
white
"
.
iSplitR
"H
o2
"
.
-
(
*
(
*
client
closure
*
)
*
)
-
(
*
(
*
client
closure
*
)
*
)
(
*
iVsIntro
.
wp_seq
.
iVsIntro
.
*
)
(
*
iVsIntro
.
wp_seq
.
iVsIntro
.
*
)
(
*
iAlways
.
iIntros
(
x
).
*
)
(
*
iAlways
.
iIntros
(
x
).
*
)
...
@@ -176,26 +163,33 @@ Section proof.
...
@@ -176,26 +163,33 @@ Section proof.
iL
ö
b
as
"IH"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_let
.
wp_bind
(
!
_
)
%
E
.
wp_rec
.
wp_let
.
wp_bind
(
!
_
)
%
E
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
+
iDestruct
"Hinv"
as
(
x
)
"[Hp Hrest]"
.
+
admit
.
wp_load
.
iVs
(
"Hclose"
with
"[Hp Hrest]"
).
+
iDestruct
"Hinv"
as
(
x
)
"(Hp & Hx & Ho1 & Ho4)"
.
{
iNext
.
rewrite
/
srv_inv
.
iLeft
.
iExists
x
.
by
iFrame
.
}
iAssert
(
|=
r
=>
own
γ
x
(((
1
/
4
)
%
Qp
,
DecAgree
x
)
⋅
((
1
/
4
)
%
Qp
,
DecAgree
x
)))
%
I
with
"[Hx]"
as
"==>[Hx1 Hx2]"
.
iVsIntro
.
wp_match
.
by
iApply
"IH"
.
{
iDestruct
(
own_update
with
"Hx"
)
as
"Hx"
;
last
by
iAssumption
.
+
iDestruct
"Hinv"
as
(
x
y
)
"[Hp Hrest]"
.
replace
((
1
/
2
)
%
Qp
)
with
(
1
/
4
+
1
/
4
)
%
Qp
;
last
by
apply
Qp_div_S
.
wp_load
.
iVs
(
"Hclose"
with
"[Hp Hrest]"
).
by
apply
pair_l_frac_op
'
.
}
{
iNext
.
rewrite
/
srv_inv
.
iRight
.
iLeft
.
iExists
x
,
y
.
by
iFrame
.
}
wp_load
.
iVsIntro
.
wp_match
.
by
iApply
"IH"
.
iVs
(
"Hclose"
with
"[Hp Hx1 Ho2 Ho4]"
).
+
iDestruct
"Hinv"
as
(
x
)
"(Hp & Hx & Hfinished & Hblack)"
.
{
iNext
.
iRight
.
iRight
.
iLeft
.
iExists
x
.
by
iFrame
.
}
wp_load
.
iVs
(
"Hclose"
with
"[Hp Hx Hfinished Hwhite]"
).
{
iNext
.
rewrite
/
srv_inv
.
iRight
.
iRight
.
iRight
.
iExists
x
.
by
iFrame
.
}
iVsIntro
.
wp_match
.
iVsIntro
.
wp_match
.
wp_bind
(
_
<-
_
)
%
E
.
wp_bind
(
f
x
).
iApply
pvs_wp
.
iApply
wp_wand_r
.
iSplitR
;
first
by
iApply
"Hf"
.
iIntros
(
y
)
"%"
.
wp_value
.
iVsIntro
.
wp_bind
(
_
<-
_
)
%
E
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
iInv
N
as
">[Hinv|[Hinv|[Hinv|Hinv]]]"
"Hclose"
.
*
admit
.
*
admit
.
*
admit
.
*
admit
.
*
iDestruct
"Hinv"
as
(
x
'
)
"(Hp & Hx' & Ho2 & Ho4)"
.
destruct
(
decide
(
x
=
x
'
))
as
[
->|
Hneq
];
last
by
admit
.
wp_store
.
iCombine
"Hx2"
"Hx'"
as
"Hx"
.
iDestruct
(
own_update
with
"Hx"
)
as
"==>Hx"
;
first
by
apply
pair_l_frac_op
.
rewrite
Qp_div_S
.
iVs
(
"Hclose"
with
"[Hp Hx Ho1 Ho4]"
).
{
iNext
.
rewrite
/
srv_inv
.
iRight
.
iRight
.
iRight
.
iExists
x
'
,
y
.
by
iFrame
.
}
iVsIntro
.
wp_seq
.
iApply
(
"IH"
with
"Ho2"
).
*
admit
.
*
admit
.
*
iDestruct
"Hinv"
as
(
x
'
)
"(Hp & Hx & Hfinished & Hwhite)"
.
+
admit
.
iVs
(
"Hclose"
with
"[Hp Hx Hfinished Hblack]"
).
+
admit
.
Admitted
.
Admitted
.
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