Imported Upstream version 8.8.2upstream/8.8.2

44 files changed, 3922 insertions, 4173 deletions

diff --git a/tactics/auto.ml b/tactics/auto.ml
index bc644857..0c0d9bcf 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -1,26 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-(*
-*)
+module CVars = Vars
+
 open Pp
 open Util
-open CErrors
 open Names
-open Vars
 open Termops
+open EConstr
 open Environ
-open Tacmach
 open Genredexpr
 open Tactics
-open Tacticals
 open Clenv
-open Tacexpr
 open Locus
 open Proofview.Notations
 open Hints
@@ -36,7 +34,7 @@ open Hints
 let priority l = List.filter (fun (_, hint) -> Int.equal hint.pri 0) l
 
 let compute_secvars gl =
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+  let hyps = Proofview.Goal.hyps gl in
   secvars_of_hyps hyps
 
 (* tell auto not to reuse already instantiated metas in unification (for
@@ -44,9 +42,9 @@ let compute_secvars gl =
 
 open Unification
 
-let auto_core_unif_flags_of st1 st2 useeager = {
+let auto_core_unif_flags_of st1 st2 = {
   modulo_conv_on_closed_terms = Some st1;
-  use_metas_eagerly_in_conv_on_closed_terms = useeager;
+  use_metas_eagerly_in_conv_on_closed_terms = false;
   use_evars_eagerly_in_conv_on_closed_terms = false;
   modulo_delta = st2;
   modulo_delta_types = full_transparent_state;
@@ -59,8 +57,8 @@ let auto_core_unif_flags_of st1 st2 useeager = {
   modulo_eta = true;
 }
 
-let auto_unif_flags_of st1 st2 useeager =
-  let flags = auto_core_unif_flags_of st1 st2 useeager in {
+let auto_unif_flags_of st1 st2 =
+  let flags = auto_core_unif_flags_of st1 st2 in {
   core_unify_flags = flags;
   merge_unify_flags = flags;
   subterm_unify_flags = { flags with modulo_delta = empty_transparent_state };
@@ -69,7 +67,7 @@ let auto_unif_flags_of st1 st2 useeager =
 }
 
 let auto_unif_flags =
-  auto_unif_flags_of full_transparent_state empty_transparent_state false
+  auto_unif_flags_of full_transparent_state empty_transparent_state
 
 (* Try unification with the precompiled clause, then use registered Apply *)
 
@@ -84,27 +82,28 @@ let connect_hint_clenv poly (c, _, ctx) clenv gl =
     if poly then
       (** Refresh the instance of the hint *)
       let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
-      let map c = Vars.subst_univs_level_constr subst c in
+      let map c = CVars.subst_univs_level_constr subst c in
+      let emap c = Vars.subst_univs_level_constr subst c in
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
       (** Only metas are mentioning the old universes. *)
       let clenv = {
-        templval = Evd.map_fl map clenv.templval;
-        templtyp = Evd.map_fl map clenv.templtyp;
+        templval = Evd.map_fl emap clenv.templval;
+        templtyp = Evd.map_fl emap clenv.templtyp;
         evd = Evd.map_metas map evd;
         env = Proofview.Goal.env gl;
       } in
-      clenv, map c
+      clenv, emap c
     else
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
       { clenv with evd = evd ; env = Proofview.Goal.env gl }, c
   in clenv, c
 
 let unify_resolve poly flags ((c : raw_hint), clenv) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let clenv, c = connect_hint_clenv poly c clenv gl in
-  let clenv = Tacmach.New.of_old (fun gl -> clenv_unique_resolver ~flags clenv gl) gl in
+  let clenv = clenv_unique_resolver ~flags clenv gl in
   Clenvtac.clenv_refine false clenv
-  end }
+  end
 
 let unify_resolve_nodelta poly h = unify_resolve poly auto_unif_flags h
 
@@ -113,12 +112,12 @@ let unify_resolve_gen poly = function
   | Some flags -> unify_resolve poly flags
 
 let exact poly (c,clenv) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let clenv', c = connect_hint_clenv poly c clenv gl in
     Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
     (exact_check c)
-  end }
+  end
 
 (* Util *)
 
@@ -142,15 +141,15 @@ let conclPattern concl pat tac =
 	try
 	  Proofview.tclUNIT (Constr_matching.matches env sigma pat concl)
 	with Constr_matching.PatternMatchingFailure ->
-          Tacticals.New.tclZEROMSG (str "conclPattern")
+          Tacticals.New.tclZEROMSG (str "pattern-matching failed")
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
      let env = Proofview.Goal.env gl in
      let sigma = Tacmach.New.project gl in
        constr_bindings env sigma >>= fun constr_bindings ->
      let open Genarg in
      let open Geninterp in
-     let inj c = match val_tag (topwit Constrarg.wit_constr) with
+     let inj c = match val_tag (topwit Stdarg.wit_constr) with
      | Val.Base tag -> Val.Dyn (tag, c)
      | _ -> assert false
      in
@@ -160,7 +159,7 @@ let conclPattern concl pat tac =
      match tac with
      | GenArg (Glbwit wit, tac) ->
       Ftactic.run (Geninterp.interp wit ist tac) (fun _ -> Proofview.tclUNIT ())
-  end }
+  end
 
 (***********************************************************)
 (** A debugging / verbosity framework for trivial and auto *)
@@ -177,8 +176,7 @@ let global_info_auto = ref false
 
 let add_option ls refe =
   let _ = Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = String.concat " " ls;
       Goptions.optkey   = ls;
       Goptions.optread  = (fun () -> !refe);
@@ -191,35 +189,34 @@ let _ =
   add_option ["Info";"Trivial"] global_info_trivial;
   add_option ["Info";"Auto"] global_info_auto
 
-let no_dbg () = (Off,0,ref [])
+type debug_kind = ReportForTrivial | ReportForAuto
+
+let no_dbg (_,whatfor,_,_) = (Off,whatfor,0,ref [])
 
 let mk_trivial_dbg debug =
   let d =
     if debug == Debug || !global_debug_trivial then Debug
     else if debug == Info || !global_info_trivial then Info
     else Off
-  in (d,0,ref [])
-
-(** Note : we start the debug depth of auto at 1 to distinguish it
-   for trivial (whose depth is 0). *)
+  in (d,ReportForTrivial,0,ref [])
 
 let mk_auto_dbg debug =
   let d =
     if debug == Debug || !global_debug_auto then Debug
     else if debug == Info || !global_info_auto then Info
     else Off
-  in (d,1,ref [])
+  in (d,ReportForAuto,0,ref [])
 
-let incr_dbg = function (dbg,depth,trace) -> (dbg,depth+1,trace)
+let incr_dbg = function (dbg,whatfor,depth,trace) -> (dbg,whatfor,depth+1,trace)
 
 (** A tracing tactic for debug/info trivial/auto *)
 
-let tclLOG (dbg,depth,trace) pp tac =
+let tclLOG (dbg,_,depth,trace) pp tac =
   match dbg with
     | Off -> tac
     | Debug ->
        (* For "debug (trivial/auto)", we directly output messages *)
-      let s = String.make depth '*' in
+      let s = String.make (depth+1) '*' in
       Proofview.V82.tactic begin fun gl ->
 	try
 	  let out = Proofview.V82.of_tactic tac gl in
@@ -263,20 +260,20 @@ let pr_info_atom (d,pp) =
   str (String.make d ' ') ++ pp () ++ str "."
 
 let pr_info_trace = function
-  | (Info,_,{contents=(d,Some pp)::l}) ->
+  | (Info,_,_,{contents=(d,Some pp)::l}) ->
       Feedback.msg_info (prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l))
   | _ -> ()
 
 let pr_info_nop = function
-  | (Info,_,_) -> Feedback.msg_info (str "idtac.")
+  | (Info,_,_,_) -> Feedback.msg_info (str "idtac.")
   | _ -> ()
 
 let pr_dbg_header = function
-  | (Off,_,_) -> ()
-  | (Debug,0,_) -> Feedback.msg_debug (str "(* debug trivial: *)")
-  | (Debug,_,_) -> Feedback.msg_debug (str "(* debug auto: *)")
-  | (Info,0,_) -> Feedback.msg_info (str "(* info trivial: *)")
-  | (Info,_,_) -> Feedback.msg_info (str "(* info auto: *)")
+  | (Off,_,_,_) -> ()
+  | (Debug,ReportForTrivial,_,_) -> Feedback.msg_debug (str "(* debug trivial: *)")
+  | (Debug,ReportForAuto,_,_) -> Feedback.msg_debug (str "(* debug auto: *)")
+  | (Info,ReportForTrivial,_,_) -> Feedback.msg_info (str "(* info trivial: *)")
+  | (Info,ReportForAuto,_,_) -> Feedback.msg_info (str "(* info auto: *)")
 
 let tclTRY_dbg d tac =
   let delay f = Proofview.tclUNIT () >>= fun () -> f () in
@@ -294,18 +291,18 @@ let tclTRY_dbg d tac =
   de Hint impérative a été remplacée par plusieurs bases fonctionnelles *)
 
 let flags_of_state st =
-  auto_unif_flags_of st st false
+  auto_unif_flags_of st st
 
 let auto_flags_of_state st =
-  auto_unif_flags_of full_transparent_state st false
+  auto_unif_flags_of full_transparent_state st
 
-let hintmap_of secvars hdc concl =
+let hintmap_of sigma secvars hdc concl =
   match hdc with
   | None -> Hint_db.map_none ~secvars
   | Some hdc ->
-     if occur_existential concl then
-       Hint_db.map_existential ~secvars hdc concl
-     else Hint_db.map_auto ~secvars hdc concl
+     if occur_existential sigma concl then
+       Hint_db.map_existential sigma ~secvars hdc concl
+     else Hint_db.map_auto sigma ~secvars hdc concl
 
 let exists_evaluable_reference env = function
   | EvalConstRef _ -> true
@@ -317,37 +314,38 @@ let dbg_assumption dbg = tclLOG dbg (fun () -> str "assumption") assumption
 let rec trivial_fail_db dbg mod_delta db_list local_db =
   let intro_tac =
     Tacticals.New.tclTHEN (dbg_intro dbg)
-      ( Proofview.Goal.enter { enter = begin fun gl ->
+      ( Proofview.Goal.enter begin fun gl ->
           let sigma = Tacmach.New.project gl in
           let env = Proofview.Goal.env gl in
           let nf c = Evarutil.nf_evar sigma c in
-          let decl = Tacmach.New.pf_last_hyp (Proofview.Goal.assume gl) in
+          let decl = Tacmach.New.pf_last_hyp gl in
           let hyp = Context.Named.Declaration.map_constr nf decl in
 	  let hintl = make_resolve_hyp env sigma hyp
 	  in trivial_fail_db dbg mod_delta db_list
 	       (Hint_db.add_list env sigma hintl local_db)
-      end })
+      end)
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Tacmach.New.pf_nf_concl gl in
+  Proofview.Goal.enter begin fun gl ->
+    let concl = Tacmach.New.pf_concl gl in
+    let sigma = Tacmach.New.project gl in
     let secvars = compute_secvars gl in
     Tacticals.New.tclFIRST
       ((dbg_assumption dbg)::intro_tac::
           (List.map Tacticals.New.tclCOMPLETE
-             (trivial_resolve dbg mod_delta db_list local_db secvars concl)))
-  end }
+             (trivial_resolve sigma dbg mod_delta db_list local_db secvars concl)))
+  end
 
-and my_find_search_nodelta db_list local_db secvars hdc concl =
+and my_find_search_nodelta sigma db_list local_db secvars hdc concl =
   List.map (fun hint -> (None,hint))
-    (List.map_append (hintmap_of secvars hdc concl) (local_db::db_list))
+    (List.map_append (hintmap_of sigma secvars hdc concl) (local_db::db_list))
 
 and my_find_search mod_delta =
   if mod_delta then my_find_search_delta
   else my_find_search_nodelta
 
-and my_find_search_delta db_list local_db secvars hdc concl =
-  let f = hintmap_of secvars hdc concl in
-    if occur_existential concl then
+and my_find_search_delta sigma db_list local_db secvars hdc concl =
+  let f = hintmap_of sigma secvars hdc concl in
+    if occur_existential sigma concl then
       List.map_append
 	(fun db ->
 	  if Hint_db.use_dn db then
@@ -369,8 +367,8 @@ and my_find_search_delta db_list local_db secvars hdc concl =
 	      match hdc with None -> Hint_db.map_none ~secvars db
 	      | Some hdc ->
 		  if (Id.Pred.is_empty ids && Cpred.is_empty csts)
-		  then Hint_db.map_auto ~secvars hdc concl db
-		  else Hint_db.map_existential ~secvars hdc concl db
+		  then Hint_db.map_auto sigma ~secvars hdc concl db
+		  else Hint_db.map_existential sigma ~secvars hdc concl db
 	    in auto_flags_of_state st, l
 	  in List.map (fun x -> (Some flags,x)) l)
       	(local_db::db_list)
@@ -378,20 +376,21 @@ and my_find_search_delta db_list local_db secvars hdc concl =
 and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=dbname})) =
   let tactic = function
     | Res_pf (c,cl) -> unify_resolve_gen poly flags (c,cl)
-    | ERes_pf _ -> Proofview.V82.tactic (fun gl -> error "eres_pf")
+    | ERes_pf _ -> Proofview.Goal.enter (fun gl -> Tacticals.New.tclZEROMSG (str "eres_pf"))
     | Give_exact (c, cl)  -> exact poly (c, cl)
     | Res_pf_THEN_trivial_fail (c,cl) ->
       Tacticals.New.tclTHEN
         (unify_resolve_gen poly flags (c,cl))
 	(* With "(debug) trivial", we shouldn't end here, and
 	   with "debug auto" we don't display the details of inner trivial *)
-        (trivial_fail_db (no_dbg ()) (not (Option.is_empty flags)) db_list local_db)
+        (trivial_fail_db (no_dbg dbg) (not (Option.is_empty flags)) db_list local_db)
     | Unfold_nth c ->
-      Proofview.V82.tactic (fun gl ->
-       if exists_evaluable_reference (pf_env gl) c then
-	 tclPROGRESS (Proofview.V82.of_tactic (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)) gl
-       else tclFAIL 0 (str"Unbound reference") gl)
-    | Extern tacast -> 
+      Proofview.Goal.enter begin fun gl ->
+       if exists_evaluable_reference (Tacmach.New.pf_env gl) c then
+	 Tacticals.New.tclPROGRESS (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)
+       else Tacticals.New.tclFAIL 0 (str"Unbound reference")
+       end
+    | Extern tacast ->
       conclPattern concl p tacast
   in
   let pr_hint () =
@@ -399,27 +398,28 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=
     | None -> mt ()
     | Some n -> str " (in " ++ str n ++ str ")"
     in
-    pr_hint t ++ origin
+    let sigma, env = Pfedit.get_current_context () in
+    pr_hint env sigma t ++ origin
   in
   tclLOG dbg pr_hint (run_hint t tactic)
 
-and trivial_resolve dbg mod_delta db_list local_db secvars cl =
+and trivial_resolve sigma dbg mod_delta db_list local_db secvars cl =
   try
     let head =
-      try let hdconstr = decompose_app_bound cl in
+      try let hdconstr = decompose_app_bound sigma cl in
 	    Some hdconstr
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
 	(priority
-	    (my_find_search mod_delta db_list local_db secvars head cl))
+	    (my_find_search mod_delta sigma db_list local_db secvars head cl))
   with Not_found -> []
 
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
 let trivial ?(debug=Off) lems dbnames =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
@@ -427,10 +427,10 @@ let trivial ?(debug=Off) lems dbnames =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (trivial_fail_db d false db_list hints)
-  end }
+  end
 
 let full_trivial ?(debug=Off) lems =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
@@ -438,7 +438,7 @@ let full_trivial ?(debug=Off) lems =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (trivial_fail_db d false db_list hints)
-  end }
+  end
 
 let gen_trivial ?(debug=Off) lems = function
   | None -> full_trivial ~debug lems
@@ -450,15 +450,15 @@ let h_trivial ?(debug=Off) lems l = gen_trivial ~debug lems l
 (*                       The classical Auto tactic                        *)
 (**************************************************************************)
 
-let possible_resolve dbg mod_delta db_list local_db secvars cl =
+let possible_resolve sigma dbg mod_delta db_list local_db secvars cl =
   try
     let head =
-      try let hdconstr = decompose_app_bound cl in
+      try let hdconstr = decompose_app_bound sigma cl in
 	    Some hdconstr
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
-	(my_find_search mod_delta db_list local_db secvars head cl)
+	(my_find_search mod_delta sigma db_list local_db secvars head cl)
   with Not_found -> []
 
 let extend_local_db decl db gl =
@@ -471,10 +471,10 @@ let extend_local_db decl db gl =
 
 let intro_register dbg kont db =
   Tacticals.New.tclTHEN (dbg_intro dbg)
-    (Proofview.Goal.enter { enter = begin fun gl ->
+    (Proofview.Goal.enter begin fun gl ->
       let extend_local_db decl db = extend_local_db decl db gl in
       Tacticals.New.onLastDecl (fun decl -> kont (extend_local_db decl db))
-    end })
+    end)
 
 (* n is the max depth of search *)
 (* local_db contains the local Hypotheses *)
@@ -487,15 +487,16 @@ let search d n mod_delta db_list local_db =
       if Int.equal n 0 then Tacticals.New.tclZEROMSG (str"BOUND 2") else
         Tacticals.New.tclORELSE0 (dbg_assumption d)
 	  (Tacticals.New.tclORELSE0 (intro_register d (search d n) local_db)
-	     ( Proofview.Goal.enter { enter = begin fun gl ->
-               let concl = Tacmach.New.pf_nf_concl gl in
+	     ( Proofview.Goal.enter begin fun gl ->
+               let concl = Tacmach.New.pf_concl gl in
+               let sigma = Tacmach.New.project gl in
                let secvars = compute_secvars gl in
 	       let d' = incr_dbg d in
 	       Tacticals.New.tclFIRST
 	         (List.map
 		    (fun ntac -> Tacticals.New.tclTHEN ntac (search d' (n-1) local_db))
-		    (possible_resolve d mod_delta db_list local_db secvars concl))
-             end }))
+		    (possible_resolve sigma d mod_delta db_list local_db secvars concl))
+             end))
     end []
   in
   search d n local_db
@@ -503,7 +504,7 @@ let search d n mod_delta db_list local_db =
 let default_search_depth = ref 5
 
 let delta_auto debug mod_delta n lems dbnames =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
@@ -511,12 +512,12 @@ let delta_auto debug mod_delta n lems dbnames =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (search d n mod_delta db_list hints)
-  end }
+  end
 
 let delta_auto = 
   if Flags.profile then
-    let key = Profile.declare_profile "delta_auto" in
-      Profile.profile5 key delta_auto
+    let key = CProfile.declare_profile "delta_auto" in
+      CProfile.profile5 key delta_auto
   else delta_auto
 
 let auto ?(debug=Off) n = delta_auto debug false n
@@ -526,7 +527,7 @@ let new_auto ?(debug=Off) n = delta_auto debug true n
 let default_auto = auto !default_search_depth [] []
 
 let delta_full_auto ?(debug=Off) mod_delta n lems =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
@@ -534,7 +535,7 @@ let delta_full_auto ?(debug=Off) mod_delta n lems =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (search d n mod_delta db_list hints)
-  end }
+  end
 
 let full_auto ?(debug=Off) n = delta_full_auto ~debug false n
 let new_full_auto ?(debug=Off) n = delta_full_auto ~debug true n
diff --git a/tactics/auto.mli b/tactics/auto.mli
index 3befaaad..a835c1ed 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -1,28 +1,31 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This files implements auto and related automation tactics *)
 
 open Names
-open Term
+open EConstr
 open Clenv
 open Pattern
 open Decl_kinds
 open Hints
+open Tactypes
 
-val compute_secvars : ('a,'b) Proofview.Goal.t -> Id.Pred.t
+val compute_secvars : Proofview.Goal.t -> Id.Pred.t
 
 val default_search_depth : int ref
 
 val auto_flags_of_state : transparent_state -> Unification.unify_flags
 
 val connect_hint_clenv : polymorphic -> raw_hint -> clausenv ->
-  ('a, 'r) Proofview.Goal.t -> clausenv * constr
+  Proofview.Goal.t -> clausenv * constr
 
 (** Try unification with the precompiled clause, then use registered Apply *)
 val unify_resolve : polymorphic -> Unification.unify_flags -> (raw_hint * clausenv) -> unit Proofview.tactic
@@ -39,43 +42,43 @@ val conclPattern : constr -> constr_pattern option -> Genarg.glob_generic_argume
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
-val auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** Auto with more delta. *)
 
-val new_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val new_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** auto with default search depth and with the hint database "core" *)
 val default_auto : unit Proofview.tactic
 
 (** auto with all hint databases *)
-val full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+val full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
 (** auto with all hint databases and doing delta *)
-val new_full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+val new_full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
 (** auto with default search depth and with all hint databases *)
 val default_full_auto : unit Proofview.tactic
 
 (** The generic form of auto (second arg [None] means all bases) *)
-val gen_auto : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val gen_auto : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** The hidden version of auto *)
-val h_auto   : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val h_auto   : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** Trivial *)
 
-val trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
-val gen_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
-val full_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> unit Proofview.tactic
-val h_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val gen_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val full_trivial : ?debug:debug ->
+  delayed_open_constr list -> unit Proofview.tactic
+val h_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 47500564..c3857e6b 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -1,29 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Equality
 open Names
 open Pp
-open Tacticals
-open Tactics
-open Term
+open Constr
 open Termops
 open CErrors
 open Util
 open Mod_subst
 open Locus
-open Proofview.Notations
 
 (* Rewriting rules *)
 type rew_rule = { rew_lemma: constr;
 		  rew_type: types;
 		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
+		  rew_ctx: Univ.ContextSet.t;
 		  rew_l2r: bool;
 		  rew_tac: Genarg.glob_generic_argument option }
 
@@ -65,7 +64,7 @@ let raw_find_base bas = String.Map.find bas !rewtab
 let find_base bas =
   try raw_find_base bas
   with Not_found ->
-    errorlabstrm "AutoRewrite"
+    user_err ~hdr:"AutoRewrite"
       (str "Rewriting base " ++ str bas ++ str " does not exist.")
 
 let find_rewrites bas =
@@ -76,31 +75,30 @@ let find_matches bas pat =
   let res = HintDN.search_pattern base pat in
   List.map snd res
 
-let print_rewrite_hintdb bas =
+let print_rewrite_hintdb env sigma bas =
   (str "Database " ++ str bas ++ fnl () ++
 	   prlist_with_sep fnl
 	   (fun h ->
 	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
-	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
+               Printer.pr_lconstr_env env sigma h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr_env env sigma h.rew_type ++
 	       Option.cata (fun tac -> str " then use tactic " ++
-	       Pptactic.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
+	       Pputils.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
 	   (find_rewrites bas))
 
-type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
+type raw_rew_rule = (constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option) CAst.t
 
 (* Applies all the rules of one base *)
 let one_base general_rewrite_maybe_in tac_main bas =
   let lrul = find_rewrites bas in
   let try_rewrite dir ctx c tc =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let subst, ctx' = Universes.fresh_universe_context_set_instance ctx in
     let c' = Vars.subst_univs_level_constr subst c in
-    let sigma = Sigma.to_evar_map sigma in
     let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx' in
-    let tac = general_rewrite_maybe_in dir c' tc in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end } in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (general_rewrite_maybe_in dir c' tc)
+  end in
   let lrul = List.map (fun h -> 
   let tac = match h.rew_tac with
   | None -> Proofview.tclUNIT ()
@@ -122,56 +120,24 @@ let autorewrite ?(conds=Naive) tac_main lbas =
        Tacticals.New.tclTHEN tac
         (one_base (fun dir c tac ->
 	  let tac = (tac, conds) in
-	    general_rewrite dir AllOccurrences true false ~tac c)
+	    general_rewrite dir AllOccurrences true false ~tac (EConstr.of_constr c))
 	  tac_main bas))
       (Proofview.tclUNIT()) lbas))
 
 let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
  (* let's check at once if id exists (to raise the appropriate error) *)
- let _ = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) idl in
- let general_rewrite_in id =
-  let id = ref id in
-  let to_be_cleared = ref false in
-   fun dir cstr tac gl ->
-    let last_hyp_id =
-     match Tacmach.pf_hyps gl with
-        d :: _ -> Context.Named.Declaration.get_id d
-      | _ -> (* even the hypothesis id is missing *)
-        raise (Logic.RefinerError (Logic.NoSuchHyp !id))
-    in
-    let gl' = Proofview.V82.of_tactic (general_rewrite_in dir AllOccurrences true ~tac:(tac, conds) false !id cstr false) gl in
-    let gls = gl'.Evd.it in
-    match gls with
-       g::_ ->
-        (match Environ.named_context_of_val (Goal.V82.hyps gl'.Evd.sigma g) with
-            d ::_ ->
-              let lastid = Context.Named.Declaration.get_id d in
-              if not (Id.equal last_hyp_id lastid) then
-               begin
-                let gl'' =
-                  if !to_be_cleared then
-                   tclTHEN (fun _ -> gl') (tclTRY (Proofview.V82.of_tactic (clear [!id]))) gl
-                  else gl' in
-                id := lastid ;
-                to_be_cleared := true ;
-                gl''
-               end
-              else
-               begin
-                to_be_cleared := false ;
-                gl'
-               end
-          | _ -> assert false) (* there must be at least an hypothesis *)
-     | _ -> assert false (* rewriting cannot complete a proof *)
- in
- let general_rewrite_in x y z w = Proofview.V82.tactic (general_rewrite_in x y z w) in
+  let _ = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) idl in
+  let general_rewrite_in id dir cstr tac =
+    let cstr = EConstr.of_constr cstr in
+    general_rewrite_in dir AllOccurrences true ~tac:(tac, conds) false id cstr false
+  in
  Tacticals.New.tclMAP (fun id ->
   Tacticals.New.tclREPEAT_MAIN (Proofview.tclPROGRESS
     (List.fold_left (fun tac bas ->
        Tacticals.New.tclTHEN tac (one_base (general_rewrite_in id) tac_main bas)) (Proofview.tclUNIT()) lbas)))
    idl
- end }
+ end
 
 let autorewrite_in ?(conds=Naive) id = autorewrite_multi_in ~conds [id]
 
@@ -196,10 +162,10 @@ let gen_auto_multi_rewrite conds tac_main lbas cl =
 	   | None ->
 		 (* try to rewrite in all hypothesis
 		    (except maybe the rewritten one) *)
-               Proofview.Goal.nf_enter { enter = begin fun gl ->
+               Proofview.Goal.nf_enter begin fun gl ->
                  let ids = Tacmach.New.pf_ids_of_hyps gl in
 		 try_do_hyps (fun id -> id)  ids
-               end })
+               end)
 
 let auto_multi_rewrite ?(conds=Naive) lems cl =
   Proofview.V82.wrap_exceptions (fun () -> gen_auto_multi_rewrite conds (Proofview.tclUNIT()) lems cl)
@@ -257,12 +223,12 @@ type hypinfo = {
 
 let decompose_applied_relation metas env sigma c ctype left2right =
   let find_rel ty =
-    let eqclause = Clenv.mk_clenv_from_env env sigma None (c,ty) in
+    let eqclause = Clenv.mk_clenv_from_env env sigma None (EConstr.of_constr c,ty) in
     let eqclause =
       if metas then eqclause
       else clenv_pose_metas_as_evars eqclause (Evd.undefined_metas eqclause.evd)
     in
-    let (equiv, args) = decompose_app (Clenv.clenv_type eqclause) in
+    let (equiv, args) = decompose_app (EConstr.Unsafe.to_constr (Clenv.clenv_type eqclause)) in
     let rec split_last_two = function
       | [c1;c2] -> [],(c1, c2)
       | x::y::z ->
@@ -272,11 +238,13 @@ let decompose_applied_relation metas env sigma c ctype left2right =
       try
 	let others,(c1,c2) = split_last_two args in
 	let ty1, ty2 =
-	  Typing.unsafe_type_of env eqclause.evd c1, Typing.unsafe_type_of env eqclause.evd c2
+	  Typing.unsafe_type_of env eqclause.evd (EConstr.of_constr c1), Typing.unsafe_type_of env eqclause.evd (EConstr.of_constr c2)
 	in
+	let ty = EConstr.Unsafe.to_constr ty in
+	let ty1 = EConstr.Unsafe.to_constr ty1 in
 (* 	  if not (evd_convertible env eqclause.evd ty1 ty2) then None *)
 (* 	  else *)
-	    Some { hyp_cl=eqclause; hyp_prf=(Clenv.clenv_value eqclause); hyp_ty = ty;
+	    Some { hyp_cl=eqclause; hyp_prf=EConstr.Unsafe.to_constr (Clenv.clenv_value eqclause); hyp_ty = ty;
 		   hyp_car=ty1; hyp_rel=mkApp (equiv, Array.of_list others);
 		   hyp_l2r=left2right; hyp_left=c1; hyp_right=c2; }
       with Not_found -> None
@@ -289,13 +257,13 @@ let decompose_applied_relation metas env sigma c ctype left2right =
 	| Some c -> Some c
 	| None -> None
 
-let find_applied_relation metas loc env sigma c left2right =
-  let ctype = Typing.unsafe_type_of env sigma c in
+let find_applied_relation ?loc metas env sigma c left2right =
+  let ctype = Typing.unsafe_type_of env sigma (EConstr.of_constr c) in
     match decompose_applied_relation metas env sigma c ctype left2right with
     | Some c -> c
     | None ->
-	user_err_loc (loc, "decompose_applied_relation",
-		     str"The type" ++ spc () ++ Printer.pr_constr_env env sigma ctype ++
+	user_err ?loc ~hdr:"decompose_applied_relation"
+		    (str"The type" ++ spc () ++ Printer.pr_econstr_env env sigma ctype ++
 		       spc () ++ str"of this term does not end with an applied relation.")
 
 (* To add rewriting rules to a base *)
@@ -303,13 +271,13 @@ let add_rew_rules base lrul =
   let counter = ref 0 in
   let env = Global.env () in
   let sigma = Evd.from_env env in
-  let ist = { Genintern.ltacvars = Id.Set.empty; genv = Global.env () } in
+  let ist = Genintern.empty_glob_sign (Global.env ()) in
   let intern tac = snd (Genintern.generic_intern ist tac) in
   let lrul =
     List.fold_left
-      (fun dn (loc,(c,ctx),b,t) ->
+      (fun dn {CAst.loc;v=((c,ctx),b,t)} ->
 	let sigma = Evd.merge_context_set Evd.univ_rigid sigma ctx in
-	let info = find_applied_relation false loc env sigma c b in
+	let info = find_applied_relation ?loc false env sigma c b in
 	let pat = if b then info.hyp_left else info.hyp_right in
 	let rul = { rew_lemma = c; rew_type = info.hyp_ty;
 		    rew_pat = pat; rew_ctx = ctx; rew_l2r = b;
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index 07065717..03e9414e 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -1,19 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This files implements the autorewrite tactic. *)
 
-open Term
-open Tacexpr
+open Constr
 open Equality
 
 (** Rewriting rules before tactic interpretation *)
-type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
+type raw_rew_rule = (constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option) CAst.t
 
 (** To add rewriting rules to a base *)
 val add_rew_rules : string -> raw_rew_rule list -> unit
@@ -29,7 +30,7 @@ val autorewrite_in : ?conds:conditions -> Names.Id.t -> unit Proofview.tactic ->
 type rew_rule = { rew_lemma: constr;
 		  rew_type: types;
 		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
+		  rew_ctx: Univ.ContextSet.t;
 		  rew_l2r: bool;
 		  rew_tac: Genarg.glob_generic_argument option }
 
@@ -41,7 +42,7 @@ val auto_multi_rewrite : ?conds:conditions -> string list -> Locus.clause -> uni
 
 val auto_multi_rewrite_with : ?conds:conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic
 
-val print_rewrite_hintdb : string -> Pp.std_ppcmds
+val print_rewrite_hintdb : Environ.env -> Evd.evar_map -> string -> Pp.t
 
 open Clenv
 
@@ -57,7 +58,7 @@ type hypinfo = {
   hyp_right : constr;
 }
 
-val find_applied_relation : bool ->
-  Loc.t ->
-  Environ.env -> Evd.evar_map -> Term.constr -> bool -> hypinfo
+val find_applied_relation :
+  ?loc:Loc.t -> bool ->
+  Environ.env -> Evd.evar_map -> constr -> bool -> hypinfo
 
diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml
index 491bc8b4..8e50c977 100644
--- a/tactics/btermdn.ml
+++ b/tactics/btermdn.ml
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
 open Term
+open EConstr
 open Names
 open Pattern
 open Globnames
@@ -38,18 +41,18 @@ let decomp_pat =
   in
   decrec []
 
-let decomp =
-  let rec decrec acc c = match kind_of_term c with
+let decomp sigma t =
+  let rec decrec acc c = match EConstr.kind sigma c with
     | App (f,l) -> decrec (Array.fold_right (fun a l -> a::l) l acc) f
     | Proj (p, c) -> (mkConst (Projection.constant p), c :: acc)
     | Cast (c1,_,_) -> decrec acc c1
     | _ -> (c,acc)
   in
-    decrec []
+    decrec [] t
 
-let constr_val_discr t =
-  let c, l = decomp t in
-    match kind_of_term c with
+let constr_val_discr sigma t =
+  let c, l = decomp sigma t in
+    match EConstr.kind sigma c with
     | Ind (ind_sp,u) -> Label(GRLabel (IndRef ind_sp),l)
     | Construct (cstr_sp,u) -> Label(GRLabel (ConstructRef cstr_sp),l)
     | Var id -> Label(GRLabel (VarRef id),l)
@@ -66,9 +69,9 @@ let constr_pat_discr t =
     | PRef ((VarRef v) as ref), args -> Some(GRLabel ref,args)
     | _ -> None
 
-let constr_val_discr_st (idpred,cpred) t =
-  let c, l = decomp t in
-    match kind_of_term c with
+let constr_val_discr_st sigma (idpred,cpred) t =
+  let c, l = decomp sigma t in
+    match EConstr.kind sigma c with
     | Const (c,u) -> if Cpred.mem c cpred then Everything else Label(GRLabel (ConstRef c),l)
     | Ind (ind_sp,u) -> Label(GRLabel (IndRef ind_sp),l)
     | Construct (cstr_sp,u) -> Label(GRLabel (ConstructRef cstr_sp),l)
@@ -105,11 +108,11 @@ let bounded_constr_pat_discr_st st (t,depth) =
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
 
-let bounded_constr_val_discr_st st (t,depth) =
+let bounded_constr_val_discr_st sigma st (t,depth) =
   if Int.equal depth 0 then
     Nothing
   else
-    match constr_val_discr_st st t with
+    match constr_val_discr_st sigma st t with
       | Label (c,l) -> Label(c,List.map (fun c -> (c,depth-1)) l)
       | Nothing -> Nothing
       | Everything -> Everything
@@ -122,11 +125,11 @@ let bounded_constr_pat_discr (t,depth) =
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
 
-let bounded_constr_val_discr (t,depth) =
+let bounded_constr_val_discr sigma (t,depth) =
   if Int.equal depth 0 then
     Nothing
   else
-    match constr_val_discr t with
+    match constr_val_discr sigma t with
       | Label (c,l) -> Label(c,List.map (fun c -> (c,depth-1)) l)
       | Nothing -> Nothing
       | Everything -> Everything
@@ -162,13 +165,13 @@ struct
 	(fun dn (c,v) ->
 	 Dn.rmv dn (bounded_constr_pat_discr_st st) ((c,!dnet_depth),v))
 
-  let lookup = function
+  let lookup sigma = function
     | None ->
 	(fun dn t ->
-	     Dn.lookup dn bounded_constr_val_discr (t,!dnet_depth))
+	     Dn.lookup dn (bounded_constr_val_discr sigma) (t,!dnet_depth))
     | Some st ->
 	(fun dn t ->
-	     Dn.lookup dn (bounded_constr_val_discr_st st) (t,!dnet_depth))
+	     Dn.lookup dn (bounded_constr_val_discr_st sigma st) (t,!dnet_depth))
 
   let app f dn = Dn.app f dn
 
diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli
index 8ca5549b..861c9b62 100644
--- a/tactics/btermdn.mli
+++ b/tactics/btermdn.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Term
 open Pattern
 open Names
 
@@ -33,7 +34,7 @@ sig
   val add : transparent_state option -> t -> (constr_pattern * Z.t) -> t
   val rmv : transparent_state option -> t -> (constr_pattern * Z.t) -> t
 
-  val lookup : transparent_state option -> t -> constr -> Z.t list
+  val lookup : Evd.evar_map -> transparent_state option -> t -> EConstr.constr -> Z.t list
   val app : (Z.t -> unit) -> t -> unit
 end
 
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index b416bc65..73b649e5 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (* TODO:
@@ -17,9 +19,7 @@ open Util
 open Names
 open Term
 open Termops
-open Reduction
-open Proof_type
-open Tacticals
+open EConstr
 open Tacmach
 open Tactics
 open Clenv
@@ -27,10 +27,11 @@ open Typeclasses
 open Globnames
 open Evd
 open Locus
-open Misctypes
 open Proofview.Notations
 open Hints
 
+module NamedDecl = Context.Named.Declaration
+
 (** Hint database named "typeclass_instances", now created directly in Auto *)
 
 (** Options handling *)
@@ -38,10 +39,6 @@ open Hints
 let typeclasses_debug = ref 0
 let typeclasses_depth = ref None
 
-let typeclasses_modulo_eta = ref false
-let set_typeclasses_modulo_eta d = (:=) typeclasses_modulo_eta d
-let get_typeclasses_modulo_eta () = !typeclasses_modulo_eta
-
 (** When this flag is enabled, the resolution of type classes tries to avoid
     useless introductions. This is no longer useful since we have eta, but is
     here for compatibility purposes. Another compatibility issues is that the
@@ -68,13 +65,6 @@ let set_typeclasses_filtered_unification d =
 let get_typeclasses_filtered_unification () =
   !typeclasses_filtered_unification
 
-(** [typeclasses_legacy_resolution] falls back to the 8.5 resolution algorithm,
-    instead of the 8.6 one which uses the native backtracking facilities of the
-    proof engine. *)
-let typeclasses_legacy_resolution = ref false
-let set_typeclasses_legacy_resolution d = (:=) typeclasses_legacy_resolution d
-let get_typeclasses_legacy_resolution () = !typeclasses_legacy_resolution
-
 let set_typeclasses_debug d = (:=) typeclasses_debug (if d then 1 else 0)
 let get_typeclasses_debug () = if !typeclasses_debug > 0 then true else false
 
@@ -91,17 +81,7 @@ open Goptions
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "do typeclass search modulo eta conversion";
-      optkey   = ["Typeclasses";"Modulo";"Eta"];
-      optread  = get_typeclasses_modulo_eta;
-      optwrite = set_typeclasses_modulo_eta; }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "do typeclass search avoiding eta-expansions " ^
                    " in proof terms (expensive)";
       optkey   = ["Typeclasses";"Limit";"Intros"];
@@ -110,8 +90,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "during typeclass resolution, solve instances according to their dependency order";
       optkey   = ["Typeclasses";"Dependency";"Order"];
       optread  = get_typeclasses_dependency_order;
@@ -119,8 +98,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "use iterative deepening strategy";
       optkey   = ["Typeclasses";"Iterative";"Deepening"];
       optread  = get_typeclasses_iterative_deepening;
@@ -128,17 +106,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "compat";
-      optkey   = ["Typeclasses";"Legacy";"Resolution"];
-      optread  = get_typeclasses_legacy_resolution;
-      optwrite = set_typeclasses_legacy_resolution; }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "compat";
       optkey   = ["Typeclasses";"Filtered";"Unification"];
       optread  = get_typeclasses_filtered_unification;
@@ -146,8 +114,7 @@ let _ =
 
 let set_typeclasses_debug =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "debug output for typeclasses proof search";
       optkey   = ["Typeclasses";"Debug"];
       optread  = get_typeclasses_debug;
@@ -155,8 +122,7 @@ let set_typeclasses_debug =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "debug output for typeclasses proof search";
       optkey   = ["Debug";"Typeclasses"];
       optread  = get_typeclasses_debug;
@@ -164,8 +130,7 @@ let _ =
 
 let _ =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "verbosity of debug output for typeclasses proof search";
       optkey   = ["Typeclasses";"Debug";"Verbosity"];
       optread  = get_typeclasses_verbose;
@@ -173,8 +138,7 @@ let _ =
 
 let set_typeclasses_depth =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "depth for typeclasses proof search";
       optkey   = ["Typeclasses";"Depth"];
       optread  = get_typeclasses_depth;
@@ -187,8 +151,7 @@ let set_typeclasses_strategy = function
   | Bfs -> set_typeclasses_iterative_deepening true
 
 let pr_ev evs ev =
-  Printer.pr_constr_env (Goal.V82.env evs ev) evs
-                        (Evarutil.nf_evar evs (Goal.V82.concl evs ev))
+  Printer.pr_econstr_env (Goal.V82.env evs ev) evs (Goal.V82.concl evs ev)
 
 (** Typeclasses instance search tactic / eauto *)
 
@@ -207,7 +170,7 @@ let auto_core_unif_flags st freeze = {
   frozen_evars = freeze;
   restrict_conv_on_strict_subterms = false; (* ? *)
   modulo_betaiota = true;
-  modulo_eta = !typeclasses_modulo_eta;
+  modulo_eta = false;
 }
 
 let auto_unif_flags freeze st =
@@ -219,38 +182,48 @@ let auto_unif_flags freeze st =
     resolve_evars = false
 }
 
-let e_give_exact flags poly (c,clenv) gl =
+let e_give_exact flags poly (c,clenv) =
+  let open Tacmach.New in
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   let (c, _, _) = c in
-  let c, gl =
+  let c, sigma =
     if poly then
       let clenv', subst = Clenv.refresh_undefined_univs clenv in
-      let evd = evars_reset_evd ~with_conv_pbs:true gl.sigma clenv'.evd in
+      let evd = evars_reset_evd ~with_conv_pbs:true sigma clenv'.evd in
       let c = Vars.subst_univs_level_constr subst c in
-        c, {gl with sigma = evd}
-    else c, gl
+        c, evd
+    else c, sigma
   in
-  let t1 = pf_unsafe_type_of gl c in
-  Proofview.V82.of_tactic (Clenvtac.unify ~flags t1 <*> exact_no_check c) gl
-
-let unify_e_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
+  let (sigma, t1) = Typing.type_of (pf_env gl) sigma c in
+  Proofview.Unsafe.tclEVARS sigma <*>
+  Clenvtac.unify ~flags t1 <*> exact_no_check c
+  end
+
+let clenv_unique_resolver_tac with_evars ~flags clenv' =
+  Proofview.Goal.enter begin fun gls ->
+    let resolve =
+      try Proofview.tclUNIT (clenv_unique_resolver ~flags clenv' gls)
+      with e -> Proofview.tclZERO e
+    in resolve >>= fun clenv' ->
+       Clenvtac.clenv_refine with_evars ~with_classes:false clenv'
+  end
+
+let unify_e_resolve poly flags = begin fun gls (c,_,clenv) ->
   let clenv', c = connect_hint_clenv poly c clenv gls in
-  let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
-    Clenvtac.clenv_refine true ~with_classes:false clenv'
-  end }
+  clenv_unique_resolver_tac true ~flags clenv' end
 
-let unify_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
+let unify_resolve poly flags = begin fun gls (c,_,clenv) ->
   let clenv', _ = connect_hint_clenv poly c clenv gls in
-  let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
-    Clenvtac.clenv_refine false ~with_classes:false clenv'
-  end }
+  clenv_unique_resolver_tac false ~flags clenv'
+  end
 
 (** Application of a lemma using [refine] instead of the old [w_unify] *)
 let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) =
   let open Clenv in
   let env = Proofview.Goal.env gls in
   let concl = Proofview.Goal.concl gls in
-  Refine.refine ~unsafe:true { Sigma.run = fun sigma ->
-      let sigma = Sigma.to_evar_map sigma in
+  Refine.refine ~typecheck:false begin fun sigma ->
       let sigma, term, ty =
         if poly then
           let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
@@ -262,11 +235,11 @@ let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) =
           sigma, c, t
       in
       let sigma', cl = Clenv.make_evar_clause env sigma ?len:n ty in
-      let term = applistc term (List.map (fun x -> x.hole_evar) cl.cl_holes) in
+      let term = applist (term, List.map (fun x -> x.hole_evar) cl.cl_holes) in
       let sigma' =
         Evarconv.the_conv_x_leq env ~ts:flags.core_unify_flags.modulo_delta
                                 cl.cl_concl concl sigma'
-      in Sigma.here term (Sigma.Unsafe.of_evar_map sigma') }
+      in (sigma', term) end
 
 let unify_resolve_refine poly flags gl clenv =
   Proofview.tclORELSE
@@ -286,43 +259,42 @@ let clenv_of_prods poly nprods (c, clenv) gl =
   let (c, _, _) = c in
   if poly || Int.equal nprods 0 then Some (None, clenv)
   else
-    let ty = Retyping.get_type_of (Proofview.Goal.env gl)
-                                  (Sigma.to_evar_map (Proofview.Goal.sigma gl)) c in
-    let diff = nb_prod ty - nprods in
+    let sigma = Tacmach.New.project gl in
+    let ty = Retyping.get_type_of (Proofview.Goal.env gl) sigma c in
+    let diff = nb_prod sigma ty - nprods in
     if Pervasives.(>=) diff 0 then
       (* Was Some clenv... *)
       Some (Some diff,
-            Tacmach.New.of_old (fun gls -> mk_clenv_from_n gls (Some diff) (c,ty)) gl)
+            mk_clenv_from_n gl (Some diff) (c,ty))
     else None
 
 let with_prods nprods poly (c, clenv) f =
   if get_typeclasses_limit_intros () then
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       try match clenv_of_prods poly nprods (c, clenv) gl with
           | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
-          | Some (diff, clenv') -> f.enter gl (c, diff, clenv')
+          | Some (diff, clenv') -> f gl (c, diff, clenv')
       with e when CErrors.noncritical e ->
-        Tacticals.New.tclZEROMSG (CErrors.print e) end }
-  else Proofview.Goal.nf_enter
-         { enter = begin fun gl ->
-                   if Int.equal nprods 0 then f.enter gl (c, None, clenv)
-                   else Tacticals.New.tclZEROMSG (str"Not enough premisses") end }
+        Tacticals.New.tclZEROMSG (CErrors.print e) end
+  else Proofview.Goal.enter
+         begin fun gl ->
+         if Int.equal nprods 0 then f gl (c, None, clenv)
+         else Tacticals.New.tclZEROMSG (str"Not enough premisses") end
 
 let matches_pattern concl pat =
   let matches env sigma =
     match pat with
     | None -> Proofview.tclUNIT ()
     | Some pat ->
-       let sigma = Sigma.to_evar_map sigma in
        if Constr_matching.is_matching env sigma pat concl then
          Proofview.tclUNIT ()
        else
          Tacticals.New.tclZEROMSG (str "pattern does not match")
   in
-   Proofview.Goal.enter { enter = fun gl ->
+   Proofview.Goal.enter begin fun gl ->
      let env = Proofview.Goal.env gl in
      let sigma = Proofview.Goal.sigma gl in
-       matches env sigma }
+       matches env sigma end
 
 (** Semantics of type class resolution lemma application:
 
@@ -349,21 +321,21 @@ let shelve_dependencies gls =
      Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls);
    shelve_goals gls)
 
-let hintmap_of hdc secvars concl =
+let hintmap_of sigma hdc secvars concl =
   match hdc with
-  | None -> fun db -> Hint_db.map_none secvars db
+  | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
      fun db ->
      if Hint_db.use_dn db then (* Using dnet *)
-       Hint_db.map_eauto secvars hdc concl db
-     else Hint_db.map_existential secvars hdc concl db
+       Hint_db.map_eauto sigma ~secvars hdc concl db
+     else Hint_db.map_existential sigma ~secvars hdc concl db
 
 (** Hack to properly solve dependent evars that are typeclasses *)
 let rec e_trivial_fail_db only_classes db_list local_db secvars =
   let open Tacticals.New in
   let open Tacmach.New in
   let trivial_fail =
-    Proofview.Goal.nf_enter { enter =
+    Proofview.Goal.enter
     begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
@@ -371,15 +343,15 @@ let rec e_trivial_fail_db only_classes db_list local_db secvars =
     let hintl = make_resolve_hyp env sigma d in
     let hints = Hint_db.add_list env sigma hintl local_db in
       e_trivial_fail_db only_classes db_list hints secvars
-      end }
+      end
   in
   let trivial_resolve =
-    Proofview.Goal.nf_enter { enter =
+    Proofview.Goal.enter
     begin fun gl ->
     let tacs = e_trivial_resolve db_list local_db secvars only_classes
-                                 (project gl) (pf_concl gl) in
+                                 (pf_env gl) (project gl) (pf_concl gl) in
       tclFIRST (List.map (fun (x,_,_,_,_) -> x) tacs)
-    end}
+    end
   in
   let tacl =
     Eauto.registered_e_assumption ::
@@ -387,9 +359,9 @@ let rec e_trivial_fail_db only_classes db_list local_db secvars =
   in
   tclFIRST (List.map tclCOMPLETE tacl)
 
-and e_my_find_search db_list local_db secvars hdc complete only_classes sigma concl =
+and e_my_find_search db_list local_db secvars hdc complete only_classes env sigma concl =
   let open Proofview.Notations in
-  let prods, concl = decompose_prod_assum concl in
+  let prods, concl = EConstr.decompose_prod_assum sigma concl in
   let nprods = List.length prods in
   let freeze =
     try
@@ -397,12 +369,12 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
       | Some (hd,_) when only_classes ->
          let cl = Typeclasses.class_info hd in
          if cl.cl_strict then
-           Evd.evars_of_term concl
+           Evarutil.undefined_evars_of_term sigma concl
          else Evar.Set.empty
       | _ -> Evar.Set.empty
     with e when CErrors.noncritical e -> Evar.Set.empty
   in
-  let hint_of_db = hintmap_of hdc secvars concl in
+  let hint_of_db = hintmap_of sigma hdc secvars concl in
   let hintl =
     List.map_append
       (fun db ->
@@ -418,31 +390,25 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
            if get_typeclasses_filtered_unification () then
              let tac =
                with_prods nprods poly (term,cl)
-                          ({ enter = fun gl clenv ->
+                          (fun gl clenv ->
                              matches_pattern concl p <*>
-                               unify_resolve_refine poly flags gl clenv})
+                               unify_resolve_refine poly flags gl clenv)
              in Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
              let tac =
                with_prods nprods poly (term,cl) (unify_resolve poly flags) in
-             if get_typeclasses_legacy_resolution () then
-               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
-             else
                Proofview.tclBIND (Proofview.with_shelf tac)
                   (fun (gls, ()) -> shelve_dependencies gls)
         | ERes_pf (term,cl) ->
            if get_typeclasses_filtered_unification () then
              let tac = (with_prods nprods poly (term,cl)
-                  ({ enter = fun gl clenv ->
+                  (fun gl clenv ->
                              matches_pattern concl p <*>
-                             unify_resolve_refine poly flags gl clenv})) in
+                             unify_resolve_refine poly flags gl clenv)) in
              Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
              let tac =
                with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
-             if get_typeclasses_legacy_resolution () then
-               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
-             else
                Proofview.tclBIND (Proofview.with_shelf tac)
                   (fun (gls, ()) -> shelve_dependencies gls)
         | Give_exact (c,clenv) ->
@@ -450,18 +416,17 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
              let tac =
                matches_pattern concl p <*>
                  Proofview.Goal.nf_enter
-                   { enter = fun gl -> unify_resolve_refine poly flags gl (c,None,clenv) } in
+                   (fun gl -> unify_resolve_refine poly flags gl (c,None,clenv)) in
              Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
-             Proofview.V82.tactic (e_give_exact flags poly (c,clenv))
+             e_give_exact flags poly (c,clenv)
       | Res_pf_THEN_trivial_fail (term,cl) ->
          let fst = with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
          let snd = if complete then Tacticals.New.tclIDTAC
                    else e_trivial_fail_db only_classes db_list local_db secvars in
          Tacticals.New.tclTHEN fst snd
       | Unfold_nth c ->
-         let tac = Proofview.V82.of_tactic (unfold_in_concl [AllOccurrences,c]) in
-         Proofview.V82.tactic (tclWEAK_PROGRESS tac)
+         Proofview.tclPROGRESS (unfold_in_concl [AllOccurrences,c])
       | Extern tacast -> conclPattern concl p tacast
       in
       let tac = run_hint t tac in
@@ -469,24 +434,24 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
       let pp =
         match p with
         | Some pat when get_typeclasses_filtered_unification () ->
-           str " with pattern " ++ Printer.pr_constr_pattern pat
+           str " with pattern " ++ Printer.pr_constr_pattern_env env sigma pat
         | _ -> mt ()
       in
         match repr_hint t with
-        | Extern _ -> (tac, b, true, name, lazy (pr_hint t ++ pp))
-        | _ -> (tac, b, false, name, lazy (pr_hint t ++ pp))
+        | Extern _ -> (tac, b, true, name, lazy (pr_hint env sigma t ++ pp))
+        | _ -> (tac, b, false, name, lazy (pr_hint env sigma t ++ pp))
   in List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db secvars only_classes sigma concl =
-  let hd = try Some (decompose_app_bound concl) with Bound -> None in
+and e_trivial_resolve db_list local_db secvars only_classes env sigma concl =
+  let hd = try Some (decompose_app_bound sigma concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db secvars hd true only_classes sigma concl
+    e_my_find_search db_list local_db secvars hd true only_classes env sigma concl
   with Not_found -> []
 
-let e_possible_resolve db_list local_db secvars only_classes sigma concl =
-  let hd = try Some (decompose_app_bound concl) with Bound -> None in
+let e_possible_resolve db_list local_db secvars only_classes env sigma concl =
+  let hd = try Some (decompose_app_bound sigma concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db secvars hd false only_classes sigma concl
+    e_my_find_search db_list local_db secvars hd false only_classes env sigma concl
   with Not_found -> []
 
 let cut_of_hints h =
@@ -496,17 +461,29 @@ let catchable = function
   | Refiner.FailError _ -> true
   | e -> Logic.catchable_exception e
 
-let pr_depth l = prlist_with_sep (fun () -> str ".") int (List.rev l)
+let pr_depth l = 
+  let rec fmt elts =
+    match elts with
+    | [] -> []
+    | [n] -> [string_of_int n]
+    | n1::n2::rest ->
+       (string_of_int n1 ^ "." ^ string_of_int n2) :: fmt rest
+  in
+  prlist_with_sep (fun () -> str "-") str (fmt (List.rev l))
 
 let is_Prop env sigma concl =
   let ty = Retyping.get_type_of env sigma concl in
-  match kind_of_term ty with
-  | Sort (Prop Null) -> true
+  match EConstr.kind sigma ty with
+  | Sort s ->
+    begin match ESorts.kind sigma s with
+    | Prop Null -> true
+    | _ -> false
+    end
   | _ -> false
 
-let is_unique env concl =
+let is_unique env sigma concl =
   try
-    let (cl,u), args = dest_class_app env concl in
+    let (cl,u), args = dest_class_app env sigma concl in
     cl.cl_unique
   with e when CErrors.noncritical e -> false
 
@@ -516,10 +493,10 @@ let top_sort evm undefs =
   let tosee = ref undefs in
   let rec visit ev evi =
     let evs = Evarutil.undefined_evars_of_evar_info evm evi in
+      tosee := Evar.Map.remove ev !tosee;
       Evar.Set.iter (fun ev ->
         if Evar.Map.mem ev !tosee then
           visit ev (Evar.Map.find ev !tosee)) evs;
-      tosee := Evar.Map.remove ev !tosee;
       l' := ev :: !l';
   in
     while not (Evar.Map.is_empty !tosee) do
@@ -546,18 +523,17 @@ let evars_to_goals p evm =
 
 (** Making local hints  *)
 let make_resolve_hyp env sigma st flags only_classes pri decl =
-  let open Context.Named.Declaration in
-  let id = get_id decl in
-  let cty = Evarutil.nf_evar sigma (get_type decl) in
+  let id = NamedDecl.get_id decl in
+  let cty = Evarutil.nf_evar sigma (NamedDecl.get_type decl) in
   let rec iscl env ty =
-    let ctx, ar = decompose_prod_assum ty in
-      match kind_of_term (fst (decompose_app ar)) with
+    let ctx, ar = decompose_prod_assum sigma ty in
+      match EConstr.kind sigma (fst (decompose_app sigma ar)) with
       | Const (c,_) -> is_class (ConstRef c)
       | Ind (i,_) -> is_class (IndRef i)
       | _ ->
-          let env' = Environ.push_rel_context ctx env in
-          let ty' = whd_all env' ar in
-               if not (Term.eq_constr ty' ar) then iscl env' ty'
+          let env' = push_rel_context ctx env in
+          let ty' = Reductionops.whd_all env' sigma ar in
+               if not (EConstr.eq_constr sigma ty' ar) then iscl env' ty'
                else false
   in
   let is_class = iscl env cty in
@@ -572,12 +548,12 @@ let make_resolve_hyp env sigma st flags only_classes pri decl =
              (fun (path,info,c) ->
 	      let info =
 		{ info with Vernacexpr.hint_pattern =
-			    Option.map (Constrintern.intern_constr_pattern env)
+                            Option.map (Constrintern.intern_constr_pattern env sigma)
 				       info.Vernacexpr.hint_pattern }
 	      in
 	      make_resolves env sigma ~name:(PathHints path)
-                  (true,false,Flags.is_verbose()) info false
-                 (IsConstr (c,Univ.ContextSet.empty)))
+                  (true,false,not !Flags.quiet) info false
+                 (IsConstr (EConstr.of_constr c,Univ.ContextSet.empty)))
                hints)
         else []
       in
@@ -593,10 +569,10 @@ let make_hints g st only_classes sign =
     List.fold_left
       (fun hints hyp ->
         let consider =
-          let open Context.Named.Declaration in
-          try let t = Global.lookup_named (get_id hyp) |> get_type in
+          not only_classes ||
+          try let t = hyp |> NamedDecl.get_id |> Global.lookup_named |> NamedDecl.get_type in
               (* Section variable, reindex only if the type changed *)
-              not (Term.eq_constr t (get_type hyp))
+              not (EConstr.eq_constr (project g) (EConstr.of_constr t) (NamedDecl.get_type hyp))
           with Not_found -> true
         in
         if consider then
@@ -607,370 +583,19 @@ let make_hints g st only_classes sign =
       ([]) sign
   in Hint_db.add_list (pf_env g) (project g) hintlist (Hint_db.empty st true)
 
-(** <= 8.5 resolution *)
-module V85 = struct
-
-  type autoinfo = { hints : hint_db; is_evar: existential_key option;
-                    only_classes: bool; unique : bool;
-                    auto_depth: int list; auto_last_tac: std_ppcmds Lazy.t;
-                    auto_path : global_reference option list;
-                    auto_cut : hints_path }
-  type autogoal = goal * autoinfo
-  type failure = NotApplicable | ReachedLimit
-  type 'ans fk = failure -> 'ans
-  type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
-  type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-
-  type auto_result = autogoal list sigma
-
-  type atac = auto_result tac
-
-  (* Some utility types to avoid the need of -rectypes *)
-
-  type 'a optionk =
-    | Nonek
-    | Somek of 'a * 'a optionk fk
-
-  type ('a,'b) optionk2 =
-    | Nonek2 of failure
-    | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
-
-  let pf_filtered_hyps gls =
-    Goal.V82.hyps gls.Evd.sigma (sig_it gls)
-
-  let make_autogoal_hints =
-    let cache = ref (true, Environ.empty_named_context_val,
-                     Hint_db.empty full_transparent_state true)
-    in
-    fun only_classes ?(st=full_transparent_state) g ->
-    let sign = pf_filtered_hyps g in
-    let (onlyc, sign', cached_hints) = !cache in
-    if onlyc == only_classes &&
-         (sign == sign' || Environ.eq_named_context_val sign sign')
-         && Hint_db.transparent_state cached_hints == st
-    then
-      cached_hints
-    else
-      let hints = make_hints g st only_classes (Environ.named_context_of_val sign)
-      in
-      cache := (only_classes, sign, hints); hints
-
-  let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : 'a tac =
-    { skft = fun sk fk {it = gl,hints; sigma=s;} ->
-             let res = try Some (tac {it=gl; sigma=s;})
-                       with e when catchable e -> None in
-             match res with
-             | Some gls -> sk (f gls hints) fk
-             | None -> fk NotApplicable }
-
-  let intro_tac : atac =
-    let tac {it = gls; sigma = s} info =
-      let gls' =
-        List.map (fun g' ->
-            let env = Goal.V82.env s g' in
-            let context = Environ.named_context_of_val (Goal.V82.hyps s g') in
-            let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints)
-              (true,false,false) info.only_classes empty_hint_info (List.hd context) in
-            let ldb = Hint_db.add_list env s hint info.hints in
-            (g', { info with is_evar = None; hints = ldb;
-                             auto_last_tac = lazy (str"intro") })) gls
-      in {it = gls'; sigma = s;}
-    in
-    lift_tactic (Proofview.V82.of_tactic Tactics.intro) tac
-
-  let normevars_tac : atac =
-    { skft = fun sk fk {it = (gl, info); sigma = s;} ->
-             let gl', sigma' = Goal.V82.nf_evar s gl in
-             let info' = { info with auto_last_tac = lazy (str"normevars") } in
-             sk {it = [gl', info']; sigma = sigma';} fk }
-
-  let merge_failures x y =
-    match x, y with
-    | _, ReachedLimit
-      | ReachedLimit, _ -> ReachedLimit
-    | NotApplicable, NotApplicable -> NotApplicable
-
-  let or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
-    { skft = fun sk fk gls -> x.skft sk
-      (fun f -> y.skft sk (fun f' -> fk (merge_failures f f')) gls) gls }
-
-  let or_else_tac (x : 'a tac) (y : failure -> 'a tac) : 'a tac =
-    { skft = fun sk fk gls -> x.skft sk
-      (fun f -> (y f).skft sk fk gls) gls }
-
-  let needs_backtrack env evd oev concl =
-    if Option.is_empty oev || is_Prop env evd concl then
-      occur_existential concl
-    else true
-
-  let hints_tac hints sk fk {it = gl,info; sigma = s} =
-    let env = Goal.V82.env s gl in
-    let concl = Goal.V82.concl s gl in
-    let tacgl = {it = gl; sigma = s;} in
-    let secvars = secvars_of_hyps (Environ.named_context_of_val (Goal.V82.hyps s gl)) in
-    let poss = e_possible_resolve hints info.hints secvars info.only_classes s concl in
-    let unique = is_unique env concl in
-    let rec aux i foundone = function
-      | (tac, _, extern, name, pp) :: tl ->
-         let derivs = path_derivate info.auto_cut name in
-         let res =
-           try
-             if path_matches derivs [] then None
-             else Some (Proofview.V82.of_tactic tac tacgl)
-           with e when catchable e -> None
-         in
-         (match res with
-          | None -> aux i foundone tl
-          | Some {it = gls; sigma = s';} ->
-             if !typeclasses_debug > 0 then
-               Feedback.msg_debug
-                 (pr_depth (i :: info.auto_depth) ++ str": " ++ Lazy.force pp
-                  ++ str" on" ++ spc () ++ pr_ev s gl);
-             let sgls =
-               evars_to_goals
-                 (fun evm ev evi ->
-                   if Typeclasses.is_resolvable evi && not (Evd.is_undefined s ev) &&
-                        (not info.only_classes || Typeclasses.is_class_evar evm evi)
-                   then Typeclasses.mark_unresolvable evi, true
-                   else evi, false) s'
-             in
-             let newgls, s' =
-               let gls' = List.map (fun g -> (None, g)) gls in
-               match sgls with
-               | None -> gls', s'
-               | Some (evgls, s') ->
-                  if not !typeclasses_dependency_order then
-                    (gls' @ List.map (fun (ev,_) -> (Some ev, ev)) (Evar.Map.bindings evgls), s')
-                  else
-                    (* Reorder with dependent subgoals. *)
-                    let evm = List.fold_left
-                                (fun acc g -> Evar.Map.add g (Evd.find_undefined s' g) acc) evgls gls in
-                    let gls = top_sort s' evm in
-                    (List.map (fun ev -> Some ev, ev) gls, s')
-             in
-             let reindex g =
-               let open Goal.V82 in
-               extern && not (Environ.eq_named_context_val
-                             (hyps s' g) (hyps s' gl))
-             in
-             let gl' j (evar, g) =
-               let hints' =
-                 if reindex g then
-                   make_autogoal_hints
-                     info.only_classes
-                     ~st:(Hint_db.transparent_state info.hints)
-                     {it = g; sigma = s';}
-                 else info.hints
-               in
-               { info with
-                 auto_depth = j :: i :: info.auto_depth;
-                 auto_last_tac = pp;
-                 is_evar = evar;
-                 hints = hints';
-                 auto_cut = derivs }
-             in
-             let gls' = List.map_i (fun i g -> snd g, gl' i g) 1 newgls in
-             let glsv = {it = gls'; sigma = s';} in
-             let fk' =
-               (fun e ->
-                 let do_backtrack =
-                   if unique then occur_existential concl
-                   else if info.unique then true
-                   else if List.is_empty gls' then
-                     needs_backtrack env s' info.is_evar concl
-                   else true
-                 in
-                 let e' = match foundone with None -> e
-                                            | Some e' -> merge_failures e e' in
-                 if !typeclasses_debug > 0 then
-                   Feedback.msg_debug
-                     ((if do_backtrack then str"Backtracking after "
-                       else str "Not backtracking after ")
-                      ++ Lazy.force pp);
-                 if do_backtrack then aux (succ i) (Some e') tl
-                 else fk e')
-             in
-             sk glsv fk')
-      | [] ->
-         if foundone == None && !typeclasses_debug > 0 then
-           Feedback.msg_debug
-             (pr_depth info.auto_depth ++ str": no match for " ++
-                Printer.pr_constr_env (Goal.V82.env s gl) s concl ++
-                spc () ++ str ", " ++ int (List.length poss) ++
-                str" possibilities");
-         match foundone with
-         | Some e -> fk e
-         | None -> fk NotApplicable
-    in aux 1 None poss
-
-  let hints_tac hints =
-  { skft = fun sk fk gls -> hints_tac hints sk fk gls }
-
-  let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk =
-    let rec aux s (acc : autogoal list list) fk = function
-      | (gl,info) :: gls ->
-         Control.check_for_interrupt ();
-         (match info.is_evar with
-          | Some ev when Evd.is_defined s ev -> aux s acc fk gls
-          | _ ->
-             second.skft
-               (fun {it=gls';sigma=s'} fk' ->
-                 let fk'' =
-                   if not info.unique && List.is_empty gls' &&
-                        not (needs_backtrack (Goal.V82.env s gl) s
-                                           info.is_evar (Goal.V82.concl s gl))
-                   then fk
-                   else fk'
-                 in
-                 aux s' (gls'::acc) fk'' gls)
-               fk {it = (gl,info); sigma = s; })
-      | [] -> Somek2 (List.rev acc, s, fk)
-    in fun {it = gls; sigma = s; } fk ->
-       let rec aux' = function
-         | Nonek2 e -> fk e
-         | Somek2 (res, s', fk') ->
-            let goals' = List.concat res in
-            sk {it = goals'; sigma = s'; } (fun e -> aux' (fk' e))
-       in aux' (aux s [] (fun e -> Nonek2 e) gls)
-
-  let then_tac (first : atac) (second : atac) : atac =
-    { skft = fun sk fk -> first.skft (then_list second sk) fk }
-
-  let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option =
-    t.skft (fun x _ -> Some x) (fun _ -> None) gl
-
-  type run_list_res = auto_result optionk
-
-  let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : run_list_res =
-    (then_list t (fun x fk -> Somek (x, fk)))
-      gl
-      (fun _ -> Nonek)
-
-  let fail_tac reason : atac =
-    { skft = fun sk fk _ -> fk reason }
-
-  let rec fix (t : 'a tac) : 'a tac =
-    then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
-
-  let rec fix_limit limit (t : 'a tac) : 'a tac =
-    if Int.equal limit 0 then fail_tac ReachedLimit
-    else then_tac t { skft = fun sk fk -> (fix_limit (pred limit) t).skft sk fk }
-
-  let fix_iterative t =
-    let rec aux depth =
-      or_else_tac (fix_limit depth t)
-                  (function
-                   | NotApplicable as e -> fail_tac e
-                   | ReachedLimit -> aux (succ depth))
-    in aux 1
-
-  let fix_iterative_limit limit (t : 'a tac) : 'a tac =
-    let rec aux depth =
-      if Int.equal limit depth then fail_tac ReachedLimit
-      else or_tac (fix_limit depth t)
-                  { skft = fun sk fk -> (aux (succ depth)).skft sk fk }
-    in aux 1
-
-  let make_autogoal ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
-                    cut ev g =
-    let hints = make_autogoal_hints only_classes ~st g in
-    (g.it, { hints = hints ; is_evar = ev; unique = unique;
-             only_classes = only_classes; auto_depth = [];
-             auto_last_tac = lazy (str"none");
-             auto_path = []; auto_cut = cut })
-
-
-  let make_autogoals ?(only_classes=true) ?(unique=false)
-                     ?(st=full_transparent_state) hints gs evm' =
-    let cut = cut_of_hints hints in
-    let gl i g =
-      let (gl, auto) = make_autogoal ~only_classes ~unique
-                                     ~st cut (Some g) {it = g; sigma = evm'; } in
-      (gl, { auto with auto_depth = [i]})
-    in { it = List.map_i gl 1 gs; sigma = evm' }
-
-  let get_result r =
-    match r with
-    | Nonek -> None
-    | Somek (gls, fk) -> Some (gls.sigma,fk)
-
-  let run_on_evars ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
-                   p evm hints tac =
-    match evars_to_goals p evm with
-    | None -> None (* This happens only because there's no evar having p *)
-    | Some (goals, evm') ->
-       let goals =
-         if !typeclasses_dependency_order then
-           top_sort evm' goals
-         else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
-       in
-       let res = run_list_tac tac p goals
-           (make_autogoals ~only_classes ~unique ~st hints goals evm') in
-       match get_result res with
-       | None -> raise Not_found
-       | Some (evm', fk) ->
-          Some (evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm, fk)
-
-  let eauto_tac hints =
-    then_tac normevars_tac (or_tac (hints_tac hints) intro_tac)
-
-  let eauto_tac strategy depth hints =
-    match strategy with
-    | Bfs -> 
-       begin match depth with
-       | None -> fix_iterative (eauto_tac hints)
-       | Some depth -> fix_iterative_limit depth (eauto_tac hints) end
-    | Dfs ->
-       match depth with
-       | None -> fix (eauto_tac hints)
-       | Some depth -> fix_limit depth (eauto_tac hints)
-                                
-  let real_eauto ?depth strategy unique st hints p evd =
-    let res =
-      run_on_evars ~st ~unique p evd hints (eauto_tac strategy depth hints)
-    in
-    match res with
-    | None -> evd
-    | Some (evd', fk) ->
-       if unique then
-         (match get_result (fk NotApplicable) with
-          | Some (evd'', fk') -> error "Typeclass resolution gives multiple solutions"
-          | None -> evd')
-       else evd'
-
-  let resolve_all_evars_once debug depth unique p evd =
-    let db = searchtable_map typeclasses_db in
-    let strategy = if get_typeclasses_iterative_deepening () then Bfs else Dfs in
-    real_eauto ?depth strategy unique (Hint_db.transparent_state db) [db] p evd
-
-  let eauto85 ?(only_classes=true) ?st ?strategy depth hints g =
-    let strategy =
-      match strategy with
-      | None -> if get_typeclasses_iterative_deepening () then Bfs else Dfs
-      | Some s -> s
-    in
-    let gl = { it = make_autogoal ~only_classes ?st
-                                  (cut_of_hints hints) None g; sigma = project g; } in
-    match run_tac (eauto_tac strategy depth hints) gl with
-    | None -> raise Not_found
-    | Some {it = goals; sigma = s; } ->
-       {it = List.map fst goals; sigma = s;}
-
-end
-
-(** 8.6 resolution *)
 module Search = struct
   type autoinfo =
     { search_depth : int list;
-      last_tac : Pp.std_ppcmds Lazy.t;
+      last_tac : Pp.t Lazy.t;
       search_dep : bool;
       search_only_classes : bool;
       search_cut : hints_path;
       search_hints : hint_db; }
 
   (** Local hints *)
-  let autogoal_cache = ref (DirPath.empty, true, Context.Named.empty,
-                            Hint_db.empty full_transparent_state true)
+  let autogoal_cache = Summary.ref ~name:"autogoal_cache"
+      (DirPath.empty, true, Context.Named.empty,
+       Hint_db.empty full_transparent_state true)
 
   let make_autogoal_hints only_classes ?(st=full_transparent_state) g =
     let open Proofview in
@@ -978,9 +603,10 @@ module Search = struct
     let sign = Goal.hyps g in
     let (dir, onlyc, sign', cached_hints) = !autogoal_cache in
     let cwd = Lib.cwd () in
+    let eq c1 c2 = EConstr.eq_constr (project g) c1 c2 in
     if DirPath.equal cwd dir &&
          (onlyc == only_classes) &&
-           Context.Named.equal sign sign' &&
+           Context.Named.equal eq sign sign' &&
              Hint_db.transparent_state cached_hints == st
     then cached_hints
     else
@@ -999,9 +625,9 @@ module Search = struct
 
   (** In the proof engine failures are represented as exceptions *)
   exception ReachedLimitEx
-  exception NotApplicableEx
+  exception NoApplicableEx
 
-  (** ReachedLimitEx has priority over NotApplicableEx to handle
+  (** ReachedLimitEx has priority over NoApplicableEx to handle
       iterative deepening: it should fail when no hints are applicable,
       but go to a deeper depth otherwise. *)
   let merge_exceptions e e' =
@@ -1016,7 +642,7 @@ module Search = struct
       NOT backtrack. *)
   let needs_backtrack env evd unique concl =
     if unique || is_Prop env evd concl then
-      occur_existential concl
+      occur_existential evd concl
     else true
 
   let mark_unresolvables sigma goals =
@@ -1028,16 +654,15 @@ module Search = struct
       sigma goals
 
   let fail_if_nonclass info =
-    Proofview.Goal.enter { enter = fun gl ->
-      let gl = Proofview.Goal.assume gl in
-      let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+    Proofview.Goal.enter begin fun gl ->
+      let sigma = Proofview.Goal.sigma gl in
       if is_class_type sigma (Proofview.Goal.concl gl) then
         Proofview.tclUNIT ()
       else (if !typeclasses_debug > 1 then
               Feedback.msg_debug (pr_depth info.search_depth ++
                                     str": failure due to non-class subgoal " ++
                                     pr_ev sigma (Proofview.Goal.goal gl));
-            Proofview.tclZERO NotApplicableEx) }
+            Proofview.tclZERO NoApplicableEx) end
 
   (** The general hint application tactic.
       tac1 + tac2 .... The choice of OR or ORELSE is determined
@@ -1049,18 +674,17 @@ module Search = struct
     let env = Goal.env gl in
     let concl = Goal.concl gl in
     let sigma = Goal.sigma gl in
-    let s = Sigma.to_evar_map sigma in
-    let unique = not info.search_dep || is_unique env concl in
-    let backtrack = needs_backtrack env s unique concl in
+    let unique = not info.search_dep || is_unique env sigma concl in
+    let backtrack = needs_backtrack env sigma unique concl in
     if !typeclasses_debug > 0 then
       Feedback.msg_debug
         (pr_depth info.search_depth ++ str": looking for " ++
-           Printer.pr_constr_env (Goal.env gl) s concl ++
+           Printer.pr_econstr_env (Goal.env gl) sigma concl ++
            (if backtrack then str" with backtracking"
             else str" without backtracking"));
     let secvars = compute_secvars gl in
     let poss =
-      e_possible_resolve hints info.search_hints secvars info.search_only_classes s concl in
+      e_possible_resolve hints info.search_hints secvars info.search_only_classes env sigma concl in
     (* If no goal depends on the solution of this one or the
        instances are irrelevant/assumed to be unique, then
        we don't need to backtrack, as long as no evar appears in the goal
@@ -1073,32 +697,42 @@ module Search = struct
       let derivs = path_derivate info.search_cut name in
       let pr_error ie =
         if !typeclasses_debug > 1 then
-          let msg =
-            pr_depth (!idx :: info.search_depth) ++ str": " ++
+          let idx = if fst ie == NoApplicableEx then pred !idx else !idx in
+          let header =
+            pr_depth (idx :: info.search_depth) ++ str": " ++
               Lazy.force pp ++
               (if !foundone != true then
-                 str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+                 str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl)
                else mt ())
           in
-          Feedback.msg_debug (msg ++ str " failed with " ++ CErrors.iprint ie)
+          let msg =
+            match fst ie with
+            | Pretype_errors.PretypeError (env, evd, Pretype_errors.CannotUnify (x,y,_)) ->
+               str"Cannot unify " ++ print_constr_env env evd x ++ str" and " ++
+                                           print_constr_env env evd y
+            | ReachedLimitEx -> str "Proof-search reached its limit."
+            | NoApplicableEx -> str "Proof-search failed."
+            | e -> CErrors.iprint ie
+          in
+          Feedback.msg_debug (header ++ str " failed with: " ++ msg)
         else ()
       in
-      let tac_of gls i j = Goal.nf_enter { enter = fun gl' ->
+      let tac_of gls i j = Goal.enter begin fun gl' ->
         let sigma' = Goal.sigma gl' in
-        let s' = Sigma.to_evar_map sigma' in
         let _concl = Goal.concl gl' in
         if !typeclasses_debug > 0 then
           Feedback.msg_debug
             (pr_depth (succ j :: i :: info.search_depth) ++ str" : " ++
-               pr_ev s' (Proofview.Goal.goal gl'));
+               pr_ev sigma' (Proofview.Goal.goal gl'));
+        let eq c1 c2 = EConstr.eq_constr sigma' c1 c2 in
         let hints' =
-          if b && not (Context.Named.equal (Goal.hyps gl') (Goal.hyps gl))
+          if b && not (Context.Named.equal eq (Goal.hyps gl') (Goal.hyps gl))
           then
             let st = Hint_db.transparent_state info.search_hints in
             make_autogoal_hints info.search_only_classes ~st gl'
           else info.search_hints
         in
-        let dep' = info.search_dep || Proofview.unifiable s' (Goal.goal gl') gls in
+        let dep' = info.search_dep || Proofview.unifiable sigma' (Goal.goal gl') gls in
         let info' =
           { search_depth = succ j :: i :: info.search_depth;
             last_tac = pp;
@@ -1106,30 +740,31 @@ module Search = struct
             search_only_classes = info.search_only_classes;
             search_hints = hints';
             search_cut = derivs }
-        in kont info' }
+        in kont info' end
       in
       let rec result (shelf, ()) i k =
         foundone := true;
         Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+        let gls = CList.map Proofview.drop_state gls in
         let j = List.length gls in
         (if !typeclasses_debug > 0 then
            Feedback.msg_debug
              (pr_depth (i :: info.search_depth) ++ str": " ++ Lazy.force pp
-              ++ str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+              ++ str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl)
               ++ str", " ++ int j ++ str" subgoal(s)" ++
                 (Option.cata (fun k -> str " in addition to the first " ++ int k)
                              (mt()) k)));
         let res =
           if j = 0 then tclUNIT ()
           else tclDISPATCH
-                 (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j))))
+                 (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j'))))
         in
         let finish nestedshelf sigma =
           let filter ev =
             try
               let evi = Evd.find_undefined sigma ev in
               if info.search_only_classes then
-                Some (ev, not (is_class_type sigma (Evd.evar_concl evi)))
+                Some (ev, not (is_class_evar sigma evi))
               else Some (ev, true)
             with Not_found -> None
           in
@@ -1159,7 +794,7 @@ module Search = struct
               (if List.is_empty goals then tclUNIT ()
                else
 	         let sigma' = mark_unresolvables sigma goals in
-	         with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>=
+                 with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state goals)) >>=
                       fun s -> result s i (Some (Option.default 0 k + j)))
           end
         in with_shelf res >>= fun (sh, ()) ->
@@ -1185,31 +820,29 @@ module Search = struct
          if !foundone == false && !typeclasses_debug > 0 then
            Feedback.msg_debug
              (pr_depth info.search_depth ++ str": no match for " ++
-                Printer.pr_constr_env (Goal.env gl) s concl ++
-                spc () ++ str ", " ++ int (List.length poss) ++
+                Printer.pr_econstr_env (Goal.env gl) sigma concl ++
+                str ", " ++ int (List.length poss) ++
                 str" possibilities");
          match e with
          | (ReachedLimitEx,ie) -> Proofview.tclZERO ~info:ie ReachedLimitEx
-         | (_,ie) -> Proofview.tclZERO ~info:ie NotApplicableEx
+         | (_,ie) -> Proofview.tclZERO ~info:ie NoApplicableEx
     in
-    if backtrack then aux (NotApplicableEx,Exninfo.null) poss
-    else tclONCE (aux (NotApplicableEx,Exninfo.null) poss)
+    if backtrack then aux (NoApplicableEx,Exninfo.null) poss
+    else tclONCE (aux (NoApplicableEx,Exninfo.null) poss)
 
   let hints_tac hints info kont : unit Proofview.tactic =
-    Proofview.Goal.nf_enter
-      { enter = fun gl -> hints_tac_gl hints info kont gl }
+    Proofview.Goal.enter
+      (fun gl -> hints_tac_gl hints info kont gl)
 
   let intro_tac info kont gl =
     let open Proofview in
-    let open Proofview.Notations in
     let env = Goal.env gl in
     let sigma = Goal.sigma gl in
-    let s = Sigma.to_evar_map sigma in
     let decl = Tacmach.New.pf_last_hyp gl in
     let hint =
-      make_resolve_hyp env s (Hint_db.transparent_state info.search_hints)
+      make_resolve_hyp env sigma (Hint_db.transparent_state info.search_hints)
                        (true,false,false) info.search_only_classes empty_hint_info decl in
-    let ldb = Hint_db.add_list env s hint info.search_hints in
+    let ldb = Hint_db.add_list env sigma hint info.search_hints in
     let info' =
       { info with search_hints = ldb; last_tac = lazy (str"intro");
         search_depth = 1 :: 1 :: info.search_depth }
@@ -1217,7 +850,7 @@ module Search = struct
 
   let intro info kont =
     Proofview.tclBIND Tactics.intro
-     (fun _ -> Proofview.Goal.nf_enter { enter = fun gl -> intro_tac info kont gl })
+     (fun _ -> Proofview.Goal.enter (fun gl -> intro_tac info kont gl))
 
   let rec search_tac hints limit depth =
     let kont info =
@@ -1239,7 +872,6 @@ module Search = struct
   let search_tac_gl ?st only_classes dep hints depth i sigma gls gl :
         unit Proofview.tactic =
     let open Proofview in
-    let open Proofview.Notations in
     if false (* In 8.6, still allow non-class goals only_classes && not (is_class_type sigma (Goal.concl gl)) *) then
       Tacticals.New.tclZEROMSG (str"Not a subgoal for a class")
     else
@@ -1250,11 +882,12 @@ module Search = struct
   let search_tac ?(st=full_transparent_state) only_classes dep hints depth =
     let open Proofview in
     let tac sigma gls i =
-      Goal.nf_enter
-        { enter = fun gl ->
-          search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl }
+      Goal.enter
+        begin fun gl ->
+          search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl end
     in
       Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+      let gls = CList.map Proofview.drop_state gls in
       Proofview.tclEVARMAP >>= fun sigma ->
       let j = List.length gls in
       (tclDISPATCH (List.init j (fun i -> tac sigma gls i)))
@@ -1299,7 +932,7 @@ module Search = struct
       match e with
       | ReachedLimitEx ->
          Tacticals.New.tclFAIL 0 (str"Proof search reached its limit")
-      | NotApplicableEx ->
+      | NoApplicableEx ->
          Tacticals.New.tclFAIL 0 (str"Proof search failed" ++
                                     (if Option.is_empty depth then mt()
                                      else str" without reaching its limit"))
@@ -1324,7 +957,7 @@ module Search = struct
                                             | Some i -> str ", with depth limit " ++ int i));
     tac
 
-  let run_on_evars p evm tac =
+  let run_on_evars env evm p tac =
     match evars_to_goals p evm with
     | None -> None (* This happens only because there's no evar having p *)
     | Some (goals, evm') ->
@@ -1333,14 +966,15 @@ module Search = struct
            top_sort evm' goals
          else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
        in
-       let fgoals = Evd.future_goals evm in
-       let pgoal = Evd.principal_future_goal evm in
+       let fgoals = Evd.save_future_goals evm in
        let _, pv = Proofview.init evm' [] in
        let pv = Proofview.unshelve goals pv in
        try
          let (), pv', (unsafe, shelved, gaveup), _ =
-           Proofview.apply (Global.env ()) tac pv
+           Proofview.apply env tac pv
          in
+         if not (List.is_empty gaveup) then
+           CErrors.anomaly (Pp.str "run_on_evars not assumed to apply tactics generating given up goals.");
          if Proofview.finished pv' then
            let evm' = Proofview.return pv' in
            assert(Evd.fold_undefined (fun ev _ acc ->
@@ -1350,28 +984,29 @@ module Search = struct
                           (str "leaking evar " ++ int (Evar.repr ev) ++
                              spc () ++ pr_ev evm' ev);
                       acc && okev) evm' true);
-           let evm' = Evd.restore_future_goals evm' (shelved @ fgoals) pgoal in
+           let fgoals = Evd.shelve_on_future_goals shelved fgoals in
+           let evm' = Evd.restore_future_goals evm' fgoals in
            let evm' = evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm in
            Some evm'
          else raise Not_found
        with Logic_monad.TacticFailure _ -> raise Not_found
 
-  let evars_eauto depth only_classes unique dep st hints p evd =
+  let evars_eauto env evd depth only_classes unique dep st hints p =
     let eauto_tac = eauto_tac ~st ~unique ~only_classes ~depth ~dep:(unique || dep) hints in
-    let res = run_on_evars p evd eauto_tac in
+    let res = run_on_evars env evd p eauto_tac in
     match res with
     | None -> evd
     | Some evd' -> evd'
 
-  let typeclasses_eauto ?depth unique st hints p evd =
-    evars_eauto depth true unique false st hints p evd
+  let typeclasses_eauto env evd ?depth unique st hints p =
+    evars_eauto env evd depth true unique false st hints p
   (** Typeclasses eauto is an eauto which tries to resolve only
       goals of typeclass type, and assumes that the initially selected
       evars in evd are independent of the rest of the evars *)
 
-  let typeclasses_resolve debug depth unique p evd =
+  let typeclasses_resolve env evd debug depth unique p =
     let db = searchtable_map typeclasses_db in
-    typeclasses_eauto ?depth unique (Hint_db.transparent_state db) [db] p evd
+    typeclasses_eauto env evd ?depth unique (Hint_db.transparent_state db) [db] p
 end
 
 (** Binding to either V85 or Search implementations. *)
@@ -1385,13 +1020,7 @@ let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state)
   in
   let st = match dbs with x :: _ -> Hint_db.transparent_state x | _ -> st in
   let depth = match depth with None -> get_typeclasses_depth () | Some l -> Some l in
-  if get_typeclasses_legacy_resolution () then
-    Proofview.V82.tactic
-    (fun gl ->
-      try V85.eauto85 depth ~only_classes ~st ?strategy dbs gl
-      with Not_found ->
-	Refiner.tclFAIL 0 (str"Proof search failed") gl)
-  else Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs
+  Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs
 
 (** We compute dependencies via a union-find algorithm.
     Beware of the imperative effects on the partition structure,
@@ -1401,23 +1030,25 @@ module Intpart = Unionfind.Make(Evar.Set)(Evar.Map)
 
 let deps_of_constraints cstrs evm p =
   List.iter (fun (_, _, x, y) ->
-    let evx = Evarutil.undefined_evars_of_term evm x in
-    let evy = Evarutil.undefined_evars_of_term evm y in
+    let evx = Evarutil.undefined_evars_of_term evm (EConstr.of_constr x) in
+    let evy = Evarutil.undefined_evars_of_term evm (EConstr.of_constr y) in
     Intpart.union_set (Evar.Set.union evx evy) p)
     cstrs
 
-let evar_dependencies evm p =
+let evar_dependencies pred evm p =
   Evd.fold_undefined
     (fun ev evi _ ->
-      let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi)
-      in Intpart.union_set evars p)
+      if Typeclasses.is_resolvable evi && pred evm ev evi then
+        let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi)
+        in Intpart.union_set evars p
+      else ())
     evm ()
 
 (** [split_evars] returns groups of undefined evars according to dependencies *)
 
-let split_evars evm =
+let split_evars pred evm =
   let p = Intpart.create () in
-  evar_dependencies evm p;
+  evar_dependencies pred evm p;
   deps_of_constraints (snd (extract_all_conv_pbs evm)) evm p;
   Intpart.partition p
 
@@ -1440,13 +1071,12 @@ let is_mandatory p comp evd =
 (** In case of unsatisfiable constraints, build a nice error message *)
 
 let error_unresolvable env comp evd =
-  let evd = Evarutil.nf_evar_map_undefined evd in
   let is_part ev = match comp with
   | None -> true
   | Some s -> Evar.Set.mem ev s
   in
   let fold ev evi (found, accu) =
-    let ev_class = class_of_constr evi.evar_concl in
+    let ev_class = class_of_constr evd (EConstr.of_constr evi.evar_concl) in
     if not (Option.is_empty ev_class) && is_part ev then
       (* focus on one instance if only one was searched for *)
       if not found then (true, Some ev)
@@ -1454,8 +1084,7 @@ let error_unresolvable env comp evd =
     else (found, accu)
    in
   let (_, ev) = Evd.fold_undefined fold evd (true, None) in
-    Pretype_errors.unsatisfiable_constraints
-      (Evarutil.nf_env_evar evd env) evd ev comp
+  Pretype_errors.unsatisfiable_constraints env evd ev comp
 
 (** Check if an evar is concerned by the current resolution attempt,
     (and in particular is in the current component), and also update
@@ -1502,7 +1131,7 @@ exception Unresolved
 (** If [do_split] is [true], we try to separate the problem in
     several components and then solve them separately *)
 let resolve_all_evars debug depth unique env p oevd do_split fail =
-  let split = if do_split then split_evars oevd else [Evar.Set.empty] in
+  let split = if do_split then split_evars p oevd else [Evar.Set.empty] in
   let in_comp comp ev = if do_split then Evar.Set.mem ev comp else true
   in
   let rec docomp evd = function
@@ -1510,12 +1139,7 @@ let resolve_all_evars debug depth unique env p oevd do_split fail =
     | comp :: comps ->
       let p = select_and_update_evars p oevd (in_comp comp) in
       try
-        let evd' =
-          if get_typeclasses_legacy_resolution () then
-            V85.resolve_all_evars_once debug depth unique p evd
-          else
-            Search.typeclasses_resolve debug depth unique p evd
-        in
+        let evd' = Search.typeclasses_resolve env evd debug depth unique p in
          if has_undefined p oevd evd' then raise Unresolved;
          docomp evd' comps
       with Unresolved | Not_found ->
@@ -1551,26 +1175,22 @@ let _ =
   Hook.set Typeclasses.solve_all_instances_hook solve_inst
 
 let resolve_one_typeclass env ?(sigma=Evd.empty) gl unique =
-  let nc, gl, subst, _, _ = Evarutil.push_rel_context_to_named_context env gl in
+  let nc, gl, subst, _ = Evarutil.push_rel_context_to_named_context env sigma gl in
   let (gl,t,sigma) =
     Goal.V82.mk_goal sigma nc gl Store.empty in
+  let (ev, _) = destEvar sigma t in
   let gls = { it = gl ; sigma = sigma; } in
   let hints = searchtable_map typeclasses_db in
   let st = Hint_db.transparent_state hints in
   let depth = get_typeclasses_depth () in
   let gls' =
-    if get_typeclasses_legacy_resolution () then
-      V85.eauto85 depth ~st [hints] gls
-    else
       try
         Proofview.V82.of_tactic
         (Search.eauto_tac ~st ~only_classes:true ~depth [hints] ~dep:true) gls
       with Refiner.FailError _ -> raise Not_found
   in
   let evd = sig_sig gls' in
-  let t' = let (ev, inst) = destEvar t in
-    mkEvar (ev, Array.of_list subst)
-  in
+  let t' = mkEvar (ev, Array.of_list subst) in
   let term = Evarutil.nf_evar evd t' in
     evd, term
 
@@ -1581,33 +1201,43 @@ let _ =
 (** Take the head of the arity of a constr.
     Used in the partial application tactic. *)
 
-let rec head_of_constr t =
-  let t = strip_outer_cast(collapse_appl t) in
-    match kind_of_term t with
-    | Prod (_,_,c2)  -> head_of_constr c2
-    | LetIn (_,_,_,c2) -> head_of_constr c2
-    | App (f,args)  -> head_of_constr f
+let rec head_of_constr sigma t =
+  let t = strip_outer_cast sigma (collapse_appl sigma t) in
+    match EConstr.kind sigma t with
+    | Prod (_,_,c2)  -> head_of_constr sigma c2
+    | LetIn (_,_,_,c2) -> head_of_constr sigma c2
+    | App (f,args)  -> head_of_constr sigma f
     | _      -> t
 
 let head_of_constr h c =
-  let c = head_of_constr c in
+  Proofview.tclEVARMAP >>= fun sigma ->
+  let c = head_of_constr sigma c in
   letin_tac None (Name h) c None Locusops.allHyps
 
 let not_evar c =
   Proofview.tclEVARMAP >>= fun sigma ->
-  match Evarutil.kind_of_term_upto sigma c with
+  match EConstr.kind sigma c with
   | Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
   | _ -> Proofview.tclUNIT ()
 
-let is_ground c gl =
-  if Evarutil.is_ground_term (project gl) c then tclIDTAC gl
-  else tclFAIL 0 (str"Not ground") gl
+let is_ground c =
+  let open Tacticals.New in
+  Proofview.tclEVARMAP >>= fun sigma ->
+  if Evarutil.is_ground_term sigma c then tclIDTAC
+  else tclFAIL 0 (str"Not ground")
 
-let autoapply c i gl =
+let autoapply c i =
+  let open Proofview.Notations in
+  Proofview.Goal.enter begin fun gl ->
+  let hintdb = try Hints.searchtable_map i with Not_found ->
+    CErrors.user_err (Pp.str ("Unknown hint database " ^ i ^ "."))
+  in
   let flags = auto_unif_flags Evar.Set.empty
-    (Hints.Hint_db.transparent_state (Hints.searchtable_map i)) in
-  let cty = pf_unsafe_type_of gl c in
+    (Hints.Hint_db.transparent_state hintdb) in
+  let cty = Tacmach.New.pf_unsafe_type_of gl c in
   let ce = mk_clenv_from gl (c,cty) in
-  let tac = { enter = fun gl -> (unify_e_resolve false flags).enter gl
-    ((c,cty,Univ.ContextSet.empty),0,ce) } in
-  Proofview.V82.of_tactic (Proofview.Goal.nf_enter tac) gl
+    unify_e_resolve false flags gl
+                                 ((c,cty,Univ.ContextSet.empty),0,ce) <*>
+      Proofview.tclEVARMAP >>= (fun sigma ->
+      let sigma = Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals sigma in
+      Proofview.Unsafe.tclEVARS sigma) end
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
index 76760db0..9ba69a05 100644
--- a/tactics/class_tactics.mli
+++ b/tactics/class_tactics.mli
@@ -1,16 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This files implements typeclasses eauto *)
 
 open Names
-open Constr
-open Tacmach
+open EConstr
 
 val catchable : exn -> bool
 
@@ -28,13 +29,13 @@ val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy
                         depth:(Int.t option) ->
                         Hints.hint_db_name list -> unit Proofview.tactic
 
-val head_of_constr : Id.t -> Term.constr -> unit Proofview.tactic
+val head_of_constr : Id.t -> constr -> unit Proofview.tactic
 
 val not_evar : constr -> unit Proofview.tactic
 
-val is_ground : constr -> tactic
+val is_ground : constr -> unit Proofview.tactic
 
-val autoapply : constr -> Hints.hint_db_name -> tactic
+val autoapply : constr -> Hints.hint_db_name -> unit Proofview.tactic
 
 module Search : sig
   val eauto_tac :
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 445a104d..c285f21e 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -1,82 +1,82 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Term
+open EConstr
 open Hipattern
 open Tactics
 open Coqlib
 open Reductionops
 open Misctypes
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Absurd *)
 
-let mk_absurd_proof t =
+let mk_absurd_proof coq_not t =
   let id = Namegen.default_dependent_ident in
-  mkLambda (Names.Name id,mkApp(build_coq_not (),[|t|]),
+  mkLambda (Names.Name id,mkApp(coq_not,[|t|]),
     mkLambda (Names.Name id,t,mkApp (mkRel 2,[|mkRel 1|])))
 
 let absurd c =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let sigma = Sigma.to_evar_map sigma in
     let j = Retyping.get_judgment_of env sigma c in
-    let sigma, j = Coercion.inh_coerce_to_sort Loc.ghost env sigma j in
+    let sigma, j = Coercion.inh_coerce_to_sort env sigma j in
     let t = j.Environ.utj_val in
-    let tac =
+    Proofview.Unsafe.tclEVARS sigma <*>
+    Tacticals.New.pf_constr_of_global (build_coq_not ()) >>= fun coqnot ->
+    Tacticals.New.pf_constr_of_global (build_coq_False ()) >>= fun coqfalse ->
     Tacticals.New.tclTHENLIST [
-      elim_type (build_coq_False ());
-      Simple.apply (mk_absurd_proof t)
-    ] in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+      elim_type coqfalse;
+      Simple.apply (mk_absurd_proof coqnot t)
+    ]
+  end
 
 let absurd c = absurd c
 
 (* Contradiction *)
 
-let use_negated_unit_or_eq_type () = Flags.version_strictly_greater Flags.V8_5
-
 (** [f] does not assume its argument to be [nf_evar]-ed. *)
 let filter_hyp f tac =
   let rec seek = function
     | [] -> Proofview.tclZERO Not_found
-    | d::rest when f (get_type d) -> tac (get_id d)
+    | d::rest when f (NamedDecl.get_type d) -> tac (NamedDecl.get_id d)
     | _::rest -> seek rest in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+    let hyps = Proofview.Goal.hyps gl in
     seek hyps
-  end }
+  end
 
 let contradiction_context =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     let rec seek_neg l = match l with
       | [] ->  Tacticals.New.tclZEROMSG (Pp.str"No such contradiction")
       | d :: rest ->
-          let id = get_id d in
-          let typ = nf_evar sigma (get_type d) in
+          let id = NamedDecl.get_id d in
+          let typ = nf_evar sigma (NamedDecl.get_type d) in
 	  let typ = whd_all env sigma typ in
-	  if is_empty_type typ then
+	  if is_empty_type sigma typ then
 	    simplest_elim (mkVar id)
-	  else match kind_of_term typ with
-	  | Prod (na,t,u) when is_empty_type u ->
-             let is_unit_or_eq =
-               if use_negated_unit_or_eq_type () then match_with_unit_or_eq_type t
-               else None in
+	  else match EConstr.kind sigma typ with
+	  | Prod (na,t,u) when is_empty_type sigma u ->
+             let is_unit_or_eq = match_with_unit_or_eq_type sigma t in
 	     Tacticals.New.tclORELSE
                (match is_unit_or_eq with
                | Some _ ->
-                   let hd,args = decompose_app t in
-                   let (ind,_ as indu) = destInd hd in
+                   let hd,args = decompose_app sigma t in
+                   let (ind,_ as indu) = destInd sigma hd in
                    let nparams = Inductiveops.inductive_nparams_env env ind in
                    let params = Util.List.firstn nparams args in
                    let p = applist ((mkConstructUi (indu,1)), params) in
@@ -85,36 +85,35 @@ let contradiction_context =
                | None ->
                  Tacticals.New.tclZEROMSG (Pp.str"Not a negated unit type."))
 	      (Proofview.tclORELSE
-                 (Proofview.Goal.enter { enter = begin fun gl ->
+                 (Proofview.Goal.enter begin fun gl ->
                    let is_conv_leq = Tacmach.New.pf_apply is_conv_leq gl in
 	           filter_hyp (fun typ -> is_conv_leq typ t)
 		     (fun id' -> simplest_elim (mkApp (mkVar id,[|mkVar id'|])))
-                 end })
+                 end)
                  begin function (e, info) -> match e with
 	           | Not_found -> seek_neg rest
                    | e -> Proofview.tclZERO ~info e
                  end)
 	  | _ -> seek_neg rest
     in
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+    let hyps = Proofview.Goal.hyps gl in
     seek_neg hyps
-  end }
+  end
 
 let is_negation_of env sigma typ t =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Prod (na,t,u) ->
-      let u = nf_evar sigma u in
-      is_empty_type u && is_conv_leq env sigma typ t
+      is_empty_type sigma u && is_conv_leq env sigma typ t
     | _ -> false
 
 let contradiction_term (c,lbind as cl) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
     let typ = type_of c in
     let _, ccl = splay_prod env sigma typ in
-    if is_empty_type ccl then
+    if is_empty_type sigma ccl then
       Tacticals.New.tclTHEN
         (elim false None cl None)
         (Tacticals.New.tclTRY assumption)
@@ -122,7 +121,7 @@ let contradiction_term (c,lbind as cl) =
       Proofview.tclORELSE
         begin
           if lbind = NoBindings then
-            filter_hyp (is_negation_of env sigma typ)
+            filter_hyp (fun c -> is_negation_of env sigma typ c)
               (fun id -> simplest_elim (mkApp (mkVar id,[|c|])))
           else
             Proofview.tclZERO Not_found
@@ -131,7 +130,7 @@ let contradiction_term (c,lbind as cl) =
           | Not_found -> Tacticals.New.tclZEROMSG (Pp.str"Not a contradiction.")
           | e -> Proofview.tclZERO ~info e
         end
-  end }
+  end
 
 let contradiction = function
   | None -> Tacticals.New.tclTHEN intros contradiction_context
diff --git a/tactics/contradiction.mli b/tactics/contradiction.mli
index b876aee9..2b3a9475 100644
--- a/tactics/contradiction.mli
+++ b/tactics/contradiction.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Misctypes
 
 val absurd                      : constr -> unit Proofview.tactic
diff --git a/tactics/dnet.ml b/tactics/dnet.ml
index c501e306..17ff94ec 100644
--- a/tactics/dnet.ml
+++ b/tactics/dnet.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (* Generic dnet implementation over non-recursive types *)
diff --git a/tactics/dnet.mli b/tactics/dnet.mli
index 9f29c60b..647bbd6b 100644
--- a/tactics/dnet.mli
+++ b/tactics/dnet.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** Generic discrimination net implementation over recursive
@@ -26,7 +28,7 @@
    distincts, or you'll get unexpected behaviours.
 
    Warning 2: This structure is perfect, i.e. the set of candidates
-   returned is equal to the set of solutions. Beware of DeBruijn
+   returned is equal to the set of solutions. Beware of de Bruijn
    shifts and sorts subtyping though (which makes the comparison not
    symmetric, see term_dnet.ml).
 
diff --git a/tactics/doc.tex b/tactics/doc.tex
deleted file mode 100644
index d44cc14a..00000000
--- a/tactics/doc.tex
+++ /dev/null
@@ -1,11 +0,0 @@
-
-\newpage
-\section*{The Tactics}
-
-\ocwsection \label{tactics}
-This chapter describes the \Coq\ main tactics.
-The modules of that chapter are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=tactics.dep.ps,width=\linewidth}\end{center}
-
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 23ff5822..dc310c54 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -1,26 +1,29 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Term
 open Termops
+open EConstr
 open Proof_type
 open Tacticals
 open Tacmach
+open Evd
 open Tactics
 open Clenv
 open Auto
 open Genredexpr
-open Tacexpr
+open Tactypes
 open Locus
 open Locusops
 open Hints
@@ -29,26 +32,27 @@ open Proofview.Notations
 let eauto_unif_flags = auto_flags_of_state full_transparent_state
 
 let e_give_exact ?(flags=eauto_unif_flags) c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let t1 = Tacmach.New.pf_unsafe_type_of gl c in
-  let t2 = Tacmach.New.pf_concl (Proofview.Goal.assume gl) in
-  if occur_existential t1 || occur_existential t2 then
+  let t2 = Tacmach.New.pf_concl gl in
+  let sigma = Tacmach.New.project gl in
+  if occur_existential sigma t1 || occur_existential sigma t2 then
      Tacticals.New.tclTHEN (Clenvtac.unify ~flags t1) (exact_no_check c)
   else exact_check c
-  end }
+  end
 
 let assumption id = e_give_exact (mkVar id)
 
 let e_assumption =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     Tacticals.New.tclFIRST (List.map assumption (Tacmach.New.pf_ids_of_hyps gl))
-  end }
+  end
 
 let registered_e_assumption =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Tacticals.New.tclFIRST (List.map (fun id -> e_give_exact (mkVar id))
               (Tacmach.New.pf_ids_of_hyps gl))
-  end }
+  end
 
 (************************************************************************)
 (*   PROLOG tactic                                                      *)
@@ -60,7 +64,7 @@ let registered_e_assumption =
 
 let first_goal gls =
   let gl = gls.Evd.it and sig_0 = gls.Evd.sigma in
-  if List.is_empty gl then error "first_goal";
+  if List.is_empty gl then user_err Pp.(str "first_goal");
   { Evd.it = List.hd gl; Evd.sigma = sig_0; }
 
 (* tactic -> tactic_list : Apply a tactic to the first goal in the list *)
@@ -71,7 +75,7 @@ let apply_tac_list tac glls =
   | (g1::rest) ->
       let gl = apply_sig_tac sigr tac g1 in
       repackage sigr (gl@rest)
-  | _ -> error "apply_tac_list"
+  | _ -> user_err Pp.(str "apply_tac_list")
 
 let one_step l gl =
   [Proofview.V82.of_tactic Tactics.intro]
@@ -80,25 +84,25 @@ let one_step l gl =
   @ (List.map (fun c -> Proofview.V82.of_tactic (assumption c)) (pf_ids_of_hyps gl))
 
 let rec prolog l n gl =
-  if n <= 0 then error "prolog - failure";
+  if n <= 0 then user_err Pp.(str "prolog - failure");
   let prol = (prolog l (n-1)) in
   (tclFIRST (List.map (fun t -> (tclTHEN t prol)) (one_step l gl))) gl
 
-let out_term = function
+let out_term env = function
   | IsConstr (c, _) -> c
-  | IsGlobRef gr -> fst (Universes.fresh_global_instance (Global.env ()) gr)
+  | IsGlobRef gr -> EConstr.of_constr (fst (Universes.fresh_global_instance env gr))
 
 let prolog_tac l n =
   Proofview.V82.tactic begin fun gl ->
   let map c =
-    let (c, sigma) = Tactics.run_delayed (pf_env gl) (project gl) c in
+    let (sigma, c) = c (pf_env gl) (project gl) in
     let c = pf_apply (prepare_hint false (false,true)) gl (sigma, c) in
-    out_term c
+    out_term (pf_env gl) c
   in
   let l = List.map map l in
   try (prolog l n gl)
-  with UserError ("Refiner.tclFIRST",_) ->
-    errorlabstrm "Prolog.prolog" (str "Prolog failed.")
+  with UserError (Some "Refiner.tclFIRST",_) ->
+    user_err ~hdr:"Prolog.prolog" (str "Prolog failed.")
   end
 
 open Auto
@@ -110,50 +114,49 @@ open Auto
 let priority l = List.map snd (List.filter (fun (pr,_) -> Int.equal pr 0) l)
 
 let unify_e_resolve poly flags (c,clenv) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
       let clenv', c = connect_hint_clenv poly c clenv gl in
-      Proofview.V82.tactic
-	(fun gls ->
-	 let clenv' = clenv_unique_resolver ~flags clenv' gls in
-	 tclTHEN (Refiner.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
-		 (Proofview.V82.of_tactic (Tactics.Simple.eapply c)) gls)
-    end }
-
-let hintmap_of secvars hdc concl =
+      let clenv' = clenv_unique_resolver ~flags clenv' gl in
+      Proofview.tclTHEN
+        (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
+        (Tactics.Simple.eapply c)
+    end
+
+let hintmap_of sigma secvars hdc concl =
   match hdc with
   | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
-     if occur_existential concl then
-       (fun db -> Hint_db.map_existential ~secvars hdc concl db)
-     else (fun db -> Hint_db.map_auto ~secvars hdc concl db)
+     if occur_existential sigma concl then
+       (fun db -> Hint_db.map_existential sigma ~secvars hdc concl db)
+     else (fun db -> Hint_db.map_auto sigma ~secvars hdc concl db)
    (* FIXME: should be (Hint_db.map_eauto hdc concl db) *)
 
 let e_exact poly flags (c,clenv) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let clenv', c = connect_hint_clenv poly c clenv gl in
     Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
     (e_give_exact c)
-  end }
+  end
 
 let rec e_trivial_fail_db db_list local_db =
-  let next = Proofview.Goal.nf_enter { enter = begin fun gl ->
+  let next = Proofview.Goal.enter begin fun gl ->
     let d = Tacmach.New.pf_last_hyp gl in
     let hintl = make_resolve_hyp (Tacmach.New.pf_env gl) (Tacmach.New.project gl) d in
     e_trivial_fail_db db_list (Hint_db.add_list (Tacmach.New.pf_env gl) (Tacmach.New.project gl) hintl local_db)
-  end } in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  end in
+  Proofview.Goal.enter begin fun gl ->
   let secvars = compute_secvars gl in
   let tacl =
     registered_e_assumption ::
     (Tacticals.New.tclTHEN Tactics.intro next) ::
-    (List.map fst (e_trivial_resolve db_list local_db secvars (Tacmach.New.pf_nf_concl gl)))
+    (List.map fst (e_trivial_resolve (Tacmach.New.pf_env gl) (Tacmach.New.project gl) db_list local_db secvars (Tacmach.New.pf_concl gl)))
   in
   Tacticals.New.tclFIRST (List.map Tacticals.New.tclCOMPLETE tacl)
-  end }
+  end
 
-and e_my_find_search db_list local_db secvars hdc concl =
-  let hint_of_db = hintmap_of secvars hdc concl in
+and e_my_find_search env sigma db_list local_db secvars hdc concl =
+  let hint_of_db = hintmap_of sigma secvars hdc concl in
   let hintl =
       List.map_append (fun db ->
 	let flags = auto_flags_of_state (Hint_db.transparent_state db) in
@@ -177,19 +180,19 @@ and e_my_find_search db_list local_db secvars hdc concl =
         | Extern tacast -> conclPattern concl p tacast
        in
        let tac = run_hint t tac in
-       (tac, lazy (pr_hint t)))
+       (tac, lazy (pr_hint env sigma t)))
   in
   List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db secvars gl =
-  let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try priority (e_my_find_search db_list local_db secvars hd gl)
+and e_trivial_resolve env sigma db_list local_db secvars gl =
+  let hd = try Some (decompose_app_bound sigma gl) with Bound -> None in
+  try priority (e_my_find_search env sigma db_list local_db secvars hd gl)
   with Not_found -> []
 
-let e_possible_resolve db_list local_db secvars gl =
-  let hd = try Some (decompose_app_bound gl) with Bound -> None in
+let e_possible_resolve env sigma db_list local_db secvars gl =
+  let hd = try Some (decompose_app_bound sigma gl) with Bound -> None in
   try List.map (fun (b, (tac, pp)) -> (tac, b, pp))
-               (e_my_find_search db_list local_db secvars hd gl)
+               (e_my_find_search env sigma db_list local_db secvars hd gl)
   with Not_found -> []
 
 let find_first_goal gls =
@@ -202,11 +205,11 @@ type search_state = {
   priority : int;
   depth : int; (*r depth of search before failing *)
   tacres : goal list sigma;
-  last_tactic : std_ppcmds Lazy.t;
+  last_tactic : Pp.t Lazy.t;
   dblist : hint_db list;
   localdb :  hint_db list;
   prev : prev_search_state;
-  local_lemmas : Tacexpr.delayed_open_constr list;
+  local_lemmas : delayed_open_constr list;
 }
 
 and prev_search_state = (* for info eauto *)
@@ -260,7 +263,7 @@ module SearchProblem = struct
       let g = find_first_goal lg in
       let hyps = pf_ids_of_hyps g in
       let secvars = secvars_of_hyps (pf_hyps g) in
-      let map_assum id = (e_give_exact (mkVar id), (-1), lazy (str "exact" ++ spc () ++ pr_id id)) in
+      let map_assum id = (e_give_exact (mkVar id), (-1), lazy (str "exact" ++ spc () ++ Id.print id)) in
       let assumption_tacs =
         let tacs = List.map map_assum hyps in
         let l = filter_tactics s.tacres tacs in
@@ -287,9 +290,9 @@ module SearchProblem = struct
       in
       let rec_tacs =
 	let l =
-          let concl = Reductionops.nf_evar (project g)(pf_concl g) in
+          let concl = Reductionops.nf_evar (project g) (pf_concl g) in
 	  filter_tactics s.tacres
-                         (e_possible_resolve s.dblist (List.hd s.localdb) secvars concl)
+                         (e_possible_resolve (pf_env g) (project g) s.dblist (List.hd s.localdb) secvars concl)
 	in
 	List.map
 	  (fun (lgls, cost, pp) ->
@@ -330,8 +333,7 @@ let global_info_eauto = ref false
 
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "Debug Eauto";
       Goptions.optkey   = ["Debug";"Eauto"];
       Goptions.optread  = (fun () -> !global_debug_eauto);
@@ -339,8 +341,7 @@ let _ =
 
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "Info Eauto";
       Goptions.optkey   = ["Info";"Eauto"];
       Goptions.optread  = (fun () -> !global_info_eauto);
@@ -403,10 +404,10 @@ let e_search_auto debug (in_depth,p) lems db_list gl =
     s.tacres
   with Not_found ->
     pr_info_nop d;
-    error "eauto: search failed"
+    user_err Pp.(str "eauto: search failed")
 
-(* let e_search_auto_key = Profile.declare_profile "e_search_auto" *)
-(* let e_search_auto = Profile.profile5 e_search_auto_key e_search_auto *)
+(* let e_search_auto_key = CProfile.declare_profile "e_search_auto" *)
+(* let e_search_auto = CProfile.profile5 e_search_auto_key e_search_auto *)
 
 let eauto_with_bases ?(debug=Off) np lems db_list =
   tclTRY (e_search_auto debug np lems db_list)
@@ -436,11 +437,11 @@ let cons a l = a :: l
 let autounfolds db occs cls gl =
   let unfolds = List.concat (List.map (fun dbname -> 
     let db = try searchtable_map dbname 
-      with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+      with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
     in
     let (ids, csts) = Hint_db.unfolds db in
     let hyps = pf_ids_of_hyps gl in
-    let ids = Idset.filter (fun id -> List.mem id hyps) ids in
+    let ids = Id.Set.filter (fun id -> List.mem id hyps) ids in
       Cset.fold (fun cst -> cons (AllOccurrences, EvalConstRef cst)) csts
 	(Id.Set.fold (fun id -> cons (AllOccurrences, EvalVarRef id)) ids [])) db)
   in Proofview.V82.of_tactic (unfold_option unfolds cls) gl
@@ -464,18 +465,19 @@ let autounfold_tac db cls =
   in
   autounfold dbs cls
 
-let unfold_head env (ids, csts) c = 
+let unfold_head env sigma (ids, csts) c =
   let rec aux c = 
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Var id when Id.Set.mem id ids ->
 	(match Environ.named_body id env with
-	| Some b -> true, b
+	| Some b -> true, EConstr.of_constr b
 	| None -> false, c)
-    | Const (cst,u as c) when Cset.mem cst csts ->
-	true, Environ.constant_value_in env c
+    | Const (cst, u) when Cset.mem cst csts ->
+        let u = EInstance.kind sigma u in
+	true, EConstr.of_constr (Environ.constant_value_in env (cst, u))
     | App (f, args) ->
 	(match aux f with
-	| true, f' -> true, Reductionops.whd_betaiota Evd.empty (mkApp (f', args))
+	| true, f' -> true, Reductionops.whd_betaiota sigma (mkApp (f', args))
 	| false, _ -> 
 	    let done_, args' = 
 	      Array.fold_left_i (fun i (done_, acc) arg -> 
@@ -489,7 +491,7 @@ let unfold_head env (ids, csts) c =
 	      else false, c)
     | _ -> 
 	let done_ = ref false in
-	let c' = map_constr (fun c -> 
+	let c' = EConstr.map sigma (fun c -> 
 	  if !done_ then c else 
 	    let x, c' = aux c in
 	      done_ := x; c') c
@@ -497,18 +499,19 @@ let unfold_head env (ids, csts) c =
   in aux c
 
 let autounfold_one db cl =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
+  let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
   let st =
     List.fold_left (fun (i,c) dbname -> 
       let db = try searchtable_map dbname 
-	with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+	with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
       in
       let (ids, csts) = Hint_db.unfolds db in
 	(Id.Set.union ids i, Cset.union csts c)) (Id.Set.empty, Cset.empty) db
   in
-  let did, c' = unfold_head env st 
+  let did, c' = unfold_head env sigma st 
     (match cl with Some (id, _) -> Tacmach.New.pf_get_hyp_typ id gl | None -> concl) 
   in
     if did then
@@ -516,4 +519,4 @@ let autounfold_one db cl =
       | Some hyp -> change_in_hyp None (make_change_arg c') hyp
       | None -> convert_concl_no_check c' DEFAULTcast
     else Tacticals.New.tclFAIL 0 (str "Nothing to unfold")
-  end }
+  end
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index 8812093d..e161d888 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Term
-open Proof_type
+open EConstr
 open Hints
+open Tactypes
 
 val e_assumption : unit Proofview.tactic
 
@@ -16,15 +18,15 @@ val registered_e_assumption : unit Proofview.tactic
 
 val e_give_exact : ?flags:Unification.unify_flags -> constr -> unit Proofview.tactic
 
-val prolog_tac : Tacexpr.delayed_open_constr list -> int -> unit Proofview.tactic
+val prolog_tac : delayed_open_constr list -> int -> unit Proofview.tactic
 
-val gen_eauto : ?debug:Tacexpr.debug -> bool * int -> Tacexpr.delayed_open_constr list ->
+val gen_eauto : ?debug:debug -> bool * int -> delayed_open_constr list ->
   hint_db_name list option -> unit Proofview.tactic
 
 val eauto_with_bases :
-  ?debug:Tacexpr.debug ->
+  ?debug:debug ->
   bool * int ->
-  Tacexpr.delayed_open_constr list -> hint_db list -> Proof_type.tactic
+  delayed_open_constr list -> hint_db list -> Proof_type.tactic
 
 val autounfold : hint_db_name list -> Locus.clause -> unit Proofview.tactic
 val autounfold_tac : hint_db_name list option -> Locus.clause -> unit Proofview.tactic
diff --git a/tactics/elim.ml b/tactics/elim.ml
index f2b9eec4..003b069b 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -1,22 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
 open Termops
+open EConstr
 open Inductiveops
 open Hipattern
 open Tacmach.New
 open Tacticals.New
 open Tactics
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Supposed to be called without as clause *)
 let introElimAssumsThen tac ba =
@@ -76,16 +79,17 @@ let tmphyp_name = Id.of_string "_TmpHyp"
 let up_to_delta = ref false (* true *)
 
 let general_decompose recognizer c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of = pf_unsafe_type_of gl in
+  let sigma = project gl in
   let typc = type_of c in
   tclTHENS (cut typc)
     [ tclTHEN (intro_using tmphyp_name)
          (onLastHypId
-	    (ifOnHyp recognizer (general_decompose_aux recognizer)
+	    (ifOnHyp (recognizer sigma) (general_decompose_aux (recognizer sigma))
 	      (fun id -> clear [id])));
        exact_no_check c ]
-  end }
+  end
 
 let head_in indl t gl =
   let env = Proofview.Goal.env gl in
@@ -94,24 +98,24 @@ let head_in indl t gl =
     let ity,_ =
       if !up_to_delta
       then find_mrectype env sigma t
-      else extract_mrectype t
+      else extract_mrectype sigma t
     in List.exists (fun i -> eq_ind (fst i) (fst ity)) indl
   with Not_found -> false
 
 let decompose_these c l =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let indl = List.map (fun x -> x, Univ.Instance.empty) l in
-  general_decompose (fun (_,t) -> head_in indl t gl) c
-  end }
+  general_decompose (fun sigma (_,t) -> head_in indl t gl) c
+  end
 
 let decompose_and c =
   general_decompose
-    (fun (_,t) -> is_record t)
+    (fun sigma (_,t) -> is_record sigma t)
     c
 
 let decompose_or c =
   general_decompose
-    (fun (_,t) -> is_disjunction t)
+    (fun sigma (_,t) -> is_disjunction sigma t)
     c
 
 let h_decompose l c = decompose_these c l
@@ -130,16 +134,16 @@ let induction_trailer abs_i abs_j bargs =
     (tclDO (abs_j - abs_i) intro)
     (onLastHypId
        (fun id ->
-          Proofview.Goal.nf_enter { enter = begin fun gl ->
+          Proofview.Goal.enter begin fun gl ->
 	  let idty = pf_unsafe_type_of gl (mkVar id) in
-	  let fvty = global_vars (pf_env gl) idty in
+	  let fvty = global_vars (pf_env gl) (project gl) idty in
 	  let possible_bring_hyps =
 	    (List.tl (nLastDecls gl (abs_j - abs_i))) @ bargs.Tacticals.assums
           in
 	  let (hyps,_) =
             List.fold_left
 	      (fun (bring_ids,leave_ids) d ->
-                 let cid = get_id d in
+                 let cid = NamedDecl.get_id d in
                  if not (List.mem cid leave_ids)
                  then (d::bring_ids,leave_ids)
                  else (bring_ids,cid::leave_ids))
@@ -148,11 +152,11 @@ let induction_trailer abs_i abs_j bargs =
           let ids = List.rev (ids_of_named_context hyps) in
 	  (tclTHENLIST
             [revert ids; simple_elimination (mkVar id)])
-          end }
+          end
           ))
 
 let double_ind h1 h2 =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let abs_i = depth_of_quantified_hypothesis true h1 gl in
   let abs_j = depth_of_quantified_hypothesis true h2 gl in
   let abs =
@@ -165,7 +169,7 @@ let double_ind h1 h2 =
        	(fun id ->
            elimination_then
              (introElimAssumsThen (induction_trailer abs_i abs_j)) (mkVar id))))
-  end }
+  end
 
 let h_double_induction = double_ind
 
diff --git a/tactics/elim.mli b/tactics/elim.mli
index ae9cf85f..d6b67e5b 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Tacticals
 open Misctypes
+open Tactypes
 
 (** Eliminations tactics. *)
 
-val introCaseAssumsThen : Tacexpr.evars_flag ->
-  (Tacexpr.intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
+val introCaseAssumsThen : evars_flag ->
+  (intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
     branch_args -> unit Proofview.tactic
 
 val h_decompose       : inductive list -> constr -> unit Proofview.tactic
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 93073fdc..6bd4866c 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin from contents related to inductive schemes
@@ -13,12 +15,12 @@
 
 (* This file builds schemes related to case analysis and recursion schemes *)
 
-open Term
+open Sorts
+open Constr
 open Indrec
 open Declarations
 open Typeops
 open Ind_tables
-open Sigma.Notations
 
 (* Induction/recursion schemes *)
 
@@ -47,26 +49,15 @@ let optimize_non_type_induction_scheme kind dep sort _ ind =
     let sigma, nf = Evarutil.nf_evars_and_universes sigma in
       (nf c', Evd.evar_universe_context sigma), eff
   else
-    let mib,mip = Inductive.lookup_mind_specif env ind in
-    let ctx = Declareops.inductive_context mib in
-    let u = Univ.UContext.instance ctx in
-    let ctxset = Univ.ContextSet.of_context ctx in
-    let ectx = Evd.evar_universe_context_of ctxset in
-    let sigma = Evd.merge_universe_context sigma ectx in
-    let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
+    let sigma, pind = Evd.fresh_inductive_instance env sigma ind in
+    let sigma, c = build_induction_scheme env sigma pind dep sort in
       (c, Evd.evar_universe_context sigma), Safe_typing.empty_private_constants
 
 let build_induction_scheme_in_type dep sort ind =
   let env = Global.env () in
   let sigma = Evd.from_env env in
-  let ctx = 
-    let mib,mip = Inductive.lookup_mind_specif env ind in
-      Declareops.inductive_context mib
-  in
-  let u = Univ.UContext.instance ctx in
-  let ctxset = Univ.ContextSet.of_context ctx in
-  let sigma = Evd.merge_universe_context sigma (Evd.evar_universe_context_of ctxset) in
-  let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
+  let sigma, pind = Evd.fresh_inductive_instance env sigma ind in
+  let sigma, c = build_induction_scheme env sigma pind dep sort in
     c, Evd.evar_universe_context sigma
  
 let rect_scheme_kind_from_type =
@@ -81,38 +72,38 @@ let rect_dep_scheme_kind_from_type =
   declare_individual_scheme_object "_rect" ~aux:"_rect_from_type"
     (fun _ x -> build_induction_scheme_in_type true InType x, Safe_typing.empty_private_constants)
 
-let ind_scheme_kind_from_type =
-  declare_individual_scheme_object "_ind_nodep"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InProp)
-
-let ind_scheme_kind_from_prop =
-  declare_individual_scheme_object "_ind" ~aux:"_ind_from_prop"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_prop false InProp)
-
-let ind_dep_scheme_kind_from_type =
-  declare_individual_scheme_object "_ind" ~aux:"_ind_from_type"
-  (optimize_non_type_induction_scheme rect_dep_scheme_kind_from_type true InProp)
+let rec_scheme_kind_from_type =
+  declare_individual_scheme_object "_rec_nodep" ~aux:"_rec_nodep_from_type"
+  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InSet)
 
 let rec_scheme_kind_from_prop =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_prop"
   (optimize_non_type_induction_scheme rect_scheme_kind_from_prop false InSet)
 
-let rec_scheme_kind_from_type =
-  declare_individual_scheme_object "_rec_nodep" ~aux:"_rec_nodep_from_type"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InSet)
-
 let rec_dep_scheme_kind_from_type =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_type"
   (optimize_non_type_induction_scheme rect_dep_scheme_kind_from_type true InSet)
 
+let ind_scheme_kind_from_type =
+  declare_individual_scheme_object "_ind_nodep"
+  (optimize_non_type_induction_scheme rec_scheme_kind_from_type false InProp)
+
+let ind_dep_scheme_kind_from_type =
+  declare_individual_scheme_object "_ind" ~aux:"_ind_from_type"
+  (optimize_non_type_induction_scheme rec_dep_scheme_kind_from_type true InProp)
+
+let ind_scheme_kind_from_prop =
+  declare_individual_scheme_object "_ind" ~aux:"_ind_from_prop"
+  (optimize_non_type_induction_scheme rec_scheme_kind_from_prop false InProp)
+
 (* Case analysis *)
 
 let build_case_analysis_scheme_in_type dep sort ind =
   let env = Global.env () in
-  let sigma = Sigma.Unsafe.of_evar_map (Evd.from_env env) in
-  let Sigma (indu, sigma, _) = Sigma.fresh_inductive_instance env sigma ind in
-  let Sigma (c, sigma, _) = build_case_analysis_scheme env sigma indu dep sort in
-    c, Evd.evar_universe_context (Sigma.to_evar_map sigma)
+  let sigma = Evd.from_env env in
+  let (sigma, indu) = Evd.fresh_inductive_instance env sigma ind in
+  let (sigma, c) = build_case_analysis_scheme env sigma indu dep sort in
+    c, Evd.evar_universe_context sigma
 
 let case_scheme_kind_from_type =
   declare_individual_scheme_object "_case_nodep"
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index 77f927f2..ece4124b 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -1,15 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Ind_tables
 
 (** Induction/recursion schemes *)
 
+val optimize_non_type_induction_scheme : 
+  'a Ind_tables.scheme_kind ->
+  Indrec.dep_flag ->
+  Sorts.family ->
+  'b ->
+  Names.inductive ->
+  (Constr.constr * UState.t) * Safe_typing.private_constants
+
 val rect_scheme_kind_from_prop : individual scheme_kind
 val ind_scheme_kind_from_prop : individual scheme_kind
 val rec_scheme_kind_from_prop : individual scheme_kind
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index b1d3290a..b0deeed1 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (************************************************************************)
@@ -16,6 +18,7 @@ open Util
 open Names
 open Namegen
 open Term
+open EConstr
 open Declarations
 open Tactics
 open Tacticals.New
@@ -23,7 +26,7 @@ open Auto
 open Constr_matching
 open Misctypes
 open Hipattern
-open Pretyping
+open Proofview.Notations
 open Tacmach.New
 open Coqlib
 
@@ -49,7 +52,9 @@ open Coqlib
    Eduardo Gimenez (30/3/98).
 *)
 
-let clear_last = (onLastHyp (fun c -> (clear [destVar c])))
+let clear_last =
+  Proofview.tclEVARMAP >>= fun sigma ->
+  (onLastHyp (fun c -> (clear [destVar sigma c])))
 
 let choose_eq eqonleft =
   if eqonleft then
@@ -62,18 +67,39 @@ let choose_noteq eqonleft =
   else
     left_with_bindings false Misctypes.NoBindings
 
-let mkBranches c1 c2 =
+(* A surgical generalize which selects the right occurrences by hand *)
+(* This prevents issues where c2 is also a subterm of c1 (see e.g. #5449) *)
+
+let generalize_right mk typ c1 c2 =
+  Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let store = Proofview.Goal.extra gl in
+  Refine.refine ~typecheck:false begin fun sigma ->
+    let na = Name (next_name_away_with_default "x" Anonymous (Termops.vars_of_env env)) in
+    let newconcl = mkProd (na, typ, mk typ c1 (mkRel 1)) in
+    let (sigma, x) = Evarutil.new_evar env sigma ~principal:true ~store newconcl in
+    (sigma, mkApp (x, [|c2|]))
+  end
+  end
+
+let mkBranches (eqonleft,mk,c1,c2,typ) =
   tclTHENLIST
-    [generalize [c2];
+    [generalize_right mk typ c1 c2;
      Simple.elim c1;
      intros;
      onLastHyp Simple.case;
      clear_last;
      intros]
 
+let inj_flags = Some {
+    Equality.keep_proof_equalities = true; (* necessary *)
+    Equality.injection_in_context = true; (* does not matter here *)
+    Equality.injection_pattern_l2r_order = true; (* does not matter here *)
+  }
+
 let discrHyp id =
-  let c = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.discr_tac false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let c env sigma = (sigma, (mkVar id, NoBindings)) in
+  let tac c = Equality.discr_tac false (Some (None, ElimOnConstr c)) in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let solveNoteqBranch side =
@@ -83,12 +109,9 @@ let solveNoteqBranch side =
 
 (* Constructs the type {c1=c2}+{~c1=c2} *)
 
-let make_eq () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq ())
-
-let mkDecideEqGoal eqonleft op rectype c1 c2 =
-  let equality    = mkApp(make_eq(), [|rectype; c1; c2|]) in
-  let disequality = mkApp(build_coq_not (), [|equality|]) in
+let mkDecideEqGoal eqonleft (op,eq,neg) rectype c1 c2 =
+  let equality    = mkApp(eq, [|rectype; c1; c2|]) in
+  let disequality = mkApp(neg, [|equality|]) in
   if eqonleft then mkApp(op, [|equality; disequality |])
   else mkApp(op, [|disequality; equality |])
 
@@ -98,13 +121,13 @@ let mkDecideEqGoal eqonleft op rectype c1 c2 =
 let idx = Id.of_string "x"
 let idy = Id.of_string "y"
 
-let mkGenDecideEqGoal rectype g =
-  let hypnames = pf_ids_of_hyps g in
+let mkGenDecideEqGoal rectype ops g =
+  let hypnames = pf_ids_set_of_hyps g in
   let xname    = next_ident_away idx hypnames
   and yname    = next_ident_away idy hypnames in
   (mkNamedProd xname rectype
      (mkNamedProd yname rectype
-        (mkDecideEqGoal true (build_coq_sumbool ())
+        (mkDecideEqGoal true ops
           rectype (mkVar xname) (mkVar yname))))
 
 let rec rewrite_and_clear hyps = match hyps with
@@ -120,8 +143,8 @@ let eqCase tac =
   tclTHEN intro (onLastHypId tac)
 
 let injHyp id =
-  let c = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.injClause None false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let c env sigma = (sigma, (mkVar id, NoBindings)) in
+  let tac c = Equality.injClause inj_flags None false (Some (None, ElimOnConstr c)) in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let diseqCase hyps eqonleft =
@@ -138,15 +161,32 @@ let diseqCase hyps eqonleft =
 
 open Proofview.Notations
 
-(* spiwack: a small wrapper around [Hipattern]. *)
-
-let match_eqdec c =
-  try Proofview.tclUNIT (match_eqdec c)
+(* spiwack: a PatternMatchingFailure wrapper around [Hipattern]. *)
+
+let match_eqdec env sigma c =
+  try
+    let (eqonleft,_,c1,c2,ty) = match_eqdec env sigma c in
+    let (op,eq1,noteq,eq2) =
+      match EConstr.kind sigma c with
+      | App (op,[|ty1;ty2|]) ->
+         let ty1, ty2 = if eqonleft then ty1, ty2 else ty2, ty1 in
+         (match EConstr.kind sigma ty1, EConstr.kind sigma ty2 with
+         | App (eq1,_), App (noteq,[|neq|]) ->
+            (match EConstr.kind sigma neq with
+             | App (eq2,_) -> op,eq1,noteq,eq2
+             | _ -> assert false)
+         | _ -> assert false)
+      | _ -> assert false in
+    let mk t x y =
+      let eq = mkApp (eq1,[|t;x;y|]) in
+      let neq = mkApp (noteq,[|mkApp (eq2,[|t;x;y|])|]) in
+      if eqonleft then mkApp (op,[|eq;neq|]) else mkApp (op,[|neq;eq|]) in
+    Proofview.tclUNIT (eqonleft,mk,c1,c2,ty)
   with PatternMatchingFailure -> Proofview.tclZERO PatternMatchingFailure
 
 (* /spiwack *)
 
-let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
+let rec solveArg hyps eqonleft mk largs rargs = match largs, rargs with
 | [], [] ->
   tclTHENLIST [
     choose_eq eqonleft;
@@ -154,30 +194,33 @@ let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
     intros_reflexivity;
   ]
 | a1 :: largs, a2 :: rargs ->
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let rectype = pf_unsafe_type_of gl a1 in
-  let decide = mkDecideEqGoal eqonleft op rectype a1 a2 in
-  let tac hyp = solveArg (hyp :: hyps) eqonleft op largs rargs in
+  let decide = mk rectype a1 a2 in
+  let tac hyp = solveArg (hyp :: hyps) eqonleft mk largs rargs in
   let subtacs =
     if eqonleft then [eqCase tac;diseqCase hyps eqonleft;default_auto]
     else [diseqCase hyps eqonleft;eqCase tac;default_auto] in
   (tclTHENS (elim_type decide) subtacs)
-  end }
+  end
 | _ -> invalid_arg "List.fold_right2"
 
 let solveEqBranch rectype =
   Proofview.tclORELSE
     begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,op,lhs,rhs,_) ->
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let env = Proofview.Goal.env gl in
+        let sigma = project gl in
+        match_eqdec env sigma concl >>= fun (eqonleft,mk,lhs,rhs,_) ->
           let (mib,mip) = Global.lookup_inductive rectype in
           let nparams   = mib.mind_nparams in
-          let getargs l = List.skipn nparams (snd (decompose_app l)) in
+          let getargs l = List.skipn nparams (snd (decompose_app sigma l)) in
           let rargs   = getargs rhs
           and largs   = getargs lhs in
-          solveArg [] eqonleft op largs rargs
-      end }
+
+          solveArg [] eqonleft mk largs rargs
+      end
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure -> Tacticals.New.tclZEROMSG (Pp.str"Unexpected conclusion!")
@@ -186,25 +229,27 @@ let solveEqBranch rectype =
 
 (* The tactic Decide Equality *)
 
-let hd_app c = match kind_of_term c with
+let hd_app sigma c = match EConstr.kind sigma c with
   | App (h,_) -> h
   | _ -> c
 
 let decideGralEquality =
   Proofview.tclORELSE
     begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,_,c1,c2,typ) ->
-        let headtyp = hd_app (pf_compute gl typ) in
-        begin match kind_of_term headtyp with
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let env = Proofview.Goal.env gl in
+        let sigma = project gl in
+        match_eqdec env sigma concl >>= fun (eqonleft,mk,c1,c2,typ as data) ->
+        let headtyp = hd_app sigma (pf_compute gl typ) in
+        begin match EConstr.kind sigma headtyp with
         | Ind (mi,_) -> Proofview.tclUNIT mi
         | _ -> tclZEROMSG (Pp.str"This decision procedure only works for inductive objects.")
         end >>= fun rectype ->
           (tclTHEN
-             (mkBranches c1 c2)
+             (mkBranches data)
              (tclORELSE (solveNoteqBranch eqonleft) (solveEqBranch rectype)))
-      end }
+      end
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure ->
@@ -214,21 +259,25 @@ let decideGralEquality =
 
 let decideEqualityGoal = tclTHEN intros decideGralEquality
 
-let decideEquality rectype =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let decide = mkGenDecideEqGoal rectype gl in
+let decideEquality rectype ops =
+  Proofview.Goal.enter begin fun gl ->
+  let decide = mkGenDecideEqGoal rectype ops gl in
   (tclTHENS (cut decide) [default_auto;decideEqualityGoal])
-  end }
+  end
 
 
 (* The tactic Compare *)
 
 let compare c1 c2 =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  pf_constr_of_global (build_coq_sumbool ()) >>= fun opc ->
+  pf_constr_of_global (Coqlib.build_coq_eq ()) >>= fun eqc ->
+  pf_constr_of_global (build_coq_not ()) >>= fun notc ->
+  Proofview.Goal.enter begin fun gl ->
   let rectype = pf_unsafe_type_of gl c1 in
-  let decide = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 in
+  let ops = (opc,eqc,notc) in
+  let decide = mkDecideEqGoal true ops rectype c1 c2 in
   (tclTHENS (cut decide)
             [(tclTHEN  intro
              (tclTHEN (onLastHyp simplest_case) clear_last));
-             decideEquality rectype])
-  end }
+             decideEquality rectype ops])
+  end
diff --git a/tactics/eqdecide.mli b/tactics/eqdecide.mli
index cb48a5bc..1e898d42 100644
--- a/tactics/eqdecide.mli
+++ b/tactics/eqdecide.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (************************************************************************)
@@ -14,4 +16,4 @@
 
 val decideEqualityGoal : unit Proofview.tactic
 
-val compare : Constr.t -> Constr.t -> unit Proofview.tactic
+val compare : EConstr.t -> EConstr.t -> unit Proofview.tactic
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index 1a45217a..477de645 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (* File created by Hugo Herbelin, Nov 2009 *)
@@ -48,6 +50,7 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open Vars
 open Declarations
 open Environ
@@ -57,13 +60,14 @@ open Namegen
 open Inductiveops
 open Ind_tables
 open Indrec
-open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 let hid = Id.of_string "H"
 let xid = Id.of_string "X"
 let default_id_of_sort = function InProp | InSet -> hid | InType -> xid
-let fresh env id = next_global_ident_away id []
+let fresh env id = next_global_ident_away id Id.Set.empty
 let with_context_set ctx (b, ctx') = 
   (b, Univ.ContextSet.union ctx ctx')
 
@@ -71,13 +75,27 @@ let build_dependent_inductive ind (mib,mip) =
   let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
   applist
     (mkIndU ind,
-       Context.Rel.to_extended_list mip.mind_nrealdecls mib.mind_params_ctxt
-       @ Context.Rel.to_extended_list 0 realargs)
+       Context.Rel.to_extended_list mkRel mip.mind_nrealdecls mib.mind_params_ctxt
+       @ Context.Rel.to_extended_list mkRel 0 realargs)
+
+let named_hd env t na = named_hd env Evd.empty (EConstr.of_constr t) na
+let name_assumption env = function
+| LocalAssum (na,t) -> LocalAssum (named_hd env t na, t)
+| LocalDef (na,c,t) -> LocalDef (named_hd env c na, c, t)
+
+let name_context env hyps =
+  snd
+    (List.fold_left
+       (fun (env,hyps) d ->
+	  let d' = name_assumption env d in (push_rel d' env, d' :: hyps))
+       (env,[]) (List.rev hyps))
 
 let my_it_mkLambda_or_LetIn s c = it_mkLambda_or_LetIn c s
-let my_it_mkProd_or_LetIn s c = it_mkProd_or_LetIn c s
+let my_it_mkProd_or_LetIn s c = Term.it_mkProd_or_LetIn c s
 let my_it_mkLambda_or_LetIn_name s c =
-  it_mkLambda_or_LetIn_name (Global.env()) c s
+  let env = Global.env () in
+  let mkLambda_or_LetIn_name d b = mkLambda_or_LetIn (name_assumption env d) b in
+  List.fold_left (fun c d -> mkLambda_or_LetIn_name d c) c s
 
 let get_coq_eq ctx =
   try
@@ -87,7 +105,13 @@ let get_coq_eq ctx =
       (Universes.fresh_inductive_instance (Global.env ()) eq) in
       mkIndU eq, mkConstructUi (eq,1), ctx
   with Not_found ->
-    error "eq not found."
+    user_err Pp.(str "eq not found.")
+
+let univ_of_eq env eq =
+  let eq = EConstr.of_constr eq in
+  match Constr.kind (EConstr.Unsafe.to_constr (Retyping.get_type_of env Evd.empty eq)) with
+  | Prod (_,t,_) -> (match Constr.kind t with Sort (Type u) -> u | _ -> assert false)
+  | _ -> assert false
 
 (**********************************************************************)
 (* Check if an inductive type [ind] has the form                      *)
@@ -98,6 +122,8 @@ let get_coq_eq ctx =
 (* in which case, a symmetry lemma is definable                       *)
 (**********************************************************************)
 
+let error msg = user_err Pp.(str msg)
+
 let get_sym_eq_data env (ind,u) =
   let (mib,mip as specif) = lookup_mind_specif env ind in
   if not (Int.equal (Array.length mib.mind_packets) 1) ||
@@ -118,7 +144,7 @@ let get_sym_eq_data env (ind,u) =
   let paramsctxt = Vars.subst_instance_context u mib.mind_params_ctxt in
   let paramsctxt1,_ =
     List.chop (mib.mind_nparams-mip.mind_nrealargs) paramsctxt in
-  if not (List.equal eq_constr params2 constrargs) then
+  if not (List.equal Constr.equal params2 constrargs) then
     error "Constructors arguments must repeat the parameters.";
   (* nrealargs_ctxt and nrealargs are the same here *)
   (specif,mip.mind_nrealargs,realsign,paramsctxt,paramsctxt1)
@@ -170,7 +196,7 @@ let build_sym_scheme env ind =
   let (mib,mip as specif),nrealargs,realsign,paramsctxt,paramsctxt1 =
     get_sym_eq_data env indu in
   let cstr n =
-    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect mkRel n mib.mind_params_ctxt) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let applied_ind = build_dependent_inductive indu specif in
   let realsign_ind =
@@ -183,12 +209,12 @@ let build_sym_scheme env ind =
      my_it_mkLambda_or_LetIn_name
        (lift_rel_context (nrealargs+1) realsign_ind)
        (mkApp (mkIndU indu,Array.concat
-	  [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	  [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 	   rel_vect 1 nrealargs;
 	   rel_vect (2*nrealargs+2) nrealargs])),
      mkRel 1 (* varH *),
        [|cstr (nrealargs+1)|]))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 let sym_scheme_kind =
   declare_individual_scheme_object "_sym_internal"
@@ -224,13 +250,13 @@ let build_sym_involutive_scheme env ind =
     get_sym_eq_data env indu in
   let eq,eqrefl,ctx = get_coq_eq ctx in
   let sym, ctx, eff = const_of_scheme sym_scheme_kind env ind ctx in
-  let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect n paramsctxt) in
+  let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect mkRel n paramsctxt) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_C =
     mkApp
       (mkIndU indu, Array.append
-         (Context.Rel.to_extended_vect (nrealargs+1) mib.mind_params_ctxt)
+         (Context.Rel.to_extended_vect mkRel (nrealargs+1) mib.mind_params_ctxt)
          (rel_vect (nrealargs+1) nrealargs)) in
   let realsign_ind =
     name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
@@ -244,22 +270,22 @@ let build_sym_involutive_scheme env ind =
 	       (mkApp (eq,[|
 	       mkApp
 	       (mkIndU indu, Array.concat
-	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		rel_vect (2*nrealargs+2) nrealargs;
 		rel_vect 1 nrealargs]);
                mkApp (sym,Array.concat
-	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		rel_vect 1 nrealargs;
 		rel_vect (2*nrealargs+2) nrealargs;
 		[|mkApp (sym,Array.concat
-		[Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+		[Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		 rel_vect (2*nrealargs+2) nrealargs;
 		 rel_vect 1 nrealargs;
 		 [|mkRel 1|]])|]]);
 	       mkRel 1|])),
 	       mkRel 1 (* varH *),
 	       [|mkApp(eqrefl,[|applied_ind_C;cstr (nrealargs+1)|])|]))))
-  in (c, Evd.evar_universe_context_of ctx), eff
+  in (c, UState.of_context_set ctx), eff
 
 let sym_involutive_scheme_kind =
   declare_individual_scheme_object "_sym_involutive"
@@ -335,7 +361,7 @@ let build_l2r_rew_scheme dep env ind kind =
   let eq,eqrefl,ctx = get_coq_eq ctx in
   let cstr n p =
     mkApp (mkConstructUi(indu,1),
-      Array.concat [Context.Rel.to_extended_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect mkRel n paramsctxt1;
                     rel_vect p nrealargs]) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -343,12 +369,12 @@ let build_l2r_rew_scheme dep env ind kind =
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_P =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect nrealargs nrealargs]) in
   let applied_ind_G =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs+3) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs+3) paramsctxt1;
         rel_vect (nrealargs+3) nrealargs;
         rel_vect 0 nrealargs]) in
   let realsign_P = lift_rel_context nrealargs realsign in
@@ -359,10 +385,10 @@ let build_l2r_rew_scheme dep env ind kind =
                       lift_rel_context (nrealargs+3) realsign) in
   let applied_sym_C n =
      mkApp(sym,
-       Array.append (Context.Rel.to_extended_vect n mip.mind_arity_ctxt) [|mkVar varH|]) in
+       Array.append (Context.Rel.to_extended_vect mkRel n mip.mind_arity_ctxt) [|mkVar varH|]) in
   let applied_sym_G =
      mkApp(sym,
-       Array.concat [Context.Rel.to_extended_vect (nrealargs*3+4) paramsctxt1;
+       Array.concat [Context.Rel.to_extended_vect mkRel (nrealargs*3+4) paramsctxt1;
                      rel_vect (nrealargs+4) nrealargs;
                      rel_vect 1 nrealargs;
 		     [|mkRel 1|]]) in
@@ -372,7 +398,7 @@ let build_l2r_rew_scheme dep env ind kind =
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let cieq = make_case_info (Global.env()) (fst (destInd eq)) RegularStyle in
   let applied_PC =
-    mkApp (mkVar varP,Array.append (Context.Rel.to_extended_vect 1 realsign)
+    mkApp (mkVar varP,Array.append (Context.Rel.to_extended_vect mkRel 1 realsign)
            (if dep then [|cstr (2*nrealargs+1) 1|] else [||])) in
   let applied_PG =
     mkApp (mkVar varP,Array.append (rel_vect 1 nrealargs)
@@ -382,11 +408,11 @@ let build_l2r_rew_scheme dep env ind kind =
            (if dep then [|mkRel 2|] else [||])) in
   let applied_sym_sym =
          mkApp (sym,Array.concat
-	   [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
+	   [Context.Rel.to_extended_vect mkRel (2*nrealargs+4) paramsctxt1;
             rel_vect 4 nrealargs;
             rel_vect (nrealargs+4) nrealargs;
             [|mkApp (sym,Array.concat
-	      [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
+	      [Context.Rel.to_extended_vect mkRel (2*nrealargs+4) paramsctxt1;
 	       rel_vect (nrealargs+4) nrealargs;
 	       rel_vect 4 nrealargs;
 	       [|mkRel 2|]])|]]) in
@@ -409,11 +435,11 @@ let build_l2r_rew_scheme dep env ind kind =
                    mkApp (eq,[|lift 4 applied_ind;applied_sym_sym;mkRel 1|]),
                    applied_PR)),
        mkApp (sym_involutive,
-         Array.append (Context.Rel.to_extended_vect 3 mip.mind_arity_ctxt) [|mkVar varH|]),
+         Array.append (Context.Rel.to_extended_vect mkRel 3 mip.mind_arity_ctxt) [|mkVar varH|]),
        [|main_body|])
    else
      main_body))))))
-  in (c, Evd.evar_universe_context_of ctx),
+  in (c, UState.of_context_set ctx),
       Safe_typing.concat_private eff' eff
 
 (**********************************************************************)
@@ -448,7 +474,7 @@ let build_l2r_forward_rew_scheme dep env ind kind =
     get_sym_eq_data env indu in
   let cstr n p =
     mkApp (mkConstructUi(indu,1),
-      Array.concat [Context.Rel.to_extended_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect mkRel n paramsctxt1;
                     rel_vect p nrealargs]) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -456,12 +482,12 @@ let build_l2r_forward_rew_scheme dep env ind kind =
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_P =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (4*nrealargs+2) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (4*nrealargs+2) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect (nrealargs+1) nrealargs]) in
   let applied_ind_P' =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs+1) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs+1) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect (2*nrealargs+1) nrealargs]) in
   let realsign_P n = lift_rel_context (nrealargs*n+n) realsign in
@@ -502,7 +528,7 @@ let build_l2r_forward_rew_scheme dep env ind kind =
 	  (if dep then realsign_ind_P 1 applied_ind_P' else realsign_P 2) s)
       (mkNamedLambda varHC applied_PC'
 	(mkVar varHC))|])))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 (**********************************************************************)
 (* Build the right-to-left rewriting lemma for hypotheses associated  *)
@@ -539,7 +565,7 @@ let build_r2l_forward_rew_scheme dep env ind kind =
   let ((mib,mip as specif),constrargs,realsign,paramsctxt,nrealargs) =
     get_non_sym_eq_data env indu in
   let cstr n =
-    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect mkRel n mib.mind_params_ctxt) in
   let constrargs_cstr = constrargs@[cstr 0] in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -555,8 +581,8 @@ let build_r2l_forward_rew_scheme dep env ind kind =
     applist (mkVar varP,if dep then constrargs_cstr else constrargs) in
   let applied_PG =
     mkApp (mkVar varP,
-           if dep then Context.Rel.to_extended_vect 0 realsign_ind
-	   else Context.Rel.to_extended_vect 1 realsign) in
+           if dep then Context.Rel.to_extended_vect mkRel 0 realsign_ind
+	   else Context.Rel.to_extended_vect mkRel 1 realsign) in
   let c = 
   (my_it_mkLambda_or_LetIn paramsctxt
   (my_it_mkLambda_or_LetIn_name realsign_ind
@@ -575,7 +601,7 @@ let build_r2l_forward_rew_scheme dep env ind kind =
 	   lift (nrealargs+3) applied_PC,
 	   mkRel 1)|]),
     [|mkVar varHC|]))))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 (**********************************************************************)
 (* This function "repairs" the non-dependent r2l forward rewriting    *)
@@ -594,20 +620,21 @@ let build_r2l_forward_rew_scheme dep env ind kind =
 (**********************************************************************)
 
 let fix_r2l_forward_rew_scheme (c, ctx') =
-  let t = Retyping.get_type_of (Global.env()) Evd.empty c in
+  let t = Retyping.get_type_of (Global.env()) Evd.empty (EConstr.of_constr c) in
+  let t = EConstr.Unsafe.to_constr t in
   let ctx,_ = decompose_prod_assum t in
   match ctx with
   | hp :: p :: ind :: indargs ->
      let c' = 
       my_it_mkLambda_or_LetIn indargs
-        (mkLambda_or_LetIn (map_constr (liftn (-1) 1) p)
-	  (mkLambda_or_LetIn (map_constr (liftn (-1) 2) hp)
-	    (mkLambda_or_LetIn (map_constr (lift 2) ind)
-	      (Reductionops.whd_beta Evd.empty
-		(applist (c,
-	          Context.Rel.to_extended_list 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))
+        (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 1) p)
+	  (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 2) hp)
+	    (mkLambda_or_LetIn (RelDecl.map_constr (lift 2) ind)
+	      (EConstr.Unsafe.to_constr (Reductionops.whd_beta Evd.empty
+		(EConstr.of_constr (applist (c,
+	          Context.Rel.to_extended_list mkRel 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))))
       in c', ctx'
-  | _ -> anomaly (Pp.str "Ill-formed non-dependent left-to-right rewriting scheme")
+  | _ -> anomaly (Pp.str "Ill-formed non-dependent left-to-right rewriting scheme.")
 
 (**********************************************************************)
 (* Build the right-to-left rewriting lemma for conclusion associated  *)
@@ -631,10 +658,10 @@ let fix_r2l_forward_rew_scheme (c, ctx') =
 (**********************************************************************)
  
 let build_r2l_rew_scheme dep env ind k =
-  let sigma = Sigma.Unsafe.of_evar_map (Evd.from_env env) in
-  let Sigma (indu, sigma, _) = Sigma.fresh_inductive_instance env sigma ind in
-  let Sigma (c, sigma, _) = build_case_analysis_scheme env sigma indu dep k in
-    c, Evd.evar_universe_context (Sigma.to_evar_map sigma)
+  let sigma = Evd.from_env env in
+  let (sigma, indu) = Evd.fresh_inductive_instance env sigma ind in
+  let (sigma, c) = build_case_analysis_scheme env sigma indu dep k in
+    c, Evd.evar_universe_context sigma
 
 let build_l2r_rew_scheme = build_l2r_rew_scheme
 let build_l2r_forward_rew_scheme = build_l2r_forward_rew_scheme
@@ -741,10 +768,10 @@ let build_congr env (eq,refl,ctx) ind =
   if List.exists is_local_def realsign then
     error "Inductive equalities with local definitions in arity not supported.";
   let env_with_arity = push_rel_context arityctxt env in
-  let ty = get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
+  let ty = RelDecl.get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
   let constrsign,ccl = decompose_prod_assum mip.mind_nf_lc.(0) in
   let _,constrargs = decompose_app ccl in
-  if Int.equal (Context.Rel.length constrsign) (Context.Rel.length mib.mind_params_ctxt) then
+  if not (Int.equal (Context.Rel.length constrsign) (Context.Rel.length mib.mind_params_ctxt)) then
     error "Constructor must have no arguments";
   let b = List.nth constrargs (i + mib.mind_nparams - 1) in
   let varB = fresh env (Id.of_string "B") in
@@ -752,6 +779,7 @@ let build_congr env (eq,refl,ctx) ind =
   let varf = fresh env (Id.of_string "f") in
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let uni, ctx = Universes.extend_context (Universes.new_global_univ ()) ctx in
+  let ctx = (fst ctx, Univ.enforce_leq uni (univ_of_eq env eq) (snd ctx)) in
   let c = 
   my_it_mkLambda_or_LetIn paramsctxt
      (mkNamedLambda varB (mkSort (Type uni))
@@ -760,8 +788,8 @@ let build_congr env (eq,refl,ctx) ind =
      (mkNamedLambda varH
         (applist
            (mkIndU indu,
-	    Context.Rel.to_extended_list (mip.mind_nrealargs+2) paramsctxt @
-	    Context.Rel.to_extended_list 0 realsign))
+	    Context.Rel.to_extended_list mkRel (mip.mind_nrealargs+2) paramsctxt @
+	    Context.Rel.to_extended_list mkRel 0 realsign))
      (mkCase (ci,
        my_it_mkLambda_or_LetIn_name
 	 (lift_rel_context (mip.mind_nrealargs+3) realsign)
@@ -769,9 +797,9 @@ let build_congr env (eq,refl,ctx) ind =
            (Anonymous,
             applist
              (mkIndU indu,
-	        Context.Rel.to_extended_list (2*mip.mind_nrealdecls+3)
+	        Context.Rel.to_extended_list mkRel (2*mip.mind_nrealdecls+3)
 		  paramsctxt
-	        @ Context.Rel.to_extended_list 0 realsign),
+	        @ Context.Rel.to_extended_list mkRel 0 realsign),
             mkApp (eq,
 	      [|mkVar varB;
                 mkApp (mkVar varf, [|lift (2*mip.mind_nrealdecls+4) b|]);
@@ -780,7 +808,7 @@ let build_congr env (eq,refl,ctx) ind =
        [|mkApp (refl,
           [|mkVar varB;
 	    mkApp (mkVar varf, [|lift (mip.mind_nrealargs+3) b|])|])|]))))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 let congr_scheme_kind = declare_individual_scheme_object "_congr"
   (fun _ ind ->
diff --git a/tactics/eqschemes.mli b/tactics/eqschemes.mli
index aa8a6d4b..4749aebd 100644
--- a/tactics/eqschemes.mli
+++ b/tactics/eqschemes.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This file builds schemes relative to equality inductive types *)
 
 open Names
-open Term
+open Constr
 open Environ
 open Ind_tables
 
@@ -22,14 +24,14 @@ val rew_l2r_forward_dep_scheme_kind : individual scheme_kind
 val rew_r2l_dep_scheme_kind : individual scheme_kind
 val rew_r2l_scheme_kind : individual scheme_kind
 
-val build_r2l_rew_scheme : bool -> env -> inductive -> sorts_family -> 
+val build_r2l_rew_scheme : bool -> env -> inductive -> Sorts.family -> 
   constr Evd.in_evar_universe_context
-val build_l2r_rew_scheme : bool -> env -> inductive -> sorts_family -> 
+val build_l2r_rew_scheme : bool -> env -> inductive -> Sorts.family -> 
   constr Evd.in_evar_universe_context * Safe_typing.private_constants
 val build_r2l_forward_rew_scheme :
-  bool -> env -> inductive -> sorts_family -> constr Evd.in_evar_universe_context
+  bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context
 val build_l2r_forward_rew_scheme :
-  bool -> env -> inductive -> sorts_family -> constr Evd.in_evar_universe_context
+  bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context
 
 (** Builds a symmetry scheme for a symmetrical equality type *)
 
@@ -43,5 +45,5 @@ val sym_involutive_scheme_kind : individual scheme_kind
 (** Builds a congruence scheme for an equality type *)
 
 val congr_scheme_kind : individual scheme_kind
-val build_congr : env -> constr * constr * Univ.universe_context_set -> inductive -> 
+val build_congr : env -> constr * constr * Univ.ContextSet.t -> inductive -> 
   constr Evd.in_evar_universe_context
diff --git a/tactics/equality.ml b/tactics/equality.ml
index bb3cbad9..5821717d 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1,23 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+module CVars = Vars
 open Pp
 open CErrors
 open Util
 open Names
 open Nameops
 open Term
-open Vars
 open Termops
+open EConstr
+open Vars
 open Namegen
 open Inductive
 open Inductiveops
-open Environ
 open Libnames
 open Globnames
 open Reductionops
@@ -26,7 +29,6 @@ open Retyping
 open Tacmach.New
 open Logic
 open Hipattern
-open Tacexpr
 open Tacticals.New
 open Tactics
 open Tacred
@@ -40,53 +42,35 @@ open Eqschemes
 open Locus
 open Locusops
 open Misctypes
-open Sigma.Notations
 open Proofview.Notations
 open Unification
 open Context.Named.Declaration
 
-(* Options *)
+module NamedDecl = Context.Named.Declaration
 
-let discriminate_introduction = ref true
+(* Options *)
 
-let discr_do_intro () =
-  !discriminate_introduction && Flags.version_strictly_greater Flags.V8_2
+type inj_flags = {
+    keep_proof_equalities : bool;
+    injection_in_context : bool;
+    injection_pattern_l2r_order : bool;
+  }
 
 open Goptions
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "automatic introduction of hypotheses by discriminate";
-      optkey   = ["Discriminate";"Introduction"];
-      optread  = (fun () -> !discriminate_introduction);
-      optwrite = (:=) discriminate_introduction }
-
-let injection_pattern_l2r_order = ref true
 
-let use_injection_pattern_l2r_order () =
-  !injection_pattern_l2r_order
-  && Flags.version_strictly_greater Flags.V8_4
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "injection left-to-right pattern order and clear by default when with introduction pattern";
-      optkey   = ["Injection";"L2R";"Pattern";"Order"];
-      optread  = (fun () -> !injection_pattern_l2r_order) ;
-      optwrite = (fun b -> injection_pattern_l2r_order := b) }
+let use_injection_pattern_l2r_order = function
+  | None -> true
+  | Some flags -> flags.injection_pattern_l2r_order
 
 let injection_in_context = ref false
 
-let use_injection_in_context () =
-  !injection_in_context
-  && Flags.version_strictly_greater Flags.V8_5
+let use_injection_in_context = function
+  | None -> !injection_in_context
+  | Some flags -> flags.injection_in_context
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "injection in context";
       optkey   = ["Structural";"Injection"];
       optread  = (fun () -> !injection_in_context) ;
@@ -94,9 +78,6 @@ let _ =
 
 (* Rewriting tactics *)
 
-let tclNOTSAMEGOAL tac =
-  Proofview.V82.tactic (Tacticals.tclNOTSAMEGOAL (Proofview.V82.of_tactic tac))
-
 type dep_proof_flag = bool (* true = support rewriting dependent proofs *)
 type freeze_evars_flag = bool (* true = don't instantiate existing evars *)
 
@@ -143,7 +124,7 @@ let freeze_initial_evars sigma flags clause =
   (* We take evars of the type: this may include old evars! For excluding *)
   (* all old evars, including the ones occurring in the rewriting lemma, *)
   (* we would have to take the clenv_value *)
-  let newevars = Evd.evars_of_term (clenv_type clause) in
+  let newevars = Evarutil.undefined_evars_of_term sigma (clenv_type clause) in
   let evars =
     fold_undefined (fun evk _ evars ->
       if Evar.Set.mem evk newevars then evars
@@ -164,10 +145,11 @@ let side_tac tac sidetac =
 
 let instantiate_lemma_all frzevars gl c ty l l2r concl =
   let env = Proofview.Goal.env gl in
+  let sigma = project gl in
   let eqclause = pf_apply Clenv.make_clenv_binding gl (c,ty) l in
-  let (equiv, args) = decompose_appvect (Clenv.clenv_type eqclause) in
+  let (equiv, args) = decompose_app_vect sigma (Clenv.clenv_type eqclause) in
   let arglen = Array.length args in
-  let () = if arglen < 2 then error "The term provided is not an applied relation." in
+  let () = if arglen < 2 then user_err Pp.(str "The term provided is not an applied relation.") in
   let c1 = args.(arglen - 2) in
   let c2 = args.(arglen - 1) in
   let try_occ (evd', c') =
@@ -257,12 +239,31 @@ let rewrite_keyed_unif_flags = {
 }
 
 let rewrite_elim with_evars frzevars cls c e =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let flags = if Unification.is_keyed_unification ()
 	      then rewrite_keyed_unif_flags else rewrite_conv_closed_unif_flags in
   let flags = make_flags frzevars (Tacmach.New.project gl) flags c in
   general_elim_clause with_evars flags cls c e
-  end }
+  end
+
+let tclNOTSAMEGOAL tac =
+  let goal gl = Proofview.Goal.goal gl in
+  Proofview.Goal.nf_enter begin fun gl ->
+    let sigma = project gl in
+    let ev = goal gl in
+    tac >>= fun () ->
+    Proofview.Goal.goals >>= fun gls ->
+    let check accu gl' =
+      gl' >>= fun gl' ->
+      let accu = accu || Goal.V82.same_goal sigma ev (project gl') (goal gl') in
+      Proofview.tclUNIT accu
+    in
+    Proofview.Monad.List.fold_left check false gls >>= fun has_same ->
+    if has_same then
+      tclZEROMSG (str"Tactic generated a subgoal identical to the original goal.")
+    else
+      Proofview.tclUNIT ()
+  end
 
 (* Ad hoc asymmetric general_elim_clause *)
 let general_elim_clause with_evars frzevars cls rew elim =
@@ -297,19 +298,19 @@ let general_elim_clause with_evars frzevars tac cls c t l l2r elim =
          (general_elim_clause with_evars frzevars cls c elim))
       tac
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let instantiate_lemma concl =
       if not all then instantiate_lemma gl c t l l2r concl
       else instantiate_lemma_all frzevars gl c t l l2r concl
     in
     let typ = match cls with
-    | None -> pf_nf_concl gl
-    | Some id -> pf_get_hyp_typ id (Proofview.Goal.assume gl)
+    | None -> pf_concl gl
+    | Some id -> pf_get_hyp_typ id gl
     in
     let cs = instantiate_lemma typ in
     if firstonly then tclFIRST (List.map try_clause cs)
     else tclMAP try_clause cs
-  end }
+  end
 
 (* The next function decides in particular whether to try a regular
   rewrite or a generalized rewrite.
@@ -322,27 +323,30 @@ let (forward_general_setoid_rewrite_clause, general_setoid_rewrite_clause) = Hoo
 
 (* Do we have a JMeq instance on twice the same domains ? *)
 
-let jmeq_same_dom gl = function
+let jmeq_same_dom env sigma = function
   | None -> true (* already checked in Hipattern.find_eq_data_decompose *)
   | Some t ->
-    let rels, t = decompose_prod_assum t in
-    let env = Environ.push_rel_context rels (Proofview.Goal.env gl) in
-    match decompose_app t with
-      | _, [dom1; _; dom2;_] -> is_conv env (Tacmach.New.project gl) dom1 dom2
+    let rels, t = decompose_prod_assum sigma t in
+    let env = push_rel_context rels env in
+    match decompose_app sigma t with
+      | _, [dom1; _; dom2;_] -> is_conv env sigma dom1 dom2
       | _ -> false
 
 (* find_elim determines which elimination principle is necessary to
    eliminate lbeq on sort_of_gl. *)
 
-let find_elim hdcncl lft2rgt dep cls ot gl =
+let find_elim hdcncl lft2rgt dep cls ot =
+  Proofview.Goal.enter_one begin fun gl ->
+  let sigma = project gl in
+  let is_global gr c = Termops.is_global sigma gr c in
   let inccl = Option.is_empty cls in
+  let env = Proofview.Goal.env gl in
   if (is_global Coqlib.glob_eq hdcncl ||
       (is_global Coqlib.glob_jmeq hdcncl &&
-	 jmeq_same_dom gl ot)) && not dep
-    || Flags.version_less_or_equal Flags.V8_2
+	 jmeq_same_dom env sigma ot)) && not dep
   then
     let c = 
-      match kind_of_term hdcncl with 
+      match EConstr.kind sigma hdcncl with 
       | Ind (ind_sp,u) -> 
 	let pr1 = 
 	  lookup_eliminator ind_sp (elimination_sort_of_clause cls gl) 
@@ -351,16 +355,16 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
         | Some true, None
         | Some false, Some _ ->
 	  let c1 = destConstRef pr1 in 
-	  let mp,dp,l = repr_con (constant_of_kn (canonical_con c1)) in 
+	  let mp,dp,l = Constant.repr3 (Constant.make1 (Constant.canonical c1)) in 
 	  let l' = Label.of_id (add_suffix (Label.to_id l) "_r")  in 
-	  let c1' = Global.constant_of_delta_kn (make_kn mp dp l') in
+	  let c1' = Global.constant_of_delta_kn (KerName.make mp dp l') in
 	  begin 
 	    try 
 	      let _ = Global.lookup_constant c1' in
 		c1'
 	    with Not_found -> 
-	      errorlabstrm "Equality.find_elim"
-                (str "Cannot find rewrite principle " ++ pr_label l' ++ str ".")
+	      user_err ~hdr:"Equality.find_elim"
+                (str "Cannot find rewrite principle " ++ Label.print l' ++ str ".")
 	  end
 	| _ -> destConstRef pr1
         end
@@ -369,8 +373,7 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
 	     Logic.eq or Jmeq just before *)
 	assert false
     in
-      let Sigma (elim, sigma, p) = Sigma.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c) in
-      Sigma ((elim, Safe_typing.empty_private_constants), sigma, p)
+        pf_constr_of_global (ConstRef c) 
   else
   let scheme_name = match dep, lft2rgt, inccl with
     (* Non dependent case *)
@@ -384,36 +387,31 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
     | true, _, true -> rew_r2l_dep_scheme_kind
     | true, _, false -> rew_r2l_forward_dep_scheme_kind
   in
-  match kind_of_term hdcncl with
+  match EConstr.kind sigma hdcncl with
   | Ind (ind,u) -> 
+      
       let c, eff = find_scheme scheme_name ind in 
-      (* MS: cannot use pf_constr_of_global as the eliminator might be generated by side-effect *)
-      let Sigma (elim, sigma, p) =
-	Sigma.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c)
-      in
-      Sigma ((elim, eff), sigma, p)
+      Proofview.tclEFFECTS eff <*>
+        pf_constr_of_global (ConstRef c) 
   | _ -> assert false
+  end
 
 let type_of_clause cls gl = match cls with
   | None -> Proofview.Goal.concl gl
   | Some id -> pf_get_hyp_typ id gl
 
 let leibniz_rewrite_ebindings_clause cls lft2rgt tac c t l with_evars frzevars dep_proof_ok hdcncl =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-  let evd = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  let isatomic = isProd (whd_zeta evd hdcncl) in
+  Proofview.Goal.enter begin fun gl ->
+  let evd = Proofview.Goal.sigma gl in
+  let isatomic = isProd evd (whd_zeta evd hdcncl) in
   let dep_fun = if isatomic then dependent else dependent_no_evar in
   let type_of_cls = type_of_clause cls gl in
-  let dep = dep_proof_ok && dep_fun c type_of_cls in
-  let Sigma ((elim, effs), sigma, p) = find_elim hdcncl lft2rgt dep cls (Some t) gl in
-  let tac =
-      Proofview.tclEFFECTS effs <*>
+  let dep = dep_proof_ok && dep_fun evd c type_of_cls in
+  find_elim hdcncl lft2rgt dep cls (Some t) >>= fun elim ->
       general_elim_clause with_evars frzevars tac cls c t l
       (match lft2rgt with None -> false | Some b -> b)
       {elimindex = None; elimbody = (elim,NoBindings); elimrename = None}
-  in
-  Sigma (tac, sigma, p)
-  end }
+  end
 
 let adjust_rewriting_direction args lft2rgt =
   match args with
@@ -421,7 +419,7 @@ let adjust_rewriting_direction args lft2rgt =
     (* equality to a constant, like in eq_true *)
     (* more natural to see -> as the rewriting to the constant *)
     if not lft2rgt then
-      error "Rewriting non-symmetric equality not allowed from right-to-left.";
+      user_err Pp.(str "Rewriting non-symmetric equality not allowed from right-to-left.");
     None
   | _ ->
     (* other equality *)
@@ -436,12 +434,12 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
   if occs != AllOccurrences then (
     rewrite_side_tac (Hook.get forward_general_setoid_rewrite_clause cls lft2rgt occs (c,l) ~new_goals:[]) tac)
   else
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
     let ctype = get_type_of env sigma c in
-    let rels, t = decompose_prod_assum (whd_betaiotazeta sigma ctype) in
-      match match_with_equality_type t with
+    let rels, t = decompose_prod_assum sigma (whd_betaiotazeta sigma ctype) in
+      match match_with_equality_type sigma t with
       | Some (hdcncl,args) -> (* Fast path: direct leibniz-like rewrite *)
 	  let lft2rgt = adjust_rewriting_direction args lft2rgt in
           leibniz_rewrite_ebindings_clause cls lft2rgt tac c (it_mkProd_or_LetIn t rels)
@@ -454,9 +452,10 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
             end
             begin function
               | (e, info) ->
+                  Proofview.tclEVARMAP >>= fun sigma ->
 	          let env' = push_rel_context rels env in
 	          let rels',t' = splay_prod_assum env' sigma t in (* Search for underlying eq *)
-	          match match_with_equality_type t' with
+	          match match_with_equality_type sigma t' with
 	            | Some (hdcncl,args) ->
 		  let lft2rgt = adjust_rewriting_direction args lft2rgt in
 		  leibniz_rewrite_ebindings_clause cls lft2rgt tac c
@@ -464,7 +463,7 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
 	            | None -> Proofview.tclZERO ~info e
             (* error "The provided term does not end with an equality or a declared rewrite relation." *)  
             end
-    end }
+    end
 
 let general_rewrite_ebindings =
   general_rewrite_ebindings_clause None
@@ -515,46 +514,46 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
 	let rec do_hyps_atleastonce = function
 	  | [] -> tclZEROMSG (Pp.str"Nothing to rewrite.")
 	  | id :: l ->
-	    tclIFTHENTRYELSEMUST
+            tclIFTHENFIRSTTRYELSEMUST
 	     (general_rewrite_ebindings_in l2r AllOccurrences false true ?tac id c with_evars)
 	     (do_hyps_atleastonce l)
 	in
 	let do_hyps =
 	  (* If the term to rewrite uses an hypothesis H, don't rewrite in H *)
 	  let ids gl =
-	    let ids_in_c = Environ.global_vars_set (Global.env()) (fst c) in
+	    let ids_in_c = Termops.global_vars_set (Proofview.Goal.env gl) (project gl) (fst c) in
             let ids_of_hyps = pf_ids_of_hyps gl in
 	    Id.Set.fold (fun id l -> List.remove Id.equal id l) ids_in_c ids_of_hyps
 	  in
-          Proofview.Goal.enter { enter = begin fun gl ->
+          Proofview.Goal.enter begin fun gl ->
             do_hyps_atleastonce (ids gl)
-          end }
+          end
 	in
 	if cl.concl_occs == NoOccurrences then do_hyps else
-	  tclIFTHENTRYELSEMUST
+          tclIFTHENFIRSTTRYELSEMUST
 	   (general_rewrite_ebindings l2r (occs_of cl.concl_occs) false true ?tac c with_evars)
 	   do_hyps
 
 let apply_special_clear_request clear_flag f =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     try
-      let ((c, bl), sigma) = run_delayed env sigma f in
+      let (sigma, (c, bl)) = f env sigma in
       apply_clear_request clear_flag (use_clear_hyp_by_default ()) c
     with
       e when catchable_exception e -> tclIDTAC
-  end }
+  end
 
 let general_multi_rewrite with_evars l cl tac =
   let do1 l2r f =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let (c, sigma) = run_delayed env sigma f in
+      let (sigma, c) = f env sigma in
       tclWITHHOLES with_evars
         (general_rewrite_clause l2r with_evars ?tac c cl) sigma
-    end }
+    end
   in
   let rec doN l2r c = function
     | Precisely n when n <= 0 -> Proofview.tclUNIT ()
@@ -617,7 +616,7 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
       | None -> Proofview.tclUNIT ()
       | Some tac ->  tclCOMPLETE tac
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let get_type_of = pf_apply get_type_of gl in
   let t1 = get_type_of c1
   and t2 = get_type_of c2 in
@@ -633,8 +632,8 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
   | Some evd ->
     let e = build_coq_eq () in
     let sym = build_coq_eq_sym () in
-    Tacticals.New.pf_constr_of_global sym (fun sym ->
-    Tacticals.New.pf_constr_of_global e (fun e ->
+    Tacticals.New.pf_constr_of_global sym >>= fun sym ->
+    Tacticals.New.pf_constr_of_global e >>= fun e ->
     let eq = applist (e, [t1;c1;c2]) in
     tclTHENLAST
       (replace_core clause l2r eq)
@@ -642,8 +641,8 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
          [assumption;
           tclTHEN (apply sym) assumption;
           try_prove_eq
-         ])))
-  end }
+         ])
+  end
 
 let replace c1 c2 =
   replace_using_leibniz onConcl c2 c1 false false None
@@ -705,26 +704,31 @@ let keep_proof_equalities_for_injection = ref false
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "injection on prop arguments";
       optkey   = ["Keep";"Proof";"Equalities"];
       optread  = (fun () -> !keep_proof_equalities_for_injection) ;
       optwrite = (fun b -> keep_proof_equalities_for_injection := b) }
 
+let keep_proof_equalities = function
+  | None -> !keep_proof_equalities_for_injection
+  | Some flags -> flags.keep_proof_equalities
 
-let find_positions env sigma t1 t2 =
+(* [keep_proofs] is relevant for types in Prop with elimination in Type *)
+(* In particular, it is relevant for injection but not for discriminate *)
+
+let find_positions env sigma ~keep_proofs ~no_discr t1 t2 =
   let project env sorts posn t1 t2 =
     let ty1 = get_type_of env sigma t1 in
-    let s = get_sort_family_of env sigma ty1 in
+    let s = get_sort_family_of ~truncation_style:true env sigma ty1 in
     if Sorts.List.mem s sorts
     then [(List.rev posn,t1,t2)] else []
   in
   let rec findrec sorts posn t1 t2 =
     let hd1,args1 = whd_all_stack env sigma t1 in
     let hd2,args2 = whd_all_stack env sigma t2 in
-    match (kind_of_term hd1, kind_of_term hd2) with
-      | Construct (sp1,_), Construct (sp2,_)
+    match (EConstr.kind sigma hd1, EConstr.kind sigma hd2) with
+      | Construct ((ind1,i1 as sp1),u1), Construct (sp2,_)
           when Int.equal (List.length args1) (constructor_nallargs_env env sp1)
             ->
 	  let sorts' =
@@ -733,13 +737,18 @@ let find_positions env sigma t1 t2 =
           (* both sides are fully applied constructors, so either we descend,
              or we can discriminate here. *)
 	  if eq_constructor sp1 sp2 then
-	    let nrealargs = constructor_nrealargs_env env sp1 in
-	    let rargs1 = List.lastn nrealargs args1 in
-	    let rargs2 = List.lastn nrealargs args2 in
+	    let nparams = inductive_nparams_env env ind1 in
+	    let params1,rargs1 = List.chop nparams args1 in
+	    let _,rargs2 = List.chop nparams args2 in
+            let (mib,mip) = lookup_mind_specif env ind1 in
+            let params1 = List.map EConstr.Unsafe.to_constr params1 in
+            let u1 = EInstance.kind sigma u1 in
+            let ctxt = (get_constructor ((ind1,u1),mib,mip,params1) i1).cs_args in
+            let adjust i = CVars.adjust_rel_to_rel_context ctxt (i+1) - 1 in
             List.flatten
-	      (List.map2_i (fun i -> findrec sorts' ((sp1,i)::posn))
+	      (List.map2_i (fun i -> findrec sorts' ((sp1,adjust i)::posn))
 		0 rargs1 rargs2)
-	  else if Sorts.List.mem InType sorts'
+	  else if Sorts.List.mem InType sorts' && not no_discr
           then (* see build_discriminator *)
 	    raise (DiscrFound (List.rev posn,sp1,sp2))
 	  else 
@@ -755,21 +764,24 @@ let find_positions env sigma t1 t2 =
 	    project env sorts posn t1_0 t2_0
   in
   try
-    let sorts = if !keep_proof_equalities_for_injection then [InSet;InType;InProp]
-		else [InSet;InType]
-    in
+    let sorts = if keep_proofs then [InSet;InType;InProp] else [InSet;InType] in
     Inr (findrec sorts [] t1 t2)
   with DiscrFound (path,c1,c2) ->
     Inl (path,c1,c2)
 
+let use_keep_proofs = function
+  | None -> !keep_proof_equalities_for_injection
+  | Some b -> b
+
 let discriminable env sigma t1 t2 =
-  match find_positions env sigma t1 t2 with
+  match find_positions env sigma ~keep_proofs:false ~no_discr:false t1 t2 with
     | Inl _ -> true
     | _ -> false
 
-let injectable env sigma t1 t2 =
-    match find_positions env sigma t1 t2 with
-    | Inl _ | Inr [] | Inr [([],_,_)] -> false
+let injectable env sigma ~keep_proofs t1 t2 =
+    match find_positions env sigma ~keep_proofs:(use_keep_proofs keep_proofs) ~no_discr:true t1 t2 with
+    | Inl _ -> assert false
+    | Inr [] | Inr [([],_,_)] -> false
     | Inr _ -> true
 
 
@@ -840,27 +852,30 @@ let descend_then env sigma head dirn =
   let IndType (indf,_) =
     try find_rectype env sigma (get_type_of env sigma head)
     with Not_found ->
-      error "Cannot project on an inductive type derived from a dependency." in
+      user_err Pp.(str "Cannot project on an inductive type derived from a dependency.") 
+  in
   let indp,_ = (dest_ind_family indf) in
   let ind, _ = check_privacy env indp in
   let (mib,mip) = lookup_mind_specif env ind in
   let cstr = get_constructors env indf in
   let dirn_nlams = cstr.(dirn-1).cs_nargs in
-  let dirn_env = push_rel_context cstr.(dirn-1).cs_args env in
+  let dirn_env = Environ.push_rel_context cstr.(dirn-1).cs_args env in
   (dirn_nlams,
    dirn_env,
-   (fun dirnval (dfltval,resty) ->
-      let deparsign = make_arity_signature env true indf in
+   (fun sigma dirnval (dfltval,resty) ->
+      let deparsign = make_arity_signature env sigma true indf in
       let p =
 	it_mkLambda_or_LetIn (lift (mip.mind_nrealargs+1) resty) deparsign in
       let build_branch i =
 	let result = if Int.equal i dirn then dirnval else dfltval in
-	it_mkLambda_or_LetIn_name env result cstr.(i-1).cs_args in
+	let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstr.(i-1).cs_args in
+	let args = name_context env sigma cs_args in
+	it_mkLambda_or_LetIn result args in
       let brl =
         List.map build_branch
           (List.interval 1 (Array.length mip.mind_consnames)) in
       let ci = make_case_info env ind RegularStyle in
-      Inductiveops.make_case_or_project env indf ci p head (Array.of_list brl)))
+      Inductiveops.make_case_or_project env sigma indf ci p head (Array.of_list brl)))
 
 (* Now we need to construct the discriminator, given a discriminable
    position.  This boils down to:
@@ -888,35 +903,39 @@ let build_selector env sigma dirn c ind special default =
           on (c bool true) = (c bool false)
           CP : changed assert false in a more informative error
        *)
-      errorlabstrm "Equality.construct_discriminator"
+      user_err ~hdr:"Equality.construct_discriminator"
 	(str "Cannot discriminate on inductive constructors with \
 		 dependent types.") in
   let (indp,_) = dest_ind_family indf in
   let ind, _ = check_privacy env indp in
   let typ = Retyping.get_type_of env sigma default in
   let (mib,mip) = lookup_mind_specif env ind in
-  let deparsign = make_arity_signature env true indf in
+  let deparsign = make_arity_signature env sigma true indf in
   let p = it_mkLambda_or_LetIn typ deparsign in
   let cstrs = get_constructors env indf in
   let build_branch i =
     let endpt = if Int.equal i dirn then special else default in
-    it_mkLambda_or_LetIn endpt cstrs.(i-1).cs_args in
+    let args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstrs.(i-1).cs_args in
+    it_mkLambda_or_LetIn endpt args in
   let brl =
     List.map build_branch(List.interval 1 (Array.length mip.mind_consnames)) in
   let ci = make_case_info env ind RegularStyle in
-  mkCase (ci, p, c, Array.of_list brl)
+  let ans = Inductiveops.make_case_or_project env sigma indf ci p c (Array.of_list brl) in
+  ans
 
-let rec build_discriminator env sigma dirn c = function
+let build_coq_False () = pf_constr_of_global (build_coq_False ())
+let build_coq_True () = pf_constr_of_global (build_coq_True ())
+let build_coq_I () = pf_constr_of_global (build_coq_I ())
+
+let rec build_discriminator env sigma true_0 false_0 dirn c = function
   | [] ->
       let ind = get_type_of env sigma c in
-      let true_0,false_0 =
-        build_coq_True(),build_coq_False() in
       build_selector env sigma dirn c ind true_0 false_0
   | ((sp,cnum),argnum)::l ->
       let (cnum_nlams,cnum_env,kont) = descend_then env sigma c cnum in
       let newc = mkRel(cnum_nlams-argnum) in
-      let subval = build_discriminator cnum_env sigma dirn newc l in
-      kont subval (build_coq_False (),mkSort (Prop Null))
+      let subval = build_discriminator cnum_env sigma true_0 false_0 dirn newc l in
+      kont sigma subval (false_0,mkSort (Prop Null))
 
 (* Note: discrimination could be more clever: if some elimination is
    not allowed because of a large impredicative constructor in the
@@ -930,15 +949,15 @@ let rec build_discriminator env sigma dirn c = function
 *)
 
 let gen_absurdity id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let hyp_typ = pf_get_hyp_typ id (Proofview.Goal.assume gl) in
-  let hyp_typ = pf_nf_evar gl hyp_typ in
-  if is_empty_type hyp_typ
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
+  let hyp_typ = pf_get_hyp_typ id gl in
+  if is_empty_type sigma hyp_typ
   then
     simplest_elim (mkVar id)
   else
     tclZEROMSG (str "Not the negation of an equality.")
-  end }
+  end
 
 (* Precondition: eq is leibniz equality
 
@@ -958,13 +977,15 @@ let ind_scheme_of_eq lbeq =
     ConstRef c, eff
 
 
-let discrimination_pf env sigma e (t,t1,t2) discriminator lbeq =
-  let i            = build_coq_I () in
-  let absurd_term  = build_coq_False () in
-  let eq_elim, eff = ind_scheme_of_eq lbeq in
-  let sigma, eq_elim = Evd.fresh_global (Global.env ()) sigma eq_elim in
-    sigma, (applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term),
-    eff
+let discrimination_pf e (t,t1,t2) discriminator lbeq =
+  build_coq_I () >>= fun i ->
+  build_coq_False () >>= fun absurd_term ->
+  let eq_elim, eff       = ind_scheme_of_eq lbeq in
+  Proofview.tclEFFECTS eff <*>
+    pf_constr_of_global eq_elim >>= fun eq_elim ->
+    Proofview.tclUNIT
+       (applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term)
+
 
 let eq_baseid = Id.of_string "e"
 
@@ -972,39 +993,44 @@ let apply_on_clause (f,t) clause =
   let sigma =  clause.evd in
   let f_clause = mk_clenv_from_env clause.env sigma None (f,t) in
   let argmv =
-    (match kind_of_term (last_arg f_clause.templval.Evd.rebus) with
+    (match EConstr.kind sigma (last_arg f_clause.evd f_clause.templval.Evd.rebus) with
      | Meta mv -> mv
-     | _  -> errorlabstrm "" (str "Ill-formed clause applicator.")) in
+     | _  -> user_err  (str "Ill-formed clause applicator.")) in
   clenv_fchain ~with_univs:false argmv f_clause clause
 
 let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn =
-  let e = next_ident_away eq_baseid (ids_of_context env) in
+  build_coq_True () >>= fun true_0 ->
+  build_coq_False () >>= fun false_0 ->
+  let e = next_ident_away eq_baseid (vars_of_env env) in
   let e_env = push_named (Context.Named.Declaration.LocalAssum (e,t)) env in
   let discriminator =
-    build_discriminator e_env sigma dirn (mkVar e) cpath in
-  let sigma,(pf, absurd_term), eff = 
-    discrimination_pf env sigma e (t,t1,t2) discriminator lbeq in
-  let pf_ty = mkArrow eqn absurd_term in
-  let absurd_clause = apply_on_clause (pf,pf_ty) eq_clause in
-  let pf = Clenvtac.clenv_value_cast_meta absurd_clause in
-  Proofview.Unsafe.tclEVARS sigma <*>
-  Proofview.tclEFFECTS eff <*>
-  tclTHENS (assert_after Anonymous absurd_term)
-    [onLastHypId gen_absurdity; (Proofview.V82.tactic (Tacmach.refine pf))]
+    try
+      Proofview.tclUNIT
+        (build_discriminator e_env sigma true_0 false_0 dirn (mkVar e) cpath)
+    with
+      UserError _ as ex -> Proofview.tclZERO ex
+  in
+    discriminator >>= fun discriminator ->
+    discrimination_pf e (t,t1,t2) discriminator lbeq >>= fun (pf, absurd_term) ->
+    let pf_ty = mkArrow eqn absurd_term in
+    let absurd_clause = apply_on_clause (pf,pf_ty) eq_clause in
+    let pf = Clenvtac.clenv_value_cast_meta absurd_clause in
+    tclTHENS (assert_after Anonymous absurd_term)
+      [onLastHypId gen_absurdity; (Proofview.V82.tactic (Tacmach.refine pf))]
 
 let discrEq (lbeq,_,(t,t1,t2) as u) eq_clause =
   let sigma = eq_clause.evd in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    match find_positions env sigma t1 t2 with
+    match find_positions env sigma ~keep_proofs:false ~no_discr:false t1 t2 with
     | Inr _ ->
 	tclZEROMSG (str"Not a discriminable equality.")
     | Inl (cpath, (_,dirn), _) ->
 	discr_positions env sigma u eq_clause cpath dirn
-  end }
+  end
 
 let onEquality with_evars tac (c,lbindc) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of = pf_unsafe_type_of gl in
   let reduce_to_quantified_ind = pf_apply Tacred.reduce_to_quantified_ind gl in
   let t = type_of c in
@@ -1016,21 +1042,21 @@ let onEquality with_evars tac (c,lbindc) =
   tclTHEN
     (Proofview.Unsafe.tclEVARS eq_clause'.evd)
     (tac (eq,eqn,eq_args) eq_clause')
-  end }
+  end
 
 let onNegatedEquality with_evars tac =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let ccl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
-    match kind_of_term (hnf_constr env sigma ccl) with
-    | Prod (_,t,u) when is_empty_type u ->
+    match EConstr.kind sigma (hnf_constr env sigma ccl) with
+    | Prod (_,t,u) when is_empty_type sigma u ->
         tclTHEN introf
           (onLastHypId (fun id ->
             onEquality with_evars tac (mkVar id,NoBindings)))
     | _ ->
         tclZEROMSG (str "Not a negated primitive equality.")
-  end }
+  end
 
 let discrSimpleClause with_evars = function
   | None -> onNegatedEquality with_evars discrEq
@@ -1041,19 +1067,13 @@ let discr with_evars = onEquality with_evars discrEq
 let discrClause with_evars = onClause (discrSimpleClause with_evars)
 
 let discrEverywhere with_evars =
-(*
-  tclORELSE
-*)
-    (if discr_do_intro () then
-      (tclTHEN
-	(tclREPEAT introf)
-	(tryAllHyps
+  tclTHEN (Proofview.tclUNIT ())
+    (* Delay the interpretation of side-effect *)
+    (tclTHEN
+       (tclREPEAT introf)
+       (tryAllHyps
           (fun id -> tclCOMPLETE (discr with_evars (mkVar id,NoBindings)))))
-     else (* <= 8.2 compat *)
-       tryAllHypsAndConcl (discrSimpleClause with_evars))
-(*    (fun gls ->
-       errorlabstrm "DiscrEverywhere" (str"No discriminable equalities."))
-*)
+
 let discr_tac with_evars = function
   | None -> discrEverywhere with_evars
   | Some c -> onInductionArg (fun clear_flag -> discr with_evars) c
@@ -1078,7 +1098,7 @@ let find_sigma_data env s = build_sigma_type ()
  *)
 
 let make_tuple env sigma (rterm,rty) lind =
-  assert (dependent (mkRel lind) rty);
+  assert (not (noccurn sigma lind rty));
   let sigdata = find_sigma_data env (get_sort_of env sigma rty) in
   let sigma, a = type_of ~refresh:true env sigma (mkRel lind) in
   let na = Context.Rel.Declaration.get_name (lookup_rel lind env) in
@@ -1088,6 +1108,8 @@ let make_tuple env sigma (rterm,rty) lind =
   let p = mkLambda (na, a, rty) in
   let sigma, exist_term = Evd.fresh_global env sigma sigdata.intro in
   let sigma, sig_term = Evd.fresh_global env sigma sigdata.typ in
+  let exist_term = EConstr.of_constr exist_term in
+  let sig_term = EConstr.of_constr sig_term in
     sigma,
     (applist(exist_term,[a;p;(mkRel lind);rterm]),
      applist(sig_term,[a;p]))
@@ -1100,9 +1122,9 @@ let make_tuple env sigma (rterm,rty) lind =
    normalization *)
 
 let minimal_free_rels env sigma (c,cty) =
-  let cty_rels = free_rels cty in
+  let cty_rels = free_rels sigma cty in
   let cty' = simpl env sigma cty in
-  let rels' = free_rels cty' in
+  let rels' = free_rels sigma cty' in
   if Int.Set.subset cty_rels rels' then
     (cty,cty_rels)
   else
@@ -1167,25 +1189,24 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
           evdref := Evarconv.solve_unif_constraints_with_heuristics env !evdref in
 	dflt
       with Evarconv.UnableToUnify _ ->
-	error "Cannot solve a unification problem."
+	user_err Pp.(str "Cannot solve a unification problem.")
     else
       let (a,p_i_minus_1) = match whd_beta_stack !evdref p_i with
-	| (_sigS,[a;p]) -> (a,p)
- 	| _ -> anomaly ~label:"sig_clausal_form" (Pp.str "should be a sigma type") in
+	| (_sigS,[a;p]) -> (a, p)
+ 	| _ -> anomaly ~label:"sig_clausal_form" (Pp.str "should be a sigma type.") in
       let ev = Evarutil.e_new_evar env evdref a in
-      let rty = beta_applist(p_i_minus_1,[ev]) in
+      let rty = beta_applist sigma (p_i_minus_1,[ev]) in
       let tuple_tail = sigrec_clausal_form (siglen-1) rty in
-      match
-        Evd.existential_opt_value !evdref
-          (destEvar ev)
-      with
+      let evopt = match EConstr.kind !evdref ev with Evar _ -> None | _ -> Some ev in
+      match evopt with
 	| Some w ->
-            let w_type = unsafe_type_of env sigma w in
+            let w_type = unsafe_type_of env !evdref w in
             if Evarconv.e_cumul env evdref w_type a then
 	      let exist_term = Evarutil.evd_comb1 (Evd.fresh_global env) evdref sigdata.intro in
+	      let exist_term = EConstr.of_constr exist_term in
               applist(exist_term,[a;p_i_minus_1;w;tuple_tail])
             else
-              error "Cannot solve a unification problem."
+              user_err Pp.(str "Cannot solve a unification problem.")
 	| None ->
             (* This at least happens if what has been detected as a
                dependency is not one; use an evasive error message;
@@ -1193,7 +1214,7 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
                tried in the first place in make_iterated_tuple instead
                of approximatively computing the free rels; then
                unsolved evars would mean not binding rel *)
-	    error "Cannot solve a unification problem."
+	    user_err Pp.(str "Cannot solve a unification problem.")
   in
   let scf = sigrec_clausal_form siglen ty in
     !evdref, Evarutil.nf_evar !evdref scf
@@ -1263,7 +1284,7 @@ let make_iterated_tuple env sigma dflt (z,zty) =
   let sigma, (tuple,tuplety) =
     List.fold_left (fun (sigma, t) -> make_tuple env sigma t) (sigma, (z,zty)) sorted_rels
   in
-  assert (closed0 tuplety);
+  assert (closed0 sigma tuplety);
   let n = List.length sorted_rels in
   let sigma, dfltval = sig_clausal_form env sigma sort_of_zty n tuplety dflt in
     sigma, (tuple,tuplety,dfltval)
@@ -1275,7 +1296,8 @@ let rec build_injrec env sigma dflt c = function
       let (cnum_nlams,cnum_env,kont) = descend_then env sigma c cnum in
       let newc = mkRel(cnum_nlams-argnum) in
       let sigma, (subval,tuplety,dfltval) = build_injrec cnum_env sigma dflt newc l in
-	sigma, (kont subval (dfltval,tuplety), tuplety,dfltval)
+      let res = kont sigma subval (dfltval,tuplety) in
+      sigma, (res, tuplety,dfltval)
     with
 	UserError _ -> failwith "caught"
 
@@ -1283,62 +1305,51 @@ let build_injector env sigma dflt c cpath =
   let sigma, (injcode,resty,_) = build_injrec env sigma dflt c cpath in
     sigma, (injcode,resty)
 
-(*
-let try_delta_expand env sigma t =
-  let whdt = whd_all env sigma t  in
-  let rec hd_rec c  =
-    match kind_of_term c with
-      | Construct _ -> whdt
-      | App (f,_)  -> hd_rec f
-      | Cast (c,_,_) -> hd_rec c
-      | _  -> t
-  in
-  hd_rec whdt
-*)
-
 let eq_dec_scheme_kind_name = ref (fun _ -> failwith "eq_dec_scheme undefined")
 let set_eq_dec_scheme_kind k = eq_dec_scheme_kind_name := (fun _ -> k)
 
 let inject_if_homogenous_dependent_pair ty =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   try
+    let sigma = Tacmach.New.project gl in
     let eq,u,(t,t1,t2) = find_this_eq_data_decompose gl ty in
     (* fetch the informations of the  pair *)
-    let ceq = Universes.constr_of_global Coqlib.glob_eq in
     let sigTconstr () = (Coqlib.build_sigma_type()).Coqlib.typ in
     let existTconstr () = (Coqlib.build_sigma_type()).Coqlib.intro in
     (* check whether the equality deals with dep pairs or not *)
-    let eqTypeDest = fst (decompose_app t) in
-    if not (Globnames.is_global (sigTconstr()) eqTypeDest) then raise Exit;
-    let hd1,ar1 = decompose_app_vect t1 and
-        hd2,ar2 = decompose_app_vect t2 in
-    if not (Globnames.is_global (existTconstr()) hd1) then raise Exit;
-    if not (Globnames.is_global (existTconstr()) hd2) then raise Exit;
-    let ind,_ = try pf_apply find_mrectype gl ar1.(0) with Not_found -> raise Exit in
+    let eqTypeDest = fst (decompose_app sigma t) in
+    if not (Termops.is_global sigma (sigTconstr()) eqTypeDest) then raise Exit;
+    let hd1,ar1 = decompose_app_vect sigma t1 and
+        hd2,ar2 = decompose_app_vect sigma t2 in
+    if not (Termops.is_global sigma (existTconstr()) hd1) then raise Exit;
+    if not (Termops.is_global sigma (existTconstr()) hd2) then raise Exit;
+    let (ind, _), _ = try pf_apply find_mrectype gl ar1.(0) with Not_found -> raise Exit in
     (* check if the user has declared the dec principle *)
     (* and compare the fst arguments of the dep pair *)
     (* Note: should work even if not an inductive type, but the table only *)
     (* knows inductive types *)
-    if not (Ind_tables.check_scheme (!eq_dec_scheme_kind_name()) (fst ind) &&
+    if not (Ind_tables.check_scheme (!eq_dec_scheme_kind_name()) ind &&
       pf_apply is_conv gl ar1.(2) ar2.(2)) then raise Exit;
     Coqlib.check_required_library ["Coq";"Logic";"Eqdep_dec"];
     let new_eq_args = [|pf_unsafe_type_of gl ar1.(3);ar1.(3);ar2.(3)|] in
-    let inj2 = Coqlib.coq_constant "inj_pair2_eq_dec is missing"
-      ["Logic";"Eqdep_dec"] "inj_pair2_eq_dec" in
-    let c, eff = find_scheme (!eq_dec_scheme_kind_name()) (Univ.out_punivs ind) in
+    let inj2 = Coqlib.coq_reference "inj_pair2_eq_dec is missing" ["Logic";"Eqdep_dec"]
+                                    "inj_pair2_eq_dec" in
+    let c, eff = find_scheme (!eq_dec_scheme_kind_name()) ind in
     (* cut with the good equality and prove the requested goal *)
     tclTHENLIST
       [Proofview.tclEFFECTS eff;
        intro;
        onLastHyp (fun hyp ->
+        Tacticals.New.pf_constr_of_global Coqlib.glob_eq >>= fun ceq ->
         tclTHENS (cut (mkApp (ceq,new_eq_args)))
-          [clear [destVar hyp];
+          [clear [destVar sigma hyp];
+           Tacticals.New.pf_constr_of_global inj2 >>= fun inj2 ->
            Proofview.V82.tactic (Tacmach.refine
              (mkApp(inj2,[|ar1.(0);mkConst c;ar1.(1);ar1.(2);ar1.(3);ar2.(3);hyp|])))
           ])]
   with Exit ->
     Proofview.tclUNIT ()
-  end }
+  end
 
 (* Given t1=t2 Inj calculates the whd normal forms of t1 and t2 and it
    expands then only when the whdnf has a constructor of an inductive type
@@ -1346,13 +1357,13 @@ let inject_if_homogenous_dependent_pair ty =
 
 let simplify_args env sigma t =
   (* Quick hack to reduce in arguments of eq only *)
-  match decompose_app t with
+  match decompose_app sigma t with
     | eq, [t;c1;c2] -> applist (eq,[t;simpl env sigma c1;simpl env sigma c2])
     | eq, [t1;c1;t2;c2] -> applist (eq,[t1;simpl env sigma c1;t2;simpl env sigma c2])
     | _ -> t
 
 let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
-  let e = next_ident_away eq_baseid (ids_of_context env) in
+  let e = next_ident_away eq_baseid (vars_of_env env) in
   let e_env = push_named (LocalAssum (e,t)) env in
   let evdref = ref sigma in
   let filter (cpath, t1', t2') =
@@ -1361,6 +1372,7 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
       let sigma, (injbody,resty) = build_injector e_env !evdref t1' (mkVar e) cpath in
       let injfun = mkNamedLambda e t injbody in
       let sigma,congr = Evd.fresh_global env sigma eq.congr in
+      let congr = EConstr.of_constr congr in
       let pf = applist(congr,[t;resty;injfun;t1;t2]) in
       let sigma, pf_typ = Typing.type_of env sigma pf in
       let inj_clause = apply_on_clause (pf,pf_typ) eq_clause in
@@ -1383,46 +1395,48 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
          (if l2r then List.rev injectors else injectors)))
       (tac (List.length injectors)))
 
-let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
+let injEqThen keep_proofs tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
   let sigma = eq_clause.evd in
   let env = eq_clause.env in
-  match find_positions env sigma t1 t2 with
+  match find_positions env sigma ~keep_proofs ~no_discr:true t1 t2 with
   | Inl _ ->
-     tclZEROMSG (strbrk"This equality is discriminable. You should use the discriminate tactic to solve the goal.")
+     assert false
   | Inr [] ->
      let suggestion =
-         if !keep_proof_equalities_for_injection then
+         if keep_proofs then
             "" else
             " You can try to use option Set Keep Proof Equalities." in
      tclZEROMSG (strbrk("No information can be deduced from this equality and the injectivity of constructors. This may be because the terms are convertible, or due to pattern matching restrictions in the sort Prop." ^ suggestion))
-  | Inr [([],_,_)] when Flags.version_strictly_greater Flags.V8_3 ->
+  | Inr [([],_,_)] ->
      tclZEROMSG (str"Nothing to inject.")
   | Inr posns ->
       inject_at_positions env sigma l2r u eq_clause posns
 	(tac (clenv_value eq_clause))
 
 let get_previous_hyp_position id gl =
+  let env, sigma = Proofview.Goal.(env gl, sigma gl) in
   let rec aux dest = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
+  | [] -> raise (RefinerError (env, sigma, NoSuchHyp id))
   | d :: right ->
     let hyp = Context.Named.Declaration.get_id d in
     if Id.equal hyp id then dest else aux (MoveAfter hyp) right
   in
-  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
+  aux MoveLast (Proofview.Goal.hyps gl)
 
-let injEq ?(old=false) with_evars clear_flag ipats =
+let injEq flags ?(old=false) with_evars clear_flag ipats =
   (* Decide which compatibility mode to use *)
   let ipats_style, l2r, dft_clear_flag, bounded_intro = match ipats with
-    | None when not old && use_injection_in_context () ->
+    | None when not old && use_injection_in_context flags ->
       Some [], true, true, true
     | None -> None, false, false, false
-    | _ -> let b = use_injection_pattern_l2r_order () in ipats, b, b, b in
+    | _ -> let b = use_injection_pattern_l2r_order flags in ipats, b, b, b in
   (* Built the post tactic depending on compatibility mode *)
   let post_tac c n =
     match ipats_style with
     | Some ipats ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let destopt = match kind_of_term c with
+      Proofview.Goal.enter begin fun gl ->
+        let sigma = project gl in
+        let destopt = match EConstr.kind sigma c with
         | Var id -> get_previous_hyp_position id gl
         | _ -> MoveLast in
         let clear_tac =
@@ -1433,28 +1447,28 @@ let injEq ?(old=false) with_evars clear_flag ipats =
           then intro_patterns_bound_to with_evars n destopt ipats
           else intro_patterns_to with_evars destopt ipats in
         tclTHEN clear_tac intro_tac
-      end }
+      end
     | None -> tclIDTAC in
-  injEqThen post_tac l2r
+  injEqThen (keep_proof_equalities flags) post_tac l2r
 
-let inj ipats with_evars clear_flag = onEquality with_evars (injEq with_evars clear_flag ipats)
+let inj flags ipats with_evars clear_flag = onEquality with_evars (injEq flags with_evars clear_flag ipats)
 
-let injClause ipats with_evars = function
-  | None -> onNegatedEquality with_evars (injEq with_evars None ipats)
-  | Some c -> onInductionArg (inj ipats with_evars) c
+let injClause flags ipats with_evars = function
+  | None -> onNegatedEquality with_evars (injEq flags with_evars None ipats)
+  | Some c -> onInductionArg (inj flags ipats with_evars) c
 
-let simpleInjClause with_evars = function
-  | None -> onNegatedEquality with_evars (injEq ~old:true with_evars None None)
-  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (injEq ~old:true with_evars clear_flag None)) c
+let simpleInjClause flags with_evars = function
+  | None -> onNegatedEquality with_evars (injEq flags ~old:true with_evars None None)
+  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (injEq flags ~old:true with_evars clear_flag None)) c
 
-let injConcl = injClause None false None
-let injHyp clear_flag id = injClause None false (Some (clear_flag,ElimOnIdent (Loc.ghost,id)))
+let injConcl flags = injClause flags None false None
+let injHyp flags clear_flag id = injClause flags None false (Some (clear_flag,ElimOnIdent CAst.(make id)))
 
-let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+let decompEqThen keep_proofs ntac (lbeq,_,(t,t1,t2) as u) clause =
+  Proofview.Goal.enter begin fun gl ->
     let sigma =  clause.evd in
     let env = Proofview.Goal.env gl in
-      match find_positions env sigma t1 t2 with
+      match find_positions env sigma ~keep_proofs ~no_discr:false t1 t2 with
       | Inl (cpath, (_,dirn), _) ->
 	  discr_positions env sigma u clause cpath dirn
       | Inr [] -> (* Change: do not fail, simplify clear this trivial hyp *)
@@ -1462,21 +1476,21 @@ let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
     | Inr posns ->
 	inject_at_positions env sigma true u clause posns
           (ntac (clenv_value clause))
-  end }
+  end
 
-let dEqThen with_evars ntac = function
-  | None -> onNegatedEquality with_evars (decompEqThen (ntac None))
-  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (decompEqThen (ntac clear_flag))) c
+let dEqThen ~keep_proofs with_evars ntac = function
+  | None -> onNegatedEquality with_evars (decompEqThen (use_keep_proofs keep_proofs) (ntac None))
+  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (decompEqThen (use_keep_proofs keep_proofs) (ntac clear_flag))) c
 
-let dEq with_evars =
-  dEqThen with_evars (fun clear_flag c x ->
+let dEq ~keep_proofs with_evars =
+  dEqThen ~keep_proofs with_evars (fun clear_flag c x ->
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c))
 
-let intro_decomp_eq tac data cl =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let cl = pf_apply make_clenv_binding gl cl NoBindings in
-    decompEqThen (fun _ -> tac) data cl
-  end }
+let intro_decomp_eq tac data (c, t) =
+  Proofview.Goal.enter begin fun gl ->
+    let cl = pf_apply make_clenv_binding gl (c, t) NoBindings in
+    decompEqThen !keep_proof_equalities_for_injection (fun _ -> tac) data cl
+  end
 
 let _ = declare_intro_decomp_eq intro_decomp_eq
 
@@ -1512,14 +1526,14 @@ let _ = declare_intro_decomp_eq intro_decomp_eq
 
  *)
 
-let decomp_tuple_term env c t =
+let decomp_tuple_term env sigma c t =
   let rec decomprec inner_code ex exty =
     let iterated_decomp =
     try
-      let ({proj1=p1; proj2=p2}),(i,a,p,car,cdr) = find_sigma_data_decompose ex in
+      let ({proj1=p1; proj2=p2}),(i,a,p,car,cdr) = find_sigma_data_decompose env sigma ex in
       let car_code = applist (mkConstU (destConstRef p1,i),[a;p;inner_code])
       and cdr_code = applist (mkConstU (destConstRef p2,i),[a;p;inner_code]) in
-      let cdrtyp = beta_applist (p,[car]) in
+      let cdrtyp = beta_applist sigma (p,[car]) in
       List.map (fun l -> ((car,a),car_code)::l) (decomprec cdr_code cdr cdrtyp)
     with Constr_matching.PatternMatchingFailure ->
       []
@@ -1527,11 +1541,10 @@ let decomp_tuple_term env c t =
   in decomprec (mkRel 1) c t
 
 let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
-  let sigma = Sigma.to_evar_map sigma in
   let typ = get_type_of env sigma dep_pair1 in
   (* We find all possible decompositions *)
-  let decomps1 = decomp_tuple_term env dep_pair1 typ in
-  let decomps2 = decomp_tuple_term env dep_pair2 typ in
+  let decomps1 = decomp_tuple_term env sigma dep_pair1 typ in
+  let decomps2 = decomp_tuple_term env sigma dep_pair2 typ in
   (* We adjust to the shortest decomposition *)
   let n = min (List.length decomps1) (List.length decomps2) in
   let decomp1 = List.nth decomps1 (n-1) in
@@ -1543,16 +1556,16 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
   (* We build the expected goal *)
   let abst_B =
     List.fold_right
-      (fun (e,t) body -> lambda_create env (t,subst_term e body)) e1_list b in
-  let pred_body = beta_applist(abst_B,proj_list) in
-  let body = mkApp (lambda_create env (typ,pred_body),[|dep_pair1|]) in
-  let expected_goal = beta_applist (abst_B,List.map fst e2_list) in
+      (fun (e,t) body -> lambda_create env sigma (t,subst_term sigma e body)) e1_list b in
+  let pred_body = beta_applist sigma (abst_B,proj_list) in
+  let body = mkApp (lambda_create env sigma (typ,pred_body),[|dep_pair1|]) in
+  let expected_goal = beta_applist sigma (abst_B,List.map fst e2_list) in
   (* Simulate now the normalisation treatment made by Logic.mk_refgoals *)
-  let expected_goal = nf_betaiota sigma expected_goal in
+  let expected_goal = nf_betaiota env sigma expected_goal in
   (* Retype to get universes right *)
   let sigma, expected_goal_ty = Typing.type_of env sigma expected_goal in
   let sigma, _ = Typing.type_of env sigma body in
-  Sigma.Unsafe.of_pair ((body, expected_goal), sigma)
+  (sigma, (body, expected_goal))
 
 (* Like "replace" but decompose dependent equalities                      *)
 (* i.e. if equality is "exists t v = exists u w", and goal is "phi(t,u)", *)
@@ -1560,42 +1573,38 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
 (* on for further iterated sigma-tuples                                   *)
 
 let cutSubstInConcl l2r eqn =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let (lbeq,u,(t,e1,e2)) = find_eq_data_decompose gl eqn in
   let typ = pf_concl gl in
   let (e1,e2) = if l2r then (e1,e2) else (e2,e1) in
-  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
-  let tac =
-  tclTHENFIRST
+  let (sigma, (typ, expected)) = subst_tuple_term env sigma e1 e2 typ in
+  tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (tclTHENFIRST
     (tclTHENLIST [
        (change_concl typ); (* Put in pattern form *)
        (replace_core onConcl l2r eqn)
     ])
-    (change_concl expected) (* Put in normalized form *)
-  in
-  Sigma (tac, sigma, p)
-  end }
+    (change_concl expected)) (* Put in normalized form *)
+  end
 
 let cutSubstInHyp l2r eqn id =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let (lbeq,u,(t,e1,e2)) = find_eq_data_decompose gl eqn in
   let typ = pf_get_hyp_typ id gl in
   let (e1,e2) = if l2r then (e1,e2) else (e2,e1) in
-  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
-  let tac =
-    tclTHENFIRST
+  let (sigma, (typ, expected)) = subst_tuple_term env sigma e1 e2 typ in
+  tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (tclTHENFIRST
     (tclTHENLIST [
        (change_in_hyp None (make_change_arg typ) (id,InHypTypeOnly));
        (replace_core (onHyp id) l2r eqn)
     ])
-    (change_in_hyp None (make_change_arg expected) (id,InHypTypeOnly))
-  in
-  Sigma (tac, sigma, p)
-  end }
+    (change_in_hyp None (make_change_arg expected) (id,InHypTypeOnly)))
+  end
 
 let try_rewrite tac =
   Proofview.tclORELSE tac begin function (e, info) -> match e with
@@ -1617,11 +1626,11 @@ let cutRewriteInHyp l2r eqn id = cutRewriteClause l2r eqn (Some id)
 let cutRewriteInConcl l2r eqn = cutRewriteClause l2r eqn None
 
 let substClause l2r c cls =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let eq = pf_apply get_type_of gl c in
   tclTHENS (cutSubstClause l2r eq cls)
     [Proofview.tclUNIT (); exact_no_check c]
-  end }
+  end
 
 let rewriteClause l2r c cls = try_rewrite (substClause l2r c cls)
 let rewriteInHyp l2r c id = rewriteClause l2r c (Some id)
@@ -1650,8 +1659,7 @@ let regular_subst_tactic = ref true
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "more regular behavior of tactic subst";
       optkey   = ["Regular";"Subst";"Tactic"];
       optread  = (fun () -> !regular_subst_tactic);
@@ -1666,16 +1674,16 @@ exception FoundHyp of (Id.t * constr * bool)
 
 (* tests whether hyp [c] is [x = t] or [t = x], [x] not occurring in [t] *)
 let is_eq_x gl x d =
-  let id = get_id d in
+  let id = NamedDecl.get_id d in
   try
-    let is_var id c = match kind_of_term c with
+    let is_var id c = match EConstr.kind (project gl) c with
     | Var id' -> Id.equal id id'
     | _ -> false
     in
-    let c = pf_nf_evar gl (get_type d) in
+    let c = pf_nf_evar gl (NamedDecl.get_type d) in
     let (_,lhs,rhs) = pi3 (find_eq_data_decompose gl c) in
-    if (is_var x lhs) && not (local_occur_var x rhs) then raise (FoundHyp (id,rhs,true));
-    if (is_var x rhs) && not (local_occur_var x lhs) then raise (FoundHyp (id,lhs,false))
+    if (is_var x lhs) && not (local_occur_var (project gl) x rhs) then raise (FoundHyp (id,rhs,true));
+    if (is_var x rhs) && not (local_occur_var (project gl) x lhs) then raise (FoundHyp (id,lhs,false))
   with Constr_matching.PatternMatchingFailure ->
     ()
 
@@ -1683,16 +1691,17 @@ let is_eq_x gl x d =
    erase hyp and x; proceed by generalizing all dep hyps *)
 
 let subst_one dep_proof_ok x (hyp,rhs,dir) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let sigma = Tacmach.New.project gl in
+  let hyps = Proofview.Goal.hyps gl in
+  let concl = Proofview.Goal.concl gl in
   (* The set of hypotheses using x *)
   let dephyps =
     List.rev (pi3 (List.fold_right (fun dcl (dest,deps,allhyps) ->
-      let id = get_id dcl in
+      let id = NamedDecl.get_id dcl in
       if not (Id.equal id hyp)
-         && List.exists (fun y -> occur_var_in_decl env y dcl) deps
+         && List.exists (fun y -> occur_var_in_decl env sigma y dcl) deps
       then
         let id_dest = if !regular_subst_tactic then dest else MoveLast in
         (dest,id::deps,(id_dest,id)::allhyps)
@@ -1701,7 +1710,7 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
       hyps
       (MoveBefore x,[x],[]))) in (* In practice, no dep hyps before x, so MoveBefore x is good enough *)
   (* Decides if x appears in conclusion *)
-  let depconcl = occur_var env x concl in
+  let depconcl = occur_var env sigma x concl in
   let need_rewrite = not (List.is_empty dephyps) || depconcl in
   tclTHENLIST
     ((if need_rewrite then
@@ -1711,17 +1720,16 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
       else
        [Proofview.tclUNIT ()]) @
      [tclTRY (clear [x; hyp])])
-  end }
+  end
 
 (* Look for an hypothesis hyp of the form "x=rhs" or "rhs=x", rewrite
    it everywhere, and erase hyp and x; proceed by generalizing all dep hyps *)
 
 let subst_one_var dep_proof_ok x =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
-    let xval = pf_get_hyp x gl |> get_value in
+  Proofview.Goal.enter begin fun gl ->
+    let decl = pf_get_hyp x gl in
     (* If x has a body, simply replace x with body and clear x *)
-    if not (Option.is_empty xval) then tclTHEN (unfold_body x) (clear [x]) else
+    if is_local_def decl then tclTHEN (unfold_body x) (clear [x]) else
       (* Find a non-recursive definition for x *)
       let res =
         try
@@ -1729,12 +1737,12 @@ let subst_one_var dep_proof_ok x =
           let hyps = Proofview.Goal.hyps gl in
           let test hyp _ = is_eq_x gl x hyp in
           Context.Named.fold_outside test ~init:() hyps;
-          errorlabstrm "Subst"
-            (str "Cannot find any non-recursive equality over " ++ pr_id x ++
+          user_err ~hdr:"Subst"
+            (str "Cannot find any non-recursive equality over " ++ Id.print x ++
 	       str".")
         with FoundHyp res -> res in
       subst_one dep_proof_ok x res
-  end }
+  end
 
 let subst_gen dep_proof_ok ids =
   tclMAP (subst_one_var dep_proof_ok) ids
@@ -1750,31 +1758,38 @@ type subst_tactic_flags = {
   rewrite_dependent_proof : bool
 }
 
-let default_subst_tactic_flags () =
-  if Flags.version_strictly_greater Flags.V8_2 then
-    { only_leibniz = false; rewrite_dependent_proof = true }
-  else
-    { only_leibniz = true; rewrite_dependent_proof = false }
+let default_subst_tactic_flags =
+  { only_leibniz = false; rewrite_dependent_proof = true }
+
+let warn_deprecated_simple_subst =
+  CWarnings.create ~name:"deprecated-simple-subst" ~category:"deprecated"
+    (fun () -> strbrk"\"simple subst\" is deprecated")
 
-let subst_all ?(flags=default_subst_tactic_flags ()) () =
+let subst_all ?(flags=default_subst_tactic_flags) () =
+
+  let () =
+    if flags.only_leibniz || not flags.rewrite_dependent_proof then
+      warn_deprecated_simple_subst ()
+  in
 
   if !regular_subst_tactic then
 
   (* First step: find hypotheses to treat in linear time *)
   let find_equations gl =
-    let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
+    let sigma = project gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
     let select_equation_name decl =
       try
-        let lbeq,u,(_,x,y) = find_eq_data_decompose (get_type decl) in
+        let lbeq,u,(_,x,y) = find_eq_data_decompose (NamedDecl.get_type decl) in
+        let u = EInstance.kind sigma u in
         let eq = Universes.constr_of_global_univ (lbeq.eq,u) in
         if flags.only_leibniz then restrict_to_eq_and_identity eq;
-        match kind_of_term x, kind_of_term y with
+        match EConstr.kind sigma x, EConstr.kind sigma y with
         | Var z, _  when not (is_evaluable env (EvalVarRef z)) ->
-            Some (get_id decl)
+            Some (NamedDecl.get_id decl)
         | _, Var z when not (is_evaluable env (EvalVarRef z)) ->
-            Some (get_id decl)
+            Some (NamedDecl.get_id decl)
         | _ ->
             None
       with Constr_matching.PatternMatchingFailure -> None
@@ -1785,51 +1800,53 @@ let subst_all ?(flags=default_subst_tactic_flags ()) () =
 
   (* Second step: treat equations *)
   let process hyp =
-    Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+    Proofview.Goal.enter begin fun gl ->
+    let sigma = project gl in
     let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
-    let c = pf_get_hyp hyp gl |> get_type in
+    let c = pf_get_hyp hyp gl |> NamedDecl.get_type in
     let _,_,(_,x,y) = find_eq_data_decompose c in
     (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
-    if Term.eq_constr x y then Proofview.tclUNIT () else
-      match kind_of_term x, kind_of_term y with
-      | Var x', _ when not (occur_term x y) && not (is_evaluable env (EvalVarRef x')) ->
+    if EConstr.eq_constr sigma x y then Proofview.tclUNIT () else
+      match EConstr.kind sigma x, EConstr.kind sigma y with
+      | Var x', _ when not (dependent sigma x y) && not (is_evaluable env (EvalVarRef x')) ->
           subst_one flags.rewrite_dependent_proof x' (hyp,y,true)
-      | _, Var y' when not (occur_term y x) && not (is_evaluable env (EvalVarRef y')) ->
+      | _, Var y' when not (dependent sigma y x) && not (is_evaluable env (EvalVarRef y')) ->
           subst_one flags.rewrite_dependent_proof y' (hyp,x,false)
       | _ ->
           Proofview.tclUNIT ()
-    end }
+    end
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let ids = find_equations gl in
     tclMAP process ids
-  end }
+  end
 
   else
 
 (* Old implementation, not able to manage configurations like a=b, a=t,
    or situations like "a = S b, b = S a", or also accidentally unfolding
    let-ins *)
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   let find_eq_data_decompose = find_eq_data_decompose gl in
   let test (_,c) =
     try
       let lbeq,u,(_,x,y) = find_eq_data_decompose c in
+      let u = EInstance.kind sigma u in
       let eq = Universes.constr_of_global_univ (lbeq.eq,u) in
       if flags.only_leibniz then restrict_to_eq_and_identity eq;
       (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
-      if Term.eq_constr x y then failwith "caught";
-      match kind_of_term x with Var x -> x | _ ->
-      match kind_of_term y with Var y -> y | _ -> failwith "caught"
+      if EConstr.eq_constr sigma x y then failwith "caught";
+      match EConstr.kind sigma x with Var x -> x | _ ->
+      match EConstr.kind sigma y with Var y -> y | _ -> failwith "caught"
     with Constr_matching.PatternMatchingFailure -> failwith "caught" in
   let test p = try Some (test p) with Failure _ -> None in
   let hyps = pf_hyps_types gl in
   let ids = List.map_filter test hyps in
   let ids = List.uniquize ids in
   subst_gen flags.rewrite_dependent_proof ids
-  end }
+  end
 
 (* Rewrite the first assumption for which a condition holds
    and gives the direction of the rewrite *)
@@ -1856,21 +1873,20 @@ let cond_eq_term c t gl =
 
 let rewrite_assumption_cond cond_eq_term cl =
   let rec arec hyps gl = match hyps with
-    | [] -> error "No such assumption."
+    | [] -> user_err Pp.(str "No such assumption.")
     | hyp ::rest ->
-        let id = get_id hyp in
+        let id = NamedDecl.get_id hyp in
 	begin
 	  try
-            let dir = cond_eq_term (get_type hyp) gl in
+            let dir = cond_eq_term (NamedDecl.get_type hyp) gl in
 	    general_rewrite_clause dir false (mkVar id,NoBindings) cl
 	  with | Failure _ | UserError _ -> arec rest gl
 	end
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.lift gl Sigma.Unsafe.le in
+  Proofview.Goal.enter begin fun gl ->
     let hyps = Proofview.Goal.hyps gl in
     arec hyps gl
-  end }
+  end
 
 (* Generalize "subst x" to substitution of subterm appearing as an
    equation in the context, but not clearing the hypothesis *)
diff --git a/tactics/equality.mli b/tactics/equality.mli
index 47cb6b82..c0be917a 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (*i*)
 open Names
-open Term
 open Evd
+open EConstr
 open Environ
-open Tacexpr
 open Ind_tables
 open Locus
 open Misctypes
+open Tactypes
 (*i*)
 
 type dep_proof_flag = bool (* true = support rewriting dependent proofs *)
@@ -67,23 +69,31 @@ val replace_in_clause_maybe_by : constr -> constr -> clause -> unit Proofview.ta
 val replace    : constr -> constr -> unit Proofview.tactic
 val replace_by : constr -> constr -> unit Proofview.tactic -> unit Proofview.tactic
 
+type inj_flags = {
+    keep_proof_equalities : bool; (* One may want it or not *)
+    injection_in_context : bool;  (* For regularity; one may want it from ML code but not interactively *)
+    injection_pattern_l2r_order : bool; (* Compatibility option: no reason not to want it *)
+  }
+
 val discr        : evars_flag -> constr with_bindings -> unit Proofview.tactic
 val discrConcl   : unit Proofview.tactic
 val discrHyp     : Id.t -> unit Proofview.tactic
 val discrEverywhere : evars_flag -> unit Proofview.tactic
 val discr_tac    : evars_flag ->
   constr with_bindings destruction_arg option -> unit Proofview.tactic
-val inj          : intro_patterns option -> evars_flag ->
+
+(* Below, if flag is [None], it takes the value from the dynamic value of the option *)
+val inj          : inj_flags option -> intro_patterns option -> evars_flag ->
   clear_flag -> constr with_bindings -> unit Proofview.tactic
-val injClause    : intro_patterns option -> evars_flag ->
+val injClause    : inj_flags option -> intro_patterns option -> evars_flag ->
   constr with_bindings destruction_arg option -> unit Proofview.tactic
-val injHyp       : clear_flag -> Id.t -> unit Proofview.tactic
-val injConcl     : unit Proofview.tactic
-val simpleInjClause : evars_flag ->
+val injHyp       : inj_flags option -> clear_flag -> Id.t -> unit Proofview.tactic
+val injConcl     : inj_flags option -> unit Proofview.tactic
+val simpleInjClause : inj_flags option -> evars_flag ->
   constr with_bindings destruction_arg option -> unit Proofview.tactic
 
-val dEq : evars_flag -> constr with_bindings destruction_arg option -> unit Proofview.tactic
-val dEqThen : evars_flag -> (clear_flag -> constr -> int -> unit Proofview.tactic) -> constr with_bindings destruction_arg option -> unit Proofview.tactic
+val dEq : keep_proofs:(bool option) -> evars_flag -> constr with_bindings destruction_arg option -> unit Proofview.tactic
+val dEqThen : keep_proofs:(bool option) -> evars_flag -> (clear_flag -> constr -> int -> unit Proofview.tactic) -> constr with_bindings destruction_arg option -> unit Proofview.tactic
 
 val make_iterated_tuple :
   env -> evar_map -> constr -> (constr * types) -> evar_map * (constr * constr * constr)
@@ -96,8 +106,11 @@ val cutRewriteInConcl : bool -> constr -> unit Proofview.tactic
 val rewriteInHyp : bool -> constr -> Id.t -> unit Proofview.tactic
 val rewriteInConcl : bool -> constr -> unit Proofview.tactic
 
+(* Tells if tactic "discriminate" is applicable *)
 val discriminable : env -> evar_map -> constr -> constr -> bool
-val injectable : env -> evar_map -> constr -> constr -> bool
+
+(* Tells if tactic "injection" is applicable *)
+val injectable : env -> evar_map -> keep_proofs:(bool option) -> constr -> constr -> bool
 
 (* Subst *)
 
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 9a96b738..500abc5b 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -1,17 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open Util
 open CErrors
 open Names
-open Vars
 open Term
+open Evd
+open EConstr
+open Vars
 open Environ
 open Mod_subst
 open Globnames
@@ -20,45 +24,49 @@ open Namegen
 open Libnames
 open Smartlocate
 open Misctypes
-open Evd
 open Termops
 open Inductiveops
 open Typing
-open Tacexpr
 open Decl_kinds
 open Pattern
 open Patternops
 open Clenv
-open Pfedit
 open Tacred
 open Printer
 open Vernacexpr
-open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (****************************************)
 (* General functions                    *)
 (****************************************)
 
-exception Bound
+type debug = Debug | Info | Off
 
-let head_constr_bound t =
-  let t = strip_outer_cast t in
-  let _,ccl = decompose_prod_assum t in
-  let hd,args = decompose_app ccl in
-  match kind_of_term hd with
-    | Const _ | Ind _ | Construct _ | Var _ -> hd
-    | Proj (p, _) -> mkConst (Projection.constant p)
-    | _ -> raise Bound
-
-let head_constr c =
-  try head_constr_bound c with Bound -> error "Bound head variable."
+exception Bound
 
-let decompose_app_bound t =
-  let t = strip_outer_cast t in
-  let _,ccl = decompose_prod_assum t in
-  let hd,args = decompose_app_vect ccl in
-  match kind_of_term hd with
+let head_constr_bound sigma t =
+  let t = strip_outer_cast sigma t in
+  let _,ccl = decompose_prod_assum sigma t in
+  let hd,args = decompose_app sigma ccl in
+  match EConstr.kind sigma hd with
+  | Const (c, _) -> ConstRef c
+  | Ind (i, _) -> IndRef i
+  | Construct (c, _) -> ConstructRef c
+  | Var id -> VarRef id
+  | Proj (p, _) -> ConstRef (Projection.constant p)
+  | _ -> raise Bound
+
+let head_constr sigma c =
+  try head_constr_bound sigma c
+  with Bound -> user_err (Pp.str "Head identifier must be a constant, section variable, \
+                                  (co)inductive type, (co)inductive type constructor, or projection.")
+
+let decompose_app_bound sigma t =
+  let t = strip_outer_cast sigma t in
+  let _,ccl = decompose_prod_assum sigma t in
+  let hd,args = decompose_app_vect sigma ccl in
+  match EConstr.kind sigma hd with
     | Const (c,u) -> ConstRef c, args
     | Ind (i,u) -> IndRef i, args
     | Construct (c,u) -> ConstructRef c, args
@@ -71,6 +79,7 @@ let decompose_app_bound t =
     different declaration between the named hyps and the section context. *)
 let secvars_of_hyps hyps =
   let secctx = Global.named_context () in
+  let open Context.Named.Declaration in
   let pred, all =
     List.fold_left (fun (pred,all) decl ->
         try let _ = Context.Named.lookup (get_id decl) hyps in
@@ -121,14 +130,14 @@ type hints_path = global_reference hints_path_gen
 
 type hint_term =
   | IsGlobRef of global_reference
-  | IsConstr of constr * Univ.universe_context_set
+  | IsConstr of constr * Univ.ContextSet.t
 
 type 'a with_uid = {
   obj : 'a;
   uid : KerName.t;
 }
 
-type raw_hint = constr * types * Univ.universe_context_set
+type raw_hint = constr * types * Univ.ContextSet.t
 
 type hint = (raw_hint * clausenv) hint_ast with_uid
 
@@ -159,12 +168,11 @@ let write_warn_hint = function
 | "Lax" -> warn_hint := `LAX
 | "Warn" -> warn_hint := `WARN
 | "Strict" -> warn_hint := `STRICT
-| _ -> error "Only the following flags are accepted: Lax, Warn, Strict."
+| _ -> user_err Pp.(str "Only the following flags are accepted: Lax, Warn, Strict.")
 
 let _ =
   Goptions.declare_string_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "behavior of non-imported hints";
       Goptions.optkey   = ["Loose"; "Hint"; "Behavior"];
       Goptions.optread  = read_warn_hint;
@@ -251,8 +259,8 @@ let rebuild_dn st se =
   in
   { se with sentry_bnet = dn' }
 
-let lookup_tacs concl st se =
-  let l'  = Bounded_net.lookup st se.sentry_bnet concl in
+let lookup_tacs sigma concl st se =
+  let l'  = Bounded_net.lookup sigma st se.sentry_bnet concl in
   let sl' = List.stable_sort pri_order_int l' in
   List.merge pri_order_int se.sentry_nopat sl'
 
@@ -263,10 +271,10 @@ let is_transparent_gr (ids, csts) = function
   | ConstRef cst -> Cpred.mem cst csts
   | IndRef _ | ConstructRef _ -> false
 
-let strip_params env c = 
-  match kind_of_term c with
+let strip_params env sigma c = 
+  match EConstr.kind sigma c with
   | App (f, args) -> 
-    (match kind_of_term f with
+    (match EConstr.kind sigma f with
     | Const (p,_) ->
       let cb = lookup_constant p env in
 	(match cb.Declarations.const_proj with
@@ -285,7 +293,7 @@ let instantiate_hint env sigma p =
     let sigma = Evd.merge_context_set univ_flexible sigma ctx in
     let cl = mk_clenv_from_env env sigma None (c,cty) in 
       {cl with templval = 
-	  { cl.templval with rebus = strip_params env cl.templval.rebus };
+	  { cl.templval with rebus = strip_params env sigma cl.templval.rebus };
 	env = empty_env}
   in
   let code = match p.code.obj with
@@ -469,11 +477,11 @@ val empty : ?name:hint_db_name -> transparent_state -> bool -> t
 val find : global_reference -> t -> search_entry
 val map_none : secvars:Id.Pred.t -> t -> full_hint list
 val map_all : secvars:Id.Pred.t -> global_reference -> t -> full_hint list
-val map_existential : secvars:Id.Pred.t ->
+val map_existential : evar_map -> secvars:Id.Pred.t ->
 		      (global_reference * constr array) -> constr -> t -> full_hint list
-val map_eauto : secvars:Id.Pred.t ->
+val map_eauto : evar_map -> secvars:Id.Pred.t ->
 		(global_reference * constr array) -> constr -> t -> full_hint list
-val map_auto : secvars:Id.Pred.t ->
+val map_auto : evar_map -> secvars:Id.Pred.t ->
 	       (global_reference * constr array) -> constr -> t -> full_hint list
 val add_one : env -> evar_map -> hint_entry -> t -> t
 val add_list : env -> evar_map -> hint_entry list -> t -> t
@@ -529,21 +537,32 @@ struct
       (** Warn about no longer typable hint? *)
       None
 
-  let match_mode m arg =
+  let head_evar sigma c =
+    let rec hrec c = match EConstr.kind sigma c with
+      | Evar (evk,_)   -> evk
+      | Case (_,_,c,_) -> hrec c
+      | App (c,_)      -> hrec c
+      | Cast (c,_,_)   -> hrec c
+      | Proj (p, c)    -> hrec c
+      | _              -> raise Evarutil.NoHeadEvar
+    in
+    hrec c
+
+  let match_mode sigma m arg =
     match m with
-    | ModeInput -> not (occur_existential arg)
+    | ModeInput -> not (occur_existential sigma arg)
     | ModeNoHeadEvar ->
-       Evarutil.(try ignore(head_evar arg); false
-                 with NoHeadEvar -> true)
+       (try ignore(head_evar sigma arg); false
+                 with Evarutil.NoHeadEvar -> true)
     | ModeOutput -> true
                                
-  let matches_mode args mode =
+  let matches_mode sigma args mode =
     Array.length mode == Array.length args &&
-      Array.for_all2 match_mode mode args
+      Array.for_all2 (match_mode sigma) mode args
       
-  let matches_modes args modes =
+  let matches_modes sigma args modes =
     if List.is_empty modes then true
-    else List.exists (matches_mode args) modes
+    else List.exists (matches_mode sigma args) modes
 
   let merge_entry secvars db nopat pat =
     let h = List.sort pri_order_int (List.map snd db.hintdb_nopat) in
@@ -559,24 +578,24 @@ struct
     merge_entry secvars db se.sentry_nopat se.sentry_pat
 	
   (** Precondition: concl has no existentials *)
-  let map_auto ~secvars (k,args) concl db =
+  let map_auto sigma ~secvars (k,args) concl db =
     let se = find k db in
     let st = if db.use_dn then  (Some db.hintdb_state) else None in
-    let pat = lookup_tacs concl st se in
+    let pat = lookup_tacs sigma concl st se in
     merge_entry secvars db [] pat
 
-  let map_existential ~secvars (k,args) concl db =
+  let map_existential sigma ~secvars (k,args) concl db =
     let se = find k db in
-      if matches_modes args se.sentry_mode then
+      if matches_modes sigma args se.sentry_mode then
         merge_entry secvars db se.sentry_nopat se.sentry_pat
       else merge_entry secvars db [] []
 
   (* [c] contains an existential *)
-  let map_eauto ~secvars (k,args) concl db =
+  let map_eauto sigma ~secvars (k,args) concl db =
     let se = find k db in
-      if matches_modes args se.sentry_mode then
+      if matches_modes sigma args se.sentry_mode then
         let st = if db.use_dn then Some db.hintdb_state else None in
-        let pat = lookup_tacs concl st se in
+        let pat = lookup_tacs sigma concl st se in
         merge_entry secvars db [] pat
       else merge_entry secvars db [] []
 
@@ -716,7 +735,7 @@ let current_db () = Hintdbmap.bindings !searchtable
 let current_pure_db () = List.map snd (current_db ())
 
 let error_no_such_hint_database x =
-  errorlabstrm "Hints" (str "No such Hint database: " ++ str x ++ str ".")
+  user_err ~hdr:"Hints" (str "No such Hint database: " ++ str x ++ str ".")
 
 (**************************************************************************)
 (*                       Definition of the summary                        *)
@@ -741,15 +760,17 @@ let _ = Summary.declare_summary "search"
 (*             Auxiliary functions to prepare AUTOHINT objects            *)
 (**************************************************************************)
 
-let rec nb_hyp c = match kind_of_term c with
-  | Prod(_,_,c2) -> if noccurn 1 c2 then 1+(nb_hyp c2) else nb_hyp c2
+let rec nb_hyp sigma c = match EConstr.kind sigma c with
+  | Prod(_,_,c2) -> if noccurn sigma 1 c2 then 1+(nb_hyp sigma c2) else nb_hyp sigma c2
   | _ -> 0
 
 (* adding and removing tactics in the search table *)
 
 let try_head_pattern c =
   try head_pattern_bound c
-  with BoundPattern -> error "Bound head variable."
+  with BoundPattern ->
+    user_err (Pp.str "Head pattern or sub-pattern must be a global constant, a section variable, \
+                      an if, case, or let expression, an application, or a projection.")
 
 let with_uid c = { obj = c; uid = fresh_key () }
 
@@ -759,19 +780,19 @@ let secvars_of_idset s =
         Id.Pred.add id p
       else p) s Id.Pred.empty
 
-let secvars_of_constr env c =
-  secvars_of_idset (global_vars_set env c)
+let secvars_of_constr env sigma c =
+  secvars_of_idset (Termops.global_vars_set env sigma c)
 
 let secvars_of_global env gr =
   secvars_of_idset (vars_of_global_reference env gr)
 
 let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) =
-  let secvars = secvars_of_constr env c in
-  let cty = strip_outer_cast cty in
-    match kind_of_term cty with
+  let secvars = secvars_of_constr env sigma c in
+  let cty = strip_outer_cast sigma cty in
+    match EConstr.kind sigma cty with
     | Prod _ -> failwith "make_exact_entry"
     | _ ->
-	let pat = Patternops.pattern_of_constr env sigma cty in
+	let pat = Patternops.pattern_of_constr env sigma (EConstr.to_constr sigma cty) in
 	let hd =
 	  try head_pattern_bound pat
 	  with BoundPattern -> failwith "make_exact_entry"
@@ -788,38 +809,48 @@ let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) =
 
 let make_apply_entry env sigma (eapply,hnf,verbose) info poly ?(name=PathAny) (c, cty, ctx) =
   let cty = if hnf then hnf_constr env sigma cty else cty in
-    match kind_of_term cty with
-    | Prod _ ->
-        let sigma' = Evd.merge_context_set univ_flexible sigma ctx in
-        let ce = mk_clenv_from_env env sigma' None (c,cty) in
-	let c' = clenv_type (* ~reduce:false *) ce in
-	let pat = Patternops.pattern_of_constr env ce.evd c' in
-        let hd =
-	  try head_pattern_bound pat
-          with BoundPattern -> failwith "make_apply_entry" in
-        let nmiss = List.length (clenv_missing ce) in
-        let secvars = secvars_of_constr env c in
-	let pri = match info.hint_priority with None -> nb_hyp cty + nmiss | Some p -> p in
-	let pat = match info.hint_pattern with
-	| Some p -> snd p | None -> pat
-	in
-	if Int.equal nmiss 0 then
-	  (Some hd,
-          { pri; poly; pat = Some pat; name;
-            db = None;
-            secvars;
-            code = with_uid (Res_pf(c,cty,ctx)); })
-	else begin
-	  if not eapply then failwith "make_apply_entry";
-          if verbose then
-	    Feedback.msg_info (str "the hint: eapply " ++ pr_lconstr c ++
-	    str " will only be used by eauto");
-          (Some hd,
-           { pri; poly; pat = Some pat; name;
-	     db = None; secvars;
-             code = with_uid (ERes_pf(c,cty,ctx)); })
-        end
-    | _ -> failwith "make_apply_entry"
+  match EConstr.kind sigma cty with
+  | Prod _ ->
+    let sigma' = Evd.merge_context_set univ_flexible sigma ctx in
+    let ce = mk_clenv_from_env env sigma' None (c,cty) in
+    let c' = clenv_type (* ~reduce:false *) ce in
+    let pat = Patternops.pattern_of_constr env ce.evd (EConstr.to_constr sigma c') in
+    let hd =
+      try head_pattern_bound pat
+      with BoundPattern -> failwith "make_apply_entry" in
+    let miss = clenv_missing ce in
+    let nmiss = List.length (clenv_missing ce) in
+    let secvars = secvars_of_constr env sigma c in
+    let pri = match info.hint_priority with None -> nb_hyp sigma' cty + nmiss | Some p -> p in
+    let pat = match info.hint_pattern with
+      | Some p -> snd p | None -> pat
+    in
+    if Int.equal nmiss 0 then
+      (Some hd,
+       { pri; poly; pat = Some pat; name;
+         db = None;
+         secvars;
+         code = with_uid (Res_pf(c,cty,ctx)); })
+    else begin
+      if not eapply then failwith "make_apply_entry";
+      if verbose then begin
+        let variables = str (CString.plural nmiss "variable") in
+        Feedback.msg_info (
+          strbrk "The hint " ++
+          pr_leconstr_env env sigma' c ++
+          strbrk " will only be used by eauto, because applying " ++
+          pr_leconstr_env env sigma' c ++
+          strbrk " would leave " ++ variables ++ Pp.spc () ++
+          Pp.prlist_with_sep Pp.pr_comma Name.print (List.map (Evd.meta_name ce.evd) miss) ++
+          strbrk " as unresolved existential " ++ variables ++ str "."
+        )
+      end;
+      (Some hd,
+       { pri; poly; pat = Some pat; name;
+         db = None; secvars;
+         code = with_uid (ERes_pf(c,cty,ctx)); })
+    end
+  | _ -> failwith "make_apply_entry"
 
 (* flags is (e,h,v) with e=true if eapply and h=true if hnf and v=true if verbose
    c is a constr
@@ -829,7 +860,7 @@ let pr_hint_term env sigma ctx = function
   | IsGlobRef gr -> pr_global gr
   | IsConstr (c, ctx) ->
      let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
-     pr_constr_env env sigma c
+     pr_econstr_env env sigma c
 
 (** We need an object to record the side-effect of registering
   global universes associated with a hint. *)
@@ -855,7 +886,8 @@ let fresh_global_or_constr env sigma poly cr =
   let isgr, (c, ctx) =
     match cr with
     | IsGlobRef gr ->
-       true, Universes.fresh_global_instance env gr
+      let (c, ctx) = Universes.fresh_global_instance env gr in
+       true, (EConstr.of_constr c, ctx)
     | IsConstr (c, ctx) -> false, (c, ctx)
   in
     if poly then (c, ctx)
@@ -877,23 +909,23 @@ let make_resolves env sigma flags info poly ?name cr =
 			      make_apply_entry env sigma flags info poly ?name]
   in
   if List.is_empty ents then
-    errorlabstrm "Hint"
-      (pr_lconstr c ++ spc() ++
+    user_err ~hdr:"Hint"
+      (pr_leconstr_env env sigma c ++ spc() ++
         (if pi1 flags then str"cannot be used as a hint."
 	else str "can be used as a hint only for eauto."));
   ents
 
 (* used to add an hypothesis to the local hint database *)
 let make_resolve_hyp env sigma decl =
-  let hname = get_id decl in
+  let hname = NamedDecl.get_id decl in
   let c = mkVar hname in
   try
     [make_apply_entry env sigma (true, true, false) empty_hint_info false
        ~name:(PathHints [VarRef hname])
-       (c, get_type decl, Univ.ContextSet.empty)]
+       (c, NamedDecl.get_type decl, Univ.ContextSet.empty)]
   with
     | Failure _ -> []
-    | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp")
+    | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp.")
 
 (* REM : in most cases hintname = id *)
 
@@ -909,7 +941,6 @@ let make_unfold eref =
      code = with_uid (Unfold_nth eref) })
 
 let make_extern pri pat tacast =
-  let tacast = Genarg.in_gen (Genarg.glbwit Constrarg.wit_ltac) tacast in
   let hdconstr = Option.map try_head_pattern pat in
   (hdconstr,
    { pri = pri;
@@ -921,12 +952,13 @@ let make_extern pri pat tacast =
      code = with_uid (Extern tacast) })  
 
 let make_mode ref m = 
-  let ty = Global.type_of_global_unsafe ref in
+  let open Term in
+  let ty, _ = Global.type_of_global_in_context (Global.env ()) ref in
   let ctx, t = decompose_prod ty in
   let n = List.length ctx in
   let m' = Array.of_list m in
     if not (n == Array.length m') then
-      errorlabstrm "Hint"
+      user_err ~hdr:"Hint"
 	(pr_global ref ++ str" has " ++ int n ++ 
 	   str" arguments while the mode declares " ++ int (Array.length m'))
     else m'
@@ -935,14 +967,14 @@ let make_trivial env sigma poly ?(name=PathAny) r =
   let c,ctx = fresh_global_or_constr env sigma poly r in
   let sigma = Evd.merge_context_set univ_flexible sigma ctx in
   let t = hnf_constr env sigma (unsafe_type_of env sigma c) in
-  let hd = head_of_constr_reference (head_constr t) in
+  let hd = head_constr sigma t in
   let ce = mk_clenv_from_env env sigma None (c,t) in
   (Some hd, { pri=1;
 	      poly = poly;
-              pat = Some (Patternops.pattern_of_constr env ce.evd (clenv_type ce));
+              pat = Some (Patternops.pattern_of_constr env ce.evd (EConstr.to_constr sigma (clenv_type ce)));
 	      name = name;
               db = None;
-              secvars = secvars_of_constr env c;
+              secvars = secvars_of_constr env sigma c;
               code= with_uid (Res_pf_THEN_trivial_fail(c,t,ctx)) })
 
 
@@ -961,8 +993,8 @@ let get_db dbname =
 let add_hint dbname hintlist =
   let check (_, h) =
     let () = if KNmap.mem h.code.uid !statustable then
-      error "Conflicting hint keys. This can happen when including \
-      twice the same module."
+      user_err Pp.(str "Conflicting hint keys. This can happen when including \
+      twice the same module.")
     in
     statustable := KNmap.add h.code.uid false !statustable
   in
@@ -1036,14 +1068,16 @@ let cache_autohint (kn, obj) =
 let subst_autohint (subst, obj) =
   let subst_key gr =
     let (lab'', elab') = subst_global subst gr in
+    let elab' = EConstr.of_constr elab' in
     let gr' =
-      (try head_of_constr_reference (head_constr_bound elab')
+      (try head_constr_bound Evd.empty elab'
        with Bound -> lab'')
     in if gr' == gr then gr else gr'
   in
   let subst_hint (k,data as hint) =
     let k' = Option.smartmap subst_key k in
     let pat' = Option.smartmap (subst_pattern subst) data.pat in
+    let subst_mps subst c = EConstr.of_constr (subst_mps subst (EConstr.Unsafe.to_constr c)) in
     let code' = match data.code.obj with
       | Res_pf (c,t,ctx) ->
           let c' = subst_mps subst c in
@@ -1136,7 +1170,7 @@ let add_resolves env sigma clist local dbnames =
     (fun dbname ->
       let r =
         List.flatten (List.map (fun (pri, poly, hnf, path, gr) ->
-          make_resolves env sigma (true,hnf,Flags.is_verbose()) 
+          make_resolves env sigma (true,hnf,not !Flags.quiet)
             pri poly ~name:path gr) clist)
       in
       let hint = make_hint ~local dbname (AddHints r) in
@@ -1192,8 +1226,6 @@ let add_trivials env sigma l local dbnames =
       Lib.add_anonymous_leaf (inAutoHint hint))
     dbnames
 
-let (forward_intern_tac, extern_intern_tac) = Hook.make ()
-
 type hnf = bool
 
 type hint_info = (patvar list * constr_pattern) hint_info_gen
@@ -1205,7 +1237,7 @@ type hints_entry =
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
   | HintsModeEntry of global_reference * hint_mode list
-  | HintsExternEntry of hint_info * glob_tactic_expr
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 let default_prepare_hint_ident = Id.of_string "H"
 
@@ -1216,30 +1248,30 @@ let prepare_hint check (poly,local) env init (sigma,c) =
   (* We re-abstract over uninstantiated evars and universes.
      It is actually a bit stupid to generalize over evars since the first
      thing make_resolves will do is to re-instantiate the products *)
-  let sigma, subst = Evd.nf_univ_variables sigma in
-  let c = Vars.subst_univs_constr subst (Evarutil.nf_evar sigma c) in
-  let c = drop_extra_implicit_args c in
-  let vars = ref (collect_vars c) in
+  let sigma, _ = Evd.nf_univ_variables sigma in
+  let c = Evarutil.nf_evar sigma c in
+  let c = drop_extra_implicit_args sigma c in
+  let vars = ref (collect_vars sigma c) in
   let subst = ref [] in
-  let rec find_next_evar c = match kind_of_term c with
+  let rec find_next_evar c = match EConstr.kind sigma c with
     | Evar (evk,args as ev) ->
       (* We skip the test whether args is the identity or not *)
       let t = Evarutil.nf_evar sigma (existential_type sigma ev) in
-      let t = List.fold_right (fun (e,id) c -> replace_term e id c) !subst t in
-      if not (closed0 c) then
-	error "Hints with holes dependent on a bound variable not supported.";
-      if occur_existential t then
+      let t = List.fold_right (fun (e,id) c -> replace_term sigma e id c) !subst t in
+      if not (closed0 sigma c) then
+	user_err Pp.(str "Hints with holes dependent on a bound variable not supported.");
+      if occur_existential sigma t then
 	(* Not clever enough to construct dependency graph of evars *)
-	error "Not clever enough to deal with evars dependent in other evars.";
+	user_err Pp.(str "Not clever enough to deal with evars dependent in other evars.");
       raise (Found (c,t))
-    | _ -> Constr.iter find_next_evar c in
+    | _ -> EConstr.iter sigma find_next_evar c in
   let rec iter c =
     try find_next_evar c; c
     with Found (evar,t) ->
       let id = next_ident_away_from default_prepare_hint_ident (fun id -> Id.Set.mem id !vars) in
       vars := Id.Set.add id !vars;
       subst := (evar,mkVar id)::!subst;
-      mkNamedLambda id t (iter (replace_term evar (mkVar id) c)) in
+      mkNamedLambda id t (iter (replace_term sigma evar (mkVar id) c)) in
   let c' = iter c in
     if check then Pretyping.check_evars (Global.env()) Evd.empty sigma c';
     let diff = Univ.ContextSet.diff (Evd.universe_context_set sigma) (Evd.universe_context_set init) in
@@ -1250,18 +1282,16 @@ let prepare_hint check (poly,local) env init (sigma,c) =
 
 let interp_hints poly =
   fun h ->
-  let env = (Global.env()) in
+  let env = Global.env () in
   let sigma = Evd.from_env env in
   let f poly c =
     let evd,c = Constrintern.interp_open_constr env sigma c in
       prepare_hint true (poly,false) (Global.env()) Evd.empty (evd,c) in
   let fref r =
     let gr = global_with_alias r in
-    Dumpglob.add_glob (loc_of_reference r) gr;
+    Dumpglob.add_glob ?loc:r.CAst.loc gr;
     gr in
-  let fr r = 
-    evaluable_of_global_reference (Global.env()) (fref r)
-  in
+  let fr r = evaluable_of_global_reference env (fref r) in
   let fi c =
     match c with
     | HintsReference c ->
@@ -1269,7 +1299,7 @@ let interp_hints poly =
 	(PathHints [gr], poly, IsGlobRef gr)
     | HintsConstr c -> (PathAny, poly, f poly c)
   in
-  let fp = Constrintern.intern_constr_pattern (Global.env()) in
+  let fp = Constrintern.intern_constr_pattern env sigma in
   let fres (info, b, r) =
     let path, poly, gr = fi r in
     let info = { info with hint_pattern = Option.map fp info.hint_pattern } in
@@ -1286,22 +1316,25 @@ let interp_hints poly =
       let constr_hints_of_ind qid =
         let ind = global_inductive_with_alias qid in
 	let mib,_ = Global.lookup_inductive ind in
-	Dumpglob.dump_reference (fst (qualid_of_reference qid)) "<>" (string_of_reference qid) "ind";
+        Dumpglob.dump_reference ?loc:qid.CAst.loc "<>" (string_of_reference qid) "ind";
           List.init (nconstructors ind) 
 	    (fun i -> let c = (ind,i+1) in
 		      let gr = ConstructRef c in
-			empty_hint_info, mib.Declarations.mind_polymorphic, true,
+			empty_hint_info, 
+                        (Declareops.inductive_is_polymorphic mib), true,
 			PathHints [gr], IsGlobRef gr)
       in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid))
   | HintsExtern (pri, patcom, tacexp) ->
       let pat =	Option.map fp patcom in
       let l = match pat with None -> [] | Some (l, _) -> l in
-      let tacexp = Hook.get forward_intern_tac l tacexp in
+      let ltacvars = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
+      let env = Genintern.({ (empty_glob_sign env) with ltacvars }) in
+      let _, tacexp = Genintern.generic_intern env tacexp in
       HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp)
 
 let add_hints local dbnames0 h =
   if String.List.mem "nocore" dbnames0 then
-    error "The hint database \"nocore\" is meant to stay empty.";
+    user_err Pp.(str "The hint database \"nocore\" is meant to stay empty.");
   let dbnames = if List.is_empty dbnames0 then ["core"] else dbnames0 in
   let env = Global.env() in
   let sigma = Evd.from_env env in
@@ -1318,7 +1351,7 @@ let add_hints local dbnames0 h =
 
 let expand_constructor_hints env sigma lems =
   List.map_append (fun (evd,lem) ->
-    match kind_of_term lem with
+    match EConstr.kind sigma lem with
     | Ind (ind,u) ->
 	List.init (nconstructors ind) 
 		  (fun i ->
@@ -1342,13 +1375,9 @@ let add_hint_lemmas env sigma eapply lems hint_db =
   Hint_db.add_list env sigma hintlist' hint_db
 
 let make_local_hint_db env sigma ts eapply lems =
-  let map c =
-    let sigma = Sigma.Unsafe.of_evar_map sigma in
-    let Sigma (c, sigma, _) = c.delayed env sigma in
-    (Sigma.to_evar_map sigma, c)
-  in
+  let map c = c env sigma in
   let lems = List.map map lems in
-  let sign = Environ.named_context env in
+  let sign = EConstr.named_context env in
   let ts = match ts with
     | None -> Hint_db.transparent_state (searchtable_map "core") 
     | Some ts -> ts
@@ -1373,42 +1402,37 @@ let make_db_list dbnames =
 (*                    Functions for printing the hints                    *)
 (**************************************************************************)
 
-let pr_hint_elt (c, _, _) = pr_constr c
+let pr_hint_elt env sigma (c, _, _) = pr_econstr_env env sigma c
 
-let pr_hint h = match h.obj with
-  | Res_pf (c, _) -> (str"simple apply " ++ pr_hint_elt c)
-  | ERes_pf (c, _) -> (str"simple eapply " ++ pr_hint_elt c)
-  | Give_exact (c, _) -> (str"exact " ++ pr_hint_elt c)
+let pr_hint env sigma h = match h.obj with
+  | Res_pf (c, _) -> (str"simple apply " ++ pr_hint_elt env sigma c)
+  | ERes_pf (c, _) -> (str"simple eapply " ++ pr_hint_elt env sigma c)
+  | Give_exact (c, _) -> (str"exact " ++ pr_hint_elt env sigma c)
   | Res_pf_THEN_trivial_fail (c, _) ->
-      (str"simple apply " ++ pr_hint_elt c ++ str" ; trivial")
-  | Unfold_nth c -> (str"unfold " ++  pr_evaluable_reference c)
+      (str"simple apply " ++ pr_hint_elt env sigma c ++ str" ; trivial")
+  | Unfold_nth c ->
+    str"unfold " ++  pr_evaluable_reference c
   | Extern tac ->
-      let env =
-        try
-          let (_, env) = Pfedit.get_current_goal_context () in
-          env
-        with e when CErrors.noncritical e -> Global.env ()
-      in
-      (str "(*external*) " ++ Pptactic.pr_glb_generic env tac)
+    str "(*external*) " ++ Pputils.pr_glb_generic env tac
 
-let pr_id_hint (id, v) =
-  let pr_pat p = str", pattern " ++ pr_lconstr_pattern p in
-  (pr_hint v.code ++ str"(level " ++ int v.pri ++ pr_opt_no_spc pr_pat v.pat
+let pr_id_hint env sigma (id, v) =
+  let pr_pat p = str", pattern " ++ pr_lconstr_pattern_env env sigma p in
+  (pr_hint env sigma v.code ++ str"(level " ++ int v.pri ++ pr_opt_no_spc pr_pat v.pat
    ++ str", id " ++ int id ++ str ")" ++ spc ())
 
-let pr_hint_list hintlist =
-  (str "  " ++ hov 0 (prlist pr_id_hint hintlist) ++ fnl ())
+let pr_hint_list env sigma hintlist =
+  (str "  " ++ hov 0 (prlist (pr_id_hint env sigma) hintlist) ++ fnl ())
 
-let pr_hints_db (name,db,hintlist) =
+let pr_hints_db env sigma (name,db,hintlist) =
   (str "In the database " ++ str name ++ str ":" ++
      if List.is_empty hintlist then (str " nothing" ++ fnl ())
-     else (fnl () ++ pr_hint_list hintlist))
+     else (fnl () ++ pr_hint_list env sigma hintlist))
 
 (* Print all hints associated to head c in any database *)
-let pr_hint_list_for_head c =
+let pr_hint_list_for_head env sigma c =
   let dbs = current_db () in
   let validate (name, db) =
-    let hints = List.map (fun v -> 0, v) (Hint_db.map_all Id.Pred.full c db) in
+    let hints = List.map (fun v -> 0, v) (Hint_db.map_all ~secvars:Id.Pred.full c db) in
     (name, db, hints)
   in
   let valid_dbs = List.map validate dbs in
@@ -1417,21 +1441,21 @@ let pr_hint_list_for_head c =
   else
     hov 0
       (str"For " ++ pr_global c ++ str" -> " ++ fnl () ++
-	 hov 0 (prlist pr_hints_db valid_dbs))
+         hov 0 (prlist (pr_hints_db env sigma) valid_dbs))
 
 let pr_hint_ref ref = pr_hint_list_for_head ref
 
 (* Print all hints associated to head id in any database *)
 
-let pr_hint_term cl =
+let pr_hint_term env sigma cl =
   try
     let dbs = current_db () in
     let valid_dbs =
       let fn = try
-	  let hdc = decompose_app_bound cl in
-	    if occur_existential cl then
-	      Hint_db.map_existential ~secvars:Id.Pred.full hdc cl
-	    else Hint_db.map_auto ~secvars:Id.Pred.full hdc cl
+	  let hdc = decompose_app_bound sigma cl in
+	    if occur_existential sigma cl then
+	      Hint_db.map_existential sigma ~secvars:Id.Pred.full hdc cl
+	    else Hint_db.map_auto sigma ~secvars:Id.Pred.full hdc cl
 	with Bound -> Hint_db.map_none ~secvars:Id.Pred.full
       in
       let fn db = List.map (fun x -> 0, x) (fn db) in
@@ -1441,18 +1465,19 @@ let pr_hint_term cl =
 	(str "No hint applicable for current goal")
       else
 	(str "Applicable Hints :" ++ fnl () ++
-	    hov 0 (prlist pr_hints_db valid_dbs))
+            hov 0 (prlist (pr_hints_db env sigma) valid_dbs))
   with Match_failure _ | Failure _ ->
     (str "No hint applicable for current goal")
 
 (* print all hints that apply to the concl of the current goal *)
 let pr_applicable_hint () =
-  let pts = get_pftreestate () in
-  let glss = Proof.V82.subgoals pts in
-  match glss.Evd.it with
-  | [] -> CErrors.error "No focused goal."
+  let env = Global.env () in
+  let pts = Proof_global.give_me_the_proof () in
+  let glss,_,_,_,sigma = Proof.proof pts in
+  match glss with
+  | [] -> CErrors.user_err Pp.(str "No focused goal.")
   | g::_ ->
-    pr_hint_term (Goal.V82.concl glss.Evd.sigma g)
+    pr_hint_term env sigma (Goal.V82.concl sigma g)
 
 let pp_hint_mode = function
   | ModeInput -> str"+"
@@ -1460,9 +1485,9 @@ let pp_hint_mode = function
   | ModeOutput -> str"-"
 
 (* displays the whole hint database db *)
-let pr_hint_db db =
+let pr_hint_db_env env sigma db =
   let pr_mode = prvect_with_sep spc pp_hint_mode in
-  let pr_modes l = 
+  let pr_modes l =
     if List.is_empty l then mt ()
     else str" (modes " ++ prlist_with_sep pr_comma pr_mode l ++ str")"
   in
@@ -1472,7 +1497,7 @@ let pr_hint_db db =
       | None -> str "For any goal"
       | Some head -> str "For " ++ pr_global head ++ pr_modes modes
       in
-      let hints = pr_hint_list (List.map (fun x -> (0, x)) hintlist) in
+      let hints = pr_hint_list env sigma (List.map (fun x -> (0, x)) hintlist) in
       let hint_descr = hov 0 (goal_descr ++ str " -> " ++ hints) in
       accu ++ hint_descr
     in
@@ -1487,17 +1512,22 @@ let pr_hint_db db =
   hov 2 (str"Cut: " ++ pp_hints_path (Hint_db.cut db)) ++ fnl () ++
   content
 
-let pr_hint_db_by_name dbname =
+(* Deprecated in the mli *)
+let pr_hint_db db =
+  let sigma, env = Pfedit.get_current_context () in
+  pr_hint_db_env env sigma db
+
+let pr_hint_db_by_name env sigma dbname =
   try
-    let db = searchtable_map dbname in pr_hint_db db
+    let db = searchtable_map dbname in pr_hint_db_env env sigma db
   with Not_found ->
     error_no_such_hint_database dbname
 
 (* displays all the hints of all databases *)
-let pr_searchtable () =
+let pr_searchtable env sigma =
   let fold name db accu =
     accu ++ str "In the database " ++ str name ++ str ":" ++ fnl () ++
-    pr_hint_db db ++ fnl ()
+    pr_hint_db_env env sigma db ++ fnl ()
   in
   Hintdbmap.fold fold !searchtable (mt ())
 
@@ -1515,10 +1545,13 @@ let warn_non_imported_hint =
           strbrk "Hint used but not imported: " ++ hint ++ print_mp mp)
 
 let warn h x =
-  let hint = pr_hint h in
-  let (mp, _, _) = KerName.repr h.uid in
-  warn_non_imported_hint (hint,mp);
-  Proofview.tclUNIT x
+  let open Proofview in
+  tclBIND tclENV     (fun env   ->
+  tclBIND tclEVARMAP (fun sigma ->
+          let hint = pr_hint env sigma h in
+          let (mp, _, _) = KerName.repr h.uid in
+          warn_non_imported_hint (hint,mp);
+          Proofview.tclUNIT x))
 
 let run_hint tac k = match !warn_hint with
 | `LAX -> k tac.obj
@@ -1527,6 +1560,6 @@ let run_hint tac k = match !warn_hint with
   else Proofview.tclBIND (k tac.obj) (fun x -> warn tac x)
 | `STRICT ->
   if is_imported tac then k tac.obj
-  else Proofview.tclZERO (UserError ("", (str "Tactic failure.")))
+  else Proofview.tclZERO (UserError (None, (str "Tactic failure.")))
 
 let repr_hint h = h.obj
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 1be3e0c5..1811150c 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Pp
 open Util
 open Names
-open Term
+open EConstr
 open Environ
 open Globnames
 open Decl_kinds
 open Evd
 open Misctypes
+open Tactypes
 open Clenv
 open Pattern
 open Vernacexpr
@@ -23,9 +25,11 @@ open Vernacexpr
 
 exception Bound
 
-val decompose_app_bound : constr -> global_reference * constr array
+val decompose_app_bound : evar_map -> constr -> global_reference * constr array
 
-val secvars_of_hyps : Context.Named.t -> Id.Pred.t
+type debug = Debug | Info | Off
+
+val secvars_of_hyps : ('c, 't) Context.Named.pt -> Id.Pred.t
 
 val empty_hint_info : 'a hint_info_gen
 
@@ -40,7 +44,7 @@ type 'a hint_ast =
   | Extern     of Genarg.glob_generic_argument       (* Hint Extern *)
 
 type hint
-type raw_hint = constr * types * Univ.universe_context_set
+type raw_hint = constr * types * Univ.ContextSet.t
 
 type 'a hints_path_atom_gen =
   | PathHints of 'a list
@@ -82,10 +86,10 @@ type hints_path = global_reference hints_path_gen
 val normalize_path : hints_path -> hints_path
 val path_matches : hints_path -> hints_path_atom list -> bool
 val path_derivate : hints_path -> hints_path_atom -> hints_path
-val pp_hints_path_gen : ('a -> Pp.std_ppcmds) -> 'a hints_path_gen -> Pp.std_ppcmds
-val pp_hints_path_atom : ('a -> Pp.std_ppcmds) -> 'a hints_path_atom_gen -> Pp.std_ppcmds
-val pp_hints_path : hints_path -> Pp.std_ppcmds
-val pp_hint_mode : hint_mode -> Pp.std_ppcmds
+val pp_hints_path_gen : ('a -> Pp.t) -> 'a hints_path_gen -> Pp.t
+val pp_hints_path_atom : ('a -> Pp.t) -> 'a hints_path_atom_gen -> Pp.t
+val pp_hints_path : hints_path -> Pp.t
+val pp_hint_mode : hint_mode -> Pp.t
 val glob_hints_path_atom :
   Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen
 val glob_hints_path :
@@ -107,16 +111,16 @@ module Hint_db :
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments, _not_ using the discrimination net. *)
-    val map_existential : secvars:Id.Pred.t ->
+    val map_existential : evar_map -> secvars:Id.Pred.t ->
       (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments and using the discrimination net. *)
-    val map_eauto : secvars:Id.Pred.t -> (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_eauto : evar_map -> secvars:Id.Pred.t -> (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments. *)
-    val map_auto : secvars:Id.Pred.t ->
+    val map_auto : evar_map -> secvars:Id.Pred.t ->
        (global_reference * constr array) -> constr -> t -> full_hint list
 
     val add_one : env -> evar_map -> hint_entry -> t -> t
@@ -144,7 +148,7 @@ type hint_info = (patvar list * constr_pattern) hint_info_gen
 
 type hint_term =
   | IsGlobRef of global_reference
-  | IsConstr of constr * Univ.universe_context_set
+  | IsConstr of constr * Univ.ContextSet.t
 
 type hints_entry =
   | HintsResolveEntry of
@@ -154,7 +158,7 @@ type hints_entry =
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
   | HintsModeEntry of global_reference * hint_mode list
-  | HintsExternEntry of hint_info * Tacexpr.glob_tactic_expr
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 val searchtable_map : hint_db_name -> hint_db
 
@@ -179,7 +183,7 @@ val add_hints : locality_flag -> hint_db_name list -> hints_entry -> unit
 
 val prepare_hint : bool (* Check no remaining evars *) ->
   (bool * bool) (* polymorphic or monomorphic, local or global *) ->
-  env -> evar_map -> open_constr -> hint_term
+  env -> evar_map -> evar_map * constr -> hint_term
 
 (** [make_exact_entry info (c, ctyp, ctx)].
    [c] is the term given as an exact proof to solve the goal;
@@ -191,7 +195,7 @@ val prepare_hint : bool (* Check no remaining evars *) ->
 *)
 
 val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hints_path_atom ->
-  (constr * types * Univ.universe_context_set) -> hint_entry
+  (constr * types * Univ.ContextSet.t) -> hint_entry
 
 (** [make_apply_entry (eapply,hnf,verbose) info (c,cty,ctx))].
    [eapply] is true if this hint will be used only with EApply;
@@ -209,7 +213,7 @@ val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hint
 
 val make_apply_entry :
   env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
-  (constr * types * Univ.universe_context_set) -> hint_entry
+  (constr * types * Univ.ContextSet.t) -> hint_entry
 
 (** A constr which is Hint'ed will be:
    - (1) used as an Exact, if it does not start with a product
@@ -228,12 +232,12 @@ val make_resolves :
    If the hyp cannot be used as a Hint, the empty list is returned. *)
 
 val make_resolve_hyp :
-  env -> evar_map -> Context.Named.Declaration.t -> hint_entry list
+  env -> evar_map -> named_declaration -> hint_entry list
 
 (** [make_extern pri pattern tactic_expr] *)
 
 val make_extern :
-  int -> constr_pattern option -> Tacexpr.glob_tactic_expr
+  int -> constr_pattern option -> Genarg.glob_generic_argument
       -> hint_entry
 
 val run_hint : hint ->
@@ -243,14 +247,11 @@ val run_hint : hint ->
     written code. *)
 val repr_hint : hint -> (raw_hint * clausenv) hint_ast
 
-val extern_intern_tac :
-  (patvar list -> Tacexpr.raw_tactic_expr -> Tacexpr.glob_tactic_expr) Hook.t
-
 (** Create a Hint database from the pairs (name, constr).
    Useful to take the current goal hypotheses as hints;
    Boolean tells if lemmas with evars are allowed *)
 
-val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> Tacexpr.delayed_open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> delayed_open_constr list -> hint_db
 
 val make_db_list : hint_db_name list -> hint_db list
 
@@ -261,14 +262,15 @@ val rewrite_db : hint_db_name
 
 (** Printing  hints *)
 
-val pr_searchtable : unit -> std_ppcmds
-val pr_applicable_hint : unit -> std_ppcmds
-val pr_hint_ref : global_reference -> std_ppcmds
-val pr_hint_db_by_name : hint_db_name -> std_ppcmds
-val pr_hint_db : Hint_db.t -> std_ppcmds
-val pr_hint : hint -> Pp.std_ppcmds
+val pr_searchtable : env -> evar_map -> Pp.t
+val pr_applicable_hint : unit -> Pp.t
+val pr_hint_ref : env -> evar_map -> global_reference -> Pp.t
+val pr_hint_db_by_name : env -> evar_map -> hint_db_name -> Pp.t
+val pr_hint_db_env : env -> evar_map -> Hint_db.t -> Pp.t
+val pr_hint_db : Hint_db.t -> Pp.t
+[@@ocaml.deprecated "please used pr_hint_db_env"]
+val pr_hint : env -> evar_map -> hint -> Pp.t
 
 (** Hook for changing the initialization of auto *)
-
 val add_hints_init : (unit -> unit) -> unit
 
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml
index 7b52a9ce..b012a7ec 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -12,6 +14,7 @@ open Util
 open Names
 open Term
 open Termops
+open EConstr
 open Inductiveops
 open Constr_matching
 open Coqlib
@@ -19,6 +22,8 @@ open Declarations
 open Tacmach.New
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* I implemented the following functions which test whether a term t
    is an inductive but non-recursive type, a general conjuction, a
    general disjunction, or a type with no constructors.
@@ -29,46 +34,44 @@ open Context.Rel.Declaration
 
   -- Eduardo (6/8/97). *)
 
-type 'a matching_function = constr -> 'a option
+type 'a matching_function = Evd.evar_map -> EConstr.constr -> 'a option
 
-type testing_function  = constr -> bool
+type testing_function  = Evd.evar_map -> EConstr.constr -> bool
 
 let mkmeta n = Nameops.make_ident "X" (Some n)
 let meta1 = mkmeta 1
 let meta2 = mkmeta 2
-let meta3 = mkmeta 3
-let meta4 = mkmeta 4
 
 let op2bool = function Some _ -> true | None -> false
 
-let match_with_non_recursive_type t =
-  match kind_of_term t with
+let match_with_non_recursive_type sigma t =
+  match EConstr.kind sigma t with
     | App _ ->
-        let (hdapp,args) = decompose_app t in
-        (match kind_of_term hdapp with
+        let (hdapp,args) = decompose_app sigma t in
+        (match EConstr.kind sigma hdapp with
            | Ind (ind,u) ->
-               if (Global.lookup_mind (fst ind)).mind_finite == Decl_kinds.CoFinite then
+               if (Global.lookup_mind (fst ind)).mind_finite == CoFinite then
 		 Some (hdapp,args)
 	       else
 		 None
            | _ -> None)
     | _ -> None
 
-let is_non_recursive_type t = op2bool (match_with_non_recursive_type t)
+let is_non_recursive_type sigma t = op2bool (match_with_non_recursive_type sigma t)
 
 (* Test dependencies *)
 
 (* NB: we consider also the let-in case in the following function,
    since they may appear in types of inductive constructors (see #2629) *)
 
-let rec has_nodep_prod_after n c =
-  match kind_of_term c with
+let rec has_nodep_prod_after n sigma c =
+  match EConstr.kind sigma c with
     | Prod (_,_,b) | LetIn (_,_,_,b) ->
-	( n>0 || not (dependent (mkRel 1) b))
-	&& (has_nodep_prod_after (n-1) b)
+	( n>0 || Vars.noccurn sigma 1 b)
+	&& (has_nodep_prod_after (n-1) sigma b)
     | _            -> true
 
-let has_nodep_prod = has_nodep_prod_after 0
+let has_nodep_prod sigma c = has_nodep_prod_after 0 sigma c
 
 (* A general conjunctive type is a non-recursive with-no-indices inductive
    type with only one constructor and no dependencies between argument;
@@ -85,9 +88,17 @@ let is_lax_conjunction = function
 | Some false -> true
 | _ -> false
 
-let match_with_one_constructor style onlybinary allow_rec t =
-  let (hdapp,args) = decompose_app t in
-  let res = match kind_of_term hdapp with
+let prod_assum sigma t = fst (decompose_prod_assum sigma t)
+
+(* whd_beta normalize the types of arguments in a product *)
+let rec whd_beta_prod sigma c = match EConstr.kind sigma c with
+  | Prod (n,t,c) -> mkProd (n,Reductionops.whd_beta sigma t,whd_beta_prod sigma c)
+  | LetIn (n,d,t,c) -> mkLetIn (n,d,t,whd_beta_prod sigma c)
+  | _ -> c
+
+let match_with_one_constructor sigma style onlybinary allow_rec t =
+  let (hdapp,args) = decompose_app sigma t in
+  let res = match EConstr.kind sigma hdapp with
   | Ind ind ->
       let (mib,mip) = Global.lookup_inductive (fst ind) in
       if Int.equal (Array.length mip.mind_consnames) 1
@@ -96,21 +107,23 @@ let match_with_one_constructor style onlybinary allow_rec t =
       then
 	if is_strict_conjunction style (* strict conjunction *) then
 	  let ctx =
-	    (prod_assum (snd
-	      (decompose_prod_n_assum mib.mind_nparams mip.mind_nf_lc.(0)))) in
+	    (prod_assum sigma (snd
+	      (decompose_prod_n_assum sigma mib.mind_nparams (EConstr.of_constr mip.mind_nf_lc.(0))))) in
 	  if
 	    List.for_all
-	      (fun decl -> let c = get_type decl in
+	      (fun decl -> let c = RelDecl.get_type decl in
 	                   is_local_assum decl &&
-			   isRel c &&
-                           Int.equal (destRel c) mib.mind_nparams) ctx
+			   isRel sigma c &&
+                           Int.equal (destRel sigma c) mib.mind_nparams) ctx
 	  then
 	    Some (hdapp,args)
 	  else None
 	else
-	  let ctyp = prod_applist mip.mind_nf_lc.(0) args in
-	  let cargs = List.map get_type (prod_assum ctyp) in
-	  if not (is_lax_conjunction style) || has_nodep_prod ctyp then
+          let ctyp = whd_beta_prod sigma
+            (Termops.prod_applist_assum sigma (Context.Rel.length mib.mind_params_ctxt)
+                       (EConstr.of_constr mip.mind_nf_lc.(0)) args) in
+	  let cargs = List.map RelDecl.get_type (prod_assum sigma ctyp) in
+	  if not (is_lax_conjunction style) || has_nodep_prod sigma ctyp then
 	    (* Record or non strict conjunction *)
 	    Some (hdapp,List.rev cargs)
 	  else
@@ -123,28 +136,29 @@ let match_with_one_constructor style onlybinary allow_rec t =
   | Some (hdapp, [_; _]) -> res
   | _ -> None
 
-let match_with_conjunction ?(strict=false) ?(onlybinary=false) t =
-  match_with_one_constructor (Some strict) onlybinary false t
+let match_with_conjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  match_with_one_constructor sigma (Some strict) onlybinary false t
 
-let match_with_record t =
-  match_with_one_constructor None false false t
+let match_with_record sigma t =
+  match_with_one_constructor sigma None false false t
 
-let is_conjunction ?(strict=false) ?(onlybinary=false) t =
-  op2bool (match_with_conjunction ~strict ~onlybinary t)
+let is_conjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  op2bool (match_with_conjunction sigma ~strict ~onlybinary t)
 
-let is_record t =
-  op2bool (match_with_record t)
+let is_record sigma t =
+  op2bool (match_with_record sigma t)
 
-let match_with_tuple t =
-  let t = match_with_one_constructor None false true t in
+let match_with_tuple sigma t =
+  let t = match_with_one_constructor sigma None false true t in
   Option.map (fun (hd,l) ->
-    let ind = destInd hd in
+    let ind = destInd sigma hd in
+    let ind = on_snd (fun u -> EInstance.kind sigma u) ind in
     let (mib,mip) = Global.lookup_pinductive ind in
     let isrec = mis_is_recursive (fst ind,mib,mip) in
     (hd,l,isrec)) t
 
-let is_tuple t =
-  op2bool (match_with_tuple t)
+let is_tuple sigma t =
+  op2bool (match_with_tuple sigma t)
 
 (* A general disjunction type is a non-recursive with-no-indices inductive
    type with of which all constructors have a single argument;
@@ -152,14 +166,15 @@ let is_tuple t =
    "Inductive I A1 ... An := C1 (_:A1) | ... | Cn : (_:An)" *)
 
 let test_strict_disjunction n lc =
+  let open Term in
   Array.for_all_i (fun i c ->
     match (prod_assum (snd (decompose_prod_n_assum n c))) with
-    | [LocalAssum (_,c)] -> isRel c && Int.equal (destRel c) (n - i)
+    | [LocalAssum (_,c)] -> Constr.isRel c && Int.equal (Constr.destRel c) (n - i)
     | _ -> false) 0 lc
 
-let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
-  let (hdapp,args) = decompose_app t in
-  let res = match kind_of_term hdapp with
+let match_with_disjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  let res = match EConstr.kind sigma hdapp with
   | Ind (ind,u)  ->
       let car = constructors_nrealargs ind in
       let (mib,mip) = Global.lookup_inductive ind in
@@ -174,7 +189,7 @@ let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
 	    None
 	else
 	  let cargs =
-	    Array.map (fun ar -> pi2 (destProd (prod_applist ar args)))
+	    Array.map (fun ar -> pi2 (destProd sigma (prod_applist sigma (EConstr.of_constr ar) args)))
 	      mip.mind_nf_lc in
 	  Some (hdapp,Array.to_list cargs)
       else
@@ -185,48 +200,48 @@ let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
   | Some (hdapp,[_; _]) -> res
   | _ -> None
 
-let is_disjunction ?(strict=false) ?(onlybinary=false) t =
-  op2bool (match_with_disjunction ~strict ~onlybinary t)
+let is_disjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  op2bool (match_with_disjunction ~strict ~onlybinary sigma t)
 
 (* An empty type is an inductive type, possible with indices, that has no
    constructors *)
 
-let match_with_empty_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind ->
-        let (mib,mip) = Global.lookup_pinductive ind in
+let match_with_empty_type sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
+    | Ind (ind, _) ->
+        let (mib,mip) = Global.lookup_inductive ind in
         let nconstr = Array.length mip.mind_consnames in
 	if Int.equal nconstr 0 then Some hdapp else None
     | _ ->  None
 
-let is_empty_type t = op2bool (match_with_empty_type t)
+let is_empty_type sigma t = op2bool (match_with_empty_type sigma t)
 
 (* This filters inductive types with one constructor with no arguments;
    Parameters and indices are allowed *)
 
-let match_with_unit_or_eq_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind  ->
-        let (mib,mip) = Global.lookup_pinductive ind in
+let match_with_unit_or_eq_type sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
+    | Ind (ind , _) ->
+        let (mib,mip) = Global.lookup_inductive ind in
         let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
-        let zero_args c = Int.equal (nb_prod c) mib.mind_nparams in
+        let zero_args c = Int.equal (nb_prod sigma (EConstr.of_constr c)) mib.mind_nparams in
 	if Int.equal nconstr 1 && zero_args constr_types.(0) then
 	  Some hdapp
 	else
 	  None
     | _ -> None
 
-let is_unit_or_eq_type t = op2bool (match_with_unit_or_eq_type t)
+let is_unit_or_eq_type sigma t = op2bool (match_with_unit_or_eq_type sigma t)
 
 (* A unit type is an inductive type with no indices but possibly
    (useless) parameters, and that has no arguments in its unique
    constructor *)
 
-let is_unit_type t =
-  match match_with_conjunction t with
+let is_unit_type sigma t =
+  match match_with_conjunction sigma t with
   | Some (_,[]) -> true
   | _ -> false
 
@@ -246,16 +261,16 @@ open Decl_kinds
 open Evar_kinds
 
 let mkPattern c = snd (Patternops.pattern_of_glob_constr c)
-let mkGApp f args = GApp (Loc.ghost, f, args)
-let mkGHole =
-  GHole (Loc.ghost, QuestionMark (Define false), Misctypes.IntroAnonymous, None)
-let mkGProd id c1 c2 =
-  GProd (Loc.ghost, Name (Id.of_string id), Explicit, c1, c2)
-let mkGArrow c1 c2 =
-  GProd (Loc.ghost, Anonymous, Explicit, c1, c2)
-let mkGVar id = GVar (Loc.ghost, Id.of_string id)
-let mkGPatVar id = GPatVar(Loc.ghost, (false, Id.of_string id))
-let mkGRef r = GRef (Loc.ghost, Lazy.force r, None)
+let mkGApp f args = DAst.make @@ GApp (f, args)
+let mkGHole = DAst.make @@
+  GHole (QuestionMark (Define false,Anonymous), Misctypes.IntroAnonymous, None)
+let mkGProd id c1 c2 = DAst.make @@
+  GProd (Name (Id.of_string id), Explicit, c1, c2)
+let mkGArrow c1 c2 = DAst.make @@
+  GProd (Anonymous, Explicit, c1, c2)
+let mkGVar id = DAst.make @@ GVar (Id.of_string id)
+let mkGPatVar id = DAst.make @@ GPatVar(Evar_kinds.FirstOrderPatVar (Id.of_string id))
+let mkGRef r = DAst.make @@ GRef (Lazy.force r, None)
 let mkGAppRef r args = mkGApp (mkGRef r) args
 
 (** forall x : _, _ x x *)
@@ -274,13 +289,10 @@ let coq_refl_jm_pattern       =
 
 open Globnames
 
-let is_matching x y = is_matching (Global.env ()) Evd.empty x y
-let matches x y = matches (Global.env ()) Evd.empty x y
-
-let match_with_equation t =
-  if not (isApp t) then raise NoEquationFound;
-  let (hdapp,args) = destApp t in
-  match kind_of_term hdapp with
+let match_with_equation env sigma t =
+  if not (isApp sigma t) then raise NoEquationFound;
+  let (hdapp,args) = destApp sigma t in
+  match EConstr.kind sigma hdapp with
   | Ind (ind,u) ->
       if eq_gr (IndRef ind) glob_eq then
 	Some (build_coq_eq_data()),hdapp,
@@ -296,11 +308,11 @@ let match_with_equation t =
         let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
 	if Int.equal nconstr 1 then
-          if is_matching coq_refl_leibniz1_pattern constr_types.(0) then
+          if is_matching env sigma coq_refl_leibniz1_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, MonomorphicLeibnizEq(args.(0),args.(1))
-	  else if is_matching coq_refl_leibniz2_pattern constr_types.(0) then
+	  else if is_matching env sigma coq_refl_leibniz2_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, PolymorphicLeibnizEq(args.(0),args.(1),args.(2))
-	  else if is_matching coq_refl_jm_pattern constr_types.(0) then
+	  else if is_matching env sigma coq_refl_jm_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, HeterogenousEq(args.(0),args.(1),args.(2),args.(3))
 	  else raise NoEquationFound
         else raise NoEquationFound
@@ -316,84 +328,87 @@ let is_inductive_equality ind =
   let nconstr = Array.length mip.mind_consnames in
   Int.equal nconstr 1 && Int.equal (constructor_nrealargs (ind,1)) 0
 
-let match_with_equality_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
+let match_with_equality_type sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
   | Ind (ind,_) when is_inductive_equality ind -> Some (hdapp,args)
   | _ -> None
 
-let is_equality_type t = op2bool (match_with_equality_type t)
+let is_equality_type sigma t = op2bool (match_with_equality_type sigma t)
 
 (* Arrows/Implication/Negation *)
 
 (** X1 -> X2 **)
 let coq_arrow_pattern = mkPattern (mkGArrow (mkGPatVar "X1") (mkGPatVar "X2"))
 
-let match_arrow_pattern t =
-  let result = matches coq_arrow_pattern t in
+let match_arrow_pattern env sigma t =
+  let result = matches env sigma coq_arrow_pattern t in
   match Id.Map.bindings result with
     | [(m1,arg);(m2,mind)] ->
       assert (Id.equal m1 meta1 && Id.equal m2 meta2); (arg, mind)
-    | _ -> anomaly (Pp.str "Incorrect pattern matching")
+    | _ -> anomaly (Pp.str "Incorrect pattern matching.")
 
-let match_with_imp_term c=
-  match kind_of_term c with
-    | Prod (_,a,b) when not (dependent (mkRel 1) b) ->Some (a,b)
+let match_with_imp_term sigma c =
+  match EConstr.kind sigma c with
+    | Prod (_,a,b) when Vars.noccurn sigma 1 b -> Some (a,b)
     | _              -> None
 
-let is_imp_term c = op2bool (match_with_imp_term c)
+let is_imp_term sigma c = op2bool (match_with_imp_term sigma c)
 
-let match_with_nottype t =
+let match_with_nottype env sigma t =
   try
-    let (arg,mind) = match_arrow_pattern t in
-    if is_empty_type mind then Some (mind,arg) else None
+    let (arg,mind) = match_arrow_pattern env sigma t in
+    if is_empty_type sigma mind then Some (mind,arg) else None
   with PatternMatchingFailure -> None
 
-let is_nottype t = op2bool (match_with_nottype t)
+let is_nottype env sigma t = op2bool (match_with_nottype env sigma t)
 
 (* Forall *)
 
-let match_with_forall_term c=
-  match kind_of_term c with
+let match_with_forall_term sigma c=
+  match EConstr.kind sigma c with
     | Prod (nam,a,b) -> Some (nam,a,b)
     | _            -> None
 
-let is_forall_term c = op2bool (match_with_forall_term c)
-
-let match_with_nodep_ind t =
-  let (hdapp,args) = decompose_app t in
-    match (kind_of_term hdapp) with
-      | Ind ind  ->
-          let (mib,mip) = Global.lookup_pinductive ind in
-	    if Array.length (mib.mind_packets)>1 then None else
-	      let nodep_constr = has_nodep_prod_after mib.mind_nparams in
-		if Array.for_all nodep_constr mip.mind_nf_lc then
-		  let params=
-		    if Int.equal mip.mind_nrealargs 0 then args else
-		      fst (List.chop mib.mind_nparams args) in
-		    Some (hdapp,params,mip.mind_nrealargs)
-		else
-		  None
-      | _ -> None
-
-let is_nodep_ind t=op2bool (match_with_nodep_ind t)
-
-let match_with_sigma_type t=
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind  ->
-        let (mib,mip) = Global.lookup_pinductive ind in
-          if Int.equal (Array.length (mib.mind_packets)) 1 &&
-	    (Int.equal mip.mind_nrealargs 0) &&
-	    (Int.equal (Array.length mip.mind_consnames)1) &&
-	    has_nodep_prod_after (mib.mind_nparams+1) mip.mind_nf_lc.(0) then
-	      (*allowing only 1 existential*)
-	      Some (hdapp,args)
-	  else
-	    None
-    | _ -> None
+let is_forall_term sigma c = op2bool (match_with_forall_term sigma c)
+
+let match_with_nodep_ind sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
+  | Ind (ind, _)  ->
+     let (mib,mip) = Global.lookup_inductive ind in
+     if Array.length (mib.mind_packets)>1 then None else
+       let nodep_constr c =
+         has_nodep_prod_after (Context.Rel.length mib.mind_params_ctxt) sigma (EConstr.of_constr c) in
+       if Array.for_all nodep_constr mip.mind_nf_lc then
+         let params=
+           if Int.equal mip.mind_nrealargs 0 then args else
+             fst (List.chop mib.mind_nparams args) in
+         Some (hdapp,params,mip.mind_nrealargs)
+       else
+         None
+  | _ -> None
+
+let is_nodep_ind sigma t = op2bool (match_with_nodep_ind sigma t)
+
+let match_with_sigma_type sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
+  | Ind (ind, _) ->
+     let (mib,mip) = Global.lookup_inductive ind in
+     if Int.equal (Array.length (mib.mind_packets)) 1
+        && (Int.equal mip.mind_nrealargs 0)
+        && (Int.equal (Array.length mip.mind_consnames)1)
+        && has_nodep_prod_after (Context.Rel.length mib.mind_params_ctxt + 1) sigma
+             (EConstr.of_constr mip.mind_nf_lc.(0))
+     then
+       (*allowing only 1 existential*)
+       Some (hdapp,args)
+     else
+       None
+  | _ -> None
 
-let is_sigma_type t=op2bool (match_with_sigma_type t)
+let is_sigma_type sigma t = op2bool (match_with_sigma_type sigma t)
 
 (***** Destructing patterns bound to some theory *)
 
@@ -406,17 +421,17 @@ let rec first_match matcher = function
 
 (*** Equality *)
 
-let match_eq eqn (ref, hetero) =
+let match_eq sigma eqn (ref, hetero) =
   let ref =
     try Lazy.force ref
     with e when CErrors.noncritical e -> raise PatternMatchingFailure
   in
-  match kind_of_term eqn with
+  match EConstr.kind sigma eqn with
   | App (c, [|t; x; y|]) ->
-    if not hetero && is_global ref c then PolymorphicLeibnizEq (t, x, y)
+    if not hetero && Termops.is_global sigma ref c then PolymorphicLeibnizEq (t, x, y)
     else raise PatternMatchingFailure
   | App (c, [|t; x; t'; x'|]) ->
-    if hetero && is_global ref c then HeterogenousEq (t, x, t', x')
+    if hetero && Termops.is_global sigma ref c then HeterogenousEq (t, x, t', x')
     else raise PatternMatchingFailure
   | _ -> raise PatternMatchingFailure
 
@@ -428,9 +443,9 @@ let equalities =
    (coq_jmeq_ref, true), check_jmeq_loaded, build_coq_jmeq_data;
    (coq_identity_ref, false), no_check, build_coq_identity_data]
 
-let find_eq_data eqn = (* fails with PatternMatchingFailure *)
-  let d,k = first_match (match_eq eqn) equalities in
-  let hd,u = destInd (fst (destApp eqn)) in
+let find_eq_data sigma eqn = (* fails with PatternMatchingFailure *)
+  let d,k = first_match (match_eq sigma eqn) equalities in
+  let hd,u = destInd sigma (fst (destApp sigma eqn)) in
     d,u,k
 
 let extract_eq_args gl = function
@@ -442,60 +457,44 @@ let extract_eq_args gl = function
       else raise PatternMatchingFailure
 
 let find_eq_data_decompose gl eqn =
-  let (lbeq,u,eq_args) = find_eq_data eqn in
+  let (lbeq,u,eq_args) = find_eq_data (project gl) eqn in
   (lbeq,u,extract_eq_args gl eq_args)
 
 let find_this_eq_data_decompose gl eqn =
   let (lbeq,u,eq_args) =
     try (*first_match (match_eq eqn) inversible_equalities*)
-      find_eq_data eqn
+      find_eq_data (project gl) eqn
     with PatternMatchingFailure ->
-      errorlabstrm "" (str "No primitive equality found.") in
+      user_err  (str "No primitive equality found.") in
   let eq_args =
     try extract_eq_args gl eq_args
     with PatternMatchingFailure ->
-      error "Don't know what to do with JMeq on arguments not of same type." in
+      user_err Pp.(str "Don't know what to do with JMeq on arguments not of same type.") in
   (lbeq,u,eq_args)
 
-let match_eq_nf gls eqn (ref, hetero) =
-  let n = if hetero then 4 else 3 in
-  let args = List.init n (fun i -> mkGPatVar ("X" ^ string_of_int (i + 1))) in
-  let pat = mkPattern (mkGAppRef ref args) in
-  match Id.Map.bindings (pf_matches gls pat eqn) with
-    | [(m1,t);(m2,x);(m3,y)] ->
-        assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3);
-	(t,pf_whd_all gls x,pf_whd_all gls y)
-    | _ -> anomaly ~label:"match_eq" (Pp.str "an eq pattern should match 3 terms")
-
-let dest_nf_eq gls eqn =
-  try
-    snd (first_match (match_eq_nf gls eqn) equalities)
-  with PatternMatchingFailure ->
-    error "Not an equality."
-
 (*** Sigma-types *)
 
-let match_sigma ex =
-  match kind_of_term ex with
-  | App (f, [| a; p; car; cdr |]) when is_global (Lazy.force coq_exist_ref) f -> 
-      build_sigma (), (snd (destConstruct f), a, p, car, cdr)
-  | App (f, [| a; p; car; cdr |]) when is_global (Lazy.force coq_existT_ref) f -> 
-    build_sigma_type (), (snd (destConstruct f), a, p, car, cdr)
+let match_sigma env sigma ex =
+  match EConstr.kind sigma ex with
+  | App (f, [| a; p; car; cdr |]) when Termops.is_global sigma (Lazy.force coq_exist_ref) f -> 
+      build_sigma (), (snd (destConstruct sigma f), a, p, car, cdr)
+  | App (f, [| a; p; car; cdr |]) when Termops.is_global sigma (Lazy.force coq_existT_ref) f -> 
+    build_sigma_type (), (snd (destConstruct sigma f), a, p, car, cdr)
   | _ -> raise PatternMatchingFailure
     
-let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
-  match_sigma ex
+let find_sigma_data_decompose env ex = (* fails with PatternMatchingFailure *)
+  match_sigma env ex
 
 (* Pattern "(sig ?1 ?2)" *)
 let coq_sig_pattern =
   lazy (mkPattern (mkGAppRef coq_sig_ref [mkGPatVar "X1"; mkGPatVar "X2"]))
 
-let match_sigma t =
-  match Id.Map.bindings (matches (Lazy.force coq_sig_pattern) t) with
+let match_sigma env sigma t =
+  match Id.Map.bindings (matches env sigma (Lazy.force coq_sig_pattern) t) with
     | [(_,a); (_,p)] -> (a,p)
-    | _ -> anomaly (Pp.str "Unexpected pattern")
+    | _ -> anomaly (Pp.str "Unexpected pattern.")
 
-let is_matching_sigma t = is_matching (Lazy.force coq_sig_pattern) t
+let is_matching_sigma env sigma t = is_matching env sigma (Lazy.force coq_sig_pattern) t
 
 (*** Decidable equalities *)
 
@@ -512,10 +511,10 @@ let coq_eqdec ~sum ~rev =
     mkPattern (mkGAppRef sum args)
   )
 
-(** { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } *)
+(** [{ ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 }] *)
 let coq_eqdec_inf_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:false
 
-(** { ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 } *)
+(** [{ ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 }] *)
 let coq_eqdec_inf_rev_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:true
 
 (** %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) *)
@@ -527,26 +526,26 @@ let coq_eqdec_rev_pattern = coq_eqdec ~sum:coq_or_ref ~rev:true
 let op_or = coq_or_ref
 let op_sum = coq_sumbool_ref
 
-let match_eqdec t =
+let match_eqdec env sigma t =
   let eqonleft,op,subst =
-    try true,op_sum,matches (Lazy.force coq_eqdec_inf_pattern) t
+    try true,op_sum,matches env sigma (Lazy.force coq_eqdec_inf_pattern) t
     with PatternMatchingFailure ->
-    try false,op_sum,matches (Lazy.force coq_eqdec_inf_rev_pattern) t
+    try false,op_sum,matches env sigma (Lazy.force coq_eqdec_inf_rev_pattern) t
     with PatternMatchingFailure ->
-    try true,op_or,matches (Lazy.force coq_eqdec_pattern) t
+    try true,op_or,matches env sigma (Lazy.force coq_eqdec_pattern) t
     with PatternMatchingFailure ->
-        false,op_or,matches (Lazy.force coq_eqdec_rev_pattern) t in
+        false,op_or,matches env sigma (Lazy.force coq_eqdec_rev_pattern) t in
   match Id.Map.bindings subst with
   | [(_,typ);(_,c1);(_,c2)] ->
-      eqonleft, Universes.constr_of_global (Lazy.force op), c1, c2, typ
-  | _ -> anomaly (Pp.str "Unexpected pattern")
+      eqonleft, Lazy.force op, c1, c2, typ
+  | _ -> anomaly (Pp.str "Unexpected pattern.")
 
 (* Patterns "~ ?" and "? -> False" *)
 let coq_not_pattern = lazy (mkPattern (mkGAppRef coq_not_ref [mkGHole]))
 let coq_imp_False_pattern = lazy (mkPattern (mkGArrow mkGHole (mkGRef coq_False_ref)))
 
-let is_matching_not t = is_matching (Lazy.force coq_not_pattern) t
-let is_matching_imp_False t = is_matching (Lazy.force coq_imp_False_pattern) t
+let is_matching_not env sigma t = is_matching env sigma (Lazy.force coq_not_pattern) t
+let is_matching_imp_False env sigma t = is_matching env sigma (Lazy.force coq_imp_False_pattern) t
 
 (* Remark: patterns that have references to the standard library must
    be evaluated lazily (i.e. at the time they are used, not a the time
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 7cc41f1b..0697d0f1 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Evd
+open EConstr
 open Coqlib
 
 (** High-order patterns *)
@@ -40,8 +43,8 @@ open Coqlib
    also work on ad-hoc disjunctions introduced by the user.
    (Eduardo, 6/8/97). *)
 
-type 'a matching_function = constr -> 'a option
-type testing_function = constr -> bool
+type 'a matching_function = evar_map -> constr -> 'a option
+type testing_function = evar_map -> constr -> bool
 
 val match_with_non_recursive_type : (constr * constr list) matching_function
 val is_non_recursive_type         : testing_function
@@ -80,8 +83,8 @@ val is_inductive_equality  : inductive -> bool
 val match_with_equality_type : (constr * constr list) matching_function
 val is_equality_type       : testing_function
 
-val match_with_nottype     : (constr * constr) matching_function
-val is_nottype             : testing_function
+val match_with_nottype     : Environ.env -> (constr * constr) matching_function
+val is_nottype             : Environ.env -> testing_function
 
 val match_with_forall_term    : (Name.t * constr * constr) matching_function
 val is_forall_term            : testing_function
@@ -113,39 +116,36 @@ type equation_kind =
 exception NoEquationFound
 
 val match_with_equation:
-  constr -> coq_eq_data option * constr * equation_kind
+  Environ.env -> evar_map -> constr -> coq_eq_data option * constr * equation_kind
 
 (***** Destructing patterns bound to some theory *)
 
 (** Match terms [eq A t u], [identity A t u] or [JMeq A t A u] 
    Returns associated lemmas and [A,t,u] or fails PatternMatchingFailure *)
-val find_eq_data_decompose : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
-      coq_eq_data * Univ.universe_instance * (types * constr * constr)
+val find_eq_data_decompose : Proofview.Goal.t -> constr ->
+      coq_eq_data * EInstance.t * (types * constr * constr)
 
 (** Idem but fails with an error message instead of PatternMatchingFailure *)
-val find_this_eq_data_decompose : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
-      coq_eq_data * Univ.universe_instance * (types * constr * constr)
+val find_this_eq_data_decompose : Proofview.Goal.t -> constr ->
+      coq_eq_data * EInstance.t * (types * constr * constr)
 
 (** A variant that returns more informative structure on the equality found *)
-val find_eq_data : constr -> coq_eq_data * Univ.universe_instance * equation_kind
+val find_eq_data : evar_map -> constr -> coq_eq_data * EInstance.t * equation_kind
 
 (** Match a term of the form [(existT A P t p)] 
    Returns associated lemmas and [A,P,t,p] *)
-val find_sigma_data_decompose : constr ->
-  coq_sigma_data * (Univ.universe_instance * constr * constr * constr * constr)
+val find_sigma_data_decompose : Environ.env -> evar_map -> constr ->
+  coq_sigma_data * (EInstance.t * constr * constr * constr * constr)
 
 (** Match a term of the form [{x:A|P}], returns [A] and [P] *)
-val match_sigma : constr -> constr * constr
+val match_sigma : Environ.env -> evar_map -> constr -> constr * constr
 
-val is_matching_sigma : constr -> bool
+val is_matching_sigma : Environ.env -> evar_map -> constr -> bool
 
 (** Match a decidable equality judgement (e.g [{t=u:>T}+{~t=u}]), returns
    [t,u,T] and a boolean telling if equality is on the left side *)
-val match_eqdec : constr -> bool * constr * constr * constr * constr
-
-(** Match an equality up to conversion; returns [(eq,t1,t2)] in normal form *)
-val dest_nf_eq : ([ `NF ], 'r) Proofview.Goal.t -> constr -> (constr * constr * constr)
+val match_eqdec : Environ.env -> evar_map -> constr -> bool * Globnames.global_reference * constr * constr * constr
 
 (** Match a negation *)
-val is_matching_not : constr -> bool
-val is_matching_imp_False : constr -> bool
+val is_matching_not : Environ.env -> evar_map -> constr -> bool
+val is_matching_imp_False : Environ.env -> evar_map -> constr -> bool
diff --git a/tactics/ind_tables.ml b/tactics/ind_tables.ml
new file mode 100644
index 00000000..62ead57f
--- /dev/null
+++ b/tactics/ind_tables.ml
@@ -0,0 +1,207 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* File created by Vincent Siles, Oct 2007, extended into a generic
+   support for generation of inductive schemes by Hugo Herbelin, Nov 2009 *)
+
+(* This file provides support for registering inductive scheme builders,
+   declaring schemes and generating schemes on demand *)
+
+open Names
+open Mod_subst
+open Libobject
+open Nameops
+open Declarations
+open Constr
+open CErrors
+open Util
+open Declare
+open Entries
+open Decl_kinds
+open Pp
+
+(**********************************************************************)
+(* Registering schemes in the environment *)
+
+type mutual_scheme_object_function =
+  internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
+type individual_scheme_object_function =
+  internal_flag -> inductive -> constr Evd.in_evar_universe_context * Safe_typing.private_constants
+
+type 'a scheme_kind = string
+
+let scheme_map = Summary.ref Indmap.empty ~name:"Schemes"
+
+let pr_scheme_kind = Pp.str
+
+let cache_one_scheme kind (ind,const) =
+  let map = try Indmap.find ind !scheme_map with Not_found -> String.Map.empty in
+  scheme_map := Indmap.add ind (String.Map.add kind const map) !scheme_map
+
+let cache_scheme (_,(kind,l)) =
+  Array.iter (cache_one_scheme kind) l
+
+let subst_one_scheme subst (ind,const) =
+  (* Remark: const is a def: the result of substitution is a constant *)
+  (subst_ind subst ind,subst_constant subst const)
+
+let subst_scheme (subst,(kind,l)) =
+  (kind,Array.map (subst_one_scheme subst) l)
+
+let discharge_scheme (_,(kind,l)) =
+  Some (kind,Array.map (fun (ind,const) ->
+    (Lib.discharge_inductive ind,Lib.discharge_con const)) l)
+
+let inScheme : string * (inductive * Constant.t) array -> obj =
+  declare_object {(default_object "SCHEME") with
+                    cache_function = cache_scheme;
+                    load_function = (fun _ -> cache_scheme);
+                    subst_function = subst_scheme;
+		    classify_function = (fun obj -> Substitute obj);
+		    discharge_function = discharge_scheme}
+
+(**********************************************************************)
+(* The table of scheme building functions *)
+
+type individual
+type mutual
+
+type scheme_object_function =
+  | MutualSchemeFunction of mutual_scheme_object_function
+  | IndividualSchemeFunction of individual_scheme_object_function
+
+let scheme_object_table =
+  (Hashtbl.create 17 : (string, string * scheme_object_function) Hashtbl.t)
+
+let declare_scheme_object s aux f =
+  let () =
+    if not (Id.is_valid ("ind" ^ s)) then
+      user_err Pp.(str ("Illegal induction scheme suffix: " ^ s))
+  in
+  let key = if String.is_empty aux then s else aux in
+  try
+    let _ = Hashtbl.find scheme_object_table key in
+(*    let aux_msg = if aux="" then "" else " (with key "^aux^")" in*)
+    user_err ~hdr:"IndTables.declare_scheme_object"
+      (str "Scheme object " ++ str key ++ str " already declared.")
+  with Not_found ->
+    Hashtbl.add scheme_object_table key (s,f);
+    key
+
+let declare_mutual_scheme_object s ?(aux="") f =
+  declare_scheme_object s aux (MutualSchemeFunction f)
+
+let declare_individual_scheme_object s ?(aux="") f =
+  declare_scheme_object s aux (IndividualSchemeFunction f)
+
+(**********************************************************************)
+(* Defining/retrieving schemes *)
+
+let declare_scheme kind indcl =
+  Lib.add_anonymous_leaf (inScheme (kind,indcl))
+
+let () = Declare.set_declare_scheme declare_scheme
+
+let is_visible_name id =
+  try ignore (Nametab.locate (Libnames.qualid_of_ident id)); true
+  with Not_found -> false
+
+let compute_name internal id =
+  match internal with
+  | UserAutomaticRequest | UserIndividualRequest -> id
+  | InternalTacticRequest ->
+      Namegen.next_ident_away_from (add_prefix "internal_" id) is_visible_name
+
+let define internal id c p univs =
+  let fd = declare_constant ~internal in
+  let id = compute_name internal id in
+  let ctx = UState.minimize univs in
+  let c = Universes.subst_opt_univs_constr (UState.subst ctx) c in
+  let univs =
+    if p then Polymorphic_const_entry (UState.context ctx)
+    else Monomorphic_const_entry (UState.context_set ctx)
+  in
+  let entry = {
+    const_entry_body =
+      Future.from_val ((c,Univ.ContextSet.empty),
+                       Safe_typing.empty_private_constants);
+    const_entry_secctx = None;
+    const_entry_type = None;
+    const_entry_universes = univs;
+    const_entry_opaque = false;
+    const_entry_inline_code = false;
+    const_entry_feedback = None;
+  } in
+  let kn = fd id (DefinitionEntry entry, Decl_kinds.IsDefinition Scheme) in
+  let () = match internal with
+    | InternalTacticRequest -> ()
+    | _-> definition_message id
+  in
+  kn
+
+let define_individual_scheme_base kind suff f mode idopt (mind,i as ind) =
+  let (c, ctx), eff = f mode ind in
+  let mib = Global.lookup_mind mind in
+  let id = match idopt with
+    | Some id -> id
+    | None -> add_suffix mib.mind_packets.(i).mind_typename suff in
+  let const = define mode id c (Declareops.inductive_is_polymorphic mib) ctx in
+  declare_scheme kind [|ind,const|];
+  const, Safe_typing.add_private
+     (Safe_typing.private_con_of_scheme ~kind (Global.safe_env()) [ind,const]) eff
+
+let define_individual_scheme kind mode names (mind,i as ind) =
+  match Hashtbl.find scheme_object_table kind with
+  | _,MutualSchemeFunction f -> assert false
+  | s,IndividualSchemeFunction f ->
+      define_individual_scheme_base kind s f mode names ind
+
+let define_mutual_scheme_base kind suff f mode names mind =
+  let (cl, ctx), eff = f mode mind in
+  let mib = Global.lookup_mind mind in
+  let ids = Array.init (Array.length mib.mind_packets) (fun i ->
+      try Int.List.assoc i names
+      with Not_found -> add_suffix mib.mind_packets.(i).mind_typename suff) in
+  let consts = Array.map2 (fun id cl -> 
+     define mode id cl (Declareops.inductive_is_polymorphic mib) ctx) ids cl in
+  let schemes = Array.mapi (fun i cst -> ((mind,i),cst)) consts in
+  declare_scheme kind schemes;
+  consts,
+  Safe_typing.add_private 
+    (Safe_typing.private_con_of_scheme
+      ~kind (Global.safe_env()) (Array.to_list schemes))
+    eff 
+
+let define_mutual_scheme kind mode names mind =
+  match Hashtbl.find scheme_object_table kind with
+  | _,IndividualSchemeFunction _ -> assert false
+  | s,MutualSchemeFunction f ->
+      define_mutual_scheme_base kind s f mode names mind
+
+let find_scheme_on_env_too kind ind =
+  let s = String.Map.find kind (Indmap.find ind !scheme_map) in
+  s, Safe_typing.add_private
+      (Safe_typing.private_con_of_scheme
+            ~kind (Global.safe_env()) [ind, s])
+      Safe_typing.empty_private_constants
+
+let find_scheme ?(mode=InternalTacticRequest) kind (mind,i as ind) =
+  try find_scheme_on_env_too kind ind
+  with Not_found ->
+  match Hashtbl.find scheme_object_table kind with
+  | s,IndividualSchemeFunction f ->
+      define_individual_scheme_base kind s f mode None ind
+  | s,MutualSchemeFunction f ->
+      let ca, eff = define_mutual_scheme_base kind s f mode [] mind in
+      ca.(i), eff
+
+let check_scheme kind ind =
+  try let _ = find_scheme_on_env_too kind ind in true
+  with Not_found -> false
diff --git a/tactics/ind_tables.mli b/tactics/ind_tables.mli
new file mode 100644
index 00000000..0eb4e47a
--- /dev/null
+++ b/tactics/ind_tables.mli
@@ -0,0 +1,53 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Constr
+open Declare
+
+(** This module provides support for registering inductive scheme builders,
+   declaring schemes and generating schemes on demand *)
+
+(** A scheme is either a "mutual scheme_kind" or an "individual scheme_kind" *)
+
+type mutual
+type individual
+type 'a scheme_kind
+
+type mutual_scheme_object_function =
+  internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
+type individual_scheme_object_function =
+  internal_flag -> inductive -> constr Evd.in_evar_universe_context * Safe_typing.private_constants
+
+(** Main functions to register a scheme builder *)
+
+val declare_mutual_scheme_object : string -> ?aux:string ->
+  mutual_scheme_object_function -> mutual scheme_kind
+
+val declare_individual_scheme_object : string -> ?aux:string ->
+  individual_scheme_object_function ->
+  individual scheme_kind
+
+(** Force generation of a (mutually) scheme with possibly user-level names *)
+
+val define_individual_scheme : individual scheme_kind -> 
+  internal_flag (** internal *) ->
+  Id.t option -> inductive -> Constant.t * Safe_typing.private_constants
+
+val define_mutual_scheme : mutual scheme_kind -> internal_flag (** internal *) ->
+  (int * Id.t) list -> MutInd.t -> Constant.t array * Safe_typing.private_constants
+
+(** Main function to retrieve a scheme in the cache or to generate it *)
+val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> Constant.t * Safe_typing.private_constants
+
+val check_scheme : 'a scheme_kind -> inductive -> bool
+
+
+val pr_scheme_kind : 'a scheme_kind -> Pp.t
diff --git a/tactics/inv.ml b/tactics/inv.ml
index bda16b01..067fc894 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -1,21 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Term
-open Vars
 open Termops
+open EConstr
+open Vars
 open Namegen
-open Environ
 open Inductiveops
 open Printer
 open Retyping
@@ -25,15 +26,15 @@ open Tactics
 open Elim
 open Equality
 open Misctypes
-open Tacexpr
-open Sigma.Notations
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 let var_occurs_in_pf gl id =
   let env = Proofview.Goal.env gl in
-  occur_var env id (Proofview.Goal.concl gl) ||
-  List.exists (occur_var_in_decl env id) (Proofview.Goal.hyps gl)
+  let sigma = project gl in
+  occur_var env sigma id (Proofview.Goal.concl gl) ||
+  List.exists (occur_var_in_decl env sigma id) (Proofview.Goal.hyps gl)
 
 (* [make_inv_predicate (ity,args) C]
 
@@ -73,11 +74,12 @@ let make_inv_predicate env evd indf realargs id status concl =
       | NoDep ->
 	  (* We push the arity and leave concl unchanged *)
 	  let hyps_arity,_ = get_arity env indf in
+	  let hyps_arity = List.map (fun d -> map_rel_decl EConstr.of_constr d) hyps_arity in
 	    (hyps_arity,concl)
       | Dep dflt_concl ->
-	  if not (occur_var env id concl) then
-	    errorlabstrm "make_inv_predicate"
-              (str "Current goal does not depend on " ++ pr_id id ++ str".");
+	  if not (occur_var env !evd id concl) then
+	    user_err ~hdr:"make_inv_predicate"
+              (str "Current goal does not depend on " ++ Id.print id ++ str".");
           (* We abstract the conclusion of goal with respect to
              realargs and c to * be concl in order to rewrite and have
              c also rewritten when the case * will be done *)
@@ -87,11 +89,11 @@ let make_inv_predicate env evd indf realargs id status concl =
               | None ->
 		let sort = get_sort_family_of env !evd concl in
 		let sort = Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd sort in
-		let p = make_arity env true indf sort in
+		let p = make_arity env !evd true indf sort in
 		let evd',(p,ptyp) = Unification.abstract_list_all env
                   !evd p concl (realargs@[mkVar id])
 		in evd := evd'; p in
-	  let hyps,bodypred = decompose_lam_n_assum (nrealargs+1) pred in
+	  let hyps,bodypred = decompose_lam_n_assum !evd (nrealargs+1) pred in
 	  (* We lift to make room for the equations *)
 	  (hyps,lift nrealargs bodypred)
   in
@@ -109,7 +111,7 @@ let make_inv_predicate env evd indf realargs id status concl =
         let ai = lift nhyps ai in
         let (xi, ti) = compute_eqn env' !evd nhyps n ai in
         let (lhs,eqnty,rhs) =
-          if closed0 ti then
+          if closed0 !evd ti then
 	    (xi,ti,ai)
           else
 	    let sigma, res = make_iterated_tuple env' !evd ai (xi,ti) in
@@ -117,17 +119,19 @@ let make_inv_predicate env evd indf realargs id status concl =
 	in
         let eq_term = eqdata.Coqlib.eq in
 	let eq = Evarutil.evd_comb1 (Evd.fresh_global env) evd eq_term in
+        let eq = EConstr.of_constr eq in
         let eqn = applist (eq,[eqnty;lhs;rhs]) in
         let eqns = (Anonymous, lift n eqn) :: eqns in
         let refl_term = eqdata.Coqlib.refl in
 	let refl_term = Evarutil.evd_comb1 (Evd.fresh_global env) evd refl_term in
+	let refl_term = EConstr.of_constr refl_term in
         let refl = mkApp (refl_term, [|eqnty; rhs|]) in
 	let _ = Evarutil.evd_comb1 (Typing.type_of env) evd refl in
         let args = refl :: args in
         build_concl eqns args (succ n) restlist
   in
   let (newconcl, args) = build_concl [] [] 0 realargs in
-  let predicate = it_mkLambda_or_LetIn_name env newconcl hyps in
+  let predicate = it_mkLambda_or_LetIn newconcl (name_context env !evd hyps) in
   let _ = Evarutil.evd_comb1 (Typing.type_of env) evd predicate in
   (* OK - this predicate should now be usable by res_elimination_then to
      do elimination on the conclusion. *)
@@ -182,8 +186,8 @@ let dependent_hyps env id idlist gl =
     | [] -> []
     | d::l ->
 	(* Update the type of id1: it may have been subject to rewriting *)
-	let d = pf_get_hyp (get_id d) gl in
-	if occur_var_in_decl env id d
+	let d = pf_get_hyp (NamedDecl.get_id d) gl in
+	if occur_var_in_decl env (project gl) id d
         then d :: dep_rec l
         else dep_rec l
   in
@@ -192,7 +196,7 @@ let dependent_hyps env id idlist gl =
 let split_dep_and_nodep hyps gl =
   List.fold_right
     (fun d (l1,l2) ->
-       if var_occurs_in_pf gl (get_id d) then (d::l1,l2) else (l1,d::l2))
+       if var_occurs_in_pf gl (NamedDecl.get_id d) then (d::l1,l2) else (l1,d::l2))
     hyps ([],[])
 
 (* Computation of dids is late; must have been done in rewrite_equations*)
@@ -268,47 +272,50 @@ Nota: with Inversion_clear, only four useless hypotheses
 
 let generalizeRewriteIntros as_mode tac depids id =
   Proofview.tclENV >>= fun env ->
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let dids = dependent_hyps env id depids gl in
   let reintros = if as_mode then intros_replacing else intros_possibly_replacing in
   (tclTHENLIST
     [bring_hyps dids; tac;
      (* may actually fail to replace if dependent in a previous eq *)
      reintros (ids_of_named_context dids)])
-  end }
+  end
 
 let error_too_many_names pats =
-  let loc = Loc.join_loc (fst (List.hd pats)) (fst (List.last pats)) in
+  let loc = Loc.merge_opt (List.hd pats).CAst.loc (List.last pats).CAst.loc in
   Proofview.tclENV >>= fun env ->
-  tclZEROMSG ~loc (
+  Proofview.tclEVARMAP >>= fun sigma ->
+  tclZEROMSG ?loc (
     str "Unexpected " ++
     str (String.plural (List.length pats) "introduction pattern") ++
-    str ": " ++ pr_enum (Miscprint.pr_intro_pattern (fun c -> Printer.pr_constr (fst (run_delayed env Evd.empty c)))) pats ++
+    str ": " ++ pr_enum (Miscprint.pr_intro_pattern
+                           (fun c -> Printer.pr_constr_env env sigma (EConstr.Unsafe.to_constr (snd (c env Evd.empty))))) pats ++
     str ".")
 
-let get_names (allow_conj,issimple) (loc, pat as x) = match pat with
+let get_names (allow_conj,issimple) ({CAst.loc;v=pat} as x) = match pat with
   | IntroNaming IntroAnonymous | IntroForthcoming _ ->
-      error "Anonymous pattern not allowed for inversion equations."
+      user_err Pp.(str "Anonymous pattern not allowed for inversion equations.")
   | IntroNaming (IntroFresh _) ->
-      error "Fresh pattern not allowed for inversion equations."
+      user_err Pp.(str "Fresh pattern not allowed for inversion equations.")
   | IntroAction IntroWildcard ->
-      error "Discarding pattern not allowed for inversion equations."
+      user_err Pp.(str "Discarding pattern not allowed for inversion equations.")
   | IntroAction (IntroRewrite _) ->
-      error "Rewriting pattern not allowed for inversion equations."
+      user_err Pp.(str "Rewriting pattern not allowed for inversion equations.")
   | IntroAction (IntroOrAndPattern (IntroAndPattern [])) when allow_conj -> (None, [])
-  | IntroAction (IntroOrAndPattern (IntroAndPattern ((_,IntroNaming (IntroIdentifier id)) :: _ as l) | IntroOrPattern [(_,IntroNaming (IntroIdentifier id)) :: _ as l ]))
+  | IntroAction (IntroOrAndPattern (IntroAndPattern ({CAst.v=IntroNaming (IntroIdentifier id)} :: _ as l)
+                                   | IntroOrPattern [{CAst.v=IntroNaming (IntroIdentifier id)} :: _ as l]))
       when allow_conj -> (Some id,l)
   | IntroAction (IntroOrAndPattern (IntroAndPattern _)) ->
       if issimple then
-        error"Conjunctive patterns not allowed for simple inversion equations."
+        user_err Pp.(str"Conjunctive patterns not allowed for simple inversion equations.")
       else
-        error"Nested conjunctive patterns not allowed for inversion equations."
+        user_err Pp.(str"Nested conjunctive patterns not allowed for inversion equations.")
   | IntroAction (IntroInjection l) ->
-      error "Injection patterns not allowed for inversion equations."
+      user_err Pp.(str "Injection patterns not allowed for inversion equations.")
   | IntroAction (IntroOrAndPattern (IntroOrPattern _)) ->
-      error "Disjunctive patterns not allowed for inversion equations."
+      user_err Pp.(str "Disjunctive patterns not allowed for inversion equations.")
   | IntroAction (IntroApplyOn (c,pat)) ->
-      error "Apply patterns not allowed for inversion equations."
+      user_err Pp.(str "Apply patterns not allowed for inversion equations.")
   | IntroNaming (IntroIdentifier id) ->
       (Some id,[x])
 
@@ -331,21 +338,32 @@ let remember_first_eq id x = if !x == MoveLast then x := MoveAfter id
    If it can discriminate then the goal is proved, if not tries to use it as
    a rewrite rule. It erases the clause which is given as input *)
 
+let dest_nf_eq env sigma t = match EConstr.kind sigma t with
+| App (r, [| t; x; y |]) ->
+  let open Reductionops in
+  let lazy eq = Coqlib.coq_eq_ref in
+  if EConstr.is_global sigma eq r then
+    (t, whd_all env sigma x, whd_all env sigma y)
+  else user_err Pp.(str "Not an equality.")
+| _ ->
+  user_err Pp.(str "Not an equality.")
+
 let projectAndApply as_mode thin avoid id eqname names depids =
   let subst_hyp l2r id =
-    tclTHEN (tclTRY(rewriteInConcl l2r (mkVar id)))
+    tclTHEN (tclTRY(rewriteInConcl l2r (EConstr.mkVar id)))
       (if thin then clear [id] else (remember_first_eq id eqname; tclIDTAC))
   in
   let substHypIfVariable tac id =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
+    let sigma = project gl in
     (** We only look at the type of hypothesis "id" *)
-    let hyp = pf_nf_evar gl (pf_get_hyp_typ id (Proofview.Goal.assume gl)) in
-    let (t,t1,t2) = Hipattern.dest_nf_eq gl hyp in
-    match (kind_of_term t1, kind_of_term t2) with
+    let hyp = pf_nf_evar gl (pf_get_hyp_typ id gl) in
+    let (t,t1,t2) = dest_nf_eq (pf_env gl) sigma hyp in
+    match (EConstr.kind sigma t1, EConstr.kind sigma t2) with
     | Var id1, _ -> generalizeRewriteIntros as_mode (subst_hyp true id) depids id1
     | _, Var id2 -> generalizeRewriteIntros as_mode (subst_hyp false id) depids id2
     | _ -> tac id
-    end }
+    end
   in
   let deq_trailer id clear_flag _ neqns =
     assert (clear_flag == None);
@@ -367,12 +385,12 @@ let projectAndApply as_mode thin avoid id eqname names depids =
     (* If no immediate variable in the equation, try to decompose it *)
     (* and apply a trailer which again try to substitute *)
     (fun id ->
-      dEqThen false (deq_trailer id)
-	(Some (None,ElimOnConstr (mkVar id,NoBindings))))
+      dEqThen ~keep_proofs:None false (deq_trailer id)
+	(Some (None,ElimOnConstr (EConstr.mkVar id,NoBindings))))
     id
 
 let nLastDecls i tac =
-  Proofview.Goal.nf_enter { enter = begin fun gl -> tac (nLastDecls gl i) end }
+  Proofview.Goal.enter begin fun gl -> tac (nLastDecls gl i) end
 
 (* Introduction of the equations on arguments
    othin: discriminates Simple Inversion, Inversion and Inversion_clear
@@ -380,10 +398,10 @@ let nLastDecls i tac =
      Some thin: the equations are rewritten, and cleared if thin is true *)
 
 let rewrite_equations as_mode othin neqns names ba =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let (depids,nodepids) = split_dep_and_nodep ba.Tacticals.assums gl in
   let first_eq = ref MoveLast in
-  let avoid = if as_mode then List.map get_id nodepids else [] in
+  let avoid = if as_mode then Id.Set.of_list (List.map NamedDecl.get_id nodepids) else Id.Set.empty in
   match othin with
     | Some thin ->
         tclTHENLIST
@@ -399,10 +417,10 @@ let rewrite_equations as_mode othin neqns names ba =
 		   tclTRY (projectAndApply as_mode thin avoid id first_eq names depids)))))
 	       names;
 	     tclMAP (fun d -> tclIDTAC >>= fun () -> (* delay for [first_eq]. *)
-               let idopt = if as_mode then Some (get_id d) else None in
+               let idopt = if as_mode then Some (NamedDecl.get_id d) else None in
 	       intro_move idopt (if thin then MoveLast else !first_eq))
 	       nodepids;
-	     (tclMAP (fun d -> tclTRY (clear [get_id d])) depids)]
+	     (tclMAP (fun d -> tclTRY (clear [NamedDecl.get_id d])) depids)]
     | None ->
         (* simple inversion *)
         if as_mode then
@@ -413,7 +431,7 @@ let rewrite_equations as_mode othin neqns names ba =
              [tclDO neqns intro;
               bring_hyps nodepids;
               clear (ids_of_named_context nodepids)])
-  end }
+  end
 
 let interp_inversion_kind = function
   | SimpleInversion -> None
@@ -430,17 +448,16 @@ let rewrite_equations_tac as_mode othin id neqns names ba =
     tac
 
 let raw_inversion inv_kind id status names =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let sigma = Sigma.to_evar_map sigma in
     let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl gl in
     let c = mkVar id in
     let (ind, t) =
       try pf_apply Tacred.reduce_to_atomic_ind gl (pf_unsafe_type_of gl c)
       with UserError _ ->
-        let msg = str "The type of " ++ pr_id id ++ str " is not inductive." in
-        CErrors.errorlabstrm "" msg
+        let msg = str "The type of " ++ Id.print id ++ str " is not inductive." in
+        CErrors.user_err  msg
     in
     let IndType (indf,realargs) = find_rectype env sigma t in
     let evdref = ref sigma in
@@ -448,30 +465,28 @@ let raw_inversion inv_kind id status names =
       make_inv_predicate env evdref indf realargs id status concl in
     let sigma = !evdref in
     let (cut_concl,case_tac) =
-      if status != NoDep && (dependent c concl) then
-        Reduction.beta_appvect elim_predicate (Array.of_list (realargs@[c])),
+      if status != NoDep && (dependent sigma c concl) then
+        Reductionops.beta_applist sigma (elim_predicate, realargs@[c]),
         case_then_using
       else
-        Reduction.beta_appvect elim_predicate (Array.of_list realargs),
+        Reductionops.beta_applist sigma (elim_predicate, realargs),
         case_nodep_then_using
     in
     let refined id =
       let prf = mkApp (mkVar id, args) in
-      Refine.refine { run = fun h -> Sigma (prf, h, Sigma.refl) }
+      Refine.refine ~typecheck:false (fun h -> (h, prf))
     in
     let neqns = List.length realargs in
     let as_mode = names != None in
-    let tac =
+    tclTHEN (Proofview.Unsafe.tclEVARS sigma)
       (tclTHENS
         (assert_before Anonymous cut_concl)
         [case_tac names
             (introCaseAssumsThen false (* ApplyOn not supported by inversion *)
                (rewrite_equations_tac as_mode inv_kind id neqns))
-            (Some elim_predicate) ind (c, t);
+            (Some elim_predicate) ind (c,t);
         onLastHypId (fun id -> tclTHEN (refined id) reflexivity)])
-    in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+  end
 
 (* Error messages of the inversion tactics *)
 let wrap_inv_error id = function (e, info) -> match e with
@@ -496,8 +511,6 @@ let inversion inv_kind status names id =
 let inv_gen thin status names =
   try_intros_until (inversion thin status names)
 
-open Tacexpr
-
 let inv k = inv_gen k NoDep
 
 let inv_tac id       = inv FullInversion None (NamedHyp id)
@@ -513,21 +526,23 @@ let dinv_clear_tac id = dinv FullInversionClear None None (NamedHyp id)
  * back to their places in the hyp-list. *)
 
 let invIn k names ids id =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let hyps = List.map (fun id -> pf_get_hyp id gl) ids in
     let concl = Proofview.Goal.concl gl in
-    let nb_prod_init = nb_prod concl in
+    let sigma = project gl in
+    let nb_prod_init = nb_prod sigma concl in
     let intros_replace_ids =
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let sigma = project gl in
         let nb_of_new_hyp =
-          nb_prod concl - (List.length hyps + nb_prod_init)
+          nb_prod sigma concl - (List.length hyps + nb_prod_init)
         in
         if nb_of_new_hyp < 1 then
           intros_replacing ids
         else
           tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids)
-      end }
+      end
     in
     Proofview.tclORELSE
       (tclTHENLIST
@@ -535,7 +550,7 @@ let invIn k names ids id =
           inversion k NoDep names id;
           intros_replace_ids])
       (wrap_inv_error id)
-  end }
+  end
 
 let invIn_gen k names idl = try_intros_until (invIn k names idl)
 
diff --git a/tactics/inv.mli b/tactics/inv.mli
index af1cb996..c63d57af 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Misctypes
-open Tacexpr
+open Tactypes
 
 type inversion_status = Dep of constr option | NoDep
 
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 40b600c8..a4cdc159 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -11,27 +13,29 @@ open CErrors
 open Util
 open Names
 open Term
-open Vars
 open Termops
+open Environ
+open EConstr
+open Vars
 open Namegen
 open Evd
 open Printer
 open Reductionops
 open Entries
 open Inductiveops
-open Environ
 open Tacmach.New
 open Clenv
 open Declare
 open Tacticals.New
 open Tactics
 open Decl_kinds
-open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let no_inductive_inconstr env sigma constr =
   (str "Cannot recognize an inductive predicate in " ++
-     pr_lconstr_env env sigma constr ++
+     pr_leconstr_env env sigma constr ++
      str "." ++ spc () ++ str "If there is one, may be the structure of the arity" ++
      spc () ++ str "or of the type of constructors" ++ spc () ++
      str "is hidden by constant definitions.")
@@ -114,13 +118,13 @@ let max_prefix_sign lid sign =
     | id::l -> snd (max_rec (id, sign_prefix id sign) l)
 *)
 let rec add_prods_sign env sigma t =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Prod (na,c1,b) ->
-	let id = id_of_name_using_hdchar env t na in
+	let id = id_of_name_using_hdchar env sigma t na in
 	let b'= subst1 (mkVar id) b in
         add_prods_sign (push_named (LocalAssum (id,c1)) env) sigma b'
     | LetIn (na,c1,t1,b) ->
-	let id = id_of_name_using_hdchar env t na in
+	let id = id_of_name_using_hdchar env sigma t na in
 	let b'= subst1 (mkVar id) b in
         add_prods_sign (push_named (LocalDef (id,c1,t1)) env) sigma b'
     | _ -> (env,t)
@@ -140,11 +144,11 @@ let rec add_prods_sign env sigma t =
 
 let compute_first_inversion_scheme env sigma ind sort dep_option =
   let indf,realargs = dest_ind_type ind in
-  let allvars = ids_of_context env in
+  let allvars = vars_of_env env in
   let p = next_ident_away (Id.of_string "P") allvars in
   let pty,goal =
     if dep_option  then
-      let pty = make_arity env true indf sort in
+      let pty = make_arity env sigma true indf sort in
       let goal =
 	mkProd
 	  (Anonymous, mkAppliedInd ind, applist(mkVar p,realargs@[mkRel 1]))
@@ -152,11 +156,12 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       pty,goal
     else
       let i = mkAppliedInd ind in
-      let ivars = global_vars env i in
+      let ivars = global_vars env sigma i in
       let revargs,ownsign =
 	fold_named_context
 	  (fun env d (revargs,hyps) ->
-             let id = get_id d in
+            let d = map_named_decl EConstr.of_constr d in
+             let id = NamedDecl.get_id d in
              if Id.List.mem id ivars then
 	       ((mkVar id)::revargs, Context.Named.add d hyps)
 	     else
@@ -183,17 +188,17 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ind =
     try find_rectype env sigma i
     with Not_found ->
-      errorlabstrm "inversion_scheme" (no_inductive_inconstr env sigma i)
+      user_err ~hdr:"inversion_scheme" (no_inductive_inconstr env sigma i)
   in
   let (invEnv,invGoal) =
     compute_first_inversion_scheme env sigma ind sort dep_option
   in
   assert
     (List.subset
-       (global_vars env invGoal)
+       (global_vars env sigma invGoal)
        (ids_of_named_context (named_context invEnv)));
   (*
-    errorlabstrm "lemma_inversion"
+    user_err ~hdr:"lemma_inversion"
     (str"Computed inversion goal was not closed in initial signature.");
   *)
   let pf = Proof.start (Evd.from_ctx (evar_universe_context sigma)) [invEnv,invGoal] in
@@ -206,84 +211,91 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ownSign = ref begin
     fold_named_context
       (fun env d sign ->
-         if mem_named_context_val (get_id d) global_named_context then sign
+        let d = map_named_decl EConstr.of_constr d in
+         if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
 	 else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
-  let avoid = ref [] in
-  let { sigma=sigma } = Proof.V82.subgoals pf in
-  let sigma = Evd.nf_constraints sigma in
+  let avoid = ref Id.Set.empty in
+  let _,_,_,_,sigma = Proof.proof pf in
+  let sigma = Evd.minimize_universes sigma in
   let rec fill_holes c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Evar (e,args) ->
 	let h = next_ident_away (Id.of_string "H") !avoid in
 	let ty,inst = Evarutil.generalize_evar_over_rels sigma (e,args) in
-	avoid := h::!avoid;
+	avoid := Id.Set.add h !avoid;
 	ownSign := Context.Named.add (LocalAssum (h,ty)) !ownSign;
 	applist (mkVar h, inst)
-    | _ -> Constr.map fill_holes c
+    | _ -> EConstr.map sigma fill_holes c
   in
   let c = fill_holes pfterm in
   (* warning: side-effect on ownSign *)
   let invProof = it_mkNamedLambda_or_LetIn c !ownSign in
+  let invProof = EConstr.Unsafe.to_constr invProof in
   let p = Evarutil.nf_evars_universes sigma invProof in
-    p, Evd.universe_context sigma
+    p, sigma
 
-let add_inversion_lemma name env sigma t sort dep inv_op =
-  let invProof, ctx = inversion_scheme env sigma t sort dep inv_op in
-  let entry = definition_entry ~poly:(Flags.use_polymorphic_flag ())
-			       ~univs:(snd ctx) invProof in
+let add_inversion_lemma ~poly name env sigma t sort dep inv_op =
+  let invProof, sigma = inversion_scheme env sigma t sort dep inv_op in
+  let univs =
+    Evd.const_univ_entry ~poly sigma
+  in
+  let entry = definition_entry ~univs invProof in
   let _ = declare_constant name (DefinitionEntry entry, IsProof Lemma) in
   ()
 
 (* inv_op = Inv (derives de complete inv. lemma)
  * inv_op = InvNoThining (derives de semi inversion lemma) *)
 
-let add_inversion_lemma_exn na com comsort bool tac =
+let add_inversion_lemma_exn ~poly na com comsort bool tac =
   let env = Global.env () in
-  let evd = ref (Evd.from_env env) in
-  let c = Constrintern.interp_type_evars env evd com in
-  let sigma, sort = Pretyping.interp_sort !evd comsort in
+  let sigma = Evd.from_env env in
+  let sigma, c = Constrintern.interp_type_evars env sigma com in
+  let sigma, sort = Evd.fresh_sort_in_family ~rigid:univ_rigid env sigma comsort in
   try
-    add_inversion_lemma na env sigma c sort bool tac
+    add_inversion_lemma ~poly na env sigma c sort bool tac
   with
-    |   UserError ("Case analysis",s) -> (* Reference to Indrec *)
-	  errorlabstrm "Inv needs Nodep Prop Set" s
+    |   UserError (Some "Case analysis",s) -> (* Reference to Indrec *)
+	  user_err ~hdr:"Inv needs Nodep Prop Set" s
 
 (* ================================= *)
 (* Applying a given inversion lemma  *)
 (* ================================= *)
 
-let lemInv id c gls =
+let lemInv id c =
+  Proofview.Goal.enter begin fun gls ->
   try
-    let clause = mk_clenv_type_of gls c in
-    let clause = clenv_constrain_last_binding (mkVar id) clause in
-    Proofview.V82.of_tactic (Clenvtac.res_pf clause ~flags:(Unification.elim_flags ()) ~with_evars:false) gls
+    let clause = mk_clenv_from_env (pf_env gls) (project gls) None (c, pf_unsafe_type_of gls c) in
+    let clause = clenv_constrain_last_binding (EConstr.mkVar id) clause in
+    Clenvtac.res_pf clause ~flags:(Unification.elim_flags ()) ~with_evars:false
   with
     | NoSuchBinding ->
-	errorlabstrm ""
-	  (hov 0 (pr_constr c ++ spc () ++ str "does not refer to an inversion lemma."))
+	user_err 
+	  (hov 0 (pr_econstr_env (pf_env gls) (project gls) c ++ spc () ++ str "does not refer to an inversion lemma."))
     | UserError (a,b) ->
-	 errorlabstrm "LemInv"
+	 user_err ~hdr:"LemInv"
 	   (str "Cannot refine current goal with the lemma " ++
-	      pr_lconstr_env (Refiner.pf_env gls) (Refiner.project gls) c)
+	      pr_leconstr_env (pf_env gls) (project gls) c)
+  end
 
-let lemInv_gen id c = try_intros_until (fun id -> Proofview.V82.tactic (lemInv id c)) id
+let lemInv_gen id c = try_intros_until (fun id -> lemInv id c) id
 
 let lemInvIn id c ids =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let hyps = List.map (fun id -> pf_get_hyp id gl) ids in
     let intros_replace_ids =
       let concl = Proofview.Goal.concl gl in
-      let nb_of_new_hyp  = nb_prod concl - List.length ids in
+      let sigma = project gl in
+      let nb_of_new_hyp = nb_prod sigma concl - List.length ids in
       if nb_of_new_hyp < 1  then
         intros_replacing ids
       else
         (tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids))
     in
-    ((tclTHEN (tclTHEN (bring_hyps hyps) (Proofview.V82.tactic (lemInv id c)))
+    ((tclTHEN (tclTHEN (bring_hyps hyps) (lemInv id c))
         (intros_replace_ids)))
-  end }
+  end
 
 let lemInvIn_gen id c l = try_intros_until (fun id -> lemInvIn id c l) id
 
diff --git a/tactics/leminv.mli b/tactics/leminv.mli
index c6ed9606..2337a790 100644
--- a/tactics/leminv.mli
+++ b/tactics/leminv.mli
@@ -1,19 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Constrexpr
 open Misctypes
 
 val lemInv_clause :
   quantified_hypothesis -> constr -> Id.t list -> unit Proofview.tactic
 
-val add_inversion_lemma_exn :
-  Id.t -> constr_expr -> glob_sort -> bool -> (Id.t -> unit Proofview.tactic) ->
+val add_inversion_lemma_exn : poly:bool ->
+  Id.t -> constr_expr -> Sorts.family -> bool -> (Id.t -> unit Proofview.tactic) ->
     unit
diff --git a/tactics/tactic_matching.ml b/tactics/tactic_matching.ml
deleted file mode 100644
index 004492e7..00000000
--- a/tactics/tactic_matching.ml
+++ /dev/null
@@ -1,375 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This file extends Matching with the main logic for Ltac's
-    (lazy)match and (lazy)match goal. *)
-
-open Names
-open Tacexpr
-open Context.Named.Declaration
-
-(** [t] is the type of matching successes. It ultimately contains a
-    {!Tacexpr.glob_tactic_expr} representing the left-hand side of the
-    corresponding matching rule, a matching substitution to be
-    applied, a context substitution mapping identifier to context like
-    those of {!Matching.matching_result}), and a {!Term.constr}
-    substitution mapping corresponding to matched hypotheses. *)
-type 'a t = {
-  subst : Constr_matching.bound_ident_map * Pattern.extended_patvar_map ;
-  context : Term.constr Id.Map.t;
-  terms : Term.constr Id.Map.t;
-  lhs : 'a;
-}
-
-
-
-(** {6 Utilities} *)
-
-
-(** Some of the functions of {!Matching} return the substitution with a
-    [patvar_map] instead of an [extended_patvar_map]. [adjust] coerces
-    substitution of the former type to the latter. *)
-let adjust : Constr_matching.bound_ident_map * Pattern.patvar_map ->
-             Constr_matching.bound_ident_map * Pattern.extended_patvar_map =
-  fun (l, lc) -> (l, Id.Map.map (fun c -> [], c) lc)
-
-
-(** Adds a binding to a {!Id.Map.t} if the identifier is [Some id] *)
-let id_map_try_add id x m =
-  match id with
-  | Some id -> Id.Map.add id x m
-  | None -> m
-
-(** Adds a binding to a {!Id.Map.t} if the name is [Name id] *)
-let id_map_try_add_name id x m =
-  match id with
-  | Name id -> Id.Map.add id x m
-  | Anonymous -> m
-
-(** Takes the union of two {!Id.Map.t}. If there is conflict,
-    the binding of the right-hand argument shadows that of the left-hand
-    argument. *)
-let id_map_right_biased_union m1 m2 =
-  if Id.Map.is_empty m1 then m2 (** Don't reconstruct the whole map *)
-  else Id.Map.fold Id.Map.add m2 m1
-
-(** Tests whether the substitution [s] is empty. *)
-let is_empty_subst (ln,lm) =
-  Id.Map.(is_empty ln && is_empty lm)
-
-(** {6 Non-linear patterns} *)
-
-
-(** The patterns of Ltac are not necessarily linear. Non-linear
-    pattern are partially handled by the {!Matching} module, however
-    goal patterns are not primitive to {!Matching}, hence we must deal
-    with non-linearity between hypotheses and conclusion. Subterms are
-    considered equal up to the equality implemented in
-    [equal_instances]. *)
-(* spiwack: it doesn't seem to be quite the same rule for non-linear
-   term patterns and non-linearity between hypotheses and/or
-   conclusion. Indeed, in [Matching], matching is made modulo
-   syntactic equality, and here we merge modulo conversion. It may be
-   a good idea to have an entry point of [Matching] with a partial
-   substitution as argument instead of merging substitution here. That
-   would ensure consistency. *)
-let equal_instances env sigma (ctx',c') (ctx,c) =
-  (* How to compare instances? Do we want the terms to be convertible?
-     unifiable? Do we want the universe levels to be relevant? 
-     (historically, conv_x is used) *)
-  CList.equal Id.equal ctx ctx' && Reductionops.is_conv env sigma c' c
-
-
-(** Merges two substitutions. Raises [Not_coherent_metas] when
-    encountering two instances of the same metavariable which are not
-    equal according to {!equal_instances}. *)
-exception Not_coherent_metas
-let verify_metas_coherence env sigma (ln1,lcm) (ln,lm) =
-  let merge id oc1 oc2 = match oc1, oc2 with
-    | None, None -> None
-    | None, Some c | Some c, None -> Some c
-    | Some c1, Some c2 ->
-        if equal_instances env sigma c1 c2 then Some c1
-        else raise Not_coherent_metas
-  in
-  let (+++) lfun1 lfun2 = Id.Map.fold Id.Map.add lfun1 lfun2 in
-  (** ppedrot: Is that even correct? *)
-  let merged = ln +++ ln1 in
-  (merged, Id.Map.merge merge lcm lm)
-
-let matching_error =
-  CErrors.UserError ("tactic matching" , Pp.str "No matching clauses for match.")
-
-let imatching_error = (matching_error, Exninfo.null)
-
-(** A functor is introduced to share the environment and the
-    evar_map. They do not change and it would be a pity to introduce
-    closures everywhere just for the occasional calls to
-    {!equal_instances}. *)
-module type StaticEnvironment = sig
-  val env : Environ.env
-  val sigma : Evd.evar_map
-end
-module PatternMatching (E:StaticEnvironment) = struct
-
-
-  (** {6 The pattern-matching monad } *)
-
-
-  (** To focus on the algorithmic portion of pattern-matching, the
-      bookkeeping is relegated to a monad: the composition of the
-      bactracking monad of {!IStream.t} with a "writer" effect. *)
-  (* spiwack: as we don't benefit from the various stream optimisations
-     of Haskell, it may be costly to give the monad in direct style such as
-     here. We may want to use some continuation passing style. *)
-  type 'a tac = 'a Proofview.tactic
-  type 'a m = { stream : 'r. ('a -> unit t -> 'r tac) -> unit t -> 'r tac }
-
-  (** The empty substitution. *)
-  let empty_subst = Id.Map.empty , Id.Map.empty
-
-  (** Composes two substitutions using {!verify_metas_coherence}. It
-      must be a monoid with neutral element {!empty_subst}. Raises
-      [Not_coherent_metas] when composition cannot be achieved. *)
-  let subst_prod s1 s2 =
-    if is_empty_subst s1 then s2
-    else if is_empty_subst s2 then s1
-    else verify_metas_coherence E.env E.sigma s1 s2
-
-  (** The empty context substitution. *)
-  let empty_context_subst = Id.Map.empty
-
-  (** Compose two context substitutions, in case of conflict the
-      right hand substitution shadows the left hand one. *)
-  let context_subst_prod = id_map_right_biased_union
-
-  (** The empty term substitution. *)
-  let empty_term_subst = Id.Map.empty
-
-  (** Compose two terms substitutions, in case of conflict the
-      right hand substitution shadows the left hand one. *)
-  let term_subst_prod = id_map_right_biased_union
-
-  (** Merge two writers (and ignore the first value component). *)
-  let merge m1 m2 =
-    try Some {
-      subst = subst_prod m1.subst m2.subst;
-      context = context_subst_prod m1.context m2.context;
-      terms = term_subst_prod m1.terms m2.terms;
-      lhs = m2.lhs;
-    }
-    with Not_coherent_metas -> None
-
-  (** Monadic [return]: returns a single success with empty substitutions. *)
-  let return (type a) (lhs:a) : a m =
-    { stream = fun k ctx -> k lhs ctx }
-
-  (** Monadic bind: each success of [x] is replaced by the successes
-      of [f x]. The substitutions of [x] and [f x] are composed,
-      dropping the apparent successes when the substitutions are not
-      coherent. *)
-  let (>>=) (type a) (type b) (m:a m) (f:a -> b m) : b m =
-    { stream = fun k ctx -> m.stream (fun x ctx -> (f x).stream k ctx) ctx }
-
-  (** A variant of [(>>=)] when the first argument returns [unit]. *)
-  let (<*>) (type a) (m:unit m) (y:a m) : a m =
-    { stream = fun k ctx -> m.stream (fun () ctx -> y.stream k ctx) ctx }
-
-  (** Failure of the pattern-matching monad: no success. *)
-  let fail (type a) : a m = { stream = fun _ _ -> Proofview.tclZERO matching_error }
-
-  let run (m : 'a m) =
-    let ctx = {
-      subst = empty_subst ;
-      context = empty_context_subst ;
-      terms = empty_term_subst ;
-      lhs = ();
-    } in
-    let eval lhs ctx = Proofview.tclUNIT { ctx with lhs } in
-    m.stream eval ctx
-
-  (** Chooses in a list, in the same order as the list *)
-  let rec pick (l:'a list) (e, info) : 'a m = match l with
-  | [] -> { stream = fun _ _ -> Proofview.tclZERO ~info e }
-  | x :: l ->
-    { stream = fun k ctx -> Proofview.tclOR (k x ctx) (fun e -> (pick l e).stream k ctx) }
-
-  let pick l = pick l imatching_error
-
-  (** Declares a subsitution, a context substitution and a term substitution. *)
-  let put subst context terms : unit m =
-    let s = { subst ; context ; terms ; lhs = () } in
-    { stream = fun k ctx -> match merge s ctx with None -> Proofview.tclZERO matching_error | Some s -> k () s }
-
-  (** Declares a substitution. *)
-  let put_subst subst : unit m = put subst empty_context_subst empty_term_subst
-
-  (** Declares a term substitution. *)
-  let put_terms terms : unit m = put empty_subst empty_context_subst terms
-
-
-
-  (** {6 Pattern-matching} *)
-
-
-  (** [wildcard_match_term lhs] matches a term against a wildcard
-      pattern ([_ => lhs]). It has a single success with an empty
-      substitution. *)
-  let wildcard_match_term = return
-
-  (** [pattern_match_term refresh pat term lhs] returns the possible
-      matchings of [term] with the pattern [pat => lhs]. If refresh is
-      true, refreshes the universes of [term]. *)
-  let pattern_match_term refresh pat term lhs = 
-(*     let term = if refresh then Termops.refresh_universes_strict term else term in *)
-    match pat with
-    | Term p ->
-        begin 
-          try
-            put_subst (Constr_matching.extended_matches E.env E.sigma p term) <*>
-            return lhs
-          with Constr_matching.PatternMatchingFailure -> fail
-        end
-    | Subterm (with_app_context,id_ctxt,p) ->
-
-      let rec map s (e, info) =
-        { stream = fun k ctx -> match IStream.peek s with
-          | IStream.Nil -> Proofview.tclZERO ~info e
-          | IStream.Cons ({ Constr_matching.m_sub ; m_ctx }, s) ->
-            let subst = adjust m_sub in
-            let context = id_map_try_add id_ctxt m_ctx Id.Map.empty in
-            let terms = empty_term_subst in
-            let nctx = { subst ; context ; terms ; lhs = () } in
-            match merge ctx nctx with
-            | None -> (map s (e, info)).stream k ctx
-            | Some nctx -> Proofview.tclOR (k lhs nctx) (fun e -> (map s e).stream k ctx)
-        }
-      in
-      map (Constr_matching.match_subterm_gen E.env E.sigma with_app_context p term) imatching_error
-
-
-  (** [rule_match_term term rule] matches the term [term] with the
-      matching rule [rule]. *)
-  let rule_match_term term = function
-    | All lhs -> wildcard_match_term lhs
-    | Pat ([],pat,lhs) -> pattern_match_term false pat term lhs
-    | Pat _ ->
-        (** Rules with hypotheses, only work in match goal. *)
-        fail
-
-  (** [match_term term rules] matches the term [term] with the set of
-      matching rules [rules].*)
-  let rec match_term (e, info) term rules = match rules with
-  | [] -> { stream = fun _ _ -> Proofview.tclZERO ~info e }
-  | r :: rules ->
-    { stream = fun k ctx ->
-      let head = rule_match_term term r in
-      let tail e = match_term e term rules in
-      Proofview.tclOR (head.stream k ctx) (fun e -> (tail e).stream k ctx)
-    }
-
-
-  (** [hyp_match_type hypname pat hyps] matches a single
-      hypothesis pattern [hypname:pat] against the hypotheses in
-      [hyps]. Tries the hypotheses in order. For each success returns
-      the name of the matched hypothesis. *)
-  let hyp_match_type hypname pat hyps =
-    pick hyps >>= fun decl ->
-    let id = get_id decl in
-    let refresh = is_local_def decl in
-    pattern_match_term refresh pat (get_type decl) () <*>
-    put_terms (id_map_try_add_name hypname (Term.mkVar id) empty_term_subst) <*>
-    return id
-
-  (** [hyp_match_type hypname bodypat typepat hyps] matches a single
-      hypothesis pattern [hypname := bodypat : typepat] against the
-      hypotheses in [hyps].Tries the hypotheses in order. For each
-      success returns the name of the matched hypothesis. *)
-  let hyp_match_body_and_type hypname bodypat typepat hyps =
-    pick hyps >>= function
-      | LocalDef (id,body,hyp) ->
-          pattern_match_term false bodypat body () <*>
-          pattern_match_term true typepat hyp () <*>
-          put_terms (id_map_try_add_name hypname (Term.mkVar id) empty_term_subst) <*>
-          return id
-      | LocalAssum (id,hyp) -> fail
-
-  (** [hyp_match pat hyps] dispatches to
-      {!hyp_match_type} or {!hyp_match_body_and_type} depending on whether
-      [pat] is [Hyp _] or [Def _]. *)
-  let hyp_match pat hyps =
-    match pat with
-    | Hyp ((_,hypname),typepat) ->
-        hyp_match_type hypname typepat hyps
-    | Def ((_,hypname),bodypat,typepat) ->
-        hyp_match_body_and_type hypname bodypat typepat hyps
-
-  (** [hyp_pattern_list_match pats hyps lhs], matches the list of
-      patterns [pats] against the hypotheses in [hyps], and eventually
-      returns [lhs]. *)
-  let rec hyp_pattern_list_match pats hyps lhs =
-    match pats with
-    | pat::pats ->
-        hyp_match pat hyps >>= fun matched_hyp ->
-        (* spiwack: alternatively it is possible to return the list
-           with the matched hypothesis removed directly in
-           [hyp_match]. *)
-        let select_matched_hyp decl = Id.equal (get_id decl) matched_hyp in
-        let hyps = CList.remove_first select_matched_hyp hyps in
-        hyp_pattern_list_match pats hyps lhs
-    | [] -> return lhs
-
-  (** [rule_match_goal hyps concl rule] matches the rule [rule]
-      against the goal [hyps|-concl]. *)
-  let rule_match_goal hyps concl = function
-    | All lhs -> wildcard_match_term lhs
-    | Pat (hyppats,conclpat,lhs) ->
-        (* the rules are applied from the topmost one (in the concrete
-           syntax) to the bottommost. *)
-        let hyppats = List.rev hyppats in
-        pattern_match_term false conclpat concl () <*>
-        hyp_pattern_list_match hyppats hyps lhs
-
-  (** [match_goal hyps concl rules] matches the goal [hyps|-concl]
-      with the set of matching rules [rules]. *)
-  let rec match_goal (e, info) hyps concl rules = match rules with
-  | [] -> { stream = fun _ _ -> Proofview.tclZERO ~info e }
-  | r :: rules ->
-    { stream = fun k ctx ->
-      let head = rule_match_goal hyps concl r in
-      let tail e = match_goal e hyps concl rules in
-      Proofview.tclOR (head.stream k ctx) (fun e -> (tail e).stream k ctx)
-    }
-
-end
-
-(** [match_term env sigma term rules] matches the term [term] with the
-    set of matching rules [rules]. The environment [env] and the
-    evar_map [sigma] are not currently used, but avoid code
-    duplication. *)
-let match_term env sigma term rules =
-  let module E = struct
-    let env = env
-    let sigma = sigma
-  end in
-  let module M = PatternMatching(E) in
-  M.run (M.match_term imatching_error term rules)
-
-
-(** [match_goal env sigma hyps concl rules] matches the goal
-    [hyps|-concl] with the set of matching rules [rules]. The
-    environment [env] and the evar_map [sigma] are used to check
-    convertibility for pattern variables shared between hypothesis
-    patterns or the conclusion pattern. *)
-let match_goal env sigma hyps concl rules =
-  let module E = struct
-    let env = env
-    let sigma = sigma
-  end in
-  let module M = PatternMatching(E) in
-  M.run (M.match_goal imatching_error hyps concl rules)
diff --git a/tactics/tactic_matching.mli b/tactics/tactic_matching.mli
deleted file mode 100644
index 090207bc..00000000
--- a/tactics/tactic_matching.mli
+++ /dev/null
@@ -1,49 +0,0 @@
- (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This file extends Matching with the main logic for Ltac's
-    (lazy)match and (lazy)match goal. *)
-
-
-(** [t] is the type of matching successes. It ultimately contains a
-    {!Tacexpr.glob_tactic_expr} representing the left-hand side of the
-    corresponding matching rule, a matching substitution to be
-    applied, a context substitution mapping identifier to context like
-    those of {!Matching.matching_result}), and a {!Term.constr}
-    substitution mapping corresponding to matched hypotheses. *)
-type 'a t = {
-  subst : Constr_matching.bound_ident_map * Pattern.extended_patvar_map ;
-  context : Term.constr Names.Id.Map.t;
-  terms : Term.constr Names.Id.Map.t;
-  lhs : 'a;
-}
-
-
-(** [match_term env sigma term rules] matches the term [term] with the
-    set of matching rules [rules]. The environment [env] and the
-    evar_map [sigma] are not currently used, but avoid code
-    duplication. *)
-val match_term :
-  Environ.env ->
-  Evd.evar_map ->
-  Term.constr ->
-  (Tacexpr.binding_bound_vars * Pattern.constr_pattern, Tacexpr.glob_tactic_expr) Tacexpr.match_rule list ->
-  Tacexpr.glob_tactic_expr t Proofview.tactic
-
-(** [match_goal env sigma hyps concl rules] matches the goal
-    [hyps|-concl] with the set of matching rules [rules]. The
-    environment [env] and the evar_map [sigma] are used to check
-    convertibility for pattern variables shared between hypothesis
-    patterns or the conclusion pattern. *)
-val match_goal:
-  Environ.env ->
-  Evd.evar_map ->
-  Context.Named.t ->
-  Term.constr ->
-  (Tacexpr.binding_bound_vars * Pattern.constr_pattern, Tacexpr.glob_tactic_expr) Tacexpr.match_rule list ->
-  Tacexpr.glob_tactic_expr t Proofview.tactic
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 66da9ee1..958a205a 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -1,22 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
+open EConstr
 open Termops
 open Declarations
 open Tacmach
 open Clenv
-open Sigma.Notations
-open Context.Named.Declaration
+open Tactypes
+
+module NamedDecl = Context.Named.Declaration
 
 (************************************************************************)
 (* Tacticals re-exported from the Refiner module                        *)
@@ -48,10 +52,8 @@ let tclAT_LEAST_ONCE = Refiner.tclAT_LEAST_ONCE
 let tclFAIL          = Refiner.tclFAIL
 let tclFAIL_lazy     = Refiner.tclFAIL_lazy
 let tclDO            = Refiner.tclDO
-let tclWEAK_PROGRESS = Refiner.tclWEAK_PROGRESS
 let tclPROGRESS      = Refiner.tclPROGRESS
 let tclSHOWHYPS      = Refiner.tclSHOWHYPS
-let tclNOTSAMEGOAL   = Refiner.tclNOTSAMEGOAL
 let tclTHENTRY       = Refiner.tclTHENTRY
 let tclIFTHENELSE    = Refiner.tclIFTHENELSE
 let tclIFTHENSELSE   = Refiner.tclIFTHENSELSE
@@ -68,9 +70,9 @@ let tclTHENSEQ       = tclTHENLIST
 
 let nthDecl m gl =
   try List.nth (pf_hyps gl) (m-1)
-  with Failure _ -> error "No such assumption."
+  with Failure _ -> user_err Pp.(str "No such assumption.")
 
-let nthHypId m gl = nthDecl m gl |> get_id
+let nthHypId m gl = nthDecl m gl |> NamedDecl.get_id
 let nthHyp m gl   = mkVar (nthHypId m gl)
 
 let lastDecl gl   = nthDecl 1 gl
@@ -79,9 +81,9 @@ let lastHyp gl    = nthHyp 1 gl
 
 let nLastDecls n gl =
   try List.firstn n (pf_hyps gl)
-  with Failure _ -> error "Not enough hypotheses in the goal."
+  with Failure _ -> user_err Pp.(str "Not enough hypotheses in the goal.")
 
-let nLastHypsId n gl = List.map get_id (nLastDecls n gl)
+let nLastHypsId n gl = List.map (NamedDecl.get_id) (nLastDecls n gl)
 let nLastHyps n gl   = List.map mkVar (nLastHypsId n gl)
 
 let onNthDecl m tac gl  = tac (nthDecl m gl) gl
@@ -99,7 +101,7 @@ let onNLastHypsId n tac = onHyps (nLastHypsId n) tac
 let onNLastHyps n tac   = onHyps (nLastHyps n) tac
 
 let afterHyp id gl =
-  fst (List.split_when (Id.equal id % get_id) (pf_hyps gl))
+  fst (List.split_when (NamedDecl.get_id %> Id.equal id) (pf_hyps gl))
 
 (***************************************)
 (*           Clause Tacticals          *)
@@ -151,11 +153,11 @@ type branch_args = {
   nassums    : int;         (* number of assumptions/letin to be introduced *)
   branchsign : bool list;   (* the signature of the branch.
                                true=assumption, false=let-in *)
-  branchnames : Tacexpr.intro_patterns}
+  branchnames : intro_patterns}
 
 type branch_assumptions = {
   ba        : branch_args;       (* the branch args *)
-  assums    : Context.Named.t}   (* the list of assumptions introduced *)
+  assums    : named_context}   (* the list of assumptions introduced *)
 
 open Misctypes
 
@@ -168,23 +170,23 @@ let fix_empty_or_and_pattern nv l =
   | IntroOrPattern [[]] -> IntroOrPattern (List.make nv [])
   | _ -> l
 
-let check_or_and_pattern_size check_and loc names branchsigns =
+let check_or_and_pattern_size ?loc check_and names branchsigns =
   let n = Array.length branchsigns in
   let msg p1 p2 = strbrk "a conjunctive pattern made of " ++ int p1 ++ (if p1 == p2 then mt () else str " or " ++ int p2) ++ str " patterns" in
   let err1 p1 p2 =
-    user_err_loc (loc,"",str "Expects " ++ msg p1 p2 ++ str ".") in
+    user_err ?loc  (str "Expects " ++ msg p1 p2 ++ str ".") in
   let errn n =
-    user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n
+    user_err ?loc  (str "Expects a disjunctive pattern with " ++ int n
 	++ str " branches.") in
   let err1' p1 p2 =
-    user_err_loc (loc,"",strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
-  let errforthcoming loc =
-    user_err_loc (loc,"",strbrk "Unexpected non atomic pattern.") in
+    user_err ?loc  (strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
+  let errforthcoming ?loc =
+    user_err ?loc  (strbrk "Unexpected non atomic pattern.") in
   match names with
   | IntroAndPattern l ->
       if not (Int.equal n 1) then errn n;
-      let l' = List.filter (function _,IntroForthcoming _ -> true | _,IntroNaming _ | _,IntroAction _ -> false) l in
-      if l' != [] then errforthcoming (fst (List.hd l'));
+      let l' = List.filter CAst.(function {v=IntroForthcoming _} -> true | {v=IntroNaming _} | {v=IntroAction _} -> false) l in
+      if l' != [] then errforthcoming ?loc:(List.hd l').CAst.loc;
       if check_and then
         let p1 = List.count (fun x -> x) branchsigns.(0) in
         let p2 = List.length branchsigns.(0) in
@@ -192,7 +194,7 @@ let check_or_and_pattern_size check_and loc names branchsigns =
         if not (Int.equal p p1 || Int.equal p p2) then err1 p1 p2;
         if Int.equal p p1 then
           IntroAndPattern
-            (List.extend branchsigns.(0) (Loc.ghost,IntroNaming IntroAnonymous) l)
+            (List.extend branchsigns.(0) (CAst.make @@ IntroNaming IntroAnonymous) l)
         else
           names
       else
@@ -205,27 +207,27 @@ let check_or_and_pattern_size check_and loc names branchsigns =
           err1' p1 p2 else errn n;
       names
 
-let get_and_check_or_and_pattern_gen check_and loc names branchsigns =
-  let names = check_or_and_pattern_size check_and loc names branchsigns in
+let get_and_check_or_and_pattern_gen ?loc check_and names branchsigns =
+  let names = check_or_and_pattern_size ?loc check_and names branchsigns in
   match names with
   | IntroAndPattern l -> [|l|]
   | IntroOrPattern l -> Array.of_list l
 
-let get_and_check_or_and_pattern = get_and_check_or_and_pattern_gen true
+let get_and_check_or_and_pattern ?loc = get_and_check_or_and_pattern_gen ?loc true
 
 let compute_induction_names_gen check_and branchletsigns = function
   | None ->
       Array.make (Array.length branchletsigns) []
-  | Some (loc,names) ->
+  | Some {CAst.loc;v=names} ->
       let names = fix_empty_or_and_pattern (Array.length branchletsigns) names in
-      get_and_check_or_and_pattern_gen check_and loc names branchletsigns
+      get_and_check_or_and_pattern_gen check_and ?loc names branchletsigns
 
 let compute_induction_names = compute_induction_names_gen true
 
 (* Compute the let-in signature of case analysis or standard induction scheme *)
 let compute_constructor_signatures isrec ((_,k as ity),u) =
   let rec analrec c recargs =
-    match kind_of_term c, recargs with
+    match Constr.kind c, recargs with
     | Prod (_,_,c), recarg::rest ->
         let rest = analrec c rest in
         begin match Declareops.dest_recarg recarg with
@@ -236,12 +238,12 @@ let compute_constructor_signatures isrec ((_,k as ity),u) =
         end
     | LetIn (_,_,_,c), rest -> false :: analrec c rest
     | _, [] -> []
-    | _ -> anomaly (Pp.str "compute_constructor_signatures")
+    | _ -> anomaly (Pp.str "compute_constructor_signatures.")
   in
   let (mib,mip) = Global.lookup_inductive ity in
   let n = mib.mind_nparams in
   let lc =
-    Array.map (fun c -> snd (decompose_prod_n_assum n c)) mip.mind_nf_lc in
+    Array.map (fun c -> snd (Term.decompose_prod_n_assum n c)) mip.mind_nf_lc in
   let lrecargs = Declareops.dest_subterms mip.mind_recargs in
   Array.map2 analrec lc lrecargs
 
@@ -261,40 +263,7 @@ let pf_with_evars glsev k gls =
     tclTHEN (Refiner.tclEVARS evd) (k a) gls
 
 let pf_constr_of_global gr k =
-  pf_with_evars (fun gls -> pf_apply Evd.fresh_global gls gr) k
-
-(* computing the case/elim combinators *)
-
-let gl_make_elim ind gl =
-  let gr = Indrec.lookup_eliminator (fst ind) (elimination_sort_of_goal gl) in
-    pf_apply Evd.fresh_global gl gr
-
-let gl_make_case_dep ind gl =
-  let sigma = Sigma.Unsafe.of_evar_map (Tacmach.project gl) in
-  let Sigma (r, sigma, _) = Indrec.build_case_analysis_scheme (pf_env gl) sigma ind true
-    (elimination_sort_of_goal gl)
-  in
-  (Sigma.to_evar_map sigma, r)
-
-let gl_make_case_nodep ind gl =
-  let sigma = Sigma.Unsafe.of_evar_map (Tacmach.project gl) in
-  let Sigma (r, sigma, _) = Indrec.build_case_analysis_scheme (pf_env gl) sigma ind false
-    (elimination_sort_of_goal gl)
-  in
-  (Sigma.to_evar_map sigma, r)
-
-let make_elim_branch_assumptions ba gl =
-  let assums =
-    try List.rev (List.firstn ba.nassums (pf_hyps gl))
-    with Failure _ -> anomaly (Pp.str "make_elim_branch_assumptions") in
-  { ba = ba; assums = assums }
-
-let elim_on_ba tac ba gl = tac (make_elim_branch_assumptions ba gl) gl
-
-let make_case_branch_assumptions = make_elim_branch_assumptions
-
-let case_on_ba tac ba gl = tac (make_case_branch_assumptions ba gl) gl
-
+  pf_with_evars (fun gls -> on_snd EConstr.of_constr (pf_apply Evd.fresh_global gls gr)) k
 
 (** Tacticals of Ltac defined directly in term of Proofview *)
 module New = struct
@@ -311,7 +280,7 @@ module New = struct
     tclZERO (Refiner.FailError (lvl,lazy msg))
 
   let tclZEROMSG ?loc msg =
-    let err = UserError ("", msg) in
+    let err = UserError (None, msg) in
     let info = match loc with
     | None -> Exninfo.null
     | Some loc -> Loc.add_loc Exninfo.null loc
@@ -366,6 +335,16 @@ module New = struct
           catch_failerror e <*> t2
         end
     end
+
+  let tclORELSE0L t1 t2 =
+    tclINDEPENDENTL begin
+      tclORELSE
+        t1
+        begin fun e ->
+          catch_failerror e <*> t2
+        end
+    end
+
   let tclORELSE t1 t2 =
     tclORELSE0 (tclPROGRESS t1) t2
 
@@ -417,6 +396,9 @@ module New = struct
 
   let tclTRY t =
     tclORELSE0 t (tclUNIT ())
+  
+  let tclTRYb t =
+    tclORELSE0L (t <*> tclUNIT true) (tclUNIT false)
 
   let tclIFTHENELSE t1 t2 t3 =
     tclINDEPENDENT begin
@@ -428,8 +410,14 @@ module New = struct
     Proofview.tclIFCATCH t1
       (fun () -> tclDISPATCH (Array.to_list a))
       (fun _ -> t3)
+  let tclIFTHENFIRSTELSE t1 t2 t3 =
+    Proofview.tclIFCATCH t1
+      (fun () -> tclEXTEND [t2] (tclUNIT ()) [])
+      (fun _ -> t3)
   let tclIFTHENTRYELSEMUST t1 t2 =
     tclIFTHENELSE t1 (tclTRY t2) t2
+  let tclIFTHENFIRSTTRYELSEMUST t1 t2 =
+    tclIFTHENFIRSTELSE t1 (tclTRY t2) t2
 
   (* Try the first tactic that does not fail in a list of tactics *)
   let rec tclFIRST = function
@@ -478,19 +466,20 @@ module New = struct
 
   (* Select a subset of the goals *)
   let tclSELECT = function
-    | Tacexpr.SelectNth i -> Proofview.tclFOCUS i i
-    | Tacexpr.SelectList l -> Proofview.tclFOCUSLIST l
-    | Tacexpr.SelectId id -> Proofview.tclFOCUSID id
-    | Tacexpr.SelectAll -> fun tac -> tac
+    | Vernacexpr.SelectNth i -> Proofview.tclFOCUS i i
+    | Vernacexpr.SelectList l -> Proofview.tclFOCUSLIST l
+    | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id
+    | Vernacexpr.SelectAll -> fun tac -> tac
 
   (* Check that holes in arguments have been resolved *)
 
   let check_evars env sigma extsigma origsigma =
     let rec is_undefined_up_to_restriction sigma evk =
+      if Evd.mem origsigma evk then None else
       let evi = Evd.find sigma evk in
       match Evd.evar_body evi with
       | Evd.Evar_empty -> Some (evk,evi)
-      | Evd.Evar_defined c -> match Term.kind_of_term c with
+      | Evd.Evar_defined c -> match Constr.kind c with
         | Term.Evar (evk,l) -> is_undefined_up_to_restriction sigma evk
         | _ -> 
           (* We make the assumption that there is no way to refine an
@@ -500,7 +489,7 @@ module New = struct
     let rest =
       Evd.fold_undefined (fun evk evi acc ->
         match is_undefined_up_to_restriction sigma evk with
-        | Some (evk',evi) when not (Evd.mem origsigma evk) -> (evk',evi)::acc
+        | Some (evk',evi) -> (evk',evi)::acc
         | _ -> acc)
         extsigma []
     in
@@ -508,7 +497,7 @@ module New = struct
     | [] -> ()
     | (evk,evi) :: _ ->
       let (loc,_) = evi.Evd.evar_source in
-      Pretype_errors.error_unsolvable_implicit loc env sigma evk None
+      Pretype_errors.error_unsolvable_implicit ?loc env sigma evk None
 
   let tclWITHHOLES accept_unresolved_holes tac sigma =
     tclEVARMAP >>= fun sigma_initial ->
@@ -529,12 +518,12 @@ module New = struct
         Proofview.Unsafe.tclEVARS sigma <*> tac >>= check_evars_if
 
   let tclDELAYEDWITHHOLES check x tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let env = Proofview.Goal.env gl in
       let sigma = Proofview.Goal.sigma gl in
-      let Sigma (x, sigma, _) = x.Tacexpr.delayed env sigma in
-      tclWITHHOLES check (tac x) (Sigma.to_evar_map sigma)
-    end }
+      let (sigma, x) = x env sigma in
+      tclWITHHOLES check (tac x) sigma
+    end
 
   let tclTIMEOUT n t =
     Proofview.tclOR
@@ -551,99 +540,99 @@ module New = struct
     let hyps = Proofview.Goal.hyps gl in
     try
       List.nth hyps (m-1)
-    with Failure _ -> CErrors.error "No such assumption."
+    with Failure _ -> CErrors.user_err Pp.(str "No such assumption.")
 
   let nLastDecls gl n =
     try List.firstn n (Proofview.Goal.hyps gl)
-    with Failure _ -> error "Not enough hypotheses in the goal."
+    with Failure _ -> CErrors.user_err Pp.(str "Not enough hypotheses in the goal.")
 
   let nthHypId m gl =
     (** We only use [id] *)
-    let gl = Proofview.Goal.assume gl in
-    nthDecl m gl |> get_id
+    nthDecl m gl |> NamedDecl.get_id
   let nthHyp m gl = 
     mkVar (nthHypId m gl)
 
   let onNthHypId m tac =
-    Proofview.Goal.enter { enter = begin fun gl -> tac (nthHypId m gl) end }
+    Proofview.Goal.enter begin fun gl -> tac (nthHypId m gl) end 
   let onNthHyp m tac =
-    Proofview.Goal.enter { enter = begin fun gl -> tac (nthHyp m gl) end }
+    Proofview.Goal.enter begin fun gl -> tac (nthHyp m gl) end
 
   let onLastHypId = onNthHypId 1
   let onLastHyp   = onNthHyp 1
 
   let onNthDecl m tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       Proofview.tclUNIT (nthDecl m gl) >>= tac
-    end }
+    end
   let onLastDecl  = onNthDecl 1
 
   let ifOnHyp pred tac1 tac2 id =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let typ = Tacmach.New.pf_get_hyp_typ id gl in
     if pred (id,typ) then
       tac1 id
     else
       tac2 id
-    end }
+    end
 
-  let onHyps find tac = Proofview.Goal.nf_enter { enter = begin fun gl -> tac (find.enter gl) end }
+  let onHyps find tac = Proofview.Goal.enter begin fun gl -> tac (find gl) end
 
   let afterHyp id tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-    let rem, _ = List.split_when (Id.equal id % get_id) hyps in
+    Proofview.Goal.enter begin fun gl ->
+    let hyps = Proofview.Goal.hyps gl in
+    let rem, _ = List.split_when (NamedDecl.get_id %> Id.equal id) hyps in
     tac rem
-    end }
+    end
 
   let fullGoal gl =
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     None :: List.map Option.make hyps
 
   let tryAllHyps tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     tclFIRST_PROGRESS_ON tac hyps
-    end }
+    end
   let tryAllHypsAndConcl tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       tclFIRST_PROGRESS_ON tac (fullGoal gl)
-    end }
+    end
 
   let onClause tac cl =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     tclMAP tac (Locusops.simple_clause_of (fun () -> hyps) cl)
-    end }
+    end
 
   (* Find the right elimination suffix corresponding to the sort of the goal *)
   (* c should be of type A1->.. An->B with B an inductive definition *)
   let general_elim_then_using mk_elim
       isrec allnames tac predicate ind (c, t) =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let sigma, elim = Tacmach.New.of_old (mk_elim ind) gl in
+    Proofview.Goal.enter begin fun gl ->
+    let sigma, elim = mk_elim ind gl in
+    let ind = on_snd (fun u -> EInstance.kind sigma u) ind in
     Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
-    (Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let indclause = Tacmach.New.of_old (fun gl -> mk_clenv_from gl (c, t)) gl in
+    (Proofview.Goal.enter begin fun gl ->
+    let indclause = mk_clenv_from gl (c, t) in
     (* applying elimination_scheme just a little modified *)
-    let elimclause = Tacmach.New.of_old (fun gls -> mk_clenv_from gls (elim,Tacmach.New.pf_unsafe_type_of gl elim)) gl in
+    let elimclause = mk_clenv_from gl (elim,Tacmach.New.pf_unsafe_type_of gl elim)  in
     let indmv =
-      match kind_of_term (last_arg elimclause.templval.Evd.rebus) with
+      match EConstr.kind elimclause.evd (last_arg elimclause.evd elimclause.templval.Evd.rebus) with
       | Meta mv -> mv
-      | _         -> anomaly (str"elimination")
+      | _         -> anomaly (str"elimination.")
     in
     let pmv =
-      let p, _ = decompose_app elimclause.templtyp.Evd.rebus in
-      match kind_of_term p with
+      let p, _ = decompose_app elimclause.evd elimclause.templtyp.Evd.rebus in
+      match EConstr.kind elimclause.evd p with
       | Meta p -> p
       | _ ->
 	  let name_elim =
-	    match kind_of_term elim with
-	    | Const (kn, _) -> string_of_con kn
-	    | Var id -> string_of_id id
+	    match EConstr.kind sigma elim with
+	    | Const (kn, _) -> Constant.to_string kn
+	    | Var id -> Id.to_string id
 	    | _ -> "\b"
 	  in
-	  errorlabstrm "Tacticals.general_elim_then_using"
+	  user_err ~hdr:"Tacticals.general_elim_then_using"
             (str "The elimination combinator " ++ str name_elim ++ str " is unknown.")
     in
     let elimclause' = clenv_fchain ~with_univs:false indmv elimclause indclause in
@@ -655,9 +644,9 @@ module New = struct
       | None   -> elimclause'
       | Some p -> clenv_unify ~flags Reduction.CONV (mkMeta pmv) p elimclause'
     in
-    let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags elimclause') gl in
+    let clenv' = clenv_unique_resolver ~flags elimclause' gl in
     let after_tac i =
-      let (hd,largs) = decompose_app clenv'.templtyp.Evd.rebus in
+      let (hd,largs) = decompose_app clenv'.evd clenv'.templtyp.Evd.rebus in
       let ba = { branchsign = branchsigns.(i);
                  branchnames = brnames.(i);
                  nassums = List.length branchsigns.(i);
@@ -672,10 +661,68 @@ module New = struct
     Proofview.tclTHEN
       (Clenvtac.clenv_refine false clenv')
       (Proofview.tclEXTEND [] tclIDTAC branchtacs)
-    end }) end }
+    end) end
+
+  let elimination_sort_of_goal gl =
+    (** Retyping will expand evars anyway. *)
+    let c = Proofview.Goal.concl gl in
+    pf_apply Retyping.get_sort_family_of gl c
+
+  let elimination_sort_of_hyp id gl =
+    (** Retyping will expand evars anyway. *)
+    let c = pf_get_hyp_typ id gl in
+    pf_apply Retyping.get_sort_family_of gl c
+
+  let elimination_sort_of_clause id gl = match id with
+  | None -> elimination_sort_of_goal gl
+  | Some id -> elimination_sort_of_hyp id gl
+
+  (* computing the case/elim combinators *)
+
+  let gl_make_elim ind = begin fun gl ->
+    let gr = Indrec.lookup_eliminator (fst ind) (elimination_sort_of_goal gl) in
+    let (sigma, c) = pf_apply Evd.fresh_global gl gr in
+    (sigma, EConstr.of_constr c)
+  end
+
+  let gl_make_case_dep (ind, u) = begin fun gl ->
+    let sigma = project gl in
+    let u = EInstance.kind (project gl) u in
+    let (sigma, r) = Indrec.build_case_analysis_scheme (pf_env gl) sigma (ind, u) true
+      (elimination_sort_of_goal gl)
+    in
+    (sigma, EConstr.of_constr r)
+  end
+
+  let gl_make_case_nodep (ind, u) = begin fun gl ->
+    let sigma = project gl in
+    let u = EInstance.kind sigma u in
+    let (sigma, r) = Indrec.build_case_analysis_scheme (pf_env gl) sigma (ind, u) false
+      (elimination_sort_of_goal gl)
+    in
+    (sigma, EConstr.of_constr r)
+  end
+
+  let make_elim_branch_assumptions ba hyps =
+    let assums =
+      try List.rev (List.firstn ba.nassums hyps)
+      with Failure _ -> anomaly (Pp.str "make_elim_branch_assumptions.") in
+    { ba = ba; assums = assums }
+
+  let elim_on_ba tac ba =
+    Proofview.Goal.enter begin fun gl ->
+    let branches = make_elim_branch_assumptions ba (Proofview.Goal.hyps gl) in
+    tac branches
+    end
+
+  let case_on_ba tac ba = 
+    Proofview.Goal.enter begin fun gl ->
+    let branches = make_elim_branch_assumptions ba (Proofview.Goal.hyps gl) in
+    tac branches
+    end
 
   let elimination_then tac c =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let (ind,t) = pf_reduce_to_quantified_ind gl (pf_unsafe_type_of gl c) in
     let isrec,mkelim =
       match (Global.lookup_mind (fst (fst ind))).mind_record with
@@ -683,7 +730,7 @@ module New = struct
       | Some _ -> false,gl_make_case_dep
     in
     general_elim_then_using mkelim isrec None tac None ind (c, t)
-    end }
+    end
 
   let case_then_using =
     general_elim_then_using gl_make_case_dep false
@@ -691,38 +738,11 @@ module New = struct
   let case_nodep_then_using =
     general_elim_then_using gl_make_case_nodep false
 
-  let elim_on_ba tac ba =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let branches = Tacmach.New.of_old (make_elim_branch_assumptions ba) gl in
-    tac branches
-    end }
-
-  let case_on_ba tac ba = 
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let branches = Tacmach.New.of_old (make_case_branch_assumptions ba) gl in
-    tac branches
-    end }
-
-  let elimination_sort_of_goal gl =
-    (** Retyping will expand evars anyway. *)
-    let c = Proofview.Goal.concl (Goal.assume gl) in
-    pf_apply Retyping.get_sort_family_of gl c
-
-  let elimination_sort_of_hyp id gl =
-    (** Retyping will expand evars anyway. *)
-    let c = pf_get_hyp_typ id (Goal.assume gl) in
-    pf_apply Retyping.get_sort_family_of gl c
-
-  let elimination_sort_of_clause id gl = match id with
-  | None -> elimination_sort_of_goal gl
-  | Some id -> elimination_sort_of_hyp id gl
-
-  let pf_constr_of_global ref tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-      let env = Proofview.Goal.env gl in
-      let sigma = Tacmach.New.project gl in
-      let (sigma, c) = Evd.fresh_global env sigma ref in
-      Proofview.Unsafe.tclEVARS sigma <*> (tac c)
-    end }
+  let pf_constr_of_global ref =
+    Proofview.tclEVARMAP >>= fun sigma ->
+    Proofview.tclENV >>= fun env ->
+    let (sigma, c) = Evd.fresh_global env sigma ref in
+    let c = EConstr.of_constr c in
+    Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT c
 
 end
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index cfdc2cff..f0ebac78 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -1,28 +1,31 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Pp
 open Names
-open Term
-open Tacmach
+open Constr
+open EConstr
+open Evd
 open Proof_type
-open Tacexpr
 open Locus
 open Misctypes
+open Tactypes
 
 (** Tacticals i.e. functions from tactics to tactics. *)
 
 val tclIDTAC         : tactic
-val tclIDTAC_MESSAGE : std_ppcmds -> tactic
+val tclIDTAC_MESSAGE : Pp.t -> tactic
 val tclORELSE0       : tactic -> tactic -> tactic
 val tclORELSE        : tactic -> tactic -> tactic
 val tclTHEN          : tactic -> tactic -> tactic
 val tclTHENSEQ       : tactic list -> tactic
+[@@ocaml.deprecated "alias of Tacticals.tclTHENLIST"]
 val tclTHENLIST      : tactic list -> tactic
 val tclTHEN_i        : tactic -> (int -> tactic) -> tactic
 val tclTHENFIRST     : tactic -> tactic -> tactic
@@ -40,13 +43,11 @@ val tclSOLVE         : tactic list -> tactic
 val tclTRY           : tactic -> tactic
 val tclCOMPLETE      : tactic -> tactic
 val tclAT_LEAST_ONCE : tactic -> tactic
-val tclFAIL          : int -> std_ppcmds -> tactic
-val tclFAIL_lazy     : int -> std_ppcmds Lazy.t -> tactic
+val tclFAIL          : int -> Pp.t -> tactic
+val tclFAIL_lazy     : int -> Pp.t Lazy.t -> tactic
 val tclDO            : int -> tactic -> tactic
-val tclWEAK_PROGRESS : tactic -> tactic
 val tclPROGRESS      : tactic -> tactic
 val tclSHOWHYPS      : tactic -> tactic
-val tclNOTSAMEGOAL   : tactic -> tactic
 val tclTHENTRY       : tactic -> tactic -> tactic
 val tclMAP           : ('a -> tactic) -> 'a list -> tactic
 
@@ -59,29 +60,29 @@ val tclIFTHENTRYELSEMUST : tactic -> tactic -> tactic
 
 val onNthHypId       : int -> (Id.t -> tactic) -> tactic
 val onNthHyp         : int -> (constr -> tactic) -> tactic
-val onNthDecl        : int -> (Context.Named.Declaration.t -> tactic) -> tactic
+val onNthDecl        : int -> (named_declaration -> tactic) -> tactic
 val onLastHypId      : (Id.t -> tactic) -> tactic
 val onLastHyp        : (constr -> tactic) -> tactic
-val onLastDecl       : (Context.Named.Declaration.t -> tactic) -> tactic
+val onLastDecl       : (named_declaration -> tactic) -> tactic
 val onNLastHypsId    : int -> (Id.t list -> tactic) -> tactic
 val onNLastHyps      : int -> (constr list -> tactic) -> tactic
-val onNLastDecls     : int -> (Context.Named.t -> tactic) -> tactic
+val onNLastDecls     : int -> (named_context -> tactic) -> tactic
 
 val lastHypId   : goal sigma -> Id.t
 val lastHyp     : goal sigma -> constr
-val lastDecl    : goal sigma -> Context.Named.Declaration.t
+val lastDecl    : goal sigma -> named_declaration
 val nLastHypsId : int -> goal sigma -> Id.t list
 val nLastHyps   : int -> goal sigma -> constr list
-val nLastDecls  : int -> goal sigma -> Context.Named.t
+val nLastDecls  : int -> goal sigma -> named_context
 
-val afterHyp    : Id.t -> goal sigma -> Context.Named.t
+val afterHyp    : Id.t -> goal sigma -> named_context
 
 val ifOnHyp     : (Id.t * types -> bool) ->
                   (Id.t -> tactic) -> (Id.t -> tactic) ->
 		   Id.t -> tactic
 
-val onHyps      : (goal sigma -> Context.Named.t) ->
-                  (Context.Named.t -> tactic) -> tactic
+val onHyps      : (goal sigma -> named_context) ->
+                  (named_context -> tactic) -> tactic
 
 (** {6 Tacticals applying to goal components } *)
 
@@ -97,7 +98,7 @@ val onClauseLR : (Id.t option -> tactic) -> clause -> tactic
 
 (** {6 Elimination tacticals. } *)
 
-type branch_args = {
+type branch_args = private {
   ity        : pinductive;  (** the type we were eliminating on *)
   largs      : constr list; (** its arguments *)
   branchnum  : int;         (** the branch number *)
@@ -107,15 +108,15 @@ type branch_args = {
                                 true=assumption, false=let-in *)
   branchnames : intro_patterns}
 
-type branch_assumptions = {
+type branch_assumptions = private {
   ba        : branch_args;       (** the branch args *)
-  assums    : Context.Named.t}   (** the list of assumptions introduced *)
+  assums    : named_context}   (** the list of assumptions introduced *)
 
 (** [get_and_check_or_and_pattern loc pats branchsign] returns an appropriate
    error message if |pats| <> |branchsign|; extends them if no pattern is given
    for let-ins in the case of a conjunctive pattern *)
 val get_and_check_or_and_pattern :
-  Loc.t -> delayed_open_constr or_and_intro_pattern_expr ->
+  ?loc:Loc.t -> delayed_open_constr or_and_intro_pattern_expr ->
   bool list array -> intro_patterns array
 
 (** Tolerate "[]" to mean a disjunctive pattern of any length *)
@@ -123,22 +124,19 @@ val fix_empty_or_and_pattern : int ->
   delayed_open_constr or_and_intro_pattern_expr ->
   delayed_open_constr or_and_intro_pattern_expr
 
-val compute_constructor_signatures : rec_flag -> pinductive -> bool list array
+val compute_constructor_signatures : rec_flag -> inductive * 'a -> bool list array
 
 (** Useful for [as intro_pattern] modifier *)
 val compute_induction_names :
   bool list array -> or_and_intro_pattern option -> intro_patterns array
 
-val elimination_sort_of_goal : goal sigma -> sorts_family
-val elimination_sort_of_hyp  : Id.t -> goal sigma -> sorts_family
-val elimination_sort_of_clause : Id.t option -> goal sigma -> sorts_family
+val elimination_sort_of_goal : goal sigma -> Sorts.family
+val elimination_sort_of_hyp  : Id.t -> goal sigma -> Sorts.family
+val elimination_sort_of_clause : Id.t option -> goal sigma -> Sorts.family
 
 val pf_with_evars :  (goal sigma -> Evd.evar_map * 'a) -> ('a -> tactic) -> tactic
 val pf_constr_of_global : Globnames.global_reference -> (constr -> tactic) -> tactic
 
-val elim_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
-val case_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
-
 (** Tacticals defined directly in term of Proofview *)
 
 (** The tacticals in the module [New] are the tactical of Ltac. Their
@@ -164,9 +162,9 @@ module New : sig
   (* [tclFAIL n msg] fails with [msg] as an error message at level [n]
      (meaning that it will jump over [n] error catching tacticals FROM
      THIS MODULE. *)
-  val tclFAIL : int -> Pp.std_ppcmds -> 'a tactic
+  val tclFAIL : int -> Pp.t -> 'a tactic
 
-  val tclZEROMSG : ?loc:Loc.t -> Pp.std_ppcmds -> 'a tactic
+  val tclZEROMSG : ?loc:Loc.t -> Pp.t -> 'a tactic
   (** Fail with a [User_Error] containing the given message. *)
 
   val tclOR : unit tactic -> unit tactic -> unit tactic
@@ -209,10 +207,12 @@ module New : sig
   val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic
 
   val tclTRY : unit tactic -> unit tactic
+  val tclTRYb : unit tactic -> bool list tactic
   val tclFIRST : unit tactic list -> unit tactic
   val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic
   val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic
   val tclIFTHENTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
+  val tclIFTHENFIRSTTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
 
   val tclDO : int -> unit tactic -> unit tactic
   val tclREPEAT : unit tactic -> unit tactic
@@ -221,35 +221,35 @@ module New : sig
   val tclCOMPLETE : 'a tactic -> 'a tactic
   val tclSOLVE : unit tactic list -> unit tactic
   val tclPROGRESS : unit tactic -> unit tactic
-  val tclSELECT : goal_selector -> 'a tactic -> 'a tactic
+  val tclSELECT : Vernacexpr.goal_selector -> 'a tactic -> 'a tactic
   val tclWITHHOLES : bool -> 'a tactic -> Evd.evar_map -> 'a tactic
   val tclDELAYEDWITHHOLES : bool -> 'a delayed_open -> ('a -> unit tactic) -> unit tactic
 
   val tclTIMEOUT : int -> unit tactic -> unit tactic
   val tclTIME : string option -> 'a tactic -> 'a tactic
 
-  val nLastDecls  : ([ `NF ], 'r) Proofview.Goal.t -> int -> Context.Named.t
+  val nLastDecls  : Proofview.Goal.t -> int -> named_context
 
-  val ifOnHyp     : (identifier * types -> bool) ->
-    (identifier -> unit Proofview.tactic) -> (identifier -> unit Proofview.tactic) ->
-    identifier -> unit Proofview.tactic
+  val ifOnHyp     : (Id.t * types -> bool) ->
+    (Id.t -> unit Proofview.tactic) -> (Id.t -> unit Proofview.tactic) ->
+    Id.t -> unit Proofview.tactic
 
-  val onNthHypId : int -> (identifier -> unit tactic) -> unit tactic
-  val onLastHypId      : (identifier -> unit tactic) -> unit tactic
+  val onNthHypId : int -> (Id.t -> unit tactic) -> unit tactic
+  val onLastHypId      : (Id.t -> unit tactic) -> unit tactic
   val onLastHyp        : (constr -> unit tactic) -> unit tactic
-  val onLastDecl       : (Context.Named.Declaration.t -> unit tactic) -> unit tactic
+  val onLastDecl       : (named_declaration -> unit tactic) -> unit tactic
 
-  val onHyps      : ([ `NF ], Context.Named.t) Proofview.Goal.enter ->
-                    (Context.Named.t -> unit tactic) -> unit tactic
-  val afterHyp    : Id.t -> (Context.Named.t -> unit tactic) -> unit tactic
+  val onHyps      : (Proofview.Goal.t -> named_context) ->
+                    (named_context -> unit tactic) -> unit tactic
+  val afterHyp    : Id.t -> (named_context -> unit tactic) -> unit tactic
 
-  val tryAllHyps          : (identifier -> unit tactic) -> unit tactic
-  val tryAllHypsAndConcl  : (identifier option -> unit tactic) -> unit tactic
-  val onClause   : (identifier option -> unit tactic) -> clause -> unit tactic
+  val tryAllHyps          : (Id.t -> unit tactic) -> unit tactic
+  val tryAllHypsAndConcl  : (Id.t option -> unit tactic) -> unit tactic
+  val onClause   : (Id.t option -> unit tactic) -> clause -> unit tactic
 
-  val elimination_sort_of_goal : ('a, 'r) Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_hyp  : Id.t -> ('a, 'r) Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_clause : Id.t option -> ('a, 'r) Proofview.Goal.t -> sorts_family
+  val elimination_sort_of_goal : Proofview.Goal.t -> Sorts.family
+  val elimination_sort_of_hyp  : Id.t -> Proofview.Goal.t -> Sorts.family
+  val elimination_sort_of_clause : Id.t option -> Proofview.Goal.t -> Sorts.family
 
   val elimination_then :
     (branch_args -> unit Proofview.tactic) ->
@@ -257,14 +257,14 @@ module New : sig
 
   val case_then_using :
     or_and_intro_pattern option -> (branch_args -> unit Proofview.tactic) ->
-    constr option -> pinductive -> Term.constr * Term.types -> unit Proofview.tactic
+    constr option -> inductive * EInstance.t -> constr * types -> unit Proofview.tactic
 
   val case_nodep_then_using :
     or_and_intro_pattern option -> (branch_args -> unit Proofview.tactic) ->
-    constr option -> pinductive -> Term.constr * Term.types -> unit Proofview.tactic
+    constr option -> inductive * EInstance.t -> constr * types -> unit Proofview.tactic
 
   val elim_on_ba : (branch_assumptions -> unit Proofview.tactic) -> branch_args  -> unit Proofview.tactic
   val case_on_ba : (branch_assumptions -> unit Proofview.tactic) -> branch_args  -> unit Proofview.tactic
 
-  val pf_constr_of_global : Globnames.global_reference -> (constr -> unit Proofview.tactic) -> unit Proofview.tactic
+  val pf_constr_of_global : Globnames.global_reference -> constr Proofview.tactic
 end
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 9d64e7c5..dfdd3237 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1,28 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+module CVars = Vars
+
 open Pp
 open CErrors
 open Util
 open Names
 open Nameops
-open Term
-open Vars
+open Constr
 open Termops
+open Environ
+open EConstr
+open Vars
 open Find_subterm
 open Namegen
 open Declarations
 open Inductiveops
 open Reductionops
-open Environ
 open Globnames
 open Evd
-open Pfedit
 open Tacred
 open Genredexpr
 open Tacmach.New
@@ -32,7 +36,6 @@ open Refiner
 open Tacticals
 open Hipattern
 open Coqlib
-open Tacexpr
 open Decl_kinds
 open Evarutil
 open Indrec
@@ -42,63 +45,28 @@ open Locus
 open Locusops
 open Misctypes
 open Proofview.Notations
-open Sigma.Notations
+open Context.Named.Declaration
 
-let inj_with_occurrences e = (AllOccurrences,e)
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
-let dloc = Loc.ghost
+let inj_with_occurrences e = (AllOccurrences,e)
 
 let typ_of env sigma c =
   let open Retyping in
-  try get_type_of ~lax:true env (Sigma.to_evar_map sigma) c
+  try get_type_of ~lax:true env sigma c
   with RetypeError e ->
-    user_err_loc (Loc.ghost, "", print_retype_error e)
+    user_err (print_retype_error e)
 
 open Goptions
 
-(* Option for 8.2 compatibility *)
-let dependent_propositions_elimination = ref true
-
-let use_dependent_propositions_elimination () =
-  !dependent_propositions_elimination
-  && Flags.version_strictly_greater Flags.V8_2
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "dependent-propositions-elimination tactic";
-      optkey   = ["Dependent";"Propositions";"Elimination"];
-      optread  = (fun () -> !dependent_propositions_elimination) ;
-      optwrite = (fun b -> dependent_propositions_elimination := b) }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "trigger bugged context matching compatibility";
-      optkey   = ["Tactic";"Compat";"Context"];
-      optread  = (fun () -> !Flags.tactic_context_compat) ;
-      optwrite = (fun b -> Flags.tactic_context_compat := b) }
-
-let apply_solve_class_goals = ref (false)
-let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = true;
-  Goptions.optname =
-    "Perform typeclass resolution on apply-generated subgoals.";
-  Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"];
-  Goptions.optread = (fun () -> !apply_solve_class_goals);
-  Goptions.optwrite = (fun a -> apply_solve_class_goals:=a);
-}
-
 let clear_hyp_by_default = ref false
 
 let use_clear_hyp_by_default () = !clear_hyp_by_default
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "default clearing of hypotheses after use";
       optkey   = ["Default";"Clearing";"Used";"Hypotheses"];
       optread  = (fun () -> !clear_hyp_by_default) ;
@@ -114,26 +82,12 @@ let accept_universal_lemma_under_conjunctions () =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "trivial unification in tactics applying under conjunctions";
       optkey   = ["Universal";"Lemma";"Under";"Conjunction"];
       optread  = (fun () -> !universal_lemma_under_conjunctions) ;
       optwrite = (fun b -> universal_lemma_under_conjunctions := b) }
 
-(* Shrinking of abstract proofs. *)
-
-let shrink_abstract = ref true
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "shrinking of abstracted proofs";
-      optkey   = ["Shrink"; "Abstract"];
-      optread  = (fun () -> !shrink_abstract) ;
-      optwrite = (fun b -> shrink_abstract := b) }
-
 (* The following boolean governs what "intros []" do on examples such
    as "forall x:nat*nat, x=x"; if true, it behaves as "intros [? ?]";
    if false, it behaves as "intro H; case H; clear H" for fresh H.
@@ -144,12 +98,10 @@ let bracketing_last_or_and_intro_pattern = ref true
 
 let use_bracketing_last_or_and_intro_pattern () =
   !bracketing_last_or_and_intro_pattern
-  && Flags.version_strictly_greater Flags.V8_4
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "bracketing last or-and introduction pattern";
       optkey   = ["Bracketing";"Last";"Introduction";"Pattern"];
       optread  = (fun () -> !bracketing_last_or_and_intro_pattern);
@@ -166,76 +118,74 @@ let _ =
 (** This tactic creates a partial proof realizing the introduction rule, but
     does not check anything. *)
 let unsafe_intro env store decl b =
-  let open Context.Named.Declaration in
-  Refine.refine ~unsafe:true { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let ctx = named_context_val env in
     let nctx = push_named_context_val decl ctx in
-    let inst = List.map (mkVar % get_id) (named_context env) in
+    let inst = List.map (NamedDecl.get_id %> mkVar) (named_context env) in
     let ninst = mkRel 1 :: inst in
-    let nb = subst1 (mkVar (get_id decl)) b in
-    let Sigma (ev, sigma, p) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
-    Sigma (mkNamedLambda_or_LetIn decl ev, sigma, p)
-  end }
+    let nb = subst1 (mkVar (NamedDecl.get_id decl)) b in
+    let (sigma, ev) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
+    (sigma, mkNamedLambda_or_LetIn decl ev)
+  end
 
 let introduction ?(check=true) id =
-  let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let hyps = named_context_val (Proofview.Goal.env gl) in
     let store = Proofview.Goal.extra gl in
     let env = Proofview.Goal.env gl in
     let () = if check && mem_named_context_val id hyps then
-      errorlabstrm "Tactics.introduction"
-        (str "Variable " ++ pr_id id ++ str " is already declared.")
+      user_err ~hdr:"Tactics.introduction"
+        (str "Variable " ++ Id.print id ++ str " is already declared.")
     in
-    match kind_of_term (whd_evar sigma concl) with
+    let open Context.Named.Declaration in
+    match EConstr.kind sigma concl with
     | Prod (_, t, b) -> unsafe_intro env store (LocalAssum (id, t)) b
     | LetIn (_, c, t, b) -> unsafe_intro env store (LocalDef (id, c, t)) b
-    | _ -> raise (RefinerError IntroNeedsProduct)
-  end }
+    | _ -> raise (RefinerError (env, sigma, IntroNeedsProduct))
+  end
 
 let refine          = Tacmach.refine
+let error msg = CErrors.user_err Pp.(str msg)
 
 let convert_concl ?(check=true) ty k =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let store = Proofview.Goal.extra gl in
-    let conclty = Proofview.Goal.raw_concl gl in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
-      let Sigma ((), sigma, p) =
+    let conclty = Proofview.Goal.concl gl in
+    Refine.refine ~typecheck:false begin fun sigma ->
+      let sigma =
         if check then begin
-          let sigma = Sigma.to_evar_map sigma in
           ignore (Typing.unsafe_type_of env sigma ty);
           let sigma,b = Reductionops.infer_conv env sigma ty conclty in
           if not b then error "Not convertible.";
-          Sigma.Unsafe.of_pair ((), sigma)
-        end else Sigma.here () sigma in
-      let Sigma (x, sigma, q) = Evarutil.new_evar env sigma ~principal:true ~store ty in
+          sigma
+        end else sigma in
+      let (sigma, x) = Evarutil.new_evar env sigma ~principal:true ~store ty in
       let ans = if k == DEFAULTcast then x else mkCast(x,k,conclty) in
-      Sigma (ans, sigma, p +> q)
-    end }
-  end }
+      (sigma, ans)
+    end
+  end
 
 let convert_hyp ?(check=true) d =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let ty = Proofview.Goal.raw_concl gl in
+    let ty = Proofview.Goal.concl gl in
     let store = Proofview.Goal.extra gl in
     let sign = convert_hyp check (named_context_val env) sigma d in
     let env = reset_with_named_context sign env in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true ~store ty
-    end }
-  end }
+    end
+  end
 
 let convert_concl_no_check = convert_concl ~check:false
 let convert_hyp_no_check = convert_hyp ~check:false
 
 let convert_gen pb x y =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     try
       let sigma, b = Tacmach.New.pf_apply (Reductionops.infer_conv ~pb) gl x y in
       if b then Proofview.Unsafe.tclEVARS sigma
@@ -243,37 +193,37 @@ let convert_gen pb x y =
     with (* Reduction.NotConvertible *) _ ->
       (** FIXME: Sometimes an anomaly is raised from conversion *)
       Tacticals.New.tclFAIL 0 (str "Not convertible")
-end }
+end
 
 let convert x y = convert_gen Reduction.CONV x y
 let convert_leq x y = convert_gen Reduction.CUMUL x y
 
 let clear_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
-      pr_id id ++ str " is used in conclusion."
+      Id.print id ++ str " is used in conclusion."
   | Evarutil.OccurHypInSimpleClause (Some id') ->
-      pr_id id ++ strbrk " is used in hypothesis " ++ pr_id id' ++ str"."
+      Id.print id ++ strbrk " is used in hypothesis " ++ Id.print id' ++ str"."
   | Evarutil.EvarTypingBreak ev ->
-      str "Cannot remove " ++ pr_id id ++
+      str "Cannot remove " ++ Id.print id ++
       strbrk " without breaking the typing of " ++
       Printer.pr_existential env sigma ev ++ str"."
 
 let error_clear_dependency env sigma id err =
-  errorlabstrm "" (clear_dependency_msg env sigma id err)
+  user_err  (clear_dependency_msg env sigma id err)
 
 let replacing_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
-      str "Cannot change " ++ pr_id id ++ str ", it is used in conclusion."
+      str "Cannot change " ++ Id.print id ++ str ", it is used in conclusion."
   | Evarutil.OccurHypInSimpleClause (Some id') ->
-      str "Cannot change " ++ pr_id id ++
-      strbrk ", it is used in hypothesis " ++ pr_id id' ++ str"."
+      str "Cannot change " ++ Id.print id ++
+      strbrk ", it is used in hypothesis " ++ Id.print id' ++ str"."
   | Evarutil.EvarTypingBreak ev ->
-      str "Cannot change " ++ pr_id id ++
+      str "Cannot change " ++ Id.print id ++
       strbrk " without breaking the typing of " ++
       Printer.pr_existential env sigma ev ++ str"."
 
 let error_replacing_dependency env sigma id err =
-  errorlabstrm "" (replacing_dependency_msg env sigma id err)
+  user_err  (replacing_dependency_msg env sigma id err)
 
 (* This tactic enables the user to remove hypotheses from the signature.
  * Some care is taken to prevent him from removing variables that are
@@ -283,10 +233,9 @@ let error_replacing_dependency env sigma id err =
 let clear_gen fail = function
 | [] -> Proofview.tclUNIT ()
 | ids ->
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let ids = List.fold_right Id.Set.add ids Id.Set.empty in
     (** clear_hyps_in_evi does not require nf terms *)
-    let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     let concl = Proofview.Goal.concl gl in
@@ -296,43 +245,44 @@ let clear_gen fail = function
       with Evarutil.ClearDependencyError (id,err) -> fail env sigma id err
     in
     let env = reset_with_named_context hyps env in
-    let tac = Refine.refine ~unsafe:true { run = fun sigma ->
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref)
+    (Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true concl
-    } in
-    Sigma.Unsafe.of_pair (tac, !evdref)
-  end }
+    end)
+  end
 
 let clear ids = clear_gen error_clear_dependency ids
 let clear_for_replacing ids = clear_gen error_replacing_dependency ids
 
 let apply_clear_request clear_flag dft c =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let check_isvar c =
-    if not (isVar c) then
+    if not (isVar sigma c) then
       error "keep/clear modifiers apply only to hypothesis names." in
   let doclear = match clear_flag with
-    | None -> dft && isVar c
+    | None -> dft && isVar sigma c
     | Some true -> check_isvar c; true
     | Some false -> false in
-  if doclear then clear [destVar c]
+  if doclear then clear [destVar sigma c]
   else Tacticals.New.tclIDTAC
 
 (* Moving hypotheses *)
 let move_hyp id dest =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let ty = Proofview.Goal.raw_concl gl in
+    let sigma = Tacmach.New.project gl in
+    let ty = Proofview.Goal.concl gl in
     let store = Proofview.Goal.extra gl in
     let sign = named_context_val env in
-    let sign' = move_hyp_in_named_context id dest sign in
+    let sign' = move_hyp_in_named_context env sigma id dest sign in
     let env = reset_with_named_context sign' env in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true ~store ty
-    end }
-  end }
+    end
+  end
 
 (* Renaming hypotheses *)
 let rename_hyp repl =
-  let open Context.Named.Declaration in
   let fold accu (src, dst) = match accu with
   | None -> None
   | Some (srcs, dsts) ->
@@ -348,24 +298,25 @@ let rename_hyp repl =
   match dom with
   | None -> Tacticals.New.tclZEROMSG (str "Not a one-to-one name mapping")
   | Some (src, dst) ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let gl = Proofview.Goal.assume gl in
+    Proofview.Goal.enter begin fun gl ->
       let hyps = Proofview.Goal.hyps gl in
       let concl = Proofview.Goal.concl gl in
       let store = Proofview.Goal.extra gl in
+      let env = Proofview.Goal.env gl in
+      let sigma = Proofview.Goal.sigma gl in
       (** Check that we do not mess variables *)
-      let fold accu decl = Id.Set.add (get_id decl) accu in
+      let fold accu decl = Id.Set.add (NamedDecl.get_id decl) accu in
       let vars = List.fold_left fold Id.Set.empty hyps in
       let () =
         if not (Id.Set.subset src vars) then
           let hyp = Id.Set.choose (Id.Set.diff src vars) in
-          raise (RefinerError (NoSuchHyp hyp))
+          raise (RefinerError (env, sigma, NoSuchHyp hyp))
       in
       let mods = Id.Set.diff vars src in
       let () =
         try
           let elt = Id.Set.choose (Id.Set.inter dst mods) in
-          CErrors.errorlabstrm "" (pr_id elt ++ str " is already used")
+          CErrors.user_err  (Id.print elt ++ str " is already used")
         with Not_found -> ()
       in
       (** All is well *)
@@ -373,24 +324,26 @@ let rename_hyp repl =
       let subst = List.map make_subst repl in
       let subst c = Vars.replace_vars subst c in
       let map decl =
-        decl |> map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
-             |> map_constr subst
+        decl |> NamedDecl.map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
+             |> NamedDecl.map_constr subst
       in
       let nhyps = List.map map hyps in
       let nconcl = subst concl in
-      let nctx = Environ.val_of_named_context nhyps in
-      let instance = List.map (mkVar % get_id) hyps in
-      Refine.refine ~unsafe:true { run = begin fun sigma ->
+      let nctx = val_of_named_context nhyps in
+      let instance = List.map (NamedDecl.get_id %> mkVar) hyps in
+      Refine.refine ~typecheck:false begin fun sigma ->
         Evarutil.new_evar_instance nctx sigma nconcl ~principal:true ~store instance
-      end }
-    end }
+      end
+    end
 
 (**************************************************************)
 (*          Fresh names                                       *)
 (**************************************************************)
 
 let fresh_id_in_env avoid id env =
-  next_ident_away_in_goal id (avoid@ids_of_named_context (named_context env))
+  let avoid' = ids_of_named_context_val (named_context_val env) in
+  let avoid = if Id.Set.is_empty avoid then avoid' else Id.Set.union avoid' avoid in
+  next_ident_away_in_goal id avoid
 
 let fresh_id avoid id gl =
   fresh_id_in_env avoid id (pf_env gl)
@@ -411,20 +364,20 @@ let default_id env sigma decl =
   | LocalAssum (name,t) ->
       let dft = default_id_of_sort (Retyping.get_sort_of env sigma t) in
       id_of_name_with_default dft name
-  | LocalDef (name,b,_) -> id_of_name_using_hdchar env b name
+  | LocalDef (name,b,_) -> id_of_name_using_hdchar env sigma b name
 
 (* Non primitive introduction tactics are treated by intro_then_gen
    There is possibly renaming, with possibly names to avoid and
    possibly a move to do after the introduction *)
 
 type name_flag =
-  | NamingAvoid of Id.t list
-  | NamingBasedOn of Id.t * Id.t list
-  | NamingMustBe of Loc.t * Id.t
+  | NamingAvoid of Id.Set.t
+  | NamingBasedOn of Id.t * Id.Set.t
+  | NamingMustBe of lident
 
 let naming_of_name = function
-  | Anonymous -> NamingAvoid []
-  | Name id -> NamingMustBe (dloc,id)
+  | Anonymous -> NamingAvoid Id.Set.empty
+  | Name id -> NamingMustBe (CAst.make id)
 
 let find_name mayrepl decl naming gl = match naming with
   | NamingAvoid idl ->
@@ -433,69 +386,129 @@ let find_name mayrepl decl naming gl = match naming with
       let sigma = Tacmach.New.project gl in
       new_fresh_id idl (default_id env sigma decl) gl
   | NamingBasedOn (id,idl) ->  new_fresh_id idl id gl
-  | NamingMustBe (loc,id) ->
-      (* When name is given, we allow to hide a global name *)
-      let ids_of_hyps = Tacmach.New.pf_ids_of_hyps gl in
-      let id' = next_ident_away id ids_of_hyps in
-      if not mayrepl && not (Id.equal id' id) then
-        user_err_loc (loc,"",pr_id id ++ str" is already used.");
-      id
+  | NamingMustBe {CAst.loc;v=id} ->
+     (* When name is given, we allow to hide a global name *)
+     let ids_of_hyps = Tacmach.New.pf_ids_set_of_hyps gl in
+     if not mayrepl && Id.Set.mem id ids_of_hyps then
+       user_err ?loc  (Id.print id ++ str" is already used.");
+     id
+
+(**************************************************************)
+(*   Computing position of hypotheses for replacing           *)
+(**************************************************************)
+
+let get_next_hyp_position env sigma id =
+  let rec aux = function
+  | [] -> error_no_such_hypothesis env sigma id
+  | decl :: right ->
+    if Id.equal (NamedDecl.get_id decl) id then
+      match right with decl::_ -> MoveBefore (NamedDecl.get_id decl) | [] -> MoveFirst
+    else
+      aux right
+  in
+  aux
+
+let get_previous_hyp_position env sigma id =
+  let rec aux dest = function
+  | [] -> error_no_such_hypothesis env sigma id
+  | decl :: right ->
+      let hyp = NamedDecl.get_id decl in
+      if Id.equal hyp id then dest else aux (MoveAfter hyp) right
+  in
+  aux MoveLast
 
 (**************************************************************)
 (*            Cut rule                                        *)
 (**************************************************************)
 
+let clear_hyps2 env sigma ids sign t cl =
+  try
+    let evdref = ref (Evd.clear_metas sigma) in
+    let (hyps,t,cl) = Evarutil.clear_hyps2_in_evi env evdref sign t cl ids in
+    (hyps, t, cl, !evdref)
+  with Evarutil.ClearDependencyError (id,err) ->
+    error_replacing_dependency env sigma id err
+
+let internal_cut_gen ?(check=true) dir replace id t =
+  Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
+    let concl = Proofview.Goal.concl gl in
+    let store = Proofview.Goal.extra gl in
+    let sign = named_context_val env in
+    let sign',t,concl,sigma =
+      if replace then
+        let nexthyp = get_next_hyp_position env sigma id (named_context_of_val sign) in
+        let sign',t,concl,sigma = clear_hyps2 env sigma (Id.Set.singleton id) sign t concl in
+        let sign' = insert_decl_in_named_context sigma (LocalAssum (id,t)) nexthyp sign' in
+        sign',t,concl,sigma
+      else
+        (if check && mem_named_context_val id sign then
+	   user_err (str "Variable " ++ Id.print id ++ str " is already declared.");
+         push_named_context_val (LocalAssum (id,t)) sign,t,concl,sigma) in
+    let nf_t = nf_betaiota env sigma t in
+    Proofview.tclTHEN
+      (Proofview.Unsafe.tclEVARS sigma)
+      (Refine.refine ~typecheck:false begin fun sigma ->
+        let (sigma,ev,ev') =
+          if dir then
+            let (sigma, ev) = Evarutil.new_evar_from_context sign sigma nf_t in
+            let (sigma, ev') = Evarutil.new_evar_from_context sign' sigma ~principal:true ~store concl in
+            (sigma,ev,ev')
+          else
+            let (sigma, ev') = Evarutil.new_evar_from_context sign' sigma ~principal:true ~store concl in
+            let (sigma, ev) = Evarutil.new_evar_from_context sign sigma nf_t in
+            (sigma,ev,ev') in
+        let term = mkLetIn (Name id, ev, t, EConstr.Vars.subst_var id ev') in
+        (sigma, term)
+      end)
+  end
+
+let internal_cut ?(check=true) = internal_cut_gen ~check true
+let internal_cut_rev ?(check=true) = internal_cut_gen ~check false
+
 let assert_before_then_gen b naming t tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENLAST
-      (Proofview.V82.tactic
-         (fun gl ->
-           try Tacmach.internal_cut b id t gl
-           with Evarutil.ClearDependencyError (id,err) ->
-             error_replacing_dependency (pf_env gl) (project gl) id err))
+      (internal_cut b id t)
       (tac id)
-  end }
+  end
 
 let assert_before_gen b naming t =
   assert_before_then_gen b naming t (fun _ -> Proofview.tclUNIT ())
 
 let assert_before na = assert_before_gen false (naming_of_name na)
-let assert_before_replacing id = assert_before_gen true (NamingMustBe (dloc,id))
+let assert_before_replacing id = assert_before_gen true (NamingMustBe (CAst.make id))
 
 let assert_after_then_gen b naming t tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENFIRST
-      (Proofview.V82.tactic
-         (fun gl ->
-           try Tacmach.internal_cut_rev b id t gl
-           with Evarutil.ClearDependencyError (id,err) ->
-             error_replacing_dependency (pf_env gl) (project gl) id err))
+      (internal_cut_rev b id t)
       (tac id)
-  end }
+  end
 
 let assert_after_gen b naming t =
   assert_after_then_gen b naming t (fun _ -> (Proofview.tclUNIT ()))
 
 let assert_after na = assert_after_gen false (naming_of_name na)
-let assert_after_replacing id = assert_after_gen true (NamingMustBe (dloc,id))
+let assert_after_replacing id = assert_after_gen true (NamingMustBe (CAst.make id))
 
 (**************************************************************)
 (*          Fixpoints and CoFixpoints                         *)
 (**************************************************************)
 
-let rec mk_holes : type r s. _ -> r Sigma.t -> (s, r) Sigma.le -> _ -> (_, s) Sigma.sigma =
-fun env sigma p -> function
-| [] -> Sigma ([], sigma, p)
+let rec mk_holes env sigma = function
+| [] -> (sigma, [])
 | arg :: rem ->
-  let Sigma (arg, sigma, q) = Evarutil.new_evar env sigma arg in
-  let Sigma (rem, sigma, r) = mk_holes env sigma (p +> q) rem in
-  Sigma (arg :: rem, sigma, r)
+  let (sigma, arg) = Evarutil.new_evar env sigma arg in
+  let (sigma, rem) = mk_holes env sigma rem in
+  (sigma, arg :: rem)
 
-let rec check_mutind env sigma k cl = match kind_of_term (strip_outer_cast cl) with
+let rec check_mutind env sigma k cl = match EConstr.kind sigma (strip_outer_cast sigma cl) with
 | Prod (na, c1, b) ->
   if Int.equal k 1 then
     try
@@ -505,10 +518,13 @@ let rec check_mutind env sigma k cl = match kind_of_term (strip_outer_cast cl) w
   else
     let open Context.Rel.Declaration in
     check_mutind (push_rel (LocalAssum (na, c1)) env) sigma (pred k) b
+| LetIn (na, c1, t, b) ->
+    let open Context.Rel.Declaration in
+    check_mutind (push_rel (LocalDef (na, c1, t)) env) sigma k b
 | _ -> error "Not enough products."
 
 (* Refine as a fixpoint *)
-let mutual_fix f n rest j = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let mutual_fix f n rest j = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
@@ -520,40 +536,45 @@ let mutual_fix f n rest j = Proofview.Goal.nf_enter { enter = begin fun gl ->
   | (f, n, ar) :: oth ->
     let open Context.Named.Declaration in
     let (sp', u')  = check_mutind env sigma n ar in
-    if not (eq_mind sp sp') then
+    if not (MutInd.equal sp sp') then
       error "Fixpoints should be on the same mutual inductive declaration.";
     if mem_named_context_val f sign then
-      errorlabstrm "Logic.prim_refiner"
-        (str "Name " ++ pr_id f ++ str " already used in the environment");
+      user_err ~hdr:"Logic.prim_refiner"
+        (str "Name " ++ Id.print f ++ str " already used in the environment");
     mk_sign (push_named_context_val (LocalAssum (f, ar)) sign) oth
   in
   let nenv = reset_with_named_context (mk_sign (named_context_val env) all) env in
-  Refine.refine { run = begin fun sigma ->
-    let Sigma (evs, sigma, p) = mk_holes nenv sigma Sigma.refl (List.map pi3 all) in
+  Refine.refine ~typecheck:false begin fun sigma ->
+    let (sigma, evs) = mk_holes nenv sigma (List.map pi3 all) in
     let ids = List.map pi1 all in
     let evs = List.map (Vars.subst_vars (List.rev ids)) evs in
     let indxs = Array.of_list (List.map (fun n -> n-1) (List.map pi2 all)) in
     let funnames = Array.of_list (List.map (fun i -> Name i) ids) in
     let typarray = Array.of_list (List.map pi3 all) in
     let bodies = Array.of_list evs in
-    let oterm = Term.mkFix ((indxs,0),(funnames,typarray,bodies)) in
-    Sigma (oterm, sigma, p)
-  end }
-end }
+    let oterm = mkFix ((indxs,0),(funnames,typarray,bodies)) in
+    (sigma, oterm)
+  end
+end
+
+let warning_nameless_fix =
+    CWarnings.create ~name:"nameless-fix" ~category:"deprecated" Pp.(fun () ->
+        str "fix/cofix without a name are deprecated, please use the named version.")
 
 let fix ido n = match ido with
   | None ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let name = Pfedit.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+    warning_nameless_fix ();
+    Proofview.Goal.enter begin fun gl ->
+      let name = Proof_global.get_current_proof_name () in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_fix id n [] 0
-    end }
+    end
   | Some id ->
     mutual_fix id n [] 0
 
 let rec check_is_mutcoind env sigma cl =
   let b = whd_all env sigma cl in
-  match kind_of_term b with
+  match EConstr.kind sigma b with
   | Prod (na, c1, b) ->
     let open Context.Rel.Declaration in
     check_is_mutcoind (push_rel (LocalAssum (na,c1)) env) sigma b
@@ -564,7 +585,7 @@ let rec check_is_mutcoind env sigma cl =
       error "All methods must construct elements in coinductive types."
 
 (* Refine as a cofixpoint *)
-let mutual_cofix f others j = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let mutual_cofix f others j = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
@@ -580,25 +601,26 @@ let mutual_cofix f others j = Proofview.Goal.nf_enter { enter = begin fun gl ->
     mk_sign (push_named_context_val (LocalAssum (f, ar)) sign) oth
   in
   let nenv = reset_with_named_context (mk_sign (named_context_val env) all) env in
-  Refine.refine { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let (ids, types) = List.split all in
-    let Sigma (evs, sigma, p) = mk_holes nenv sigma Sigma.refl types in
+    let (sigma, evs) = mk_holes nenv sigma types in
     let evs = List.map (Vars.subst_vars (List.rev ids)) evs in
     let funnames = Array.of_list (List.map (fun i -> Name i) ids) in
     let typarray = Array.of_list types in
     let bodies = Array.of_list evs in
-    let oterm = Term.mkCoFix (0, (funnames, typarray, bodies)) in
-    Sigma (oterm, sigma, p)
-  end }
-end }
+    let oterm = mkCoFix (0, (funnames, typarray, bodies)) in
+    (sigma, oterm)
+  end
+end
 
 let cofix ido = match ido with
   | None ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let name = Pfedit.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+    warning_nameless_fix ();
+    Proofview.Goal.enter begin fun gl ->
+      let name = Proof_global.get_current_proof_name () in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_cofix id [] 0
-    end }
+    end
   | Some id ->
       mutual_cofix id [] 0
 
@@ -606,15 +628,16 @@ let cofix ido = match ido with
 (*          Reduction and conversion tactics                  *)
 (**************************************************************)
 
-type tactic_reduction = env -> evar_map -> constr -> constr
+type tactic_reduction = Reductionops.reduction_function
+type e_tactic_reduction = Reductionops.e_reduction_function
 
 let pf_reduce_decl redfun where decl gl =
   let open Context.Named.Declaration in
-  let redfun' = Tacmach.New.pf_apply redfun gl in
+  let redfun' c = Tacmach.New.pf_apply redfun gl c in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
+	user_err  (Id.print id ++ str " has no value.");
       LocalAssum (id,redfun' ty)
   | LocalDef (id,b,ty) ->
       let b' = if where != InHypTypeOnly then redfun' b else b in
@@ -690,14 +713,14 @@ let bind_red_expr_occurrences occs nbcl redexp =
    certain hypothesis *)
 
 let reduct_in_concl (redfun,sty) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     convert_concl_no_check (Tacmach.New.pf_apply redfun gl (Tacmach.New.pf_concl gl)) sty
-  end }
+  end
 
 let reduct_in_hyp ?(check=false) redfun (id,where) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   convert_hyp ~check (pf_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl)
-  end }
+  end
 
 let revert_cast (redfun,kind as r) =
   if kind == DEFAULTcast then (redfun,REVERTcast) else r
@@ -711,30 +734,32 @@ let reduct_option ?(check=false) redfun = function
 let pf_e_reduce_decl redfun where decl gl =
   let open Context.Named.Declaration in
   let sigma = Proofview.Goal.sigma gl in
-  let redfun sigma c = redfun.e_redfun (Tacmach.New.pf_env gl) sigma c in
+  let redfun sigma c = redfun (Tacmach.New.pf_env gl) sigma c in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
-    let Sigma (ty', sigma, p) = redfun sigma ty in
-    Sigma (LocalAssum (id, ty'), sigma, p)
+	user_err  (Id.print id ++ str " has no value.");
+    let (sigma, ty') = redfun sigma ty in
+    (sigma, LocalAssum (id, ty'))
   | LocalDef (id,b,ty) ->
-      let Sigma (b', sigma, p) = if where != InHypTypeOnly then redfun sigma b else Sigma.here b sigma in
-      let Sigma (ty', sigma, q) = if where != InHypValueOnly then redfun sigma ty else Sigma.here ty sigma in
-      Sigma (LocalDef (id, b', ty'), sigma, p +> q)
+      let (sigma, b') = if where != InHypTypeOnly then redfun sigma b else (sigma, b) in
+      let (sigma, ty') = if where != InHypValueOnly then redfun sigma ty else (sigma, ty) in
+      (sigma, LocalDef (id, b', ty'))
 
 let e_reduct_in_concl ~check (redfun, sty) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let Sigma (c', sigma, p) = redfun.e_redfun (Tacmach.New.pf_env gl) sigma (Tacmach.New.pf_concl gl) in
-    Sigma (convert_concl ~check c' sty, sigma, p)
-  end }
+    let (sigma, c') = redfun (Tacmach.New.pf_env gl) sigma (Tacmach.New.pf_concl gl) in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_concl ~check c' sty)
+  end
 
 let e_reduct_in_hyp ?(check=false) redfun (id, where) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-    let Sigma (decl', sigma, p) = pf_e_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl in
-    Sigma (convert_hyp ~check decl', sigma, p)
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let (sigma, decl') = pf_e_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_hyp ~check decl')
+  end
 
 let e_reduct_option ?(check=false) redfun = function
   | Some id -> e_reduct_in_hyp ~check (fst redfun) id
@@ -744,41 +769,42 @@ let e_reduct_option ?(check=false) redfun = function
     from conversions. *)
 
 let e_change_in_concl (redfun,sty) =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let Sigma (c, sigma, p) = redfun.e_redfun (Proofview.Goal.env gl) sigma (Proofview.Goal.raw_concl gl) in
-    Sigma (convert_concl_no_check c sty, sigma, p)
-  end }
+    let (sigma, c) = redfun (Proofview.Goal.env gl) sigma (Proofview.Goal.concl gl) in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_concl_no_check c sty)
+  end
 
 let e_pf_change_decl (redfun : bool -> e_reduction_function) where decl env sigma =
   let open Context.Named.Declaration in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
-    let Sigma (ty', sigma, p) = (redfun false).e_redfun env sigma ty in
-    Sigma (LocalAssum (id, ty'), sigma, p)
+	user_err  (Id.print id ++ str " has no value.");
+    let (sigma, ty') = redfun false env sigma ty in
+    (sigma, LocalAssum (id, ty'))
   | LocalDef (id,b,ty) ->
-      let Sigma (b', sigma, p) =
-	if where != InHypTypeOnly then (redfun true).e_redfun env sigma b else Sigma.here b sigma
+      let (sigma, b') =
+	if where != InHypTypeOnly then redfun true env sigma b else (sigma, b)
       in
-      let Sigma (ty', sigma, q) =
-	if where != InHypValueOnly then (redfun false).e_redfun env sigma ty else Sigma.here ty sigma
+      let (sigma, ty') =
+	if where != InHypValueOnly then redfun false env sigma ty else (sigma, ty)
       in
-      Sigma (LocalDef (id,b',ty'), sigma, p +> q)
+      (sigma, LocalDef (id,b',ty'))
 
 let e_change_in_hyp redfun (id,where) =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let hyp = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
-    let Sigma (c, sigma, p) = e_pf_change_decl redfun where hyp (Proofview.Goal.env gl) sigma in
-    Sigma (convert_hyp c, sigma, p)
-  end }
+    let hyp = Tacmach.New.pf_get_hyp id gl in
+    let (sigma, c) = e_pf_change_decl redfun where hyp (Proofview.Goal.env gl) sigma in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_hyp c)
+  end
 
-type change_arg = Pattern.patvar_map -> constr Sigma.run
+type change_arg = Ltac_pretype.patvar_map -> evar_map -> evar_map * EConstr.constr
 
-let make_change_arg c pats =
-  { run = fun sigma -> Sigma.here (replace_vars (Id.Map.bindings pats) c) sigma }
+let make_change_arg c pats sigma = (sigma, replace_vars (Id.Map.bindings pats) c)
 
 let check_types env sigma mayneedglobalcheck deep newc origc =
   let t1 = Retyping.get_type_of env sigma newc in
@@ -789,46 +815,43 @@ let check_types env sigma mayneedglobalcheck deep newc origc =
     let sigma, b = infer_conv ~pb:Reduction.CUMUL env sigma t1 t2 in
     if not b then
       if
-        isSort (whd_all env sigma t1) &&
-        isSort (whd_all env sigma t2)
+        isSort sigma (whd_all env sigma t1) &&
+        isSort sigma (whd_all env sigma t2)
       then (mayneedglobalcheck := true; sigma)
       else
-        errorlabstrm "convert-check-hyp" (str "Types are incompatible.")
+        user_err ~hdr:"convert-check-hyp" (str "Types are incompatible.")
     else sigma
   end
   else
-    if not (isSort (whd_all env sigma t1)) then
-      errorlabstrm "convert-check-hyp" (str "Not a type.")
+    if not (isSort sigma (whd_all env sigma t1)) then
+      user_err ~hdr:"convert-check-hyp" (str "Not a type.")
     else sigma
 
 (* Now we introduce different instances of the previous tacticals *)
-let change_and_check cv_pb mayneedglobalcheck deep t = { e_redfun = begin fun env sigma c ->
-  let Sigma (t', sigma, p) = t.run sigma in
-  let sigma = Sigma.to_evar_map sigma in
+let change_and_check cv_pb mayneedglobalcheck deep t env sigma c =
+  let (sigma, t') = t sigma in
   let sigma = check_types env sigma mayneedglobalcheck deep t' c in
   let sigma, b = infer_conv ~pb:cv_pb env sigma t' c in
-  if not b then errorlabstrm "convert-check-hyp" (str "Not convertible.");
-  Sigma.Unsafe.of_pair (t', sigma)
-end }
+  if not b then user_err ~hdr:"convert-check-hyp" (str "Not convertible.");
+  (sigma, t')
 
 (* Use cumulativity only if changing the conclusion not a subterm *)
-let change_on_subterm cv_pb deep t where = { e_redfun = begin fun env sigma c ->
+let change_on_subterm cv_pb deep t where env sigma c =
   let mayneedglobalcheck = ref false in
-  let Sigma (c, sigma, p) = match where with
-  | None -> (change_and_check cv_pb mayneedglobalcheck deep (t Id.Map.empty)).e_redfun env sigma c
+  let (sigma, c) = match where with
+  | None -> change_and_check cv_pb mayneedglobalcheck deep (t Id.Map.empty) env sigma c
   | Some occl ->
-      (e_contextually false occl
+      e_contextually false occl
         (fun subst ->
-          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))).e_redfun
+          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))
         env sigma c in
   if !mayneedglobalcheck then
     begin
-      try ignore (Typing.unsafe_type_of env (Sigma.to_evar_map sigma) c)
+      try ignore (Typing.unsafe_type_of env sigma c)
       with e when catchable_exception e ->
         error "Replacement would lead to an ill-typed term."
     end;
-  Sigma (c, sigma, p)
-end }
+  (sigma, c)
 
 let change_in_concl occl t =
   e_change_in_concl ((change_on_subterm Reduction.CUMUL false t occl),DEFAULTcast)
@@ -841,7 +864,7 @@ let change_option occl t = function
   | None -> change_in_concl occl t
 
 let change chg c cls =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let cls = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cls in
     Tacticals.New.tclMAP (function
     | OnHyp (id,occs,where) ->
@@ -849,7 +872,7 @@ let change chg c cls =
     | OnConcl occs ->
        change_option (bind_change_occurrences occs chg) c None)
     cls
-  end }
+  end
 
 let change_concl t = 
   change_in_concl None (make_change_arg t)
@@ -884,16 +907,24 @@ let reduction_clause redexp cl =
 	(None, bind_red_expr_occurrences occs nbcl redexp)) cl
 
 let reduce redexp cl =
-  let trace () = Pp.(hov 2 (Pptactic.pr_atomic_tactic (Global.env()) (TacReduce (redexp,cl)))) in
+  let trace env sigma =
+    let open Printer in
+    let pr = (pr_econstr_env, pr_leconstr_env, pr_evaluable_reference, pr_constr_pattern_env) in
+    Pp.(hov 2 (Pputils.pr_red_expr_env env sigma pr str redexp))
+  in
+  let trace () =
+    let sigma, env = Pfedit.get_current_context () in
+    trace env sigma
+  in
   Proofview.Trace.name_tactic trace begin
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let cl' = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cl in
   let redexps = reduction_clause redexp cl' in
   let check = match redexp with Fold _ | Pattern _ -> true | _ -> false in
   Tacticals.New.tclMAP (fun (where,redexp) ->
     e_reduct_option ~check
       (Redexpr.reduction_of_red_expr (Tacmach.New.pf_env gl) redexp) where) redexps
-  end }
+  end
   end
 
 (* Unfolding occurrences of a constant *)
@@ -901,7 +932,7 @@ let reduce redexp cl =
 let unfold_constr = function
   | ConstRef sp -> unfold_in_concl [AllOccurrences,EvalConstRef sp]
   | VarRef id -> unfold_in_concl [AllOccurrences,EvalVarRef id]
-  | _ -> errorlabstrm "unfold_constr" (str "Cannot unfold a non-constant.")
+  | _ -> user_err ~hdr:"unfold_constr" (str "Cannot unfold a non-constant.")
 
 (*******************************************)
 (*         Introduction tactics            *)
@@ -913,13 +944,13 @@ let unfold_constr = function
    the type to build hyp names, we maintain an environment to be able
    to type dependent hyps. *)
 let find_intro_names ctxt gl =
-  let _, res = List.fold_right
+  let _, res, _ = List.fold_right
     (fun decl acc ->
-      let env,idl = acc in
-      let name = fresh_id idl (default_id env gl.sigma decl) gl in
+      let env,idl,avoid = acc in
+      let name = fresh_id avoid (default_id env gl.sigma decl) gl in
       let newenv = push_rel decl env in
-      (newenv,(name::idl)))
-    ctxt (pf_env gl , []) in
+      (newenv, name :: idl, Id.Set.add name avoid))
+    ctxt (pf_env gl, [], Id.Set.empty) in
   List.rev res
 
 let build_intro_tac id dest tac = match dest with
@@ -929,18 +960,19 @@ let build_intro_tac id dest tac = match dest with
 
 let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
-    let concl = nf_evar (Tacmach.New.project gl) concl in
-    match kind_of_term concl with
-    | Prod (name,t,u) when not dep_flag || (dependent (mkRel 1) u) ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
+    let env = Tacmach.New.pf_env gl in
+    let concl = Proofview.Goal.concl gl in
+    match EConstr.kind sigma concl with
+    | Prod (name,t,u) when not dep_flag || not (noccurn sigma 1 u) ->
         let name = find_name false (LocalAssum (name,t)) name_flag gl in
 	build_intro_tac name move_flag tac
-    | LetIn (name,b,t,u) when not dep_flag || (dependent (mkRel 1) u) ->
+    | LetIn (name,b,t,u) when not dep_flag || not (noccurn sigma 1 u) ->
         let name = find_name false (LocalDef (name,b,t)) name_flag gl in
 	build_intro_tac name move_flag tac
     | _ ->
-	begin if not force_flag then Proofview.tclZERO (RefinerError IntroNeedsProduct)
+        begin if not force_flag then Proofview.tclZERO (RefinerError (env, sigma, IntroNeedsProduct))
             (* Note: red_in_concl includes betaiotazeta and this was like *)
             (* this since at least V6.3 (a pity *)
             (* that intro do betaiotazeta only when reduction is needed; and *)
@@ -951,26 +983,26 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
 	  (Tacticals.New.tclTHEN hnf_in_concl
 	     (intro_then_gen name_flag move_flag false dep_flag tac))
           begin function (e, info) -> match e with
-            | RefinerError IntroNeedsProduct ->
+            | RefinerError (env, sigma, IntroNeedsProduct) ->
                 Tacticals.New.tclZEROMSG (str "No product even after head-reduction.")
             | e -> Proofview.tclZERO ~info e
           end
-  end }
+  end
 
 let intro_gen n m f d = intro_then_gen n m f d (fun _ -> Proofview.tclUNIT ())
-let intro_mustbe_force id = intro_gen (NamingMustBe (dloc,id)) MoveLast true false
-let intro_using id = intro_gen (NamingBasedOn (id,[])) MoveLast false false
+let intro_mustbe_force id = intro_gen (NamingMustBe (CAst.make id)) MoveLast true false
+let intro_using id = intro_gen (NamingBasedOn (id, Id.Set.empty)) MoveLast false false
 
-let intro_then = intro_then_gen (NamingAvoid []) MoveLast false false
-let intro = intro_gen (NamingAvoid []) MoveLast false false
-let introf = intro_gen (NamingAvoid []) MoveLast true false
+let intro_then = intro_then_gen (NamingAvoid Id.Set.empty) MoveLast false false
+let intro = intro_gen (NamingAvoid Id.Set.empty) MoveLast false false
+let introf = intro_gen (NamingAvoid Id.Set.empty) MoveLast true false
 let intro_avoiding l = intro_gen (NamingAvoid l) MoveLast false false
 
 let intro_move_avoid idopt avoid hto = match idopt with
   | None -> intro_gen (NamingAvoid avoid) hto true false
-  | Some id -> intro_gen (NamingMustBe (dloc,id)) hto true false
+  | Some id -> intro_gen (NamingMustBe (CAst.make id)) hto true false
 
-let intro_move idopt hto = intro_move_avoid idopt [] hto
+let intro_move idopt hto = intro_move_avoid idopt Id.Set.empty hto
 
 (**** Multiple introduction tactics ****)
 
@@ -990,7 +1022,7 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
          (fun id -> aux (n+1) (id::ids))
       end
       begin function (e, info) -> match e with
-      | RefinerError IntroNeedsProduct ->
+      | RefinerError (env, sigma, IntroNeedsProduct) ->
           tac ids
       | e -> Proofview.tclZERO ~info e
       end
@@ -999,37 +1031,17 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
   in
   aux n []
 
-let get_next_hyp_position id gl =
-  let open Context.Named.Declaration in
-  let rec aux = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
-  | decl :: right ->
-    if Id.equal (get_id decl) id then
-      match right with decl::_ -> MoveBefore (get_id decl) | [] -> MoveLast
-    else
-      aux right
-  in
-  aux (Proofview.Goal.hyps (Proofview.Goal.assume gl))
-
-let get_previous_hyp_position id gl =
-  let open Context.Named.Declaration in
-  let rec aux dest = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
-  | decl :: right ->
-      let hyp = get_id decl in
-      if Id.equal hyp id then dest else aux (MoveAfter hyp) right
-  in
-  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
-
 let intro_replacing id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let next_hyp = get_next_hyp_position id gl in
+  Proofview.Goal.enter begin fun gl ->
+  let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+  let hyps = Proofview.Goal.hyps gl in
+  let next_hyp = get_next_hyp_position env sigma id hyps in
   Tacticals.New.tclTHENLIST [
     clear_for_replacing [id];
     introduction id;
     move_hyp id next_hyp;
   ]
-  end }
+  end
 
 (* We have e.g. [x, y, y', x', y'' |- forall y y' y'', G] and want to
    reintroduce y, y,' y''. Note that we have to clear y, y' and y''
@@ -1041,8 +1053,10 @@ let intro_replacing id =
 (* the behavior of inversion *)
 let intros_possibly_replacing ids =
   let suboptimal = true in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
+  Proofview.Goal.enter begin fun gl ->
+    let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+    let hyps = Proofview.Goal.hyps gl in
+    let posl = List.map (fun id -> (id, get_next_hyp_position env sigma id hyps)) ids in
     Tacticals.New.tclTHEN
       (Tacticals.New.tclMAP (fun id -> 
 	Tacticals.New.tclTRY (clear_for_replacing [id]))
@@ -1050,30 +1064,32 @@ let intros_possibly_replacing ids =
       (Tacticals.New.tclMAP (fun (id,pos) ->
         Tacticals.New.tclORELSE (intro_move (Some id) pos) (intro_using id))
          posl)
-  end }
+  end
 
 (* This version assumes that replacement is actually possible *)
 let intros_replacing ids =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
+  Proofview.Goal.enter begin fun gl ->
+    let hyps = Proofview.Goal.hyps gl in
+    let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+    let posl = List.map (fun id -> (id, get_next_hyp_position env sigma id hyps)) ids in
     Tacticals.New.tclTHEN
       (clear_for_replacing ids)
       (Tacticals.New.tclMAP (fun (id,pos) -> intro_move (Some id) pos) posl)
-  end }
+  end
 
 (* User-level introduction tactics *)
 
-let lookup_hypothesis_as_renamed env ccl = function
-  | AnonHyp n -> Detyping.lookup_index_as_renamed env ccl n
-  | NamedHyp id -> Detyping.lookup_name_as_displayed env ccl id
+let lookup_hypothesis_as_renamed env sigma ccl = function
+  | AnonHyp n -> Detyping.lookup_index_as_renamed env sigma ccl n
+  | NamedHyp id -> Detyping.lookup_name_as_displayed env sigma ccl id
 
 let lookup_hypothesis_as_renamed_gen red h gl =
   let env = Proofview.Goal.env gl in
   let rec aux ccl =
-    match lookup_hypothesis_as_renamed env ccl h with
+    match lookup_hypothesis_as_renamed env (Tacmach.New.project gl) ccl h with
       | None when red ->
         let (redfun, _) = Redexpr.reduction_of_red_expr env (Red true) in
-        let Sigma (c, _, _) = redfun.e_redfun env (Proofview.Goal.sigma gl) ccl in
+        let (_, c) = redfun env (Proofview.Goal.sigma gl) ccl in
         aux c
       | x -> x
   in
@@ -1087,7 +1103,7 @@ let is_quantified_hypothesis id gl =
 
 let msg_quantified_hypothesis = function
   | NamedHyp id ->
-      str "quantified hypothesis named " ++ pr_id id
+      str "quantified hypothesis named " ++ Id.print id
   | AnonHyp n ->
       pr_nth n ++
       str " non dependent hypothesis"
@@ -1096,17 +1112,17 @@ let depth_of_quantified_hypothesis red h gl =
   match lookup_hypothesis_as_renamed_gen red h gl with
     | Some depth -> depth
     | None ->
-        errorlabstrm "lookup_quantified_hypothesis"
+        user_err ~hdr:"lookup_quantified_hypothesis"
           (str "No " ++ msg_quantified_hypothesis h ++
 	  strbrk " in current goal" ++
 	  (if red then strbrk " even after head-reduction" else mt ()) ++
 	  str".")
 
 let intros_until_gen red h =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let n = depth_of_quantified_hypothesis red h gl in
   Tacticals.New.tclDO n (if red then introf else intro)
-  end }
+  end
 
 let intros_until_id id = intros_until_gen false (NamedHyp id)
 let intros_until_n_gen red n = intros_until_gen red (AnonHyp n)
@@ -1115,10 +1131,10 @@ let intros_until = intros_until_gen true
 let intros_until_n = intros_until_n_gen true
 
 let tclCHECKVAR id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let _ = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+    let _ = Tacmach.New.pf_get_hyp id gl in
     Proofview.tclUNIT ()
-  end }
+  end
 
 let try_intros_until_id_check id =
   Tacticals.New.tclORELSE (intros_until_id id) (tclCHECKVAR id)
@@ -1130,49 +1146,43 @@ let try_intros_until tac = function
 let rec intros_move = function
   | [] -> Proofview.tclUNIT ()
   | (hyp,destopt) :: rest ->
-      Tacticals.New.tclTHEN (intro_gen (NamingMustBe (dloc,hyp)) destopt false false)
+      Tacticals.New.tclTHEN (intro_gen (NamingMustBe (CAst.make hyp)) destopt false false)
 	(intros_move rest)
 
-let run_delayed env sigma c =
-  Sigma.run sigma { Sigma.run = fun sigma -> c.delayed env sigma }
-
 (* Apply a tactic on a quantified hypothesis, an hypothesis in context
    or a term with bindings *)
 
 let tactic_infer_flags with_evar = {
   Pretyping.use_typeclasses = true;
   Pretyping.solve_unification_constraints = true;
-  Pretyping.use_hook = Some solve_by_implicit_tactic;
+  Pretyping.use_hook = Pfedit.solve_by_implicit_tactic ();
   Pretyping.fail_evar = not with_evar;
   Pretyping.expand_evars = true }
 
 
 let onOpenInductionArg env sigma tac = function
   | clear_flag,ElimOnConstr f ->
-      let (cbl, sigma') = run_delayed env sigma f in
-      let pending = (sigma,sigma') in
+      let (sigma', cbl) = f env sigma in
       Tacticals.New.tclTHEN
         (Proofview.Unsafe.tclEVARS sigma')
-        (tac clear_flag (pending,cbl))
+        (tac clear_flag (sigma,cbl))
   | clear_flag,ElimOnAnonHyp n ->
       Tacticals.New.tclTHEN
         (intros_until_n n)
         (Tacticals.New.onLastHyp
            (fun c ->
-             Proofview.Goal.enter { enter = begin fun gl ->
+             Proofview.Goal.enter begin fun gl ->
              let sigma = Tacmach.New.project gl in
-             let pending = (sigma,sigma) in
-             tac clear_flag (pending,(c,NoBindings))
-             end }))
-  | clear_flag,ElimOnIdent (_,id) ->
+             tac clear_flag (sigma,(c,NoBindings))
+             end))
+  | clear_flag,ElimOnIdent {CAst.v=id} ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
-        (Proofview.Goal.enter { enter = begin fun gl ->
+        (Proofview.Goal.enter begin fun gl ->
          let sigma = Tacmach.New.project gl in
-         let pending = (sigma,sigma) in
-         tac clear_flag (pending,(mkVar id,NoBindings))
-        end })
+         tac clear_flag (sigma,(mkVar id,NoBindings))
+        end)
 
 let onInductionArg tac = function
   | clear_flag,ElimOnConstr cbl ->
@@ -1181,7 +1191,7 @@ let onInductionArg tac = function
       Tacticals.New.tclTHEN
         (intros_until_n n)
         (Tacticals.New.onLastHyp (fun c -> tac clear_flag (c,NoBindings)))
-  | clear_flag,ElimOnIdent (_,id) ->
+  | clear_flag,ElimOnIdent {CAst.v=id} ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
@@ -1193,12 +1203,10 @@ let map_destruction_arg f sigma = function
   | clear_flag,ElimOnIdent id as x -> (sigma,x)
 
 let finish_delayed_evar_resolution with_evars env sigma f =
-  let ((c, lbind), sigma') = run_delayed env sigma f in
-  let pending = (sigma,sigma') in
-  let sigma' = Sigma.Unsafe.of_evar_map sigma' in
+  let (sigma', (c, lbind)) = f env sigma in
   let flags = tactic_infer_flags with_evars in
-  let Sigma (c, sigma', _) = finish_evar_resolution ~flags env sigma' (pending,c) in
-  (Sigma.to_evar_map sigma', (c, lbind))
+  let (sigma', c) = finish_evar_resolution ~flags env sigma' (sigma,c) in
+  (sigma', (c, lbind))
 
 let with_no_bindings (c, lbind) =
   if lbind != NoBindings then error "'with' clause not supported here.";
@@ -1214,45 +1222,46 @@ let force_destruction_arg with_evars env sigma c =
 let normalize_cut = false
 
 let cut c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let concl = Tacmach.New.pf_nf_concl gl in
+    let concl = Proofview.Goal.concl gl in
     let is_sort =
       try
         (** Backward compat: ensure that [c] is well-typed. *)
         let typ = Typing.unsafe_type_of env sigma c in
         let typ = whd_all env sigma typ in
-        match kind_of_term typ with
+        match EConstr.kind sigma typ with
         | Sort _ -> true
         | _ -> false
       with e when Pretype_errors.precatchable_exception e -> false
     in
     if is_sort then
-      let id = next_name_away_with_default "H" Anonymous (Tacmach.New.pf_ids_of_hyps gl) in
+      let id = next_name_away_with_default "H" Anonymous (Tacmach.New.pf_ids_set_of_hyps gl) in
       (** Backward compat: normalize [c]. *)
       let c = if normalize_cut then local_strong whd_betaiota sigma c else c in
-      Refine.refine ~unsafe:true { run = begin fun h ->
-        let Sigma (f, h, p) = Evarutil.new_evar ~principal:true env h (mkArrow c (Vars.lift 1 concl)) in
-        let Sigma (x, h, q) = Evarutil.new_evar env h c in
+      Refine.refine ~typecheck:false begin fun h ->
+        let (h, f) = Evarutil.new_evar ~principal:true env h (mkArrow c (Vars.lift 1 concl)) in
+        let (h, x) = Evarutil.new_evar env h c in
         let f = mkLetIn (Name id, x, c, mkApp (Vars.lift 1 f, [|mkRel 1|])) in
-        Sigma (f, h, p +> q)
-      end }
+        (h, f)
+      end
     else
       Tacticals.New.tclZEROMSG (str "Not a proposition or a type.")
-  end }
+  end
 
 let error_uninstantiated_metas t clenv =
+  let t = EConstr.Unsafe.to_constr t in
   let na = meta_name clenv.evd (List.hd (Metaset.elements (metavars_of t))) in
-  let id = match na with Name id -> id | _ -> anomaly (Pp.str "unnamed dependent meta")
-  in errorlabstrm "" (str "Cannot find an instance for " ++ pr_id id ++ str".")
+  let id = match na with Name id -> id | _ -> anomaly (Pp.str "unnamed dependent meta.")
+  in user_err  (str "Cannot find an instance for " ++ Id.print id ++ str".")
 
 let check_unresolved_evars_of_metas sigma clenv =
   (* This checks that Metas turned into Evars by *)
   (* Refiner.pose_all_metas_as_evars are resolved *)
   List.iter (fun (mv,b) -> match b with
   | Clval (_,(c,_),_) ->
-    (match kind_of_term c.rebus with
+    (match Constr.kind c.rebus with
     | Evar (evk,_) when Evd.is_undefined clenv.evd evk
                      && not (Evd.mem sigma evk) ->
       error_uninstantiated_metas (mkMeta mv) clenv
@@ -1261,7 +1270,7 @@ let check_unresolved_evars_of_metas sigma clenv =
   (meta_list clenv.evd)
 
 let do_replace id = function
-  | NamingMustBe (_,id') when Option.equal Id.equal id (Some id') -> true
+  | NamingMustBe {CAst.v=id'} when Option.equal Id.equal id (Some id') -> true
   | _ -> false
 
 (* For a clenv expressing some lemma [C[?1:T1,...,?n:Tn] : P] and some
@@ -1281,11 +1290,11 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
   in
   let new_hyp_typ = clenv_type clenv in
   if not with_evars then check_unresolved_evars_of_metas sigma0 clenv;
-  if not with_evars && occur_meta new_hyp_typ then
+  if not with_evars && occur_meta clenv.evd new_hyp_typ then
     error_uninstantiated_metas new_hyp_typ clenv;
   let new_hyp_prf = clenv_value clenv in
   let exact_tac = Proofview.V82.tactic (Tacmach.refine_no_check new_hyp_prf) in
-  let naming = NamingMustBe (dloc,targetid) in
+  let naming = NamingMustBe (CAst.make targetid) in
   let with_clear = do_replace (Some id) naming in
   Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARS (clear_metas clenv.evd))
@@ -1300,90 +1309,50 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
 (*       Elimination tactics                *)
 (********************************************)
 
-let last_arg c = match kind_of_term c with
+let last_arg sigma c = match EConstr.kind sigma c with
   | App (f,cl) ->
       Array.last cl
-  | _ -> anomaly (Pp.str "last_arg")
+  | _ -> anomaly (Pp.str "last_arg.")
 
-let nth_arg i c =
-  if Int.equal i (-1) then last_arg c else
-  match kind_of_term c with
+let nth_arg sigma i c =
+  if Int.equal i (-1) then last_arg sigma c else
+  match EConstr.kind sigma c with
   | App (f,cl) -> cl.(i)
-  | _ -> anomaly (Pp.str "nth_arg")
+  | _ -> anomaly (Pp.str "nth_arg.")
 
-let index_of_ind_arg t =
-  let rec aux i j t = match kind_of_term t with
+let index_of_ind_arg sigma t =
+  let rec aux i j t = match EConstr.kind sigma t with
   | Prod (_,t,u) ->
       (* heuristic *)
-      if isInd (fst (decompose_app t)) then aux (Some j) (j+1) u
+      if isInd sigma (fst (decompose_app sigma t)) then aux (Some j) (j+1) u
       else aux i (j+1) u
   | _ -> match i with
       | Some i -> i
       | None -> error "Could not find inductive argument of elimination scheme."
   in aux None 0 t
 
-let enforce_prop_bound_names rename tac =
-  let open Context.Rel.Declaration in
-  match rename with
-  | Some (isrec,nn) when Namegen.use_h_based_elimination_names () ->
-      (* Rename dependent arguments in Prop with name "H" *)
-      (* so as to avoid having hypothesis such as "t:True", "n:~A" when calling *)
-      (* elim or induction with schemes built by Indrec.build_induction_scheme *)
-      let rec aux env sigma i t =
-        if i = 0 then t else match kind_of_term t with
-        | Prod (Name _ as na,t,t') ->
-            let very_standard = true in
-            let na =
-              if Retyping.get_sort_family_of env sigma t = InProp then
-                (* "very_standard" says that we should have "H" names only, but
-                   this would break compatibility even more... *)
-                let s = match Namegen.head_name t with
-                  | Some id when not very_standard -> string_of_id id
-                  | _ -> "" in
-                Name (add_suffix Namegen.default_prop_ident s)
-              else
-                na in
-            mkProd (na,t,aux (push_rel (LocalAssum (na,t)) env) sigma (i-1) t')
-        | Prod (Anonymous,t,t') ->
-            mkProd (Anonymous,t,aux (push_rel (LocalAssum (Anonymous,t)) env) sigma (i-1) t')
-        | LetIn (na,c,t,t') ->
-            mkLetIn (na,c,t,aux (push_rel (LocalDef (na,c,t)) env) sigma (i-1) t')
-        | _ -> print_int i; Feedback.msg_notice (print_constr t); assert false in
-      let rename_branch i =
-        Proofview.Goal.nf_enter { enter = begin fun gl ->
-          let env = Proofview.Goal.env gl in
-          let sigma = Tacmach.New.project gl in
-          let t = Proofview.Goal.concl gl in
-          change_concl (aux env sigma i t)
-        end } in
-      (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
-        tac
-        (Array.map rename_branch nn)
-  | _ ->
-      tac
-
-let rec contract_letin_in_lam_header c =
-  match kind_of_term c with
-  | Lambda (x,t,c)  -> mkLambda (x,t,contract_letin_in_lam_header c)
-  | LetIn (x,b,t,c) -> contract_letin_in_lam_header (subst1 b c)
+let rec contract_letin_in_lam_header sigma c =
+  match EConstr.kind sigma c with
+  | Lambda (x,t,c)  -> mkLambda (x,t,contract_letin_in_lam_header sigma c)
+  | LetIn (x,b,t,c) -> contract_letin_in_lam_header sigma (subst1 b c)
   | _ -> c
 
 let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags ()) 
     rename i (elim, elimty, bindings) indclause =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let elim = contract_letin_in_lam_header elim in
+  let elim = contract_letin_in_lam_header sigma elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
   let indmv =
-    (match kind_of_term (nth_arg i elimclause.templval.rebus) with
+    (match EConstr.kind sigma (nth_arg sigma i elimclause.templval.rebus) with
        | Meta mv -> mv
-       | _  -> errorlabstrm "elimination_clause"
+       | _  -> user_err ~hdr:"elimination_clause"
              (str "The type of elimination clause is not well-formed."))
   in
   let elimclause' = clenv_fchain ~flags indmv elimclause indclause in
-  enforce_prop_bound_names rename (Clenvtac.res_pf elimclause' ~with_evars ~with_classes ~flags)
-  end }
+  Clenvtac.res_pf elimclause' ~with_evars ~with_classes ~flags
+  end
 
 (*
  * Elimination tactic with bindings and using an arbitrary
@@ -1396,22 +1365,22 @@ let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags
 type eliminator = {
   elimindex : int option;  (* None = find it automatically *)
   elimrename : (bool * int array) option; (** None = don't rename Prop hyps with H-names *)
-  elimbody : constr with_bindings
+  elimbody : EConstr.constr with_bindings
 }
 
 let general_elim_clause_gen elimtac indclause elim =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let (elimc,lbindelimc) = elim.elimbody in
   let elimt = Retyping.get_type_of env sigma elimc in
   let i =
-    match elim.elimindex with None -> index_of_ind_arg elimt | Some i -> i in
+    match elim.elimindex with None -> index_of_ind_arg sigma elimt | Some i -> i in
   elimtac elim.elimrename i (elimc, elimt, lbindelimc) indclause
-  end }
+  end
 
 let general_elim with_evars clear_flag (c, lbindc) elim =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let ct = Retyping.get_type_of env sigma c in
@@ -1423,33 +1392,34 @@ let general_elim with_evars clear_flag (c, lbindc) elim =
   Tacticals.New.tclTHEN
     (general_elim_clause_gen elimtac indclause elim)
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c)
-  end }
+  end
 
 (* Case analysis tactics *)
 
 let general_case_analysis_in_context with_evars clear_flag (c,lbindc) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
-  let t = Retyping.get_type_of env (Sigma.to_evar_map sigma) c in
-  let (mind,_) = reduce_to_quantified_ind env (Sigma.to_evar_map sigma) t in
+  let t = Retyping.get_type_of env sigma c in
+  let (mind,_) = reduce_to_quantified_ind env sigma t in
   let sort = Tacticals.New.elimination_sort_of_goal gl in
-  let Sigma (elim, sigma, p) =
-    if occur_term c concl then
+  let mind = on_snd (fun u -> EInstance.kind sigma u) mind in
+  let (sigma, elim) =
+    if dependent sigma c concl then
       build_case_analysis_scheme env sigma mind true sort
     else
       build_case_analysis_scheme_default env sigma mind sort in
-  let tac =
+  let elim = EConstr.of_constr elim in
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
   (general_elim with_evars clear_flag (c,lbindc)
    {elimindex = None; elimbody = (elim,NoBindings);
     elimrename = Some (false, constructors_nrealdecls (fst mind))})
-  in
-  Sigma (tac, sigma, p)
-  end }
+  end
 
 let general_case_analysis with_evars clear_flag (c,lbindc as cx) =
-  match kind_of_term c with
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma c with
     | Var id when lbindc == NoBindings ->
 	Tacticals.New.tclTHEN (try_intros_until_id_check id)
 	  (general_case_analysis_in_context with_evars clear_flag cx)
@@ -1464,11 +1434,12 @@ let simplest_ecase c = general_case_analysis true None (c,NoBindings)
 
 exception IsNonrec
 
-let is_nonrec mind = (Global.lookup_mind (fst mind)).mind_finite == Decl_kinds.BiFinite
+let is_nonrec mind = (Global.lookup_mind (fst mind)).mind_finite == Declarations.BiFinite
 
 let find_ind_eliminator ind s gl =
   let gr = lookup_eliminator ind s in
   let evd, c = Tacmach.New.pf_apply Evd.fresh_global gl gr in
+  let c = EConstr.of_constr c in
     evd, c
 
 let find_eliminator c gl =
@@ -1480,13 +1451,11 @@ let find_eliminator c gl =
 
 let default_elim with_evars clear_flag (c,_ as cx) =
   Proofview.tclORELSE
-    (Proofview.Goal.s_enter { s_enter = begin fun gl ->
+    (Proofview.Goal.enter begin fun gl ->
       let sigma, elim = find_eliminator c gl in
-      let tac =
-	  (general_elim with_evars clear_flag cx elim)
-      in
-      Sigma.Unsafe.of_pair (tac, sigma)
-    end })
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+      (general_elim with_evars clear_flag cx elim)
+    end)
     begin function (e, info) -> match e with
       | IsNonrec ->
           (* For records, induction principles aren't there by default
@@ -1502,7 +1471,8 @@ let elim_in_context with_evars clear_flag c = function
   | None -> default_elim with_evars clear_flag c
 
 let elim with_evars clear_flag (c,lbindc as cx) elim =
-  match kind_of_term c with
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma c with
     | Var id when lbindc == NoBindings ->
 	Tacticals.New.tclTHEN (try_intros_until_id_check id)
 	  (elim_in_context with_evars clear_flag cx elim)
@@ -1533,30 +1503,30 @@ let clenv_fchain_in id ?(flags=elim_flags ()) mv elimclause hypclause =
 
 let elimination_in_clause_scheme with_evars ?(flags=elim_flags ()) 
     id rename i (elim, elimty, bindings) indclause =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let elim = contract_letin_in_lam_header elim in
+  let elim = contract_letin_in_lam_header sigma elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
-  let indmv = destMeta (nth_arg i elimclause.templval.rebus) in
+  let indmv = destMeta sigma (nth_arg sigma i elimclause.templval.rebus) in
   let hypmv =
-    try match List.remove Int.equal indmv (clenv_independent elimclause) with
-      | [a] -> a
-      | _ -> failwith ""
-    with Failure _ -> errorlabstrm "elimination_clause"
-          (str "The type of elimination clause is not well-formed.") in
+    match List.remove Int.equal indmv (clenv_independent elimclause) with
+    | [a] -> a
+    | _ -> user_err ~hdr:"elimination_clause"
+             (str "The type of elimination clause is not well-formed.")
+  in
   let elimclause'  = clenv_fchain ~flags indmv elimclause indclause in
   let hyp = mkVar id in
   let hyp_typ = Retyping.get_type_of env sigma hyp in
   let hypclause = mk_clenv_from_env env sigma (Some 0) (hyp, hyp_typ) in
   let elimclause'' = clenv_fchain_in id ~flags hypmv elimclause' hypclause in
   let new_hyp_typ  = clenv_type elimclause'' in
-  if Term.eq_constr hyp_typ new_hyp_typ then
-    errorlabstrm "general_rewrite_in"
-      (str "Nothing to rewrite in " ++ pr_id id ++ str".");
+  if EConstr.eq_constr sigma hyp_typ new_hyp_typ then
+    user_err ~hdr:"general_rewrite_in"
+      (str "Nothing to rewrite in " ++ Id.print id ++ str".");
   clenv_refine_in with_evars id id sigma elimclause''
     (fun id -> Proofview.tclUNIT ())
-  end }
+  end
 
 let general_elim_clause with_evars flags id c e =
   let elim = match id with
@@ -1568,7 +1538,7 @@ let general_elim_clause with_evars flags id c e =
 (* Apply a tactic below the products of the conclusion of a lemma *)
 
 type conjunction_status =
-  | DefinedRecord of constant option list
+  | DefinedRecord of Constant.t option list
   | NotADefinedRecordUseScheme of constr
 
 let make_projection env sigma params cstr sign elim i n c u =
@@ -1576,21 +1546,23 @@ let make_projection env sigma params cstr sign elim i n c u =
   let elim = match elim with
   | NotADefinedRecordUseScheme elim ->
       (* bugs: goes from right to left when i increases! *)
-      let decl = List.nth cstr.cs_args i in
-      let t = get_type decl in
+      let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstr.cs_args in
+      let decl = List.nth cs_args i in
+      let t = RelDecl.get_type decl in
       let b = match decl with LocalAssum _ -> mkRel (i+1) | LocalDef (_,b,_) -> b in
-      let branch = it_mkLambda_or_LetIn b cstr.cs_args in
+      let branch = it_mkLambda_or_LetIn b cs_args in
       if
 	(* excludes dependent projection types *)
-	noccur_between 1 (n-i-1) t
+	noccur_between sigma 1 (n-i-1) t
 	(* to avoid surprising unifications, excludes flexible
 	projection types or lambda which will be instantiated by Meta/Evar *)
-	&& not (isEvar (fst (whd_betaiota_stack sigma t)))
-	&& (accept_universal_lemma_under_conjunctions () || not (isRel t))
+	&& not (isEvar sigma (fst (whd_betaiota_stack sigma t)))
+	&& (accept_universal_lemma_under_conjunctions () || not (isRel sigma t))
       then
         let t = lift (i+1-n) t in
-	let abselim = beta_applist (elim,params@[t;branch]) in
-	let c = beta_applist (abselim, [mkApp (c, Context.Rel.to_extended_vect 0 sign)]) in
+	let abselim = beta_applist sigma (elim, params@[t;branch]) in
+	let args = Context.Rel.to_extended_vect mkRel 0 sign in
+	let c = beta_applist sigma (abselim, [mkApp (c, args)]) in
 	  Some (it_mkLambda_or_LetIn c sign, it_mkProd_or_LetIn t sign)
       else
 	None
@@ -1598,7 +1570,7 @@ let make_projection env sigma params cstr sign elim i n c u =
       (* goes from left to right when i increases! *)
       match List.nth l i with
       | Some proj ->
-	  let args = Context.Rel.to_extended_vect 0 sign in
+	  let args = Context.Rel.to_extended_vect mkRel 0 sign in
 	  let proj =
 	    if Environ.is_projection proj env then
 	      mkProj (Projection.make proj false, mkApp (c, args))
@@ -1613,30 +1585,32 @@ let make_projection env sigma params cstr sign elim i n c u =
   in elim
 
 let descend_in_conjunctions avoid tac (err, info) c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   try
     let t = Retyping.get_type_of env sigma c in
     let ((ind,u),t) = reduce_to_quantified_ind env sigma t in
-    let sign,ccl = decompose_prod_assum t in
-    match match_with_tuple ccl with
+    let sign,ccl = EConstr.decompose_prod_assum sigma t in
+    match match_with_tuple sigma ccl with
     | Some (_,_,isrec) ->
 	let n = (constructors_nrealargs ind).(0) in
 	let sort = Tacticals.New.elimination_sort_of_goal gl in
 	let IndType (indf,_) = find_rectype env sigma ccl in
 	let (_,inst), params = dest_ind_family indf in
+	let params = List.map EConstr.of_constr params in
 	let cstr = (get_constructors env indf).(0) in
 	let elim =
 	  try DefinedRecord (Recordops.lookup_projections ind)
 	  with Not_found ->
-            let sigma = Sigma.Unsafe.of_evar_map sigma in
-	    let Sigma (elim, _, _) = build_case_analysis_scheme env sigma (ind,u) false sort in
+            let u = EInstance.kind sigma u in
+	    let (_, elim) = build_case_analysis_scheme env sigma (ind,u) false sort in
+	    let elim = EConstr.of_constr elim in
 	    NotADefinedRecordUseScheme elim in
 	Tacticals.New.tclORELSE0
 	(Tacticals.New.tclFIRST
 	  (List.init n (fun i ->
-            Proofview.Goal.enter { enter = begin fun gl ->
+            Proofview.Goal.enter begin fun gl ->
             let env = Proofview.Goal.env gl in
             let sigma = Tacmach.New.project gl in
 	    match make_projection env sigma params cstr sign elim i n c u with
@@ -1647,33 +1621,16 @@ let descend_in_conjunctions avoid tac (err, info) c =
 		[Proofview.V82.tactic (refine p);
 		 (* Might be ill-typed due to forbidden elimination. *)
 		 Tacticals.New.onLastHypId (tac (not isrec))]
-           end })))
+           end)))
           (Proofview.tclZERO ~info err)
     | None -> Proofview.tclZERO ~info err
   with RefinerError _|UserError _ -> Proofview.tclZERO ~info err
-  end }
+  end
 
 (****************************************************)
 (*            Resolution tactics                    *)
 (****************************************************)
 
-let solve_remaining_apply_goals =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-  let sigma = Proofview.Goal.sigma gl in
-  if !apply_solve_class_goals then
-    try 
-      let env = Proofview.Goal.env gl in
-      let evd = Sigma.to_evar_map sigma in
-      let concl = Proofview.Goal.concl gl in
-      if Typeclasses.is_class_type evd concl then
-        let evd', c' = Typeclasses.resolve_one_typeclass env evd concl in
-        let tac = Refine.refine ~unsafe:true { run = fun h -> Sigma.here c' h } in
-        Sigma.Unsafe.of_pair (tac, evd')
-	else Sigma.here (Proofview.tclUNIT ()) sigma
-    with Not_found -> Sigma.here (Proofview.tclUNIT ()) sigma
-  else Sigma.here (Proofview.tclUNIT ()) sigma
-  end }
-
 let tclORELSEOPT t k =
   Proofview.tclORELSE t
     (fun e -> match k e with
@@ -1682,25 +1639,27 @@ let tclORELSEOPT t k =
       Proofview.tclZERO ~info e
     | Some tac -> tac)
 
-let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind)) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+let general_apply with_delta with_destruct with_evars clear_flag
+    {CAst.loc;v=(c,lbind : EConstr.constr with_bindings)} =
+  Proofview.Goal.enter begin fun gl ->
   let concl = Proofview.Goal.concl gl in
+  let sigma = Tacmach.New.project gl in
   let flags =
     if with_delta then default_unify_flags () else default_no_delta_unify_flags () in
   (* The actual type of the theorem. It will be matched against the
   goal. If this fails, then the head constant will be unfolded step by
   step. *)
-  let concl_nprod = nb_prod_modulo_zeta concl in
+  let concl_nprod = nb_prod_modulo_zeta sigma concl in
   let rec try_main_apply with_destruct c =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
 
-    let thm_ty0 = nf_betaiota sigma (Retyping.get_type_of env sigma c) in
+    let thm_ty0 = nf_betaiota env sigma (Retyping.get_type_of env sigma c) in
     let try_apply thm_ty nprod =
       try
-        let n = nb_prod_modulo_zeta thm_ty - nprod in
-        if n<0 then error "Applied theorem has not enough premisses.";
+        let n = nb_prod_modulo_zeta sigma thm_ty - nprod in
+        if n<0 then error "Applied theorem does not have enough premises.";
         let clause = make_clenv_binding_apply env sigma (Some n) (c,thm_ty) lbind in
         Clenvtac.res_pf clause ~with_evars ~flags
       with exn when catchable_exception exn ->
@@ -1719,10 +1678,10 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
       with Redelimination ->
         (* Last chance: if the head is a variable, apply may try
             second order unification *)
-        let info = Loc.add_loc info loc in
+        let info = Option.cata (fun loc -> Loc.add_loc info loc) info loc in
         let tac =
           if with_destruct then
-            descend_in_conjunctions []
+            descend_in_conjunctions Id.Set.empty
               (fun b id ->
                 Tacticals.New.tclTHEN
                   (try_main_apply b (mkVar id))
@@ -1746,14 +1705,12 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
       | PretypeError _|RefinerError _|UserError _|Failure _ ->
         Some (try_red_apply thm_ty0 (e, info))
       | _ -> None)
-    end }
+    end
   in
-    Tacticals.New.tclTHENLIST [
-      try_main_apply with_destruct c;
-      solve_remaining_apply_goals;
-      apply_clear_request clear_flag (use_clear_hyp_by_default ()) c
-    ]
-  end }
+    Tacticals.New.tclTHEN
+      (try_main_apply with_destruct c)
+      (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c)
+  end
 
 let rec apply_with_bindings_gen b e = function
   | [] -> Proofview.tclUNIT ()
@@ -1764,14 +1721,14 @@ let rec apply_with_bindings_gen b e = function
         (apply_with_bindings_gen b e cbl)
 
 let apply_with_delayed_bindings_gen b e l = 
-  let one k (loc, f) =
-    Proofview.Goal.enter { enter = begin fun gl ->
+  let one k {CAst.loc;v=f} =
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let (cb, sigma) = run_delayed env sigma f in
+      let (sigma, cb) = f env sigma in
 	Tacticals.New.tclWITHHOLES e
-          (general_apply b b e k (loc,cb)) sigma
-    end }
+          (general_apply b b e k CAst.(make ?loc cb)) sigma
+    end
   in
   let rec aux = function
     | [] -> Proofview.tclUNIT ()
@@ -1781,13 +1738,13 @@ let apply_with_delayed_bindings_gen b e l =
         (one k f) (aux cbl)
   in aux l
 
-let apply_with_bindings cb = apply_with_bindings_gen false false [None,(dloc,cb)]
+let apply_with_bindings cb = apply_with_bindings_gen false false [None,(CAst.make cb)]
 
-let eapply_with_bindings cb = apply_with_bindings_gen false true [None,(dloc,cb)]
+let eapply_with_bindings cb = apply_with_bindings_gen false true [None,(CAst.make cb)]
 
-let apply c = apply_with_bindings_gen false false [None,(dloc,(c,NoBindings))]
+let apply c = apply_with_bindings_gen false false [None,(CAst.make (c,NoBindings))]
 
-let eapply c = apply_with_bindings_gen false true [None,(dloc,(c,NoBindings))]
+let eapply c = apply_with_bindings_gen false true [None,(CAst.make (c,NoBindings))]
 
 let apply_list = function
   | c::l -> apply_with_bindings (c,ImplicitBindings l)
@@ -1811,31 +1768,44 @@ let find_matching_clause unifier clause =
     with NotExtensibleClause -> failwith "Cannot apply"
   in find clause
 
+exception UnableToApply
+
 let progress_with_clause flags innerclause clause =
   let ordered_metas = List.rev (clenv_independent clause) in
-  if List.is_empty ordered_metas then error "Statement without assumptions.";
+  if List.is_empty ordered_metas then raise UnableToApply;
   let f mv =
     try Some (find_matching_clause (clenv_fchain ~with_univs:false mv ~flags clause) innerclause)
     with Failure _ -> None
   in
   try List.find_map f ordered_metas
-  with Not_found -> error "Unable to unify."
-
-let apply_in_once_main flags innerclause env sigma (d,lbind) =
-  let thm = nf_betaiota sigma (Retyping.get_type_of env sigma d) in
+  with Not_found -> raise UnableToApply
+
+let explain_unable_to_apply_lemma ?loc env sigma thm innerclause =
+  user_err ?loc (hov 0
+    (Pp.str "Unable to apply lemma of type" ++ brk(1,1) ++
+     Pp.quote (Printer.pr_leconstr_env env sigma thm) ++ spc() ++
+     str "on hypothesis of type" ++ brk(1,1) ++
+     Pp.quote (Printer.pr_leconstr_env innerclause.env innerclause.evd (clenv_type innerclause)) ++
+     str "."))
+
+let apply_in_once_main flags innerclause env sigma (loc,d,lbind) =
+  let thm = nf_betaiota env sigma (Retyping.get_type_of env sigma d) in
   let rec aux clause =
     try progress_with_clause flags innerclause clause
     with e when CErrors.noncritical e ->
-    let e = CErrors.push e in
+    let e' = CErrors.push e in
     try aux (clenv_push_prod clause)
-    with NotExtensibleClause -> iraise e
+    with NotExtensibleClause ->
+      match e with
+      | UnableToApply -> explain_unable_to_apply_lemma ?loc env sigma thm innerclause
+      | _ -> iraise e'
   in
   aux (make_clenv_binding env sigma (d,thm) lbind)
 
 let apply_in_once sidecond_first with_delta with_destruct with_evars naming
-    id (clear_flag,(loc,(d,lbind))) tac =
+    id (clear_flag,{ CAst.loc; v= d,lbind}) tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let flags =
@@ -1844,11 +1814,11 @@ let apply_in_once sidecond_first with_delta with_destruct with_evars naming
   let innerclause = mk_clenv_from_env env sigma (Some 0) (mkVar id,t') in
   let targetid = find_name true (LocalAssum (Anonymous,t')) naming gl in
   let rec aux idstoclear with_destruct c =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     try
-      let clause = apply_in_once_main flags innerclause env sigma (c,lbind) in
+      let clause = apply_in_once_main flags innerclause env sigma (loc,c,lbind) in
       clenv_refine_in ~sidecond_first with_evars targetid id sigma clause
         (fun id ->
           Tacticals.New.tclTHENLIST [
@@ -1858,25 +1828,25 @@ let apply_in_once sidecond_first with_delta with_destruct with_evars naming
           ])
     with e when with_destruct && CErrors.noncritical e ->
       let (e, info) = CErrors.push e in
-        (descend_in_conjunctions [targetid]
+        (descend_in_conjunctions (Id.Set.singleton targetid)
            (fun b id -> aux (id::idstoclear) b (mkVar id))
            (e, info) c)
-    end }
+    end
   in
   aux [] with_destruct d
-  end }
+  end
 
 let apply_in_delayed_once sidecond_first with_delta with_destruct with_evars naming
-    id (clear_flag,(loc,f)) tac =
-  Proofview.Goal.enter { enter = begin fun gl ->
+    id (clear_flag,{CAst.loc;v=f}) tac =
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let (c, sigma) = run_delayed env sigma f in
+    let (sigma, c) = f env sigma in
     Tacticals.New.tclWITHHOLES with_evars 
       (apply_in_once sidecond_first with_delta with_destruct with_evars
-         naming id (clear_flag,(loc,c)) tac)
+         naming id (clear_flag,CAst.(make ?loc c)) tac)
       sigma
-  end }
+  end
 
 (* A useful resolution tactic which, if c:A->B, transforms |- C into
    |- B -> C and |- A
@@ -1896,70 +1866,65 @@ let apply_in_delayed_once sidecond_first with_delta with_destruct with_evars nam
 *)
 
 let cut_and_apply c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    match kind_of_term (Tacmach.New.pf_hnf_constr gl (Tacmach.New.pf_unsafe_type_of gl c)) with
-      | Prod (_,c1,c2) when not (dependent (mkRel 1) c2) ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
+    match EConstr.kind sigma (Tacmach.New.pf_hnf_constr gl (Tacmach.New.pf_unsafe_type_of gl c)) with
+      | Prod (_,c1,c2) when Vars.noccurn sigma 1 c2 ->
         let concl = Proofview.Goal.concl gl in
         let env = Tacmach.New.pf_env gl in
-        Refine.refine { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           let typ = mkProd (Anonymous, c2, concl) in
-          let Sigma (f, sigma, p) = Evarutil.new_evar env sigma typ in
-          let Sigma (x, sigma, q) = Evarutil.new_evar env sigma c1 in
-          let ans = mkApp (f, [|mkApp (c, [|x|])|]) in
-          Sigma (ans, sigma, p +> q)
-        end }
+          let (sigma, f) = Evarutil.new_evar env sigma typ in
+          let (sigma, x) = Evarutil.new_evar env sigma c1 in
+          (sigma, mkApp (f, [|mkApp (c, [|x|])|]))
+        end
       | _ -> error "lapply needs a non-dependent product."
-  end }
+  end
 
 (********************************************************************)
 (*               Exact tactics                                      *)
 (********************************************************************)
 
-(* let convert_leqkey = Profile.declare_profile "convert_leq";; *)
-(* let convert_leq = Profile.profile3 convert_leqkey convert_leq *)
+(* let convert_leqkey = CProfile.declare_profile "convert_leq";; *)
+(* let convert_leq = CProfile.profile3 convert_leqkey convert_leq *)
 
-(* let refine_no_checkkey = Profile.declare_profile "refine_no_check";; *)
-(* let refine_no_check = Profile.profile2 refine_no_checkkey refine_no_check *)
+(* let refine_no_checkkey = CProfile.declare_profile "refine_no_check";; *)
+(* let refine_no_check = CProfile.profile2 refine_no_checkkey refine_no_check *)
 
 let exact_no_check c =
-  Refine.refine ~unsafe:true { run = fun h -> Sigma.here c h }
+  Refine.refine ~typecheck:false (fun h -> (h,c))
 
 let exact_check c =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   (** We do not need to normalize the goal because we just check convertibility *)
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let concl = Proofview.Goal.concl gl in
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map sigma in
   let sigma, ct = Typing.type_of env sigma c in
-  let tac =
-      Tacticals.New.tclTHEN (convert_leq ct concl) (exact_no_check c)
-  in
-  Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (Tacticals.New.tclTHEN (convert_leq ct concl) (exact_no_check c))
+  end
 
 let cast_no_check cast c =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
-    exact_no_check (Term.mkCast (c, cast, concl))
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let concl = Proofview.Goal.concl gl in
+    exact_no_check (mkCast (c, cast, concl))
+  end
 
 let vm_cast_no_check c = cast_no_check Term.VMcast c
 let native_cast_no_check c = cast_no_check Term.NATIVEcast c
 
 let exact_proof c =
   let open Tacmach.New in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  Refine.refine { run = begin fun sigma ->
-    let sigma = Sigma.to_evar_map sigma in
+  Proofview.Goal.enter begin fun gl ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let (c, ctx) = Constrintern.interp_casted_constr (pf_env gl) sigma c (pf_concl gl) in
     let sigma = Evd.merge_universe_context sigma ctx in
-    Sigma.Unsafe.of_pair (c, sigma)
-  end }
-  end }
+    (sigma, c)
+  end
+  end
 
 let assumption =
-  let open Context.Named.Declaration in
   let rec arec gl only_eq = function
   | [] ->
     if only_eq then
@@ -1967,25 +1932,25 @@ let assumption =
       arec gl false hyps
     else Tacticals.New.tclZEROMSG (str "No such assumption.")
   | decl::rest ->
-    let t = get_type decl in
+    let t = NamedDecl.get_type decl in
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let (sigma, is_same_type) =
-      if only_eq then (sigma, Constr.equal t concl)
+      if only_eq then (sigma, EConstr.eq_constr sigma t concl)
       else
         let env = Proofview.Goal.env gl in
         infer_conv env sigma t concl
     in
     if is_same_type then
       (Proofview.Unsafe.tclEVARS sigma) <*>
-	exact_no_check (mkVar (get_id decl))
+	exact_no_check (mkVar (NamedDecl.get_id decl))
     else arec gl only_eq rest
   in
-  let assumption_tac = { enter = begin fun gl ->
+  let assumption_tac gl =
     let hyps = Proofview.Goal.hyps gl in
     arec gl true hyps
-  end } in
-  Proofview.Goal.nf_enter assumption_tac
+  in
+  Proofview.Goal.enter assumption_tac
 
 (*****************************************************************)
 (*          Modification of a local context                      *)
@@ -1993,8 +1958,8 @@ let assumption =
 
 let on_the_bodies = function
 | [] -> assert false
-| [id] -> str " depends on the body of " ++ pr_id id
-| l -> str " depends on the bodies of " ++ pr_sequence pr_id l
+| [id] -> str " depends on the body of " ++ Id.print id
+| l -> str " depends on the bodies of " ++ pr_sequence Id.print l
 
 exception DependsOnBody of Id.t option
 
@@ -2008,7 +1973,7 @@ let check_is_type env sigma ty =
 
 let check_decl env sigma decl =
   let open Context.Named.Declaration in
-  let ty = get_type decl in
+  let ty = NamedDecl.get_type decl in
   let evdref = ref sigma in
   try
     let _ = Typing.e_sort_of env evdref ty in
@@ -2018,20 +1983,20 @@ let check_decl env sigma decl =
     in
     !evdref
   with e when CErrors.noncritical e ->
-    let id = get_id decl in
+    let id = NamedDecl.get_id decl in
     raise (DependsOnBody (Some id))
 
 let clear_body ids =
   let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+    let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let ctx = named_context env in
     let map = function
     | LocalAssum (id,t) as decl ->
       let () = if List.mem_f Id.equal id ids then
-        errorlabstrm "" (str "Hypothesis " ++ pr_id id ++ str " is not a local definition")
+        user_err  (str "Hypothesis " ++ Id.print id ++ str " is not a local definition")
       in
       decl
     | LocalDef (id,_,t) as decl ->
@@ -2046,16 +2011,16 @@ let clear_body ids =
           (** Do no recheck hypotheses that do not depend *)
           let sigma =
             if not seen then sigma
-            else if List.exists (fun id -> occur_var_in_decl env id decl) ids then
+            else if List.exists (fun id -> occur_var_in_decl env sigma id decl) ids then
               check_decl env sigma decl
             else sigma
           in
-          let seen = seen || List.mem_f Id.equal (get_id decl) ids in
+          let seen = seen || List.mem_f Id.equal (NamedDecl.get_id decl) ids in
           (push_named decl env, sigma, seen)
         in
         let (env, sigma, _) = List.fold_left check (base_env, sigma, false) (List.rev ctx) in
         let sigma =
-          if List.exists (fun id -> occur_var env id concl) ids then
+          if List.exists (fun id -> occur_var env sigma id concl) ids then
             check_is_type env sigma concl
           else sigma
         in
@@ -2063,18 +2028,18 @@ let clear_body ids =
       with DependsOnBody where ->
         let msg = match where with
         | None -> str "Conclusion" ++ on_the_bodies ids
-        | Some id -> str "Hypothesis " ++ pr_id id ++ on_the_bodies ids
+        | Some id -> str "Hypothesis " ++ Id.print id ++ on_the_bodies ids
         in
         Tacticals.New.tclZEROMSG msg
     in
     check <*>
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true concl
-    end }
-  end }
+    end
+  end
 
 let clear_wildcards ids =
-  Tacticals.New.tclMAP (fun (loc, id) -> clear [id]) ids
+  Tacticals.New.tclMAP (fun {CAst.loc;v=id} -> clear [id]) ids
 
 (*   Takes a list of booleans, and introduces all the variables
  *  quantified in the goal which are associated with a value
@@ -2090,22 +2055,23 @@ let rec intros_clearing = function
 (* Keeping only a few hypotheses *)
 
 let keep hyps =
-  let open Context.Named.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Proofview.tclENV >>= fun env ->
   let ccl = Proofview.Goal.concl gl in
+  let sigma = Tacmach.New.project gl in
   let cl,_ =
     fold_named_context_reverse (fun (clear,keep) decl ->
-      let hyp = get_id decl in
+      let decl = map_named_decl EConstr.of_constr decl in
+      let hyp = NamedDecl.get_id decl in
       if Id.List.mem hyp hyps
-        || List.exists (occur_var_in_decl env hyp) keep
-	|| occur_var env hyp ccl
+        || List.exists (occur_var_in_decl env sigma hyp) keep
+	|| occur_var env sigma hyp ccl
       then (clear,decl::keep)
       else (hyp::clear,keep))
       ~init:([],[]) (Proofview.Goal.env gl)
   in
   clear cl
-  end }
+  end
 
 (*********************************)
 (*  Basic generalization tactics *)
@@ -2115,17 +2081,17 @@ let keep hyps =
    and [a1..an:A1..An(a1..an-1)] such that the goal is [G(a1..an)],
    this generalizes [hyps |- goal] into [hyps |- T] *)
 
-let apply_type newcl args =
-  Proofview.Goal.enter { enter = begin fun gl ->
+let apply_type ~typecheck newcl args =
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let store = Proofview.Goal.extra gl in
-    Refine.refine { run = begin fun sigma ->
-      let newcl = nf_betaiota (Sigma.to_evar_map sigma) newcl (* As in former Logic.refine *) in
-      let Sigma (ev, sigma, p) =
+    Refine.refine ~typecheck begin fun sigma ->
+      let newcl = nf_betaiota env sigma newcl (* As in former Logic.refine *) in
+      let (sigma, ev) =
         Evarutil.new_evar env sigma ~principal:true ~store newcl in
-      Sigma (applist (ev, args), sigma, p)
-    end }
-  end }
+      (sigma, applist (ev, args))
+    end
+  end
 
 (* Given a context [hyps] with domain [x1..xn], possibly with let-ins,
    and well-typed in the current goal, [bring_hyps hyps] generalizes
@@ -2134,25 +2100,24 @@ let apply_type newcl args =
 let bring_hyps hyps =
   if List.is_empty hyps then Tacticals.New.tclIDTAC
   else
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let env = Proofview.Goal.env gl in
       let store = Proofview.Goal.extra gl in
-      let concl = Tacmach.New.pf_nf_concl gl in
+      let concl = Tacmach.New.pf_concl gl in
       let newcl = List.fold_right mkNamedProd_or_LetIn hyps concl in
-      let args = Array.of_list (Context.Named.to_instance hyps) in
-      Refine.refine { run = begin fun sigma ->
-        let Sigma (ev, sigma, p) =
+      let args = Array.of_list (Context.Named.to_instance mkVar hyps) in
+      Refine.refine ~typecheck:false begin fun sigma ->
+        let (sigma, ev) =
           Evarutil.new_evar env sigma ~principal:true ~store newcl in
-        Sigma (mkApp (ev, args), sigma, p)
-      end }
-    end }
+        (sigma, mkApp (ev, args))
+      end
+    end
 
 let revert hyps = 
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+  Proofview.Goal.enter begin fun gl ->
     let ctx = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) hyps in
       (bring_hyps ctx) <*> (clear hyps)
-  end }
+  end
 
 (************************)
 (* Introduction tactics *)
@@ -2162,37 +2127,34 @@ let check_number_of_constructors expctdnumopt i nconstr =
   if Int.equal i 0 then error "The constructors are numbered starting from 1.";
   begin match expctdnumopt with
     | Some n when not (Int.equal n nconstr) ->
-	errorlabstrm "Tactics.check_number_of_constructors"
+	user_err ~hdr:"Tactics.check_number_of_constructors"
           (str "Not an inductive goal with " ++ int n ++ str (String.plural n " constructor") ++ str ".")
     | _ -> ()
   end;
   if i > nconstr then error "Not enough constructors."
 
-let constructor_tac with_evars expctdnumopt i lbind =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+let constructor_core with_evars cstr lbind =
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let cl = Tacmach.New.pf_nf_concl gl in
-    let reduce_to_quantified_ind =
-      Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl
-    in
-    let (mind,redcl) = reduce_to_quantified_ind cl in
-    let nconstr =
-      Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
-      check_number_of_constructors expctdnumopt i nconstr;
-
-      let Sigma (cons, sigma, p) = Sigma.fresh_constructor_instance
-	(Proofview.Goal.env gl) sigma (fst mind, i) in
-      let cons = mkConstructU cons in
-	
-      let apply_tac = general_apply true false with_evars None (dloc,(cons,lbind)) in
-      let tac =
-	(Tacticals.New.tclTHENLIST
-           [
-	    convert_concl_no_check redcl DEFAULTcast;
-	    intros; apply_tac])
-      in
-      Sigma (tac, sigma, p)
-  end }
+    let env = Proofview.Goal.env gl in
+    let (sigma, (cons, u)) = Evd.fresh_constructor_instance env sigma cstr in
+    let cons = mkConstructU (cons, EInstance.make u) in
+    let apply_tac = general_apply true false with_evars None (CAst.make (cons,lbind)) in
+    Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) apply_tac
+  end
+
+let constructor_tac with_evars expctdnumopt i lbind =
+  Proofview.Goal.enter begin fun gl ->
+    let cl = Tacmach.New.pf_concl gl in
+    let ((ind,_),redcl) = Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl cl in
+    let nconstr = Array.length (snd (Global.lookup_inductive ind)).mind_consnames in
+    check_number_of_constructors expctdnumopt i nconstr;
+    Tacticals.New.tclTHENLIST [
+      convert_concl_no_check redcl DEFAULTcast;
+      intros;
+      constructor_core with_evars (ind, i) lbind
+    ]
+  end
 
 let one_constructor i lbind = constructor_tac false None i lbind
 
@@ -2201,25 +2163,27 @@ let one_constructor i lbind = constructor_tac false None i lbind
    Should be generalize in Constructor (Fun c : I -> tactic)
  *)
 
-let rec tclANY tac = function
-| [] -> Tacticals.New.tclZEROMSG (str "No applicable tactic.")
-| arg :: l ->
-  Tacticals.New.tclORD (tac arg) (fun () -> tclANY tac l)
-
 let any_constructor with_evars tacopt =
-  let t = match tacopt with None -> Proofview.tclUNIT () | Some t -> t in
-  let tac i = Tacticals.New.tclTHEN (constructor_tac with_evars None i NoBindings) t in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let cl = Tacmach.New.pf_nf_concl gl in
-    let reduce_to_quantified_ind =
-      Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl
-    in
-    let mind = fst (reduce_to_quantified_ind cl) in
+  let one_constr =
+    let tac cstr = constructor_core with_evars cstr NoBindings in
+    match tacopt with
+    | None -> tac
+    | Some t -> fun cstr -> Tacticals.New.tclTHEN (tac cstr) t in
+  let rec any_constr ind n i () =
+    if Int.equal i n then one_constr (ind,i)
+    else Tacticals.New.tclORD (one_constr (ind,i)) (any_constr ind n (i + 1)) in
+  Proofview.Goal.enter begin fun gl ->
+    let cl = Tacmach.New.pf_concl gl in
+    let (ind,_),redcl = Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl cl in
     let nconstr =
-      Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
+      Array.length (snd (Global.lookup_inductive ind)).mind_consnames in
     if Int.equal nconstr 0 then error "The type has no constructors.";
-    tclANY tac (List.interval 1 nconstr)
- end }
+    Tacticals.New.tclTHENLIST [
+      convert_concl_no_check redcl DEFAULTcast;
+      intros;
+      any_constr ind nconstr 1 ()
+    ]
+ end
 
 let left_with_bindings  with_evars = constructor_tac with_evars (Some 2) 1
 let right_with_bindings with_evars = constructor_tac with_evars (Some 2) 2
@@ -2251,7 +2215,7 @@ let error_unexpected_extra_pattern loc bound pat =
   | IntroNaming (IntroIdentifier _) ->
       "name", (String.plural nb " introduction pattern"), "no"
   | _ -> "introduction pattern", "", "none" in
-  user_err_loc (loc,"",str "Unexpected " ++ str s1 ++ str " (" ++
+  user_err ?loc  (str "Unexpected " ++ str s1 ++ str " (" ++
     (if Int.equal nb 0 then (str s3 ++ str s2) else
       (str "at most " ++ int nb ++ str s2)) ++ spc () ++
        str (if Int.equal nb 1 then "was" else "were") ++
@@ -2269,34 +2233,34 @@ let my_find_eq_data_decompose gl t =
       -> None
   | Constr_matching.PatternMatchingFailure -> None
 
-let intro_decomp_eq loc l thin tac id =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+let intro_decomp_eq ?loc l thin tac id =
+  Proofview.Goal.enter begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
   let _,t = Tacmach.New.pf_reduce_to_quantified_ind gl t in
   match my_find_eq_data_decompose gl t with
   | Some (eq,u,eq_args) ->
     !intro_decomp_eq_function
-    (fun n -> tac ((dloc,id)::thin) (Some (true,n)) l)
+    (fun n -> tac ((CAst.make id)::thin) (Some (true,n)) l)
     (eq,t,eq_args) (c, t)
   | None ->
     Tacticals.New.tclZEROMSG (str "Not a primitive equality here.")
-  end }
+  end
 
-let intro_or_and_pattern loc with_evars bracketed ll thin tac id =
-  Proofview.Goal.enter { enter = begin fun gl ->
+let intro_or_and_pattern ?loc with_evars bracketed ll thin tac id =
+  Proofview.Goal.enter begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
   let (ind,t) = Tacmach.New.pf_reduce_to_quantified_ind gl t in
   let branchsigns = compute_constructor_signatures false ind in
   let nv_with_let = Array.map List.length branchsigns in
   let ll = fix_empty_or_and_pattern (Array.length branchsigns) ll in
-  let ll = get_and_check_or_and_pattern loc ll branchsigns in
+  let ll = get_and_check_or_and_pattern ?loc ll branchsigns in
   Tacticals.New.tclTHENLASTn
     (Tacticals.New.tclTHEN (simplest_ecase c) (clear [id]))
     (Array.map2 (fun n l -> tac thin (Some (bracketed,n)) l)
        nv_with_let ll)
-  end }
+  end
 
 let rewrite_hyp_then assert_style with_evars thin l2r id tac =
   let rew_on l2r =
@@ -2305,27 +2269,28 @@ let rewrite_hyp_then assert_style with_evars thin l2r id tac =
     Hook.get forward_subst_one true x (id,rhs,l2r) in
   let clear_var_and_eq id' = clear [id';id] in
   let early_clear id' thin =
-    List.filter (fun (_,id) -> not (Id.equal id id')) thin in
-  Proofview.Goal.enter { enter = begin fun gl ->
+    List.filter (fun {CAst.v=id} -> not (Id.equal id id')) thin in
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
     let whd_all = Tacmach.New.pf_apply whd_all gl in
     let t = whd_all (type_of (mkVar id)) in
-    let eqtac, thin = match match_with_equality_type t with
+    let eqtac, thin = match match_with_equality_type sigma t with
     | Some (hdcncl,[_;lhs;rhs]) ->
-        if l2r && isVar lhs && not (occur_var env (destVar lhs) rhs) then
-          let id' = destVar lhs in
+        if l2r && isVar sigma lhs && not (occur_var env sigma (destVar sigma lhs) rhs) then
+          let id' = destVar sigma lhs in
           subst_on l2r id' rhs, early_clear id' thin
-        else if not l2r && isVar rhs && not (occur_var env (destVar rhs) lhs) then
-          let id' = destVar rhs in
+        else if not l2r && isVar sigma rhs && not (occur_var env sigma (destVar sigma rhs) lhs) then
+          let id' = destVar sigma rhs in
           subst_on l2r id' lhs, early_clear id' thin
         else
           Tacticals.New.tclTHEN (rew_on l2r onConcl) (clear [id]),
           thin
     | Some (hdcncl,[c]) ->
         let l2r = not l2r in (* equality of the form eq_true *)
-        if isVar c then
-          let id' = destVar c in
+        if isVar sigma c then
+          let id' = destVar sigma c in
           Tacticals.New.tclTHEN (rew_on l2r allHypsAndConcl) 
 	    (clear_var_and_eq id'),
           early_clear id' thin
@@ -2337,39 +2302,63 @@ let rewrite_hyp_then assert_style with_evars thin l2r id tac =
         thin in
     (* Skip the side conditions of the rewriting step *)
     Tacticals.New.tclTHENFIRST eqtac (tac thin)
-  end }
+  end 
 
-let prepare_naming loc = function
-  | IntroIdentifier id -> NamingMustBe (loc,id)
-  | IntroAnonymous -> NamingAvoid []
-  | IntroFresh id -> NamingBasedOn (id,[])
+let prepare_naming ?loc = function
+  | IntroIdentifier id -> NamingMustBe (CAst.make ?loc id)
+  | IntroAnonymous -> NamingAvoid Id.Set.empty
+  | IntroFresh id -> NamingBasedOn (id, Id.Set.empty)
 
-let rec explicit_intro_names = function
-| (_, IntroForthcoming _) :: l -> explicit_intro_names l
-| (_, IntroNaming (IntroIdentifier id)) :: l -> id :: explicit_intro_names l
-| (_, IntroAction (IntroOrAndPattern l)) :: l' ->
+let rec explicit_intro_names = let open CAst in function
+| {v=IntroForthcoming _} :: l -> explicit_intro_names l
+| {v=IntroNaming (IntroIdentifier id)} :: l -> Id.Set.add id (explicit_intro_names l)
+| {v=IntroAction (IntroOrAndPattern l)} :: l' ->
     let ll = match l with IntroAndPattern l -> [l] | IntroOrPattern ll -> ll in
-    List.flatten (List.map (fun l -> explicit_intro_names (l@l')) ll)
-| (_, IntroAction (IntroInjection l)) :: l' ->
+    let fold accu l = Id.Set.union accu (explicit_intro_names (l@l')) in
+    List.fold_left fold Id.Set.empty ll
+| {v=IntroAction (IntroInjection l)} :: l' ->
     explicit_intro_names (l@l')
-| (_, IntroAction (IntroApplyOn (c,pat))) :: l' ->
+| {v=IntroAction (IntroApplyOn (c,pat))} :: l' ->
     explicit_intro_names (pat::l')
-| (_, (IntroNaming (IntroAnonymous | IntroFresh _)
-     | IntroAction (IntroWildcard | IntroRewrite _))) :: l ->
+| {v=(IntroNaming (IntroAnonymous | IntroFresh _)
+     | IntroAction (IntroWildcard | IntroRewrite _))} :: l ->
      explicit_intro_names l
-| [] -> []
+| [] -> Id.Set.empty
+
+let rec check_name_unicity env ok seen = let open CAst in function
+| {v=IntroForthcoming _} :: l -> check_name_unicity env ok seen l
+| {loc;v=IntroNaming (IntroIdentifier id)} :: l ->
+   (try
+      ignore (if List.mem_f Id.equal id ok then raise Not_found else lookup_named id env);
+      user_err ?loc (Id.print id ++ str" is already used.")
+   with Not_found ->
+     if List.mem_f Id.equal id seen then
+       user_err ?loc (Id.print id ++ str" is used twice.")
+     else
+       check_name_unicity env ok (id::seen) l)
+| {v=IntroAction (IntroOrAndPattern l)} :: l' ->
+    let ll = match l with IntroAndPattern l -> [l] | IntroOrPattern ll -> ll in
+    List.iter (fun l -> check_name_unicity env ok seen (l@l')) ll
+| {v=IntroAction (IntroInjection l)} :: l' ->
+    check_name_unicity env ok seen (l@l')
+| {v=IntroAction (IntroApplyOn (c,pat))} :: l' ->
+    check_name_unicity env ok seen (pat::l')
+| {v=(IntroNaming (IntroAnonymous | IntroFresh _)
+     | IntroAction (IntroWildcard | IntroRewrite _))} :: l ->
+     check_name_unicity env ok seen l
+| [] -> ()
 
 let wild_id = Id.of_string "_tmp"
 
 let rec list_mem_assoc_right id = function
   | [] -> false
-  | (x,id')::l -> Id.equal id id' || list_mem_assoc_right id l
+  | {CAst.v=id'}::l -> Id.equal id id' || list_mem_assoc_right id l
 
 let check_thin_clash_then id thin avoid tac =
   if list_mem_assoc_right id thin then
     let newid = next_ident_away (add_suffix id "'") avoid in
     let thin =
-      List.map (on_snd (fun id' -> if Id.equal id id' then newid else id')) thin in
+      List.map CAst.(map (fun id' -> if Id.equal id id' then newid else id')) thin in
     Tacticals.New.tclTHEN (rename_hyp [id,newid]) (tac thin)
   else
     tac thin
@@ -2381,8 +2370,8 @@ let make_tmp_naming avoid l = function
      IntroAnonymous, but at the cost of a "renaming"; Note that in the
      case of IntroFresh, we should use check_thin_clash_then anyway to
      prevent the case of an IntroFresh precisely using the wild_id *)
-  | IntroWildcard -> NamingBasedOn (wild_id,avoid@explicit_intro_names l)
-  | pat -> NamingAvoid(avoid@explicit_intro_names ((dloc,IntroAction pat)::l))
+  | IntroWildcard -> NamingBasedOn (wild_id, Id.Set.union avoid (explicit_intro_names l))
+  | pat -> NamingAvoid(Id.Set.union avoid (explicit_intro_names ((CAst.make @@ IntroAction pat)::l)))
 
 let fit_bound n = function
   | None -> true
@@ -2394,7 +2383,7 @@ let exceed_bound n = function
 
   (* We delay thinning until the completion of the whole intros tactic
      to ensure that dependent hypotheses are cleared in the right
-     dependency order (see bug #1000); we use fresh names, not used in
+     dependency order (see BZ#1000); we use fresh names, not used in
      the tactic, for the hyps to clear *)
   (* In [intro_patterns_core b avoid ids thin destopt bound n tac patl]:
      [b]: compatibility flag, if false at toplevel, do not complete incomplete
@@ -2418,19 +2407,19 @@ let rec intro_patterns_core with_evars b avoid ids thin destopt bound n tac =
   | [] ->
       (* Behave as IntroAnonymous *)
       intro_patterns_core with_evars b avoid ids thin destopt bound n tac
-        [dloc,IntroNaming IntroAnonymous]
-  | (loc,pat) :: l ->
+        [CAst.make @@ IntroNaming IntroAnonymous]
+  | {CAst.loc;v=pat} :: l ->
   if exceed_bound n bound then error_unexpected_extra_pattern loc bound pat else
   match pat with
   | IntroForthcoming onlydeps ->
-      intro_forthcoming_then_gen (NamingAvoid (avoid@explicit_intro_names l))
+      intro_forthcoming_then_gen (NamingAvoid (Id.Set.union avoid (explicit_intro_names l)))
 	  destopt onlydeps n bound
         (fun ids -> intro_patterns_core with_evars b avoid ids thin destopt bound
           (n+List.length ids) tac l)
   | IntroAction pat ->
       intro_then_gen (make_tmp_naming avoid l pat)
 	destopt true false
-        (intro_pattern_action loc with_evars (b || not (List.is_empty l)) false
+        (intro_pattern_action ?loc with_evars (b || not (List.is_empty l)) false
           pat thin destopt
           (fun thin bound' -> intro_patterns_core with_evars b avoid ids thin destopt bound' 0
             (fun ids thin ->
@@ -2443,67 +2432,73 @@ and intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound n tac
   match pat with
   | IntroIdentifier id ->
       check_thin_clash_then id thin avoid (fun thin ->
-        intro_then_gen (NamingMustBe (loc,id)) destopt true false
+        intro_then_gen (NamingMustBe CAst.(make ?loc id)) destopt true false
           (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l))
   | IntroAnonymous ->
-      intro_then_gen (NamingAvoid (avoid@explicit_intro_names l))
+      intro_then_gen (NamingAvoid (Id.Set.union avoid (explicit_intro_names l)))
 	destopt true false
         (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
   | IntroFresh id ->
       (* todo: avoid thinned names to interfere with generation of fresh name *)
-      intro_then_gen (NamingBasedOn (id, avoid@explicit_intro_names l))
+      intro_then_gen (NamingBasedOn (id, Id.Set.union avoid (explicit_intro_names l)))
 	destopt true false
         (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
 
-and intro_pattern_action loc with_evars b style pat thin destopt tac id =
+and intro_pattern_action ?loc with_evars b style pat thin destopt tac id =
   match pat with
   | IntroWildcard ->
-      tac ((loc,id)::thin) None []
+      tac (CAst.(make ?loc id)::thin) None []
   | IntroOrAndPattern ll ->
-      intro_or_and_pattern loc with_evars b ll thin tac id
+      intro_or_and_pattern ?loc with_evars b ll thin tac id
   | IntroInjection l' ->
-      intro_decomp_eq loc l' thin tac id
+      intro_decomp_eq ?loc l' thin tac id
   | IntroRewrite l2r ->
       rewrite_hyp_then style with_evars thin l2r id (fun thin -> tac thin None [])
-  | IntroApplyOn (f,(loc,pat)) ->
+  | IntroApplyOn ({CAst.loc=loc';v=f},{CAst.loc;v=pat}) ->
       let naming,tac_ipat =
-        prepare_intros_loc loc with_evars (IntroIdentifier id) destopt pat in
+        prepare_intros ?loc with_evars (IntroIdentifier id) destopt pat in
       let doclear =
-        if naming = NamingMustBe (loc,id) then
+        if naming = NamingMustBe (CAst.make ?loc id) then
           Proofview.tclUNIT () (* apply_in_once do a replacement *)
         else
           clear [id] in
-      let f = { delayed = fun env sigma ->
-        let Sigma (c, sigma, p) = f.delayed env sigma in
-        Sigma ((c, NoBindings), sigma, p)
-      } in
-      apply_in_delayed_once false true true with_evars naming id (None,(loc,f))
+      let f env sigma = let (sigma, c) = f env sigma in (sigma,(c, NoBindings))
+      in
+      apply_in_delayed_once false true true with_evars naming id (None,CAst.make ?loc:loc' f)
         (fun id -> Tacticals.New.tclTHENLIST [doclear; tac_ipat id; tac thin None []])
 
-and prepare_intros_loc loc with_evars dft destopt = function
+and prepare_intros ?loc with_evars dft destopt = function
   | IntroNaming ipat ->
-      prepare_naming loc ipat,
+      prepare_naming ?loc ipat,
       (fun id -> move_hyp id destopt)
   | IntroAction ipat ->
-      prepare_naming loc dft,
+      prepare_naming ?loc dft,
       (let tac thin bound =
-        intro_patterns_core with_evars true [] [] thin destopt bound 0
+        intro_patterns_core with_evars true Id.Set.empty [] thin destopt bound 0
           (fun _ l -> clear_wildcards l) in
       fun id ->
-        intro_pattern_action loc with_evars true true ipat [] destopt tac id)
-  | IntroForthcoming _ -> user_err_loc
-      (loc,"",str "Introduction pattern for one hypothesis expected.")
+        intro_pattern_action ?loc with_evars true true ipat [] destopt tac id)
+  | IntroForthcoming _ -> user_err ?loc 
+      (str "Introduction pattern for one hypothesis expected.")
+
+let intro_patterns_head_core with_evars b destopt bound pat =
+  Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    check_name_unicity env [] [] pat;
+    intro_patterns_core with_evars b Id.Set.empty [] [] destopt
+      bound 0 (fun _ l -> clear_wildcards l) pat
+  end
 
 let intro_patterns_bound_to with_evars n destopt =
-  intro_patterns_core with_evars true [] [] [] destopt
-    (Some (true,n)) 0 (fun _ l -> clear_wildcards l)
+  intro_patterns_head_core with_evars true destopt
+    (Some (true,n))
 
 let intro_patterns_to with_evars destopt =
-  intro_patterns_core with_evars (use_bracketing_last_or_and_intro_pattern ())
-    [] [] [] destopt None 0 (fun _ l -> clear_wildcards l)
+  intro_patterns_head_core with_evars (use_bracketing_last_or_and_intro_pattern ())
+    destopt None
 
 let intro_pattern_to with_evars destopt pat =
-  intro_patterns_to with_evars destopt [dloc,pat]
+  intro_patterns_to with_evars destopt [CAst.make pat]
 
 let intro_patterns with_evars = intro_patterns_to with_evars MoveLast
 
@@ -2516,20 +2511,20 @@ let intros_patterns with_evars = function
 (*   Forward reasoning    *)
 (**************************)
 
-let prepare_intros with_evars dft destopt = function
-  | None -> prepare_naming dloc dft, (fun _id -> Proofview.tclUNIT ())
-  | Some (loc,ipat) -> prepare_intros_loc loc with_evars dft destopt ipat
+let prepare_intros_opt with_evars dft destopt = function
+  | None -> prepare_naming dft, (fun _id -> Proofview.tclUNIT ())
+  | Some {CAst.loc;v=ipat} -> prepare_intros ?loc with_evars dft destopt ipat
 
 let ipat_of_name = function
   | Anonymous -> None
-  | Name id -> Some (dloc, IntroNaming (IntroIdentifier id))
+  | Name id -> Some (CAst.make @@ IntroNaming (IntroIdentifier id))
 
-let head_ident c =
-   let c = fst (decompose_app ((strip_lam_assum c))) in
-   if isVar c then Some (destVar c) else None
+let head_ident sigma c =
+   let c = fst (decompose_app sigma (snd (decompose_lam_assum sigma c))) in
+   if isVar sigma c then Some (destVar sigma c) else None
 
 let assert_as first hd ipat t =
-  let naming,tac = prepare_intros false IntroAnonymous MoveLast ipat in
+  let naming,tac = prepare_intros_opt false IntroAnonymous MoveLast ipat in
   let repl = do_replace hd naming in
   let tac = if repl then (fun id -> Proofview.tclUNIT ()) else tac in
   if first then assert_before_then_gen repl naming t tac
@@ -2542,19 +2537,22 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
   let tac (naming,lemma) tac id =
     apply_in_delayed_once sidecond_first with_delta with_destruct with_evars
       naming id lemma tac in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let destopt =
     if with_evars then MoveLast (* evars would depend on the whole context *)
-    else get_previous_hyp_position id gl in
+    else (
+      let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+      get_previous_hyp_position env sigma id (Proofview.Goal.hyps gl)
+    ) in
   let naming,ipat_tac =
-    prepare_intros with_evars (IntroIdentifier id) destopt ipat in
+    prepare_intros_opt with_evars (IntroIdentifier id) destopt ipat in
   let lemmas_target, last_lemma_target =
     let last,first = List.sep_last lemmas in
-    List.map (fun lem -> (NamingMustBe (dloc,id),lem)) first, (naming,last)
+    List.map (fun lem -> (NamingMustBe (CAst.make id),lem)) first, (naming,last)
   in
   (* We chain apply_in_once, ending with an intro pattern *)
   List.fold_right tac lemmas_target (tac last_lemma_target ipat_tac) id
-  end }
+  end
 
 (*
   if sidecond_first then
@@ -2565,7 +2563,7 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
 *)
 
 let apply_in simple with_evars id lemmas ipat =
-  let lemmas = List.map (fun (k,(loc,l)) -> k, (loc, { delayed = fun _ sigma -> Sigma.here l sigma })) lemmas in
+  let lemmas = List.map (fun (k,{CAst.loc;v=l}) -> k, CAst.make ?loc (fun _ sigma -> (sigma,l))) lemmas in
   general_apply_in false simple simple with_evars id lemmas ipat
 
 let apply_delayed_in simple with_evars id lemmas ipat =
@@ -2589,61 +2587,69 @@ let decode_hyp = function
 *)
 
 let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let Sigma (t, sigma, p) = match ty with
-    | Some t -> Sigma.here t sigma
+    let (sigma, t) = match ty with
+    | Some t -> (sigma, t)
     | None ->
       let t = typ_of env sigma c in
-      let sigma, c = Evarsolve.refresh_universes ~onlyalg:true (Some false) env (Sigma.to_evar_map sigma) t in
-      Sigma.Unsafe.of_pair (c, sigma)
+      Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma t
     in
-    let Sigma ((newcl, eq_tac), sigma, q) = match with_eq with
-      | Some (lr,(loc,ido)) ->
+    let (sigma, (newcl, eq_tac)) = match with_eq with
+      | Some (lr,{CAst.loc;v=ido}) ->
           let heq = match ido with
-            | IntroAnonymous -> new_fresh_id [id] (add_prefix "Heq" id) gl
-            | IntroFresh heq_base -> new_fresh_id [id] heq_base gl
+            | IntroAnonymous -> new_fresh_id (Id.Set.singleton id) (add_prefix "Heq" id) gl
+            | IntroFresh heq_base -> new_fresh_id (Id.Set.singleton id) heq_base gl
             | IntroIdentifier id -> id in
           let eqdata = build_coq_eq_data () in
           let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
-          let Sigma (eq, sigma, p) = Sigma.fresh_global env sigma eqdata.eq in
-          let Sigma (refl, sigma, q) = Sigma.fresh_global env sigma eqdata.refl in
+          let (sigma, eq) = Evd.fresh_global env sigma eqdata.eq in
+          let eq = EConstr.of_constr eq in
+          let (sigma, refl) = Evd.fresh_global env sigma eqdata.refl in
+          let refl = EConstr.of_constr refl in
           let eq = applist (eq,args) in
           let refl = applist (refl, [t;mkVar id]) in
 	  let term = mkNamedLetIn id c t (mkLetIn (Name heq, refl, eq, ccl)) in
-	  let sigma = Sigma.to_evar_map sigma in
 	  let sigma, _ = Typing.type_of env sigma term in
           let ans = term,
-            Tacticals.New.tclTHEN
-	      (intro_gen (NamingMustBe (loc,heq)) (decode_hyp lastlhyp) true false)
-	      (clear_body [heq;id])
+            Tacticals.New.tclTHENLIST
+	      [
+               intro_gen (NamingMustBe CAst.(make ?loc heq)) (decode_hyp lastlhyp) true false;
+	      clear_body [heq;id]]
           in
-          Sigma.Unsafe.of_pair (ans, sigma)
+          (sigma, ans)
       | None ->
-          Sigma.here (mkNamedLetIn id c t ccl, Proofview.tclUNIT ()) sigma
+          (sigma, (mkNamedLetIn id c t ccl, Proofview.tclUNIT ()))
     in
-    let tac =
       Tacticals.New.tclTHENLIST
-      [ convert_concl_no_check newcl DEFAULTcast;
-        intro_gen (NamingMustBe (dloc,id)) (decode_hyp lastlhyp) true false;
+      [ Proofview.Unsafe.tclEVARS sigma;
+        convert_concl_no_check newcl DEFAULTcast;
+        intro_gen (NamingMustBe (CAst.make id)) (decode_hyp lastlhyp) true false;
         Tacticals.New.tclMAP convert_hyp_no_check depdecls;
         eq_tac ]
-    in
-    Sigma (tac, sigma, p +> q)
-  end }
+  end
 
 let insert_before decls lasthyp env =
-  let open Context.Named.Declaration in
   match lasthyp with
   | None -> push_named_context decls env
   | Some id ->
   Environ.fold_named_context
     (fun _ d env ->
-      let env = if Id.equal id (get_id d) then push_named_context decls env else env in
+      let d = map_named_decl EConstr.of_constr d in
+      let env = if Id.equal id (NamedDecl.get_id d) then push_named_context decls env else env in
       push_named d env)
     ~init:(reset_context env) env
 
+let mk_eq_name env id {CAst.loc;v=ido} =
+  match ido with
+  | IntroAnonymous -> fresh_id_in_env (Id.Set.singleton id) (add_prefix "Heq" id) env
+  | IntroFresh heq_base -> fresh_id_in_env (Id.Set.singleton id) heq_base env
+  | IntroIdentifier id ->
+    if List.mem id (ids_of_named_context (named_context env)) then
+      user_err ?loc  (Id.print id ++ str" is already used.");
+    id
+
 (* unsafe *)
 
 let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
@@ -2653,30 +2659,25 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
 	     else LocalAssum (id,t)
   in
   match with_eq with
-  | Some (lr,(loc,ido)) ->
-      let heq = match ido with
-      | IntroAnonymous -> fresh_id_in_env [id] (add_prefix "Heq" id) env
-      | IntroFresh heq_base -> fresh_id_in_env [id] heq_base env
-      | IntroIdentifier id ->
-          if List.mem id (ids_of_named_context (named_context env)) then
-            user_err_loc (loc,"",pr_id id ++ str" is already used.");
-          id in
+  | Some (lr,heq) ->
       let eqdata = build_coq_eq_data () in
       let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
-      let Sigma (eq, sigma, p) = Sigma.fresh_global env sigma eqdata.eq in
-      let Sigma (refl, sigma, q) = Sigma.fresh_global env sigma eqdata.refl in
+      let (sigma, eq) = Evd.fresh_global env sigma eqdata.eq in
+      let eq = EConstr.of_constr eq in
+      let (sigma, refl) = Evd.fresh_global env sigma eqdata.refl in
+      let refl = EConstr.of_constr refl in
       let eq = applist (eq,args) in
       let refl = applist (refl, [t;mkVar id]) in
       let newenv = insert_before [LocalAssum (heq,eq); decl] lastlhyp env in
-      let Sigma (x, sigma, r) = new_evar newenv sigma ~principal:true ~store ccl in
-      Sigma (mkNamedLetIn id c t (mkNamedLetIn heq refl eq x), sigma, p +> q +> r)
+      let (sigma, x) = new_evar newenv sigma ~principal:true ~store ccl in
+      (sigma, mkNamedLetIn id c t (mkNamedLetIn heq refl eq x))
   | None ->
       let newenv = insert_before [decl] lastlhyp env in
-      let Sigma (x, sigma, p) = new_evar newenv sigma ~principal:true ~store ccl in
-      Sigma (mkNamedLetIn id c t x, sigma, p)
+      let (sigma, x) = new_evar newenv sigma ~principal:true ~store ccl in
+      (sigma, mkNamedLetIn id c t x)
 
 let letin_tac with_eq id c ty occs =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
     let ccl = Proofview.Goal.concl gl in
@@ -2684,40 +2685,39 @@ let letin_tac with_eq id c ty occs =
     let (id,_,depdecls,lastlhyp,ccl,res) = make_abstraction env sigma ccl abs in
     (* We keep the original term to match but record the potential side-effects
        of unifying universes. *)
-    let Sigma (c, sigma, p) = match res with
-      | None -> Sigma.here c sigma
-      | Some (Sigma (_, sigma, p)) -> Sigma (c, sigma, p)
+    let (sigma, c) = match res with
+      | None -> (sigma, c)
+      | Some (sigma, _) -> (sigma, c)
     in
-    let tac = letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty in
-    Sigma (tac, sigma, p)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty)
+  end
 
-let letin_pat_tac with_eq id c occs =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+let letin_pat_tac with_evars with_eq id c occs =
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
     let ccl = Proofview.Goal.concl gl in
     let check t = true in
     let abs = AbstractPattern (false,check,id,c,occs,false) in
     let (id,_,depdecls,lastlhyp,ccl,res) = make_abstraction env sigma ccl abs in
-    let Sigma (c, sigma, p) = match res with
-    | None -> finish_evar_resolution ~flags:(tactic_infer_flags false) env sigma c
+    let (sigma, c) = match res with
+    | None -> finish_evar_resolution ~flags:(tactic_infer_flags with_evars) env sigma c
     | Some res -> res in
-    let tac =
-      (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) None)
-    in
-    Sigma (tac, sigma, p)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) None)
+  end
 
 (* Tactics "pose proof" (usetac=None) and "assert"/"enough" (otherwise) *)
 let forward b usetac ipat c =
   match usetac with
   | None ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
       let t = Tacmach.New.pf_get_type_of gl c in
-      let hd = head_ident c in
+      let sigma = Tacmach.New.project gl in
+      let hd = head_ident sigma c in
       Tacticals.New.tclTHENFIRST (assert_as true hd ipat t) (exact_no_check c)
-      end }
+      end
   | Some tac ->
       let tac = match tac with
         | None -> Tacticals.New.tclIDTAC
@@ -2738,22 +2738,22 @@ let enough_by na t tac = forward false (Some (Some tac)) (ipat_of_name na) t
 
 (* Compute a name for a generalization *)
 
-let generalized_name c t ids cl = function
+let generalized_name env sigma c t ids cl = function
   | Name id as na ->
       if Id.List.mem id ids then
-	errorlabstrm "" (pr_id id ++ str " is already used.");
+	user_err  (Id.print id ++ str " is already used.");
       na
   | Anonymous ->
-      match kind_of_term c with
+      match EConstr.kind sigma c with
       | Var id ->
 	 (* Keep the name even if not occurring: may be used by intros later *)
 	  Name id
       | _ ->
-	  if noccurn 1 cl then Anonymous else
+	  if noccurn sigma 1 cl then Anonymous else
 	    (* On ne s'etait pas casse la tete : on avait pris pour nom de
                variable la premiere lettre du type, meme si "c" avait ete une
                constante dont on aurait pu prendre directement le nom *)
-	    named_hd (Global.env()) t Anonymous
+	    named_hd env sigma t Anonymous
 
 (* Abstract over [c] in [forall x1:A1(c)..xi:Ai(c).T(c)] producing
    [forall x, x1:A1(x1), .., xi:Ai(x). T(x)] with all [c] abtracted in [Ai]
@@ -2761,11 +2761,11 @@ let generalized_name c t ids cl = function
 
 let generalize_goal_gen env sigma ids i ((occs,c,b),na) t cl =
   let open Context.Rel.Declaration in
-  let decls,cl = decompose_prod_n_assum i cl in
+  let decls,cl = decompose_prod_n_assum sigma i cl in
   let dummy_prod = it_mkProd_or_LetIn mkProp decls in
-  let newdecls,_ = decompose_prod_n_assum i (subst_term_gen eq_constr_nounivs c dummy_prod) in
+  let newdecls,_ = decompose_prod_n_assum sigma i (subst_term_gen sigma EConstr.eq_constr_nounivs c dummy_prod) in
   let cl',sigma' = subst_closed_term_occ env sigma (AtOccs occs) c (it_mkProd_or_LetIn cl newdecls) in
-  let na = generalized_name c t ids cl' na in
+  let na = generalized_name env sigma c t ids cl' na in
   let decl = match b with
     | None -> LocalAssum (na,t)
     | Some b -> LocalDef (na,b,t)
@@ -2773,37 +2773,41 @@ let generalize_goal_gen env sigma ids i ((occs,c,b),na) t cl =
   mkProd_or_LetIn decl cl', sigma'
 
 let generalize_goal gl i ((occs,c,b),na as o) (cl,sigma) =
-  let env = Tacmach.pf_env gl in
-  let ids = Tacmach.pf_ids_of_hyps gl in
+  let open Tacmach.New in
+  let env = pf_env gl in
+  let ids = pf_ids_of_hyps gl in
   let sigma, t = Typing.type_of env sigma c in
   generalize_goal_gen env sigma ids i o t cl
 
-let old_generalize_dep ?(with_let=false) c gl =
-  let open Context.Named.Declaration in
+let generalize_dep ?(with_let=false) c =
+  let open Tacmach.New in
+  let open Tacticals.New in
+  Proofview.Goal.nf_enter begin fun gl ->
   let env = pf_env gl in
-  let sign = pf_hyps gl in
+  let sign = Proofview.Goal.hyps gl in
+  let sigma = project gl in
   let init_ids = ids_of_named_context (Global.named_context()) in
-  let seek (d:Context.Named.Declaration.t) (toquant:Context.Named.t) =
-    if List.exists (fun d' -> occur_var_in_decl env (get_id d') d) toquant
-      || dependent_in_decl c d then
+  let seek (d:named_declaration) (toquant:named_context) =
+    if List.exists (fun d' -> occur_var_in_decl env sigma (NamedDecl.get_id d') d) toquant
+      || dependent_in_decl sigma c d then
       d::toquant
     else
       toquant in
   let to_quantify = Context.Named.fold_outside seek sign ~init:[] in
   let to_quantify_rev = List.rev to_quantify in
-  let qhyps = List.map get_id to_quantify_rev in
+  let qhyps = List.map NamedDecl.get_id to_quantify_rev in
   let tothin = List.filter (fun id -> not (Id.List.mem id init_ids)) qhyps in
   let tothin' =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
       | Var id when mem_named_context_val id (val_of_named_context sign) && not (Id.List.mem id init_ids)
 	  -> id::tothin
       | _ -> tothin
   in
-  let cl' = it_mkNamedProd_or_LetIn (Tacmach.pf_concl gl) to_quantify in
+  let cl' = it_mkNamedProd_or_LetIn (pf_concl gl) to_quantify in
   let body =
     if with_let then
-      match kind_of_term c with
-      | Var id -> Tacmach.pf_get_hyp gl id |> get_value
+      match EConstr.kind sigma c with
+      | Var id -> id |> (fun id -> pf_get_hyp id gl) |> NamedDecl.get_value
       | _ -> None
     else None
   in
@@ -2811,35 +2815,30 @@ let old_generalize_dep ?(with_let=false) c gl =
     (cl',project gl) in
   (** Check that the generalization is indeed well-typed *)
   let (evd, _) = Typing.type_of env evd cl'' in
-  let args = Context.Named.to_instance to_quantify_rev in
+  let args = Context.Named.to_instance mkVar to_quantify_rev in
   tclTHENLIST
-    [tclEVARS evd;
-     Proofview.V82.of_tactic (apply_type cl'' (if Option.is_empty body then c::args else args));
-     Proofview.V82.of_tactic (clear (List.rev tothin'))]
-    gl
-
-let generalize_dep ?(with_let = false) c =
-  Proofview.V82.tactic (old_generalize_dep ~with_let c)
+    [ Proofview.Unsafe.tclEVARS evd;
+      apply_type ~typecheck:false cl'' (if Option.is_empty body then c::args else args);
+      clear (List.rev tothin')]
+  end
 
 (**  *)
-let generalize_gen_let lconstr = Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+let generalize_gen_let lconstr = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let newcl, evd =
-    List.fold_right_i (Tacmach.New.of_old generalize_goal gl) 0 lconstr
+    List.fold_right_i (generalize_goal gl) 0 lconstr
       (Tacmach.New.pf_concl gl,Tacmach.New.project gl)
   in
   let (evd, _) = Typing.type_of env evd newcl in
   let map ((_, c, b),_) = if Option.is_empty b then Some c else None in
-  let tac = apply_type newcl (List.map_filter map lconstr) in
-  Sigma.Unsafe.of_pair (tac, evd)
-end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd)
+  (apply_type ~typecheck:false newcl (List.map_filter map lconstr))
+end
 
 let new_generalize_gen_let lconstr =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let gl = Proofview.Goal.assume gl in
     let concl = Proofview.Goal.concl gl in
-    let sigma = Sigma.to_evar_map sigma in
     let env = Proofview.Goal.env gl in
     let ids = Tacmach.New.pf_ids_of_hyps gl in
     let newcl, sigma, args =
@@ -2851,14 +2850,12 @@ let new_generalize_gen_let lconstr =
           (cl, sigma, args))
 	0 lconstr (concl, sigma, [])
     in
-    let tac =
-	Refine.refine { run = begin fun sigma ->
-          let Sigma (ev, sigma, p) = Evarutil.new_evar env sigma ~principal:true newcl in
-          Sigma ((applist (ev, args)), sigma, p)
-	end }
-    in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+	(Refine.refine ~typecheck:false begin fun sigma ->
+          let (sigma, ev) = Evarutil.new_evar env sigma ~principal:true newcl in
+          (sigma, applist (ev, args))
+	 end)
+  end
 
 let generalize_gen lconstr =
   generalize_gen_let (List.map (fun (occs_c,na) ->
@@ -2886,38 +2883,77 @@ let quantify lconstr =
 
 (* Modifying/Adding an hypothesis  *)
 
+(* Instantiating some arguments (whatever their position) of an hypothesis
+   or any term, leaving other arguments quantified. If operating on an
+   hypothesis of the goal, the new hypothesis replaces it.
+
+   (c,lbind) are supposed to be of the form
+   ((t t1 t2 ... tm) , someBindings)
+
+   in which case we pose a proof with body
+
+   (fun y1...yp => H t1 t2 ... tm u1 ... uq) where yi are the
+   remaining arguments of H that lbind could not resolve, ui are a mix
+   of inferred args and yi. The overall effect is to remove from H as
+   much quantification as possible given lbind. *)
 let specialize (c,lbind) ipat =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   let sigma, term =
     if lbind == NoBindings then
-      let sigma = Typeclasses.resolve_typeclasses env sigma in
-      sigma, nf_evar sigma c
+      sigma, c
     else
-      let clause = make_clenv_binding env sigma (c,Retyping.get_type_of env sigma c) lbind in
+      let typ_of_c = Retyping.get_type_of env sigma c in
+      (* If the term is lambda then we put a letin to put avoid
+         interaction between the term and the bindings. *)
+      let c = match EConstr.kind sigma c with
+        | Lambda(_,_,_) ->
+          mkLetIn(Name.Anonymous, c, typ_of_c, (mkRel 1))
+        | _ -> c in
+      let clause = make_clenv_binding env sigma (c,typ_of_c) lbind in
       let flags = { (default_unify_flags ()) with resolve_evars = true } in
       let clause = clenv_unify_meta_types ~flags clause in
-      let (thd,tstack) = whd_nored_stack clause.evd (clenv_value clause) in
-      let rec chk = function
-      | [] -> []
-      | t::l -> if occur_meta t then [] else t :: chk l
-      in
-      let tstack = chk tstack in
-      let term = applist(thd,List.map (nf_evar clause.evd) tstack) in
-      if occur_meta term then
-	errorlabstrm "" (str "Cannot infer an instance for " ++
-
-          pr_name (meta_name clause.evd (List.hd (collect_metas term))) ++
-	  str ".");
-      clause.evd, term in
+      let sigma = clause.evd in
+      let (thd,tstack) = whd_nored_stack sigma (clenv_value clause) in
+      let c_hd , c_args = decompose_app sigma c in
+      let liftrel x =
+        match kind sigma x with
+        | Rel n -> mkRel (n+1)
+        | _ -> x in
+      (* We grab names used in product to remember them at re-abstracting phase *)
+      let typ_of_c_hd = pf_get_type_of gl c_hd in
+      let lprod, concl = decompose_prod_assum sigma typ_of_c_hd in
+      (* accumulator args: arguments to apply to c_hd: all infered
+         args + re-abstracted rels *)
+      let rec rebuild_lambdas sigma lprd args hd l =
+        match lprd , l with
+        | _, [] -> sigma,applist (hd, (List.map (nf_evar sigma) args))
+        | Context.Rel.Declaration.LocalAssum(nme,_)::lp' , t::l' when occur_meta sigma t ->
+          (* nme has not been resolved, let us re-abstract it. Same
+             name but type updated by instanciation of other args. *)
+          let sigma,new_typ_of_t = Typing.type_of clause.env sigma t in
+          let liftedargs = List.map liftrel args in
+          (* lifting rels in the accumulator args *)
+          let sigma,hd' = rebuild_lambdas sigma lp' (liftedargs@[mkRel 1 ]) hd l' in
+          (* replace meta variable by the abstracted variable *)
+          let hd'' = subst_term sigma t hd' in
+          (* lambda expansion *)
+          sigma,mkLambda (nme,new_typ_of_t,hd'')
+        | Context.Rel.Declaration.LocalAssum(_,_)::lp' , t::l' ->
+          let sigma,hd' = rebuild_lambdas sigma lp' (args@[t]) hd l' in
+          sigma,hd'
+        | _ ,_ -> assert false in
+      let sigma,hd = rebuild_lambdas sigma (List.rev lprod) [] c_hd tstack in
+      Evd.clear_metas sigma, hd
+  in
   let typ = Retyping.get_type_of env sigma term in
   let tac =
-    match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
+    match EConstr.kind sigma (fst(EConstr.decompose_app sigma (snd(EConstr.decompose_lam_assum sigma c)))) with
     | Var id when Id.List.mem id (Tacmach.New.pf_ids_of_hyps gl) ->
       (* Like assert (id:=id args) but with the concept of specialization *)
       let naming,tac =
-        prepare_intros false (IntroIdentifier id) MoveLast ipat in
+        prepare_intros_opt false (IntroIdentifier id) MoveLast ipat in
       let repl = do_replace (Some id) naming in
       Tacticals.New.tclTHENFIRST
         (assert_before_then_gen repl naming typ tac)
@@ -2927,17 +2963,19 @@ let specialize (c,lbind) ipat =
       | None ->
         (* Like generalize with extra support for "with" bindings *)
         (* even though the "with" bindings forces full application *)
-        Tacticals.New.tclTHENLAST (cut typ) (exact_no_check term)
-      | Some (loc,ipat) ->
+        (* TODO: add intro to be more homogeneous. It will break
+           scripts but will be easy to fix *)
+         (Tacticals.New.tclTHENLAST (cut typ) (exact_no_check term))
+      | Some {CAst.loc;v=ipat} ->
         (* Like pose proof with extra support for "with" bindings *)
         (* even though the "with" bindings forces full application *)
-        let naming,tac = prepare_intros_loc loc false IntroAnonymous MoveLast ipat in
+        let naming,tac = prepare_intros ?loc false IntroAnonymous MoveLast ipat in
         Tacticals.New.tclTHENFIRST
           (assert_before_then_gen false naming typ tac)
 	  (exact_no_check term)
   in
   Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
-  end }
+  end
 
 (*****************************)
 (* Ad hoc unfold             *)
@@ -2947,22 +2985,23 @@ let specialize (c,lbind) ipat =
 (* Unfolds x by its definition everywhere *)
 let unfold_body x =
   let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (** We normalize the given hypothesis immediately. *)
-  let env = Proofview.Goal.env (Proofview.Goal.assume gl) in
+  let env = Proofview.Goal.env gl in
   let xval = match Environ.lookup_named x env with
-  | LocalAssum _ -> errorlabstrm "unfold_body"
-    (pr_id x ++ str" is not a defined hypothesis.")
+  | LocalAssum _ -> user_err ~hdr:"unfold_body"
+    (Id.print x ++ str" is not a defined hypothesis.")
   | LocalDef (_,xval,_) -> xval
   in
+  let xval = EConstr.of_constr xval in
   Tacticals.New.afterHyp x begin fun aft ->
-  let hl = List.fold_right (fun decl cl -> (get_id decl, InHyp) :: cl) aft [] in
+  let hl = List.fold_right (fun decl cl -> (NamedDecl.get_id decl, InHyp) :: cl) aft [] in
   let rfun _ _ c = replace_vars [x, xval] c in
   let reducth h = reduct_in_hyp rfun h in
   let reductc = reduct_in_concl (rfun, DEFAULTcast) in
   Tacticals.New.tclTHENLIST [Tacticals.New.tclMAP reducth hl; reductc]
   end
-  end }
+  end
 
 (* Either unfold and clear if defined or simply clear if not a definition *)
 let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
@@ -3001,35 +3040,35 @@ let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
 
  *)
 
-let warn_unused_intro_pattern =
+let warn_unused_intro_pattern env sigma =
   CWarnings.create ~name:"unused-intro-pattern" ~category:"tactics"
-         (fun names ->
-          strbrk"Unused introduction " ++ str (String.plural (List.length names) "pattern")
-          ++ str": " ++ prlist_with_sep spc 
-         (Miscprint.pr_intro_pattern 
-	 (fun c -> Printer.pr_constr (fst (run_delayed (Global.env()) Evd.empty c)))) names)
+    (fun names ->
+       strbrk"Unused introduction " ++ str (String.plural (List.length names) "pattern") ++
+       str": " ++ prlist_with_sep spc
+         (Miscprint.pr_intro_pattern
+            (fun c -> Printer.pr_econstr_env env sigma (snd (c env sigma)))) names)
 
-let check_unused_names names =
-  if not (List.is_empty names) && Flags.is_verbose () then
-    warn_unused_intro_pattern names
+let check_unused_names env sigma names =
+  if not (List.is_empty names) then
+    warn_unused_intro_pattern env sigma names
 
 let intropattern_of_name gl avoid = function
   | Anonymous -> IntroNaming IntroAnonymous
   | Name id -> IntroNaming (IntroIdentifier (new_fresh_id avoid id gl))
 
-let rec consume_pattern avoid na isdep gl = function
-  | [] -> ((dloc, intropattern_of_name gl avoid na), [])
-  | (loc,IntroForthcoming true)::names when not isdep ->
+let rec consume_pattern avoid na isdep gl = let open CAst in function
+  | [] -> ((CAst.make @@ intropattern_of_name gl avoid na), [])
+  | {loc;v=IntroForthcoming true}::names when not isdep ->
       consume_pattern avoid na isdep gl names
-  | (loc,IntroForthcoming _)::names as fullpat ->
-      let avoid = avoid@explicit_intro_names names in
-      ((loc,intropattern_of_name gl avoid na), fullpat)
-  | (loc,IntroNaming IntroAnonymous)::names ->
-      let avoid = avoid@explicit_intro_names names in
-      ((loc,intropattern_of_name gl avoid na), names)
-  | (loc,IntroNaming (IntroFresh id'))::names ->
-      let avoid = avoid@explicit_intro_names names in
-      ((loc,IntroNaming (IntroIdentifier (new_fresh_id avoid id' gl))), names)
+  | {loc;v=IntroForthcoming _}::names as fullpat ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ intropattern_of_name gl avoid na, fullpat)
+  | {loc;v=IntroNaming IntroAnonymous}::names ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ intropattern_of_name gl avoid na, names)
+  | {loc;v=IntroNaming (IntroFresh id')}::names ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ IntroNaming (IntroIdentifier (new_fresh_id avoid id' gl)), names)
   | pat::names -> (pat,names)
 
 let re_intro_dependent_hypotheses (lstatus,rstatus) (_,tophyp) =
@@ -3048,7 +3087,7 @@ let safe_dest_intro_patterns with_evars avoid thin dest pat tac =
   Proofview.tclORELSE
     (dest_intro_patterns with_evars avoid thin dest pat tac)
     begin function (e, info) -> match e with
-      | UserError ("move_hyp",_) ->
+      | UserError (Some "move_hyp",_) ->
        (* May happen e.g. with "destruct x using s" with an hypothesis
           which is morally an induction hypothesis to be "MoveLast" if
           known as such but which is considered instead as a subterm of
@@ -3086,53 +3125,57 @@ let get_recarg_dest (recargdests,tophyp) =
 *)
 
 let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
-  let avoid = avoid @ avoid' in
+  let avoid = Id.Set.union avoid avoid' in
   let rec peel_tac ra dests names thin =
     match ra with
     | (RecArg,_,deprec,recvarname) ::
         (IndArg,_,depind,hyprecname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (recpat,names) = match names with
-          | [loc,IntroNaming (IntroIdentifier id) as pat] ->
+          | [{CAst.loc;v=IntroNaming (IntroIdentifier id)} as pat] ->
               let id' = next_ident_away (add_prefix "IH" id) avoid in
-	      (pat, [dloc, IntroNaming (IntroIdentifier id')])
+              (pat, [CAst.make @@ IntroNaming (IntroIdentifier id')])
           | _ -> consume_pattern avoid (Name recvarname) deprec gl names in
         let dest = get_recarg_dest dests in
         dest_intro_patterns with_evars avoid thin dest [recpat] (fun ids thin ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
           let (hyprec,names) =
             consume_pattern avoid (Name hyprecname) depind gl names
           in
 	  dest_intro_patterns with_evars avoid thin MoveLast [hyprec] (fun ids' thin ->
 	    peel_tac ra' (update_dest dests ids') names thin)
-        end })
-        end }
+                             end)
+        end
     | (IndArg,_,dep,hyprecname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
 	(* Rem: does not happen in Coq schemes, only in user-defined schemes *)
         let pat,names =
           consume_pattern avoid (Name hyprecname) dep gl names in
 	dest_intro_patterns with_evars avoid thin MoveLast [pat] (fun ids thin ->
         peel_tac ra' (update_dest dests ids) names thin)
-        end }
+        end
     | (RecArg,_,dep,recvarname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (pat,names) =
           consume_pattern avoid (Name recvarname) dep gl names in
         let dest = get_recarg_dest dests in
 	dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
-        end }
+        end
     | (OtherArg,_,dep,_) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (pat,names) = consume_pattern avoid Anonymous dep gl names in
         let dest = get_recarg_dest dests in
 	safe_dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
-        end }
+        end
     | [] ->
-        check_unused_names names;
+        Proofview.Goal.enter begin fun gl ->
+        let env = Proofview.Goal.env gl in
+        let sigma = Proofview.Goal.sigma gl in
+        check_unused_names env sigma names;
         Tacticals.New.tclTHEN (clear_wildcards thin) (tac dests)
+        end
   in
   peel_tac ra dests names []
 
@@ -3141,26 +3184,26 @@ let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
      substitutions aussi sur l'argument voisin *)
 
 let expand_projections env sigma c =
-  let sigma = Sigma.to_evar_map sigma in
   let rec aux env c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Proj (p, c) -> Retyping.expand_projection env sigma p (aux env c) []
-    | _ -> map_constr_with_full_binders push_rel aux env c
-  in aux env c
+    | _ -> map_constr_with_full_binders sigma push_rel aux env c
+  in
+  aux env c
 			       
 	   
 (* Marche pas... faut prendre en compte l'occurrence précise... *)
 
 let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 (Proofview.Goal.assume gl) in
+  let sigma = Tacmach.New.project gl in
+  let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 gl in
   let reduce_to_quantified_ref = Tacmach.New.pf_apply reduce_to_quantified_ref gl in
   let typ0 = reduce_to_quantified_ref indref tmptyp0 in
-  let prods, indtyp = decompose_prod_assum typ0 in
-  let hd,argl = decompose_app indtyp in
+  let prods, indtyp = decompose_prod_assum sigma typ0 in
+  let hd,argl = decompose_app sigma indtyp in
   let env' = push_rel_context prods env in
-  let sigma = Proofview.Goal.sigma gl in
   let params = List.firstn nparams argl in
   let params' = List.map (expand_projections env' sigma) params in
   (* le gl est important pour ne pas préévaluer *)
@@ -3172,17 +3215,18 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
         (tac avoid)
     else
       let c = List.nth argl (i-1) in
-      match kind_of_term c with
-	| Var id when not (List.exists (occur_var env id) args') &&
-                      not (List.exists (occur_var env id) params') ->
+      match EConstr.kind sigma c with
+	| Var id when not (List.exists (fun c -> occur_var env sigma id c) args') &&
+                      not (List.exists (fun c -> occur_var env sigma id c) params') ->
             (* Based on the knowledge given by the user, all
                constraints on the variable are generalizable in the
                current environment so that it is clearable after destruction *)
-	    atomize_one (i-1) (c::args) (c::args') (id::avoid)
+	    atomize_one (i-1) (c::args) (c::args') (Id.Set.add id avoid)
 	| _ ->
 	   let c' = expand_projections env' sigma c in
-            if List.exists (dependent c) params' ||
-               List.exists (dependent c) args'
+            let dependent t = dependent sigma c t in
+            if List.exists dependent params' ||
+               List.exists dependent args'
             then
               (* This is a case where the argument is constrained in a
                  way which would require some kind of inversion; we
@@ -3194,18 +3238,18 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
             (* We reason blindly on the term and do as if it were
                generalizable, ignoring the constraints coming from
                its structure *)
-            let id = match kind_of_term c with
+            let id = match EConstr.kind sigma c with
             | Var id -> id
             | _ ->
             let type_of = Tacmach.New.pf_unsafe_type_of gl in
-            id_of_name_using_hdchar (Global.env()) (type_of c) Anonymous in
+            id_of_name_using_hdchar env sigma (type_of c) Anonymous in
             let x = fresh_id_in_env avoid id env in
 	    Tacticals.New.tclTHEN
 	      (letin_tac None (Name x) c None allHypsAndConcl)
-	      (atomize_one (i-1) (mkVar x::args) (mkVar x::args') (x::avoid))
+	      (atomize_one (i-1) (mkVar x::args) (mkVar x::args') (Id.Set.add x avoid))
   in
-  atomize_one (List.length argl) [] [] []
-  end }
+  atomize_one (List.length argl) [] [] Id.Set.empty
+  end
 
 (* [cook_sign] builds the lists [beforetoclear] (preceding the
    ind. var.) and [aftertoclear] (coming after the ind. var.)  of hyps
@@ -3272,12 +3316,11 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
 
 exception Shunt of Id.t move_location
 
-let cook_sign hyp0_opt inhyps indvars env =
+let cook_sign hyp0_opt inhyps indvars env sigma =
   (* First phase from L to R: get [toclear], [decldep] and [statuslist]
      for the hypotheses before (= more ancient than) hyp0 (see above) *)
-  let open Context.Named.Declaration in
   let toclear = ref [] in
-  let avoid = ref [] in
+  let avoid = ref Id.Set.empty in
   let decldeps = ref [] in
   let ldeps = ref [] in
   let rstatus = ref [] in
@@ -3285,7 +3328,8 @@ let cook_sign hyp0_opt inhyps indvars env =
   let before = ref true in
   let maindep = ref false in
   let seek_deps env decl rhyp =
-    let hyp = get_id decl in
+    let decl = map_named_decl EConstr.of_constr decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false)
     then begin
       before:=false;
@@ -3293,24 +3337,24 @@ let cook_sign hyp0_opt inhyps indvars env =
          is one of indvars too *)
       toclear := hyp::!toclear;
       MoveFirst (* fake value *)
-    end else if Id.List.mem hyp indvars then begin
+    end else if Id.Set.mem hyp indvars then begin
       (* The variables in indvars are such that they don't occur any
          more after generalization, so declare them to clear. *)
       toclear := hyp::!toclear;
       rhyp
     end else
       let dephyp0 = List.is_empty inhyps && 
-	(Option.cata (fun id -> occur_var_in_decl env id decl) false hyp0_opt)
+	(Option.cata (fun id -> occur_var_in_decl env sigma id decl) false hyp0_opt)
       in
       let depother = List.is_empty inhyps &&
-	(List.exists (fun id -> occur_var_in_decl env id decl) indvars ||
-         List.exists (fun decl' -> occur_var_in_decl env (get_id decl') decl) !decldeps)
+	(Id.Set.exists (fun id -> occur_var_in_decl env sigma id decl) indvars ||
+         List.exists (fun decl' -> occur_var_in_decl env sigma (NamedDecl.get_id decl') decl) !decldeps)
       in
       if not (List.is_empty inhyps) && Id.List.mem hyp inhyps
          || dephyp0 || depother
       then begin
 	decldeps := decl::!decldeps;
-	avoid := hyp::!avoid;
+	avoid := Id.Set.add hyp !avoid;
         maindep := dephyp0 || !maindep;
 	if !before then begin
           toclear := hyp::!toclear;
@@ -3327,7 +3371,7 @@ let cook_sign hyp0_opt inhyps indvars env =
   let _ = fold_named_context seek_deps env ~init:MoveFirst in
   (* 2nd phase from R to L: get left hyp of [hyp0] and [lhyps] *)
   let compute_lstatus lhyp decl =
-    let hyp = get_id decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false) then
       raise (Shunt lhyp);
     if Id.List.mem hyp !ldeps then begin
@@ -3377,15 +3421,15 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: Context.Rel.t;      (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  params: rel_context;      (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
   nparams: int;               (* number of parameters *)
-  predicates: Context.Rel.t;  (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  predicates: rel_context;  (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;           (* Number of predicates *)
-  branches: Context.Rel.t;    (* branchr,...,branch1 *)
+  branches: rel_context;    (* branchr,...,branch1 *)
   nbranches: int;             (* Number of branches *)
-  args: Context.Rel.t;        (* (xni, Ti_ni) ... (x1, Ti_1) *)
+  args: rel_context;        (* (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;                 (* number of arguments *)
-  indarg: Context.Rel.Declaration.t option; (* Some (H,I prm1..prmp x1...xni)
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni)
                                                if HI is in premisses, None otherwise *)
   concl: types;               (* Qi x1...xni HI (f...), HI and (f...)
 			         are optional and mutually exclusive *)
@@ -3434,44 +3478,44 @@ let make_up_names n ind_opt cname =
     else add_prefix ind_prefix cname in
   let hyprecname = make_base n base_ind in
   let avoid =
-    if Int.equal n 1 (* Only one recursive argument *) || Int.equal n 0 then []
+    if Int.equal n 1 (* Only one recursive argument *) || Int.equal n 0 then Id.Set.empty
     else
       (* Forbid to use cname, cname0, hyprecname and hyprecname0 *)
       (* in order to get names such as f1, f2, ... *)
       let avoid =
-        (make_ident (Id.to_string hyprecname) None) ::
-        (make_ident (Id.to_string hyprecname) (Some 0)) :: [] in
+        Id.Set.add (make_ident (Id.to_string hyprecname) None)
+        (Id.Set.singleton (make_ident (Id.to_string hyprecname) (Some 0))) in
       if not (String.equal (atompart_of_id cname) "H") then
-        (make_ident base (Some 0)) :: (make_ident base None) :: avoid
+        Id.Set.add (make_ident base (Some 0)) (Id.Set.add (make_ident base None) avoid)
       else avoid in
   Id.of_string base, hyprecname, avoid
 
 let error_ind_scheme s =
   let s = if not (String.is_empty s) then s^" " else s in
-  errorlabstrm "Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
+  user_err ~hdr:"Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
 
-let glob = Universes.constr_of_global
+let coq_eq sigma       = Evarutil.new_global sigma (Coqlib.build_coq_eq ())
+let coq_eq_refl sigma  = Evarutil.new_global sigma (Coqlib.build_coq_eq_refl ())
 
-let coq_eq = lazy (glob (Coqlib.build_coq_eq ()))
-let coq_eq_refl = lazy (glob (Coqlib.build_coq_eq_refl ()))
+let coq_heq_ref        = lazy (Coqlib.coq_reference"mkHEq" ["Logic";"JMeq"] "JMeq")
+let coq_heq sigma      = Evarutil.new_global sigma (Lazy.force coq_heq_ref)
+let coq_heq_refl sigma = Evarutil.new_global sigma (Coqlib.coq_reference "mkHEq" ["Logic";"JMeq"] "JMeq_refl")
 
-let coq_heq = lazy (Coqlib.coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq")
-let coq_heq_refl = lazy (Coqlib.coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq_refl")
+let mkEq sigma t x y =
+  let sigma, eq = coq_eq sigma in
+  sigma, mkApp (eq, [| t; x; y |])
 
+let mkRefl sigma t x =
+  let sigma, refl = coq_eq_refl sigma in
+  sigma, mkApp (refl, [| t; x |])
 
-let mkEq t x y =
-  mkApp (Lazy.force coq_eq, [| t; x; y |])
+let mkHEq sigma t x u y =
+  let sigma, c = coq_heq sigma in
+  sigma, mkApp (c,[| t; x; u; y |])
 
-let mkRefl t x =
-  mkApp (Lazy.force coq_eq_refl, [| t; x |])
-
-let mkHEq t x u y =
-  mkApp (Lazy.force coq_heq,
-	[| t; x; u; y |])
-
-let mkHRefl t x =
-  mkApp (Lazy.force coq_heq_refl,
-	[| t; x |])
+let mkHRefl sigma t x =
+  let sigma, c = coq_heq_refl sigma in
+  sigma, mkApp (c, [| t; x |])
 
 let lift_togethern n l =
   let l', _ =
@@ -3483,24 +3527,24 @@ let lift_togethern n l =
 
 let lift_list l = List.map (lift 1) l
 
-let ids_of_constr ?(all=false) vars c =
+let ids_of_constr sigma ?(all=false) vars c =
   let rec aux vars c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Var id -> Id.Set.add id vars
     | App (f, args) ->
-	(match kind_of_term f with
+	(match EConstr.kind sigma f with
 	| Construct ((ind,_),_)
 	| Ind (ind,_) ->
             let (mib,mip) = Global.lookup_inductive ind in
 	      Array.fold_left_from
 		(if all then 0 else mib.Declarations.mind_nparams)
 		aux vars args
-	| _ -> fold_constr aux vars c)
-    | _ -> fold_constr aux vars c
+	| _ -> EConstr.fold sigma aux vars c)
+    | _ -> EConstr.fold sigma aux vars c
   in aux vars c
 
-let decompose_indapp f args =
-  match kind_of_term f with
+let decompose_indapp sigma f args =
+  match EConstr.kind sigma f with
   | Construct ((ind,_),_)
   | Ind (ind,_) ->
       let (mib,mip) = Global.lookup_inductive ind in
@@ -3509,23 +3553,29 @@ let decompose_indapp f args =
 	mkApp (f, pars), args
   | _ -> f, args
 
-let mk_term_eq env sigma ty t ty' t' =
-  let sigma = Sigma.to_evar_map sigma in
-  if Reductionops.is_conv env sigma ty ty' then
-    mkEq ty t t', mkRefl ty' t'
+let mk_term_eq homogeneous env sigma ty t ty' t' =
+  if homogeneous then
+    let sigma, eq = mkEq sigma ty t t' in
+    let sigma, refl = mkRefl sigma ty' t' in
+    sigma, (eq, refl)
   else
-    mkHEq ty t ty' t', mkHRefl ty' t'
+    let sigma, heq = mkHEq sigma ty t ty' t' in
+    let sigma, hrefl = mkHRefl sigma ty' t' in
+    sigma, (heq, hrefl)
 
 let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
   let open Context.Rel.Declaration in
-  Refine.refine { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
   let eqslen = List.length eqs in
     (* Abstract by the "generalized" hypothesis equality proof if necessary. *)
-  let abshypeq, abshypt =
+  let sigma, abshypeq, abshypt =
     if dep then
-      let eq, refl = mk_term_eq (push_rel_context ctx env) sigma (lift 1 c) (mkRel 1) typ (mkVar id) in
-	mkProd (Anonymous, eq, lift 1 concl), [| refl |]
-    else concl, [||]
+      let ty = lift 1 c in
+      let homogeneous = Reductionops.is_conv env sigma ty typ in
+      let sigma, (eq, refl) =
+        mk_term_eq homogeneous (push_rel_context ctx env) sigma ty (mkRel 1) typ (mkVar id) in
+      sigma, mkProd (Anonymous, eq, lift 1 concl), [| refl |]
+    else sigma, concl, [||]
   in
     (* Abstract by equalities *)
   let eqs = lift_togethern 1 eqs in (* lift together and past genarg *)
@@ -3539,7 +3589,7 @@ let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
     (* Abstract by the extension of the context *)
   let genctyp = it_mkProd_or_LetIn genarg ctx in
     (* The goal will become this product. *)
-  let Sigma (genc, sigma, p) = Evarutil.new_evar env sigma ~principal:true genctyp in
+  let (sigma, genc) = Evarutil.new_evar env sigma ~principal:true genctyp in
     (* Apply the old arguments giving the proper instantiation of the hyp *)
   let instc = mkApp (genc, Array.of_list args) in
     (* Then apply to the original instantiated hyp. *)
@@ -3547,21 +3597,20 @@ let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
     (* Apply the reflexivity proofs on the indices. *)
   let appeqs = mkApp (instc, Array.of_list refls) in
     (* Finally, apply the reflexivity proof for the original hyp, to get a term of type gl again. *)
-  Sigma (mkApp (appeqs, abshypt), sigma, p)
-  end }
+  (sigma, mkApp (appeqs, abshypt))
+  end
 
-let hyps_of_vars env sign nogen hyps =
-  let open Context.Named.Declaration in
+let hyps_of_vars env sigma sign nogen hyps =
   if Id.Set.is_empty hyps then []
   else
     let (_,lh) =
       Context.Named.fold_inside
         (fun (hs,hl) d ->
-          let x = get_id d in
+          let x = NamedDecl.get_id d in
 	  if Id.Set.mem x nogen then (hs,hl)
 	  else if Id.Set.mem x hs then (hs,x::hl)
 	  else
-	    let xvars = global_vars_set_of_decl env d in
+	    let xvars = global_vars_set_of_decl env sigma d in
 	      if not (Id.Set.is_empty (Id.Set.diff xvars hs)) then
 		(Id.Set.add x hs, x :: hl)
 	      else (hs, hl))
@@ -3571,11 +3620,11 @@ let hyps_of_vars env sign nogen hyps =
 
 exception Seen
 
-let linear vars args =
+let linear sigma vars args =
   let seen = ref vars in
     try
       Array.iter (fun i ->
-	let rels = ids_of_constr ~all:true Id.Set.empty i in
+	let rels = ids_of_constr sigma ~all:true Id.Set.empty i in
 	let seen' =
 	  Id.Set.fold (fun id acc ->
 	    if Id.Set.mem id acc then raise Seen
@@ -3587,19 +3636,19 @@ let linear vars args =
     with Seen -> false
 
 let is_defined_variable env id =
-  let open Context.Named.Declaration in
-  lookup_named id env |> is_local_def
+  env |> lookup_named id |> is_local_def
 
 let abstract_args gl generalize_vars dep id defined f args =
+  let open Tacmach.New in
   let open Context.Rel.Declaration in
-  let sigma = ref (Tacmach.project gl) in
-  let env = Tacmach.pf_env gl in
-  let concl = Tacmach.pf_concl gl in
-  let dep = dep || dependent (mkVar id) concl in
-  let avoid = ref [] in
+  let sigma = ref (Tacmach.New.project gl) in
+  let env = Tacmach.New.pf_env gl in
+  let concl = Tacmach.New.pf_concl gl in
+  let dep = dep || local_occur_var !sigma id concl in
+  let avoid = ref Id.Set.empty in
   let get_id name =
-    let id = fresh_id !avoid (match name with Name n -> n | Anonymous -> Id.of_string "gen_x") gl in
-      avoid := id :: !avoid; id
+    let id = new_fresh_id !avoid (match name with Name n -> n | Anonymous -> Id.of_string "gen_x") gl in
+      avoid := Id.Set.add id !avoid; id
   in
     (* Build application generalized w.r.t. the argument plus the necessary eqs.
        From env |- c : forall G, T and args : G we build
@@ -3611,15 +3660,15 @@ let abstract_args gl generalize_vars dep id defined f args =
     let name, ty, arity =
       let rel, c = Reductionops.splay_prod_n env !sigma 1 prod in
       let decl = List.hd rel in
-      get_name decl, get_type decl, c
+      RelDecl.get_name decl, RelDecl.get_type decl, c
     in
-    let argty = Tacmach.pf_unsafe_type_of gl arg in
+    let argty = Tacmach.New.pf_unsafe_type_of gl arg in
     let sigma', ty = Evarsolve.refresh_universes (Some true) env !sigma ty in
     let () = sigma := sigma' in
     let lenctx = List.length ctx in
     let liftargty = lift lenctx argty in
-    let leq = constr_cmp Reduction.CUMUL liftargty ty in
-      match kind_of_term arg with
+    let leq = constr_cmp !sigma Reduction.CUMUL liftargty ty in
+      match EConstr.kind !sigma arg with
       | Var id when not (is_defined_variable env id) && leq && not (Id.Set.mem id nongenvars) ->
       	  (subst1 arg arity, ctx, ctxenv, mkApp (c, [|arg|]), args, eqs, refls,
       	  Id.Set.add id nongenvars, Id.Set.remove id vars, env)
@@ -3632,29 +3681,33 @@ let abstract_args gl generalize_vars dep id defined f args =
 	  let liftarg = lift (List.length ctx) arg in
 	  let eq, refl =
 	    if leq then
-	      mkEq (lift 1 ty) (mkRel 1) liftarg, mkRefl (lift (-lenctx) ty) arg
+	      let sigma', eq = mkEq !sigma (lift 1 ty) (mkRel 1) liftarg in
+              let sigma', refl = mkRefl sigma' (lift (-lenctx) ty) arg in
+              sigma := sigma'; eq, refl
 	    else
-	      mkHEq (lift 1 ty) (mkRel 1) liftargty liftarg, mkHRefl argty arg
+	      let sigma', eq = mkHEq !sigma (lift 1 ty) (mkRel 1) liftargty liftarg in
+              let sigma', refl = mkHRefl sigma' argty arg in
+              sigma := sigma'; eq, refl
 	  in
 	  let eqs = eq :: lift_list eqs in
 	  let refls = refl :: refls in
-	  let argvars = ids_of_constr vars arg in
+	  let argvars = ids_of_constr !sigma vars arg in
 	    (arity, ctx, push_rel decl ctxenv, c', args, eqs, refls,
 	    nongenvars, Id.Set.union argvars vars, env)
   in
-  let f', args' = decompose_indapp f args in
+  let f', args' = decompose_indapp !sigma f args in
   let dogen, f', args' =
-    let parvars = ids_of_constr ~all:true Id.Set.empty f' in
-      if not (linear parvars args') then true, f, args
+    let parvars = ids_of_constr !sigma ~all:true Id.Set.empty f' in
+      if not (linear !sigma parvars args') then true, f, args
       else
-	match Array.findi (fun i x -> not (isVar x) || is_defined_variable env (destVar x)) args' with
+	match Array.findi (fun i x -> not (isVar !sigma x) || is_defined_variable env (destVar !sigma x)) args' with
 	| None -> false, f', args'
 	| Some nonvar ->
 	    let before, after = Array.chop nonvar args' in
 	      true, mkApp (f', before), after
   in
     if dogen then
-      let tyf' = Tacmach.pf_unsafe_type_of gl f' in
+      let tyf' = Tacmach.New.pf_unsafe_type_of gl f' in
       let arity, ctx, ctxenv, c', args, eqs, refls, nogen, vars, env =
 	Array.fold_left aux (tyf',[],env,f',[],[],[],Id.Set.empty,Id.Set.empty,env) args'
       in
@@ -3662,14 +3715,14 @@ let abstract_args gl generalize_vars dep id defined f args =
       let vars =
 	if generalize_vars then
 	  let nogen = Id.Set.add id nogen in
-	    hyps_of_vars (pf_env gl) (pf_hyps gl) nogen vars
+	    hyps_of_vars (pf_env gl) (project gl) (Proofview.Goal.hyps gl) nogen vars
 	else []
       in
       let body, c' =
 	if defined then Some c', Retyping.get_type_of ctxenv !sigma c'
 	else None, c'
       in
-      let typ = Tacmach.pf_get_hyp_typ gl id in
+      let typ = Tacmach.New.pf_get_hyp_typ id gl in
       let tac = make_abstract_generalize (pf_env gl) id typ concl dep ctx body c' eqs args refls in
       let tac = Proofview.Unsafe.tclEVARS !sigma <*> tac in
 	Some (tac, dep, succ (List.length ctx), vars)
@@ -3677,21 +3730,22 @@ let abstract_args gl generalize_vars dep id defined f args =
 
 let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
   let open Context.Named.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Coqlib.check_required_library Coqlib.jmeq_module_name;
+  let sigma = Tacmach.New.project gl in
   let (f, args, def, id, oldid) =
     let oldid = Tacmach.New.pf_get_new_id id gl in
       match Tacmach.New.pf_get_hyp id gl with
-      | LocalAssum (_,t) -> let f, args = decompose_app t in
+      | LocalAssum (_,t) -> let f, args = decompose_app sigma t in
 	        (f, args, false, id, oldid)
       | LocalDef (_,t,_) ->
-	  let f, args = decompose_app t in
+	  let f, args = decompose_app sigma t in
 	  (f, args, true, id, oldid)
   in
   if List.is_empty args then Proofview.tclUNIT ()
   else
     let args = Array.of_list args in
-    let newc = Tacmach.New.of_old (fun gl -> abstract_args gl generalize_vars force_dep id def f args) gl in
+    let newc = abstract_args gl generalize_vars force_dep id def f args in
       match newc with
       | None -> Proofview.tclUNIT ()
       | Some (tac, dep, n, vars) ->
@@ -3712,35 +3766,41 @@ let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
                 [revert vars ;
 		 Tacticals.New.tclMAP (fun id ->
 		      Tacticals.New.tclTRY (generalize_dep ~with_let:true (mkVar id))) vars])
-  end }
+  end
 
-let rec compare_upto_variables x y =
-  if (isVar x || isRel x) && (isVar y || isRel y) then true
-  else compare_constr compare_upto_variables x y
+let compare_upto_variables sigma x y =
+  let rec compare x y =
+    if (isVar sigma x || isRel sigma x) && (isVar sigma y || isRel sigma y) then true
+    else compare_constr sigma compare x y
+  in
+  compare x y
 
-let specialize_eqs id gl =
+let specialize_eqs id =
   let open Context.Rel.Declaration in
-  let env = Tacmach.pf_env gl in
-  let ty = Tacmach.pf_get_hyp_typ gl id in
-  let evars = ref (project gl) in
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let ty = Tacmach.New.pf_get_hyp_typ id gl in
+  let evars = ref (Proofview.Goal.sigma gl) in
   let unif env evars c1 c2 =
-    compare_upto_variables c1 c2 && Evarconv.e_conv env evars c1 c2
+    compare_upto_variables !evars c1 c2 && Evarconv.e_conv env evars c1 c2
   in
   let rec aux in_eqs ctx acc ty =
-    match kind_of_term ty with
+    match EConstr.kind !evars ty with
     | Prod (na, t, b) ->
-	(match kind_of_term t with
-	| App (eq, [| eqty; x; y |]) when Term.eq_constr (Lazy.force coq_eq) eq ->
-	    let c = if noccur_between 1 (List.length ctx) x then y else x in
-	    let pt = mkApp (Lazy.force coq_eq, [| eqty; c; c |]) in
-	    let p = mkApp (Lazy.force coq_eq_refl, [| eqty; c |]) in
+	(match EConstr.kind !evars t with
+	| App (eq, [| eqty; x; y |]) when EConstr.is_global !evars (Lazy.force coq_eq_ref) eq ->
+	    let c = if noccur_between !evars 1 (List.length ctx) x then y else x in
+	    let pt = mkApp (eq, [| eqty; c; c |]) in
+            let ind = destInd !evars eq in
+	    let p = mkApp (mkConstructUi (ind,0), [| eqty; c |]) in
 	      if unif (push_rel_context ctx env) evars pt t then
 		aux true ctx (mkApp (acc, [| p |])) (subst1 p b)
 	      else acc, in_eqs, ctx, ty
-	| App (heq, [| eqty; x; eqty'; y |]) when Term.eq_constr heq (Lazy.force coq_heq) ->
-	    let eqt, c = if noccur_between 1 (List.length ctx) x then eqty', y else eqty, x in
-	    let pt = mkApp (Lazy.force coq_heq, [| eqt; c; eqt; c |]) in
-	    let p = mkApp (Lazy.force coq_heq_refl, [| eqt; c |]) in
+	| App (heq, [| eqty; x; eqty'; y |]) when EConstr.is_global !evars (Lazy.force coq_heq_ref) heq ->
+	    let eqt, c = if noccur_between !evars 1 (List.length ctx) x then eqty', y else eqty, x in
+	    let pt = mkApp (heq, [| eqt; c; eqt; c |]) in
+            let ind = destInd !evars heq in
+	    let p = mkApp (mkConstructUi (ind,0), [| eqt; c |]) in
 	      if unif (push_rel_context ctx env) evars pt t then
 		aux true ctx (mkApp (acc, [| p |])) (subst1 p b)
 	      else acc, in_eqs, ctx, ty
@@ -3754,7 +3814,7 @@ let specialize_eqs id gl =
   let acc, worked, ctx, ty = aux false [] (mkVar id) ty in
   let ctx' = nf_rel_context_evar !evars ctx in
   let ctx'' = List.map (function
-    | LocalDef (n,k,t) when isEvar k -> LocalAssum (n,t)
+    | LocalDef (n,k,t) when isEvar !evars k -> LocalAssum (n,t)
     | decl -> decl) ctx'
   in
   let ty' = it_mkProd_or_LetIn ty ctx'' in
@@ -3763,20 +3823,22 @@ let specialize_eqs id gl =
   and acc' = Tacred.whd_simpl env !evars acc' in
   let ty' = Evarutil.nf_evar !evars ty' in
     if worked then
-      tclTHENFIRST (Tacmach.internal_cut true id ty')
-	(Proofview.V82.of_tactic (exact_no_check ((* refresh_universes_strict *) acc'))) gl
-    else tclFAIL 0 (str "Nothing to do in hypothesis " ++ pr_id id) gl
-
+      Tacticals.New.tclTHENFIRST
+        (internal_cut true id ty')
+	(exact_no_check ((* refresh_universes_strict *) acc'))
+    else
+      Tacticals.New.tclFAIL 0 (str "Nothing to do in hypothesis " ++ Id.print id)
+  end
 
-let specialize_eqs id = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let specialize_eqs id = Proofview.Goal.enter begin fun gl ->
   let msg = str "Specialization not allowed on dependent hypotheses" in
   Proofview.tclOR (clear [id])
     (fun _ -> Tacticals.New.tclZEROMSG msg) >>= fun () ->
-    Proofview.V82.tactic (specialize_eqs id)
-end }
+    specialize_eqs id
+end
 
-let occur_rel n c =
-  let res = not (noccurn n c) in
+let occur_rel sigma n c =
+  let res = not (noccurn sigma n c) in
   res
 
 (* This function splits the products of the induction scheme [elimt] into four
@@ -3787,20 +3849,20 @@ let occur_rel n c =
    if there is no branch, we try to fill in acc3 with args/indargs.
    We also return the conclusion.
 *)
-let decompose_paramspred_branch_args elimt =
+let decompose_paramspred_branch_args sigma elimt =
   let open Context.Rel.Declaration in
   let rec cut_noccur elimt acc2 =
-    match kind_of_term elimt with
+    match EConstr.kind sigma elimt with
       | Prod(nme,tpe,elimt') ->
-	  let hd_tpe,_ = decompose_app ((strip_prod_assum tpe)) in
-	  if not (occur_rel 1 elimt') && isRel hd_tpe
+	  let hd_tpe,_ = decompose_app sigma (snd (decompose_prod_assum sigma tpe)) in
+	  if not (occur_rel sigma 1 elimt') && isRel sigma hd_tpe
 	  then cut_noccur elimt' (LocalAssum (nme,tpe)::acc2)
-	  else let acc3,ccl = decompose_prod_assum elimt in acc2 , acc3 , ccl
+	  else let acc3,ccl = decompose_prod_assum sigma elimt in acc2 , acc3 , ccl
       | App(_, _) | Rel _ -> acc2 , [] , elimt
       | _ -> error_ind_scheme "" in
   let rec cut_occur elimt acc1 =
-    match kind_of_term elimt with
-      | Prod(nme,tpe,c) when occur_rel 1 c -> cut_occur c (LocalAssum (nme,tpe)::acc1)
+    match EConstr.kind sigma elimt with
+      | Prod(nme,tpe,c) when occur_rel sigma 1 c -> cut_occur c (LocalAssum (nme,tpe)::acc1)
       | Prod(nme,tpe,c) -> let acc2,acc3,ccl = cut_noccur elimt [] in acc1,acc2,acc3,ccl
       | App(_, _) | Rel _ -> acc1,[],[],elimt
       | _ -> error_ind_scheme "" in
@@ -3813,17 +3875,17 @@ let decompose_paramspred_branch_args elimt =
      args. We suppose there is only one predicate here. *)
   match acc2 with
   | [] ->
-    let hyps,ccl = decompose_prod_assum elimt in
-    let hd_ccl_pred,_ = decompose_app ccl in
-    begin match kind_of_term hd_ccl_pred with
+    let hyps,ccl = decompose_prod_assum sigma elimt in
+    let hd_ccl_pred,_ = decompose_app sigma ccl in
+    begin match EConstr.kind sigma hd_ccl_pred with
       | Rel i  -> let acc3,acc1 = List.chop (i-1) hyps in acc1 , [] , acc3 , ccl
       | _ -> error_ind_scheme ""
     end
   | _ -> acc1, acc2 , acc3, ccl
 
 
-let exchange_hd_app subst_hd t =
-  let hd,args= decompose_app t in mkApp (subst_hd,Array.of_list args)
+let exchange_hd_app sigma subst_hd t =
+  let hd,args= decompose_app sigma t in mkApp (subst_hd,Array.of_list args)
 
 (* Builds an elim_scheme from its type and calling form (const+binding). We
    first separate branches.  We obtain branches, hyps before (params + preds),
@@ -3841,14 +3903,14 @@ let exchange_hd_app subst_hd t =
      predicates are cited in the conclusion.
 
    - finish to fill in the elim_scheme: indarg/farg/args and finally indref. *)
-let compute_elim_sig ?elimc elimt =
+let compute_elim_sig sigma ?elimc elimt =
   let open Context.Rel.Declaration in
   let params_preds,branches,args_indargs,conclusion =
-    decompose_paramspred_branch_args elimt in
+    decompose_paramspred_branch_args sigma elimt in
 
-  let ccl = exchange_hd_app (mkVar (Id.of_string "__QI_DUMMY__")) conclusion in
+  let ccl = exchange_hd_app sigma (mkVar (Id.of_string "__QI_DUMMY__")) conclusion in
   let concl_with_args = it_mkProd_or_LetIn ccl args_indargs in
-  let nparams = Int.Set.cardinal (free_rels concl_with_args) in
+  let nparams = Int.Set.cardinal (free_rels sigma concl_with_args) in
   let preds,params = List.chop (List.length params_preds - nparams) params_preds in
 
   (* A first approximation, further analysis will tweak it *)
@@ -3857,7 +3919,7 @@ let compute_elim_sig ?elimc elimt =
     elimc = elimc; elimt = elimt; concl = conclusion;
     predicates = preds; npredicates = List.length preds;
     branches = branches; nbranches = List.length branches;
-    farg_in_concl = isApp ccl && isApp (last_arg ccl);
+    farg_in_concl = isApp sigma ccl && isApp sigma (last_arg sigma ccl);
     params = params; nparams = nparams;
     (* all other fields are unsure at this point. Including these:*)
     args = args_indargs; nargs = List.length args_indargs; } in
@@ -3878,9 +3940,9 @@ let compute_elim_sig ?elimc elimt =
       match List.hd args_indargs with
 	| LocalDef (hiname,_,hi) -> error_ind_scheme ""
 	| LocalAssum (hiname,hi) ->
-	    let hi_ind, hi_args = decompose_app hi in
+	    let hi_ind, hi_args = decompose_app sigma hi in
 	    let hi_is_ind = (* hi est d'un type globalisable *)
-	      match kind_of_term hi_ind with
+	      match EConstr.kind sigma hi_ind with
 		| Ind (mind,_)  -> true
 		| Var _ -> true
 		| Const _ -> true
@@ -3893,7 +3955,7 @@ let compute_elim_sig ?elimc elimt =
 	    else (* Last arg is the indarg *)
 	      res := {!res with
 		indarg = Some (List.hd !res.args);
-		indarg_in_concl = occur_rel 1 ccl;
+		indarg_in_concl = occur_rel sigma 1 ccl;
 		args = List.tl !res.args; nargs = !res.nargs - 1;
 	      };
 	    raise Exit);
@@ -3903,49 +3965,49 @@ let compute_elim_sig ?elimc elimt =
       | None -> !res (* No indref *)
       | Some (LocalDef _) -> error_ind_scheme ""
       | Some (LocalAssum (_,ind)) ->
-	  let indhd,indargs = decompose_app ind in
-	  try {!res with indref = Some (global_of_constr indhd) }
+	  let indhd,indargs = decompose_app sigma ind in
+	  try {!res with indref = Some (fst (Termops.global_of_constr sigma indhd)) }
 	  with e when CErrors.noncritical e ->
             error "Cannot find the inductive type of the inductive scheme."
 
-let compute_scheme_signature scheme names_info ind_type_guess =
+let compute_scheme_signature evd scheme names_info ind_type_guess =
   let open Context.Rel.Declaration in
-  let f,l = decompose_app scheme.concl in
+  let f,l = decompose_app evd scheme.concl in
   (* Vérifier que les arguments de Qi sont bien les xi. *)
   let cond, check_concl =
     match scheme.indarg with
       | Some (LocalDef _) ->
 	  error "Strange letin, cannot recognize an induction scheme."
       | None -> (* Non standard scheme *)
-	  let cond hd = Term.eq_constr hd ind_type_guess && not scheme.farg_in_concl
+	  let cond hd = EConstr.eq_constr evd hd ind_type_guess && not scheme.farg_in_concl
 	  in (cond, fun _ _ -> ())
       | Some (LocalAssum (_,ind)) -> (* Standard scheme from an inductive type *)
-	  let indhd,indargs = decompose_app ind in
-	  let cond hd = Term.eq_constr hd indhd in
+	  let indhd,indargs = decompose_app evd ind in
+	  let cond hd = EConstr.eq_constr evd hd indhd in
 	  let check_concl is_pred p =
 	    (* Check again conclusion *)
 	    let ccl_arg_ok = is_pred (p + scheme.nargs + 1) f == IndArg in
 	    let ind_is_ok =
-	      List.equal Term.eq_constr
+	      List.equal (fun c1 c2 -> EConstr.eq_constr evd c1 c2)
 		(List.lastn scheme.nargs indargs)
-		(Context.Rel.to_extended_list 0 scheme.args) in
+		(Context.Rel.to_extended_list mkRel 0 scheme.args) in
 	    if not (ccl_arg_ok && ind_is_ok) then
 	      error_ind_scheme "the conclusion of"
 	  in (cond, check_concl)
   in
   let is_pred n c =
-    let hd = fst (decompose_app c) in
-    match kind_of_term hd with
+    let hd = fst (decompose_app evd c) in
+    match EConstr.kind evd hd with
       | Rel q when n < q && q <= n+scheme.npredicates -> IndArg
       | _ when cond hd -> RecArg
       | _ -> OtherArg
   in
   let rec check_branch p c =
-    match kind_of_term c with
+    match EConstr.kind evd c with
       | Prod (_,t,c) ->
-	(is_pred p t, true, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(is_pred p t, true, not (Vars.noccurn evd 1 c)) :: check_branch (p+1) c
       | LetIn (_,_,_,c) ->
-	(OtherArg, false, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(OtherArg, false, not (Vars.noccurn evd 1 c)) :: check_branch (p+1) c
       | _ when is_pred p c == IndArg -> []
       | _ -> raise Exit
   in
@@ -3977,55 +4039,59 @@ let compute_scheme_signature scheme names_info ind_type_guess =
    the non standard case, naming of generated hypos is slightly
    different. *)
 let compute_elim_signature (evd,(elimc,elimt),ind_type_guess) names_info =
-  let scheme = compute_elim_sig ~elimc:elimc elimt in
-    evd, (compute_scheme_signature scheme names_info ind_type_guess, scheme)
+  let scheme = compute_elim_sig evd ~elimc:elimc elimt in
+    evd, (compute_scheme_signature evd scheme names_info ind_type_guess, scheme)
 
 let guess_elim isrec dep s hyp0 gl =
   let tmptyp0 =	Tacmach.New.pf_get_hyp_typ hyp0 gl in
-  let mind,_ = Tacmach.New.pf_reduce_to_quantified_ind gl tmptyp0 in
+  let (mind, u), _ = Tacmach.New.pf_reduce_to_quantified_ind gl tmptyp0 in
   let evd, elimc =
-    if isrec && not (is_nonrec (fst mind)) then find_ind_eliminator (fst mind) s gl
+    if isrec && not (is_nonrec mind) then find_ind_eliminator mind s gl
     else
       let env = Tacmach.New.pf_env gl in
-      let sigma = Sigma.Unsafe.of_evar_map (Tacmach.New.project gl) in
-      if use_dependent_propositions_elimination () && dep
-      then
-        let Sigma (ind, sigma, _) = build_case_analysis_scheme env sigma mind true s in
-        (Sigma.to_evar_map sigma, ind)
+      let sigma = Tacmach.New.project gl in
+      let u = EInstance.kind (Tacmach.New.project gl) u in
+      if dep then
+        let (sigma, ind) = build_case_analysis_scheme env sigma (mind, u) true s in
+        let ind = EConstr.of_constr ind in
+        (sigma, ind)
       else
-        let Sigma (ind, sigma, _) = build_case_analysis_scheme_default env sigma mind s in
-        (Sigma.to_evar_map sigma, ind)
+        let (sigma, ind) = build_case_analysis_scheme_default env sigma (mind, u) s in
+        let ind = EConstr.of_constr ind in
+        (sigma, ind)
   in
   let elimt = Tacmach.New.pf_unsafe_type_of gl elimc in
-    evd, ((elimc, NoBindings), elimt), mkIndU mind
+    evd, ((elimc, NoBindings), elimt), mkIndU (mind, u)
 
 let given_elim hyp0 (elimc,lbind as e) gl =
+  let sigma = Tacmach.New.project gl in
   let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 gl in
-  let ind_type_guess,_ = decompose_app ((strip_prod tmptyp0)) in
-  Tacmach.New.project gl, (e, Tacmach.New.pf_unsafe_type_of gl elimc), ind_type_guess
+  let ind_type_guess,_ = decompose_app sigma (snd (decompose_prod sigma tmptyp0)) in
+  let elimt = Tacmach.New.pf_unsafe_type_of gl elimc in
+  Tacmach.New.project gl, (e, elimt), ind_type_guess
 
 type scheme_signature =
-    (Id.t list * (elim_arg_kind * bool * bool * Id.t) list) array
+    (Id.Set.t * (elim_arg_kind * bool * bool * Id.t) list) array
 
 type eliminator_source =
-  | ElimUsing of (eliminator * types) * scheme_signature
+  | ElimUsing of (eliminator * EConstr.types) * scheme_signature
   | ElimOver of bool * Id.t
 
 let find_induction_type isrec elim hyp0 gl =
+  let sigma = Tacmach.New.project gl in
   let scheme,elim =
     match elim with
     | None ->
        let sort = Tacticals.New.elimination_sort_of_goal gl in
-       let _, (elimc,elimt),_ = 
-	 guess_elim isrec (* dummy: *) true sort hyp0 gl in
-	let scheme = compute_elim_sig ~elimc elimt in
-	(* We drop the scheme waiting to know if it is dependent *)
-	scheme, ElimOver (isrec,hyp0)
+       let _, (elimc,elimt),_ = guess_elim isrec false sort hyp0 gl in
+       let scheme = compute_elim_sig sigma ~elimc elimt in
+       (* We drop the scheme waiting to know if it is dependent *)
+       scheme, ElimOver (isrec,hyp0)
     | Some e ->
 	let evd, (elimc,elimt),ind_guess = given_elim hyp0 e gl in
-	let scheme = compute_elim_sig ~elimc elimt in
+	let scheme = compute_elim_sig sigma ~elimc elimt in
 	if Option.is_empty scheme.indarg then error "Cannot find induction type";
-	let indsign = compute_scheme_signature scheme hyp0 ind_guess in
+	let indsign = compute_scheme_signature evd scheme hyp0 ind_guess in
 	let elim = ({elimindex = Some(-1); elimbody = elimc; elimrename = None},elimt) in
 	scheme, ElimUsing (elim,indsign)
   in
@@ -4037,7 +4103,8 @@ let get_elim_signature elim hyp0 gl =
   compute_elim_signature (given_elim hyp0 elim gl) hyp0
 
 let is_functional_induction elimc gl =
-  let scheme = compute_elim_sig ~elimc (Tacmach.New.pf_unsafe_type_of gl (fst elimc)) in
+  let sigma = Tacmach.New.project gl in
+  let scheme = compute_elim_sig sigma ~elimc (Tacmach.New.pf_unsafe_type_of gl (fst elimc)) in
   (* The test is not safe: with non-functional induction on non-standard
      induction scheme, this may fail *)
   Option.is_empty scheme.indarg
@@ -4046,27 +4113,28 @@ let is_functional_induction elimc gl =
    need a dependent one or not *)
 
 let get_eliminator elim dep s gl =
-  let open Context.Rel.Declaration in
   match elim with
   | ElimUsing (elim,indsign) ->
       Tacmach.New.project gl, (* bugged, should be computed *) true, elim, indsign
   | ElimOver (isrec,id) ->
       let evd, (elimc,elimt),_ as elims = guess_elim isrec dep s id gl in
       let _, (l, s) = compute_elim_signature elims id in
-      let branchlengthes = List.map (fun d -> assert (is_local_assum d); pi1 (decompose_prod_letin (get_type d))) (List.rev s.branches) in
+      let branchlengthes = List.map (fun d -> assert (RelDecl.is_local_assum d); pi1 (decompose_prod_letin (Tacmach.New.project gl) (RelDecl.get_type d)))
+                                    (List.rev s.branches)
+      in
       evd, isrec, ({elimindex = None; elimbody = elimc; elimrename = Some (isrec,Array.of_list branchlengthes)}, elimt), l
 
 (* Instantiate all meta variables of elimclause using lid, some elts
    of lid are parameters (first ones), the other are
    arguments. Returns the clause obtained.  *)
 let recolle_clenv i params args elimclause gl =
-  let _,arr = destApp elimclause.templval.rebus in
+  let _,arr = destApp elimclause.evd elimclause.templval.rebus in
   let lindmv =
     Array.map
       (fun x ->
-	match kind_of_term x with
+	match EConstr.kind elimclause.evd x with
 	  | Meta mv -> mv
-	  | _  -> errorlabstrm "elimination_clause"
+	  | _  -> user_err ~hdr:"elimination_clause"
               (str "The type of the elimination clause is not well-formed."))
       arr in
   let k = match i with -1 -> Array.length lindmv - List.length args | _ -> i in
@@ -4085,7 +4153,7 @@ let recolle_clenv i params args elimclause gl =
       (* from_n (Some 0) means that x should be taken "as is" without
          trying to unify (which would lead to trying to apply it to
          evars if y is a product). *)
-      let indclause  = Tacmach.New.of_old (fun gl -> mk_clenv_from_n gl (Some 0) (x,y)) gl in
+      let indclause  = mk_clenv_from_n gl (Some 0) (x,y) in
       let elimclause' = clenv_fchain ~with_univs:false i acc indclause in
       elimclause')
     (List.rev clauses)
@@ -4096,49 +4164,49 @@ let recolle_clenv i params args elimclause gl =
     produce new ones). Then refine with the resulting term with holes.
 *)
 let induction_tac with_evars params indvars elim =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = Tacmach.New.project gl in
   let ({elimindex=i;elimbody=(elimc,lbindelimc);elimrename=rename},elimt) = elim in
-  let i = match i with None -> index_of_ind_arg elimt | Some i -> i in
+  let i = match i with None -> index_of_ind_arg sigma elimt | Some i -> i in
   (* elimclause contains this: (elimc ?i ?j ?k...?l) *)
-  let elimc = contract_letin_in_lam_header elimc in
+  let elimc = contract_letin_in_lam_header sigma elimc in
   let elimc = mkCast (elimc, DEFAULTcast, elimt) in
-  let elimclause = pf_apply make_clenv_binding gl (elimc,elimt) lbindelimc in
+  let elimclause = Tacmach.New.pf_apply make_clenv_binding gl (elimc,elimt) lbindelimc in
   (* elimclause' is built from elimclause by instanciating all args and params. *)
   let elimclause' = recolle_clenv i params indvars elimclause gl in
   (* one last resolution (useless?) *)
-  let resolved = Tacmach.New.of_old (clenv_unique_resolver ~flags:(elim_flags ()) elimclause') gl in
-  enforce_prop_bound_names rename (Clenvtac.clenv_refine with_evars resolved)
-  end }
+  let resolved = clenv_unique_resolver ~flags:(elim_flags ()) elimclause' gl in
+  Clenvtac.clenv_refine with_evars resolved
+  end
 
 (* Apply induction "in place" taking into account dependent
    hypotheses from the context, replacing the main hypothesis on which
    induction applies with the induction hypotheses *)
 
 let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_tac =
-  let open Context.Named.Declaration in
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let sigma = Sigma.to_evar_map sigma in
-    let concl = Tacmach.New.pf_nf_concl gl in
-    let statuslists,lhyp0,toclear,deps,avoid,dep_in_hyps = cook_sign hyp0 inhyps indvars env in
-    let dep_in_concl = Option.cata (fun id -> occur_var env id concl) false hyp0 in
+    let concl = Tacmach.New.pf_concl gl in
+    let statuslists,lhyp0,toclear,deps,avoid,dep_in_hyps = cook_sign hyp0 inhyps indvars env sigma in
+    let dep_in_concl = Option.cata (fun id -> occur_var env sigma id concl) false hyp0 in
     let dep = dep_in_hyps || dep_in_concl in
     let tmpcl = it_mkNamedProd_or_LetIn concl deps in
     let s = Retyping.get_sort_family_of env sigma tmpcl in
     let deps_cstr =
       List.fold_left
-        (fun a decl -> if is_local_assum decl then (mkVar (get_id decl))::a else a) [] deps in
-    let (sigma, isrec, elim, indsign) = get_eliminator elim dep s (Proofview.Goal.assume gl) in
+        (fun a decl -> if NamedDecl.is_local_assum decl then (mkVar (NamedDecl.get_id decl))::a else a) [] deps in
+    let (sigma, isrec, elim, indsign) = get_eliminator elim dep s gl in
     let branchletsigns =
       let f (_,is_not_let,_,_) = is_not_let in
       Array.map (fun (_,l) -> List.map f l) indsign in
     let names = compute_induction_names branchletsigns names in
+    Array.iter (check_name_unicity env toclear []) names;
     let tac =
     (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
       (Tacticals.New.tclTHENLIST [
         (* Generalize dependent hyps (but not args) *)
-        if deps = [] then Proofview.tclUNIT () else apply_type tmpcl deps_cstr;
+        if deps = [] then Proofview.tclUNIT () else apply_type ~typecheck:false tmpcl deps_cstr;
         (* side-conditions in elim (resp case) schemes come last (resp first) *)
         induct_tac elim;
         Tacticals.New.tclMAP expand_hyp toclear;
@@ -4148,16 +4216,16 @@ let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_
             (re_intro_dependent_hypotheses statuslists))
          indsign names)
     in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
+  end
 
 let induction_with_atomization_of_ind_arg isrec with_evars elim names hyp0 inhyps =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let elim_info = find_induction_type isrec elim hyp0 (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+  let elim_info = find_induction_type isrec elim hyp0 gl in
   atomize_param_of_ind_then elim_info hyp0 (fun indvars ->
     apply_induction_in_context with_evars (Some hyp0) inhyps (pi3 elim_info) indvars names
       (fun elim -> induction_tac with_evars [] [hyp0] elim))
-  end }
+  end
 
 let msg_not_right_number_induction_arguments scheme =
   str"Not the right number of induction arguments (expected " ++
@@ -4174,7 +4242,7 @@ let msg_not_right_number_induction_arguments scheme =
    must be given, so we help a bit the unifier by making the "pattern"
    by hand before calling induction_tac *)
 let induction_without_atomization isrec with_evars elim names lid =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma, (indsign,scheme) = get_elim_signature elim (List.hd lid) gl in
   let nargs_indarg_farg =
     scheme.nargs + (if scheme.farg_in_concl then 1 else 0) in
@@ -4193,7 +4261,7 @@ let induction_without_atomization isrec with_evars elim names lid =
        gt_wf_rec was taken as a functional scheme with no parameters,
        but by chance, because of the addition of at least hyp0 for
        cook_sign, it behaved as if there was a real induction arg. *)
-    if indvars = [] then [List.hd lid_params] else indvars in
+    if List.is_empty indvars then Id.Set.singleton (List.hd lid_params) else Id.Set.of_list indvars in
   let induct_tac elim = Tacticals.New.tclTHENLIST [
     (* pattern to make the predicate appear. *)
     reduce (Pattern (List.map inj_with_occurrences lidcstr)) onConcl;
@@ -4205,33 +4273,31 @@ let induction_without_atomization isrec with_evars elim names lid =
   ] in
   let elim = ElimUsing (({elimindex = Some (-1); elimbody = Option.get scheme.elimc; elimrename = None}, scheme.elimt), indsign) in
   apply_induction_in_context with_evars None [] elim indvars names induct_tac
-  end }
+  end
 
 (* assume that no occurrences are selected *)
 let clear_unselected_context id inhyps cls =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let open Context.Named.Declaration in
-  if occur_var (Tacmach.New.pf_env gl) id (Tacmach.New.pf_concl gl) &&
+  Proofview.Goal.enter begin fun gl ->
+  if occur_var (Tacmach.New.pf_env gl) (Tacmach.New.project gl) id (Tacmach.New.pf_concl gl) &&
     cls.concl_occs == NoOccurrences
-  then errorlabstrm ""
-    (str "Conclusion must be mentioned: it depends on " ++ pr_id id
+  then user_err 
+    (str "Conclusion must be mentioned: it depends on " ++ Id.print id
      ++ str ".");
   match cls.onhyps with
   | Some hyps ->
       let to_erase d =
-        let id' = get_id d in
+        let id' = NamedDecl.get_id d in
 	if Id.List.mem id' inhyps then (* if selected, do not erase *) None
 	else
 	  (* erase if not selected and dependent on id or selected hyps *)
-	  let test id = occur_var_in_decl (Tacmach.New.pf_env gl) id d in
+	  let test id = occur_var_in_decl (Tacmach.New.pf_env gl) (Tacmach.New.project gl) id d in
 	  if List.exists test (id::inhyps) then Some id' else None in
       let ids = List.map_filter to_erase (Proofview.Goal.hyps gl) in
       clear ids
   | None -> Proofview.tclUNIT ()
-  end }
+  end
 
 let use_bindings env sigma elim must_be_closed (c,lbind) typ =
-  let sigma = Sigma.to_evar_map sigma in
   let typ =
     if elim == None then
       (* w/o an scheme, the term has to be applied at least until
@@ -4250,11 +4316,10 @@ let use_bindings env sigma elim must_be_closed (c,lbind) typ =
   let rec find_clause typ =
     try
       let indclause = make_clenv_binding env sigma (c,typ) lbind in
-      if must_be_closed && occur_meta (clenv_value indclause) then
+      if must_be_closed && occur_meta indclause.evd (clenv_value indclause) then
         error "Need a fully applied argument.";
       (* We lose the possibility of coercions in with-bindings *)
-      let (sigma, c) = pose_all_metas_as_evars env indclause.evd (clenv_value indclause) in
-      Sigma.Unsafe.of_pair (c, sigma)
+      pose_all_metas_as_evars env indclause.evd (clenv_value indclause)
     with e when catchable_exception e ->
     try find_clause (try_red_product env sigma typ)
     with Redelimination -> raise e in
@@ -4268,20 +4333,19 @@ let check_expected_type env sigma (elimc,bl) elimt =
   if n == 0 then error "Scheme cannot be applied.";
   let sigma,cl = make_evar_clause env sigma ~len:(n - 1) elimt in
   let sigma = solve_evar_clause env sigma true cl bl in
-  let (_,u,_) = destProd cl.cl_concl in
+  let (_,u,_) = destProd sigma cl.cl_concl in
   fun t -> Evarconv.e_cumul env (ref sigma) t u
 
 let check_enough_applied env sigma elim =
-  let sigma = Sigma.to_evar_map sigma in
   (* A heuristic to decide whether the induction arg is enough applied *)
   match elim with
   | None ->
       (* No eliminator given *)
       fun u ->
-      let t,_ = decompose_app (whd_all env sigma u) in isInd t
+      let t,_ = decompose_app sigma (whd_all env sigma u) in isInd sigma t
   | Some elimc ->
       let elimt = Retyping.get_type_of env sigma (fst elimc) in
-      let scheme = compute_elim_sig ~elimc elimt in
+      let scheme = compute_elim_sig sigma ~elimc elimt in
       match scheme.indref with
       | None ->
          (* in the absence of information, do not assume it may be
@@ -4292,28 +4356,32 @@ let check_enough_applied env sigma elim =
           check_expected_type env sigma elimc elimt
 
 let guard_no_unifiable = Proofview.guard_no_unifiable >>= function
-| None -> Proofview.tclUNIT ()
-| Some l -> Proofview.tclZERO (RefinerError (UnresolvedBindings l))
+  | None -> Proofview.tclUNIT ()
+  | Some l ->
+    Proofview.tclENV     >>= function env ->
+    Proofview.tclEVARMAP >>= function sigma ->
+    Proofview.tclZERO (RefinerError (env, sigma, UnresolvedBindings l))
 
 let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
      id ((pending,(c0,lbind)),(eqname,names)) t0 inhyps cls tac =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Proofview.Goal.env gl in
-  let ccl = Proofview.Goal.raw_concl gl in
+  let ccl = Proofview.Goal.concl gl in
   let store = Proofview.Goal.extra gl in
   let check = check_enough_applied env sigma elim in
-  let Sigma (c, sigma', p) = use_bindings env sigma elim false (c0,lbind) t0 in
+  let (sigma', c) = use_bindings env sigma elim false (c0,lbind) t0 in
   let abs = AbstractPattern (from_prefix,check,Name id,(pending,c),cls,false) in
   let (id,sign,_,lastlhyp,ccl,res) = make_abstraction env sigma' ccl abs in
   match res with
   | None ->
       (* pattern not found *)
-      let with_eq = Option.map (fun eq -> (false,eq)) eqname in
+      let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+      let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
       (* we restart using bindings after having tried type-class
          resolution etc. on the term given by the user *)
       let flags = tactic_infer_flags (with_evars && (* do not give a success semantics to edestruct on an open term yet *) false) in
-      let Sigma (c0, sigma, q) = finish_evar_resolution ~flags env sigma (pending,c0) in
+      let (sigma, c0) = finish_evar_resolution ~flags env sigma (pending,c0) in
       let tac =
       (if isrec then
           (* Historically, induction has side conditions last *)
@@ -4322,68 +4390,68 @@ let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
           (* and destruct has side conditions first *)
           Tacticals.New.tclTHENLAST)
       (Tacticals.New.tclTHENLIST [
-        Refine.refine ~unsafe:true { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           let b = not with_evars && with_eq != None in
-          let Sigma (c, sigma, p) = use_bindings env sigma elim b (c0,lbind) t0 in
-          let t = Retyping.get_type_of env (Sigma.to_evar_map sigma) c in
-          let Sigma (ans, sigma, q) = mkletin_goal env sigma store with_eq false (id,lastlhyp,ccl,c) (Some t) in
-          Sigma (ans, sigma, p +> q)
-        end };
+          let (sigma, c) = use_bindings env sigma elim b (c0,lbind) t0 in
+          let t = Retyping.get_type_of env sigma c in
+          mkletin_goal env sigma store with_eq false (id,lastlhyp,ccl,c) (Some t)
+        end;
         if with_evars then Proofview.shelve_unifiable else guard_no_unifiable;
         if is_arg_pure_hyp
-        then Tacticals.New.tclTRY (clear [destVar c0])
+        then Proofview.tclEVARMAP >>= fun sigma -> Tacticals.New.tclTRY (clear [destVar sigma c0])
         else Proofview.tclUNIT ();
         if isrec then Proofview.cycle (-1) else Proofview.tclUNIT ()
       ])
-      tac
+      (tac inhyps)
       in
-      Sigma (tac, sigma, q)
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
 
-  | Some (Sigma (c, sigma', q)) ->
+  | Some (sigma', c) ->
       (* pattern found *)
-      let with_eq = Option.map (fun eq -> (false,eq)) eqname in
       (* TODO: if ind has predicate parameters, use JMeq instead of eq *)
       let env = reset_with_named_context sign env in
+      let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+      let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
       let tac =
       Tacticals.New.tclTHENLIST [
-        Refine.refine ~unsafe:true { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           mkletin_goal env sigma store with_eq true (id,lastlhyp,ccl,c) None
-        end };
-        tac
+        end;
+        (tac inhyps)
       ]
       in
-      Sigma (tac, sigma', p +> q)
-  end }
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma') tac
+  end
 
-let has_generic_occurrences_but_goal cls id env ccl =
+let has_generic_occurrences_but_goal cls id env sigma ccl =
   clause_with_generic_context_selection cls &&
   (* TODO: whd_evar of goal *)
-  (cls.concl_occs != NoOccurrences || not (occur_var env id ccl))
+  (cls.concl_occs != NoOccurrences || not (occur_var env sigma id ccl))
 
 let induction_gen clear_flag isrec with_evars elim
     ((_pending,(c,lbind)),(eqname,names) as arg) cls =
   let inhyps = match cls with
   | Some {onhyps=Some hyps} -> List.map (fun ((_,id),_) -> id) hyps
   | _ -> [] in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let ccl = Proofview.Goal.raw_concl gl in
+  let evd = Proofview.Goal.sigma gl in
+  let ccl = Proofview.Goal.concl gl in
   let cls = Option.default allHypsAndConcl cls in
-  let t = typ_of env sigma c in
+  let t = typ_of env evd c in
   let is_arg_pure_hyp =
-    isVar c && not (mem_named_context_val (destVar c) (Global.named_context_val ()))
+    isVar evd c && not (mem_named_context_val (destVar evd c) (Global.named_context_val ()))
     && lbind == NoBindings && not with_evars && Option.is_empty eqname
     && clear_flag == None
-    && has_generic_occurrences_but_goal cls (destVar c) env ccl in
-  let enough_applied = check_enough_applied env sigma elim t in
+    && has_generic_occurrences_but_goal cls (destVar evd c) env evd ccl in
+  let enough_applied = check_enough_applied env evd elim t in
   if is_arg_pure_hyp && enough_applied then
     (* First case: induction on a variable already in an inductive type and
        with maximal abstraction over the variable.
        This is a situation where the induction argument is a
        clearable variable of the goal w/o occurrence selection
        and w/o equality kept: no need to generalize *)
-    let id = destVar c in
+    let id = destVar evd c in
     Tacticals.New.tclTHEN
       (clear_unselected_context id inhyps cls)
       (induction_with_atomization_of_ind_arg
@@ -4393,14 +4461,14 @@ let induction_gen clear_flag isrec with_evars elim
      declaring the induction argument as a new local variable *)
     let id =
     (* Type not the right one if partially applied but anyway for internal use*)
-      let x = id_of_name_using_hdchar (Global.env()) t Anonymous in
-      new_fresh_id [] x gl in
+      let x = id_of_name_using_hdchar env evd t Anonymous in
+      new_fresh_id Id.Set.empty x gl in
     let info_arg = (is_arg_pure_hyp, not enough_applied) in
     pose_induction_arg_then
       isrec with_evars info_arg elim id arg t inhyps cls
     (induction_with_atomization_of_ind_arg
-       isrec with_evars elim names id inhyps)
-  end }
+       isrec with_evars elim names id)
+  end 
 
 (* Induction on a list of arguments. First make induction arguments
    atomic (using letins), then do induction. The specificity here is
@@ -4411,32 +4479,35 @@ let induction_gen_l isrec with_evars elim names lc =
   let newlc = ref [] in
   let lc = List.map (function
     | (c,None) -> c
-    | (c,Some(loc,eqname)) ->
-      user_err_loc (loc,"",str "Do not know what to do with " ++
+    | (c,Some{CAst.loc;v=eqname}) ->
+      user_err ?loc  (str "Do not know what to do with " ++
                          Miscprint.pr_intro_pattern_naming eqname)) lc in
   let rec atomize_list l =
     match l with
       | [] -> Proofview.tclUNIT ()
       | c::l' ->
-	  match kind_of_term c with
+          Proofview.tclEVARMAP >>= fun sigma ->
+	  match EConstr.kind sigma c with
 	    | Var id when not (mem_named_context_val id (Global.named_context_val ()))
 		&& not with_evars ->
 		let _ = newlc:= id::!newlc in
 		atomize_list l'
 
 	    | _ ->
-                Proofview.Goal.enter { enter = begin fun gl ->
+                Proofview.Goal.enter begin fun gl ->
                 let type_of = Tacmach.New.pf_unsafe_type_of gl in
+                let sigma = Tacmach.New.project gl in
+                Proofview.tclENV >>= fun env ->
                 let x =
-		  id_of_name_using_hdchar (Global.env()) (type_of c) Anonymous in
+		  id_of_name_using_hdchar env sigma (type_of c) Anonymous in
 
-                let id = new_fresh_id [] x gl in
-		let newl' = List.map (replace_term c (mkVar id)) l' in
+                let id = new_fresh_id Id.Set.empty x gl in
+		let newl' = List.map (fun r -> replace_term sigma c (mkVar id) r) l' in
 		let _ = newlc:=id::!newlc in
 		Tacticals.New.tclTHEN
 		  (letin_tac None (Name id) c None allHypsAndConcl)
 		  (atomize_list newl')
-                end } in
+                end in
   Tacticals.New.tclTHENLIST
     [
       (atomize_list lc);
@@ -4453,7 +4524,7 @@ let induction_destruct isrec with_evars (lc,elim) =
   match lc with
   | [] -> assert false (* ensured by syntax, but if called inside caml? *)
   | [c,(eqname,names as allnames),cls] ->
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     match elim with
@@ -4470,9 +4541,9 @@ let induction_destruct isrec with_evars (lc,elim) =
       (* standard induction *)
       onOpenInductionArg env sigma
       (fun clear_flag c -> induction_gen clear_flag isrec with_evars elim (c,allnames) cls) c
-    end }
+    end
   | _ ->
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     match elim with
@@ -4488,12 +4559,12 @@ let induction_destruct isrec with_evars (lc,elim) =
         (onOpenInductionArg env sigma (fun clear_flag a ->
           induction_gen clear_flag isrec with_evars None (a,b) cl) a)
         (Tacticals.New.tclMAP (fun (a,b,cl) ->
-          Proofview.Goal.enter { enter = begin fun gl ->
+          Proofview.Goal.enter begin fun gl ->
           let env = Proofview.Goal.env gl in
-          let sigma = Tacmach.New.project gl in      
+          let sigma = Tacmach.New.project gl in
           onOpenInductionArg env sigma (fun clear_flag a ->
             induction_gen clear_flag false with_evars None (a,b) cl) a
-          end }) l)
+          end) l)
     | Some elim ->
       (* Several induction hyps with induction scheme *)
       let lc = List.map (on_pi1 (fun c -> snd (force_destruction_arg false env sigma c))) lc in
@@ -4512,39 +4583,15 @@ let induction_destruct isrec with_evars (lc,elim) =
         error "'as' clause with multiple arguments and 'using' clause can only occur last.";
       let newlc = List.map (fun (x,_) -> (x,None)) newlc in
       induction_gen_l isrec with_evars elim names newlc
-    end }
+    end
 
 let induction ev clr c l e =
-  induction_gen clr true ev e 
-    (((Evd.empty,Evd.empty),(c,NoBindings)),(None,l)) None
+  induction_gen clr true ev e
+    ((Evd.empty,(c,NoBindings)),(None,l)) None
 
 let destruct ev clr c l e =
   induction_gen clr false ev e
-    (((Evd.empty,Evd.empty),(c,NoBindings)),(None,l)) None
-
-(* The registered tactic, which calls the default elimination
- * if no elimination constant is provided. *)
-
-(* Induction tactics *)
-
-(* This was Induction before 6.3 (induction only in quantified premisses) *)
-let simple_induct_id s = Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_elim)
-let simple_induct_nodep n = Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_elim)
-
-let simple_induct = function
-  | NamedHyp id -> simple_induct_id id
-  | AnonHyp n -> simple_induct_nodep n
-
-(* Destruction tactics *)
-
-let simple_destruct_id s    =
-  (Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_case))
-let simple_destruct_nodep n =
-  (Tacticals.New.tclTHEN (intros_until_n n)    (Tacticals.New.onLastHyp simplest_case))
-
-let simple_destruct = function
-  | NamedHyp id -> simple_destruct_id id
-  | AnonHyp n -> simple_destruct_nodep n
+    ((Evd.empty,(c,NoBindings)),(None,l)) None
 
 (*
  *  Eliminations giving the type instead of the proof.
@@ -4554,34 +4601,36 @@ let simple_destruct = function
  *)
 
 let elim_scheme_type elim t =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let clause = Tacmach.New.of_old (fun gl -> mk_clenv_type_of gl elim) gl in
-  match kind_of_term (last_arg clause.templval.rebus) with
+  Proofview.Goal.enter begin fun gl ->
+  let clause = mk_clenv_type_of gl elim in
+  match EConstr.kind clause.evd (last_arg clause.evd clause.templval.rebus) with
     | Meta mv ->
         let clause' =
 	  (* t is inductive, then CUMUL or CONV is irrelevant *)
 	  clenv_unify ~flags:(elim_flags ()) Reduction.CUMUL t
             (clenv_meta_type clause mv) clause in
 	Clenvtac.res_pf clause' ~flags:(elim_flags ()) ~with_evars:false
-    | _ -> anomaly (Pp.str "elim_scheme_type")
-  end }
+    | _ -> anomaly (Pp.str "elim_scheme_type.")
+  end
 
 let elim_type t =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let (ind,t) = Tacmach.New.pf_apply reduce_to_atomic_ind gl t in
   let evd, elimc = find_ind_eliminator (fst ind) (Tacticals.New.elimination_sort_of_goal gl) gl in
-  Sigma.Unsafe.of_pair (elim_scheme_type elimc t, evd)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
+  end
 
 let case_type t =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Tacmach.New.pf_env gl in
-  let (ind,t) = reduce_to_atomic_ind env (Sigma.to_evar_map sigma) t in
+  let ((ind, u), t) = reduce_to_atomic_ind env sigma t in
+  let u = EInstance.kind sigma u in
   let s = Tacticals.New.elimination_sort_of_goal gl in
-  let Sigma (elimc, evd, p) = build_case_analysis_scheme_default env sigma ind s in
-  Sigma (elim_scheme_type elimc t, evd, p)
-  end }
+  let (evd, elimc) = build_case_analysis_scheme_default env sigma (ind, u) s in
+  let elimc = EConstr.of_constr elimc in
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
+  end
 
 
 (************************************************)
@@ -4593,7 +4642,7 @@ let case_type t =
 let (forward_setoid_reflexivity, setoid_reflexivity) = Hook.make ()
 
 let maybe_betadeltaiota_concl allowred gl =
-  let concl = Tacmach.New.pf_nf_concl gl in
+  let concl = Tacmach.New.pf_concl gl in
   let sigma = Tacmach.New.project gl in
   if not allowred then concl
   else
@@ -4601,15 +4650,16 @@ let maybe_betadeltaiota_concl allowred gl =
     whd_all env sigma concl
 
 let reflexivity_red allowred =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual reflexivity don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+    let sigma = Tacmach.New.project gl in
     let concl = maybe_betadeltaiota_concl allowred gl in
-    match match_with_equality_type concl with
+    match match_with_equality_type sigma concl with
     | None -> Proofview.tclZERO NoEquationFound
     | Some _ -> one_constructor 1 NoBindings
-  end }
+  end
 
 let reflexivity =
   Proofview.tclORELSE
@@ -4643,27 +4693,29 @@ let prove_symmetry hdcncl eq_kind =
         Tacticals.New.onLastHyp simplest_case;
 	one_constructor 1 NoBindings ])
 
-let match_with_equation c =
+let match_with_equation sigma c =
+  Proofview.tclENV >>= fun env ->
   try
-    let res = match_with_equation c in
+    let res = match_with_equation env sigma c in
     Proofview.tclUNIT res
   with NoEquationFound ->
     Proofview.tclZERO NoEquationFound
 
 let symmetry_red allowred =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual symmetry don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+  let sigma = Tacmach.New.project gl in
   let concl = maybe_betadeltaiota_concl allowred gl in
-  match_with_equation concl >>= fun with_eqn ->
+  match_with_equation sigma concl >>= fun with_eqn ->
   match with_eqn with
   | Some eq_data,_,_ ->
       Tacticals.New.tclTHEN
         (convert_concl_no_check concl DEFAULTcast)
-        (Tacticals.New.pf_constr_of_global eq_data.sym apply)
+        (Tacticals.New.pf_constr_of_global eq_data.sym >>= apply)
   | None,eq,eq_kind -> prove_symmetry eq eq_kind
-  end }
+  end
 
 let symmetry =
   Proofview.tclORELSE
@@ -4677,17 +4729,19 @@ let (forward_setoid_symmetry_in, setoid_symmetry_in) = Hook.make ()
 
 
 let symmetry_in id =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = Tacmach.New.project gl in
   let ctype = Tacmach.New.pf_unsafe_type_of gl (mkVar id) in
-  let sign,t = decompose_prod_assum ctype in
+  let sign,t = decompose_prod_assum sigma ctype in
   Proofview.tclORELSE
     begin
-      match_with_equation t >>= fun (_,hdcncl,eq) ->
-        let symccl = match eq with
+      match_with_equation sigma t >>= fun (_,hdcncl,eq) ->
+        let symccl =
+          match eq with
           | MonomorphicLeibnizEq (c1,c2) -> mkApp (hdcncl, [| c2; c1 |])
           | PolymorphicLeibnizEq (typ,c1,c2) -> mkApp (hdcncl, [| typ; c2; c1 |])
           | HeterogenousEq (t1,c1,t2,c2) -> mkApp (hdcncl, [| t2; c2; t1; c1 |]) in
-        Tacticals.New.tclTHENS (cut (it_mkProd_or_LetIn symccl sign))
+        Tacticals.New.tclTHENS (cut (EConstr.it_mkProd_or_LetIn symccl sign))
           [ intro_replacing id;
             Tacticals.New.tclTHENLIST [ intros; symmetry; apply (mkVar id); assumption ] ]
     end
@@ -4695,7 +4749,7 @@ let symmetry_in id =
       | NoEquationFound -> Hook.get forward_setoid_symmetry_in id
       | e -> Proofview.tclZERO ~info e
     end
-  end }
+  end
 
 let intros_symmetry =
   Tacticals.New.onClause
@@ -4720,7 +4774,7 @@ let (forward_setoid_transitivity, setoid_transitivity) = Hook.make ()
 
 (* This is probably not very useful any longer *)
 let prove_transitivity hdcncl eq_kind t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let (eq1,eq2) = match eq_kind with
   | MonomorphicLeibnizEq (c1,c2) ->
       mkApp (hdcncl, [| c1; t|]), mkApp (hdcncl, [| t; c2 |])
@@ -4740,27 +4794,28 @@ let prove_transitivity hdcncl eq_kind t =
 	  [ Tacticals.New.tclDO 2 intro;
 	    Tacticals.New.onLastHyp simplest_case;
 	    assumption ]))
-  end }
+  end
 
 let transitivity_red allowred t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual transitivity don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+  let sigma = Tacmach.New.project gl in
   let concl = maybe_betadeltaiota_concl allowred gl in
-  match_with_equation concl >>= fun with_eqn ->
+  match_with_equation sigma concl >>= fun with_eqn ->
   match with_eqn with
   | Some eq_data,_,_ ->
       Tacticals.New.tclTHEN
         (convert_concl_no_check concl DEFAULTcast)
         (match t with
-	  | None -> Tacticals.New.pf_constr_of_global eq_data.trans eapply
-	  | Some t -> Tacticals.New.pf_constr_of_global eq_data.trans (fun trans -> apply_list [trans;t]))
+	  | None -> Tacticals.New.pf_constr_of_global eq_data.trans >>= eapply
+	  | Some t -> Tacticals.New.pf_constr_of_global eq_data.trans >>= fun trans -> apply_list [trans; t])
    | None,eq,eq_kind ->
       match t with
       | None -> Tacticals.New.tclZEROMSG (str"etransitivity not supported for this relation.")
       | Some t -> prove_transitivity eq eq_kind t
-  end }
+  end
 
 let transitivity_gen t =
   Proofview.tclORELSE
@@ -4780,18 +4835,24 @@ let intros_transitivity  n  = Tacticals.New.tclTHEN intros (transitivity_gen n)
    is solved by tac *)
 
 (** d1 is the section variable in the global context, d2 in the goal context *)
-let interpretable_as_section_decl evd d1 d2 =
+let interpretable_as_section_decl env evd d1 d2 =
   let open Context.Named.Declaration in
+  let e_eq_constr_univs sigma c1 c2 = match eq_constr_universes env !sigma c1 c2 with
+  | None -> false
+  | Some cstr ->
+    try ignore (Evd.add_universe_constraints !sigma cstr); true
+    with UniversesDiffer -> false
+  in
   match d2, d1 with
   | LocalDef _, LocalAssum _ -> false
   | LocalDef (_,b1,t1), LocalDef (_,b2,t2) ->
     e_eq_constr_univs evd b1 b2 && e_eq_constr_univs evd t1 t2
-  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (get_type d2)
+  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (NamedDecl.get_type d2)
 
 let rec decompose len c t accu =
   let open Context.Rel.Declaration in
   if len = 0 then (c, t, accu)
-  else match kind_of_term c, kind_of_term t with 
+  else match Constr.kind c, Constr.kind t with 
   | Lambda (na, u, c), Prod (_, _, t) ->
     decompose (pred len) c t (LocalAssum (na, u) :: accu)
   | LetIn (na, b, u, c), LetIn (_, _, _, t) ->
@@ -4799,7 +4860,8 @@ let rec decompose len c t accu =
   | _ -> assert false
 
 let rec shrink ctx sign c t accu =
-  let open Context.Rel.Declaration in
+  let open Constr in
+  let open CVars in
   match ctx, sign with
   | [], [] -> (c, t, accu)
   | p :: ctx, decl :: sign ->
@@ -4808,11 +4870,11 @@ let rec shrink ctx sign c t accu =
         let t = subst1 mkProp t in
         shrink ctx sign c t accu
       else
-        let c = mkLambda_or_LetIn p c in
-        let t = mkProd_or_LetIn p t in
-        let accu = if is_local_assum p then let open Context.Named.Declaration in
-                                            mkVar (get_id decl) :: accu
-                                       else accu
+        let c = Term.mkLambda_or_LetIn p c in
+        let t = Term.mkProd_or_LetIn p t in
+        let accu = if RelDecl.is_local_assum p
+                   then mkVar (NamedDecl.get_id decl) :: accu
+                   else accu
     in
     shrink ctx sign c t accu
 | _ -> assert false
@@ -4834,28 +4896,30 @@ let shrink_entry sign const =
   } in
   (const, args)
 
-let abstract_subproof id gk tac =
+let cache_term_by_tactic_then ~opaque ?(goal_type=None) id gk tac tacK =
   let open Tacticals.New in
   let open Tacmach.New in
   let open Proofview.Notations in
-  let open Context.Named.Declaration in
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let current_sign = Global.named_context_val ()
   and global_sign = Proofview.Goal.hyps gl in
-  let sigma = Sigma.to_evar_map sigma in
   let evdref = ref sigma in
   let sign,secsign =
     List.fold_right
       (fun d (s1,s2) ->
-        let id = get_id d in
+        let id = NamedDecl.get_id d in
 	if mem_named_context_val id current_sign &&
-          interpretable_as_section_decl evdref (lookup_named_val id current_sign) d
+          interpretable_as_section_decl env evdref (lookup_named_val id current_sign) d
         then (s1,push_named_context_val d s2)
 	else (Context.Named.add d s1,s2))
       global_sign (Context.Named.empty, empty_named_context_val) in
-  let id = next_global_ident_away id (pf_ids_of_hyps gl) in
-  let concl = it_mkNamedProd_or_LetIn (Proofview.Goal.concl gl) sign in
+  let id = next_global_ident_away id (pf_ids_set_of_hyps gl) in
+  let concl = match goal_type with
+              | None ->  Proofview.Goal.concl gl
+              | Some ty -> ty in
+  let concl = it_mkNamedProd_or_LetIn concl sign in
   let concl =
     try flush_and_check_evars !evdref concl
     with Uninstantiated_evar _ ->
@@ -4867,6 +4931,7 @@ let abstract_subproof id gk tac =
     let ctx = Evd.universe_context_set evd in
       evd, ctx, nf concl
   in
+  let concl = EConstr.of_constr concl in
   let solve_tac = tclCOMPLETE (tclTHEN (tclDO (List.length sign) intro) tac) in
   let ectx = Evd.evar_universe_context evd in
   let (const, safe, ectx) =
@@ -4879,12 +4944,10 @@ let abstract_subproof id gk tac =
     let (_, info) = CErrors.push src in
     iraise (e, info)
   in
-  let const, args =
-    if !shrink_abstract then shrink_entry sign const
-    else (const, List.rev (Context.Named.to_instance sign))
-  in
-  let cd = Entries.DefinitionEntry const in
-  let decl = (cd, IsProof Lemma) in
+  let const, args = shrink_entry sign const in
+  let args = List.map EConstr.of_constr args in
+  let cd = Entries.DefinitionEntry { const with Entries.const_entry_opaque = opaque } in
+  let decl = (cd, if opaque then IsProof Lemma else IsDefinition Definition) in
   let cst () =
     (** do not compute the implicit arguments, it may be costly *)
     let () = Impargs.make_implicit_args false in
@@ -4892,8 +4955,21 @@ let abstract_subproof id gk tac =
     Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl
   in
   let cst = Impargs.with_implicit_protection cst () in
-  (* let evd, lem = Evd.fresh_global (Global.env ()) evd (ConstRef cst) in *)
-  let lem, ctx = Universes.unsafe_constr_of_global (ConstRef cst) in
+  let lem =
+    match const.Entries.const_entry_universes with
+    | Entries.Polymorphic_const_entry uctx ->
+      let uctx = Univ.ContextSet.of_context uctx in
+      (** Hack: the kernel may generate definitions whose universe variables are
+          not the same as requested in the entry because of constraints delayed
+          in the body, even in polymorphic mode. We mimick what it does for now
+          in hope it is fixed at some point. *)
+      let (_, body_uctx), _ = Future.force const.Entries.const_entry_body in
+      let uctx = Univ.ContextSet.to_context (Univ.ContextSet.union uctx body_uctx) in
+      let u = Univ.UContext.instance uctx in
+      mkConstU (cst, EInstance.make u)
+    | Entries.Monomorphic_const_entry _ ->
+      mkConst cst
+  in
   let evd = Evd.set_universe_context evd ectx in
   let open Safe_typing in
   let eff = private_con_of_con (Global.safe_env ()) cst in
@@ -4901,31 +4977,39 @@ let abstract_subproof id gk tac =
     Entries.(snd (Future.force const.const_entry_body)) in
   let solve =
     Proofview.tclEFFECTS effs <*>
-    exact_no_check (applist (lem, args))
+    tacK lem args
   in
   let tac = if not safe then Proofview.mark_as_unsafe <*> solve else solve in
-  Sigma.Unsafe.of_pair (tac, evd)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) tac
+  end
+
+let abstract_subproof ~opaque id gk tac =
+  cache_term_by_tactic_then ~opaque id gk tac (fun lem args -> exact_no_check (applist (lem, args)))
 
 let anon_id = Id.of_string "anonymous"
 
-let tclABSTRACT name_op tac =
+let name_op_to_name name_op object_kind suffix =
   let open Proof_global in
-  let default_gk = (Global, false, Proof Theorem) in
-  let s, gk = match name_op with
-    | Some s ->
-      (try let _, gk, _ = current_proof_statement () in s, gk
-       with NoCurrentProof -> s, default_gk)
-    | None   ->
-      let name, gk =
-	try let name, gk, _ = current_proof_statement () in name, gk
-	with NoCurrentProof -> anon_id, default_gk in
-      add_suffix name "_subproof", gk
+  let default_gk = (Global, false, object_kind) in
+  let name, gk = match Proof_global.V82.get_current_initial_conclusions () with
+  | (id, (_, gk)) -> Some id, gk
+  | exception NoCurrentProof -> None, default_gk
   in
-  abstract_subproof s gk tac
+  match name_op with
+  | Some s -> s, gk
+  | None ->
+    let name = Option.default anon_id name in
+    add_suffix name suffix, gk
+
+let tclABSTRACT ?(opaque=true) name_op tac =
+  let s, gk = if opaque
+    then name_op_to_name name_op (Proof Theorem) "_subproof"
+    else name_op_to_name name_op (DefinitionBody Definition) "_subterm" in
+  abstract_subproof ~opaque s gk tac
 
 let unify ?(state=full_transparent_state) x y =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   try
     let core_flags =
@@ -4938,12 +5022,11 @@ let unify ?(state=full_transparent_state) x y =
       merge_unify_flags = core_flags;
       subterm_unify_flags = { core_flags with modulo_delta = empty_transparent_state } }
     in
-    let sigma = Sigma.to_evar_map sigma in
     let sigma = w_unify (Tacmach.New.pf_env gl) sigma Reduction.CONV ~flags x y in
-    Sigma.Unsafe.of_pair (Proofview.tclUNIT (), sigma)
+    Proofview.Unsafe.tclEVARS sigma
   with e when CErrors.noncritical e ->
-    Sigma.here (Tacticals.New.tclFAIL 0 (str"Not unifiable")) sigma
-  end }
+    Proofview.tclZERO (PretypeError (env, sigma, CannotUnify (x, y, None)))
+  end
 
 module Simple = struct
   (** Simplified version of some of the above tactics *)
@@ -4951,40 +5034,30 @@ module Simple = struct
   let intro x = intro_move (Some x) MoveLast
 
   let apply c =
-    apply_with_bindings_gen false false [None,(Loc.ghost,(c,NoBindings))]
+    apply_with_bindings_gen false false [None,(CAst.make (c,NoBindings))]
   let eapply c =
-    apply_with_bindings_gen false true [None,(Loc.ghost,(c,NoBindings))]
+    apply_with_bindings_gen false true [None,(CAst.make (c,NoBindings))]
   let elim c   = elim false None (c,NoBindings) None
   let case   c = general_case_analysis false None (c,NoBindings)
 
   let apply_in id c =
-    apply_in false false id [None,(Loc.ghost, (c, NoBindings))] None
+    apply_in false false id [None,(CAst.make (c, NoBindings))] None
 
 end
 
 
 (** Tacticals defined directly in term of Proofview *)
 module New = struct
-  open Proofview.Notations
-
-  let exact_proof c = exact_proof c
-
   open Genredexpr
   open Locus
 
   let reduce_after_refine =
-    let onhyps =
-      (** We reduced everywhere in the hyps before 8.6 *)
-      if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0
-      then None
-      else Some []
-    in
     reduce
       (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;
 	     rZeta=false;rDelta=false;rConst=[]})
-      {onhyps; concl_occs=AllOccurrences }
+      {onhyps = Some []; concl_occs = AllOccurrences }
 
-  let refine ?unsafe c =
-    Refine.refine ?unsafe c <*>
+  let refine ~typecheck c =
+    Refine.refine ~typecheck c <*>
     reduce_after_refine
 end
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index fb033363..079baa3e 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -1,25 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Loc
 open Names
-open Term
+open Constr
+open EConstr
 open Environ
 open Proof_type
 open Evd
 open Clenv
 open Redexpr
 open Globnames
-open Tacexpr
 open Pattern
 open Unification
 open Misctypes
+open Tactypes
 open Locus
+open Ltac_pretype
 
 (** Main tactics defined in ML. This file is huge and should probably be split
     in more reasonable units at some point. Because of its size and age, the
@@ -28,15 +31,15 @@ open Locus
 
 (** {6 General functions. } *)
 
-val is_quantified_hypothesis : Id.t -> ([`NF],'b) Proofview.Goal.t -> bool
+val is_quantified_hypothesis : Id.t -> Proofview.Goal.t -> bool
 
 (** {6 Primitive tactics. } *)
 
 val introduction    : ?check:bool -> Id.t -> unit Proofview.tactic
 val convert_concl   : ?check:bool -> types -> cast_kind -> unit Proofview.tactic
-val convert_hyp     : ?check:bool -> Context.Named.Declaration.t -> unit Proofview.tactic
+val convert_hyp     : ?check:bool -> named_declaration -> unit Proofview.tactic
 val convert_concl_no_check : types -> cast_kind -> unit Proofview.tactic
-val convert_hyp_no_check : Context.Named.Declaration.t -> unit Proofview.tactic
+val convert_hyp_no_check : named_declaration -> unit Proofview.tactic
 val mutual_fix      :
   Id.t -> int -> (Id.t * int * constr) list -> int -> unit Proofview.tactic
 val fix             : Id.t option -> int -> unit Proofview.tactic
@@ -48,18 +51,18 @@ val convert_leq     : constr -> constr -> unit Proofview.tactic
 
 (** {6 Introduction tactics. } *)
 
-val fresh_id_in_env : Id.t list -> Id.t -> env -> Id.t
-val fresh_id : Id.t list -> Id.t -> goal sigma -> Id.t
-val find_intro_names : Context.Rel.t -> goal sigma -> Id.t list
+val fresh_id_in_env : Id.Set.t -> Id.t -> env -> Id.t
+val fresh_id : Id.Set.t -> Id.t -> goal sigma -> Id.t
+val find_intro_names : rel_context -> goal sigma -> Id.t list
 
 val intro                : unit Proofview.tactic
 val introf               : unit Proofview.tactic
 val intro_move        : Id.t option -> Id.t move_location -> unit Proofview.tactic
-val intro_move_avoid  : Id.t option -> Id.t list -> Id.t move_location -> unit Proofview.tactic
+val intro_move_avoid  : Id.t option -> Id.Set.t -> Id.t move_location -> unit Proofview.tactic
 
   (** [intro_avoiding idl] acts as intro but prevents the new Id.t
      to belong to [idl] *)
-val intro_avoiding       : Id.t list -> unit Proofview.tactic
+val intro_avoiding       : Id.Set.t -> unit Proofview.tactic
 
 val intro_replacing      : Id.t -> unit Proofview.tactic
 val intro_using          : Id.t -> unit Proofview.tactic
@@ -74,7 +77,7 @@ val intros               : unit Proofview.tactic
 (** [depth_of_quantified_hypothesis b h g] returns the index of [h] in
    the conclusion of goal [g], up to head-reduction if [b] is [true] *)
 val depth_of_quantified_hypothesis :
-  bool -> quantified_hypothesis -> ([`NF],'b) Proofview.Goal.t -> int
+  bool -> quantified_hypothesis -> Proofview.Goal.t -> int
 
 val intros_until         : quantified_hypothesis -> unit Proofview.tactic
 
@@ -128,14 +131,16 @@ val exact_proof      : Constrexpr.constr_expr -> unit Proofview.tactic
 
 (** {6 Reduction tactics. } *)
 
-type tactic_reduction = env -> evar_map -> constr -> constr
+type tactic_reduction = Reductionops.reduction_function
+type e_tactic_reduction = Reductionops.e_reduction_function
 
-type change_arg = patvar_map -> constr Sigma.run
+type change_arg = patvar_map -> evar_map -> evar_map * constr
 
 val make_change_arg   : constr -> change_arg
 val reduct_in_hyp     : ?check:bool -> tactic_reduction -> hyp_location -> unit Proofview.tactic
 val reduct_option     : ?check:bool -> tactic_reduction * cast_kind -> goal_location -> unit Proofview.tactic
 val reduct_in_concl   : tactic_reduction * cast_kind -> unit Proofview.tactic
+val e_reduct_in_concl   : check:bool -> e_tactic_reduction * cast_kind -> unit Proofview.tactic
 val change_in_concl   : (occurrences * constr_pattern) option -> change_arg -> unit Proofview.tactic
 val change_concl      : constr -> unit Proofview.tactic
 val change_in_hyp     : (occurrences * constr_pattern) option -> change_arg ->
@@ -183,17 +188,17 @@ val revert        : Id.t list -> unit Proofview.tactic
 
 (** {6 Resolution tactics. } *)
 
-val apply_type : constr -> constr list -> unit Proofview.tactic
-val bring_hyps : Context.Named.t -> unit Proofview.tactic
+val apply_type : typecheck:bool -> constr -> constr list -> unit Proofview.tactic
+val bring_hyps : named_context -> unit Proofview.tactic
 
 val apply                 : constr -> unit Proofview.tactic
 val eapply                : constr -> unit Proofview.tactic
 
 val apply_with_bindings_gen :
-  advanced_flag -> evars_flag -> (clear_flag * constr with_bindings located) list -> unit Proofview.tactic
+  advanced_flag -> evars_flag -> (clear_flag * constr with_bindings CAst.t) list -> unit Proofview.tactic
 
 val apply_with_delayed_bindings_gen :
-  advanced_flag -> evars_flag -> (clear_flag * delayed_open_constr_with_bindings located) list -> unit Proofview.tactic
+  advanced_flag -> evars_flag -> (clear_flag * delayed_open_constr_with_bindings CAst.t) list -> unit Proofview.tactic
 
 val apply_with_bindings   : constr with_bindings -> unit Proofview.tactic
 val eapply_with_bindings  : constr with_bindings -> unit Proofview.tactic
@@ -202,16 +207,14 @@ val cut_and_apply         : constr -> unit Proofview.tactic
 
 val apply_in :
   advanced_flag -> evars_flag -> Id.t -> 
-    (clear_flag * constr with_bindings located) list ->
+    (clear_flag * constr with_bindings CAst.t) list ->
     intro_pattern option -> unit Proofview.tactic
 
 val apply_delayed_in :
   advanced_flag -> evars_flag -> Id.t -> 
-    (clear_flag * delayed_open_constr_with_bindings located) list ->
+    (clear_flag * delayed_open_constr_with_bindings CAst.t) list ->
     intro_pattern option -> unit Proofview.tactic
 
-val run_delayed : Environ.env -> evar_map -> 'a delayed_open -> 'a * evar_map
-
 (** {6 Elimination tactics. } *)
 
 (*
@@ -243,15 +246,15 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: Context.Rel.t;      (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  params: rel_context;      (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
   nparams: int;               (** number of parameters *)
-  predicates: Context.Rel.t;  (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  predicates: rel_context;  (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;           (** Number of predicates *)
-  branches: Context.Rel.t;    (** branchr,...,branch1 *)
+  branches: rel_context;    (** branchr,...,branch1 *)
   nbranches: int;             (** Number of branches *)
-  args: Context.Rel.t;        (** (xni, Ti_ni) ... (x1, Ti_1) *)
+  args: rel_context;        (** (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;                 (** number of arguments *)
-  indarg: Context.Rel.Declaration.t option;  (** Some (H,I prm1..prmp x1...xni)
+  indarg: rel_declaration option;  (** Some (H,I prm1..prmp x1...xni)
 	  		 	                 if HI is in premisses, None otherwise *)
   concl: types;               (** Qi x1...xni HI (f...), HI and (f...)
 			          are optional and mutually exclusive *)
@@ -259,7 +262,7 @@ type elim_scheme = {
   farg_in_concl: bool;        (** true if (f...) appears at the end of conclusion *)
 }
 
-val compute_elim_sig : ?elimc: constr with_bindings -> types -> elim_scheme
+val compute_elim_sig : evar_map -> ?elimc:constr with_bindings -> types -> elim_scheme
 
 (** elim principle with the index of its inductive arg *)
 type eliminator = {
@@ -271,7 +274,7 @@ type eliminator = {
 val general_elim  : evars_flag -> clear_flag ->
   constr with_bindings -> eliminator -> unit Proofview.tactic
 
-val general_elim_clause : evars_flag -> unify_flags -> identifier option ->
+val general_elim_clause : evars_flag -> unify_flags -> Id.t option ->
   clausenv -> eliminator -> unit Proofview.tactic
 
 val default_elim  : evars_flag -> clear_flag -> constr with_bindings ->
@@ -280,8 +283,6 @@ val simplest_elim : constr -> unit Proofview.tactic
 val elim :
   evars_flag -> clear_flag -> constr with_bindings -> constr with_bindings option -> unit Proofview.tactic
 
-val simple_induct : quantified_hypothesis -> unit Proofview.tactic
-
 val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
   constr with_bindings option -> unit Proofview.tactic
 
@@ -290,7 +291,6 @@ val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern optio
 val general_case_analysis : evars_flag -> clear_flag -> constr with_bindings ->  unit Proofview.tactic
 val simplest_case         : constr -> unit Proofview.tactic
 
-val simple_destruct       : quantified_hypothesis -> unit Proofview.tactic
 val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
   constr with_bindings option -> unit Proofview.tactic
 
@@ -355,7 +355,7 @@ val assert_before : Name.t -> types -> unit Proofview.tactic
 val assert_after  : Name.t -> types -> unit Proofview.tactic
 
 val assert_as     : (* true = before *) bool ->
-  (* optionally tell if a specialization of some hyp: *) identifier option ->
+  (* optionally tell if a specialization of some hyp: *) Id.t option ->
   intro_pattern option -> constr -> unit Proofview.tactic
 
 (** Implements the tactics assert, enough and pose proof; note that "by"
@@ -384,8 +384,8 @@ val letin_tac : (bool * intro_pattern_naming) option ->
 
 (** Common entry point for user-level "set", "pose" and "remember" *)
 
-val letin_pat_tac : (bool * intro_pattern_naming) option ->
-  Name.t -> pending_constr -> clause -> unit Proofview.tactic
+val letin_pat_tac : evars_flag -> (bool * intro_pattern_naming) option ->
+  Name.t -> (evar_map * constr) -> clause -> unit Proofview.tactic
 
 (** {6 Generalize tactics. } *)
 
@@ -400,7 +400,9 @@ val generalize_dep  : ?with_let:bool (** Don't lose let bindings *) -> constr  -
 
 val unify           : ?state:Names.transparent_state -> constr -> constr -> unit Proofview.tactic
 
-val tclABSTRACT : Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
+val cache_term_by_tactic_then : opaque:bool -> ?goal_type:(constr option) -> Id.t -> Decl_kinds.goal_kind -> unit Proofview.tactic -> (constr -> constr list -> unit Proofview.tactic) -> unit Proofview.tactic
+
+val tclABSTRACT : ?opaque:bool -> Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
 
 val abstract_generalize : ?generalize_vars:bool -> ?force_dep:bool -> Id.t -> unit Proofview.tactic
 val specialize_eqs : Id.t -> unit Proofview.tactic
@@ -426,7 +428,7 @@ module Simple : sig
   val eapply : constr -> unit Proofview.tactic
   val elim   : constr -> unit Proofview.tactic
   val case   : constr -> unit Proofview.tactic
-  val apply_in : identifier -> constr -> unit Proofview.tactic
+  val apply_in : Id.t -> constr -> unit Proofview.tactic
 
 end
 
@@ -434,8 +436,8 @@ end
 
 module New : sig
 
-  val refine : ?unsafe:bool -> constr Sigma.run -> unit Proofview.tactic
-  (** [refine ?unsafe c] is [Refine.refine ?unsafe c]
+  val refine : typecheck:bool -> (evar_map -> evar_map * constr) -> unit Proofview.tactic
+  (** [refine ~typecheck c] is [Refine.refine ~typecheck c]
       followed by beta-iota-reduction of the conclusion. *)
 
   val reduce_after_refine : unit Proofview.tactic
diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib
index 09330260..f54ad86a 100644
--- a/tactics/tactics.mllib
+++ b/tactics/tactics.mllib
@@ -16,7 +16,6 @@ Hints
 Auto
 Eauto
 Class_tactics
-Tactic_matching
 Term_dnet
 Eqdecide
 Autorewrite
diff --git a/tactics/term_dnet.ml b/tactics/term_dnet.ml
index e4b45489..753c608a 100644
--- a/tactics/term_dnet.ml
+++ b/tactics/term_dnet.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (*i*)
 open Util
-open Term
+open Constr
 open Names
 open Globnames
 open Mod_subst
@@ -49,7 +51,7 @@ struct
     | DNil
 
   (* debug *)
-  let pr_dconstr f : 'a t -> std_ppcmds = function
+  let _pr_dconstr f : 'a t -> Pp.t = function
     | DRel -> str "*"
     | DSort -> str "Sort"
     | DRef _ -> str "Ref"
@@ -95,13 +97,20 @@ struct
 
   let compare cmp t1 t2 = match t1, t2 with
   | DRel, DRel -> 0
+  | DRel, _ -> -1 | _, DRel -> 1
   | DSort, DSort -> 0
+  | DSort, _ -> -1 | _, DSort -> 1
   | DRef gr1, DRef gr2 -> RefOrdered.compare gr1 gr2
+  | DRef _, _ -> -1 | _, DRef _ -> 1
+
   | DCtx (tl1, tr1), DCtx (tl2, tr2)
   | DLambda (tl1, tr1), DLambda (tl2, tr2)
   | DApp (tl1, tr1), DApp (tl2, tr2) ->
     let c = cmp tl1 tl2 in
     if c = 0 then cmp tr1 tr2 else c
+  | DCtx _, _ -> -1 | _, DCtx _ -> 1
+  | DLambda _, _ -> -1 | _, DLambda _ -> 1
+  | DApp _, _ -> -1 | _, DApp _ -> 1
 
   | DCase (ci1, c1, t1, p1), DCase (ci2, c2, t2, p2) ->
     let c = cmp c1 c2 in
@@ -113,6 +122,7 @@ struct
         else c
       else c
     else c
+  | DCase _, _ -> -1 | _, DCase _ -> 1
 
   | DFix (i1, j1, tl1, pl1), DFix (i2, j2, tl2, pl2) ->
     let c = Int.compare j1 j2 in
@@ -124,6 +134,8 @@ struct
         else c
       else c
     else c
+  | DFix _, _ -> -1 | _, DFix _ -> 1
+
   | DCoFix (i1, tl1, pl1), DCoFix (i2, tl2, pl2) ->
     let c = Int.compare i1 i2 in
     if c = 0 then
@@ -131,7 +143,18 @@ struct
       if c = 0 then Array.compare cmp pl1 pl2
       else c
     else c
-  | _ -> Pervasives.compare t1 t2 (** OK **)
+  | DCoFix _, _ -> -1 | _, DCoFix _ -> 1
+
+  | DCons ((t1, ot1), u1), DCons ((t2, ot2), u2) ->
+     let c = cmp t1 t2 in
+     if Int.equal c 0 then
+       let c = Option.compare cmp ot1 ot2 in
+       if Int.equal c 0 then cmp u1 u2
+       else c
+     else c
+  | DCons _, _ -> -1 | _, DCons _ -> 1
+
+  | DNil, DNil -> 0
 
   let fold f acc = function
     | (DRel | DNil | DSort | DRef _) -> acc
@@ -174,7 +197,8 @@ struct
 	    Array.fold_left2 f (Array.fold_left2 f acc ta1 ta2) ca1 ca2
 	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) ->
 	    f (Option.fold_left2 f (f acc t1 t2) topt1 topt2) u1 u2
-	| _ -> assert false
+        | (DRel | DNil | DSort | DRef _ | DCtx _ | DApp _ | DLambda _ | DCase _
+           | DFix _ | DCoFix _ | DCons _), _ -> assert false
 
   let map2 (f:'a -> 'b -> 'c) (c1:'a t) (c2:'b t) : 'c t =
     let head w = map (fun _ -> ()) w in
@@ -194,11 +218,13 @@ struct
 	    DCoFix (i,Array.map2 f ta1 ta2,Array.map2 f ca1 ca2)
 	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) ->
 	    DCons ((f t1 t2,Option.lift2 f topt1 topt2), f u1 u2)
-	| _ -> assert false
+        | (DRel | DNil | DSort | DRef _ | DCtx _ | DApp _ | DLambda _ | DCase _
+           | DFix _ | DCoFix _ | DCons _), _ -> assert false
 
   let terminal = function
     | (DRel | DSort | DNil | DRef _) -> true
-    | _ -> false
+    | DLambda _ | DApp _ | DCase _ | DFix _ | DCoFix _ | DCtx _ | DCons _ ->
+      false
 
   let compare t1 t2 = compare dummy_cmp t1 t2
 
@@ -257,7 +283,7 @@ struct
   let pat_of_constr c : term_pattern =
     (** To each evar we associate a unique identifier. *)
     let metas = ref Evar.Map.empty in
-    let rec pat_of_constr c = match kind_of_term c with
+    let rec pat_of_constr c = match Constr.kind c with
     | Rel _          -> Term DRel
     | Sort _         -> Term DSort
     | Var i          -> Term (DRef (VarRef i))
@@ -290,7 +316,7 @@ struct
     | Proj (p,c) -> 
         Term (DApp (Term (DRef (ConstRef (Projection.constant p))), pat_of_constr c))
 
-    and ctx_of_constr ctx c = match kind_of_term c with
+    and ctx_of_constr ctx c = match Constr.kind c with
     | Prod (_,t,c)   -> ctx_of_constr (Term(DCons((pat_of_constr t,None),ctx))) c
     | LetIn(_,d,t,c) -> ctx_of_constr (Term(DCons((pat_of_constr t, Some (pat_of_constr d)),ctx))) c
     | _ -> ctx,pat_of_constr c
@@ -344,18 +370,19 @@ struct
     ) (pr_dconstr pr_term_pattern) p*)
 
   let search_pat cpat dpat dn =
-    let whole_c = cpat in
+    let whole_c = EConstr.of_constr cpat in
     (* if we are at the root, add an empty context *)
     let dpat = under_prod (empty_ctx dpat) in
     TDnet.Idset.fold
       (fun id acc ->
 	 let c_id = Opt.reduce (Ident.constr_of id) in
+	 let c_id = EConstr.of_constr c_id in
 	 let (ctx,wc) =
-	   try Termops.align_prod_letin whole_c c_id
+	   try Termops.align_prod_letin Evd.empty whole_c c_id (** FIXME *)
 	   with Invalid_argument _ -> [],c_id in
 	 let wc,whole_c = if Opt.direction then whole_c,wc else wc,whole_c in
 	 try
-          let _ = Termops.filtering ctx Reduction.CUMUL wc whole_c in
+          let _ = Termops.filtering Evd.empty ctx Reduction.CUMUL wc whole_c in
           id :: acc
 	 with Termops.CannotFilter -> (* msgnl(str"recon "++Termops.print_constr_env (Global.env()) wc); *) acc
       ) (TDnet.find_match dpat dn) []
diff --git a/tactics/term_dnet.mli b/tactics/term_dnet.mli
index fcc03bef..2c748f9c 100644
--- a/tactics/term_dnet.mli
+++ b/tactics/term_dnet.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open Mod_subst
 
 (** Dnets on constr terms.