Modularization of BinPos + fixes in Stdlib

 BinPos now contain a sub-module Pos, in which are placed functions
 like add (ex-Pplus), mul (ex-Pmult), ... and properties like
 add_comm, add_assoc, ...

 In addition to the name changes, the organisation is changed quite
 a lot, to try to take advantage more of the orders < and <= instead
 of speaking only of the comparison function.

 The main source of incompatibilities in scripts concerns this compare:
 Pos.compare is now a binary operation, expressed in terms of the
 ex-Pcompare which is ternary (expecting an initial comparision as 3rd arg),
 this ternary version being called now Pos.compare_cont. As for everything
 else, compatibility notations (only parsing) are provided. But notations
 "_ ?= _" on positive will have to be edited, since they now point to
 Pos.compare.

 We also make the sub-module Pos to be directly an OrderedType,
 and include results about min and max.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14098 85f007b7-540e-0410-9357-904b9bb8a0f7

6 files changed, 67 insertions, 85 deletions

diff --git a/plugins/setoid_ring/Cring_initial.v b/plugins/setoid_ring/Cring_initial.v
index 4a0beb3fa4..3cd9d4d3e3 100644
--- a/plugins/setoid_ring/Cring_initial.v
+++ b/plugins/setoid_ring/Cring_initial.v
@@ -147,7 +147,7 @@ Ltac rsimpl := simpl;  set_cring_notations.
 
  Lemma gen_phiZ1_add_pos_neg : forall x y,
  gen_phiZ1
-    match (x ?= y)%positive Eq with
+    match (x ?= y)%positive with
     | Eq => Z0
     | Lt => Zneg (y - x)
     | Gt => Zpos (x - y)
@@ -155,12 +155,11 @@ Ltac rsimpl := simpl;  set_cring_notations.
  == gen_phiPOS1 x + -gen_phiPOS1 y.
  Proof.
   intros x y.
-  assert (H:= (Pcompare_Eq_eq x y)); assert (H0 := Pminus_mask_Gt x y).
-  generalize (Pminus_mask_Gt y x).
-  replace Eq with (CompOpp Eq);[intro H1;simpl|trivial].
-  rewrite <- Pcompare_antisym in H1.
-  destruct ((x ?= y)%positive Eq).
-  cring_rewrite H;trivial. cring_rewrite cring_opp_def;gen_reflexivity.
+  assert (H0 := Pminus_mask_Gt x y). unfold Pgt in H0.
+  assert (H1 := Pminus_mask_Gt y x). unfold Pgt in H1.
+  rewrite Pos.compare_antisym in H1.
+  destruct (Pos.compare_spec x y) as [H|H|H].
+  subst. cring_rewrite cring_opp_def;gen_reflexivity.
   destruct H1 as [h [Heq1 [Heq2 Hor]]];trivial.
   unfold Pminus; cring_rewrite Heq1;rewrite <- Heq2.
   cring_rewrite ARgen_phiPOS_add;simpl;norm.
@@ -182,8 +181,7 @@ Ltac rsimpl := simpl;  set_cring_notations.
   induction x;destruct y;simpl;norm.
   apply ARgen_phiPOS_add.
   apply gen_phiZ1_add_pos_neg.
-  replace Eq with (CompOpp Eq);trivial.
-  rewrite <- Pcompare_antisym;simpl.
+  rewrite Pos.compare_antisym;simpl.
   cring_rewrite match_compOpp.
   cring_rewrite cring_add_comm.
   apply gen_phiZ1_add_pos_neg.
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
index d97238343d..29d7ee333c 100644
--- a/plugins/setoid_ring/Field_theory.v
+++ b/plugins/setoid_ring/Field_theory.v
@@ -779,7 +779,7 @@ Fixpoint isIn (e1:PExpr C)  (p1:positive)
 Proof.
   intros l e1 e2 p1 p2; generalize (PExpr_eq_semi_correct l e1 e2);
    case (PExpr_eq e1 e2); simpl; auto; intros H.
-  case_eq ((p1 ?= p2)%positive Eq);intros;simpl.
+  case_eq ((p1 ?= p2)%positive);intros;simpl.
   repeat rewrite pow_th.(rpow_pow_N);simpl. split. 2:refine (refl_equal _).
   rewrite (Pcompare_Eq_eq _ _ H0).
   rewrite H by trivial. ring [ (morph1 CRmorph)].
