Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
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
2
Issues
2
List
Boards
Labels
Milestones
Merge Requests
3
Merge Requests
3
CI / CD
CI / CD
Pipelines
Jobs
Schedules
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
4107a238
Commit
4107a238
authored
Jan 25, 2019
by
Ralf Jung
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
prettify treiber stack
parent
a04b230a
Pipeline
#14062
failed with stage
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
27 additions
and
33 deletions
+27
33
theories/logatom/treiber.v
theories/logatom/treiber.v
+27
33
No files found.
theories/logatom/treiber.v
View file @
4107a238
...
@@ 87,87 +87,81 @@ Section proof.
...
@@ 87,87 +87,81 @@ Section proof.
Proof
.
generalize
hd
.
induction
xs
;
apply
_
.
Qed
.
Proof
.
generalize
hd
.
induction
xs
;
apply
_
.
Qed
.
Lemma
new_stack_spec
:
Lemma
new_stack_spec
:
∀
(
Φ
:
val
→
iProp
Σ
),
{{{
True
}}}
new_stack
#()
{{{
s
,
RET
#
s
;
is_stack
s
[]
}}}.
(
∀
s
,
is_stack
s
[]

∗
Φ
#
s
)
⊢
WP
new_stack
#()
{{
Φ
}}.
Proof
.
Proof
.
iIntros
(
Φ
)
"HΦ"
.
wp_lam
.
iIntros
(
Φ
)
"
_
HΦ"
.
wp_lam
.
wp_bind
(
ref
NONE
)%
E
.
wp_alloc
l
as
"Hl"
.
wp_bind
(
ref
NONE
)%
E
.
wp_alloc
l
as
"Hl"
.
wp_alloc
l'
as
"Hl'"
.
wp_alloc
l'
as
"Hl'"
.
iApply
"HΦ"
.
rewrite
/
is_stack
.
iExists
l
.
iApply
"HΦ"
.
rewrite
/
is_stack
.
iExists
l
.
iFrame
.
by
iExists
1
%
Qp
.
iFrame
.
by
iExists
1
%
Qp
.
Qed
.
Qed
.
Definition
push_triple
(
s
:
loc
)
(
x
:
val
)
:
=
<<<
∀
(
xs
:
list
val
)
(
hd
:
loc
),
s
↦
#
hd
∗
is_list
hd
xs
>>>
push
#
s
x
@
⊤
<<<
∃
hd'
:
loc
,
s
↦
#
hd'
∗
hd'
↦
SOMEV
(
x
,
#
hd
)
∗
is_list
hd
xs
,
RET
#()
>>>.
Lemma
push_atomic_spec
(
s
:
loc
)
(
x
:
val
)
:
Lemma
push_atomic_spec
(
s
:
loc
)
(
x
:
val
)
:
push_triple
s
x
.
<<<
∀
(
xs
:
list
val
),
is_stack
s
xs
>>>
push
#
s
x
@
⊤
<<<
is_stack
s
(
x
::
xs
),
RET
#()
>>>.
Proof
.
Proof
.
rewrite
/
push_triple
.
iApply
wp_atomic_intro
.
iApply
wp_atomic_intro
.
unfold
is_stack
.
iIntros
(
Φ
)
"HP"
.
iL
ö
b
as
"IH"
.
wp_rec
.
iIntros
(
Φ
)
"HP"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_let
.
wp_bind
(!
_
)%
E
.
wp_let
.
wp_bind
(!
_
)%
E
.
iMod
"HP"
as
(
xs
hd
)
"[[Hs Hhd] [Hvs' _]]"
.
iMod
"HP"
as
(
xs
)
"[Hxs [Hvs' _]]"
.
wp_load
.
iMod
(
"Hvs'"
with
"[Hs Hhd]"
)
as
"HP"
;
first
by
iFrame
.
iDestruct
"Hxs"
as
(
hd
)
"[Hs Hhd]"
.
wp_load
.
iMod
(
"Hvs'"
with
"[Hs Hhd]"
)
as
"HP"
;
first
by
eauto
with
iFrame
.
iModIntro
.
wp_let
.
wp_alloc
l
as
"Hl"
.
wp_let
.
iModIntro
.
wp_let
.
wp_alloc
l
as
"Hl"
.
wp_let
.
wp_bind
(
CAS
_
_
_
)%
E
.
wp_bind
(
CAS
_
_
_
)%
E
.
iMod
"HP"
as
(
xs'
hd'
)
"[[Hs Hhd'] Hvs']"
.
iMod
"HP"
as
(
xs'
)
"[Hxs' Hvs']"
.
iDestruct
"Hxs'"
as
(
hd'
)
"[Hs' Hhd']"
.
destruct
(
decide
(
hd
=
hd'
))
as
[>
Hneq
].
destruct
(
decide
(
hd
=
hd'
))
as
[>
Hneq
].
*
wp_cas_suc
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
*
wp_cas_suc
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HQ"
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HQ"
.
{
by
iFrame
.
}
{
by
eauto
with
iFrame
.
}
iModIntro
.
wp_if
.
eauto
.
iModIntro
.
wp_if
.
eauto
.
*
wp_cas_fail
.
*
wp_cas_fail
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HP"
;
first
by
iFrame
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HP"
;
first
by
eauto
with
iFrame
.
iModIntro
.
wp_if
.
by
iApply
"IH"
.
iModIntro
.
wp_if
.
by
iApply
"IH"
.
Qed
.
Qed
.
Definition
pop_triple
(
s
:
loc
)
:
=
Lemma
pop_atomic_spec
(
s
:
loc
)
:
<<<
∀
(
xs
:
list
val
)
(
hd
:
loc
),
s
↦
#
hd
∗
is_list
hd
xs
>>>
<<<
∀
(
xs
:
list
val
)
,
is_stack
s
xs
>>>
pop
#
s
@
⊤
pop
#
s
@
⊤
<<<
match
xs
with
[]
=>
s
↦
#
hd
∗
is_list
hd
[]
<<<
match
xs
with
[]
=>
is_stack
s
[]

