Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
FP
iris-atomic
Commits
647edcec
Commit
647edcec
authored
Oct 11, 2016
by
Zhen Zhang
Browse files
Pull dependencies back
parent
b0f7bc5b
Changes
10
Hide whitespace changes
Inline
Side-by-side
Makefile.coq
View file @
647edcec
...
...
@@ -50,11 +50,11 @@ vo_to_obj = $(addsuffix .o,\
##########################
COQLIBS
?=
\
-Q
"."
fl
at
c
om
b
-Q
"."
iris_
atom
ic
COQCHKLIBS
?=
\
-R
"."
fl
at
c
om
b
-R
"."
iris_
atom
ic
COQDOCLIBS
?=
\
-R
"."
fl
at
c
om
b
-R
"."
iris_
atom
ic
##########################
# #
...
...
@@ -96,12 +96,13 @@ endif
# #
######################
VFILES
:=
simple_syn
c.v
\
pair_cas
.v
\
VFILES
:=
atomi
c.v
\
simple_sync
.v
\
flat.v
\
atomic_pair.v
\
atomic_sync.v
\
treiber.v
treiber.v
\
misc.v
ifneq
($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),)
-include
$(addsuffix .d,$(VFILES))
...
...
@@ -191,22 +192,22 @@ userinstall:
install
:
cd
"."
&&
for
i
in
$(VOFILES)
$(VFILES)
$(GLOBFILES)
$(NATIVEFILES)
$(CMOFILES)
$(CMIFILES)
$(CMAFILES)
;
do
\
install
-d
"
`
dirname
"
$(DSTROOT)
"
$(COQLIBINSTALL)
/
fl
at
c
om
b
/
$$
i
`
"
;
\
install
-m
0644
$$
i
"
$(DSTROOT)
"
$(COQLIBINSTALL)
/
fl
at
c
om
b
/
$$
i
;
\
install
-d
"
`
dirname
"
$(DSTROOT)
"
$(COQLIBINSTALL)
/
iris_
atom
ic
/
$$
i
`
"
;
\
install
-m
0644
$$
i
"
$(DSTROOT)
"
$(COQLIBINSTALL)
/
iris_
atom
ic
/
$$
i
;
\
done
install-doc
:
install
-d
"
$(DSTROOT)
"
$(COQDOCINSTALL)
/
fl
at
c
om
b
/html
install
-d
"
$(DSTROOT)
"
$(COQDOCINSTALL)
/
iris_
atom
ic
/html
for
i
in
html/
*
;
do
\
install
-m
0644
$$
i
"
$(DSTROOT)
"
$(COQDOCINSTALL)
/
fl
at
c
om
b
/
$$
i
;
\
install
-m
0644
$$
i
"
$(DSTROOT)
"
$(COQDOCINSTALL)
/
iris_
atom
ic
/
$$
i
;
\
done
uninstall_me.sh
:
Makefile
echo
'#!/bin/sh'
>
$@
printf
'cd "$
${DSTROOT}
"
$(COQLIBINSTALL)
/
fl
at
c
om
b
&& rm -f
$(VOFILES)
$(VFILES)
$(GLOBFILES)
$(NATIVEFILES)
$(CMOFILES)
$(CMIFILES)
$(CMAFILES)
&& find . -type d -and -empty -delete\ncd "$
${DSTROOT}
"
$(COQLIBINSTALL)
&& find "
fl
at
c
om
b
" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n'
>>
"
$@
"
printf
'cd "$
${DSTROOT}
"
$(COQDOCINSTALL)
/
fl
at
c
om
b
\\\n'
>>
"
$@
"
printf
'cd "$
${DSTROOT}
"
$(COQLIBINSTALL)
/
iris_
atom
ic
&& rm -f
$(VOFILES)
$(VFILES)
$(GLOBFILES)
$(NATIVEFILES)
$(CMOFILES)
$(CMIFILES)
$(CMAFILES)
&& find . -type d -and -empty -delete\ncd "$
${DSTROOT}
"
$(COQLIBINSTALL)
&& find "
iris_
atom
ic
" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n'
>>
"
$@
"
printf
'cd "$
${DSTROOT}
"
$(COQDOCINSTALL)
/
iris_
atom
ic
\\\n'
>>
"
$@
"
printf
'&& rm -f
$(
shell
find "html" -maxdepth 1 -and -type f -print
)
\n'
>>
"
$@
"
printf
'cd "$
${DSTROOT}
"
$(COQDOCINSTALL)
&& find
fl
at
c
om
b
/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n'
>>
"
$@
"
printf
'cd "$
${DSTROOT}
"
$(COQDOCINSTALL)
&& find
iris_
atom
ic
/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n'
>>
"
$@
"
chmod
+x
$@
uninstall
:
uninstall_me.sh
...
...
_CoqProject
View file @
647edcec
-Q . flatcomb
-Q . iris_atomic
atomic.v
simple_sync.v
pair_cas.v
flat.v
atomic_pair.v
atomic_sync.v
treiber.v
misc.v
atomic.v
0 → 100644
View file @
647edcec
From
iris
.
program_logic
Require
Export
hoare
weakestpre
pviewshifts
ownership
.
From
iris
.
algebra
Require
Import
upred_big_op
.
From
iris
.
prelude
Require
Export
coPset
.
From
iris
.
proofmode
Require
Import
tactics
.
Import
uPred
.
Section
atomic
.
Context
`
{
irisG
Λ
Σ
}
{
A
:
Type
}
.
(
*
logically
atomic
triple
:
<
x
,
α
>
e
@
E_i
,
E_o
<
v
,
β
x
v
>
*
)
Definition
atomic_triple
(
α
:
A
→
iProp
Σ
)
(
β
:
A
→
val
_
→
iProp
Σ
)
(
Ei
Eo
:
coPset
)
(
e
:
expr
_
)
:
iProp
Σ
:=
(
∀
P
Q
,
(
P
={
Eo
,
Ei
}=>
∃
x
:
A
,
α
x
★
((
α
x
={
Ei
,
Eo
}=
★
P
)
∧
(
∀
v
,
β
x
v
={
Ei
,
Eo
}=
★
Q
x
v
))
)
-
★
{{
P
}}
e
@
⊤
{{
v
,
(
∃
x
:
A
,
Q
x
v
)
}}
)
%
I
.
(
*
Weakest
-
pre
version
of
the
above
one
.
Also
weaker
in
some
sense
*
)
Definition
atomic_triple_wp
(
α
:
A
→
iProp
Σ
)
(
β
:
A
→
val
_
→
iProp
Σ
)
(
Ei
Eo
:
coPset
)
(
e
:
expr
_
)
:
iProp
Σ
:=
(
∀
P
Q
,
(
P
={
Eo
,
Ei
}=>
∃
x
,
α
x
★
((
α
x
={
Ei
,
Eo
}=
★
P
)
∧
(
∀
v
,
β
x
v
={
Ei
,
Eo
}=
★
Q
x
v
))
)
-
★
P
-
★
WP
e
@
⊤
{{
v
,
(
∃
x
,
Q
x
v
)
}}
)
%
I
.
Lemma
atomic_triple_weaken
α
β
Ei
Eo
e
:
atomic_triple
α
β
Ei
Eo
e
⊢
atomic_triple_wp
α
β
Ei
Eo
e
.
Proof
.
iIntros
"H"
.
iIntros
(
P
Q
)
"Hvs Hp"
.
by
iApply
(
"H"
$
!
P
Q
with
"Hvs"
).
Qed
.
Arguments
atomic_triple
{
_
}
_
_
_
_.
End
atomic
.
From
iris
.
heap_lang
Require
Export
lang
proofmode
notation
.
Section
incr
.
Context
`
{!
heapG
Σ
}
(
N
:
namespace
).
Definition
incr
:
val
:=
rec:
"incr"
"l"
:=
let:
"oldv"
:=
!
"l"
in
if:
CAS
"l"
"oldv"
(
"oldv"
+
#
1
)
then
"oldv"
(
*
return
old
value
if
success
*
)
else
"incr"
"l"
.
Global
Opaque
incr
.
(
*
TODO
:
Can
we
have
a
more
WP
-
style
definition
and
avoid
the
equality
?
*
)
Definition
incr_triple
(
l
:
loc
)
:=
atomic_triple
(
fun
(
v
:
Z
)
=>
l
↦
#
v
)
%
I
(
fun
v
ret
=>
ret
=
#
v
★
l
↦
#(
v
+
1
))
%
I
(
nclose
heapN
)
⊤
(
incr
#
l
).
Lemma
incr_atomic_spec
:
∀
(
l
:
loc
),
heapN
⊥
N
→
heap_ctx
⊢
incr_triple
l
.
Proof
.
iIntros
(
l
HN
)
"#?"
.
rewrite
/
incr_triple
.
rewrite
/
atomic_triple
.
iIntros
(
P
Q
)
"#Hvs"
.
iL
ö
b
as
"IH"
.
iIntros
"!# HP"
.
wp_rec
.
wp_bind
(
!
_
)
%
E
.
iVs
(
"Hvs"
with
"HP"
)
as
(
x
)
"[Hl [Hvs' _]]"
.
wp_load
.
iVs
(
"Hvs'"
with
"Hl"
)
as
"HP"
.
iVsIntro
.
wp_let
.
wp_bind
(
CAS
_
_
_
).
wp_op
.
iVs
(
"Hvs"
with
"HP"
)
as
(
x
'
)
"[Hl Hvs']"
.
destruct
(
decide
(
x
=
x
'
)).
-
subst
.
iDestruct
"Hvs'"
as
"[_ Hvs']"
.
iSpecialize
(
"Hvs'"
$
!
#
x
'
).
wp_cas_suc
.
iVs
(
"Hvs'"
with
"[Hl]"
)
as
"HQ"
;
first
by
iFrame
.
iVsIntro
.
wp_if
.
iVsIntro
.
by
iExists
x
'
.
-
iDestruct
"Hvs'"
as
"[Hvs' _]"
.
wp_cas_fail
.
iVs
(
"Hvs'"
with
"[Hl]"
)
as
"HP"
;
first
by
iFrame
.
iVsIntro
.
wp_if
.
by
iApply
"IH"
.
Qed
.
End
incr
.
From
iris
.
heap_lang
.
lib
Require
Import
par
.
Section
user
.
Context
`
{!
heapG
Σ
,
!
spawnG
Σ
}
(
N
:
namespace
).
Definition
incr_2
:
val
:=
λ
:
"x"
,
let:
"l"
:=
ref
"x"
in
incr
"l"
||
incr
"l"
;;
!
"l"
.
(
*
prove
that
incr
is
safe
w
.
r
.
t
.
data
race
.
TODO
:
prove
a
stronger
post
-
condition
*
)
Lemma
incr_2_safe
:
∀
(
x
:
Z
),
heapN
⊥
N
->
heap_ctx
⊢
WP
incr_2
#
x
{{
_
,
True
}}
.
Proof
.
iIntros
(
x
HN
)
"#Hh"
.
rewrite
/
incr_2
.
wp_let
.
wp_alloc
l
as
"Hl"
.
iVs
(
inv_alloc
N
_
(
∃
x
'
:
Z
,
l
↦
#
x
'
)
%
I
with
"[Hl]"
)
as
"#?"
;
first
eauto
.
wp_let
.
wp_bind
(
_
||
_
)
%
E
.
iApply
(
wp_par
(
λ
_
,
True
%
I
)
(
λ
_
,
True
%
I
)).
iFrame
"Hh"
.
(
*
prove
worker
triple
*
)
iDestruct
(
incr_atomic_spec
N
l
with
"Hh"
)
as
"Hincr"
=>
//.
rewrite
/
incr_triple
/
atomic_triple
.
iSpecialize
(
"Hincr"
$
!
True
%
I
(
fun
_
_
=>
True
%
I
)
with
"[]"
).
-
iIntros
"!# _"
.
(
*
open
the
invariant
*
)
iInv
N
as
(
x
'
)
">Hl'"
"Hclose"
.
(
*
mask
magic
*
)
iApply
pvs_intro
'
.
{
apply
ndisj_subseteq_difference
;
auto
.
}
iIntros
"Hvs"
.
iExists
x
'
.
iFrame
"Hl'"
.
iSplit
.
+
(
*
provide
a
way
to
rollback
*
)
iIntros
"Hl'"
.
iVs
"Hvs"
.
iVs
(
"Hclose"
with
"[Hl']"
);
eauto
.
+
(
*
provide
a
way
to
commit
*
)
iIntros
(
v
)
"[Heq Hl']"
.
iVs
"Hvs"
.
iVs
(
"Hclose"
with
"[Hl']"
);
eauto
.
-
iDestruct
"Hincr"
as
"#HIncr"
.
iSplitL
;
[
|
iSplitL
];
try
(
iApply
wp_wand_r
;
iSplitL
;
[
by
iApply
"HIncr"
|
auto
]).
iIntros
(
v1
v2
)
"_ !>"
.
wp_seq
.
iInv
N
as
(
x
'
)
">Hl"
"Hclose"
.
wp_load
.
iApply
"Hclose"
.
eauto
.
Qed
.
End
user
.
atomic_pair.v
View file @
647edcec
...
...
@@ -2,10 +2,8 @@ From iris.program_logic Require Export weakestpre hoare.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
.
lib
Require
Import
spin_lock
.
From
iris
.
tests
Require
Import
atomic
.
From
iris
.
algebra
Require
Import
dec_agree
frac
.
From
iris
.
program_logic
Require
Import
auth
.
From
flatcomb
Require
Import
sync
.
From
iris_atomic
Require
Import
atomic
sync
.
Import
uPred
.
Section
atomic_pair
.
...
...
atomic_sync.v
View file @
647edcec
...
...
@@ -2,9 +2,8 @@ From iris.program_logic Require Export weakestpre hoare.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
.
lib
Require
Import
spin_lock
.
From
iris
.
tests
Require
Import
atomic
misc
.
From
iris
.
algebra
Require
Import
dec_agree
frac
.
From
iris
.
program_log
ic
Require
Import
a
uth
.
From
iris
_atom
ic
Require
Import
a
tomic
misc
.
Definition
syncR
:=
prodR
fracR
(
dec_agreeR
val
).
Class
syncG
Σ
:=
sync_tokG
:>
inG
Σ
syncR
.
...
...
flat.v
View file @
647edcec
From
iris
.
program_logic
Require
Export
auth
weakestpre
saved_prop
.
From
iris
.
program_logic
Require
Export
weakestpre
saved_prop
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
.
lib
Require
Import
spin_lock
.
From
iris
.
algebra
Require
Import
upred
frac
agree
excl
dec_agree
upred_big_op
gset
gmap
.
From
iris
.
tests
Require
Import
misc
atomic
treiber_stack
.
Require
Import
flatcomb
.
atomic_sync
.
From
iris
.
algebra
Require
Import
auth
upred
frac
agree
excl
dec_agree
upred_big_op
gset
gmap
.
From
iris_atomic
Require
Import
misc
atomic
treiber
atomic_sync
.
Definition
doOp
:
val
:=
λ
:
"f"
"p"
,
...
...
@@ -168,8 +167,7 @@ Section proof.
iDestruct
(
evmap_alloc
_
_
_
m
p
(
γ
x
,
γ
1
,
γ
3
,
γ
4
,
γ
q
)
with
"[Hm]"
)
as
"==>[Hm1 Hm2]"
=>
//.
iDestruct
"Hl"
as
"[Hl1 Hl2]"
.
iVs
(
"Hclose"
with
"[HRm Hm1 Hl1 Hrs]"
).
+
iNext
.
iFrame
.
iExists
(
{
[
p
:=
(
1
%
Qp
,
DecAgree
(
γ
x
,
γ
1
,
γ
3
,
γ
4
,
γ
q
))]
}
⋅
m
).
iFrame
.
rewrite
<-
(
insert_singleton_op
m
)
=>
//.
+
iNext
.
iFrame
.
iExists
(
<
[
p
:=
(
1
%
Qp
,
DecAgree
(
γ
x
,
γ
1
,
γ
3
,
γ
4
,
γ
q
))]
>
m
).
iFrame
.
iDestruct
(
big_sepM_insert
_
m
with
"[-]"
)
as
"H"
=>
//.
iSplitL
"Hl1"
;
last
by
iAssumption
.
eauto
.
+
iDestruct
(
pack_ev
with
"Hm2"
)
as
"Hev"
.
...
...
misc.v
0 → 100644
View file @
647edcec
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
algebra
Require
Import
auth
frac
gmap
dec_agree
upred_big_op
.
From
iris
.
prelude
Require
Import
countable
.
Import
uPred
.
Section
lemmas
.
Lemma
op_some
:
∀
{
A
:
cmraT
}
(
a
b
:
A
),
Some
a
⋅
Some
b
=
Some
(
a
⋅
b
).
Proof
.
done
.
Qed
.
Lemma
invalid_plus
:
∀
(
q
:
Qp
),
¬
✓
(
1
+
q
)
%
Qp
.
Proof
.
intros
q
H
.
apply
(
Qp_not_plus_q_ge_1
q
).
done
.
Qed
.
Lemma
pair_l_frac_update
(
g
g
'
:
val
)
:
((
1
/
2
)
%
Qp
,
DecAgree
g
)
⋅
((
1
/
2
)
%
Qp
,
DecAgree
g
)
~~>
((
1
/
2
)
%
Qp
,
DecAgree
g
'
)
⋅
((
1
/
2
)
%
Qp
,
DecAgree
g
'
).
Proof
.
repeat
rewrite
pair_op
dec_agree_idemp
.
rewrite
frac_op
'
Qp_div_2
.
eapply
cmra_update_exclusive
.
done
.
Qed
.
Lemma
pair_l_frac_op
(
p
q
:
Qp
)
(
g
g
'
:
val
)
:
(((
p
,
DecAgree
g
'
)
⋅
(
q
,
DecAgree
g
'
)))
~~>
((
p
+
q
)
%
Qp
,
DecAgree
g
'
).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
.
Qed
.
Lemma
pair_l_frac_op
'
(
p
q
:
Qp
)
(
g
g
'
:
val
)
:
((
p
+
q
)
%
Qp
,
DecAgree
g
'
)
~~>
(((
p
,
DecAgree
g
'
)
⋅
(
q
,
DecAgree
g
'
))).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
.
Qed
.
Lemma
pair_l_frac_op_1
'
(
g
g
'
:
val
)
:
(
1
%
Qp
,
DecAgree
g
'
)
~~>
(((
1
/
2
)
%
Qp
,
DecAgree
g
'
)
⋅
((
1
/
2
)
%
Qp
,
DecAgree
g
'
)).
Proof
.
by
rewrite
pair_op
dec_agree_idemp
frac_op
'
Qp_div_2
.
Qed
.
End
lemmas
.
Section
excl
.
Context
`
{!
inG
Σ
(
exclR
unitC
)
}
.
Lemma
excl_falso
γ
Q
'
:
own
γ
(
Excl
())
★
own
γ
(
Excl
())
⊢
Q
'
.
Proof
.
iIntros
"[Ho1 Ho2]"
.
iCombine
"Ho1"
"Ho2"
as
"Ho"
.
iExFalso
.
by
iDestruct
(
own_valid
with
"Ho"
)
as
"%"
.
Qed
.
End
excl
.
Section
pair
.
Context
`
{
EqDecision
A
,
!
inG
Σ
(
prodR
fracR
(
dec_agreeR
A
))
}
.
Lemma
m_frag_agree
γ
m
(
q1
q2
:
Qp
)
(
a1
a2
:
A
)
:
own
γ
m
(
q1
,
DecAgree
a1
)
★
own
γ
m
(
q2
,
DecAgree
a2
)
⊢
|=
r
=>
own
γ
m
((
q1
+
q2
)
%
Qp
,
DecAgree
a1
)
★
(
a1
=
a2
).
Proof
.
iIntros
"[Ho Ho']"
.
destruct
(
decide
(
a1
=
a2
))
as
[
->|
Hneq
].
-
iSplitL
=>
//.
iCombine
"Ho"
"Ho'"
as
"Ho"
.
iDestruct
(
own_update
with
"Ho"
)
as
"?"
;
last
by
iAssumption
.
by
rewrite
pair_op
frac_op
'
dec_agree_idemp
.
-
iCombine
"Ho"
"Ho'"
as
"Ho"
.
iDestruct
(
own_valid
with
"Ho"
)
as
%
Hvalid
.
exfalso
.
destruct
Hvalid
as
[
_
Hvalid
].
simpl
in
Hvalid
.
apply
dec_agree_op_inv
in
Hvalid
.
inversion
Hvalid
.
subst
.
auto
.
Qed
.
End
pair
.
Section
evidence
.
Context
(
K
A
:
Type
)
`
{
Countable
K
,
EqDecision
A
}
.
Definition
evkR
:=
prodR
fracR
(
dec_agreeR
A
).
Definition
evmapR
:=
gmapUR
K
evkR
.
Definition
evidenceR
:=
authR
evmapR
.
Class
evidenceG
Σ
:=
EvidenceG
{
evidence_G
:>
inG
Σ
evidenceR
}
.
Definition
evidence
Σ
:
gFunctors
:=
#[
GFunctor
(
constRF
evidenceR
)
].
Instance
subG_evidence
Σ
{
Σ
}
:
subG
evidence
Σ
Σ
→
evidenceG
Σ
.
Proof
.
intros
[
?%
subG_inG
_
]
%
subG_inv
.
split
;
apply
_.
Qed
.
Lemma
map_agree_eq
m
m
'
(
hd
:
K
)
(
p
q
:
Qp
)
(
x
y
:
A
)
:
m
!!
hd
=
Some
(
p
,
DecAgree
y
)
→
m
=
{
[
hd
:=
(
q
,
DecAgree
x
)]
}
⋅
m
'
→
x
=
y
.
Proof
.
intros
H1
H2
.
destruct
(
decide
(
x
=
y
))
as
[
->|
Hneq
]
=>
//.
exfalso
.
subst
.
rewrite
lookup_op
lookup_singleton
in
H1
.
destruct
(
m
'
!!
hd
)
as
[[
b
[
c
|
]]
|
]
eqn
:
Heqn
;
rewrite
Heqn
in
H1
;
inversion
H1
=>
//.
destruct
(
decide
(
x
=
c
))
as
[
->|
Hneq3
]
=>
//.
-
rewrite
dec_agree_idemp
in
H3
.
by
inversion
H3
.
-
rewrite
dec_agree_ne
in
H3
=>
//.
Qed
.
Lemma
map_agree_somebot
m
m
'
(
hd
:
K
)
(
p
q
:
Qp
)
(
x
:
A
)
:
m
!!
hd
=
Some
(
p
,
DecAgreeBot
)
→
m
'
!!
hd
=
None
→
m
=
{
[
hd
:=
(
q
,
DecAgree
x
)]
}
⋅
m
'
→
False
.
Proof
.
intros
H1
H2
H3
.
subst
.
rewrite
lookup_op
lookup_singleton
in
H1
.
destruct
(
m
'
!!
hd
)
as
[[
b
[
c
|
]]
|
]
eqn
:
Heqn
;
rewrite
Heqn
in
H1
;
inversion
H1
=>
//.
Qed
.
Lemma
map_agree_none
m
m
'
(
hd
:
K
)
(
q
:
Qp
)
(
x
:
A
)
:
m
!!
hd
=
None
→
m
=
{
[
hd
:=
(
q
,
DecAgree
x
)]
}
⋅
m
'
→
False
.
Proof
.
intros
H1
H2
.
subst
.
rewrite
lookup_op
lookup_singleton
in
H1
.
destruct
(
m
'
!!
hd
)
=>
//.
Qed
.
Context
`
{!
inG
Σ
(
authR
evmapR
)
}
.
Definition
ev
γ
m
(
k
:
K
)
(
v
:
A
)
:=
(
∃
q
,
own
γ
m
(
◯
{
[
k
:=
(
q
,
DecAgree
v
)
]
}
))
%
I
.
Lemma
evmap_alloc
γ
m
m
k
v
:
m
!!
k
=
None
→
own
γ
m
(
●
m
)
⊢
|=
r
=>
own
γ
m
(
●
(
<
[
k
:=
(
1
%
Qp
,
DecAgree
v
)
]
>
m
)
⋅
◯
{
[
k
:=
(
1
%
Qp
,
DecAgree
v
)
]
}
).
Proof
.
iIntros
(
?
)
"Hm"
.
iDestruct
(
own_update
with
"Hm"
)
as
"?"
;
last
by
iAssumption
.
apply
auth_update_alloc
,
alloc_local_update
=>
//.
Qed
.
Lemma
map_agree_none
'
γ
m
m
hd
x
:
m
!!
hd
=
None
→
own
γ
m
(
●
m
)
★
ev
γ
m
hd
x
⊢
False
.
Proof
.
iIntros
(
?
)
"[Hom Hev]"
.
iDestruct
"Hev"
as
(
?
)
"Hfrag"
.
iCombine
"Hom"
"Hfrag"
as
"Hauth"
.
iDestruct
(
own_valid
γ
m
(
●
m
⋅
◯
{
[
hd
:=
(
_
,
DecAgree
x
)]
}
)
with
"[Hauth]"
)
as
%
Hvalid
=>
//.
iPureIntro
.
apply
auth_valid_discrete_2
in
Hvalid
as
[[
af
Compose
%
leibniz_equiv_iff
]
Valid
].
eapply
(
map_agree_none
m
)
=>
//.
Qed
.
Lemma
map_agree_eq
'
γ
m
m
hd
p
x
agy
:
m
!!
hd
=
Some
(
p
,
agy
)
→
own
γ
m
(
●
m
)
★
ev
γ
m
hd
x
⊢
own
γ
m
(
●
m
)
★
ev
γ
m
hd
x
★
DecAgree
x
=
agy
.
Proof
.
iIntros
(
?
)
"[Hom Hev]"
.
iDestruct
"Hev"
as
(
?
)
"Hfrag"
.
iCombine
"Hom"
"Hfrag"
as
"Hauth"
.
iDestruct
(
own_valid
γ
m
(
●
m
⋅
◯
{
[
hd
:=
(
_
,
DecAgree
x
)]
}
)
with
"[Hauth]"
)
as
%
Hvalid
=>
//.
apply
auth_valid_discrete_2
in
Hvalid
as
[[
af
Compose
%
leibniz_equiv_iff
]
Valid
].
destruct
agy
as
[
y
|
].
-
iDestruct
"Hauth"
as
"[? ?]"
.
iFrame
.
iSplitL
.
{
rewrite
/
ev
.
eauto
.
}
iPureIntro
.
destruct
(
decide
(
x
=
y
));
try
by
subst
.
exfalso
.
apply
n
.
eapply
(
map_agree_eq
m
)
=>
//. (* XXX: Why it is uPred M *)
-
iAssert
(
✓
m
)
%
I
as
"H"
=>
//. rewrite (gmap_validI m).
iDestruct
(
"H"
$
!
hd
)
as
"%"
.
exfalso
.
subst
.
rewrite
H0
in
H2
.
by
destruct
H2
as
[
?
?
].
Qed
.
Lemma
pack_ev
γ
m
k
v
q
:
own
γ
m
(
◯
{
[
k
:=
(
q
,
DecAgree
v
)
]
}
)
⊢
ev
γ
m
k
v
.
Proof
.
iIntros
"?"
.
rewrite
/
ev
.
eauto
.
Qed
.
Lemma
dup_ev
γ
m
hd
y
:
ev
γ
m
hd
y
⊢
|=
r
=>
ev
γ
m
hd
y
★
ev
γ
m
hd
y
.
Proof
.
rewrite
/
ev
.
iIntros
"Hev"
.
iDestruct
"Hev"
as
(
q
)
"Hev"
.
iAssert
(
|=
r
=>
own
γ
m
(
◯
{
[
hd
:=
((
q
/
2
)
%
Qp
,
DecAgree
y
)]
}
⋅
◯
{
[
hd
:=
((
q
/
2
)
%
Qp
,
DecAgree
y
)]
}
))
%
I
with
"[Hev]"
as
"==>[Hev1 Hev2]"
.
{
iDestruct
(
own_update
with
"Hev"
)
as
"?"
;
last
by
iAssumption
.
rewrite
<-
auth_frag_op
.
by
rewrite
op_singleton
pair_op
dec_agree_idemp
frac_op
'
Qp_div_2
.
}
iSplitL
"Hev1"
;
eauto
.
Qed
.
Lemma
evmap_frag_agree_split
γ
m
p
q1
q2
(
a1
a2
:
A
)
:
own
γ
m
(
◯
{
[
p
:=
(
q1
,
DecAgree
a1
)]
}
)
★
own
γ
m
(
◯
{
[
p
:=
(
q2
,
DecAgree
a2
)]
}
)
⊢
|=
r
=>
own
γ
m
(
◯
{
[
p
:=
(
q1
,
DecAgree
a1
)]
}
)
★
own
γ
m
(
◯
{
[
p
:=
(
q2
,
DecAgree
a1
)]
}
)
★
(
a1
=
a2
).
Proof
.
iIntros
"[Ho Ho']"
.
destruct
(
decide
(
a1
=
a2
))
as
[
->|
Hneq
].
-
by
iFrame
.
-
iCombine
"Ho"
"Ho'"
as
"Ho"
.
iDestruct
(
own_valid
with
"Ho"
)
as
%
Hvalid
.
exfalso
.
rewrite
<-
(
@
auth_frag_op
evmapR
)
in
Hvalid
.
rewrite
op_singleton
in
Hvalid
.
apply
auth_valid_discrete
in
Hvalid
.
simpl
in
Hvalid
.
apply
singleton_valid
in
Hvalid
.
destruct
Hvalid
as
[
_
Hvalid
].
apply
dec_agree_op_inv
in
Hvalid
.
inversion
Hvalid
.
subst
.
auto
.
Qed
.
Lemma
evmap_frag_agree
γ
m
p
q1
q2
(
a1
a2
:
A
)
:
own
γ
m
(
◯
{
[
p
:=
(
q1
,
DecAgree
a1
)]
}
)
★
own
γ
m
(
◯
{
[
p
:=
(
q2
,
DecAgree
a2
)]
}
)
⊢
|=
r
=>
own
γ
m
(
◯
{
[
p
:=
((
q1
+
q2
)
%
Qp
,
DecAgree
a1
)]
}
)
★
(
a1
=
a2
).
Proof
.
iIntros
"Hos"
.
iDestruct
(
evmap_frag_agree_split
with
"Hos"
)
as
"==>[Ho1 [Ho2 %]]"
.
iCombine
"Ho1"
"Ho2"
as
"Ho"
.
iSplitL
;
auto
.
iDestruct
(
own_update
with
"Ho"
)
as
"?"
;
last
by
iAssumption
.
rewrite
<-
(
@
auth_frag_op
evmapR
{
[
p
:=
(
q1
,
DecAgree
a1
)]
}
{
[
p
:=
(
q2
,
DecAgree
a1
)]
}
).
by
rewrite
op_singleton
pair_op
frac_op
'
dec_agree_idemp
.
Qed
.
Lemma
ev_agree
γ
m
k
v1
v2
:
ev
γ
m
k
v1
★
ev
γ
m
k
v2
⊢
|=
r
=>
ev
γ
m
k
v1
★
ev
γ
m
k
v1
★
v1
=
v2
.
Proof
.
iIntros
"[Hev1 Hev2]"
.
iDestruct
"Hev1"
as
(
?
)
"Hev1"
.
iDestruct
"Hev2"
as
(
?
)
"Hev2"
.
iDestruct
(
evmap_frag_agree_split
with
"[-]"
)
as
"==>[Hev1 [Hev2 %]]"
;
first
iFrame
.
subst
.
iSplitL
"Hev1"
;
rewrite
/
ev
;
eauto
.
Qed
.
End
evidence
.
Section
heap_extra
.
Context
`
{
heapG
Σ
}
.
Lemma
bogus_heap
p
(
q1
q2
:
Qp
)
a
b
:
~
((
q1
+
q2
)
%
Qp
≤
1
%
Qp
)
%
Qc
→
heap_ctx
★
p
↦
{
q1
}
a
★
p
↦
{
q2
}
b
⊢
False
.
Proof
.
iIntros
(
?
)
"(#Hh & Hp1 & Hp2)"
.
iCombine
"Hp1"
"Hp2"
as
"Hp"
.
iDestruct
(
heap_mapsto_op_1
with
"Hp"
)
as
"[_ Hp]"
.
rewrite
heap_mapsto_eq
.
iDestruct
(
own_valid
with
"Hp"
)
as
%
H
'
.
apply
singleton_valid
in
H
'
.
by
destruct
H
'
as
[
H
'
_
].
Qed
.
End
heap_extra
.
Section
big_op_later
.
Context
{
M
:
ucmraT
}
.
Context
`
{
Countable
K
}
{
A
:
Type
}
.
Implicit
Types
m
:
gmap
K
A
.
Implicit
Types
Φ
Ψ
:
K
→
A
→
uPred
M
.
Lemma
big_sepM_delete_later
Φ
m
i
x
:
m
!!
i
=
Some
x
→
▷
([
★
map
]
k
↦
y
∈
m
,
Φ
k
y
)
⊣⊢
▷
Φ
i
x
★
▷
[
★
map
]
k
↦
y
∈
delete
i
m
,
Φ
k
y
.
Proof
.
intros
?
.
rewrite
big_sepM_delete
=>
//. apply later_sep. Qed.
Lemma
big_sepM_insert_later
Φ
m
i
x
:
m
!!
i
=
None
→
▷
([
★
map
]
k
↦
y
∈
<
[
i
:=
x
]
>
m
,
Φ
k
y
)
⊣⊢
▷
Φ
i
x
★
▷
[
★
map
]
k
↦
y
∈
m
,
Φ
k
y
.
Proof
.
intros
?
.
rewrite
big_sepM_insert
=>
//. apply later_sep. Qed.
End
big_op_later
.
pair_cas.v
View file @
647edcec
...
...
@@ -3,7 +3,7 @@ From iris.heap_lang Require Export lang.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
.
lib
Require
Import
spin_lock
.
From
iris
.
algebra
Require
Import
excl
.
From
flatcomb
Require
Import
sync
.
Require
Import
iris_atomic
.
atomic_
sync
.
Import
uPred
.
(
*
CAS
,
load
and
store
to
pair
of
locations
*
)
...
...
simple_sync.v
View file @
647edcec
...
...
@@ -2,10 +2,8 @@ From iris.program_logic Require Export weakestpre hoare.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
.
lib
Require
Import
spin_lock
.
From
iris
.
tests
Require
Import
atomic
misc
.
From
iris
.
algebra
Require
Import
dec_agree
frac
.
From
iris
.
program_logic
Require
Import
auth
.
From
flatcomb
Require
Import
atomic_sync
.
From
iris_atomic
Require
Import
atomic
atomic_sync
.
Import
uPred
.
Definition
mk_sync
:
val
:=
...
...
treiber.v
View file @
647edcec
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
algebra
Require
Import
upred
gmap
dec_agree
upred_big_op
.
From
iris
.
program_logic
Require
Import
auth
.
From
iris
.
tests
Require
Import
treiber_stack
atomic
misc
.
From
iris
.
algebra
Require
Import
auth
upred
gmap
dec_agree
upred_big_op
.
From
iris_atomic
Require
Import
atomic
misc
.
Definition
new_stack
:
val
:=
λ
:
<>
,
ref
(
ref
NONE
).
Definition
push
:
val
:=
rec:
"push"
"s"
"x"
:=
let:
"hd"
:=
!
"s"
in
let:
"s'"
:=
ref
SOME
(
"x"
,
"hd"
)
in
if:
CAS
"s"
"hd"
"s'"
then
#()
else
"push"
"s"
"x"
.
Definition
pop
:
val
:=
rec:
"pop"
"s"
:=
let:
"hd"
:=
!
"s"
in
match:
!
"hd"
with
SOME
"cell"
=>
if:
CAS
"s"
"hd"
(
Snd
"cell"
)
then
SOME
(
Fst
"cell"
)
else
"pop"
"s"
|
NONE
=>
NONE
end
.
Definition
iter
:
val
:=
rec:
"iter"
"hd"
"f"
:=
match:
!
"hd"
with
NONE
=>
#()
|
SOME
"cell"
=>
"f"
(
Fst
"cell"
)
;;
"iter"
(
Snd
"cell"
)
"f"
end
.
Global
Opaque
new_stack
push
pop
iter
.
Section
proof
.
Context
`
{!
heapG
Σ
}
(
N
:
namespace
).
Fixpoint
is_list
(
hd
:
loc
)
(
xs
:
list
val
)
:
iProp
Σ
:=
match
xs
with
|
[]
=>
(
∃
q
,
hd
↦
{
q
}
NONEV
)
%
I
|
x
::
xs
=>
(
∃
(
hd
'
:
loc
)
q
,
hd
↦
{
q
}
SOMEV
(
x
,
#
hd
'
)
★
is_list
hd
'
xs
)
%
I
end
.
Lemma
dup_is_list
:
∀