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

52 files changed, 1499 insertions, 1499 deletions

diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 1f9cc0f1f..899fb64e1 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -73,11 +73,11 @@ let set_impossible_default_clause c = impossible_default_case := Some c
 let coq_unit_judge =
   let na1 = Name (id_of_string "A") in
   let na2 = Name (id_of_string "H") in
-  fun () -> 
+  fun () ->
     match !impossible_default_case with
     | Some (id,type_of_id) ->
 	make_judge id type_of_id
-    | None -> 
+    | None ->
 	(* In case the constants id/ID are not defined *)
 	make_judge (mkLambda (na1,mkProp,mkLambda(na2,mkRel 1,mkRel 1)))
                  (mkProd (na1,mkProp,mkArrow (mkRel 1) (mkRel 2)))
@@ -88,7 +88,7 @@ module type S = sig
   val compile_cases :
     loc -> case_style ->
     (type_constraint -> env -> evar_defs ref -> rawconstr -> unsafe_judgment) * evar_defs ref ->
-    type_constraint -> 
+    type_constraint ->
     env -> rawconstr option * tomatch_tuples * cases_clauses ->
     unsafe_judgment
 end
@@ -97,8 +97,8 @@ let rec list_try_compile f = function
   | [a] -> f a
   | [] -> anomaly "try_find_f"
   | h::t ->
-      try f h 
-      with UserError _ | TypeError _ | PretypeError _ 
+      try f h
+      with UserError _ | TypeError _ | PretypeError _
 	| Stdpp.Exc_located (_,(UserError _ | TypeError _ | PretypeError _)) ->
 	    list_try_compile f t
 
@@ -119,7 +119,7 @@ let msg_may_need_inversion () =
 
 (* Utils *)
 let make_anonymous_patvars n =
-  list_make n (PatVar (dummy_loc,Anonymous)) 
+  list_make n (PatVar (dummy_loc,Anonymous))
 
 (* Environment management *)
 let push_rels vars env = List.fold_right push_rel vars env
@@ -169,7 +169,7 @@ type 'a rhs =
       it         : 'a option}
 
 type 'a equation =
-    { patterns     : cases_pattern list; 
+    { patterns     : cases_pattern list;
       rhs          : 'a rhs;
       alias_stack  : name list;
       eqn_loc      : loc;
@@ -212,7 +212,7 @@ let feed_history arg = function
       Continuation (n-1, arg :: l, h)
   | Continuation (n, _, _) ->
       anomaly ("Bad number of expected remaining patterns: "^(string_of_int n))
-  | Result _ -> 
+  | Result _ ->
       anomaly "Exhausted pattern history"
 
 (* This is for non exhaustive error message *)
@@ -243,7 +243,7 @@ let rec simplify_history = function
       let pat = match f with
 	| AliasConstructor pci ->
 	    PatCstr (dummy_loc,pci,pargs,Anonymous)
-	| AliasLeaf -> 
+	| AliasLeaf ->
 	    assert (l = []);
 	    PatVar (dummy_loc, Anonymous) in
       feed_history pat rh
@@ -261,7 +261,7 @@ let push_history_pattern n current cont =
 
   where tomatch is some sequence of "instructions" (t1  ... tn)
 
-  and mat is some matrix 
+  and mat is some matrix
    (p11 ... p1n -> rhs1)
    (    ...            )
    (pm1 ... pmn -> rhsm)
@@ -322,7 +322,7 @@ let rec find_row_ind = function
 
 let inductive_template evdref env tmloc ind =
   let arsign = get_full_arity_sign env ind in
-  let hole_source = match tmloc with 
+  let hole_source = match tmloc with
     | Some loc -> fun i -> (loc, TomatchTypeParameter (ind,i))
     | None -> fun _ -> (dummy_loc, InternalHole) in
    let (_,evarl,_) =
@@ -332,7 +332,7 @@ let inductive_template evdref env tmloc ind =
         | None ->
 	    let ty' = substl subst ty in
 	    let e = e_new_evar evdref env ~src:(hole_source n) ty' in
-	    (e::subst,e::evarl,n+1) 
+	    (e::subst,e::evarl,n+1)
 	| Some b ->
 	    (b::subst,evarl,n+1))
       arsign ([],[],1) in
@@ -349,7 +349,7 @@ let try_find_ind env sigma typ realnames =
 
 let inh_coerce_to_ind evdref env ty tyi =
   let expected_typ = inductive_template evdref env None tyi in
-     (* devrait être indifférent d'exiger leq ou pas puisque pour 
+     (* devrait être indifférent d'exiger leq ou pas puisque pour
         un inductif cela doit être égal *)
   let _ = e_cumul env evdref expected_typ ty in ()
 
@@ -363,9 +363,9 @@ let unify_tomatch_with_patterns evdref env loc typ pats realnames =
 
 let find_tomatch_tycon evdref env loc = function
   (* Try if some 'in I ...' is present and can be used as a constraint *)
-  | Some (_,ind,_,realnal) -> 		  
+  | Some (_,ind,_,realnal) ->
       mk_tycon (inductive_template evdref env loc ind),Some (List.rev realnal)
-  | None -> 
+  | None ->
       empty_tycon,None
 
 let coerce_row typing_fun evdref env pats (tomatch,(_,indopt)) =
@@ -404,7 +404,7 @@ let adjust_tomatch_to_pattern pb ((current,typ),deps,dep) =
   (* Ideally, we could find a common inductive type to which both the
      term to match and the patterns coerce *)
   (* In practice, we coerce the term to match if it is not already an
-     inductive type and it is not dependent; moreover, we use only 
+     inductive type and it is not dependent; moreover, we use only
      the first pattern type and forget about the others *)
   let typ,names =
     match typ with IsInd(t,_,names) -> t,Some names | NotInd(_,t) -> t,None in
@@ -483,7 +483,7 @@ let rec adjust_local_defs loc = function
   | [], [] -> []
   | _ -> raise NotAdjustable
 
-let check_and_adjust_constructor env ind cstrs = function 
+let check_and_adjust_constructor env ind cstrs = function
   | PatVar _ as pat -> pat
   | PatCstr (loc,((_,i) as cstr),args,alias) as pat ->
       (* Check it is constructor of the right type *)
@@ -494,7 +494,7 @@ let check_and_adjust_constructor env ind cstrs = function
 	let nb_args_constr = ci.cs_nargs in
 	if List.length args = nb_args_constr then pat
 	else
-	  try 
+	  try
 	    let args' = adjust_local_defs loc (args, List.rev ci.cs_args)
 	    in PatCstr (loc, cstr, args', alias)
 	  with NotAdjustable ->
@@ -504,7 +504,7 @@ let check_and_adjust_constructor env ind cstrs = function
 	(* Try to insert a coercion *)
 	try
 	  Coercion.inh_pattern_coerce_to loc pat ind' ind
-	with Not_found -> 
+	with Not_found ->
 	  error_bad_constructor_loc loc cstr ind
 
 let check_all_variables typ mat =
@@ -516,14 +516,14 @@ let check_all_variables typ mat =
     mat
 
 let check_unused_pattern env eqn =
-  if not !(eqn.used) then 
+  if not !(eqn.used) then
     raise_pattern_matching_error
       (eqn.eqn_loc, env, UnusedClause eqn.patterns)
 
 let set_used_pattern eqn = eqn.used := true
 
 let extract_rhs pb =
-  match pb.mat with 
+  match pb.mat with
     | [] -> errorlabstrm "build_leaf" (msg_may_need_inversion())
     | eqn::_ ->
 	set_used_pattern eqn;
@@ -574,7 +574,7 @@ let dependencies_in_rhs nargs current tms eqns =
 
 let rec find_dependency_list k n = function
   | [] -> []
-  | (used,tdeps,d)::rest -> 
+  | (used,tdeps,d)::rest ->
       let deps = find_dependency_list k (n+1) rest in
       if used && dependent_decl (mkRel n) d
       then list_add_set (List.length rest + 1) (list_union deps tdeps)
@@ -601,7 +601,7 @@ let find_dependencies_signature deps_in_rhs typs =
 
 let regeneralize_index_tomatch n =
   let rec genrec depth = function
-  | [] -> 
+  | [] ->
       []
   | Pushed ((c,tm),l,dep) :: rest ->
       let c = regeneralize_index n depth c in
@@ -615,7 +615,7 @@ let regeneralize_index_tomatch n =
       :: genrec (depth+1) rest in
   genrec 0
 
-let rec replace_term n c k t = 
+let rec replace_term n c k t =
   if t = mkRel (n+k) then lift k c
   else map_constr_with_binders succ (replace_term n c) k t
 
@@ -673,7 +673,7 @@ let lift_tomatch_stack n = liftn_tomatch_stack n 1
    [match y with (S (S x)) => x | x => x end] should be compiled into
    [match y with O => y | (S n) => match n with O => y | (S x) => x end end]
 
-   and [match y with (S (S n)) => n | n => n end] into 
+   and [match y with (S (S n)) => n | n => n end] into
    [match y with O => y | (S n0) => match n0 with O => y | (S n) => n end end]
 
   i.e. user names should be preserved and created names should not
@@ -688,7 +688,7 @@ let merge_names get_name = List.map2 (merge_name get_name)
 let get_names env sign eqns =
   let names1 = list_make (List.length sign) Anonymous in
   (* If any, we prefer names used in pats, from top to bottom *)
-  let names2 = 
+  let names2 =
     List.fold_right
       (fun (pats,eqn) names -> merge_names alias_of_pat pats names)
       eqns names1 in
@@ -702,7 +702,7 @@ let get_names env sign eqns =
 	 let na =
 	   merge_name
 	     (fun (na,_,t) -> Name (next_name_away (named_hd env t na) avoid))
-	     d na 
+	     d na
 	 in
          (na::l,(out_name na)::avoid))
       ([],allvars) (List.rev sign) names2 in
@@ -739,7 +739,7 @@ let build_aliases_context env sigma names allpats pats =
 	let oldallpats = List.map List.tl oldallpats in
 	let decl = (na,Some deppat,t) in
 	let a = (deppat,nondeppat,d,t) in
-	insert (push_rel decl env) (decl::sign1) ((na,a)::sign2) (n+1) 
+	insert (push_rel decl env) (decl::sign1) ((na,a)::sign2) (n+1)
 	  newallpats oldallpats (pats,names)
     | [], [] -> newallpats, sign1, sign2, env
     | _ -> anomaly "Inconsistent alias and name lists" in
@@ -759,7 +759,7 @@ let insert_aliases env sigma alias eqns =
   let eqnsnames = List.map (fun eqn -> List.hd eqn.alias_stack) eqns in
   let alias_rests = List.map (fun eqn -> List.tl eqn.alias_stack) eqns in
   (* name2 takes the meet of all needed aliases *)
-  let name2 = 
+  let name2 =
     List.fold_right (merge_name (fun x -> x)) eqnsnames Anonymous in
   (* Only needed aliases are kept by build_aliases_context *)
   let eqnsnames, sign1, sign2, env =
@@ -776,7 +776,7 @@ let noccur_between_without_evar n m term =
     | Rel p       -> if n<=p && p<n+m then raise Occur
     | Evar (_,cl) -> ()
     | _             -> iter_constr_with_binders succ occur_rec n c
-  in 
+  in
   (m = 0) or (try occur_rec n term; true with Occur -> false)
 
 
@@ -853,7 +853,7 @@ let subst_predicate (args,copt) ccl tms =
 
 let specialize_predicate_var (cur,typ,dep) tms ccl =
   let c = if dep<>Anonymous then Some cur else None in
-  let l = 
+  let l =
     match typ with
     | IsInd (_,IndType(_,realargs),names) -> if names<>[] then realargs else []
     | NotInd _ -> [] in
@@ -901,7 +901,7 @@ let abstract_predicate env sigma indf cur (names,(nadep,_)) tms ccl =
       | Rel i -> regeneralize_index_tomatch (i+n) tms
       | _ -> (* Initial case *) tms in
   let sign = List.map2 (fun na (_,c,t) -> (na,c,t)) (nadep::names) sign in
-  let ccl = if nadep <> Anonymous then ccl else lift_predicate 1 ccl tms in 
+  let ccl = if nadep <> Anonymous then ccl else lift_predicate 1 ccl tms in
   let pred = extract_predicate [] ccl tms in
   it_mkLambda_or_LetIn_name env pred sign
 
@@ -913,7 +913,7 @@ let known_dependent (_,dep) = (dep = KnownDep)
    by gamma, x1...xn, x1...xk-1 |- [X=realargs]pred (if not dep) *)
 
 let expand_arg tms ccl ((_,t),_,na) =
-  let k = length_of_tomatch_type_sign na t in 
+  let k = length_of_tomatch_type_sign na t in
   lift_predicate (k-1) ccl tms
 
 let adjust_impossible_cases pb pred tomatch submat =
@@ -928,9 +928,9 @@ let adjust_impossible_cases pb pred tomatch submat =
 	map_succeed (function Alias _ -> Anonymous | _ -> failwith"") tomatch
       in
       [ { patterns = pats;
-          rhs = { rhs_env = pb.env; 
-	          rhs_vars = []; 
-		  avoid_ids = []; 
+          rhs = { rhs_env = pb.env;
+	          rhs_vars = [];
+		  avoid_ids = [];
 		  it = None };
 	  alias_stack = Anonymous::aliasnames;
 	  eqn_loc = dummy_loc;
@@ -1024,8 +1024,8 @@ let group_equations pb ind current cstrs mat =
       (fun eqn () ->
 	 let rest = remove_current_pattern eqn in
 	 let pat = current_pattern eqn in
-	 match check_and_adjust_constructor pb.env ind cstrs pat with 
-	   | PatVar (_,name) -> 
+	 match check_and_adjust_constructor pb.env ind cstrs pat with
+	   | PatVar (_,name) ->
 	       (* This is a default clause that we expand *)
 	       for i=1 to Array.length cstrs do
 		 let args = make_anonymous_patvars cstrs.(i-1).cs_nargs in
@@ -1074,10 +1074,10 @@ let build_branch current deps (realnames,dep) pb arsign eqns const_info =
       & not (known_dependent dep) & deps = []
     then
       NonDepAlias
-    else 
+    else
       DepAlias
   in
-  let history = 
+  let history =
     push_history_pattern const_info.cs_nargs
       (AliasConstructor const_info.cs_cstr)
       pb.history in
@@ -1096,10 +1096,10 @@ let build_branch current deps (realnames,dep) pb arsign eqns const_info =
 
   let dep_sign =
     find_dependencies_signature
-      (dependencies_in_rhs const_info.cs_nargs current pb.tomatch eqns) 
+      (dependencies_in_rhs const_info.cs_nargs current pb.tomatch eqns)
       (List.rev typs) in
 
-  (* The dependent term to subst in the types of the remaining UnPushed 
+  (* The dependent term to subst in the types of the remaining UnPushed
      terms is relative to the current context enriched by topushs *)
   let ci = build_dependent_constructor const_info in
 
@@ -1109,7 +1109,7 @@ let build_branch current deps (realnames,dep) pb arsign eqns const_info =
   (* into  "Gamma; typs; curalias |- tms" *)
   let tomatch = lift_tomatch_stack const_info.cs_nargs pb.tomatch in
 
-  let typs'' = 
+  let typs'' =
     list_map2_i
       (fun i (na,t) deps ->
 	let dep = match dep with
@@ -1123,7 +1123,7 @@ let build_branch current deps (realnames,dep) pb arsign eqns const_info =
 	((mkRel i, lift_tomatch_type i t),deps,dep))
       1 typs' (List.rev dep_sign) in
 
-  let pred = 
+  let pred =
     specialize_predicate typs'' (realnames,dep) arsign const_info tomatch pb.pred in
 
   let currents = List.map (fun x -> Pushed x) typs'' in
@@ -1199,7 +1199,7 @@ and match_current pb tomatch =
 	  (* We build the (elementary) case analysis *)
 	  let brvals = Array.map (fun (v,_) -> v) brs in
 	  let (pred,typ,s) =
-	    find_predicate pb.caseloc pb.env pb.evdref 
+	    find_predicate pb.caseloc pb.env pb.evdref
 	      pb.pred current indt (names,dep) pb.tomatch in
 	  let ci = make_case_info pb.env mind pb.casestyle in
 	  let case = mkCase (ci,nf_betaiota Evd.empty pred,current,brvals) in
@@ -1284,7 +1284,7 @@ let matx_of_eqns env tomatchl eqns =
    variables (in practice, there is no reason that ti is already
    constructed and the qi will be degenerated).
 
-   We then look for a type U(..a1jk..b1 .. ..amjk..bm) so that 
+   We then look for a type U(..a1jk..b1 .. ..amjk..bm) so that
    T = U(..v1jk..t1 .. ..vmjk..tm). This a higher-order matching
    problem with a priori different solution (one of them if T itself!).
 
@@ -1303,13 +1303,13 @@ let matx_of_eqns env tomatchl eqns =
 let adjust_to_extended_env_and_remove_deps env extenv subst t =
   let n = rel_context_length (rel_context env) in
   let n' = rel_context_length (rel_context extenv) in
-  (* We first remove the bindings that are dependently typed (they are 
+  (* We first remove the bindings that are dependently typed (they are
      difficult to manage and it is not sure these are so useful in practice);
      Notes:
      - [subst] is made of pairs [(id,u)] where id is a name in [extenv] and
        [u] a term typed in [env];
      - [subst0] is made of items [(p,u,(u,ty))] where [ty] is the type of [u]
-       and both are adjusted to [extenv] while [p] is the index of [id] in 
+       and both are adjusted to [extenv] while [p] is the index of [id] in
        [extenv] (after expansion of the aliases) *)
   let subst0 = map_succeed (fun (x,u) ->
     (* d1 ... dn dn+1 ... dn'-p+1 ... dn' *)
@@ -1337,8 +1337,8 @@ let adjust_to_extended_env_and_remove_deps env extenv subst t =
  * defined in some environment env. The vijk and ti are supposed to be
  * instances for variables aijk and bi.
  *
- * [abstract_tycon Gamma0 Sigma subst T Gamma] looks for U(..v1jk..t1 .. ..vmjk..tm) 
- * defined in some extended context 
+ * [abstract_tycon Gamma0 Sigma subst T Gamma] looks for U(..v1jk..t1 .. ..vmjk..tm)
+ * defined in some extended context
  * "Gamma0, ..a1jk:V1jk.. b1:W1 .. ..amjk:Vmjk.. bm:Wm"
  * such that env |- T = U(..v1jk..t1 .. ..vmjk..tm). To not commit to
  * a particular solution, we replace each subterm t in T that unifies with
@@ -1362,11 +1362,11 @@ let abstract_tycon loc env evdref subst _tycon extenv t =
     if good <> [] then
       let (u,ty) = pi3 (List.hd good) in
       let vl = List.map pi1 good in
-      let inst = 
+      let inst =
 	list_map_i
 	  (fun i _ -> if List.mem i vl then u else mkRel i) 1
 	  (rel_context extenv) in
-      let rel_filter = 
+      let rel_filter =
 	List.map (fun a -> not (isRel a) or dependent a u) inst in
       let named_filter =
 	List.map (fun (id,_,_) -> dependent (mkVar id) u)
@@ -1377,10 +1377,10 @@ let abstract_tycon loc env evdref subst _tycon extenv t =
       evdref := add_conv_pb (Reduction.CONV,extenv,substl inst ev,u) !evdref;
       lift k ev
     else
-      map_constr_with_full_binders 
+      map_constr_with_full_binders
 	(fun d (k,env,subst) ->
 	  k+1,
-	  push_rel d env, 
+	  push_rel d env,
 	  List.map (fun (na,u,d) -> (na,lift 1 u,d)) subst)
 	aux x t in
   aux (0,extenv,subst0) t0
@@ -1388,11 +1388,11 @@ let abstract_tycon loc env evdref subst _tycon extenv t =
 let build_tycon loc env tycon_env subst tycon extenv evdref t =
   let t = match t with
     | None ->
-	(* This is the situation we are building a return predicate and 
+	(* This is the situation we are building a return predicate and
            we are in an impossible branch *)
 	let n = rel_context_length (rel_context env) in
 	let n' = rel_context_length (rel_context tycon_env) in
-	let impossible_case_type = 
+	let impossible_case_type =
 	  e_new_evar evdref env ~src:(loc,ImpossibleCase) (new_Type ()) in
 	lift (n'-n) impossible_case_type
     | Some t -> abstract_tycon loc tycon_env evdref subst tycon extenv t in
@@ -1400,7 +1400,7 @@ let build_tycon loc env tycon_env subst tycon extenv evdref t =
 
 (* For a multiple pattern-matching problem Xi on t1..tn with return
  * type T, [build_inversion_problem Gamma Sigma (t1..tn) T] builds a return
- * predicate for Xi that is itself made by an auxiliary 
+ * predicate for Xi that is itself made by an auxiliary
  * pattern-matching problem of which the first clause reveals the
  * pattern structure of the constraints on the inductive types of the t1..tn,
  * and the second clause is a wildcard clause for catching the
@@ -1485,11 +1485,11 @@ let build_inversion_problem loc env evdref tms t =
       alias_stack = [];
       eqn_loc = dummy_loc;
       used = ref false;
-      rhs = { rhs_env = pb_env; 
-              rhs_vars = []; 
+      rhs = { rhs_env = pb_env;
+              rhs_vars = [];
 	      avoid_ids = avoid0;
 	      it = None } } in
-  (* [pb] is the auxiliary pattern-matching serving as skeleton for the 
+  (* [pb] is the auxiliary pattern-matching serving as skeleton for the
       return type of the original problem Xi *)
   let pb =
     { env       = pb_env;
@@ -1520,7 +1520,7 @@ let prepare_predicate_from_tycon loc dep env evdref tomatchs sign c =
   let n,allargs,env',signs = List.fold_left cook (0, [], env, []) tomatchs in
   let names = List.rev (List.map (List.map pi1) signs) in
   names, build_inversion_problem loc env evdref tomatchs c
-  
+
 (* Here, [pred] is assumed to be in the context built from all *)
 (* realargs and terms to match *)
 let build_initial_predicate knowndep allnames pred =
@@ -1547,10 +1547,10 @@ let build_initial_predicate knowndep allnames pred =
 let extract_arity_signature env0 tomatchl tmsign =
   let get_one_sign n tm (na,t) =
     match tm with
-      | NotInd (bo,typ) -> 
+      | NotInd (bo,typ) ->
 	  (match t with
 	    | None -> [na,Option.map (lift n) bo,lift n typ]
-	    | Some (loc,_,_,_) -> 
+	    | Some (loc,_,_,_) ->
  	    user_err_loc (loc,"",
 	    str"Unexpected type annotation for a term of non inductive type."))
       | IsInd (term,IndType(indf,realargs),_) ->
@@ -1598,11 +1598,11 @@ let inh_conv_coerce_to_tycon loc env evdref j tycon =
 
 let prepare_predicate_from_arsign_tycon loc env tomatchs sign arsign c =
   let nar = List.fold_left (fun n sign -> List.length sign + n) 0 arsign in
-  let subst, len = 
+  let subst, len =
     List.fold_left2 (fun (subst, len) (tm, tmtype) sign ->
       let signlen = List.length sign in
 	match kind_of_term tm with
-	  | Rel n when dependent tm c 
+	  | Rel n when dependent tm c
 		&& signlen = 1 (* The term to match is not of a dependent type itself *) ->
 	      ((n, len) :: subst, len - signlen)
 	  | Rel n when signlen > 1 (* The term is of a dependent type,
@@ -1610,12 +1610,12 @@ let prepare_predicate_from_arsign_tycon loc env tomatchs sign arsign c =
 	      (match tmtype with
 		  NotInd _ -> (* len - signlen, subst*) assert false (* signlen > 1 *)
 		| IsInd (_, IndType(indf,realargs),_) ->
-		    let subst = 
-		      if dependent tm c && List.for_all isRel realargs 
-		      then (n, 1) :: subst else subst 
+		    let subst =
+		      if dependent tm c && List.for_all isRel realargs
+		      then (n, 1) :: subst else subst
 		    in
 		      List.fold_left
-			(fun (subst, len) arg -> 
+			(fun (subst, len) arg ->
 			  match kind_of_term arg with
 			  | Rel n when dependent arg c ->
 			      ((n, len) :: subst, pred len)
@@ -1626,16 +1626,16 @@ let prepare_predicate_from_arsign_tycon loc env tomatchs sign arsign c =
   in
   let rec predicate lift c =
     match kind_of_term c with
-      | Rel n when n > lift -> 
-	  (try 
+      | Rel n when n > lift ->
+	  (try
 	      (* Make the predicate dependent on the matched variable *)
 	      let idx = List.assoc (n - lift) subst in
 		mkRel (idx + lift)
-	    with Not_found -> 
+	    with Not_found ->
 	      (* A variable that is not matched, lift over the arsign. *)
 	      mkRel (n + nar))
       | _ ->
-	  map_constr_with_binders succ predicate lift c 
+	  map_constr_with_binders succ predicate lift c
   in predicate 0 c
 
 
@@ -1666,16 +1666,16 @@ let prepare_predicate loc typing_fun evdref env tomatchs sign tycon pred =
            let pred1 = prepare_predicate_from_arsign_tycon loc env' tomatchs sign arsign t in
            let nal1,pred1 = build_initial_predicate KnownDep names1 pred1 in
 	   (* Second strategy: we build an "inversion" predicate *)
-	   let names2,pred2 = 
+	   let names2,pred2 =
 	     prepare_predicate_from_tycon loc true env evdref2 tomatchs sign t
-	   in 
+	   in
 	   let nal2,pred2 = build_initial_predicate DepUnknown names2 pred2 in
 	   [evdref, nal1, pred1; evdref2, nal2, pred2]
        | Some (None, t) ->
 	   (* Only one strategy: we build an "inversion" predicate *)
-	   let names,pred = 
+	   let names,pred =
 	     prepare_predicate_from_tycon loc true env evdref tomatchs sign t
-	   in 
+	   in
 	   let nal,pred = build_initial_predicate DepUnknown names pred in
 	   [evdref, nal, pred]
        | _ ->
@@ -1683,9 +1683,9 @@ let prepare_predicate loc typing_fun evdref env tomatchs sign tycon pred =
 	   let evdref2 = ref !evdref in
 	   let t1 = mkExistential env ~src:(loc, CasesType) evdref in
 	   (* First strategy: we pose a possibly dependent "inversion" evar *)
-	   let names1,pred1 = 
+	   let names1,pred1 =
 	     prepare_predicate_from_tycon loc true env evdref tomatchs sign t1
-	   in 
+	   in
 	   let nal1,pred1 = build_initial_predicate DepUnknown names1 pred1 in
 	   (* Second strategy: we pose a non dependent evar *)
 	   let t2 = mkExistential env ~src:(loc, CasesType) evdref2 in
@@ -1701,34 +1701,34 @@ let prepare_predicate loc typing_fun evdref env tomatchs sign tycon pred =
       let env = List.fold_right push_rels arsign env in
       let allnames = List.rev (List.map (List.map pi1) arsign) in
       let predcclj = typing_fun (mk_tycon (new_Type ())) env evdref rtntyp in
-      let _ = 
-	Option.map (fun tycon -> 
-		      evdref := Coercion.inh_conv_coerces_to loc env !evdref predcclj.uj_val 
+      let _ =
+	Option.map (fun tycon ->
+		      evdref := Coercion.inh_conv_coerces_to loc env !evdref predcclj.uj_val
 		      (lift_tycon_type (List.length arsign) tycon))
 	  tycon
       in
-      let predccl = (j_nf_isevar !evdref predcclj).uj_val in      
+      let predccl = (j_nf_isevar !evdref predcclj).uj_val in
       let nal,pred = build_initial_predicate KnownDep allnames predccl in
       [evdref, nal, pred]
 
 (**************************************************************************)
 (* Main entry of the matching compilation                                 *)
-  
+
 let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, eqns) =
 
   (* We build the matrix of patterns and right-hand-side *)
   let matx = matx_of_eqns env tomatchl eqns in
-    
+
   (* We build the vector of terms to match consistently with the *)
   (* constructors found in patterns *)
   let tomatchs = coerce_to_indtype typing_fun evdref env matx tomatchl in
-    
+
   (* If an elimination predicate is provided, we check it is compatible
      with the type of arguments to match; if none is provided, we
      build alternative possible predicates *)
   let sign = List.map snd tomatchl in
   let preds = prepare_predicate loc typing_fun evdref env tomatchs sign tycon predopt in
-    
+
   let compile_for_one_predicate (myevdref,nal,pred) =
     (* We push the initial terms to match and push their alias to rhs' envs *)
     (* names of aliases will be recovered from patterns (hence Anonymous *)
diff --git a/pretyping/cases.mli b/pretyping/cases.mli
index 4b203586a..e6d42e10d 100644
--- a/pretyping/cases.mli
+++ b/pretyping/cases.mli
@@ -65,7 +65,7 @@ module type S = sig
   val compile_cases :
     loc -> case_style ->
     (type_constraint -> env -> evar_defs ref -> rawconstr -> unsafe_judgment) * evar_defs ref ->
-    type_constraint -> 
+    type_constraint ->
     env -> rawconstr option * tomatch_tuples * cases_clauses ->
     unsafe_judgment
 end
diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index 70cf980f4..8c03d0df4 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -75,7 +75,7 @@ and cbv_stack =
   | CASE of constr * constr array * case_info * cbv_value subs * cbv_stack
 
 (* les vars pourraient etre des constr,
-   cela permet de retarder les lift: utile ?? *) 
+   cela permet de retarder les lift: utile ?? *)
 
 (* relocation of a value; used when a value stored in a context is expanded
  * in a larger context. e.g.  [%k (S.t)](k+1) --> [^k]t  (t is shifted of k)
@@ -173,7 +173,7 @@ let fixp_reducible flgs ((reci,i),_) stk =
               CONSTR _ -> true
             | _ -> false)
       | _ -> false
-  else 
+  else
     false
 
 let cofixp_reducible flgs _ stk =
@@ -181,7 +181,7 @@ let cofixp_reducible flgs _ stk =
     match stk with
       | (CASE _ | APP(_,CASE _)) -> true
       | _ -> false
-  else 
+  else
     false
 
 
@@ -261,7 +261,7 @@ and norm_head_ref k info env stack normt =
  * env, with context stack, i.e. ([env]t stack).  First computes weak
  * head normal form of t and checks if a redex appears with the stack.
  * If so, recursive call to reach the real head normal form.  If not,
- * we build a value. 
+ * we build a value.
  *)
 and cbv_stack_term info stack env t =
   match norm_head info env t stack with
@@ -297,15 +297,15 @@ and cbv_stack_term info stack env t =
 	let cargs =
           Array.sub args ci.ci_npar (Array.length args - ci.ci_npar) in
         cbv_stack_term info (stack_app cargs stk) env br.(n-1)
-         
+
     (* constructor of arity 0 in a Case -> IOTA *)
     | (CONSTR((_,n),_), CASE(_,br,_,env,stk))
             when red_set (info_flags info) fIOTA ->
                     cbv_stack_term info stk env br.(n-1)
 
-    (* may be reduced later by application *)  
-    | (FIXP(fix,env,[||]), APP(appl,TOP)) -> FIXP(fix,env,appl) 
-    | (COFIXP(cofix,env,[||]), APP(appl,TOP)) -> COFIXP(cofix,env,appl) 
+    (* may be reduced later by application *)
+    | (FIXP(fix,env,[||]), APP(appl,TOP)) -> FIXP(fix,env,appl)
+    | (COFIXP(cofix,env,[||]), APP(appl,TOP)) -> COFIXP(cofix,env,appl)
     | (CONSTR(c,[||]), APP(appl,TOP)) -> CONSTR(c,appl)
 
     (* definitely a value *)
@@ -350,14 +350,14 @@ and cbv_norm_value info = function (* reduction under binders *)
         (mkFix (lij,
 		(names,
                  Array.map (cbv_norm_term info env) lty,
-		 Array.map (cbv_norm_term info 
+		 Array.map (cbv_norm_term info
 			      (subs_liftn (Array.length lty) env)) bds)),
          Array.map (cbv_norm_value info) args)
   | COFIXP ((j,(names,lty,bds)),env,args) ->
       mkApp
         (mkCoFix (j,
 		  (names,Array.map (cbv_norm_term info env) lty,
-		   Array.map (cbv_norm_term info 
+		   Array.map (cbv_norm_term info
 				(subs_liftn (Array.length lty) env)) bds)),
          Array.map (cbv_norm_value info) args)
   | CONSTR (c,args) ->
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 348ae46dc..a4b4260ad 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -28,8 +28,8 @@ open Mod_subst
 (* A class is a type constructor, its type is an arity whose number of
    arguments is cl_param (0 for CL_SORT and CL_FUN) *)
 
-type cl_typ = 
-  | CL_SORT 
+type cl_typ =
+  | CL_SORT
   | CL_FUN
   | CL_SECVAR of variable
   | CL_CONST of constant
@@ -82,7 +82,7 @@ let inheritance_graph =
 
 let freeze () = (!class_tab, !coercion_tab, !inheritance_graph)
 
-let unfreeze (fcl,fco,fig) = 
+let unfreeze (fcl,fco,fig) =
   class_tab:=fcl;
   coercion_tab:=fco;
   inheritance_graph:=fig
@@ -93,20 +93,20 @@ let add_new_class cl s =
   if not (Bijint.mem cl !class_tab) then
     class_tab := Bijint.add cl s !class_tab
 
-let add_new_coercion coe s = 
+let add_new_coercion coe s =
   coercion_tab := Gmap.add coe s !coercion_tab
 
 let add_new_path x y =
   inheritance_graph := Gmap.add x y !inheritance_graph
 
 let init () =
-  class_tab:= Bijint.empty; 
+  class_tab:= Bijint.empty;
   add_new_class CL_FUN  { cl_param = 0 };
   add_new_class CL_SORT { cl_param = 0 };
   coercion_tab:= Gmap.empty;
   inheritance_graph:= Gmap.empty
 
-let _ = 
+let _ =
   Summary.declare_summary "inh_graph"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
@@ -151,12 +151,12 @@ let subst_cl_typ subst ct = match ct with
     CL_SORT
   | CL_FUN
   | CL_SECVAR _ -> ct
-  | CL_CONST kn -> 
-      let kn',t = subst_con subst kn in 
+  | CL_CONST kn ->
+      let kn',t = subst_con subst kn in
 	if kn' == kn then ct else
          fst (find_class_type (Global.env()) Evd.empty t)
   | CL_IND (kn,i) ->
-      let kn' = subst_kn subst kn in 
+      let kn' = subst_kn subst kn in
 	if kn' == kn then ct else
 	  CL_IND (kn',i)
 
@@ -166,15 +166,15 @@ let subst_coe_typ subst t = fst (subst_global subst t)
 
 (* class_of : Term.constr -> int *)
 
-let class_of env sigma t = 
-  let (t, n1, i, args) = 
+let class_of env sigma t =
+  let (t, n1, i, args) =
     try
       let (cl,args) = find_class_type env sigma t in
       let (i, { cl_param = n1 } ) = class_info cl in
       (t, n1, i, args)
     with Not_found ->
       let t = Tacred.hnf_constr env sigma t in
-      let (cl, args) = find_class_type env sigma t in 
+      let (cl, args) = find_class_type env sigma t in
       let (i, { cl_param = n1 } ) = class_info cl in
       (t, n1, i, args)
   in
@@ -218,7 +218,7 @@ let apply_on_class_of env sigma t cont =
   with Not_found ->
     (* Is it worth to be more incremental on the delta steps? *)
     let t = Tacred.hnf_constr env sigma t in
-    let (cl, args) = find_class_type env sigma t in 
+    let (cl, args) = find_class_type env sigma t in
     let (i, { cl_param = n1 } ) = class_info cl in
     if List.length args <> n1 then raise Not_found;
     t, cont i
@@ -233,7 +233,7 @@ let lookup_path_between env sigma (s,t) =
 let lookup_path_to_fun_from env sigma s =
   apply_on_class_of env sigma s lookup_path_to_fun_from_class
 
-let lookup_path_to_sort_from env sigma s = 
+let lookup_path_to_sort_from env sigma s =
   apply_on_class_of env sigma s lookup_path_to_sort_from_class
 
 let get_coercion_constructor coe =
@@ -241,7 +241,7 @@ let get_coercion_constructor coe =
     Reductionops.whd_betadeltaiota_stack (Global.env()) Evd.empty coe.coe_value
   in
   match kind_of_term c with
-  | Construct cstr -> 
+  | Construct cstr ->
       (cstr, Inductiveops.constructor_nrealargs (Global.env()) cstr -1)
   | _ ->
       raise Not_found
@@ -263,14 +263,14 @@ let path_printer = ref (fun _ -> str "<a class path>"
                         : (int * int) * inheritance_path -> std_ppcmds)
 
 let install_path_printer f = path_printer := f
- 
+
 let print_path x = !path_printer x
 
-let message_ambig l = 
+let message_ambig l =
   (str"Ambiguous paths:" ++ spc () ++
    prlist_with_sep pr_fnl (fun ijp -> print_path ijp) l)
 
-(* add_coercion_in_graph : coe_index * cl_index * cl_index -> unit 
+(* add_coercion_in_graph : coe_index * cl_index * cl_index -> unit
                          coercion,source,target *)
 
 let different_class_params i j =
@@ -281,7 +281,7 @@ let add_coercion_in_graph (ic,source,target) =
   let ambig_paths =
     (ref [] : ((cl_index * cl_index) * inheritance_path) list ref) in
   let try_add_new_path (i,j as ij) p =
-    try 
+    try
       if i=j then begin
 	if different_class_params i j then begin
 	  let _ = lookup_path_between_class ij in
@@ -297,26 +297,26 @@ let add_coercion_in_graph (ic,source,target) =
       true
     end
   in
-  let try_add_new_path1 ij p = 
-    let _ = try_add_new_path ij p in () 
+  let try_add_new_path1 ij p =
+    let _ = try_add_new_path ij p in ()
   in
   if try_add_new_path (source,target) [ic] then begin
-    Gmap.iter 
+    Gmap.iter
       (fun (s,t) p ->
          if s<>t then begin
 	   if t = source then begin
              try_add_new_path1 (s,target) (p@[ic]);
              Gmap.iter
 	       (fun (u,v) q ->
-                  if u<>v & (u = target) & (p <> q) then 
+                  if u<>v & (u = target) & (p <> q) then
 		    try_add_new_path1 (s,v) (p@[ic]@q))
                old_inheritance_graph
            end;
            if s = target then try_add_new_path1 (source,t) (ic::p)
 	 end)
-      old_inheritance_graph 
+      old_inheritance_graph
   end;
-  if (!ambig_paths <> []) && is_verbose () then 
+  if (!ambig_paths <> []) && is_verbose () then
     ppnl (message_ambig !ambig_paths)
 
 type coercion = coe_typ * locality * bool * cl_typ * cl_typ * int
@@ -343,7 +343,7 @@ let load_coercion i (_,(coe,stre,isid,cls,clt,ps)) =
   add_class clt;
   let is,_ = class_info cls in
   let it,_ = class_info clt in
-  let xf = 
+  let xf =
     { coe_value = constr_of_global coe;
       coe_type = Global.type_of_global coe;
       coe_strength = stre;
@@ -368,7 +368,7 @@ let discharge_cl = function
   | cl -> cl
 
 let discharge_coercion (_,(coe,stre,isid,cls,clt,ps)) =
-  if stre = Local then None else 
+  if stre = Local then None else
     let n = try Array.length (Lib.section_instance coe) with Not_found -> 0 in
     Some (Lib.discharge_global coe,
           stre,
@@ -378,7 +378,7 @@ let discharge_coercion (_,(coe,stre,isid,cls,clt,ps)) =
           n + ps)
 
 let (inCoercion,_) =
-  declare_object {(default_object "COERCION") with 
+  declare_object {(default_object "COERCION") with
     load_function = load_coercion;
     cache_function = cache_coercion;
     subst_function = subst_coercion;
@@ -401,7 +401,7 @@ let inheritance_graph () = Gmap.to_list !inheritance_graph
 let coercion_of_reference r =
   let ref = Nametab.global r in
   if not (coercion_exists ref) then
-    errorlabstrm "try_add_coercion" 
+    errorlabstrm "try_add_coercion"
       (Nametab.pr_global_env Idset.empty ref ++ str" is not a coercion.");
   ref
 
diff --git a/pretyping/classops.mli b/pretyping/classops.mli
index a5f139ab1..63d5b0a4e 100644
--- a/pretyping/classops.mli
+++ b/pretyping/classops.mli
@@ -19,9 +19,9 @@ open Mod_subst
 (*i*)
 
 (*s This is the type of class kinds *)
-type cl_typ = 
-  | CL_SORT 
-  | CL_FUN 
+type cl_typ =
+  | CL_SORT
+  | CL_FUN
   | CL_SECVAR of variable
   | CL_CONST of constant
   | CL_IND of inductive
@@ -36,7 +36,7 @@ type cl_info_typ = {
 type coe_typ = Libnames.global_reference
 
 (* This is the type of infos for declared coercions *)
-type coe_info_typ 
+type coe_info_typ
 
 (* [cl_index] is the type of class keys *)
 type cl_index
@@ -65,7 +65,7 @@ val inductive_class_of : inductive -> cl_index
 val class_args_of : env -> evar_map -> types -> constr list
 
 (*s [declare_coercion] adds a coercion in the graph of coercion paths *)
-val declare_coercion : 
+val declare_coercion :
   coe_typ -> locality -> isid:bool ->
       src:cl_typ -> target:cl_typ -> params:int -> unit
 
@@ -77,18 +77,18 @@ val coercion_value : coe_index -> (unsafe_judgment * bool)
 (*s Lookup functions for coercion paths *)
 val lookup_path_between_class : cl_index * cl_index -> inheritance_path
 
-val lookup_path_between : env -> evar_map -> types * types -> 
+val lookup_path_between : env -> evar_map -> types * types ->
       types * types * inheritance_path
 val lookup_path_to_fun_from : env -> evar_map -> types ->
       types * inheritance_path
-val lookup_path_to_sort_from : env -> evar_map -> types -> 
+val lookup_path_to_sort_from : env -> evar_map -> types ->
       types * inheritance_path
-val lookup_pattern_path_between : 
+val lookup_pattern_path_between :
   inductive * inductive -> (constructor * int) list
 
 (*i Crade *)
 open Pp
-val install_path_printer : 
+val install_path_printer :
   ((cl_index * cl_index) * inheritance_path -> std_ppcmds) -> unit
 (*i*)
 
diff --git a/pretyping/clenv.ml b/pretyping/clenv.ml
index 420cbe290..4b5e40408 100644
--- a/pretyping/clenv.ml
+++ b/pretyping/clenv.ml
@@ -46,7 +46,7 @@ type clausenv = {
 let cl_env ce = ce.env
 let cl_sigma ce =  ce.evd
 
-let subst_clenv sub clenv = 
+let subst_clenv sub clenv =
   { templval = map_fl (subst_mps sub) clenv.templval;
     templtyp = map_fl (subst_mps sub) clenv.templtyp;
     evd = subst_evar_defs_light sub clenv.evd;
@@ -100,7 +100,7 @@ let clenv_environments evd bound t =
 	    (if dep then (subst1 (mkMeta mv) t2) else t2)
       | (n, LetIn (na,b,_,t)) -> clrec (e,metas) n (subst1 b t)
       | (n, _) -> (e, List.rev metas, t)
-  in 
+  in
   clrec (evd,[]) bound t
 
 (* Instantiate the first [bound] products of [t] with evars (all products if
@@ -118,7 +118,7 @@ let clenv_environments_evars env evd bound t =
 	    (if dep then (subst1 constr t2) else t2)
       | (n, LetIn (na,b,_,t)) -> clrec (e,ts) n (subst1 b t)
       | (n, _) -> (e, List.rev ts, t)
-  in 
+  in
   clrec (evd,[]) bound t
 
 let clenv_conv_leq env sigma t c bound =
@@ -144,7 +144,7 @@ let mk_clenv_from_n gls n (c,cty) =
 
 let mk_clenv_from gls = mk_clenv_from_n gls None
 
-let mk_clenv_rename_from_n gls n (c,t) = 
+let mk_clenv_rename_from_n gls n (c,t) =
   mk_clenv_from_n gls n (c,rename_bound_var (pf_env gls) [] t)
 
 let mk_clenv_type_of gls t = mk_clenv_from gls (t,pf_type_of gls t)
@@ -171,14 +171,14 @@ let error_incompatible_inst clenv mv  =
   match na with
       Name id ->
         errorlabstrm "clenv_assign"
-          (str "An incompatible instantiation has already been found for " ++ 
+          (str "An incompatible instantiation has already been found for " ++
            pr_id id)
     | _ ->
         anomaly "clenv_assign: non dependent metavar already assigned"
 
-(* TODO: replace by clenv_unify (mkMeta mv) rhs ? *)		      
+(* TODO: replace by clenv_unify (mkMeta mv) rhs ? *)
 let clenv_assign mv rhs clenv =
-  let rhs_fls = mk_freelisted rhs in 
+  let rhs_fls = mk_freelisted rhs in
   if meta_exists (mentions clenv mv) rhs_fls.freemetas then
     error "clenv_assign: circularity in unification";
   try
@@ -187,10 +187,10 @@ let clenv_assign mv rhs clenv =
         error_incompatible_inst clenv mv
       else
 	clenv
-    else 
+    else
       let st = (ConvUpToEta 0,TypeNotProcessed) in
       {clenv with evd = meta_assign mv (rhs_fls.rebus,st) clenv.evd}
-  with Not_found -> 
+  with Not_found ->
     error "clenv_assign: undefined meta"
 
 
@@ -216,7 +216,7 @@ let dependent_metas clenv mvs conclmetas =
        Metaset.union deps (clenv_metavars clenv.evd mv))
     mvs conclmetas
 
-let duplicated_metas c = 
+let duplicated_metas c =
   let rec collrec (one,more as acc) c =
     match kind_of_term c with
     | Meta mv -> if List.mem mv one then (one,mv::more) else (mv::one,more)
@@ -259,7 +259,7 @@ let clenv_unique_resolver allow_K ?(flags=default_unify_flags) clenv gl =
  * For each dependent evar in the clause-env which does not have a value,
  * pose a value for it by constructing a fresh evar.  We do this in
  * left-to-right order, so that every evar's type is always closed w.r.t.
- * metas. 
+ * metas.
 
  * Node added 14/4/08 [HH]: before this date, evars were collected in
    clenv_dependent by collect_metas in the fold_constr order which is
@@ -271,7 +271,7 @@ let clenv_unique_resolver allow_K ?(flags=default_unify_flags) clenv gl =
    dependency order when a clenv_fchain occurs (because clenv_fchain
    plugs a term with a list of consecutive metas in place of a - a priori -
    arbitrary metavariable belonging to another sequence of consecutive metas:
-   e.g., clenv_fchain may plug (H ?1 ?2) at the position ?6 of 
+   e.g., clenv_fchain may plug (H ?1 ?2) at the position ?6 of
    (nat_ind ?3 ?4 ?5 ?6), leading to a dependency order 3<4<5<1<2).
    To ensure the dependency order, we check that the type of each meta
    to pose is already meta-free, otherwise we postpone the transformation,
@@ -285,13 +285,13 @@ let clenv_unique_resolver allow_K ?(flags=default_unify_flags) clenv gl =
 let clenv_pose_metas_as_evars clenv dep_mvs =
   let rec fold clenv = function
   | [] -> clenv
-  | mv::mvs -> 
+  | mv::mvs ->
       let ty = clenv_meta_type clenv mv in
       (* Postpone the evar-ization if dependent on another meta *)
       (* This assumes no cycle in the dependencies - is it correct ? *)
       if occur_meta ty then fold clenv (mvs@[mv])
       else
-	let (evd,evar) = 
+	let (evd,evar) =
 	  new_evar clenv.evd (cl_env clenv) ~src:(dummy_loc,GoalEvar) ty in
 	let clenv = clenv_assign mv evar {clenv with evd=evd} in
 	fold clenv mvs in
@@ -315,9 +315,9 @@ let connect_clenv gls clenv =
  * resolution can cause unification of already-existing metavars, and
  * of the fresh ones which get created.  This operation is a composite
  * of operations which pose new metavars, perform unification on
- * terms, and make bindings. 
+ * terms, and make bindings.
 
-   Otherwise said, from 
+   Otherwise said, from
 
      [clenv] = [env;sigma;metas |- c:T]
      [clenv'] = [env';sigma';metas' |- d:U]
@@ -334,7 +334,7 @@ let clenv_fchain ?(allow_K=true) ?(flags=default_unify_flags) mv clenv nextclenv
   let clenv' =
     { templval = clenv.templval;
       templtyp = clenv.templtyp;
-      evd = 
+      evd =
         evar_merge (meta_merge clenv.evd nextclenv.evd) clenv.evd;
       env = nextclenv.env } in
   (* unify the type of the template of [nextclenv] with the type of [mv] *)
@@ -346,7 +346,7 @@ let clenv_fchain ?(allow_K=true) ?(flags=default_unify_flags) mv clenv nextclenv
   (* assign the metavar *)
   let clenv''' =
     clenv_assign mv (clenv_term clenv' nextclenv.templval) clenv''
-  in 
+  in
   clenv'''
 
 (***************************************************************)
@@ -368,9 +368,9 @@ let clenv_independent clenv =
 
 let check_bindings bl =
   match list_duplicates (List.map pi2 bl) with
-    | NamedHyp s :: _ -> 
+    | NamedHyp s :: _ ->
 	errorlabstrm ""
-	  (str "The variable " ++ pr_id s ++ 
+	  (str "The variable " ++ pr_id s ++
 	   str " occurs more than once in binding list.");
     | AnonHyp n :: _ ->
 	errorlabstrm ""
@@ -433,7 +433,7 @@ let clenv_match_args bl clenv =
 let clenv_constrain_last_binding c clenv =
   let all_mvs = collect_metas clenv.templval.rebus in
   let k =
-    try list_last all_mvs 
+    try list_last all_mvs
     with Failure _ -> anomaly "clenv_constrain_with_bindings" in
   clenv_assign_binding clenv k (Evd.empty,c)
 
@@ -444,8 +444,8 @@ let clenv_constrain_dep_args hyps_only bl clenv =
     let occlist = clenv_dependent hyps_only clenv in
     if List.length occlist = List.length bl then
       List.fold_left2 clenv_assign_binding clenv occlist bl
-    else 
-      errorlabstrm "" 
+    else
+      errorlabstrm ""
 	(strbrk "Not the right number of missing arguments (expected " ++
 	 int (List.length occlist) ++ str ").")
 
diff --git a/pretyping/clenv.mli b/pretyping/clenv.mli
index dfa751349..8e4dba5b5 100644
--- a/pretyping/clenv.mli
+++ b/pretyping/clenv.mli
@@ -60,14 +60,14 @@ val mk_clenv_from_env : env -> evar_map -> int option -> constr * types -> claus
 (* linking of clenvs *)
 
 val connect_clenv : evar_info sigma -> clausenv -> clausenv
-val clenv_fchain : 
+val clenv_fchain :
   ?allow_K:bool -> ?flags:unify_flags -> metavariable -> clausenv -> clausenv -> clausenv
 
 (***************************************************************)
 (* Unification with clenvs *)
 
 (* Unifies two terms in a clenv. The boolean is [allow_K] (see [Unification]) *)
-val clenv_unify : 
+val clenv_unify :
   bool -> ?flags:unify_flags -> conv_pb -> constr -> constr -> clausenv -> clausenv
 
 (* unifies the concl of the goal with the type of the clenv *)
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index ee4306b7d..586ad716d 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -24,13 +24,13 @@ open Termops
 
 module type S = sig
   (*s Coercions. *)
-  
+
   (* [inh_app_fun env evd j] coerces [j] to a function; i.e. it
      inserts a coercion into [j], if needed, in such a way it gets as
      type a product; it returns [j] if no coercion is applicable *)
   val inh_app_fun :
     env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment
-    
+
   (* [inh_coerce_to_sort env evd j] coerces [j] to a type; i.e. it
      inserts a coercion into [j], if needed, in such a way it gets as
      type a sort; it fails if no coercion is applicable *)
@@ -42,24 +42,24 @@ module type S = sig
      type its base type (the notion depends on the coercion system) *)
   val inh_coerce_to_base : loc ->
     env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment
-    
+
   (* [inh_coerce_to_prod env evars t] coerces [t] to a product type *)
   val inh_coerce_to_prod : loc ->
     env -> evar_defs -> type_constraint_type -> evar_defs * type_constraint_type
 
-  (* [inh_conv_coerce_to loc env evd j t] coerces [j] to an object of type 
+  (* [inh_conv_coerce_to loc env evd j t] coerces [j] to an object of type
      [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and
      [j.uj_type] are convertible; it fails if no coercion is applicable *)
-  val inh_conv_coerce_to : loc -> 
+  val inh_conv_coerce_to : loc ->
     env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
 
-  val inh_conv_coerce_rigid_to : loc -> 
+  val inh_conv_coerce_rigid_to : loc ->
     env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
 
   (* [inh_conv_coerces_to loc env evd t t'] checks if an object of type [t]
      is coercible to an object of type [t'] adding evar constraints if needed;
      it fails if no coercion exists *)
-  val inh_conv_coerces_to : loc -> 
+  val inh_conv_coerces_to : loc ->
     env -> evar_defs -> types -> type_constraint_type -> evar_defs
 
   (* [inh_pattern_coerce_to loc env evd pat ind1 ind2] coerces the Cases
@@ -81,11 +81,11 @@ module Default = struct
       | h::restl ->
 	  (* On devrait pouvoir s'arranger pour qu'on n'ait pas à faire hnf_constr *)
   	  match kind_of_term (whd_betadeltaiota env Evd.empty typ) with
-	    | Prod (_,c1,c2) -> 
+	    | Prod (_,c1,c2) ->
 		(* Typage garanti par l'appel à app_coercion*)
 		apply_rec (h::acc) (subst1 h c2) restl
 	    | _ -> anomaly "apply_coercion_args"
-    in 
+    in
       apply_rec [] funj.uj_type argl
 
   (* appliquer le chemin de coercions de patterns p *)
@@ -107,21 +107,21 @@ module Default = struct
 
   (* appliquer le chemin de coercions p à hj *)
   let apply_coercion env sigma p hj typ_cl =
-    try 
+    try
       fst (List.fold_left
-             (fun (ja,typ_cl) i -> 
+             (fun (ja,typ_cl) i ->
 		let fv,isid = coercion_value i in
 		let argl = (class_args_of env sigma typ_cl)@[ja.uj_val] in
 		let jres = apply_coercion_args env argl fv in
-		  (if isid then 
+		  (if isid then
 		     { uj_val = ja.uj_val; uj_type = jres.uj_type }
-		   else 
+		   else
 		     jres),
 		jres.uj_type)
              (hj,typ_cl) p)
     with _ -> anomaly "apply_coercion"
 
-  let inh_app_fun env evd j = 
+  let inh_app_fun env evd j =
     let t = whd_betadeltaiota env evd j.uj_type in
       match kind_of_term t with
 	| Prod (_,_,_) -> (evd,j)
@@ -132,7 +132,7 @@ module Default = struct
       	    let t,p =
 	      lookup_path_to_fun_from env ( evd) j.uj_type in
 	      (evd,apply_coercion env ( evd) p j t)
-		
+
   let inh_app_fun env evd j =
     try inh_app_fun env evd j
     with Not_found ->
@@ -142,7 +142,7 @@ module Default = struct
   let inh_tosort_force loc env evd j =
     try
       let t,p = lookup_path_to_sort_from env ( evd) j.uj_type in
-      let j1 = apply_coercion env ( evd) p j t in 
+      let j1 = apply_coercion env ( evd) p j t in
       let j2 = on_judgment_type (whd_evar ( evd)) j1 in
         (evd,type_judgment env j2)
     with Not_found ->
@@ -167,16 +167,16 @@ module Default = struct
       raise NoCoercion
     else
     let v', t' =
-      try 
+      try
 	let t2,t1,p = lookup_path_between env evd (t,c1) in
 	  match v with
-	      Some v -> 
+	      Some v ->
 		let j =
 		  apply_coercion env evd p
 		    {uj_val = v; uj_type = t} t2 in
 		  Some j.uj_val, j.uj_type
 	    | None -> None, t
-      with Not_found -> raise NoCoercion 
+      with Not_found -> raise NoCoercion
     in
       try (the_conv_x_leq env t' c1 evd, v')
       with Reduction.NotConvertible -> raise NoCoercion
@@ -190,12 +190,12 @@ module Default = struct
       kind_of_term (whd_betadeltaiota env evd t),
       kind_of_term (whd_betadeltaiota env evd c1)
     with
-    | Prod (name,t1,t2), Prod (_,u1,u2) -> 
+    | Prod (name,t1,t2), Prod (_,u1,u2) ->
         (* Conversion did not work, we may succeed with a coercion. *)
         (* We eta-expand (hence possibly modifying the original term!) *)
 	(* and look for a coercion c:u1->t1 s.t. fun x:u1 => v' (c x)) *)
 	(* has type forall (x:u1), u2 (with v' recursively obtained) *)
-	let name = match name with 
+	let name = match name with
 	  | Anonymous -> Name (id_of_string "x")
 	  | _ -> name in
 	let env1 = push_rel (name,None,u1) env in
@@ -213,8 +213,8 @@ module Default = struct
   let inh_conv_coerce_to_gen rigidonly loc env evd cj (n, t) =
     match n with
 	None ->
-	  let (evd', val') = 
-	    try 
+	  let (evd', val') =
+	    try
 	      inh_conv_coerce_to_fail loc env evd rigidonly (Some cj.uj_val) cj.uj_type t
 	    with NoCoercion ->
 	      let evd = saturate_evd env evd in
@@ -230,19 +230,19 @@ module Default = struct
   let inh_conv_coerce_to = inh_conv_coerce_to_gen false
   let inh_conv_coerce_rigid_to = inh_conv_coerce_to_gen true
 
-      
+
     let inh_conv_coerces_to loc env (evd : evar_defs) t (abs, t') = evd
-      (* Still problematic, as it changes unification 
-      let nabsinit, nabs = 
+      (* Still problematic, as it changes unification
+      let nabsinit, nabs =
 	match abs with
 	    None -> 0, 0
 	  | Some (init, cur) -> init, cur
       in
-	try 
-	  let (rels, rng) = 
-	    (* a little more effort to get products is needed *) 
+	try
+	  let (rels, rng) =
+	    (* a little more effort to get products is needed *)
 	    try decompose_prod_n nabs t
-	    with _ -> 
+	    with _ ->
 	      if !Flags.debug then
 		msg_warning (str "decompose_prod_n failed");
 	      raise (Invalid_argument "Coercion.inh_conv_coerces_to")
@@ -250,11 +250,11 @@ module Default = struct
 	    (* The final range free variables must have been replaced by evars, we accept only that evars
 	       in rng are applied to free vars. *)
 	    if noccur_with_meta 0 (succ nabsinit) rng then (
-	      let env', t, t' = 
+	      let env', t, t' =
 		let env' = List.fold_right (fun (n, t) env -> push_rel (n, None, t) env) rels env in
 		  env', rng, lift nabs t'
 	      in
-		try 
+		try
 		  pi1 (inh_conv_coerce_to_fail loc env' evd None t t')
 		with NoCoercion ->
 		  evd) (* Maybe not enough information to unify *)
diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli
index ff33d679d..0329cc07c 100644
--- a/pretyping/coercion.mli
+++ b/pretyping/coercion.mli
@@ -21,13 +21,13 @@ open Rawterm
 
 module type S = sig
   (*s Coercions. *)
-  
+
   (* [inh_app_fun env isevars j] coerces [j] to a function; i.e. it
      inserts a coercion into [j], if needed, in such a way it gets as
      type a product; it returns [j] if no coercion is applicable *)
   val inh_app_fun :
     env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment
-    
+
   (* [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it
      inserts a coercion into [j], if needed, in such a way it gets as
      type a sort; it fails if no coercion is applicable *)
@@ -43,22 +43,22 @@ module type S = sig
   (* [inh_coerce_to_prod env isevars t] coerces [t] to a product type *)
   val inh_coerce_to_prod : loc ->
     env -> evar_defs -> type_constraint_type -> evar_defs * type_constraint_type
-    
-  (* [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type 
+
+  (* [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type
      [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and
      [j.uj_type] are convertible; it fails if no coercion is applicable *)
-  val inh_conv_coerce_to : loc -> 
+  val inh_conv_coerce_to : loc ->
     env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
 
-  val inh_conv_coerce_rigid_to : loc -> 
+  val inh_conv_coerce_rigid_to : loc ->
     env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
-    
+
   (* [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t]
      is coercible to an object of type [t'] adding evar constraints if needed;
      it fails if no coercion exists *)
-  val inh_conv_coerces_to : loc -> 
+  val inh_conv_coerces_to : loc ->
     env -> evar_defs -> types -> type_constraint_type -> evar_defs
-   
+
   (* [inh_pattern_coerce_to loc env isevars pat ind1 ind2] coerces the Cases
      pattern [pat] typed in [ind1] into a pattern typed in [ind2];
      raises [Not_found] if no coercion found *)
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 2c3de28a5..f9c872f9e 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -60,7 +60,7 @@ let encode_tuple r =
   x
 
 module PrintingCasesMake =
-  functor (Test : sig 
+  functor (Test : sig
      val encode : reference -> inductive * int array
      val member_message : std_ppcmds -> bool -> std_ppcmds
      val field : string
@@ -81,22 +81,22 @@ module PrintingCasesMake =
   end
 
 module PrintingCasesIf =
-  PrintingCasesMake (struct 
+  PrintingCasesMake (struct
     let encode = encode_bool
     let field = "If"
     let title = "Types leading to pretty-printing of Cases using a `if' form: "
     let member_message s b =
-      str "Cases on elements of " ++ s ++ 
+      str "Cases on elements of " ++ s ++
       str
 	(if b then " are printed using a `if' form"
          else " are not printed using a `if' form")
   end)
 
 module PrintingCasesLet =
-  PrintingCasesMake (struct 
+  PrintingCasesMake (struct
     let encode = encode_tuple
     let field = "Let"
-    let title = 
+    let title =
       "Types leading to a pretty-printing of Cases using a `let' form:"
     let member_message s b =
       str "Cases on elements of " ++ s ++
@@ -115,7 +115,7 @@ open Goptions
 let wildcard_value = ref true
 let force_wildcard () = !wildcard_value
 
-let _ = declare_bool_option 
+let _ = declare_bool_option
 	  { optsync  = true;
 	    optname  = "forced wildcard";
 	    optkey   = ["Printing";"Wildcard"];
@@ -125,7 +125,7 @@ let _ = declare_bool_option
 let synth_type_value = ref true
 let synthetize_type () = !synth_type_value
 
-let _ = declare_bool_option 
+let _ = declare_bool_option
 	  { optsync  = true;
 	    optname  = "pattern matching return type synthesizability";
 	    optkey   = ["Printing";"Synth"];
@@ -135,7 +135,7 @@ let _ = declare_bool_option
 let reverse_matching_value = ref true
 let reverse_matching () = !reverse_matching_value
 
-let _ = declare_bool_option 
+let _ = declare_bool_option
 	  { optsync  = true;
 	    optname  = "pattern-matching reversibility";
 	    optkey   = ["Printing";"Matching"];
@@ -164,23 +164,23 @@ let computable p k =
 
   (nb_lam p = k+1)
   &&
-  let _,ccl = decompose_lam p in 
+  let _,ccl = decompose_lam p in
   noccur_between 1 (k+1) ccl
 
 let avoid_flag isgoal = if isgoal then Some true else None
- 
+
 let lookup_name_as_renamed env t s =
   let rec lookup avoid env_names n c = match kind_of_term c with
     | Prod (name,_,c') ->
 	(match concrete_name (Some true) avoid env_names name c' with
-           | (Name id,avoid') -> 
-	       if id=s then (Some n) 
+           | (Name id,avoid') ->
+	       if id=s then (Some n)
 	       else lookup avoid' (add_name (Name id) env_names) (n+1) c'
 	   | (Anonymous,avoid')    -> lookup avoid' env_names (n+1) (pop c'))
     | LetIn (name,_,_,c') ->
 	(match concrete_name (Some true) avoid env_names name c' with
-           | (Name id,avoid') -> 
-	       if id=s then (Some n) 
+           | (Name id,avoid') ->
+	       if id=s then (Some n)
 	       else lookup avoid' (add_name (Name id) env_names) (n+1) c'
 	   | (Anonymous,avoid')    -> lookup avoid' env_names (n+1) (pop c'))
     | Cast (c,_,_) -> lookup avoid env_names n c
@@ -192,22 +192,22 @@ let lookup_index_as_renamed env t n =
     | Prod (name,_,c') ->
 	  (match concrete_name (Some true) [] empty_names_context name c' with
                (Name _,_) -> lookup n (d+1) c'
-             | (Anonymous,_) -> 
+             | (Anonymous,_) ->
 		 if n=0 then
 		   Some (d-1)
-		 else if n=1 then 
-		   Some d 
-		 else 
+		 else if n=1 then
+		   Some d
+		 else
 		   lookup (n-1) (d+1) c')
     | LetIn (name,_,_,c') ->
 	  (match concrete_name (Some true) [] empty_names_context name c' with
              | (Name _,_) -> lookup n (d+1) c'
-             | (Anonymous,_) -> 
-		 if n=0 then 
-		   Some (d-1) 
-		 else if n=1 then 
-		   Some d 
-		 else 
+             | (Anonymous,_) ->
+		 if n=0 then
+		   Some (d-1)
+		 else if n=1 then
+		   Some d
+		 else
 		   lookup (n-1) (d+1) c'
 	  )
     | Cast (c,_,_) -> lookup n d c
@@ -231,8 +231,8 @@ let rec decomp_branch n nal b (avoid,env as e) c =
       match kind_of_term (strip_outer_cast c) with
 	| Lambda (na,_,c) -> na,c,concrete_let_name
 	| LetIn (na,_,_,c) -> na,c,concrete_name
-	| _ -> 
-	    Name (id_of_string "x"),(applist (lift 1 c, [mkRel 1])), 
+	| _ ->
+	    Name (id_of_string "x"),(applist (lift 1 c, [mkRel 1])),
 	    concrete_name in
     let na',avoid' = f (Some b) avoid env na c in
     decomp_branch (n-1) (na'::nal) b (avoid',add_name na' env) c
@@ -248,14 +248,14 @@ and align_tree nal isgoal (e,c as rhs) = match nal with
   | [] -> [[],rhs]
   | na::nal ->
     match kind_of_term c with
-    | Case (ci,p,c,cl) when c = mkRel (list_index na (snd e)) 
+    | Case (ci,p,c,cl) when c = mkRel (list_index na (snd e))
 	& (* don't contract if p dependent *)
 	computable p (ci.ci_pp_info.ind_nargs) ->
 	let clauses = build_tree na isgoal e ci cl in
 	List.flatten
           (List.map (fun (pat,rhs) ->
 	      let lines = align_tree nal isgoal rhs in
-	      List.map (fun (hd,rest) -> pat::hd,rest) lines) 
+	      List.map (fun (hd,rest) -> pat::hd,rest) lines)
 	    clauses)
     | _ ->
 	let pat = PatVar(dl,update_name na rhs) in
@@ -299,9 +299,9 @@ let it_destRLambda_or_LetIn_names n c =
 (* 	    if occur_rawconstr x c then next (x::l) else x in *)
 	    x
 	  in
-	  let x = next (free_rawvars c) in 
+	  let x = next (free_rawvars c) in
 	  let a = RVar (dl,x) in
-	  aux (n-1) (Name x :: nal) 
+	  aux (n-1) (Name x :: nal)
             (match c with
               | RApp (loc,p,l) -> RApp (loc,c,l@[a])
               | _ -> (RApp (dl,c,[a])))
@@ -311,16 +311,16 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl =
   let (indsp,st,nparams,consnargsl,k) = data in
   let synth_type = synthetize_type () in
   let tomatch = detype c in
-  let alias, aliastyp, pred= 
-    if (not !Flags.raw_print) & synth_type & computable & Array.length bl<>0 
-    then 
+  let alias, aliastyp, pred=
+    if (not !Flags.raw_print) & synth_type & computable & Array.length bl<>0
+    then
       Anonymous, None, None
     else
       match Option.map detype p with
         | None -> Anonymous, None, None
         | Some p ->
             let nl,typ = it_destRLambda_or_LetIn_names k p in
-	    let n,typ = match typ with 
+	    let n,typ = match typ with
               | RLambda (_,x,_,t,c) -> x, c
 	      | _ -> Anonymous, typ in
 	    let aliastyp =
@@ -331,21 +331,21 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl =
   let constructs = Array.init (Array.length bl) (fun i -> (indsp,i+1)) in
   let eqnl = detype_eqns constructs consnargsl bl in
   let tag =
-    try 
+    try
       if !Flags.raw_print then
         RegularStyle
-      else if st = LetPatternStyle then 
+      else if st = LetPatternStyle then
 	st
       else if PrintingLet.active (indsp,consnargsl) then
 	LetStyle
-      else if PrintingIf.active (indsp,consnargsl) then 
+      else if PrintingIf.active (indsp,consnargsl) then
 	IfStyle
-      else 
+      else
 	st
     with Not_found -> st
   in
   match tag with
-  | LetStyle when aliastyp = None -> 
+  | LetStyle when aliastyp = None ->
       let bl' = Array.map detype bl in
       let (nal,d) = it_destRLambda_or_LetIn_names consnargsl.(0) bl'.(0) in
       RLetTuple (dl,nal,(alias,pred),tomatch,d)
@@ -399,7 +399,7 @@ let rec detype (isgoal:bool) avoid env t =
               array_map_to_list (detype isgoal avoid env) args)
     | Const sp -> RRef (dl, ConstRef sp)
     | Evar (ev,cl) ->
-        REvar (dl, ev, 
+        REvar (dl, ev,
                Some (List.map (detype isgoal avoid env) (Array.to_list cl)))
     | Ind ind_sp ->
 	RRef (dl, IndRef ind_sp)
@@ -409,7 +409,7 @@ let rec detype (isgoal:bool) avoid env t =
 	let comp = computable p (ci.ci_pp_info.ind_nargs) in
 	detype_case comp (detype isgoal avoid env)
 	  (detype_eqns isgoal avoid env ci comp)
-	  is_nondep_branch avoid 
+	  is_nondep_branch avoid
 	  (ci.ci_ind,ci.ci_pp_info.style,ci.ci_npar,
 	   ci.ci_cstr_nargs,ci.ci_pp_info.ind_nargs)
 	  (Some p) c bl
@@ -420,7 +420,7 @@ and detype_fix isgoal avoid env (vn,_ as nvn) (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left
       (fun (avoid, env, l) na ->
-	 let id = next_name_away na avoid in 
+	 let id = next_name_away na avoid in
 	 (id::avoid, add_name (Name id) env, id::l))
       (avoid, env, []) names in
   let n = Array.length tys in
@@ -436,7 +436,7 @@ and detype_cofix isgoal avoid env n (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left
       (fun (avoid, env, l) na ->
-	 let id = next_name_away na avoid in 
+	 let id = next_name_away na avoid in
 	 (id::avoid, add_name (Name id) env, id::l))
       (avoid, env, []) names in
   let ntys = Array.length tys in
@@ -455,16 +455,16 @@ and share_names isgoal n l avoid env c t =
         let na = match (na,na') with
             Name _, _ -> na
           | _, Name _ -> na'
-          | _ -> na in 
+          | _ -> na in
         let t = detype isgoal avoid env t in
-	let id = next_name_away na avoid in 
+	let id = next_name_away na avoid in
         let avoid = id::avoid and env = add_name (Name id) env in
         share_names isgoal (n-1) ((Name id,Explicit,None,t)::l) avoid env c c'
     (* May occur for fix built interactively *)
     | LetIn (na,b,t',c), _ when n > 0 ->
         let t' = detype isgoal avoid env t' in
         let b = detype isgoal avoid env b in
-	let id = next_name_away na avoid in 
+	let id = next_name_away na avoid in
         let avoid = id::avoid and env = add_name (Name id) env in
         share_names isgoal n ((Name id,Explicit,Some b,t')::l) avoid env c t
     (* Only if built with the f/n notation or w/o let-expansion in types *)
@@ -473,7 +473,7 @@ and share_names isgoal n l avoid env c t =
     (* If it is an open proof: we cheat and eta-expand *)
     | _, Prod (na',t',c') when n > 0 ->
         let t' = detype isgoal avoid env t' in
-	let id = next_name_away na' avoid in 
+	let id = next_name_away na' avoid in
         let avoid = id::avoid and env = add_name (Name id) env in
         let appc = mkApp (lift 1 c,[|mkRel 1|]) in
         share_names isgoal (n-1) ((Name id,Explicit,None,t')::l) avoid env appc c'
@@ -498,22 +498,22 @@ and detype_eqn isgoal avoid env constr construct_nargs branch =
   let make_pat x avoid env b ids =
     if force_wildcard () & noccurn 1 b then
       PatVar (dl,Anonymous),avoid,(add_name Anonymous env),ids
-    else 
+    else
       let id = next_name_away_in_cases_pattern x avoid in
       PatVar (dl,Name id),id::avoid,(add_name (Name id) env),id::ids
   in
   let rec buildrec ids patlist avoid env n b =
     if n=0 then
-      (dl, ids, 
+      (dl, ids,
        [PatCstr(dl, constr, List.rev patlist,Anonymous)],
        detype isgoal avoid env b)
     else
       match kind_of_term b with
-	| Lambda (x,_,b) -> 
+	| Lambda (x,_,b) ->
 	    let pat,new_avoid,new_env,new_ids = make_pat x avoid env b ids in
             buildrec new_ids (pat::patlist) new_avoid new_env (n-1) b
 
-	| LetIn (x,_,_,b) -> 
+	| LetIn (x,_,_,b) ->
 	    let pat,new_avoid,new_env,new_ids = make_pat x avoid env b ids in
             buildrec new_ids (pat::patlist) new_avoid new_env (n-1) b
 
@@ -527,8 +527,8 @@ and detype_eqn isgoal avoid env constr construct_nargs branch =
             let pat,new_avoid,new_env,new_ids =
 	      make_pat Anonymous avoid env new_b ids in
 	    buildrec new_ids (pat::patlist) new_avoid new_env (n-1) new_b
-	  
-  in 
+
+  in
   buildrec [] [] avoid env construct_nargs branch
 
 and detype_binder isgoal bk avoid env na ty c =
@@ -562,19 +562,19 @@ let rec detype_rel_context where avoid env sign =
 (**********************************************************************)
 (* Module substitution: relies on detyping                            *)
 
-let rec subst_cases_pattern subst pat = 
+let rec subst_cases_pattern subst pat =
   match pat with
   | PatVar _ -> pat
-  | PatCstr (loc,((kn,i),j),cpl,n) -> 
-      let kn' = subst_kn subst kn 
+  | PatCstr (loc,((kn,i),j),cpl,n) ->
+      let kn' = subst_kn subst kn
       and cpl' = list_smartmap (subst_cases_pattern subst) cpl in
 	if kn' == kn && cpl' == cpl then pat else
 	  PatCstr (loc,((kn',i),j),cpl',n)
 
-let rec subst_rawconstr subst raw = 
+let rec subst_rawconstr subst raw =
   match raw with
-  | RRef (loc,ref) -> 
-      let ref',t = subst_global subst ref in 
+  | RRef (loc,ref) ->
+      let ref',t = subst_global subst ref in
 	if ref' == ref then raw else
          detype false [] [] t
 
@@ -582,38 +582,38 @@ let rec subst_rawconstr subst raw =
   | REvar _ -> raw
   | RPatVar _ -> raw
 
-  | RApp (loc,r,rl) -> 
-      let r' = subst_rawconstr subst r 
+  | RApp (loc,r,rl) ->
+      let r' = subst_rawconstr subst r
       and rl' = list_smartmap (subst_rawconstr subst) rl in
 	if r' == r && rl' == rl then raw else
 	  RApp(loc,r',rl')
 
-  | RLambda (loc,n,bk,r1,r2) -> 
+  | RLambda (loc,n,bk,r1,r2) ->
       let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  RLambda (loc,n,bk,r1',r2')
 
-  | RProd (loc,n,bk,r1,r2) -> 
+  | RProd (loc,n,bk,r1,r2) ->
       let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  RProd (loc,n,bk,r1',r2')
 
-  | RLetIn (loc,n,r1,r2) -> 
+  | RLetIn (loc,n,r1,r2) ->
       let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  RLetIn (loc,n,r1',r2')
 
-  | RCases (loc,sty,rtno,rl,branches) -> 
+  | RCases (loc,sty,rtno,rl,branches) ->
       let rtno' = Option.smartmap (subst_rawconstr subst) rtno
       and rl' = list_smartmap (fun (a,x as y) ->
         let a' = subst_rawconstr subst a in
-        let (n,topt) = x in 
+        let (n,topt) = x in
         let topt' = Option.smartmap
           (fun (loc,(sp,i),x,y as t) ->
             let sp' = subst_kn subst sp in
             if sp == sp' then t else (loc,(sp',i),x,y)) topt in
         if a == a' && topt == topt' then y else (a',(n,topt'))) rl
-      and branches' = list_smartmap 
+      and branches' = list_smartmap
 			(fun (loc,idl,cpl,r as branch) ->
 			   let cpl' =
 			     list_smartmap (subst_cases_pattern subst) cpl
@@ -627,20 +627,20 @@ let rec subst_rawconstr subst raw =
 
   | RLetTuple (loc,nal,(na,po),b,c) ->
       let po' = Option.smartmap (subst_rawconstr subst) po
-      and b' = subst_rawconstr subst b 
+      and b' = subst_rawconstr subst b
       and c' = subst_rawconstr subst c in
 	if po' == po && b' == b && c' == c then raw else
           RLetTuple (loc,nal,(na,po'),b',c')
-	        
+
   | RIf (loc,c,(na,po),b1,b2) ->
       let po' = Option.smartmap (subst_rawconstr subst) po
-      and b1' = subst_rawconstr subst b1 
-      and b2' = subst_rawconstr subst b2 
+      and b1' = subst_rawconstr subst b1
+      and b2' = subst_rawconstr subst b2
       and c' = subst_rawconstr subst c in
 	if c' == c & po' == po && b1' == b1 && b2' == b2 then raw else
           RIf (loc,c',(na,po'),b1',b2')
 
-  | RRec (loc,fix,ida,bl,ra1,ra2) -> 
+  | RRec (loc,fix,ida,bl,ra1,ra2) ->
       let ra1' = array_smartmap (subst_rawconstr subst) ra1
       and ra2' = array_smartmap (subst_rawconstr subst) ra2 in
       let bl' = array_smartmap
@@ -655,19 +655,19 @@ let rec subst_rawconstr subst raw =
   | RSort _ -> raw
 
   | RHole (loc,ImplicitArg (ref,i,b)) ->
-      let ref',_ = subst_global subst ref in 
+      let ref',_ = subst_global subst ref in
 	if ref' == ref then raw else
 	  RHole (loc,InternalHole)
   | RHole (loc, (BinderType _ | QuestionMark _ | CasesType | InternalHole |
       TomatchTypeParameter _ | GoalEvar | ImpossibleCase)) -> raw
 
-  | RCast (loc,r1,k) -> 
-      (match k with 
+  | RCast (loc,r1,k) ->
+      (match k with
 	   CastConv (k,r2) ->
 	     let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
 	       if r1' == r1 && r2' == r2 then raw else
 		 RCast (loc,r1', CastConv (k,r2'))
-	 | CastCoerce -> 
+	 | CastCoerce ->
 	     let r1' = subst_rawconstr subst r1 in
 	       if r1' == r1 then raw else RCast (loc,r1',k))
   | RDynamic _ -> raw
diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli
index 72379dfcf..d1e0d1049 100644
--- a/pretyping/detyping.mli
+++ b/pretyping/detyping.mli
@@ -30,9 +30,9 @@ val subst_rawconstr : substitution -> rawconstr -> rawconstr
 
 val detype : bool -> identifier list -> names_context -> constr -> rawconstr
 
-val detype_case : 
+val detype_case :
   bool -> ('a -> rawconstr) ->
-  (constructor array -> int array -> 'a array -> 
+  (constructor array -> int array -> 'a array ->
     (loc * identifier list * cases_pattern list * rawconstr) list) ->
   ('a -> int -> bool) ->
   identifier list -> inductive * case_style * int * int array * int ->
@@ -54,7 +54,7 @@ val synthetize_type : unit -> bool
 (* Utilities to transform kernel cases to simple pattern-matching problem *)
 
 val it_destRLambda_or_LetIn_names : int -> rawconstr -> name list * rawconstr
-val simple_cases_matrix_of_branches : 
+val simple_cases_matrix_of_branches :
   inductive -> int list -> rawconstr list -> cases_clauses
 val return_type_of_predicate :
   inductive -> int -> int -> rawconstr -> predicate_pattern * rawconstr option
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index f197f7a9a..b6e697e4d 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -19,13 +19,13 @@ open Termops
 open Environ
 open Typing
 open Classops
-open Recordops 
+open Recordops
 open Evarutil
 open Libnames
 open Evd
 
 type flex_kind_of_term =
-  | Rigid of constr 
+  | Rigid of constr
   | MaybeFlexible of constr
   | Flexible of existential
 
@@ -93,31 +93,31 @@ let position_problem l2r = function
 let check_conv_record (t1,l1) (t2,l2) =
   try
     let proji = global_of_constr t1 in
-    let canon_s,l2_effective = 
+    let canon_s,l2_effective =
       try
 	match kind_of_term t2 with
 	    Prod (_,a,b) -> (* assert (l2=[]); *)
       	      if dependent (mkRel 1) b then raise Not_found
 	      else lookup_canonical_conversion (proji, Prod_cs),[a;pop b]
-	  | Sort s -> 
-	      lookup_canonical_conversion 
+	  | Sort s ->
+	      lookup_canonical_conversion
 		(proji, Sort_cs (family_of_sort s)),[]
-	  | _ -> 
+	  | _ ->
 	      let c2 = global_of_constr t2 in
 		lookup_canonical_conversion (proji, Const_cs c2),l2
-      with Not_found -> 
+      with Not_found ->
 	lookup_canonical_conversion (proji,Default_cs),[]
     in
-    let { o_DEF = c; o_INJ=n; o_TABS = bs; 
+    let { o_DEF = c; o_INJ=n; o_TABS = bs;
           o_TPARAMS = params; o_NPARAMS = nparams; o_TCOMPS = us } = canon_s in
     let params1, c1, extra_args1 =
-      match list_chop nparams l1 with 
+      match list_chop nparams l1 with
 	| params1, c1::extra_args1 -> params1, c1, extra_args1
 	| _ -> raise Not_found in
     let us2,extra_args2 = list_chop (List.length us) l2_effective in
     c,bs,(params,params1),(us,us2),(extra_args1,extra_args2),c1,
     (n,applist(t2,l2))
-  with Failure _ | Not_found -> 
+  with Failure _ | Not_found ->
     raise Not_found
 
 (* Precondition: one of the terms of the pb is an uninstantiated evar,
@@ -156,12 +156,12 @@ let ise_array2 evd f v1 v2 =
     | n ->
         let (i',b) = f i v1.(n) v2.(n) in
         if b then allrec i' (n-1) else (evd,false)
-  in 
+  in
   let lv1 = Array.length v1 in
-  if lv1 = Array.length v2 then allrec evd (pred lv1) 
+  if lv1 = Array.length v2 then allrec evd (pred lv1)
   else (evd,false)
 
-let rec evar_conv_x env evd pbty term1 term2 = 
+let rec evar_conv_x env evd pbty term1 term2 =
   let sigma =  evd in
   let term1 = whd_castappevar sigma term1 in
   let term2 = whd_castappevar sigma term2 in
@@ -195,7 +195,7 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
   match (flex_kind_of_term term1 l1, flex_kind_of_term term2 l2) with
     | Flexible (sp1,al1 as ev1), Flexible (sp2,al2 as ev2) ->
 	let f1 i =
-	  if List.length l1 > List.length l2 then 
+	  if List.length l1 > List.length l2 then
             let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
             ise_and i
               [(fun i -> solve_simple_eqn evar_conv_x env i
@@ -212,18 +212,18 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	and f2 i =
           if sp1 = sp2 then
             ise_and i
-            [(fun i -> ise_list2 i 
+            [(fun i -> ise_list2 i
                   (fun i -> evar_conv_x env i CONV) l1 l2);
              (fun i -> solve_refl evar_conv_x env i sp1 al1 al2,
                   true)]
           else (i,false)
-	in 
+	in
 	ise_try evd [f1; f2]
 
     | Flexible ev1, MaybeFlexible flex2 ->
 	let f1 i =
-	  if 
-	    is_unification_pattern_evar env ev1 l1 (applist appr2) & 
+	  if
+	    is_unification_pattern_evar env ev1 l1 (applist appr2) &
 	    not (occur_evar (fst ev1) (applist appr2))
 	  then
 	    (* Miller-Pfenning's patterns unification *)
@@ -250,13 +250,13 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	    | Some v2 ->
 		evar_eqappr_x env i pbty appr1 (evar_apprec env i l2 v2)
 	    | None -> (i,false)
-	in 
+	in
 	ise_try evd [f1; f4]
 
     | MaybeFlexible flex1, Flexible ev2 ->
 	let f1 i =
-	  if 
-	    is_unification_pattern_evar env ev2 l2 (applist appr1) & 
+	  if
+	    is_unification_pattern_evar env ev2 l2 (applist appr1) &
 	    not (occur_evar (fst ev2) (applist appr1))
 	  then
 	    (* Miller-Pfenning's patterns unification *)
@@ -282,7 +282,7 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	    | Some v1 ->
 		evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
 	    | None -> (i,false)
-	in 
+	in
 	ise_try evd [f1; f4]
 
     | MaybeFlexible flex1, MaybeFlexible flex2 ->
@@ -320,12 +320,12 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 		| Some v1 ->
 		    evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
 		| None -> (i,false)
-	in 
+	in
 	ise_try evd [f1; f2; f3]
 
     | Flexible ev1, Rigid _ ->
-	if 
-	  is_unification_pattern_evar env ev1 l1 (applist appr2) & 
+	if
+	  is_unification_pattern_evar env ev1 l1 (applist appr2) &
 	  not (occur_evar (fst ev1) (applist appr2))
 	then
 	  (* Miller-Pfenning's patterns unification *)
@@ -340,8 +340,8 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	  true
 
     | Rigid _, Flexible ev2 ->
-	if 
-	  is_unification_pattern_evar env ev2 l2 (applist appr1) & 
+	if
+	  is_unification_pattern_evar env ev2 l2 (applist appr1) &
 	  not (occur_evar (fst ev2) (applist appr1))
 	then
 	  (* Miller-Pfenning's patterns unification *)
@@ -364,11 +364,11 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	    | Some v1 ->
  		evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
 	    | None -> (i,false)
-	in 
+	in
 	ise_try evd [f3; f4]
-	     
-    | Rigid _ , MaybeFlexible flex2 -> 
-	let f3 i = 
+
+    | Rigid _ , MaybeFlexible flex2 ->
+	let f3 i =
 	  (try conv_record env i (check_conv_record appr2 appr1)
            with Not_found -> (i,false))
 	and f4 i =
@@ -376,11 +376,11 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	    | Some v2 ->
  		evar_eqappr_x env i pbty appr1 (evar_apprec env i l2 v2)
 	    | None -> (i,false)
-	in 
+	in
 	ise_try evd [f3; f4]
 
     | Rigid c1, Rigid c2 -> match kind_of_term c1, kind_of_term c2 with
-	  
+
 	| Cast (c1,_,_), _ -> evar_eqappr_x env evd pbty (c1,l1) appr2
 
 	| _, Cast (c2,_,_) -> evar_eqappr_x env evd pbty appr1 (c2,l2)
@@ -388,7 +388,7 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	| Sort s1, Sort s2 when l1=[] & l2=[] ->
             (evd,base_sort_cmp pbty s1 s2)
 
-	| Lambda (na,c1,c'1), Lambda (_,c2,c'2) when l1=[] & l2=[] -> 
+	| Lambda (na,c1,c'1), Lambda (_,c2,c'2) when l1=[] & l2=[] ->
             ise_and evd
               [(fun i -> evar_conv_x env i CONV c1 c2);
                (fun i ->
@@ -409,7 +409,7 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
               let appr1 = evar_apprec env i l1 (subst1 b1 c'1)
               and appr2 = evar_apprec env i l2 (subst1 b2 c'2)
 	      in evar_eqappr_x env i pbty appr1 appr2
-	    in 
+	    in
 	    ise_try evd [f1; f2]
 
 	| LetIn (_,b1,_,c'1), _ ->(* On fait commuter les args avec le Let *)
@@ -420,7 +420,7 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	    let appr2 = evar_apprec env evd l2 (subst1 b2 c'2)
             in evar_eqappr_x env evd pbty appr1 appr2
 
-	| Prod (n,c1,c'1), Prod (_,c2,c'2) when l1=[] & l2=[] -> 
+	| Prod (n,c1,c'1), Prod (_,c2,c'2) when l1=[] & l2=[] ->
             ise_and evd
               [(fun i -> evar_conv_x env i CONV c1 c2);
                (fun i ->
@@ -474,13 +474,13 @@ and evar_eqappr_x env evd pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	| (Ind _ | Construct _ | Sort _ | Prod _), _ -> (evd,false)
 	| _, (Ind _ | Construct _ | Sort _ | Prod _) -> (evd,false)
 
-	| (App _ | Case _ | Fix _ | CoFix _), 
+	| (App _ | Case _ | Fix _ | CoFix _),
 	  (App _ | Case _ | Fix _ | CoFix _) -> (evd,false)
 
 	| (Rel _ | Var _ | Const _ | Evar _), _ -> assert false
 	| _, (Rel _ | Var _ | Const _ | Evar _) -> assert false
 
-and conv_record env evd (c,bs,(params,params1),(us,us2),(ts,ts1),c1,(n,t2)) = 
+and conv_record env evd (c,bs,(params,params1),(us,us2),(ts,ts1),c1,(n,t2)) =
   let (evd',ks,_) =
     List.fold_left
       (fun (i,ks,m) b ->
@@ -535,7 +535,7 @@ let apply_conversion_problem_heuristic env evd pbty t1 t2 =
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
       choose_less_dependent_instance evk1 evd term2 args1, true
-  | (Rel _|Var _), Evar (evk2,args2) when l1 = [] & l2 = [] 
+  | (Rel _|Var _), Evar (evk2,args2) when l1 = [] & l2 = []
       & array_for_all (fun a -> a = term1 or isEvar a) args2 ->
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
@@ -569,7 +569,7 @@ let the_conv_x_leq env t1 t2 evd =
   match evar_conv_x env evd CUMUL t1 t2 with
       (evd', true) -> evd'
     | _ -> raise Reduction.NotConvertible
- 
+
 let e_conv env evd t1 t2 =
   match evar_conv_x env !evd CONV t1 t2 with
       (evd',true) -> evd := evd'; true
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index a281a3898..a85f0f739 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -20,7 +20,7 @@ open Evd
 val the_conv_x     : env -> constr -> constr -> evar_defs -> evar_defs
 val the_conv_x_leq : env -> constr -> constr -> evar_defs -> evar_defs
 
-(* The same function resolving evars by side-effect and 
+(* The same function resolving evars by side-effect and
    catching the exception *)
 val e_conv  : env -> evar_defs ref -> constr -> constr -> bool
 val e_cumul : env -> evar_defs ref -> constr -> constr -> bool
@@ -28,7 +28,7 @@ val e_cumul : env -> evar_defs ref -> constr -> constr -> bool
 (*i For debugging *)
 val evar_conv_x :
   env -> evar_defs -> conv_pb -> constr -> constr -> evar_defs * bool
-val evar_eqappr_x : 
+val evar_eqappr_x :
   env -> evar_defs ->
     conv_pb -> constr * constr list -> constr * constr list ->
       evar_defs * bool
@@ -39,5 +39,5 @@ val consider_remaining_unif_problems : env -> evar_defs -> evar_defs * bool
 val check_conv_record : constr * types list -> constr * types list ->
   constr * constr list * (constr list * constr list) *
     (constr list * types list) *
-    (constr list * types list) * constr * 
+    (constr list * types list) * constr *
     (int * constr)
diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml
index 451860477..8d19feea4 100644
--- a/pretyping/evarutil.ml
+++ b/pretyping/evarutil.ml
@@ -38,7 +38,7 @@ let rec whd_ise sigma c =
 
 
 (* Expand evars, possibly in the head of an application *)
-let whd_castappevar_stack sigma c = 
+let whd_castappevar_stack sigma c =
   let rec whrec (c, l as s) =
     match kind_of_term c with
       | Evar (evk,args as ev) when Evd.mem sigma evk & Evd.is_defined sigma evk
@@ -46,7 +46,7 @@ let whd_castappevar_stack sigma c =
       | Cast (c,_,_) -> whrec (c, l)
       | App (f,args) -> whrec (f, Array.fold_right (fun a l -> a::l) args l)
       | _ -> s
-  in 
+  in
   whrec (c, [])
 
 let whd_castappevar sigma c = applist (whd_castappevar_stack sigma c)
@@ -57,19 +57,19 @@ let jl_nf_evar = Pretype_errors.jl_nf_evar
 let jv_nf_evar = Pretype_errors.jv_nf_evar
 let tj_nf_evar = Pretype_errors.tj_nf_evar
 
-let nf_named_context_evar sigma ctx = 
+let nf_named_context_evar sigma ctx =
   Sign.map_named_context (Reductionops.nf_evar sigma) ctx
 
-let nf_rel_context_evar sigma ctx = 
+let nf_rel_context_evar sigma ctx =
   Sign.map_rel_context (Reductionops.nf_evar sigma) ctx
-    
-let nf_env_evar sigma env = 
+
+let nf_env_evar sigma env =
   let nc' = nf_named_context_evar sigma (Environ.named_context env) in
   let rel' = nf_rel_context_evar sigma (Environ.rel_context env) in
     push_rel_context rel' (reset_with_named_context (val_of_named_context nc') env)
 
 let nf_evar_info evc info =
-  { info with 
+  { info with
     evar_concl = Reductionops.nf_evar evc info.evar_concl;
     evar_hyps = map_named_val (Reductionops.nf_evar evc) info.evar_hyps;
     evar_body = match info.evar_body with
@@ -110,13 +110,13 @@ let collect_evars emap c =
 
 let push_dependent_evars sigma emap =
   Evd.fold (fun ev {evar_concl = ccl} (sigma',emap') ->
-    List.fold_left 
-      (fun (sigma',emap') ev -> 
+    List.fold_left
+      (fun (sigma',emap') ev ->
 	(Evd.add sigma' ev (Evd.find emap' ev),Evd.remove emap' ev))
       (sigma',emap') (collect_evars emap' ccl))
     emap (sigma,emap)
 
-let push_duplicated_evars sigma emap c = 
+let push_duplicated_evars sigma emap c =
   let rec collrec (one,(sigma,emap) as acc) c =
     match kind_of_term c with
     | Evar (evk,_) when not (Evd.mem sigma evk) ->
@@ -149,11 +149,11 @@ let evars_to_metas sigma (emap, c) =
 
 (* The list of non-instantiated existential declarations *)
 
-let non_instantiated sigma = 
+let non_instantiated sigma =
   let listev = to_list sigma in
-  List.fold_left 
-    (fun l (ev,evi) -> 
-       if evi.evar_body = Evar_empty then 
+  List.fold_left
+    (fun l (ev,evi) ->
+       if evi.evar_body = Evar_empty then
 	 ((ev,nf_evar_info sigma evi)::l) else l)
     [] listev
 
@@ -194,7 +194,7 @@ let new_evar_instance sign evd typ ?(src=(dummy_loc,InternalHole)) ?filter insta
 
 let make_projectable_subst sigma evi args =
   let sign = evar_filtered_context evi in
-  let rec alias_of_var id = 
+  let rec alias_of_var id =
     match pi2 (Sign.lookup_named id sign) with
     | Some t when isVar t -> alias_of_var (destVar t)
     | _ -> id in
@@ -217,12 +217,12 @@ let make_pure_subst evi args =
 
 (* [push_rel_context_to_named_context] builds the defining context and the
  * initial instance of an evar. If the evar is to be used in context
- * 
+ *
  * Gamma =  a1     ...    an xp      ...       x1
  *          \- named part -/ \- de Bruijn part -/
- * 
+ *
  * then the x1...xp are turned into variables so that the evar is declared in
- * context 
+ * context
  *
  *          a1     ...    an xp      ...       x1
  *          \----------- named part ------------/
@@ -230,7 +230,7 @@ let make_pure_subst evi args =
  * but used applied to the initial instance "a1 ... an Rel(p) ... Rel(1)"
  * so that ev[a1:=a1 ... an:=an xp:=Rel(p) ... x1:=Rel(1)] is correctly typed
  * in context Gamma.
- * 
+ *
  * Remark 1: The instance is reverted in practice (i.e. Rel(1) comes first)
  * Remark 2: If some of the ai or xj are definitions, we keep them in the
  *   instance. This is necessary so that no unfolding of local definitions
@@ -239,7 +239,7 @@ let make_pure_subst evi args =
  *   we want the hole to be instantiated by x', not by x (which would have the
  *   case in [invert_instance] if x' had disappear of the instance).
  *   Note that at any time, if, in some context env, the instance of
- *   declaration x:A is t and the instance of definition x':=phi(x) is u, then 
+ *   declaration x:A is t and the instance of definition x':=phi(x) is u, then
  *   we have the property that u and phi(t) are convertible in env.
  *)
 
@@ -259,7 +259,7 @@ let push_rel_context_to_named_context env typ =
 	(mkVar id :: subst, id::avoid, push_named d env))
       (rel_context env) ~init:([], ids, env) in
   (named_context_val env, substl subst typ, inst_rels@inst_vars)
-      
+
 (* [new_evar] declares a new existential in an env env with type typ *)
 (* Converting the env into the sign of the evar to define *)
 
@@ -288,9 +288,9 @@ let is_pattern inst =
 *)
 
 
-(* We have x1..xq |- ?e1 and had to solve something like 
- * Σ; Γ |- ?e1[u1..uq] = (...\y1 ... \yk ... c), where c is typically some 
- * ?e2[v1..vn], hence flexible. We had to go through k binders and now 
+(* We have x1..xq |- ?e1 and had to solve something like
+ * Σ; Γ |- ?e1[u1..uq] = (...\y1 ... \yk ... c), where c is typically some
+ * ?e2[v1..vn], hence flexible. We had to go through k binders and now
  * virtually have x1..xq, y1..yk | ?e1' and the equation
  * Γ, y1..yk |- ?e1'[u1..uq y1..yk] = c.
  * What we do is to formally introduce ?e1' in context x1..xq, Γ, y1..yk,
@@ -299,10 +299,10 @@ let is_pattern inst =
  *
  * In fact, we optimize a little and try to compute a maximum
  * common subpart of x1..xq and Γ. This is done by detecting the
- * longest subcontext x1..xp such that Γ = x1'..xp' z1..zm and 
+ * longest subcontext x1..xp such that Γ = x1'..xp' z1..zm and
  * u1..up = x1'..xp'.
  *
- * At the end, we return ?e1'[x1..xn z1..zm y1..yk] so that ?e1 can be 
+ * At the end, we return ?e1'[x1..xn z1..zm y1..yk] so that ?e1 can be
  * instantiated by (...\y1 ... \yk ... ?e1[x1..xn z1..zm y1..yk]) and the
  * new problem is Σ; Γ, y1..yk |- ?e1'[u1..un z1..zm y1..yk] = c,
  * making the z1..zm unavailable.
@@ -316,10 +316,10 @@ let shrink_context env subst ty =
   (* We merge the contexts (optimization) *)
   let rec shrink_rel i subst rel_subst rev_rel_sign =
     match subst,rev_rel_sign with
-    | (id,c)::subst,_::rev_rel_sign when c = mkRel i -> 
+    | (id,c)::subst,_::rev_rel_sign when c = mkRel i ->
 	shrink_rel (i-1) subst (mkVar id::rel_subst) rev_rel_sign
     | _ ->
-	substl_rel_context rel_subst (List.rev rev_rel_sign), 
+	substl_rel_context rel_subst (List.rev rev_rel_sign),
 	substl rel_subst ty
   in
   let rec shrink_named subst named_subst rev_named_sign =
@@ -364,7 +364,7 @@ let extend_evar env evdref k (evk1,args1) c =
 let subfilter p filter l =
   let (filter,_,l) =
     List.fold_left (fun (filter,l,newl) b ->
-      if b then 
+      if b then
 	let a,l' = match l with a::args -> a,args | _ -> assert false in
 	if p a then (true::filter,l',a::newl) else (false::filter,l',newl)
       else (false::filter,l,newl))
@@ -400,10 +400,10 @@ let rec check_and_clear_in_constr evdref err ids c =
   (* returns a new constr where all the evars have been 'cleaned'
      (ie the hypotheses ids have been removed from the contexts of
      evars) *)
-  let check id' = 
+  let check id' =
     if List.mem id' ids then
       raise (ClearDependencyError (id',err))
-  in 
+  in
     match kind_of_term c with
       | Var id' ->
 	  check id'; c
@@ -412,12 +412,12 @@ let rec check_and_clear_in_constr evdref err ids c =
           let vars = Environ.vars_of_global (Global.env()) c in
             List.iter check vars; c
 
-      | Evar (evk,l as ev) -> 
+      | Evar (evk,l as ev) ->
 	  if Evd.is_defined_evar !evdref ev then
 	    (* If evk is already defined we replace it by its definition *)
-	    let nc = whd_evar !evdref c in 
+	    let nc = whd_evar !evdref c in
 	      (check_and_clear_in_constr evdref err ids nc)
-	  else 
+	  else
 	    (* We check for dependencies to elements of ids in the
 	       evar_info corresponding to e and in the instance of
 	       arguments. Concurrently, we build a new evar
@@ -426,11 +426,11 @@ let rec check_and_clear_in_constr evdref err ids c =
 	    let evi = Evd.find !evdref evk in
 	    let ctxt = Evd.evar_filtered_context evi in
 	    let (nhyps,nargs,rids) =
-	      List.fold_right2 
+	      List.fold_right2
 		(fun (rid,ob,c as h) a (hy,ar,ri) ->
 		  (* Check if some id to clear occurs in the instance
 		     a of rid in ev and remember the dependency *)
-		  match 
+		  match
 		    List.filter (fun id -> List.mem id ids) (collect_vars a)
 		  with
 		  | id :: _ -> (hy,ar,(rid,id)::ri)
@@ -448,8 +448,8 @@ let rec check_and_clear_in_constr evdref err ids c =
 	       in the type of ev and adjust the source of the dependency *)
 	    let nconcl =
 	      try check_and_clear_in_constr evdref (EvarTypingBreak ev)
-		    (List.map fst rids) (evar_concl evi) 
-	      with ClearDependencyError (rid,err) -> 
+		    (List.map fst rids) (evar_concl evi)
+	      with ClearDependencyError (rid,err) ->
 		raise (ClearDependencyError (List.assoc rid rids,err)) in
 
 	    let env = Sign.fold_named_context push_named nhyps ~init:(empty_env) in
@@ -466,7 +466,7 @@ let clear_hyps_in_evi evdref hyps concl ids =
      the contexts of the evars occuring in evi *)
   let nconcl =
     check_and_clear_in_constr evdref (OccurHypInSimpleClause None) ids concl in
-  let nhyps = 
+  let nhyps =
     let check_context (id,ob,c) =
       let err = OccurHypInSimpleClause (Some id) in
       (id, Option.map (check_and_clear_in_constr evdref err ids) ob,
@@ -488,7 +488,7 @@ let clear_hyps_in_evi evdref hyps concl ids =
   (nhyps,nconcl)
 
 
-(* Expand rels and vars that are bound to other rels or vars so that 
+(* Expand rels and vars that are bound to other rels or vars so that
    dependencies in variables are canonically associated to the most ancient
    variable in its family of aliased variables *)
 
@@ -513,7 +513,7 @@ let rec expand_var_at_least_once env x =
 
 let expand_var env x =
   try expand_var_at_least_once env x with Not_found -> x
-  
+
 let expand_var_opt env x =
   try Some (expand_var_at_least_once env x) with Not_found -> None
 
@@ -522,7 +522,7 @@ let rec expand_vars_in_term env t = match kind_of_term t with
   | _ -> map_constr_with_full_binders push_rel expand_vars_in_term env t
 
 let rec expansions_of_var env x =
-  try 
+  try
     let t = expand_var_once env x in
     t :: expansions_of_var env t
   with Not_found ->
@@ -534,7 +534,7 @@ let rec expansions_of_var env x =
  *
  * - ?n[...;x:=y;...] = y
  * - ?n[...;x:=?m[args];...] = y with ?m[args] = y recursively solvable
- *   
+ *
  * (see test-suite/success/Fixpoint.v for an example of application of
  * the second kind of problem).
  *
@@ -563,8 +563,8 @@ let rec expansions_of_var env x =
 exception NotUnique
 exception NotUniqueInType of types
 
-type evar_projection = 
-| ProjectVar 
+type evar_projection =
+| ProjectVar
 | ProjectEvar of existential * evar_info * identifier * evar_projection
 
 let rec find_projectable_vars with_evars env sigma y subst =
@@ -577,7 +577,7 @@ let rec find_projectable_vars with_evars env sigma y subst =
       let evi = Evd.find sigma evk in
       let subst = make_projectable_subst sigma evi argsv in
       let l = find_projectable_vars with_evars env sigma y subst in
-      match l with 
+      match l with
       | [id',p] -> (idc,(true,(id,ProjectEvar (t,evi,id',p))))
       | _ -> failwith ""
     else failwith "" in
@@ -635,7 +635,7 @@ let rec do_projection_effects define_fun env ty evd = function
 	evd
 
 (* Assuming Σ; Γ, y1..yk |- c, [invert_subst Γ k Σ [x1:=u1;...;xn:=un] c]
- * tries to return φ(x1..xn) such that equation φ(u1..un) = c is valid. 
+ * tries to return φ(x1..xn) such that equation φ(u1..un) = c is valid.
  * The strategy is to imitate the structure of c and then to invert
  * the variables of c (i.e. rels or vars of Γ) using the algorithm
  * implemented by project_with_effects/find_projectable_vars.
@@ -643,14 +643,14 @@ let rec do_projection_effects define_fun env ty evd = function
  * 1 solutions is found.
  *
  * Precondition:  Σ; Γ, y1..yk |- c /\ Σ; Γ |- u1..un
- * Postcondition: if φ(x1..xn) is returned then 
+ * Postcondition: if φ(x1..xn) is returned then
  *                Σ; Γ, y1..yk |- φ(u1..un) = c /\ x1..xn |- φ(x1..xn)
  *
  * The effects correspond to evars instantiated while trying to project.
  *
  * [invert_subst] is used on instances of evars. Since the evars are flexible,
  * these instances are potentially erasable. This is why we don't investigate
- * whether evars in the instances of evars are unifiable, to the contrary of 
+ * whether evars in the instances of evars are unifiable, to the contrary of
  * [invert_definition].
  *)
 
@@ -673,7 +673,7 @@ let invert_arg_from_subst env k sigma subst_in_env c_in_env_extended_with_k_bind
 	project_with_effects env sigma effects t subst_in_env
     | _ ->
 	map_constr_with_binders succ aux k t in
-  try 
+  try
     let c = aux k c_in_env_extended_with_k_binders in
     Invertible (UniqueProjection (c,!effects))
   with
@@ -725,7 +725,7 @@ let restrict_hyps evd evk filter =
          occurrence of x in the hnf of C), then z should be removed too.
        - If y is in a non-erasable position in T(x,y,z) then the problem is
          unsolvable.
-       Computing whether y is erasable or not may be costly and the 
+       Computing whether y is erasable or not may be costly and the
        interest for this early detection in practice is not obvious. We let
        it for future work. In any case, thanks to the use of filters, the whole
        (unrestricted) context remains consistent. *)
@@ -779,13 +779,13 @@ let postpone_evar_evar env evd projs1 (evk1,args1) projs2 (evk2,args2) =
   let pb = (Reduction.CONV,env,mkEvar(evk1',args1'),mkEvar (evk2',args2')) in
   add_conv_pb pb evd
 
-(* [solve_evar_evar f Γ Σ ?e1[u1..un] ?e2[v1..vp]] applies an heuristic 
+(* [solve_evar_evar f Γ Σ ?e1[u1..un] ?e2[v1..vp]] applies an heuristic
  * to solve the equation Σ; Γ ⊢ ?e1[u1..un] = ?e2[v1..vp]:
- * - if there are at most one φj for each vj s.t. vj = φj(u1..un), 
- *   we first restrict ?2 to the subset v_k1..v_kq of the vj that are 
+ * - if there are at most one φj for each vj s.t. vj = φj(u1..un),
+ *   we first restrict ?2 to the subset v_k1..v_kq of the vj that are
  *   inversible and we set ?1[x1..xn] := ?2[φk1(x1..xn)..φkp(x1..xn)]
- * - symmetrically if there are at most one ψj for each uj s.t. 
- *   uj = ψj(v1..vp), 
+ * - symmetrically if there are at most one ψj for each uj s.t.
+ *   uj = ψj(v1..vp),
  * - otherwise, each position i s.t. ui does not occur in v1..vp has to
  *   be restricted and similarly for the vi, and we leave the equation
  *   as an open equation (performed by [postpone_evar])
@@ -819,12 +819,12 @@ let solve_evar_evar f env evd ev1 ev2 =
 
 (* We try to instantiate the evar assuming the body won't depend
  * on arguments that are not Rels or Vars, or appearing several times
- * (i.e. we tackle a generalization of Miller-Pfenning patterns unification) 
+ * (i.e. we tackle a generalization of Miller-Pfenning patterns unification)
  *
  * 1) Let "env |- ?ev[hyps:=args] = rhs" be the unification problem
  * 2) We limit it to a patterns unification problem "env |- ev[subst] = rhs"
  *    where only Rel's and Var's are relevant in subst
- * 3) We recur on rhs, "imitating" the term, and failing if some Rel/Var is 
+ * 3) We recur on rhs, "imitating" the term, and failing if some Rel/Var is
  *    not in the scope of ?ev. For instance, the problem
  *    "y:nat |- ?x[] = y" where "|- ?1:nat" is not satisfiable because
  *    ?1 would be instantiated by y which is not in the scope of ?1.
@@ -834,9 +834,9 @@ let solve_evar_evar f env evd ev1 ev2 =
  * Note: we don't assume rhs in normal form, it may fail while it would
  * have succeeded after some reductions.
  *
- * This is the work of [invert_definition Γ Σ ?ev[hyps:=args] 
+ * This is the work of [invert_definition Γ Σ ?ev[hyps:=args]
  * Precondition:  Σ; Γ, y1..yk |- c /\ Σ; Γ |- u1..un
- * Postcondition: if φ(x1..xn) is returned then 
+ * Postcondition: if φ(x1..xn) is returned then
  *                Σ; Γ, y1..yk |- φ(u1..un) = c /\ x1..xn |- φ(x1..xn)
  *)
 
@@ -852,7 +852,7 @@ let rec invert_definition choose env evd (evk,argsv as ev) rhs =
   (* Projection *)
   let project_variable t =
     (* Evar/Var problem: unifiable iff variable projectable from ev subst *)
-    try 
+    try
       let sols = find_projectable_vars true env !evdref t subst in
       let c, p = match sols with
 	| [] -> raise Not_found
@@ -896,7 +896,7 @@ let rec invert_definition choose env evd (evk,argsv as ev) rhs =
 	(try
 	  (* Try to project (a restriction of) the right evar *)
 	  let eprojs' = effective_projections projs' in
-	  let evd,args' = 
+	  let evd,args' =
 	    list_fold_map (instance_of_projection evar_define env' t)
 	      !evdref eprojs' in
 	  let evd,evk' = do_restrict_hyps evd evk' projs' in
@@ -948,7 +948,7 @@ and evar_define ?(choose=false) env (evk,_ as ev) rhs evd =
     let body = refresh_universes body in
 (* Cannot strictly type instantiations since the unification algorithm
  * does not unify applications from left to right.
- * e.g problem f x == g y yields x==y and f==g (in that order) 
+ * e.g problem f x == g y yields x==y and f==g (in that order)
  * Another problem is that type variables are evars of type Type
    let _ =
       try
@@ -966,7 +966,7 @@ and evar_define ?(choose=false) env (evk,_ as ev) rhs evd =
   with
     | NotEnoughInformationToProgress ->
 	postpone_evar_term env evd ev rhs
-    | NotInvertibleUsingOurAlgorithm t -> 
+    | NotInvertibleUsingOurAlgorithm t ->
 	error_not_clean env evd evk t (evar_source evk evd)
 
 (*-------------------*)
@@ -1000,15 +1000,15 @@ let is_ground_env evd env =
    structures *)
 let is_ground_env = memo1_2 is_ground_env
 
-let head_evar = 
+let head_evar =
   let rec hrec c = match kind_of_term c with
     | Evar (evk,_)   -> evk
     | Case (_,_,c,_) -> hrec c
     | App (c,_)      -> hrec c
     | Cast (c,_,_)   -> hrec c
     | _              -> failwith "headconstant"
-  in 
-  hrec 
+  in
+  hrec
 
 (* Check if an applied evar "?X[args] l" is a Miller's pattern; note
    that we don't care whether args itself contains Rel's or even Rel's
@@ -1063,7 +1063,7 @@ let is_unification_pattern (env,nb) f l t =
 (* From a unification problem "?X l1 = term1 l2" such that l1 is made
    of distinct rel's, build "\x1...xn.(term1 l2)" (patterns unification) *)
 (* NB: does not work when (term1 l2) contains metas because metas
-   *implicitly* depend on Vars but lambda abstraction will not reflect this 
+   *implicitly* depend on Vars but lambda abstraction will not reflect this
    dependency: ?X x = ?1 (?1 is a meta) will return \_.?1 while it should
    return \y. ?1{x\y} (non constant function if ?1 depends on x) (BB) *)
 let solve_pattern_eqn env l1 c =
@@ -1074,7 +1074,7 @@ let solve_pattern_eqn env l1 c =
       (* Rem: if [a] links to a let-in, do as if it were an assumption *)
       | Rel n -> let (na,_,t) = lookup_rel n env in mkLambda (na,lift n t,c')
       | Var id -> let (id,_,t) = lookup_named id env in mkNamedLambda id t c'
-      | _ -> assert false) 
+      | _ -> assert false)
     l1 c in
   (* Warning: we may miss some opportunity to eta-reduce more since c'
      is not in normal form *)
@@ -1107,7 +1107,7 @@ let solve_pattern_eqn env l1 c =
  *)
 
 let status_changed lev (pbty,_,t1,t2) =
-  try 
+  try
     ExistentialSet.mem (head_evar t1) lev or ExistentialSet.mem (head_evar t2) lev
   with Failure _ ->
     try ExistentialSet.mem (head_evar t2) lev with Failure _ -> false
@@ -1172,7 +1172,7 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1)
       | _ ->
 	  let evd =
 	    if pbty = Some false then
-	      check_instance_type conv_algo env evd ev1 t2 
+	      check_instance_type conv_algo env evd ev1 t2
 	    else
 	      evd in
 	  let evd = evar_define ~choose env ev1 t2 evd in
@@ -1180,11 +1180,11 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1)
 	    if occur_existential evd evi.evar_concl then
 	      let evenv = evar_env evi in
 	      let evc = nf_isevar evd evi.evar_concl in
-		match evi.evar_body with 
-		| Evar_defined body -> 
+		match evi.evar_body with
+		| Evar_defined body ->
 		    let ty = nf_isevar evd (Retyping.get_type_of evenv evd body) in
 		      add_conv_pb (Reduction.CUMUL,evenv,ty,evc) evd
-		| Evar_empty -> (* Resulted in a constraint *) 
+		| Evar_empty -> (* Resulted in a constraint *)
 		    evd
 	    else evd
     in
@@ -1196,29 +1196,29 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1)
   with e when precatchable_exception e ->
     (evd,false)
 
-let evars_of_term c = 
+let evars_of_term c =
   let rec evrec acc c =
     match kind_of_term c with
     | Evar (n, _) -> Intset.add n acc
     | _ -> fold_constr evrec acc c
-  in 
+  in
     evrec Intset.empty c
 
 let evars_of_named_context nc =
   List.fold_right (fun (_, b, t) s ->
-    Option.fold_left (fun s t -> 
+    Option.fold_left (fun s t ->
       Intset.union s (evars_of_term t))
       (Intset.union s (evars_of_term t)) b)
     nc Intset.empty
-    
+
 let evars_of_evar_info evi =
   Intset.union (evars_of_term evi.evar_concl)
-    (Intset.union 
-	(match evi.evar_body with 
+    (Intset.union
+	(match evi.evar_body with
 	| Evar_empty -> Intset.empty
 	| Evar_defined b -> evars_of_term b)
 	(evars_of_named_context (named_context_of_val evi.evar_hyps)))
-    
+
 (* [check_evars] fails if some unresolved evar remains *)
 (* it assumes that the defined existentials have already been substituted *)
 
@@ -1289,7 +1289,7 @@ let define_evar_as_abstraction abs evd (ev,args) =
       (ids_of_named_context (evar_context evi)) in
   let newenv = push_named (nvar, None, dom) evenv in
   let (evd2,rng) =
-    new_evar evd1 newenv ~src:(evar_source ev evd1) (new_Type()) 
+    new_evar evd1 newenv ~src:(evar_source ev evd1) (new_Type())
       ~filter:(true::evar_filter evi) in
   let prod = abs (Name nvar, dom, subst_var nvar rng) in
   let evd3 = Evd.define ev prod evd2 in
@@ -1298,7 +1298,7 @@ let define_evar_as_abstraction abs evd (ev,args) =
     fst (destEvar rng), array_cons (mkRel 1) (Array.map (lift 1) args) in
   let prod' = abs (Name nvar, mkEvar evdom, mkEvar evrng) in
     (evd3,prod')
-      
+
 let define_evar_as_product evd (ev,args) =
   define_evar_as_abstraction (fun t -> mkProd t) evd (ev,args)
 
@@ -1319,8 +1319,8 @@ let judge_of_new_Type () = Typeops.judge_of_type (new_univ ())
    constraint on its domain and codomain. If the input constraint is
    an evar instantiate it with the product of 2 new evars. *)
 
-let split_tycon loc env evd tycon = 
-  let rec real_split evd c = 
+let split_tycon loc env evd tycon =
+  let rec real_split evd c =
     let t = whd_betadeltaiota env evd c in
       match kind_of_term t with
 	| Prod (na,dom,rng) -> evd, (na, dom, rng)
@@ -1334,29 +1334,29 @@ let split_tycon loc env evd tycon =
       | None -> evd,(Anonymous,None,None)
       | Some (abs, c) ->
 	  (match abs with
-	       None -> 
+	       None ->
 		 let evd', (n, dom, rng) = real_split evd c in
 		   evd', (n, mk_tycon dom, mk_tycon rng)
 	     | Some (init, cur) ->
-		 if cur = 0 then 
+		 if cur = 0 then
 		   let evd', (x, dom, rng) = real_split evd c in
-		     evd, (Anonymous, 
-			  Some (None, dom), 
+		     evd, (Anonymous,
+			  Some (None, dom),
 			  Some (None, rng))
 		 else
-		   evd, (Anonymous, None, 
+		   evd, (Anonymous, None,
 			Some (if cur = 1 then None,c else Some (init, pred cur), c)))
-	    
-let valcon_of_tycon x = 
+
+let valcon_of_tycon x =
   match x with
     | Some (None, t) -> Some t
     | _ -> None
-	
+
 let lift_abstr_tycon_type n (abs, t) =
-  match abs with 
+  match abs with
       None -> raise (Invalid_argument "lift_abstr_tycon_type: not an abstraction")
     | Some (init, abs) ->
-	let abs' = abs + n in 
+	let abs' = abs + n in
 	  if abs' < 0 then raise (Invalid_argument "lift_abstr_tycon_type")
 	  else (Some (init, abs'), t)
 
@@ -1364,10 +1364,10 @@ let lift_tycon_type n (abs, t) = (abs, lift n t)
 let lift_tycon n = Option.map (lift_tycon_type n)
 
 let pr_tycon_type env (abs, t) =
-  match abs with 
+  match abs with
       None -> Termops.print_constr_env env t
     | Some (init, cur) -> str "Abstract (" ++ int init ++ str ","  ++ int cur ++ str ") " ++ Termops.print_constr_env env t
-	
+
 let pr_tycon env = function
     None -> str "None"
   | Some t -> pr_tycon_type env t
diff --git a/pretyping/evarutil.mli b/pretyping/evarutil.mli
index 8df301c66..dc212c9ca 100644
--- a/pretyping/evarutil.mli
+++ b/pretyping/evarutil.mli
@@ -42,7 +42,7 @@ val e_new_evar :
 (* Create a fresh evar in a context different from its definition context:
    [new_evar_instance sign evd ty inst] creates a new evar of context
    [sign] and type [ty], [inst] is a mapping of the evar context to
-   the context where the evar should occur. This means that the terms 
+   the context where the evar should occur. This means that the terms
    of [inst] are typed in the occurrence context and their type (seen
    as a telescope) is [sign] *)
 val new_evar_instance :
@@ -74,7 +74,7 @@ val non_instantiated : evar_map -> (evar * evar_info) list
 
 val is_ground_term :  evar_defs -> constr -> bool
 val is_ground_env  :  evar_defs -> env -> bool
-val solve_refl : 
+val solve_refl :
   (env ->  evar_defs -> conv_pb -> constr -> constr -> evar_defs * bool)
   -> env ->  evar_defs -> existential_key -> constr array -> constr array ->
     evar_defs
@@ -91,7 +91,7 @@ val define_evar_as_product : evar_defs -> existential -> evar_defs * types
 val define_evar_as_lambda : evar_defs -> existential -> evar_defs * types
 val define_evar_as_sort : evar_defs -> existential -> evar_defs * sorts
 
-val is_unification_pattern_evar : env -> existential -> constr list -> 
+val is_unification_pattern_evar : env -> existential -> constr list ->
   constr -> bool
 val is_unification_pattern : env * int -> constr -> constr array ->
   constr -> bool
@@ -120,7 +120,7 @@ val empty_valcon : val_constraint
 val mk_valcon : constr -> val_constraint
 
 val split_tycon :
-  loc -> env ->  evar_defs -> type_constraint -> 
+  loc -> env ->  evar_defs -> type_constraint ->
     evar_defs * (name * type_constraint * type_constraint)
 
 val valcon_of_tycon : type_constraint -> val_constraint
@@ -170,7 +170,7 @@ val whd_castappevar :  evar_map -> constr -> constr
 
 (* Replace the vars and rels that are aliases to other vars and rels by *)
 (* their representative that is most ancient in the context *)
-val expand_vars_in_term : env -> constr -> constr 
+val expand_vars_in_term : env -> constr -> constr
 
 (*********************************************************************)
 (* debug pretty-printer: *)
diff --git a/pretyping/evd.ml b/pretyping/evd.ml
index 191c8e62a..c96cc20cf 100644
--- a/pretyping/evd.ml
+++ b/pretyping/evd.ml
@@ -27,7 +27,7 @@ let string_of_existential evk = "?" ^ string_of_int evk
 let existential_of_int evk = evk
 
 type evar_body =
-  | Evar_empty 
+  | Evar_empty
   | Evar_defined of constr
 
 type evar_info = {
@@ -51,15 +51,15 @@ let evar_context evi = named_context_of_val evi.evar_hyps
 let evar_body evi = evi.evar_body
 let evar_filter evi = evi.evar_filter
 let evar_unfiltered_env evi = Global.env_of_context evi.evar_hyps
-let evar_filtered_context evi = 
+let evar_filtered_context evi =
   snd (list_filter2 (fun b c -> b) (evar_filter evi,evar_context evi))
-let evar_env evi = 
+let evar_env evi =
   List.fold_right push_named (evar_filtered_context evi)
     (reset_context (Global.env()))
 
 let eq_evar_info ei1 ei2 =
-  ei1 == ei2 || 
-    eq_constr ei1.evar_concl ei2.evar_concl && 
+  ei1 == ei2 ||
+    eq_constr ei1.evar_concl ei2.evar_concl &&
     eq_named_context_val (ei1.evar_hyps) (ei2.evar_hyps) &&
     ei1.evar_body = ei2.evar_body
 
@@ -73,7 +73,7 @@ let eq_evar_info ei1 ei2 =
 module ExistentialMap = Intmap
 module ExistentialSet = Intset
 
-(* This exception is raised by *.existential_value *)	
+(* This exception is raised by *.existential_value *)
 exception NotInstantiatedEvar
 
 module EvarInfoMap = struct
@@ -82,7 +82,7 @@ module EvarInfoMap = struct
   let empty = ExistentialMap.empty
 
   let to_list evc = (* Workaround for change in Map.fold behavior *)
-    let l = ref [] in 
+    let l = ref [] in
     ExistentialMap.iter (fun evk x -> l := (evk,x)::!l) evc;
     !l
 
@@ -96,7 +96,7 @@ module EvarInfoMap = struct
 
   let equal = ExistentialMap.equal
 
-  let define evd evk body = 
+  let define evd evk body =
     let oldinfo =
       try find evd evk
       with Not_found -> error "Evd.define: cannot define undeclared evar" in
@@ -110,7 +110,7 @@ module EvarInfoMap = struct
   let is_evar sigma evk = mem sigma evk
 
   let is_defined sigma evk =
-    let info = find sigma evk in 
+    let info = find sigma evk in
       not (info.evar_body = Evar_empty)
 
 
@@ -131,7 +131,7 @@ module EvarInfoMap = struct
       | ([],[])                        -> []
       | ([],_) | (_,[]) ->
 	  anomaly "Signature and its instance do not match"
-    in 
+    in
       instrec (sign,args)
 
   let instantiate_evar sign c args =
@@ -247,7 +247,7 @@ let set_leq_sort (u1,(leq1,geq1)) (u2,(leq2,geq2)) scstr =
       match UniverseMap.find u1 scstr with
           EqSort u1' -> search_rec (is_b,betw,not_betw) u1'
         | SortVar(leq,_) ->
-            let (is_b',betw',not_betw') = 
+            let (is_b',betw',not_betw') =
               List.fold_left search_rec (false,betw,not_betw) leq in
             if is_b' then (true, u1::betw', not_betw')
             else (false, betw', not_betw')
@@ -317,9 +317,9 @@ module EvarMap = struct
       UniverseMap.equal (=) (snd x) (snd y))
 
   let merge e e' = fold (fun n v sigma -> add sigma n v) e' e
-  
+
 end
- 
+
 (*******************************************************************)
 (* Metamaps *)
 
@@ -391,16 +391,16 @@ let clb_name = function
   | Clval (na,_,_) -> (na,true)
 
 (***********************)
-                                                                               
+
 module Metaset = Intset
-                                                                               
+
 let meta_exists p s = Metaset.fold (fun x b -> b || (p x)) s false
 
 module Metamap = Intmap
 
 let metamap_to_list m =
   Metamap.fold (fun n v l -> (n,v)::l) m []
- 
+
 (*************************)
 (* Unification state *)
 
@@ -430,7 +430,7 @@ type evar_map = evar_defs
 (* spiwack: this function seems to be used only for the definition of the progress
     tactical. I would recommand not using it in other places. *)
 let eq_evar_map d1 d2 =
-  EvarMap.eq_evar_map d1.evars d2.evars 
+  EvarMap.eq_evar_map d1.evars d2.evars
 
 (* spiwack: tentative. It might very well not be the semantics we want
      for merging evar_defs *)
@@ -450,7 +450,7 @@ let mem d e = EvarMap.mem d.evars e
 (* spiwack: this function loses information from the original evar_defs
    it might be an idea not to export it. *)
 let to_list d = EvarMap.to_list d.evars
-(* spiwack: not clear what folding over an evar_defs, for now we shall 
+(* spiwack: not clear what folding over an evar_defs, for now we shall
     simply fold over the inner evar_map. *)
 let fold f d a = EvarMap.fold f d.evars a
 let is_evar d e = EvarMap.is_evar d.evars e
@@ -463,14 +463,14 @@ let existential_opt_value d e = EvarMap.existential_opt_value d.evars e
 (*** /Lifting... ***)
 
 (* evar_defs are considered empty disregarding histories *)
-let is_empty d = 
+let is_empty d =
   d.evars = EvarMap.empty &&
   d.conv_pbs = [] &&
   Metamap.is_empty d.metas
 
 let subst_named_context_val s = map_named_val (subst_mps s)
 
-let subst_evar_info s evi = 
+let subst_evar_info s evi =
   let subst_evb = function Evar_empty -> Evar_empty
     | Evar_defined c -> Evar_defined (subst_mps s c) in
   { evi with
@@ -494,12 +494,12 @@ let create_evar_defs sigma = { sigma with
 (* spiwack: tentatively deprecated *)
 let create_goal_evar_defs sigma = { sigma with
    conv_pbs=[]; last_mods=ExistentialSet.empty; metas=Metamap.empty }
-let empty =  { 
-  evars=EvarMap.empty; 
-  conv_pbs=[]; 
-  last_mods = ExistentialSet.empty; 
-  history=[]; 
-  metas=Metamap.empty 
+let empty =  {
+  evars=EvarMap.empty;
+  conv_pbs=[];
+  last_mods = ExistentialSet.empty;
+  history=[];
+  metas=Metamap.empty
 }
 
 let evars_reset_evd evd d = {d with evars = evd.evars}
@@ -512,7 +512,7 @@ let evar_source evk d =
 let define evk body evd =
   { evd with
     evars = EvarMap.define evd.evars evk body;
-    last_mods = 
+    last_mods =
         match evd.conv_pbs with
 	| [] ->  evd.last_mods
         | _ -> ExistentialSet.add evk evd.last_mods }
@@ -542,23 +542,23 @@ let is_undefined_evar evd c = match kind_of_term c with
   | Evar ev -> not (is_defined_evar evd ev)
   | _ -> false
 
-let undefined_evars evd = 
-  let evars = 
-    EvarMap.fold (fun evk evi sigma -> if evi.evar_body = Evar_empty then 
-	    EvarMap.add sigma evk evi else sigma) 
+let undefined_evars evd =
+  let evars =
+    EvarMap.fold (fun evk evi sigma -> if evi.evar_body = Evar_empty then
+	    EvarMap.add sigma evk evi else sigma)
       evd.evars EvarMap.empty
-  in 
+  in
     { evd with evars = evars }
 
 (* extracts conversion problems that satisfy predicate p *)
 (* Note: conv_pbs not satisying p are stored back in reverse order *)
 let extract_conv_pbs evd p =
-  let (pbs,pbs1) = 
+  let (pbs,pbs1) =
     List.fold_left
       (fun (pbs,pbs1) pb ->
-    	 if p pb then 
+    	 if p pb then
 	   (pb::pbs,pbs1)
-         else 
+         else
 	   (pbs,pb::pbs1))
       ([],[])
       evd.conv_pbs
@@ -604,7 +604,7 @@ let undefined_metas evd =
     | (n,Cltyp (_,typ))  -> n)
     (meta_list evd))
 
-let metas_of evd = 
+let metas_of evd =
   List.map (function
     | (n,Clval(_,_,typ)) -> (n,typ.rebus)
     | (n,Cltyp (_,typ))  -> (n,typ.rebus))
@@ -612,8 +612,8 @@ let metas_of evd =
 
 let map_metas_fvalue f evd =
   { evd with metas =
-      Metamap.map 
-        (function 
+      Metamap.map
+        (function
           | Clval(id,(c,s),typ) -> Clval(id,(mk_freelisted (f c.rebus),s),typ)
           | x -> x) evd.metas }
 
@@ -633,7 +633,7 @@ let try_meta_fvalue evd mv =
     | Cltyp _ -> raise Not_found
 
 let meta_fvalue evd mv =
-  try try_meta_fvalue evd mv 
+  try try_meta_fvalue evd mv
   with Not_found -> anomaly "meta_fvalue: meta has no value"
 
 let meta_value evd mv =
@@ -645,10 +645,10 @@ let meta_ftype evd mv =
     | Clval(_,_,b) -> b
 
 let meta_type evd mv = (meta_ftype evd mv).rebus
- 
+
 let meta_declare mv v ?(name=Anonymous) evd =
   { evd with metas = Metamap.add mv (Cltyp(name,mk_freelisted v)) evd.metas }
-  
+
 let meta_assign mv (v,pb) evd =
   match Metamap.find mv evd.metas with
   | Cltyp(na,ty) ->
@@ -680,12 +680,12 @@ let meta_with_name evd id =
         else l)
       evd.metas ([],[]) in
   match mvnodef, mvl with
-    | _,[]  -> 
+    | _,[]  ->
 	errorlabstrm "Evd.meta_with_name"
           (str"No such bound variable " ++ pr_id id ++ str".")
-    | ([n],_|_,[n]) -> 
+    | ([n],_|_,[n]) ->
 	n
-    | _  -> 
+    | _  ->
 	errorlabstrm "Evd.meta_with_name"
           (str "Binder name \"" ++ pr_id id ++
            strbrk "\" occurs more than once in clause.")
@@ -694,14 +694,14 @@ let meta_with_name evd id =
 (* spiwack: we should try and replace this List.fold_left by a Metamap.fold.  *)
 let meta_merge evd1 evd2 =
   {evd2 with
-    metas = List.fold_left (fun m (n,v) -> Metamap.add n v m) 
+    metas = List.fold_left (fun m (n,v) -> Metamap.add n v m)
       evd2.metas (metamap_to_list evd1.metas) }
 
 type metabinding = metavariable * constr * instance_status
 
 let retract_coercible_metas evd =
-  let mc,ml = 
-    Metamap.fold (fun n v (mc,ml) -> 
+  let mc,ml =
+    Metamap.fold (fun n v (mc,ml) ->
       match v with
 	| Clval (na,(b,(UserGiven,CoerceToType as s)),typ) ->
 	    (n,b.rebus,s)::mc, Metamap.add n (Cltyp (na,typ)) ml
@@ -714,7 +714,7 @@ let rec list_assoc_in_triple x = function
     [] -> raise Not_found
   | (a,b,_)::l -> if compare a x = 0 then b else list_assoc_in_triple x l
 
-let subst_defined_metas bl c = 
+let subst_defined_metas bl c =
   let rec substrec c = match kind_of_term c with
     | Meta i -> substrec (list_assoc_in_triple i bl)
     | _ -> map_constr substrec c
@@ -729,7 +729,7 @@ type open_constr = evar_map * constr
 type 'a sigma = {
   it : 'a ;
   sigma : evar_map}
- 
+
 let sig_it x = x.it
 let sig_sig x = x.sigma
 
@@ -761,13 +761,13 @@ let pr_meta_map mmap =
     | _ -> mt() in
   let pr_meta_binding = function
     | (mv,Cltyp (na,b)) ->
-      	hov 0 
+      	hov 0
 	  (pr_meta mv ++ pr_name na ++ str " : " ++
            print_constr b.rebus ++ fnl ())
     | (mv,Clval(na,(b,s),t)) ->
-      	hov 0 
+      	hov 0
 	  (pr_meta mv ++ pr_name na ++ str " := " ++
-           print_constr b.rebus ++ 
+           print_constr b.rebus ++
 	   str " : " ++ print_constr t.rebus ++
 	   spc () ++ pr_instance_status s ++ fnl ())
   in
@@ -776,7 +776,7 @@ let pr_meta_map mmap =
 let pr_decl ((id,b,_),ok) =
   match b with
   | None -> if ok then pr_id id else (str "{" ++ pr_id id ++ str "}")
-  | Some c -> str (if ok then "(" else "{") ++ pr_id id ++ str ":=" ++ 
+  | Some c -> str (if ok then "(" else "{") ++ pr_id id ++ str ":=" ++
       print_constr c ++ str (if ok then ")" else "}")
 
 let pr_evar_info evi =
@@ -791,7 +791,7 @@ let pr_evar_info evi =
   hov 2 (str"["  ++ phyps ++ spc () ++ str"|- "  ++ pty ++ pb ++ str"]")
 
 let pr_evar_defs_t (evars,cstrs as sigma) =
-  let evs = 
+  let evs =
     if evars = EvarInfoMap.empty then mt ()
     else
       str"EVARS:"++brk(0,1)++
@@ -801,7 +801,7 @@ let pr_evar_defs_t (evars,cstrs as sigma) =
 		(EvarMap.to_list sigma))++fnl()
   and cs =
     if cstrs = UniverseMap.empty then mt ()
-    else pr_sort_cstrs cstrs++fnl() 
+    else pr_sort_cstrs cstrs++fnl()
   in evs ++ cs
 
 let pr_constraints pbs =
@@ -810,7 +810,7 @@ let pr_constraints pbs =
       print_constr t1 ++ spc() ++
       str (match pbty with
 	| Reduction.CONV -> "=="
-	| Reduction.CUMUL -> "<=") ++ 
+	| Reduction.CUMUL -> "<=") ++
       spc() ++ print_constr t2) pbs)
 
 let pr_evar_defs evd =
@@ -825,5 +825,5 @@ let pr_evar_defs evd =
       str"METAS:"++brk(0,1)++pr_meta_map evd.metas in
   v 0 (pp_evm ++ cstrs ++ pp_met)
 
-let pr_metaset metas = 
+let pr_metaset metas =
   str "[" ++ prlist_with_sep spc pr_meta (Metaset.elements metas) ++ str "]"
diff --git a/pretyping/evd.mli b/pretyping/evd.mli
index e5cf8e269..07706c0ba 100644
--- a/pretyping/evd.mli
+++ b/pretyping/evd.mli
@@ -44,7 +44,7 @@ val map_fl : ('a -> 'b) -> 'a freelisted -> 'b freelisted
     (e.g. the solution [P] to [?X u v = P u v] can be eta-expanded twice)
 *)
 
-type instance_constraint = 
+type instance_constraint =
     IsSuperType | IsSubType | ConvUpToEta of int | UserGiven
 
 (* Status of the unification of the type of an instance against the type of
@@ -80,11 +80,11 @@ val map_clb : (constr -> constr) -> clbinding -> clbinding
 (*** Existential variables and unification states ***)
 
 (* A unification state (of type [evar_defs]) is primarily a finite mapping
-    from existential variables to records containing the type of the evar 
-   ([evar_concl]), the context under which it was introduced ([evar_hyps]) 
-   and its definition ([evar_body]). [evar_extra] is used to add any other 
-   kind of information. 
-   It also contains conversion constraints, debugging information and 
+    from existential variables to records containing the type of the evar
+   ([evar_concl]), the context under which it was introduced ([evar_hyps])
+   and its definition ([evar_body]). [evar_extra] is used to add any other
+   kind of information.
+   It also contains conversion constraints, debugging information and
    information about meta variables. *)
 
 (* Information about existential variables. *)
@@ -94,7 +94,7 @@ val string_of_existential : evar -> string
 val existential_of_int : int -> evar
 
 type evar_body =
-  | Evar_empty 
+  | Evar_empty
   | Evar_defined of constr
 
 type evar_info = {
@@ -197,7 +197,7 @@ type evar_constraint = conv_pb * env * constr * constr
 val add_conv_pb :  evar_constraint -> evar_defs -> evar_defs
 
 module ExistentialSet : Set.S with type elt = existential_key
-val extract_changed_conv_pbs : evar_defs -> 
+val extract_changed_conv_pbs : evar_defs ->
       (ExistentialSet.t -> evar_constraint -> bool) ->
       evar_defs * evar_constraint list
 val extract_all_conv_pbs : evar_defs -> evar_defs * evar_constraint list
@@ -208,7 +208,7 @@ val find_meta : evar_defs -> metavariable -> clbinding
 val meta_list : evar_defs -> (metavariable * clbinding) list
 val meta_defined : evar_defs -> metavariable -> bool
 (* [meta_fvalue] raises [Not_found] if meta not in map or [Anomaly] if
-   meta has no value *)  
+   meta has no value *)
 val meta_value     : evar_defs -> metavariable -> constr
 val meta_fvalue    : evar_defs -> metavariable -> constr freelisted * instance_status
 val meta_opt_fvalue : evar_defs -> metavariable -> (constr freelisted * instance_status) option
diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml
index 92c5dfcc3..eed795cdc 100644
--- a/pretyping/indrec.ml
+++ b/pretyping/indrec.ml
@@ -44,12 +44,12 @@ let mkLambda_string s t c = mkLambda (Name (id_of_string s), t, c)
 (**********************************************************************)
 (* Building case analysis schemes *)
 (* Nouvelle version, plus concise mais plus coûteuse à cause de
-   lift_constructor et lift_inductive_family qui ne se contentent pas de 
+   lift_constructor et lift_inductive_family qui ne se contentent pas de
    lifter les paramètres globaux *)
 
 let mis_make_case_com depopt env sigma ind (mib,mip as specif) kind =
   let lnamespar = mib.mind_params_ctxt in
-  let dep = match depopt with 
+  let dep = match depopt with
     | None -> inductive_sort_family mip <> InProp
     | Some d -> d
   in
@@ -67,7 +67,7 @@ let mis_make_case_com depopt env sigma ind (mib,mip as specif) kind =
   let indf = make_ind_family(ind, extended_rel_list 0 lnamespar) in
   let constrs = get_constructors env indf in
 
-  let rec add_branch env k = 
+  let rec add_branch env k =
     if k = Array.length mip.mind_consnames then
       let nbprod = k+1 in
 
@@ -82,7 +82,7 @@ let mis_make_case_com depopt env sigma ind (mib,mip as specif) kind =
           (mkRel (ndepar + nbprod),
            if dep then extended_rel_vect 0 deparsign
            else extended_rel_vect 1 arsign) in
-      let p = 
+      let p =
 	it_mkLambda_or_LetIn_name env'
 	  ((if dep then mkLambda_name env' else mkLambda)
 	   (Anonymous,depind,pbody))
@@ -100,27 +100,27 @@ let mis_make_case_com depopt env sigma ind (mib,mip as specif) kind =
 	(add_branch (push_rel (Anonymous, None, t) env) (k+1))
   in
   let typP = make_arity env' dep indf (new_sort_in_family kind) in
-  it_mkLambda_or_LetIn_name env 
+  it_mkLambda_or_LetIn_name env
     (mkLambda_string "P" typP
        (add_branch (push_rel (Anonymous,None,typP) env') 0)) lnamespar
-    
+
 (* check if the type depends recursively on one of the inductive scheme *)
 
 (**********************************************************************)
 (* Building the recursive elimination *)
 
 (*
- * t is the type of the constructor co and recargs is the information on 
+ * t is the type of the constructor co and recargs is the information on
  * the recursive calls. (It is assumed to be in form given by the user).
  * build the type of the corresponding branch of the recurrence principle
- * assuming f has this type, branch_rec gives also the term 
- *   [x1]..[xk](f xi (F xi) ...) to be put in the corresponding branch of 
+ * assuming f has this type, branch_rec gives also the term
+ *   [x1]..[xk](f xi (F xi) ...) to be put in the corresponding branch of
  * the case operation
- * FPvect gives for each inductive definition if we want an elimination 
- * on it with which predicate and which recursive function. 
+ * FPvect gives for each inductive definition if we want an elimination
+ * on it with which predicate and which recursive function.
  *)
 
-let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs = 
+let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
   let make_prod = make_prod_dep dep in
   let nparams = List.length vargs in
   let process_pos env depK pk =
@@ -136,39 +136,39 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
      	| Ind (_,_) ->
 	    let realargs = list_skipn nparams largs in
 	    let base = applist (lift i pk,realargs) in
-            if depK then 
+            if depK then
 	      Reduction.beta_appvect
                 base [|applist (mkRel (i+1),extended_rel_list 0 sign)|]
-            else 
+            else
 	      base
-      	| _ -> assert false 
+      	| _ -> assert false
     in
     prec env 0 []
   in
   let rec process_constr env i c recargs nhyps li =
-    if nhyps > 0 then match kind_of_term c with 
+    if nhyps > 0 then match kind_of_term c with
       | Prod (n,t,c_0) ->
-          let (optionpos,rest) = 
-	    match recargs with 
+          let (optionpos,rest) =
+	    match recargs with
 	      | [] -> None,[]
               | ra::rest ->
-                  (match dest_recarg ra with 
+                  (match dest_recarg ra with
 	            | Mrec j when is_rec -> (depPvect.(j),rest)
-	            | Imbr _  -> 
-		        Flags.if_verbose warning "Ignoring recursive call"; 
-		        (None,rest) 
+	            | Imbr _  ->
+		        Flags.if_verbose warning "Ignoring recursive call";
+		        (None,rest)
                     | _ -> (None, rest))
-	  in 
-          (match optionpos with 
-	     | None -> 
+	  in
+          (match optionpos with
+	     | None ->
 		 make_prod env
 		   (n,t,
 		    process_constr (push_rel (n,None,t) env) (i+1) c_0 rest
 		      (nhyps-1) (i::li))
-             | Some(dep',p) -> 
+             | Some(dep',p) ->
 		 let nP = lift (i+1+decP) p in
                  let env' = push_rel (n,None,t) env in
-		 let t_0 = process_pos env' dep' nP (lift 1 t) in 
+		 let t_0 = process_pos env' dep' nP (lift 1 t) in
 		 make_prod_dep (dep or dep') env
                    (n,t,
 		    mkArrow t_0
@@ -190,14 +190,14 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
       else c
   in
   let nhyps = List.length cs.cs_args in
-  let nP = match depPvect.(tyi) with 
+  let nP = match depPvect.(tyi) with
     | Some(_,p) -> lift (nhyps+decP) p
     | _ -> assert false in
   let base = appvect (nP,cs.cs_concl_realargs) in
   let c = it_mkProd_or_LetIn base cs.cs_args in
   process_constr env 0 c recargs nhyps []
 
-let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs = 
+let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
   let process_pos env fk  =
     let rec prec env i hyps p =
       let p',largs = whd_betadeltaiota_nolet_stack env sigma p in
@@ -208,9 +208,9 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
 	| LetIn (n,b,t,c) ->
 	    let d = (n,Some b,t) in
 	    mkLetIn (n,b,t,prec (push_rel d env) (i+1) (d::hyps) c)
-     	| Ind _ -> 
+     	| Ind _ ->
             let realargs = list_skipn nparrec largs
-            and arg = appvect (mkRel (i+1),extended_rel_vect 0 hyps) in 
+            and arg = appvect (mkRel (i+1),extended_rel_vect 0 hyps) in
             applist(lift i fk,realargs@[arg])
      	| _ -> assert false
     in
@@ -218,23 +218,23 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
   in
   (* ici, cstrprods est la liste des produits du constructeur instantié *)
   let rec process_constr env i f = function
-    | (n,None,t as d)::cprest, recarg::rest -> 
-        let optionpos = 
-	  match dest_recarg recarg with 
+    | (n,None,t as d)::cprest, recarg::rest ->
+        let optionpos =
+	  match dest_recarg recarg with
             | Norec   -> None
             | Imbr _  -> None
             | Mrec i  -> fvect.(i)
-	in 
-        (match optionpos with 
+	in
+        (match optionpos with
            | None ->
 	       lambda_name env
 		 (n,t,process_constr (push_rel d env) (i+1)
 		    (whd_beta Evd.empty (applist (lift 1 f, [(mkRel 1)])))
 		    (cprest,rest))
-           | Some(_,f_0) -> 
+           | Some(_,f_0) ->
 	       let nF = lift (i+1+decF) f_0 in
                let env' = push_rel d env in
-	       let arg = process_pos env' nF (lift 1 t) in 
+	       let arg = process_pos env' nF (lift 1 t) in
                lambda_name env
 		 (n,t,process_constr env' (i+1)
 		    (whd_beta Evd.empty (applist (lift 1 f, [(mkRel 1); arg])))
@@ -251,9 +251,9 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
   process_constr env 0 f (List.rev cstr.cs_args, recargs)
 
 
-(* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k 
+(* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k
    variables *)
-let context_chop k ctx = 
+let context_chop k ctx =
   let rec chop_aux acc = function
     | (0, l2) -> (List.rev acc, l2)
     | (n, ((_,Some _,_ as h)::t)) -> chop_aux (h::acc) (n, t)
@@ -266,24 +266,24 @@ let context_chop k ctx =
 let mis_make_indrec env sigma listdepkind mib =
   let nparams = mib.mind_nparams in
   let nparrec = mib. mind_nparams_rec in
-  let lnonparrec,lnamesparrec = 
+  let lnonparrec,lnamesparrec =
     context_chop (nparams-nparrec) mib.mind_params_ctxt in
   let nrec = List.length listdepkind in
   let depPvec =
-    Array.create mib.mind_ntypes (None : (bool * constr) option) in 
-  let _ = 
-    let rec 
-	assign k = function 
+    Array.create mib.mind_ntypes (None : (bool * constr) option) in
+  let _ =
+    let rec
+	assign k = function
 	  | [] -> ()
-          | (indi,mibi,mipi,dep,_)::rest -> 
+          | (indi,mibi,mipi,dep,_)::rest ->
               (Array.set depPvec (snd indi) (Some(dep,mkRel k));
                assign (k-1) rest)
-    in 
-      assign nrec listdepkind in 
+    in
+      assign nrec listdepkind in
   let recargsvec =
     Array.map (fun mip -> mip.mind_recargs) mib.mind_packets in
   (* recarg information for non recursive parameters *)
-  let rec recargparn l n = 
+  let rec recargparn l n =
     if n = 0 then l else recargparn (mk_norec::l) (n-1) in
   let recargpar = recargparn [] (nparams-nparrec) in
   let make_one_rec p =
@@ -293,80 +293,80 @@ let mis_make_indrec env sigma listdepkind mib =
 	    let tyi = snd indi in
 	    let nctyi =
               Array.length mipi.mind_consnames in (* nb constructeurs du type*)
-	      
+
             (* arity in the context of the fixpoint, i.e.
                P1..P_nrec f1..f_nbconstruct *)
 	    let args = extended_rel_list (nrec+nbconstruct) lnamesparrec in
 	    let indf = make_ind_family(indi,args) in
-	      
+
 	    let arsign,_ = get_arity env indf in
 	    let depind = build_dependent_inductive env indf in
 	    let deparsign = (Anonymous,None,depind)::arsign in
-	      
+
 	    let nonrecpar = rel_context_length lnonparrec in
 	    let larsign = rel_context_length deparsign in
 	    let ndepar = larsign - nonrecpar in
 	    let dect = larsign+nrec+nbconstruct in
-	      
+
             (* constructors in context of the Cases expr, i.e.
                P1..P_nrec f1..f_nbconstruct F_1..F_nrec a_1..a_nar x:I *)
 	    let args' = extended_rel_list (dect+nrec) lnamesparrec in
 	    let args'' = extended_rel_list ndepar lnonparrec in
             let indf' = make_ind_family(indi,args'@args'') in
-	      
-	    let branches = 
+
+	    let branches =
 	      let constrs = get_constructors env indf' in
 	      let fi = rel_vect (dect-i-nctyi) nctyi in
-	      let vecfi = Array.map 
+	      let vecfi = Array.map
 		(fun f -> appvect (f,extended_rel_vect ndepar lnonparrec))
-		fi 
+		fi
 	      in
 		array_map3
-		  (make_rec_branch_arg env sigma 
+		  (make_rec_branch_arg env sigma
 		      (nparrec,depPvec,larsign))
-                  vecfi constrs (dest_subterms recargsvec.(tyi)) 
+                  vecfi constrs (dest_subterms recargsvec.(tyi))
 	    in
-	      
-	    let j = (match depPvec.(tyi) with 
-	      | Some (_,c) when isRel c -> destRel c 
-	      | _ -> assert false) 
+
+	    let j = (match depPvec.(tyi) with
+	      | Some (_,c) when isRel c -> destRel c
+	      | _ -> assert false)
 	    in
-	      
+
 	    (* Predicate in the context of the case *)
-	      
+
 	    let depind' = build_dependent_inductive env indf' in
 	    let arsign',_ = get_arity env indf' in
 	    let deparsign' = (Anonymous,None,depind')::arsign' in
-	      
+
 	    let pargs =
-	      let nrpar = extended_rel_list (2*ndepar) lnonparrec 
+	      let nrpar = extended_rel_list (2*ndepar) lnonparrec
 	      and nrar = if dep then extended_rel_list 0 deparsign'
 		else extended_rel_list 1 arsign'
 	      in nrpar@nrar
-		
+
 	    in
 
 	    (* body of i-th component of the mutual fixpoint *)
-	    let deftyi = 
+	    let deftyi =
 	      let ci = make_case_info env indi RegularStyle in
-	      let concl = applist (mkRel (dect+j+ndepar),pargs) in 
+	      let concl = applist (mkRel (dect+j+ndepar),pargs) in
 	      let pred =
-		it_mkLambda_or_LetIn_name env 
+		it_mkLambda_or_LetIn_name env
 		  ((if dep then mkLambda_name env else mkLambda)
 		      (Anonymous,depind',concl))
 		  arsign'
 	      in
 		it_mkLambda_or_LetIn_name env
-		  (mkCase (ci, pred, 
+		  (mkCase (ci, pred,
 		          mkRel 1,
 			  branches))
 		  (lift_rel_context nrec deparsign)
 	    in
-	      
+
 	    (* type of i-th component of the mutual fixpoint *)
-	      
+
 	    let typtyi =
-	      let concl = 
+	      let concl =
 		let pargs = if dep then extended_rel_vect 0 deparsign
 		  else extended_rel_vect 1 arsign
 		in appvect (mkRel (nbconstruct+ndepar+nonrecpar+j),pargs)
@@ -374,25 +374,25 @@ let mis_make_indrec env sigma listdepkind mib =
 		concl
 		deparsign
 	    in
-	      mrec (i+nctyi) (rel_context_nhyps arsign ::ln) (typtyi::ltyp) 
+	      mrec (i+nctyi) (rel_context_nhyps arsign ::ln) (typtyi::ltyp)
                 (deftyi::ldef) rest
-        | [] -> 
+        | [] ->
 	    let fixn = Array.of_list (List.rev ln) in
             let fixtyi = Array.of_list (List.rev ltyp) in
-            let fixdef = Array.of_list (List.rev ldef) in 
+            let fixdef = Array.of_list (List.rev ldef) in
             let names = Array.create nrec (Name(id_of_string "F")) in
 	      mkFix ((fixn,p),(names,fixtyi,fixdef))
-      in 
-	mrec 0 [] [] [] 
-    in 
-    let rec make_branch env i = function 
+      in
+	mrec 0 [] [] []
+    in
+    let rec make_branch env i = function
       | (indi,mibi,mipi,dep,_)::rest ->
           let tyi = snd indi in
 	  let nconstr = Array.length mipi.mind_consnames in
-	  let rec onerec env j = 
-	    if j = nconstr then 
-	      make_branch env (i+j) rest 
-	    else 
+	  let rec onerec env j =
+	    if j = nconstr then
+	      make_branch env (i+j) rest
+	    else
 	      let recarg = (dest_subterms recargsvec.(tyi)).(j) in
 	      let recarg = recargpar@recarg in
 	      let vargs = extended_rel_list (nrec+i+j) lnamesparrec in
@@ -400,36 +400,36 @@ let mis_make_indrec env sigma listdepkind mib =
 	      let p_0 =
 		type_rec_branch
                   true dep env sigma (vargs,depPvec,i+j) tyi cs recarg
-	      in 
+	      in
 		mkLambda_string "f" p_0
 		  (onerec (push_rel (Anonymous,None,p_0) env) (j+1))
 	  in onerec env 0
-      | [] -> 
+      | [] ->
 	  makefix i listdepkind
     in
-    let rec put_arity env i = function 
-      | (indi,_,_,dep,kinds)::rest -> 
+    let rec put_arity env i = function
+      | (indi,_,_,dep,kinds)::rest ->
 	  let indf = make_ind_family (indi,extended_rel_list i lnamesparrec) in
 	  let typP = make_arity env dep indf (new_sort_in_family kinds) in
 	    mkLambda_string "P" typP
 	      (put_arity (push_rel (Anonymous,None,typP) env) (i+1) rest)
-      | [] -> 
-	  make_branch env 0 listdepkind 
+      | [] ->
+	  make_branch env 0 listdepkind
     in
-      
+
     (* Body on make_one_rec *)
     let (indi,mibi,mipi,dep,kind) = List.nth listdepkind p in
-      
+
       if (mis_is_recursive_subset
 	(List.map (fun (indi,_,_,_,_) -> snd indi) listdepkind)
-	mipi.mind_recargs) 
-      then 
+	mipi.mind_recargs)
+      then
 	let env' = push_rel_context lnamesparrec env in
-	  it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind) 
+	  it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind)
 	    lnamesparrec
-      else 
-	mis_make_case_com (Some dep) env sigma indi (mibi,mipi) kind 
-  in 
+      else
+	mis_make_case_com (Some dep) env sigma indi (mibi,mipi) kind
+  in
     (* Body of mis_make_indrec *)
     list_tabulate make_one_rec nrec
 
@@ -437,11 +437,11 @@ let mis_make_indrec env sigma listdepkind mib =
 (* This builds elimination predicate for Case tactic *)
 
 let make_case_com depopt env sigma ity kind =
-  let (mib,mip) = lookup_mind_specif env ity in 
+  let (mib,mip) = lookup_mind_specif env ity in
     mis_make_case_com depopt env sigma ity (mib,mip) kind
 
 let make_case_dep env   = make_case_com (Some true) env
-let make_case_nodep env = make_case_com (Some false) env 
+let make_case_nodep env = make_case_com (Some false) env
 let make_case_gen env   = make_case_com None env
 
 
@@ -449,24 +449,24 @@ let make_case_gen env   = make_case_com None env
 (* [instantiate_indrec_scheme s rec] replace the sort of the scheme
    [rec] by [s] *)
 
-let change_sort_arity sort = 
+let change_sort_arity sort =
   let rec drec a = match kind_of_term a with
-    | Cast (c,_,_) -> drec c 
+    | Cast (c,_,_) -> drec c
     | Prod (n,t,c) -> mkProd (n, t, drec c)
     | LetIn (n,b,t,c) -> mkLetIn (n,b, t, drec c)
     | Sort _ -> mkSort sort
     | _ -> assert false
-  in 
-    drec 
+  in
+    drec
 
 (* [npar] is the number of expected arguments (then excluding letin's) *)
 let instantiate_indrec_scheme sort =
   let rec drec npar elim =
     match kind_of_term elim with
-      | Lambda (n,t,c) -> 
-	  if npar = 0 then 
+      | Lambda (n,t,c) ->
+	  if npar = 0 then
 	    mkLambda (n, change_sort_arity sort t, c)
-	  else 
+	  else
 	    mkLambda (n, t, drec (npar-1) c)
       | LetIn (n,b,t,c) -> mkLetIn (n,b,t,drec npar c)
       | _ -> anomaly "instantiate_indrec_scheme: wrong elimination type"
@@ -478,28 +478,28 @@ let instantiate_indrec_scheme sort =
 let instantiate_type_indrec_scheme sort npars term =
   let rec drec np elim =
     match kind_of_term elim with
-      | Prod (n,t,c) -> 
-	  if np = 0 then 
+      | Prod (n,t,c) ->
+	  if np = 0 then
             let t' = change_sort_arity sort t in
             mkProd (n, t', c),
             mkLambda (n, t', mkApp(term,Termops.rel_vect 0 (npars+1)))
-	  else 
+	  else
             let c',term' = drec (np-1) c in
 	    mkProd (n, t, c'), mkLambda (n, t, term')
       | LetIn (n,b,t,c) -> let c',term' = drec np c in
-           mkLetIn (n,b,t,c'), mkLetIn (n,b,t,term') 
+           mkLetIn (n,b,t,c'), mkLetIn (n,b,t,term')
       | _ -> anomaly "instantiate_type_indrec_scheme: wrong elimination type"
   in
   drec npars
 
 (**********************************************************************)
 (* Interface to build complex Scheme *)
-(* Check inductive types only occurs once 
+(* Check inductive types only occurs once
 (otherwise we obtain a meaning less scheme) *)
 
-let check_arities listdepkind = 
+let check_arities listdepkind =
   let _ = List.fold_left
-    (fun ln ((_,ni as mind),mibi,mipi,dep,kind) -> 
+    (fun ln ((_,ni as mind),mibi,mipi,dep,kind) ->
        let kelim = elim_sorts (mibi,mipi) in
        if not (List.exists ((=) kind) kelim) then raise
 	 (RecursionSchemeError
@@ -510,10 +510,10 @@ let check_arities listdepkind =
 	    [] listdepkind
   in true
 
-let build_mutual_indrec env sigma = function 
+let build_mutual_indrec env sigma = function
   | (mind,mib,mip,dep,s)::lrecspec ->
       let (sp,tyi) = mind in
-      let listdepkind = 
+      let listdepkind =
     	(mind,mib,mip, dep,s)::
     	(List.map
 	   (function (mind',mibi',mipi',dep',s') ->
@@ -525,7 +525,7 @@ let build_mutual_indrec env sigma = function
 		  raise (RecursionSchemeError (NotMutualInScheme (mind,mind'))))
 	   lrecspec)
       in
-      let _ = check_arities listdepkind in 
+      let _ = check_arities listdepkind in
       mis_make_indrec env sigma listdepkind mib
   | _ -> anomaly "build_indrec expects a non empty list of inductive types"
 
@@ -542,7 +542,7 @@ let build_indrec env sigma ind =
 (* To interpret Case and Match operators *)
 (* Expects a dependent predicate *)
 
-let type_rec_branches recursive env sigma indt p c = 
+let type_rec_branches recursive env sigma indt p c =
   let IndType (indf,realargs) = indt in
   let (ind,params) = dest_ind_family indf in
   let (mib,mip) = lookup_mind_specif env ind in
@@ -591,11 +591,11 @@ let lookup_eliminator ind_sp s =
     errorlabstrm "default_elim"
       (strbrk "Cannot find the elimination combinator " ++
        pr_id id ++ strbrk ", the elimination of the inductive definition " ++
-       pr_global_env Idset.empty (IndRef ind_sp) ++ 
+       pr_global_env Idset.empty (IndRef ind_sp) ++
        strbrk " on sort " ++ pr_sort_family s ++
        strbrk " is probably not allowed.")
 
-(* Build the congruence lemma associated to an inductive type 
+(* Build the congruence lemma associated to an inductive type
    I p1..pn a1..am with one constructor C : I q1..qn b1..bm *)
 
 (* TODO: extend it to types with more than one index *)
@@ -638,10 +638,10 @@ let build_congr env (eq,refl) ind (mib,mip) =
            (Anonymous,
             applist
              (mkInd ind,
-	        extended_rel_list (2*mip.mind_nrealargs_ctxt+3) 
+	        extended_rel_list (2*mip.mind_nrealargs_ctxt+3)
 		  mib.mind_params_ctxt
 	        @ extended_rel_list 0 realsign),
-            mkApp (eq, 
+            mkApp (eq,
 	      [|mkVar varB;
                 mkApp (mkVar varf, [|lift (2*mip.mind_nrealargs_ctxt+4) c|]);
 		mkApp (mkVar varf, [|mkRel (mip.mind_nrealargs - i + 2)|])|]))),
@@ -649,4 +649,4 @@ let build_congr env (eq,refl) ind (mib,mip) =
        [|mkApp (refl,
           [|mkVar varB;
 	    mkApp (mkVar varf, [|lift (mip.mind_nrealargs+3) c|])|])|]))))))
- 
+
diff --git a/pretyping/indrec.mli b/pretyping/indrec.mli
index d7507bd66..ac6a61c3c 100644
--- a/pretyping/indrec.mli
+++ b/pretyping/indrec.mli
@@ -43,7 +43,7 @@ val instantiate_type_indrec_scheme : sorts -> int -> constr -> types ->
 
 (** Complex recursion schemes [Scheme] *)
 
-val build_mutual_indrec : 
+val build_mutual_indrec :
   env -> evar_map ->
     (inductive * mutual_inductive_body * one_inductive_body
     * bool * sorts_family) list
@@ -53,7 +53,7 @@ val build_mutual_indrec :
 
 val type_rec_branches : bool -> env -> evar_map -> inductive_type
   -> constr -> constr -> constr array * constr
-val make_rec_branch_arg : 
+val make_rec_branch_arg :
   env -> evar_map ->
     int * ('b * constr) option array * int ->
     constr -> constructor_summary -> wf_paths list -> constr
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 727fd6f85..bfe1522f9 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -71,15 +71,15 @@ let substnl_ind_type l n = map_inductive_type (substnl l n)
 let mkAppliedInd (IndType ((ind,params), realargs)) =
   applist (mkInd ind,params@realargs)
 
-(* Does not consider imbricated or mutually recursive types *) 
-let mis_is_recursive_subset listind rarg = 
-  let rec one_is_rec rvec = 
+(* Does not consider imbricated or mutually recursive types *)
+let mis_is_recursive_subset listind rarg =
+  let rec one_is_rec rvec =
     List.exists
       (fun ra ->
         match dest_recarg ra with
-	  | Mrec i -> List.mem i listind 
+	  | Mrec i -> List.mem i listind
           | _ -> false) rvec
-  in 
+  in
   array_exists one_is_rec (dest_subterms rarg)
 
 let mis_is_recursive (ind,mib,mip) =
@@ -90,7 +90,7 @@ let mis_nf_constructor_type (ind,mib,mip) j =
   let specif = mip.mind_nf_lc
   and ntypes = mib.mind_ntypes
   and nconstr = Array.length mip.mind_consnames in
-  let make_Ik k = mkInd ((fst ind),ntypes-k-1) in 
+  let make_Ik k = mkInd ((fst ind),ntypes-k-1) in
   if j > nconstr then error "Not enough constructors in the type.";
   substl (list_tabulate make_Ik ntypes) specif.(j-1)
 
@@ -101,15 +101,15 @@ let mis_constr_nargs indsp =
   let recargs = dest_subterms mip.mind_recargs in
   Array.map List.length recargs
 
-let mis_constr_nargs_env env (kn,i) = 
+let mis_constr_nargs_env env (kn,i) =
   let mib = Environ.lookup_mind kn env in
-  let mip = mib.mind_packets.(i) in 
+  let mip = mib.mind_packets.(i) in
   let recargs = dest_subterms mip.mind_recargs in
   Array.map List.length recargs
 
 let mis_constructor_nargs_env env ((kn,i),j) =
   let mib = Environ.lookup_mind kn env in
-  let mip = mib.mind_packets.(i) in 
+  let mip = mib.mind_packets.(i) in
   recarg_length mip.mind_recargs j + mib.mind_nparams
 
 let constructor_nrealargs env (ind,j) =
@@ -124,7 +124,7 @@ let get_full_arity_sign env ind =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
   mip.mind_arity_ctxt
 
-let nconstructors ind = 
+let nconstructors ind =
   let (mib,mip) = Inductive.lookup_mind_specif (Global.env()) ind in
   Array.length mip.mind_consnames
 
@@ -175,7 +175,7 @@ let instantiate_params t args sign =
 	(match kind_of_term t with
 	   | Prod(_,_,t) -> inst (a::s) t (ctxt,args)
 	   | _ -> anomaly"instantiate_params: type, ctxt and args mismatch")
-    | ((_,(Some b),_)::ctxt,args) -> 
+    | ((_,(Some b),_)::ctxt,args) ->
 	(match kind_of_term t with
 	   | LetIn(_,_,_,t) -> inst ((substl s b)::s) t (ctxt,args)
 	   | _ -> anomaly"instantiate_params: type, ctxt and args mismatch")
@@ -252,7 +252,7 @@ let build_dependent_constructor cs =
 let build_dependent_inductive env ((ind, params) as indf) =
   let arsign,_ = get_arity env indf in
   let nrealargs = List.length arsign in
-  applist 
+  applist
     (mkInd ind,
      (List.map (lift nrealargs) params)@(extended_rel_list 0 arsign))
 
@@ -325,7 +325,7 @@ let find_coinductive env sigma c =
 (* find appropriate names for pattern variables. Useful in the Case
    and Inversion (case_then_using et case_nodep_then_using) tactics. *)
 
-let is_predicate_explicitly_dep env pred arsign = 
+let is_predicate_explicitly_dep env pred arsign =
   let rec srec env pval arsign =
     let pv' = whd_betadeltaiota env Evd.empty pval in
     match kind_of_term pv', arsign with
@@ -405,7 +405,7 @@ let arity_of_case_predicate env (ind,params) dep k =
 (* Check if u (sort of a parameter) appears in the sort of the
    inductive (is). This is done by trying to enforce u > u' >= is
    in the empty univ graph. If an inconsistency appears, then
-   is depends on u. *)  
+   is depends on u. *)
 let is_constrained is u =
   try
     let u' = fresh_local_univ() in
@@ -456,7 +456,7 @@ let type_of_inductive_knowing_conclusion env mip conclty =
 (* A function which checks that a term well typed verifies both
    syntactic conditions *)
 
-let control_only_guard env c = 
+let control_only_guard env c =
   let check_fix_cofix e c = match kind_of_term c with
     | CoFix (_,(_,_,_) as cofix) ->
 	Inductive.check_cofix e cofix
@@ -464,12 +464,12 @@ let control_only_guard env c =
 	Inductive.check_fix e fix
     | _ -> ()
   in
-  let rec iter env c = 
-    check_fix_cofix env c; 
+  let rec iter env c =
+    check_fix_cofix env c;
     iter_constr_with_full_binders push_rel iter env c
   in
   iter env c
 
-let subst_inductive subst (kn,i as ind) = 
+let subst_inductive subst (kn,i as ind) =
   let kn' = Mod_subst.subst_kn subst kn in
   if kn == kn' then ind else (kn',i)
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index cea769955..a9a51d9ac 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -110,7 +110,7 @@ val type_case_branches_with_names :
     types array * types
 val make_case_info : env -> inductive -> case_style -> case_info
 
-(*i Compatibility 
+(*i Compatibility
 val make_default_case_info : env -> case_style -> inductive -> case_info
 i*)
 
diff --git a/pretyping/matching.ml b/pretyping/matching.ml
index 341fc28f2..0b1e05de9 100644
--- a/pretyping/matching.ml
+++ b/pretyping/matching.ml
@@ -75,15 +75,15 @@ let add_binders na1 na2 (names,terms as subst) =
          ((id1,id2)::names,terms));
   | _ -> subst
 
-let build_lambda toabstract stk (m : constr) = 
-  let rec buildrec m p_0 p_1 = match p_0,p_1 with 
+let build_lambda toabstract stk (m : constr) =
+  let rec buildrec m p_0 p_1 = match p_0,p_1 with
     | (_, []) -> m
-    | (n, (na,t)::tl) -> 
+    | (n, (na,t)::tl) ->
 	if List.mem n toabstract then
           buildrec (mkLambda (na,t,m)) (n+1) tl
-        else 
+        else
 	  buildrec (lift (-1) m) (n+1) tl
-  in 
+  in
   buildrec m 1 stk
 
 let memb_metavars m n =
@@ -98,7 +98,7 @@ let same_case_structure (_,cs1,ind,_) ci2 br1 br2 =
   | Some ind -> ind = ci2.ci_ind
   | None -> cs1 = ci2.ci_cstr_nargs
 
-let matches_core convert allow_partial_app pat c = 
+let matches_core convert allow_partial_app pat c =
   let conv = match convert with
     | None -> eq_constr
     | Some (env,sigma) -> is_conv env sigma in
@@ -127,7 +127,7 @@ let matches_core convert allow_partial_app pat c =
 	    let frels = Intset.elements (free_rels cT) in
             if List.for_all (fun i -> i > depth) frels then
 	      constrain (n,lift (-depth) cT) subst
-            else 
+            else
 	      raise PatternMatchingFailure
 
       | PMeta None, m -> subst
@@ -195,7 +195,7 @@ let matches_core convert allow_partial_app pat c =
 
       | PCase (ci1,p1,a1,br1), Case (ci2,p2,a2,br2) ->
 	  if same_case_structure ci1 ci2 br1 br2 then
-  	    array_fold_left2 (sorec stk) 
+  	    array_fold_left2 (sorec stk)
 	      (sorec stk (sorec stk subst a1 a2) p1 p2) br1 br2
           else
             raise PatternMatchingFailure
@@ -216,7 +216,7 @@ let special_meta = (-1)
 
 (* Tells if it is an authorized occurrence and if the instance is closed *)
 let authorized_occ partial_app closed pat c mk_ctx next =
-  try 
+  try
     let sigma = matches_core None partial_app pat c in
     if closed && not (List.for_all (fun (_,c) -> closed0 c) (snd sigma))
     then next ()
@@ -251,7 +251,7 @@ let sub_match ?(partial_app=false) ?(closed=true) pat c =
           if topdown then
             let lc1 = Array.sub lc 0 (Array.length lc - 1) in
             let app = mkApp (c1,lc1) in
-            let mk_ctx = function 
+            let mk_ctx = function
               | [app';c] -> mk_ctx (mkApp (app',[|c|]))
               | _ -> assert false in
 	    try_aux [app;array_last lc] mk_ctx next
@@ -274,7 +274,7 @@ let sub_match ?(partial_app=false) ?(closed=true) pat c =
 	  try_aux (c1::Array.to_list lc) mk_ctx next)
   | Case (ci,hd,c1,lc) ->
       authorized_occ partial_app closed pat c mk_ctx (fun () ->
-        let mk_ctx le = 
+        let mk_ctx le =
           mk_ctx (mkCase (ci,hd,List.hd le,Array.of_list (List.tl le))) in
         try_aux (c1::Array.to_list lc) mk_ctx next)
   | Construct _ | Fix _ | Ind _|CoFix _ |Evar _|Const _
diff --git a/pretyping/matching.mli b/pretyping/matching.mli
index 4b3bc6c05..98d16b112 100644
--- a/pretyping/matching.mli
+++ b/pretyping/matching.mli
@@ -34,7 +34,7 @@ val matches : constr_pattern -> constr -> patvar_map
    in [c] that matches the bound variables in [pat]; if several bound
    variables or metavariables have the same name, the metavariable,
    or else the rightmost bound variable, takes precedence *)
-val extended_matches : 
+val extended_matches :
   constr_pattern -> constr -> bound_ident_map * patvar_map
 
 (* [is_matching pat c] just tells if [c] matches against [pat] *)
@@ -59,14 +59,14 @@ type subterm_matching_result =
 val match_subterm : constr_pattern -> constr -> subterm_matching_result
 
 (* [match_appsubterm pat c] returns the substitution and the context
-   corresponding to the first **closed** subterm of [c] matching [pat], 
+   corresponding to the first **closed** subterm of [c] matching [pat],
    considering application contexts as well. It also returns a
    continuation that looks for the next matching subterm.
    It raises PatternMatchingFailure if no subterm matches the pattern *)
 val match_appsubterm : constr_pattern -> constr -> subterm_matching_result
 
 (* [match_subterm_gen] calls either [match_subterm] or [match_appsubterm] *)
-val match_subterm_gen : bool (* true = with app context *) -> 
+val match_subterm_gen : bool (* true = with app context *) ->
    constr_pattern -> constr -> subterm_matching_result
 
 (* [is_matching_appsubterm pat c] tells if a subterm of [c] matches
diff --git a/pretyping/pattern.ml b/pretyping/pattern.ml
index d4b21fba5..be37e6531 100644
--- a/pretyping/pattern.ml
+++ b/pretyping/pattern.ml
@@ -69,8 +69,8 @@ exception BoundPattern;;
 
 let rec head_pattern_bound t =
   match t with
-    | PProd (_,_,b)  -> head_pattern_bound b 
-    | PLetIn (_,_,b) -> head_pattern_bound b 
+    | PProd (_,_,b)  -> head_pattern_bound b
+    | PLetIn (_,_,b) -> head_pattern_bound b
     | PApp (c,args)  -> head_pattern_bound c
     | PIf (c,_,_)  -> head_pattern_bound c
     | PCase (_,p,c,br) -> head_pattern_bound c
@@ -149,11 +149,11 @@ let rec subst_pattern subst pat = match pat with
       let ref',t = subst_global subst ref in
 	if ref' == ref then pat else
 	 pattern_of_constr t
-  | PVar _ 
+  | PVar _
   | PEvar _
   | PRel _ -> pat
   | PApp (f,args) ->
-      let f' = subst_pattern subst f in 
+      let f' = subst_pattern subst f in
       let args' = array_smartmap (subst_pattern subst) args in
 	if f' == f && args' == args then pat else
 	  PApp (f',args')
@@ -176,7 +176,7 @@ let rec subst_pattern subst pat = match pat with
       let c2' = subst_pattern subst c2 in
 	if c1' == c1 && c2' == c2 then pat else
 	  PLetIn (name,c1',c2')
-  | PSort _ 
+  | PSort _
   | PMeta _ -> pat
   | PIf (c,c1,c2) ->
       let c' = subst_pattern subst c in
@@ -186,12 +186,12 @@ let rec subst_pattern subst pat = match pat with
 	  PIf (c',c1',c2')
   | PCase ((a,b,ind,n as cs),typ,c,branches) ->
       let ind' = Option.smartmap (Inductiveops.subst_inductive subst) ind in
-      let typ' = subst_pattern subst typ in 
+      let typ' = subst_pattern subst typ in
       let c' = subst_pattern subst c in
       let branches' = array_smartmap (subst_pattern subst) branches in
       let cs' = if ind == ind' then cs else (a,b,ind',n) in
 	if typ' == typ && c' == c && branches' == branches then pat else
-	  PCase(cs',typ', c', branches') 
+	  PCase(cs',typ', c', branches')
   | PFix fixpoint ->
       let cstr = mkFix fixpoint in
       let fixpoint' = destFix (subst_mps subst cstr) in
@@ -204,7 +204,7 @@ let rec subst_pattern subst pat = match pat with
 	  PCoFix cofixpoint'
 
 let mkPLambda na b = PLambda(na,PMeta None,b)
-let rev_it_mkPLambda = List.fold_right mkPLambda 
+let rev_it_mkPLambda = List.fold_right mkPLambda
 
 let rec pat_of_raw metas vars = function
   | RVar (_,id) ->
@@ -217,14 +217,14 @@ let rec pat_of_raw metas vars = function
   (* Hack pour ne pas réécrire une interprétation complète des patterns*)
   | RApp (_, RPatVar (_,(true,n)), cl) ->
       metas := n::!metas; PSoApp (n, List.map (pat_of_raw metas vars) cl)
-  | RApp (_,c,cl) -> 
+  | RApp (_,c,cl) ->
       PApp (pat_of_raw metas vars c,
 	    Array.of_list (List.map (pat_of_raw metas vars) cl))
   | RLambda (_,na,bk,c1,c2) ->
       name_iter (fun n -> metas := n::!metas) na;
       PLambda (na, pat_of_raw metas vars c1,
 	       pat_of_raw metas (na::vars) c2)
-  | RProd (_,na,bk,c1,c2) -> 
+  | RProd (_,na,bk,c1,c2) ->
       name_iter (fun n -> metas := n::!metas) na;
       PProd (na, pat_of_raw metas vars c1,
 	       pat_of_raw metas (na::vars) c2)
@@ -264,7 +264,7 @@ let rec pat_of_raw metas vars = function
       let cstr_nargs,brs = (Array.map fst cbrs, Array.map snd cbrs) in
       PCase ((sty,cstr_nargs,ind,ind_nargs), pred,
              pat_of_raw metas vars c, brs)
-             
+
   | r ->
       let loc = loc_of_rawconstr r in
       user_err_loc (loc,"pattern_of_rawconstr", Pp.str"Non supported pattern.")
@@ -287,7 +287,7 @@ and pat_of_raw_branch loc metas vars ind brs i =
               | PatCstr(loc,_,_,_) ->
                   user_err_loc (loc,"pattern_of_rawconstr",
                                 Pp.str "Non supported pattern.")) lv in
-        let vars' = List.rev lna @ vars in 
+        let vars' = List.rev lna @ vars in
 	List.length lv, rev_it_mkPLambda lna (pat_of_raw metas vars' br)
     | _ -> user_err_loc (loc,"pattern_of_rawconstr",
                          str "No unique branch for " ++ int (i+1) ++
diff --git a/pretyping/pattern.mli b/pretyping/pattern.mli
index ee0eefade..b0229ab61 100644
--- a/pretyping/pattern.mli
+++ b/pretyping/pattern.mli
@@ -72,7 +72,7 @@ val pattern_of_constr : constr -> constr_pattern
    a pattern; variables bound in [l] are replaced by the pattern to which they
     are bound *)
 
-val pattern_of_rawconstr : rawconstr -> 
+val pattern_of_rawconstr : rawconstr ->
       patvar list * constr_pattern
 
 val instantiate_pattern :
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index 06d1aa533..aa83f71c2 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -25,7 +25,7 @@ type pretype_error =
   (* Unification *)
   | OccurCheck of existential_key * constr
   | NotClean of existential_key * constr * Evd.hole_kind
-  | UnsolvableImplicit of Evd.evar_info * Evd.hole_kind * 
+  | UnsolvableImplicit of Evd.evar_info * Evd.hole_kind *
       Evd.unsolvability_explanation option
   | CannotUnify of constr * constr
   | CannotUnifyLocal of constr * constr * constr
@@ -47,7 +47,7 @@ let precatchable_exception = function
   | _ -> false
 
 let nf_evar = Reductionops.nf_evar
-let j_nf_evar sigma j = 
+let j_nf_evar sigma j =
   { uj_val = nf_evar sigma j.uj_val;
     uj_type = nf_evar sigma j.uj_type }
 let jl_nf_evar sigma jl = List.map (j_nf_evar sigma) jl
@@ -76,7 +76,7 @@ let contract env lc =
       | Some c' when isRel c' ->
 	  l := (substl !l c') :: !l;
 	  env
-      | _ -> 
+      | _ ->
 	  let t' = substl !l t in
 	  let c' = Option.map (substl !l) c in
 	  let na' = named_hd env t' na in
@@ -161,7 +161,7 @@ let error_unsolvable_implicit loc env sigma evi e explain =
 let error_cannot_unify env sigma (m,n) =
   raise (PretypeError (env_ise sigma env,CannotUnify (m,n)))
 
-let error_cannot_unify_local env sigma (m,n,sn) = 
+let error_cannot_unify_local env sigma (m,n,sn) =
   raise (PretypeError (env_ise sigma env,CannotUnifyLocal (m,n,sn)))
 
 let error_cannot_coerce env sigma (m,n) =
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index a276b4ed5..ca48f7021 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -27,7 +27,7 @@ type pretype_error =
   (* Unification *)
   | OccurCheck of existential_key * constr
   | NotClean of existential_key * constr * Evd.hole_kind
-  | UnsolvableImplicit of Evd.evar_info * Evd.hole_kind * 
+  | UnsolvableImplicit of Evd.evar_info * Evd.hole_kind *
       Evd.unsolvability_explanation option
   | CannotUnify of constr * constr
   | CannotUnifyLocal of constr * constr * constr
@@ -59,22 +59,22 @@ val tj_nf_evar :
 val error_actual_type_loc :
   loc -> env ->  Evd.evar_map -> unsafe_judgment -> constr -> 'b
 
-val error_cant_apply_not_functional_loc : 
+val error_cant_apply_not_functional_loc :
   loc -> env ->  Evd.evar_map ->
       unsafe_judgment -> unsafe_judgment list -> 'b
 
-val error_cant_apply_bad_type_loc : 
-  loc -> env ->  Evd.evar_map -> int * constr * constr -> 
+val error_cant_apply_bad_type_loc :
+  loc -> env ->  Evd.evar_map -> int * constr * constr ->
       unsafe_judgment -> unsafe_judgment list -> 'b
 
 val error_case_not_inductive_loc :
   loc -> env ->  Evd.evar_map -> unsafe_judgment -> 'b
 
-val error_ill_formed_branch_loc : 
+val error_ill_formed_branch_loc :
   loc -> env ->  Evd.evar_map ->
       constr -> int -> constr -> constr -> 'b
 
-val error_number_branches_loc : 
+val error_number_branches_loc :
   loc -> env ->  Evd.evar_map ->
       unsafe_judgment -> int -> 'b
 
@@ -95,7 +95,7 @@ val error_not_clean :
   env -> Evd.evar_map -> existential_key -> constr -> loc * Evd.hole_kind -> 'b
 
 val error_unsolvable_implicit :
-  loc -> env -> Evd.evar_map -> Evd.evar_info -> Evd.hole_kind -> 
+  loc -> env -> Evd.evar_map -> Evd.evar_info -> Evd.hole_kind ->
       Evd.unsolvability_explanation option -> 'b
 
 val error_cannot_unify : env -> Evd.evar_map -> constr * constr -> 'b
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index d8ae03130..956b778e0 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -23,7 +23,7 @@ open Libnames
 open Nameops
 open Classops
 open List
-open Recordops 
+open Recordops
 open Evarutil
 open Pretype_errors
 open Rawterm
@@ -47,27 +47,27 @@ open Inductiveops
 
 exception Found of int array
 
-let search_guard loc env possible_indexes fixdefs = 
+let search_guard loc env possible_indexes fixdefs =
   (* Standard situation with only one possibility for each fix. *)
   (* We treat it separately in order to get proper error msg. *)
-  if List.for_all (fun l->1=List.length l) possible_indexes then 
-    let indexes = Array.of_list (List.map List.hd possible_indexes) in 
+  if List.for_all (fun l->1=List.length l) possible_indexes then
+    let indexes = Array.of_list (List.map List.hd possible_indexes) in
     let fix = ((indexes, 0),fixdefs) in
-    (try check_fix env fix with 
+    (try check_fix env fix with
        | e -> if loc = dummy_loc then raise e else Stdpp.raise_with_loc loc e);
     indexes
   else
     (* we now search recursively amoungst all combinations *)
-    (try     
-       List.iter 
-	 (fun l -> 
-	    let indexes = Array.of_list l in 
+    (try
+       List.iter
+	 (fun l ->
+	    let indexes = Array.of_list l in
 	    let fix = ((indexes, 0),fixdefs) in
-	    try check_fix env fix; raise (Found indexes) 
+	    try check_fix env fix; raise (Found indexes)
 	    with TypeError _ -> ())
-	 (list_combinations possible_indexes); 
-       let errmsg = "Cannot guess decreasing argument of fix." in 
-       if loc = dummy_loc then error errmsg else 
+	 (list_combinations possible_indexes);
+       let errmsg = "Cannot guess decreasing argument of fix." in
+       if loc = dummy_loc then error errmsg else
 	 user_err_loc (loc,"search_guard", Pp.str errmsg)
      with Found indexes -> indexes)
 
@@ -76,66 +76,66 @@ let ((constr_in : constr -> Dyn.t),
      (constr_out : Dyn.t -> constr)) = create "constr"
 
 (** Miscellaneous interpretation functions *)
-  
+
 let interp_sort = function
   | RProp c -> Prop c
   | RType _ -> new_Type_sort ()
-      
+
 let interp_elimination_sort = function
   | RProp Null -> InProp
   | RProp Pos  -> InSet
   | RType _ -> InType
 
-module type S = 
+module type S =
 sig
 
   module Cases : Cases.S
-  
+
   (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *)
   val allow_anonymous_refs : bool ref
 
   (* Generic call to the interpreter from rawconstr to open_constr, leaving
      unresolved holes as evars and returning the typing contexts of
      these evars. Work as [understand_gen] for the rest. *)
-  
+
   val understand_tcc : ?resolve_classes:bool ->
     evar_map -> env -> ?expected_type:types -> rawconstr -> open_constr
 
   val understand_tcc_evars : ?fail_evar:bool -> ?resolve_classes:bool ->
     evar_defs ref -> env -> typing_constraint -> rawconstr -> constr
-    
+
   (* More general entry point with evars from ltac *)
-    
+
   (* Generic call to the interpreter from rawconstr to constr, failing
      unresolved holes in the rawterm cannot be instantiated.
-     
+
      In [understand_ltac sigma env ltac_env constraint c],
-     
+
      sigma : initial set of existential variables (typically dependent subgoals)
      ltac_env : partial substitution of variables (used for the tactic language)
-     constraint : tell if interpreted as a possibly constrained term or a type 
+     constraint : tell if interpreted as a possibly constrained term or a type
   *)
-    
+
   val understand_ltac :
     evar_map -> env -> var_map * unbound_ltac_var_map ->
     typing_constraint -> rawconstr -> evar_defs * constr
-    
+
   (* Standard call to get a constr from a rawconstr, resolving implicit args *)
-    
+
   val understand : evar_map -> env -> ?expected_type:Term.types ->
     rawconstr -> constr
-    
+
   (* Idem but the rawconstr is intended to be a type *)
-    
+
   val understand_type : evar_map -> env -> rawconstr -> constr
-    
+
   (* A generalization of the two previous case *)
-    
-  val understand_gen : typing_constraint -> evar_map -> env -> 
+
+  val understand_gen : typing_constraint -> evar_map -> env ->
     rawconstr -> constr
-    
+
   (* Idem but returns the judgment of the understood term *)
-    
+
   val understand_judgment : evar_map -> env -> rawconstr -> unsafe_judgment
 
   (* Idem but do not fail on unresolved evars *)
@@ -146,12 +146,12 @@ sig
   (* Internal of Pretyping...
    * Unused outside, but useful for debugging
    *)
-  val pretype : 
-    type_constraint -> env -> evar_defs ref -> 
+  val pretype :
+    type_constraint -> env -> evar_defs ref ->
     var_map * (identifier * identifier option) list ->
     rawconstr -> unsafe_judgment
-    
-  val pretype_type : 
+
+  val pretype_type :
     val_constraint -> env -> evar_defs ref ->
     var_map * (identifier * identifier option) list ->
     rawconstr -> unsafe_type_judgment
@@ -190,27 +190,27 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     let (evd',t) = f !evdref x y z in
       evdref := evd';
       t
-	
+
   let mt_evd = Evd.empty
-    
+
   (* Utilisé pour inférer le prédicat des Cases *)
   (* Semble exagérement fort *)
   (* Faudra préférer une unification entre les types de toutes les clauses *)
   (* et autoriser des ? à rester dans le résultat de l'unification *)
-  
+
   let evar_type_fixpoint loc env evdref lna lar vdefj =
-    let lt = Array.length vdefj in 
-      if Array.length lar = lt then 
-	for i = 0 to lt-1 do 
+    let lt = Array.length vdefj in
+      if Array.length lar = lt then
+	for i = 0 to lt-1 do
           if not (e_cumul env evdref (vdefj.(i)).uj_type
 		    (lift lt lar.(i))) then
             error_ill_typed_rec_body_loc loc env !evdref
               i lna vdefj lar
 	done
 
-  let check_branches_message loc env evdref c (explft,lft) = 
+  let check_branches_message loc env evdref c (explft,lft) =
     for i = 0 to Array.length explft - 1 do
-      if not (e_cumul env evdref lft.(i) explft.(i)) then 
+      if not (e_cumul env evdref lft.(i) explft.(i)) then
 	let sigma =  !evdref in
 	  error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i)
     done
@@ -257,14 +257,14 @@ module Pretyping_F (Coercion : Coercion.S) = struct
       if n=0 then p else
 	match kind_of_term p with
 	  | Lambda (_,_,c) -> decomp (n-1) c
-	  | _ -> decomp (n-1) (applist (lift 1 p, [mkRel 1])) 
+	  | _ -> decomp (n-1) (applist (lift 1 p, [mkRel 1]))
     in
     let sign,s = decompose_prod_n n pj.uj_type in
     let ind = build_dependent_inductive env indf in
     let s' = mkProd (Anonymous, ind, s) in
     let ccl = lift 1 (decomp n pj.uj_val) in
     let ccl' = mkLambda (Anonymous, ind, ccl) in
-      {uj_val=it_mkLambda ccl' sign; uj_type=it_mkProd s' sign} 
+      {uj_val=it_mkLambda ccl' sign; uj_type=it_mkProd s' sign}
 
   let evar_kind_of_term sigma c =
     kind_of_term (whd_evar sigma c)
@@ -272,7 +272,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
   (*************************************************************************)
   (* Main pretyping function                                               *)
 
-  let pretype_ref evdref env ref = 
+  let pretype_ref evdref env ref =
     let c = constr_of_global ref in
       make_judge c (Retyping.get_type_of env Evd.empty c)
 
@@ -307,12 +307,12 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	let j = (Retyping.get_judgment_of env !evdref c) in
 	  inh_conv_coerce_to_tycon loc env evdref j tycon
 
-    | RPatVar (loc,(someta,n)) -> 
+    | RPatVar (loc,(someta,n)) ->
 	anomaly "Found a pattern variable in a rawterm to type"
-	  
+
     | RHole (loc,k) ->
 	let ty =
-          match tycon with 
+          match tycon with
             | Some (None, ty) -> ty
             | None | Some _ ->
 		e_new_evar evdref env ~src:(loc,InternalHole) (new_Type ()) in
@@ -343,7 +343,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	  (* Note: bodies are not used by push_rec_types, so [||] is safe *)
 	let newenv = push_rec_types (names,ftys,[||]) env in
 	let vdefj =
-	  array_map2_i 
+	  array_map2_i
 	    (fun i ctxt def ->
                (* we lift nbfix times the type in tycon, because of
 		* the nbfix variables pushed to newenv *)
@@ -363,17 +363,17 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	      (* First, let's find the guard indexes. *)
 	      (* If recursive argument was not given by user, we try all args.
 	         An earlier approach was to look only for inductive arguments,
-		 but doing it properly involves delta-reduction, and it finally 
-                 doesn't seem worth the effort (except for huge mutual 
+		 but doing it properly involves delta-reduction, and it finally
+                 doesn't seem worth the effort (except for huge mutual
 		 fixpoints ?) *)
-	      let possible_indexes = Array.to_list (Array.mapi 
-		(fun i (n,_) -> match n with 
+	      let possible_indexes = Array.to_list (Array.mapi
+		(fun i (n,_) -> match n with
 		   | Some n -> [n]
 		   | None -> list_map_i (fun i _ -> i) 0 ctxtv.(i))
 		vn)
-	      in 
-	      let fixdecls = (names,ftys,fdefs) in 
-	      let indexes = search_guard loc env possible_indexes fixdecls in 
+	      in
+	      let fixdecls = (names,ftys,fdefs) in
+	      let indexes = search_guard loc env possible_indexes fixdecls in
 	      make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i)
 	  | RCoFix i ->
 	      let cofix = (i,(names,ftys,fdefs)) in
@@ -384,7 +384,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     | RSort (loc,s) ->
 	inh_conv_coerce_to_tycon loc env evdref (pretype_sort s) tycon
 
-    | RApp (loc,f,args) -> 
+    | RApp (loc,f,args) ->
 	let fj = pretype empty_tycon env evdref lvar f in
  	let floc = loc_of_rawconstr f in
 	let rec apply_rec env n resj = function
@@ -397,13 +397,13 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		  | Prod (na,c1,c2) ->
 		      let hj = pretype (mk_tycon c1) env evdref lvar c in
 		      let value, typ = applist (j_val resj, [j_val hj]), subst1 hj.uj_val c2 in
-			apply_rec env (n+1) 
+			apply_rec env (n+1)
 			  { uj_val = value;
 			    uj_type = typ }
 			  rest
 		  | _ ->
 		      let hj = pretype empty_tycon env evdref lvar c in
-			error_cant_apply_not_functional_loc 
+			error_cant_apply_not_functional_loc
 			  (join_loc floc argloc) env !evdref
 	      		  resj [hj]
 	in
@@ -429,7 +429,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	let dom_valcon = valcon_of_tycon dom in
 	let j = pretype_type dom_valcon env evdref lvar c1 in
 	let var = (name,None,j.utj_val) in
-	let j' = pretype rng (push_rel var env) evdref lvar c2 in 
+	let j' = pretype rng (push_rel var env) evdref lvar c2 in
 	  judge_of_abstraction env (orelse_name name name') j j'
 
     | RProd(loc,name,bk,c1,c2)        ->
@@ -447,12 +447,12 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	  try judge_of_product env name j j'
 	  with TypeError _ as e -> Stdpp.raise_with_loc loc e in
 	  inh_conv_coerce_to_tycon loc env evdref resj tycon
-	    
+
     | RLetIn(loc,name,c1,c2)      ->
-	let j = 
+	let j =
 	  match c1 with
 	  | RCast (loc, c, CastConv (DEFAULTcast, t)) ->
-	      let tj = pretype_type empty_valcon env evdref lvar t in		
+	      let tj = pretype_type empty_valcon env evdref lvar t in
 		pretype (mk_tycon tj.utj_val) env evdref lvar c
 	  | _ -> pretype empty_tycon env evdref lvar c1
 	in
@@ -465,11 +465,11 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 
     | RLetTuple (loc,nal,(na,po),c,d) ->
 	let cj = pretype empty_tycon env evdref lvar c in
-	let (IndType (indf,realargs)) = 
+	let (IndType (indf,realargs)) =
 	  try find_rectype env !evdref cj.uj_type
 	  with Not_found ->
 	    let cloc = loc_of_rawconstr c in
-	      error_case_not_inductive_loc cloc env !evdref cj 
+	      error_case_not_inductive_loc cloc env !evdref cj
 	in
 	let cstrs = get_constructors env indf in
 	  if Array.length cstrs <> 1 then
@@ -496,7 +496,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		     let ccl = nf_evar !evdref pj.utj_val in
 		     let psign = make_arity_signature env true indf in (* with names *)
 		     let p = it_mkLambda_or_LetIn ccl psign in
-		     let inst = 
+		     let inst =
 		       (Array.to_list cs.cs_concl_realargs)
 		       @[build_dependent_constructor cs] in
 		     let lp = lift cs.cs_nargs p in
@@ -506,46 +506,46 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		     let v =
 		       let mis,_ = dest_ind_family indf in
 		       let ci = make_case_info env mis LetStyle in
-			 mkCase (ci, p, cj.uj_val,[|f|]) in 
+			 mkCase (ci, p, cj.uj_val,[|f|]) in
 		       { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl }
 
-		 | None -> 
+		 | None ->
 		     let tycon = lift_tycon cs.cs_nargs tycon in
 		     let fj = pretype tycon env_f evdref lvar d in
 		     let f = it_mkLambda_or_LetIn fj.uj_val fsign in
 		     let ccl = nf_evar !evdref fj.uj_type in
 		     let ccl =
 		       if noccur_between 1 cs.cs_nargs ccl then
-			 lift (- cs.cs_nargs) ccl 
+			 lift (- cs.cs_nargs) ccl
 		       else
-			 error_cant_find_case_type_loc loc env !evdref 
+			 error_cant_find_case_type_loc loc env !evdref
 			   cj.uj_val in
 		     let ccl = refresh_universes ccl in
 		     let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in
 		     let v =
 		       let mis,_ = dest_ind_family indf in
 		       let ci = make_case_info env mis LetStyle in
-			 mkCase (ci, p, cj.uj_val,[|f|] ) 
+			 mkCase (ci, p, cj.uj_val,[|f|] )
 		     in
 		       { uj_val = v; uj_type = ccl })
 
     | RIf (loc,c,(na,po),b1,b2) ->
 	let cj = pretype empty_tycon env evdref lvar c in
-	let (IndType (indf,realargs)) = 
+	let (IndType (indf,realargs)) =
 	  try find_rectype env !evdref cj.uj_type
 	  with Not_found ->
 	    let cloc = loc_of_rawconstr c in
 	      error_case_not_inductive_loc cloc env !evdref cj in
-	let cstrs = get_constructors env indf in 
+	let cstrs = get_constructors env indf in
 	  if Array.length cstrs <> 2 then
             user_err_loc (loc,"",
 			  str "If is only for inductive types with two constructors.");
 
-	  let arsgn = 
+	  let arsgn =
 	    let arsgn,_ = get_arity env indf in
 	      if not !allow_anonymous_refs then
 		(* Make dependencies from arity signature impossible *)
-		List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn 
+		List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn
 	      else arsgn
 	  in
 	  let nar = List.length arsgn in
@@ -558,10 +558,10 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		let pred = it_mkLambda_or_LetIn ccl psign in
 		let typ = lift (- nar) (beta_applist (pred,[cj.uj_val])) in
 		let jtyp = inh_conv_coerce_to_tycon loc env evdref {uj_val = pred;
-								     uj_type = typ} tycon 
+								     uj_type = typ} tycon
 		in
 		  jtyp.uj_val, jtyp.uj_type
-	    | None -> 
+	    | None ->
 		let p = match tycon with
 		  | Some (None, ty) -> ty
 		  | None | Some _ ->
@@ -574,18 +574,18 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	    let n = rel_context_length cs.cs_args in
 	    let pi = lift n pred in (* liftn n 2 pred ? *)
 	    let pi = beta_applist (pi, [build_dependent_constructor cs]) in
-	    let csgn = 
+	    let csgn =
 	      if not !allow_anonymous_refs then
-		List.map (fun (_,b,t) -> (Anonymous,b,t)) cs.cs_args 
-	      else 
-		List.map 
+		List.map (fun (_,b,t) -> (Anonymous,b,t)) cs.cs_args
+	      else
+		List.map
 		  (fun (n, b, t) ->
 		     match n with
                          Name _ -> (n, b, t)
                        | Anonymous -> (Name (id_of_string "H"), b, t))
 		cs.cs_args
 	    in
-	    let env_c = push_rels csgn env in 
+	    let env_c = push_rels csgn env in
 	    let bj = pretype (mk_tycon pi) env_c evdref lvar b in
 	      it_mkLambda_or_LetIn bj.uj_val cs.cs_args in
 	  let b1 = f cstrs.(0) b1 in
@@ -596,7 +596,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	      mkCase (ci, pred, cj.uj_val, [|b1;b2|])
 	  in
 	    { uj_val = v; uj_type = p }
-	  
+
     | RCases (loc,sty,po,tml,eqns) ->
 	Cases.compile_cases loc sty
 	  ((fun vtyc env evdref -> pretype vtyc env evdref lvar),evdref)
@@ -640,7 +640,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		 let t = Retyping.get_type_of env sigma v in
 		   match kind_of_term (whd_betadeltaiota env sigma t) with
                      | Sort s -> s
-                     | Evar ev when is_Type (existential_type sigma ev) -> 
+                     | Evar ev when is_Type (existential_type sigma ev) ->
 			 evd_comb1 (define_evar_as_sort) evdref ev
                      | _ -> anomaly "Found a type constraint which is not a type"
                in
@@ -671,7 +671,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	  (pretype_type empty_valcon env evdref lvar c).utj_val in
     evdref := fst (consider_remaining_unif_problems env !evdref);
     if resolve_classes then
-      evdref := 
+      evdref :=
         Typeclasses.resolve_typeclasses ~onlyargs:false
 	  ~split:true ~fail:fail_evar env !evdref;
     let c = nf_evar !evdref c' in
@@ -688,7 +688,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     let j = pretype empty_tycon env evdref ([],[]) c in
     let evd,_ = consider_remaining_unif_problems env !evdref in
     let evd = Typeclasses.resolve_typeclasses ~onlyargs:true ~split:false
-      ~fail:true env evd 
+      ~fail:true env evd
     in
     let j = j_nf_evar evd j in
     check_evars env sigma evd (mkCast(j.uj_val,DEFAULTcast, j.uj_type));
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 9b1f57484..7524c72a6 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -20,7 +20,7 @@ open Evarutil
 
 (* An auxiliary function for searching for fixpoint guard indexes *)
 
-val search_guard : 
+val search_guard :
     Util.loc -> env -> int list list -> rec_declaration -> int array
 
 type typing_constraint = OfType of types option | IsType
@@ -28,56 +28,56 @@ type typing_constraint = OfType of types option | IsType
 type var_map = (identifier * unsafe_judgment) list
 type unbound_ltac_var_map = (identifier * identifier option) list
 
-module type S = 
+module type S =
 sig
 
   module Cases : Cases.S
-    
+
   (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *)
   val allow_anonymous_refs : bool ref
 
   (* Generic call to the interpreter from rawconstr to open_constr, leaving
      unresolved holes as evars and returning the typing contexts of
      these evars. Work as [understand_gen] for the rest. *)
-  
+
   val understand_tcc : ?resolve_classes:bool ->
     evar_map -> env -> ?expected_type:types -> rawconstr -> open_constr
-    
+
   val understand_tcc_evars : ?fail_evar:bool -> ?resolve_classes:bool ->
     evar_defs ref -> env -> typing_constraint -> rawconstr -> constr
 
   (* More general entry point with evars from ltac *)
-    
+
   (* Generic call to the interpreter from rawconstr to constr, failing
      unresolved holes in the rawterm cannot be instantiated.
-     
+
      In [understand_ltac sigma env ltac_env constraint c],
-     
+
      sigma : initial set of existential variables (typically dependent subgoals)
      ltac_env : partial substitution of variables (used for the tactic language)
-     constraint : tell if interpreted as a possibly constrained term or a type 
+     constraint : tell if interpreted as a possibly constrained term or a type
   *)
-    
+
   val understand_ltac :
     evar_map -> env -> var_map * unbound_ltac_var_map ->
     typing_constraint -> rawconstr -> evar_defs * constr
-    
+
   (* Standard call to get a constr from a rawconstr, resolving implicit args *)
-    
+
   val understand : evar_map -> env -> ?expected_type:Term.types ->
     rawconstr -> constr
-    
+
   (* Idem but the rawconstr is intended to be a type *)
-    
+
   val understand_type : evar_map -> env -> rawconstr -> constr
-    
+
   (* A generalization of the two previous case *)
-    
-  val understand_gen : typing_constraint -> evar_map -> env -> 
+
+  val understand_gen : typing_constraint -> evar_map -> env ->
     rawconstr -> constr
-    
+
   (* Idem but returns the judgment of the understood term *)
-    
+
   val understand_judgment : evar_map -> env -> rawconstr -> unsafe_judgment
 
   (* Idem but do not fail on unresolved evars *)
@@ -86,12 +86,12 @@ sig
   (*i*)
   (* Internal of Pretyping...
    *)
-  val pretype : 
-    type_constraint -> env -> evar_defs ref -> 
+  val pretype :
+    type_constraint -> env -> evar_defs ref ->
     var_map * (identifier * identifier option) list ->
     rawconstr -> unsafe_judgment
-    
-  val pretype_type : 
+
+  val pretype_type :
     val_constraint -> env -> evar_defs ref ->
     var_map * (identifier * identifier option) list ->
     rawconstr -> unsafe_type_judgment
@@ -102,17 +102,17 @@ sig
     typing_constraint -> rawconstr -> constr
 
   (*i*)
-    
+
 end
 
 module Pretyping_F (C : Coercion.S) : S
 module Default : S
 
 (* To embed constr in rawconstr *)
-  
+
 val constr_in : constr -> Dyn.t
 val constr_out : Dyn.t -> constr
 
-val interp_sort : rawsort -> sorts  
+val interp_sort : rawsort -> sorts
 val interp_elimination_sort : rawsort -> sorts_family
 
diff --git a/pretyping/rawterm.ml b/pretyping/rawterm.ml
index d8eae2d0d..727ac117c 100644
--- a/pretyping/rawterm.ml
+++ b/pretyping/rawterm.ml
@@ -42,7 +42,7 @@ type quantified_hypothesis = AnonHyp of int | NamedHyp of identifier
 
 type 'a explicit_bindings = (loc * quantified_hypothesis * 'a) list
 
-type 'a bindings = 
+type 'a bindings =
   | ImplicitBindings of 'a list
   | ExplicitBindings of 'a explicit_bindings
   | NoBindings
@@ -53,7 +53,7 @@ type 'a cast_type =
   | CastConv of cast_kind * 'a
   | CastCoerce (* Cast to a base type (eg, an underlying inductive type) *)
 
-type rawconstr = 
+type rawconstr =
   | RRef of (loc * global_reference)
   | RVar of (loc * identifier)
   | REvar of loc * existential_key * rawconstr list option
@@ -63,7 +63,7 @@ type rawconstr =
   | RProd of loc * name * binding_kind * rawconstr * rawconstr
   | RLetIn of loc * name * rawconstr * rawconstr
   | RCases of loc * case_style * rawconstr option * tomatch_tuples * cases_clauses
-  | RLetTuple of loc * name list * (name * rawconstr option) * 
+  | RLetTuple of loc * name list * (name * rawconstr option) *
       rawconstr * rawconstr
   | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr
   | RRec of loc * fix_kind * identifier array * rawdecl list array *
@@ -99,7 +99,7 @@ let cases_predicate_names tml =
 
 (*i - if PRec (_, names, arities, bodies) is in env then arities are
    typed in env too and bodies are typed in env enriched by the
-   arities incrementally lifted 
+   arities incrementally lifted
 
   [On pourrait plutot mettre les arités aves le type qu'elles auront
    dans le contexte servant à typer les body ???]
@@ -127,7 +127,7 @@ let map_rawconstr f = function
             Array.map f tyl,Array.map f bv)
   | RCast (loc,c,k) -> RCast (loc,f c, match k with CastConv (k,t) -> CastConv (k, f t) | x -> x)
   | (RSort _ | RHole _ | RRef _ | REvar _ | RPatVar _ | RDynamic _) as x -> x
-  
+
 
 (*
 let name_app f e = function
@@ -178,10 +178,10 @@ let occur_rawconstr id =
 	(occur_option rtntypopt)
         or (List.exists (fun (tm,_) -> occur tm) tml)
 	or (List.exists occur_pattern pl)
-    | RLetTuple (loc,nal,rtntyp,b,c) -> 
+    | RLetTuple (loc,nal,rtntyp,b,c) ->
 	occur_return_type rtntyp id
         or (occur b) or (not (List.mem (Name id) nal) & (occur c))
-    | RIf (loc,c,rtntyp,b1,b2) -> 
+    | RIf (loc,c,rtntyp,b1,b2) ->
 	occur_return_type rtntyp id or (occur c) or (occur b1) or (occur b2)
     | RRec (loc,fk,idl,bl,tyl,bv) ->
         not (array_for_all4 (fun fid bl ty bd ->
@@ -207,67 +207,67 @@ let occur_rawconstr id =
   in occur
 
 
-let add_name_to_ids set na = 
-  match na with 
-    | Anonymous -> set 
-    | Name id -> Idset.add id set 
+let add_name_to_ids set na =
+  match na with
+    | Anonymous -> set
+    | Name id -> Idset.add id set
 
 let free_rawvars  =
   let rec vars bounded vs = function
     | RVar (loc,id') -> if Idset.mem id' bounded then vs else Idset.add id' vs
     | RApp (loc,f,args) -> List.fold_left (vars bounded) vs (f::args)
-    | RLambda (loc,na,_,ty,c) | RProd (loc,na,_,ty,c) | RLetIn (loc,na,ty,c) -> 
-	let vs' = vars bounded vs ty in 
-	let bounded' = add_name_to_ids bounded na in 
+    | RLambda (loc,na,_,ty,c) | RProd (loc,na,_,ty,c) | RLetIn (loc,na,ty,c) ->
+	let vs' = vars bounded vs ty in
+	let bounded' = add_name_to_ids bounded na in
        vars bounded' vs' c
     | RCases (loc,sty,rtntypopt,tml,pl) ->
-	let vs1 = vars_option bounded vs rtntypopt in 
-	let vs2 = List.fold_left (fun vs (tm,_) -> vars bounded vs tm) vs1 tml in 
+	let vs1 = vars_option bounded vs rtntypopt in
+	let vs2 = List.fold_left (fun vs (tm,_) -> vars bounded vs tm) vs1 tml in
 	List.fold_left (vars_pattern bounded) vs2 pl
     | RLetTuple (loc,nal,rtntyp,b,c) ->
-	let vs1 = vars_return_type bounded vs rtntyp in 
-	let vs2 = vars bounded vs1 b in 
+	let vs1 = vars_return_type bounded vs rtntyp in
+	let vs2 = vars bounded vs1 b in
 	let bounded' = List.fold_left add_name_to_ids bounded nal in
 	vars bounded' vs2 c
-    | RIf (loc,c,rtntyp,b1,b2) -> 
-	let vs1 = vars_return_type bounded vs rtntyp in 
-	let vs2 = vars bounded vs1 c in 
-	let vs3 = vars bounded vs2 b1 in 
+    | RIf (loc,c,rtntyp,b1,b2) ->
+	let vs1 = vars_return_type bounded vs rtntyp in
+	let vs2 = vars bounded vs1 c in
+	let vs3 = vars bounded vs2 b1 in
 	vars bounded vs3 b2
     | RRec (loc,fk,idl,bl,tyl,bv) ->
-	let bounded' = Array.fold_right Idset.add idl bounded in 
-	let vars_fix i vs fid = 
-	  let vs1,bounded1 = 
-	    List.fold_left 
-	      (fun (vs,bounded) (na,k,bbd,bty) -> 
-		 let vs' = vars_option bounded vs bbd in 
+	let bounded' = Array.fold_right Idset.add idl bounded in
+	let vars_fix i vs fid =
+	  let vs1,bounded1 =
+	    List.fold_left
+	      (fun (vs,bounded) (na,k,bbd,bty) ->
+		 let vs' = vars_option bounded vs bbd in
 		 let vs'' = vars bounded vs' bty in
-		 let bounded' = add_name_to_ids bounded na in 
+		 let bounded' = add_name_to_ids bounded na in
 		 (vs'',bounded')
 	      )
 	      (vs,bounded')
 	      bl.(i)
 	  in
-	  let vs2 = vars bounded1 vs1 tyl.(i) in 
+	  let vs2 = vars bounded1 vs1 tyl.(i) in
 	  vars bounded1 vs2 bv.(i)
 	in
 	array_fold_left_i vars_fix vs idl
-    | RCast (loc,c,k) -> let v = vars bounded vs c in 
+    | RCast (loc,c,k) -> let v = vars bounded vs c in
 	(match k with CastConv (_,t) -> vars bounded v t | _ -> v)
     | (RSort _ | RHole _ | RRef _ | REvar _ | RPatVar _ | RDynamic _) -> vs
 
-  and vars_pattern bounded vs (loc,idl,p,c) = 
-    let bounded' = List.fold_right Idset.add idl bounded  in 
+  and vars_pattern bounded vs (loc,idl,p,c) =
+    let bounded' = List.fold_right Idset.add idl bounded  in
     vars bounded' vs c
 
   and vars_option bounded vs = function None -> vs | Some p -> vars bounded vs p
 
-  and vars_return_type bounded vs (na,tyopt) = 
-    let bounded' = add_name_to_ids bounded na in 
+  and vars_return_type bounded vs (na,tyopt) =
+    let bounded' = add_name_to_ids bounded na in
     vars_option bounded' vs tyopt
-  in 
-  fun rt -> 
-    let vs = vars Idset.empty Idset.empty rt in 
+  in
+  fun rt ->
+    let vs = vars Idset.empty Idset.empty rt in
     Idset.elements vs
 
 
diff --git a/pretyping/rawterm.mli b/pretyping/rawterm.mli
index 6bb4eceb3..5cf227440 100644
--- a/pretyping/rawterm.mli
+++ b/pretyping/rawterm.mli
@@ -46,7 +46,7 @@ type quantified_hypothesis = AnonHyp of int | NamedHyp of identifier
 
 type 'a explicit_bindings = (loc * quantified_hypothesis * 'a) list
 
-type 'a bindings = 
+type 'a bindings =
   | ImplicitBindings of 'a list
   | ExplicitBindings of 'a explicit_bindings
   | NoBindings
@@ -57,7 +57,7 @@ type 'a cast_type =
   | CastConv of cast_kind * 'a
   | CastCoerce (* Cast to a base type (eg, an underlying inductive type) *)
 
-type rawconstr = 
+type rawconstr =
   | RRef of (loc * global_reference)
   | RVar of (loc * identifier)
   | REvar of loc * existential_key * rawconstr list option
@@ -67,7 +67,7 @@ type rawconstr =
   | RProd of loc * name * binding_kind * rawconstr * rawconstr
   | RLetIn of loc * name * rawconstr * rawconstr
   | RCases of loc * case_style * rawconstr option * tomatch_tuples * cases_clauses
-  | RLetTuple of loc * name list * (name * rawconstr option) * 
+  | RLetTuple of loc * name list * (name * rawconstr option) *
       rawconstr * rawconstr
   | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr
   | RRec of loc * fix_kind * identifier array * rawdecl list array *
@@ -100,7 +100,7 @@ val cases_predicate_names : tomatch_tuples -> name list
 
 (*i - if PRec (_, names, arities, bodies) is in env then arities are
    typed in env too and bodies are typed in env enriched by the
-   arities incrementally lifted 
+   arities incrementally lifted
 
   [On pourrait plutot mettre les arités aves le type qu'elles auront
    dans le contexte servant à typer les body ???]
@@ -112,7 +112,7 @@ i*)
 val map_rawconstr : (rawconstr -> rawconstr) -> rawconstr -> rawconstr
 
 (*i
-val map_rawconstr_with_binders_loc : loc -> 
+val map_rawconstr_with_binders_loc : loc ->
   (identifier -> 'a -> identifier * 'a) ->
   ('a -> rawconstr -> rawconstr) -> 'a -> rawconstr -> rawconstr
 i*)
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index c29895912..048ec92de 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -32,7 +32,7 @@ open Reductionops
    projection ou bien une fonction constante (associée à un LetIn) *)
 
 type struc_typ = {
-  s_CONST : constructor; 
+  s_CONST : constructor;
   s_EXPECTEDPARAM : int;
   s_PROJKIND : (name * bool) list;
   s_PROJ : constant option list }
@@ -45,19 +45,19 @@ let load_structure i (_,(ind,id,kl,projs)) =
   let struc =
     { s_CONST = id; s_EXPECTEDPARAM = n; s_PROJ = projs; s_PROJKIND = kl } in
   structure_table := Indmap.add ind struc !structure_table;
-  projection_table := 
+  projection_table :=
     List.fold_right (Option.fold_right (fun proj -> Cmap.add proj struc))
       projs !projection_table
 
 let cache_structure o =
   load_structure 1 o
 
-let subst_structure (_,subst,((kn,i),id,kl,projs as obj)) = 
+let subst_structure (_,subst,((kn,i),id,kl,projs as obj)) =
   let kn' = subst_kn subst kn in
   let projs' =
    (* invariant: struc.s_PROJ is an evaluable reference. Thus we can take *)
    (* the first component of subst_con.                                   *)
-   list_smartmap 
+   list_smartmap
      (Option.smartmap (fun kn -> fst (subst_con subst kn)))
     projs
   in
@@ -65,7 +65,7 @@ let subst_structure (_,subst,((kn,i),id,kl,projs as obj)) =
     if projs' == projs && kn' == kn && id' == id then obj else
       ((kn',i),id',kl,projs')
 
-let discharge_constructor (ind, n) = 
+let discharge_constructor (ind, n) =
   (Lib.discharge_inductive ind, n)
 
 let discharge_structure (_,(ind,id,kl,projs)) =
@@ -73,7 +73,7 @@ let discharge_structure (_,(ind,id,kl,projs)) =
         List.map (Option.map Lib.discharge_con) projs)
 
 let (inStruc,outStruc) =
-  declare_object {(default_object "STRUCTURE") with 
+  declare_object {(default_object "STRUCTURE") with
     cache_function = cache_structure;
     load_function = load_structure;
     subst_function = subst_structure;
@@ -81,7 +81,7 @@ let (inStruc,outStruc) =
     discharge_function = discharge_structure;
     export_function = (function x -> Some x) }
 
-let declare_structure (s,c,kl,pl) = 
+let declare_structure (s,c,kl,pl) =
   Lib.add_anonymous_leaf (inStruc (s,c,kl,pl))
 
 let lookup_structure indsp = Indmap.find indsp !structure_table
@@ -99,21 +99,21 @@ let find_projection = function
 (* Management of a field store : each field + argument of the inferred
  * records are stored in a discrimination tree *)
 
-let subst_id s (gr,ev,evm) = 
+let subst_id s (gr,ev,evm) =
   (fst(subst_global s gr),ev,Evd.subst_evar_map s evm)
 
-module MethodsDnet : Term_dnet.S 
+module MethodsDnet : Term_dnet.S
   with type ident = global_reference * Evd.evar * Evd.evar_map
   = Term_dnet.Make
-  (struct 
+  (struct
      type t = global_reference * Evd.evar * Evd.evar_map
      let compare = Pervasives.compare
      let subst = subst_id
      let constr_of (_,ev,evm) = Evd.evar_concl (Evd.find evm ev)
-   end) 
-  (struct 
-     let reduce c = Reductionops.head_unfold_under_prod 
-       Names.full_transparent_state (Global.env()) Evd.empty c 
+   end)
+  (struct
+     let reduce c = Reductionops.head_unfold_under_prod
+       Names.full_transparent_state (Global.env()) Evd.empty c
      let direction = true
    end)
 
@@ -121,7 +121,7 @@ let meth_dnet = ref MethodsDnet.empty
 
 open Summary
 
-let _ = 
+let _ =
   declare_summary "record-methods-state"
     { freeze_function = (fun () -> !meth_dnet);
       unfreeze_function = (fun m -> meth_dnet := m);
@@ -132,14 +132,14 @@ open Libobject
 let load_method (_,(ty,id)) =
   meth_dnet := MethodsDnet.add ty id !meth_dnet
 
-let (in_method,out_method) = 
+let (in_method,out_method) =
   declare_object
     { (default_object "RECMETHODS") with
 	load_function = (fun _ -> load_method);
 	cache_function = load_method;
 	subst_function = (fun (_,s,(ty,id)) -> Mod_subst.subst_mps s ty,subst_id s id);
 	export_function = (fun x -> Some x);
-	classify_function = (fun x -> Substitute x) 
+	classify_function = (fun x -> Substitute x)
     }
 
 let methods_matching c = MethodsDnet.search_pattern !meth_dnet c
@@ -188,7 +188,7 @@ type cs_pattern =
 
 let object_table = ref (Refmap.empty : (cs_pattern * obj_typ) list Refmap.t)
 
-let canonical_projections () = 
+let canonical_projections () =
   Refmap.fold (fun x -> List.fold_right (fun (y,c) acc -> ((x,y),c)::acc))
     !object_table []
 
@@ -198,19 +198,19 @@ let keep_true_projections projs kinds =
 
 let cs_pattern_of_constr t =
   match kind_of_term t with
-      App (f,vargs) -> 
-	begin 
+      App (f,vargs) ->
+	begin
 	  try  Const_cs (global_of_constr f) , -1, Array.to_list vargs with
-	      _ -> raise Not_found 
-	end 
+	      _ -> raise Not_found
+	end
     | Rel n -> Default_cs, pred n, []
     | Prod (_,a,b) when not (dependent (mkRel 1) b) -> Prod_cs, -1, [a;pop b]
     | Sort s -> Sort_cs (family_of_sort s), -1, []
-    | _ -> 
-	begin 
+    | _ ->
+	begin
 	  try  Const_cs (global_of_constr t) , -1, [] with
-	      _ -> raise Not_found 
-	end 
+	      _ -> raise Not_found
+	end
 
 (* Intended to always succeed *)
 let compute_canonical_projections (con,ind) =
@@ -219,7 +219,7 @@ let compute_canonical_projections (con,ind) =
   let lt,t = Reductionops.splay_lam (Global.env()) Evd.empty c in
   let lt = List.rev (List.map snd lt) in
   let args = snd (decompose_app t) in
-  let { s_EXPECTEDPARAM = p; s_PROJ = lpj; s_PROJKIND = kl } = 
+  let { s_EXPECTEDPARAM = p; s_PROJ = lpj; s_PROJKIND = kl } =
     lookup_structure ind in
   let params, projs = list_chop p args in
   let lpj = keep_true_projections lpj kl in
@@ -230,16 +230,16 @@ let compute_canonical_projections (con,ind) =
 	 match spopt with
            | Some proji_sp ->
 	       begin
-		 try 
+		 try
 		   let patt, n , args = cs_pattern_of_constr t in
 		     ((ConstRef proji_sp, patt, n, args) :: l)
-		 with Not_found -> l 
+		 with Not_found -> l
 	       end
 	   | _ -> l)
       [] lps in
   List.map (fun (refi,c,inj,argj) ->
     (refi,c),
-    {o_DEF=v; o_INJ=inj; o_TABS=lt; 
+    {o_DEF=v; o_INJ=inj; o_TABS=lt;
      o_TPARAMS=params; o_NPARAMS=List.length params; o_TCOMPS=argj})
     comp
 
@@ -265,7 +265,7 @@ let discharge_canonical_structure (_,(cst,ind)) =
   Some (Lib.discharge_con cst,Lib.discharge_inductive ind)
 
 let (inCanonStruc,outCanonStruct) =
-  declare_object {(default_object "CANONICAL-STRUCTURE") with 
+  declare_object {(default_object "CANONICAL-STRUCTURE") with
     open_function = open_canonical_structure;
     cache_function = cache_canonical_structure;
     subst_function = subst_canonical_structure;
@@ -309,7 +309,7 @@ let lookup_canonical_conversion (proj,pat) =
   List.assoc pat (Refmap.find proj !object_table)
 
 let is_open_canonical_projection sigma (c,args) =
-  try 
+  try
     let l = Refmap.find (global_of_constr c) !object_table in
     let n = (snd (List.hd l)).o_NPARAMS in
     try isEvar_or_Meta (whd_evar sigma (List.nth args n)) with Failure _ -> false
@@ -318,7 +318,7 @@ let is_open_canonical_projection sigma (c,args) =
 let freeze () =
   !structure_table, !projection_table, !object_table
 
-let unfreeze (s,p,o) = 
+let unfreeze (s,p,o) =
   structure_table := s; projection_table := p; object_table := o
 
 let init () =
@@ -327,7 +327,7 @@ let init () =
 
 let _ = init()
 
-let _ = 
+let _ =
   Summary.declare_summary "objdefs"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli
index 4d28ee55b..5d3180ff7 100755
--- a/pretyping/recordops.mli
+++ b/pretyping/recordops.mli
@@ -22,12 +22,12 @@ open Library
    constructor (the name of which defaults to Build_S) *)
 
 type struc_typ = {
-  s_CONST : constructor; 
+  s_CONST : constructor;
   s_EXPECTEDPARAM : int;
   s_PROJKIND : (name * bool) list;
   s_PROJ : constant option list }
 
-val declare_structure : 
+val declare_structure :
   inductive * constructor * (name * bool) list * constant option list -> unit
 
 (* [lookup_projections isp] returns the projections associated to the
@@ -46,8 +46,8 @@ val find_projection : global_reference -> struc_typ
 val declare_method :
   global_reference -> Evd.evar -> Evd.evar_map -> unit
   (* and here is how to search for methods matched by a given term: *)
-val methods_matching : constr -> 
-  ((global_reference*Evd.evar*Evd.evar_map) * 
+val methods_matching : constr ->
+  ((global_reference*Evd.evar*Evd.evar_map) *
      (constr*existential_key)*Termops.subst) list
 
 (*s A canonical structure declares "canonical" conversion hints between *)
@@ -56,7 +56,7 @@ val methods_matching : constr ->
 
 type cs_pattern =
     Const_cs of global_reference
-  | Prod_cs 
+  | Prod_cs
   | Sort_cs of sorts_family
   | Default_cs
 
@@ -69,10 +69,10 @@ type obj_typ = {
   o_TCOMPS : constr list } (* ordered *)
 
 val cs_pattern_of_constr : constr -> cs_pattern * int * constr list
- 
+
 val lookup_canonical_conversion : (global_reference * cs_pattern) -> obj_typ
 val declare_canonical_structure : global_reference -> unit
 val is_open_canonical_projection :
   Evd.evar_map -> (constr * constr list) -> bool
-val canonical_projections : unit -> 
+val canonical_projections : unit ->
   ((global_reference * cs_pattern) * obj_typ) list
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 1bff68cbf..bbc0ceae7 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -25,7 +25,7 @@ exception Elimconst
 
 
 (**********************************************************************)
-(* The type of (machine) stacks (= lambda-bar-calculus' contexts)     *) 
+(* The type of (machine) stacks (= lambda-bar-calculus' contexts)     *)
 
 type 'a stack_member =
   | Zapp of 'a list
@@ -80,12 +80,12 @@ let rec list_of_stack = function
 let rec app_stack = function
   | f, [] -> f
   | f, (Zapp [] :: s) -> app_stack (f, s)
-  | f, (Zapp args :: s) -> 
+  | f, (Zapp args :: s) ->
       app_stack (applist (f, args), s)
   | _ -> assert false
 let rec stack_assign s p c = match s with
   | Zapp args :: s ->
-      let q = List.length args in 
+      let q = List.length args in
       if p >= q then
 	Zapp args :: stack_assign s (p-q) c
       else
@@ -109,20 +109,20 @@ let rec stack_nth s p = match s with
   | _ -> raise Not_found
 
 (**************************************************************)
-(* The type of (machine) states (= lambda-bar-calculus' cuts) *) 
+(* The type of (machine) states (= lambda-bar-calculus' cuts) *)
 type state = constr * constr stack
 
 type  contextual_reduction_function = env ->  evar_map -> constr -> constr
 type  reduction_function =  contextual_reduction_function
 type local_reduction_function = evar_map -> constr -> constr
 
-type  contextual_stack_reduction_function = 
+type  contextual_stack_reduction_function =
     env ->  evar_map -> constr -> constr * constr list
 type  stack_reduction_function =  contextual_stack_reduction_function
 type local_stack_reduction_function =
     evar_map -> constr -> constr * constr list
 
-type  contextual_state_reduction_function = 
+type  contextual_state_reduction_function =
     env ->  evar_map -> state -> state
 type  state_reduction_function =  contextual_state_reduction_function
 type local_state_reduction_function = evar_map -> state -> state
@@ -159,16 +159,16 @@ let stack_reduction_of_reduction red_fun env sigma s =
   let t = red_fun env sigma (app_stack s) in
   whd_stack t
 
-let strong whdfun env sigma t = 
+let strong whdfun env sigma t =
   let rec strongrec env t =
     map_constr_with_full_binders push_rel strongrec env (whdfun env sigma t) in
   strongrec env t
 
-let local_strong whdfun sigma = 
+let local_strong whdfun sigma =
   let rec strongrec t = map_constr strongrec (whdfun sigma t) in
   strongrec
 
-let rec strong_prodspine redfun sigma c = 
+let rec strong_prodspine redfun sigma c =
   let x = redfun sigma c in
   match kind_of_term x with
     | Prod (na,a,b) -> mkProd (na,a,strong_prodspine redfun sigma b)
@@ -203,7 +203,7 @@ module RedFlags = (struct
   type flags = int
   let fbeta = 1
   let fdelta = 2
-  let feta = 8 
+  let feta = 8
   let fiota = 16
   let fzeta = 32
   let mkflags = List.fold_left (lor) 0
@@ -282,7 +282,7 @@ let contract_fix ((recindices,bodynum),(types,names,bodies as typedbodies)) =
 let fix_recarg ((recindices,bodynum),_) stack =
   assert (0 <= bodynum & bodynum < Array.length recindices);
   let recargnum = Array.get recindices bodynum in
-  try 
+  try
     Some (recargnum, stack_nth stack recargnum)
   with Not_found ->
     None
@@ -303,12 +303,12 @@ let reduce_fix whdfun sigma fix stack =
 
 (* Y avait un commentaire pour whd_betadeltaiota :
 
-   NB : Cette fonction alloue peu c'est l'appel 
+   NB : Cette fonction alloue peu c'est l'appel
      ``let (c,cargs) = whfun (recarg, empty_stack)''
                               -------------------
    qui coute cher *)
 
-let rec whd_state_gen flags env sigma = 
+let rec whd_state_gen flags env sigma =
   let rec whrec (x, stack as s) =
     match kind_of_term x with
       | Rel n when red_delta flags ->
@@ -361,19 +361,19 @@ let rec whd_state_gen flags env sigma =
             whrec (reduce_mind_case
                      {mP=p; mconstr=c; mcargs=list_of_stack cargs;
 		      mci=ci; mlf=lf}, stack)
-          else 
+          else
 	    (mkCase (ci, p, app_stack (c,cargs), lf), stack)
-            
+
       | Fix fix when red_iota flags ->
 	  (match reduce_fix (fun _ -> whrec) sigma fix stack with
              | Reduced s' -> whrec s'
 	     | NotReducible -> s)
 
       | x -> s
-  in 
+  in
   whrec
 
-let local_whd_state_gen flags sigma = 
+let local_whd_state_gen flags sigma =
   let rec whrec (x, stack as s) =
     match kind_of_term x with
       | LetIn (_,b,_,c) when red_zeta flags -> stacklam whrec [b] c stack
@@ -383,7 +383,7 @@ let local_whd_state_gen flags sigma =
           (match decomp_stack stack with
              | Some (a,m) when red_beta flags -> stacklam whrec [a] c m
              | None when red_eta flags ->
-                 (match kind_of_term (app_stack (whrec (c, empty_stack))) with 
+                 (match kind_of_term (app_stack (whrec (c, empty_stack))) with
                     | App (f,cl) ->
 			let napp = Array.length cl in
 			if napp > 0 then
@@ -404,9 +404,9 @@ let local_whd_state_gen flags sigma =
             whrec (reduce_mind_case
                      {mP=p; mconstr=c; mcargs=list_of_stack cargs;
 		      mci=ci; mlf=lf}, stack)
-          else 
+          else
 	    (mkCase (ci, p, app_stack (c,cargs), lf), stack)
-            
+
       | Fix fix when red_iota flags ->
 	  (match reduce_fix (fun _ ->whrec) sigma fix stack with
              | Reduced s' -> whrec s'
@@ -423,7 +423,7 @@ let local_whd_state_gen flags sigma =
             | None -> s)
 
       | x -> s
-  in 
+  in
   whrec
 
 
@@ -464,7 +464,7 @@ let whd_betadelta env =
 let whd_betadeltaeta_state e = whd_state_gen betadeltaeta e
 let whd_betadeltaeta_stack env =
   stack_red_of_state_red (whd_betadeltaeta_state env)
-let whd_betadeltaeta env = 
+let whd_betadeltaeta env =
   red_of_state_red (whd_betadeltaeta_state env)
 
 (* 3. Iota reduction Functions *)
@@ -480,19 +480,19 @@ let whd_betaiotazeta = red_of_state_red whd_betaiotazeta_state
 let whd_betadeltaiota_state e = whd_state_gen betadeltaiota e
 let whd_betadeltaiota_stack env =
   stack_red_of_state_red (whd_betadeltaiota_state env)
-let whd_betadeltaiota env = 
+let whd_betadeltaiota env =
   red_of_state_red (whd_betadeltaiota_state env)
 
 let whd_betadeltaiotaeta_state e = whd_state_gen betadeltaiotaeta e
 let whd_betadeltaiotaeta_stack env =
   stack_red_of_state_red (whd_betadeltaiotaeta_state env)
-let whd_betadeltaiotaeta env = 
+let whd_betadeltaiotaeta env =
   red_of_state_red (whd_betadeltaiotaeta_state env)
 
 let whd_betadeltaiota_nolet_state e = whd_state_gen betadeltaiota_nolet e
 let whd_betadeltaiota_nolet_stack env =
   stack_red_of_state_red (whd_betadeltaiota_nolet_state env)
-let whd_betadeltaiota_nolet env = 
+let whd_betadeltaiota_nolet env =
   red_of_state_red (whd_betadeltaiota_nolet_state env)
 
 (* 3. Eta reduction Functions *)
@@ -530,53 +530,53 @@ let nf_betadeltaiota env sigma =
   clos_norm_flags Closure.betadeltaiota env sigma
 
 
-(* Attention reduire un beta-redexe avec un argument qui n'est pas 
+(* Attention reduire un beta-redexe avec un argument qui n'est pas
    une variable, peut changer enormement le temps de conversion lors
    du type checking :
      (fun x => x + x) M
 *)
-let rec whd_betaiota_preserving_vm_cast env sigma t = 	 
-   let rec stacklam_var subst t stack = 	 
-     match (decomp_stack stack,kind_of_term t) with 	 
-     | Some (h,stacktl), Lambda (_,_,c) -> 	 
-         begin match kind_of_term h with 	 
-         | Rel i when not (evaluable_rel i env) -> 	 
-             stacklam_var (h::subst) c stacktl 	 
-         | Var id when  not (evaluable_named id env)-> 	 
-             stacklam_var (h::subst) c stacktl 	 
-         | _ -> whrec (substl subst t, stack) 	 
-         end 	 
-     | _ -> whrec (substl subst t, stack) 	 
-   and whrec (x, stack as s) = 	 
-     match kind_of_term x with 	 
-       | Evar ev -> 	 
-           (match safe_evar_value sigma ev with 	 
-              | Some body -> whrec (body, stack) 	 
-              | None -> s) 	 
-       | Cast (c,VMcast,t) -> 	 
-           let c = app_stack (whrec (c,empty_stack)) in 	 
-           let t = app_stack (whrec (t,empty_stack)) in 	 
-           (mkCast(c,VMcast,t),stack) 	 
-       | Cast (c,DEFAULTcast,_) -> 	 
-           whrec (c, stack) 	 
-       | App (f,cl)  -> whrec (f, append_stack cl stack) 	 
-       | Lambda (na,t,c) -> 	 
-           (match decomp_stack stack with 	 
-            | Some (a,m) -> stacklam_var [a] c m 	 
-            | _ -> s) 	 
-       | Case (ci,p,d,lf) -> 	 
-           let (c,cargs) = whrec (d, empty_stack) in 	 
-           if reducible_mind_case c then 	 
-             whrec (reduce_mind_case 	 
-                      {mP=p; mconstr=c; mcargs=list_of_stack cargs; 	 
-                       mci=ci; mlf=lf}, stack) 	 
-           else 	 
-             (mkCase (ci, p, app_stack (c,cargs), lf), stack) 	 
-       | x -> s 	 
-   in 	 
+let rec whd_betaiota_preserving_vm_cast env sigma t =
+   let rec stacklam_var subst t stack =
+     match (decomp_stack stack,kind_of_term t) with
+     | Some (h,stacktl), Lambda (_,_,c) ->
+         begin match kind_of_term h with
+         | Rel i when not (evaluable_rel i env) ->
+             stacklam_var (h::subst) c stacktl
+         | Var id when  not (evaluable_named id env)->
+             stacklam_var (h::subst) c stacktl
+         | _ -> whrec (substl subst t, stack)
+         end
+     | _ -> whrec (substl subst t, stack)
+   and whrec (x, stack as s) =
+     match kind_of_term x with
+       | Evar ev ->
+           (match safe_evar_value sigma ev with
+              | Some body -> whrec (body, stack)
+              | None -> s)
+       | Cast (c,VMcast,t) ->
+           let c = app_stack (whrec (c,empty_stack)) in
+           let t = app_stack (whrec (t,empty_stack)) in
+           (mkCast(c,VMcast,t),stack)
+       | Cast (c,DEFAULTcast,_) ->
+           whrec (c, stack)
+       | App (f,cl)  -> whrec (f, append_stack cl stack)
+       | Lambda (na,t,c) ->
+           (match decomp_stack stack with
+            | Some (a,m) -> stacklam_var [a] c m
+            | _ -> s)
+       | Case (ci,p,d,lf) ->
+           let (c,cargs) = whrec (d, empty_stack) in
+           if reducible_mind_case c then
+             whrec (reduce_mind_case
+                      {mP=p; mconstr=c; mcargs=list_of_stack cargs;
+                       mci=ci; mlf=lf}, stack)
+           else
+             (mkCase (ci, p, app_stack (c,cargs), lf), stack)
+       | x -> s
+   in
    app_stack (whrec (t,empty_stack))
 
-let nf_betaiota_preserving_vm_cast = 
+let nf_betaiota_preserving_vm_cast =
   strong whd_betaiota_preserving_vm_cast
 
 (* lazy weak head reduction functions *)
@@ -638,12 +638,12 @@ let whd_meta metasubst c = match kind_of_term c with
 
 (* Try to replace all metas. Does not replace metas in the metas' values
  * Differs from (strong whd_meta). *)
-let plain_instance s c = 
+let plain_instance s c =
   let rec irec n u = match kind_of_term u with
     | Meta p -> (try lift n (List.assoc p s) with Not_found -> u)
     | App (f,l) when isCast f ->
         let (f,_,t) = destCast f in
-        let l' = Array.map (irec n) l in 
+        let l' = Array.map (irec n) l in
         (match kind_of_term f with
         | Meta p ->
 	    (* Don't flatten application nodes: this is used to extract a
@@ -651,21 +651,21 @@ let plain_instance s c =
                of the proof-tree *)
 	    (try let g = List.assoc p s in
 	    match kind_of_term g with
-            | App _ -> 
+            | App _ ->
                 let h = id_of_string "H" in
                 mkLetIn (Name h,g,t,mkApp(mkRel 1,Array.map (lift 1) l'))
             | _ -> mkApp (g,l')
 	    with Not_found -> mkApp (f,l'))
-        | _ -> mkApp (irec n f,l'))	
+        | _ -> mkApp (irec n f,l'))
     | Cast (m,_,_) when isMeta m ->
 	(try lift n (List.assoc (destMeta m) s) with Not_found -> u)
     | _ ->
 	map_constr_with_binders succ irec n u
-  in 
+  in
   if s = [] then c else irec 0 c
 
 (* [instance] is used for [res_pf]; the call to [local_strong whd_betaiota]
-   has (unfortunately) different subtle side effects: 
+   has (unfortunately) different subtle side effects:
 
    - ** Order of subgoals **
      If the lemma is a case analysis with parameters, it will move the
@@ -682,7 +682,7 @@ let plain_instance s c =
      been contracted). A goal to rewrite may then fail or succeed
      differently.
 
-   - ** Naming of hypotheses ** 
+   - ** Naming of hypotheses **
      If a lemma is a function of the form "fun H:(forall a:A, P a)
      => .. F H .." where the expected type of H is "forall b:A, P b",
      then, without reduction, the application of the lemma will
@@ -713,24 +713,24 @@ let hnf_prod_app env sigma t n =
     | Prod (_,_,b) -> subst1 n b
     | _ -> anomaly "hnf_prod_app: Need a product"
 
-let hnf_prod_appvect env sigma t nl = 
+let hnf_prod_appvect env sigma t nl =
   Array.fold_left (hnf_prod_app env sigma) t nl
 
-let hnf_prod_applist env sigma t nl = 
+let hnf_prod_applist env sigma t nl =
   List.fold_left (hnf_prod_app env sigma) t nl
-				    
+
 let hnf_lam_app env sigma t n =
   match kind_of_term (whd_betadeltaiota env sigma t) with
     | Lambda (_,_,b) -> subst1 n b
     | _ -> anomaly "hnf_lam_app: Need an abstraction"
 
-let hnf_lam_appvect env sigma t nl = 
+let hnf_lam_appvect env sigma t nl =
   Array.fold_left (hnf_lam_app env sigma) t nl
 
-let hnf_lam_applist env sigma t nl = 
+let hnf_lam_applist env sigma t nl =
   List.fold_left (hnf_lam_app env sigma) t nl
 
-let splay_prod env sigma = 
+let splay_prod env sigma =
   let rec decrec env m c =
     let t = whd_betadeltaiota env sigma c in
     match kind_of_term t with
@@ -738,10 +738,10 @@ let splay_prod env sigma =
 	  decrec (push_rel (n,None,a) env)
 	    ((n,a)::m) c0
       | _ -> m,t
-  in 
+  in
   decrec env []
 
-let splay_lam env sigma = 
+let splay_lam env sigma =
   let rec decrec env m c =
     let t = whd_betadeltaiota env sigma c in
     match kind_of_term t with
@@ -749,10 +749,10 @@ let splay_lam env sigma =
 	  decrec (push_rel (n,None,a) env)
 	    ((n,a)::m) c0
       | _ -> m,t
-  in 
+  in
   decrec env []
 
-let splay_prod_assum env sigma = 
+let splay_prod_assum env sigma =
   let rec prodec_rec env l c =
     let t = whd_betadeltaiota_nolet env sigma c in
     match kind_of_term t with
@@ -775,24 +775,24 @@ let splay_arity env sigma c =
 
 let sort_of_arity env c = snd (splay_arity env Evd.empty c)
 
-let splay_prod_n env sigma n = 
-  let rec decrec env m ln c = if m = 0 then (ln,c) else 
+let splay_prod_n env sigma n =
+  let rec decrec env m ln c = if m = 0 then (ln,c) else
     match kind_of_term (whd_betadeltaiota env sigma c) with
       | Prod (n,a,c0) ->
 	  decrec (push_rel (n,None,a) env)
 	    (m-1) (add_rel_decl (n,None,a) ln) c0
       | _                      -> invalid_arg "splay_prod_n"
-  in 
+  in
   decrec env n empty_rel_context
 
-let splay_lam_n env sigma n = 
-  let rec decrec env m ln c = if m = 0 then (ln,c) else 
+let splay_lam_n env sigma n =
+  let rec decrec env m ln c = if m = 0 then (ln,c) else
     match kind_of_term (whd_betadeltaiota env sigma c) with
       | Lambda (n,a,c0) ->
 	  decrec (push_rel (n,None,a) env)
 	    (m-1) (add_rel_decl (n,None,a) ln) c0
       | _                      -> invalid_arg "splay_lam_n"
-  in 
+  in
   decrec env n empty_rel_context
 
 exception NotASort
@@ -803,22 +803,22 @@ let decomp_sort env sigma t =
   | _ -> raise NotASort
 
 let is_sort env sigma arity =
-  try let _ = decomp_sort env sigma arity in true 
+  try let _ = decomp_sort env sigma arity in true
   with NotASort -> false
 
 (* reduction to head-normal-form allowing delta/zeta only in argument
    of case/fix (heuristic used by evar_conv) *)
 
 let whd_betaiota_deltazeta_for_iota_state env sigma s =
-  let rec whrec s = 
+  let rec whrec s =
     let (t, stack as s) = whd_betaiota_state sigma s in
     match kind_of_term t with
     | Case (ci,p,d,lf) ->
         let (cr,crargs) = whd_betadeltaiota_stack env sigma d in
         let rslt = mkCase (ci, p, applist (cr,crargs), lf) in
-        if reducible_mind_case cr then 
+        if reducible_mind_case cr then
 	  whrec (rslt, stack)
-        else 
+        else
 	  s
     | Fix fix ->
 	  (match reduce_fix (whd_betadeltaiota_state env) sigma fix stack with
@@ -832,15 +832,15 @@ let whd_betaiota_deltazeta_for_iota_state env sigma s =
  * Used in Correctness.
  * Added by JCF, 29/1/98. *)
 
-let whd_programs_stack env sigma = 
+let whd_programs_stack env sigma =
   let rec whrec (x, stack as s) =
     match kind_of_term x with
       | App (f,cl) ->
 	  let n = Array.length cl - 1 in
 	  let c = cl.(n) in
-	  if occur_existential c then 
-	    s 
-	  else 
+	  if occur_existential c then
+	    s
+	  else
 	    whrec (mkApp (f, Array.sub cl 0 n), append_stack [|c|] stack)
       | LetIn (_,b,_,c) ->
 	  if occur_existential b then
@@ -867,7 +867,7 @@ let whd_programs_stack env sigma =
              | Reduced s' -> whrec s'
 	     | NotReducible -> s)
       | _ -> s
-  in 
+  in
   whrec
 
 let whd_programs env sigma x =
@@ -882,7 +882,7 @@ let find_conclusion env sigma =
       | Prod (x,t,c0) -> decrec (push_rel (x,None,t) env) c0
       | Lambda (x,t,c0) -> decrec (push_rel (x,None,t) env) c0
       | t -> t
-  in 
+  in
   decrec env
 
 let is_arity env sigma c =
@@ -893,29 +893,29 @@ let is_arity env sigma c =
 (*************************************)
 (* Metas *)
 
-let meta_value evd mv = 
+let meta_value evd mv =
   let rec valrec mv =
     match meta_opt_fvalue evd mv with
-    | Some (b,_) -> 
+    | Some (b,_) ->
       instance
         (List.map (fun mv' -> (mv',valrec mv')) (Metaset.elements b.freemetas))
         b.rebus
     | None -> mkMeta mv
-  in 
+  in
   valrec mv
 
 let meta_instance env b =
   let c_sigma =
-    List.map 
+    List.map
       (fun mv -> (mv,meta_value env mv)) (Metaset.elements b.freemetas)
-  in 
+  in
   if c_sigma = [] then b.rebus else instance c_sigma b.rebus
 
 let nf_meta env c = meta_instance env (mk_freelisted c)
 
 (* Instantiate metas that create beta/iota redexes *)
 
-let meta_value evd mv = 
+let meta_value evd mv =
   let rec valrec mv =
     match meta_opt_fvalue evd mv with
     | Some (b,_) ->
@@ -923,14 +923,14 @@ let meta_value evd mv =
         (List.map (fun mv' -> (mv',valrec mv')) (Metaset.elements b.freemetas))
         b.rebus
     | None -> mkMeta mv
-  in 
+  in
   valrec mv
 
 let meta_reducible_instance evd b =
   let fm = Metaset.elements b.freemetas in
-  let metas = List.fold_left (fun l mv -> 
+  let metas = List.fold_left (fun l mv ->
     match (try meta_opt_fvalue evd mv with Not_found -> None) with
-    | Some (g,(_,s)) -> (mv,(g.rebus,s))::l 
+    | Some (g,(_,s)) -> (mv,(g.rebus,s))::l
     | None -> l) [] fm in
   let rec irec u =
     let u = whd_betaiota Evd.empty u in
@@ -959,21 +959,21 @@ let meta_reducible_instance evd b =
 	(try let g,s = List.assoc m metas in if s<>CoerceToType then irec g else u
 	 with Not_found -> u)
     | _ -> map_constr irec u
-  in 
+  in
   if fm = [] then (* nf_betaiota? *) b.rebus else irec b.rebus
 
 
-let head_unfold_under_prod ts env _ c = 
-  let unfold cst = 
+let head_unfold_under_prod ts env _ c =
+  let unfold cst =
     if Cpred.mem cst (snd ts) then
       match constant_opt_value env cst with
-	| Some c -> c 
+	| Some c -> c
 	| None -> mkConst cst
     else mkConst cst in
   let rec aux c =
     match kind_of_term c with
       | Prod (n,t,c) -> mkProd (n,aux t, aux c)
-      | _ -> 
+      | _ ->
 	  let (h,l) = decompose_app c in
 	  match kind_of_term h with
 	    | Const cst -> beta_applist (unfold cst,l)
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 535101d74..3c3190484 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -56,13 +56,13 @@ type contextual_reduction_function = env -> evar_map -> constr -> constr
 type reduction_function = contextual_reduction_function
 type local_reduction_function = evar_map -> constr -> constr
 
-type contextual_stack_reduction_function = 
+type contextual_stack_reduction_function =
     env -> evar_map -> constr -> constr * constr list
 type stack_reduction_function = contextual_stack_reduction_function
 type local_stack_reduction_function =
     evar_map -> constr -> constr * constr list
 
-type contextual_state_reduction_function = 
+type contextual_state_reduction_function =
     env -> evar_map -> state -> state
 type state_reduction_function = contextual_state_reduction_function
 type local_state_reduction_function = evar_map -> state -> state
@@ -79,15 +79,15 @@ val strong : reduction_function -> reduction_function
 val local_strong : local_reduction_function -> local_reduction_function
 val strong_prodspine : local_reduction_function -> local_reduction_function
 (*i
-val stack_reduction_of_reduction : 
+val stack_reduction_of_reduction :
   'a reduction_function -> 'a state_reduction_function
 i*)
-val stacklam : (state -> 'a) -> constr list -> constr -> constr stack -> 'a 
+val stacklam : (state -> 'a) -> constr list -> constr -> constr stack -> 'a
 
 (*s Generic Optimized Reduction Function using Closures *)
 
 val clos_norm_flags : Closure.RedFlags.reds -> reduction_function
-(* Same as [(strong whd_beta[delta][iota])], but much faster on big terms *) 
+(* Same as [(strong whd_beta[delta][iota])], but much faster on big terms *)
 val nf_beta : local_reduction_function
 val nf_betaiota : local_reduction_function
 val nf_betadeltaiota : reduction_function
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index b16508053..1e0649da6 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -81,7 +81,7 @@ let retype sigma =
     | Cast (c,_, t) -> t
     | Sort _ | Prod _ -> mkSort (sort_of env cstr)
 
-  and sort_of env t = 
+  and sort_of env t =
     match kind_of_term t with
     | Cast (c,_, s) when isSort s -> destSort s
     | Sort (Prop c) -> type1_sort
@@ -111,14 +111,14 @@ let retype sigma =
     | Cast (c,_, s) when isSort s -> family_of_sort (destSort s)
     | Sort (Prop c) -> InType
     | Sort (Type u) -> InType
-    | Prod (name,t,c2) -> 
+    | Prod (name,t,c2) ->
 	let s2 = sort_family_of (push_rel (name,None,t) env) c2 in
 	if Environ.engagement env <> Some ImpredicativeSet &&
 	   s2 = InSet & sort_family_of env t = InType then InType else s2
     | App(f,args) when isGlobalRef f ->
 	let t = type_of_global_reference_knowing_parameters env f args in
         family_of_sort (sort_of_atomic_type env sigma t args)
-    | App(f,args) -> 
+    | App(f,args) ->
 	family_of_sort (sort_of_atomic_type env sigma (type_of env f) args)
     | Lambda _ | Fix _ | Construct _ ->
         anomaly "sort_of: Not a type (1)"
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index 9b65494c1..8576d5baa 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -31,8 +31,8 @@ val get_assumption_of : env -> evar_map -> constr -> types
 (* Makes an unsafe judgment from a constr *)
 val get_judgment_of : env -> evar_map -> constr -> unsafe_judgment
 
-val type_of_global_reference_knowing_parameters : env -> evar_map -> constr -> 
+val type_of_global_reference_knowing_parameters : env -> evar_map -> constr ->
   constr array -> types
- 
+
 val type_of_global_reference_knowing_conclusion :
   env -> evar_map -> constr -> types -> types
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index fc790c672..51c00122b 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -25,7 +25,7 @@ open Rawterm
 
 (* Errors *)
 
-type reduction_tactic_error = 
+type reduction_tactic_error =
     InvalidAbstraction of env * constr * (env * Type_errors.type_error)
 
 exception ReductionTacticError of reduction_tactic_error
@@ -37,7 +37,7 @@ exception Redelimination
 
 let error_not_evaluable r =
   errorlabstrm "error_not_evaluable"
-    (str "Cannot coerce" ++ spc () ++ Nametab.pr_global_env Idset.empty r ++ 
+    (str "Cannot coerce" ++ spc () ++ Nametab.pr_global_env Idset.empty r ++
      spc () ++ str "to an evaluable reference.")
 
 let is_evaluable_const env cst =
@@ -112,7 +112,7 @@ let reference_value sigma env c =
 (* Reduction of constants hiding a fixpoint (e.g. for "simpl" tactic).  *)
 (* One reuses the name of the function after reduction of the fixpoint  *)
 
-type constant_evaluation = 
+type constant_evaluation =
   | EliminationFix of int * int * (int * (int * constr) list * int)
   | EliminationMutualFix of
       int * evaluable_reference *
@@ -136,7 +136,7 @@ let freeze () =
 let unfreeze ct =
   eval_table := ct
 
-let _ = 
+let _ =
   Summary.declare_summary "evaluation"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
@@ -147,9 +147,9 @@ let _ =
    either [yn:Tn]..[y1:T1](match yi with f1..fk end g1 ..gp)
 
    or     [yn:Tn]..[y1:T1](Fix(f|t) yi1..yip)
-          with yi1..yip distinct variables among the yi, not occurring in t 
+          with yi1..yip distinct variables among the yi, not occurring in t
 
-   In the second case, [check_fix_reversibility [T1;...;Tn] args fix] 
+   In the second case, [check_fix_reversibility [T1;...;Tn] args fix]
    checks that [args] is a subset of disjoint variables in y1..yn (a necessary
    condition for reversibility). It also returns the relevant
    information ([i1,Ti1;..;ip,Tip],n) in order to compute an
@@ -158,7 +158,7 @@ let _ =
    g := [xp:Tip']..[x1:Ti1'](f a1..an)
      == [xp:Tip']..[x1:Ti1'](Fix(f|t) yi1..yip)
 
-   with a_k:=y_k if k<>i_j, a_k:=args_k otherwise, and 
+   with a_k:=y_k if k<>i_j, a_k:=args_k otherwise, and
    Tij':=Tij[x1..xi(j-1) <- a1..ai(j-1)]
 
    Note that the types Tk, when no i_j=k, must not be dependent on
@@ -177,15 +177,15 @@ let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
              if
 	       array_for_all (noccurn k) tys
 	       && array_for_all (noccurn (k+nbfix)) bds
-	     then 
-	       (k, List.nth labs (k-1)) 
-	     else 
+	     then
+	       (k, List.nth labs (k-1))
+	     else
 	       raise Elimconst
-         | _ -> 
+         | _ ->
 	     raise Elimconst) args
   in
   let reversible_rels = List.map fst li in
-  if not (list_distinct reversible_rels) then 
+  if not (list_distinct reversible_rels) then
     raise Elimconst;
   list_iter_i (fun i t_i ->
     if not (List.mem_assoc (i+1) li) then
@@ -194,8 +194,8 @@ let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
     labs;
   let k = lv.(i) in
   if k < nargs then
-(*  Such an optimisation would need eta-expansion 
-      let p = destRel (List.nth args k) in 
+(*  Such an optimisation would need eta-expansion
+      let p = destRel (List.nth args k) in
       EliminationFix (n-p+1,(nbfix,li,n))
 *)
     EliminationFix (n,nargs,(nbfix,li,n))
@@ -206,7 +206,7 @@ let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
    components of a mutual fixpoint *)
 
 let invert_name labs l na0 env sigma ref = function
-  | Name id -> 
+  | Name id ->
       let minfxargs = List.length l in
       if na0 <> Name id then
 	let refi = match ref with
@@ -220,7 +220,7 @@ let invert_name labs l na0 env sigma ref = function
 	  | Some ref ->
 	      try match reference_opt_value sigma env ref with
 		| None -> None
-		| Some c -> 
+		| Some c ->
 		    let labs',ccl = decompose_lam c in
 		    let _, l' = whd_betalet_stack sigma ccl in
 		    let labs' = List.map snd labs' in
@@ -241,11 +241,11 @@ let compute_consteval_direct sigma env ref =
       | Lambda (id,t,g) when l=[] ->
 	  srec (push_rel (id,None,t) env) (n+1) (t::labs) g
       | Fix fix ->
-	  (try check_fix_reversibility labs l fix 
+	  (try check_fix_reversibility labs l fix
 	  with Elimconst -> NotAnElimination)
       | Case (_,_,d,_) when isRel d -> EliminationCases n
       | _ -> NotAnElimination
-  in 
+  in
   match reference_opt_value sigma env ref with
     | None -> NotAnElimination
     | Some c -> srec env 0 [] c
@@ -276,7 +276,7 @@ let compute_consteval_mutual_fix sigma env ref =
 	    | None -> anomaly "Should have been trapped by compute_direct"
 	    | Some c -> srec env (minarg-nargs) [] ref c)
       | _ -> (* Should not occur *) NotAnElimination
-  in 
+  in
   match reference_opt_value sigma env ref with
     | None -> (* Should not occur *) NotAnElimination
     | Some c -> srec env 0 [] ref c
@@ -286,9 +286,9 @@ let compute_consteval sigma env ref =
     | EliminationFix (_,_,(nbfix,_,_)) when nbfix <> 1 ->
 	compute_consteval_mutual_fix sigma env ref
     | elim -> elim
-	
+
 let reference_eval sigma env = function
-  | EvalConst cst as ref -> 
+  | EvalConst cst as ref ->
       (try
 	 Cmap.find cst !eval_table
        with Not_found -> begin
@@ -298,15 +298,15 @@ let reference_eval sigma env = function
        end)
   | ref -> compute_consteval sigma env ref
 
-let rev_firstn_liftn fn ln = 
-  let rec rfprec p res l = 
-    if p = 0 then 
-      res 
+let rev_firstn_liftn fn ln =
+  let rec rfprec p res l =
+    if p = 0 then
+      res
     else
       match l with
         | [] -> invalid_arg "Reduction.rev_firstn_liftn"
         | a::rest -> rfprec (p-1) ((lift ln a)::res) rest
-  in 
+  in
   rfprec fn []
 
 (* If f is bound to EliminationFix (n',infos), then n' is the minimal
@@ -323,7 +323,7 @@ let rev_firstn_liftn fn ln =
 
    s.t. (g u1 ... up) reduces to (Fix(..) u1 ... up)
 
-   This is made possible by setting 
+   This is made possible by setting
       a_k:=x_j    if k=i_j for some j
       a_k:=arg_k  otherwise
 
@@ -337,25 +337,25 @@ let make_elim_fun (names,(nbfix,lv,n)) largs =
   let p = List.length lv in
   let lyi = List.map fst lv in
   let la =
-    list_map_i (fun q aq -> 
-      (* k from the comment is q+1 *) 
+    list_map_i (fun q aq ->
+      (* k from the comment is q+1 *)
       try mkRel (p+1-(list_index (n-q) lyi))
       with Not_found -> aq)
-      0 (List.map (lift p) lu) 
-  in 
+      0 (List.map (lift p) lu)
+  in
   fun i ->
     match names.(i) with
       | None -> None
       | Some (minargs,ref) ->
           let body = applistc (mkEvalRef ref) la in
-          let g = 
+          let g =
             list_fold_left_i (fun q (* j = n+1-q *) c (ij,tij) ->
               let subst = List.map (lift (-q)) (list_firstn (n-ij) la) in
               let tij' = substl (List.rev subst) tij in
 	      mkLambda (x,tij',c)) 1 body (List.rev lv)
           in Some (minargs,g)
 
-(* [f] is convertible to [Fix(recindices,bodynum),bodyvect)]: 
+(* [f] is convertible to [Fix(recindices,bodynum),bodyvect)]:
    do so that the reduction uses this extra information *)
 
 let dummy = mkProp
@@ -453,7 +453,7 @@ let reduce_fix_use_function env sigma f whfun fix stack =
         let (recarg'hd,_ as recarg') =
 	  if isRel recarg then
 	    (* The recarg cannot be a local def, no worry about the right env *)
-	    (recarg, empty_stack) 
+	    (recarg, empty_stack)
 	  else
 	    whfun (recarg, empty_stack) in
         let stack' = stack_assign stack recargnum (app_stack recarg') in
@@ -471,7 +471,7 @@ let contract_cofix_use_function env sigma f
     (nf_beta sigma bodies.(bodynum))
 
 let reduce_mind_case_use_function func env sigma mia =
-  match kind_of_term mia.mconstr with 
+  match kind_of_term mia.mconstr with
     | Construct(ind_sp,i) ->
 	let real_cargs = list_skipn mia.mci.ci_npar mia.mcargs in
 	applist (mia.mlf.(i-1), real_cargs)
@@ -485,9 +485,9 @@ let reduce_mind_case_use_function func env sigma mia =
 	      else match names.(i) with
 		| Anonymous -> None
 		| Name id ->
-		    (* In case of a call to another component of a block of 
+		    (* In case of a call to another component of a block of
 		       mutual inductive, try to reuse the global name if
-		       the block was indeed initially built as a global 
+		       the block was indeed initially built as a global
 		       definition *)
 		    let kn = make_con mp dp (label_of_id id) in
 		    try match constant_opt_value env kn with
@@ -503,8 +503,8 @@ let reduce_mind_case_use_function func env sigma mia =
     | _ -> assert false
 
 let special_red_case env sigma whfun (ci, p, c, lf)  =
-  let rec redrec s = 
-    let (constr, cargs) = whfun s in 
+  let rec redrec s =
+    let (constr, cargs) = whfun s in
     if isEvalRef env constr then
       let ref = destEvalRef constr in
       match reference_opt_value sigma env ref with
@@ -521,9 +521,9 @@ let special_red_case env sigma whfun (ci, p, c, lf)  =
         reduce_mind_case
 	  {mP=p; mconstr=constr; mcargs=list_of_stack cargs;
 	  mci=ci; mlf=lf}
-      else 
+      else
 	raise Redelimination
-  in 
+  in
   redrec (c, empty_stack)
 
 (* [red_elim_const] contracts iota/fix/cofix redexes hidden behind
@@ -570,14 +570,14 @@ and whd_simpl_state env sigma s =
   let rec redrec (x, stack as s) =
     match kind_of_term x with
       | Lambda (na,t,c) ->
-          (match decomp_stack stack with 
+          (match decomp_stack stack with
              | None -> s
              | Some (a,rest) -> stacklam redrec [a] c rest)
       | LetIn (n,b,t,c) -> stacklam redrec [b] c stack
       | App (f,cl) -> redrec (f, append_stack cl stack)
       | Cast (c,_,_) -> redrec (c, stack)
       | Case (ci,p,c,lf) ->
-          (try 
+          (try
 	    redrec (special_red_case env sigma redrec (ci,p,c,lf), stack)
 	  with
 	      Redelimination -> s)
@@ -593,13 +593,13 @@ and whd_simpl_state env sigma s =
            with Redelimination ->
 	     s)
       | _ -> s
-  in 
+  in
   redrec s
 
 (* reduce until finding an applied constructor or fail *)
 
 and whd_construct_state env sigma s =
-  let (constr, cargs as s') = whd_simpl_state env sigma s in 
+  let (constr, cargs as s') = whd_simpl_state env sigma s in
   if reducible_mind_case constr then s'
   else if isEvalRef env constr then
     let ref = destEvalRef constr in
@@ -617,11 +617,11 @@ and whd_construct_state env sigma s =
    sequence of products; fails if no delta redex is around
 *)
 
-let try_red_product env sigma c = 
+let try_red_product env sigma c =
   let simpfun = clos_norm_flags betaiotazeta env sigma in
   let rec redrec env x =
     match kind_of_term x with
-      | App (f,l) -> 
+      | App (f,l) ->
           (match kind_of_term f with
              | Fix fix ->
                  let stack = append_stack l empty_stack in
@@ -636,7 +636,7 @@ let try_red_product env sigma c =
       | Prod (x,a,b) -> mkProd (x, a, redrec (push_rel (x,None,a) env) b)
       | LetIn (x,a,b,t) -> redrec env (subst1 a t)
       | Case (ci,p,d,lf) -> simpfun (mkCase (ci,p,redrec env d,lf))
-      | _ when isEvalRef env x -> 
+      | _ when isEvalRef env x ->
           (* TO DO: re-fold fixpoints after expansion *)
           (* to get true one-step reductions *)
           let ref = destEvalRef x in
@@ -646,17 +646,17 @@ let try_red_product env sigma c =
       | _ -> raise Redelimination
   in redrec env c
 
-let red_product env sigma c = 
+let red_product env sigma c =
   try try_red_product env sigma c
   with Redelimination -> error "Not reducible."
 
 (*
-(* This old version of hnf uses betadeltaiota instead of itself (resp 
+(* This old version of hnf uses betadeltaiota instead of itself (resp
    whd_construct_state) to reduce the argument of Case (resp Fix);
    The new version uses the "simpl" strategy instead. For instance,
 
    Variable n:nat.
-   Eval hnf in match (plus (S n) O) with S n => n | _ => O end.  
+   Eval hnf in match (plus (S n) O) with S n => n | _ => O end.
 
    returned
 
@@ -683,7 +683,7 @@ let whd_simpl_orelse_delta_but_fix_old env sigma c =
       | Case (ci,p,d,lf) ->
           (try
              redrec (special_red_case env sigma whd_all (ci,p,d,lf), stack)
-           with Redelimination -> 
+           with Redelimination ->
 	     s)
       | Fix fix ->
 	  (match reduce_fix whd_all fix stack with
@@ -696,7 +696,7 @@ let whd_simpl_orelse_delta_but_fix_old env sigma c =
            with Redelimination ->
              match reference_opt_value sigma env ref with
 	       | Some c ->
-		   (match kind_of_term ((strip_lam c)) with 
+		   (match kind_of_term ((strip_lam c)) with
                      | CoFix _ | Fix _ -> s
 		     | _ -> redrec (c, stack))
 	       | None -> s)
@@ -710,11 +710,11 @@ let whd_simpl_orelse_delta_but_fix_old env sigma c =
 
 let whd_simpl_orelse_delta_but_fix env sigma c =
   let rec redrec s =
-    let (constr, stack as s') = whd_simpl_state env sigma s in 
+    let (constr, stack as s') = whd_simpl_state env sigma s in
     if isEvalRef env constr then
       match reference_opt_value sigma env (destEvalRef constr) with
 	| Some c ->
-	    (match kind_of_term ((strip_lam c)) with 
+	    (match kind_of_term ((strip_lam c)) with
               | CoFix _ | Fix _ -> s'
 	      | _ -> redrec (c, stack))
 	| None -> s'
@@ -746,7 +746,7 @@ let contextually byhead ((nowhere_except_in,locs),c) f env sigma t =
     if nowhere_except_in & (!pos > maxocc) then t
     else
     if (not byhead & eq_constr c t) or (byhead & is_head c t) then
-      let ok = 
+      let ok =
 	if nowhere_except_in then List.mem !pos locs
 	else not (List.mem !pos locs) in
       incr pos;
@@ -780,7 +780,7 @@ let substlin env evalref n (nowhere_except_in,locs) c =
   let rec substrec () c =
     if nowhere_except_in & !pos > maxocc then c
     else if c = term then
-      let ok = 
+      let ok =
 	if nowhere_except_in then List.mem !pos locs
 	else not (List.mem !pos locs) in
       incr pos;
@@ -796,7 +796,7 @@ let substlin env evalref n (nowhere_except_in,locs) c =
 let string_of_evaluable_ref env = function
   | EvalVarRef id -> string_of_id id
   | EvalConstRef kn ->
-      string_of_qualid 
+      string_of_qualid
         (Nametab.shortest_qualid_of_global (vars_of_env env) (ConstRef kn))
 
 let unfold env sigma name =
@@ -813,14 +813,14 @@ let unfoldoccs env sigma ((nowhere_except_in,locs as plocs),name) c =
   if locs = [] then if nowhere_except_in then c else unfold env sigma name c
   else
     let (nbocc,uc) = substlin env name 1 plocs c in
-    if nbocc = 1 then 
+    if nbocc = 1 then
       error ((string_of_evaluable_ref env name)^" does not occur.");
     let rest = List.filter (fun o -> o >= nbocc) locs in
     if rest <> [] then error_invalid_occurrence rest;
     nf_betaiota sigma uc
 
 (* Unfold reduction tactic: *)
-let unfoldn loccname env sigma c = 
+let unfoldn loccname env sigma c =
   List.fold_left (fun c occname -> unfoldoccs env sigma occname c) c loccname
 
 (* Re-folding constants tactics: refold com in term c *)
@@ -863,9 +863,9 @@ let abstract_scheme env sigma (locc,a) c =
   let ta = Retyping.get_type_of env sigma a in
   let na = named_hd env ta Anonymous in
   if occur_meta ta then error "Cannot find a type for the generalisation.";
-  if occur_meta a then 
+  if occur_meta a then
     mkLambda (na,ta,c)
-  else 
+  else
     mkLambda (na,ta,subst_term_occ locc a c)
 
 let pattern_occs loccs_trm env sigma c =
@@ -881,7 +881,7 @@ let pattern_occs loccs_trm env sigma c =
 (* put t as t'=(x1:A1)..(xn:An)B with B an inductive definition of name name
    return name, B and t' *)
 
-let reduce_to_ind_gen allow_product env sigma t = 
+let reduce_to_ind_gen allow_product env sigma t =
   let rec elimrec env t l =
     let t = hnf_constr env sigma t in
     match kind_of_term (fst (decompose_app t)) with
@@ -909,7 +909,7 @@ let reduce_to_atomic_ind x = reduce_to_ind_gen false x
 
 exception NotStepReducible
 
-let one_step_reduce env sigma c = 
+let one_step_reduce env sigma c =
   let rec redrec (x, stack) =
     match kind_of_term x with
       | Lambda (n,t,c)  ->
@@ -938,7 +938,7 @@ let one_step_reduce env sigma c =
 	       | None -> raise NotStepReducible)
 
       | _ -> raise NotStepReducible
-  in 
+  in
   app_stack (redrec (c, empty_stack))
 
 let isIndRef = function IndRef _ -> true | _ -> false
@@ -947,34 +947,34 @@ let reduce_to_ref_gen allow_product env sigma ref t =
   if isIndRef ref then
     let (mind,t) = reduce_to_ind_gen allow_product env sigma t in
     if IndRef mind <> ref then
-      errorlabstrm "" (str "Cannot recognize a statement based on " ++ 
+      errorlabstrm "" (str "Cannot recognize a statement based on " ++
         Nametab.pr_global_env Idset.empty ref ++ str".")
     else
       t
   else
   (* lazily reduces to match the head of [t] with the expected [ref] *)
-  let rec elimrec env t l = 
+  let rec elimrec env t l =
     let c, _ = Reductionops.whd_stack sigma t in
     match kind_of_term c with
       | Prod (n,ty,t') ->
 	  if allow_product then
 	    elimrec (push_rel (n,None,t) env) t' ((n,None,ty)::l)
-	  else 
-	     errorlabstrm "" 
-	       (str "Cannot recognize an atomic statement based on " ++ 
+	  else
+	     errorlabstrm ""
+	       (str "Cannot recognize an atomic statement based on " ++
 	        Nametab.pr_global_env Idset.empty ref ++ str".")
       | _ ->
-	  try 
-	    if global_of_constr c = ref 
+	  try
+	    if global_of_constr c = ref
 	    then it_mkProd_or_LetIn t l
 	    else raise Not_found
 	  with Not_found ->
-          try 
-	    let t' = nf_betaiota sigma (one_step_reduce env sigma t) in 
+          try
+	    let t' = nf_betaiota sigma (one_step_reduce env sigma t) in
 	    elimrec env t' l
           with NotStepReducible ->
 	    errorlabstrm ""
-	      (str "Cannot recognize a statement based on " ++ 
+	      (str "Cannot recognize a statement based on " ++
 	       Nametab.pr_global_env Idset.empty ref ++ str".")
   in
   elimrec env t []
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index c29a3f335..26d62379a 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -19,7 +19,7 @@ open Rawterm
 open Termops
 (*i*)
 
-type reduction_tactic_error = 
+type reduction_tactic_error =
     InvalidAbstraction of env * constr * (env * Type_errors.type_error)
 
 exception ReductionTacticError of reduction_tactic_error
@@ -47,7 +47,7 @@ val red_product : reduction_function
 val try_red_product : reduction_function
 
 (* Simpl *)
-val simpl : reduction_function 
+val simpl : reduction_function
 
 (* Simpl only at the head *)
 val whd_simpl : reduction_function
@@ -57,7 +57,7 @@ val whd_simpl : reduction_function
 val hnf_constr : reduction_function
 
 (* Unfold *)
-val unfoldn : 
+val unfoldn :
   (occurrences * evaluable_global_reference) list ->  reduction_function
 
 (* Fold *)
diff --git a/pretyping/term_dnet.ml b/pretyping/term_dnet.ml
index 4c6c5e631..f47485780 100644
--- a/pretyping/term_dnet.ml
+++ b/pretyping/term_dnet.ml
@@ -20,9 +20,9 @@ open Pp (* debug *)
 
 
 (* Representation/approximation of terms to use in the dnet:
- * 
+ *
  * - no meta or evar (use ['a pattern] for that)
- * 
+ *
  * - [Rel]s and [Sort]s are not taken into account (that's why we need
  *   a second pass of linear filterin on the results - it's not a perfect
  *   term indexing structure)
@@ -52,7 +52,7 @@ struct
     | DNil
 
   type dconstr = dconstr t
-      
+
   (* debug *)
   let rec pr_dconstr f : 'a t -> std_ppcmds = function
     | DRel -> str "*"
@@ -64,7 +64,7 @@ struct
     | DCase (_,t1,t2,ta) -> str "case"
     | DFix _ -> str "fix"
     | DCoFix _ -> str "cofix"
-    | DCons ((t,dopt),tl) -> f t ++ (match dopt with 
+    | DCons ((t,dopt),tl) -> f t ++ (match dopt with
 	  Some t' -> str ":=" ++ f t'
 	| None -> str "") ++ spc() ++ str "::" ++ spc() ++ f tl
     | DNil -> str "[]"
@@ -116,10 +116,10 @@ struct
     then invalid_arg "fold2:compare" else
       match c1,c2 with
 	| (DRel, DRel | DNil, DNil | DSort, DSort | DRef _, DRef _) -> acc
-	| (DCtx (c1,t1), DCtx (c2,t2) 
+	| (DCtx (c1,t1), DCtx (c2,t2)
 	  | DApp (c1,t1), DApp (c2,t2)
 	  | DLambda (c1,t1), DLambda (c2,t2)) -> f (f acc c1 c2) t1 t2
-	| DCase (ci,p1,c1,bl1),DCase (_,p2,c2,bl2) -> 
+	| DCase (ci,p1,c1,bl1),DCase (_,p2,c2,bl2) ->
 	    array_fold_left2 f (f (f acc p1 p2) c1 c2) bl1 bl2
 	| DFix (ia,i,ta1,ca1), DFix (_,_,ta2,ca2) ->
 	    array_fold_left2 f (array_fold_left2 f acc ta1 ta2) ca1 ca2
@@ -129,7 +129,7 @@ struct
 	    f (Option.fold_left2 f (f acc t1 t2) topt1 topt2) u1 u2
 	| _ -> assert false
 
-  let map2 (f:'a -> 'b -> 'c) (c1:'a t) (c2:'b t) : 'c t = 
+  let map2 (f:'a -> 'b -> 'c) (c1:'a t) (c2:'b t) : 'c t =
     let head w = map (fun _ -> ()) w in
     if compare (head c1) (head c2) <> 0
     then invalid_arg "map2_t:compare" else
@@ -139,29 +139,29 @@ struct
 	| DCtx (c1,t1), DCtx (c2,t2) -> DCtx (f c1 c2, f t1 t2)
 	| DLambda (t1,c1), DLambda (t2,c2) -> DLambda (f t1 t2, f c1 c2)
 	| DApp (t1,u1), DApp (t2,u2) -> DApp (f t1 t2,f u1 u2)
-	| DCase (ci,p1,c1,bl1), DCase (_,p2,c2,bl2) -> 
+	| DCase (ci,p1,c1,bl1), DCase (_,p2,c2,bl2) ->
 	    DCase (ci, f p1 p2, f c1 c2, array_map2 f bl1 bl2)
 	| DFix (ia,i,ta1,ca1), DFix (_,_,ta2,ca2) ->
 	    DFix (ia,i,array_map2 f ta1 ta2,array_map2 f ca1 ca2)
 	| DCoFix (i,ta1,ca1), DCoFix (_,ta2,ca2) ->
 	    DCoFix (i,array_map2 f ta1 ta2,array_map2 f ca1 ca2)
-	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) -> 
+	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) ->
 	    DCons ((f t1 t2,Option.lift2 f topt1 topt2), f u1 u2)
 	| _ -> assert false
 
   let terminal = function
     | (DRel | DSort | DNil | DRef _) -> true
-    | _ -> false    
+    | _ -> false
 end
-      
+
 (*
  * Terms discrimination nets
  * Uses the general dnet datatype on DTerm.t
  * (here you can restart reading)
  *)
 
-(* 
- * Construction of the module 
+(*
+ * Construction of the module
  *)
 
 module type IDENT =
@@ -185,7 +185,7 @@ struct
 
   module TDnet : Dnet.S with type ident=Ident.t
 			and  type 'a structure = 'a DTerm.t
-			and  type meta = metavariable 
+			and  type meta = metavariable
     = Dnet.Make(DTerm)(Ident)
     (struct
        type t = metavariable
@@ -193,20 +193,20 @@ struct
      end)
 
   type t = TDnet.t
-      
+
   type ident = TDnet.ident
-      
+
   type 'a pattern = 'a TDnet.pattern
   type term_pattern = term_pattern DTerm.t pattern
-      
+
   type idset = TDnet.Idset.t
 
   type result = ident * (constr*existential_key) * Termops.subst
 
   open DTerm
   open TDnet
-  
-  let rec pat_of_constr c : term_pattern = 
+
+  let rec pat_of_constr c : term_pattern =
     match kind_of_term c with
       | Rel _          -> Term DRel
       | Sort _         -> Term DSort
@@ -216,46 +216,46 @@ struct
       | Construct c    -> Term (DRef (ConstructRef c))
       | Term.Meta _    -> assert false
       | Evar (i,_)     -> Meta i
-      | Case (ci,c1,c2,ca)     -> 
+      | Case (ci,c1,c2,ca)     ->
 	  Term(DCase(ci,pat_of_constr c1,pat_of_constr c2,Array.map pat_of_constr ca))
-      | Fix ((ia,i),(_,ta,ca)) -> 
+      | Fix ((ia,i),(_,ta,ca)) ->
 	  Term(DFix(ia,i,Array.map pat_of_constr ta, Array.map pat_of_constr ca))
-      | CoFix (i,(_,ta,ca))    -> 
+      | CoFix (i,(_,ta,ca))    ->
 	  Term(DCoFix(i,Array.map pat_of_constr ta,Array.map pat_of_constr ca))
       | Cast (c,_,_)   -> pat_of_constr c
       | Lambda (_,t,c) -> Term(DLambda (pat_of_constr t, pat_of_constr c))
-      | (Prod (_,_,_) | LetIn(_,_,_,_))   -> 
+      | (Prod (_,_,_) | LetIn(_,_,_,_))   ->
 	  let (ctx,c) = ctx_of_constr (Term DNil) c in Term (DCtx (ctx,c))
-      | App (f,ca)     -> 
+      | App (f,ca)     ->
 	  Array.fold_left (fun c a -> Term (DApp (c,a)))
 	    (pat_of_constr f) (Array.map pat_of_constr ca)
 
-  and ctx_of_constr ctx c : term_pattern * term_pattern = 
+  and ctx_of_constr ctx c : term_pattern * term_pattern =
     match kind_of_term c with
       | Prod (_,t,c)   -> ctx_of_constr (Term(DCons((pat_of_constr t,None),ctx))) c
       | LetIn(_,d,t,c) -> ctx_of_constr (Term(DCons((pat_of_constr t, Some (pat_of_constr d)),ctx))) c
       | _ -> ctx,pat_of_constr c
-	  
+
   let empty_ctx : term_pattern -> term_pattern = function
     | Meta _ as c -> c
     | Term (DCtx(_,_)) as c -> c
     | c -> Term (DCtx (Term DNil, c))
-	  
-  (* 
+
+  (*
    * Basic primitives
    *)
 
   let empty = TDnet.empty
-    
-  let subst s t = 
+
+  let subst s t =
     let sleaf id = Ident.subst s id in
     let snode = function
       | DTerm.DRef gr -> DTerm.DRef (fst (subst_global s gr))
       | n -> n in
     TDnet.map sleaf snode t
-      
+
   let union = TDnet.union
-    
+
   let add (c:constr) (id:Ident.t) (dn:t) =
     let c = Opt.reduce c in
     let c = empty_ctx (pat_of_constr c) in
@@ -264,11 +264,11 @@ struct
   let new_meta_no =
     let ctr = ref 0 in
     fun () -> decr ctr; !ctr
-      
+
   let new_meta_no = Evarutil.new_untyped_evar
 
   let neutral_meta = new_meta_no()
-    
+
   let new_meta () = Meta (new_meta_no())
   let new_evar () = mkEvar(new_meta_no(),[||])
 
@@ -292,19 +292,19 @@ struct
   let subst_evar i c = e_subst_evar i (fun _ -> c)
 
   (* debug *)
-  let rec pr_term_pattern p = 
-    (fun pr_t -> function 
+  let rec pr_term_pattern p =
+    (fun pr_t -> function
        | Term t -> pr_t t
        | Meta m -> str"["++Util.pr_int (Obj.magic m)++str"]"
     ) (pr_dconstr pr_term_pattern) p
 
-  let search_pat cpat dpat dn (up,plug) = 
+  let search_pat cpat dpat dn (up,plug) =
     let whole_c = subst_evar plug cpat up in
     TDnet.Idset.fold
-      (fun id acc -> 
+      (fun id acc ->
 	 let c_id = Opt.reduce (Ident.constr_of id) in
-	 let (ctx,wc) = 
-	   try Termops.align_prod_letin whole_c c_id 
+	 let (ctx,wc) =
+	   try Termops.align_prod_letin whole_c c_id
 	   with Invalid_argument _ -> [],c_id in
 	 let up = it_mkProd_or_LetIn up ctx in
 	 let wc,whole_c = if Opt.direction then whole_c,wc else wc,whole_c in
@@ -326,11 +326,11 @@ struct
   let fold_pattern_up f acc dpat cpat dn (up,plug) =
     fold_pattern_nonlin
       ( fun m dn acc ->
-	  f dn (subst_evar plug (e_subst_evar neutral_meta new_evar cpat) up, m) acc 
+	  f dn (subst_evar plug (e_subst_evar neutral_meta new_evar cpat) up, m) acc
       ) acc dpat dn
 
-  let possibly_under pat k dn (up,plug) = 
-    let rec aux fst dn (up,plug) acc = 
+  let possibly_under pat k dn (up,plug) =
+    let rec aux fst dn (up,plug) acc =
       let cpat = pat() in
       let dpat = pat_of_constr cpat in
       let dpat = if fst then empty_ctx dpat else dpat in
@@ -345,24 +345,24 @@ struct
    * High-level primitives describing specific search problems
    *)
 
-  let search_pattern dn pat = 
+  let search_pattern dn pat =
     let pat = Opt.reduce pat in
     search_pat pat (empty_ctx (pat_of_constr pat)) dn init
-    
+
   let search_concl dn pat =
     let pat = Opt.reduce pat in
     search_pat pat (under_prod (empty_ctx (pat_of_constr pat))) dn init
 
-  let search_eq_concl dn eq pat = 
+  let search_eq_concl dn eq pat =
     let pat = Opt.reduce pat in
     let eq_pat = eq_pat eq () in
     let eq_dpat = under_prod (empty_ctx (pat_of_constr eq_pat)) in
     snd (fold_pattern_up
-      (fun dn up acc -> 
+      (fun dn up acc ->
 	 search_pat pat (pat_of_constr pat) dn up @ acc
       ) [] eq_dpat eq_pat dn init)
-      
-   let search_head_concl dn pat = 
+
+   let search_head_concl dn pat =
     let pat = Opt.reduce pat in
     possibly_under app_pat (search_pat pat (pat_of_constr pat)) dn init
 
@@ -370,12 +370,12 @@ struct
 
   let map f dn = TDnet.map f (fun x -> x) dn
 end
-    
+
 module type S =
 sig
   type t
   type ident
-    
+
   type result = ident * (constr*existential_key) * Termops.subst
 
   val empty : t
diff --git a/pretyping/term_dnet.mli b/pretyping/term_dnet.mli
index f6c1b5b61..0e7fdb82a 100644
--- a/pretyping/term_dnet.mli
+++ b/pretyping/term_dnet.mli
@@ -15,8 +15,8 @@ open Libnames
 open Mod_subst
 (*i*)
 
-(* Dnets on constr terms. 
-   
+(* Dnets on constr terms.
+
    An instantiation of Dnet on (an approximation of) constr. It
    associates a term (possibly with Evar) with an
    identifier. Identifiers must be unique (no two terms sharing the
@@ -51,7 +51,7 @@ module type OPT = sig
   (* pre-treatment to terms before adding or searching *)
   val reduce : constr -> constr
 
-  (* direction of post-filtering w.r.t sort subtyping : 
+  (* direction of post-filtering w.r.t sort subtyping :
      - true means query <= terms in the structure
      - false means terms <= query
  *)
@@ -78,14 +78,14 @@ sig
 
   val subst : substitution -> t -> t
 
-  (* 
-   * High-level primitives describing specific search problems 
+  (*
+   * High-level primitives describing specific search problems
    *)
 
   (* [search_pattern dn c] returns all terms/patterns in dn
      matching/matched by c *)
   val search_pattern : t -> constr -> result list
-   
+
   (* [search_concl dn c] returns all matches under products and
      letins, i.e. it finds subterms whose conclusion matches c. The
      complexity depends only on c ! *)
@@ -95,7 +95,7 @@ sig
      heads. Finds terms of the form [forall H_1...H_n, C t_1...t_n]
      where C matches c *)
   val search_head_concl : t -> constr -> result list
-    
+
   (* [search_eq_concl dn eq c] searches terms of the form [forall
      H1...Hn, eq _ X1 X2] where either X1 or X2 matches c *)
   val search_eq_concl : t -> constr -> constr -> result list
diff --git a/pretyping/termops.ml b/pretyping/termops.ml
index 47bc97251..f0a7ce4c8 100644
--- a/pretyping/termops.ml
+++ b/pretyping/termops.ml
@@ -42,7 +42,7 @@ let rec pr_constr c = match kind_of_term c with
   | Meta n -> str "Meta(" ++ int n ++ str ")"
   | Var id -> pr_id id
   | Sort s -> print_sort s
-  | Cast (c,_, t) -> hov 1 
+  | Cast (c,_, t) -> hov 1
       (str"(" ++ pr_constr c ++ cut() ++
        str":" ++ pr_constr t ++ str")")
   | Prod (Name(id),t,c) -> hov 1
@@ -99,7 +99,7 @@ let pr_var_decl env (id,c,typ) =
   let pbody = match c with
     | None ->  (mt ())
     | Some c ->
-	(* Force evaluation *) 
+	(* Force evaluation *)
 	let pb = print_constr_env env c in
 	  (str" := " ++ pb ++ cut () ) in
   let pt = print_constr_env env typ in
@@ -110,7 +110,7 @@ let pr_rel_decl env (na,c,typ) =
   let pbody = match c with
     | None -> mt ()
     | Some c ->
-	(* Force evaluation *) 
+	(* Force evaluation *)
 	let pb = print_constr_env env c in
 	  (str":=" ++ spc () ++ pb ++ spc ()) in
   let ptyp = print_constr_env env typ in
@@ -120,39 +120,39 @@ let pr_rel_decl env (na,c,typ) =
 
 let print_named_context env =
   hv 0 (fold_named_context
-	  (fun env d pps -> 
+	  (fun env d pps ->
 	    pps ++ ws 2 ++ pr_var_decl env d)
           env ~init:(mt ()))
 
-let print_rel_context env = 
+let print_rel_context env =
   hv 0 (fold_rel_context
 	  (fun env d pps -> pps ++ ws 2 ++ pr_rel_decl env d)
           env ~init:(mt ()))
-    
+
 let print_env env =
   let sign_env =
     fold_named_context
       (fun env d pps ->
          let pidt =  pr_var_decl env d in
 	 (pps ++ fnl () ++ pidt))
-      env ~init:(mt ()) 
+      env ~init:(mt ())
   in
   let db_env =
     fold_rel_context
       (fun env d pps ->
          let pnat = pr_rel_decl env d in (pps ++ fnl () ++ pnat))
       env ~init:(mt ())
-  in 
+  in
     (sign_env ++ db_env)
-    
+
 (*let current_module = ref empty_dirpath
 
 let set_module m = current_module := m*)
 
-let new_univ = 
+let new_univ =
   let univ_gen = ref 0 in
   (fun sp ->
-    incr univ_gen; 
+    incr univ_gen;
     Univ.make_univ (Lib.library_dp(),!univ_gen))
 let new_Type () = mkType (new_univ ())
 let new_Type_sort () = Type (new_univ ())
@@ -173,7 +173,7 @@ let refresh_universes_gen strict t =
 let refresh_universes = refresh_universes_gen false
 let refresh_universes_strict = refresh_universes_gen true
 
-let new_sort_in_family = function 
+let new_sort_in_family = function
   | InProp -> prop_sort
   | InSet -> set_sort
   | InType -> Type (new_univ ())
@@ -183,10 +183,10 @@ let new_sort_in_family = function
 (* [Rel (n+m);...;Rel(n+1)] *)
 let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i))
 
-let rel_list n m = 
-  let rec reln l p = 
+let rel_list n m =
+  let rec reln l p =
     if p>m then l else reln (mkRel(n+p)::l) (p+1)
-  in 
+  in
   reln [] 1
 
 (* Same as [rel_list] but takes a context as argument and skips let-ins *)
@@ -195,7 +195,7 @@ let extended_rel_list n hyps =
     | (_,None,_) :: hyps -> reln (mkRel (n+p) :: l) (p+1) hyps
     | (_,Some _,_) :: hyps -> reln l (p+1) hyps
     | [] -> l
-  in 
+  in
   reln [] 1 hyps
 
 let extended_rel_vect n hyps = Array.of_list (extended_rel_list n hyps)
@@ -218,12 +218,12 @@ let push_named_rec_types (lna,typarray,_) env =
   Array.fold_left
     (fun e assum -> push_named assum e) env ctxt
 
-let rec lookup_rel_id id sign = 
+let rec lookup_rel_id id sign =
   let rec lookrec = function
     | (n, (Anonymous,_,_)::l) -> lookrec (n+1,l)
     | (n, (Name id',_,t)::l)  -> if id' = id then (n,t) else lookrec (n+1,l)
     | (_, [])                 -> raise Not_found
-  in 
+  in
   lookrec (1,sign)
 
 (* Constructs either [forall x:t, c] or [let x:=b:t in c] *)
@@ -241,7 +241,7 @@ let mkProd_wo_LetIn (na,body,t) c =
 let it_mkProd ~init = List.fold_left (fun c (n,t)  -> mkProd (n, t, c)) init
 let it_mkLambda ~init = List.fold_left (fun c (n,t)  -> mkLambda (n, t, c)) init
 
-let it_named_context_quantifier f ~init = 
+let it_named_context_quantifier f ~init =
   List.fold_left (fun c d -> f d c) init
 
 let it_mkProd_or_LetIn = it_named_context_quantifier mkProd_or_LetIn
@@ -255,12 +255,12 @@ let it_mkNamedLambda_or_LetIn = it_named_context_quantifier mkNamedLambda_or_Let
 
 (* strips head casts and flattens head applications *)
 let rec strip_head_cast c = match kind_of_term c with
-  | App (f,cl) -> 
+  | App (f,cl) ->
       let rec collapse_rec f cl2 = match kind_of_term f with
 	| App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
 	| Cast (c,_,_) -> collapse_rec c cl2
 	| _ -> if Array.length cl2 = 0 then f else mkApp (f,cl2)
-      in 
+      in
       collapse_rec f cl
   | Cast (c,_,_) -> strip_head_cast c
   | _ -> c
@@ -348,7 +348,7 @@ let map_constr_with_binders_left_to_right g f l c = match kind_of_term c with
 let map_constr_with_full_binders g f l cstr = match kind_of_term cstr with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> cstr
-  | Cast (c,k, t) -> 
+  | Cast (c,k, t) ->
       let c' = f l c in
       let t' = f l t in
       if c==c' && t==t' then cstr else mkCast (c', k, t')
@@ -412,7 +412,7 @@ let fold_constr_with_binders g f n acc c = match kind_of_term c with
   | App (c,l) -> Array.fold_left (f n) (f n acc c) l
   | Evar (_,l) -> Array.fold_left (f n) acc l
   | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) c) bl
-  | Fix (_,(lna,tl,bl)) -> 
+  | Fix (_,(lna,tl,bl)) ->
       let n' = iterate g (Array.length tl) n in
       let fd = array_map2 (fun t b -> (t,b)) tl bl in
       Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd
@@ -436,7 +436,7 @@ let iter_constr_with_full_binders g f l c = match kind_of_term c with
   | App (c,args) -> f l c; Array.iter (f l) args
   | Evar (_,args) -> Array.iter (f l) args
   | Case (_,p,c,bl) -> f l p; f l c; Array.iter (f l) bl
-  | Fix (_,(lna,tl,bl)) -> 
+  | Fix (_,(lna,tl,bl)) ->
       let l' = array_fold_left2 (fun l na t -> g (na,None,t) l) l lna tl in
       Array.iter (f l) tl;
       Array.iter (f l') bl
@@ -446,7 +446,7 @@ let iter_constr_with_full_binders g f l c = match kind_of_term c with
       Array.iter (f l') bl
 
 (***************************)
-(* occurs check functions  *)                         
+(* occurs check functions  *)
 (***************************)
 
 exception Occur
@@ -457,42 +457,42 @@ let occur_meta c =
     | _ -> iter_constr occrec c
   in try occrec c; false with Occur -> true
 
-let occur_existential c = 
+let occur_existential c =
   let rec occrec c = match kind_of_term c with
     | Evar _ -> raise Occur
     | _ -> iter_constr occrec c
   in try occrec c; false with Occur -> true
 
-let occur_meta_or_existential c = 
+let occur_meta_or_existential c =
   let rec occrec c = match kind_of_term c with
     | Evar _ -> raise Occur
     | Meta _ -> raise Occur
     | _ -> iter_constr occrec c
   in try occrec c; false with Occur -> true
 
-let occur_const s c = 
+let occur_const s c =
   let rec occur_rec c = match kind_of_term c with
     | Const sp when sp=s -> raise Occur
     | _ -> iter_constr occur_rec c
-  in 
+  in
   try occur_rec c; false with Occur -> true
 
-let occur_evar n c = 
+let occur_evar n c =
   let rec occur_rec c = match kind_of_term c with
     | Evar (sp,_) when sp=n -> raise Occur
     | _ -> iter_constr occur_rec c
-  in 
+  in
   try occur_rec c; false with Occur -> true
 
 let occur_in_global env id constr =
   let vars = vars_of_global env constr in
   if List.mem id vars then raise Occur
 
-let occur_var env s c = 
+let occur_var env s c =
   let rec occur_rec c =
     occur_in_global env s c;
     iter_constr occur_rec c
-  in 
+  in
   try occur_rec c; false with Occur -> true
 
 let occur_var_in_decl env hyp (_,c,typ) =
@@ -504,17 +504,17 @@ let occur_var_in_decl env hyp (_,c,typ) =
 
 (* returns the list of free debruijn indices in a term *)
 
-let free_rels m = 
+let free_rels m =
   let rec frec depth acc c = match kind_of_term c with
     | Rel n       -> if n >= depth then Intset.add (n-depth+1) acc else acc
     | _ -> fold_constr_with_binders succ frec depth acc c
-  in 
+  in
   frec 1 Intset.empty m
 
 (* collects all metavar occurences, in left-to-right order, preserving
  * repetitions and all. *)
 
-let collect_metas c = 
+let collect_metas c =
   let rec collrec acc c =
     match kind_of_term c with
       | Meta mv -> list_add_set mv acc
@@ -534,12 +534,12 @@ let dependent_main noevar m t =
 	| App (fm,lm), App (ft,lt) when Array.length lm < Array.length lt ->
 	    deprec m (mkApp (ft,Array.sub lt 0 (Array.length lm)));
 	    Array.iter (deprec m)
-	      (Array.sub lt 
+	      (Array.sub lt
 		(Array.length lm) ((Array.length lt) - (Array.length lm)))
 	| _, Cast (c,_,_) when noevar & isMeta c -> ()
 	| _, Evar _ when noevar -> ()
 	| _ -> iter_constr_with_binders (lift 1) deprec m t
-  in 
+  in
   try deprec m t; false with Occur -> true
 
 let dependent = dependent_main false
@@ -551,21 +551,21 @@ let occur_term = dependent
 let pop t = lift (-1) t
 
 (***************************)
-(*  bindings functions *)                         
+(*  bindings functions *)
 (***************************)
 
-type meta_type_map = (metavariable * types) list 
+type meta_type_map = (metavariable * types) list
 
-type meta_value_map = (metavariable * constr) list 
+type meta_value_map = (metavariable * constr) list
 
-let rec subst_meta bl c = 
+let rec subst_meta bl c =
   match kind_of_term c with
     | Meta i -> (try List.assoc i bl with Not_found -> c)
     | _ -> map_constr (subst_meta bl) c
 
 (* First utilities for avoiding telescope computation for subst_term *)
 
-let prefix_application eq_fun (k,c) (t : constr) = 
+let prefix_application eq_fun (k,c) (t : constr) =
   let c' = collapse_appl c and t' = collapse_appl t in
   match kind_of_term c', kind_of_term t' with
     | App (f1,cl1), App (f2,cl2) ->
@@ -574,11 +574,11 @@ let prefix_application eq_fun (k,c) (t : constr) =
 	if l1 <= l2
 	   && eq_fun c' (mkApp (f2, Array.sub cl2 0 l1)) then
 	  Some (mkApp (mkRel k, Array.sub cl2 l1 (l2 - l1)))
-	else 
+	else
 	  None
     | _ -> None
 
-let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) = 
+let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) =
   let c' = collapse_appl c and t' = collapse_appl t in
   match kind_of_term c', kind_of_term t' with
     | App (f1,cl1), App (f2,cl2) ->
@@ -587,7 +587,7 @@ let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) =
 	if l1 <= l2
 	   && eq_fun c' (mkApp (f2, Array.sub cl2 0 l1)) then
 	  Some (mkApp ((lift k by_c), Array.sub cl2 l1 (l2 - l1)))
-	else 
+	else
 	  None
     | _ -> None
 
@@ -596,7 +596,7 @@ let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) =
    term [c] in a term [t] *)
 (*i Bizarre : si on cherche un sous terme clos, pourquoi le lifter ? i*)
 
-let subst_term_gen eq_fun c t = 
+let subst_term_gen eq_fun c t =
   let rec substrec (k,c as kc) t =
     match prefix_application eq_fun kc t with
       | Some x -> x
@@ -604,7 +604,7 @@ let subst_term_gen eq_fun c t =
     if eq_fun c t then mkRel k
     else
       map_constr_with_binders (fun (k,c) -> (k+1,lift 1 c)) substrec kc t
-  in 
+  in
   substrec (1,c) t
 
 (* Recognizing occurrences of a given (closed) subterm in a term :
@@ -612,7 +612,7 @@ let subst_term_gen eq_fun c t =
    term [c1] in a term [t] *)
 (*i Meme remarque : a priori [c] n'est pas forcement clos i*)
 
-let replace_term_gen eq_fun c by_c in_t = 
+let replace_term_gen eq_fun c by_c in_t =
   let rec substrec (k,c as kc) t =
     match my_prefix_application eq_fun kc by_c t with
       | Some x -> x
@@ -620,7 +620,7 @@ let replace_term_gen eq_fun c by_c in_t =
     (if eq_fun c t then (lift k by_c) else
       map_constr_with_binders (fun (k,c) -> (k+1,lift 1 c))
 	substrec kc t)
-  in 
+  in
   substrec (0,c) in_t
 
 let subst_term = subst_term_gen eq_constr
@@ -639,7 +639,7 @@ let no_occurrences_in_set = (true,[])
 let error_invalid_occurrence l =
   let l = list_uniquize (List.sort Pervasives.compare l) in
   errorlabstrm ""
-    (str ("Invalid occurrence " ^ plural (List.length l) "number" ^": ") ++ 
+    (str ("Invalid occurrence " ^ plural (List.length l) "number" ^": ") ++
      prlist_with_sep spc int l ++ str ".")
 
 let subst_term_occ_gen (nowhere_except_in,locs) occ c t =
@@ -650,10 +650,10 @@ let subst_term_occ_gen (nowhere_except_in,locs) occ c t =
     if nowhere_except_in & !pos > maxocc then t
     else
     if eq_constr c t then
-      let r = 
+      let r =
 	if nowhere_except_in then
 	  if List.mem !pos locs then (mkRel k) else t
-	else 
+	else
 	  if List.mem !pos locs then t else (mkRel k)
       in incr pos; r
     else
@@ -664,9 +664,9 @@ let subst_term_occ_gen (nowhere_except_in,locs) occ c t =
   let t' = substrec (1,c) t in
   (!pos, t')
 
-let subst_term_occ (nowhere_except_in,locs as plocs) c t = 
+let subst_term_occ (nowhere_except_in,locs as plocs) c t =
   if locs = [] then if nowhere_except_in then t else subst_term c t
-  else 
+  else
     let (nbocc,t') = subst_term_occ_gen plocs 1 c t in
     let rest = List.filter (fun o -> o >= nbocc) locs in
     if rest <> [] then error_invalid_occurrence rest;
@@ -687,7 +687,7 @@ let subst_term_occ_decl ((nowhere_except_in,locs as plocs),hloc) c (id,bodyopt,t
 	if locs = [] then
 	  if nowhere_except_in then d
 	  else (id,Some (subst_term c body),subst_term c typ)
-	else 
+	else
 	  let (nbocc,body') = subst_term_occ_gen plocs 1 c body in
 	  let (nbocc',t') = subst_term_occ_gen plocs nbocc c typ in
 	  let rest = List.filter (fun o -> o >= nbocc') locs in
@@ -700,7 +700,7 @@ let lowercase_first_char id =
   lowercase_first_char_utf8 (string_of_id id)
 
 let vars_of_env env =
-  let s = 
+  let s =
     Sign.fold_named_context (fun (id,_,_) s -> Idset.add id s)
       (named_context env) ~init:Idset.empty in
   Sign.fold_rel_context
@@ -717,7 +717,7 @@ let sort_hdchar = function
   | Prop(_) -> "P"
   | Type(_) -> "T"
 
-let hdchar env c = 
+let hdchar env c =
   let rec hdrec k c =
     match kind_of_term c with
     | Prod (_,_,c)       -> hdrec (k+1) c
@@ -728,9 +728,9 @@ let hdchar env c =
     | Const kn       ->
 	lowercase_first_char (id_of_label (con_label kn))
     | Ind ((kn,i) as x) ->
-	if i=0 then 
+	if i=0 then
 	  lowercase_first_char (id_of_label (label kn))
-	else 
+	else
 	  lowercase_first_char (basename_of_global (IndRef x))
     | Construct ((sp,i) as x) ->
 	lowercase_first_char (basename_of_global (ConstructRef x))
@@ -743,22 +743,22 @@ let hdchar env c =
 	     | (Name id,_,_)   -> lowercase_first_char id
 	     | (Anonymous,_,t) -> hdrec 0 (lift (n-k) t)
 	   with Not_found -> "y")
-    | Fix ((_,i),(lna,_,_)) -> 
+    | Fix ((_,i),(lna,_,_)) ->
 	let id = match lna.(i) with Name id -> id | _ -> assert false in
 	lowercase_first_char id
-    | CoFix (i,(lna,_,_)) -> 
+    | CoFix (i,(lna,_,_)) ->
 	let id = match lna.(i) with Name id -> id | _ -> assert false in
 	lowercase_first_char id
     | Meta _|Evar _|Case (_, _, _, _) -> "y"
-  in 
+  in
   hdrec 0 c
 
 let id_of_name_using_hdchar env a = function
-  | Anonymous -> id_of_string (hdchar env a) 
+  | Anonymous -> id_of_string (hdchar env a)
   | Name id   -> id
 
 let named_hd env a = function
-  | Anonymous -> Name (id_of_string (hdchar env a)) 
+  | Anonymous -> Name (id_of_string (hdchar env a))
   | x         -> x
 
 let mkProd_name   env (n,a,b) = mkProd (named_hd env a n, a, b)
@@ -778,11 +778,11 @@ let name_assumption env (na,c,t) =
 let name_context env hyps =
   snd
     (List.fold_left
-       (fun (env,hyps) d -> 
+       (fun (env,hyps) d ->
 	  let d' = name_assumption env d in (push_rel d' env, d' :: hyps))
        (env,[]) (List.rev hyps))
 
-let mkProd_or_LetIn_name env b d = mkProd_or_LetIn (name_assumption env d) b 
+let mkProd_or_LetIn_name env b d = mkProd_or_LetIn (name_assumption env d) b
 let mkLambda_or_LetIn_name env b d = mkLambda_or_LetIn (name_assumption env d)b
 
 let it_mkProd_or_LetIn_name env b hyps =
@@ -798,12 +798,12 @@ let add_name n nl = n::nl
 let lookup_name_of_rel p names =
   try List.nth names (p-1)
   with Invalid_argument _ | Failure _ -> raise Not_found
-let rec lookup_rel_of_name id names = 
+let rec lookup_rel_of_name id names =
   let rec lookrec n = function
     | Anonymous :: l  -> lookrec (n+1) l
     | (Name id') :: l -> if id' = id then n else lookrec (n+1) l
     | []            -> raise Not_found
-  in 
+  in
   lookrec 1 names
 let empty_names_context = []
 
@@ -815,7 +815,7 @@ let ids_of_rel_context sign =
 let ids_of_named_context sign =
   Sign.fold_named_context (fun (id,_,_) idl -> id::idl) sign ~init:[]
 
-let ids_of_context env = 
+let ids_of_context env =
   (ids_of_rel_context (rel_context env))
   @ (ids_of_named_context (named_context env))
 
@@ -838,42 +838,42 @@ let is_imported_ref = function
       let (mp,_,_) = repr_con kn in is_imported_modpath mp
 
 let is_global id =
-  try 
+  try
     let ref = locate (qualid_of_ident id) in
     not (is_imported_ref ref)
-  with Not_found -> 
+  with Not_found ->
     false
 
 let is_constructor id =
-  try 
-    match locate (qualid_of_ident id) with 
+  try
+    match locate (qualid_of_ident id) with
       | ConstructRef _ as ref -> not (is_imported_ref ref)
       | _ -> false
-  with Not_found -> 
+  with Not_found ->
     false
 
 let is_section_variable id =
   try let _ = Global.lookup_named id in true
   with Not_found -> false
 
-let next_global_ident_from allow_secvar id avoid = 
+let next_global_ident_from allow_secvar id avoid =
   let rec next_rec id =
     let id = next_ident_away_from id avoid in
     if (allow_secvar && is_section_variable id) || not (is_global id) then
       id
-    else  
+    else
       next_rec (lift_ident id)
-  in 
+  in
   next_rec id
 
 let next_global_ident_away allow_secvar id avoid =
   let id  = next_ident_away id avoid in
   if (allow_secvar && is_section_variable id) || not (is_global id) then
     id
-  else  
+  else
     next_global_ident_from allow_secvar (lift_ident id) avoid
 
-let isGlobalRef c = 
+let isGlobalRef c =
   match kind_of_term c with
   | Const _ | Ind _ | Construct _ | Var _ -> true
   | _ -> false
@@ -884,23 +884,23 @@ let has_polymorphic_type c =
   | _ -> false
 
 (* nouvelle version de renommage des variables (DEC 98) *)
-(* This is the algorithm to display distinct bound variables 
+(* This is the algorithm to display distinct bound variables
 
     - Règle 1 : un nom non anonyme, même non affiché, contribue à la liste
-      des noms à éviter 
+      des noms à éviter
     - Règle 2 : c'est la dépendance qui décide si on affiche ou pas
 
-    Exemple : 
+    Exemple :
     si bool_ind = (P:bool->Prop)(f:(P true))(f:(P false))(b:bool)(P b), alors
     il est affiché (P:bool->Prop)(P true)->(P false)->(b:bool)(P b)
-    mais f et f0 contribue à la liste des variables à éviter (en supposant 
+    mais f et f0 contribue à la liste des variables à éviter (en supposant
     que les noms f et f0 ne sont pas déjà pris)
     Intérêt : noms homogènes dans un but avant et après Intro
 *)
 
 type used_idents = identifier list
 
-let occur_rel p env id = 
+let occur_rel p env id =
   try lookup_name_of_rel p env = Name id
   with Not_found -> false (* Unbound indice : may happen in debug *)
 
@@ -916,7 +916,7 @@ let occur_id nenv id0 c =
         raise Occur
     | Rel p when p>n & occur_rel (p-n) nenv id0 -> raise Occur
     | _ -> iter_constr_with_binders succ occur n c
-  in 
+  in
   try occur 1 c; false
   with Occur -> true
     | Not_found -> false (* Case when a global is not in the env *)
@@ -925,7 +925,7 @@ type avoid_flags = bool option
 
 let next_name_not_occuring avoid_flags name l env_names t =
   let rec next id =
-    if List.mem id l or occur_id env_names id t or 
+    if List.mem id l or occur_id env_names id t or
       (* Further restrictions ? *)
       match avoid_flags with None -> false | Some not_only_cstr ->
       (if not_only_cstr then
@@ -936,10 +936,10 @@ let next_name_not_occuring avoid_flags name l env_names t =
 	is_constructor id)
     then next (lift_ident id)
     else id
-  in 
+  in
   match name with
     | Name id   -> next id
-    | Anonymous -> 
+    | Anonymous ->
         (* Normally, an anonymous name is not dependent and will not be *)
         (* taken into account by the function concrete_name; just in case *)
         (* invent a valid name *)
@@ -953,10 +953,10 @@ let base_sort_cmp pb s0 s1 =
     | _ -> false
 
 (* eq_constr extended with universe erasure *)
-let compare_constr_univ f cv_pb t1 t2 = 
+let compare_constr_univ f cv_pb t1 t2 =
   match kind_of_term t1, kind_of_term t2 with
       Sort s1, Sort s2 -> base_sort_cmp cv_pb s1 s2
-    | Prod (_,t1,c1), Prod (_,t2,c2) -> 
+    | Prod (_,t1,c1), Prod (_,t2,c2) ->
 	f Reduction.CONV t1 t2 & f cv_pb c1 c2
     | _ -> compare_constr (f Reduction.CONV) t1 t2
 
@@ -967,7 +967,7 @@ let eq_constr = constr_cmp Reduction.CONV
 (* App(c,[t1,...tn]) -> ([c,t1,...,tn-1],tn)
    App(c,[||]) -> ([],c) *)
 let split_app c = match kind_of_term c with
-    App(c,l) -> 
+    App(c,l) ->
       let len = Array.length l in
       if len=0 then ([],c) else
 	let last = Array.get l (len-1) in
@@ -983,16 +983,16 @@ exception CannotFilter
 
 let filtering env cv_pb c1 c2 =
   let evm = ref Intmap.empty in
-  let define cv_pb e1 ev c1 = 
+  let define cv_pb e1 ev c1 =
     try let (e2,c2) = Intmap.find ev !evm in
     let shift = List.length e1 - List.length e2 in
     if constr_cmp cv_pb c1 (lift shift c2) then () else raise CannotFilter
-    with Not_found -> 
+    with Not_found ->
       evm := Intmap.add ev (e1,c1) !evm
   in
   let rec aux env cv_pb c1 c2 =
     match kind_of_term c1, kind_of_term c2 with
-      | App _, App _ -> 
+      | App _, App _ ->
 	  let ((p1,l1),(p2,l2)) = (split_app c1),(split_app c2) in
 	  aux env cv_pb l1 l2; if p1=[] & p2=[] then () else
 	      aux env cv_pb (applist (hdtl p1)) (applist (hdtl p2))
@@ -1001,15 +1001,15 @@ let filtering env cv_pb c1 c2 =
 	  aux ((n,None,t1)::env) cv_pb c1 c2
       | _, Evar (ev,_) -> define cv_pb env ev c1
       | Evar (ev,_), _ -> define cv_pb env ev c2
-      | _ -> 
-	  if compare_constr_univ 
-	  (fun pb c1 c2 -> aux env pb c1 c2; true) cv_pb c1 c2 then () 
+      | _ ->
+	  if compare_constr_univ
+	  (fun pb c1 c2 -> aux env pb c1 c2; true) cv_pb c1 c2 then ()
 	  else raise CannotFilter
 	  (* TODO: le reste des binders *)
   in
   aux env cv_pb c1 c2; !evm
 
-let decompose_prod_letin : constr -> int * rel_context * constr = 
+let decompose_prod_letin : constr -> int * rel_context * constr =
   let rec prodec_rec i l c = match kind_of_term c with
     | Prod (n,t,c)    -> prodec_rec (succ i) ((n,None,t)::l) c
     | LetIn (n,d,t,c) -> prodec_rec (succ i) ((n,Some d,t)::l) c
@@ -1023,7 +1023,7 @@ let align_prod_letin c a : rel_context * constr =
   if not (la >= lc) then invalid_arg "align_prod_letin";
   let (l1,l2) = Util.list_chop lc l in
   l2,it_mkProd_or_LetIn a l1
-    
+
 (* On reduit une serie d'eta-redex de tete ou rien du tout  *)
 (* [x1:c1;...;xn:cn]@(f;a1...an;x1;...;xn) --> @(f;a1...an) *)
 (* Remplace 2 versions précédentes buggées                  *)
@@ -1033,7 +1033,7 @@ let rec eta_reduce_head c =
     | Lambda (_,c1,c') ->
 	(match kind_of_term (eta_reduce_head c') with
            | App (f,cl) ->
-               let lastn = (Array.length cl) - 1 in 
+               let lastn = (Array.length cl) - 1 in
                if lastn < 1 then anomaly "application without arguments"
                else
                  (match kind_of_term cl.(lastn) with
@@ -1107,7 +1107,7 @@ let smash_rel_context sign =
 
 let adjust_subst_to_rel_context sign l =
   let rec aux subst sign l =
-    match sign, l with 
+    match sign, l with
     | (_,None,_)::sign', a::args' -> aux (a::subst) sign' args'
     | (_,Some c,_)::sign', args' ->
 	aux (substl (List.rev subst) c :: subst) sign' args'
@@ -1125,7 +1125,7 @@ let rec mem_named_context id = function
 let make_all_name_different env =
   let avoid = ref (ids_of_named_context (named_context env)) in
   process_rel_context
-    (fun (na,c,t) newenv -> 
+    (fun (na,c,t) newenv ->
        let id = next_name_away na !avoid in
        avoid := id::!avoid;
        push_rel (Name id,c,t) newenv)
@@ -1195,7 +1195,7 @@ let on_judgment f j = { uj_val = f j.uj_val; uj_type = f j.uj_type }
 let on_judgment_value f j = { j with uj_val = f j.uj_val }
 let on_judgment_type f j = { j with uj_type = f j.uj_type }
 
-(* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k 
+(* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k
      variables *)
 let context_chop k ctx =
   let rec chop_aux acc = function
diff --git a/pretyping/termops.mli b/pretyping/termops.mli
index 3d167ebb0..f28fee951 100644
--- a/pretyping/termops.mli
+++ b/pretyping/termops.mli
@@ -69,7 +69,7 @@ val map_constr_with_named_binders :
   (name -> 'a -> 'a) ->
   ('a -> constr -> constr) -> 'a -> constr -> constr
 val map_constr_with_binders_left_to_right :
-  (rel_declaration -> 'a -> 'a) -> 
+  (rel_declaration -> 'a -> 'a) ->
   ('a -> constr -> constr) ->
     'a -> constr -> constr
 val map_constr_with_full_binders :
@@ -87,7 +87,7 @@ val fold_constr_with_binders :
   ('a -> 'a) -> ('a -> 'b -> constr -> 'b) -> 'a -> 'b -> constr -> 'b
 
 val iter_constr_with_full_binders :
-  (rel_declaration -> 'a -> 'a) -> ('a -> constr -> unit) -> 'a -> 
+  (rel_declaration -> 'a -> 'a) -> ('a -> constr -> unit) -> 'a ->
     constr -> unit
 
 (**********************************************************************)
@@ -113,11 +113,11 @@ val collect_metas : constr -> int list
 val occur_term : constr -> constr -> bool (* Synonymous
  of dependent *)
 (* Substitution of metavariables *)
-type meta_value_map = (metavariable * constr) list 
+type meta_value_map = (metavariable * constr) list
 val subst_meta : meta_value_map -> constr -> constr
 
 (* Type assignment for metavariables *)
-type meta_type_map = (metavariable * types) list 
+type meta_type_map = (metavariable * types) list
 
 (* [pop c] lifts by -1 the positive indexes in [c] *)
 val pop : constr -> constr
@@ -149,7 +149,7 @@ val no_occurrences_in_set : occurrences
 
 (* [subst_term_occ_gen occl n c d] replaces occurrences of [c] at
    positions [occl], counting from [n], by [Rel 1] in [d] *)
-val subst_term_occ_gen : 
+val subst_term_occ_gen :
   occurrences -> int -> constr -> types -> int * types
 
 (* [subst_term_occ occl c d] replaces occurrences of [c] at
@@ -165,7 +165,7 @@ type hyp_location_flag = (* To distinguish body and type of local defs *)
   | InHypValueOnly
 
 val subst_term_occ_decl :
-  occurrences * hyp_location_flag -> constr -> named_declaration -> 
+  occurrences * hyp_location_flag -> constr -> named_declaration ->
       named_declaration
 
 val error_invalid_occurrence : int list -> 'a
@@ -183,7 +183,7 @@ val eta_eq_constr : constr -> constr -> bool
 exception CannotFilter
 
 (* Lightweight first-order filtering procedure. Unification
-   variables ar represented by (untyped) Evars.  
+   variables ar represented by (untyped) Evars.
    [filtering c1 c2] returns the substitution n'th evar ->
    (context,term), or raises [CannotFilter].
    Warning: Outer-kernel sort subtyping are taken into account: c1 has
@@ -245,20 +245,20 @@ val occur_rel : int -> name list -> identifier -> bool
 val occur_id : name list -> identifier -> constr -> bool
 
 type avoid_flags = bool option
- (* Some true = avoid all globals (as in intro); 
+ (* Some true = avoid all globals (as in intro);
     Some false = avoid only global constructors; None = don't avoid globals *)
 
-val next_name_away_in_cases_pattern : 
+val next_name_away_in_cases_pattern :
   name -> identifier list -> identifier
-val next_global_ident_away : 
+val next_global_ident_away :
   (*allow section vars:*) bool -> identifier -> identifier list -> identifier
 val next_name_not_occuring :
   avoid_flags -> name -> identifier list -> name list -> constr -> identifier
 val concrete_name :
-  avoid_flags -> identifier list -> name list -> name -> constr -> 
+  avoid_flags -> identifier list -> name list -> name -> constr ->
     name * identifier list
 val concrete_let_name :
-  avoid_flags -> identifier list -> name list -> name -> constr -> 
+  avoid_flags -> identifier list -> name list -> name -> constr ->
     name * identifier list
 val rename_bound_var : env -> identifier list -> types -> types
 
@@ -271,7 +271,7 @@ val smash_rel_context : rel_context -> rel_context (* expand lets in context *)
 val adjust_subst_to_rel_context : rel_context -> constr list -> constr list
 val map_rel_context_in_env :
   (env -> constr -> constr) -> env -> rel_context -> rel_context
-val map_rel_context_with_binders : 
+val map_rel_context_with_binders :
   (int -> constr -> constr) -> rel_context -> rel_context
 val fold_named_context_both_sides :
   ('a -> named_declaration -> named_declaration list -> 'a) ->
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml
index 2e4f978f5..097cba590 100644
--- a/pretyping/typeclasses.ml
+++ b/pretyping/typeclasses.ml
@@ -33,14 +33,14 @@ type rels = constr list
 (* This module defines type-classes *)
 type typeclass = {
   (* The class implementation *)
-  cl_impl : global_reference; 
+  cl_impl : global_reference;
 
   (* Context in which the definitions are typed. Includes both typeclass parameters and superclasses. *)
-  cl_context : (global_reference * bool) option list * rel_context; 
+  cl_context : (global_reference * bool) option list * rel_context;
 
   (* Context of definitions and properties on defs, will not be shared *)
   cl_props : rel_context;
-  
+
   (* The method implementaions as projections. *)
   cl_projs : (identifier * constant option) list;
 }
@@ -50,20 +50,20 @@ type typeclasses = (global_reference, typeclass) Gmap.t
 type instance = {
   is_class: global_reference;
   is_pri: int option;
-  (* Sections where the instance should be redeclared, 
-     -1 for discard, 0 for none, mutable to avoid redeclarations 
+  (* Sections where the instance should be redeclared,
+     -1 for discard, 0 for none, mutable to avoid redeclarations
      when multiple rebuild_object happen. *)
   is_global: int ref;
-  is_impl: constant; 
+  is_impl: constant;
 }
 
 type instances = (global_reference, instance Cmap.t) Gmap.t
 
 let instance_impl is = is.is_impl
 
-let new_instance cl pri glob impl = 
+let new_instance cl pri glob impl =
   let global =
-    if Lib.sections_are_opened () then 
+    if Lib.sections_are_opened () then
       if glob then Lib.sections_depth ()
       else -1
     else 0
@@ -76,22 +76,22 @@ let new_instance cl pri glob impl =
 (*
  * states management
  *)
-	
+
 let classes : typeclasses ref = ref Gmap.empty
 
 let instances : instances ref = ref Gmap.empty
-  
+
 let freeze () = !classes, !instances
 
-let unfreeze (cl,is) = 
+let unfreeze (cl,is) =
   classes:=cl;
   instances:=is
-    
+
 let init () =
-  classes:= Gmap.empty; 
+  classes:= Gmap.empty;
   instances:= Gmap.empty
-    
-let _ = 
+
+let _ =
   Summary.declare_summary "classes_and_instances"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
@@ -115,10 +115,10 @@ let subst_class (_,subst,cl) =
   let do_subst_con c = fst (Mod_subst.subst_con subst c)
   and do_subst c = Mod_subst.subst_mps subst c
   and do_subst_gr gr = fst (subst_global subst gr) in
-  let do_subst_ctx ctx = list_smartmap 
+  let do_subst_ctx ctx = list_smartmap
     (fun (na, b, t) -> (na, Option.smartmap do_subst b, do_subst t))
     ctx in
-  let do_subst_context (grs,ctx) = 
+  let do_subst_context (grs,ctx) =
     list_smartmap (Option.smartmap (fun (gr,b) -> do_subst_gr gr, b)) grs,
     do_subst_ctx ctx in
   let do_subst_projs projs = list_smartmap (fun (x, y) -> (x, Option.smartmap do_subst_con y)) projs in
@@ -128,15 +128,15 @@ let subst_class (_,subst,cl) =
     cl_projs = do_subst_projs cl.cl_projs; }
 
 let discharge_class (_,cl) =
-  let rel_of_variable_context ctx = List.fold_right 
+  let rel_of_variable_context ctx = List.fold_right
     ( fun (n,_,b,t) (ctx', subst) ->
 	let decl = (Name n, Option.map (substn_vars 1 subst) b, substn_vars 1 subst t) in
-	(decl :: ctx', n :: subst) 
+	(decl :: ctx', n :: subst)
     ) ctx ([], []) in
   let discharge_rel_context subst n rel =
     let ctx, _ =
       List.fold_right
-	(fun (id, b, t) (ctx, k) -> 
+	(fun (id, b, t) (ctx, k) ->
 	   (id, Option.smartmap (substn_vars k subst) b, substn_vars k subst t) :: ctx, succ k)
 	rel ([], n)
     in ctx in
@@ -146,7 +146,7 @@ let discharge_class (_,cl) =
       | ConstRef cst -> Lib.section_segment_of_constant cst
       | IndRef (ind,_) -> Lib.section_segment_of_mutual_inductive ind in
   let discharge_context ctx' subst (grs, ctx) =
-    let grs' = List.map (fun _ -> None) subst @ 
+    let grs' = List.map (fun _ -> None) subst @
       list_smartmap (Option.smartmap (fun (gr, b) -> Lib.discharge_global gr, b)) grs
     in grs', discharge_rel_context subst 1 ctx @ ctx' in
   let cl_impl' = Lib.discharge_global cl.cl_impl in
@@ -160,7 +160,7 @@ let discharge_class (_,cl) =
 
 let rebuild_class cl = cl
 
-let (class_input,class_output) = 
+let (class_input,class_output) =
   declare_object
     { (default_object "type classes state") with
       cache_function = cache_class;
@@ -180,31 +180,31 @@ let add_class cl =
  * instances persistent object
  *)
 
-let load_instance (_,inst) = 
-  let insts = 
-    try Gmap.find inst.is_class !instances 
+let load_instance (_,inst) =
+  let insts =
+    try Gmap.find inst.is_class !instances
     with Not_found -> Cmap.empty in
   let insts = Cmap.add inst.is_impl inst insts in
   instances := Gmap.add inst.is_class insts !instances
 
 let cache_instance = load_instance
-let subst_instance (_,subst,inst) = 
-  { inst with 
+let subst_instance (_,subst,inst) =
+  { inst with
       is_class = fst (subst_global subst inst.is_class);
       is_impl = fst (Mod_subst.subst_con subst inst.is_impl) }
 
-let discharge_instance (_,inst) = 
-  { inst with 
+let discharge_instance (_,inst) =
+  { inst with
       is_class = Lib.discharge_global inst.is_class;
       is_impl = Lib.discharge_con inst.is_impl}
 
-let rebuild_instance inst = 
+let rebuild_instance inst =
   match !(inst.is_global) with
     | -1 | 0 -> inst (* TODO : probably a bug here *)
     | n -> add_instance_hint inst.is_impl inst.is_pri;
 	inst.is_global := pred n; inst
 
-let (instance_input,instance_output) = 
+let (instance_input,instance_output) =
   declare_object
     { (default_object "type classes instances state") with
       cache_function = cache_instance;
@@ -224,18 +224,18 @@ let add_instance i =
  * interface functions
  *)
 
-let class_info c = 
+let class_info c =
   try Gmap.find c !classes
   with _ -> not_a_class (Global.env()) (constr_of_global c)
 
-let instance_constructor cl args = 
+let instance_constructor cl args =
   let pars = fst (list_chop (List.length (fst cl.cl_context)) args) in
     match cl.cl_impl with
       | IndRef ind -> applistc (mkConstruct (ind, 1)) args,
 	  applistc (mkInd ind) pars
       | ConstRef cst -> list_last args, applistc (mkConst cst) pars
       | _ -> assert false
-	  
+
 let typeclasses () = Gmap.fold (fun _ l c -> l :: c) !classes []
 
 let cmapl_add x y m =
@@ -247,19 +247,19 @@ let cmapl_add x y m =
 
 let cmap_elements c = Cmap.fold (fun k v acc -> v :: acc) c []
 
-let instances_of c = 
+let instances_of c =
   try cmap_elements (Gmap.find c.cl_impl !instances) with Not_found -> []
 
-let all_instances () = 
-  Gmap.fold (fun k v acc -> 
+let all_instances () =
+  Gmap.fold (fun k v acc ->
     Cmap.fold (fun k v acc -> v :: acc) v acc)
     !instances []
 
-let instances r = 
+let instances r =
   let cl = class_info r in instances_of cl
-    
-      
-let is_class gr = 
+
+
+let is_class gr =
   Gmap.fold (fun k v acc -> acc || v.cl_impl = gr) !classes false
 
 let is_instance = function
@@ -273,16 +273,16 @@ let is_instance = function
       | _ -> false)
   | _ -> false
 
-let is_implicit_arg k = 
+let is_implicit_arg k =
   match k with
       ImplicitArg (ref, (n, id), b) -> true
     | InternalHole -> true
     | _ -> false
 
-let global_class_of_constr env c = 
+let global_class_of_constr env c =
   try class_info (global_of_constr c)
   with Not_found -> not_a_class env c
-      
+
 let dest_class_app env c =
   let cl, args = decompose_app c in
     global_class_of_constr env cl, args
@@ -290,40 +290,40 @@ let dest_class_app env c =
 let class_of_constr c = try Some (fst (dest_class_app (Global.env ()) c)) with _ -> None
 
 (* To embed a boolean for resolvability status.
-   This is essentially a hack to mark which evars correspond to 
-   goals and do not need to be resolved when we have nested [resolve_all_evars] 
+   This is essentially a hack to mark which evars correspond to
+   goals and do not need to be resolved when we have nested [resolve_all_evars]
    calls (e.g. when doing apply in an External hint in typeclass_instances).
    Would be solved by having real evars-as-goals. *)
 
 let ((bool_in : bool -> Dyn.t),
     (bool_out : Dyn.t -> bool)) = Dyn.create "bool"
-  
+
 let bool_false = bool_in false
 
 let is_resolvable evi =
   match evi.evar_extra with
       Some t -> if Dyn.tag t = "bool" then bool_out t else true
     | None -> true
-	
-let mark_unresolvable evi = 
+
+let mark_unresolvable evi =
   { evi with evar_extra = Some bool_false }
-    
+
 let mark_unresolvables sigma =
   Evd.fold (fun ev evi evs ->
     Evd.add evs ev (mark_unresolvable evi))
     sigma Evd.empty
-    
+
 let rec is_class_type evd c =
   match kind_of_term c with
   | Prod (_, _, t) -> is_class_type evd t
   | Evar (e, _) when is_defined evd e -> is_class_type evd (Evarutil.nf_evar evd c)
   | _ -> class_of_constr c <> None
 
-let is_class_evar evd evi = 
+let is_class_evar evd evi =
   is_class_type evd evi.Evd.evar_concl
-    
+
 let has_typeclasses evd =
-  Evd.fold (fun ev evi has -> has || 
+  Evd.fold (fun ev evi has -> has ||
     (evi.evar_body = Evar_empty && is_class_evar evd evi && is_resolvable evi))
     evd false
 
diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli
index c2f046440..c9ee9adf0 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -24,19 +24,19 @@ open Util
 
 (* This module defines type-classes *)
 type typeclass = {
-  (* The class implementation: a record parameterized by the context with defs in it or a definition if 
+  (* The class implementation: a record parameterized by the context with defs in it or a definition if
      the class is a singleton. This acts as the class' global identifier. *)
-  cl_impl : global_reference; 
+  cl_impl : global_reference;
 
-  (* Context in which the definitions are typed. Includes both typeclass parameters and superclasses. 
+  (* Context in which the definitions are typed. Includes both typeclass parameters and superclasses.
      The boolean indicates if the typeclass argument is a direct superclass and the global reference
      gives a direct link to the class itself. *)
-  cl_context : (global_reference * bool) option list * rel_context; 
+  cl_context : (global_reference * bool) option list * rel_context;
 
   (* Context of definitions and properties on defs, will not be shared *)
   cl_props : rel_context;
 
-  (* The methods implementations of the typeclass as projections. Some may be undefinable due to 
+  (* The methods implementations of the typeclass as projections. Some may be undefinable due to
      sorting restrictions. *)
   cl_projs : (identifier * constant option) list;
 }
@@ -60,7 +60,7 @@ val dest_class_app : env -> constr -> typeclass * constr list
 
 (* Just return None if not a class *)
 val class_of_constr : constr -> typeclass option
-  
+
 val instance_impl : instance -> constant
 
 val is_class : global_reference -> bool
@@ -82,7 +82,7 @@ val mark_unresolvable : evar_info -> evar_info
 val mark_unresolvables : evar_map -> evar_map
 val is_class_evar : evar_map -> evar_info -> bool
 
-val resolve_typeclasses : ?onlyargs:bool -> ?split:bool -> ?fail:bool -> 
+val resolve_typeclasses : ?onlyargs:bool -> ?split:bool -> ?fail:bool ->
   env -> evar_defs -> evar_defs
 val resolve_one_typeclass : env -> evar_map -> types -> open_constr
 
diff --git a/pretyping/typeclasses_errors.ml b/pretyping/typeclasses_errors.ml
index cec46d780..ae9dec97f 100644
--- a/pretyping/typeclasses_errors.ml
+++ b/pretyping/typeclasses_errors.ml
@@ -24,7 +24,7 @@ open Libnames
 
 type contexts = Parameters | Properties
 
-type typeclass_error = 
+type typeclass_error =
     | NotAClass of constr
     | UnboundMethod of global_reference * identifier located (* Class name, method *)
     | NoInstance of identifier located * constr list
@@ -41,7 +41,7 @@ let unbound_method env cid id = typeclass_error env (UnboundMethod (cid, id))
 
 let no_instance env id args = typeclass_error env (NoInstance (id, args))
 
-let unsatisfiable_constraints env evd ev = 
+let unsatisfiable_constraints env evd ev =
   match ev with
   | None ->
       raise (TypeClassError (env, UnsatisfiableConstraints (evd, None)))
@@ -49,7 +49,7 @@ let unsatisfiable_constraints env evd ev =
       let loc, kind = Evd.evar_source ev evd in
 	raise (Stdpp.Exc_located (loc, TypeClassError
 	  (env, UnsatisfiableConstraints (evd, Some (ev, kind)))))
-	  
+
 let mismatched_ctx_inst env c n m = typeclass_error env (MismatchedContextInstance (c, n, m))
 
 let rec unsatisfiable_exception exn =
diff --git a/pretyping/typeclasses_errors.mli b/pretyping/typeclasses_errors.mli
index 4af1333e9..5cf850890 100644
--- a/pretyping/typeclasses_errors.mli
+++ b/pretyping/typeclasses_errors.mli
@@ -24,7 +24,7 @@ open Libnames
 
 type contexts = Parameters | Properties
 
-type typeclass_error = 
+type typeclass_error =
   | NotAClass of constr
   | UnboundMethod of global_reference * identifier located (* Class name, method *)
   | NoInstance of identifier located * constr list
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 434736667..f4d032bf1 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -51,20 +51,20 @@ let rec execute env evd cstr =
 	let jty = execute env evd (nf_evar evd ty) in
 	let jty = assumption_of_judgment env jty in
 	{ uj_val = cstr; uj_type = jty }
-	
-    | Rel n -> 
+
+    | Rel n ->
 	j_nf_evar evd (judge_of_relative env n)
 
-    | Var id -> 
+    | Var id ->
         j_nf_evar evd (judge_of_variable env id)
-	  
+
     | Const c ->
         make_judge cstr (nf_evar evd (type_of_constant env c))
-	  
+
     | Ind ind ->
 	make_judge cstr (nf_evar evd (type_of_inductive env ind))
-	  
-    | Construct cstruct -> 
+
+    | Construct cstruct ->
 	make_judge cstr
           (nf_evar evd (type_of_constructor env cstruct))
 
@@ -74,25 +74,25 @@ let rec execute env evd cstr =
         let lfj = execute_array env evd lf in
         let (j,_) = judge_of_case env ci pj cj lfj in
         j
-  
+
     | Fix ((vn,i as vni),recdef) ->
         let (_,tys,_ as recdef') = execute_recdef env evd recdef in
 	let fix = (vni,recdef') in
         check_fix env fix;
 	make_judge (mkFix fix) tys.(i)
-	  
+
     | CoFix (i,recdef) ->
         let (_,tys,_ as recdef') = execute_recdef env evd recdef in
         let cofix = (i,recdef') in
         check_cofix env cofix;
 	make_judge (mkCoFix cofix) tys.(i)
-	  
-    | Sort (Prop c) -> 
+
+    | Sort (Prop c) ->
 	judge_of_prop_contents c
 
     | Sort (Type u) ->
 	judge_of_type u
-	  
+
     | App (f,args) ->
         let jl = execute_array env evd args in
 	let j =
@@ -102,23 +102,23 @@ let rec execute env evd cstr =
 		make_judge f
 		  (inductive_type_knowing_parameters env ind
 		    (jv_nf_evar evd jl))
-	    | Const cst -> 
+	    | Const cst ->
 		(* Sort-polymorphism of inductive types *)
 		make_judge f
 		  (constant_type_knowing_parameters env cst
 		    (jv_nf_evar evd jl))
-	    | _ -> 
+	    | _ ->
 		execute env evd f
 	in
 	fst (judge_of_apply env j jl)
-	    
-    | Lambda (name,c1,c2) -> 
+
+    | Lambda (name,c1,c2) ->
         let j = execute env evd c1 in
 	let var = type_judgment env j in
 	let env1 = push_rel (name,None,var.utj_val) env in
-        let j' = execute env1 evd c2 in 
+        let j' = execute env1 evd c2 in
         judge_of_abstraction env1 name var j'
-	  
+
     | Prod (name,c1,c2) ->
         let j = execute env evd c1 in
         let varj = type_judgment env j in
@@ -135,7 +135,7 @@ let rec execute env evd cstr =
         let env1 = push_rel (name,Some j1.uj_val,j2.utj_val) env in
         let j3 = execute env1 evd c3 in
         judge_of_letin env name j1 j2 j3
-  
+
     | Cast (c,k,t) ->
         let cj = execute env evd c in
         let tj = execute env evd t in
@@ -163,7 +163,7 @@ let mcheck env evd c t =
     error_actual_type env j (nf_evar sigma t)
 
 (* Type of a constr *)
- 
+
 let mtype_of env evd c =
   let j = execute env evd (nf_evar evd c) in
   (* We are outside the kernel: we take fresh universes *)
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index dbb416bee..0aa65bef3 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -23,12 +23,12 @@ val type_of : env -> evar_map -> constr -> types
 val sort_of : env -> evar_map -> types -> sorts
 (* Typecheck a term has a given type (assuming the type is OK *)
 val check   : env -> evar_map -> constr -> types -> unit
- 
+
 (* The same but with metas... *)
 val mtype_of : env -> evar_defs -> constr -> types
 val msort_of : env -> evar_defs -> types -> sorts
 val mcheck   : env -> evar_defs -> constr -> types -> unit
 val meta_type : evar_defs -> metavariable -> types
- 
+
 (* unused typing function... *)
 val mtype_of_type : env -> evar_defs -> types -> types
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 92c176593..fe18a0d19 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -31,7 +31,7 @@ open Recordops
    gives [x1:A1]..[xn:An]c' such that c converts to ([x1:A1]..[xn:An]c' l) *)
 
 let abstract_scheme env c l lname_typ =
-  List.fold_left2 
+  List.fold_left2
     (fun t (locc,a) (na,_,ta) ->
        let na = match kind_of_term a with Var id -> Name id | _ -> na in
 (* [occur_meta ta] test removed for support of eelim/ecase but consequences
@@ -46,8 +46,8 @@ let abstract_scheme env c l lname_typ =
 let abstract_list_all env evd typ c l =
   let ctxt,_ = splay_prod_n env evd (List.length l) typ in
   let l_with_all_occs = List.map (function a -> (all_occurrences,a)) l in
-  let p = abstract_scheme env c l_with_all_occs ctxt in 
-  try 
+  let p = abstract_scheme env c l_with_all_occs ctxt in
+  try
     if is_conv_leq env evd (Typing.mtype_of env evd p) typ then p
     else error "abstract_list_all"
   with UserError _ | Type_errors.TypeError _ ->
@@ -89,7 +89,7 @@ let rec subst_meta_instances bl c =
 
 let solve_pattern_eqn_array (env,nb) f l c (sigma,metasubst,evarsubst) =
   match kind_of_term f with
-    | Meta k -> 
+    | Meta k ->
 	let c = solve_pattern_eqn env (Array.to_list l) c in
 	let n = Array.length l - List.length (fst (decompose_lam c)) in
 	let pb = (ConvUpToEta n,TypeNotProcessed) in
@@ -127,14 +127,14 @@ let global_evars_pattern_unification_flag = ref true
 
 open Goptions
 let _ =
-  declare_bool_option 
+  declare_bool_option
     { optsync  = true;
       optname  = "pattern-unification for existential variables in tactics";
       optkey   = ["Tactic";"Evars";"Pattern";"Unification"];
       optread  = (fun () -> !global_evars_pattern_unification_flag);
       optwrite = (:=) global_evars_pattern_unification_flag }
 
-type unify_flags = { 
+type unify_flags = {
   modulo_conv_on_closed_terms : Names.transparent_state option;
   use_metas_eagerly : bool;
   modulo_delta : Names.transparent_state;
@@ -159,35 +159,35 @@ let default_no_delta_unify_flags = {
 }
 
 let use_evars_pattern_unification flags =
-  !global_evars_pattern_unification_flag && flags.use_evars_pattern_unification 
+  !global_evars_pattern_unification_flag && flags.use_evars_pattern_unification
 
 let expand_key env = function
   | Some (ConstKey cst) -> constant_opt_value env cst
   | Some (VarKey id) -> named_body id env
   | Some (RelKey _) -> None
   | None -> None
-      
+
 let key_of flags f =
   match kind_of_term f with
   | Const cst when is_transparent (ConstKey cst) &&
         Cpred.mem cst (snd flags.modulo_delta) ->
-      Some (ConstKey cst) 
+      Some (ConstKey cst)
   | Var id when is_transparent (VarKey id) &&
         Idpred.mem id (fst flags.modulo_delta) ->
       Some (VarKey id)
   | _ -> None
-      
+
 let oracle_order env cf1 cf2 =
   match cf1 with
   | None ->
-      (match cf2 with 
+      (match cf2 with
       | None -> None
       | Some k2 -> Some false)
-  | Some k1 -> 
+  | Some k1 ->
       match cf2 with
       | None -> Some true
       | Some k2 -> Some (Conv_oracle.oracle_order k1 k2)
-	    
+
 let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flags m n =
   let trivial_unify curenv pb (sigma,metasubst,_) m n =
     let subst = if flags.use_metas_eagerly then metasubst else ms in
@@ -203,15 +203,15 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
     | _ -> false in
   let rec unirec_rec (curenv,nb as curenvnb) pb b ((sigma,metasubst,evarsubst) as substn) curm curn =
     let cM = Evarutil.whd_castappevar sigma curm
-    and cN = Evarutil.whd_castappevar sigma curn in 
+    and cN = Evarutil.whd_castappevar sigma curn in
       match (kind_of_term cM,kind_of_term cN) with
 	| Meta k1, Meta k2 ->
 	    let stM,stN = extract_instance_status pb in
-	    if k1 < k2 
+	    if k1 < k2
 	    then sigma,(k1,cN,stN)::metasubst,evarsubst
 	    else if k1 = k2 then substn
 	    else sigma,(k2,cM,stM)::metasubst,evarsubst
-	| Meta k, _ when not (dependent cM cN) -> 
+	| Meta k, _ when not (dependent cM cN) ->
 	    (* Here we check that [cN] does not contain any local variables *)
 	    if nb = 0 then
               sigma,(k,cN,snd (extract_instance_status pb))::metasubst,evarsubst
@@ -220,7 +220,7 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 	      (k,lift (-nb) cN,snd (extract_instance_status pb))::metasubst,
               evarsubst)
 	    else error_cannot_unify_local curenv sigma (m,n,cN)
-	| _, Meta k when not (dependent cN cM) -> 
+	| _, Meta k when not (dependent cN cM) ->
 	    (* Here we check that [cM] does not contain any local variables *)
 	    if nb = 0 then
               (sigma,(k,cM,fst (extract_instance_status pb))::metasubst,evarsubst)
@@ -239,7 +239,7 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 	      (unirec_rec curenvnb topconv true substn t1 t2) c1 c2
 	| LetIn (_,a,_,c), _ -> unirec_rec curenvnb pb b substn (subst1 a c) cN
 	| _, LetIn (_,a,_,c) -> unirec_rec curenvnb pb b substn cM (subst1 a c)
-	    
+
 	| Case (_,p1,c1,cl1), Case (_,p2,c2,cl2) ->
             array_fold_left2 (unirec_rec curenvnb topconv true)
 	      (unirec_rec curenvnb topconv true
@@ -264,10 +264,10 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 		  let (f1,l1,f2,l2) =
 		    if len1 = len2 then (f1,l1,f2,l2)
 		    else if len1 < len2 then
-		      let extras,restl2 = array_chop (len2-len1) l2 in 
+		      let extras,restl2 = array_chop (len2-len1) l2 in
 		      (f1, l1, appvect (f2,extras), restl2)
-		    else 
-		      let extras,restl1 = array_chop (len1-len2) l1 in 
+		    else
+		      let extras,restl1 = array_chop (len1-len2) l1 in
 		      (appvect (f1,extras), restl1, f2, l2) in
 		  let pb = ConvUnderApp (len1,len2) in
 		  array_fold_left2 (unirec_rec curenvnb topconv true)
@@ -276,12 +276,12 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 		  try expand curenvnb pb b substn cM f1 l1 cN f2 l2
 		  with ex when precatchable_exception ex ->
 		    canonical_projections curenvnb pb b cM cN substn)
-		
+
 	| _ ->
 	    try canonical_projections curenvnb pb b cM cN substn
 	    with ex when precatchable_exception ex ->
               if constr_cmp (conv_pb_of cv_pb) cM cN then substn else
-		let (f1,l1) = 
+		let (f1,l1) =
 		  match kind_of_term cM with App (f,l) -> (f,l) | _ -> (cM,[||]) in
 		let (f2,l2) =
 		  match kind_of_term cN with App (f,l) -> (f,l) | _ -> (cN,[||]) in
@@ -289,12 +289,12 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 
   and expand (curenv,_ as curenvnb) pb b (sigma, _, _ as substn) cM f1 l1 cN f2 l2 =
     if trivial_unify curenv pb substn cM cN then substn
-    else 
+    else
       if b then
       let cf1 = key_of flags f1 and cf2 = key_of flags f2 in
 	match oracle_order curenv cf1 cf2 with
 	| None -> error_cannot_unify curenv sigma (cM,cN)
-	| Some true -> 
+	| Some true ->
 	    (match expand_key curenv cf1 with
 	    | Some c ->
 		unirec_rec curenvnb pb b substn
@@ -331,10 +331,10 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 	  else error_cannot_unify (fst curenvnb) sigma (cM,cN)
       else error_cannot_unify (fst curenvnb) sigma (cM,cN)
     in
-      if flags.modulo_conv_on_closed_terms = None then 
+      if flags.modulo_conv_on_closed_terms = None then
 	error_cannot_unify (fst curenvnb) sigma (cM,cN)
       else
-	try f1 () with e when precatchable_exception e -> 
+	try f1 () with e when precatchable_exception e ->
 	  if isApp cN then
 	    let f2l2 = decompose_app cN in
 	      if is_open_canonical_projection sigma f2l2 then
@@ -357,15 +357,15 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
 	      (evd', mkMeta mv :: ks, m - 1))
 	(sigma,[],List.length bs - 1) bs
     in
-    let unilist2 f substn l l' = 
-      try List.fold_left2 f substn l l' 
+    let unilist2 f substn l l' =
+      try List.fold_left2 f substn l l'
       with Invalid_argument "List.fold_left2" -> error_cannot_unify (fst curenvnb) sigma (cM,cN)
     in
-    let substn = unilist2 (fun s u1 u -> unirec_rec curenvnb pb b s u1 (substl ks u)) 
+    let substn = unilist2 (fun s u1 u -> unirec_rec curenvnb pb b s u1 (substl ks u))
       (evd,ms,es) us2 us in
-    let substn = unilist2 (fun s u1 u -> unirec_rec curenvnb pb b s u1 (substl ks u)) 
-      substn params1 params in 
-    let substn = unilist2 (unirec_rec curenvnb pb b) substn ts ts1 in 
+    let substn = unilist2 (fun s u1 u -> unirec_rec curenvnb pb b s u1 (substl ks u))
+      substn params1 params in
+    let substn = unilist2 (unirec_rec curenvnb pb b) substn ts ts1 in
       unirec_rec curenvnb pb b substn c1 (applist (c,(List.rev ks)))
 
   in
@@ -381,9 +381,9 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag
                 Idpred.subset dl_id cv_id && Cpred.subset dl_k cv_k
             | None,(dl_id, dl_k) ->
                 Idpred.is_empty dl_id && Cpred.is_empty dl_k)
-      then error_cannot_unify env sigma (m, n) else false) 
+      then error_cannot_unify env sigma (m, n) else false)
     then subst
-    else 
+    else
       unirec_rec (env,0) cv_pb conv_at_top subst m n
 
 let unify_0 env sigma = unify_0_with_initial_metas (sigma,[],[]) true env
@@ -406,12 +406,12 @@ let rec unify_with_eta keptside flags env sigma k1 k2 c1 c2 =
   | (Lambda (na,t,c1'),_) when k2 > 0 ->
       let env' = push_rel_assum (na,t) env in
       let side = left in (* expansion on the right: we keep the left side *)
-      unify_with_eta side flags env' sigma (pop k1) (k2-1) 
+      unify_with_eta side flags env' sigma (pop k1) (k2-1)
 	c1' (mkApp (lift 1 c2,[|mkRel 1|]))
   | (_,Lambda (na,t,c2')) when k1 > 0 ->
       let env' = push_rel_assum (na,t) env in
       let side = right in (* expansion on the left: we keep the right side *)
-      unify_with_eta side flags env' sigma (k1-1) (pop k2) 
+      unify_with_eta side flags env' sigma (k1-1) (pop k2)
 	(mkApp (lift 1 c1,[|mkRel 1|])) c2'
   | _ ->
       (keptside,ConvUpToEta(min k1 k2),
@@ -501,18 +501,18 @@ let merge_instances env sigma flags st1 st2 c1 c2 =
  * close it off.  But this might not always work,
  * since other metavars might also need to be resolved. *)
 
-let applyHead env evd n c  = 
+let applyHead env evd n c  =
   let rec apprec n c cty evd =
-    if n = 0 then 
+    if n = 0 then
       (evd, c)
-    else 
+    else
       match kind_of_term (whd_betadeltaiota env evd cty) with
         | Prod (_,c1,c2) ->
-            let (evd',evar) = 
+            let (evd',evar) =
 	      Evarutil.new_evar evd env ~src:(dummy_loc,GoalEvar) c1 in
 	    apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) evd'
 	| _ -> error "Apply_Head_Then"
-  in 
+  in
   apprec n c (Typing.type_of env evd c) evd
 
 let is_mimick_head f =
@@ -553,7 +553,7 @@ let w_coerce_to_type env evd c cty mvty =
   let tycon = mk_tycon_type mvty in
   try try_to_coerce env evd c cty tycon
   with e when precatchable_exception e ->
-    (* inh_conv_coerce_rigid_to should have reasoned modulo reduction 
+    (* inh_conv_coerce_rigid_to should have reasoned modulo reduction
        but there are cases where it though it was not rigid (like in
        fst (nat,nat)) and stops while it could have seen that it is rigid *)
     let cty = Tacred.hnf_constr env evd cty in
@@ -569,18 +569,18 @@ let unify_to_type env sigma flags c status u =
   let t = get_type_of env sigma c in
   let t = Tacred.hnf_constr env sigma (nf_betaiota sigma (nf_meta sigma t)) in
   let u = Tacred.hnf_constr env sigma u in
-    try 
+    try
       if status = IsSuperType then
 	unify_0 env sigma Cumul flags u t
       else if status = IsSubType then
 	unify_0 env sigma Cumul flags t u
-      else 
+      else
 	try unify_0 env sigma Cumul flags t u
 	with e when precatchable_exception e ->
 	  unify_0 env sigma Cumul flags u t
     with e when precatchable_exception e ->
       (sigma,[],[])
-	
+
 let unify_type env sigma flags mv status c =
   let mvty = Typing.meta_type sigma mv in
   if occur_meta_or_existential mvty or is_arity env sigma mvty then
@@ -633,7 +633,7 @@ let w_merge env with_types flags (evd,metas,evars) =
 	      w_merge_rec (solve_simple_evar_eqn env evd ev rhs')
 		metas evars' eqns
 	end
-    | [] -> 
+    | [] ->
 
     (* Process metas *)
     match metas with
@@ -646,30 +646,30 @@ let w_merge env with_types flags (evd,metas,evars) =
 	    else
               (* No coercion needed: delay the unification of types *)
 	      ((evd,c),([],[])),(mv,status,c)::eqns
-	  else 
+	  else
 	    ((evd,c),([],[])),eqns in
 	  if meta_defined evd mv then
 	    let {rebus=c'},(status',_) = meta_fvalue evd mv in
             let (take_left,st,(evd,metas',evars')) =
 	      merge_instances env evd flags status' status c' c
 	    in
-	    let evd' = 
-              if take_left then evd 
-              else meta_reassign mv (c,(st,TypeProcessed)) evd 
+	    let evd' =
+              if take_left then evd
+              else meta_reassign mv (c,(st,TypeProcessed)) evd
 	    in
               w_merge_rec evd' (metas'@metas@metas'') (evars'@evars'') eqns
     	  else
 	    let evd' = meta_assign mv (c,(status,TypeProcessed)) evd in
 	      w_merge_rec evd' (metas@metas'') evars'' eqns
-    | [] -> 
+    | [] ->
 
     (* Process type eqns *)
     match eqns with
     | (mv,status,c)::eqns ->
-        let (evd,metas,evars) = unify_type env evd flags mv status c in 
+        let (evd,metas,evars) = unify_type env evd flags mv status c in
         w_merge_rec evd metas evars eqns
     | [] -> evd
-		
+
   and mimick_evar evd flags hdc nargs sp =
     let ev = Evd.find evd sp in
     let sp_env = Global.env_of_context ev.evar_hyps in
@@ -719,7 +719,7 @@ let w_unify_core_0 env with_types cv_pb flags m n evd =
      unify_0_with_initial_metas (evd',ms,es) true env cv_pb flags m n
   in
   let evd = w_merge env with_types flags subst2 in
-    if flags.resolve_evars then 
+    if flags.resolve_evars then
       try Typeclasses.resolve_typeclasses ~onlyargs:false ~split:false
 	~fail:true env evd
       with e when Typeclasses_errors.unsatisfiable_exception e ->
@@ -734,11 +734,11 @@ let w_typed_unify env = w_unify_core_0 env true
    FAIL because we cannot find a binding *)
 
 let iter_fail f a =
-  let n = Array.length a in 
+  let n = Array.length a in
   let rec ffail i =
-    if i = n then error "iter_fail" 
+    if i = n then error "iter_fail"
     else
-      try f a.(i) 
+      try f a.(i)
       with ex when precatchable_exception ex -> ffail (i+1)
   in ffail 0
 
@@ -748,56 +748,56 @@ let iter_fail f a =
 let w_unify_to_subterm env ?(flags=default_unify_flags) (op,cl) evd =
   let rec matchrec cl =
     let cl = strip_outer_cast cl in
-    (try 
-       if closed0 cl 
+    (try
+       if closed0 cl
        then w_typed_unify env topconv flags op cl evd,cl
        else error "Bound 1"
      with ex when precatchable_exception ex ->
-       (match kind_of_term cl with 
+       (match kind_of_term cl with
 	  | App (f,args) ->
 	      let n = Array.length args in
 	      assert (n>0);
 	      let c1 = mkApp (f,Array.sub args 0 (n-1)) in
 	      let c2 = args.(n-1) in
-	      (try 
+	      (try
 		 matchrec c1
-	       with ex when precatchable_exception ex -> 
+	       with ex when precatchable_exception ex ->
 		 matchrec c2)
           | Case(_,_,c,lf) -> (* does not search in the predicate *)
-	       (try 
+	       (try
 		 matchrec c
-	       with ex when precatchable_exception ex -> 
+	       with ex when precatchable_exception ex ->
 		 iter_fail matchrec lf)
-	  | LetIn(_,c1,_,c2) -> 
-	       (try 
+	  | LetIn(_,c1,_,c2) ->
+	       (try
 		 matchrec c1
-	       with ex when precatchable_exception ex -> 
+	       with ex when precatchable_exception ex ->
 		 matchrec c2)
 
-	  | Fix(_,(_,types,terms)) -> 
-	       (try 
+	  | Fix(_,(_,types,terms)) ->
+	       (try
 		 iter_fail matchrec types
-	       with ex when precatchable_exception ex -> 
+	       with ex when precatchable_exception ex ->
 		 iter_fail matchrec terms)
-	
-	  | CoFix(_,(_,types,terms)) -> 
-	       (try 
+
+	  | CoFix(_,(_,types,terms)) ->
+	       (try
 		 iter_fail matchrec types
-	       with ex when precatchable_exception ex -> 
+	       with ex when precatchable_exception ex ->
 		 iter_fail matchrec terms)
 
           | Prod (_,t,c) ->
-	      (try 
-		 matchrec t 
-	       with ex when precatchable_exception ex -> 
+	      (try
+		 matchrec t
+	       with ex when precatchable_exception ex ->
 		 matchrec c)
           | Lambda (_,t,c) ->
-	      (try 
-		 matchrec t 
-	       with ex when precatchable_exception ex -> 
+	      (try
+		 matchrec t
+	       with ex when precatchable_exception ex ->
 		 matchrec c)
-          | _ -> error "Match_subterm")) 
-  in 
+          | _ -> error "Match_subterm"))
+  in
   try matchrec cl
   with ex when precatchable_exception ex ->
     raise (PretypeError (env,NoOccurrenceFound (op, None)))
@@ -808,10 +808,10 @@ let w_unify_to_subterm env ?(flags=default_unify_flags) (op,cl) evd =
 let w_unify_to_subterm_all env ?(flags=default_unify_flags) (op,cl) evd =
   let return a b =
     let (evd,c as a) = a () in
-      if List.exists (fun (evd',c') -> eq_constr c c') b then b else a :: b 
+      if List.exists (fun (evd',c') -> eq_constr c c') b then b else a :: b
   in
   let fail str _ = error str in
-  let bind f g a = 
+  let bind f g a =
     let a1 = try f a
              with ex
              when precatchable_exception ex -> a
@@ -820,7 +820,7 @@ let w_unify_to_subterm_all env ?(flags=default_unify_flags) (op,cl) evd =
        when precatchable_exception ex -> a1
   in
   let bind_iter f a =
-    let n = Array.length a in 
+    let n = Array.length a in
     let rec ffail i =
       if i = n then fun a -> a
       else bind (f a.(i)) (ffail (i+1))
@@ -828,11 +828,11 @@ let w_unify_to_subterm_all env ?(flags=default_unify_flags) (op,cl) evd =
   in
   let rec matchrec cl =
     let cl = strip_outer_cast cl in
-      (bind 
-	  (if closed0 cl 
+      (bind
+	  (if closed0 cl
 	  then return (fun () -> w_typed_unify env topconv flags op cl evd,cl)
             else fail "Bound 1")
-          (match kind_of_term cl with 
+          (match kind_of_term cl with
 	    | App (f,args) ->
 		let n = Array.length args in
 		assert (n>0);
@@ -843,42 +843,42 @@ let w_unify_to_subterm_all env ?(flags=default_unify_flags) (op,cl) evd =
             | Case(_,_,c,lf) -> (* does not search in the predicate *)
 		bind (matchrec c) (bind_iter matchrec lf)
 
-	    | LetIn(_,c1,_,c2) -> 
+	    | LetIn(_,c1,_,c2) ->
 		bind (matchrec c1) (matchrec c2)
 
 	    | Fix(_,(_,types,terms)) ->
 		bind (bind_iter matchrec types) (bind_iter matchrec terms)
-	
-	    | CoFix(_,(_,types,terms)) -> 
+
+	    | CoFix(_,(_,types,terms)) ->
 		bind (bind_iter matchrec types) (bind_iter matchrec terms)
 
             | Prod (_,t,c) ->
 		bind (matchrec t) (matchrec c)
-		  
+
             | Lambda (_,t,c) ->
 		bind (matchrec t) (matchrec c)
 
-            | _ -> fail "Match_subterm")) 
-  in 
+            | _ -> fail "Match_subterm"))
+  in
   let res = matchrec cl [] in
   if res = [] then
     raise (PretypeError (env,NoOccurrenceFound (op, None)))
   else
     res
 
-let w_unify_to_subterm_list env flags allow_K oplist t evd = 
-  List.fold_right 
+let w_unify_to_subterm_list env flags allow_K oplist t evd =
+  List.fold_right
     (fun op (evd,l) ->
       if isMeta op then
 	if allow_K then (evd,op::l)
 	else error "Unify_to_subterm_list"
       else if occur_meta_or_existential op then
         let (evd',cl) =
-          try 
+          try
 	    (* This is up to delta for subterms w/o metas ... *)
 	    w_unify_to_subterm env ~flags (strip_outer_cast op,t) evd
 	  with PretypeError (env,NoOccurrenceFound _) when allow_K -> (evd,op)
-        in 
+        in
 	  if not allow_K && (* ensure we found a different instance *)
 	    List.exists (fun op -> eq_constr op cl) l
 	  then error "Unify_to_subterm_list"
@@ -888,7 +888,7 @@ let w_unify_to_subterm_list env flags allow_K oplist t evd =
       else
 	(* This is not up to delta ... *)
 	raise (PretypeError (env,NoOccurrenceFound (op, None))))
-    oplist 
+    oplist
     (evd,[])
 
 let secondOrderAbstraction env flags allow_K typ (p, oplist) evd =
@@ -907,13 +907,13 @@ let w_unify2 env flags allow_K cv_pb ty1 ty2 evd =
     | Meta p1, _ ->
         (* Find the predicate *)
 	let evd' =
-          secondOrderAbstraction env flags allow_K ty2 (p1,oplist1) evd in 
+          secondOrderAbstraction env flags allow_K ty2 (p1,oplist1) evd in
         (* Resume first order unification *)
 	w_unify_0 env cv_pb flags (nf_meta evd' ty1) ty2 evd'
     | _, Meta p2 ->
         (* Find the predicate *)
 	let evd' =
-          secondOrderAbstraction env flags allow_K ty1 (p2, oplist2) evd in 
+          secondOrderAbstraction env flags allow_K ty1 (p2, oplist2) evd in
         (* Resume first order unification *)
 	w_unify_0 env cv_pb flags ty1 (nf_meta evd' ty2) evd'
     | _ -> error "w_unify2"
@@ -946,23 +946,23 @@ let w_unify allow_K env cv_pb ?(flags=default_unify_flags) ty1 ty2 evd =
       (* Pattern case *)
       | (Meta _, true, Lambda _, _ | Lambda _, _, Meta _, true)
 	  when List.length l1 = List.length l2 ->
-	  (try 
+	  (try
 	      w_typed_unify env cv_pb flags ty1 ty2 evd
-	    with ex when precatchable_exception ex -> 
-	      try 
+	    with ex when precatchable_exception ex ->
+	      try
 		w_unify2 env flags allow_K cv_pb ty1 ty2 evd
 	      with PretypeError (env,NoOccurrenceFound _) as e -> raise e)
-	    
+
       (* Second order case *)
-      | (Meta _, true, _, _ | _, _, Meta _, true) -> 
-	  (try 
+      | (Meta _, true, _, _ | _, _, Meta _, true) ->
+	  (try
 	      w_unify2 env flags allow_K cv_pb ty1 ty2 evd
 	    with PretypeError (env,NoOccurrenceFound _) as e -> raise e
-	      | ex when precatchable_exception ex -> 
-		  try 
+	      | ex when precatchable_exception ex ->
+		  try
 		    w_typed_unify env cv_pb flags ty1 ty2 evd
 		  with ex' when precatchable_exception ex' ->
 		    raise ex)
-	    
+
       (* General case: try first order *)
       | _ -> w_typed_unify env cv_pb flags ty1 ty2 evd
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index 43c9dd2e9..2df1c648a 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -14,8 +14,8 @@ open Environ
 open Evd
 (*i*)
 
-type unify_flags = { 
-  modulo_conv_on_closed_terms : Names.transparent_state option; 
+type unify_flags = {
+  modulo_conv_on_closed_terms : Names.transparent_state option;
   use_metas_eagerly : bool;
   modulo_delta : Names.transparent_state;
   resolve_evars : bool;
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 6eb7302f0..c894d2b51 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -13,14 +13,14 @@ open Declarations
 open Term
 open Environ
 open Inductive
-open Reduction 
+open Reduction
 open Vm
 
 (*******************************************)
 (* Calcul de la forme normal d'un terme    *)
 (*******************************************)
 
-let crazy_type =  mkSet 
+let crazy_type =  mkSet
 
 let decompose_prod env t =
   let (name,dom,codom as res) = destProd (whd_betadeltaiota env t) in
@@ -33,18 +33,18 @@ exception Find_at of int
    [cst] = true si c'est un constructeur constant *)
 
 let invert_tag cst tag reloc_tbl =
-  try 
+  try
     for j = 0 to Array.length reloc_tbl - 1 do
       let tagj,arity = reloc_tbl.(j) in
       if tag = tagj && (cst && arity = 0 || not(cst || arity = 0)) then
 	raise (Find_at j)
       else ()
-    done;raise Not_found 
-  with Find_at j -> (j+1)   
+    done;raise Not_found
+  with Find_at j -> (j+1)
              (* Argggg, ces constructeurs de ... qui commencent a 1*)
 
 let find_rectype_a env c =
-  let (t, l) = 
+  let (t, l) =
     let t = whd_betadeltaiota env c in
     try destApp t with _ -> (t,[||]) in
   match kind_of_term t with
@@ -53,13 +53,13 @@ let find_rectype_a env c =
 
 (* Instantiate inductives and parameters in constructor type *)
 
-let type_constructor mind mib typ params = 
+let type_constructor mind mib typ params =
   let s = ind_subst mind mib in
   let ctyp = substl s typ in
   let nparams = Array.length params in
   if nparams = 0 then ctyp
   else
-    let _,ctyp = decompose_prod_n nparams ctyp in   
+    let _,ctyp = decompose_prod_n nparams ctyp in
     substl (List.rev (Array.to_list params)) ctyp
 
 
@@ -85,7 +85,7 @@ let construct_of_constr const env tag typ =
     let ctyp = type_constructor mind mib (mip.mind_nf_lc.(i-1)) params in
       (mkApp(mkConstruct(ind,i), params), ctyp)
 
-let construct_of_constr_const env tag typ = 
+let construct_of_constr_const env tag typ =
   fst (construct_of_constr true env tag typ)
 
 let construct_of_constr_block = construct_of_constr false
@@ -94,15 +94,15 @@ let constr_type_of_idkey env idkey =
   match idkey with
   | ConstKey cst ->
       mkConst cst, Typeops.type_of_constant env cst
-  | VarKey id -> 
-      let (_,_,ty) = lookup_named id env in 
+  | VarKey id ->
+      let (_,_,ty) = lookup_named id env in
       mkVar id, ty
-  | RelKey i -> 
+  | RelKey i ->
       let n = (nb_rel env - i) in
       let (_,_,ty) = lookup_rel n env in
       mkRel n, lift n ty
 
-let type_of_ind env ind = 
+let type_of_ind env ind =
   type_of_inductive env (Inductive.lookup_mind_specif env ind)
 
 let build_branches_type env (mind,_ as _ind) mib mip params dep p =
@@ -116,7 +116,7 @@ let build_branches_type env (mind,_ as _ind) mib mip params dep p =
     let nparams = Array.length params in
     let carity = snd (rtbl.(i)) in
     let crealargs = Array.sub cargs nparams (Array.length cargs - nparams) in
-    let codom = 
+    let codom =
       let papp = mkApp(p,crealargs) in
       if dep then
 	let cstr = ith_constructor_of_inductive ind (i+1) in
@@ -124,17 +124,17 @@ let build_branches_type env (mind,_ as _ind) mib mip params dep p =
 	let dep_cstr = mkApp(mkApp(mkConstruct cstr,params),relargs) in
 	mkApp(papp,[|dep_cstr|])
       else papp
-    in 
+    in
     decl, codom
   in Array.mapi build_one_branch mip.mind_nf_lc
 
-let build_case_type dep p realargs c = 
+let build_case_type dep p realargs c =
   if dep then mkApp(mkApp(p, realargs), [|c|])
   else mkApp(p, realargs)
 
 (* La fonction de normalisation *)
 
-let rec nf_val env v t = nf_whd env (whd_val v) t 
+let rec nf_val env v t = nf_whd env (whd_val v) t
 
 and nf_vtype env v =  nf_val env v crazy_type
 
@@ -145,18 +145,18 @@ and nf_whd env whd typ =
       let dom = nf_vtype env (dom p) in
       let name = Name (id_of_string "x") in
       let vc = body_of_vfun (nb_rel env) (codom p) in
-      let codom = nf_vtype (push_rel (name,None,dom) env) vc  in      
-      mkProd(name,dom,codom)	  
+      let codom = nf_vtype (push_rel (name,None,dom) env) vc  in
+      mkProd(name,dom,codom)
   | Vfun f -> nf_fun env f typ
   | Vfix(f,None) -> nf_fix env f
   | Vfix(f,Some vargs) -> fst (nf_fix_app env f vargs)
-  | Vcofix(cf,_,None) -> nf_cofix env cf 
-  | Vcofix(cf,_,Some vargs) -> 
+  | Vcofix(cf,_,None) -> nf_cofix env cf
+  | Vcofix(cf,_,Some vargs) ->
       let cfd = nf_cofix env cf in
       let i,(_,ta,_) = destCoFix cfd in
       let t = ta.(i) in
       let _, args = nf_args env vargs t in
-      mkApp(cfd,args) 
+      mkApp(cfd,args)
   | Vconstr_const n -> construct_of_constr_const env n typ
   | Vconstr_block b ->
       let capp,ctyp = construct_of_constr_block env (btag b) typ in
@@ -168,24 +168,24 @@ and nf_whd env whd typ =
   | Vatom_stk(Aiddef(idkey,v), stk) ->
       nf_whd env (whd_stack v stk) typ
   | Vatom_stk(Aind ind, stk) ->
-      nf_stk env (mkInd ind) (type_of_ind env ind) stk 
-	
+      nf_stk env (mkInd ind) (type_of_ind env ind) stk
+
 and nf_stk env c t stk  =
   match stk with
   | [] -> c
   | Zapp vargs :: stk ->
       let t, args = nf_args env vargs t in
-      nf_stk env (mkApp(c,args)) t stk 
-  | Zfix (f,vargs) :: stk ->  
+      nf_stk env (mkApp(c,args)) t stk
+  | Zfix (f,vargs) :: stk ->
       let fa, typ = nf_fix_app env f vargs in
       let _,_,codom = try decompose_prod env typ with _ -> exit 120 in
       nf_stk env (mkApp(fa,[|c|])) (subst1 c codom) stk
-  | Zswitch sw :: stk -> 
+  | Zswitch sw :: stk ->
       let (mind,_ as ind),allargs = find_rectype_a env t in
       let (mib,mip) = Inductive.lookup_mind_specif env ind in
       let nparams = mib.mind_nparams in
       let params,realargs = Util.array_chop nparams allargs in
-      let pT = 
+      let pT =
 	hnf_prod_applist env (type_of_ind env ind) (Array.to_list params) in
       let pT = whd_betadeltaiota env pT in
       let dep, p = nf_predicate env ind mip params (type_of_switch sw) pT in
@@ -195,12 +195,12 @@ and nf_stk env c t stk  =
       let bsw = branch_of_switch (nb_rel env) sw in
       let mkbranch i (n,v) =
 	let decl,codom = btypes.(i) in
-	let env = 
-	  List.fold_right 
+	let env =
+	  List.fold_right
 	    (fun (name,t) env -> push_rel (name,None,t) env) decl env in
 	let b = nf_val env v codom in
-	compose_lam decl b 
-      in 
+	compose_lam decl b
+      in
       let branchs = Array.mapi mkbranch bsw in
       let tcase = build_case_type dep p realargs c in
       let ci = case_info sw in
@@ -212,10 +212,10 @@ and nf_predicate env ind mip params v pT =
       let k = nb_rel env in
       let vb = body_of_vfun k f in
       let name,dom,codom = try decompose_prod env pT with _ -> exit 121 in
-      let dep,body = 
+      let dep,body =
 	nf_predicate (push_rel (name,None,dom) env) ind mip params vb codom in
       dep, mkLambda(name,dom,body)
-  | Vfun f, _ -> 
+  | Vfun f, _ ->
       let k = nb_rel env in
       let vb = body_of_vfun k f in
       let name = Name (id_of_string "c") in
@@ -226,12 +226,12 @@ and nf_predicate env ind mip params v pT =
       let body = nf_vtype (push_rel (name,None,dom) env) vb in
       true, mkLambda(name,dom,body)
   | _, _ -> false, nf_val env v crazy_type
-	
+
 and nf_args env vargs t =
   let t = ref t in
   let len = nargs vargs in
-  let args = 
-    Array.init len 
+  let args =
+    Array.init len
       (fun i ->
 	let _,dom,codom = try decompose_prod env !t with _ -> exit 123 in
 	let c = nf_val env (arg vargs i) dom in
@@ -242,8 +242,8 @@ and nf_bargs env b t =
   let t = ref t in
   let len = bsize b in
   let args =
-    Array.init len 
-      (fun i -> 
+    Array.init len
+      (fun i ->
 	let _,dom,codom = try decompose_prod env !t with _ -> exit 124 in
 	let c = nf_val env (bfield b i) dom in
 	t := subst1 c codom; c) in
@@ -252,7 +252,7 @@ and nf_bargs env b t =
 and nf_fun env f typ =
   let k = nb_rel env in
   let vb = body_of_vfun k f in
-  let name,dom,codom = 
+  let name,dom,codom =
     try decompose_prod env typ
     with _ ->
       raise (Type_errors.TypeError(env,Type_errors.ReferenceVariables typ))
@@ -268,17 +268,17 @@ and nf_fix env f =
   let ndef = Array.length vt in
   let ft = Array.map (fun v -> nf_val env v crazy_type) vt in
   let name = Array.init ndef (fun _ -> (Name (id_of_string "Ffix"))) in
-  let env = push_rec_types (name,ft,ft) env in 
+  let env = push_rec_types (name,ft,ft) env in
   let fb = Util.array_map2 (fun v t -> nf_fun env v t) vb ft in
   mkFix ((rec_args,init),(name,ft,fb))
-      
+
 and nf_fix_app env f vargs =
   let fd = nf_fix env f in
   let (_,i),(_,ta,_) = destFix fd in
   let t = ta.(i) in
   let t, args = nf_args env vargs t in
   mkApp(fd,args),t
-  
+
 and nf_cofix env cf =
   let init = current_cofix cf in
   let k = nb_rel env in
@@ -286,15 +286,15 @@ and nf_cofix env cf =
   let ndef = Array.length vt in
   let cft = Array.map (fun v -> nf_val env v crazy_type) vt in
   let name = Array.init ndef (fun _ -> (Name (id_of_string "Fcofix"))) in
-  let env = push_rec_types (name,cft,cft) env in 
+  let env = push_rec_types (name,cft,cft) env in
   let cfb = Util.array_map2 (fun v t -> nf_val env v t) vb cft in
   mkCoFix (init,(name,cft,cfb))
-  
+
 let cbv_vm env c t  =
   let transp = transp_values () in
-  if not transp then set_transp_values true; 
+  if not transp then set_transp_values true;
   let v = Vconv.val_of_constr env c in
   let c = nf_val env v t in
-  if not transp then set_transp_values false; 
+  if not transp then set_transp_values false;
   c
-  
+