Delete trailing whitespaces in all *.{v,ml*} files

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

47 files changed, 2426 insertions, 2426 deletions

diff --git a/tactics/auto.ml b/tactics/auto.ml
index 547ad2a772..8b68fa09b2 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -47,15 +47,15 @@ open Mod_subst
 (*            The Type of Constructions Autotactic Hints                    *)
 (****************************************************************************)
 
-type auto_tactic = 
+type auto_tactic =
   | Res_pf     of constr * clausenv (* Hint Apply *)
   | ERes_pf    of constr * clausenv (* Hint EApply *)
-  | Give_exact of constr                  
+  | Give_exact of constr
   | Res_pf_THEN_trivial_fail of constr * clausenv (* Hint Immediate *)
   | Unfold_nth of evaluable_global_reference       (* Hint Unfold *)
-  | Extern     of glob_tactic_expr       (* Hint Extern *) 
+  | Extern     of glob_tactic_expr       (* Hint Extern *)
 
-type pri_auto_tactic = { 
+type pri_auto_tactic = {
   pri  : int;            (* A number between 0 and 4, 4 = lower priority *)
   pat  : constr_pattern option; (* A pattern for the concl of the Goal *)
   code : auto_tactic     (* the tactic to apply when the concl matches pat *)
@@ -65,15 +65,15 @@ type hint_entry = global_reference option * pri_auto_tactic
 
 let pri_order {pri=pri1} {pri=pri2} = pri1 <= pri2
 
-let insert v l = 
+let insert v l =
   let rec insrec = function
     | [] -> [v]
     | h::tl -> if pri_order v h then v::h::tl else h::(insrec tl)
-  in 
+  in
   insrec l
 
 (* Nov 98 -- Papageno *)
-(* Les Hints sont ré-organisés en plusieurs databases. 
+(* Les Hints sont ré-organisés en plusieurs databases.
 
   La table impérative "searchtable", de type "hint_db_table",
    associe une database (hint_db) à chaque nom.
@@ -101,15 +101,15 @@ let add_tac pat t st (l,l',dn) =
 let rebuild_dn st (l,l',dn) =
   (l, l', List.fold_left (fun dn t -> Btermdn.add (Some st) dn (Option.get t.pat, t))
     (Btermdn.create ()) l')
-    
+
 let lookup_tacs (hdc,c) st (l,l',dn) =
   let l'  = List.map snd (Btermdn.lookup st dn c) in
   let sl' = Sort.list pri_order l' in
     Sort.merge pri_order l sl'
 
-module Constr_map = Map.Make(struct 
+module Constr_map = Map.Make(struct
 			       type t = global_reference
-			       let compare = Pervasives.compare 
+			       let compare = Pervasives.compare
 			     end)
 
 let is_transparent_gr (ids, csts) = function
@@ -119,7 +119,7 @@ let is_transparent_gr (ids, csts) = function
 
 module Hint_db = struct
 
-  type t = { 
+  type t = {
     hintdb_state : Names.transparent_state;
     use_dn : bool;
     hintdb_map : search_entry Constr_map.t;
@@ -132,14 +132,14 @@ module Hint_db = struct
 			  use_dn = use_dn;
 			  hintdb_map = Constr_map.empty;
 			  hintdb_nopat = [] }
-    
+
   let find key db =
     try Constr_map.find key db.hintdb_map
     with Not_found -> empty_se
-      
-  let map_none db = 
+
+  let map_none db =
     Sort.merge pri_order (List.map snd db.hintdb_nopat) []
-      
+
   let map_all k db =
     let (l,l',_) = find k db in
       Sort.merge pri_order (List.map snd db.hintdb_nopat @ l) l'
@@ -148,12 +148,12 @@ module Hint_db = struct
     let st = if db.use_dn then Some db.hintdb_state else None in
     let l' = lookup_tacs (k,c) st (find k db) in
       Sort.merge pri_order (List.map snd db.hintdb_nopat) l'
-	
-  let is_exact = function 
+
+  let is_exact = function
     | Give_exact _ -> true
     | _ -> false
 
-  let addkv gr v db = 
+  let addkv gr v db =
     let k = match gr with
       | Some gr -> if db.use_dn && is_transparent_gr db.hintdb_state gr then None else Some gr
       | None -> None
@@ -170,12 +170,12 @@ module Hint_db = struct
 	    { db with hintdb_map = Constr_map.add gr (add_tac pat v dnst oval) db.hintdb_map }
 
   let rebuild_db st' db =
-    let db' = 
+    let db' =
       { db with hintdb_map = Constr_map.map (rebuild_dn st') db.hintdb_map;
 	hintdb_state = st'; hintdb_nopat = [] }
-    in 
+    in
       List.fold_left (fun db (gr,v) -> addkv gr v db) db' db.hintdb_nopat
-	
+
   let add_one (k,v) db =
     let st',rebuild =
       match v.code with
@@ -188,38 +188,38 @@ module Hint_db = struct
     in
     let db = if db.use_dn && rebuild then rebuild_db st' db else db
     in addkv k v db
-	
+
   let add_list l db = List.fold_right add_one l db
-    
-  let iter f db = 
+
+  let iter f db =
     f None (List.map snd db.hintdb_nopat);
     Constr_map.iter (fun k (l,l',_) -> f (Some k) (l@l')) db.hintdb_map
-    
+
   let transparent_state db = db.hintdb_state
 
   let set_transparent_state db st =
-    if db.use_dn then rebuild_db st db 
+    if db.use_dn then rebuild_db st db
     else { db with hintdb_state = st }
 
   let use_dn db = db.use_dn
-	
+
 end
 
 module Hintdbmap = Gmap
 
 type hint_db = Hint_db.t
 
-type frozen_hint_db_table = (string,hint_db) Hintdbmap.t 
+type frozen_hint_db_table = (string,hint_db) Hintdbmap.t
 
 type hint_db_table = (string,hint_db) Hintdbmap.t ref
 
 type hint_db_name = string
 
 let searchtable = (ref Hintdbmap.empty : hint_db_table)
-  
-let searchtable_map name = 
+
+let searchtable_map name =
   Hintdbmap.find name !searchtable
-let searchtable_add (name,db) = 
+let searchtable_add (name,db) =
   searchtable := Hintdbmap.add name db !searchtable
 let current_db_names () =
   Hintdbmap.dom !searchtable
@@ -229,7 +229,7 @@ let current_db_names () =
 (**************************************************************************)
 
 let auto_init : (unit -> unit) ref = ref (fun () -> ())
-  
+
 let init     () = searchtable := Hintdbmap.empty; !auto_init ()
 let freeze   () = !searchtable
 let unfreeze fs = searchtable := fs
@@ -239,29 +239,29 @@ let _ = Summary.declare_summary "search"
 	    Summary.unfreeze_function = unfreeze;
 	    Summary.init_function     = init }
 
- 
+
 (**************************************************************************)
 (*             Auxiliary functions to prepare AUTOHINT objects            *)
 (**************************************************************************)
 
 let rec nb_hyp c = match kind_of_term c with
   | Prod(_,_,c2) -> if noccurn 1 c2 then 1+(nb_hyp c2) else nb_hyp c2
-  | _ -> 0 
+  | _ -> 0
 
 (* adding and removing tactics in the search table *)
 
-let try_head_pattern c = 
+let try_head_pattern c =
   try head_pattern_bound c
   with BoundPattern -> error "Bound head variable."
 
-let dummy_goal = 
+let dummy_goal =
   {it = make_evar empty_named_context_val mkProp;
    sigma = empty}
 
 let make_exact_entry pri (c,cty) =
   let cty = strip_outer_cast cty in
   match kind_of_term cty with
-    | Prod (_,_,_) -> 
+    | Prod (_,_,_) ->
 	failwith "make_exact_entry"
     | _ ->
         let ce = mk_clenv_from dummy_goal (c,cty) in
@@ -280,7 +280,7 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri (c,cty) =
         let hd = (try head_pattern_bound pat
           with BoundPattern -> failwith "make_apply_entry") in
         let nmiss = List.length (clenv_missing ce) in
-	if nmiss = 0 then 
+	if nmiss = 0 then
 	  (Some hd,
           { pri = (match pri with None -> nb_hyp cty | Some p -> p);
             pat = Some pat;
@@ -296,31 +296,31 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri (c,cty) =
               code = ERes_pf(c,{ce with env=empty_env}) })
         end
     | _ -> failwith "make_apply_entry"
- 
-(* flags is (e,h,v) with e=true if eapply and h=true if hnf and v=true if verbose 
+
+(* flags is (e,h,v) with e=true if eapply and h=true if hnf and v=true if verbose
    c is a constr
    cty is the type of constr *)
 
 let make_resolves env sigma flags pri c =
   let cty = type_of env sigma c in
-  let ents = 
-    map_succeed 
-      (fun f -> f (c,cty)) 
+  let ents =
+    map_succeed
+      (fun f -> f (c,cty))
       [make_exact_entry pri; make_apply_entry env sigma flags pri]
-  in 
+  in
   if ents = [] then
-    errorlabstrm "Hint" 
-      (pr_lconstr c ++ spc() ++ 
+    errorlabstrm "Hint"
+      (pr_lconstr c ++ spc() ++
         (if pi1 flags then str"cannot be used as a hint."
 	else str "can be used as a hint only for eauto."));
   ents
 
 (* used to add an hypothesis to the local hint database *)
-let make_resolve_hyp env sigma (hname,_,htyp) = 
+let make_resolve_hyp env sigma (hname,_,htyp) =
   try
     [make_apply_entry env sigma (true, true, false) None
        (mkVar hname, htyp)]
-  with 
+  with
     | Failure _ -> []
     | e when Logic.catchable_exception e -> anomaly "make_resolve_hyp"
 
@@ -331,8 +331,8 @@ let make_unfold eref =
      pat = None;
      code = Unfold_nth eref })
 
-let make_extern pri pat tacast = 
-  let hdconstr = Option.map try_head_pattern pat in 
+let make_extern pri pat tacast =
+  let hdconstr = Option.map try_head_pattern pat in
   (hdconstr,
    { pri=pri;
      pat = pat;
@@ -354,44 +354,44 @@ open Vernacexpr
 
 (* If the database does not exist, it is created *)
 (* TODO: should a warning be printed in this case ?? *)
-let add_hint dbname hintlist = 
-  try 
+let add_hint dbname hintlist =
+  try
     let db = searchtable_map dbname in
     let db' = Hint_db.add_list hintlist db in
     searchtable_add (dbname,db')
-  with Not_found -> 
+  with Not_found ->
     let db = Hint_db.add_list hintlist (Hint_db.empty empty_transparent_state false) in
     searchtable_add (dbname,db)
 
 let add_transparency dbname grs b =
   let db = searchtable_map dbname in
   let st = Hint_db.transparent_state db in
-  let st' = 
-    List.fold_left (fun (ids, csts) gr -> 
+  let st' =
+    List.fold_left (fun (ids, csts) gr ->
       match gr with
       | EvalConstRef c -> (ids, (if b then Cpred.add else Cpred.remove) c csts)
       | EvalVarRef v -> (if b then Idpred.add else Idpred.remove) v ids, csts)
       st grs
   in searchtable_add (dbname, Hint_db.set_transparent_state db st')
-    
+
 type hint_action = | CreateDB of bool * transparent_state
 		   | AddTransparency of evaluable_global_reference list * bool
 		   | AddTactic of (global_reference option * pri_auto_tactic) list
 
-let cache_autohint (_,(local,name,hints)) = 
+let cache_autohint (_,(local,name,hints)) =
   match hints with
   | CreateDB (b, st) -> searchtable_add (name, Hint_db.empty st b)
   | AddTransparency (grs, b) -> add_transparency name grs b
   | AddTactic hints -> add_hint name hints
 
-let forward_subst_tactic = 
+let forward_subst_tactic =
   ref (fun _ -> failwith "subst_tactic is not installed for auto")
 
 let set_extern_subst_tactic f = forward_subst_tactic := f
 
-let subst_autohint (_,subst,(local,name,hintlist as obj)) = 
+let subst_autohint (_,subst,(local,name,hintlist as obj)) =
   let trans_clenv clenv = Clenv.subst_clenv subst clenv in
-  let trans_data data code = 	      
+  let trans_data data code =
     { data with
 	pat = Option.smartmap (subst_pattern subst) data.pat ;
 	code = code ;
@@ -399,7 +399,7 @@ let subst_autohint (_,subst,(local,name,hintlist as obj)) =
   in
   let subst_key gr =
     let (lab'', elab') = subst_global subst gr in
-    let gr' = 
+    let gr' =
       (try head_of_constr_reference (fst (head_constr_bound elab'))
        with Tactics.Bound -> lab'')
     in if gr' == gr then gr else gr'
@@ -424,7 +424,7 @@ let subst_autohint (_,subst,(local,name,hintlist as obj)) =
 	    if c==c' then data else
 	      let code' = Res_pf_THEN_trivial_fail (c', trans_clenv clenv) in
 		trans_data data code'
-      | Unfold_nth ref -> 
+      | Unfold_nth ref ->
           let ref' = subst_evaluable_reference subst ref in
            if ref==ref' then data else
 	    trans_data data (Unfold_nth ref')
@@ -438,14 +438,14 @@ let subst_autohint (_,subst,(local,name,hintlist as obj)) =
   in
     match hintlist with
     | CreateDB _ -> obj
-    | AddTransparency (grs, b) -> 
+    | AddTransparency (grs, b) ->
 	let grs' = list_smartmap (subst_evaluable_reference subst) grs in
 	  if grs==grs' then obj else (local, name, AddTransparency (grs', b))
     | AddTactic hintlist ->
 	let hintlist' = list_smartmap subst_hint hintlist in
 	  if hintlist' == hintlist then obj else
 	    (local,name,AddTactic hintlist')
-	      
+
 let classify_autohint ((local,name,hintlist) as obj) =
   if local or hintlist = (AddTactic []) then Dispose else Substitute obj
 
@@ -461,9 +461,9 @@ let (inAutoHint,_) =
                     export_function = export_autohint }
 
 
-let create_hint_db l n st b = 
+let create_hint_db l n st b =
   Lib.add_anonymous_leaf (inAutoHint (l,n,CreateDB (b, st)))
-      
+
 (**************************************************************************)
 (*                     The "Hint" vernacular command                      *)
 (**************************************************************************)
@@ -479,14 +479,14 @@ let add_resolves env sigma clist local dbnames =
 
 
 let add_unfolds l local dbnames =
-  List.iter 
-    (fun dbname -> Lib.add_anonymous_leaf 
+  List.iter
+    (fun dbname -> Lib.add_anonymous_leaf
        (inAutoHint (local,dbname, AddTactic (List.map make_unfold l))))
     dbnames
 
 let add_transparency l b local dbnames =
-  List.iter 
-    (fun dbname -> Lib.add_anonymous_leaf 
+  List.iter
+    (fun dbname -> Lib.add_anonymous_leaf
        (inAutoHint (local,dbname, AddTransparency (l, b))))
     dbnames
 
@@ -498,16 +498,16 @@ let add_extern pri pat tacast local dbname =
     | Some (patmetas,pat) ->
 	(match (list_subtract tacmetas patmetas) with
 	| i::_ ->
-	    errorlabstrm "add_extern" 
+	    errorlabstrm "add_extern"
 	      (str "The meta-variable ?" ++ pr_patvar i ++ str" is not bound.")
 	| []  ->
 	    Lib.add_anonymous_leaf
 	      (inAutoHint(local,dbname, AddTactic [make_extern pri (Some pat) tacast])))
-    | None -> 
+    | None ->
 	Lib.add_anonymous_leaf
 	  (inAutoHint(local,dbname, AddTactic [make_extern pri None tacast]))
 
-let add_externs pri pat tacast local dbnames = 
+let add_externs pri pat tacast local dbnames =
   List.iter (add_extern pri pat tacast local) dbnames
 
 let add_trivials env sigma l local dbnames =
@@ -517,7 +517,7 @@ let add_trivials env sigma l local dbnames =
 	 inAutoHint(local,dbname, AddTactic (List.map (make_trivial env sigma) l))))
     dbnames
 
-let forward_intern_tac = 
+let forward_intern_tac =
   ref (fun _ -> failwith "intern_tac is not installed for auto")
 
 let set_extern_intern_tac f = forward_intern_tac := f
@@ -527,9 +527,9 @@ type hints_entry =
   | HintsImmediateEntry of constr list
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsExternEntry of 
+  | HintsExternEntry of
       int * (patvar list * constr_pattern) option * glob_tactic_expr
-  | HintsDestructEntry of identifier * int * (bool,unit) location * 
+  | HintsDestructEntry of identifier * int * (bool,unit) location *
       (patvar list * constr_pattern) * glob_tactic_expr
 
 let interp_hints h =
@@ -585,10 +585,10 @@ let pr_autotactic =
   | Res_pf (c,clenv) -> (str"apply " ++ pr_lconstr c)
   | ERes_pf (c,clenv) -> (str"eapply " ++ pr_lconstr c)
   | Give_exact c -> (str"exact " ++ pr_lconstr c)
-  | Res_pf_THEN_trivial_fail (c,clenv) -> 
+  | Res_pf_THEN_trivial_fail (c,clenv) ->
       (str"apply " ++ pr_lconstr c ++ str" ; trivial")
   | Unfold_nth c -> (str"unfold " ++  pr_evaluable_reference c)
-  | Extern tac -> 
+  | Extern tac ->
       (str "(external) " ++ Pptactic.pr_glob_tactic (Global.env()) tac)
 
 let pr_hint v =
@@ -603,17 +603,17 @@ let pr_hints_db (name,db,hintlist) =
      else (fnl () ++ pr_hint_list hintlist))
 
 (* Print all hints associated to head c in any database *)
-let pr_hint_list_for_head c = 
+let pr_hint_list_for_head c =
   let dbs = Hintdbmap.to_list !searchtable in
-  let valid_dbs = 
-    map_succeed 
-      (fun (name,db) -> (name,db,Hint_db.map_all c db)) 
-      dbs 
+  let valid_dbs =
+    map_succeed
+      (fun (name,db) -> (name,db,Hint_db.map_all c db))
+      dbs
   in
-  if valid_dbs = [] then 
+  if valid_dbs = [] then
     (str "No hint declared for :" ++ pr_global c)
-  else 
-    hov 0 
+  else
+    hov 0
       (str"For " ++ pr_global c ++ str" -> " ++ fnl () ++
 	 hov 0 (prlist pr_hints_db valid_dbs))
 
@@ -622,11 +622,11 @@ let pr_hint_ref ref = pr_hint_list_for_head ref
 (* Print all hints associated to head id in any database *)
 let print_hint_ref ref =  ppnl(pr_hint_ref ref)
 
-let pr_hint_term cl = 
-  try 
+let pr_hint_term cl =
+  try
     let dbs = Hintdbmap.to_list !searchtable in
-    let valid_dbs = 
-      let fn = try 
+    let valid_dbs =
+      let fn = try
 	  let (hdc,args) = head_constr_bound cl in
 	  let hd = head_of_constr_reference hdc in
 	    if occur_existential cl then
@@ -636,50 +636,50 @@ let pr_hint_term cl =
       in
 	map_succeed (fun (name, db) -> (name, db, fn db)) dbs
     in
-      if valid_dbs = [] then 
+      if valid_dbs = [] then
 	(str "No hint applicable for current goal")
       else
 	(str "Applicable Hints :" ++ fnl () ++
 	    hov 0 (prlist pr_hints_db valid_dbs))
-  with Match_failure _ | Failure _ -> 
+  with Match_failure _ | Failure _ ->
     (str "No hint applicable for current goal")
 
 let error_no_such_hint_database x =
   error ("No such Hint database: "^x^".")
-	  
+
 let print_hint_term cl = ppnl (pr_hint_term cl)
 
 (* print all hints that apply to the concl of the current goal *)
-let print_applicable_hint () = 
-  let pts = get_pftreestate () in 
-  let gl = nth_goal_of_pftreestate 1 pts in 
+let print_applicable_hint () =
+  let pts = get_pftreestate () in
+  let gl = nth_goal_of_pftreestate 1 pts in
   print_hint_term (pf_concl gl)
-    
+
 (* displays the whole hint database db *)
 let print_hint_db db =
   let (ids, csts) = Hint_db.transparent_state db in
   msg (hov 0
 	  (str"Unfoldable variable definitions: " ++ pr_idpred ids ++ fnl () ++
 	   str"Unfoldable constant definitions: " ++ pr_cpred csts ++ fnl ()));
-  Hint_db.iter 
+  Hint_db.iter
     (fun head hintlist ->
       match head with
       | Some head ->
-	  msg (hov 0 
+	  msg (hov 0
 		  (str "For " ++ pr_global head ++ str " -> " ++
 		      pr_hint_list hintlist))
       | None ->
-	  msg (hov 0 
+	  msg (hov 0
 		  (str "For any goal -> " ++
 		      pr_hint_list hintlist)))
     db
 
 let print_hint_db_by_name dbname =
-  try 
+  try
     let db = searchtable_map dbname in print_hint_db db
-  with Not_found -> 
+  with Not_found ->
     error_no_such_hint_database dbname
-  
+
 (* displays all the hints of all databases *)
 let print_searchtable () =
   Hintdbmap.iter
@@ -704,7 +704,7 @@ let priority l = List.filter (fun (_,hint) -> hint.pri = 0) l
 open Unification
 
 let auto_unif_flags = {
-  modulo_conv_on_closed_terms = Some full_transparent_state; 
+  modulo_conv_on_closed_terms = Some full_transparent_state;
   use_metas_eagerly = false;
   modulo_delta = empty_transparent_state;
   resolve_evars = true;
@@ -713,14 +713,14 @@ let auto_unif_flags = {
 
 (* Try unification with the precompiled clause, then use registered Apply *)
 
-let unify_resolve_nodelta (c,clenv) gl = 
+let unify_resolve_nodelta (c,clenv) gl =
   let clenv' = connect_clenv gl clenv in
-  let _ = clenv_unique_resolver false ~flags:auto_unif_flags clenv' gl in  
+  let _ = clenv_unique_resolver false ~flags:auto_unif_flags clenv' gl in
   h_simplest_apply c gl
 
-let unify_resolve flags (c,clenv) gl = 
+let unify_resolve flags (c,clenv) gl =
   let clenv' = connect_clenv gl clenv in
-  let _ = clenv_unique_resolver false ~flags clenv' gl in  
+  let _ = clenv_unique_resolver false ~flags clenv' gl in
   h_apply true false [dummy_loc,(inj_open c,NoBindings)] gl
 
 let unify_resolve_gen = function
@@ -742,7 +742,7 @@ let expand_constructor_hints lems =
 
 let add_hint_lemmas eapply lems hint_db gl =
   let lems = expand_constructor_hints lems in
-  let hintlist' = 
+  let hintlist' =
     list_map_append (pf_apply make_resolves gl (eapply,true,false) None) lems in
   Hint_db.add_list hintlist' hint_db
 
@@ -757,21 +757,21 @@ let make_local_hint_db eapply lems gl =
    terme pour l'affichage ? (HH) *)
 
 (* Si on enlève le dernier argument (gl) conclPattern est calculé une
-fois pour toutes : en particulier si Pattern.somatch produit une UserError 
+fois pour toutes : en particulier si Pattern.somatch produit une UserError
 Ce qui fait que si la conclusion ne matche pas le pattern, Auto échoue, même
 si après Intros la conclusion matche le pattern.
 *)
 
 (* conclPattern doit échouer avec error car il est rattraper par tclFIRST *)
 
-let forward_interp_tactic = 
+let forward_interp_tactic =
   ref (fun _ -> failwith "interp_tactic is not installed for auto")
 
 let set_extern_interp f = forward_interp_tactic := f
 
 let conclPattern concl pat tac gl =
-  let constr_bindings = 
-    match pat with 
+  let constr_bindings =
+    match pat with
     | None -> []
     | Some pat ->
 	try matches pat concl
@@ -787,7 +787,7 @@ let conclPattern concl pat tac gl =
   de Hint impérative a été remplacée par plusieurs bases fonctionnelles *)
 
 let flags_of_state st =
-  {auto_unif_flags with 
+  {auto_unif_flags with
     modulo_conv_on_closed_terms = Some st; modulo_delta = st}
 
 let hintmap_of hdc concl =
@@ -796,34 +796,34 @@ let hintmap_of hdc concl =
   | Some hdc ->
       if occur_existential concl then Hint_db.map_all hdc
       else Hint_db.map_auto (hdc,concl)
-	
+
 let rec trivial_fail_db mod_delta db_list local_db gl =
-  let intro_tac = 
-    tclTHEN intro 
+  let intro_tac =
+    tclTHEN intro
       (fun g'->
 	 let hintl = make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
 	 in trivial_fail_db mod_delta db_list (Hint_db.add_list hintl local_db) g')
   in
-  tclFIRST 
+  tclFIRST
     (assumption::intro_tac::
-     (List.map tclCOMPLETE 
+     (List.map tclCOMPLETE
        (trivial_resolve mod_delta db_list local_db (pf_concl gl)))) gl
 
 and my_find_search_nodelta db_list local_db hdc concl =
-  List.map (fun hint -> (None,hint)) 
+  List.map (fun hint -> (None,hint))
     (list_map_append (hintmap_of hdc concl) (local_db::db_list))
 
 and my_find_search mod_delta =
   if mod_delta then my_find_search_delta
   else my_find_search_nodelta
-    
+
 and my_find_search_delta db_list local_db hdc concl =
   let flags = {auto_unif_flags with use_metas_eagerly = true} in
   let f = hintmap_of hdc concl in
-    if occur_existential concl then 
+    if occur_existential concl then
       list_map_append
-	(fun db -> 
-	  if Hint_db.use_dn db then 
+	(fun db ->
+	  if Hint_db.use_dn db then
 	    let flags = flags_of_state (Hint_db.transparent_state db) in
 	      List.map (fun x -> (Some flags,x)) (f db)
 	  else
@@ -831,8 +831,8 @@ and my_find_search_delta db_list local_db hdc concl =
 	      List.map (fun x -> (Some flags,x)) (f db))
 	(local_db::db_list)
     else
-      list_map_append (fun db -> 
-	if Hint_db.use_dn db then 
+      list_map_append (fun db ->
+	if Hint_db.use_dn db then
 	  let flags = flags_of_state (Hint_db.transparent_state db) in
 	    List.map (fun x -> (Some flags, x)) (f db)
 	else
@@ -853,37 +853,37 @@ and tac_of_hint db_list local_db concl (flags, {pat=p; code=t}) =
   | Res_pf (term,cl) -> unify_resolve_gen flags (term,cl)
   | ERes_pf (_,c) -> (fun gl -> error "eres_pf")
   | Give_exact c  -> exact_check c
-  | Res_pf_THEN_trivial_fail (term,cl) -> 
-      tclTHEN 
+  | Res_pf_THEN_trivial_fail (term,cl) ->
+      tclTHEN
         (unify_resolve_gen flags (term,cl))
         (trivial_fail_db (flags <> None) db_list local_db)
   | Unfold_nth c -> unfold_in_concl [all_occurrences,c]
   | Extern tacast -> conclPattern concl p tacast
-      
-and trivial_resolve mod_delta db_list local_db cl = 
-  try 
-    let head = 
+
+and trivial_resolve mod_delta db_list local_db cl =
+  try
+    let head =
       try let hdconstr,_ = head_constr_bound cl in
 	    Some (head_of_constr_reference hdconstr)
       with Bound -> None
     in
       List.map (tac_of_hint db_list local_db cl)
-	(priority 
+	(priority
 	    (my_find_search mod_delta db_list local_db head cl))
   with Not_found -> []
 
 let trivial lems dbnames gl =
-  let db_list = 
+  let db_list =
     List.map
-      (fun x -> 
-	 try 
+      (fun x ->
+	 try
 	   searchtable_map x
-	 with Not_found -> 
+	 with Not_found ->
 	   error_no_such_hint_database x)
-      ("core"::dbnames) 
+      ("core"::dbnames)
   in
-  tclTRY (trivial_fail_db false db_list (make_local_hint_db false lems gl)) gl 
-    
+  tclTRY (trivial_fail_db false db_list (make_local_hint_db false lems gl)) gl
+
 let full_trivial lems gl =
   let dbnames = Hintdbmap.dom !searchtable in
   let dbnames = list_subtract dbnames ["v62"] in
@@ -905,8 +905,8 @@ let h_trivial lems l =
 (**************************************************************************)
 
 let possible_resolve mod_delta db_list local_db cl =
-  try 
-    let head = 
+  try
+    let head =
       try let hdconstr,_ = head_constr_bound cl in
 	    Some (head_of_constr_reference hdconstr)
       with Bound -> None
@@ -925,18 +925,18 @@ let decomp_unary_term_then (id,_,typc) kont1 kont2 gl =
 	kont2 gl
   with UserError _ -> kont2 gl
 
-let decomp_empty_term (id,_,typc) gl = 
-  if Hipattern.is_empty_type typc then 
-    simplest_case (mkVar id) gl 
-  else 
+let decomp_empty_term (id,_,typc) gl =
+  if Hipattern.is_empty_type typc then
+    simplest_case (mkVar id) gl
+  else
     errorlabstrm "Auto.decomp_empty_term" (str "Not an empty type.")
 
 let extend_local_db gl decl db =
   Hint_db.add_list (make_resolve_hyp (pf_env gl) (project gl) decl) db
 
-(* Try to decompose hypothesis [decl] into atomic components of a 
-   conjunction with maximum depth [p] (or solve the goal from an 
-   empty type) then call the continuation tactic with hint db extended 
+(* Try to decompose hypothesis [decl] into atomic components of a
+   conjunction with maximum depth [p] (or solve the goal from an
+   empty type) then call the continuation tactic with hint db extended
    with the obtained not-further-decomposable hypotheses *)
 
 let rec decomp_and_register_decl p kont (id,_,_ as decl) db gl =
@@ -967,7 +967,7 @@ and decomp_and_register_decls p kont decls =
   List.fold_left (decomp_and_register_decl p) kont decls
 
 
-(* decomp is an natural number giving an indication on decomposition 
+(* decomp is an natural number giving an indication on decomposition
    of conjunction in hypotheses, 0 corresponds to no decomposition *)
 (* n is the max depth of search *)
 (* local_db contains the local Hypotheses *)
@@ -980,7 +980,7 @@ let rec search_gen p n mod_delta db_list local_db =
     tclFIRST
       (assumption ::
        intros_decomp p (search n) [] local_db 1 ::
-       List.map (fun ntac -> tclTHEN ntac (search (n-1) local_db)) 
+       List.map (fun ntac -> tclTHEN ntac (search (n-1) local_db))
 	(possible_resolve mod_delta db_list local_db (pf_concl gl))) gl
   in
   search n local_db
@@ -990,14 +990,14 @@ let search = search_gen 0
 let default_search_depth = ref 5
 
 let delta_auto mod_delta n lems dbnames gl =
-  let db_list = 
+  let db_list =
     List.map
-      (fun x -> 
-	 try 
+      (fun x ->
+	 try
 	   searchtable_map x
-	 with Not_found -> 
+	 with Not_found ->
 	   error_no_such_hint_database x)
-      ("core"::dbnames) 
+      ("core"::dbnames)
   in
   tclTRY (search n mod_delta db_list (make_local_hint_db false lems gl)) gl
 
@@ -1007,7 +1007,7 @@ let new_auto = delta_auto true
 
 let default_auto = auto !default_search_depth [] []
 
-let delta_full_auto mod_delta n lems gl = 
+let delta_full_auto mod_delta n lems gl =
   let dbnames = Hintdbmap.dom !searchtable in
   let dbnames = list_subtract dbnames ["v62"] in
   let db_list = List.map (fun x -> searchtable_map x) dbnames in
@@ -1034,18 +1034,18 @@ let h_auto n lems l =
 (*                  The "destructing Auto" from Eduardo                   *)
 (**************************************************************************)
 
-(* Depth of search after decomposition of hypothesis, by default 
-   one look for an immediate solution *) 
+(* Depth of search after decomposition of hypothesis, by default
+   one look for an immediate solution *)
 let default_search_decomp = ref 20
 
-let destruct_auto p lems n gl = 
+let destruct_auto p lems n gl =
   decomp_and_register_decls p (fun local_db gl ->
     search_gen p n false (List.map searchtable_map ["core";"extcore"])
       (add_hint_lemmas false lems local_db gl) gl)
     (pf_hyps gl)
     (Hint_db.empty empty_transparent_state false)
     gl
-    
+
 let dautomatic des_opt lems n = tclTRY (destruct_auto des_opt lems n)
 
 let dauto (n,p) lems =
@@ -1064,35 +1064,35 @@ let h_dauto (n,p) lems =
 (***************************************)
 
 let make_resolve_any_hyp env sigma (id,_,ty) =
-  let ents = 
+  let ents =
     map_succeed
-      (fun f -> f (mkVar id,ty)) 
+      (fun f -> f (mkVar id,ty))
       [make_exact_entry None; make_apply_entry env sigma (true,true,false) None]
-  in 
+  in
   ents
 
 type autoArguments =
-  | UsingTDB       
-  | Destructing   
+  | UsingTDB
+  | Destructing
 
 let compileAutoArg contac = function
-  | Destructing -> 
-      (function g -> 
-         let ctx = pf_hyps g in  
-	 tclFIRST 
-           (List.map 
-              (fun (id,_,typ) -> 
+  | Destructing ->
+      (function g ->
+         let ctx = pf_hyps g in
+	 tclFIRST
+           (List.map
+              (fun (id,_,typ) ->
                 let cl = (strip_prod_assum typ) in
                  if Hipattern.is_conjunction cl
-		 then 
-		   tclTHENSEQ [simplest_elim (mkVar id); clear [id]; contac] 
-                 else 
+		 then
+		   tclTHENSEQ [simplest_elim (mkVar id); clear [id]; contac]
+                 else
 		   tclFAIL 0 (pr_id id ++ str" is not a conjunction"))
 	     ctx) g)
-  | UsingTDB ->  
-      (tclTHEN  
-         (Tacticals.tryAllHypsAndConcl 
-            (function 
+  | UsingTDB ->
+      (tclTHEN
+         (Tacticals.tryAllHypsAndConcl
+            (function
                | Some id -> Dhyp.h_destructHyp false id
                | None    -> Dhyp.h_destructConcl))
          contac)
@@ -1104,20 +1104,20 @@ let rec super_search n db_list local_db argl gl =
   tclFIRST
     (assumption
      ::
-     tclTHEN intro 
-        (fun g -> 
+     tclTHEN intro
+        (fun g ->
 	   let hintl = pf_apply make_resolve_any_hyp g (pf_last_hyp g) in
 	   super_search n db_list (Hint_db.add_list hintl local_db)
 	     argl g)
      ::
-     List.map (fun ntac -> 
-            tclTHEN ntac 
+     List.map (fun ntac ->
+            tclTHEN ntac
               (super_search (n-1) db_list local_db argl))
          (possible_resolve false db_list local_db (pf_concl gl))
       @
       compileAutoArgList (super_search (n-1) db_list local_db argl) argl) gl
 
-let search_superauto n to_add argl g = 
+let search_superauto n to_add argl g =
   let sigma =
     List.fold_right
       (fun (id,c) -> add_named_decl (id, None, pf_type_of g c))
@@ -1126,7 +1126,7 @@ let search_superauto n to_add argl g =
   let db = Hint_db.add_list db0 (make_local_hint_db false [] g) in
   super_search n [Hintdbmap.find "core" !searchtable] db argl g
 
-let superauto n to_add argl  = 
+let superauto n to_add argl  =
   tclTRY (tclCOMPLETE (search_superauto n to_add argl))
 
 let interp_to_add gl r =
diff --git a/tactics/auto.mli b/tactics/auto.mli
index 982a4e68ec..007a116d19 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -23,24 +23,24 @@ open Libnames
 open Vernacexpr
 open Mod_subst
 (*i*)
-  
-type auto_tactic = 
+
+type auto_tactic =
   | Res_pf     of constr * clausenv    (* Hint Apply *)
   | ERes_pf    of constr * clausenv    (* Hint EApply *)
-  | Give_exact of constr                  
+  | Give_exact of constr
   | Res_pf_THEN_trivial_fail of constr * clausenv (* Hint Immediate *)
   | Unfold_nth of evaluable_global_reference          (* Hint Unfold *)
   | Extern     of Tacexpr.glob_tactic_expr   (* Hint Extern *)
 
 open Rawterm
 
-type pri_auto_tactic = { 
+type pri_auto_tactic = {
   pri   : int;            (* A number between 0 and 4, 4 = lower priority *)
   pat   : constr_pattern option; (* A pattern for the concl of the Goal *)
   code  : auto_tactic;    (* the tactic to apply when the concl matches pat *)
 }
 
-type stored_data = pri_auto_tactic 
+type stored_data = pri_auto_tactic
 
 type search_entry = stored_data list * stored_data list * stored_data Btermdn.t
 
@@ -74,18 +74,18 @@ type hints_entry =
   | HintsImmediateEntry of constr list
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsExternEntry of 
+  | HintsExternEntry of
       int * (patvar list * constr_pattern) option * Tacexpr.glob_tactic_expr
-  | HintsDestructEntry of identifier * int * (bool,unit) Tacexpr.location * 
+  | HintsDestructEntry of identifier * int * (bool,unit) Tacexpr.location *
       (patvar list * constr_pattern) * Tacexpr.glob_tactic_expr
 
 val searchtable_map : hint_db_name -> hint_db
 
 val searchtable_add : (hint_db_name * hint_db) -> unit
 
-(* [create_hint_db local name st use_dn]. 
+(* [create_hint_db local name st use_dn].
    [st] is a transparency state for unification using this db
-   [use_dn] switches the use of the discrimination net for all hints 
+   [use_dn] switches the use of the discrimination net for all hints
    and patterns. *)
 
 val create_hint_db : bool -> hint_db_name -> transparent_state -> bool -> unit
@@ -104,7 +104,7 @@ val print_hint_ref : global_reference -> unit
 
 val print_hint_db_by_name : hint_db_name -> unit
 
-(* [make_exact_entry pri (c, ctyp)]. 
+(* [make_exact_entry pri (c, ctyp)].
    [c] is the term given as an exact proof to solve the goal;
    [ctyp] is the type of [c]. *)
 
@@ -112,11 +112,11 @@ val make_exact_entry : int option -> constr * constr -> hint_entry
 
 (* [make_apply_entry (eapply,verbose) pri (c,cty)].
    [eapply] is true if this hint will be used only with EApply;
-   [hnf] should be true if we should expand the head of cty before searching for 
+   [hnf] should be true if we should expand the head of cty before searching for
    products;
    [c] is the term given as an exact proof to solve the goal;
    [cty] is the type of [c]. *)
-  
+
 val make_apply_entry :
   env -> evar_map -> bool * bool * bool -> int option -> constr * constr
       -> hint_entry
@@ -129,7 +129,7 @@ val make_apply_entry :
        has missing arguments. *)
 
 val make_resolves :
-  env -> evar_map -> bool * bool * bool -> int option -> constr -> 
+  env -> evar_map -> bool * bool * bool -> int option -> constr ->
       hint_entry list
 
 (* [make_resolve_hyp hname htyp].
@@ -137,7 +137,7 @@ val make_resolves :
    Never raises a user exception;
    If the hyp cannot be used as a Hint, the empty list is returned. *)
 
-val make_resolve_hyp : 
+val make_resolve_hyp :
   env -> evar_map -> named_declaration -> hint_entry list
 
 (* [make_extern pri pattern tactic_expr] *)
@@ -175,7 +175,7 @@ val unify_resolve_nodelta : (constr * clausenv) -> tactic
 val unify_resolve : Unification.unify_flags -> (constr * clausenv) -> tactic
 
 (* [ConclPattern concl pat tacast]:
-   if the term concl matches the pattern pat, (in sense of 
+   if the term concl matches the pattern pat, (in sense of
    [Pattern.somatches], then replace [?1] [?2] metavars in tacast by the
    right values to build a tactic *)
 
@@ -199,7 +199,7 @@ val full_auto : int -> constr list -> tactic
    and doing delta *)
 val new_full_auto : int -> constr list -> tactic
 
-(* auto with default search depth and with all hint databases 
+(* auto with default search depth and with all hint databases
    except the "v62" compatibility database *)
 val default_full_auto : tactic
 
@@ -228,8 +228,8 @@ val h_dauto : int option * int option -> constr list -> tactic
 (* SuperAuto *)
 
 type autoArguments =
-  | UsingTDB       
-  | Destructing   
+  | UsingTDB
+  | Destructing
 
 (*
 val superauto : int -> (identifier * constr) list -> autoArguments list -> tactic
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 0d5a4ba25b..dbaedeefc8 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -37,14 +37,14 @@ let subst_hint subst hint =
   let pat' = subst_mps subst hint.rew_pat in
   let t' = Tacinterp.subst_tactic subst hint.rew_tac in
     if hint.rew_lemma == cst' && hint.rew_tac == t' then hint else
-      { hint with 
-	rew_lemma = cst'; rew_type = typ'; 
+      { hint with
+	rew_lemma = cst'; rew_type = typ';
 	rew_pat = pat';	rew_tac = t' }
 
-module HintIdent = 
+module HintIdent =
 struct
   type t = int * rew_rule
-  
+
   let compare (i,t) (i',t') =
     Pervasives.compare i i'
 (*     Pervasives.compare t.rew_lemma t'.rew_lemma *)
@@ -66,7 +66,7 @@ module HintDN = Term_dnet.Make(HintIdent)(HintOpt)
 let rewtab =
   ref (Stringmap.empty : HintDN.t Stringmap.t)
 
-let _ = 
+let _ =
   let init () = rewtab := Stringmap.empty in
   let freeze () = !rewtab in
   let unfreeze fs = rewtab := fs in
@@ -78,11 +78,11 @@ let _ =
 let find_base bas =
  try Stringmap.find bas !rewtab
  with
-  Not_found -> 
-   errorlabstrm "AutoRewrite" 
+  Not_found ->
+   errorlabstrm "AutoRewrite"
      (str ("Rewriting base "^(bas)^" does not exist."))
 
-let find_rewrites bas = 
+let find_rewrites bas =
   List.rev_map snd (HintDN.find_all (find_base bas))
 
 let find_matches bas pat =
@@ -96,10 +96,10 @@ let print_rewrite_hintdb bas =
 	   (fun h ->
 	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
 	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
-	       str " then use tactic " ++ 
+	       str " then use tactic " ++
 	       Pptactic.pr_glob_tactic (Global.env()) h.rew_tac)
 	   (find_rewrites bas))
-    
+
 type raw_rew_rule = loc * constr * bool * raw_tactic_expr
 
 (* Applies all the rules of one base *)
@@ -108,14 +108,14 @@ let one_base general_rewrite_maybe_in tac_main bas =
   let lrul = List.map (fun h -> (h.rew_lemma,h.rew_l2r,Tacinterp.eval_tactic h.rew_tac)) lrul in
     tclREPEAT_MAIN (tclPROGRESS (List.fold_left (fun tac (csr,dir,tc) ->
       tclTHEN tac
-        (tclREPEAT_MAIN 
+        (tclREPEAT_MAIN
 	    (tclTHENFIRST (general_rewrite_maybe_in dir csr tc) tac_main)))
       tclIDTAC lrul))
 
 (* The AutoRewrite tactic *)
 let autorewrite ?(conds=Naive) tac_main lbas =
   tclREPEAT_MAIN (tclPROGRESS
-    (List.fold_left (fun tac bas -> 
+    (List.fold_left (fun tac bas ->
        tclTHEN tac
         (one_base (fun dir c tac ->
 	  let tac = tac, conds in
@@ -124,7 +124,7 @@ let autorewrite ?(conds=Naive) tac_main lbas =
       tclIDTAC lbas))
 
 let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas : tactic =
-  fun gl -> 
+  fun gl ->
  (* let's check at once if id exists (to raise the appropriate error) *)
  let _ = List.map (Tacmach.pf_get_hyp gl) idl in
  let general_rewrite_in id =
@@ -161,35 +161,35 @@ let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas : tactic =
           | _ -> assert false) (* there must be at least an hypothesis *)
      | _ -> assert false (* rewriting cannot complete a proof *)
  in
- tclMAP (fun id -> 
+ tclMAP (fun id ->
   tclREPEAT_MAIN (tclPROGRESS
-    (List.fold_left (fun tac bas -> 
+    (List.fold_left (fun tac bas ->
        tclTHEN tac (one_base (general_rewrite_in id) tac_main bas)) tclIDTAC lbas)))
    idl gl
 
 let autorewrite_in ?(conds=Naive) id = autorewrite_multi_in ~conds [id]
 
-let gen_auto_multi_rewrite conds tac_main lbas cl = 
-  let try_do_hyps treat_id l = 
+let gen_auto_multi_rewrite conds tac_main lbas cl =
+  let try_do_hyps treat_id l =
     autorewrite_multi_in ~conds (List.map treat_id l) tac_main lbas
-  in 
+  in
   if cl.concl_occs <> all_occurrences_expr &
      cl.concl_occs <> no_occurrences_expr
-  then 
+  then
     error "The \"at\" syntax isn't available yet for the autorewrite tactic."
-  else 
-    let compose_tac t1 t2 = 
-      match cl.onhyps with 
-	| Some [] -> t1 
+  else
+    let compose_tac t1 t2 =
+      match cl.onhyps with
+	| Some [] -> t1
 	| _ ->      tclTHENFIRST t1 t2
     in
     compose_tac
 	(if cl.concl_occs <> no_occurrences_expr then autorewrite ~conds tac_main lbas else tclIDTAC)
-	(match cl.onhyps with 
+	(match cl.onhyps with
 	   | Some l -> try_do_hyps (fun ((_,id),_) -> id) l
-	   | None -> 
-	       fun gl -> 
-		 (* try to rewrite in all hypothesis 
+	   | None ->
+	       fun gl ->
+		 (* try to rewrite in all hypothesis
 		    (except maybe the rewritten one) *)
 		 let ids =  Tacmach.pf_ids_of_hyps gl
 		 in try_do_hyps (fun id -> id)  ids gl)
@@ -198,14 +198,14 @@ let auto_multi_rewrite ?(conds=Naive) = gen_auto_multi_rewrite conds Refiner.tcl
 
 let auto_multi_rewrite_with ?(conds=Naive) tac_main lbas cl gl =
   let onconcl = cl.Tacexpr.concl_occs <> no_occurrences_expr in
-  match onconcl,cl.Tacexpr.onhyps with 
-    | false,Some [_] | true,Some [] | false,Some [] ->   
-	(* autorewrite with .... in clause using tac n'est sur que 
-	   si clause represente soit le but soit UNE hypothese 
+  match onconcl,cl.Tacexpr.onhyps with
+    | false,Some [_] | true,Some [] | false,Some [] ->
+	(* autorewrite with .... in clause using tac n'est sur que
+	   si clause represente soit le but soit UNE hypothese
 	*)
 	gen_auto_multi_rewrite conds tac_main lbas cl gl
-    | _ -> 
-	    Util.errorlabstrm "autorewrite" 
+    | _ ->
+	    Util.errorlabstrm "autorewrite"
 	      (strbrk "autorewrite .. in .. using can only be used either with a unique hypothesis or on the conclusion.")
 
 (* Functions necessary to the library object declaration *)
@@ -217,11 +217,11 @@ let cache_hintrewrite (_,(rbase,lrl)) =
 
 let export_hintrewrite x = Some x
 
-let subst_hintrewrite (_,subst,(rbase,list as node)) = 
+let subst_hintrewrite (_,subst,(rbase,list as node)) =
   let list' = HintDN.subst subst list in
     if list' == list then node else
       (rbase,list')
-      
+
 let classify_hintrewrite x = Libobject.Substitute x
 
 
@@ -249,13 +249,13 @@ type hypinfo = {
 }
 
 let evd_convertible env evd x y =
-  try ignore(Evarconv.the_conv_x env x y evd); true 
+  try ignore(Evarconv.the_conv_x env x y evd); true
   with _ -> false
-  
+
 let decompose_applied_relation metas env sigma c ctype left2right =
-  let find_rel ty = 
+  let find_rel ty =
     let eqclause = Clenv.mk_clenv_from_env env sigma None (c,ty) in
-    let eqclause = 
+    let eqclause =
       if metas then eqclause
       else clenv_pose_metas_as_evars eqclause (Evd.undefined_metas eqclause.evd)
     in
@@ -266,9 +266,9 @@ let decompose_applied_relation metas env sigma c ctype left2right =
 	  let l,res = split_last_two (y::z) in x::l, res
       | _ -> raise Not_found
     in
-      try 
+      try
 	let others,(c1,c2) = split_last_two args in
-	let ty1, ty2 = 
+	let ty1, ty2 =
 	  Typing.mtype_of env eqclause.evd c1, Typing.mtype_of env eqclause.evd c2
 	in
 	  if not (evd_convertible env eqclause.evd ty1 ty2) then None
@@ -280,7 +280,7 @@ let decompose_applied_relation metas env sigma c ctype left2right =
   in
     match find_rel ctype with
     | Some c -> Some c
-    | None -> 
+    | None ->
 	let ctx,t' = Reductionops.splay_prod_assum env sigma ctype in (* Search for underlying eq *)
 	match find_rel (it_mkProd_or_LetIn t' ctx) with
 	| Some c -> Some c
@@ -290,11 +290,11 @@ let find_applied_relation metas loc env sigma c left2right =
   let ctype = Typing.type_of env sigma c in
     match decompose_applied_relation metas env sigma c ctype left2right with
     | Some c -> c
-    | None -> 
-	user_err_loc (loc, "decompose_applied_relation", 
+    | None ->
+	user_err_loc (loc, "decompose_applied_relation",
 		     str"The type" ++ spc () ++ Printer.pr_constr_env env ctype ++
 		       spc () ++ str"of this term does not end with an applied relation.")
-	
+
 (* To add rewriting rules to a base *)
 let add_rew_rules base lrul =
   let counter = ref 0 in
@@ -309,4 +309,4 @@ let add_rew_rules base lrul =
 	in incr counter;
 	  HintDN.add pat (!counter, rul) dn) HintDN.empty lrul
   in Lib.add_anonymous_leaf (inHintRewrite (base,lrul))
-    
+
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index 17777084d8..cf0d58ccb4 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -23,7 +23,7 @@ val add_rew_rules : string -> raw_rew_rule list -> unit
 
 (* The AutoRewrite tactic.
    The optional conditions tell rewrite how to handle matching and side-condition solving.
-   Default is Naive: first match in the clause, don't look at the side-conditions to 
+   Default is Naive: first match in the clause, don't look at the side-conditions to
    tell if the rewrite succeeded. *)
 val autorewrite : ?conds:conditions -> tactic -> string list -> tactic
 val autorewrite_in : ?conds:conditions -> Names.identifier -> tactic -> string list -> tactic
diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml
index 379949f462..b409fc9b8d 100644
--- a/tactics/btermdn.ml
+++ b/tactics/btermdn.ml
@@ -19,18 +19,18 @@ open Libnames
    Eduardo (5/8/97). *)
 
 let dnet_depth = ref 8
-		   
+
 let bounded_constr_pat_discr_st st (t,depth) =
-  if depth = 0 then 
-    None 
+  if depth = 0 then
+    None
   else
     match constr_pat_discr_st st t with
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
-	    
+
 let bounded_constr_val_discr_st st (t,depth) =
-  if depth = 0 then 
-    Dn.Nothing 
+  if depth = 0 then
+    Dn.Nothing
   else
     match constr_val_discr_st st t with
       | Dn.Label (c,l) -> Dn.Label(c,List.map (fun c -> (c,depth-1)) l)
@@ -38,16 +38,16 @@ let bounded_constr_val_discr_st st (t,depth) =
       | Dn.Everything -> Dn.Everything
 
 let bounded_constr_pat_discr (t,depth) =
-  if depth = 0 then 
-    None 
+  if depth = 0 then
+    None
   else
     match constr_pat_discr t with
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
-	    
+
 let bounded_constr_val_discr (t,depth) =
-  if depth = 0 then 
-    Dn.Nothing 
+  if depth = 0 then
+    Dn.Nothing
   else
     match constr_val_discr t with
       | Dn.Label (c,l) -> Dn.Label(c,List.map (fun c -> (c,depth-1)) l)
@@ -55,35 +55,35 @@ let bounded_constr_val_discr (t,depth) =
       | Dn.Everything -> Dn.Everything
 
 type 'a t = (global_reference,constr_pattern * int,'a) Dn.t
-  
+
 let create = Dn.create
-  
+
 let add = function
-  | None -> 
-      (fun dn (c,v) -> 
+  | None ->
+      (fun dn (c,v) ->
 	Dn.add dn bounded_constr_pat_discr ((c,!dnet_depth),v))
-  | Some st -> 
-      (fun dn (c,v) -> 
+  | Some st ->
+      (fun dn (c,v) ->
 	Dn.add dn (bounded_constr_pat_discr_st st) ((c,!dnet_depth),v))
 
 let rmv = function
-  | None -> 
-      (fun dn (c,v) -> 
+  | None ->
+      (fun dn (c,v) ->
 	Dn.rmv dn bounded_constr_pat_discr ((c,!dnet_depth),v))
-  | Some st -> 
-      (fun dn (c,v) -> 
+  | Some st ->
+      (fun dn (c,v) ->
 	Dn.rmv dn (bounded_constr_pat_discr_st st) ((c,!dnet_depth),v))
 
 let lookup = function
-  | None -> 
+  | None ->
       (fun dn t ->
-	List.map 
-	  (fun ((c,_),v) -> (c,v)) 
+	List.map
+	  (fun ((c,_),v) -> (c,v))
 	  (Dn.lookup dn bounded_constr_val_discr (t,!dnet_depth)))
-  | Some st -> 
+  | Some st ->
       (fun dn t ->
-	List.map 
-	  (fun ((c,_),v) -> (c,v)) 
+	List.map
+	  (fun ((c,_),v) -> (c,v))
 	  (Dn.lookup dn (bounded_constr_val_discr_st st) (t,!dnet_depth)))
 
 let app f dn = Dn.app (fun ((c,_),v) -> f(c,v)) dn
diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli
index 86107641d0..b41ecbf77c 100644
--- a/tactics/btermdn.mli
+++ b/tactics/btermdn.mli
@@ -22,7 +22,7 @@ val create : unit -> 'a t
 
 val add : transparent_state option -> 'a t -> (constr_pattern * 'a) -> 'a t
 val rmv : transparent_state option -> 'a t -> (constr_pattern * 'a) -> 'a t
-  
+
 val lookup : transparent_state option -> 'a t -> constr -> (constr_pattern * 'a) list
 val app : ((constr_pattern * 'a) -> unit) -> 'a t -> unit
 
diff --git a/tactics/class_tactics.ml4 b/tactics/class_tactics.ml4
index e9dfce78b0..be8b0fb805 100644
--- a/tactics/class_tactics.ml4
+++ b/tactics/class_tactics.ml4
@@ -43,20 +43,20 @@ open Evd
 let default_eauto_depth = 100
 let typeclasses_db = "typeclass_instances"
 
-let _ = Auto.auto_init := (fun () -> 
+let _ = Auto.auto_init := (fun () ->
   Auto.create_hint_db false typeclasses_db full_transparent_state true)
 
 exception Found of evar_map
 
-let is_dependent ev evm = 
-  Evd.fold (fun ev' evi dep -> 
+let is_dependent ev evm =
+  Evd.fold (fun ev' evi dep ->
     if ev = ev' then dep
     else dep || occur_evar ev evi.evar_concl)
     evm false
 
-let valid goals p res_sigma l = 
-  let evm = 
-    List.fold_left2 
+let valid goals p res_sigma l =
+  let evm =
+    List.fold_left2
       (fun sigma (ev, evi) prf ->
 	let cstr, obls = Refiner.extract_open_proof !res_sigma prf in
 	  if not (Evd.is_defined sigma ev) then
@@ -66,13 +66,13 @@ let valid goals p res_sigma l =
   in raise (Found evm)
 
 let evars_to_goals p evm =
-  let goals, evm' = 
+  let goals, evm' =
     Evd.fold
       (fun ev evi (gls, evm') ->
-	if evi.evar_body = Evar_empty 
+	if evi.evar_body = Evar_empty
 	  && Typeclasses.is_resolvable evi
 	  (* 	  && not (is_dependent ev evm) *)
-	  && p ev evi then ((ev,evi) :: gls, Evd.add evm' ev (Typeclasses.mark_unresolvable evi)) else 
+	  && p ev evi then ((ev,evi) :: gls, Evd.add evm' ev (Typeclasses.mark_unresolvable evi)) else
 	  (gls, Evd.add evm' ev evi))
       evm ([], Evd.empty)
   in
@@ -88,9 +88,9 @@ let intersects s t =
 
 open Auto
 
-let e_give_exact flags c gl = 
-  let t1 = (pf_type_of gl c) and t2 = pf_concl gl in 
-    if occur_existential t1 or occur_existential t2 then 
+let e_give_exact flags c gl =
+  let t1 = (pf_type_of gl c) and t2 = pf_concl gl in
+    if occur_existential t1 or occur_existential t2 then
       tclTHEN (Clenvtac.unify ~flags t1) (exact_no_check c) gl
     else exact_check c gl
 (*   let t1 = (pf_type_of gl c) in *)
@@ -107,12 +107,12 @@ let auto_unif_flags = {
   use_evars_pattern_unification = true;
 }
 
-let unify_e_resolve flags (c,clenv) gls = 
+let unify_e_resolve flags (c,clenv) gls =
   let clenv' = connect_clenv gls clenv in
   let clenv' = clenv_unique_resolver false ~flags clenv' gls in
     Clenvtac.clenv_refine true ~with_classes:false clenv' gls
 
-let unify_resolve flags (c,clenv) gls = 
+let unify_resolve flags (c,clenv) gls =
   let clenv' = connect_clenv gls clenv in
   let clenv' = clenv_unique_resolver false ~flags clenv' gls in
     Clenvtac.clenv_refine false ~with_classes:false clenv' gls
@@ -120,64 +120,64 @@ let unify_resolve flags (c,clenv) gls =
 (** Hack to properly solve dependent evars that are typeclasses *)
 
 let flags_of_state st =
-  {auto_unif_flags with 
+  {auto_unif_flags with
     modulo_conv_on_closed_terms = Some st; modulo_delta = st}
 
 let rec e_trivial_fail_db db_list local_db goal =
-  let tacl = 
+  let tacl =
     Eauto.registered_e_assumption ::
-    (tclTHEN Tactics.intro 
+    (tclTHEN Tactics.intro
        (function g'->
 	  let d = pf_last_hyp g' in
 	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
           (e_trivial_fail_db db_list
 	      (Hint_db.add_list hintl local_db) g'))) ::
     (List.map pi1 (e_trivial_resolve db_list local_db (pf_concl goal)) )
-  in 
-  tclFIRST (List.map tclCOMPLETE tacl) goal 
+  in
+  tclFIRST (List.map tclCOMPLETE tacl) goal
 
-and e_my_find_search db_list local_db hdc concl = 
+and e_my_find_search db_list local_db hdc concl =
   let hdc = head_of_constr_reference hdc in
   let hintl =
     list_map_append
-      (fun db -> 
-	if Hint_db.use_dn db then 
+      (fun db ->
+	if Hint_db.use_dn db then
 	  let flags = flags_of_state (Hint_db.transparent_state db) in
 	    List.map (fun x -> (flags, x)) (Hint_db.map_auto (hdc,concl) db)
 	else
 	  let flags = flags_of_state (Hint_db.transparent_state db) in
 	    List.map (fun x -> (flags, x)) (Hint_db.map_all hdc db))
       (local_db::db_list)
-  in 
-  let tac_of_hint = 
-    fun (flags, {pri=b; pat = p; code=t}) -> 
+  in
+  let tac_of_hint =
+    fun (flags, {pri=b; pat = p; code=t}) ->
       let tac =
 	match t with
 	  | Res_pf (term,cl) -> unify_resolve flags (term,cl)
 	  | ERes_pf (term,cl) -> unify_e_resolve flags (term,cl)
 	  | Give_exact (c) -> e_give_exact flags c
 	  | Res_pf_THEN_trivial_fail (term,cl) ->
-              tclTHEN (unify_e_resolve flags (term,cl)) 
+              tclTHEN (unify_e_resolve flags (term,cl))
 		(e_trivial_fail_db db_list local_db)
 	  | Unfold_nth c -> unfold_in_concl [all_occurrences,c]
 	  | Extern tacast -> conclPattern concl p tacast
-      in 
+      in
 	(tac,b,pr_autotactic t)
-  in 
+  in
     List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db gl = 
-  try 
-    e_my_find_search db_list local_db 
+and e_trivial_resolve db_list local_db gl =
+  try
+    e_my_find_search db_list local_db
       (fst (head_constr_bound gl)) gl
   with Bound | Not_found -> []
 
 let e_possible_resolve db_list local_db gl =
-  try 
-    e_my_find_search db_list local_db 
+  try
+    e_my_find_search db_list local_db
       (fst (head_constr_bound gl)) gl
   with Bound | Not_found -> []
-    
+
 let rec catchable = function
   | Refiner.FailError _ -> true
   | Stdpp.Exc_located (_, e) -> catchable e
@@ -188,17 +188,17 @@ let is_dep gl gls =
     if evs = Intset.empty then false
     else
       List.fold_left
-	(fun b gl -> 
-	  if b then b 
+	(fun b gl ->
+	  if b then b
 	  else
 	    let evs' = Evarutil.evars_of_term gl.evar_concl in
 	      intersects evs evs')
 	false gls
 
-let is_ground gl = 
+let is_ground gl =
   Evarutil.is_ground_term (project gl) (pf_concl gl)
 
-let nb_empty_evars s = 
+let nb_empty_evars s =
   Evd.fold (fun ev evi acc -> if evi.evar_body = Evar_empty then succ acc else acc) s 0
 
 let pr_ev evs ev = Printer.pr_constr_env (Evd.evar_env ev) (Evarutil.nf_evar evs ev.Evd.evar_concl)
@@ -214,7 +214,7 @@ type autogoal = goal * autoinfo
 type 'ans fk = unit -> 'ans
 type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
 type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-  
+
 type auto_result = autogoal list sigma * validation
 
 type atac = auto_result tac
@@ -225,9 +225,9 @@ let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : '
       match res with
       | Some (gls,v) -> sk (f gls hints, fun _ -> v) fk
       | None -> fk () }
-    
-let intro_tac : atac = 
-  lift_tactic Tactics.intro 
+
+let intro_tac : atac =
+  lift_tactic Tactics.intro
     (fun {it = gls; sigma = s} info ->
       let gls' =
 	List.map (fun g' ->
@@ -237,8 +237,8 @@ let intro_tac : atac =
 	    (g', { info with hints = ldb; auto_last_tac = str"intro" })) gls
       in {it = gls'; sigma = s})
 
-let id_tac : atac = 
-  { skft = fun sk fk {it = gl; sigma = s} -> 
+let id_tac : atac =
+  { skft = fun sk fk {it = gl; sigma = s} ->
     sk ({it = [gl]; sigma = s}, fun _ pfs -> List.hd pfs) fk }
 
 (* Ordering of states is lexicographic on the number of remaining goals. *)
@@ -250,13 +250,13 @@ let compare (pri, _, (res, _)) (pri', _, (res', _)) =
     if pri <> 0 then pri
     else nbgoals res - nbgoals res'
 
-let or_tac (x : 'a tac) (y : 'a tac) : 'a tac = 
+let or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
   { skft = fun sk fk gls -> x.skft sk (fun () -> y.skft sk fk gls) gls }
 
 let solve_tac (x : 'a tac) : 'a tac =
   { skft = fun sk fk gls -> x.skft (fun ({it = gls},_ as res) fk -> if gls = [] then sk res fk else fk ()) fk gls }
-      
-let hints_tac hints = 
+
+let hints_tac hints =
   { skft = fun sk fk {it = gl,info; sigma = s} ->
 (*     if !typeclasses_debug then msgnl (str"depth=" ++ int info.auto_depth ++ str": " ++ info.auto_last_tac *)
 (* 					 ++ spc () ++ str "->" ++ spc () ++ pr_ev s gl); *)
@@ -272,7 +272,7 @@ let hints_tac hints =
 	  poss
       in
 	if l = [] && !typeclasses_debug then
-	  msgnl (pr_depth info.auto_depth ++ str": no match for " ++ 
+	  msgnl (pr_depth info.auto_depth ++ str": no match for " ++
 		    Printer.pr_constr_env (Evd.evar_env gl) concl ++ int (List.length poss) ++ str" possibilities");
 	List.map possible_resolve l
     in
@@ -283,24 +283,24 @@ let hints_tac hints =
 					       ++ str" on" ++ spc () ++ pr_ev s gl);
 	  let fk =
 	    (fun () -> (* if !typeclasses_debug then msgnl (str"backtracked after " ++ pp); *)
-	    aux (succ i) tl) 
+	    aux (succ i) tl)
 	  in
-	  let glsv = {it = list_map_i (fun j g -> g, 
-	    { info with auto_depth = j :: i :: info.auto_depth; 
+	  let glsv = {it = list_map_i (fun j g -> g,
+	    { info with auto_depth = j :: i :: info.auto_depth;
 	      auto_last_tac = pp }) 1 gls; sigma = s}, fun _ -> v in
 	    sk glsv fk
       | [] -> fk ()
     in aux 1 tacs }
-    
+
 let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk =
   let rec aux s (acc : (autogoal list * validation) list) fk = function
     | (gl,info) :: gls ->
-	second.skft (fun ({it=gls';sigma=s'},v') fk' -> 
-	  let fk'' = if gls' = [] && Evarutil.is_ground_term s gl.evar_concl then 
+	second.skft (fun ({it=gls';sigma=s'},v') fk' ->
+	  let fk'' = if gls' = [] && Evarutil.is_ground_term s gl.evar_concl then
 	    (if !typeclasses_debug then msgnl (str"no backtrack on" ++ pr_ev s gl); fk) else fk' in
 	    aux s' ((gls',v')::acc) fk'' gls) fk {it = (gl,info); sigma = s}
     | [] -> Some (List.rev acc, s, fk)
-  in fun ({it = gls; sigma = s},v) fk -> 
+  in fun ({it = gls; sigma = s},v) fk ->
     let rec aux' = function
       | None -> fk ()
       | Some (res, s', fk') ->
@@ -316,19 +316,19 @@ let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk
 
 let then_tac (first : atac) (second : atac) : atac =
   { skft = fun sk fk -> first.skft (then_list second sk) fk }
-  
-let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option = 
+
+let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option =
   t.skft (fun x _ -> Some x) (fun _ -> None) gl
 
-let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : auto_result option = 
-  (then_list t (fun x _ -> Some x)) 
+let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : auto_result option =
+  (then_list t (fun x _ -> Some x))
     (gl, fun s pfs -> valid goals p (ref s) pfs)
     (fun _ -> None)
-    
-let rec fix (t : 'a tac) : 'a tac = 
+
+let rec fix (t : 'a tac) : 'a tac =
   then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
 
-  
+
 (* A special one for getting everything into a dnet. *)
 
 let is_transparent_gr (ids, csts) = function
@@ -339,15 +339,15 @@ let is_transparent_gr (ids, csts) = function
 let make_resolve_hyp env sigma st flags pri (id, _, cty) =
   let cty = Evarutil.nf_evar sigma cty in
   let ctx, ar = decompose_prod cty in
-  let keep = 
+  let keep =
     match kind_of_term (fst (decompose_app ar)) with
     | Const c -> is_class (ConstRef c)
     | Ind i -> is_class (IndRef i)
     | _ -> false
   in
     if keep then let c = mkVar id in
-      map_succeed 
-	(fun f -> f (c,cty)) 
+      map_succeed
+	(fun f -> f (c,cty))
 	[make_exact_entry pri; make_apply_entry env sigma flags pri]
     else []
 
@@ -356,9 +356,9 @@ let make_autogoal ?(st=full_transparent_state) g =
   let hintlist = list_map_append (pf_apply make_resolve_hyp g st (true,false,false) None) sign in
   let hints = Hint_db.add_list hintlist (Hint_db.empty st true) in
     (g.it, { hints = hints ; auto_depth = []; auto_last_tac = mt() })
-      
+
 let make_autogoals ?(st=full_transparent_state) gs evm' =
-  { it = list_map_i (fun i g -> 
+  { it = list_map_i (fun i g ->
     let (gl, auto) = make_autogoal ~st {it = snd g; sigma = evm'} in
       (gl, { auto with auto_depth = [i]})) 1 gs; sigma = evm' }
 
@@ -368,9 +368,9 @@ let run_on_evars ?(st=full_transparent_state) p evm tac =
   | Some (goals, evm') ->
       match run_list_tac tac p goals (make_autogoals ~st goals evm') with
       | None -> raise Not_found
-      | Some (gls, v) -> 
-	  try ignore(v (sig_sig gls) []); assert(false) 
-	  with Found evm' -> 
+      | Some (gls, v) ->
+	  try ignore(v (sig_sig gls) []); assert(false)
+	  with Found evm' ->
 	    Some (Evd.evars_reset_evd evm' evm)
 
 let eauto hints g =
@@ -378,7 +378,7 @@ let eauto hints g =
   let gl = { it = make_autogoal g; sigma = project g } in
     match run_tac tac gl with
     | None -> raise Not_found
-    | Some ({it = goals; sigma = s}, valid) -> 
+    | Some ({it = goals; sigma = s}, valid) ->
 	{it = List.map fst goals; sigma = s}, valid s
 
 let real_eauto st hints p evd =
@@ -404,24 +404,24 @@ let resolve_one_typeclass env ?(sigma=Evd.empty) gl =
   let term = Evarutil.nf_evar evd term in
     evd, term
 
-let _ = 
+let _ =
   Typeclasses.solve_instanciation_problem := (fun x y z -> resolve_one_typeclass x ~sigma:y z)
 
 let has_undefined p oevd evd =
   Evd.fold (fun ev evi has -> has ||
-    (evi.evar_body = Evar_empty && p ev evi && 
+    (evi.evar_body = Evar_empty && p ev evi &&
 	(try Typeclasses.is_resolvable (Evd.find oevd ev) with _ -> true)))
     evd false
 
 let rec merge_deps deps = function
   | [] -> [deps]
-  | hd :: tl -> 
-      if intersects deps hd then 
+  | hd :: tl ->
+      if intersects deps hd then
 	merge_deps (Intset.union deps hd) tl
       else hd :: merge_deps deps tl
-	
+
 let evars_of_evi evi =
-  Intset.union (Evarutil.evars_of_term evi.evar_concl) 
+  Intset.union (Evarutil.evars_of_term evi.evar_concl)
     (match evi.evar_body with
     | Evar_defined b -> Evarutil.evars_of_term b
     | Evar_empty -> Intset.empty)
@@ -440,9 +440,9 @@ let select_evars evs evm =
 let resolve_all_evars debug m env p oevd do_split fail =
   let oevm =  oevd in
   let split = if do_split then split_evars oevd else [Intset.empty] in
-  let p = if do_split then 
+  let p = if do_split then
     fun comp ev evi -> (Intset.mem ev comp || not (Evd.mem oevm ev)) && p ev evi
-    else fun _ -> p 
+    else fun _ -> p
   in
   let rec aux n p evd =
     if has_undefined p oevm evd then
@@ -451,23 +451,23 @@ let resolve_all_evars debug m env p oevd do_split fail =
 	  aux (pred n) p evd'
       else None
     else Some evd
-  in 
+  in
   let rec docomp evd = function
     | [] -> evd
     | comp :: comps ->
 	let res = try aux 1 (p comp) evd with Not_found -> None in
 	  match res with
-	  | None -> 
+	  | None ->
 	      if fail then
 		let evd = Evarutil.nf_evars evd in
-		(* Unable to satisfy the constraints. *)		
+		(* Unable to satisfy the constraints. *)
 		let evm = if do_split then select_evars comp evd else evd in
-		let _, ev = Evd.fold 
-		  (fun ev evi (b,acc) -> 
+		let _, ev = Evd.fold
+		  (fun ev evi (b,acc) ->
 		    (* focus on one instance if only one was searched for *)
 		    if class_of_constr evi.evar_concl <> None then
 		      if not b (* || do_split *) then
-			true, Some ev 
+			true, Some ev
 		      else b, None
 		    else b, acc) evm (false, None)
 		in
@@ -477,28 +477,28 @@ let resolve_all_evars debug m env p oevd do_split fail =
   in docomp oevd split
 
 let resolve_typeclass_evars d p env evd onlyargs split fail =
-  let pred = 
-    if onlyargs then 
+  let pred =
+    if onlyargs then
       (fun ev evi -> Typeclasses.is_implicit_arg (snd (Evd.evar_source ev evd)) &&
 	Typeclasses.is_class_evar evd evi)
     else (fun ev evi -> Typeclasses.is_class_evar evd evi)
   in resolve_all_evars d p env pred evd split fail
-    
+
 let solve_inst debug mode depth env evd onlyargs split fail =
   resolve_typeclass_evars debug (mode, depth) env evd onlyargs split fail
 
-let _ = 
+let _ =
   Typeclasses.solve_instanciations_problem :=
     solve_inst false true default_eauto_depth
 
-    
+
 VERNAC COMMAND EXTEND Typeclasses_Unfold_Settings
 | [ "Typeclasses" "Transparent" reference_list(cl) ] -> [
     add_hints false [typeclasses_db]
       (interp_hints (Vernacexpr.HintsTransparency (cl, true)))
   ]
 END
-	
+
 VERNAC COMMAND EXTEND Typeclasses_Rigid_Settings
 | [ "Typeclasses" "Opaque" reference_list(cl) ] -> [
     add_hints false [typeclasses_db]
@@ -520,9 +520,9 @@ END
 let pr_mode _prc _prlc _prt m =
   match m with
       Some b ->
-	if b then Pp.str "depth-first" else Pp.str "breadth-fist" 
+	if b then Pp.str "depth-first" else Pp.str "breadth-fist"
     | None -> Pp.mt()
-	
+
 ARGUMENT EXTEND search_mode TYPED AS bool option PRINTED BY pr_mode
 | [ "dfs" ] -> [ Some true ]
 | [ "bfs" ] -> [ Some false ]
@@ -532,13 +532,13 @@ END
 let pr_depth _prc _prlc _prt = function
     Some i -> Util.pr_int i
   | None -> Pp.mt()
-	
+
 ARGUMENT EXTEND depth TYPED AS int option PRINTED BY pr_depth
 | [ int_or_var_opt(v) ] -> [ match v with Some (ArgArg i) -> Some i | _ -> None ]
 END
-      
+
 VERNAC COMMAND EXTEND Typeclasses_Settings
- | [ "Typeclasses" "eauto" ":=" debug(d) search_mode(s) depth(depth) ] -> [ 
+ | [ "Typeclasses" "eauto" ":=" debug(d) search_mode(s) depth(depth) ] -> [
      typeclasses_debug := d;
      let mode = match s with Some t -> t | None -> true in
      let depth = match depth with Some i -> i | None -> default_eauto_depth in
@@ -560,11 +560,11 @@ let _ = Classes.refine_ref := Refine.refine
 let rec head_of_constr t =
   let t = strip_outer_cast(collapse_appl t) in
     match kind_of_term t with
-    | Prod (_,_,c2)  -> head_of_constr c2 
+    | Prod (_,_,c2)  -> head_of_constr c2
     | LetIn (_,_,_,c2) -> head_of_constr c2
     | App (f,args)  -> head_of_constr f
     | _      -> t
-      
+
 TACTIC EXTEND head_of_constr
   [ "head_of_constr" ident(h) constr(c) ] -> [
     let c = head_of_constr c in
@@ -584,7 +584,7 @@ let freevars c =
   let rec frec acc c = match kind_of_term c with
     | Var id       -> Idset.add id acc
     | _ -> fold_constr frec acc c
-  in 
+  in
   frec Idset.empty c
 
 let coq_zero = lazy (gen_constant ["Init"; "Datatypes"] "O")
@@ -597,15 +597,15 @@ let rec coq_nat_of_int = function
 
 let varify_constr_list ty def varh c =
   let vars = Idset.elements (freevars c) in
-  let mkaccess i = 
+  let mkaccess i =
     mkApp (Lazy.force coq_List_nth,
 	  [| ty; coq_nat_of_int i; varh; def |])
   in
-  let l = List.fold_right (fun id acc -> 
+  let l = List.fold_right (fun id acc ->
     mkApp (Lazy.force coq_List_cons, [| ty ; mkVar id; acc |]))
     vars (mkApp (Lazy.force coq_List_nil, [| ty |]))
   in
-  let subst = 
+  let subst =
     list_map_i (fun i id -> (id, mkaccess i)) 0 vars
   in
     l, replace_vars subst c
@@ -630,27 +630,27 @@ let rec mkidx i p =
     else mkApp (Lazy.force coq_index_left, [|mkidx (i - p) (2 * p)|])
   else if i = 1 then mkApp (Lazy.force coq_index_right, [|Lazy.force coq_index_end|])
   else mkApp (Lazy.force coq_index_right, [|mkidx (i - p) (2 * p)|])
-	
+
 let varify_constr_varmap ty def varh c =
   let vars = Idset.elements (freevars c) in
-  let mkaccess i = 
+  let mkaccess i =
     mkApp (Lazy.force coq_varmap_lookup,
 	  [| ty; def; i; varh |])
   in
-  let rec vmap_aux l cont = 
-    match l with 
+  let rec vmap_aux l cont =
+    match l with
     | [] -> [], mkApp (Lazy.force coq_varmap_empty, [| ty |])
-    | hd :: tl -> 
+    | hd :: tl ->
 	let left, right = split_interleaved [] [] tl in
 	let leftvars, leftmap = vmap_aux left (fun x -> cont (mkApp (Lazy.force coq_index_left, [| x |]))) in
 	let rightvars, rightmap = vmap_aux right (fun x -> cont (mkApp (Lazy.force coq_index_right, [| x |]))) in
-	  (hd, cont (Lazy.force coq_index_end)) :: leftvars @ rightvars, 
+	  (hd, cont (Lazy.force coq_index_end)) :: leftvars @ rightvars,
 	mkApp (Lazy.force coq_varmap_node, [| ty; hd; leftmap ; rightmap |])
   in
   let subst, vmap = vmap_aux (def :: List.map (fun x -> mkVar x) vars) (fun x -> x) in
   let subst = List.map (fun (id, x) -> (destVar id, mkaccess x)) (List.tl subst) in
     vmap, replace_vars subst c
-  
+
 
 TACTIC EXTEND varify
   [ "varify" ident(varh) ident(h') constr(ty) constr(def) constr(c) ] -> [
@@ -661,7 +661,7 @@ TACTIC EXTEND varify
 END
 
 TACTIC EXTEND not_evar
-  [ "not_evar" constr(ty) ] -> [ 
+  [ "not_evar" constr(ty) ] -> [
     match kind_of_term ty with
     | Evar _ -> tclFAIL 0 (str"Evar")
     | _ -> tclIDTAC ]
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 4b48064b31..46ed2134d0 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -27,9 +27,9 @@ let absurd c gls =
     (Evd.create_goal_evar_defs sigma) (Retyping.get_judgment_of env sigma c) in
   let c = j.Environ.utj_val in
   (tclTHENS
-     (tclTHEN (elim_type (build_coq_False ())) (cut c)) 
+     (tclTHEN (elim_type (build_coq_False ())) (cut c))
      ([(tclTHENS
-          (cut (applist(build_coq_not (),[c]))) 
+          (cut (applist(build_coq_not (),[c])))
 	  ([(tclTHEN intros
 	       ((fun gl ->
 		   let ida = pf_nth_hyp_id gl 1
@@ -59,7 +59,7 @@ let contradiction_context gl =
 	else match kind_of_term typ with
 	  | Prod (na,t,u) when is_empty_type u ->
 	      (try
-		filter_hyp (fun typ -> pf_conv_x_leq gl typ t) 
+		filter_hyp (fun typ -> pf_conv_x_leq gl typ t)
 		  (fun id' -> simplest_elim (mkApp (mkVar id,[|mkVar id'|])))
 		  gl
 	      with Not_found -> seek_neg rest gl)
diff --git a/tactics/decl_interp.ml b/tactics/decl_interp.ml
index 02dace8377..77357e3fa4 100644
--- a/tactics/decl_interp.ml
+++ b/tactics/decl_interp.ml
@@ -22,18 +22,18 @@ open Pp
 
 (* INTERN *)
 
-let raw_app (loc,hd,args) = if args =[] then hd else RApp(loc,hd,args) 
+let raw_app (loc,hd,args) = if args =[] then hd else RApp(loc,hd,args)
 
-let intern_justification_items globs = 
+let intern_justification_items globs =
   Option.map (List.map (intern_constr globs))
 
-let intern_justification_method globs = 
+let intern_justification_method globs =
   Option.map (intern_tactic globs)
 
 let intern_statement intern_it globs st =
   {st_label=st.st_label;
    st_it=intern_it globs st.st_it}
-    
+
 let intern_no_bind intern_it globs x =
   globs,intern_it globs x
 
@@ -41,22 +41,22 @@ let intern_constr_or_thesis globs = function
     Thesis n -> Thesis n
   | This c -> This (intern_constr globs c)
 
-let add_var id globs= 
+let add_var id globs=
   let l1,l2=globs.ltacvars in
     {globs with ltacvars= (id::l1),(id::l2)}
 
 let add_name nam globs=
- match nam with 
+ match nam with
      Anonymous -> globs
    | Name id -> add_var id globs
 
-let intern_hyp iconstr globs = function 
+let intern_hyp iconstr globs = function
     Hvar (loc,(id,topt)) -> add_var id globs,
       Hvar (loc,(id,Option.map (intern_constr globs) topt))
   | Hprop st -> add_name st.st_label globs,
       Hprop (intern_statement iconstr globs st)
 
-let intern_hyps iconstr globs hyps = 
+let intern_hyps iconstr globs hyps =
   snd (list_fold_map (intern_hyp iconstr) globs hyps)
 
 let intern_cut intern_it globs cut=
@@ -65,32 +65,32 @@ let intern_cut intern_it globs cut=
      cut_by=intern_justification_items nglobs cut.cut_by;
      cut_using=intern_justification_method nglobs cut.cut_using}
 
-let intern_casee globs = function 
+let intern_casee globs = function
     Real c -> Real (intern_constr globs c)
-  | Virtual cut -> Virtual 
-      (intern_cut (intern_no_bind (intern_statement intern_constr)) globs cut) 
+  | Virtual cut -> Virtual
+      (intern_cut (intern_no_bind (intern_statement intern_constr)) globs cut)
 
 let intern_hyp_list args globs =
   let intern_one globs (loc,(id,opttyp)) =
     (add_var id globs),
     (loc,(id,Option.map (intern_constr globs) opttyp)) in
-  list_fold_map intern_one globs args 
+  list_fold_map intern_one globs args
 
-let intern_suffices_clause globs (hyps,c) = 
+let intern_suffices_clause globs (hyps,c) =
   let nglobs,nhyps = list_fold_map (intern_hyp intern_constr) globs hyps in
-    nglobs,(nhyps,intern_constr_or_thesis nglobs c) 
+    nglobs,(nhyps,intern_constr_or_thesis nglobs c)
 
-let intern_fundecl args body globs= 
+let intern_fundecl args body globs=
   let nglobs,nargs = intern_hyp_list args globs in
     nargs,intern_constr nglobs body
-          
+
 let rec add_vars_of_simple_pattern globs = function
     CPatAlias (loc,p,id) ->
       add_vars_of_simple_pattern (add_var id globs) p
-(*      Stdpp.raise_with_loc loc 
+(*      Stdpp.raise_with_loc loc
 	(UserError ("simple_pattern",str "\"as\" is not allowed here"))*)
   | CPatOr (loc, _)->
-      Stdpp.raise_with_loc loc 
+      Stdpp.raise_with_loc loc
 	(UserError ("simple_pattern",str "\"(_ | _)\" is not allowed here"))
   | CPatDelimiters (_,_,p) ->
       add_vars_of_simple_pattern globs p
@@ -99,26 +99,26 @@ let rec add_vars_of_simple_pattern globs = function
   | CPatNotation(_,_,(pl,pll)) ->
       List.fold_left add_vars_of_simple_pattern globs (List.flatten (pl::pll))
   | CPatAtom (_,Some (Libnames.Ident (_,id))) -> add_var id globs
-  |  _  -> globs 
+  |  _  -> globs
 
 let rec intern_bare_proof_instr globs = function
     Pthus i -> Pthus (intern_bare_proof_instr globs i)
   | Pthen i -> Pthen (intern_bare_proof_instr globs i)
   | Phence i -> Phence (intern_bare_proof_instr globs i)
-  | Pcut c -> Pcut 
-      (intern_cut 
+  | Pcut c -> Pcut
+      (intern_cut
 	 (intern_no_bind (intern_statement intern_constr_or_thesis)) globs c)
-  | Psuffices c -> 
+  | Psuffices c ->
       Psuffices (intern_cut intern_suffices_clause globs c)
-  | Prew (s,c) -> Prew 
-      (s,intern_cut 
-	 (intern_no_bind  (intern_statement intern_constr)) globs c) 
+  | Prew (s,c) -> Prew
+      (s,intern_cut
+	 (intern_no_bind  (intern_statement intern_constr)) globs c)
   | Psuppose hyps -> Psuppose (intern_hyps intern_constr globs hyps)
-  | Pcase (params,pat,hyps) -> 
+  | Pcase (params,pat,hyps) ->
       let nglobs,nparams = intern_hyp_list params globs in
       let nnglobs= add_vars_of_simple_pattern nglobs pat in
       let nhyps = intern_hyps intern_constr_or_thesis nnglobs hyps in
-	Pcase (nparams,pat,nhyps) 
+	Pcase (nparams,pat,nhyps)
   | Ptake witl -> Ptake (List.map (intern_constr globs) witl)
   | Pconsider (c,hyps) -> Pconsider (intern_constr globs c,
 				      intern_hyps intern_constr globs hyps)
@@ -130,7 +130,7 @@ let rec intern_bare_proof_instr globs = function
   | Plet hyps -> Plet (intern_hyps intern_constr globs hyps)
   | Pclaim st -> Pclaim (intern_statement intern_constr globs st)
   | Pfocus st -> Pfocus (intern_statement intern_constr globs st)
-  | Pdefine (id,args,body) -> 
+  | Pdefine (id,args,body) ->
       let nargs,nbody = intern_fundecl args body globs in
 	Pdefine (id,nargs,nbody)
   | Pcast (id,typ) ->
@@ -145,10 +145,10 @@ let rec intern_proof_instr globs instr=
 let interp_justification_items sigma env =
     Option.map (List.map (fun c ->understand sigma env (fst c)))
 
-let interp_constr check_sort sigma env c = 
-  if check_sort then 
-    understand_type sigma env (fst c) 
-  else 
+let interp_constr check_sort sigma env c =
+  if check_sort then
+    understand_type sigma env (fst c)
+  else
     understand sigma env (fst c)
 
 let special_whd env =
@@ -162,13 +162,13 @@ let decompose_eq env id =
   let whd = special_whd env typ in
     match kind_of_term whd with
 	App (f,args)->
-	  if eq_constr f _eq && (Array.length args)=3 
+	  if eq_constr f _eq && (Array.length args)=3
 	  then args.(0)
 	  else error "Previous step is not an equality."
       | _ -> error "Previous step is not an equality."
 
 let get_eq_typ info env =
-  let typ = decompose_eq env (get_last env) in  
+  let typ = decompose_eq env (get_last env) in
     typ
 
 let interp_constr_in_type typ sigma env c =
@@ -177,28 +177,28 @@ let interp_constr_in_type typ sigma env c =
 let interp_statement interp_it sigma env st =
   {st_label=st.st_label;
    st_it=interp_it sigma env st.st_it}
-	
+
 let interp_constr_or_thesis check_sort sigma env = function
     Thesis n -> Thesis n
   | This c -> This (interp_constr check_sort sigma env c)
 
-let abstract_one_hyp inject h raw = 
-  match h with 
-      Hvar (loc,(id,None)) ->  
+let abstract_one_hyp inject h raw =
+  match h with
+      Hvar (loc,(id,None)) ->
 	RProd (dummy_loc,Name id, Explicit, RHole (loc,Evd.BinderType (Name id)), raw)
-    | Hvar (loc,(id,Some typ)) ->  
+    | Hvar (loc,(id,Some typ)) ->
 	RProd (dummy_loc,Name id, Explicit, fst typ, raw)
-    | Hprop st -> 
+    | Hprop st ->
 	RProd (dummy_loc,st.st_label, Explicit, inject st.st_it, raw)
 
-let rawconstr_of_hyps inject hyps head = 
+let rawconstr_of_hyps inject hyps head =
   List.fold_right (abstract_one_hyp inject) hyps head
 
 let raw_prop = RSort (dummy_loc,RProp Null)
-  
-let rec match_hyps blend names constr = function 
+
+let rec match_hyps blend names constr = function
     [] -> [],substl names constr
-  | hyp::q -> 
+  | hyp::q ->
       let (name,typ,body)=destProd constr in
       let st= {st_label=name;st_it=substl names typ} in
       let qnames=
@@ -211,7 +211,7 @@ let rec match_hyps blend names constr = function
       let rhyps,head = match_hyps blend qnames body q in
 	qhyp::rhyps,head
 
-let interp_hyps_gen inject blend sigma env hyps head = 
+let interp_hyps_gen inject blend sigma env hyps head =
   let constr=understand sigma env (rawconstr_of_hyps inject hyps head) in
     match_hyps blend [] constr hyps
 
@@ -219,42 +219,42 @@ let interp_hyps sigma env hyps = fst (interp_hyps_gen fst (fun x _ -> x) sigma e
 
 let dummy_prefix= id_of_string "__"
 
-let rec deanonymize ids = 
-  function 
-      PatVar (loc,Anonymous) -> 
+let rec deanonymize ids =
+  function
+      PatVar (loc,Anonymous) ->
 	let (found,known) = !ids in
 	let new_id=Nameops.next_ident_away dummy_prefix known in
 	let _= ids:= (loc,new_id) :: found , new_id :: known in
 	  PatVar (loc,Name new_id)
-    | PatVar (loc,Name id) as pat -> 
+    | PatVar (loc,Name id) as pat ->
 	let (found,known) = !ids in
 	let _= ids:= (loc,id) :: found , known in
 	  pat
-    | PatCstr(loc,cstr,lpat,nam) -> 
+    | PatCstr(loc,cstr,lpat,nam) ->
 	PatCstr(loc,cstr,List.map (deanonymize ids) lpat,nam)
 
 let rec raw_of_pat =
-  function 
-      PatVar (loc,Anonymous) -> anomaly "Anonymous pattern variable" 
-    | PatVar (loc,Name id) -> 
+  function
+      PatVar (loc,Anonymous) -> anomaly "Anonymous pattern variable"
+    | PatVar (loc,Name id) ->
 	  RVar (loc,id)
-    | PatCstr(loc,((ind,_) as cstr),lpat,_) -> 
+    | PatCstr(loc,((ind,_) as cstr),lpat,_) ->
 	let mind= fst (Global.lookup_inductive ind) in
 	let rec add_params n q =
 	  if n<=0 then q else
 	    add_params (pred n) (RHole(dummy_loc,
 				       Evd.TomatchTypeParameter(ind,n))::q) in
-	    let args = List.map raw_of_pat lpat in 
+	    let args = List.map raw_of_pat lpat in
 	      raw_app(loc,RRef(dummy_loc,Libnames.ConstructRef cstr),
-		   add_params mind.Declarations.mind_nparams args) 
-			 
+		   add_params mind.Declarations.mind_nparams args)
+
 let prod_one_hyp = function
     (loc,(id,None)) ->
-      (fun raw ->  
+      (fun raw ->
 	 RProd (dummy_loc,Name id, Explicit,
 		RHole (loc,Evd.BinderType (Name id)), raw))
-  | (loc,(id,Some typ)) -> 
-      (fun raw ->  
+  | (loc,(id,Some typ)) ->
+      (fun raw ->
 	 RProd (dummy_loc,Name id, Explicit, fst typ, raw))
 
 let prod_one_id (loc,id) raw =
@@ -265,13 +265,13 @@ let let_in_one_alias (id,pat) raw =
   RLetIn (dummy_loc,Name id, raw_of_pat pat, raw)
 
 let rec bind_primary_aliases map pat =
-  match pat with 
+  match pat with
       PatVar (_,_) -> map
     | PatCstr(loc,_,lpat,nam) ->
 	let map1 =
-	  match nam with 
+	  match nam with
 	      Anonymous -> map
-	    | Name id -> (id,pat)::map 
+	    | Name id -> (id,pat)::map
 	in
 	  List.fold_left bind_primary_aliases map1 lpat
 
@@ -283,17 +283,17 @@ let bind_aliases patvars subst patt =
   let map1 = bind_secondary_aliases map subst in
   List.rev map1
 
-let interp_pattern env pat_expr = 
+let interp_pattern env pat_expr =
   let patvars,pats = Constrintern.intern_pattern env pat_expr in
-    match pats with 
+    match pats with
 	[] -> anomaly "empty pattern list"
       | [subst,patt] ->
 	  (patvars,bind_aliases patvars subst patt,patt)
       | _  -> anomaly "undetected disjunctive pattern"
 
-let rec match_args dest names constr = function 
+let rec match_args dest names constr = function
     [] -> [],names,substl names constr
-  | _::q -> 
+  | _::q ->
       let (name,typ,body)=dest constr in
       let st={st_label=name;st_it=substl names typ} in
       let qnames=
@@ -303,9 +303,9 @@ let rec match_args dest names constr = function
       let args,bnames,body = match_args dest qnames body q in
 	st::args,bnames,body
 
-let rec match_aliases names constr = function 
+let rec match_aliases names constr = function
     [] -> [],names,substl names constr
-  | _::q -> 
+  | _::q ->
       let (name,c,typ,body)=destLetIn constr in
       let st={st_label=name;st_it=(substl names c,substl names typ)} in
       let qnames=
@@ -324,21 +324,21 @@ let interp_cases info sigma env params (pat:cases_pattern_expr) hyps =
       | _ -> error "No proof per cases/induction/inversion in progress." in
   let mib,oib=Global.lookup_inductive  pinfo.per_ind in
   let num_params = pinfo.per_nparams in
-  let _ = 
+  let _ =
     let expected = mib.Declarations.mind_nparams - num_params in
       if List.length params <> expected then
-	errorlabstrm "suppose it is" 
-	  (str "Wrong number of extra arguments: " ++ 
-	     (if expected = 0 then str "none" else int expected) ++ 
+	errorlabstrm "suppose it is"
+	  (str "Wrong number of extra arguments: " ++
+	     (if expected = 0 then str "none" else int expected) ++
 	     str "expected.") in
   let app_ind =
     let rind = RRef (dummy_loc,Libnames.IndRef pinfo.per_ind) in
-    let rparams = List.map detype_ground pinfo.per_params in 
-    let rparams_rec = 
-      List.map 
-	(fun (loc,(id,_)) -> 
-	   RVar (loc,id)) params in 
-    let dum_args= 
+    let rparams = List.map detype_ground pinfo.per_params in
+    let rparams_rec =
+      List.map
+	(fun (loc,(id,_)) ->
+	   RVar (loc,id)) params in
+    let dum_args=
       list_tabulate (fun _ -> RHole (dummy_loc,Evd.QuestionMark (Evd.Define false)))
 	oib.Declarations.mind_nrealargs in
       raw_app(dummy_loc,rind,rparams@rparams_rec@dum_args) in
@@ -346,22 +346,22 @@ let interp_cases info sigma env params (pat:cases_pattern_expr) hyps =
   let inject = function
       Thesis (Plain) -> Rawterm.RSort(dummy_loc,RProp Null)
     | Thesis (For rec_occ) ->
-	if not (List.mem rec_occ pat_vars) then 
-	  errorlabstrm "suppose it is" 
-	    (str "Variable " ++ Nameops.pr_id rec_occ ++ 
+	if not (List.mem rec_occ pat_vars) then
+	  errorlabstrm "suppose it is"
+	    (str "Variable " ++ Nameops.pr_id rec_occ ++
 	       str " does not occur in pattern.");
 	Rawterm.RSort(dummy_loc,RProp Null)
     | This (c,_) -> c in
   let term1 = rawconstr_of_hyps inject hyps raw_prop in
   let loc_ids,npatt =
     let rids=ref ([],pat_vars) in
-    let npatt= deanonymize rids patt in 
+    let npatt= deanonymize rids patt in
       List.rev (fst !rids),npatt in
   let term2 =
     RLetIn(dummy_loc,Anonymous,
 	   RCast(dummy_loc,raw_of_pat npatt,
 		 CastConv (DEFAULTcast,app_ind)),term1) in
-  let term3=List.fold_right let_in_one_alias aliases term2 in  
+  let term3=List.fold_right let_in_one_alias aliases term2 in
   let term4=List.fold_right prod_one_id loc_ids term3 in
   let term5=List.fold_right prod_one_hyp params term4 in
   let constr = understand  sigma env term5 in
@@ -370,8 +370,8 @@ let interp_cases info sigma env params (pat:cases_pattern_expr) hyps =
   let taliases,nam2,rest2 = match_aliases nam3 rest3 aliases in
   let (_,pat_pat,pat_typ,rest1) = destLetIn rest2 in
   let blend st st' =
-    match st'.st_it with 
-	Thesis nam -> {st_it=Thesis nam;st_label=st'.st_label} 
+    match st'.st_it with
+	Thesis nam -> {st_it=Thesis nam;st_label=st'.st_label}
       | This _ -> {st_it = This st.st_it;st_label=st.st_label} in
   let thyps = fst (match_hyps blend nam2 (Termops.pop rest1) hyps) in
     tparams,{pat_vars=tpatvars;
@@ -383,7 +383,7 @@ let interp_cases info sigma env params (pat:cases_pattern_expr) hyps =
 
 let interp_cut interp_it sigma env cut=
   let nenv,nstat = interp_it sigma env cut.cut_stat in
-    {cut with 
+    {cut with
        cut_stat=nstat;
        cut_by=interp_justification_items sigma nenv cut.cut_by}
 
@@ -393,7 +393,7 @@ let interp_no_bind interp_it sigma env x =
 let interp_suffices_clause sigma env (hyps,cot)=
   let (locvars,_) as res =
     match cot with
-	This (c,_) -> 
+	This (c,_) ->
 	  let nhyps,nc = interp_hyps_gen fst (fun x _ -> x) sigma env hyps c in
 	  nhyps,This nc
       | Thesis Plain as th  -> interp_hyps sigma env hyps,th
@@ -404,26 +404,26 @@ let interp_suffices_clause sigma env (hyps,cot)=
 	  match st.st_label with
 	      Name id -> Environ.push_named (id,None,st.st_it) env0
 	    | _ -> env in
-  let nenv = List.fold_right push_one locvars env in 
-    nenv,res 
-	  
-let interp_casee sigma env = function 
+  let nenv = List.fold_right push_one locvars env in
+    nenv,res
+
+let interp_casee sigma env = function
     Real c -> Real (understand sigma env (fst c))
-  | Virtual cut -> Virtual (interp_cut (interp_no_bind (interp_statement (interp_constr true))) sigma env cut) 
+  | Virtual cut -> Virtual (interp_cut (interp_no_bind (interp_statement (interp_constr true))) sigma env cut)
 
 let abstract_one_arg = function
     (loc,(id,None)) ->
-      (fun raw ->  
-	 RLambda (dummy_loc,Name id, Explicit, 
+      (fun raw ->
+	 RLambda (dummy_loc,Name id, Explicit,
 		RHole (loc,Evd.BinderType (Name id)), raw))
-  | (loc,(id,Some typ)) -> 
-      (fun raw ->  
+  | (loc,(id,Some typ)) ->
+      (fun raw ->
 	 RLambda (dummy_loc,Name id, Explicit, fst typ, raw))
 
-let rawconstr_of_fun args body = 
+let rawconstr_of_fun args body =
   List.fold_right abstract_one_arg args (fst body)
 
-let interp_fun sigma env args body = 
+let interp_fun sigma env args body =
   let constr=understand sigma env (rawconstr_of_fun args body) in
     match_args destLambda [] constr args
 
@@ -431,22 +431,22 @@ let rec interp_bare_proof_instr info (sigma:Evd.evar_map) (env:Environ.env) = fu
     Pthus i -> Pthus (interp_bare_proof_instr info sigma env i)
   | Pthen i -> Pthen (interp_bare_proof_instr info sigma env i)
   | Phence i -> Phence (interp_bare_proof_instr info sigma env i)
-  | Pcut c -> Pcut (interp_cut 
-		      (interp_no_bind (interp_statement 
-					 (interp_constr_or_thesis true))) 
-		      sigma env c) 
-  | Psuffices c ->  
+  | Pcut c -> Pcut (interp_cut
+		      (interp_no_bind (interp_statement
+					 (interp_constr_or_thesis true)))
+		      sigma env c)
+  | Psuffices c ->
       Psuffices (interp_cut interp_suffices_clause sigma env c)
-  | Prew (s,c) -> Prew (s,interp_cut 
-			  (interp_no_bind (interp_statement 
+  | Prew (s,c) -> Prew (s,interp_cut
+			  (interp_no_bind (interp_statement
 			     (interp_constr_in_type (get_eq_typ info env))))
-			  sigma env c) 
+			  sigma env c)
 
   | Psuppose hyps -> Psuppose (interp_hyps sigma env hyps)
-  | Pcase (params,pat,hyps) -> 
-      let tparams,tpat,thyps = interp_cases info sigma env params pat hyps in 
+  | Pcase (params,pat,hyps) ->
+      let tparams,tpat,thyps = interp_cases info sigma env params pat hyps in
 	Pcase (tparams,tpat,thyps)
-  | Ptake witl -> 
+  | Ptake witl ->
       Ptake (List.map (fun c -> understand sigma env (fst c)) witl)
   | Pconsider (c,hyps) -> Pconsider (interp_constr false sigma env c,
 				     interp_hyps sigma env hyps)
@@ -458,15 +458,15 @@ let rec interp_bare_proof_instr info (sigma:Evd.evar_map) (env:Environ.env) = fu
   | Plet hyps -> Plet (interp_hyps sigma env hyps)
   | Pclaim st -> Pclaim (interp_statement (interp_constr true) sigma env st)
   | Pfocus st -> Pfocus (interp_statement (interp_constr true) sigma env st)
-  | Pdefine (id,args,body) -> 
+  | Pdefine (id,args,body) ->
       let nargs,_,nbody = interp_fun sigma env args body in
 	Pdefine (id,nargs,nbody)
-  | Pcast (id,typ) -> 
+  | Pcast (id,typ) ->
       Pcast(id,interp_constr true sigma env typ)
 
 let rec interp_proof_instr info sigma env instr=
   {emph = instr.emph;
    instr = interp_bare_proof_instr info sigma env instr.instr}
- 
+
 
 
diff --git a/tactics/decl_proof_instr.ml b/tactics/decl_proof_instr.ml
index 515b184daf..c2a32471e1 100644
--- a/tactics/decl_proof_instr.ml
+++ b/tactics/decl_proof_instr.ml
@@ -36,27 +36,27 @@ open Goptions
 
 let get_its_info gls = get_info gls.it
 
-let get_strictness,set_strictness = 
+let get_strictness,set_strictness =
   let strictness = ref false in
     (fun () -> (!strictness)),(fun b -> strictness:=b)
 
 let _ =
-  declare_bool_option 
+  declare_bool_option
     { optsync  = true;
       optname  = "strict mode";
       optkey   = ["Strict";"Proofs"];
       optread  = get_strictness;
       optwrite = set_strictness }
 
-let tcl_change_info_gen info_gen = 
+let tcl_change_info_gen info_gen =
   (fun gls ->
-  let gl =sig_it gls in  
-    {it=[{gl with evar_extra=info_gen}];sigma=sig_sig gls}, 
-  function 
+  let gl =sig_it gls in
+    {it=[{gl with evar_extra=info_gen}];sigma=sig_sig gls},
+  function
       [pftree] ->
 	{pftree with
 	   goal=gl;
-	   ref=Some (Prim Change_evars,[pftree])} 
+	   ref=Some (Prim Change_evars,[pftree])}
     | _ -> anomaly "change_info : Wrong number of subtrees")
 
 let tcl_change_info info gls =  tcl_change_info_gen (Some (pm_in info)) gls
@@ -78,27 +78,27 @@ let is_good_inductive env ind =
 let check_not_per pts =
   if not (Proof_trees.is_complete_proof (proof_of_pftreestate pts)) then
     match get_stack pts with
-	Per (_,_,_,_)::_ -> 
+	Per (_,_,_,_)::_ ->
 	  error "You are inside a proof per cases/induction.\n\
 Please \"suppose\" something or \"end\" it now."
       | _ -> ()
 
 let mk_evd metalist gls =
   let evd0= create_goal_evar_defs (sig_sig gls) in
-  let add_one (meta,typ) evd = 
+  let add_one (meta,typ) evd =
     meta_declare meta typ evd in
     List.fold_right add_one metalist evd0
 
-let is_tmp id = (string_of_id id).[0] = '_'    
+let is_tmp id = (string_of_id id).[0] = '_'
 
-let tmp_ids gls = 
+let tmp_ids gls =
   let ctx = pf_hyps gls in
-    match ctx with 
+    match ctx with
 	[] -> []
-      | _::q -> List.filter is_tmp (ids_of_named_context q) 
+      | _::q -> List.filter is_tmp (ids_of_named_context q)
 
-let clean_tmp gls = 
-  let clean_id id0 gls0 = 
+let clean_tmp gls =
+  let clean_id id0 gls0 =
       tclTRY (clear [id0]) gls0 in
   let rec clean_all = function
       [] -> tclIDTAC
@@ -114,30 +114,30 @@ let assert_postpone id t =
 let start_proof_tac gls=
   let gl=sig_it gls in
   let info={pm_stack=[]} in
-    {it=[{gl with evar_extra=Some (pm_in info)}];sigma=sig_sig gls}, 
-  function 
+    {it=[{gl with evar_extra=Some (pm_in info)}];sigma=sig_sig gls},
+  function
       [pftree] ->
 	{pftree with
 	   goal=gl;
-	   ref=Some (Decl_proof true,[pftree])} 
+	   ref=Some (Decl_proof true,[pftree])}
     | _ -> anomaly "Dem : Wrong number of subtrees"
 
-let go_to_proof_mode () = 
-  Pfedit.mutate 
+let go_to_proof_mode () =
+  Pfedit.mutate
     (fun pts -> nth_unproven 1 (solve_pftreestate start_proof_tac pts))
 
 (* closing gaps *)
 
 let daimon_tac gls =
   set_daimon_flag ();
-  ({it=[];sigma=sig_sig gls}, 
-   function 
+  ({it=[];sigma=sig_sig gls},
+   function
        [] ->
 	 {open_subgoals=0;
 	    goal=sig_it gls;
-	    ref=Some (Daimon,[])} 
+	    ref=Some (Daimon,[])}
      | _ -> anomaly "Daimon: Wrong number of subtrees")
-    
+
 let daimon _ pftree =
   set_daimon_flag ();
   {pftree with
@@ -150,7 +150,7 @@ let daimon_subtree = map_pftreestate (fun _ ->  frontier_mapi daimon )
 
 let rec is_focussing_instr = function
     Pthus i | Pthen i | Phence i -> is_focussing_instr i
-  | Pescape | Pper _ | Pclaim _ | Pfocus _ 
+  | Pescape | Pper _ | Pclaim _ | Pfocus _
   | Psuppose _ | Pcase (_,_,_)  -> true
   | _ -> false
 
@@ -158,7 +158,7 @@ let mark_rule_as_done = function
     Decl_proof true -> Decl_proof false
   | Decl_proof false ->
       anomaly "already marked as done"
-  | Nested(Proof_instr (lock_focus,instr),spfl) -> 
+  | Nested(Proof_instr (lock_focus,instr),spfl) ->
       if lock_focus then
 	Nested(Proof_instr (false,instr),spfl)
       else
@@ -168,34 +168,34 @@ let mark_rule_as_done = function
 let mark_proof_tree_as_done pt =
   match pt.ref with
       None -> anomaly "mark_proof_tree_as_done"
-    | Some (r,spfl) -> 
+    | Some (r,spfl) ->
 	{pt with ref= Some (mark_rule_as_done r,spfl)}
 
-let mark_as_done pts = 
-  map_pftreestate 
-    (fun _ -> mark_proof_tree_as_done) 
+let mark_as_done pts =
+  map_pftreestate
+    (fun _ -> mark_proof_tree_as_done)
     (up_to_matching_rule is_focussing_command pts)
 
 (* post-instruction focus management *)
 
 let goto_current_focus pts = up_until_matching_rule is_focussing_command pts
 
-let goto_current_focus_or_top pts = 
-  try 
+let goto_current_focus_or_top pts =
+  try
     up_until_matching_rule is_focussing_command pts
   with Not_found -> top_of_tree pts
 
 (* return *)
 
 let close_tactic_mode pts =
-    let pts1=  
-      try goto_current_focus pts 
-      with Not_found -> 
+    let pts1=
+      try goto_current_focus pts
+      with Not_found ->
 	error "\"return\" cannot be used outside of Declarative Proof Mode." in
     let pts2 = daimon_subtree pts1 in
-    let pts3 = mark_as_done pts2 in 
-      goto_current_focus pts3 
-	  
+    let pts3 = mark_as_done pts2 in
+      goto_current_focus pts3
+
 let return_from_tactic_mode () = Pfedit.mutate close_tactic_mode
 
 (* end proof/claim *)
@@ -207,11 +207,11 @@ let close_block bt pts =
     else
       get_stack pts in
     match bt,stack with
-	B_claim, Claim::_ | B_focus, Focus_claim::_ | B_proof, [] -> 
+	B_claim, Claim::_ | B_focus, Focus_claim::_ | B_proof, [] ->
 	  daimon_subtree (goto_current_focus pts)
-      | _, Claim::_ -> 
+      | _, Claim::_ ->
 	  error "\"end claim\" expected."
-      | _, Focus_claim::_ -> 
+      | _, Focus_claim::_ ->
 	  error "\"end focus\" expected."
       | _, [] ->
  	  error "\"end proof\" expected."
@@ -225,18 +225,18 @@ let close_block bt pts =
 
 (* utility for suppose / suppose it is *)
 
-let close_previous_case pts = 
-  if 
-    Proof_trees.is_complete_proof (proof_of_pftreestate pts) 
+let close_previous_case pts =
+  if
+    Proof_trees.is_complete_proof (proof_of_pftreestate pts)
   then
     match get_top_stack pts with
-	Per (et,_,_,_) :: _ -> anomaly "Weird case occured ..."  
-      | Suppose_case :: Per (et,_,_,_) :: _ -> 
+	Per (et,_,_,_) :: _ -> anomaly "Weird case occured ..."
+      | Suppose_case :: Per (et,_,_,_) :: _ ->
 	  goto_current_focus (mark_as_done pts)
-      | _ -> error "Not inside a proof per cases or induction."   
+      | _ -> error "Not inside a proof per cases or induction."
   else
     match get_stack pts with
-	Per (et,_,_,_) :: _ -> pts 
+	Per (et,_,_,_) :: _ -> pts
       | Suppose_case :: Per (et,_,_,_) :: _ ->
 	  goto_current_focus (mark_as_done (daimon_subtree pts))
       | _ -> error "Not inside a proof per cases or induction."
@@ -246,10 +246,10 @@ let close_previous_case pts =
 (* automation *)
 
 let filter_hyps f gls =
-  let filter_aux (id,_,_) = 
-    if f id then 
+  let filter_aux (id,_,_) =
+    if f id then
       tclIDTAC
-    else 
+    else
       tclTRY (clear [id])  in
     tclMAP filter_aux (Environ.named_context_of_val gls.it.evar_hyps) gls
 
@@ -257,16 +257,16 @@ let local_hyp_prefix = id_of_string "___"
 
 let add_justification_hyps keep items gls =
   let add_aux c gls=
-    match kind_of_term c with 
-	Var id -> 
+    match kind_of_term c with
+	Var id ->
 	  keep:=Idset.add id !keep;
-	  tclIDTAC gls 
-      | _ -> 
-	  let id=pf_get_new_id local_hyp_prefix gls in 
-	    keep:=Idset.add id !keep; 
+	  tclIDTAC gls
+      | _ ->
+	  let id=pf_get_new_id local_hyp_prefix gls in
+	    keep:=Idset.add id !keep;
 	    tclTHEN (letin_tac None (Names.Name id) c None Tacexpr.nowhere)
-              (thin_body [id]) gls in 
-    tclMAP add_aux items gls   
+              (thin_body [id]) gls in
+    tclMAP add_aux items gls
 
 let prepare_goal items gls =
   let tokeep = ref Idset.empty in
@@ -275,18 +275,18 @@ let prepare_goal items gls =
      [ (fun _ -> auxres);
        filter_hyps (let keep = !tokeep in fun id -> Idset.mem id keep)] gls
 
-let my_automation_tac = ref 
+let my_automation_tac = ref
   (fun gls -> anomaly "No automation registered")
 
 let register_automation_tac tac = my_automation_tac:= tac
 
 let automation_tac gls = !my_automation_tac gls
 
-let justification tac gls= 
-    tclORELSE 
-      (tclSOLVE [tclTHEN tac assumption]) 
-      (fun gls -> 
-	 if get_strictness () then 
+let justification tac gls=
+    tclORELSE
+      (tclSOLVE [tclTHEN tac assumption])
+      (fun gls ->
+	 if get_strictness () then
 	   error "Insufficient justification."
 	 else
 	   begin
@@ -340,44 +340,44 @@ let enstack_subsubgoals env se stack gls=
 	    Inductive.lookup_mind_specif env ind in
           let gentypes=
             Inductive.arities_of_constructors ind (mib,oib) in
-	  let process i gentyp = 
-	    let constructor = mkConstruct(ind,succ i) 
+	  let process i gentyp =
+	    let constructor = mkConstruct(ind,succ i)
 	      (* constructors numbering*) in
 	    let appterm = applist (constructor,params) in
 	    let apptype = Term.prod_applist gentyp params in
 	    let rc,_ = Reduction.dest_prod env apptype in
-	    let rec meta_aux last lenv = function 
+	    let rec meta_aux last lenv = function
 		[] -> (last,lenv,[])
 	      | (nam,_,typ)::q ->
 		  let nlast=succ last in
 		  let (llast,holes,metas) =
 		    meta_aux nlast (mkMeta nlast :: lenv) q in
 		    (llast,holes,(nlast,special_nf gls (substl lenv typ))::metas) in
-	    let (nlast,holes,nmetas) = 
+	    let (nlast,holes,nmetas) =
 		meta_aux se.se_last_meta [] (List.rev rc) in
 	    let refiner = applist (appterm,List.rev holes) in
-	    let evd = meta_assign se.se_meta 
+	    let evd = meta_assign se.se_meta
               (refiner,(ConvUpToEta 0,TypeProcessed (* ? *))) se.se_evd in
-	    let ncreated = replace_in_list 
+	    let ncreated = replace_in_list
 	      se.se_meta nmetas se.se_meta_list in
-	    let evd0 = List.fold_left 
-	      (fun evd (m,typ) -> meta_declare m typ evd) evd nmetas in  
-	      List.iter (fun (m,typ) -> 
-			   Stack.push 
+	    let evd0 = List.fold_left
+	      (fun evd (m,typ) -> meta_declare m typ evd) evd nmetas in
+	      List.iter (fun (m,typ) ->
+			   Stack.push
 			     {se_meta=m;
 			      se_type=typ;
 			      se_evd=evd0;
 			      se_meta_list=ncreated;
-			      se_last_meta=nlast} stack) (List.rev nmetas) 
+			      se_last_meta=nlast} stack) (List.rev nmetas)
 	  in
 	    Array.iteri process gentypes
       | _ -> ()
 
-let rec nf_list evd = 
+let rec nf_list evd =
   function
-      [] -> []  
-    | (m,typ)::others -> 
-	if meta_defined evd m then 
+      [] -> []
+    | (m,typ)::others ->
+	if meta_defined evd m then
 	    nf_list evd others
 	else
 	  (m,nf_meta evd typ)::nf_list evd others
@@ -387,29 +387,29 @@ let find_subsubgoal c ctyp skip submetas gls =
   let concl = pf_concl gls in
   let evd = mk_evd ((0,concl)::submetas) gls in
   let stack = Stack.create () in
-  let max_meta = 
+  let max_meta =
       List.fold_left (fun a (m,_) -> max a m) 0 submetas in
-  let _ = Stack.push 
+  let _ = Stack.push
 		{se_meta=0;
 		 se_type=concl;
 		 se_last_meta=max_meta;
 		 se_meta_list=[0,concl];
 		 se_evd=evd} stack  in
-  let rec dfs n = 
+  let rec dfs n =
     let se = Stack.pop stack in
-      try 
-	let unifier = 
-	  Unification.w_unify true env Reduction.CUMUL 
+      try
+	let unifier =
+	  Unification.w_unify true env Reduction.CUMUL
 	    ctyp se.se_type se.se_evd in
-	  if n <= 0 then 
-	      {se with 
+	  if n <= 0 then
+	      {se with
 		 se_evd=meta_assign se.se_meta
                   (c,(ConvUpToEta 0,TypeNotProcessed (* ?? *))) unifier;
-	         se_meta_list=replace_in_list 
+	         se_meta_list=replace_in_list
 		  se.se_meta submetas se.se_meta_list}
 	  else
 	      dfs (pred n)
-      with _ -> 
+      with _ ->
 	begin
 	  enstack_subsubgoals env se stack gls;
 	  dfs n
@@ -421,20 +421,20 @@ let concl_refiner metas body gls =
   let concl = pf_concl gls in
   let evd = sig_sig gls in
   let env = pf_env gls in
-  let sort = family_of_sort (Typing.sort_of env evd concl) in  
+  let sort = family_of_sort (Typing.sort_of env evd concl) in
   let rec aux env avoid subst = function
       [] -> anomaly "concl_refiner: cannot happen"
     | (n,typ)::rest ->
-	let _A = subst_meta subst typ in 
-	let x = id_of_name_using_hdchar env _A Anonymous in 
+	let _A = subst_meta subst typ in
+	let x = id_of_name_using_hdchar env _A Anonymous in
 	let _x = fresh_id avoid x gls in
 	let nenv = Environ.push_named (_x,None,_A) env in
 	let asort = family_of_sort (Typing.sort_of nenv evd _A) in
 	let nsubst = (n,mkVar _x)::subst in
-	  if rest = [] then 
+	  if rest = [] then
 	    asort,_A,mkNamedLambda _x _A (subst_meta nsubst body)
 	  else
-	    let bsort,_B,nbody = 
+	    let bsort,_B,nbody =
 	      aux nenv (_x::avoid) ((n,mkVar _x)::subst) rest in
 	    let body = mkNamedLambda _x _A nbody in
 	      if occur_term (mkVar _x) _B then
@@ -450,7 +450,7 @@ let concl_refiner metas body gls =
 			let _P0 = mkLambda(Anonymous,_AxB,concl) in
 			  InType,_AxB,
 			mkApp(Lazy.force _sig_rect,[|_A;_P;_P0;body|])
-		    | _,_ -> 
+		    | _,_ ->
 			let _AxB = mkApp(Lazy.force _sigT,[|_A;_P|]) in
 			let _P0 = mkLambda(Anonymous,_AxB,concl) in
 			  InType,_AxB,
@@ -473,23 +473,23 @@ let concl_refiner metas body gls =
   let (_,_,prf) = aux env [] [] metas in
     mkApp(prf,[|mkMeta 1|])
 
-let thus_tac c ctyp submetas gls =  
-  let list,proof = 
+let thus_tac c ctyp submetas gls =
+  let list,proof =
     try
       find_subsubgoal c ctyp 0 submetas gls
-    with Not_found -> 
+    with Not_found ->
       error "I could not relate this statement to the thesis." in
   if list = [] then
-    exact_check proof gls 
+    exact_check proof gls
   else
     let refiner = concl_refiner list proof gls in
       Tactics.refine refiner gls
 
 (* general forward step *)
 
-let mk_stat_or_thesis info gls = function  
+let mk_stat_or_thesis info gls = function
     This c -> c
-  | Thesis (For _ ) -> 
+  | Thesis (For _ ) ->
       error "\"thesis for ...\" is not applicable here."
   | Thesis Plain -> pf_concl gls
 
@@ -497,34 +497,34 @@ let just_tac _then cut info gls0 =
   let items_tac gls =
     match cut.cut_by with
 	None -> tclIDTAC gls
-      | Some items -> 
-	  let items_ = 
-	    if _then then 
+      | Some items ->
+	  let items_ =
+	    if _then then
 	      let last_id = get_last (pf_env gls) in
 		(mkVar last_id)::items
-	    else items 
+	    else items
 	  in prepare_goal items_ gls in
-  let method_tac gls = 
+  let method_tac gls =
     match cut.cut_using with
-        None ->	
+        None ->
 	  automation_tac gls
-      | Some tac -> 
+      | Some tac ->
 	  (Tacinterp.eval_tactic tac) gls in
     justification (tclTHEN items_tac method_tac) gls0
-			
-let instr_cut mkstat _thus _then cut gls0 = 
-  let info = get_its_info gls0 in 
+
+let instr_cut mkstat _thus _then cut gls0 =
+  let info = get_its_info gls0 in
   let stat = cut.cut_stat in
-  let (c_id,_) = match stat.st_label with 
-      Anonymous -> 
-	pf_get_new_id (id_of_string "_fact") gls0,false 
+  let (c_id,_) = match stat.st_label with
+      Anonymous ->
+	pf_get_new_id (id_of_string "_fact") gls0,false
     | Name id -> id,true in
   let c_stat = mkstat info gls0 stat.st_it in
-  let thus_tac gls= 
-    if _thus then 
+  let thus_tac gls=
+    if _thus then
       thus_tac (mkVar c_id) c_stat [] gls
     else tclIDTAC gls in
-    tclTHENS (assert_postpone c_id c_stat) 
+    tclTHENS (assert_postpone c_id c_stat)
       [tclTHEN tcl_erase_info (just_tac _then cut info);
        thus_tac] gls0
 
@@ -538,162 +538,162 @@ let decompose_eq id gls =
   let whd =  (special_whd gls typ) in
     match kind_of_term whd with
 	App (f,args)->
-	  if eq_constr f _eq && (Array.length args)=3 
+	  if eq_constr f _eq && (Array.length args)=3
 	  then (args.(0),
-		args.(1), 
-		args.(2)) 
+		args.(1),
+		args.(2))
 	  else error "Previous step is not an equality."
       | _ -> error "Previous step is not an equality."
-	  
-let instr_rew _thus rew_side cut gls0 = 
-  let last_id = 
+
+let instr_rew _thus rew_side cut gls0 =
+  let last_id =
     try get_last (pf_env gls0) with _ -> error "No previous equality." in
-  let typ,lhs,rhs = decompose_eq last_id gls0 in  
+  let typ,lhs,rhs = decompose_eq last_id gls0 in
   let items_tac gls =
     match cut.cut_by with
 	None -> tclIDTAC gls
       | Some items -> prepare_goal items gls in
-  let method_tac gls = 
+  let method_tac gls =
     match cut.cut_using with
-        None ->	
+        None ->
 	  automation_tac gls
-      | Some tac -> 
+      | Some tac ->
 	  (Tacinterp.eval_tactic tac) gls in
   let just_tac gls =
     justification (tclTHEN items_tac method_tac) gls in
-  let (c_id,_) = match cut.cut_stat.st_label with 
-      Anonymous -> 
-	pf_get_new_id (id_of_string "_eq") gls0,false 
+  let (c_id,_) = match cut.cut_stat.st_label with
+      Anonymous ->
+	pf_get_new_id (id_of_string "_eq") gls0,false
     | Name id -> id,true in
-  let thus_tac new_eq gls= 
-    if _thus then 
+  let thus_tac new_eq gls=
+    if _thus then
       thus_tac (mkVar c_id) new_eq [] gls
     else tclIDTAC gls in
-    match rew_side with 
+    match rew_side with
 	Lhs ->
 	  let new_eq = mkApp(_eq,[|typ;cut.cut_stat.st_it;rhs|]) in
-	    tclTHENS (assert_postpone c_id new_eq) 
-	      [tclTHEN tcl_erase_info 
-		 (tclTHENS (transitivity lhs) 
+	    tclTHENS (assert_postpone c_id new_eq)
+	      [tclTHEN tcl_erase_info
+		 (tclTHENS (transitivity lhs)
 		    [just_tac;exact_check (mkVar last_id)]);
 	       thus_tac new_eq] gls0
       | Rhs ->
 	  let new_eq = mkApp(_eq,[|typ;lhs;cut.cut_stat.st_it|]) in
-	    tclTHENS (assert_postpone c_id new_eq) 
-	      [tclTHEN tcl_erase_info 
-		 (tclTHENS (transitivity rhs) 
+	    tclTHENS (assert_postpone c_id new_eq)
+	      [tclTHEN tcl_erase_info
+		 (tclTHENS (transitivity rhs)
 		    [exact_check (mkVar last_id);just_tac]);
 	       thus_tac new_eq] gls0
-	      
+
 
 
 (* tactics for claim/focus *)
 
-let instr_claim _thus st gls0 = 
-  let info = get_its_info gls0 in  
-  let (id,_) = match st.st_label with 
-      Anonymous -> pf_get_new_id (id_of_string "_claim") gls0,false 
+let instr_claim _thus st gls0 =
+  let info = get_its_info gls0 in
+  let (id,_) = match st.st_label with
+      Anonymous -> pf_get_new_id (id_of_string "_claim") gls0,false
     | Name id -> id,true in
-  let thus_tac gls= 
-    if _thus then 
+  let thus_tac gls=
+    if _thus then
       thus_tac (mkVar id) st.st_it [] gls
     else tclIDTAC gls in
   let ninfo1 = {pm_stack=
       (if _thus then Focus_claim else Claim)::info.pm_stack} in
-    tclTHENS (assert_postpone id st.st_it) 
+    tclTHENS (assert_postpone id st.st_it)
       [tcl_change_info ninfo1;
        thus_tac] gls0
 
 (* tactics for assume *)
 
-let push_intro_tac coerce nam gls = 
+let push_intro_tac coerce nam gls =
       let (hid,_) =
-	match nam with 
-	    Anonymous -> pf_get_new_id (id_of_string "_hyp") gls,false 
+	match nam with
+	    Anonymous -> pf_get_new_id (id_of_string "_hyp") gls,false
 	  | Name id -> id,true in
-	tclTHENLIST 
+	tclTHENLIST
 	  [intro_mustbe_force hid;
 	   coerce hid]
-	  gls 
-
-let assume_tac hyps gls = 
-  List.fold_right 
-    (fun (Hvar st | Hprop st) -> 
-       tclTHEN 
-	 (push_intro_tac 
-	    (fun id -> 
+	  gls
+
+let assume_tac hyps gls =
+  List.fold_right
+    (fun (Hvar st | Hprop st) ->
+       tclTHEN
+	 (push_intro_tac
+	    (fun id ->
 	       convert_hyp (id,None,st.st_it)) st.st_label))
-	 hyps tclIDTAC gls 
-
-let assume_hyps_or_theses hyps gls = 
-  List.fold_right 
-    (function 
-	 (Hvar {st_label=nam;st_it=c} | Hprop {st_label=nam;st_it=This c}) -> 
-	   tclTHEN 
-	     (push_intro_tac 
-		(fun id -> 
+	 hyps tclIDTAC gls
+
+let assume_hyps_or_theses hyps gls =
+  List.fold_right
+    (function
+	 (Hvar {st_label=nam;st_it=c} | Hprop {st_label=nam;st_it=This c}) ->
+	   tclTHEN
+	     (push_intro_tac
+		(fun id ->
 		   convert_hyp (id,None,c)) nam)
-       | Hprop {st_label=nam;st_it=Thesis (tk)} -> 
-	   tclTHEN 
-	     (push_intro_tac 
+       | Hprop {st_label=nam;st_it=Thesis (tk)} ->
+	   tclTHEN
+	     (push_intro_tac
 		(fun id -> tclIDTAC) nam))
-    hyps tclIDTAC gls 
+    hyps tclIDTAC gls
 
-let assume_st hyps gls = 
-  List.fold_right 
-    (fun st -> 
-       tclTHEN 
-	 (push_intro_tac 
+let assume_st hyps gls =
+  List.fold_right
+    (fun st ->
+       tclTHEN
+	 (push_intro_tac
 	    (fun id -> convert_hyp (id,None,st.st_it)) st.st_label))
-	 hyps tclIDTAC gls 
-
-let assume_st_letin hyps gls = 
-  List.fold_right 
-    (fun st -> 
-       tclTHEN 
-	 (push_intro_tac 
-	    (fun id -> 
+	 hyps tclIDTAC gls
+
+let assume_st_letin hyps gls =
+  List.fold_right
+    (fun st ->
+       tclTHEN
+	 (push_intro_tac
+	    (fun id ->
 	       convert_hyp (id,Some (fst st.st_it),snd st.st_it)) st.st_label))
-	 hyps tclIDTAC gls 
+	 hyps tclIDTAC gls
 
 (* suffices *)
 
-let rec metas_from n hyps = 
+let rec metas_from n hyps =
   match hyps with
       _ :: q -> n :: metas_from (succ n) q
     | [] -> []
- 
+
 let rec build_product args body =
-  match args with 
-      (Hprop st| Hvar st )::rest -> 
+  match args with
+      (Hprop st| Hvar st )::rest ->
 	let pprod= lift 1 (build_product rest body) in
 	let lbody =
 	  match st.st_label with
 	      Anonymous -> pprod
 	    | Name id -> subst_term (mkVar id) pprod in
 	  mkProd (st.st_label, st.st_it, lbody)
-    | [] -> body 
+    | [] -> body
 
 let rec build_applist prod = function
     [] -> [],prod
-  | n::q -> 
+  | n::q ->
       let (_,typ,_) = destProd prod in
       let ctx,head = build_applist (Term.prod_applist prod [mkMeta n]) q in
 	(n,typ)::ctx,head
 
-let instr_suffices _then cut gls0 = 
-  let info = get_its_info gls0 in 
-  let c_id = pf_get_new_id (id_of_string "_cofact") gls0 in 
+let instr_suffices _then cut gls0 =
+  let info = get_its_info gls0 in
+  let c_id = pf_get_new_id (id_of_string "_cofact") gls0 in
   let ctx,hd = cut.cut_stat in
   let c_stat = build_product ctx (mk_stat_or_thesis info gls0 hd) in
   let metas = metas_from 1 ctx in
   let c_ctx,c_head = build_applist c_stat metas in
-  let c_term = applist (mkVar c_id,List.map mkMeta metas) in  
-  let thus_tac gls= 
+  let c_term = applist (mkVar c_id,List.map mkMeta metas) in
+  let thus_tac gls=
     thus_tac c_term c_head c_ctx gls in
-   tclTHENS (assert_postpone c_id c_stat) 
-     [tclTHENLIST 
-	 [ assume_tac ctx;   
+   tclTHENS (assert_postpone c_id c_stat)
+     [tclTHENLIST
+	 [ assume_tac ctx;
 	   tcl_erase_info;
 	   just_tac _then cut info];
       thus_tac] gls0
@@ -703,7 +703,7 @@ let instr_suffices _then cut gls0 =
 let conjunction_arity id gls =
   let typ = pf_get_hyp_typ gls id  in
   let hd,params = decompose_app (special_whd gls typ) in
-  let env =pf_env gls in 
+  let env =pf_env gls in
     match kind_of_term hd with
 	Ind ind when is_good_inductive env ind ->
 	  let mib,oib=
@@ -716,70 +716,70 @@ let conjunction_arity id gls =
 	    List.length rc
       | _ -> raise Not_found
 
-let rec intron_then n ids ltac gls = 
-  if n<=0 then 
+let rec intron_then n ids ltac gls =
+  if n<=0 then
     ltac ids gls
-  else  
-    let id = pf_get_new_id (id_of_string "_tmp") gls in 
-      tclTHEN 
-	(intro_mustbe_force id) 
-	(intron_then (pred n) (id::ids) ltac) gls 
+  else
+    let id = pf_get_new_id (id_of_string "_tmp") gls in
+      tclTHEN
+	(intro_mustbe_force id)
+	(intron_then (pred n) (id::ids) ltac) gls
 
 
 let rec consider_match may_intro introduced available expected gls =
-  match available,expected with 
+  match available,expected with
       [],[] ->
 	  tclIDTAC gls
     | _,[] -> error "Last statements do not match a complete hypothesis."
 	(* should tell which ones *)
-    | [],hyps -> 
+    | [],hyps ->
 	if may_intro then
 	  begin
  	    let id = pf_get_new_id (id_of_string "_tmp") gls in
-	      tclIFTHENELSE 
+	      tclIFTHENELSE
 		(intro_mustbe_force id)
-		(consider_match true [] [id] hyps) 
-		(fun _ -> 
+		(consider_match true [] [id] hyps)
+		(fun _ ->
 		   error "Not enough sub-hypotheses to match statements.")
-		gls 
-          end 
+		gls
+          end
 	else
 	  error "Not enough sub-hypotheses to match statements."
 	    (* should tell which ones *)
     | id::rest_ids,(Hvar st | Hprop st)::rest ->
 	tclIFTHENELSE (convert_hyp (id,None,st.st_it))
 	  begin
-	    match st.st_label with 
-		Anonymous -> 
+	    match st.st_label with
+		Anonymous ->
 		  consider_match may_intro ((id,false)::introduced) rest_ids rest
-	      | Name hid -> 
-		  tclTHENLIST 
+	      | Name hid ->
+		  tclTHENLIST
 		    [rename_hyp [id,hid];
 		     consider_match may_intro ((hid,true)::introduced) rest_ids rest]
 	  end
 	  begin
-	    (fun gls -> 
+	    (fun gls ->
 	       let nhyps =
-		 try conjunction_arity id gls with 
-		     Not_found -> error "Matching hypothesis not found." in 
-		 tclTHENLIST 
+		 try conjunction_arity id gls with
+		     Not_found -> error "Matching hypothesis not found." in
+		 tclTHENLIST
 		   [general_case_analysis false (mkVar id,NoBindings);
 		    intron_then nhyps []
-		      (fun l -> consider_match may_intro introduced 
+		      (fun l -> consider_match may_intro introduced
 			 (List.rev_append l rest_ids) expected)] gls)
 	  end
 	  gls
-	  
+
 let consider_tac c hyps gls =
   match kind_of_term (strip_outer_cast c) with
       Var id ->
-	consider_match false [] [id] hyps gls 
-    | _ -> 
+	consider_match false [] [id] hyps gls
+    | _ ->
 	let id = pf_get_new_id (id_of_string "_tmp") gls in
-	tclTHEN 
+	tclTHEN
 	  (forward None (Some (dummy_loc, Genarg.IntroIdentifier id)) c)
- 	  (consider_match false [] [id] hyps) gls 
-	  
+ 	  (consider_match false [] [id] hyps) gls
+
 
 let given_tac hyps gls =
   consider_match true [] [] hyps gls
@@ -789,22 +789,22 @@ let given_tac hyps gls =
 let rec take_tac wits gls =
   match wits with
       [] -> tclIDTAC gls
-    | wit::rest ->  
-	let typ = pf_type_of gls wit in  
+    | wit::rest ->
+	let typ = pf_type_of gls wit in
 	  tclTHEN (thus_tac wit typ []) (take_tac rest)  gls
 
 
 (* tactics for define *)
 
 let rec build_function args body =
-  match args with 
-      st::rest -> 
+  match args with
+      st::rest ->
 	let pfun= lift 1 (build_function rest body) in
 	let id = match st.st_label with
 	    Anonymous -> assert false
 	  | Name id -> id in
 	  mkLambda (Name id, st.st_it, subst_term (mkVar id) pfun)
-    | [] -> body 
+    | [] -> body
 
 let define_tac id args body gls =
   let t = build_function args body in
@@ -812,37 +812,37 @@ let define_tac id args body gls =
 
 (* tactics for reconsider *)
 
-let cast_tac id_or_thesis typ gls = 
+let cast_tac id_or_thesis typ gls =
   match id_or_thesis with
       This id ->
 	let (_,body,_) = pf_get_hyp gls id in
 	  convert_hyp (id,body,typ) gls
-    | Thesis (For _ ) -> 
+    | Thesis (For _ ) ->
 	error "\"thesis for ...\" is not applicable here."
-    | Thesis Plain ->    
+    | Thesis Plain ->
           convert_concl typ DEFAULTcast gls
-      
+
 (* per cases *)
 
 let is_rec_pos (main_ind,wft) =
   match main_ind with
       None -> false
-    | Some index -> 
+    | Some index ->
 	match fst (Rtree.dest_node wft) with
 	    Mrec i when i = index -> true
 	  | _ -> false
 
 let rec constr_trees (main_ind,wft) ind =
     match Rtree.dest_node wft with
-      Norec,_ -> 
-	let itree = 
-	  (snd (Global.lookup_inductive ind)).mind_recargs in 
+      Norec,_ ->
+	let itree =
+	  (snd (Global.lookup_inductive ind)).mind_recargs in
 	  constr_trees (None,itree) ind
     | _,constrs -> main_ind,constrs
 
 let ind_args rp ind =
     let main_ind,constrs = constr_trees rp ind in
-    let args ctree =     
+    let args ctree =
       Array.map (fun t -> main_ind,t) (snd (Rtree.dest_node ctree)) in
       Array.map args constrs
 
@@ -853,7 +853,7 @@ let init_tree ids ind rp nexti =
 
 let map_tree_rp rp id_fun mapi = function
     Split_patt (ids,ind,branches) ->
-  let indargs = ind_args rp ind in 
+  let indargs = ind_args rp ind in
   let do_i i (recargs,bri) = recargs,mapi i indargs.(i) bri in
     Split_patt (id_fun ids,ind,Array.mapi do_i branches)
   | _ -> failwith "map_tree_rp: not a splitting node"
@@ -865,19 +865,19 @@ let map_tree id_fun mapi = function
   | _ -> failwith "map_tree: not a splitting node"
 
 
-let start_tree env ind rp = 
+let start_tree env ind rp =
   init_tree Idset.empty ind rp (fun _ _ -> None)
 
-let build_per_info etype casee gls = 
+let build_per_info etype casee gls =
   let concl=pf_concl gls in
   let env=pf_env gls in
   let ctyp=pf_type_of gls casee in
-  let is_dep = dependent casee concl in 
+  let is_dep = dependent casee concl in
   let hd,args = decompose_app (special_whd gls ctyp) in
-  let ind = 
+  let ind =
     try
-      destInd hd 
-    with _ -> 
+      destInd hd
+    with _ ->
       error "Case analysis must be done on an inductive object." in
   let mind,oind = Global.lookup_inductive ind in
   let nparams,index =
@@ -885,10 +885,10 @@ let build_per_info etype casee gls =
 	ET_Induction -> mind.mind_nparams_rec,Some (snd ind)
       | _ -> mind.mind_nparams,None in
   let params,real_args = list_chop nparams args in
-  let abstract_obj c body = 
-    let typ=pf_type_of gls c in 
+  let abstract_obj c body =
+    let typ=pf_type_of gls c in
       lambda_create env (typ,subst_term c body) in
-  let pred= List.fold_right abstract_obj    
+  let pred= List.fold_right abstract_obj
     real_args (lambda_create env (ctyp,subst_term casee concl)) in
     is_dep,
   {per_casee=casee;
@@ -897,7 +897,7 @@ let build_per_info etype casee gls =
    per_pred=pred;
    per_args=real_args;
    per_params=params;
-   per_nparams=nparams;   
+   per_nparams=nparams;
    per_wf=index,oind.mind_recargs}
 
 let per_tac etype casee gls=
@@ -906,25 +906,25 @@ let per_tac etype casee gls=
     match casee with
 	Real c ->
 	  let is_dep,per_info = build_per_info etype c gls in
-	  let ek = 
+	  let ek =
 	    if is_dep then
 	      EK_dep (start_tree env per_info.per_ind per_info.per_wf)
 	    else EK_unknown in
-	    tcl_change_info 
+	    tcl_change_info
 	      {pm_stack=
 		  Per(etype,per_info,ek,[])::info.pm_stack} gls
       | Virtual cut ->
 	  assert (cut.cut_stat.st_label=Anonymous);
 	  let id = pf_get_new_id (id_of_string "anonymous_matched") gls in
 	  let c = mkVar id in
-	  let modified_cut = 
+	  let modified_cut =
 	    {cut with cut_stat={cut.cut_stat with st_label=Name id}} in
-	    tclTHEN 
+	    tclTHEN
 	      (instr_cut (fun _ _ c -> c) false false modified_cut)
 	      (fun gls0 ->
 		 let is_dep,per_info = build_per_info etype c gls0 in
 		   assert (not is_dep);
-		   tcl_change_info 
+		   tcl_change_info
 		     {pm_stack=
 			 Per(etype,per_info,EK_unknown,[])::info.pm_stack} gls0)
 	      gls
@@ -941,7 +941,7 @@ let register_nodep_subcase id= function
       end
   | _ -> anomaly "wrong stack state"
 
-let suppose_tac hyps gls0 = 
+let suppose_tac hyps gls0 =
   let info = get_its_info gls0 in
   let thesis = pf_concl gls0 in
   let id = pf_get_new_id (id_of_string "subcase_") gls0 in
@@ -949,13 +949,13 @@ let suppose_tac hyps gls0 =
   let ninfo1 = {pm_stack=Suppose_case::info.pm_stack} in
   let old_clauses,stack = register_nodep_subcase id info.pm_stack in
   let ninfo2 = {pm_stack=stack} in
-    tclTHENS (assert_postpone id clause) 
+    tclTHENS (assert_postpone id clause)
       [tclTHENLIST [tcl_change_info ninfo1;
 		    assume_tac hyps;
 		    clear old_clauses];
        tcl_change_info ninfo2] gls0
 
-(* suppose it is ... *) 
+(* suppose it is ... *)
 
 (* pattern matching compiling *)
 
@@ -966,20 +966,20 @@ let rec skip_args rest ids n =
     Skip_patt (ids,skip_args rest ids (pred n))
 
 let rec tree_of_pats ((id,_) as cpl) pats =
-  match pats with 
+  match pats with
       [] -> End_patt cpl
     | args::stack ->
 	match args with
 	    [] -> Close_patt (tree_of_pats cpl stack)
 	  | (patt,rp) :: rest_args ->
 	      match patt with
-		  PatVar (_,v) -> 
+		  PatVar (_,v) ->
 		    Skip_patt (Idset.singleton id,
 			       tree_of_pats cpl (rest_args::stack))
 		| PatCstr (_,(ind,cnum),args,nam) ->
 		    let nexti i ati =
-		      if i = pred cnum then 
-			let nargs = 
+		      if i = pred cnum then
+			let nargs =
 			  list_map_i (fun j a -> (a,ati.(j))) 0 args in
 			  Some (Idset.singleton id,
 				tree_of_pats cpl (nargs::rest_args::stack))
@@ -987,49 +987,49 @@ let rec tree_of_pats ((id,_) as cpl) pats =
 		      in init_tree Idset.empty ind rp nexti
 
 let rec add_branch ((id,_) as cpl) pats tree=
-  match pats with 
-      [] -> 
+  match pats with
+      [] ->
 	begin
 	  match tree with
-	      End_patt cpl0 -> End_patt cpl0 
-		(* this ensures precedence for overlapping patterns *) 
+	      End_patt cpl0 -> End_patt cpl0
+		(* this ensures precedence for overlapping patterns *)
 	    | _ -> anomaly "tree is expected to end here"
 	end
     | args::stack ->
-	match args with 
+	match args with
 	    [] ->
 	      begin
 		match tree with
-		   Close_patt t -> 
+		   Close_patt t ->
 		     Close_patt (add_branch cpl stack t)
-		  | _ -> anomaly "we should pop here" 
+		  | _ -> anomaly "we should pop here"
 	      end
 	  | (patt,rp) :: rest_args ->
 	      match patt with
 		  PatVar (_,v) ->
 		    begin
-		      match tree with 
-			  Skip_patt (ids,t) -> 
+		      match tree with
+			  Skip_patt (ids,t) ->
 			    Skip_patt (Idset.add id ids,
 				       add_branch cpl (rest_args::stack) t)
 			| Split_patt (_,_,_) ->
 			    map_tree (Idset.add id)
-			      (fun i bri ->  
-				 append_branch cpl 1 (rest_args::stack) bri) 
+			      (fun i bri ->
+				 append_branch cpl 1 (rest_args::stack) bri)
 			      tree
-			| _ -> anomaly "No pop/stop expected here"  
+			| _ -> anomaly "No pop/stop expected here"
 		    end
 		| PatCstr (_,(ind,cnum),args,nam) ->
 		      match tree with
 			Skip_patt (ids,t) ->
 			  let nexti i ati =
-			    if i = pred cnum then 
-			      let nargs = 
+			    if i = pred cnum then
+			      let nargs =
 				list_map_i (fun j a -> (a,ati.(j))) 0 args in
 				Some (Idset.add id ids,
 				      add_branch cpl (nargs::rest_args::stack)
 					(skip_args t ids (Array.length ati)))
-			    else 
+			    else
 			      Some (ids,
 				    skip_args t ids (Array.length ati))
 			  in init_tree ids ind rp nexti
@@ -1038,30 +1038,30 @@ let rec add_branch ((id,_) as cpl) pats tree=
 			    (* this can happen with coercions *)
 	                    "Case pattern belongs to wrong inductive type.";
 			  let mapi i ati bri =
-			    if i = pred cnum then 
-			      let nargs = 
+			    if i = pred cnum then
+			      let nargs =
 				list_map_i (fun j a -> (a,ati.(j))) 0 args in
-				append_branch cpl 0 
+				append_branch cpl 0
 				  (nargs::rest_args::stack) bri
 			    else bri in
 			    map_tree_rp rp (fun ids -> ids) mapi tree
 		      | _ -> anomaly "No pop/stop expected here"
 and append_branch ((id,_) as cpl) depth pats = function
-    Some (ids,tree) -> 
+    Some (ids,tree) ->
       Some (Idset.add id ids,append_tree cpl depth pats tree)
   | None ->
       Some (Idset.singleton id,tree_of_pats cpl pats)
 and append_tree ((id,_) as cpl) depth pats tree =
   if depth<=0 then add_branch cpl pats tree
   else match tree with
-      Close_patt t -> 
+      Close_patt t ->
 	Close_patt (append_tree cpl (pred depth) pats t)
-    | Skip_patt (ids,t) -> 
+    | Skip_patt (ids,t) ->
 	Skip_patt (Idset.add id ids,append_tree cpl depth pats t)
     | End_patt _ -> anomaly "Premature end of branch"
-    | Split_patt (_,_,_) -> 
-	map_tree (Idset.add id) 
-	  (fun i bri -> append_branch cpl (succ depth) pats bri) tree 
+    | Split_patt (_,_,_) ->
+	map_tree (Idset.add id)
+	  (fun i bri -> append_branch cpl (succ depth) pats bri) tree
 
 (* suppose it is *)
 
@@ -1075,22 +1075,22 @@ let thesis_for obj typ per_info env=
   let cind,all_args=decompose_app typ in
   let ind = destInd cind in
   let _ = if ind <> per_info.per_ind then
-    errorlabstrm "thesis_for" 
-      ((Printer.pr_constr_env env obj) ++ spc () ++ 
-	 str"cannot give an induction hypothesis (wrong inductive type).") in  
+    errorlabstrm "thesis_for"
+      ((Printer.pr_constr_env env obj) ++ spc () ++
+	 str"cannot give an induction hypothesis (wrong inductive type).") in
   let params,args = list_chop per_info.per_nparams all_args in
   let _ = if not (List.for_all2 eq_constr params per_info.per_params) then
-    errorlabstrm "thesis_for" 
-      ((Printer.pr_constr_env env obj) ++ spc () ++ 
+    errorlabstrm "thesis_for"
+      ((Printer.pr_constr_env env obj) ++ spc () ++
 	 str "cannot give an induction hypothesis (wrong parameters).") in
   let hd2 = (applist ((lift (List.length rc) per_info.per_pred),args@[obj])) in
     compose_prod rc (whd_beta Evd.empty hd2)
 
 let rec build_product_dep pat_info per_info args body gls =
-  match args with 
-      (Hprop {st_label=nam;st_it=This c} 
-      | Hvar {st_label=nam;st_it=c})::rest -> 
-	let pprod= 
+  match args with
+      (Hprop {st_label=nam;st_it=This c}
+      | Hvar {st_label=nam;st_it=c})::rest ->
+	let pprod=
 	  lift 1 (build_product_dep pat_info per_info rest body gls) in
 	let lbody =
 	  match nam with
@@ -1098,7 +1098,7 @@ let rec build_product_dep pat_info per_info args body gls =
 	    | Name id -> subst_var id pprod in
 	  mkProd (nam,c,lbody)
     | Hprop ({st_it=Thesis tk} as st)::rest ->
-	let pprod= 
+	let pprod=
 	  lift 1 (build_product_dep pat_info per_info rest body gls) in
 	let lbody =
 	  match st.st_label with
@@ -1108,14 +1108,14 @@ let rec build_product_dep pat_info per_info args body gls =
 	  match tk with
 	      For id ->
 		let obj = mkVar id in
-		let typ = 
-		  try st_assoc (Name id) pat_info.pat_vars 
-		  with Not_found -> 
+		let typ =
+		  try st_assoc (Name id) pat_info.pat_vars
+		  with Not_found ->
 		    snd (st_assoc (Name id) pat_info.pat_aliases) in
 		  thesis_for obj typ per_info (pf_env gls)
 	    | Plain -> pf_concl gls in
 	  mkProd (st.st_label,ptyp,lbody)
-    | [] -> body 
+    | [] -> body
 
 let build_dep_clause params pat_info per_info hyps gls =
   let concl=
@@ -1129,35 +1129,35 @@ let build_dep_clause params pat_info per_info hyps gls =
   let let_one_in st body =
     match st.st_label with
 	Anonymous -> mkLetIn(Anonymous,fst st.st_it,snd st.st_it,lift 1 body)
-      | Name id -> 
+      | Name id ->
 	  mkNamedLetIn id (fst st.st_it) (snd st.st_it) (lift 1 body) in
-  let aliased_clause = 
+  let aliased_clause =
     List.fold_right let_one_in pat_info.pat_aliases open_clause in
     List.fold_right prod_one (params@pat_info.pat_vars) aliased_clause
 
 let rec register_dep_subcase id env per_info pat = function
     EK_nodep -> error  "Only \"suppose it is\" can be used here."
-  | EK_unknown -> 
+  | EK_unknown ->
       register_dep_subcase id env per_info pat
 	(EK_dep (start_tree env per_info.per_ind per_info.per_wf))
   | EK_dep tree -> EK_dep (add_branch id [[pat,per_info.per_wf]] tree)
-  
+
 let case_tac params pat_info hyps gls0 =
   let info = get_its_info gls0 in
   let id = pf_get_new_id (id_of_string "subcase_") gls0 in
   let et,per_info,ek,old_clauses,rest =
     match info.pm_stack with
-	Per (et,pi,ek,old_clauses)::rest -> (et,pi,ek,old_clauses,rest) 
+	Per (et,pi,ek,old_clauses)::rest -> (et,pi,ek,old_clauses,rest)
       | _ -> anomaly "wrong place for cases" in
   let clause = build_dep_clause params pat_info per_info hyps gls0 in
   let ninfo1 = {pm_stack=Suppose_case::info.pm_stack} in
-  let nek = 
-    register_dep_subcase (id,List.length hyps) (pf_env gls0) per_info 
-      pat_info.pat_pat ek in  
+  let nek =
+    register_dep_subcase (id,List.length hyps) (pf_env gls0) per_info
+      pat_info.pat_pat ek in
   let ninfo2 = {pm_stack=Per(et,per_info,nek,id::old_clauses)::rest} in
-    tclTHENS (assert_postpone id clause) 
-      [tclTHENLIST 
-	 [tcl_change_info ninfo1; 
+    tclTHENS (assert_postpone id clause)
+      [tclTHENLIST
+	 [tcl_change_info ninfo1;
 	  assume_st (params@pat_info.pat_vars);
 	  assume_st_letin pat_info.pat_aliases;
 	  assume_hyps_or_theses hyps;
@@ -1172,23 +1172,23 @@ type instance_stack =
 let initial_instance_stack ids =
   List.map (fun id -> id,[None,[]]) ids
 
-let push_one_arg arg = function 
+let push_one_arg arg = function
     [] -> anomaly "impossible"
-  | (head,args) :: ctx -> 
+  | (head,args) :: ctx ->
       ((head,(arg::args)) :: ctx)
 
 let push_arg arg stacks =
   List.map (fun (id,stack) -> (id,push_one_arg arg stack)) stacks
-  
 
-let push_one_head c ids (id,stack) = 
+
+let push_one_head c ids (id,stack) =
   let head = if Idset.mem id ids then Some c else None in
     id,(head,[]) :: stack
 
 let push_head c ids stacks =
   List.map (push_one_head c ids) stacks
 
-let pop_one (id,stack) =  
+let pop_one (id,stack) =
   let nstack=
     match stack with
 	[] -> anomaly "impossible"
@@ -1209,30 +1209,30 @@ let hrec_for fix_id per_info gls obj_id =
   let rc,hd1=decompose_prod typ in
   let cind,all_args=decompose_app typ in
   let ind = destInd cind in assert (ind=per_info.per_ind);
-  let params,args= list_chop per_info.per_nparams all_args in 
+  let params,args= list_chop per_info.per_nparams all_args in
   assert begin
-    try List.for_all2 eq_constr params per_info.per_params with 
+    try List.for_all2 eq_constr params per_info.per_params with
         Invalid_argument _ -> false end;
-  let hd2 = applist (mkVar fix_id,args@[obj]) in 
+  let hd2 = applist (mkVar fix_id,args@[obj]) in
     compose_lam rc (whd_beta gls.sigma hd2)
 
 let rec execute_cases fix_name per_info tacnext args objs nhrec tree gls =
   match tree, objs  with
-      Close_patt t,_ ->  
-	let args0 = pop_stacks args in	
+      Close_patt t,_ ->
+	let args0 = pop_stacks args in
 	  execute_cases fix_name per_info tacnext args0 objs nhrec t gls
-    | Skip_patt (_,t),skipped::next_objs -> 
+    | Skip_patt (_,t),skipped::next_objs ->
 	let args0 = push_arg skipped args in
 	  execute_cases fix_name per_info tacnext args0 next_objs nhrec t gls
-    | End_patt (id,nhyps),[] -> 
+    | End_patt (id,nhyps),[] ->
 	begin
 	  match List.assoc id args with
-	      [None,br_args] -> 
-		let metas = 
+	      [None,br_args] ->
+		let metas =
 		  list_tabulate (fun n -> mkMeta (succ n)) nhyps in
 		  tclTHEN
 		    (tclDO nhrec introf)
-		    (tacnext 
+		    (tacnext
 		       (applist (mkVar id,List.rev_append br_args metas))) gls
 	    | _ -> anomaly "wrong stack size"
 	end
@@ -1245,111 +1245,111 @@ let rec execute_cases fix_name per_info tacnext args objs nhrec tree gls =
 	let hd,all_args = decompose_app (special_whd gls ctyp) in
 	let _ = assert (destInd hd = ind) in (* just in case *)
 	let params,real_args = list_chop nparams all_args in
-	let abstract_obj c body = 
-	  let typ=pf_type_of gls c in 
+	let abstract_obj c body =
+	  let typ=pf_type_of gls c in
 	    lambda_create env (typ,subst_term c body) in
-	let elim_pred = List.fold_right abstract_obj    
+	let elim_pred = List.fold_right abstract_obj
 	  real_args (lambda_create env (ctyp,subst_term casee concl)) in
 	let case_info = Inductiveops.make_case_info env ind RegularStyle in
 	let gen_arities = Inductive.arities_of_constructors ind spec in
-	let f_ids typ = 
-	  let sign = 
+	let f_ids typ =
+	  let sign =
 	    (prod_assum (Term.prod_applist typ params)) in
 	    find_intro_names sign gls in
 	let constr_args_ids = Array.map f_ids gen_arities in
-	let case_term =	 
+	let case_term =
 	  mkCase(case_info,elim_pred,casee,
 		 Array.mapi (fun i _ -> mkMeta (succ i)) constr_args_ids) in
 	let branch_tac i (recargs,bro) gls0 =
 	  let args_ids = constr_args_ids.(i) in
 	  let rec aux n = function
-	      [] -> 
-		assert (n=Array.length recargs); 
+	      [] ->
+		assert (n=Array.length recargs);
 		next_objs,[],nhrec
-	    | id :: q -> 
+	    | id :: q ->
 		let objs,recs,nrec = aux (succ n) q in
-		  if recargs.(n) 
-		  then (mkVar id::objs),(id::recs),succ nrec 
+		  if recargs.(n)
+		  then (mkVar id::objs),(id::recs),succ nrec
 		  else (mkVar id::objs),recs,nrec in
 	  let objs,recs,nhrec = aux 0 args_ids in
 	    tclTHENLIST
 	      [tclMAP intro_mustbe_force args_ids;
 	       begin
-		 fun gls1 -> 
-		   let hrecs = 
-		     List.map 
-		       (fun id -> 
-			  hrec_for (out_name fix_name) per_info gls1 id) 
+		 fun gls1 ->
+		   let hrecs =
+		     List.map
+		       (fun id ->
+			  hrec_for (out_name fix_name) per_info gls1 id)
 		       recs in
 		     generalize hrecs gls1
 	       end;
 	       match bro with
-		   None -> 
+		   None ->
 		     msg_warning (str "missing case");
 		     tacnext (mkMeta 1)
 		 | Some (sub_ids,tree) ->
 		     let br_args =
-		       List.filter 
-			 (fun (id,_) -> Idset.mem id sub_ids) args in 
-		     let construct = 
+		       List.filter
+			 (fun (id,_) -> Idset.mem id sub_ids) args in
+		     let construct =
 		       applist (mkConstruct(ind,succ i),params) in
-		     let p_args = 
+		     let p_args =
 		       push_head construct ids br_args in
-		       execute_cases fix_name per_info tacnext 
+		       execute_cases fix_name per_info tacnext
 			 p_args objs nhrec tree] gls0 in
-	  tclTHENSV 
+	  tclTHENSV
 	    (refine case_term)
 	    (Array.mapi branch_tac br) gls
-    | Split_patt (_, _, _) , [] -> 
+    | Split_patt (_, _, _) , [] ->
 	anomaly "execute_cases : Nothing to split"
-    | Skip_patt _ , [] -> 
+    | Skip_patt _ , [] ->
 	anomaly "execute_cases : Nothing to skip"
-    | End_patt (_,_) , _ :: _  -> 
+    | End_patt (_,_) , _ :: _  ->
 	anomaly "execute_cases : End of branch with garbage left"
 
 
 
 (* end focus/claim *)
-		
+
 let end_tac et2 gls =
   let info = get_its_info gls in
-  let et1,pi,ek,clauses = 
+  let et1,pi,ek,clauses =
     match info.pm_stack with
-	Suppose_case::_ -> 
+	Suppose_case::_ ->
 	  anomaly "This case should already be trapped"
-      | Claim::_ ->  
+      | Claim::_ ->
 	  error "\"end claim\" expected."
       | Focus_claim::_ ->
 	  error "\"end focus\" expected."
-      | Per(et',pi,ek,clauses)::_ -> (et',pi,ek,clauses) 
-      | [] -> 
+      | Per(et',pi,ek,clauses)::_ -> (et',pi,ek,clauses)
+      | [] ->
 	  anomaly "This case should already be trapped" in
-  let et = 
+  let et =
     if et1 <> et2 then
-      match et1 with 
-	  ET_Case_analysis -> 
+      match et1 with
+	  ET_Case_analysis ->
 	    error "\"end cases\" expected."
 	| ET_Induction ->
 	    error "\"end induction\" expected."
     else et1 in
-    tclTHEN 
+    tclTHEN
       tcl_erase_info
       begin
 	match et,ek with
-	    _,EK_unknown -> 
-	      tclSOLVE [simplest_elim pi.per_casee]	
+	    _,EK_unknown ->
+	      tclSOLVE [simplest_elim pi.per_casee]
 	  | ET_Case_analysis,EK_nodep ->
-	      tclTHEN 
+	      tclTHEN
 		(general_case_analysis false (pi.per_casee,NoBindings))
 		(default_justification (List.map mkVar clauses))
 	  | ET_Induction,EK_nodep ->
 	      tclTHENLIST
-		[generalize (pi.per_args@[pi.per_casee]); 
+		[generalize (pi.per_args@[pi.per_casee]);
 		 simple_induct (AnonHyp (succ (List.length pi.per_args)));
 		 default_justification (List.map mkVar clauses)]
 	  | ET_Case_analysis,EK_dep tree ->
-		 execute_cases Anonymous pi 
-		   (fun c -> tclTHENLIST 
+		 execute_cases Anonymous pi
+		   (fun c -> tclTHENLIST
 		      [refine c;
 		       clear clauses;
 		       justification assumption])
@@ -1358,25 +1358,25 @@ let end_tac et2 gls =
 	      let nargs = (List.length pi.per_args) in
 		tclTHEN (generalize (pi.per_args@[pi.per_casee]))
 		  begin
-		    fun gls0 -> 
-		      let fix_id = 
+		    fun gls0 ->
+		      let fix_id =
 			pf_get_new_id (id_of_string "_fix") gls0 in
-		      let c_id = 
+		      let c_id =
 			pf_get_new_id (id_of_string "_main_arg") gls0 in
 			tclTHENLIST
 			  [fix (Some fix_id) (succ nargs);
 			   tclDO nargs introf;
 			   intro_mustbe_force c_id;
-			   execute_cases (Name fix_id) pi 
+			   execute_cases (Name fix_id) pi
 			     (fun c ->
-				tclTHENLIST 
+				tclTHENLIST
 				  [clear [fix_id];
 				   refine c;
 				   clear clauses;
 				   justification assumption])
-			     (initial_instance_stack clauses) 
+			     (initial_instance_stack clauses)
 			     [mkVar c_id]  0 tree] gls0
-		  end	
+		  end
       end gls
 
 (* escape *)
@@ -1385,21 +1385,21 @@ let escape_tac gls =  tcl_erase_info gls
 
 (* General instruction engine *)
 
-let rec do_proof_instr_gen _thus _then instr = 
-  match instr with 
-      Pthus i -> 
+let rec do_proof_instr_gen _thus _then instr =
+  match instr with
+      Pthus i ->
 	assert (not _thus);
 	do_proof_instr_gen true _then i
-    | Pthen i -> 	
+    | Pthen i ->
 	assert (not _then);
 	do_proof_instr_gen _thus true i
-    | Phence i -> 
+    | Phence i ->
 	assert (not (_then || _thus));
 	do_proof_instr_gen true true i
     | Pcut c ->
 	instr_cut mk_stat_or_thesis _thus _then c
     | Psuffices c ->
-	instr_suffices _then c 
+	instr_suffices _then c
     | Prew (s,c) ->
 	assert (not _then);
 	instr_rew _thus s c
@@ -1407,75 +1407,75 @@ let rec do_proof_instr_gen _thus _then instr =
     | Pgiven hyps            -> given_tac hyps
     | Passume hyps           -> assume_tac hyps
     | Plet hyps              -> assume_tac hyps
-    | Pclaim st              -> instr_claim false st 
+    | Pclaim st              -> instr_claim false st
     | Pfocus st              -> instr_claim true st
     | Ptake witl             -> take_tac witl
     | Pdefine (id,args,body) -> define_tac id args body
-    | Pcast (id,typ)         -> cast_tac id typ 
-    | Pper (et,cs)           -> per_tac et cs 
+    | Pcast (id,typ)         -> cast_tac id typ
+    | Pper (et,cs)           -> per_tac et cs
     | Psuppose hyps      -> suppose_tac hyps
     | Pcase (params,pat_info,hyps) -> case_tac params pat_info hyps
     | Pend (B_elim et) -> end_tac et
     | Pend _ -> anomaly "Not applicable"
     | Pescape -> escape_tac
- 
+
 let eval_instr {instr=instr} =
-  do_proof_instr_gen false false instr   
+  do_proof_instr_gen false false instr
 
 let rec preprocess pts instr =
   match instr with
     Phence i |Pthus i | Pthen i -> preprocess pts i
-  | Psuffices _ | Pcut _ |  Passume _ | Plet _ | Pclaim _ | Pfocus _ 
-  | Pconsider (_,_) | Pcast (_,_) | Pgiven _ | Ptake _ 
+  | Psuffices _ | Pcut _ |  Passume _ | Plet _ | Pclaim _ | Pfocus _
+  | Pconsider (_,_) | Pcast (_,_) | Pgiven _ | Ptake _
   | Pdefine (_,_,_) | Pper _ | Prew _ ->
       check_not_per pts;
       true,pts
-  | Pescape -> 
+  | Pescape ->
       check_not_per pts;
       true,pts
-  | Pcase _ | Psuppose _ | Pend (B_elim _) -> 
+  | Pcase _ | Psuppose _ | Pend (B_elim _) ->
       true,close_previous_case pts
-  | Pend bt -> 
-      false,close_block bt pts 
-      
-let rec postprocess pts instr = 
+  | Pend bt ->
+      false,close_block bt pts
+
+let rec postprocess pts instr =
   match instr with
       Phence i | Pthus i | Pthen i -> postprocess pts i
     | Pcut _ | Psuffices _ | Passume _ | Plet _ | Pconsider (_,_) | Pcast (_,_)
     | Pgiven _ | Ptake _ | Pdefine (_,_,_) | Prew (_,_) -> pts
-    | Pclaim _ | Pfocus _ | Psuppose _ | Pcase _ | Pper _ 
+    | Pclaim _ | Pfocus _ | Psuppose _ | Pcase _ | Pper _
     | Pescape -> nth_unproven 1 pts
     | Pend (B_elim ET_Induction) ->
   	begin
 	  let pf = proof_of_pftreestate pts in
 	  let (pfterm,_) = extract_open_pftreestate pts in
 	  let env =  Evd.evar_env (goal_of_proof pf) in
-	    try 
+	    try
 	      Inductiveops.control_only_guard env pfterm;
 	      goto_current_focus_or_top (mark_as_done pts)
- 	    with 
+ 	    with
 		Type_errors.TypeError(env,
 				      Type_errors.IllFormedRecBody(_,_,_,_,_)) ->
 		  anomaly "\"end induction\" generated an ill-formed fixpoint"
 	end
-    | Pend _ -> 
+    | Pend _ ->
 	goto_current_focus_or_top (mark_as_done pts)
 
 let do_instr raw_instr pts =
   let has_tactic,pts1 = preprocess pts raw_instr.instr in
-  let pts2 = 
+  let pts2 =
     if has_tactic then
       let gl = nth_goal_of_pftreestate 1 pts1 in
       let env=  pf_env gl in
       let sigma= project gl in
-      let ist = {ltacvars = ([],[]); ltacrecvars = []; 
+      let ist = {ltacvars = ([],[]); ltacrecvars = [];
 		 gsigma = sigma; genv = env} in
       let glob_instr = intern_proof_instr ist raw_instr in
-      let instr = 
+      let instr =
 	interp_proof_instr (get_its_info gl) sigma env glob_instr in
       let lock_focus = is_focussing_instr instr.instr in
       let marker= Proof_instr (lock_focus,instr) in
-	solve_nth_pftreestate 1 
+	solve_nth_pftreestate 1
 	  (abstract_operation marker (tclTHEN (eval_instr instr) clean_tmp)) pts1
     else pts1 in
       postprocess pts2 raw_instr.instr
@@ -1486,8 +1486,8 @@ let proof_instr raw_instr =
 (*
 
 (* STUFF FOR ITERATED RELATIONS *)
-let decompose_bin_app t= 
-  let hd,args = destApp 
+let decompose_bin_app t=
+  let hd,args = destApp
 
 let identify_transitivity_lemma c =
   let varx,tx,c1 = destProd c in
@@ -1498,4 +1498,4 @@ let identify_transitivity_lemma c =
   let p2=pop lp2 in
   let p3=pop lp3 in
 *)
-    
+
diff --git a/tactics/decl_proof_instr.mli b/tactics/decl_proof_instr.mli
index fa1a703b95..a05c36e93a 100644
--- a/tactics/decl_proof_instr.mli
+++ b/tactics/decl_proof_instr.mli
@@ -23,7 +23,7 @@ val automation_tac : tactic
 
 val daimon_subtree: pftreestate -> pftreestate
 
-val concl_refiner: 
+val concl_refiner:
   Termops.meta_type_map -> constr -> Proof_type.goal sigma -> constr
 
 val do_instr: Decl_expr.raw_proof_instr -> pftreestate -> pftreestate
@@ -42,11 +42,11 @@ val execute_cases :
     (Names.Idset.elt * (Term.constr option * Term.constr list) list) list ->
     Term.constr list -> int -> Decl_mode.split_tree -> Proof_type.tactic
 
-val tree_of_pats : 
+val tree_of_pats :
   identifier * int -> (Rawterm.cases_pattern*recpath) list list ->
   split_tree
 
-val add_branch : 
+val add_branch :
   identifier * int -> (Rawterm.cases_pattern*recpath) list list ->
   split_tree -> split_tree
 
@@ -65,7 +65,7 @@ val build_dep_clause :   Term.types Decl_expr.statement list ->
     (Term.types Decl_expr.statement, Term.types Decl_expr.or_thesis)
     Decl_expr.hyp list -> Proof_type.goal Tacmach.sigma -> Term.types
 
-val register_dep_subcase :    
+val register_dep_subcase :
     Names.identifier * int ->
     Environ.env ->
     Decl_mode.per_info ->
@@ -77,27 +77,27 @@ val thesis_for :     Term.constr ->
 val close_previous_case : pftreestate -> pftreestate
 
 val pop_stacks :
-  (Names.identifier * 
-     (Term.constr option * Term.constr list) list) list -> 
-  (Names.identifier * 
+  (Names.identifier *
+     (Term.constr option * Term.constr list) list) list ->
+  (Names.identifier *
      (Term.constr option * Term.constr list) list) list
 
 val push_head :   Term.constr ->
   Names.Idset.t ->
-  (Names.identifier * 
+  (Names.identifier *
      (Term.constr option * Term.constr list) list) list ->
-  (Names.identifier * 
+  (Names.identifier *
      (Term.constr option * Term.constr list) list) list
 
 val push_arg : Term.constr ->
-  (Names.identifier * 
+  (Names.identifier *
      (Term.constr option * Term.constr list) list) list ->
-  (Names.identifier * 
+  (Names.identifier *
      (Term.constr option * Term.constr list) list) list
 
-val hrec_for: 
+val hrec_for:
     Names.identifier ->
-    Decl_mode.per_info -> Proof_type.goal Tacmach.sigma -> 
+    Decl_mode.per_info -> Proof_type.goal Tacmach.sigma ->
     Names.identifier -> Term.constr
 
 val consider_match :
diff --git a/tactics/dhyp.ml b/tactics/dhyp.ml
index c28a87f0e7..e3dddacb0f 100644
--- a/tactics/dhyp.ml
+++ b/tactics/dhyp.ml
@@ -9,7 +9,7 @@
 (* $Id$ *)
 
 (* Chet's comments about this tactic :
- 
+
  Programmable destruction of hypotheses and conclusions.
 
    The idea here is that we are going to store patterns.  These
@@ -136,7 +136,7 @@ open Libnames
 
 (* two patterns - one for the type, and one for the type of the type *)
 type destructor_pattern = {
-  d_typ: constr_pattern; 
+  d_typ: constr_pattern;
   d_sort: constr_pattern }
 
 let subst_destructor_pattern subst { d_typ = t; d_sort = s } =
@@ -151,7 +151,7 @@ type located_destructor_pattern =
    destructor_pattern) location
 
 let subst_located_destructor_pattern subst = function
-  | HypLocation (b,d,d') -> 
+  | HypLocation (b,d,d') ->
       HypLocation
         (b,subst_destructor_pattern subst d, subst_destructor_pattern subst d')
   | ConclLocation d ->
@@ -179,29 +179,29 @@ let add (na,dd) =
   let pat = match dd.d_pat with
     | HypLocation(_,p,_) -> p.d_typ
     | ConclLocation p -> p.d_typ
-  in 
+  in
   if Nbtermdn.in_dn tactab na then begin
-    msgnl (str "Warning [Overriding Destructor Entry " ++ 
+    msgnl (str "Warning [Overriding Destructor Entry " ++
              str (string_of_id na) ++ str"]");
     Nbtermdn.remap tactab na (pat,dd)
-  end else 
+  end else
     Nbtermdn.add tactab (na,(pat,dd))
 
-let _ = 
+let _ =
   Summary.declare_summary "destruct-hyp-concl"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
       Summary.init_function = init }
 
-let forward_subst_tactic = 
+let forward_subst_tactic =
   ref (fun _ -> failwith "subst_tactic is not installed for DHyp")
 
 let cache_dd (_,(_,na,dd)) =
-  try 
+  try
     add (na,dd)
-  with _ -> 
+  with _ ->
     anomalylabstrm "Dhyp.add"
-      (str"The code which adds destructor hints broke;" ++ spc () ++ 
+      (str"The code which adds destructor hints broke;" ++ spc () ++
 	 str"this is not supposed to happen")
 
 let classify_dd (local,_,_ as o) =
@@ -212,7 +212,7 @@ let export_dd (local,_,_ as x) = if local then None else Some x
 let subst_dd (_,subst,(local,na,dd)) =
   (local,na,
   { d_pat = subst_located_destructor_pattern subst dd.d_pat;
-    d_pri = dd.d_pri; 
+    d_pri = dd.d_pri;
     d_code = !forward_subst_tactic subst dd.d_code })
 
 let (inDD,_) =
@@ -225,7 +225,7 @@ let (inDD,_) =
 
 let catch_all_sort_pattern = PMeta(Some (id_of_string "SORT"))
 let catch_all_type_pattern = PMeta(Some (id_of_string "TYPE"))
-    
+
 let add_destructor_hint local na loc (_,pat) pri code =
   let code =
     begin match loc, code with
@@ -273,7 +273,7 @@ let match_dpat dp cls gls =
         then error "No match."
     | _ -> error "ApplyDestructor"
 
-let forward_interp_tactic = 
+let forward_interp_tactic =
   ref (fun _ -> failwith "interp_tactic is not installed for DHyp")
 
 let set_extern_interp f = forward_interp_tactic := f
@@ -284,7 +284,7 @@ let applyDestructor cls discard dd gls =
   let tacl =
     List.map (fun cl ->
       match cl, dd.d_code with
-        | Some id, (Some x, tac) -> 
+        | Some id, (Some x, tac) ->
 	    let arg =
               ConstrMayEval(ConstrTerm (RRef(dummy_loc,VarRef id),None)) in
             TacLetIn (false, [(dummy_loc, x), arg], tac)
@@ -337,15 +337,15 @@ let rec search n =
   tclFIRST
     [intros;
      assumption;
-     (tclTHEN  
-        (Tacticals.tryAllHypsAndConcl 
-           (function 
+     (tclTHEN
+        (Tacticals.tryAllHypsAndConcl
+           (function
               | Some id -> (dHyp id)
               | None    ->  dConcl ))
         (search (n-1)))]
-    
+
 let auto_tdb n = tclTRY (tclCOMPLETE (search n))
-   
+
 let search_depth_tdb = ref(5)
 
 let depth_tdb = function
diff --git a/tactics/dhyp.mli b/tactics/dhyp.mli
index 3277fd2e67..41fd497f7a 100644
--- a/tactics/dhyp.mli
+++ b/tactics/dhyp.mli
@@ -28,5 +28,5 @@ val h_auto_tdb : int option -> tactic
 
 val add_destructor_hint :
   Vernacexpr.locality_flag -> identifier -> (bool,unit) Tacexpr.location ->
-    Rawterm.patvar list * Pattern.constr_pattern -> int -> 
+    Rawterm.patvar list * Pattern.constr_pattern -> int ->
       glob_tactic_expr -> unit
diff --git a/tactics/dn.ml b/tactics/dn.ml
index 0809c80ebb..359e3fe7fb 100644
--- a/tactics/dn.ml
+++ b/tactics/dn.ml
@@ -16,7 +16,7 @@
    then the associated tactic is applied. Discrimination nets are used
    (only) to implement the tactics Auto, DHyp and Point.
 
-   A discrimination net is a tries structure, that is, a tree structure 
+   A discrimination net is a tries structure, that is, a tree structure
    specially conceived for searching patterns, like for example strings
    --see the file Tlm.ml in the directory lib/util--. Here the tries
    structure are used for looking for term patterns.
@@ -34,67 +34,67 @@
 type ('lbl,'pat) decompose_fun = 'pat -> ('lbl * 'pat list) option
 
 type 'res lookup_res = Label of 'res | Nothing | Everything
-    
+
 type ('lbl,'tree) lookup_fun = 'tree -> ('lbl * 'tree list) lookup_res
 
 type ('lbl,'pat,'inf) t = (('lbl * int) option,'pat * 'inf) Tlm.t
 
 let create () = Tlm.empty
 
-(* [path_of dna pat] returns the list of nodes of the pattern [pat] read in 
+(* [path_of dna pat] returns the list of nodes of the pattern [pat] read in
 prefix ordering, [dna] is the function returning the main node of a pattern *)
 
 let path_of dna =
   let rec path_of_deferred = function
     | [] -> []
     | h::tl -> pathrec tl h
-	    
+
   and pathrec deferred t =
     match dna t with
-    | None -> 
+    | None ->
 	None :: (path_of_deferred deferred)
     | Some (lbl,[]) ->
 	(Some (lbl,0))::(path_of_deferred deferred)
     | Some (lbl,(h::def_subl as v)) ->
 	(Some (lbl,List.length v))::(pathrec (def_subl@deferred) h)
-  in 
+  in
   pathrec []
-    
+
 let tm_of tm lbl =
   try [Tlm.map tm lbl, true] with Not_found -> []
-    
+
 let rec skip_arg n tm =
   if n = 0 then [tm,true]
   else
-    List.flatten 
-      (List.map 
+    List.flatten
+      (List.map
 	  (fun a -> match a with
 	  | None -> skip_arg (pred n) (Tlm.map tm a)
-	  | Some (lbl,m) -> 
-	      skip_arg (pred n + m) (Tlm.map tm a)) 
+	  | Some (lbl,m) ->
+	      skip_arg (pred n + m) (Tlm.map tm a))
 	  (Tlm.dom tm))
-      
+
 let lookup tm dna t =
   let rec lookrec t tm =
     match dna t with
     | Nothing -> tm_of tm None
     | Label(lbl,v) ->
 	tm_of tm None@
-	  (List.fold_left 
-	      (fun l c -> 
+	  (List.fold_left
+	      (fun l c ->
 		List.flatten(List.map (fun (tm, b) ->
 		  if b then lookrec c tm
 		  else [tm,b]) l))
               (tm_of tm (Some(lbl,List.length v))) v)
     | Everything -> skip_arg 1 tm
-  in 
+  in
     List.flatten (List.map (fun (tm,b) -> Tlm.xtract tm) (lookrec t tm))
 
 let add tm dna (pat,inf) =
   let p = path_of dna pat in Tlm.add tm (p,(pat,inf))
-    
+
 let rmv tm dna (pat,inf) =
   let p = path_of dna pat in Tlm.rmv tm (p,(pat,inf))
-    
+
 let app f tm = Tlm.app (fun (_,p) -> f p) tm
 
diff --git a/tactics/dn.mli b/tactics/dn.mli
index e37ed9af3f..b4b2e6c891 100644
--- a/tactics/dn.mli
+++ b/tactics/dn.mli
@@ -25,11 +25,11 @@ val create : unit -> ('lbl,'pat,'inf) t
 val add : ('lbl,'pat,'inf) t -> ('lbl,'pat) decompose_fun -> 'pat * 'inf
   -> ('lbl,'pat,'inf) t
 
-val rmv : ('lbl,'pat,'inf) t -> ('lbl,'pat) decompose_fun -> 'pat * 'inf 
+val rmv : ('lbl,'pat,'inf) t -> ('lbl,'pat) decompose_fun -> 'pat * 'inf
   -> ('lbl,'pat,'inf) t
 
 type 'res lookup_res = Label of 'res | Nothing | Everything
-    
+
 type ('lbl,'tree) lookup_fun = 'tree -> ('lbl * 'tree list) lookup_res
 
 (* [lookup t f tree] looks for trees (and their associated
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4
index 3a16cd7935..25efd5a050 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml4
@@ -33,14 +33,14 @@ open Hiddentac
 
 let eauto_unif_flags = { auto_unif_flags with Unification.modulo_delta = full_transparent_state }
 
-let e_give_exact ?(flags=eauto_unif_flags) c gl = let t1 = (pf_type_of gl c) and t2 = pf_concl gl in 
-  if occur_existential t1 or occur_existential t2 then 
+let e_give_exact ?(flags=eauto_unif_flags) c gl = let t1 = (pf_type_of gl c) and t2 = pf_concl gl in
+  if occur_existential t1 or occur_existential t2 then
      tclTHEN (Clenvtac.unify ~flags t1) (exact_check c) gl
   else exact_check c gl
 
 let assumption id = e_give_exact (mkVar id)
-        
-let e_assumption gl = 
+
+let e_assumption gl =
   tclFIRST (List.map assumption (pf_ids_of_hyps gl)) gl
 
 TACTIC EXTEND eassumption
@@ -51,8 +51,8 @@ TACTIC EXTEND eexact
 | [ "eexact" constr(c) ] -> [ e_give_exact c ]
 END
 
-let registered_e_assumption gl = 
-  tclFIRST (List.map (fun id gl -> e_give_exact (mkVar id) gl) 
+let registered_e_assumption gl =
+  tclFIRST (List.map (fun id gl -> e_give_exact (mkVar id) gl)
               (pf_ids_of_hyps gl)) gl
 
 (************************************************************************)
@@ -93,116 +93,116 @@ open Unification
 
 let priority l = List.map snd (List.filter (fun (pr,_) -> pr = 0) l)
 
-let unify_e_resolve flags (c,clenv) gls = 
+let unify_e_resolve flags (c,clenv) gls =
   let clenv' = connect_clenv gls clenv in
   let _ = clenv_unique_resolver false ~flags clenv' gls in
   h_simplest_eapply c gls
 
 let rec e_trivial_fail_db db_list local_db goal =
-  let tacl = 
+  let tacl =
     registered_e_assumption ::
-    (tclTHEN Tactics.intro 
+    (tclTHEN Tactics.intro
        (function g'->
 	  let d = pf_last_hyp g' in
 	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
           (e_trivial_fail_db db_list
 	      (Hint_db.add_list hintl local_db) g'))) ::
     (List.map fst (e_trivial_resolve db_list local_db (pf_concl goal)) )
-  in 
-  tclFIRST (List.map tclCOMPLETE tacl) goal 
+  in
+  tclFIRST (List.map tclCOMPLETE tacl) goal
 
-and e_my_find_search db_list local_db hdc concl = 
+and e_my_find_search db_list local_db hdc concl =
   let hdc = head_of_constr_reference hdc in
   let hintl =
-    if occur_existential concl then 
-      list_map_append (fun db -> 
+    if occur_existential concl then
+      list_map_append (fun db ->
 	let flags = {auto_unif_flags with modulo_delta = Hint_db.transparent_state db} in
 	  List.map (fun x -> flags, x) (Hint_db.map_all hdc db)) (local_db::db_list)
-    else 
-      list_map_append (fun db -> 
+    else
+      list_map_append (fun db ->
 	let flags = {auto_unif_flags with modulo_delta = Hint_db.transparent_state db} in
 	  List.map (fun x -> flags, x) (Hint_db.map_auto (hdc,concl) db)) (local_db::db_list)
-  in 
-  let tac_of_hint = 
-    fun (st, {pri=b; pat = p; code=t}) -> 
-      (b, 
+  in
+  let tac_of_hint =
+    fun (st, {pri=b; pat = p; code=t}) ->
+      (b,
        let tac =
 	 match t with
 	   | Res_pf (term,cl) -> unify_resolve st (term,cl)
 	   | ERes_pf (term,cl) -> unify_e_resolve st (term,cl)
 	   | Give_exact (c) -> e_give_exact c
 	   | Res_pf_THEN_trivial_fail (term,cl) ->
-               tclTHEN (unify_e_resolve st (term,cl)) 
+               tclTHEN (unify_e_resolve st (term,cl))
 		 (e_trivial_fail_db db_list local_db)
 	   | Unfold_nth c -> unfold_in_concl [all_occurrences,c]
 	   | Extern tacast -> conclPattern concl p tacast
-       in 
+       in
        (tac,pr_autotactic t))
        (*i
-	 fun gls -> pPNL (pr_autotactic t); Format.print_flush (); 
+	 fun gls -> pPNL (pr_autotactic t); Format.print_flush ();
                      try tac gls
-		     with e when Logic.catchable_exception(e) -> 
-                            (Format.print_string "Fail\n"; 
-			     Format.print_flush (); 
+		     with e when Logic.catchable_exception(e) ->
+                            (Format.print_string "Fail\n";
+			     Format.print_flush ();
 			     raise e)
        i*)
-  in 
+  in
   List.map tac_of_hint hintl
-    
-and e_trivial_resolve db_list local_db gl = 
-  try 
-    priority 
-      (e_my_find_search db_list local_db 
+
+and e_trivial_resolve db_list local_db gl =
+  try
+    priority
+      (e_my_find_search db_list local_db
 	 (fst (head_constr_bound gl)) gl)
   with Bound | Not_found -> []
 
 let e_possible_resolve db_list local_db gl =
-  try List.map snd 
-    (e_my_find_search db_list local_db 
+  try List.map snd
+    (e_my_find_search db_list local_db
 	(fst (head_constr_bound gl)) gl)
   with Bound | Not_found -> []
 
-let find_first_goal gls = 
+let find_first_goal gls =
   try first_goal gls with UserError _ -> assert false
 
 (*s The following module [SearchProblem] is used to instantiate the generic
     exploration functor [Explore.Make]. *)
 
-type search_state = { 
+type search_state = {
   depth : int; (*r depth of search before failing *)
   tacres : goal list sigma * validation;
   last_tactic : std_ppcmds;
   dblist : Auto.hint_db list;
   localdb :  Auto.hint_db list }
-    
+
 module SearchProblem = struct
-    
+
   type state = search_state
 
   let success s = (sig_it (fst s.tacres)) = []
 
   let pr_ev evs ev = Printer.pr_constr_env (Evd.evar_env ev) (Evarutil.nf_evar evs ev.Evd.evar_concl)
-    
+
   let pr_goals gls =
     let evars = Evarutil.nf_evars (Refiner.project gls) in
       prlist (pr_ev evars) (sig_it gls)
-	
+
   let filter_tactics (glls,v) l =
 (*     let _ = Proof_trees.db_pr_goal (List.hd (sig_it glls)) in *)
 (*     let evars = Evarutil.nf_evars (Refiner.project glls) in *)
 (*     msg (str"Goal:" ++ pr_ev evars (List.hd (sig_it glls)) ++ str"\n"); *)
     let rec aux = function
       | [] -> []
-      | (tac,pptac) :: tacl -> 
-	  try 
-	    let (lgls,ptl) = apply_tac_list tac glls in 
+      | (tac,pptac) :: tacl ->
+	  try
+	    let (lgls,ptl) = apply_tac_list tac glls in
 	    let v' p = v (ptl p) in
 (* 	    let gl = Proof_trees.db_pr_goal (List.hd (sig_it glls)) in *)
 (* 	      msg (hov 1 (pptac ++ str" gives: \n" ++ pr_goals lgls ++ str"\n")); *)
 	      ((lgls,v'),pptac) :: aux tacl
 	  with e -> Refiner.catch_failerror e; aux tacl
     in aux l
-      
+
   (* Ordering of states is lexicographic on depth (greatest first) then
      number of remaining goals. *)
   let compare s s' =
@@ -210,18 +210,18 @@ module SearchProblem = struct
     let nbgoals s = List.length (sig_it (fst s.tacres)) in
     if d <> 0 then d else nbgoals s - nbgoals s'
 
-  let branching s = 
-    if s.depth = 0 then 
+  let branching s =
+    if s.depth = 0 then
       []
-    else      
+    else
       let lg = fst s.tacres in
       let nbgl = List.length (sig_it lg) in
       assert (nbgl > 0);
       let g = find_first_goal lg in
-      let assumption_tacs = 
-	let l = 
+      let assumption_tacs =
+	let l =
 	  filter_tactics s.tacres
-	    (List.map 
+	    (List.map
 	       (fun id -> (e_give_exact (mkVar id),
 			   (str "exact" ++ spc () ++ pr_id id)))
 	       (pf_ids_of_hyps g))
@@ -230,40 +230,40 @@ module SearchProblem = struct
 				    last_tactic = pp; dblist = s.dblist;
 				    localdb = List.tl s.localdb }) l
       in
-      let intro_tac = 
-	List.map 
-	  (fun ((lgls,_) as res,pp) -> 
-	     let g' = first_goal lgls in 
-	     let hintl = 
+      let intro_tac =
+	List.map
+	  (fun ((lgls,_) as res,pp) ->
+	     let g' = first_goal lgls in
+	     let hintl =
 	       make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
 	     in
              let ldb = Hint_db.add_list hintl (List.hd s.localdb) in
-	     { depth = s.depth; tacres = res; 
+	     { depth = s.depth; tacres = res;
 	       last_tactic = pp; dblist = s.dblist;
 	       localdb = ldb :: List.tl s.localdb })
 	  (filter_tactics s.tacres [Tactics.intro,(str "intro")])
       in
-      let rec_tacs = 
-	let l = 
+      let rec_tacs =
+	let l =
 	  filter_tactics s.tacres (e_possible_resolve s.dblist (List.hd s.localdb) (pf_concl g))
 	in
-	List.map 
-	  (fun ((lgls,_) as res, pp) -> 
+	List.map
+	  (fun ((lgls,_) as res, pp) ->
 	     let nbgl' = List.length (sig_it lgls) in
 	     if nbgl' < nbgl then
 	       { depth = s.depth; tacres = res; last_tactic = pp;
 		 dblist = s.dblist; localdb = List.tl s.localdb }
-	     else 
-	       { depth = pred s.depth; tacres = res; 
+	     else
+	       { depth = pred s.depth; tacres = res;
 		 dblist = s.dblist; last_tactic = pp;
-		 localdb = 
+		 localdb =
 		   list_addn (nbgl'-nbgl) (List.hd s.localdb) s.localdb })
 	  l
       in
       List.sort compare (assumption_tacs @ intro_tac @ rec_tacs)
 
-  let pp s = 
-    msg (hov 0 (str " depth=" ++ int s.depth ++ spc () ++ 
+  let pp s =
+    msg (hov 0 (str " depth=" ++ int s.depth ++ spc () ++
 		  s.last_tactic ++ str "\n"))
 
 end
@@ -286,36 +286,36 @@ let e_depth_search debug p db_list local_db gl =
 
 let e_breadth_search debug n db_list local_db gl =
   try
-    let tac = 
-      if debug then Search.debug_breadth_first else Search.breadth_first 
+    let tac =
+      if debug then Search.debug_breadth_first else Search.breadth_first
     in
     let s = tac (make_initial_state n gl db_list local_db) in
     s.tacres
   with Not_found -> error "eauto: breadth first search failed."
 
-let e_search_auto debug (in_depth,p) lems db_list gl = 
-  let local_db = make_local_hint_db true lems gl in 
-  if in_depth then 
+let e_search_auto debug (in_depth,p) lems db_list gl =
+  let local_db = make_local_hint_db true lems gl in
+  if in_depth then
     e_depth_search debug p db_list local_db gl
-  else 
+  else
     e_breadth_search debug p db_list local_db gl
 
 open Evd
 
-let eauto_with_bases debug np lems db_list = 
+let eauto_with_bases debug np lems db_list =
   tclTRY (e_search_auto debug np lems db_list)
 
-let eauto debug np lems dbnames = 
+let eauto debug np lems dbnames =
   let db_list =
     List.map
-      (fun x -> 
+      (fun x ->
 	 try searchtable_map x
 	 with Not_found -> error ("No such Hint database: "^x^"."))
-      ("core"::dbnames) 
+      ("core"::dbnames)
   in
   tclTRY (e_search_auto debug np lems db_list)
-  
-let full_eauto debug n lems gl = 
+
+let full_eauto debug n lems gl =
   let dbnames = current_db_names () in
   let dbnames =  list_subtract dbnames ["v62"] in
   let db_list = List.map searchtable_map dbnames in
@@ -326,7 +326,7 @@ let gen_eauto d np lems = function
   | Some l -> eauto d np lems l
 
 let make_depth = function
-  | None -> !default_search_depth 
+  | None -> !default_search_depth
   | Some (ArgArg d) -> d
   | _ -> error "eauto called with a non closed argument."
 
@@ -368,39 +368,39 @@ ARGUMENT EXTEND auto_using
 END
 
 TACTIC EXTEND eauto
-| [ "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems) 
+| [ "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
     hintbases(db) ] ->
     [ gen_eauto false (make_dimension n p) lems db ]
 END
 
 TACTIC EXTEND new_eauto
-| [ "new" "auto" int_or_var_opt(n) auto_using(lems) 
+| [ "new" "auto" int_or_var_opt(n) auto_using(lems)
     hintbases(db) ] ->
     [ match db with
       | None -> new_full_auto (make_depth n) lems
       | Some l ->
 	  new_auto (make_depth n) lems l ]
 END
-      
+
 TACTIC EXTEND debug_eauto
-| [ "debug" "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems) 
+| [ "debug" "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
     hintbases(db) ] ->
     [ gen_eauto true (make_dimension n p) lems db ]
 END
 
 TACTIC EXTEND dfs_eauto
-| [ "dfs" "eauto" int_or_var_opt(p) auto_using(lems) 
+| [ "dfs" "eauto" int_or_var_opt(p) auto_using(lems)
       hintbases(db) ] ->
     [ gen_eauto false (true, make_depth p) lems db ]
 END
 
 let autosimpl db cl =
   let unfold_of_elts constr (b, elts) =
-    if not b then 
+    if not b then
       List.map (fun c -> all_occurrences, constr c) elts
     else []
   in
-  let unfolds = List.concat (List.map (fun dbname -> 
+  let unfolds = List.concat (List.map (fun dbname ->
     let db = searchtable_map dbname in
     let (ids, csts) = Hint_db.transparent_state db in
       unfold_of_elts (fun x -> EvalConstRef x) (Cpred.elements csts) @
@@ -414,6 +414,6 @@ END
 
 TACTIC EXTEND unify
 | ["unify" constr(x) constr(y) ] -> [ unify x y ]
-| ["unify" constr(x) constr(y) "with" preident(base)  ] -> [ 
+| ["unify" constr(x) constr(y) "with" preident(base)  ] -> [
     unify ~state:(Hint_db.transparent_state (searchtable_map base)) x y ]
 END
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index d2ac36fe82..7359d070e0 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -27,7 +27,7 @@ val registered_e_assumption : tactic
 
 val e_give_exact : ?flags:Unification.unify_flags -> constr -> tactic
 
-val gen_eauto : bool -> bool * int -> constr list -> 
+val gen_eauto : bool -> bool * int -> constr list ->
   hint_db_name list option -> tactic
 
 
diff --git a/tactics/elim.ml b/tactics/elim.ml
index fd5d65d853..935431bf93 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -28,12 +28,12 @@ open Genarg
 open Tacexpr
 
 let introElimAssumsThen tac ba =
-  let nassums = 
-    List.fold_left 
-      (fun acc b -> if b then acc+2 else acc+1) 
-      0 ba.branchsign 
-  in 
-  let introElimAssums = tclDO nassums intro in 
+  let nassums =
+    List.fold_left
+      (fun acc b -> if b then acc+2 else acc+1)
+      0 ba.branchsign
+  in
+  let introElimAssums = tclDO nassums intro in
   (tclTHEN introElimAssums (elim_on_ba tac ba))
 
 let introCaseAssumsThen tac ba =
@@ -41,12 +41,12 @@ let introCaseAssumsThen tac ba =
     List.flatten
       (List.map (function b -> if b then [false;true] else [false])
 	ba.branchsign)
-  in 
+  in
   let n1 = List.length case_thin_sign in
   let n2 = List.length ba.branchnames in
   let (l1,l2),l3 =
     if n1 < n2 then list_chop n1 ba.branchnames, []
-    else 
+    else
       (ba.branchnames, []),
        if n1 > n2 then snd (list_chop n2 case_thin_sign) else [] in
   let introCaseAssums =
@@ -93,9 +93,9 @@ and general_decompose_aux recognizer id =
 let tmphyp_name = id_of_string "_TmpHyp"
 let up_to_delta = ref false (* true *)
 
-let general_decompose recognizer c gl = 
-  let typc = pf_type_of gl c in  
-  tclTHENSV (cut typc) 
+let general_decompose recognizer c gl =
+  let typc = pf_type_of gl c in
+  tclTHENSV (cut typc)
     [| tclTHEN (intro_using tmphyp_name)
          (onLastHypId
 	    (ifOnHyp recognizer (general_decompose_aux recognizer)
@@ -110,7 +110,7 @@ let head_in gls indl t =
       else extract_mrectype t
     in List.mem ity indl
   with Not_found -> false
-       
+
 let inductive_of = function
   | IndRef ity -> ity
   | r ->
@@ -118,21 +118,21 @@ let inductive_of = function
         (Printer.pr_global r ++ str " is not an inductive type.")
 
 let decompose_these c l gls =
-  let indl = (*List.map inductive_of*) l in 
+  let indl = (*List.map inductive_of*) l in
   general_decompose (fun (_,t) -> head_in gls indl t) c gls
 
 let decompose_nonrec c gls =
-  general_decompose 
+  general_decompose
     (fun (_,t) -> is_non_recursive_type t)
     c gls
 
-let decompose_and c gls = 
-  general_decompose 
+let decompose_and c gls =
+  general_decompose
     (fun (_,t) -> is_record t)
     c gls
 
-let decompose_or c gls = 
-  general_decompose 
+let decompose_or c gls =
+  general_decompose
     (fun (_,t) -> is_disjunction t)
     c gls
 
@@ -153,7 +153,7 @@ let simple_elimination c gls =
   simple_elimination_then (fun _ -> tclIDTAC) c gls
 
 let induction_trailer abs_i abs_j bargs =
-  tclTHEN 
+  tclTHEN
     (tclDO (abs_j - abs_i) intro)
     (onLastHypId
        (fun id gls ->
@@ -163,7 +163,7 @@ let induction_trailer abs_i abs_j bargs =
 	    (List.tl (nLastDecls (abs_j - abs_i) gls)) @ bargs.assums
           in
 	  let (hyps,_) =
-            List.fold_left 
+            List.fold_left
 	      (fun (bring_ids,leave_ids) (cid,_,cidty as d) ->
                  if not (List.mem cid leave_ids)
                  then (d::bring_ids,leave_ids)
@@ -172,7 +172,7 @@ let induction_trailer abs_i abs_j bargs =
 	  in
           let ids = List.rev (ids_of_named_context hyps) in
 	  (tclTHENSEQ
-            [bring_hyps hyps; tclTRY (clear ids); 
+            [bring_hyps hyps; tclTRY (clear ids);
 	     simple_elimination (mkVar id)])
           gls))
 
diff --git a/tactics/elim.mli b/tactics/elim.mli
index 1fd8a9c2bd..25ae07000b 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -23,7 +23,7 @@ val introElimAssumsThen :
   (branch_assumptions -> tactic) -> branch_args -> tactic
 
 val introCaseAssumsThen :
-  (intro_pattern_expr Util.located list -> branch_assumptions -> tactic) -> 
+  (intro_pattern_expr Util.located list -> branch_assumptions -> tactic) ->
     branch_args -> tactic
 
 val general_decompose : (identifier * constr -> bool) -> constr -> tactic
diff --git a/tactics/eqdecide.ml4 b/tactics/eqdecide.ml4
index 7b0e5e0ef1..d535e56e10 100644
--- a/tactics/eqdecide.ml4
+++ b/tactics/eqdecide.ml4
@@ -49,8 +49,8 @@ open Coqlib
       then analyse one by one the corresponding pairs of arguments.
       If they are equal, rewrite one into the other. If they are
       not, derive a contradiction from the injectiveness of the
-      constructor. 
-   4. Once all the arguments have been rewritten, solve the remaining half 
+      constructor.
+   4. Once all the arguments have been rewritten, solve the remaining half
       of the disjunction by reflexivity.
 
    Eduardo Gimenez (30/3/98).
@@ -58,12 +58,12 @@ open Coqlib
 
 let clear_last = (onLastHyp (fun c -> (clear [destVar c])))
 
-let choose_eq eqonleft = 
+let choose_eq eqonleft =
   if eqonleft then h_simplest_left else h_simplest_right
 let choose_noteq eqonleft =
   if eqonleft then h_simplest_right else h_simplest_left
 
-let mkBranches c1 c2 = 
+let mkBranches c1 c2 =
   tclTHENSEQ
     [generalize [c2];
      h_simplest_elim c1;
@@ -72,18 +72,18 @@ let mkBranches c1 c2 =
      clear_last;
      intros]
 
-let solveNoteqBranch side = 
+let solveNoteqBranch side =
   tclTHEN (choose_noteq side)
     (tclTHEN introf
       (onLastHypId (fun id -> Extratactics.h_discrHyp id)))
 
 let h_solveNoteqBranch side =
-  Refiner.abstract_extended_tactic "solveNoteqBranch" [] 
+  Refiner.abstract_extended_tactic "solveNoteqBranch" []
     (solveNoteqBranch side)
 
 (* Constructs the type {c1=c2}+{~c1=c2} *)
 
-let mkDecideEqGoal eqonleft op rectype c1 c2 g = 
+let mkDecideEqGoal eqonleft op rectype c1 c2 g =
   let equality    = mkApp(build_coq_eq(), [|rectype; c1; c2|]) in
   let disequality = mkApp(build_coq_not (), [|equality|]) in
   if eqonleft then mkApp(op, [|equality; disequality |])
@@ -92,24 +92,24 @@ let mkDecideEqGoal eqonleft op rectype c1 c2 g =
 
 (* Constructs the type (x1,x2:R){x1=x2}+{~x1=x2} *)
 
-let mkGenDecideEqGoal rectype g = 
-  let hypnames = pf_ids_of_hyps g in 
+let mkGenDecideEqGoal rectype g =
+  let hypnames = pf_ids_of_hyps g in
   let xname    = next_ident_away (id_of_string "x") hypnames
   and yname    = next_ident_away (id_of_string "y") hypnames in
-  (mkNamedProd xname rectype 
-     (mkNamedProd yname rectype 
+  (mkNamedProd xname rectype
+     (mkNamedProd yname rectype
         (mkDecideEqGoal true (build_coq_sumbool ())
           rectype (mkVar xname) (mkVar yname) g)))
 
-let eqCase tac = 
-  (tclTHEN intro  
+let eqCase tac =
+  (tclTHEN intro
   (tclTHEN (onLastHyp Equality.rewriteLR)
-  (tclTHEN clear_last 
+  (tclTHEN clear_last
   tac)))
 
 let diseqCase eqonleft =
   let diseq  = id_of_string "diseq" in
-  let absurd = id_of_string "absurd" in 
+  let absurd = id_of_string "absurd" in
   (tclTHEN (intro_using diseq)
   (tclTHEN (choose_noteq eqonleft)
   (tclTHEN  red_in_concl
@@ -118,11 +118,11 @@ let diseqCase eqonleft =
   (tclTHEN  (Extratactics.h_injHyp absurd)
             (full_trivial [])))))))
 
-let solveArg eqonleft op a1 a2 tac g = 
+let solveArg eqonleft op a1 a2 tac g =
   let rectype = pf_type_of g a1 in
   let decide  = mkDecideEqGoal eqonleft op rectype a1 a2 g in
-  let subtacs = 
-    if eqonleft then [eqCase tac;diseqCase eqonleft;default_auto] 
+  let subtacs =
+    if eqonleft then [eqCase tac;diseqCase eqonleft;default_auto]
     else [diseqCase eqonleft;eqCase tac;default_auto] in
   (tclTHENS (h_elim_type decide) subtacs) g
 
@@ -133,8 +133,8 @@ let solveEqBranch rectype g =
     let nparams   = mib.mind_nparams in
     let getargs l = list_skipn nparams (snd (decompose_app l)) in
     let rargs   = getargs rhs
-    and largs   = getargs lhs in 
-    List.fold_right2 
+    and largs   = getargs lhs in
+    List.fold_right2
       (solveArg eqonleft op) largs rargs
       (tclTHEN (choose_eq eqonleft) h_reflexivity) g
   with PatternMatchingFailure -> error "Unexpected conclusion!"
@@ -163,19 +163,19 @@ let decideGralEquality g =
 
 let decideEqualityGoal = tclTHEN intros decideGralEquality
 
-let decideEquality c1 c2 g = 
-  let rectype = (pf_type_of g c1) in     
-  let decide  = mkGenDecideEqGoal rectype g in  
+let decideEquality c1 c2 g =
+  let rectype = (pf_type_of g c1) in
+  let decide  = mkGenDecideEqGoal rectype g in
   (tclTHENS (cut decide) [default_auto;decideEqualityGoal]) g
 
 
 (* The tactic Compare *)
 
-let compare c1 c2 g = 
+let compare c1 c2 g =
   let rectype = pf_type_of g c1 in
-  let decide  = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 g in  
-  (tclTHENS (cut decide) 
-            [(tclTHEN  intro 
+  let decide  = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 g in
+  (tclTHENS (cut decide)
+            [(tclTHEN  intro
              (tclTHEN (onLastHyp simplest_case)
                        clear_last));
              decideEquality c1 c2]) g
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 20e32bea3b..1c9cae30e8 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -50,7 +50,7 @@ let discr_do_intro = ref true
 
 open Goptions
 let _ =
-  declare_bool_option 
+  declare_bool_option
     { optsync  = true;
       optname  = "automatic introduction of hypotheses by discriminate";
       optkey   = ["Discriminate";"Introduction"];
@@ -61,11 +61,11 @@ let _ =
 
 type orientation = bool
 
-type conditions = 
+type conditions =
   | Naive (* Only try the first occurence of the lemma (default) *)
   | FirstSolved (* Use the first match whose side-conditions are solved *)
   | AllMatches (* Rewrite all matches whose side-conditions are solved *)
-      
+
 (* Warning : rewriting from left to right only works
    if there exists in the context a theorem named <eqname>_<suffsort>_r
    with type (A:<sort>)(x:A)(P:A->Prop)(P x)->(y:A)(eqname A y x)->(P y).
@@ -96,12 +96,12 @@ let instantiate_lemma_all env sigma gl c ty l l2r concl =
 	  let l,res = split_last_two (y::z) in x::l, res
       | _ -> error "The term provided is not an applied relation." in
   let others,(c1,c2) = split_last_two args in
-  let try_occ (evd', c') = 
+  let try_occ (evd', c') =
     let cl' = {eqclause with evd = evd'} in
     let mvs = clenv_dependent false cl' in
       clenv_pose_metas_as_evars cl' mvs
   in
-  let occs = 
+  let occs =
     Unification.w_unify_to_subterm_all ~flags:rewrite_unif_flags env
       ((if l2r then c1 else c2),concl) eqclause.evd
   in List.map try_occ occs
@@ -121,10 +121,10 @@ let rewrite_elim_in with_evars id c e =
 
 (* Ad hoc asymmetric general_elim_clause *)
 let general_elim_clause with_evars cls rew elim =
-  try 
+  try
     (match cls with
       | None ->
-	  (* was tclWEAK_PROGRESS which only fails for tactics generating one 
+	  (* was tclWEAK_PROGRESS which only fails for tactics generating one
              subgoal and did not fail for useless conditional rewritings generating
              an extra condition *)
 	  tclNOTSAMEGOAL (rewrite_elim with_evars rew elim ~allow_K:false)
@@ -135,14 +135,14 @@ let general_elim_clause with_evars cls rew elim =
 	      (env, (Pretype_errors.NoOccurrenceFound (c', cls))))
 
 let general_elim_clause with_evars tac cls sigma c t l l2r elim gl =
-  let all, firstonly, tac = 
+  let all, firstonly, tac =
     match tac with
     | None -> false, false, None
     | Some (tac, Naive) -> false, false, Some tac
     | Some (tac, FirstSolved) -> true, true, Some (tclCOMPLETE tac)
     | Some (tac, AllMatches) -> true, false, Some (tclCOMPLETE tac)
   in
-  let cs = 
+  let cs =
     (if not all then instantiate_lemma else instantiate_lemma_all)
       (pf_env gl) sigma gl c t l l2r
       (match cls with None -> pf_concl gl | Some id -> pf_get_hyp_typ gl id)
@@ -154,10 +154,10 @@ let general_elim_clause with_evars tac cls sigma c t l l2r elim gl =
       tclFIRST (List.map try_clause cs) gl
     else tclMAP try_clause cs gl
 
-(* The next function decides in particular whether to try a regular 
-  rewrite or a generalized rewrite. 
-  Approach is to break everything, if [eq] appears in head position 
-  then regular rewrite else try general rewrite. 
+(* The next function decides in particular whether to try a regular
+  rewrite or a generalized rewrite.
+  Approach is to break everything, if [eq] appears in head position
+  then regular rewrite else try general rewrite.
   If occurrences are set, use general rewrite.
 *)
 
@@ -172,7 +172,7 @@ let register_is_applied_rewrite_relation = (:=) is_applied_rewrite_relation
 
 let find_elim hdcncl lft2rgt cls gl =
   let suffix = elimination_suffix (elimination_sort_of_clause cls gl) in
-  let hdcncls = string_of_inductive hdcncl ^ suffix in 
+  let hdcncls = string_of_inductive hdcncl ^ suffix in
   let rwr_thm = if lft2rgt = (cls = None) then hdcncls^"_r" else hdcncls in
   try pf_global gl (id_of_string rwr_thm)
   with Not_found -> error ("Cannot find rewrite principle "^rwr_thm^".")
@@ -200,16 +200,16 @@ let general_rewrite_ebindings_clause cls lft2rgt occs ?tac
     let env = pf_env gl in
     let sigma, c' = c in
     let sigma = Evd.merge sigma (project gl) in
-    let ctype = get_type_of env sigma c' in 
+    let ctype = get_type_of env sigma c' in
     let rels, t = decompose_prod_assum (whd_betaiotazeta sigma ctype) in
       match match_with_equality_type t with
       | Some (hdcncl,args) -> (* Fast path: direct leibniz rewrite *)
 	  let lft2rgt = adjust_rewriting_direction args lft2rgt in
-          leibniz_rewrite_ebindings_clause cls lft2rgt tac sigma c' (it_mkProd_or_LetIn t rels) 
+          leibniz_rewrite_ebindings_clause cls lft2rgt tac sigma c' (it_mkProd_or_LetIn t rels)
 	    l with_evars gl hdcncl
       | None ->
 	  try
-	    rewrite_side_tac (!general_rewrite_clause cls 
+	    rewrite_side_tac (!general_rewrite_clause cls
 				 lft2rgt occs (c,l) ~new_goals:[]) tac gl
 	  with e -> (* Try to see if there's an equality hidden *)
 	    let env' = push_rel_context rels env in
@@ -221,11 +221,11 @@ let general_rewrite_ebindings_clause cls lft2rgt occs ?tac
 		      (it_mkProd_or_LetIn t' (rels' @ rels)) l with_evars gl hdcncl
 	      | None -> raise e
 		  (* error "The provided term does not end with an equality or a declared rewrite relation." *)
-		      
-let general_rewrite_ebindings = 
+
+let general_rewrite_ebindings =
   general_rewrite_ebindings_clause None
 
-let general_rewrite_bindings l2r occs ?tac (c,bl) = 
+let general_rewrite_bindings l2r occs ?tac (c,bl) =
   general_rewrite_ebindings_clause None l2r occs ?tac (inj_open c,inj_ebindings bl)
 
 let general_rewrite l2r occs ?tac c =
@@ -237,55 +237,55 @@ let general_rewrite_ebindings_in l2r occs ?tac id =
 let general_rewrite_bindings_in l2r occs ?tac id (c,bl) =
   general_rewrite_ebindings_clause (Some id) l2r occs ?tac (inj_open c,inj_ebindings bl)
 
-let general_rewrite_in l2r occs ?tac id c = 
+let general_rewrite_in l2r occs ?tac id c =
   general_rewrite_ebindings_clause (Some id) l2r occs ?tac (inj_open c,NoBindings)
 
-let general_multi_rewrite l2r with_evars ?tac c cl = 
-  let occs_of = on_snd (List.fold_left 
+let general_multi_rewrite l2r with_evars ?tac c cl =
+  let occs_of = on_snd (List.fold_left
     (fun acc ->
       function ArgArg x -> x :: acc | ArgVar _ -> acc)
     [])
   in
-  match cl.onhyps with 
-    | Some l -> 
+  match cl.onhyps with
+    | Some l ->
 	(* If a precise list of locations is given, success is mandatory for
 	   each of these locations. *)
-	let rec do_hyps = function 
+	let rec do_hyps = function
 	  | [] -> tclIDTAC
-	  | ((occs,id),_) :: l -> 
+	  | ((occs,id),_) :: l ->
 	    tclTHENFIRST
 	      (general_rewrite_ebindings_in l2r (occs_of occs) ?tac id c with_evars)
 	      (do_hyps l)
-	in 
+	in
 	if cl.concl_occs = no_occurrences_expr then do_hyps l else
 	  tclTHENFIRST
 	   (general_rewrite_ebindings l2r (occs_of cl.concl_occs) ?tac c with_evars)
 	   (do_hyps l)
-    | None -> 
-	(* Otherwise, if we are told to rewrite in all hypothesis via the 
-           syntax "* |-", we fail iff all the different rewrites fail *) 
-	let rec do_hyps_atleastonce = function 
+    | None ->
+	(* Otherwise, if we are told to rewrite in all hypothesis via the
+           syntax "* |-", we fail iff all the different rewrites fail *)
+	let rec do_hyps_atleastonce = function
 	  | [] -> (fun gl -> error "Nothing to rewrite.")
-	  | id :: l -> 
-	    tclIFTHENTRYELSEMUST 
+	  | id :: l ->
+	    tclIFTHENTRYELSEMUST
 	     (general_rewrite_ebindings_in l2r all_occurrences ?tac id c with_evars)
 	     (do_hyps_atleastonce l)
-	in 
-	let do_hyps gl = 
+	in
+	let do_hyps gl =
 	  (* If the term to rewrite uses an hypothesis H, don't rewrite in H *)
-	  let ids = 
+	  let ids =
 	    let ids_in_c = Environ.global_vars_set (Global.env()) (snd (fst c)) in
 	      Idset.fold (fun id l -> list_remove id l) ids_in_c (pf_ids_of_hyps gl)
 	  in do_hyps_atleastonce ids gl
-	in 
+	in
 	if cl.concl_occs = no_occurrences_expr then do_hyps else
-	  tclIFTHENTRYELSEMUST 
+	  tclIFTHENTRYELSEMUST
 	   (general_rewrite_ebindings l2r (occs_of cl.concl_occs) ?tac c with_evars)
 	   do_hyps
 
-let general_multi_multi_rewrite with_evars l cl tac = 
+let general_multi_multi_rewrite with_evars l cl tac =
   let do1 l2r c = general_multi_rewrite l2r with_evars ?tac c cl in
-  let rec doN l2r c = function 
+  let rec doN l2r c = function
     | Precisely n when n <= 0 -> tclIDTAC
     | Precisely 1 -> do1 l2r c
     | Precisely n -> tclTHENFIRST (do1 l2r c) (doN l2r c (Precisely (n-1)))
@@ -293,7 +293,7 @@ let general_multi_multi_rewrite with_evars l cl tac =
     | RepeatPlus -> tclTHENFIRST (do1 l2r c) (doN l2r c RepeatStar)
     | UpTo n when n<=0 -> tclIDTAC
     | UpTo n -> tclTHENFIRST (tclTRY (do1 l2r c)) (doN l2r c (UpTo (n-1)))
-  in 
+  in
   let rec loop = function
     | [] -> tclIDTAC
     | (l2r,m,c)::l -> tclTHENFIRST (doN l2r c m) (loop l)
@@ -307,24 +307,24 @@ let rewriteRL = general_rewrite false all_occurrences
 (* eq,sym_eq : equality on Type and its symmetry theorem
    c2 c1 : c1 is to be replaced by c2
    unsafe : If true, do not check that c1 and c2 are convertible
-   tac : Used to prove the equality c1 = c2 
+   tac : Used to prove the equality c1 = c2
    gl : goal *)
 
-let multi_replace clause c2 c1 unsafe try_prove_eq_opt gl = 
-  let try_prove_eq = 
-    match try_prove_eq_opt with 
+let multi_replace clause c2 c1 unsafe try_prove_eq_opt gl =
+  let try_prove_eq =
+    match try_prove_eq_opt with
       | None -> tclIDTAC
       | Some tac ->  tclCOMPLETE tac
   in
-  let t1 = pf_apply get_type_of gl c1 
+  let t1 = pf_apply get_type_of gl c1
   and t2 = pf_apply get_type_of gl c2 in
   if unsafe or (pf_conv_x gl t1 t2) then
     let e = build_coq_eq () in
     let sym = build_coq_eq_sym () in
     let eq = applist (e, [t1;c1;c2]) in
     tclTHENS (assert_as false None eq)
-      [onLastHypId (fun id -> 
-	tclTHEN 
+      [onLastHypId (fun id ->
+	tclTHEN
 	  (tclTRY (general_multi_rewrite false false (inj_open (mkVar id),NoBindings) clause))
 	  (clear [id]));
        tclFIRST
@@ -335,7 +335,7 @@ let multi_replace clause c2 c1 unsafe try_prove_eq_opt gl =
       ] gl
   else
     error "Terms do not have convertible types."
-  
+
 
 let replace c2 c1 gl = multi_replace onConcl c2 c1 false None gl
 
@@ -345,7 +345,7 @@ let replace_by c2 c1 tac gl = multi_replace onConcl c2 c1 false (Some tac) gl
 
 let replace_in_by id c2 c1 tac gl = multi_replace (onHyp id) c2 c1 false (Some tac) gl
 
-let replace_in_clause_maybe_by c2 c1 cl tac_opt gl = 
+let replace_in_clause_maybe_by c2 c1 cl tac_opt gl =
   multi_replace cl c2 c1 false tac_opt gl
 
 (* End of Eduardo's code. The rest of this file could be improved
@@ -400,8 +400,8 @@ let find_positions env sigma t1 t2 =
     let hd1,args1 = whd_betadeltaiota_stack env sigma t1 in
     let hd2,args2 = whd_betadeltaiota_stack env sigma t2 in
     match (kind_of_term hd1, kind_of_term hd2) with
-  	
-      | Construct sp1, Construct sp2 
+
+      | Construct sp1, Construct sp2
           when List.length args1 = mis_constructor_nargs_env env sp1
             ->
 	  let sorts = list_intersect sorts (allowed_sorts env (fst sp1)) in
@@ -419,14 +419,14 @@ let find_positions env sigma t1 t2 =
 	  else []
 
       | _ ->
-	  let t1_0 = applist (hd1,args1) 
+	  let t1_0 = applist (hd1,args1)
           and t2_0 = applist (hd2,args2) in
-          if is_conv env sigma t1_0 t2_0 then 
+          if is_conv env sigma t1_0 t2_0 then
 	    []
           else
 	    let ty1_0 = get_type_of env sigma t1_0 in
 	    let s = get_sort_family_of env sigma ty1_0 in
-	    if List.mem s sorts then [(List.rev posn,t1_0,t2_0)] else [] in 
+	    if List.mem s sorts then [(List.rev posn,t1_0,t2_0)] else [] in
   try
     (* Rem: to allow injection on proofs objects, just add InProp *)
     Inr (findrec [InSet;InType] [] t1 t2)
@@ -438,7 +438,7 @@ let discriminable env sigma t1 t2 =
     | Inl _ -> true
     | _ -> false
 
-let injectable env sigma t1 t2 = 
+let injectable env sigma t1 t2 =
     match find_positions env sigma t1 t2 with
     | Inl _ | Inr [] -> false
     | Inr _ -> true
@@ -553,13 +553,13 @@ let construct_discriminator sigma env dirn c sort =
   let IndType(indf,_) =
     try find_rectype env sigma (get_type_of env sigma c)
     with Not_found ->
-       (* one can find Rel(k) in case of dependent constructors 
-          like T := c : (A:Set)A->T and a discrimination 
+       (* one can find Rel(k) in case of dependent constructors
+          like T := c : (A:Set)A->T and a discrimination
           on (c bool true) = (c bool false)
           CP : changed assert false in a more informative error
        *)
       errorlabstrm "Equality.construct_discriminator"
-	(str "Cannot discriminate on inductive constructors with 
+	(str "Cannot discriminate on inductive constructors with
 		 dependent types.") in
   let (ind,_) = dest_ind_family indf in
   let (mib,mip) = lookup_mind_specif env ind in
@@ -574,7 +574,7 @@ let construct_discriminator sigma env dirn c sort =
     List.map build_branch(interval 1 (Array.length mip.mind_consnames)) in
   let ci = make_case_info env ind RegularStyle in
   mkCase (ci, p, c, Array.of_list brl)
-    
+
 let rec build_discriminator sigma env dirn c sort = function
   | [] -> construct_discriminator sigma env dirn c sort
   | ((sp,cnum),argnum)::l ->
@@ -599,13 +599,13 @@ let gen_absurdity id gl =
   then
     simplest_elim (mkVar id) gl
   else
-    errorlabstrm "Equality.gen_absurdity" 
+    errorlabstrm "Equality.gen_absurdity"
       (str "Not the negation of an equality.")
 
 (* Precondition: eq is leibniz equality
- 
+
    returns ((eq_elim t t1 P i t2), absurd_term)
-   where  P=[e:t]discriminator 
+   where  P=[e:t]discriminator
           absurd_term=False
 *)
 
@@ -622,7 +622,7 @@ let eq_baseid = id_of_string "e"
 let apply_on_clause (f,t) clause =
   let sigma =  clause.evd in
   let f_clause = mk_clenv_from_env clause.env sigma None (f,t) in
-  let argmv = 
+  let argmv =
     (match kind_of_term (last_arg f_clause.templval.Evd.rebus) with
      | Meta mv -> mv
      | _  -> errorlabstrm "" (str "Ill-formed clause applicator.")) in
@@ -647,7 +647,7 @@ let discrEq (lbeq,_,(t,t1,t2) as u) eq_clause gls =
     | Inr _ ->
 	errorlabstrm "discr" (str"Not a discriminable equality.")
     | Inl (cpath, (_,dirn), _) ->
-	let sort = pf_apply get_type_of gls (pf_concl gls) in 
+	let sort = pf_apply get_type_of gls (pf_concl gls) in
 	discr_positions env sigma u eq_clause cpath dirn sort gls
 
 let onEquality with_evars tac (c,lbindc) gls =
@@ -658,7 +658,7 @@ let onEquality with_evars tac (c,lbindc) gls =
   let eqn = clenv_type eq_clause' in
   let eq,eq_args = find_this_eq_data_decompose gls eqn in
   tclTHEN
-    (Refiner.tclEVARS eq_clause'.evd) 
+    (Refiner.tclEVARS eq_clause'.evd)
     (tac (eq,eqn,eq_args) eq_clause') gls
 
 let onNegatedEquality with_evars tac gls =
@@ -666,9 +666,9 @@ let onNegatedEquality with_evars tac gls =
   match kind_of_term (hnf_constr (pf_env gls) (project gls) ccl) with
   | Prod (_,t,u) when is_empty_type u ->
       tclTHEN introf
-        (onLastHypId (fun id -> 
+        (onLastHypId (fun id ->
           onEquality with_evars tac (mkVar id,NoBindings))) gls
-  | _ -> 
+  | _ ->
       errorlabstrm "" (str "Not a negated primitive equality.")
 
 let discrSimpleClause with_evars = function
@@ -679,18 +679,18 @@ let discr with_evars = onEquality with_evars discrEq
 
 let discrClause with_evars = onClause (discrSimpleClause with_evars)
 
-let discrEverywhere with_evars = 
+let discrEverywhere with_evars =
 (*
   tclORELSE
 *)
     (if !discr_do_intro then
       (tclTHEN
-	(tclREPEAT introf) 
+	(tclREPEAT introf)
 	(Tacticals.tryAllHyps
           (fun id -> tclCOMPLETE (discr with_evars (mkVar id,NoBindings)))))
      else (* <= 8.2 compat *)
        Tacticals.tryAllHypsAndConcl (discrSimpleClause with_evars))
-(*    (fun gls -> 
+(*    (fun gls ->
        errorlabstrm "DiscrEverywhere" (str"No discriminable equalities."))
 *)
 let discr_tac with_evars = function
@@ -702,8 +702,8 @@ let discrHyp id gls = discrClause false (onHyp id) gls
 
 (* returns the sigma type (sigS, sigT) with the respective
     constructor depending on the sort *)
-(* J.F.: correction du bug #1167 en accord avec Hugo. *) 
-   
+(* J.F.: correction du bug #1167 en accord avec Hugo. *)
+
 let find_sigma_data s = build_sigma_type ()
 
 (* [make_tuple env sigma (rterm,rty) lind] assumes [lind] is the lesser
@@ -746,8 +746,8 @@ let minimal_free_rels env sigma (c,cty) =
     (cty',rels')
 
 (* [sig_clausal_form siglen ty]
-    
-   Will explode [siglen] [sigS,sigT ]'s on [ty] (depending on the 
+
+   Will explode [siglen] [sigS,sigT ]'s on [ty] (depending on the
    type of ty), and return:
 
    (1) a pattern, with meta-variables in it for various arguments,
@@ -761,9 +761,9 @@ let minimal_free_rels env sigma (c,cty) =
 
    (4) a typing for each patvar
 
-   WARNING: No checking is done to make sure that the 
+   WARNING: No checking is done to make sure that the
             sigS(or sigT)'s are actually there.
-          - Only homogenious pairs are built i.e. pairs where all the 
+          - Only homogenious pairs are built i.e. pairs where all the
    dependencies are of the same sort
 
    [sig_clausal_form] proceed as follows: the default tuple is
@@ -782,7 +782,7 @@ let minimal_free_rels env sigma (c,cty) =
  *)
 
 let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
-  let { intro = exist_term } = find_sigma_data sort_of_ty in 
+  let { intro = exist_term } = find_sigma_data sort_of_ty in
   let evdref = ref (Evd.create_goal_evar_defs sigma) in
   let rec sigrec_clausal_form siglen p_i =
     if siglen = 0 then
@@ -801,7 +801,7 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
       let rty = beta_applist(p_i_minus_1,[ev]) in
       let tuple_tail = sigrec_clausal_form (siglen-1) rty in
       match
-	Evd.existential_opt_value !evdref 
+	Evd.existential_opt_value !evdref
 	(destEvar ev)
       with
 	| Some w -> applist(exist_term,[a;p_i_minus_1;w;tuple_tail])
@@ -873,7 +873,7 @@ let make_iterated_tuple env sigma dflt (z,zty) =
   let sort_of_zty = get_sort_of env sigma zty in
   let sorted_rels = Sort.list (<) (Intset.elements rels) in
   let (tuple,tuplety) =
-    List.fold_left (make_tuple env sigma) (z,zty) sorted_rels 
+    List.fold_left (make_tuple env sigma) (z,zty) sorted_rels
   in
   assert (closed0 tuplety);
   let n = List.length sorted_rels in
@@ -898,22 +898,22 @@ let build_injector sigma env dflt c cpath =
 
 (*
 let try_delta_expand env sigma t =
-  let whdt = whd_betadeltaiota env sigma t  in 
+  let whdt = whd_betadeltaiota env sigma t  in
   let rec hd_rec c  =
     match kind_of_term c with
       | Construct _ -> whdt
       | App (f,_)  -> hd_rec f
       | Cast (c,_,_) -> hd_rec c
       | _  -> t
-  in 
-  hd_rec whdt 
+  in
+  hd_rec whdt
 *)
 
-(* Given t1=t2 Inj calculates the whd normal forms of t1 and t2 and it 
+(* Given t1=t2 Inj calculates the whd normal forms of t1 and t2 and it
    expands then only when the whdnf has a constructor of an inductive type
    in hd position, otherwise delta expansion is not done *)
 
-let simplify_args env sigma t = 
+let simplify_args env sigma t =
   (* Quick hack to reduce in arguments of eq only *)
   match decompose_app t with
     | eq, [t;c1;c2] -> applist (eq,[t;nf env sigma c1;nf env sigma c2])
@@ -953,7 +953,7 @@ let injEq ipats (eq,_,(t,t1,t2) as u) eq_clause =
 	errorlabstrm "Inj"
 	  (str"Not a projectable equality but a discriminable one.")
     | Inr [] ->
-	errorlabstrm "Equality.inj" 
+	errorlabstrm "Equality.inj"
 	   (str"Nothing to do, it is an equality between convertible terms.")
     | Inr posns ->
 (* Est-ce utile à partir du moment où les arguments projetés subissent "nf" ?
@@ -964,7 +964,7 @@ let injEq ipats (eq,_,(t,t1,t2) as u) eq_clause =
 (* fetch the informations of the  pair *)
         let ceq = constr_of_global Coqlib.glob_eq in
         let sigTconstr () = (Coqlib.build_sigma_type()).Coqlib.typ in
-        let eqTypeDest = fst (destApp t) in 
+        let eqTypeDest = fst (destApp t) in
         let _,ar1 = destApp t1 and
             _,ar2 = destApp t2 in
         let ind = destInd ar1.(0) in
@@ -977,11 +977,11 @@ let injEq ipats (eq,_,(t,t1,t2) as u) eq_clause =
         if ( (eqTypeDest = sigTconstr()) &&
              (Ind_tables.check_dec_proof ind=true) &&
              (is_conv env sigma (ar1.(2)) (ar2.(2)) = true))
-              then ( 
+              then (
 (* Require Import Eqdec_dec copied from vernac_require in vernacentries.ml*)
-              let qidl = qualid_of_reference 
+              let qidl = qualid_of_reference
                 (Ident (dummy_loc,id_of_string "Eqdep_dec")) in
-              Library.require_library [qidl] (Some false); 
+              Library.require_library [qidl] (Some false);
 (* cut with the good equality and prove the requested goal *)
               tclTHENS (cut (mkApp (ceq,new_eq_args)) )
                [tclIDTAC; tclTHEN (apply (
@@ -991,7 +991,7 @@ let injEq ipats (eq,_,(t,t1,t2) as u) eq_clause =
                   )) (Auto.trivial [] [])
                 ]
 (* not a dep eq or no decidable type found *)
-            ) else (raise Not_dep_pair) 
+            ) else (raise Not_dep_pair)
         ) with _ ->
 	tclTHEN
 	  (inject_at_positions env sigma u eq_clause posns)
@@ -1007,9 +1007,9 @@ let injConcl gls  = injClause [] false None gls
 let injHyp id gls = injClause [] false (Some (ElimOnIdent (dummy_loc,id))) gls
 
 let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause gls =
-  let sort = pf_apply get_type_of gls (pf_concl gls) in 
+  let sort = pf_apply get_type_of gls (pf_concl gls) in
   let sigma =  clause.evd in
-  let env = pf_env gls in 
+  let env = pf_env gls in
   match find_positions env sigma t1 t2 with
     | Inl (cpath, (_,dirn), _) ->
 	discr_positions env sigma u clause cpath dirn sort gls
@@ -1033,7 +1033,7 @@ let swap_equality_args = function
   | HeterogenousEq (t1,e1,t2,e2) -> [t2;e2;t1;e1]
 
 let swap_equands gls eqn =
-  let (lbeq,eq_args) = find_eq_data eqn in 
+  let (lbeq,eq_args) = find_eq_data eqn in
   applist(lbeq.eq,swap_equality_args eq_args)
 
 let swapEquandsInConcl gls =
@@ -1081,7 +1081,7 @@ let bareRevSubstInConcl lbeq body (t,e1,e2) gls =
 
  *)
 
-let decomp_tuple_term env c t = 
+let decomp_tuple_term env c t =
   let rec decomprec inner_code ex exty =
     try
       let {proj1=p1; proj2=p2},(a,p,car,cdr) = find_sigma_data_decompose ex in
@@ -1125,7 +1125,7 @@ let cutSubstInConcl_LR eqn gls =
 let cutSubstInConcl l2r =if l2r then cutSubstInConcl_LR else cutSubstInConcl_RL
 
 let cutSubstInHyp_LR eqn id gls =
-  let (lbeq,(t,e1,e2 as eq)) = find_eq_data_decompose gls eqn in 
+  let (lbeq,(t,e1,e2 as eq)) = find_eq_data_decompose gls eqn in
   let body = pf_apply subst_tuple_term gls e1 (pf_get_hyp_typ gls id) in
   if not (dependent (mkRel 1) body) then raise NothingToRewrite;
   cut_replacing id (subst1 e2 body)
@@ -1139,12 +1139,12 @@ let cutSubstInHyp_RL eqn id gls =
 let cutSubstInHyp l2r = if l2r then cutSubstInHyp_LR else cutSubstInHyp_RL
 
 let try_rewrite tac gls =
-  try 
+  try
     tac gls
-  with 
+  with
     | PatternMatchingFailure ->
 	errorlabstrm "try_rewrite" (str "Not a primitive equality here.")
-    | e when catchable_exception e -> 
+    | e when catchable_exception e ->
 	errorlabstrm "try_rewrite"
           (strbrk "Cannot find a well-typed generalization of the goal that makes the proof progress.")
     | NothingToRewrite ->
@@ -1227,7 +1227,7 @@ let subst_one x gl =
   (* x is a variable: *)
   let varx = mkVar x in
   (* Find a non-recursive definition for x *)
-  let (hyp,rhs,dir) = 
+  let (hyp,rhs,dir) =
     try
       let test hyp _ = is_eq_x gl varx hyp in
       Sign.fold_named_context test ~init:() hyps;
@@ -1237,8 +1237,8 @@ let subst_one x gl =
     with FoundHyp res -> res
   in
   (* The set of hypotheses using x *)
-  let depdecls = 
-    let test (id,_,c as dcl) = 
+  let depdecls =
+    let test (id,_,c as dcl) =
       if id <> hyp && occur_var_in_decl (pf_env gl) x dcl then dcl
       else failwith "caught" in
     List.rev (map_succeed test hyps) in
@@ -1261,7 +1261,7 @@ let subst_one x gl =
 	  (Some (replace_term varx rhs htyp)) nowhere
   in
   let need_rewrite = dephyps <> [] || depconcl in
-  tclTHENLIST 
+  tclTHENLIST
     ((if need_rewrite then
       [generalize abshyps;
        (if dir then rewriteLR else rewriteRL) (mkVar hyp);
@@ -1281,7 +1281,7 @@ let subst_all ?(strict=true) gl =
       if strict then restrict_to_eq_and_identity lbeq.eq;
       (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
       if eq_constr x y then failwith "caught";
-      match kind_of_term x with Var x -> x | _ -> 
+      match kind_of_term x with Var x -> x | _ ->
       match kind_of_term y with Var y -> y | _ -> failwith "caught"
     with PatternMatchingFailure -> failwith "caught"
   in
@@ -1290,7 +1290,7 @@ let subst_all ?(strict=true) gl =
   subst ids gl
 
 
-(* Rewrite the first assumption for which the condition faildir does not fail 
+(* Rewrite the first assumption for which the condition faildir does not fail
    and gives the direction of the rewrite *)
 
 let cond_eq_term_left c t gl =
@@ -1299,41 +1299,41 @@ let cond_eq_term_left c t gl =
     if pf_conv_x gl c x then true else failwith "not convertible"
   with PatternMatchingFailure -> failwith "not an equality"
 
-let cond_eq_term_right c t gl = 
+let cond_eq_term_right c t gl =
   try
     let (_,_,x) = snd (find_eq_data_decompose gl t) in
     if pf_conv_x gl c x then false else failwith "not convertible"
   with PatternMatchingFailure -> failwith "not an equality"
 
-let cond_eq_term c t gl = 
+let cond_eq_term c t gl =
   try
     let (_,x,y) = snd (find_eq_data_decompose gl t) in
-    if pf_conv_x gl c x then true 
+    if pf_conv_x gl c x then true
     else if pf_conv_x gl c y then false
     else failwith "not convertible"
   with PatternMatchingFailure -> failwith "not an equality"
 
-let rewrite_multi_assumption_cond cond_eq_term cl gl = 
-  let rec arec = function 
+let rewrite_multi_assumption_cond cond_eq_term cl gl =
+  let rec arec = function
     | [] -> error "No such assumption."
-    | (id,_,t) ::rest -> 
-	begin 
-	  try 
-	    let dir = cond_eq_term t gl in 
+    | (id,_,t) ::rest ->
+	begin
+	  try
+	    let dir = cond_eq_term t gl in
 	    general_multi_rewrite dir false (inj_open (mkVar id),NoBindings) cl gl
 	  with | Failure _ | UserError _ -> arec rest
 	end
-  in 
+  in
   arec (pf_hyps gl)
 
-let replace_multi_term dir_opt c  = 
-  let cond_eq_fun = 
-    match dir_opt with 
+let replace_multi_term dir_opt c  =
+  let cond_eq_fun =
+    match dir_opt with
       | None -> cond_eq_term c
       | Some true -> cond_eq_term_left c
       | Some false -> cond_eq_term_right c
-  in 
-  rewrite_multi_assumption_cond cond_eq_fun 
+  in
+  rewrite_multi_assumption_cond cond_eq_fun
 
-let _ = Tactics.register_general_multi_rewrite 
+let _ = Tactics.register_general_multi_rewrite
   (fun b evars t cls -> general_multi_rewrite b evars t cls)
diff --git a/tactics/equality.mli b/tactics/equality.mli
index 9d5bcca7af..7b63099c74 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -29,14 +29,14 @@ open Genarg
 
 type orientation = bool
 
-type conditions = 
+type conditions =
   | Naive (* Only try the first occurence of the lemma (default) *)
   | FirstSolved (* Use the first match whose side-conditions are solved *)
   | AllMatches (* Rewrite all matches whose side-conditions are solved *)
-      
-val general_rewrite_bindings : 
+
+val general_rewrite_bindings :
   orientation -> occurrences -> ?tac:(tactic * conditions) -> constr with_bindings -> evars_flag -> tactic
-val general_rewrite : 
+val general_rewrite :
   orientation -> occurrences -> ?tac:(tactic * conditions) -> constr -> tactic
 
 (* Equivalent to [general_rewrite l2r] *)
@@ -50,18 +50,18 @@ val register_general_rewrite_clause :
     occurrences -> open_constr with_bindings -> new_goals:constr list -> tactic) -> unit
 val register_is_applied_rewrite_relation : (env -> evar_defs -> rel_context -> constr -> open_constr option) -> unit
 
-val general_rewrite_ebindings_clause : identifier option -> 
+val general_rewrite_ebindings_clause : identifier option ->
   orientation -> occurrences -> ?tac:(tactic * conditions) -> open_constr with_bindings -> evars_flag -> tactic
 
-val general_rewrite_bindings_in : 
+val general_rewrite_bindings_in :
   orientation -> occurrences -> ?tac:(tactic * conditions) -> identifier -> constr with_bindings -> evars_flag -> tactic
 val general_rewrite_in          :
   orientation -> occurrences -> ?tac:(tactic * conditions) -> identifier -> constr -> evars_flag -> tactic
 
 val general_multi_rewrite :
   orientation -> evars_flag -> ?tac:(tactic * conditions) -> open_constr with_bindings -> clause -> tactic
-val general_multi_multi_rewrite : 
-  evars_flag -> (bool * multi * open_constr with_bindings) list -> clause -> 
+val general_multi_multi_rewrite :
+  evars_flag -> (bool * multi * open_constr with_bindings) list -> clause ->
   (tactic * conditions) option -> tactic
 
 val replace_in_clause_maybe_by : constr -> constr -> clause -> tactic option -> tactic
@@ -75,11 +75,11 @@ val discrConcl   : tactic
 val discrClause  : evars_flag -> clause -> tactic
 val discrHyp     : identifier -> tactic
 val discrEverywhere : evars_flag -> tactic
-val discr_tac    : evars_flag -> 
+val discr_tac    : evars_flag ->
   constr with_ebindings induction_arg option -> tactic
 val inj          : intro_pattern_expr located list -> evars_flag ->
   constr with_ebindings -> tactic
-val injClause    : intro_pattern_expr located list -> evars_flag -> 
+val injClause    : intro_pattern_expr located list -> evars_flag ->
   constr with_ebindings induction_arg option -> tactic
 val injHyp       : identifier -> tactic
 val injConcl     : tactic
@@ -87,7 +87,7 @@ val injConcl     : tactic
 val dEq : evars_flag -> constr with_ebindings induction_arg option -> tactic
 val dEqThen : evars_flag -> (int -> tactic) -> constr with_ebindings induction_arg option -> tactic
 
-val make_iterated_tuple : 
+val make_iterated_tuple :
   env -> evar_map -> constr -> (constr * types) -> constr * constr * constr
 
 (* The family cutRewriteIn expect an equality statement *)
@@ -132,7 +132,7 @@ val subst : identifier list -> tactic
 val subst_all : ?strict:bool -> tactic
 
 (* Replace term *)
-(* [replace_multi_term dir_opt c cl] 
+(* [replace_multi_term dir_opt c cl]
    perfoms replacement of [c] by the first value found in context
    (according to [dir] if given to get the rewrite direction)  in the clause [cl]
 *)
diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml
index 0d08b72aae..ad392c7d84 100644
--- a/tactics/evar_tactics.ml
+++ b/tactics/evar_tactics.ml
@@ -21,31 +21,31 @@ open Termops
 
 (* The instantiate tactic *)
 
-let evar_list evc c = 
+let evar_list evc c =
   let rec evrec acc c =
     match kind_of_term c with
     | Evar (n, _) when Evd.mem evc n -> c :: acc
     | _ -> fold_constr evrec acc c
-  in 
+  in
     evrec [] c
 
-let instantiate n (ist,rawc) ido gl = 
+let instantiate n (ist,rawc) ido gl =
   let sigma = gl.sigma in
-  let evl = 
+  let evl =
     match ido with
-	ConclLocation () -> evar_list sigma gl.it.evar_concl 
+	ConclLocation () -> evar_list sigma gl.it.evar_concl
       | HypLocation (id,hloc) ->
 	  let decl = Environ.lookup_named_val id gl.it.evar_hyps in
 	    match hloc with
-		InHyp ->  
-		  (match decl with 
+		InHyp ->
+		  (match decl with
 		      (_,None,typ) -> evar_list sigma typ
-		    | _ -> error 
+		    | _ -> error
 			"Please be more specific: in type or value?")
 	      | InHypTypeOnly ->
 		  let (_, _, typ) = decl in evar_list sigma typ
 	      | InHypValueOnly ->
-		  (match decl with 
+		  (match decl with
 		      (_,Some body,_) -> evar_list sigma body
 		    | _ -> error "Not a defined hypothesis.") in
     if List.length evl < n then
@@ -59,9 +59,9 @@ let instantiate n (ist,rawc) ido gl =
         (tclEVARS sigma')
         tclNORMEVAR
         gl
-	
+
 let let_evar name typ gls =
   let sigma',evar = Evarutil.new_evar gls.sigma (pf_env gls) typ in
   Refiner.tclTHEN (Refiner.tclEVARS sigma')
     (Tactics.letin_tac None name evar None nowhere) gls
- 
+
diff --git a/tactics/evar_tactics.mli b/tactics/evar_tactics.mli
index 7a305f2001..2e30cdfbee 100644
--- a/tactics/evar_tactics.mli
+++ b/tactics/evar_tactics.mli
@@ -13,7 +13,7 @@ open Names
 open Tacexpr
 open Termops
 
-val instantiate : int -> Tacinterp.interp_sign * Rawterm.rawconstr -> 
+val instantiate : int -> Tacinterp.interp_sign * Rawterm.rawconstr ->
   (identifier * hyp_location_flag, unit) location -> tactic
 
 (*i
diff --git a/tactics/extraargs.ml4 b/tactics/extraargs.ml4
index 4e3e04c67f..e6eefea8ab 100644
--- a/tactics/extraargs.ml4
+++ b/tactics/extraargs.ml4
@@ -41,9 +41,9 @@ let pr_int_list _prc _prlc _prt l =
   in aux l
 
 ARGUMENT EXTEND int_nelist
-  TYPED AS int list 
+  TYPED AS int list
   PRINTED BY pr_int_list
-  RAW_TYPED AS int list 
+  RAW_TYPED AS int list
   RAW_PRINTED BY pr_int_list
   GLOB_TYPED AS int list
   GLOB_PRINTED BY pr_int_list
@@ -65,11 +65,11 @@ let coerce_to_int = function
 let int_list_of_VList = function
   | VList l -> List.map (fun n -> coerce_to_int n) l
   | _ -> raise Not_found
-      
-let interp_occs ist gl l = 
+
+let interp_occs ist gl l =
   match l with
     | ArgArg x -> x
-    | ArgVar (_,id as locid) -> 
+    | ArgVar (_,id as locid) ->
 	(try int_list_of_VList (List.assoc id ist.lfun)
 	  with Not_found | CannotCoerceTo _ -> [interp_int ist locid])
 
@@ -111,14 +111,14 @@ let subst_raw = Tacinterp.subst_rawconstr_and_expr
 ARGUMENT EXTEND raw
     TYPED AS rawconstr
     PRINTED BY pr_rawc
-     
-     INTERPRETED BY interp_raw	
+
+     INTERPRETED BY interp_raw
      GLOBALIZED BY glob_raw
      SUBSTITUTED BY subst_raw
-     
+
      RAW_TYPED AS constr_expr
      RAW_PRINTED BY pr_gen
-     
+
      GLOB_TYPED AS rawconstr_and_expr
      GLOB_PRINTED BY pr_gen
   [ lconstr(c) ] -> [ c ]
@@ -132,9 +132,9 @@ type place = identifier gen_place
 let pr_gen_place pr_id = function
     ConclLocation () -> Pp.mt ()
   | HypLocation (id,InHyp) -> str "in " ++ pr_id id
-  | HypLocation (id,InHypTypeOnly) -> 
+  | HypLocation (id,InHypTypeOnly) ->
       str "in (Type of " ++ pr_id id ++ str ")"
-  | HypLocation (id,InHypValueOnly) -> 
+  | HypLocation (id,InHypValueOnly) ->
       str "in (Value of " ++ pr_id id ++ str ")"
 
 let pr_loc_place _ _ _ = pr_gen_place (fun (_,id) -> Nameops.pr_id id)
@@ -148,7 +148,7 @@ let interp_place ist gl = function
     ConclLocation () -> ConclLocation ()
   | HypLocation (id,hl) -> HypLocation (interp_hyp ist gl id,hl)
 
-let subst_place subst pl = pl 
+let subst_place subst pl = pl
 
 ARGUMENT EXTEND hloc
     TYPED AS place
@@ -160,17 +160,17 @@ ARGUMENT EXTEND hloc
     RAW_PRINTED BY pr_loc_place
     GLOB_TYPED AS loc_place
     GLOB_PRINTED BY pr_loc_place
-  [ ] -> 
+  [ ] ->
     [ ConclLocation () ]
-  |  [ "in" "|-" "*" ] -> 
+  |  [ "in" "|-" "*" ] ->
     [ ConclLocation () ]
 | [ "in" ident(id) ] ->
     [ HypLocation ((Util.dummy_loc,id),InHyp) ]
-| [ "in" "(" "Type" "of" ident(id) ")" ] -> 
+| [ "in" "(" "Type" "of" ident(id) ")" ] ->
     [ HypLocation ((Util.dummy_loc,id),InHypTypeOnly) ]
-| [ "in" "(" "Value" "of" ident(id) ")" ] -> 
+| [ "in" "(" "Value" "of" ident(id) ")" ] ->
     [ HypLocation ((Util.dummy_loc,id),InHypValueOnly) ]
-   
+
  END
 
 
@@ -181,8 +181,8 @@ ARGUMENT EXTEND hloc
 
 (* Julien: Mise en commun des differentes version de replace with in by *)
 
-let pr_by_arg_tac _prc _prlc prtac opt_c = 
-  match opt_c with 
+let pr_by_arg_tac _prc _prlc prtac opt_c =
+  match opt_c with
     | None -> mt ()
     | Some t -> spc () ++ hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t)
 
@@ -192,37 +192,37 @@ ARGUMENT EXTEND by_arg_tac
 | [ "by" tactic3(c) ] -> [ Some c ]
 | [ ] -> [ None ]
 END
- 
 
-let pr_in_hyp  pr_id (lo,concl) :  Pp.std_ppcmds = 
-  match lo,concl with 
+
+let pr_in_hyp  pr_id (lo,concl) :  Pp.std_ppcmds =
+  match lo,concl with
     | Some [],true -> mt ()
     | None,true -> str "in" ++ spc () ++ str "*"
-    | None,false -> str "in" ++ spc () ++ str "*" ++ spc () ++ str "|-" 
-    | Some l,_ -> 
-	str "in" ++ spc () ++ 
-	  Util.prlist_with_sep spc pr_id l ++ 
-	  match concl with 
+    | None,false -> str "in" ++ spc () ++ str "*" ++ spc () ++ str "|-"
+    | Some l,_ ->
+	str "in" ++ spc () ++
+	  Util.prlist_with_sep spc pr_id l ++
+	  match concl with
 	    | true -> spc () ++ str "|-" ++ spc () ++ str "*"
 	    | _ -> mt ()
 
 
 let pr_in_arg_hyp _ _ _ = pr_in_hyp (fun (_,id) -> Ppconstr.pr_id id)
 
-let pr_in_arg_hyp_typed  _ _  _  = pr_in_hyp Ppconstr.pr_id 
+let pr_in_arg_hyp_typed  _ _  _  = pr_in_hyp Ppconstr.pr_id
 
 
-let pr_var_list_gen pr_id = Util.prlist_with_sep (fun () -> str ",") pr_id 
+let pr_var_list_gen pr_id = Util.prlist_with_sep (fun () -> str ",") pr_id
 
-let pr_var_list_typed _ _ _ =  pr_var_list_gen Ppconstr.pr_id 
+let pr_var_list_typed _ _ _ =  pr_var_list_gen Ppconstr.pr_id
 
 let pr_var_list _ _ _ = pr_var_list_gen (fun (_,id) -> Ppconstr.pr_id id)
 
 
-ARGUMENT EXTEND comma_var_lne 
-  TYPED AS var list 
+ARGUMENT EXTEND comma_var_lne
+  TYPED AS var list
   PRINTED BY pr_var_list_typed
-  RAW_TYPED AS var list 
+  RAW_TYPED AS var list
   RAW_PRINTED BY pr_var_list
   GLOB_TYPED AS var list
   GLOB_PRINTED BY pr_var_list
@@ -230,10 +230,10 @@ ARGUMENT EXTEND comma_var_lne
 | [ var(x) "," comma_var_lne(l) ] -> [x::l]
 END
 
-ARGUMENT EXTEND comma_var_l 
-  TYPED AS var list 
+ARGUMENT EXTEND comma_var_l
+  TYPED AS var list
   PRINTED BY pr_var_list_typed
-  RAW_TYPED AS var list 
+  RAW_TYPED AS var list
   RAW_PRINTED BY pr_var_list
   GLOB_TYPED AS var list
   GLOB_PRINTED BY pr_var_list
@@ -241,10 +241,10 @@ ARGUMENT EXTEND comma_var_l
 | [] -> [ [] ]
 END
 
-let pr_in_concl _ _ _ = function true -> str "|- " ++ spc () ++ str "*" | _ -> str "|-" 
+let pr_in_concl _ _ _ = function true -> str "|- " ++ spc () ++ str "*" | _ -> str "|-"
 
-ARGUMENT EXTEND inconcl  
-  TYPED AS bool 
+ARGUMENT EXTEND inconcl
+  TYPED AS bool
   PRINTED BY pr_in_concl
 | [ "|-" "*" ] -> [ true ]
 | [ "|-" ] -> [ false ]
@@ -255,24 +255,24 @@ END
 ARGUMENT EXTEND in_arg_hyp
   TYPED AS var list option * bool
   PRINTED BY pr_in_arg_hyp_typed
-  RAW_TYPED AS var list option * bool 
+  RAW_TYPED AS var list option * bool
   RAW_PRINTED BY pr_in_arg_hyp
   GLOB_TYPED AS var list option * bool
   GLOB_PRINTED BY pr_in_arg_hyp
 | [ "in" "*" ] -> [(None,true)]
 | [ "in" "*" inconcl_opt(b) ] -> [let onconcl = match b with Some b -> b | None -> true in (None,onconcl)]
-| [ "in" comma_var_l(l) inconcl_opt(b) ] -> [ let onconcl = match b with Some b -> b | None -> false in 
+| [ "in" comma_var_l(l) inconcl_opt(b) ] -> [ let onconcl = match b with Some b -> b | None -> false in
 					      Some l, onconcl
 					   ]
 | [ ] -> [ (Some [],true) ]
 END
 
 
-let gen_in_arg_hyp_to_clause trad_id (hyps ,concl) : Tacticals.clause = 
+let gen_in_arg_hyp_to_clause trad_id (hyps ,concl) : Tacticals.clause =
   {Tacexpr.onhyps=
-   Option.map 
-     (fun l -> 
-	List.map 
+   Option.map
+     (fun l ->
+	List.map
 	  (fun id -> ( (all_occurrences_expr,trad_id id),InHyp))
 	  l
      )
@@ -280,8 +280,8 @@ let gen_in_arg_hyp_to_clause trad_id (hyps ,concl) : Tacticals.clause =
    Tacexpr.concl_occs = if concl then all_occurrences_expr else no_occurrences_expr}
 
 
-let raw_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause snd 
-let glob_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause (fun x -> x) 
+let raw_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause snd
+let glob_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause (fun x -> x)
 
 
 (* spiwack argument for the commands of the retroknowledge *)
@@ -297,7 +297,7 @@ let (wit_r_field, globwit_r_field, rawwit_r_field) =
 
 (* spiwack: the print functions are incomplete, but I don't know what they are
 	used for *)
-let pr_r_nat_field _ _ _ natf = 
+let pr_r_nat_field _ _ _ natf =
   str "nat " ++
   match natf with
     | Retroknowledge.NatType -> str "type"
@@ -327,7 +327,7 @@ let pr_r_int31_field _ _ _ i31f =
     | Retroknowledge.Int31PhiInv -> str "phi inv"
     | Retroknowledge.Int31Plus -> str "plus"
     | Retroknowledge.Int31Times -> str "times"
-    | _ -> assert false	
+    | _ -> assert false
 
 let pr_retroknowledge_field _ _ _ f =
   match f with
@@ -335,7 +335,7 @@ let pr_retroknowledge_field _ _ _ f =
   | Retroknowledge.KNat natf -> pr_r_nat_field () () () natf
   | Retroknowledge.KN nf -> pr_r_n_field () () () nf *)
   | Retroknowledge.KInt31 (group, i31f) -> (pr_r_int31_field () () () i31f) ++
-                                           str "in " ++ str group 
+                                           str "in " ++ str group
 
 ARGUMENT EXTEND retroknowledge_nat
 TYPED AS r_nat_field
@@ -347,7 +347,7 @@ END
 
 
 ARGUMENT EXTEND retroknowledge_binary_n
-TYPED AS r_n_field 
+TYPED AS r_n_field
 PRINTED BY pr_r_n_field
 | [ "binary" "N" "positive" ] -> [ Retroknowledge.NPositive ]
 | [ "binary" "N" "type" ] -> [ Retroknowledge.NType ]
@@ -360,7 +360,7 @@ PRINTED BY pr_r_n_field
 END
 
 ARGUMENT EXTEND retroknowledge_int31
-TYPED AS r_int31_field 
+TYPED AS r_int31_field
 PRINTED BY pr_r_int31_field
 | [ "int31" "bits" ] -> [ Retroknowledge.Int31Bits ]
 | [ "int31" "type" ] -> [ Retroknowledge.Int31Type ]
@@ -385,8 +385,8 @@ PRINTED BY pr_r_int31_field
 
 END
 
-ARGUMENT EXTEND retroknowledge_field 
-TYPED AS r_field 
+ARGUMENT EXTEND retroknowledge_field
+TYPED AS r_field
 PRINTED BY pr_retroknowledge_field
 (*| [ "equality" ] -> [ Retroknowledge.KEq ]
 | [ retroknowledge_nat(n)] -> [ Retroknowledge.KNat n ]
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
index f03084d4d0..c7c235cc0f 100644
--- a/tactics/extratactics.ml4
+++ b/tactics/extratactics.ml4
@@ -26,7 +26,7 @@ open Termops
 open Equality
 
 
-TACTIC EXTEND replace 
+TACTIC EXTEND replace
    ["replace" constr(c1) "with" constr(c2) in_arg_hyp(in_hyp) by_arg_tac(tac) ]
 -> [ replace_in_clause_maybe_by c1 c2 (glob_in_arg_hyp_to_clause in_hyp) (Option.map Tacinterp.eval_tactic tac) ]
 END
@@ -97,10 +97,10 @@ let h_discrHyp id = h_discriminate_main (Term.mkVar id,NoBindings)
 TACTIC EXTEND injection_main
 | [ "injection" constr_with_bindings(c) ] ->
     [ injClause [] false (Some (ElimOnConstr c)) ]
-END 
+END
 TACTIC EXTEND injection
 | [ "injection" ] -> [ injClause [] false None ]
-| [ "injection" quantified_hypothesis(h) ] -> 
+| [ "injection" quantified_hypothesis(h) ] ->
     [ injClause [] false (Some (induction_arg_of_quantified_hyp h)) ]
 END
 TACTIC EXTEND einjection_main
@@ -110,21 +110,21 @@ END
 TACTIC EXTEND einjection
 | [ "einjection" ] -> [ injClause [] true None ]
 | [ "einjection" quantified_hypothesis(h) ] -> [ injClause [] true (Some (induction_arg_of_quantified_hyp h)) ]
-END 
+END
 TACTIC EXTEND injection_as_main
 | [ "injection" constr_with_bindings(c) "as" simple_intropattern_list(ipat)] ->
     [ injClause ipat false (Some (ElimOnConstr c)) ]
-END 
+END
 TACTIC EXTEND injection_as
 | [ "injection" "as" simple_intropattern_list(ipat)] ->
     [ injClause ipat false None ]
 | [ "injection" quantified_hypothesis(h) "as" simple_intropattern_list(ipat) ] ->
     [ injClause ipat false (Some (induction_arg_of_quantified_hyp h)) ]
-END 
+END
 TACTIC EXTEND einjection_as_main
 | [ "einjection" constr_with_bindings(c) "as" simple_intropattern_list(ipat)] ->
     [ injClause ipat true (Some (ElimOnConstr c)) ]
-END 
+END
 TACTIC EXTEND einjection_as
 | [ "einjection" "as" simple_intropattern_list(ipat)] ->
     [ injClause ipat true None ]
@@ -160,7 +160,7 @@ END
 (* AutoRewrite *)
 
 open Autorewrite
-(* J.F : old version 
+(* J.F : old version
 TACTIC EXTEND autorewrite
   [ "autorewrite" "with" ne_preident_list(l) ] ->
     [ autorewrite Refiner.tclIDTAC l ]
@@ -177,8 +177,8 @@ TACTIC EXTEND autorewrite
 | [ "autorewrite" "with" ne_preident_list(l) in_arg_hyp(cl) ] ->
     [ auto_multi_rewrite  l (glob_in_arg_hyp_to_clause  cl) ]
 | [ "autorewrite" "with" ne_preident_list(l) in_arg_hyp(cl) "using" tactic(t) ] ->
-    [ 
-      let cl =  glob_in_arg_hyp_to_clause cl in 
+    [
+      let cl =  glob_in_arg_hyp_to_clause cl in
       auto_multi_rewrite_with (snd t) l cl
 
     ]
@@ -188,7 +188,7 @@ TACTIC EXTEND autorewrite_star
 | [ "autorewrite" "*" "with" ne_preident_list(l) in_arg_hyp(cl) ] ->
     [ auto_multi_rewrite ~conds:AllMatches l (glob_in_arg_hyp_to_clause  cl) ]
 | [ "autorewrite" "*" "with" ne_preident_list(l) in_arg_hyp(cl) "using" tactic(t) ] ->
-    [ let cl =  glob_in_arg_hyp_to_clause cl in 
+    [ let cl =  glob_in_arg_hyp_to_clause cl in
 	auto_multi_rewrite_with ~conds:AllMatches (snd t) l cl ]
 END
 
@@ -196,25 +196,25 @@ open Extraargs
 
 let rewrite_star clause orient occs c (tac : glob_tactic_expr option) =
   let tac' = Option.map (fun t -> Tacinterp.eval_tactic t, FirstSolved) tac in
-  general_rewrite_ebindings_clause clause orient occs ?tac:tac' (c,NoBindings) true 
+  general_rewrite_ebindings_clause clause orient occs ?tac:tac' (c,NoBindings) true
 
 let occurrences_of = function
   | n::_ as nl when n < 0 -> (false,List.map abs nl)
-  | nl -> 
+  | nl ->
       if List.exists (fun n -> n < 0) nl then
 	error "Illegal negative occurrence number.";
       (true,nl)
 
 TACTIC EXTEND rewrite_star
-| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) "at" occurrences(occ) by_arg_tac(tac) ] -> 
+| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) "at" occurrences(occ) by_arg_tac(tac) ] ->
     [ rewrite_star (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) "in" hyp(id) by_arg_tac(tac) ] -> 
+| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) "in" hyp(id) by_arg_tac(tac) ] ->
     [ rewrite_star (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) by_arg_tac(tac) ] -> 
+| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) by_arg_tac(tac) ] ->
     [ rewrite_star (Some id) o all_occurrences c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) by_arg_tac(tac) ] -> 
+| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) by_arg_tac(tac) ] ->
     [ rewrite_star None o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) by_arg_tac(tac) ] -> 
+| [ "rewrite" "*" orient(o) open_constr(c) by_arg_tac(tac) ] ->
     [ rewrite_star None o all_occurrences c tac ]
     END
 
@@ -242,7 +242,7 @@ let project_hint pri l2r c =
   let env = Global.env() in
   let c = Constrintern.interp_constr Evd.empty env c in
   let t = Retyping.get_type_of env Evd.empty c in
-  let t = 
+  let t =
     Tacred.reduce_to_quantified_ref env Evd.empty (Lazy.force coq_iff_ref) t in
   let sign,ccl = decompose_prod_assum t in
   let (a,b) = match snd (decompose_app ccl) with
@@ -396,11 +396,11 @@ let step left x tac =
 (* Main function to push lemmas in persistent environment *)
 
 let cache_transitivity_lemma (_,(left,lem)) =
-  if left then  
+  if left then
     transitivity_left_table  := lem :: !transitivity_left_table
   else
     transitivity_right_table := lem :: !transitivity_right_table
-  
+
 let subst_transitivity_lemma (_,subst,(b,ref)) = (b,subst_mps subst ref)
 
 let (inTransitivity,_) =
@@ -408,22 +408,22 @@ let (inTransitivity,_) =
     cache_function = cache_transitivity_lemma;
     open_function = (fun i o -> if i=1 then cache_transitivity_lemma o);
     subst_function = subst_transitivity_lemma;
-    classify_function = (fun o -> Substitute o);       
+    classify_function = (fun o -> Substitute o);
     export_function = (fun x -> Some x) }
 
 (* Synchronisation with reset *)
 
 let freeze () = !transitivity_left_table, !transitivity_right_table
 
-let unfreeze (l,r) = 
+let unfreeze (l,r) =
   transitivity_left_table := l;
   transitivity_right_table := r
 
-let init () = 
+let init () =
   transitivity_left_table := [];
   transitivity_right_table := []
 
-let _ = 
+let _ =
   declare_summary "transitivity-steps"
     { freeze_function = freeze;
       unfreeze_function = unfreeze;
@@ -468,7 +468,7 @@ END
 (*spiwack : Vernac commands for retroknowledge *)
 
 VERNAC COMMAND EXTEND RetroknowledgeRegister
- | [ "Register" constr(c) "as" retroknowledge_field(f) "by" constr(b)] -> 
+ | [ "Register" constr(c) "as" retroknowledge_field(f) "by" constr(b)] ->
            [ let tc = Constrintern.interp_constr Evd.empty (Global.env ()) c in
              let tb = Constrintern.interp_constr Evd.empty (Global.env ()) b in
              Global.register f tc tb ]
@@ -476,7 +476,7 @@ END
 
 
 
-(* sozeau: abs/gen for induction on instantiated dependent inductives, using "Ford" induction as 
+(* sozeau: abs/gen for induction on instantiated dependent inductives, using "Ford" induction as
   defined by Conor McBride *)
 TACTIC EXTEND generalize_eqs
 | ["generalize_eqs" hyp(id) ] -> [ abstract_generalize id ~generalize_vars:false ]
diff --git a/tactics/hiddentac.ml b/tactics/hiddentac.ml
index e6130cfcdc..73aeec501d 100644
--- a/tactics/hiddentac.ml
+++ b/tactics/hiddentac.ml
@@ -37,7 +37,7 @@ let h_assumption     = abstract_tactic TacAssumption assumption
 let h_exact c        = abstract_tactic (TacExact (inj_open c)) (exact_check c)
 let h_exact_no_check c =
   abstract_tactic (TacExactNoCheck (inj_open c)) (exact_no_check c)
-let h_vm_cast_no_check c = 
+let h_vm_cast_no_check c =
   abstract_tactic (TacVmCastNoCheck (inj_open c)) (vm_cast_no_check c)
 let h_apply simple ev cb =
   abstract_tactic (TacApply (simple,ev,List.map snd cb,None))
@@ -60,7 +60,7 @@ let h_mutual_fix b id n l =
 let h_cofix ido      = abstract_tactic (TacCofix ido) (cofix ido)
 let h_mutual_cofix b id l =
   abstract_tactic
-    (TacMutualCofix (b,id,List.map (fun (id,c) -> (id,inj_open c)) l)) 
+    (TacMutualCofix (b,id,List.map (fun (id,c) -> (id,inj_open c)) l))
     (mutual_cofix id l 0)
 
 let h_cut c          = abstract_tactic (TacCut (inj_open c)) (cut c)
@@ -78,13 +78,13 @@ let h_let_tac b na c cl =
 
 (* Derived basic tactics *)
 let h_simple_induction_destruct isrec h =
-  abstract_tactic (TacSimpleInductionDestruct (isrec,h)) 
+  abstract_tactic (TacSimpleInductionDestruct (isrec,h))
     (if isrec then (simple_induct h) else (simple_destruct h))
 let h_simple_induction = h_simple_induction_destruct true
 let h_simple_destruct = h_simple_induction_destruct false
 
 let h_induction_destruct isrec ev l =
-  abstract_tactic (TacInductionDestruct (isrec,ev,List.map (fun (c,e,idl,cl) -> 
+  abstract_tactic (TacInductionDestruct (isrec,ev,List.map (fun (c,e,idl,cl) ->
     List.map inj_ia c,Option.map inj_open_wb e,idl,cl) l))
     (induction_destruct ev isrec l)
 let h_new_induction ev c e idl cl = h_induction_destruct ev true [c,e,idl,cl]
@@ -118,7 +118,7 @@ let h_simplest_left   = h_left false NoBindings
 let h_simplest_right  = h_right false NoBindings
 
 (* Conversion *)
-let h_reduce r cl  = 
+let h_reduce r cl  =
   abstract_tactic (TacReduce (inj_red_expr r,cl)) (reduce r cl)
 let h_change oc c cl =
   abstract_tactic (TacChange (Option.map inj_occ oc,inj_open c,cl))
diff --git a/tactics/hiddentac.mli b/tactics/hiddentac.mli
index e0c267c071..f4da57144b 100644
--- a/tactics/hiddentac.mli
+++ b/tactics/hiddentac.mli
@@ -37,10 +37,10 @@ val h_exact           : constr -> tactic
 val h_exact_no_check  : constr -> tactic
 val h_vm_cast_no_check  : constr -> tactic
 
-val h_apply           : advanced_flag -> evars_flag -> 
+val h_apply           : advanced_flag -> evars_flag ->
   open_constr with_bindings located list -> tactic
-val h_apply_in        : advanced_flag -> evars_flag -> 
-  open_constr with_bindings located list -> 
+val h_apply_in        : advanced_flag -> evars_flag ->
+  open_constr with_bindings located list ->
   identifier * intro_pattern_expr located option -> tactic
 
 val h_elim            : evars_flag -> constr with_ebindings ->
@@ -52,15 +52,15 @@ val h_case_type       : constr -> tactic
 val h_mutual_fix      : hidden_flag -> identifier -> int ->
                         (identifier * int * constr) list -> tactic
 val h_fix             : identifier option -> int -> tactic
-val h_mutual_cofix    : hidden_flag -> identifier -> 
+val h_mutual_cofix    : hidden_flag -> identifier ->
                         (identifier * constr) list -> tactic
 val h_cofix           : identifier option -> tactic
 
-val h_cut             : constr -> tactic 
-val h_generalize      : constr list -> tactic 
-val h_generalize_gen  : (constr with_occurrences * name) list -> tactic 
-val h_generalize_dep  : constr -> tactic 
-val h_let_tac         : letin_flag -> name -> constr -> 
+val h_cut             : constr -> tactic
+val h_generalize      : constr list -> tactic
+val h_generalize_gen  : (constr with_occurrences * name) list -> tactic
+val h_generalize_dep  : constr -> tactic
+val h_let_tac         : letin_flag -> name -> constr ->
                         Tacticals.clause -> tactic
 
 (* Derived basic tactics *)
@@ -68,16 +68,16 @@ val h_let_tac         : letin_flag -> name -> constr ->
 val h_simple_induction   : quantified_hypothesis -> tactic
 val h_simple_destruct    : quantified_hypothesis -> tactic
 val h_simple_induction_destruct : rec_flag -> quantified_hypothesis -> tactic
-val h_new_induction   : evars_flag -> 
+val h_new_induction   : evars_flag ->
   constr with_ebindings induction_arg list -> constr with_ebindings option ->
   intro_pattern_expr located option * intro_pattern_expr located option ->
   Tacticals.clause option -> tactic
-val h_new_destruct    : evars_flag -> 
-  constr with_ebindings induction_arg list -> constr with_ebindings option -> 
+val h_new_destruct    : evars_flag ->
+  constr with_ebindings induction_arg list -> constr with_ebindings option ->
   intro_pattern_expr located option * intro_pattern_expr located option ->
   Tacticals.clause option -> tactic
 val h_induction_destruct : rec_flag -> evars_flag ->
-  (constr with_ebindings induction_arg list * constr with_ebindings option * 
+  (constr with_ebindings induction_arg list * constr with_ebindings option *
    (intro_pattern_expr located option * intro_pattern_expr located option) *
    Tacticals.clause option) list -> tactic
 
@@ -115,8 +115,8 @@ val h_reflexivity     : tactic
 val h_symmetry        : Tacticals.clause -> tactic
 val h_transitivity    : constr option -> tactic
 
-val h_simplest_apply  : constr -> tactic 
-val h_simplest_eapply : constr -> tactic 
+val h_simplest_apply  : constr -> tactic
+val h_simplest_eapply : constr -> tactic
 val h_simplest_elim   : constr -> tactic
 val h_simplest_case   : constr -> tactic
 
diff --git a/tactics/hipattern.ml4 b/tactics/hipattern.ml4
index bf34a5598f..b2824fbfbc 100644
--- a/tactics/hipattern.ml4
+++ b/tactics/hipattern.ml4
@@ -32,10 +32,10 @@ open Declarations
    is an inductive but non-recursive type, a general conjuction, a
    general disjunction, or a type with no constructors.
 
-   They are more general than matching with or_term, and_term, etc, 
-   since they do not depend on the name of the type. Hence, they 
+   They are more general than matching with or_term, and_term, etc,
+   since they do not depend on the name of the type. Hence, they
    also work on ad-hoc disjunctions introduced by the user.
-  
+
   -- Eduardo (6/8/97). *)
 
 type 'a matching_function = constr -> 'a option
@@ -50,16 +50,16 @@ let meta4 = mkmeta 4
 
 let op2bool = function Some _ -> true | None -> false
 
-let match_with_non_recursive_type t = 
-  match kind_of_term t with 
-    | App _ -> 
+let match_with_non_recursive_type t =
+  match kind_of_term t with
+    | App _ ->
         let (hdapp,args) = decompose_app t in
         (match kind_of_term hdapp with
-           | Ind ind -> 
-               if not (Global.lookup_mind (fst ind)).mind_finite then 
-		 Some (hdapp,args) 
-	       else 
-		 None 
+           | Ind ind ->
+               if not (Global.lookup_mind (fst ind)).mind_finite then
+		 Some (hdapp,args)
+	       else
+		 None
            | _ -> None)
     | _ -> None
 
@@ -69,34 +69,34 @@ let is_non_recursive_type t = op2bool (match_with_non_recursive_type t)
 
 let rec has_nodep_prod_after n c =
   match kind_of_term c with
-    | Prod (_,_,b) -> 
-	( n>0 || not (dependent (mkRel 1) b)) 
+    | Prod (_,_,b) ->
+	( n>0 || not (dependent (mkRel 1) b))
 	&& (has_nodep_prod_after (n-1) b)
     | _            -> true
-	  
+
 let has_nodep_prod = has_nodep_prod_after 0
 
-(* A general conjunctive type is a non-recursive with-no-indices inductive 
+(* A general conjunctive type is a non-recursive with-no-indices inductive
    type with only one constructor and no dependencies between argument;
-   it is strict if it has the form 
+   it is strict if it has the form
    "Inductive I A1 ... An := C (_:A1) ... (_:An)" *)
 
 (* style: None = record; Some false = conjunction; Some true = strict conj *)
 
 let match_with_one_constructor style allow_rec t =
-  let (hdapp,args) = decompose_app t in 
+  let (hdapp,args) = decompose_app t in
   match kind_of_term hdapp with
-  | Ind ind -> 
+  | Ind ind ->
       let (mib,mip) = Global.lookup_inductive ind in
       if (Array.length mip.mind_consnames = 1)
 	&& (allow_rec or not (mis_is_recursive (ind,mib,mip)))
         && (mip.mind_nrealargs = 0)
       then
 	if style = Some true (* strict conjunction *) then
-	  let ctx = 
-	    (prod_assum (snd 
+	  let ctx =
+	    (prod_assum (snd
 	      (decompose_prod_n_assum mib.mind_nparams mip.mind_nf_lc.(0)))) in
-	  if 
+	  if
 	    List.for_all
 	      (fun (_,b,c) -> b=None && c = mkRel mib.mind_nparams) ctx
 	  then
@@ -126,7 +126,7 @@ let is_conjunction ?(strict=false) t =
 let is_record t =
   op2bool (match_with_record t)
 
-let match_with_tuple t = 
+let match_with_tuple t =
   let t = match_with_one_constructor None true t in
   Option.map (fun (hd,l) ->
     let ind = destInd hd in
@@ -137,9 +137,9 @@ let match_with_tuple t =
 let is_tuple t =
   op2bool (match_with_tuple t)
 
-(* A general disjunction type is a non-recursive with-no-indices inductive 
+(* A general disjunction type is a non-recursive with-no-indices inductive
    type with of which all constructors have a single argument;
-   it is strict if it has the form 
+   it is strict if it has the form
    "Inductive I A1 ... An := C1 (_:A1) | ... | Cn : (_:An)" *)
 
 let test_strict_disjunction n lc =
@@ -149,7 +149,7 @@ let test_strict_disjunction n lc =
     | _ -> false) 0 lc
 
 let match_with_disjunction ?(strict=false) t =
-  let (hdapp,args) = decompose_app t in 
+  let (hdapp,args) = decompose_app t in
   match kind_of_term hdapp with
   | Ind ind  ->
       let car = mis_constr_nargs ind in
@@ -167,7 +167,7 @@ let match_with_disjunction ?(strict=false) t =
 	    Array.map (fun ar -> pi2 (destProd (prod_applist ar args)))
 	      mip.mind_nf_lc in
 	  Some (hdapp,Array.to_list cargs)
-      else 
+      else
 	None
   | _ -> None
 
@@ -180,12 +180,12 @@ let is_disjunction ?(strict=false) t =
 let match_with_empty_type t =
   let (hdapp,args) = decompose_app t in
   match (kind_of_term hdapp) with
-    | Ind ind -> 
+    | Ind ind ->
         let (mib,mip) = Global.lookup_inductive ind in
-        let nconstr = Array.length mip.mind_consnames in  
+        let nconstr = Array.length mip.mind_consnames in
 	if nconstr = 0 then Some hdapp else None
     | _ ->  None
-	  
+
 let is_empty_type t = op2bool (match_with_empty_type t)
 
 (* This filters inductive types with one constructor with no arguments;
@@ -194,14 +194,14 @@ let is_empty_type t = op2bool (match_with_empty_type t)
 let match_with_unit_or_eq_type t =
   let (hdapp,args) = decompose_app t in
   match (kind_of_term hdapp) with
-    | Ind ind  -> 
+    | Ind ind  ->
         let (mib,mip) = Global.lookup_inductive ind in
-        let constr_types = mip.mind_nf_lc in 
+        let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
-        let zero_args c = nb_prod c = mib.mind_nparams in  
-	if nconstr = 1 && zero_args constr_types.(0) then 
+        let zero_args c = nb_prod c = mib.mind_nparams in
+	if nconstr = 1 && zero_args constr_types.(0) then
 	  Some hdapp
-	else 
+	else
 	  None
     | _ -> None
 
@@ -249,7 +249,7 @@ let match_with_equation t =
 	HeterogenousEq(args.(0),args.(1),args.(2),args.(3))
       else
         let (mib,mip) = Global.lookup_inductive ind in
-        let constr_types = mip.mind_nf_lc in 
+        let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
 	if nconstr = 1 then
           if is_matching coq_refl_leibniz1_pattern constr_types.(0) then
@@ -265,13 +265,13 @@ let match_with_equation t =
 let match_with_equality_type t =
   let (hdapp,args) = decompose_app t in
   match (kind_of_term hdapp) with
-    | Ind ind when args <> [] -> 
+    | Ind ind when args <> [] ->
         let (mib,mip) = Global.lookup_inductive ind in
         let nconstr = Array.length mip.mind_consnames in
 	if nconstr = 1 && constructor_nrealargs (Global.env()) (ind,1) = 0
-        then 
+        then
 	  Some (hdapp,args)
-        else 
+        else
 	  None
     | _ -> None
 
@@ -282,34 +282,34 @@ let coq_arrow_pattern = PATTERN [ ?X1 -> ?X2 ]
 let match_arrow_pattern t =
   match matches coq_arrow_pattern t with
     | [(m1,arg);(m2,mind)] -> assert (m1=meta1 & m2=meta2); (arg, mind)
-    | _ -> anomaly "Incorrect pattern matching" 
+    | _ -> anomaly "Incorrect pattern matching"
 
 let match_with_nottype t =
   try
     let (arg,mind) = match_arrow_pattern t in
     if is_empty_type mind then Some (mind,arg) else None
-  with PatternMatchingFailure -> None  
+  with PatternMatchingFailure -> None
 
 let is_nottype t = op2bool (match_with_nottype t)
-		     
+
 let match_with_forall_term c=
   match kind_of_term c with
     | Prod (nam,a,b) -> Some (nam,a,b)
     | _            -> None
 
-let is_forall_term c = op2bool (match_with_forall_term c) 
+let is_forall_term c = op2bool (match_with_forall_term c)
 
 let match_with_imp_term c=
   match kind_of_term c with
     | Prod (_,a,b) when not (dependent (mkRel 1) b) ->Some (a,b)
     | _              -> None
 
-let is_imp_term c = op2bool (match_with_imp_term c) 
+let is_imp_term c = op2bool (match_with_imp_term c)
 
 let match_with_nodep_ind t =
   let (hdapp,args) = decompose_app t in
     match (kind_of_term hdapp) with
-      | Ind ind  -> 
+      | Ind ind  ->
           let (mib,mip) = Global.lookup_inductive ind in
 	    if Array.length (mib.mind_packets)>1 then None else
 	      let nodep_constr = has_nodep_prod_after mib.mind_nparams in
@@ -318,24 +318,24 @@ let match_with_nodep_ind t =
 		    if mip.mind_nrealargs=0 then args else
 		      fst (list_chop mib.mind_nparams args) in
 		    Some (hdapp,params,mip.mind_nrealargs)
-		else 
+		else
 		  None
       | _ -> None
-	  
+
 let is_nodep_ind t=op2bool (match_with_nodep_ind t)
 
 let match_with_sigma_type t=
   let (hdapp,args) = decompose_app t in
   match (kind_of_term hdapp) with
-    | Ind ind  -> 
+    | Ind ind  ->
         let (mib,mip) = Global.lookup_inductive ind in
           if (Array.length (mib.mind_packets)=1) &&
 	    (mip.mind_nrealargs=0) &&
 	    (Array.length mip.mind_consnames=1) &&
 	    has_nodep_prod_after (mib.mind_nparams+1) mip.mind_nf_lc.(0) then
-	      (*allowing only 1 existential*) 
+	      (*allowing only 1 existential*)
 	      Some (hdapp,args)
-	  else 
+	  else
 	    None
     | _ -> None
 
@@ -377,7 +377,7 @@ let find_eq_data eqn = (* fails with PatternMatchingFailure *)
   first_match (match_eq eqn) equalities
 
 let extract_eq_args gl = function
-  | MonomorphicLeibnizEq (e1,e2) -> 
+  | MonomorphicLeibnizEq (e1,e2) ->
       let t = Tacmach.pf_type_of gl e1 in (t,e1,e2)
   | PolymorphicLeibnizEq (t,e1,e2) -> (t,e1,e2)
   | HeterogenousEq (t1,e1,t2,e2) ->
@@ -389,13 +389,13 @@ let find_eq_data_decompose gl eqn =
   (lbeq,extract_eq_args gl eq_args)
 
 let find_this_eq_data_decompose gl eqn =
-  let (lbeq,eq_args) = 
+  let (lbeq,eq_args) =
     try find_eq_data eqn
     with PatternMatchingFailure ->
       errorlabstrm "" (str "No primitive equality found.") in
   let eq_args =
     try extract_eq_args gl eq_args
-    with PatternMatchingFailure -> 
+    with PatternMatchingFailure ->
       error "Don't know what to do with JMeq on arguments not of same type." in
   (lbeq,eq_args)
 
@@ -430,7 +430,7 @@ let match_sigma ex ex_pat =
 	anomaly "match_sigma: a successful sigma pattern should match 4 terms"
 
 let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
-  first_match (match_sigma ex) 
+  first_match (match_sigma ex)
     [coq_existT_pattern, build_sigma_type]
 
 (* Pattern "(sig ?1 ?2)" *)
@@ -468,14 +468,14 @@ let op_sum = coq_sumbool_ref
 let match_eqdec t =
   let eqonleft,op,subst =
     try true,op_sum,matches (Lazy.force coq_eqdec_inf_pattern) t
-    with PatternMatchingFailure -> 
+    with PatternMatchingFailure ->
     try false,op_sum,matches (Lazy.force coq_eqdec_inf_rev_pattern) t
-    with PatternMatchingFailure -> 
+    with PatternMatchingFailure ->
     try true,op_or,matches (Lazy.force coq_eqdec_pattern) t
-    with PatternMatchingFailure -> 
+    with PatternMatchingFailure ->
         false,op_or,matches (Lazy.force coq_eqdec_rev_pattern) t in
   match subst with
-  | [(_,typ);(_,c1);(_,c2)] -> 
+  | [(_,typ);(_,c1);(_,c2)] ->
       eqonleft, Libnames.constr_of_global (Lazy.force op), c1, c2, typ
   | _ -> anomaly "Unexpected pattern"
 
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 3f5411e00f..001755b1ea 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -42,8 +42,8 @@ open Coqlib
    is an inductive but non-recursive type, a general conjuction, a
    general disjunction, or a type with no constructors.
 
-   They are more general than matching with [or_term], [and_term], etc, 
-   since they do not depend on the name of the type. Hence, they 
+   They are more general than matching with [or_term], [and_term], etc,
+   since they do not depend on the name of the type. Hence, they
    also work on ad-hoc disjunctions introduced by the user.
    (Eduardo, 6/8/97). *)
 
@@ -51,49 +51,49 @@ type 'a matching_function = constr -> 'a option
 type testing_function = constr -> bool
 
 val match_with_non_recursive_type : (constr * constr list) matching_function
-val is_non_recursive_type         : testing_function 
+val is_non_recursive_type         : testing_function
 
 (* Non recursive type with no indices and exactly one argument for each
    constructor; canonical definition of n-ary disjunction if strict *)
 val match_with_disjunction : ?strict:bool -> (constr * constr list) matching_function
-val is_disjunction         : ?strict:bool -> testing_function 
+val is_disjunction         : ?strict:bool -> testing_function
 
 (* Non recursive tuple (one constructor and no indices) with no inner
    dependencies; canonical definition of n-ary conjunction if strict *)
 val match_with_conjunction : ?strict:bool -> (constr * constr list) matching_function
-val is_conjunction         : ?strict:bool -> testing_function 
+val is_conjunction         : ?strict:bool -> testing_function
 
 (* Non recursive tuple, possibly with inner dependencies *)
 val match_with_record      : (constr * constr list) matching_function
-val is_record              : testing_function 
+val is_record              : testing_function
 
 (* Like record but supports and tells if recursive (e.g. Acc) *)
 val match_with_tuple       : (constr * constr list * bool) matching_function
-val is_tuple               : testing_function 
+val is_tuple               : testing_function
 
 (* No constructor, possibly with indices *)
 val match_with_empty_type  : constr matching_function
-val is_empty_type          : testing_function 
+val is_empty_type          : testing_function
 
 (* type with only one constructor and no arguments, possibly with indices *)
 val match_with_unit_or_eq_type : constr matching_function
-val is_unit_or_eq_type     : testing_function 
+val is_unit_or_eq_type     : testing_function
 
 (* type with only one constructor and no arguments, no indices *)
-val is_unit_type           : testing_function 
+val is_unit_type           : testing_function
 
 (* type with only one constructor, no arguments and at least one dependency *)
 val match_with_equality_type : (constr * constr list) matching_function
 val is_equality_type       : testing_function
 
 val match_with_nottype     : (constr * constr) matching_function
-val is_nottype             : testing_function 
+val is_nottype             : testing_function
 
 val match_with_forall_term    : (name * constr * constr) matching_function
-val is_forall_term            : testing_function 
+val is_forall_term            : testing_function
 
 val match_with_imp_term    : (constr * constr) matching_function
-val is_imp_term            : testing_function 
+val is_imp_term            : testing_function
 
 (* I added these functions to test whether a type contains dependent
   products or not, and if an inductive has constructors with dependent types
@@ -103,11 +103,11 @@ val is_imp_term            : testing_function
 val has_nodep_prod_after   : int -> testing_function
 val has_nodep_prod         : testing_function
 
-val match_with_nodep_ind   : (constr * constr list * int) matching_function  
-val is_nodep_ind           : testing_function 
+val match_with_nodep_ind   : (constr * constr list * int) matching_function
+val is_nodep_ind           : testing_function
 
-val match_with_sigma_type   : (constr * constr list) matching_function	  
-val is_sigma_type           : testing_function 
+val match_with_sigma_type   : (constr * constr list) matching_function
+val is_sigma_type           : testing_function
 
 (* Recongnize inductive relation defined by reflexivity *)
 
@@ -125,11 +125,11 @@ val match_with_equation:
 
 (* Match terms [eq A t u], [identity A t u] or [JMeq A t A u] *)
 (* Returns associated lemmas and [A,t,u] or fails PatternMatchingFailure *)
-val find_eq_data_decompose : Proof_type.goal sigma -> constr -> 
+val find_eq_data_decompose : Proof_type.goal sigma -> constr ->
       coq_eq_data * (types * constr * constr)
 
 (* Idem but fails with an error message instead of PatternMatchingFailure *)
-val find_this_eq_data_decompose : Proof_type.goal sigma -> constr -> 
+val find_this_eq_data_decompose : Proof_type.goal sigma -> constr ->
       coq_eq_data * (types * constr * constr)
 
 (* A variant that returns more informative structure on the equality found *)
@@ -137,7 +137,7 @@ val find_eq_data : constr -> coq_eq_data * equation_kind
 
 (* Match a term of the form [(existT A P t p)] *)
 (* Returns associated lemmas and [A,P,t,p] *)
-val find_sigma_data_decompose : constr -> 
+val find_sigma_data_decompose : constr ->
   coq_sigma_data * (constr * constr * constr * constr)
 
 (* Match a term of the form [{x:A|P}], returns [A] and [P] *)
diff --git a/tactics/inv.ml b/tactics/inv.ml
index ae76e6b26e..5a1fb6eeeb 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -37,18 +37,18 @@ open Rawterm
 open Genarg
 open Tacexpr
 
-let collect_meta_variables c = 
+let collect_meta_variables c =
   let rec collrec acc c = match kind_of_term c with
     | Meta mv -> mv::acc
     | _ -> fold_constr collrec acc c
-  in 
+  in
   collrec [] c
 
 let check_no_metas clenv ccl =
   if occur_meta ccl then
     let metas = List.filter (fun na -> na<>Anonymous)
       (List.map (Evd.meta_name clenv.evd) (collect_meta_variables ccl)) in
-    errorlabstrm "inversion" 
+    errorlabstrm "inversion"
       (str ("Cannot find an instantiation for variable"^
 	       (if List.length metas = 1 then " " else "s ")) ++
 	 prlist_with_sep pr_coma pr_name metas
@@ -60,7 +60,7 @@ let var_occurs_in_pf gl id =
   List.exists (occur_var_in_decl env id) (pf_hyps gl)
 
 (* [make_inv_predicate (ity,args) C]
-  
+
    is given the inductive type, its arguments, both the global
    parameters and its local arguments, and is expected to produce a
    predicate P such that if largs is the "local" part of the
@@ -130,13 +130,13 @@ let make_inv_predicate env sigma indf realargs id status concl =
     | [] -> (it_mkProd concl eqns,n)
     | (ai,(xi,ti))::restlist ->
         let (lhs,eqnty,rhs) =
-          if closed0 ti then 
+          if closed0 ti then
 	    (xi,ti,ai)
-          else 
+          else
 	    make_iterated_tuple env' sigma ai (xi,ti)
 	in
         let eq_term = Coqlib.build_coq_eq () in
-        let eqn = applist (eq_term ,[eqnty;lhs;rhs]) in 
+        let eqn = applist (eq_term ,[eqnty;lhs;rhs]) in
 	build_concl ((Anonymous,lift n eqn)::eqns) (n+1) restlist
   in
   let (newconcl,neqns) = build_concl [] 0 pairs in
@@ -188,21 +188,21 @@ let make_inv_predicate env sigma indf realargs id status concl =
    it generalizes them, applies tac to rewrite all occurrencies of t,
    and introduces generalized hypotheis.
    Precondition: t=(mkVar id) *)
-    
-let rec dependent_hyps id idlist gl = 
+
+let rec dependent_hyps id idlist gl =
   let rec dep_rec =function
     | [] -> []
-    | (id1,_,_)::l -> 
+    | (id1,_,_)::l ->
 	(* Update the type of id1: it may have been subject to rewriting *)
 	let d = pf_get_hyp gl id1 in
 	if occur_var_in_decl (Global.env()) id d
         then d :: dep_rec l
         else dep_rec l
-  in 
-  dep_rec idlist 
+  in
+  dep_rec idlist
 
 let split_dep_and_nodep hyps gl =
-  List.fold_right 
+  List.fold_right
     (fun (id,_,_ as d) (l1,l2) ->
        if var_occurs_in_pf gl id then (d::l1,l2) else (l1,d::l2))
     hyps ([],[])
@@ -280,17 +280,17 @@ Summary: nine useless hypotheses!
 Nota: with Inversion_clear, only four useless hypotheses
 *)
 
-let generalizeRewriteIntros tac depids id gls = 
+let generalizeRewriteIntros tac depids id gls =
   let dids = dependent_hyps id depids gls in
   (tclTHENSEQ
-    [bring_hyps dids; tac; 
+    [bring_hyps dids; tac;
      (* may actually fail to replace if dependent in a previous eq *)
      intros_replacing (ids_of_named_context dids)])
   gls
 
 let rec tclMAP_i n tacfun = function
   | [] -> tclDO n (tacfun None)
-  | a::l -> 
+  | a::l ->
       if n=0 then error "Too much names."
       else tclTHEN (tacfun (Some a)) (tclMAP_i (n-1) tacfun l)
 
@@ -317,7 +317,7 @@ let projectAndApply thin id eqname names depids gls =
     | _ -> tac id gls
   in
   let deq_trailer id neqns =
-    tclTHENSEQ 
+    tclTHENSEQ
       [(if names <> [] then clear [id] else tclIDTAC);
        (tclMAP_i neqns (fun idopt ->
 	 tclTHEN
@@ -349,7 +349,7 @@ let rewrite_equations_gene othin neqns ba gl =
                      (tclTHEN intro
                         (onLastHypId
                            (fun id ->
-                              tclTRY 
+                              tclTRY
 			        (projectAndApply thin id (ref no_move)
 				  [] depids))));
                  onHyps (compose List.rev (afterHyp last)) bring_hyps;
@@ -384,7 +384,7 @@ let rec get_names allow_conj (loc,pat) = match pat with
       error "Fresh pattern not allowed for inversion equations."
   | IntroRewrite _->
       error "Rewriting pattern not allowed for inversion equations."
-  | IntroOrAndPattern [l] -> 
+  | IntroOrAndPattern [l] ->
       if allow_conj then
 	if l = [] then (None,[]) else
 	  let l = List.map (fun id -> Option.get (fst (get_names false id))) l in
@@ -440,18 +440,18 @@ let rewrite_equations_tac (gene, othin) id neqns names ba =
   let tac =
     if gene then rewrite_equations_gene othin neqns ba
     else rewrite_equations othin neqns names ba in
-  if othin = Some true (* if Inversion_clear, clear the hypothesis *) then 
+  if othin = Some true (* if Inversion_clear, clear the hypothesis *) then
     tclTHEN tac (tclTRY (clear [id]))
-  else 
+  else
     tac
 
 
 let raw_inversion inv_kind id status names gl =
   let env = pf_env gl and sigma = project gl in
   let c = mkVar id in
-  let (ind,t) = 
+  let (ind,t) =
     try pf_reduce_to_atomic_ind gl (pf_type_of gl c)
-    with UserError _ -> 
+    with UserError _ ->
       errorlabstrm "raw_inversion"
 	(str ("The type of "^(string_of_id id)^" is not inductive.")) in
   let indclause = mk_clenv_from gl (c,t) in
@@ -461,16 +461,16 @@ let raw_inversion inv_kind id status names gl =
   let (elim_predicate,neqns) =
     make_inv_predicate env sigma indf realargs id status (pf_concl gl) in
   let (cut_concl,case_tac) =
-    if status <> NoDep & (dependent c (pf_concl gl)) then 
+    if status <> NoDep & (dependent c (pf_concl gl)) then
       Reduction.beta_appvect elim_predicate (Array.of_list (realargs@[c])),
-      case_then_using 
-    else 
+      case_then_using
+    else
       Reduction.beta_appvect elim_predicate (Array.of_list realargs),
-      case_nodep_then_using 
+      case_nodep_then_using
   in
   (tclTHENS
      (assert_tac Anonymous cut_concl)
-     [case_tac names 
+     [case_tac names
        (introCaseAssumsThen (rewrite_equations_tac inv_kind id neqns))
        (Some elim_predicate) ([],[]) ind indclause;
       onLastHypId
@@ -487,7 +487,7 @@ let wrap_inv_error id = function
       (Indrec.NotAllowedCaseAnalysis (_,(Type _ | Prop Pos as k),i)) ->
       errorlabstrm ""
 	(strbrk "Inversion would require case analysis on sort " ++
-	pr_sort k ++ 
+	pr_sort k ++
 	strbrk " which is not allowed for inductive definition " ++
 	pr_inductive (Global.env()) i ++ str ".")
   | e -> raise e
@@ -526,16 +526,16 @@ let invIn k names ids id gls =
   let intros_replace_ids gls =
     let nb_of_new_hyp =
       nb_prod (pf_concl gls) - (List.length hyps + nb_prod_init)
-    in 
-    if nb_of_new_hyp < 1 then 
+    in
+    if nb_of_new_hyp < 1 then
       intros_replacing ids gls
-    else 
+    else
       tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids) gls
   in
-  try 
+  try
     (tclTHENSEQ
       [bring_hyps hyps;
-       inversion (false,k) NoDep names id; 
+       inversion (false,k) NoDep names id;
        intros_replace_ids])
     gls
   with e -> wrap_inv_error id e
diff --git a/tactics/inv.mli b/tactics/inv.mli
index 322e139f06..8ec0e2db24 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -24,7 +24,7 @@ val inv_gen :
   bool -> inversion_kind -> inversion_status ->
     intro_pattern_expr located option -> quantified_hypothesis -> tactic
 val invIn_gen :
-  inversion_kind -> intro_pattern_expr located option -> identifier list -> 
+  inversion_kind -> intro_pattern_expr located option -> identifier list ->
     quantified_hypothesis -> tactic
 
 val inv_clause :
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 9a39b22723..c2be67d750 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -39,7 +39,7 @@ open Decl_kinds
 let not_work_message = "tactic fails to build the inversion lemma, may be because the predicate has arguments that depend on other arguments"
 
 let no_inductive_inconstr env constr =
-  (str "Cannot recognize an inductive predicate in " ++ 
+  (str "Cannot recognize an inductive predicate in " ++
      pr_lconstr_env env constr ++
      str "." ++ spc () ++ str "If there is one, may be the structure of the arity" ++
      spc () ++ str "or of the type of constructors" ++ spc () ++
@@ -87,7 +87,7 @@ let no_inductive_inconstr env constr =
    the respective assumption in each subgoal.
 
  *)
- 
+
 let thin_ids env (hyps,vars) =
   fst
     (List.fold_left
@@ -106,16 +106,16 @@ let thin_ids env (hyps,vars) =
 let get_local_sign sign =
   let lid = ids_of_sign sign in
   let globsign = Global.named_context() in
-  let add_local id res_sign = 
-    if not (mem_sign globsign id) then 
+  let add_local id res_sign =
+    if not (mem_sign globsign id) then
       add_sign (lookup_sign id sign) res_sign
-    else 
+    else
       res_sign
-  in 
+  in
   List.fold_right add_local lid nil_sign
 *)
 (* returs the identifier of lid that was the latest declared in sign.
- * (i.e. is the identifier id of lid such that 
+ * (i.e. is the identifier id of lid such that
  * sign_length (sign_prefix id sign) > sign_length (sign_prefix id' sign) >
  * for any id'<>id in lid).
  * it returns both the pair (id,(sign_prefix id sign)) *)
@@ -123,14 +123,14 @@ let get_local_sign sign =
 let max_prefix_sign lid sign =
   let rec max_rec (resid,prefix) = function
     | [] -> (resid,prefix)
-    | (id::l) -> 
-	let pre = sign_prefix id sign in  
-	if sign_length pre > sign_length prefix then 
+    | (id::l) ->
+	let pre = sign_prefix id sign in
+	if sign_length pre > sign_length prefix then
           max_rec (id,pre) l
-        else 
+        else
 	  max_rec (resid,prefix) l
   in
-  match lid with 
+  match lid with
     | [] -> nil_sign
     | id::l -> snd (max_rec (id, sign_prefix id sign) l)
 *)
@@ -148,14 +148,14 @@ let rec add_prods_sign env sigma t =
 
 (* [dep_option] indicates wether the inversion lemma is dependent or not.
    If it is dependent and I is of the form (x_bar:T_bar)(I t_bar) then
-   the stated goal will be (x_bar:T_bar)(H:(I t_bar))(P t_bar H) 
+   the stated goal will be (x_bar:T_bar)(H:(I t_bar))(P t_bar H)
    where P:(x_bar:T_bar)(H:(I x_bar))[sort].
    The generalisation of such a goal at the moment of the dependent case should
    be easy.
 
    If it is non dependent, then if [I]=(I t_bar) and (x_bar:T_bar) are the
    variables occurring in [I], then the stated goal will be:
-    (x_bar:T_bar)(I t_bar)->(P x_bar) 
+    (x_bar:T_bar)(I t_bar)->(P x_bar)
    where P: P:(x_bar:T_bar)[sort].
 *)
 
@@ -166,7 +166,7 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
   let pty,goal =
     if dep_option  then
       let pty = make_arity env true indf sort in
-      let goal = 
+      let goal =
 	mkProd
 	  (Anonymous, mkAppliedInd ind, applist(mkVar p,realargs@[mkRel 1]))
       in
@@ -177,11 +177,11 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let revargs,ownsign =
 	fold_named_context
 	  (fun env (id,_,_ as d) (revargs,hyps) ->
-             if List.mem id ivars then 
+             if List.mem id ivars then
 	       ((mkVar id)::revargs,add_named_decl d hyps)
-	     else 
+	     else
 	       (revargs,hyps))
-          env ~init:([],[]) 
+          env ~init:([],[])
       in
       let pty = it_mkNamedProd_or_LetIn (mkSort sort) ownsign in
       let goal = mkArrow i (applist(mkVar p, List.rev revargs)) in
@@ -203,14 +203,14 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ind =
     try find_rectype env sigma i
     with Not_found ->
-      errorlabstrm "inversion_scheme" (no_inductive_inconstr env i) 
+      errorlabstrm "inversion_scheme" (no_inductive_inconstr env i)
   in
   let (invEnv,invGoal) =
-    compute_first_inversion_scheme env sigma ind sort dep_option 
+    compute_first_inversion_scheme env sigma ind sort dep_option
   in
-  assert 
-    (list_subset 
-       (global_vars env invGoal) 
+  assert
+    (list_subset
+       (global_vars env invGoal)
        (ids_of_named_context (named_context invEnv)));
   (*
     errorlabstrm "lemma_inversion"
@@ -226,7 +226,7 @@ let inversion_scheme env sigma t sort dep_option inv_op =
       (fun env (id,_,_ as d) sign ->
          if mem_named_context id global_named_context then sign
 	 else add_named_decl d sign)
-      invEnv ~init:empty_named_context 
+      invEnv ~init:empty_named_context
   in
   let (_,ownSign,mvb) =
     List.fold_left
@@ -234,23 +234,23 @@ let inversion_scheme env sigma t sort dep_option inv_op =
          let h = next_ident_away (id_of_string "H") avoid in
 	 (h::avoid, add_named_decl (h,None,mvty) sign, (mv,mkVar h)::mvb))
       (ids_of_context invEnv, ownSign, [])
-      meta_types 
+      meta_types
   in
-  let invProof = 
+  let invProof =
     it_mkNamedLambda_or_LetIn
-      (local_strong (fun _ -> whd_meta mvb) Evd.empty pfterm) ownSign 
+      (local_strong (fun _ -> whd_meta mvb) Evd.empty pfterm) ownSign
   in
   invProof
 
 let add_inversion_lemma name env sigma t sort dep inv_op =
   let invProof = inversion_scheme env sigma t sort dep inv_op in
-  let _ = 
+  let _ =
     declare_constant name
-    (DefinitionEntry 
+    (DefinitionEntry
        { const_entry_body = invProof;
          const_entry_type = None;
          const_entry_opaque = false;
-	 const_entry_boxed = true && (Flags.boxed_definitions())}, 
+	 const_entry_boxed = true && (Flags.boxed_definitions())},
      IsProof Lemma)
   in ()
 
@@ -262,11 +262,11 @@ let add_inversion_lemma name env sigma t sort dep inv_op =
 let inversion_lemma_from_goal n na (loc,id) sort dep_option inv_op =
   let pts = get_pftreestate() in
   let gl = nth_goal_of_pftreestate n pts in
-  let t = 
+  let t =
     try pf_get_hyp_typ gl id
     with Not_found -> Pretype_errors.error_var_not_found_loc loc id in
   let env = pf_env gl and sigma = project gl in
-(* Pourquoi ??? 
+(* Pourquoi ???
   let fv = global_vars env t in
   let thin_ids = thin_ids (hyps,fv) in
   if not(list_subset thin_ids fv) then
@@ -275,14 +275,14 @@ let inversion_lemma_from_goal n na (loc,id) sort dep_option inv_op =
 	 str"free variables in the types of an inductive" ++ spc () ++
 	 str"which are not free in its instance."); *)
   add_inversion_lemma na env sigma t sort dep_option inv_op
-   
+
 let add_inversion_lemma_exn na com comsort bool tac =
   let env = Global.env () and sigma = Evd.empty in
   let c = Constrintern.interp_type sigma env com in
   let sort = Pretyping.interp_sort comsort in
   try
     add_inversion_lemma na env sigma c sort bool tac
-  with 
+  with
     |   UserError ("Case analysis",s) -> (* référence à Indrec *)
 	  errorlabstrm "Inv needs Nodep Prop Set" s
 
@@ -295,23 +295,23 @@ let lemInv id c gls =
     let clause = mk_clenv_type_of gls c in
     let clause = clenv_constrain_last_binding (mkVar id) clause in
     Clenvtac.res_pf clause ~allow_K:true gls
-  with 
-    |  UserError (a,b) -> 
-	 errorlabstrm "LemInv" 
-	   (str "Cannot refine current goal with the lemma " ++ 
-	      pr_lconstr_env (Global.env()) c) 
+  with
+    |  UserError (a,b) ->
+	 errorlabstrm "LemInv"
+	   (str "Cannot refine current goal with the lemma " ++
+	      pr_lconstr_env (Global.env()) c)
 
 let lemInv_gen id c = try_intros_until (fun id -> lemInv id c) id
 
 let lemInvIn id c ids gls =
   let hyps = List.map (pf_get_hyp gls) ids in
   let intros_replace_ids gls =
-    let nb_of_new_hyp  = nb_prod (pf_concl gls) - List.length ids in 
-    if nb_of_new_hyp < 1  then 
+    let nb_of_new_hyp  = nb_prod (pf_concl gls) - List.length ids in
+    if nb_of_new_hyp < 1  then
       intros_replacing ids gls
-    else 
+    else
       (tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids)) gls
-  in 
+  in
   ((tclTHEN (tclTHEN (bring_hyps hyps) (lemInv id c))
     (intros_replace_ids)) gls)
 
diff --git a/tactics/leminv.mli b/tactics/leminv.mli
index 3e12f770e1..b4b5737b5f 100644
--- a/tactics/leminv.mli
+++ b/tactics/leminv.mli
@@ -8,7 +8,7 @@ open Topconstr
 val lemInv_gen : quantified_hypothesis -> constr -> tactic
 val lemInvIn_gen : quantified_hypothesis -> constr -> identifier list -> tactic
 
-val lemInv_clause : 
+val lemInv_clause :
   quantified_hypothesis -> constr -> identifier list -> tactic
 
 val inversion_lemma_from_goal :
diff --git a/tactics/nbtermdn.ml b/tactics/nbtermdn.ml
index 431748868c..4e72d07080 100644
--- a/tactics/nbtermdn.ml
+++ b/tactics/nbtermdn.ml
@@ -31,7 +31,7 @@ type ('na,'a) t = {
   mutable table : ('na,constr_pattern * 'a) Gmap.t;
   mutable patterns : (global_reference option,'a Btermdn.t) Gmap.t }
 
-type ('na,'a) frozen_t = 
+type ('na,'a) frozen_t =
     ('na,constr_pattern * 'a) Gmap.t
     * (global_reference option,'a Btermdn.t) Gmap.t
 
@@ -43,46 +43,46 @@ let get_dn dnm hkey =
   try Gmap.find hkey dnm with Not_found -> Btermdn.create ()
 
 let add dn (na,(pat,valu)) =
-  let hkey = Option.map fst (Termdn.constr_pat_discr pat) in 
+  let hkey = Option.map fst (Termdn.constr_pat_discr pat) in
   dn.table <- Gmap.add na (pat,valu) dn.table;
   let dnm = dn.patterns in
   dn.patterns <- Gmap.add hkey (Btermdn.add None (get_dn dnm hkey) (pat,valu)) dnm
-    
+
 let rmv dn na =
   let (pat,valu) = Gmap.find na dn.table in
-  let hkey = Option.map fst (Termdn.constr_pat_discr pat) in 
+  let hkey = Option.map fst (Termdn.constr_pat_discr pat) in
   dn.table <- Gmap.remove na dn.table;
   let dnm = dn.patterns in
   dn.patterns <- Gmap.add hkey (Btermdn.rmv None (get_dn dnm hkey) (pat,valu)) dnm
 
 let in_dn dn na = Gmap.mem na dn.table
-			  
+
 let remap ndn na (pat,valu) =
   rmv ndn na;
   add ndn (na,(pat,valu))
 
 let lookup dn valu =
-  let hkey = 
-    match (Termdn.constr_val_discr valu) with 
+  let hkey =
+    match (Termdn.constr_val_discr valu) with
     | Dn.Label(l,_) -> Some l
     | _ -> None
-  in 
+  in
   try Btermdn.lookup None (Gmap.find hkey dn.patterns) valu with Not_found -> []
 
 let app f dn = Gmap.iter f dn.table
-		       
+
 let dnet_depth = Btermdn.dnet_depth
-		   
+
 let freeze dn = (dn.table, dn.patterns)
 
 let unfreeze (fnm,fdnm) dn =
   dn.table <- fnm;
   dn.patterns <- fdnm
 
-let empty dn = 
+let empty dn =
   dn.table <- Gmap.empty;
   dn.patterns <- Gmap.empty
 
-let to2lists dn = 
+let to2lists dn =
   (Gmap.to_list dn.table, Gmap.to_list dn.patterns)
 
diff --git a/tactics/nbtermdn.mli b/tactics/nbtermdn.mli
index 8665cc7057..350b53df71 100644
--- a/tactics/nbtermdn.mli
+++ b/tactics/nbtermdn.mli
@@ -34,5 +34,5 @@ val dnet_depth : int ref
 val freeze : ('na,'a) t -> ('na,'a) frozen_t
 val unfreeze : ('na,'a) frozen_t -> ('na,'a) t -> unit
 val empty : ('na,'a) t -> unit
-val to2lists : ('na,'a) t -> ('na * (constr_pattern * 'a)) list * 
+val to2lists : ('na,'a) t -> ('na * (constr_pattern * 'a)) list *
                              (global_reference option * 'a Btermdn.t) list
diff --git a/tactics/refine.ml b/tactics/refine.ml
index ff644c1432..5258b319b3 100644
--- a/tactics/refine.ml
+++ b/tactics/refine.ml
@@ -16,7 +16,7 @@
  *  où les trous sont typés -- et que les sous-buts correspondants
  *  soient engendrés pour finir la preuve.
  *
- *  Exemple : 
+ *  Exemple :
  *    J'ai le but
  *        (x:nat) { y:nat | (minus y x) = x }
  *    et je donne la preuve incomplète
@@ -70,12 +70,12 @@ let rec pp_th (TH(c,mm,sg)) =
 			      (* pp_mm mm ++ fnl () ++ *)
 			   pp_sg sg) ++ str "]")
 and pp_mm l =
-  hov 0 (prlist_with_sep (fun _ -> (fnl ())) 
+  hov 0 (prlist_with_sep (fun _ -> (fnl ()))
 	   (fun (n,c) -> (int n ++ str" --> " ++ pr_lconstr c)) l)
 and pp_sg sg =
   hov 0 (prlist_with_sep (fun _ -> (fnl ()))
 	   (function None -> (str"None") | Some th -> (pp_th th)) sg)
-     
+
 (*  compute_metamap : constr -> 'a evar_map -> term_with_holes
  *  réalise le 2. ci-dessus
  *
@@ -84,7 +84,7 @@ and pp_sg sg =
  *  par un terme de preuve incomplet (Some c).
  *
  *  On a donc l'INVARIANT suivant : le terme c rendu est "de niveau 1"
- *  -- i.e. à plat -- et la meta_map contient autant d'éléments qu'il y 
+ *  -- i.e. à plat -- et la meta_map contient autant d'éléments qu'il y
  *  a de meta-variables dans c. On suppose de plus que l'ordre dans la
  *  meta_map correspond à celui des buts qui seront engendrés par le refine.
  *)
@@ -108,7 +108,7 @@ let replace_by_meta env sigma = function
 	(*
 	| Fix ((_,j),(v,_,_)) ->
 	    v.(j) (* en pleine confiance ! *)
-	| _ -> invalid_arg "Tcc.replace_by_meta (TO DO)" 
+	| _ -> invalid_arg "Tcc.replace_by_meta (TO DO)"
         *)
       in
       mkCast (m,DEFAULTcast, ty),[n,ty],[Some th]
@@ -120,13 +120,13 @@ let replace_in_array keep_length env sigma a =
     raise NoMeta;
   let a' = Array.map (function
 			| (TH (c,mm,[])) when not keep_length -> c,mm,[]
-			| th -> replace_by_meta env sigma th) a 
+			| th -> replace_by_meta env sigma th) a
   in
   let v' = Array.map pi1 a' in
   let mm = Array.fold_left (@) [] (Array.map pi2 a') in
   let sgp = Array.fold_left (@) [] (Array.map pi3 a') in
   v',mm,sgp
-    
+
 let fresh env n =
   let id = match n with Name x -> x | _ -> id_of_string "_H" in
   next_global_ident_away true id (ids_of_named_context (named_context env))
@@ -134,14 +134,14 @@ let fresh env n =
 let rec compute_metamap env sigma c = match kind_of_term c with
   (* le terme est directement une preuve *)
   | (Const _ | Evar _ | Ind _ | Construct _ |
-    Sort _ | Var _ | Rel _) -> 
+    Sort _ | Var _ | Rel _) ->
       TH (c,[],[])
 
   (* le terme est une mv => un but *)
   | Meta n ->
       TH (c,[],[None])
 
-  | Cast (m,_, ty) when isMeta m -> 
+  | Cast (m,_, ty) when isMeta m ->
       TH (c,[destMeta m,ty],[None])
 
 
@@ -154,7 +154,7 @@ let rec compute_metamap env sigma c = match kind_of_term c with
       begin match compute_metamap env' sigma (subst1 (mkVar v) c2) with
 	(* terme de preuve complet *)
 	| TH (_,_,[]) -> TH (c,[],[])
-	(* terme de preuve incomplet *)    
+	(* terme de preuve incomplet *)
 	| th ->
 	    let m,mm,sgp = replace_by_meta env' sigma th in
 	    TH (mkLambda (Name v,c1,m), mm, sgp)
@@ -168,13 +168,13 @@ let rec compute_metamap env sigma c = match kind_of_term c with
       begin match th1,th2 with
 	(* terme de preuve complet *)
 	| TH (_,_,[]), TH (_,_,[]) -> TH (c,[],[])
-	(* terme de preuve incomplet *)    
+	(* terme de preuve incomplet *)
 	| TH (c1,mm1,sgp1), TH (c2,mm2,sgp2) ->
 	    let m1,mm1,sgp1 =
-              if sgp1=[] then (c1,mm1,[]) 
+              if sgp1=[] then (c1,mm1,[])
               else replace_by_meta env sigma th1 in
 	    let m2,mm2,sgp2 =
-              if sgp2=[] then (c2,mm2,[]) 
+              if sgp2=[] then (c2,mm2,[])
               else replace_by_meta env' sigma th2 in
 	    TH (mkNamedLetIn v m1 t1 m2, mm1@mm2, sgp1@sgp2)
       end
@@ -213,7 +213,7 @@ let rec compute_metamap env sigma c = match kind_of_term c with
       let env' = push_named_rec_types (fi',ai,v) env in
       let a = Array.map
 		(compute_metamap env' sigma)
-		(Array.map (substl (List.map mkVar (Array.to_list vi))) v) 
+		(Array.map (substl (List.map mkVar (Array.to_list vi))) v)
       in
       begin
 	try
@@ -223,12 +223,12 @@ let rec compute_metamap env sigma c = match kind_of_term c with
 	with NoMeta ->
 	  TH (c,[],[])
       end
-	      
+
   (* Cast. Est-ce bien exact ? *)
   | Cast (c,_,t) -> compute_metamap env sigma c
       (*let TH (c',mm,sgp) = compute_metamap sign c in
 	TH (mkCast (c',t),mm,sgp) *)
-      
+
   (* Produit. Est-ce bien exact ? *)
   | Prod (_,_,_) ->
       if occur_meta c then
@@ -243,7 +243,7 @@ let rec compute_metamap env sigma c = match kind_of_term c with
       let env' = push_named_rec_types (fi',ai,v) env in
       let a = Array.map
 		(compute_metamap env' sigma)
-		(Array.map (substl (List.map mkVar (Array.to_list vi))) v) 
+		(Array.map (substl (List.map mkVar (Array.to_list vi))) v)
       in
       begin
 	try
@@ -256,7 +256,7 @@ let rec compute_metamap env sigma c = match kind_of_term c with
 
 
 (*  tcc_aux : term_with_holes -> tactic
- * 
+ *
  *  Réalise le 3. ci-dessus
  *)
 
@@ -269,11 +269,11 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
 
     | Cast (c,_,_), _ when isMeta c ->
 	tclIDTAC gl
-	  
+
     (* terme pur => refine *)
     | _,[] ->
 	refine c gl
-	
+
     (* abstraction => intro *)
     | Lambda (Name id,_,m), _ ->
 	assert (isMeta (strip_outer_cast m));
@@ -292,7 +292,7 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
 	  | [Some th] ->
               tclTHEN
                 intro
-                (onLastHypId (fun id -> 
+                (onLastHypId (fun id ->
                   tclTHEN
                     (clear [id])
                     (tcc_aux (mkVar (*dummy*) id::subst) th))) gl
@@ -303,25 +303,25 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
     | LetIn (Name id,c1,t1,c2), _ when not (isMeta (strip_outer_cast c1)) ->
 	let c = pf_concl gl in
 	let newc = mkNamedLetIn id c1 t1 c in
-	tclTHEN 
-	  (change_in_concl None newc) 
-	  (match sgp with 
+	tclTHEN
+	  (change_in_concl None newc)
+	  (match sgp with
 	     | [None] -> introduction id
 	     | [Some th] ->
                  tclTHEN (introduction id)
                    (onLastHypId (fun id -> tcc_aux (mkVar id::subst) th))
-	     | _ -> assert false) 
+	     | _ -> assert false)
 	  gl
 
     (* let in with holes in the body => unable to handle dependency
        because of evars limitation, use non dependent assert instead *)
     | LetIn (Name id,c1,t1,c2), _ ->
 	tclTHENS
-          (assert_tac (Name id) t1) 
-	  [(match List.hd sgp with 
+          (assert_tac (Name id) t1)
+	  [(match List.hd sgp with
 	     | None -> tclIDTAC
 	     | Some th -> onLastHypId (fun id -> tcc_aux (mkVar id::subst) th));
-           (match List.tl sgp with 
+           (match List.tl sgp with
 	     | [] -> refine (subst1 (mkVar id) c2)  (* a complete proof *)
 	     | [None] -> tclIDTAC                   (* a meta *)
 	     | [Some th] ->                         (* a partial proof *)
@@ -340,7 +340,7 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
 	tclTHENS
 	  (mutual_fix (out_name fi.(j)) (succ ni.(j)) (firsts@List.tl lasts) j)
 	  (List.map (function
-		       | None -> tclIDTAC 
+		       | None -> tclIDTAC
 		       | Some th -> tcc_aux subst th) sgp)
 	  gl
 
@@ -355,7 +355,7 @@ let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
 	tclTHENS
 	  (mutual_cofix (out_name fi.(j)) (firsts@List.tl lasts) j)
 	  (List.map (function
-		       | None -> tclIDTAC 
+		       | None -> tclIDTAC
 		       | Some th -> tcc_aux subst th) sgp)
 	  gl
 
@@ -375,7 +375,7 @@ let refine (evd,c) gl =
   let evd = Typeclasses.resolve_typeclasses ~onlyargs:true (pf_env gl) evd in
   let c = Evarutil.nf_evar evd c in
   let (evd,c) = Evarutil.evars_to_metas sigma (evd,c) in
-  (* Relies on Cast's put on Meta's by evars_to_metas, because it is otherwise 
+  (* Relies on Cast's put on Meta's by evars_to_metas, because it is otherwise
      complicated to update meta types when passing through a binder *)
   let th = compute_metamap (pf_env gl) evd c in
   tclTHEN (Refiner.tclEVARS evd) (tcc_aux [] th) gl
diff --git a/tactics/rewrite.ml4 b/tactics/rewrite.ml4
index 02bff3b15f..1c48988c77 100644
--- a/tactics/rewrite.ml4
+++ b/tactics/rewrite.ml4
@@ -47,18 +47,18 @@ let check_required_library d =
   let dir = make_dirpath (List.rev d') in
   if not (Library.library_is_loaded dir) then
     error ("Library "^(list_last d)^" has to be required first.")
-      
+
 let classes_dirpath =
   make_dirpath (List.map id_of_string ["Classes";"Coq"])
-  
+
 let init_setoid () =
   if is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then ()
   else check_required_library ["Coq";"Setoids";"Setoid"]
 
-let proper_class = 
+let proper_class =
   lazy (class_info (Nametab.global (Qualid (dummy_loc, qualid_of_string "Coq.Classes.Morphisms.Proper"))))
 
-let proper_proxy_class = 
+let proper_proxy_class =
   lazy (class_info (Nametab.global (Qualid (dummy_loc, qualid_of_string "Coq.Classes.Morphisms.ProperProxy"))))
 
 let proper_proj = lazy (mkConst (Option.get (snd (List.hd (Lazy.force proper_class).cl_projs))))
@@ -68,10 +68,10 @@ let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
 let try_find_global_reference dir s =
   let sp = Libnames.make_path (make_dir ("Coq"::dir)) (id_of_string s) in
     Nametab.global_of_path sp
-      
+
 let try_find_reference dir s =
   constr_of_global (try_find_global_reference dir s)
-    
+
 let gen_constant dir s = Coqlib.gen_constant "rewrite" dir s
 let coq_proj1 = lazy(gen_constant ["Init"; "Logic"] "proj1")
 let coq_proj2 = lazy(gen_constant ["Init"; "Logic"] "proj2")
@@ -131,16 +131,16 @@ let setoid_refl_proj = lazy (gen_constant ["Classes"; "SetoidClass"] "Equivalenc
 
 let rewrite_relation_class = lazy (gen_constant ["Classes"; "RelationClasses"] "RewriteRelation")
 let rewrite_relation = lazy (gen_constant ["Classes"; "RelationClasses"] "rewrite_relation")
-  
-let arrow_morphism a b = 
+
+let arrow_morphism a b =
   if isprop a && isprop b then
     Lazy.force impl
   else
     mkApp(Lazy.force arrow, [|a;b|])
 
-let setoid_refl pars x = 
+let setoid_refl pars x =
   applistc (Lazy.force setoid_refl_proj) (pars @ [x])
-      
+
 let proper_type = lazy (constr_of_global (Lazy.force proper_class).cl_impl)
 
 let proper_proxy_type = lazy (constr_of_global (Lazy.force proper_proxy_class).cl_impl)
@@ -148,9 +148,9 @@ let proper_proxy_type = lazy (constr_of_global (Lazy.force proper_proxy_class).c
 let is_applied_rewrite_relation env sigma rels t =
   match kind_of_term t with
   | App (c, args) when Array.length args >= 2 ->
-      let head = if isApp c then fst (destApp c) else c in 
+      let head = if isApp c then fst (destApp c) else c in
 	if eq_constr (Lazy.force coq_eq) head then None
-	else 
+	else
 	  (try
 	      let params, args = array_chop (Array.length args - 2) args in
 	      let env' = Environ.push_rel_context rels env in
@@ -160,19 +160,19 @@ let is_applied_rewrite_relation env sigma rels t =
 		Some (sigma, it_mkProd_or_LetIn t rels)
 	  with _ -> None)
   | _ -> None
-      
-let _ = 
+
+let _ =
   Equality.register_is_applied_rewrite_relation is_applied_rewrite_relation
 
 let split_head = function
     hd :: tl -> hd, tl
   | [] -> assert(false)
 
-let new_goal_evar (goal,cstr) env t = 
+let new_goal_evar (goal,cstr) env t =
   let goal', t = Evarutil.new_evar goal env t in
     (goal', cstr), t
 
-let new_cstr_evar (goal,cstr) env t = 
+let new_cstr_evar (goal,cstr) env t =
   let cstr', t = Evarutil.new_evar cstr env t in
     (goal, cstr'), t
 
@@ -183,7 +183,7 @@ let build_signature evars env m (cstrs : 'a option list) (finalcstr : 'a option)
   in
   let mk_relty evars env ty obj =
     match obj with
-      | None -> 
+      | None ->
 	  let relty = mk_relation ty in
 	    new_evar evars env relty
       | Some x -> evars, f x
@@ -191,7 +191,7 @@ let build_signature evars env m (cstrs : 'a option list) (finalcstr : 'a option)
   let rec aux env evars ty l =
     let t = Reductionops.whd_betadeltaiota env (fst evars) ty in
       match kind_of_term t, l with
-      | Prod (na, ty, b), obj :: cstrs -> 
+      | Prod (na, ty, b), obj :: cstrs ->
 	  if dependent (mkRel 1) b then
 	    let (evars, b, arg, cstrs) = aux (Environ.push_rel (na, None, ty) env) evars b cstrs in
 	    let ty = Reductionops.nf_betaiota (fst evars) ty in
@@ -207,22 +207,22 @@ let build_signature evars env m (cstrs : 'a option list) (finalcstr : 'a option)
 	    let newarg = mkApp (Lazy.force respectful, [| ty ; b' ; relty ; arg |]) in
 	      evars, mkProd(na, ty, b), newarg, (ty, Some relty) :: cstrs
       | _, obj :: _ -> anomaly "build_signature: not enough products"
-      | _, [] -> 
+      | _, [] ->
 	  (match finalcstr with
-	  | None -> 
+	  | None ->
 	      let t = Reductionops.nf_betaiota (fst evars) ty in
-	      let evars, rel = mk_relty evars env t None in 
+	      let evars, rel = mk_relty evars env t None in
 		evars, t, rel, [t, Some rel]
 	  | Some codom -> let (t, rel) = codom in
 			    evars, t, rel, [t, Some rel])
   in aux env evars m cstrs
-    
+
 let proper_proof env evars carrier relation x =
   let goal = mkApp (Lazy.force proper_proxy_type, [| carrier ; relation; x |])
   in new_cstr_evar evars env goal
 
 let find_class_proof proof_type proof_method env evars carrier relation =
-  try 
+  try
     let goal = mkApp (Lazy.force proof_type, [| carrier ; relation |]) in
     let evars, c = Typeclasses.resolve_one_typeclass env evars goal in
       mkApp (Lazy.force proof_method, [| carrier; relation; c |])
@@ -234,7 +234,7 @@ let get_transitive_proof env = find_class_proof transitive_type transitive_proof
 
 exception FoundInt of int
 
-let array_find (arr: 'a array) (pred: int -> 'a -> bool): int = 
+let array_find (arr: 'a array) (pred: int -> 'a -> bool): int =
   try
     for i=0 to Array.length arr - 1 do if pred i (arr.(i)) then raise (FoundInt i) done;
     raise Not_found
@@ -253,12 +253,12 @@ type hypinfo = {
 }
 
 let evd_convertible env evd x y =
-  try ignore(Evarconv.the_conv_x env x y evd); true 
+  try ignore(Evarconv.the_conv_x env x y evd); true
   with _ -> false
-  
+
 let decompose_applied_relation env sigma c left2right =
   let ctype = Typing.type_of env sigma c in
-  let find_rel ty = 
+  let find_rel ty =
     let eqclause = Clenv.mk_clenv_from_env env sigma None (c,ty) in
     let (equiv, args) = decompose_app (Clenv.clenv_type eqclause) in
     let rec split_last_two = function
@@ -267,7 +267,7 @@ let decompose_applied_relation env sigma c left2right =
 	  let l,res = split_last_two (y::z) in x::l, res
       | _ -> error "The term provided is not an applied relation." in
     let others,(c1,c2) = split_last_two args in
-    let ty1, ty2 = 
+    let ty1, ty2 =
       Typing.mtype_of env eqclause.evd c1, Typing.mtype_of env eqclause.evd c2
     in
       if not (evd_convertible env eqclause.evd ty1 ty2) then None
@@ -278,12 +278,12 @@ let decompose_applied_relation env sigma c left2right =
   in
     match find_rel ctype with
     | Some c -> c
-    | None -> 
+    | None ->
 	let ctx,t' = Reductionops.splay_prod_assum env sigma ctype in (* Search for underlying eq *)
 	match find_rel (it_mkProd_or_LetIn t' ctx) with
 	| Some c -> c
 	| None -> error "The term does not end with an applied homogeneous relation."
-	    
+
 let rewrite_unif_flags = {
   Unification.modulo_conv_on_closed_terms = None;
   Unification.use_metas_eagerly = true;
@@ -312,27 +312,27 @@ let setoid_rewrite_unif_flags = {
 
 let convertible env evd x y =
   Reductionops.is_conv env evd x y
-  
+
 let allowK = true
 
-let refresh_hypinfo env sigma hypinfo = 
+let refresh_hypinfo env sigma hypinfo =
   if hypinfo.abs = None then
     let {l2r=l2r; c=c;cl=cl} = hypinfo in
-      match c with 
+      match c with
 	| Some c ->
 	    (* Refresh the clausenv to not get the same meta twice in the goal. *)
 	    decompose_applied_relation env cl.evd c l2r;
 	| _ -> hypinfo
   else hypinfo
 
-let unify_eqn env sigma hypinfo t = 
+let unify_eqn env sigma hypinfo t =
   if isEvar t then None
-  else try 
+  else try
     let {cl=cl; prf=prf; car=car; rel=rel; l2r=l2r; c1=c1; c2=c2; c=c; abs=abs} = !hypinfo in
     let left = if l2r then c1 else c2 in
     let env', prf, c1, c2, car, rel =
       match abs with
-      | Some (absprf, absprfty) -> 
+      | Some (absprf, absprfty) ->
 	  let env' = clenv_unify allowK ~flags:rewrite2_unif_flags CONV left t cl in
 	    env', prf, c1, c2, car, rel
       | None ->
@@ -342,7 +342,7 @@ let unify_eqn env sigma hypinfo t =
 	      (* For Ring essentially, only when doing setoid_rewrite *)
 	      clenv_unify allowK ~flags:rewrite2_unif_flags CONV left t cl
 	  in
-	  let env' = 
+	  let env' =
 	    let mvs = clenv_dependent false env' in
 	      clenv_pose_metas_as_evars env' mvs
 	  in
@@ -350,13 +350,13 @@ let unify_eqn env sigma hypinfo t =
 	  let env' = { env' with evd = evd' } in
 	  let nf c = Evarutil.nf_evar evd' (Clenv.clenv_nf_meta env' c) in
 	  let c1 = nf c1 and c2 = nf c2
-	  and car = nf car and rel = nf rel 
+	  and car = nf car and rel = nf rel
 	  and prf = nf (Clenv.clenv_value env') in
-	  let ty1 = Typing.mtype_of env'.env env'.evd c1 
+	  let ty1 = Typing.mtype_of env'.env env'.evd c1
 	  and ty2 = Typing.mtype_of env'.env env'.evd c2
 	  in
 	    if convertible env env'.evd ty1 ty2 then (
-	      if occur_meta prf then 
+	      if occur_meta prf then
 		hypinfo := refresh_hypinfo env sigma !hypinfo;
 	      env', prf, c1, c2, car, rel)
 	    else raise Reduction.NotConvertible
@@ -364,7 +364,7 @@ let unify_eqn env sigma hypinfo t =
     let res =
       if l2r then (prf, (car, rel, c1, c2))
       else
-	try (mkApp (get_symmetric_proof env Evd.empty car rel, 
+	try (mkApp (get_symmetric_proof env Evd.empty car rel,
 		   [| c1 ; c2 ; prf |]),
 	    (car, rel, c2, c1))
 	with Not_found ->
@@ -374,16 +374,16 @@ let unify_eqn env sigma hypinfo t =
 
 let unfold_impl t =
   match kind_of_term t with
-    | App (arrow, [| a; b |])(*  when eq_constr arrow (Lazy.force impl) *) -> 
+    | App (arrow, [| a; b |])(*  when eq_constr arrow (Lazy.force impl) *) ->
 	mkProd (Anonymous, a, lift 1 b)
     | _ -> assert false
 
-let unfold_id t = 
+let unfold_id t =
   match kind_of_term t with
     | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_id) *) -> b
     | _ -> assert false
 
-let unfold_all t = 
+let unfold_all t =
   match kind_of_term t with
     | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_all) *) ->
 	(match kind_of_term b with
@@ -391,7 +391,7 @@ let unfold_all t =
 	  | _ -> assert false)
     | _ -> assert false
 
-let decomp_prod env evm n c = 
+let decomp_prod env evm n c =
   snd (Reductionops.splay_prod_n env evm n c)
 
 let rec decomp_pointwise n c =
@@ -400,19 +400,19 @@ let rec decomp_pointwise n c =
     match kind_of_term c with
       | App (pointwise, [| a; b; relb |]) -> decomp_pointwise (pred n) relb
       | _ -> raise Not_found
-	  
+
 let lift_cstr env sigma evars args cstr =
   let cstr =
-    let start = 
+    let start =
       match cstr with
       | Some codom -> codom
-      | None -> 
+      | None ->
 	  let car = Evarutil.e_new_evar evars env (new_Type ()) in
 	  let rel = Evarutil.e_new_evar evars env (mk_relation car) in
 	    (car, rel)
     in
       Array.fold_right
-	(fun arg (car, rel) -> 
+	(fun arg (car, rel) ->
 	  let ty = Typing.type_of env sigma arg in
 	  let car' = mkProd (Anonymous, ty, car) in
 	  let rel' = mkApp (Lazy.force pointwise_relation, [| ty; car; rel |]) in
@@ -440,10 +440,10 @@ type rewrite_result_info = {
 }
 
 type rewrite_result = rewrite_result_info option
-  
+
 type strategy = Environ.env -> evar_defs -> constr -> types ->
   constr option -> evars -> rewrite_result option
-  
+
 let resolve_subrelation env sigma car rel rel' res =
   if eq_constr rel rel' then res
   else
@@ -452,14 +452,14 @@ let resolve_subrelation env sigma car rel rel' res =
 (*   with NotConvertible -> *)
     let app = mkApp (Lazy.force subrelation, [|car; rel; rel'|]) in
     let evars, subrel = new_cstr_evar res.rew_evars env app in
-      { res with 
+      { res with
 	rew_prf = mkApp (subrel, [| res.rew_from ; res.rew_to ; res.rew_prf |]);
 	rew_rel = rel';
 	rew_evars = evars }
 
 
 let resolve_morphism env sigma oldt m ?(fnewt=fun x -> x) args args' cstr evars =
-  let evars, morph_instance, proj, sigargs, m', args, args' = 
+  let evars, morph_instance, proj, sigargs, m', args, args' =
     let first = try (array_find args' (fun i b -> b <> None)) with Not_found -> raise (Invalid_argument "resolve_morphism") in
     let morphargs, morphobjs = array_chop first args in
     let morphargs', morphobjs' = array_chop first args' in
@@ -477,22 +477,22 @@ let resolve_morphism env sigma oldt m ?(fnewt=fun x -> x) args args' cstr evars
     in
     let evars, morph = new_cstr_evar evars env' app in
       evars, morph, morph, sigargs, appm, morphobjs, morphobjs'
-  in 
-  let projargs, subst, evars, respars, typeargs = 
-    array_fold_left2 
-      (fun (acc, subst, evars, sigargs, typeargs') x y -> 
+  in
+  let projargs, subst, evars, respars, typeargs =
+    array_fold_left2
+      (fun (acc, subst, evars, sigargs, typeargs') x y ->
 	let (carrier, relation), sigargs = split_head sigargs in
 	  match relation with
 	  | Some relation ->
-	      let carrier = substl subst carrier 
+	      let carrier = substl subst carrier
 	      and relation = substl subst relation in
 	      (match y with
 	      | None ->
 		  let evars, proof = proper_proof env evars carrier relation x in
 		    [ proof ; x ; x ] @ acc, subst, evars, sigargs, x :: typeargs'
-	      | Some r -> 
+	      | Some r ->
 		  [ r.rew_prf; r.rew_to; x ] @ acc, subst, evars, sigargs, r.rew_to :: typeargs')
-	  | None -> 
+	  | None ->
 	      if y <> None then error "Cannot rewrite the argument of a dependent function";
 	      x :: acc, x :: subst, evars, sigargs, x :: typeargs')
       ([], [], evars, sigargs, []) args args'
@@ -502,7 +502,7 @@ let resolve_morphism env sigma oldt m ?(fnewt=fun x -> x) args args' cstr evars
     match respars with
 	[ a, Some r ] -> evars, proof, a, r, oldt, fnewt newt
       | _ -> assert(false)
-	
+
 let apply_constraint env sigma car rel cstr res =
   match cstr with
   | None -> res
@@ -512,7 +512,7 @@ let eq_env x y = x == y
 
 let apply_rule hypinfo loccs : strategy =
   let (nowhere_except_in,occs) = loccs in
-  let is_occ occ = 
+  let is_occ occ =
     if nowhere_except_in then List.mem occ occs else not (List.mem occ occs) in
   let occ = ref 0 in
     fun env sigma t ty cstr evars ->
@@ -520,13 +520,13 @@ let apply_rule hypinfo loccs : strategy =
       let unif = unify_eqn env sigma hypinfo t in
 	if unif <> None then incr occ;
 	match unif with
-	| Some (env', (prf, (car, rel, c1, c2))) when is_occ !occ -> 
+	| Some (env', (prf, (car, rel, c1, c2))) when is_occ !occ ->
 	    begin
 	      let goalevars = Evd.evar_merge (fst evars)
 		(Evd.undefined_evars (Evarutil.nf_evar_defs env'.evd))
 	      in
-	      let res = { rew_car = ty; rew_rel = rel; rew_from = c1; 
-			  rew_to = c2; rew_prf = prf; rew_evars = goalevars, snd evars } 
+	      let res = { rew_car = ty; rew_rel = rel; rew_from = c1;
+			  rew_to = c2; rew_prf = prf; rew_evars = goalevars, snd evars }
 	      in Some (Some (apply_constraint env sigma car rel cstr res))
 	    end
 	| _ -> None
@@ -538,27 +538,27 @@ let apply_lemma (evm,c) left2right loccs : strategy =
       apply_rule hypinfo loccs env sigma
 
 let make_leibniz_proof c ty r =
-  let prf = mkApp (Lazy.force coq_f_equal, 
+  let prf = mkApp (Lazy.force coq_f_equal,
 		  [| r.rew_car; ty;
 		     mkLambda (Anonymous, r.rew_car, c (mkRel 1));
 		     r.rew_from; r.rew_to; r.rew_prf |])
   in
-    { r with rew_car = ty; rew_rel = mkApp (Lazy.force coq_eq, [| ty |]); 
+    { r with rew_car = ty; rew_rel = mkApp (Lazy.force coq_eq, [| ty |]);
       rew_from = c r.rew_from; rew_to = c r.rew_to; rew_prf = prf }
-      
+
 let subterm all flags (s : strategy) : strategy =
   let rec aux env sigma t ty cstr evars =
     let cstr' = Option.map (fun c -> (ty, c)) cstr in
       match kind_of_term t with
       | App (m, args) ->
-	  let rewrite_args success = 
+	  let rewrite_args success =
 	    let args', evars', progress =
-	      Array.fold_left 
-		(fun (acc, evars, progress) arg -> 
+	      Array.fold_left
+		(fun (acc, evars, progress) arg ->
 		  if progress <> None && not all then (None :: acc, evars, progress)
-		  else 
+		  else
 		    let res = s env sigma arg (Typing.type_of env sigma arg) None evars in
-		      match res with 
+		      match res with
 		      | Some None -> (None :: acc, evars, if progress = None then Some false else progress)
 		      | Some (Some r) -> (Some r :: acc, r.rew_evars, Some true)
 		      | None -> (None :: acc, evars, progress))
@@ -573,11 +573,11 @@ let subterm all flags (s : strategy) : strategy =
 		  let res = { rew_car = ty; rew_rel = rel; rew_from = c1;
 			      rew_to = c2; rew_prf = prf; rew_evars = evars' } in
 		    Some (Some res)
-	  in 
+	  in
 	    if flags.on_morphisms then
 	      let evarsref = ref (snd evars) in
 	      let cstr' = lift_cstr env sigma evarsref args cstr' in
-	      let m' = s env sigma m (Typing.type_of env sigma m) 
+	      let m' = s env sigma m (Typing.type_of env sigma m)
 		(Option.map snd cstr') (fst evars, !evarsref)
 	      in
 		match m' with
@@ -587,14 +587,14 @@ let subterm all flags (s : strategy) : strategy =
 		    (* We rewrote the function and get a proof of pointwise rel for the arguments.
 		       We just apply it. *)
 		    let nargs = Array.length args in
-		    let res = 
+		    let res =
 		      { rew_car = decomp_prod env (fst r.rew_evars) nargs r.rew_car;
-			rew_rel = decomp_pointwise nargs r.rew_rel; 
+			rew_rel = decomp_pointwise nargs r.rew_rel;
 			rew_from = mkApp(r.rew_from, args); rew_to = mkApp(r.rew_to, args);
 			rew_prf = mkApp (r.rew_prf, args); rew_evars = r.rew_evars }
 		    in Some (Some res)
 	    else rewrite_args None
-	      
+
       | Prod (n, x, b) when not (dependent (mkRel 1) b) ->
 	  let b = subst1 mkProp b in
 	  let tx = Typing.type_of env sigma x and tb = Typing.type_of env sigma b in
@@ -602,7 +602,7 @@ let subterm all flags (s : strategy) : strategy =
 	    (match res with
 	    | Some (Some r) -> Some (Some { r with rew_to = unfold_impl r.rew_to })
 	    | _ -> res)
-	      
+
       (* 		if x' = None && flags.under_lambdas then *)
       (* 		  let lam = mkLambda (n, x, b) in *)
       (* 		  let lam', occ = aux env lam occ None in *)
@@ -616,14 +616,14 @@ let subterm all flags (s : strategy) : strategy =
       (* 				 cstr evars) *)
       (* 		  in res, occ *)
       (* 		else *)
-	      
+
       | Prod (n, dom, codom) when eq_constr ty mkProp ->
 	  let lam = mkLambda (n, dom, codom) in
 	  let res = aux env sigma (mkApp (Lazy.force coq_all, [| dom; lam |])) ty cstr evars in
 	    (match res with
 	    | Some (Some r) -> Some (Some { r with rew_to = unfold_all r.rew_to })
 	    | _ -> res)
-	      
+
       | Lambda (n, t, b) when flags.under_lambdas ->
 	  let env' = Environ.push_rel (n, None, t) env in
 	  let b' = s env' sigma b (Typing.type_of env' sigma b) (unlift_cstr env sigma cstr) evars in
@@ -636,7 +636,7 @@ let subterm all flags (s : strategy) : strategy =
 		  rew_from = mkLambda(n, t, r.rew_from);
 		  rew_to = mkLambda (n, t, r.rew_to) })
 	    | _ -> b')
-	      
+
       | Case (ci, p, c, brs) ->
 	  let cty = Typing.type_of env sigma c in
 	  let cstr = Some (mkApp (Lazy.force coq_eq, [| cty |])) in
@@ -644,16 +644,16 @@ let subterm all flags (s : strategy) : strategy =
 	    (match c' with
 	    | Some (Some r) ->
 		Some (Some (make_leibniz_proof (fun x -> mkCase (ci, p, x, brs)) ty r))
-	    | x -> 
+	    | x ->
 		if array_for_all ((=) 0) ci.ci_cstr_nargs then
 		  let cstr = Some (mkApp (Lazy.force coq_eq, [| ty |])) in
-		  let found, brs' = Array.fold_left (fun (found, acc) br -> 
-		    if found <> None then (found, fun x -> br :: acc x) 
+		  let found, brs' = Array.fold_left (fun (found, acc) br ->
+		    if found <> None then (found, fun x -> br :: acc x)
 		    else
 		      match s env sigma br ty cstr evars with
 		      | Some (Some r) -> (Some r, fun x -> x :: acc x)
-		      | _ -> (None, fun x -> br :: acc x)) 
-		    (None, fun x -> []) brs 
+		      | _ -> (None, fun x -> br :: acc x))
+		    (None, fun x -> []) brs
 		  in
 		    match found with
 		    | Some r ->
@@ -674,7 +674,7 @@ let transitivity env sigma (res : rewrite_result_info) (next : strategy) : rewri
   match next env sigma res.rew_to res.rew_car (Some res.rew_rel) res.rew_evars with
   | None -> None
   | Some None -> Some (Some res)
-  | Some (Some res') -> 
+  | Some (Some res') ->
       let prfty = mkApp (Lazy.force transitive_type, [| res.rew_car ; res.rew_rel |]) in
       let evars, prf = new_cstr_evar res'.rew_evars env prfty in
       let prf = mkApp (prf, [|res.rew_from; res'.rew_from; res'.rew_to;
@@ -682,22 +682,22 @@ let transitivity env sigma (res : rewrite_result_info) (next : strategy) : rewri
       in Some (Some { res' with rew_from = res.rew_from; rew_evars = evars; rew_prf = prf })
 
 (** Rewriting strategies.
-    
+
     Inspired by ELAN's rewriting strategies:
     http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.21.4049
 *)
 
-module Strategies = 
+module Strategies =
   struct
 
-    let fail : strategy = 
+    let fail : strategy =
       fun env sigma t ty cstr evars -> None
 
-    let id : strategy = 
+    let id : strategy =
       fun env sigma t ty cstr evars -> Some None
 
     let refl : strategy =
-      fun env sigma t ty cstr evars -> 
+      fun env sigma t ty cstr evars ->
 	let evars, rel = match cstr with
 	  | None -> new_cstr_evar evars env (mk_relation ty)
 	  | Some r -> evars, r
@@ -706,11 +706,11 @@ module Strategies =
 	  let mty = mkApp (Lazy.force proper_proxy_type, [| ty ; rel; t |]) in
 	    new_cstr_evar evars env mty
 	in
-	  Some (Some { rew_car = ty; rew_rel = rel; rew_from = t; rew_to = t; 
+	  Some (Some { rew_car = ty; rew_rel = rel; rew_from = t; rew_to = t;
 		       rew_prf = proof; rew_evars = evars })
-	    
+
     let progress (s : strategy) : strategy =
-      fun env sigma t ty cstr evars -> 
+      fun env sigma t ty cstr evars ->
 	match s env sigma t ty cstr evars with
 	| None -> None
 	| Some None -> None
@@ -722,7 +722,7 @@ module Strategies =
 	| None -> None
 	| Some None -> snd env sigma t ty cstr evars
 	| Some (Some res) -> transitivity env sigma res snd
-	    
+
     let choice fst snd : strategy =
       fun env sigma t ty cstr evars ->
 	match fst env sigma t ty cstr evars with
@@ -731,7 +731,7 @@ module Strategies =
 
     let try_ str : strategy = choice str id
 
-    let fix (f : strategy -> strategy) : strategy = 
+    let fix (f : strategy -> strategy) : strategy =
       let rec aux env = f (fun env -> aux env) env in aux
 
     let any (s : strategy) : strategy =
@@ -740,10 +740,10 @@ module Strategies =
     let repeat (s : strategy) : strategy =
       seq s (any s)
 
-    let bu (s : strategy) : strategy = 
+    let bu (s : strategy) : strategy =
       fix (fun s' -> seq (choice (all_subterms s') s) (try_ s'))
 
-    let td (s : strategy) : strategy = 
+    let td (s : strategy) : strategy =
       fix (fun s' -> seq (choice s (all_subterms s')) (try_ s'))
 
     let innermost (s : strategy) : strategy =
@@ -756,7 +756,7 @@ module Strategies =
       List.fold_left (fun tac (l,l2r) ->
 	choice tac (apply_lemma l l2r (false,[])))
 	fail cs
-	
+
     let old_hints (db : string) : strategy =
       let rules = Autorewrite.find_rewrites db in
 	lemmas (List.map (fun hint -> (inj_open hint.Autorewrite.rew_lemma, hint.Autorewrite.rew_l2r)) rules)
@@ -771,9 +771,9 @@ end
 
 (** The strategy for a single rewrite, dealing with occurences. *)
 
-let rewrite_strat flags occs hyp = 
+let rewrite_strat flags occs hyp =
   let app = apply_rule hyp occs in
-  let rec aux () = 
+  let rec aux () =
     Strategies.choice app (subterm true flags (fun env -> aux () env))
   in aux ()
 
@@ -791,26 +791,26 @@ let apply_strategy (s : strategy) env sigma concl cstr evars =
     match res with
     | None -> None
     | Some None -> Some None
-    | Some (Some res) -> 
+    | Some (Some res) ->
 	evars := res.rew_evars;
 	Some (Some (res.rew_prf, (res.rew_car, res.rew_rel, res.rew_from, res.rew_to)))
 
-let split_evars_once sigma evd = 
+let split_evars_once sigma evd =
   Evd.fold (fun ev evi deps ->
-    if Intset.mem ev deps then 
+    if Intset.mem ev deps then
       Intset.union (Class_tactics.evars_of_evi evi) deps
     else deps) evd sigma
-    
+
 let existentials_of_evd evd =
-  Evd.fold (fun ev evi acc -> Intset.add ev acc) evd Intset.empty 
+  Evd.fold (fun ev evi acc -> Intset.add ev acc) evd Intset.empty
 
 let evd_of_existentials evd exs =
-  Intset.fold (fun i acc -> 
+  Intset.fold (fun i acc ->
     let evi = Evd.find evd i in
       Evd.add acc i evi) exs Evd.empty
 
-let split_evars sigma evd = 
-  let rec aux deps = 
+let split_evars sigma evd =
+  let rec aux deps =
     let deps' = split_evars_once deps evd in
       if Intset.equal deps' deps then
 	evd_of_existentials evd deps
@@ -822,12 +822,12 @@ let solve_constraints env evars =
   Typeclasses.resolve_typeclasses env ~split:false ~fail:true (merge_evars evars)
 
 let cl_rewrite_clause_aux ?(abs=None) strat goal_meta clause gl =
-  let concl, is_hyp = 
+  let concl, is_hyp =
     match clause with
 	Some id -> pf_get_hyp_typ gl id, Some id
       | None -> pf_concl gl, None
   in
-  let cstr = 
+  let cstr =
     let sort = mkProp in
     let impl = Lazy.force impl in
       match is_hyp with
@@ -839,34 +839,34 @@ let cl_rewrite_clause_aux ?(abs=None) strat goal_meta clause gl =
   let env = pf_env gl in
   let eq = apply_strategy strat env sigma concl (Some cstr) evars in
     match eq with
-    | Some (Some (p, (_, _, oldt, newt))) -> 
+    | Some (Some (p, (_, _, oldt, newt))) ->
 	(try
 	    let cstrevars = !evars in
 	    let evars = solve_constraints env cstrevars in
 	    let p = Evarutil.nf_isevar evars p in
 	    let newt = Evarutil.nf_isevar evars newt in
-	    let abs = Option.map (fun (x, y) -> 
+	    let abs = Option.map (fun (x, y) ->
 	      Evarutil.nf_isevar evars x, Evarutil.nf_isevar evars y) abs in
 	    let undef = split_evars (fst cstrevars) evars in
-	    let rewtac = 
+	    let rewtac =
 	      match is_hyp with
-	      | Some id -> 
-		  let term = 
+	      | Some id ->
+		  let term =
 		    match abs with
 		    | None -> p
-		    | Some (t, ty) -> 
+		    | Some (t, ty) ->
 			mkApp (mkLambda (Name (id_of_string "lemma"), ty, p), [| t |])
 		  in
-		    cut_replacing id newt 
+		    cut_replacing id newt
 		      (fun x -> Tacmach.refine_no_check (mkApp (term, [| mkVar id |])))
-	      | None -> 
+	      | None ->
 		  (match abs with
-		  | None -> 
+		  | None ->
 		      let name = next_name_away_with_default "H" Anonymous (pf_ids_of_hyps gl) in
 			tclTHENLAST
 			  (Tacmach.internal_cut_no_check false name newt)
 			  (tclTHEN (Tactics.revert [name]) (Tacmach.refine_no_check p))
-		  | Some (t, ty) -> 
+		  | Some (t, ty) ->
 		      Tacmach.refine_no_check
 			(mkApp (mkLambda (Name (id_of_string "newt"), newt,
 					 mkLambda (Name (id_of_string "lemma"), ty,
@@ -874,20 +874,20 @@ let cl_rewrite_clause_aux ?(abs=None) strat goal_meta clause gl =
 			       [| mkMeta goal_meta; t |])))
 	    in
 	    let evartac =
-	      if not (undef = Evd.empty) then 
+	      if not (undef = Evd.empty) then
 		Refiner.tclEVARS undef
 	      else tclIDTAC
 	    in tclTHENLIST [evartac; rewtac] gl
-	  with 
+	  with
 	  | Stdpp.Exc_located (_, TypeClassError (env, (UnsatisfiableConstraints _ as e)))
 	  | TypeClassError (env, (UnsatisfiableConstraints _ as e)) ->
-	      Refiner.tclFAIL_lazy 0 
-		(lazy (str"setoid rewrite failed: unable to satisfy the rewriting constraints." 
+	      Refiner.tclFAIL_lazy 0
+		(lazy (str"setoid rewrite failed: unable to satisfy the rewriting constraints."
 			++ fnl () ++ Himsg.explain_typeclass_error env e)) gl)
-    | Some None -> 
+    | Some None ->
 	tclFAIL 0 (str"setoid rewrite failed: no progress made") gl
     | None -> raise Not_found
-	
+
 let cl_rewrite_clause_strat strat clause gl =
   init_setoid ();
   let meta = Evarutil.new_meta() in
@@ -910,7 +910,7 @@ open Extraargs
 
 let occurrences_of = function
   | n::_ as nl when n < 0 -> (false,List.map abs nl)
-  | nl -> 
+  | nl ->
       if List.exists (fun n -> n < 0) nl then
 	error "Illegal negative occurrence number.";
       (true,nl)
@@ -924,7 +924,7 @@ let interp_strategy ist gl c = c
 let glob_strategy ist l = l
 let subst_strategy evm l = l
 
-let apply_constr_expr c l2r occs = fun env sigma -> 
+let apply_constr_expr c l2r occs = fun env sigma ->
   let c = Constrintern.interp_open_constr sigma env c in
     apply_lemma c l2r occs env sigma
 
@@ -985,8 +985,8 @@ END
 
 let clsubstitute o c =
   let is_tac id = match kind_of_term (snd c) with Var id' when id' = id -> true | _ -> false in
-    Tacticals.onAllHypsAndConcl 
-      (fun cl -> 
+    Tacticals.onAllHypsAndConcl
+      (fun cl ->
 	match cl with
 	  | Some id when is_tac id -> tclIDTAC
 	  | _ -> tclTRY (cl_rewrite_clause c o all_occurrences cl))
@@ -997,7 +997,7 @@ END
 
 
 (* Compatibility with old Setoids *)
-  
+
 TACTIC EXTEND setoid_rewrite
    [ "setoid_rewrite" orient(o) open_constr(c) ]
    -> [ cl_rewrite_clause c o all_occurrences None ]
@@ -1019,73 +1019,73 @@ let mkappc s l = CAppExpl (dummy_loc,(None,(Libnames.Ident (dummy_loc,id_of_stri
 
 let declare_an_instance n s args =
   ((dummy_loc,Name n), Explicit,
-  CAppExpl (dummy_loc, (None, Qualid (dummy_loc, qualid_of_string s)), 
+  CAppExpl (dummy_loc, (None, Qualid (dummy_loc, qualid_of_string s)),
 	   args))
 
 let declare_instance a aeq n s = declare_an_instance n s [a;aeq]
 
-let anew_instance binders instance fields = 
+let anew_instance binders instance fields =
   new_instance binders instance (CRecord (dummy_loc,None,fields)) ~generalize:false None
 
 let require_library dirpath =
   let qualid = (dummy_loc, Libnames.qualid_of_dirpath (Libnames.dirpath_of_string dirpath)) in
     Library.require_library [qualid] (Some false)
 
-let declare_instance_refl binders a aeq n lemma = 
-  let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive" 
-  in anew_instance binders instance 
+let declare_instance_refl binders a aeq n lemma =
+  let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive"
+  in anew_instance binders instance
        [((dummy_loc,id_of_string "reflexivity"),lemma)]
 
-let declare_instance_sym binders a aeq n lemma = 
+let declare_instance_sym binders a aeq n lemma =
   let instance = declare_instance a aeq (add_suffix n "_Symmetric") "Coq.Classes.RelationClasses.Symmetric"
-  in anew_instance binders instance 
+  in anew_instance binders instance
        [((dummy_loc,id_of_string "symmetry"),lemma)]
 
-let declare_instance_trans binders a aeq n lemma = 
-  let instance = declare_instance a aeq (add_suffix n "_Transitive") "Coq.Classes.RelationClasses.Transitive" 
-  in anew_instance binders instance 
+let declare_instance_trans binders a aeq n lemma =
+  let instance = declare_instance a aeq (add_suffix n "_Transitive") "Coq.Classes.RelationClasses.Transitive"
+  in anew_instance binders instance
        [((dummy_loc,id_of_string "transitivity"),lemma)]
 
 let constr_tac = Tacinterp.interp (Tacexpr.TacAtom (dummy_loc, Tacexpr.TacAnyConstructor (false,None)))
 
-let declare_relation ?(binders=[]) a aeq n refl symm trans = 
+let declare_relation ?(binders=[]) a aeq n refl symm trans =
   init_setoid ();
   let instance = declare_instance a aeq (add_suffix n "_relation") "Coq.Classes.RelationClasses.RewriteRelation"
   in ignore(anew_instance binders instance []);
-  match (refl,symm,trans) with 
+  match (refl,symm,trans) with
       (None, None, None) -> ()
-    | (Some lemma1, None, None) -> 
+    | (Some lemma1, None, None) ->
 	ignore (declare_instance_refl binders a aeq n lemma1)
-    | (None, Some lemma2, None) -> 
+    | (None, Some lemma2, None) ->
 	ignore (declare_instance_sym binders a aeq n lemma2)
-    | (None, None, Some lemma3) -> 
+    | (None, None, Some lemma3) ->
 	ignore (declare_instance_trans binders a aeq n lemma3)
-    | (Some lemma1, Some lemma2, None) -> 
-	ignore (declare_instance_refl binders a aeq n lemma1); 
+    | (Some lemma1, Some lemma2, None) ->
+	ignore (declare_instance_refl binders a aeq n lemma1);
 	ignore (declare_instance_sym binders a aeq n lemma2)
-    | (Some lemma1, None, Some lemma3) -> 
+    | (Some lemma1, None, Some lemma3) ->
 	let _lemma_refl = declare_instance_refl binders a aeq n lemma1 in
 	let _lemma_trans = declare_instance_trans binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PreOrder" 
+	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PreOrder"
 	in ignore(
-	    anew_instance binders instance 
+	    anew_instance binders instance
 	      [((dummy_loc,id_of_string "PreOrder_Reflexive"), lemma1);
 	       ((dummy_loc,id_of_string "PreOrder_Transitive"),lemma3)])
-    | (None, Some lemma2, Some lemma3) -> 
+    | (None, Some lemma2, Some lemma3) ->
 	let _lemma_sym = declare_instance_sym binders a aeq n lemma2 in
 	let _lemma_trans = declare_instance_trans binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PER" 
+	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PER"
 	in ignore(
-	    anew_instance binders instance 
+	    anew_instance binders instance
 	      [((dummy_loc,id_of_string "PER_Symmetric"), lemma2);
 	       ((dummy_loc,id_of_string "PER_Transitive"),lemma3)])
-     | (Some lemma1, Some lemma2, Some lemma3) -> 
-	let _lemma_refl = declare_instance_refl binders a aeq n lemma1 in 
+     | (Some lemma1, Some lemma2, Some lemma3) ->
+	let _lemma_refl = declare_instance_refl binders a aeq n lemma1 in
 	let _lemma_sym = declare_instance_sym binders a aeq n lemma2 in
 	let _lemma_trans = declare_instance_trans binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence" 
+	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
 	in ignore(
-	  anew_instance binders instance 
+	  anew_instance binders instance
 	    [((dummy_loc,id_of_string "Equivalence_Reflexive"), lemma1);
 	     ((dummy_loc,id_of_string "Equivalence_Symmetric"), lemma2);
 	     ((dummy_loc,id_of_string "Equivalence_Transitive"), lemma3)])
@@ -1100,19 +1100,19 @@ let (wit_binders_let : Genarg.tlevel binders_let_argtype),
 open Pcoq.Constr
 
 VERNAC COMMAND EXTEND AddRelation
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1) 
+  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
 	"symmetry" "proved" "by" constr(lemma2) "as" ident(n) ] ->
       [ declare_relation a aeq n (Some lemma1) (Some lemma2) None ]
 
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)  
+  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
 	"as" ident(n) ] ->
       [ declare_relation a aeq n (Some lemma1) None None ]
-  | [ "Add" "Relation" constr(a) constr(aeq)  "as" ident(n) ] -> 
+  | [ "Add" "Relation" constr(a) constr(aeq)  "as" ident(n) ] ->
       [ declare_relation a aeq n None None None ]
 END
 
 VERNAC COMMAND EXTEND AddRelation2
-    [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) 
+    [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2)
       "as" ident(n) ] ->
       [ declare_relation a aeq n None (Some lemma2) None ]
   | [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)  "as" ident(n) ] ->
@@ -1120,33 +1120,33 @@ VERNAC COMMAND EXTEND AddRelation2
 END
 
 VERNAC COMMAND EXTEND AddRelation3
-    [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1) 
+    [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
       "transitivity" "proved" "by" constr(lemma3) "as" ident(n) ] ->
       [ declare_relation a aeq n (Some lemma1) None (Some lemma3) ]
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1) 
-      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3) 
+  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
+      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)
       "as" ident(n) ] ->
-      [ declare_relation a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ] 
+      [ declare_relation a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ]
   | [ "Add" "Relation" constr(a) constr(aeq) "transitivity" "proved" "by" constr(lemma3)
-	"as" ident(n) ] ->  
-      [ declare_relation a aeq n None None (Some lemma3) ] 
+	"as" ident(n) ] ->
+      [ declare_relation a aeq n None None (Some lemma3) ]
 END
 
 VERNAC COMMAND EXTEND AddParametricRelation
   | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq)
-	"reflexivity" "proved" "by" constr(lemma1) 
+	"reflexivity" "proved" "by" constr(lemma1)
 	"symmetry" "proved" "by" constr(lemma2) "as" ident(n) ] ->
       [ declare_relation ~binders:b a aeq n (Some lemma1) (Some lemma2) None ]
   | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq)
-	"reflexivity" "proved" "by" constr(lemma1)  
+	"reflexivity" "proved" "by" constr(lemma1)
 	"as" ident(n) ] ->
       [ declare_relation ~binders:b a aeq n (Some lemma1) None None ]
-  | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq)  "as" ident(n) ] -> 
+  | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq)  "as" ident(n) ] ->
       [ declare_relation ~binders:b a aeq n None None None ]
 END
 
 VERNAC COMMAND EXTEND AddParametricRelation2
-    [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) 
+    [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2)
       "as" ident(n) ] ->
       [ declare_relation ~binders:b a aeq n None (Some lemma2) None ]
   | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)  "as" ident(n) ] ->
@@ -1154,16 +1154,16 @@ VERNAC COMMAND EXTEND AddParametricRelation2
 END
 
 VERNAC COMMAND EXTEND AddParametricRelation3
-    [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1) 
+    [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
       "transitivity" "proved" "by" constr(lemma3) "as" ident(n) ] ->
       [ declare_relation ~binders:b a aeq n (Some lemma1) None (Some lemma3) ]
-  | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1) 
-      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3) 
+  | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
+      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)
       "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ] 
+      [ declare_relation ~binders:b a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ]
   | [ "Add" "Parametric" "Relation" binders_let(b) ":" constr(a) constr(aeq) "transitivity" "proved" "by" constr(lemma3)
-	"as" ident(n) ] ->  
-      [ declare_relation ~binders:b a aeq n None None (Some lemma3) ] 
+	"as" ident(n) ] ->
+      [ declare_relation ~binders:b a aeq n None None (Some lemma3) ]
 END
 
 let mk_qualid s =
@@ -1178,10 +1178,10 @@ let proper_projection r ty =
   let ctx, inst = decompose_prod_assum ty in
   let mor, args = destApp inst in
   let instarg = mkApp (r, rel_vect 0 (List.length ctx)) in
-  let app = mkApp (Lazy.force proper_proj, 
+  let app = mkApp (Lazy.force proper_proj,
 		  Array.append args [| instarg |]) in
     it_mkLambda_or_LetIn app ctx
-      
+
 let declare_projection n instance_id r =
   let ty = Global.type_of_global r in
   let c = constr_of_global r in
@@ -1189,41 +1189,41 @@ let declare_projection n instance_id r =
   let typ = Typing.type_of (Global.env ()) Evd.empty term in
   let ctx, typ = decompose_prod_assum typ in
   let typ =
-    let n = 
-      let rec aux t = 
+    let n =
+      let rec aux t =
 	match kind_of_term t with
-	    App (f, [| a ; a' ; rel; rel' |]) when eq_constr f (Lazy.force respectful) -> 
+	    App (f, [| a ; a' ; rel; rel' |]) when eq_constr f (Lazy.force respectful) ->
 	      succ (aux rel')
 	  | _ -> 0
       in
-      let init = 
+      let init =
 	match kind_of_term typ with
-	    App (f, args) when eq_constr f (Lazy.force respectful) -> 
+	    App (f, args) when eq_constr f (Lazy.force respectful) ->
 	      mkApp (f, fst (array_chop (Array.length args - 2) args))
 	  | _ -> typ
       in aux init
     in
     let ctx,ccl = Reductionops.splay_prod_n (Global.env()) Evd.empty (3 * n) typ
-    in it_mkProd_or_LetIn ccl ctx 
+    in it_mkProd_or_LetIn ccl ctx
   in
   let typ = it_mkProd_or_LetIn typ ctx in
-  let cst = 
+  let cst =
     { const_entry_body = term;
       const_entry_type = Some typ;
       const_entry_opaque = false;
       const_entry_boxed = false }
   in
     ignore(Declare.declare_constant n (Entries.DefinitionEntry cst, Decl_kinds.IsDefinition Decl_kinds.Definition))
-          
+
 let build_morphism_signature m =
   let env = Global.env () in
   let m = Constrintern.interp_constr Evd.empty env m in
   let t = Typing.type_of env Evd.empty m in
   let isevars = ref (Evd.empty, Evd.empty) in
-  let cstrs = 
-    let rec aux t = 
+  let cstrs =
+    let rec aux t =
       match kind_of_term t with
-	| Prod (na, a, b) -> 
+	| Prod (na, a, b) ->
 	    None :: aux b
 	| _ -> []
     in aux t
@@ -1231,7 +1231,7 @@ let build_morphism_signature m =
   let evars, t', sig_, cstrs = build_signature !isevars env t cstrs None snd in
   let _ = isevars := evars in
   let _ = List.iter
-    (fun (ty, rel) -> 
+    (fun (ty, rel) ->
       Option.iter (fun rel ->
 	let default = mkApp (Lazy.force default_relation, [| ty; rel |]) in
 	let evars,c = new_cstr_evar !isevars env default in
@@ -1239,13 +1239,13 @@ let build_morphism_signature m =
 	rel)
     cstrs
   in
-  let morph = 
+  let morph =
     mkApp (Lazy.force proper_type, [| t; sig_; m |])
   in
   let evd = solve_constraints env !isevars in
   let m = Evarutil.nf_isevar evd morph in
     Evarutil.check_evars env Evd.empty evd m; m
-	
+
 let default_morphism sign m =
   let env = Global.env () in
   let t = Typing.type_of env Evd.empty m in
@@ -1257,10 +1257,10 @@ let default_morphism sign m =
   in
   let evars, mor = resolve_one_typeclass env (merge_evars evars) morph in
     mor, proper_projection mor morph
-    	  
+
 let add_setoid binders a aeq t n =
   init_setoid ();
-  let _lemma_refl = declare_instance_refl binders a aeq n (mkappc "Seq_refl" [a;aeq;t]) in 
+  let _lemma_refl = declare_instance_refl binders a aeq n (mkappc "Seq_refl" [a;aeq;t]) in
   let _lemma_sym = declare_instance_sym binders a aeq n (mkappc "Seq_sym" [a;aeq;t]) in
   let _lemma_trans = declare_instance_trans binders a aeq n (mkappc "Seq_trans" [a;aeq;t]) in
   let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
@@ -1274,7 +1274,7 @@ let add_morphism_infer glob m n =
   init_setoid ();
   let instance_id = add_suffix n "_Proper" in
   let instance = build_morphism_signature m in
-    if Lib.is_modtype () then 
+    if Lib.is_modtype () then
       let cst = Declare.declare_internal_constant instance_id
 				(Entries.ParameterEntry (instance,false), Decl_kinds.IsAssumption Decl_kinds.Logical)
       in
@@ -1282,30 +1282,30 @@ let add_morphism_infer glob m n =
 				declare_projection n instance_id (ConstRef cst)
     else
       let kind = Decl_kinds.Global, Decl_kinds.DefinitionBody Decl_kinds.Instance in
-	Flags.silently 
+	Flags.silently
 	  (fun () ->
-	    Command.start_proof instance_id kind instance 
+	    Command.start_proof instance_id kind instance
 	      (fun _ -> function
-		Libnames.ConstRef cst -> 
-		  add_instance (Typeclasses.new_instance (Lazy.force proper_class) None 
+		Libnames.ConstRef cst ->
+		  add_instance (Typeclasses.new_instance (Lazy.force proper_class) None
 				   glob cst);
 		  declare_projection n instance_id (ConstRef cst)
 		| _ -> assert false);
 	    Pfedit.by (Tacinterp.interp <:tactic< Coq.Classes.SetoidTactics.add_morphism_tactic>>)) ();
-	Flags.if_verbose (fun x -> msg (Printer.pr_open_subgoals x)) () 
-	  
+	Flags.if_verbose (fun x -> msg (Printer.pr_open_subgoals x)) ()
+
 let add_morphism glob binders m s n =
   init_setoid ();
   let instance_id = add_suffix n "_Proper" in
-  let instance = 
+  let instance =
     ((dummy_loc,Name instance_id), Explicit,
-    CAppExpl (dummy_loc, 
-	     (None, Qualid (dummy_loc, Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper")), 
+    CAppExpl (dummy_loc,
+	     (None, Qualid (dummy_loc, Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper")),
 	     [cHole; s; m]))
-  in	  
+  in
   let tac = Tacinterp.interp <:tactic<add_morphism_tactic>> in
     ignore(new_instance ~global:glob binders instance (CRecord (dummy_loc,None,[]))
-	      ~generalize:false ~tac 
+	      ~generalize:false ~tac
 	      ~hook:(fun cst -> declare_projection n instance_id (ConstRef cst)) None)
 
 VERNAC COMMAND EXTEND AddSetoid1
@@ -1317,8 +1317,8 @@ VERNAC COMMAND EXTEND AddSetoid1
       [ add_morphism_infer (not (Vernacexpr.use_section_locality ())) m n ]
   | [ "Add" "Morphism" constr(m) "with" "signature" lconstr(s) "as" ident(n) ] ->
       [ add_morphism (not (Vernacexpr.use_section_locality ())) [] m s n ]
-  | [ "Add" "Parametric" "Morphism" binders_let(binders) ":" constr(m) 
-	"with" "signature" lconstr(s) "as" ident(n) ] -> 
+  | [ "Add" "Parametric" "Morphism" binders_let(binders) ":" constr(m)
+	"with" "signature" lconstr(s) "as" ident(n) ] ->
       [ add_morphism (not (Vernacexpr.use_section_locality ())) binders m s n ]
 END
 
@@ -1347,7 +1347,7 @@ let check_evar_map_of_evars_defs evd =
          check_freemetas_is_empty rebus2 freemetas2
    ) metas
 
-let unification_rewrite l2r c1 c2 cl car rel but gl = 
+let unification_rewrite l2r c1 c2 cl car rel but gl =
   let env = pf_env gl in
   let (evd',c') =
     try
@@ -1375,11 +1375,11 @@ let unification_rewrite l2r c1 c2 cl car rel but gl =
   let cl' = { cl' with templval = mk_freelisted prf ; templtyp = mk_freelisted prfty } in
     {cl=cl'; prf=(mkRel 1); car=car; rel=rel; l2r=l2r; c1=c1; c2=c2; c=None; abs=Some (prf, prfty)}
 
-let get_hyp gl evars (evm,c) clause l2r = 
+let get_hyp gl evars (evm,c) clause l2r =
   let hi = decompose_applied_relation (pf_env gl) evars c l2r in
   let but = match clause with Some id -> pf_get_hyp_typ gl id | None -> pf_concl gl in
     unification_rewrite hi.l2r hi.c1 hi.c2 hi.cl hi.car hi.rel but gl
-	
+
 let general_rewrite_flags = { under_lambdas = false; on_morphisms = false }
 
 let apply_lemma gl (evm,c) cl l2r occs =
@@ -1387,10 +1387,10 @@ let apply_lemma gl (evm,c) cl l2r occs =
   let evars = Evd.merge sigma evm in
   let hypinfo = ref (get_hyp gl evars (evm,c) cl l2r) in
   let app = apply_rule hypinfo occs in
-  let rec aux () = 
+  let rec aux () =
     Strategies.choice app (subterm true general_rewrite_flags (fun env -> aux () env))
   in !hypinfo, aux ()
-	
+
 let general_s_rewrite cl l2r occs (c,l) ~new_goals gl =
   let meta = Evarutil.new_meta() in
   let hypinfo, strat = apply_lemma gl c cl l2r occs in
@@ -1406,7 +1406,7 @@ let general_s_rewrite_clause x =
   match x with
     | None -> general_s_rewrite None
     | Some id -> general_s_rewrite (Some id)
-	
+
 let _ = Equality.register_general_rewrite_clause general_s_rewrite_clause
 
 let is_loaded d =
@@ -1421,24 +1421,24 @@ let try_loaded f gl =
 (** [setoid_]{reflexivity,symmetry,transitivity} tactics *)
 
 let not_declared env ty rel =
-  tclFAIL 0 (str" The relation " ++ Printer.pr_constr_env env rel ++ str" is not a declared " ++ 
+  tclFAIL 0 (str" The relation " ++ Printer.pr_constr_env env rel ++ str" is not a declared " ++
 		str ty ++ str" relation. Maybe you need to require the Setoid library")
 
-let relation_of_constr env c = 
+let relation_of_constr env c =
   match kind_of_term c with
-    | App (f, args) when Array.length args >= 2 -> 
+    | App (f, args) when Array.length args >= 2 ->
 	let relargs, args = array_chop (Array.length args - 2) args in
 	  mkApp (f, relargs), args
-    | _ -> errorlabstrm "relation_of_constr" 
+    | _ -> errorlabstrm "relation_of_constr"
 	(str "The term " ++ Printer.pr_constr_env env c ++ str" is not an applied relation.")
-	
+
 let setoid_proof gl ty fn fallback =
   let env = pf_env gl in
-    try 
+    try
       let rel, args = relation_of_constr env (pf_concl gl) in
       let evm, car = project gl, pf_type_of gl args.(0) in
 	fn env evm car rel gl
-    with e -> 
+    with e ->
       try fallback gl
       with Hipattern.NoEquationFound ->
 	  match e with
@@ -1446,19 +1446,19 @@ let setoid_proof gl ty fn fallback =
 	      let rel, args = relation_of_constr env (pf_concl gl) in
 		not_declared env ty rel gl
 	  | _ -> raise e
-	      
+
 let setoid_reflexivity gl =
-  setoid_proof gl "reflexive" 
+  setoid_proof gl "reflexive"
     (fun env evm car rel -> apply (get_reflexive_proof env evm car rel))
     (reflexivity_red true)
-	  
+
 let setoid_symmetry gl =
-  setoid_proof gl "symmetric" 
+  setoid_proof gl "symmetric"
     (fun env evm car rel -> apply (get_symmetric_proof env evm car rel))
     (symmetry_red true)
-    
+
 let setoid_transitivity c gl =
-  setoid_proof gl "transitive" 
+  setoid_proof gl "transitive"
     (fun env evm car rel ->
       let proof = get_transitive_proof env evm car rel in
       match c with
@@ -1466,7 +1466,7 @@ let setoid_transitivity c gl =
       | Some c ->
 	  apply_with_bindings (proof,Rawterm.ExplicitBindings [ dummy_loc, Rawterm.NamedHyp (id_of_string "y"), c ]))
     (transitivity_red true c)
-    
+
 let setoid_symmetry_in id gl =
   let ctype = pf_type_of gl (mkVar id) in
   let binders,concl = decompose_prod_assum ctype in
@@ -1507,12 +1507,12 @@ END
 let implify id gl =
   let (_, b, ctype) = pf_get_hyp gl id in
   let binders,concl = decompose_prod_assum ctype in
-  let ctype' = 
+  let ctype' =
     match binders with
-    | (_, None, ty as hd) :: tl when not (dependent (mkRel 1) concl) -> 
+    | (_, None, ty as hd) :: tl when not (dependent (mkRel 1) concl) ->
 	let env = Environ.push_rel_context tl (pf_env gl) in
 	let sigma = project gl in
-	let tyhd = Typing.type_of env sigma ty 
+	let tyhd = Typing.type_of env sigma ty
 	and tyconcl = Typing.type_of (Environ.push_rel hd env) sigma concl in
 	let app = mkApp (arrow_morphism tyhd (subst1 mkProp tyconcl), [| ty; (subst1 mkProp concl) |]) in
 	  it_mkProd_or_LetIn app tl
diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml
index 28173b7a34..8e55d4f5cc 100644
--- a/tactics/tacinterp.ml
+++ b/tactics/tacinterp.ml
@@ -51,13 +51,13 @@ open Extrawit
 open Pcoq
 
 let safe_msgnl s =
-    try msgnl s with e -> 
-      msgnl 
+    try msgnl s with e ->
+      msgnl
 	(str "bug in the debugger: " ++
          str "an exception is raised while printing debug information")
 
 let error_syntactic_metavariables_not_allowed loc =
-  user_err_loc 
+  user_err_loc
     (loc,"out_ident",
      str "Syntactic metavariables allowed only in quotations.")
 
@@ -76,7 +76,7 @@ type ltac_type =
 type value =
   | VRTactic of (goal list sigma * validation) (* For Match results *)
                                                (* Not a true value *)
-  | VFun of ltac_trace * (identifier*value) list * 
+  | VFun of ltac_trace * (identifier*value) list *
       identifier option list * glob_tactic_expr
   | VVoid
   | VInteger of int
@@ -135,7 +135,7 @@ let rec pr_value env = function
       str "a list (first element is " ++ pr_value env a ++ str")"
 
 (* Transforms an id into a constr if possible, or fails *)
-let constr_of_id env id = 
+let constr_of_id env id =
   construct_reference (Environ.named_context env) id
 
 (* To embed tactics *)
@@ -212,7 +212,7 @@ let _ =
         "fail", TacFail(ArgArg 0,[]);
         "fresh", TacArg(TacFreshId [])
       ]
- 
+
 let lookup_atomic id = Idmap.find id !atomic_mactab
 let is_atomic_kn kn =
   let (_,_,l) = repr_kn kn in
@@ -238,7 +238,7 @@ let tac_tab = Hashtbl.create 17
 
 let add_tactic s t =
   if Hashtbl.mem tac_tab s then
-    errorlabstrm ("Refiner.add_tactic: ") 
+    errorlabstrm ("Refiner.add_tactic: ")
       (str ("Cannot redeclare tactic "^s^"."));
   Hashtbl.add tac_tab s t
 
@@ -250,9 +250,9 @@ let overwriting_add_tactic s t =
   Hashtbl.add tac_tab s t
 
 let lookup_tactic s =
-  try 
+  try
     Hashtbl.find tac_tab s
-  with Not_found -> 
+  with Not_found ->
     errorlabstrm "Refiner.lookup_tactic"
       (str"The tactic " ++ str s ++ str" is not installed.")
 (*
@@ -271,7 +271,7 @@ type glob_sign = {
 
 type interp_genarg_type =
   (glob_sign -> raw_generic_argument -> glob_generic_argument) *
-  (interp_sign -> goal sigma -> glob_generic_argument -> 
+  (interp_sign -> goal sigma -> glob_generic_argument ->
     typed_generic_argument) *
   (substitution -> glob_generic_argument -> glob_generic_argument)
 
@@ -279,7 +279,7 @@ let extragenargtab =
   ref (Gmap.empty : (string,interp_genarg_type) Gmap.t)
 let add_interp_genarg id f =
   extragenargtab := Gmap.add id f !extragenargtab
-let lookup_genarg id = 
+let lookup_genarg id =
   try Gmap.find id !extragenargtab
   with Not_found -> failwith ("No interpretation function found for entry "^id)
 
@@ -300,7 +300,7 @@ let propagate_trace ist loc id = function
 (* Dynamically check that an argument is a tactic *)
 let coerce_to_tactic loc id = function
   | VFun _ | VRTactic _ as a -> a
-  | _ -> user_err_loc 
+  | _ -> user_err_loc
   (loc, "", str "Variable " ++ pr_id id ++ str " should be bound to a tactic.")
 
 (*****************)
@@ -309,8 +309,8 @@ let coerce_to_tactic loc id = function
 
 (* We have identifier <| global_reference <| constr *)
 
-let find_ident id ist = 
-  List.mem id (fst ist.ltacvars) or 
+let find_ident id ist =
+  List.mem id (fst ist.ltacvars) or
   List.mem id (ids_of_named_context (Environ.named_context ist.genv))
 
 let find_recvar qid ist = List.assoc qid ist.ltacrecvars
@@ -344,7 +344,7 @@ let vars_of_ist (lfun,_,_,env) =
 
 let get_current_context () =
     try Pfedit.get_current_goal_context ()
-    with e when Logic.catchable_exception e -> 
+    with e when Logic.catchable_exception e ->
       (Evd.empty, Global.env())
 
 let strict_check = ref false
@@ -374,10 +374,10 @@ let intern_inductive ist = function
 
 let intern_global_reference ist = function
   | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
-  | r -> 
+  | r ->
       let loc,_ as lqid = qualid_of_reference r in
       try ArgArg (loc,locate_global_with_alias lqid)
-      with Not_found -> 
+      with Not_found ->
 	error_global_not_found_loc lqid
 
 let intern_ltac_variable ist = function
@@ -485,16 +485,16 @@ let intern_quantified_hypothesis ist = function
   | NamedHyp id ->
       (* Uncomment to disallow "intros until n" in ltac when n is not bound *)
       NamedHyp ((*snd (intern_hyp ist (dloc,*)id(* ))*))
-      
+
 let intern_binding_name ist x =
   (* We use identifier both for variables and binding names *)
-  (* Todo: consider the body of the lemma to which the binding refer 
+  (* Todo: consider the body of the lemma to which the binding refer
      and if a term w/o ltac vars, check the name is indeed quantified *)
   x
 
 let intern_constr_gen isarity {ltacvars=lfun; gsigma=sigma; genv=env} c =
   let warn = if !strict_check then fun x -> x else Constrintern.for_grammar in
-  let c' = 
+  let c' =
     warn (Constrintern.intern_gen isarity ~ltacvars:(fst lfun,[]) sigma env) c
   in
   (c',if !strict_check then None else Some c)
@@ -541,7 +541,7 @@ let intern_evaluable_global_reference ist r =
   let lqid = qualid_of_reference r in
   try evaluable_of_global_reference ist.genv (locate_global_with_alias lqid)
   with Not_found ->
-  match r with 
+  match r with
   | Ident (loc,id) when not !strict_check -> EvalVarRef id
   | _ -> error_global_not_found_loc lqid
 
@@ -578,7 +578,7 @@ let intern_red_expr ist = function
   | Pattern l -> Pattern (List.map (intern_constr_with_occurrences ist) l)
   | Simpl o -> Simpl (Option.map (intern_constr_with_occurrences ist) o)
   | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r ) -> r
-  
+
 let intern_in_hyp_as ist lf (id,ipat) =
   (intern_hyp_or_metaid ist id, Option.map (intern_intro_pattern lf ist) ipat)
 
@@ -660,7 +660,7 @@ let rec intern_match_goal_hyps sigma env lfun = function
 
 (* Utilities *)
 let extract_let_names lrc =
-  List.fold_right 
+  List.fold_right
     (fun ((loc,name),_) l ->
       if List.mem name l then
 	user_err_loc
@@ -676,7 +676,7 @@ let clause_app f = function
 
 (* Globalizes tactics : raw_tactic_expr -> glob_tactic_expr *)
 let rec intern_atomic lf ist x =
-  match (x:raw_atomic_tactic_expr) with 
+  match (x:raw_atomic_tactic_expr) with
   (* Basic tactics *)
   | TacIntroPattern l ->
       TacIntroPattern (List.map (intern_intro_pattern lf ist) l)
@@ -759,12 +759,12 @@ let rec intern_atomic lf ist x =
   | TacClearBody l -> TacClearBody (List.map (intern_hyp_or_metaid ist) l)
   | TacMove (dep,id1,id2) ->
     TacMove (dep,intern_hyp_or_metaid ist id1,intern_move_location ist id2)
-  | TacRename l -> 
-      TacRename (List.map (fun (id1,id2) -> 
-			     intern_hyp_or_metaid ist id1, 
+  | TacRename l ->
+      TacRename (List.map (fun (id1,id2) ->
+			     intern_hyp_or_metaid ist id1,
 			     intern_hyp_or_metaid ist id2) l)
   | TacRevert l -> TacRevert (List.map (intern_hyp_or_metaid ist) l)
-	
+
   (* Constructors *)
   | TacLeft (ev,bl) -> TacLeft (ev,intern_bindings ist bl)
   | TacRight (ev,bl) -> TacRight (ev,intern_bindings ist bl)
@@ -785,14 +785,14 @@ let rec intern_atomic lf ist x =
 
   (* Equivalence relations *)
   | TacReflexivity -> TacReflexivity
-  | TacSymmetry idopt -> 
+  | TacSymmetry idopt ->
       TacSymmetry (clause_app (intern_hyp_location ist) idopt)
   | TacTransitivity c -> TacTransitivity (Option.map (intern_constr ist) c)
 
   (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) -> 
-      TacRewrite 
-	(ev, 
+  | TacRewrite (ev,l,cl,by) ->
+      TacRewrite
+	(ev,
 	List.map (fun (b,m,c) -> (b,m,intern_constr_with_bindings ist c)) l,
 	clause_app (intern_hyp_location ist) cl,
 	Option.map (intern_tactic ist) by)
@@ -819,7 +819,7 @@ and intern_tactic_seq ist = function
   | TacLetIn (isrec,l,u) ->
       let (l1,l2) = ist.ltacvars in
       let ist' = { ist with ltacvars = (extract_let_names l @ l1, l2) } in
-      let l = List.map (fun (n,b) -> 
+      let l = List.map (fun (n,b) ->
 	  (n,intern_tacarg !strict_check (if isrec then ist' else ist) b)) l in
       ist.ltacvars, TacLetIn (isrec,l,intern_tactic ist' u)
   | TacMatchGoal (lz,lr,lmr) ->
@@ -827,7 +827,7 @@ and intern_tactic_seq ist = function
   | TacMatch (lz,c,lmr) ->
       ist.ltacvars, TacMatch (lz,intern_tactic ist c,intern_match_rule ist lmr)
   | TacId l -> ist.ltacvars, TacId (intern_message ist l)
-  | TacFail (n,l) -> 
+  | TacFail (n,l) ->
       ist.ltacvars, TacFail (intern_or_var ist n,intern_message ist l)
   | TacProgress tac -> ist.ltacvars, TacProgress (intern_tactic ist tac)
   | TacAbstract (tac,s) -> ist.ltacvars, TacAbstract (intern_tactic ist tac,s)
@@ -846,7 +846,7 @@ and intern_tactic_seq ist = function
       let ist' = { ist with ltacvars = lfun' } in
       (* Que faire en cas de (tac complexe avec Match et Thens; tac2) ?? *)
       lfun', TacThens (t, List.map (intern_tactic ist') tl)
-  | TacDo (n,tac) -> 
+  | TacDo (n,tac) ->
       ist.ltacvars, TacDo (intern_or_var ist n,intern_tactic ist tac)
   | TacTry tac -> ist.ltacvars, TacTry (intern_tactic ist tac)
   | TacInfo tac -> ist.ltacvars, TacInfo (intern_tactic ist tac)
@@ -858,7 +858,7 @@ and intern_tactic_seq ist = function
   | TacComplete tac -> ist.ltacvars, TacComplete (intern_tactic ist tac)
   | TacArg a -> ist.ltacvars, TacArg (intern_tacarg true ist a)
 
-and intern_tactic_fun ist (var,body) = 
+and intern_tactic_fun ist (var,body) =
   let (l1,l2) = ist.ltacvars in
   let lfun' = List.rev_append (Option.List.flatten var) l1 in
   (var,intern_tactic { ist with ltacvars = (lfun',l2) } body)
@@ -866,7 +866,7 @@ and intern_tactic_fun ist (var,body) =
 and intern_tacarg strict ist = function
   | TacVoid -> TacVoid
   | Reference r -> intern_non_tactic_reference strict ist r
-  | IntroPattern ipat -> 
+  | IntroPattern ipat ->
       let lf = ref([],[]) in (*How to know what names the intropattern binds?*)
       IntroPattern (intern_intro_pattern lf ist ipat)
   | Integer n -> Integer n
@@ -883,7 +883,7 @@ and intern_tacarg strict ist = function
       TacCall (loc,
         intern_applied_tactic_reference ist f,
         List.map (intern_tacarg !strict_check ist) l)
-  | TacExternal (loc,com,req,la) -> 
+  | TacExternal (loc,com,req,la) ->
       TacExternal (loc,com,req,List.map (intern_tacarg !strict_check ist) la)
   | TacFreshId x -> TacFreshId (List.map (intern_or_var ist) x)
   | Tacexp t -> Tacexp (intern_tactic ist t)
@@ -924,7 +924,7 @@ and intern_genarg ist x =
         (intern_intro_pattern lf ist (out_gen rawwit_intro_pattern x))
   | IdentArgType b ->
       let lf = ref ([],[]) in
-      in_gen (globwit_ident_gen b) 
+      in_gen (globwit_ident_gen b)
 	(intern_ident lf ist (out_gen (rawwit_ident_gen b) x))
   | VarArgType ->
       in_gen globwit_var (intern_hyp ist (out_gen rawwit_var x))
@@ -935,7 +935,7 @@ and intern_genarg ist x =
   | ConstrArgType ->
       in_gen globwit_constr (intern_constr ist (out_gen rawwit_constr x))
   | ConstrMayEvalArgType ->
-      in_gen globwit_constr_may_eval 
+      in_gen globwit_constr_may_eval
         (intern_constr_may_eval ist (out_gen rawwit_constr_may_eval x))
   | QuantHypArgType ->
       in_gen globwit_quant_hyp
@@ -957,7 +957,7 @@ and intern_genarg ist x =
   | PairArgType _ -> app_pair (intern_genarg ist) (intern_genarg ist) x
   | ExtraArgType s ->
       match tactic_genarg_level s with
-      | Some n -> 
+      | Some n ->
           (* Special treatment of tactic arguments *)
           in_gen (globwit_tactic n) (intern_tactic ist
 	    (out_gen (rawwit_tactic n) x))
@@ -989,7 +989,7 @@ let give_context ctxt = function
   | Some id -> [id,VConstr_context ctxt]
 
 (* Reads a pattern by substituting vars of lfun *)
-let eval_pattern lfun c = 
+let eval_pattern lfun c =
   let lvar = List.map (fun (id,c) -> (id,lazy(pattern_of_constr c))) lfun in
   instantiate_pattern lvar c
 
@@ -1062,7 +1062,7 @@ let apply_one_mhyp_context ist env gl lmatch (hypname,patv,pat) lhyps =
     | Subterm (b,ic,t) ->
         let rec match_next_pattern find_next () =
           let (lmeta,ctxt,find_next') = find_next () in
-          try 
+          try
             let lmeta = verify_metas_coherence gl lmatch lmeta in
             (give_context ctxt ic,lmeta,match_next_pattern find_next')
           with
@@ -1075,30 +1075,30 @@ let apply_one_mhyp_context ist env gl lmatch (hypname,patv,pat) lhyps =
             let rec match_next_pattern find_next () =
               try
                 let (ids, lmeta, find_next') = find_next () in
-		(get_id_couple id hypname@ids, lmeta, hd, 
+		(get_id_couple id hypname@ids, lmeta, hd,
                  match_next_pattern find_next')
               with
                 | PatternMatchingFailure -> apply_one_mhyp_context_rec tl in
             match_next_pattern (fun () -> match_pat lmatch hyp pat) ()
-	| Some patv -> 
+	| Some patv ->
 	    match b with
-	    | Some body -> 
+	    | Some body ->
                 let rec match_next_pattern_in_body next_in_body () =
                   try
                     let (ids,lmeta,next_in_body') = next_in_body() in
                     let rec match_next_pattern_in_typ next_in_typ () =
                       try
                         let (ids',lmeta',next_in_typ') = next_in_typ() in
-		        (get_id_couple id hypname@ids@ids', lmeta', hd, 
+		        (get_id_couple id hypname@ids@ids', lmeta', hd,
                          match_next_pattern_in_typ next_in_typ')
                       with
                         | PatternMatchingFailure ->
                             match_next_pattern_in_body next_in_body' () in
-                    match_next_pattern_in_typ 
+                    match_next_pattern_in_typ
                       (fun () -> match_pat lmeta hyp pat) ()
                   with PatternMatchingFailure -> apply_one_mhyp_context_rec tl
                 in
-                match_next_pattern_in_body 
+                match_next_pattern_in_body
                   (fun () -> match_pat lmatch body patv) ()
             | None -> apply_one_mhyp_context_rec tl)
     | [] ->
@@ -1137,12 +1137,12 @@ let debugging_exception_step ist signal_anomaly e pp =
   let explain_exc =
     if signal_anomaly then explain_logic_error
     else explain_logic_error_no_anomaly in
-  debugging_step ist (fun () -> 
+  debugging_step ist (fun () ->
     pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ !explain_exc e)
 
 let error_ltac_variable loc id env v s =
-   user_err_loc (loc, "", str "Ltac variable " ++ pr_id id ++ 
-   strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++ 
+   user_err_loc (loc, "", str "Ltac variable " ++ pr_id id ++
+   strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++
    strbrk "which cannot be coerced to " ++ str s ++ str".")
 
 exception CannotCoerceTo of string
@@ -1169,7 +1169,7 @@ let interp_ident_gen fresh ist gl id =
   try try_interp_ltac_var (coerce_to_ident fresh env) ist (Some env) (dloc,id)
   with Not_found -> id
 
-let interp_ident = interp_ident_gen false 
+let interp_ident = interp_ident_gen false
 let interp_fresh_ident = interp_ident_gen true
 
 (* Interprets an optional identifier which must be fresh *)
@@ -1216,7 +1216,7 @@ let int_or_var_list_of_VList = function
   | _ -> raise Not_found
 
 let interp_int_or_var_as_list ist = function
-  | ArgVar (_,id as locid) -> 
+  | ArgVar (_,id as locid) ->
       (try int_or_var_list_of_VList (List.assoc id ist.lfun)
        with Not_found | CannotCoerceTo _ -> [ArgArg (interp_int ist locid)])
   | ArgArg n as x -> [x]
@@ -1239,7 +1239,7 @@ let interp_hyp ist gl (loc,id as locid) =
   let env = pf_env gl in
   (* Look first in lfun for a value coercible to a variable *)
   try try_interp_ltac_var (coerce_to_hyp env) ist (Some env) locid
-  with Not_found -> 
+  with Not_found ->
   (* Then look if bound in the proof context at calling time *)
   if is_variable env id then id
   else user_err_loc (loc,"eval_variable",pr_id id ++ str " not found.")
@@ -1279,7 +1279,7 @@ let coerce_to_reference env v =
 
 let interp_reference ist env = function
   | ArgArg (_,r) -> r
-  | ArgVar locid -> 
+  | ArgVar locid ->
       interp_ltac_var (coerce_to_reference env) ist (Some env) locid
 
 let pf_interp_reference ist gl = interp_reference ist (pf_env gl)
@@ -1296,7 +1296,7 @@ let coerce_to_evaluable_ref env v =
   let ev = match v with
     | VConstr c when isConst c -> EvalConstRef (destConst c)
     | VConstr c when isVar c -> EvalVarRef (destVar c)
-    | VIntroPattern (IntroIdentifier id) when List.mem id (ids_of_context env) 
+    | VIntroPattern (IntroIdentifier id) when List.mem id (ids_of_context env)
 	-> EvalVarRef id
     | _ -> raise (CannotCoerceTo "an evaluable reference")
   in
@@ -1316,7 +1316,7 @@ let interp_evaluable ist env = function
        | EvalConstRef _ -> r
        | _ -> Pretype_errors.error_var_not_found_loc loc id)
   | ArgArg (r,None) -> r
-  | ArgVar locid -> 
+  | ArgVar locid ->
       interp_ltac_var (coerce_to_evaluable_ref env) ist (Some env) locid
 
 (* Interprets an hypothesis name *)
@@ -1334,10 +1334,10 @@ let interp_clause ist gl { onhyps=ol; concl_occs=occs } =
 
 (* Extract the constr list from lfun *)
 let rec constr_list_aux env = function
-  | (id,v)::tl -> 
+  | (id,v)::tl ->
       let (l1,l2) = constr_list_aux env tl in
       (try ((id,constr_of_value env v)::l1,l2)
-       with Not_found -> 
+       with Not_found ->
 	 let ido = match v with
 	   | VIntroPattern (IntroIdentifier id0) -> Some id0
 	   | _ -> None in
@@ -1349,9 +1349,9 @@ let constr_list ist env = constr_list_aux env ist.lfun
 (* Extract the identifier list from lfun: join all branches (what to do else?)*)
 let rec intropattern_ids (loc,pat) = match pat with
   | IntroIdentifier id -> [id]
-  | IntroOrAndPattern ll -> 
+  | IntroOrAndPattern ll ->
       List.flatten (List.map intropattern_ids (List.flatten ll))
-  | IntroWildcard | IntroAnonymous | IntroFresh _ | IntroRewrite _ 
+  | IntroWildcard | IntroAnonymous | IntroFresh _ | IntroRewrite _
   | IntroForthcoming _ -> []
 
 let rec extract_ids ids = function
@@ -1365,8 +1365,8 @@ let default_fresh_id = id_of_string "H"
 let interp_fresh_id ist gl l =
   let ids = map_succeed (function ArgVar(_,id) -> id | _ -> failwith "") l in
   let avoid = (extract_ids ids ist.lfun) @ ist.avoid_ids in
-  let id = 
-    if l = [] then default_fresh_id 
+  let id =
+    if l = [] then default_fresh_id
     else
       let s =
 	String.concat "" (List.map (function
@@ -1396,11 +1396,11 @@ let declare_implicit_tactic tac = implicit_tactic := Some tac
 
 open Evd
 
-let solvable_by_tactic env evi (ev,args) src = 
+let solvable_by_tactic env evi (ev,args) src =
   match (!implicit_tactic, src) with
   | Some tac, (ImplicitArg _ | QuestionMark _)
-      when 
-	Environ.named_context_of_val evi.evar_hyps = 
+      when
+	Environ.named_context_of_val evi.evar_hyps =
 	Environ.named_context env ->
       let id = id_of_string "H" in
       start_proof id (Local,Proof Lemma) evi.evar_hyps evi.evar_concl
@@ -1408,9 +1408,9 @@ let solvable_by_tactic env evi (ev,args) src =
       begin
 	try
 	  by (tclCOMPLETE tac);
-	  let _,(const,_,_,_) = cook_proof ignore in 
+	  let _,(const,_,_,_) = cook_proof ignore in
 	  delete_current_proof (); const.const_entry_body
-	with e when Logic.catchable_exception e -> 
+	with e when Logic.catchable_exception e ->
 	  delete_current_proof();
 	  raise Exit
       end
@@ -1424,13 +1424,13 @@ let solve_remaining_evars env initial_sigma evd c =
             let (loc,src) = evar_source ev !evdref in
 	    let sigma =  !evdref in
 	    let evi = Evd.find sigma ev in
-	    (try 
+	    (try
 	      let c = solvable_by_tactic env evi k src in
 	      evdref := Evd.define ev c !evdref;
 	      c
 	    with Exit ->
 	      Pretype_errors.error_unsolvable_implicit loc env sigma evi src None)
-      | _ -> map_constr proc_rec c      
+      | _ -> map_constr proc_rec c
   in
   proc_rec (Evarutil.nf_isevar !evdref c)
 
@@ -1524,7 +1524,7 @@ let pf_interp_open_constr_list =
 let pf_interp_open_constr_list_as_list ist gl (c,_ as x) =
   match c with
     | RVar (_,id) ->
-        (try List.map inj_open 
+        (try List.map inj_open
 	       (constr_list_of_VList (pf_env gl) (List.assoc id ist.lfun))
         with Not_found ->
 	  [interp_open_constr None ist (project gl) (pf_env gl) x])
@@ -1546,16 +1546,16 @@ let interp_unfold ist env (occs,qid) =
 let interp_flag ist env red =
   { red with rConst = List.map (interp_evaluable ist env) red.rConst }
 
-let interp_pattern ist sigma env (occs,c) = 
+let interp_pattern ist sigma env (occs,c) =
   (interp_occurrences ist occs, interp_constr ist sigma env c)
 
 let pf_interp_constr_with_occurrences ist gl =
   interp_pattern ist (project gl) (pf_env gl)
 
-let pf_interp_constr_with_occurrences_and_name_as_list = 
+let pf_interp_constr_with_occurrences_and_name_as_list =
   pf_interp_constr_in_compound_list
     (fun c -> ((all_occurrences_expr,c),Anonymous))
-    (function ((occs,c),Anonymous) when occs = all_occurrences_expr -> c 
+    (function ((occs,c),Anonymous) when occs = all_occurrences_expr -> c
       | _ -> raise Not_found)
     (fun ist gl (occ_c,na) ->
       (interp_pattern ist (project gl) (pf_env gl) occ_c,
@@ -1586,17 +1586,17 @@ let interp_may_eval f ist gl = function
 	    user_err_loc (loc, "interp_may_eval",
 	    str "Unbound context identifier" ++ pr_id s ++ str"."))
   | ConstrTypeOf c -> pf_type_of gl (f ist gl c)
-  | ConstrTerm c -> 
-     try 
+  | ConstrTerm c ->
+     try
 	f ist gl c
      with e ->
        debugging_exception_step ist false e (fun () ->
          str"interpretation of term " ++ pr_rawconstr_env (pf_env gl) (fst c));
-       raise e  
+       raise e
 
 (* Interprets a constr expression possibly to first evaluate *)
 let interp_constr_may_eval ist gl c =
-  let csr = 
+  let csr =
     try
       interp_may_eval pf_interp_constr ist gl c
     with e ->
@@ -1636,7 +1636,7 @@ let rec interp_message_nl ist = function
   | l -> prlist_with_sep spc (interp_message_token ist) l ++ fnl()
 
 let interp_message ist l =
-  (* Force evaluation of interp_message_token so that potential errors 
+  (* Force evaluation of interp_message_token so that potential errors
      are raised now and not at printing time *)
   prlist (fun x -> spc () ++ x) (List.map (interp_message_token ist) l)
 
@@ -1693,16 +1693,16 @@ let interp_binding_name ist = function
 (* (as in Inversion) *)
 let coerce_to_decl_or_quant_hyp env = function
   | VInteger n -> AnonHyp n
-  | v -> 
+  | v ->
       try NamedHyp (coerce_to_hyp env v)
-      with CannotCoerceTo _ -> 
+      with CannotCoerceTo _ ->
 	raise (CannotCoerceTo "a declared or quantified hypothesis")
 
 let interp_declared_or_quantified_hypothesis ist gl = function
   | AnonHyp n -> AnonHyp n
   | NamedHyp id ->
       let env = pf_env gl in
-      try try_interp_ltac_var 
+      try try_interp_ltac_var
 	    (coerce_to_decl_or_quant_hyp env) ist (Some env) (dloc,id)
       with Not_found -> NamedHyp id
 
@@ -1762,13 +1762,13 @@ let rec val_interp ist gl (tac:glob_tactic_expr) =
   | TacFun (it,body) -> VFun (ist.trace,ist.lfun,it,body)
   | TacLetIn (true,l,u) -> interp_letrec ist gl l u
   | TacLetIn (false,l,u) -> interp_letin ist gl l u
-  | TacMatchGoal (lz,lr,lmr) -> interp_match_goal ist gl lz lr lmr 
+  | TacMatchGoal (lz,lr,lmr) -> interp_match_goal ist gl lz lr lmr
   | TacMatch (lz,c,lmr) -> interp_match ist gl lz c lmr
   | TacArg a -> interp_tacarg ist gl a
   (* Delayed evaluation *)
   | t -> VFun (ist.trace,ist.lfun,[],t)
 
-  in check_for_interrupt (); 
+  in check_for_interrupt ();
     match ist.debug with
     | DebugOn lev ->
 	debug_prompt lev gl tac (fun v -> value_interp {ist with debug=v})
@@ -1792,15 +1792,15 @@ and eval_tactic ist = function
   | TacAbstract (tac,ido) ->
       fun gl -> Tactics.tclABSTRACT
         (Option.map (interp_ident ist gl) ido) (interp_tactic ist tac) gl
-  | TacThen (t1,tf,t,tl) -> 
+  | TacThen (t1,tf,t,tl) ->
       tclTHENS3PARTS (interp_tactic ist t1)
 	(Array.map (interp_tactic ist) tf) (interp_tactic ist t) (Array.map (interp_tactic ist) tl)
   | TacThens (t1,tl) -> tclTHENS (interp_tactic ist t1) (List.map (interp_tactic ist) tl)
   | TacDo (n,tac) -> tclDO (interp_int_or_var ist n) (interp_tactic ist tac)
   | TacTry tac -> tclTRY (interp_tactic ist tac)
-  | TacInfo tac -> 
+  | TacInfo tac ->
       let t = (interp_tactic ist tac) in
-	tclINFO 
+	tclINFO
 	  begin
 	    match tac with
 		TacAtom (_,_) -> t
@@ -1827,7 +1827,7 @@ and interp_ltac_reference loc' mustbetac ist gl = function
   | ArgArg (loc,r) ->
       let ids = extract_ids [] ist.lfun in
       let loc_info = ((if loc' = dloc then loc else loc'),LtacNameCall r) in
-      let ist = 
+      let ist =
         { lfun=[]; debug=ist.debug; avoid_ids=ids;
           trace = push_trace loc_info ist.trace } in
       val_interp ist gl (lookup r)
@@ -1847,7 +1847,7 @@ and interp_tacarg ist gl = function
       interp_app loc ist gl fv largs
   | TacExternal (loc,com,req,la) ->
       interp_external loc ist gl com req (List.map (interp_tacarg ist gl) la)
-  | TacFreshId l -> 
+  | TacFreshId l ->
       let id = interp_fresh_id ist gl l in
       VIntroPattern (IntroIdentifier id)
   | Tacexp t -> val_interp ist gl t
@@ -1875,7 +1875,7 @@ and interp_app loc ist gl fv largs =
          (TacFun _|TacLetIn _|TacMatchGoal _|TacMatch _| TacArg _ as body))) ->
 	let (newlfun,lvar,lval)=head_with_value (var,largs) in
 	if lvar=[] then
-	  let v = 
+	  let v =
 	    try
 	      catch_error trace
 		(val_interp {ist with lfun=newlfun@olfun; trace=trace} gl) body
@@ -1916,7 +1916,7 @@ and eval_with_fail ist is_lazy goal tac =
 	VRTactic (catch_error trace tac goal)
     | a -> a)
   with
-    | FailError (0,s) | Stdpp.Exc_located(_, FailError (0,s)) 
+    | FailError (0,s) | Stdpp.Exc_located(_, FailError (0,s))
     | Stdpp.Exc_located(_,LtacLocated (_,FailError (0,s))) ->
 	raise (Eval_fail (Lazy.force s))
     | FailError (lvl,s) -> raise (FailError (lvl - 1, s))
@@ -1953,7 +1953,7 @@ and interp_match_goal ist goal lz lr lmr =
       try apply_hyps_context ist env lz goal mt lctxt lgoal mhyps hyps
       with e when is_match_catchable e -> match_next_pattern find_next' () in
     match_next_pattern (fun () -> match_subterm_gen app c csr) () in
-  let rec apply_match_goal ist env goal nrs lex lpt = 
+  let rec apply_match_goal ist env goal nrs lex lpt =
     begin
       if lex<>[] then db_pattern_rule ist.debug nrs (List.hd lex);
       match lpt with
@@ -2009,7 +2009,7 @@ and apply_hyps_context ist env lz goal mt lctxt lgmatch mhyps hyps =
             let id_match = pi1 hyp_match in
             let nextlhyps = list_remove_assoc_in_triple id_match lhyps_rest in
             apply_hyps_context_rec (lfun@lids) lm nextlhyps tl
-          with e when is_match_catchable e -> 
+          with e when is_match_catchable e ->
 	    match_next_pattern find_next' in
         let init_match_pattern () =
           apply_one_mhyp_context ist env goal lmatch hyp_pat lhyps_rest in
@@ -2050,8 +2050,8 @@ and interp_genarg ist gl x =
       in_gen wit_ref (pf_interp_reference ist gl (out_gen globwit_ref x))
   | SortArgType ->
       in_gen wit_sort
-        (destSort 
-	  (pf_interp_constr ist gl 
+        (destSort
+	  (pf_interp_constr ist gl
 	    (RSort (dloc,out_gen globwit_sort x), None)))
   | ConstrArgType ->
       in_gen wit_constr (pf_interp_constr ist gl (out_gen globwit_constr x))
@@ -2064,8 +2064,8 @@ and interp_genarg ist gl x =
   | RedExprArgType ->
       in_gen wit_red_expr (pf_interp_red_expr ist gl (out_gen globwit_red_expr x))
   | OpenConstrArgType casted ->
-      in_gen (wit_open_constr_gen casted) 
-        (pf_interp_open_constr casted ist gl 
+      in_gen (wit_open_constr_gen casted)
+        (pf_interp_open_constr casted ist gl
           (snd (out_gen (globwit_open_constr_gen casted) x)))
   | ConstrWithBindingsArgType ->
       in_gen wit_constr_with_bindings
@@ -2081,14 +2081,14 @@ and interp_genarg ist gl x =
   | List1ArgType _ -> app_list1 (interp_genarg ist gl) x
   | OptArgType _ -> app_opt (interp_genarg ist gl) x
   | PairArgType _ -> app_pair (interp_genarg ist gl) (interp_genarg ist gl) x
-  | ExtraArgType s -> 
+  | ExtraArgType s ->
       match tactic_genarg_level s with
-      | Some n -> 
+      | Some n ->
           (* Special treatment of tactic arguments *)
           in_gen (wit_tactic n)
 	    (TacArg(valueIn(VFun(ist.trace,ist.lfun,[],
 				 out_gen (globwit_tactic n) x))))
-      | None -> 
+      | None ->
           lookup_interp_genarg s ist gl x
 
 and interp_genarg_constr_list0 ist gl x =
@@ -2128,7 +2128,7 @@ and interp_match ist g lz constr lmr =
          with e when is_match_catchable e -> apply_match ist csr [])
     | (Pat ([],Term c,mt))::tl ->
         (try
-            let lmatch = 
+            let lmatch =
               try extended_matches c csr
               with e ->
                 debugging_exception_step ist false e (fun () ->
@@ -2153,14 +2153,14 @@ and interp_match ist g lz constr lmr =
     | _ ->
       errorlabstrm "Tacinterp.apply_match" (str
         "No matching clauses for match.") in
-  let csr = 
+  let csr =
       try interp_ltac_constr ist g constr with e ->
         debugging_exception_step ist true e
           (fun () -> str "evaluation of the matched expression");
         raise e in
   let ilr = read_match_rule (fst (constr_list ist (pf_env g))) lmr in
-  let res = 
-     try apply_match ist csr ilr with e -> 
+  let res =
+     try apply_match ist csr ilr with e ->
        debugging_exception_step ist true e (fun () -> str "match expression");
        raise e in
   debugging_step ist (fun () ->
@@ -2169,8 +2169,8 @@ and interp_match ist g lz constr lmr =
 
 (* Interprets tactic expressions : returns a "constr" *)
 and interp_ltac_constr ist gl e =
-  let result = 
-  try val_interp ist gl e with Not_found -> 
+  let result =
+  try val_interp ist gl e with Not_found ->
     debugging_step ist (fun () ->
       str "evaluation failed for" ++ fnl() ++
       Pptactic.pr_glob_tactic (pf_env gl) e);
@@ -2183,7 +2183,7 @@ and interp_ltac_constr ist gl e =
     cresult
   with Not_found ->
     errorlabstrm ""
-      (str "Must evaluate to a term" ++ fnl() ++ 
+      (str "Must evaluate to a term" ++ fnl() ++
 	  str "offending expression: " ++ fnl() ++
           Pptactic.pr_glob_tactic (pf_env gl) e ++ fnl() ++ str "this is a " ++
           (match result with
@@ -2192,7 +2192,7 @@ and interp_ltac_constr ist gl e =
                 (str "VFun with body " ++ fnl() ++
                     Pptactic.pr_glob_tactic (pf_env gl) b ++ fnl() ++
 		    str "instantiated arguments " ++ fnl() ++
-                    List.fold_right 
+                    List.fold_right
                     (fun p s ->
                       let (i,v) = p in str (string_of_id i) ++ str ", " ++ s)
                     il (str "") ++
@@ -2263,7 +2263,7 @@ and interp_atomic ist gl = function
       h_let_tac b (interp_fresh_name ist gl na) (pf_interp_constr ist gl c) clp
 
   (* Automation tactics *)
-  | TacTrivial (lems,l) -> 
+  | TacTrivial (lems,l) ->
       Auto.h_trivial (pf_interp_constr_list ist gl lems)
 	(Option.map (List.map (interp_hint_base ist)) l)
   | TacAuto (n,lems,l) ->
@@ -2308,8 +2308,8 @@ and interp_atomic ist gl = function
   | TacMove (dep,id1,id2) ->
       h_move dep (interp_hyp ist gl id1) (interp_move_location ist gl id2)
   | TacRename l ->
-      h_rename (List.map (fun (id1,id2) -> 
-			    interp_hyp ist gl id1, 
+      h_rename (List.map (fun (id1,id2) ->
+			    interp_hyp ist gl id1,
 			    interp_fresh_ident ist gl (snd id2)) l)
   | TacRevert l -> h_revert (interp_hyp_list ist gl l)
 
@@ -2331,7 +2331,7 @@ and interp_atomic ist gl = function
         (if occl = None & (cl.onhyps = None or cl.onhyps = Some []) &
 	    (cl.concl_occs = all_occurrences_expr or
 	     cl.concl_occs = no_occurrences_expr)
-	 then pf_interp_type ist gl c 
+	 then pf_interp_type ist gl c
 	 else pf_interp_constr ist gl c)
         (interp_clause ist gl cl)
 
@@ -2341,7 +2341,7 @@ and interp_atomic ist gl = function
   | TacTransitivity c -> h_transitivity (Option.map (pf_interp_constr ist gl) c)
 
   (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) -> 
+  | TacRewrite (ev,l,cl,by) ->
       Equality.general_multi_multi_rewrite ev
 	(List.map (fun (b,m,c) -> (b,m,interp_open_constr_with_bindings ist gl c)) l)
 	(interp_clause ist gl cl)
@@ -2351,7 +2351,7 @@ and interp_atomic ist gl = function
         (Option.map (interp_intro_pattern ist gl) ids)
         (interp_declared_or_quantified_hypothesis ist gl hyp)
   | TacInversion (NonDepInversion (k,idl,ids),hyp) ->
-      Inv.inv_clause k 
+      Inv.inv_clause k
         (Option.map (interp_intro_pattern ist gl) ids)
         (interp_hyp_list ist gl idl)
         (interp_declared_or_quantified_hypothesis ist gl hyp)
@@ -2367,24 +2367,24 @@ and interp_atomic ist gl = function
       abstract_extended_tactic opn args (tac args)
   | TacAlias (loc,s,l,(_,body)) -> fun gl ->
     let rec f x = match genarg_tag x with
-    | IntArgType -> 
+    | IntArgType ->
         VInteger (out_gen globwit_int x)
     | IntOrVarArgType ->
         mk_int_or_var_value ist (out_gen globwit_int_or_var x)
     | PreIdentArgType ->
 	failwith "pre-identifiers cannot be bound"
     | IntroPatternArgType ->
-	VIntroPattern 
+	VIntroPattern
 	  (snd (interp_intro_pattern ist gl (out_gen globwit_intro_pattern x)))
     | IdentArgType b ->
 	value_of_ident (interp_fresh_ident ist gl
 	  (out_gen (globwit_ident_gen b) x))
     | VarArgType ->
         mk_hyp_value ist gl (out_gen globwit_var x)
-    | RefArgType -> 
-        VConstr (constr_of_global 
+    | RefArgType ->
+        VConstr (constr_of_global
           (pf_interp_reference ist gl (out_gen globwit_ref x)))
-    | SortArgType -> 
+    | SortArgType ->
         VConstr (mkSort (interp_sort (out_gen globwit_sort x)))
     | ConstrArgType ->
         mk_constr_value ist gl (out_gen globwit_constr x)
@@ -2393,68 +2393,68 @@ and interp_atomic ist gl = function
           (interp_constr_may_eval ist gl (out_gen globwit_constr_may_eval x))
     | ExtraArgType s when tactic_genarg_level s <> None ->
           (* Special treatment of tactic arguments *)
-	val_interp ist gl 
+	val_interp ist gl
           (out_gen (globwit_tactic (Option.get (tactic_genarg_level s))) x)
-    | List0ArgType ConstrArgType -> 
+    | List0ArgType ConstrArgType ->
         let wit = wit_list0 globwit_constr in
         VList (List.map (mk_constr_value ist gl) (out_gen wit x))
-    | List0ArgType VarArgType -> 
+    | List0ArgType VarArgType ->
         let wit = wit_list0 globwit_var in
         VList (List.map (mk_hyp_value ist gl) (out_gen wit x))
-    | List0ArgType IntArgType -> 
+    | List0ArgType IntArgType ->
         let wit = wit_list0 globwit_int in
         VList (List.map (fun x -> VInteger x) (out_gen wit x))
-    | List0ArgType IntOrVarArgType -> 
+    | List0ArgType IntOrVarArgType ->
         let wit = wit_list0 globwit_int_or_var in
         VList (List.map (mk_int_or_var_value ist) (out_gen wit x))
-    | List0ArgType (IdentArgType b) -> 
+    | List0ArgType (IdentArgType b) ->
         let wit = wit_list0 (globwit_ident_gen b) in
 	let mk_ident x = value_of_ident (interp_fresh_ident ist gl x) in
         VList (List.map mk_ident (out_gen wit x))
-    | List0ArgType IntroPatternArgType -> 
+    | List0ArgType IntroPatternArgType ->
         let wit = wit_list0 globwit_intro_pattern in
 	let mk_ipat x = VIntroPattern (snd (interp_intro_pattern ist gl x)) in
         VList (List.map mk_ipat (out_gen wit x))
-    | List1ArgType ConstrArgType -> 
+    | List1ArgType ConstrArgType ->
         let wit = wit_list1 globwit_constr in
         VList (List.map (mk_constr_value ist gl) (out_gen wit x))
-    | List1ArgType VarArgType -> 
+    | List1ArgType VarArgType ->
         let wit = wit_list1 globwit_var in
         VList (List.map (mk_hyp_value ist gl) (out_gen wit x))
-    | List1ArgType IntArgType -> 
+    | List1ArgType IntArgType ->
         let wit = wit_list1 globwit_int in
         VList (List.map (fun x -> VInteger x) (out_gen wit x))
-    | List1ArgType IntOrVarArgType -> 
+    | List1ArgType IntOrVarArgType ->
         let wit = wit_list1 globwit_int_or_var in
         VList (List.map (mk_int_or_var_value ist) (out_gen wit x))
-    | List1ArgType (IdentArgType b) -> 
+    | List1ArgType (IdentArgType b) ->
         let wit = wit_list1 (globwit_ident_gen b) in
 	let mk_ident x = value_of_ident (interp_fresh_ident ist gl x) in
         VList (List.map mk_ident (out_gen wit x))
-    | List1ArgType IntroPatternArgType -> 
+    | List1ArgType IntroPatternArgType ->
         let wit = wit_list1 globwit_intro_pattern in
 	let mk_ipat x = VIntroPattern (snd (interp_intro_pattern ist gl x)) in
         VList (List.map mk_ipat (out_gen wit x))
     | StringArgType | BoolArgType
-    | QuantHypArgType | RedExprArgType 
-    | OpenConstrArgType _ | ConstrWithBindingsArgType 
-    | ExtraArgType _ | BindingsArgType 
-    | OptArgType _ | PairArgType _ 
-    | List0ArgType _ | List1ArgType _ 
+    | QuantHypArgType | RedExprArgType
+    | OpenConstrArgType _ | ConstrWithBindingsArgType
+    | ExtraArgType _ | BindingsArgType
+    | OptArgType _ | PairArgType _
+    | List0ArgType _ | List1ArgType _
 	-> error "This generic type is not supported in alias."
-        
+
     in
     let lfun = (List.map (fun (x,c) -> (x,f c)) l)@ist.lfun in
     let trace = push_trace (loc,LtacNotationCall s) ist.trace in
     interp_tactic { ist with lfun=lfun; trace=trace } body gl
 
 let make_empty_glob_sign () =
-  { ltacvars = ([],[]); ltacrecvars = []; 
+  { ltacvars = ([],[]); ltacrecvars = [];
     gsigma = Evd.empty; genv = Global.env() }
 
 (* Initial call for interpretation *)
-let interp_tac_gen lfun avoid_ids debug t gl = 
-  interp_tactic { lfun=lfun; avoid_ids=avoid_ids; debug=debug; trace=[] } 
+let interp_tac_gen lfun avoid_ids debug t gl =
+  interp_tactic { lfun=lfun; avoid_ids=avoid_ids; debug=debug; trace=[] }
     (intern_tactic {
       ltacvars = (List.map fst lfun, []); ltacrecvars = [];
       gsigma = project gl; genv = pf_env gl } t) gl
@@ -2466,17 +2466,17 @@ let eval_tactic t gls =
 let interp t = interp_tac_gen [] [] (get_debug()) t
 
 let eval_ltac_constr gl t =
-  interp_ltac_constr 
+  interp_ltac_constr
     { lfun=[]; avoid_ids=[]; debug=get_debug(); trace=[] } gl
     (intern_tactic (make_empty_glob_sign ()) t )
 
 (* Hides interpretation for pretty-print *)
 let hide_interp t ot gl =
-  let ist = { ltacvars = ([],[]); ltacrecvars = []; 
+  let ist = { ltacvars = ([],[]); ltacrecvars = [];
             gsigma = project gl; genv = pf_env gl } in
   let te = intern_tactic ist t in
   let t = eval_tactic te in
-  match ot with 
+  match ot with
   | None -> abstract_tactic_expr (TacArg (Tacexp te)) t gl
   | Some t' ->
       abstract_tactic_expr ~dflt:true (TacArg (Tacexp te)) (tclTHEN t t') gl
@@ -2520,13 +2520,13 @@ let subst_or_var f =  function
 
 let subst_located f (_loc,id) = (dloc,f id)
 
-let subst_reference subst = 
+let subst_reference subst =
   subst_or_var (subst_located (subst_kn subst))
 
 (*CSC: subst_global_reference is used "only" for RefArgType, that propagates
   to the syntactic non-terminals "global", used in commands such as
-  Print. It is also used for non-evaluable references. *) 
-let subst_global_reference subst = 
+  Print. It is also used for non-evaluable references. *)
+let subst_global_reference subst =
  let subst_global ref =
   let ref',t' = subst_global subst ref in
    if not (eq_constr (constr_of_global ref') t') then
@@ -2541,7 +2541,7 @@ let subst_evaluable subst =
   let subst_eval_ref = subst_evaluable_reference subst in
     subst_or_var (subst_and_short_name subst_eval_ref)
 
-let subst_unfold subst (l,e) = 
+let subst_unfold subst (l,e) =
   (l,subst_evaluable subst e)
 
 let subst_flag subst red =
@@ -2655,8 +2655,8 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   | TacTransitivity c -> TacTransitivity (Option.map (subst_rawconstr subst) c)
 
   (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) -> 
-      TacRewrite (ev, 
+  | TacRewrite (ev,l,cl,by) ->
+      TacRewrite (ev,
 		  List.map (fun (b,m,c) ->
 			      b,m,subst_raw_with_bindings subst c) l,
 		 cl,Option.map (subst_tactic subst) by)
@@ -2710,14 +2710,14 @@ and subst_tacarg subst = function
   | MetaIdArg (_loc,_,_) -> assert false
   | TacCall (_loc,f,l) ->
       TacCall (_loc, subst_reference subst f, List.map (subst_tacarg subst) l)
-  | TacExternal (_loc,com,req,la) -> 
+  | TacExternal (_loc,com,req,la) ->
       TacExternal (_loc,com,req,List.map (subst_tacarg subst) la)
   | (TacVoid | IntroPattern _ | Integer _ | TacFreshId _) as x -> x
   | Tacexp t -> Tacexp (subst_tactic subst t)
   | TacDynamic(the_loc,t) as x ->
       (match tag t with
 	| "tactic" | "value" -> x
-        | "constr" -> 
+        | "constr" ->
           TacDynamic(the_loc, constr_in (subst_mps subst (constr_out t)))
 	| s -> anomaly_loc (dloc, "Tacinterp.val_interp",
                  str "Unknown dynamic: <" ++ str s ++ str ">"))
@@ -2742,11 +2742,11 @@ and subst_genarg subst (x:glob_generic_argument) =
   | PreIdentArgType -> in_gen globwit_pre_ident (out_gen globwit_pre_ident x)
   | IntroPatternArgType ->
       in_gen globwit_intro_pattern (out_gen globwit_intro_pattern x)
-  | IdentArgType b -> 
+  | IdentArgType b ->
       in_gen (globwit_ident_gen b) (out_gen (globwit_ident_gen b) x)
   | VarArgType -> in_gen globwit_var (out_gen globwit_var x)
   | RefArgType ->
-      in_gen globwit_ref (subst_global_reference subst 
+      in_gen globwit_ref (subst_global_reference subst
 	(out_gen globwit_ref x))
   | SortArgType ->
       in_gen globwit_sort (out_gen globwit_sort x)
@@ -2756,7 +2756,7 @@ and subst_genarg subst (x:glob_generic_argument) =
       in_gen globwit_constr_may_eval (subst_raw_may_eval subst (out_gen globwit_constr_may_eval x))
   | QuantHypArgType ->
       in_gen globwit_quant_hyp
-        (subst_declared_or_quantified_hypothesis subst 
+        (subst_declared_or_quantified_hypothesis subst
           (out_gen globwit_quant_hyp x))
   | RedExprArgType ->
       in_gen globwit_red_expr (subst_redexp subst (out_gen globwit_red_expr x))
@@ -2775,11 +2775,11 @@ and subst_genarg subst (x:glob_generic_argument) =
   | PairArgType _ -> app_pair (subst_genarg subst) (subst_genarg subst) x
   | ExtraArgType s ->
       match tactic_genarg_level s with
-      | Some n -> 
+      | Some n ->
           (* Special treatment of tactic arguments *)
           in_gen (globwit_tactic n)
             (subst_tactic subst (out_gen (globwit_tactic n) x))
-      | None -> 
+      | None ->
           lookup_genarg_subst s subst x
 
 (***************************************************************************)
@@ -2800,7 +2800,7 @@ type tacdef_kind = | NewTac of identifier
 let load_md i ((sp,kn),defs) =
   let dp,_ = repr_path sp in
   let mp,dir,_ = repr_kn kn in
-  List.iter (fun (id,t) -> 
+  List.iter (fun (id,t) ->
     match id with
 	NewTac id ->
 	  let sp = Libnames.make_path dp id in
@@ -2808,11 +2808,11 @@ let load_md i ((sp,kn),defs) =
 	    Nametab.push_tactic (Until i) sp kn;
 	    add (kn,t)
       | UpdateTac kn -> replace (kn,t)) defs
-    
+
 let open_md i((sp,kn),defs) =
   let dp,_ = repr_path sp in
   let mp,dir,_ = repr_kn kn in
-  List.iter (fun (id,t) -> 
+  List.iter (fun (id,t) ->
     match id with
 	NewTac id ->
 	  let sp = Libnames.make_path dp id in
@@ -2822,7 +2822,7 @@ let open_md i((sp,kn),defs) =
 
 let cache_md x = load_md 1 x
 
-let subst_kind subst id = 
+let subst_kind subst id =
   match id with
     | NewTac _ -> id
     | UpdateTac kn -> UpdateTac (Mod_subst.subst_kn subst kn)
@@ -2836,7 +2836,7 @@ let (inMD,outMD) =
      load_function   = load_md;
      open_function   = open_md;
      subst_function = subst_md;
-     classify_function = (fun o -> Substitute o);       
+     classify_function = (fun o -> Substitute o);
      export_function = (fun x -> Some x)}
 
 let print_ltac id =
@@ -2855,18 +2855,18 @@ open Libnames
 (* Adds a definition for tactics in the table *)
 let make_absolute_name ident repl =
   let loc = loc_of_reference ident in
-  try 
-    let id, kn = 
+  try
+    let id, kn =
       if repl then None, Nametab.locate_tactic (snd (qualid_of_reference ident))
       else let id = coerce_reference_to_id ident in
-	     Some id, Lib.make_kn id 
+	     Some id, Lib.make_kn id
     in
       if Gmap.mem kn !mactab then
 	if repl then id, kn
 	else
 	  user_err_loc (loc,"Tacinterp.add_tacdef",
 		       str "There is already an Ltac named " ++ pr_reference ident ++ str".")
-      else if is_atomic_kn kn then 
+      else if is_atomic_kn kn then
 	user_err_loc (loc,"Tacinterp.add_tacdef",
 		     str "Reserved Ltac name " ++ pr_reference ident ++ str".")
       else id, kn
@@ -2877,9 +2877,9 @@ let make_absolute_name ident repl =
 let add_tacdef isrec tacl =
   let rfun = List.map (fun (ident, b, _) -> make_absolute_name ident b) tacl in
   let ist =
-    {(make_empty_glob_sign()) with ltacrecvars = 
+    {(make_empty_glob_sign()) with ltacrecvars =
 	if isrec then list_map_filter
-	  (function (Some id, qid) -> Some (id, qid) | (None, _) -> None) rfun 
+	  (function (Some id, qid) -> Some (id, qid) | (None, _) -> None) rfun
 	else []} in
   let gtacl =
     List.map2 (fun (_,b,def) (id, qid) ->
@@ -2891,8 +2891,8 @@ let add_tacdef isrec tacl =
   let _ = match id0 with Some id0 -> ignore(Lib.add_leaf id0 (inMD gtacl))
     | _ -> Lib.add_anonymous_leaf (inMD gtacl) in
   List.iter
-    (fun (id,b,_) -> 
-      Flags.if_verbose msgnl (Libnames.pr_reference id ++ 
+    (fun (id,b,_) ->
+      Flags.if_verbose msgnl (Libnames.pr_reference id ++
 				 (if b then str " is redefined"
 				   else str " is defined")))
     tacl
@@ -2902,13 +2902,13 @@ let add_tacdef isrec tacl =
 
 let glob_tactic x = intern_tactic (make_empty_glob_sign ()) x
 
-let glob_tactic_env l env x = 
+let glob_tactic_env l env x =
   Flags.with_option strict_check
   (intern_tactic
     { ltacvars = (l,[]); ltacrecvars = []; gsigma = Evd.empty; genv = env })
     x
 
-let interp_redexp env sigma r = 
+let interp_redexp env sigma r =
   let ist = { lfun=[]; avoid_ids=[]; debug=get_debug (); trace=[] } in
   let gist = {(make_empty_glob_sign ()) with genv = env; gsigma = sigma } in
   interp_red_expr ist sigma env (intern_red_expr gist r)
@@ -2933,10 +2933,10 @@ let tacticOut = function
 (* Backwarding recursive needs of tactic glob/interp/eval functions *)
 
 let _ = Auto.set_extern_interp
-  (fun l -> 
+  (fun l ->
     let l = List.map (fun (id,c) -> (id,VConstr c)) l in
     interp_tactic {lfun=l;avoid_ids=[];debug=get_debug(); trace=[]})
-let _ = Auto.set_extern_intern_tac 
+let _ = Auto.set_extern_intern_tac
   (fun l ->
     Flags.with_option strict_check
     (intern_tactic {(make_empty_glob_sign()) with ltacvars=(l,[])}))
diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli
index 6b7aabe2e3..18873d1c66 100644
--- a/tactics/tacinterp.mli
+++ b/tactics/tacinterp.mli
@@ -27,7 +27,7 @@ open Redexpr
 (* Values for interpretation *)
 type value =
   | VRTactic of (goal list sigma * validation)
-  | VFun of ltac_trace * (identifier*value) list * 
+  | VFun of ltac_trace * (identifier*value) list *
       identifier option list * glob_tactic_expr
   | VVoid
   | VInteger of int
@@ -44,7 +44,7 @@ and interp_sign =
     debug : debug_info;
     trace : ltac_trace }
 
-val extract_ltac_vars : interp_sign -> Evd.evar_defs -> Environ.env -> 
+val extract_ltac_vars : interp_sign -> Evd.evar_defs -> Environ.env ->
   Pretyping.var_map * Pretyping.unbound_ltac_var_map
 
 (* Transforms an id into a constr if possible *)
@@ -53,7 +53,7 @@ val constr_of_id : Environ.env -> identifier -> constr
 (* To embed several objects in Coqast.t *)
 val tactic_in : (interp_sign -> glob_tactic_expr) -> Dyn.t
 val tactic_out : Dyn.t -> (interp_sign -> glob_tactic_expr)
-  
+
 val tacticIn : (interp_sign -> raw_tactic_expr) -> raw_tactic_expr
 val globTacticIn : (interp_sign -> glob_tactic_expr) -> raw_tactic_expr
 val valueIn : value -> raw_tactic_arg
@@ -88,7 +88,7 @@ type glob_sign = {
 val add_interp_genarg :
   string ->
     (glob_sign -> raw_generic_argument -> glob_generic_argument) *
-    (interp_sign -> goal sigma -> glob_generic_argument -> 
+    (interp_sign -> goal sigma -> glob_generic_argument ->
       typed_generic_argument) *
     (substitution -> glob_generic_argument -> glob_generic_argument)
     -> unit
@@ -99,14 +99,14 @@ val interp_genarg :
 val intern_genarg :
   glob_sign -> raw_generic_argument -> glob_generic_argument
 
-val intern_tactic : 
+val intern_tactic :
   glob_sign -> raw_tactic_expr -> glob_tactic_expr
 
 val intern_constr :
   glob_sign -> constr_expr -> rawconstr_and_expr
 
 val intern_constr_with_bindings :
-  glob_sign -> constr_expr * constr_expr Rawterm.bindings -> 
+  glob_sign -> constr_expr * constr_expr Rawterm.bindings ->
   rawconstr_and_expr * rawconstr_and_expr Rawterm.bindings
 
 val intern_hyp :
@@ -122,7 +122,7 @@ val subst_rawconstr_and_expr :
 val val_interp : interp_sign -> goal sigma -> glob_tactic_expr -> value
 
 (* Interprets an expression that evaluates to a constr *)
-val interp_ltac_constr : interp_sign -> goal sigma -> glob_tactic_expr -> 
+val interp_ltac_constr : interp_sign -> goal sigma -> glob_tactic_expr ->
   constr
 
 (* Interprets redexp arguments *)
@@ -134,7 +134,7 @@ val interp_tac_gen : (identifier * value) list -> identifier list ->
 
 val interp_hyp :  interp_sign -> goal sigma -> identifier located -> identifier
 
-val interp_bindings : interp_sign -> goal sigma -> rawconstr_and_expr Rawterm.bindings -> 
+val interp_bindings : interp_sign -> goal sigma -> rawconstr_and_expr Rawterm.bindings ->
   Evd.open_constr Rawterm.bindings
 
 (* Initial call for interpretation *)
@@ -158,7 +158,7 @@ val hide_interp : raw_tactic_expr -> tactic option -> tactic
 val declare_implicit_tactic : tactic -> unit
 
 (* Declare the xml printer *)
-val declare_xml_printer : 
+val declare_xml_printer :
   (out_channel -> Environ.env -> Evd.evar_map -> constr -> unit) -> unit
 
 (* printing *)
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 2b69d7233f..a20fe72efe 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -86,7 +86,7 @@ let rec tclFIRST_PROGRESS_ON tac = function
 (************************************************************************)
 
 let nthDecl m gl =
-  try List.nth (pf_hyps gl) (m-1) 
+  try List.nth (pf_hyps gl) (m-1)
   with Failure _ -> error "No such assumption."
 
 let nthHypId m gl = pi1 (nthDecl m gl)
@@ -129,7 +129,7 @@ let afterHyp id gl =
    or (Some id), where id is an identifier. This type is useful for
    defining tactics that may be used either to transform the
    conclusion (None) or to transform a hypothesis id (Some id).  --
-   --Eduardo (8/8/97) 
+   --Eduardo (8/8/97)
 *)
 
 (* A [simple_clause] is a set of hypotheses, possibly extended with
@@ -156,7 +156,7 @@ let simple_clause_of cl gls =
   let error_body_selection () =
     error "This tactic does not support body selection" in
   let hyps =
-    match cl.onhyps with 
+    match cl.onhyps with
     | None ->
 	List.map Option.make (pf_ids_of_hyps gls)
     | Some l ->
@@ -186,7 +186,7 @@ let onClauseLR tac cl gls = tclMAP tac (List.rev (simple_clause_of cl gls)) gls
 let ifOnHyp pred tac1 tac2 id gl =
   if pred (id,pf_get_hyp_typ gl id) then
     tac1 id gl
-  else 
+  else
     tac2 id gl
 
 
@@ -225,14 +225,14 @@ type concrete_clause = clause_atom list
 
 let concrete_clause_of cl gls =
   let hyps =
-    match cl.onhyps with 
+    match cl.onhyps with
     | None ->
 	let f id = OnHyp (id,all_occurrences_expr,InHyp) in
 	List.map f (pf_ids_of_hyps gls)
     | Some l ->
 	List.map (fun ((occs,id),w) -> OnHyp (id,occs,w)) l in
   if cl.concl_occs = no_occurrences_expr then hyps
-  else 
+  else
     OnConcl cl.concl_occs :: hyps
 
 (************************************************************************)
@@ -241,10 +241,10 @@ let concrete_clause_of cl gls =
 
 (* The following tacticals allow to apply a tactic to the
    branches generated by the application of an elimination
-  tactic. 
+  tactic.
 
   Two auxiliary types --branch_args and branch_assumptions-- are
-  used to keep track of some information about the ``branches'' of 
+  used to keep track of some information about the ``branches'' of
   the elimination. *)
 
 type branch_args = {
@@ -262,18 +262,18 @@ type branch_assumptions = {
   assums    : named_context}   (* the list of assumptions introduced *)
 
 let fix_empty_or_and_pattern nv l =
-  (* 1- The syntax does not distinguish between "[ ]" for one clause with no 
+  (* 1- The syntax does not distinguish between "[ ]" for one clause with no
      names and "[ ]" for no clause at all *)
-  (* 2- More generally, we admit "[ ]" for any disjunctive pattern of 
+  (* 2- More generally, we admit "[ ]" for any disjunctive pattern of
      arbitrary length *)
   if l = [[]] then list_make nv [] else l
 
 let check_or_and_pattern_size loc names n =
   if List.length names <> n then
-    if n = 1 then 
+    if n = 1 then
       user_err_loc (loc,"",str "Expects a conjunctive pattern.")
-    else 
-      user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n 
+    else
+      user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n
 	++ str " branches.")
 
 let compute_induction_names n = function
@@ -288,7 +288,7 @@ let compute_induction_names n = function
 
 let compute_construtor_signatures isrec (_,k as ity) =
   let rec analrec c recargs =
-    match kind_of_term c, recargs with 
+    match kind_of_term c, recargs with
     | Prod (_,_,c), recarg::rest ->
 	let b = match dest_recarg recarg with
 	  | Norec | Imbr _  -> false
@@ -297,7 +297,7 @@ let compute_construtor_signatures isrec (_,k as ity) =
     | LetIn (_,_,_,c), rest -> false :: (analrec c rest)
     | _, [] -> []
     | _ -> anomaly "compute_construtor_signatures"
-  in 
+  in
   let (mib,mip) = Global.lookup_inductive ity in
   let n = mib.mind_nparams in
   let lc =
@@ -305,27 +305,27 @@ let compute_construtor_signatures isrec (_,k as ity) =
   let lrecargs = dest_subterms mip.mind_recargs in
   array_map2 analrec lc lrecargs
 
-let elimination_sort_of_goal gl = 
+let elimination_sort_of_goal gl =
   pf_apply Retyping.get_sort_family_of gl (pf_concl gl)
 
-let elimination_sort_of_hyp id gl = 
+let elimination_sort_of_hyp id gl =
   pf_apply Retyping.get_sort_family_of gl (pf_get_hyp_typ gl id)
 
 let elimination_sort_of_clause = function
-  | None -> elimination_sort_of_goal 
+  | None -> elimination_sort_of_goal
   | Some id -> elimination_sort_of_hyp id
 
 (* Find the right elimination suffix corresponding to the sort of the goal *)
 (* c should be of type A1->.. An->B with B an inductive definition *)
 
-let general_elim_then_using mk_elim 
-  isrec allnames tac predicate (indbindings,elimbindings) 
+let general_elim_then_using mk_elim
+  isrec allnames tac predicate (indbindings,elimbindings)
   ind indclause gl =
   let elim = mk_elim ind gl in
   (* applying elimination_scheme just a little modified *)
   let indclause' = clenv_match_args indbindings indclause in
   let elimclause = mk_clenv_from gl (elim,pf_type_of gl elim) in
-  let indmv = 
+  let indmv =
     match kind_of_term (last_arg elimclause.templval.Evd.rebus) with
       | Meta mv -> mv
       | _         -> anomaly "elimination"
@@ -341,7 +341,7 @@ let general_elim_then_using mk_elim
 	      | Var id -> string_of_id id
 	      | _ -> "\b"
 	  in
-	  error ("The elimination combinator " ^ name_elim ^ " is unknown.") 
+	  error ("The elimination combinator " ^ name_elim ^ " is unknown.")
   in
   let elimclause' = clenv_fchain indmv elimclause indclause' in
   let elimclause' = clenv_match_args elimbindings elimclause' in
@@ -351,15 +351,15 @@ let general_elim_then_using mk_elim
     let (hd,largs) = decompose_app ce.templtyp.Evd.rebus in
     let ba = { branchsign = branchsigns.(i);
                branchnames = brnames.(i);
-               nassums = 
-		 List.fold_left 
+               nassums =
+		 List.fold_left
                    (fun acc b -> if b then acc+2 else acc+1)
                    0 branchsigns.(i);
                branchnum = i+1;
                ity = ind;
                largs = List.map (clenv_nf_meta ce) largs;
                pred = clenv_nf_meta ce hd }
-    in 
+    in
     tac ba gl
   in
   let branchtacs ce = Array.init (Array.length branchsigns) (after_tac ce) in
@@ -368,7 +368,7 @@ let general_elim_then_using mk_elim
        | None   -> elimclause'
        | Some p ->
            clenv_unify true Reduction.CONV (mkMeta pmv) p elimclause'
-  in 
+  in
   elim_res_pf_THEN_i elimclause' branchtacs gl
 
 (* computing the case/elim combinators *)
@@ -382,7 +382,7 @@ let gl_make_case_dep ind gl =
 let gl_make_case_nodep ind gl =
   pf_apply Indrec.make_case_nodep gl ind (elimination_sort_of_goal gl)
 
-let elimination_then_using tac predicate bindings c gl = 
+let elimination_then_using tac predicate bindings c gl =
   let (ind,t) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
   let indclause  = mk_clenv_from gl (c,t) in
   general_elim_then_using gl_make_elim
@@ -394,14 +394,14 @@ let case_then_using =
 let case_nodep_then_using =
   general_elim_then_using gl_make_case_nodep false
 
-let elimination_then tac        = elimination_then_using tac None 
+let elimination_then tac        = elimination_then_using tac None
 let simple_elimination_then tac = elimination_then tac ([],[])
 
 
-let make_elim_branch_assumptions ba gl =   
+let make_elim_branch_assumptions ba gl =
   let rec makerec (assums,cargs,constargs,recargs,indargs) lb lc =
-    match lb,lc with 
-      | ([], _) -> 
+    match lb,lc with
+      | ([], _) ->
           { ba = ba;
             assums    = assums}
       | ((true::tl), ((idrec,_,_ as recarg)::(idind,_,_ as indarg)::idtl)) ->
@@ -417,7 +417,7 @@ let make_elim_branch_assumptions ba gl =
 		   recargs,
 		   indargs) tl idtl
       | (_, _) -> anomaly "make_elim_branch_assumptions"
-  in 
+  in
   makerec ([],[],[],[],[]) ba.branchsign
     (try list_firstn ba.nassums (pf_hyps gl)
      with Failure _ -> anomaly "make_elim_branch_assumptions")
@@ -426,8 +426,8 @@ let elim_on_ba tac ba gl = tac (make_elim_branch_assumptions ba gl) gl
 
 let make_case_branch_assumptions ba gl =
   let rec makerec (assums,cargs,constargs,recargs) p_0 p_1 =
-    match p_0,p_1 with 
-      | ([], _) -> 
+    match p_0,p_1 with
+      | ([], _) ->
           { ba = ba;
             assums    = assums}
       | ((true::tl), ((idrec,_,_ as recarg)::idtl)) ->
@@ -441,7 +441,7 @@ let make_case_branch_assumptions ba gl =
 		   recargs,
 		   id::constargs) tl idtl
       | (_, _) -> anomaly "make_case_branch_assumptions"
-  in 
+  in
   makerec ([],[],[],[]) ba.branchsign
     (try list_firstn ba.nassums (pf_hyps gl)
      with Failure _ -> anomaly "make_case_branch_assumptions")
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 762c7dc767..b9c8ab928b 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -93,7 +93,7 @@ val ifOnHyp     : (identifier * types -> bool) ->
                   (identifier -> tactic) -> (identifier -> tactic) ->
 		   identifier -> tactic
 
-val onHyps      : (goal sigma -> named_context) -> 
+val onHyps      : (goal sigma -> named_context) ->
                   (named_context -> tactic) -> tactic
 
 (*s Tacticals applying to goal components *)
@@ -158,7 +158,7 @@ val concrete_clause_of : clause -> goal sigma -> concrete_clause
 
 (*s Elimination tacticals. *)
 
-type branch_args = { 
+type branch_args = {
   ity        : inductive;   (* the type we were eliminating on *)
   largs      : constr list; (* its arguments *)
   branchnum  : int;         (* the branch number *)
@@ -175,15 +175,15 @@ type branch_assumptions = {
 (* [check_disjunctive_pattern_size loc pats n] returns an appropriate *)
 (* error message if |pats| <> n *)
 val check_or_and_pattern_size :
-  Util.loc -> or_and_intro_pattern_expr -> int -> unit 
+  Util.loc -> or_and_intro_pattern_expr -> int -> unit
 
 (* Tolerate "[]" to mean a disjunctive pattern of any length *)
-val fix_empty_or_and_pattern : int -> or_and_intro_pattern_expr -> 
+val fix_empty_or_and_pattern : int -> or_and_intro_pattern_expr ->
   or_and_intro_pattern_expr
 
 (* Useful for [as intro_pattern] modifier *)
-val compute_induction_names : 
-  int -> intro_pattern_expr located option -> 
+val compute_induction_names :
+  int -> intro_pattern_expr located option ->
     intro_pattern_expr located list array
 
 val elimination_sort_of_goal : goal sigma -> sorts_family
@@ -192,30 +192,30 @@ val elimination_sort_of_clause : identifier option -> goal sigma -> sorts_family
 
 val general_elim_then_using :
   (inductive -> goal sigma -> constr) -> rec_flag ->
-  intro_pattern_expr located option -> (branch_args -> tactic) -> 
+  intro_pattern_expr located option -> (branch_args -> tactic) ->
     constr option -> (arg_bindings * arg_bindings) -> inductive -> clausenv ->
     tactic
-	  
+
 val elimination_then_using :
-  (branch_args -> tactic) -> constr option -> 
+  (branch_args -> tactic) -> constr option ->
     (arg_bindings * arg_bindings) -> constr -> tactic
 
 val elimination_then :
-  (branch_args -> tactic) -> 
+  (branch_args -> tactic) ->
     (arg_bindings * arg_bindings) -> constr -> tactic
 
 val case_then_using :
-  intro_pattern_expr located option -> (branch_args -> tactic) -> 
+  intro_pattern_expr located option -> (branch_args -> tactic) ->
     constr option -> (arg_bindings * arg_bindings) ->
       inductive -> clausenv -> tactic
 
 val case_nodep_then_using :
-  intro_pattern_expr located option -> (branch_args -> tactic) -> 
-    constr option -> (arg_bindings * arg_bindings) -> 
+  intro_pattern_expr located option -> (branch_args -> tactic) ->
+    constr option -> (arg_bindings * arg_bindings) ->
       inductive -> clausenv -> tactic
 
 val simple_elimination_then :
   (branch_args -> tactic) -> constr -> tactic
 
-val elim_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic 
-val case_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic 
+val elim_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
+val case_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 1ac95f7285..7796c36fbf 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -72,7 +72,7 @@ let inj_red_expr = function
 let inj_ebindings = function
   | NoBindings -> NoBindings
   | ImplicitBindings l -> ImplicitBindings (List.map inj_open l)
-  | ExplicitBindings l -> 
+  | ExplicitBindings l ->
       ExplicitBindings (List.map (fun (l,id,c) -> (l,id,inj_open c)) l)
 
 let dloc = dummy_loc
@@ -85,10 +85,10 @@ let dloc = dummy_loc
 (* General functions                    *)
 (****************************************)
 
-let string_of_inductive c = 
+let string_of_inductive c =
   try match kind_of_term c with
-  | Ind ind_sp -> 
-      let (mib,mip) = Global.lookup_inductive ind_sp in 
+  | Ind ind_sp ->
+      let (mib,mip) = Global.lookup_inductive ind_sp in
       string_of_id mip.mind_typename
   | _ -> raise Bound
   with Bound -> error "Bound head variable."
@@ -101,14 +101,14 @@ let rec head_constr_bound t =
     | Const _ | Ind _ | Construct _ | Var _ -> (hd,args)
     | _ -> raise Bound
 
-let head_constr c = 
+let head_constr c =
   try head_constr_bound c with Bound -> error "Bound head variable."
 
 (******************************************)
 (*           Primitive tactics            *)
 (******************************************)
 
-let introduction    = Tacmach.introduction 
+let introduction    = Tacmach.introduction
 let refine          = Tacmach.refine
 let convert_concl   = Tacmach.convert_concl
 let convert_hyp     = Tacmach.convert_hyp
@@ -117,16 +117,16 @@ let thin_body       = Tacmach.thin_body
 let error_clear_dependency env id = function
   | Evarutil.OccurHypInSimpleClause None ->
       errorlabstrm "" (pr_id id ++ str " is used in conclusion.")
-  | Evarutil.OccurHypInSimpleClause (Some id') -> 
+  | Evarutil.OccurHypInSimpleClause (Some id') ->
       errorlabstrm ""
         (pr_id id ++ strbrk " is used in hypothesis " ++ pr_id id' ++ str".")
   | Evarutil.EvarTypingBreak ev ->
       errorlabstrm ""
-        (str "Cannot remove " ++ pr_id id ++ 
-	 strbrk " without breaking the typing of " ++ 
+        (str "Cannot remove " ++ pr_id id ++
+	 strbrk " without breaking the typing of " ++
 	 Printer.pr_existential env ev ++ str".")
 
-let thin l gl = 
+let thin l gl =
   try thin l gl
   with Evarutil.ClearDependencyError (id,err) ->
     error_clear_dependency (pf_env gl) id err
@@ -148,7 +148,7 @@ let internal_cut_rev = internal_cut_rev_gen false
 let internal_cut_rev_replace = internal_cut_rev_gen true
 
 (* Moving hypotheses *)
-let move_hyp        = Tacmach.move_hyp 
+let move_hyp        = Tacmach.move_hyp
 
 let order_hyps      = Tacmach.order_hyps
 
@@ -173,7 +173,7 @@ let fresh_id avoid id gl =
 let mutual_fix = Tacmach.mutual_fix
 
 let fix ido n gl = match ido with
-  | None -> 
+  | None ->
       mutual_fix (fresh_id [] (Pfedit.get_current_proof_name ()) gl) n [] 0 gl
   | Some id ->
       mutual_fix id n [] 0 gl
@@ -182,7 +182,7 @@ let fix ido n gl = match ido with
 let mutual_cofix = Tacmach.mutual_cofix
 
 let cofix ido gl = match ido with
-  | None -> 
+  | None ->
       mutual_cofix (fresh_id [] (Pfedit.get_current_proof_name ()) gl) [] 0 gl
   | Some id ->
       mutual_cofix id [] 0 gl
@@ -196,7 +196,7 @@ type tactic_reduction = env -> evar_map -> constr -> constr
 let pf_reduce_decl redfun where (id,c,ty) gl =
   let redfun' = pf_reduce redfun gl in
   match c with
-  | None -> 
+  | None ->
       if where = InHypValueOnly then
 	errorlabstrm "" (pr_id id ++ str "has no value.");
       (id,None,redfun' ty)
@@ -243,7 +243,7 @@ let bind_red_expr_occurrences occs nbcl redexp =
     if nbcl > 1 && has_at_clause redexp then
       error_illegal_non_atomic_clause ()
     else
-      redexp 
+      redexp
   else
     match redexp with
     | Unfold (_::_::_) ->
@@ -272,31 +272,31 @@ let bind_red_expr_occurrences occs nbcl redexp =
 	assert false
 
 (* The following two tactics apply an arbitrary
-   reduction function either to the conclusion or to a 
+   reduction function either to the conclusion or to a
    certain hypothesis *)
 
-let reduct_in_concl (redfun,sty) gl = 
+let reduct_in_concl (redfun,sty) gl =
   convert_concl_no_check (pf_reduce redfun gl (pf_concl gl)) sty gl
 
 let reduct_in_hyp redfun (id,where) gl =
   convert_hyp_no_check
-    (pf_reduce_decl redfun where (pf_get_hyp gl id) gl) gl 
+    (pf_reduce_decl redfun where (pf_get_hyp gl id) gl) gl
 
 let reduct_option redfun = function
-  | Some id -> reduct_in_hyp (fst redfun) id 
-  | None    -> reduct_in_concl redfun 
+  | Some id -> reduct_in_hyp (fst redfun) id
+  | None    -> reduct_in_concl redfun
 
 (* Now we introduce different instances of the previous tacticals *)
 let change_and_check cv_pb t env sigma c =
-  if is_fconv cv_pb env sigma t c then 
+  if is_fconv cv_pb env sigma t c then
     t
-  else 
+  else
     errorlabstrm "convert-check-hyp" (str "Not convertible.")
 
 (* Use cumulativity only if changing the conclusion not a subterm *)
 let change_on_subterm cv_pb t = function
   | None -> change_and_check cv_pb t
-  | Some occl -> contextually false occl (change_and_check Reduction.CONV t) 
+  | Some occl -> contextually false occl (change_and_check Reduction.CONV t)
 
 let change_in_concl occl t =
   reduct_in_concl ((change_on_subterm Reduction.CUMUL t occl),DEFAULTcast)
@@ -334,8 +334,8 @@ let normalise_in_hyp    = reduct_in_hyp   compute
 let normalise_option    = reduct_option   (compute,DEFAULTcast)
 let normalise_vm_in_concl = reduct_in_concl (Redexpr.cbv_vm,VMcast)
 let unfold_in_concl loccname = reduct_in_concl (unfoldn loccname,DEFAULTcast)
-let unfold_in_hyp   loccname = reduct_in_hyp   (unfoldn loccname) 
-let unfold_option   loccname = reduct_option (unfoldn loccname,DEFAULTcast) 
+let unfold_in_hyp   loccname = reduct_in_hyp   (unfoldn loccname)
+let unfold_option   loccname = reduct_option (unfoldn loccname,DEFAULTcast)
 let pattern_option l = reduct_option (pattern_occs l,DEFAULTcast)
 
 (* A function which reduces accordingly to a reduction expression,
@@ -369,7 +369,7 @@ let reduce redexp cl goal =
 
 (* Unfolding occurrences of a constant *)
 
-let unfold_constr = function 
+let unfold_constr = function
   | ConstRef sp -> unfold_in_concl [all_occurrences,EvalConstRef sp]
   | VarRef id -> unfold_in_concl [all_occurrences,EvalVarRef id]
   | _ -> errorlabstrm "unfold_constr" (str "Cannot unfold a non-constant.")
@@ -394,7 +394,7 @@ let default_id env sigma = function
   | (name,Some b,_) -> id_of_name_using_hdchar env b name
 
 (* Non primitive introduction tactics are treated by central_intro
-   There is possibly renaming, with possibly names to avoid and 
+   There is possibly renaming, with possibly names to avoid and
    possibly a move to do after the introduction *)
 
 type intro_name_flag =
@@ -403,11 +403,11 @@ type intro_name_flag =
   | IntroMustBe of identifier
 
 let find_name loc decl gl = function
-  | IntroAvoid idl -> 
+  | IntroAvoid idl ->
       (* this case must be compatible with [find_intro_names] below. *)
       let id = fresh_id idl (default_id (pf_env gl) gl.sigma decl) gl in id
   | IntroBasedOn (id,idl) -> fresh_id idl id gl
-  | IntroMustBe id -> 
+  | IntroMustBe id ->
       let id' = fresh_id [] id gl in
       if id'<>id then user_err_loc (loc,"",pr_id id ++ str" is already used.");
       id'
@@ -417,16 +417,16 @@ let find_name loc decl gl = function
    iteration of [find_name] above. As [default_id] checks the sort of
    the type to build hyp names, we maintain an environment to be able
    to type dependent hyps. *)
-let find_intro_names ctxt gl = 
-  let _, res = List.fold_right 
-    (fun decl acc -> 
+let find_intro_names ctxt gl =
+  let _, res = List.fold_right
+    (fun decl acc ->
       let wantedname,x,typdecl = decl in
       let env,idl = acc in
       let name = fresh_id idl (default_id env gl.sigma decl) gl in
       let newenv = push_rel (wantedname,x,typdecl) env in
       (newenv,(name::idl)))
     ctxt (pf_env gl , []) in
-  List.rev res 
+  List.rev res
 
 let build_intro_tac id = function
   | MoveToEnd true -> introduction id
@@ -439,7 +439,7 @@ let rec intro_gen loc name_flag move_flag force_flag dep_flag gl =
     | LetIn (name,b,t,u) when not dep_flag or (dependent (mkRel 1) u) ->
 	build_intro_tac (find_name loc (name,Some b,t) gl name_flag) move_flag
 	  gl
-    | _ -> 
+    | _ ->
 	if not force_flag then raise (RefinerError IntroNeedsProduct);
 	try
 	  tclTHEN try_red_in_concl
@@ -481,14 +481,14 @@ let thin_for_replacing l gl =
   | Evarutil.OccurHypInSimpleClause None ->
       errorlabstrm ""
       (str "Cannot change " ++ pr_id id ++ str ", it is used in conclusion.")
-  | Evarutil.OccurHypInSimpleClause (Some id') -> 
+  | Evarutil.OccurHypInSimpleClause (Some id') ->
       errorlabstrm ""
-        (str "Cannot change " ++ pr_id id ++ 
+        (str "Cannot change " ++ pr_id id ++
 	 strbrk ", it is used in hypothesis " ++ pr_id id' ++ str".")
   | Evarutil.EvarTypingBreak ev ->
       errorlabstrm ""
-        (str "Cannot change " ++ pr_id id ++ 
-	 strbrk " without breaking the typing of " ++ 
+        (str "Cannot change " ++ pr_id id ++
+	 strbrk " without breaking the typing of " ++
 	 Printer.pr_existential (pf_env gl) ev ++ str".")
 
 let intro_replacing id gl =
@@ -496,13 +496,13 @@ let intro_replacing id gl =
   tclTHENLIST
     [thin_for_replacing [id]; introduction id; move_hyp true id next_hyp] gl
 
-let intros_replacing ids gl = 
+let intros_replacing ids gl =
   let rec introrec = function
     | [] -> tclIDTAC
     | id::tl ->
 	tclTHEN (tclORELSE (intro_replacing id) (intro_using id))
            (introrec tl)
-  in 
+  in
   introrec ids gl
 
 (* User-level introduction tactics *)
@@ -520,8 +520,8 @@ let pf_lookup_hypothesis_as_renamed_gen red h gl =
   let rec aux ccl =
     match pf_lookup_hypothesis_as_renamed env ccl h with
       | None when red ->
-          aux 
-	    ((fst (Redexpr.reduction_of_red_expr (Red true))) 
+          aux
+	    ((fst (Redexpr.reduction_of_red_expr (Red true)))
 	       env (project gl) ccl)
       | x -> x
   in
@@ -534,7 +534,7 @@ let is_quantified_hypothesis id g =
     | None -> false
 
 let msg_quantified_hypothesis = function
-  | NamedHyp id -> 
+  | NamedHyp id ->
       str "quantified hypothesis named " ++ pr_id id
   | AnonHyp n ->
       int n ++ str (match n with 1 -> "st" | 2 -> "nd" | _ -> "th") ++
@@ -544,7 +544,7 @@ let depth_of_quantified_hypothesis red h gl =
   match pf_lookup_hypothesis_as_renamed_gen red h gl with
     | Some depth -> depth
     | None ->
-        errorlabstrm "lookup_quantified_hypothesis" 
+        errorlabstrm "lookup_quantified_hypothesis"
           (str "No " ++ msg_quantified_hypothesis h ++
 	  strbrk " in current goal" ++
 	  (if red then strbrk " even after head-reduction" else mt ()) ++
@@ -579,8 +579,8 @@ let dependent_in_decl a (_,c,t) =
    or a term with bindings *)
 
 let onInductionArg tac = function
-  | ElimOnConstr (c,lbindc as cbl) -> 
-      if isVar c & lbindc = NoBindings then 
+  | ElimOnConstr (c,lbindc as cbl) ->
+      if isVar c & lbindc = NoBindings then
 	tclTHEN (tclTRY (intros_until_id (destVar c))) (tac cbl)
       else
 	tac cbl
@@ -596,11 +596,11 @@ let onInductionArg tac = function
 
 let apply_type hdcty argl gl =
   refine (applist (mkCast (Evarutil.mk_new_meta(),DEFAULTcast, hdcty),argl)) gl
-    
+
 let apply_term hdc argl gl =
   refine (applist (hdc,argl)) gl
 
-let bring_hyps hyps = 
+let bring_hyps hyps =
   if hyps = [] then Refiner.tclIDTAC
   else
     (fun gl ->
@@ -634,15 +634,15 @@ let cut_intro t = tclTHENFIRST (cut t) intro
 
 (* cut_replacing échoue si l'hypothèse à remplacer apparaît dans le
    but, ou dans une autre hypothèse *)
-let cut_replacing id t tac = 
+let cut_replacing id t tac =
   tclTHENLAST (internal_cut_rev_replace id t)
     (tac (refine_no_check (mkVar id)))
 
-let cut_in_parallel l = 
+let cut_in_parallel l =
   let rec prec = function
-    | [] -> tclIDTAC 
+    | [] -> tclIDTAC
     | h::t -> tclTHENFIRST (cut h) (prec t)
-  in 
+  in
     prec (List.rev l)
 
 let error_uninstantiated_metas t clenv =
@@ -652,13 +652,13 @@ let error_uninstantiated_metas t clenv =
 
 let clenv_refine_in with_evars ?(with_classes=true) id clenv gl =
   let clenv = clenv_pose_dependent_evars with_evars clenv in
-  let clenv = 
-    if with_classes then 
+  let clenv =
+    if with_classes then
       { clenv with evd = Typeclasses.resolve_typeclasses ~fail:(not with_evars) clenv.env clenv.evd }
     else clenv
   in
   let new_hyp_typ = clenv_type clenv in
-  if not with_evars & occur_meta new_hyp_typ then 
+  if not with_evars & occur_meta new_hyp_typ then
     error_uninstantiated_metas new_hyp_typ clenv;
   let new_hyp_prf = clenv_value clenv in
   tclTHEN
@@ -672,40 +672,40 @@ let clenv_refine_in with_evars ?(with_classes=true) id clenv gl =
 (********************************************)
 
 let last_arg c = match kind_of_term c with
-  | App (f,cl) ->  
+  | App (f,cl) ->
       array_last cl
   | _ -> anomaly "last_arg"
 
 let elim_flags = {
-  modulo_conv_on_closed_terms = Some full_transparent_state; 
+  modulo_conv_on_closed_terms = Some full_transparent_state;
   use_metas_eagerly = true;
   modulo_delta = empty_transparent_state;
   resolve_evars = false;
   use_evars_pattern_unification = true;
 }
 
-let elimination_clause_scheme with_evars allow_K elimclause indclause gl = 
-  let indmv = 
+let elimination_clause_scheme with_evars allow_K elimclause indclause gl =
+  let indmv =
     (match kind_of_term (last_arg elimclause.templval.rebus) with
        | Meta mv -> mv
        | _  -> errorlabstrm "elimination_clause"
-             (str "The type of elimination clause is not well-formed.")) 
+             (str "The type of elimination clause is not well-formed."))
   in
-  let elimclause' = clenv_fchain ~flags:elim_flags indmv elimclause indclause in 
+  let elimclause' = clenv_fchain ~flags:elim_flags indmv elimclause indclause in
   res_pf elimclause' ~with_evars:with_evars ~allow_K:allow_K ~flags:elim_flags
     gl
 
-(* 
- * Elimination tactic with bindings and using an arbitrary 
- * elimination constant called elimc. This constant should end 
+(*
+ * Elimination tactic with bindings and using an arbitrary
+ * elimination constant called elimc. This constant should end
  * with a clause (x:I)(P .. ), where P is a bound variable.
- * The term c is of type t, which is a product ending with a type 
- * matching I, lbindc are the expected terms for c arguments 
+ * The term c is of type t, which is a product ending with a type
+ * matching I, lbindc are the expected terms for c arguments
  *)
 
 let general_elim_clause_gen elimtac indclause (elimc,lbindelimc) gl =
   let elimt      = pf_type_of gl elimc in
-  let elimclause = make_clenv_binding gl (elimc,elimt) lbindelimc in 
+  let elimclause = make_clenv_binding gl (elimc,elimt) lbindelimc in
     elimtac elimclause indclause gl
 
 let general_elim_clause elimtac (c,lbindc) (elimc,lbindelimc) gl =
@@ -717,14 +717,14 @@ let general_elim_clause elimtac (c,lbindc) (elimc,lbindelimc) gl =
 let general_elim with_evars c e ?(allow_K=true) =
   general_elim_clause (elimination_clause_scheme with_evars allow_K) c e
 
-(* Elimination tactic with bindings but using the default elimination 
+(* Elimination tactic with bindings but using the default elimination
  * constant associated with the type. *)
 
 let find_eliminator c gl =
   let (ind,t) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
   lookup_eliminator ind (elimination_sort_of_goal gl)
 
-let default_elim with_evars (c,_ as cx) gl = 
+let default_elim with_evars (c,_ as cx) gl =
   general_elim with_evars cx (find_eliminator c gl,NoBindings) gl
 
 let elim_in_context with_evars c = function
@@ -759,20 +759,20 @@ let clenv_fchain_in id elim_flags mv elimclause hypclause =
     raise (PretypeError (env,NoOccurrenceFound (op,Some id)))
 
 let elimination_in_clause_scheme with_evars id elimclause indclause gl =
-  let (hypmv,indmv) = 
+  let (hypmv,indmv) =
     match clenv_independent elimclause with
         [k1;k2] -> (k1,k2)
       | _  -> errorlabstrm "elimination_clause"
           (str "The type of elimination clause is not well-formed.") in
-  let elimclause'  = clenv_fchain indmv elimclause indclause in 
+  let elimclause'  = clenv_fchain indmv elimclause indclause in
   let hyp = mkVar id in
   let hyp_typ = pf_type_of gl hyp in
   let hypclause = mk_clenv_from_n gl (Some 0) (hyp, hyp_typ) in
-  let elimclause'' = 
+  let elimclause'' =
     clenv_fchain_in id elim_flags hypmv elimclause' hypclause in
   let new_hyp_typ  = clenv_type elimclause'' in
   if eq_constr hyp_typ new_hyp_typ then
-    errorlabstrm "general_rewrite_in" 
+    errorlabstrm "general_rewrite_in"
       (str "Nothing to rewrite in " ++ pr_id id ++ str".");
   clenv_refine_in with_evars id elimclause'' gl
 
@@ -784,9 +784,9 @@ let general_elim_in with_evars id =
 let general_case_analysis_in_context with_evars (c,lbindc) gl =
   let (mind,_) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
   let sort     = elimination_sort_of_goal gl in
-  let case = 
+  let case =
     if occur_term c (pf_concl gl) then make_case_dep else make_case_gen in
-  let elim     = pf_apply case gl mind sort in 
+  let elim     = pf_apply case gl mind sort in
   general_elim with_evars (c,lbindc) (elim,NoBindings) gl
 
 let general_case_analysis with_evars (c,lbindc as cx) =
@@ -799,7 +799,7 @@ let general_case_analysis with_evars (c,lbindc as cx) =
 
 let simplest_case c = general_case_analysis false (c,NoBindings)
 
-(* Apply a tactic below the products of the conclusion of a lemma *) 
+(* Apply a tactic below the products of the conclusion of a lemma *)
 
 let descend_in_conjunctions with_evars tac exit c gl =
   try
@@ -830,18 +830,18 @@ let descend_in_conjunctions with_evars tac exit c gl =
 
 let check_evars sigma evm gl =
   let origsigma = gl.sigma in
-  let rest = 
-    Evd.fold (fun ev evi acc -> 
-      if not (Evd.mem origsigma ev) && not (Evd.is_defined sigma ev) 
+  let rest =
+    Evd.fold (fun ev evi acc ->
+      if not (Evd.mem origsigma ev) && not (Evd.is_defined sigma ev)
       then Evd.add acc ev evi else acc)
       evm Evd.empty
-  in 
+  in
   if rest <> Evd.empty then
-    errorlabstrm "apply" (str"Uninstantiated existential variables: " ++ 
+    errorlabstrm "apply" (str"Uninstantiated existential variables: " ++
       fnl () ++ pr_evar_defs rest)
 
 let general_apply with_delta with_destruct with_evars (loc,(c,lbind)) gl0 =
-  let flags = 
+  let flags =
     if with_delta then default_unify_flags else default_no_delta_unify_flags in
   (* The actual type of the theorem. It will be matched against the
   goal. If this fails, then the head constant will be unfolded step by
@@ -861,13 +861,13 @@ let general_apply with_delta with_destruct with_evars (loc,(c,lbind)) gl0 =
       try try_apply thm_ty0 concl_nprod
       with PretypeError _|RefinerError _|UserError _|Failure _ as exn ->
 	let rec try_red_apply thm_ty =
-	  try 
+	  try
             (* Try to head-reduce the conclusion of the theorem *)
             let red_thm = try_red_product (pf_env gl) (project gl) thm_ty in
               try try_apply red_thm concl_nprod
               with PretypeError _|RefinerError _|UserError _|Failure _ ->
 		try_red_apply red_thm
-	  with Redelimination -> 
+	  with Redelimination ->
             (* Last chance: if the head is a variable, apply may try
 	       second order unification *)
 	    try if concl_nprod <> 0 then try_apply thm_ty 0 else raise Exit
@@ -877,7 +877,7 @@ let general_apply with_delta with_destruct with_evars (loc,(c,lbind)) gl0 =
                   try_main_apply (fun _ -> Stdpp.raise_with_loc loc exn) c gl
 	      else
 		Stdpp.raise_with_loc loc exn
-	in try_red_apply thm_ty0 
+	in try_red_apply thm_ty0
   in
     if evm = Evd.empty then try_main_apply with_destruct c gl0
     else
@@ -889,7 +889,7 @@ let rec apply_with_ebindings_gen b e = function
   | [] ->
       tclIDTAC
   | [cb] -> general_apply b b e cb
-  | cb::cbl -> 
+  | cb::cbl ->
       tclTHENLAST (general_apply b b e cb) (apply_with_ebindings_gen b e cbl)
 
 let apply_with_ebindings cb = apply_with_ebindings_gen false false [dloc,cb]
@@ -907,7 +907,7 @@ let apply c =
 let eapply c =
   eapply_with_ebindings (inj_open c,NoBindings)
 
-let apply_list = function 
+let apply_list = function
   | c::l -> apply_with_bindings (c,ImplicitBindings l)
   | _ -> assert false
 
@@ -943,12 +943,12 @@ let apply_in_once_main flags innerclause (d,lbind) gl =
     try progress_with_clause flags innerclause clause
     with err ->
     try aux (clenv_push_prod clause)
-    with NotExtensibleClause -> raise err in 
+    with NotExtensibleClause -> raise err in
   aux (make_clenv_binding gl (d,thm) lbind)
 
-let apply_in_once with_delta with_destruct with_evars id 
+let apply_in_once with_delta with_destruct with_evars id
   (loc,((sigma,d),lbind)) gl0 =
-  let flags = 
+  let flags =
     if with_delta then default_unify_flags else default_no_delta_unify_flags in
   let t' = pf_get_hyp_typ gl0 id in
   let innerclause = mk_clenv_from_n gl0 (Some 0) (mkVar id,t') in
@@ -986,7 +986,7 @@ let apply_in_once with_delta with_destruct with_evars id
 *)
 
 let cut_and_apply c gl =
-  let goal_constr = pf_concl gl in 
+  let goal_constr = pf_concl gl in
     match kind_of_term (pf_hnf_constr gl (pf_type_of gl c)) with
       | Prod (_,c1,c2) when not (dependent (mkRel 1) c2) ->
 	  tclTHENLAST
@@ -1001,14 +1001,14 @@ let cut_and_apply c gl =
 let exact_check c gl =
   let concl = (pf_concl gl) in
   let ct = pf_type_of gl c in
-  if pf_conv_x_leq gl ct concl then  
-    refine_no_check c gl 
-  else 
+  if pf_conv_x_leq gl ct concl then
+    refine_no_check c gl
+  else
     error "Not an exact proof."
 
 let exact_no_check = refine_no_check
 
-let vm_cast_no_check c gl = 
+let vm_cast_no_check c gl =
   let concl = pf_concl gl in
   refine_no_check (Term.mkCast(c,Term.VMcast,concl)) gl
 
@@ -1016,16 +1016,16 @@ let vm_cast_no_check c gl =
 let exact_proof c gl =
   (* on experimente la synthese d'ise dans exact *)
   let c = Constrintern.interp_casted_constr (project gl) (pf_env gl) c (pf_concl gl)
-  in refine_no_check c gl 
+  in refine_no_check c gl
 
 let (assumption : tactic) = fun gl ->
-  let concl =  pf_concl gl in 
+  let concl =  pf_concl gl in
   let hyps = pf_hyps gl in
   let rec arec only_eq = function
-    | [] -> 
+    | [] ->
         if only_eq then arec false hyps else error "No such assumption."
-    | (id,c,t)::rest -> 
-	if (only_eq & eq_constr t concl) 
+    | (id,c,t)::rest ->
+	if (only_eq & eq_constr t concl)
           or (not only_eq & pf_conv_x_leq gl t concl)
         then refine_no_check (mkVar id) gl
 	else arec only_eq rest
@@ -1037,9 +1037,9 @@ let (assumption : tactic) = fun gl ->
 (*****************************************************************)
 
 (* This tactic enables the user to remove hypotheses from the signature.
- * Some care is taken to prevent him from removing variables that are 
- * subsequently used in other hypotheses or in the conclusion of the  
- * goal. *)                                                               
+ * Some care is taken to prevent him from removing variables that are
+ * subsequently used in other hypotheses or in the conclusion of the
+ * goal. *)
 
 let clear ids = (* avant seul dyn_clear n'echouait pas en [] *)
   if ids=[] then tclIDTAC else thin ids
@@ -1055,7 +1055,7 @@ let clear_wildcards ids =
         (error_clear_dependency (pf_env gl) (id_of_string "_") err))
     ids
 
-(*   Takes a list of booleans, and introduces all the variables 
+(*   Takes a list of booleans, and introduces all the variables
  *  quantified in the goal which are associated with a value
  *  true  in the boolean list. *)
 
@@ -1069,38 +1069,38 @@ let rec intros_clearing = function
 (* Modifying/Adding an hypothesis  *)
 
 let specialize mopt (c,lbind) g =
-  let evars, term = 
-    if lbind = NoBindings then None, c 
-    else 
+  let evars, term =
+    if lbind = NoBindings then None, c
+    else
       let clause = make_clenv_binding g (c,pf_type_of g c) lbind in
       let clause = clenv_unify_meta_types clause in
       let (thd,tstack) =
         whd_stack clause.evd (clenv_value clause) in
       let nargs = List.length tstack in
-      let tstack = match mopt with 
-	| Some m -> 
+      let tstack = match mopt with
+	| Some m ->
 	    if m < nargs then list_firstn m tstack else tstack
-	| None -> 
-	    let rec chk = function 
+	| None ->
+	    let rec chk = function
 	      | [] -> []
 	      | t::l -> if occur_meta t then [] else t :: chk l
 	    in chk tstack
-      in 
-      let term = applist(thd,tstack) in 
+      in
+      let term = applist(thd,tstack) in
       if occur_meta term then
 	errorlabstrm "" (str "Cannot infer an instance for " ++
           pr_name (meta_name clause.evd (List.hd (collect_metas term))) ++
 	  str ".");
       Some clause.evd, term
   in
-  tclTHEN 
+  tclTHEN
     (match evars with Some e -> tclEVARS e | _ -> tclIDTAC)
     (match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
        | Var id when List.mem id (pf_ids_of_hyps g) ->
 	     tclTHENFIRST
 	       (fun g -> internal_cut_replace id (pf_type_of g term) g)
 	       (exact_no_check term)
-       | _ -> tclTHENLAST 
+       | _ -> tclTHENLAST
                  (fun g -> cut (pf_type_of g term) g)
                  (exact_no_check term))
     g
@@ -1126,7 +1126,7 @@ let keep hyps gl =
 
 let check_number_of_constructors expctdnumopt i nconstr =
   if i=0 then error "The constructors are numbered starting from 1.";
-  begin match expctdnumopt with 
+  begin match expctdnumopt with
     | Some n when n <> nconstr ->
 	error ("Not an inductive goal with "^
 	       string_of_int n^plural n " constructor"^".")
@@ -1135,20 +1135,20 @@ let check_number_of_constructors expctdnumopt i nconstr =
   if i > nconstr then error "Not enough constructors."
 
 let constructor_tac with_evars expctdnumopt i lbind gl =
-  let cl = pf_concl gl in 
-  let (mind,redcl) = pf_reduce_to_quantified_ind gl cl in 
+  let cl = pf_concl gl in
+  let (mind,redcl) = pf_reduce_to_quantified_ind gl cl in
   let nconstr =
     Array.length (snd (Global.lookup_inductive mind)).mind_consnames in
   check_number_of_constructors expctdnumopt i nconstr;
   let cons = mkConstruct (ith_constructor_of_inductive mind i) in
   let apply_tac =
     general_apply true false with_evars (dloc,(inj_open cons,lbind)) in
-  (tclTHENLIST 
+  (tclTHENLIST
      [convert_concl_no_check redcl DEFAULTcast; intros; apply_tac]) gl
 
 let one_constructor i = constructor_tac false None i
 
-(* Try to apply the constructor of the inductive definition followed by 
+(* Try to apply the constructor of the inductive definition followed by
    a tactic t given as an argument.
    Should be generalize in Constructor (Fun c : I -> tactic)
  *)
@@ -1161,7 +1161,7 @@ let any_constructor with_evars tacopt gl =
   if nconstr = 0 then error "The type has no constructors.";
   tclFIRST
     (List.map
-      (fun i -> tclTHEN (constructor_tac with_evars None i NoBindings) t) 
+      (fun i -> tclTHEN (constructor_tac with_evars None i NoBindings) t)
       (interval 1 nconstr)) gl
 
 let left_with_ebindings  with_evars = constructor_tac with_evars (Some 2) 1
@@ -1246,9 +1246,9 @@ let rewrite_hyp l2r id gl =
 let rec explicit_intro_names = function
 | (_, IntroIdentifier id) :: l ->
     id :: explicit_intro_names l
-| (_, (IntroWildcard | IntroAnonymous | IntroFresh _ 
+| (_, (IntroWildcard | IntroAnonymous | IntroFresh _
       | IntroRewrite _ | IntroForthcoming _)) :: l -> explicit_intro_names l
-| (_, IntroOrAndPattern ll) :: l' -> 
+| (_, IntroOrAndPattern ll) :: l' ->
     List.flatten (List.map (fun l -> explicit_intro_names (l@l')) ll)
 | [] ->
     []
@@ -1259,7 +1259,7 @@ let rec explicit_intro_names = function
      the tactic, for the hyps to clear *)
 let rec intros_patterns b avoid thin destopt = function
   | (loc, IntroWildcard) :: l ->
-      tclTHEN 
+      tclTHEN
         (intro_gen loc (IntroAvoid(avoid@explicit_intro_names l))
 	  no_move true false)
         (onLastHypId (fun id ->
@@ -1292,7 +1292,7 @@ let rec intros_patterns b avoid thin destopt = function
 	  (intro_or_and_pattern loc b ll l'
 	    (intros_patterns b avoid thin destopt)))
   | (loc, IntroRewrite l2r) :: l ->
-      tclTHEN 
+      tclTHEN
         (intro_gen loc (IntroAvoid(avoid@explicit_intro_names l))
 	  no_move true false)
         (onLastHypId (fun id ->
@@ -1305,7 +1305,7 @@ let intros_pattern = intros_patterns false [] []
 
 let intro_pattern destopt pat = intros_patterns false [] [] destopt [dloc,pat]
 
-let intro_patterns = function 
+let intro_patterns = function
   | [] -> tclREPEAT intro
   | l  -> intros_pattern no_move l
 
@@ -1322,12 +1322,12 @@ let prepare_intros s ipat gl = match ipat with
   | IntroAnonymous -> make_id s gl, tclIDTAC
   | IntroFresh id -> fresh_id [] id gl, tclIDTAC
   | IntroWildcard -> let id = make_id s gl in id, clear_wildcards [dloc,id]
-  | IntroRewrite l2r -> 
+  | IntroRewrite l2r ->
       let id = make_id s gl in
       id, !forward_general_multi_rewrite l2r false (inj_open (mkVar id),NoBindings) allHypsAndConcl
   | IntroOrAndPattern ll -> make_id s gl,
       onLastHypId
-	(intro_or_and_pattern loc true ll [] 
+	(intro_or_and_pattern loc true ll []
 	  (intros_patterns true [] [] no_move))
   | IntroForthcoming _ -> user_err_loc
       (loc,"",str "Introduction pattern for one hypothesis expected")
@@ -1357,13 +1357,13 @@ let assert_tac na = assert_as true (ipat_of_name na)
 (* apply in as *)
 
 let as_tac id ipat = match ipat with
-  | Some (loc,IntroRewrite l2r) -> 
+  | Some (loc,IntroRewrite l2r) ->
       !forward_general_multi_rewrite l2r false (inj_open (mkVar id),NoBindings) allHypsAndConcl
   | Some (loc,IntroOrAndPattern ll) ->
       intro_or_and_pattern loc true ll [] (intros_patterns true [] [] no_move)
         id
   | Some (loc,
-      (IntroIdentifier _ | IntroAnonymous | IntroFresh _ | 
+      (IntroIdentifier _ | IntroAnonymous | IntroFresh _ |
        IntroWildcard | IntroForthcoming _)) ->
       user_err_loc (loc,"", str "Disjunctive/conjunctive pattern expected")
   | None -> tclIDTAC
@@ -1376,7 +1376,7 @@ let general_apply_in with_delta with_destruct with_evars id lemmas ipat gl =
 
 let apply_in simple with_evars = general_apply_in simple simple with_evars
 
-let simple_apply_in id c = 
+let simple_apply_in id c =
   apply_in false false id [dloc,((Evd.empty,c),NoBindings)] None
 
 (**************************)
@@ -1386,16 +1386,16 @@ let simple_apply_in id c =
 let generalized_name c t ids cl = function
   | Name id as na ->
       if List.mem id ids then
-	errorlabstrm "" (pr_id id ++ str " is already used"); 
+	errorlabstrm "" (pr_id id ++ str " is already used");
       na
-  | Anonymous -> 
+  | Anonymous ->
       match kind_of_term c with
       | Var id ->
 	 (* Keep the name even if not occurring: may be used by intros later *)
 	  Name id
       | _ ->
 	  if noccurn 1 cl then Anonymous else
-	    (* On ne s'etait pas casse la tete : on avait pris pour nom de 
+	    (* On ne s'etait pas casse la tete : on avait pris pour nom de
                variable la premiere lettre du type, meme si "c" avait ete une
                constante dont on aurait pu prendre directement le nom *)
 	    named_hd (Global.env()) t Anonymous
@@ -1415,9 +1415,9 @@ let generalize_dep c gl =
   let init_ids = ids_of_named_context (Global.named_context()) in
   let rec seek d toquant =
     if List.exists (fun (id,_,_) -> occur_var_in_decl env id d) toquant
-      or dependent_in_decl c d then 
+      or dependent_in_decl c d then
       d::toquant
-    else 
+    else
       toquant in
   let to_quantify = Sign.fold_named_context seek sign ~init:[] in
   let to_quantify_rev = List.rev to_quantify in
@@ -1445,7 +1445,7 @@ let generalize_gen lconstr gl =
 let generalize l =
   generalize_gen (List.map (fun c -> ((all_occurrences,c),Anonymous)) l)
 
-let revert hyps gl = 
+let revert hyps gl =
   tclTHEN (generalize (List.map mkVar hyps)) (clear hyps) gl
 
 (* Faudra-t-il une version avec plusieurs args de generalize_dep ?
@@ -1454,7 +1454,7 @@ Cela peut-être troublant de faire "Generalize Dependent H n" dans
 généralisation dépendante par n.
 
 let quantify lconstr =
- List.fold_right 
+ List.fold_right
    (fun com tac -> tclTHEN tac (tactic_com generalize_dep c))
    lconstr
    tclIDTAC
@@ -1520,13 +1520,13 @@ let letin_abstract id c occs gl =
 		if not (in_every_hyp occs)
 		then raise (RefinerError (DoesNotOccurIn (c,hyp)))
 		else raise Not_found
-              else 
+              else
 		(subst1_named_decl (mkVar id) newdecl, true)
-	with Not_found -> 
+	with Not_found ->
 	  (d,List.exists
 	      (fun ((id,_,_),dep) -> dep && occur_var_in_decl env id d) ctxt)
     in d'::ctxt
-  in 
+  in
   let ctxt' = fold_named_context compute_dependency env ~init:[] in
   let compute_marks ((depdecls,marks as accu),lhyp) ((hyp,_,_) as d,b) =
     if b then ((d::depdecls,(hyp,lhyp)::marks), lhyp)
@@ -1544,7 +1544,7 @@ let letin_tac with_eq name c occs gl =
     if name = Anonymous then fresh_id [] x gl else
       if not (mem_named_context x (pf_hyps gl)) then x else
 	error ("The variable "^(string_of_id x)^" is already declared") in
-  let (depdecls,marks,ccl)= letin_abstract id c occs gl in 
+  let (depdecls,marks,ccl)= letin_abstract id c occs gl in
   let t = pf_type_of gl c in
   let tmpcl = List.fold_right mkNamedProd_or_LetIn depdecls ccl in
   let args = Array.to_list (instance_from_named_context depdecls) in
@@ -1569,11 +1569,11 @@ let letin_abstract id c (occs,check_occs) gl =
       | Some occ ->
           let newdecl = subst_term_occ_decl occ c d in
           if occ = (all_occurrences,InHyp) & d = newdecl then
-	    if check_occs & not (in_every_hyp occs) 
+	    if check_occs & not (in_every_hyp occs)
 	    then raise (RefinerError (DoesNotOccurIn (c,hyp)))
 	    else depdecls
-          else 
-	    (subst1_named_decl (mkVar id) newdecl)::depdecls in 
+          else
+	    (subst1_named_decl (mkVar id) newdecl)::depdecls in
   let depdecls = fold_named_context compute_dependency env ~init:[] in
   let ccl = match occurrences_of_goal occs with
     | None -> pf_concl gl
@@ -1588,7 +1588,7 @@ let letin_tac_gen with_eq name c ty occs gl =
     if name = Anonymous then fresh_id [] x gl else
       if not (mem_named_context x (pf_hyps gl)) then x else
 	error ("The variable "^(string_of_id x)^" is already declared.") in
-  let (depdecls,lastlhyp,ccl)= letin_abstract id c occs gl in 
+  let (depdecls,lastlhyp,ccl)= letin_abstract id c occs gl in
   let t = match ty with Some t -> t | None -> pf_type_of gl c in
   let newcl,eq_tac = match with_eq with
     | Some (lr,(loc,ido)) ->
@@ -1619,10 +1619,10 @@ let letin_tac with_eq name c ty occs =
 (* Tactics "pose proof" (usetac=None) and "assert" (otherwise) *)
 let forward usetac ipat c gl =
   match usetac with
-  | None -> 
+  | None ->
       let t = pf_type_of gl c in
       tclTHENFIRST (assert_as true ipat t) (exact_no_check c) gl
-  | Some tac -> 
+  | Some tac ->
       tclTHENFIRST (assert_as true ipat c) tac gl
 
 let pose_proof na c = forward None (ipat_of_name na) c
@@ -1663,7 +1663,7 @@ let unfold_all x gl =
 
 (*
  * A "natural" induction tactic
- * 
+ *
   - [H0:T0, ..., Hi:Ti, hyp0:P->I(args), Hi+1:Ti+1, ..., Hn:Tn |-G] is the goal
   - [hyp0] is the induction hypothesis
   - we extract from [args] the variables which are not rigid parameters
@@ -1695,13 +1695,13 @@ let unfold_all x gl =
 
 let check_unused_names names =
   if names <> [] & Flags.is_verbose () then
-    msg_warning 
+    msg_warning
       (str"Unused introduction " ++ str (plural (List.length names) "pattern")
        ++ str": " ++ prlist_with_sep spc pr_intro_pattern names)
 
 let rec first_name_buggy avoid gl (loc,pat) = match pat with
   | IntroOrAndPattern [] -> no_move
-  | IntroOrAndPattern ([]::l) -> 
+  | IntroOrAndPattern ([]::l) ->
       first_name_buggy avoid gl (loc,IntroOrAndPattern l)
   | IntroOrAndPattern ((p::_)::_) -> first_name_buggy avoid gl p
   | IntroWildcard -> no_move
@@ -1766,7 +1766,7 @@ let induct_discharge statuslists destopt avoid' (avoid,ra) names gl =
           (peel_tac ra' names tophyp) gl
     | (RecArg,dep,recvarname) :: ra' ->
         let pat,names = consume_pattern avoid recvarname dep gl names in
-	tclTHEN (intros_patterns true avoid [] (update destopt tophyp) [pat]) 
+	tclTHEN (intros_patterns true avoid [] (update destopt tophyp) [pat])
           (peel_tac ra' names tophyp) gl
     | (OtherArg,_,_) :: ra' ->
         let pat,names = match names with
@@ -1816,7 +1816,7 @@ let atomize_param_of_ind (indref,nparams) hyp0 gl =
 	    tclTHEN
 	      (letin_tac None (Name x) c None allHypsAndConcl)
 	      (atomize_one (i-1) ((mkVar x)::avoid)) gl
-    else 
+    else
       tclIDTAC gl
   in
   atomize_one (List.length argl) params gl
@@ -1834,7 +1834,7 @@ let find_atomic_param_of_ind nparams indtyp =
       | _ -> ()
   done;
   Idset.elements !indvars;
-  
+
 
 (* [cook_sign] builds the lists [indhyps] of hyps that must be
    erased, the lists of hyps to be generalize [(hdeps,tdeps)] on the
@@ -1853,7 +1853,7 @@ let find_atomic_param_of_ind nparams indtyp =
    To summarize, the situation looks like this
 
    Goal(n,x) -| H6:(Q n); x:A; H5:True; H4:(le O n); H3:(P n); H2:True; n:nat
-                Left                                                    Right 
+                Left                                                    Right
 
    Induction hypothesis is H4 ([hyp0])
    Variable parameters of (le O n) is the singleton list with "n" ([indvars])
@@ -1887,7 +1887,7 @@ let find_atomic_param_of_ind nparams indtyp =
    would have posed no problem. But for uniformity, we decided to use
    the right hyp for all hyps on the right of H4.
 
-   Others solutions are welcome 
+   Others solutions are welcome
 
    PC 9 fev 06: Adapted to accept multi argument principle with no
    main arg hyp. hyp0 is now optional, meaning that it is possible
@@ -1917,15 +1917,15 @@ let cook_sign hyp0_opt indvars env =
   let before = ref true in
   let seek_deps env (hyp,_,_ as decl) rhyp =
     if hyp = hyp0 then begin
-      before:=false; 
+      before:=false;
       (* If there was no main induction hypotheses, then hyp is one of
          indvars too, so add it to indhyps. *)
-      (if hyp0_opt=None then indhyps := hyp::!indhyps); 
+      (if hyp0_opt=None then indhyps := hyp::!indhyps);
       MoveToEnd false (* fake value *)
     end else if List.mem hyp indvars then begin
       (* warning: hyp can still occur after induction *)
       (* e.g. if the goal (t hyp hyp0) with other occs of hyp in t *)
-      indhyps := hyp::!indhyps; 
+      indhyps := hyp::!indhyps;
       rhyp
     end else
       if inhyps <> [] && List.mem hyp inhyps || inhyps = [] &&
@@ -1933,9 +1933,9 @@ let cook_sign hyp0_opt indvars env =
          List.exists (fun (id,_,_) -> occur_var_in_decl env id decl) !decldeps)
       then begin
 	decldeps := decl::!decldeps;
-	if !before then 
+	if !before then
 	  rstatus := (hyp,rhyp)::!rstatus
-	else 
+	else
 	  ldeps := hyp::!ldeps; (* status computed in 2nd phase *)
 	MoveBefore hyp end
       else
@@ -1951,8 +1951,8 @@ let cook_sign hyp0_opt indvars env =
     end else
       if List.mem hyp !indhyps then lhyp else MoveAfter hyp
   in
-  try 
-    let _ = 
+  try
+    let _ =
       fold_named_context_reverse compute_lstatus ~init:(MoveToEnd true) env in
     raise (Shunt (MoveToEnd true)) (* ?? FIXME *)
   with Shunt lhyp0 ->
@@ -1963,7 +1963,7 @@ let cook_sign hyp0_opt indvars env =
 
 (*
    The general form of an induction principle is the following:
-   
+
    forall prm1 prm2 ... prmp,                          (induction parameters)
    forall Q1...,(Qi:Ti_1 -> Ti_2 ->...-> Ti_ni),...Qq, (predicates)
    branch1, branch2, ... , branchr,                    (branches of the principle)
@@ -1972,7 +1972,7 @@ let cook_sign hyp0_opt indvars env =
    -> (Qi x1...xni HI        (f prm1...prmp x1...xni)).(conclusion)
                    ^^        ^^^^^^^^^^^^^^^^^^^^^^^^
                optional        optional argument added if
-               even if HI    principle generated by functional 
+               even if HI    principle generated by functional
              present above   induction, only if HI does not exist
              [indarg]                  [farg]
 
@@ -1985,7 +1985,7 @@ let cook_sign hyp0_opt indvars env =
 
 (* [rel_contexts] and [rel_declaration] actually contain triples, and
    lists are actually in reverse order to fit [compose_prod]. *)
-type elim_scheme = { 
+type elim_scheme = {
   elimc: constr with_ebindings option;
   elimt: types;
   indref: global_reference option;
@@ -1994,19 +1994,19 @@ type elim_scheme = {
   predicates: rel_context; (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;        (* Number of predicates *)
   branches: rel_context;   (* branchr,...,branch1 *)
-  nbranches: int;          (* Number of branches *) 
+  nbranches: int;          (* Number of branches *)
   args: rel_context;       (* (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;              (* number of arguments *)
-  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni) 
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni)
 				     if HI is in premisses, None otherwise *)
-  concl: types;            (* Qi x1...xni HI (f...), HI and (f...) 
+  concl: types;            (* Qi x1...xni HI (f...), HI and (f...)
 			      are optional and mutually exclusive *)
   indarg_in_concl: bool;   (* true if HI appears at the end of conclusion *)
   farg_in_concl: bool;     (* true if (f...) appears at the end of conclusion *)
 }
 
-let empty_scheme = 
-  { 
+let empty_scheme =
+  {
     elimc = None;
     elimt = mkProp;
     indref = None;
@@ -2028,12 +2028,12 @@ let empty_scheme =
 (* Unification between ((elimc:elimt) ?i ?j ?k ?l ... ?m) and the
    hypothesis on which the induction is made *)
 let induction_tac with_evars (varname,lbind) typ scheme gl =
-  let elimc,lbindelimc = 
+  let elimc,lbindelimc =
     match scheme.elimc with | Some x -> x | None -> error "No definition of the principle." in
   let elimt = scheme.elimt in
   let indclause = make_clenv_binding gl (mkVar varname,typ) lbind  in
   let elimclause =
-    make_clenv_binding gl 
+    make_clenv_binding gl
       (mkCast (elimc,DEFAULTcast, elimt),elimt) lbindelimc in
   elimination_clause_scheme with_evars true elimclause indclause gl
 
@@ -2047,12 +2047,12 @@ let make_base n id =
 (* Builds two different names from an optional inductive type and a
    number, also deals with a list of names to avoid. If the inductive
    type is None, then hyprecname is IHi where i is a number. *)
-let make_up_names n ind_opt cname = 
+let make_up_names n ind_opt cname =
   let is_hyp = atompart_of_id cname = "H" in
   let base = string_of_id (make_base n cname) in
   let ind_prefix = "IH" in
-  let base_ind = 
-    if is_hyp then 
+  let base_ind =
+    if is_hyp then
       match ind_opt with
 	| None -> id_of_string ind_prefix
 	| Some ind_id -> add_prefix ind_prefix (Nametab.basename_of_global ind_id)
@@ -2073,35 +2073,35 @@ let make_up_names n ind_opt cname =
 
 let is_indhyp p n t =
   let l, c = decompose_prod t in
-  let c,_ = decompose_app c in 
+  let c,_ = decompose_app c in
   let p = p + List.length l in
   match kind_of_term c with
     | Rel k when p < k & k <= p + n -> true
     | _ -> false
 
-let chop_context n l = 
+let chop_context n l =
   let rec chop_aux acc = function
     | n, (_,Some _,_ as h :: t) -> chop_aux (h::acc) (n, t)
     | 0, l2 -> (List.rev acc, l2)
     | n, (h::t) -> chop_aux (h::acc) (n-1, t)
     | _, [] -> anomaly "chop_context"
-  in 
+  in
   chop_aux [] (n,l)
 
 let error_ind_scheme s =
   let s = if s <> "" then s^" " else s in
   error ("Cannot recognize "^s^"an induction scheme.")
 
-let mkEq t x y = 
+let mkEq t x y =
   mkApp (build_coq_eq (), [| t; x; y |])
-    
-let mkRefl t x = 
+
+let mkRefl t x =
   mkApp ((build_coq_eq_data ()).refl, [| t; x |])
 
 let mkHEq t x u y =
   mkApp (coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq",
 	[| t; x; u; y |])
-    
+
 let mkHRefl t x =
   mkApp (coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq_refl",
 	[| t; x |])
@@ -2112,7 +2112,7 @@ let mkHRefl t x =
 (*   let ty = new_Type () in *)
 (*   mkApp (coq_constant "mkHEq" ["Logic";"EqdepFacts"] "eq_dep", *)
 (* 	[| ty; mkApp (Lazy.force id, [|ty|]); t; x; u; y |]) *)
-    
+
 (* let mkHRefl t x =  *)
 (*   let ty = new_Type () in *)
 (*   mkApp (coq_constant "mkHEq" ["Logic";"EqdepFacts"] "eq_dep_intro", *)
@@ -2125,21 +2125,21 @@ let lift_togethern n l =
 	(lift n x :: acc, succ n))
       l ([], n)
   in l'
-      
+
 let lift_together l = lift_togethern 0 l
 
 let lift_list l = List.map (lift 1) l
 
-let ids_of_constr vars c = 
-  let rec aux vars c = 
+let ids_of_constr vars c =
+  let rec aux vars c =
     match kind_of_term c with
     | Var id -> if List.mem id vars then vars else id :: vars
-    | App (f, args) -> 
+    | App (f, args) ->
 	(match kind_of_term f with
-	| Construct (ind,_) 
+	| Construct (ind,_)
 	| Ind ind ->
             let (mib,mip) = Global.lookup_inductive ind in
-	      array_fold_left_from mib.Declarations.mind_nparams 
+	      array_fold_left_from mib.Declarations.mind_nparams
 		aux vars args
 	| _ -> fold_constr aux vars c)
     | _ -> fold_constr aux vars c
@@ -2151,13 +2151,13 @@ let mk_term_eq env sigma ty t ty' t' =
   else
     mkHEq ty t ty' t', mkHRefl ty' t'
 
-let make_abstract_generalize gl id concl dep ctx c eqs args refls = 
+let make_abstract_generalize gl id concl dep ctx c eqs args refls =
   let meta = Evarutil.new_meta() in
   let term, typ = mkVar id, pf_get_hyp_typ gl id (* de Bruijn closed! *) in
   let eqslen = List.length eqs in
     (* Abstract by the "generalized" hypothesis equality proof if necessary. *)
-  let abshypeq, abshypt = 
-    if dep then 
+  let abshypeq, abshypt =
+    if dep then
       let eq, refl = mk_term_eq (push_rel_context ctx (pf_env gl)) (project gl) (lift 1 c) (mkRel 1) typ term in
 	mkProd (Anonymous, eq, lift 1 concl), [| refl |]
     else concl, [||]
@@ -2170,7 +2170,7 @@ let make_abstract_generalize gl id concl dep ctx c eqs args refls =
     (* Abstract by the extension of the context *)
   let genctyp = it_mkProd_or_LetIn ~init:genarg ctx in
     (* The goal will become this product. *)
-  let genc = mkCast (mkMeta meta, DEFAULTcast, genctyp) in      
+  let genc = mkCast (mkMeta meta, DEFAULTcast, genctyp) in
     (* Apply the old arguments giving the proper instantiation of the hyp *)
   let instc = mkApp (genc, Array.of_list args) in
     (* Then apply to the original instanciated hyp. *)
@@ -2179,20 +2179,20 @@ let make_abstract_generalize gl id concl dep ctx c eqs args refls =
   let appeqs = mkApp (instc, Array.of_list refls) in
     (* Finaly, apply the reflexivity proof for the original hyp, to get a term of type gl again. *)
     mkApp (appeqs, abshypt)
-      
-let abstract_args gl id = 
+
+let abstract_args gl id =
   let c = pf_get_hyp_typ gl id in
   let sigma = project gl in
   let env = pf_env gl in
   let concl = pf_concl gl in
   let dep = dependent (mkVar id) concl in
   let avoid = ref [] in
-  let get_id name = 
-    let id = fresh_id !avoid (match name with Name n -> n | Anonymous -> id_of_string "gen_x") gl in 
+  let get_id name =
+    let id = fresh_id !avoid (match name with Name n -> n | Anonymous -> id_of_string "gen_x") gl in
       avoid := id :: !avoid; id
   in
   match kind_of_term c with
-      App (f, args) -> 
+      App (f, args) ->
 	(* Build application generalized w.r.t. the argument plus the necessary eqs.
 	   From env |- c : forall G, T and args : G we build
 	   (T[G'], G' : ctx, env ; G' |- args' : G, eqs := G'_i = G_i, refls : G' = G, vars to generalize)
@@ -2200,7 +2200,7 @@ let abstract_args gl id =
 	   eqs are not lifted w.r.t. each other yet. (* will be needed when going to dependent indexes *)
 	*)
 	let aux (prod, ctx, ctxenv, c, args, eqs, refls, vars, env) arg =
-	  let (name, _, ty), arity = 
+	  let (name, _, ty), arity =
 	    let rel, c = Reductionops.splay_prod_n env sigma 1 prod in
 	      List.hd rel, c
 	  in
@@ -2217,7 +2217,7 @@ let abstract_args gl id =
 		let c' = mkApp (lift 1 c, [|mkRel 1|]) in
 		let args = arg :: args in
 		let liftarg = lift (List.length ctx) arg in
-		let eq, refl = 
+		let eq, refl =
 		  if convertible then
 		    mkEq (lift 1 ty) (mkRel 1) liftarg, mkRefl argty arg
 		  else
@@ -2227,10 +2227,10 @@ let abstract_args gl id =
 		let refls = refl :: refls in
 		let vars = ids_of_constr vars arg in
 		  (arity, ctx, push_rel decl ctxenv, c', args, eqs, refls, vars, env)
-	in 
+	in
 	let f, args =
 	  match kind_of_term f with
-	  | Construct (ind,_) 
+	  | Construct (ind,_)
 	  | Ind ind ->
               let (mib,mip) = Global.lookup_inductive ind in
 	      let first = mib.Declarations.mind_nparams in
@@ -2240,7 +2240,7 @@ let abstract_args gl id =
 	in
 	  (match args with [||] -> None
 	  | _ ->
-	      let arity, ctx, ctxenv, c', args, eqs, refls, vars, env = 
+	      let arity, ctx, ctxenv, c', args, eqs, refls, vars, env =
 		Array.fold_left aux (pf_type_of gl f,[],env,f,[],[],[],[],env) args
 	      in
 	      let args, refls = List.rev args, List.rev refls in
@@ -2254,22 +2254,22 @@ let abstract_generalize id ?(generalize_vars=true) gl =
   let newc = abstract_args gl id in
     match newc with
       | None -> tclIDTAC gl
-      | Some (newc, dep, n, vars) -> 
+      | Some (newc, dep, n, vars) ->
 	  let tac =
 	    if dep then
-	      tclTHENLIST [refine newc; rename_hyp [(id, oldid)]; tclDO n intro; 
-			   generalize_dep (mkVar oldid)]	      
+	      tclTHENLIST [refine newc; rename_hyp [(id, oldid)]; tclDO n intro;
+			   generalize_dep (mkVar oldid)]
 	    else
 	      tclTHENLIST [refine newc; clear [id]; tclDO n intro]
-	  in 
-	    if generalize_vars then tclTHEN tac 
+	  in
+	    if generalize_vars then tclTHEN tac
 	      (tclFIRST [revert (List.rev vars) ;
 			 tclMAP (fun id -> tclTRY (generalize_dep (mkVar id))) vars]) gl
 	    else tac gl
-	      
+
 let dependent_pattern c gl =
   let cty = pf_type_of gl c in
-  let deps = 
+  let deps =
     match kind_of_term cty with
     | App (f, args) -> Array.to_list args
     | _ -> []
@@ -2283,11 +2283,11 @@ let dependent_pattern c gl =
       mkNamedLambda id cty conclvar
   in
   let subst = (c, varname c, cty) :: List.rev_map (fun c -> (c, varname c, pf_type_of gl c)) deps in
-  let concllda = List.fold_left mklambda (pf_concl gl) subst in 
+  let concllda = List.fold_left mklambda (pf_concl gl) subst in
   let conclapp = applistc concllda (List.rev_map pi1 subst) in
     convert_concl_no_check conclapp DEFAULTcast gl
-      
-let occur_rel n c = 
+
+let occur_rel n c =
   let res = not (noccurn n c) in
   res
 
@@ -2330,19 +2330,19 @@ let cut_list n l =
 
 
 (* This function splits the products of the induction scheme [elimt] into four
-   parts: 
+   parts:
    - branches, easily detectable (they are not referred by rels in the subterm)
    - what was found before branches (acc1) that is: parameters and predicates
    - what was found after branches (acc3) that is: args and indarg if any
    if there is no branch, we try to fill in acc3 with args/indargs.
    We also return the conclusion.
 *)
-let decompose_paramspred_branch_args elimt = 
+let decompose_paramspred_branch_args elimt =
   let rec cut_noccur elimt acc2 : rel_context * rel_context * types =
     match kind_of_term elimt with
-      | Prod(nme,tpe,elimt') -> 
+      | Prod(nme,tpe,elimt') ->
 	  let hd_tpe,_ = decompose_app ((strip_prod_assum tpe)) in
-	  if not (occur_rel 1 elimt') && isRel hd_tpe	    
+	  if not (occur_rel 1 elimt') && isRel hd_tpe
 	  then cut_noccur elimt' ((nme,None,tpe)::acc2)
 	  else let acc3,ccl = decompose_prod_assum elimt in acc2 , acc3 , ccl
       | App(_, _) | Rel _ -> acc2 , [] , elimt
@@ -2361,7 +2361,7 @@ let decompose_paramspred_branch_args elimt =
      we must find the predicate of the conclusion to separate params_pred from
      args. We suppose there is only one predicate here. *)
   if List.length acc2 <> 0 then acc1, acc2 , acc3, ccl
-  else 
+  else
     let hyps,ccl = decompose_prod_assum elimt in
     let hd_ccl_pred,_ = decompose_app ccl in
     match kind_of_term hd_ccl_pred with
@@ -2379,7 +2379,7 @@ let exchange_hd_app subst_hd t =
    eliminator by modifying their scheme_info, then rebuild the
    eliminator type, then prove it (with tactics). *)
 let rebuild_elimtype_from_scheme (scheme:elim_scheme): types =
-  let hiconcl = 
+  let hiconcl =
     match scheme.indarg with
       | None -> scheme.concl
       | Some x -> mkProd_or_LetIn x scheme.concl in
@@ -2397,8 +2397,8 @@ exception NoLastArgCcl
    first separate branches.  We obtain branches, hyps before (params + preds),
    hyps after (args <+ indarg if present>) and conclusion.  Then we proceed as
    follows:
-   
-   - separate parameters and predicates in params_preds. For that we build: 
+
+   - separate parameters and predicates in params_preds. For that we build:
  forall (x1:Ti_1)(xni:Ti_ni) (HI:I prm1..prmp x1...xni), DUMMY x1...xni HI/farg
                              ^^^^^^^^^^^^^^^^^^^^^^^^^                  ^^^^^^^
                                        optional                           opt
@@ -2410,28 +2410,28 @@ exception NoLastArgCcl
 
    - finish to fill in the elim_scheme: indarg/farg/args and finally indref. *)
 let compute_elim_sig ?elimc elimt =
-  let params_preds,branches,args_indargs,conclusion = 
+  let params_preds,branches,args_indargs,conclusion =
     decompose_paramspred_branch_args elimt in
-  
+
   let ccl = exchange_hd_app (mkVar (id_of_string "__QI_DUMMY__")) conclusion in
-  let concl_with_args = it_mkProd_or_LetIn ccl args_indargs in  
+  let concl_with_args = it_mkProd_or_LetIn ccl args_indargs in
   let nparams = Intset.cardinal (free_rels concl_with_args) in
   let preds,params = cut_list (List.length params_preds - nparams) params_preds in
-  
+
   (* A first approximation, further analysis will tweak it *)
   let res = ref { empty_scheme with
     (* This fields are ok: *)
     elimc = elimc; elimt = elimt; concl = conclusion;
-    predicates = preds; npredicates = List.length preds; 
-    branches = branches; nbranches = List.length branches; 
+    predicates = preds; npredicates = List.length preds;
+    branches = branches; nbranches = List.length branches;
     farg_in_concl = isApp ccl && isApp (last_arg ccl);
-    params = params; nparams = nparams; 
+    params = params; nparams = nparams;
     (* all other fields are unsure at this point. Including these:*)
     args = args_indargs; nargs = List.length args_indargs; } in
-  try 
+  try
     (* Order of tests below is important. Each of them exits if successful. *)
     (* 1- First see if (f x...) is in the conclusion. *)
-    if !res.farg_in_concl 
+    if !res.farg_in_concl
     then begin
       res := { !res with
 	indarg = None;
@@ -2439,19 +2439,19 @@ let compute_elim_sig ?elimc elimt =
       raise Exit
     end;
     (* 2- If no args_indargs (=!res.nargs at this point) then no indarg *)
-    if !res.nargs=0 then raise Exit; 
+    if !res.nargs=0 then raise Exit;
     (* 3- Look at last arg: is it the indarg? *)
     ignore (
       match List.hd args_indargs with
 	| hiname,Some _,hi -> error_ind_scheme ""
-	| hiname,None,hi -> 
+	| hiname,None,hi ->
 	    let hi_ind, hi_args = decompose_app hi in
 	    let hi_is_ind = (* hi est d'un type globalisable *)
 	      match kind_of_term hi_ind with
-		| Ind (mind,_)  -> true 
-		| Var _ -> true 
-		| Const _ -> true 
-		| Construct _ -> true 
+		| Ind (mind,_)  -> true
+		| Var _ -> true
+		| Const _ -> true
+		| Construct _ -> true
 		| _ -> false in
 	    let hi_args_enough = (* hi a le bon nbre d'arguments *)
 	      List.length hi_args = List.length params + !res.nargs -1 in
@@ -2469,12 +2469,12 @@ let compute_elim_sig ?elimc elimt =
     match !res.indarg with
       | None -> !res (* No indref *)
       | Some ( _,Some _,_) -> error_ind_scheme ""
-      | Some ( _,None,ind) -> 
+      | Some ( _,None,ind) ->
 	  let indhd,indargs = decompose_app ind in
 	  try {!res with indref = Some (global_of_constr indhd) }
 	  with _ -> error "Cannot find the inductive type of the inductive scheme.";;
 
-(* Check that the elimination scheme has a form similar to the 
+(* Check that the elimination scheme has a form similar to the
    elimination schemes built by Coq. Schemes may have the standard
    form computed from an inductive type OR (feb. 2006) a non standard
    form. That is: with no main induction argument and with an optional
@@ -2488,29 +2488,29 @@ let compute_elim_signature elimc elimt names_info ind_type_guess =
   match scheme.indarg with
     | Some (_,Some _,_) -> error "Strange letin, cannot recognize an induction scheme."
     | None -> (* Non standard scheme *)
-	let is_pred n c = 
+	let is_pred n c =
 	  let hd = fst (decompose_app c) in match kind_of_term hd with
 	    | Rel q when n < q & q <= n+scheme.npredicates -> IndArg
 	    | _ when hd = ind_type_guess & not scheme.farg_in_concl -> RecArg
-	    | _ -> OtherArg in 
-	let rec check_branch p c = 
+	    | _ -> OtherArg in
+	let rec check_branch p c =
 	  match kind_of_term c with
 	    | Prod (_,t,c) ->
 		(is_pred p t, dependent (mkRel 1) c) :: check_branch (p+1) c
 	    | LetIn (_,_,_,c) ->
 		(OtherArg, dependent (mkRel 1) c) :: check_branch (p+1) c
 	    | _ when is_pred p c = IndArg -> []
-	    | _ -> raise Exit in 
-	let rec find_branches p lbrch = 
+	    | _ -> raise Exit in
+	let rec find_branches p lbrch =
 	  match lbrch with
 	    | (_,None,t)::brs ->
 		(try
 		  let lchck_brch = check_branch p t in
-		  let n = List.fold_left 
+		  let n = List.fold_left
 		    (fun n (b,_) -> if b=RecArg then n+1 else n) 0 lchck_brch in
-		  let recvarname, hyprecname, avoid = 
+		  let recvarname, hyprecname, avoid =
 		    make_up_names n scheme.indref names_info in
-		  let namesign = 
+		  let namesign =
 		    List.map (fun (b,dep) ->
 		      (b,dep,if b=IndArg then hyprecname else recvarname))
 		      lchck_brch in
@@ -2519,33 +2519,33 @@ let compute_elim_signature elimc elimt names_info ind_type_guess =
 	    | (_,Some _,_)::_ -> error_ind_scheme "the branches of"
 	    | [] -> [] in
 	let indsign = Array.of_list (find_branches 0 (List.rev scheme.branches)) in
-	indsign,scheme	
-	
+	indsign,scheme
+
     | Some ( _,None,ind) -> (* Standard scheme from an inductive type *)
 	let indhd,indargs = decompose_app ind in
-	let is_pred n c = 
+	let is_pred n c =
 	  let hd = fst (decompose_app c) in match kind_of_term hd with
 	    | Rel q when n < q & q <= n+scheme.npredicates -> IndArg
 	    | _ when hd = indhd -> RecArg
 	    | _ -> OtherArg in
 	let rec check_branch p c = match kind_of_term c with
-	  | Prod (_,t,c) -> 
+	  | Prod (_,t,c) ->
 	      (is_pred p t, dependent (mkRel 1) c) :: check_branch (p+1) c
 	  | LetIn (_,_,_,c) ->
 	      (OtherArg, dependent (mkRel 1) c) :: check_branch (p+1) c
 	  | _ when is_pred p c = IndArg -> []
-	  | _ -> raise Exit in 
+	  | _ -> raise Exit in
 	let rec find_branches p lbrch =
 	  match lbrch with
 	    | (_,None,t)::brs ->
 		(try
 		  let lchck_brch = check_branch p t in
-		  let n = List.fold_left 
+		  let n = List.fold_left
 		    (fun n (b,_) -> if b=RecArg then n+1 else n) 0 lchck_brch in
-		  let recvarname, hyprecname, avoid = 
+		  let recvarname, hyprecname, avoid =
 		    make_up_names n scheme.indref names_info in
-		  let namesign = 
-		    List.map (fun (b,dep) -> 
+		  let namesign =
+		    List.map (fun (b,dep) ->
 		      (b,dep,if b=IndArg then hyprecname else recvarname))
 		      lchck_brch in
 		  (avoid,namesign) :: find_branches (p+1) brs
@@ -2555,12 +2555,12 @@ let compute_elim_signature elimc elimt names_info ind_type_guess =
 		(* Check again conclusion *)
 
 		let ccl_arg_ok = is_pred (p + scheme.nargs + 1) f = IndArg in
-		let ind_is_ok = 
-		  list_lastn scheme.nargs indargs 
+		let ind_is_ok =
+		  list_lastn scheme.nargs indargs
 		  = extended_rel_list 0 scheme.args in
 		if not (ccl_arg_ok & ind_is_ok) then
 		  error_ind_scheme "the conclusion of";
-		[] 
+		[]
 	in
 	let indsign = Array.of_list (find_branches 0 (List.rev scheme.branches)) in
 	indsign,scheme
@@ -2575,7 +2575,7 @@ let find_elim_signature isrec elim hyp0 gl =
 	let elimc =
 	  if isrec then lookup_eliminator mind s
 	  else
-	    let case = 
+	    let case =
 	      if dependent_no_evar (mkVar hyp0) (pf_concl gl) then make_case_dep
 	      else make_case_gen in
 	    pf_apply case gl mind s in
@@ -2592,11 +2592,11 @@ let find_elim_signature isrec elim hyp0 gl =
 (* Instantiate all meta variables of elimclause using lid, some elts
    of lid are parameters (first ones), the other are
    arguments. Returns the clause obtained.  *)
-let recolle_clenv scheme lid elimclause gl = 
+let recolle_clenv scheme lid elimclause gl =
   let _,arr = destApp elimclause.templval.rebus in
-  let lindmv = 
+  let lindmv =
     Array.map
-      (fun x -> 
+      (fun x ->
 	match kind_of_term x with
 	  | Meta mv -> mv
 	  | _  -> errorlabstrm "elimination_clause"
@@ -2606,15 +2606,15 @@ let recolle_clenv scheme lid elimclause gl =
   let lidparams,lidargs = cut_list (scheme.nparams) lid in
   let nidargs = List.length lidargs in
   (* parameters correspond to first elts of lid. *)
-  let clauses_params = 
+  let clauses_params =
     list_map_i (fun i id -> mkVar id , pf_get_hyp_typ gl id , lindmv.(i))
       0 lidparams in
   (* arguments correspond to last elts of lid. *)
-  let clauses_args = 
-    list_map_i 
+  let clauses_args =
+    list_map_i
       (fun i id -> mkVar id , pf_get_hyp_typ gl id , lindmv.(nmv-nidargs+i))
       0 lidargs in
-  let clause_indarg = 
+  let clause_indarg =
     match scheme.indarg with
       | None -> []
       | Some (x,_,typx) -> []
@@ -2637,9 +2637,9 @@ let recolle_clenv scheme lid elimclause gl =
    (elimc ?i ?j ?k...?l). This solves partly meta variables (and may
     produce new ones). Then refine with the resulting term with holes.
 *)
-let induction_tac_felim with_evars indvars scheme gl = 
+let induction_tac_felim with_evars indvars scheme gl =
   let elimt = scheme.elimt in
-  let elimc,lbindelimc = 
+  let elimc,lbindelimc =
     match scheme.elimc with | Some x -> x | None -> error "No definition of the principle." in
   (* elimclause contains this: (elimc ?i ?j ?k...?l) *)
   let elimclause =
@@ -2660,7 +2660,7 @@ let apply_induction_in_context isrec hyp0 indsign indvars names induct_tac gl =
     List.fold_left
       (fun a (id,b,_) -> if b = None then (mkVar id)::a else a) [] deps in
   tclTHENLIST
-    [ 
+    [
       (* Generalize dependent hyps (but not args) *)
       if deps = [] then tclIDTAC else apply_type tmpcl deps_cstr;
       (* clear dependent hyps *)
@@ -2668,7 +2668,7 @@ let apply_induction_in_context isrec hyp0 indsign indvars names induct_tac gl =
       (* side-conditions in elim (resp case) schemes come last (resp first) *)
       (if isrec then tclTHENFIRSTn else tclTHENLASTn)
         (tclTHEN induct_tac (tclTRY (thin (List.rev indhyps))))
-	(array_map2 
+	(array_map2
 	  (induct_discharge statlists lhyp0 (List.rev dephyps)) indsign names)
     ]
     gl
@@ -2683,24 +2683,24 @@ let induction_from_context_l isrec with_evars elim_info lid names gl =
   let indsign,scheme = elim_info in
   (* number of all args, counting farg and indarg if present. *)
   let nargs_indarg_farg = scheme.nargs
-    + (if scheme.farg_in_concl then 1 else 0) 
+    + (if scheme.farg_in_concl then 1 else 0)
     + (if scheme.indarg <> None then 1 else 0) in
   (* Number of given induction args must be exact. *)
-  if List.length lid <> nargs_indarg_farg + scheme.nparams then 
+  if List.length lid <> nargs_indarg_farg + scheme.nparams then
       error "Not the right number of arguments given to induction scheme.";
   (* hyp0 is used for re-introducing hyps at the right place afterward.
      We chose the first element of the list of variables on which to
      induct. It is probably the first of them appearing in the
      context. *)
-  let hyp0,indvars,lid_params = 
+  let hyp0,indvars,lid_params =
     match lid with
       | []  -> anomaly "induction_from_context_l"
-      | e::l -> 
+      | e::l ->
 	  let nargs_without_first = nargs_indarg_farg - 1 in
 	  let ivs,lp = cut_list nargs_without_first l in
 	  e, ivs, lp in
   (* terms to patternify we must patternify indarg or farg if present in concl *)
-  let lid_in_pattern = 
+  let lid_in_pattern =
     if scheme.indarg <> None & not scheme.indarg_in_concl then List.rev indvars
     else List.rev (hyp0::indvars) in
   let lidcstr = List.map (fun x -> mkVar x) lid_in_pattern in
@@ -2747,7 +2747,7 @@ let induction_with_atomization_of_ind_arg isrec with_evars elim names (hyp0,lbin
     let indref = match scheme.indref with | None -> assert false | Some x -> x in
     tclTHEN
       (atomize_param_of_ind (indref,scheme.nparams) hyp0)
-      (induction_from_context isrec with_evars elim_info 
+      (induction_from_context isrec with_evars elim_info
 	(hyp0,lbind) names inhyps) gl
 
 (* Induction on a list of induction arguments. Analyse the elim
@@ -2756,8 +2756,8 @@ let induction_with_atomization_of_ind_arg isrec with_evars elim names (hyp0,lbin
 let induction_without_atomization isrec with_evars elim names lid gl =
   let (indsign,scheme as elim_info) =
     find_elim_signature isrec elim (List.hd lid) gl in
-  let awaited_nargs = 
-    scheme.nparams + scheme.nargs 
+  let awaited_nargs =
+    scheme.nparams + scheme.nargs
     + (if scheme.farg_in_concl then 1 else 0)
     + (if scheme.indarg <> None then 1 else 0)
   in
@@ -2787,7 +2787,7 @@ let clear_unselected_context id inhyps cls gl =
   | None -> tclIDTAC gl
   | Some cls ->
       if occur_var (pf_env gl) id (pf_concl gl) &&
-	 cls.concl_occs = no_occurrences_expr 
+	 cls.concl_occs = no_occurrences_expr
       then errorlabstrm ""
 	    (str "Conclusion must be mentioned: it depends on " ++ pr_id id
 	     ++ str ".");
@@ -2809,14 +2809,14 @@ let new_induct_gen isrec with_evars elim (eqname,names) (c,lbind) cls gl =
   | _ -> [] in
   match kind_of_term c with
     | Var id when not (mem_named_context id (Global.named_context()))
-	        & lbind = NoBindings & not with_evars & eqname = None 
+	        & lbind = NoBindings & not with_evars & eqname = None
                 & not (has_selected_occurrences cls) ->
 	tclTHEN
           (clear_unselected_context id inhyps cls)
 	  (induction_with_atomization_of_ind_arg
 	    isrec with_evars elim names (id,lbind) inhyps) gl
     | _        ->
-	let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) 
+	let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c)
 		  Anonymous in
 	let id = fresh_id [] x gl in
 	(* We need the equality name now *)
@@ -2844,22 +2844,22 @@ let new_induct_gen_l isrec with_evars elim (eqname,names) lc gl =
       | c::l' ->
 	  match kind_of_term c with
 	    | Var id when not (mem_named_context id (Global.named_context()))
-		& not with_evars -> 
+		& not with_evars ->
 		let _ = newlc:= id::!newlc in
 		atomize_list l' gl
 
 	    | _ ->
-		let x = 
+		let x =
 		  id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) Anonymous in
-		
+
 		let id = fresh_id [] x gl in
 		let newl' = List.map (replace_term c (mkVar id)) l' in
 		let _ = newlc:=id::!newlc in
 		let _ = letids:=id::!letids in
-		tclTHEN 
+		tclTHEN
 		  (letin_tac None (Name id) c None allHypsAndConcl)
 		  (atomize_list newl') gl in
-  tclTHENLIST 
+  tclTHENLIST
     [
       (atomize_list lc);
       (fun gl' -> (* recompute each time to have the new value of newlc *)
@@ -2872,16 +2872,16 @@ let new_induct_gen_l isrec with_evars elim (eqname,names) lc gl =
     gl
 
 
-let induct_destruct_l isrec with_evars lc elim names cls = 
+let induct_destruct_l isrec with_evars lc elim names cls =
   (* Several induction hyps: induction scheme is mandatory *)
-  let _ = 
+  let _ =
     if elim = None
-    then 
-      errorlabstrm "" (strbrk "Induction scheme must be given when several induction hypothesis are given.\n" ++ 
+    then
+      errorlabstrm "" (strbrk "Induction scheme must be given when several induction hypothesis are given.\n" ++
       str "Example: induction x1 x2 x3 using my_scheme.") in
-  let newlc = 
+  let newlc =
     List.map
-      (fun x -> 
+      (fun x ->
 	match x with (* FIXME: should we deal with ElimOnIdent? *)
 	  | ElimOnConstr (x,NoBindings) -> x
 	  | _ -> error "Don't know where to find some argument.")
@@ -2893,7 +2893,7 @@ let induct_destruct_l isrec with_evars lc elim names cls =
 
 (* Induction either over a term, over a quantified premisse, or over
    several quantified premisses (like with functional induction
-   principles). 
+   principles).
    TODO: really unify induction with one and induction with several
    args *)
 let induct_destruct isrec with_evars (lc,elim,names,cls) =
@@ -2923,7 +2923,7 @@ let new_destruct ev lc e idl cls = induct_destruct false ev (lc,e,idl,cls)
 
 (* The registered tactic, which calls the default elimination
  * if no elimination constant is provided. *)
-	
+
 (* Induction tactics *)
 
 (* This was Induction before 6.3 (induction only in quantified premisses) *)
@@ -2951,7 +2951,7 @@ let simple_destruct = function
 (*
  *  Eliminations giving the type instead of the proof.
  * These tactics use the default elimination constant and
- * no substitutions at all. 
+ * no substitutions at all.
  * May be they should be integrated into Elim ...
  *)
 
@@ -2974,7 +2974,7 @@ let elim_type t gl =
 let case_type t gl =
   let (ind,t) = pf_reduce_to_atomic_ind gl t in
   let env = pf_env gl in
-  let elimc = make_case_gen env (project gl) ind (elimination_sort_of_goal gl) in 
+  let elimc = make_case_gen env (project gl) ind (elimination_sort_of_goal gl) in
   elim_scheme_type elimc t gl
 
 
@@ -2983,10 +2983,10 @@ let case_type t gl =
 (* These elimination tactics are particularly adapted for sequent
    calculus.  They take a clause as argument, and yield the
    elimination rule if the clause is of the form (Some id) and a
-   suitable introduction rule otherwise. They do not depend on 
-   the name of the eliminated constant, so they can be also 
+   suitable introduction rule otherwise. They do not depend on
+   the name of the eliminated constant, so they can be also
    used on ad-hoc disjunctions and conjunctions introduced by
-   the user. 
+   the user.
    -- Eduardo Gimenez (11/8/97)
 
    HH (29/5/99) replaces failures by specific error messages
@@ -2994,10 +2994,10 @@ let case_type t gl =
 
 let andE id gl =
   let t = pf_get_hyp_typ gl id in
-  if is_conjunction (pf_hnf_constr gl t) then 
+  if is_conjunction (pf_hnf_constr gl t) then
     (tclTHEN (simplest_elim (mkVar id)) (tclDO 2 intro)) gl
-  else 
-    errorlabstrm "andE" 
+  else
+    errorlabstrm "andE"
       (str("Tactic andE expects "^(string_of_id id)^" is a conjunction."))
 
 let dAnd cls =
@@ -3009,10 +3009,10 @@ let dAnd cls =
 
 let orE id gl =
   let t = pf_get_hyp_typ gl id in
-  if is_disjunction (pf_hnf_constr gl t) then 
+  if is_disjunction (pf_hnf_constr gl t) then
     (tclTHEN (simplest_elim (mkVar id)) intro) gl
-  else 
-    errorlabstrm "orE" 
+  else
+    errorlabstrm "orE"
       (str("Tactic orE expects "^(string_of_id id)^" is a disjunction."))
 
 let dorE b cls =
@@ -3024,16 +3024,16 @@ let dorE b cls =
 
 let impE id gl =
   let t = pf_get_hyp_typ gl id in
-  if is_imp_term (pf_hnf_constr gl t) then 
-    let (dom, _, rng) = destProd (pf_hnf_constr gl t) in 
+  if is_imp_term (pf_hnf_constr gl t) then
+    let (dom, _, rng) = destProd (pf_hnf_constr gl t) in
     tclTHENLAST
-      (cut_intro rng) 
+      (cut_intro rng)
       (apply_term (mkVar id) [mkMeta (new_meta())]) gl
-  else 
+  else
     errorlabstrm "impE"
       (str("Tactic impE expects "^(string_of_id id)^
 	      " is a an implication."))
-                        
+
 let dImp cls =
   onClause
     (function
@@ -3051,19 +3051,19 @@ let setoid_reflexivity = ref (fun _ -> assert false)
 let register_setoid_reflexivity f = setoid_reflexivity := f
 
 let reflexivity_red allowred gl =
-  (* PL: usual reflexivity don't perform any reduction when searching 
-     for an equality, but we may need to do some when called back from 
+  (* PL: usual reflexivity don't perform any reduction when searching
+     for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
   let concl = if not allowred then pf_concl gl
-  else whd_betadeltaiota (pf_env gl) (project gl) (pf_concl gl) 
-  in 
+  else whd_betadeltaiota (pf_env gl) (project gl) (pf_concl gl)
+  in
     match match_with_equality_type concl with
     | None -> raise NoEquationFound
     | Some _ -> one_constructor 1 NoBindings gl
 
 let reflexivity gl =
   try reflexivity_red false gl with NoEquationFound -> !setoid_reflexivity gl
-      
+
 let intros_reflexivity  = (tclTHEN intros reflexivity)
 
 (* Symmetry tactics *)
@@ -3084,18 +3084,18 @@ let prove_symmetry hdcncl eq_kind =
     | PolymorphicLeibnizEq (typ,c1,c2) -> mkApp(hdcncl,[|typ;c2;c1|])
     | HeterogenousEq (t1,c1,t2,c2) -> mkApp(hdcncl,[|t2;c2;t1;c1|]) in
   tclTHENFIRST (cut symc)
-    (tclTHENLIST 
-      [ intro; 
-        onLastHyp simplest_case; 
+    (tclTHENLIST
+      [ intro;
+        onLastHyp simplest_case;
 	one_constructor 1 NoBindings ])
 
 let symmetry_red allowred gl =
-  (* PL: usual symmetry don't perform any reduction when searching 
-     for an equality, but we may need to do some when called back from 
+  (* PL: usual symmetry don't perform any reduction when searching
+     for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
   let concl =
     if not allowred then pf_concl gl else pf_whd_betadeltaiota gl (pf_concl gl)
-  in 
+  in
   match match_with_equation concl with
   | Some eq_data,_,_ ->
       tclTHEN
@@ -3109,10 +3109,10 @@ let symmetry gl =
 let setoid_symmetry_in = ref (fun _ _ -> assert false)
 let register_setoid_symmetry_in f = setoid_symmetry_in := f
 
-let symmetry_in id gl = 
-  let ctype = pf_type_of gl (mkVar id) in 
+let symmetry_in id gl =
+  let ctype = pf_type_of gl (mkVar id) in
   let sign,t = decompose_prod_assum ctype in
-  try 
+  try
     let _,hdcncl,eq = match_with_equation t in
     let symccl = match eq with
       | MonomorphicLeibnizEq (c1,c2) -> mkApp (hdcncl, [| c2; c1 |])
@@ -3134,9 +3134,9 @@ let intros_symmetry =
 
 (* This tactic first tries to apply a constant named trans_eq, where eq
    is the name of the equality predicate. If this constant is not
-   defined and the conclusion is a=b, it solves the goal doing 
-   Cut x1=x2; 
-       [Cut x2=x3; [Intros e1 e2; Case e2;Assumption 
+   defined and the conclusion is a=b, it solves the goal doing
+   Cut x1=x2;
+       [Cut x2=x3; [Intros e1 e2; Case e2;Assumption
                     | Idtac]
        | Idtac]
    --Eduardo (19/8/97)
@@ -3165,8 +3165,8 @@ let prove_transitivity hdcncl eq_kind t gl =
 	  assumption ])) gl
 
 let transitivity_red allowred t gl =
-  (* PL: usual transitivity don't perform any reduction when searching 
-     for an equality, but we may need to do some when called back from 
+  (* PL: usual transitivity don't perform any reduction when searching
+     for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
   let concl =
     if not allowred then pf_concl gl else pf_whd_betadeltaiota gl (pf_concl gl)
@@ -3192,8 +3192,8 @@ let transitivity t = transitivity_gen (Some t)
 
 let intros_transitivity  n  = tclTHEN intros (transitivity_gen n)
 
-(* tactical to save as name a subproof such that the generalisation of 
-   the current goal, abstracted with respect to the local signature, 
+(* tactical to save as name a subproof such that the generalisation of
+   the current goal, abstracted with respect to the local signature,
    is solved by tac *)
 
 let interpretable_as_section_decl d1 d2 = match d1,d2 with
@@ -3201,16 +3201,16 @@ let interpretable_as_section_decl d1 d2 = match d1,d2 with
   | (_,Some b1,t1), (_,Some b2,t2) -> eq_constr b1 b2 & eq_constr t1 t2
   | (_,None,t1), (_,_,t2) -> eq_constr t1 t2
 
-let abstract_subproof name tac gl = 
+let abstract_subproof name tac gl =
   let current_sign = Global.named_context()
   and global_sign = pf_hyps gl in
-  let sign,secsign = 
+  let sign,secsign =
     List.fold_right
-      (fun (id,_,_ as d) (s1,s2) -> 
+      (fun (id,_,_ as d) (s1,s2) ->
 	if mem_named_context id current_sign &
           interpretable_as_section_decl (Sign.lookup_named id current_sign) d
         then (s1,push_named_context_val d s2)
-	else (add_named_decl d s1,s2)) 
+	else (add_named_decl d s1,s2))
       global_sign (empty_named_context,empty_named_context_val) in
   let na = next_global_ident_away false name (pf_ids_of_hyps gl) in
   let concl = it_mkNamedProd_or_LetIn (pf_concl gl) sign in
@@ -3220,10 +3220,10 @@ let abstract_subproof name tac gl =
       start_proof na (Global, Proof Lemma) secsign concl (fun _ _ -> ());
       let _,(const,_,kind,_) =
 	try
-	  by (tclCOMPLETE (tclTHEN (tclDO (List.length sign) intro) tac)); 
-	  let r = cook_proof ignore in 
+	  by (tclCOMPLETE (tclTHEN (tclDO (List.length sign) intro) tac));
+	  let r = cook_proof ignore in
 	    delete_current_proof (); r
-	with 
+	with
 	    e ->
 	      (delete_current_proof(); raise e)
       in   (* Faudrait un peu fonctionnaliser cela *)
@@ -3231,29 +3231,29 @@ let abstract_subproof name tac gl =
       let con = Declare.declare_internal_constant na (cd,IsProof Lemma) in
 	constr_of_global (ConstRef con)
     in
-      exact_no_check 
-	(applist (lemme, 
+      exact_no_check
+	(applist (lemme,
 		 List.rev (Array.to_list (instance_from_named_context sign))))
 	gl
 
-let tclABSTRACT name_op tac gl = 
-  let s = match name_op with 
-    | Some s -> s 
-    | None   -> add_suffix (get_current_proof_name ()) "_subproof" 
-  in  
+let tclABSTRACT name_op tac gl =
+  let s = match name_op with
+    | Some s -> s
+    | None   -> add_suffix (get_current_proof_name ()) "_subproof"
+  in
   abstract_subproof s tac gl
 
 
 let admit_as_an_axiom gl =
   let current_sign = Global.named_context()
   and global_sign = pf_hyps gl in
-  let sign,secsign = 
+  let sign,secsign =
     List.fold_right
-      (fun (id,_,_ as d) (s1,s2) -> 
+      (fun (id,_,_ as d) (s1,s2) ->
 	 if mem_named_context id current_sign &
            interpretable_as_section_decl (Sign.lookup_named id current_sign) d
          then (s1,add_named_decl d s2)
-	 else (add_named_decl d s1,s2)) 
+	 else (add_named_decl d s1,s2))
       global_sign (empty_named_context,empty_named_context) in
   let name = add_suffix (get_current_proof_name ()) "_admitted" in
   let na = next_global_ident_away false name (pf_ids_of_hyps gl) in
@@ -3264,19 +3264,19 @@ let admit_as_an_axiom gl =
     let con = Declare.declare_internal_constant na (cd,IsAssumption Logical) in
     constr_of_global (ConstRef con)
   in
-  exact_no_check 
-    (applist (axiom, 
+  exact_no_check
+    (applist (axiom,
               List.rev (Array.to_list (instance_from_named_context sign))))
     gl
 
 let unify ?(state=full_transparent_state) x y gl =
-  try 
-    let flags = 
-      {default_unify_flags with 
+  try
+    let flags =
+      {default_unify_flags with
 	modulo_delta = state;
 	modulo_conv_on_closed_terms = Some state}
     in
-    let evd = w_unify false (pf_env gl) Reduction.CONV 
+    let evd = w_unify false (pf_env gl) Reduction.CONV
       ~flags x y (Evd.create_evar_defs (project gl))
     in tclEVARS evd gl
   with _ -> tclFAIL 0 (str"Not unifiable") gl
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index ee2250b346..40ff0b688e 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -102,7 +102,7 @@ val try_intros_until :
 (* Apply a tactic on a quantified hypothesis, an hypothesis in context
    or a term with bindings *)
 
-val onInductionArg : 
+val onInductionArg :
   (constr with_ebindings -> tactic) ->
     constr with_ebindings induction_arg -> tactic
 
@@ -129,7 +129,7 @@ val reduct_in_hyp     : tactic_reduction -> hyp_location -> tactic
 val reduct_option     : tactic_reduction * cast_kind -> goal_location -> tactic
 val reduct_in_concl   : tactic_reduction * cast_kind -> tactic
 val change_in_concl   : (occurrences * constr) option -> constr -> tactic
-val change_in_hyp     : (occurrences * constr) option -> constr -> 
+val change_in_hyp     : (occurrences * constr) option -> constr ->
                         hyp_location -> tactic
 val red_in_concl      : tactic
 val red_in_hyp        : hyp_location -> tactic
@@ -146,13 +146,13 @@ val normalise_option  : goal_location -> tactic
 val normalise_vm_in_concl : tactic
 val unfold_in_concl   :
   (occurrences * evaluable_global_reference) list -> tactic
-val unfold_in_hyp     : 
+val unfold_in_hyp     :
   (occurrences * evaluable_global_reference) list -> hyp_location -> tactic
-val unfold_option     : 
+val unfold_option     :
   (occurrences * evaluable_global_reference) list -> goal_location -> tactic
 val change            :
   (occurrences * constr) option -> constr -> clause -> tactic
-val pattern_option    : 
+val pattern_option    :
   (occurrences * constr) list -> goal_location -> tactic
 val reduce            : red_expr -> clause -> tactic
 val unfold_constr     : global_reference -> tactic
@@ -179,7 +179,7 @@ val bring_hyps : named_context -> tactic
 val apply                 : constr -> tactic
 val eapply                : constr -> tactic
 
-val apply_with_ebindings_gen : 
+val apply_with_ebindings_gen :
   advanced_flag -> evars_flag -> open_constr with_ebindings located list ->
     tactic
 
@@ -191,8 +191,8 @@ val eapply_with_ebindings : open_constr with_ebindings -> tactic
 
 val cut_and_apply         : constr -> tactic
 
-val apply_in : 
-  advanced_flag -> evars_flag -> identifier -> 
+val apply_in :
+  advanced_flag -> evars_flag -> identifier ->
   open_constr with_ebindings located list ->
   intro_pattern_expr located option -> tactic
 
@@ -203,7 +203,7 @@ val simple_apply_in : identifier -> constr -> tactic
 
 (*
    The general form of an induction principle is the following:
-   
+
    forall prm1 prm2 ... prmp,                          (induction parameters)
    forall Q1...,(Qi:Ti_1 -> Ti_2 ->...-> Ti_ni),...Qq, (predicates)
    branch1, branch2, ... , branchr,                    (branches of the principle)
@@ -226,7 +226,7 @@ val simple_apply_in : identifier -> constr -> tactic
 
 (* [rel_contexts] and [rel_declaration] actually contain triples, and
    lists are actually in reverse order to fit [compose_prod]. *)
-type elim_scheme = { 
+type elim_scheme = {
   elimc: constr with_ebindings option;
   elimt: types;
   indref: global_reference option;
@@ -235,12 +235,12 @@ type elim_scheme = {
   predicates: rel_context; (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;        (* Number of predicates *)
   branches: rel_context;   (* branchr,...,branch1 *)
-  nbranches: int;          (* Number of branches *) 
+  nbranches: int;          (* Number of branches *)
   args: rel_context;       (* (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;              (* number of arguments *)
-  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni) 
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni)
 				     if HI is in premisses, None otherwise *)
-  concl: types;            (* Qi x1...xni HI (f...), HI and (f...) 
+  concl: types;            (* Qi x1...xni HI (f...), HI and (f...)
 			      are optional and mutually exclusive *)
   indarg_in_concl: bool;   (* true if HI appears at the end of conclusion *)
   farg_in_concl: bool;     (* true if (f...) appears at the end of conclusion *)
@@ -250,7 +250,7 @@ type elim_scheme = {
 val compute_elim_sig : ?elimc: constr with_ebindings -> types -> elim_scheme
 val rebuild_elimtype_from_scheme: elim_scheme -> types
 
-val elimination_clause_scheme : evars_flag -> 
+val elimination_clause_scheme : evars_flag ->
   bool -> clausenv -> clausenv -> tactic
 
 val elimination_in_clause_scheme : evars_flag -> identifier ->
@@ -261,18 +261,18 @@ val general_elim_clause_gen : (Clenv.clausenv -> 'a -> tactic) ->
 
 val general_elim  : evars_flag ->
   constr with_ebindings -> constr with_ebindings -> ?allow_K:bool -> tactic
-val general_elim_in : evars_flag -> 
+val general_elim_in : evars_flag ->
   identifier -> constr with_ebindings -> constr with_ebindings -> tactic
 
 val default_elim  : evars_flag -> constr with_ebindings -> tactic
 val simplest_elim : constr -> tactic
-val elim : 
+val elim :
   evars_flag -> constr with_ebindings -> constr with_ebindings option -> tactic
 
 val simple_induct : quantified_hypothesis -> tactic
 
-val new_induct : evars_flag -> constr with_ebindings induction_arg list -> 
-  constr with_ebindings option -> 
+val new_induct : evars_flag -> constr with_ebindings induction_arg list ->
+  constr with_ebindings option ->
     intro_pattern_expr located option * intro_pattern_expr located option ->
       clause option -> tactic
 
@@ -282,14 +282,14 @@ val general_case_analysis : evars_flag -> constr with_ebindings ->  tactic
 val simplest_case         : constr -> tactic
 
 val simple_destruct          : quantified_hypothesis -> tactic
-val new_destruct : evars_flag -> constr with_ebindings induction_arg list -> 
-  constr with_ebindings option -> 
+val new_destruct : evars_flag -> constr with_ebindings induction_arg list ->
+  constr with_ebindings option ->
     intro_pattern_expr located option * intro_pattern_expr located option ->
       clause option -> tactic
 
 (*s Generic case analysis / induction tactics. *)
 
-val induction_destruct : evars_flag -> rec_flag -> 
+val induction_destruct : evars_flag -> rec_flag ->
   (constr with_ebindings induction_arg list *
   constr with_ebindings option *
   (intro_pattern_expr located option * intro_pattern_expr located option) *
@@ -313,7 +313,7 @@ val dorE : bool -> clause ->tactic
 
 (*s Introduction tactics. *)
 
-val constructor_tac      : evars_flag -> int option -> int -> 
+val constructor_tac      : evars_flag -> int option -> int ->
   open_constr bindings  -> tactic
 val any_constructor      : evars_flag -> tactic option -> tactic
 val one_constructor      : int -> open_constr bindings  -> tactic
@@ -352,13 +352,13 @@ val intros_transitivity         : constr option -> tactic
 
 val cut                         : constr -> tactic
 val cut_intro                   : constr -> tactic
-val cut_replacing               : 
+val cut_replacing               :
   identifier -> constr -> (tactic -> tactic) -> tactic
 val cut_in_parallel             : constr list -> tactic
 
 val assert_as : bool -> intro_pattern_expr located option -> constr -> tactic
 val forward   : tactic option -> intro_pattern_expr located option -> constr -> tactic
-val letin_tac : (bool * intro_pattern_expr located) option -> name -> 
+val letin_tac : (bool * intro_pattern_expr located) option -> name ->
   constr -> types option -> clause -> tactic
 val assert_tac : name -> types -> tactic
 val assert_by  : name -> types -> tactic -> tactic
@@ -379,5 +379,5 @@ val abstract_generalize : identifier -> ?generalize_vars:bool -> tactic
 
 val dependent_pattern : constr -> tactic
 
-val register_general_multi_rewrite : 
+val register_general_multi_rewrite :
   (bool -> evars_flag -> open_constr with_bindings -> clause -> tactic) -> unit
diff --git a/tactics/tauto.ml4 b/tactics/tauto.ml4
index ad2fd90093..ebfb9446f3 100644
--- a/tactics/tauto.ml4
+++ b/tactics/tauto.ml4
@@ -50,7 +50,7 @@ let iff_unfolding = ref false
 
 open Goptions
 let _ =
-  declare_bool_option 
+  declare_bool_option
     { optsync  = true;
       optname  = "unfolding of iff and not in intuition";
       optkey   = ["Intuition";"Iff";"Unfolding"];
@@ -77,7 +77,7 @@ let is_unit_or_eq ist =
 let is_record t =
   let (hdapp,args) = decompose_app t in
     match (kind_of_term hdapp) with
-      | Ind ind  -> 
+      | Ind ind  ->
           let (mib,mip) = Global.lookup_inductive ind in
 	    mib.Declarations.mind_record
       | _ -> false
@@ -86,13 +86,13 @@ let is_binary t =
   isApp t &&
   let (hdapp,args) = decompose_app t in
     match (kind_of_term hdapp) with
-    | Ind ind  -> 
+    | Ind ind  ->
         let (mib,mip) = Global.lookup_inductive ind in
 	  mib.Declarations.mind_nparams = 2
     | _ -> false
 
 let iter_tac tacl =
-  List.fold_right (fun tac tacs -> <:tactic< $tac; $tacs >>) tacl 
+  List.fold_right (fun tac tacs -> <:tactic< $tac; $tacs >>) tacl
 
 (** Dealing with conjunction *)
 
@@ -111,10 +111,10 @@ let flatten_contravariant_conj ist =
   match match_with_conjunction ~strict:strict_in_contravariant_hyp typ with
   | Some (_,args) ->
       let i = List.length args in
-      if not binary_mode || i = 2 then 
+      if not binary_mode || i = 2 then
 	let newtyp = valueIn (VConstr (List.fold_right mkArrow args c)) in
 	let intros =
-	  iter_tac (List.map (fun _ -> <:tactic< intro >>) args) 
+	  iter_tac (List.map (fun _ -> <:tactic< intro >>) args)
 	  <:tactic< idtac >> in
 	<:tactic<
           let newtyp := $newtyp in
@@ -143,10 +143,10 @@ let flatten_contravariant_disj ist =
   match match_with_disjunction ~strict:strict_in_contravariant_hyp typ with
   | Some (_,args) ->
       let i = List.length args in
-      if not binary_mode || i = 2 then 
+      if not binary_mode || i = 2 then
 	iter_tac (list_map_i (fun i arg ->
 	  let typ = valueIn (VConstr (mkArrow arg c)) in
-	  <:tactic< 
+	  <:tactic<
             let typ := $typ in
 	    assert typ by (intro; apply id; constructor $i; assumption)
 	  >>) 1 args) <:tactic< clear id >>
@@ -166,7 +166,7 @@ let not_dep_intros ist =
   | H:(Coq.Init.Logic.not _)|-_    => unfold Coq.Init.Logic.not at 1 in H
   | H:(Coq.Init.Logic.not _)->_|-_    => unfold Coq.Init.Logic.not at 1 in H
   end >>
-				      
+
 let axioms ist =
   let t_is_unit_or_eq = tacticIn is_unit_or_eq
   and t_is_empty = tacticIn is_empty in
@@ -231,7 +231,7 @@ let rec tauto_intuit t_reduce solver ist =
    || match reverse goal with
       | id:(?X1 -> ?X2)-> ?X3|- _ =>
 	  cut X3;
-	    [ intro; clear id; $t_tauto_intuit 
+	    [ intro; clear id; $t_tauto_intuit
 	    | cut (X1 -> X2);
 		[ exact id
 		| generalize (fun y:X2 => id (fun x:X1 => y)); intro; clear id;
@@ -276,7 +276,7 @@ let tauto_classical nnpp g =
   with UserError _ -> errorlabstrm "tauto" (str "Classical tauto failed.")
 
 let tauto g =
-  try 
+  try
     let nnpp = constr_of_global (Nametab.global_of_path coq_nnpp_path) in
     (* try intuitionistic version first to avoid an axiom if possible *)
     tclORELSE tauto_intuitionistic (tauto_classical nnpp) g
diff --git a/tactics/termdn.ml b/tactics/termdn.ml
index 591b2947c9..32e65239dd 100644
--- a/tactics/termdn.ml
+++ b/tactics/termdn.ml
@@ -25,20 +25,20 @@ type 'a t = (global_reference,constr_pattern,'a) Dn.t
 
 (*If we have: f a b c ..., decomp gives: (f,[a;b;c;...])*)
 
-let decomp = 
+let decomp =
   let rec decrec acc c = match kind_of_term c with
     | App (f,l) -> decrec (Array.fold_right (fun a l -> a::l) l acc) f
     | Cast (c1,_,_) -> decrec acc c1
     | _ -> (c,acc)
-  in 
+  in
   decrec []
 
-let decomp_pat = 
+let decomp_pat =
   let rec decrec acc = function
     | PApp (f,args) -> decrec (Array.to_list args @ acc) f
     | c -> (c,acc)
-  in 
-  decrec []   
+  in
+  decrec []
 
 let constr_pat_discr t =
   if not (occur_meta_pattern t) then
@@ -54,7 +54,7 @@ let constr_pat_discr_st (idpred,cpred) t =
   match decomp_pat t with
   | PRef ((IndRef _) as ref), args
   | PRef ((ConstructRef _ ) as ref), args -> Some (ref,args)
-  | PRef ((VarRef v) as ref), args when not (Idpred.mem v idpred) -> 
+  | PRef ((VarRef v) as ref), args when not (Idpred.mem v idpred) ->
       Some(ref,args)
   | PVar v, args when not (Idpred.mem v idpred) ->
       Some(VarRef v,args)
@@ -64,7 +64,7 @@ let constr_pat_discr_st (idpred,cpred) t =
 
 open Dn
 
-let constr_val_discr t =  
+let constr_val_discr t =
   let c, l = decomp t in
     match kind_of_term c with
     | Ind ind_sp -> Label(IndRef ind_sp,l)
@@ -72,8 +72,8 @@ let constr_val_discr t =
     | Var id -> Label(VarRef id,l)
     | Const _ -> Everything
     | _ -> Nothing
-	
-let constr_val_discr_st (idpred,cpred) t =  
+
+let constr_val_discr_st (idpred,cpred) t =
   let c, l = decomp t in
     match kind_of_term c with
     | Const c -> if Cpred.mem c cpred then Everything else Label(ConstRef c,l)
@@ -83,12 +83,12 @@ let constr_val_discr_st (idpred,cpred) t =
     | Evar _ -> Everything
     | _ -> Nothing
 
-let create = Dn.create 
+let create = Dn.create
 
 let add dn st = Dn.add dn (constr_pat_discr_st st)
 
 let rmv dn st = Dn.rmv dn (constr_pat_discr_st st)
 
 let lookup dn st t = Dn.lookup dn (constr_val_discr_st st) t
-  
+
 let app f dn = Dn.app f dn
diff --git a/tactics/termdn.mli b/tactics/termdn.mli
index a9f11b3afa..92a1b8c3ea 100644
--- a/tactics/termdn.mli
+++ b/tactics/termdn.mli
@@ -14,7 +14,7 @@ open Pattern
 open Libnames
 open Names
 (*i*)
-  
+
 (* Discrimination nets of terms. *)
 
 (* This module registers actions (typically tactics) mapped to patterns *)
@@ -23,7 +23,7 @@ open Names
 order in such a way patterns having the same prefix have this common
 prefix shared and the seek for the action associated to the patterns
 that a term matches are found in time proportional to the maximal
-number of nodes of the patterns matching the term. The [transparent_state] 
+number of nodes of the patterns matching the term. The [transparent_state]
 indicates which constants and variables can be considered as rigid.
 These dnets are able to cope with existential variables as well, which match
 [Everything]. *)