Commit a90a8e99 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

CMRA structure on gsets that avoids the indirection via maps.

Also, add algebra/gset to _CoqProject.
parent c46bb2a0
...@@ -59,6 +59,7 @@ algebra/frac.v ...@@ -59,6 +59,7 @@ algebra/frac.v
algebra/csum.v algebra/csum.v
algebra/list.v algebra/list.v
algebra/updates.v algebra/updates.v
algebra/gset.v
program_logic/model.v program_logic/model.v
program_logic/adequacy.v program_logic/adequacy.v
program_logic/hoare_lifting.v program_logic/hoare_lifting.v
......
From iris.algebra Require Export gmap. From iris.algebra Require Export cmra.
From iris.algebra Require Import excl. From iris.algebra Require Import updates.
From iris.prelude Require Import mapset. From iris.prelude Require Export collections gmap.
Definition gsetC K `{Countable K} := gmapC K (exclC unitC). Inductive gset_disj K `{Countable K} :=
| GSet : gset K gset_disj K
Definition to_gsetC `{Countable K} (X : gset K) : gsetC K := | GSetBot : gset_disj K.
to_gmap (Excl ()) X. Arguments GSet {_ _ _} _.
Arguments GSetBot {_ _ _}.
Section gset. Section gset.
Context `{Countable K}. Context `{Countable K}.
Implicit Types X Y : gset K. Arguments op _ _ !_ !_ /.
Lemma to_gsetC_empty : to_gsetC ( : gset K) = . Canonical Structure gset_disjC := leibnizC (gset_disj K).
Proof. apply to_gmap_empty. Qed.
Lemma to_gsetC_union X Y : X Y to_gsetC X to_gsetC Y = to_gsetC (X Y). Instance gset_disj_valid : Valid (gset_disj K) := λ X,
Proof. match X with GSet _ => True | GSetBot => False end.
intros HXY; apply: map_eq=> i; rewrite /to_gsetC /=. Instance gset_disj_empty : Empty (gset_disj K) := GSet .
rewrite lookup_op !lookup_to_gmap. repeat case_option_guard; set_solver. Instance gset_disj_op : Op (gset_disj K) := λ X Y,
Qed. match X, Y with
Lemma to_gsetC_valid X : to_gsetC X. | GSet X, GSet Y => if decide (X Y) then GSet (X Y) else GSetBot
Proof. intros i. rewrite /to_gsetC lookup_to_gmap. by case_option_guard. Qed. | _, _ => GSetBot
Lemma to_gsetC_valid_op X Y : (to_gsetC X to_gsetC Y) X Y. end.
Proof. Instance gset_disj_pcore : PCore (gset_disj K) := λ _, Some .
split; last (intros; rewrite to_gsetC_union //; apply to_gsetC_valid).
intros HXY i ??; move: (HXY i); rewrite lookup_op !lookup_to_gmap. Ltac gset_disj_solve :=
rewrite !option_guard_True //. repeat (simpl || case_decide);
Qed. first [apply (f_equal GSet)|done|exfalso]; set_solver by eauto.
Context `{Fresh K (gset K), !FreshSpec K (gset K)}. Lemma gset_disj_valid_inv_l X Y : (GSet X Y) Y', Y = GSet Y' X Y'.
Lemma updateP_alloc_strong (Q : gsetC K Prop) (I : gset K) X : Proof. destruct Y; repeat (simpl || case_decide); by eauto. Qed.
( i, i X i I Q (to_gsetC ({[i]} X))) to_gsetC X ~~>: Q. Lemma gset_disj_union X Y : X Y GSet X GSet Y = GSet (X Y).
Proof. Proof. intros. by rewrite /= decide_True. Qed.
intros; apply updateP_alloc_strong with I (Excl ()); [done|]=> i. Lemma gset_disj_valid_op X Y : (GSet X GSet Y) X Y.
rewrite /to_gsetC lookup_to_gmap_None -to_gmap_union_singleton; eauto. Proof. simpl. case_decide; by split. Qed.
Qed.
Lemma updateP_alloc (Q : gsetC K Prop) X : Lemma gset_disj_ra_mixin : RAMixin (gset_disj K).
( i, i X Q (to_gsetC ({[i]} X))) to_gsetC X ~~>: Q. Proof.
Proof. move=>??. eapply updateP_alloc_strong with (I:=); by eauto. Qed. apply ra_total_mixin; eauto.
Lemma updateP_alloc_strong' (I : gset K) X : - intros [?|]; destruct 1; gset_disj_solve.
to_gsetC X ~~>: λ Y : gsetC K, i, Y = to_gsetC ({[ i ]} X) i I i X. - by constructor.
Proof. eauto using updateP_alloc_strong. Qed. - by destruct 1.
Lemma updateP_alloc' X : - intros [X1|] [X2|] [X3|]; gset_disj_solve.
to_gsetC X ~~>: λ Y : gsetC K, i, Y = to_gsetC ({[ i ]} X) i X. - intros [X1|] [X2|]; gset_disj_solve.
Proof. eauto using updateP_alloc. Qed. - intros [X|]; gset_disj_solve.
End gset. - exists (GSet ); gset_disj_solve.
\ No newline at end of file - intros [X1|] [X2|]; gset_disj_solve.
Qed.
Canonical Structure gset_disjR := discreteR (gset_disj K) gset_disj_ra_mixin.
Lemma gset_disj_ucmra_mixin : UCMRAMixin (gset_disj K).
Proof. split; try apply _ || done. intros [X|]; gset_disj_solve. Qed.
Canonical Structure gset_disjUR :=
discreteUR (gset_disj K) gset_disj_ra_mixin gset_disj_ucmra_mixin.
Context `{Fresh K (gset K), !FreshSpec K (gset K)}.
Arguments op _ _ _ _ : simpl never.
Lemma updateP_alloc_strong (Q : gset_disj K Prop) (I : gset K) X :
( i, i X i I Q (GSet ({[i]} X))) GSet X ~~>: Q.
Proof.
intros HQ; apply cmra_discrete_updateP=> ? /gset_disj_valid_inv_l [Y [->?]].
destruct (exist_fresh (X Y I)) as [i ?].
exists (GSet ({[ i ]} X)); split.
- apply HQ; set_solver by eauto.
- apply gset_disj_valid_op. set_solver by eauto.
Qed.
Lemma updateP_alloc (Q : gset_disj K Prop) X :
( i, i X Q (GSet ({[i]} X))) GSet X ~~>: Q.
Proof. move=>??. eapply updateP_alloc_strong with (I:=); by eauto. Qed.
Lemma updateP_alloc_strong' (I : gset K) X :
GSet X ~~>: λ Y, i, Y = GSet ({[ i ]} X) i I i X.
Proof. eauto using updateP_alloc_strong. Qed.
Lemma updateP_alloc' X : GSet X ~~>: λ Y, i, Y = GSet ({[ i ]} X) i X.
Proof. eauto using updateP_alloc. Qed.
End gset.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment