diff options
Diffstat (limited to 'theories/Structures')
| -rw-r--r-- | theories/Structures/DecidableType.v | 2 | ||||
| -rw-r--r-- | theories/Structures/DecidableTypeEx.v | 2 | ||||
| -rw-r--r-- | theories/Structures/Equalities.v | 77 | ||||
| -rw-r--r-- | theories/Structures/EqualitiesFacts.v | 23 | ||||
| -rw-r--r-- | theories/Structures/GenericMinMax.v | 16 | ||||
| -rw-r--r-- | theories/Structures/OrderedType.v | 19 | ||||
| -rw-r--r-- | theories/Structures/OrderedTypeAlt.v | 2 | ||||
| -rw-r--r-- | theories/Structures/OrderedTypeEx.v | 24 | ||||
| -rw-r--r-- | theories/Structures/Orders.v | 109 | ||||
| -rw-r--r-- | theories/Structures/OrdersAlt.v | 2 | ||||
| -rw-r--r-- | theories/Structures/OrdersEx.v | 12 | ||||
| -rw-r--r-- | theories/Structures/OrdersFacts.v | 324 | ||||
| -rw-r--r-- | theories/Structures/OrdersLists.v | 6 |
13 files changed, 445 insertions, 173 deletions
diff --git a/theories/Structures/DecidableType.v b/theories/Structures/DecidableType.v index 18153436..79e81771 100644 --- a/theories/Structures/DecidableType.v +++ b/theories/Structures/DecidableType.v @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: DecidableType.v 12641 2010-01-07 15:32:52Z letouzey $ *) - Require Export SetoidList. Require Equalities. diff --git a/theories/Structures/DecidableTypeEx.v b/theories/Structures/DecidableTypeEx.v index ac1f014b..2c02f8dd 100644 --- a/theories/Structures/DecidableTypeEx.v +++ b/theories/Structures/DecidableTypeEx.v @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: DecidableTypeEx.v 12641 2010-01-07 15:32:52Z letouzey $ *) - Require Import DecidableType OrderedType OrderedTypeEx. Set Implicit Arguments. Unset Strict Implicit. diff --git a/theories/Structures/Equalities.v b/theories/Structures/Equalities.v index 382511d9..eb537385 100644 --- a/theories/Structures/Equalities.v +++ b/theories/Structures/Equalities.v @@ -6,23 +6,28 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: Equalities.v 13475 2010-09-29 14:33:13Z letouzey $ *) - Require Export RelationClasses. +Require Import Bool Morphisms Setoid. Set Implicit Arguments. Unset Strict Implicit. +(** Structure with nothing inside. + Used to force a module type T into a module via Nop <+ T. (HACK!) *) + +Module Type Nop. +End Nop. + (** * Structure with just a base type [t] *) Module Type Typ. - Parameter Inline t : Type. + Parameter Inline(10) t : Type. End Typ. (** * Structure with an equality relation [eq] *) Module Type HasEq (Import T:Typ). - Parameter Inline eq : t -> t -> Prop. + Parameter Inline(30) eq : t -> t -> Prop. End HasEq. Module Type Eq := Typ <+ HasEq. @@ -61,10 +66,19 @@ End HasEqDec. (** Having [eq_dec] is the same as having a boolean equality plus a correctness proof. *) -Module Type HasEqBool (Import E:Eq'). +Module Type HasEqb (Import T:Typ). Parameter Inline eqb : t -> t -> bool. - Parameter eqb_eq : forall x y, eqb x y = true <-> x==y. -End HasEqBool. +End HasEqb. + +Module Type EqbSpec (T:Typ)(X:HasEq T)(Y:HasEqb T). + Parameter eqb_eq : forall x y, Y.eqb x y = true <-> X.eq x y. +End EqbSpec. + +Module Type EqbNotation (T:Typ)(E:HasEqb T). + Infix "=?" := E.eqb (at level 70, no associativity). +End EqbNotation. + +Module Type HasEqBool (E:Eq) := HasEqb E <+ EqbSpec E E. (** From these basic blocks, we can build many combinations of static standalone module types. *) @@ -102,8 +116,10 @@ Module Type EqualityTypeBoth' := EqualityTypeBoth <+ EqNotation. Module Type DecidableType' := DecidableType <+ EqNotation. Module Type DecidableTypeOrig' := DecidableTypeOrig <+ EqNotation. Module Type DecidableTypeBoth' := DecidableTypeBoth <+ EqNotation. -Module Type BooleanEqualityType' := BooleanEqualityType <+ EqNotation. -Module Type BooleanDecidableType' := BooleanDecidableType <+ EqNotation. +Module Type BooleanEqualityType' := + BooleanEqualityType <+ EqNotation <+ EqbNotation. +Module Type BooleanDecidableType' := + BooleanDecidableType <+ EqNotation <+ EqbNotation. Module Type DecidableTypeFull' := DecidableTypeFull <+ EqNotation. (** * Compatibility wrapper from/to the old version of @@ -162,6 +178,49 @@ Module Bool2Dec (E:BooleanEqualityType) <: BooleanDecidableType := E <+ HasEqBool2Dec. +(** Some properties of boolean equality *) + +Module BoolEqualityFacts (Import E : BooleanEqualityType'). + +(** [eqb] is compatible with [eq] *) + +Instance eqb_compat : Proper (E.eq ==> E.eq ==> Logic.eq) eqb. +Proof. +intros x x' Exx' y y' Eyy'. +apply eq_true_iff_eq. +now rewrite 2 eqb_eq, Exx', Eyy'. +Qed. + +(** Alternative specification of [eqb] based on [reflect]. *) + +Lemma eqb_spec x y : reflect (x==y) (x =? y). +Proof. +apply iff_reflect. symmetry. apply eqb_eq. +Defined. + +(** Negated form of [eqb_eq] *) + +Lemma eqb_neq x y : (x =? y) = false <-> x ~= y. +Proof. +now rewrite <- not_true_iff_false, eqb_eq. +Qed. + +(** Basic equality laws for [eqb] *) + +Lemma eqb_refl x : (x =? x) = true. +Proof. +now apply eqb_eq. +Qed. + +Lemma eqb_sym x y : (x =? y) = (y =? x). +Proof. +apply eq_true_iff_eq. now rewrite 2 eqb_eq. +Qed. + +(** Transitivity is a particular case of [eqb_compat] *) + +End BoolEqualityFacts. + (** * UsualDecidableType diff --git a/theories/Structures/EqualitiesFacts.v b/theories/Structures/EqualitiesFacts.v index d9b1d76f..c69885b4 100644 --- a/theories/Structures/EqualitiesFacts.v +++ b/theories/Structures/EqualitiesFacts.v @@ -8,21 +8,8 @@ Require Import Equalities Bool SetoidList RelationPairs. -(** In a BooleanEqualityType, [eqb] is compatible with [eq] *) - -Module BoolEqualityFacts (Import E : BooleanEqualityType). - -Instance eqb_compat : Proper (E.eq ==> E.eq ==> Logic.eq) eqb. -Proof. -intros x x' Exx' y y' Eyy'. -apply eq_true_iff_eq. -rewrite 2 eqb_eq, Exx', Eyy'; auto with *. -Qed. - -End BoolEqualityFacts. - - (** * Keys and datas used in FMap *) + Module KeyDecidableType(Import D:DecidableType). Section Elt. @@ -42,9 +29,9 @@ Module KeyDecidableType(Import D:DecidableType). (* eqk, eqke are equalities, ltk is a strict order *) - Global Instance eqk_equiv : Equivalence eqk. + Global Instance eqk_equiv : Equivalence eqk := _. - Global Instance eqke_equiv : Equivalence eqke. + Global Instance eqke_equiv : Equivalence eqke := _. (* Additionnal facts *) @@ -156,7 +143,7 @@ Module PairDecidableType(D1 D2:DecidableType) <: DecidableType. Definition eq := (D1.eq * D2.eq)%signature. - Instance eq_equiv : Equivalence eq. + Instance eq_equiv : Equivalence eq := _. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. @@ -172,7 +159,7 @@ End PairDecidableType. Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType. Definition t := (D1.t * D2.t)%type. Definition eq := @eq t. - Program Instance eq_equiv : Equivalence eq. + Instance eq_equiv : Equivalence eq := _. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); diff --git a/theories/Structures/GenericMinMax.v b/theories/Structures/GenericMinMax.v index 68f20189..5583142f 100644 --- a/theories/Structures/GenericMinMax.v +++ b/theories/Structures/GenericMinMax.v @@ -79,7 +79,7 @@ End GenericMinMax. (** ** Consequences of the minimalist interface: facts about [max]. *) Module MaxLogicalProperties (Import O:TotalOrder')(Import M:HasMax O). - Module Import T := !MakeOrderTac O. + Module Import Private_Tac := !MakeOrderTac O. (** An alternative caracterisation of [max], equivalent to [max_l /\ max_r] *) @@ -277,8 +277,9 @@ End MaxLogicalProperties. Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O). Include MaxLogicalProperties O M. - Import T. + Import Private_Tac. + Module Import Private_Rev. Module ORev := TotalOrderRev O. Module MRev <: HasMax ORev. Definition max x y := M.min y x. @@ -286,6 +287,7 @@ Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O). Definition max_r x y := M.min_l y x. End MRev. Module MPRev := MaxLogicalProperties ORev MRev. + End Private_Rev. Instance min_compat : Proper (eq==>eq==>eq) min. Proof. intros x x' Hx y y' Hy. apply MPRev.max_compat; assumption. Qed. @@ -578,29 +580,29 @@ End UsualMinMaxLogicalProperties. Module UsualMinMaxDecProperties (Import O:UsualOrderedTypeFull')(Import M:HasMinMax O). - Module P := MinMaxDecProperties O M. + Module Import Private_Dec := MinMaxDecProperties O M. Lemma max_case_strong : forall n m (P:t -> Type), (m<=n -> P n) -> (n<=m -> P m) -> P (max n m). - Proof. intros; apply P.max_case_strong; auto. congruence. Defined. + Proof. intros; apply max_case_strong; auto. congruence. Defined. Lemma max_case : forall n m (P:t -> Type), P n -> P m -> P (max n m). Proof. intros; apply max_case_strong; auto. Defined. Lemma max_dec : forall n m, {max n m = n} + {max n m = m}. - Proof. exact P.max_dec. Defined. + Proof. exact max_dec. Defined. Lemma min_case_strong : forall n m (P:O.t -> Type), (n<=m -> P n) -> (m<=n -> P m) -> P (min n m). - Proof. intros; apply P.min_case_strong; auto. congruence. Defined. + Proof. intros; apply min_case_strong; auto. congruence. Defined. Lemma min_case : forall n m (P:O.t -> Type), P n -> P m -> P (min n m). Proof. intros. apply min_case_strong; auto. Defined. Lemma min_dec : forall n m, {min n m = n} + {min n m = m}. - Proof. exact P.min_dec. Defined. + Proof. exact min_dec. Defined. End UsualMinMaxDecProperties. diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v index 57f491d2..f84cdf32 100644 --- a/theories/Structures/OrderedType.v +++ b/theories/Structures/OrderedType.v @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: OrderedType.v 12732 2010-02-10 22:46:59Z letouzey $ *) - Require Export SetoidList Morphisms OrdersTac. Set Implicit Arguments. Unset Strict Implicit. @@ -22,6 +20,10 @@ Inductive Compare (X : Type) (lt eq : X -> X -> Prop) (x y : X) : Type := | EQ : eq x y -> Compare lt eq x y | GT : lt y x -> Compare lt eq x y. +Arguments LT [X lt eq x y] _. +Arguments EQ [X lt eq x y] _. +Arguments GT [X lt eq x y] _. + Module Type MiniOrderedType. Parameter Inline t : Type. @@ -143,7 +145,7 @@ Module OrderedTypeFacts (Import O: OrderedType). Lemma elim_compare_eq : forall x y : t, - eq x y -> exists H : eq x y, compare x y = EQ _ H. + eq x y -> exists H : eq x y, compare x y = EQ H. Proof. intros; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. @@ -151,7 +153,7 @@ Module OrderedTypeFacts (Import O: OrderedType). Lemma elim_compare_lt : forall x y : t, - lt x y -> exists H : lt x y, compare x y = LT _ H. + lt x y -> exists H : lt x y, compare x y = LT H. Proof. intros; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. @@ -159,7 +161,7 @@ Module OrderedTypeFacts (Import O: OrderedType). Lemma elim_compare_gt : forall x y : t, - lt y x -> exists H : lt y x, compare x y = GT _ H. + lt y x -> exists H : lt y x, compare x y = GT H. Proof. intros; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. @@ -318,16 +320,13 @@ Module KeyOrderedType(O:OrderedType). Hint Immediate eqk_sym eqke_sym. Global Instance eqk_equiv : Equivalence eqk. - Proof. split; eauto. Qed. + Proof. constructor; eauto. Qed. Global Instance eqke_equiv : Equivalence eqke. Proof. split; eauto. Qed. Global Instance ltk_strorder : StrictOrder ltk. - Proof. - split; eauto. - intros (x,e); compute; apply (StrictOrder_Irreflexive x). - Qed. + Proof. constructor; eauto. intros x; apply (irreflexivity (x:=fst x)). Qed. Global Instance ltk_compat : Proper (eqk==>eqk==>iff) ltk. Proof. diff --git a/theories/Structures/OrderedTypeAlt.v b/theories/Structures/OrderedTypeAlt.v index f6c1532b..b054496e 100644 --- a/theories/Structures/OrderedTypeAlt.v +++ b/theories/Structures/OrderedTypeAlt.v @@ -5,8 +5,6 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: OrderedTypeAlt.v 12384 2009-10-13 14:39:51Z letouzey $ *) - Require Import OrderedType. (** * An alternative (but equivalent) presentation for an Ordered Type diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v index 128cd576..adeba9e4 100644 --- a/theories/Structures/OrderedTypeEx.v +++ b/theories/Structures/OrderedTypeEx.v @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: OrderedTypeEx.v 13297 2010-07-19 23:32:42Z letouzey $ *) - Require Import OrderedType. Require Import ZArith. Require Import Omega. @@ -111,26 +109,18 @@ Module Positive_as_OT <: UsualOrderedType. Definition eq_sym := @sym_eq t. Definition eq_trans := @trans_eq t. - Definition lt p q:= (p ?= q) Eq = Lt. + Definition lt := Plt. - Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. - Proof. - unfold lt; intros x y z. - change ((Zpos x < Zpos y)%Z -> (Zpos y < Zpos z)%Z -> (Zpos x < Zpos z)%Z). - omega. - Qed. + Definition lt_trans := Plt_trans. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. - intros; intro. - rewrite H0 in H. - unfold lt in H. - rewrite Pcompare_refl in H; discriminate. + intros x y H. contradict H. rewrite H. apply Plt_irrefl. Qed. Definition compare : forall x y : t, Compare lt eq x y. Proof. - intros x y. destruct ((x ?= y) Eq) as [ | | ]_eqn. + intros x y. destruct (x ?= y) as [ | | ]_eqn. apply EQ; apply Pcompare_Eq_eq; assumption. apply LT; assumption. apply GT; apply ZC1; assumption. @@ -324,10 +314,10 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. Lemma eq_dec (x y: positive): {x = y} + {x <> y}. Proof. - intros. case_eq ((x ?= y) Eq); intros. + intros. case_eq (x ?= y); intros. left. apply Pcompare_Eq_eq; auto. - right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate. - right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate. + right. red. intro. subst y. rewrite (Pos.compare_refl x) in H. discriminate. + right. red. intro. subst y. rewrite (Pos.compare_refl x) in H. discriminate. Qed. End PositiveOrderedTypeBits. diff --git a/theories/Structures/Orders.v b/theories/Structures/Orders.v index 5567b743..1d025439 100644 --- a/theories/Structures/Orders.v +++ b/theories/Structures/Orders.v @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: Orders.v 13276 2010-07-10 14:34:44Z letouzey $ *) - Require Export Relations Morphisms Setoid Equalities. Set Implicit Arguments. Unset Strict Implicit. @@ -67,20 +65,34 @@ Module Type LeIsLtEq (Import E:EqLtLe'). Axiom le_lteq : forall x y, x<=y <-> x<y \/ x==y. End LeIsLtEq. -Module Type HasCompare (Import E:EqLt). +Module Type StrOrder := EqualityType <+ HasLt <+ IsStrOrder. +Module Type StrOrder' := StrOrder <+ EqLtNotation. + +(** Versions with a decidable ternary comparison *) + +Module Type HasCmp (Import T:Typ). Parameter Inline compare : t -> t -> comparison. - Axiom compare_spec : forall x y, CompSpec eq lt x y (compare x y). -End HasCompare. +End HasCmp. + +Module Type CmpNotation (T:Typ)(C:HasCmp T). + Infix "?=" := C.compare (at level 70, no associativity). +End CmpNotation. + +Module Type CmpSpec (Import E:EqLt')(Import C:HasCmp E). + Axiom compare_spec : forall x y, CompareSpec (x==y) (x<y) (y<x) (compare x y). +End CmpSpec. + +Module Type HasCompare (E:EqLt) := HasCmp E <+ CmpSpec E. -Module Type StrOrder := EqualityType <+ HasLt <+ IsStrOrder. Module Type DecStrOrder := StrOrder <+ HasCompare. +Module Type DecStrOrder' := DecStrOrder <+ EqLtNotation <+ CmpNotation. + Module Type OrderedType <: DecidableType := DecStrOrder <+ HasEqDec. -Module Type OrderedTypeFull := OrderedType <+ HasLe <+ LeIsLtEq. +Module Type OrderedType' := OrderedType <+ EqLtNotation <+ CmpNotation. -Module Type StrOrder' := StrOrder <+ EqLtNotation. -Module Type DecStrOrder' := DecStrOrder <+ EqLtNotation. -Module Type OrderedType' := OrderedType <+ EqLtNotation. -Module Type OrderedTypeFull' := OrderedTypeFull <+ EqLtLeNotation. +Module Type OrderedTypeFull := OrderedType <+ HasLe <+ LeIsLtEq. +Module Type OrderedTypeFull' := + OrderedTypeFull <+ EqLtLeNotation <+ CmpNotation. (** NB: in [OrderedType], an [eq_dec] could be deduced from [compare]. But adding this redundant field allows to see an [OrderedType] as a @@ -169,50 +181,63 @@ Module OTF_to_TotalOrder (O:OrderedTypeFull) <: TotalOrder Local Coercion is_true : bool >-> Sortclass. Hint Unfold is_true. -Module Type HasLeBool (Import T:Typ). - Parameter Inline leb : t -> t -> bool. -End HasLeBool. - -Module Type HasLtBool (Import T:Typ). - Parameter Inline ltb : t -> t -> bool. -End HasLtBool. +Module Type HasLeb (Import T:Typ). + Parameter Inline leb : t -> t -> bool. +End HasLeb. -Module Type LeBool := Typ <+ HasLeBool. -Module Type LtBool := Typ <+ HasLtBool. +Module Type HasLtb (Import T:Typ). + Parameter Inline ltb : t -> t -> bool. +End HasLtb. -Module Type LeBoolNotation (E:LeBool). - Infix "<=?" := E.leb (at level 35). -End LeBoolNotation. +Module Type LebNotation (T:Typ)(E:HasLeb T). + Infix "<=?" := E.leb (at level 35). +End LebNotation. -Module Type LtBoolNotation (E:LtBool). - Infix "<?" := E.ltb (at level 35). -End LtBoolNotation. +Module Type LtbNotation (T:Typ)(E:HasLtb T). + Infix "<?" := E.ltb (at level 35). +End LtbNotation. -Module Type LeBool' := LeBool <+ LeBoolNotation. -Module Type LtBool' := LtBool <+ LtBoolNotation. +Module Type LebSpec (T:Typ)(X:HasLe T)(Y:HasLeb T). + Parameter leb_le : forall x y, Y.leb x y = true <-> X.le x y. +End LebSpec. -Module Type LeBool_Le (T:Typ)(X:HasLeBool T)(Y:HasLe T). - Parameter leb_le : forall x y, X.leb x y = true <-> Y.le x y. -End LeBool_Le. +Module Type LtbSpec (T:Typ)(X:HasLt T)(Y:HasLtb T). + Parameter ltb_lt : forall x y, Y.ltb x y = true <-> X.lt x y. +End LtbSpec. -Module Type LtBool_Lt (T:Typ)(X:HasLtBool T)(Y:HasLt T). - Parameter ltb_lt : forall x y, X.ltb x y = true <-> Y.lt x y. -End LtBool_Lt. +Module Type LeBool := Typ <+ HasLeb. +Module Type LtBool := Typ <+ HasLtb. +Module Type LeBool' := LeBool <+ LebNotation. +Module Type LtBool' := LtBool <+ LtbNotation. -Module Type LeBoolIsTotal (Import X:LeBool'). +Module Type LebIsTotal (Import X:LeBool'). Axiom leb_total : forall x y, (x <=? y) = true \/ (y <=? x) = true. -End LeBoolIsTotal. +End LebIsTotal. -Module Type TotalLeBool := LeBool <+ LeBoolIsTotal. -Module Type TotalLeBool' := LeBool' <+ LeBoolIsTotal. +Module Type TotalLeBool := LeBool <+ LebIsTotal. +Module Type TotalLeBool' := LeBool' <+ LebIsTotal. -Module Type LeBoolIsTransitive (Import X:LeBool'). +Module Type LebIsTransitive (Import X:LeBool'). Axiom leb_trans : Transitive X.leb. -End LeBoolIsTransitive. +End LebIsTransitive. + +Module Type TotalTransitiveLeBool := TotalLeBool <+ LebIsTransitive. +Module Type TotalTransitiveLeBool' := TotalLeBool' <+ LebIsTransitive. + +(** Grouping all boolean comparison functions *) + +Module Type HasBoolOrdFuns (T:Typ) := HasEqb T <+ HasLtb T <+ HasLeb T. + +Module Type HasBoolOrdFuns' (T:Typ) := + HasBoolOrdFuns T <+ EqbNotation T <+ LtbNotation T <+ LebNotation T. -Module Type TotalTransitiveLeBool := TotalLeBool <+ LeBoolIsTransitive. -Module Type TotalTransitiveLeBool' := TotalLeBool' <+ LeBoolIsTransitive. +Module Type BoolOrdSpecs (O:EqLtLe)(F:HasBoolOrdFuns O) := + EqbSpec O O F <+ LtbSpec O O F <+ LebSpec O O F. +Module Type OrderFunctions (E:EqLtLe) := + HasCompare E <+ HasBoolOrdFuns E <+ BoolOrdSpecs E. +Module Type OrderFunctions' (E:EqLtLe) := + HasCompare E <+ CmpNotation E <+ HasBoolOrdFuns' E <+ BoolOrdSpecs E. (** * From [OrderedTypeFull] to [TotalTransitiveLeBool] *) diff --git a/theories/Structures/OrdersAlt.v b/theories/Structures/OrdersAlt.v index 21ef8eb8..85e7fb17 100644 --- a/theories/Structures/OrdersAlt.v +++ b/theories/Structures/OrdersAlt.v @@ -11,8 +11,6 @@ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -(* $Id: OrdersAlt.v 12754 2010-02-12 16:21:48Z letouzey $ *) - Require Import OrderedType Orders. Set Implicit Arguments. diff --git a/theories/Structures/OrdersEx.v b/theories/Structures/OrdersEx.v index 9f83d82b..e071d053 100644 --- a/theories/Structures/OrdersEx.v +++ b/theories/Structures/OrdersEx.v @@ -11,20 +11,18 @@ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -(* $Id: OrdersEx.v 12641 2010-01-07 15:32:52Z letouzey $ *) - -Require Import Orders NatOrderedType POrderedType NOrderedType - ZOrderedType RelationPairs EqualitiesFacts. +Require Import Orders NPeano POrderedType NArith + ZArith RelationPairs EqualitiesFacts. (** * Examples of Ordered Type structures. *) (** Ordered Type for [nat], [Positive], [N], [Z] with the usual order. *) -Module Nat_as_OT := NatOrderedType.Nat_as_OT. +Module Nat_as_OT := NPeano.Nat. Module Positive_as_OT := POrderedType.Positive_as_OT. -Module N_as_OT := NOrderedType.N_as_OT. -Module Z_as_OT := ZOrderedType.Z_as_OT. +Module N_as_OT := BinNat.N. +Module Z_as_OT := BinInt.Z. (** An OrderedType can now directly be seen as a DecidableType *) diff --git a/theories/Structures/OrdersFacts.v b/theories/Structures/OrdersFacts.v index a28b7977..2e9c0cf5 100644 --- a/theories/Structures/OrdersFacts.v +++ b/theories/Structures/OrdersFacts.v @@ -6,15 +6,76 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -Require Import Basics OrdersTac. +Require Import Bool Basics OrdersTac. Require Export Orders. Set Implicit Arguments. Unset Strict Implicit. -(** * Properties of [OrderedTypeFull] *) +(** * Properties of [compare] *) -Module OrderedTypeFullFacts (Import O:OrderedTypeFull'). +Module Type CompareFacts (Import O:DecStrOrder'). + + Local Infix "?=" := compare (at level 70, no associativity). + + Lemma compare_eq_iff x y : (x ?= y) = Eq <-> x==y. + Proof. + case compare_spec; intro H; split; try easy; intro EQ; + contradict H; rewrite EQ; apply irreflexivity. + Qed. + + Lemma compare_eq x y : (x ?= y) = Eq -> x==y. + Proof. + apply compare_eq_iff. + Qed. + + Lemma compare_lt_iff x y : (x ?= y) = Lt <-> x<y. + Proof. + case compare_spec; intro H; split; try easy; intro LT; + contradict LT; rewrite H; apply irreflexivity. + Qed. + + Lemma compare_gt_iff x y : (x ?= y) = Gt <-> y<x. + Proof. + case compare_spec; intro H; split; try easy; intro LT; + contradict LT; rewrite H; apply irreflexivity. + Qed. + + Lemma compare_nlt_iff x y : (x ?= y) <> Lt <-> ~(x<y). + Proof. + rewrite compare_lt_iff; intuition. + Qed. + + Lemma compare_ngt_iff x y : (x ?= y) <> Gt <-> ~(y<x). + Proof. + rewrite compare_gt_iff; intuition. + Qed. + + Hint Rewrite compare_eq_iff compare_lt_iff compare_gt_iff : order. + + Instance compare_compat : Proper (eq==>eq==>Logic.eq) compare. + Proof. + intros x x' Hxx' y y' Hyy'. + case (compare_spec x' y'); autorewrite with order; now rewrite Hxx', Hyy'. + Qed. + + Lemma compare_refl x : (x ?= x) = Eq. + Proof. + case compare_spec; intros; trivial; now elim irreflexivity with x. + Qed. + + Lemma compare_antisym x y : (y ?= x) = CompOpp (x ?= y). + Proof. + case (compare_spec x y); simpl; autorewrite with order; + trivial; now symmetry. + Qed. + +End CompareFacts. + + + (** * Properties of [OrderedTypeFull] *) + +Module Type OrderedTypeFullFacts (Import O:OrderedTypeFull'). Module OrderTac := OTF_to_OrderTac O. Ltac order := OrderTac.order. @@ -47,6 +108,18 @@ Module OrderedTypeFullFacts (Import O:OrderedTypeFull'). Lemma eq_is_le_ge : forall x y, x==y <-> x<=y /\ y<=x. Proof. iorder. Qed. + Include CompareFacts O. + + Lemma compare_le_iff x y : compare x y <> Gt <-> x<=y. + Proof. + rewrite le_not_gt_iff. apply compare_ngt_iff. + Qed. + + Lemma compare_ge_iff x y : compare x y <> Lt <-> y<=x. + Proof. + rewrite le_not_gt_iff. apply compare_nlt_iff. + Qed. + End OrderedTypeFullFacts. @@ -84,50 +157,9 @@ Module OrderedTypeFacts (Import O: OrderedType'). Definition lt_irrefl (x:t) : ~x<x := StrictOrder_Irreflexive x. - (** Some more about [compare] *) - - Lemma compare_eq_iff : forall x y, (x ?= y) = Eq <-> x==y. - Proof. - intros; elim_compare x y; intuition; try discriminate; order. - Qed. - - Lemma compare_lt_iff : forall x y, (x ?= y) = Lt <-> x<y. - Proof. - intros; elim_compare x y; intuition; try discriminate; order. - Qed. - - Lemma compare_gt_iff : forall x y, (x ?= y) = Gt <-> y<x. - Proof. - intros; elim_compare x y; intuition; try discriminate; order. - Qed. - - Lemma compare_ge_iff : forall x y, (x ?= y) <> Lt <-> y<=x. - Proof. - intros; rewrite compare_lt_iff; intuition. - Qed. - - Lemma compare_le_iff : forall x y, (x ?= y) <> Gt <-> x<=y. - Proof. - intros; rewrite compare_gt_iff; intuition. - Qed. - - Hint Rewrite compare_eq_iff compare_lt_iff compare_gt_iff : order. - - Instance compare_compat : Proper (eq==>eq==>Logic.eq) compare. - Proof. - intros x x' Hxx' y y' Hyy'. - elim_compare x' y'; autorewrite with order; order. - Qed. - - Lemma compare_refl : forall x, (x ?= x) = Eq. - Proof. - intros; elim_compare x x; auto; order. - Qed. - - Lemma compare_antisym : forall x y, (y ?= x) = CompOpp (x ?= y). - Proof. - intros; elim_compare x y; simpl; autorewrite with order; order. - Qed. + Include CompareFacts O. + Notation compare_le_iff := compare_ngt_iff (only parsing). + Notation compare_ge_iff := compare_nlt_iff (only parsing). (** For compatibility reasons *) Definition eq_dec := eq_dec. @@ -162,10 +194,6 @@ Module OrderedTypeFacts (Import O: OrderedType'). End OrderedTypeFacts. - - - - (** * Tests of the order tactic Is it at least capable of proving some basic properties ? *) @@ -208,7 +236,7 @@ Module OrderedTypeRev (O:OrderedTypeFull) <: OrderedTypeFull. Definition t := O.t. Definition eq := O.eq. -Instance eq_equiv : Equivalence eq. +Program Instance eq_equiv : Equivalence eq. Definition eq_dec := O.eq_dec. Definition lt := flip O.lt. @@ -232,3 +260,195 @@ Qed. End OrderedTypeRev. +Unset Implicit Arguments. + +(** * Order relations derived from a [compare] function. + + We factorize here some common properties for ZArith, NArith + and co, where [lt] and [le] are defined in terms of [compare]. + Note that we do not require anything here concerning compatibility + of [compare] w.r.t [eq], nor anything concerning transitivity. +*) + +Module Type CompareBasedOrder (Import E:EqLtLe')(Import C:HasCmp E). + Include CmpNotation E C. + Include IsEq E. + Axiom compare_eq_iff : forall x y, (x ?= y) = Eq <-> x == y. + Axiom compare_lt_iff : forall x y, (x ?= y) = Lt <-> x < y. + Axiom compare_le_iff : forall x y, (x ?= y) <> Gt <-> x <= y. + Axiom compare_antisym : forall x y, (y ?= x) = CompOpp (x ?= y). +End CompareBasedOrder. + +Module Type CompareBasedOrderFacts + (Import E:EqLtLe') + (Import C:HasCmp E) + (Import O:CompareBasedOrder E C). + + Lemma compare_spec x y : CompareSpec (x==y) (x<y) (y<x) (x?=y). + Proof. + case_eq (compare x y); intros H; constructor. + now apply compare_eq_iff. + now apply compare_lt_iff. + rewrite compare_antisym, CompOpp_iff in H. now apply compare_lt_iff. + Qed. + + Lemma compare_eq x y : (x ?= y) = Eq -> x==y. + Proof. + apply compare_eq_iff. + Qed. + + Lemma compare_refl x : (x ?= x) = Eq. + Proof. + now apply compare_eq_iff. + Qed. + + Lemma compare_gt_iff x y : (x ?= y) = Gt <-> y<x. + Proof. + now rewrite <- compare_lt_iff, compare_antisym, CompOpp_iff. + Qed. + + Lemma compare_ge_iff x y : (x ?= y) <> Lt <-> y<=x. + Proof. + now rewrite <- compare_le_iff, compare_antisym, CompOpp_iff. + Qed. + + Lemma compare_ngt_iff x y : (x ?= y) <> Gt <-> ~(y<x). + Proof. + rewrite compare_gt_iff; intuition. + Qed. + + Lemma compare_nlt_iff x y : (x ?= y) <> Lt <-> ~(x<y). + Proof. + rewrite compare_lt_iff; intuition. + Qed. + + Lemma compare_nle_iff x y : (x ?= y) = Gt <-> ~(x<=y). + Proof. + rewrite <- compare_le_iff. + destruct compare; split; easy || now destruct 1. + Qed. + + Lemma compare_nge_iff x y : (x ?= y) = Lt <-> ~(y<=x). + Proof. + now rewrite <- compare_nle_iff, compare_antisym, CompOpp_iff. + Qed. + + Lemma lt_irrefl x : ~ (x<x). + Proof. + now rewrite <- compare_lt_iff, compare_refl. + Qed. + + Lemma lt_eq_cases n m : n <= m <-> n < m \/ n==m. + Proof. + rewrite <- compare_lt_iff, <- compare_le_iff, <- compare_eq_iff. + destruct (n ?= m); now intuition. + Qed. + +End CompareBasedOrderFacts. + +(** Basic facts about boolean comparisons *) + +Module Type BoolOrderFacts + (Import E:EqLtLe') + (Import C:HasCmp E) + (Import F:HasBoolOrdFuns' E) + (Import O:CompareBasedOrder E C) + (Import S:BoolOrdSpecs E F). + +Include CompareBasedOrderFacts E C O. + +(** Nota : apart from [eqb_compare] below, facts about [eqb] + are in BoolEqualityFacts *) + +(** Alternate specifications based on [BoolSpec] and [reflect] *) + +Lemma leb_spec0 x y : reflect (x<=y) (x<=?y). +Proof. + apply iff_reflect. symmetry. apply leb_le. +Defined. + +Lemma leb_spec x y : BoolSpec (x<=y) (y<x) (x<=?y). +Proof. + case leb_spec0; constructor; trivial. + now rewrite <- compare_lt_iff, compare_nge_iff. +Qed. + +Lemma ltb_spec0 x y : reflect (x<y) (x<?y). +Proof. + apply iff_reflect. symmetry. apply ltb_lt. +Defined. + +Lemma ltb_spec x y : BoolSpec (x<y) (y<=x) (x<?y). +Proof. + case ltb_spec0; constructor; trivial. + now rewrite <- compare_le_iff, compare_ngt_iff. +Qed. + +(** Negated variants of the specifications *) + +Lemma leb_nle x y : x <=? y = false <-> ~ (x <= y). +Proof. +now rewrite <- not_true_iff_false, leb_le. +Qed. + +Lemma leb_gt x y : x <=? y = false <-> y < x. +Proof. +now rewrite leb_nle, <- compare_lt_iff, compare_nge_iff. +Qed. + +Lemma ltb_nlt x y : x <? y = false <-> ~ (x < y). +Proof. +now rewrite <- not_true_iff_false, ltb_lt. +Qed. + +Lemma ltb_ge x y : x <? y = false <-> y <= x. +Proof. +now rewrite ltb_nlt, <- compare_le_iff, compare_ngt_iff. +Qed. + +(** Basic equality laws for boolean tests *) + +Lemma leb_refl x : x <=? x = true. +Proof. +apply leb_le. apply lt_eq_cases. now right. +Qed. + +Lemma leb_antisym x y : y <=? x = negb (x <? y). +Proof. +apply eq_true_iff_eq. now rewrite negb_true_iff, leb_le, ltb_ge. +Qed. + +Lemma ltb_irrefl x : x <? x = false. +Proof. +apply ltb_ge. apply lt_eq_cases. now right. +Qed. + +Lemma ltb_antisym x y : y <? x = negb (x <=? y). +Proof. +apply eq_true_iff_eq. now rewrite negb_true_iff, ltb_lt, leb_gt. +Qed. + +(** Relation bewteen [compare] and the boolean comparisons *) + +Lemma eqb_compare x y : + (x =? y) = match compare x y with Eq => true | _ => false end. +Proof. +apply eq_true_iff_eq. rewrite eqb_eq, <- compare_eq_iff. +destruct compare; now split. +Qed. + +Lemma ltb_compare x y : + (x <? y) = match compare x y with Lt => true | _ => false end. +Proof. +apply eq_true_iff_eq. rewrite ltb_lt, <- compare_lt_iff. +destruct compare; now split. +Qed. + +Lemma leb_compare x y : + (x <=? y) = match compare x y with Gt => false | _ => true end. +Proof. +apply eq_true_iff_eq. rewrite leb_le, <- compare_le_iff. +destruct compare; split; try easy. now destruct 1. +Qed. + +End BoolOrderFacts. diff --git a/theories/Structures/OrdersLists.v b/theories/Structures/OrdersLists.v index 2ed07026..f83b6377 100644 --- a/theories/Structures/OrdersLists.v +++ b/theories/Structures/OrdersLists.v @@ -86,11 +86,11 @@ Module KeyOrderedType(Import O:OrderedType). (* eqk, eqke are equalities, ltk is a strict order *) - Global Instance eqk_equiv : Equivalence eqk. + Global Instance eqk_equiv : Equivalence eqk := _. - Global Instance eqke_equiv : Equivalence eqke. + Global Instance eqke_equiv : Equivalence eqke := _. - Global Instance ltk_strorder : StrictOrder ltk. + Global Instance ltk_strorder : StrictOrder ltk := _. Global Instance ltk_compat : Proper (eqk==>eqk==>iff) ltk. Proof. unfold eqk, ltk; auto with *. Qed. |