@@ -791,7 +791,7 @@ Proof.
   repeat rewrite pow_th.(rpow_pow_N);simpl.
   rewrite H;trivial.
    change (ZtoN
-     match (p1 ?= p1 - p2)%positive Eq with
+     match (p1 ?= p1 - p2)%positive with
      | Eq => 0
      | Lt => Zneg (p1 - p2 - p1)
      | Gt => Zpos (p1 - (p1 - p2))
@@ -1805,25 +1805,24 @@ Lemma gen_phiPOS_inj : forall x y,
   x = y.
 intros x y.
 repeat rewrite <- (same_gen Rsth Reqe ARth) in |- *.
-ElimPcompare x y; intro.
+case (Pos.compare_spec x y).
+ intros.
+   trivial.
  intros.
-   apply Pcompare_Eq_eq; trivial.
- intro.
    elim gen_phiPOS_not_0 with (y - x)%positive.
    apply add_inj_r with x.
    symmetry  in |- *.
    rewrite (ARadd_0_r Rsth ARth) in |- *.
    rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
    rewrite Pplus_minus in |- *; trivial.
-   change Eq with (CompOpp Eq) in |- *.
-   rewrite <- Pcompare_antisym in |- *; trivial.
-   rewrite H in |- *; trivial.
- intro.
+   now apply Pos.lt_gt.
+ intros.
    elim gen_phiPOS_not_0 with (x - y)%positive.
    apply add_inj_r with y.
    rewrite (ARadd_0_r Rsth ARth) in |- *.
    rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
    rewrite Pplus_minus in |- *; trivial.
+   now apply Pos.lt_gt.
 Qed.
 
 
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
index cd59b7cb6d..86fada82ac 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -172,7 +172,7 @@ Section ZMORPHISM.
 
  Lemma gen_phiZ1_add_pos_neg : forall x y,
  gen_phiZ1
-    match (x ?= y)%positive Eq with
+    match (x ?= y)%positive with
     | Eq => Z0
     | Lt => Zneg (y - x)
     | Gt => Zpos (x - y)
@@ -180,20 +180,14 @@ Section ZMORPHISM.
  == gen_phiPOS1 x + -gen_phiPOS1 y.
  Proof.
   intros x y.
-  assert (H:= (Pcompare_Eq_eq x y)); assert (H0 := Pminus_mask_Gt x y).
-  generalize (Pminus_mask_Gt y x).
-  replace Eq with (CompOpp Eq);[intro H1;simpl|trivial].
-  rewrite <- Pcompare_antisym in H1.
-  destruct ((x ?= y)%positive Eq).
-  rewrite H;trivial. rewrite (Ropp_def Rth);rrefl.
-  destruct H1 as [h [Heq1 [Heq2 Hor]]];trivial.
-  unfold Pminus; rewrite Heq1;rewrite <- Heq2.
+  case Pos.compare_spec; intros H; simpl.
+  rewrite H. rewrite (Ropp_def Rth);rrefl.
+  rewrite <- (Pos.sub_add y x H) at 2. rewrite Pos.add_comm.
   rewrite (ARgen_phiPOS_add ARth);simpl;norm.
   rewrite (Ropp_def Rth);norm.
-  destruct H0 as [h [Heq1 [Heq2 Hor]]];trivial.
-  unfold Pminus; rewrite Heq1;rewrite <- Heq2.
+  rewrite <- (Pos.sub_add x y H) at 2.
   rewrite (ARgen_phiPOS_add ARth);simpl;norm.
-  add_push (gen_phiPOS1 h);rewrite (Ropp_def Rth); norm.
+  add_push (gen_phiPOS1 (x-y));rewrite (Ropp_def Rth); norm.
  Qed.
 
  Lemma match_compOpp : forall x (B:Type) (be bl bg:B),
@@ -207,8 +201,7 @@ Section ZMORPHISM.
   induction x;destruct y;simpl;norm.
   apply (ARgen_phiPOS_add ARth).
   apply gen_phiZ1_add_pos_neg.
-  replace Eq with (CompOpp Eq);trivial.
-  rewrite <- Pcompare_antisym;simpl.
+  rewrite Pos.compare_antisym.
   rewrite match_compOpp.
   rewrite (Radd_comm Rth).
   apply gen_phiZ1_add_pos_neg.
diff --git a/plugins/setoid_ring/Ring2_initial.v b/plugins/setoid_ring/Ring2_initial.v
index 38a300f714..f94ad9b0f5 100644
--- a/plugins/setoid_ring/Ring2_initial.v
+++ b/plugins/setoid_ring/Ring2_initial.v
@@ -147,7 +147,7 @@ Ltac rsimpl := simpl;  set_ring_notations.
 
  Lemma gen_phiZ1_add_pos_neg : forall x y,
  gen_phiZ1
-    match (x ?= y)%positive Eq with
+    match (x ?= y)%positive with
     | Eq => Z0
     | Lt => Zneg (y - x)
     | Gt => Zpos (x - y)
@@ -155,12 +155,11 @@ Ltac rsimpl := simpl;  set_ring_notations.
  == gen_phiPOS1 x + -gen_phiPOS1 y.
  Proof.
   intros x y.
-  assert (H:= (Pcompare_Eq_eq x y)); assert (H0 := Pminus_mask_Gt x y).
-  generalize (Pminus_mask_Gt y x).
-  replace Eq with (CompOpp Eq);[intro H1;simpl|trivial].
-  rewrite <- Pcompare_antisym in H1.
-  destruct ((x ?= y)%positive Eq).
-  ring_rewrite H;trivial. ring_rewrite ring_opp_def;gen_reflexivity.
+  assert (H0 := Pminus_mask_Gt x y). unfold Pos.gt in H0.
+  assert (H1 := Pminus_mask_Gt y x). unfold Pos.gt in H1.
+  rewrite Pos.compare_antisym in H1.
+  destruct (Pos.compare_spec x y) as [H|H|H].
+  subst. ring_rewrite ring_opp_def;gen_reflexivity.
   destruct H1 as [h [Heq1 [Heq2 Hor]]];trivial.
   unfold Pminus; ring_rewrite Heq1;rewrite <- Heq2.
   ring_rewrite ARgen_phiPOS_add;simpl;norm.
@@ -183,7 +182,7 @@ Ltac rsimpl := simpl;  set_ring_notations.
   apply ARgen_phiPOS_add.
   apply gen_phiZ1_add_pos_neg.
   replace Eq with (CompOpp Eq);trivial.
-  rewrite <- Pcompare_antisym;simpl.
+  rewrite Pos.compare_antisym;simpl.
   ring_rewrite match_compOpp.
   ring_rewrite ring_add_comm.
   apply gen_phiZ1_add_pos_neg.
diff --git a/plugins/setoid_ring/Ring2_polynom.v b/plugins/setoid_ring/Ring2_polynom.v
index 6fa0f200be..fdf5ca5452 100644
--- a/plugins/setoid_ring/Ring2_polynom.v
+++ b/plugins/setoid_ring/Ring2_polynom.v
@@ -65,7 +65,7 @@ Instance equalityb_coef : Equalityb C :=
   match P, P' with
   | Pc c, Pc c' => c =? c'
   | PX P i n Q, PX P' i' n' Q' =>
-    match Pcompare i i' Eq, Pcompare n n' Eq with
+    match Pos.compare i i', Pos.compare n n' with
     | Eq, Eq => if Peq P P' then Peq Q Q' else false
     | _,_ => false
     end
@@ -80,7 +80,7 @@ Instance equalityb_pol : Equalityb Pol :=
   match P with
   | Pc c => if c =? cO then Q else PX P i n Q 
   | PX P' i' n' Q' => 
-       match Pcompare i i' Eq with
+       match Pos.compare i i' with
         | Eq => if Q' =? P0 then PX P' i (n + n') Q else PX P i n Q
         | _ => PX P i n Q
        end
@@ -122,7 +122,7 @@ Fixpoint PaddX (i n:positive)(Q:Pol){struct Q}:=
   match Q with
   | Pc c => mkPX P i n Q
   | PX P' i' n' Q' => 
-      match Pcompare i i' Eq with
+      match Pos.compare i i' with
       | (* i > i' *)
         Gt => mkPX P i n Q
       | (* i < i' *)
@@ -225,20 +225,14 @@ Definition Psub(P P':Pol):= P ++ (--P').
     (P =? P') = true -> forall l, P@l == P'@ l.
  Proof.
   induction P;destruct P';simpl;intros;try discriminate;trivial. apply ring_morphism_eq.
- apply Ceqb_eq ;trivial.
-
-  assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2).
-   simpl in H1. destruct (Peq P2 P'1). simpl in H2; destruct (Peq P3 P'2).
-  ring_rewrite (H1);trivial . ring_rewrite (H2);trivial. 
-assert (H3 := Pcompare_Eq_eq p p1);
- destruct ((p ?= p1)%positive Eq);
-assert (H4 := Pcompare_Eq_eq p0 p2);
-destruct ((p0 ?= p2)%positive Eq); try (discriminate H).
- ring_rewrite H3;trivial. ring_rewrite H4;trivial. rrefl.
- destruct ((p ?= p1)%positive Eq); destruct ((p0 ?= p2)%positive Eq);
- try (discriminate H).
- destruct ((p ?= p1)%positive Eq); destruct ((p0 ?= p2)%positive Eq);
- try (discriminate H). 
+  apply Ceqb_eq ;trivial.
+  destruct (Pos.compare_spec p p1); try discriminate H.
+  destruct (Pos.compare_spec p0 p2); try discriminate H.
+  assert (H1' := IHP1 P'1);assert (H2' := IHP2 P'2).
+  simpl in H1'. destruct (Peq P2 P'1); try discriminate H.
+  simpl in H2'. destruct (Peq P3 P'2); try discriminate H.
+  ring_rewrite (H1');trivial . ring_rewrite (H2');trivial.
+  subst. rrefl.
  Qed.
 
  Lemma Pphi0 : forall l, P0@l == 0.
@@ -262,13 +256,15 @@ destruct ((p0 ?= p2)%positive Eq); try (discriminate H).
   assert (H := ring_morphism_eq  c cO). simpl; case_eq (Ceqb c cO);simpl;try rrefl.
 intros.
   ring_rewrite H. ring_rewrite ring_morphism0.
-  rsimpl. apply Ceqb_eq. trivial. assert (H1 := Pcompare_Eq_eq i p);
-destruct ((i ?= p)%positive Eq).
-  assert (H := @Peq_ok P3 P0). case_eq (P3=? P0). intro. simpl. 
-  ring_rewrite H. 
-  ring_rewrite Pphi0. rsimpl. ring_rewrite Pplus_comm. ring_rewrite pow_pos_Pplus;rsimpl.
-ring_rewrite H1;trivial. rrefl. trivial. intros. simpl. rrefl. simpl. rrefl.
- simpl. rrefl.
+  rsimpl. apply Ceqb_eq. trivial.
+  case Pos.compare_spec; intros; subst.
+  assert (H := @Peq_ok P3 P0). case_eq (P3=? P0). intro. simpl.
+  ring_rewrite H; trivial.
+  ring_rewrite Pphi0. rsimpl. ring_rewrite Pplus_comm.
+  ring_rewrite pow_pos_Pplus;rsimpl; trivial.
+  rrefl.
+  rrefl.
+  rrefl.
  Qed.
 
 Ltac Esimpl :=
@@ -337,7 +333,7 @@ Lemma PaddXPX: forall P i n Q,
   match Q with
   | Pc c => mkPX P i n Q
   | PX P' i' n' Q' => 
-      match Pcompare i i' Eq with
+      match Pos.compare i i' with
       | (* i > i' *)
         Gt => mkPX P i n Q
       | (* i < i' *)
@@ -365,18 +361,16 @@ Lemma PaddX_ok2 : forall P2,
 induction P2;ring_simpl;intros. split. intros. apply PaddCl_ok.
  induction P.  unfold PaddX. intros. ring_rewrite mkPX_ok.
  ring_simpl. rsimpl.
-intros. ring_simpl. assert (H := Pcompare_Eq_eq k p);
- destruct ((k ?= p)%positive Eq).
+intros. ring_simpl.
+ case Pos.compare_spec; intros; subst.
  assert (H1 := ZPminus_spec n p0);destruct (ZPminus n p0). Esimpl2.
-ring_rewrite H; trivial. rewrite H1. rrefl.
+ rewrite H1. rrefl.
 ring_simpl. ring_rewrite mkPX_ok. ring_rewrite IHP1. Esimpl2.
  rewrite Pplus_comm in H1.
 rewrite H1. 
 ring_rewrite pow_pos_Pplus.  Esimpl2.
-rewrite H; trivial. rrefl.
 ring_rewrite mkPX_ok. ring_rewrite PaddCl_ok. Esimpl2. rewrite Pplus_comm in H1.
 rewrite H1.  Esimpl2. ring_rewrite pow_pos_Pplus. Esimpl2.
-rewrite H; trivial. rrefl.
 ring_rewrite mkPX_ok. ring_rewrite IHP2. Esimpl2.
 ring_rewrite (ring_add_comm  (P2 @ l * pow_pos Rr (nth 0 p l) p0) 
                              ([c] * pow_pos Rr (nth 0 k l) n)).
@@ -388,17 +382,16 @@ split. intros. ring_rewrite H0. ring_rewrite H1.
 Esimpl2.
 induction P. unfold PaddX. intros. ring_rewrite mkPX_ok. ring_simpl. rrefl.
 intros. ring_rewrite PaddXPX. 
-assert (H3 := Pcompare_Eq_eq k p1);
- destruct ((k ?= p1)%positive Eq).
+case Pos.compare_spec; intros; subst.
 assert (H4 := ZPminus_spec n p2);destruct (ZPminus n p2). 
 ring_rewrite mkPX_ok. ring_simpl. ring_rewrite H0. ring_rewrite H1. Esimpl2.
-rewrite H4. rewrite H3;trivial. rrefl.
-ring_rewrite mkPX_ok. ring_rewrite IHP1. Esimpl2. rewrite H3;trivial.
+rewrite H4. rrefl.
+ring_rewrite mkPX_ok. ring_rewrite IHP1. Esimpl2.
 rewrite Pplus_comm in H4.
 rewrite H4. ring_rewrite pow_pos_Pplus. Esimpl2.
 ring_rewrite mkPX_ok. ring_simpl. ring_rewrite H0. ring_rewrite H1. 
 ring_rewrite mkPX_ok.
- Esimpl2. rewrite H3;trivial.
+ Esimpl2.
  rewrite Pplus_comm in H4.
 rewrite H4. ring_rewrite pow_pos_Pplus. Esimpl2.
 ring_rewrite mkPX_ok. ring_simpl. ring_rewrite IHP2. Esimpl2.
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index abaa312e15..b722a31b63 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -104,12 +104,12 @@ Section MakeRingPol.
   match P, P' with
   | Pc c, Pc c' => c ?=! c'
   | Pinj j Q, Pinj j' Q' =>
-    match Pcompare j j' Eq with
+    match j ?= j' with
     | Eq => Peq Q Q'
     | _ => false
     end
   | PX P i Q, PX P' i' Q' =>
-    match Pcompare i i' Eq with
+    match i ?= i' with
     | Eq => if Peq P P' then Peq Q Q' else false
     | _ => false
     end
@@ -435,7 +435,7 @@ Section MakeRingPol.
             CFactor P c
    | Pc _, _    => (P, Pc cO)
    | Pinj j1 P1, zmon j2 M1 =>
-      match (j1 ?= j2) Eq with
+      match j1 ?= j2 with
         Eq => let (R,S) := MFactor P1 c M1 in
                  (mkPinj j1 R, mkPinj j1 S)
       | Lt => let (R,S) := MFactor P1 c (zmon (j2 - j1) M1) in
@@ -449,7 +449,7 @@ Section MakeRingPol.
              let (R2, S2) := MFactor Q1 c M2 in
                (mkPX R1 i R2, mkPX S1 i S2)
   | PX P1 i Q1, vmon j M1 =>
-      match (i ?= j) Eq with
+      match i ?= j with
         Eq => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in
                  (mkPX R1 i Q1, S1)
       | Lt => let (R1,S1) := MFactor P1 c (vmon (j - i) M1) in
@@ -552,10 +552,10 @@ Section MakeRingPol.
  Proof.
   induction P;destruct P';simpl;intros;try discriminate;trivial.
   apply (morph_eq CRmorph);trivial.
-  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
+  assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
    try discriminate H.
   rewrite (IHP P' H); rewrite H1;trivial;rrefl.
-  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
+  assert (H1 := Pos.compare_eq p p0); destruct (p ?= p0);
    try discriminate H.
   rewrite H1;trivial. clear H1.
   assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2);
@@ -947,8 +947,8 @@ Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
    generalize (Mcphi_ok P c (jump i l)); case CFactor.
    intros R1 Q1 HH; rewrite HH; Esimpl.
      intros j M.
-     case_eq ((i ?= j) Eq); intros He; simpl.
-       rewrite (Pcompare_Eq_eq _ _ He).
+     case_eq (i ?= j); intros He; simpl.
+       rewrite (Pos.compare_eq _ _ He).
        generalize (Hrec (c, M) (jump j l)); case (MFactor P c M);
         simpl; intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
        generalize (Hrec (c, (zmon (j -i) M)) (jump i l));
@@ -987,8 +987,8 @@ Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
      rewrite (ARadd_comm ARth); rsimpl.
      rewrite zmon_pred_ok;rsimpl.
    intros j M1.
-     case_eq ((i ?= j) Eq); intros He; simpl.
-       rewrite (Pcompare_Eq_eq _ _ He).
+     case_eq (i ?= j); intros He; simpl.
+       rewrite (Pos.compare_eq _ _ He).
        generalize (Hrec1 (c, mkZmon xH M1) l); case (MFactor P2 c (mkZmon xH M1));
         simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
        rewrite H; rewrite mkPX_ok; rsimpl.