Commit 0d4e3210 authored by Robbert Krebbers's avatar Robbert Krebbers

Merge branch 'robbert/locations_meta' into 'master'

Add ghost data to locations

See merge request iris/iris!249
parents 31bf88ff 48628616
......@@ -49,6 +49,7 @@ Changes in heap_lang:
"administrative" reductions in the operational semantics of the language.
* heap_lang now has support for allocating, accessing and reasoning about arrays
(continuously allocated regions of memory).
* One can now assign "meta" data to heap_lang locations.
Changes in Coq:
......
......@@ -36,6 +36,7 @@ theories/algebra/coPset.v
theories/algebra/deprecated.v
theories/algebra/proofmode_classes.v
theories/algebra/ufrac.v
theories/algebra/namespace_map.v
theories/bi/notation.v
theories/bi/interface.v
theories/bi/derived_connectives.v
......
From iris.algebra Require Export gmap coPset local_updates.
From stdpp Require Import namespaces.
From iris.algebra Require Import updates.
From iris.algebra Require Import proofmode_classes.
Set Default Proof Using "Type".
(** The camera [namespace_map A] over a camera [A] provides the connectives
[namespace_map_data N a], which associates data [a : A] with a namespace [N],
and [namespace_map_token E], which says that no data has been associated with
the namespaces in the mask [E]. The important properties of this camera are:
- The lemma [namespace_map_token_union] enables one to split [namespace_map_token]
w.r.t. disjoint union. That is, if we have [E1 ## E2], then we get
[namespace_map_token (E1 ∪ E2) = namespace_map_token E1 ⋅ namespace_map_token E2]
- The lemma [namespace_map_alloc_update] provides a frame preserving update to
associate data to a namespace [namespace_map_token E ~~> namespace_map_data N a]
provided [↑N ⊆ E] and [✓ a]. *)
Record namespace_map (A : Type) := NamespaceMap {
namespace_map_data_proj : gmap positive A;
namespace_map_token_proj : coPset_disj
}.
Add Printing Constructor namespace_map.
Arguments NamespaceMap {_} _ _.
Arguments namespace_map_data_proj {_} _.
Arguments namespace_map_token_proj {_} _.
Instance: Params (@NamespaceMap) 1 := {}.
Instance: Params (@namespace_map_data_proj) 1 := {}.
Instance: Params (@namespace_map_token_proj) 1 := {}.
(** TODO: [positives_flatten] violates the namespace abstraction. *)
Definition namespace_map_data {A : cmraT} (N : namespace) (a : A) : namespace_map A :=
NamespaceMap {[ positives_flatten N := a ]} ε.
Definition namespace_map_token {A : cmraT} (E : coPset) : namespace_map A :=
NamespaceMap (CoPset E).
Instance: Params (@namespace_map_data) 2 := {}.
(* Ofe *)
Section ofe.
Context {A : ofeT}.
Implicit Types x y : namespace_map A.
Instance namespace_map_equiv : Equiv (namespace_map A) := λ x y,
namespace_map_data_proj x namespace_map_data_proj y
namespace_map_token_proj x = namespace_map_token_proj y.
Instance namespace_map_dist : Dist (namespace_map A) := λ n x y,
namespace_map_data_proj x {n} namespace_map_data_proj y
namespace_map_token_proj x = namespace_map_token_proj y.
Global Instance Awesome_ne : NonExpansive2 (@NamespaceMap A).
Proof. by split. Qed.
Global Instance Awesome_proper : Proper (() ==> (=) ==> ()) (@NamespaceMap A).
Proof. by split. Qed.
Global Instance namespace_map_data_proj_ne: NonExpansive (@namespace_map_data_proj A).
Proof. by destruct 1. Qed.
Global Instance namespace_map_data_proj_proper :
Proper (() ==> ()) (@namespace_map_data_proj A).
Proof. by destruct 1. Qed.
Definition namespace_map_ofe_mixin : OfeMixin (namespace_map A).
Proof.
by apply (iso_ofe_mixin
(λ x, (namespace_map_data_proj x, namespace_map_token_proj x))).
Qed.
Canonical Structure namespace_mapC :=
OfeT (namespace_map A) namespace_map_ofe_mixin.
Global Instance NamespaceMap_discrete a b :
Discrete a Discrete b Discrete (NamespaceMap a b).
Proof. by intros ?? [??] [??]; split; apply: discrete. Qed.
Global Instance namespace_map_ofe_discrete :
OfeDiscrete A OfeDiscrete namespace_mapC.
Proof. intros ? [??]; apply _. Qed.
End ofe.
Arguments namespace_mapC : clear implicits.
(* Camera *)
Section cmra.
Context {A : cmraT}.
Implicit Types a b : A.
Implicit Types x y : namespace_map A.
Global Instance namespace_map_data_ne i : NonExpansive (@namespace_map_data A i).
Proof. solve_proper. Qed.
Global Instance namespace_map_data_proper N :
Proper (() ==> ()) (@namespace_map_data A N).
Proof. solve_proper. Qed.
Global Instance namespace_map_data_discrete N a :
Discrete a Discrete (namespace_map_data N a).
Proof. intros. apply NamespaceMap_discrete; apply _. Qed.
Global Instance namespace_map_token_discrete E : Discrete (@namespace_map_token A E).
Proof. intros. apply NamespaceMap_discrete; apply _. Qed.
Instance namespace_map_valid : Valid (namespace_map A) := λ x,
match namespace_map_token_proj x with
| CoPset E =>
(namespace_map_data_proj x)
(* dom (namespace_map_data_proj x) ⊥ E *)
i, namespace_map_data_proj x !! i = None i E
| CoPsetBot => False
end.
Global Arguments namespace_map_valid !_ /.
Instance namespace_map_validN : ValidN (namespace_map A) := λ n x,
match namespace_map_token_proj x with
| CoPset E =>
{n} (namespace_map_data_proj x)
(* dom (namespace_map_data_proj x) ⊥ E *)
i, namespace_map_data_proj x !! i = None i E
| CoPsetBot => False
end.
Global Arguments namespace_map_validN !_ /.
Instance namespace_map_pcore : PCore (namespace_map A) := λ x,
Some (NamespaceMap (core (namespace_map_data_proj x)) ε).
Instance namespace_map_op : Op (namespace_map A) := λ x y,
NamespaceMap (namespace_map_data_proj x namespace_map_data_proj y)
(namespace_map_token_proj x namespace_map_token_proj y).
Definition namespace_map_valid_eq :
valid = λ x, match namespace_map_token_proj x with
| CoPset E =>
(namespace_map_data_proj x)
(* dom (namespace_map_data_proj x) ⊥ E *)
i, namespace_map_data_proj x !! i = None i E
| CoPsetBot => False
end := eq_refl _.
Definition namespace_map_validN_eq :
validN = λ n x, match namespace_map_token_proj x with
| CoPset E =>
{n} (namespace_map_data_proj x)
(* dom (namespace_map_data_proj x) ⊥ E *)
i, namespace_map_data_proj x !! i = None i E
| CoPsetBot => False
end := eq_refl _.
Lemma namespace_map_included x y :
x y
namespace_map_data_proj x namespace_map_data_proj y
namespace_map_token_proj x namespace_map_token_proj y.
Proof.
split; [intros [[z1 z2] Hz]; split; [exists z1|exists z2]; apply Hz|].
intros [[z1 Hz1] [z2 Hz2]]; exists (NamespaceMap z1 z2); split; auto.
Qed.
Lemma namespace_map_data_proj_validN n x : {n} x {n} namespace_map_data_proj x.
Proof. by destruct x as [? [?|]]=> // -[??]. Qed.
Lemma namespace_map_token_proj_validN n x : {n} x {n} namespace_map_token_proj x.
Proof. by destruct x as [? [?|]]=> // -[??]. Qed.
Lemma namespace_map_cmra_mixin : CmraMixin (namespace_map A).
Proof.
apply cmra_total_mixin.
- eauto.
- by intros n x y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'.
- solve_proper.
- intros n [m1 [E1|]] [m2 [E2|]] [Hm ?]=> // -[??]; split; simplify_eq/=.
+ by rewrite -Hm.
+ intros i. by rewrite -(dist_None n) -Hm dist_None.
- intros [m [E|]]; rewrite namespace_map_valid_eq namespace_map_validN_eq /=
?cmra_valid_validN; naive_solver eauto using 0.
- intros n [m [E|]]; rewrite namespace_map_validN_eq /=;
naive_solver eauto using cmra_validN_S.
- split; simpl; [by rewrite assoc|by rewrite assoc_L].
- split; simpl; [by rewrite comm|by rewrite comm_L].
- split; simpl; [by rewrite cmra_core_l|by rewrite left_id_L].
- split; simpl; [by rewrite cmra_core_idemp|done].
- intros ??; rewrite! namespace_map_included; intros [??].
by split; simpl; apply: cmra_core_mono. (* FIXME: apply cmra_core_mono. fails *)
- intros n [m1 [E1|]] [m2 [E2|]]=> //=; rewrite namespace_map_validN_eq /=.
rewrite {1}/op /cmra_op /=. case_decide; last done.
intros [Hm Hdisj]; split; first by eauto using cmra_validN_op_l.
intros i. move: (Hdisj i). rewrite lookup_op.
case: (m1 !! i)=> [a|]; last auto.
move=> []. by case: (m2 !! i). set_solver.
- intros n x y1 y2 ? [??]; simpl in *.
destruct (cmra_extend n (namespace_map_data_proj x)
(namespace_map_data_proj y1) (namespace_map_data_proj y2))
as (m1&m2&?&?&?); auto using namespace_map_data_proj_validN.
destruct (cmra_extend n (namespace_map_token_proj x)
(namespace_map_token_proj y1) (namespace_map_token_proj y2))
as (E1&E2&?&?&?); auto using namespace_map_token_proj_validN.
by exists (NamespaceMap m1 E1), (NamespaceMap m2 E2).
Qed.
Canonical Structure namespace_mapR :=
CmraT (namespace_map A) namespace_map_cmra_mixin.
Global Instance namespace_map_cmra_discrete :
CmraDiscrete A CmraDiscrete namespace_mapR.
Proof.
split; first apply _.
intros [m [E|]]; rewrite namespace_map_validN_eq namespace_map_valid_eq //=.
naive_solver eauto using (cmra_discrete_valid m).
Qed.
Instance namespace_map_empty : Unit (namespace_map A) := NamespaceMap ε ε.
Lemma namespace_map_ucmra_mixin : UcmraMixin (namespace_map A).
Proof.
split; simpl.
- rewrite namespace_map_valid_eq /=. split. apply ucmra_unit_valid. set_solver.
- split; simpl; [by rewrite left_id|by rewrite left_id_L].
- do 2 constructor; [apply (core_id_core _)|done].
Qed.
Canonical Structure namespace_mapUR :=
UcmraT (namespace_map A) namespace_map_ucmra_mixin.
Global Instance namespace_map_data_core_id N a :
CoreId a CoreId (namespace_map_data N a).
Proof. do 2 constructor; simpl; auto. apply core_id_core, _. Qed.
Lemma namespace_map_data_valid N a : (namespace_map_data N a) a.
Proof. rewrite namespace_map_valid_eq /= singleton_valid. set_solver. Qed.
Lemma namespace_map_token_valid E : (namespace_map_token E).
Proof. rewrite namespace_map_valid_eq /=. split. done. by left. Qed.
Lemma namespace_map_data_op N a b :
namespace_map_data N (a b) = namespace_map_data N a namespace_map_data N b.
Proof.
by rewrite {2}/op /namespace_map_op /namespace_map_data /= -op_singleton left_id_L.
Qed.
Lemma namespace_map_data_mono N a b :
a b namespace_map_data N a namespace_map_data N b.
Proof. intros [c ->]. rewrite namespace_map_data_op. apply cmra_included_l. Qed.
Global Instance is_op_namespace_map_data N a b1 b2 :
IsOp a b1 b2
IsOp' (namespace_map_data N a) (namespace_map_data N b1) (namespace_map_data N b2).
Proof. rewrite /IsOp' /IsOp=> ->. by rewrite namespace_map_data_op. Qed.
Lemma namespace_map_token_union E1 E2 :
E1 ## E2
namespace_map_token (E1 E2) = namespace_map_token E1 namespace_map_token E2.
Proof.
intros. by rewrite /op /namespace_map_op
/namespace_map_token /= coPset_disj_union // left_id_L.
Qed.
Lemma namespace_map_token_difference E1 E2 :
E1 E2
namespace_map_token E2 = namespace_map_token E1 namespace_map_token (E2 E1).
Proof.
intros. rewrite -namespace_map_token_union; last set_solver.
by rewrite -union_difference_L.
Qed.
Lemma namespace_map_token_valid_op E1 E2 :
(namespace_map_token E1 namespace_map_token E2) E1 ## E2.
Proof.
rewrite namespace_map_valid_eq /= {1}/op /cmra_op /=. case_decide; last done.
split; [done|]; intros _. split.
- by rewrite left_id.
- intros i. rewrite lookup_op lookup_empty. auto.
Qed.
(** [↑N ⊆ E] is stronger than needed, just [positives_flatten N ∈ E] would be
sufficient. However, we do not have convenient infrastructure to prove the
latter, so we use the former. *)
Lemma namespace_map_alloc_update E N a :
N E a namespace_map_token E ~~> namespace_map_data N a.
Proof.
assert (positives_flatten N (N : coPset)).
{ rewrite nclose_eq. apply elem_coPset_suffixes.
exists 1%positive. by rewrite left_id_L. }
intros ??. apply cmra_total_update=> n [mf [Ef|]] //.
rewrite namespace_map_validN_eq /= {1}/op /cmra_op /=. case_decide; last done.
rewrite left_id_L {1}left_id. intros [Hmf Hdisj]; split.
- destruct (Hdisj (positives_flatten N)) as [Hmfi|]; last set_solver.
move: Hmfi. rewrite lookup_op lookup_empty left_id_L=> Hmfi.
intros j. rewrite lookup_op.
destruct (decide (positives_flatten N = j)) as [<-|].
+ rewrite Hmfi lookup_singleton right_id_L. by apply cmra_valid_validN.
+ by rewrite lookup_singleton_ne // left_id_L.
- intros j. destruct (decide (positives_flatten N = j)); first set_solver.
rewrite lookup_op lookup_singleton_ne //.
destruct (Hdisj j) as [Hmfi|?]; last set_solver.
move: Hmfi. rewrite lookup_op lookup_empty; auto.
Qed.
Lemma namespace_map_updateP P (Q : namespace_map A Prop) N a :
a ~~>: P
( a', P a' Q (namespace_map_data N a')) namespace_map_data N a ~~>: Q.
Proof.
intros Hup HP. apply cmra_total_updateP=> n [mf [Ef|]] //.
rewrite namespace_map_validN_eq /= left_id_L. intros [Hmf Hdisj].
destruct (Hup n (mf !! positives_flatten N)) as (a'&?&?).
{ move: (Hmf (positives_flatten N)).
by rewrite lookup_op lookup_singleton Some_op_opM. }
exists (namespace_map_data N a'); split; first by eauto.
rewrite /= left_id_L. split.
- intros j. destruct (decide (positives_flatten N = j)) as [<-|].
+ by rewrite lookup_op lookup_singleton Some_op_opM.
+ rewrite lookup_op lookup_singleton_ne // left_id_L.
move: (Hmf j). rewrite lookup_op. eauto using cmra_validN_op_r.
- intros j. move: (Hdisj j).
rewrite !lookup_op !op_None !lookup_singleton_None. naive_solver.
Qed.
Lemma namespace_map_update N a b :
a ~~> b namespace_map_data N a ~~> namespace_map_data N b.
Proof.
rewrite !cmra_update_updateP. eauto using namespace_map_updateP with subst.
Qed.
End cmra.
Arguments namespace_mapR : clear implicits.
Arguments namespace_mapUR : clear implicits.
From iris.algebra Require Import auth gmap frac agree.
From iris.algebra Require Import auth gmap frac agree namespace_map.
From stdpp Require Export namespaces.
From iris.base_logic.lib Require Export own.
From iris.bi.lib Require Import fractional.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
(** This file provides a generic mechanism for a point-to connective [l ↦{q} v]
with fractional permissions (where [l : L] and [v : V] over some abstract type
[L] for locations and [V] for values). This mechanism can be plugged into a
language by using the heap invariant [gen_heap_ctx σ] where [σ : gmap L V]. See
heap-lang for an example.
Next to the point-to connective [l ↦{q} v], which keeps track of the value [v]
of a location [l], this mechanism allows one to attach "meta" or "ghost" data to
locations. This is done as follows:
- When one allocates a location, in addition to the point-to connective [l ↦ v],
one also obtains the token [meta_token ⊤ l]. This token is an exclusive
resource that denotes that no meta data has been associated with the
namespaces in the mask [⊤] for the location [l].
- Meta data tokens can be split w.r.t. namespace masks, i.e.
[meta_token l (E1 ∪ E2) ⊣⊢ meta_token l E1 ∗ meta_token l E2] if [E1 ## E2].
- Meta data can be set using the update [meta_token l E ==∗ meta l N x] provided
[↑N ⊆ E], and [x : A] for any countable [A]. The [meta l N x] connective is
persistent and denotes the knowledge that the meta data [x] has been
associated with namespace [N] to the location [l].
To make the mechanism as flexible as possible, the [x : A] in [meta l N x] can
be of any countable type [A]. This means that you can associate e.g. single
ghost names, but also tuples of ghost names, etc.
To further increase flexibility, the [meta l N x] and [meta_token l E]
connectives are annotated with a namespace [N] and mask [E]. That way, one can
assign a map of meta information to a location. This is particularly useful when
building abstractions, then one can gradually assign more ghost information to a
location instead of having to do all of this at once. We use namespaces so that
these can be matched up with the invariant namespaces. *)
(** To implement this mechanism, we use three resource algebras:
- An authoritative RA over [gmap L (fracR * agreeR V)], which keeps track of the
values of locations.
- An authoritative RA over [gmap L (agree gname)], which keeps track of the meta
information of locations. This RA introduces an indirection, it keeps track of
a ghost name for each location.
- The ghost names in the aforementioned authoritative RA refer to namespace maps
[namespace_map (agree positive)], which store the actual meta information.
This indirection is needed because we cannot perform frame preserving updates
in an authoritative fragment without owning the full authoritative element
(in other words, without the indirection [meta_set] would need [gen_heap_ctx]
as a premise).
Note that in principle we could have used one big authoritative RA to keep track
of both values and ghost names for meta information, for example:
[gmap L (option (fracR * agreeR V) ∗ option (agree gname)]. Due to the [option]s,
this RA would be quite inconvenient to deal with. *)
Definition gen_heapUR (L V : Type) `{Countable L} : ucmraT :=
gmapUR L (prodR fracR (agreeR (leibnizC V))).
Definition gen_metaUR (L : Type) `{Countable L} : ucmraT :=
gmapUR L (agreeR gnameC).
Definition to_gen_heap {L V} `{Countable L} : gmap L V gen_heapUR L V :=
fmap (λ v, (1%Qp, to_agree (v : leibnizC V))).
Definition to_gen_meta `{Countable L} : gmap L gname gen_metaUR L :=
fmap to_agree.
(** The CMRA we need. *)
Class gen_heapG (L V : Type) (Σ : gFunctors) `{Countable L} := GenHeapG {
gen_heap_inG :> inG Σ (authR (gen_heapUR L V));
gen_heap_name : gname
gen_meta_inG :> inG Σ (authR (gen_metaUR L));
gen_meta_data_inG :> inG Σ (namespace_mapR (agreeR positiveC));
gen_heap_name : gname;
gen_meta_name : gname
}.
Arguments gen_heap_name {_ _ _ _ _} _ : assert.
Arguments gen_meta_name {_ _ _ _ _} _ : assert.
Class gen_heapPreG (L V : Type) (Σ : gFunctors) `{Countable L} :=
{ gen_heap_preG_inG :> inG Σ (authR (gen_heapUR L V)) }.
Class gen_heapPreG (L V : Type) (Σ : gFunctors) `{Countable L} := {
gen_heap_preG_inG :> inG Σ (authR (gen_heapUR L V));
gen_meta_preG_inG :> inG Σ (authR (gen_metaUR L));
gen_meta_data_preG_inG :> inG Σ (namespace_mapR (agreeR positiveC));
}.
Definition gen_heapΣ (L V : Type) `{Countable L} : gFunctors :=
#[GFunctor (authR (gen_heapUR L V))].
Definition gen_heapΣ (L V : Type) `{Countable L} : gFunctors := #[
GFunctor (authR (gen_heapUR L V));
GFunctor (authR (gen_metaUR L));
GFunctor (namespace_mapR (agreeR positiveC))
].
Instance subG_gen_heapPreG {Σ L V} `{Countable L} :
subG (gen_heapΣ L V) Σ gen_heapPreG L V Σ.
......@@ -30,14 +97,32 @@ Proof. solve_inG. Qed.
Section definitions.
Context `{Countable L, hG : !gen_heapG L V Σ}.
Definition gen_heap_ctx (σ : gmap L V) : iProp Σ :=
own (gen_heap_name hG) ( (to_gen_heap σ)).
Definition gen_heap_ctx (σ : gmap L V) : iProp Σ := ( m,
(* The [⊆] is used to avoid assigning ghost information to the locations in
the initial heap (see [gen_heap_init]). *)
dom _ m dom (gset L) σ
own (gen_heap_name hG) ( (to_gen_heap σ))
own (gen_meta_name hG) ( (to_gen_meta m)))%I.
Definition mapsto_def (l : L) (q : Qp) (v: V) : iProp Σ :=
own (gen_heap_name hG) ( {[ l := (q, to_agree (v : leibnizC V)) ]}).
Definition mapsto_aux : seal (@mapsto_def). by eexists. Qed.
Definition mapsto := mapsto_aux.(unseal).
Definition mapsto_eq : @mapsto = @mapsto_def := mapsto_aux.(seal_eq).
Definition meta_token_def (l : L) (E : coPset) : iProp Σ :=
( γm, own (gen_meta_name hG) ( {[ l := to_agree γm ]})
own γm (namespace_map_token E))%I.
Definition meta_token_aux : seal (@meta_token_def). by eexists. Qed.
Definition meta_token := meta_token_aux.(unseal).
Definition meta_token_eq : @meta_token = @meta_token_def := meta_token_aux.(seal_eq).
Definition meta_def `{Countable A} (l : L) (N : namespace) (x : A) : iProp Σ :=
( γm, own (gen_meta_name hG) ( {[ l := to_agree γm ]})
own γm (namespace_map_data N (to_agree (encode x))))%I.
Definition meta_aux : seal (@meta_def). by eexists. Qed.
Definition meta {A dA cA} := meta_aux.(unseal) A dA cA.
Definition meta_eq : @meta = @meta_def := meta_aux.(seal_eq).
End definitions.
Local Notation "l ↦{ q } v" := (mapsto l q v)
......@@ -51,6 +136,7 @@ Local Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : bi_scope.
Section to_gen_heap.
Context (L V : Type) `{Countable L}.
Implicit Types σ : gmap L V.
Implicit Types m : gmap L gname.
(** Conversion to heaps and back *)
Lemma to_gen_heap_valid σ : to_gen_heap σ.
......@@ -67,17 +153,25 @@ Section to_gen_heap.
Lemma to_gen_heap_insert l v σ :
to_gen_heap (<[l:=v]> σ) = <[l:=(1%Qp, to_agree (v:leibnizC V))]> (to_gen_heap σ).
Proof. by rewrite /to_gen_heap fmap_insert. Qed.
Lemma to_gen_heap_delete l σ :
to_gen_heap (delete l σ) = delete l (to_gen_heap σ).
Proof. by rewrite /to_gen_heap fmap_delete. Qed.
Lemma to_gen_meta_valid m : to_gen_meta m.
Proof. intros l. rewrite lookup_fmap. by case (m !! l). Qed.
Lemma lookup_to_gen_meta_None m l : m !! l = None to_gen_meta m !! l = None.
Proof. by rewrite /to_gen_meta lookup_fmap=> ->. Qed.
Lemma to_gen_meta_insert l m γm :
to_gen_meta (<[l:=γm]> m) = <[l:=to_agree γm]> (to_gen_meta m).
Proof. by rewrite /to_gen_meta fmap_insert. Qed.
End to_gen_heap.
Lemma gen_heap_init `{Countable L, !gen_heapPreG L V Σ} σ :
(|==> _ : gen_heapG L V Σ, gen_heap_ctx σ)%I.
Proof.
iMod (own_alloc ( to_gen_heap σ)) as (γ) "Hh".
iMod (own_alloc ( to_gen_heap σ)) as (γh) "Hh".
{ rewrite auth_auth_valid. exact: to_gen_heap_valid. }
iModIntro. by iExists (GenHeapG L V Σ _ _ _ γ).
iMod (own_alloc ( to_gen_meta )) as (γm) "Hm".
{ rewrite auth_auth_valid. exact: to_gen_meta_valid. }
iModIntro. iExists (GenHeapG L V Σ _ _ _ _ _ γh γm).
iExists ; simpl. iFrame "Hh Hm". by rewrite dom_empty_L.
Qed.
Section gen_heap.
......@@ -85,6 +179,7 @@ Section gen_heap.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : V iProp Σ.
Implicit Types σ : gmap L V.
Implicit Types m : gmap L gname.
Implicit Types h g : gen_heapUR L V.
Implicit Types l : L.
Implicit Types v : V.
......@@ -131,44 +226,103 @@ Section gen_heap.
iApply (mapsto_valid l _ v2). by iFrame.
Qed.
(** General properties of [meta] and [meta_token] *)
Global Instance meta_token_timeless l N : Timeless (meta_token l N).
Proof. rewrite meta_token_eq /meta_token_def. apply _. Qed.
Global Instance meta_timeless `{Countable A} l N (x : A) : Timeless (meta l N x).
Proof. rewrite meta_eq /meta_def. apply _. Qed.
Global Instance meta_persistent `{Countable A} l N (x : A) : Persistent (meta l N x).
Proof. rewrite meta_eq /meta_def. apply _. Qed.
Lemma meta_token_union_1 l E1 E2 :
E1 ## E2 meta_token l (E1 E2) - meta_token l E1 meta_token l E2.
Proof.
rewrite meta_token_eq /meta_token_def. intros ?. iDestruct 1 as (γm1) "[#Hγm Hm]".
rewrite namespace_map_token_union //. iDestruct "Hm" as "[Hm1 Hm2]".
iSplitL "Hm1"; eauto.
Qed.
Lemma meta_token_union_2 l E1 E2 :
meta_token l E1 - meta_token l E2 - meta_token l (E1 E2).
Proof.
rewrite meta_token_eq /meta_token_def.
iDestruct 1 as (γm1) "[#Hγm1 Hm1]". iDestruct 1 as (γm2) "[#Hγm2 Hm2]".
iAssert γm1 = γm2 %I as %->.
{ iDestruct (own_valid_2 with "Hγm1 Hγm2") as %Hγ; iPureIntro.
move: Hγ. rewrite -auth_frag_op op_singleton=> /auth_frag_valid /=.
rewrite singleton_valid. apply: agree_op_invL'. }
iDestruct (own_valid_2 with "Hm1 Hm2") as %?%namespace_map_token_valid_op.
iExists γm2. iFrame "Hγm2". rewrite namespace_map_token_union //. by iSplitL "Hm1".
Qed.
Lemma meta_token_union l E1 E2 :
E1 ## E2 meta_token l (E1 E2) meta_token l E1 meta_token l E2.
Proof.
intros; iSplit; first by iApply meta_token_union_1.
iIntros "[Hm1 Hm2]". by iApply (meta_token_union_2 with "Hm1 Hm2").
Qed.
Lemma meta_agree `{Countable A} l i (x1 x2 : A) :
meta l i x1 - meta l i x2 - x1 = x2.
Proof.
rewrite meta_eq /meta_def.
iDestruct 1 as (γm1) "[Hγm1 Hm1]"; iDestruct 1 as (γm2) "[Hγm2 Hm2]".
iAssert γm1 = γm2 %I as %->.
{ iDestruct (own_valid_2 with "Hγm1 Hγm2") as %Hγ; iPureIntro.
move: Hγ. rewrite -auth_frag_op op_singleton=> /auth_frag_valid /=.
rewrite singleton_valid. apply: agree_op_invL'. }
iDestruct (own_valid_2 with "Hm1 Hm2") as %Hγ; iPureIntro.
move: Hγ. rewrite -namespace_map_data_op namespace_map_data_valid.