Debug implementation of dependent induction/dependent destruction and document it.

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

3 files changed, 72 insertions, 31 deletions

diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v
index c570aa9836..46a1b5cf25 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -30,9 +30,7 @@ Ltac on_JMeq tac :=
 (** Try to apply [JMeq_eq] to get back a regular equality when the two types are equal. *)
 
 Ltac simpl_one_JMeq :=
-  on_JMeq 
-  ltac:(fun H => let H' := fresh "H" in 
-    assert (H' := JMeq_eq H) ; clear H ; rename H' into H).
+  on_JMeq ltac:(fun H => replace_hyp H (JMeq_eq H)).
 
 (** Repeat it for every possible hypothesis. *)
 
@@ -176,10 +174,21 @@ Ltac simplify_eqs :=
 (** A tactic that tries to remove trivial equality guards in induction hypotheses coming
    from [dependent induction]/[generalize_eqs] invocations. *)
 
+
 Ltac simpl_IH_eq H :=
   match type of H with
-    | JMeq _ _ -> _ =>
-      refine_hyp (H (JMeq_refl _))
+    | @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H (JMeq_refl x))
+    | _ -> @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H _ (JMeq_refl x))
+    | _ -> _ -> @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H _ _ (JMeq_refl x))
+    | _ -> _ -> _ -> @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H _ _ _ (JMeq_refl x))
+    | _ -> _ -> _ -> _ -> @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H _ _ _ _ (JMeq_refl x))
+    | _ -> _ -> _ -> _ -> _ -> @JMeq _ ?x _ _ -> _ =>
+      refine_hyp (H _ _ _ _ _ (JMeq_refl x))
     | ?x = _ -> _ =>
       refine_hyp (H (refl_equal x))
     | _ -> ?x = _ -> _ =>
@@ -198,22 +207,49 @@ Ltac simpl_IH_eqs H := repeat simpl_IH_eq H.
 
 Ltac do_simpl_IHs_eqs := 
   match goal with
-    | [ H : context [ JMeq _ _ -> _ ] |- _ ] => progress (simpl_IH_eqs H)
+    | [ H : context [ @JMeq _ _ _ _ -> _ ] |- _ ] => progress (simpl_IH_eqs H)
     | [ H : context [ _ = _ -> _ ] |- _ ] => progress (simpl_IH_eqs H)
   end.
 
 Ltac simpl_IHs_eqs := repeat do_simpl_IHs_eqs.
 
+Ltac simpl_depind := subst* ; autoinjections ; try discriminates ; simpl_JMeq ; simpl_IHs_eqs.
+
 (** The following tactics allow to do induction on an already instantiated inductive predicate
    by first generalizing it and adding the proper equalities to the context, in a maner similar to 
    the BasicElim tactic of "Elimination with a motive" by Conor McBride. *)
 
+(** First a tactic to prepare for a dependent induction on an hypothesis [H]. *)
+
+Ltac prepare_depind H :=
+  let oldH := fresh "old" H in
+    generalize_eqs H ; rename H into oldH ; (intros until H || intros until 1) ; 
+      generalize dependent oldH ;
+        try (intros _ _) (* If the goal is not dependent on the hyp, we can prove a stronger statement *).
+
+(** The [do_depind] higher-order tactic takes an induction tactic as argument and an hypothesis 
+   and starts a dependent induction using this tactic. *)
+
+Ltac do_depind tac H :=
+  prepare_depind H ; tac H ; simpl_depind.
+
+(** Calls [destruct] on the generalized hypothesis, results should be similar to inversion. *)
+
+Tactic Notation "dependent" "destruction" ident(H) := 
+  do_depind ltac:(fun H => destruct H ; intros) H ; subst*.
+
+(** Then we have wrappers for usual calls to induction. One can customize the induction tactic by 
+   writting another wrapper calling do_depind. *)
+
 Tactic Notation "dependent" "induction" ident(H) := 
-  generalize_eqs H ; clear H ; (intros until 1 || intros until H) ; 
-    induction H ; intros ; subst* ; try discriminates ; simpl_IHs_eqs.
+  do_depind ltac:(fun H => induction H ; intros) H.
 
 (** This tactic also generalizes the goal by the given variables before the induction. *)
 
 Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := 
