[ocamlformat] Enable for funind.

As part of the proof refactoring work I am doing some modifications to
`funind` and indentation of that code is driving me a bit crazy; I'd
much prefer to delegate it to an automatic tool.

19 files changed, 6522 insertions, 6168 deletions

diff --git a/plugins/funind/.ocamlformat b/plugins/funind/.ocamlformat
new file mode 100644
index 0000000000..a22a2ff88c
--- /dev/null
+++ b/plugins/funind/.ocamlformat
@@ -0,0 +1 @@
+disable=false
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 9749af1e66..ad0891b567 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -15,280 +15,265 @@ open Tactics
 open Indfun_common
 open Libnames
 open Context.Rel.Declaration
-
 module RelDecl = Context.Rel.Declaration
 
-let list_chop ?(msg="") n l =
-  try
-    List.chop n l
-  with Failure (msg') ->
-    failwith (msg ^ msg')
+let list_chop ?(msg = "") n l =
+  try List.chop n l with Failure msg' -> failwith (msg ^ msg')
 
 let pop t = Vars.lift (-1) t
 
-let make_refl_eq constructor type_of_t t  =
-(*   let refl_equal_term = Lazy.force refl_equal in *)
-  mkApp(constructor,[|type_of_t;t|])
-
+let make_refl_eq constructor type_of_t t =
+  (*   let refl_equal_term = Lazy.force refl_equal in *)
+  mkApp (constructor, [|type_of_t; t|])
 
 type pte_info =
-    {
-      proving_tac : (Id.t list -> Tacmach.tactic);
-      is_valid : constr -> bool
-    }
+  {proving_tac : Id.t list -> Tacmach.tactic; is_valid : constr -> bool}
 
 type ptes_info = pte_info Id.Map.t
 
 type 'a dynamic_info =
-    {
-      nb_rec_hyps : int;
-      rec_hyps : Id.t list ;
-      eq_hyps : Id.t list;
-      info : 'a
-    }
+  {nb_rec_hyps : int; rec_hyps : Id.t list; eq_hyps : Id.t list; info : 'a}
 
 type body_info = constr dynamic_info
 
 let observe_tac s = observe_tac (fun _ _ -> Pp.str s)
 
 let finish_proof dynamic_infos g =
-  observe_tac "finish"
-    (Proofview.V82.of_tactic assumption)
-    g
-
+  observe_tac "finish" (Proofview.V82.of_tactic assumption) g
 
 let refine c = Refiner.refiner ~check:true EConstr.Unsafe.(to_constr c)
-
 let thin l = Proofview.V82.of_tactic (Tactics.clear l)
-
 let eq_constr sigma u v = EConstr.eq_constr_nounivs sigma u v
 
 let is_trivial_eq sigma t =
-  let res =   try
-    begin
+  let res =
+    try
       match EConstr.kind sigma t with
-        | App(f,[|_;t1;t2|]) when eq_constr sigma f (Lazy.force eq) ->
-            eq_constr sigma t1 t2
-        | App(f,[|t1;a1;t2;a2|]) when eq_constr sigma f (jmeq ())  ->
-            eq_constr sigma t1 t2 && eq_constr sigma a1 a2
-        | _ -> false
-    end
-  with e when CErrors.noncritical e -> false
+      | App (f, [|_; t1; t2|]) when eq_constr sigma f (Lazy.force eq) ->
+        eq_constr sigma t1 t2
+      | App (f, [|t1; a1; t2; a2|]) when eq_constr sigma f (jmeq ()) ->
+        eq_constr sigma t1 t2 && eq_constr sigma a1 a2
+      | _ -> false
+    with e when CErrors.noncritical e -> false
   in
-(*   observe (str "is_trivial_eq " ++ Printer.pr_lconstr t ++ (if res then str " true" else str " false")); *)
+  (*   observe (str "is_trivial_eq " ++ Printer.pr_lconstr t ++ (if res then str " true" else str " false")); *)
   res
 
 let rec incompatible_constructor_terms sigma t1 t2 =
-  let c1,arg1 = decompose_app sigma t1
-  and c2,arg2 = decompose_app sigma t2
-  in
-  (not (eq_constr sigma t1 t2)) &&
-    isConstruct sigma c1 && isConstruct sigma c2 &&
-    (
-      not (eq_constr sigma c1 c2) ||
-        List.exists2 (incompatible_constructor_terms sigma) arg1 arg2
-    )
+  let c1, arg1 = decompose_app sigma t1 and c2, arg2 = decompose_app sigma t2 in
+  (not (eq_constr sigma t1 t2))
+  && isConstruct sigma c1 && isConstruct sigma c2
+  && ( (not (eq_constr sigma c1 c2))
+     || List.exists2 (incompatible_constructor_terms sigma) arg1 arg2 )
 
 let is_incompatible_eq env sigma t =
   let res =
     try
       match EConstr.kind sigma t with
-        | App(f,[|_;t1;t2|]) when eq_constr sigma f (Lazy.force eq) ->
-            incompatible_constructor_terms sigma t1 t2
-        | App(f,[|u1;t1;u2;t2|]) when eq_constr sigma f (jmeq ()) ->
-            (eq_constr sigma u1 u2 &&
-               incompatible_constructor_terms sigma t1 t2)
-        | _ -> false
+      | App (f, [|_; t1; t2|]) when eq_constr sigma f (Lazy.force eq) ->
+        incompatible_constructor_terms sigma t1 t2
+      | App (f, [|u1; t1; u2; t2|]) when eq_constr sigma f (jmeq ()) ->
+        eq_constr sigma u1 u2 && incompatible_constructor_terms sigma t1 t2
+      | _ -> false
     with e when CErrors.noncritical e -> false
   in
   if res then observe (str "is_incompatible_eq " ++ pr_leconstr_env env sigma t);
   res
 
 let change_hyp_with_using msg hyp_id t tac : tactic =
-  fun g ->
-    let prov_id = pf_get_new_id hyp_id g in
-    tclTHENS
-      ((* observe_tac msg *) Proofview.V82.of_tactic (assert_by (Name prov_id) t (Proofview.V82.tactic (tclCOMPLETE tac))))
-      [tclTHENLIST
-      [
-        (* observe_tac "change_hyp_with_using thin" *) (thin [hyp_id]);
-        (* observe_tac "change_hyp_with_using rename " *) (Proofview.V82.of_tactic (rename_hyp [prov_id,hyp_id]))
-      ]] g
+ fun g ->
+  let prov_id = pf_get_new_id hyp_id g in
+  tclTHENS
+    ((* observe_tac msg *) Proofview.V82.of_tactic
+       (assert_by (Name prov_id) t (Proofview.V82.tactic (tclCOMPLETE tac))))
+    [ tclTHENLIST
+        [ (* observe_tac "change_hyp_with_using thin" *)
+          thin [hyp_id]
+        ; (* observe_tac "change_hyp_with_using rename " *)
+          Proofview.V82.of_tactic (rename_hyp [(prov_id, hyp_id)]) ] ]
+    g
 
 exception TOREMOVE
 
-
-let prove_trivial_eq h_id context (constructor,type_of_term,term) =
+let prove_trivial_eq h_id context (constructor, type_of_term, term) =
   let nb_intros = List.length context in
   tclTHENLIST
-    [
-      tclDO nb_intros (Proofview.V82.of_tactic intro); (* introducing context *)
+    [ tclDO nb_intros (Proofview.V82.of_tactic intro)
+    ; (* introducing context *)
       (fun g ->
-         let context_hyps =
-           fst (list_chop ~msg:"prove_trivial_eq : " nb_intros (pf_ids_of_hyps g))
-         in
-         let context_hyps' =
-           (mkApp(constructor,[|type_of_term;term|]))::
-             (List.map mkVar context_hyps)
-         in
-         let to_refine = applist(mkVar h_id,List.rev context_hyps') in
-         refine to_refine g
-      )
-    ]
-
-
+        let context_hyps =
+          fst
+            (list_chop ~msg:"prove_trivial_eq : " nb_intros (pf_ids_of_hyps g))
+        in
+        let context_hyps' =
+          mkApp (constructor, [|type_of_term; term|])
+          :: List.map mkVar context_hyps
+        in
+        let to_refine = applist (mkVar h_id, List.rev context_hyps') in
+        refine to_refine g) ]
 
 let find_rectype env sigma c =
-  let (t, l) = decompose_app sigma (Reductionops.whd_betaiotazeta sigma c) in
+  let t, l = decompose_app sigma (Reductionops.whd_betaiotazeta sigma c) in
   match EConstr.kind sigma t with
   | Ind ind -> (t, l)
-  | Construct _ -> (t,l)
+  | Construct _ -> (t, l)
   | _ -> raise Not_found
 
-
-let isAppConstruct ?(env=Global.env ()) sigma t =
+let isAppConstruct ?(env = Global.env ()) sigma t =
   try
-    let t',l = find_rectype env sigma t in
-    observe (str "isAppConstruct : " ++ Printer.pr_leconstr_env env sigma t ++ str " -> " ++
-             Printer.pr_leconstr_env env sigma (applist  (t',l)));
+    let t', l = find_rectype env sigma t in
+    observe
+      ( str "isAppConstruct : "
+      ++ Printer.pr_leconstr_env env sigma t
+      ++ str " -> "
+      ++ Printer.pr_leconstr_env env sigma (applist (t', l)) );
     true
   with Not_found -> false
 
 exception NoChange
 
-let change_eq env sigma hyp_id (context:rel_context) x t end_of_type  =
-  let nochange ?t' msg  =
-    begin
-      observe (str ("Not treating ( "^msg^" )") ++ pr_leconstr_env env sigma t  ++ str "    " ++
-               match t' with None -> str "" | Some t -> Printer.pr_leconstr_env env sigma t );
-      raise NoChange;
-    end
+let change_eq env sigma hyp_id (context : rel_context) x t end_of_type =
+  let nochange ?t' msg =
+    observe
+      ( str ("Not treating ( " ^ msg ^ " )")
+      ++ pr_leconstr_env env sigma t
+      ++ str "    "
+      ++
+      match t' with
+      | None -> str ""
+      | Some t -> Printer.pr_leconstr_env env sigma t );
+    raise NoChange
   in
   let eq_constr c1 c2 =
-    try ignore(Evarconv.unify_delay env sigma c1 c2); true
-    with Evarconv.UnableToUnify _ -> false in
-  if not (noccurn sigma 1 end_of_type)
-  then nochange "dependent"; (* if end_of_type depends on this term we don't touch it  *)
-    if not (isApp sigma t) then nochange "not an equality";
-    let f_eq,args = destApp sigma t in
-    let constructor,t1,t2,t1_typ =
+    try
+      ignore (Evarconv.unify_delay env sigma c1 c2);
+      true
+    with Evarconv.UnableToUnify _ -> false
+  in
+  if not (noccurn sigma 1 end_of_type) then nochange "dependent";
+  (* if end_of_type depends on this term we don't touch it  *)
+  if not (isApp sigma t) then nochange "not an equality";
+  let f_eq, args = destApp sigma t in
+  let constructor, t1, t2, t1_typ =
+    try
+      if eq_constr f_eq (Lazy.force eq) then
+        let t1 = (args.(1), args.(0))
+        and t2 = (args.(2), args.(0))
+        and t1_typ = args.(0) in
+        (Lazy.force refl_equal, t1, t2, t1_typ)
+      else if eq_constr f_eq (jmeq ()) then
+        (jmeq_refl (), (args.(1), args.(0)), (args.(3), args.(2)), args.(0))
+      else nochange "not an equality"
+    with e when CErrors.noncritical e -> nochange "not an equality"
+  in
+  if not (closed0 sigma (fst t1) && closed0 sigma (snd t1)) then
+    nochange "not a closed lhs";
+  let rec compute_substitution sub t1 t2 =
+    (*       observe (str "compute_substitution : " ++ pr_lconstr t1 ++ str " === " ++ pr_lconstr t2); *)
+    if isRel sigma t2 then (
+      let t2 = destRel sigma t2 in
       try
-        if (eq_constr f_eq (Lazy.force eq))
-        then
-          let t1 = (args.(1),args.(0))
-          and t2 = (args.(2),args.(0))
-          and t1_typ = args.(0)
-          in
-          (Lazy.force refl_equal,t1,t2,t1_typ)
-        else
-          if (eq_constr f_eq (jmeq ()))
-          then
-            (jmeq_refl (),(args.(1),args.(0)),(args.(3),args.(2)),args.(0))
-          else nochange "not an equality"
-      with e when CErrors.noncritical e -> nochange "not an equality"
-    in
-    if not ((closed0 sigma (fst t1)) && (closed0 sigma (snd t1)))then nochange "not a closed lhs";
-    let rec compute_substitution sub t1 t2 =
-(*       observe (str "compute_substitution : " ++ pr_lconstr t1 ++ str " === " ++ pr_lconstr t2); *)
-      if isRel sigma t2
-      then
-        let t2 = destRel sigma t2  in
-        begin
-          try
-            let t1' = Int.Map.find t2 sub in
-            if not (eq_constr t1 t1') then nochange "twice bound variable";
-            sub
-          with Not_found ->
-            assert (closed0 sigma t1);
-            Int.Map.add t2 t1 sub
-        end
-      else if isAppConstruct sigma t1 && isAppConstruct sigma t2
-      then
-        begin
-          let c1,args1 =  find_rectype env sigma t1
-          and c2,args2 = find_rectype env sigma t2
-          in
-          if not (eq_constr c1 c2) then nochange "cannot solve (diff)";
-          List.fold_left2 compute_substitution sub args1 args2
-        end
-      else
-        if (eq_constr t1 t2) then sub else nochange ~t':(make_refl_eq constructor (Reductionops.whd_all env sigma t1) t2)  "cannot solve (diff)"
-    in
-    let sub = compute_substitution Int.Map.empty (snd t1) (snd t2) in
-    let sub = compute_substitution sub (fst t1) (fst t2) in
-    let end_of_type_with_pop = pop end_of_type in (*the equation will be removed *)
-    let new_end_of_type =
-      (* Ugly hack to prevent Map.fold order change between ocaml-3.08.3 and ocaml-3.08.4
-         Can be safely replaced by the next comment for Ocaml >= 3.08.4
-      *)
-      let sub = Int.Map.bindings sub in
-      List.fold_left (fun end_of_type (i,t)  -> liftn 1 i (substnl  [t] (i-1) end_of_type))
-        end_of_type_with_pop
+        let t1' = Int.Map.find t2 sub in
+        if not (eq_constr t1 t1') then nochange "twice bound variable";
         sub
-    in
-    let old_context_length = List.length context + 1 in
-    let witness_fun =
-      mkLetIn(make_annot Anonymous Sorts.Relevant,make_refl_eq constructor t1_typ (fst t1),t,
-               mkApp(mkVar hyp_id,Array.init old_context_length (fun i -> mkRel (old_context_length - i)))
-              )
-    in
-    let new_type_of_hyp,ctxt_size,witness_fun =
-      List.fold_left_i
-        (fun i (end_of_type,ctxt_size,witness_fun) decl ->
-           try
-             let witness = Int.Map.find i sub in
-             if is_local_def decl then anomaly (Pp.str "can not redefine a rel!");
-      (pop end_of_type,ctxt_size,mkLetIn (RelDecl.get_annot decl,
-                                            witness, RelDecl.get_type decl, witness_fun))
-           with Not_found  ->
-             (mkProd_or_LetIn decl end_of_type, ctxt_size + 1, mkLambda_or_LetIn decl witness_fun)
-        )
-        1
-        (new_end_of_type,0,witness_fun)
-        context
-    in
-    let new_type_of_hyp =
-      Reductionops.nf_betaiota env sigma new_type_of_hyp in
-    let new_ctxt,new_end_of_type =
-      decompose_prod_n_assum sigma ctxt_size new_type_of_hyp
-    in
-    let prove_new_hyp : tactic =
-      tclTHEN
-        (tclDO ctxt_size (Proofview.V82.of_tactic intro))
-        (fun g ->
-           let all_ids = pf_ids_of_hyps g in
-           let new_ids,_  = list_chop ctxt_size all_ids in
-           let to_refine = applist(witness_fun,List.rev_map mkVar new_ids) in
-           let evm, _ = pf_apply Typing.type_of g to_refine in
-             tclTHEN (Refiner.tclEVARS evm) (refine to_refine) g
-        )
-    in
-    let simpl_eq_tac =
-      change_hyp_with_using "prove_pattern_simplification" hyp_id new_type_of_hyp prove_new_hyp
-    in
-(*     observe (str "In " ++ Ppconstr.pr_id hyp_id ++  *)
-(*             str "removing an equation " ++ fnl ()++  *)
-(*             str "old_typ_of_hyp :=" ++ *)
-(*             Printer.pr_lconstr_env *)
-(*             env *)
-(*             (it_mkProd_or_LetIn ~init:end_of_type ((x,None,t)::context)) *)
-(*           ++ fnl () ++ *)
-(*             str "new_typ_of_hyp := "++  *)
-(*             Printer.pr_lconstr_env env new_type_of_hyp ++ fnl () *)
-(*           ++ str "old context := " ++ pr_rel_context env context ++ fnl ()  *)
-(*           ++ str "new context := " ++ pr_rel_context env new_ctxt ++ fnl ()  *)
-(*           ++ str "old type  := " ++ pr_lconstr end_of_type ++ fnl ()  *)
-(*           ++ str "new type := " ++ pr_lconstr new_end_of_type ++ fnl ()  *)
-(* ); *)
-    new_ctxt,new_end_of_type,simpl_eq_tac
-
-
-let is_property sigma (ptes_info:ptes_info) t_x full_type_of_hyp =
-  if isApp sigma t_x
-  then
-    let pte,args = destApp sigma t_x in
-    if isVar sigma pte && Array.for_all (closed0 sigma) args
-    then
+      with Not_found ->
+        assert (closed0 sigma t1);
+        Int.Map.add t2 t1 sub )
+    else if isAppConstruct sigma t1 && isAppConstruct sigma t2 then begin
+      let c1, args1 = find_rectype env sigma t1
+      and c2, args2 = find_rectype env sigma t2 in
+      if not (eq_constr c1 c2) then nochange "cannot solve (diff)";
+      List.fold_left2 compute_substitution sub args1 args2
+    end
+    else if eq_constr t1 t2 then sub
+    else
+      nochange
+        ~t':(make_refl_eq constructor (Reductionops.whd_all env sigma t1) t2)
+        "cannot solve (diff)"
+  in
+  let sub = compute_substitution Int.Map.empty (snd t1) (snd t2) in
+  let sub = compute_substitution sub (fst t1) (fst t2) in
+  let end_of_type_with_pop = pop end_of_type in
+  (*the equation will be removed *)
+  let new_end_of_type =
+    (* Ugly hack to prevent Map.fold order change between ocaml-3.08.3 and ocaml-3.08.4
+       Can be safely replaced by the next comment for Ocaml >= 3.08.4
+    *)
+    let sub = Int.Map.bindings sub in
+    List.fold_left
+      (fun end_of_type (i, t) -> liftn 1 i (substnl [t] (i - 1) end_of_type))
+      end_of_type_with_pop sub
+  in
+  let old_context_length = List.length context + 1 in
+  let witness_fun =
+    mkLetIn
+      ( make_annot Anonymous Sorts.Relevant
+      , make_refl_eq constructor t1_typ (fst t1)
+      , t
+      , mkApp
+          ( mkVar hyp_id
+          , Array.init old_context_length (fun i ->
+                mkRel (old_context_length - i)) ) )
+  in
+  let new_type_of_hyp, ctxt_size, witness_fun =
+    List.fold_left_i
+      (fun i (end_of_type, ctxt_size, witness_fun) decl ->
+        try
+          let witness = Int.Map.find i sub in
+          if is_local_def decl then anomaly (Pp.str "can not redefine a rel!");
+          ( pop end_of_type
+          , ctxt_size
+          , mkLetIn
+              ( RelDecl.get_annot decl
+              , witness
+              , RelDecl.get_type decl
+              , witness_fun ) )
+        with Not_found ->
+          ( mkProd_or_LetIn decl end_of_type
+          , ctxt_size + 1
+          , mkLambda_or_LetIn decl witness_fun ))
+      1
+      (new_end_of_type, 0, witness_fun)
+      context
+  in
+  let new_type_of_hyp = Reductionops.nf_betaiota env sigma new_type_of_hyp in
+  let new_ctxt, new_end_of_type =
+    decompose_prod_n_assum sigma ctxt_size new_type_of_hyp
+  in
+  let prove_new_hyp : tactic =
+    tclTHEN
+      (tclDO ctxt_size (Proofview.V82.of_tactic intro))
+      (fun g ->
+        let all_ids = pf_ids_of_hyps g in
+        let new_ids, _ = list_chop ctxt_size all_ids in
+        let to_refine = applist (witness_fun, List.rev_map mkVar new_ids) in
+        let evm, _ = pf_apply Typing.type_of g to_refine in
+        tclTHEN (Refiner.tclEVARS evm) (refine to_refine) g)
+  in
+  let simpl_eq_tac =
+    change_hyp_with_using "prove_pattern_simplification" hyp_id new_type_of_hyp
+      prove_new_hyp
+  in
+  (*     observe (str "In " ++ Ppconstr.pr_id hyp_id ++  *)
+  (*             str "removing an equation " ++ fnl ()++  *)
+  (*             str "old_typ_of_hyp :=" ++ *)
+  (*             Printer.pr_lconstr_env *)
+  (*             env *)
+  (*             (it_mkProd_or_LetIn ~init:end_of_type ((x,None,t)::context)) *)
+  (*           ++ fnl () ++ *)
+  (*             str "new_typ_of_hyp := "++  *)
+  (*             Printer.pr_lconstr_env env new_type_of_hyp ++ fnl () *)
+  (*           ++ str "old context := " ++ pr_rel_context env context ++ fnl ()  *)
+  (*           ++ str "new context := " ++ pr_rel_context env new_ctxt ++ fnl ()  *)
+  (*           ++ str "old type  := " ++ pr_lconstr end_of_type ++ fnl ()  *)
+  (*           ++ str "new type := " ++ pr_lconstr new_end_of_type ++ fnl ()  *)
+  (* ); *)
+  (new_ctxt, new_end_of_type, simpl_eq_tac)
+
+let is_property sigma (ptes_info : ptes_info) t_x full_type_of_hyp =
+  if isApp sigma t_x then
+    let pte, args = destApp sigma t_x in
+    if isVar sigma pte && Array.for_all (closed0 sigma) args then
       try
         let info = Id.Map.find (destVar sigma pte) ptes_info in
         info.is_valid full_type_of_hyp
@@ -297,19 +282,13 @@ let is_property sigma (ptes_info:ptes_info) t_x full_type_of_hyp =
   else false
 
 let isLetIn sigma t =
-  match EConstr.kind sigma t with
-    | LetIn _ -> true
-    | _ -> false
-
+  match EConstr.kind sigma t with LetIn _ -> true | _ -> false
 
 let h_reduce_with_zeta cl =
-  Proofview.V82.of_tactic (reduce
-    (Genredexpr.Cbv
-       {Redops.all_flags
-        with Genredexpr.rDelta = false;
-       }) cl)
-
-
+  Proofview.V82.of_tactic
+    (reduce
+       (Genredexpr.Cbv {Redops.all_flags with Genredexpr.rDelta = false})
+       cl)
 
 let rewrite_until_var arg_num eq_ids : tactic =
   (* tests if the declares recursive argument is neither a Constructor nor
@@ -318,268 +297,247 @@ let rewrite_until_var arg_num eq_ids : tactic =
   *)
   let test_var g =
     let sigma = project g in
-    let _,args = destApp sigma (pf_concl g) in
-    not ((isConstruct sigma args.(arg_num)) || isAppConstruct sigma args.(arg_num))
+    let _, args = destApp sigma (pf_concl g) in
+    not (isConstruct sigma args.(arg_num) || isAppConstruct sigma args.(arg_num))
   in
-  let rec do_rewrite eq_ids g  =
-    if test_var g
-    then tclIDTAC g
+  let rec do_rewrite eq_ids g =
+    if test_var g then tclIDTAC g
     else
       match eq_ids with
-        | [] -> anomaly (Pp.str "Cannot find a way to prove recursive property.");
-        | eq_id::eq_ids ->
-            tclTHEN
-              (tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar eq_id))))
-              (do_rewrite eq_ids)
-              g
+      | [] -> anomaly (Pp.str "Cannot find a way to prove recursive property.")
+      | eq_id :: eq_ids ->
+        tclTHEN
+          (tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar eq_id))))
+          (do_rewrite eq_ids) g
   in
   do_rewrite eq_ids
 
-
 let rec_pte_id = Id.of_string "Hrec"
+
 let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
-  let coq_False = EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.False.type") in
-  let coq_True = EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.type") in
-  let coq_I = EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.I") in
-  let rec scan_type  context type_of_hyp : tactic =
+  let coq_False =
+    EConstr.of_constr
+      (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.False.type")
+  in
+  let coq_True =
+    EConstr.of_constr
+      (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.type")
+  in
+  let coq_I =
+    EConstr.of_constr
+      (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.I")
+  in
+  let rec scan_type context type_of_hyp : tactic =
     if isLetIn sigma type_of_hyp then
       let real_type_of_hyp = it_mkProd_or_LetIn type_of_hyp context in
-      let reduced_type_of_hyp = Reductionops.nf_betaiotazeta env sigma real_type_of_hyp in
+      let reduced_type_of_hyp =
+        Reductionops.nf_betaiotazeta env sigma real_type_of_hyp
+      in
       (* length of context didn't change ? *)
-      let new_context,new_typ_of_hyp =
-         decompose_prod_n_assum sigma (List.length context) reduced_type_of_hyp
+      let new_context, new_typ_of_hyp =
+        decompose_prod_n_assum sigma (List.length context) reduced_type_of_hyp
       in
+      tclTHENLIST
+        [ h_reduce_with_zeta (Locusops.onHyp hyp_id)
+        ; scan_type new_context new_typ_of_hyp ]
+    else if isProd sigma type_of_hyp then
+      let x, t_x, t' = destProd sigma type_of_hyp in
+      let actual_real_type_of_hyp = it_mkProd_or_LetIn t' context in
+      if is_property sigma ptes_infos t_x actual_real_type_of_hyp then
+        let pte, pte_args = destApp sigma t_x in
+        let (* fix_info *) prove_rec_hyp =
+          (Id.Map.find (destVar sigma pte) ptes_infos).proving_tac
+        in
+        let popped_t' = pop t' in
+        let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
+        let prove_new_type_of_hyp =
+          let context_length = List.length context in
+          tclTHENLIST
+            [ tclDO context_length (Proofview.V82.of_tactic intro)
+            ; (fun g ->
+                let context_hyps_ids =
+                  fst
+                    (list_chop ~msg:"rec hyp : context_hyps" context_length
+                       (pf_ids_of_hyps g))
+                in
+                let rec_pte_id = pf_get_new_id rec_pte_id g in
+                let to_refine =
+                  applist
+                    ( mkVar hyp_id
+                    , List.rev_map mkVar (rec_pte_id :: context_hyps_ids) )
+                in
+                (*                   observe_tac "rec hyp " *)
+                (tclTHENS
+                   (Proofview.V82.of_tactic
+                      (assert_before (Name rec_pte_id) t_x))
+                   [ (* observe_tac "prove rec hyp" *)
+                     prove_rec_hyp eq_hyps
+                   ; (*                      observe_tac "prove rec hyp" *)
+                     refine to_refine ])
+                  g) ]
+        in
         tclTHENLIST
-        [ h_reduce_with_zeta (Locusops.onHyp hyp_id);
-          scan_type new_context new_typ_of_hyp ]
-    else if isProd sigma type_of_hyp
-    then
-      begin
-        let (x,t_x,t') = destProd sigma type_of_hyp in
-        let actual_real_type_of_hyp = it_mkProd_or_LetIn t' context in
-        if is_property sigma ptes_infos t_x actual_real_type_of_hyp then
-          begin
-            let pte,pte_args =  (destApp sigma t_x) in
-            let (* fix_info *) prove_rec_hyp = (Id.Map.find (destVar sigma pte) ptes_infos).proving_tac in
-            let popped_t' = pop t' in
-            let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
-            let prove_new_type_of_hyp =
-              let context_length = List.length context in
-              tclTHENLIST
-                [
-                  tclDO context_length (Proofview.V82.of_tactic intro);
-                  (fun g ->
-                     let context_hyps_ids =
-                       fst (list_chop ~msg:"rec hyp : context_hyps"
-                              context_length (pf_ids_of_hyps g))
-                     in
-                     let rec_pte_id = pf_get_new_id rec_pte_id g in
-                     let to_refine =
-                       applist(mkVar hyp_id,
-                               List.rev_map mkVar (rec_pte_id::context_hyps_ids)
-                              )
-                     in
-(*                   observe_tac "rec hyp " *)
-                       (tclTHENS
-                       (Proofview.V82.of_tactic (assert_before (Name rec_pte_id) t_x))
-                       [
-                         (* observe_tac "prove rec hyp" *) (prove_rec_hyp eq_hyps);
-(*                      observe_tac "prove rec hyp" *)
-                          (refine to_refine)
-                       ])
-                       g
-                  )
-                ]
-            in
-            tclTHENLIST
-              [
-(*              observe_tac "hyp rec"  *)
-                  (change_hyp_with_using "rec_hyp_tac" hyp_id real_type_of_hyp prove_new_type_of_hyp);
-                scan_type context popped_t'
-              ]
-          end
-        else if eq_constr sigma t_x coq_False then
-          begin
-(*          observe (str "Removing : "++ Ppconstr.pr_id hyp_id++  *)
-(*                     str " since it has False in its preconds " *)
-(*                  ); *)
-            raise TOREMOVE;  (* False -> .. useless *)
-          end
-        else if is_incompatible_eq env sigma t_x then raise TOREMOVE (* t_x := C1 ... =  C2 ... *)
-        else if eq_constr sigma t_x coq_True  (* Trivial => we remove this precons *)
-        then
-(*          observe (str "In "++Ppconstr.pr_id hyp_id++  *)
-(*                     str " removing useless precond True" *)
-(*                  );  *)
-          let popped_t' = pop t' in
-          let real_type_of_hyp =
-            it_mkProd_or_LetIn popped_t' context
-          in
-          let prove_trivial =
-            let nb_intro = List.length context in
-            tclTHENLIST [
-              tclDO nb_intro (Proofview.V82.of_tactic intro);
-              (fun g ->
-                 let context_hyps =
-                   fst (list_chop ~msg:"removing True : context_hyps "nb_intro (pf_ids_of_hyps g))
-                 in
-                 let to_refine =
-                   applist (mkVar hyp_id,
-                            List.rev (coq_I::List.map mkVar context_hyps)
-                           )
-                 in
-                 refine to_refine g
-              )
-            ]
-          in
-          tclTHENLIST[
-            change_hyp_with_using "prove_trivial" hyp_id real_type_of_hyp
-              ((* observe_tac "prove_trivial" *) prove_trivial);
-            scan_type context popped_t'
-          ]
-        else if is_trivial_eq sigma t_x
-        then (*  t_x :=  t = t   => we remove this precond *)
-          let popped_t' = pop t' in
-          let real_type_of_hyp =
-            it_mkProd_or_LetIn popped_t' context
-          in
-          let hd,args = destApp sigma t_x in
-          let get_args hd args =
-            if eq_constr sigma hd (Lazy.force eq)
-            then (Lazy.force refl_equal,args.(0),args.(1))
-            else (jmeq_refl (),args.(0),args.(1))
-          in
+          [ (*              observe_tac "hyp rec"  *)
+            change_hyp_with_using "rec_hyp_tac" hyp_id real_type_of_hyp
+              prove_new_type_of_hyp
+          ; scan_type context popped_t' ]
+      else if eq_constr sigma t_x coq_False then
+        (*          observe (str "Removing : "++ Ppconstr.pr_id hyp_id++  *)
+        (*                     str " since it has False in its preconds " *)
+        (*                  ); *)
+        raise TOREMOVE (* False -> .. useless *)
+      else if is_incompatible_eq env sigma t_x then raise TOREMOVE
+        (* t_x := C1 ... =  C2 ... *)
+      else if
+        eq_constr sigma t_x coq_True (* Trivial => we remove this precons *)
+      then
+        (*          observe (str "In "++Ppconstr.pr_id hyp_id++  *)
+        (*                     str " removing useless precond True" *)
+        (*                  );  *)
+        let popped_t' = pop t' in
+        let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
+        let prove_trivial =
+          let nb_intro = List.length context in
           tclTHENLIST
-            [
-              change_hyp_with_using
-                "prove_trivial_eq"
-                hyp_id
-                real_type_of_hyp
-                ((* observe_tac "prove_trivial_eq" *)
-                  (prove_trivial_eq hyp_id context (get_args hd args)));
-              scan_type context popped_t'
-            ]
-        else
-          begin
-            try
-              let new_context,new_t',tac = change_eq env sigma hyp_id context x t_x t' in
-              tclTHEN
-                tac
-                (scan_type new_context new_t')
-            with NoChange ->
-              (* Last thing todo : push the rel in the context and continue *)
-              scan_type (LocalAssum (x,t_x) :: context) t'
-          end
-      end
-    else
-      tclIDTAC
-  in
-  try
-    scan_type [] (Typing.type_of_variable env hyp_id), [hyp_id]
-  with TOREMOVE ->
-    thin [hyp_id],[]
-
-
-let clean_goal_with_heq ptes_infos continue_tac (dyn_infos:body_info) =
-  fun g ->
-    let env = pf_env g
-    and sigma = project g
-    in
-    let tac,new_hyps =
-      List.fold_left (
-        fun (hyps_tac,new_hyps) hyp_id ->
-          let hyp_tac,new_hyp =
-            clean_hyp_with_heq ptes_infos dyn_infos.eq_hyps hyp_id env sigma
+            [ tclDO nb_intro (Proofview.V82.of_tactic intro)
+            ; (fun g ->
+                let context_hyps =
+                  fst
+                    (list_chop ~msg:"removing True : context_hyps " nb_intro
+                       (pf_ids_of_hyps g))
+                in
+                let to_refine =
+                  applist
+                    ( mkVar hyp_id
+                    , List.rev (coq_I :: List.map mkVar context_hyps) )
+                in
+                refine to_refine g) ]
+        in
+        tclTHENLIST
+          [ change_hyp_with_using "prove_trivial" hyp_id real_type_of_hyp
+              (* observe_tac "prove_trivial" *) prove_trivial
+          ; scan_type context popped_t' ]
+      else if is_trivial_eq sigma t_x then
+        (*  t_x :=  t = t   => we remove this precond *)
+        let popped_t' = pop t' in
+        let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
+        let hd, args = destApp sigma t_x in
+        let get_args hd args =
+          if eq_constr sigma hd (Lazy.force eq) then
+            (Lazy.force refl_equal, args.(0), args.(1))
+          else (jmeq_refl (), args.(0), args.(1))
+        in
+        tclTHENLIST
+          [ change_hyp_with_using "prove_trivial_eq" hyp_id real_type_of_hyp
+              ((* observe_tac "prove_trivial_eq" *)
+               prove_trivial_eq hyp_id context (get_args hd args))
+          ; scan_type context popped_t' ]
+      else
+        try
+          let new_context, new_t', tac =
+            change_eq env sigma hyp_id context x t_x t'
           in
-          (tclTHEN hyp_tac hyps_tac),new_hyp@new_hyps
-      )
-        (tclIDTAC,[])
-        dyn_infos.rec_hyps
-    in
-    let new_infos =
-      { dyn_infos with
-          rec_hyps = new_hyps;
-          nb_rec_hyps  = List.length new_hyps
-      }
-    in
-    tclTHENLIST
-      [
-        tac ;
-        (* observe_tac "clean_hyp_with_heq continue" *) (continue_tac new_infos)
-      ]
-      g
+          tclTHEN tac (scan_type new_context new_t')
+        with NoChange ->
+          (* Last thing todo : push the rel in the context and continue *)
+          scan_type (LocalAssum (x, t_x) :: context) t'
+    else tclIDTAC
+  in
+  try (scan_type [] (Typing.type_of_variable env hyp_id), [hyp_id])
+  with TOREMOVE -> (thin [hyp_id], [])
+
+let clean_goal_with_heq ptes_infos continue_tac (dyn_infos : body_info) g =
+  let env = pf_env g and sigma = project g in
+  let tac, new_hyps =
+    List.fold_left
+      (fun (hyps_tac, new_hyps) hyp_id ->
+        let hyp_tac, new_hyp =
+          clean_hyp_with_heq ptes_infos dyn_infos.eq_hyps hyp_id env sigma
+        in
+        (tclTHEN hyp_tac hyps_tac, new_hyp @ new_hyps))
+      (tclIDTAC, []) dyn_infos.rec_hyps
+  in
+  let new_infos =
+    {dyn_infos with rec_hyps = new_hyps; nb_rec_hyps = List.length new_hyps}
+  in
+  tclTHENLIST
+    [tac; (* observe_tac "clean_hyp_with_heq continue" *) continue_tac new_infos]
+    g
 
 let heq_id = Id.of_string "Heq"
 
-let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
-  fun g ->
-    let nb_first_intro = nb_prod - 1 - dyn_infos.nb_rec_hyps in
-    tclTHENLIST
-      [
-        (* We first introduce the variables *)
-        tclDO nb_first_intro (Proofview.V82.of_tactic (intro_avoiding (Id.Set.of_list dyn_infos.rec_hyps)));
-        (* Then the equation itself *)
-        Proofview.V82.of_tactic (intro_using heq_id);
-        onLastHypId (fun heq_id -> tclTHENLIST [
-        (* Then the new hypothesis *)
-        tclMAP (fun id -> Proofview.V82.of_tactic (introduction id)) dyn_infos.rec_hyps;
-        observe_tac "after_introduction" (fun g' ->
-           (* We get infos on the equations introduced*)
-           let new_term_value_eq = pf_get_hyp_typ g' heq_id in
-           (* compute the new value of the body *)
-           let new_term_value =
-             match EConstr.kind (project g') new_term_value_eq with
-               | App(f,[| _;_;args2 |]) -> args2
-               | _ ->
-                   observe (str "cannot compute new term value : " ++ pr_gls g' ++ fnl () ++ str "last hyp is" ++
-                              pr_leconstr_env (pf_env g') (project g') new_term_value_eq
-                           );
-                   anomaly (Pp.str "cannot compute new term value.")
-           in
-           let g', termtyp = tac_type_of g' term in
-           let fun_body =
-             mkLambda(make_annot Anonymous Sorts.Relevant,
-                      termtyp,
-                      Termops.replace_term (project g') term (mkRel 1) dyn_infos.info
-                     )
-           in
-           let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in
-           let new_infos =
-             {dyn_infos with
-              info = new_body;
-              eq_hyps = heq_id::dyn_infos.eq_hyps
-             }
-           in
-           clean_goal_with_heq ptes_infos continue_tac new_infos  g'
-          )])
-      ]
-      g
-
+let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos g =
+  let nb_first_intro = nb_prod - 1 - dyn_infos.nb_rec_hyps in
+  tclTHENLIST
+    [ (* We first introduce the variables *)
+      tclDO nb_first_intro
+        (Proofview.V82.of_tactic
+           (intro_avoiding (Id.Set.of_list dyn_infos.rec_hyps)))
+    ; (* Then the equation itself *)
+      Proofview.V82.of_tactic (intro_using heq_id)
+    ; onLastHypId (fun heq_id ->
+          tclTHENLIST
+            [ (* Then the new hypothesis *)
+              tclMAP
+                (fun id -> Proofview.V82.of_tactic (introduction id))
+                dyn_infos.rec_hyps
+            ; observe_tac "after_introduction" (fun g' ->
+                  (* We get infos on the equations introduced*)
+                  let new_term_value_eq = pf_get_hyp_typ g' heq_id in
+                  (* compute the new value of the body *)
+                  let new_term_value =
+                    match EConstr.kind (project g') new_term_value_eq with
+                    | App (f, [|_; _; args2|]) -> args2
+                    | _ ->
+                      observe
+                        ( str "cannot compute new term value : "
+                        ++ pr_gls g' ++ fnl () ++ str "last hyp is"
+                        ++ pr_leconstr_env (pf_env g') (project g')
+                             new_term_value_eq );
+                      anomaly (Pp.str "cannot compute new term value.")
+                  in
+                  let g', termtyp = tac_type_of g' term in
+                  let fun_body =
+                    mkLambda
+                      ( make_annot Anonymous Sorts.Relevant
+                      , termtyp
+                      , Termops.replace_term (project g') term (mkRel 1)
+                          dyn_infos.info )
+                  in
+                  let new_body =
+                    pf_nf_betaiota g' (mkApp (fun_body, [|new_term_value|]))
+                  in
+                  let new_infos =
+                    { dyn_infos with
+                      info = new_body
+                    ; eq_hyps = heq_id :: dyn_infos.eq_hyps }
+                  in
+                  clean_goal_with_heq ptes_infos continue_tac new_infos g') ])
+    ]
+    g
 
 let my_orelse tac1 tac2 g =
-  try
-    tac1 g
+  try tac1 g
   with e when CErrors.noncritical e ->
-(*     observe (str "using snd tac since : " ++ CErrors.print e); *)
+    (*     observe (str "using snd tac since : " ++ CErrors.print e); *)
     tac2 g
 
-let instantiate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
-  let args = Array.of_list (List.map mkVar  args_id) in
+let instantiate_hyps_with_args (do_prove : Id.t list -> tactic) hyps args_id =
+  let args = Array.of_list (List.map mkVar args_id) in
   let instantiate_one_hyp hid =
     my_orelse
-      ( (* we instantiate the hyp if possible  *)
-        fun g ->
-          let prov_hid = pf_get_new_id hid g in
-          let c = mkApp(mkVar hid,args) in
-          let evm, _ = pf_apply Typing.type_of g c in
-          tclTHENLIST[
-            Refiner.tclEVARS evm;
-            Proofview.V82.of_tactic (pose_proof (Name prov_hid) c);
-            thin [hid];
-            Proofview.V82.of_tactic (rename_hyp [prov_hid,hid])
-          ] g
-      )
-      ( (*
+      (fun (* we instantiate the hyp if possible  *)
+             g ->
+        let prov_hid = pf_get_new_id hid g in
+        let c = mkApp (mkVar hid, args) in
+        let evm, _ = pf_apply Typing.type_of g c in
+        tclTHENLIST
+          [ Refiner.tclEVARS evm
+          ; Proofview.V82.of_tactic (pose_proof (Name prov_hid) c)
+          ; thin [hid]
+          ; Proofview.V82.of_tactic (rename_hyp [(prov_hid, hid)]) ]
+          g)
+      (fun (*
           if not then we are in a mutual function block
           and this hyp is a recursive hyp on an other function.
 
@@ -587,350 +545,314 @@ let instantiate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
           principle so that we can trash it
 
         *)
-        (fun g ->
-(*         observe (str "Instantiation: removing hyp " ++ Ppconstr.pr_id hid); *)
-           thin [hid] g
-        )
-      )
+             g ->
+        (*         observe (str "Instantiation: removing hyp " ++ Ppconstr.pr_id hid); *)
+        thin [hid] g)
   in
-  if List.is_empty args_id
-  then
-    tclTHENLIST [
-      tclMAP (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id)) hyps;
-      do_prove hyps
-    ]
+  if List.is_empty args_id then
+    tclTHENLIST
+      [ tclMAP (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id)) hyps
+      ; do_prove hyps ]
   else
     tclTHENLIST
-      [
-        tclMAP (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id)) hyps;
-        tclMAP instantiate_one_hyp hyps;
-        (fun g ->
-           let all_g_hyps_id =
-             List.fold_right Id.Set.add (pf_ids_of_hyps g) Id.Set.empty
-           in
-           let remaining_hyps =
-             List.filter (fun id -> Id.Set.mem id all_g_hyps_id) hyps
-           in
-           do_prove remaining_hyps g
-          )
-      ]
+      [ tclMAP (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id)) hyps
+      ; tclMAP instantiate_one_hyp hyps
+      ; (fun g ->
+          let all_g_hyps_id =
+            List.fold_right Id.Set.add (pf_ids_of_hyps g) Id.Set.empty
+          in
+          let remaining_hyps =
+            List.filter (fun id -> Id.Set.mem id all_g_hyps_id) hyps
+          in
+          do_prove remaining_hyps g) ]
 
-let build_proof
-    (interactive_proof:bool)
-    (fnames:Constant.t list)
-    ptes_infos
-    dyn_infos
-    : tactic =
+let build_proof (interactive_proof : bool) (fnames : Constant.t list) ptes_infos
+    dyn_infos : tactic =
   let rec build_proof_aux do_finalize dyn_infos : tactic =
-    fun g ->
-        let env = pf_env g in
-        let sigma = project g in
-(*      observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*)
-        match EConstr.kind sigma dyn_infos.info with
-          | Case(ci,ct,t,cb) ->
-              let do_finalize_t dyn_info' =
-                fun g ->
-                  let t = dyn_info'.info in
-                  let dyn_infos = {dyn_info' with info =
-                      mkCase(ci,ct,t,cb)} in
-                  let g_nb_prod = nb_prod (project g) (pf_concl g) in
-                  let g, type_of_term = tac_type_of g t in
-                  let term_eq =
-                    make_refl_eq (Lazy.force refl_equal) type_of_term t
-                  in
-                  tclTHENLIST
-                    [
-                      Proofview.V82.of_tactic (generalize (term_eq::(List.map mkVar dyn_infos.rec_hyps)));
-                      thin dyn_infos.rec_hyps;
-                      Proofview.V82.of_tactic (pattern_option [Locus.AllOccurrencesBut [1],t] None);
-                      (fun g -> observe_tac "toto" (
-                         tclTHENLIST [Proofview.V82.of_tactic (Simple.case t);
-                                     (fun g' ->
-                                        let g'_nb_prod = nb_prod (project g') (pf_concl g') in
-                                        let nb_instantiate_partial = g'_nb_prod - g_nb_prod in
-                                        observe_tac "treat_new_case"
-                                          (treat_new_case
-                                             ptes_infos
-                                             nb_instantiate_partial
-                                             (build_proof do_finalize)
-                                             t
-                                             dyn_infos)
-                                          g'
-                                     )
-
-                                    ]) g
-                      )
-                    ]
-                    g
-              in
-              build_proof do_finalize_t {dyn_infos with info = t} g
-          | Lambda(n,t,b) ->
-              begin
-                match EConstr.kind sigma (pf_concl g) with
-                  | Prod _ ->
-                      tclTHEN
-                        (Proofview.V82.of_tactic intro)
-                        (fun g' ->
-                           let open Context.Named.Declaration in
-                           let id = pf_last_hyp g' |> get_id in
-                           let new_term =
-                             pf_nf_betaiota g'
-                               (mkApp(dyn_infos.info,[|mkVar id|]))
-                           in
-                           let new_infos = {dyn_infos with info = new_term} in
-                           let do_prove new_hyps =
-                             build_proof do_finalize
-                               {new_infos with
-                                  rec_hyps = new_hyps;
-                                  nb_rec_hyps  = List.length new_hyps
-                               }
-                           in
-(*                         observe_tac "Lambda" *) (instantiate_hyps_with_args do_prove new_infos.rec_hyps [id]) g'
-                             (*                            build_proof do_finalize new_infos g' *)
-                        ) g
-                  | _ ->
-                      do_finalize dyn_infos g
-              end
-          | Cast(t,_,_) ->
-              build_proof do_finalize {dyn_infos with info = t} g
-          | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ | Int _ | Float _ ->
-              do_finalize dyn_infos g
-          | App(_,_) ->
-              let f,args = decompose_app sigma dyn_infos.info in
-              begin
-                match EConstr.kind sigma f with
-                  | Int _ -> user_err Pp.(str "integer cannot be applied")
-                  | Float _ -> user_err Pp.(str "float cannot be applied")
-                  | App _ -> assert false (* we have collected all the app in decompose_app *)
-                  | Proj _ -> assert false (*FIXME*)
-                  | Var _ | Construct _ | Rel _ | Evar _ | Meta _  | Ind _ | Sort _ | Prod _ ->
-                      let new_infos =
-                        { dyn_infos with
-                            info = (f,args)
-                        }
-                      in
-                      build_proof_args env sigma do_finalize new_infos  g
-                  | Const (c,_) when not (List.mem_f Constant.equal c fnames) ->
-                      let new_infos =
-                        { dyn_infos with
-                            info = (f,args)
-                        }
-                      in
-(*                    Pp.msgnl (str "proving in " ++ pr_lconstr_env (pf_env g) dyn_infos.info); *)
-                      build_proof_args env sigma do_finalize new_infos g
-                  | Const _ ->
-                      do_finalize dyn_infos  g
-                  | Lambda _ ->
-                      let new_term =
-                        Reductionops.nf_beta env sigma dyn_infos.info in
-                      build_proof do_finalize {dyn_infos with info = new_term}
-                        g
-                  | LetIn _ ->
-                      let new_infos =
-                        { dyn_infos with info = Reductionops.nf_betaiotazeta env sigma dyn_infos.info }
-                      in
-
-                      tclTHENLIST
-                        [tclMAP
-                           (fun hyp_id ->
-                             h_reduce_with_zeta (Locusops.onHyp hyp_id))
-                           dyn_infos.rec_hyps;
-                         h_reduce_with_zeta Locusops.onConcl;
-                         build_proof do_finalize new_infos
-                        ]
-                        g
-                  | Cast(b,_,_) ->
-                      build_proof do_finalize {dyn_infos with info = b } g
-                  | Case _ | Fix _ | CoFix _ ->
-                      let new_finalize dyn_infos =
-                        let new_infos =
-                          { dyn_infos with
-                              info = dyn_infos.info,args
-                          }
-                        in
-                        build_proof_args env sigma do_finalize new_infos
-                      in
-                      build_proof new_finalize {dyn_infos  with info = f } g
-              end
-          | Fix _ | CoFix _ ->
-              user_err Pp.(str ( "Anonymous local (co)fixpoints are not handled yet"))
-
-
-          | Proj _ -> user_err Pp.(str "Prod")
-          | Prod _ -> do_finalize dyn_infos g
-          | LetIn _ ->
-              let new_infos =
-                { dyn_infos with
-                    info = Reductionops.nf_betaiotazeta env sigma dyn_infos.info
-                }
-              in
-
-              tclTHENLIST
-                [tclMAP
-                   (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id))
-                   dyn_infos.rec_hyps;
-                 h_reduce_with_zeta Locusops.onConcl;
-                 build_proof do_finalize new_infos
-                ] g
-          | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
-  and build_proof do_finalize dyn_infos g =
-(*     observe (str "proving with "++Printer.pr_lconstr dyn_infos.info++ str " on goal " ++ pr_gls g); *)
-    Indfun_common.observe_tac (fun env sigma ->
-        str "build_proof with " ++ pr_leconstr_env env sigma dyn_infos.info ) (build_proof_aux do_finalize dyn_infos) g
-  and build_proof_args env sigma do_finalize dyn_infos (* f_args'  args *) :tactic =
-    fun g ->
-      let (f_args',args) = dyn_infos.info in
-      let tac : tactic =
-        fun g ->
-          match args with
-            | []  ->
-              do_finalize {dyn_infos with info = f_args'} g
-            | arg::args ->
-              (*                observe (str "build_proof_args with arg := "++ pr_lconstr_env (pf_env g) arg++ *)
-              (*                        fnl () ++  *)
-              (*                        pr_goal (Tacmach.sig_it g) *)
-              (*                        ); *)
-              let do_finalize dyn_infos =
-                let new_arg = dyn_infos.info in
-                (*              tclTRYD *)
-                (build_proof_args env sigma
-                   do_finalize
-                   {dyn_infos with info = (mkApp(f_args',[|new_arg|])), args}
-                )
-              in
+   fun g ->
+    let env = pf_env g in
+    let sigma = project g in
+    (*      observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*)
+    match EConstr.kind sigma dyn_infos.info with
+    | Case (ci, ct, t, cb) ->
+      let do_finalize_t dyn_info' g =
+        let t = dyn_info'.info in
+        let dyn_infos = {dyn_info' with info = mkCase (ci, ct, t, cb)} in
+        let g_nb_prod = nb_prod (project g) (pf_concl g) in
+        let g, type_of_term = tac_type_of g t in
+        let term_eq = make_refl_eq (Lazy.force refl_equal) type_of_term t in
+        tclTHENLIST
+          [ Proofview.V82.of_tactic
+              (generalize (term_eq :: List.map mkVar dyn_infos.rec_hyps))
+          ; thin dyn_infos.rec_hyps
+          ; Proofview.V82.of_tactic
+              (pattern_option [(Locus.AllOccurrencesBut [1], t)] None)
+          ; (fun g ->
+              observe_tac "toto"
+                (tclTHENLIST
+                   [ Proofview.V82.of_tactic (Simple.case t)
+                   ; (fun g' ->
+                       let g'_nb_prod = nb_prod (project g') (pf_concl g') in
+                       let nb_instantiate_partial = g'_nb_prod - g_nb_prod in
+                       observe_tac "treat_new_case"
+                         (treat_new_case ptes_infos nb_instantiate_partial
+                            (build_proof do_finalize) t dyn_infos)
+                         g') ])
+                g) ]
+          g
+      in
+      build_proof do_finalize_t {dyn_infos with info = t} g
+    | Lambda (n, t, b) -> (
+      match EConstr.kind sigma (pf_concl g) with
+      | Prod _ ->
+        tclTHEN
+          (Proofview.V82.of_tactic intro)
+          (fun g' ->
+            let open Context.Named.Declaration in
+            let id = pf_last_hyp g' |> get_id in
+            let new_term =
+              pf_nf_betaiota g' (mkApp (dyn_infos.info, [|mkVar id|]))
+            in
+            let new_infos = {dyn_infos with info = new_term} in
+            let do_prove new_hyps =
               build_proof do_finalize
-                {dyn_infos with info = arg }
-                g
+                { new_infos with
+                  rec_hyps = new_hyps
+                ; nb_rec_hyps = List.length new_hyps }
+            in
+            (*                         observe_tac "Lambda" *)
+            (instantiate_hyps_with_args do_prove new_infos.rec_hyps [id]) g'
+            (*                            build_proof do_finalize new_infos g' *))
+          g
+      | _ -> do_finalize dyn_infos g )
+    | Cast (t, _, _) -> build_proof do_finalize {dyn_infos with info = t} g
+    | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ | Int _
+     |Float _ ->
+      do_finalize dyn_infos g
+    | App (_, _) -> (
+      let f, args = decompose_app sigma dyn_infos.info in
+      match EConstr.kind sigma f with
+      | Int _ -> user_err Pp.(str "integer cannot be applied")
+      | Float _ -> user_err Pp.(str "float cannot be applied")
+      | App _ ->
+        assert false (* we have collected all the app in decompose_app *)
+      | Proj _ -> assert false (*FIXME*)
+      | Var _ | Construct _ | Rel _ | Evar _ | Meta _ | Ind _ | Sort _ | Prod _
+        ->
+        let new_infos = {dyn_infos with info = (f, args)} in
+        build_proof_args env sigma do_finalize new_infos g
+      | Const (c, _) when not (List.mem_f Constant.equal c fnames) ->
+        let new_infos = {dyn_infos with info = (f, args)} in
+        (*                    Pp.msgnl (str "proving in " ++ pr_lconstr_env (pf_env g) dyn_infos.info); *)
+        build_proof_args env sigma do_finalize new_infos g
+      | Const _ -> do_finalize dyn_infos g
+      | Lambda _ ->
+        let new_term = Reductionops.nf_beta env sigma dyn_infos.info in
+        build_proof do_finalize {dyn_infos with info = new_term} g
+      | LetIn _ ->
+        let new_infos =
+          { dyn_infos with
+            info = Reductionops.nf_betaiotazeta env sigma dyn_infos.info }
+        in
+        tclTHENLIST
+          [ tclMAP
+              (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id))
+              dyn_infos.rec_hyps
+          ; h_reduce_with_zeta Locusops.onConcl
+          ; build_proof do_finalize new_infos ]
+          g
+      | Cast (b, _, _) -> build_proof do_finalize {dyn_infos with info = b} g
+      | Case _ | Fix _ | CoFix _ ->
+        let new_finalize dyn_infos =
+          let new_infos = {dyn_infos with info = (dyn_infos.info, args)} in
+          build_proof_args env sigma do_finalize new_infos
+        in
+        build_proof new_finalize {dyn_infos with info = f} g )
+    | Fix _ | CoFix _ ->
+      user_err Pp.(str "Anonymous local (co)fixpoints are not handled yet")
+    | Proj _ -> user_err Pp.(str "Prod")
+    | Prod _ -> do_finalize dyn_infos g
+    | LetIn _ ->
+      let new_infos =
+        { dyn_infos with
+          info = Reductionops.nf_betaiotazeta env sigma dyn_infos.info }
       in
-      (* observe_tac "build_proof_args" *) (tac ) g
+      tclTHENLIST
+        [ tclMAP
+            (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id))
+            dyn_infos.rec_hyps
+        ; h_reduce_with_zeta Locusops.onConcl
+        ; build_proof do_finalize new_infos ]
+        g
+    | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
+  and build_proof do_finalize dyn_infos g =
+    (*     observe (str "proving with "++Printer.pr_lconstr dyn_infos.info++ str " on goal " ++ pr_gls g); *)
+    Indfun_common.observe_tac
+      (fun env sigma ->
+        str "build_proof with " ++ pr_leconstr_env env sigma dyn_infos.info)
+      (build_proof_aux do_finalize dyn_infos)
+      g
+  and build_proof_args env sigma do_finalize dyn_infos : tactic =
+   (* f_args'  args *)
+   fun g ->
+    let f_args', args = dyn_infos.info in
+    let tac : tactic =
+     fun g ->
+      match args with
+      | [] -> do_finalize {dyn_infos with info = f_args'} g
+      | arg :: args ->
+        (*                observe (str "build_proof_args with arg := "++ pr_lconstr_env (pf_env g) arg++ *)
+        (*                        fnl () ++  *)
+        (*                        pr_goal (Tacmach.sig_it g) *)
+        (*                        ); *)
+        let do_finalize dyn_infos =
+          let new_arg = dyn_infos.info in
+          (*              tclTRYD *)
+          build_proof_args env sigma do_finalize
+            {dyn_infos with info = (mkApp (f_args', [|new_arg|]), args)}
+        in
+        build_proof do_finalize {dyn_infos with info = arg} g
+    in
+    (* observe_tac "build_proof_args" *) tac g
   in
   let do_finish_proof dyn_infos =
-     (* tclTRYD *) (clean_goal_with_heq
-                      ptes_infos
-                      finish_proof dyn_infos)
+    (* tclTRYD *) clean_goal_with_heq ptes_infos finish_proof dyn_infos
   in
-    (* observe_tac "build_proof" *)
+  (* observe_tac "build_proof" *)
   fun g ->
     build_proof (clean_goal_with_heq ptes_infos do_finish_proof) dyn_infos g
 
-
 (* Proof of principles from structural functions *)
 
 type static_fix_info =
-    {
-      idx : int;
-      name : Id.t;
-      types : types;
-      offset : int;
-      nb_realargs : int;
-      body_with_param : constr;
-      num_in_block : int
-    }
-
-
-
-let prove_rec_hyp_for_struct fix_info =
-      (fun  eq_hyps -> tclTHEN
-        (rewrite_until_var (fix_info.idx) eq_hyps)
-        (fun g ->
-           let _,pte_args = destApp (project g) (pf_concl g) in
-           let rec_hyp_proof =
-             mkApp(mkVar fix_info.name,array_get_start pte_args)
-           in
-           refine rec_hyp_proof g
-        ))
+  { idx : int
+  ; name : Id.t
+  ; types : types
+  ; offset : int
+  ; nb_realargs : int
+  ; body_with_param : constr
+  ; num_in_block : int }
+
+let prove_rec_hyp_for_struct fix_info eq_hyps =
+  tclTHEN (rewrite_until_var fix_info.idx eq_hyps) (fun g ->
+      let _, pte_args = destApp (project g) (pf_concl g) in
+      let rec_hyp_proof =
+        mkApp (mkVar fix_info.name, array_get_start pte_args)
+      in
+      refine rec_hyp_proof g)
 
-let prove_rec_hyp fix_info  =
-  { proving_tac = prove_rec_hyp_for_struct fix_info
-  ;
-    is_valid = fun _ -> true
-  }
+let prove_rec_hyp fix_info =
+  {proving_tac = prove_rec_hyp_for_struct fix_info; is_valid = (fun _ -> true)}
 
 let generalize_non_dep hyp g =
-(*   observe (str "rec id := " ++ Ppconstr.pr_id hyp); *)
+  (*   observe (str "rec id := " ++ Ppconstr.pr_id hyp); *)
   let hyps = [hyp] in
   let env = Global.env () in
   let hyp_typ = pf_get_hyp_typ g hyp in
-  let to_revert,_ =
+  let to_revert, _ =
     let open Context.Named.Declaration in
-    Environ.fold_named_context_reverse (fun (clear,keep) decl ->
-      let decl = map_named_decl EConstr.of_constr decl in
-      let hyp = get_id decl in
-      if Id.List.mem hyp hyps
-        || List.exists (Termops.occur_var_in_decl env (project g) hyp) keep
-        || Termops.occur_var env (project g) hyp hyp_typ
-        || Termops.is_section_variable hyp (* should be dangerous *)
-      then (clear,decl::keep)
-      else (hyp::clear,keep))
-      ~init:([],[]) (pf_env g)
+    Environ.fold_named_context_reverse
+      (fun (clear, keep) decl ->
+        let decl = map_named_decl EConstr.of_constr decl in
+        let hyp = get_id decl in
+        if
+          Id.List.mem hyp hyps
+          || List.exists (Termops.occur_var_in_decl env (project g) hyp) keep
+          || Termops.occur_var env (project g) hyp hyp_typ
+          || Termops.is_section_variable hyp
+          (* should be dangerous *)
+        then (clear, decl :: keep)
+        else (hyp :: clear, keep))
+      ~init:([], []) (pf_env g)
   in
-(*   observe (str "to_revert := " ++ prlist_with_sep spc Ppconstr.pr_id to_revert); *)
+  (*   observe (str "to_revert := " ++ prlist_with_sep spc Ppconstr.pr_id to_revert); *)
   tclTHEN
-    ((* observe_tac "h_generalize" *) (Proofview.V82.of_tactic (generalize  (List.map mkVar to_revert) )))
-    ((* observe_tac "thin" *) (thin to_revert))
+    ((* observe_tac "h_generalize" *) Proofview.V82.of_tactic
+       (generalize (List.map mkVar to_revert)))
+    ((* observe_tac "thin" *) thin to_revert)
     g
 
 let id_of_decl = RelDecl.get_name %> Nameops.Name.get_id
 let var_of_decl = id_of_decl %> mkVar
+
 let revert idl =
-  tclTHEN
-    (Proofview.V82.of_tactic (generalize (List.map mkVar idl)))
-    (thin idl)
+  tclTHEN (Proofview.V82.of_tactic (generalize (List.map mkVar idl))) (thin idl)
 
-let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num =
-(*   observe (str "nb_args := " ++ str (string_of_int nb_args)); *)
-(*   observe (str "nb_params := " ++ str (string_of_int nb_params)); *)
-(*   observe (str "rec_args_num := " ++ str (string_of_int (rec_args_num + 1) )); *)
+let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
+    =
+  (*   observe (str "nb_args := " ++ str (string_of_int nb_args)); *)
+  (*   observe (str "nb_params := " ++ str (string_of_int nb_params)); *)
+  (*   observe (str "rec_args_num := " ++ str (string_of_int (rec_args_num + 1) )); *)
   let f_def = Global.lookup_constant (fst (destConst evd f)) in
-  let eq_lhs = mkApp(f,Array.init (nb_params + nb_args) (fun i -> mkRel(nb_params + nb_args - i))) in
-  let (f_body, _, _) = Option.get (Global.body_of_constant_body Library.indirect_accessor f_def) in
+  let eq_lhs =
+    mkApp
+      ( f
+      , Array.init (nb_params + nb_args) (fun i ->
+            mkRel (nb_params + nb_args - i)) )
+  in
+  let f_body, _, _ =
+    Option.get (Global.body_of_constant_body Library.indirect_accessor f_def)
+  in
   let f_body = EConstr.of_constr f_body in
-  let params,f_body_with_params = decompose_lam_n evd nb_params f_body in
-  let (_,num),(_,_,bodies) = destFix evd f_body_with_params in
+  let params, f_body_with_params = decompose_lam_n evd nb_params f_body in
+  let (_, num), (_, _, bodies) = destFix evd f_body_with_params in
   let fnames_with_params =
-    let params = Array.init nb_params (fun i -> mkRel(nb_params - i)) in
-    let fnames = List.rev (Array.to_list (Array.map (fun f -> mkApp(f,params)) fnames)) in
+    let params = Array.init nb_params (fun i -> mkRel (nb_params - i)) in
+    let fnames =
+      List.rev (Array.to_list (Array.map (fun f -> mkApp (f, params)) fnames))
+    in
     fnames
   in
-(*   observe (str "fnames_with_params " ++ prlist_with_sep fnl pr_lconstr fnames_with_params); *)
-(*   observe (str "body " ++ pr_lconstr bodies.(num)); *)
-  let f_body_with_params_and_other_fun  = substl fnames_with_params bodies.(num) in
-(*   observe (str "f_body_with_params_and_other_fun " ++  pr_lconstr f_body_with_params_and_other_fun); *)
-  let eq_rhs = Reductionops.nf_betaiotazeta (Global.env ()) evd (mkApp(compose_lam params f_body_with_params_and_other_fun,Array.init (nb_params + nb_args) (fun i -> mkRel(nb_params + nb_args - i)))) in
+  (*   observe (str "fnames_with_params " ++ prlist_with_sep fnl pr_lconstr fnames_with_params); *)
+  (*   observe (str "body " ++ pr_lconstr bodies.(num)); *)
+  let f_body_with_params_and_other_fun =
+    substl fnames_with_params bodies.(num)
+  in
+  (*   observe (str "f_body_with_params_and_other_fun " ++  pr_lconstr f_body_with_params_and_other_fun); *)
+  let eq_rhs =
+    Reductionops.nf_betaiotazeta (Global.env ()) evd
+      (mkApp
+         ( compose_lam params f_body_with_params_and_other_fun
+         , Array.init (nb_params + nb_args) (fun i ->
+               mkRel (nb_params + nb_args - i)) ))
+  in
   (*   observe (str "eq_rhs " ++  pr_lconstr eq_rhs); *)
-  let (type_ctxt,type_of_f),evd =
-    let evd,t = Typing.type_of ~refresh:true (Global.env ()) evd f
-    in
-    decompose_prod_n_assum evd
-      (nb_params + nb_args) t,evd
+  let (type_ctxt, type_of_f), evd =
+    let evd, t = Typing.type_of ~refresh:true (Global.env ()) evd f in
+    (decompose_prod_n_assum evd (nb_params + nb_args) t, evd)
   in
-  let eqn = mkApp(Lazy.force eq,[|type_of_f;eq_lhs;eq_rhs|]) in
+  let eqn = mkApp (Lazy.force eq, [|type_of_f; eq_lhs; eq_rhs|]) in
   let lemma_type = it_mkProd_or_LetIn eqn type_ctxt in
   (* Pp.msgnl (str "lemma type " ++ Printer.pr_lconstr lemma_type ++ fnl () ++ str "f_body " ++ Printer.pr_lconstr f_body); *)
   let f_id = Label.to_id (Constant.label (fst (destConst evd f))) in
   let prove_replacement =
     tclTHENLIST
-      [
-        tclDO (nb_params + rec_args_num + 1) (Proofview.V82.of_tactic intro);
-        observe_tac "" (fun g ->
-           let rec_id = pf_nth_hyp_id g 1 in
-           tclTHENLIST
-             [observe_tac "generalize_non_dep in generate_equation_lemma" (generalize_non_dep rec_id);
-              observe_tac "h_case" (Proofview.V82.of_tactic (simplest_case (mkVar rec_id)));
-              (Proofview.V82.of_tactic intros_reflexivity)] g
-        )
-      ]
+      [ tclDO (nb_params + rec_args_num + 1) (Proofview.V82.of_tactic intro)
+      ; observe_tac "" (fun g ->
+            let rec_id = pf_nth_hyp_id g 1 in
+            tclTHENLIST
+              [ observe_tac "generalize_non_dep in generate_equation_lemma"
+                  (generalize_non_dep rec_id)
+              ; observe_tac "h_case"
+                  (Proofview.V82.of_tactic (simplest_case (mkVar rec_id)))
+              ; Proofview.V82.of_tactic intros_reflexivity ]
+              g) ]
   in
   (* Pp.msgnl (str "lemma type (2) " ++ Printer.pr_lconstr_env (Global.env ()) evd lemma_type); *)
 
   (*i The next call to mk_equation_id is valid since we are
      constructing the lemma Ensures by: obvious i*)
-  let lemma = Lemmas.start_lemma ~name:(mk_equation_id f_id) ~poly:false evd lemma_type in
-  let lemma,_ = Lemmas.by (Proofview.V82.tactic prove_replacement) lemma in
-  let () = Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent ~idopt:None in
+  let lemma =
+    Lemmas.start_lemma ~name:(mk_equation_id f_id) ~poly:false evd lemma_type
+  in
+  let lemma, _ = Lemmas.by (Proofview.V82.tactic prove_replacement) lemma in
+  let () =
+    Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent ~idopt:None
+  in
   evd
 
-let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num all_funs g =
+let do_replace (evd : Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num
+    all_funs g =
   let equation_lemma =
     try
       let finfos =
@@ -939,376 +861,366 @@ let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num a
         | Some finfos -> finfos
       in
       mkConst (Option.get finfos.equation_lemma)
-    with (Not_found | Option.IsNone as e) ->
+    with (Not_found | Option.IsNone) as e ->
       let f_id = Label.to_id (Constant.label (fst (destConst !evd f))) in
       (*i The next call to mk_equation_id is valid since we will construct the lemma
         Ensures by: obvious
         i*)
-      let equation_lemma_id = (mk_equation_id f_id) in
-      evd := generate_equation_lemma !evd all_funs  f fun_num (List.length params) (List.length rev_args_id) rec_arg_num;
+      let equation_lemma_id = mk_equation_id f_id in
+      evd :=
+        generate_equation_lemma !evd all_funs f fun_num (List.length params)
+          (List.length rev_args_id) rec_arg_num;
       let _ =
         match e with
-          | Option.IsNone ->
-            let finfos = match find_Function_infos (fst (destConst !evd f)) with
-              | None -> raise Not_found
-              | Some finfos -> finfos
-            in
-            update_Function
-              {finfos with
-               equation_lemma = Some (
-                   match Nametab.locate (qualid_of_ident equation_lemma_id) with
-                   | GlobRef.ConstRef c -> c
-                   | _ -> CErrors.anomaly (Pp.str "Not a constant.")
-                 )
-              }
-          | _ -> ()
+        | Option.IsNone ->
+          let finfos =
+            match find_Function_infos (fst (destConst !evd f)) with
+            | None -> raise Not_found
+            | Some finfos -> finfos
+          in
+          update_Function
+            { finfos with
+              equation_lemma =
+                Some
+                  ( match Nametab.locate (qualid_of_ident equation_lemma_id) with
+                  | GlobRef.ConstRef c -> c
+                  | _ -> CErrors.anomaly (Pp.str "Not a constant.") ) }
+        | _ -> ()
       in
       (* let res = Constrintern.construct_reference (pf_hyps g) equation_lemma_id in *)
-      let evd',res =
-        Evd.fresh_global
-          (Global.env ()) !evd
+      let evd', res =
+        Evd.fresh_global (Global.env ()) !evd
           (Constrintern.locate_reference (qualid_of_ident equation_lemma_id))
       in
-      evd:=evd';
+      evd := evd';
       let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd res in
       evd := sigma;
       res
   in
   let nb_intro_to_do = nb_prod (project g) (pf_concl g) in
-    tclTHEN
-      (tclDO nb_intro_to_do (Proofview.V82.of_tactic intro))
-      (
-        fun g' ->
-          let just_introduced = nLastDecls nb_intro_to_do g' in
-          let open Context.Named.Declaration in
-          let just_introduced_id = List.map get_id just_introduced in
-          tclTHEN (Proofview.V82.of_tactic (Equality.rewriteLR equation_lemma))
-                  (revert just_introduced_id) g'
-      )
-      g
+  tclTHEN
+    (tclDO nb_intro_to_do (Proofview.V82.of_tactic intro))
+    (fun g' ->
+      let just_introduced = nLastDecls nb_intro_to_do g' in
+      let open Context.Named.Declaration in
+      let just_introduced_id = List.map get_id just_introduced in
+      tclTHEN
+        (Proofview.V82.of_tactic (Equality.rewriteLR equation_lemma))
+        (revert just_introduced_id)
+        g')
+    g
 
-let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnames all_funs _nparams : tactic =
-  fun g ->
+let prove_princ_for_struct (evd : Evd.evar_map ref) interactive_proof fun_num
+    fnames all_funs _nparams : tactic =
+ fun g ->
   let princ_type = pf_concl g in
   (* Pp.msgnl (str "princ_type " ++ Printer.pr_lconstr princ_type); *)
   (* Pp.msgnl (str "all_funs "); *)
   (* Array.iter (fun c -> Pp.msgnl (Printer.pr_lconstr c)) all_funs; *)
-    let princ_info = compute_elim_sig (project g) princ_type in
-    let fresh_id =
-      let avoid = ref (pf_ids_of_hyps g) in
-      (fun na ->
-         let new_id =
-           match na with
-               Name id -> fresh_id !avoid (Id.to_string id)
-             | Anonymous -> fresh_id !avoid "H"
-         in
-         avoid := new_id :: !avoid;
-         (Name new_id)
-      )
-    in
-    let fresh_decl = RelDecl.map_name fresh_id in
-    let princ_info : elim_scheme =
-      { princ_info with
-          params = List.map fresh_decl princ_info.params;
-          predicates = List.map fresh_decl princ_info.predicates;
-          branches = List.map fresh_decl princ_info.branches;
-          args = List.map fresh_decl princ_info.args
-      }
-    in
-    let get_body const =
-      match Global.body_of_constant Library.indirect_accessor const with
-        | Some (body, _, _) ->
-          let env = Global.env () in
-          let sigma = Evd.from_env env in
-             Tacred.cbv_norm_flags
-               (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
-               env
-               sigma
-               (EConstr.of_constr body)
-        | None -> user_err Pp.(str "Cannot define a principle over an axiom ")
-    in
-    let fbody = get_body fnames.(fun_num) in
-    let f_ctxt,f_body = decompose_lam (project g) fbody in
-    let f_ctxt_length = List.length f_ctxt in
-    let diff_params = princ_info.nparams - f_ctxt_length in
-    let full_params,princ_params,fbody_with_full_params =
-      if diff_params > 0
-      then
-        let princ_params,full_params =
-          list_chop  diff_params princ_info.params
-        in
-        (full_params, (* real params *)
-         princ_params, (* the params of the principle which are not params of the function *)
-         substl (* function instantiated with real params *)
-           (List.map var_of_decl full_params)
-           f_body
-        )
-      else
-        let f_ctxt_other,f_ctxt_params =
-          list_chop (- diff_params) f_ctxt in
-        let f_body = compose_lam f_ctxt_other f_body in
-        (princ_info.params, (* real params *)
-         [],(* all params are full params *)
-         substl (* function instantiated with real params *)
-           (List.map var_of_decl princ_info.params)
-           f_body
-        )
-    in
-    observe (str "full_params := " ++
-               prlist_with_sep spc (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
-               full_params
-            );
-    observe (str "princ_params := " ++
-               prlist_with_sep spc (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
-               princ_params
-            );
-    observe (str "fbody_with_full_params := " ++
-               pr_leconstr_env (Global.env ()) !evd fbody_with_full_params
-            );
-    let all_funs_with_full_params =
-      Array.map (fun f -> applist(f, List.rev_map var_of_decl full_params)) all_funs
-    in
-    let fix_offset = List.length princ_params in
-    let ptes_to_fix,infos =
-      match EConstr.kind (project g) fbody_with_full_params with
-        | Fix((idxs,i),(names,typess,bodies)) ->
-            let bodies_with_all_params =
-              Array.map
-                (fun body ->
-                   Reductionops.nf_betaiota (pf_env g) (project g)
-                     (applist(substl (List.rev (Array.to_list all_funs_with_full_params)) body,
-                              List.rev_map var_of_decl princ_params))
-                )
-                bodies
+  let princ_info = compute_elim_sig (project g) princ_type in
+  let fresh_id =
+    let avoid = ref (pf_ids_of_hyps g) in
+    fun na ->
+      let new_id =
+        match na with
+        | Name id -> fresh_id !avoid (Id.to_string id)
+        | Anonymous -> fresh_id !avoid "H"
+      in
+      avoid := new_id :: !avoid;
+      Name new_id
+  in
+  let fresh_decl = RelDecl.map_name fresh_id in
+  let princ_info : elim_scheme =
+    { princ_info with
+      params = List.map fresh_decl princ_info.params
+    ; predicates = List.map fresh_decl princ_info.predicates
+    ; branches = List.map fresh_decl princ_info.branches
+    ; args = List.map fresh_decl princ_info.args }
+  in
+  let get_body const =
+    match Global.body_of_constant Library.indirect_accessor const with
+    | Some (body, _, _) ->
+      let env = Global.env () in
+      let sigma = Evd.from_env env in
+      Tacred.cbv_norm_flags
+        (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
+        env sigma (EConstr.of_constr body)
+    | None -> user_err Pp.(str "Cannot define a principle over an axiom ")
+  in
+  let fbody = get_body fnames.(fun_num) in
+  let f_ctxt, f_body = decompose_lam (project g) fbody in
+  let f_ctxt_length = List.length f_ctxt in
+  let diff_params = princ_info.nparams - f_ctxt_length in
+  let full_params, princ_params, fbody_with_full_params =
+    if diff_params > 0 then
+      let princ_params, full_params = list_chop diff_params princ_info.params in
+      ( full_params
+      , (* real params *)
+        princ_params
+      , (* the params of the principle which are not params of the function *)
+        substl (* function instantiated with real params *)
+          (List.map var_of_decl full_params)
+          f_body )
+    else
+      let f_ctxt_other, f_ctxt_params = list_chop (-diff_params) f_ctxt in
+      let f_body = compose_lam f_ctxt_other f_body in
+      ( princ_info.params
+      , (* real params *)
+        []
+      , (* all params are full params *)
+        substl (* function instantiated with real params *)
+          (List.map var_of_decl princ_info.params)
+          f_body )
+  in
+  observe
+    ( str "full_params := "
+    ++ prlist_with_sep spc
+         (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
+         full_params );
+  observe
+    ( str "princ_params := "
+    ++ prlist_with_sep spc
+         (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
+         princ_params );
+  observe
+    ( str "fbody_with_full_params := "
+    ++ pr_leconstr_env (Global.env ()) !evd fbody_with_full_params );
+  let all_funs_with_full_params =
+    Array.map
+      (fun f -> applist (f, List.rev_map var_of_decl full_params))
+      all_funs
+  in
+  let fix_offset = List.length princ_params in
+  let ptes_to_fix, infos =
+    match EConstr.kind (project g) fbody_with_full_params with
+    | Fix ((idxs, i), (names, typess, bodies)) ->
+      let bodies_with_all_params =
+        Array.map
+          (fun body ->
+            Reductionops.nf_betaiota (pf_env g) (project g)
+              (applist
+                 ( substl
+                     (List.rev (Array.to_list all_funs_with_full_params))
+                     body
+                 , List.rev_map var_of_decl princ_params )))
+          bodies
+      in
+      let info_array =
+        Array.mapi
+          (fun i types ->
+            let types =
+              prod_applist (project g) types
+                (List.rev_map var_of_decl princ_params)
             in
-            let info_array =
-              Array.mapi
-                (fun i types ->
-                   let types = prod_applist (project g) types (List.rev_map var_of_decl princ_params) in
-                   { idx = idxs.(i)  - fix_offset;
-                     name = Nameops.Name.get_id (fresh_id names.(i).binder_name);
-                     types = types;
-                     offset = fix_offset;
-                     nb_realargs =
-                       List.length
-                         (fst (decompose_lam (project g) bodies.(i))) - fix_offset;
-                     body_with_param = bodies_with_all_params.(i);
-                     num_in_block = i
-                   }
-                )
-                typess
+            { idx = idxs.(i) - fix_offset
+            ; name = Nameops.Name.get_id (fresh_id names.(i).binder_name)
+            ; types
+            ; offset = fix_offset
+            ; nb_realargs =
+                List.length (fst (decompose_lam (project g) bodies.(i)))
+                - fix_offset
+            ; body_with_param = bodies_with_all_params.(i)
+            ; num_in_block = i })
+          typess
+      in
+      let pte_to_fix, rev_info =
+        List.fold_left_i
+          (fun i (acc_map, acc_info) decl ->
+            let pte = RelDecl.get_name decl in
+            let infos = info_array.(i) in
+            let type_args, _ = decompose_prod (project g) infos.types in
+            let nargs = List.length type_args in
+            let f =
+              applist
+                (mkConst fnames.(i), List.rev_map var_of_decl princ_info.params)
             in
-            let pte_to_fix,rev_info =
-              List.fold_left_i
-                (fun i (acc_map,acc_info) decl ->
-                   let pte = RelDecl.get_name decl in
-                   let infos = info_array.(i) in
-                   let type_args,_ = decompose_prod (project g) infos.types in
-                   let nargs = List.length type_args in
-                   let f = applist(mkConst fnames.(i), List.rev_map var_of_decl princ_info.params) in
-                   let first_args = Array.init nargs (fun i -> mkRel (nargs -i)) in
-                   let app_f = mkApp(f,first_args) in
-                   let pte_args = (Array.to_list first_args)@[app_f] in
-                   let app_pte = applist(mkVar (Nameops.Name.get_id pte),pte_args) in
-                   let body_with_param,num =
-                     let body = get_body fnames.(i) in
-                     let body_with_full_params =
-                       Reductionops.nf_betaiota (pf_env g) (project g) (
-                         applist(body,List.rev_map var_of_decl full_params))
-                     in
-                     match EConstr.kind (project g) body_with_full_params with
-                       | Fix((_,num),(_,_,bs)) ->
-                               Reductionops.nf_betaiota (pf_env g) (project g)
-                                 (
-                                   (applist
-                                      (substl
-                                         (List.rev
-                                            (Array.to_list all_funs_with_full_params))
-                                         bs.(num),
-                                       List.rev_map var_of_decl princ_params))
-                                 ),num
-                         | _ -> user_err Pp.(str "Not a mutual block")
-                   in
-                   let info =
-                     {infos with
-                        types = compose_prod type_args app_pte;
-                         body_with_param = body_with_param;
-                         num_in_block = num
-                     }
-                   in
-(*                 observe (str "binding " ++ Ppconstr.pr_id (Nameops.Name.get_id pte) ++  *)
-(*                            str " to " ++ Ppconstr.pr_id info.name); *)
-                   (Id.Map.add (Nameops.Name.get_id pte) info acc_map,info::acc_info)
-                   )
-                0
-                (Id.Map.empty,[])
-                (List.rev princ_info.predicates)
+            let first_args = Array.init nargs (fun i -> mkRel (nargs - i)) in
+            let app_f = mkApp (f, first_args) in
+            let pte_args = Array.to_list first_args @ [app_f] in
+            let app_pte = applist (mkVar (Nameops.Name.get_id pte), pte_args) in
+            let body_with_param, num =
+              let body = get_body fnames.(i) in
+              let body_with_full_params =
+                Reductionops.nf_betaiota (pf_env g) (project g)
+                  (applist (body, List.rev_map var_of_decl full_params))
+              in
+              match EConstr.kind (project g) body_with_full_params with
+              | Fix ((_, num), (_, _, bs)) ->
+                ( Reductionops.nf_betaiota (pf_env g) (project g)
+                    (applist
+                       ( substl
+                           (List.rev (Array.to_list all_funs_with_full_params))
+                           bs.(num)
+                       , List.rev_map var_of_decl princ_params ))
+                , num )
+              | _ -> user_err Pp.(str "Not a mutual block")
             in
-            pte_to_fix,List.rev rev_info
-        | _ ->
-           Id.Map.empty,[]
-    in
-    let mk_fixes : tactic =
-      let pre_info,infos = list_chop fun_num infos in
-      match pre_info,infos with
-        | _,[] -> tclIDTAC
-        | _, this_fix_info::others_infos ->
-            let other_fix_infos =
-              List.map
-                (fun fi -> fi.name,fi.idx + 1 ,fi.types)
-                (pre_info@others_infos)
+            let info =
+              { infos with
+                types = compose_prod type_args app_pte
+              ; body_with_param
+              ; num_in_block = num }
             in
-            if List.is_empty other_fix_infos
-            then
-              if this_fix_info.idx + 1 = 0
-              then tclIDTAC (* Someone  tries to defined a principle on a fully parametric definition declared as a fixpoint (strange but ....) *)
-              else
-                Indfun_common.observe_tac (fun _ _ -> str "h_fix " ++ int (this_fix_info.idx +1))
-                  (Proofview.V82.of_tactic (fix this_fix_info.name (this_fix_info.idx +1)))
-            else
-              Proofview.V82.of_tactic (Tactics.mutual_fix this_fix_info.name (this_fix_info.idx + 1)
-                other_fix_infos 0)
-    in
-    let first_tac : tactic = (* every operations until fix creations *)
+            (*                 observe (str "binding " ++ Ppconstr.pr_id (Nameops.Name.get_id pte) ++  *)
+            (*                            str " to " ++ Ppconstr.pr_id info.name); *)
+            (Id.Map.add (Nameops.Name.get_id pte) info acc_map, info :: acc_info))
+          0 (Id.Map.empty, [])
+          (List.rev princ_info.predicates)
+      in
+      (pte_to_fix, List.rev rev_info)
+    | _ -> (Id.Map.empty, [])
+  in
+  let mk_fixes : tactic =
+    let pre_info, infos = list_chop fun_num infos in
+    match (pre_info, infos) with
+    | _, [] -> tclIDTAC
+    | _, this_fix_info :: others_infos ->
+      let other_fix_infos =
+        List.map
+          (fun fi -> (fi.name, fi.idx + 1, fi.types))
+          (pre_info @ others_infos)
+      in
+      if List.is_empty other_fix_infos then
+        if this_fix_info.idx + 1 = 0 then tclIDTAC
+          (* Someone  tries to defined a principle on a fully parametric definition declared as a fixpoint (strange but ....) *)
+        else
+          Indfun_common.observe_tac
+            (fun _ _ -> str "h_fix " ++ int (this_fix_info.idx + 1))
+            (Proofview.V82.of_tactic
+               (fix this_fix_info.name (this_fix_info.idx + 1)))
+      else
+        Proofview.V82.of_tactic
+          (Tactics.mutual_fix this_fix_info.name (this_fix_info.idx + 1)
+             other_fix_infos 0)
+  in
+  let first_tac : tactic =
+    (* every operations until fix creations *)
+    tclTHENLIST
+      [ observe_tac "introducing params"
+          (Proofview.V82.of_tactic
+             (intros_using (List.rev_map id_of_decl princ_info.params)))
+      ; observe_tac "introducing predictes"
+          (Proofview.V82.of_tactic
+             (intros_using (List.rev_map id_of_decl princ_info.predicates)))
+      ; observe_tac "introducing branches"
+          (Proofview.V82.of_tactic
+             (intros_using (List.rev_map id_of_decl princ_info.branches)))
+      ; observe_tac "building fixes" mk_fixes ]
+  in
+  let intros_after_fixes : tactic =
+   fun gl ->
+    let ctxt, pte_app = decompose_prod_assum (project gl) (pf_concl gl) in
+    let pte, pte_args = decompose_app (project gl) pte_app in
+    try
+      let pte =
+        try destVar (project gl) pte
+        with DestKO -> anomaly (Pp.str "Property is not a variable.")
+      in
+      let fix_info = Id.Map.find pte ptes_to_fix in
+      let nb_args = fix_info.nb_realargs in
       tclTHENLIST
-        [ observe_tac "introducing params" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.params)));
-          observe_tac "introducing predictes" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.predicates)));
-          observe_tac "introducing branches" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.branches)));
-          observe_tac "building fixes" mk_fixes;
-        ]
-    in
-    let intros_after_fixes : tactic =
-      fun gl ->
-        let ctxt,pte_app =  (decompose_prod_assum (project gl) (pf_concl gl)) in
-        let pte,pte_args = (decompose_app (project gl) pte_app) in
-        try
-          let pte =
-            try destVar (project gl) pte
-            with DestKO -> anomaly (Pp.str "Property is not a variable.")
-          in
-          let fix_info = Id.Map.find  pte ptes_to_fix in
-          let nb_args = fix_info.nb_realargs in
-          tclTHENLIST
-            [
-              (* observe_tac ("introducing args") *) (tclDO nb_args (Proofview.V82.of_tactic intro));
-              (fun g -> (* replacement of the function by its body *)
-                 let args = nLastDecls nb_args g in
-                 let fix_body = fix_info.body_with_param in
-(*               observe (str "fix_body := "++ pr_lconstr_env (pf_env gl) fix_body); *)
-                 let open Context.Named.Declaration in
-                 let args_id = List.map get_id args in
-                 let dyn_infos =
-                   {
-                     nb_rec_hyps = -100;
-                     rec_hyps = [];
-                     info =
-                       Reductionops.nf_betaiota (pf_env g) (project g)
-                         (applist(fix_body,List.rev_map mkVar args_id));
-                     eq_hyps = []
-                   }
+        [ (* observe_tac ("introducing args") *)
+          tclDO nb_args (Proofview.V82.of_tactic intro)
+        ; (fun g ->
+            (* replacement of the function by its body *)
+            let args = nLastDecls nb_args g in
+            let fix_body = fix_info.body_with_param in
+            (*               observe (str "fix_body := "++ pr_lconstr_env (pf_env gl) fix_body); *)
+            let open Context.Named.Declaration in
+            let args_id = List.map get_id args in
+            let dyn_infos =
+              { nb_rec_hyps = -100
+              ; rec_hyps = []
+              ; info =
+                  Reductionops.nf_betaiota (pf_env g) (project g)
+                    (applist (fix_body, List.rev_map mkVar args_id))
+              ; eq_hyps = [] }
+            in
+            tclTHENLIST
+              [ observe_tac "do_replace"
+                  (do_replace evd full_params
+                     (fix_info.idx + List.length princ_params)
+                     ( args_id
+                     @ List.map
+                         (RelDecl.get_name %> Nameops.Name.get_id)
+                         princ_params )
+                     all_funs.(fix_info.num_in_block)
+                     fix_info.num_in_block all_funs)
+              ; (let do_prove =
+                   build_proof interactive_proof (Array.to_list fnames)
+                     (Id.Map.map prove_rec_hyp ptes_to_fix)
                  in
-                 tclTHENLIST
-                   [
-                     observe_tac "do_replace"
-                       (do_replace evd
-                          full_params
-                          (fix_info.idx + List.length princ_params)
-                          (args_id@(List.map (RelDecl.get_name %> Nameops.Name.get_id) princ_params))
-                          (all_funs.(fix_info.num_in_block))
-                          fix_info.num_in_block
-                          all_funs
-                       );
-                     let do_prove =
-                       build_proof
-                         interactive_proof
-                         (Array.to_list fnames)
-                         (Id.Map.map prove_rec_hyp ptes_to_fix)
-                     in
-                     let prove_tac branches  =
-                       let dyn_infos =
-                         {dyn_infos with
-                            rec_hyps = branches;
-                            nb_rec_hyps = List.length branches
-                         }
-                       in
-                       observe_tac "cleaning" (clean_goal_with_heq
-                         (Id.Map.map prove_rec_hyp ptes_to_fix)
-                         do_prove
-                         dyn_infos)
-                     in
-(*                   observe (str "branches := " ++ *)
-(*                              prlist_with_sep spc (fun decl -> Ppconstr.pr_id (id_of_decl decl)) princ_info.branches ++  fnl () ++ *)
-(*                         str "args := " ++ prlist_with_sep spc Ppconstr.pr_id  args_id *)
-
-(*                         ); *)
-                     (* observe_tac "instancing" *) (instantiate_hyps_with_args prove_tac
-                       (List.rev_map id_of_decl princ_info.branches)
-                       (List.rev args_id))
-                   ]
-                   g
-              );
-            ] gl
-        with Not_found ->
-          let nb_args = min (princ_info.nargs) (List.length ctxt) in
-          tclTHENLIST
-            [
-              tclDO nb_args (Proofview.V82.of_tactic intro);
-              (fun g -> (* replacement of the function by its body *)
-                 let args = nLastDecls nb_args g in
-                 let open Context.Named.Declaration in
-                 let args_id = List.map get_id args in
-                 let dyn_infos =
-                   {
-                     nb_rec_hyps = -100;
-                     rec_hyps = [];
-                     info =
-                       Reductionops.nf_betaiota (pf_env g) (project g)
-                         (applist(fbody_with_full_params,
-                                  (List.rev_map var_of_decl princ_params)@
-                                    (List.rev_map mkVar args_id)
-                                 ));
-                     eq_hyps = []
-                   }
+                 let prove_tac branches =
+                   let dyn_infos =
+                     { dyn_infos with
+                       rec_hyps = branches
+                     ; nb_rec_hyps = List.length branches }
+                   in
+                   observe_tac "cleaning"
+                     (clean_goal_with_heq
+                        (Id.Map.map prove_rec_hyp ptes_to_fix)
+                        do_prove dyn_infos)
                  in
-                 let fname = destConst (project g) (fst (decompose_app (project g) (List.hd (List.rev pte_args)))) in
-                 tclTHENLIST
-                   [Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalConstRef (fst fname))]);
-                    let do_prove =
-                      build_proof
-                        interactive_proof
-                        (Array.to_list fnames)
-                         (Id.Map.map prove_rec_hyp ptes_to_fix)
-                    in
-                    let prove_tac branches  =
-                      let dyn_infos =
-                         {dyn_infos with
-                            rec_hyps = branches;
-                            nb_rec_hyps = List.length branches
-                         }
-                      in
-                       clean_goal_with_heq
-                         (Id.Map.map prove_rec_hyp ptes_to_fix)
-                         do_prove
-                         dyn_infos
-                    in
-                    instantiate_hyps_with_args prove_tac
-                       (List.rev_map id_of_decl princ_info.branches)
-                      (List.rev args_id)
-                   ]
-                   g
-              )
-            ]
-          gl
-    in
-    tclTHEN
-      first_tac
-      intros_after_fixes
-      g
-
-
-
-
-
+                 (*                   observe (str "branches := " ++ *)
+                 (*                              prlist_with_sep spc (fun decl -> Ppconstr.pr_id (id_of_decl decl)) princ_info.branches ++  fnl () ++ *)
+                 (*                         str "args := " ++ prlist_with_sep spc Ppconstr.pr_id  args_id *)
+
+                 (*                         ); *)
+                 (* observe_tac "instancing" *)
+                 instantiate_hyps_with_args prove_tac
+                   (List.rev_map id_of_decl princ_info.branches)
+                   (List.rev args_id)) ]
+              g) ]
+        gl
+    with Not_found ->
+      let nb_args = min princ_info.nargs (List.length ctxt) in
+      tclTHENLIST
+        [ tclDO nb_args (Proofview.V82.of_tactic intro)
+        ; (fun g ->
+            (* replacement of the function by its body *)
+            let args = nLastDecls nb_args g in
+            let open Context.Named.Declaration in
+            let args_id = List.map get_id args in
+            let dyn_infos =
+              { nb_rec_hyps = -100
+              ; rec_hyps = []
+              ; info =
+                  Reductionops.nf_betaiota (pf_env g) (project g)
+                    (applist
+                       ( fbody_with_full_params
+                       , List.rev_map var_of_decl princ_params
+                         @ List.rev_map mkVar args_id ))
+              ; eq_hyps = [] }
+            in
+            let fname =
+              destConst (project g)
+                (fst (decompose_app (project g) (List.hd (List.rev pte_args))))
+            in
+            tclTHENLIST
+              [ Proofview.V82.of_tactic
+                  (unfold_in_concl
+                     [(Locus.AllOccurrences, Names.EvalConstRef (fst fname))])
+              ; (let do_prove =
+                   build_proof interactive_proof (Array.to_list fnames)
+                     (Id.Map.map prove_rec_hyp ptes_to_fix)
+                 in
+                 let prove_tac branches =
+                   let dyn_infos =
+                     { dyn_infos with
+                       rec_hyps = branches
+                     ; nb_rec_hyps = List.length branches }
+                   in
+                   clean_goal_with_heq
+                     (Id.Map.map prove_rec_hyp ptes_to_fix)
+                     do_prove dyn_infos
+                 in
+                 instantiate_hyps_with_args prove_tac
+                   (List.rev_map id_of_decl princ_info.branches)
+                   (List.rev args_id)) ]
+              g) ]
+        gl
+  in
+  tclTHEN first_tac intros_after_fixes g
 
 (* Proof of principles of general functions *)
 (* let  hrec_id = Recdef.hrec_id *)
@@ -1319,132 +1231,119 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 (* and list_rewrite = Recdef.list_rewrite *)
 (* and evaluable_of_global_reference = Recdef.evaluable_of_global_reference *)
 
-
-
-
-
 let prove_with_tcc tcc_lemma_constr eqs : tactic =
   match !tcc_lemma_constr with
   | Undefined -> anomaly (Pp.str "No tcc proof !!")
   | Value lemma ->
-        fun gls ->
-(*        let hid = next_ident_away_in_goal h_id (pf_ids_of_hyps gls) in *)
-(*        let ids = hid::pf_ids_of_hyps gls in  *)
-          tclTHENLIST
-            [
-(*            generalize [lemma]; *)
-(*            h_intro hid; *)
-(*            Elim.h_decompose_and (mkVar hid); *)
-              tclTRY(list_rewrite true eqs);
-(*            (fun g ->  *)
-(*               let ids' = pf_ids_of_hyps g in  *)
-(*               let ids = List.filter (fun id -> not (List.mem id ids)) ids' in  *)
-(*               rewrite *)
-(*            ) *)
-              Proofview.V82.of_tactic (Eauto.gen_eauto (false,5) [] (Some []))
-            ]
-            gls
+    fun gls ->
+      (*        let hid = next_ident_away_in_goal h_id (pf_ids_of_hyps gls) in *)
+      (*        let ids = hid::pf_ids_of_hyps gls in  *)
+      tclTHENLIST
+        [ (*            generalize [lemma]; *)
+          (*            h_intro hid; *)
+          (*            Elim.h_decompose_and (mkVar hid); *)
+          tclTRY (list_rewrite true eqs)
+        ; (*            (fun g ->  *)
+          (*               let ids' = pf_ids_of_hyps g in  *)
+          (*               let ids = List.filter (fun id -> not (List.mem id ids)) ids' in  *)
+          (*               rewrite *)
+          (*            ) *)
+          Proofview.V82.of_tactic (Eauto.gen_eauto (false, 5) [] (Some [])) ]
+        gls
   | Not_needed -> tclIDTAC
 
 let backtrack_eqs_until_hrec hrec eqs : tactic =
-  fun gls ->
-    let eqs = List.map mkVar eqs in
-    let rewrite =
-      tclFIRST (List.map (fun x -> Proofview.V82.of_tactic (Equality.rewriteRL x)) eqs )
-    in
-    let _,hrec_concl  = decompose_prod (project gls) (pf_get_hyp_typ gls hrec) in
-    let f_app = Array.last (snd (destApp (project gls) hrec_concl)) in
-    let f =  (fst (destApp (project gls) f_app)) in
-    let rec backtrack : tactic =
-      fun g ->
-        let f_app = Array.last (snd (destApp (project g) (pf_concl g))) in
-        match EConstr.kind (project g) f_app with
-          | App(f',_) when eq_constr (project g) f' f -> tclIDTAC g
-          | _ -> tclTHEN rewrite backtrack g
-    in
-    backtrack gls
-
+ fun gls ->
+  let eqs = List.map mkVar eqs in
+  let rewrite =
+    tclFIRST
+      (List.map (fun x -> Proofview.V82.of_tactic (Equality.rewriteRL x)) eqs)
+  in
+  let _, hrec_concl = decompose_prod (project gls) (pf_get_hyp_typ gls hrec) in
+  let f_app = Array.last (snd (destApp (project gls) hrec_concl)) in
+  let f = fst (destApp (project gls) f_app) in
+  let rec backtrack : tactic =
+   fun g ->
+    let f_app = Array.last (snd (destApp (project g) (pf_concl g))) in
+    match EConstr.kind (project g) f_app with
+    | App (f', _) when eq_constr (project g) f' f -> tclIDTAC g
+    | _ -> tclTHEN rewrite backtrack g
+  in
+  backtrack gls
 
 let rec rewrite_eqs_in_eqs eqs =
   match eqs with
-    | [] -> tclIDTAC
-    | eq::eqs ->
-
-          tclTHEN
-            (tclMAP
-               (fun id gl ->
-                  observe_tac
-                    (Format.sprintf "rewrite %s in %s " (Id.to_string eq) (Id.to_string id))
-                    (tclTRY (Proofview.V82.of_tactic (Equality.general_rewrite_in true Locus.AllOccurrences
-                               true (* dep proofs also: *) true id (mkVar eq) false)))
-                    gl
-               )
-               eqs
-            )
-            (rewrite_eqs_in_eqs eqs)
+  | [] -> tclIDTAC
+  | eq :: eqs ->
+    tclTHEN
+      (tclMAP
+         (fun id gl ->
+           observe_tac
+             (Format.sprintf "rewrite %s in %s " (Id.to_string eq)
+                (Id.to_string id))
+             (tclTRY
+                (Proofview.V82.of_tactic
+                   (Equality.general_rewrite_in true Locus.AllOccurrences true
+                      (* dep proofs also: *) true id (mkVar eq) false)))
+             gl)
+         eqs)
+      (rewrite_eqs_in_eqs eqs)
 
 let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
-  fun gls ->
-    (tclTHENLIST
-       [
-         backtrack_eqs_until_hrec hrec eqs;
-         (* observe_tac ("new_prove_with_tcc ( applying "^(Id.to_string hrec)^" )" ) *)
-         (tclTHENS  (* We must have exactly ONE subgoal !*)
-            (Proofview.V82.of_tactic (apply (mkVar hrec)))
-            [ tclTHENLIST
-                [
-                  (Proofview.V82.of_tactic (keep (tcc_hyps@eqs)));
-                  (Proofview.V82.of_tactic (apply (Lazy.force acc_inv)));
-                  (fun g ->
-                     if is_mes
-                     then
-                       Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, evaluable_of_global_reference (delayed_force ltof_ref))]) g
-                     else tclIDTAC g
-                  );
-                  observe_tac "rew_and_finish"
-                    (tclTHENLIST
-                       [tclTRY(list_rewrite false (List.map (fun v -> (mkVar v,true)) eqs));
-                        observe_tac "rewrite_eqs_in_eqs" (rewrite_eqs_in_eqs eqs);
-                         (observe_tac "finishing using"
-                           (
-                            tclCOMPLETE(
-                              Proofview.V82.of_tactic @@
-                              Eauto.eauto_with_bases
-                                (true,5)
+ fun gls ->
+  (tclTHENLIST
+     [ backtrack_eqs_until_hrec hrec eqs
+     ; (* observe_tac ("new_prove_with_tcc ( applying "^(Id.to_string hrec)^" )" ) *)
+       tclTHENS (* We must have exactly ONE subgoal !*)
+         (Proofview.V82.of_tactic (apply (mkVar hrec)))
+         [ tclTHENLIST
+             [ Proofview.V82.of_tactic (keep (tcc_hyps @ eqs))
+             ; Proofview.V82.of_tactic (apply (Lazy.force acc_inv))
+             ; (fun g ->
+                 if is_mes then
+                   Proofview.V82.of_tactic
+                     (unfold_in_concl
+                        [ ( Locus.AllOccurrences
+                          , evaluable_of_global_reference
+                              (delayed_force ltof_ref) ) ])
+                     g
+                 else tclIDTAC g)
+             ; observe_tac "rew_and_finish"
+                 (tclTHENLIST
+                    [ tclTRY
+                        (list_rewrite false
+                           (List.map (fun v -> (mkVar v, true)) eqs))
+                    ; observe_tac "rewrite_eqs_in_eqs" (rewrite_eqs_in_eqs eqs)
+                    ; observe_tac "finishing using"
+                        (tclCOMPLETE
+                           ( Proofview.V82.of_tactic
+                           @@ Eauto.eauto_with_bases (true, 5)
                                 [(fun _ sigma -> (sigma, Lazy.force refl_equal))]
-                                [Hints.Hint_db.empty TransparentState.empty false]
-                            )
-                          )
-                         )
-                       ]
-                    )
-                ]
-            ])
-       ])
-      gls
-
+                                [ Hints.Hint_db.empty TransparentState.empty
+                                    false ] )) ]) ] ] ])
+    gls
 
 let is_valid_hypothesis sigma predicates_name =
-  let predicates_name = List.fold_right Id.Set.add predicates_name Id.Set.empty in
+  let predicates_name =
+    List.fold_right Id.Set.add predicates_name Id.Set.empty
+  in
   let is_pte typ =
-    if isApp sigma typ
-    then
-      let pte,_ = destApp sigma typ in
-      if isVar sigma pte
-      then Id.Set.mem (destVar sigma pte) predicates_name
+    if isApp sigma typ then
+      let pte, _ = destApp sigma typ in
+      if isVar sigma pte then Id.Set.mem (destVar sigma pte) predicates_name
       else false
     else false
   in
   let rec is_valid_hypothesis typ =
-    is_pte typ ||
-      match EConstr.kind sigma typ with
-        | Prod(_,pte,typ') -> is_pte pte && is_valid_hypothesis typ'
-        | _ -> false
+    is_pte typ
+    ||
+    match EConstr.kind sigma typ with
+    | Prod (_, pte, typ') -> is_pte pte && is_valid_hypothesis typ'
+    | _ -> false
   in
   is_valid_hypothesis
 
-let prove_principle_for_gen
-    (f_ref,functional_ref,eq_ref) tcc_lemma_ref is_mes
+let prove_principle_for_gen (f_ref, functional_ref, eq_ref) tcc_lemma_ref is_mes
     rec_arg_num rec_arg_type relation gl =
   let princ_type = pf_concl gl in
   let princ_info = compute_elim_sig (project gl) princ_type in
@@ -1452,9 +1351,9 @@ let prove_principle_for_gen
     let avoid = ref (pf_ids_of_hyps gl) in
     fun na ->
       let new_id =
-          match na with
-            | Name id -> fresh_id !avoid (Id.to_string id)
-            | Anonymous -> fresh_id !avoid "H"
+        match na with
+        | Name id -> fresh_id !avoid (Id.to_string id)
+        | Anonymous -> fresh_id !avoid "H"
       in
       avoid := new_id :: !avoid;
       Name new_id
@@ -1462,200 +1361,182 @@ let prove_principle_for_gen
   let fresh_decl = map_name fresh_id in
   let princ_info : elim_scheme =
     { princ_info with
-        params = List.map fresh_decl princ_info.params;
-        predicates = List.map fresh_decl princ_info.predicates;
-        branches = List.map fresh_decl princ_info.branches;
-        args = List.map fresh_decl princ_info.args
-    }
+      params = List.map fresh_decl princ_info.params
+    ; predicates = List.map fresh_decl princ_info.predicates
+    ; branches = List.map fresh_decl princ_info.branches
+    ; args = List.map fresh_decl princ_info.args }
   in
   let wf_tac =
-    if is_mes
-    then
-      (fun b ->
-         Proofview.V82.of_tactic @@
-         Recdef.tclUSER_if_not_mes Tacticals.New.tclIDTAC b None)
+    if is_mes then fun b ->
+      Proofview.V82.of_tactic
+      @@ Recdef.tclUSER_if_not_mes Tacticals.New.tclIDTAC b None
     else fun _ -> prove_with_tcc tcc_lemma_ref []
   in
   let real_rec_arg_num = rec_arg_num - princ_info.nparams in
   let npost_rec_arg = princ_info.nargs - real_rec_arg_num + 1 in
-(*   observe ( *)
-(*     str "princ_type := " ++ pr_lconstr  princ_type ++ fnl () ++ *)
-(*     str "princ_info.nparams := " ++ int princ_info.nparams ++ fnl () ++  *)
-
-(*       str "princ_info.nargs := " ++ int princ_info.nargs ++ fnl () ++  *)
-(*     str "rec_arg_num := " ++ int rec_arg_num ++ fnl() ++  *)
-(*           str "real_rec_arg_num := " ++ int real_rec_arg_num ++ fnl () ++ *)
-(*           str "npost_rec_arg := " ++ int npost_rec_arg ); *)
-  let (post_rec_arg,pre_rec_arg) =
+  (*   observe ( *)
+  (*     str "princ_type := " ++ pr_lconstr  princ_type ++ fnl () ++ *)
+  (*     str "princ_info.nparams := " ++ int princ_info.nparams ++ fnl () ++  *)
+
+  (*       str "princ_info.nargs := " ++ int princ_info.nargs ++ fnl () ++  *)
+  (*     str "rec_arg_num := " ++ int rec_arg_num ++ fnl() ++  *)
+  (*           str "real_rec_arg_num := " ++ int real_rec_arg_num ++ fnl () ++ *)
+  (*           str "npost_rec_arg := " ++ int npost_rec_arg ); *)
+  let post_rec_arg, pre_rec_arg =
     Util.List.chop npost_rec_arg princ_info.args
   in
   let rec_arg_id =
     match List.rev post_rec_arg with
-      | (LocalAssum ({binder_name=Name id},_) | LocalDef ({binder_name=Name id},_,_)) :: _ -> id
-      | _ -> assert false
+    | ( LocalAssum ({binder_name = Name id}, _)
+      | LocalDef ({binder_name = Name id}, _, _) )
+      :: _ ->
+      id
+    | _ -> assert false
+  in
+  (*   observe (str "rec_arg_id := " ++ pr_lconstr (mkVar rec_arg_id)); *)
+  let subst_constrs =
+    List.map
+      (get_name %> Nameops.Name.get_id %> mkVar)
+      (pre_rec_arg @ princ_info.params)
   in
-(*   observe (str "rec_arg_id := " ++ pr_lconstr (mkVar rec_arg_id)); *)
-  let subst_constrs = List.map (get_name %> Nameops.Name.get_id %> mkVar) (pre_rec_arg@princ_info.params) in
   let relation = substl subst_constrs relation in
   let input_type = substl subst_constrs rec_arg_type in
   let wf_thm_id = Nameops.Name.get_id (fresh_id (Name (Id.of_string "wf_R"))) in
   let acc_rec_arg_id =
-    Nameops.Name.get_id (fresh_id (Name (Id.of_string ("Acc_"^(Id.to_string rec_arg_id)))))
+    Nameops.Name.get_id
+      (fresh_id (Name (Id.of_string ("Acc_" ^ Id.to_string rec_arg_id))))
   in
   let revert l =
-    tclTHEN (Proofview.V82.of_tactic (Tactics.generalize (List.map mkVar l))) (Proofview.V82.of_tactic (clear l))
+    tclTHEN
+      (Proofview.V82.of_tactic (Tactics.generalize (List.map mkVar l)))
+      (Proofview.V82.of_tactic (clear l))
   in
   let fix_id = Nameops.Name.get_id (fresh_id (Name hrec_id)) in
   let prove_rec_arg_acc g =
-      ((* observe_tac "prove_rec_arg_acc"  *)
-         (tclCOMPLETE
-            (tclTHEN
-               (Proofview.V82.of_tactic (assert_by (Name wf_thm_id)
-                  (mkApp (delayed_force well_founded,[|input_type;relation|]))
-                  (Proofview.V82.tactic (fun g -> (* observe_tac "prove wf" *) (tclCOMPLETE (wf_tac is_mes)) g))))
-               (
-                 (* observe_tac  *)
-(*                 "apply wf_thm"  *)
-                 Proofview.V82.of_tactic (Tactics.Simple.apply (mkApp(mkVar wf_thm_id,[|mkVar rec_arg_id|])))
-               )
-            )
-         )
-      )
+    ((* observe_tac "prove_rec_arg_acc"  *)
+     tclCOMPLETE
+       (tclTHEN
+          (Proofview.V82.of_tactic
+             (assert_by (Name wf_thm_id)
+                (mkApp (delayed_force well_founded, [|input_type; relation|]))
+                (Proofview.V82.tactic (fun g ->
+                     (* observe_tac "prove wf" *)
+                     (tclCOMPLETE (wf_tac is_mes)) g))))
+          ((* observe_tac  *)
+           (*                 "apply wf_thm"  *)
+           Proofview.V82.of_tactic
+             (Tactics.Simple.apply
+                (mkApp (mkVar wf_thm_id, [|mkVar rec_arg_id|]))))))
       g
   in
   let args_ids = List.map (get_name %> Nameops.Name.get_id) princ_info.args in
   let lemma =
     match !tcc_lemma_ref with
-     | Undefined -> user_err Pp.(str "No tcc proof !!")
-     | Value lemma -> EConstr.of_constr lemma
-     | Not_needed -> EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.I")
+    | Undefined -> user_err Pp.(str "No tcc proof !!")
+    | Value lemma -> EConstr.of_constr lemma
+    | Not_needed ->
+      EConstr.of_constr
+        (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.True.I")
   in
-(*   let rec list_diff del_list check_list = *)
-(*     match del_list with *)
-(*          [] -> *)
-(*            [] *)
-(*       | f::r -> *)
-(*           if List.mem f check_list then *)
-(*                list_diff r check_list *)
-(*           else *)
-(*                f::(list_diff r check_list) *)
-(*   in *)
+  (*   let rec list_diff del_list check_list = *)
+  (*     match del_list with *)
+  (*          [] -> *)
+  (*            [] *)
+  (*       | f::r -> *)
+  (*           if List.mem f check_list then *)
+  (*                list_diff r check_list *)
+  (*           else *)
+  (*                f::(list_diff r check_list) *)
+  (*   in *)
   let tcc_list = ref [] in
   let start_tac gls =
     let hyps = pf_ids_of_hyps gls in
-      let hid =
-        next_ident_away_in_goal
-          (Id.of_string "prov")
-          (Id.Set.of_list hyps)
-      in
-      tclTHENLIST
-        [
-          Proofview.V82.of_tactic (generalize [lemma]);
-          Proofview.V82.of_tactic (Simple.intro hid);
-          Proofview.V82.of_tactic (Elim.h_decompose_and (mkVar hid));
-          (fun g ->
-             let new_hyps = pf_ids_of_hyps g in
-             tcc_list := List.rev (List.subtract Id.equal new_hyps (hid::hyps));
-             if List.is_empty !tcc_list
-             then
-               begin
-                 tcc_list := [hid];
-                 tclIDTAC g
-               end
-             else thin [hid] g
-          )
-          ]
-          gls
+    let hid =
+      next_ident_away_in_goal (Id.of_string "prov") (Id.Set.of_list hyps)
+    in
+    tclTHENLIST
+      [ Proofview.V82.of_tactic (generalize [lemma])
+      ; Proofview.V82.of_tactic (Simple.intro hid)
+      ; Proofview.V82.of_tactic (Elim.h_decompose_and (mkVar hid))
+      ; (fun g ->
+          let new_hyps = pf_ids_of_hyps g in
+          tcc_list := List.rev (List.subtract Id.equal new_hyps (hid :: hyps));
+          if List.is_empty !tcc_list then begin
+            tcc_list := [hid];
+            tclIDTAC g
+          end
+          else thin [hid] g) ]
+      gls
   in
   tclTHENLIST
-    [
-      observe_tac "start_tac" start_tac;
-      h_intros
-        (List.rev_map (get_name %> Nameops.Name.get_id)
-           (princ_info.args@princ_info.branches@princ_info.predicates@princ_info.params)
-        );
-      Proofview.V82.of_tactic
-        (assert_by
-           (Name acc_rec_arg_id)
-           (mkApp (delayed_force acc_rel,[|input_type;relation;mkVar rec_arg_id|]))
-           (Proofview.V82.tactic prove_rec_arg_acc));
-      (revert (List.rev (acc_rec_arg_id::args_ids)));
-      (Proofview.V82.of_tactic (fix fix_id (List.length args_ids + 1)));
-      h_intros (List.rev (acc_rec_arg_id::args_ids));
-      Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_ref));
-      (fun gl' ->
-         let body =
-           let _,args = destApp (project gl') (pf_concl gl') in
-           Array.last args
-         in
-         let body_info rec_hyps =
-           {
-             nb_rec_hyps = List.length rec_hyps;
-             rec_hyps = rec_hyps;
-             eq_hyps = [];
-             info = body
-           }
-         in
-         let acc_inv =
-           lazy (
-             mkApp (
-               delayed_force acc_inv_id,
-               [|input_type;relation;mkVar rec_arg_id|]
-             )
-           )
-         in
-         let acc_inv = lazy (mkApp(Lazy.force acc_inv, [|mkVar  acc_rec_arg_id|])) in
-         let predicates_names =
-           List.map (get_name %> Nameops.Name.get_id) princ_info.predicates
-         in
-         let pte_info =
-           { proving_tac =
-               (fun eqs ->
-(*                msgnl (str "tcc_list := "++ prlist_with_sep spc Ppconstr.pr_id  !tcc_list); *)
-(*                msgnl (str "princ_info.args := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.args)); *)
-(*                msgnl (str "princ_info.params := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.params)); *)
-(*                msgnl (str "acc_rec_arg_id := "++  Ppconstr.pr_id acc_rec_arg_id); *)
-(*                msgnl (str "eqs := "++ prlist_with_sep spc Ppconstr.pr_id  eqs); *)
-
-                  (* observe_tac "new_prove_with_tcc"  *)
-                    (new_prove_with_tcc
-                       is_mes acc_inv fix_id
-
-                       (!tcc_list@(List.map
-                           (get_name %> Nameops.Name.get_id)
-                           (princ_info.args@princ_info.params)
-                        )@ ([acc_rec_arg_id])) eqs
-                    )
-
-               );
-             is_valid = is_valid_hypothesis (project gl') predicates_names
-           }
-         in
-         let ptes_info : pte_info Id.Map.t =
-           List.fold_left
-             (fun map pte_id ->
-                Id.Map.add pte_id
-                  pte_info
-                  map
-             )
-             Id.Map.empty
-             predicates_names
-         in
-         let make_proof rec_hyps =
-           build_proof
-             false
-             [f_ref]
-             ptes_info
-             (body_info rec_hyps)
-         in
-         (* observe_tac "instantiate_hyps_with_args"  *)
-           (instantiate_hyps_with_args
-              make_proof
-              (List.map (get_name %> Nameops.Name.get_id) princ_info.branches)
-              (List.rev args_ids)
-           )
-           gl'
-      )
-
-    ]
+    [ observe_tac "start_tac" start_tac
+    ; h_intros
+        (List.rev_map
+           (get_name %> Nameops.Name.get_id)
+           ( princ_info.args @ princ_info.branches @ princ_info.predicates
+           @ princ_info.params ))
+    ; Proofview.V82.of_tactic
+        (assert_by (Name acc_rec_arg_id)
+           (mkApp
+              (delayed_force acc_rel, [|input_type; relation; mkVar rec_arg_id|]))
+           (Proofview.V82.tactic prove_rec_arg_acc))
+    ; revert (List.rev (acc_rec_arg_id :: args_ids))
+    ; Proofview.V82.of_tactic (fix fix_id (List.length args_ids + 1))
+    ; h_intros (List.rev (acc_rec_arg_id :: args_ids))
+    ; Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_ref))
+    ; (fun gl' ->
+        let body =
+          let _, args = destApp (project gl') (pf_concl gl') in
+          Array.last args
+        in
+        let body_info rec_hyps =
+          { nb_rec_hyps = List.length rec_hyps
+          ; rec_hyps
+          ; eq_hyps = []
+          ; info = body }
+        in
+        let acc_inv =
+          lazy
+            (mkApp
+               ( delayed_force acc_inv_id
+               , [|input_type; relation; mkVar rec_arg_id|] ))
+        in
+        let acc_inv =
+          lazy (mkApp (Lazy.force acc_inv, [|mkVar acc_rec_arg_id|]))
+        in
+        let predicates_names =
+          List.map (get_name %> Nameops.Name.get_id) princ_info.predicates
+        in
+        let pte_info =
+          { proving_tac =
+              (fun eqs ->
+                (*                msgnl (str "tcc_list := "++ prlist_with_sep spc Ppconstr.pr_id  !tcc_list); *)
+                (*                msgnl (str "princ_info.args := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.args)); *)
+                (*                msgnl (str "princ_info.params := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.params)); *)
+                (*                msgnl (str "acc_rec_arg_id := "++  Ppconstr.pr_id acc_rec_arg_id); *)
+                (*                msgnl (str "eqs := "++ prlist_with_sep spc Ppconstr.pr_id  eqs); *)
+
+                (* observe_tac "new_prove_with_tcc"  *)
+                new_prove_with_tcc is_mes acc_inv fix_id
+                  ( !tcc_list
+                  @ List.map
+                      (get_name %> Nameops.Name.get_id)
+                      (princ_info.args @ princ_info.params)
+                  @ [acc_rec_arg_id] )
+                  eqs)
+          ; is_valid = is_valid_hypothesis (project gl') predicates_names }
+        in
+        let ptes_info : pte_info Id.Map.t =
+          List.fold_left
+            (fun map pte_id -> Id.Map.add pte_id pte_info map)
+            Id.Map.empty predicates_names
+        in
+        let make_proof rec_hyps =
+          build_proof false [f_ref] ptes_info (body_info rec_hyps)
+        in
+        (* observe_tac "instantiate_hyps_with_args"  *)
+        (instantiate_hyps_with_args make_proof
+           (List.map (get_name %> Nameops.Name.get_id) princ_info.branches)
+           (List.rev args_ids))
+          gl') ]
     gl
diff --git a/plugins/funind/functional_principles_proofs.mli b/plugins/funind/functional_principles_proofs.mli
index 64fbfaeedf..52089ca7fb 100644
--- a/plugins/funind/functional_principles_proofs.mli
+++ b/plugins/funind/functional_principles_proofs.mli
@@ -1,19 +1,27 @@
 open Names
 
 val prove_princ_for_struct :
-  Evd.evar_map ref ->
-  bool ->
-  int -> Constant.t array -> EConstr.constr array -> int -> Tacmach.tactic
-
+     Evd.evar_map ref
+  -> bool
+  -> int
+  -> Constant.t array
+  -> EConstr.constr array
+  -> int
+  -> Tacmach.tactic
 
 val prove_principle_for_gen :
-  Constant.t * Constant.t * Constant.t -> (* name of the function, the functional and the fixpoint equation *)
-  Indfun_common.tcc_lemma_value ref -> (* a pointer to the obligation proofs lemma *)
-  bool -> (* is that function uses measure *)
-  int -> (* the number of recursive argument *)
-  EConstr.types -> (* the type of the recursive argument *)
-  EConstr.constr -> (* the wf relation used to prove the function *)
-  Tacmach.tactic
-
+     Constant.t * Constant.t * Constant.t
+  -> (* name of the function, the functional and the fixpoint equation *)
+     Indfun_common.tcc_lemma_value ref
+  -> (* a pointer to the obligation proofs lemma *)
+     bool
+  -> (* is that function uses measure *)
+     int
+  -> (* the number of recursive argument *)
+     EConstr.types
+  -> (* the type of the recursive argument *)
+     EConstr.constr
+  -> (* the wf relation used to prove the function *)
+     Tacmach.tactic
 
 (* val is_pte  : rel_declaration -> bool  *)
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 163645b719..1ab747ca09 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -20,16 +20,12 @@ open Pp
 open Tactics
 open Context.Rel.Declaration
 open Indfun_common
-
 module RelDecl = Context.Rel.Declaration
 
-exception Toberemoved_with_rel of int*constr
+exception Toberemoved_with_rel of int * constr
 exception Toberemoved
 
-let observe s =
-  if do_observe ()
-  then Feedback.msg_debug s
-
+let observe s = if do_observe () then Feedback.msg_debug s
 let pop t = Vars.lift (-1) t
 
 (*
@@ -42,203 +38,211 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
   let env = Global.env () in
   let env_with_params = EConstr.push_rel_context princ_type_info.params env in
   let tbl = Hashtbl.create 792 in
-  let rec change_predicates_names (avoid:Id.t list) (predicates:EConstr.rel_context)  : EConstr.rel_context =
+  let rec change_predicates_names (avoid : Id.t list)
+      (predicates : EConstr.rel_context) : EConstr.rel_context =
     match predicates with
     | [] -> []
-    | decl :: predicates ->
-       (match Context.Rel.Declaration.get_name decl with
-        | Name x ->
-           let id = Namegen.next_ident_away x (Id.Set.of_list avoid) in
-           Hashtbl.add tbl id x;
-           RelDecl.set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
-        | Anonymous -> anomaly (Pp.str "Anonymous property binder."))
+    | decl :: predicates -> (
+      match Context.Rel.Declaration.get_name decl with
+      | Name x ->
+        let id = Namegen.next_ident_away x (Id.Set.of_list avoid) in
+        Hashtbl.add tbl id x;
+        RelDecl.set_name (Name id) decl
+        :: change_predicates_names (id :: avoid) predicates
+      | Anonymous -> anomaly (Pp.str "Anonymous property binder.") )
   in
-  let avoid = (Termops.ids_of_context env_with_params ) in
+  let avoid = Termops.ids_of_context env_with_params in
   let princ_type_info =
     { princ_type_info with
-        predicates = change_predicates_names avoid princ_type_info.predicates
-    }
+      predicates = change_predicates_names avoid princ_type_info.predicates }
   in
-(*   observe (str "starting princ_type := " ++ pr_lconstr_env env princ_type); *)
-(*   observe (str "princ_infos : " ++ pr_elim_scheme princ_type_info); *)
+  (*   observe (str "starting princ_type := " ++ pr_lconstr_env env princ_type); *)
+  (*   observe (str "princ_infos : " ++ pr_elim_scheme princ_type_info); *)
   let change_predicate_sort i decl =
     let new_sort = sorts.(i) in
-    let args,_ = decompose_prod_assum (EConstr.Unsafe.to_constr (RelDecl.get_type decl)) in
+    let args, _ =
+      decompose_prod_assum (EConstr.Unsafe.to_constr (RelDecl.get_type decl))
+    in
     let real_args =
-      if princ_type_info.indarg_in_concl
-      then List.tl args
-      else args
+      if princ_type_info.indarg_in_concl then List.tl args else args
     in
-    Context.Named.Declaration.LocalAssum (map_annot Nameops.Name.get_id (Context.Rel.Declaration.get_annot decl),
-                                          Term.it_mkProd_or_LetIn (mkSort new_sort) real_args)
+    Context.Named.Declaration.LocalAssum
+      ( map_annot Nameops.Name.get_id (Context.Rel.Declaration.get_annot decl)
+      , Term.it_mkProd_or_LetIn (mkSort new_sort) real_args )
   in
   let new_predicates =
-    List.map_i
-      change_predicate_sort
-      0
-      princ_type_info.predicates
+    List.map_i change_predicate_sort 0 princ_type_info.predicates
+  in
+  let env_with_params_and_predicates =
+    List.fold_right Environ.push_named new_predicates env_with_params
   in
-  let env_with_params_and_predicates = List.fold_right Environ.push_named new_predicates env_with_params in
   let rel_as_kn =
-    fst (match princ_type_info.indref with
-           | Some (GlobRef.IndRef ind) -> ind
-           | _ -> user_err Pp.(str "Not a valid predicate")
-        )
+    fst
+      ( match princ_type_info.indref with
+      | Some (GlobRef.IndRef ind) -> ind
+      | _ -> user_err Pp.(str "Not a valid predicate") )
   in
   let ptes_vars = List.map Context.Named.Declaration.get_id new_predicates in
   let is_pte =
     let set = List.fold_right Id.Set.add ptes_vars Id.Set.empty in
-    fun t ->
-      match Constr.kind t with
-        | Var id -> Id.Set.mem id set
-        | _ -> false
+    fun t -> match Constr.kind t with Var id -> Id.Set.mem id set | _ -> false
   in
   let pre_princ =
     let open EConstr in
     it_mkProd_or_LetIn
       (it_mkProd_or_LetIn
-         (Option.fold_right
-                           mkProd_or_LetIn
-                           princ_type_info.indarg
-                           princ_type_info.concl
-                        )
-         princ_type_info.args
-      )
+         (Option.fold_right mkProd_or_LetIn princ_type_info.indarg
+            princ_type_info.concl)
+         princ_type_info.args)
       princ_type_info.branches
   in
   let pre_princ = EConstr.Unsafe.to_constr pre_princ in
   let pre_princ = substl (List.map mkVar ptes_vars) pre_princ in
   let is_dom c =
     match Constr.kind c with
-      | Ind((u,_),_) -> MutInd.equal u rel_as_kn
-      | Construct(((u,_),_),_) -> MutInd.equal u rel_as_kn
-      | _ -> false
+    | Ind ((u, _), _) -> MutInd.equal u rel_as_kn
+    | Construct (((u, _), _), _) -> MutInd.equal u rel_as_kn
+    | _ -> false
   in
   let get_fun_num c =
     match Constr.kind c with
-      | Ind((_,num),_) -> num
-      | Construct(((_,num),_),_) -> num
-      | _ -> assert false
+    | Ind ((_, num), _) -> num
+    | Construct (((_, num), _), _) -> num
+    | _ -> assert false
   in
   let dummy_var = mkVar (Id.of_string "________") in
   let mk_replacement c i args =
-    let res = mkApp(rel_to_fun.(i), Array.map pop (array_get_start args)) in
-    observe (str "replacing " ++
-             pr_lconstr_env env Evd.empty c ++ str " by "  ++
-             pr_lconstr_env env Evd.empty res);
+    let res = mkApp (rel_to_fun.(i), Array.map pop (array_get_start args)) in
+    observe
+      ( str "replacing "
+      ++ pr_lconstr_env env Evd.empty c
+      ++ str " by "
+      ++ pr_lconstr_env env Evd.empty res );
     res
   in
-  let rec compute_new_princ_type remove env pre_princ : types*(constr list) =
-    let (new_princ_type,_) as res =
+  let rec compute_new_princ_type remove env pre_princ : types * constr list =
+    let ((new_princ_type, _) as res) =
       match Constr.kind pre_princ with
-        | Rel n ->
-            begin
-              try match Environ.lookup_rel n env with
-                | LocalAssum (_,t) | LocalDef (_,_,t) when is_dom t -> raise Toberemoved
-                | _ -> pre_princ,[]
-              with Not_found -> assert false
-            end
-        | Prod(x,t,b) ->
-            compute_new_princ_type_for_binder remove mkProd env x t b
-        | Lambda(x,t,b) ->
-            compute_new_princ_type_for_binder  remove mkLambda env x t b
-        | Ind _ | Construct _ when is_dom pre_princ -> raise Toberemoved
-        | App(f,args) when is_dom f ->
-            let var_to_be_removed = destRel (Array.last args) in
-            let num = get_fun_num f in
-            raise (Toberemoved_with_rel (var_to_be_removed,mk_replacement pre_princ num args))
-        | App(f,args) ->
-            let args =
-              if is_pte f && remove
-              then array_get_start args
-              else args
-            in
-            let new_args,binders_to_remove =
-              Array.fold_right (compute_new_princ_type_with_acc remove env)
-                args
-                ([],[])
-            in
-            let new_f,binders_to_remove_from_f = compute_new_princ_type remove env f in
-            applistc new_f new_args,
-            list_union_eq Constr.equal binders_to_remove_from_f binders_to_remove
-        | LetIn(x,v,t,b) ->
-            compute_new_princ_type_for_letin remove env x v t b
-        | _ -> pre_princ,[]
+      | Rel n -> (
+        try
+          match Environ.lookup_rel n env with
+          | (LocalAssum (_, t) | LocalDef (_, _, t)) when is_dom t ->
+            raise Toberemoved
+          | _ -> (pre_princ, [])
+        with Not_found -> assert false )
+      | Prod (x, t, b) ->
+        compute_new_princ_type_for_binder remove mkProd env x t b
+      | Lambda (x, t, b) ->
+        compute_new_princ_type_for_binder remove mkLambda env x t b
+      | (Ind _ | Construct _) when is_dom pre_princ -> raise Toberemoved
+      | App (f, args) when is_dom f ->
+        let var_to_be_removed = destRel (Array.last args) in
+        let num = get_fun_num f in
+        raise
+          (Toberemoved_with_rel
+             (var_to_be_removed, mk_replacement pre_princ num args))
+      | App (f, args) ->
+        let args = if is_pte f && remove then array_get_start args else args in
+        let new_args, binders_to_remove =
+          Array.fold_right
+            (compute_new_princ_type_with_acc remove env)
+            args ([], [])
+        in
+        let new_f, binders_to_remove_from_f =
+          compute_new_princ_type remove env f
+        in
+        ( applistc new_f new_args
+        , list_union_eq Constr.equal binders_to_remove_from_f binders_to_remove
+        )
+      | LetIn (x, v, t, b) ->
+        compute_new_princ_type_for_letin remove env x v t b
+      | _ -> (pre_princ, [])
     in
-(*     let _ = match Constr.kind pre_princ with *)
-(*      | Prod _ -> *)
-(*          observe(str "compute_new_princ_type for "++ *)
-(*            pr_lconstr_env env pre_princ ++ *)
-(*            str" is "++ *)
-(*            pr_lconstr_env env new_princ_type ++ fnl ()) *)
-(*      | _ -> () in *)
+    (*     let _ = match Constr.kind pre_princ with *)
+    (*      | Prod _ -> *)
+    (*          observe(str "compute_new_princ_type for "++ *)
+    (*            pr_lconstr_env env pre_princ ++ *)
+    (*            str" is "++ *)
+    (*            pr_lconstr_env env new_princ_type ++ fnl ()) *)
+    (*      | _ -> () in *)
     res
-
   and compute_new_princ_type_for_binder remove bind_fun env x t b =
-    begin
-      try
-        let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in
-        let new_x = map_annot (get_name (Termops.ids_of_context env)) x in
-        let new_env = Environ.push_rel (LocalAssum (x,t)) env in
-        let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in
-         if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b
-         then (pop new_b), filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b
-         else
-           (
-             bind_fun(new_x,new_t,new_b),
-             list_union_eq
-               Constr.equal
-               binders_to_remove_from_t
-               (List.map pop binders_to_remove_from_b)
-           )
-
-       with
-         | Toberemoved ->
-(*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
-            let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b)  in
-            new_b, List.map pop binders_to_remove_from_b
-        | Toberemoved_with_rel (n,c) ->
-(*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
-            let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b)  in
-            new_b, list_add_set_eq Constr.equal (mkRel n) (List.map pop binders_to_remove_from_b)
-    end
+    try
+      let new_t, binders_to_remove_from_t =
+        compute_new_princ_type remove env t
+      in
+      let new_x = map_annot (get_name (Termops.ids_of_context env)) x in
+      let new_env = Environ.push_rel (LocalAssum (x, t)) env in
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove new_env b
+      in
+      if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b then
+        ( pop new_b
+        , filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b )
+      else
+        ( bind_fun (new_x, new_t, new_b)
+        , list_union_eq Constr.equal binders_to_remove_from_t
+            (List.map pop binders_to_remove_from_b) )
+    with
+    | Toberemoved ->
+      (*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove env (substnl [dummy_var] 1 b)
+      in
+      (new_b, List.map pop binders_to_remove_from_b)
+    | Toberemoved_with_rel (n, c) ->
+      (*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove env (substnl [c] n b)
+      in
+      ( new_b
+      , list_add_set_eq Constr.equal (mkRel n)
+          (List.map pop binders_to_remove_from_b) )
   and compute_new_princ_type_for_letin remove env x v t b =
-    begin
-      try
-        let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in
-        let new_v,binders_to_remove_from_v = compute_new_princ_type remove env v in
-        let new_x = map_annot (get_name (Termops.ids_of_context env)) x in
-        let new_env = Environ.push_rel (LocalDef (x,v,t)) env in
-        let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in
-        if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b
-        then (pop new_b),filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b
-        else
-          (
-            mkLetIn(new_x,new_v,new_t,new_b),
-            list_union_eq
-              Constr.equal
-              (list_union_eq Constr.equal binders_to_remove_from_t binders_to_remove_from_v)
-              (List.map pop binders_to_remove_from_b)
-          )
-
-      with
-        | Toberemoved ->
-(*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
-            let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b)  in
-            new_b, List.map pop binders_to_remove_from_b
-        | Toberemoved_with_rel (n,c) ->
-(*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
-            let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b)  in
-            new_b, list_add_set_eq Constr.equal (mkRel n) (List.map pop binders_to_remove_from_b)
-    end
-  and  compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc)  =
-    let new_e,to_remove_from_e = compute_new_princ_type remove env e
-    in
-    new_e::c_acc,list_union_eq Constr.equal to_remove_from_e to_remove_acc
+    try
+      let new_t, binders_to_remove_from_t =
+        compute_new_princ_type remove env t
+      in
+      let new_v, binders_to_remove_from_v =
+        compute_new_princ_type remove env v
+      in
+      let new_x = map_annot (get_name (Termops.ids_of_context env)) x in
+      let new_env = Environ.push_rel (LocalDef (x, v, t)) env in
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove new_env b
+      in
+      if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b then
+        ( pop new_b
+        , filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b )
+      else
+        ( mkLetIn (new_x, new_v, new_t, new_b)
+        , list_union_eq Constr.equal
+            (list_union_eq Constr.equal binders_to_remove_from_t
+               binders_to_remove_from_v)
+            (List.map pop binders_to_remove_from_b) )
+    with
+    | Toberemoved ->
+      (*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove env (substnl [dummy_var] 1 b)
+      in
+      (new_b, List.map pop binders_to_remove_from_b)
+    | Toberemoved_with_rel (n, c) ->
+      (*          observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
+      let new_b, binders_to_remove_from_b =
+        compute_new_princ_type remove env (substnl [c] n b)
+      in
+      ( new_b
+      , list_add_set_eq Constr.equal (mkRel n)
+          (List.map pop binders_to_remove_from_b) )
+  and compute_new_princ_type_with_acc remove env e (c_acc, to_remove_acc) =
+    let new_e, to_remove_from_e = compute_new_princ_type remove env e in
+    (new_e :: c_acc, list_union_eq Constr.equal to_remove_from_e to_remove_acc)
   in
-(*   observe (str "Computing new principe from " ++ pr_lconstr_env  env_with_params_and_predicates pre_princ); *)
-  let pre_res,_ =
-    compute_new_princ_type princ_type_info.indarg_in_concl env_with_params_and_predicates pre_princ
+  (*   observe (str "Computing new principe from " ++ pr_lconstr_env  env_with_params_and_predicates pre_princ); *)
+  let pre_res, _ =
+    compute_new_princ_type princ_type_info.indarg_in_concl
+      env_with_params_and_predicates pre_princ
   in
   let pre_res =
     replace_vars
@@ -246,12 +250,18 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
       (lift (List.length ptes_vars) pre_res)
   in
   it_mkProd_or_LetIn
-    (it_mkProd_or_LetIn
-       pre_res (List.map (function
-           | Context.Named.Declaration.LocalAssum (id,b) ->
-             LocalAssum (map_annot (fun id -> Name.mk_name (Hashtbl.find tbl id)) id, b)
-           | Context.Named.Declaration.LocalDef (id,t,b) ->
-             LocalDef (map_annot (fun id -> Name.mk_name (Hashtbl.find tbl id)) id, t, b))
-                      new_predicates)
-    )
-    (List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) princ_type_info.params)
+    (it_mkProd_or_LetIn pre_res
+       (List.map
+          (function
+            | Context.Named.Declaration.LocalAssum (id, b) ->
+              LocalAssum
+                (map_annot (fun id -> Name.mk_name (Hashtbl.find tbl id)) id, b)
+            | Context.Named.Declaration.LocalDef (id, t, b) ->
+              LocalDef
+                ( map_annot (fun id -> Name.mk_name (Hashtbl.find tbl id)) id
+                , t
+                , b ))
+          new_predicates))
+    (List.map
+       (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d)
+       princ_type_info.params)
diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli
index c870603a43..4bbb7180f0 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -8,8 +8,5 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-val compute_new_princ_type_from_rel
-  : Constr.constr array
-  -> Sorts.t array
-  -> Constr.t
-  -> Constr.types
+val compute_new_princ_type_from_rel :
+  Constr.constr array -> Sorts.t array -> Constr.t -> Constr.types
diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index d38c3c869b..df147b3aa6 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -10,9 +10,7 @@
 
 open Util
 open Names
-
 open Indfun_common
-
 module RelDecl = Context.Rel.Declaration
 
 let observe_tac s = observe_tac (fun _ _ -> Pp.str s)
@@ -23,73 +21,92 @@ let observe_tac s = observe_tac (fun _ _ -> Pp.str s)
 *)
 let rec abstract_glob_constr c = function
   | [] -> c
-  | Constrexpr.CLocalDef (x,b,t)::bl -> Constrexpr_ops.mkLetInC(x,b,t,abstract_glob_constr c bl)
-  | Constrexpr.CLocalAssum (idl,k,t)::bl ->
-    List.fold_right (fun x b -> Constrexpr_ops.mkLambdaC([x],k,t,b)) idl
+  | Constrexpr.CLocalDef (x, b, t) :: bl ->
+    Constrexpr_ops.mkLetInC (x, b, t, abstract_glob_constr c bl)
+  | Constrexpr.CLocalAssum (idl, k, t) :: bl ->
+    List.fold_right
+      (fun x b -> Constrexpr_ops.mkLambdaC ([x], k, t, b))
+      idl
       (abstract_glob_constr c bl)
-  | Constrexpr.CLocalPattern _::bl -> assert false
+  | Constrexpr.CLocalPattern _ :: bl -> assert false
 
-let interp_casted_constr_with_implicits env sigma impls c  =
+let interp_casted_constr_with_implicits env sigma impls c =
   Constrintern.intern_gen Pretyping.WithoutTypeConstraint env sigma ~impls c
 
 let build_newrecursive lnameargsardef =
-  let env0 = Global.env() in
+  let env0 = Global.env () in
   let sigma = Evd.from_env env0 in
-  let (rec_sign,rec_impls) =
+  let rec_sign, rec_impls =
     List.fold_left
-      (fun (env,impls) { Vernacexpr.fname={CAst.v=recname}; binders; rtype } ->
-         let arityc = Constrexpr_ops.mkCProdN binders rtype in
-         let arity,_ctx = Constrintern.interp_type env0 sigma arityc in
-         let evd = Evd.from_env env0 in
-         let evd, (_, (_, impls')) = Constrintern.interp_context_evars ~program_mode:false env evd binders in
-         let impl = Constrintern.compute_internalization_data env0 evd Constrintern.Recursive arity impls' in
-         let open Context.Named.Declaration in
-         let r = Sorts.Relevant in (* TODO relevance *)
-         (EConstr.push_named (LocalAssum (Context.make_annot recname r,arity)) env, Id.Map.add recname impl impls))
-      (env0,Constrintern.empty_internalization_env) lnameargsardef in
+      (fun (env, impls) {Vernacexpr.fname = {CAst.v = recname}; binders; rtype} ->
+        let arityc = Constrexpr_ops.mkCProdN binders rtype in
+        let arity, _ctx = Constrintern.interp_type env0 sigma arityc in
+        let evd = Evd.from_env env0 in
+        let evd, (_, (_, impls')) =
+          Constrintern.interp_context_evars ~program_mode:false env evd binders
+        in
+        let impl =
+          Constrintern.compute_internalization_data env0 evd
+            Constrintern.Recursive arity impls'
+        in
+        let open Context.Named.Declaration in
+        let r = Sorts.Relevant in
+        (* TODO relevance *)
+        ( EConstr.push_named
+            (LocalAssum (Context.make_annot recname r, arity))
+            env
+        , Id.Map.add recname impl impls ))
+      (env0, Constrintern.empty_internalization_env)
+      lnameargsardef
+  in
   let recdef =
     (* Declare local notations *)
-    let f { Vernacexpr.binders; body_def } =
+    let f {Vernacexpr.binders; body_def} =
       match body_def with
       | Some body_def ->
         let def = abstract_glob_constr body_def binders in
-        interp_casted_constr_with_implicits
-          rec_sign sigma rec_impls def
-      | None -> CErrors.user_err ~hdr:"Function" (Pp.str "Body of Function must be given")
+        interp_casted_constr_with_implicits rec_sign sigma rec_impls def
+      | None ->
+        CErrors.user_err ~hdr:"Function"
+          (Pp.str "Body of Function must be given")
     in
     States.with_state_protection (List.map f) lnameargsardef
   in
-  recdef,rec_impls
+  (recdef, rec_impls)
 
 (* Checks whether or not the mutual bloc is recursive *)
 let is_rec names =
   let open Glob_term in
   let names = List.fold_right Id.Set.add names Id.Set.empty in
-  let check_id id names =  Id.Set.mem id names in
-  let rec lookup names gt = match DAst.get gt with
-    | GVar(id) -> check_id id names
-    | GRef _ | GEvar _ | GPatVar _ | GSort _ |  GHole _ | GInt _ | GFloat _ -> false
-    | GCast(b,_) -> lookup names b
+  let check_id id names = Id.Set.mem id names in
+  let rec lookup names gt =
+    match DAst.get gt with
+    | GVar id -> check_id id names
+    | GRef _ | GEvar _ | GPatVar _ | GSort _ | GHole _ | GInt _ | GFloat _ ->
+      false
+    | GCast (b, _) -> lookup names b
     | GRec _ -> CErrors.user_err (Pp.str "GRec not handled")
-    | GIf(b,_,lhs,rhs) ->
-      (lookup names b) || (lookup names lhs) || (lookup names rhs)
-    | GProd(na,_,t,b) | GLambda(na,_,t,b) ->
-      lookup names t || lookup (Nameops.Name.fold_right Id.Set.remove na names) b
-    | GLetIn(na,b,t,c) ->
-      lookup names b || Option.cata (lookup names) true t || lookup (Nameops.Name.fold_right Id.Set.remove na names) c
-    | GLetTuple(nal,_,t,b) -> lookup names t ||
-                              lookup
-                                (List.fold_left
-                                   (fun acc na -> Nameops.Name.fold_right Id.Set.remove na acc)
-                                   names
-                                   nal
-                                )
-                                b
-    | GApp(f,args) -> List.exists (lookup names) (f::args)
-    | GCases(_,_,el,brl) ->
-      List.exists (fun (e,_) -> lookup names e) el ||
-      List.exists (lookup_br names) brl
-  and lookup_br names {CAst.v=(idl,_,rt)} =
+    | GIf (b, _, lhs, rhs) ->
+      lookup names b || lookup names lhs || lookup names rhs
+    | GProd (na, _, t, b) | GLambda (na, _, t, b) ->
+      lookup names t
+      || lookup (Nameops.Name.fold_right Id.Set.remove na names) b
+    | GLetIn (na, b, t, c) ->
+      lookup names b
+      || Option.cata (lookup names) true t
+      || lookup (Nameops.Name.fold_right Id.Set.remove na names) c
+    | GLetTuple (nal, _, t, b) ->
+      lookup names t
+      || lookup
+           (List.fold_left
+              (fun acc na -> Nameops.Name.fold_right Id.Set.remove na acc)
+              names nal)
+           b
+    | GApp (f, args) -> List.exists (lookup names) (f :: args)
+    | GCases (_, _, el, brl) ->
+      List.exists (fun (e, _) -> lookup names e) el
+      || List.exists (lookup_br names) brl
+  and lookup_br names {CAst.v = idl, _, rt} =
     let new_names = List.fold_right Id.Set.remove idl names in
     lookup new_names rt
   in
@@ -97,114 +114,137 @@ let is_rec names =
 
 let rec rebuild_bl aux bl typ =
   let open Constrexpr in
-  match bl,typ with
-  | [], _ -> List.rev aux,typ
-  | (CLocalAssum(nal,bk,_))::bl',typ ->
-    rebuild_nal aux bk bl' nal  typ
-  | (CLocalDef(na,_,_))::bl',{ CAst.v = CLetIn(_,nat,ty,typ') } ->
-    rebuild_bl (Constrexpr.CLocalDef(na,nat,ty)::aux)
-      bl' typ'
+  match (bl, typ) with
+  | [], _ -> (List.rev aux, typ)
+  | CLocalAssum (nal, bk, _) :: bl', typ -> rebuild_nal aux bk bl' nal typ
+  | CLocalDef (na, _, _) :: bl', {CAst.v = CLetIn (_, nat, ty, typ')} ->
+    rebuild_bl (Constrexpr.CLocalDef (na, nat, ty) :: aux) bl' typ'
   | _ -> assert false
+
 and rebuild_nal aux bk bl' nal typ =
   let open Constrexpr in
-  match nal,typ with
-  | _,{ CAst.v = CProdN([],typ) } -> rebuild_nal aux bk bl' nal typ
+  match (nal, typ) with
+  | _, {CAst.v = CProdN ([], typ)} -> rebuild_nal aux bk bl' nal typ
   | [], _ -> rebuild_bl aux bl' typ
-  | na::nal,{ CAst.v = CProdN(CLocalAssum(na'::nal',bk',nal't)::rest,typ') } ->
-    if Name.equal (na.CAst.v) (na'.CAst.v) || Name.is_anonymous (na'.CAst.v)
-    then
-      let assum = CLocalAssum([na],bk,nal't) in
-      let new_rest = if nal' = [] then rest else (CLocalAssum(nal',bk',nal't)::rest) in
-      rebuild_nal
-        (assum::aux)
-        bk
-        bl'
-        nal
-        (CAst.make @@ CProdN(new_rest,typ'))
+  | ( na :: nal
+    , {CAst.v = CProdN (CLocalAssum (na' :: nal', bk', nal't) :: rest, typ')} )
+    ->
+    if Name.equal na.CAst.v na'.CAst.v || Name.is_anonymous na'.CAst.v then
+      let assum = CLocalAssum ([na], bk, nal't) in
+      let new_rest =
+        if nal' = [] then rest else CLocalAssum (nal', bk', nal't) :: rest
+      in
+      rebuild_nal (assum :: aux) bk bl' nal
+        (CAst.make @@ CProdN (new_rest, typ'))
     else
-      let assum = CLocalAssum([na'],bk,nal't) in
-      let new_rest = if nal' = [] then rest else (CLocalAssum(nal',bk',nal't)::rest) in
-      rebuild_nal
-        (assum::aux)
-        bk
-        bl'
-        (na::nal)
-        (CAst.make @@ CProdN(new_rest,typ'))
-  | _ ->
-    assert false
+      let assum = CLocalAssum ([na'], bk, nal't) in
+      let new_rest =
+        if nal' = [] then rest else CLocalAssum (nal', bk', nal't) :: rest
+      in
+      rebuild_nal (assum :: aux) bk bl' (na :: nal)
+        (CAst.make @@ CProdN (new_rest, typ'))
+  | _ -> assert false
 
 let rebuild_bl aux bl typ = rebuild_bl aux bl typ
 
 let recompute_binder_list fixpoint_exprl =
   let fixl =
-    List.map (fun fix -> Vernacexpr.{
-        fix
-        with rec_order = ComFixpoint.adjust_rec_order ~structonly:false fix.binders fix.rec_order }) fixpoint_exprl in
-  let ((_,_,_,typel),_,ctx,_) = ComFixpoint.interp_fixpoint ~cofix:false fixl in
+    List.map
+      (fun fix ->
+        Vernacexpr.
+          { fix with
+            rec_order =
+              ComFixpoint.adjust_rec_order ~structonly:false fix.binders
+                fix.rec_order })
+      fixpoint_exprl
+  in
+  let (_, _, _, typel), _, ctx, _ =
+    ComFixpoint.interp_fixpoint ~cofix:false fixl
+  in
   let constr_expr_typel =
-    with_full_print (List.map (fun c -> Constrextern.extern_constr (Global.env ()) (Evd.from_ctx ctx) (EConstr.of_constr c))) typel in
+    with_full_print
+      (List.map (fun c ->
+           Constrextern.extern_constr (Global.env ()) (Evd.from_ctx ctx)
+             (EConstr.of_constr c)))
+      typel
+  in
   let fixpoint_exprl_with_new_bl =
-    List.map2 (fun ({ Vernacexpr.binders } as fp) fix_typ ->
+    List.map2
+      (fun ({Vernacexpr.binders} as fp) fix_typ ->
         let binders, rtype = rebuild_bl [] binders fix_typ in
-        { fp with Vernacexpr.binders; rtype }
-      ) fixpoint_exprl constr_expr_typel
+        {fp with Vernacexpr.binders; rtype})
+      fixpoint_exprl constr_expr_typel
   in
   fixpoint_exprl_with_new_bl
 
 let rec local_binders_length = function
   (* Assume that no `{ ... } contexts occur *)
   | [] -> 0
-  | Constrexpr.CLocalDef _::bl -> 1 + local_binders_length bl
-  | Constrexpr.CLocalAssum (idl,_,_)::bl -> List.length idl + local_binders_length bl
-  | Constrexpr.CLocalPattern _::bl -> assert false
+  | Constrexpr.CLocalDef _ :: bl -> 1 + local_binders_length bl
+  | Constrexpr.CLocalAssum (idl, _, _) :: bl ->
+    List.length idl + local_binders_length bl
+  | Constrexpr.CLocalPattern _ :: bl -> assert false
 
-let prepare_body { Vernacexpr.binders } rt =
+let prepare_body {Vernacexpr.binders} rt =
   let n = local_binders_length binders in
   (*   Pp.msgnl (str "nb lambda to chop : " ++ str (string_of_int n) ++ fnl () ++Printer.pr_glob_constr rt); *)
-  let fun_args,rt' = chop_rlambda_n n rt in
-  (fun_args,rt')
+  let fun_args, rt' = chop_rlambda_n n rt in
+  (fun_args, rt')
 
-let build_functional_principle ?(opaque=Proof_global.Transparent) (evd:Evd.evar_map ref) old_princ_type sorts funs _i proof_tac hook =
+let build_functional_principle ?(opaque = Proof_global.Transparent)
+    (evd : Evd.evar_map ref) old_princ_type sorts funs _i proof_tac hook =
   (* First we get the type of the old graph principle *)
-  let mutr_nparams = (Tactics.compute_elim_sig !evd (EConstr.of_constr old_princ_type)).Tactics.nparams in
+  let mutr_nparams =
+    (Tactics.compute_elim_sig !evd (EConstr.of_constr old_princ_type))
+      .Tactics.nparams
+  in
   (*   let time1 = System.get_time ()  in *)
   let new_principle_type =
     Functional_principles_types.compute_new_princ_type_from_rel
       (Array.map Constr.mkConstU funs)
-      sorts
-      old_princ_type
+      sorts old_princ_type
   in
   (*    let time2 = System.get_time ()  in *)
   (*    Pp.msgnl (str "computing principle type := " ++ System.fmt_time_difference time1 time2); *)
   let new_princ_name =
-    Namegen.next_ident_away_in_goal (Id.of_string "___________princ_________") Id.Set.empty
+    Namegen.next_ident_away_in_goal
+      (Id.of_string "___________princ_________")
+      Id.Set.empty
+  in
+  let sigma, _ =
+    Typing.type_of ~refresh:true (Global.env ()) !evd
+      (EConstr.of_constr new_principle_type)
   in
-  let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd (EConstr.of_constr new_principle_type) in
   evd := sigma;
   let hook = DeclareDef.Hook.make (hook new_principle_type) in
   let lemma =
-    Lemmas.start_lemma
-      ~name:new_princ_name
-      ~poly:false
-      !evd
+    Lemmas.start_lemma ~name:new_princ_name ~poly:false !evd
       (EConstr.of_constr new_principle_type)
   in
   (*       let _tim1 = System.get_time ()  in *)
   let map (c, u) = EConstr.mkConstU (c, EConstr.EInstance.make u) in
-  let lemma,_ = Lemmas.by (Proofview.V82.tactic (proof_tac (Array.map map funs) mutr_nparams)) lemma in
+  let lemma, _ =
+    Lemmas.by
+      (Proofview.V82.tactic (proof_tac (Array.map map funs) mutr_nparams))
+      lemma
+  in
   (*       let _tim2 =  System.get_time ()  in *)
   (*    begin *)
   (*      let dur1 = System.time_difference tim1 tim2 in *)
   (*      Pp.msgnl (str ("Time to compute proof: ") ++ str (string_of_float dur1)); *)
   (*    end; *)
-
   let open Proof_global in
-  let { entries } = Lemmas.pf_fold (close_proof ~opaque ~keep_body_ucst_separate:false) lemma in
+  let {entries} =
+    Lemmas.pf_fold (close_proof ~opaque ~keep_body_ucst_separate:false) lemma
+  in
   match entries with
-  | [entry] ->
-    entry, hook
+  | [entry] -> (entry, hook)
   | _ ->
-    CErrors.anomaly Pp.(str "[build_functional_principle] close_proof returned more than one proof term")
+    CErrors.anomaly
+      Pp.(
+        str
+          "[build_functional_principle] close_proof returned more than one \
+           proof term")
 
 let change_property_sort evd toSort princ princName =
   let open Context.Rel.Declaration in
@@ -212,207 +252,221 @@ let change_property_sort evd toSort princ princName =
   let princ_info = Tactics.compute_elim_sig evd princ in
   let change_sort_in_predicate decl =
     LocalAssum
-    (get_annot decl,
-     let args,ty = Term.decompose_prod (EConstr.Unsafe.to_constr (get_type decl)) in
-     let s = Constr.destSort ty in
-       Global.add_constraints (Univ.enforce_leq (Sorts.univ_of_sort toSort) (Sorts.univ_of_sort s) Univ.Constraint.empty);
-       Term.compose_prod args (Constr.mkSort toSort)
-    )
+      ( get_annot decl
+      , let args, ty =
+          Term.decompose_prod (EConstr.Unsafe.to_constr (get_type decl))
+        in
+        let s = Constr.destSort ty in
+        Global.add_constraints
+          (Univ.enforce_leq
+             (Sorts.univ_of_sort toSort)
+             (Sorts.univ_of_sort s) Univ.Constraint.empty);
+        Term.compose_prod args (Constr.mkSort toSort) )
+  in
+  let evd, princName_as_constr =
+    Evd.fresh_global (Global.env ()) evd
+      (Constrintern.locate_reference (Libnames.qualid_of_ident princName))
   in
-  let evd,princName_as_constr =
-    Evd.fresh_global
-      (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident princName)) in
   let init =
-    let nargs =  (princ_info.Tactics.nparams + (List.length  princ_info.Tactics.predicates)) in
-    Constr.mkApp(EConstr.Unsafe.to_constr princName_as_constr,
-                 Array.init nargs
-                   (fun i -> Constr.mkRel (nargs - i )))
+    let nargs =
+      princ_info.Tactics.nparams + List.length princ_info.Tactics.predicates
+    in
+    Constr.mkApp
+      ( EConstr.Unsafe.to_constr princName_as_constr
+      , Array.init nargs (fun i -> Constr.mkRel (nargs - i)) )
   in
-  evd, Term.it_mkLambda_or_LetIn
-    (Term.it_mkLambda_or_LetIn init
-       (List.map change_sort_in_predicate princ_info.Tactics.predicates)
-    )
-    (List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) princ_info.Tactics.params)
-
-let generate_functional_principle (evd: Evd.evar_map ref)
-    old_princ_type sorts new_princ_name funs i proof_tac
-    =
+  ( evd
+  , Term.it_mkLambda_or_LetIn
+      (Term.it_mkLambda_or_LetIn init
+         (List.map change_sort_in_predicate princ_info.Tactics.predicates))
+      (List.map
+         (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d)
+         princ_info.Tactics.params) )
+
+let generate_functional_principle (evd : Evd.evar_map ref) old_princ_type sorts
+    new_princ_name funs i proof_tac =
   try
-
-  let f = funs.(i) in
-  let sigma, type_sort = Evd.fresh_sort_in_family !evd Sorts.InType in
-  evd := sigma;
-  let new_sorts =
-    match sorts with
-      | None -> Array.make (Array.length funs) (type_sort)
+    let f = funs.(i) in
+    let sigma, type_sort = Evd.fresh_sort_in_family !evd Sorts.InType in
+    evd := sigma;
+    let new_sorts =
+      match sorts with
+      | None -> Array.make (Array.length funs) type_sort
       | Some a -> a
-  in
-  let base_new_princ_name,new_princ_name =
-    match new_princ_name with
-      | Some (id) -> id,id
+    in
+    let base_new_princ_name, new_princ_name =
+      match new_princ_name with
+      | Some id -> (id, id)
       | None ->
-          let id_of_f = Label.to_id (Constant.label (fst f)) in
-          id_of_f,Indrec.make_elimination_ident id_of_f (Sorts.family type_sort)
-  in
-  let names = ref [new_princ_name] in
-  let hook =
-    fun new_principle_type _  ->
-    if Option.is_empty sorts
-    then
-      (*     let id_of_f = Label.to_id (con_label f) in *)
-      let register_with_sort fam_sort =
-        let evd' = Evd.from_env (Global.env ()) in
-        let evd',s = Evd.fresh_sort_in_family evd' fam_sort in
-        let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
-        let evd',value = change_property_sort evd' s new_principle_type new_princ_name in
-        let evd' = fst (Typing.type_of ~refresh:true (Global.env ()) evd' (EConstr.of_constr value)) in
-        (* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
-        let univs = Evd.univ_entry ~poly:false evd' in
-        let ce = Declare.definition_entry ~univs value in
-        ignore(
-          Declare.declare_constant
-            ~name
-            ~kind:Decls.(IsDefinition Scheme)
-            (Declare.DefinitionEntry ce)
-        );
-        Declare.definition_message name;
-        names := name :: !names
-      in
-      register_with_sort Sorts.InProp;
-      register_with_sort Sorts.InSet
-  in
-  let entry, hook =
-    build_functional_principle evd old_princ_type new_sorts funs i
-    proof_tac hook
+        let id_of_f = Label.to_id (Constant.label (fst f)) in
+        (id_of_f, Indrec.make_elimination_ident id_of_f (Sorts.family type_sort))
+    in
+    let names = ref [new_princ_name] in
+    let hook new_principle_type _ =
+      if Option.is_empty sorts then (
+        (*     let id_of_f = Label.to_id (con_label f) in *)
+        let register_with_sort fam_sort =
+          let evd' = Evd.from_env (Global.env ()) in
+          let evd', s = Evd.fresh_sort_in_family evd' fam_sort in
+          let name =
+            Indrec.make_elimination_ident base_new_princ_name fam_sort
+          in
+          let evd', value =
+            change_property_sort evd' s new_principle_type new_princ_name
+          in
+          let evd' =
+            fst
+              (Typing.type_of ~refresh:true (Global.env ()) evd'
+                 (EConstr.of_constr value))
+          in
+          (* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
+          let univs = Evd.univ_entry ~poly:false evd' in
+          let ce = Declare.definition_entry ~univs value in
+          ignore
+            (Declare.declare_constant ~name
+               ~kind:Decls.(IsDefinition Scheme)
+               (Declare.DefinitionEntry ce));
+          Declare.definition_message name;
+          names := name :: !names
+        in
+        register_with_sort Sorts.InProp;
+        register_with_sort Sorts.InSet )
+    in
+    let entry, hook =
+      build_functional_principle evd old_princ_type new_sorts funs i proof_tac
+        hook
+    in
+    (* Pr  1278 :
+       Don't forget to close the goal if an error is raised !!!!
+    *)
+    let uctx = Evd.evar_universe_context sigma in
+    let (_ : Names.GlobRef.t) =
+      DeclareDef.declare_entry ~name:new_princ_name ~hook
+        ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior)
+        ~kind:Decls.(IsProof Theorem)
+        ~impargs:[] ~uctx entry
+    in
+    ()
+  with e when CErrors.noncritical e -> raise (Defining_principle e)
+
+let generate_principle (evd : Evd.evar_map ref) pconstants on_error is_general
+    do_built fix_rec_l recdefs
+    (continue_proof :
+         int
+      -> Names.Constant.t array
+      -> EConstr.constr array
+      -> int
+      -> Tacmach.tactic) : unit =
+  let names =
+    List.map (function {Vernacexpr.fname = {CAst.v = name}} -> name) fix_rec_l
   in
-  (* Pr  1278 :
-     Don't forget to close the goal if an error is raised !!!!
-  *)
-  let uctx = Evd.evar_universe_context sigma in
-  let _ : Names.GlobRef.t = DeclareDef.declare_entry
-      ~name:new_princ_name ~hook
-      ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior)
-      ~kind:Decls.(IsProof Theorem)
-      ~impargs:[]
-      ~uctx entry in
-  ()
-  with e when CErrors.noncritical e ->
-    raise (Defining_principle e)
-
-let generate_principle (evd:Evd.evar_map ref) pconstants on_error
-    is_general do_built fix_rec_l recdefs
-    (continue_proof : int -> Names.Constant.t array -> EConstr.constr array -> int ->
-     Tacmach.tactic) : unit =
-  let names = List.map (function { Vernacexpr.fname = {CAst.v=name} } -> name) fix_rec_l in
   let fun_bodies = List.map2 prepare_body fix_rec_l recdefs in
   let funs_args = List.map fst fun_bodies in
-  let funs_types =  List.map (function { Vernacexpr.rtype } -> rtype) fix_rec_l in
+  let funs_types =
+    List.map (function {Vernacexpr.rtype} -> rtype) fix_rec_l
+  in
   try
     (* We then register the Inductive graphs of the functions  *)
-    Glob_term_to_relation.build_inductive !evd pconstants funs_args funs_types recdefs;
-    if do_built
-    then
-      begin
-        (*i The next call to mk_rel_id is valid since we have just construct the graph
-           Ensures by : do_built
-          i*)
-        let f_R_mut = Libnames.qualid_of_ident @@ mk_rel_id (List.nth names 0) in
-        let ind_kn =
-          fst (locate_with_msg
-                 Pp.(Libnames.pr_qualid f_R_mut ++ str ": Not an inductive type!")
-                 locate_ind
-                 f_R_mut)
-        in
-        let fname_kn { Vernacexpr.fname } =
-          let f_ref = Libnames.qualid_of_ident ?loc:fname.CAst.loc fname.CAst.v in
-          locate_with_msg
-            Pp.(Libnames.pr_qualid f_ref++str ": Not an inductive type!")
-            locate_constant
-            f_ref
-        in
-        let funs_kn = Array.of_list (List.map fname_kn fix_rec_l) in
-        let _ =
-          List.map_i
-            (fun i _x ->
-               let env = Global.env () in
-               let princ = Indrec.lookup_eliminator env (ind_kn,i) (Sorts.InProp) in
-               let evd = ref (Evd.from_env env) in
-               let evd',uprinc = Evd.fresh_global env !evd princ in
-               let _ = evd := evd' in
-               let sigma, princ_type = Typing.type_of ~refresh:true env !evd uprinc in
-               evd := sigma;
-               let princ_type = EConstr.Unsafe.to_constr princ_type in
-               generate_functional_principle
-                 evd
-                 princ_type
-                 None
-                 None
-                 (Array.of_list pconstants)
-                 (* funs_kn *)
-                 i
-                 (continue_proof  0 [|funs_kn.(i)|])
-            )
-            0
-            fix_rec_l
-        in
-        Array.iter (add_Function is_general) funs_kn;
-        ()
-      end
-  with e when CErrors.noncritical e ->
-    on_error names e
+    Glob_term_to_relation.build_inductive !evd pconstants funs_args funs_types
+      recdefs;
+    if do_built then begin
+      (*i The next call to mk_rel_id is valid since we have just construct the graph
+         Ensures by : do_built
+        i*)
+      let f_R_mut = Libnames.qualid_of_ident @@ mk_rel_id (List.nth names 0) in
+      let ind_kn =
+        fst
+          (locate_with_msg
+             Pp.(Libnames.pr_qualid f_R_mut ++ str ": Not an inductive type!")
+             locate_ind f_R_mut)
+      in
+      let fname_kn {Vernacexpr.fname} =
+        let f_ref = Libnames.qualid_of_ident ?loc:fname.CAst.loc fname.CAst.v in
+        locate_with_msg
+          Pp.(Libnames.pr_qualid f_ref ++ str ": Not an inductive type!")
+          locate_constant f_ref
+      in
+      let funs_kn = Array.of_list (List.map fname_kn fix_rec_l) in
+      let _ =
+        List.map_i
+          (fun i _x ->
+            let env = Global.env () in
+            let princ = Indrec.lookup_eliminator env (ind_kn, i) Sorts.InProp in
+            let evd = ref (Evd.from_env env) in
+            let evd', uprinc = Evd.fresh_global env !evd princ in
+            let _ = evd := evd' in
+            let sigma, princ_type =
+              Typing.type_of ~refresh:true env !evd uprinc
+            in
+            evd := sigma;
+            let princ_type = EConstr.Unsafe.to_constr princ_type in
+            generate_functional_principle evd princ_type None None
+              (Array.of_list pconstants) (* funs_kn *)
+              i
+              (continue_proof 0 [|funs_kn.(i)|]))
+          0 fix_rec_l
+      in
+      Array.iter (add_Function is_general) funs_kn;
+      ()
+    end
+  with e when CErrors.noncritical e -> on_error names e
 
 let register_struct is_rec fixpoint_exprl =
   let open EConstr in
   match fixpoint_exprl with
-  | [{ Vernacexpr.fname; univs; binders; rtype; body_def }] when not is_rec ->
+  | [{Vernacexpr.fname; univs; binders; rtype; body_def}] when not is_rec ->
     let body =
       match body_def with
       | Some body -> body
       | None ->
-        CErrors.user_err ~hdr:"Function" Pp.(str "Body of Function must be given") in
-    ComDefinition.do_definition
-      ~name:fname.CAst.v
-      ~poly:false
+        CErrors.user_err ~hdr:"Function"
+          Pp.(str "Body of Function must be given")
+    in
+    ComDefinition.do_definition ~name:fname.CAst.v ~poly:false
       ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior)
-      ~kind:Decls.Definition univs
-      binders None body (Some rtype);
-    let evd,rev_pconstants =
+      ~kind:Decls.Definition univs binders None body (Some rtype);
+    let evd, rev_pconstants =
       List.fold_left
-        (fun (evd,l) { Vernacexpr.fname } ->
-           let evd,c =
-             Evd.fresh_global
-               (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname.CAst.v)) in
-           let (cst, u) = destConst evd c in
-           let u = EInstance.kind evd u in
-           evd,((cst, u) :: l)
-        )
-        (Evd.from_env (Global.env ()),[])
+        (fun (evd, l) {Vernacexpr.fname} ->
+          let evd, c =
+            Evd.fresh_global (Global.env ()) evd
+              (Constrintern.locate_reference
+                 (Libnames.qualid_of_ident fname.CAst.v))
+          in
+          let cst, u = destConst evd c in
+          let u = EInstance.kind evd u in
+          (evd, (cst, u) :: l))
+        (Evd.from_env (Global.env ()), [])
         fixpoint_exprl
     in
-    None, evd,List.rev rev_pconstants
+    (None, evd, List.rev rev_pconstants)
   | _ ->
-    ComFixpoint.do_fixpoint ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior) ~poly:false fixpoint_exprl;
-    let evd,rev_pconstants =
+    ComFixpoint.do_fixpoint
+      ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior) ~poly:false
+      fixpoint_exprl;
+    let evd, rev_pconstants =
       List.fold_left
-        (fun (evd,l) { Vernacexpr.fname } ->
-           let evd,c =
-             Evd.fresh_global
-               (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname.CAst.v)) in
-           let (cst, u) = destConst evd c in
-           let u = EInstance.kind evd u in
-           evd,((cst, u) :: l)
-        )
-        (Evd.from_env (Global.env ()),[])
+        (fun (evd, l) {Vernacexpr.fname} ->
+          let evd, c =
+            Evd.fresh_global (Global.env ()) evd
+              (Constrintern.locate_reference
+                 (Libnames.qualid_of_ident fname.CAst.v))
+          in
+          let cst, u = destConst evd c in
+          let u = EInstance.kind evd u in
+          (evd, (cst, u) :: l))
+        (Evd.from_env (Global.env ()), [])
         fixpoint_exprl
     in
-    None,evd,List.rev rev_pconstants
+    (None, evd, List.rev rev_pconstants)
 
-let generate_correction_proof_wf f_ref tcc_lemma_ref
-    is_mes functional_ref eq_ref rec_arg_num rec_arg_type relation
-    (_: int) (_:Names.Constant.t array) (_:EConstr.constr array) (_:int) : Tacmach.tactic =
+let generate_correction_proof_wf f_ref tcc_lemma_ref is_mes functional_ref
+    eq_ref rec_arg_num rec_arg_type relation (_ : int)
+    (_ : Names.Constant.t array) (_ : EConstr.constr array) (_ : int) :
+    Tacmach.tactic =
   Functional_principles_proofs.prove_principle_for_gen
-    (f_ref,functional_ref,eq_ref)
-    tcc_lemma_ref is_mes  rec_arg_num rec_arg_type relation
+    (f_ref, functional_ref, eq_ref)
+    tcc_lemma_ref is_mes rec_arg_num rec_arg_type relation
 
 (* [generate_type g_to_f f graph i] build the completeness (resp. correctness) lemma type if [g_to_f = true]
    (resp. g_to_f = false) where [graph]  is the graph of [f] and is the [i]th function in the block.
@@ -431,34 +485,38 @@ let generate_type evd g_to_f f graph =
   let open EConstr in
   let open EConstr.Vars in
   (*i we deduce the number of arguments of the function and its returned type from the graph i*)
-  let evd',graph =
-    Evd.fresh_global  (Global.env ()) !evd  (GlobRef.IndRef (fst (destInd !evd graph)))
+  let evd', graph =
+    Evd.fresh_global (Global.env ()) !evd
+      (GlobRef.IndRef (fst (destInd !evd graph)))
   in
-  evd:=evd';
+  evd := evd';
   let sigma, graph_arity = Typing.type_of (Global.env ()) !evd graph in
   evd := sigma;
-  let ctxt,_ = decompose_prod_assum !evd graph_arity in
-  let fun_ctxt,res_type =
+  let ctxt, _ = decompose_prod_assum !evd graph_arity in
+  let fun_ctxt, res_type =
     match ctxt with
     | [] | [_] -> CErrors.anomaly (Pp.str "Not a valid context.")
-    | decl :: fun_ctxt -> fun_ctxt, RelDecl.get_type decl
+    | decl :: fun_ctxt -> (fun_ctxt, RelDecl.get_type decl)
   in
   let rec args_from_decl i accu = function
     | [] -> accu
-    | LocalDef _ :: l ->
-      args_from_decl (succ i) accu l
+    | LocalDef _ :: l -> args_from_decl (succ i) accu l
     | _ :: l ->
       let t = mkRel i in
       args_from_decl (succ i) (t :: accu) l
   in
   (*i We need to name the vars [res] and [fv] i*)
-  let filter = fun decl -> match RelDecl.get_name decl with
-    | Name id -> Some id
-    | Anonymous -> None
+  let filter decl =
+    match RelDecl.get_name decl with Name id -> Some id | Anonymous -> None
   in
   let named_ctxt = Id.Set.of_list (List.map_filter filter fun_ctxt) in
-  let res_id = Namegen.next_ident_away_in_goal (Id.of_string "_res") named_ctxt in
-  let fv_id = Namegen.next_ident_away_in_goal (Id.of_string "fv") (Id.Set.add res_id named_ctxt) in
+  let res_id =
+    Namegen.next_ident_away_in_goal (Id.of_string "_res") named_ctxt
+  in
+  let fv_id =
+    Namegen.next_ident_away_in_goal (Id.of_string "fv")
+      (Id.Set.add res_id named_ctxt)
+  in
   (*i we can then type the argument to be applied to the function [f] i*)
   let args_as_rels = Array.of_list (args_from_decl 1 [] fun_ctxt) in
   (*i
@@ -467,7 +525,7 @@ let generate_type evd g_to_f f graph =
     i*)
   let make_eq = make_eq () in
   let res_eq_f_of_args =
-    mkApp(make_eq ,[|lift 2 res_type;mkRel 1;mkRel 2|])
+    mkApp (make_eq, [|lift 2 res_type; mkRel 1; mkRel 2|])
   in
   (*i
     The hypothesis [graph\ x_1\ldots x_n\ res] can then be computed
@@ -475,18 +533,29 @@ let generate_type evd g_to_f f graph =
     i*)
   let args_and_res_as_rels = Array.of_list (args_from_decl 3 [] fun_ctxt) in
   let args_and_res_as_rels = Array.append args_and_res_as_rels [|mkRel 1|] in
-  let graph_applied = mkApp(graph, args_and_res_as_rels) in
+  let graph_applied = mkApp (graph, args_and_res_as_rels) in
   (*i The [pre_context]  is the defined to be the context corresponding to
     \[\forall (x_1:t_1)\ldots(x_n:t_n), let fv := f x_1\ldots x_n in, forall res,  \]
     i*)
   let pre_ctxt =
-    LocalAssum (Context.make_annot (Name res_id) Sorts.Relevant, lift 1 res_type) ::
-    LocalDef (Context.make_annot (Name fv_id) Sorts.Relevant, mkApp (f,args_as_rels), res_type) :: fun_ctxt
+    LocalAssum (Context.make_annot (Name res_id) Sorts.Relevant, lift 1 res_type)
+    :: LocalDef
+         ( Context.make_annot (Name fv_id) Sorts.Relevant
+         , mkApp (f, args_as_rels)
+         , res_type )
+    :: fun_ctxt
   in
   (*i and we can return the solution depending on which lemma type we are defining i*)
-  if g_to_f
-  then LocalAssum (Context.make_annot Anonymous Sorts.Relevant,graph_applied)::pre_ctxt,(lift 1 res_eq_f_of_args),graph
-  else LocalAssum (Context.make_annot Anonymous Sorts.Relevant,res_eq_f_of_args)::pre_ctxt,(lift 1 graph_applied),graph
+  if g_to_f then
+    ( LocalAssum (Context.make_annot Anonymous Sorts.Relevant, graph_applied)
+      :: pre_ctxt
+    , lift 1 res_eq_f_of_args
+    , graph )
+  else
+    ( LocalAssum (Context.make_annot Anonymous Sorts.Relevant, res_eq_f_of_args)
+      :: pre_ctxt
+    , lift 1 graph_applied
+    , graph )
 
 (**
    [find_induction_principle f] searches and returns the [body] and the [type] of [f_rect]
@@ -494,21 +563,25 @@ let generate_type evd g_to_f f graph =
    WARNING: while convertible, [type_of body] and [type] can be non equal
 *)
 let find_induction_principle evd f =
-  let f_as_constant, _u =  match EConstr.kind !evd f with
+  let f_as_constant, _u =
+    match EConstr.kind !evd f with
     | Constr.Const c' -> c'
     | _ -> CErrors.user_err Pp.(str "Must be used with a function")
   in
   match find_Function_infos f_as_constant with
-  | None ->
-    raise Not_found
-  | Some infos ->
+  | None -> raise Not_found
+  | Some infos -> (
     match infos.rect_lemma with
     | None -> raise Not_found
     | Some rect_lemma ->
-      let evd',rect_lemma = Evd.fresh_global  (Global.env ()) !evd  (GlobRef.ConstRef rect_lemma) in
-      let evd',typ = Typing.type_of ~refresh:true (Global.env ()) evd' rect_lemma in
-      evd:=evd';
-      rect_lemma,typ
+      let evd', rect_lemma =
+        Evd.fresh_global (Global.env ()) !evd (GlobRef.ConstRef rect_lemma)
+      in
+      let evd', typ =
+        Typing.type_of ~refresh:true (Global.env ()) evd' rect_lemma
+      in
+      evd := evd';
+      (rect_lemma, typ) )
 
 (* [prove_fun_correct funs_constr graphs_constr schemes lemmas_types_infos i ]
    is the tactic used to prove correctness lemma.
@@ -535,13 +608,13 @@ let find_induction_principle evd f =
 *)
 
 let rec generate_fresh_id x avoid i =
-  if i == 0
-  then []
+  if i == 0 then []
   else
     let id = Namegen.next_ident_away_in_goal x (Id.Set.of_list avoid) in
-    id::(generate_fresh_id x (id::avoid) (pred i))
+    id :: generate_fresh_id x (id :: avoid) (pred i)
 
-let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i : Tacmach.tactic =
+let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i :
+    Tacmach.tactic =
   let open Constr in
   let open EConstr in
   let open Context.Rel.Declaration in
@@ -554,22 +627,25 @@ let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i : Tacmach.t
        \[fun (x_1:t_1)\ldots(x_n:t_n)=> fun  fv => fun res => res = fv \rightarrow graph\ x_1\ldots x_n\ res\]
     *)
     (* we the get the definition of the graphs block *)
-    let graph_ind,u = destInd evd graphs_constr.(i) in
+    let graph_ind, u = destInd evd graphs_constr.(i) in
     let kn = fst graph_ind in
-    let mib,_ = Global.lookup_inductive graph_ind in
+    let mib, _ = Global.lookup_inductive graph_ind in
     (* and the principle to use in this lemma in $\zeta$ normal form *)
-    let f_principle,princ_type = schemes.(i) in
+    let f_principle, princ_type = schemes.(i) in
     let princ_type = Reductionops.nf_zeta (Global.env ()) evd princ_type in
     let princ_infos = Tactics.compute_elim_sig evd princ_type in
     (* The number of args of the function is then easily computable *)
     let nb_fun_args = Termops.nb_prod (project g) (pf_concl g) - 2 in
     let args_names = generate_fresh_id (Id.of_string "x") [] nb_fun_args in
-    let ids = args_names@(pf_ids_of_hyps g) in
+    let ids = args_names @ pf_ids_of_hyps g in
     (* Since we cannot ensure that the functional principle is defined in the
        environment and due to the bug #1174, we will need to pose the principle
        using a name
     *)
-    let principle_id = Namegen.next_ident_away_in_goal (Id.of_string "princ") (Id.Set.of_list ids) in
+    let principle_id =
+      Namegen.next_ident_away_in_goal (Id.of_string "princ")
+        (Id.Set.of_list ids)
+    in
     let ids = principle_id :: ids in
     (* We get the branches of the principle *)
     let branches = List.rev princ_infos.Tactics.branches in
@@ -577,28 +653,28 @@ let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i : Tacmach.t
     let intro_pats =
       List.map
         (fun decl ->
-           List.map
-             (fun id -> CAst.make @@ Tactypes.IntroNaming (Namegen.IntroIdentifier id))
-             (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum evd (RelDecl.get_type decl)))))
-        )
+          List.map
+            (fun id ->
+              CAst.make @@ Tactypes.IntroNaming (Namegen.IntroIdentifier id))
+            (generate_fresh_id (Id.of_string "y") ids
+               (List.length
+                  (fst (decompose_prod_assum evd (RelDecl.get_type decl))))))
         branches
     in
     (* before building the full intro pattern for the principle *)
     let eq_ind = make_eq () in
     let eq_construct = mkConstructUi (destInd evd eq_ind, 1) in
     (* The next to referencies will be used to find out which constructor to apply in each branch *)
-    let ind_number = ref 0
-    and min_constr_number = ref 0 in
+    let ind_number = ref 0 and min_constr_number = ref 0 in
     (* The tactic to prove the ith branch of the principle *)
     let prove_branche i g =
       (* We get the identifiers of this branch *)
       let pre_args =
         List.fold_right
-          (fun {CAst.v=pat} acc ->
-             match pat with
-             | Tactypes.IntroNaming (Namegen.IntroIdentifier id) -> id::acc
-             | _ -> CErrors.anomaly (Pp.str "Not an identifier.")
-          )
+          (fun {CAst.v = pat} acc ->
+            match pat with
+            | Tactypes.IntroNaming (Namegen.IntroIdentifier id) -> id :: acc
+            | _ -> CErrors.anomaly (Pp.str "Not an identifier."))
           (List.nth intro_pats (pred i))
           []
       in
@@ -613,32 +689,35 @@ let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i : Tacmach.t
       let constructor_args g =
         List.fold_right
           (fun hid acc ->
-             let type_of_hid = pf_get_hyp_typ g hid in
-             let sigma = project g in
-             match EConstr.kind sigma type_of_hid with
-             | Prod(_,_,t') ->
-               begin
-                 match EConstr.kind sigma t' with
-                 | Prod(_,t'',t''') ->
-                   begin
-                     match EConstr.kind sigma t'',EConstr.kind sigma t''' with
-                     | App(eq,args), App(graph',_)
-                       when
-                         (EConstr.eq_constr sigma eq eq_ind) &&
-                         Array.exists  (EConstr.eq_constr_nounivs sigma graph') graphs_constr ->
-                       (args.(2)::(mkApp(mkVar hid,[|args.(2);(mkApp(eq_construct,[|args.(0);args.(2)|]))|]))
-                        ::acc)
-                     | _ -> mkVar hid ::  acc
-                   end
-                 | _ -> mkVar hid :: acc
-               end
-             | _ -> mkVar hid :: acc
-          ) pre_args []
+            let type_of_hid = pf_get_hyp_typ g hid in
+            let sigma = project g in
+            match EConstr.kind sigma type_of_hid with
+            | Prod (_, _, t') -> (
+              match EConstr.kind sigma t' with
+              | Prod (_, t'', t''') -> (
+                match (EConstr.kind sigma t'', EConstr.kind sigma t''') with
+                | App (eq, args), App (graph', _)
+                  when EConstr.eq_constr sigma eq eq_ind
+                       && Array.exists
+                            (EConstr.eq_constr_nounivs sigma graph')
+                            graphs_constr ->
+                  args.(2)
+                  :: mkApp
+                       ( mkVar hid
+                       , [| args.(2)
+                          ; mkApp (eq_construct, [|args.(0); args.(2)|]) |] )
+                  :: acc
+                | _ -> mkVar hid :: acc )
+              | _ -> mkVar hid :: acc )
+            | _ -> mkVar hid :: acc)
+          pre_args []
       in
       (* in fact we must also add the parameters to the constructor args *)
       let constructor_args g =
-        let params_id = fst (List.chop princ_infos.Tactics.nparams args_names) in
-        (List.map mkVar params_id)@((constructor_args g))
+        let params_id =
+          fst (List.chop princ_infos.Tactics.nparams args_names)
+        in
+        List.map mkVar params_id @ constructor_args g
       in
       (* We then get the constructor corresponding to this branch and
          modifies the references has needed i.e.
@@ -648,120 +727,136 @@ let prove_fun_correct evd graphs_constr schemes lemmas_types_infos i : Tacmach.t
       *)
       let constructor =
         let constructor_num = i - !min_constr_number in
-        let length = Array.length (mib.Declarations.mind_packets.(!ind_number).Declarations.mind_consnames) in
-        if constructor_num <= length
-        then
-          begin
-            (kn,!ind_number),constructor_num
-          end
-        else
-          begin
-            incr ind_number;
-            min_constr_number := !min_constr_number + length ;
-            (kn,!ind_number),1
-          end
+        let length =
+          Array.length
+            mib.Declarations.mind_packets.(!ind_number)
+              .Declarations.mind_consnames
+        in
+        if constructor_num <= length then ((kn, !ind_number), constructor_num)
+        else begin
+          incr ind_number;
+          min_constr_number := !min_constr_number + length;
+          ((kn, !ind_number), 1)
+        end
       in
       (* we can then build the final proof term *)
-      let app_constructor g = applist((mkConstructU(constructor,u)),constructor_args g) in
+      let app_constructor g =
+        applist (mkConstructU (constructor, u), constructor_args g)
+      in
       (* an apply the tactic *)
-      let res,hres =
-        match generate_fresh_id (Id.of_string "z") (ids(* @this_branche_ids *)) 2 with
-        | [res;hres] -> res,hres
+      let res, hres =
+        match
+          generate_fresh_id (Id.of_string "z") ids (* @this_branche_ids *) 2
+        with
+        | [res; hres] -> (res, hres)
         | _ -> assert false
       in
       (* observe (str "constructor := " ++ Printer.pr_lconstr_env (pf_env g) app_constructor); *)
-      (
-        tclTHENLIST
-          [
-            observe_tac ("h_intro_patterns ")  (let l = (List.nth intro_pats (pred i)) in
-                                                match l with
-                                                | [] -> tclIDTAC
-                                                | _ -> Proofview.V82.of_tactic (intro_patterns false l));
-            (* unfolding of all the defined variables introduced by this branch *)
-            (* observe_tac "unfolding" pre_tac; *)
-            (* $zeta$ normalizing of the conclusion *)
-            Proofview.V82.of_tactic (reduce
-                                       (Genredexpr.Cbv
-                                          { Redops.all_flags with
-                                            Genredexpr.rDelta = false ;
-                                            Genredexpr.rConst = []
-                                          }
-                                       )
-                                       Locusops.onConcl);
-            observe_tac ("toto ") tclIDTAC;
-
-            (* introducing the result of the graph and the equality hypothesis *)
-            observe_tac "introducing" (tclMAP (fun x -> Proofview.V82.of_tactic (Simple.intro x)) [res;hres]);
-            (* replacing [res] with its value *)
-            observe_tac "rewriting res value" (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar hres)));
-            (* Conclusion *)
-            observe_tac "exact" (fun g ->
-                Proofview.V82.of_tactic (exact_check (app_constructor g)) g)
-          ]
-      )
+      (tclTHENLIST
+         [ observe_tac "h_intro_patterns "
+             (let l = List.nth intro_pats (pred i) in
+              match l with
+              | [] -> tclIDTAC
+              | _ -> Proofview.V82.of_tactic (intro_patterns false l))
+         ; (* unfolding of all the defined variables introduced by this branch *)
+           (* observe_tac "unfolding" pre_tac; *)
+           (* $zeta$ normalizing of the conclusion *)
+           Proofview.V82.of_tactic
+             (reduce
+                (Genredexpr.Cbv
+                   { Redops.all_flags with
+                     Genredexpr.rDelta = false
+                   ; Genredexpr.rConst = [] })
+                Locusops.onConcl)
+         ; observe_tac "toto " tclIDTAC
+         ; (* introducing the result of the graph and the equality hypothesis *)
+           observe_tac "introducing"
+             (tclMAP
+                (fun x -> Proofview.V82.of_tactic (Simple.intro x))
+                [res; hres])
+         ; (* replacing [res] with its value *)
+           observe_tac "rewriting res value"
+             (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar hres)))
+         ; (* Conclusion *)
+           observe_tac "exact" (fun g ->
+               Proofview.V82.of_tactic (exact_check (app_constructor g)) g) ])
         g
     in
     (* end of branche proof *)
     let lemmas =
       Array.map
-        (fun ((_,(ctxt,concl))) ->
-           match ctxt with
-           | [] | [_] | [_;_] -> CErrors.anomaly (Pp.str "bad context.")
-           | hres::res::decl::ctxt ->
-             let res = EConstr.it_mkLambda_or_LetIn
-                 (EConstr.it_mkProd_or_LetIn concl [hres;res])
-                 (LocalAssum (RelDecl.get_annot decl, RelDecl.get_type decl) :: ctxt)
-             in
-             res)
+        (fun (_, (ctxt, concl)) ->
+          match ctxt with
+          | [] | [_] | [_; _] -> CErrors.anomaly (Pp.str "bad context.")
+          | hres :: res :: decl :: ctxt ->
+            let res =
+              EConstr.it_mkLambda_or_LetIn
+                (EConstr.it_mkProd_or_LetIn concl [hres; res])
+                ( LocalAssum (RelDecl.get_annot decl, RelDecl.get_type decl)
+                :: ctxt )
+            in
+            res)
         lemmas_types_infos
     in
     let param_names = fst (List.chop princ_infos.nparams args_names) in
     let params = List.map mkVar param_names in
-    let lemmas = Array.to_list (Array.map (fun c -> applist(c,params)) lemmas) in
+    let lemmas =
+      Array.to_list (Array.map (fun c -> applist (c, params)) lemmas)
+    in
     (* The bindings of the principle
        that is the params of the principle and the different lemma types
     *)
     let bindings =
-      let params_bindings,avoid =
+      let params_bindings, avoid =
         List.fold_left2
-          (fun (bindings,avoid) decl p ->
-             let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
-             p::bindings,id::avoid
-          )
-          ([],pf_ids_of_hyps g)
-          princ_infos.params
-          (List.rev params)
+          (fun (bindings, avoid) decl p ->
+            let id =
+              Namegen.next_ident_away
+                (Nameops.Name.get_id (RelDecl.get_name decl))
+                (Id.Set.of_list avoid)
+            in
+            (p :: bindings, id :: avoid))
+          ([], pf_ids_of_hyps g)
+          princ_infos.params (List.rev params)
       in
       let lemmas_bindings =
-        List.rev (fst  (List.fold_left2
-                          (fun (bindings,avoid) decl p ->
-                             let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
-                             (Reductionops.nf_zeta (pf_env g) (project g) p)::bindings,id::avoid)
-                          ([],avoid)
-                          princ_infos.predicates
-                          (lemmas)))
+        List.rev
+          (fst
+             (List.fold_left2
+                (fun (bindings, avoid) decl p ->
+                  let id =
+                    Namegen.next_ident_away
+                      (Nameops.Name.get_id (RelDecl.get_name decl))
+                      (Id.Set.of_list avoid)
+                  in
+                  ( Reductionops.nf_zeta (pf_env g) (project g) p :: bindings
+                  , id :: avoid ))
+                ([], avoid) princ_infos.predicates lemmas))
       in
-      (params_bindings@lemmas_bindings)
+      params_bindings @ lemmas_bindings
     in
     tclTHENLIST
-      [
-        observe_tac "principle" (Proofview.V82.of_tactic (assert_by
-                                                            (Name principle_id)
-                                                            princ_type
-                                                            (exact_check f_principle)));
-        observe_tac "intro args_names" (tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) args_names);
-        (* observe_tac "titi" (pose_proof (Name (Id.of_string "__")) (Reductionops.nf_beta Evd.empty  ((mkApp (mkVar principle_id,Array.of_list bindings))))); *)
-        observe_tac "idtac" tclIDTAC;
-        tclTHEN_i
-          (observe_tac
-             "functional_induction" (
-             (fun gl ->
-                let term = mkApp (mkVar principle_id,Array.of_list bindings) in
-                let gl', _ty = pf_eapply (Typing.type_of ~refresh:true)  gl term in
-                Proofview.V82.of_tactic (apply term) gl')
-           ))
-          (fun i g -> observe_tac ("proving branche "^string_of_int i) (prove_branche i) g )
-      ]
+      [ observe_tac "principle"
+          (Proofview.V82.of_tactic
+             (assert_by (Name principle_id) princ_type
+                (exact_check f_principle)))
+      ; observe_tac "intro args_names"
+          (tclMAP
+             (fun id -> Proofview.V82.of_tactic (Simple.intro id))
+             args_names)
+      ; (* observe_tac "titi" (pose_proof (Name (Id.of_string "__")) (Reductionops.nf_beta Evd.empty  ((mkApp (mkVar principle_id,Array.of_list bindings))))); *)
+        observe_tac "idtac" tclIDTAC
+      ; tclTHEN_i
+          (observe_tac "functional_induction" (fun gl ->
+               let term = mkApp (mkVar principle_id, Array.of_list bindings) in
+               let gl', _ty =
+                 pf_eapply (Typing.type_of ~refresh:true) gl term
+               in
+               Proofview.V82.of_tactic (apply term) gl'))
+          (fun i g ->
+            observe_tac
+              ("proving branche " ^ string_of_int i)
+              (prove_branche i) g) ]
       g
 
 (* [prove_fun_complete funs graphs schemes lemmas_types_infos i]
@@ -798,13 +893,12 @@ let thin ids gl = Proofview.V82.of_tactic (Tactics.clear ids) gl
 *)
 let tauto =
   let open Ltac_plugin in
-  let dp = List.map Id.of_string ["Tauto" ; "Init"; "Coq"] in
+  let dp = List.map Id.of_string ["Tauto"; "Init"; "Coq"] in
   let mp = ModPath.MPfile (DirPath.make dp) in
   let kn = KerName.make mp (Label.make "tauto") in
-  Proofview.tclBIND (Proofview.tclUNIT ()) begin fun () ->
-    let body = Tacenv.interp_ltac kn in
-    Tacinterp.eval_tactic body
-  end
+  Proofview.tclBIND (Proofview.tclUNIT ()) (fun () ->
+      let body = Tacenv.interp_ltac kn in
+      Tacinterp.eval_tactic body)
 
 (* [generalize_dependent_of x hyp g]
    generalize every hypothesis which depends of [x] but [hyp]
@@ -815,16 +909,18 @@ let generalize_dependent_of x hyp g =
   let open Tacticals in
   tclMAP
     (function
-      | LocalAssum ({Context.binder_name=id},t) when not (Id.equal id hyp) &&
-                                                     (Termops.occur_var (pf_env g) (project g) x t) ->
-        tclTHEN (Proofview.V82.of_tactic (Tactics.generalize [EConstr.mkVar id])) (thin [id])
-      | _ -> tclIDTAC
-    )
-    (pf_hyps g)
-    g
+      | LocalAssum ({Context.binder_name = id}, t)
+        when (not (Id.equal id hyp))
+             && Termops.occur_var (pf_env g) (project g) x t ->
+        tclTHEN
+          (Proofview.V82.of_tactic (Tactics.generalize [EConstr.mkVar id]))
+          (thin [id])
+      | _ -> tclIDTAC)
+    (pf_hyps g) g
 
 let rec intros_with_rewrite g =
   observe_tac "intros_with_rewrite" intros_with_rewrite_aux g
+
 and intros_with_rewrite_aux : Tacmach.tactic =
   let open Constr in
   let open EConstr in
@@ -835,88 +931,111 @@ and intros_with_rewrite_aux : Tacmach.tactic =
     let eq_ind = make_eq () in
     let sigma = project g in
     match EConstr.kind sigma (pf_concl g) with
-    | Prod(_,t,t') ->
-      begin
-        match EConstr.kind sigma t with
-        | App(eq,args) when (EConstr.eq_constr sigma eq eq_ind)  ->
-          if Reductionops.is_conv (pf_env g) (project g) args.(1) args.(2)
-          then
-            let id = pf_get_new_id (Id.of_string "y") g  in
-            tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id); thin [id]; intros_with_rewrite ] g
-          else if isVar sigma args.(1) && (Environ.evaluable_named (destVar sigma args.(1)) (pf_env g))
-          then tclTHENLIST[
-              Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(1)))]);
-              tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(1)))] ((destVar sigma args.(1)),Locus.InHyp) )))
-                (pf_ids_of_hyps g);
-              intros_with_rewrite
-            ] g
-          else if isVar sigma args.(2) && (Environ.evaluable_named (destVar sigma args.(2)) (pf_env g))
-          then tclTHENLIST[
-              Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(2)))]);
-              tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(2)))] ((destVar sigma args.(2)),Locus.InHyp) )))
-                (pf_ids_of_hyps g);
-              intros_with_rewrite
-            ] g
-          else if isVar sigma args.(1)
-          then
-            let id = pf_get_new_id (Id.of_string "y") g  in
-            tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);
-                          generalize_dependent_of (destVar sigma args.(1)) id;
-                          tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)));
-                          intros_with_rewrite
-                        ]
-              g
-          else if isVar sigma args.(2)
-          then
-            let id = pf_get_new_id (Id.of_string "y") g  in
-            tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);
-                          generalize_dependent_of (destVar sigma args.(2)) id;
-                          tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar id)));
-                          intros_with_rewrite
-                        ]
-              g
-          else
-            begin
-              let id = pf_get_new_id (Id.of_string "y") g  in
-              tclTHENLIST[
-                Proofview.V82.of_tactic (Simple.intro id);
-                tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)));
-                intros_with_rewrite
-              ] g
-            end
-        | Ind _ when EConstr.eq_constr sigma t (EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.False.type")) ->
-          Proofview.V82.of_tactic tauto g
-        | Case(_,_,v,_) ->
-          tclTHENLIST[
-            Proofview.V82.of_tactic (simplest_case v);
-            intros_with_rewrite
-          ] g
-        | LetIn _ ->
-          tclTHENLIST[
-            Proofview.V82.of_tactic (reduce
-                                       (Genredexpr.Cbv
-                                          {Redops.all_flags
-                                           with Genredexpr.rDelta = false;
-                                          })
-                                       Locusops.onConcl)
-            ;
-            intros_with_rewrite
-          ] g
-        | _ ->
-          let id = pf_get_new_id (Id.of_string "y") g  in
-          tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);intros_with_rewrite] g
-      end
+    | Prod (_, t, t') -> (
+      match EConstr.kind sigma t with
+      | App (eq, args) when EConstr.eq_constr sigma eq eq_ind ->
+        if Reductionops.is_conv (pf_env g) (project g) args.(1) args.(2) then
+          let id = pf_get_new_id (Id.of_string "y") g in
+          tclTHENLIST
+            [ Proofview.V82.of_tactic (Simple.intro id)
+            ; thin [id]
+            ; intros_with_rewrite ]
+            g
+        else if
+          isVar sigma args.(1)
+          && Environ.evaluable_named (destVar sigma args.(1)) (pf_env g)
+        then
+          tclTHENLIST
+            [ Proofview.V82.of_tactic
+                (unfold_in_concl
+                   [ ( Locus.AllOccurrences
+                     , Names.EvalVarRef (destVar sigma args.(1)) ) ])
+            ; tclMAP
+                (fun id ->
+                  tclTRY
+                    (Proofview.V82.of_tactic
+                       (unfold_in_hyp
+                          [ ( Locus.AllOccurrences
+                            , Names.EvalVarRef (destVar sigma args.(1)) ) ]
+                          (destVar sigma args.(1), Locus.InHyp))))
+                (pf_ids_of_hyps g)
+            ; intros_with_rewrite ]
+            g
+        else if
+          isVar sigma args.(2)
+          && Environ.evaluable_named (destVar sigma args.(2)) (pf_env g)
+        then
+          tclTHENLIST
+            [ Proofview.V82.of_tactic
+                (unfold_in_concl
+                   [ ( Locus.AllOccurrences
+                     , Names.EvalVarRef (destVar sigma args.(2)) ) ])
+            ; tclMAP
+                (fun id ->
+                  tclTRY
+                    (Proofview.V82.of_tactic
+                       (unfold_in_hyp
+                          [ ( Locus.AllOccurrences
+                            , Names.EvalVarRef (destVar sigma args.(2)) ) ]
+                          (destVar sigma args.(2), Locus.InHyp))))
+                (pf_ids_of_hyps g)
+            ; intros_with_rewrite ]
+            g
+        else if isVar sigma args.(1) then
+          let id = pf_get_new_id (Id.of_string "y") g in
+          tclTHENLIST
+            [ Proofview.V82.of_tactic (Simple.intro id)
+            ; generalize_dependent_of (destVar sigma args.(1)) id
+            ; tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)))
+            ; intros_with_rewrite ]
+            g
+        else if isVar sigma args.(2) then
+          let id = pf_get_new_id (Id.of_string "y") g in
+          tclTHENLIST
+            [ Proofview.V82.of_tactic (Simple.intro id)
+            ; generalize_dependent_of (destVar sigma args.(2)) id
+            ; tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar id)))
+            ; intros_with_rewrite ]
+            g
+        else
+          let id = pf_get_new_id (Id.of_string "y") g in
+          tclTHENLIST
+            [ Proofview.V82.of_tactic (Simple.intro id)
+            ; tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)))
+            ; intros_with_rewrite ]
+            g
+      | Ind _
+        when EConstr.eq_constr sigma t
+               (EConstr.of_constr
+                  ( UnivGen.constr_of_monomorphic_global
+                  @@ Coqlib.lib_ref "core.False.type" )) ->
+        Proofview.V82.of_tactic tauto g
+      | Case (_, _, v, _) ->
+        tclTHENLIST
+          [Proofview.V82.of_tactic (simplest_case v); intros_with_rewrite]
+          g
+      | LetIn _ ->
+        tclTHENLIST
+          [ Proofview.V82.of_tactic
+              (reduce
+                 (Genredexpr.Cbv
+                    {Redops.all_flags with Genredexpr.rDelta = false})
+                 Locusops.onConcl)
+          ; intros_with_rewrite ]
+          g
+      | _ ->
+        let id = pf_get_new_id (Id.of_string "y") g in
+        tclTHENLIST
+          [Proofview.V82.of_tactic (Simple.intro id); intros_with_rewrite]
+          g )
     | LetIn _ ->
-      tclTHENLIST[
-        Proofview.V82.of_tactic (reduce
-                                   (Genredexpr.Cbv
-                                      {Redops.all_flags
-                                       with Genredexpr.rDelta = false;
-                                      })
-                                   Locusops.onConcl)
-        ;
-        intros_with_rewrite
-      ] g
+      tclTHENLIST
+        [ Proofview.V82.of_tactic
+            (reduce
+               (Genredexpr.Cbv {Redops.all_flags with Genredexpr.rDelta = false})
+               Locusops.onConcl)
+        ; intros_with_rewrite ]
+        g
     | _ -> tclIDTAC g
 
 let rec reflexivity_with_destruct_cases g =
@@ -927,52 +1046,66 @@ let rec reflexivity_with_destruct_cases g =
   let open Tacticals in
   let destruct_case () =
     try
-      match EConstr.kind (project g) (snd (destApp (project g) (pf_concl g))).(2) with
-      | Case(_,_,v,_) ->
-        tclTHENLIST[
-          Proofview.V82.of_tactic (simplest_case v);
-          Proofview.V82.of_tactic intros;
-          observe_tac "reflexivity_with_destruct_cases" reflexivity_with_destruct_cases
-        ]
+      match
+        EConstr.kind (project g) (snd (destApp (project g) (pf_concl g))).(2)
+      with
+      | Case (_, _, v, _) ->
+        tclTHENLIST
+          [ Proofview.V82.of_tactic (simplest_case v)
+          ; Proofview.V82.of_tactic intros
+          ; observe_tac "reflexivity_with_destruct_cases"
+              reflexivity_with_destruct_cases ]
       | _ -> Proofview.V82.of_tactic reflexivity
     with e when CErrors.noncritical e -> Proofview.V82.of_tactic reflexivity
   in
   let eq_ind = make_eq () in
-  let my_inj_flags = Some {
-      Equality.keep_proof_equalities = false;
-      injection_in_context = false; (* for compatibility, necessary *)
-      injection_pattern_l2r_order = false; (* probably does not matter; except maybe with dependent hyps *)
-    } in
+  let my_inj_flags =
+    Some
+      { Equality.keep_proof_equalities = false
+      ; injection_in_context = false
+      ; (* for compatibility, necessary *)
+        injection_pattern_l2r_order =
+          false (* probably does not matter; except maybe with dependent hyps *)
+      }
+  in
   let discr_inject =
-    Tacticals.onAllHypsAndConcl (
-      fun sc g ->
+    Tacticals.onAllHypsAndConcl (fun sc g ->
         match sc with
-          None -> tclIDTAC g
-        | Some id ->
+        | None -> tclIDTAC g
+        | Some id -> (
           match EConstr.kind (project g) (pf_get_hyp_typ g id) with
-          | App(eq,[|_;t1;t2|]) when EConstr.eq_constr (project g) eq eq_ind ->
-            if Equality.discriminable (pf_env g) (project g) t1 t2
-            then Proofview.V82.of_tactic (Equality.discrHyp id) g
-            else if Equality.injectable (pf_env g) (project g) ~keep_proofs:None t1 t2
-            then tclTHENLIST [Proofview.V82.of_tactic (Equality.injHyp my_inj_flags None id);thin [id];intros_with_rewrite]  g
+          | App (eq, [|_; t1; t2|]) when EConstr.eq_constr (project g) eq eq_ind
+            ->
+            if Equality.discriminable (pf_env g) (project g) t1 t2 then
+              Proofview.V82.of_tactic (Equality.discrHyp id) g
+            else if
+              Equality.injectable (pf_env g) (project g) ~keep_proofs:None t1 t2
+            then
+              tclTHENLIST
+                [ Proofview.V82.of_tactic (Equality.injHyp my_inj_flags None id)
+                ; thin [id]
+                ; intros_with_rewrite ]
+                g
             else tclIDTAC g
-          | _ -> tclIDTAC g
-    )
+          | _ -> tclIDTAC g ))
   in
   (tclFIRST
-     [ observe_tac "reflexivity_with_destruct_cases : reflexivity" (Proofview.V82.of_tactic reflexivity);
-       observe_tac "reflexivity_with_destruct_cases : destruct_case" ((destruct_case ()));
-       (*  We reach this point ONLY if
-           the same value is matched (at least) two times
-           along binding path.
-           In this case, either we have a discriminable hypothesis and we are done,
-           either at least an injectable one and we do the injection before continuing
+     [ observe_tac "reflexivity_with_destruct_cases : reflexivity"
+         (Proofview.V82.of_tactic reflexivity)
+     ; observe_tac "reflexivity_with_destruct_cases : destruct_case"
+         (destruct_case ())
+     ; (* We reach this point ONLY if
+          the same value is matched (at least) two times
+          along binding path.
+          In this case, either we have a discriminable hypothesis and we are done,
+          either at least an injectable one and we do the injection before continuing
        *)
-       observe_tac "reflexivity_with_destruct_cases : others" (tclTHEN (tclPROGRESS discr_inject ) reflexivity_with_destruct_cases)
-     ])
+       observe_tac "reflexivity_with_destruct_cases : others"
+         (tclTHEN (tclPROGRESS discr_inject) reflexivity_with_destruct_cases) ])
     g
 
-let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tactic =
+let prove_fun_complete funcs graphs schemes lemmas_types_infos i :
+    Tacmach.tactic =
   let open EConstr in
   let open Tacmach in
   let open Tactics in
@@ -983,12 +1116,17 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tacti
     *)
     let lemmas =
       Array.map
-        (fun (_,(ctxt,concl)) -> Reductionops.nf_zeta (pf_env g) (project g) (EConstr.it_mkLambda_or_LetIn concl ctxt))
+        (fun (_, (ctxt, concl)) ->
+          Reductionops.nf_zeta (pf_env g) (project g)
+            (EConstr.it_mkLambda_or_LetIn concl ctxt))
         lemmas_types_infos
     in
     (* We get the constant and the principle corresponding to this lemma *)
     let f = funcs.(i) in
-    let graph_principle = Reductionops.nf_zeta (pf_env g) (project g) (EConstr.of_constr schemes.(i))  in
+    let graph_principle =
+      Reductionops.nf_zeta (pf_env g) (project g)
+        (EConstr.of_constr schemes.(i))
+    in
     let g, princ_type = tac_type_of g graph_principle in
     let princ_infos = Tactics.compute_elim_sig (project g) princ_type in
     (* Then we get the number of argument of the function
@@ -996,24 +1134,24 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tacti
     *)
     let nb_fun_args = Termops.nb_prod (project g) (pf_concl g) - 2 in
     let args_names = generate_fresh_id (Id.of_string "x") [] nb_fun_args in
-    let ids = args_names@(pf_ids_of_hyps g) in
+    let ids = args_names @ pf_ids_of_hyps g in
     (* and fresh names for res H and the principle (cf bug bug #1174) *)
-    let res,hres,graph_principle_id =
+    let res, hres, graph_principle_id =
       match generate_fresh_id (Id.of_string "z") ids 3 with
-      | [res;hres;graph_principle_id] -> res,hres,graph_principle_id
+      | [res; hres; graph_principle_id] -> (res, hres, graph_principle_id)
       | _ -> assert false
     in
-    let ids = res::hres::graph_principle_id::ids in
+    let ids = res :: hres :: graph_principle_id :: ids in
     (* we also compute fresh names for each hyptohesis of each branch
        of the principle *)
     let branches = List.rev princ_infos.branches in
     let intro_pats =
       List.map
         (fun decl ->
-           List.map
-             (fun id -> id)
-             (generate_fresh_id (Id.of_string "y") ids (Termops.nb_prod (project g) (RelDecl.get_type decl)))
-        )
+          List.map
+            (fun id -> id)
+            (generate_fresh_id (Id.of_string "y") ids
+               (Termops.nb_prod (project g) (RelDecl.get_type decl))))
         branches
     in
     (* We will need to change the function by its body
@@ -1022,34 +1160,38 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tacti
     *)
     let rewrite_tac j ids : Tacmach.tactic =
       let graph_def = graphs.(j) in
-      let infos = match find_Function_infos (fst (destConst (project g) funcs.(j))) with
-        | None ->
-          CErrors.user_err Pp.(str "No graph found")
+      let infos =
+        match find_Function_infos (fst (destConst (project g) funcs.(j))) with
+        | None -> CErrors.user_err Pp.(str "No graph found")
         | Some infos -> infos
       in
-      if infos.is_general || Rtree.is_infinite Declareops.eq_recarg graph_def.Declarations.mind_recargs
+      if
+        infos.is_general
+        || Rtree.is_infinite Declareops.eq_recarg
+             graph_def.Declarations.mind_recargs
       then
         let eq_lemma =
-          try Option.get (infos).equation_lemma
-          with Option.IsNone -> CErrors.anomaly (Pp.str "Cannot find equation lemma.")
+          try Option.get infos.equation_lemma
+          with Option.IsNone ->
+            CErrors.anomaly (Pp.str "Cannot find equation lemma.")
         in
-        tclTHENLIST[
-          tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) ids;
-          Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_lemma));
-          (* Don't forget to $\zeta$ normlize the term since the principles
-             have been $\zeta$-normalized *)
-          Proofview.V82.of_tactic (reduce
-                                     (Genredexpr.Cbv
-                                        {Redops.all_flags
-                                         with Genredexpr.rDelta = false;
-                                        })
-                                     Locusops.onConcl)
-          ;
-          Proofview.V82.of_tactic (generalize (List.map mkVar ids));
-          thin ids
-        ]
+        tclTHENLIST
+          [ tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) ids
+          ; Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_lemma))
+          ; (* Don't forget to $\zeta$ normlize the term since the principles
+               have been $\zeta$-normalized *)
+            Proofview.V82.of_tactic
+              (reduce
+                 (Genredexpr.Cbv
+                    {Redops.all_flags with Genredexpr.rDelta = false})
+                 Locusops.onConcl)
+          ; Proofview.V82.of_tactic (generalize (List.map mkVar ids))
+          ; thin ids ]
       else
-        Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalConstRef (fst (destConst (project g) f)))])
+        Proofview.V82.of_tactic
+          (unfold_in_concl
+             [ ( Locus.AllOccurrences
+               , Names.EvalConstRef (fst (destConst (project g) f)) ) ])
     in
     (* The proof of each branche itself *)
     let ind_number = ref 0 in
@@ -1058,40 +1200,49 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tacti
       (* we fist compute the inductive corresponding to the branch *)
       let this_ind_number =
         let constructor_num = i - !min_constr_number in
-        let length = Array.length (graphs.(!ind_number).Declarations.mind_consnames) in
-        if constructor_num <= length
-        then !ind_number
-        else
-          begin
-            incr ind_number;
-            min_constr_number := !min_constr_number + length;
-            !ind_number
-          end
+        let length =
+          Array.length graphs.(!ind_number).Declarations.mind_consnames
+        in
+        if constructor_num <= length then !ind_number
+        else begin
+          incr ind_number;
+          min_constr_number := !min_constr_number + length;
+          !ind_number
+        end
       in
       let this_branche_ids = List.nth intro_pats (pred i) in
-      tclTHENLIST[
-        (* we expand the definition of the function *)
-        observe_tac "rewrite_tac" (rewrite_tac this_ind_number this_branche_ids);
-        (* introduce hypothesis with some rewrite *)
-        observe_tac "intros_with_rewrite (all)" intros_with_rewrite;
-        (* The proof is (almost) complete *)
-        observe_tac "reflexivity" (reflexivity_with_destruct_cases)
-      ]
+      tclTHENLIST
+        [ (* we expand the definition of the function *)
+          observe_tac "rewrite_tac"
+            (rewrite_tac this_ind_number this_branche_ids)
+        ; (* introduce hypothesis with some rewrite *)
+          observe_tac "intros_with_rewrite (all)" intros_with_rewrite
+        ; (* The proof is (almost) complete *)
+          observe_tac "reflexivity" reflexivity_with_destruct_cases ]
         g
     in
     let params_names = fst (List.chop princ_infos.nparams args_names) in
     let open EConstr in
     let params = List.map mkVar params_names in
     tclTHENLIST
-      [ tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) (args_names@[res;hres]);
-        observe_tac "h_generalize"
-          (Proofview.V82.of_tactic (generalize [mkApp(applist(graph_principle,params),Array.map (fun c -> applist(c,params)) lemmas)]));
-        Proofview.V82.of_tactic (Simple.intro graph_principle_id);
-        observe_tac "" (tclTHEN_i
-                          (observe_tac "elim" (Proofview.V82.of_tactic (elim false None (mkVar hres, Tactypes.NoBindings)
-                                                                          (Some (mkVar graph_principle_id, Tactypes.NoBindings)))))
-                          (fun i g -> observe_tac "prove_branche" (prove_branche i) g ))
-      ]
+      [ tclMAP
+          (fun id -> Proofview.V82.of_tactic (Simple.intro id))
+          (args_names @ [res; hres])
+      ; observe_tac "h_generalize"
+          (Proofview.V82.of_tactic
+             (generalize
+                [ mkApp
+                    ( applist (graph_principle, params)
+                    , Array.map (fun c -> applist (c, params)) lemmas ) ]))
+      ; Proofview.V82.of_tactic (Simple.intro graph_principle_id)
+      ; observe_tac ""
+          (tclTHEN_i
+             (observe_tac "elim"
+                (Proofview.V82.of_tactic
+                   (elim false None
+                      (mkVar hres, Tactypes.NoBindings)
+                      (Some (mkVar graph_principle_id, Tactypes.NoBindings)))))
+             (fun i g -> observe_tac "prove_branche" (prove_branche i) g)) ]
       g
 
 exception No_graph_found
@@ -1099,35 +1250,35 @@ exception No_graph_found
 let get_funs_constant mp =
   let open Constr in
   let exception Not_Rec in
-  let get_funs_constant const e : (Names.Constant.t*int) array =
+  let get_funs_constant const e : (Names.Constant.t * int) array =
     match Constr.kind (Term.strip_lam e) with
-    | Fix((_,(na,_,_))) ->
+    | Fix (_, (na, _, _)) ->
       Array.mapi
         (fun i na ->
-           match na.Context.binder_name with
-           | Name id ->
-             let const = Constant.make2 mp (Label.of_id id) in
-             const,i
-           | Anonymous ->
-             CErrors.anomaly (Pp.str "Anonymous fix.")
-        )
+          match na.Context.binder_name with
+          | Name id ->
+            let const = Constant.make2 mp (Label.of_id id) in
+            (const, i)
+          | Anonymous -> CErrors.anomaly (Pp.str "Anonymous fix."))
         na
-    | _ -> [|const,0|]
+    | _ -> [|(const, 0)|]
   in
-  function const ->
+  function
+  | const ->
     let find_constant_body const =
       match Global.body_of_constant Library.indirect_accessor const with
-        | Some (body, _, _) ->
-            let body = Tacred.cbv_norm_flags
-              (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
-              (Global.env ())
-              (Evd.from_env (Global.env ()))
-              (EConstr.of_constr body)
-            in
-            let body = EConstr.Unsafe.to_constr body in
-            body
-        | None ->
-          CErrors.user_err Pp.(str ( "Cannot define a principle over an axiom "))
+      | Some (body, _, _) ->
+        let body =
+          Tacred.cbv_norm_flags
+            (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
+            (Global.env ())
+            (Evd.from_env (Global.env ()))
+            (EConstr.of_constr body)
+        in
+        let body = EConstr.Unsafe.to_constr body in
+        body
+      | None ->
+        CErrors.user_err Pp.(str "Cannot define a principle over an axiom ")
     in
     let f = find_constant_body const in
     let l_const = get_funs_constant const f in
@@ -1135,17 +1286,24 @@ let get_funs_constant mp =
        We need to check that all the functions found are in the same block
        to prevent Reset strange thing
     *)
-    let l_bodies = List.map find_constant_body (Array.to_list (Array.map fst l_const)) in
-    let l_params, _l_fixes = List.split (List.map Term.decompose_lam l_bodies) in
+    let l_bodies =
+      List.map find_constant_body (Array.to_list (Array.map fst l_const))
+    in
+    let l_params, _l_fixes =
+      List.split (List.map Term.decompose_lam l_bodies)
+    in
     (* all the parameters must be equal*)
     let _check_params =
-      let first_params = List.hd l_params  in
+      let first_params = List.hd l_params in
       List.iter
         (fun params ->
-   if not (List.equal (fun (n1, c1) (n2, c2) ->
-       Context.eq_annot Name.equal n1 n2 && Constr.equal c1 c2) first_params params)
-           then CErrors.user_err Pp.(str "Not a mutal recursive block")
-        )
+          if
+            not
+              (List.equal
+                 (fun (n1, c1) (n2, c2) ->
+                   Context.eq_annot Name.equal n1 n2 && Constr.equal c1 c2)
+                 first_params params)
+          then CErrors.user_err Pp.(str "Not a mutal recursive block"))
         l_params
     in
     (* The bodies has to be very similar *)
@@ -1153,27 +1311,30 @@ let get_funs_constant mp =
       try
         let extract_info is_first body =
           match Constr.kind body with
-            | Fix((idxs,_),(na,ta,ca)) -> (idxs,na,ta,ca)
-            | _ ->
-                if is_first && Int.equal (List.length l_bodies) 1
-                then raise Not_Rec
-                else CErrors.user_err Pp.(str "Not a mutal recursive block")
+          | Fix ((idxs, _), (na, ta, ca)) -> (idxs, na, ta, ca)
+          | _ ->
+            if is_first && Int.equal (List.length l_bodies) 1 then raise Not_Rec
+            else CErrors.user_err Pp.(str "Not a mutal recursive block")
         in
         let first_infos = extract_info true (List.hd l_bodies) in
-        let check body  = (* Hope this is correct *)
+        let check body =
+          (* Hope this is correct *)
           let eq_infos (ia1, na1, ta1, ca1) (ia2, na2, ta2, ca2) =
-     Array.equal Int.equal ia1 ia2 && Array.equal (Context.eq_annot Name.equal) na1 na2 &&
-     Array.equal Constr.equal ta1 ta2 && Array.equal Constr.equal ca1 ca2
+            Array.equal Int.equal ia1 ia2
+            && Array.equal (Context.eq_annot Name.equal) na1 na2
+            && Array.equal Constr.equal ta1 ta2
+            && Array.equal Constr.equal ca1 ca2
           in
-          if not (eq_infos first_infos (extract_info false body))
-          then CErrors.user_err Pp.(str "Not a mutal recursive block")
+          if not (eq_infos first_infos (extract_info false body)) then
+            CErrors.user_err Pp.(str "Not a mutal recursive block")
         in
         List.iter check l_bodies
       with Not_Rec -> ()
     in
     l_const
 
-let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : Evd.side_effects Declare.proof_entry list =
+let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) :
+    Evd.side_effects Declare.proof_entry list =
   let exception Found_type of int in
   let env = Global.env () in
   let funs = List.map fst fas in
@@ -1185,42 +1346,47 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : Evd.side_ef
     | Some finfos -> fst finfos.graph_ind
   in
   let this_block_funs_indexes = get_funs_constant funs_mp (fst first_fun) in
-  let this_block_funs = Array.map (fun (c,_) -> (c,snd first_fun)) this_block_funs_indexes in
+  let this_block_funs =
+    Array.map (fun (c, _) -> (c, snd first_fun)) this_block_funs_indexes
+  in
   let prop_sort = Sorts.InProp in
   let funs_indexes =
     let this_block_funs_indexes = Array.to_list this_block_funs_indexes in
     List.map
-      (function cst -> List.assoc_f Constant.equal (fst cst) this_block_funs_indexes)
+      (function
+        | cst -> List.assoc_f Constant.equal (fst cst) this_block_funs_indexes)
       funs
   in
   let ind_list =
     List.map
-      (fun (idx) ->
-         let ind = first_fun_kn,idx in
-           (ind,snd first_fun),true,prop_sort
-      )
+      (fun idx ->
+        let ind = (first_fun_kn, idx) in
+        ((ind, snd first_fun), true, prop_sort))
       funs_indexes
   in
-  let sigma, schemes =
-    Indrec.build_mutual_induction_scheme env !evd ind_list
-  in
+  let sigma, schemes = Indrec.build_mutual_induction_scheme env !evd ind_list in
   let _ = evd := sigma in
   let l_schemes =
-    List.map (EConstr.of_constr %> Retyping.get_type_of env sigma %> EConstr.Unsafe.to_constr) schemes
+    List.map
+      ( EConstr.of_constr
+      %> Retyping.get_type_of env sigma
+      %> EConstr.Unsafe.to_constr )
+      schemes
   in
   let i = ref (-1) in
   let sorts =
-    List.rev_map (fun (_,x) ->
+    List.rev_map
+      (fun (_, x) ->
         let sigma, fs = Evd.fresh_sort_in_family !evd x in
-        evd := sigma; fs
-      )
+        evd := sigma;
+        fs)
       fas
   in
   (* We create the first principle by tactic *)
-  let first_type,other_princ_types =
+  let first_type, other_princ_types =
     match l_schemes with
-        s::l_schemes -> s,l_schemes
-      | _ -> CErrors.anomaly (Pp.str "")
+    | s :: l_schemes -> (s, l_schemes)
+    | _ -> CErrors.anomaly (Pp.str "")
   in
   let opaque =
     let finfos =
@@ -1232,276 +1398,294 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : Evd.side_ef
     match finfos.equation_lemma with
     | None -> Transparent (* non recursive definition *)
     | Some equation ->
-      if Declareops.is_opaque (Global.lookup_constant equation) then Opaque else Transparent
+      if Declareops.is_opaque (Global.lookup_constant equation) then Opaque
+      else Transparent
   in
   let entry, _hook =
     try
-      build_functional_principle ~opaque evd
-        first_type
-        (Array.of_list sorts)
-        this_block_funs
-        0
-        (Functional_principles_proofs.prove_princ_for_struct evd false 0 (Array.of_list (List.map fst funs)))
+      build_functional_principle ~opaque evd first_type (Array.of_list sorts)
+        this_block_funs 0
+        (Functional_principles_proofs.prove_princ_for_struct evd false 0
+           (Array.of_list (List.map fst funs)))
         (fun _ _ -> ())
-    with e when CErrors.noncritical e ->
-      raise (Defining_principle e)
-
+    with e when CErrors.noncritical e -> raise (Defining_principle e)
   in
   incr i;
   (* The others are just deduced *)
-  if List.is_empty other_princ_types
-  then [entry]
+  if List.is_empty other_princ_types then [entry]
   else
     let other_fun_princ_types =
       let funs = Array.map Constr.mkConstU this_block_funs in
       let sorts = Array.of_list sorts in
-      List.map (Functional_principles_types.compute_new_princ_type_from_rel funs sorts) other_princ_types
+      List.map
+        (Functional_principles_types.compute_new_princ_type_from_rel funs sorts)
+        other_princ_types
     in
     let first_princ_body = entry.Declare.proof_entry_body in
-    let ctxt,fix = Term.decompose_lam_assum (fst(fst(Future.force first_princ_body))) in (* the principle has for forall ...., fix .*)
-    let (idxs,_),(_,ta,_ as decl) = Constr.destFix fix in
+    let ctxt, fix =
+      Term.decompose_lam_assum (fst (fst (Future.force first_princ_body)))
+    in
+    (* the principle has for forall ...., fix .*)
+    let (idxs, _), ((_, ta, _) as decl) = Constr.destFix fix in
     let other_result =
       List.map (* we can now compute the other principles *)
         (fun scheme_type ->
-           incr i;
-           observe (Printer.pr_lconstr_env env sigma scheme_type);
-           let type_concl = (Term.strip_prod_assum scheme_type) in
-           let applied_f = List.hd (List.rev (snd (Constr.decompose_app type_concl))) in
-           let f = fst (Constr.decompose_app applied_f) in
-           try (* we search the number of the function in the fix block (name of the function) *)
-             Array.iteri
-             (fun j t ->
-                let t =  (Term.strip_prod_assum t) in
-                let applied_g = List.hd (List.rev (snd (Constr.decompose_app t))) in
+          incr i;
+          observe (Printer.pr_lconstr_env env sigma scheme_type);
+          let type_concl = Term.strip_prod_assum scheme_type in
+          let applied_f =
+            List.hd (List.rev (snd (Constr.decompose_app type_concl)))
+          in
+          let f = fst (Constr.decompose_app applied_f) in
+          try
+            (* we search the number of the function in the fix block (name of the function) *)
+            Array.iteri
+              (fun j t ->
+                let t = Term.strip_prod_assum t in
+                let applied_g =
+                  List.hd (List.rev (snd (Constr.decompose_app t)))
+                in
                 let g = fst (Constr.decompose_app applied_g) in
-                if Constr.equal f g
-                then raise (Found_type j);
-                observe Pp.(Printer.pr_lconstr_env env sigma f ++ str " <> " ++
-                            Printer.pr_lconstr_env env sigma g)
-
-             )
-             ta;
-             (* If we reach this point, the two principle are not mutually recursive
-                We fall back to the previous method
-                *)
-             let entry, _hook =
-               build_functional_principle
-                 evd
-                 (List.nth other_princ_types (!i - 1))
-                 (Array.of_list sorts)
-                 this_block_funs
-                 !i
-                 (Functional_principles_proofs.prove_princ_for_struct evd false !i (Array.of_list (List.map fst funs)))
-                 (fun _ _ -> ())
-             in
-             entry
-         with Found_type i ->
-           let princ_body =
-             Termops.it_mkLambda_or_LetIn (Constr.mkFix((idxs,i),decl)) ctxt
-           in
-           Declare.definition_entry ~types:scheme_type princ_body
-      )
-      other_fun_princ_types
+                if Constr.equal f g then raise (Found_type j);
+                observe
+                  Pp.(
+                    Printer.pr_lconstr_env env sigma f
+                    ++ str " <> "
+                    ++ Printer.pr_lconstr_env env sigma g))
+              ta;
+            (* If we reach this point, the two principle are not mutually recursive
+               We fall back to the previous method
+            *)
+            let entry, _hook =
+              build_functional_principle evd
+                (List.nth other_princ_types (!i - 1))
+                (Array.of_list sorts) this_block_funs !i
+                (Functional_principles_proofs.prove_princ_for_struct evd false
+                   !i
+                   (Array.of_list (List.map fst funs)))
+                (fun _ _ -> ())
+            in
+            entry
+          with Found_type i ->
+            let princ_body =
+              Termops.it_mkLambda_or_LetIn (Constr.mkFix ((idxs, i), decl)) ctxt
+            in
+            Declare.definition_entry ~types:scheme_type princ_body)
+        other_fun_princ_types
     in
-    entry::other_result
+    entry :: other_result
 
 (* [derive_correctness funs graphs] create correctness and completeness
    lemmas for each function in [funs] w.r.t. [graphs]
 *)
 
-let derive_correctness (funs: Constr.pconstant list) (graphs:inductive list) =
+let derive_correctness (funs : Constr.pconstant list) (graphs : inductive list)
+    =
   let open EConstr in
   assert (funs <> []);
   assert (graphs <> []);
   let funs = Array.of_list funs and graphs = Array.of_list graphs in
   let map (c, u) = mkConstU (c, EInstance.make u) in
-  let funs_constr = Array.map map funs  in
+  let funs_constr = Array.map map funs in
   (* XXX STATE Why do we need this... why is the toplevel protection not enough *)
   funind_purify
     (fun () ->
-       let env = Global.env () in
-       let evd = ref (Evd.from_env env) in
-       let graphs_constr = Array.map mkInd graphs in
-       let lemmas_types_infos =
-         Util.Array.map2_i
-           (fun i f_constr graph ->
-              let (type_of_lemma_ctxt,type_of_lemma_concl,graph) =
-                generate_type evd false f_constr graph
-              in
-              let type_info = (type_of_lemma_ctxt,type_of_lemma_concl) in
-              graphs_constr.(i) <- graph;
-              let type_of_lemma = EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt in
-              let sigma, _ = Typing.type_of (Global.env ()) !evd type_of_lemma in
-              evd := sigma;
-              let type_of_lemma = Reductionops.nf_zeta (Global.env ()) !evd type_of_lemma in
-              observe Pp.(str "type_of_lemma := " ++ Printer.pr_leconstr_env (Global.env ()) !evd type_of_lemma);
-              type_of_lemma,type_info
-           )
-           funs_constr
-           graphs_constr
-       in
-       let schemes =
-         (* The functional induction schemes are computed and not saved if there is more that one function
-            if the block contains only one function we can safely reuse [f_rect]
-         *)
-         try
-           if not (Int.equal (Array.length funs_constr) 1) then raise Not_found;
-           [| find_induction_principle evd funs_constr.(0) |]
-         with Not_found ->
-           (
-
-             Array.of_list
-               (List.map
-                  (fun entry ->
-                     (EConstr.of_constr (fst (fst (Future.force entry.Declare.proof_entry_body))),
-                      EConstr.of_constr (Option.get entry.Declare.proof_entry_type ))
-                  )
-                  (make_scheme evd (Array.map_to_list (fun const -> const,Sorts.InType) funs))
-               )
-           )
-       in
-       let proving_tac =
-         prove_fun_correct !evd graphs_constr schemes lemmas_types_infos
-       in
-       Array.iteri
-         (fun i f_as_constant ->
-            let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
-            (*i The next call to mk_correct_id is valid since we are constructing the lemma
-                Ensures by: obvious
-              i*)
-            let lem_id = mk_correct_id f_id in
-            let (typ,_) = lemmas_types_infos.(i) in
-            let lemma = Lemmas.start_lemma ~name:lem_id ~poly:false !evd typ in
-            let lemma = fst @@ Lemmas.by
-                (Proofview.V82.tactic (proving_tac i)) lemma in
-            let () = Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent ~idopt:None in
-            let finfo =
-              match find_Function_infos (fst f_as_constant) with
-              | None -> raise Not_found
-              | Some finfo -> finfo
+      let env = Global.env () in
+      let evd = ref (Evd.from_env env) in
+      let graphs_constr = Array.map mkInd graphs in
+      let lemmas_types_infos =
+        Util.Array.map2_i
+          (fun i f_constr graph ->
+            let type_of_lemma_ctxt, type_of_lemma_concl, graph =
+              generate_type evd false f_constr graph
             in
-            (* let lem_cst = fst (destConst (Constrintern.global_reference lem_id)) in *)
-            let _,lem_cst_constr = Evd.fresh_global
-                (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-            let (lem_cst,_) = EConstr.destConst !evd lem_cst_constr in
-            update_Function {finfo with correctness_lemma = Some lem_cst};
-
-         )
-         funs;
-       let lemmas_types_infos =
-         Util.Array.map2_i
-           (fun i f_constr graph ->
-              let (type_of_lemma_ctxt,type_of_lemma_concl,graph) =
-                generate_type evd true f_constr graph
-              in
-              let type_info = (type_of_lemma_ctxt,type_of_lemma_concl) in
-              graphs_constr.(i) <- graph;
-              let type_of_lemma =
-                EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt
-              in
-              let type_of_lemma = Reductionops.nf_zeta env !evd type_of_lemma in
-              observe Pp.(str "type_of_lemma := " ++ Printer.pr_leconstr_env env !evd type_of_lemma);
-              type_of_lemma,type_info
-           )
-           funs_constr
-           graphs_constr
-       in
-
-       let (kn,_) as graph_ind,u  = (destInd !evd graphs_constr.(0)) in
-       let mib, _mip = Global.lookup_inductive graph_ind in
-       let sigma, scheme =
-         (Indrec.build_mutual_induction_scheme (Global.env ()) !evd
-            (Array.to_list
-               (Array.mapi
-                  (fun i _ -> ((kn,i), EInstance.kind !evd u),true, Sorts.InType)
-                  mib.Declarations.mind_packets
-               )
-            )
-         )
-       in
-       let schemes =
-         Array.of_list scheme
-       in
-       let proving_tac =
-         prove_fun_complete funs_constr mib.Declarations.mind_packets schemes lemmas_types_infos
-       in
-       Array.iteri
-         (fun i f_as_constant ->
-            let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
-            (*i The next call to mk_complete_id is valid since we are constructing the lemma
-                Ensures by: obvious
-              i*)
-            let lem_id = mk_complete_id f_id in
-            let lemma = Lemmas.start_lemma ~name:lem_id ~poly:false sigma (fst lemmas_types_infos.(i)) in
-            let lemma = fst (Lemmas.by
-                               (Proofview.V82.tactic (observe_tac ("prove completeness ("^(Id.to_string f_id)^")")
-                                                        (proving_tac i))) lemma) in
-            let () = Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent ~idopt:None in
-            let finfo =
-              match find_Function_infos (fst f_as_constant) with
-              | None -> raise Not_found
-              | Some finfo -> finfo
+            let type_info = (type_of_lemma_ctxt, type_of_lemma_concl) in
+            graphs_constr.(i) <- graph;
+            let type_of_lemma =
+              EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt
             in
-            let _,lem_cst_constr = Evd.fresh_global
-                (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-            let (lem_cst,_) = destConst !evd lem_cst_constr in
-            update_Function {finfo with completeness_lemma = Some lem_cst}
-         )
-         funs)
+            let sigma, _ = Typing.type_of (Global.env ()) !evd type_of_lemma in
+            evd := sigma;
+            let type_of_lemma =
+              Reductionops.nf_zeta (Global.env ()) !evd type_of_lemma
+            in
+            observe
+              Pp.(
+                str "type_of_lemma := "
+                ++ Printer.pr_leconstr_env (Global.env ()) !evd type_of_lemma);
+            (type_of_lemma, type_info))
+          funs_constr graphs_constr
+      in
+      let schemes =
+        (* The functional induction schemes are computed and not saved if there is more that one function
+           if the block contains only one function we can safely reuse [f_rect]
+        *)
+        try
+          if not (Int.equal (Array.length funs_constr) 1) then raise Not_found;
+          [|find_induction_principle evd funs_constr.(0)|]
+        with Not_found ->
+          Array.of_list
+            (List.map
+               (fun entry ->
+                 ( EConstr.of_constr
+                     (fst (fst (Future.force entry.Declare.proof_entry_body)))
+                 , EConstr.of_constr (Option.get entry.Declare.proof_entry_type)
+                 ))
+               (make_scheme evd
+                  (Array.map_to_list (fun const -> (const, Sorts.InType)) funs)))
+      in
+      let proving_tac =
+        prove_fun_correct !evd graphs_constr schemes lemmas_types_infos
+      in
+      Array.iteri
+        (fun i f_as_constant ->
+          let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
+          (*i The next call to mk_correct_id is valid since we are constructing the lemma
+              Ensures by: obvious
+            i*)
+          let lem_id = mk_correct_id f_id in
+          let typ, _ = lemmas_types_infos.(i) in
+          let lemma = Lemmas.start_lemma ~name:lem_id ~poly:false !evd typ in
+          let lemma =
+            fst @@ Lemmas.by (Proofview.V82.tactic (proving_tac i)) lemma
+          in
+          let () =
+            Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent
+              ~idopt:None
+          in
+          let finfo =
+            match find_Function_infos (fst f_as_constant) with
+            | None -> raise Not_found
+            | Some finfo -> finfo
+          in
+          (* let lem_cst = fst (destConst (Constrintern.global_reference lem_id)) in *)
+          let _, lem_cst_constr =
+            Evd.fresh_global (Global.env ()) !evd
+              (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id))
+          in
+          let lem_cst, _ = EConstr.destConst !evd lem_cst_constr in
+          update_Function {finfo with correctness_lemma = Some lem_cst})
+        funs;
+      let lemmas_types_infos =
+        Util.Array.map2_i
+          (fun i f_constr graph ->
+            let type_of_lemma_ctxt, type_of_lemma_concl, graph =
+              generate_type evd true f_constr graph
+            in
+            let type_info = (type_of_lemma_ctxt, type_of_lemma_concl) in
+            graphs_constr.(i) <- graph;
+            let type_of_lemma =
+              EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt
+            in
+            let type_of_lemma = Reductionops.nf_zeta env !evd type_of_lemma in
+            observe
+              Pp.(
+                str "type_of_lemma := "
+                ++ Printer.pr_leconstr_env env !evd type_of_lemma);
+            (type_of_lemma, type_info))
+          funs_constr graphs_constr
+      in
+      let ((kn, _) as graph_ind), u = destInd !evd graphs_constr.(0) in
+      let mib, _mip = Global.lookup_inductive graph_ind in
+      let sigma, scheme =
+        Indrec.build_mutual_induction_scheme (Global.env ()) !evd
+          (Array.to_list
+             (Array.mapi
+                (fun i _ ->
+                  (((kn, i), EInstance.kind !evd u), true, Sorts.InType))
+                mib.Declarations.mind_packets))
+      in
+      let schemes = Array.of_list scheme in
+      let proving_tac =
+        prove_fun_complete funs_constr mib.Declarations.mind_packets schemes
+          lemmas_types_infos
+      in
+      Array.iteri
+        (fun i f_as_constant ->
+          let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
+          (*i The next call to mk_complete_id is valid since we are constructing the lemma
+              Ensures by: obvious
+            i*)
+          let lem_id = mk_complete_id f_id in
+          let lemma =
+            Lemmas.start_lemma ~name:lem_id ~poly:false sigma
+              (fst lemmas_types_infos.(i))
+          in
+          let lemma =
+            fst
+              (Lemmas.by
+                 (Proofview.V82.tactic
+                    (observe_tac
+                       ("prove completeness (" ^ Id.to_string f_id ^ ")")
+                       (proving_tac i)))
+                 lemma)
+          in
+          let () =
+            Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent
+              ~idopt:None
+          in
+          let finfo =
+            match find_Function_infos (fst f_as_constant) with
+            | None -> raise Not_found
+            | Some finfo -> finfo
+          in
+          let _, lem_cst_constr =
+            Evd.fresh_global (Global.env ()) !evd
+              (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id))
+          in
+          let lem_cst, _ = destConst !evd lem_cst_constr in
+          update_Function {finfo with completeness_lemma = Some lem_cst})
+        funs)
     ()
 
 let warn_funind_cannot_build_inversion =
   CWarnings.create ~name:"funind-cannot-build-inversion" ~category:"funind"
-    Pp.(fun e' -> strbrk "Cannot build inversion information" ++
-                  if do_observe () then (fnl() ++ CErrors.print e') else mt ())
+    Pp.(
+      fun e' ->
+        strbrk "Cannot build inversion information"
+        ++ if do_observe () then fnl () ++ CErrors.print e' else mt ())
 
 let derive_inversion fix_names =
   try
     let evd' = Evd.from_env (Global.env ()) in
     (* we first transform the fix_names identifier into their corresponding constant *)
-    let evd',fix_names_as_constant =
+    let evd', fix_names_as_constant =
       List.fold_right
-        (fun id (evd,l) ->
-           let evd,c =
-             Evd.fresh_global
-               (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident id)) in
-           let (cst, u) = EConstr.destConst evd c in
-           evd, (cst, EConstr.EInstance.kind evd u) :: l
-        )
-        fix_names
-        (evd',[])
+        (fun id (evd, l) ->
+          let evd, c =
+            Evd.fresh_global (Global.env ()) evd
+              (Constrintern.locate_reference (Libnames.qualid_of_ident id))
+          in
+          let cst, u = EConstr.destConst evd c in
+          (evd, (cst, EConstr.EInstance.kind evd u) :: l))
+        fix_names (evd', [])
     in
     (*
        Then we check that the graphs have been defined
        If one of the graphs haven't been defined
        we do nothing
     *)
-    List.iter (fun c -> ignore (find_Function_infos (fst c))) fix_names_as_constant ;
+    List.iter
+      (fun c -> ignore (find_Function_infos (fst c)))
+      fix_names_as_constant;
     try
       let _evd', lind =
         List.fold_right
-          (fun id (evd,l) ->
-             let evd,id =
-               Evd.fresh_global
-                 (Global.env ()) evd
-                 (Constrintern.locate_reference (Libnames.qualid_of_ident (mk_rel_id id)))
-             in
-             evd,(fst (EConstr.destInd evd id))::l
-          )
-          fix_names
-          (evd',[])
+          (fun id (evd, l) ->
+            let evd, id =
+              Evd.fresh_global (Global.env ()) evd
+                (Constrintern.locate_reference
+                   (Libnames.qualid_of_ident (mk_rel_id id)))
+            in
+            (evd, fst (EConstr.destInd evd id) :: l))
+          fix_names (evd', [])
       in
-      derive_correctness
-        fix_names_as_constant
-        lind;
-    with e when CErrors.noncritical e ->
-      warn_funind_cannot_build_inversion e
-  with e when CErrors.noncritical e ->
-    warn_funind_cannot_build_inversion e
-
-let register_wf interactive_proof ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas args ret_type body
-    pre_hook
-  =
+      derive_correctness fix_names_as_constant lind
+    with e when CErrors.noncritical e -> warn_funind_cannot_build_inversion e
+  with e when CErrors.noncritical e -> warn_funind_cannot_build_inversion e
+
+let register_wf interactive_proof ?(is_mes = false) fname rec_impls wf_rel_expr
+    wf_arg using_lemmas args ret_type body pre_hook =
   let type_of_f = Constrexpr_ops.mkCProdN args ret_type in
   let rec_arg_num =
     let names =
@@ -1513,226 +1697,233 @@ let register_wf interactive_proof ?(is_mes=false) fname rec_impls wf_rel_expr wf
   in
   let unbounded_eq =
     let f_app_args =
-      CAst.make @@ Constrexpr.CAppExpl(
-        (None, Libnames.qualid_of_ident fname,None) ,
-        (List.map
-           (function
-             | {CAst.v=Anonymous} -> assert false
-             | {CAst.v=Name e} -> (Constrexpr_ops.mkIdentC e)
-           )
-           (Constrexpr_ops.names_of_local_assums args)
-        )
-      )
+      CAst.make
+      @@ Constrexpr.CAppExpl
+           ( (None, Libnames.qualid_of_ident fname, None)
+           , List.map
+               (function
+                 | {CAst.v = Anonymous} -> assert false
+                 | {CAst.v = Name e} -> Constrexpr_ops.mkIdentC e)
+               (Constrexpr_ops.names_of_local_assums args) )
     in
-    CAst.make @@ Constrexpr.CApp ((None,Constrexpr_ops.mkRefC (Libnames.qualid_of_string "Logic.eq")),
-                                  [(f_app_args,None);(body,None)])
+    CAst.make
+    @@ Constrexpr.CApp
+         ( (None, Constrexpr_ops.mkRefC (Libnames.qualid_of_string "Logic.eq"))
+         , [(f_app_args, None); (body, None)] )
   in
   let eq = Constrexpr_ops.mkCProdN args unbounded_eq in
-  let hook ((f_ref,_) as fconst) tcc_lemma_ref (functional_ref,_) (eq_ref,_) rec_arg_num rec_arg_type
-      _nb_args relation =
+  let hook ((f_ref, _) as fconst) tcc_lemma_ref (functional_ref, _) (eq_ref, _)
+      rec_arg_num rec_arg_type _nb_args relation =
     try
       pre_hook [fconst]
-        (generate_correction_proof_wf f_ref tcc_lemma_ref is_mes
-           functional_ref eq_ref rec_arg_num rec_arg_type relation
-        );
+        (generate_correction_proof_wf f_ref tcc_lemma_ref is_mes functional_ref
+           eq_ref rec_arg_num rec_arg_type relation);
       derive_inversion [fname]
-    with e when CErrors.noncritical e ->
-      (* No proof done *)
-      ()
+    with e when CErrors.noncritical e -> (* No proof done *)
+                                         ()
   in
-  Recdef.recursive_definition ~interactive_proof
-    ~is_mes fname rec_impls
-    type_of_f
-    wf_rel_expr
-    rec_arg_num
-    eq
-    hook
-    using_lemmas
-
-let register_mes interactive_proof fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas args ret_type body =
-  let wf_arg_type,wf_arg =
+  Recdef.recursive_definition ~interactive_proof ~is_mes fname rec_impls
+    type_of_f wf_rel_expr rec_arg_num eq hook using_lemmas
+
+let register_mes interactive_proof fname rec_impls wf_mes_expr wf_rel_expr_opt
+    wf_arg using_lemmas args ret_type body =
+  let wf_arg_type, wf_arg =
     match wf_arg with
-    | None ->
-      begin
-        match args with
-        | [Constrexpr.CLocalAssum ([{CAst.v=Name x}],_k,t)] -> t,x
-        | _ -> CErrors.user_err (Pp.str "Recursive argument must be specified")
-      end
-    | Some wf_args ->
+    | None -> (
+      match args with
+      | [Constrexpr.CLocalAssum ([{CAst.v = Name x}], _k, t)] -> (t, x)
+      | _ -> CErrors.user_err (Pp.str "Recursive argument must be specified") )
+    | Some wf_args -> (
       try
         match
           List.find
             (function
-              | Constrexpr.CLocalAssum(l,_k,t) ->
+              | Constrexpr.CLocalAssum (l, _k, t) ->
                 List.exists
-                  (function {CAst.v=Name id} -> Id.equal id wf_args | _ -> false)
+                  (function
+                    | {CAst.v = Name id} -> Id.equal id wf_args | _ -> false)
                   l
-              | _ -> false
-            )
+              | _ -> false)
             args
         with
-        | Constrexpr.CLocalAssum(_,_k,t)  ->           t,wf_args
+        | Constrexpr.CLocalAssum (_, _k, t) -> (t, wf_args)
         | _ -> assert false
-      with Not_found -> assert false
+      with Not_found -> assert false )
   in
-  let wf_rel_from_mes,is_mes =
+  let wf_rel_from_mes, is_mes =
     match wf_rel_expr_opt with
     | None ->
       let ltof =
         let make_dir l = DirPath.make (List.rev_map Id.of_string l) in
         Libnames.qualid_of_path
-          (Libnames.make_path (make_dir ["Arith";"Wf_nat"]) (Id.of_string "ltof"))
+          (Libnames.make_path
+             (make_dir ["Arith"; "Wf_nat"])
+             (Id.of_string "ltof"))
       in
       let fun_from_mes =
         let applied_mes =
-          Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC wf_arg])    in
-        Constrexpr_ops.mkLambdaC ([CAst.make @@ Name wf_arg],Constrexpr_ops.default_binder_kind,wf_arg_type,applied_mes)
+          Constrexpr_ops.mkAppC (wf_mes_expr, [Constrexpr_ops.mkIdentC wf_arg])
+        in
+        Constrexpr_ops.mkLambdaC
+          ( [CAst.make @@ Name wf_arg]
+          , Constrexpr_ops.default_binder_kind
+          , wf_arg_type
+          , applied_mes )
       in
       let wf_rel_from_mes =
-        Constrexpr_ops.mkAppC(Constrexpr_ops.mkRefC  ltof,[wf_arg_type;fun_from_mes])
+        Constrexpr_ops.mkAppC
+          (Constrexpr_ops.mkRefC ltof, [wf_arg_type; fun_from_mes])
       in
-      wf_rel_from_mes,true
+      (wf_rel_from_mes, true)
     | Some wf_rel_expr ->
       let wf_rel_with_mes =
         let a = Names.Id.of_string "___a" in
         let b = Names.Id.of_string "___b" in
-        Constrexpr_ops.mkLambdaC(
-          [CAst.make @@ Name a; CAst.make @@ Name b],
-          Constrexpr.Default Glob_term.Explicit,
-          wf_arg_type,
-          Constrexpr_ops.mkAppC(wf_rel_expr,
-                                [
-                                  Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC a]);
-                                  Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC b])
-                                ])
-        )
+        Constrexpr_ops.mkLambdaC
+          ( [CAst.make @@ Name a; CAst.make @@ Name b]
+          , Constrexpr.Default Glob_term.Explicit
+          , wf_arg_type
+          , Constrexpr_ops.mkAppC
+              ( wf_rel_expr
+              , [ Constrexpr_ops.mkAppC
+                    (wf_mes_expr, [Constrexpr_ops.mkIdentC a])
+                ; Constrexpr_ops.mkAppC
+                    (wf_mes_expr, [Constrexpr_ops.mkIdentC b]) ] ) )
       in
-      wf_rel_with_mes,false
+      (wf_rel_with_mes, false)
   in
-  register_wf interactive_proof ~is_mes:is_mes fname rec_impls wf_rel_from_mes wf_arg
+  register_wf interactive_proof ~is_mes fname rec_impls wf_rel_from_mes wf_arg
     using_lemmas args ret_type body
 
-let do_generate_principle_aux pconstants on_error register_built interactive_proof fixpoint_exprl : Lemmas.t option =
-  List.iter (fun { Vernacexpr.notations } ->
-      if not (List.is_empty notations)
-      then CErrors.user_err (Pp.str "Function does not support notations for now")) fixpoint_exprl;
+let do_generate_principle_aux pconstants on_error register_built
+    interactive_proof fixpoint_exprl : Lemmas.t option =
+  List.iter
+    (fun {Vernacexpr.notations} ->
+      if not (List.is_empty notations) then
+        CErrors.user_err (Pp.str "Function does not support notations for now"))
+    fixpoint_exprl;
   let lemma, _is_struct =
     match fixpoint_exprl with
-    | [{ Vernacexpr.rec_order = Some {CAst.v = Constrexpr.CWfRec (wf_x,wf_rel)} } as fixpoint_expr] ->
-      let { Vernacexpr.fname; univs = _; binders; rtype; body_def } as fixpoint_expr =
+    | [ ( { Vernacexpr.rec_order =
+              Some {CAst.v = Constrexpr.CWfRec (wf_x, wf_rel)} } as
+        fixpoint_expr ) ] ->
+      let ( {Vernacexpr.fname; univs = _; binders; rtype; body_def} as
+          fixpoint_expr ) =
         match recompute_binder_list [fixpoint_expr] with
         | [e] -> e
         | _ -> assert false
       in
       let fixpoint_exprl = [fixpoint_expr] in
-      let body = match body_def with | Some body -> body | None ->
-        CErrors.user_err ~hdr:"Function" (Pp.str "Body of Function must be given") in
-      let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
+      let body =
+        match body_def with
+        | Some body -> body
+        | None ->
+          CErrors.user_err ~hdr:"Function"
+            (Pp.str "Body of Function must be given")
+      in
+      let recdefs, rec_impls = build_newrecursive fixpoint_exprl in
       let using_lemmas = [] in
       let pre_hook pconstants =
         generate_principle
           (ref (Evd.from_env (Global.env ())))
-          pconstants
-          on_error
-          true
-          register_built
-          fixpoint_exprl
-          recdefs
+          pconstants on_error true register_built fixpoint_exprl recdefs
       in
-      if register_built
-      then register_wf interactive_proof fname.CAst.v rec_impls wf_rel wf_x.CAst.v using_lemmas binders rtype body pre_hook, false
-      else None, false
-    | [{ Vernacexpr.rec_order = Some {CAst.v = Constrexpr.CMeasureRec(wf_x,wf_mes,wf_rel_opt)} } as fixpoint_expr] ->
-      let { Vernacexpr.fname; univs = _; binders; rtype; body_def} as fixpoint_expr =
+      if register_built then
+        ( register_wf interactive_proof fname.CAst.v rec_impls wf_rel
+            wf_x.CAst.v using_lemmas binders rtype body pre_hook
+        , false )
+      else (None, false)
+    | [ ( { Vernacexpr.rec_order =
+              Some {CAst.v = Constrexpr.CMeasureRec (wf_x, wf_mes, wf_rel_opt)}
+          } as fixpoint_expr ) ] ->
+      let ( {Vernacexpr.fname; univs = _; binders; rtype; body_def} as
+          fixpoint_expr ) =
         match recompute_binder_list [fixpoint_expr] with
         | [e] -> e
         | _ -> assert false
       in
       let fixpoint_exprl = [fixpoint_expr] in
-      let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
+      let recdefs, rec_impls = build_newrecursive fixpoint_exprl in
       let using_lemmas = [] in
-      let body = match body_def with
+      let body =
+        match body_def with
         | Some body -> body
         | None ->
-          CErrors.user_err ~hdr:"Function" Pp.(str "Body of Function must be given") in
+          CErrors.user_err ~hdr:"Function"
+            Pp.(str "Body of Function must be given")
+      in
       let pre_hook pconstants =
         generate_principle
           (ref (Evd.from_env (Global.env ())))
-          pconstants
-          on_error
-          true
-          register_built
-          fixpoint_exprl
-          recdefs
+          pconstants on_error true register_built fixpoint_exprl recdefs
       in
-      if register_built
-      then register_mes interactive_proof fname.CAst.v rec_impls wf_mes wf_rel_opt
-          (Option.map (fun x -> x.CAst.v) wf_x) using_lemmas binders rtype body pre_hook, true
-      else None, true
+      if register_built then
+        ( register_mes interactive_proof fname.CAst.v rec_impls wf_mes wf_rel_opt
+            (Option.map (fun x -> x.CAst.v) wf_x)
+            using_lemmas binders rtype body pre_hook
+        , true )
+      else (None, true)
     | _ ->
-      List.iter (function { Vernacexpr.rec_order } ->
-        match rec_order with
-        | Some { CAst.v = (Constrexpr.CMeasureRec _ | Constrexpr.CWfRec _) } ->
-          CErrors.user_err
-            (Pp.str "Cannot use mutual definition with well-founded recursion or measure")
-        | _ -> ()
-        )
+      List.iter
+        (function
+          | {Vernacexpr.rec_order} -> (
+            match rec_order with
+            | Some {CAst.v = Constrexpr.CMeasureRec _ | Constrexpr.CWfRec _} ->
+              CErrors.user_err
+                (Pp.str
+                   "Cannot use mutual definition with well-founded recursion \
+                    or measure")
+            | _ -> () ))
         fixpoint_exprl;
       let fixpoint_exprl = recompute_binder_list fixpoint_exprl in
-      let fix_names = List.map (function { Vernacexpr.fname } -> fname.CAst.v) fixpoint_exprl in
+      let fix_names =
+        List.map (function {Vernacexpr.fname} -> fname.CAst.v) fixpoint_exprl
+      in
       (* ok all the expressions are structural *)
       let recdefs, _rec_impls = build_newrecursive fixpoint_exprl in
       let is_rec = List.exists (is_rec fix_names) recdefs in
-      let lemma,evd,pconstants =
-        if register_built
-        then register_struct is_rec fixpoint_exprl
-        else None, Evd.from_env (Global.env ()), pconstants
+      let lemma, evd, pconstants =
+        if register_built then register_struct is_rec fixpoint_exprl
+        else (None, Evd.from_env (Global.env ()), pconstants)
       in
       let evd = ref evd in
-      generate_principle
-        (ref !evd)
-        pconstants
-        on_error
-        false
-        register_built
-        fixpoint_exprl
-        recdefs
-        (Functional_principles_proofs.prove_princ_for_struct evd interactive_proof);
-      if register_built then
-        begin derive_inversion fix_names; end;
-      lemma, true
+      generate_principle (ref !evd) pconstants on_error false register_built
+        fixpoint_exprl recdefs
+        (Functional_principles_proofs.prove_princ_for_struct evd
+           interactive_proof);
+      if register_built then derive_inversion fix_names;
+      (lemma, true)
   in
   lemma
 
 let warn_cannot_define_graph =
   CWarnings.create ~name:"funind-cannot-define-graph" ~category:"funind"
-    (fun (names,error) ->
-       Pp.(strbrk "Cannot define graph(s) for " ++
-           h 1 names ++ error))
+    (fun (names, error) ->
+      Pp.(strbrk "Cannot define graph(s) for " ++ h 1 names ++ error))
 
 let warn_cannot_define_principle =
   CWarnings.create ~name:"funind-cannot-define-principle" ~category:"funind"
-    (fun (names,error) ->
-       Pp.(strbrk "Cannot define induction principle(s) for "++
-           h 1 names ++ error))
+    (fun (names, error) ->
+      Pp.(
+        strbrk "Cannot define induction principle(s) for " ++ h 1 names ++ error))
 
 let warning_error names e =
   let e_explain e =
     match e with
-    | ToShow e ->
-      Pp.(spc () ++ CErrors.print e)
-    | _ ->
-      if do_observe ()
-      then Pp.(spc () ++ CErrors.print e)
-      else Pp.mt ()
+    | ToShow e -> Pp.(spc () ++ CErrors.print e)
+    | _ -> if do_observe () then Pp.(spc () ++ CErrors.print e) else Pp.mt ()
   in
   match e with
   | Building_graph e ->
-    let names = Pp.(prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) in
-    warn_cannot_define_graph (names,e_explain e)
+    let names =
+      Pp.(prlist_with_sep (fun _ -> str "," ++ spc ()) Ppconstr.pr_id names)
+    in
+    warn_cannot_define_graph (names, e_explain e)
   | Defining_principle e ->
-    let names = Pp.(prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) in
-    warn_cannot_define_principle (names,e_explain e)
+    let names =
+      Pp.(prlist_with_sep (fun _ -> str "," ++ spc ()) Ppconstr.pr_id names)
+    in
+    warn_cannot_define_principle (names, e_explain e)
   | _ -> raise e
 
 let error_error names e =
@@ -1744,9 +1935,11 @@ let error_error names e =
   match e with
   | Building_graph e ->
     CErrors.user_err
-      Pp.(str "Cannot define graph(s) for " ++
-          h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
-          e_explain e)
+      Pp.(
+        str "Cannot define graph(s) for "
+        ++ h 1
+             (prlist_with_sep (fun _ -> str "," ++ spc ()) Ppconstr.pr_id names)
+        ++ e_explain e)
   | _ -> raise e
 
 (* [chop_n_arrow n t] chops the [n] first arrows in [t]
@@ -1755,272 +1948,307 @@ let error_error names e =
 let rec chop_n_arrow n t =
   let exception Stop of Constrexpr.constr_expr in
   let open Constrexpr in
-  if n <= 0
-  then t (* If we have already removed all the arrows then return the type *)
-  else (* If not we check the form of [t] *)
+  if n <= 0 then t
+    (* If we have already removed all the arrows then return the type *)
+  else
+    (* If not we check the form of [t] *)
     match t.CAst.v with
-    | Constrexpr.CProdN(nal_ta',t') -> (* If we have a forall, two results are possible :
-                                           either we need to discard more than the number of arrows contained
-                                           in this product declaration then we just recall [chop_n_arrow] on
-                                           the remaining number of arrow to chop and [t'] we discard it and
-                                           recall [chop_n_arrow], either this product contains more arrows
-                                           than the number we need to chop and then we return the new type
-                                       *)
-      begin
-        try
-          let new_n =
-            let rec aux (n:int) = function
-                [] -> n
-              | CLocalAssum(nal,k,t'')::nal_ta' ->
-                let nal_l = List.length nal in
-                if n >= nal_l
-                then
-                  aux (n - nal_l) nal_ta'
-                else
-                  let new_t' = CAst.make @@
-                    Constrexpr.CProdN(
-                      CLocalAssum((snd (List.chop n nal)),k,t'')::nal_ta',t')
-                  in
-                  raise (Stop new_t')
-              | _ -> CErrors.anomaly (Pp.str "Not enough products.")
-            in
-            aux n nal_ta'
+    | Constrexpr.CProdN (nal_ta', t') -> (
+      try
+        (* If we have a forall, two results are possible :
+            either we need to discard more than the number of arrows contained
+            in this product declaration then we just recall [chop_n_arrow] on
+            the remaining number of arrow to chop and [t'] we discard it and
+            recall [chop_n_arrow], either this product contains more arrows
+            than the number we need to chop and then we return the new type
+        *)
+        let new_n =
+          let rec aux (n : int) = function
+            | [] -> n
+            | CLocalAssum (nal, k, t'') :: nal_ta' ->
+              let nal_l = List.length nal in
+              if n >= nal_l then aux (n - nal_l) nal_ta'
+              else
+                let new_t' =
+                  CAst.make
+                  @@ Constrexpr.CProdN
+                       ( CLocalAssum (snd (List.chop n nal), k, t'') :: nal_ta'
+                       , t' )
+                in
+                raise (Stop new_t')
+            | _ -> CErrors.anomaly (Pp.str "Not enough products.")
           in
-          chop_n_arrow new_n t'
-        with Stop t -> t
-      end
+          aux n nal_ta'
+        in
+        chop_n_arrow new_n t'
+      with Stop t -> t )
     | _ -> CErrors.anomaly (Pp.str "Not enough products.")
 
 let rec add_args id new_args =
   let open Libnames in
   let open Constrexpr in
   CAst.map (function
-      | CRef (qid,_) as b ->
-        if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
-          CAppExpl((None,qid,None),new_args)
-        else b
-      | CFix  _  | CCoFix _ ->
-        CErrors.anomaly ~label:"add_args " (Pp.str "todo.")
-      | CProdN(nal,b1) ->
-        CProdN(List.map (function  CLocalAssum (nal,k,b2) -> CLocalAssum (nal,k,add_args id new_args b2)
-                                 | CLocalDef (na,b1,t) -> CLocalDef (na,add_args id new_args b1,Option.map (add_args id new_args) t)
-                                 | CLocalPattern _ ->
-                                   CErrors.user_err (Pp.str "pattern with quote not allowed here.")) nal,
-               add_args id new_args  b1)
-      | CLambdaN(nal,b1) ->
-        CLambdaN(List.map (function  CLocalAssum (nal,k,b2) -> CLocalAssum (nal,k,add_args id new_args b2)
-                                   | CLocalDef (na,b1,t) -> CLocalDef (na,add_args id new_args b1,Option.map (add_args id new_args) t)
-                                   | CLocalPattern _ ->
-                                     CErrors.user_err (Pp.str "pattern with quote not allowed here.")) nal,
-                 add_args id new_args  b1)
-      | CLetIn(na,b1,t,b2) ->
-        CLetIn(na,add_args id new_args b1,Option.map (add_args id new_args) t,add_args id new_args b2)
-      | CAppExpl((pf,qid,us),exprl) ->
-        if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
-          CAppExpl((pf,qid,us),new_args@(List.map (add_args id new_args) exprl))
-        else CAppExpl((pf,qid,us),List.map (add_args id new_args) exprl)
-      | CApp((pf,b),bl) ->
-        CApp((pf,add_args id new_args b),
-             List.map (fun (e,o) -> add_args id new_args e,o) bl)
-      | CCases(sty,b_option,cel,cal) ->
-        CCases(sty,Option.map (add_args id new_args) b_option,
-               List.map (fun (b,na,b_option) ->
-                   add_args id new_args b,
-                   na, b_option) cel,
-               List.map CAst.(map (fun (cpl,e) -> (cpl,add_args id new_args e))) cal
-              )
-      | CLetTuple(nal,(na,b_option),b1,b2) ->
-        CLetTuple(nal,(na,Option.map (add_args id new_args) b_option),
-                  add_args id new_args b1,
-                  add_args id new_args b2
-                 )
-
-      | CIf(b1,(na,b_option),b2,b3) ->
-        CIf(add_args id new_args b1,
-            (na,Option.map (add_args id new_args) b_option),
-            add_args id new_args b2,
-            add_args id new_args b3
-           )
-      | CHole _
-      | CPatVar _
-      | CEvar _
-      | CPrim _
-      | CSort _ as b -> b
-      | CCast(b1,b2)  ->
-        CCast(add_args id new_args b1,
-              Glob_ops.map_cast_type (add_args id new_args) b2)
-      | CRecord pars ->
-        CRecord (List.map (fun (e,o) -> e, add_args id new_args o) pars)
-      | CNotation _ ->
-        CErrors.anomaly ~label:"add_args " (Pp.str "CNotation.")
-      | CGeneralization _ ->
-        CErrors.anomaly ~label:"add_args " (Pp.str "CGeneralization.")
-      | CDelimiters _ ->
-        CErrors.anomaly ~label:"add_args " (Pp.str "CDelimiters.")
-    )
-
-let rec get_args b t : Constrexpr.local_binder_expr list * Constrexpr.constr_expr * Constrexpr.constr_expr =
+    | CRef (qid, _) as b ->
+      if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
+        CAppExpl ((None, qid, None), new_args)
+      else b
+    | CFix _ | CCoFix _ -> CErrors.anomaly ~label:"add_args " (Pp.str "todo.")
+    | CProdN (nal, b1) ->
+      CProdN
+        ( List.map
+            (function
+              | CLocalAssum (nal, k, b2) ->
+                CLocalAssum (nal, k, add_args id new_args b2)
+              | CLocalDef (na, b1, t) ->
+                CLocalDef
+                  ( na
+                  , add_args id new_args b1
+                  , Option.map (add_args id new_args) t )
+              | CLocalPattern _ ->
+                CErrors.user_err (Pp.str "pattern with quote not allowed here."))
+            nal
+        , add_args id new_args b1 )
+    | CLambdaN (nal, b1) ->
+      CLambdaN
+        ( List.map
+            (function
+              | CLocalAssum (nal, k, b2) ->
+                CLocalAssum (nal, k, add_args id new_args b2)
+              | CLocalDef (na, b1, t) ->
+                CLocalDef
+                  ( na
+                  , add_args id new_args b1
+                  , Option.map (add_args id new_args) t )
+              | CLocalPattern _ ->
+                CErrors.user_err (Pp.str "pattern with quote not allowed here."))
+            nal
+        , add_args id new_args b1 )
+    | CLetIn (na, b1, t, b2) ->
+      CLetIn
+        ( na
+        , add_args id new_args b1
+        , Option.map (add_args id new_args) t
+        , add_args id new_args b2 )
+    | CAppExpl ((pf, qid, us), exprl) ->
+      if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
+        CAppExpl
+          ((pf, qid, us), new_args @ List.map (add_args id new_args) exprl)
+      else CAppExpl ((pf, qid, us), List.map (add_args id new_args) exprl)
+    | CApp ((pf, b), bl) ->
+      CApp
+        ( (pf, add_args id new_args b)
+        , List.map (fun (e, o) -> (add_args id new_args e, o)) bl )
+    | CCases (sty, b_option, cel, cal) ->
+      CCases
+        ( sty
+        , Option.map (add_args id new_args) b_option
+        , List.map
+            (fun (b, na, b_option) -> (add_args id new_args b, na, b_option))
+            cel
+        , List.map
+            CAst.(map (fun (cpl, e) -> (cpl, add_args id new_args e)))
+            cal )
+    | CLetTuple (nal, (na, b_option), b1, b2) ->
+      CLetTuple
+        ( nal
+        , (na, Option.map (add_args id new_args) b_option)
+        , add_args id new_args b1
+        , add_args id new_args b2 )
+    | CIf (b1, (na, b_option), b2, b3) ->
+      CIf
+        ( add_args id new_args b1
+        , (na, Option.map (add_args id new_args) b_option)
+        , add_args id new_args b2
+        , add_args id new_args b3 )
+    | (CHole _ | CPatVar _ | CEvar _ | CPrim _ | CSort _) as b -> b
+    | CCast (b1, b2) ->
+      CCast
+        ( add_args id new_args b1
+        , Glob_ops.map_cast_type (add_args id new_args) b2 )
+    | CRecord pars ->
+      CRecord (List.map (fun (e, o) -> (e, add_args id new_args o)) pars)
+    | CNotation _ -> CErrors.anomaly ~label:"add_args " (Pp.str "CNotation.")
+    | CGeneralization _ ->
+      CErrors.anomaly ~label:"add_args " (Pp.str "CGeneralization.")
+    | CDelimiters _ ->
+      CErrors.anomaly ~label:"add_args " (Pp.str "CDelimiters."))
+
+let rec get_args b t :
+    Constrexpr.local_binder_expr list
+    * Constrexpr.constr_expr
+    * Constrexpr.constr_expr =
   let open Constrexpr in
   match b.CAst.v with
-  | Constrexpr.CLambdaN (CLocalAssum(nal,k,ta) as d::rest, b') ->
-    begin
-      let n = List.length nal in
-      let nal_tas,b'',t'' = get_args (CAst.make ?loc:b.CAst.loc @@ Constrexpr.CLambdaN (rest,b')) (chop_n_arrow n t) in
-      d :: nal_tas, b'',t''
-    end
-  | Constrexpr.CLambdaN ([], b) -> [],b,t
-  | _ -> [],b,t
+  | Constrexpr.CLambdaN ((CLocalAssum (nal, k, ta) as d) :: rest, b') ->
+    let n = List.length nal in
+    let nal_tas, b'', t'' =
+      get_args
+        (CAst.make ?loc:b.CAst.loc @@ Constrexpr.CLambdaN (rest, b'))
+        (chop_n_arrow n t)
+    in
+    (d :: nal_tas, b'', t'')
+  | Constrexpr.CLambdaN ([], b) -> ([], b, t)
+  | _ -> ([], b, t)
 
 let make_graph (f_ref : GlobRef.t) =
   let open Constrexpr in
-  let env = Global.env() in
+  let env = Global.env () in
   let sigma = Evd.from_env env in
-  let c,c_body =
+  let c, c_body =
     match f_ref with
-    | GlobRef.ConstRef c ->
-      begin
-        try c,Global.lookup_constant c
-        with Not_found ->
-          CErrors.user_err Pp.(str "Cannot find " ++ Printer.pr_leconstr_env env sigma (EConstr.mkConst c))
-      end
-    | _ ->
-      CErrors.user_err Pp.(str "Not a function reference")
+    | GlobRef.ConstRef c -> (
+      try (c, Global.lookup_constant c)
+      with Not_found ->
+        CErrors.user_err
+          Pp.(
+            str "Cannot find "
+            ++ Printer.pr_leconstr_env env sigma (EConstr.mkConst c)) )
+    | _ -> CErrors.user_err Pp.(str "Not a function reference")
   in
-  (match Global.body_of_constant_body Library.indirect_accessor c_body with
-   | None ->
-     CErrors.user_err (Pp.str "Cannot build a graph over an axiom!")
-   | Some (body, _, _) ->
-     let env = Global.env () in
-     let extern_body,extern_type =
-       with_full_print (fun () ->
-           (Constrextern.extern_constr env sigma (EConstr.of_constr body),
-            Constrextern.extern_type env sigma
-              (EConstr.of_constr (*FIXME*) c_body.Declarations.const_type)
-           )
-         )
-         ()
-     in
-     let (nal_tas,b,t)  = get_args extern_body extern_type in
-     let expr_list =
-       match b.CAst.v with
-       | Constrexpr.CFix(l_id,fixexprl) ->
-         let l =
-           List.map
-             (fun (id,recexp,bl,t,b) ->
-                let { CAst.loc; v=rec_id } = match Option.get recexp with
-                  | { CAst.v = CStructRec id } -> id
-                  | { CAst.v = CWfRec (id,_) } -> id
-                  | { CAst.v = CMeasureRec (oid,_,_) } -> Option.get oid
-                in
-                let new_args =
-                  List.flatten
-                    (List.map
-                       (function
-                         | Constrexpr.CLocalDef (na,_,_)-> []
-                         | Constrexpr.CLocalAssum (nal,_,_) ->
-                           List.map
-                             (fun {CAst.loc;v=n} -> CAst.make ?loc @@
-                               CRef(Libnames.qualid_of_ident ?loc @@ Nameops.Name.get_id n,None))
-                             nal
-                         | Constrexpr.CLocalPattern _ -> assert false
-                       )
-                       nal_tas
-                    )
-                in
-                let b' = add_args id.CAst.v new_args b in
-                { Vernacexpr.fname=id; univs=None
-                ; rec_order = Some (CAst.make (CStructRec (CAst.make rec_id)))
-                ; binders = nal_tas@bl; rtype=t; body_def=Some b'; notations = []}
-             )
-             fixexprl
-         in
-         l
-       | _ ->
-         let fname = CAst.make (Label.to_id (Constant.label c)) in
-         [{ Vernacexpr.fname; univs=None; rec_order = None; binders=nal_tas; rtype=t; body_def=Some b; notations=[]}]
-     in
-     let mp = Constant.modpath c in
-     let pstate = do_generate_principle_aux [c,Univ.Instance.empty] error_error  false false expr_list in
-     assert (Option.is_empty pstate);
-     (* We register the infos *)
-     List.iter
-       (fun { Vernacexpr.fname= {CAst.v=id} } ->
-          add_Function false (Constant.make2 mp (Label.of_id id)))
-       expr_list)
+  match Global.body_of_constant_body Library.indirect_accessor c_body with
+  | None -> CErrors.user_err (Pp.str "Cannot build a graph over an axiom!")
+  | Some (body, _, _) ->
+    let env = Global.env () in
+    let extern_body, extern_type =
+      with_full_print
+        (fun () ->
+          ( Constrextern.extern_constr env sigma (EConstr.of_constr body)
+          , Constrextern.extern_type env sigma
+              (EConstr.of_constr (*FIXME*) c_body.Declarations.const_type) ))
+        ()
+    in
+    let nal_tas, b, t = get_args extern_body extern_type in
+    let expr_list =
+      match b.CAst.v with
+      | Constrexpr.CFix (l_id, fixexprl) ->
+        let l =
+          List.map
+            (fun (id, recexp, bl, t, b) ->
+              let {CAst.loc; v = rec_id} =
+                match Option.get recexp with
+                | {CAst.v = CStructRec id} -> id
+                | {CAst.v = CWfRec (id, _)} -> id
+                | {CAst.v = CMeasureRec (oid, _, _)} -> Option.get oid
+              in
+              let new_args =
+                List.flatten
+                  (List.map
+                     (function
+                       | Constrexpr.CLocalDef (na, _, _) -> []
+                       | Constrexpr.CLocalAssum (nal, _, _) ->
+                         List.map
+                           (fun {CAst.loc; v = n} ->
+                             CAst.make ?loc
+                             @@ CRef
+                                  ( Libnames.qualid_of_ident ?loc
+                                    @@ Nameops.Name.get_id n
+                                  , None ))
+                           nal
+                       | Constrexpr.CLocalPattern _ -> assert false)
+                     nal_tas)
+              in
+              let b' = add_args id.CAst.v new_args b in
+              { Vernacexpr.fname = id
+              ; univs = None
+              ; rec_order = Some (CAst.make (CStructRec (CAst.make rec_id)))
+              ; binders = nal_tas @ bl
+              ; rtype = t
+              ; body_def = Some b'
+              ; notations = [] })
+            fixexprl
+        in
+        l
+      | _ ->
+        let fname = CAst.make (Label.to_id (Constant.label c)) in
+        [ { Vernacexpr.fname
+          ; univs = None
+          ; rec_order = None
+          ; binders = nal_tas
+          ; rtype = t
+          ; body_def = Some b
+          ; notations = [] } ]
+    in
+    let mp = Constant.modpath c in
+    let pstate =
+      do_generate_principle_aux [(c, Univ.Instance.empty)] error_error false
+        false expr_list
+    in
+    assert (Option.is_empty pstate);
+    (* We register the infos *)
+    List.iter
+      (fun {Vernacexpr.fname = {CAst.v = id}} ->
+        add_Function false (Constant.make2 mp (Label.of_id id)))
+      expr_list
 
 (* *************** statically typed entrypoints ************************* *)
 
 let do_generate_principle_interactive fixl : Lemmas.t =
-  match
-    do_generate_principle_aux [] warning_error true true fixl
-  with
+  match do_generate_principle_aux [] warning_error true true fixl with
   | Some lemma -> lemma
   | None ->
-    CErrors.anomaly
-      (Pp.str"indfun: leaving no open proof in interactive mode")
+    CErrors.anomaly (Pp.str "indfun: leaving no open proof in interactive mode")
 
 let do_generate_principle fixl : unit =
-  match do_generate_principle_aux [] warning_error true false fixl  with
+  match do_generate_principle_aux [] warning_error true false fixl with
   | Some _lemma ->
     CErrors.anomaly
-      (Pp.str"indfun: leaving a goal open in non-interactive mode")
+      (Pp.str "indfun: leaving a goal open in non-interactive mode")
   | None -> ()
 
-
 let build_scheme fas =
-  let evd = (ref (Evd.from_env (Global.env ()))) in
-  let pconstants = (List.map
-         (fun (_,f,sort) ->
-            let f_as_constant =
-              try
-                Smartlocate.global_with_alias f
-              with Not_found ->
-                CErrors.user_err ~hdr:"FunInd.build_scheme"
-                  Pp.(str "Cannot find " ++ Libnames.pr_qualid f)
-            in
-            let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
-            let _ = evd := evd' in
-            let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd f in
-            evd := sigma;
-            let c, u =
-              try EConstr.destConst !evd f
-              with Constr.DestKO ->
-                CErrors.user_err Pp.(Printer.pr_econstr_env (Global.env ()) !evd f ++spc () ++ str "should be the named of a globally defined function")
-            in
-            (c, EConstr.EInstance.kind !evd u), sort
-         )
-         fas
-                   ) in
+  let evd = ref (Evd.from_env (Global.env ())) in
+  let pconstants =
+    List.map
+      (fun (_, f, sort) ->
+        let f_as_constant =
+          try Smartlocate.global_with_alias f
+          with Not_found ->
+            CErrors.user_err ~hdr:"FunInd.build_scheme"
+              Pp.(str "Cannot find " ++ Libnames.pr_qualid f)
+        in
+        let evd', f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
+        let _ = evd := evd' in
+        let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd f in
+        evd := sigma;
+        let c, u =
+          try EConstr.destConst !evd f
+          with Constr.DestKO ->
+            CErrors.user_err
+              Pp.(
+                Printer.pr_econstr_env (Global.env ()) !evd f
+                ++ spc ()
+                ++ str "should be the named of a globally defined function")
+        in
+        ((c, EConstr.EInstance.kind !evd u), sort))
+      fas
+  in
   let bodies_types = make_scheme evd pconstants in
-
   List.iter2
-    (fun (princ_id,_,_) def_entry ->
-       ignore
-         (Declare.declare_constant
-            ~name:princ_id
-            ~kind:Decls.(IsProof Theorem)
-            (Declare.DefinitionEntry def_entry));
-       Declare.definition_message princ_id
-    )
-    fas
-    bodies_types
+    (fun (princ_id, _, _) def_entry ->
+      ignore
+        (Declare.declare_constant ~name:princ_id
+           ~kind:Decls.(IsProof Theorem)
+           (Declare.DefinitionEntry def_entry));
+      Declare.definition_message princ_id)
+    fas bodies_types
 
 let build_case_scheme fa =
-  let env = Global.env ()
-  and sigma = (Evd.from_env (Global.env ())) in
-(*   let id_to_constr id =  *)
-(*     Constrintern.global_reference  id *)
-(*   in  *)
+  let env = Global.env () and sigma = Evd.from_env (Global.env ()) in
+  (*   let id_to_constr id =  *)
+  (*     Constrintern.global_reference  id *)
+  (*   in  *)
   let funs =
-    let (_,f,_) = fa in
-    try (let open GlobRef in
-         match Smartlocate.global_with_alias f with
-         | ConstRef c -> c
-         | IndRef _ | ConstructRef _ | VarRef _ -> assert false)
+    let _, f, _ = fa in
+    try
+      let open GlobRef in
+      match Smartlocate.global_with_alias f with
+      | ConstRef c -> c
+      | IndRef _ | ConstructRef _ | VarRef _ -> assert false
     with Not_found ->
       CErrors.user_err ~hdr:"FunInd.build_case_scheme"
-        Pp.(str "Cannot find " ++ Libnames.pr_qualid f) in
-  let sigma, (_,u) = Evd.fresh_constant_instance env sigma funs in
+        Pp.(str "Cannot find " ++ Libnames.pr_qualid f)
+  in
+  let sigma, (_, u) = Evd.fresh_constant_instance env sigma funs in
   let first_fun = funs in
   let funs_mp = Constant.modpath first_fun in
   let first_fun_kn =
@@ -2029,39 +2257,39 @@ let build_case_scheme fa =
     | Some finfos -> fst finfos.graph_ind
   in
   let this_block_funs_indexes = get_funs_constant funs_mp first_fun in
-  let this_block_funs = Array.map (fun (c,_) -> (c,u)) this_block_funs_indexes in
+  let this_block_funs =
+    Array.map (fun (c, _) -> (c, u)) this_block_funs_indexes
+  in
   let prop_sort = Sorts.InProp in
   let funs_indexes =
     let this_block_funs_indexes = Array.to_list this_block_funs_indexes in
     List.assoc_f Constant.equal funs this_block_funs_indexes
   in
-  let (ind, sf) =
-         let ind = first_fun_kn,funs_indexes in
-           (ind,Univ.Instance.empty)(*FIXME*),prop_sort
+  let ind, sf =
+    let ind = (first_fun_kn, funs_indexes) in
+    ((ind, Univ.Instance.empty) (*FIXME*), prop_sort)
   in
-  let (sigma, scheme) =
-      Indrec.build_case_analysis_scheme_default env sigma ind sf
+  let sigma, scheme =
+    Indrec.build_case_analysis_scheme_default env sigma ind sf
   in
-  let scheme_type = EConstr.Unsafe.to_constr ((Retyping.get_type_of env sigma) (EConstr.of_constr scheme)) in
-  let sorts =
-    (fun (_,_,x) ->
-       fst @@ UnivGen.fresh_sort_in_family x
-    )
-      fa
+  let scheme_type =
+    EConstr.Unsafe.to_constr
+      ((Retyping.get_type_of env sigma) (EConstr.of_constr scheme))
   in
-  let princ_name =  (fun (x,_,_) -> x) fa in
-  let _ : unit =
-  (*  Pp.msgnl (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++
-               pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs
-            );
-  *)
+  let sorts = (fun (_, _, x) -> fst @@ UnivGen.fresh_sort_in_family x) fa in
+  let princ_name = (fun (x, _, _) -> x) fa in
+  let (_ : unit) =
+    (* Pp.msgnl (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++
+                pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs
+             );
+    *)
     generate_functional_principle
       (ref (Evd.from_env (Global.env ())))
       scheme_type
-      (Some ([|sorts|]))
-      (Some princ_name)
-      this_block_funs
-      0
-      (Functional_principles_proofs.prove_princ_for_struct (ref (Evd.from_env (Global.env ()))) false 0 [|funs|])
+      (Some [|sorts|])
+      (Some princ_name) this_block_funs 0
+      (Functional_principles_proofs.prove_princ_for_struct
+         (ref (Evd.from_env (Global.env ())))
+         false 0 [|funs|])
   in
   ()
diff --git a/plugins/funind/gen_principle.mli b/plugins/funind/gen_principle.mli
index 6313a2b16e..3c04d6cb7d 100644
--- a/plugins/funind/gen_principle.mli
+++ b/plugins/funind/gen_principle.mli
@@ -11,13 +11,14 @@
 val warn_cannot_define_graph : ?loc:Loc.t -> Pp.t * Pp.t -> unit
 val warn_cannot_define_principle : ?loc:Loc.t -> Pp.t * Pp.t -> unit
 
-val do_generate_principle_interactive : Vernacexpr.fixpoint_expr list -> Lemmas.t
-val do_generate_principle : Vernacexpr.fixpoint_expr list -> unit
+val do_generate_principle_interactive :
+  Vernacexpr.fixpoint_expr list -> Lemmas.t
 
+val do_generate_principle : Vernacexpr.fixpoint_expr list -> unit
 val make_graph : Names.GlobRef.t -> unit
 
 (* Can be thrown by build_{,case}_scheme *)
 exception No_graph_found
 
 val build_scheme : (Names.Id.t * Libnames.qualid * Sorts.family) list -> unit
-val build_case_scheme : (Names.Id.t * Libnames.qualid * Sorts.family) -> unit
+val build_case_scheme : Names.Id.t * Libnames.qualid * Sorts.family -> unit
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index e08ad9af3a..11e4fa0ac7 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -10,34 +10,27 @@ open Indfun_common
 open CErrors
 open Util
 open Glob_termops
-
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
 
-let observe strm =
-  if do_observe ()
-  then Feedback.msg_debug strm
-  else ()
+let observe strm = if do_observe () then Feedback.msg_debug strm else ()
+
 (*let observennl strm =
   if do_observe ()
   then Pp.msg strm
   else ()*)
 
-
-type binder_type =
-  | Lambda of Name.t
-  | Prod of Name.t
-  | LetIn of Name.t
-
-type glob_context = (binder_type*glob_constr) list
-
+type binder_type = Lambda of Name.t | Prod of Name.t | LetIn of Name.t
+type glob_context = (binder_type * glob_constr) list
 
 let rec solve_trivial_holes pat_as_term e =
-  match DAst.get pat_as_term, DAst.get e with
-  | GHole _,_ -> e
-  | GApp(fp,argsp),GApp(fe,argse) when glob_constr_eq fp fe ->
-       DAst.make (GApp((solve_trivial_holes fp fe),List.map2 solve_trivial_holes argsp argse))
-  | _,_ -> pat_as_term
+  match (DAst.get pat_as_term, DAst.get e) with
+  | GHole _, _ -> e
+  | GApp (fp, argsp), GApp (fe, argse) when glob_constr_eq fp fe ->
+    DAst.make
+      (GApp
+         (solve_trivial_holes fp fe, List.map2 solve_trivial_holes argsp argse))
+  | _, _ -> pat_as_term
 
 (*
    compose_glob_context [(bt_1,n_1,t_1);......] rt returns
@@ -45,31 +38,26 @@ let rec solve_trivial_holes pat_as_term e =
    binders corresponding to the bt_i's
 *)
 let compose_glob_context =
-  let compose_binder  (bt,t) acc =
+  let compose_binder (bt, t) acc =
     match bt with
-      | Lambda n -> mkGLambda(n,t,acc)
-      | Prod n -> mkGProd(n,t,acc)
-      | LetIn n -> mkGLetIn(n,t,None,acc)
+    | Lambda n -> mkGLambda (n, t, acc)
+    | Prod n -> mkGProd (n, t, acc)
+    | LetIn n -> mkGLetIn (n, t, None, acc)
   in
   List.fold_right compose_binder
 
-
 (*
    The main part deals with building a list of globalized constructor expressions
    from the rhs of a fixpoint equation.
 *)
 
 type 'a build_entry_pre_return =
-    {
-      context : glob_context;  (* the binding context of the result *)
-      value : 'a; (* The value *)
-    }
+  { context : glob_context
+  ; (* the binding context of the result *)
+    value : 'a (* The value *) }
 
 type 'a build_entry_return =
-    {
-      result : 'a build_entry_pre_return list;
-      to_avoid : Id.t list
-    }
+  {result : 'a build_entry_pre_return list; to_avoid : Id.t list}
 
 (*
   [combine_results combine_fun res1 res2] combine two results [res1] and [res2]
@@ -81,64 +69,55 @@ type 'a build_entry_return =
 *)
 
 let combine_results
-    (combine_fun : 'a build_entry_pre_return -> 'b build_entry_pre_return ->
-      'c build_entry_pre_return
-    )
-    (res1: 'a build_entry_return)
-    (res2 : 'b build_entry_return)
-    : 'c build_entry_return
-    =
-  let pre_result =     List.map
-    ( fun res1 ->  (* for each result in arg_res *)
-          List.map (* we add it in each args_res *)
-            (fun res2 ->
-               combine_fun res1 res2
-            )
-            res2.result
-      )
+    (combine_fun :
+         'a build_entry_pre_return
+      -> 'b build_entry_pre_return
+      -> 'c build_entry_pre_return) (res1 : 'a build_entry_return)
+    (res2 : 'b build_entry_return) : 'c build_entry_return =
+  let pre_result =
+    List.map
+      (fun res1 ->
+        (* for each result in arg_res *)
+        List.map (* we add it in each args_res *)
+          (fun res2 -> combine_fun res1 res2)
+          res2.result)
       res1.result
-  in (* and then we flatten the map *)
-  {
-    result = List.concat pre_result;
-    to_avoid = List.union Id.equal res1.to_avoid res2.to_avoid
-  }
-
+  in
+  (* and then we flatten the map *)
+  { result = List.concat pre_result
+  ; to_avoid = List.union Id.equal res1.to_avoid res2.to_avoid }
 
 (*
    The combination function for an argument with a list of argument
 *)
 
 let combine_args arg args =
-  {
-    context = arg.context@args.context;
-    (* Note that the binding context of [arg] MUST be placed before the one of
+  { context = arg.context @ args.context
+  ; (* Note that the binding context of [arg] MUST be placed before the one of
        [args] in order to preserve possible type dependencies
     *)
-    value = arg.value::args.value;
-  }
+    value = arg.value :: args.value }
 
-
-let ids_of_binder =  function
+let ids_of_binder = function
   | LetIn Anonymous | Prod Anonymous | Lambda Anonymous -> Id.Set.empty
-  | LetIn (Name id)  | Prod (Name id) | Lambda (Name id) -> Id.Set.singleton id
+  | LetIn (Name id) | Prod (Name id) | Lambda (Name id) -> Id.Set.singleton id
 
 let rec change_vars_in_binder mapping = function
-    [] -> []
-  | (bt,t)::l ->
-      let new_mapping = Id.Set.fold Id.Map.remove (ids_of_binder bt) mapping in
-      (bt,change_vars mapping t)::
-        (if Id.Map.is_empty new_mapping
-         then l
-         else change_vars_in_binder new_mapping l
-        )
+  | [] -> []
+  | (bt, t) :: l ->
+    let new_mapping = Id.Set.fold Id.Map.remove (ids_of_binder bt) mapping in
+    (bt, change_vars mapping t)
+    ::
+    ( if Id.Map.is_empty new_mapping then l
+    else change_vars_in_binder new_mapping l )
 
 let rec replace_var_by_term_in_binder x_id term = function
   | [] -> []
-  | (bt,t)::l ->
-      (bt,replace_var_by_term x_id term t)::
-        if Id.Set.mem x_id (ids_of_binder bt)
-        then l
-        else replace_var_by_term_in_binder x_id term l
+  | (bt, t) :: l ->
+    (bt, replace_var_by_term x_id term t)
+    ::
+    ( if Id.Set.mem x_id (ids_of_binder bt) then l
+    else replace_var_by_term_in_binder x_id term l )
 
 let add_bt_names bt = Id.Set.union (ids_of_binder bt)
 
@@ -146,128 +125,116 @@ let apply_args ctxt body args =
   let need_convert_id avoid id =
     List.exists (is_free_in id) args || Id.Set.mem id avoid
   in
-  let need_convert avoid  bt =
+  let need_convert avoid bt =
     Id.Set.exists (need_convert_id avoid) (ids_of_binder bt)
   in
-  let next_name_away (na:Name.t) (mapping: Id.t Id.Map.t) (avoid: Id.Set.t) =
+  let next_name_away (na : Name.t) (mapping : Id.t Id.Map.t) (avoid : Id.Set.t)
+      =
     match na with
-       | Name id when Id.Set.mem id avoid ->
-           let new_id = Namegen.next_ident_away id avoid in
-           Name new_id,Id.Map.add id new_id mapping,Id.Set.add new_id avoid
-       | _ -> na,mapping,avoid
+    | Name id when Id.Set.mem id avoid ->
+      let new_id = Namegen.next_ident_away id avoid in
+      (Name new_id, Id.Map.add id new_id mapping, Id.Set.add new_id avoid)
+    | _ -> (na, mapping, avoid)
   in
-  let next_bt_away bt (avoid:Id.Set.t) =
+  let next_bt_away bt (avoid : Id.Set.t) =
     match bt with
-      | LetIn na ->
-          let new_na,mapping,new_avoid = next_name_away na Id.Map.empty avoid  in
-          LetIn new_na,mapping,new_avoid
-      | Prod na ->
-          let new_na,mapping,new_avoid = next_name_away na Id.Map.empty avoid  in
-          Prod new_na,mapping,new_avoid
-      | Lambda na ->
-          let new_na,mapping,new_avoid = next_name_away na Id.Map.empty avoid  in
-          Lambda new_na,mapping,new_avoid
+    | LetIn na ->
+      let new_na, mapping, new_avoid = next_name_away na Id.Map.empty avoid in
+      (LetIn new_na, mapping, new_avoid)
+    | Prod na ->
+      let new_na, mapping, new_avoid = next_name_away na Id.Map.empty avoid in
+      (Prod new_na, mapping, new_avoid)
+    | Lambda na ->
+      let new_na, mapping, new_avoid = next_name_away na Id.Map.empty avoid in
+      (Lambda new_na, mapping, new_avoid)
   in
   let rec do_apply avoid ctxt body args =
-    match ctxt,args with
-      | _,[] -> (* No more args *)
-          (ctxt,body)
-      | [],_ -> (* no more fun *)
-          let f,args' = glob_decompose_app body in
-          (ctxt,mkGApp(f,args'@args))
-      | (Lambda Anonymous,t)::ctxt',arg::args' ->
-          do_apply avoid ctxt' body args'
-      | (Lambda (Name id),t)::ctxt',arg::args' ->
-          let new_avoid,new_ctxt',new_body,new_id =
-            if need_convert_id avoid id
-            then
-              let new_avoid =  Id.Set.add id avoid in
-              let new_id = Namegen.next_ident_away id new_avoid in
-              let new_avoid' = Id.Set.add new_id new_avoid in
-              let mapping = Id.Map.add id new_id Id.Map.empty in
-              let new_ctxt' = change_vars_in_binder mapping ctxt' in
-              let new_body = change_vars mapping body in
-              new_avoid',new_ctxt',new_body,new_id
-            else
-              Id.Set.add id avoid,ctxt',body,id
-          in
-          let new_body = replace_var_by_term new_id arg new_body in
-          let new_ctxt' = replace_var_by_term_in_binder new_id arg new_ctxt' in
-          do_apply avoid new_ctxt' new_body args'
-      | (bt,t)::ctxt',_ ->
-          let new_avoid,new_ctxt',new_body,new_bt =
-            let new_avoid = add_bt_names bt avoid in
-            if need_convert avoid bt
-            then
-              let new_bt,mapping,new_avoid = next_bt_away bt new_avoid in
-              (
-                new_avoid,
-                change_vars_in_binder mapping ctxt',
-                change_vars mapping body,
-                new_bt
-             )
-            else new_avoid,ctxt',body,bt
-          in
-          let new_ctxt',new_body =
-            do_apply new_avoid new_ctxt' new_body args
-          in
-          (new_bt,t)::new_ctxt',new_body
+    match (ctxt, args) with
+    | _, [] ->
+      (* No more args *)
+      (ctxt, body)
+    | [], _ ->
+      (* no more fun *)
+      let f, args' = glob_decompose_app body in
+      (ctxt, mkGApp (f, args' @ args))
+    | (Lambda Anonymous, t) :: ctxt', arg :: args' ->
+      do_apply avoid ctxt' body args'
+    | (Lambda (Name id), t) :: ctxt', arg :: args' ->
+      let new_avoid, new_ctxt', new_body, new_id =
+        if need_convert_id avoid id then
+          let new_avoid = Id.Set.add id avoid in
+          let new_id = Namegen.next_ident_away id new_avoid in
+          let new_avoid' = Id.Set.add new_id new_avoid in
+          let mapping = Id.Map.add id new_id Id.Map.empty in
+          let new_ctxt' = change_vars_in_binder mapping ctxt' in
+          let new_body = change_vars mapping body in
+          (new_avoid', new_ctxt', new_body, new_id)
+        else (Id.Set.add id avoid, ctxt', body, id)
+      in
+      let new_body = replace_var_by_term new_id arg new_body in
+      let new_ctxt' = replace_var_by_term_in_binder new_id arg new_ctxt' in
+      do_apply avoid new_ctxt' new_body args'
+    | (bt, t) :: ctxt', _ ->
+      let new_avoid, new_ctxt', new_body, new_bt =
+        let new_avoid = add_bt_names bt avoid in
+        if need_convert avoid bt then
+          let new_bt, mapping, new_avoid = next_bt_away bt new_avoid in
+          ( new_avoid
+          , change_vars_in_binder mapping ctxt'
+          , change_vars mapping body
+          , new_bt )
+        else (new_avoid, ctxt', body, bt)
+      in
+      let new_ctxt', new_body = do_apply new_avoid new_ctxt' new_body args in
+      ((new_bt, t) :: new_ctxt', new_body)
   in
   do_apply Id.Set.empty ctxt body args
 
-
 let combine_app f args =
-  let new_ctxt,new_value = apply_args f.context f.value args.value in
-  {
-    (* Note that the binding context of [args] MUST be placed before the one of
+  let new_ctxt, new_value = apply_args f.context f.value args.value in
+  { (* Note that the binding context of [args] MUST be placed before the one of
        the applied value in order to preserve possible type dependencies
     *)
-      context = args.context@new_ctxt;
-      value = new_value;
-  }
+    context = args.context @ new_ctxt
+  ; value = new_value }
 
 let combine_lam n t b =
-  {
-    context = [];
-    value = mkGLambda(n, compose_glob_context t.context t.value,
-                      compose_glob_context b.context b.value )
-  }
+  { context = []
+  ; value =
+      mkGLambda
+        ( n
+        , compose_glob_context t.context t.value
+        , compose_glob_context b.context b.value ) }
 
 let combine_prod2 n t b =
-  {
-    context = [];
-    value = mkGProd(n, compose_glob_context t.context t.value,
-                      compose_glob_context b.context b.value )
-  }
+  { context = []
+  ; value =
+      mkGProd
+        ( n
+        , compose_glob_context t.context t.value
+        , compose_glob_context b.context b.value ) }
 
 let combine_prod n t b =
-  { context = t.context@((Prod n,t.value)::b.context); value = b.value}
+  {context = t.context @ ((Prod n, t.value) :: b.context); value = b.value}
 
 let combine_letin n t b =
-  { context = t.context@((LetIn n,t.value)::b.context); value = b.value}
-
+  {context = t.context @ ((LetIn n, t.value) :: b.context); value = b.value}
 
 let mk_result ctxt value avoid =
-  {
-    result =
-      [{context = ctxt;
-        value = value}]
-        ;
-    to_avoid = avoid
-  }
+  {result = [{context = ctxt; value}]; to_avoid = avoid}
+
 (*************************************************
   Some functions to deal with overlapping patterns
 **************************************************)
 
-let coq_True_ref  = lazy (Coqlib.lib_ref "core.True.type")
+let coq_True_ref = lazy (Coqlib.lib_ref "core.True.type")
 let coq_False_ref = lazy (Coqlib.lib_ref "core.False.type")
 
 (*
   [make_discr_match_el \[e1,...en\]] builds match e1,...,en with
   (the list of expressions on which we will do the matching)
  *)
-let make_discr_match_el  =
-  List.map (fun e -> (e,(Anonymous,None)))
+let make_discr_match_el = List.map (fun e -> (e, (Anonymous, None)))
 
 (*
   [make_discr_match_brl i \[pat_1,...,pat_n\]]  constructs a discrimination pattern matching on the ith expression.
@@ -283,23 +250,21 @@ let make_discr_match_el  =
 *)
 let make_discr_match_brl i =
   List.map_i
-    (fun j {CAst.v=(idl,patl,_)} -> CAst.make @@
-       if Int.equal j i
-       then (idl,patl, mkGRef (Lazy.force coq_True_ref))
-       else (idl,patl, mkGRef (Lazy.force coq_False_ref))
-    )
+    (fun j {CAst.v = idl, patl, _} ->
+      CAst.make
+      @@
+      if Int.equal j i then (idl, patl, mkGRef (Lazy.force coq_True_ref))
+      else (idl, patl, mkGRef (Lazy.force coq_False_ref)))
     0
+
 (*
    [make_discr_match brl el i] generates an hypothesis such that it reduce to true iff
    brl_{i} is the first branch matched by [el]
 
    Used when we want to simulate the coq pattern matching algorithm
 *)
-let make_discr_match brl =
-  fun el i ->
-  mkGCases(None,
-           make_discr_match_el el,
-           make_discr_match_brl i brl)
+let make_discr_match brl el i =
+  mkGCases (None, make_discr_match_el el, make_discr_match_brl i brl)
 
 (**********************************************************************)
 (*  functions used to build case expression from lettuple and if ones *)
@@ -307,140 +272,159 @@ let make_discr_match brl =
 
 (* [build_constructors_of_type] construct the array of pattern of its inductive argument*)
 let build_constructors_of_type ind' argl =
-  let (mib,ind) = Inductive.lookup_mind_specif (Global.env()) ind' in
+  let mib, ind = Inductive.lookup_mind_specif (Global.env ()) ind' in
   let npar = mib.Declarations.mind_nparams in
-  Array.mapi (fun i _ ->
-                let construct = ind',i+1 in
-                let constructref = GlobRef.ConstructRef(construct) in
-                let _implicit_positions_of_cst =
-                  Impargs.implicits_of_global constructref
-                in
-                let cst_narg =
-                  Inductiveops.constructor_nallargs
-                    (Global.env ())
-                    construct
-                in
-                let argl =
-                  if List.is_empty argl then
-                    List.make cst_narg (mkGHole ())
-                  else
-                    List.make npar (mkGHole ()) @ argl
-                in
-                let pat_as_term =
-                  mkGApp(mkGRef (GlobRef.ConstructRef(ind',i+1)),argl)
-                in
-                cases_pattern_of_glob_constr (Global.env()) Anonymous pat_as_term
-             )
+  Array.mapi
+    (fun i _ ->
+      let construct = (ind', i + 1) in
+      let constructref = GlobRef.ConstructRef construct in
+      let _implicit_positions_of_cst =
+        Impargs.implicits_of_global constructref
+      in
+      let cst_narg =
+        Inductiveops.constructor_nallargs (Global.env ()) construct
+      in
+      let argl =
+        if List.is_empty argl then List.make cst_narg (mkGHole ())
+        else List.make npar (mkGHole ()) @ argl
+      in
+      let pat_as_term =
+        mkGApp (mkGRef (GlobRef.ConstructRef (ind', i + 1)), argl)
+      in
+      cases_pattern_of_glob_constr (Global.env ()) Anonymous pat_as_term)
     ind.Declarations.mind_consnames
 
 (******************)
 (* Main functions *)
 (******************)
 
-
-
-let raw_push_named (na,raw_value,raw_typ) env =
+let raw_push_named (na, raw_value, raw_typ) env =
   match na with
-    | Anonymous -> env
-    | Name id ->
-      let typ,_ = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in
-      let na = make_annot id Sorts.Relevant in (* TODO relevance *)
-        (match raw_value with
-        | None ->
-           EConstr.push_named (NamedDecl.LocalAssum (na,typ)) env
-        | Some value ->
-           EConstr.push_named (NamedDecl.LocalDef (na, value, typ)) env)
-
+  | Anonymous -> env
+  | Name id -> (
+    let typ, _ =
+      Pretyping.understand env (Evd.from_env env)
+        ~expected_type:Pretyping.IsType raw_typ
+    in
+    let na = make_annot id Sorts.Relevant in
+    (* TODO relevance *)
+    match raw_value with
+    | None -> EConstr.push_named (NamedDecl.LocalAssum (na, typ)) env
+    | Some value -> EConstr.push_named (NamedDecl.LocalDef (na, value, typ)) env
+    )
 
 let add_pat_variables sigma pat typ env : Environ.env =
-  let rec add_pat_variables env pat typ  : Environ.env =
-    observe (str "new rel env := " ++ Printer.pr_rel_context_of env (Evd.from_env env));
-
+  let rec add_pat_variables env pat typ : Environ.env =
+    observe
+      (str "new rel env := " ++ Printer.pr_rel_context_of env (Evd.from_env env));
     match DAst.get pat with
-      | PatVar na -> Environ.push_rel (RelDecl.LocalAssum (make_annot na Sorts.Relevant,typ)) env
-      | PatCstr(c,patl,na) ->
-          let Inductiveops.IndType(indf,indargs) =
-            try Inductiveops.find_rectype env (Evd.from_env env) (EConstr.of_constr typ)
-            with Not_found -> assert false
-          in
-          let constructors = Inductiveops.get_constructors env indf in
-          let constructor : Inductiveops.constructor_summary = List.find (fun cs -> eq_constructor c (fst cs.Inductiveops.cs_cstr)) (Array.to_list constructors) in
-          let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
-          List.fold_left2 add_pat_variables env patl (List.rev cs_args_types)
+    | PatVar na ->
+      Environ.push_rel
+        (RelDecl.LocalAssum (make_annot na Sorts.Relevant, typ))
+        env
+    | PatCstr (c, patl, na) ->
+      let (Inductiveops.IndType (indf, indargs)) =
+        try
+          Inductiveops.find_rectype env (Evd.from_env env)
+            (EConstr.of_constr typ)
+        with Not_found -> assert false
+      in
+      let constructors = Inductiveops.get_constructors env indf in
+      let constructor : Inductiveops.constructor_summary =
+        List.find
+          (fun cs -> eq_constructor c (fst cs.Inductiveops.cs_cstr))
+          (Array.to_list constructors)
+      in
+      let cs_args_types : types list =
+        List.map RelDecl.get_type constructor.Inductiveops.cs_args
+      in
+      List.fold_left2 add_pat_variables env patl (List.rev cs_args_types)
   in
   let new_env = add_pat_variables env pat typ in
   let res =
-    fst (
-      Context.Rel.fold_outside
-        (fun decl (env,ctxt) ->
+    fst
+      (Context.Rel.fold_outside
+         (fun decl (env, ctxt) ->
            let open Context.Rel.Declaration in
            match decl with
-           | LocalAssum ({binder_name=Anonymous},_) | LocalDef ({binder_name=Anonymous},_,_) -> assert false
-           | LocalAssum ({binder_name=Name id} as na, t) ->
-             let na = {na with binder_name=id} in
-             let new_t =  substl ctxt t in
-             observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
-                      str "old type := " ++ Printer.pr_lconstr_env env sigma t ++ fnl () ++
-                      str "new type := " ++ Printer.pr_lconstr_env env sigma new_t ++ fnl ()
-                     );
+           | LocalAssum ({binder_name = Anonymous}, _)
+            |LocalDef ({binder_name = Anonymous}, _, _) ->
+             assert false
+           | LocalAssum (({binder_name = Name id} as na), t) ->
+             let na = {na with binder_name = id} in
+             let new_t = substl ctxt t in
+             observe
+               ( str "for variable " ++ Ppconstr.pr_id id ++ fnl ()
+               ++ str "old type := "
+               ++ Printer.pr_lconstr_env env sigma t
+               ++ fnl () ++ str "new type := "
+               ++ Printer.pr_lconstr_env env sigma new_t
+               ++ fnl () );
              let open Context.Named.Declaration in
-             (Environ.push_named (LocalAssum (na,new_t)) env,mkVar id::ctxt)
-           | LocalDef ({binder_name=Name id} as na, v, t) ->
-             let na = {na with binder_name=id} in
-             let new_t =  substl ctxt t in
+             (Environ.push_named (LocalAssum (na, new_t)) env, mkVar id :: ctxt)
+           | LocalDef (({binder_name = Name id} as na), v, t) ->
+             let na = {na with binder_name = id} in
+             let new_t = substl ctxt t in
              let new_v = substl ctxt v in
-             observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
-                      str "old type := "  ++ Printer.pr_lconstr_env env sigma t ++ fnl () ++
-                      str "new type := "  ++ Printer.pr_lconstr_env env sigma new_t ++ fnl () ++
-                      str "old value := " ++ Printer.pr_lconstr_env env sigma v ++ fnl () ++
-                      str "new value := " ++ Printer.pr_lconstr_env env sigma new_v ++ fnl ()
-                     );
+             observe
+               ( str "for variable " ++ Ppconstr.pr_id id ++ fnl ()
+               ++ str "old type := "
+               ++ Printer.pr_lconstr_env env sigma t
+               ++ fnl () ++ str "new type := "
+               ++ Printer.pr_lconstr_env env sigma new_t
+               ++ fnl () ++ str "old value := "
+               ++ Printer.pr_lconstr_env env sigma v
+               ++ fnl () ++ str "new value := "
+               ++ Printer.pr_lconstr_env env sigma new_v
+               ++ fnl () );
              let open Context.Named.Declaration in
-             (Environ.push_named (LocalDef (na,new_v,new_t)) env,mkVar id::ctxt)
-        )
-        (Environ.rel_context new_env)
-        ~init:(env,[])
-    )
+             ( Environ.push_named (LocalDef (na, new_v, new_t)) env
+             , mkVar id :: ctxt ))
+         (Environ.rel_context new_env)
+         ~init:(env, []))
   in
-  observe (str "new var env := " ++ Printer.pr_named_context_of res (Evd.from_env env));
+  observe
+    (str "new var env := " ++ Printer.pr_named_context_of res (Evd.from_env env));
   res
 
-
-
-
-let rec pattern_to_term_and_type env typ  = DAst.with_val (function
-  | PatVar Anonymous -> assert false
-  | PatVar (Name id) ->
-        mkGVar id
-  | PatCstr(constr,patternl,_) ->
-      let cst_narg =
-        Inductiveops.constructor_nallargs
-          (Global.env ())
-          constr
-      in
-      let Inductiveops.IndType(indf,indargs) =
-        try Inductiveops.find_rectype env (Evd.from_env env) (EConstr.of_constr typ)
+let rec pattern_to_term_and_type env typ =
+  DAst.with_val (function
+    | PatVar Anonymous -> assert false
+    | PatVar (Name id) -> mkGVar id
+    | PatCstr (constr, patternl, _) ->
+      let cst_narg = Inductiveops.constructor_nallargs (Global.env ()) constr in
+      let (Inductiveops.IndType (indf, indargs)) =
+        try
+          Inductiveops.find_rectype env (Evd.from_env env)
+            (EConstr.of_constr typ)
         with Not_found -> assert false
       in
       let constructors = Inductiveops.get_constructors env indf in
-      let constructor  = List.find (fun cs -> eq_constructor (fst cs.Inductiveops.cs_cstr) constr) (Array.to_list constructors) in
-      let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
-      let _,cstl = Inductiveops.dest_ind_family indf in
+      let constructor =
+        List.find
+          (fun cs -> eq_constructor (fst cs.Inductiveops.cs_cstr) constr)
+          (Array.to_list constructors)
+      in
+      let cs_args_types : types list =
+        List.map RelDecl.get_type constructor.Inductiveops.cs_args
+      in
+      let _, cstl = Inductiveops.dest_ind_family indf in
       let csta = Array.of_list cstl in
       let implicit_args =
         Array.to_list
           (Array.init
              (cst_narg - List.length patternl)
-             (fun i -> Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env) (EConstr.of_constr csta.(i)))
-          )
+             (fun i ->
+               Detyping.detype Detyping.Now false Id.Set.empty env
+                 (Evd.from_env env)
+                 (EConstr.of_constr csta.(i))))
       in
       let patl_as_term =
-        List.map2 (pattern_to_term_and_type env)  (List.rev cs_args_types)  patternl
+        List.map2
+          (pattern_to_term_and_type env)
+          (List.rev cs_args_types) patternl
       in
-      mkGApp(mkGRef(GlobRef.ConstructRef constr),
-             implicit_args@patl_as_term
-            )
-  )
+      mkGApp (mkGRef (GlobRef.ConstructRef constr), implicit_args @ patl_as_term))
 
 (* [build_entry_lc funnames avoid rt] construct the list (in fact a build_entry_return)
    of constructors corresponding to [rt] when replacing calls to [funnames] by calls to the
@@ -473,448 +457,427 @@ let rec pattern_to_term_and_type env typ  = DAst.with_val (function
    but only the value of the function
 *)
 
-
-let rec build_entry_lc env sigma funnames avoid rt : glob_constr build_entry_return =
+let rec build_entry_lc env sigma funnames avoid rt :
+    glob_constr build_entry_return =
   observe (str " Entering : " ++ Printer.pr_glob_constr_env env rt);
   let open CAst in
   match DAst.get rt with
-    | GRef _ | GVar _ | GEvar _ | GPatVar _ | GSort _  | GHole _ | GInt _ | GFloat _ ->
-        (* do nothing (except changing type of course) *)
-        mk_result [] rt avoid
-    | GApp(_,_) ->
-        let f,args = glob_decompose_app rt in
-        let args_res : (glob_constr list) build_entry_return =
-          List.fold_right (* create the arguments lists of constructors and combine them *)
-            (fun arg ctxt_argsl ->
-               let arg_res = build_entry_lc env sigma funnames ctxt_argsl.to_avoid arg in
-               combine_results combine_args arg_res ctxt_argsl
-            )
-            args
-            (mk_result [] [] avoid)
-        in
-        begin
-          match DAst.get f with
-            | GLambda _  ->
-                let rec aux t l =
-                  match l with
-                    | [] -> t
-                    | u::l -> DAst.make @@
-                        match DAst.get t with
-                          | GLambda(na,_,nat,b) ->
-                              GLetIn(na,u,None,aux b l)
-                          | _ ->
-                              GApp(t,l)
-                in
-                build_entry_lc env sigma funnames avoid (aux f args)
-            | GVar id when Id.Set.mem id funnames ->
-                (* if we have [f t1 ... tn] with [f]$\in$[fnames]
-                   then we create a fresh variable [res],
-                   add [res] and its "value" (i.e. [res v1 ... vn]) to each
-                   pseudo constructor build for the arguments (i.e. a pseudo context [ctxt] and
-                   a pseudo value "v1 ... vn".
-                   The "value" of this branch is then simply [res]
-                *)
-                (* XXX here and other [understand] calls drop the ctx *)
-                let rt_as_constr,ctx = Pretyping.understand env (Evd.from_env env) rt in
-                let rt_typ = Retyping.get_type_of env (Evd.from_env env) rt_as_constr in
-                let res_raw_type = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env) rt_typ in
-                let res = fresh_id args_res.to_avoid "_res" in
-                let new_avoid = res::args_res.to_avoid in
-                let res_rt = mkGVar res in
-                let new_result =
-                  List.map
-                    (fun arg_res ->
-                       let new_hyps =
-                         [Prod (Name res),res_raw_type;
-                          Prod Anonymous,mkGApp(res_rt,(mkGVar id)::arg_res.value)]
-                       in
-                       {context =  arg_res.context@new_hyps; value = res_rt }
-                    )
-                    args_res.result
-                in
-                { result = new_result; to_avoid = new_avoid }
-            | GVar _ | GEvar _ | GPatVar _ | GHole _ | GSort _ | GRef _ ->
-                (* if have [g t1 ... tn] with [g] not appearing in [funnames]
-                   then
-                   foreach [ctxt,v1 ... vn] in [args_res] we return
-                   [ctxt, g v1 .... vn]
-                *)
-                {
-                  args_res with
-                    result =
-                    List.map
-                      (fun args_res ->
-                         {args_res with value = mkGApp(f,args_res.value)})
-                      args_res.result
-                }
-            | GApp _ -> assert false (* we have collected all the app in [glob_decompose_app] *)
-            | GLetIn(n,v,t,b) ->
-                (* if we have [(let x := v in b) t1 ... tn] ,
-                   we discard our work and compute the list of constructor for
-                   [let x = v in (b t1 ... tn)] up to alpha conversion
-                *)
-                let new_n,new_b,new_avoid =
-                  match n with
-                    | Name id when List.exists (is_free_in id) args ->
-                        (* need to alpha-convert the name *)
-                        let new_id = Namegen.next_ident_away id (Id.Set.of_list avoid) in
-                        let new_avoid = id:: avoid in
-                        let new_b =
-                          replace_var_by_term
-                            id
-                            (DAst.make @@ GVar id)
-                            b
-                        in
-                        (Name new_id,new_b,new_avoid)
-                    | _ -> n,b,avoid
-                in
-                build_entry_lc
-                  env
-      sigma
-      funnames
-                  avoid
-                  (mkGLetIn(new_n,v,t,mkGApp(new_b,args)))
-            | GCases _  | GIf _ | GLetTuple _ ->
-                (* we have [(match e1, ...., en with ..... end) t1 tn]
-                   we first compute the result from the case and
-                   then combine each of them with each of args one
-                *)
-                let f_res = build_entry_lc env sigma funnames args_res.to_avoid f in
-                combine_results combine_app f_res  args_res
-            | GCast(b,_) ->
-                (* for an applied cast we just trash the cast part
-                   and restart the work.
-
-                   WARNING: We need to restart since [b] itself should be an application term
-                *)
-                build_entry_lc env sigma funnames avoid (mkGApp(b,args))
-            | GRec _ -> user_err Pp.(str "Not handled GRec")
-            | GProd _ -> user_err Pp.(str "Cannot apply a type")
-            | GInt _ -> user_err Pp.(str "Cannot apply an integer")
-      | GFloat _ -> user_err Pp.(str "Cannot apply a float")
-        end (* end of the application treatement *)
-
-    | GLambda(n,_,t,b) ->
-        (* we first compute the list of constructor
-           corresponding to the body of the function,
-           then the one corresponding to the type
-           and combine the two result
-        *)
-        let t_res = build_entry_lc env sigma funnames avoid t  in
-        let new_n =
-          match n with
-            | Name _ -> n
-            | Anonymous -> Name (Indfun_common.fresh_id [] "_x")
-        in
-        let new_env = raw_push_named (new_n,None,t) env in
-        let b_res = build_entry_lc new_env sigma funnames avoid b in
-        combine_results (combine_lam new_n) t_res b_res
-    | GProd(n,_,t,b) ->
-        (* we first compute the list of constructor
-           corresponding to the body of the function,
-           then the one corresponding to the type
-           and combine the two result
-        *)
-        let t_res = build_entry_lc env sigma funnames avoid t in
-        let new_env = raw_push_named (n,None,t) env in
-        let b_res = build_entry_lc new_env sigma funnames avoid b in
-        if List.length t_res.result = 1 && List.length b_res.result = 1
-        then combine_results (combine_prod2 n) t_res b_res
-        else combine_results (combine_prod n) t_res b_res
-    | GLetIn(n,v,typ,b) ->
-        (* we first compute the list of constructor
-           corresponding to the body of the function,
-           then the one corresponding to the value [t]
-           and combine the two result
-        *)
-        let v = match typ with None -> v | Some t -> DAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
-        let v_res = build_entry_lc env sigma funnames avoid v in
-        let v_as_constr,ctx = Pretyping.understand env (Evd.from_env env) v in
-        let v_type = Retyping.get_type_of env (Evd.from_env env) v_as_constr in
-        let v_r = Sorts.Relevant in (* TODO relevance *)
-        let new_env =
-          match n with
-              Anonymous -> env
-            | Name id -> EConstr.push_named (NamedDecl.LocalDef (make_annot id v_r,v_as_constr,v_type)) env
-        in
-        let b_res = build_entry_lc new_env sigma funnames avoid b in
-        combine_results (combine_letin n) v_res b_res
-    | GCases(_,_,el,brl) ->
-        (* we create the discrimination function
-           and treat the case itself
-        *)
-        let make_discr = make_discr_match brl in
-        build_entry_lc_from_case env sigma funnames make_discr el brl avoid
-    | GIf(b,(na,e_option),lhs,rhs) ->
-        let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in
-        let b_typ = Retyping.get_type_of env (Evd.from_env env) b_as_constr in
-        let (ind,_) =
-          try Inductiveops.find_inductive env (Evd.from_env env) b_typ
-          with Not_found ->
-            user_err  (str "Cannot find the inductive associated to " ++
-                               Printer.pr_glob_constr_env env b ++ str " in " ++
-                               Printer.pr_glob_constr_env env rt ++ str ". try again with a cast")
-        in
-        let case_pats = build_constructors_of_type (fst ind) [] in
-        assert (Int.equal (Array.length case_pats) 2);
-        let brl =
-          List.map_i
-            (fun i x -> CAst.make ([],[case_pats.(i)],x))
-            0
-            [lhs;rhs]
-        in
-        let match_expr =
-          mkGCases(None,[(b,(Anonymous,None))],brl)
-        in
-        (* 		Pp.msgnl (str "new case := " ++ Printer.pr_glob_constr match_expr); *)
-        build_entry_lc env sigma funnames avoid match_expr
-    | GLetTuple(nal,_,b,e) ->
-        begin
-          let nal_as_glob_constr =
-            List.map
-              (function
-                   Name id -> mkGVar id
-                 | Anonymous -> mkGHole ()
-              )
-              nal
-          in
-          let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in
-          let b_typ = Retyping.get_type_of env (Evd.from_env env) b_as_constr in
-          let (ind,_) =
-            try Inductiveops.find_inductive env (Evd.from_env env) b_typ
-            with Not_found ->
-              user_err  (str "Cannot find the inductive associated to " ++
-                                 Printer.pr_glob_constr_env env b ++ str " in " ++
-                                 Printer.pr_glob_constr_env env rt ++ str ". try again with a cast")
+  | GRef _ | GVar _ | GEvar _ | GPatVar _ | GSort _ | GHole _ | GInt _
+   |GFloat _ ->
+    (* do nothing (except changing type of course) *)
+    mk_result [] rt avoid
+  | GApp (_, _) -> (
+    let f, args = glob_decompose_app rt in
+    let args_res : glob_constr list build_entry_return =
+      List.fold_right
+        (* create the arguments lists of constructors and combine them *)
+          (fun arg ctxt_argsl ->
+          let arg_res =
+            build_entry_lc env sigma funnames ctxt_argsl.to_avoid arg
           in
-          let case_pats = build_constructors_of_type (fst ind) nal_as_glob_constr in
-          assert (Int.equal (Array.length case_pats) 1);
-          let br = CAst.make ([],[case_pats.(0)],e) in
-          let match_expr = mkGCases(None,[b,(Anonymous,None)],[br]) in
-          build_entry_lc env sigma funnames avoid match_expr
-
-        end
+          combine_results combine_args arg_res ctxt_argsl)
+        args (mk_result [] [] avoid)
+    in
+    match DAst.get f with
+    | GLambda _ ->
+      let rec aux t l =
+        match l with
+        | [] -> t
+        | u :: l -> (
+          DAst.make
+          @@
+          match DAst.get t with
+          | GLambda (na, _, nat, b) -> GLetIn (na, u, None, aux b l)
+          | _ -> GApp (t, l) )
+      in
+      build_entry_lc env sigma funnames avoid (aux f args)
+    | GVar id when Id.Set.mem id funnames ->
+      (* if we have [f t1 ... tn] with [f]$\in$[fnames]
+         then we create a fresh variable [res],
+         add [res] and its "value" (i.e. [res v1 ... vn]) to each
+         pseudo constructor build for the arguments (i.e. a pseudo context [ctxt] and
+         a pseudo value "v1 ... vn".
+         The "value" of this branch is then simply [res]
+      *)
+      (* XXX here and other [understand] calls drop the ctx *)
+      let rt_as_constr, ctx = Pretyping.understand env (Evd.from_env env) rt in
+      let rt_typ = Retyping.get_type_of env (Evd.from_env env) rt_as_constr in
+      let res_raw_type =
+        Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env)
+          rt_typ
+      in
+      let res = fresh_id args_res.to_avoid "_res" in
+      let new_avoid = res :: args_res.to_avoid in
+      let res_rt = mkGVar res in
+      let new_result =
+        List.map
+          (fun arg_res ->
+            let new_hyps =
+              [ (Prod (Name res), res_raw_type)
+              ; (Prod Anonymous, mkGApp (res_rt, mkGVar id :: arg_res.value)) ]
+            in
+            {context = arg_res.context @ new_hyps; value = res_rt})
+          args_res.result
+      in
+      {result = new_result; to_avoid = new_avoid}
+    | GVar _ | GEvar _ | GPatVar _ | GHole _ | GSort _ | GRef _ ->
+      (* if have [g t1 ... tn] with [g] not appearing in [funnames]
+         then
+         foreach [ctxt,v1 ... vn] in [args_res] we return
+         [ctxt, g v1 .... vn]
+      *)
+      { args_res with
+        result =
+          List.map
+            (fun args_res -> {args_res with value = mkGApp (f, args_res.value)})
+            args_res.result }
+    | GApp _ ->
+      assert false (* we have collected all the app in [glob_decompose_app] *)
+    | GLetIn (n, v, t, b) ->
+      (* if we have [(let x := v in b) t1 ... tn] ,
+         we discard our work and compute the list of constructor for
+         [let x = v in (b t1 ... tn)] up to alpha conversion
+      *)
+      let new_n, new_b, new_avoid =
+        match n with
+        | Name id when List.exists (is_free_in id) args ->
+          (* need to alpha-convert the name *)
+          let new_id = Namegen.next_ident_away id (Id.Set.of_list avoid) in
+          let new_avoid = id :: avoid in
+          let new_b = replace_var_by_term id (DAst.make @@ GVar id) b in
+          (Name new_id, new_b, new_avoid)
+        | _ -> (n, b, avoid)
+      in
+      build_entry_lc env sigma funnames avoid
+        (mkGLetIn (new_n, v, t, mkGApp (new_b, args)))
+    | GCases _ | GIf _ | GLetTuple _ ->
+      (* we have [(match e1, ...., en with ..... end) t1 tn]
+         we first compute the result from the case and
+         then combine each of them with each of args one
+      *)
+      let f_res = build_entry_lc env sigma funnames args_res.to_avoid f in
+      combine_results combine_app f_res args_res
+    | GCast (b, _) ->
+      (* for an applied cast we just trash the cast part
+         and restart the work.
+
+         WARNING: We need to restart since [b] itself should be an application term
+      *)
+      build_entry_lc env sigma funnames avoid (mkGApp (b, args))
     | GRec _ -> user_err Pp.(str "Not handled GRec")
-    | GCast(b,_) ->
-        build_entry_lc env sigma funnames  avoid b
-and build_entry_lc_from_case env sigma funname make_discr
-    (el:tomatch_tuples)
-    (brl:Glob_term.cases_clauses) avoid :
-    glob_constr build_entry_return =
+    | GProd _ -> user_err Pp.(str "Cannot apply a type")
+    | GInt _ -> user_err Pp.(str "Cannot apply an integer")
+    | GFloat _ -> user_err Pp.(str "Cannot apply a float")
+    (* end of the application treatement *) )
+  | GLambda (n, _, t, b) ->
+    (* we first compute the list of constructor
+       corresponding to the body of the function,
+       then the one corresponding to the type
+       and combine the two result
+    *)
+    let t_res = build_entry_lc env sigma funnames avoid t in
+    let new_n =
+      match n with
+      | Name _ -> n
+      | Anonymous -> Name (Indfun_common.fresh_id [] "_x")
+    in
+    let new_env = raw_push_named (new_n, None, t) env in
+    let b_res = build_entry_lc new_env sigma funnames avoid b in
+    combine_results (combine_lam new_n) t_res b_res
+  | GProd (n, _, t, b) ->
+    (* we first compute the list of constructor
+       corresponding to the body of the function,
+       then the one corresponding to the type
+       and combine the two result
+    *)
+    let t_res = build_entry_lc env sigma funnames avoid t in
+    let new_env = raw_push_named (n, None, t) env in
+    let b_res = build_entry_lc new_env sigma funnames avoid b in
+    if List.length t_res.result = 1 && List.length b_res.result = 1 then
+      combine_results (combine_prod2 n) t_res b_res
+    else combine_results (combine_prod n) t_res b_res
+  | GLetIn (n, v, typ, b) ->
+    (* we first compute the list of constructor
+       corresponding to the body of the function,
+       then the one corresponding to the value [t]
+       and combine the two result
+    *)
+    let v =
+      match typ with
+      | None -> v
+      | Some t -> DAst.make ?loc:rt.loc @@ GCast (v, CastConv t)
+    in
+    let v_res = build_entry_lc env sigma funnames avoid v in
+    let v_as_constr, ctx = Pretyping.understand env (Evd.from_env env) v in
+    let v_type = Retyping.get_type_of env (Evd.from_env env) v_as_constr in
+    let v_r = Sorts.Relevant in
+    (* TODO relevance *)
+    let new_env =
+      match n with
+      | Anonymous -> env
+      | Name id ->
+        EConstr.push_named
+          (NamedDecl.LocalDef (make_annot id v_r, v_as_constr, v_type))
+          env
+    in
+    let b_res = build_entry_lc new_env sigma funnames avoid b in
+    combine_results (combine_letin n) v_res b_res
+  | GCases (_, _, el, brl) ->
+    (* we create the discrimination function
+       and treat the case itself
+    *)
+    let make_discr = make_discr_match brl in
+    build_entry_lc_from_case env sigma funnames make_discr el brl avoid
+  | GIf (b, (na, e_option), lhs, rhs) ->
+    let b_as_constr, ctx = Pretyping.understand env (Evd.from_env env) b in
+    let b_typ = Retyping.get_type_of env (Evd.from_env env) b_as_constr in
+    let ind, _ =
+      try Inductiveops.find_inductive env (Evd.from_env env) b_typ
+      with Not_found ->
+        user_err
+          ( str "Cannot find the inductive associated to "
+          ++ Printer.pr_glob_constr_env env b
+          ++ str " in "
+          ++ Printer.pr_glob_constr_env env rt
+          ++ str ". try again with a cast" )
+    in
+    let case_pats = build_constructors_of_type (fst ind) [] in
+    assert (Int.equal (Array.length case_pats) 2);
+    let brl =
+      List.map_i (fun i x -> CAst.make ([], [case_pats.(i)], x)) 0 [lhs; rhs]
+    in
+    let match_expr = mkGCases (None, [(b, (Anonymous, None))], brl) in
+    (* 		Pp.msgnl (str "new case := " ++ Printer.pr_glob_constr match_expr); *)
+    build_entry_lc env sigma funnames avoid match_expr
+  | GLetTuple (nal, _, b, e) ->
+    let nal_as_glob_constr =
+      List.map (function Name id -> mkGVar id | Anonymous -> mkGHole ()) nal
+    in
+    let b_as_constr, ctx = Pretyping.understand env (Evd.from_env env) b in
+    let b_typ = Retyping.get_type_of env (Evd.from_env env) b_as_constr in
+    let ind, _ =
+      try Inductiveops.find_inductive env (Evd.from_env env) b_typ
+      with Not_found ->
+        user_err
+          ( str "Cannot find the inductive associated to "
+          ++ Printer.pr_glob_constr_env env b
+          ++ str " in "
+          ++ Printer.pr_glob_constr_env env rt
+          ++ str ". try again with a cast" )
+    in
+    let case_pats = build_constructors_of_type (fst ind) nal_as_glob_constr in
+    assert (Int.equal (Array.length case_pats) 1);
+    let br = CAst.make ([], [case_pats.(0)], e) in
+    let match_expr = mkGCases (None, [(b, (Anonymous, None))], [br]) in
+    build_entry_lc env sigma funnames avoid match_expr
+  | GRec _ -> user_err Pp.(str "Not handled GRec")
+  | GCast (b, _) -> build_entry_lc env sigma funnames avoid b
+
+and build_entry_lc_from_case env sigma funname make_discr (el : tomatch_tuples)
+    (brl : Glob_term.cases_clauses) avoid : glob_constr build_entry_return =
   match el with
-    | [] -> assert false (* this case correspond to match <nothing> with .... !*)
-    | el ->
-        (* this case correspond to
-           match el with brl end
-           we first compute the list of lists corresponding to [el] and
-           combine them .
-           Then for each element of the combinations,
-           we compute the result we compute one list per branch in [brl] and
-           finally we just concatenate those list
-        *)
-        let case_resl =
-            List.fold_right
-              (fun (case_arg,_) ctxt_argsl ->
-                let arg_res = build_entry_lc env sigma funname ctxt_argsl.to_avoid case_arg in
-                combine_results combine_args arg_res ctxt_argsl
-              )
-              el
-              (mk_result [] [] avoid)
-        in
-        let types =
-          List.map (fun (case_arg,_) ->
-                      let case_arg_as_constr,ctx = Pretyping.understand env (Evd.from_env env) case_arg in
-                      EConstr.Unsafe.to_constr (Retyping.get_type_of env (Evd.from_env env) case_arg_as_constr)
-                   ) el
-        in
-        (****** The next works only if the match is not dependent ****)
-        let results =
-          List.map
-            (fun ca ->
-               let res = build_entry_lc_from_case_term
-               env sigma types
-               funname (make_discr)
-               []  brl
-               case_resl.to_avoid
-               ca
-               in
-               res
-            )
-            case_resl.result
-        in
-        {
-          result = List.concat (List.map (fun r -> r.result) results);
-          to_avoid =
-            List.fold_left (fun acc r -> List.union Id.equal acc r.to_avoid)
-              [] results
-        }
-
-and build_entry_lc_from_case_term env sigma types funname make_discr patterns_to_prevent brl avoid
-    matched_expr =
+  | [] -> assert false (* this case correspond to match <nothing> with .... !*)
+  | el ->
+    (* this case correspond to
+       match el with brl end
+       we first compute the list of lists corresponding to [el] and
+       combine them .
+       Then for each element of the combinations,
+       we compute the result we compute one list per branch in [brl] and
+       finally we just concatenate those list
+    *)
+    let case_resl =
+      List.fold_right
+        (fun (case_arg, _) ctxt_argsl ->
+          let arg_res =
+            build_entry_lc env sigma funname ctxt_argsl.to_avoid case_arg
+          in
+          combine_results combine_args arg_res ctxt_argsl)
+        el (mk_result [] [] avoid)
+    in
+    let types =
+      List.map
+        (fun (case_arg, _) ->
+          let case_arg_as_constr, ctx =
+            Pretyping.understand env (Evd.from_env env) case_arg
+          in
+          EConstr.Unsafe.to_constr
+            (Retyping.get_type_of env (Evd.from_env env) case_arg_as_constr))
+        el
+    in
+    (****** The next works only if the match is not dependent ****)
+    let results =
+      List.map
+        (fun ca ->
+          let res =
+            build_entry_lc_from_case_term env sigma types funname make_discr []
+              brl case_resl.to_avoid ca
+          in
+          res)
+        case_resl.result
+    in
+    { result = List.concat (List.map (fun r -> r.result) results)
+    ; to_avoid =
+        List.fold_left
+          (fun acc r -> List.union Id.equal acc r.to_avoid)
+          [] results }
+
+and build_entry_lc_from_case_term env sigma types funname make_discr
+    patterns_to_prevent brl avoid matched_expr =
   match brl with
-    | [] -> (* computed_branches  *) {result = [];to_avoid = avoid}
-    | br::brl' ->
-        (* alpha conversion to prevent name clashes *)
-        let {CAst.v=(idl,patl,return)} = alpha_br avoid br in
-        let new_avoid  = idl@avoid in 	(* for now we can no more use idl as an identifier *)
-        (* building a list of precondition stating that we are not in this branch
-           (will be used in the following recursive calls)
-        *)
-        let new_env = List.fold_right2 (add_pat_variables sigma) patl types env in
-        let not_those_patterns : (Id.t list -> glob_constr -> glob_constr) list =
-          List.map2
-            (fun pat typ ->
-               fun avoid pat'_as_term ->
-                 let renamed_pat,_,_ = alpha_pat avoid pat in
-                 let pat_ids = get_pattern_id renamed_pat  in
-                 let env_with_pat_ids = add_pat_variables sigma pat typ new_env in
-                   List.fold_right
-                     (fun id acc ->
-                        let typ_of_id = Typing.type_of_variable env_with_pat_ids id in
-                        let raw_typ_of_id =
-                          Detyping.detype Detyping.Now false Id.Set.empty
-                            env_with_pat_ids (Evd.from_env env) typ_of_id
-                        in
-                        mkGProd (Name id,raw_typ_of_id,acc))
-                     pat_ids
-                     (glob_make_neq pat'_as_term (pattern_to_term renamed_pat))
-            )
-            patl
-            types
-        in
-        (* Checking if we can be in this branch
-           (will be used in the following recursive calls)
-        *)
-        let unify_with_those_patterns : (cases_pattern -> bool*bool) list =
-          List.map
-            (fun pat pat' -> are_unifiable pat pat',eq_cases_pattern pat pat')
-            patl
-        in
-        (*
+  | [] -> (* computed_branches  *) {result = []; to_avoid = avoid}
+  | br :: brl' ->
+    (* alpha conversion to prevent name clashes *)
+    let {CAst.v = idl, patl, return} = alpha_br avoid br in
+    let new_avoid = idl @ avoid in
+    (* for now we can no more use idl as an identifier *)
+    (* building a list of precondition stating that we are not in this branch
+       (will be used in the following recursive calls)
+    *)
+    let new_env = List.fold_right2 (add_pat_variables sigma) patl types env in
+    let not_those_patterns : (Id.t list -> glob_constr -> glob_constr) list =
+      List.map2
+        (fun pat typ avoid pat'_as_term ->
+          let renamed_pat, _, _ = alpha_pat avoid pat in
+          let pat_ids = get_pattern_id renamed_pat in
+          let env_with_pat_ids = add_pat_variables sigma pat typ new_env in
+          List.fold_right
+            (fun id acc ->
+              let typ_of_id = Typing.type_of_variable env_with_pat_ids id in
+              let raw_typ_of_id =
+                Detyping.detype Detyping.Now false Id.Set.empty env_with_pat_ids
+                  (Evd.from_env env) typ_of_id
+              in
+              mkGProd (Name id, raw_typ_of_id, acc))
+            pat_ids
+            (glob_make_neq pat'_as_term (pattern_to_term renamed_pat)))
+        patl types
+    in
+    (* Checking if we can be in this branch
+       (will be used in the following recursive calls)
+    *)
+    let unify_with_those_patterns : (cases_pattern -> bool * bool) list =
+      List.map
+        (fun pat pat' -> (are_unifiable pat pat', eq_cases_pattern pat pat'))
+        patl
+    in
+    (*
            we first compute the other branch result (in ordrer to keep the order of the matching
            as much as possible)
         *)
-        let brl'_res =
-          build_entry_lc_from_case_term
-            env
-      sigma
-            types
-            funname
-            make_discr
-            ((unify_with_those_patterns,not_those_patterns)::patterns_to_prevent)
-            brl'
-            avoid
-            matched_expr
-        in
-        (* We now create the precondition of this branch i.e.
-           1- the list of variable appearing in the different patterns of this branch and
-              the list of equation stating than el = patl (List.flatten ...)
-           2- If there exists a previous branch which pattern unify with the one of this branch
-              then a discrimination precond stating that we are not in a previous branch (if List.exists ...)
-        *)
-        let those_pattern_preconds =
-          (List.flatten
-            (
-              List.map3
-              (fun pat e typ_as_constr ->
-                 let this_pat_ids = ids_of_pat pat in
-                 let typ_as_constr = EConstr.of_constr typ_as_constr in
-                 let typ = Detyping.detype Detyping.Now false Id.Set.empty new_env (Evd.from_env env) typ_as_constr in
-                 let pat_as_term = pattern_to_term pat in
-                 (* removing trivial holes *)
-                 let pat_as_term = solve_trivial_holes pat_as_term e in
-                  (* observe (str "those_pattern_preconds" ++ spc () ++ *)
-                  (*            str "pat" ++ spc () ++ pr_glob_constr pat_as_term ++ spc ()++ *)
-                  (*            str "e" ++ spc () ++ pr_glob_constr e ++spc ()++ *)
-                  (*            str "typ_as_constr" ++ spc () ++ pr_lconstr typ_as_constr); *)
-                 List.fold_right
-                   (fun id  acc ->
-                      if Id.Set.mem id this_pat_ids
-                      then (Prod (Name id),
-                      let typ_of_id = Typing.type_of_variable new_env id in
-                      let raw_typ_of_id =
-                        Detyping.detype Detyping.Now false Id.Set.empty new_env (Evd.from_env env) typ_of_id
-                      in
-                      raw_typ_of_id
-                           )::acc
-                      else acc
-                   )
-                   idl
-                   [(Prod Anonymous,glob_make_eq ~typ pat_as_term e)]
-              )
-              patl
-              matched_expr.value
-              types
-          )
-          )
-          @
-          (if List.exists (function (unifl,_) ->
-                             let (unif,_) =
-                               List.split (List.map2 (fun x y -> x y) unifl patl)
-                             in
-                             List.for_all (fun x -> x) unif) patterns_to_prevent
-           then
-             let i = List.length patterns_to_prevent in
-             let pats_as_constr = List.map2 (pattern_to_term_and_type new_env) types patl in
-             [(Prod Anonymous,make_discr pats_as_constr i  )]
-           else
-             []
-          )
-        in
-        (* We compute the result of the value returned by the branch*)
-        let return_res = build_entry_lc new_env sigma funname new_avoid return in
-        (* and combine it with the preconds computed for this branch *)
-        let this_branch_res =
-          List.map
-            (fun res  ->
-               { context = matched_expr.context@those_pattern_preconds@res.context ;
-                 value = res.value}
-            )
-            return_res.result
+    let brl'_res =
+      build_entry_lc_from_case_term env sigma types funname make_discr
+        ((unify_with_those_patterns, not_those_patterns) :: patterns_to_prevent)
+        brl' avoid matched_expr
+    in
+    (* We now create the precondition of this branch i.e.
+       1- the list of variable appearing in the different patterns of this branch and
+          the list of equation stating than el = patl (List.flatten ...)
+       2- If there exists a previous branch which pattern unify with the one of this branch
+          then a discrimination precond stating that we are not in a previous branch (if List.exists ...)
+    *)
+    let those_pattern_preconds =
+      List.flatten
+        (List.map3
+           (fun pat e typ_as_constr ->
+             let this_pat_ids = ids_of_pat pat in
+             let typ_as_constr = EConstr.of_constr typ_as_constr in
+             let typ =
+               Detyping.detype Detyping.Now false Id.Set.empty new_env
+                 (Evd.from_env env) typ_as_constr
+             in
+             let pat_as_term = pattern_to_term pat in
+             (* removing trivial holes *)
+             let pat_as_term = solve_trivial_holes pat_as_term e in
+             (* observe (str "those_pattern_preconds" ++ spc () ++ *)
+             (*            str "pat" ++ spc () ++ pr_glob_constr pat_as_term ++ spc ()++ *)
+             (*            str "e" ++ spc () ++ pr_glob_constr e ++spc ()++ *)
+             (*            str "typ_as_constr" ++ spc () ++ pr_lconstr typ_as_constr); *)
+             List.fold_right
+               (fun id acc ->
+                 if Id.Set.mem id this_pat_ids then
+                   ( Prod (Name id)
+                   , let typ_of_id = Typing.type_of_variable new_env id in
+                     let raw_typ_of_id =
+                       Detyping.detype Detyping.Now false Id.Set.empty new_env
+                         (Evd.from_env env) typ_of_id
+                     in
+                     raw_typ_of_id )
+                   :: acc
+                 else acc)
+               idl
+               [(Prod Anonymous, glob_make_eq ~typ pat_as_term e)])
+           patl matched_expr.value types)
+      @
+      if
+        List.exists
+          (function
+            | unifl, _ ->
+              let unif, _ =
+                List.split (List.map2 (fun x y -> x y) unifl patl)
+              in
+              List.for_all (fun x -> x) unif)
+          patterns_to_prevent
+      then
+        let i = List.length patterns_to_prevent in
+        let pats_as_constr =
+          List.map2 (pattern_to_term_and_type new_env) types patl
         in
-        { brl'_res with result = this_branch_res@brl'_res.result }
-
+        [(Prod Anonymous, make_discr pats_as_constr i)]
+      else []
+    in
+    (* We compute the result of the value returned by the branch*)
+    let return_res = build_entry_lc new_env sigma funname new_avoid return in
+    (* and combine it with the preconds computed for this branch *)
+    let this_branch_res =
+      List.map
+        (fun res ->
+          { context = matched_expr.context @ those_pattern_preconds @ res.context
+          ; value = res.value })
+        return_res.result
+    in
+    {brl'_res with result = this_branch_res @ brl'_res.result}
 
-let is_res r = match DAst.get r with
-| GVar id ->
-  begin try
-    String.equal (String.sub (Id.to_string id) 0 4) "_res"
-  with Invalid_argument _ -> false end
-| _ -> false
+let is_res r =
+  match DAst.get r with
+  | GVar id -> (
+    try String.equal (String.sub (Id.to_string id) 0 4) "_res"
+    with Invalid_argument _ -> false )
+  | _ -> false
 
-let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> GlobRef.equal r gr
-| _ -> false
+let is_gr c gr =
+  match DAst.get c with GRef (r, _) -> GlobRef.equal r gr | _ -> false
 
-let is_gvar c = match DAst.get c with
-| GVar id -> true
-| _ -> false
+let is_gvar c = match DAst.get c with GVar id -> true | _ -> false
 
 let same_raw_term rt1 rt2 =
-  match DAst.get rt1, DAst.get rt2 with
-    | GRef(r1,_), GRef (r2,_) -> GlobRef.equal r1 r2
-    | GHole _, GHole _ -> true
-    | _ -> false
+  match (DAst.get rt1, DAst.get rt2) with
+  | GRef (r1, _), GRef (r2, _) -> GlobRef.equal r1 r2
+  | GHole _, GHole _ -> true
+  | _ -> false
+
 let decompose_raw_eq env lhs rhs =
   let rec decompose_raw_eq lhs rhs acc =
-    observe (str "decomposing eq for " ++ pr_glob_constr_env env lhs ++ str " " ++ pr_glob_constr_env env rhs);
-    let (rhd,lrhs) = glob_decompose_app rhs in
-    let (lhd,llhs) = glob_decompose_app lhs in
+    observe
+      ( str "decomposing eq for " ++ pr_glob_constr_env env lhs ++ str " "
+      ++ pr_glob_constr_env env rhs );
+    let rhd, lrhs = glob_decompose_app rhs in
+    let lhd, llhs = glob_decompose_app lhs in
     observe (str "lhd := " ++ pr_glob_constr_env env lhd);
     observe (str "rhd := " ++ pr_glob_constr_env env rhd);
     observe (str "llhs := " ++ int (List.length llhs));
     observe (str "lrhs := " ++ int (List.length lrhs));
     let sllhs = List.length llhs in
     let slrhs = List.length lrhs in
-    if same_raw_term lhd rhd && Int.equal sllhs slrhs
-    then
+    if same_raw_term lhd rhd && Int.equal sllhs slrhs then
       (* let _ = assert false in  *)
-      List.fold_right2 decompose_raw_eq	llhs lrhs acc
-    else (lhs,rhs)::acc
+      List.fold_right2 decompose_raw_eq llhs lrhs acc
+    else (lhs, rhs) :: acc
   in
   decompose_raw_eq lhs rhs []
 
 exception Continue
+
 (*
    The second phase which reconstruct the real type of the constructor.
    rebuild the globalized constructors expression.
@@ -925,304 +888,283 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
   let open Context.Rel.Declaration in
   let open CAst in
   match DAst.get rt with
-    | GProd(n,k,t,b) ->
-        let not_free_in_t id = not (is_free_in id t) in
-        let new_crossed_types = t::crossed_types in
-        begin
-          match DAst.get t with
-            | GApp(res_rt ,args') when is_res res_rt ->
-                begin
-                  let arg = List.hd args' in
-                  match DAst.get arg with
-                    | GVar this_relname ->
-                        (*i The next call to mk_rel_id is
-                          valid since we are constructing the graph
-                          Ensures by: obvious
-                          i*)
-
-                        let new_t =
-                          mkGApp(mkGVar(mk_rel_id this_relname),List.tl args'@[res_rt])
-                        in
-                        let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in
-                        let r = Sorts.Relevant in (* TODO relevance *)
-                        let new_env = EConstr.push_rel (LocalAssum (make_annot n r,t')) env in
-                        let new_b,id_to_exclude =
-                          rebuild_cons new_env
-                            nb_args relname
-                            args new_crossed_types
-                            (depth + 1) b
-                        in
-                        mkGProd(n,new_t,new_b),
-                        Id.Set.filter not_free_in_t id_to_exclude
-                    | _ -> (* the first args is the name of the function! *)
-                        assert false
-                end
-            | GApp(eq_as_ref,[ty; id ;rt])
-                when is_gvar id && is_gr eq_as_ref Coqlib.(lib_ref "core.eq.type")  && n == Anonymous
-                  ->
-                let loc1 = rt.CAst.loc in
-                let loc2 = eq_as_ref.CAst.loc in
-                let loc3 = id.CAst.loc in
-                let id = match DAst.get id with GVar id -> id | _ -> assert false in
-                begin
-                  try
-                    observe (str "computing new type for eq : " ++ pr_glob_constr_env env rt);
-                    let t' =
-                      try fst (Pretyping.understand env (Evd.from_env env) t)(*FIXME*)
-                      with e when CErrors.noncritical e -> raise Continue
-                    in
-                    let is_in_b = is_free_in id b in
-                    let _keep_eq =
-                      not (List.exists (is_free_in id) args) || is_in_b  ||
-                        List.exists (is_free_in id) crossed_types
-                    in
-                    let new_args = List.map (replace_var_by_term id rt) args in
-                    let subst_b =
-                      if is_in_b then b else  replace_var_by_term id rt b
-                    in
-                    let r = Sorts.Relevant in (* TODO relevance *)
-                    let new_env = EConstr.push_rel (LocalAssum (make_annot n r,t')) env in
-                    let new_b,id_to_exclude =
-                      rebuild_cons
-                        new_env
-                        nb_args relname
-                        new_args new_crossed_types
-                        (depth + 1) subst_b
-                    in
-                    mkGProd(n,t,new_b),id_to_exclude
-                  with Continue ->
-                    let jmeq = GlobRef.IndRef (fst (EConstr.destInd Evd.empty (jmeq ()))) in
-                    let ty',ctx = Pretyping.understand env (Evd.from_env env) ty in
-                    let ind,args' = Inductiveops.find_inductive env Evd.(from_env env) ty' in
-                    let mib,_ = Global.lookup_inductive (fst ind) in
-                    let nparam = mib.Declarations.mind_nparams in
-                    let params,arg' =
-                      ((Util.List.chop nparam args'))
-                    in
-                    let rt_typ = DAst.make @@
-                       GApp(DAst.make @@ GRef (GlobRef.IndRef (fst ind),None),
-                            (List.map
-                              (fun p -> Detyping.detype Detyping.Now false Id.Set.empty
-                                 env (Evd.from_env env)
-                                 (EConstr.of_constr p)) params)@(Array.to_list
-                                      (Array.make
-                                         (List.length args' - nparam)
-                                         (mkGHole ()))))
-                    in
-                    let eq' =
-                      DAst.make ?loc:loc1 @@ GApp(DAst.make ?loc:loc2 @@GRef(jmeq,None),[ty;DAst.make ?loc:loc3 @@ GVar id;rt_typ;rt])
-                    in
-                    observe (str "computing new type for jmeq : " ++ pr_glob_constr_env env eq');
-                    let eq'_as_constr,ctx = Pretyping.understand env (Evd.from_env env) eq' in
-                    observe (str " computing new type for jmeq : done") ;
-                    let sigma = Evd.(from_env env) in
-                    let new_args =
-                      match EConstr.kind sigma eq'_as_constr with
-                        | App(_,[|_;_;ty;_|]) ->
-                            let ty = Array.to_list (snd (EConstr.destApp sigma ty)) in
-                            let ty' = snd (Util.List.chop nparam ty) in
-                            List.fold_left2
-                              (fun acc var_as_constr arg ->
-                                 if isRel var_as_constr
-                                 then
-                                   let na = RelDecl.get_name (Environ.lookup_rel (destRel var_as_constr) env) in
-                                   match na with
-                                     | Anonymous -> acc
-                                     | Name id' ->
-                                         (id',Detyping.detype Detyping.Now false Id.Set.empty
-                                            env
-                                            (Evd.from_env env)
-                                            arg)::acc
-                                 else if isVar var_as_constr
-                                 then (destVar var_as_constr,Detyping.detype Detyping.Now false Id.Set.empty
-                                         env
-                                         (Evd.from_env env)
-                                         arg)::acc
-                                 else acc
-                              )
-                              []
-                              arg'
-                              ty'
-                        | _ -> assert false
-                    in
-                    let is_in_b = is_free_in id b in
-                    let _keep_eq =
-                      not (List.exists (is_free_in id) args) || is_in_b  ||
-                        List.exists (is_free_in id) crossed_types
-                    in
-                    let new_args =
-                      List.fold_left
-                        (fun args (id,rt) ->
-                           List.map (replace_var_by_term id rt) args
-                        )
-                        args
-                        ((id,rt)::new_args)
-                    in
-                    let subst_b =
-                     if is_in_b then b else  replace_var_by_term id rt b
-                    in
-                    let new_env =
-                      let t',ctx = Pretyping.understand env (Evd.from_env env) eq' in
-                      let r = Sorts.Relevant in (* TODO relevance *)
-                      EConstr.push_rel (LocalAssum (make_annot n r,t')) env
-                    in
-                    let new_b,id_to_exclude =
-                      rebuild_cons
-                        new_env
-                        nb_args relname
-                        new_args new_crossed_types
-                        (depth + 1) subst_b
-                    in
-                    mkGProd(n,eq',new_b),id_to_exclude
-                end
-                  (* J.F:. keep this comment  it explain how to remove some meaningless equalities
-                     if keep_eq then
-                     mkGProd(n,t,new_b),id_to_exclude
-                     else new_b, Id.Set.add id id_to_exclude
-                  *)
-            | GApp(eq_as_ref,[ty;rt1;rt2])
-                when is_gr eq_as_ref Coqlib.(lib_ref "core.eq.type") && n == Anonymous
-                  ->
-              begin
-                try
-                  let l = decompose_raw_eq env rt1 rt2 in
-                  if List.length l > 1
-                  then
-                    let new_rt =
-                      List.fold_left
-                        (fun acc (lhs,rhs) ->
-                          mkGProd(Anonymous,
-                                  mkGApp(mkGRef Coqlib.(lib_ref "core.eq.type"),[mkGHole ();lhs;rhs]),acc)
-                        )
-                        b
-                        l
-                    in
-                    rebuild_cons env nb_args relname args crossed_types depth new_rt
-                  else raise Continue
-              with Continue ->
-                observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
-                let t',ctx = Pretyping.understand env (Evd.from_env env) t in
-                let r = Sorts.Relevant in (* TODO relevance *)
-                let new_env = EConstr.push_rel (LocalAssum (make_annot n r,t')) env in
-                let new_b,id_to_exclude =
-                  rebuild_cons new_env
-                    nb_args relname
-                    args new_crossed_types
-                    (depth + 1) b
-                in
-                match n with
-                  | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args ->
-                      new_b,Id.Set.remove id
-                        (Id.Set.filter not_free_in_t id_to_exclude)
-                  | _ -> mkGProd(n,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
-              end
-            | _ ->
-                observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
-                let t',ctx = Pretyping.understand env (Evd.from_env env) t in
-                let r = Sorts.Relevant in (* TODO relevance *)
-                let new_env = EConstr.push_rel (LocalAssum (make_annot n r,t')) env in
-                let new_b,id_to_exclude =
-                  rebuild_cons new_env
-                    nb_args relname
-                    args new_crossed_types
-                    (depth + 1) b
-                in
-                match n with
-                  | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args ->
-                      new_b,Id.Set.remove id
-                        (Id.Set.filter not_free_in_t id_to_exclude)
-                  | _ -> mkGProd(n,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
-        end
-    | GLambda(n,k,t,b) ->
-        begin
-          let not_free_in_t id = not (is_free_in id t) in
-          let new_crossed_types = t :: crossed_types in
-          observe (str "computing new type for lambda : " ++ pr_glob_constr_env env rt);
-          let t',ctx = Pretyping.understand env (Evd.from_env env) t in
-          match n with
-            | Name id ->
-              let r = Sorts.Relevant in (* TODO relevance *)
-              let new_env = EConstr.push_rel (LocalAssum (make_annot n r,t')) env in
-                let new_b,id_to_exclude =
-                  rebuild_cons new_env
-                    nb_args relname
-                    (args@[mkGVar id])new_crossed_types
-                    (depth + 1 ) b
-                in
-                if Id.Set.mem id id_to_exclude && depth >= nb_args
-                then
-                  new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude)
-                else
-                  DAst.make @@ GProd(n,k,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
-            | _ -> anomaly (Pp.str "Should not have an anonymous function here.")
-                (* We have renamed all the anonymous functions during alpha_renaming phase *)
-
-        end
-    | GLetIn(n,v,t,b) ->
-        begin
-          let t = match t with None -> v | Some t -> DAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
-          let not_free_in_t id = not (is_free_in id t) in
-          let evd = (Evd.from_env env) in
-          let t',ctx = Pretyping.understand env evd t in
-          let evd = Evd.from_ctx ctx in
-          let type_t' = Retyping.get_type_of env evd t' in
-          let t' = EConstr.Unsafe.to_constr t' in
-          let type_t' = EConstr.Unsafe.to_constr type_t' in
-          let new_env = Environ.push_rel (LocalDef (make_annot n Sorts.Relevant,t',type_t')) env in
-          let new_b,id_to_exclude =
-            rebuild_cons new_env
-              nb_args relname
-              args (t::crossed_types)
-              (depth + 1 ) b in
-          match n with
-            | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args  ->
-                new_b,Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude)
-            | _ -> DAst.make @@ GLetIn(n,t,None,new_b), (* HOPING IT WOULD WORK *)
-                Id.Set.filter not_free_in_t id_to_exclude
-        end
-    | GLetTuple(nal,(na,rto),t,b) ->
-        assert (Option.is_empty rto);
-        begin
-          let not_free_in_t id = not (is_free_in id t) in
-          let new_t,id_to_exclude' =
-            rebuild_cons env
-              nb_args
-              relname
-              args (crossed_types)
-              depth t
-          in
-          let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in
-          let r = Sorts.Relevant in (* TODO relevance *)
-          let new_env = EConstr.push_rel (LocalAssum (make_annot na r,t')) env in
-          let new_b,id_to_exclude =
-            rebuild_cons new_env
-              nb_args relname
-              args (t::crossed_types)
-              (depth + 1) b
+  | GProd (n, k, t, b) -> (
+    let not_free_in_t id = not (is_free_in id t) in
+    let new_crossed_types = t :: crossed_types in
+    match DAst.get t with
+    | GApp (res_rt, args') when is_res res_rt -> (
+      let arg = List.hd args' in
+      match DAst.get arg with
+      | GVar this_relname ->
+        (*i The next call to mk_rel_id is
+          valid since we are constructing the graph
+          Ensures by: obvious
+          i*)
+        let new_t =
+          mkGApp (mkGVar (mk_rel_id this_relname), List.tl args' @ [res_rt])
+        in
+        let t', ctx = Pretyping.understand env (Evd.from_env env) new_t in
+        let r = Sorts.Relevant in
+        (* TODO relevance *)
+        let new_env = EConstr.push_rel (LocalAssum (make_annot n r, t')) env in
+        let new_b, id_to_exclude =
+          rebuild_cons new_env nb_args relname args new_crossed_types
+            (depth + 1) b
+        in
+        (mkGProd (n, new_t, new_b), Id.Set.filter not_free_in_t id_to_exclude)
+      | _ ->
+        (* the first args is the name of the function! *)
+        assert false )
+    | GApp (eq_as_ref, [ty; id; rt])
+      when is_gvar id
+           && is_gr eq_as_ref Coqlib.(lib_ref "core.eq.type")
+           && n == Anonymous -> (
+      let loc1 = rt.CAst.loc in
+      let loc2 = eq_as_ref.CAst.loc in
+      let loc3 = id.CAst.loc in
+      let id = match DAst.get id with GVar id -> id | _ -> assert false in
+      try
+        observe (str "computing new type for eq : " ++ pr_glob_constr_env env rt);
+        let t' =
+          try fst (Pretyping.understand env (Evd.from_env env) t) (*FIXME*)
+          with e when CErrors.noncritical e -> raise Continue
+        in
+        let is_in_b = is_free_in id b in
+        let _keep_eq =
+          (not (List.exists (is_free_in id) args))
+          || is_in_b
+          || List.exists (is_free_in id) crossed_types
+        in
+        let new_args = List.map (replace_var_by_term id rt) args in
+        let subst_b = if is_in_b then b else replace_var_by_term id rt b in
+        let r = Sorts.Relevant in
+        (* TODO relevance *)
+        let new_env = EConstr.push_rel (LocalAssum (make_annot n r, t')) env in
+        let new_b, id_to_exclude =
+          rebuild_cons new_env nb_args relname new_args new_crossed_types
+            (depth + 1) subst_b
+        in
+        (mkGProd (n, t, new_b), id_to_exclude)
+      with Continue ->
+        let jmeq = GlobRef.IndRef (fst (EConstr.destInd Evd.empty (jmeq ()))) in
+        let ty', ctx = Pretyping.understand env (Evd.from_env env) ty in
+        let ind, args' =
+          Inductiveops.find_inductive env Evd.(from_env env) ty'
+        in
+        let mib, _ = Global.lookup_inductive (fst ind) in
+        let nparam = mib.Declarations.mind_nparams in
+        let params, arg' = Util.List.chop nparam args' in
+        let rt_typ =
+          DAst.make
+          @@ GApp
+               ( DAst.make @@ GRef (GlobRef.IndRef (fst ind), None)
+               , List.map
+                   (fun p ->
+                     Detyping.detype Detyping.Now false Id.Set.empty env
+                       (Evd.from_env env) (EConstr.of_constr p))
+                   params
+                 @ Array.to_list
+                     (Array.make (List.length args' - nparam) (mkGHole ())) )
+        in
+        let eq' =
+          DAst.make ?loc:loc1
+          @@ GApp
+               ( DAst.make ?loc:loc2 @@ GRef (jmeq, None)
+               , [ty; DAst.make ?loc:loc3 @@ GVar id; rt_typ; rt] )
+        in
+        observe
+          (str "computing new type for jmeq : " ++ pr_glob_constr_env env eq');
+        let eq'_as_constr, ctx =
+          Pretyping.understand env (Evd.from_env env) eq'
+        in
+        observe (str " computing new type for jmeq : done");
+        let sigma = Evd.(from_env env) in
+        let new_args =
+          match EConstr.kind sigma eq'_as_constr with
+          | App (_, [|_; _; ty; _|]) ->
+            let ty = Array.to_list (snd (EConstr.destApp sigma ty)) in
+            let ty' = snd (Util.List.chop nparam ty) in
+            List.fold_left2
+              (fun acc var_as_constr arg ->
+                if isRel var_as_constr then
+                  let na =
+                    RelDecl.get_name
+                      (Environ.lookup_rel (destRel var_as_constr) env)
+                  in
+                  match na with
+                  | Anonymous -> acc
+                  | Name id' ->
+                    ( id'
+                    , Detyping.detype Detyping.Now false Id.Set.empty env
+                        (Evd.from_env env) arg )
+                    :: acc
+                else if isVar var_as_constr then
+                  ( destVar var_as_constr
+                  , Detyping.detype Detyping.Now false Id.Set.empty env
+                      (Evd.from_env env) arg )
+                  :: acc
+                else acc)
+              [] arg' ty'
+          | _ -> assert false
+        in
+        let is_in_b = is_free_in id b in
+        let _keep_eq =
+          (not (List.exists (is_free_in id) args))
+          || is_in_b
+          || List.exists (is_free_in id) crossed_types
+        in
+        let new_args =
+          List.fold_left
+            (fun args (id, rt) -> List.map (replace_var_by_term id rt) args)
+            args ((id, rt) :: new_args)
+        in
+        let subst_b = if is_in_b then b else replace_var_by_term id rt b in
+        let new_env =
+          let t', ctx = Pretyping.understand env (Evd.from_env env) eq' in
+          let r = Sorts.Relevant in
+          (* TODO relevance *)
+          EConstr.push_rel (LocalAssum (make_annot n r, t')) env
+        in
+        let new_b, id_to_exclude =
+          rebuild_cons new_env nb_args relname new_args new_crossed_types
+            (depth + 1) subst_b
+        in
+        (mkGProd (n, eq', new_b), id_to_exclude)
+      (* J.F:. keep this comment  it explain how to remove some meaningless equalities
+         if keep_eq then
+         mkGProd(n,t,new_b),id_to_exclude
+         else new_b, Id.Set.add id id_to_exclude
+      *) )
+    | GApp (eq_as_ref, [ty; rt1; rt2])
+      when is_gr eq_as_ref Coqlib.(lib_ref "core.eq.type") && n == Anonymous
+      -> (
+      try
+        let l = decompose_raw_eq env rt1 rt2 in
+        if List.length l > 1 then
+          let new_rt =
+            List.fold_left
+              (fun acc (lhs, rhs) ->
+                mkGProd
+                  ( Anonymous
+                  , mkGApp
+                      ( mkGRef Coqlib.(lib_ref "core.eq.type")
+                      , [mkGHole (); lhs; rhs] )
+                  , acc ))
+              b l
           in
-(* 	  match n with  *)
-(* 	    | Name id when Id.Set.mem id id_to_exclude ->  *)
-(* 		new_b,Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude) *)
-(* 	    | _ -> *)
-          DAst.make @@ GLetTuple(nal,(na,None),t,new_b),
-                Id.Set.filter not_free_in_t (Id.Set.union id_to_exclude id_to_exclude')
-
-        end
-
-    | _ -> mkGApp(mkGVar  relname,args@[rt]),Id.Set.empty
-
+          rebuild_cons env nb_args relname args crossed_types depth new_rt
+        else raise Continue
+      with Continue -> (
+        observe
+          (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
+        let t', ctx = Pretyping.understand env (Evd.from_env env) t in
+        let r = Sorts.Relevant in
+        (* TODO relevance *)
+        let new_env = EConstr.push_rel (LocalAssum (make_annot n r, t')) env in
+        let new_b, id_to_exclude =
+          rebuild_cons new_env nb_args relname args new_crossed_types
+            (depth + 1) b
+        in
+        match n with
+        | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args ->
+          (new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude))
+        | _ -> (mkGProd (n, t, new_b), Id.Set.filter not_free_in_t id_to_exclude) )
+      )
+    | _ -> (
+      observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
+      let t', ctx = Pretyping.understand env (Evd.from_env env) t in
+      let r = Sorts.Relevant in
+      (* TODO relevance *)
+      let new_env = EConstr.push_rel (LocalAssum (make_annot n r, t')) env in
+      let new_b, id_to_exclude =
+        rebuild_cons new_env nb_args relname args new_crossed_types (depth + 1)
+          b
+      in
+      match n with
+      | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args ->
+        (new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude))
+      | _ -> (mkGProd (n, t, new_b), Id.Set.filter not_free_in_t id_to_exclude)
+      ) )
+  | GLambda (n, k, t, b) -> (
+    let not_free_in_t id = not (is_free_in id t) in
+    let new_crossed_types = t :: crossed_types in
+    observe (str "computing new type for lambda : " ++ pr_glob_constr_env env rt);
+    let t', ctx = Pretyping.understand env (Evd.from_env env) t in
+    match n with
+    | Name id ->
+      let r = Sorts.Relevant in
+      (* TODO relevance *)
+      let new_env = EConstr.push_rel (LocalAssum (make_annot n r, t')) env in
+      let new_b, id_to_exclude =
+        rebuild_cons new_env nb_args relname
+          (args @ [mkGVar id])
+          new_crossed_types (depth + 1) b
+      in
+      if Id.Set.mem id id_to_exclude && depth >= nb_args then
+        (new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude))
+      else
+        ( DAst.make @@ GProd (n, k, t, new_b)
+        , Id.Set.filter not_free_in_t id_to_exclude )
+    | _ -> anomaly (Pp.str "Should not have an anonymous function here.")
+    (* We have renamed all the anonymous functions during alpha_renaming phase *)
+    )
+  | GLetIn (n, v, t, b) -> (
+    let t =
+      match t with
+      | None -> v
+      | Some t -> DAst.make ?loc:rt.loc @@ GCast (v, CastConv t)
+    in
+    let not_free_in_t id = not (is_free_in id t) in
+    let evd = Evd.from_env env in
+    let t', ctx = Pretyping.understand env evd t in
+    let evd = Evd.from_ctx ctx in
+    let type_t' = Retyping.get_type_of env evd t' in
+    let t' = EConstr.Unsafe.to_constr t' in
+    let type_t' = EConstr.Unsafe.to_constr type_t' in
+    let new_env =
+      Environ.push_rel (LocalDef (make_annot n Sorts.Relevant, t', type_t')) env
+    in
+    let new_b, id_to_exclude =
+      rebuild_cons new_env nb_args relname args (t :: crossed_types) (depth + 1)
+        b
+    in
+    match n with
+    | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args ->
+      (new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude))
+    | _ ->
+      ( DAst.make @@ GLetIn (n, t, None, new_b)
+      , (* HOPING IT WOULD WORK *)
+        Id.Set.filter not_free_in_t id_to_exclude ) )
+  | GLetTuple (nal, (na, rto), t, b) ->
+    assert (Option.is_empty rto);
+    let not_free_in_t id = not (is_free_in id t) in
+    let new_t, id_to_exclude' =
+      rebuild_cons env nb_args relname args crossed_types depth t
+    in
+    let t', ctx = Pretyping.understand env (Evd.from_env env) new_t in
+    let r = Sorts.Relevant in
+    (* TODO relevance *)
+    let new_env = EConstr.push_rel (LocalAssum (make_annot na r, t')) env in
+    let new_b, id_to_exclude =
+      rebuild_cons new_env nb_args relname args (t :: crossed_types) (depth + 1)
+        b
+    in
+    (* 	  match n with  *)
+    (* 	    | Name id when Id.Set.mem id id_to_exclude ->  *)
+    (* 		new_b,Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude) *)
+    (* 	    | _ -> *)
+    ( DAst.make @@ GLetTuple (nal, (na, None), t, new_b)
+    , Id.Set.filter not_free_in_t (Id.Set.union id_to_exclude id_to_exclude') )
+  | _ -> (mkGApp (mkGVar relname, args @ [rt]), Id.Set.empty)
 
 (* debugging wrapper *)
 let rebuild_cons env nb_args relname args crossed_types rt =
-(*   observennl  (str "rebuild_cons : rt := "++ pr_glob_constr rt ++  *)
-(* 		 str "nb_args := " ++ str (string_of_int nb_args)); *)
-  let res =
-    rebuild_cons env nb_args relname args crossed_types 0 rt
-  in
-(*   observe (str " leads to "++ pr_glob_constr (fst res)); *)
+  (*   observennl  (str "rebuild_cons : rt := "++ pr_glob_constr rt ++  *)
+  (* 		 str "nb_args := " ++ str (string_of_int nb_args)); *)
+  let res = rebuild_cons env nb_args relname args crossed_types 0 rt in
+  (*   observe (str " leads to "++ pr_glob_constr (fst res)); *)
   res
 
-
 (* naive implementation of parameter detection.
 
    A parameter is an argument which is only preceded by parameters and whose
@@ -1230,92 +1172,103 @@ let rebuild_cons env nb_args relname args crossed_types rt =
 
    TODO: Find a valid way to deal with implicit arguments here!
 *)
-let rec compute_cst_params relnames params gt = DAst.with_val (function
-  | GRef _ | GVar _ | GEvar _ | GPatVar _ | GInt _ | GFloat _ -> params
-  | GApp(f,args) ->
-    begin match DAst.get f with
-    | GVar relname' when Id.Set.mem relname' relnames ->
-      compute_cst_params_from_app [] (params,args)
-    | _ ->
-      List.fold_left (compute_cst_params relnames) params (f::args)
-    end
-  | GLambda(_,_,t,b) | GProd(_,_,t,b) | GLetTuple(_,_,t,b) ->
-      let t_params = compute_cst_params relnames params t in
-      compute_cst_params relnames t_params b
-  | GLetIn(_,v,t,b) ->
-      let v_params = compute_cst_params relnames params v in
-      let t_params = Option.fold_left (compute_cst_params relnames) v_params t in
-      compute_cst_params relnames t_params b
-  | GCases _ ->
-      params  (* If there is still cases at this point they can only be
-                 discrimination ones *)
-  | GSort _ -> params
-  | GHole _ -> params
-  | GIf _ | GRec _ | GCast _ ->
-    CErrors.user_err ~hdr:"compute_cst_params" (str "Not handled case")
-  ) gt
-and compute_cst_params_from_app acc (params,rtl) =
-  let is_gid id c = match DAst.get c with GVar id' -> Id.equal id id' | _ -> false in
-  match params,rtl with
-    | _::_,[] -> assert false (* the rel has at least nargs + 1 arguments ! *)
-    | ((Name id,_,None) as param)::params', c::rtl' when is_gid id c ->
-        compute_cst_params_from_app (param::acc) (params',rtl')
-    | _  -> List.rev acc
-
-let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * glob_constr option) list array) csts =
+let rec compute_cst_params relnames params gt =
+  DAst.with_val
+    (function
+      | GRef _ | GVar _ | GEvar _ | GPatVar _ | GInt _ | GFloat _ -> params
+      | GApp (f, args) -> (
+        match DAst.get f with
+        | GVar relname' when Id.Set.mem relname' relnames ->
+          compute_cst_params_from_app [] (params, args)
+        | _ -> List.fold_left (compute_cst_params relnames) params (f :: args) )
+      | GLambda (_, _, t, b) | GProd (_, _, t, b) | GLetTuple (_, _, t, b) ->
+        let t_params = compute_cst_params relnames params t in
+        compute_cst_params relnames t_params b
+      | GLetIn (_, v, t, b) ->
+        let v_params = compute_cst_params relnames params v in
+        let t_params =
+          Option.fold_left (compute_cst_params relnames) v_params t
+        in
+        compute_cst_params relnames t_params b
+      | GCases _ ->
+        params
+        (* If there is still cases at this point they can only be
+           discrimination ones *)
+      | GSort _ -> params
+      | GHole _ -> params
+      | GIf _ | GRec _ | GCast _ ->
+        CErrors.user_err ~hdr:"compute_cst_params" (str "Not handled case"))
+    gt
+
+and compute_cst_params_from_app acc (params, rtl) =
+  let is_gid id c =
+    match DAst.get c with GVar id' -> Id.equal id id' | _ -> false
+  in
+  match (params, rtl) with
+  | _ :: _, [] -> assert false (* the rel has at least nargs + 1 arguments ! *)
+  | ((Name id, _, None) as param) :: params', c :: rtl' when is_gid id c ->
+    compute_cst_params_from_app (param :: acc) (params', rtl')
+  | _ -> List.rev acc
+
+let compute_params_name relnames
+    (args : (Name.t * Glob_term.glob_constr * glob_constr option) list array)
+    csts =
   let rels_params =
     Array.mapi
       (fun i args ->
-         List.fold_left
-           (fun params (_,cst) -> compute_cst_params relnames params cst)
-           args
-           csts.(i)
-      )
+        List.fold_left
+          (fun params (_, cst) -> compute_cst_params relnames params cst)
+          args csts.(i))
       args
   in
   let l = ref [] in
   let _ =
     try
       List.iteri
-        (fun i ((n,nt,typ) as param) ->
-           if Array.for_all
-             (fun l ->
-                let (n',nt',typ') = List.nth l i in
-                Name.equal n n' && glob_constr_eq nt nt' && Option.equal glob_constr_eq typ typ')
-             rels_params
-           then
-             l := param::!l
-        )
+        (fun i ((n, nt, typ) as param) ->
+          if
+            Array.for_all
+              (fun l ->
+                let n', nt', typ' = List.nth l i in
+                Name.equal n n' && glob_constr_eq nt nt'
+                && Option.equal glob_constr_eq typ typ')
+              rels_params
+          then l := param :: !l)
         rels_params.(0)
-    with e when CErrors.noncritical e ->
-      ()
+    with e when CErrors.noncritical e -> ()
   in
   List.rev !l
 
 let rec rebuild_return_type rt =
   let loc = rt.CAst.loc in
   match rt.CAst.v with
-    | Constrexpr.CProdN(n,t') ->
-        CAst.make ?loc @@ Constrexpr.CProdN(n,rebuild_return_type t')
-    | Constrexpr.CLetIn(na,v,t,t') ->
-        CAst.make ?loc @@ Constrexpr.CLetIn(na,v,t,rebuild_return_type t')
-    | _ -> CAst.make ?loc @@ Constrexpr.CProdN([Constrexpr.CLocalAssum ([CAst.make Anonymous],
-                                       Constrexpr.Default Explicit, rt)],
-                             CAst.make @@ Constrexpr.CSort(UAnonymous {rigid=true}))
-
-let do_build_inductive
-      evd (funconstants: pconstant list) (funsargs: (Name.t * glob_constr * glob_constr option) list list)
-      returned_types
-      (rtl:glob_constr list) =
+  | Constrexpr.CProdN (n, t') ->
+    CAst.make ?loc @@ Constrexpr.CProdN (n, rebuild_return_type t')
+  | Constrexpr.CLetIn (na, v, t, t') ->
+    CAst.make ?loc @@ Constrexpr.CLetIn (na, v, t, rebuild_return_type t')
+  | _ ->
+    CAst.make ?loc
+    @@ Constrexpr.CProdN
+         ( [ Constrexpr.CLocalAssum
+               ([CAst.make Anonymous], Constrexpr.Default Explicit, rt) ]
+         , CAst.make @@ Constrexpr.CSort (UAnonymous {rigid = true}) )
+
+let do_build_inductive evd (funconstants : pconstant list)
+    (funsargs : (Name.t * glob_constr * glob_constr option) list list)
+    returned_types (rtl : glob_constr list) =
   let _time1 = System.get_time () in
-  let funnames = List.map (fun c -> Label.to_id (KerName.label (Constant.canonical (fst c)))) funconstants in
+  let funnames =
+    List.map
+      (fun c -> Label.to_id (KerName.label (Constant.canonical (fst c))))
+      funconstants
+  in
   (*   Pp.msgnl (prlist_with_sep fnl Printer.pr_glob_constr rtl); *)
   let funnames_as_set = List.fold_right Id.Set.add funnames Id.Set.empty in
   let funnames = Array.of_list funnames in
   let funsargs = Array.of_list funsargs in
   let returned_types = Array.of_list returned_types in
   (* alpha_renaming of the body to prevent variable capture during manipulation *)
-  let rtl_alpha = List.map (function rt ->  expand_as (alpha_rt [] rt)) rtl in
+  let rtl_alpha = List.map (function rt -> expand_as (alpha_rt [] rt)) rtl in
   let rta = Array.of_list rtl_alpha in
   (*i The next call to mk_rel_id is valid since we are constructing the graph
     Ensures by: obvious
@@ -1324,46 +1277,64 @@ let do_build_inductive
   let relnames_as_set = Array.fold_right Id.Set.add relnames Id.Set.empty in
   (* Construction of the pseudo constructors *)
   let open Context.Named.Declaration in
-  let evd,env =
+  let evd, env =
     Array.fold_right2
-      (fun id (c, u) (evd,env) ->
-       let u = EConstr.EInstance.make u in
-       let evd,t = Typing.type_of env evd (EConstr.mkConstU (c, u)) in
-       let t = EConstr.Unsafe.to_constr t in
-       evd,
-       Environ.push_named (LocalAssum (make_annot id Sorts.Relevant,t))
-                         env
-      )
+      (fun id (c, u) (evd, env) ->
+        let u = EConstr.EInstance.make u in
+        let evd, t = Typing.type_of env evd (EConstr.mkConstU (c, u)) in
+        let t = EConstr.Unsafe.to_constr t in
+        ( evd
+        , Environ.push_named (LocalAssum (make_annot id Sorts.Relevant, t)) env
+        ))
       funnames
       (Array.of_list funconstants)
-      (evd,Global.env ())
+      (evd, Global.env ())
   in
   (* we solve and replace the implicits *)
   let rta =
-    Array.mapi (fun i rt ->
-        let _,t = Typing.type_of env evd (EConstr.of_constr (mkConstU ((Array.of_list funconstants).(i)))) in
-        resolve_and_replace_implicits ~expected_type:(Pretyping.OfType t) env evd rt
-      ) rta
+    Array.mapi
+      (fun i rt ->
+        let _, t =
+          Typing.type_of env evd
+            (EConstr.of_constr (mkConstU (Array.of_list funconstants).(i)))
+        in
+        resolve_and_replace_implicits ~expected_type:(Pretyping.OfType t) env
+          evd rt)
+      rta
   in
   let resa = Array.map (build_entry_lc env evd funnames_as_set []) rta in
   let env_with_graphs =
-    let rel_arity i funargs =  (* Rebuilding arities (with parameters) *)
-      let rel_first_args :(Name.t * Glob_term.glob_constr * Glob_term.glob_constr option ) list  =
+    let rel_arity i funargs =
+      (* Rebuilding arities (with parameters) *)
+      let rel_first_args :
+          (Name.t * Glob_term.glob_constr * Glob_term.glob_constr option) list =
         funargs
       in
       List.fold_right
-        (fun (n,t,typ) acc ->
+        (fun (n, t, typ) acc ->
           match typ with
           | Some typ ->
-             CAst.make @@ Constrexpr.CLetIn((CAst.make n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
-                              Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ),
-                              acc)
+            CAst.make
+            @@ Constrexpr.CLetIn
+                 ( CAst.make n
+                 , with_full_print
+                     (Constrextern.extern_glob_constr Id.Set.empty)
+                     t
+                 , Some
+                     (with_full_print
+                        (Constrextern.extern_glob_constr Id.Set.empty)
+                        typ)
+                 , acc )
           | None ->
-             CAst.make @@ Constrexpr.CProdN
-               ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
-                acc
-               )
-        )
+            CAst.make
+            @@ Constrexpr.CProdN
+                 ( [ Constrexpr.CLocalAssum
+                       ( [CAst.make n]
+                       , Constrexpr_ops.default_binder_kind
+                       , with_full_print
+                           (Constrextern.extern_glob_constr Id.Set.empty)
+                           t ) ]
+                 , acc ))
         rel_first_args
         (rebuild_return_type returned_types.(i))
     in
@@ -1372,67 +1343,87 @@ let do_build_inductive
        Then save the graphs and reset Printing options to their primitive values
     *)
     let rel_arities = Array.mapi rel_arity funsargs in
-    Util.Array.fold_left2 (fun env rel_name rel_ar ->
-        let rex = fst (with_full_print (Constrintern.interp_constr env evd) rel_ar) in
+    Util.Array.fold_left2
+      (fun env rel_name rel_ar ->
+        let rex =
+          fst (with_full_print (Constrintern.interp_constr env evd) rel_ar)
+        in
         let rex = EConstr.Unsafe.to_constr rex in
-        let r = Sorts.Relevant in (* TODO relevance *)
-        Environ.push_named (LocalAssum (make_annot rel_name r,rex)) env) env relnames rel_arities
+        let r = Sorts.Relevant in
+        (* TODO relevance *)
+        Environ.push_named (LocalAssum (make_annot rel_name r, rex)) env)
+      env relnames rel_arities
   in
   (* and of the real constructors*)
   let constr i res =
     List.map
-      (function result (* (args',concl') *) ->
-         let rt = compose_glob_context result.context result.value in
-         let nb_args = List.length funsargs.(i) in
-         (*  with_full_print (fun rt -> Pp.msgnl (str "glob constr " ++ pr_glob_constr rt)) rt; *)
-         fst (
-           rebuild_cons env_with_graphs nb_args relnames.(i)
-             []
-             []
-             rt
-         )
-      )
+      (function
+        | result (* (args',concl') *) ->
+          let rt = compose_glob_context result.context result.value in
+          let nb_args = List.length funsargs.(i) in
+          (*  with_full_print (fun rt -> Pp.msgnl (str "glob constr " ++ pr_glob_constr rt)) rt; *)
+          fst (rebuild_cons env_with_graphs nb_args relnames.(i) [] [] rt))
       res.result
   in
   (* adding names to constructors  *)
- let next_constructor_id = ref (-1) in
+  let next_constructor_id = ref (-1) in
   let mk_constructor_id i =
     incr next_constructor_id;
     (*i The next call to mk_rel_id is valid since we are constructing the graph
       Ensures by: obvious
       i*)
-    Id.of_string ((Id.to_string (mk_rel_id funnames.(i)))^"_"^(string_of_int !next_constructor_id))
+    Id.of_string
+      ( Id.to_string (mk_rel_id funnames.(i))
+      ^ "_"
+      ^ string_of_int !next_constructor_id )
   in
-  let rel_constructors i rt : (Id.t*glob_constr) list =
-    next_constructor_id := (-1);
-    List.map (fun constr -> (mk_constructor_id i),constr) (constr i rt)
+  let rel_constructors i rt : (Id.t * glob_constr) list =
+    next_constructor_id := -1;
+    List.map (fun constr -> (mk_constructor_id i, constr)) (constr i rt)
   in
   let rel_constructors = Array.mapi rel_constructors resa in
   (* Computing the set of parameters if asked *)
-  let rels_params = compute_params_name relnames_as_set funsargs  rel_constructors in
+  let rels_params =
+    compute_params_name relnames_as_set funsargs rel_constructors
+  in
   let nrel_params = List.length rels_params in
-  let rel_constructors = (* Taking into account the parameters in constructors *)
-    Array.map (List.map
-    (fun (id,rt) -> (id,snd (chop_rprod_n nrel_params rt))))
-    rel_constructors
+  let rel_constructors =
+    (* Taking into account the parameters in constructors *)
+    Array.map
+      (List.map (fun (id, rt) -> (id, snd (chop_rprod_n nrel_params rt))))
+      rel_constructors
   in
-  let rel_arity i funargs =  (* Reduilding arities (with parameters) *)
-    let rel_first_args :(Name.t * Glob_term.glob_constr * Glob_term.glob_constr option ) list  =
-      (snd (List.chop nrel_params funargs))
+  let rel_arity i funargs =
+    (* Reduilding arities (with parameters) *)
+    let rel_first_args :
+        (Name.t * Glob_term.glob_constr * Glob_term.glob_constr option) list =
+      snd (List.chop nrel_params funargs)
     in
     List.fold_right
-      (fun (n,t,typ) acc ->
-         match typ with
-         | Some typ ->
-           CAst.make @@ Constrexpr.CLetIn((CAst.make n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
-                              Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ),
-                            acc)
-         | None ->
-           CAst.make @@ Constrexpr.CProdN
-           ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
-            acc
-           )
-      )
+      (fun (n, t, typ) acc ->
+        match typ with
+        | Some typ ->
+          CAst.make
+          @@ Constrexpr.CLetIn
+               ( CAst.make n
+               , with_full_print
+                   (Constrextern.extern_glob_constr Id.Set.empty)
+                   t
+               , Some
+                   (with_full_print
+                      (Constrextern.extern_glob_constr Id.Set.empty)
+                      typ)
+               , acc )
+        | None ->
+          CAst.make
+          @@ Constrexpr.CProdN
+               ( [ Constrexpr.CLocalAssum
+                     ( [CAst.make n]
+                     , Constrexpr_ops.default_binder_kind
+                     , with_full_print
+                         (Constrextern.extern_glob_constr Id.Set.empty)
+                         t ) ]
+               , acc ))
       rel_first_args
       (rebuild_return_type returned_types.(i))
   in
@@ -1443,103 +1434,123 @@ let do_build_inductive
   let rel_arities = Array.mapi rel_arity funsargs in
   let rel_params_ids =
     List.fold_left
-      (fun  acc (na,_,_) ->
-       match na with
-         Anonymous -> acc
-       | Name id -> id::acc
-      )
-      []
-      rels_params
+      (fun acc (na, _, _) ->
+        match na with Anonymous -> acc | Name id -> id :: acc)
+      [] rels_params
   in
   let rel_params =
     List.map
-      (fun (n,t,typ) ->
-         match typ with
-         | Some typ ->
-           Constrexpr.CLocalDef((CAst.make n), Constrextern.extern_glob_constr Id.Set.empty t,
-                                  Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ))
-         | None ->
-         Constrexpr.CLocalAssum
-           ([(CAst.make n)], Constrexpr_ops.default_binder_kind, Constrextern.extern_glob_constr Id.Set.empty t)
-      )
+      (fun (n, t, typ) ->
+        match typ with
+        | Some typ ->
+          Constrexpr.CLocalDef
+            ( CAst.make n
+            , Constrextern.extern_glob_constr Id.Set.empty t
+            , Some
+                (with_full_print
+                   (Constrextern.extern_glob_constr Id.Set.empty)
+                   typ) )
+        | None ->
+          Constrexpr.CLocalAssum
+            ( [CAst.make n]
+            , Constrexpr_ops.default_binder_kind
+            , Constrextern.extern_glob_constr Id.Set.empty t ))
       rels_params
   in
   let ext_rels_constructors =
-    Array.map (List.map
-      (fun (id,t) ->
-         false,((CAst.make id),
-                with_full_print
-                  (Constrextern.extern_glob_type Id.Set.empty) ((* zeta_normalize *) (alpha_rt rel_params_ids t))
-               )
-      ))
-      (rel_constructors)
+    Array.map
+      (List.map (fun (id, t) ->
+           ( false
+           , ( CAst.make id
+             , with_full_print
+                 (Constrextern.extern_glob_type Id.Set.empty)
+                 ((* zeta_normalize *) alpha_rt rel_params_ids t) ) )))
+      rel_constructors
   in
   let rel_ind i ext_rel_constructors =
-    ((CAst.make @@ relnames.(i)),
-    (rel_params,None),
-    Some rel_arities.(i),
-    ext_rel_constructors),[]
+    ( ( CAst.make @@ relnames.(i)
+      , (rel_params, None)
+      , Some rel_arities.(i)
+      , ext_rel_constructors )
+    , [] )
   in
-  let ext_rel_constructors = (Array.mapi rel_ind ext_rels_constructors) in
+  let ext_rel_constructors = Array.mapi rel_ind ext_rels_constructors in
   let rel_inds = Array.to_list ext_rel_constructors in
-(*   let _ =  *)
-(*   Pp.msgnl  (\* observe *\) ( *)
-(*       str "Inductive" ++ spc () ++ *)
-(* 	prlist_with_sep  *)
-(* 	(fun () -> fnl ()++spc () ++ str "with" ++ spc ())  *)
-(* 	(function ((_,id),_,params,ar,constr) ->  *)
-(* 	   Ppconstr.pr_id id ++ spc () ++  *)
-(* 	     Ppconstr.pr_binders params ++ spc () ++ *)
-(* 	     str ":" ++ spc () ++  *)
-(* 	     Ppconstr.pr_lconstr_expr ar ++ spc () ++ str ":=" ++ *)
-(* 	     prlist_with_sep  *)
-(* 	     (fun _ -> fnl () ++ spc () ++ str "|" ++ spc ()) *)
-(* 	     (function (_,((_,id),t)) ->  *)
-(* 		Ppconstr.pr_id id ++ spc () ++ str ":" ++ spc () ++ *)
-(* 		  Ppconstr.pr_lconstr_expr t) *)
-(* 	     constr *)
-(* 	) *)
-(* 	rel_inds *)
-(*     ) *)
-(*   in *)
+  (*   let _ =  *)
+  (*   Pp.msgnl  (\* observe *\) ( *)
+  (*       str "Inductive" ++ spc () ++ *)
+  (* 	prlist_with_sep  *)
+  (* 	(fun () -> fnl ()++spc () ++ str "with" ++ spc ())  *)
+  (* 	(function ((_,id),_,params,ar,constr) ->  *)
+  (* 	   Ppconstr.pr_id id ++ spc () ++  *)
+  (* 	     Ppconstr.pr_binders params ++ spc () ++ *)
+  (* 	     str ":" ++ spc () ++  *)
+  (* 	     Ppconstr.pr_lconstr_expr ar ++ spc () ++ str ":=" ++ *)
+  (* 	     prlist_with_sep  *)
+  (* 	     (fun _ -> fnl () ++ spc () ++ str "|" ++ spc ()) *)
+  (* 	     (function (_,((_,id),t)) ->  *)
+  (* 		Ppconstr.pr_id id ++ spc () ++ str ":" ++ spc () ++ *)
+  (* 		  Ppconstr.pr_lconstr_expr t) *)
+  (* 	     constr *)
+  (* 	) *)
+  (* 	rel_inds *)
+  (*     ) *)
+  (*   in *)
   let _time2 = System.get_time () in
   try
     with_full_print
-      (Flags.silently (ComInductive.do_mutual_inductive ~template:(Some false) None rel_inds ~cumulative:false ~poly:false ~private_ind:false ~uniform:ComInductive.NonUniformParameters))
+      (Flags.silently
+         (ComInductive.do_mutual_inductive ~template:(Some false) None rel_inds
+            ~cumulative:false ~poly:false ~private_ind:false
+            ~uniform:ComInductive.NonUniformParameters))
       Declarations.Finite
   with
-    | UserError(s,msg) as e ->
-        let _time3 = System.get_time () in
-(* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
-        let repacked_rel_inds =
-          List.map  (fun ((a , b , c , l),ntn) -> ((false,(a,None)) , b, c, Vernacexpr.Constructors l),ntn )
-                          rel_inds
-        in
-        let msg =
-          str "while trying to define"++ spc () ++
-            Ppvernac.pr_vernac (CAst.make Vernacexpr.{ control = []; attrs = []; expr = VernacInductive(Vernacexpr.Inductive_kw,repacked_rel_inds)})
-            ++ fnl () ++
-            msg
-        in
-        observe (msg);
-        raise e
-    | reraise ->
-        let _time3 = System.get_time () in
-(* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
-        let repacked_rel_inds =
-          List.map  (fun ((a , b , c , l),ntn) -> ((false,(a,None)) , b, c, Vernacexpr.Constructors l),ntn )
-                          rel_inds
-        in
-        let msg =
-          str "while trying to define"++ spc () ++
-            Ppvernac.pr_vernac (CAst.make @@ Vernacexpr.{ control = []; attrs = []; expr = VernacInductive(Vernacexpr.Inductive_kw,repacked_rel_inds)})
-            ++ fnl () ++
-            CErrors.print reraise
-        in
-        observe msg;
-        raise reraise
-
-
+  | UserError (s, msg) as e ->
+    let _time3 = System.get_time () in
+    (* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
+    let repacked_rel_inds =
+      List.map
+        (fun ((a, b, c, l), ntn) ->
+          (((false, (a, None)), b, c, Vernacexpr.Constructors l), ntn))
+        rel_inds
+    in
+    let msg =
+      str "while trying to define"
+      ++ spc ()
+      ++ Ppvernac.pr_vernac
+           (CAst.make
+              Vernacexpr.
+                { control = []
+                ; attrs = []
+                ; expr =
+                    VernacInductive (Vernacexpr.Inductive_kw, repacked_rel_inds)
+                })
+      ++ fnl () ++ msg
+    in
+    observe msg; raise e
+  | reraise ->
+    let _time3 = System.get_time () in
+    (* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
+    let repacked_rel_inds =
+      List.map
+        (fun ((a, b, c, l), ntn) ->
+          (((false, (a, None)), b, c, Vernacexpr.Constructors l), ntn))
+        rel_inds
+    in
+    let msg =
+      str "while trying to define"
+      ++ spc ()
+      ++ Ppvernac.pr_vernac
+           ( CAst.make
+           @@ Vernacexpr.
+                { control = []
+                ; attrs = []
+                ; expr =
+                    VernacInductive (Vernacexpr.Inductive_kw, repacked_rel_inds)
+                } )
+      ++ fnl () ++ CErrors.print reraise
+    in
+    observe msg; raise reraise
 
 let build_inductive evd funconstants funsargs returned_types rtl =
   let pu = !Detyping.print_universes in
diff --git a/plugins/funind/glob_term_to_relation.mli b/plugins/funind/glob_term_to_relation.mli
index a29e5dff23..8dfeafe7c9 100644
--- a/plugins/funind/glob_term_to_relation.mli
+++ b/plugins/funind/glob_term_to_relation.mli
@@ -7,13 +7,15 @@ open Names
 *)
 
 val build_inductive :
-(*  (ModPath.t * DirPath.t) option ->
-  Id.t list -> (* The list of function name *)
- *)
-  Evd.evar_map ->
-  Constr.pconstant list ->
-  (Name.t*Glob_term.glob_constr*Glob_term.glob_constr option) list list -> (* The list of function args *)
-  Constrexpr.constr_expr list -> (* The list of function returned type *)
-  Glob_term.glob_constr list -> (* the list of body *)
-  unit
-
+     (* (ModPath.t * DirPath.t) option ->
+        Id.t list -> (* The list of function name *)
+     *)
+     Evd.evar_map
+  -> Constr.pconstant list
+  -> (Name.t * Glob_term.glob_constr * Glob_term.glob_constr option) list list
+  -> (* The list of function args *)
+     Constrexpr.constr_expr list
+  -> (* The list of function returned type *)
+     Glob_term.glob_constr list
+  -> (* the list of body *)
+     unit
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 9fa72919ce..5026120849 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -18,14 +18,17 @@ open Names
    Some basic functions to rebuild glob_constr
    In each of them the location is Loc.ghost
 *)
-let mkGRef ref          = DAst.make @@ GRef(ref,None)
-let mkGVar id           = DAst.make @@ GVar(id)
-let mkGApp(rt,rtl)      = DAst.make @@ GApp(rt,rtl)
-let mkGLambda(n,t,b)    = DAst.make @@ GLambda(n,Explicit,t,b)
-let mkGProd(n,t,b)      = DAst.make @@ GProd(n,Explicit,t,b)
-let mkGLetIn(n,b,t,c)   = DAst.make @@ GLetIn(n,b,t,c)
-let mkGCases(rto,l,brl) = DAst.make @@ GCases(RegularStyle,rto,l,brl)
-let mkGHole ()          = DAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Namegen.IntroAnonymous,None)
+let mkGRef ref = DAst.make @@ GRef (ref, None)
+let mkGVar id = DAst.make @@ GVar id
+let mkGApp (rt, rtl) = DAst.make @@ GApp (rt, rtl)
+let mkGLambda (n, t, b) = DAst.make @@ GLambda (n, Explicit, t, b)
+let mkGProd (n, t, b) = DAst.make @@ GProd (n, Explicit, t, b)
+let mkGLetIn (n, b, t, c) = DAst.make @@ GLetIn (n, b, t, c)
+let mkGCases (rto, l, brl) = DAst.make @@ GCases (RegularStyle, rto, l, brl)
+
+let mkGHole () =
+  DAst.make
+  @@ GHole (Evar_kinds.BinderType Anonymous, Namegen.IntroAnonymous, None)
 
 (*
   Some basic functions to decompose glob_constrs
@@ -33,532 +36,483 @@ let mkGHole ()          = DAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Nam
 *)
 let glob_decompose_app =
   let rec decompose_rapp acc rt =
-(*     msgnl (str "glob_decompose_app on : "++ Printer.pr_glob_constr rt); *)
+    (*     msgnl (str "glob_decompose_app on : "++ Printer.pr_glob_constr rt); *)
     match DAst.get rt with
-    | GApp(rt,rtl) ->
-        decompose_rapp (List.fold_left (fun y x -> x::y) acc rtl) rt
-    | _ -> rt,List.rev acc
+    | GApp (rt, rtl) ->
+      decompose_rapp (List.fold_left (fun y x -> x :: y) acc rtl) rt
+    | _ -> (rt, List.rev acc)
   in
   decompose_rapp []
 
-
-
-
 (* [glob_make_eq t1 t2] build the glob_constr corresponding to [t2 = t1] *)
-let glob_make_eq ?(typ= mkGHole ()) t1 t2  =
-  mkGApp(mkGRef (Coqlib.lib_ref "core.eq.type"),[typ;t2;t1])
+let glob_make_eq ?(typ = mkGHole ()) t1 t2 =
+  mkGApp (mkGRef (Coqlib.lib_ref "core.eq.type"), [typ; t2; t1])
 
 (* [glob_make_neq t1 t2] build the glob_constr corresponding to [t1 <> t2] *)
 let glob_make_neq t1 t2 =
-  mkGApp(mkGRef (Coqlib.lib_ref "core.not.type"),[glob_make_eq t1 t2])
+  mkGApp (mkGRef (Coqlib.lib_ref "core.not.type"), [glob_make_eq t1 t2])
 
 let remove_name_from_mapping mapping na =
-  match na with
-    | Anonymous -> mapping
-    | Name id -> Id.Map.remove id mapping
+  match na with Anonymous -> mapping | Name id -> Id.Map.remove id mapping
 
 let change_vars =
   let rec change_vars mapping rt =
-    DAst.map_with_loc (fun ?loc -> function
-      | GRef _ as x -> x
-      | GVar id ->
-          let new_id =
-            try
-              Id.Map.find id mapping
-            with Not_found -> id
+    DAst.map_with_loc
+      (fun ?loc -> function GRef _ as x -> x
+        | GVar id ->
+          let new_id = try Id.Map.find id mapping with Not_found -> id in
+          GVar new_id | GEvar _ as x -> x | GPatVar _ as x -> x
+        | GApp (rt', rtl) ->
+          GApp (change_vars mapping rt', List.map (change_vars mapping) rtl)
+        | GLambda (name, k, t, b) ->
+          GLambda
+            ( name
+            , k
+            , change_vars mapping t
+            , change_vars (remove_name_from_mapping mapping name) b )
+        | GProd (name, k, t, b) ->
+          GProd
+            ( name
+            , k
+            , change_vars mapping t
+            , change_vars (remove_name_from_mapping mapping name) b )
+        | GLetIn (name, def, typ, b) ->
+          GLetIn
+            ( name
+            , change_vars mapping def
+            , Option.map (change_vars mapping) typ
+            , change_vars (remove_name_from_mapping mapping name) b )
+        | GLetTuple (nal, (na, rto), b, e) ->
+          let new_mapping =
+            List.fold_left remove_name_from_mapping mapping nal
           in
-          GVar(new_id)
-      | GEvar _ as x   -> x
-      | GPatVar _ as x -> x
-      | GApp(rt',rtl) ->
-          GApp(change_vars mapping rt',
-               List.map (change_vars mapping) rtl
-              )
-      | GLambda(name,k,t,b) ->
-          GLambda(name,
-                  k,
-                  change_vars mapping t,
-                  change_vars (remove_name_from_mapping mapping name) b
-                 )
-      | GProd(name,k,t,b) ->
-          GProd(  name,
-                  k,
-                  change_vars mapping t,
-                  change_vars (remove_name_from_mapping mapping name) b
-                 )
-      | GLetIn(name,def,typ,b) ->
-          GLetIn(name,
-                 change_vars mapping def,
-                 Option.map (change_vars mapping) typ,
-                 change_vars (remove_name_from_mapping mapping name) b
-                )
-      | GLetTuple(nal,(na,rto),b,e) ->
-          let new_mapping = List.fold_left remove_name_from_mapping mapping nal in
-          GLetTuple(nal,
-                    (na, Option.map (change_vars mapping) rto),
-                    change_vars mapping b,
-                    change_vars new_mapping e
-                   )
-      | GCases(sty,infos,el,brl) ->
-          GCases(sty,
-                 infos,
-                 List.map (fun (e,x) -> (change_vars mapping e,x)) el,
-                 List.map (change_vars_br mapping) brl
-                )
-      | GIf(b,(na,e_option),lhs,rhs) ->
-          GIf(change_vars mapping b,
-              (na,Option.map (change_vars mapping) e_option),
-              change_vars mapping lhs,
-              change_vars mapping rhs
-             )
-      | GRec _ -> user_err ?loc Pp.(str "Local (co)fixes are not supported")
-      | GSort _ as x -> x
-      | GHole _ as x -> x
-      | GInt _ as x -> x
-      | GFloat _ as x -> x
-      | GCast(b,c) ->
-          GCast(change_vars mapping b,
-                Glob_ops.map_cast_type (change_vars mapping) c)
-      ) rt
-  and change_vars_br mapping ({CAst.loc;v=(idl,patl,res)} as br) =
+          GLetTuple
+            ( nal
+            , (na, Option.map (change_vars mapping) rto)
+            , change_vars mapping b
+            , change_vars new_mapping e )
+        | GCases (sty, infos, el, brl) ->
+          GCases
+            ( sty
+            , infos
+            , List.map (fun (e, x) -> (change_vars mapping e, x)) el
+            , List.map (change_vars_br mapping) brl )
+        | GIf (b, (na, e_option), lhs, rhs) ->
+          GIf
+            ( change_vars mapping b
+            , (na, Option.map (change_vars mapping) e_option)
+            , change_vars mapping lhs
+            , change_vars mapping rhs )
+        | GRec _ -> user_err ?loc Pp.(str "Local (co)fixes are not supported")
+        | GSort _ as x -> x | GHole _ as x -> x | GInt _ as x -> x
+        | GFloat _ as x -> x
+        | GCast (b, c) ->
+          GCast
+            ( change_vars mapping b
+            , Glob_ops.map_cast_type (change_vars mapping) c ))
+      rt
+  and change_vars_br mapping ({CAst.loc; v = idl, patl, res} as br) =
     let new_mapping = List.fold_right Id.Map.remove idl mapping in
-    if Id.Map.is_empty new_mapping
-    then br
-    else CAst.make ?loc (idl,patl,change_vars new_mapping res)
+    if Id.Map.is_empty new_mapping then br
+    else CAst.make ?loc (idl, patl, change_vars new_mapping res)
   in
   change_vars
 
-
-
 let rec alpha_pat excluded pat =
   let loc = pat.CAst.loc in
   match DAst.get pat with
-    | PatVar Anonymous ->
-        let new_id = Indfun_common.fresh_id excluded "_x" in
-        (DAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),Id.Map.empty
-    | PatVar(Name id) ->
-        if Id.List.mem id excluded
-        then
-          let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-          (DAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),
-        (Id.Map.add id new_id Id.Map.empty)
-        else pat, excluded,Id.Map.empty
-    | PatCstr(constr,patl,na) ->
-        let new_na,new_excluded,map =
-          match na with
-            | Name id when Id.List.mem id excluded ->
-                let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-                Name new_id,new_id::excluded, Id.Map.add id new_id Id.Map.empty
-            | _ -> na,excluded,Id.Map.empty
-        in
-        let new_patl,new_excluded,new_map =
-          List.fold_left
-            (fun (patl,excluded,map) pat ->
-               let new_pat,new_excluded,new_map = alpha_pat excluded pat in
-               (new_pat::patl,new_excluded,Id.Map.fold Id.Map.add new_map map)
-            )
-            ([],new_excluded,map)
-            patl
-        in
-        (DAst.make ?loc @@ PatCstr(constr,List.rev new_patl,new_na)),new_excluded,new_map
-
-let alpha_patl excluded patl  =
-  let patl,new_excluded,map =
+  | PatVar Anonymous ->
+    let new_id = Indfun_common.fresh_id excluded "_x" in
+    (DAst.make ?loc @@ PatVar (Name new_id), new_id :: excluded, Id.Map.empty)
+  | PatVar (Name id) ->
+    if Id.List.mem id excluded then
+      let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+      ( DAst.make ?loc @@ PatVar (Name new_id)
+      , new_id :: excluded
+      , Id.Map.add id new_id Id.Map.empty )
+    else (pat, excluded, Id.Map.empty)
+  | PatCstr (constr, patl, na) ->
+    let new_na, new_excluded, map =
+      match na with
+      | Name id when Id.List.mem id excluded ->
+        let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+        (Name new_id, new_id :: excluded, Id.Map.add id new_id Id.Map.empty)
+      | _ -> (na, excluded, Id.Map.empty)
+    in
+    let new_patl, new_excluded, new_map =
+      List.fold_left
+        (fun (patl, excluded, map) pat ->
+          let new_pat, new_excluded, new_map = alpha_pat excluded pat in
+          (new_pat :: patl, new_excluded, Id.Map.fold Id.Map.add new_map map))
+        ([], new_excluded, map) patl
+    in
+    ( DAst.make ?loc @@ PatCstr (constr, List.rev new_patl, new_na)
+    , new_excluded
+    , new_map )
+
+let alpha_patl excluded patl =
+  let patl, new_excluded, map =
     List.fold_left
-      (fun (patl,excluded,map) pat ->
-         let new_pat,new_excluded,new_map = alpha_pat excluded pat in
-         new_pat::patl,new_excluded,(Id.Map.fold Id.Map.add new_map map)
-      )
-      ([],excluded,Id.Map.empty)
+      (fun (patl, excluded, map) pat ->
+        let new_pat, new_excluded, new_map = alpha_pat excluded pat in
+        (new_pat :: patl, new_excluded, Id.Map.fold Id.Map.add new_map map))
+      ([], excluded, Id.Map.empty)
       patl
   in
-  (List.rev patl,new_excluded,map)
-
-
-
+  (List.rev patl, new_excluded, map)
 
 let raw_get_pattern_id pat acc =
   let rec get_pattern_id pat =
     match DAst.get pat with
-      | PatVar(Anonymous) -> assert false
-      | PatVar(Name id) ->
-          [id]
-      | PatCstr(constr,patternl,_) ->
-          List.fold_right
-          (fun pat idl ->
-             let idl' = get_pattern_id pat in
-             idl'@idl
-          )
-            patternl
-            []
+    | PatVar Anonymous -> assert false
+    | PatVar (Name id) -> [id]
+    | PatCstr (constr, patternl, _) ->
+      List.fold_right
+        (fun pat idl ->
+          let idl' = get_pattern_id pat in
+          idl' @ idl)
+        patternl []
   in
-  (get_pattern_id pat)@acc
+  get_pattern_id pat @ acc
 
 let get_pattern_id pat = raw_get_pattern_id pat []
 
 let rec alpha_rt excluded rt =
   let loc = rt.CAst.loc in
-  let new_rt = DAst.make ?loc @@
+  let new_rt =
+    DAst.make ?loc
+    @@
     match DAst.get rt with
-      | GRef _ | GVar _ | GEvar _ | GPatVar _ as rt -> rt
-      | GLambda(Anonymous,k,t,b) ->
-          let new_id = Namegen.next_ident_away (Id.of_string "_x") (Id.Set.of_list excluded) in
-          let new_excluded = new_id :: excluded in
-          let new_t = alpha_rt new_excluded t in
-          let new_b = alpha_rt new_excluded b in
-          GLambda(Name new_id,k,new_t,new_b)
-      | GProd(Anonymous,k,t,b) ->
-        let new_t = alpha_rt excluded t in
-        let new_b = alpha_rt excluded b in
-        GProd(Anonymous,k,new_t,new_b)
-    | GLetIn(Anonymous,b,t,c) ->
-        let new_b = alpha_rt excluded b in
-        let new_t = Option.map (alpha_rt excluded) t in
-        let new_c = alpha_rt excluded c in
-        GLetIn(Anonymous,new_b,new_t,new_c)
-    | GLambda(Name id,k,t,b) ->
-        let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-        let t,b =
-          if Id.equal new_id id
-          then t, b
-          else
-            let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
-            (t,replace b)
-        in
-        let new_excluded = new_id::excluded in
-        let new_t = alpha_rt new_excluded t in
-        let new_b = alpha_rt new_excluded b in
-        GLambda(Name new_id,k,new_t,new_b)
-    | GProd(Name id,k,t,b) ->
-        let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-        let new_excluded = new_id::excluded in
-        let t,b =
-          if Id.equal new_id id
-          then t,b
-          else
-            let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
-            (t,replace b)
-        in
-        let new_t = alpha_rt new_excluded t in
-        let new_b = alpha_rt new_excluded b in
-        GProd(Name new_id,k,new_t,new_b)
-    | GLetIn(Name id,b,t,c) ->
-        let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-        let c =
-          if Id.equal new_id id then c
-          else change_vars (Id.Map.add id new_id Id.Map.empty) c
-        in
-        let new_excluded = new_id::excluded in
-        let new_b = alpha_rt new_excluded b in
-        let new_t = Option.map (alpha_rt new_excluded) t in
-        let new_c = alpha_rt new_excluded c in
-        GLetIn(Name new_id,new_b,new_t,new_c)
-
-    | GLetTuple(nal,(na,rto),t,b) ->
-        let rev_new_nal,new_excluded,mapping =
-          List.fold_left
-            (fun (nal,excluded,mapping) na ->
-               match na with
-                 | Anonymous -> (na::nal,excluded,mapping)
-                 | Name id ->
-                     let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
-                     if Id.equal new_id id
-                     then
-                       na::nal,id::excluded,mapping
-                     else
-                       (Name new_id)::nal,id::excluded,(Id.Map.add id new_id mapping)
-            )
-            ([],excluded,Id.Map.empty)
-            nal
-        in
-        let new_nal = List.rev rev_new_nal in
-        let new_rto,new_t,new_b =
-          if Id.Map.is_empty mapping
-          then rto,t,b
-          else let replace = change_vars mapping in
-          (Option.map replace rto, t,replace b)
-        in
-        let new_t = alpha_rt new_excluded new_t in
-        let new_b = alpha_rt new_excluded new_b in
-        let new_rto = Option.map (alpha_rt new_excluded) new_rto  in
-        GLetTuple(new_nal,(na,new_rto),new_t,new_b)
-    | GCases(sty,infos,el,brl) ->
-        let new_el =
-          List.map (function (rt,i) -> alpha_rt excluded rt, i) el
-        in
-        GCases(sty,infos,new_el,List.map (alpha_br excluded) brl)
-    | GIf(b,(na,e_o),lhs,rhs) ->
-        GIf(alpha_rt excluded b,
-            (na,Option.map (alpha_rt excluded) e_o),
-            alpha_rt excluded lhs,
-            alpha_rt excluded rhs
-           )
+    | (GRef _ | GVar _ | GEvar _ | GPatVar _) as rt -> rt
+    | GLambda (Anonymous, k, t, b) ->
+      let new_id =
+        Namegen.next_ident_away (Id.of_string "_x") (Id.Set.of_list excluded)
+      in
+      let new_excluded = new_id :: excluded in
+      let new_t = alpha_rt new_excluded t in
+      let new_b = alpha_rt new_excluded b in
+      GLambda (Name new_id, k, new_t, new_b)
+    | GProd (Anonymous, k, t, b) ->
+      let new_t = alpha_rt excluded t in
+      let new_b = alpha_rt excluded b in
+      GProd (Anonymous, k, new_t, new_b)
+    | GLetIn (Anonymous, b, t, c) ->
+      let new_b = alpha_rt excluded b in
+      let new_t = Option.map (alpha_rt excluded) t in
+      let new_c = alpha_rt excluded c in
+      GLetIn (Anonymous, new_b, new_t, new_c)
+    | GLambda (Name id, k, t, b) ->
+      let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+      let t, b =
+        if Id.equal new_id id then (t, b)
+        else
+          let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
+          (t, replace b)
+      in
+      let new_excluded = new_id :: excluded in
+      let new_t = alpha_rt new_excluded t in
+      let new_b = alpha_rt new_excluded b in
+      GLambda (Name new_id, k, new_t, new_b)
+    | GProd (Name id, k, t, b) ->
+      let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+      let new_excluded = new_id :: excluded in
+      let t, b =
+        if Id.equal new_id id then (t, b)
+        else
+          let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
+          (t, replace b)
+      in
+      let new_t = alpha_rt new_excluded t in
+      let new_b = alpha_rt new_excluded b in
+      GProd (Name new_id, k, new_t, new_b)
+    | GLetIn (Name id, b, t, c) ->
+      let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+      let c =
+        if Id.equal new_id id then c
+        else change_vars (Id.Map.add id new_id Id.Map.empty) c
+      in
+      let new_excluded = new_id :: excluded in
+      let new_b = alpha_rt new_excluded b in
+      let new_t = Option.map (alpha_rt new_excluded) t in
+      let new_c = alpha_rt new_excluded c in
+      GLetIn (Name new_id, new_b, new_t, new_c)
+    | GLetTuple (nal, (na, rto), t, b) ->
+      let rev_new_nal, new_excluded, mapping =
+        List.fold_left
+          (fun (nal, excluded, mapping) na ->
+            match na with
+            | Anonymous -> (na :: nal, excluded, mapping)
+            | Name id ->
+              let new_id =
+                Namegen.next_ident_away id (Id.Set.of_list excluded)
+              in
+              if Id.equal new_id id then (na :: nal, id :: excluded, mapping)
+              else
+                ( Name new_id :: nal
+                , id :: excluded
+                , Id.Map.add id new_id mapping ))
+          ([], excluded, Id.Map.empty)
+          nal
+      in
+      let new_nal = List.rev rev_new_nal in
+      let new_rto, new_t, new_b =
+        if Id.Map.is_empty mapping then (rto, t, b)
+        else
+          let replace = change_vars mapping in
+          (Option.map replace rto, t, replace b)
+      in
+      let new_t = alpha_rt new_excluded new_t in
+      let new_b = alpha_rt new_excluded new_b in
+      let new_rto = Option.map (alpha_rt new_excluded) new_rto in
+      GLetTuple (new_nal, (na, new_rto), new_t, new_b)
+    | GCases (sty, infos, el, brl) ->
+      let new_el =
+        List.map (function rt, i -> (alpha_rt excluded rt, i)) el
+      in
+      GCases (sty, infos, new_el, List.map (alpha_br excluded) brl)
+    | GIf (b, (na, e_o), lhs, rhs) ->
+      GIf
+        ( alpha_rt excluded b
+        , (na, Option.map (alpha_rt excluded) e_o)
+        , alpha_rt excluded lhs
+        , alpha_rt excluded rhs )
     | GRec _ -> user_err Pp.(str "Not handled GRec")
-    | GSort _
-    | GInt _
-    | GFloat _
-    | GHole _ as rt -> rt
-    | GCast (b,c) ->
-        GCast(alpha_rt excluded b,
-              Glob_ops.map_cast_type (alpha_rt excluded) c)
-    | GApp(f,args) ->
-        GApp(alpha_rt excluded f,
-             List.map (alpha_rt excluded) args
-            )
+    | (GSort _ | GInt _ | GFloat _ | GHole _) as rt -> rt
+    | GCast (b, c) ->
+      GCast (alpha_rt excluded b, Glob_ops.map_cast_type (alpha_rt excluded) c)
+    | GApp (f, args) ->
+      GApp (alpha_rt excluded f, List.map (alpha_rt excluded) args)
   in
   new_rt
 
-and alpha_br excluded {CAst.loc;v=(ids,patl,res)} =
-  let new_patl,new_excluded,mapping = alpha_patl excluded patl in
+and alpha_br excluded {CAst.loc; v = ids, patl, res} =
+  let new_patl, new_excluded, mapping = alpha_patl excluded patl in
   let new_ids = List.fold_right raw_get_pattern_id new_patl [] in
-  let new_excluded = new_ids@excluded in
+  let new_excluded = new_ids @ excluded in
   let renamed_res = change_vars mapping res in
   let new_res = alpha_rt new_excluded renamed_res in
-  CAst.make ?loc (new_ids,new_patl,new_res)
+  CAst.make ?loc (new_ids, new_patl, new_res)
 
 (*
    [is_free_in id rt] checks if [id] is a free variable in [rt]
 *)
 let is_free_in id =
-  let rec is_free_in x = DAst.with_loc_val (fun ?loc -> function
-    | GRef _ ->  false
-    | GVar id' -> Id.compare id' id == 0
-    | GEvar _ -> false
-    | GPatVar _ -> false
-    | GApp(rt,rtl) -> List.exists is_free_in (rt::rtl)
-    | GLambda(n,_,t,b) | GProd(n,_,t,b) ->
-        let check_in_b =
-          match n with
-            | Name id' -> not (Id.equal id' id)
-            | _ -> true
-        in
-        is_free_in t || (check_in_b && is_free_in b)
-    | GLetIn(n,b,t,c) ->
-        let check_in_c =
-          match n with
-            | Name id' -> not (Id.equal id' id)
-            | _ -> true
-        in
-        is_free_in b || Option.cata is_free_in true t || (check_in_c && is_free_in c)
-    | GCases(_,_,el,brl) ->
-        (List.exists (fun (e,_) -> is_free_in e) el) ||
-          List.exists is_free_in_br brl
-    | GLetTuple(nal,_,b,t) ->
-        let check_in_nal =
-          not (List.exists (function Name id' -> Id.equal id' id | _ -> false) nal)
-        in
-        is_free_in t  || (check_in_nal && is_free_in b)
-
-    | GIf(cond,_,br1,br2) ->
-        is_free_in cond || is_free_in br1 || is_free_in br2
-    | GRec _  -> user_err Pp.(str "Not handled GRec")
-    | GSort _ -> false
-    | GHole _ -> false
-    | GCast (b,(CastConv t|CastVM t|CastNative t)) -> is_free_in b || is_free_in t
-    | GCast (b,CastCoerce) -> is_free_in b
-    | GInt _ | GFloat _ -> false
-    ) x
-  and is_free_in_br {CAst.v=(ids,_,rt)} =
+  let rec is_free_in x =
+    DAst.with_loc_val
+      (fun ?loc -> function GRef _ -> false | GVar id' -> Id.compare id' id == 0
+        | GEvar _ -> false | GPatVar _ -> false
+        | GApp (rt, rtl) -> List.exists is_free_in (rt :: rtl)
+        | GLambda (n, _, t, b) | GProd (n, _, t, b) ->
+          let check_in_b =
+            match n with Name id' -> not (Id.equal id' id) | _ -> true
+          in
+          is_free_in t || (check_in_b && is_free_in b)
+        | GLetIn (n, b, t, c) ->
+          let check_in_c =
+            match n with Name id' -> not (Id.equal id' id) | _ -> true
+          in
+          is_free_in b
+          || Option.cata is_free_in true t
+          || (check_in_c && is_free_in c)
+        | GCases (_, _, el, brl) ->
+          List.exists (fun (e, _) -> is_free_in e) el
+          || List.exists is_free_in_br brl
+        | GLetTuple (nal, _, b, t) ->
+          let check_in_nal =
+            not
+              (List.exists
+                 (function Name id' -> Id.equal id' id | _ -> false)
+                 nal)
+          in
+          is_free_in t || (check_in_nal && is_free_in b)
+        | GIf (cond, _, br1, br2) ->
+          is_free_in cond || is_free_in br1 || is_free_in br2
+        | GRec _ -> user_err Pp.(str "Not handled GRec") | GSort _ -> false
+        | GHole _ -> false
+        | GCast (b, (CastConv t | CastVM t | CastNative t)) ->
+          is_free_in b || is_free_in t | GCast (b, CastCoerce) -> is_free_in b
+        | GInt _ | GFloat _ -> false)
+      x
+  and is_free_in_br {CAst.v = ids, _, rt} =
     (not (Id.List.mem id ids)) && is_free_in rt
   in
   is_free_in
 
-
-
-let rec pattern_to_term pt = DAst.with_val (function
-  | PatVar Anonymous -> assert false
-  | PatVar(Name id) ->
-        mkGVar id
-  | PatCstr(constr,patternl,_) ->
-      let cst_narg =
-        Inductiveops.constructor_nallargs
-          (Global.env ())
-          constr
-      in
-      let implicit_args =
-        Array.to_list
-          (Array.init
-             (cst_narg - List.length patternl)
-             (fun _ -> mkGHole ())
-          )
-      in
-      let patl_as_term =
-        List.map pattern_to_term patternl
-      in
-      mkGApp(mkGRef(GlobRef.ConstructRef constr),
-             implicit_args@patl_as_term
-            )
-  ) pt
-
+let rec pattern_to_term pt =
+  DAst.with_val
+    (function
+      | PatVar Anonymous -> assert false
+      | PatVar (Name id) -> mkGVar id
+      | PatCstr (constr, patternl, _) ->
+        let cst_narg =
+          Inductiveops.constructor_nallargs (Global.env ()) constr
+        in
+        let implicit_args =
+          Array.to_list
+            (Array.init (cst_narg - List.length patternl) (fun _ -> mkGHole ()))
+        in
+        let patl_as_term = List.map pattern_to_term patternl in
+        mkGApp
+          (mkGRef (GlobRef.ConstructRef constr), implicit_args @ patl_as_term))
+    pt
 
 let replace_var_by_term x_id term =
-  let rec replace_var_by_pattern x = DAst.map (function
-      | GVar id when Id.compare id x_id == 0 -> DAst.get term
-      | GRef _
-      | GVar _
-      | GEvar _
-      | GPatVar _ as rt -> rt
-      | GApp(rt',rtl) ->
-          GApp(replace_var_by_pattern rt',
-               List.map replace_var_by_pattern rtl
-              )
-      | GLambda(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
-      | GLambda(name,k,t,b) ->
-          GLambda(name,
-                  k,
-                  replace_var_by_pattern t,
-                  replace_var_by_pattern b
-                 )
-      | GProd(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
-      | GProd(name,k,t,b) ->
-          GProd(  name,
-                  k,
-                  replace_var_by_pattern t,
-                  replace_var_by_pattern b
-                 )
-      | GLetIn(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
-      | GLetIn(name,def,typ,b) ->
-          GLetIn(name,
-                 replace_var_by_pattern def,
-                 Option.map (replace_var_by_pattern) typ,
-                 replace_var_by_pattern b
-                )
-      | GLetTuple(nal,_,_,_) as rt
-          when List.exists (function Name id -> Id.equal id x_id | _ -> false) nal  ->
+  let rec replace_var_by_pattern x =
+    DAst.map
+      (function
+        | GVar id when Id.compare id x_id == 0 -> DAst.get term
+        | (GRef _ | GVar _ | GEvar _ | GPatVar _) as rt -> rt
+        | GApp (rt', rtl) ->
+          GApp (replace_var_by_pattern rt', List.map replace_var_by_pattern rtl)
+        | GLambda (Name id, _, _, _) as rt when Id.compare id x_id == 0 -> rt
+        | GLambda (name, k, t, b) ->
+          GLambda (name, k, replace_var_by_pattern t, replace_var_by_pattern b)
+        | GProd (Name id, _, _, _) as rt when Id.compare id x_id == 0 -> rt
+        | GProd (name, k, t, b) ->
+          GProd (name, k, replace_var_by_pattern t, replace_var_by_pattern b)
+        | GLetIn (Name id, _, _, _) as rt when Id.compare id x_id == 0 -> rt
+        | GLetIn (name, def, typ, b) ->
+          GLetIn
+            ( name
+            , replace_var_by_pattern def
+            , Option.map replace_var_by_pattern typ
+            , replace_var_by_pattern b )
+        | GLetTuple (nal, _, _, _) as rt
+          when List.exists
+                 (function Name id -> Id.equal id x_id | _ -> false)
+                 nal ->
           rt
-      | GLetTuple(nal,(na,rto),def,b) ->
-          GLetTuple(nal,
-                    (na,Option.map replace_var_by_pattern rto),
-                    replace_var_by_pattern def,
-                    replace_var_by_pattern b
-                   )
-      | GCases(sty,infos,el,brl) ->
-          GCases(sty,
-                 infos,
-                 List.map (fun (e,x) -> (replace_var_by_pattern e,x)) el,
-                 List.map replace_var_by_pattern_br brl
-                )
-      | GIf(b,(na,e_option),lhs,rhs) ->
-          GIf(replace_var_by_pattern b,
-              (na,Option.map replace_var_by_pattern e_option),
-              replace_var_by_pattern lhs,
-              replace_var_by_pattern rhs
-             )
-      | GRec _ ->
-        CErrors.user_err (Pp.str "Not handled GRec")
-      | GSort _
-      | GHole _ as rt -> rt
-      | GInt _ as rt -> rt
-      | GFloat _ as rt -> rt
-      | GCast(b,c) ->
-          GCast(replace_var_by_pattern b,
-                Glob_ops.map_cast_type replace_var_by_pattern c)
-    ) x
-  and replace_var_by_pattern_br ({CAst.loc;v=(idl,patl,res)} as br) =
-    if List.exists (fun id -> Id.compare id x_id == 0) idl
-    then br
-    else CAst.make ?loc (idl,patl,replace_var_by_pattern res)
+        | GLetTuple (nal, (na, rto), def, b) ->
+          GLetTuple
+            ( nal
+            , (na, Option.map replace_var_by_pattern rto)
+            , replace_var_by_pattern def
+            , replace_var_by_pattern b )
+        | GCases (sty, infos, el, brl) ->
+          GCases
+            ( sty
+            , infos
+            , List.map (fun (e, x) -> (replace_var_by_pattern e, x)) el
+            , List.map replace_var_by_pattern_br brl )
+        | GIf (b, (na, e_option), lhs, rhs) ->
+          GIf
+            ( replace_var_by_pattern b
+            , (na, Option.map replace_var_by_pattern e_option)
+            , replace_var_by_pattern lhs
+            , replace_var_by_pattern rhs )
+        | GRec _ -> CErrors.user_err (Pp.str "Not handled GRec")
+        | (GSort _ | GHole _) as rt -> rt
+        | GInt _ as rt -> rt
+        | GFloat _ as rt -> rt
+        | GCast (b, c) ->
+          GCast
+            ( replace_var_by_pattern b
+            , Glob_ops.map_cast_type replace_var_by_pattern c ))
+      x
+  and replace_var_by_pattern_br ({CAst.loc; v = idl, patl, res} as br) =
+    if List.exists (fun id -> Id.compare id x_id == 0) idl then br
+    else CAst.make ?loc (idl, patl, replace_var_by_pattern res)
   in
   replace_var_by_pattern
 
-
-
-
 (* checking unifiability of patterns *)
 exception NotUnifiable
 
-let rec are_unifiable_aux  = function
+let rec are_unifiable_aux = function
   | [] -> ()
-  | (l, r) ::eqs ->
-      match DAst.get l, DAst.get r with
-         | PatVar _ ,_ | _, PatVar _-> are_unifiable_aux eqs
-         | PatCstr(constructor1,cpl1,_), PatCstr(constructor2,cpl2,_) ->
-             if not (eq_constructor constructor2 constructor1)
-             then raise NotUnifiable
-             else
-               let eqs' =
-                 try (List.combine cpl1 cpl2) @ eqs
-                 with Invalid_argument _ -> anomaly (Pp.str "are_unifiable_aux.")
-               in
-               are_unifiable_aux eqs'
+  | (l, r) :: eqs -> (
+    match (DAst.get l, DAst.get r) with
+    | PatVar _, _ | _, PatVar _ -> are_unifiable_aux eqs
+    | PatCstr (constructor1, cpl1, _), PatCstr (constructor2, cpl2, _) ->
+      if not (eq_constructor constructor2 constructor1) then raise NotUnifiable
+      else
+        let eqs' =
+          try List.combine cpl1 cpl2 @ eqs
+          with Invalid_argument _ -> anomaly (Pp.str "are_unifiable_aux.")
+        in
+        are_unifiable_aux eqs' )
 
 let are_unifiable pat1 pat2 =
   try
-    are_unifiable_aux [pat1,pat2];
+    are_unifiable_aux [(pat1, pat2)];
     true
   with NotUnifiable -> false
 
-
-let rec eq_cases_pattern_aux  = function
+let rec eq_cases_pattern_aux = function
   | [] -> ()
-  | (l, r) ::eqs ->
-      match DAst.get l, DAst.get r with
-         | PatVar _, PatVar _ -> eq_cases_pattern_aux eqs
-         | PatCstr(constructor1,cpl1,_), PatCstr(constructor2,cpl2,_) ->
-             if not (eq_constructor constructor2 constructor1)
-             then raise NotUnifiable
-             else
-               let eqs' =
-                 try (List.combine cpl1 cpl2) @ eqs
-                 with Invalid_argument _ -> anomaly (Pp.str "eq_cases_pattern_aux.")
-               in
-               eq_cases_pattern_aux eqs'
-         | _ -> raise NotUnifiable
+  | (l, r) :: eqs -> (
+    match (DAst.get l, DAst.get r) with
+    | PatVar _, PatVar _ -> eq_cases_pattern_aux eqs
+    | PatCstr (constructor1, cpl1, _), PatCstr (constructor2, cpl2, _) ->
+      if not (eq_constructor constructor2 constructor1) then raise NotUnifiable
+      else
+        let eqs' =
+          try List.combine cpl1 cpl2 @ eqs
+          with Invalid_argument _ -> anomaly (Pp.str "eq_cases_pattern_aux.")
+        in
+        eq_cases_pattern_aux eqs'
+    | _ -> raise NotUnifiable )
 
 let eq_cases_pattern pat1 pat2 =
   try
-    eq_cases_pattern_aux [pat1,pat2];
+    eq_cases_pattern_aux [(pat1, pat2)];
     true
   with NotUnifiable -> false
 
-
-
 let ids_of_pat =
-  let rec ids_of_pat ids = DAst.with_val (function
-    | PatVar Anonymous -> ids
-    | PatVar(Name id) -> Id.Set.add id ids
-    | PatCstr(_,patl,_) -> List.fold_left ids_of_pat ids patl
-    )
+  let rec ids_of_pat ids =
+    DAst.with_val (function
+      | PatVar Anonymous -> ids
+      | PatVar (Name id) -> Id.Set.add id ids
+      | PatCstr (_, patl, _) -> List.fold_left ids_of_pat ids patl)
   in
   ids_of_pat Id.Set.empty
 
 let expand_as =
-
   let rec add_as map rt =
     match DAst.get rt with
-      | PatVar _ -> map
-      | PatCstr(_,patl,Name id) ->
-          Id.Map.add id (pattern_to_term rt) (List.fold_left add_as map patl)
-      | PatCstr(_,patl,_) -> List.fold_left add_as map patl
+    | PatVar _ -> map
+    | PatCstr (_, patl, Name id) ->
+      Id.Map.add id (pattern_to_term rt) (List.fold_left add_as map patl)
+    | PatCstr (_, patl, _) -> List.fold_left add_as map patl
   in
-  let rec expand_as map = DAst.map (function
-      | GRef _ | GEvar _ | GPatVar _ | GSort _ | GHole _ | GInt _ | GFloat _ as rt -> rt
-      | GVar id as rt ->
-          begin
-            try
-              DAst.get (Id.Map.find id map)
-            with Not_found -> rt
-          end
-      | GApp(f,args) -> GApp(expand_as map f,List.map (expand_as map) args)
-      | GLambda(na,k,t,b) -> GLambda(na,k,expand_as map t, expand_as map b)
-      | GProd(na,k,t,b) -> GProd(na,k,expand_as map t, expand_as map b)
-      | GLetIn(na,v,typ,b) -> GLetIn(na, expand_as map v,Option.map (expand_as map) typ,expand_as map b)
-      | GLetTuple(nal,(na,po),v,b) ->
-          GLetTuple(nal,(na,Option.map (expand_as map) po),
-                    expand_as map v, expand_as map b)
-      | GIf(e,(na,po),br1,br2) ->
-          GIf(expand_as map e,(na,Option.map (expand_as map) po),
-              expand_as map br1, expand_as map br2)
-      | GRec _ ->  user_err Pp.(str "Not handled GRec")
-      | GCast(b,c) ->
-          GCast(expand_as map b,
-                Glob_ops.map_cast_type (expand_as map) c)
-      | GCases(sty,po,el,brl) ->
-          GCases(sty, Option.map (expand_as map) po, List.map (fun (rt,t) -> expand_as map rt,t) el,
-                List.map (expand_as_br map) brl)
-    )
-  and expand_as_br map {CAst.loc; v=(idl,cpl,rt)} =
-    CAst.make ?loc (idl,cpl, expand_as (List.fold_left add_as map cpl) rt)
+  let rec expand_as map =
+    DAst.map (function
+      | (GRef _ | GEvar _ | GPatVar _ | GSort _ | GHole _ | GInt _ | GFloat _)
+        as rt ->
+        rt
+      | GVar id as rt -> (
+        try DAst.get (Id.Map.find id map) with Not_found -> rt )
+      | GApp (f, args) -> GApp (expand_as map f, List.map (expand_as map) args)
+      | GLambda (na, k, t, b) ->
+        GLambda (na, k, expand_as map t, expand_as map b)
+      | GProd (na, k, t, b) -> GProd (na, k, expand_as map t, expand_as map b)
+      | GLetIn (na, v, typ, b) ->
+        GLetIn
+          (na, expand_as map v, Option.map (expand_as map) typ, expand_as map b)
+      | GLetTuple (nal, (na, po), v, b) ->
+        GLetTuple
+          ( nal
+          , (na, Option.map (expand_as map) po)
+          , expand_as map v
+          , expand_as map b )
+      | GIf (e, (na, po), br1, br2) ->
+        GIf
+          ( expand_as map e
+          , (na, Option.map (expand_as map) po)
+          , expand_as map br1
+          , expand_as map br2 )
+      | GRec _ -> user_err Pp.(str "Not handled GRec")
+      | GCast (b, c) ->
+        GCast (expand_as map b, Glob_ops.map_cast_type (expand_as map) c)
+      | GCases (sty, po, el, brl) ->
+        GCases
+          ( sty
+          , Option.map (expand_as map) po
+          , List.map (fun (rt, t) -> (expand_as map rt, t)) el
+          , List.map (expand_as_br map) brl ))
+  and expand_as_br map {CAst.loc; v = idl, cpl, rt} =
+    CAst.make ?loc (idl, cpl, expand_as (List.fold_left add_as map cpl) rt)
   in
   expand_as Id.Map.empty
 
@@ -566,65 +520,75 @@ let expand_as =
  *)
 
 exception Found of Evd.evar_info
-let resolve_and_replace_implicits ?(flags=Pretyping.all_and_fail_flags) ?(expected_type=Pretyping.WithoutTypeConstraint) env sigma rt =
+
+let resolve_and_replace_implicits ?(flags = Pretyping.all_and_fail_flags)
+    ?(expected_type = Pretyping.WithoutTypeConstraint) env sigma rt =
   let open Evd in
   let open Evar_kinds in
   (* we first (pseudo) understand [rt] and get back the computed evar_map *)
   (* FIXME : JF (30/03/2017) I'm not completely sure to have split understand as needed.
-If someone knows how to prevent solved existantial removal in  understand, please do not hesitate to change the computation of [ctx] here *)
-  let ctx,_,_ = Pretyping.ise_pretype_gen flags env sigma Glob_ops.empty_lvar expected_type rt in
+     If someone knows how to prevent solved existantial removal in  understand, please do not hesitate to change the computation of [ctx] here *)
+  let ctx, _, _ =
+    Pretyping.ise_pretype_gen flags env sigma Glob_ops.empty_lvar expected_type
+      rt
+  in
   let ctx = Evd.minimize_universes ctx in
-  let f c = EConstr.of_constr (Evarutil.nf_evars_universes ctx (EConstr.Unsafe.to_constr c)) in
-
+  let f c =
+    EConstr.of_constr
+      (Evarutil.nf_evars_universes ctx (EConstr.Unsafe.to_constr c))
+  in
   (* then we map [rt] to replace the implicit holes by their values *)
   let rec change rt =
     match DAst.get rt with
-    | GHole(ImplicitArg(grk,pk,bk),_,_) -> (* we only want to deal with implicit arguments *)
-       (
-         try (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
-           Evd.fold (* to simulate an iter *)
-             (fun _ evi _ ->
-               match evi.evar_source with
-               | (loc_evi,ImplicitArg(gr_evi,p_evi,b_evi)) ->
-                  if GlobRef.equal grk gr_evi && pk=p_evi && bk=b_evi  && rt.CAst.loc = loc_evi
-                  then raise (Found evi)
-               | _ -> ()
-             )
-             ctx
-             ();
-           (* the hole was not solved : we do nothing *)
-           rt
-         with Found evi -> (* we found the evar corresponding to this hole *)
-           match evi.evar_body with
-           | Evar_defined c ->
-             (* we just have to lift the solution in glob_term *)
-              Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
-           | Evar_empty -> rt (* the hole was not solved : we do nothing *)
-       )
-    | (GHole(BinderType na,_,_)) -> (* we only want to deal with implicit arguments *)
-       (
-         let res =
-           try (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
-             Evd.fold (* to simulate an iter *)
-               (fun _ evi _ ->
-                 match evi.evar_source with
-                 | (loc_evi,BinderType na') ->
-                    if Name.equal na na' && rt.CAst.loc = loc_evi  then raise (Found evi)
-                 | _ -> ()
-               )
-               ctx
-               ();
-             (* the hole was not solved : we do nothing *)
-             rt
-           with Found evi -> (* we found the evar corresponding to this hole *)
-                match evi.evar_body with
-                | Evar_defined c ->
-                   (* we just have to lift the solution in glob_term *)
-                   Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
-                | Evar_empty -> rt (* the hole was not solved : we d when falseo nothing *)
-         in
-         res
-       )
+    | GHole (ImplicitArg (grk, pk, bk), _, _) -> (
+      try
+        (* we only want to deal with implicit arguments *)
+
+        (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
+        Evd.fold (* to simulate an iter *)
+          (fun _ evi _ ->
+            match evi.evar_source with
+            | loc_evi, ImplicitArg (gr_evi, p_evi, b_evi) ->
+              if
+                GlobRef.equal grk gr_evi && pk = p_evi && bk = b_evi
+                && rt.CAst.loc = loc_evi
+              then raise (Found evi)
+            | _ -> ())
+          ctx ();
+        (* the hole was not solved : we do nothing *)
+        rt
+      with Found evi -> (
+        (* we found the evar corresponding to this hole *)
+        match evi.evar_body with
+        | Evar_defined c ->
+          (* we just have to lift the solution in glob_term *)
+          Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
+        | Evar_empty -> rt (* the hole was not solved : we do nothing *) ) )
+    | GHole (BinderType na, _, _) ->
+      (* we only want to deal with implicit arguments *)
+      let res =
+        try
+          (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
+          Evd.fold (* to simulate an iter *)
+            (fun _ evi _ ->
+              match evi.evar_source with
+              | loc_evi, BinderType na' ->
+                if Name.equal na na' && rt.CAst.loc = loc_evi then
+                  raise (Found evi)
+              | _ -> ())
+            ctx ();
+          (* the hole was not solved : we do nothing *)
+          rt
+        with Found evi -> (
+          (* we found the evar corresponding to this hole *)
+          match evi.evar_body with
+          | Evar_defined c ->
+            (* we just have to lift the solution in glob_term *)
+            Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
+          | Evar_empty -> rt )
+        (* the hole was not solved : we d when falseo nothing *)
+      in
+      res
     | _ -> Glob_ops.map_glob_constr change rt
   in
   change rt
diff --git a/plugins/funind/glob_termops.mli b/plugins/funind/glob_termops.mli
index c55fdc017c..8eff7926da 100644
--- a/plugins/funind/glob_termops.mli
+++ b/plugins/funind/glob_termops.mli
@@ -25,33 +25,37 @@ val pattern_to_term : cases_pattern -> glob_constr
 *)
 val mkGRef : GlobRef.t -> glob_constr
 val mkGVar : Id.t -> glob_constr
-val mkGApp  : glob_constr*(glob_constr list) -> glob_constr
+val mkGApp : glob_constr * glob_constr list -> glob_constr
 val mkGLambda : Name.t * glob_constr * glob_constr -> glob_constr
 val mkGProd : Name.t * glob_constr * glob_constr -> glob_constr
-val mkGLetIn : Name.t * glob_constr * glob_constr option * glob_constr -> glob_constr
-val mkGCases : glob_constr option * tomatch_tuples * cases_clauses -> glob_constr
-val mkGHole : unit -> glob_constr (* we only build Evd.BinderType Anonymous holes *)
+
+val mkGLetIn :
+  Name.t * glob_constr * glob_constr option * glob_constr -> glob_constr
+
+val mkGCases :
+  glob_constr option * tomatch_tuples * cases_clauses -> glob_constr
+
+val mkGHole : unit -> glob_constr
+
+(* we only build Evd.BinderType Anonymous holes *)
+
 (*
   Some basic functions to decompose glob_constrs
   These are analogous to the ones constrs
 *)
-val glob_decompose_app : glob_constr -> glob_constr*(glob_constr list)
-
+val glob_decompose_app : glob_constr -> glob_constr * glob_constr list
 
 (* [glob_make_eq t1 t2] build the glob_constr corresponding to [t2 = t1] *)
-val  glob_make_eq : ?typ:glob_constr -> glob_constr -> glob_constr -> glob_constr
+val glob_make_eq : ?typ:glob_constr -> glob_constr -> glob_constr -> glob_constr
+
 (* [glob_make_neq t1 t2] build the glob_constr corresponding to [t1 <> t2] *)
-val  glob_make_neq : glob_constr -> glob_constr -> glob_constr
+val glob_make_neq : glob_constr -> glob_constr -> glob_constr
 
 (* alpha_conversion functions *)
 
-
-
 (* Replace the var mapped in the glob_constr/context *)
 val change_vars : Id.t Id.Map.t -> glob_constr -> glob_constr
 
-
-
 (* [alpha_pat avoid pat] rename all the variables present in [pat] s.t.
    the result does not share variables with [avoid]. This function create
    a fresh variable for each occurrence of the anonymous pattern.
@@ -59,11 +63,10 @@ val change_vars : Id.t Id.Map.t -> glob_constr -> glob_constr
    Also returns a mapping  from old variables to new ones and the concatenation of
    [avoid] with the variables appearing in the result.
 *)
-  val alpha_pat :
-    Id.Map.key list ->
-    Glob_term.cases_pattern ->
-    Glob_term.cases_pattern * Id.Map.key list *
-      Id.t Id.Map.t
+val alpha_pat :
+     Id.Map.key list
+  -> Glob_term.cases_pattern
+  -> Glob_term.cases_pattern * Id.Map.key list * Id.t Id.Map.t
 
 (* [alpha_rt avoid rt] alpha convert [rt] s.t. the result respects barendregt
    conventions and  does not share bound variables with avoid
@@ -71,38 +74,35 @@ val change_vars : Id.t Id.Map.t -> glob_constr -> glob_constr
 val alpha_rt : Id.t list -> glob_constr -> glob_constr
 
 (* same as alpha_rt but for case branches *)
-val alpha_br : Id.t list ->
-  Glob_term.cases_clause ->
-  Glob_term.cases_clause
+val alpha_br : Id.t list -> Glob_term.cases_clause -> Glob_term.cases_clause
 
 (* Reduction function *)
-val replace_var_by_term  :
-  Id.t ->
-  Glob_term.glob_constr -> Glob_term.glob_constr -> Glob_term.glob_constr
-
-
+val replace_var_by_term :
+     Id.t
+  -> Glob_term.glob_constr
+  -> Glob_term.glob_constr
+  -> Glob_term.glob_constr
 
 (*
    [is_free_in id rt] checks if [id] is a free variable in [rt]
 *)
 val is_free_in : Id.t -> glob_constr -> bool
-
-
 val are_unifiable : cases_pattern -> cases_pattern -> bool
 val eq_cases_pattern : cases_pattern -> cases_pattern -> bool
 
-
-
 (*
    ids_of_pat : cases_pattern -> Id.Set.t
    returns the set of variables appearing in a pattern
 *)
-val   ids_of_pat : cases_pattern -> Id.Set.t
-
+val ids_of_pat : cases_pattern -> Id.Set.t
 val expand_as : glob_constr -> glob_constr
 
 (* [resolve_and_replace_implicits ?expected_type env sigma rt] solves implicits of [rt] w.r.t. [env] and [sigma] and then replace them by their solution
  *)
 val resolve_and_replace_implicits :
-      ?flags:Pretyping.inference_flags ->
-      ?expected_type:Pretyping.typing_constraint -> Environ.env -> Evd.evar_map -> glob_constr -> glob_constr
+     ?flags:Pretyping.inference_flags
+  -> ?expected_type:Pretyping.typing_constraint
+  -> Environ.env
+  -> Evd.evar_map
+  -> glob_constr
+  -> glob_constr
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 1f2f56ec34..4e0e2dc501 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -15,48 +15,49 @@ open Names
 open Sorts
 open Constr
 open EConstr
-
 open Tacmach.New
 open Tacticals.New
 open Tactics
-
 open Indfun_common
-
 module RelDecl = Context.Rel.Declaration
 
 let is_rec_info sigma scheme_info =
   let test_branche min acc decl =
-    acc || (
-      let new_branche =
-        it_mkProd_or_LetIn mkProp (fst (decompose_prod_assum sigma (RelDecl.get_type decl))) in
-      let free_rels_in_br = Termops.free_rels sigma new_branche in
-      let max = min + scheme_info.Tactics.npredicates in
-      Int.Set.exists (fun i -> i >= min && i< max) free_rels_in_br
-    )
+    acc
+    ||
+    let new_branche =
+      it_mkProd_or_LetIn mkProp
+        (fst (decompose_prod_assum sigma (RelDecl.get_type decl)))
+    in
+    let free_rels_in_br = Termops.free_rels sigma new_branche in
+    let max = min + scheme_info.Tactics.npredicates in
+    Int.Set.exists (fun i -> i >= min && i < max) free_rels_in_br
   in
   List.fold_left_i test_branche 1 false (List.rev scheme_info.Tactics.branches)
 
 let choose_dest_or_ind scheme_info args =
   Proofview.tclBIND Proofview.tclEVARMAP (fun sigma ->
-  Tactics.induction_destruct (is_rec_info sigma scheme_info) false args)
+      Tactics.induction_destruct (is_rec_info sigma scheme_info) false args)
 
 let functional_induction with_clean c princl pat =
   let open Proofview.Notations in
   Proofview.Goal.enter_one (fun gl ->
-    let sigma = project gl in
-    let f,args = decompose_app sigma c in
-    match princl with
-    | None -> (* No principle is given let's find the good one *)
-      begin
+      let sigma = project gl in
+      let f, args = decompose_app sigma c in
+      match princl with
+      | None -> (
+        (* No principle is given let's find the good one *)
         match EConstr.kind sigma f with
-        | Const (c',u) ->
+        | Const (c', u) ->
           let princ_option =
-            let finfo = (* we first try to find out a graph on f *)
+            let finfo =
+              (* we first try to find out a graph on f *)
               match find_Function_infos c' with
               | Some finfo -> finfo
               | None ->
-                user_err  (str "Cannot find induction information on "++
-                           Printer.pr_leconstr_env (pf_env gl) sigma (mkConst c') )
+                user_err
+                  ( str "Cannot find induction information on "
+                  ++ Printer.pr_leconstr_env (pf_env gl) sigma (mkConst c') )
             in
             match elimination_sort_of_goal gl with
             | InSProp -> finfo.sprop_lemma
@@ -64,7 +65,8 @@ let functional_induction with_clean c princl pat =
             | InSet -> finfo.rec_lemma
             | InType -> finfo.rect_lemma
           in
-          let sigma, princ =  (* then we get the principle *)
+          let sigma, princ =
+            (* then we get the principle *)
             match princ_option with
             | Some princ ->
               Evd.fresh_global (pf_env gl) (project gl) (GlobRef.ConstRef princ)
@@ -79,66 +81,74 @@ let functional_induction with_clean c princl pat =
               in
               let princ_ref =
                 try
-                  Constrintern.locate_reference (Libnames.qualid_of_ident princ_name)
-                with
-                | Not_found ->
-                  user_err (str "Cannot find induction principle for "
-                            ++ Printer.pr_leconstr_env (pf_env gl) sigma (mkConst c') )
+                  Constrintern.locate_reference
+                    (Libnames.qualid_of_ident princ_name)
+                with Not_found ->
+                  user_err
+                    ( str "Cannot find induction principle for "
+                    ++ Printer.pr_leconstr_env (pf_env gl) sigma (mkConst c') )
               in
               Evd.fresh_global (pf_env gl) (project gl) princ_ref
           in
           let princt = Retyping.get_type_of (pf_env gl) sigma princ in
-          Proofview.Unsafe.tclEVARS sigma <*>
-          Proofview.tclUNIT (princ, Tactypes.NoBindings, princt, args)
+          Proofview.Unsafe.tclEVARS sigma
+          <*> Proofview.tclUNIT (princ, Tactypes.NoBindings, princt, args)
         | _ ->
-          CErrors.user_err (str "functional induction must be used with a function" )
-      end
-    | Some ((princ,binding)) ->
-      let sigma, princt = pf_type_of gl princ in
-      Proofview.Unsafe.tclEVARS sigma <*>
-      Proofview.tclUNIT (princ, binding, princt, args)
-    ) >>= fun (princ, bindings, princ_type, args) ->
+          CErrors.user_err
+            (str "functional induction must be used with a function") )
+      | Some (princ, binding) ->
+        let sigma, princt = pf_type_of gl princ in
+        Proofview.Unsafe.tclEVARS sigma
+        <*> Proofview.tclUNIT (princ, binding, princt, args))
+  >>= fun (princ, bindings, princ_type, args) ->
   Proofview.Goal.enter (fun gl ->
-  let sigma = project gl in
-  let princ_infos = compute_elim_sig (project gl) princ_type in
-  let args_as_induction_constr =
-    let c_list =
-      if princ_infos.Tactics.farg_in_concl
-      then [c] else []
-    in
-    if List.length args + List.length c_list = 0
-    then user_err Pp.(str "Cannot recognize a valid functional scheme" );
-    let encoded_pat_as_patlist =
-      List.make (List.length args + List.length c_list - 1) None @ [pat]
-    in
-    List.map2
-      (fun c pat ->
-         ((None, ElimOnConstr (fun env sigma -> (sigma,(c,Tactypes.NoBindings)))),
-          (None,pat), None))
-      (args@c_list)
-      encoded_pat_as_patlist
-  in
-  let princ' = Some (princ,bindings) in
-  let princ_vars =
-    List.fold_right
-      (fun a acc -> try Id.Set.add (destVar sigma a) acc with DestKO -> acc)
-      args
-      Id.Set.empty
-  in
-  let old_idl = List.fold_right Id.Set.add (pf_ids_of_hyps gl) Id.Set.empty in
-  let old_idl = Id.Set.diff old_idl princ_vars in
-  let subst_and_reduce gl =
-    if with_clean
-    then
-      let idl = List.filter (fun id -> not (Id.Set.mem id old_idl))(pf_ids_of_hyps gl) in
-      let flag = Genredexpr.Cbv { Redops.all_flags with Genredexpr.rDelta = false } in
+      let sigma = project gl in
+      let princ_infos = compute_elim_sig (project gl) princ_type in
+      let args_as_induction_constr =
+        let c_list = if princ_infos.Tactics.farg_in_concl then [c] else [] in
+        if List.length args + List.length c_list = 0 then
+          user_err Pp.(str "Cannot recognize a valid functional scheme");
+        let encoded_pat_as_patlist =
+          List.make (List.length args + List.length c_list - 1) None @ [pat]
+        in
+        List.map2
+          (fun c pat ->
+            ( ( None
+              , ElimOnConstr
+                  (fun env sigma -> (sigma, (c, Tactypes.NoBindings))) )
+            , (None, pat)
+            , None ))
+          (args @ c_list) encoded_pat_as_patlist
+      in
+      let princ' = Some (princ, bindings) in
+      let princ_vars =
+        List.fold_right
+          (fun a acc ->
+            try Id.Set.add (destVar sigma a) acc with DestKO -> acc)
+          args Id.Set.empty
+      in
+      let old_idl =
+        List.fold_right Id.Set.add (pf_ids_of_hyps gl) Id.Set.empty
+      in
+      let old_idl = Id.Set.diff old_idl princ_vars in
+      let subst_and_reduce gl =
+        if with_clean then
+          let idl =
+            List.filter
+              (fun id -> not (Id.Set.mem id old_idl))
+              (pf_ids_of_hyps gl)
+          in
+          let flag =
+            Genredexpr.Cbv {Redops.all_flags with Genredexpr.rDelta = false}
+          in
+          tclTHEN
+            (tclMAP
+               (fun id ->
+                 tclTRY (Equality.subst_gen (do_rewrite_dependent ()) [id]))
+               idl)
+            (reduce flag Locusops.allHypsAndConcl)
+        else tclIDTAC
+      in
       tclTHEN
-        (tclMAP (fun id -> tclTRY (Equality.subst_gen (do_rewrite_dependent ()) [id])) idl)
-        (reduce flag Locusops.allHypsAndConcl)
-    else tclIDTAC
-  in
-  tclTHEN
-    (choose_dest_or_ind
-       princ_infos
-       (args_as_induction_constr,princ'))
-    (Proofview.Goal.enter subst_and_reduce))
+        (choose_dest_or_ind princ_infos (args_as_induction_constr, princ'))
+        (Proofview.Goal.enter subst_and_reduce))
diff --git a/plugins/funind/indfun.mli b/plugins/funind/indfun.mli
index 4f3d4a1587..daabc4e7c6 100644
--- a/plugins/funind/indfun.mli
+++ b/plugins/funind/indfun.mli
@@ -8,8 +8,8 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-val functional_induction
-  :  bool
+val functional_induction :
+     bool
   -> EConstr.constr
   -> (EConstr.constr * EConstr.constr Tactypes.bindings) option
   -> Ltac_plugin.Tacexpr.or_and_intro_pattern option
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index ec23355ce1..e83fe56cc9 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -4,112 +4,96 @@ open Constr
 open Libnames
 open Refiner
 
-let mk_prefix pre id = Id.of_string (pre^(Id.to_string id))
+let mk_prefix pre id = Id.of_string (pre ^ Id.to_string id)
 let mk_rel_id = mk_prefix "R_"
 let mk_correct_id id = Nameops.add_suffix (mk_rel_id id) "_correct"
 let mk_complete_id id = Nameops.add_suffix (mk_rel_id id) "_complete"
 let mk_equation_id id = Nameops.add_suffix id "_equation"
 
-let fresh_id avoid s = Namegen.next_ident_away_in_goal (Id.of_string s) (Id.Set.of_list avoid)
+let fresh_id avoid s =
+  Namegen.next_ident_away_in_goal (Id.of_string s) (Id.Set.of_list avoid)
 
 let fresh_name avoid s = Name (fresh_id avoid s)
 
-let get_name avoid ?(default="H") = function
+let get_name avoid ?(default = "H") = function
   | Anonymous -> fresh_name avoid default
   | Name n -> Name n
 
-let array_get_start a =
-  Array.init
-    (Array.length a - 1)
-    (fun i -> a.(i))
-
+let array_get_start a = Array.init (Array.length a - 1) (fun i -> a.(i))
 let locate qid = Nametab.locate qid
 
 let locate_ind ref =
-  match locate ref with
-    | GlobRef.IndRef x -> x
-    | _ -> raise Not_found
+  match locate ref with GlobRef.IndRef x -> x | _ -> raise Not_found
 
 let locate_constant ref =
-  match locate ref with
-    | GlobRef.ConstRef x -> x
-    | _ -> raise Not_found
-
-
-let locate_with_msg msg f x =
-  try f x
-  with
-  | Not_found ->
-    CErrors.user_err msg
+  match locate ref with GlobRef.ConstRef x -> x | _ -> raise Not_found
 
+let locate_with_msg msg f x = try f x with Not_found -> CErrors.user_err msg
 
 let filter_map filter f =
   let rec it = function
     | [] -> []
-    | e::l ->
-        if filter e
-        then
-          (f e) :: it l
-        else it l
+    | e :: l -> if filter e then f e :: it l else it l
   in
   it
 
-
-let chop_rlambda_n  =
+let chop_rlambda_n =
   let rec chop_lambda_n acc n rt =
-      if n == 0
-      then List.rev acc,rt
-      else
-        match DAst.get rt with
-          | Glob_term.GLambda(name,k,t,b) -> chop_lambda_n ((name,t,None)::acc) (n-1) b
-          | Glob_term.GLetIn(name,v,t,b) -> chop_lambda_n ((name,v,t)::acc) (n-1) b
-          | _ ->
-            CErrors.user_err ~hdr:"chop_rlambda_n" (str "chop_rlambda_n: Not enough Lambdas")
+    if n == 0 then (List.rev acc, rt)
+    else
+      match DAst.get rt with
+      | Glob_term.GLambda (name, k, t, b) ->
+        chop_lambda_n ((name, t, None) :: acc) (n - 1) b
+      | Glob_term.GLetIn (name, v, t, b) ->
+        chop_lambda_n ((name, v, t) :: acc) (n - 1) b
+      | _ ->
+        CErrors.user_err ~hdr:"chop_rlambda_n"
+          (str "chop_rlambda_n: Not enough Lambdas")
   in
   chop_lambda_n []
 
-let chop_rprod_n  =
+let chop_rprod_n =
   let rec chop_prod_n acc n rt =
-      if n == 0
-      then List.rev acc,rt
-      else
-        match DAst.get rt with
-          | Glob_term.GProd(name,k,t,b) -> chop_prod_n ((name,t)::acc) (n-1) b
-          | _ ->
-            CErrors.user_err ~hdr:"chop_rprod_n" (str "chop_rprod_n: Not enough products")
+    if n == 0 then (List.rev acc, rt)
+    else
+      match DAst.get rt with
+      | Glob_term.GProd (name, k, t, b) ->
+        chop_prod_n ((name, t) :: acc) (n - 1) b
+      | _ ->
+        CErrors.user_err ~hdr:"chop_rprod_n"
+          (str "chop_rprod_n: Not enough products")
   in
   chop_prod_n []
 
-
-
 let list_union_eq eq_fun l1 l2 =
   let rec urec = function
     | [] -> l2
-    | a::l -> if List.exists (eq_fun a) l2 then urec l else a::urec l
+    | a :: l -> if List.exists (eq_fun a) l2 then urec l else a :: urec l
   in
   urec l1
 
-let list_add_set_eq eq_fun x l =
-  if List.exists (eq_fun x) l then l else x::l
-
-let coq_constant s = UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref s;;
+let list_add_set_eq eq_fun x l = if List.exists (eq_fun x) l then l else x :: l
+let coq_constant s = UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref s
 
 let find_reference sl s =
   let dp = Names.DirPath.make (List.rev_map Id.of_string sl) in
   Nametab.locate (make_qualid dp (Id.of_string s))
 
-let eq = lazy(EConstr.of_constr (coq_constant "core.eq.type"))
-let refl_equal = lazy(EConstr.of_constr (coq_constant "core.eq.refl"))
+let eq = lazy (EConstr.of_constr (coq_constant "core.eq.type"))
+let refl_equal = lazy (EConstr.of_constr (coq_constant "core.eq.refl"))
 
 let with_full_print f a =
   let old_implicit_args = Impargs.is_implicit_args ()
-  and old_strict_implicit_args =  Impargs.is_strict_implicit_args ()
+  and old_strict_implicit_args = Impargs.is_strict_implicit_args ()
   and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
   let old_rawprint = !Flags.raw_print in
   let old_printuniverses = !Constrextern.print_universes in
-  let old_printallowmatchdefaultclause = Detyping.print_allow_match_default_clause () in
+  let old_printallowmatchdefaultclause =
+    Detyping.print_allow_match_default_clause ()
+  in
   Constrextern.print_universes := true;
-  Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name false;
+  Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name
+    false;
   Flags.raw_print := true;
   Impargs.make_implicit_args false;
   Impargs.make_strict_implicit_args false;
@@ -122,47 +106,41 @@ let with_full_print f a =
     Impargs.make_contextual_implicit_args old_contextual_implicit_args;
     Flags.raw_print := old_rawprint;
     Constrextern.print_universes := old_printuniverses;
-    Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name old_printallowmatchdefaultclause;
+    Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name
+      old_printallowmatchdefaultclause;
     Dumpglob.continue ();
     res
-  with
-    | reraise ->
-        Impargs.make_implicit_args old_implicit_args;
-        Impargs.make_strict_implicit_args old_strict_implicit_args;
-        Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-        Flags.raw_print := old_rawprint;
-        Constrextern.print_universes := old_printuniverses;
-        Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name old_printallowmatchdefaultclause;
-        Dumpglob.continue ();
-        raise reraise
-
-
-
-
-
+  with reraise ->
+    Impargs.make_implicit_args old_implicit_args;
+    Impargs.make_strict_implicit_args old_strict_implicit_args;
+    Impargs.make_contextual_implicit_args old_contextual_implicit_args;
+    Flags.raw_print := old_rawprint;
+    Constrextern.print_universes := old_printuniverses;
+    Goptions.set_bool_option_value Detyping.print_allow_match_default_opt_name
+      old_printallowmatchdefaultclause;
+    Dumpglob.continue ();
+    raise reraise
 
 (**********************)
 
 type function_info =
-    {
-      function_constant : Constant.t;
-      graph_ind : inductive;
-      equation_lemma : Constant.t option;
-      correctness_lemma : Constant.t option;
-      completeness_lemma : Constant.t option;
-      rect_lemma : Constant.t option;
-      rec_lemma : Constant.t option;
-      prop_lemma : Constant.t option;
-      sprop_lemma : Constant.t option;
-      is_general : bool; (* Has this function been defined using general recursive definition *)
-    }
-
+  { function_constant : Constant.t
+  ; graph_ind : inductive
+  ; equation_lemma : Constant.t option
+  ; correctness_lemma : Constant.t option
+  ; completeness_lemma : Constant.t option
+  ; rect_lemma : Constant.t option
+  ; rec_lemma : Constant.t option
+  ; prop_lemma : Constant.t option
+  ; sprop_lemma : Constant.t option
+  ; is_general : bool
+        (* Has this function been defined using general recursive definition *)
+  }
 
 (* type function_db  = function_info list *)
 
 (* let function_table = ref ([] : function_db) *)
 
-
 let from_function = Summary.ref Cmap_env.empty ~name:"functions_db_fn"
 let from_graph = Summary.ref Indmap.empty ~name:"functions_db_gr"
 
@@ -187,91 +165,105 @@ let cache_Function (_,(finfos)) =
   then function_table := new_tbl
 *)
 
-let cache_Function (_,finfos) =
+let cache_Function (_, finfos) =
   from_function := Cmap_env.add finfos.function_constant finfos !from_function;
   from_graph := Indmap.add finfos.graph_ind finfos !from_graph
 
-
-let subst_Function (subst,finfos) =
+let subst_Function (subst, finfos) =
   let do_subst_con c = Mod_subst.subst_constant subst c
-  and do_subst_ind i = Mod_subst.subst_ind subst i
-  in
+  and do_subst_ind i = Mod_subst.subst_ind subst i in
   let function_constant' = do_subst_con finfos.function_constant in
   let graph_ind' = do_subst_ind finfos.graph_ind in
   let equation_lemma' = Option.Smart.map do_subst_con finfos.equation_lemma in
-  let correctness_lemma' = Option.Smart.map do_subst_con finfos.correctness_lemma in
-  let completeness_lemma' = Option.Smart.map do_subst_con finfos.completeness_lemma in
+  let correctness_lemma' =
+    Option.Smart.map do_subst_con finfos.correctness_lemma
+  in
+  let completeness_lemma' =
+    Option.Smart.map do_subst_con finfos.completeness_lemma
+  in
   let rect_lemma' = Option.Smart.map do_subst_con finfos.rect_lemma in
   let rec_lemma' = Option.Smart.map do_subst_con finfos.rec_lemma in
-  let prop_lemma' =  Option.Smart.map do_subst_con finfos.prop_lemma in
+  let prop_lemma' = Option.Smart.map do_subst_con finfos.prop_lemma in
   let sprop_lemma' = Option.Smart.map do_subst_con finfos.sprop_lemma in
-  if function_constant' == finfos.function_constant &&
-    graph_ind' == finfos.graph_ind &&
-    equation_lemma' == finfos.equation_lemma &&
-    correctness_lemma' == finfos.correctness_lemma &&
-    completeness_lemma' == finfos.completeness_lemma &&
-    rect_lemma' == finfos.rect_lemma &&
-    rec_lemma' == finfos.rec_lemma &&
-    prop_lemma' == finfos.prop_lemma &&
-    sprop_lemma' == finfos.sprop_lemma
+  if
+    function_constant' == finfos.function_constant
+    && graph_ind' == finfos.graph_ind
+    && equation_lemma' == finfos.equation_lemma
+    && correctness_lemma' == finfos.correctness_lemma
+    && completeness_lemma' == finfos.completeness_lemma
+    && rect_lemma' == finfos.rect_lemma
+    && rec_lemma' == finfos.rec_lemma
+    && prop_lemma' == finfos.prop_lemma
+    && sprop_lemma' == finfos.sprop_lemma
   then finfos
   else
-    { function_constant = function_constant';
-      graph_ind = graph_ind';
-      equation_lemma = equation_lemma' ;
-      correctness_lemma = correctness_lemma' ;
-      completeness_lemma = completeness_lemma' ;
-      rect_lemma = rect_lemma' ;
-      rec_lemma = rec_lemma';
-      prop_lemma = prop_lemma';
-      sprop_lemma = sprop_lemma';
-      is_general = finfos.is_general
-    }
-
-let discharge_Function (_,finfos) = Some finfos
+    { function_constant = function_constant'
+    ; graph_ind = graph_ind'
+    ; equation_lemma = equation_lemma'
+    ; correctness_lemma = correctness_lemma'
+    ; completeness_lemma = completeness_lemma'
+    ; rect_lemma = rect_lemma'
+    ; rec_lemma = rec_lemma'
+    ; prop_lemma = prop_lemma'
+    ; sprop_lemma = sprop_lemma'
+    ; is_general = finfos.is_general }
+
+let discharge_Function (_, finfos) = Some finfos
 
 let pr_ocst env sigma c =
-  Option.fold_right (fun v acc -> Printer.pr_lconstr_env env sigma (mkConst v)) c (mt ())
+  Option.fold_right
+    (fun v acc -> Printer.pr_lconstr_env env sigma (mkConst v))
+    c (mt ())
 
 let pr_info env sigma f_info =
-  str "function_constant := " ++
-  Printer.pr_lconstr_env env sigma (mkConst f_info.function_constant)++ fnl () ++
-  str "function_constant_type := " ++
-  (try
-     Printer.pr_lconstr_env env sigma
-       (fst (Typeops.type_of_global_in_context env (GlobRef.ConstRef f_info.function_constant)))
-   with e when CErrors.noncritical e -> mt ()) ++ fnl () ++
-  str "equation_lemma := " ++ pr_ocst env sigma f_info.equation_lemma ++ fnl () ++
-  str "completeness_lemma :=" ++ pr_ocst env sigma f_info.completeness_lemma ++ fnl () ++
-  str "correctness_lemma := " ++ pr_ocst env sigma f_info.correctness_lemma ++ fnl () ++
-  str "rect_lemma := " ++ pr_ocst env sigma f_info.rect_lemma ++ fnl () ++
-  str "rec_lemma := " ++ pr_ocst env sigma f_info.rec_lemma ++ fnl () ++
-  str "prop_lemma := " ++ pr_ocst env sigma f_info.prop_lemma ++ fnl () ++
-  str "graph_ind := " ++ Printer.pr_lconstr_env env sigma (mkInd f_info.graph_ind) ++ fnl ()
+  str "function_constant := "
+  ++ Printer.pr_lconstr_env env sigma (mkConst f_info.function_constant)
+  ++ fnl ()
+  ++ str "function_constant_type := "
+  ++ ( try
+         Printer.pr_lconstr_env env sigma
+           (fst
+              (Typeops.type_of_global_in_context env
+                 (GlobRef.ConstRef f_info.function_constant)))
+       with e when CErrors.noncritical e -> mt () )
+  ++ fnl () ++ str "equation_lemma := "
+  ++ pr_ocst env sigma f_info.equation_lemma
+  ++ fnl ()
+  ++ str "completeness_lemma :="
+  ++ pr_ocst env sigma f_info.completeness_lemma
+  ++ fnl ()
+  ++ str "correctness_lemma := "
+  ++ pr_ocst env sigma f_info.correctness_lemma
+  ++ fnl () ++ str "rect_lemma := "
+  ++ pr_ocst env sigma f_info.rect_lemma
+  ++ fnl () ++ str "rec_lemma := "
+  ++ pr_ocst env sigma f_info.rec_lemma
+  ++ fnl () ++ str "prop_lemma := "
+  ++ pr_ocst env sigma f_info.prop_lemma
+  ++ fnl () ++ str "graph_ind := "
+  ++ Printer.pr_lconstr_env env sigma (mkInd f_info.graph_ind)
+  ++ fnl ()
 
 let pr_table env sigma tb =
-  let l = Cmap_env.fold (fun k v acc -> v::acc) tb [] in
+  let l = Cmap_env.fold (fun k v acc -> v :: acc) tb [] in
   Pp.prlist_with_sep fnl (pr_info env sigma) l
 
 let in_Function : function_info -> Libobject.obj =
   let open Libobject in
-  declare_object @@ superglobal_object "FUNCTIONS_DB"
-    ~cache:cache_Function
-    ~subst:(Some subst_Function)
-    ~discharge:discharge_Function
-
+  declare_object
+  @@ superglobal_object "FUNCTIONS_DB" ~cache:cache_Function
+       ~subst:(Some subst_Function) ~discharge:discharge_Function
 
 let find_or_none id =
-  try Some
-    (match Nametab.locate (qualid_of_ident id) with GlobRef.ConstRef c -> c | _ -> CErrors.anomaly (Pp.str "Not a constant.")
-    )
+  try
+    Some
+      ( match Nametab.locate (qualid_of_ident id) with
+      | GlobRef.ConstRef c -> c
+      | _ -> CErrors.anomaly (Pp.str "Not a constant.") )
   with Not_found -> None
 
-let find_Function_infos f =
-  Cmap_env.find_opt f !from_function
-
-let find_Function_of_graph ind =
-  Indmap.find_opt ind !from_graph
+let find_Function_infos f = Cmap_env.find_opt f !from_function
+let find_Function_of_graph ind = Indmap.find_opt ind !from_graph
 
 let update_Function finfo =
   (* Pp.msgnl (pr_info finfo); *)
@@ -287,113 +279,101 @@ let add_Function is_general f =
   and prop_lemma = find_or_none (Nameops.add_suffix f_id "_ind")
   and sprop_lemma = find_or_none (Nameops.add_suffix f_id "_sind")
   and graph_ind =
-    match Nametab.locate (qualid_of_ident (mk_rel_id f_id))
-    with | GlobRef.IndRef ind -> ind | _ -> CErrors.anomaly (Pp.str "Not an inductive.")
+    match Nametab.locate (qualid_of_ident (mk_rel_id f_id)) with
+    | GlobRef.IndRef ind -> ind
+    | _ -> CErrors.anomaly (Pp.str "Not an inductive.")
   in
   let finfos =
-    { function_constant = f;
-      equation_lemma = equation_lemma;
-      completeness_lemma = completeness_lemma;
-      correctness_lemma = correctness_lemma;
-      rect_lemma = rect_lemma;
-      rec_lemma = rec_lemma;
-      prop_lemma = prop_lemma;
-      sprop_lemma = sprop_lemma;
-      graph_ind = graph_ind;
-      is_general = is_general
-
-    }
+    { function_constant = f
+    ; equation_lemma
+    ; completeness_lemma
+    ; correctness_lemma
+    ; rect_lemma
+    ; rec_lemma
+    ; prop_lemma
+    ; sprop_lemma
+    ; graph_ind
+    ; is_general }
   in
   update_Function finfos
 
 let pr_table env sigma = pr_table env sigma !from_function
+
 (*********************************)
 (* Debugging *)
 
 let do_rewrite_dependent =
-  Goptions.declare_bool_option_and_ref
-    ~depr:false
-    ~key:["Functional";"Induction";"Rewrite";"Dependent"]
+  Goptions.declare_bool_option_and_ref ~depr:false
+    ~key:["Functional"; "Induction"; "Rewrite"; "Dependent"]
     ~value:true
 
 let do_observe =
-  Goptions.declare_bool_option_and_ref
-    ~depr:false
-    ~key:["Function_debug"]
+  Goptions.declare_bool_option_and_ref ~depr:false ~key:["Function_debug"]
     ~value:false
 
-let observe strm =
-  if do_observe ()
-  then Feedback.msg_debug strm
-  else ()
-
+let observe strm = if do_observe () then Feedback.msg_debug strm else ()
 let debug_queue = Stack.create ()
 
 let print_debug_queue b e =
-  if not (Stack.is_empty debug_queue)
-  then
-    let lmsg,goal = Stack.pop debug_queue in
-    (if b then
-       Feedback.msg_debug (hov 1 (lmsg ++ (str " raised exception " ++ CErrors.print e) ++ str " on goal" ++ fnl() ++ goal))
-     else
-       Feedback.msg_debug (hov 1 (str " from " ++ lmsg ++ str " on goal"++fnl() ++ goal))
-       (* print_debug_queue false e; *)
-    )
+  if not (Stack.is_empty debug_queue) then
+    let lmsg, goal = Stack.pop debug_queue in
+    if b then
+      Feedback.msg_debug
+        (hov 1
+           ( lmsg
+           ++ (str " raised exception " ++ CErrors.print e)
+           ++ str " on goal" ++ fnl () ++ goal ))
+    else
+      Feedback.msg_debug
+        (hov 1 (str " from " ++ lmsg ++ str " on goal" ++ fnl () ++ goal))
+
+(* print_debug_queue false e; *)
 
 let do_observe_tac s tac g =
   let goal = Printer.pr_goal g in
   let s = s (pf_env g) (project g) in
-  let lmsg = (str "observation : ") ++ s in
-  Stack.push (lmsg,goal) debug_queue;
+  let lmsg = str "observation : " ++ s in
+  Stack.push (lmsg, goal) debug_queue;
   try
     let v = tac g in
-    ignore(Stack.pop debug_queue);
+    ignore (Stack.pop debug_queue);
     v
   with reraise ->
     let reraise = Exninfo.capture reraise in
-    if not (Stack.is_empty debug_queue)
-    then print_debug_queue true (fst reraise);
+    if not (Stack.is_empty debug_queue) then
+      print_debug_queue true (fst reraise);
     Exninfo.iraise reraise
 
 let observe_tac s tac g =
-  if do_observe ()
-  then do_observe_tac s tac g
-  else tac g
+  if do_observe () then do_observe_tac s tac g else tac g
 
 module New = struct
-
-let do_observe_tac ~header s tac =
-  let open Proofview.Notations in
-  let open Proofview in
-  Goal.enter begin fun gl ->
-    let goal = Printer.pr_goal (Goal.print gl) in
-    let env, sigma = Goal.env gl, Goal.sigma gl in
-    let s = s env sigma in
-    let lmsg = seq [header; str " : " ++ s] in
-    tclLIFT (NonLogical.make (fun () ->
-        Feedback.msg_debug (s++fnl()))) >>= fun () ->
-    tclOR (
-      Stack.push (lmsg, goal) debug_queue;
-      tac >>= fun v ->
-      ignore(Stack.pop debug_queue);
-      Proofview.tclUNIT v)
-      (fun (exn, info) ->
-         if not (Stack.is_empty debug_queue)
-         then print_debug_queue true exn;
-         tclZERO ~info exn)
-  end
-
-let observe_tac ~header s tac =
-  if do_observe ()
-  then do_observe_tac ~header s tac
-  else tac
-
+  let do_observe_tac ~header s tac =
+    let open Proofview.Notations in
+    let open Proofview in
+    Goal.enter (fun gl ->
+        let goal = Printer.pr_goal (Goal.print gl) in
+        let env, sigma = (Goal.env gl, Goal.sigma gl) in
+        let s = s env sigma in
+        let lmsg = seq [header; str " : " ++ s] in
+        tclLIFT (NonLogical.make (fun () -> Feedback.msg_debug (s ++ fnl ())))
+        >>= fun () ->
+        tclOR
+          ( Stack.push (lmsg, goal) debug_queue;
+            tac
+            >>= fun v ->
+            ignore (Stack.pop debug_queue);
+            Proofview.tclUNIT v )
+          (fun (exn, info) ->
+            if not (Stack.is_empty debug_queue) then print_debug_queue true exn;
+            tclZERO ~info exn))
+
+  let observe_tac ~header s tac =
+    if do_observe () then do_observe_tac ~header s tac else tac
 end
 
 let is_strict_tcc =
-  Goptions.declare_bool_option_and_ref
-    ~depr:false
-    ~key:["Function_raw_tcc"]
+  Goptions.declare_bool_option_and_ref ~depr:false ~key:["Function_raw_tcc"]
     ~value:false
 
 exception Building_graph of exn
@@ -403,17 +383,15 @@ exception ToShow of exn
 let jmeq () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
-    EConstr.of_constr @@
-    UnivGen.constr_of_monomorphic_global @@
-      Coqlib.lib_ref "core.JMeq.type"
+    EConstr.of_constr @@ UnivGen.constr_of_monomorphic_global
+    @@ Coqlib.lib_ref "core.JMeq.type"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
 let jmeq_refl () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
-    EConstr.of_constr @@
-    UnivGen.constr_of_monomorphic_global @@
-      Coqlib.lib_ref "core.JMeq.refl"
+    EConstr.of_constr @@ UnivGen.constr_of_monomorphic_global
+    @@ Coqlib.lib_ref "core.JMeq.refl"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
 let h_intros l =
@@ -421,49 +399,67 @@ let h_intros l =
 
 let h_id = Id.of_string "h"
 let hrec_id = Id.of_string "hrec"
-let well_founded = function () -> EConstr.of_constr (coq_constant "core.wf.well_founded")
+
+let well_founded = function
+  | () -> EConstr.of_constr (coq_constant "core.wf.well_founded")
+
 let acc_rel = function () -> EConstr.of_constr (coq_constant "core.wf.acc")
-let acc_inv_id = function () -> EConstr.of_constr (coq_constant "core.wf.acc_inv")
 
-let well_founded_ltof () = EConstr.of_constr (coq_constant "num.nat.well_founded_ltof")
+let acc_inv_id = function
+  | () -> EConstr.of_constr (coq_constant "core.wf.acc_inv")
 
-let ltof_ref = function  () -> (find_reference ["Coq";"Arith";"Wf_nat"] "ltof")
+let well_founded_ltof () =
+  EConstr.of_constr (coq_constant "num.nat.well_founded_ltof")
+
+let ltof_ref = function () -> find_reference ["Coq"; "Arith"; "Wf_nat"] "ltof"
 
 let make_eq () =
-  try EConstr.of_constr (UnivGen.constr_of_monomorphic_global (Coqlib.lib_ref "core.eq.type"))
+  try
+    EConstr.of_constr
+      (UnivGen.constr_of_monomorphic_global (Coqlib.lib_ref "core.eq.type"))
   with _ -> assert false
 
-let evaluable_of_global_reference r = (* Tacred.evaluable_of_global_reference (Global.env ()) *)
+let evaluable_of_global_reference r =
+  (* Tacred.evaluable_of_global_reference (Global.env ()) *)
   match r with
-      GlobRef.ConstRef sp -> EvalConstRef sp
-    | GlobRef.VarRef id -> EvalVarRef id
-    | _ -> assert false;;
+  | GlobRef.ConstRef sp -> EvalConstRef sp
+  | GlobRef.VarRef id -> EvalVarRef id
+  | _ -> assert false
 
-let list_rewrite (rev:bool) (eqs: (EConstr.constr*bool) list) =
+let list_rewrite (rev : bool) (eqs : (EConstr.constr * bool) list) =
   tclREPEAT
     (List.fold_right
-       (fun (eq,b) i -> tclORELSE (Proofview.V82.of_tactic ((if b then Equality.rewriteLR else Equality.rewriteRL) eq)) i)
-       (if rev then (List.rev eqs) else eqs) (tclFAIL 0 (mt())));;
+       (fun (eq, b) i ->
+         tclORELSE
+           (Proofview.V82.of_tactic
+              ((if b then Equality.rewriteLR else Equality.rewriteRL) eq))
+           i)
+       (if rev then List.rev eqs else eqs)
+       (tclFAIL 0 (mt ())))
 
 let decompose_lam_n sigma n =
-  if n < 0 then CErrors.user_err Pp.(str "decompose_lam_n: integer parameter must be positive");
+  if n < 0 then
+    CErrors.user_err
+      Pp.(str "decompose_lam_n: integer parameter must be positive");
   let rec lamdec_rec l n c =
-    if Int.equal n 0 then l,c
-    else match EConstr.kind sigma c with
-      | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) (n-1) c
-      | Cast (c,_,_)     -> lamdec_rec l n c
-      | _ -> CErrors.user_err Pp.(str "decompose_lam_n: not enough abstractions")
+    if Int.equal n 0 then (l, c)
+    else
+      match EConstr.kind sigma c with
+      | Lambda (x, t, c) -> lamdec_rec ((x, t) :: l) (n - 1) c
+      | Cast (c, _, _) -> lamdec_rec l n c
+      | _ ->
+        CErrors.user_err Pp.(str "decompose_lam_n: not enough abstractions")
   in
   lamdec_rec [] n
 
 let lamn n env b =
   let open EConstr in
   let rec lamrec = function
-    | (0, env, b)        -> b
-    | (n, ((v,t)::l), b) -> lamrec (n-1,  l, mkLambda (v,t,b))
+    | 0, env, b -> b
+    | n, (v, t) :: l, b -> lamrec (n - 1, l, mkLambda (v, t, b))
     | _ -> assert false
   in
-  lamrec (n,env,b)
+  lamrec (n, env, b)
 
 (* compose_lam [xn:Tn;..;x1:T1] b = [x1:T1]..[xn:Tn]b *)
 let compose_lam l b = lamn (List.length l) l b
@@ -472,19 +468,16 @@ let compose_lam l b = lamn (List.length l) l b
 let prodn n env b =
   let open EConstr in
   let rec prodrec = function
-    | (0, env, b)        -> b
-    | (n, ((v,t)::l), b) -> prodrec (n-1,  l, mkProd (v,t,b))
+    | 0, env, b -> b
+    | n, (v, t) :: l, b -> prodrec (n - 1, l, mkProd (v, t, b))
     | _ -> assert false
   in
-  prodrec (n,env,b)
+  prodrec (n, env, b)
 
 (* compose_prod [xn:Tn;..;x1:T1] b = (x1:T1)..(xn:Tn)b *)
 let compose_prod l b = prodn (List.length l) l b
 
-type tcc_lemma_value =
-  | Undefined
-  | Value of constr
-  | Not_needed
+type tcc_lemma_value = Undefined | Value of constr | Not_needed
 
 (* We only "purify" on exceptions. XXX: What is this doing here? *)
 let funind_purify f x =
@@ -497,4 +490,4 @@ let funind_purify f x =
 
 let tac_type_of g c =
   let sigma, t = Tacmach.pf_type_of g c in
-  {g with Evd.sigma}, t
+  ({g with Evd.sigma}, t)
diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli
index bd8b34088b..396db55458 100644
--- a/plugins/funind/indfun_common.mli
+++ b/plugins/funind/indfun_common.mli
@@ -8,30 +8,27 @@ val mk_rel_id : Id.t -> Id.t
 val mk_correct_id : Id.t -> Id.t
 val mk_complete_id : Id.t -> Id.t
 val mk_equation_id : Id.t -> Id.t
-
 val fresh_id : Id.t list -> string -> Id.t
 val fresh_name : Id.t list -> string -> Name.t
 val get_name : Id.t list -> ?default:string -> Name.t -> Name.t
-
 val array_get_start : 'a array -> 'a array
-
 val locate_ind : Libnames.qualid -> inductive
 val locate_constant : Libnames.qualid -> Constant.t
-val locate_with_msg :
-  Pp.t -> (Libnames.qualid -> 'a) ->
-  Libnames.qualid -> 'a
-
+val locate_with_msg : Pp.t -> (Libnames.qualid -> 'a) -> Libnames.qualid -> 'a
 val filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list
-val list_union_eq :
-  ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
-val list_add_set_eq :
-  ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
+val list_union_eq : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
+val list_add_set_eq : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
 
-val chop_rlambda_n : int -> Glob_term.glob_constr ->
-  (Name.t*Glob_term.glob_constr*Glob_term.glob_constr option) list * Glob_term.glob_constr
+val chop_rlambda_n :
+     int
+  -> Glob_term.glob_constr
+  -> (Name.t * Glob_term.glob_constr * Glob_term.glob_constr option) list
+     * Glob_term.glob_constr
 
-val chop_rprod_n : int -> Glob_term.glob_constr ->
-  (Name.t*Glob_term.glob_constr) list * Glob_term.glob_constr
+val chop_rprod_n :
+     int
+  -> Glob_term.glob_constr
+  -> (Name.t * Glob_term.glob_constr) list * Glob_term.glob_constr
 
 val eq : EConstr.constr Lazy.t
 val refl_equal : EConstr.constr Lazy.t
@@ -45,44 +42,41 @@ val make_eq : unit -> EConstr.constr
 *)
 val with_full_print : ('a -> 'b) -> 'a -> 'b
 
-
 (*****************)
 
 type function_info =
-    {
-      function_constant : Constant.t;
-      graph_ind : inductive;
-      equation_lemma : Constant.t option;
-      correctness_lemma : Constant.t option;
-      completeness_lemma : Constant.t option;
-      rect_lemma : Constant.t option;
-      rec_lemma : Constant.t option;
-      prop_lemma : Constant.t option;
-      sprop_lemma : Constant.t option;
-      is_general : bool;
-    }
+  { function_constant : Constant.t
+  ; graph_ind : inductive
+  ; equation_lemma : Constant.t option
+  ; correctness_lemma : Constant.t option
+  ; completeness_lemma : Constant.t option
+  ; rect_lemma : Constant.t option
+  ; rec_lemma : Constant.t option
+  ; prop_lemma : Constant.t option
+  ; sprop_lemma : Constant.t option
+  ; is_general : bool }
 
 val find_Function_infos : Constant.t -> function_info option
 val find_Function_of_graph : inductive -> function_info option
+
 (* WARNING: To be used just after the graph definition !!! *)
 val add_Function : bool -> Constant.t -> unit
 val update_Function : function_info -> unit
 
 (** debugging *)
 val pr_info : Environ.env -> Evd.evar_map -> function_info -> Pp.t
+
 val pr_table : Environ.env -> Evd.evar_map -> Pp.t
 
-val observe_tac
-  : (Environ.env -> Evd.evar_map -> Pp.t)
-  -> Tacmach.tactic -> Tacmach.tactic
+val observe_tac :
+  (Environ.env -> Evd.evar_map -> Pp.t) -> Tacmach.tactic -> Tacmach.tactic
 
 module New : sig
-
-  val observe_tac
-    : header:Pp.t
+  val observe_tac :
+       header:Pp.t
     -> (Environ.env -> Evd.evar_map -> Pp.t)
-    -> unit Proofview.tactic -> unit Proofview.tactic
-
+    -> unit Proofview.tactic
+    -> unit Proofview.tactic
 end
 
 (* val function_debug : bool ref  *)
@@ -96,28 +90,35 @@ exception Defining_principle of exn
 exception ToShow of exn
 
 val is_strict_tcc : unit -> bool
-
-val h_intros: Names.Id.t list -> Tacmach.tactic
-val h_id :  Names.Id.t
-val hrec_id :  Names.Id.t
-val acc_inv_id :  EConstr.constr Util.delayed
+val h_intros : Names.Id.t list -> Tacmach.tactic
+val h_id : Names.Id.t
+val hrec_id : Names.Id.t
+val acc_inv_id : EConstr.constr Util.delayed
 val ltof_ref : GlobRef.t Util.delayed
 val well_founded_ltof : EConstr.constr Util.delayed
 val acc_rel : EConstr.constr Util.delayed
 val well_founded : EConstr.constr Util.delayed
-val evaluable_of_global_reference : GlobRef.t -> Names.evaluable_global_reference
-val list_rewrite : bool -> (EConstr.constr*bool) list -> Tacmach.tactic
 
-val decompose_lam_n : Evd.evar_map -> int -> EConstr.t ->
-  (Names.Name.t Context.binder_annot * EConstr.t) list * EConstr.t
-val compose_lam : (Names.Name.t Context.binder_annot * EConstr.t) list -> EConstr.t -> EConstr.t
-val compose_prod : (Names.Name.t Context.binder_annot * EConstr.t) list -> EConstr.t -> EConstr.t
+val evaluable_of_global_reference :
+  GlobRef.t -> Names.evaluable_global_reference
+
+val list_rewrite : bool -> (EConstr.constr * bool) list -> Tacmach.tactic
+
+val decompose_lam_n :
+     Evd.evar_map
+  -> int
+  -> EConstr.t
+  -> (Names.Name.t Context.binder_annot * EConstr.t) list * EConstr.t
+
+val compose_lam :
+  (Names.Name.t Context.binder_annot * EConstr.t) list -> EConstr.t -> EConstr.t
+
+val compose_prod :
+  (Names.Name.t Context.binder_annot * EConstr.t) list -> EConstr.t -> EConstr.t
 
-type tcc_lemma_value =
-  | Undefined
-  | Value of Constr.t
-  | Not_needed
+type tcc_lemma_value = Undefined | Value of Constr.t | Not_needed
 
-val funind_purify : ('a -> 'b) -> ('a -> 'b)
+val funind_purify : ('a -> 'b) -> 'a -> 'b
 
-val tac_type_of : Goal.goal Evd.sigma -> EConstr.constr -> Goal.goal Evd.sigma * EConstr.types
+val tac_type_of :
+  Goal.goal Evd.sigma -> EConstr.constr -> Goal.goal Evd.sigma * EConstr.types
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 44d2cb4a3d..5d631aac84 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -15,7 +15,6 @@ open EConstr
 open Tacmach.New
 open Tactics
 open Tacticals.New
-
 open Indfun_common
 
 (***********************************************)
@@ -26,36 +25,40 @@ open Indfun_common
 
    if the type of hypothesis has not this form or if we cannot find the completeness lemma then we do nothing
 *)
-let revert_graph kn post_tac hid = Proofview.Goal.enter (fun gl ->
-  let sigma = project gl in
-  let typ = pf_get_hyp_typ hid gl in
-  match EConstr.kind sigma typ with
-  | App(i,args) when isInd sigma i ->
-    let ((kn',num) as ind'),u = destInd sigma i in
-    if MutInd.equal kn kn'
-    then (* We have generated a graph hypothesis so that we must change it if we can *)
-      let info = match find_Function_of_graph ind' with
-        | Some info -> info
-        | None ->
-          (* The graphs are mutually recursive but we cannot find one of them !*)
-          CErrors.anomaly (Pp.str "Cannot retrieve infos about a mutual block.")
-      in
-      (* if we can find a completeness lemma for this function
-         then we can come back to the functional form. If not, we do nothing
-      *)
-      match info.completeness_lemma with
-      | None -> tclIDTAC
-      | Some f_complete ->
-        let f_args,res = Array.chop (Array.length args - 1) args in
-        tclTHENLIST
-          [ generalize [applist(mkConst f_complete,(Array.to_list f_args)@[res.(0);mkVar hid])]
-          ; clear [hid]
-          ; Simple.intro hid
-          ; post_tac hid
-          ]
-    else tclIDTAC
-  | _ -> tclIDTAC
-  )
+let revert_graph kn post_tac hid =
+  Proofview.Goal.enter (fun gl ->
+      let sigma = project gl in
+      let typ = pf_get_hyp_typ hid gl in
+      match EConstr.kind sigma typ with
+      | App (i, args) when isInd sigma i ->
+        let ((kn', num) as ind'), u = destInd sigma i in
+        if MutInd.equal kn kn' then
+          (* We have generated a graph hypothesis so that we must change it if we can *)
+          let info =
+            match find_Function_of_graph ind' with
+            | Some info -> info
+            | None ->
+              (* The graphs are mutually recursive but we cannot find one of them !*)
+              CErrors.anomaly
+                (Pp.str "Cannot retrieve infos about a mutual block.")
+          in
+          (* if we can find a completeness lemma for this function
+             then we can come back to the functional form. If not, we do nothing
+          *)
+          match info.completeness_lemma with
+          | None -> tclIDTAC
+          | Some f_complete ->
+            let f_args, res = Array.chop (Array.length args - 1) args in
+            tclTHENLIST
+              [ generalize
+                  [ applist
+                      ( mkConst f_complete
+                      , Array.to_list f_args @ [res.(0); mkVar hid] ) ]
+              ; clear [hid]
+              ; Simple.intro hid
+              ; post_tac hid ]
+        else tclIDTAC
+      | _ -> tclIDTAC)
 
 (*
    [functional_inversion hid fconst f_correct ] is the functional version of [inversion]
@@ -74,52 +77,55 @@ let revert_graph kn post_tac hid = Proofview.Goal.enter (fun gl ->
    \end{enumerate}
 *)
 
-let functional_inversion kn hid fconst f_correct = Proofview.Goal.enter (fun gl ->
-  let old_ids = List.fold_right Id.Set.add  (pf_ids_of_hyps gl) Id.Set.empty in
-  let sigma = project gl in
-  let type_of_h = pf_get_hyp_typ hid gl in
-  match EConstr.kind sigma type_of_h with
-  | App(eq,args) when EConstr.eq_constr sigma eq (make_eq ())  ->
-    let pre_tac,f_args,res =
-      match EConstr.kind sigma args.(1),EConstr.kind sigma args.(2) with
-      | App(f,f_args),_ when EConstr.eq_constr sigma f fconst ->
-        ((fun hid -> intros_symmetry (Locusops.onHyp hid))),f_args,args.(2)
-      |_,App(f,f_args) when EConstr.eq_constr sigma f fconst ->
-        ((fun hid -> tclIDTAC),f_args,args.(1))
-      | _ -> (fun hid -> tclFAIL 1 Pp.(mt ())),[||],args.(2)
-    in
-    tclTHENLIST
-      [ pre_tac hid
-      ; generalize [applist(f_correct,(Array.to_list f_args)@[res;mkVar hid])]
-      ; clear [hid]
-      ; Simple.intro hid
-      ; Inv.inv Inv.FullInversion None (Tactypes.NamedHyp hid)
-      ; Proofview.Goal.enter (fun gl ->
-            let new_ids = List.filter (fun id -> not (Id.Set.mem id old_ids)) (pf_ids_of_hyps gl) in
-            tclMAP (revert_graph kn pre_tac)  (hid::new_ids)
-          )
-      ]
-  | _ -> tclFAIL 1 Pp.(mt ())
-  )
+let functional_inversion kn hid fconst f_correct =
+  Proofview.Goal.enter (fun gl ->
+      let old_ids =
+        List.fold_right Id.Set.add (pf_ids_of_hyps gl) Id.Set.empty
+      in
+      let sigma = project gl in
+      let type_of_h = pf_get_hyp_typ hid gl in
+      match EConstr.kind sigma type_of_h with
+      | App (eq, args) when EConstr.eq_constr sigma eq (make_eq ()) ->
+        let pre_tac, f_args, res =
+          match (EConstr.kind sigma args.(1), EConstr.kind sigma args.(2)) with
+          | App (f, f_args), _ when EConstr.eq_constr sigma f fconst ->
+            ((fun hid -> intros_symmetry (Locusops.onHyp hid)), f_args, args.(2))
+          | _, App (f, f_args) when EConstr.eq_constr sigma f fconst ->
+            ((fun hid -> tclIDTAC), f_args, args.(1))
+          | _ -> ((fun hid -> tclFAIL 1 Pp.(mt ())), [||], args.(2))
+        in
+        tclTHENLIST
+          [ pre_tac hid
+          ; generalize
+              [applist (f_correct, Array.to_list f_args @ [res; mkVar hid])]
+          ; clear [hid]
+          ; Simple.intro hid
+          ; Inv.inv Inv.FullInversion None (Tactypes.NamedHyp hid)
+          ; Proofview.Goal.enter (fun gl ->
+                let new_ids =
+                  List.filter
+                    (fun id -> not (Id.Set.mem id old_ids))
+                    (pf_ids_of_hyps gl)
+                in
+                tclMAP (revert_graph kn pre_tac) (hid :: new_ids)) ]
+      | _ -> tclFAIL 1 Pp.(mt ()))
 
-let invfun qhyp f  =
+let invfun qhyp f =
   let f =
     match f with
     | GlobRef.ConstRef f -> f
-    | _ ->
-      CErrors.user_err Pp.(str "Not a function")
+    | _ -> CErrors.user_err Pp.(str "Not a function")
   in
   match find_Function_infos f with
-  | None ->
-    CErrors.user_err (Pp.str "No graph found")
-  | Some finfos ->
+  | None -> CErrors.user_err (Pp.str "No graph found")
+  | Some finfos -> (
     match finfos.correctness_lemma with
-    | None ->
-      CErrors.user_err (Pp.str "Cannot use equivalence with graph!")
+    | None -> CErrors.user_err (Pp.str "Cannot use equivalence with graph!")
     | Some f_correct ->
-      let f_correct = mkConst f_correct
-      and kn = fst finfos.graph_ind in
-      Tactics.try_intros_until (fun hid -> functional_inversion kn hid (mkConst f)  f_correct) qhyp
+      let f_correct = mkConst f_correct and kn = fst finfos.graph_ind in
+      Tactics.try_intros_until
+        (fun hid -> functional_inversion kn hid (mkConst f) f_correct)
+        qhyp )
 
 let invfun qhyp f =
   let exception NoFunction in
@@ -128,41 +134,55 @@ let invfun qhyp f =
   | None ->
     let tac_action hid gl =
       let sigma = project gl in
-      let hyp_typ = pf_get_hyp_typ hid gl  in
+      let hyp_typ = pf_get_hyp_typ hid gl in
       match EConstr.kind sigma hyp_typ with
-      | App(eq,args) when EConstr.eq_constr sigma eq (make_eq ()) ->
-        begin
-          let f1,_ = decompose_app sigma args.(1) in
-          try
-            if not (isConst sigma f1) then raise NoFunction;
-            let finfos = Option.get (find_Function_infos (fst (destConst sigma f1))) in
-            let f_correct = mkConst(Option.get finfos.correctness_lemma)
-            and kn = fst finfos.graph_ind
-            in
-            functional_inversion kn hid f1 f_correct
-          with
-          | NoFunction | Option.IsNone ->
-            let f2,_ = decompose_app sigma args.(2) in
-            if isConst sigma f2 then
-              match find_Function_infos (fst (destConst sigma f2)) with
+      | App (eq, args) when EConstr.eq_constr sigma eq (make_eq ()) -> (
+        let f1, _ = decompose_app sigma args.(1) in
+        try
+          if not (isConst sigma f1) then raise NoFunction;
+          let finfos =
+            Option.get (find_Function_infos (fst (destConst sigma f1)))
+          in
+          let f_correct = mkConst (Option.get finfos.correctness_lemma)
+          and kn = fst finfos.graph_ind in
+          functional_inversion kn hid f1 f_correct
+        with NoFunction | Option.IsNone ->
+          let f2, _ = decompose_app sigma args.(2) in
+          if isConst sigma f2 then
+            match find_Function_infos (fst (destConst sigma f2)) with
+            | None ->
+              if do_observe () then
+                CErrors.user_err
+                  (Pp.str "No graph found for any side of equality")
+              else
+                CErrors.user_err
+                  Pp.(
+                    str "Cannot find inversion information for hypothesis "
+                    ++ Ppconstr.pr_id hid)
+            | Some finfos -> (
+              match finfos.correctness_lemma with
               | None ->
-                if do_observe ()
-                then CErrors.user_err (Pp.str "No graph found for any side of equality")
-                else CErrors.user_err Pp.(str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
-              | Some finfos ->
-                match finfos.correctness_lemma with
-                | None ->
-                  if do_observe ()
-                  then CErrors.user_err (Pp.str "Cannot use equivalence with graph for any side of the equality")
-                  else CErrors.user_err Pp.(str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
-                | Some f_correct ->
-                  let f_correct = mkConst f_correct
-                  and kn = fst finfos.graph_ind
-                  in
-                  functional_inversion kn hid  f2 f_correct
-            else                (* NoFunction *)
-              CErrors.user_err Pp.(str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
-        end
-      | _ -> CErrors.user_err Pp.(Ppconstr.pr_id hid ++ str " must be an equality ")
+                if do_observe () then
+                  CErrors.user_err
+                    (Pp.str
+                       "Cannot use equivalence with graph for any side of the \
+                        equality")
+                else
+                  CErrors.user_err
+                    Pp.(
+                      str "Cannot find inversion information for hypothesis "
+                      ++ Ppconstr.pr_id hid)
+              | Some f_correct ->
+                let f_correct = mkConst f_correct
+                and kn = fst finfos.graph_ind in
+                functional_inversion kn hid f2 f_correct )
+          else
+            (* NoFunction *)
+            CErrors.user_err
+              Pp.(
+                str "Hypothesis " ++ Ppconstr.pr_id hid
+                ++ str " must contain at least one Function") )
+      | _ ->
+        CErrors.user_err Pp.(Ppconstr.pr_id hid ++ str " must be an equality ")
     in
     try_intros_until (tac_action %> Proofview.Goal.enter) qhyp
diff --git a/plugins/funind/invfun.mli b/plugins/funind/invfun.mli
index 41dbe1437c..a117df32df 100644
--- a/plugins/funind/invfun.mli
+++ b/plugins/funind/invfun.mli
@@ -8,7 +8,7 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-val invfun
-  :  Tactypes.quantified_hypothesis
+val invfun :
+     Tactypes.quantified_hypothesis
   -> Names.GlobRef.t option
   -> unit Proofview.tactic
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 19a762d33d..bd19648c08 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -8,9 +8,7 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-
 module CVars = Vars
-
 open Constr
 open Context
 open EConstr
@@ -37,22 +35,19 @@ open Termops
 open Constrintern
 open Tactypes
 open Genredexpr
-
 open Equality
 open Auto
 open Eauto
-
 open Indfun_common
 open Context.Rel.Declaration
 
 (* Ugly things which should not be here *)
 
-let coq_constant s = EConstr.of_constr @@ UnivGen.constr_of_monomorphic_global @@
-  Coqlib.lib_ref s
+let coq_constant s =
+  EConstr.of_constr @@ UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref s
 
 let coq_init_constant s =
-  EConstr.of_constr(UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref s)
-;;
+  EConstr.of_constr (UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref s)
 
 let find_reference sl s =
   let dp = Names.DirPath.make (List.rev_map Id.of_string sl) in
@@ -60,35 +55,37 @@ let find_reference sl s =
 
 let declare_fun name kind ?univs value =
   let ce = definition_entry ?univs value (*FIXME *) in
-  GlobRef.ConstRef(declare_constant ~name ~kind (DefinitionEntry ce))
+  GlobRef.ConstRef (declare_constant ~name ~kind (DefinitionEntry ce))
 
 let defined lemma =
   Lemmas.save_lemma_proved ~lemma ~opaque:Proof_global.Transparent ~idopt:None
 
 let def_of_const t =
-   match (Constr.kind t) with
-    Const sp ->
-      (try (match constant_opt_value_in (Global.env ()) sp with
-             | Some c -> c
-             | _ -> raise Not_found)
-       with Not_found ->
-         anomaly (str "Cannot find definition of constant " ++
-                    (Id.print (Label.to_id (Constant.label (fst sp)))) ++ str ".")
-      )
-     |_ -> assert false
+  match Constr.kind t with
+  | Const sp -> (
+    try
+      match constant_opt_value_in (Global.env ()) sp with
+      | Some c -> c
+      | _ -> raise Not_found
+    with Not_found ->
+      anomaly
+        ( str "Cannot find definition of constant "
+        ++ Id.print (Label.to_id (Constant.label (fst sp)))
+        ++ str "." ) )
+  | _ -> assert false
 
 let type_of_const sigma t =
-   match (EConstr.kind sigma t) with
-   | Const (sp, u) ->
-      let u = EInstance.kind sigma u in
-      (* FIXME discarding universe constraints *)
-      Typeops.type_of_constant_in (Global.env()) (sp, u)
-    |_ -> assert false
+  match EConstr.kind sigma t with
+  | Const (sp, u) ->
+    let u = EInstance.kind sigma u in
+    (* FIXME discarding universe constraints *)
+    Typeops.type_of_constant_in (Global.env ()) (sp, u)
+  | _ -> assert false
 
 let constant sl s = UnivGen.constr_of_monomorphic_global (find_reference sl s)
 
 let const_of_ref = function
-    GlobRef.ConstRef kn -> kn
+  | GlobRef.ConstRef kn -> kn
   | _ -> anomaly (Pp.str "ConstRef expected.")
 
 (* Generic values *)
@@ -96,16 +93,16 @@ let pf_get_new_ids idl g =
   let ids = pf_ids_of_hyps g in
   let ids = Id.Set.of_list ids in
   List.fold_right
-    (fun id acc -> next_global_ident_away id (Id.Set.union (Id.Set.of_list acc) ids)::acc)
-    idl
-    []
+    (fun id acc ->
+      next_global_ident_away id (Id.Set.union (Id.Set.of_list acc) ids) :: acc)
+    idl []
 
 let next_ident_away_in_goal ids avoid =
   next_ident_away_in_goal ids (Id.Set.of_list avoid)
 
 let compute_renamed_type gls id =
-  rename_bound_vars_as_displayed (project gls) (*no avoid*) Id.Set.empty (*no rels*) []
-    (pf_get_hyp_typ gls id)
+  rename_bound_vars_as_displayed (project gls) (*no avoid*) Id.Set.empty
+    (*no rels*) [] (pf_get_hyp_typ gls id)
 
 let h'_id = Id.of_string "h'"
 let teq_id = Id.of_string "teq"
@@ -115,112 +112,140 @@ let k_id = Id.of_string "k"
 let v_id = Id.of_string "v"
 let def_id = Id.of_string "def"
 let p_id = Id.of_string "p"
-let rec_res_id = Id.of_string "rec_res";;
-let lt = function () -> (coq_init_constant "num.nat.lt")
+let rec_res_id = Id.of_string "rec_res"
+let lt = function () -> coq_init_constant "num.nat.lt"
 let le = function () -> Coqlib.lib_ref "num.nat.le"
+let ex = function () -> coq_init_constant "core.ex.type"
+let nat = function () -> coq_init_constant "num.nat.type"
 
-let ex = function () -> (coq_init_constant "core.ex.type")
-let nat = function () -> (coq_init_constant "num.nat.type")
 let iter_ref () =
   try find_reference ["Recdef"] "iter"
   with Not_found -> user_err Pp.(str "module Recdef not loaded")
-let iter_rd = function () -> (constr_of_monomorphic_global (delayed_force iter_ref))
-let eq = function () -> (coq_init_constant "core.eq.type")
-let le_lt_SS = function () -> (constant ["Recdef"] "le_lt_SS")
-let le_lt_n_Sm = function () -> (coq_constant "num.nat.le_lt_n_Sm")
-let le_trans = function () -> (coq_constant "num.nat.le_trans")
-let le_lt_trans = function () -> (coq_constant "num.nat.le_lt_trans")
-let lt_S_n = function () -> (coq_constant "num.nat.lt_S_n")
-let le_n = function () -> (coq_init_constant "num.nat.le_n")
-let coq_sig_ref = function () -> (find_reference ["Coq";"Init";"Specif"] "sig")
-let coq_O = function () -> (coq_init_constant "num.nat.O")
-let coq_S = function () -> (coq_init_constant"num.nat.S")
-let lt_n_O = function () -> (coq_constant "num.nat.nlt_0_r")
-let max_ref = function () -> (find_reference ["Recdef"] "max")
-let max_constr = function () -> EConstr.of_constr (constr_of_monomorphic_global (delayed_force max_ref))
-
-let f_S t = mkApp(delayed_force coq_S, [|t|]);;
+
+let iter_rd = function
+  | () -> constr_of_monomorphic_global (delayed_force iter_ref)
+
+let eq = function () -> coq_init_constant "core.eq.type"
+let le_lt_SS = function () -> constant ["Recdef"] "le_lt_SS"
+let le_lt_n_Sm = function () -> coq_constant "num.nat.le_lt_n_Sm"
+let le_trans = function () -> coq_constant "num.nat.le_trans"
+let le_lt_trans = function () -> coq_constant "num.nat.le_lt_trans"
+let lt_S_n = function () -> coq_constant "num.nat.lt_S_n"
+let le_n = function () -> coq_init_constant "num.nat.le_n"
+
+let coq_sig_ref = function
+  | () -> find_reference ["Coq"; "Init"; "Specif"] "sig"
+
+let coq_O = function () -> coq_init_constant "num.nat.O"
+let coq_S = function () -> coq_init_constant "num.nat.S"
+let lt_n_O = function () -> coq_constant "num.nat.nlt_0_r"
+let max_ref = function () -> find_reference ["Recdef"] "max"
+
+let max_constr = function
+  | () ->
+    EConstr.of_constr (constr_of_monomorphic_global (delayed_force max_ref))
+
+let f_S t = mkApp (delayed_force coq_S, [|t|])
 
 let rec n_x_id ids n =
   if Int.equal n 0 then []
-  else let x = next_ident_away_in_goal x_id ids in
-          x::n_x_id (x::ids) (n-1);;
-
+  else
+    let x = next_ident_away_in_goal x_id ids in
+    x :: n_x_id (x :: ids) (n - 1)
 
 let simpl_iter clause =
   reduce
     (Lazy
-       {rBeta=true;rMatch=true;rFix=true;rCofix=true;rZeta=true;rDelta=false;
-        rConst = [ EvalConstRef (const_of_ref (delayed_force iter_ref))]})
+       { rBeta = true
+       ; rMatch = true
+       ; rFix = true
+       ; rCofix = true
+       ; rZeta = true
+       ; rDelta = false
+       ; rConst = [EvalConstRef (const_of_ref (delayed_force iter_ref))] })
     clause
 
 (* Others ugly things ... *)
-let (value_f: Constr.t list -> GlobRef.t -> Constr.t) =
+let (value_f : Constr.t list -> GlobRef.t -> Constr.t) =
   let open Term in
   let open Constr in
   fun al fterm ->
     let rev_x_id_l =
-      (
-        List.fold_left
-          (fun x_id_l _ ->
-             let x_id = next_ident_away_in_goal x_id x_id_l in
-             x_id::x_id_l
-          )
-          []
-          al
-      )
+      List.fold_left
+        (fun x_id_l _ ->
+          let x_id = next_ident_away_in_goal x_id x_id_l in
+          x_id :: x_id_l)
+        [] al
     in
-    let context = List.map
-      (fun (x, c) -> LocalAssum (make_annot (Name x) Sorts.Relevant, c)) (List.combine rev_x_id_l (List.rev al))
+    let context =
+      List.map
+        (fun (x, c) -> LocalAssum (make_annot (Name x) Sorts.Relevant, c))
+        (List.combine rev_x_id_l (List.rev al))
     in
     let env = Environ.push_rel_context context (Global.env ()) in
     let glob_body =
-      DAst.make @@
-       GCases
-        (RegularStyle,None,
-         [DAst.make @@ GApp(DAst.make @@ GRef(fterm,None), List.rev_map (fun x_id -> DAst.make @@ GVar x_id) rev_x_id_l),
-          (Anonymous,None)],
-         [CAst.make ([v_id], [DAst.make @@ PatCstr ((destIndRef (delayed_force coq_sig_ref),1),
-                           [DAst.make @@ PatVar(Name v_id); DAst.make @@ PatVar Anonymous],
-                           Anonymous)],
-            DAst.make @@ GVar v_id)])
+      DAst.make
+      @@ GCases
+           ( RegularStyle
+           , None
+           , [ ( DAst.make
+                 @@ GApp
+                      ( DAst.make @@ GRef (fterm, None)
+                      , List.rev_map
+                          (fun x_id -> DAst.make @@ GVar x_id)
+                          rev_x_id_l )
+               , (Anonymous, None) ) ]
+           , [ CAst.make
+                 ( [v_id]
+                 , [ DAst.make
+                     @@ PatCstr
+                          ( (destIndRef (delayed_force coq_sig_ref), 1)
+                          , [ DAst.make @@ PatVar (Name v_id)
+                            ; DAst.make @@ PatVar Anonymous ]
+                          , Anonymous ) ]
+                 , DAst.make @@ GVar v_id ) ] )
     in
-    let body = fst (understand env (Evd.from_env env) glob_body)(*FIXME*) in
+    let body = fst (understand env (Evd.from_env env) glob_body) (*FIXME*) in
     let body = EConstr.Unsafe.to_constr body in
     it_mkLambda_or_LetIn body context
 
-let (declare_f : Id.t -> Decls.logical_kind -> Constr.t list -> GlobRef.t -> GlobRef.t) =
-  fun f_id kind input_type fterm_ref ->
-    declare_fun f_id kind (value_f input_type fterm_ref);;
+let (declare_f :
+      Id.t -> Decls.logical_kind -> Constr.t list -> GlobRef.t -> GlobRef.t) =
+ fun f_id kind input_type fterm_ref ->
+  declare_fun f_id kind (value_f input_type fterm_ref)
 
 let observe_tclTHENLIST s tacl =
-  if do_observe ()
-  then
+  if do_observe () then
     let rec aux n = function
       | [] -> tclIDTAC
-      | [tac] -> observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) tac
-      | tac::tacl -> observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) (tclTHEN tac (aux (succ n) tacl))
+      | [tac] ->
+        observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) tac
+      | tac :: tacl ->
+        observe_tac
+          (fun env sigma -> s env sigma ++ spc () ++ int n)
+          (tclTHEN tac (aux (succ n) tacl))
     in
     aux 0 tacl
   else tclTHENLIST tacl
 
 module New = struct
-
   open Tacticals.New
 
-  let observe_tac = New.observe_tac ~header:(Pp.mt())
+  let observe_tac = New.observe_tac ~header:(Pp.mt ())
 
   let observe_tclTHENLIST s tacl =
-  if do_observe ()
-  then
-    let rec aux n = function
-      | [] -> tclIDTAC
-      | [tac] -> observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) tac
-      | tac::tacl -> observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) (tclTHEN tac (aux (succ n) tacl))
-    in
-    aux 0 tacl
-  else tclTHENLIST tacl
-
+    if do_observe () then
+      let rec aux n = function
+        | [] -> tclIDTAC
+        | [tac] ->
+          observe_tac (fun env sigma -> s env sigma ++ spc () ++ int n) tac
+        | tac :: tacl ->
+          observe_tac
+            (fun env sigma -> s env sigma ++ spc () ++ int n)
+            (tclTHEN tac (aux (succ n) tacl))
+      in
+      aux 0 tacl
+    else tclTHENLIST tacl
 end
 
 (* Conclusion tactics *)
@@ -234,23 +259,25 @@ let tclUSER tac is_mes l =
     | None -> tclIDTAC
     | Some l -> tclMAP (fun id -> tclTRY (clear [id])) (List.rev l)
   in
-  New.observe_tclTHENLIST (fun _ _ -> str "tclUSER1")
-    [ clear_tac;
-      if is_mes
-      then
-        New.observe_tclTHENLIST (fun _ _ -> str "tclUSER2")
-          [ unfold_in_concl [(Locus.AllOccurrences, evaluable_of_global_reference
-                                (delayed_force Indfun_common.ltof_ref))]
-          ; tac
-          ]
-      else tac
-    ]
+  New.observe_tclTHENLIST
+    (fun _ _ -> str "tclUSER1")
+    [ clear_tac
+    ; ( if is_mes then
+        New.observe_tclTHENLIST
+          (fun _ _ -> str "tclUSER2")
+          [ unfold_in_concl
+              [ ( Locus.AllOccurrences
+                , evaluable_of_global_reference
+                    (delayed_force Indfun_common.ltof_ref) ) ]
+          ; tac ]
+      else tac ) ]
 
 let tclUSER_if_not_mes concl_tac is_mes names_to_suppress =
-  if is_mes
-  then Tacticals.New.tclCOMPLETE (Simple.apply (delayed_force well_founded_ltof))
-  else (* tclTHEN (Simple.apply (delayed_force acc_intro_generator_function) ) *)
-    (tclUSER concl_tac is_mes names_to_suppress)
+  if is_mes then
+    Tacticals.New.tclCOMPLETE (Simple.apply (delayed_force well_founded_ltof))
+  else
+    (* tclTHEN (Simple.apply (delayed_force acc_intro_generator_function) ) *)
+    tclUSER concl_tac is_mes names_to_suppress
 
 (* Traveling term.
    Both definitions of [f_terminate] and [f_equation] use the same generic
@@ -263,210 +290,243 @@ let tclUSER_if_not_mes concl_tac is_mes names_to_suppress =
 let check_not_nested env sigma forbidden e =
   let rec check_not_nested e =
     match EConstr.kind sigma e with
-      | Rel _ -> ()
-      | Int _ | Float _ -> ()
-      | Var x ->
-        if Id.List.mem x forbidden
-        then user_err ~hdr:"Recdef.check_not_nested"
-               (str "check_not_nested: failure " ++ Id.print x)
-      | Meta _ | Evar _ | Sort _ -> ()
-      | Cast(e,_,t) -> check_not_nested e;check_not_nested t
-      | Prod(_,t,b) -> check_not_nested t;check_not_nested b
-      | Lambda(_,t,b) -> check_not_nested t;check_not_nested b
-      | LetIn(_,v,t,b) -> check_not_nested t;check_not_nested b;check_not_nested v
-      | App(f,l) -> check_not_nested f;Array.iter check_not_nested l
-      | Proj (p,c) -> check_not_nested c
-      | Const _ -> ()
-      | Ind _ -> ()
-      | Construct _ -> ()
-      | Case(_,t,e,a) ->
-        check_not_nested t;check_not_nested e;Array.iter check_not_nested a
-      | Fix _ -> user_err Pp.(str "check_not_nested : Fix")
-      | CoFix _ -> user_err Pp.(str "check_not_nested : Fix")
+    | Rel _ -> ()
+    | Int _ | Float _ -> ()
+    | Var x ->
+      if Id.List.mem x forbidden then
+        user_err ~hdr:"Recdef.check_not_nested"
+          (str "check_not_nested: failure " ++ Id.print x)
+    | Meta _ | Evar _ | Sort _ -> ()
+    | Cast (e, _, t) -> check_not_nested e; check_not_nested t
+    | Prod (_, t, b) -> check_not_nested t; check_not_nested b
+    | Lambda (_, t, b) -> check_not_nested t; check_not_nested b
+    | LetIn (_, v, t, b) ->
+      check_not_nested t; check_not_nested b; check_not_nested v
+    | App (f, l) ->
+      check_not_nested f;
+      Array.iter check_not_nested l
+    | Proj (p, c) -> check_not_nested c
+    | Const _ -> ()
+    | Ind _ -> ()
+    | Construct _ -> ()
+    | Case (_, t, e, a) ->
+      check_not_nested t;
+      check_not_nested e;
+      Array.iter check_not_nested a
+    | Fix _ -> user_err Pp.(str "check_not_nested : Fix")
+    | CoFix _ -> user_err Pp.(str "check_not_nested : Fix")
   in
-  try
-    check_not_nested e
-  with UserError(_,p) ->
-    user_err ~hdr:"_" (str "on expr : " ++ Printer.pr_leconstr_env env sigma e ++ str " " ++ p)
+  try check_not_nested e
+  with UserError (_, p) ->
+    user_err ~hdr:"_"
+      (str "on expr : " ++ Printer.pr_leconstr_env env sigma e ++ str " " ++ p)
 
 (* ['a info] contains the local information for traveling *)
 type 'a infos =
-    { nb_arg : int; (* function number of arguments *)
-      concl_tac : unit Proofview.tactic; (* final tactic to finish proofs *)
-      rec_arg_id : Id.t; (*name of the declared recursive argument *)
-      is_mes : bool; (* type of recursion *)
-      ih : Id.t; (* induction hypothesis name *)
-      f_id : Id.t;  (* function name *)
-      f_constr : constr;  (* function term *)
-      f_terminate : constr; (* termination proof term *)
-      func : GlobRef.t; (* functional reference *)
-      info : 'a;
-      is_main_branch : bool; (* on the main branch or on a matched expression *)
-      is_final : bool; (* final first order term or not *)
-      values_and_bounds : (Id.t*Id.t) list;
-      eqs : Id.t list;
-      forbidden_ids : Id.t list;
-      acc_inv : constr lazy_t;
-      acc_id : Id.t;
-      args_assoc : ((constr list)*constr) list;
-    }
-
-
-type ('a,'b) journey_info_tac =
-    'a -> (* the arguments of the constructor *)
-    'b infos -> (* infos of the caller *)
-    ('b infos -> tactic) -> (* the continuation tactic of the caller *)
-    'b infos -> (* argument of the tactic *)
-    tactic
+  { nb_arg : int
+  ; (* function number of arguments *)
+    concl_tac : unit Proofview.tactic
+  ; (* final tactic to finish proofs *)
+    rec_arg_id : Id.t
+  ; (*name of the declared recursive argument *)
+    is_mes : bool
+  ; (* type of recursion *)
+    ih : Id.t
+  ; (* induction hypothesis name *)
+    f_id : Id.t
+  ; (* function name *)
+    f_constr : constr
+  ; (* function term *)
+    f_terminate : constr
+  ; (* termination proof term *)
+    func : GlobRef.t
+  ; (* functional reference *)
+    info : 'a
+  ; is_main_branch : bool
+  ; (* on the main branch or on a matched expression *)
+    is_final : bool
+  ; (* final first order term or not *)
+    values_and_bounds : (Id.t * Id.t) list
+  ; eqs : Id.t list
+  ; forbidden_ids : Id.t list
+  ; acc_inv : constr lazy_t
+  ; acc_id : Id.t
+  ; args_assoc : (constr list * constr) list }
+
+type ('a, 'b) journey_info_tac =
+     'a
+  -> (* the arguments of the constructor *)
+     'b infos
+  -> (* infos of the caller *)
+     ('b infos -> tactic)
+  -> (* the continuation tactic of the caller *)
+     'b infos
+  -> (* argument of the tactic *)
+     tactic
 
 (* journey_info : specifies the actions to do on the different term constructors during the traveling of the term
 *)
 type journey_info =
-    { letiN : ((Name.t*constr*types*constr),constr) journey_info_tac;
-      lambdA : ((Name.t*types*constr),constr) journey_info_tac;
-      casE : ((constr infos -> tactic) -> constr infos -> tactic) ->
-        ((case_info * constr * constr * constr array),constr) journey_info_tac;
-      otherS : (unit,constr) journey_info_tac;
-      apP : (constr*(constr list),constr) journey_info_tac;
-      app_reC : (constr*(constr list),constr) journey_info_tac;
-      message : string
-    }
-
-
+  { letiN : (Name.t * constr * types * constr, constr) journey_info_tac
+  ; lambdA : (Name.t * types * constr, constr) journey_info_tac
+  ; casE :
+         ((constr infos -> tactic) -> constr infos -> tactic)
+      -> (case_info * constr * constr * constr array, constr) journey_info_tac
+  ; otherS : (unit, constr) journey_info_tac
+  ; apP : (constr * constr list, constr) journey_info_tac
+  ; app_reC : (constr * constr list, constr) journey_info_tac
+  ; message : string }
 
 let add_vars sigma forbidden e =
   let rec aux forbidden e =
-  match EConstr.kind sigma e with
-    | Var x -> x::forbidden
+    match EConstr.kind sigma e with
+    | Var x -> x :: forbidden
     | _ -> EConstr.fold sigma aux forbidden e
   in
   aux forbidden e
 
 let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic =
-  fun g ->
-    let rev_context,b = decompose_lam_n (project g) nb_lam e in
-    let ids = List.fold_left (fun acc (na,_) ->
-      let pre_id =
-        match na.binder_name with
-          | Name x -> x
-          | Anonymous -> ano_id
-      in
-      pre_id::acc
-    ) [] rev_context in
-    let rev_ids = pf_get_new_ids (List.rev ids) g in
-    let new_b = substl (List.map mkVar rev_ids) b in
-    observe_tclTHENLIST (fun _ _ -> str "treat_case1")
-      [
-        h_intros (List.rev rev_ids);
-        Proofview.V82.of_tactic (intro_using teq_id);
-        onLastHypId (fun heq ->
-          observe_tclTHENLIST (fun _ _ -> str "treat_case2")[
-            Proofview.V82.of_tactic (clear to_intros);
-            h_intros to_intros;
-            (fun g' ->
-              let ty_teq = pf_get_hyp_typ g' heq in
-              let teq_lhs,teq_rhs =
-                let _,args = try destApp (project g') ty_teq with DestKO -> assert false in
-                args.(1),args.(2)
-              in
-              let new_b' = Termops.replace_term (project g') teq_lhs teq_rhs new_b in
-              let new_infos = {
-                infos with
-                  info = new_b';
-                  eqs = heq::infos.eqs;
-                  forbidden_ids =
-                  if forbid_new_ids
-                  then add_vars (project g') infos.forbidden_ids new_b'
-                  else infos.forbidden_ids
-              } in
-              finalize_tac new_infos g'
-            )
-          ]
-        )
-      ] g
-
-let rec travel_aux jinfo continuation_tac (expr_info:constr infos) g =
+ fun g ->
+  let rev_context, b = decompose_lam_n (project g) nb_lam e in
+  let ids =
+    List.fold_left
+      (fun acc (na, _) ->
+        let pre_id =
+          match na.binder_name with Name x -> x | Anonymous -> ano_id
+        in
+        pre_id :: acc)
+      [] rev_context
+  in
+  let rev_ids = pf_get_new_ids (List.rev ids) g in
+  let new_b = substl (List.map mkVar rev_ids) b in
+  observe_tclTHENLIST
+    (fun _ _ -> str "treat_case1")
+    [ h_intros (List.rev rev_ids)
+    ; Proofview.V82.of_tactic (intro_using teq_id)
+    ; onLastHypId (fun heq ->
+          observe_tclTHENLIST
+            (fun _ _ -> str "treat_case2")
+            [ Proofview.V82.of_tactic (clear to_intros)
+            ; h_intros to_intros
+            ; (fun g' ->
+                let ty_teq = pf_get_hyp_typ g' heq in
+                let teq_lhs, teq_rhs =
+                  let _, args =
+                    try destApp (project g') ty_teq
+                    with DestKO -> assert false
+                  in
+                  (args.(1), args.(2))
+                in
+                let new_b' =
+                  Termops.replace_term (project g') teq_lhs teq_rhs new_b
+                in
+                let new_infos =
+                  { infos with
+                    info = new_b'
+                  ; eqs = heq :: infos.eqs
+                  ; forbidden_ids =
+                      ( if forbid_new_ids then
+                        add_vars (project g') infos.forbidden_ids new_b'
+                      else infos.forbidden_ids ) }
+                in
+                finalize_tac new_infos g') ]) ]
+    g
+
+let rec travel_aux jinfo continuation_tac (expr_info : constr infos) g =
   let sigma = project g in
   let env = pf_env g in
   match EConstr.kind sigma expr_info.info with
-    | CoFix _ | Fix _ -> user_err Pp.(str "Function cannot treat local fixpoint or cofixpoint")
-    | Proj _ -> user_err Pp.(str "Function cannot treat projections")
-    | LetIn(na,b,t,e) ->
-      begin
+  | CoFix _ | Fix _ ->
+    user_err Pp.(str "Function cannot treat local fixpoint or cofixpoint")
+  | Proj _ -> user_err Pp.(str "Function cannot treat projections")
+  | LetIn (na, b, t, e) ->
+    let new_continuation_tac =
+      jinfo.letiN (na.binder_name, b, t, e) expr_info continuation_tac
+    in
+    travel jinfo new_continuation_tac
+      {expr_info with info = b; is_final = false}
+      g
+  | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
+  | Prod _ -> (
+    try
+      check_not_nested env sigma
+        (expr_info.f_id :: expr_info.forbidden_ids)
+        expr_info.info;
+      jinfo.otherS () expr_info continuation_tac expr_info g
+    with e when CErrors.noncritical e ->
+      user_err ~hdr:"Recdef.travel"
+        ( str "the term "
+        ++ Printer.pr_leconstr_env env sigma expr_info.info
+        ++ str " can not contain a recursive call to "
+        ++ Id.print expr_info.f_id ) )
+  | Lambda (n, t, b) -> (
+    try
+      check_not_nested env sigma
+        (expr_info.f_id :: expr_info.forbidden_ids)
+        expr_info.info;
+      jinfo.otherS () expr_info continuation_tac expr_info g
+    with e when CErrors.noncritical e ->
+      user_err ~hdr:"Recdef.travel"
+        ( str "the term "
+        ++ Printer.pr_leconstr_env env sigma expr_info.info
+        ++ str " can not contain a recursive call to "
+        ++ Id.print expr_info.f_id ) )
+  | Case (ci, t, a, l) ->
+    let continuation_tac_a =
+      jinfo.casE (travel jinfo) (ci, t, a, l) expr_info continuation_tac
+    in
+    travel jinfo continuation_tac_a
+      {expr_info with info = a; is_main_branch = false; is_final = false}
+      g
+  | App _ -> (
+    let f, args = decompose_app sigma expr_info.info in
+    if EConstr.eq_constr sigma f expr_info.f_constr then
+      jinfo.app_reC (f, args) expr_info continuation_tac expr_info g
+    else
+      match EConstr.kind sigma f with
+      | App _ -> assert false (* f is coming from a decompose_app *)
+      | Const _ | Construct _ | Rel _ | Evar _ | Meta _ | Ind _ | Sort _
+       |Prod _ | Var _ ->
+        let new_infos = {expr_info with info = (f, args)} in
         let new_continuation_tac =
-          jinfo.letiN (na.binder_name,b,t,e) expr_info continuation_tac
+          jinfo.apP (f, args) expr_info continuation_tac
         in
-        travel jinfo new_continuation_tac
-          {expr_info with info = b; is_final=false} g
-      end
-    | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
-    | Prod _ ->
-      begin
-        try
-          check_not_nested env sigma (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
-          jinfo.otherS () expr_info continuation_tac expr_info g
-        with e when CErrors.noncritical e ->
-          user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env env sigma expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
-      end
-    | Lambda(n,t,b) ->
-      begin
-        try
-          check_not_nested env sigma (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
-          jinfo.otherS () expr_info continuation_tac expr_info g
-        with e when CErrors.noncritical e ->
-          user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env env sigma expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
-      end
-    | Case(ci,t,a,l) ->
-      begin
-        let continuation_tac_a =
-          jinfo.casE
-            (travel jinfo) (ci,t,a,l)
-            expr_info continuation_tac in
-        travel
-          jinfo continuation_tac_a
-          {expr_info with info = a; is_main_branch = false;
-            is_final = false} g
-      end
-    | App _ ->
-      let f,args = decompose_app sigma expr_info.info in
-      if EConstr.eq_constr sigma f (expr_info.f_constr)
-      then jinfo.app_reC (f,args) expr_info continuation_tac expr_info g
-      else
-      begin
-        match EConstr.kind sigma f with
-          | App _ -> assert false (* f is coming from a decompose_app *)
-          | Const _ | Construct _ | Rel _ | Evar _ | Meta _  | Ind _
-          | Sort _ | Prod _ | Var _ ->
-            let new_infos = {expr_info with info=(f,args)} in
-            let new_continuation_tac =
-              jinfo.apP (f,args) expr_info continuation_tac in
-            travel_args jinfo
-              expr_info.is_main_branch new_continuation_tac new_infos g
-          | Case _ ->  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env env sigma expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
-          | _ -> anomaly (Pp.str "travel_aux : unexpected "++ Printer.pr_leconstr_env env sigma expr_info.info ++ Pp.str ".")
-      end
-    | Cast(t,_,_) -> travel jinfo continuation_tac {expr_info with info=t} g
-    | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ | Int _ | Float _ ->
-      let new_continuation_tac =
-        jinfo.otherS () expr_info continuation_tac in
-      new_continuation_tac expr_info g
+        travel_args jinfo expr_info.is_main_branch new_continuation_tac
+          new_infos g
+      | Case _ ->
+        user_err ~hdr:"Recdef.travel"
+          ( str "the term "
+          ++ Printer.pr_leconstr_env env sigma expr_info.info
+          ++ str
+               " can not contain an applied match (See Limitation in Section \
+                2.3 of refman)" )
+      | _ ->
+        anomaly
+          ( Pp.str "travel_aux : unexpected "
+          ++ Printer.pr_leconstr_env env sigma expr_info.info
+          ++ Pp.str "." ) )
+  | Cast (t, _, _) -> travel jinfo continuation_tac {expr_info with info = t} g
+  | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ | Int _
+   |Float _ ->
+    let new_continuation_tac = jinfo.otherS () expr_info continuation_tac in
+    new_continuation_tac expr_info g
+
 and travel_args jinfo is_final continuation_tac infos =
-  let (f_args',args) = infos.info in
+  let f_args', args = infos.info in
   match args with
-    | [] ->
-      continuation_tac {infos with info = f_args'; is_final = is_final}
-    | arg::args' ->
-      let new_continuation_tac new_infos =
-        let new_arg = new_infos.info in
-        travel_args jinfo is_final
-          continuation_tac
-          {new_infos with info = (mkApp(f_args',[|new_arg|]),args')}
-      in
-      travel jinfo new_continuation_tac
-        {infos with info=arg;is_final=false}
+  | [] -> continuation_tac {infos with info = f_args'; is_final}
+  | arg :: args' ->
+    let new_continuation_tac new_infos =
+      let new_arg = new_infos.info in
+      travel_args jinfo is_final continuation_tac
+        {new_infos with info = (mkApp (f_args', [|new_arg|]), args')}
+    in
+    travel jinfo new_continuation_tac {infos with info = arg; is_final = false}
+
 and travel jinfo continuation_tac expr_info =
   observe_tac
-    (fun env sigma -> str jinfo.message ++ Printer.pr_leconstr_env env sigma expr_info.info)
+    (fun env sigma ->
+      str jinfo.message ++ Printer.pr_leconstr_env env sigma expr_info.info)
     (travel_aux jinfo continuation_tac expr_info)
 
 (* Termination proof *)
@@ -475,164 +535,185 @@ let rec prove_lt hyple g =
   let sigma = project g in
   begin
     try
-      let (varx,varz) = match decompose_app sigma (pf_concl g) with
-        | _, x::z::_ when isVar sigma x && isVar sigma z -> x, z
+      let varx, varz =
+        match decompose_app sigma (pf_concl g) with
+        | _, x :: z :: _ when isVar sigma x && isVar sigma z -> (x, z)
         | _ -> assert false
       in
       let h =
-        List.find (fun id ->
-          match decompose_app sigma (pf_get_hyp_typ g id) with
-            | _, t::_ -> EConstr.eq_constr sigma t varx
-            | _ -> false
-        ) hyple
+        List.find
+          (fun id ->
+            match decompose_app sigma (pf_get_hyp_typ g id) with
+            | _, t :: _ -> EConstr.eq_constr sigma t varx
+            | _ -> false)
+          hyple
       in
       let y =
-        List.hd (List.tl (snd (decompose_app sigma (pf_get_hyp_typ g h)))) in
-      observe_tclTHENLIST (fun _ _ -> str "prove_lt1")[
-        Proofview.V82.of_tactic (apply (mkApp(le_lt_trans (),[|varx;y;varz;mkVar h|])));
-        observe_tac (fun _ _ -> str "prove_lt") (prove_lt hyple)
-      ]
+        List.hd (List.tl (snd (decompose_app sigma (pf_get_hyp_typ g h))))
+      in
+      observe_tclTHENLIST
+        (fun _ _ -> str "prove_lt1")
+        [ Proofview.V82.of_tactic
+            (apply (mkApp (le_lt_trans (), [|varx; y; varz; mkVar h|])))
+        ; observe_tac (fun _ _ -> str "prove_lt") (prove_lt hyple) ]
     with Not_found ->
-      (
-        (
-          observe_tclTHENLIST (fun _ _ -> str "prove_lt2")[
-            Proofview.V82.of_tactic (apply (delayed_force lt_S_n));
-            (observe_tac (fun _ _ -> str "assumption: " ++ Printer.pr_goal g) (Proofview.V82.of_tactic assumption))
-          ])
-      )
+      observe_tclTHENLIST
+        (fun _ _ -> str "prove_lt2")
+        [ Proofview.V82.of_tactic (apply (delayed_force lt_S_n))
+        ; observe_tac
+            (fun _ _ -> str "assumption: " ++ Printer.pr_goal g)
+            (Proofview.V82.of_tactic assumption) ]
   end
     g
 
-let rec destruct_bounds_aux infos (bound,hyple,rechyps) lbounds g =
+let rec destruct_bounds_aux infos (bound, hyple, rechyps) lbounds g =
   match lbounds with
-    | [] ->
-      let ids = pf_ids_of_hyps g in
-      let s_max = mkApp(delayed_force coq_S, [|bound|]) in
-      let k = next_ident_away_in_goal k_id ids in
-      let ids = k::ids in
-      let h' = next_ident_away_in_goal (h'_id) ids in
-      let ids = h'::ids in
-      let def = next_ident_away_in_goal def_id ids in
-      observe_tclTHENLIST (fun _ _ -> str "destruct_bounds_aux1")[
-        Proofview.V82.of_tactic (split (ImplicitBindings [s_max]));
-        Proofview.V82.of_tactic (intro_then
-          (fun id ->
-            Proofview.V82.tactic begin
-            observe_tac (fun _ _ -> str "destruct_bounds_aux")
-              (tclTHENS (Proofview.V82.of_tactic (simplest_case (mkVar id)))
-                 [
-                   observe_tclTHENLIST (fun _ _ -> str "")[Proofview.V82.of_tactic (intro_using h_id);
-                               Proofview.V82.of_tactic (simplest_elim(mkApp(delayed_force lt_n_O,[|s_max|])));
-                               Proofview.V82.of_tactic default_full_auto];
-                   observe_tclTHENLIST (fun _ _ -> str "destruct_bounds_aux2")[
-                     observe_tac (fun _ _ -> str "clearing k ") (Proofview.V82.of_tactic (clear [id]));
-                     h_intros [k;h';def];
-                     observe_tac (fun _ _ -> str "simple_iter") (Proofview.V82.of_tactic (simpl_iter Locusops.onConcl));
-                     observe_tac (fun _ _ -> str "unfold functional")
-                       (Proofview.V82.of_tactic (unfold_in_concl[(Locus.OnlyOccurrences [1],
-                                         evaluable_of_global_reference infos.func)]));
-                     (
-                       observe_tclTHENLIST (fun _ _ -> str "test")[
-                         list_rewrite true
-                           (List.fold_right
-                              (fun e acc -> (mkVar e,true)::acc)
-                              infos.eqs
-                              (List.map (fun e -> (e,true)) rechyps)
-                           );
-                      (* list_rewrite true *)
-                      (*   (List.map (fun e -> (mkVar e,true)) infos.eqs) *)
-                      (*   ; *)
-
-                         (observe_tac (fun _ _ -> str "finishing")
-                            (tclORELSE
-                               (Proofview.V82.of_tactic intros_reflexivity)
-                               (observe_tac (fun _ _ -> str "calling prove_lt") (prove_lt hyple))))])
-                   ]
-              ]
-              )end))
-          ] g
-      | (_,v_bound)::l ->
-      observe_tclTHENLIST (fun _ _ -> str "destruct_bounds_aux3")[
-        Proofview.V82.of_tactic (simplest_elim (mkVar v_bound));
-        Proofview.V82.of_tactic (clear [v_bound]);
-        tclDO 2 (Proofview.V82.of_tactic intro);
-        onNthHypId 1
-          (fun p_hyp ->
-            (onNthHypId 2
-               (fun p ->
-                 observe_tclTHENLIST (fun _ _ -> str "destruct_bounds_aux4")[
-                   Proofview.V82.of_tactic (simplest_elim
-                     (mkApp(delayed_force max_constr, [| bound; mkVar p|])));
-                   tclDO 3 (Proofview.V82.of_tactic intro);
-                   onNLastHypsId 3 (fun lids ->
-                     match lids with
-                       [hle2;hle1;pmax] ->
-                         destruct_bounds_aux infos
-                           ((mkVar pmax),
-                            hle1::hle2::hyple,(mkVar p_hyp)::rechyps)
-                           l
-                       | _ -> assert false) ;
-                 ]
-               )
-            )
-          )
-      ] g
+  | [] ->
+    let ids = pf_ids_of_hyps g in
+    let s_max = mkApp (delayed_force coq_S, [|bound|]) in
+    let k = next_ident_away_in_goal k_id ids in
+    let ids = k :: ids in
+    let h' = next_ident_away_in_goal h'_id ids in
+    let ids = h' :: ids in
+    let def = next_ident_away_in_goal def_id ids in
+    observe_tclTHENLIST
+      (fun _ _ -> str "destruct_bounds_aux1")
+      [ Proofview.V82.of_tactic (split (ImplicitBindings [s_max]))
+      ; Proofview.V82.of_tactic
+          (intro_then (fun id ->
+               Proofview.V82.tactic
+                 (observe_tac
+                    (fun _ _ -> str "destruct_bounds_aux")
+                    (tclTHENS
+                       (Proofview.V82.of_tactic (simplest_case (mkVar id)))
+                       [ observe_tclTHENLIST
+                           (fun _ _ -> str "")
+                           [ Proofview.V82.of_tactic (intro_using h_id)
+                           ; Proofview.V82.of_tactic
+                               (simplest_elim
+                                  (mkApp (delayed_force lt_n_O, [|s_max|])))
+                           ; Proofview.V82.of_tactic default_full_auto ]
+                       ; observe_tclTHENLIST
+                           (fun _ _ -> str "destruct_bounds_aux2")
+                           [ observe_tac
+                               (fun _ _ -> str "clearing k ")
+                               (Proofview.V82.of_tactic (clear [id]))
+                           ; h_intros [k; h'; def]
+                           ; observe_tac
+                               (fun _ _ -> str "simple_iter")
+                               (Proofview.V82.of_tactic
+                                  (simpl_iter Locusops.onConcl))
+                           ; observe_tac
+                               (fun _ _ -> str "unfold functional")
+                               (Proofview.V82.of_tactic
+                                  (unfold_in_concl
+                                     [ ( Locus.OnlyOccurrences [1]
+                                       , evaluable_of_global_reference
+                                           infos.func ) ]))
+                           ; observe_tclTHENLIST
+                               (fun _ _ -> str "test")
+                               [ list_rewrite true
+                                   (List.fold_right
+                                      (fun e acc -> (mkVar e, true) :: acc)
+                                      infos.eqs
+                                      (List.map (fun e -> (e, true)) rechyps))
+                               ; (* list_rewrite true *)
+                                 (*   (List.map (fun e -> (mkVar e,true)) infos.eqs) *)
+                                 (*   ; *)
+                                 observe_tac
+                                   (fun _ _ -> str "finishing")
+                                   (tclORELSE
+                                      (Proofview.V82.of_tactic
+                                         intros_reflexivity)
+                                      (observe_tac
+                                         (fun _ _ -> str "calling prove_lt")
+                                         (prove_lt hyple))) ] ] ])))) ]
+      g
+  | (_, v_bound) :: l ->
+    observe_tclTHENLIST
+      (fun _ _ -> str "destruct_bounds_aux3")
+      [ Proofview.V82.of_tactic (simplest_elim (mkVar v_bound))
+      ; Proofview.V82.of_tactic (clear [v_bound])
+      ; tclDO 2 (Proofview.V82.of_tactic intro)
+      ; onNthHypId 1 (fun p_hyp ->
+            onNthHypId 2 (fun p ->
+                observe_tclTHENLIST
+                  (fun _ _ -> str "destruct_bounds_aux4")
+                  [ Proofview.V82.of_tactic
+                      (simplest_elim
+                         (mkApp (delayed_force max_constr, [|bound; mkVar p|])))
+                  ; tclDO 3 (Proofview.V82.of_tactic intro)
+                  ; onNLastHypsId 3 (fun lids ->
+                        match lids with
+                        | [hle2; hle1; pmax] ->
+                          destruct_bounds_aux infos
+                            ( mkVar pmax
+                            , hle1 :: hle2 :: hyple
+                            , mkVar p_hyp :: rechyps )
+                            l
+                        | _ -> assert false) ])) ]
+      g
 
 let destruct_bounds infos =
-  destruct_bounds_aux infos (delayed_force coq_O,[],[]) infos.values_and_bounds
+  destruct_bounds_aux infos
+    (delayed_force coq_O, [], [])
+    infos.values_and_bounds
 
 let terminate_app f_and_args expr_info continuation_tac infos =
-    if expr_info.is_final && expr_info.is_main_branch
-    then
-      observe_tclTHENLIST (fun _ _ -> str "terminate_app1")[
-        continuation_tac infos;
-        observe_tac (fun _ _ -> str "first split")
-          (Proofview.V82.of_tactic (split (ImplicitBindings [infos.info])));
-        observe_tac (fun _ _ -> str "destruct_bounds (1)") (destruct_bounds infos)
-      ]
-    else continuation_tac infos
+  if expr_info.is_final && expr_info.is_main_branch then
+    observe_tclTHENLIST
+      (fun _ _ -> str "terminate_app1")
+      [ continuation_tac infos
+      ; observe_tac
+          (fun _ _ -> str "first split")
+          (Proofview.V82.of_tactic (split (ImplicitBindings [infos.info])))
+      ; observe_tac
+          (fun _ _ -> str "destruct_bounds (1)")
+          (destruct_bounds infos) ]
+  else continuation_tac infos
 
 let terminate_others _ expr_info continuation_tac infos =
-  if expr_info.is_final && expr_info.is_main_branch
-  then
-    observe_tclTHENLIST (fun _ _ -> str "terminate_others")[
-            continuation_tac infos;
-      observe_tac (fun _ _ -> str "first split")
-        (Proofview.V82.of_tactic (split (ImplicitBindings [infos.info])));
-      observe_tac (fun _ _ -> str "destruct_bounds") (destruct_bounds infos)
-    ]
+  if expr_info.is_final && expr_info.is_main_branch then
+    observe_tclTHENLIST
+      (fun _ _ -> str "terminate_others")
+      [ continuation_tac infos
+      ; observe_tac
+          (fun _ _ -> str "first split")
+          (Proofview.V82.of_tactic (split (ImplicitBindings [infos.info])))
+      ; observe_tac (fun _ _ -> str "destruct_bounds") (destruct_bounds infos)
+      ]
   else continuation_tac infos
 
-let terminate_letin (na,b,t,e) expr_info continuation_tac info g =
+let terminate_letin (na, b, t, e) expr_info continuation_tac info g =
   let sigma = project g in
   let env = pf_env g in
   let new_e = subst1 info.info e in
   let new_forbidden =
     let forbid =
       try
-        check_not_nested env sigma (expr_info.f_id::expr_info.forbidden_ids) b;
+        check_not_nested env sigma (expr_info.f_id :: expr_info.forbidden_ids) b;
         true
       with e when CErrors.noncritical e -> false
     in
-    if forbid
-    then
+    if forbid then
       match na with
-        | Anonymous -> info.forbidden_ids
-        | Name id -> id::info.forbidden_ids
+      | Anonymous -> info.forbidden_ids
+      | Name id -> id :: info.forbidden_ids
     else info.forbidden_ids
   in
   continuation_tac {info with info = new_e; forbidden_ids = new_forbidden} g
 
 let pf_type c tac gl =
   let evars, ty = Typing.type_of (pf_env gl) (project gl) c in
-    tclTHEN (Refiner.tclEVARS evars) (tac ty) gl
+  tclTHEN (Refiner.tclEVARS evars) (tac ty) gl
 
 let pf_typel l tac =
   let rec aux tys l =
     match l with
     | [] -> tac (List.rev tys)
-    | hd :: tl -> pf_type hd (fun ty -> aux (ty::tys) tl)
-  in aux [] l
+    | hd :: tl -> pf_type hd (fun ty -> aux (ty :: tys) tl)
+  in
+  aux [] l
 
 (* This is like the previous one except that it also rewrite on all
   hypotheses except the ones given in the first argument.  All the
@@ -646,351 +727,431 @@ let mkDestructEq not_on_hyp expr g =
       (fun decl ->
         let open Context.Named.Declaration in
         let id = get_id decl in
-        if Id.List.mem id not_on_hyp || not (Termops.dependent (project g) expr (get_type decl))
-        then None else Some id) hyps in
+        if
+          Id.List.mem id not_on_hyp
+          || not (Termops.dependent (project g) expr (get_type decl))
+        then None
+        else Some id)
+      hyps
+  in
   let to_revert_constr = List.rev_map mkVar to_revert in
   let g, type_of_expr = tac_type_of g expr in
-  let new_hyps = mkApp(Lazy.force refl_equal, [|type_of_expr; expr|])::to_revert_constr in
+  let new_hyps =
+    mkApp (Lazy.force refl_equal, [|type_of_expr; expr|]) :: to_revert_constr
+  in
   let tac =
     pf_typel new_hyps (fun _ ->
-    observe_tclTHENLIST (fun _ _ -> str "mkDestructEq")
-     [Proofview.V82.of_tactic (generalize new_hyps);
-      (fun g2 ->
-        let changefun patvars env sigma =
-          pattern_occs [Locus.AllOccurrencesBut [1], expr] (pf_env g2) sigma (pf_concl g2)
-        in
-        Proofview.V82.of_tactic (change_in_concl ~check:true None changefun) g2);
-      Proofview.V82.of_tactic (simplest_case expr)])
+        observe_tclTHENLIST
+          (fun _ _ -> str "mkDestructEq")
+          [ Proofview.V82.of_tactic (generalize new_hyps)
+          ; (fun g2 ->
+              let changefun patvars env sigma =
+                pattern_occs
+                  [(Locus.AllOccurrencesBut [1], expr)]
+                  (pf_env g2) sigma (pf_concl g2)
+              in
+              Proofview.V82.of_tactic
+                (change_in_concl ~check:true None changefun)
+                g2)
+          ; Proofview.V82.of_tactic (simplest_case expr) ])
   in
-  g, tac, to_revert
+  (g, tac, to_revert)
 
-let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
+let terminate_case next_step (ci, a, t, l) expr_info continuation_tac infos g =
   let sigma = project g in
   let env = pf_env g in
   let f_is_present =
     try
-      check_not_nested env sigma (expr_info.f_id::expr_info.forbidden_ids) a;
+      check_not_nested env sigma (expr_info.f_id :: expr_info.forbidden_ids) a;
       false
-    with e when CErrors.noncritical e ->
-      true
+    with e when CErrors.noncritical e -> true
   in
   let a' = infos.info in
   let new_info =
-    {infos with
-      info = mkCase(ci,t,a',l);
-      is_main_branch = expr_info.is_main_branch;
-      is_final = expr_info.is_final} in
-  let g,destruct_tac,rev_to_thin_intro =
-    mkDestructEq [expr_info.rec_arg_id] a' g in
+    { infos with
+      info = mkCase (ci, t, a', l)
+    ; is_main_branch = expr_info.is_main_branch
+    ; is_final = expr_info.is_final }
+  in
+  let g, destruct_tac, rev_to_thin_intro =
+    mkDestructEq [expr_info.rec_arg_id] a' g
+  in
   let to_thin_intro = List.rev rev_to_thin_intro in
-  observe_tac (fun _ _ -> str "treating cases (" ++ int (Array.length l) ++ str")" ++ spc () ++ Printer.pr_leconstr_env (pf_env g) sigma a')
-    (try
-      (tclTHENS
-         destruct_tac
-         (List.map_i (fun i e -> observe_tac (fun _ _ -> str "do treat case") (treat_case f_is_present to_thin_intro (next_step continuation_tac) ci.ci_cstr_ndecls.(i) e new_info)) 0 (Array.to_list l)
-         ))
-    with
-      | UserError(Some "Refiner.thensn_tac3",_)
-      | UserError(Some "Refiner.tclFAIL_s",_) ->
-        (observe_tac (fun _ _ -> str "is computable " ++ Printer.pr_leconstr_env env sigma new_info.info) (next_step continuation_tac {new_info with info = Reductionops.nf_betaiotazeta (pf_env g) sigma new_info.info} )
-        ))
+  observe_tac
+    (fun _ _ ->
+      str "treating cases ("
+      ++ int (Array.length l)
+      ++ str ")" ++ spc ()
+      ++ Printer.pr_leconstr_env (pf_env g) sigma a')
+    ( try
+        tclTHENS destruct_tac
+          (List.map_i
+             (fun i e ->
+               observe_tac
+                 (fun _ _ -> str "do treat case")
+                 (treat_case f_is_present to_thin_intro
+                    (next_step continuation_tac)
+                    ci.ci_cstr_ndecls.(i) e new_info))
+             0 (Array.to_list l))
+      with
+      | UserError (Some "Refiner.thensn_tac3", _)
+       |UserError (Some "Refiner.tclFAIL_s", _)
+      ->
+        observe_tac
+          (fun _ _ ->
+            str "is computable "
+            ++ Printer.pr_leconstr_env env sigma new_info.info)
+          (next_step continuation_tac
+             { new_info with
+               info =
+                 Reductionops.nf_betaiotazeta (pf_env g) sigma new_info.info })
+    )
     g
 
-let terminate_app_rec (f,args) expr_info continuation_tac _ g =
+let terminate_app_rec (f, args) expr_info continuation_tac _ g =
   let sigma = project g in
   let env = pf_env g in
-  List.iter (check_not_nested env sigma (expr_info.f_id::expr_info.forbidden_ids))
+  List.iter
+    (check_not_nested env sigma (expr_info.f_id :: expr_info.forbidden_ids))
     args;
-  begin
-    try
-      let v = List.assoc_f (List.equal (EConstr.eq_constr sigma)) args expr_info.args_assoc in
-      let new_infos = {expr_info with info = v} in
-      observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec")[
-        continuation_tac new_infos;
-        if expr_info.is_final && expr_info.is_main_branch
-        then
-          observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec1")[
-            observe_tac (fun _ _ -> str "first split")
-              (Proofview.V82.of_tactic (split (ImplicitBindings [new_infos.info])));
-            observe_tac (fun _ _ -> str "destruct_bounds (3)")
-              (destruct_bounds new_infos)
-          ]
-        else
-          tclIDTAC
-      ] g
-    with Not_found ->
-      observe_tac (fun _ _ -> str "terminate_app_rec not found") (tclTHENS
-        (Proofview.V82.of_tactic (simplest_elim (mkApp(mkVar expr_info.ih,Array.of_list args))))
-        [
-          observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec2")[
-            Proofview.V82.of_tactic (intro_using rec_res_id);
-            Proofview.V82.of_tactic intro;
-            onNthHypId 1
-              (fun v_bound ->
-                (onNthHypId 2
-                   (fun v ->
-                     let new_infos = { expr_info with
-                       info = (mkVar v);
-                       values_and_bounds =
-                         (v,v_bound)::expr_info.values_and_bounds;
-                       args_assoc=(args,mkVar v)::expr_info.args_assoc
-                     } in
-                     observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec3")[
-                       continuation_tac new_infos;
-                       if expr_info.is_final && expr_info.is_main_branch
-                       then
-                         observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec4")[
-                           observe_tac (fun _ _ -> str "first split")
-                             (Proofview.V82.of_tactic (split (ImplicitBindings [new_infos.info])));
-                           observe_tac (fun _ _ -> str "destruct_bounds (2)")
-                             (destruct_bounds new_infos)
-                         ]
-                       else
-                         tclIDTAC
-                     ]
-                   )
-                )
-              )
-          ];
-          observe_tac (fun _ _ -> str "proving decreasing") (
-            tclTHENS (* proof of args < formal args *)
-              (Proofview.V82.of_tactic (apply (Lazy.force expr_info.acc_inv)))
-              [
-                observe_tac (fun _ _ -> str "assumption") (Proofview.V82.of_tactic assumption);
-                observe_tclTHENLIST (fun _ _ -> str "terminate_app_rec5")
-                  [
-                    tclTRY(list_rewrite true
-                             (List.map
-                                (fun e -> mkVar e,true)
-                                expr_info.eqs
-                             )
-                    );
-                    Proofview.V82.of_tactic @@
-                    tclUSER expr_info.concl_tac true
-                      (Some (
-                      expr_info.ih::expr_info.acc_id::
-                        (fun (x,y) -> y)
-                        (List.split expr_info.values_and_bounds)
-                       )
-                      );
-                  ]
-              ])
-        ]) g
-  end
+  try
+    let v =
+      List.assoc_f
+        (List.equal (EConstr.eq_constr sigma))
+        args expr_info.args_assoc
+    in
+    let new_infos = {expr_info with info = v} in
+    observe_tclTHENLIST
+      (fun _ _ -> str "terminate_app_rec")
+      [ continuation_tac new_infos
+      ; ( if expr_info.is_final && expr_info.is_main_branch then
+          observe_tclTHENLIST
+            (fun _ _ -> str "terminate_app_rec1")
+            [ observe_tac
+                (fun _ _ -> str "first split")
+                (Proofview.V82.of_tactic
+                   (split (ImplicitBindings [new_infos.info])))
+            ; observe_tac
+                (fun _ _ -> str "destruct_bounds (3)")
+                (destruct_bounds new_infos) ]
+        else tclIDTAC ) ]
+      g
+  with Not_found ->
+    observe_tac
+      (fun _ _ -> str "terminate_app_rec not found")
+      (tclTHENS
+         (Proofview.V82.of_tactic
+            (simplest_elim (mkApp (mkVar expr_info.ih, Array.of_list args))))
+         [ observe_tclTHENLIST
+             (fun _ _ -> str "terminate_app_rec2")
+             [ Proofview.V82.of_tactic (intro_using rec_res_id)
+             ; Proofview.V82.of_tactic intro
+             ; onNthHypId 1 (fun v_bound ->
+                   onNthHypId 2 (fun v ->
+                       let new_infos =
+                         { expr_info with
+                           info = mkVar v
+                         ; values_and_bounds =
+                             (v, v_bound) :: expr_info.values_and_bounds
+                         ; args_assoc = (args, mkVar v) :: expr_info.args_assoc
+                         }
+                       in
+                       observe_tclTHENLIST
+                         (fun _ _ -> str "terminate_app_rec3")
+                         [ continuation_tac new_infos
+                         ; ( if expr_info.is_final && expr_info.is_main_branch
+                           then
+                             observe_tclTHENLIST
+                               (fun _ _ -> str "terminate_app_rec4")
+                               [ observe_tac
+                                   (fun _ _ -> str "first split")
+                                   (Proofview.V82.of_tactic
+                                      (split
+                                         (ImplicitBindings [new_infos.info])))
+                               ; observe_tac
+                                   (fun _ _ -> str "destruct_bounds (2)")
+                                   (destruct_bounds new_infos) ]
+                           else tclIDTAC ) ])) ]
+         ; observe_tac
+             (fun _ _ -> str "proving decreasing")
+             (tclTHENS (* proof of args < formal args *)
+                (Proofview.V82.of_tactic (apply (Lazy.force expr_info.acc_inv)))
+                [ observe_tac
+                    (fun _ _ -> str "assumption")
+                    (Proofview.V82.of_tactic assumption)
+                ; observe_tclTHENLIST
+                    (fun _ _ -> str "terminate_app_rec5")
+                    [ tclTRY
+                        (list_rewrite true
+                           (List.map (fun e -> (mkVar e, true)) expr_info.eqs))
+                    ; Proofview.V82.of_tactic
+                      @@ tclUSER expr_info.concl_tac true
+                           (Some
+                              ( expr_info.ih :: expr_info.acc_id
+                              :: (fun (x, y) -> y)
+                                   (List.split expr_info.values_and_bounds) ))
+                    ] ]) ])
+      g
 
 let terminate_info =
-  { message = "prove_terminate with term ";
-    letiN = terminate_letin;
-    lambdA = (fun _ _ _ _ -> assert false);
-    casE = terminate_case;
-    otherS = terminate_others;
-    apP = terminate_app;
-    app_reC = terminate_app_rec;
-  }
+  { message = "prove_terminate with term "
+  ; letiN = terminate_letin
+  ; lambdA = (fun _ _ _ _ -> assert false)
+  ; casE = terminate_case
+  ; otherS = terminate_others
+  ; apP = terminate_app
+  ; app_reC = terminate_app_rec }
 
 let prove_terminate = travel terminate_info
 
-
 (* Equation proof *)
 
-let equation_case next_step (ci,a,t,l) expr_info continuation_tac infos =
-  observe_tac (fun _ _ -> str "equation case") (terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos)
+let equation_case next_step (ci, a, t, l) expr_info continuation_tac infos =
+  observe_tac
+    (fun _ _ -> str "equation case")
+    (terminate_case next_step (ci, a, t, l) expr_info continuation_tac infos)
 
 let rec prove_le g =
   let sigma = project g in
-  let x,z =
-    let _,args = decompose_app sigma (pf_concl g) in
-    (List.hd args,List.hd (List.tl args))
+  let x, z =
+    let _, args = decompose_app sigma (pf_concl g) in
+    (List.hd args, List.hd (List.tl args))
   in
-  tclFIRST[
-    Proofview.V82.of_tactic assumption;
-    Proofview.V82.of_tactic (apply (delayed_force le_n));
-    begin
-      try
-        let matching_fun c = match EConstr.kind sigma c with
-        | App (c, [| x0 ; _ |]) ->
-          EConstr.isVar sigma x0 &&
-          Id.equal (destVar sigma x0) (destVar sigma x) &&
-          EConstr.isRefX sigma (le ()) c
-        | _ -> false
-        in
-        let (h,t) = List.find (fun (_,t) -> matching_fun t) (pf_hyps_types g) in
-        let h = h.binder_name in
-        let y =
-          let _,args = decompose_app sigma t in
-          List.hd (List.tl args)
-        in
-        observe_tclTHENLIST (fun _ _ -> str "prove_le")[
-          Proofview.V82.of_tactic (apply(mkApp(le_trans (),[|x;y;z;mkVar h|])));
-          observe_tac (fun _ _ -> str "prove_le (rec)") (prove_le)
-        ]
-      with Not_found -> tclFAIL 0 (mt())
-    end;
-  ]
+  tclFIRST
+    [ Proofview.V82.of_tactic assumption
+    ; Proofview.V82.of_tactic (apply (delayed_force le_n))
+    ; begin
+        try
+          let matching_fun c =
+            match EConstr.kind sigma c with
+            | App (c, [|x0; _|]) ->
+              EConstr.isVar sigma x0
+              && Id.equal (destVar sigma x0) (destVar sigma x)
+              && EConstr.isRefX sigma (le ()) c
+            | _ -> false
+          in
+          let h, t =
+            List.find (fun (_, t) -> matching_fun t) (pf_hyps_types g)
+          in
+          let h = h.binder_name in
+          let y =
+            let _, args = decompose_app sigma t in
+            List.hd (List.tl args)
+          in
+          observe_tclTHENLIST
+            (fun _ _ -> str "prove_le")
+            [ Proofview.V82.of_tactic
+                (apply (mkApp (le_trans (), [|x; y; z; mkVar h|])))
+            ; observe_tac (fun _ _ -> str "prove_le (rec)") prove_le ]
+        with Not_found -> tclFAIL 0 (mt ())
+      end ]
     g
 
 let rec make_rewrite_list expr_info max = function
   | [] -> tclIDTAC
-  | (_,p,hp)::l ->
-    observe_tac (fun _ _ -> str "make_rewrite_list") (tclTHENS
-      (observe_tac (fun _ _ -> str "rewrite heq on " ++ Id.print p ) (
-        (fun g ->
-          let sigma = project g in
-          let t_eq = compute_renamed_type g hp in
-          let k,def =
-            let k_na,_,t = destProd sigma t_eq in
-            let _,_,t  = destProd sigma t in
-            let def_na,_,_ = destProd sigma t in
-            Nameops.Name.get_id k_na.binder_name,Nameops.Name.get_id def_na.binder_name
-          in
-          Proofview.V82.of_tactic (general_rewrite_bindings false Locus.AllOccurrences
-            true (* dep proofs also: *) true
-            (mkVar hp,
-             ExplicitBindings[CAst.make @@ (NamedHyp def, expr_info.f_constr);
-                              CAst.make @@ (NamedHyp k, f_S max)]) false) g) )
-      )
-      [make_rewrite_list expr_info max l;
-       observe_tclTHENLIST (fun _ _ -> str "make_rewrite_list")[ (* x < S max proof *)
-         Proofview.V82.of_tactic (apply (delayed_force le_lt_n_Sm));
-         observe_tac (fun _ _ -> str "prove_le(2)") prove_le
-       ]
-      ] )
+  | (_, p, hp) :: l ->
+    observe_tac
+      (fun _ _ -> str "make_rewrite_list")
+      (tclTHENS
+         (observe_tac
+            (fun _ _ -> str "rewrite heq on " ++ Id.print p)
+            (fun g ->
+              let sigma = project g in
+              let t_eq = compute_renamed_type g hp in
+              let k, def =
+                let k_na, _, t = destProd sigma t_eq in
+                let _, _, t = destProd sigma t in
+                let def_na, _, _ = destProd sigma t in
+                ( Nameops.Name.get_id k_na.binder_name
+                , Nameops.Name.get_id def_na.binder_name )
+              in
+              Proofview.V82.of_tactic
+                (general_rewrite_bindings false Locus.AllOccurrences true
+                   (* dep proofs also: *) true
+                   ( mkVar hp
+                   , ExplicitBindings
+                       [ CAst.make @@ (NamedHyp def, expr_info.f_constr)
+                       ; CAst.make @@ (NamedHyp k, f_S max) ] )
+                   false)
+                g))
+         [ make_rewrite_list expr_info max l
+         ; observe_tclTHENLIST
+             (fun _ _ -> str "make_rewrite_list")
+             [ (* x < S max proof *)
+               Proofview.V82.of_tactic (apply (delayed_force le_lt_n_Sm))
+             ; observe_tac (fun _ _ -> str "prove_le(2)") prove_le ] ])
 
 let make_rewrite expr_info l hp max =
   tclTHENFIRST
-    (observe_tac (fun _ _ -> str "make_rewrite") (make_rewrite_list expr_info max l))
-    (observe_tac (fun _ _ -> str "make_rewrite") (tclTHENS
-       (fun g ->
-          let sigma = project g in
-          let t_eq = compute_renamed_type g hp in
-          let k,def =
-            let k_na,_,t = destProd sigma t_eq in
-            let _,_,t  = destProd sigma t in
-            let def_na,_,_ = destProd sigma t in
-            Nameops.Name.get_id k_na.binder_name,Nameops.Name.get_id def_na.binder_name
-          in
-         observe_tac (fun _ _ -> str "general_rewrite_bindings")
-           (Proofview.V82.of_tactic (general_rewrite_bindings false Locus.AllOccurrences
-            true (* dep proofs also: *) true
-            (mkVar hp,
-             ExplicitBindings[CAst.make @@ (NamedHyp def, expr_info.f_constr);
-                              CAst.make @@ (NamedHyp k, f_S (f_S max))]) false)) g)
-       [observe_tac(fun _ _ -> str "make_rewrite finalize") (
-         (* tclORELSE( h_reflexivity) *)
-         (observe_tclTHENLIST (fun _ _ -> str "make_rewrite")[
-           Proofview.V82.of_tactic (simpl_iter Locusops.onConcl);
-           observe_tac (fun _ _ -> str "unfold functional")
-             (Proofview.V82.of_tactic (unfold_in_concl[(Locus.OnlyOccurrences [1],
-                               evaluable_of_global_reference expr_info.func)]));
-
-           (list_rewrite true
-              (List.map (fun e -> mkVar e,true) expr_info.eqs));
-           (observe_tac (fun _ _ -> str "h_reflexivity")
-                        (Proofview.V82.of_tactic intros_reflexivity)
-           )
-            ]))
-       ;
-         observe_tclTHENLIST (fun _ _ -> str "make_rewrite1")[ (* x < S (S max) proof *)
-         Proofview.V82.of_tactic (apply (EConstr.of_constr (delayed_force le_lt_SS)));
-         observe_tac (fun _ _ -> str "prove_le (3)") prove_le
-         ]
-       ])
-    )
+    (observe_tac
+       (fun _ _ -> str "make_rewrite")
+       (make_rewrite_list expr_info max l))
+    (observe_tac
+       (fun _ _ -> str "make_rewrite")
+       (tclTHENS
+          (fun g ->
+            let sigma = project g in
+            let t_eq = compute_renamed_type g hp in
+            let k, def =
+              let k_na, _, t = destProd sigma t_eq in
+              let _, _, t = destProd sigma t in
+              let def_na, _, _ = destProd sigma t in
+              ( Nameops.Name.get_id k_na.binder_name
+              , Nameops.Name.get_id def_na.binder_name )
+            in
+            observe_tac
+              (fun _ _ -> str "general_rewrite_bindings")
+              (Proofview.V82.of_tactic
+                 (general_rewrite_bindings false Locus.AllOccurrences true
+                    (* dep proofs also: *) true
+                    ( mkVar hp
+                    , ExplicitBindings
+                        [ CAst.make @@ (NamedHyp def, expr_info.f_constr)
+                        ; CAst.make @@ (NamedHyp k, f_S (f_S max)) ] )
+                    false))
+              g)
+          [ observe_tac
+              (fun _ _ -> str "make_rewrite finalize")
+              ((* tclORELSE( h_reflexivity) *)
+               observe_tclTHENLIST
+                 (fun _ _ -> str "make_rewrite")
+                 [ Proofview.V82.of_tactic (simpl_iter Locusops.onConcl)
+                 ; observe_tac
+                     (fun _ _ -> str "unfold functional")
+                     (Proofview.V82.of_tactic
+                        (unfold_in_concl
+                           [ ( Locus.OnlyOccurrences [1]
+                             , evaluable_of_global_reference expr_info.func ) ]))
+                 ; list_rewrite true
+                     (List.map (fun e -> (mkVar e, true)) expr_info.eqs)
+                 ; observe_tac
+                     (fun _ _ -> str "h_reflexivity")
+                     (Proofview.V82.of_tactic intros_reflexivity) ])
+          ; observe_tclTHENLIST
+              (fun _ _ -> str "make_rewrite1")
+              [ (* x < S (S max) proof *)
+                Proofview.V82.of_tactic
+                  (apply (EConstr.of_constr (delayed_force le_lt_SS)))
+              ; observe_tac (fun _ _ -> str "prove_le (3)") prove_le ] ]))
 
 let rec compute_max rew_tac max l =
   match l with
-    | [] -> rew_tac max
-    | (_,p,_)::l ->
-      observe_tclTHENLIST (fun _ _ -> str "compute_max")[
-        Proofview.V82.of_tactic (simplest_elim
-          (mkApp(delayed_force max_constr, [| max; mkVar p|])));
-        tclDO 3 (Proofview.V82.of_tactic intro);
-        onNLastHypsId 3 (fun lids ->
-          match lids with
-            | [hle2;hle1;pmax] -> compute_max rew_tac (mkVar pmax) l
-            | _ -> assert false
-        )]
+  | [] -> rew_tac max
+  | (_, p, _) :: l ->
+    observe_tclTHENLIST
+      (fun _ _ -> str "compute_max")
+      [ Proofview.V82.of_tactic
+          (simplest_elim (mkApp (delayed_force max_constr, [|max; mkVar p|])))
+      ; tclDO 3 (Proofview.V82.of_tactic intro)
+      ; onNLastHypsId 3 (fun lids ->
+            match lids with
+            | [hle2; hle1; pmax] -> compute_max rew_tac (mkVar pmax) l
+            | _ -> assert false) ]
 
 let rec destruct_hex expr_info acc l =
   match l with
-    | [] ->
-      begin
-        match List.rev acc with
-          | [] -> tclIDTAC
-          | (_,p,hp)::tl  ->
-            observe_tac (fun _ _ -> str "compute max ") (compute_max (make_rewrite expr_info tl hp) (mkVar p) tl)
-      end
-    | (v,hex)::l ->
-      observe_tclTHENLIST (fun _ _ -> str "destruct_hex")[
-        Proofview.V82.of_tactic (simplest_case (mkVar hex));
-        Proofview.V82.of_tactic (clear [hex]);
-        tclDO 2 (Proofview.V82.of_tactic intro);
-        onNthHypId 1 (fun hp ->
-          onNthHypId 2 (fun p ->
-            observe_tac
-              (fun _ _ -> str "destruct_hex after " ++ Id.print hp ++ spc () ++ Id.print p)
-              (destruct_hex expr_info ((v,p,hp)::acc) l)
-          )
-        )
-      ]
+  | [] -> (
+    match List.rev acc with
+    | [] -> tclIDTAC
+    | (_, p, hp) :: tl ->
+      observe_tac
+        (fun _ _ -> str "compute max ")
+        (compute_max (make_rewrite expr_info tl hp) (mkVar p) tl) )
+  | (v, hex) :: l ->
+    observe_tclTHENLIST
+      (fun _ _ -> str "destruct_hex")
+      [ Proofview.V82.of_tactic (simplest_case (mkVar hex))
+      ; Proofview.V82.of_tactic (clear [hex])
+      ; tclDO 2 (Proofview.V82.of_tactic intro)
+      ; onNthHypId 1 (fun hp ->
+            onNthHypId 2 (fun p ->
+                observe_tac
+                  (fun _ _ ->
+                    str "destruct_hex after " ++ Id.print hp ++ spc ()
+                    ++ Id.print p)
+                  (destruct_hex expr_info ((v, p, hp) :: acc) l))) ]
 
 let rec intros_values_eq expr_info acc =
-  tclORELSE(
-    observe_tclTHENLIST (fun _ _ -> str "intros_values_eq")[
-      tclDO 2 (Proofview.V82.of_tactic intro);
-      onNthHypId 1 (fun hex ->
-        (onNthHypId 2 (fun v -> intros_values_eq expr_info ((v,hex)::acc)))
-      )
-    ])
-    (tclCOMPLETE (
-      destruct_hex expr_info [] acc
-    ))
+  tclORELSE
+    (observe_tclTHENLIST
+       (fun _ _ -> str "intros_values_eq")
+       [ tclDO 2 (Proofview.V82.of_tactic intro)
+       ; onNthHypId 1 (fun hex ->
+             onNthHypId 2 (fun v ->
+                 intros_values_eq expr_info ((v, hex) :: acc))) ])
+    (tclCOMPLETE (destruct_hex expr_info [] acc))
 
 let equation_others _ expr_info continuation_tac infos =
-  if expr_info.is_final && expr_info.is_main_branch
-  then
-    observe_tac (fun env sigma -> str "equation_others (cont_tac +intros) " ++ Printer.pr_leconstr_env env sigma expr_info.info)
-                (tclTHEN
+  if expr_info.is_final && expr_info.is_main_branch then
+    observe_tac
+      (fun env sigma ->
+        str "equation_others (cont_tac +intros) "
+        ++ Printer.pr_leconstr_env env sigma expr_info.info)
+      (tclTHEN (continuation_tac infos)
+         (observe_tac
+            (fun env sigma ->
+              str "intros_values_eq equation_others "
+              ++ Printer.pr_leconstr_env env sigma expr_info.info)
+            (intros_values_eq expr_info [])))
+  else
+    observe_tac
+      (fun env sigma ->
+        str "equation_others (cont_tac) "
+        ++ Printer.pr_leconstr_env env sigma expr_info.info)
       (continuation_tac infos)
-      (observe_tac (fun env sigma -> str "intros_values_eq equation_others "  ++ Printer.pr_leconstr_env env sigma expr_info.info) (intros_values_eq expr_info [])))
-  else observe_tac (fun env sigma -> str "equation_others (cont_tac) " ++ Printer.pr_leconstr_env env sigma expr_info.info) (continuation_tac infos)
 
 let equation_app f_and_args expr_info continuation_tac infos =
-    if expr_info.is_final && expr_info.is_main_branch
-    then ((observe_tac (fun _ _ -> str "intros_values_eq equation_app") (intros_values_eq expr_info [])))
-    else continuation_tac infos
+  if expr_info.is_final && expr_info.is_main_branch then
+    observe_tac
+      (fun _ _ -> str "intros_values_eq equation_app")
+      (intros_values_eq expr_info [])
+  else continuation_tac infos
 
-let equation_app_rec (f,args) expr_info continuation_tac info g =
+let equation_app_rec (f, args) expr_info continuation_tac info g =
   let sigma = project g in
-  begin
-    try
-      let v = List.assoc_f (List.equal (EConstr.eq_constr sigma)) args expr_info.args_assoc in
-      let new_infos = {expr_info with info = v} in
-      observe_tac (fun _ _ -> str "app_rec found") (continuation_tac new_infos) g
-    with Not_found ->
-      if expr_info.is_final && expr_info.is_main_branch
-      then
-        observe_tclTHENLIST (fun _ _ -> str "equation_app_rec")
-          [ Proofview.V82.of_tactic (simplest_case (mkApp (expr_info.f_terminate,Array.of_list args)));
-            continuation_tac {expr_info with args_assoc = (args,delayed_force coq_O)::expr_info.args_assoc};
-            observe_tac (fun _ _ -> str "app_rec intros_values_eq") (intros_values_eq expr_info [])
-          ] g
-      else
-        observe_tclTHENLIST (fun _ _ -> str "equation_app_rec1")[
-          Proofview.V82.of_tactic (simplest_case (mkApp (expr_info.f_terminate,Array.of_list args)));
-          observe_tac (fun _ _ -> str "app_rec not_found") (continuation_tac {expr_info with args_assoc = (args,delayed_force coq_O)::expr_info.args_assoc})
-        ] g
-  end
+  try
+    let v =
+      List.assoc_f
+        (List.equal (EConstr.eq_constr sigma))
+        args expr_info.args_assoc
+    in
+    let new_infos = {expr_info with info = v} in
+    observe_tac (fun _ _ -> str "app_rec found") (continuation_tac new_infos) g
+  with Not_found ->
+    if expr_info.is_final && expr_info.is_main_branch then
+      observe_tclTHENLIST
+        (fun _ _ -> str "equation_app_rec")
+        [ Proofview.V82.of_tactic
+            (simplest_case (mkApp (expr_info.f_terminate, Array.of_list args)))
+        ; continuation_tac
+            { expr_info with
+              args_assoc = (args, delayed_force coq_O) :: expr_info.args_assoc
+            }
+        ; observe_tac
+            (fun _ _ -> str "app_rec intros_values_eq")
+            (intros_values_eq expr_info []) ]
+        g
+    else
+      observe_tclTHENLIST
+        (fun _ _ -> str "equation_app_rec1")
+        [ Proofview.V82.of_tactic
+            (simplest_case (mkApp (expr_info.f_terminate, Array.of_list args)))
+        ; observe_tac
+            (fun _ _ -> str "app_rec not_found")
+            (continuation_tac
+               { expr_info with
+                 args_assoc =
+                   (args, delayed_force coq_O) :: expr_info.args_assoc }) ]
+        g
 
 let equation_info =
-  {message = "prove_equation with term ";
-   letiN = (fun _ -> assert false);
-   lambdA = (fun _ _ _ _ -> assert false);
-   casE = equation_case;
-   otherS = equation_others;
-   apP = equation_app;
-   app_reC = equation_app_rec
-}
+  { message = "prove_equation with term "
+  ; letiN = (fun _ -> assert false)
+  ; lambdA = (fun _ _ _ _ -> assert false)
+  ; casE = equation_case
+  ; otherS = equation_others
+  ; apP = equation_app
+  ; app_reC = equation_app_rec }
 
 let prove_eq = travel equation_info
 
@@ -1001,271 +1162,268 @@ let compute_terminate_type nb_args func =
   let open Term in
   let open Constr in
   let open CVars in
-  let _,a_arrow_b,_ = destLambda(def_of_const (constr_of_monomorphic_global func)) in
-  let rev_args,b = decompose_prod_n nb_args a_arrow_b in
+  let _, a_arrow_b, _ =
+    destLambda (def_of_const (constr_of_monomorphic_global func))
+  in
+  let rev_args, b = decompose_prod_n nb_args a_arrow_b in
   let left =
-    mkApp(delayed_force iter_rd,
-          Array.of_list
-            (lift 5 a_arrow_b:: mkRel 3::
-               constr_of_monomorphic_global func::mkRel 1::
-               List.rev (List.map_i (fun i _ -> mkRel (6+i)) 0 rev_args)
-            )
-         )
+    mkApp
+      ( delayed_force iter_rd
+      , Array.of_list
+          ( lift 5 a_arrow_b :: mkRel 3
+          :: constr_of_monomorphic_global func
+          :: mkRel 1
+          :: List.rev (List.map_i (fun i _ -> mkRel (6 + i)) 0 rev_args) ) )
   in
   let right = mkRel 5 in
   let delayed_force c = EConstr.Unsafe.to_constr (delayed_force c) in
-  let equality = mkApp(delayed_force eq, [|lift 5 b; left; right|]) in
-  let result = (mkProd (make_annot (Name def_id) Sorts.Relevant, lift 4 a_arrow_b, equality)) in
-  let cond = mkApp(delayed_force lt, [|(mkRel 2); (mkRel 1)|]) in
+  let equality = mkApp (delayed_force eq, [|lift 5 b; left; right|]) in
+  let result =
+    mkProd (make_annot (Name def_id) Sorts.Relevant, lift 4 a_arrow_b, equality)
+  in
+  let cond = mkApp (delayed_force lt, [|mkRel 2; mkRel 1|]) in
   let nb_iter =
-    mkApp(delayed_force ex,
-          [|delayed_force nat;
-            (mkLambda
-               (make_annot (Name p_id) Sorts.Relevant,
-                  delayed_force nat,
-                  (mkProd (make_annot (Name k_id) Sorts.Relevant, delayed_force nat,
-                           mkArrow cond Sorts.Relevant result))))|])in
-  let value = mkApp(constr_of_monomorphic_global (Util.delayed_force coq_sig_ref),
-                    [|b;
-                      (mkLambda (make_annot (Name v_id) Sorts.Relevant, b, nb_iter))|]) in
+    mkApp
+      ( delayed_force ex
+      , [| delayed_force nat
+         ; mkLambda
+             ( make_annot (Name p_id) Sorts.Relevant
+             , delayed_force nat
+             , mkProd
+                 ( make_annot (Name k_id) Sorts.Relevant
+                 , delayed_force nat
+                 , mkArrow cond Sorts.Relevant result ) ) |] )
+  in
+  let value =
+    mkApp
+      ( constr_of_monomorphic_global (Util.delayed_force coq_sig_ref)
+      , [|b; mkLambda (make_annot (Name v_id) Sorts.Relevant, b, nb_iter)|] )
+  in
   compose_prod rev_args value
 
-
-let termination_proof_header is_mes input_type ids args_id relation
-    rec_arg_num rec_arg_id tac wf_tac : tactic =
-  begin
-    fun g ->
-      let nargs = List.length args_id in
-      let pre_rec_args =
-        List.rev_map
-          mkVar (fst (List.chop (rec_arg_num - 1) args_id))
-      in
-      let relation = substl pre_rec_args relation in
-      let input_type = substl pre_rec_args input_type in
-      let wf_thm = next_ident_away_in_goal (Id.of_string ("wf_R")) ids in
-      let wf_rec_arg =
-        next_ident_away_in_goal
-          (Id.of_string ("Acc_"^(Id.to_string rec_arg_id)))
-          (wf_thm::ids)
-      in
-      let hrec = next_ident_away_in_goal hrec_id
-        (wf_rec_arg::wf_thm::ids) in
-      let acc_inv =
-          lazy (
-            mkApp (
-              delayed_force acc_inv_id,
-              [|input_type;relation;mkVar rec_arg_id|]
-            )
-          )
-      in
-      tclTHEN
-        (h_intros args_id)
-        (tclTHENS
+let termination_proof_header is_mes input_type ids args_id relation rec_arg_num
+    rec_arg_id tac wf_tac : tactic =
+ fun g ->
+  let nargs = List.length args_id in
+  let pre_rec_args =
+    List.rev_map mkVar (fst (List.chop (rec_arg_num - 1) args_id))
+  in
+  let relation = substl pre_rec_args relation in
+  let input_type = substl pre_rec_args input_type in
+  let wf_thm = next_ident_away_in_goal (Id.of_string "wf_R") ids in
+  let wf_rec_arg =
+    next_ident_away_in_goal
+      (Id.of_string ("Acc_" ^ Id.to_string rec_arg_id))
+      (wf_thm :: ids)
+  in
+  let hrec = next_ident_away_in_goal hrec_id (wf_rec_arg :: wf_thm :: ids) in
+  let acc_inv =
+    lazy
+      (mkApp
+         (delayed_force acc_inv_id, [|input_type; relation; mkVar rec_arg_id|]))
+  in
+  tclTHEN (h_intros args_id)
+    (tclTHENS
+       (observe_tac
+          (fun _ _ -> str "first assert")
+          (Proofview.V82.of_tactic
+             (assert_before (Name wf_rec_arg)
+                (mkApp
+                   ( delayed_force acc_rel
+                   , [|input_type; relation; mkVar rec_arg_id|] )))))
+       [ (* accesibility proof *)
+         tclTHENS
            (observe_tac
-              (fun _ _ -> str "first assert")
-              (Proofview.V82.of_tactic (assert_before
-                 (Name wf_rec_arg)
-                 (mkApp (delayed_force acc_rel,
-                         [|input_type;relation;mkVar rec_arg_id|])
-                 )
-              ))
-           )
-           [
-             (* accesibility proof *)
-             tclTHENS
-               (observe_tac
-                  (fun _ _ -> str "second assert")
-                  (Proofview.V82.of_tactic (assert_before
-                     (Name wf_thm)
-                     (mkApp (delayed_force well_founded,[|input_type;relation|]))
-                  ))
-               )
-               [
-                 (* interactive proof that the relation is well_founded *)
-                 observe_tac (fun _ _ -> str "wf_tac") (wf_tac is_mes (Some args_id));
-                 (* this gives the accessibility argument *)
-                 observe_tac
-                   (fun _ _ -> str "apply wf_thm")
-                   (Proofview.V82.of_tactic (Simple.apply (mkApp(mkVar wf_thm,[|mkVar rec_arg_id|])))
-                   )
-               ]
-             ;
-             (* rest of the proof *)
-             observe_tclTHENLIST (fun _ _ -> str "rest of proof")
-               [observe_tac (fun _ _ -> str "generalize")
-                  (onNLastHypsId (nargs+1)
-                     (tclMAP (fun id ->
-                        tclTHEN (Proofview.V82.of_tactic (Tactics.generalize [mkVar id])) (Proofview.V82.of_tactic (clear [id])))
-                     ))
-               ;
-                observe_tac (fun _ _ -> str "fix") (Proofview.V82.of_tactic (fix hrec (nargs+1)));
-                h_intros args_id;
-                Proofview.V82.of_tactic (Simple.intro wf_rec_arg);
-                observe_tac (fun _ _ -> str "tac") (tac wf_rec_arg hrec wf_rec_arg acc_inv)
-               ]
+              (fun _ _ -> str "second assert")
+              (Proofview.V82.of_tactic
+                 (assert_before (Name wf_thm)
+                    (mkApp
+                       (delayed_force well_founded, [|input_type; relation|])))))
+           [ (* interactive proof that the relation is well_founded *)
+             observe_tac
+               (fun _ _ -> str "wf_tac")
+               (wf_tac is_mes (Some args_id))
+           ; (* this gives the accessibility argument *)
+             observe_tac
+               (fun _ _ -> str "apply wf_thm")
+               (Proofview.V82.of_tactic
+                  (Simple.apply (mkApp (mkVar wf_thm, [|mkVar rec_arg_id|]))))
            ]
-        ) g
-  end
-
-
+       ; (* rest of the proof *)
+         observe_tclTHENLIST
+           (fun _ _ -> str "rest of proof")
+           [ observe_tac
+               (fun _ _ -> str "generalize")
+               (onNLastHypsId (nargs + 1)
+                  (tclMAP (fun id ->
+                       tclTHEN
+                         (Proofview.V82.of_tactic
+                            (Tactics.generalize [mkVar id]))
+                         (Proofview.V82.of_tactic (clear [id])))))
+           ; observe_tac
+               (fun _ _ -> str "fix")
+               (Proofview.V82.of_tactic (fix hrec (nargs + 1)))
+           ; h_intros args_id
+           ; Proofview.V82.of_tactic (Simple.intro wf_rec_arg)
+           ; observe_tac
+               (fun _ _ -> str "tac")
+               (tac wf_rec_arg hrec wf_rec_arg acc_inv) ] ])
+    g
 
 let rec instantiate_lambda sigma t l =
   match l with
   | [] -> t
-  | a::l ->
-      let (_, _, body) = destLambda sigma t in
-      instantiate_lambda sigma (subst1 a body) l
+  | a :: l ->
+    let _, _, body = destLambda sigma t in
+    instantiate_lambda sigma (subst1 a body) l
 
-let whole_start concl_tac nb_args is_mes func input_type relation rec_arg_num  : tactic =
-  begin
-    fun g ->
-      let sigma = project g in
-      let ids = Termops.ids_of_named_context (pf_hyps g) in
-      let func_body = (def_of_const (constr_of_monomorphic_global func)) in
-      let func_body = EConstr.of_constr func_body in
-      let (f_name, _, body1) = destLambda sigma func_body in
-      let f_id =
-        match f_name.binder_name with
-          | Name f_id -> next_ident_away_in_goal f_id ids
-          | Anonymous -> anomaly (Pp.str "Anonymous function.")
-      in
-      let n_names_types,_ = decompose_lam_n sigma nb_args body1 in
-      let n_ids,ids =
-        List.fold_left
-          (fun (n_ids,ids) (n_name,_) ->
-             match n_name.binder_name with
-               | Name id ->
-                   let n_id = next_ident_away_in_goal id ids in
-                   n_id::n_ids,n_id::ids
-               | _ -> anomaly (Pp.str "anonymous argument.")
-          )
-          ([],(f_id::ids))
-          n_names_types
-      in
-      let rec_arg_id = List.nth n_ids (rec_arg_num - 1) in
-      let expr = instantiate_lambda sigma func_body (mkVar f_id::(List.map mkVar n_ids)) in
-      termination_proof_header
-        is_mes
-        input_type
-        ids
-        n_ids
-        relation
-        rec_arg_num
-        rec_arg_id
-        (fun rec_arg_id hrec acc_id acc_inv g ->
-          (prove_terminate (fun infos -> tclIDTAC)
-             { is_main_branch = true; (* we are on the main branche (i.e. still on a match ... with .... end *)
-               is_final = true;      (* and on leaf (more or less) *)
-               f_terminate = delayed_force coq_O;
-               nb_arg = nb_args;
-               concl_tac;
-               rec_arg_id = rec_arg_id;
-               is_mes = is_mes;
-               ih = hrec;
-               f_id = f_id;
-               f_constr = mkVar f_id;
-               func = func;
-               info = expr;
-               acc_inv = acc_inv;
-               acc_id = acc_id;
-               values_and_bounds = [];
-               eqs = [];
-               forbidden_ids = [];
-               args_assoc = []
-             }
-          )
-             g
-        )
-        (fun b ids -> Proofview.V82.of_tactic (tclUSER_if_not_mes concl_tac b ids))
-        g
-  end
+let whole_start concl_tac nb_args is_mes func input_type relation rec_arg_num :
+    tactic =
+ fun g ->
+  let sigma = project g in
+  let ids = Termops.ids_of_named_context (pf_hyps g) in
+  let func_body = def_of_const (constr_of_monomorphic_global func) in
+  let func_body = EConstr.of_constr func_body in
+  let f_name, _, body1 = destLambda sigma func_body in
+  let f_id =
+    match f_name.binder_name with
+    | Name f_id -> next_ident_away_in_goal f_id ids
+    | Anonymous -> anomaly (Pp.str "Anonymous function.")
+  in
+  let n_names_types, _ = decompose_lam_n sigma nb_args body1 in
+  let n_ids, ids =
+    List.fold_left
+      (fun (n_ids, ids) (n_name, _) ->
+        match n_name.binder_name with
+        | Name id ->
+          let n_id = next_ident_away_in_goal id ids in
+          (n_id :: n_ids, n_id :: ids)
+        | _ -> anomaly (Pp.str "anonymous argument."))
+      ([], f_id :: ids)
+      n_names_types
+  in
+  let rec_arg_id = List.nth n_ids (rec_arg_num - 1) in
+  let expr =
+    instantiate_lambda sigma func_body (mkVar f_id :: List.map mkVar n_ids)
+  in
+  termination_proof_header is_mes input_type ids n_ids relation rec_arg_num
+    rec_arg_id
+    (fun rec_arg_id hrec acc_id acc_inv g ->
+      (prove_terminate
+         (fun infos -> tclIDTAC)
+         { is_main_branch = true
+         ; (* we are on the main branche (i.e. still on a match ... with .... end *)
+           is_final = true
+         ; (* and on leaf (more or less) *)
+           f_terminate = delayed_force coq_O
+         ; nb_arg = nb_args
+         ; concl_tac
+         ; rec_arg_id
+         ; is_mes
+         ; ih = hrec
+         ; f_id
+         ; f_constr = mkVar f_id
+         ; func
+         ; info = expr
+         ; acc_inv
+         ; acc_id
+         ; values_and_bounds = []
+         ; eqs = []
+         ; forbidden_ids = []
+         ; args_assoc = [] })
+        g)
+    (fun b ids -> Proofview.V82.of_tactic (tclUSER_if_not_mes concl_tac b ids))
+    g
 
 let get_current_subgoals_types pstate =
   let p = Proof_global.get_proof pstate in
-  let Proof.{ goals=sgs; sigma; _ } = Proof.data p in
-  sigma, List.map (Goal.V82.abstract_type sigma) sgs
+  let Proof.{goals = sgs; sigma; _} = Proof.data p in
+  (sigma, List.map (Goal.V82.abstract_type sigma) sgs)
 
 exception EmptySubgoals
+
 let build_and_l sigma l =
-  let and_constr =  UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.and.type" in
+  let and_constr =
+    UnivGen.constr_of_monomorphic_global @@ Coqlib.lib_ref "core.and.type"
+  in
   let conj_constr = Coqlib.lib_ref "core.and.conj" in
-  let mk_and p1 p2 =
-    mkApp(EConstr.of_constr and_constr,[|p1;p2|]) in
+  let mk_and p1 p2 = mkApp (EConstr.of_constr and_constr, [|p1; p2|]) in
   let rec is_well_founded t =
     match EConstr.kind sigma t with
-      | Prod(_,_,t') -> is_well_founded t'
-      | App(_,_) ->
-        let (f,_) = decompose_app sigma t in
-        EConstr.eq_constr sigma f (well_founded ())
-      | _ ->
-        false
+    | Prod (_, _, t') -> is_well_founded t'
+    | App (_, _) ->
+      let f, _ = decompose_app sigma t in
+      EConstr.eq_constr sigma f (well_founded ())
+    | _ -> false
   in
   let compare t1 t2 =
-    let b1,b2= is_well_founded t1,is_well_founded t2 in
-    if (b1&&b2) || not (b1 || b2) then 0
-    else if b1 && not b2 then 1 else -1
+    let b1, b2 = (is_well_founded t1, is_well_founded t2) in
+    if (b1 && b2) || not (b1 || b2) then 0 else if b1 && not b2 then 1 else -1
   in
   let l = List.sort compare l in
-  let rec f  = function
+  let rec f = function
     | [] -> raise EmptySubgoals
-    | [p] -> p,tclIDTAC,1
-    | p1::pl ->
-        let c,tac,nb = f pl in
-        mk_and p1 c,
-        tclTHENS
-          (Proofview.V82.of_tactic (apply (EConstr.of_constr (constr_of_monomorphic_global conj_constr))))
-          [tclIDTAC;
-           tac
-          ],nb+1
-  in f l
-
+    | [p] -> (p, tclIDTAC, 1)
+    | p1 :: pl ->
+      let c, tac, nb = f pl in
+      ( mk_and p1 c
+      , tclTHENS
+          (Proofview.V82.of_tactic
+             (apply
+                (EConstr.of_constr (constr_of_monomorphic_global conj_constr))))
+          [tclIDTAC; tac]
+      , nb + 1 )
+  in
+  f l
 
 let is_rec_res id =
-  let rec_res_name = Id.to_string rec_res_id   in
+  let rec_res_name = Id.to_string rec_res_id in
   let id_name = Id.to_string id in
   try
-    String.equal (String.sub id_name 0 (String.length rec_res_name)) rec_res_name
+    String.equal
+      (String.sub id_name 0 (String.length rec_res_name))
+      rec_res_name
   with Invalid_argument _ -> false
 
 let clear_goals sigma =
   let rec clear_goal t =
     match EConstr.kind sigma t with
-      | Prod({binder_name=Name id} as na,t',b) ->
-          let b' = clear_goal b in
-          if noccurn sigma 1 b' && (is_rec_res id)
-          then Vars.lift (-1) b'
-          else if b' == b then t
-          else mkProd(na,t',b')
-      | _ -> EConstr.map sigma clear_goal t
+    | Prod (({binder_name = Name id} as na), t', b) ->
+      let b' = clear_goal b in
+      if noccurn sigma 1 b' && is_rec_res id then Vars.lift (-1) b'
+      else if b' == b then t
+      else mkProd (na, t', b')
+    | _ -> EConstr.map sigma clear_goal t
   in
   List.map clear_goal
 
-
 let build_new_goal_type lemma =
   let sigma, sub_gls_types = Lemmas.pf_fold get_current_subgoals_types lemma in
   (* Pp.msgnl (str "sub_gls_types1 := " ++ Util.prlist_with_sep (fun () -> Pp.fnl () ++ Pp.fnl ()) Printer.pr_lconstr sub_gls_types); *)
   let sub_gls_types = clear_goals sigma sub_gls_types in
   (* Pp.msgnl (str "sub_gls_types2 := " ++ Pp.prlist_with_sep (fun () -> Pp.fnl () ++ Pp.fnl ()) Printer.pr_lconstr sub_gls_types); *)
   let res = build_and_l sigma sub_gls_types in
-    sigma, res
+  (sigma, res)
 
 let is_opaque_constant c =
   let cb = Global.lookup_constant c in
   match cb.Declarations.const_body with
-    | Declarations.OpaqueDef _ -> Proof_global.Opaque
-    | Declarations.Undef _ -> Proof_global.Opaque
-    | Declarations.Def _ -> Proof_global.Transparent
-    | Declarations.Primitive _ -> Proof_global.Opaque
+  | Declarations.OpaqueDef _ -> Proof_global.Opaque
+  | Declarations.Undef _ -> Proof_global.Opaque
+  | Declarations.Def _ -> Proof_global.Transparent
+  | Declarations.Primitive _ -> Proof_global.Opaque
 
-let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name (gls_type,decompose_and_tac,nb_goal)   =
+let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name
+    (gls_type, decompose_and_tac, nb_goal) =
   (* Pp.msgnl (str "gls_type := " ++ Printer.pr_lconstr gls_type); *)
   let current_proof_name = Lemmas.pf_fold Proof_global.get_proof_name lemma in
-  let name = match goal_name with
+  let name =
+    match goal_name with
     | Some s -> s
-    | None   ->
-        try add_suffix current_proof_name "_subproof"
-        with e when CErrors.noncritical e ->
-          anomaly (Pp.str "open_new_goal with an unnamed theorem.")
+    | None -> (
+      try add_suffix current_proof_name "_subproof"
+      with e when CErrors.noncritical e ->
+        anomaly (Pp.str "open_new_goal with an unnamed theorem.") )
   in
   let na = next_global_ident_away name Id.Set.empty in
   if Termops.occur_existential sigma gls_type then
@@ -1275,8 +1433,8 @@ let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name (gls_type
       let na_ref = qualid_of_ident na in
       let na_global = Smartlocate.global_with_alias na_ref in
       match na_global with
-          GlobRef.ConstRef c -> is_opaque_constant c
-        | _ -> anomaly ~label:"equation_lemma" (Pp.str "not a constant.")
+      | GlobRef.ConstRef c -> is_opaque_constant c
+      | _ -> anomaly ~label:"equation_lemma" (Pp.str "not a constant.")
     in
     let lemma = mkConst (Names.Constant.make1 (Lib.make_kn na)) in
     ref_ := Value (EConstr.Unsafe.to_constr lemma);
@@ -1288,7 +1446,8 @@ let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name (gls_type
       let open Tacticals.New in
       Proofview.Goal.enter (fun gl ->
           let hid = next_ident_away_in_goal h_id (pf_ids_of_hyps gl) in
-          New.observe_tclTHENLIST (fun _ _ -> mt ())
+          New.observe_tclTHENLIST
+            (fun _ _ -> mt ())
             [ generalize [lemma]
             ; Simple.intro hid
             ; Proofview.Goal.enter (fun gl ->
@@ -1299,195 +1458,252 @@ let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name (gls_type
                          let ids' = pf_ids_of_hyps gl in
                          lid := List.rev (List.subtract Id.equal ids' ids);
                          if List.is_empty !lid then lid := [hid];
-                         tclIDTAC)))
-            ]) in
+                         tclIDTAC))) ])
+    in
     let end_tac =
       let open Tacmach.New in
       let open Tacticals.New in
       Proofview.Goal.enter (fun gl ->
           let sigma = project gl in
           match EConstr.kind sigma (pf_concl gl) with
-          | App(f,_) when EConstr.eq_constr sigma f (well_founded ()) ->
+          | App (f, _) when EConstr.eq_constr sigma f (well_founded ()) ->
             Auto.h_auto None [] (Some [])
           | _ ->
             incr h_num;
-            tclCOMPLETE(
-              tclFIRST
-                [ tclTHEN
-                    (eapply_with_bindings (mkVar (List.nth !lid !h_num), NoBindings))
-                    e_assumption
-                ; Eauto.eauto_with_bases
-                      (true,5)
-                      [(fun _ sigma -> (sigma, (Lazy.force refl_equal)))]
-                      [Hints.Hint_db.empty TransparentState.empty false
-                      ]
-                ]
-            )) in
+            tclCOMPLETE
+              (tclFIRST
+                 [ tclTHEN
+                     (eapply_with_bindings
+                        (mkVar (List.nth !lid !h_num), NoBindings))
+                     e_assumption
+                 ; Eauto.eauto_with_bases (true, 5)
+                     [(fun _ sigma -> (sigma, Lazy.force refl_equal))]
+                     [Hints.Hint_db.empty TransparentState.empty false] ]))
+    in
     let lemma = build_proof env (Evd.from_env env) start_tac end_tac in
     Lemmas.save_lemma_proved ~lemma ~opaque:opacity ~idopt:None
   in
   let info = Lemmas.Info.make ~hook:(DeclareDef.Hook.make hook) () in
-  let lemma = Lemmas.start_lemma
-      ~name:na
-      ~poly:false (* FIXME *) ~info
-      sigma gls_type in
-  let lemma = if Indfun_common.is_strict_tcc  ()
-  then
-    fst @@ Lemmas.by (Proofview.V82.tactic (tclIDTAC)) lemma
-  else
-    fst @@ Lemmas.by (Proofview.V82.tactic begin
-        fun g ->
-          tclTHEN
-            (decompose_and_tac)
-            (tclORELSE
-               (tclFIRST
-                  (List.map
-                     (fun c ->
-                        Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST
-                          [intros;
-                           Simple.apply (fst (interp_constr (Global.env()) Evd.empty c)) (*FIXME*);
-                           Tacticals.New.tclCOMPLETE Auto.default_auto
-                          ])
-                     )
-                     using_lemmas)
-               ) tclIDTAC)
-            g end) lemma
+  let lemma =
+    Lemmas.start_lemma ~name:na ~poly:false (* FIXME *) ~info sigma gls_type
+  in
+  let lemma =
+    if Indfun_common.is_strict_tcc () then
+      fst @@ Lemmas.by (Proofview.V82.tactic tclIDTAC) lemma
+    else
+      fst
+      @@ Lemmas.by
+           (Proofview.V82.tactic (fun g ->
+                tclTHEN decompose_and_tac
+                  (tclORELSE
+                     (tclFIRST
+                        (List.map
+                           (fun c ->
+                             Proofview.V82.of_tactic
+                               (Tacticals.New.tclTHENLIST
+                                  [ intros
+                                  ; Simple.apply
+                                      (fst
+                                         (interp_constr (Global.env ())
+                                            Evd.empty c))
+                                    (*FIXME*)
+                                  ; Tacticals.New.tclCOMPLETE Auto.default_auto
+                                  ]))
+                           using_lemmas))
+                     tclIDTAC)
+                  g))
+           lemma
   in
-  if Lemmas.(pf_fold Proof_global.get_open_goals) lemma = 0 then (defined lemma; None) else Some lemma
-
-let com_terminate
-    interactive_proof
-    tcc_lemma_name
-    tcc_lemma_ref
-    is_mes
-    fonctional_ref
-    input_type
-    relation
-    rec_arg_num
-    thm_name using_lemmas
-    nb_args ctx
-    hook =
+  if Lemmas.(pf_fold Proof_global.get_open_goals) lemma = 0 then (
+    defined lemma; None )
+  else Some lemma
+
+let com_terminate interactive_proof tcc_lemma_name tcc_lemma_ref is_mes
+    fonctional_ref input_type relation rec_arg_num thm_name using_lemmas nb_args
+    ctx hook =
   let start_proof env ctx tac_start tac_end =
     let info = Lemmas.Info.make ~hook () in
-    let lemma = Lemmas.start_lemma ~name:thm_name
-        ~poly:false (*FIXME*)
-        ~info
-        ctx
-        (EConstr.of_constr (compute_terminate_type nb_args fonctional_ref)) in
-    let lemma = fst @@ Lemmas.by (New.observe_tac (fun _ _ -> str "starting_tac") tac_start) lemma in
-    fst @@ Lemmas.by (Proofview.V82.tactic (observe_tac (fun _ _ -> str "whole_start") (whole_start tac_end nb_args is_mes fonctional_ref
-                                   input_type relation rec_arg_num ))) lemma
+    let lemma =
+      Lemmas.start_lemma ~name:thm_name ~poly:false (*FIXME*) ~info ctx
+        (EConstr.of_constr (compute_terminate_type nb_args fonctional_ref))
+    in
+    let lemma =
+      fst
+      @@ Lemmas.by
+           (New.observe_tac (fun _ _ -> str "starting_tac") tac_start)
+           lemma
+    in
+    fst
+    @@ Lemmas.by
+         (Proofview.V82.tactic
+            (observe_tac
+               (fun _ _ -> str "whole_start")
+               (whole_start tac_end nb_args is_mes fonctional_ref input_type
+                  relation rec_arg_num)))
+         lemma
+  in
+  let lemma =
+    start_proof
+      Global.(env ())
+      ctx Tacticals.New.tclIDTAC Tacticals.New.tclIDTAC
   in
-  let lemma = start_proof Global.(env ()) ctx Tacticals.New.tclIDTAC Tacticals.New.tclIDTAC in
   try
     let sigma, new_goal_type = build_new_goal_type lemma in
     let sigma = Evd.from_ctx (Evd.evar_universe_context sigma) in
-    open_new_goal ~lemma start_proof sigma
-      using_lemmas tcc_lemma_ref
-      (Some tcc_lemma_name)
-      (new_goal_type)
+    open_new_goal ~lemma start_proof sigma using_lemmas tcc_lemma_ref
+      (Some tcc_lemma_name) new_goal_type
   with EmptySubgoals ->
     (* a non recursive function declared with measure ! *)
     tcc_lemma_ref := Not_needed;
-    if interactive_proof then Some lemma
-    else (defined lemma; None)
+    if interactive_proof then Some lemma else (defined lemma; None)
 
-let start_equation (f:GlobRef.t) (term_f:GlobRef.t)
-  (cont_tactic:Id.t list -> tactic) g =
+let start_equation (f : GlobRef.t) (term_f : GlobRef.t)
+    (cont_tactic : Id.t list -> tactic) g =
   let sigma = project g in
   let ids = pf_ids_of_hyps g in
   let terminate_constr = constr_of_monomorphic_global term_f in
   let terminate_constr = EConstr.of_constr terminate_constr in
-  let nargs = nb_prod (project g) (EConstr.of_constr (type_of_const sigma terminate_constr)) in
+  let nargs =
+    nb_prod (project g)
+      (EConstr.of_constr (type_of_const sigma terminate_constr))
+  in
   let x = n_x_id ids nargs in
-  observe_tac (fun _ _ -> str "start_equation") (observe_tclTHENLIST (fun _ _ -> str "start_equation") [
-    h_intros x;
-    Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, evaluable_of_global_reference f)]);
-    observe_tac (fun _ _ -> str "simplest_case")
-      (Proofview.V82.of_tactic (simplest_case (mkApp (terminate_constr,
-                             Array.of_list (List.map mkVar x)))));
-    observe_tac (fun _ _ -> str "prove_eq") (cont_tactic x)]) g;;
-
-let com_eqn uctx nb_arg eq_name functional_ref f_ref terminate_ref equation_lemma_type =
-    let open CVars in
-    let opacity =
-      match terminate_ref with
-        | GlobRef.ConstRef c -> is_opaque_constant c
-        | _ -> anomaly ~label:"terminate_lemma" (Pp.str "not a constant.")
-    in
-    let evd = Evd.from_ctx uctx in
-    let f_constr = constr_of_monomorphic_global f_ref in
-    let equation_lemma_type = subst1 f_constr equation_lemma_type in
-    let lemma = Lemmas.start_lemma ~name:eq_name ~poly:false evd
-       (EConstr.of_constr equation_lemma_type) in
-    let lemma = fst @@ Lemmas.by
-       (Proofview.V82.tactic (start_equation f_ref terminate_ref
-          (fun  x ->
-             prove_eq (fun _ -> tclIDTAC)
-               {nb_arg=nb_arg;
-                f_terminate = EConstr.of_constr (constr_of_monomorphic_global terminate_ref);
-                f_constr = EConstr.of_constr f_constr;
-                concl_tac = Tacticals.New.tclIDTAC;
-                func=functional_ref;
-                info=(instantiate_lambda Evd.empty
-                        (EConstr.of_constr (def_of_const (constr_of_monomorphic_global functional_ref)))
-                        (EConstr.of_constr f_constr::List.map mkVar x)
-                );
-                is_main_branch = true;
-                is_final = true;
-                values_and_bounds = [];
-                eqs = [];
-                forbidden_ids = [];
-                acc_inv = lazy (assert false);
-                acc_id = Id.of_string "____";
-                args_assoc = [];
-                f_id = Id.of_string "______";
-                rec_arg_id = Id.of_string "______";
-                is_mes = false;
-                ih = Id.of_string "______";
-               }
-          )
-       )) lemma in
-    let _ = Flags.silently (fun () -> Lemmas.save_lemma_proved ~lemma ~opaque:opacity ~idopt:None) () in
-    ()
-(*      Pp.msgnl (fun _ _ -> str "eqn finished"); *)
+  observe_tac
+    (fun _ _ -> str "start_equation")
+    (observe_tclTHENLIST
+       (fun _ _ -> str "start_equation")
+       [ h_intros x
+       ; Proofview.V82.of_tactic
+           (unfold_in_concl
+              [(Locus.AllOccurrences, evaluable_of_global_reference f)])
+       ; observe_tac
+           (fun _ _ -> str "simplest_case")
+           (Proofview.V82.of_tactic
+              (simplest_case
+                 (mkApp (terminate_constr, Array.of_list (List.map mkVar x)))))
+       ; observe_tac (fun _ _ -> str "prove_eq") (cont_tactic x) ])
+    g
 
+let com_eqn uctx nb_arg eq_name functional_ref f_ref terminate_ref
+    equation_lemma_type =
+  let open CVars in
+  let opacity =
+    match terminate_ref with
+    | GlobRef.ConstRef c -> is_opaque_constant c
+    | _ -> anomaly ~label:"terminate_lemma" (Pp.str "not a constant.")
+  in
+  let evd = Evd.from_ctx uctx in
+  let f_constr = constr_of_monomorphic_global f_ref in
+  let equation_lemma_type = subst1 f_constr equation_lemma_type in
+  let lemma =
+    Lemmas.start_lemma ~name:eq_name ~poly:false evd
+      (EConstr.of_constr equation_lemma_type)
+  in
+  let lemma =
+    fst
+    @@ Lemmas.by
+         (Proofview.V82.tactic
+            (start_equation f_ref terminate_ref (fun x ->
+                 prove_eq
+                   (fun _ -> tclIDTAC)
+                   { nb_arg
+                   ; f_terminate =
+                       EConstr.of_constr
+                         (constr_of_monomorphic_global terminate_ref)
+                   ; f_constr = EConstr.of_constr f_constr
+                   ; concl_tac = Tacticals.New.tclIDTAC
+                   ; func = functional_ref
+                   ; info =
+                       instantiate_lambda Evd.empty
+                         (EConstr.of_constr
+                            (def_of_const
+                               (constr_of_monomorphic_global functional_ref)))
+                         (EConstr.of_constr f_constr :: List.map mkVar x)
+                   ; is_main_branch = true
+                   ; is_final = true
+                   ; values_and_bounds = []
+                   ; eqs = []
+                   ; forbidden_ids = []
+                   ; acc_inv = lazy (assert false)
+                   ; acc_id = Id.of_string "____"
+                   ; args_assoc = []
+                   ; f_id = Id.of_string "______"
+                   ; rec_arg_id = Id.of_string "______"
+                   ; is_mes = false
+                   ; ih = Id.of_string "______" })))
+         lemma
+  in
+  let _ =
+    Flags.silently
+      (fun () -> Lemmas.save_lemma_proved ~lemma ~opaque:opacity ~idopt:None)
+      ()
+  in
+  ()
 
-let recursive_definition ~interactive_proof ~is_mes function_name rec_impls type_of_f r rec_arg_num eq
-    generate_induction_principle using_lemmas : Lemmas.t option =
+(*      Pp.msgnl (fun _ _ -> str "eqn finished"); *)
+
+let recursive_definition ~interactive_proof ~is_mes function_name rec_impls
+    type_of_f r rec_arg_num eq generate_induction_principle using_lemmas :
+    Lemmas.t option =
   let open Term in
   let open Constr in
   let open CVars in
-  let env = Global.env() in
+  let env = Global.env () in
   let evd = Evd.from_env env in
-  let evd, function_type = interp_type_evars ~program_mode:false env evd type_of_f in
-  let function_r = Sorts.Relevant in (* TODO relevance *)
-  let env = EConstr.push_named (Context.Named.Declaration.LocalAssum (make_annot function_name function_r,function_type)) env in
+  let evd, function_type =
+    interp_type_evars ~program_mode:false env evd type_of_f
+  in
+  let function_r = Sorts.Relevant in
+  (* TODO relevance *)
+  let env =
+    EConstr.push_named
+      (Context.Named.Declaration.LocalAssum
+         (make_annot function_name function_r, function_type))
+      env
+  in
   (* Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type);  *)
-  let evd, ty = interp_type_evars ~program_mode:false env evd ~impls:rec_impls eq in
+  let evd, ty =
+    interp_type_evars ~program_mode:false env evd ~impls:rec_impls eq
+  in
   let evd = Evd.minimize_universes evd in
-  let equation_lemma_type = Reductionops.nf_betaiotazeta env evd (Evarutil.nf_evar evd ty) in
-  let function_type = EConstr.to_constr ~abort_on_undefined_evars:false evd function_type in
+  let equation_lemma_type =
+    Reductionops.nf_betaiotazeta env evd (Evarutil.nf_evar evd ty)
+  in
+  let function_type =
+    EConstr.to_constr ~abort_on_undefined_evars:false evd function_type
+  in
   let equation_lemma_type = EConstr.Unsafe.to_constr equation_lemma_type in
- (* Pp.msgnl (fun _ _ -> str "lemma type := " ++ Printer.pr_lconstr equation_lemma_type ++ fnl ()); *)
-  let res_vars,eq' = decompose_prod equation_lemma_type in
-  let env_eq' = Environ.push_rel_context (List.map (fun (x,y) -> LocalAssum (x,y)) res_vars) env in
+  (* Pp.msgnl (fun _ _ -> str "lemma type := " ++ Printer.pr_lconstr equation_lemma_type ++ fnl ()); *)
+  let res_vars, eq' = decompose_prod equation_lemma_type in
+  let env_eq' =
+    Environ.push_rel_context
+      (List.map (fun (x, y) -> LocalAssum (x, y)) res_vars)
+      env
+  in
   let eq' = Reductionops.nf_zeta env_eq' evd (EConstr.of_constr eq') in
   let eq' = EConstr.Unsafe.to_constr eq' in
   let res =
-(*     Pp.msgnl (fun _ _ -> str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *)
-(*     Pp.msgnl (fun _ _ -> str "rec_arg_num := " ++ str (fun _ _ -> string_of_int rec_arg_num)); *)
-(*     Pp.msgnl (fun _ _ -> str "eq' := " ++ str (fun _ _ -> string_of_int rec_arg_num)); *)
+    (*     Pp.msgnl (fun _ _ -> str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *)
+    (*     Pp.msgnl (fun _ _ -> str "rec_arg_num := " ++ str (fun _ _ -> string_of_int rec_arg_num)); *)
+    (*     Pp.msgnl (fun _ _ -> str "eq' := " ++ str (fun _ _ -> string_of_int rec_arg_num)); *)
     match Constr.kind eq' with
-      | App(e,[|_;_;eq_fix|]) ->
-          mkLambda (make_annot (Name function_name) Sorts.Relevant,function_type,subst_var function_name (compose_lam res_vars  eq_fix))
-      | _ -> failwith "Recursive Definition (res not eq)"
+    | App (e, [|_; _; eq_fix|]) ->
+      mkLambda
+        ( make_annot (Name function_name) Sorts.Relevant
+        , function_type
+        , subst_var function_name (compose_lam res_vars eq_fix) )
+    | _ -> failwith "Recursive Definition (res not eq)"
+  in
+  let pre_rec_args, function_type_before_rec_arg =
+    decompose_prod_n (rec_arg_num - 1) function_type
+  in
+  let _, rec_arg_type, _ = destProd function_type_before_rec_arg in
+  let arg_types =
+    List.rev_map snd
+      (fst (decompose_prod_n (List.length res_vars) function_type))
   in
-  let pre_rec_args,function_type_before_rec_arg = decompose_prod_n (rec_arg_num - 1) function_type in
-  let (_, rec_arg_type, _) = destProd function_type_before_rec_arg in
-  let arg_types = List.rev_map snd (fst (decompose_prod_n (List.length res_vars) function_type)) in
   let equation_id = add_suffix function_name "_equation" in
-  let functional_id =  add_suffix function_name "_F" in
+  let functional_id = add_suffix function_name "_F" in
   let term_id = add_suffix function_name "_terminate" in
   let functional_ref =
     let univs = Evd.univ_entry ~poly:false evd in
@@ -1495,57 +1711,61 @@ let recursive_definition ~interactive_proof ~is_mes function_name rec_impls type
   in
   (* Refresh the global universes, now including those of _F *)
   let evd = Evd.from_env (Global.env ()) in
-  let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> LocalAssum (x,t)) pre_rec_args) env in
-  let relation, evuctx =
-    interp_constr env_with_pre_rec_args evd r
+  let env_with_pre_rec_args =
+    push_rel_context
+      (List.map (function x, t -> LocalAssum (x, t)) pre_rec_args)
+      env
   in
+  let relation, evuctx = interp_constr env_with_pre_rec_args evd r in
   let evd = Evd.from_ctx evuctx in
   let tcc_lemma_name = add_suffix function_name "_tcc" in
   let tcc_lemma_constr = ref Undefined in
   (* let _ = Pp.msgnl (fun _ _ -> str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *)
-  let hook { DeclareDef.Hook.S.uctx ; _ } =
+  let hook {DeclareDef.Hook.S.uctx; _} =
     let term_ref = Nametab.locate (qualid_of_ident term_id) in
-    let f_ref = declare_f function_name Decls.(IsProof Lemma) arg_types term_ref in
-    let _ = Extraction_plugin.Table.extraction_inline true [qualid_of_ident term_id] in
+    let f_ref =
+      declare_f function_name Decls.(IsProof Lemma) arg_types term_ref
+    in
+    let _ =
+      Extraction_plugin.Table.extraction_inline true [qualid_of_ident term_id]
+    in
     (*     message "start second proof"; *)
     let stop =
       (* XXX: What is the correct way to get sign at hook time *)
       try
-        com_eqn uctx (List.length res_vars) equation_id functional_ref f_ref term_ref (subst_var function_name equation_lemma_type);
+        com_eqn uctx (List.length res_vars) equation_id functional_ref f_ref
+          term_ref
+          (subst_var function_name equation_lemma_type);
         false
       with e when CErrors.noncritical e ->
-        begin
-          if do_observe ()
-          then Feedback.msg_debug (str "Cannot create equation Lemma " ++ CErrors.print e)
-          else CErrors.user_err ~hdr:"Cannot create equation Lemma"
-               (str "Cannot create equation lemma." ++ spc () ++
-                str "This may be because the function is nested-recursive.")
-          ;
-          true
-        end
+        if do_observe () then
+          Feedback.msg_debug
+            (str "Cannot create equation Lemma " ++ CErrors.print e)
+        else
+          CErrors.user_err ~hdr:"Cannot create equation Lemma"
+            ( str "Cannot create equation lemma."
+            ++ spc ()
+            ++ str "This may be because the function is nested-recursive." );
+        true
     in
-    if not stop
-    then
-      let eq_ref = Nametab.locate (qualid_of_ident equation_id ) in
+    if not stop then
+      let eq_ref = Nametab.locate (qualid_of_ident equation_id) in
       let f_ref = destConst (constr_of_monomorphic_global f_ref)
-      and functional_ref = destConst (constr_of_monomorphic_global functional_ref)
+      and functional_ref =
+        destConst (constr_of_monomorphic_global functional_ref)
       and eq_ref = destConst (constr_of_monomorphic_global eq_ref) in
-      generate_induction_principle f_ref tcc_lemma_constr
-        functional_ref eq_ref rec_arg_num
+      generate_induction_principle f_ref tcc_lemma_constr functional_ref eq_ref
+        rec_arg_num
         (EConstr.of_constr rec_arg_type)
-        (nb_prod evd (EConstr.of_constr res)) relation
+        (nb_prod evd (EConstr.of_constr res))
+        relation
   in
   (* XXX STATE Why do we need this... why is the toplevel protection not enough *)
-  funind_purify (fun () ->
-      com_terminate
-        interactive_proof
-        tcc_lemma_name
-        tcc_lemma_constr
-        is_mes functional_ref
+  funind_purify
+    (fun () ->
+      com_terminate interactive_proof tcc_lemma_name tcc_lemma_constr is_mes
+        functional_ref
         (EConstr.of_constr rec_arg_type)
-        relation rec_arg_num
-        term_id
-        using_lemmas
-        (List.length res_vars)
-        evd (DeclareDef.Hook.make hook))
+        relation rec_arg_num term_id using_lemmas (List.length res_vars) evd
+        (DeclareDef.Hook.make hook))
     ()
diff --git a/plugins/funind/recdef.mli b/plugins/funind/recdef.mli
index 3225411c85..4e5146e37c 100644
--- a/plugins/funind/recdef.mli
+++ b/plugins/funind/recdef.mli
@@ -1,13 +1,13 @@
 open Constr
 
-val tclUSER_if_not_mes
-  : unit Proofview.tactic
+val tclUSER_if_not_mes :
+     unit Proofview.tactic
   -> bool
   -> Names.Id.t list option
   -> unit Proofview.tactic
 
-val recursive_definition
-  :  interactive_proof:bool
+val recursive_definition :
+     interactive_proof:bool
   -> is_mes:bool
   -> Names.Id.t
   -> Constrintern.internalization_env
@@ -15,7 +15,14 @@ val recursive_definition
   -> Constrexpr.constr_expr
   -> int
   -> Constrexpr.constr_expr
-  -> (pconstant -> Indfun_common.tcc_lemma_value ref -> pconstant ->
-      pconstant -> int -> EConstr.types -> int -> EConstr.constr -> unit)
+  -> (   pconstant
+      -> Indfun_common.tcc_lemma_value ref
+      -> pconstant
+      -> pconstant
+      -> int
+      -> EConstr.types
+      -> int
+      -> EConstr.constr
+      -> unit)
   -> Constrexpr.constr_expr list
   -> Lemmas.t option