Tentative to fix bug #2628 by not letting intuition break records. Might be too much of a backwards-incompatible change

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

7 files changed, 30 insertions, 15 deletions

diff --git a/tactics/tauto.ml4 b/tactics/tauto.ml4
index b7a58be45..fe5103cea 100644
--- a/tactics/tauto.ml4
+++ b/tactics/tauto.ml4
@@ -100,7 +100,7 @@ let iter_tac tacl =
 
 let is_conj ist =
   let ind = assoc_var "X1" ist in
-    if (not binary_mode || is_binary ind) (* && not (is_record ind) *)
+    if (not binary_mode || is_binary ind) && not (is_record ind)
       && is_conjunction ~strict:strict_in_hyp_and_ccl ind
     then
       <:tactic<idtac>>
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index d9e9fe257..87316cda9 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -115,6 +115,12 @@ Section Respecting.
 
   Next Obligation.
   Proof.
+    unfold respecting in *. program_simpl. transitivity (y y0); auto. symmetry; apply H. reflexivity.
+  Qed.
+
+
+  Next Obligation.
+  Proof.
     unfold respecting in *. program_simpl. transitivity (y y0); auto. apply H0. reflexivity.
   Qed.
 
@@ -122,10 +128,13 @@ End Respecting.
 
 (** The default equivalence on function spaces, with higher-priority than [eq]. *)
 
+Hint Extern 0 => reflexivity : relations.
+Hint Extern 1 => solve [symmetry; auto] : relations.
+
 Program Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) :
   Equivalence (pointwise_relation A eqB) | 9.
 
   Next Obligation.
   Proof.
-    transitivity (y a) ; auto.
+    transitivity (y a); auto with relations.
   Qed.
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index 8e491b1b8..30d82822a 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.v
@@ -146,6 +146,13 @@ Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R').
   Next Obligation.
   Proof with auto.
     assert(R x0 x0).
+    transitivity y0... symmetry... 
+    symmetry... apply H1. now symmetry.
+  Qed.
+
+  Next Obligation.
+  Proof with auto.
+    assert(R x0 x0).
     transitivity y0... symmetry...
     transitivity (y x0)...
   Qed.
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index 0c1448c9b..db24a417f 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -18,12 +18,13 @@ Require Export FMapInterface.
 Set Implicit Arguments.
 Unset Strict Implicit.
 
-Hint Extern 1 (Equivalence _) => constructor; congruence.
-
 (** * Facts about weak maps *)
 
 Module WFacts_fun (E:DecidableType)(Import M:WSfun E).
 
+Module UEq := Equalities.UpdateEq(E)(E).
+Import UEq.
+
 Notation eq_dec := E.eq_dec.
 Definition eqb x y := if eq_dec x y then true else false.
 
@@ -1184,7 +1185,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
     Equal m m' -> cardinal m = cardinal m'.
   Proof.
   intros; do 2 rewrite cardinal_fold.
-  apply fold_Equal with (eqA:=eq); compute; auto.
+  apply fold_Equal with (eqA:=eq); compute; auto. apply _.
   Qed.
 
   Lemma cardinal_1 : forall m : t elt, Empty m -> cardinal m = 0.
@@ -1197,7 +1198,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Proof.
   intros; do 2 rewrite cardinal_fold.
   change S with ((fun _ _ => S) x e).
-  apply fold_Add with (eqA:=eq); compute; auto.
+  apply fold_Add with (eqA:=eq); compute; auto. apply _.
   Qed.
 
   Lemma cardinal_inv_1 : forall m : t elt,
@@ -1544,7 +1545,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   setoid_replace (fold f m 0) with (fold f m1 (fold f m2 0)).
   rewrite <- cardinal_fold.
   apply fold_rel with (R:=fun u v => u = v + cardinal m2); simpl; auto.
-  apply Partition_fold with (eqA:=eq); repeat red; auto.
+  apply Partition_fold with (eqA:=eq); repeat red; auto. apply _.
   Qed.
 
   Lemma Partition_partition : forall m m1 m2, Partition m m1 m2 ->
