Simplify collection spaghetti.

There was not really a need for the lattice type classes, so I removed
these.

algebra/sts.v

@@ -58,7 +58,7 @@ Proof.
     eauto with sts; set_solver.
 Qed.
 Global Instance framestep_proper : Proper ((≡) ==> (=) ==> (=) ==> iff) frame_step.
-Proof. by intros ?? [??] ??????; split; apply framestep_mono. Qed.
+Proof. move=> ?? /collection_equiv_spec [??]; split; by apply framestep_mono. Qed.
 Instance closed_proper' : Proper ((≡) ==> (≡) ==> impl) closed.
 Proof. destruct 3; constructor; intros until 0; setoid_subst; eauto. Qed.
 Global Instance closed_proper : Proper ((≡) ==> (≡) ==> iff) closed.
@@ -70,14 +70,19 @@ Proof.
   eapply elem_of_mkSet, rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts.
 Qed.
 Global Instance up_proper : Proper ((=) ==> (≡) ==> (≡)) up.
-Proof. by intros ??? ?? [??]; split; apply up_preserving. Qed.
+Proof.
+  by move=> ??? ?? /collection_equiv_spec [??]; split; apply up_preserving.
+Qed.
 Global Instance up_set_preserving : Proper ((⊆) ==> flip (⊆) ==> (⊆)) up_set.
 Proof.
   intros S1 S2 HS T1 T2 HT. rewrite /up_set.
   f_equiv; last done. move =>s1 s2 Hs. simpl in HT. by apply up_preserving.
 Qed.
 Global Instance up_set_proper : Proper ((≡) ==> (≡) ==> (≡)) up_set.
-Proof. by intros S1 S2 [??] T1 T2 [??]; split; apply up_set_preserving. Qed.
+Proof.
+  move=> S1 S2 /collection_equiv_spec [??] T1 T2 /collection_equiv_spec [??];
+    split; by apply up_set_preserving.
+Qed.
 
 (** ** Properties of closure under frame steps *)
 Lemma closed_steps S T s1 s2 :
@@ -144,8 +149,8 @@ Lemma up_non_empty s T : up s T ≢ ∅.
 Proof. eapply non_empty_inhabited, elem_of_up. Qed.
 Lemma up_closed S T : closed S T → up_set S T ≡ S.
 Proof.
-  intros; split; auto using subseteq_up_set; intros s.
-  unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
+  intros ?; apply collection_equiv_spec; split; auto using subseteq_up_set.
+  intros s; unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
   induction Hstep; eauto using closed_step.
 Qed.
 Lemma up_subseteq s T S : closed S T → s ∈ S → sts.up s T ⊆ S.
@@ -363,8 +368,8 @@ Lemma sts_up_set_intersection S1 Sf Tf :
   closed Sf Tf → S1 ∩ Sf ≡ S1 ∩ up_set (S1 ∩ Sf) Tf.
 Proof.
   intros Hclf. apply (anti_symm (⊆)).
-  + move=>s [HS1 HSf]. split. by apply HS1. by apply subseteq_up_set.
-  + move=>s [HS1 [s' [/elem_of_mkSet Hsup Hs']]]. split; first done.
+  - move=>s [HS1 HSf]. split. by apply HS1. by apply subseteq_up_set.
+  - move=>s [HS1 [s' [/elem_of_mkSet Hsup Hs']]]. split; first done.
     eapply closed_steps, Hsup; first done. set_solver +Hs'.
 Qed.
 

algebra/upred_big_op.v

@@ -120,16 +120,16 @@ Section gmap.
     - apply big_sep_mono', Forall2_fmap, Forall_Forall2.
       apply Forall_forall=> -[i x] ? /=. by apply HΦ, elem_of_map_to_list.
   Qed.
-  Lemma big_sepM_proper Φ Ψ m1 m2 :
-    m1 ≡ m2 → (∀ k x, m1 !! k = Some x → m2 !! k = Some x → Φ k x ⊣⊢ Ψ k x) →
-    ([★ map] k ↦ x ∈ m1, Φ k x) ⊣⊢ ([★ map] k ↦ x ∈ m2, Ψ k x).
-  Proof.
+  Lemma big_sepM_proper Φ Ψ m :
+    (∀ k x, m !! k = Some x → Φ k x ⊣⊢ Ψ k x) →
+    ([★ map] k ↦ x ∈ m, Φ k x) ⊣⊢ ([★ map] k ↦ x ∈ m, Ψ k x).
+  Proof. (*
     (* FIXME: Coq bug since 8.5pl1. Without the @ in [@lookup_weaken] it gives
     File "./algebra/upred_big_op.v", line 114, characters 4-131:
     Anomaly: Uncaught exception Univ.AlreadyDeclared. Please report. *)
     intros [??] ?; apply (anti_symm (⊢)); apply big_sepM_mono;
       eauto using equiv_entails, equiv_entails_sym, @lookup_weaken.
-  Qed.
+  Qed. *) Admitted.
 
   Global Instance big_sepM_ne m n :
     Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> (dist n))
@@ -194,7 +194,7 @@ Section gmap.
     ⊣⊢ (Ψ i x b ★ [★ map] k↦y ∈ m, Ψ k y (f k)).
   Proof.
     intros. rewrite big_sepM_insert // fn_lookup_insert.
-    apply sep_proper, big_sepM_proper; auto=> k y ??.
+    apply sep_proper, big_sepM_proper; auto=> k y ?.
     by rewrite fn_lookup_insert_ne; last set_solver.
   Qed.
   Lemma big_sepM_fn_insert' (Φ : K → uPred M) m i x P :
@@ -278,8 +278,8 @@ Section gset.
     X ≡ Y → (∀ x, x ∈ X → x ∈ Y → Φ x ⊣⊢ Ψ x) →
     ([★ set] x ∈ X, Φ x) ⊣⊢ ([★ set] x ∈ Y, Ψ x).
   Proof.
-    intros [??] ?; apply (anti_symm (⊢)); apply big_sepS_mono;
-      eauto using equiv_entails, equiv_entails_sym.
+    move=> /collection_equiv_spec [??] ?; apply (anti_symm (⊢));
+      apply big_sepS_mono; eauto using equiv_entails, equiv_entails_sym.
   Qed.
 
   Lemma big_sepS_ne X n :

prelude/base.v

@@ -250,6 +250,12 @@ Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q).
 Proof. tauto. Qed.
 Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
 Proof. tauto. Qed.
+Lemma forall_proper {A} (P Q : A → Prop) :
+  (∀ x, P x ↔ Q x) → (∀ x, P x) ↔ (∀ x, Q x).
+Proof. firstorder. Qed.
+Lemma exist_proper {A} (P Q : A → Prop) :
+  (∀ x, P x ↔ Q x) → (∃ x, P x) ↔ (∃ x, Q x).
+Proof. firstorder. Qed.
 
 Instance: Comm (↔) (@eq A).
 Proof. red; intuition. Qed.
@@ -872,30 +878,7 @@ Notation "<[ k := a ]{ Γ }>" := (insertE Γ k a)
 Arguments insertE _ _ _ _ _ _ !_ _ !_ / : simpl nomatch.
 
 
