Commit 1804da3f authored by Robbert Krebbers's avatar Robbert Krebbers

Simplify collection spaghetti.

There was not really a need for the lattice type classes, so I removed
these.
parent d1fa8150
......@@ -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,
......
This diff is collapsed.
......@@ -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.
......
......@@ -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|].
......
......@@ -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.
......
......@@ -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.
......
......@@ -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.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment