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
Iris
Iris
Commits
29c097c6
Commit
29c097c6
authored
Nov 16, 2016
by
Ralf Jung
Browse files
list-based agreement
parent
e1ef66ef
Pipeline
#3128
passed with stage
in 10 minutes and 27 seconds
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
algebra/agree.v
View file @
29c097c6
From
iris
.
algebra
Require
Export
cmra
.
From
iris
.
algebra
Require
Import
list
.
From
iris
.
base_logic
Require
Import
base_logic
.
Local
Hint
Extern
10
(
_
≤
_
)
=>
omega
.
Local
Arguments
validN
_
_
_
!
_
/.
Local
Arguments
valid
_
_
!
_
/.
Local
Arguments
op
_
_
_
!
_
/.
Local
Arguments
pcore
_
_
!
_
/.
Record
agree
(
A
:
Type
)
:
Type
:
=
Agree
{
agree_car
:
nat
→
A
;
agree_is_valid
:
nat
→
Prop
;
agree_valid_S
n
:
agree_is_valid
(
S
n
)
→
agree_is_valid
n
agree_car
:
A
;
agree_with
:
list
A
;
}.
Arguments
Agree
{
_
}
_
_
_
.
Arguments
agree_car
{
_
}
_
_
.
Arguments
agree_is_valid
{
_
}
_
_
.
Arguments
Agree
{
_
}
_
_
.
Arguments
agree_car
{
_
}
_
.
Arguments
agree_with
{
_
}
_
.
(* Some theory about set-inclusion on lists and lists of which all elements are equal.
TODO: Move this elsewhere. *)
Definition
list_setincl
`
(
R
:
relation
A
)
(
al
bl
:
list
A
)
:
=
∀
a
,
a
∈
al
→
∃
b
,
b
∈
bl
∧
R
a
b
.
Definition
list_setequiv
`
(
R
:
relation
A
)
(
al
bl
:
list
A
)
:
=
list_setincl
R
al
bl
∧
list_setincl
R
bl
al
.
(* list_agrees is carefully written such that, when applied to a singleton, it is convertible to True. This makes working with agreement much more pleasant. *)
Definition
list_agrees
`
(
R
:
relation
A
)
(
al
:
list
A
)
:
=
match
al
with
|
[]
=>
True
|
[
a
]
=>
True
|
a
::
al
=>
∀
b
,
b
∈
al
→
R
a
b
end
.
Lemma
list_agrees_alt
`
(
R
:
relation
A
)
`
{
Equivalence
_
R
}
al
:
list_agrees
R
al
↔
(
∀
a
b
,
a
∈
al
→
b
∈
al
→
R
a
b
).
Proof
.
destruct
al
as
[|
a
[|
b
al
]].
-
split
;
last
done
.
intros
_
?
?
[]%
elem_of_nil
.
-
split
;
last
done
.
intros
_
?
?
->%
elem_of_list_singleton
->%
elem_of_list_singleton
.
done
.
-
simpl
.
split
.
+
intros
Hl
a'
b'
[->|
Ha'
]%
elem_of_cons
.
*
intros
[->|
Hb'
]%
elem_of_cons
;
first
done
.
auto
.
*
intros
[->|
Hb'
]%
elem_of_cons
;
first
by
(
symmetry
;
auto
).
trans
a
;
last
by
auto
.
symmetry
.
auto
.
+
intros
Hl
b'
Hb'
.
apply
Hl
;
set_solver
.
Qed
.
Section
list_theory
.
Context
`
(
R
:
relation
A
)
`
{
Equivalence
A
R
}.
Global
Instance
:
PreOrder
(
list_setincl
R
).
Proof
.
split
.
-
intros
al
a
Ha
.
set_solver
.
-
intros
al
bl
cl
Hab
Hbc
a
Ha
.
destruct
(
Hab
_
Ha
)
as
(
b
&
Hb
&
Rab
).
destruct
(
Hbc
_
Hb
)
as
(
c
&
Hc
&
Rbc
).
exists
c
.
split
;
first
done
.
by
trans
b
.
Qed
.
Global
Instance
:
Equivalence
(
list_setequiv
R
).
Proof
.
split
.
-
by
split
.
-
intros
??
[??].
split
;
auto
.
-
intros
???
[??]
[??].
split
;
etrans
;
done
.
Qed
.
Global
Instance
list_setincl_subrel
`
(
R'
:
relation
A
)
:
subrelation
R
R'
→
subrelation
(
list_setincl
R
)
(
list_setincl
R'
).
Proof
.
intros
HRR'
al
bl
Hab
.
intros
a
Ha
.
destruct
(
Hab
_
Ha
)
as
(
b
&
Hb
&
HR
).
exists
b
.
split
;
first
done
.
exact
:
HRR'
.
Qed
.
Global
Instance
list_setequiv_subrel
`
(
R'
:
relation
A
)
:
subrelation
R
R'
→
subrelation
(
list_setequiv
R
)
(
list_setequiv
R'
).
Proof
.
intros
HRR'
??
[??].
split
;
exact
:
list_setincl_subrel
.
Qed
.
Global
Instance
list_setincl_perm
:
subrelation
(
≡
ₚ
)
(
list_setincl
R
).
Proof
.
intros
al
bl
Hab
a
Ha
.
exists
a
.
split
;
last
done
.
by
rewrite
-
Hab
.
Qed
.
Global
Instance
list_setincl_app
l
:
Proper
(
list_setincl
R
==>
list_setincl
R
)
(
app
l
).
Proof
.
intros
al
bl
Hab
a
[
Ha
|
Ha
]%
elem_of_app
.
-
exists
a
.
split
;
last
done
.
apply
elem_of_app
.
by
left
.
-
destruct
(
Hab
_
Ha
)
as
(
b
&
Hb
&
HR
).
exists
b
.
split
;
last
done
.
apply
elem_of_app
.
by
right
.
Qed
.
Global
Instance
list_setequiv_app
l
:
Proper
(
list_setequiv
R
==>
list_setequiv
R
)
(
app
l
).
Proof
.
intros
al
bl
[??].
split
;
apply
list_setincl_app
;
done
.
Qed
.
Global
Instance
:
subrelation
(
≡
ₚ
)
(
flip
(
list_setincl
R
)).
Proof
.
intros
???.
apply
list_setincl_perm
.
done
.
Qed
.
Global
Instance
list_agrees_setincl
:
Proper
(
flip
(
list_setincl
R
)
==>
impl
)
(
list_agrees
R
).
Proof
.
move
=>
al
bl
/=
Hab
/
list_agrees_alt
Hal
.
apply
(
list_agrees_alt
_
)
=>
a
b
Ha
Hb
.
destruct
(
Hab
_
Ha
)
as
(
a'
&
Ha'
&
HRa
).
destruct
(
Hab
_
Hb
)
as
(
b'
&
Hb'
&
HRb
).
trans
a'
;
first
done
.
etrans
;
last
done
.
eapply
Hal
;
done
.
Qed
.
Global
Instance
list_agrees_setequiv
:
Proper
(
list_setequiv
R
==>
iff
)
(
list_agrees
R
).
Proof
.
intros
??
[??].
split
;
by
apply
:
list_agrees_setincl
.
Qed
.
Lemma
list_setincl_contains
al
bl
:
(
∀
x
,
x
∈
al
→
x
∈
bl
)
→
list_setincl
R
al
bl
.
Proof
.
intros
Hin
a
Ha
.
exists
a
.
split
;
last
done
.
naive_solver
.
Qed
.
Lemma
list_setequiv_equiv
al
bl
:
(
∀
x
,
x
∈
al
↔
x
∈
bl
)
→
list_setequiv
R
al
bl
.
Proof
.
intros
Hin
.
split
;
apply
list_setincl_contains
;
naive_solver
.
Qed
.
Lemma
list_agrees_contains
al
bl
:
(
∀
x
,
x
∈
bl
→
x
∈
al
)
→
list_agrees
R
al
→
list_agrees
R
bl
.
Proof
.
intros
?.
by
eapply
(
list_agrees_setincl
_
),
list_setincl_contains
.
Qed
.
Lemma
list_agrees_equiv
al
bl
:
(
∀
x
,
x
∈
bl
↔
x
∈
al
)
→
list_agrees
R
al
↔
list_agrees
R
bl
.
Proof
.
intros
?.
by
eapply
(
list_agrees_setequiv
_
),
list_setequiv_equiv
.
Qed
.
Lemma
list_setincl_singleton
a
b
:
R
a
b
→
list_setincl
R
[
a
]
[
b
].
Proof
.
intros
HR
c
->%
elem_of_list_singleton
.
exists
b
.
split
;
last
done
.
apply
elem_of_list_singleton
.
done
.
Qed
.
Lemma
list_setincl_singleton_rev
a
b
:
list_setincl
R
[
a
]
[
b
]
→
R
a
b
.
Proof
.
intros
Hl
.
destruct
(
Hl
a
)
as
(?
&
->%
elem_of_list_singleton
&
HR
)
;
last
done
.
by
apply
elem_of_list_singleton
.
Qed
.
Lemma
list_setequiv_singleton
a
b
:
R
a
b
→
list_setequiv
R
[
a
]
[
b
].
Proof
.
intros
?.
split
;
by
apply
list_setincl_singleton
.
Qed
.
Lemma
list_agrees_iff_setincl
al
a
:
a
∈
al
→
list_agrees
R
al
↔
list_setincl
R
al
[
a
].
Proof
.
intros
Hin
.
split
.
-
move
=>/
list_agrees_alt
Hl
b
Hb
.
exists
a
.
split
;
first
set_solver
+.
exact
:
Hl
.
-
intros
Hl
.
apply
(
list_agrees_alt
_
)=>
b
c
Hb
Hc
.
destruct
(
Hl
_
Hb
)
as
(?
&
->%
elem_of_list_singleton
&
?).
destruct
(
Hl
_
Hc
)
as
(?
&
->%
elem_of_list_singleton
&
?).
by
trans
a
.
Qed
.
Lemma
list_setincl_singleton_in
al
a
:
a
∈
al
→
list_setincl
R
[
a
]
al
.
Proof
.
intros
Hin
b
->%
elem_of_list_singleton
.
exists
a
.
split
;
done
.
Qed
.
Global
Instance
list_setincl_ext
:
subrelation
(
Forall2
R
)
(
list_setincl
R
).
Proof
.
move
=>
al
bl
.
induction
1
.
-
intros
?
[]%
elem_of_nil
.
-
intros
a
[->|
Ha
]%
elem_of_cons
.
+
eexists
.
split
;
first
constructor
.
done
.
+
destruct
(
IHForall2
_
Ha
)
as
(
b
&
?
&
?).
exists
b
.
split
;
first
by
constructor
.
done
.
Qed
.
Global
Instance
list_setequiv_ext
:
subrelation
(
Forall2
R
)
(
list_setequiv
R
).
Proof
.
move
=>
al
bl
?.
split
;
apply
list_setincl_ext
;
done
.
Qed
.
Lemma
list_agrees_subrel
`
(
R'
:
relation
A
)
`
{
Equivalence
_
R'
}
:
subrelation
R
R'
→
∀
l
,
list_agrees
R
l
→
list_agrees
R'
l
.
Proof
.
move
=>
HR
l
/
list_agrees_alt
Hl
.
apply
(
list_agrees_alt
_
)=>
a
b
Ha
Hb
.
by
apply
HR
,
Hl
.
Qed
.
Section
fmap
.
Context
`
(
R'
:
relation
B
)
(
f
:
A
→
B
)
{
Hf
:
Proper
(
R
==>
R'
)
f
}.
Global
Instance
list_setincl_fmap
:
Proper
(
list_setincl
R
==>
list_setincl
R'
)
(
fmap
f
).
Proof
.
intros
al
bl
Hab
a'
(
a
&
->
&
Ha
)%
elem_of_list_fmap
.
destruct
(
Hab
_
Ha
)
as
(
b
&
Hb
&
HR
).
exists
(
f
b
).
split
;
first
eapply
elem_of_list_fmap
;
eauto
.
Qed
.
Global
Instance
list_setequiv_fmap
:
Proper
(
list_setequiv
R
==>
list_setequiv
R'
)
(
fmap
f
).
Proof
.
intros
??
[??].
split
;
apply
list_setincl_fmap
;
done
.
Qed
.
Lemma
list_agrees_fmap
`
{
Equivalence
_
R'
}
al
:
list_agrees
R
al
→
list_agrees
R'
(
f
<$>
al
).
Proof
.
move
=>
/
list_agrees_alt
Hl
.
apply
<-(
list_agrees_alt
R'
)=>
a'
b'
.
intros
(
a
&
->
&
Ha
)%
elem_of_list_fmap
(
b
&
->
&
Hb
)%
elem_of_list_fmap
.
apply
Hf
.
exact
:
Hl
.
Qed
.
End
fmap
.
End
list_theory
.
Section
agree
.
Context
{
A
:
ofeT
}.
Instance
agree_validN
:
ValidN
(
agree
A
)
:
=
λ
n
x
,
agree_is_valid
x
n
∧
∀
n'
,
n'
≤
n
→
agree_car
x
n
≡
{
n'
}
≡
agree_car
x
n'
.
Instance
agree_valid
:
Valid
(
agree
A
)
:
=
λ
x
,
∀
n
,
✓
{
n
}
x
.
Definition
agree_list
(
x
:
agree
A
)
:
=
agree_car
x
::
agree_with
x
.
Lemma
agree_valid_le
n
n'
(
x
:
agree
A
)
:
agree_is_valid
x
n
→
n'
≤
n
→
agree_is_valid
x
n'
.
Proof
.
induction
2
;
eauto
using
agree_valid_S
.
Qed
.
Instance
agree_validN
:
ValidN
(
agree
A
)
:
=
λ
n
x
,
list_agrees
(
dist
n
)
(
agree_list
x
).
Instance
agree_valid
:
Valid
(
agree
A
)
:
=
λ
x
,
list_agrees
(
equiv
)
(
agree_list
x
).
Instance
agree_equiv
:
Equiv
(
agree
A
)
:
=
λ
x
y
,
(
∀
n
,
agree_is_valid
x
n
↔
agree_is_valid
y
n
)
∧
(
∀
n
,
agree_is_valid
x
n
→
agree_car
x
n
≡
{
n
}
≡
agree_car
y
n
).
Instance
agree_dist
:
Dist
(
agree
A
)
:
=
λ
n
x
y
,
(
∀
n'
,
n'
≤
n
→
agree_is_valid
x
n'
↔
agree_is_valid
y
n'
)
∧
(
∀
n'
,
n'
≤
n
→
agree_is_valid
x
n'
→
agree_car
x
n'
≡
{
n'
}
≡
agree_car
y
n'
).
list_setequiv
(
dist
n
)
(
agree_list
x
)
(
agree_list
y
).
Instance
agree_equiv
:
Equiv
(
agree
A
)
:
=
λ
x
y
,
∀
n
,
list_setequiv
(
dist
n
)
(
agree_list
x
)
(
agree_list
y
).
Definition
agree_dist_incl
n
(
x
y
:
agree
A
)
:
=
list_setincl
(
dist
n
)
(
agree_list
x
)
(
agree_list
y
).
Definition
agree_ofe_mixin
:
OfeMixin
(
agree
A
).
Proof
.
split
.
-
intros
x
y
;
split
.
+
by
intros
Hxy
n
;
split
;
intros
;
apply
Hxy
.
+
by
intros
Hxy
;
split
;
intros
;
apply
Hxy
with
n
.
-
split
.
+
by
split
.
+
by
intros
x
y
Hxy
;
split
;
intros
;
symmetry
;
apply
Hxy
;
auto
;
apply
Hxy
.
+
intros
x
y
z
Hxy
Hyz
;
split
;
intros
n'
;
intros
.
*
trans
(
agree_is_valid
y
n'
).
by
apply
Hxy
.
by
apply
Hyz
.
*
trans
(
agree_car
y
n'
).
by
apply
Hxy
.
by
apply
Hyz
,
Hxy
.
-
intros
n
x
y
Hxy
;
split
;
intros
;
apply
Hxy
;
auto
.
-
intros
x
y
;
split
;
intros
Hxy
;
done
.
-
split
;
rewrite
/
dist
/
agree_dist
;
intros
?
*.
+
reflexivity
.
+
by
symmetry
.
+
intros
.
etrans
;
eassumption
.
-
intros
???.
apply
list_setequiv_subrel
=>??.
apply
dist_S
.
Qed
.
Canonical
Structure
agreeC
:
=
OfeT
(
agree
A
)
agree_ofe_mixin
.
Program
Definition
agree_compl
:
Compl
agreeC
:
=
λ
c
,
{|
agree_car
n
:
=
agree_car
(
c
n
)
n
;
agree_is_valid
n
:
=
agree_is_valid
(
c
n
)
n
|}.
Next
Obligation
.
intros
c
n
?.
apply
(
chain_cauchy
c
n
(
S
n
)),
agree_valid_S
;
auto
.
Qed
.
Global
Program
Instance
agree_cofe
:
Cofe
agreeC
:
=
{|
compl
:
=
agree_compl
|}.
Next
Obligation
.
intros
n
c
;
apply
and_wlog_r
;
intros
;
symmetry
;
apply
(
chain_cauchy
c
)
;
naive_solver
.
Qed
.
Program
Instance
agree_op
:
Op
(
agree
A
)
:
=
λ
x
y
,
{|
agree_car
:
=
agree_car
x
;
agree_is_valid
n
:
=
agree_is_valid
x
n
∧
agree_is_valid
y
n
∧
x
≡
{
n
}
≡
y
|}.
Next
Obligation
.
naive_solver
eauto
using
agree_valid_S
,
dist_S
.
Qed
.
agree_with
:
=
agree_with
x
++
agree_car
y
::
agree_with
y
|}.
Instance
agree_pcore
:
PCore
(
agree
A
)
:
=
Some
.
Instance
:
Comm
(
≡
)
(@
op
(
agree
A
)
_
).
Proof
.
intros
x
y
;
split
;
[
naive_solver
|
by
intros
n
(?&?&
Hxy
)
;
apply
Hxy
].
Qed
.
Proof
.
intros
x
y
n
.
apply
:
list_setequiv_equiv
.
set_solver
.
Qed
.
Lemma
agree_idemp
(
x
:
agree
A
)
:
x
⋅
x
≡
x
.
Proof
.
split
;
naive_solver
.
Qed
.
Proof
.
intros
n
.
apply
:
list_setequiv_equiv
.
set_solver
.
Qed
.
Instance
:
∀
n
:
nat
,
Proper
(
dist
n
==>
impl
)
(@
validN
(
agree
A
)
_
n
).
Proof
.
intros
n
x
y
Hxy
[?
Hx
]
;
split
;
[
by
apply
Hxy
|
intros
n'
?].
rewrite
-(
proj2
Hxy
n'
)
-
1
?(
Hx
n'
)
;
eauto
using
agree_valid_le
.
symmetry
.
by
apply
dist_le
with
n
;
try
apply
Hxy
.
intros
n
x
y
.
rewrite
/
dist
/
validN
/
agree_dist
/
agree_validN
.
by
intros
->.
Qed
.
Instance
:
∀
n
:
nat
,
Proper
(
equiv
==>
iff
)
(@
validN
(
agree
A
)
_
n
).
Proof
.
intros
n
???.
assert
(
x
≡
{
n
}
≡
y
)
as
Hxy
by
by
apply
equiv_dist
.
split
;
rewrite
Hxy
;
done
.
Qed
.
Instance
:
∀
x
:
agree
A
,
Proper
(
dist
n
==>
dist
n
)
(
op
x
).
Proof
.
intros
n
x
y1
y2
[
Hy'
Hy
]
;
split
;
[|
done
].
split
;
intros
(?&?&
Hxy
)
;
repeat
(
intro
||
split
)
;
try
apply
Hy'
;
eauto
using
agree_valid_le
.
-
etrans
;
[
apply
Hxy
|
apply
Hy
]
;
eauto
using
agree_valid_le
.
-
etrans
;
[
apply
Hxy
|
symmetry
;
apply
Hy
,
Hy'
]
;
eauto
using
agree_valid_le
.
intros
n
x
y1
y2
.
rewrite
/
dist
/
agree_dist
/
agree_list
/=.
rewrite
!
app_comm_cons
.
apply
:
list_setequiv_app
.
Qed
.
Instance
:
Proper
(
dist
n
==>
dist
n
==>
dist
n
)
(@
op
(
agree
A
)
_
).
Proof
.
by
intros
n
x1
x2
Hx
y1
y2
Hy
;
rewrite
Hy
!(
comm
_
_
y2
)
Hx
.
Qed
.
Instance
:
Proper
((
≡
)
==>
(
≡
)
==>
(
≡
))
op
:
=
ne_proper_2
_
.
Instance
:
Assoc
(
≡
)
(@
op
(
agree
A
)
_
).
Proof
.
intros
x
y
z
;
split
;
simpl
;
intuition
;
repeat
match
goal
with
H
:
agree_is_valid
_
_
|-
_
=>
clear
H
end
;
by
cofe_subst
;
rewrite
!
agree_idemp
.
Qed
.
Proof
.
intros
x
y
z
n
.
apply
:
list_setequiv_equiv
.
set_solver
.
Qed
.
Lemma
agree_included
(
x
y
:
agree
A
)
:
x
≼
y
↔
y
≡
x
⋅
y
.
Proof
.
split
;
[|
by
intros
?
;
exists
y
].
by
intros
[
z
Hz
]
;
rewrite
Hz
assoc
agree_idemp
.
Qed
.
Lemma
agree_op_inv
n
(
x1
x2
:
agree
A
)
:
✓
{
n
}
(
x1
⋅
x2
)
→
x1
≡
{
n
}
≡
x2
.
Proof
.
intros
Hxy
;
apply
Hxy
.
Qed
.
Lemma
agree_op_inv_inclN
n
x1
x2
:
✓
{
n
}
(
x1
⋅
x2
)
→
agree_dist_incl
n
x1
x2
.
Proof
.
rewrite
/
validN
/=
=>
/
list_agrees_alt
Hv
a
/
elem_of_cons
Ha
.
exists
(
agree_car
x2
).
split
;
first
by
constructor
.
eapply
Hv
.
-
simpl
.
destruct
Ha
as
[->|
Ha
]
;
set_solver
.
-
simpl
.
set_solver
+.
Qed
.
Lemma
agree_op_invN
n
(
x1
x2
:
agree
A
)
:
✓
{
n
}
(
x1
⋅
x2
)
→
x1
≡
{
n
}
≡
x2
.
Proof
.
intros
Hxy
.
split
;
apply
agree_op_inv_inclN
;
first
done
.
by
rewrite
comm
.
Qed
.
Lemma
agree_valid_includedN
n
(
x
y
:
agree
A
)
:
✓
{
n
}
y
→
x
≼
{
n
}
y
→
x
≡
{
n
}
≡
y
.
Proof
.
move
=>
Hval
[
z
Hy
]
;
move
:
Hval
;
rewrite
Hy
.
by
move
=>
/
agree_op_inv
->
;
rewrite
agree_idemp
.
by
move
=>
/
agree_op_inv
N
->
;
rewrite
agree_idemp
.
Qed
.
Definition
agree_cmra_mixin
:
CMRAMixin
(
agree
A
).
Proof
.
apply
cmra_total_mixin
;
try
apply
_
||
by
eauto
.
-
intros
n
x
[?
Hx
]
;
split
;
[
by
apply
agree_valid_S
|
intros
n'
?].
rewrite
-(
Hx
n'
)
;
last
auto
.
symmetry
;
apply
dist_le
with
n
;
try
apply
Hx
;
auto
.
-
move
=>
x
.
split
.
+
move
=>/
list_agrees_alt
Hx
n
.
apply
(
list_agrees_alt
_
)=>
a
b
Ha
Hb
.
apply
equiv_dist
,
Hx
;
done
.
+
intros
Hx
.
apply
(
list_agrees_alt
_
)=>
a
b
Ha
Hb
.
apply
equiv_dist
=>
n
.
eapply
(
list_agrees_alt
_
)
;
first
(
by
apply
Hx
)
;
done
.
-
intros
n
x
.
apply
(
list_agrees_subrel
_
_
)=>??.
apply
dist_S
.
-
intros
x
.
apply
agree_idemp
.
-
by
intros
n
x
y
[(?&?&?)
?]
.
-
intros
???
Hl
.
apply
:
list_agrees_contains
Hl
.
set_solver
.
-
intros
n
x
y1
y2
Hval
Hx
;
exists
x
,
x
;
simpl
;
split
.
+
by
rewrite
agree_idemp
.
+
by
move
:
Hval
;
rewrite
Hx
;
move
=>
/
agree_op_inv
->
;
rewrite
agree_idemp
.
+
by
move
:
Hval
;
rewrite
Hx
;
move
=>
/
agree_op_inv
N
->
;
rewrite
agree_idemp
.
Qed
.
Canonical
Structure
agreeR
:
cmraT
:
=
CMRAT
(
agree
A
)
agree_ofe_mixin
agree_cmra_mixin
.
...
...
@@ -125,60 +321,114 @@ Proof. rewrite /CMRATotal; eauto. Qed.
Global
Instance
agree_persistent
(
x
:
agree
A
)
:
Persistent
x
.
Proof
.
by
constructor
.
Qed
.
Program
Definition
to_agree
(
x
:
A
)
:
agree
A
:
=
{|
agree_car
n
:
=
x
;
agree_is_valid
n
:
=
True
|}.
Solve
Obligations
with
done
.
Lemma
agree_op_inv
(
x1
x2
:
agree
A
)
:
✓
(
x1
⋅
x2
)
→
x1
≡
x2
.
Proof
.
intros
?.
apply
equiv_dist
=>
n
.
by
apply
agree_op_invN
,
cmra_valid_validN
.
Qed
.
Global
Instance
agree_discrete
:
Discrete
A
→
CMRADiscrete
agreeR
.
Proof
.
intros
HD
.
split
.
-
intros
x
y
Hxy
n
.
eapply
list_setequiv_subrel
;
last
exact
Hxy
.
clear
-
HD
.
intros
x
y
?.
apply
equiv_dist
,
HD
.
done
.
-
rewrite
/
valid
/
cmra_valid
/
agree_valid
/
validN
/
cmra_validN
/
agree_validN
/=.
move
=>
x
.
apply
(
list_agrees_subrel
_
_
).
clear
-
HD
.
intros
x
y
.
apply
HD
.
Qed
.
Definition
to_agree
(
x
:
A
)
:
agree
A
:
=
{|
agree_car
:
=
x
;
agree_with
:
=
[]
|}.
Global
Instance
to_agree_ne
n
:
Proper
(
dist
n
==>
dist
n
)
to_agree
.
Proof
.
intros
x1
x2
Hx
;
split
;
naive_solver
eauto
using
@
dist_le
.
Qed
.
Proof
.
intros
x1
x2
Hx
;
rewrite
/=
/
dist
/
agree_dist
/=.
exact
:
list_setequiv_singleton
.
Qed
.
Global
Instance
to_agree_proper
:
Proper
((
≡
)
==>
(
≡
))
to_agree
:
=
ne_proper
_
.
Global
Instance
to_agree_inj
n
:
Inj
(
dist
n
)
(
dist
n
)
(
to_agree
).
Proof
.
by
intros
x
y
[
_
Hxy
]
;
apply
Hxy
.
Qed
.
Global
Instance
to_agree_injN
n
:
Inj
(
dist
n
)
(
dist
n
)
(
to_agree
).
Proof
.
intros
a
b
[
Hxy
%
list_setincl_singleton_rev
_
].
done
.
Qed
.
Global
Instance
to_agree_inj
:
Inj
(
≡
)
(
≡
)
(
to_agree
).
Proof
.
intros
a
b
?.
apply
equiv_dist
=>
n
.
apply
to_agree_injN
.
by
apply
equiv_dist
.
Qed
.
Lemma
to_agree_uninj
n
(
x
:
agree
A
)
:
✓
{
n
}
x
→
∃
y
:
A
,
to_agree
y
≡
{
n
}
≡
x
.
Proof
.
intros
[??].
exists
(
agree_car
x
n
).
split
;
naive_solver
eauto
using
agree_valid_le
.
intros
Hl
.
exists
(
agree_car
x
).
rewrite
/
dist
/
agree_dist
/=.
split
.
-
apply
:
list_setincl_singleton_in
.
set_solver
+.
-
apply
(
list_agrees_iff_setincl
_
)
;
first
set_solver
+.
done
.
Qed
.
Lemma
to_agree_included
(
a
b
:
A
)
:
to_agree
a
≼
to_agree
b
↔
a
≡
b
.
Proof
.
split
.
-
intros
(
x
&
Heq
).
apply
equiv_dist
=>
n
.
destruct
(
Heq
n
)
as
[
_
Hincl
].
(* TODO: This could become a generic lemma about list_setincl. *)
destruct
(
Hincl
a
)
as
(?
&
->%
elem_of_list_singleton
&
?)
;
first
set_solver
+.
done
.
-
intros
Hab
.
rewrite
Hab
.
eexists
.
symmetry
.
eapply
agree_idemp
.
Qed
.
Lemma
to_agree_comp_valid
(
a
b
:
A
)
:
✓
(
to_agree
a
⋅
to_agree
b
)
↔
a
≡
b
.
Proof
.
split
.
-
(* TODO: can this be derived from other stuff? Otherwise, should probably become sth. generic about list_agrees. *)
intros
Hv
.
apply
Hv
;
simpl
;
set_solver
.
-
intros
->.
rewrite
agree_idemp
.
done
.
Qed
.
(** Internalized properties *)
Lemma
agree_equivI
{
M
}
a
b
:
to_agree
a
≡
to_agree
b
⊣
⊢
(
a
≡
b
:
uPred
M
).
Proof
.
uPred
.
unseal
.
do
2
split
.
by
intros
[?
Hv
]
;
apply
(
Hv
n
).
apply
:
to_agree_ne
.
uPred
.
unseal
.
do
2
split
.
-
intros
Hx
.
exact
:
to_agree_injN
.
-
intros
Hx
.
exact
:
to_agree_ne
.
Qed
.
Lemma
agree_validI
{
M
}
x
y
:
✓
(
x
⋅
y
)
⊢
(
x
≡
y
:
uPred
M
).
Proof
.
uPred
.
unseal
;
split
=>
r
n
_
?
;
by
apply
:
agree_op_inv
.
Qed
.
Proof
.
uPred
.
unseal
;
split
=>
r
n
_
?
;
by
apply
:
agree_op_inv
N
.
Qed
.
End
agree
.
Arguments
agreeC
:
clear
implicits
.
Arguments
agreeR
:
clear
implicits
.
Program
Definition
agree_map
{
A
B
}
(
f
:
A
→
B
)
(
x
:
agree
A
)
:
agree
B
:
=
{|
agree_car
n
:
=
f
(
agree_car
x
n
)
;
agree_is_valid
:
=
agree_is_valid
x
;
agree_valid_S
:
=
agree_valid_S
_
x
|}.
{|
agree_car
:
=
f
(
agree_car
x
)
;
agree_with
:
=
f
<$>
(
agree_with
x
)
|}.
Lemma
agree_map_id
{
A
}
(
x
:
agree
A
)
:
agree_map
id
x
=
x
.
Proof
.
by
destruct
x
.
Qed
.
Proof
.
rewrite
/
agree_map
/=
list_fmap_id
.
by
destruct
x
.
Qed
.
Lemma
agree_map_compose
{
A
B
C
}
(
f
:
A
→
B
)
(
g
:
B
→
C
)
(
x
:
agree
A
)
:
agree_map
(
g
∘
f
)
x
=
agree_map
g
(
agree_map
f
x
).
Proof
.
done
.
Qed
.
Proof
.
rewrite
/
agree_map
/=
list_fmap_compose
.
done
.
Qed
.
Section
agree_map
.
Context
{
A
B
:
ofeT
}
(
f
:
A
→
B
)
`
{
Hf
:
∀
n
,
Proper
(
dist
n
==>
dist
n
)
f
}.
Instance
agree_map_ne
n
:
Proper
(
dist
n
==>
dist
n
)
(
agree_map
f
).
Proof
.
by
intros
x1
x2
Hx
;
split
;
simpl
;
intros
;
[
apply
Hx
|
apply
Hf
,
Hx
].
Qed
.
Proof
.
intros
x
y
Hxy
.
change
(
list_setequiv
(
dist
n
)(
f
<$>
(
agree_list
x
))(
f
<$>
(
agree_list
y
))).
eapply
list_setequiv_fmap
;
last
exact
Hxy
.
apply
_
.
Qed
.
Instance
agree_map_proper
:
Proper
((
≡
)
==>
(
≡
))
(
agree_map
f
)
:
=
ne_proper
_
.
Lemma
agree_map_ext
(
g
:
A
→
B
)
x
:
(
∀
x
,
f
x
≡
g
x
)
→
agree_map
f
x
≡
agree_map
g
x
.
Proof
.
by
intros
Hfg
;
split
;
simpl
;
intros
;
rewrite
?Hfg
.
Qed
.
Proof
.
intros
Hfg
n
.
apply
:
list_setequiv_ext
.
change
(
f
<$>
(
agree_list
x
)
≡
{
n
}
≡
g
<$>
(
agree_list
x
)).
apply
list_fmap_ext_ne
=>
y
.
by
apply
equiv_dist
.
Qed
.
Global
Instance
agree_map_monotone
:
CMRAMonotone
(
agree_map
f
).
Proof
.
split
;
first
apply
_
.
-
by
intros
n
x
[?
Hx
]
;
split
;
simpl
;
[|
by
intros
n'
?
;
rewrite
Hx
].
-
intros
n
x
.
rewrite
/
cmra_validN
/
validN
/=
/
agree_validN
/=
=>
?.
change
(
list_agrees
(
dist
n
)
(
f
<$>
agree_list
x
)).
eapply
(
list_agrees_fmap
_
_
_
)
;
done
.
-
intros
x
y
;
rewrite
!
agree_included
=>
->.
split
;
last
done
;
split
;
simpl
;
last
tauto
.
by
intros
(?&?&
Hxy
)
;
repeat
split
;
intros
;
try
apply
Hxy
;
try
apply
Hf
;
eauto
using
@
agree_valid_le
.
rewrite
/
equiv
/
agree_equiv
/
agree_map
/
agree_op
/
agree_list
/=.
rewrite
!
fmap_app
=>
n
.
apply
:
list_setequiv_equiv
.
set_solver
+.
Qed
.
End
agree_map
.
...
...
@@ -186,8 +436,9 @@ Definition agreeC_map {A B} (f : A -n> B) : agreeC A -n> agreeC B :=
CofeMor
(
agree_map
f
:
agreeC
A
→
agreeC
B
).
Instance
agreeC_map_ne
A
B
n
:
Proper
(
dist
n
==>
dist
n
)
(@
agreeC_map
A
B
).
Proof
.
intros
f
g
Hfg
x
;
split
;
simpl
;
intros
;
first
done
.
by
apply
dist_le
with
n
;
try
apply
Hfg
.
intros
f
g
Hfg
x
.
apply
:
list_setequiv_ext
.
change
(
f
<$>
(
agree_list
x
)
≡
{
n
}
≡
g
<$>
(
agree_list
x
)).
apply
list_fmap_ext_ne
.
done
.
Qed
.
Program
Definition
agreeRF
(
F
:
cFunctor
)
:
rFunctor
:
=
{|
...
...
Write
Preview
Supports
Markdown
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