From 345c0ee557465d7d2f22ac34898388dfbb57cd0f Mon Sep 17 00:00:00 2001
From: letouzey
Date: Thu, 7 Jan 2010 15:32:22 +0000
Subject: OrderTac: use TotalOrder, no more "change" before calling "order"
 (stuff with Inline)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12636 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 theories/Arith/NatOrderedType.v         |   7 +-
 theories/NArith/NOrderedType.v          |   7 +-
 theories/NArith/POrderedType.v          |   7 +-
 theories/QArith/QOrderedType.v          |   3 +-
 theories/Reals/ROrderedType.v           |   6 +-
 theories/Structures/OrderTac.v          | 174 ++++++++++++++++++++++----------
 theories/Structures/OrderedType.v       |  12 +--
 theories/Structures/OrderedType2Facts.v |  64 +++---------
 theories/ZArith/ZOrderedType.v          |   6 +-
 9 files changed, 148 insertions(+), 138 deletions(-)

diff --git a/theories/Arith/NatOrderedType.v b/theories/Arith/NatOrderedType.v
index 287d0c9559..d9b2b30f04 100644
--- a/theories/Arith/NatOrderedType.v
+++ b/theories/Arith/NatOrderedType.v
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 Require Import Lt Peano_dec Compare_dec EqNat
- DecidableType2 OrderedType2 OrderedType2Facts.
+ DecidableType2 OrderedType2 OrderTac.
 
 
 (** * DecidableType structure for Peano numbers *)
@@ -53,10 +53,7 @@ End Nat_as_OT.
 (** * An [order] tactic for Peano numbers *)
 
 Module NatOrder := OTF_to_OrderTac Nat_as_OT.
