Commit d60affc0 authored by Robbert Krebbers's avatar Robbert Krebbers

Preparation to port the master branch

Major changes:
* A data structure to collect locked addresses in memory.
* Operations to lock and unlock addresses.
* Remove [ctree_Forall] and express it using [Forall] and [ctree_flatten]. This
  saves a lot of lines of code.
* Add a [void] value. This value cannot be typed, but will be used as a dummy
  return value for functions with return type [void].

Minor changes:
* Various deciders in preparation of the executable semantics.
* Improve naming and notations.
* Remove obsolete stuff.
parent 46799584
...@@ -9,11 +9,6 @@ Global Set Automatic Coercions Import. ...@@ -9,11 +9,6 @@ Global Set Automatic Coercions Import.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid. Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
(** * General *) (** * General *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion Is_true : bool >-> Sortclass.
Notation "(&&)" := andb (only parsing).
Notation "(||)" := orb (only parsing).
(** Zipping lists. *) (** Zipping lists. *)
Definition zip_with {A B C} (f : A B C) : list A list B list C := Definition zip_with {A B C} (f : A B C) : list A list B list C :=
fix go l1 l2 := fix go l1 l2 :=
...@@ -500,14 +495,6 @@ Class Merge (M : Type → Type) := ...@@ -500,14 +495,6 @@ Class Merge (M : Type → Type) :=
Instance: Params (@merge) 4. Instance: Params (@merge) 4.
Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch. Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch.
(** We lift the insert and delete operation to lists of elements. *)
Definition insert_list `{Insert K A M} (l : list (K * A)) (m : M) : M :=
fold_right (λ p, <[p.1:=p.2]>) m l.
Instance: Params (@insert_list) 4.
Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
Instance: Params (@delete_list) 3.
(** The function [union_with f m1 m2] is supposed to yield the union of [m1] (** The function [union_with f m1 m2] is supposed to yield the union of [m1]
and [m2] using the function [f] to combine values of members that are in and [m2] using the function [f] to combine values of members that are in
both [m1] and [m2]. *) both [m1] and [m2]. *)
...@@ -724,8 +711,8 @@ Class FinCollection A C `{ElemOf A C, Empty C, Singleton A C, ...@@ -724,8 +711,8 @@ Class FinCollection A C `{ElemOf A C, Empty C, Singleton A C,
Union C, Intersection C, Difference C, Union C, Intersection C, Difference C,
Elements A C, x y : A, Decision (x = y)} : Prop := { Elements A C, x y : A, Decision (x = y)} : Prop := {
fin_collection :>> Collection A C; fin_collection :>> Collection A C;
elements_spec X x : x X x elements X; elem_of_elements X x : x elements X x X;
elements_nodup X : NoDup (elements X) NoDup_elements X : NoDup (elements X)
}. }.
Class Size C := size: C nat. Class Size C := size: C nat.
Arguments size {_ _} !_ / : simpl nomatch. Arguments size {_ _} !_ / : simpl nomatch.
...@@ -763,6 +750,20 @@ Class FreshSpec A C `{ElemOf A C, ...@@ -763,6 +750,20 @@ Class FreshSpec A C `{ElemOf A C,
is_fresh (X : C) : fresh X X is_fresh (X : C) : fresh X X
}. }.
(** * Booleans *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion Is_true : bool >-> Sortclass.
Notation "(&&)" := andb (only parsing).
Notation "(||)" := orb (only parsing).
Infix "&&*" := (zip_with (&&)) (at level 40).
Infix "||*" := (zip_with (||)) (at level 50).
Definition bool_le (β1 β2 : bool) : Prop := negb β1 || β2.
Infix "=.>" := bool_le (at level 70).
Infix "=.>*" := (Forall2 bool_le) (at level 70).
Instance: PartialOrder bool_le.
Proof. repeat split; repeat intros [|]; compute; tauto. Qed.
(** * Miscellaneous *) (** * Miscellaneous *)
Class Half A := half: A A. Class Half A := half: A A.
Notation "½" := half : C_scope. Notation "½" := half : C_scope.
...@@ -823,14 +824,6 @@ Section prod_relation. ...@@ -823,14 +824,6 @@ Section prod_relation.
End prod_relation. End prod_relation.
(** ** Other *) (** ** Other *)
Definition proj_eq {A B} (f : B A) : relation B := λ x y, f x = f y.
Global Instance proj_eq_equivalence `(f : B A) : Equivalence (proj_eq f).
Proof. unfold proj_eq. repeat split; red; intuition congruence. Qed.
Notation "x ~{ f } y" := (proj_eq f x y)
(at level 70, format "x ~{ f } y") : C_scope.
Hint Extern 0 (_ ~{_} _) => reflexivity.
Hint Extern 0 (_ ~{_} _) => symmetry; assumption.
Instance: A B (x : B), Commutative (=) (λ _ _ : A, x). Instance: A B (x : B), Commutative (=) (λ _ _ : A, x).
Proof. red. trivial. Qed. Proof. red. trivial. Qed.
Instance: A (x : A), Associative (=) (λ _ _ : A, x). Instance: A (x : A), Associative (=) (λ _ _ : A, x).
......
...@@ -18,10 +18,8 @@ Section simple_collection. ...@@ -18,10 +18,8 @@ Section simple_collection.
Proof. intros. apply elem_of_union. auto. Qed. Proof. intros. apply elem_of_union. auto. Qed.
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: BoundedJoinSemiLattice C. Global Instance: BoundedJoinSemiLattice C.
Proof. firstorder auto. Qed. Proof. firstorder auto. Qed.
Lemma elem_of_subseteq X Y : X Y x, x X x Y. Lemma elem_of_subseteq X Y : X Y x, x X x Y.
Proof. done. Qed. Proof. done. Qed.
Lemma elem_of_equiv X Y : X Y x, x X x Y. Lemma elem_of_equiv X Y : X Y x, x X x Y.
...@@ -31,7 +29,12 @@ Section simple_collection. ...@@ -31,7 +29,12 @@ Section simple_collection.
Proof. firstorder. Qed. Proof. firstorder. Qed.
Lemma elem_of_equiv_empty X : X x, x X. Lemma elem_of_equiv_empty X : X x, x X.
Proof. firstorder. Qed. Proof. firstorder. Qed.
Lemma collection_positive_l X Y : X Y X .
Proof.
rewrite !elem_of_equiv_empty. setoid_rewrite elem_of_union. naive_solver.
Qed.
Lemma collection_positive_l_alt X Y : X X Y .
Proof. eauto using collection_positive_l. Qed.
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.
...@@ -42,7 +45,6 @@ Section simple_collection. ...@@ -42,7 +45,6 @@ Section simple_collection.
Proof. by repeat intro; 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.
...@@ -51,7 +53,6 @@ Section simple_collection. ...@@ -51,7 +53,6 @@ Section simple_collection.
* intros [X []]. induction 1; simpl; [by apply elem_of_union_l |]. * intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
intros. apply elem_of_union_r; auto. 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.
...@@ -68,6 +69,10 @@ Section simple_collection. ...@@ -68,6 +69,10 @@ Section simple_collection.
Proof. unfold_leibniz. apply elem_of_equiv_alt. Qed. Proof. unfold_leibniz. apply elem_of_equiv_alt. Qed.
Lemma elem_of_equiv_empty_L X : X = x, x X. Lemma elem_of_equiv_empty_L X : X = x, x X.
Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed. Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed.
Lemma collection_positive_l_L X Y : X Y = X = .
Proof. unfold_leibniz. apply collection_positive_l. Qed.
Lemma collection_positive_l_alt_L X Y : X X Y .
Proof. unfold_leibniz. apply collection_positive_l_alt. Qed.
Lemma non_empty_singleton_L x : {[ x ]} . Lemma non_empty_singleton_L x : {[ x ]} .
Proof. unfold_leibniz. apply non_empty_singleton. Qed. Proof. unfold_leibniz. apply non_empty_singleton. Qed.
End leibniz. End leibniz.
...@@ -385,7 +390,7 @@ Section quantifiers. ...@@ -385,7 +390,7 @@ Section quantifiers.
End quantifiers. End quantifiers.
Section more_quantifiers. Section more_quantifiers.
Context `{Collection A B}. Context `{SimpleCollection A B}.
Lemma set_Forall_weaken (P Q : A Prop) (Hweaken : x, P x Q x) X : Lemma set_Forall_weaken (P Q : A Prop) (Hweaken : x, P x Q x) X :
set_Forall P X set_Forall Q X. set_Forall P X set_Forall Q X.
......
...@@ -6,8 +6,6 @@ principles on finite collections . *) ...@@ -6,8 +6,6 @@ principles on finite collections . *)
Require Import Permutation ars listset. Require Import Permutation ars listset.
Require Export numbers collections. Require Export numbers collections.
Definition collection_choose `{Elements A C} (X : C) : option A :=
head (elements X).
Instance collection_size `{Elements A C} : Size C := length elements. Instance collection_size `{Elements A C} : Size C := length elements.
Definition collection_fold `{Elements A C} {B} Definition collection_fold `{Elements A C} {B}
(f : A B B) (b : B) : C B := foldr f b elements. (f : A B B) (b : B) : C B := foldr f b elements.
...@@ -18,76 +16,56 @@ Context `{FinCollection A C}. ...@@ -18,76 +16,56 @@ Context `{FinCollection A C}.
Global Instance elements_proper: Proper (() ==> ()) elements. Global Instance elements_proper: Proper (() ==> ()) elements.
Proof. Proof.
intros ?? E. apply NoDup_Permutation. intros ?? E. apply NoDup_Permutation.
* apply elements_nodup. * apply NoDup_elements.
* apply elements_nodup. * apply NoDup_elements.
* intros. by rewrite <-!elements_spec, E. * intros. by rewrite !elem_of_elements, E.
Qed. Qed.
Global Instance collection_size_proper: Proper (() ==> (=)) size. Global Instance collection_size_proper: Proper (() ==> (=)) size.
Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed. Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed.
Lemma size_empty : size ( : C) = 0. Lemma size_empty : size ( : C) = 0.
Proof. Proof.
unfold size, collection_size. simpl. unfold size, collection_size. simpl.
rewrite (elem_of_nil_inv (elements )); [done |]. rewrite (elem_of_nil_inv (elements )); [done |].
intro. rewrite <-elements_spec. solve_elem_of. intro. rewrite elem_of_elements. solve_elem_of.
Qed. Qed.
Lemma size_empty_inv (X : C) : size X = 0 X . Lemma size_empty_inv (X : C) : size X = 0 X .
Proof. Proof.
intros. apply equiv_empty. intro. rewrite elements_spec. intros. apply equiv_empty. intro. rewrite <-elem_of_elements.
rewrite (nil_length_inv (elements X)). by rewrite elem_of_nil. done. rewrite (nil_length_inv (elements X)). by rewrite elem_of_nil. done.
Qed. Qed.
Lemma size_empty_iff (X : C) : size X = 0 X . Lemma size_empty_iff (X : C) : size X = 0 X .
Proof. split. apply size_empty_inv. intros E. by rewrite E, size_empty. Qed. Proof. split. apply size_empty_inv. intros E. by rewrite E, size_empty. Qed.
Lemma size_non_empty_iff (X : C) : size X 0 X . Lemma size_non_empty_iff (X : C) : size X 0 X .
Proof. by rewrite size_empty_iff. Qed. Proof. by rewrite size_empty_iff. Qed.
Lemma size_singleton (x : A) : size {[ x ]} = 1. Lemma size_singleton (x : A) : size {[ x ]} = 1.
Proof. Proof.
change (length (elements {[ x ]}) = length [x]). change (length (elements {[ x ]}) = length [x]).
apply Permutation_length, NoDup_Permutation. apply Permutation_length, NoDup_Permutation.
* apply elements_nodup. * apply NoDup_elements.
* apply NoDup_singleton. * apply NoDup_singleton.
* intros. * intros. by rewrite elem_of_elements,
by rewrite <-elements_spec, elem_of_singleton, elem_of_list_singleton. elem_of_singleton, elem_of_list_singleton.
Qed. Qed.
Lemma size_singleton_inv X x y : size X = 1 x X y X x = y. Lemma size_singleton_inv X x y : size X = 1 x X y X x = y.
Proof. Proof.
unfold size, collection_size. simpl. rewrite !elements_spec. unfold size, collection_size. simpl. rewrite <-!elem_of_elements.
generalize (elements X). intros [|? l]; intro; simplify_equality. generalize (elements X). intros [|? l]; intro; simplify_equality.
rewrite (nil_length_inv l), !elem_of_list_singleton by done. congruence. rewrite (nil_length_inv l), !elem_of_list_singleton by done. congruence.
Qed. Qed.
Lemma collection_choose_or_empty X : ( x, x X) X .
Lemma collection_choose_Some X x : collection_choose X = Some x x X.
Proof.
unfold collection_choose. destruct (elements X) eqn:E; intros;
simplify_equality. rewrite elements_spec, E. by left.
Qed.
Lemma collection_choose_None X : collection_choose X = None X .
Proof.
unfold collection_choose.
destruct (elements X) eqn:E; intros; simplify_equality.
apply equiv_empty. intros x. by rewrite elements_spec, E, elem_of_nil.
Qed.
Lemma elem_of_or_empty X : ( x, x X) X .
Proof.
destruct (collection_choose X) eqn:?;
eauto using collection_choose_Some, collection_choose_None.
Qed.
Lemma collection_choose_is_Some X : X is_Some (collection_choose X).
Proof.
destruct (collection_choose X) eqn:?.
* rewrite elem_of_equiv_empty. split; eauto using collection_choose_Some.
* split. intros []; eauto using collection_choose_None. by intros [??].
Qed.
Lemma not_elem_of_equiv_empty X : X ( x, x X).
Proof. Proof.
destruct (elem_of_or_empty X) as [?|E]; [esolve_elem_of |]. destruct (elements X) as [|x l] eqn:HX; [right|left].
setoid_rewrite E. setoid_rewrite elem_of_empty. naive_solver. * apply equiv_empty. intros x. by rewrite <-elem_of_elements, HX, elem_of_nil.
* exists x. rewrite <-elem_of_elements, HX. by left.
Qed. Qed.
Lemma collection_choose X : X x, x X.
Proof. intros. by destruct (collection_choose_or_empty X). Qed.
Lemma collection_choose_L `{!LeibnizEquiv C} X : X x, x X.
Proof. unfold_leibniz. apply collection_choose. Qed.
Lemma size_pos_elem_of X : 0 < size X x, x X. Lemma size_pos_elem_of X : 0 < size X x, x X.
Proof. Proof.
intros E1. apply not_elem_of_equiv_empty. intros E2. intros Hsz. destruct (collection_choose_or_empty X) as [|HX]; [done|].
rewrite E2, size_empty in E1. lia. contradict Hsz. rewrite HX, size_empty; lia.
Qed. Qed.
Lemma size_1_elem_of X : size X = 1 x, X {[ x ]}. Lemma size_1_elem_of X : size X = 1 x, X {[ x ]}.
Proof. Proof.
...@@ -96,27 +74,24 @@ Proof. ...@@ -96,27 +74,24 @@ Proof.
* rewrite elem_of_singleton. eauto using size_singleton_inv. * rewrite elem_of_singleton. eauto using size_singleton_inv.
* solve_elem_of. * solve_elem_of.
Qed. Qed.
Lemma size_union X Y : X Y size (X Y) = size X + size Y. Lemma size_union X Y : X Y size (X Y) = size X + size Y.
Proof. Proof.
intros [E _]. unfold size, collection_size. simpl. rewrite <-app_length. intros [E _]. unfold size, collection_size. simpl. rewrite <-app_length.
apply Permutation_length, NoDup_Permutation. apply Permutation_length, NoDup_Permutation.
* apply elements_nodup. * apply NoDup_elements.
* apply NoDup_app; repeat split; try apply elements_nodup. * apply NoDup_app; repeat split; try apply NoDup_elements.
intros x. rewrite <-!elements_spec. esolve_elem_of. intros x. rewrite !elem_of_elements. esolve_elem_of.
* intros. rewrite elem_of_app, <-!elements_spec. solve_elem_of. * intros. rewrite elem_of_app, !elem_of_elements. solve_elem_of.
Qed. Qed.
Instance elem_of_dec_slow (x : A) (X : C) : Decision (x X) | 100. Instance elem_of_dec_slow (x : A) (X : C) : Decision (x X) | 100.
Proof. Proof.
refine (cast_if (decide_rel () x (elements X))); refine (cast_if (decide_rel () x (elements X)));
by rewrite (elements_spec _). by rewrite <-(elem_of_elements _).
Defined. Defined.
Global Program Instance collection_subseteq_dec_slow (X Y : C) : Global Program Instance collection_subseteq_dec_slow (X Y : C) :
Decision (X Y) | 100 := Decision (X Y) | 100 :=
match decide_rel (=) (size (X Y)) 0 with match decide_rel (=) (size (X Y)) 0 with
| left E1 => left _ | left E1 => left _ | right E1 => right _
| right E1 => right _
end. end.
Next Obligation. Next Obligation.
intros x Ex; apply dec_stable; intro. destruct (proj1 (elem_of_empty x)). intros x Ex; apply dec_stable; intro. destruct (proj1 (elem_of_empty x)).
...@@ -126,14 +101,12 @@ Next Obligation. ...@@ -126,14 +101,12 @@ Next Obligation.
intros E2. destruct E1. apply size_empty_iff, equiv_empty. intros x. intros E2. destruct E1. apply size_empty_iff, equiv_empty. intros x.
rewrite elem_of_difference. intros [E3 ?]. by apply E2 in E3. rewrite elem_of_difference. intros [E3 ?]. by apply E2 in E3.
Qed. Qed.
Lemma size_union_alt X Y : size (X Y) = size X + size (Y X). Lemma size_union_alt X Y : size (X Y) = size X + size (Y X).
Proof. Proof.
rewrite <-size_union by solve_elem_of. rewrite <-size_union by solve_elem_of.
setoid_replace (Y X) with ((Y X) X) by esolve_elem_of. setoid_replace (Y X) with ((Y X) X) by esolve_elem_of.
rewrite <-union_difference, (commutative ()); solve_elem_of. rewrite <-union_difference, (commutative ()); solve_elem_of.
Qed. Qed.
Lemma subseteq_size X Y : X Y size X size Y. Lemma subseteq_size X Y : X Y size X size Y.
Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed. Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed.
Lemma subset_size X Y : X Y size X < size Y. Lemma subset_size X Y : X Y size X < size Y.
...@@ -143,22 +116,19 @@ Proof. ...@@ -143,22 +116,19 @@ Proof.
cut (size (Y X) 0); [lia |]. cut (size (Y X) 0); [lia |].
by apply size_non_empty_iff, non_empty_difference. by apply size_non_empty_iff, non_empty_difference.
Qed. Qed.
Lemma collection_wf : wf (strict (@subseteq C _)). Lemma collection_wf : wf (strict (@subseteq C _)).
Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed. Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed.
Lemma collection_ind (P : C Prop) : Lemma collection_ind (P : C Prop) :
Proper (() ==> iff) P Proper (() ==> iff) P
P ( x X, x X P X P ({[ x ]} X)) X, P X. P ( x X, x X P X P ({[ x ]} X)) X, P X.
Proof. Proof.
intros ? Hemp Hadd. apply well_founded_induction with (). intros ? Hemp Hadd. apply well_founded_induction with ().
{ apply collection_wf. } { apply collection_wf. }
intros X IH. destruct (elem_of_or_empty X) as [[x ?]|HX]. intros X IH. destruct (collection_choose_or_empty X) as [[x ?]|HX].
* rewrite (union_difference {[ x ]} X) by solve_elem_of. * rewrite (union_difference {[ x ]} X) by solve_elem_of.
apply Hadd. solve_elem_of. apply IH. esolve_elem_of. apply Hadd. solve_elem_of. apply IH. esolve_elem_of.
* by rewrite HX. * by rewrite HX.
Qed. Qed.
Lemma collection_fold_ind {B} (P : B C Prop) (f : A B B) (b : B) : Lemma collection_fold_ind {B} (P : B C Prop) (f : A B B) (b : B) :
Proper ((=) ==> () ==> iff) P Proper ((=) ==> () ==> iff) P
P b ( x X r, x X P r X P (f x r) ({[ x ]} X)) P b ( x X r, x X P r X P (f x r) ({[ x ]} X))
...@@ -166,7 +136,8 @@ Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) ...@@ -166,7 +136,8 @@ Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B)
Proof. Proof.
intros ? Hemp Hadd. intros ? Hemp Hadd.
cut ( l, NoDup l X, ( x, x X x l) P (foldr f b l) X). cut ( l, NoDup l X, ( x, x X x l) P (foldr f b l) X).
{ intros help ?. apply help. apply elements_nodup. apply elements_spec. } { intros help ?. apply help; [apply NoDup_elements|].
symmetry. apply elem_of_elements. }
induction 1 as [|x l ?? IH]; simpl. induction 1 as [|x l ?? IH]; simpl.
* intros X HX. setoid_rewrite elem_of_nil in HX. * intros X HX. setoid_rewrite elem_of_nil in HX.
rewrite equiv_empty. done. esolve_elem_of. rewrite equiv_empty. done. esolve_elem_of.
...@@ -174,25 +145,23 @@ Proof. ...@@ -174,25 +145,23 @@ Proof.
rewrite (union_difference {[ x ]} X) by esolve_elem_of. rewrite (union_difference {[ x ]} X) by esolve_elem_of.
apply Hadd. solve_elem_of. apply IH. esolve_elem_of. apply Hadd. solve_elem_of. apply IH. esolve_elem_of.
Qed. Qed.
Lemma collection_fold_proper {B} (R : relation B) `{!Equivalence R} Lemma collection_fold_proper {B} (R : relation B) `{!Equivalence R}
(f : A B B) (b : B) `{!Proper ((=) ==> R ==> R) f} (f : A B B) (b : B) `{!Proper ((=) ==> R ==> R) f}
(Hf : a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) : (Hf : a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
Proper (() ==> R) (collection_fold f b). Proper (() ==> R) (collection_fold f b).
Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed. Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed.
Global Instance set_Forall_dec `(P : A Prop) Global Instance set_Forall_dec `(P : A Prop)
`{ x, Decision (P x)} X : Decision (set_Forall P X) | 100. `{ x, Decision (P x)} X : Decision (set_Forall P X) | 100.
Proof. Proof.
refine (cast_if (decide (Forall P (elements X)))); refine (cast_if (decide (Forall P (elements X))));
abstract (unfold set_Forall; setoid_rewrite elements_spec; abstract (unfold set_Forall; setoid_rewrite <-elem_of_elements;
by rewrite <-Forall_forall). by rewrite <-Forall_forall).
Defined. Defined.
Global Instance set_Exists_dec `(P : A Prop) `{ x, Decision (P x)} X : Global Instance set_Exists_dec `(P : A Prop) `{ x, Decision (P x)} X :
Decision (set_Exists P X) | 100. Decision (set_Exists P X) | 100.
Proof. Proof.
refine (cast_if (decide (Exists P (elements X)))); refine (cast_if (decide (Exists P (elements X))));
abstract (unfold set_Exists; setoid_rewrite elements_spec; abstract (unfold set_Exists; setoid_rewrite <-elem_of_elements;
by rewrite <-Exists_exists). by rewrite <-Exists_exists).
Defined. Defined.
Global Instance rel_elem_of_dec `{ x y, Decision (R x y)} x X : Global Instance rel_elem_of_dec `{ x y, Decision (R x y)} x X :
......
This diff is collapsed.
...@@ -5,11 +5,11 @@ Obligation Tactic := idtac. ...@@ -5,11 +5,11 @@ Obligation Tactic := idtac.
Class Finite A `{ x y : A, Decision (x = y)} := { Class Finite A `{ x y : A, Decision (x = y)} := {
enum : list A; enum : list A;
enum_nodup : NoDup enum; NoDup_enum : NoDup enum;
elem_of_enum x : x enum elem_of_enum x : x enum
}. }.
Arguments enum _ {_ _} : clear implicits. Arguments enum _ {_ _} : clear implicits.
Arguments enum_nodup _ {_ _} : clear implicits. Arguments NoDup_enum _ {_ _} : clear implicits.
Definition card A `{Finite A} := length (enum A). Definition card A `{Finite A} := length (enum A).
Program Instance finite_countable `{Finite A} : Countable A := {| Program Instance finite_countable `{Finite A} : Countable A := {|
encode := λ x, Pos.of_nat $ S $ from_option 0 $ list_find (x =) (enum A); encode := λ x, Pos.of_nat $ S $ from_option 0 $ list_find (x =) (enum A);
...@@ -72,7 +72,7 @@ Qed. ...@@ -72,7 +72,7 @@ Qed.
Lemma finite_injective_contains `{finA: Finite A} `{finB: Finite B} (f: A B) Lemma finite_injective_contains `{finA: Finite A} `{finB: Finite B} (f: A B)
`{!Injective (=) (=) f} : f <$> enum A `contains` enum B. `{!Injective (=) (=) f} : f <$> enum A `contains` enum B.
Proof. Proof.
intros. destruct finA, finB. apply NoDup_contains; auto using fmap_nodup_2. intros. destruct finA, finB. apply NoDup_contains; auto using NoDup_fmap_2.
Qed. Qed.
Lemma finite_injective_Permutation `{Finite A} `{Finite B} (f : A B) Lemma finite_injective_Permutation `{Finite A} `{Finite B} (f : A B)
`{!Injective (=) (=) f} : card A = card B f <$> enum A enum B. `{!Injective (=) (=) f} : card A = card B f <$> enum A enum B.
...@@ -181,7 +181,7 @@ Section bijective_finite. ...@@ -181,7 +181,7 @@ Section bijective_finite.
Context `{!Injective (=) (=) f} `{!Cancel (=) f g}. Context `{!Injective (=) (=) f} `{!Cancel (=) f g}.
Program Instance bijective_finite: Finite B := {| enum := f <$> enum A |}. Program Instance bijective_finite: Finite B := {| enum := f <$> enum A |}.
Next Obligation. apply (fmap_nodup _), enum_nodup. Qed. Next Obligation. apply (NoDup_fmap_2 _), NoDup_enum. Qed.
Next Obligation. Next Obligation.
intros y. rewrite elem_of_list_fmap. eauto using elem_of_enum. intros y. rewrite elem_of_list_fmap. eauto using elem_of_enum.
Qed. Qed.
...@@ -192,7 +192,7 @@ Program Instance option_finite `{Finite A} : Finite (option A) := ...@@ -192,7 +192,7 @@ Program Instance option_finite `{Finite A} : Finite (option A) :=
Next Obligation. Next Obligation.
constructor. constructor.
* rewrite elem_of_list_fmap. by intros (?&?&?). * rewrite elem_of_list_fmap. by intros (?&?&?).
* apply (fmap_nodup _); auto using enum_nodup. * apply (NoDup_fmap_2 _); auto using NoDup_enum.
Qed. Qed.
Next Obligation. Next Obligation.
intros ??? [x|]; [right|left]; auto. intros ??? [x|]; [right|left]; auto.
...@@ -219,9 +219,9 @@ Program Instance sum_finite `{Finite A} `{Finite B} : Finite (A + B)%type := ...@@ -219,9 +219,9 @@ Program Instance sum_finite `{Finite A} `{Finite B} : Finite (A + B)%type :=
{| enum := (inl <$> enum A) ++ (inr <$> enum B) |}. {| enum := (inl <$> enum A) ++ (inr <$> enum B) |}.
Next Obligation. Next Obligation.
intros. apply NoDup_app; split_ands. intros. apply NoDup_app; split_ands.
* apply (fmap_nodup _). by apply enum_nodup. * apply (NoDup_fmap_2 _). by apply NoDup_enum.
* intro. rewrite !elem_of_list_fmap. intros (?&?&?) (?&?&?); congruence. * intro. rewrite !elem_of_list_fmap. intros (?&?&?) (?&?&?); congruence.
* apply (fmap_nodup _). by apply enum_nodup. * apply (NoDup_fmap_2 _). by apply NoDup_enum.
Qed. Qed.
Next Obligation. Next Obligation.
intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap; intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap;
...@@ -233,10 +233,10 @@ Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed. ...@@ -233,10 +233,10 @@ Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed.
Program Instance prod_finite `{Finite A} `{Finite B} : Finite (A * B)%type := Program Instance prod_finite `{Finite A} `{Finite B} : Finite (A * B)%type :=
{| enum := foldr (λ x, (pair x <$> enum B ++)) [] (enum A) |}. {| enum := foldr (λ x, (pair x <$> enum B ++)) [] (enum A) |}.
Next Obligation. Next Obligation.
intros ??????. induction (enum_nodup A) as [|x xs Hx Hxs IH]; simpl. intros ??????. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl.
{ constructor. } { constructor. }
apply NoDup_app; split_ands. apply NoDup_app; split_ands.
* apply (fmap_nodup _). by apply enum_nodup. * by apply (NoDup_fmap_2 _), NoDup_enum.
* intros [? y]. rewrite elem_of_list_fmap. intros (?&?&?); simplify_equality. * intros [? y]. rewrite elem_of_list_fmap. intros (?&?&?); simplify_equality.
clear IH. induction Hxs as [|x' xs ?? IH]; simpl. clear IH. induction Hxs as [|x' xs ?? IH]; simpl.
{ rewrite elem_of_nil. tauto. } { rewrite elem_of_nil. tauto. }
...@@ -268,9 +268,9 @@ Program Instance list_finite `{Finite A} n : Finite { l | length l = n } := ...@@ -268,9 +268,9 @@ Program Instance list_finite `{Finite A} n : Finite { l | length l = n } :=
Next Obligation. Next Obligation.
intros ????. induction n as [|n IH]; simpl; [apply NoDup_singleton |]. intros ????. induction n as [|n IH]; simpl; [apply NoDup_singleton |].
revert IH. generalize (list_enum (enum A) n). intros l Hl. revert IH. generalize (list_enum (enum A) n). intros l Hl.
induction (enum_nodup A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |]. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |].
apply NoDup_app; split_ands. apply NoDup_app; split_ands.