Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
E
examples
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Iris
examples
Commits
98ee891b
Commit
98ee891b
authored
Jun 13, 2018
by
Ralf Jung
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
prove stack push
parent
8ed6910d
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
109 additions
and
6 deletions
+109
-6
theories/logatom_stack/stack.v
theories/logatom_stack/stack.v
+109
-6
No files found.
theories/logatom_stack/stack.v
View file @
98ee891b
...
...
@@ -94,14 +94,27 @@ Section stack.
(
own
γ
s
(
◯
Excl'
l
))%
I
.
Global
Instance
stack_content_timeless
γ
s
l
:
Timeless
(
stack_content
γ
s
l
)
:
=
_
.
Fixpoint
list_inv
(
l
:
list
val
)
(
rep
:
val
)
:
iProp
:
=
Definition
stack_elem_to_val
(
stack_rep
:
option
loc
)
:
val
:
=
match
stack_rep
with
|
None
=>
NONEV
|
Some
l
=>
SOMEV
#
l
end
.
Local
Instance
stack_elem_to_val_inj
:
Inj
(=)
(=)
stack_elem_to_val
.
Proof
.
rewrite
/
Inj
/
stack_elem_to_val
=>??.
repeat
case_match
;
congruence
.
Qed
.
Fixpoint
list_inv
(
l
:
list
val
)
(
rep
:
option
loc
)
:
iProp
:
=
match
l
with
|
nil
=>
⌜
rep
=
NONEV
⌝
|
v
::
l
=>
∃
(
ℓ
:
loc
)
(
rep'
:
val
),
⌜
rep
=
SOMEV
#
ℓ⌝
∗
ℓ
↦
(
v
,
rep'
)
∗
list_inv
l
rep'
|
nil
=>
⌜
rep
=
None
⌝
|
v
::
l
=>
∃
(
ℓ
:
loc
)
(
rep'
:
option
loc
),
⌜
rep
=
Some
ℓ⌝
∗
ℓ
↦
(
v
,
stack_elem_to_val
rep'
)
∗
list_inv
l
rep'
end
%
I
.
Local
Hint
Extern
0
(
environments
.
envs_entails
_
(
list_inv
(
_::_
)
_
))
=>
simpl
.
Inductive
offer_state
:
=
OfferPending
|
OfferRevoked
|
OfferAccepted
|
OfferAcked
.
Local
Instance
:
Inhabited
offer_state
:
=
populate
OfferPending
.
Definition
offer_state_rep
(
st
:
offer_state
)
:
Z
:
=
match
st
with
|
OfferPending
=>
0
...
...
@@ -115,9 +128,11 @@ Section stack.
match
st
with
|
OfferPending
=>
P
|
OfferAccepted
=>
Q
|
_
=>
True
|
_
=>
own
γ
o
(
Excl
())
end
)%
I
.
Local
Hint
Extern
0
(
environments
.
envs_entails
_
(
offer_inv
_
_
_
_
))
=>
unfold
offer_inv
.
Definition
is_offer
(
γ
s
:
gname
)
(
offer_rep
:
option
(
val
*
loc
))
:
=
match
offer_rep
with
|
None
=>
True
...
...
@@ -136,9 +151,11 @@ Section stack.
Definition
stack_inv
(
γ
s
:
gname
)
(
head
:
loc
)
(
offer
:
loc
)
:
iProp
:
=
(
∃
stack_rep
offer_rep
l
,
own
γ
s
(
●
Excl'
l
)
∗
head
↦
stack_rep
∗
list_inv
l
stack_rep
∗
head
↦
stack_
elem_to_val
stack_
rep
∗
list_inv
l
stack_rep
∗
offer
↦
offer_to_val
offer_rep
∗
is_offer
γ
s
offer_rep
)%
I
.
Local
Hint
Extern
0
(
environments
.
envs_entails
_
(
stack_inv
_
_
_
))
=>
unfold
stack_inv
.
Definition
is_stack
(
γ
s
:
gname
)
(
s
:
val
)
:
iProp
:
=
(
∃
head
offer
:
loc
,
⌜
s
=
(#
head
,
#
offer
)%
V
⌝
∗
inv
protoN
(
stack_inv
γ
s
head
offer
))%
I
.
Global
Instance
is_stack_persistent
γ
s
s
:
Persistent
(
is_stack
γ
s
s
)
:
=
_
.
...
...
@@ -153,10 +170,96 @@ Section stack.
iMod
(
own_alloc
(
●
Excl'
[]
⋅
◯
Excl'
[]))
as
(
γ
s
)
"[Hs● Hs◯]"
.
{
apply
auth_valid_discrete_2
.
split
;
done
.
}
iMod
(
inv_alloc
protoN
_
(
stack_inv
γ
s
head
offer
)
with
"[-HΦ Hs◯]"
).
{
iNext
.
iExists
_
,
None
,
_
.
iFrame
.
done
.
}
{
iNext
.
iExists
None
,
None
,
_
.
iFrame
.
done
.
}
iApply
"HΦ"
.
iFrame
"Hs◯"
.
iModIntro
.
iExists
_
,
_
.
auto
.
Qed
.
Lemma
push_spec
γ
s
(
s
v
:
val
)
:
is_stack
γ
s
s
-
∗
<<<
∀
l
,
stack_content
γ
s
l
>>>
push
(
s
,
v
)
@
⊤
∖↑
stackN
<<<
stack_content
γ
s
(
v
::
l
),
RET
#()
>>>.
Proof
.
iIntros
"#Hinv"
(
Q
Φ
)
"HQ AU"
.
iDestruct
"Hinv"
as
(
head
offer
)
"[% #Hinv]"
.
subst
s
.
iL
ö
b
as
"IH"
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
(* Load the old head. *)
wp_apply
(
load_spec
with
"[HQ AU]"
)
;
first
by
iAccu
.
iAuIntro
.
iInv
protoN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hrem)"
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
iSplitL
;
first
by
eauto
10
with
iFrame
.
iIntros
"!> [HQ AU]"
.
clear
offer_rep
l
.
(* Go on. *)
wp_let
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
head_new
)
"Hhead_new"
.
wp_let
.
wp_proj
.
(* CAS to change the head. *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
by
destruct
stack_rep
|
iAccu
|].
iAuIntro
.
iInv
protoN
as
(
stack_rep'
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hoffer)"
.
iAaccIntro
with
"H↦"
;
first
eauto
10
with
iFrame
.
iIntros
"H↦"
.
destruct
(
decide
(
stack_elem_to_val
stack_rep'
=
stack_elem_to_val
stack_rep
))
as
[->%
stack_elem_to_val_inj
|
_
].
-
(* The CAS succeeded. Update everything accordingly. *)
iMod
"AU"
as
(
l'
)
"[Hl' [_ Hclose]]"
.
iDestruct
(
own_valid_2
with
"Hs● Hl'"
)
as
%[->%
Excl_included
%
leibniz_equiv
_
]%
auth_valid_discrete_2
.
iMod
(
own_update_2
with
"Hs● Hl'"
)
as
"[Hs● Hl']"
.
{
eapply
auth_update
,
option_local_update
,
(
exclusive_local_update
_
(
Excl
(
v
::
l
))).
done
.
}
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iModIntro
.
change
(
InjRV
#
head_new
)
with
(
stack_elem_to_val
(
Some
head_new
)).
iSplitR
"HΦ"
;
first
by
eauto
12
with
iFrame
.
iIntros
"Q"
.
wp_if
.
by
iApply
"HΦ"
.
-
(* The CAS failed, go on making an offer. *)
iModIntro
.
iSplitR
"AU"
;
first
by
eauto
8
with
iFrame
.
clear
stack_rep
stack_rep'
offer_rep
l
head_new
.
iIntros
"HQ"
.
wp_if
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
st_loc
)
"Hoffer_st"
.
wp_let
.
wp_let
.
wp_proj
.
(* Make the offer *)
wp_apply
(
store_spec
with
"[HQ]"
)
;
first
by
iAccu
.
iAuIntro
.
iInv
protoN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iMod
(
own_alloc
(
Excl
()))
as
(
γ
o
)
"Htok"
;
first
done
.
iDestruct
(
laterable
with
"AU"
)
as
(
AU_later
)
"[AU #AU_back]"
.
iMod
(
inv_alloc
offerN
_
(
offer_inv
st_loc
γ
o
AU_later
_
)
with
"[AU Hoffer_st]"
)
as
"#Hoinv"
.
{
iNext
.
iExists
OfferPending
.
iFrame
.
}
iIntros
"?"
.
iSplitR
"Htok"
.
{
iClear
"Hoffer"
.
iExists
_
,
(
Some
(
v
,
st_loc
)),
_
.
iFrame
.
rewrite
/
is_offer
/=.
iExists
_
,
_
,
_
.
iFrame
"AU_back Hoinv"
.
done
.
}
clear
stack_rep
offer_rep
l
.
iIntros
"!> HQ"
.
wp_let
.
(* Retract the offer. *)
wp_proj
.
wp_apply
(
store_spec
with
"[HQ]"
)
;
first
by
iAccu
.
iAuIntro
.
iInv
protoN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
iSplitR
"Htok"
.
{
iClear
"Hoffer"
.
iExists
_
,
None
,
_
.
iFrame
.
done
.
}
iIntros
"!> HQ"
.
wp_seq
.
clear
stack_rep
offer_rep
l
.
(* See if someone took it. *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
done
|
iAccu
|].
iAuIntro
.
iInv
offerN
as
(
offer_st
)
"[>Hst↦ Hst]"
.
iAaccIntro
with
"Hst↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hst↦"
.
destruct
offer_st
;
simpl
.
+
(* Offer was still pending, and we revoked it. Loop around and try again. *)
iModIntro
.
iSplitR
"Hst"
.
{
iNext
.
iExists
OfferRevoked
.
iFrame
.
}
iIntros
"HQ"
.
iDestruct
(
"AU_back"
with
"Hst"
)
as
">AU {AU_back Hoinv}"
.
clear
AU_later
.
wp_if
.
iApply
(
"IH"
with
"HQ AU"
).
+
(* Offer revoked by someone else? Impossible! *)
iDestruct
"Hst"
as
">Hst"
.
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
+
(* Offer got accepted by someone, awesome! We are done. *)
iModIntro
.
iSplitR
"Hst"
.
{
iNext
.
iExists
OfferAcked
.
iFrame
.
}
iIntros
"HQ"
.
wp_if
.
by
iApply
"Hst"
.
+
(* Offer got acked by someone else? Impossible! *)
iDestruct
"Hst"
as
">Hst"
.
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
Qed
.
End
stack
.
Global
Typeclasses
Opaque
stack_content
is_stack
.
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