-Ltac nat_order :=
- change (@eq nat) with NatOrder.OrderElts.eq in *;
- NatOrder.order.
+Ltac nat_order := NatOrder.order.
 
 (** Note that [nat_order] is domain-agnostic: it will not prove
     [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-
diff --git a/theories/NArith/NOrderedType.v b/theories/NArith/NOrderedType.v
index 08391d33f7..06db5fa1ce 100644
--- a/theories/NArith/NOrderedType.v
+++ b/theories/NArith/NOrderedType.v
@@ -6,8 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Import BinNat
- DecidableType2 OrderedType2 OrderedType2Facts.
+Require Import BinNat DecidableType2 OrderedType2 OrderTac.
 
 Local Open Scope N_scope.
 
@@ -54,9 +53,7 @@ End N_as_OT.
 (** * An [order] tactic for [N] numbers *)
 
 Module NOrder := OTF_to_OrderTac N_as_OT.
-Ltac n_order :=
- change (@eq N) with NOrder.OrderElts.eq in *;
- NOrder.order.
+Ltac n_order := NOrder.order.
 
 (** Note that [n_order] is domain-agnostic: it will not prove
     [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
diff --git a/theories/NArith/POrderedType.v b/theories/NArith/POrderedType.v
index 85667e29ae..041a3a01be 100644
--- a/theories/NArith/POrderedType.v
+++ b/theories/NArith/POrderedType.v
@@ -6,8 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Import BinPos
- DecidableType2 OrderedType2 OrderedType2Facts.
+Require Import BinPos DecidableType2 OrderedType2 OrderTac.
 
 Local Open Scope positive_scope.
 
@@ -55,9 +54,7 @@ End Positive_as_OT.
 (** * An [order] tactic for positive numbers *)
 
 Module PositiveOrder := OTF_to_OrderTac Positive_as_OT.
-Ltac p_order :=
- change (@eq positive) with PositiveOrder.OrderElts.eq in *;
- PositiveOrder.order.
+Ltac p_order := PositiveOrder.order.
 
 (** Note that [p_order] is domain-agnostic: it will not prove
     [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v
index c49ded7403..74770d6e11 100644
--- a/theories/QArith/QOrderedType.v
+++ b/theories/QArith/QOrderedType.v
@@ -6,8 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Import QArith_base
- DecidableType2 OrderedType2 OrderedType2Facts.
+Require Import QArith_base DecidableType2 OrderedType2 OrderTac.
 
 Local Open Scope Q_scope.
 
diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v
index 4ef8d7bcc6..ea20db99fb 100644
--- a/theories/Reals/ROrderedType.v
+++ b/theories/Reals/ROrderedType.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Import Rbase DecidableType2 OrderedType2 OrderedType2Facts.
+Require Import Rbase DecidableType2 OrderedType2 OrderTac.
 
 Local Open Scope R_scope.
 
@@ -88,9 +88,7 @@ End R_as_OT.
 (** * An [order] tactic for real numbers *)
 
 Module ROrder := OTF_to_OrderTac R_as_OT.
-Ltac r_order :=
- change (@eq R) with ROrder.OrderElts.eq in *;
- ROrder.order.
+Ltac r_order := ROrder.order.
 
 (** Note that [r_order] is domain-agnostic: it will not prove
     [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
diff --git a/theories/Structures/OrderTac.v b/theories/Structures/OrderTac.v
index f75e1ae913..43df377c08 100644
--- a/theories/Structures/OrderTac.v
+++ b/theories/Structures/OrderTac.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-Require Import Setoid Morphisms.
+Require Import Setoid Morphisms Basics DecidableType2 OrderedType2.
 Set Implicit Arguments.
 
 (** * The order tactic *)
@@ -23,25 +23,6 @@ Set Implicit Arguments.
     The tactic will fail if it doesn't solve the goal. *)
 
 
-(** ** The requirements of the tactic : an equivalence [eq],
-   a strict order [lt] total and compatible with [eq], and
-   a larger order [le] synonym of [lt\/eq]. *)
-
-Module Type OrderSig.
-
-Parameter Inline t : Type.
-Parameters eq lt le : t -> t -> Prop.
-Declare Instance eq_equiv : Equivalence eq.
-Declare Instance lt_strorder : StrictOrder lt.
-Declare Instance lt_compat : Proper (eq==>eq==>iff) lt.
-Parameter lt_total : forall x y, lt x y \/ eq x y \/ lt y x.
-Parameter le_lteq : forall x y, le x y <-> lt x y \/ eq x y.
-
-End OrderSig.
-
-(** NB : we should _not_ use "Inline" for these predicates,
-   otherwise the ltac matching will not work properly later. *)
-
 (** An abstract vision of the predicates. This allows a one-line
     statement for interesting transitivity properties: for instance
     [trans_ord OLE OLE = OLE] will imply later
@@ -56,19 +37,46 @@ Definition trans_ord o o' :=
  | OLE, OLE => OLE
  | _, _ => OLT
  end.
-Infix "+" := trans_ord : order.
+Local Infix "+" := trans_ord.
 
-(** ** [MakeOrderTac] : The functor providing the order tactic. *)
 
-Module MakeOrderTac(Import O:OrderSig).
+(** ** The requirements of the tactic : [TotalOrder].
 
-Local Open Scope order.
+   [TotalOrder] contains an equivalence [eq],
+   a strict order [lt] total and compatible with [eq], and
+   a larger order [le] synonym for [lt\/eq].
 
-Infix "==" := eq (at level 70, no associativity) : order.
-Infix "<" := lt : order.
-Infix "<=" := le : order.
+  NB: we create here a clone of TotalOrder, but without the [Inline] Pragma.
+  This is important for having later the exact shape in Ltac matching.
+*)
 
-(** ** Properties that will be used by the tactic *)
+Module Type TotalOrder_NoInline <: TotalOrder.
+ Parameter Inline t : Type.
+ Parameters eq lt le : t -> t -> Prop.
+ Include Type IsEq <+ IsStrOrder <+ LeIsLtEq <+ LtIsTotal.
+End TotalOrder_NoInline.
+
+Module Type TotalOrder_NoInline' := TotalOrder_NoInline <+ EqLtLeNotation.
+
+(** We make explicit aliases to help ltac matching *)
+
+Module CloneOrder (O:TotalOrder_NoInline) <: TotalOrder.
+Definition t := O.t.
+Definition eq := O.eq.
+Definition lt := O.lt.
+Definition le := O.le.
+Definition eq_equiv := O.eq_equiv.
+Definition lt_compat := O.lt_compat.
+Definition lt_strorder := O.lt_strorder.
+Definition le_lteq := O.le_lteq.
+Definition lt_total := O.lt_total.
+End CloneOrder.
+
+
+
+(** ** Properties that will be used by the [order] tactic *)
+
+Module OrderFacts(Import O:TotalOrder_NoInline').
 
 (** Reflexivity rules *)
 
@@ -104,8 +112,8 @@ Ltac subst_eqns :=
  end.
 
 Definition interp_ord o :=
- match o with OEQ => eq | OLT => lt | OLE => le end.
-Notation "#" := interp_ord : order.
+ match o with OEQ => O.eq | OLT => O.lt | OLE => O.le end.
+Local Notation "#" := interp_ord.
 
 Lemma trans : forall o o' x y z, #o x y -> #o' y z -> #(o+o') x z.
 Proof.
@@ -113,15 +121,15 @@ destruct o, o'; simpl; intros x y z; rewrite ?le_lteq; intuition;
  subst_eqns; eauto using (StrictOrder_Transitive x y z) with *.
 Qed.
 
-Definition eq_trans x y z : x==y -> y==z -> x==z := trans OEQ OEQ x y z.
-Definition le_trans x y z : x<=y -> y<=z -> x<=z := trans OLE OLE x y z.
-Definition lt_trans x y z : x<y -> y<z -> x<z := trans OLT OLT x y z.
-Definition le_lt_trans x y z : x<=y -> y<z -> x<z := trans OLE OLT x y z.
-Definition lt_le_trans x y z : x<y -> y<=z -> x<z := trans OLT OLE x y z.
-Definition eq_lt x y z : x==y -> y<z -> x<z := trans OEQ OLT x y z.
-Definition lt_eq x y z : x<y -> y==z -> x<z := trans OLT OEQ x y z.
-Definition eq_le x y z : x==y -> y<=z -> x<=z := trans OEQ OLE x y z.
-Definition le_eq x y z : x<=y -> y==z -> x<=z := trans OLE OEQ x y z.
+Definition eq_trans x y z : x==y -> y==z -> x==z := @trans OEQ OEQ x y z.
+Definition le_trans x y z : x<=y -> y<=z -> x<=z := @trans OLE OLE x y z.
+Definition lt_trans x y z : x<y -> y<z -> x<z := @trans OLT OLT x y z.
+Definition le_lt_trans x y z : x<=y -> y<z -> x<z := @trans OLE OLT x y z.
+Definition lt_le_trans x y z : x<y -> y<=z -> x<z := @trans OLT OLE x y z.
+Definition eq_lt x y z : x==y -> y<z -> x<z := @trans OEQ OLT x y z.
+Definition lt_eq x y z : x<y -> y==z -> x<z := @trans OLT OEQ x y z.
+Definition eq_le x y z : x==y -> y<=z -> x<=z := @trans OEQ OLE x y z.
+Definition le_eq x y z : x<=y -> y==z -> x<=z := @trans OLE OEQ x y z.
 
 Lemma eq_neq : forall x y z, x==y -> ~y==z -> ~x==z.
 Proof. eauto using eq_trans, eq_sym. Qed.
@@ -151,8 +159,15 @@ Qed.
 Lemma le_neq_lt : forall x y, x<=y -> ~x==y -> x<y.
 Proof. auto using not_ge_lt, le_antisym. Qed.
 
+End OrderFacts.
+
 
-(** ** The tactic itself *)
+
+(** ** [MakeOrderTac] : The functor providing the order tactic. *)
+
+Module MakeOrderTac (Import O:TotalOrder_NoInline').
+
+Include OrderFacts O.
 
 (** order_eq : replace x by y in all (in)equations hyps thanks
    to equality EQ (where eq has been hidden in order to avoid
@@ -177,7 +192,7 @@ end.
 Ltac order_eq x y eqn :=
  match x with
  | y => clear eqn
- | _ => change (#OEQ x y) in eqn; order_rewr x eqn
+ | _ => change (interp_ord OEQ x y) in eqn; order_rewr x eqn
  end.
 
 (** Goal preparation : We turn all negative hyps into positive ones
@@ -190,18 +205,31 @@ Ltac order_eq x y eqn :=
 Ltac order_prepare :=
  match goal with
  | H : ?A -> False |- _ => change (~A) in H; order_prepare
- | H : ~ _ < _ |- _ => apply not_gt_le in H; order_prepare
- | H : ~ _ <= _ |- _ => apply not_ge_lt in H; order_prepare
- | |- ~ _ => intro
- (* Two special cases. This handling is optional but gives nicer proofs. *)
- | |- ?x == ?x => exact (eq_refl x)
- | |- ?x <= ?x => exact (le_refl x)
- | |- ?x < ?x => exfalso
- (* Any cool stuff left in the goal becomes an hyp via double neg. *)
- | |- _ == _ => apply not_neq_eq; intro
- | |- _ < _ => apply not_ge_lt; intro
- | |- _ <= _ => apply not_gt_le; intro
- | _ => exfalso
+ | H : ~(?R ?x ?y) |- _ =>
+   match R with
+   | eq => fail 1 (* if already using [eq], we leave it this ways *)
+   | _ => (change (~x==y) in H ||
+           apply not_gt_le in H ||
+           apply not_ge_lt in H ||
+           clear H || fail 1); order_prepare
+   end
+ | H : ?R ?x ?y |- _ =>
+   match R with
+   | eq => fail 1
+   | lt => fail 1
+   | le => fail 1
+   | _ => (change (x==y) in H ||
+           change (x<y) in H ||
+           change (x<=y) in H ||
+           clear H || fail 1); order_prepare
+   end
+ | |- ~ _ => intro; order_prepare
+ | |- _ ?x ?x =>
+   exact (eq_refl x) || exact (le_refl x) || exfalso
+ | _ =>
+   (apply not_neq_eq; intro) ||
+   (apply not_ge_lt; intro) ||
+   (apply not_gt_le; intro) || exfalso
  end.
 
 (** We now try to prove False from the various [< <= == !=] hypothesis *)
@@ -254,4 +282,42 @@ Ltac order :=
 
 End MakeOrderTac.
 
-(** For example of use of this tactic, see for instance [OrderedType] *)
\ No newline at end of file
+Module OTF_to_OrderTac (OTF:OrderedTypeFull).
+ Module TO := OTF_to_TotalOrder OTF.
+ Module TO' := CloneOrder TO.
+ Include MakeOrderTac TO'.
+End OTF_to_OrderTac.
+
+Module OT_to_OrderTac (OT:OrderedType).
+ Module OTF := OT_to_Full OT.
+ Include OTF_to_OrderTac OTF.
+End OT_to_OrderTac.
+
+(** For example of use of this tactic, see for instance [OrderedType] *)
+
+
+Module TotalOrderRev (O:TotalOrder) <: TotalOrder.
+
+Definition t := O.t.
+Definition eq := O.eq.
+Definition lt := flip O.lt.
+Definition le := flip O.le.
+Include Type EqLtLeNotation.
+
+Instance eq_equiv : Equivalence eq.
+
+Instance lt_strorder: StrictOrder lt.
+Proof. unfold lt; auto with *. Qed.
+Instance lt_compat : Proper (eq==>eq==>iff) lt.
+Proof. unfold lt; auto with *. Qed.
+
+Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y.
+Proof. intros; unfold le, lt, flip. rewrite O.le_lteq; intuition. Qed.
+
+Lemma lt_total : forall x y, x<y \/ x==y \/ y<x.
+Proof.
+ intros x y; unfold lt, eq, flip.
+ generalize (O.lt_total x y); intuition.
+Qed.
+
+End TotalOrderRev.
diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v
index f0d4163c3a..ca441fc867 100644
--- a/theories/Structures/OrderedType.v
+++ b/theories/Structures/OrderedType.v
@@ -103,11 +103,7 @@ Module OrderedTypeFacts (Import O: OrderedType).
   Lemma lt_total : forall x y, lt x y \/ eq x y \/ lt y x.
   Proof. intros; destruct (compare x y); auto. Qed.
 
-  Module OrderElts : OrderSig
-    with Definition t := t
-    with Definition eq := eq
-    with Definition lt := lt.
-  (* Opaque signature is crucial for ltac to work correctly later *)
+  Module OrderElts <: OrderedType2.TotalOrder.
   Definition t := t.
   Definition eq := eq.
   Definition lt := lt.
@@ -121,11 +117,7 @@ Module OrderedTypeFacts (Import O: OrderedType).
   Proof. unfold le; intuition. Qed.
   End OrderElts.
   Module OrderTac := MakeOrderTac OrderElts.
-
-  Ltac order :=
-    change eq with OrderElts.eq in *;
-    change lt with OrderElts.lt in *;
-    OrderTac.order.
+  Ltac order := OrderTac.order.
 
   Lemma le_eq x y z : ~lt x y -> eq y z -> ~lt x z. Proof. order. Qed.
   Lemma eq_le x y z : eq x y -> ~lt y z -> ~lt x z. Proof. order. Qed.
diff --git a/theories/Structures/OrderedType2Facts.v b/theories/Structures/OrderedType2Facts.v
index 9d964d7129..b5dc0c92fc 100644
--- a/theories/Structures/OrderedType2Facts.v
+++ b/theories/Structures/OrderedType2Facts.v
@@ -9,47 +9,15 @@
 Require Import Basics OrderTac.
 Require Export OrderedType2.
 
-
 Set Implicit Arguments.
 Unset Strict Implicit.
 
+(** * Properties of [OrderedTypeFull] *)
 
-(** * Properties of ordered types *)
-
-(** First, an OrderdType (with [<=]) is enough for building an [order]
-    tactic. *)
-
-Module OTF_to_OrderSig (O : OrderedTypeFull) :
- OrderSig with Definition t := O.t
-          with Definition eq := O.eq
-          with Definition lt := O.lt
-          with Definition le := O.le
-          with Definition eq_equiv := O.eq_equiv
-          with Definition lt_strorder := O.lt_strorder
-          with Definition lt_compat := O.lt_compat.
- Include O.
- Lemma lt_total : forall x y, O.lt x y \/ O.eq x y \/ O.lt y x.
- Proof. intros; destruct (O.compare_spec x y); auto. Qed.
-End OTF_to_OrderSig.
-
-
-Module OTF_to_OrderTac (O:OrderedTypeFull).
- Module OrderElts := OTF_to_OrderSig O.
- Module OrderTac := MakeOrderTac OrderElts.
- Ltac order :=
-   change O.eq with OrderElts.eq in *;
-   change O.lt with OrderElts.lt in *;
-   change O.le with OrderElts.le in *;
-   OrderTac.order.
-End OTF_to_OrderTac.
+Module OrderedTypeFullFacts (Import O:OrderedTypeFull').
 
-
-(** This allows to prove a few properties of [<=] *)
-
-Module OrderedTypeFullFacts (Import O:OrderedTypeFull).
-
- Module Order := OTF_to_OrderTac O.
- Ltac order := Order.order.
+ Module OrderTac := OTF_to_OrderTac O.
+ Ltac order := OrderTac.order.
  Ltac iorder := intuition order.
 
  Instance le_compat : Proper (eq==>eq==>iff) le.
@@ -64,33 +32,31 @@ Module OrderedTypeFullFacts (Import O:OrderedTypeFull).
  Instance le_antisym : Antisymmetric _ eq le.
  Proof. apply partial_order_antisym; auto with *. Qed.
 
- Lemma le_not_gt_iff : forall x y, le x y <-> ~lt y x.
+ Lemma le_not_gt_iff : forall x y, x<=y <-> ~y<x.
  Proof. iorder. Qed.
 
- Lemma lt_not_ge_iff : forall x y, lt x y <-> ~le y x.
+ Lemma lt_not_ge_iff : forall x y, x<y <-> ~y<=x.
  Proof. iorder. Qed.
 
- Lemma le_or_gt : forall x y, le x y \/ lt y x.
+ Lemma le_or_gt : forall x y, x<=y \/ y<x.
  Proof. intros. rewrite le_lteq; destruct (O.compare_spec x y); auto. Qed.
 
- Lemma lt_or_ge : forall x y, lt x y \/ le y x.
+ Lemma lt_or_ge : forall x y, x<y \/ y<=x.
  Proof. intros. rewrite le_lteq; destruct (O.compare_spec x y); iorder. Qed.
 
- Lemma eq_is_le_ge : forall x y, eq x y <-> le x y /\ le y x.
+ Lemma eq_is_le_ge : forall x y, x==y <-> x<=y /\ y<=x.
  Proof. iorder. Qed.
 
 End OrderedTypeFullFacts.
 
 
-(** * Properties of OrderedType *)
+(** * Properties of [OrderedType] *)
+
+Module OrderedTypeFacts (Import O: OrderedType').
 
-Module OrderedTypeFacts (Import O: OrderedType).
-  Module O' := OT_to_Full O.
-  Module Order := OTF_to_OrderTac O'.
-  Ltac order := Order.order.
+  Module OrderTac := OT_to_OrderTac O.
+  Ltac order := OrderTac.order.
 
-  Infix "==" := eq (at level 70, no associativity) : order.
-  Infix "<" := lt : order.
   Notation "x <= y" := (~lt y x) : order.
   Infix "?=" := compare (at level 70, no associativity) : order.
 
@@ -204,7 +170,7 @@ End OrderedTypeFacts.
 
     Is it at least capable of proving some basic properties ? *)
 
-Module OrderedTypeTest (O:OrderedType).
+Module OrderedTypeTest (Import O:OrderedType').
   Module Import MO := OrderedTypeFacts O.
   Local Open Scope order.
   Lemma lt_not_eq x y : x<y -> ~x==y.  Proof. order. Qed.
diff --git a/theories/ZArith/ZOrderedType.v b/theories/ZArith/ZOrderedType.v
index c717284fd4..f249ae1b42 100644
--- a/theories/ZArith/ZOrderedType.v
+++ b/theories/ZArith/ZOrderedType.v
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 Require Import BinInt Zcompare Zorder Zbool ZArith_dec
- DecidableType2 OrderedType2 OrderedType2Facts.
+ DecidableType2 OrderedType2 OrderTac.
 
 Local Open Scope Z_scope.
 
@@ -53,9 +53,7 @@ End Z_as_OT.
 (** * An [order] tactic for integers *)
 
 Module ZOrder := OTF_to_OrderTac Z_as_OT.
-Ltac z_order :=
- change (@eq Z) with ZOrder.OrderElts.eq in *;
- ZOrder.order.
+Ltac z_order := ZOrder.order.
 
 (** Note that [z_order] is domain-agnostic: it will not prove
     [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-- 
cgit v1.2.3