-  generalize_eqs H ; clear H ; (intros until 1 || intros until H) ; 
-    generalize l ; clear l ; induction H ; intros ; subst* ; try discriminates ; simpl_IHs_eqs.
+  do_depind ltac:(fun H => generalize l ; clear l ; induction H ; intros) H.
+
+(** This tactic also generalizes the goal by the given variables before the induction. *)
+
+Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := 
+  do_depind ltac:(fun H => generalize l ; clear l ; induction H using c ; intros) H.
diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v
index 54d830c899..c414dc9cd6 100644
--- a/theories/Program/Subset.v
+++ b/theories/Program/Subset.v
@@ -65,22 +65,6 @@ Ltac pi_subset_proof := on_subset_proof pi_subset_proof_hyp.
 
 Ltac pi_subset_proofs := repeat pi_subset_proof.
 
-(** Clear duplicated hypotheses *)
-
-Ltac clear_dup :=
-  match goal with 
-    | [ H : ?X |- _ ] => 
-      match goal with
-        | [ H' : X |- _ ] =>
-          match H' with
-            | H => fail 2 
-            | _ => clear H' || clear H
-          end
-      end
-  end.
-
-Ltac clear_dups := repeat clear_dup.
-
 (** The two preceding tactics in sequence. *)
 
 Ltac clear_subset_proofs :=
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index bb06f37b5a..df2393ace2 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -69,6 +69,22 @@ Ltac revert_last :=
 
 Ltac reverse := repeat revert_last.
 
+(** Clear duplicated hypotheses *)
+
+Ltac clear_dup :=
+  match goal with 
+    | [ H : ?X |- _ ] => 
+      match goal with
+        | [ H' : X |- _ ] =>
+          match H' with
+            | H => fail 2 
+            | _ => clear H' || clear H
+          end
+      end
+  end.
+
+Ltac clear_dups := repeat clear_dup.
+
 (** A non-failing subst that substitutes as much as possible. *)
 
 Tactic Notation "subst" "*" :=
@@ -122,7 +138,7 @@ Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) := destruc
 (** Try to inject any potential constructor equality hypothesis. *)
 
 Ltac autoinjection :=
-  let tac H := inversion H ; subst ; clear H in
+  let tac H := progress (inversion H ; subst ; clear_dups) ; clear H in
     match goal with
       | [ H : ?f ?a = ?f' ?a' |- _ ] => tac H
       | [ H : ?f ?a ?b = ?f' ?a' ?b'  |- _ ] => tac H
@@ -169,11 +185,16 @@ Ltac add_hypothesis H' p :=
 
 Tactic Notation "pose" constr(c) "as" ident(H) := assert(H:=c).
 
+(** A tactic to replace an hypothesis by another term. *)
+
+Ltac replace_hyp H c :=
+  let H' := fresh "H" in
+    assert(H' := c) ; clear H ; rename H' into H.
+
 (** A tactic to refine an hypothesis by supplying some of its arguments. *)
 
 Ltac refine_hyp c :=
-  let H' := fresh "H" in
-  let tac H := assert(H' := c) ; clear H ; rename H' into H in
+  let tac H := replace_hyp H c in
     match c with
       | ?H _ => tac H
       | ?H _ _ => tac H
@@ -190,8 +211,8 @@ Ltac refine_hyp c :=
    possibly using [program_simplify] to use standard goal-cleaning tactics. *)
 
 Ltac program_simplify :=
-  simpl ; intros ; destruct_conjs ; simpl proj1_sig in * ; subst* ; try autoinjection ; try discriminates ;
-    try (solve [ red ; intros ; destruct_conjs ; try autoinjection ; discriminates ]).
+  simpl ; intros ; destruct_conjs ; simpl proj1_sig in * ; subst* ; autoinjections ; try discriminates ;
+    try (solve [ red ; intros ; destruct_conjs ; autoinjections ; discriminates ]).
 
 Ltac program_simpl := program_simplify ; auto with *.