Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
C
c
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Iris
c
Commits
b85484c9
Commit
b85484c9
authored
Feb 03, 2019
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
finish the store_strong example
parent
1ee95d7b
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
76 additions
and
57 deletions
+76
-57
_CoqProject
_CoqProject
+1
-0
store_strong.v
theories/tests/store_strong.v
+75
-57
No files found.
_CoqProject
View file @
b85484c9
...
...
@@ -24,3 +24,4 @@ theories/tests/fact.v
theories/tests/array_copy.v
theories/tests/gcd.v
theories/tests/par_inc.v
theories/tests/store_strong.v
theories/tests/store_strong.v
View file @
b85484c9
...
...
@@ -6,11 +6,11 @@ From iris.algebra Require Import frac_auth csum excl agree.
Definition
storeme
:
val
:=
λᶜ
"l"
,
c_ret
"l"
=
ᶜ
♯
10
;
ᶜ
♯
10
.
Definition
lol
:
val
:=
λᶜ
"l"
,
Definition
test
:
val
:=
λᶜ
"l"
,
call
ᶜ
(
c_ret
storeme
)
(
c_ret
"l"
)
+
ᶜ
(
c_ret
"l"
=
ᶜ
♯
11
).
Section
lol
.
Context
`
{
cmonadG
Σ
,
!
inG
Σ
(
frac_authR
natR
)}.
Section
test
.
Context
`
{
cmonadG
Σ
,
!
inG
Σ
(
authR
(
optionUR
(
exclR
boolC
))
)}.
Lemma
cwp_store_hard
R
Φ
Ψ
1
Ψ
2 e1
e2
:
CWP
e1
@
R
{{
Ψ
1
}}
-
∗
...
...
@@ -41,7 +41,7 @@ Section lol.
iEval
(
rewrite
-(
Z2Nat
.
id
(
cloc_offset
cl
))
//).
wp_apply
(
linsert_spec
with
"[//]"
);
[
eauto
|].
iIntros
(
ll'
Hl'
).
iApply
wp_fupd
.
wp_store
.
iMod
(
"Hclose"
$!
_
LLvl
with
"[//] Hl"
)
as
"[Hσ Hl]"
.
iMod
(
"Hclose"
$!
_
LLvl
with
"[//] Hl"
)
as
"[Hσ Hl]"
.
iMod
(
"HΦ"
with
"Hl"
)
as
"[$ $]"
.
iIntros
"!> !>"
.
iExists
({[(#(
cloc_base
cl
),
#(
cloc_offset
cl
))%
V
]}
∪
X
),
_.
iFrame
"Hσ Hlocks"
.
iPureIntro
.
rewrite
locked_locs_lock
.
set_solver
.
...
...
@@ -54,73 +54,91 @@ Section lol.
iIntros
"? H"
.
iApply
cwp_fun
;
simpl
.
vcg
;
iIntros
"? !>"
.
by
iApply
"H"
.
Qed
.
Definition
oneshotR
:=
csumR
(
exclR
unitR
)
(
agreeR
natC
).
Class
oneshotG
Σ
:=
{
oneshot_inG
:>
inG
Σ
oneshotR
}.
Definition
oneshot
Σ
:
gFunctors
:=
#[
GFunctor
oneshotR
].
Instance
subG_oneshot
Σ
{
Σ
}
:
subG
oneshot
Σ
Σ
→
oneshotG
Σ
.
Proof
.
solve_inG
.
Qed
.
Definition
pending
γ
`
{
oneshotG
Σ
}
:=
own
γ
(
Cinl
(
Excl
())).
Definition
shot
γ
n
`
{
oneshotG
Σ
}
:=
own
γ
(
Cinr
(
to_agree
n
)).
Lemma
new_pending
`
{
oneshotG
Σ
}
:
(|==>
∃
γ
,
pending
γ
)%
I
.
Proof
.
by
apply
own_alloc
.
Qed
.
Lemma
shoot
γ
m
`
{
oneshotG
Σ
}
:
pending
γ
==
∗
shot
γ
m
.
Definition
gpointsto
γ
(
b
:
bool
)
:=
own
γ
(
◯
(
Excl'
b
)).
Notation
"γ '≔' b"
:=
(
gpointsto
γ
b
)
(
at
level
80
).
Definition
gauth
γ
b
:=
own
γ
(
●
(
Excl'
b
)).
Lemma
gagree
γ
b1
b2
:
γ
≔
b1
-
∗
gauth
γ
b2
-
∗
⌜
b1
=
b2
⌝
.
Proof
.
apply
own_update
.
intros
n
[
f
|];
simpl
;
eauto
.
destruct
f
;
simpl
;
try
by
inversion
1
.
iIntros
"H1 H2"
.
by
iDestruct
(
own_valid_2
with
"H2 H1"
)
as
%[<-%
Excl_included
%
leibniz_equiv
_]%
auth_valid_discrete_2
.
Qed
.
Lemma
shot_not_pending
γ
b
`
{
oneshotG
Σ
}
:
shot
γ
b
-
∗
pending
γ
-
∗
False
.
Lemma
gnew
:
(|==>
∃
γ
,
gauth
γ
false
∗
γ
≔
false
)%
I
.
Proof
.
i
Intros
"Hs Hp"
.
iPoseProof
(
own_valid_2
with
"Hs Hp"
)
as
"H"
.
iDestruct
"H"
as
%[]
.
i
Mod
(
own_alloc
(
●
(
Excl'
false
)
⋅
◯
(
Excl'
false
)))%
I
as
(
γ
)
"[H1 H2]"
;
first
done
;
eauto
with
iFrame
.
Qed
.
Lemma
shot_agree
γ
m
n
`
{
oneshotG
Σ
}
:
shot
γ
m
-
∗
shot
γ
n
-
∗
⌜
m
=
n
⌝
.
Lemma
gupdate
b3
γ
b1
b2
:
γ
≔
b1
-
∗
gauth
γ
b2
==
∗
γ
≔
b3
∗
gauth
γ
b3
.
Proof
.
iIntros
"Hs Hs'"
.
iPoseProof
(
own_valid_2
with
"Hs Hs'"
)
as
"H"
.
rewrite
Cinr_op
/=.
by
iDestruct
"H"
as
%
LOL
%
agree_op_invL'
.
iIntros
"H1 H2"
.
iMod
(
own_update_2
with
"H2 H1"
)
as
"[? ?]"
.
{
apply
auth_update
,
option_local_update
.
by
apply
(
exclusive_local_update
(
Excl
b2
)
(
Excl
b3
)).
}
by
iFrame
.
Qed
.
Lemma
lol_spec
R
cl
`
{
oneshotG
Σ
}
:
Lemma
test_spec
R
cl
`
{
inG
Σ
testR
,
inG
Σ
fracR
}
:
cl
↦
C
#
0
%
nat
-
∗
CWP
lol
(
cloc_to_val
cl
)
@
R
{{
v
,
⌜
v
=
#
21
⌝
∧
CWP
"x"
←ᶜ
test
(
cloc_to_val
cl
);
ᶜ
c_ret
"x"
@
R
{{
v
,
⌜
v
=
#
21
⌝
∧
(
cl
↦
C
#
10
∨
cl
↦
C
#
11
)
}}.
Proof
.
iIntros
"Hl"
.
iApply
cwp_fun
.
iMod
(
own_alloc
(
●
!
0
%
nat
⋅
◯
!
0
%
nat
))
as
(
γ
)
"[Hγ [Hγ1 Hγ2]]"
;
[
done
|].
set
(
lol_inv
:=
((
cl
↦
C
#
0
∗
own
γ
(
●
!
0
%
nat
))
∨
(
cl
↦
C
#
10
∗
own
γ
(
●
!
10
%
nat
))
∨
(
cl
↦
C
[
LLvl
]
#
11
∗
own
γ
(
●
!
11
%
nat
))
iIntros
"Hl"
.
iApply
cwp_seq_bind
.
iApply
cwp_fun
.
simpl
.
iMod
gnew
as
(
γ
l
)
"[H1 lb]"
.
iMod
gnew
as
(
γ
r
)
"[H2 rb]"
.
set
(
test_inv
:=
(
∃
b1
b2
,
gauth
γ
l
b1
∗
gauth
γ
r
b2
∗
match
b1
,
b2
with
|
false
,
false
=>
cl
↦
C
#
0
|
true
,
false
=>
cl
↦
C
#
10
|
false
,
true
=>
cl
↦
C
[
LLvl
]
#
11
|
_,
_
=>
cl
↦
C
#
10
∨
cl
↦
C
[
LLvl
]
#
11
end
)%
I
).
iApply
(
cwp_insert_res
_
_
lol_inv
with
"[Hγ Hl]"
).
{
iNext
.
iLeft
.
eauto
with
iFrame
.
}
simpl
.
iApply
(
cwp_bin_op
_
_
(
λ
v
,
⌜
v
=
#
10
⌝
∗
own
γ
(
◯
!{
1
/
2
}
10
%
nat
))%
I
(
λ
v
,
⌜
v
=
#
11
⌝
∗
own
γ
(
◯
!{
1
/
2
}
11
%
nat
))%
I
with
"[Hγ1] [Hγ2]"
).
-
vcg
.
unfold
lol_inv
.
iIntros
"[H R]"
.
admit
.
iApply
(
cwp_insert_res
_
_
test_inv
with
"[H1 H2 Hl]"
).
{
iNext
.
iExists
false
,
false
.
iFrame
.
}
iApply
(
cwp_bin_op
_
_
(
λ
v
,
⌜
v
=
#
10
⌝
∗
γ
l
≔
true
)%
I
(
λ
v
,
⌜
v
=
#
11
⌝
∗
γ
r
≔
true
)%
I
with
"[lb] [rb]"
).
-
vcg
.
unfold
test_inv
.
iIntros
"[H R]"
.
iDestruct
"H"
as
(
b1
b2
)
"(H1 & H2 & H)"
.
iDestruct
(
gagree
with
"lb H1"
)
as
%<-.
destruct
b2
;
iNext
;
iModIntro
.
+
iMod
(
gupdate
true
with
"lb H1"
)
as
"[lb H1]"
.
iApply
(
storeme_spec
with
"H"
).
iIntros
"Hl"
.
iFrame
"R"
.
iSplitR
"lb"
;
last
by
(
vcg_continue
;
eauto
with
iFrame
).
iExists
_,_;
eauto
with
iFrame
.
+
iMod
(
gupdate
true
with
"lb H1"
)
as
"[lb H1]"
.
iApply
(
storeme_spec
with
"H"
).
iIntros
"Hl"
.
iFrame
"R"
.
iSplitR
"lb"
;
last
by
(
vcg_continue
;
eauto
with
iFrame
).
iExists
_,_;
eauto
with
iFrame
.
-
iApply
(
cwp_store_hard
_
_
(
λ
v
,
⌜
v
=
cloc_to_val
cl
⌝
)%
I
(
λ
v
,
⌜
v
=
#
11
⌝
)%
I
).
1
,
2
:
vcg
;
eauto
.
iIntros
(?
?
->
->)
"[H R]"
.
unfold
lol_inv
.
iDestruct
"H"
as
"[[Hcl H] | [[Hcl H] | [Hcl H]]]"
.
iIntros
(?
?
->
->)
"[H R]"
.
unfold
test_inv
.
iDestruct
"H"
as
(
b1
b2
)
"(H1 & H2 & H)"
.
iDestruct
(
gagree
with
"rb H2"
)
as
%<-.
destruct
b1
;
iEval
(
simpl
)
in
"H"
.
+
iExists
cl
,
_.
iFrame
.
iSplit
;
first
done
.
iIntros
"Hl"
.
iMod
(
own_update_2
with
"H Hγ2"
)
as
"[H Hγ2]"
.
{
apply
frac_auth_update
.
apply
(
nat_local_update
_
_
11
%
nat
11
%
nat
);
lia
.
}
iModIntro
.
iFrame
"Hγ2"
.
iSplit
;
last
done
.
iRight
.
iRight
.
iFrame
.
iIntros
"Hl"
.
iMod
(
gupdate
true
with
"rb H2"
)
as
"[rb H2]"
.
iModIntro
.
iSplitR
"rb"
;
last
by
eauto
with
iFrame
.
iExists
_,_;
eauto
with
iFrame
.
+
iExists
cl
,
_.
iFrame
.
iSplit
;
first
done
.
iIntros
"Hl"
.
iMod
(
own_update_2
with
"H Hγ2"
)
as
"[H Hγ2]"
.
{
apply
frac_auth_update
.
apply
(
nat_local_update
_
_
11
%
nat
1
%
nat
).
lia
.
}
iModIntro
.
Abort
.
End
lol
.
iIntros
"Hl"
.
iMod
(
gupdate
true
with
"rb H2"
)
as
"[rb H2]"
.
iModIntro
.
iSplitR
"rb"
;
last
by
eauto
with
iFrame
.
iExists
_,_;
eauto
with
iFrame
.
-
iIntros
(
v1
v2
)
"[% lb] [% rb]"
;
simplify_eq
/=.
iExists
#
21
;
simpl
.
iSplit
;
first
done
.
iIntros
"H"
.
iDestruct
"H"
as
(
b1
b2
)
"(H1 & H2 & H)"
.
do
3
iModIntro
.
iDestruct
(
gagree
with
"lb H1"
)
as
%<-.
iDestruct
(
gagree
with
"rb H2"
)
as
%<-.
iDestruct
"H"
as
"[H|H]"
;
iModIntro
;
vcg
;
eauto
with
iFrame
.
Qed
.
End
test
.
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