@@ -1694,7 +1695,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
  Proof.
   intros m1 m1' Hm1 m2 m2' Hm2.
   setoid_replace (update m1 m2) with (update m1' m2); unfold update.
-  apply fold_Equal with (eqA:=Equal); auto.
+  apply fold_Equal with (eqA:=Equal); auto. apply _.
   intros k k' Hk e e' He m m' Hm; rewrite Hk,He,Hm; red; auto.
   intros k k' e e' i Hneq x.
   rewrite !add_o; do 2 destruct eq_dec; auto. elim Hneq; eauto.
@@ -1712,7 +1713,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
    intros k e i i' H Hii' x.
    pattern (mem k m2); rewrite Hm2. (* UGLY, see with Matthieu *)
    destruct mem; rewrite Hii'; auto.
-  apply fold_Equal with (eqA:=Equal); auto.
+  apply fold_Equal with (eqA:=Equal); auto. apply _.
    intros k k' Hk e e' He m m' Hm; simpl in *.
    pattern (mem k m2); rewrite Hk. (* idem *)
    destruct mem; rewrite ?Hk,?He,Hm; red; auto.
@@ -1731,7 +1732,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
    intros k e i i' H Hii' x.
    pattern (mem k m2); rewrite Hm2. (* idem *)
    destruct mem; simpl; rewrite Hii'; auto.
-  apply fold_Equal with (eqA:=Equal); auto.
+  apply fold_Equal with (eqA:=Equal); auto. apply _.
    intros k k' Hk e e' He m m' Hm; simpl in *.
    pattern (mem k m2); rewrite Hk. (* idem *)
    destruct mem; simpl; rewrite ?Hk,?He,Hm; red; auto.
diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v
index 755bc7dd0..3a2de94b5 100644
--- a/theories/FSets/FSetEqProperties.v
+++ b/theories/FSets/FSetEqProperties.v
@@ -920,8 +920,6 @@ Lemma sum_compat :
   forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s.
 intros.
 unfold sum; apply (fold_compat _ (@Logic.eq nat)); auto with *.
-intros x x' Hx y y' Hy. rewrite Hx, Hy; auto.
-intros x x' Hx y y' Hy. rewrite Hx, Hy; auto.
 Qed.
 
 End Sum.
diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v
index f84cdf32c..beb10a833 100644
--- a/theories/Structures/OrderedType.v
+++ b/theories/Structures/OrderedType.v
@@ -223,7 +223,7 @@ Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l.
 Proof. exact (InfA_ltA lt_strorder). Qed.
 
 Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l.
-Proof. exact (InfA_eqA eq_equiv lt_strorder lt_compat). Qed.
+Proof. exact (InfA_eqA eq_equiv lt_compat). Qed.
 
 Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x.
 Proof. exact (SortA_InfA_InA eq_equiv lt_strorder lt_compat). Qed.
@@ -396,7 +396,7 @@ Module KeyOrderedType(O:OrderedType).
   Qed.
 
   Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
-  Proof. exact (InfA_eqA eqk_equiv ltk_strorder ltk_compat). Qed.
+  Proof. exact (InfA_eqA eqk_equiv ltk_compat). Qed.
 
   Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
   Proof. exact (InfA_ltA ltk_strorder). Qed.
diff --git a/theories/Structures/OrdersLists.v b/theories/Structures/OrdersLists.v
index f83b63779..059992f5b 100644
--- a/theories/Structures/OrdersLists.v
+++ b/theories/Structures/OrdersLists.v
@@ -32,7 +32,7 @@ Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l.
 Proof. exact (InfA_ltA lt_strorder). Qed.
 
 Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l.
-Proof. exact (InfA_eqA eq_equiv lt_strorder lt_compat). Qed.
+Proof. exact (InfA_eqA eq_equiv lt_compat). Qed.
 
 Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x.
 Proof. exact (SortA_InfA_InA eq_equiv lt_strorder lt_compat). Qed.