Commit 716f554d authored by Robbert Krebbers's avatar Robbert Krebbers

Start integrating memory model with sequence point semantics.

parent 65be1966
...@@ -11,13 +11,13 @@ Require Export fin_maps. ...@@ -11,13 +11,13 @@ Require Export fin_maps.
(** Because the association list is sorted using [strict lexico] instead of (** Because the association list is sorted using [strict lexico] instead of
[lexico], it automatically guarantees that no duplicates exist. *) [lexico], it automatically guarantees that no duplicates exist. *)
Definition assoc (K : Type) `{Lexico K} `{!TrichotomyT lexico} Definition assoc (K : Type) `{Lexico K, !TrichotomyT lexico,
`{!StrictOrder lexico} (A : Type) : Type := !StrictOrder lexico} (A : Type) : Type :=
dsig (λ l : list (K * A), StronglySorted lexico (fst <$> l)). dsig (λ l : list (K * A), StronglySorted lexico (fst <$> l)).
Section assoc. Section assoc.
Context `{Lexico K} `{!StrictOrder lexico}. Context `{Lexico K, !StrictOrder lexico,
Context `{ x y : K, Decision (x = y)} `{!TrichotomyT lexico}. x y : K, Decision (x = y), !TrichotomyT lexico}.
Infix "⊂" := lexico. Infix "⊂" := lexico.
Notation assoc_before j l := Notation assoc_before j l :=
...@@ -44,6 +44,7 @@ Ltac simplify_assoc := intros; ...@@ -44,6 +44,7 @@ Ltac simplify_assoc := intros;
| H : StronglySorted _ (_ :: _) |- _ => inversion_clear H | H : StronglySorted _ (_ :: _) |- _ => inversion_clear H
| _ => progress decompose_elem_of_list | _ => progress decompose_elem_of_list
| _ => progress simplify_equality' | _ => progress simplify_equality'
| _ => match goal with |- context [?o = _] => by destruct o end
end; end;
repeat first repeat first
[ progress simplify_order [ progress simplify_order
...@@ -139,30 +140,45 @@ Proof. ...@@ -139,30 +140,45 @@ Proof.
destruct (f _); simplify_assoc. destruct (f _); simplify_assoc.
Qed. Qed.
Lemma assoc_fmap_wf {A B} (f : A B) (l : list (K * A)) : Lemma assoc_fmap_wf {A B} (f : A B) (l : list (K * A)) :
assoc_wf l assoc_wf (snd_map f <$> l). assoc_wf l assoc_wf (prod_map id f <$> l).
Proof. Proof.
intros. by rewrite <-list_fmap_compose, intros. by rewrite <-list_fmap_compose,
(list_fmap_ext _ fst l l) by (done; by intros []). (list_fmap_ext _ fst l l) by (done; by intros []).
Qed. Qed.
Global Program Instance assoc_fmap: FMap (assoc K) := λ A B f m, Global Program Instance assoc_fmap: FMap (assoc K) := λ A B f m,
dexist _ (assoc_fmap_wf f _ (proj2_dsig m)). dexist _ (assoc_fmap_wf f _ (proj2_dsig m)).
Lemma assoc_lookup_fmap {A B} (f : A B) (l : list (K * A)) i : Lemma assoc_lookup_fmap {A B} (f : A B) (l : list (K * A)) i :
assoc_lookup_raw i (snd_map f <$> l) = fmap f (assoc_lookup_raw i l). assoc_lookup_raw i (prod_map id f <$> l) = fmap f (assoc_lookup_raw i l).
Proof. induction l as [|[??]]; simplify_assoc. Qed. Proof. induction l as [|[??]]; simplify_assoc. Qed.
Fixpoint assoc_merge_aux {A B} (f : option A option B) Fixpoint assoc_omap_raw {A B} (f : A option B)
(l : list (K * A)) : list (K * B) := (l : list (K * A)) : list (K * B) :=
match l with match l with
| [] => [] | [] => []
| (i,x) :: l => assoc_cons i (f (Some x)) (assoc_merge_aux f l) | (i,x) :: l => assoc_cons i (f x) (assoc_omap_raw f l)
end. end.
Lemma assoc_omap_raw_before {A B} (f : A option B) l j :
assoc_before j l assoc_before j (assoc_omap_raw f l).
Proof. induction l as [|[??]]; simplify_assoc. Qed.
Hint Resolve assoc_omap_raw_before.
Lemma assoc_omap_wf {A B} (f : A option B) l :
assoc_wf l assoc_wf (assoc_omap_raw f l).
Proof. induction l as [|[??]]; simplify_assoc. Qed.
Hint Resolve assoc_omap_wf.
Global Instance assoc_omap: OMap (assoc K) := λ A B f m,
dexist _ (assoc_omap_wf f _ (proj2_dsig m)).
Lemma assoc_omap_spec {A B} (f : A option B) l i :
assoc_wf l
assoc_lookup_raw i (assoc_omap_raw f l) = assoc_lookup_raw i l = f.
Proof. intros. induction l as [|[??]]; simplify_assoc. Qed.
Hint Rewrite @assoc_omap_spec using (by eauto) : assoc.
Fixpoint assoc_merge_raw {A B C} (f : option A option B option C) Fixpoint assoc_merge_raw {A B C} (f : option A option B option C)
(l : list (K * A)) : list (K * B) list (K * C) := (l : list (K * A)) : list (K * B) list (K * C) :=
fix go (k : list (K * B)) := fix go (k : list (K * B)) :=
match l, k with match l, k with
| [], _ => assoc_merge_aux (f None) k | [], _ => assoc_omap_raw (f None Some) k
| _, [] => assoc_merge_aux (flip f None) l | _, [] => assoc_omap_raw (flip f None Some) l
| (i,x) :: l, (j,y) :: k => | (i,x) :: l, (j,y) :: k =>
match trichotomyT lexico i j with match trichotomyT lexico i j with
| (**i i ⊂ j *) inleft (left _) => | (**i i ⊂ j *) inleft (left _) =>
...@@ -173,15 +189,13 @@ Fixpoint assoc_merge_raw {A B C} (f : option A → option B → option C) ...@@ -173,15 +189,13 @@ Fixpoint assoc_merge_raw {A B C} (f : option A → option B → option C)
assoc_cons j (f None (Some y)) (go k) assoc_cons j (f None (Some y)) (go k)
end end
end. end.
Section assoc_merge_raw. Section assoc_merge_raw.
Context {A B C} (f : option A option B option C). Context {A B C} (f : option A option B option C).
Lemma assoc_merge_nil_l k : Lemma assoc_merge_nil_l k :
assoc_merge_raw f [] k = assoc_merge_aux (f None) k. assoc_merge_raw f [] k = assoc_omap_raw (f None Some) k.
Proof. by destruct k. Qed. Proof. by destruct k. Qed.
Lemma assoc_merge_nil_r l : Lemma assoc_merge_nil_r l :
assoc_merge_raw f l [] = assoc_merge_aux (flip f None) l. assoc_merge_raw f l [] = assoc_omap_raw (flip f None Some) l.
Proof. by destruct l as [|[??]]. Qed. Proof. by destruct l as [|[??]]. Qed.
Lemma assoc_merge_cons i x j y l k : Lemma assoc_merge_cons i x j y l k :
assoc_merge_raw f ((i,x) :: l) ((j,y) :: k) = assoc_merge_raw f ((i,x) :: l) ((j,y) :: k) =
...@@ -195,14 +209,8 @@ Section assoc_merge_raw. ...@@ -195,14 +209,8 @@ Section assoc_merge_raw.
end. end.
Proof. done. Qed. Proof. done. Qed.
End assoc_merge_raw. End assoc_merge_raw.
Arguments assoc_merge_raw _ _ _ _ _ _ : simpl never. Arguments assoc_merge_raw _ _ _ _ _ _ : simpl never.
Hint Rewrite @assoc_merge_nil_l @assoc_merge_nil_r @assoc_merge_cons : assoc. Hint Rewrite @assoc_merge_nil_l @assoc_merge_nil_r @assoc_merge_cons : assoc.
Lemma assoc_merge_aux_before {A B} (f : option A option B) l j :
assoc_before j l assoc_before j (assoc_merge_aux f l).
Proof. induction l as [|[??]]; simplify_assoc. Qed.
Hint Resolve assoc_merge_aux_before.
Lemma assoc_merge_before {A B C} (f : option A option B option C) l1 l2 j : Lemma assoc_merge_before {A B C} (f : option A option B option C) l1 l2 j :
assoc_before j l1 assoc_before j l2 assoc_before j l1 assoc_before j l2
assoc_before j (assoc_merge_raw f l1 l2). assoc_before j (assoc_merge_raw f l1 l2).
...@@ -211,26 +219,14 @@ Proof. ...@@ -211,26 +219,14 @@ Proof.
intros l2; induction l2 as [|[??] l2 IH2]; simplify_assoc. intros l2; induction l2 as [|[??] l2 IH2]; simplify_assoc.
Qed. Qed.
Hint Resolve assoc_merge_before. Hint Resolve assoc_merge_before.
Lemma assoc_merge_wf {A B C} (f : option A option B option C) l1 l2 : Lemma assoc_merge_wf {A B C} (f : option A option B option C) l1 l2 :
assoc_wf l1 assoc_wf l2 assoc_wf (assoc_merge_raw f l1 l2). assoc_wf l1 assoc_wf l2 assoc_wf (assoc_merge_raw f l1 l2).
Proof. Proof.
revert A B C f l1 l2. assert ( A B (f : option A option B) l, revert l2. induction l1 as [|[i x] l1 IH];
assoc_wf l assoc_wf (assoc_merge_aux f l)).
{ intros ?? j l. induction l as [|[??]]; simplify_assoc. }
intros A B C f l1. induction l1 as [|[i x] l1 IH];
intros l2; induction l2 as [|[j y] l2 IH2]; simplify_assoc. intros l2; induction l2 as [|[j y] l2 IH2]; simplify_assoc.
Qed. Qed.
Global Instance assoc_merge: Merge (assoc K) := λ A B C f m1 m2, Global Instance assoc_merge: Merge (assoc K) := λ A B C f m1 m2,
dexist (merge f (`m1) (`m2)) dexist _ (assoc_merge_wf f _ _ (proj2_dsig m1) (proj2_dsig m2)).
(assoc_merge_wf _ _ _ (proj2_dsig m1) (proj2_dsig m2)).
Lemma assoc_merge_aux_spec {A B} (f : option A option B) l i :
f None = None assoc_wf l
assoc_lookup_raw i (assoc_merge_aux f l) = f (assoc_lookup_raw i l).
Proof. intros. induction l as [|[??]]; simplify_assoc. Qed.
Hint Rewrite @assoc_merge_aux_spec using (by eauto) : assoc.
Lemma assoc_merge_spec {A B C} (f : option A option B option C) l1 l2 i : Lemma assoc_merge_spec {A B C} (f : option A option B option C) l1 l2 i :
f None None = None assoc_wf l1 assoc_wf l2 f None None = None assoc_wf l1 assoc_wf l2
assoc_lookup_raw i (assoc_merge_raw f l1 l2) = assoc_lookup_raw i (assoc_merge_raw f l1 l2) =
...@@ -268,6 +264,7 @@ Proof. ...@@ -268,6 +264,7 @@ Proof.
* intros ??? [??] ?. apply assoc_lookup_fmap. * intros ??? [??] ?. apply assoc_lookup_fmap.
* intros ? [??]. apply assoc_to_list_nodup; auto. * intros ? [??]. apply assoc_to_list_nodup; auto.
* intros ? [??] ??. apply assoc_to_list_elem_of; auto. * intros ? [??] ??. apply assoc_to_list_elem_of; auto.
* intros ??? [??] ?. apply assoc_omap_spec; auto.
* intros ????? [??] [??] ?. apply assoc_merge_spec; auto. * intros ????? [??] [??] ?. apply assoc_merge_spec; auto.
Qed. Qed.
End assoc. End assoc.
...@@ -275,8 +272,8 @@ End assoc. ...@@ -275,8 +272,8 @@ End assoc.
(** * Finite sets *) (** * Finite sets *)
(** We construct finite sets using the above implementation of maps. *) (** We construct finite sets using the above implementation of maps. *)
Notation assoc_set K := (mapset (assoc K)). Notation assoc_set K := (mapset (assoc K)).
Instance assoc_map_dom `{Lexico K} `{!TrichotomyT (@lexico K _)} Instance assoc_map_dom `{Lexico K, !TrichotomyT (@lexico K _),
`{!StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom. !StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom.
Instance assoc_map_dom_spec `{Lexico K} `{!TrichotomyT (@lexico K _)} Instance assoc_map_dom_spec `{Lexico K} `{!TrichotomyT (@lexico K _)}
`{!StrictOrder lexico} `{ x y : K, Decision (x = y)} : `{!StrictOrder lexico, x y : K, Decision (x = y)} :
FinMapDom K (assoc K) (assoc_set K) := mapset_dom_spec. FinMapDom K (assoc K) (assoc_set K) := mapset_dom_spec.
This diff is collapsed.
...@@ -5,6 +5,9 @@ importantly, it implements some tactics to automatically solve goals involving ...@@ -5,6 +5,9 @@ importantly, it implements some tactics to automatically solve goals involving
collections. *) collections. *)
Require Export base tactics orders. Require Export base tactics orders.
Instance collection_subseteq `{ElemOf A C} : SubsetEq C := λ X Y,
x, x X x Y.
(** * Basic theorems *) (** * Basic theorems *)
Section simple_collection. Section simple_collection.
Context `{SimpleCollection A C}. Context `{SimpleCollection A C}.
...@@ -16,8 +19,6 @@ Section simple_collection. ...@@ -16,8 +19,6 @@ Section simple_collection.
Lemma elem_of_union_r x X Y : x Y x X Y. Lemma elem_of_union_r x X Y : x Y x X Y.
Proof. intros. apply elem_of_union. auto. Qed. Proof. intros. apply elem_of_union. auto. Qed.
Global Instance collection_subseteq: SubsetEq C := λ X Y,
x, x X x Y.
Global Instance: BoundedJoinSemiLattice C. Global Instance: BoundedJoinSemiLattice C.
Proof. firstorder auto. Qed. Proof. firstorder auto. Qed.
...@@ -34,29 +35,25 @@ Section simple_collection. ...@@ -34,29 +35,25 @@ Section simple_collection.
Lemma elem_of_subseteq_singleton x X : x X {[ x ]} X. Lemma elem_of_subseteq_singleton x X : x X {[ x ]} X.
Proof. Proof.
split. split.
* intros ??. rewrite elem_of_singleton. intro. by subst. * intros ??. rewrite elem_of_singleton. by intros ->.
* intros Ex. by apply (Ex x), elem_of_singleton. * intros Ex. by apply (Ex x), elem_of_singleton.
Qed. Qed.
Global Instance singleton_proper : Proper ((=) ==> ()) singleton. Global Instance singleton_proper : Proper ((=) ==> ()) singleton.
Proof. repeat intro. by subst. Qed. Proof. by repeat intro; subst. Qed.
Global Instance elem_of_proper: Proper ((=) ==> () ==> iff) () | 5. Global Instance elem_of_proper: Proper ((=) ==> () ==> iff) () | 5.
Proof. intros ???. subst. firstorder. Qed. Proof. intros ???; subst. firstorder. Qed.
Lemma elem_of_union_list Xs x : x Xs X, X Xs x X. Lemma elem_of_union_list Xs x : x Xs X, X Xs x X.
Proof. Proof.
split. split.
* induction Xs; simpl; intros HXs. * induction Xs; simpl; intros HXs; [by apply elem_of_empty in HXs|].
+ by apply elem_of_empty in HXs. setoid_rewrite elem_of_cons. apply elem_of_union in HXs. naive_solver.
+ setoid_rewrite elem_of_cons. * intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
apply elem_of_union in HXs. naive_solver. intros. apply elem_of_union_r; auto.
* intros [X []]. induction 1; simpl.
+ by apply elem_of_union_l.
+ intros. apply elem_of_union_r; auto.
Qed. Qed.
Lemma non_empty_singleton x : {[ x ]} . Lemma non_empty_singleton x : {[ x ]} .
Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed. Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed.
Lemma not_elem_of_singleton x y : x {[ y ]} x y. Lemma not_elem_of_singleton x y : x {[ y ]} x y.
Proof. by rewrite elem_of_singleton. Qed. Proof. by rewrite elem_of_singleton. Qed.
Lemma not_elem_of_union x X Y : x X Y x X x Y. Lemma not_elem_of_union x X Y : x X Y x X x Y.
...@@ -64,7 +61,6 @@ Section simple_collection. ...@@ -64,7 +61,6 @@ Section simple_collection.
Section leibniz. Section leibniz.
Context `{!LeibnizEquiv C}. Context `{!LeibnizEquiv C}.
Lemma elem_of_equiv_L X Y : X = Y x, x X x Y. Lemma elem_of_equiv_L X Y : X = Y x, x X x Y.
Proof. unfold_leibniz. apply elem_of_equiv. Qed. Proof. unfold_leibniz. apply elem_of_equiv. Qed.
Lemma elem_of_equiv_alt_L X Y : Lemma elem_of_equiv_alt_L X Y :
...@@ -78,7 +74,6 @@ Section simple_collection. ...@@ -78,7 +74,6 @@ Section simple_collection.
Section dec. Section dec.
Context `{ X Y : C, Decision (X Y)}. Context `{ X Y : C, Decision (X Y)}.
Global Instance elem_of_dec_slow (x : A) (X : C) : Decision (x X) | 100. Global Instance elem_of_dec_slow (x : A) (X : C) : Decision (x X) | 100.
Proof. Proof.
refine (cast_if (decide_rel () {[ x ]} X)); refine (cast_if (decide_rel () {[ x ]} X));
...@@ -203,18 +198,12 @@ Section collection. ...@@ -203,18 +198,12 @@ Section collection.
Context `{Collection A C}. Context `{Collection A C}.
Global Instance: LowerBoundedLattice C. Global Instance: LowerBoundedLattice C.
Proof. Proof. split. apply _. firstorder auto. solve_elem_of. Qed.
split.
* apply _.
* firstorder auto.
* solve_elem_of.
Qed.
Lemma intersection_singletons x : {[x]} {[x]} {[x]}. Lemma intersection_singletons x : {[x]} {[x]} {[x]}.
Proof. esolve_elem_of. Qed. Proof. esolve_elem_of. Qed.
Lemma difference_twice X Y : (X Y) Y X Y. Lemma difference_twice X Y : (X Y) Y X Y.
Proof. esolve_elem_of. Qed. Proof. esolve_elem_of. Qed.
Lemma empty_difference X Y : X Y X Y . Lemma empty_difference X Y : X Y X Y .
Proof. esolve_elem_of. Qed. Proof. esolve_elem_of. Qed.
Lemma difference_diag X : X X . Lemma difference_diag X : X X .
...@@ -226,12 +215,10 @@ Section collection. ...@@ -226,12 +215,10 @@ Section collection.
Section leibniz. Section leibniz.
Context `{!LeibnizEquiv C}. Context `{!LeibnizEquiv C}.
Lemma intersection_singletons_L x : {[x]} {[x]} = {[x]}. Lemma intersection_singletons_L x : {[x]} {[x]} = {[x]}.
Proof. unfold_leibniz. apply intersection_singletons. Qed. Proof. unfold_leibniz. apply intersection_singletons. Qed.
Lemma difference_twice_L X Y : (X Y) Y = X Y. Lemma difference_twice_L X Y : (X Y) Y = X Y.
Proof. unfold_leibniz. apply difference_twice. Qed. Proof. unfold_leibniz. apply difference_twice. Qed.
Lemma empty_difference_L X Y : X Y X Y = . Lemma empty_difference_L X Y : X Y X Y = .
Proof. unfold_leibniz. apply empty_difference. Qed. Proof. unfold_leibniz. apply empty_difference. Qed.
Lemma difference_diag_L X : X X = . Lemma difference_diag_L X : X X = .
...@@ -245,20 +232,14 @@ Section collection. ...@@ -245,20 +232,14 @@ Section collection.
Section dec. Section dec.
Context `{ X Y : C, Decision (X Y)}. Context `{ X Y : C, Decision (X Y)}.
Lemma not_elem_of_intersection x X Y : x X Y x X x Y. Lemma not_elem_of_intersection x X Y : x X Y x X x Y.
Proof. Proof. rewrite elem_of_intersection. destruct (decide (x X)); tauto. Qed.
rewrite elem_of_intersection. destruct (decide (x X)); tauto.
Qed.
Lemma not_elem_of_difference x X Y : x X Y x X x Y. Lemma not_elem_of_difference x X Y : x X Y x X x Y.
Proof. Proof. rewrite elem_of_difference. destruct (decide (x Y)); tauto. Qed.
rewrite elem_of_difference. destruct (decide (x Y)); tauto.
Qed.
Lemma union_difference X Y : X Y Y X Y X. Lemma union_difference X Y : X Y Y X Y X.
Proof. Proof.
split; intros x; rewrite !elem_of_union, elem_of_difference. split; intros x; rewrite !elem_of_union, elem_of_difference; [|intuition].
* destruct (decide (x X)); intuition. destruct (decide (x X)); intuition.
* intuition.
Qed. Qed.
Lemma non_empty_difference X Y : X Y Y X . Lemma non_empty_difference X Y : X Y Y X .
Proof. Proof.
...@@ -267,7 +248,6 @@ Section collection. ...@@ -267,7 +248,6 @@ Section collection.
Qed. Qed.
Context `{!LeibnizEquiv C}. Context `{!LeibnizEquiv C}.
Lemma union_difference_L X Y : X Y Y = X Y X. Lemma union_difference_L X Y : X Y Y = X Y X.
Proof. unfold_leibniz. apply union_difference. Qed. Proof. unfold_leibniz. apply union_difference. Qed.
Lemma non_empty_difference_L X Y : X Y Y X . Lemma non_empty_difference_L X Y : X Y Y X .
...@@ -283,12 +263,10 @@ Section collection_ops. ...@@ -283,12 +263,10 @@ Section collection_ops.
Forall2 () xs Xs y Y foldr (λ x, (= f x)) (Some y) xs = Some x. Forall2 () xs Xs y Y foldr (λ x, (= f x)) (Some y) xs = Some x.
Proof. Proof.
split. split.
* revert x. induction Xs; simpl; intros x HXs. * revert x. induction Xs; simpl; intros x HXs; [eexists [], x; intuition|].
+ eexists [], x. intuition. rewrite elem_of_intersection_with in HXs; destruct HXs as (x1&x2&?&?&?).
+ rewrite elem_of_intersection_with in HXs. destruct (IHXs x2) as (xs & y & hy & ? & ?); trivial.
destruct HXs as (x1 & x2 & Hx1 & Hx2 & ?). eexists (x1 :: xs), y. intuition (simplify_option_equality; auto).
destruct (IHXs x2) as (xs & y & hy & ? & ?); trivial.
eexists (x1 :: xs), y. intuition (simplify_option_equality; auto).
* intros (xs & y & Hxs & ? & Hx). revert x Hx. * intros (xs & y & Hxs & ? & Hx). revert x Hx.
induction Hxs; intros; simplify_option_equality; [done |]. induction Hxs; intros; simplify_option_equality; [done |].
rewrite elem_of_intersection_with. naive_solver. rewrite elem_of_intersection_with. naive_solver.
...@@ -416,23 +394,17 @@ Section fresh. ...@@ -416,23 +394,17 @@ Section fresh.
Global Instance fresh_list_proper: Proper ((=) ==> () ==> (=)) fresh_list. Global Instance fresh_list_proper: Proper ((=) ==> () ==> (=)) fresh_list.
Proof. Proof.
intros ? n ?. subst. induction n; simpl; intros ?? E; f_equal. intros ? n ->. induction n as [|n IH]; intros ?? E; f_equal'; [by rewrite E|].
* by rewrite E. apply IH. by rewrite E.
* apply IHn. by rewrite E.
Qed. Qed.
Lemma fresh_list_length n X : length (fresh_list n X) = n. Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed. Proof. revert X. induction n; simpl; auto. Qed.
Lemma fresh_list_is_fresh n X x : x fresh_list n X x X. Lemma fresh_list_is_fresh n X x : x fresh_list n X x X.
Proof. Proof.
revert X. induction n; intros X; simpl. revert X. induction n as [|n IH]; intros X; simpl; [by rewrite elem_of_nil|].
* by rewrite elem_of_nil. rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|].
* rewrite elem_of_cons. intros [?| Hin]; subst. apply IH in Hin; solve_elem_of.
+ apply is_fresh.
+ apply IHn in Hin. solve_elem_of.
Qed. Qed.
Lemma fresh_list_nodup n X : NoDup (fresh_list n X). Lemma fresh_list_nodup n X : NoDup (fresh_list n X).
Proof. Proof.
revert X. induction n; simpl; constructor; auto. revert X. induction n; simpl; constructor; auto.
...@@ -441,20 +413,14 @@ Section fresh. ...@@ -441,20 +413,14 @@ Section fresh.
End fresh. End fresh.
Definition option_collection `{Singleton A C} `{Empty C} (x : option A) : C := Definition option_collection `{Singleton A C} `{Empty C} (x : option A) : C :=
match x with match x with None => | Some a => {[ a ]} end.
| None =>
| Some a => {[ a ]}
end.
(** * Properties of implementations of collections that form a monad *) (** * Properties of implementations of collections that form a monad *)
Section collection_monad. Section collection_monad.
Context `{CollectionMonad M}. Context `{CollectionMonad M}.
Global Instance collection_guard: MGuard M := λ P dec A x, Global Instance collection_guard: MGuard M := λ P dec A x,
match dec with match dec with left H => x H | _ => end.
| left H => x H
| _ =>
end.
Global Instance collection_fmap_proper {A B} (f : A B) : Global Instance collection_fmap_proper {A B} (f : A B) :
Proper (() ==> ()) (fmap f). Proper (() ==> ()) (fmap f).
...@@ -496,9 +462,8 @@ Section collection_monad. ...@@ -496,9 +462,8 @@ Section collection_monad.
Lemma elem_of_mapM_fmap {A B} (f : A B) (g : B M A) l k : Lemma elem_of_mapM_fmap {A B} (f : A B) (g : B M A) l k :
Forall (λ x, y, y g x f y = x) l k mapM g l fmap f k = l. Forall (λ x, y, y g x f y = x) l k mapM g l fmap f k = l.
Proof. Proof.
intros Hl. revert k. intros Hl. revert k. induction Hl; simpl; intros;
induction Hl; simpl; intros; decompose_elem_of; f_equal'; auto.
decompose_elem_of; simpl; f_equal; auto.
Qed. Qed.
Lemma elem_of_mapM_Forall {A B} (f : A M B) (P : B Prop) l k : Lemma elem_of_mapM_Forall {A B} (f : A M B) (P : B Prop) l k :
......
...@@ -70,6 +70,7 @@ Ltac solve_decision := intros; first ...@@ -70,6 +70,7 @@ Ltac solve_decision := intros; first
(** The following combinators are useful to create Decision proofs in (** The following combinators are useful to create Decision proofs in
combination with the [refine] tactic. *) combination with the [refine] tactic. *)
Notation swap_if S := (match S with left H => right H | right H => left H end).
Notation cast_if S := (if S then left _ else right _). Notation cast_if S := (if S then left _ else right _).
Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _). Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _).
Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _). Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _).
...@@ -77,6 +78,8 @@ Notation cast_if_and4 S1 S2 S3 S4 := ...@@ -77,6 +78,8 @@ Notation cast_if_and4 S1 S2 S3 S4 :=
(if S1 then cast_if_and3 S2 S3 S4 else right _). (if S1 then cast_if_and3 S2 S3 S4 else right _).
Notation cast_if_and5 S1 S2 S3 S4 S5 := Notation cast_if_and5 S1 S2 S3 S4 S5 :=
(if S1 then cast_if_and4 S2 S3 S4 S5 else right _). (if S1 then cast_if_and4 S2 S3 S4 S5 else right _).
Notation cast_if_and6 S1 S2 S3 S4 S5 S6 :=
(if S1 then cast_if_and5 S2 S3 S4 S5 S6 else right _).
Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2). Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2).
Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3). Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3).
Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _). Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _).
...@@ -131,6 +134,8 @@ Proof. by apply dsig_eq. Qed. ...@@ -131,6 +134,8 @@ Proof. by apply dsig_eq. Qed.
(** Instances of [Decision] for operators of propositional logic. *) (** Instances of [Decision] for operators of propositional logic. *)
Instance True_dec: Decision True := left I. Instance True_dec: Decision True := left I.
Instance False_dec: Decision False := right (False_rect False). Instance False_dec: Decision False := right (False_rect False).
Instance Is_true_dec b : Decision (Is_true b).
Proof. destruct b; apply _. Defined.
Section prop_dec. Section prop_dec.
Context `(P_dec : Decision P) `(Q_dec : Decision Q). Context `(P_dec : Decision P) `(Q_dec : Decision Q).
...@@ -144,18 +149,17 @@ Section prop_dec. ...@@ -144,18 +149,17 @@ Section prop_dec.
Global Instance impl_dec: Decision (P Q). Global Instance impl_dec: Decision (P Q).
Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined. Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
End prop_dec. End prop_dec.
Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
Decision (P Q) := and_dec _ _.
(** Instances of [Decision] for common data types. *) (** Instances of [Decision] for common data types. *)
Instance bool_eq_dec (x y : bool) : Decision (x = y). Instance bool_eq_dec (x y : bool) : Decision (x = y).
Proof. solve_decision. Defined. Proof. solve_decision. Defined.
Instance unit_eq_dec (x y : unit) : Decision (x = y). Instance unit_eq_dec (x y : unit) : Decision (x = y).
Proof. refine (left _); by destruct x, y. Defined. Proof. solve_decision. Defined.
Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y)) Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y))
`(B_dec : x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y). `(B_dec : x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y).
Proof. Proof. solve_decision. Defined.
refine (cast_if_and (A_dec (fst x) (fst y)) (B_dec (snd x) (snd y)));
abstract (destruct x, y; simpl in *; congruence).
Defined.
Instance sum_eq_dec `(A_dec : x y : A, Decision (x = y)) Instance sum_eq_dec `(A_dec : x y : A, Decision (x = y))
`(B_dec : x y : B, Decision (x = y)) (x y : A + B) : Decision (x = y). `(B_dec : x y : B, Decision (x = y)) (x y : A + B) : Decision (x = y).
Proof. solve_decision. Defined. Proof. solve_decision. Defined.
...@@ -173,7 +177,11 @@ Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x)} ...@@ -173,7 +177,11 @@ Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x)}
Proof. refine (cast_if (decide (`x = `y))); by rewrite sig_eq_pi. Defined. Proof. refine (cast_if (decide (`x = `y))); by rewrite sig_eq_pi. Defined.