Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Iris
examples
Commits
7c7bc060
Commit
7c7bc060
authored
Jun 18, 2018
by
Ralf Jung
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add abstract HoCAP-style spec and show that it implies the logically atomic one
parent
1835a90a
Changes
4
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
261 additions
and
31 deletions
+261
-31
_CoqProject
_CoqProject
+1
-0
theories/logatom_stack/hocap_spec.v
theories/logatom_stack/hocap_spec.v
+230
-0
theories/logatom_stack/spec.v
theories/logatom_stack/spec.v
+2
-2
theories/logatom_stack/stack.v
theories/logatom_stack/stack.v
+28
-29
No files found.
_CoqProject
View file @
7c7bc060
...
@@ -83,3 +83,4 @@ theories/hocap/parfib.v
...
@@ -83,3 +83,4 @@ theories/hocap/parfib.v
theories/logatom_stack/stack.v
theories/logatom_stack/stack.v
theories/logatom_stack/spec.v
theories/logatom_stack/spec.v
theories/logatom_stack/hocap_spec.v
theories/logatom_stack/hocap_spec.v
0 → 100644
View file @
7c7bc060
From
stdpp
Require
Import
namespaces
.
From
iris
.
algebra
Require
Import
excl
auth
list
.
From
iris
.
heap_lang
Require
Export
lifting
notation
.
From
iris
.
base_logic
.
lib
Require
Import
invariants
.
From
iris
.
program_logic
Require
Import
atomic
.
From
iris
.
heap_lang
Require
Import
proofmode
atomic_heap
.
From
iris_examples
.
logatom_stack
Require
spec
.
Set
Default
Proof
Using
"Type"
.
Module
logatom
:
=
logatom_stack
.
spec
.
(** A general HoCAP-style interface for a stack, modeled after the spec in
[hocap/abstract_bag.v]. There are two differences:
- We split [bag_contents] into an authoritative part and a fragment as this
slightly strnegthens the spec: The logically atomic spec only requires
[stack_content ∗ stack_content] to derive a contradiction, the abstract bag
spec requires to get *three* pieces which is only possible when actually
calling a bag operation.
- We also slightly weaken the spec by adding [make_laterable], which is needed
because logical atomicity can only capture laterable resources, which is
needed when implementing e.g. the elimination stack on top of an abstract
logically atomic heap. *)
Record
hocap_stack
{
Σ
}
`
{!
heapG
Σ
}
:
=
AtomicStack
{
(* -- operations -- *)
new_stack
:
val
;
push
:
val
;
pop
:
val
;
(* -- other data -- *)
name
:
Type
;
(* -- predicates -- *)
is_stack
(
N
:
namespace
)
(
γ
s
:
name
)
(
v
:
val
)
:
iProp
Σ
;
stack_content_frag
(
γ
s
:
name
)
(
l
:
list
val
)
:
iProp
Σ
;
stack_content_auth
(
γ
s
:
name
)
(
l
:
list
val
)
:
iProp
Σ
;
(* -- predicate properties -- *)
is_stack_persistent
N
γ
s
v
:
Persistent
(
is_stack
N
γ
s
v
)
;
stack_content_frag_timeless
γ
s
l
:
Timeless
(
stack_content_frag
γ
s
l
)
;
stack_content_auth_timeless
γ
s
l
:
Timeless
(
stack_content_auth
γ
s
l
)
;
stack_content_frag_exclusive
γ
s
l1
l2
:
stack_content_frag
γ
s
l1
-
∗
stack_content_frag
γ
s
l2
-
∗
False
;
stack_content_auth_exclusive
γ
s
l1
l2
:
stack_content_auth
γ
s
l1
-
∗
stack_content_auth
γ
s
l2
-
∗
False
;
stack_content_agree
γ
s
l1
l2
:
stack_content_frag
γ
s
l1
-
∗
stack_content_auth
γ
s
l2
-
∗
⌜
l1
=
l2
⌝
;
stack_content_update
γ
s
l
l'
:
stack_content_frag
γ
s
l
-
∗
stack_content_auth
γ
s
l
-
∗
|==>
stack_content_frag
γ
s
l'
∗
stack_content_auth
γ
s
l'
;
(* -- operation specs -- *)
new_stack_spec
N
:
{{{
True
}}}
new_stack
#()
{{{
γ
s
s
,
RET
s
;
is_stack
N
γ
s
s
∗
stack_content_frag
γ
s
[]
}}}
;
push_spec
N
γ
s
s
e
v
(
Φ
:
val
→
iProp
Σ
)
:
IntoVal
e
v
→
is_stack
N
γ
s
s
-
∗
make_laterable
(
∀
l
,
stack_content_auth
γ
s
l
={
⊤
∖↑
N
}=
∗
stack_content_auth
γ
s
(
v
::
l
)
∗
Φ
#())
-
∗
WP
push
(
s
,
e
)
{{
Φ
}}
;
pop_spec
N
γ
s
s
(
Φ
:
val
→
iProp
Σ
)
:
is_stack
N
γ
s
s
-
∗
make_laterable
(
∀
l
,
stack_content_auth
γ
s
l
={
⊤
∖↑
N
}=
∗
match
l
with
[]
=>
stack_content_auth
γ
s
[]
∗
Φ
NONEV
|
v
::
l'
=>
stack_content_auth
γ
s
l'
∗
Φ
(
SOMEV
v
)
end
)
-
∗
WP
pop
s
{{
Φ
}}
;
}.
Arguments
hocap_stack
_
{
_
}.
Existing
Instance
is_stack_persistent
.
Existing
Instance
stack_content_frag_timeless
.
Existing
Instance
stack_content_auth_timeless
.
(** Show that our way of writing the [pop_spec] is equivalent to what is done in
[concurrent_stack.spec]. IOW, the conjunction-vs-match doesn't matter. Fixing
the postcondition (the [Q] in [concurrent_stack.spec]) still matters. *)
Section
pop_equiv
.
Context
`
{
invG
Σ
}
(
T
:
Type
).
Lemma
pop_equiv
E
(
I
:
list
T
→
iProp
Σ
)
(
Φ
emp
:
iProp
Σ
)
(
Φ
ret
:
T
→
iProp
Σ
)
:
(
∀
l
,
I
l
={
E
}=
∗
match
l
with
[]
=>
I
[]
∗
Φ
emp
|
v
::
l'
=>
I
l'
∗
Φ
ret
v
end
)
⊣
⊢
(
∀
v
vs
,
I
(
v
::
vs
)
={
E
}=
∗
Φ
ret
v
∗
I
vs
)
∧
(
I
[]
={
E
}=
∗
Φ
emp
∗
I
[]).
Proof
.
iSplit
.
-
iIntros
"HΦ"
.
iSplit
.
+
iIntros
(??)
"HI"
.
iMod
(
"HΦ"
with
"HI"
)
as
"[$ $]"
.
done
.
+
iIntros
"HI"
.
iMod
(
"HΦ"
with
"HI"
)
as
"[$ $]"
.
done
.
-
iIntros
"HΦ"
(
l
)
"HI"
.
destruct
l
;
rewrite
[(
I
_
∗
_
)%
I
]
bi
.
sep_comm
;
by
iApply
"HΦ"
.
Qed
.
End
pop_equiv
.
(** From a HoCAP stack we can directly implement the logically atomic
interface. *)
Section
hocap_logatom
.
Context
`
{!
heapG
Σ
}
(
stack
:
hocap_stack
Σ
).
Lemma
logatom_push
N
γ
s
s
e
v
:
IntoVal
e
v
→
stack
.(
is_stack
)
N
γ
s
s
-
∗
<<<
∀
l
:
list
val
,
stack
.(
stack_content_frag
)
γ
s
l
>>>
stack
.(
push
)
(
s
,
e
)
@
⊤
∖↑
N
<<<
stack
.(
stack_content_frag
)
γ
s
(
v
::
l
),
RET
#()
>>>.
Proof
.
iIntros
(?)
"Hstack"
.
iApply
wp_atomic_intro
.
iIntros
(
Φ
)
"HΦ"
.
iApply
(
push_spec
with
"Hstack"
).
iApply
(
make_laterable_intro
with
"[%] [] HΦ"
).
iIntros
"!# >HΦ"
(
l
)
"Hauth"
.
iMod
"HΦ"
as
(
l'
)
"[Hfrag [_ Hclose]]"
.
iDestruct
(
stack_content_agree
with
"Hfrag Hauth"
)
as
%->.
iMod
(
stack_content_update
with
"Hfrag Hauth"
)
as
"[Hfrag $]"
.
iMod
(
"Hclose"
with
"Hfrag"
)
as
"HΦ"
.
done
.
Qed
.
Lemma
logatom_pop
N
γ
s
(
s
:
val
)
:
stack
.(
is_stack
)
N
γ
s
s
-
∗
<<<
∀
l
:
list
val
,
stack
.(
stack_content_frag
)
γ
s
l
>>>
stack
.(
pop
)
s
@
⊤
∖↑
N
<<<
stack
.(
stack_content_frag
)
γ
s
(
tail
l
),
RET
match
l
with
[]
=>
NONEV
|
v
::
_
=>
SOMEV
v
end
>>>.
Proof
.
iIntros
"Hstack"
.
iApply
wp_atomic_intro
.
iIntros
(
Φ
)
"HΦ"
.
iApply
(
pop_spec
with
"Hstack"
).
iApply
(
make_laterable_intro
with
"[%] [] HΦ"
).
iIntros
"!# >HΦ"
(
l
)
"Hauth"
.
iMod
"HΦ"
as
(
l'
)
"[Hfrag [_ Hclose]]"
.
iDestruct
(
stack_content_agree
with
"Hfrag Hauth"
)
as
%->.
destruct
l
;
iMod
(
stack_content_update
with
"Hfrag Hauth"
)
as
"[Hfrag $]"
;
iMod
(
"Hclose"
with
"Hfrag"
)
as
"HΦ"
;
done
.
Qed
.
Definition
hocap_logatom
:
logatom
.
atomic_stack
Σ
:
=
{|
logatom
.
new_stack_spec
:
=
stack
.(
new_stack_spec
)
;
logatom
.
push_spec
:
=
logatom_push
;
logatom
.
pop_spec
:
=
logatom_pop
;
logatom
.
stack_content_exclusive
:
=
stack
.(
stack_content_frag_exclusive
)
|}.
End
hocap_logatom
.
(** From a logically atomic stack, we can implement a HoCAP stack by adding an
auth invariant. *)
(** The CMRA & functor we need. *)
Class
hocapG
Σ
:
=
HocapG
{
hocap_stateG
:
>
inG
Σ
(
authR
(
optionUR
$
exclR
(
listC
valC
)))
;
}.
Definition
hocap
Σ
:
gFunctors
:
=
#[
GFunctor
(
exclR
unitC
)
;
GFunctor
(
authR
(
optionUR
$
exclR
(
listC
valC
)))].
Instance
subG_hocap
Σ
{
Σ
}
:
subG
hocap
Σ
Σ
→
hocapG
Σ
.
Proof
.
solve_inG
.
Qed
.
Section
logatom_hocap
.
Context
`
{!
heapG
Σ
}
`
{!
hocapG
Σ
}
(
stack
:
logatom
.
atomic_stack
Σ
).
Definition
hocap_name
:
Type
:
=
stack
.(
logatom
.
name
)
*
gname
.
Implicit
Types
γ
s
:
hocap_name
.
Definition
hocap_stack_content_auth
γ
s
l
:
iProp
Σ
:
=
own
γ
s
.
2
(
●
Excl'
l
).
Definition
hocap_stack_content_frag
γ
s
l
:
iProp
Σ
:
=
own
γ
s
.
2
(
◯
Excl'
l
).
Definition
hocap_is_stack
N
γ
s
v
:
iProp
Σ
:
=
(
stack
.(
logatom
.
is_stack
)
(
N
.@
"stack"
)
γ
s
.
1
v
∗
inv
(
N
.@
"wrapper"
)
(
∃
l
,
stack
.(
logatom
.
stack_content
)
γ
s
.
1
l
∗
hocap_stack_content_auth
γ
s
l
))%
I
.
Lemma
hocap_new_stack
N
:
{{{
True
}}}
stack
.(
logatom
.
new_stack
)
#()
{{{
γ
s
s
,
RET
s
;
hocap_is_stack
N
γ
s
s
∗
hocap_stack_content_frag
γ
s
[]
}}}.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
iApply
wp_fupd
.
iApply
logatom
.
new_stack_spec
;
first
done
.
iIntros
"!>"
(
γ
s
s
)
"[Hstack Hcont]"
.
iMod
(
own_alloc
(
●
Excl'
[]
⋅
◯
Excl'
[]))
as
(
γ
w
)
"[Hs● Hs◯]"
.
{
apply
auth_valid_discrete_2
.
split
;
done
.
}
iApply
(
"HΦ"
$!
(
γ
s
,
γ
w
)).
rewrite
/
hocap_is_stack
.
iFrame
.
iApply
inv_alloc
.
eauto
with
iFrame
.
Qed
.
Lemma
hocap_push
N
γ
s
s
e
v
(
Φ
:
val
→
iProp
Σ
)
:
IntoVal
e
v
→
hocap_is_stack
N
γ
s
s
-
∗
make_laterable
(
∀
l
,
hocap_stack_content_auth
γ
s
l
={
⊤
∖↑
N
}=
∗
hocap_stack_content_auth
γ
s
(
v
::
l
)
∗
Φ
#())
-
∗
WP
stack
.(
logatom
.
push
)
(
s
,
e
)
{{
Φ
}}.
Proof
using
Type
*.
iIntros
(?)
"#[Hstack Hwrap] Hupd"
.
iApply
(
logatom
.
push_spec
with
"Hstack"
)
;
first
iAccu
.
iAuIntro
.
iInv
"Hwrap"
as
(
l
)
"[>Hcont >H●]"
.
iAaccIntro
with
"Hcont"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hcont"
.
iMod
fupd_intro_mask'
as
"Hclose"
;
last
iMod
(
make_laterable_elim
with
"Hupd H●"
)
as
"[H● HΦ]"
;
first
solve_ndisj
.
iMod
"Hclose"
as
"_"
.
iIntros
"!>"
.
eauto
with
iFrame
.
Qed
.
Lemma
hocap_pop
N
γ
s
s
(
Φ
:
val
→
iProp
Σ
)
:
hocap_is_stack
N
γ
s
s
-
∗
make_laterable
(
∀
l
,
hocap_stack_content_auth
γ
s
l
={
⊤
∖↑
N
}=
∗
match
l
with
[]
=>
hocap_stack_content_auth
γ
s
[]
∗
Φ
NONEV
|
v
::
l'
=>
hocap_stack_content_auth
γ
s
l'
∗
Φ
(
SOMEV
v
)
end
)
-
∗
WP
stack
.(
logatom
.
pop
)
s
{{
Φ
}}.
Proof
using
Type
*.
iIntros
"#[Hstack Hwrap] Hupd"
.
iApply
(
logatom
.
pop_spec
with
"Hstack"
)
;
first
iAccu
.
iAuIntro
.
iInv
"Hwrap"
as
(
l
)
"[>Hcont >H●]"
.
iAaccIntro
with
"Hcont"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hcont"
.
destruct
l
.
-
iMod
fupd_intro_mask'
as
"Hclose"
;
last
iMod
(
make_laterable_elim
with
"Hupd H●"
)
as
"[H● HΦ]"
;
first
solve_ndisj
.
iMod
"Hclose"
as
"_"
.
iIntros
"!>"
;
eauto
with
iFrame
.
-
iMod
fupd_intro_mask'
as
"Hclose"
;
last
iMod
(
make_laterable_elim
with
"Hupd H●"
)
as
"[H● HΦ]"
;
first
solve_ndisj
.
iMod
"Hclose"
as
"_"
.
iIntros
"!>"
;
eauto
with
iFrame
.
Qed
.
Program
Definition
logatom_hocap
:
hocap_stack
Σ
:
=
{|
new_stack_spec
:
=
hocap_new_stack
;
push_spec
:
=
hocap_push
;
pop_spec
:
=
hocap_pop
|}.
Next
Obligation
.
iIntros
(???)
"Hf1 Hf2"
.
iDestruct
(
own_valid_2
with
"Hf1 Hf2"
)
as
%[].
Qed
.
Next
Obligation
.
iIntros
(???)
"Ha1 Ha2"
.
iDestruct
(
own_valid_2
with
"Ha1 Ha2"
)
as
%[].
Qed
.
Next
Obligation
.
iIntros
(???)
"Hf Ha"
.
iDestruct
(
own_valid_2
with
"Ha Hf"
)
as
%[->%
Excl_included
%
leibniz_equiv
_
]%
auth_valid_discrete_2
.
done
.
Qed
.
Next
Obligation
.
iIntros
(???)
"Hf Ha"
.
iMod
(
own_update_2
with
"Ha Hf"
)
as
"[? ?]"
.
{
eapply
auth_update
,
option_local_update
,
(
exclusive_local_update
_
(
Excl
_
)).
done
.
}
by
iFrame
.
Qed
.
End
logatom_hocap
.
theories/logatom_stack/spec.v
View file @
7c7bc060
...
@@ -25,12 +25,12 @@ Record atomic_stack {Σ} `{!heapG Σ} := AtomicStack {
...
@@ -25,12 +25,12 @@ Record atomic_stack {Σ} `{!heapG Σ} := AtomicStack {
push_spec
N
γ
s
s
e
v
:
push_spec
N
γ
s
s
e
v
:
IntoVal
e
v
→
IntoVal
e
v
→
is_stack
N
γ
s
s
-
∗
is_stack
N
γ
s
s
-
∗
<<<
∀
l
,
stack_content
γ
s
l
>>>
<<<
∀
l
:
list
val
,
stack_content
γ
s
l
>>>
push
(
s
,
e
)
@
⊤
∖↑
N
push
(
s
,
e
)
@
⊤
∖↑
N
<<<
stack_content
γ
s
(
v
::
l
),
RET
#()
>>>
;
<<<
stack_content
γ
s
(
v
::
l
),
RET
#()
>>>
;
pop_spec
N
γ
s
s
:
pop_spec
N
γ
s
s
:
is_stack
N
γ
s
s
-
∗
is_stack
N
γ
s
s
-
∗
<<<
∀
l
,
stack_content
γ
s
l
>>>
<<<
∀
l
:
list
val
,
stack_content
γ
s
l
>>>
pop
s
@
⊤
∖↑
N
pop
s
@
⊤
∖↑
N
<<<
stack_content
γ
s
(
tail
l
),
<<<
stack_content
γ
s
(
tail
l
),
RET
match
l
with
[]
=>
NONEV
|
v
::
_
=>
SOMEV
v
end
>>>
;
RET
match
l
with
[]
=>
NONEV
|
v
::
_
=>
SOMEV
v
end
>>>
;
...
...
theories/logatom_stack/stack.v
View file @
7c7bc060
...
@@ -186,25 +186,25 @@ Section stack.
...
@@ -186,25 +186,25 @@ Section stack.
Lemma
push_spec
γ
s
s
e
v
:
Lemma
push_spec
γ
s
s
e
v
:
IntoVal
e
v
→
IntoVal
e
v
→
is_stack
γ
s
s
-
∗
is_stack
γ
s
s
-
∗
<<<
∀
l
,
stack_content
γ
s
l
>>>
<<<
∀
l
:
list
val
,
stack_content
γ
s
l
>>>
push
(
s
,
e
)
@
⊤
∖↑
N
push
(
s
,
e
)
@
⊤
∖↑
N
<<<
stack_content
γ
s
(
v
::
l
),
RET
#()
>>>.
<<<
stack_content
γ
s
(
v
::
l
),
RET
#()
>>>.
Proof
.
Proof
.
intros
<-
.
iIntros
"#Hinv"
(
Q
Φ
)
"
HQ
AU"
.
i
I
ntros
(
<-
)
"#Hinv"
.
iApply
wp_atomic_intro
.
iIntros
(
Φ
)
"AU"
.
iDestruct
"Hinv"
as
(
head
offer
)
"[% #Hinv]"
.
subst
s
.
iDestruct
"Hinv"
as
(
head
offer
)
"[% #Hinv]"
.
subst
s
.
iL
ö
b
as
"IH"
.
iL
ö
b
as
"IH"
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
(* Load the old head. *)
(* Load the old head. *)
wp_apply
(
load_spec
with
"[
HQ
AU]"
)
;
first
by
iAccu
.
wp_apply
(
load_spec
with
"[AU]"
)
;
first
by
iAccu
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hrem)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hrem)"
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
iSplitL
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
iSplitL
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
[HQ
AU
]
"
.
clear
offer_rep
l
.
iIntros
"!> AU"
.
clear
offer_rep
l
.
(* Go on. *)
(* Go on. *)
wp_let
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
head_new
)
"Hhead_new"
.
wp_let
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
head_new
)
"Hhead_new"
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
(* CAS to change the head. *)
(* CAS to change the head. *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
by
destruct
stack_rep
|
iAccu
|].
wp_apply
cas_spec
;
[
by
destruct
stack_rep
|
iAccu
|].
iAuIntro
.
iInv
stackN
as
(
stack_rep'
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hoffer)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep'
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hoffer)"
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"H↦"
.
iIntros
"H↦"
.
...
@@ -219,15 +219,15 @@ Section stack.
...
@@ -219,15 +219,15 @@ Section stack.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iModIntro
.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iModIntro
.
change
(
InjRV
#
head_new
)
with
(
stack_elem_to_val
(
Some
head_new
)).
change
(
InjRV
#
head_new
)
with
(
stack_elem_to_val
(
Some
head_new
)).
iSplitR
"HΦ"
;
first
by
eauto
12
with
iFrame
.
iSplitR
"HΦ"
;
first
by
eauto
12
with
iFrame
.
iIntros
"
Q
"
.
wp_if
.
by
iApply
"HΦ"
.
iIntros
"
_
"
.
wp_if
.
by
iApply
"HΦ"
.
-
(* The CAS failed, go on making an offer. *)
-
(* The CAS failed, go on making an offer. *)
iModIntro
.
iSplitR
"AU"
;
first
by
eauto
8
with
iFrame
.
iModIntro
.
iSplitR
"AU"
;
first
by
eauto
8
with
iFrame
.
clear
stack_rep
stack_rep'
offer_rep
l
head_new
.
clear
stack_rep
stack_rep'
offer_rep
l
head_new
.
iIntros
"H
Q
"
.
wp_if
.
iIntros
"H"
.
wp_if
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
st_loc
)
"Hoffer_st"
.
wp_apply
alloc_spec
;
first
done
.
iIntros
(
st_loc
)
"Hoffer_st"
.
wp_let
.
wp_let
.
wp_proj
.
wp_let
.
wp_let
.
wp_proj
.
(* Make the offer *)
(* Make the offer *)
wp_apply
(
store_spec
with
"[HQ]"
)
;
first
by
iAccu
.
wp_apply
store_spec
;
first
by
iAccu
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iMod
(
own_alloc
(
Excl
()))
as
(
γ
o
)
"Htok"
;
first
done
.
iMod
(
own_alloc
(
Excl
()))
as
(
γ
o
)
"Htok"
;
first
done
.
...
@@ -238,33 +238,33 @@ Section stack.
...
@@ -238,33 +238,33 @@ Section stack.
{
iClear
"Hoffer"
.
iExists
_
,
(
Some
(
v
,
st_loc
)),
_
.
iFrame
.
{
iClear
"Hoffer"
.
iExists
_
,
(
Some
(
v
,
st_loc
)),
_
.
iFrame
.
rewrite
/
is_offer
/=.
iExists
_
,
_
,
_
.
iFrame
"AU_back Hoinv"
.
done
.
}
rewrite
/
is_offer
/=.
iExists
_
,
_
,
_
.
iFrame
"AU_back Hoinv"
.
done
.
}
clear
stack_rep
offer_rep
l
.
clear
stack_rep
offer_rep
l
.
iIntros
"!>
HQ
"
.
wp_let
.
iIntros
"!>
_
"
.
wp_let
.
(* Retract the offer. *)
(* Retract the offer. *)
wp_proj
.
wp_apply
(
store_spec
with
"[HQ]"
)
;
first
by
iAccu
.
wp_proj
.
wp_apply
store_spec
;
first
by
iAccu
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(Hs● & >H↦ & Hlist & >Hoffer↦ & Hoffer)"
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"Hoffer↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
iSplitR
"Htok"
.
iIntros
"?"
.
iSplitR
"Htok"
.
{
iClear
"Hoffer"
.
iExists
_
,
None
,
_
.
iFrame
.
done
.
}
{
iClear
"Hoffer"
.
iExists
_
,
None
,
_
.
iFrame
.
done
.
}
iIntros
"!>
HQ
"
.
wp_seq
.
iIntros
"!>
_
"
.
wp_seq
.
clear
stack_rep
offer_rep
l
.
clear
stack_rep
offer_rep
l
.
(* See if someone took it. *)
(* See if someone took it. *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
done
|
iAccu
|].
wp_apply
cas_spec
;
[
done
|
iAccu
|].
iAuIntro
.
iInv
offerN
as
(
offer_st
)
"[>Hst↦ Hst]"
.
iAuIntro
.
iInv
offerN
as
(
offer_st
)
"[>Hst↦ Hst]"
.
iAaccIntro
with
"Hst↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"Hst↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hst↦"
.
destruct
offer_st
;
simpl
.
iIntros
"Hst↦"
.
destruct
offer_st
;
simpl
.
+
(* Offer was still pending, and we revoked it. Loop around and try again. *)
+
(* Offer was still pending, and we revoked it. Loop around and try again. *)
iModIntro
.
iSplitR
"Hst"
.
iModIntro
.
iSplitR
"Hst"
.
{
iNext
.
iExists
OfferRevoked
.
iFrame
.
}
{
iNext
.
iExists
OfferRevoked
.
iFrame
.
}
iIntros
"
HQ
"
.
iIntros
"
_
"
.
iDestruct
(
"AU_back"
with
"Hst"
)
as
">AU {AU_back Hoinv}"
.
clear
AU_later
.
iDestruct
(
"AU_back"
with
"Hst"
)
as
">AU {AU_back Hoinv}"
.
clear
AU_later
.
wp_if
.
iApply
(
"IH"
with
"
HQ
AU"
).
wp_if
.
iApply
(
"IH"
with
"AU"
).
+
(* Offer revoked by someone else? Impossible! *)
+
(* Offer revoked by someone else? Impossible! *)
iDestruct
"Hst"
as
">Hst"
.
iDestruct
"Hst"
as
">Hst"
.
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
+
(* Offer got accepted by someone, awesome! We are done. *)
+
(* Offer got accepted by someone, awesome! We are done. *)
iModIntro
.
iSplitR
"Hst"
.
iModIntro
.
iSplitR
"Hst"
.
{
iNext
.
iExists
OfferAcked
.
iFrame
.
}
{
iNext
.
iExists
OfferAcked
.
iFrame
.
}
iIntros
"
HQ
"
.
wp_if
.
by
iApply
"Hst"
.
iIntros
"
_
"
.
wp_if
.
by
iApply
"Hst"
.
+
(* Offer got acked by someone else? Impossible! *)
+
(* Offer got acked by someone else? Impossible! *)
iDestruct
"Hst"
as
">Hst"
.
iDestruct
"Hst"
as
">Hst"
.
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
iDestruct
(
own_valid_2
with
"Htok Hst"
)
as
%[].
...
@@ -277,12 +277,12 @@ Section stack.
...
@@ -277,12 +277,12 @@ Section stack.
<<<
stack_content
γ
s
(
tail
l
),
<<<
stack_content
γ
s
(
tail
l
),
RET
match
l
with
[]
=>
NONEV
|
v
::
_
=>
SOMEV
v
end
>>>.
RET
match
l
with
[]
=>
NONEV
|
v
::
_
=>
SOMEV
v
end
>>>.
Proof
.
Proof
.
iIntros
"#Hinv"
(
Q
Φ
)
"
HQ
AU"
.
iIntros
"#Hinv"
.
iApply
wp_atomic_intro
.
iIntros
(
Φ
)
"AU"
.
iDestruct
"Hinv"
as
(
head
offer
)
"[% #Hinv]"
.
subst
s
.
iDestruct
"Hinv"
as
(
head
offer
)
"[% #Hinv]"
.
subst
s
.
iL
ö
b
as
"IH"
.
iL
ö
b
as
"IH"
.
wp_let
.
wp_proj
.
wp_let
.
wp_proj
.
(* Load the old head *)
(* Load the old head *)
wp_apply
(
load_spec
with
"[HQ]"
)
;
first
by
iAccu
.
wp_apply
load_spec
;
first
by
iAccu
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hrem)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hrem)"
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"?"
.
destruct
l
as
[|
v
l
]
;
simpl
.
iIntros
"?"
.
destruct
l
as
[|
v
l
]
;
simpl
.
...
@@ -294,16 +294,16 @@ Section stack.
...
@@ -294,16 +294,16 @@ Section stack.
%[->%
Excl_included
%
leibniz_equiv
_
]%
auth_valid_discrete_2
.
%[->%
Excl_included
%
leibniz_equiv
_
]%
auth_valid_discrete_2
.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iSplitR
"HΦ"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"HΦ"
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
HQ
"
.
wp_match
.
by
iApply
"HΦ"
.
iIntros
"!>
_
"
.
wp_match
.
by
iApply
"HΦ"
.
-
(* Non-empty list, let's try to pop. *)
-
(* Non-empty list, let's try to pop. *)
iDestruct
"Hlist"
as
(
tail
q
rep
)
"[>% [[Htail Htail2] Hlist]]"
.
subst
stack_rep
.
iDestruct
"Hlist"
as
(
tail
q
rep
)
"[>% [[Htail Htail2] Hlist]]"
.
subst
stack_rep
.
iSplitR
"AU Htail"
;
first
by
eauto
15
with
iFrame
.
iSplitR
"AU Htail"
;
first
by
eauto
15
with
iFrame
.
clear
offer_rep
l
.
clear
offer_rep
l
.
iIntros
"!>
HQ
"
.
wp_match
.
iIntros
"!>
_
"
.
wp_match
.
wp_apply
(
atomic_wp_seq
$!
(
load_spec
_
)
with
"Htail"
).
wp_apply
(
atomic_wp_seq
$!
(
load_spec
_
)
with
"Htail"
).
iIntros
"Htail"
.
wp_let
.
wp_proj
.
wp_proj
.
iIntros
"Htail"
.
wp_let
.
wp_proj
.
wp_proj
.
(* CAS to change the head *)
(* CAS to change the head *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
done
|
iAccu
|].
wp_apply
cas_spec
;
[
done
|
iAccu
|].
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hrem)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & Hrem)"
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"H↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"H↦"
.
change
(
InjRV
#
tail
)
with
(
stack_elem_to_val
(
Some
tail
)).
iIntros
"H↦"
.
change
(
InjRV
#
tail
)
with
(
stack_elem_to_val
(
Some
tail
)).
...
@@ -323,23 +323,22 @@ Section stack.
...
@@ -323,23 +323,22 @@ Section stack.
{
eapply
auth_update
,
option_local_update
,
(
exclusive_local_update
_
(
Excl
_
)).
done
.
}
{
eapply
auth_update
,
option_local_update
,
(
exclusive_local_update
_
(
Excl
_
)).
done
.
}
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ {Htail Htail'}"
.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ {Htail Htail'}"
.
iSplitR
"HΦ"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"HΦ"
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
HQ
"
.
clear
q'
q
offer_rep
l
.
iIntros
"!>
_
"
.
clear
q'
q
offer_rep
l
.
wp_if
.
wp_proj
.
by
iApply
"HΦ"
.
wp_if
.
wp_proj
.
by
iApply
"HΦ"
.
+
(* CAS failed. Go on looking for an offer. *)
+
(* CAS failed. Go on looking for an offer. *)
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
HQ
"
.
wp_if
.
clear
rep
stack_rep
offer_rep
l
q
tail
v
.
iIntros
"!>
_
"
.
wp_if
.
clear
rep
stack_rep
offer_rep
l
q
tail
v
.
wp_proj
.
wp_proj
.
(* Load the offer pointer. *)
(* Load the offer pointer. *)
(* FIXME: [wp_apply (load_spec with "[HQ AU]"); first by iAccu.] here triggers an anomaly. *)
wp_apply
load_spec
;
first
by
iAccu
.
wp_apply
(
load_spec
with
"[HQ]"
)
;
first
by
iAccu
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & >Hoff↦ & #Hoff)"
.
iAuIntro
.
iInv
stackN
as
(
stack_rep
offer_rep
l
)
"(>Hs● & >H↦ & Hlist & >Hoff↦ & #Hoff)"
.
iAaccIntro
with
"Hoff↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"Hoff↦"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hoff↦"
.
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iIntros
"Hoff↦"
.
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
HQ
"
.
destruct
offer_rep
as
[[
v
offer_st_loc
]|]
;
last
first
.
iIntros
"!>
_
"
.
destruct
offer_rep
as
[[
v
offer_st_loc
]|]
;
last
first
.
{
(* No offer, just loop. *)
wp_match
.
iApply
(
"IH"
with
"
HQ
AU"
).
}
{
(* No offer, just loop. *)
wp_match
.
iApply
(
"IH"
with
"AU"
).
}
clear
l
stack_rep
.
wp_match
.
wp_proj
.
clear
l
stack_rep
.
wp_match
.
wp_proj
.
(* CAS to accept the offer. *)
(* CAS to accept the offer. *)
wp_apply
(
cas_spec
with
"[HQ]"
)
;
[
done
|
iAccu
|].
simpl
.
wp_apply
cas_spec
;
[
done
|
iAccu
|].
simpl
.
iAuIntro
.
iDestruct
"Hoff"
as
(
Poff
Qoff
γ
o
)
"[#Hoinv #AUoff]"
.
iAuIntro
.
iDestruct
"Hoff"
as
(
Poff
Qoff
γ
o
)
"[#Hoinv #AUoff]"
.
iInv
offerN
as
(
offer_st
)
"[>Hoff↦ Hoff]"
.
iInv
offerN
as
(
offer_st
)
"[>Hoff↦ Hoff]"
.
iAaccIntro
with
"Hoff↦"
;
first
by
eauto
10
with
iFrame
.
iAaccIntro
with
"Hoff↦"
;
first
by
eauto
10
with
iFrame
.
...
@@ -347,7 +346,7 @@ Section stack.
...
@@ -347,7 +346,7 @@ Section stack.
destruct
(
decide
(#(
offer_state_rep
offer_st
)
=
#
0
))
as
[
Heq
|
_
]
;
last
first
.
destruct
(
decide
(#(
offer_state_rep
offer_st
)
=
#
0
))
as
[
Heq
|
_
]
;
last
first
.
{
(* CAS failed, we don't do a thing. *)
{
(* CAS failed, we don't do a thing. *)
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"AU"
;
first
by
eauto
10
with
iFrame
.
iIntros
"!>
HQ
"
.
wp_if
.
iApply
(
"IH"
with
"
HQ
AU"
).
}
iIntros
"!>
_
"
.
wp_if
.
iApply
(
"IH"
with
"AU"
).
}
(* CAS succeeded! We accept and complete the offer. *)
(* CAS succeeded! We accept and complete the offer. *)
destruct
offer_st
;
try
done
;
[].
clear
Heq
.
destruct
offer_st
;
try
done
;
[].
clear
Heq
.
iMod
(
"AUoff"
with
"Hoff"
)
as
"{AUoff IH} AUoff"
.
iMod
(
"AUoff"
with
"Hoff"
)
as
"{AUoff IH} AUoff"
.
...
@@ -366,7 +365,7 @@ Section stack.
...
@@ -366,7 +365,7 @@ Section stack.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iMod
(
"Hclose"
with
"Hl'"
)
as
"HΦ"
.
iSplitR
"Hoff↦ HQoff HΦ"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"HΦ"
.
iSplitR
"Hoff↦ HQoff HΦ"
;
first
by
eauto
10
with
iFrame
.
iSplitR
"HΦ"
.
{
iIntros
"!> !> !>"
.
iExists
OfferAccepted
.
iFrame
.
}
{
iIntros
"!> !> !>"
.
iExists
OfferAccepted
.
iFrame
.
}
iIntros
"!> !>
HQ
"
.
wp_if
.
wp_proj
.
by
iApply
"HΦ"
.
iIntros
"!> !>
_
"
.
wp_if
.
wp_proj
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
End
stack
.
End
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