Commit 361308c7 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Lots of refactoring. and new results on permutations and list containment.

The refactoring includes:
* Use infix notations for the various list relations
* More consistent naming
* Put lemmas on one line whenever possible
* Change proofs into one-liners when possible
* Make better use of the "Implicit Types" command
* Improve the order of the list module by placing all definitions at the start,
  then the proofs, and finally the tactics.

Besides, there is some new machinery for proofs by reflection on lists. It is
used for a decision procedure for permutations and list containment.
parent 2783aea9
...@@ -107,17 +107,11 @@ Instance unit_inhabited: Inhabited unit := populate (). ...@@ -107,17 +107,11 @@ Instance unit_inhabited: Inhabited unit := populate ().
Instance list_inhabited {A} : Inhabited (list A) := populate []. Instance list_inhabited {A} : Inhabited (list A) := populate [].
Instance prod_inhabited {A B} (iA : Inhabited A) Instance prod_inhabited {A B} (iA : Inhabited A)
(iB : Inhabited B) : Inhabited (A * B) := (iB : Inhabited B) : Inhabited (A * B) :=
match iA, iB with match iA, iB with populate x, populate y => populate (x,y) end.
| populate x, populate y => populate (x,y)
end.
Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) := Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) :=
match iA with match iA with populate x => populate (inl x) end.
| populate x => populate (inl x)
end.
Instance sum_inhabited_r {A B} (iB : Inhabited A) : Inhabited (A + B) := Instance sum_inhabited_r {A B} (iB : Inhabited A) : Inhabited (A + B) :=
match iB with match iB with populate y => populate (inl y) end.
| populate y => populate (inl y)
end.
Instance option_inhabited {A} : Inhabited (option A) := populate None. Instance option_inhabited {A} : Inhabited (option A) := populate None.
(** ** Proof irrelevant types *) (** ** Proof irrelevant types *)
...@@ -187,8 +181,7 @@ Notation "(∪)" := union (only parsing) : C_scope. ...@@ -187,8 +181,7 @@ Notation "(∪)" := union (only parsing) : C_scope.
Notation "( x ∪)" := (union x) (only parsing) : C_scope. Notation "( x ∪)" := (union x) (only parsing) : C_scope.
Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope. Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope.
Definition union_list `{Empty A} Definition union_list `{Empty A} `{Union A} : list A A := fold_right () .
`{Union A} : list A A := fold_right () .
Arguments union_list _ _ _ !_ /. Arguments union_list _ _ _ !_ /.
Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : C_scope. Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : C_scope.
...@@ -208,9 +201,14 @@ Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope. ...@@ -208,9 +201,14 @@ Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope.
Class Singleton A B := singleton: A B. Class Singleton A B := singleton: A B.
Instance: Params (@singleton) 3. Instance: Params (@singleton) 3.
Notation "{[ x ]}" := (singleton x) : C_scope. Notation "{[ x ]}" := (singleton x) (at level 1) : C_scope.
Notation "{[ x ; y ; .. ; z ]}" := Notation "{[ x ; y ; .. ; z ]}" :=
(union .. (union (singleton x) (singleton y)) .. (singleton z)) : C_scope. (union .. (union (singleton x) (singleton y)) .. (singleton z))
(at level 1) : C_scope.
Notation "{[ x , y ]}" := (singleton (x,y))
(at level 1, y at next level) : C_scope.
Notation "{[ x , y , z ]}" := (singleton (x,y,z))
(at level 1, y at next level, z at next level) : C_scope.
Class SubsetEq A := subseteq: A A Prop. Class SubsetEq A := subseteq: A A Prop.
Instance: Params (@subseteq) 2. Instance: Params (@subseteq) 2.
...@@ -222,6 +220,8 @@ Notation "X ⊈ Y" := (¬X ⊆ Y) (at level 70) : C_scope. ...@@ -222,6 +220,8 @@ Notation "X ⊈ Y" := (¬X ⊆ Y) (at level 70) : C_scope.
Notation "(⊈)" := (λ X Y, X Y) (only parsing) : C_scope. Notation "(⊈)" := (λ X Y, X Y) (only parsing) : C_scope.
Notation "( X ⊈ )" := (λ Y, X Y) (only parsing) : C_scope. Notation "( X ⊈ )" := (λ Y, X Y) (only parsing) : C_scope.
Notation "( ⊈ X )" := (λ Y, Y X) (only parsing) : C_scope. Notation "( ⊈ X )" := (λ Y, Y X) (only parsing) : C_scope.
Infix "⊆*" := (Forall2 subseteq) (at level 70) : C_scope.
Notation "(⊆*)" := (Forall2 subseteq) (only parsing) : C_scope.
Hint Extern 0 (_ _) => reflexivity. Hint Extern 0 (_ _) => reflexivity.
...@@ -251,43 +251,51 @@ Class Disjoint A := disjoint : A → A → Prop. ...@@ -251,43 +251,51 @@ Class Disjoint A := disjoint : A → A → Prop.
Instance: Params (@disjoint) 2. Instance: Params (@disjoint) 2.
Infix "⊥" := disjoint (at level 70) : C_scope. Infix "⊥" := disjoint (at level 70) : C_scope.
Notation "(⊥)" := disjoint (only parsing) : C_scope. Notation "(⊥)" := disjoint (only parsing) : C_scope.
Notation "( X ⊥)" := (disjoint X) (only parsing) : C_scope. Notation "( X ⊥.)" := (disjoint X) (only parsing) : C_scope.
Notation "(⊥ X )" := (λ Y, disjoint Y X) (only parsing) : C_scope. Notation "(.⊥ X )" := (λ Y, disjoint Y X) (only parsing) : C_scope.
Inductive list_disjoint `{Empty A} `{Union A} Class DisjointList A := disjoint_list : list A Prop.
`{Disjoint A} : list A Prop := Instance: Params (@disjoint_list) 2.
| disjoint_nil : Notation "⊥ l" := (disjoint_list l) (at level 20, format "⊥ l") : C_scope.
list_disjoint []
| disjoint_cons X Xs : Section default_disjoint_list.
X Xs Context `{Empty A} `{Union A} `{Disjoint A}.
list_disjoint Xs Inductive default_disjoint_list : DisjointList A :=
list_disjoint (X :: Xs). | disjoint_nil_2 : []
Lemma list_disjoint_cons_inv `{Empty A} `{Union A} `{Disjoint A} X Xs : | disjoint_cons_2 X Xs : X Xs Xs (X :: Xs).
list_disjoint (X :: Xs) Global Existing Instance default_disjoint_list.
X Xs list_disjoint Xs.
Proof. inversion_clear 1; auto. Qed. Lemma disjoint_list_nil : @nil A True.
Proof. split; constructor. Qed.
Class Filter A B := Lemma disjoint_list_cons X Xs : (X :: Xs) X Xs Xs.
filter: (P : A Prop) `{ x, Decision (P x)}, B B. Proof. split. inversion_clear 1; auto. intros [??]. constructor; auto. Qed.
End default_disjoint_list.
(* Arguments filter {_ _ _} _ {_} !_ / : simpl nomatch. *)
Class Filter A B := filter: (P : A Prop) `{ x, Decision (P x)}, B B.
(** We define variants of the relations [(≡)] and [(⊆)] that are indexed by (** We define variants of the relations [(≡)] and [(⊆)] that are indexed by
an environment. *) an environment. *)
Class EquivEnv A B := equiv_env : A relation B. Class EquivEnv A B := equiv_env : A relation B.
Notation "X ≡@{ E } Y" := (equiv_env E X Y) Notation "X ≡@{ E } Y" := (equiv_env E X Y)
(at level 70, format "X ≡@{ E } Y") : C_scope. (at level 70, format "X ≡@{ E } Y") : C_scope.
Notation "(≡@{ E } )" := (equiv_env E) Notation "(≡@{ E } )" := (equiv_env E) (E at level 1, only parsing) : C_scope.
(E at level 1, only parsing) : C_scope.
Instance: Params (@equiv_env) 4. Instance: Params (@equiv_env) 4.
Class SubsetEqEnv A B := subseteq_env : A relation B. Class SubsetEqEnv A B := subseteq_env : A relation B.
Notation "X ⊆@{ E } Y" := (subseteq_env E X Y) Instance: Params (@subseteq_env) 4.
(at level 70, format "X ⊆@{ E } Y") : C_scope. Notation "X ⊑@{ E } Y" := (subseteq_env E X Y)
Notation "(⊆@{ E } )" := (subseteq_env E) (at level 70, format "X ⊑@{ E } Y") : C_scope.
Notation "(⊑@{ E } )" := (subseteq_env E)
(E at level 1, only parsing) : C_scope.
Notation "X ⊑@{ E }* Y" := (Forall2 (subseteq_env E) X Y)
(at level 70, format "X ⊑@{ E }* Y") : C_scope.
Notation "(⊑@{ E }*)" := (Forall2 (subseteq_env E))
(E at level 1, only parsing) : C_scope. (E at level 1, only parsing) : C_scope.
Instance: Params (@subseteq_env) 4. Instance: Params (@subseteq_env) 4.
Hint Extern 0 (_ @{_} _) => reflexivity.
Hint Extern 0 (_ @{_} _) => reflexivity.
(** ** Monadic operations *) (** ** Monadic operations *)
(** We define operational type classes for the monadic operations bind, join (** We define operational type classes for the monadic operations bind, join
and fmap. These type classes are defined in a non-standard way by taking the and fmap. These type classes are defined in a non-standard way by taking the
...@@ -314,16 +322,16 @@ Arguments mret {_ _ _} _. ...@@ -314,16 +322,16 @@ Arguments mret {_ _ _} _.
Class MBindD (M : Type Type) {A B} (f : A M B) := mbind: M A M B. Class MBindD (M : Type Type) {A B} (f : A M B) := mbind: M A M B.
Notation MBind M := ( {A B} (f : A M B), MBindD M f)%type. Notation MBind M := ( {A B} (f : A M B), MBindD M f)%type.
Instance: Params (@mbind) 5. Instance: Params (@mbind) 5.
Arguments mbind {_ _ _} _ {_} !_ / : simpl nomatch. Arguments mbind {_ _ _} _ {_} !_ /.
Class MJoin (M : Type Type) := mjoin: {A}, M (M A) M A. Class MJoin (M : Type Type) := mjoin: {A}, M (M A) M A.
Instance: Params (@mjoin) 3. Instance: Params (@mjoin) 3.
Arguments mjoin {_ _ _} !_ / : simpl nomatch. Arguments mjoin {_ _ _} !_ /.
Class FMapD (M : Type Type) {A B} (f : A B) := fmap: M A M B. Class FMapD (M : Type Type) {A B} (f : A B) := fmap: M A M B.
Notation FMap M := ( {A B} (f : A B), FMapD M f)%type. Notation FMap M := ( {A B} (f : A B), FMapD M f)%type.
Instance: Params (@fmap) 6. Instance: Params (@fmap) 6.
Arguments fmap {_ _ _} _ {_} !_ / : simpl nomatch. Arguments fmap {_ _ _} _ {_} !_ /.
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope. Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "( m ≫=)" := (λ f, mbind f m) (only parsing) : C_scope. Notation "( m ≫=)" := (λ f, mbind f m) (only parsing) : C_scope.
...@@ -331,21 +339,22 @@ Notation "(≫= f )" := (mbind f) (only parsing) : C_scope. ...@@ -331,21 +339,22 @@ Notation "(≫= f )" := (mbind f) (only parsing) : C_scope.
Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope. Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z)) Notation "x ← y ; z" := (y = (λ x : _, z))
(at level 65, only parsing, next at level 35, right associativity) : C_scope. (at level 65, next at level 35, only parsing, right associativity) : C_scope.
Infix "<$>" := fmap (at level 60, right associativity) : C_scope. Infix "<$>" := fmap (at level 60, right associativity) : C_scope.
Class MGuard (M : Type Type) := Class MGuard (M : Type Type) :=
mguard: P {dec : Decision P} {A}, M A M A. mguard: P {dec : Decision P} {A}, (P M A) M A.
Notation "'guard' P ; o" := (mguard P o) Arguments mguard _ _ _ !_ _ _ /.
(at level 65, only parsing, next at level 35, right associativity) : C_scope. Notation "'guard' P ; o" := (mguard P (λ _, o))
Arguments mguard _ _ _ !_ _ !_ / : simpl nomatch. (at level 65, next at level 35, only parsing, right associativity) : C_scope.
Notation "'guard' P 'as' H ; o" := (mguard P (λ H, o))
(at level 65, next at level 35, only parsing, right associativity) : C_scope.
(** ** Operations on maps *) (** ** Operations on maps *)
(** In this section we define operational type classes for the operations (** In this section we define operational type classes for the operations
on maps. In the file [fin_maps] we will axiomatize finite maps. on maps. In the file [fin_maps] we will axiomatize finite maps.
The function look up [m !! k] should yield the element at key [k] in [m]. *) The function look up [m !! k] should yield the element at key [k] in [m]. *)
Class Lookup (K A M : Type) := Class Lookup (K A M : Type) := lookup: K M option A.
lookup: K M option A.
Instance: Params (@lookup) 4. Instance: Params (@lookup) 4.
Notation "m !! i" := (lookup i m) (at level 20) : C_scope. Notation "m !! i" := (lookup i m) (at level 20) : C_scope.
...@@ -356,8 +365,7 @@ Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch. ...@@ -356,8 +365,7 @@ Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch.
(** The function insert [<[k:=a]>m] should update the element at key [k] with (** The function insert [<[k:=a]>m] should update the element at key [k] with
value [a] in [m]. *) value [a] in [m]. *)
Class Insert (K A M : Type) := Class Insert (K A M : Type) := insert: K A M M.
insert: K A M M.
Instance: Params (@insert) 4. Instance: Params (@insert) 4.
Notation "<[ k := a ]>" := (insert k a) Notation "<[ k := a ]>" := (insert k a)
(at level 5, right associativity, format "<[ k := a ]>") : C_scope. (at level 5, right associativity, format "<[ k := a ]>") : C_scope.
...@@ -366,15 +374,13 @@ Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch. ...@@ -366,15 +374,13 @@ Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch.
(** The function delete [delete k m] should delete the value at key [k] in (** The function delete [delete k m] should delete the value at key [k] in
[m]. If the key [k] is not a member of [m], the original map should be [m]. If the key [k] is not a member of [m], the original map should be
returned. *) returned. *)
Class Delete (K M : Type) := Class Delete (K M : Type) := delete: K M M.
delete: K M M.
Instance: Params (@delete) 3. Instance: Params (@delete) 3.
Arguments delete _ _ _ !_ !_ / : simpl nomatch. Arguments delete _ _ _ !_ !_ / : simpl nomatch.
(** The function [alter f k m] should update the value at key [k] using the (** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value. *) function [f], which is called with the original value. *)
Class AlterD (K A M : Type) (f : A A) := Class AlterD (K A M : Type) (f : A A) := alter: K M M.
alter: K M M.
Notation Alter K A M := ( (f : A A), AlterD K A M f)%type. Notation Alter K A M := ( (f : A A), AlterD K A M f)%type.
Instance: Params (@alter) 5. Instance: Params (@alter) 5.
Arguments alter {_ _ _} _ {_} !_ !_ / : simpl nomatch. Arguments alter {_ _ _} _ {_} !_ !_ / : simpl nomatch.
...@@ -409,9 +415,8 @@ Definition delete_list `{Delete K M} (l : list K) (m : M) : M := ...@@ -409,9 +415,8 @@ Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l. fold_right delete m l.
Instance: Params (@delete_list) 3. Instance: Params (@delete_list) 3.
Definition insert_consecutive `{Insert nat A M} Definition insert_consecutive `{Insert nat A M} (i : nat) (l : list A)
(i : nat) (l : list A) (m : M) : M := (m : M) : M := fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
Instance: Params (@insert_consecutive) 3. Instance: Params (@insert_consecutive) 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]
...@@ -441,8 +446,11 @@ Arguments intersection_with_list _ _ _ _ _ !_ /. ...@@ -441,8 +446,11 @@ Arguments intersection_with_list _ _ _ _ _ !_ /.
(** These operational type classes allow us to refer to common mathematical (** These operational type classes allow us to refer to common mathematical
properties in a generic way. For example, for injectivity of [(k ++)] it properties in a generic way. For example, for injectivity of [(k ++)] it
allows us to write [injective (k ++)] instead of [app_inv_head k]. *) allows us to write [injective (k ++)] instead of [app_inv_head k]. *)
Class Injective {A B} (R : relation A) S (f : A B) : Prop := Class Injective {A B} (R : relation A) (S : relation B) (f : A B) : Prop :=
injective: x y : A, S (f x) (f y) R x y. injective: x y, S (f x) (f y) R x y.
Class Injective2 {A B C} (R1 : relation A) (R2 : relation B)
(S : relation C) (f : A B C) : Prop :=
injective2: x1 x2 y1 y2, S (f x1 x2) (f y1 y2) R1 x1 y1 R2 x2 y2.
Class Idempotent {A} (R : relation A) (f : A A A) : Prop := Class Idempotent {A} (R : relation A) (f : A A A) : Prop :=
idempotent: x, R (f x x) x. idempotent: x, R (f x x) x.
Class Commutative {A B} (R : relation A) (f : B B A) : Prop := Class Commutative {A B} (R : relation A) (f : B B A) : Prop :=
...@@ -461,11 +469,12 @@ Class LeftDistr {A} (R : relation A) (f g : A → A → A) : Prop := ...@@ -461,11 +469,12 @@ Class LeftDistr {A} (R : relation A) (f g : A → A → A) : Prop :=
left_distr: x y z, R (f x (g y z)) (g (f x y) (f x z)). left_distr: x y z, R (f x (g y z)) (g (f x y) (f x z)).
Class RightDistr {A} (R : relation A) (f g : A A A) : Prop := Class RightDistr {A} (R : relation A) (f g : A A A) : Prop :=
right_distr: y z x, R (f (g y z) x) (g (f y x) (f z x)). right_distr: y z x, R (f (g y z) x) (g (f y x) (f z x)).
Class AntiSymmetric {A} (R : relation A) : Prop := Class AntiSymmetric {A} (R S : relation A) : Prop :=
anti_symmetric: x y, R x y R y x x = y. anti_symmetric: x y, S x y S y x R x y.
Arguments irreflexivity {_} _ {_} _ _. Arguments irreflexivity {_} _ {_} _ _.
Arguments injective {_ _ _ _} _ {_} _ _ _. Arguments injective {_ _ _ _} _ {_} _ _ _.
Arguments injective2 {_ _ _ _ _ _} _ {_} _ _ _ _ _.
Arguments idempotent {_ _} _ {_} _. Arguments idempotent {_ _} _ {_} _.
Arguments commutative {_ _ _} _ {_} _ _. Arguments commutative {_ _ _} _ {_} _ _.
Arguments left_id {_ _} _ _ {_} _. Arguments left_id {_ _} _ _ {_} _.
...@@ -475,8 +484,10 @@ Arguments left_absorb {_ _} _ _ {_} _. ...@@ -475,8 +484,10 @@ Arguments left_absorb {_ _} _ _ {_} _.
Arguments right_absorb {_ _} _ _ {_} _. Arguments right_absorb {_ _} _ _ {_} _.
Arguments left_distr {_ _} _ _ {_} _ _ _. Arguments left_distr {_ _} _ _ {_} _ _ _.
Arguments right_distr {_ _} _ _ {_} _ _ _. Arguments right_distr {_ _} _ _ {_} _ _ _.
Arguments anti_symmetric {_} _ {_} _ _ _ _. Arguments anti_symmetric {_ _} _ {_} _ _ _ _.
Lemma impl_transitive (P Q R : Prop) : (P Q) (Q R) (P R).
Proof. tauto. Qed.
Instance: Commutative () (@eq A). Instance: Commutative () (@eq A).
Proof. red. intuition. Qed. Proof. red. intuition. Qed.
Instance: Commutative () (λ x y, @eq A y x). Instance: Commutative () (λ x y, @eq A y x).
...@@ -524,34 +535,31 @@ Proof. red. intuition. Qed. ...@@ -524,34 +535,31 @@ Proof. red. intuition. Qed.
Instance: RightDistr () () (). Instance: RightDistr () () ().
Proof. red. intuition. Qed. Proof. red. intuition. Qed.
(** The following lemmas are more specific versions of the projections of the (** The following lemmas are specific versions of the projections of the above
above type classes. These lemmas allow us to enforce Coq not to use the setoid type classes for Leibniz equality. These lemmas allow us to enforce Coq not to
rewriting mechanism. *) use the setoid rewriting mechanism. *)
Lemma idempotent_eq {A} (f : A A A) `{!Idempotent (=) f} x : Lemma idempotent_L {A} (f : A A A) `{!Idempotent (=) f} x : f x x = x.
f x x = x.
Proof. auto. Qed. Proof. auto. Qed.
Lemma commutative_eq {A B} (f : B B A) `{!Commutative (=) f} x y : Lemma commutative_L {A B} (f : B B A) `{!Commutative (=) f} x y :
f x y = f y x. f x y = f y x.
Proof. auto. Qed. Proof. auto. Qed.
Lemma left_id_eq {A} (i : A) (f : A A A) `{!LeftId (=) i f} x : Lemma left_id_L {A} (i : A) (f : A A A) `{!LeftId (=) i f} x : f i x = x.
f i x = x.
Proof. auto. Qed. Proof. auto. Qed.
Lemma right_id_eq {A} (i : A) (f : A A A) `{!RightId (=) i f} x : Lemma right_id_L {A} (i : A) (f : A A A) `{!RightId (=) i f} x : f x i = x.
f x i = x.
Proof. auto. Qed. Proof. auto. Qed.
Lemma associative_eq {A} (f : A A A) `{!Associative (=) f} x y z : Lemma associative_L {A} (f : A A A) `{!Associative (=) f} x y z :
f x (f y z) = f (f x y) z. f x (f y z) = f (f x y) z.
Proof. auto. Qed. Proof. auto. Qed.
Lemma left_absorb_eq {A} (i : A) (f : A A A) `{!LeftAbsorb (=) i f} x : Lemma left_absorb_L {A} (i : A) (f : A A A) `{!LeftAbsorb (=) i f} x :
f i x = i. f i x = i.
Proof. auto. Qed. Proof. auto. Qed.
Lemma right_absorb_eq {A} (i : A) (f : A A A) `{!RightAbsorb (=) i f} x : Lemma right_absorb_L {A} (i : A) (f : A A A) `{!RightAbsorb (=) i f} x :
f x i = i. f x i = i.
Proof. auto. Qed. Proof. auto. Qed.
Lemma left_distr_eq {A} (f g : A A A) `{!LeftDistr (=) f g} x y z : Lemma left_distr_L {A} (f g : A A A) `{!LeftDistr (=) f g} x y z :
f x (g y z) = g (f x y) (f x z). f x (g y z) = g (f x y) (f x z).
Proof. auto. Qed. Proof. auto. Qed.
Lemma right_distr_eq {A} (f g : A A A) `{!RightDistr (=) f g} y z x : Lemma right_distr_L {A} (f g : A A A) `{!RightDistr (=) f g} y z x :
f (g y z) x = g (f y x) (f z x). f (g y z) x = g (f y x) (f z x).
Proof. auto. Qed. Proof. auto. Qed.
...@@ -561,9 +569,9 @@ Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := { ...@@ -561,9 +569,9 @@ Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := {
bounded_preorder :>> PreOrder (); bounded_preorder :>> PreOrder ();
subseteq_empty x : x subseteq_empty x : x
}. }.
Class PartialOrder A `{SubsetEq A} : Prop := { Class PartialOrder {A} (R : relation A) : Prop := {
po_preorder :>> PreOrder (); po_preorder :> PreOrder R;
po_antisym :> AntiSymmetric () po_antisym :> AntiSymmetric (=) R
}. }.
(** We do not include equality in the following interfaces so as to avoid the (** We do not include equality in the following interfaces so as to avoid the
...@@ -663,12 +671,10 @@ Class CollectionMonad M `{∀ A, ElemOf A (M A)} ...@@ -663,12 +671,10 @@ Class CollectionMonad M `{∀ A, ElemOf A (M A)}
collection_monad_simple A :> SimpleCollection A (M A); collection_monad_simple A :> SimpleCollection A (M A);
elem_of_bind {A B} (f : A M B) (X : M A) (x : B) : elem_of_bind {A B} (f : A M B) (X : M A) (x : B) :
x X = f y, x f y y X; x X = f y, x f y y X;
elem_of_ret {A} (x y : A) : elem_of_ret {A} (x y : A) : x mret y x = y;
x mret y x = y;
elem_of_fmap {A B} (f : A B) (X : M A) (x : B) : elem_of_fmap {A B} (f : A B) (X : M A) (x : B) :
x f <$> X y, x = f y y X; x f <$> X y, x = f y y X;
elem_of_join {A} (X : M (M A)) (x : A) : elem_of_join {A} (X : M (M A)) (x : A) : x mjoin X Y, x Y Y X
x mjoin X Y, x Y Y X
}. }.
(** The function [fresh X] yields an element that is not contained in [X]. We (** The function [fresh X] yields an element that is not contained in [X]. We
......
...@@ -42,8 +42,7 @@ Section simple_collection. ...@@ -42,8 +42,7 @@ Section simple_collection.
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 : list C) (x : A) : Lemma elem_of_union_list Xs x : x Xs X, X Xs x X.
x Xs X, X Xs x X.
Proof. Proof.
split. split.
* induction Xs; simpl; intros HXs. * induction Xs; simpl; intros HXs.
...@@ -249,13 +248,11 @@ Section collection. ...@@ -249,13 +248,11 @@ Section collection.
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. rewrite elem_of_intersection. destruct (decide (x X)); tauto.
destruct (decide (x X)); tauto.
Qed. 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. rewrite elem_of_difference. destruct (decide (x Y)); tauto.
destruct (decide (x Y)); tauto.
Qed. 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.
...@@ -303,19 +300,18 @@ Section collection_ops. ...@@ -303,19 +300,18 @@ Section collection_ops.
( x y z, Q x P y f x y = Some z P z) ( x y z, Q x P y f x y = Some z P z)
x, x intersection_with_list f Y Xs P x. x, x intersection_with_list f Y Xs P x.
Proof. Proof.
intros HY HXs Hf. intros HY HXs Hf. induction Xs; simplify_option_equality; [done |].
induction Xs; simplify_option_equality; [done |].
intros x Hx. rewrite elem_of_intersection_with in Hx. intros x Hx. rewrite elem_of_intersection_with in Hx.
decompose_Forall. destruct Hx as (? & ? & ? & ? & ?). eauto. decompose_Forall. destruct Hx as (? & ? & ? & ? & ?). eauto.
Qed. Qed.
End collection_ops. End collection_ops.
(** * Sets without duplicates up to an equivalence *) (** * Sets without duplicates up to an equivalence *)
Section no_dup. Section NoDup.
Context `{SimpleCollection A B} (R : relation A) `{!Equivalence R}. Context `{SimpleCollection A B} (R : relation A) `{!Equivalence R}.
Definition elem_of_upto (x : A) (X : B) := y, y X R x y. Definition elem_of_upto (x : A) (X : B) := y, y X R x y.
Definition no_dup (X : B) := x y, x X y X R x y x = y. Definition set_NoDup (X : B) := x y, x X y X R x y x = y.
Global Instance: Proper (() ==> iff) (elem_of_upto x). Global Instance: Proper (() ==>