Skip to content
GitLab
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
38d2f0d2
Commit
38d2f0d2
authored
Feb 08, 2016
by
Robbert Krebbers
Browse files
Clean up global CMRA.
parent
ff9ebff8
Changes
1
Hide whitespace changes
Inline
Side-by-side
program_logic/global_cmra.v
View file @
38d2f0d2
...
...
@@ -9,139 +9,86 @@ Definition globalC (Σ : gid → iFunctor) : iFunctor :=
Class
InG
(
Λ
:
language
)
(
Σ
:
gid
→
iFunctor
)
(
i
:
gid
)
(
A
:
cmraT
)
:
=
inG
:
A
=
Σ
i
(
laterC
(
iPreProp
Λ
(
globalC
Σ
))).
Definition
to_globalC
{
Λ
Σ
A
}
(
i
:
gid
)
`
{!
InG
Λ
Σ
i
A
}
(
γ
:
gid
)
(
a
:
A
)
:
iGst
Λ
(
globalC
Σ
)
:
=
iprod_singleton
i
{[
γ
↦
cmra_transport
inG
a
]}.
Definition
own
{
Λ
Σ
A
}
(
i
:
gid
)
`
{!
InG
Λ
Σ
i
A
}
(
γ
:
gid
)
(
a
:
A
)
:
iProp
Λ
(
globalC
Σ
)
:
=
ownG
(
to_globalC
i
γ
a
).
Instance
:
Params
(@
to_globalC
)
6
.
Instance
:
Params
(@
own
)
6
.
Typeclasses
Opaque
to_globalC
own
.
Section
global
.
Context
{
Λ
:
language
}
{
Σ
:
gid
→
iFunctor
}
(
i
:
gid
)
`
{!
InG
Λ
Σ
i
A
}.
Implicit
Types
a
:
A
.
Definition
to_
Σ
(
a
:
A
)
:
Σ
i
(
laterC
(
iPreProp
Λ
(
globalC
Σ
)))
:
=
eq_rect
A
id
a
_
inG
.
Definition
to_globalC
(
γ
:
gid
)
`
{!
InG
Λ
Σ
i
A
}
(
a
:
A
)
:
iGst
Λ
(
globalC
Σ
)
:
=
iprod_singleton
i
{[
γ
↦
to_
Σ
a
]}.
Definition
own
(
γ
:
gid
)
(
a
:
A
)
:
iProp
Λ
(
globalC
Σ
)
:
=
ownG
(
to_globalC
γ
a
).
Definition
from_
Σ
(
b
:
Σ
i
(
laterC
(
iPreProp
Λ
(
globalC
Σ
))))
:
A
:
=
eq_rect
(
Σ
i
_
)
id
b
_
(
Logic
.
eq_sym
inG
).
Definition
P_to_
Σ
(
P
:
A
→
Prop
)
(
b
:
Σ
i
(
laterC
(
iPreProp
Λ
(
globalC
Σ
))))
:
Prop
:
=
P
(
from_
Σ
b
).
(* Properties of the transport. *)
Lemma
to_from_
Σ
b
:
to_
Σ
(
from_
Σ
b
)
=
b
.
Proof
.
rewrite
/
to_
Σ
/
from_
Σ
.
by
destruct
inG
.
Qed
.
(* Properties of to_globalC *)
Lemma
globalC_op
γ
a1
a2
:
to_globalC
γ
(
a1
⋅
a2
)
≡
to_globalC
γ
a1
⋅
to_globalC
γ
a2
.
Proof
.
rewrite
/
to_globalC
iprod_op_singleton
map_op_singleton
.
apply
iprod_singleton_proper
,
(
fin_maps
.
singleton_proper
(
M
:
=
gmap
_
)).
by
rewrite
/
to_
Σ
;
destruct
inG
.
Qed
.
Lemma
globalC_validN
n
γ
a
:
✓
{
n
}
(
to_globalC
γ
a
)
↔
✓
{
n
}
a
.
Instance
to_globalC_ne
γ
n
:
Proper
(
dist
n
==>
dist
n
)
(
to_globalC
i
γ
).
Proof
.
by
intros
a
a'
Ha
;
apply
iprod_singleton_ne
;
rewrite
Ha
.
Qed
.
Lemma
to_globalC_validN
n
γ
a
:
✓
{
n
}
(
to_globalC
i
γ
a
)
↔
✓
{
n
}
a
.
Proof
.
rewrite
/
to_globalC
iprod_singleton_validN
map_singleton_validN
.
by
rewrite
/
to_
Σ
;
destruct
inG
.
by
rewrite
/
to_globalC
iprod_singleton_validN
map_singleton_validN
cmra_transport_validN
.
Qed
.
Lemma
globalC_unit
γ
a
:
unit
(
to_globalC
γ
a
)
≡
to_globalC
γ
(
unit
a
).
Lemma
to_globalC_op
γ
a1
a2
:
to_globalC
i
γ
(
a1
⋅
a2
)
≡
to_globalC
i
γ
a1
⋅
to_globalC
i
γ
a2
.
Proof
.
rewrite
/
to_globalC
.
rewrite
iprod_unit_singleton
map_unit_singleton
.
apply
iprod_singleton_proper
,
(
fin_maps
.
singleton_proper
(
M
:
=
gmap
_
)).
by
rewrite
/
to_
Σ
;
destruct
inG
.
by
rewrite
/
to_globalC
iprod_op_singleton
map_op_singleton
cmra_transport_op
.
Qed
.
Global
Instance
globalC_timeless
γ
m
:
Timeless
m
→
Timeless
(
to_globalC
γ
m
).
Lemma
to_globalC_unit
γ
a
:
unit
(
to_globalC
i
γ
a
)
≡
to_globalC
i
γ
(
unit
a
).
Proof
.
rewrite
/
to_globalC
=>
?.
apply
(
iprod_singleton_timeless
_
_
_
),
map_singleton_timeless
.
by
rewrite
/
to_
Σ
;
destruct
inG
.
by
rewrite
/
to_globalC
iprod_unit_singleton
map_unit_singleton
cmra_transport_unit
.
Qed
.
(* Properties of the lifted frame-preserving updates *)
Lemma
update_to_
Σ
a
P
:
a
~~>
:
P
→
to_
Σ
a
~~>
:
P_to_
Σ
P
.
Proof
.
move
=>
Hu
gf
n
Hf
.
destruct
(
Hu
(
from_
Σ
gf
)
n
)
as
[
a'
Ha'
].
{
move
:
Hf
.
rewrite
/
to_
Σ
/
from_
Σ
.
by
destruct
inG
.
}
exists
(
to_
Σ
a'
).
move
:
Hf
Ha'
.
rewrite
/
P_to_
Σ
/
to_
Σ
/
from_
Σ
.
destruct
inG
.
done
.
Qed
.
Instance
to_globalC_timeless
γ
m
:
Timeless
m
→
Timeless
(
to_globalC
i
γ
m
).
Proof
.
rewrite
/
to_globalC
;
apply
_
.
Qed
.
(* Properties of own *)
Global
Instance
own_ne
γ
n
:
Proper
(
dist
n
==>
dist
n
)
(
own
γ
).
Global
Instance
own_ne
γ
n
:
Proper
(
dist
n
==>
dist
n
)
(
own
i
γ
).
Proof
.
by
intros
m
m'
Hm
;
rewrite
/
own
Hm
.
Qed
.
Global
Instance
own_proper
γ
:
Proper
((
≡
)
==>
(
≡
))
(
own
i
γ
)
:
=
ne_proper
_
.
Lemma
own_op
γ
a1
a2
:
own
i
γ
(
a1
⋅
a2
)
≡
(
own
i
γ
a1
★
own
i
γ
a2
)%
I
.
Proof
.
by
rewrite
/
own
-
ownG_op
to_globalC_op
.
Qed
.
Lemma
always_own_unit
γ
a
:
(
□
own
i
γ
(
unit
a
))%
I
≡
own
i
γ
(
unit
a
).
Proof
.
by
rewrite
/
own
-
to_globalC_unit
always_ownG_unit
.
Qed
.
Lemma
own_valid
γ
a
:
own
i
γ
a
⊑
✓
a
.
Proof
.
intros
m
m'
Hm
;
apply
ownG_ne
,
iprod_singleton_ne
,
singleton_ne
.
by
rewrite
/
to_globalC
/
to_
Σ
;
destruct
inG
.
rewrite
/
own
ownG_valid
;
apply
valid_mono
=>
?
;
apply
to_globalC_validN
.
Qed
.
Global
Instance
own_proper
γ
:
Proper
((
≡
)
==>
(
≡
))
(
own
γ
)
:
=
ne_proper
_
.
Lemma
own_op
γ
a1
a2
:
own
γ
(
a1
⋅
a2
)
≡
(
own
γ
a1
★
own
γ
a2
)%
I
.
Proof
.
rewrite
/
own
-
ownG_op
.
apply
ownG_proper
,
globalC_op
.
Qed
.
(* TODO: This also holds if we just have ✓a at the current step-idx, as Iris
assertion. However, the map_updateP_alloc does not suffice to show this. *)
Lemma
own_alloc
E
a
:
✓
a
→
True
⊑
pvs
E
E
(
∃
γ
,
own
γ
a
).
Proof
.
intros
Ha
.
set
(
P
m
:
=
∃
γ
,
m
=
to_globalC
γ
a
).
rewrite
-(
pvs_mono
_
_
(
∃
m
,
■
P
m
∧
ownG
m
)%
I
).
-
rewrite
-
pvs_ownG_updateP_empty
//
;
[].
subst
P
.
eapply
(
iprod_singleton_updateP_empty
i
).
+
apply
map_updateP_alloc'
with
(
x
:
=
to_
Σ
a
).
by
rewrite
/
to_
Σ
;
destruct
inG
.
+
simpl
.
move
=>?
[
γ
[->
?]].
exists
γ
.
done
.
-
apply
exist_elim
=>
m
.
apply
const_elim_l
=>-[
p
->]
{
P
}.
by
rewrite
-(
exist_intro
p
).
Qed
.
Lemma
always_own_unit
γ
a
:
(
□
own
γ
(
unit
a
))%
I
≡
own
γ
(
unit
a
).
Proof
.
rewrite
/
own
-
globalC_unit
.
by
apply
always_ownG_unit
.
Qed
.
Lemma
own_valid
γ
a
:
(
own
γ
a
)
⊑
(
✓
a
).
Proof
.
rewrite
/
own
ownG_valid
.
apply
uPred
.
valid_mono
=>
n
.
by
apply
globalC_validN
.
Qed
.
Lemma
own_valid_r'
γ
a
:
(
own
γ
a
)
⊑
(
own
γ
a
★
✓
a
).
Lemma
own_valid_r'
γ
a
:
own
i
γ
a
⊑
(
own
i
γ
a
★
✓
a
).
Proof
.
apply
(
uPred
.
always_entails_r'
_
_
),
own_valid
.
Qed
.
Global
Instance
own_timeless
γ
a
:
Timeless
a
→
TimelessP
(
own
i
γ
a
).
Proof
.
unfold
own
;
apply
_
.
Qed
.
Global
Instance
ownG_timeless
γ
a
:
Timeless
a
→
TimelessP
(
own
γ
a
).
(* TODO: This also holds if we just have ✓ a at the current step-idx, as Iris
assertion. However, the map_updateP_alloc does not suffice to show this. *)
Lemma
own_alloc
E
a
:
✓
a
→
True
⊑
pvs
E
E
(
∃
γ
,
own
i
γ
a
).
Proof
.
intros
.
apply
ownG_timeless
.
apply
_
.
intros
Ha
.
rewrite
-(
pvs_mono
_
_
(
∃
m
,
■
(
∃
γ
,
m
=
to_globalC
i
γ
a
)
∧
ownG
m
)%
I
).
*
eapply
pvs_ownG_updateP_empty
,
(
iprod_singleton_updateP_empty
i
)
;
first
(
eapply
map_updateP_alloc'
,
cmra_transport_valid
,
Ha
)
;
naive_solver
.
*
apply
exist_elim
=>
m
;
apply
const_elim_l
=>-[
γ
->].
by
rewrite
-(
exist_intro
γ
).
Qed
.
Lemma
pvs_updateP
E
γ
a
P
:
a
~~>
:
P
→
own
γ
a
⊑
pvs
E
E
(
∃
a'
,
■
P
a'
∧
own
γ
a'
).
a
~~>
:
P
→
own
i
γ
a
⊑
pvs
E
E
(
∃
a'
,
■
P
a'
∧
own
i
γ
a'
).
Proof
.
intros
Ha
.
set
(
P'
m
:
=
∃
a'
,
P
a'
∧
m
=
to_globalC
γ
a'
).
rewrite
-(
pvs_mono
_
_
(
∃
m
,
■
P'
m
∧
ownG
m
)%
I
).
-
rewrite
-
pvs_ownG_updateP
;
first
by
rewrite
/
own
.
rewrite
/
to_globalC
.
eapply
iprod_singleton_updateP
.
+
(* FIXME RJ: I tried apply... with instead of instantiate, that
does not work. *)
apply
map_singleton_updateP'
.
instantiate
(
1
:
=
P_to_
Σ
P
).
by
apply
update_to_
Σ
.
+
simpl
.
move
=>?
[
y
[->
HP
]].
exists
(
from_
Σ
y
).
split
.
*
move
:
HP
.
rewrite
/
P_to_
Σ
/
from_
Σ
.
by
destruct
inG
.
*
clear
HP
.
rewrite
/
to_globalC
to_from_
Σ
;
done
.
-
apply
exist_elim
=>
m
.
apply
const_elim_l
=>-[
a'
[
HP
->]].
rewrite
-(
exist_intro
a'
).
apply
and_intro
;
last
done
.
by
apply
const_intro
.
intros
Ha
.
rewrite
-(
pvs_mono
_
_
(
∃
m
,
■
(
∃
b
,
m
=
to_globalC
i
γ
b
∧
P
b
)
∧
ownG
m
)%
I
).
*
eapply
pvs_ownG_updateP
,
iprod_singleton_updateP
;
first
(
eapply
map_singleton_updateP'
,
cmra_transport_updateP'
,
Ha
).
naive_solver
.
*
apply
exist_elim
=>
m
;
apply
const_elim_l
=>-[
a'
[->
HP
]].
rewrite
-(
exist_intro
a'
).
by
apply
and_intro
;
[
apply
const_intro
|].
Qed
.
Lemma
pvs_update
E
γ
a
a'
:
a
~~>
a'
→
own
γ
a
⊑
pvs
E
E
(
own
γ
a'
).
Lemma
pvs_update
E
γ
a
a'
:
a
~~>
a'
→
own
i
γ
a
⊑
pvs
E
E
(
own
i
γ
a'
).
Proof
.
intros
;
rewrite
(
pvs_updateP
E
_
_
(
a'
=))
;
last
by
apply
cmra_update_updateP
.
by
apply
pvs_mono
,
uPred
.
exist_elim
=>
m''
;
apply
uPred
.
const_elim_l
=>
->.
Qed
.
End
global
.
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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