Commit da7a14bb authored by Robbert Krebbers's avatar Robbert Krebbers

More accurate formalization of integer ranks.

Integers with the same size, are no longer supposed to have the same rank. As a
result, the C integer types (char, short, int, long, long long) are different
(and thus cannot alias) even if they have the same size. We now have to use a
more involved definition of integer promotions and usual arithmetic conversions.
However, this new definition follows the C standard literally.
parent 39e490e9
...@@ -612,46 +612,37 @@ Lemma right_distr_L {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x : ...@@ -612,46 +612,37 @@ Lemma right_distr_L {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x :
Proof. auto. Qed. Proof. auto. Qed.
(** ** Axiomatization of ordered structures *) (** ** Axiomatization of ordered structures *)
(** The classes [PreOrder], [PartialOrder], and [TotalOrder] do not use the (** The classes [PreOrder], [PartialOrder], and [TotalOrder] use an arbitrary
relation [⊆] because we often have multiple orders on the same structure. *) relation [R] instead of [⊆] to support multiple orders on the same type. *)
Class PartialOrder {A} (R : relation A) : Prop := { Class PartialOrder {A} (R : relation A) : Prop := {
po_preorder :> PreOrder R; partial_order_pre :> PreOrder R;
po_anti_symmetric :> AntiSymmetric (=) R partial_order_anti_symmetric :> AntiSymmetric (=) R
}. }.
Class TotalOrder {A} (R : relation A) : Prop := { Class TotalOrder {A} (R : relation A) : Prop := {
to_po :> PartialOrder R; total_order_partial :> PartialOrder R;
to_trichotomy :> Trichotomy R total_order_trichotomy :> Trichotomy (strict R)
}. }.
(** We do not include equality in the following interfaces so as to avoid the (** We do not use a setoid equality in the following interfaces to avoid the
need for proofs that the relations and operations respect setoid equality. need for proofs that the relations and operations are proper. Instead, we
Instead, we will define setoid equality in a generic way as define setoid equality generically [λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
[λ X Y, X ⊆ Y ∧ Y ⊆ X]. *) Class EmptySpec A `{Empty A, SubsetEq A} : Prop := subseteq_empty X : X.
Class BoundedPreOrder A `{Empty A, SubsetEq A} : Prop := { Class JoinSemiLattice A `{SubsetEq A, Union A} : Prop := {
bounded_preorder :>> PreOrder (); join_semi_lattice_pre :>> PreOrder ();
subseteq_empty X : X
}.
Class BoundedJoinSemiLattice A `{Empty A, SubsetEq A, Union A} : Prop := {
bjsl_preorder :>> BoundedPreOrder A;
union_subseteq_l X Y : X X Y; union_subseteq_l X Y : X X Y;
union_subseteq_r X Y : Y X Y; union_subseteq_r X Y : Y X Y;
union_least X Y Z : X Z Y Z X Y Z union_least X Y Z : X Z Y Z X Y Z
}. }.
Class MeetSemiLattice A `{Empty A, SubsetEq A, Intersection A} : Prop := { Class MeetSemiLattice A `{SubsetEq A, Intersection A} : Prop := {
msl_preorder :>> BoundedPreOrder A; meet_semi_lattice_pre :>> PreOrder ();
intersection_subseteq_l X Y : X Y X; intersection_subseteq_l X Y : X Y X;
intersection_subseteq_r X Y : X Y Y; intersection_subseteq_r X Y : X Y Y;
intersection_greatest X Y Z : Z X Z Y Z X Y intersection_greatest X Y Z : Z X Z Y Z X Y
}. }.
Class Lattice A `{SubsetEq A, Union A, Intersection A} : Prop := {
(** A join distributive lattice with distributivity stated in the order lattice_join :>> JoinSemiLattice A;
theoretic way. We will prove that distributivity of join, and distributivity lattice_meet :>> MeetSemiLattice A;
as an equality can be derived. *) lattice_distr X Y Z : (X Y) (X Z) X (Y Z)
Class LowerBoundedLattice A
`{Empty A, SubsetEq A, Union A, Intersection A} : Prop := {
lbl_bjsl :>> BoundedJoinSemiLattice A;
lbl_msl :>> MeetSemiLattice A;
lbl_distr X Y Z : (X Y) (X Z) X (Y Z)
}. }.
(** ** Axiomatization of collections *) (** ** Axiomatization of collections *)
...@@ -670,14 +661,12 @@ Class Collection A C `{ElemOf A C, Empty C, Singleton A C, ...@@ -670,14 +661,12 @@ Class Collection A C `{ElemOf A C, Empty C, Singleton A C,
elem_of_intersection X Y (x : A) : x X Y x X x Y; elem_of_intersection X Y (x : A) : x X Y x X x Y;
elem_of_difference X Y (x : A) : x X Y x X x Y elem_of_difference X Y (x : A) : x X Y x X x Y
}. }.
Class CollectionOps A C `{ElemOf A C, Empty C, Singleton A C, Class CollectionOps A C `{ElemOf A C, Empty C, Singleton A C, Union C,
Union C, Intersection C, Difference C, Intersection C, Difference C, IntersectionWith A C, Filter A C} : Prop := {
IntersectionWith A C, Filter A C} : Prop := {
collection_ops :>> Collection A C; collection_ops :>> Collection A C;
elem_of_intersection_with (f : A A option A) X Y (x : A) : elem_of_intersection_with (f : A A option A) X Y (x : A) :
x intersection_with f X Y x1 x2, x1 X x2 Y f x1 x2 = Some x; x intersection_with f X Y x1 x2, x1 X x2 Y f x1 x2 = Some x;
elem_of_filter X P `{ x, Decision (P x)} x : elem_of_filter X P `{ x, Decision (P x)} x : x filter P X P x x X
x filter P X P x x X
}. }.
(** We axiomative a finite collection as a collection whose elements can be (** We axiomative a finite collection as a collection whose elements can be
......
...@@ -18,7 +18,9 @@ Section simple_collection. ...@@ -18,7 +18,9 @@ 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: EmptySpec C.
Proof. firstorder auto. Qed.
Global Instance: JoinSemiLattice 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.
...@@ -229,9 +231,8 @@ Tactic Notation "esolve_elem_of" := esolve_elem_of eauto. ...@@ -229,9 +231,8 @@ Tactic Notation "esolve_elem_of" := esolve_elem_of eauto.
Section collection. Section collection.
Context `{Collection A C}. Context `{Collection A C}.
Global Instance: LowerBoundedLattice C. Global Instance: Lattice C.
Proof. split. apply _. firstorder auto. solve_elem_of. Qed. Proof. 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.
...@@ -484,14 +485,12 @@ Section collection_monad. ...@@ -484,14 +485,12 @@ Section collection_monad.
Lemma collection_mapM_length {A B} (f : A M B) l k : Lemma collection_mapM_length {A B} (f : A M B) l k :
l mapM f k length l = length k. l mapM f k length l = length k.
Proof. revert l; induction k; esolve_elem_of. Qed. Proof. revert l; induction k; esolve_elem_of. Qed.
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. induction Hl; simpl; intros; intros Hl. revert k. induction Hl; simpl; intros;
decompose_elem_of; f_equal'; auto. decompose_elem_of; 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 :
l mapM f k Forall (λ x, y, y f x P y) k Forall P l. l mapM f k Forall (λ x, y, y f x P y) k Forall P l.
Proof. rewrite elem_of_mapM. apply Forall2_Forall_l. Qed. Proof. rewrite elem_of_mapM. apply Forall2_Forall_l. Qed.
......
...@@ -122,17 +122,18 @@ Proof. ...@@ -122,17 +122,18 @@ Proof.
unfold subseteq, map_subseteq, map_Forall2. split; intros Hm i; unfold subseteq, map_subseteq, map_Forall2. split; intros Hm i;
specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver. specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
Qed. Qed.
Global Instance: BoundedPreOrder (M A). Global Instance: EmptySpec (M A).
Proof. Proof.
repeat split. intros A m. rewrite !map_subseteq_spec.
* intros m. by rewrite map_subseteq_spec. intros i x. by rewrite lookup_empty.
* intros m1 m2 m3. rewrite !map_subseteq_spec. naive_solver.
* intros m. rewrite !map_subseteq_spec. intros i x. by rewrite lookup_empty.
Qed. Qed.
Global Instance : PartialOrder (@subseteq (M A) _). Global Instance: PartialOrder (() : relation (M A)).
Proof. Proof.
split; [apply _ |]. intros ??. rewrite !map_subseteq_spec. repeat split.
intros ??. apply map_eq; intros i. apply option_eq. naive_solver. * intros m; rewrite !map_subseteq_spec; naive_solver.
* intros m1 m2 m3; rewrite !map_subseteq_spec; naive_solver.
* intros m1 m2; rewrite !map_subseteq_spec.
intros; apply map_eq; intros i; apply option_eq; naive_solver.
Qed. Qed.
Lemma lookup_weaken {A} (m1 m2 : M A) i x : Lemma lookup_weaken {A} (m1 m2 : M A) i x :
m1 !! i = Some x m1 m2 m2 !! i = Some x. m1 !! i = Some x m1 m2 m2 !! i = Some x.
......
...@@ -177,8 +177,8 @@ Section enc_finite. ...@@ -177,8 +177,8 @@ Section enc_finite.
End enc_finite. End enc_finite.
Section bijective_finite. Section bijective_finite.
Context `{Finite A} `{ x y : B, Decision (x = y)} (f : A B) (g : B A). Context `{Finite A, x y : B, Decision (x = y)} (f : A B) (g : B A).
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 (NoDup_fmap_2 _), NoDup_enum. Qed. Next Obligation. apply (NoDup_fmap_2 _), NoDup_enum. Qed.
...@@ -215,7 +215,7 @@ Next Obligation. intros [|]. left. right; left. Qed. ...@@ -215,7 +215,7 @@ Next Obligation. intros [|]. left. right; left. Qed.
Lemma bool_card : card bool = 2. Lemma bool_card : card bool = 2.
Proof. done. Qed. Proof. done. Qed.
Program Instance sum_finite `{Finite A} `{Finite B} : Finite (A + B)%type := 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.
...@@ -227,10 +227,10 @@ Next Obligation. ...@@ -227,10 +227,10 @@ Next Obligation.
intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap; intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap;
eauto using @elem_of_enum. eauto using @elem_of_enum.
Qed. Qed.
Lemma sum_card `{Finite A} `{Finite B} : card (A + B) = card A + card B. Lemma sum_card `{Finite A, Finite B} : card (A + B) = card A + card B.
Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed. 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 (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl. intros ??????. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl.
......
...@@ -77,6 +77,10 @@ Proof. intros. destruct (Nat_mul_split_l n x2 x1 y2 y1); auto with lia. Qed. ...@@ -77,6 +77,10 @@ Proof. intros. destruct (Nat_mul_split_l n x2 x1 y2 y1); auto with lia. Qed.
Notation lcm := Nat.lcm. Notation lcm := Nat.lcm.
Notation divide := Nat.divide. Notation divide := Nat.divide.
Notation "( x | y )" := (divide x y) : nat_scope. Notation "( x | y )" := (divide x y) : nat_scope.
Instance divide_dec x y : Decision (x | y).
Proof.
refine (cast_if (decide (lcm x y = y))); by rewrite Nat.divide_lcm_iff.
Defined.
Instance: PartialOrder divide. Instance: PartialOrder divide.
Proof. Proof.
repeat split; try apply _. intros ??. apply Nat.divide_antisym_nonneg; lia. repeat split; try apply _. intros ??. apply Nat.divide_antisym_nonneg; lia.
......
...@@ -29,15 +29,13 @@ Section orders. ...@@ -29,15 +29,13 @@ Section orders.
Proof. by intros [??] <-. Qed. Proof. by intros [??] <-. Qed.
Lemma strict_transitive_l `{!Transitive R} X Y Z : X Y Y Z X Z. Lemma strict_transitive_l `{!Transitive R} X Y Z : X Y Y Z X Z.
Proof. Proof.
intros [? HXY] ?. split. intros [? HXY] ?. split; [by transitivity Y|].
* by transitivity Y. contradict HXY. by transitivity Z.
* contradict HXY. by transitivity Z.
Qed. Qed.
Lemma strict_transitive_r `{!Transitive R} X Y Z : X Y Y Z X Z. Lemma strict_transitive_r `{!Transitive R} X Y Z : X Y Y Z X Z.
Proof. Proof.
intros ? [? HYZ]. split. intros ? [? HYZ]. split; [by transitivity Y|].
* by transitivity Y. contradict HYZ. by transitivity X.
* contradict HYZ. by transitivity X.
Qed. Qed.
Global Instance: Irreflexive (strict R). Global Instance: Irreflexive (strict R).
Proof. firstorder. Qed. Proof. firstorder. Qed.
...@@ -54,7 +52,7 @@ Section orders. ...@@ -54,7 +52,7 @@ Section orders.
* intros [? HYX]. split. done. by intros <-. * intros [? HYX]. split. done. by intros <-.
* intros [? HXY]. split. done. by contradict HXY; apply (anti_symmetric R). * intros [? HXY]. split. done. by contradict HXY; apply (anti_symmetric R).
Qed. Qed.
Lemma po_eq_dec `{!PartialOrder R} `{ X Y, Decision (X Y)} (X Y : A) : Lemma po_eq_dec `{!PartialOrder R, X Y, Decision (X Y)} (X Y : A) :
Decision (X = Y). Decision (X = Y).
Proof. Proof.
refine (cast_if_and (decide (X Y)) (decide (Y X))); refine (cast_if_and (decide (X Y)) (decide (Y X)));
...@@ -65,7 +63,7 @@ Section orders. ...@@ -65,7 +63,7 @@ Section orders.
Lemma total_not_strict `{!Total R} X Y : X Y Y X. Lemma total_not_strict `{!Total R} X Y : X Y Y X.
Proof. red; auto using total_not. Qed. Proof. red; auto using total_not. Qed.
Global Instance trichotomy_total Global Instance trichotomy_total
`{!Trichotomy (strict R)} `{!Reflexive R} : Total R. `{!Trichotomy (strict R), !Reflexive R} : Total R.
Proof. Proof.
intros X Y. intros X Y.
destruct (trichotomy (strict R) X Y) as [[??]|[<-|[??]]]; intuition. destruct (trichotomy (strict R) X Y) as [[??]|[<-|[??]]]; intuition.
...@@ -82,15 +80,13 @@ Section strict_orders. ...@@ -82,15 +80,13 @@ Section strict_orders.
Lemma strict_anti_symmetric `{!StrictOrder R} X Y : Lemma strict_anti_symmetric `{!StrictOrder R} X Y :
X Y Y X False. X Y Y X False.
Proof. intros. apply (irreflexivity R X). by transitivity Y. Qed. Proof. intros. apply (irreflexivity R X). by transitivity Y. Qed.
Global Instance trichotomyT_dec `{!TrichotomyT R, !StrictOrder R} X Y :
Global Instance trichotomyT_dec `{!TrichotomyT R} Decision (X Y) :=
`{!StrictOrder R} X Y : Decision (X Y) :=
match trichotomyT R X Y with match trichotomyT R X Y with
| inleft (left H) => left H | inleft (left H) => left H
| inleft (right H) => right (irreflexive_eq _ _ H) | inleft (right H) => right (irreflexive_eq _ _ H)
| inright H => right (strict_anti_symmetric _ _ H) | inright H => right (strict_anti_symmetric _ _ H)
end. end.
Global Instance trichotomyT_trichotomy `{!TrichotomyT R} : Trichotomy R. Global Instance trichotomyT_trichotomy `{!TrichotomyT R} : Trichotomy R.
Proof. intros X Y. destruct (trichotomyT R X Y) as [[|]|]; tauto. Qed. Proof. intros X Y. destruct (trichotomyT R X Y) as [[|]|]; tauto. Qed.
End strict_orders. End strict_orders.
...@@ -168,7 +164,7 @@ Section sorted. ...@@ -168,7 +164,7 @@ Section sorted.
inversion Hx1'; inversion Hx2'; simplify_equality; auto. } inversion Hx1'; inversion Hx2'; simplify_equality; auto. }
f_equal. by apply IH, (injective (x2 ::)). f_equal. by apply IH, (injective (x2 ::)).
Qed. Qed.
Lemma Sorted_unique `{!Transitive R} `{!AntiSymmetric (=) R} l1 l2 : Lemma Sorted_unique `{!Transitive R, !AntiSymmetric (=) R} l1 l2 :
Sorted R l1 Sorted R l2 l1 l2 l1 = l2. Sorted R l1 Sorted R l2 l1 l2 l1 = l2.
Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed. Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed.
...@@ -181,7 +177,6 @@ Section sorted. ...@@ -181,7 +177,6 @@ Section sorted.
| y :: l => cast_if (decide (R x y)) | y :: l => cast_if (decide (R x y))
end; abstract first [by constructor | by inversion 1]. end; abstract first [by constructor | by inversion 1].
Defined. Defined.
Global Instance Sorted_dec `{ x y, Decision (R x y)} : l, Global Instance Sorted_dec `{ x y, Decision (R x y)} : l,
Decision (Sorted R l). Decision (Sorted R l).
Proof. Proof.
...@@ -228,7 +223,6 @@ Section merge_sort_correct. ...@@ -228,7 +223,6 @@ Section merge_sort_correct.
if decide (R x1 x2) then x1 :: list_merge R l1 (x2 :: l2) if decide (R x1 x2) then x1 :: list_merge R l1 (x2 :: l2)
else x2 :: list_merge R (x1 :: l1) l2. else x2 :: list_merge R (x1 :: l1) l2.
Proof. done. Qed. Proof. done. Qed.
Lemma HdRel_list_merge x l1 l2 : Lemma HdRel_list_merge x l1 l2 :
HdRel R x l1 HdRel R x l2 HdRel R x (list_merge R l1 l2). HdRel R x l1 HdRel R x l2 HdRel R x (list_merge R l1 l2).
Proof. Proof.
...@@ -318,7 +312,7 @@ setoid. *) ...@@ -318,7 +312,7 @@ setoid. *)
Instance preorder_equiv `{SubsetEq A} : Equiv A := λ X Y, X Y Y X. Instance preorder_equiv `{SubsetEq A} : Equiv A := λ X Y, X Y Y X.
Section preorder. Section preorder.
Context `{SubsetEq A} `{!PreOrder (@subseteq A _)}. Context `{SubsetEq A, !PreOrder (@subseteq A _)}.
Instance preorder_equivalence: @Equivalence A (). Instance preorder_equivalence: @Equivalence A ().
Proof. Proof.
...@@ -349,35 +343,34 @@ Section preorder. ...@@ -349,35 +343,34 @@ Section preorder.
Lemma not_subset_inv X Y : X Y X Y X Y. Lemma not_subset_inv X Y : X Y X Y X Y.
Proof. rewrite subset_spec. destruct (decide (X Y)); tauto. Qed. Proof. rewrite subset_spec. destruct (decide (X Y)); tauto. Qed.
End dec. End dec.
End preorder.
Section preorder_leibniz.
Context `{SubsetEq A} `{!PreOrder (@subseteq A _)} `{!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)}. Section leibniz.
Lemma subseteq_inv_L X Y : X Y X Y X = Y. Context `{!LeibnizEquiv A}.
Proof. unfold_leibniz. apply subseteq_inv. Qed. Lemma subset_spec_L X Y : X Y X Y X Y.
Lemma not_subset_inv_L X Y : X Y X Y X = Y. Proof. unfold_leibniz. apply subset_spec. Qed.
Proof. unfold_leibniz. apply not_subset_inv. Qed. Context `{ X Y : A, Decision (X Y)}.
End preorder_leibniz. 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. Typeclasses Opaque preorder_equiv.
Hint Extern 0 (@Equivalence _ ()) => Hint Extern 0 (@Equivalence _ ()) =>
class_apply preorder_equivalence : typeclass_instances. class_apply preorder_equivalence : typeclass_instances.
(** * Partial orders *) (** * Partial orders *)
Section partialorder. Section partial_order.
Context `{SubsetEq A} `{!PartialOrder (@subseteq A _)}. Context `{SubsetEq A, !PartialOrder (@subseteq A _)}.
Global Instance: LeibnizEquiv A. Global Instance: LeibnizEquiv A.
Proof. split. intros [??]. by apply (anti_symmetric ()). by intros ->. Qed. Proof. split. intros [??]. by apply (anti_symmetric ()). by intros ->. Qed.
End partialorder. End partial_order.
(** * Join semi lattices *) (** * Join semi lattices *)
(** General purpose theorems on join semi lattices. *) (** General purpose theorems on join semi lattices. *)
Section bounded_join_sl. Section join_semi_lattice.
Context `{BoundedJoinSemiLattice A}. Context `{Empty A, JoinSemiLattice A, !EmptySpec A}.
Implicit Types X Y : A. Implicit Types X Y : A.
Implicit Types Xs Ys : list A. Implicit Types Xs Ys : list A.
...@@ -418,8 +411,7 @@ Section bounded_join_sl. ...@@ -418,8 +411,7 @@ Section bounded_join_sl.
Proof. apply subseteq_union. Qed. Proof. apply subseteq_union. Qed.
Lemma equiv_empty X : X X . Lemma equiv_empty X : X X .
Proof. split; eauto. Qed. Proof. split; eauto. Qed.
Global Instance union_list_proper: Global Instance union_list_proper: Proper (Forall2 () ==> ()) union_list.
Proper (Forall2 () ==> ()) union_list.
Proof. induction 1; simpl. done. by apply union_proper. Qed. Proof. induction 1; simpl. done. by apply union_proper. Qed.
Lemma union_list_nil : @nil A = . Lemma union_list_nil : @nil A = .
Proof. done. Qed. Proof. done. Qed.
...@@ -498,11 +490,11 @@ Section bounded_join_sl. ...@@ -498,11 +490,11 @@ Section bounded_join_sl.
Lemma non_empty_union_list_L Xs : Xs Exists ( ) Xs. Lemma non_empty_union_list_L Xs : Xs Exists ( ) Xs.
Proof. unfold_leibniz. apply non_empty_union_list. Qed. Proof. unfold_leibniz. apply non_empty_union_list. Qed.
End dec. End dec.
End bounded_join_sl. End join_semi_lattice.
(** * Meet semi lattices *) (** * Meet semi lattices *)
(** The dual of the above section, but now for meet semi lattices. *) (** The dual of the above section, but now for meet semi lattices. *)
Section meet_sl. Section meet_semi_lattice.
Context `{MeetSemiLattice A}. Context `{MeetSemiLattice A}.
Implicit Types X Y : A. Implicit Types X Y : A.
Implicit Types Xs Ys : list A. Implicit Types Xs Ys : list A.
...@@ -555,27 +547,24 @@ Section meet_sl. ...@@ -555,27 +547,24 @@ Section meet_sl.
Lemma subseteq_intersection_2_L X Y : X Y = X X Y. Lemma subseteq_intersection_2_L X Y : X Y = X X Y.
Proof. unfold_leibniz. apply subseteq_intersection_2. Qed. Proof. unfold_leibniz. apply subseteq_intersection_2. Qed.
End leibniz. End leibniz.
End meet_sl. End meet_semi_lattice.
(** * Lower bounded lattices *) (** * Lower bounded lattices *)
Section lower_bounded_lattice. Section lattice.
Context `{LowerBoundedLattice A}. Context `{Empty A, Lattice A, !EmptySpec A}.
Global Instance: LeftAbsorb () (). Global Instance: LeftAbsorb () ().
Proof. Proof. split. by apply intersection_subseteq_l. by apply subseteq_empty. Qed.
split. by apply intersection_subseteq_l. by apply subseteq_empty.
Qed.
Global Instance: RightAbsorb () (). Global Instance: RightAbsorb () ().
Proof. intros ?. by rewrite (commutative _), (left_absorb _ _). Qed. Proof. intros ?. by rewrite (commutative _), (left_absorb _ _). Qed.
Global Instance: LeftDistr () () (). Global Instance: LeftDistr () () ().
Proof. Proof.
intros X Y Z. split. intros X Y Z. split; [|apply lattice_distr].
* apply union_least. apply union_least.
{ apply intersection_greatest; auto using union_subseteq_l. } { apply intersection_greatest; auto using union_subseteq_l. }
apply intersection_greatest. apply intersection_greatest.
+ apply union_subseteq_r_transitive, intersection_subseteq_l. * apply union_subseteq_r_transitive, intersection_subseteq_l.
+ apply union_subseteq_r_transitive, intersection_subseteq_r. * apply union_subseteq_r_transitive, intersection_subseteq_r.
* apply lbl_distr.
Qed. Qed.
Global Instance: RightDistr () () (). Global Instance: RightDistr () () ().
Proof. intros X Y Z. by rewrite !(commutative _ _ Z), (left_distr _ _). Qed. Proof. intros X Y Z. by rewrite !(commutative _ _ Z), (left_distr _ _). Qed.
...@@ -585,9 +574,8 @@ Section lower_bounded_lattice. ...@@ -585,9 +574,8 @@ Section lower_bounded_lattice.
* rewrite (left_distr () ()). * rewrite (left_distr () ()).
apply intersection_greatest. apply intersection_greatest.
{ apply union_subseteq_r_transitive, intersection_subseteq_l. } { apply union_subseteq_r_transitive, intersection_subseteq_l. }
rewrite (right_distr () ()). apply intersection_preserving. rewrite (right_distr () ()).
+ apply union_subseteq_l. apply intersection_preserving; auto using union_subseteq_l.
+ done.
* apply intersection_greatest. * apply intersection_greatest.
{ apply union_least; auto using intersection_subseteq_l. } { apply union_least; auto using intersection_subseteq_l. }
apply union_least. apply union_least.
...@@ -612,4 +600,4 @@ Section lower_bounded_lattice. ...@@ -612,4 +600,4 @@ Section lower_bounded_lattice.
Global Instance: RightDistr (=) () (). Global Instance: RightDistr (=) () ().
Proof. intros ???. unfold_leibniz. apply (right_distr _ _). Qed. Proof. intros ???. unfold_leibniz. apply (right_distr _ _). Qed.