x
::
xs'
=>
∃
q
(
hd'
:
loc
),
hd
↦
{
q
}
SOMEV
(
x
,
#
hd'
)
∗
s
↦
#
hd'
∗
is_list
hd'
xs'
end
,

x
::
xs'
=>
is_stack
s
xs'
end
,
RET
match
xs
with
[]
=>
NONEV

x
::
_
=>
SOMEV
x
end
>>>.
RET
match
xs
with
[]
=>
NONEV

x
::
_
=>
SOMEV
x
end
>>>.
Lemma
pop_atomic_spec
(
s
:
loc
)
:
pop_triple
s
.
Proof
.
Proof
.
rewrite
/
pop_triple
.
iApply
wp_atomic_intro
.
iApply
wp_atomic_intro
.
unfold
is_stack
.
iIntros
(
Φ
)
"HP"
.
iL
ö
b
as
"IH"
.
wp_rec
.
iIntros
(
Φ
)
"HP"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_bind
(!
_
)%
E
.
wp_bind
(!
_
)%
E
.
iMod
"HP"
as
(
xs
hd
)
"[[Hs Hhd] Hvs']"
.
iMod
"HP"
as
(
xs
)
"[Hxs Hvs']"
.
iDestruct
"Hxs"
as
(
hd
)
"[Hs Hhd]"
.
destruct
xs
as
[
y'
xs'
].
destruct
xs
as
[
y'
xs'
].

simpl
.
wp_load
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.

simpl
.
wp_load
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
iDestruct
"Hhd"
as
(
q
)
"[Hhd Hhd']"
.
iDestruct
"Hhd"
as
(
q
)
"[Hhd Hhd']"
.
iMod
(
"Hvs'"
with
"[Hhd]"
)
as
"HQ"
.
iMod
(
"Hvs'"
with
"[Hhd]"
)
as
"HQ"
.
{
iFrame
.
eauto
.
}
{
eauto
with
iFrame
.
}
iModIntro
.
wp_let
.
wp_load
.
wp_pures
.
iModIntro
.
wp_let
.
wp_load
.
wp_pures
.
eauto
.
eauto
.

simpl
.
iDestruct
"Hhd"
as
(
hd'
q
)
"([[Hhd1 Hhd2] Hhd'] & Hxs')"
.

simpl
.
iDestruct
"Hhd"
as
(
hd'
q
)
"([[Hhd1 Hhd2] Hhd'] & Hxs')"
.
iDestruct
(
dup_is_list
with
"[Hxs']"
)
as
"[Hxs1 Hxs2]"
;
first
by
iFrame
.
iDestruct
(
dup_is_list
with
"[Hxs']"
)
as
"[Hxs1 Hxs2]"
;
first
by
iFrame
.
wp_load
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
wp_load
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
iMod
(
"Hvs'"
with
"[Hhd1 Hhd2 Hxs1]"
)
as
"HP"
.
iMod
(
"Hvs'"
with
"[Hhd1 Hhd2 Hxs1]"
)
as
"HP"
.
{
iFrame
.
iExists
hd'
,
(
q
/
2
)%
Qp
.
by
iFrame
.
}
{
eauto
with
iFrame
.
}
iModIntro
.
wp_let
.
wp_load
.
wp_match
.
wp_proj
.
iModIntro
.
wp_let
.
wp_load
.
wp_match
.
wp_proj
.
wp_bind
(
CAS
_
_
_
).
wp_bind
(
CAS
_
_
_
).
iMod
"HP"
as
(
xs
hd''
)
"[[Hs Hhd''] Hvs']"
.
iMod
"HP"
as
(
xs''
)
"[Hxs'' Hvs']"
.
iDestruct
"Hxs''"
as
(
hd''
)
"[Hs'' Hhd'']"
.
destruct
(
decide
(
hd
=
hd''
))
as
[>
Hneq
].
destruct
(
decide
(
hd
=
hd''
))
as
[>
Hneq
].
+
wp_cas_suc
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
+
wp_cas_suc
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
destruct
xs
as
[
x
'
xs''
].
destruct
xs
''
as
[
x'
'
xs''
].
{
simpl
.
iDestruct
"Hhd''"
as
(?)
"H"
.
{
simpl
.
iDestruct
"Hhd''"
as
(?)
"H"
.
iExFalso
.
by
iDestruct
(@
mapsto_agree
with
"[$Hhd1] [$H]"
)
as
%?.
}
iExFalso
.
by
iDestruct
(@
mapsto_agree
with
"[$Hhd1] [$H]"
)
as
%?.
}
simpl
.
iDestruct
"Hhd''"
as
(
hd'''
?)
"(Hhd'' & Hxs'')"
.
simpl
.
iDestruct
"Hhd''"
as
(
hd'''
?)
"(Hhd'' & Hxs'')"
.
iDestruct
(@
mapsto_agree
with
"[$Hhd1] [$Hhd'']"
)
as
%[=].
subst
.
iDestruct
(@
mapsto_agree
with
"[$Hhd1] [$Hhd'']"
)
as
%[=].
subst
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HQ"
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HQ"
.
{
iExists
(
q
/
2
/
2
)%
Qp
,
_
.
{
eauto
with
iFrame
.
}
iDestruct
(
uniq_is_list
with
"[Hxs1 Hxs'']"
)
as
"%"
;
first
by
iFrame
.
subst
.
repeat
(
iSplitR
"Hxs1 Hs"
;
first
done
).
iFrame
.
}
iModIntro
.
wp_if
.
wp_pures
.
eauto
.
iModIntro
.
wp_if
.
wp_pures
.
eauto
.
+
wp_cas_fail
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
+
wp_cas_fail
.
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HP"
;
first
by
iFrame
.
iMod
(
"Hvs'"
with
"[]"
)
as
"HP"
;
first
by
eauto
with
iFrame
.
iModIntro
.
wp_if
.
by
iApply
"IH"
.
iModIntro
.
wp_if
.
by
iApply
"IH"
.
Qed
.
Qed
.
End
proof
.
End
proof
.
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