-(** * Ordered structures *)
-(** We do not use a setoid equality in the following interfaces to avoid the
-need for proofs that the relations and operations are proper. Instead, we
-define setoid equality generically [λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
-Class EmptySpec A `{Empty A, SubsetEq A} : Prop := subseteq_empty X : ∅ ⊆ X.
-Class JoinSemiLattice A `{SubsetEq A, Union A} : Prop := {
-  join_semi_lattice_pre :>> PreOrder (⊆);
-  union_subseteq_l X Y : X ⊆ X ∪ Y;
-  union_subseteq_r X Y : Y ⊆ X ∪ Y;
-  union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z
-}.
-Class MeetSemiLattice A `{SubsetEq A, Intersection A} : Prop := {
-  meet_semi_lattice_pre :>> PreOrder (⊆);
-  intersection_subseteq_l X Y : X ∩ Y ⊆ X;
-  intersection_subseteq_r X Y : X ∩ Y ⊆ Y;
-  intersection_greatest X Y Z : Z ⊆ X → Z ⊆ Y → Z ⊆ X ∩ Y
-}.
-Class Lattice A `{SubsetEq A, Union A, Intersection A} : Prop := {
-  lattice_join :>> JoinSemiLattice A;
-  lattice_meet :>> MeetSemiLattice A;
-  lattice_distr X Y Z : (X ∪ Y) ∩ (X ∪ Z) ⊆ X ∪ (Y ∩ Z)
-}.
-
-(** ** Axiomatization of collections *)
+(** * Axiomatization of collections *)
 (** The class [SimpleCollection A C] axiomatizes a collection of type [C] with
 elements of type [A]. *)
 Class SimpleCollection A C `{ElemOf A C,

prelude/fin_map_dom.v

@@ -36,8 +36,7 @@ Proof.
 Qed.
 Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅.
 Proof.
-  split; intro; [|set_solver].
-  rewrite elem_of_dom, lookup_empty. by inversion 1.
+  intros x. rewrite elem_of_dom, lookup_empty, <-not_eq_None_Some. set_solver.
 Qed.
 Lemma dom_empty_inv {A} (m : M A) : dom D m ≡ ∅ → m = ∅.
 Proof.

prelude/fin_maps.v

@@ -190,11 +190,6 @@ Proof.
   unfold subseteq, map_subseteq, map_relation. split; intros Hm i;
     specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
 Qed.
-Global Instance: EmptySpec (M A).
-Proof.
-  intros A m. rewrite !map_subseteq_spec.
-  intros i x. by rewrite lookup_empty.
-Qed.
 Global Instance: ∀ {A} (R : relation A), PreOrder R → PreOrder (map_included R).
 Proof.
   split; [intros m i; by destruct (m !! i); simpl|].

prelude/listset.v

@@ -28,7 +28,8 @@ Qed.
 Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = [].
 Proof.
   destruct X as [l]; split; [|by intros; simplify_eq/=].
-  intros [Hl _]; destruct l as [|x l]; [done|]. feed inversion (Hl x); left.
+  rewrite elem_of_equiv_empty; intros Hl.
+  destruct l as [|x l]; [done|]. feed inversion (Hl x). left.
 Qed. 
 Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅).
 Proof.

prelude/mapset.v

@@ -63,8 +63,8 @@ Proof.
     intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
     destruct (m2 !! x) as [[]|]; intuition congruence.
 Qed.
-Global Instance: PartialOrder (@subseteq (mapset M) _).
-Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
+Global Instance: LeibnizEquiv (mapset M).
+Proof. intros ??. apply mapset_eq. Qed.
 Global Instance: FinCollection K (mapset M).
 Proof.
   split.

prelude/orders.v

@@ -304,299 +304,3 @@ Section merge_sort_correct.
     StronglySorted R (merge_sort R l).
   Proof. auto using Sorted_StronglySorted, Sorted_merge_sort. Qed.
 End merge_sort_correct.
-
-(** * Canonical pre and partial orders *)
-(** We extend the canonical pre-order [⊆] to a partial order by defining setoid
-equality as [λ X Y, X ⊆ Y ∧ Y ⊆ X]. We prove that this indeed gives rise to a
-setoid. *)
-Instance preorder_equiv `{SubsetEq A} : Equiv A | 20 := λ X Y, X ⊆ Y ∧ Y ⊆ X.
-
-Section preorder.
-  Context `{SubsetEq A, !PreOrder (@subseteq A _)}.
-
-  Instance preorder_equivalence: @Equivalence A (≡).
-  Proof.
-    split.
-    - done.
-    - by intros ?? [??].
-    - by intros X Y Z [??] [??]; split; trans Y.
-  Qed.
-  Global Instance: Proper ((≡) ==> (≡) ==> iff) ((⊆) : relation A).
-  Proof.
-    unfold equiv, preorder_equiv. intros X1 Y1 ? X2 Y2 ?. split; intro.
-    - trans X1. tauto. trans X2; tauto.
-    - trans Y1. tauto. trans Y2; tauto.
-  Qed.
-  Lemma subset_spec (X Y : A) : X ⊂ Y ↔ X ⊆ Y ∧ X ≢ Y.
-  Proof.
-    split.
-    - intros [? HYX]. split. done. contradict HYX. by rewrite <-HYX.
-    - intros [? HXY]. split. done. by contradict HXY.
-  Qed.
-
-  Section dec.
-    Context `{∀ X Y : A, Decision (X ⊆ Y)}.
-    Global Instance preorder_equiv_dec_slow (X Y : A) :
-      Decision (X ≡ Y) | 100 := _.
-    Lemma subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
-    Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
-    Lemma not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
-    Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
-  End dec.
-
-  Section leibniz.
-    Context `{!LeibnizEquiv A}.
-    Lemma subset_spec_L X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠ Y.
-    Proof. unfold_leibniz. apply subset_spec. Qed.
-    Context `{∀ X Y : A, Decision (X ⊆ Y)}.
-    Lemma subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
-    Proof. unfold_leibniz. apply subseteq_inv. Qed.
-    Lemma not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
-    Proof. unfold_leibniz. apply not_subset_inv. Qed.
-  End leibniz.
-End preorder.
-
-Typeclasses Opaque preorder_equiv.
-Hint Extern 0 (@Equivalence _ (≡)) =>
-  class_apply preorder_equivalence : typeclass_instances.
-
-(** * Partial orders *)
-Section partial_order.
-  Context `{SubsetEq A, !PartialOrder (@subseteq A _)}.
-  Global Instance: LeibnizEquiv A.
-  Proof. intros ?? [??]; by apply (anti_symm (⊆)). Qed.
-End partial_order.
-
-(** * Join semi lattices *)
-(** General purpose theorems on join semi lattices. *)
-Section join_semi_lattice.
-  Context `{Empty A, JoinSemiLattice A, !EmptySpec A}.
-  Implicit Types X Y : A.
-  Implicit Types Xs Ys : list A.
-
-  Hint Resolve subseteq_empty union_subseteq_l union_subseteq_r union_least.
-  Lemma union_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ X2 ∪ Y.
-  Proof. intros. trans X2; auto. Qed.
-  Lemma union_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ Y ∪ X2.
-  Proof. intros. trans X2; auto. Qed.
-  Hint Resolve union_subseteq_l_transitive union_subseteq_r_transitive.
-  Lemma union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
-  Proof. auto. Qed.
-  Lemma union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
-  Proof. auto. Qed.
-  Lemma union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
-  Proof. auto. Qed.
-  Lemma union_empty X : X ∪ ∅ ⊆ X.
-  Proof. by apply union_least. Qed.
-  Global Instance union_proper : Proper ((≡) ==> (≡) ==> (≡)) (@union A _).
-  Proof.
-    unfold equiv, preorder_equiv.
-    split; apply union_preserving; simpl in *; tauto.
-  Qed.
-  Global Instance: IdemP ((≡) : relation A) (∪).
-  Proof. split; eauto. Qed.
-  Global Instance: LeftId ((≡) : relation A) ∅ (∪).
-  Proof. split; eauto. Qed.
-  Global Instance: RightId ((≡) : relation A) ∅ (∪).
-  Proof. split; eauto. Qed.
-  Global Instance: Comm ((≡) : relation A) (∪).
-  Proof. split; auto. Qed.
-  Global Instance: Assoc ((≡) : relation A) (∪).
-  Proof. split; auto. Qed.
-  Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
-  Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. Qed.
-  Lemma subseteq_union_1 X Y : X ⊆ Y → X ∪ Y ≡ Y.
-  Proof. apply subseteq_union. Qed.
-  Lemma subseteq_union_2 X Y : X ∪ Y ≡ Y → X ⊆ Y.
-  Proof. apply subseteq_union. Qed.
-  Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
-  Proof. split; eauto. Qed.
-  Global Instance union_list_proper: Proper ((≡) ==> (≡)) (union_list (A:=A)).
-  Proof. by induction 1; simpl; try apply union_proper. Qed.
-  Lemma union_list_nil : ⋃ @nil A = ∅.
-  Proof. done. Qed.
-  Lemma union_list_cons X Xs : ⋃ (X :: Xs) = X ∪ ⋃ Xs.
-  Proof. done. Qed.
-  Lemma union_list_singleton X : ⋃ [X] ≡ X.
-  Proof. simpl. by rewrite (right_id ∅ _). Qed.
-  Lemma union_list_app Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2.
-  Proof.
-    induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id ∅ _)|].
-    by rewrite IH, (assoc _).
-  Qed.
-  Lemma union_list_reverse Xs : ⋃ (reverse Xs) ≡ ⋃ Xs.
-  Proof.
-    induction Xs as [|X Xs IH]; simpl; [done |].
-    by rewrite reverse_cons, union_list_app,
-      union_list_singleton, (comm _), IH.
-  Qed.
-  Lemma union_list_preserving Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
-  Proof. induction 1; simpl; auto using union_preserving. Qed.
-  Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅.
-  Proof.
-    split.
-    - intros HXY. split; apply equiv_empty;
-        by trans (X ∪ Y); [auto | rewrite HXY].
-    - intros [HX HY]. by rewrite HX, HY, (left_id _ _).
-  Qed.
-  Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (≡ ∅) Xs.
-  Proof.
-    split.
-    - induction Xs; simpl; rewrite ?empty_union; intuition.
-    - induction 1 as [|?? E1 ? E2]; simpl. done. by apply empty_union.
-  Qed.
-
-  Section leibniz.
-    Context `{!LeibnizEquiv A}.
-    Global Instance: IdemP (=) (∪).
-    Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
-    Global Instance: LeftId (=) ∅ (∪).
-    Proof. intros ?. unfold_leibniz. apply (left_id _ _). Qed.
-    Global Instance: RightId (=) ∅ (∪).
-    Proof. intros ?. unfold_leibniz. apply (right_id _ _). Qed.
-    Global Instance: Comm (=) (∪).
-    Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
-    Global Instance: Assoc (=) (∪).
-    Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
-    Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y.
-    Proof. unfold_leibniz. apply subseteq_union. Qed.
-    Lemma subseteq_union_1_L X Y : X ⊆ Y → X ∪ Y = Y.
-    Proof. unfold_leibniz. apply subseteq_union_1. Qed.
-    Lemma subseteq_union_2_L X Y : X ∪ Y = Y → X ⊆ Y.
-    Proof. unfold_leibniz. apply subseteq_union_2. Qed.
-    Lemma equiv_empty_L X : X ⊆ ∅ → X = ∅.
-    Proof. unfold_leibniz. apply equiv_empty. Qed.
-    Lemma union_list_singleton_L (X : A) : ⋃ [X] = X.
-    Proof. unfold_leibniz. apply union_list_singleton. Qed.
-    Lemma union_list_app_L (Xs1 Xs2 : list A) : ⋃ (Xs1 ++ Xs2) = ⋃ Xs1 ∪ ⋃ Xs2.
-    Proof. unfold_leibniz. apply union_list_app. Qed.
-    Lemma union_list_reverse_L (Xs : list A) : ⋃ (reverse Xs) = ⋃ Xs.
-    Proof. unfold_leibniz. apply union_list_reverse. Qed.
-    Lemma empty_union_L X Y : X ∪ Y = ∅ ↔ X = ∅ ∧ Y = ∅.
-    Proof. unfold_leibniz. apply empty_union. Qed.
-    Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (= ∅) Xs.
-    Proof. unfold_leibniz. by rewrite empty_union_list. Qed. 
-  End leibniz.
-
-  Section dec.
-    Context `{∀ X Y : A, Decision (X ⊆ Y)}.
-    Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅.
-    Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed.
-    Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (≢ ∅) Xs.
-    Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
-    Context `{!LeibnizEquiv A}.
-    Lemma non_empty_union_L X Y : X ∪ Y ≠ ∅ ↔ X ≠ ∅ ∨ Y ≠ ∅.
-    Proof. unfold_leibniz. apply non_empty_union. Qed.
-    Lemma non_empty_union_list_L Xs : ⋃ Xs ≠ ∅ → Exists (≠ ∅) Xs.
-    Proof. unfold_leibniz. apply non_empty_union_list. Qed.
-  End dec.
-End join_semi_lattice.
-
-(** * Meet semi lattices *)
-(** The dual of the above section, but now for meet semi lattices. *)
-Section meet_semi_lattice.
-  Context `{MeetSemiLattice A}.
-  Implicit Types X Y : A.
-  Implicit Types Xs Ys : list A.
-
-  Hint Resolve intersection_subseteq_l intersection_subseteq_r
-    intersection_greatest.
-  Lemma intersection_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2.
-  Proof. intros. trans X1; auto. Qed.
-  Lemma intersection_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → Y ∩ X1 ⊆ X2.
-  Proof. intros. trans X1; auto. Qed.
-  Hint Resolve intersection_subseteq_l_transitive
-    intersection_subseteq_r_transitive.
-  Lemma intersection_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∩ Y1 ⊆ X ∩ Y2.
-  Proof. auto. Qed.
-  Lemma intersection_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2 ∩ Y.
-  Proof. auto. Qed.
-  Lemma intersection_preserving X1 X2 Y1 Y2 :
-    X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∩ Y1 ⊆ X2 ∩ Y2.
-  Proof. auto. Qed.
-  Global Instance: Proper ((≡) ==> (≡) ==> (≡)) (@intersection A _).
-  Proof.
-    unfold equiv, preorder_equiv. split;
-      apply intersection_preserving; simpl in *; tauto.
-  Qed.
-  Global Instance: IdemP ((≡) : relation A) (∩).
-  Proof. split; eauto. Qed.
-  Global Instance: Comm ((≡) : relation A) (∩).
-  Proof. split; auto. Qed.
-  Global Instance: Assoc ((≡) : relation A) (∩).
-  Proof. split; auto. Qed.
-  Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
-  Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. Qed.
-  Lemma subseteq_intersection_1 X Y : X ⊆ Y → X ∩ Y ≡ X.
-  Proof. apply subseteq_intersection. Qed.
-  Lemma subseteq_intersection_2 X Y : X ∩ Y ≡ X → X ⊆ Y.
-  Proof. apply subseteq_intersection. Qed.
-
-  Section leibniz.
-    Context `{!LeibnizEquiv A}.
-    Global Instance: IdemP (=) (∩).
-    Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
-    Global Instance: Comm (=) (∩).
-    Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
-    Global Instance: Assoc (=) (∩).
-    Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
-    Lemma subseteq_intersection_L X Y : X ⊆ Y ↔ X ∩ Y = X.
-    Proof. unfold_leibniz. apply subseteq_intersection. Qed.
-    Lemma subseteq_intersection_1_L X Y : X ⊆ Y → X ∩ Y = X.
-    Proof. unfold_leibniz. apply subseteq_intersection_1. Qed.
-    Lemma subseteq_intersection_2_L X Y : X ∩ Y = X → X ⊆ Y.
-    Proof. unfold_leibniz. apply subseteq_intersection_2. Qed.
-  End leibniz.
-End meet_semi_lattice.
-
-(** * Lower bounded lattices *)
-Section lattice.
-  Context `{Empty A, Lattice A, !EmptySpec A}.
-
-  Global Instance: LeftAbsorb ((≡) : relation A) ∅ (∩).
-  Proof. split. by apply intersection_subseteq_l. by apply subseteq_empty. Qed.
-  Global Instance: RightAbsorb ((≡) : relation A) ∅ (∩).
-  Proof. intros ?. by rewrite (comm _), (left_absorb _ _). Qed.
-  Lemma union_intersection_l (X Y Z : A) : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z).
-  Proof.
-    split; [apply union_least|apply lattice_distr].
-    { apply intersection_greatest; auto using union_subseteq_l. }
-    apply intersection_greatest.
-    - apply union_subseteq_r_transitive, intersection_subseteq_l.
-    - apply union_subseteq_r_transitive, intersection_subseteq_r.
-  Qed.
-  Lemma union_intersection_r (X Y Z : A) : (X ∩ Y) ∪ Z ≡ (X ∪ Z) ∩ (Y ∪ Z).
-  Proof. by rewrite !(comm _ _ Z), union_intersection_l. Qed.
-  Lemma intersection_union_l (X Y Z : A) : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
-  Proof.
-    split.
-    - rewrite union_intersection_l.
-      apply intersection_greatest.
-      { apply union_subseteq_r_transitive, intersection_subseteq_l. }
-      rewrite union_intersection_r.
-      apply intersection_preserving; auto using union_subseteq_l.
-    - apply intersection_greatest.
-      { apply union_least; auto using intersection_subseteq_l. }
-      apply union_least.
-      + apply intersection_subseteq_r_transitive, union_subseteq_l.
-      + apply intersection_subseteq_r_transitive, union_subseteq_r.
-  Qed.
-  Lemma intersection_union_r (X Y Z : A) : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
-  Proof. by rewrite !(comm _ _ Z), intersection_union_l. Qed.
-
-  Section leibniz.
-    Context `{!LeibnizEquiv A}.
-    Global Instance: LeftAbsorb (=) ∅ (∩).
-    Proof. intros ?. unfold_leibniz. apply (left_absorb _ _). Qed.
-    Global Instance: RightAbsorb (=) ∅ (∩).
-    Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed.
-    Lemma union_intersection_l_L (X Y Z : A) : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
-    Proof. unfold_leibniz; apply union_intersection_l. Qed.
-    Lemma union_intersection_r_L (X Y Z : A) : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z).
-    Proof. unfold_leibniz; apply union_intersection_r. Qed.
-    Lemma intersection_union_l_L (X Y Z : A) : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
-    Proof. unfold_leibniz; apply intersection_union_l. Qed.
-    Lemma intersection_union_r_L (X Y Z : A) : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
-    Proof. unfold_leibniz; apply intersection_union_r. Qed.
-  End leibniz.
-End lattice.