Imported Upstream version 8.6upstream/8.6

60 files changed, 4187 insertions, 12303 deletions

diff --git a/tactics/auto.ml b/tactics/auto.ml
index 2d92387c..bc644857 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -10,7 +10,7 @@
 *)
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Vars
 open Termops
@@ -35,6 +35,10 @@ 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
+  secvars_of_hyps hyps
+
 (* tell auto not to reuse already instantiated metas in unification (for
    compatibility, since otherwise, apply succeeds oftener) *)
 
@@ -67,16 +71,13 @@ let auto_unif_flags_of st1 st2 useeager =
 let auto_unif_flags =
   auto_unif_flags_of full_transparent_state empty_transparent_state false
 
-let auto_flags_of_state st =
-  auto_unif_flags_of full_transparent_state st false
-
 (* Try unification with the precompiled clause, then use registered Apply *)
 
 let connect_hint_clenv poly (c, _, ctx) clenv gl =
   (** [clenv] has been generated by a hint-making function, so the only relevant
       data in its evarmap is the set of metas. The [evar_reset_evd] function
       below just replaces the metas of sigma by those coming from the clenv. *)
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let evd = Evd.evars_reset_evd ~with_conv_pbs:true ~with_univs:false sigma clenv.evd in
   (** Still, we need to update the universes *)
   let clenv, c =
@@ -85,22 +86,25 @@ let connect_hint_clenv poly (c, _, ctx) clenv gl =
       let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
       let map c = Vars.subst_univs_level_constr subst c in
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
-      let clenv = { clenv with evd = evd ; env = Proofview.Goal.env gl } in
-      (** FIXME: We're being inefficient here because we substitute the whole
-          evar map instead of just its metas, which are the only ones
-          mentioning the old universes. *)
-      Clenv.map_clenv map clenv, map c
+      (** Only metas are mentioning the old universes. *)
+      let clenv = {
+        templval = Evd.map_fl map clenv.templval;
+        templtyp = Evd.map_fl map clenv.templtyp;
+        evd = Evd.map_metas map evd;
+        env = Proofview.Goal.env gl;
+      } in
+      clenv, map 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 begin fun gl ->
+  Proofview.Goal.nf_enter { 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
   Clenvtac.clenv_refine false clenv
-  end
+  end }
 
 let unify_resolve_nodelta poly h = unify_resolve poly auto_unif_flags h
 
@@ -109,20 +113,12 @@ let unify_resolve_gen poly = function
   | Some flags -> unify_resolve poly flags
 
 let exact poly (c,clenv) =
-  let (c, _, _) = c in
-  let ctx, c' = 
-    if poly then
-      let evd', subst = Evd.refresh_undefined_universes clenv.evd in
-      let ctx = Evd.evar_universe_context evd' in
-	ctx, subst_univs_level_constr subst c 
-    else 
-      let ctx = Evd.evar_universe_context clenv.evd in
-	ctx, c
-  in
-  Proofview.Goal.enter begin fun gl ->
-    let sigma = Evd.merge_universe_context (Proofview.Goal.sigma gl) ctx in
-    Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) (exact_check c')
-  end
+  Proofview.Goal.enter { 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 }
 
 (* Util *)
 
@@ -138,8 +134,6 @@ si après Intros la conclusion matche le pattern.
 
 (* conclPattern doit échouer avec error car il est rattraper par tclFIRST *)
 
-let (forward_interp_tactic, extern_interp) = Hook.make ()
-
 let conclPattern concl pat tac =
   let constr_bindings env sigma =
     match pat with
@@ -150,11 +144,23 @@ let conclPattern concl pat tac =
 	with Constr_matching.PatternMatchingFailure ->
           Tacticals.New.tclZEROMSG (str "conclPattern")
   in
-   Proofview.Goal.enter (fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
      let env = Proofview.Goal.env gl in
-     let sigma = Proofview.Goal.sigma gl in
+     let sigma = Tacmach.New.project gl in
        constr_bindings env sigma >>= fun constr_bindings ->
-     Hook.get forward_interp_tactic constr_bindings tac)
+     let open Genarg in
+     let open Geninterp in
+     let inj c = match val_tag (topwit Constrarg.wit_constr) with
+     | Val.Base tag -> Val.Dyn (tag, c)
+     | _ -> assert false
+     in
+     let fold id c accu = Id.Map.add id (inj c) accu in
+     let lfun = Id.Map.fold fold constr_bindings Id.Map.empty in
+     let ist = { lfun; extra = TacStore.empty } in
+     match tac with
+     | GenArg (Glbwit wit, tac) ->
+      Ftactic.run (Geninterp.interp wit ist tac) (fun _ -> Proofview.tclUNIT ())
+  end }
 
 (***********************************************************)
 (** A debugging / verbosity framework for trivial and auto *)
@@ -217,11 +223,11 @@ let tclLOG (dbg,depth,trace) pp tac =
       Proofview.V82.tactic begin fun gl ->
 	try
 	  let out = Proofview.V82.of_tactic tac gl in
-	  msg_debug (str s ++ spc () ++ pp () ++ str ". (*success*)");
+	  Feedback.msg_debug (str s ++ spc () ++ pp () ++ str ". (*success*)");
 	  out
 	with reraise ->
-          let reraise = Errors.push reraise in
-	  msg_debug (str s ++ spc () ++ pp () ++ str ". (*fail*)");
+          let reraise = CErrors.push reraise in
+	  Feedback.msg_debug (str s ++ spc () ++ pp () ++ str ". (*fail*)");
 	  iraise reraise
       end
     | Info ->
@@ -232,7 +238,7 @@ let tclLOG (dbg,depth,trace) pp tac =
 	  trace := (depth, Some pp) :: !trace;
 	  out
 	with reraise ->
-          let reraise = Errors.push reraise in
+          let reraise = CErrors.push reraise in
 	  trace := (depth, None) :: !trace;
 	  iraise reraise
       end
@@ -258,31 +264,25 @@ let pr_info_atom (d,pp) =
 
 let pr_info_trace = function
   | (Info,_,{contents=(d,Some pp)::l}) ->
-      prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l)
-  | _ -> mt ()
+      Feedback.msg_info (prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l))
+  | _ -> ()
 
 let pr_info_nop = function
-  | (Info,_,_) -> str "idtac."
-  | _ -> mt ()
+  | (Info,_,_) -> Feedback.msg_info (str "idtac.")
+  | _ -> ()
 
 let pr_dbg_header = function
-  | (Off,_,_) -> mt ()
-  | (Debug,0,_) -> str "(* debug trivial : *)"
-  | (Debug,_,_) -> str "(* debug auto : *)"
-  | (Info,0,_) -> str "(* info trivial : *)"
-  | (Info,_,_) -> str "(* info auto : *)"
+  | (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: *)")
 
 let tclTRY_dbg d tac =
-  let (level, _, _) = d in
   let delay f = Proofview.tclUNIT () >>= fun () -> f () in
-  let tac = match level with
-  | Off -> tac
-  | Debug | Info -> delay (fun () -> msg_debug (pr_dbg_header d ++ fnl () ++ pr_info_trace d); tac)
-  in
-  let after = match level with
-  | Info -> delay (fun () -> msg_debug (pr_info_nop d); Proofview.tclUNIT ())
-  | Off | Debug -> Proofview.tclUNIT ()
-  in
+  let tac = delay (fun () -> pr_dbg_header d; tac) >>=
+              fun () -> pr_info_trace d; Proofview.tclUNIT () in
+  let after = delay (fun () -> pr_info_nop d; Proofview.tclUNIT ()) in
   Tacticals.New.tclORELSE0 tac after
 
 (**************************************************************************)
@@ -293,21 +293,19 @@ let tclTRY_dbg d tac =
 (* Papageno : cette fonction a été pas mal simplifiée depuis que la base
   de Hint impérative a été remplacée par plusieurs bases fonctionnelles *)
 
-let auto_unif_flags =
-  auto_unif_flags_of full_transparent_state empty_transparent_state false
-
 let flags_of_state st =
   auto_unif_flags_of st st false
 
 let auto_flags_of_state st =
   auto_unif_flags_of full_transparent_state st false
 
-let hintmap_of hdc concl =
+let hintmap_of secvars hdc concl =
   match hdc with
-  | None -> Hint_db.map_none
+  | None -> Hint_db.map_none ~secvars
   | Some hdc ->
-      if occur_existential concl then Hint_db.map_existential hdc concl
-      else Hint_db.map_auto hdc concl
+     if occur_existential concl then
+       Hint_db.map_existential ~secvars hdc concl
+     else Hint_db.map_auto ~secvars hdc concl
 
 let exists_evaluable_reference env = function
   | EvalConstRef _ -> true
@@ -319,35 +317,36 @@ 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 begin fun gl ->
-          let sigma = Proofview.Goal.sigma gl in
+      ( Proofview.Goal.enter { 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 hyp = Context.map_named_declaration nf decl 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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let concl = Tacmach.New.pf_nf_concl 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 concl)))
-  end
+             (trivial_resolve dbg mod_delta db_list local_db secvars concl)))
+  end }
 
-and my_find_search_nodelta db_list local_db hdc concl =
+and my_find_search_nodelta db_list local_db secvars hdc concl =
   List.map (fun hint -> (None,hint))
-    (List.map_append (hintmap_of hdc concl) (local_db::db_list))
+    (List.map_append (hintmap_of 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 hdc concl =
-  let f = hintmap_of hdc concl in
+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
       List.map_append
 	(fun db ->
@@ -367,16 +366,16 @@ and my_find_search_delta db_list local_db hdc concl =
 	  let (ids, csts as st) = Hint_db.transparent_state db in
 	  let flags, l =
 	    let l =
-	      match hdc with None -> Hint_db.map_none db
+	      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 hdc concl db
-		  else Hint_db.map_existential hdc concl db
+		  then Hint_db.map_auto ~secvars hdc concl db
+		  else Hint_db.map_existential ~secvars hdc concl db
 	    in auto_flags_of_state st, l
 	  in List.map (fun x -> (Some flags,x)) l)
       	(local_db::db_list)
 
-and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly})) =
+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")
@@ -390,14 +389,21 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly}))
     | Unfold_nth c ->
       Proofview.V82.tactic (fun gl ->
        if exists_evaluable_reference (pf_env gl) c then
-	 tclPROGRESS (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl) gl
+	 tclPROGRESS (Proofview.V82.of_tactic (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)) gl
        else tclFAIL 0 (str"Unbound reference") gl)
     | Extern tacast -> 
       conclPattern concl p tacast
   in
-  tclLOG dbg (fun () -> pr_hint t) (run_hint t tactic)
+  let pr_hint () =
+    let origin = match dbname with
+    | None -> mt ()
+    | Some n -> str " (in " ++ str n ++ str ")"
+    in
+    pr_hint t ++ origin
+  in
+  tclLOG dbg pr_hint (run_hint t tactic)
 
-and trivial_resolve dbg mod_delta db_list local_db cl =
+and trivial_resolve dbg mod_delta db_list local_db secvars cl =
   try
     let head =
       try let hdconstr = decompose_app_bound cl in
@@ -406,33 +412,33 @@ and trivial_resolve dbg mod_delta db_list local_db cl =
     in
       List.map (tac_of_hint dbg db_list local_db cl)
 	(priority
-	    (my_find_search mod_delta db_list local_db head cl))
+	    (my_find_search mod_delta 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
   let d = mk_trivial_dbg debug in
   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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
   let d = mk_trivial_dbg debug in
   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
@@ -444,7 +450,7 @@ 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 cl =
+let possible_resolve dbg mod_delta db_list local_db secvars cl =
   try
     let head =
       try let hdconstr = decompose_app_bound cl in
@@ -452,12 +458,12 @@ let possible_resolve dbg mod_delta db_list local_db cl =
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
-	(my_find_search mod_delta db_list local_db head cl)
+	(my_find_search mod_delta db_list local_db secvars head cl)
   with Not_found -> []
 
 let extend_local_db decl db gl =
   let env = Tacmach.New.pf_env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   Hint_db.add_list env sigma (make_resolve_hyp env sigma decl) db
 
 (* Introduce an hypothesis, then call the continuation tactic [kont]
@@ -465,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 begin fun gl ->
+    (Proofview.Goal.enter { 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 *)
@@ -481,14 +487,15 @@ 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 begin fun gl ->
+	     ( Proofview.Goal.enter { enter = begin fun gl ->
                let concl = Tacmach.New.pf_nf_concl 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 concl))
-             end))
+		    (possible_resolve d mod_delta db_list local_db secvars concl))
+             end }))
     end []
   in
   search d n local_db
@@ -496,15 +503,15 @@ 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
   let d = mk_auto_dbg debug in
   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
@@ -519,15 +526,15 @@ 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
   let d = mk_auto_dbg debug in
   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 2e5647f8..3befaaad 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -6,31 +6,25 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements auto and related automation tactics *)
+
 open Names
 open Term
 open Clenv
 open Pattern
-open Evd
 open Decl_kinds
 open Hints
 
-val extern_interp :
-  (patvar_map -> Tacexpr.glob_tactic_expr -> unit Proofview.tactic) Hook.t
-
-(** Auto and related automation tactics *)
-
-val priority : ('a * full_hint) list -> ('a * full_hint) list
+val compute_secvars : ('a,'b) 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 ->
-			 [ `NF ] Proofview.Goal.t -> clausenv * constr
-						
-(** Try unification with the precompiled clause, then use registered Apply *)
-val unify_resolve_nodelta : polymorphic -> (raw_hint * clausenv) -> unit Proofview.tactic
+  ('a, 'r) 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
 
 (** [ConclPattern concl pat tacast]:
@@ -38,7 +32,7 @@ val unify_resolve : polymorphic -> Unification.unify_flags -> (raw_hint * clause
    [Pattern.somatches], then replace [?1] [?2] metavars in tacast by the
    right values to build a tactic *)
 
-val conclPattern : constr -> constr_pattern option -> Tacexpr.glob_tactic_expr -> unit Proofview.tactic
+val conclPattern : constr -> constr_pattern option -> Genarg.glob_generic_argument -> unit Proofview.tactic
 
 (** The Auto tactic *)
 
@@ -46,44 +40,42 @@ val conclPattern : constr -> constr_pattern option -> Tacexpr.glob_tactic_expr -
     "nocore" amongst the databases. *)
 
 val auto : ?debug:Tacexpr.debug ->
-  int -> open_constr list -> hint_db_name list -> unit Proofview.tactic
+  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** Auto with more delta. *)
 
 val new_auto : ?debug:Tacexpr.debug ->
-  int -> open_constr list -> hint_db_name list -> unit Proofview.tactic
+  int -> Tacexpr.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 except the "v62" compatibility database *)
+(** auto with all hint databases *)
 val full_auto : ?debug:Tacexpr.debug ->
-  int -> open_constr list -> unit Proofview.tactic
+  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
 
-(** auto with all hint databases except the "v62" compatibility database
-   and doing delta *)
+(** auto with all hint databases and doing delta *)
 val new_full_auto : ?debug:Tacexpr.debug ->
-  int -> open_constr list -> unit Proofview.tactic
+  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
 
-(** auto with default search depth and with all hint databases
-   except the "v62" compatibility database *)
+(** 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 -> open_constr list -> hint_db_name list option -> unit Proofview.tactic
+  int option -> Tacexpr.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 -> open_constr list -> hint_db_name list option -> unit Proofview.tactic
+  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** Trivial *)
 
 val trivial : ?debug:Tacexpr.debug ->
-  open_constr list -> hint_db_name list -> unit Proofview.tactic
+  Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 val gen_trivial : ?debug:Tacexpr.debug ->
-  open_constr list -> hint_db_name list option -> unit Proofview.tactic
+  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 val full_trivial : ?debug:Tacexpr.debug ->
-  open_constr list -> unit Proofview.tactic
+  Tacexpr.delayed_open_constr list -> unit Proofview.tactic
 val h_trivial : ?debug:Tacexpr.debug ->
-  open_constr list -> hint_db_name list option -> unit Proofview.tactic
+  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 49e5c620..47500564 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -13,11 +13,11 @@ open Tacticals
 open Tactics
 open Term
 open Termops
-open Errors
+open CErrors
 open Util
-open Tacexpr
 open Mod_subst
 open Locus
+open Proofview.Notations
 
 (* Rewriting rules *)
 type rew_rule = { rew_lemma: constr;
@@ -25,13 +25,13 @@ type rew_rule = { rew_lemma: constr;
 		  rew_pat: constr;
 		  rew_ctx: Univ.universe_context_set;
 		  rew_l2r: bool;
-		  rew_tac: glob_tactic_expr option }
+		  rew_tac: Genarg.glob_generic_argument option }
 
 let subst_hint subst hint =
   let cst' = subst_mps subst hint.rew_lemma in
   let typ' = subst_mps subst hint.rew_type in
   let pat' = subst_mps subst hint.rew_pat in
-  let t' = Option.smartmap (Tacsubst.subst_tactic subst) hint.rew_tac in
+  let t' = Option.smartmap (Genintern.generic_substitute subst) hint.rew_tac in
     if hint.rew_lemma == cst' && hint.rew_type == typ' && hint.rew_tac == t' then hint else
       { hint with
 	rew_lemma = cst'; rew_type = typ';
@@ -83,24 +83,31 @@ let print_rewrite_hintdb bas =
 	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
 	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
 	       Option.cata (fun tac -> str " then use tactic " ++
-	       Pptactic.pr_glob_tactic (Global.env()) tac) (mt ()) h.rew_tac)
+	       Pptactic.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 * raw_tactic_expr option
+type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
 
 (* 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_enter (fun gl ->
+  let try_rewrite dir ctx c tc =
+  Proofview.Goal.nf_s_enter { s_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 = Proofview.Goal.sigma gl in
+    let sigma = Sigma.to_evar_map sigma in
     let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx' in
-    Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
-      (general_rewrite_maybe_in dir c' tc)
-  ) in
+    let tac = general_rewrite_maybe_in dir c' tc in
+    Sigma.Unsafe.of_pair (tac, sigma)
+  end } in
   let lrul = List.map (fun h -> 
-  let tac = match h.rew_tac with None -> Proofview.tclUNIT () | Some t -> Tacinterp.eval_tactic t in
+  let tac = match h.rew_tac with
+  | None -> Proofview.tclUNIT ()
+  | Some (Genarg.GenArg (Genarg.Glbwit wit, tac)) ->
+    let ist = { Geninterp.lfun = Id.Map.empty; extra = Geninterp.TacStore.empty } in
+    Ftactic.run (Geninterp.interp wit ist tac) (fun _ -> Proofview.tclUNIT ())
+  in
     (h.rew_ctx,h.rew_lemma,h.rew_l2r,tac)) lrul in
     Tacticals.New.tclREPEAT_MAIN (Proofview.tclPROGRESS (List.fold_left (fun tac (ctx,csr,dir,tc) ->
       Tacticals.New.tclTHEN tac
@@ -120,7 +127,7 @@ let autorewrite ?(conds=Naive) tac_main lbas =
       (Proofview.tclUNIT()) lbas))
 
 let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
- Proofview.Goal.nf_enter begin fun gl ->
+ Proofview.Goal.nf_enter { 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 =
@@ -129,7 +136,7 @@ let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
    fun dir cstr tac gl ->
     let last_hyp_id =
      match Tacmach.pf_hyps gl with
-        (last_hyp_id,_,_)::_ -> last_hyp_id
+        d :: _ -> Context.Named.Declaration.get_id d
       | _ -> (* even the hypothesis id is missing *)
         raise (Logic.RefinerError (Logic.NoSuchHyp !id))
     in
@@ -138,12 +145,13 @@ let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
     match gls with
        g::_ ->
         (match Environ.named_context_of_val (Goal.V82.hyps gl'.Evd.sigma g) with
-            (lastid,_,_)::_ ->
+            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 (clear [!id])) gl
+                   tclTHEN (fun _ -> gl') (tclTRY (Proofview.V82.of_tactic (clear [!id]))) gl
                   else gl' in
                 id := lastid ;
                 to_be_cleared := true ;
@@ -163,7 +171,7 @@ let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
     (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]
 
@@ -188,12 +196,13 @@ 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 begin fun gl ->
+               Proofview.Goal.nf_enter { 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) = gen_auto_multi_rewrite conds (Proofview.tclUNIT())
+let auto_multi_rewrite ?(conds=Naive) lems cl =
+  Proofview.V82.wrap_exceptions (fun () -> gen_auto_multi_rewrite conds (Proofview.tclUNIT()) lems cl)
 
 let auto_multi_rewrite_with ?(conds=Naive) tac_main lbas cl =
   let onconcl = match cl.Locus.concl_occs with NoOccurrences -> false | _ -> true in
@@ -202,7 +211,7 @@ let auto_multi_rewrite_with ?(conds=Naive) tac_main lbas cl =
 	(* autorewrite with .... in clause using tac n'est sur que
 	   si clause represente soit le but soit UNE hypothese
 	*)
-	gen_auto_multi_rewrite conds tac_main lbas cl
+	Proofview.V82.wrap_exceptions (fun () -> gen_auto_multi_rewrite conds tac_main lbas cl)
     | _ ->
         Tacticals.New.tclZEROMSG (strbrk "autorewrite .. in .. using can only be used either with a unique hypothesis or on the conclusion.")
 
@@ -294,6 +303,8 @@ 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 intern tac = snd (Genintern.generic_intern ist tac) in
   let lrul =
     List.fold_left
       (fun dn (loc,(c,ctx),b,t) ->
@@ -302,7 +313,7 @@ let add_rew_rules base lrul =
 	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;
-		    rew_tac = Option.map Tacintern.glob_tactic t}
+		    rew_tac = Option.map intern t}
 	in incr counter;
 	  HintDN.add pat (!counter, rul) dn) HintDN.empty lrul
   in Lib.add_anonymous_leaf (inHintRewrite (base,lrul))
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index 6196b04e..07065717 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -6,12 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements the autorewrite tactic. *)
+
 open Term
 open Tacexpr
 open Equality
 
 (** Rewriting rules before tactic interpretation *)
-type raw_rew_rule = Loc.t * Term.constr Univ.in_universe_context_set * bool * Tacexpr.raw_tactic_expr option
+type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
 
 (** To add rewriting rules to a base *)
 val add_rew_rules : string -> raw_rew_rule list -> unit
@@ -29,7 +31,7 @@ type rew_rule = { rew_lemma: constr;
 		  rew_pat: constr;
 		  rew_ctx: Univ.universe_context_set;
 		  rew_l2r: bool;
-		  rew_tac: glob_tactic_expr option }
+		  rew_tac: Genarg.glob_generic_argument option }
 
 val find_rewrites : string -> rew_rule list
 
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 5b3231de..b416bc65 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -6,8 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* TODO:
+  - Find an interface allowing eauto to backtrack when shelved goals remain,
+   e.g. to force instantiations.
+ *)
+
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -28,23 +33,66 @@ open Hints
 
 (** Hint database named "typeclass_instances", now created directly in Auto *)
 
-let typeclasses_debug = ref false
+(** Options handling *)
+
+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
+    cost (in terms of search depth) can differ. *)
+let typeclasses_limit_intros = ref true
+let set_typeclasses_limit_intros d = (:=) typeclasses_limit_intros d
+let get_typeclasses_limit_intros () = !typeclasses_limit_intros
+
 let typeclasses_dependency_order = ref false
 let set_typeclasses_dependency_order d = (:=) typeclasses_dependency_order d
 let get_typeclasses_dependency_order () = !typeclasses_dependency_order
 
+let typeclasses_iterative_deepening = ref false
+let set_typeclasses_iterative_deepening d = (:=) typeclasses_iterative_deepening d
+let get_typeclasses_iterative_deepening () = !typeclasses_iterative_deepening
+
+(** [typeclasses_filtered_unif] governs the unification algorithm used by type
+    classes. If enabled, a new algorithm based on pattern filtering and refine
+    will be used. When disabled, the previous algorithm based on apply will be
+    used. *)
+let typeclasses_filtered_unification = ref false
+let set_typeclasses_filtered_unification d =
+  (:=) 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
+
+let set_typeclasses_verbose =
+  function None -> typeclasses_debug := 0
+         | Some n -> (:=) typeclasses_debug n
+let get_typeclasses_verbose () =
+  if !typeclasses_debug = 0 then None else Some !typeclasses_debug
+
+let set_typeclasses_depth d = (:=) typeclasses_depth d
+let get_typeclasses_depth () = !typeclasses_depth
+
 open Goptions
 
 let _ =
   declare_bool_option
     { optsync  = true;
-      optdepr  = false;
+      optdepr  = true;
       optname  = "do typeclass search modulo eta conversion";
       optkey   = ["Typeclasses";"Modulo";"Eta"];
       optread  = get_typeclasses_modulo_eta;
@@ -54,47 +102,97 @@ let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
+      optname  = "do typeclass search avoiding eta-expansions " ^
+                   " in proof terms (expensive)";
+      optkey   = ["Typeclasses";"Limit";"Intros"];
+      optread  = get_typeclasses_limit_intros;
+      optwrite = set_typeclasses_limit_intros; }
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
       optname  = "during typeclass resolution, solve instances according to their dependency order";
       optkey   = ["Typeclasses";"Dependency";"Order"];
       optread  = get_typeclasses_dependency_order;
       optwrite = set_typeclasses_dependency_order; }
 
-(** We transform the evars that are concerned by this resolution
-    (according to predicate p) into goals.
-    Invariant: function p only manipulates and returns undefined evars *)
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "use iterative deepening strategy";
+      optkey   = ["Typeclasses";"Iterative";"Deepening"];
+      optread  = get_typeclasses_iterative_deepening;
+      optwrite = set_typeclasses_iterative_deepening; }
 
-let top_sort evm undefs =
-  let l' = ref [] in
-  let tosee = ref undefs in
-  let rec visit ev evi = 
-    let evs = Evarutil.undefined_evars_of_evar_info evm evi in
-      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
-      let ev, evi = Evar.Map.min_binding !tosee in
-	visit ev evi
-    done;
-    List.rev !l'
+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 evars_to_goals p evm =
-  let goals = ref Evar.Map.empty in
-  let map ev evi =
-    let evi, goal = p evm ev evi in
-    let () = if goal then goals := Evar.Map.add ev evi !goals in
-    evi
-  in
-  let evm = Evd.raw_map_undefined map evm in
-  if Evar.Map.is_empty !goals then None
-  else Some (!goals, evm)
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "compat";
+      optkey   = ["Typeclasses";"Filtered";"Unification"];
+      optread  = get_typeclasses_filtered_unification;
+      optwrite = set_typeclasses_filtered_unification; }
+
+let set_typeclasses_debug =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "debug output for typeclasses proof search";
+      optkey   = ["Typeclasses";"Debug"];
+      optread  = get_typeclasses_debug;
+      optwrite = set_typeclasses_debug; }
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "debug output for typeclasses proof search";
+      optkey   = ["Debug";"Typeclasses"];
+      optread  = get_typeclasses_debug;
+      optwrite = set_typeclasses_debug; }
+
+let _ =
+  declare_int_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "verbosity of debug output for typeclasses proof search";
+      optkey   = ["Typeclasses";"Debug";"Verbosity"];
+      optread  = get_typeclasses_verbose;
+      optwrite = set_typeclasses_verbose; }
+
+let set_typeclasses_depth =
+  declare_int_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "depth for typeclasses proof search";
+      optkey   = ["Typeclasses";"Depth"];
+      optread  = get_typeclasses_depth;
+      optwrite = set_typeclasses_depth; }
+
+type search_strategy = Dfs | Bfs
+
+let set_typeclasses_strategy = function
+  | Dfs -> set_typeclasses_iterative_deepening false
+  | 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))
 
 (** Typeclasses instance search tactic / eauto *)
 
 open Auto
-
 open Unification
 
 let auto_core_unif_flags st freeze = {
@@ -112,7 +210,7 @@ let auto_core_unif_flags st freeze = {
   modulo_eta = !typeclasses_modulo_eta;
 }
 
-let auto_unif_flags freeze st = 
+let auto_unif_flags freeze st =
   let fl = auto_core_unif_flags st freeze in
   { core_unify_flags = fl;
     merge_unify_flags = fl;
@@ -121,182 +219,346 @@ let auto_unif_flags freeze st =
     resolve_evars = false
 }
 
-let rec eq_constr_mod_evars x y =
-  match kind_of_term x, kind_of_term y with
-  | Evar (e1, l1), Evar (e2, l2) when not (Evar.equal e1 e2) -> true
-  | _, _ -> compare_constr eq_constr_mod_evars x y
-
-let progress_evars t =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let check =
-      Proofview.Goal.nf_enter begin fun gl' ->
-        let newconcl = Proofview.Goal.concl gl' in
-        if eq_constr_mod_evars concl newconcl
-        then Tacticals.New.tclFAIL 0 (str"No progress made (modulo evars)")
-        else Proofview.tclUNIT ()
-      end
-    in t <*> check
-  end
-
-
 let e_give_exact flags poly (c,clenv) gl =
   let (c, _, _) = c in
   let c, gl =
     if poly then
       let clenv', subst = Clenv.refresh_undefined_univs clenv in
-      let clenv' = connect_clenv gl clenv' in
+      let evd = evars_reset_evd ~with_conv_pbs:true gl.sigma clenv'.evd in
       let c = Vars.subst_univs_level_constr subst c in
-	c, {gl with sigma = clenv'.evd}
+        c, {gl with sigma = evd}
     else c, gl
   in
   let t1 = pf_unsafe_type_of gl c in
-    tclTHEN (Proofview.V82.of_tactic (Clenvtac.unify ~flags t1)) (exact_no_check c) gl
+  Proofview.V82.of_tactic (Clenvtac.unify ~flags t1 <*> exact_no_check c) gl
 
-let unify_e_resolve poly flags (c,clenv) gls =
+let unify_e_resolve poly flags = { enter = 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 }
 
-let unify_resolve poly flags (c,clenv) gls =
+let unify_resolve poly flags = { enter = 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 }
+
+(** 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
+      let sigma, term, ty =
+        if poly then
+          let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
+          let map c = Vars.subst_univs_level_constr subst c in
+          let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
+          sigma, map c, map t
+        else
+          let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
+          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 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') }
+
+let unify_resolve_refine poly flags gl clenv =
+  Proofview.tclORELSE
+    (unify_resolve_refine poly flags gl clenv)
+    (fun ie ->
+      match fst ie with
+      | Evarconv.UnableToUnify _ ->
+         Tacticals.New.tclZEROMSG (str "Unable to unify")
+      | e when CErrors.noncritical e ->
+         Tacticals.New.tclZEROMSG (str "Unexpected error")
+      | _ -> iraise ie)
+
+(** Dealing with goals of the form A -> B and hints of the form
+  C -> A -> B.
+*)
 let clenv_of_prods poly nprods (c, clenv) gl =
   let (c, _, _) = c in
-  if poly || Int.equal nprods 0 then Some clenv
+  if poly || Int.equal nprods 0 then Some (None, clenv)
   else
-    let ty = Tacmach.New.pf_unsafe_type_of gl c in
+    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
-      if Pervasives.(>=) diff 0 then
-        (* Was Some clenv... *)
-	Some (Tacmach.New.of_old (fun gls -> mk_clenv_from_n gls (Some diff) (c,ty)) gl)
-      else None
+    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)
+    else None
 
 let with_prods nprods poly (c, clenv) f =
-  Proofview.Goal.nf_enter (fun gl ->
-  match clenv_of_prods poly nprods (c, clenv) gl with
-  | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
-  | Some clenv' -> f (c, clenv') gl)
+  if get_typeclasses_limit_intros () then
+    Proofview.Goal.nf_enter { 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')
+      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 }
+
+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 ->
+     let env = Proofview.Goal.env gl in
+     let sigma = Proofview.Goal.sigma gl in
+       matches env sigma }
+
+(** Semantics of type class resolution lemma application:
+
+  - Use unification to find a well-typed substitution. There might
+    be evars in the goal and the lemma. Evars in the goal can get refined.
+  - Independent evars are turned into goals, whatever their kind is.
+  - Dependent evars of the lemma corresponding to arguments which appear
+    in independent goals or the conclusion are turned into subgoals iff
+    they are of typeclass kind.
+  - The remaining dependent evars not of typeclass type are shelved,
+    and resolution must fill them for it to succeed, otherwise we
+    backtrack.
+ *)
+
+let pr_gls sigma gls =
+  prlist_with_sep spc
+   (fun ev -> int (Evar.repr ev) ++ spc () ++ pr_ev sigma ev) gls
+
+(** Ensure the dependent subgoals are shelved after an apply/eapply. *)
+let shelve_dependencies gls =
+  let open Proofview in
+  tclEVARMAP >>= fun sigma ->
+  (if !typeclasses_debug > 1 && List.length gls > 0 then
+     Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls);
+   shelve_goals gls)
+
+let hintmap_of hdc secvars concl =
+  match hdc with
+  | 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
 
 (** Hack to properly solve dependent evars that are typeclasses *)
-
-let rec e_trivial_fail_db db_list local_db goal =
+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 =
+    begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
+    let d = pf_last_hyp gl in
+    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 }
+  in
+  let trivial_resolve =
+    Proofview.Goal.nf_enter { enter =
+    begin fun gl ->
+    let tacs = e_trivial_resolve db_list local_db secvars only_classes
+                                 (project gl) (pf_concl gl) in
+      tclFIRST (List.map (fun (x,_,_,_,_) -> x) tacs)
+    end}
+  in
   let tacl =
     Eauto.registered_e_assumption ::
-    (tclTHEN (Proofview.V82.of_tactic Tactics.intro)
-       (function g'->
-	  let d = pf_last_hyp g' in
-	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
-          (e_trivial_fail_db db_list
-	      (Hint_db.add_list (pf_env g') (project g') hintl local_db) g'))) ::
-    (List.map (fun (x,_,_,_,_) -> x) 
-     (e_trivial_resolve db_list local_db (project goal) (pf_concl goal)))
+    (tclTHEN Tactics.intro trivial_fail :: [trivial_resolve])
   in
-  tclFIRST (List.map tclCOMPLETE tacl) goal
+  tclFIRST (List.map tclCOMPLETE tacl)
 
-and e_my_find_search db_list local_db hdc complete sigma concl =
+and e_my_find_search db_list local_db secvars hdc complete only_classes sigma concl =
+  let open Proofview.Notations in
   let prods, concl = decompose_prod_assum concl in
   let nprods = List.length prods in
-  let freeze = 
+  let freeze =
     try
-      let cl = Typeclasses.class_info (fst hdc) in
-	if cl.cl_strict then
-	  Evd.evars_of_term concl
-	else Evar.Set.empty
-    with e when Errors.noncritical e -> Evar.Set.empty
+      match hdc with
+      | Some (hd,_) when only_classes ->
+         let cl = Typeclasses.class_info hd in
+         if cl.cl_strict then
+           Evd.evars_of_term 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 hintl =
     List.map_append
       (fun db ->
-	let tacs = 
-	  if Hint_db.use_dn db then (* Using dnet *)
-	    Hint_db.map_eauto hdc concl db
-	  else Hint_db.map_existential hdc concl db
-	in
-	let flags = auto_unif_flags freeze (Hint_db.transparent_state db) in
-	  List.map (fun x -> (flags, x)) tacs)
+        let tacs = hint_of_db db in
+        let flags = auto_unif_flags freeze (Hint_db.transparent_state db) in
+          List.map (fun x -> (flags, x)) tacs)
       (local_db::db_list)
   in
   let tac_of_hint =
-    fun (flags, {pri = b; pat = p; poly = poly; code = t; name = name}) ->
+    fun (flags, {pri = b; pat = p; poly = poly; code = t; secvars; name = name}) ->
       let tac = function
-      | Res_pf (term,cl) -> with_prods nprods poly (term,cl) (unify_resolve poly flags)
-      | ERes_pf (term,cl) -> with_prods nprods poly (term,cl) (unify_e_resolve poly flags)
-      | Give_exact c -> Proofview.V82.tactic (e_give_exact flags poly c)
+        | Res_pf (term,cl) ->
+           if get_typeclasses_filtered_unification () then
+             let tac =
+               with_prods nprods poly (term,cl)
+                          ({ enter = fun gl clenv ->
+                             matches_pattern concl p <*>
+                               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 ->
+                             matches_pattern concl p <*>
+                             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) ->
+           if get_typeclasses_filtered_unification () then
+             let tac =
+               matches_pattern concl p <*>
+                 Proofview.Goal.nf_enter
+                   { enter = 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))
       | Res_pf_THEN_trivial_fail (term,cl) ->
-         Proofview.V82.tactic (tclTHEN
-				 (Proofview.V82.of_tactic ((with_prods nprods poly (term,cl) (unify_e_resolve poly flags))))
-				 (if complete then tclIDTAC else e_trivial_fail_db db_list local_db))
-      | Unfold_nth c -> Proofview.V82.tactic (tclWEAK_PROGRESS (unfold_in_concl [AllOccurrences,c]))
+         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)
       | Extern tacast -> conclPattern concl p tacast
       in
-      let tac = Proofview.V82.of_tactic (run_hint t tac) in
-      let tac = if complete then tclCOMPLETE tac else tac in
-	match repr_hint t with
-	| Extern _ -> (tac,b,true, name, lazy (pr_hint t))
-	| _ ->
-(* 	  let tac gl = with_pattern (pf_env gl) (project gl) flags p concl tac gl in *)
-	    (tac,b,false, name, lazy (pr_hint t))
+      let tac = run_hint t tac in
+      let tac = if complete then Tacticals.New.tclCOMPLETE tac else tac in
+      let pp =
+        match p with
+        | Some pat when get_typeclasses_filtered_unification () ->
+           str " with pattern " ++ Printer.pr_constr_pattern 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))
   in List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db sigma concl =
+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
   try
-    e_my_find_search db_list local_db
-     (decompose_app_bound concl) true sigma concl
-  with Bound | Not_found -> []
+    e_my_find_search db_list local_db secvars hd true only_classes sigma concl
+  with Not_found -> []
 
-let e_possible_resolve db_list local_db sigma concl =
+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
   try
-    e_my_find_search db_list local_db
-      (decompose_app_bound concl) false sigma concl
-  with Bound | Not_found -> []
+    e_my_find_search db_list local_db secvars hd false only_classes sigma concl
+  with Not_found -> []
+
+let cut_of_hints h =
+  List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h
 
 let catchable = function
   | Refiner.FailError _ -> true
   | e -> Logic.catchable_exception e
 
-let pr_ev evs ev = Printer.pr_constr_env (Goal.V82.env evs ev) evs (Evarutil.nf_evar evs (Goal.V82.concl evs ev))
-
 let pr_depth l = prlist_with_sep (fun () -> str ".") int (List.rev l)
 
-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 'ans fk = unit -> 'ans
-type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
-type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-
-type auto_result = autogoal list sigma
+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
+  | _ -> false
 
-type atac = auto_result tac
+let is_unique env concl =
+  try
+    let (cl,u), args = dest_class_app env concl in
+    cl.cl_unique
+  with e when CErrors.noncritical e -> false
 
-(* Some utility types to avoid the need of -rectypes *)
+(** Sort the undefined variables from the least-dependent to most dependent. *)
+let top_sort evm undefs =
+  let l' = ref [] in
+  let tosee = ref undefs in
+  let rec visit ev evi =
+    let evs = Evarutil.undefined_evars_of_evar_info evm evi in
+      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
+      let ev, evi = Evar.Map.min_binding !tosee in
+        visit ev evi
+    done;
+    List.rev !l'
 
-type 'a optionk =
-  | Nonek
-  | Somek of 'a * 'a optionk fk
+(** We transform the evars that are concerned by this resolution
+    (according to predicate p) into goals.
+    Invariant: function p only manipulates and returns undefined evars
+*)
 
-type ('a,'b) optionk2 =
-  | Nonek2
-  | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
+let evars_to_goals p evm =
+  let goals = ref Evar.Map.empty in
+  let map ev evi =
+    let evi, goal = p evm ev evi in
+    let () = if goal then goals := Evar.Map.add ev evi !goals in
+    evi
+  in
+  let evm = Evd.raw_map_undefined map evm in
+  if Evar.Map.is_empty !goals then None
+  else Some (!goals, evm)
 
-let make_resolve_hyp env sigma st flags only_classes pri (id, _, cty) =
-  let cty = Evarutil.nf_evar sigma cty in
+(** 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 rec iscl env ty =
     let ctx, ar = decompose_prod_assum ty in
       match kind_of_term (fst (decompose_app 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_betadeltaiota env' ar in
-	       if not (Term.eq_constr ty' ar) then iscl env' ty'
-	       else false
+          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'
+               else false
   in
   let is_class = iscl env cty in
   let keep = not only_classes || is_class in
@@ -304,310 +566,832 @@ let make_resolve_hyp env sigma st flags only_classes pri (id, _, cty) =
       let c = mkVar id in
       let name = PathHints [VarRef id] in
       let hints =
-	if is_class then
-	  let hints = build_subclasses ~check:false env sigma (VarRef id) None in
-	    (List.map_append
-	       (fun (path,pri, c) -> make_resolves env sigma ~name:(PathHints path)
-		  (true,false,Flags.is_verbose()) pri false
-		 (IsConstr (c,Univ.ContextSet.empty)))
-	       hints)
-	else []
+        if is_class then
+          let hints = build_subclasses ~check:false env sigma (VarRef id) empty_hint_info in
+            (List.map_append
+             (fun (path,info,c) ->
+	      let info =
+		{ info with Vernacexpr.hint_pattern =
+			    Option.map (Constrintern.intern_constr_pattern env)
+				       info.Vernacexpr.hint_pattern }
+	      in
+	      make_resolves env sigma ~name:(PathHints path)
+                  (true,false,Flags.is_verbose()) info false
+                 (IsConstr (c,Univ.ContextSet.empty)))
+               hints)
+        else []
       in
         (hints @ List.map_filter
-	 (fun f -> try Some (f (c, cty, Univ.ContextSet.empty)) 
-	   with Failure _ | UserError _ -> None)
-	 [make_exact_entry ~name env sigma pri false; 
-	  make_apply_entry ~name env sigma flags pri false])
+         (fun f -> try Some (f (c, cty, Univ.ContextSet.empty))
+           with Failure _ | UserError _ -> None)
+         [make_exact_entry ~name env sigma pri false;
+          make_apply_entry ~name env sigma flags pri false])
     else []
 
-let pf_filtered_hyps gls =
-  Goal.V82.hyps gls.Evd.sigma (sig_it gls)
-
 let make_hints g st only_classes sign =
-  let paths, hintlist =
+  let hintlist =
     List.fold_left
-    (fun (paths, hints) hyp ->
-      let consider =
-	try let (_, b, t) = Global.lookup_named (pi1 hyp) in
-	      (* Section variable, reindex only if the type changed *)
-	      not (Term.eq_constr t (pi3 hyp))
-	with Not_found -> true
-     in
-      if consider then 
-	let path, hint =
-	  PathEmpty, pf_apply make_resolve_hyp g st (true,false,false) only_classes None hyp
-	in
-	  (PathOr (paths, path), hint @ hints)
-      else (paths, hints))
-    (PathEmpty, []) sign
+      (fun hints hyp ->
+        let consider =
+          let open Context.Named.Declaration in
+          try let t = Global.lookup_named (get_id hyp) |> get_type in
+              (* Section variable, reindex only if the type changed *)
+              not (Term.eq_constr t (get_type hyp))
+          with Not_found -> true
+        in
+        if consider then
+          let hint =
+            pf_apply make_resolve_hyp g st (true,false,false) only_classes empty_hint_info hyp
+          in hint @ hints
+        else hints)
+      ([]) sign
   in Hint_db.add_list (pf_env g) (project g) hintlist (Hint_db.empty st true)
 
-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 () }
-
-let intro_tac : atac =
-  lift_tactic (Proofview.V82.of_tactic Tactics.intro)
-    (fun {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 None (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;})
-
-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 or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
-  { skft = fun sk fk gls -> x.skft sk (fun () -> y.skft sk fk gls) gls }
+(** <= 8.5 resolution *)
+module V85 = struct
 
-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
-  | _ -> false
+  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 }
 
-let is_unique env concl = 
-  try 
-    let (cl,u), args = dest_class_app env concl in
-      cl.cl_unique
-  with e when Errors.noncritical e -> false
-
-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 =
-  { skft = fun 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 poss = e_possible_resolve hints info.hints s concl in
-      let unique = is_unique env concl in
-      let rec aux i foundone = function
-      | (tac, _, b, name, pp) :: tl ->
-	let derivs = path_derivate info.auto_cut name in
-	let res =
-          try
-	    if path_matches derivs [] then None else Some (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 then
-	      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 gls' = List.map_i
-	      (fun j (evar, g) ->
-		let info =
-		  { info with auto_depth = j :: i :: info.auto_depth; auto_last_tac = pp;
-		    is_evar = evar;
-		    hints =
-		      if b && not (Environ.eq_named_context_val (Goal.V82.hyps s' g) 
-				     (Goal.V82.hyps s' gl))
-		      then make_autogoal_hints info.only_classes
-			~st:(Hint_db.transparent_state info.hints) {it = g; sigma = s';}
-		      else info.hints;
-		    auto_cut = derivs }
-		in g, info) 1 newgls in
-	    let glsv = {it = gls'; sigma = s';} in
-	    let fk' =
-	      (fun () ->
-		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
-		  if !typeclasses_debug then
-		    msg_debug 
-		      ((if do_backtrack then str"Backtracking after "
-			else str "Not backtracking after ")
-		       ++ Lazy.force pp);
-		  if do_backtrack then aux (succ i) true tl
-		  else fk ())
-	    in
-	      sk glsv fk')
-      | [] ->
-	if not foundone && !typeclasses_debug then
-	  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");
-	fk ()
-      in aux 1 false poss }
-
-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 -> fk ()
-      | Somek2 (res, s', fk') ->
-	  let goals' = List.concat res in
-	    sk {it = goals'; sigma = s'; } (fun () -> aux' (fk' ()))
-    in aux' (aux s [] (fun () -> Nonek2) 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 : atac =
-  { skft = fun sk fk _ -> fk () }
-
-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
-  else then_tac t { skft = fun sk fk -> (fix_limit (pred limit) t).skft sk fk }
-
-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 })
+  type auto_result = autogoal list sigma
 
+  type atac = auto_result tac
 
-let cut_of_hints h =
-  List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h
+  (* 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 make_autogoals ?(only_classes=true) ?(unique=false) 
-    ?(st=full_transparent_state) hints gs evm' =
-  let cut = cut_of_hints hints in
-  { it = List.map_i (fun 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]})) 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)
+  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
-    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 ?limit hints =
-  match limit with
-  | None -> fix (eauto_tac hints)
-  | Some limit -> fix_limit limit (eauto_tac hints)
-
-let eauto ?(only_classes=true) ?st ?limit hints g =
-  let gl = { it = make_autogoal ~only_classes ?st (cut_of_hints hints) None g; sigma = project g; } in
-    match run_tac (eauto_tac ?limit hints) gl with
+    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;}
+       {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;
+      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 make_autogoal_hints only_classes ?(st=full_transparent_state) g =
+    let open Proofview in
+    let open Tacmach.New in
+    let sign = Goal.hyps g in
+    let (dir, onlyc, sign', cached_hints) = !autogoal_cache in
+    let cwd = Lib.cwd () in
+    if DirPath.equal cwd dir &&
+         (onlyc == only_classes) &&
+           Context.Named.equal sign sign' &&
+             Hint_db.transparent_state cached_hints == st
+    then cached_hints
+    else
+      let hints = make_hints {it = Goal.goal g; sigma = project g}
+                             st only_classes sign
+      in
+      autogoal_cache := (cwd, only_classes, sign, hints); hints
+
+  let make_autogoal ?(st=full_transparent_state) only_classes dep cut i g =
+    let hints = make_autogoal_hints only_classes ~st g in
+    { search_hints = hints;
+      search_depth = [i]; last_tac = lazy (str"none");
+      search_dep = dep;
+      search_only_classes = only_classes;
+      search_cut = cut }
+
+  (** In the proof engine failures are represented as exceptions *)
+  exception ReachedLimitEx
+  exception NotApplicableEx
+
+  (** ReachedLimitEx has priority over NotApplicableEx to handle
+      iterative deepening: it should fail when no hints are applicable,
+      but go to a deeper depth otherwise. *)
+  let merge_exceptions e e' =
+    match fst e, fst e' with
+    | ReachedLimitEx, _ -> e
+    | _, ReachedLimitEx -> e'
+    | _, _ -> e
+
+  (** Determine if backtracking is needed for this goal.
+      If the type class is unique or in Prop
+      and there are no evars in the goal then we do
+      NOT backtrack. *)
+  let needs_backtrack env evd unique concl =
+    if unique || is_Prop env evd concl then
+      occur_existential concl
+    else true
 
-let real_eauto ?limit unique st hints p evd =
-  let res =
-    run_on_evars ~st ~unique p evd hints (eauto_tac ?limit hints)
-  in
+  let mark_unresolvables sigma goals =
+    List.fold_left
+      (fun sigma gl ->
+        let evi = Evd.find_undefined sigma gl in
+	let evi' = Typeclasses.mark_unresolvable evi in
+	Evd.add sigma gl evi')
+      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
+      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) }
+
+  (** The general hint application tactic.
+      tac1 + tac2 .... The choice of OR or ORELSE is determined
+      depending on the dependencies of the goal and the unique/Prop
+      status *)
+  let hints_tac_gl hints info kont gl : unit Proofview.tactic =
+    let open Proofview in
+    let open Proofview.Notations in
+    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
+    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 ++
+           (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
+    (* 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
+       This is an overapproximation. Evars could appear in this goal only
+       and not any other *)
+    let ortac = if backtrack then Proofview.tclOR else Proofview.tclORELSE in
+    let idx = ref 1 in
+    let foundone = ref false in
+    let rec onetac e (tac, pat, b, name, pp) tl =
+      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": " ++
+              Lazy.force pp ++
+              (if !foundone != true then
+                 str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+               else mt ())
+          in
+          Feedback.msg_debug (msg ++ str " failed with " ++ CErrors.iprint ie)
+        else ()
+      in
+      let tac_of gls i j = Goal.nf_enter { enter = 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'));
+        let hints' =
+          if b && not (Context.Named.equal (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 info' =
+          { search_depth = succ j :: i :: info.search_depth;
+            last_tac = pp;
+            search_dep = dep';
+            search_only_classes = info.search_only_classes;
+            search_hints = hints';
+            search_cut = derivs }
+        in kont info' }
+      in
+      let rec result (shelf, ()) i k =
+        foundone := true;
+        Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+        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", " ++ 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))))
+        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)))
+              else Some (ev, true)
+            with Not_found -> None
+          in
+          let remaining = CList.map_filter filter shelf in
+          (if !typeclasses_debug > 1 then
+             let prunsolved (ev, _) =
+               int (Evar.repr ev) ++ spc () ++ pr_ev sigma ev in
+             let unsolved = prlist_with_sep spc prunsolved remaining in
+             Feedback.msg_debug
+               (pr_depth (i :: info.search_depth) ++
+                  str": after " ++ Lazy.force pp ++ str" finished, " ++
+                  int (List.length remaining) ++
+                  str " goals are shelved and unsolved ( " ++
+                  unsolved ++ str")"));
+          begin
+            (* Some existentials produced by the original tactic were not solved
+               in the subgoals, turn them into subgoals now. *)
+            let shelved, goals = List.partition (fun (ev, s) -> s) remaining in
+            let shelved = List.map fst shelved @ nestedshelf and goals = List.map fst goals in
+            if !typeclasses_debug > 1 && not (List.is_empty shelved && List.is_empty goals) then
+              Feedback.msg_debug
+                (str"Adding shelved subgoals to the search: " ++
+                 prlist_with_sep spc (pr_ev sigma) goals ++
+		 str" while shelving " ++
+		 prlist_with_sep spc (pr_ev sigma) shelved);
+            shelve_goals shelved <*>
+              (if List.is_empty goals then tclUNIT ()
+               else
+	         let sigma' = mark_unresolvables sigma goals in
+	         with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>=
+                      fun s -> result s i (Some (Option.default 0 k + j)))
+          end
+        in with_shelf res >>= fun (sh, ()) ->
+           tclEVARMAP >>= finish sh
+      in
+      if path_matches derivs [] then aux e tl
+      else
+        let filter =
+          if false (* in 8.6, still allow non-class subgoals
+                    info.search_only_classes *) then fail_if_nonclass info
+          else Proofview.tclUNIT ()
+        in
+        ortac
+             (with_shelf (tac <*> filter) >>= fun s ->
+              let i = !idx in incr idx; result s i None)
+             (fun e' ->
+	      if CErrors.noncritical (fst e') then
+                (pr_error e'; aux (merge_exceptions e e') tl)
+              else iraise e')
+    and aux e = function
+      | x :: xs -> onetac e x xs
+      | [] ->
+         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) ++
+                str" possibilities");
+         match e with
+         | (ReachedLimitEx,ie) -> Proofview.tclZERO ~info:ie ReachedLimitEx
+         | (_,ie) -> Proofview.tclZERO ~info:ie NotApplicableEx
+    in
+    if backtrack then aux (NotApplicableEx,Exninfo.null) poss
+    else tclONCE (aux (NotApplicableEx,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 }
+
+  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)
+                       (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 info' =
+      { info with search_hints = ldb; last_tac = lazy (str"intro");
+        search_depth = 1 :: 1 :: info.search_depth }
+    in kont info'
+
+  let intro info kont =
+    Proofview.tclBIND Tactics.intro
+     (fun _ -> Proofview.Goal.nf_enter { enter = fun gl -> intro_tac info kont gl })
+
+  let rec search_tac hints limit depth =
+    let kont info =
+      Proofview.numgoals >>= fun i ->
+      if !typeclasses_debug > 1 then
+        Feedback.msg_debug
+          (str"calling eauto recursively at depth " ++ int (succ depth)
+           ++ str" on " ++ int i ++ str" subgoals");
+      search_tac hints limit (succ depth) info
+    in
+    fun info ->
+    if Int.equal depth (succ limit) then Proofview.tclZERO ReachedLimitEx
+    else
+      Proofview.tclOR (hints_tac hints info kont)
+                      (fun e -> Proofview.tclOR (intro info kont)
+                      (fun e' -> let (e, info) = merge_exceptions e e' in
+                              Proofview.tclZERO ~info e))
+
+  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
+      let dep = dep || Proofview.unifiable sigma (Goal.goal gl) gls in
+      let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in
+      search_tac hints depth 1 info
+
+  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 }
+    in
+      Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+      Proofview.tclEVARMAP >>= fun sigma ->
+      let j = List.length gls in
+      (tclDISPATCH (List.init j (fun i -> tac sigma gls i)))
+
+  let fix_iterative t =
+    let rec aux depth =
+      Proofview.tclOR
+        (t depth)
+        (function
+         | (ReachedLimitEx,_) -> aux (succ depth)
+         | (e,ie) -> Proofview.tclZERO ~info:ie e)
+    in aux 1
+
+  let fix_iterative_limit limit t =
+    let open Proofview in
+    let rec aux depth =
+      if Int.equal depth (succ limit) then tclZERO ReachedLimitEx
+      else tclOR (t depth) (function (ReachedLimitEx, _) -> aux (succ depth)
+                                   | (e,ie) -> Proofview.tclZERO ~info:ie e)
+    in aux 1
+
+  let eauto_tac ?(st=full_transparent_state) ?(unique=false)
+                ~only_classes ?strategy ~depth ~dep hints =
+    let open Proofview in
+    let tac =
+      let search = search_tac ~st only_classes dep hints in
+      let dfs =
+        match strategy with
+        | None -> not (get_typeclasses_iterative_deepening ())
+        | Some Dfs -> true
+        | Some Bfs -> false
+      in
+      if dfs then
+        let depth = match depth with None -> -1 | Some d -> d in
+        search depth
+      else
+        match depth with
+        | None -> fix_iterative search
+        | Some l -> fix_iterative_limit l search
+    in
+    let error (e, ie) =
+      match e with
+      | ReachedLimitEx ->
+         Tacticals.New.tclFAIL 0 (str"Proof search reached its limit")
+      | NotApplicableEx ->
+         Tacticals.New.tclFAIL 0 (str"Proof search failed" ++
+                                    (if Option.is_empty depth then mt()
+                                     else str" without reaching its limit"))
+      | Proofview.MoreThanOneSuccess ->
+         Tacticals.New.tclFAIL 0 (str"Proof search failed: " ++
+                                  str"more than one success found")
+      | e -> Proofview.tclZERO ~info:ie e
+    in
+    let tac = Proofview.tclOR tac error in
+    let tac =
+      if unique then
+        Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac
+      else tac
+    in
+    with_shelf numgoals >>= fun (initshelf, i) ->
+    (if !typeclasses_debug > 1 then
+       Feedback.msg_debug (str"Starting resolution with " ++ int i ++
+                             str" goal(s) under focus and " ++
+                             int (List.length initshelf) ++ str " shelved goal(s)" ++
+                             (if only_classes then str " in only_classes mode" else str " in regular mode") ++
+                             match depth with None -> str ", unbounded"
+                                            | Some i -> str ", with depth limit " ++ int i));
+    tac
+
+  let run_on_evars p evm 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 fgoals = Evd.future_goals evm in
+       let pgoal = Evd.principal_future_goal 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
+         in
+         if Proofview.finished pv' then
+           let evm' = Proofview.return pv' in
+           assert(Evd.fold_undefined (fun ev _ acc ->
+                      let okev = Evd.mem evm ev || List.mem ev shelved in
+                      if not okev then
+                        Feedback.msg_debug
+                          (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 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 eauto_tac = eauto_tac ~st ~unique ~only_classes ~depth ~dep:(unique || dep) hints in
+    let res = run_on_evars p evd eauto_tac in
     match res with
     | None -> evd
-    | Some (evd', fk) -> 
-      if unique then
-	(match get_result (fk ()) with
-	| Some (evd'', fk') -> error "Typeclass resolution gives multiple solutions"
-	| None -> evd')
-      else evd'
-    
-let resolve_all_evars_once debug limit unique p evd =
-  let db = searchtable_map typeclasses_db in
-    real_eauto ?limit unique (Hint_db.transparent_state db) [db] p evd
+    | Some evd' -> evd'
+
+  let typeclasses_eauto ?depth unique st hints p evd =
+    evars_eauto depth true unique false st hints p evd
+  (** 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 db = searchtable_map typeclasses_db in
+    typeclasses_eauto ?depth unique (Hint_db.transparent_state db) [db] p evd
+end
+
+(** Binding to either V85 or Search implementations. *)
+
+let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state)
+                      ?strategy ~depth dbs =
+  let dbs = List.map_filter
+              (fun db -> try Some (searchtable_map db)
+                      with e when CErrors.noncritical e -> None)
+              dbs
+  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
 
 (** We compute dependencies via a union-find algorithm.
     Beware of the imperative effects on the partition structure,
@@ -629,24 +1413,6 @@ let evar_dependencies evm p =
       in Intpart.union_set evars p)
     evm ()
 
-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 (gl,t,sigma) =
-    Goal.V82.mk_goal sigma nc gl Store.empty in
-  let gls = { it = gl ; sigma = sigma; } in
-  let hints = searchtable_map typeclasses_db in
-  let gls' = eauto ?limit:!typeclasses_depth ~st:(Hint_db.transparent_state hints) [hints] gls in
-  let evd = sig_sig gls' in
-  let t' = let (ev, inst) = destEvar t in
-    mkEvar (ev, Array.of_list subst)
-  in
-  let term = Evarutil.nf_evar evd t' in
-    evd, term
-
-let _ =
-  Typeclasses.solve_instantiation_problem := 
-    (fun x y z w -> resolve_one_typeclass x ~sigma:y z w)
-
 (** [split_evars] returns groups of undefined evars according to dependencies *)
 
 let split_evars evm =
@@ -662,9 +1428,9 @@ let is_inference_forced p evd ev =
     then
       let (loc, k) = evar_source ev evd in
       match k with
-	| Evar_kinds.ImplicitArg (_, _, b) -> b
-	| Evar_kinds.QuestionMark _ -> false
-	| _ -> true
+        | Evar_kinds.ImplicitArg (_, _, b) -> b
+        | Evar_kinds.QuestionMark _ -> false
+        | _ -> true
     else true
   with Not_found -> assert false
 
@@ -731,12 +1497,11 @@ let revert_resolvability oevd evd =
   in
   Evd.raw_map_undefined map evd
 
-(** If [do_split] is [true], we try to separate the problem in
-    several components and then solve them separately *)
-
 exception Unresolved
 
-let resolve_all_evars debug m unique env p oevd do_split fail =
+(** 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 in_comp comp ev = if do_split then Evar.Set.mem ev comp else true
   in
@@ -745,16 +1510,21 @@ let resolve_all_evars debug m unique env p oevd do_split fail =
     | comp :: comps ->
       let p = select_and_update_evars p oevd (in_comp comp) in
       try
-	 let evd' = resolve_all_evars_once debug m unique p evd in
-	 if has_undefined p oevd evd' then raise Unresolved;
-	 docomp evd' comps
+        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
+         if has_undefined p oevd evd' then raise Unresolved;
+         docomp evd' comps
       with Unresolved | Not_found ->
-	if fail && (not do_split || is_mandatory (p evd) comp evd)
-	then (* Unable to satisfy the constraints. *)
+        if fail && (not do_split || is_mandatory (p evd) comp evd)
+        then (* Unable to satisfy the constraints. *)
           let comp = if do_split then Some comp else None in
-	  error_unresolvable env comp evd
-	else (* Best effort: do nothing on this component *)
-	  docomp evd comps
+          error_unresolvable env comp evd
+        else (* Best effort: do nothing on this component *)
+          docomp evd comps
   in docomp oevd split
 
 let initial_select_evars filter =
@@ -762,61 +1532,51 @@ let initial_select_evars filter =
     filter ev (snd evi.Evd.evar_source) &&
     Typeclasses.is_class_evar evd evi
 
-let resolve_typeclass_evars debug m unique env evd filter split fail =
+let resolve_typeclass_evars debug depth unique env evd filter split fail =
   let evd =
-    try Evarconv.consider_remaining_unif_problems
+    try Evarconv.solve_unif_constraints_with_heuristics
       ~ts:(Typeclasses.classes_transparent_state ()) env evd
-    with e when Errors.noncritical e -> evd
+    with e when CErrors.noncritical e -> evd
   in
-    resolve_all_evars debug m unique env (initial_select_evars filter) evd split fail
+    resolve_all_evars debug depth unique env
+                      (initial_select_evars filter) evd split fail
 
-let solve_inst debug depth env evd filter unique split fail =
-  resolve_typeclass_evars debug depth unique env evd filter split fail
+let solve_inst env evd filter unique split fail =
+  resolve_typeclass_evars
+    (get_typeclasses_debug ())
+    (get_typeclasses_depth ())
+    unique env evd filter split fail
 
 let _ =
-  Typeclasses.solve_instantiations_problem :=
-    solve_inst false !typeclasses_depth
-
-let set_typeclasses_debug d = (:=) typeclasses_debug d;
-  Typeclasses.solve_instantiations_problem := solve_inst d !typeclasses_depth
-
-let get_typeclasses_debug () = !typeclasses_debug
+  Hook.set Typeclasses.solve_all_instances_hook solve_inst
 
-let set_typeclasses_depth d = (:=) typeclasses_depth d;
-  Typeclasses.solve_instantiations_problem := solve_inst !typeclasses_debug !typeclasses_depth
-
-let get_typeclasses_depth () = !typeclasses_depth
-
-open Goptions
-
-let set_typeclasses_debug =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "debug output for typeclasses proof search";
-      optkey   = ["Typeclasses";"Debug"];
-      optread  = get_typeclasses_debug;
-      optwrite = set_typeclasses_debug; }
-
-let set_typeclasses_depth =
-  declare_int_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "depth for typeclasses proof search";
-      optkey   = ["Typeclasses";"Depth"];
-      optread  = get_typeclasses_depth;
-      optwrite = set_typeclasses_depth; }
+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 (gl,t,sigma) =
+    Goal.V82.mk_goal sigma nc gl Store.empty 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 term = Evarutil.nf_evar evd t' in
+    evd, term
 
-let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) dbs gl =
-  try
-    let dbs = List.map_filter
-      (fun db -> try Some (searchtable_map db)
-        with e when Errors.noncritical e -> None)
-      dbs
-    in
-    let st = match dbs with x :: _ -> Hint_db.transparent_state x | _ -> st in
-      eauto ?limit:!typeclasses_depth ~only_classes ~st dbs gl
-   with Not_found -> tclFAIL 0 (str" typeclasses eauto failed on: " ++ Printer.pr_goal gl) gl
+let _ =
+  Hook.set Typeclasses.solve_one_instance_hook
+    (fun x y z w -> resolve_one_typeclass x ~sigma:y z w)
 
 (** Take the head of the arity of a constr.
     Used in the partial application tactic. *)
@@ -833,18 +1593,21 @@ let head_of_constr h c =
   let c = head_of_constr c in
   letin_tac None (Name h) c None Locusops.allHyps
 
-let not_evar c = match kind_of_term c with
-| Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
-| _ -> Proofview.tclUNIT ()
+let not_evar c =
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match Evarutil.kind_of_term_upto 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 autoapply c i gl =
-  let flags = auto_unif_flags Evar.Set.empty 
+  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
   let ce = mk_clenv_from gl (c,cty) in
-  let tac = unify_e_resolve false flags ((c,cty,Univ.ContextSet.empty),ce) 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
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
index f1bcfa7d..76760db0 100644
--- a/tactics/class_tactics.mli
+++ b/tactics/class_tactics.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements typeclasses eauto *)
+
 open Names
 open Constr
 open Tacmach
@@ -18,10 +20,13 @@ val get_typeclasses_debug : unit -> bool
 val set_typeclasses_depth : int option -> unit
 val get_typeclasses_depth : unit -> int option
 
-val progress_evars : unit Proofview.tactic -> unit Proofview.tactic
+type search_strategy = Dfs | Bfs
+
+val set_typeclasses_strategy : search_strategy -> unit
 
-val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state ->
-  Hints.hint_db_name list -> tactic
+val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy:search_strategy ->
+                        depth:(Int.t option) ->
+                        Hints.hint_db_name list -> unit Proofview.tactic
 
 val head_of_constr : Id.t -> Term.constr -> unit Proofview.tactic
 
@@ -30,3 +35,23 @@ val not_evar : constr -> unit Proofview.tactic
 val is_ground : constr -> tactic
 
 val autoapply : constr -> Hints.hint_db_name -> tactic
+
+module Search : sig
+  val eauto_tac :
+    ?st:Names.transparent_state ->
+    (** The transparent_state used when working with local hypotheses  *)
+    ?unique:bool ->
+    (** Should we force a unique solution *)
+    only_classes:bool ->
+    (** Should non-class goals be shelved and resolved at the end *)
+    ?strategy:search_strategy ->
+    (** Is a traversing-strategy specified? *)
+    depth:Int.t option ->
+    (** Bounded or unbounded search *)
+    dep:bool ->
+    (** Should the tactic be made backtracking on the initial goals,
+       whatever their internal dependencies are. *)
+    Hints.hint_db list ->
+    (** The list of hint databases to use *)
+    unit Proofview.tactic
+end
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 6eebf494..445a104d 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
 open Term
 open Hipattern
 open Tactics
 open Coqlib
 open Reductionops
 open Misctypes
+open Proofview.Notations
+open Context.Named.Declaration
 
 (* Absurd *)
 
@@ -22,53 +23,73 @@ let mk_absurd_proof t =
     mkLambda (Names.Name id,t,mkApp (mkRel 2,[|mkRel 1|])))
 
 let absurd c =
-  Proofview.Goal.enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
+  Proofview.Goal.s_enter { s_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 t = j.Environ.utj_val in
+    let tac =
     Tacticals.New.tclTHENLIST [
-      Proofview.Unsafe.tclEVARS sigma;
       elim_type (build_coq_False ());
       Simple.apply (mk_absurd_proof t)
-    ]
-  end
+    ] in
+    Sigma.Unsafe.of_pair (tac, sigma)
+  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
-    | (id,_,t)::rest when f t -> tac id
+    | d::rest when f (get_type d) -> tac (get_id d)
     | _::rest -> seek rest in
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
     seek hyps
-  end
+  end }
 
 let contradiction_context =
-  Proofview.Goal.enter begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
+  Proofview.Goal.enter { 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")
-      | (id,_,typ)::rest ->
-          let typ = nf_evar sigma typ in
-	  let typ = whd_betadeltaiota env sigma typ in
+      | d :: rest ->
+          let id = get_id d in
+          let typ = nf_evar sigma (get_type d) in
+	  let typ = whd_all env sigma typ in
 	  if is_empty_type 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
+	     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 nparams = Inductiveops.inductive_nparams_env env ind in
+                   let params = Util.List.firstn nparams args in
+                   let p = applist ((mkConstructUi (indu,1)), params) in
+                   (* Checking on the fly that it type-checks *)
+                   simplest_elim (mkApp (mkVar id,[|p|]))
+               | None ->
+                 Tacticals.New.tclZEROMSG (Pp.str"Not a negated unit type."))
 	      (Proofview.tclORELSE
-                 (Proofview.Goal.enter begin fun gl ->
+                 (Proofview.Goal.enter { 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
@@ -77,18 +98,18 @@ let contradiction_context =
     in
     let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
     seek_neg hyps
-  end
+  end }
 
 let is_negation_of env sigma typ t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (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
     | _ -> false
 
 let contradiction_term (c,lbind as cl) =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
+  Proofview.Goal.nf_enter { 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
@@ -110,7 +131,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/coretactics.ml4 b/tactics/coretactics.ml4
deleted file mode 100644
index 3efa65eb..00000000
--- a/tactics/coretactics.ml4
+++ /dev/null
@@ -1,239 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Util
-open Names
-open Locus
-open Misctypes
-open Genredexpr
-
-open Proofview.Notations
-
-DECLARE PLUGIN "coretactics"
-
-TACTIC EXTEND reflexivity
-  [ "reflexivity" ] -> [ Tactics.intros_reflexivity ]
-END
-
-TACTIC EXTEND assumption
-  [ "assumption" ] -> [ Tactics.assumption ]
-END
-
-TACTIC EXTEND etransitivity
-  [ "etransitivity" ] -> [ Tactics.intros_transitivity None ]
-END
-
-TACTIC EXTEND cut
-  [ "cut" constr(c) ] -> [ Tactics.cut c ]
-END
-
-TACTIC EXTEND exact_no_check
-  [ "exact_no_check" constr(c) ] -> [ Proofview.V82.tactic (Tactics.exact_no_check c) ]
-END
-
-TACTIC EXTEND vm_cast_no_check
-  [ "vm_cast_no_check" constr(c) ] -> [ Proofview.V82.tactic (Tactics.vm_cast_no_check c) ]
-END
-
-TACTIC EXTEND native_cast_no_check
-  [ "native_cast_no_check" constr(c) ] -> [ Proofview.V82.tactic (Tactics.native_cast_no_check c) ]
-END
-
-TACTIC EXTEND casetype
-  [ "casetype" constr(c) ] -> [ Tactics.case_type c ]
-END
-
-TACTIC EXTEND elimtype
-  [ "elimtype" constr(c) ] -> [ Tactics.elim_type c ]
-END
-
-TACTIC EXTEND lapply
-  [ "lapply" constr(c) ] -> [ Tactics.cut_and_apply c ]
-END
-
-TACTIC EXTEND transitivity
-  [ "transitivity" constr(c) ] -> [ Tactics.intros_transitivity (Some c) ]
-END
-
-(** Left *)
-
-TACTIC EXTEND left
-  [ "left" ] -> [ Tactics.left_with_bindings false NoBindings ]
-END
-
-TACTIC EXTEND eleft
-  [ "eleft" ] -> [ Tactics.left_with_bindings true NoBindings ]
-END
-
-TACTIC EXTEND left_with
-  [ "left" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES false (Tactics.left_with_bindings false bl) sigma
-  ]
-END
-
-TACTIC EXTEND eleft_with
-  [ "eleft" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES true (Tactics.left_with_bindings true bl) sigma
-  ]
-END
-
-(** Right *)
-
-TACTIC EXTEND right
-  [ "right" ] -> [ Tactics.right_with_bindings false NoBindings ]
-END
-
-TACTIC EXTEND eright
-  [ "eright" ] -> [ Tactics.right_with_bindings true NoBindings ]
-END
-
-TACTIC EXTEND right_with
-  [ "right" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES false (Tactics.right_with_bindings false bl) sigma
-  ]
-END
-
-TACTIC EXTEND eright_with
-  [ "eright" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES true (Tactics.right_with_bindings true bl) sigma
-  ]
-END
-
-(** Constructor *)
-
-TACTIC EXTEND constructor
-  [ "constructor" ] -> [ Tactics.any_constructor false None ]
-| [ "constructor" int_or_var(i) ] -> [
-    let i = Tacinterp.interp_int_or_var ist i in
-    Tactics.constructor_tac false None i NoBindings
-  ]
-| [ "constructor" int_or_var(i) "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma; it = bl } = bl in
-    let i = Tacinterp.interp_int_or_var ist i in
-    let tac = Tactics.constructor_tac false None i bl in
-    Tacticals.New.tclWITHHOLES false tac sigma
-  ]
-END
-
-TACTIC EXTEND econstructor
-  [ "econstructor" ] -> [ Tactics.any_constructor true None ]
-| [ "econstructor" int_or_var(i) ] -> [
-    let i = Tacinterp.interp_int_or_var ist i in
-    Tactics.constructor_tac true None i NoBindings
-  ]
-| [ "econstructor" int_or_var(i) "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma; it = bl } = bl in
-    let i = Tacinterp.interp_int_or_var ist i in
-    let tac = Tactics.constructor_tac true None i bl in
-    Tacticals.New.tclWITHHOLES true tac sigma
-  ]
-END
-
-(** Specialize *)
-
-TACTIC EXTEND specialize
-  [ "specialize" constr_with_bindings(c) ] -> [
-    let { Evd.sigma = sigma; it = c } = c in
-    let specialize = Proofview.V82.tactic (Tactics.specialize c) in
-    Tacticals.New.tclWITHHOLES false specialize sigma
-  ]
-END
-
-TACTIC EXTEND symmetry
-  [ "symmetry" ] -> [ Tactics.intros_symmetry {onhyps=Some[];concl_occs=AllOccurrences} ]
-END
-
-(** Split *)
-
-TACTIC EXTEND split
-  [ "split" ] -> [ Tactics.split_with_bindings false [NoBindings] ]
-END
-
-TACTIC EXTEND esplit
-  [ "esplit" ] -> [ Tactics.split_with_bindings true [NoBindings] ]
-END
-
-TACTIC EXTEND split_with
-  [ "split" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES false (Tactics.split_with_bindings false [bl]) sigma
-  ]
-END
-
-TACTIC EXTEND esplit_with
-  [ "esplit" "with" bindings(bl) ] -> [
-    let { Evd.sigma = sigma ; it = bl } = bl in
-    Tacticals.New.tclWITHHOLES true (Tactics.split_with_bindings true [bl]) sigma
-  ]
-END
-
-(** Intro *)
-
-TACTIC EXTEND intros_until
-  [ "intros" "until" quantified_hypothesis(h) ] -> [ Tactics.intros_until h ]
-END
-
-(** Revert *)
-
-TACTIC EXTEND revert
-  [ "revert" ne_hyp_list(hl) ] -> [ Tactics.revert hl ]
-END
-
-(** Simple induction / destruct *)
-
-TACTIC EXTEND simple_induction
-  [ "simple" "induction" quantified_hypothesis(h) ] -> [ Tactics.simple_induct h ]
-END
-
-TACTIC EXTEND simple_destruct
-  [ "simple" "destruct" quantified_hypothesis(h) ] -> [ Tactics.simple_destruct h ]
-END
-
-(* Admit *)
-
-TACTIC EXTEND admit
- [ "admit" ] -> [ Proofview.give_up ]
-END
-
-(* Table of "pervasives" macros tactics (e.g. auto, simpl, etc.) *)
-
-open Tacexpr
-
-let initial_atomic () =
-  let dloc = Loc.ghost in
-  let nocl = {onhyps=Some[];concl_occs=AllOccurrences} in
-  let iter (s, t) =
-    let body = TacAtom (dloc, t) in
-    Tacenv.register_ltac false false (Id.of_string s) body
-  in
-  let () = List.iter iter
-      [ "red", TacReduce(Red false,nocl);
-        "hnf", TacReduce(Hnf,nocl);
-        "simpl", TacReduce(Simpl (Redops.all_flags,None),nocl);
-        "compute", TacReduce(Cbv Redops.all_flags,nocl);
-        "intro", TacIntroMove(None,MoveLast);
-        "intros", TacIntroPattern [];
-        "cofix", TacCofix None;
-        "trivial", TacTrivial (Off,[],None);
-        "auto", TacAuto(Off,None,[],None);
-      ]
-  in
-  let iter (s, t) = Tacenv.register_ltac false false (Id.of_string s) t in
-  List.iter iter
-      [ "idtac",TacId [];
-        "fail", TacFail(TacLocal,ArgArg 0,[]);
-        "fresh", TacArg(dloc,TacFreshId [])
-      ]
-
-let () = Mltop.declare_cache_obj initial_atomic "coretactics"
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml
index 568b1d17..23ff5822 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml
@@ -6,10 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -19,42 +17,38 @@ open Proof_type
 open Tacticals
 open Tacmach
 open Tactics
-open Patternops
 open Clenv
 open Auto
 open Genredexpr
 open Tacexpr
-open Misctypes
 open Locus
 open Locusops
 open Hints
-
-DECLARE PLUGIN "eauto"
+open Proofview.Notations
 
 let eauto_unif_flags = auto_flags_of_state full_transparent_state
 
-let e_give_exact ?(flags=eauto_unif_flags) c gl =
-  let t1 = (pf_unsafe_type_of gl c) and t2 = pf_concl gl in
+let e_give_exact ?(flags=eauto_unif_flags) c =
+  Proofview.Goal.enter { 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
-     tclTHEN (Proofview.V82.of_tactic (Clenvtac.unify ~flags t1)) (exact_no_check c) gl
-  else Proofview.V82.of_tactic (exact_check c) gl
+     Tacticals.New.tclTHEN (Clenvtac.unify ~flags t1) (exact_no_check c)
+  else exact_check c
+  end }
 
 let assumption id = e_give_exact (mkVar id)
 
-let e_assumption gl =
-  tclFIRST (List.map assumption (pf_ids_of_hyps gl)) gl
-
-TACTIC EXTEND eassumption
-| [ "eassumption" ] -> [ Proofview.V82.tactic e_assumption ]
-END
+let e_assumption =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    Tacticals.New.tclFIRST (List.map assumption (Tacmach.New.pf_ids_of_hyps gl))
+  end }
 
-TACTIC EXTEND eexact
-| [ "eexact" constr(c) ] -> [ Proofview.V82.tactic (e_give_exact c) ]
-END
-
-let registered_e_assumption gl =
-  tclFIRST (List.map (fun id gl -> e_give_exact (mkVar id) gl)
-              (pf_ids_of_hyps gl)) gl
+let registered_e_assumption =
+  Proofview.Goal.enter { enter = begin fun gl ->
+  Tacticals.New.tclFIRST (List.map (fun id -> e_give_exact (mkVar id))
+              (Tacmach.New.pf_ids_of_hyps gl))
+  end }
 
 (************************************************************************)
 (*   PROLOG tactic                                                      *)
@@ -83,7 +77,7 @@ let one_step l gl =
   [Proofview.V82.of_tactic Tactics.intro]
   @ (List.map (fun c -> Proofview.V82.of_tactic (Tactics.Simple.eapply c)) (List.map mkVar (pf_ids_of_hyps gl)))
   @ (List.map (fun c -> Proofview.V82.of_tactic (Tactics.Simple.eapply c)) l)
-  @ (List.map assumption (pf_ids_of_hyps 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";
@@ -94,71 +88,72 @@ let out_term = function
   | IsConstr (c, _) -> c
   | IsGlobRef gr -> fst (Universes.fresh_global_instance (Global.env ()) gr)
 
-let prolog_tac l n gl =
-  let l = List.map (fun x -> out_term (pf_apply (prepare_hint false (false,true)) gl x)) l in
-  let n =
-    match n with
-      | ArgArg n -> n
-      | _ -> error "Prolog called with a non closed argument."
+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 c = pf_apply (prepare_hint false (false,true)) gl (sigma, c) in
+    out_term c
   in
+  let l = List.map map l in
   try (prolog l n gl)
   with UserError ("Refiner.tclFIRST",_) ->
     errorlabstrm "Prolog.prolog" (str "Prolog failed.")
-
-TACTIC EXTEND prolog
-| [ "prolog" "[" open_constr_list(l) "]" int_or_var(n) ] -> [ Proofview.V82.tactic (prolog_tac l n) ]
-END
+  end
 
 open Auto
-open Unification
 
 (***************************************************************************)
 (* A tactic similar to Auto, but using EApply, Assumption and e_give_exact *)
 (***************************************************************************)
 
 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 begin
-      fun gl ->
+  Proofview.Goal.nf_enter { 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
+    end }
 
-let hintmap_of hdc concl =
+let hintmap_of secvars hdc concl =
   match hdc with
-  | None -> fun db -> Hint_db.map_none db
+  | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
-    if occur_existential concl then (fun db -> Hint_db.map_existential hdc concl db)
-    else (fun db -> Hint_db.map_auto hdc concl db)
+     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)
    (* FIXME: should be (Hint_db.map_eauto hdc concl db) *)
 
 let e_exact poly flags (c,clenv) =
-  let (c, _, _) = c in
-  let clenv', subst = 
-    if poly then Clenv.refresh_undefined_univs clenv 
-    else clenv, Univ.empty_level_subst
-  in e_give_exact (* ~flags *) (Vars.subst_univs_level_constr subst c)
-    
-let rec e_trivial_fail_db db_list local_db goal =
+  Proofview.Goal.enter { 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 }
+
+let rec e_trivial_fail_db db_list local_db =
+  let next = Proofview.Goal.nf_enter { 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 ->
+  let secvars = compute_secvars gl in
   let tacl =
     registered_e_assumption ::
-    (tclTHEN (Proofview.V82.of_tactic Tactics.intro)
-       (function g'->
-	  let d = pf_last_hyp g' in
-	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
-          (e_trivial_fail_db db_list
-	      (Hint_db.add_list (pf_env g') (project g') hintl local_db) g'))) ::
-    (List.map fst (e_trivial_resolve db_list local_db (pf_concl goal)) )
+    (Tacticals.New.tclTHEN Tactics.intro next) ::
+    (List.map fst (e_trivial_resolve db_list local_db secvars (Tacmach.New.pf_nf_concl gl)))
   in
-    tclFIRST (List.map tclCOMPLETE tacl) goal
+  Tacticals.New.tclFIRST (List.map Tacticals.New.tclCOMPLETE tacl)
+  end }
 
-and e_my_find_search db_list local_db hdc concl =
-  let hint_of_db = hintmap_of hdc concl in
+and e_my_find_search db_list local_db secvars hdc concl =
+  let hint_of_db = hintmap_of secvars hdc concl in
   let hintl =
       List.map_append (fun db ->
 	let flags = auto_flags_of_state (Hint_db.transparent_state db) in
@@ -174,26 +169,27 @@ and e_my_find_search db_list local_db hdc concl =
         let tac = function
         | Res_pf (term,cl) -> unify_resolve poly st (term,cl)
         | ERes_pf (term,cl) -> unify_e_resolve poly st (term,cl)
-        | Give_exact (c,cl) -> Proofview.V82.tactic (e_exact poly st (c,cl))
+        | Give_exact (c,cl) -> e_exact poly st (c,cl)
         | Res_pf_THEN_trivial_fail (term,cl) ->
-          Proofview.V82.tactic (tclTHEN (Proofview.V82.of_tactic (unify_e_resolve poly st (term,cl)))
-            (e_trivial_fail_db db_list local_db))
-        | Unfold_nth c -> Proofview.V82.tactic (reduce (Unfold [AllOccurrences,c]) onConcl)
+          Tacticals.New.tclTHEN (unify_e_resolve poly st (term,cl))
+            (e_trivial_fail_db db_list local_db)
+        | Unfold_nth c -> reduce (Unfold [AllOccurrences,c]) onConcl
         | Extern tacast -> conclPattern concl p tacast
        in
-       let tac = Proofview.V82.of_tactic (run_hint t tac) in
+       let tac = run_hint t tac in
        (tac, lazy (pr_hint t)))
   in
   List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db gl =
+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 hd gl)
+  try priority (e_my_find_search db_list local_db secvars hd gl)
   with Not_found -> []
 
-let e_possible_resolve db_list local_db gl =
+let e_possible_resolve db_list local_db secvars gl =
   let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try List.map (fun (b, (tac, pp)) -> (tac, b, pp)) (e_my_find_search db_list local_db hd gl)
+  try List.map (fun (b, (tac, pp)) -> (tac, b, pp))
+               (e_my_find_search db_list local_db secvars hd gl)
   with Not_found -> []
 
 let find_first_goal gls =
@@ -210,7 +206,7 @@ type search_state = {
   dblist : hint_db list;
   localdb :  hint_db list;
   prev : prev_search_state;
-  local_lemmas : Evd.open_constr list;
+  local_lemmas : Tacexpr.delayed_open_constr list;
 }
 
 and prev_search_state = (* for info eauto *)
@@ -234,12 +230,12 @@ module SearchProblem = struct
       | [] -> []
       | (tac, cost, pptac) :: tacl ->
 	  try
-	    let lgls = apply_tac_list tac glls in
+	    let lgls = apply_tac_list (Proofview.V82.of_tactic tac) glls in
 (* 	    let gl = Proof_trees.db_pr_goal (List.hd (sig_it glls)) in *)
 (* 	      msg (hov 1 (pptac ++ str" gives: \n" ++ pr_goals lgls ++ str"\n")); *)
 	      (lgls, cost, pptac) :: aux tacl
-	  with e when Errors.noncritical e ->
-            let e = Errors.push e in
+	  with e when CErrors.noncritical e ->
+            let e = CErrors.push e in
             Refiner.catch_failerror e; aux tacl
     in aux l
 
@@ -262,9 +258,11 @@ module SearchProblem = struct
       let nbgl = List.length (sig_it lg) in
       assert (nbgl > 0);
       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 assumption_tacs =
-        let tacs = List.map map_assum (pf_ids_of_hyps g) in
+        let tacs = List.map map_assum hyps in
         let l = filter_tactics s.tacres tacs in
 	List.map (fun (res, cost, pp) -> { depth = s.depth; priority = cost; tacres = res;
 				    last_tactic = pp; dblist = s.dblist;
@@ -272,7 +270,7 @@ module SearchProblem = struct
 				    prev = ps; local_lemmas = s.local_lemmas}) l
       in
       let intro_tac =
-        let l = filter_tactics s.tacres [Proofview.V82.of_tactic Tactics.intro, (-1), lazy (str "intro")] in
+        let l = filter_tactics s.tacres [Tactics.intro, (-1), lazy (str "intro")] in
 	List.map
 	  (fun (lgls, cost, pp) ->
 	     let g' = first_goal lgls in
@@ -289,7 +287,9 @@ module SearchProblem = struct
       in
       let rec_tacs =
 	let l =
-	  filter_tactics s.tacres (e_possible_resolve s.dblist (List.hd s.localdb) (pf_concl g))
+          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)
 	in
 	List.map
 	  (fun (lgls, cost, pp) ->
@@ -352,13 +352,13 @@ let mk_eauto_dbg d =
   else Off
 
 let pr_info_nop = function
-  | Info -> msg_debug (str "idtac.")
+  | Info -> Feedback.msg_info (str "idtac.")
   | _ -> ()
 
 let pr_dbg_header = function
   | Off -> ()
-  | Debug -> msg_debug (str "(* debug eauto : *)")
-  | Info -> msg_debug (str "(* info eauto : *)")
+  | Debug -> Feedback.msg_debug (str "(* debug eauto: *)")
+  | Info  -> Feedback.msg_info (str "(* info eauto: *)")
 
 let pr_info dbg s =
   if dbg != Info then ()
@@ -369,7 +369,7 @@ let pr_info dbg s =
 	| State sp ->
 	  let mindepth = loop sp in
 	  let indent = String.make (mindepth - sp.depth) ' ' in
-	  msg_debug (str indent ++ Lazy.force s.last_tactic ++ str ".");
+	  Feedback.msg_info (str indent ++ Lazy.force s.last_tactic ++ str ".");
 	  mindepth
     in
     ignore (loop s)
@@ -416,89 +416,20 @@ let eauto ?(debug=Off) np lems dbnames =
   tclTRY (e_search_auto debug np lems db_list)
 
 let full_eauto ?(debug=Off) n lems gl =
-  let dbnames = current_db_names () in
-  let dbnames =  String.Set.remove "v62" dbnames in
-  let db_list = List.map searchtable_map (String.Set.elements dbnames) in
+  let db_list = current_pure_db () in
   tclTRY (e_search_auto debug n lems db_list) gl
 
 let gen_eauto ?(debug=Off) np lems = function
-  | None -> full_eauto ~debug np lems
-  | Some l -> eauto ~debug np lems l
+  | None -> Proofview.V82.tactic (full_eauto ~debug np lems)
+  | Some l -> Proofview.V82.tactic (eauto ~debug np lems l)
 
 let make_depth = function
   | None -> !default_search_depth
-  | Some (ArgArg d) -> d
-  | _ -> error "eauto called with a non closed argument."
+  | Some d -> d
 
 let make_dimension n = function
   | None -> (true,make_depth n)
-  | Some (ArgArg d) -> (false,d)
-  | _ -> error "eauto called with a non closed argument."
-
-open Genarg
-
-(* Hint bases *)
-
-let pr_hintbases _prc _prlc _prt = Pptactic.pr_hintbases
-
-ARGUMENT EXTEND hintbases
-  TYPED AS preident_list_opt
-  PRINTED BY pr_hintbases
-| [ "with" "*" ] -> [ None ]
-| [ "with" ne_preident_list(l) ] -> [ Some l ]
-| [ ] -> [ Some [] ]
-END
-
-let pr_constr_coma_sequence prc _ _ =
-  prlist_with_sep pr_comma (fun (_,c) -> prc c)
-
-ARGUMENT EXTEND constr_coma_sequence
-  TYPED AS open_constr_list
-  PRINTED BY pr_constr_coma_sequence
-| [ open_constr(c) "," constr_coma_sequence(l) ] -> [ c::l ]
-| [ open_constr(c) ] -> [ [c] ]
-END
-
-let pr_auto_using prc _prlc _prt = Pptactic.pr_auto_using (fun (_,c) -> prc c)
-
-ARGUMENT EXTEND auto_using
-  TYPED AS open_constr_list
-  PRINTED BY pr_auto_using
-| [ "using" constr_coma_sequence(l) ] -> [ l ]
-| [ ] -> [ [] ]
-END
-
-TACTIC EXTEND eauto
-| [ "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Proofview.V82.tactic (gen_eauto (make_dimension n p) lems db) ]
-END
-
-TACTIC EXTEND new_eauto
-| [ "new" "auto" int_or_var_opt(n) auto_using(lems)
-    hintbases(db) ] ->
-    [ match db with
-      | None -> new_full_auto (make_depth n) lems
-      | Some l -> new_auto (make_depth n) lems l ]
-END
-
-TACTIC EXTEND debug_eauto
-| [ "debug" "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Proofview.V82.tactic (gen_eauto ~debug:Debug (make_dimension n p) lems db) ]
-END
-
-TACTIC EXTEND info_eauto
-| [ "info_eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Proofview.V82.tactic (gen_eauto ~debug:Info (make_dimension n p) lems db) ]
-END
-
-TACTIC EXTEND dfs_eauto
-| [ "dfs" "eauto" int_or_var_opt(p) auto_using(lems)
-      hintbases(db) ] ->
-    [ Proofview.V82.tactic (gen_eauto (true, make_depth p) lems db) ]
-END
+  | Some d -> (false,d)
 
 let cons a l = a :: l
 
@@ -512,27 +443,26 @@ let autounfolds db occs cls gl =
     let ids = Idset.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 unfold_option unfolds cls gl
+  in Proofview.V82.of_tactic (unfold_option unfolds cls) gl
 
-let autounfold db cls gl =
+let autounfold db cls =
+  Proofview.V82.tactic begin fun gl ->
   let cls = concrete_clause_of (fun () -> pf_ids_of_hyps gl) cls in
   let tac = autounfolds db in
   tclMAP (function
     | OnHyp (id,occs,where) -> tac occs (Some (id,where))
     | OnConcl occs -> tac occs None)
     cls gl
+  end
 
-let autounfold_tac db cls gl =
+let autounfold_tac db cls =
+  Proofview.tclUNIT () >>= fun () ->
   let dbs = match db with
   | None -> String.Set.elements (current_db_names ())
   | Some [] -> ["core"]
   | Some l -> l
   in
-  autounfold dbs  cls gl
-
-TACTIC EXTEND autounfold
-| [ "autounfold" hintbases(db) clause(cl) ] -> [ Proofview.V82.tactic (autounfold_tac db cl) ]
-END
+  autounfold dbs cls
 
 let unfold_head env (ids, csts) c = 
   let rec aux c = 
@@ -567,7 +497,7 @@ let unfold_head env (ids, csts) c =
   in aux c
 
 let autounfold_one db cl =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
   let st =
@@ -586,91 +516,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
-
-(* 	  Cset.fold (fun cst -> cons (all_occurrences, EvalConstRef cst)) csts *)
-(* 	    (Id.Set.fold (fun id -> cons (all_occurrences, EvalVarRef id)) ids [])) db) *)
-(*       in unfold_option unfolds cl *)
-
-(*       let db = try searchtable_map dbname  *)
-(* 	with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname) *)
-(*       in *)
-(*       let (ids, csts) = Hint_db.unfolds db in *)
-(* 	Cset.fold (fun cst -> tclORELSE (unfold_option [(occ, EvalVarRef id)] cst)) csts *)
-(* 	  (Id.Set.fold (fun id -> tclORELSE (unfold_option [(occ, EvalVarRef id)] cl) ids acc))) *)
-(*       (tclFAIL 0 (mt())) db *)
-      
-TACTIC EXTEND autounfold_one
-| [ "autounfold_one" hintbases(db) "in" hyp(id) ] ->
-    [ autounfold_one (match db with None -> ["core"] | Some x -> "core"::x) (Some (id, InHyp)) ]
-| [ "autounfold_one" hintbases(db) ] ->
-    [ autounfold_one (match db with None -> ["core"] | Some x -> "core"::x) None ]
-      END
-
-TACTIC EXTEND autounfoldify
-| [ "autounfoldify" constr(x) ] -> [
-  Proofview.V82.tactic (
-    let db = match kind_of_term x with
-      | Const (c,_) -> Label.to_string (con_label c)
-      | _ -> assert false
-    in autounfold ["core";db] onConcl 
-  )]
-END
-
-TACTIC EXTEND unify
-| ["unify" constr(x) constr(y) ] -> [ unify x y ]
-| ["unify" constr(x) constr(y) "with" preident(base)  ] -> [
-    let table = try Some (searchtable_map base) with Not_found -> None in
-    match table with
-    | None ->
-      let msg = str "Hint table " ++ str base ++ str " not found" in
-      Tacticals.New.tclZEROMSG msg
-    | Some t ->
-      let state = Hint_db.transparent_state t in
-      unify ~state x y
-  ]
-END
-
-
-TACTIC EXTEND convert_concl_no_check
-| ["convert_concl_no_check" constr(x) ] -> [ convert_concl_no_check x DEFAULTcast ]
-END
-
-let pr_hints_path_atom _ _ _ = Hints.pp_hints_path_atom
-
-ARGUMENT EXTEND hints_path_atom
-  TYPED AS hints_path_atom
-  PRINTED BY pr_hints_path_atom
-| [ global_list(g) ] -> [ PathHints (List.map Nametab.global g) ]
-| [ "*" ] -> [ PathAny ]
-END
-
-let pr_hints_path prc prx pry c = Hints.pp_hints_path c
-
-ARGUMENT EXTEND hints_path
-  TYPED AS hints_path
-  PRINTED BY pr_hints_path
-| [ "(" hints_path(p) ")"  ] -> [ p ]
-| [ "!" hints_path(p)  ] -> [ PathStar p ]
-| [ "emp" ] -> [ PathEmpty ]
-| [ "eps" ] -> [ PathEpsilon ]
-| [ hints_path_atom(a) ] -> [ PathAtom a ]
-| [ hints_path(p) "|" hints_path(q) ] -> [ PathOr (p, q) ]
-| [ hints_path(p) ";" hints_path(q) ] -> [ PathSeq (p, q) ]
-END
-
-let pr_hintbases _prc _prlc _prt = Pptactic.pr_hintbases
-
-ARGUMENT EXTEND opthints
-  TYPED AS preident_list_opt
-  PRINTED BY pr_hintbases
-| [ ":" ne_preident_list(l) ] -> [ Some l ]
-| [ ] -> [ None ]
-END
-
-VERNAC COMMAND EXTEND HintCut CLASSIFIED AS SIDEFF
-| [ "Hint" "Cut" "[" hints_path(p) "]" opthints(dbnames) ] -> [
-  let entry = HintsCutEntry p in
-    Hints.add_hints (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
-      (match dbnames with None -> ["core"] | Some l -> l) entry ]
-END
+  end }
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index 1bb15d6c..8812093d 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -8,31 +8,26 @@
 
 open Term
 open Proof_type
-open Evd
 open Hints
 
-val hintbases : hint_db_name list option Pcoq.Gram.entry
+val e_assumption : unit Proofview.tactic
 
-val wit_hintbases : hint_db_name list option Genarg.uniform_genarg_type
+val registered_e_assumption : unit Proofview.tactic
 
-val wit_auto_using :
-  (Tacexpr.open_constr_expr list,
-  Tacexpr.open_glob_constr list, Evd.open_constr list)
-    Genarg.genarg_type
+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 e_assumption : tactic
-
-val registered_e_assumption : tactic
-
-val e_give_exact : ?flags:Unification.unify_flags -> constr -> tactic
-
-val gen_eauto : ?debug:Tacexpr.debug -> bool * int -> open_constr list ->
-  hint_db_name list option -> tactic
+val gen_eauto : ?debug:Tacexpr.debug -> bool * int -> Tacexpr.delayed_open_constr list ->
+  hint_db_name list option -> unit Proofview.tactic
 
 val eauto_with_bases :
   ?debug:Tacexpr.debug ->
   bool * int ->
-  open_constr list -> hint_db list -> Proof_type.tactic
+  Tacexpr.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
+val autounfold_one : hint_db_name list -> Locus.hyp_location option -> unit Proofview.tactic
 
-val autounfold : hint_db_name list -> Locus.clause -> tactic
+val make_dimension : int option -> int option -> bool * int
diff --git a/tactics/elim.ml b/tactics/elim.ml
index 1c7e1f0d..f2b9eec4 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -16,31 +16,23 @@ open Tacmach.New
 open Tacticals.New
 open Tactics
 open Proofview.Notations
+open Context.Named.Declaration
 
+(* Supposed to be called without as clause *)
 let introElimAssumsThen tac ba =
-  let nassums =
-    List.fold_left
-      (fun acc b -> if b then acc+2 else acc+1)
-      0 ba.Tacticals.branchsign
-  in
-  let introElimAssums = tclDO nassums intro in
+  assert (ba.Tacticals.branchnames == []);
+  let introElimAssums = tclDO ba.Tacticals.nassums intro in
   (tclTHEN introElimAssums (elim_on_ba tac ba))
 
-let introCaseAssumsThen tac ba =
-  let case_thin_sign =
-    List.flatten
-      (List.map (function b -> if b then [false;true] else [false])
-	ba.Tacticals.branchsign)
-  in
-  let n1 = List.length case_thin_sign in
+(* Supposed to be called with a non-recursive scheme *)
+let introCaseAssumsThen with_evars tac ba =
+  let n1 = List.length ba.Tacticals.branchsign in
   let n2 = List.length ba.Tacticals.branchnames in
   let (l1,l2),l3 =
     if n1 < n2 then List.chop n1 ba.Tacticals.branchnames, []
-    else
-      (ba.Tacticals.branchnames, []),
-       if n1 > n2 then snd (List.chop n2 case_thin_sign) else [] in
+    else (ba.Tacticals.branchnames, []), List.make (n1-n2) false in
   let introCaseAssums =
-    tclTHEN (intro_patterns l1) (intros_clearing l3) in
+    tclTHEN (intro_patterns with_evars l1) (intros_clearing l3) in
   (tclTHEN introCaseAssums (case_on_ba (tac l2) ba))
 
 (* The following tactic Decompose repeatedly applies the
@@ -71,7 +63,7 @@ and general_decompose_aux recognizer id =
   elimHypThen
     (introElimAssumsThen
        (fun bas ->
-	  tclTHEN (Proofview.V82.tactic (clear [id]))
+	  tclTHEN (clear [id])
 	    (tclMAP (general_decompose_on_hyp recognizer)
                (ids_of_named_context bas.Tacticals.assums))))
     id
@@ -84,20 +76,20 @@ let tmphyp_name = Id.of_string "_TmpHyp"
 let up_to_delta = ref false (* true *)
 
 let general_decompose recognizer c =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let type_of = pf_unsafe_type_of gl in
   let typc = type_of c in
   tclTHENS (cut typc)
     [ tclTHEN (intro_using tmphyp_name)
          (onLastHypId
 	    (ifOnHyp recognizer (general_decompose_aux recognizer)
-	      (fun id -> Proofview.V82.tactic (clear [id]))));
-       Proofview.V82.tactic (exact_no_check c) ]
-  end
+	      (fun id -> clear [id])));
+       exact_no_check c ]
+  end }
 
 let head_in indl t gl =
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   try
     let ity,_ =
       if !up_to_delta
@@ -107,10 +99,10 @@ let head_in indl t gl =
   with Not_found -> false
 
 let decompose_these c l =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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
+  end }
 
 let decompose_and c =
   general_decompose
@@ -138,7 +130,7 @@ let induction_trailer abs_i abs_j bargs =
     (tclDO (abs_j - abs_i) intro)
     (onLastHypId
        (fun id ->
-          Proofview.Goal.nf_enter begin fun gl ->
+          Proofview.Goal.nf_enter { enter = begin fun gl ->
 	  let idty = pf_unsafe_type_of gl (mkVar id) in
 	  let fvty = global_vars (pf_env gl) idty in
 	  let possible_bring_hyps =
@@ -146,7 +138,8 @@ let induction_trailer abs_i abs_j bargs =
           in
 	  let (hyps,_) =
             List.fold_left
-	      (fun (bring_ids,leave_ids) (cid,_,_ as d) ->
+	      (fun (bring_ids,leave_ids) d ->
+                 let cid = get_id d in
                  if not (List.mem cid leave_ids)
                  then (d::bring_ids,leave_ids)
                  else (bring_ids,cid::leave_ids))
@@ -154,15 +147,14 @@ let induction_trailer abs_i abs_j bargs =
 	  in
           let ids = List.rev (ids_of_named_context hyps) in
 	  (tclTHENLIST
-            [bring_hyps hyps; tclTRY (Proofview.V82.tactic (clear ids));
-	     simple_elimination (mkVar id)])
-          end
+            [revert ids; simple_elimination (mkVar id)])
+          end }
           ))
 
 let double_ind h1 h2 =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let abs_i = of_old (depth_of_quantified_hypothesis true h1) gl in
-  let abs_j = of_old (depth_of_quantified_hypothesis true h2) gl in
+  Proofview.Goal.nf_enter { 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 =
     if abs_i < abs_j then Proofview.tclUNIT (abs_i,abs_j) else
     if abs_i > abs_j then  Proofview.tclUNIT (abs_j,abs_i) else
@@ -173,7 +165,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 a94f642a..ae9cf85f 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -13,7 +13,7 @@ open Misctypes
 
 (** Eliminations tactics. *)
 
-val introCaseAssumsThen :
+val introCaseAssumsThen : Tacexpr.evars_flag ->
   (Tacexpr.intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
     branch_args -> unit Proofview.tactic
 
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 4ff774b8..93073fdc 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -18,6 +18,7 @@ open Indrec
 open Declarations
 open Typeops
 open Ind_tables
+open Sigma.Notations
 
 (* Induction/recursion schemes *)
 
@@ -51,19 +52,21 @@ let optimize_non_type_induction_scheme kind dep sort _ ind =
     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, c = build_induction_scheme env (Evd.from_ctx ectx) (ind,u) dep sort in
+    let sigma = Evd.merge_universe_context sigma ectx in
+    let sigma, c = build_induction_scheme env sigma (ind,u) 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 ectx = Evd.evar_universe_context_of ctxset in
-  let sigma, c = build_induction_scheme env (Evd.from_ctx ectx) (ind,u) dep sort 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
     c, Evd.evar_universe_context sigma
  
 let rect_scheme_kind_from_type =
@@ -94,6 +97,10 @@ 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)
@@ -102,10 +109,10 @@ let rec_dep_scheme_kind_from_type =
 
 let build_case_analysis_scheme_in_type dep sort ind =
   let env = Global.env () in
-  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 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 case_scheme_kind_from_type =
   declare_individual_scheme_object "_case_nodep"
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index c3679705..77f927f2 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -13,9 +13,11 @@ open Ind_tables
 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
+val rect_scheme_kind_from_type : individual scheme_kind
 val rect_dep_scheme_kind_from_type : individual scheme_kind
 val ind_scheme_kind_from_type : individual scheme_kind
 val ind_dep_scheme_kind_from_type : individual scheme_kind
+val rec_scheme_kind_from_type : individual scheme_kind
 val rec_dep_scheme_kind_from_type : individual scheme_kind
 
 
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index 8ba8f7b6..b1d3290a 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -12,9 +12,6 @@
 (*                           by Eduardo Gimenez                        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Errors
 open Util
 open Names
 open Namegen
@@ -24,7 +21,9 @@ open Tactics
 open Tacticals.New
 open Auto
 open Constr_matching
+open Misctypes
 open Hipattern
+open Pretyping
 open Tacmach.New
 open Coqlib
 
@@ -50,7 +49,6 @@ open Coqlib
    Eduardo Gimenez (30/3/98).
 *)
 
-let clear ids = Proofview.V82.tactic (clear ids)
 let clear_last = (onLastHyp (fun c -> (clear [destVar c])))
 
 let choose_eq eqonleft =
@@ -66,17 +64,22 @@ let choose_noteq eqonleft =
 
 let mkBranches c1 c2 =
   tclTHENLIST
-    [Proofview.V82.tactic (generalize [c2]);
+    [generalize [c2];
      Simple.elim c1;
      intros;
      onLastHyp Simple.case;
      clear_last;
      intros]
 
+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
+  Tacticals.New.tclDELAYEDWITHHOLES false c tac
+
 let solveNoteqBranch side =
   tclTHEN (choose_noteq side)
     (tclTHEN introf
-      (onLastHypId (fun id -> Extratactics.discrHyp id)))
+      (onLastHypId (fun id -> discrHyp id)))
 
 (* Constructs the type {c1=c2}+{~c1=c2} *)
 
@@ -116,16 +119,21 @@ let rec rewrite_and_clear hyps = match hyps with
 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
+  Tacticals.New.tclDELAYEDWITHHOLES false c tac
+
 let diseqCase hyps eqonleft =
   let diseq  = Id.of_string "diseq" in
   let absurd = Id.of_string "absurd" in
   (tclTHEN (intro_using diseq)
   (tclTHEN (choose_noteq eqonleft)
   (tclTHEN (rewrite_and_clear (List.rev hyps))
-  (tclTHEN  (Proofview.V82.tactic red_in_concl)
+  (tclTHEN  (red_in_concl)
   (tclTHEN  (intro_using absurd)
   (tclTHEN  (Simple.apply (mkVar diseq))
-  (tclTHEN  (Extratactics.injHyp absurd)
+  (tclTHEN  (injHyp absurd)
             (full_trivial []))))))))
 
 open Proofview.Notations
@@ -146,7 +154,7 @@ let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
     intros_reflexivity;
   ]
 | a1 :: largs, a2 :: rargs ->
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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
@@ -154,13 +162,13 @@ let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
     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 begin fun gl ->
+      Proofview.Goal.enter { enter = begin fun gl ->
         let concl = pf_nf_concl gl in
         match_eqdec concl >>= fun (eqonleft,op,lhs,rhs,_) ->
           let (mib,mip) = Global.lookup_inductive rectype in
@@ -169,7 +177,7 @@ let solveEqBranch rectype =
           let rargs   = getargs rhs
           and largs   = getargs lhs in
           solveArg [] eqonleft op largs rargs
-      end
+      end }
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure -> Tacticals.New.tclZEROMSG (Pp.str"Unexpected conclusion!")
@@ -185,7 +193,7 @@ let hd_app c = match kind_of_term c with
 let decideGralEquality =
   Proofview.tclORELSE
     begin
-      Proofview.Goal.enter begin fun gl ->
+      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
@@ -196,7 +204,7 @@ let decideGralEquality =
           (tclTHEN
              (mkBranches c1 c2)
              (tclORELSE (solveNoteqBranch eqonleft) (solveEqBranch rectype)))
-      end
+      end }
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure ->
@@ -207,20 +215,20 @@ let decideGralEquality =
 let decideEqualityGoal = tclTHEN intros decideGralEquality
 
 let decideEquality rectype =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let decide = mkGenDecideEqGoal rectype gl in
   (tclTHENS (cut decide) [default_auto;decideEqualityGoal])
-  end
+  end }
 
 
 (* The tactic Compare *)
 
 let compare c1 c2 =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let rectype = pf_unsafe_type_of gl c1 in
   let decide = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 in
   (tclTHENS (cut decide)
             [(tclTHEN  intro
              (tclTHEN (onLastHyp simplest_case) clear_last));
              decideEquality rectype])
-  end
+  end }
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index c9764af1..1a45217a 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -44,12 +44,11 @@
    natural expectation of the user.
 *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Vars
-open Context
 open Declarations
 open Environ
 open Inductive
@@ -58,6 +57,8 @@ open Namegen
 open Inductiveops
 open Ind_tables
 open Indrec
+open Sigma.Notations
+open Context.Rel.Declaration
 
 let hid = Id.of_string "H"
 let xid = Id.of_string "X"
@@ -70,8 +71,8 @@ let build_dependent_inductive ind (mib,mip) =
   let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
   applist
     (mkIndU ind,
-       extended_rel_list mip.mind_nrealdecls mib.mind_params_ctxt
-       @ extended_rel_list 0 realargs)
+       Context.Rel.to_extended_list mip.mind_nrealdecls mib.mind_params_ctxt
+       @ Context.Rel.to_extended_list 0 realargs)
 
 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
@@ -104,11 +105,11 @@ let get_sym_eq_data env (ind,u) =
     error "Not an inductive type with a single constructor.";
   let arityctxt = Vars.subst_instance_context u mip.mind_arity_ctxt in
   let realsign,_ = List.chop mip.mind_nrealdecls arityctxt in
-  if List.exists (fun (_,b,_) -> not (Option.is_empty b)) realsign then
+  if List.exists is_local_def realsign then
     error "Inductive equalities with local definitions in arity not supported.";
   let constrsign,ccl = decompose_prod_assum mip.mind_nf_lc.(0) in
   let _,constrargs = decompose_app ccl in
-  if not (Int.equal (rel_context_length constrsign) (rel_context_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"; (* This can be relaxed... *)
   let params,constrargs = List.chop mib.mind_nparams constrargs in
   if mip.mind_nrealargs > mib.mind_nparams then
@@ -139,11 +140,11 @@ let get_non_sym_eq_data env (ind,u) =
     error "Not an inductive type with a single constructor.";
   let arityctxt = Vars.subst_instance_context u mip.mind_arity_ctxt in
   let realsign,_ = List.chop mip.mind_nrealdecls arityctxt in
-  if List.exists (fun (_,b,_) -> not (Option.is_empty b)) realsign then
+  if List.exists is_local_def realsign then
     error "Inductive equalities with local definitions in arity not supported";
   let constrsign,ccl = decompose_prod_assum mip.mind_nf_lc.(0) in
   let _,constrargs = decompose_app ccl in
-  if not (Int.equal (rel_context_length constrsign) (rel_context_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 _,constrargs = List.chop mib.mind_nparams constrargs in
   let constrargs = List.map (Vars.subst_instance_constr u) constrargs in
@@ -169,11 +170,11 @@ 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),extended_rel_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect 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 =
-    name_context env ((Name varH,None,applied_ind)::realsign) in
+    name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let c = 
   (my_it_mkLambda_or_LetIn paramsctxt
@@ -182,7 +183,7 @@ let build_sym_scheme env ind =
      my_it_mkLambda_or_LetIn_name
        (lift_rel_context (nrealargs+1) realsign_ind)
        (mkApp (mkIndU indu,Array.concat
-	  [extended_rel_vect (3*nrealargs+2) paramsctxt1;
+	  [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
 	   rel_vect 1 nrealargs;
 	   rel_vect (2*nrealargs+2) nrealargs])),
      mkRel 1 (* varH *),
@@ -223,16 +224,16 @@ 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),extended_rel_vect n paramsctxt) in
+  let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect 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
-         (extended_rel_vect (nrealargs+1) mib.mind_params_ctxt)
+         (Context.Rel.to_extended_vect (nrealargs+1) mib.mind_params_ctxt)
          (rel_vect (nrealargs+1) nrealargs)) in
   let realsign_ind =
-    name_context env ((Name varH,None,applied_ind)::realsign) in
+    name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let c = 
     (my_it_mkLambda_or_LetIn paramsctxt
@@ -243,15 +244,15 @@ let build_sym_involutive_scheme env ind =
 	       (mkApp (eq,[|
 	       mkApp
 	       (mkIndU indu, Array.concat
-	       [extended_rel_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
 		rel_vect (2*nrealargs+2) nrealargs;
 		rel_vect 1 nrealargs]);
                mkApp (sym,Array.concat
-	       [extended_rel_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
 		rel_vect 1 nrealargs;
 		rel_vect (2*nrealargs+2) nrealargs;
 		[|mkApp (sym,Array.concat
-		[extended_rel_vect (3*nrealargs+2) paramsctxt1;
+		[Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
 		 rel_vect (2*nrealargs+2) nrealargs;
 		 rel_vect 1 nrealargs;
 		 [|mkRel 1|]])|]]);
@@ -334,7 +335,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 [extended_rel_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect 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
@@ -342,26 +343,26 @@ 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
-       [extended_rel_vect (3*nrealargs) paramsctxt1;
+       [Context.Rel.to_extended_vect (3*nrealargs) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect nrealargs nrealargs]) in
   let applied_ind_G =
     mkApp (mkIndU indu, Array.concat
-       [extended_rel_vect (3*nrealargs+3) paramsctxt1;
+       [Context.Rel.to_extended_vect (3*nrealargs+3) paramsctxt1;
         rel_vect (nrealargs+3) nrealargs;
         rel_vect 0 nrealargs]) in
   let realsign_P = lift_rel_context nrealargs realsign in
   let realsign_ind_P =
-    name_context env ((Name varH,None,applied_ind_P)::realsign_P) in
+    name_context env ((LocalAssum (Name varH,applied_ind_P))::realsign_P) in
   let realsign_ind_G =
-    name_context env ((Name varH,None,applied_ind_G)::
+    name_context env ((LocalAssum (Name varH,applied_ind_G))::
                       lift_rel_context (nrealargs+3) realsign) in
   let applied_sym_C n =
      mkApp(sym,
-       Array.append (extended_rel_vect n mip.mind_arity_ctxt) [|mkVar varH|]) in
+       Array.append (Context.Rel.to_extended_vect n mip.mind_arity_ctxt) [|mkVar varH|]) in
   let applied_sym_G =
      mkApp(sym,
-       Array.concat [extended_rel_vect (nrealargs*3+4) paramsctxt1;
+       Array.concat [Context.Rel.to_extended_vect (nrealargs*3+4) paramsctxt1;
                      rel_vect (nrealargs+4) nrealargs;
                      rel_vect 1 nrealargs;
 		     [|mkRel 1|]]) in
@@ -371,7 +372,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 (extended_rel_vect 1 realsign)
+    mkApp (mkVar varP,Array.append (Context.Rel.to_extended_vect 1 realsign)
            (if dep then [|cstr (2*nrealargs+1) 1|] else [||])) in
   let applied_PG =
     mkApp (mkVar varP,Array.append (rel_vect 1 nrealargs)
@@ -381,11 +382,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
-	   [extended_rel_vect (2*nrealargs+4) paramsctxt1;
+	   [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
             rel_vect 4 nrealargs;
             rel_vect (nrealargs+4) nrealargs;
             [|mkApp (sym,Array.concat
-	      [extended_rel_vect (2*nrealargs+4) paramsctxt1;
+	      [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
 	       rel_vect (nrealargs+4) nrealargs;
 	       rel_vect 4 nrealargs;
 	       [|mkRel 2|]])|]]) in
@@ -408,7 +409,7 @@ 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 (extended_rel_vect 3 mip.mind_arity_ctxt) [|mkVar varH|]),
+         Array.append (Context.Rel.to_extended_vect 3 mip.mind_arity_ctxt) [|mkVar varH|]),
        [|main_body|])
    else
      main_body))))))
@@ -447,7 +448,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 [extended_rel_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect 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
@@ -455,19 +456,19 @@ 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
-       [extended_rel_vect (4*nrealargs+2) paramsctxt1;
+       [Context.Rel.to_extended_vect (4*nrealargs+2) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect (nrealargs+1) nrealargs]) in
   let applied_ind_P' =
     mkApp (mkIndU indu, Array.concat
-       [extended_rel_vect (3*nrealargs+1) paramsctxt1;
+       [Context.Rel.to_extended_vect (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
   let realsign_ind =
-    name_context env ((Name varH,None,applied_ind)::realsign) in
+    name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
   let realsign_ind_P n aP =
-    name_context env ((Name varH,None,aP)::realsign_P n) in
+    name_context env ((LocalAssum (Name varH,aP))::realsign_P n) in
   let s, ctx' = Universes.fresh_sort_in_family (Global.env ()) kind in
   let ctx = Univ.ContextSet.union ctx ctx' in
   let s = mkSort s in
@@ -538,14 +539,14 @@ 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),extended_rel_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect 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
   let varP = fresh env (Id.of_string "P") in
   let applied_ind = build_dependent_inductive indu specif in
   let realsign_ind =
-    name_context env ((Name varH,None,applied_ind)::realsign) in
+    name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
   let s, ctx' = Universes.fresh_sort_in_family (Global.env ()) kind in
   let ctx = Univ.ContextSet.union ctx ctx' in
   let s = mkSort s in
@@ -554,8 +555,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 extended_rel_vect 0 realsign_ind
-	   else extended_rel_vect 1 realsign) in
+           if dep then Context.Rel.to_extended_vect 0 realsign_ind
+	   else Context.Rel.to_extended_vect 1 realsign) in
   let c = 
   (my_it_mkLambda_or_LetIn paramsctxt
   (my_it_mkLambda_or_LetIn_name realsign_ind
@@ -599,12 +600,12 @@ let fix_r2l_forward_rew_scheme (c, ctx') =
   | hp :: p :: ind :: indargs ->
      let c' = 
       my_it_mkLambda_or_LetIn indargs
-	(mkLambda_or_LetIn (map_rel_declaration (liftn (-1) 1) p)
-	  (mkLambda_or_LetIn (map_rel_declaration (liftn (-1) 2) hp)
-	    (mkLambda_or_LetIn (map_rel_declaration (lift 2) ind)
+        (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,
-	          extended_rel_list 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))
+	          Context.Rel.to_extended_list 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))
       in c', ctx'
   | _ -> anomaly (Pp.str "Ill-formed non-dependent left-to-right rewriting scheme")
 
@@ -630,9 +631,10 @@ let fix_r2l_forward_rew_scheme (c, ctx') =
 (**********************************************************************)
  
 let build_r2l_rew_scheme dep env ind k =
-  let sigma, indu = Evd.fresh_inductive_instance env (Evd.from_env env) ind in
-  let sigma', c = build_case_analysis_scheme env sigma indu dep k in
-    c, Evd.evar_universe_context sigma'
+  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 build_l2r_rew_scheme = build_l2r_rew_scheme
 let build_l2r_forward_rew_scheme = build_l2r_forward_rew_scheme
@@ -736,13 +738,13 @@ let build_congr env (eq,refl,ctx) ind =
   let arityctxt = Vars.subst_instance_context u mip.mind_arity_ctxt in
   let paramsctxt = Vars.subst_instance_context u mib.mind_params_ctxt in
   let realsign,_ = List.chop mip.mind_nrealdecls arityctxt in
-  if List.exists (fun (_,b,_) -> not (Option.is_empty b)) realsign then
+  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) = lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity in
+  let ty = 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 (rel_context_length constrsign) (rel_context_length mib.mind_params_ctxt) then
+  if 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
@@ -758,8 +760,8 @@ let build_congr env (eq,refl,ctx) ind =
      (mkNamedLambda varH
         (applist
            (mkIndU indu,
-	    extended_rel_list (mip.mind_nrealargs+2) paramsctxt @
-	    extended_rel_list 0 realsign))
+	    Context.Rel.to_extended_list (mip.mind_nrealargs+2) paramsctxt @
+	    Context.Rel.to_extended_list 0 realsign))
      (mkCase (ci,
        my_it_mkLambda_or_LetIn_name
 	 (lift_rel_context (mip.mind_nrealargs+3) realsign)
@@ -767,9 +769,9 @@ let build_congr env (eq,refl,ctx) ind =
            (Anonymous,
             applist
              (mkIndU indu,
-	        extended_rel_list (2*mip.mind_nrealdecls+3)
+	        Context.Rel.to_extended_list (2*mip.mind_nrealdecls+3)
 		  paramsctxt
-	        @ extended_rel_list 0 realsign),
+	        @ Context.Rel.to_extended_list 0 realsign),
             mkApp (eq,
 	      [|mkVar varB;
                 mkApp (mkVar varf, [|lift (2*mip.mind_nrealdecls+4) b|]);
diff --git a/tactics/equality.ml b/tactics/equality.ml
index ef1ec13b..bb3cbad9 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -40,8 +40,10 @@ open Eqschemes
 open Locus
 open Locusops
 open Misctypes
+open Sigma.Notations
 open Proofview.Notations
 open Unification
+open Context.Named.Declaration
 
 (* Options *)
 
@@ -70,14 +72,27 @@ let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
-      optname  = "injection left-to-right pattern order";
+      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) }
 
-(* Rewriting tactics *)
+let injection_in_context = ref false
 
-let clear ids = Proofview.V82.tactic (clear ids)
+let use_injection_in_context () =
+  !injection_in_context
+  && Flags.version_strictly_greater Flags.V8_5
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "injection in context";
+      optkey   = ["Structural";"Injection"];
+      optread  = (fun () -> !injection_in_context) ;
+      optwrite = (fun b -> injection_in_context := b) }
+
+(* Rewriting tactics *)
 
 let tclNOTSAMEGOAL tac =
   Proofview.V82.tactic (Tacticals.tclNOTSAMEGOAL (Proofview.V82.of_tactic tac))
@@ -158,7 +173,7 @@ let instantiate_lemma_all frzevars gl c ty l l2r concl =
   let try_occ (evd', c') =
     Clenvtac.clenv_pose_dependent_evars true {eqclause with evd = evd'}
   in
-  let flags = make_flags frzevars (Proofview.Goal.sigma gl) rewrite_unif_flags eqclause in
+  let flags = make_flags frzevars (Tacmach.New.project gl) rewrite_unif_flags eqclause in
   let occs =
     w_unify_to_subterm_all ~flags env eqclause.evd
       ((if l2r then c1 else c2),concl)
@@ -229,7 +244,7 @@ let rewrite_keyed_core_unif_flags = {
 
   restrict_conv_on_strict_subterms = false;
   modulo_betaiota = true;
-  (* Different from conv_closed *)
+
   modulo_eta = true;
 }
 
@@ -242,12 +257,12 @@ let rewrite_keyed_unif_flags = {
 }
 
 let rewrite_elim with_evars frzevars cls c e =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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 (Proofview.Goal.sigma gl) flags c in
+  let flags = make_flags frzevars (Tacmach.New.project gl) flags c in
   general_elim_clause with_evars flags cls c e
-  end
+  end }
 
 (* Ad hoc asymmetric general_elim_clause *)
 let general_elim_clause with_evars frzevars cls rew elim =
@@ -282,7 +297,7 @@ 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 begin fun gl ->
+  Proofview.Goal.enter { 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
@@ -294,7 +309,7 @@ let general_elim_clause with_evars frzevars tac cls c t l l2r elim =
     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.
@@ -313,7 +328,7 @@ let jmeq_same_dom gl = function
     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 (Proofview.Goal.sigma gl) dom1 dom2
+      | _, [dom1; _; dom2;_] -> is_conv env (Tacmach.New.project gl) dom1 dom2
       | _ -> false
 
 (* find_elim determines which elimination principle is necessary to
@@ -354,8 +369,8 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
 	     Logic.eq or Jmeq just before *)
 	assert false
     in
-      let sigma, elim = Evd.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c) in
-	sigma, elim, Safe_typing.empty_private_constants
+      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)
   else
   let scheme_name = match dep, lft2rgt, inccl with
     (* Non dependent case *)
@@ -373,10 +388,10 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
   | 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 =
-	Evd.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c)
+      let Sigma (elim, sigma, p) =
+	Sigma.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c)
       in
-	sigma, elim, eff
+      Sigma ((elim, eff), sigma, p)
   | _ -> assert false
 
 let type_of_clause cls gl = match cls with
@@ -384,17 +399,21 @@ let type_of_clause cls gl = match cls with
   | 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_enter begin fun gl ->
-  let isatomic = isProd (whd_zeta hdcncl) in
+  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
   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) = find_elim hdcncl lft2rgt dep cls (Some t) gl in
-    Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclEFFECTS effs <*>
+  let Sigma ((elim, effs), sigma, p) = find_elim hdcncl lft2rgt dep cls (Some t) gl in
+  let tac =
+      Proofview.tclEFFECTS effs <*>
       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}
-  end
+  in
+  Sigma (tac, sigma, p)
+  end }
 
 let adjust_rewriting_direction args lft2rgt =
   match args with
@@ -417,8 +436,8 @@ 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 begin fun gl ->
-      let sigma = Proofview.Goal.sigma gl in
+    Proofview.Goal.enter { 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
@@ -445,7 +464,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
@@ -507,9 +526,9 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
             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 begin fun gl ->
+          Proofview.Goal.enter { enter = begin fun gl ->
             do_hyps_atleastonce (ids gl)
-          end
+          end }
 	in
 	if cl.concl_occs == NoOccurrences then do_hyps else
 	  tclIFTHENTRYELSEMUST
@@ -517,25 +536,25 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
 	   do_hyps
 
 let apply_special_clear_request clear_flag f =
-  Proofview.Goal.enter begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     try
-      let sigma,(c,bl) = f env sigma in
+      let ((c, bl), sigma) = run_delayed env sigma f 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 begin fun gl ->
-      let sigma = Proofview.Goal.sigma gl in
+    Proofview.Goal.enter { enter = begin fun gl ->
+      let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let sigma,c = f env sigma in
+      let (c, sigma) = run_delayed env sigma f 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 ()
@@ -598,19 +617,19 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
       | None -> Proofview.tclUNIT ()
       | Some tac ->  tclCOMPLETE tac
   in
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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
   let evd = 
-    if unsafe then Some (Proofview.Goal.sigma gl)
+    if unsafe then Some (Tacmach.New.project gl)
     else
-      try Some (Evarconv.the_conv_x (Proofview.Goal.env gl) t1 t2 (Proofview.Goal.sigma gl))
+      try Some (Evarconv.the_conv_x (Proofview.Goal.env gl) t1 t2 (Tacmach.New.project gl))
       with Evarconv.UnableToUnify _ -> None
   in
   match evd with
   | None ->
-    tclFAIL 0 (str"Terms do not have convertible types.")
+    tclFAIL 0 (str"Terms do not have convertible types")
   | Some evd ->
     let e = build_coq_eq () in
     let sym = build_coq_eq_sym () in
@@ -624,7 +643,7 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
           tclTHEN (apply sym) assumption;
           try_prove_eq
          ])))
-  end
+  end }
 
 let replace c1 c2 =
   replace_using_leibniz onConcl c2 c1 false false None
@@ -682,16 +701,16 @@ let replace_in_clause_maybe_by c1 c2 cl tac_opt =
 exception DiscrFound of
   (constructor * int) list * constructor * constructor
 
-let injection_on_proofs = ref false
+let keep_proof_equalities_for_injection = ref false
 
 let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
       optname  = "injection on prop arguments";
-      optkey   = ["Injection";"On";"Proofs"];
-      optread  = (fun () -> !injection_on_proofs) ;
-      optwrite = (fun b -> injection_on_proofs := b) }
+      optkey   = ["Keep";"Proof";"Equalities"];
+      optread  = (fun () -> !keep_proof_equalities_for_injection) ;
+      optwrite = (fun b -> keep_proof_equalities_for_injection := b) }
 
 
 let find_positions env sigma t1 t2 =
@@ -702,8 +721,8 @@ let find_positions env sigma t1 t2 =
     then [(List.rev posn,t1,t2)] else []
   in
   let rec findrec sorts posn t1 t2 =
-    let hd1,args1 = whd_betadeltaiota_stack env sigma t1 in
-    let hd2,args2 = whd_betadeltaiota_stack env sigma t2 in
+    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,_)
           when Int.equal (List.length args1) (constructor_nallargs_env env sp1)
@@ -736,7 +755,7 @@ let find_positions env sigma t1 t2 =
 	    project env sorts posn t1_0 t2_0
   in
   try
-    let sorts = if !injection_on_proofs then [InSet;InType;InProp]
+    let sorts = if !keep_proof_equalities_for_injection then [InSet;InType;InProp]
 		else [InSet;InType]
     in
     Inr (findrec sorts [] t1 t2)
@@ -841,7 +860,7 @@ let descend_then env sigma head dirn =
         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, head, Array.of_list brl)))
+      Inductiveops.make_case_or_project env indf ci p head (Array.of_list brl)))
 
 (* Now we need to construct the discriminator, given a discriminable
    position.  This boils down to:
@@ -856,13 +875,13 @@ let descend_then env sigma head dirn =
 
  *)
 
-(* [construct_discriminator env dirn headval]
-   constructs a case-split on [headval], with the [dirn]-th branch
-   giving [True], and all the rest giving False. *)
+(* [construct_discriminator env sigma dirn c ind special default]]
+   constructs a case-split on [c] of type [ind], with the [dirn]-th
+   branch giving [special], and all the rest giving [default]. *)
 
-let construct_discriminator env sigma dirn c sort =
+let build_selector env sigma dirn c ind special default =
   let IndType(indf,_) =
-    try find_rectype env sigma (get_type_of env sigma c)
+    try find_rectype env sigma ind
     with Not_found ->
        (* one can find Rel(k) in case of dependent constructors
           like T := c : (A:Set)A->T and a discrimination
@@ -874,25 +893,29 @@ let construct_discriminator env sigma dirn c sort =
 		 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 (true_0,false_0,sort_0) = build_coq_True(),build_coq_False(),Prop Null in
   let deparsign = make_arity_signature env true indf in
-  let p = it_mkLambda_or_LetIn (mkSort sort_0) deparsign 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 true_0 else false_0 in
+    let endpt = if Int.equal i dirn then special else default in
     it_mkLambda_or_LetIn endpt cstrs.(i-1).cs_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 rec build_discriminator env sigma dirn c sort = function
-  | [] -> construct_discriminator env sigma dirn c sort
+let rec build_discriminator env sigma 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 sort l  in
+      let subval = build_discriminator cnum_env sigma dirn newc l in
       kont subval (build_coq_False (),mkSort (Prop Null))
 
 (* Note: discrimination could be more clever: if some elimination is
@@ -907,7 +930,7 @@ let rec build_discriminator env sigma dirn c sort = function
 *)
 
 let gen_absurdity id =
-  Proofview.Goal.enter begin fun gl ->
+  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
@@ -915,7 +938,7 @@ let gen_absurdity id =
     simplest_elim (mkVar id)
   else
     tclZEROMSG (str "Not the negation of an equality.")
-  end
+  end }
 
 (* Precondition: eq is leibniz equality
 
@@ -954,11 +977,11 @@ let apply_on_clause (f,t) clause =
      | _  -> errorlabstrm "" (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 sort =
+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
-  let e_env = push_named (e,None,t) 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) sort cpath in
+    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
@@ -967,23 +990,21 @@ let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn sort =
   Proofview.Unsafe.tclEVARS sigma <*>
   Proofview.tclEFFECTS eff <*>
   tclTHENS (assert_after Anonymous absurd_term)
-    [onLastHypId gen_absurdity; (Proofview.V82.tactic (refine pf))]
+    [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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let concl = Proofview.Goal.concl gl in
     match find_positions env sigma t1 t2 with
     | Inr _ ->
 	tclZEROMSG (str"Not a discriminable equality.")
     | Inl (cpath, (_,dirn), _) ->
-	let sort = pf_apply get_type_of gl concl in
-	discr_positions env sigma u eq_clause cpath dirn sort
-  end
+	discr_positions env sigma u eq_clause cpath dirn
+  end }
 
 let onEquality with_evars tac (c,lbindc) =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { 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
@@ -995,11 +1016,11 @@ 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 begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
+  Proofview.Goal.nf_enter { 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
@@ -1009,7 +1030,7 @@ let onNegatedEquality with_evars tac =
             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
@@ -1060,7 +1081,7 @@ let make_tuple env sigma (rterm,rty) lind =
   assert (dependent (mkRel 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,_,_) = lookup_rel lind env in
+  let na = Context.Rel.Declaration.get_name (lookup_rel lind env) in
   (* We move [lind] to [1] and lift other rels > [lind] by 1 *)
   let rty = lift (1-lind) (liftn lind (lind+1) rty) in
   (* Now [lind] is [mkRel 1] and we abstract on (na:a) *)
@@ -1135,14 +1156,15 @@ let minimal_free_rels_rec env sigma =
 
 let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
   let sigdata = find_sigma_data env sort_of_ty in
-  let evdref = ref (Evd.create_goal_evar_defs sigma) in
+  let evdref = ref (Evd.clear_metas sigma) in
   let rec sigrec_clausal_form siglen p_i =
     if Int.equal siglen 0 then
       (* is the default value typable with the expected type *)
       let dflt_typ = unsafe_type_of env sigma dflt in
       try
 	let () = evdref := Evarconv.the_conv_x_leq env dflt_typ p_i !evdref in
-	let () = evdref := Evarconv.consider_remaining_unif_problems env !evdref in
+	let () =
+          evdref := Evarconv.solve_unif_constraints_with_heuristics env !evdref in
 	dflt
       with Evarconv.UnableToUnify _ ->
 	error "Cannot solve a unification problem."
@@ -1263,7 +1285,7 @@ let build_injector env sigma dflt c cpath =
 
 (*
 let try_delta_expand env sigma t =
-  let whdt = whd_betadeltaiota env sigma t  in
+  let whdt = whd_all env sigma t  in
   let rec hd_rec c  =
     match kind_of_term c with
       | Construct _ -> whdt
@@ -1278,7 +1300,7 @@ 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   try
     let eq,u,(t,t1,t2) = find_this_eq_data_decompose gl ty in
     (* fetch the informations of the  pair *)
@@ -1311,12 +1333,12 @@ let inject_if_homogenous_dependent_pair ty =
        onLastHyp (fun hyp ->
         tclTHENS (cut (mkApp (ceq,new_eq_args)))
           [clear [destVar hyp];
-           Proofview.V82.tactic (refine
+           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
@@ -1331,7 +1353,7 @@ let simplify_args env sigma 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_env = push_named (e, None,t) env in
+  let e_env = push_named (LocalAssum (e,t)) env in
   let evdref = ref sigma in
   let filter (cpath, t1', t2') =
     try
@@ -1353,13 +1375,13 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
     tclZEROMSG (str "Failed to decompose the equality.")
   else
     Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref)
-    (Proofview.tclBIND
-      (Proofview.Monad.List.map
+    (Tacticals.New.tclTHENFIRST
+      (Proofview.tclIGNORE (Proofview.Monad.List.map
          (fun (pf,ty) -> tclTHENS (cut ty)
            [inject_if_homogenous_dependent_pair ty;
-            Proofview.V82.tactic (refine pf)])
-         (if l2r then List.rev injectors else injectors))
-      (fun _ -> tac (List.length injectors)))
+            Proofview.V82.tactic (Tacmach.refine pf)])
+         (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 sigma = eq_clause.evd in
@@ -1368,7 +1390,10 @@ let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
   | Inl _ ->
      tclZEROMSG (strbrk"This equality is discriminable. You should use the discriminate tactic to solve the goal.")
   | Inr [] ->
-     let suggestion = if !injection_on_proofs then "" else " You can try to use option Set Injection On Proofs." in
+     let suggestion =
+         if !keep_proof_equalities_for_injection 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 ->
      tclZEROMSG (str"Nothing to inject.")
@@ -1376,51 +1401,68 @@ let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
       inject_at_positions env sigma l2r u eq_clause posns
 	(tac (clenv_value eq_clause))
 
-let use_clear_hyp_by_default () = false
-
-let postInjEqTac clear_flag ipats c n =
-  match ipats with
-  | Some ipats ->
-      let clear_tac =
-        let dft =
-          use_injection_pattern_l2r_order () || use_clear_hyp_by_default () in
-        tclTRY (apply_clear_request clear_flag dft c) in
-      let intro_tac =
-        if use_injection_pattern_l2r_order ()
-        then intro_patterns_bound_to n MoveLast ipats
-        else intro_patterns_to MoveLast ipats in
-      tclTHEN clear_tac intro_tac
-  | None -> tclIDTAC
-
-let injEq clear_flag ipats =
-  let l2r =
-    if use_injection_pattern_l2r_order () && not (Option.is_empty ipats) then true else false
+let get_previous_hyp_position id gl =
+  let rec aux dest = function
+  | [] -> raise (RefinerError (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
-  injEqThen (fun c i -> postInjEqTac clear_flag ipats c i) l2r
-
-let inj ipats with_evars clear_flag = onEquality with_evars (injEq clear_flag ipats)
+  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
+
+let injEq ?(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 () ->
+      Some [], true, true, true
+    | None -> None, false, false, false
+    | _ -> let b = use_injection_pattern_l2r_order () 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
+        | Var id -> get_previous_hyp_position id gl
+        | _ -> MoveLast in
+        let clear_tac =
+          tclTRY (apply_clear_request clear_flag dft_clear_flag c) in
+        (* Try should be removal if dependency were treated *)
+        let intro_tac =
+          if bounded_intro
+          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 }
+    | None -> tclIDTAC in
+  injEqThen post_tac l2r
+
+let inj ipats with_evars clear_flag = onEquality with_evars (injEq with_evars clear_flag ipats)
 
 let injClause ipats with_evars = function
-  | None -> onNegatedEquality with_evars (injEq None ipats)
+  | None -> onNegatedEquality with_evars (injEq with_evars None ipats)
   | Some c -> onInductionArg (inj 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 injConcl = injClause None false None
 let injHyp clear_flag id = injClause None false (Some (clear_flag,ElimOnIdent (Loc.ghost,id)))
 
 let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let sort = pf_apply get_type_of gl (Proofview.Goal.concl gl) in
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
     let sigma =  clause.evd in
     let env = Proofview.Goal.env gl in
       match find_positions env sigma t1 t2 with
       | Inl (cpath, (_,dirn), _) ->
-	  discr_positions env sigma u clause cpath dirn sort
+	  discr_positions env sigma u clause cpath dirn
       | Inr [] -> (* Change: do not fail, simplify clear this trivial hyp *)
         ntac (clenv_value clause) 0
     | 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))
@@ -1430,13 +1472,13 @@ let dEq with_evars =
   dEqThen with_evars (fun clear_flag c x ->
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c))
 
-let intro_decompe_eq tac data cl =
-  Proofview.Goal.enter begin fun gl ->
+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
+  end }
 
-let _ = declare_intro_decomp_eq intro_decompe_eq
+let _ = declare_intro_decomp_eq intro_decomp_eq
 
 (* [subst_tuple_term dep_pair B]
 
@@ -1485,6 +1527,7 @@ 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
@@ -1509,7 +1552,7 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
   (* 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,body,expected_goal
+  Sigma.Unsafe.of_pair ((body, expected_goal), sigma)
 
 (* Like "replace" but decompose dependent equalities                      *)
 (* i.e. if equality is "exists t v = exists u w", and goal is "phi(t,u)", *)
@@ -1517,34 +1560,42 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
 (* on for further iterated sigma-tuples                                   *)
 
 let cutSubstInConcl l2r eqn =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_s_enter { s_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 = pf_apply subst_tuple_term gl e1 e2 typ in
+  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
+  let tac =
   tclTHENFIRST
     (tclTHENLIST [
-       (Proofview.Unsafe.tclEVARS sigma);
        (change_concl typ); (* Put in pattern form *)
        (replace_core onConcl l2r eqn)
     ])
     (change_concl expected) (* Put in normalized form *)
-   end
+  in
+  Sigma (tac, sigma, p)
+  end }
 
 let cutSubstInHyp l2r eqn id =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_s_enter { s_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 = pf_apply subst_tuple_term gl e1 e2 typ in
-  tclTHENFIRST
+  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
+  let tac =
+    tclTHENFIRST
     (tclTHENLIST [
-       (Proofview.Unsafe.tclEVARS sigma);
        (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))
-  end
+  in
+  Sigma (tac, sigma, p)
+  end }
 
 let try_rewrite tac =
   Proofview.tclORELSE tac begin function (e, info) -> match e with
@@ -1566,11 +1617,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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let eq = pf_apply get_type_of gl c in
   tclTHENS (cutSubstClause l2r eq cls)
-    [Proofview.tclUNIT (); Proofview.V82.tactic (exact_no_check c)]
-  end
+    [Proofview.tclUNIT (); exact_no_check c]
+  end }
 
 let rewriteClause l2r c cls = try_rewrite (substClause l2r c cls)
 let rewriteInHyp l2r c id = rewriteClause l2r c (Some id)
@@ -1595,25 +1646,16 @@ user = raise user error specific to rewrite
 (**********************************************************************)
 (* Substitutions tactics (JCF) *)
 
-let unfold_body x =
-  Proofview.Goal.enter begin fun gl ->
-  (** We normalize the given hypothesis immediately. *)
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let (_, xval, _) = Context.lookup_named x hyps in
-  let xval = match xval with
-  | None -> errorlabstrm "unfold_body"
-    (pr_id x ++ str" is not a defined hypothesis.")
-  | Some xval -> pf_nf_evar gl xval
-  in
-  afterHyp x begin fun aft ->
-  let hl = List.fold_right (fun (y,yval,_) cl -> (y,InHyp) :: cl) aft [] in
-  let xvar = mkVar x in
-  let rfun _ _ c = replace_term xvar xval c in
-  let reducth h = Proofview.V82.tactic (fun gl -> reduct_in_hyp rfun h gl) in
-  let reductc = Proofview.V82.tactic (fun gl -> reduct_in_concl (rfun, DEFAULTcast) gl) in
-  tclTHENLIST [tclMAP reducth hl; reductc]
-  end
-  end
+let regular_subst_tactic = ref true
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "more regular behavior of tactic subst";
+      optkey   = ["Regular";"Subst";"Tactic"];
+      optread  = (fun () -> !regular_subst_tactic);
+      optwrite = (:=) regular_subst_tactic }
 
 let restrict_to_eq_and_identity eq = (* compatibility *)
   if not (is_global glob_eq eq) &&
@@ -1623,12 +1665,17 @@ let restrict_to_eq_and_identity eq = (* compatibility *)
 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 (id,_,c) =
+let is_eq_x gl x d =
+  let id = get_id d in
   try
-    let c = pf_nf_evar gl c in
+    let is_var id c = match kind_of_term c with
+    | Var id' -> Id.equal id id'
+    | _ -> false
+    in
+    let c = pf_nf_evar gl (get_type d) in
     let (_,lhs,rhs) = pi3 (find_eq_data_decompose gl c) in
-    if (Term.eq_constr x lhs) && not (occur_term x rhs) then raise (FoundHyp (id,rhs,true));
-    if (Term.eq_constr x rhs) && not (occur_term x lhs) then raise (FoundHyp (id,lhs,false))
+    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))
   with Constr_matching.PatternMatchingFailure ->
     ()
 
@@ -1636,61 +1683,61 @@ let is_eq_x gl x (id,_,c) =
    erase hyp and x; proceed by generalizing all dep hyps *)
 
 let subst_one dep_proof_ok x (hyp,rhs,dir) =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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
   (* The set of hypotheses using x *)
   let dephyps =
-    List.rev (snd (List.fold_right (fun (id,b,_ as dcl) (deps,allhyps) ->
+    List.rev (pi3 (List.fold_right (fun dcl (dest,deps,allhyps) ->
+      let id = get_id dcl in
       if not (Id.equal id hyp)
          && List.exists (fun y -> occur_var_in_decl env y dcl) deps
       then
-        ((if b = None then deps else id::deps), id::allhyps)
+        let id_dest = if !regular_subst_tactic then dest else MoveLast in
+        (dest,id::deps,(id_dest,id)::allhyps)
       else
-        (deps,allhyps))
+        (MoveBefore id,deps,allhyps))
       hyps
-      ([x],[]))) in
+      (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 need_rewrite = not (List.is_empty dephyps) || depconcl in
   tclTHENLIST
     ((if need_rewrite then
-      [revert dephyps;
+      [revert (List.map snd dephyps);
        general_rewrite dir AllOccurrences true dep_proof_ok (mkVar hyp);
-       (tclMAP intro_using dephyps)]
+       (tclMAP (fun (dest,id) -> intro_move (Some id) dest) dephyps)]
       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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume gl in
-    let (_,xval,_) = pf_get_hyp x gl in
+    let xval = pf_get_hyp x gl |> get_value 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
-      (* x is a variable: *)
-      let varx = mkVar x in
       (* Find a non-recursive definition for x *)
       let res =
         try
           (** [is_eq_x] ensures nf_evar on its side *)
           let hyps = Proofview.Goal.hyps gl in
-          let test hyp _ = is_eq_x gl varx hyp in
-          Context.fold_named_context test ~init:() hyps;
+          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 ++
 	       str".")
         with FoundHyp res -> res in
       subst_one dep_proof_ok x res
-  end
+  end }
 
 let subst_gen dep_proof_ok ids =
-  tclTHEN Proofview.V82.nf_evar_goals (tclMAP (subst_one_var dep_proof_ok) ids)
+  tclMAP (subst_one_var dep_proof_ok) ids
 
 (* For every x, look for an hypothesis hyp of the form "x=rhs" or "rhs=x",
    rewrite it everywhere, and erase hyp and x; proceed by generalizing
@@ -1709,17 +1756,6 @@ let default_subst_tactic_flags () =
   else
     { only_leibniz = true; rewrite_dependent_proof = false }
 
-let regular_subst_tactic = ref false
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "more regular behavior of tactic subst";
-      optkey   = ["Regular";"Subst";"Tactic"];
-      optread  = (fun () -> !regular_subst_tactic);
-      optwrite = (:=) regular_subst_tactic }
-
 let subst_all ?(flags=default_subst_tactic_flags ()) () =
 
   if !regular_subst_tactic then
@@ -1729,51 +1765,54 @@ let subst_all ?(flags=default_subst_tactic_flags ()) () =
     let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
-    let test (hyp,_,c) =
+    let select_equation_name decl =
       try
-        let lbeq,u,(_,x,y) = find_eq_data_decompose c in
+        let lbeq,u,(_,x,y) = find_eq_data_decompose (get_type decl) 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
-        | Var z, _ | _, Var z when not (is_evaluable env (EvalVarRef z))  ->
-            Some hyp
+        | Var z, _  when not (is_evaluable env (EvalVarRef z)) ->
+            Some (get_id decl)
+        | _, Var z when not (is_evaluable env (EvalVarRef z)) ->
+            Some (get_id decl)
         | _ ->
             None
       with Constr_matching.PatternMatchingFailure -> None
     in
     let hyps = Proofview.Goal.hyps gl in
-    List.rev (List.map_filter test hyps)
+    List.rev (List.map_filter select_equation_name hyps)
   in
 
   (* Second step: treat equations *)
   let process hyp =
-    Proofview.Goal.enter begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume 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 in
+    let c = pf_get_hyp hyp gl |> 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) ->
+      | Var x', _ when not (occur_term 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) ->
+      | _, Var y' when not (occur_term 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 begin fun gl ->
+  Proofview.Goal.nf_enter { 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let find_eq_data_decompose = find_eq_data_decompose gl in
   let test (_,c) =
     try
@@ -1790,7 +1829,7 @@ let subst_all ?(flags=default_subst_tactic_flags ()) () =
   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 *)
@@ -1818,18 +1857,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."
-    | (id,_,t) ::rest ->
+    | hyp ::rest ->
+        let id = get_id hyp in
 	begin
 	  try
-            let dir = cond_eq_term t gl in
+            let dir = cond_eq_term (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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+    let gl = Proofview.Goal.lift gl Sigma.Unsafe.le in
     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 f84dafb3..47cb6b82 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -72,16 +72,18 @@ 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 induction_arg option -> unit Proofview.tactic
+  constr with_bindings destruction_arg option -> unit Proofview.tactic
 val inj          : intro_patterns option -> evars_flag ->
   clear_flag -> constr with_bindings -> unit Proofview.tactic
 val injClause    : intro_patterns option -> evars_flag ->
-  constr with_bindings induction_arg option -> unit Proofview.tactic
+  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 ->
+  constr with_bindings destruction_arg option -> unit Proofview.tactic
 
-val dEq : evars_flag -> constr with_bindings induction_arg option -> unit Proofview.tactic
-val dEqThen : evars_flag -> (clear_flag -> constr -> int -> unit Proofview.tactic) -> constr with_bindings induction_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 make_iterated_tuple :
   env -> evar_map -> constr -> (constr * types) -> evar_map * (constr * constr * constr)
@@ -117,3 +119,8 @@ val subst_all : ?flags:subst_tactic_flags -> unit -> unit Proofview.tactic
 val replace_term : bool option -> constr -> clause -> unit Proofview.tactic
 
 val set_eq_dec_scheme_kind : mutual scheme_kind -> unit
+
+(* [build_selector env sigma i c t u v] matches on [c] of
+   type [t] and returns [u] in branch [i] and [v] on other branches *)
+val build_selector : env -> evar_map -> int -> constr -> types ->
+  constr -> constr -> constr
diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml
deleted file mode 100644
index 202aca0d..00000000
--- a/tactics/evar_tactics.ml
+++ /dev/null
@@ -1,82 +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        *)
-(************************************************************************)
-
-open Util
-open Errors
-open Evar_refiner
-open Tacmach
-open Tacexpr
-open Refiner
-open Evd
-open Locus
-
-(* The instantiate tactic *)
-
-let instantiate_evar evk (ist,rawc) sigma =
-  let evi = Evd.find sigma evk in
-  let filtered = Evd.evar_filtered_env evi in
-  let constrvars = Tacinterp.extract_ltac_constr_values ist filtered in
-  let lvar = {
-    Pretyping.ltac_constrs = constrvars;
-    ltac_uconstrs = Names.Id.Map.empty;
-    ltac_idents = Names.Id.Map.empty;
-    ltac_genargs = ist.Geninterp.lfun;
-  } in
-  let sigma' = w_refine (evk,evi) (lvar ,rawc) sigma in
-  tclEVARS sigma'
-
-let instantiate_tac n c ido =
-  Proofview.V82.tactic begin fun gl ->
-  let sigma = gl.sigma in
-  let evl =
-    match ido with
-	ConclLocation () -> evar_list (pf_concl gl)
-      | HypLocation (id,hloc) ->
-	  let decl = Environ.lookup_named_val id (Goal.V82.hyps sigma (sig_it gl)) in
-	    match hloc with
-		InHyp ->
-		  (match decl with
-		      (_,None,typ) -> evar_list typ
-		    | _ -> error
-			"Please be more specific: in type or value?")
-	      | InHypTypeOnly ->
-		  let (_, _, typ) = decl in evar_list typ
-	      | InHypValueOnly ->
-		  (match decl with
-		      (_,Some body,_) -> evar_list body
-		    | _ -> error "Not a defined hypothesis.") in
-  if List.length evl < n then
-    error "Not enough uninstantiated existential variables.";
-  if n <= 0 then error "Incorrect existential variable index.";
-  let evk,_ = List.nth evl (n-1) in
-  instantiate_evar evk c sigma gl
-  end
-
-let instantiate_tac_by_name id c =
-  Proofview.V82.tactic begin fun gl ->
-  let sigma = gl.sigma in
-  let evk =
-    try Evd.evar_key id sigma
-    with Not_found -> error "Unknown existential variable." in
-  instantiate_evar evk c sigma gl
-  end
-
-let let_evar name typ =
-  let src = (Loc.ghost,Evar_kinds.GoalEvar) in
-  Proofview.Goal.enter begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
-    let env = Proofview.Goal.env gl in
-    let id = match name with
-    | Names.Anonymous -> 
-      let id = Namegen.id_of_name_using_hdchar env typ name in
-      Namegen.next_ident_away_in_goal id (Termops.ids_of_named_context (Environ.named_context env))
-    | Names.Name id -> id in
-    let sigma',evar = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
-    Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS sigma'))
-      (Tactics.letin_tac None (Names.Name id) evar None Locusops.nowhere)
-  end
diff --git a/tactics/evar_tactics.mli b/tactics/evar_tactics.mli
deleted file mode 100644
index e67540c0..00000000
--- a/tactics/evar_tactics.mli
+++ /dev/null
@@ -1,19 +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        *)
-(************************************************************************)
-
-open Names
-open Tacexpr
-open Locus
-
-val instantiate_tac : int -> Tacinterp.interp_sign * Glob_term.glob_constr ->
-  (Id.t * hyp_location_flag, unit) location -> unit Proofview.tactic
-
-val instantiate_tac_by_name : Id.t ->
-  Tacinterp.interp_sign * Glob_term.glob_constr -> unit Proofview.tactic
-
-val let_evar : Name.t -> Term.types -> unit Proofview.tactic
diff --git a/tactics/extraargs.ml4 b/tactics/extraargs.ml4
deleted file mode 100644
index 8f336cdb..00000000
--- a/tactics/extraargs.ml4
+++ /dev/null
@@ -1,304 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Pp
-open Genarg
-open Names
-open Tacexpr
-open Taccoerce
-open Tacinterp
-open Misctypes
-open Locus
-
-(* Rewriting orientation *)
-
-let _ = Metasyntax.add_token_obj "<-"
-let _ = Metasyntax.add_token_obj "->"
-
-let pr_orient _prc _prlc _prt = function
-  | true -> Pp.mt ()
-  | false -> Pp.str " <-"
-
-ARGUMENT EXTEND orient TYPED AS bool PRINTED BY pr_orient
-| [ "->" ] -> [ true ]
-| [ "<-" ] -> [ false ]
-| [ ] -> [ true ]
-END
-
-let pr_orient = pr_orient () () ()
-
-
-let pr_int_list = Pp.pr_sequence Pp.int
-let pr_int_list_full _prc _prlc _prt l = pr_int_list l
-
-let pr_occurrences _prc _prlc _prt l =
-  match l with
-    | ArgArg x -> pr_int_list x
-    | ArgVar (loc, id) -> Nameops.pr_id id
-
-let occurrences_of = function
-  | [] -> NoOccurrences
-  | n::_ as nl when n < 0 -> AllOccurrencesBut (List.map abs nl)
-  | nl ->
-      if List.exists (fun n -> n < 0) nl then
-        Errors.error "Illegal negative occurrence number.";
-      OnlyOccurrences nl
-
-let coerce_to_int v = match Value.to_int v with
-  | None -> raise (CannotCoerceTo "an integer")
-  | Some n -> n
-
-let int_list_of_VList v = match Value.to_list v with
-| Some l -> List.map (fun n -> coerce_to_int n) l
-| _ -> raise (CannotCoerceTo "an integer")
-
-let interp_occs ist gl l =
-  match l with
-    | ArgArg x -> x
-    | ArgVar (_,id as locid) ->
-	(try int_list_of_VList (Id.Map.find id ist.lfun)
-	  with Not_found | CannotCoerceTo _ -> [interp_int ist locid])
-let interp_occs ist gl l =
-  Tacmach.project gl , interp_occs ist gl l
-
-let glob_occs ist l = l
-
-let subst_occs evm l = l
-
-ARGUMENT EXTEND occurrences
-  PRINTED BY pr_int_list_full
-
-  INTERPRETED BY interp_occs
-  GLOBALIZED BY glob_occs
-  SUBSTITUTED BY subst_occs
-
-  RAW_TYPED AS occurrences_or_var
-  RAW_PRINTED BY pr_occurrences
-
-  GLOB_TYPED AS occurrences_or_var
-  GLOB_PRINTED BY pr_occurrences
-
-| [ ne_integer_list(l) ] -> [ ArgArg l ]
-| [ var(id) ] -> [ ArgVar id ]
-END
-
-let pr_occurrences = pr_occurrences () () ()
-
-let pr_gen prc _prlc _prtac c = prc c
-
-let pr_globc _prc _prlc _prtac (_,glob) = Printer.pr_glob_constr glob
-
-let interp_glob ist gl (t,_) = Tacmach.project gl , (ist,t)
-
-let glob_glob = Tacintern.intern_constr
-
-let subst_glob = Tacsubst.subst_glob_constr_and_expr
-
-ARGUMENT EXTEND glob
-    PRINTED BY pr_globc
-
-     INTERPRETED BY interp_glob
-     GLOBALIZED BY glob_glob
-     SUBSTITUTED BY subst_glob
-
-     RAW_TYPED AS constr_expr
-     RAW_PRINTED BY pr_gen
-
-     GLOB_TYPED AS glob_constr_and_expr
-     GLOB_PRINTED BY pr_gen
-  [ constr(c) ] -> [ c ]
-END
-
-ARGUMENT EXTEND lglob
-    PRINTED BY pr_globc
-
-     INTERPRETED BY interp_glob
-     GLOBALIZED BY glob_glob
-     SUBSTITUTED BY subst_glob
-
-     RAW_TYPED AS constr_expr
-     RAW_PRINTED BY pr_gen
-
-     GLOB_TYPED AS glob_constr_and_expr
-     GLOB_PRINTED BY pr_gen
-  [ lconstr(c) ] -> [ c ]
-END
-
-type 'id gen_place= ('id * hyp_location_flag,unit) location
-
-type loc_place = Id.t Loc.located gen_place
-type place = Id.t gen_place
-
-let pr_gen_place pr_id = function
-    ConclLocation () -> Pp.mt ()
-  | HypLocation (id,InHyp) -> str "in " ++ pr_id id
-  | HypLocation (id,InHypTypeOnly) ->
-      str "in (Type of " ++ pr_id id ++ str ")"
-  | HypLocation (id,InHypValueOnly) ->
-      str "in (Value of " ++ pr_id id ++ str ")"
-
-let pr_loc_place _ _ _ = pr_gen_place (fun (_,id) -> Nameops.pr_id id)
-let pr_place _ _ _ = pr_gen_place Nameops.pr_id
-let pr_hloc = pr_loc_place () () ()
-
-let intern_place ist = function
-    ConclLocation () -> ConclLocation ()
-  | HypLocation (id,hl) -> HypLocation (Tacintern.intern_hyp ist id,hl)
-
-let interp_place ist env sigma = function
-    ConclLocation () -> ConclLocation ()
-  | HypLocation (id,hl) -> HypLocation (Tacinterp.interp_hyp ist env sigma id,hl)
-
-let interp_place ist gl p =
-  Tacmach.project gl , interp_place ist (Tacmach.pf_env gl) (Tacmach.project gl) p
-
-let subst_place subst pl = pl
-
-ARGUMENT EXTEND hloc
-    PRINTED BY pr_place
-    INTERPRETED BY interp_place
-    GLOBALIZED BY intern_place
-    SUBSTITUTED BY subst_place
-    RAW_TYPED AS loc_place
-    RAW_PRINTED BY pr_loc_place
-    GLOB_TYPED AS loc_place
-    GLOB_PRINTED BY pr_loc_place
-  [ ] ->
-    [ ConclLocation () ]
-  |  [ "in" "|-" "*" ] ->
-    [ ConclLocation () ]
-| [ "in" ident(id) ] ->
-    [ HypLocation ((Loc.ghost,id),InHyp) ]
-| [ "in" "(" "Type" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.ghost,id),InHypTypeOnly) ]
-| [ "in" "(" "Value" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.ghost,id),InHypValueOnly) ]
-
- END
-
-
-
-
-
-
-
-(* Julien: Mise en commun des differentes version de replace with in by *)
-
-let pr_by_arg_tac _prc _prlc prtac opt_c =
-  match opt_c with
-    | None -> mt ()
-    | Some t -> hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t)
-
-ARGUMENT EXTEND by_arg_tac
-  TYPED AS tactic_opt
-  PRINTED BY pr_by_arg_tac
-| [ "by" tactic3(c) ] -> [ Some c ]
-| [ ] -> [ None ]
-END
-
-let pr_by_arg_tac prtac opt_c = pr_by_arg_tac () () prtac opt_c
-
-(* spiwack: the print functions are incomplete, but I don't know what they are
-	used for *)
-let pr_r_nat_field natf =
-  str "nat " ++
-  match natf with
-    | Retroknowledge.NatType -> str "type"
-    | Retroknowledge.NatPlus -> str "plus"
-    | Retroknowledge.NatTimes -> str "times"
-
-let pr_r_n_field  nf =
-  str "binary N " ++
-  match nf with
-    | Retroknowledge.NPositive -> str "positive"
-    | Retroknowledge.NType -> str "type"
-    | Retroknowledge.NTwice -> str "twice"
-    | Retroknowledge.NTwicePlusOne -> str "twice plus one"
-    | Retroknowledge.NPhi -> str "phi"
-    | Retroknowledge.NPhiInv -> str "phi inv"
-    | Retroknowledge.NPlus -> str "plus"
-    | Retroknowledge.NTimes -> str "times"
-
-let pr_r_int31_field i31f =
-  str "int31 " ++
-  match i31f with
-    | Retroknowledge.Int31Bits -> str "bits"
-    | Retroknowledge.Int31Type -> str "type"
-    | Retroknowledge.Int31Twice -> str "twice"
-    | Retroknowledge.Int31TwicePlusOne -> str "twice plus one"
-    | Retroknowledge.Int31Phi -> str "phi"
-    | Retroknowledge.Int31PhiInv -> str "phi inv"
-    | Retroknowledge.Int31Plus -> str "plus"
-    | Retroknowledge.Int31Times -> str "times"
-    | _ -> assert false
-
-let pr_retroknowledge_field f =
-  match f with
- (* | Retroknowledge.KEq -> str "equality"
-  | Retroknowledge.KNat natf -> pr_r_nat_field () () () natf
-  | Retroknowledge.KN nf -> pr_r_n_field () () () nf *)
-  | Retroknowledge.KInt31 (group, i31f) -> (pr_r_int31_field i31f) ++
-                                           str "in " ++ str group
-
-VERNAC ARGUMENT EXTEND retroknowledge_nat
-PRINTED BY pr_r_nat_field
-| [ "nat" "type" ] -> [ Retroknowledge.NatType ]
-| [ "nat" "plus" ] -> [ Retroknowledge.NatPlus ]
-| [ "nat" "times" ] -> [ Retroknowledge.NatTimes ]
-END
-
-
-VERNAC ARGUMENT EXTEND retroknowledge_binary_n
-PRINTED BY pr_r_n_field
-| [ "binary" "N" "positive" ] -> [ Retroknowledge.NPositive ]
-| [ "binary" "N" "type" ] -> [ Retroknowledge.NType ]
-| [ "binary" "N" "twice" ] -> [ Retroknowledge.NTwice ]
-| [ "binary" "N" "twice" "plus" "one" ] -> [ Retroknowledge.NTwicePlusOne ]
-| [ "binary" "N" "phi" ] -> [ Retroknowledge.NPhi ]
-| [ "binary" "N" "phi" "inv" ] -> [ Retroknowledge.NPhiInv ]
-| [ "binary" "N" "plus" ] -> [ Retroknowledge.NPlus ]
-| [ "binary" "N" "times" ] -> [ Retroknowledge.NTimes ]
-END
-
-VERNAC ARGUMENT EXTEND retroknowledge_int31
-PRINTED BY pr_r_int31_field
-| [ "int31" "bits" ] -> [ Retroknowledge.Int31Bits ]
-| [ "int31" "type" ] -> [ Retroknowledge.Int31Type ]
-| [ "int31" "twice" ] -> [ Retroknowledge.Int31Twice ]
-| [ "int31" "twice" "plus" "one" ] -> [ Retroknowledge.Int31TwicePlusOne ]
-| [ "int31" "phi" ] -> [ Retroknowledge.Int31Phi ]
-| [ "int31" "phi" "inv" ] -> [ Retroknowledge.Int31PhiInv ]
-| [ "int31" "plus" ] -> [ Retroknowledge.Int31Plus ]
-| [ "int31" "plusc" ] -> [ Retroknowledge.Int31PlusC ]
-| [ "int31" "pluscarryc" ] -> [ Retroknowledge.Int31PlusCarryC ]
-| [ "int31" "minus" ] -> [ Retroknowledge.Int31Minus ]
-| [ "int31" "minusc" ] -> [ Retroknowledge.Int31MinusC ]
-| [ "int31" "minuscarryc" ] -> [ Retroknowledge.Int31MinusCarryC ]
-| [ "int31" "times" ] -> [ Retroknowledge.Int31Times ]
-| [ "int31" "timesc" ] -> [ Retroknowledge.Int31TimesC ]
-| [ "int31" "div21" ] -> [ Retroknowledge.Int31Div21 ]
-| [ "int31" "div" ] -> [ Retroknowledge.Int31Div ]
-| [ "int31" "diveucl" ] -> [ Retroknowledge.Int31Diveucl ]
-| [ "int31" "addmuldiv" ] -> [ Retroknowledge.Int31AddMulDiv ]
-| [ "int31" "compare" ] -> [ Retroknowledge.Int31Compare ]
-| [ "int31" "head0" ] -> [ Retroknowledge.Int31Head0 ]
-| [ "int31" "tail0" ] -> [ Retroknowledge.Int31Tail0 ]
-| [ "int31" "lor" ] -> [ Retroknowledge.Int31Lor ]
-| [ "int31" "land" ] -> [ Retroknowledge.Int31Land ]
-| [ "int31" "lxor" ] -> [ Retroknowledge.Int31Lxor ]
-END
-
-VERNAC ARGUMENT EXTEND retroknowledge_field
-PRINTED BY pr_retroknowledge_field
-(*| [ "equality" ] -> [ Retroknowledge.KEq ]
-| [ retroknowledge_nat(n)] -> [ Retroknowledge.KNat n ]
-| [ retroknowledge_binary_n (n)] -> [ Retroknowledge.KN n ]*)
-| [ retroknowledge_int31 (i) "in" string(g)] -> [ Retroknowledge.KInt31(g,i) ]
-END
diff --git a/tactics/extraargs.mli b/tactics/extraargs.mli
deleted file mode 100644
index 7c206d95..00000000
--- a/tactics/extraargs.mli
+++ /dev/null
@@ -1,60 +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        *)
-(************************************************************************)
-
-open Tacexpr
-open Names
-open Constrexpr
-open Glob_term
-open Misctypes
-
-val wit_orient : bool Genarg.uniform_genarg_type
-val orient : bool Pcoq.Gram.entry
-val pr_orient : bool -> Pp.std_ppcmds
-
-val occurrences : (int list or_var) Pcoq.Gram.entry
-val wit_occurrences : (int list or_var, int list or_var, int list) Genarg.genarg_type
-val pr_occurrences : int list or_var -> Pp.std_ppcmds
-val occurrences_of : int list -> Locus.occurrences
-
-val wit_glob :
-  (constr_expr,
-  Tacexpr.glob_constr_and_expr,
-  Tacinterp.interp_sign * glob_constr) Genarg.genarg_type
-
-val wit_lglob :
-  (constr_expr,
-  Tacexpr.glob_constr_and_expr,
-  Tacinterp.interp_sign * glob_constr) Genarg.genarg_type
-
-val glob : constr_expr Pcoq.Gram.entry
-val lglob : constr_expr Pcoq.Gram.entry
-
-type 'id gen_place= ('id * Locus.hyp_location_flag,unit) location
-
-type loc_place = Id.t Loc.located gen_place
-type place = Id.t gen_place
-
-val wit_hloc : (loc_place, loc_place, place) Genarg.genarg_type
-val hloc : loc_place Pcoq.Gram.entry
-val pr_hloc : loc_place -> Pp.std_ppcmds
-
-val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.entry
-val wit_by_arg_tac :
-  (raw_tactic_expr option,
-  glob_tactic_expr option,
-  glob_tactic_expr option) Genarg.genarg_type
-
-val pr_by_arg_tac : 
-  (int * Ppextend.parenRelation -> raw_tactic_expr -> Pp.std_ppcmds) ->
-  raw_tactic_expr option -> Pp.std_ppcmds
-
-
-(** Spiwack: Primitive for retroknowledge registration *)
-
-val retroknowledge_field : Retroknowledge.field Pcoq.Gram.entry
-val wit_retroknowledge_field : (Retroknowledge.field, unit, unit) Genarg.genarg_type
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
deleted file mode 100644
index 15613c7e..00000000
--- a/tactics/extratactics.ml4
+++ /dev/null
@@ -1,1032 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Pp
-open Genarg
-open Extraargs
-open Mod_subst
-open Names
-open Tacexpr
-open Glob_ops
-open Tactics
-open Errors
-open Util
-open Evd
-open Equality
-open Misctypes
-open Proofview.Notations
-
-DECLARE PLUGIN "extratactics"
-
-(**********************************************************************)
-(* replace, discriminate, injection, simplify_eq                      *)
-(* cutrewrite, dependent rewrite                                      *)
-
-let replace_in_clause_maybe_by (sigma1,c1) c2 cl  tac =
-  Tacticals.New.tclWITHHOLES false
-    (replace_in_clause_maybe_by c1 c2 cl (Option.map Tacinterp.eval_tactic tac))
-    sigma1
-
-let replace_term dir_opt (sigma,c) cl =
-  Tacticals.New.tclWITHHOLES false
-    (replace_term dir_opt c cl)
-    sigma
-
-TACTIC EXTEND replace
-   ["replace" open_constr(c1) "with" constr(c2) clause(cl) by_arg_tac(tac) ]
--> [ replace_in_clause_maybe_by c1 c2 cl tac ]
-END
-
-TACTIC EXTEND replace_term_left
-  [ "replace"  "->" open_constr(c) clause(cl) ]
-  -> [ replace_term (Some true) c cl ]
-END
-
-TACTIC EXTEND replace_term_right
-  [ "replace"  "<-" open_constr(c) clause(cl) ]
-  -> [ replace_term (Some false) c cl ]
-END
-
-TACTIC EXTEND replace_term
-  [ "replace" open_constr(c) clause(cl) ]
-  -> [ replace_term None c cl ]
-END
-
-let induction_arg_of_quantified_hyp = function
-  | AnonHyp n -> None,ElimOnAnonHyp n
-  | NamedHyp id -> None,ElimOnIdent (Loc.ghost,id)
-
-(* Versions *_main must come first!! so that "1" is interpreted as a
-   ElimOnAnonHyp and not as a "constr", and "id" is interpreted as a
-   ElimOnIdent and not as "constr" *)
-
-let elimOnConstrWithHoles tac with_evars c =
-  Tacticals.New.tclWITHHOLES with_evars
-    (tac with_evars (Some (None,ElimOnConstr c.it))) c.sigma
-
-TACTIC EXTEND simplify_eq_main
-| [ "simplify_eq" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles dEq false c ]
-END
-TACTIC EXTEND simplify_eq
-  [ "simplify_eq" ] -> [ dEq false None ]
-| [ "simplify_eq" quantified_hypothesis(h) ] ->
-    [ dEq false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND esimplify_eq_main
-| [ "esimplify_eq" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles dEq true c ]
-END
-TACTIC EXTEND esimplify_eq
-| [ "esimplify_eq" ] -> [ dEq true None ]
-| [ "esimplify_eq" quantified_hypothesis(h) ] ->
-    [ dEq true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-
-let discr_main c = elimOnConstrWithHoles discr_tac false c
-
-TACTIC EXTEND discriminate_main
-| [ "discriminate" constr_with_bindings(c) ] ->
-    [ discr_main c ]
-END
-TACTIC EXTEND discriminate
-| [ "discriminate" ] -> [ discr_tac false None ]
-| [ "discriminate" quantified_hypothesis(h) ] ->
-    [ discr_tac false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND ediscriminate_main
-| [ "ediscriminate" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles discr_tac true c ]
-END
-TACTIC EXTEND ediscriminate
-| [ "ediscriminate" ] -> [ discr_tac true None ]
-| [ "ediscriminate" quantified_hypothesis(h) ] ->
-    [ discr_tac true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-
-open Proofview.Notations
-let discrHyp id =
-  Proofview.tclEVARMAP >>= fun sigma ->
-  discr_main {it = Term.mkVar id,NoBindings; sigma = sigma;}
-
-let injection_main c =
- elimOnConstrWithHoles (injClause None) false c
-
-TACTIC EXTEND injection_main
-| [ "injection" constr_with_bindings(c) ] ->
-    [ injection_main c ]
-END
-TACTIC EXTEND injection
-| [ "injection" ] -> [ injClause None false None ]
-| [ "injection" quantified_hypothesis(h) ] ->
-    [ injClause None false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND einjection_main
-| [ "einjection" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles (injClause None) true c ]
-END
-TACTIC EXTEND einjection
-| [ "einjection" ] -> [ injClause None true None ]
-| [ "einjection" quantified_hypothesis(h) ] -> [ injClause None true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND injection_as_main
-| [ "injection" constr_with_bindings(c) "as" simple_intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) false c ]
-END
-TACTIC EXTEND injection_as
-| [ "injection" "as" simple_intropattern_list(ipat)] ->
-    [ injClause (Some ipat) false None ]
-| [ "injection" quantified_hypothesis(h) "as" simple_intropattern_list(ipat) ] ->
-    [ injClause (Some ipat) false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND einjection_as_main
-| [ "einjection" constr_with_bindings(c) "as" simple_intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) true c ]
-END
-TACTIC EXTEND einjection_as
-| [ "einjection" "as" simple_intropattern_list(ipat)] ->
-    [ injClause (Some ipat) true None ]
-| [ "einjection" quantified_hypothesis(h) "as" simple_intropattern_list(ipat) ] ->
-    [ injClause (Some ipat) true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-
-let injHyp id =
-  Proofview.tclEVARMAP >>= fun sigma ->
-  injection_main { it = Term.mkVar id,NoBindings; sigma = sigma; }
-
-TACTIC EXTEND dependent_rewrite
-| [ "dependent" "rewrite" orient(b) constr(c) ] -> [ rewriteInConcl b c ]
-| [ "dependent" "rewrite" orient(b) constr(c) "in" hyp(id) ]
-    -> [ rewriteInHyp b c id ]
-END
-
-(** To be deprecated?, "cutrewrite (t=u) as <-" is equivalent to
-    "replace u with t" or "enough (t=u) as <-" and 
-    "cutrewrite (t=u) as ->" is equivalent to "enough (t=u) as ->". *)
-
-TACTIC EXTEND cut_rewrite
-| [ "cutrewrite" orient(b) constr(eqn) ] -> [ cutRewriteInConcl b eqn ]
-| [ "cutrewrite" orient(b) constr(eqn) "in" hyp(id) ]
-    -> [ cutRewriteInHyp b eqn id ]
-END
-
-(**********************************************************************)
-(* Decompose                                                          *)
-
-TACTIC EXTEND decompose_sum
-| [ "decompose" "sum" constr(c) ] -> [ Elim.h_decompose_or c ]
-END
-
-TACTIC EXTEND decompose_record
-| [ "decompose" "record" constr(c) ] -> [ Elim.h_decompose_and c ]
-END
-
-(**********************************************************************)
-(* Contradiction                                                      *)
-
-open Contradiction
-
-TACTIC EXTEND absurd
- [ "absurd" constr(c) ] -> [ absurd c ]
-END
-
-let onSomeWithHoles tac = function
-  | None -> tac None
-  | Some c -> Tacticals.New.tclWITHHOLES false (tac (Some c.it)) c.sigma
-
-TACTIC EXTEND contradiction
- [ "contradiction" constr_with_bindings_opt(c) ] ->
-    [ onSomeWithHoles contradiction c ]
-END
-
-(**********************************************************************)
-(* AutoRewrite                                                        *)
-
-open Autorewrite
-
-let pr_orient _prc _prlc _prt = function
-  | true -> Pp.mt ()
-  | false -> Pp.str " <-"
-
-let pr_orient_string _prc _prlc _prt (orient, s) =
-  pr_orient _prc _prlc _prt orient ++ Pp.spc () ++ Pp.str s
-
-ARGUMENT EXTEND orient_string TYPED AS (bool * string) PRINTED BY pr_orient_string
-| [ orient(r) preident(i) ] -> [ r, i ]
-END
-
-TACTIC EXTEND autorewrite
-| [ "autorewrite" "with" ne_preident_list(l) clause(cl) ] ->
-    [ auto_multi_rewrite  l ( cl) ]
-| [ "autorewrite" "with" ne_preident_list(l) clause(cl) "using" tactic(t) ] ->
-    [
-      auto_multi_rewrite_with (Tacinterp.eval_tactic t) l cl
-    ]
-END
-
-TACTIC EXTEND autorewrite_star
-| [ "autorewrite" "*" "with" ne_preident_list(l) clause(cl) ] ->
-    [ auto_multi_rewrite ~conds:AllMatches l cl ]
-| [ "autorewrite" "*" "with" ne_preident_list(l) clause(cl) "using" tactic(t) ] ->
-  [ auto_multi_rewrite_with ~conds:AllMatches (Tacinterp.eval_tactic t) l cl ]
-END
-
-(**********************************************************************)
-(* Rewrite star                                                       *)
-
-let rewrite_star clause orient occs (sigma,c) (tac : glob_tactic_expr option) =
-  let tac' = Option.map (fun t -> Tacinterp.eval_tactic t, FirstSolved) tac in
-  Tacticals.New.tclWITHHOLES false
-    (general_rewrite_ebindings_clause clause orient occs ?tac:tac' true true (c,NoBindings) true) sigma
-
-TACTIC EXTEND rewrite_star
-| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) "at" occurrences(occ) by_arg_tac(tac) ] ->
-    [ rewrite_star (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) "in" hyp(id) by_arg_tac(tac) ] ->
-    [ rewrite_star (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "in" hyp(id) by_arg_tac(tac) ] ->
-    [ rewrite_star (Some id) o Locus.AllOccurrences c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) "at" occurrences(occ) by_arg_tac(tac) ] ->
-    [ rewrite_star None o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) open_constr(c) by_arg_tac(tac) ] ->
-    [ rewrite_star None o Locus.AllOccurrences c tac ]
-    END
-
-(**********************************************************************)
-(* Hint Rewrite                                                       *)
-
-let add_rewrite_hint bases ort t lcsr =
-  let env = Global.env() in
-  let sigma = Evd.from_env env in
-  let poly = Flags.use_polymorphic_flag () in
-  let f ce = 
-    let c, ctx = Constrintern.interp_constr env sigma ce in
-    let ctx =
-      let ctx = Evd.evar_universe_context_set Univ.UContext.empty ctx in
-        if poly then ctx
-	else (Global.push_context_set false ctx; Univ.ContextSet.empty)
-    in
-      Constrexpr_ops.constr_loc ce, (c, ctx), ort, t in
-  let eqs = List.map f lcsr in
-  let add_hints base = add_rew_rules base eqs in
-  List.iter add_hints bases
-
-let classify_hint _ = Vernacexpr.VtSideff [], Vernacexpr.VtLater
-
-VERNAC COMMAND EXTEND HintRewrite CLASSIFIED BY classify_hint
-  [ "Hint" "Rewrite" orient(o) ne_constr_list(l) ":" preident_list(bl) ] ->
-  [ add_rewrite_hint bl o None l ]
-| [ "Hint" "Rewrite" orient(o) ne_constr_list(l) "using" tactic(t)
-    ":" preident_list(bl) ] ->
-  [ add_rewrite_hint bl o (Some t) l ]
-| [ "Hint" "Rewrite" orient(o) ne_constr_list(l) ] ->
-  [ add_rewrite_hint ["core"] o None l ]
-| [ "Hint" "Rewrite" orient(o) ne_constr_list(l) "using" tactic(t) ] ->
-  [ add_rewrite_hint ["core"] o (Some t) l ]
-END
-
-(**********************************************************************)
-(* Hint Resolve                                                       *)
-
-open Term
-open Vars
-open Coqlib
-
-let project_hint pri l2r r =
-  let gr = Smartlocate.global_with_alias r in
-  let env = Global.env() in
-  let sigma = Evd.from_env env in
-  let sigma, c = Evd.fresh_global env sigma gr in
-  let t = Retyping.get_type_of env sigma c in
-  let t =
-    Tacred.reduce_to_quantified_ref env sigma (Lazy.force coq_iff_ref) t in
-  let sign,ccl = decompose_prod_assum t in
-  let (a,b) = match snd (decompose_app ccl) with
-    | [a;b] -> (a,b)
-    | _ -> assert false in
-  let p =
-    if l2r then build_coq_iff_left_proj () else build_coq_iff_right_proj () in
-  let c = Reductionops.whd_beta Evd.empty (mkApp (c,Termops.extended_rel_vect 0 sign)) in
-  let c = it_mkLambda_or_LetIn
-    (mkApp (p,[|mkArrow a (lift 1 b);mkArrow b (lift 1 a);c|])) sign in
-  let id =
-    Nameops.add_suffix (Nametab.basename_of_global gr) ("_proj_" ^ (if l2r then "l2r" else "r2l"))
-  in
-  let ctx = Evd.universe_context_set sigma in
-  let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
-    (pri,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
-
-let add_hints_iff l2r lc n bl =
-  Hints.add_hints true bl
-    (Hints.HintsResolveEntry (List.map (project_hint n l2r) lc))
-
-VERNAC COMMAND EXTEND HintResolveIffLR CLASSIFIED AS SIDEFF
-  [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n)
-    ":" preident_list(bl) ] ->
-  [ add_hints_iff true lc n bl ]
-| [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n) ] ->
-  [ add_hints_iff true lc n ["core"] ]
-END
-VERNAC COMMAND EXTEND HintResolveIffRL CLASSIFIED AS SIDEFF
-  [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n)
-    ":" preident_list(bl) ] ->
-  [ add_hints_iff false lc n bl ]
-| [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n) ] ->
-  [ add_hints_iff false lc n ["core"] ]
-END
-
-(**********************************************************************)
-(* Refine                                                             *)
-
-let refine_tac simple {Glob_term.closure=closure;term=term} =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let env = Proofview.Goal.env gl in
-    let flags = Pretyping.all_no_fail_flags in
-    let tycon = Pretyping.OfType concl in
-    let lvar = { Pretyping.empty_lvar with
-      Pretyping.ltac_constrs = closure.Glob_term.typed;
-      Pretyping.ltac_uconstrs = closure.Glob_term.untyped;
-      Pretyping.ltac_idents = closure.Glob_term.idents;
-    } in
-    let update evd = Pretyping.understand_ltac flags env evd lvar tycon term in
-    let refine = Proofview.Refine.refine ~unsafe:false update in
-    if simple then refine
-    else refine <*>
-           Tactics.New.reduce_after_refine <*>
-           Proofview.shelve_unifiable
-  end
-
-TACTIC EXTEND refine
-| [ "refine" uconstr(c) ] -> [ refine_tac false c ]
-END
-
-TACTIC EXTEND simple_refine
-| [ "simple" "refine" uconstr(c) ] -> [ refine_tac true c ]
-END
-
-(**********************************************************************)
-(* Inversion lemmas (Leminv)                                          *)
-
-open Inv
-open Leminv
-
-let seff id = Vernacexpr.VtSideff [id], Vernacexpr.VtLater
-
-VERNAC COMMAND EXTEND DeriveInversionClear
-| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
-  => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s false inv_clear_tac ]
-
-| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) ] => [ seff na ]
-  -> [ add_inversion_lemma_exn na c GProp false inv_clear_tac ]
-END
-
-open Term
-
-VERNAC COMMAND EXTEND DeriveInversion
-| [ "Derive" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
-  => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s false inv_tac ]
-
-| [ "Derive" "Inversion" ident(na) "with" constr(c) ] => [ seff na ]
-  -> [ add_inversion_lemma_exn na c GProp false inv_tac ]
-END
-
-VERNAC COMMAND EXTEND DeriveDependentInversion
-| [ "Derive" "Dependent" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
-  => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s true dinv_tac ]
-END
-
-VERNAC COMMAND EXTEND DeriveDependentInversionClear
-| [ "Derive" "Dependent" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
-  => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s true dinv_clear_tac ]
-END
-
-(**********************************************************************)
-(* Subst                                                              *)
-
-TACTIC EXTEND subst
-| [ "subst" ne_var_list(l) ] -> [ subst l ]
-| [ "subst" ] -> [ subst_all () ]
-END
-
-let simple_subst_tactic_flags =
-  { only_leibniz = true; rewrite_dependent_proof = false }
-
-TACTIC EXTEND simple_subst
-| [ "simple" "subst" ] -> [ subst_all ~flags:simple_subst_tactic_flags () ]
-END
-
-open Evar_tactics
-
-(**********************************************************************)
-(* Evar creation                                                      *)
-
-(* TODO: add support for some test similar to g_constr.name_colon so that
-   expressions like "evar (list A)" do not raise a syntax error *)
-TACTIC EXTEND evar
-  [ "evar" "(" ident(id) ":" lconstr(typ) ")" ] -> [ let_evar (Name id) typ ]
-| [ "evar" constr(typ) ] -> [ let_evar Anonymous typ ]
-END
-
-open Tacticals
-
-TACTIC EXTEND instantiate
-  [ "instantiate" "(" ident(id) ":=" lglob(c) ")" ] ->
-    [ Tacticals.New.tclTHEN (instantiate_tac_by_name id c) Proofview.V82.nf_evar_goals ]
-| [ "instantiate" "(" integer(i) ":=" lglob(c) ")" hloc(hl) ] ->
-    [ Tacticals.New.tclTHEN (instantiate_tac i c hl) Proofview.V82.nf_evar_goals ]
-| [ "instantiate" ] -> [ Proofview.V82.nf_evar_goals ]
-END
-
-(**********************************************************************)
-(** Nijmegen "step" tactic for setoid rewriting                       *)
-
-open Tactics
-open Glob_term
-open Libobject
-open Lib
-
-(* Registered lemmas are expected to be of the form
-     x R y -> y == z -> x R z    (in the right table)
-     x R y -> x == z -> z R y    (in the left table)
-*)
-
-let transitivity_right_table = Summary.ref [] ~name:"transitivity-steps-r"
-let transitivity_left_table = Summary.ref [] ~name:"transitivity-steps-l"
-
-(* [step] tries to apply a rewriting lemma; then apply [tac] intended to
-   complete to proof of the last hypothesis (assumed to state an equality) *)
-
-let step left x tac =
-  let l =
-    List.map (fun lem ->
-      Tacticals.New.tclTHENLAST
-        (apply_with_bindings (lem, ImplicitBindings [x]))
-        tac)
-      !(if left then transitivity_left_table else transitivity_right_table)
-  in
-  Tacticals.New.tclFIRST l
-
-(* Main function to push lemmas in persistent environment *)
-
-let cache_transitivity_lemma (_,(left,lem)) =
-  if left then
-    transitivity_left_table  := lem :: !transitivity_left_table
-  else
-    transitivity_right_table := lem :: !transitivity_right_table
-
-let subst_transitivity_lemma (subst,(b,ref)) = (b,subst_mps subst ref)
-
-let inTransitivity : bool * constr -> obj =
-  declare_object {(default_object "TRANSITIVITY-STEPS") with
-    cache_function = cache_transitivity_lemma;
-    open_function = (fun i o -> if Int.equal i 1 then cache_transitivity_lemma o);
-    subst_function = subst_transitivity_lemma;
-    classify_function = (fun o -> Substitute o) }
-
-(* Main entry points *)
-
-let add_transitivity_lemma left lem =
-  let env = Global.env () in
-  let sigma = Evd.from_env env in
-  let lem',ctx (*FIXME*) = Constrintern.interp_constr env sigma lem in
-  add_anonymous_leaf (inTransitivity (left,lem'))
-
-(* Vernacular syntax *)
-
-TACTIC EXTEND stepl
-| ["stepl" constr(c) "by" tactic(tac) ] -> [ step true c (Tacinterp.eval_tactic tac) ]
-| ["stepl" constr(c) ] -> [ step true c (Proofview.tclUNIT ()) ]
-END
-
-TACTIC EXTEND stepr
-| ["stepr" constr(c) "by" tactic(tac) ] -> [ step false c (Tacinterp.eval_tactic tac) ]
-| ["stepr" constr(c) ] -> [ step false c (Proofview.tclUNIT ()) ]
-END
-
-VERNAC COMMAND EXTEND AddStepl CLASSIFIED AS SIDEFF
-| [ "Declare" "Left" "Step" constr(t) ] ->
-    [ add_transitivity_lemma true t ]
-END
-
-VERNAC COMMAND EXTEND AddStepr CLASSIFIED AS SIDEFF
-| [ "Declare" "Right" "Step" constr(t) ] ->
-    [ add_transitivity_lemma false t ]
-END
-
-VERNAC COMMAND EXTEND ImplicitTactic CLASSIFIED AS SIDEFF
-| [ "Declare" "Implicit" "Tactic" tactic(tac) ] ->
-    [ Pfedit.declare_implicit_tactic (Tacinterp.interp tac) ]
-| [ "Clear" "Implicit" "Tactic" ] ->
-    [ Pfedit.clear_implicit_tactic () ]
-END
-
-
-
-
-(**********************************************************************)
-(*spiwack : Vernac commands for retroknowledge                        *)
-
-VERNAC COMMAND EXTEND RetroknowledgeRegister CLASSIFIED AS SIDEFF
- | [ "Register" constr(c) "as" retroknowledge_field(f) "by" constr(b)] ->
-           [ let tc,ctx = Constrintern.interp_constr (Global.env ()) Evd.empty c in
-             let tb,ctx(*FIXME*) = Constrintern.interp_constr (Global.env ()) Evd.empty b in
-             Global.register f tc tb ]
-END
-
-
-
-(**********************************************************************)
-(* sozeau: abs/gen for induction on instantiated dependent inductives, using "Ford" induction as
-  defined by Conor McBride *)
-TACTIC EXTEND generalize_eqs
-| ["generalize_eqs" hyp(id) ] -> [ abstract_generalize ~generalize_vars:false id ]
-END
-TACTIC EXTEND dep_generalize_eqs
-| ["dependent" "generalize_eqs" hyp(id) ] -> [ abstract_generalize ~generalize_vars:false ~force_dep:true id ]
-END
-TACTIC EXTEND generalize_eqs_vars
-| ["generalize_eqs_vars" hyp(id) ] -> [ abstract_generalize ~generalize_vars:true id ]
-END
-TACTIC EXTEND dep_generalize_eqs_vars
-| ["dependent" "generalize_eqs_vars" hyp(id) ] -> [ abstract_generalize ~force_dep:true ~generalize_vars:true id ]
-END
-
-(** Tactic to automatically simplify hypotheses of the form [Π Δ, x_i = t_i -> T] 
-    where [t_i] is closed w.r.t. Δ. Such hypotheses are automatically generated
-    during dependent induction. For internal use. *)
-
-TACTIC EXTEND specialize_eqs
-[ "specialize_eqs" hyp(id) ] -> [ Proofview.V82.tactic (specialize_eqs id) ]
-END
-
-(**********************************************************************)
-(* A tactic that considers a given occurrence of [c] in [t] and       *)
-(* abstract the minimal set of all the occurrences of [c] so that the *)
-(* abstraction [fun x -> t[x/c]] is well-typed                        *)
-(*                                                                    *)
-(* Contributed by Chung-Kil Hur (Winter 2009)                         *)
-(**********************************************************************)
-
-let subst_var_with_hole occ tid t = 
-  let occref = if occ > 0 then ref occ else Find_subterm.error_invalid_occurrence [occ] in
-  let locref = ref 0 in
-  let rec substrec = function
-    | GVar (_,id) as x -> 
-        if Id.equal id tid 
-        then
-	  (decr occref;
-	   if Int.equal !occref 0 then x
-           else
-	     (incr locref;
-	      GHole (Loc.make_loc (!locref,0),
-		     Evar_kinds.QuestionMark(Evar_kinds.Define true),
-                     Misctypes.IntroAnonymous, None)))
-        else x
-    | c -> map_glob_constr_left_to_right substrec c in
-  let t' = substrec t
-  in
-  if !occref > 0 then Find_subterm.error_invalid_occurrence [occ] else t'
-
-let subst_hole_with_term occ tc t =
-  let locref = ref 0 in
-  let occref = ref occ in
-  let rec substrec = function
-    | GHole (_,Evar_kinds.QuestionMark(Evar_kinds.Define true),Misctypes.IntroAnonymous,s) ->
-        decr occref;
-        if Int.equal !occref 0 then tc
-        else
-	  (incr locref;
-	   GHole (Loc.make_loc (!locref,0),
-		  Evar_kinds.QuestionMark(Evar_kinds.Define true),Misctypes.IntroAnonymous,s))
-    | c -> map_glob_constr_left_to_right substrec c
-  in
-  substrec t
-
-open Tacmach
-
-let out_arg = function
-  | ArgVar _ -> anomaly (Pp.str "Unevaluated or_var variable")
-  | ArgArg x -> x
-
-let hResolve id c occ t =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let sigma = Proofview.Goal.sigma gl in
-  let env = Termops.clear_named_body id (Proofview.Goal.env gl) in
-  let concl = Proofview.Goal.concl gl in
-  let env_ids = Termops.ids_of_context env in
-  let c_raw = Detyping.detype true env_ids env sigma c in
-  let t_raw = Detyping.detype true env_ids env sigma t in
-  let rec resolve_hole t_hole =
-    try 
-      Pretyping.understand env sigma t_hole
-    with
-      | Pretype_errors.PretypeError (_,_,Pretype_errors.UnsolvableImplicit _) as e ->
-          let (e, info) = Errors.push e in
-          let loc = match Loc.get_loc info with None -> Loc.ghost | Some loc -> loc in
-          resolve_hole (subst_hole_with_term (fst (Loc.unloc loc)) c_raw t_hole)
-  in
-  let t_constr,ctx = resolve_hole (subst_var_with_hole occ id t_raw) in
-  let sigma = Evd.merge_universe_context sigma ctx in
-  let t_constr_type = Retyping.get_type_of env sigma t_constr in
-  Tacticals.New.tclTHEN
-    (Proofview.Unsafe.tclEVARS sigma)
-    (change_concl (mkLetIn (Anonymous,t_constr,t_constr_type,concl)))
-  end
-
-let hResolve_auto id c t =
-  let rec resolve_auto n = 
-    try
-      hResolve id c n t
-    with
-    | UserError _ as e -> raise e
-    | e when Errors.noncritical e -> resolve_auto (n+1)
-  in
-  resolve_auto 1
-
-TACTIC EXTEND hresolve_core
-| [ "hresolve_core" "(" ident(id) ":=" constr(c) ")" "at" int_or_var(occ) "in" constr(t) ] -> [ hResolve id c (out_arg occ) t ]
-| [ "hresolve_core" "(" ident(id) ":=" constr(c) ")" "in" constr(t) ] -> [ hResolve_auto id c t ]
-END
-
-(**
-   hget_evar
-*)
-
-let hget_evar n =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let sigma = Proofview.Goal.sigma gl in
-  let concl = Proofview.Goal.concl gl in
-  let evl = evar_list concl in
-  if List.length evl < n then
-    error "Not enough uninstantiated existential variables.";
-  if n <= 0 then error "Incorrect existential variable index.";
-  let ev = List.nth evl (n-1) in
-  let ev_type = existential_type sigma ev in
-  change_concl (mkLetIn (Anonymous,mkEvar ev,ev_type,concl))
-  end
-
-TACTIC EXTEND hget_evar
-| [ "hget_evar" int_or_var(n) ] -> [ hget_evar (out_arg n) ]
-END
-
-(**********************************************************************)
-
-(**********************************************************************)
-(* A tactic that reduces one match t with ... by doing destruct t.    *)
-(* if t is not a variable, the tactic does                            *)
-(* case_eq t;intros ... heq;rewrite heq in *|-. (but heq itself is    *)
-(* preserved).                                                        *)
-(* Contributed by Julien Forest and Pierre Courtieu (july 2010)       *)
-(**********************************************************************)
-
-exception Found of unit Proofview.tactic
-
-let rewrite_except h =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let hyps = Tacmach.New.pf_ids_of_hyps gl in
-  Tacticals.New.tclMAP (fun id -> if Id.equal id h then Proofview.tclUNIT () else 
-      Tacticals.New.tclTRY (Equality.general_rewrite_in true Locus.AllOccurrences true true id (mkVar h) false))
-    hyps
-  end
-
-
-let refl_equal = 
-  let coq_base_constant s =
-    Coqlib.gen_constant_in_modules "RecursiveDefinition"
-      (Coqlib.init_modules @ [["Coq";"Arith";"Le"];["Coq";"Arith";"Lt"]]) s in
-  function () -> (coq_base_constant "eq_refl")
-
-
-(* This is simply an implementation of the case_eq tactic.  this code
-  should be replaced by a call to the tactic but I don't know how to
-  call it before it is defined. *)
-let  mkCaseEq a  : unit Proofview.tactic =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let type_of_a = Tacmach.New.of_old (fun g -> Tacmach.pf_unsafe_type_of g a) gl in
-       Tacticals.New.tclTHENLIST
-         [Proofview.V82.tactic (Tactics.Simple.generalize [mkApp(delayed_force refl_equal, [| type_of_a; a|])]);
-          Proofview.Goal.nf_enter begin fun gl ->
-            let concl = Proofview.Goal.concl gl in
-            let env = Proofview.Goal.env gl in
-	    change_concl
-	      (snd (Tacred.pattern_occs [Locus.OnlyOccurrences [1], a] env Evd.empty concl))
-          end;
-	  simplest_case a]
-  end
-
-
-let case_eq_intros_rewrite x =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let n = nb_prod (Proofview.Goal.concl gl) in
-  (* Pp.msgnl (Printer.pr_lconstr x); *)
-  Tacticals.New.tclTHENLIST [
-      mkCaseEq x;
-    Proofview.Goal.nf_enter begin fun gl ->
-      let concl = Proofview.Goal.concl gl in
-      let hyps = Tacmach.New.pf_ids_of_hyps gl in
-      let n' = nb_prod concl in
-      let h = Tacmach.New.of_old (fun g -> fresh_id hyps (Id.of_string "heq") g) gl in
-      Tacticals.New.tclTHENLIST [
-                    Tacticals.New.tclDO (n'-n-1) intro;
-		    introduction h;
-		    rewrite_except h]
-    end
-  ]
-  end
-
-let rec find_a_destructable_match t =
-  match kind_of_term t with
-    | Case (_,_,x,_) when closed0 x ->
-	if isVar x then
-	  (* TODO check there is no rel n. *)
-	  raise (Found (Tacinterp.eval_tactic(<:tactic<destruct x>>)))
-	else
-	  (* let _ = Pp.msgnl (Printer.pr_lconstr x)  in *)
-	  raise (Found (case_eq_intros_rewrite x))
-    | _ -> iter_constr find_a_destructable_match t
-	
-
-let destauto t =
-  try find_a_destructable_match t;
-    Tacticals.New.tclZEROMSG (str "No destructable match found")
-  with Found tac -> tac
-
-let destauto_in id = 
-  Proofview.Goal.nf_enter begin fun gl ->
-  let ctype = Tacmach.New.of_old (fun g -> Tacmach.pf_unsafe_type_of g (mkVar id)) gl in
-(*  Pp.msgnl (Printer.pr_lconstr (mkVar id)); *)
-(*  Pp.msgnl (Printer.pr_lconstr (ctype)); *)
-  destauto ctype
-  end
-
-TACTIC EXTEND destauto
-| [ "destauto" ] -> [ Proofview.Goal.nf_enter (fun gl -> destauto (Proofview.Goal.concl gl)) ]
-| [ "destauto" "in" hyp(id) ] -> [ destauto_in id ]
-END
-
-
-(* ********************************************************************* *)
-
-let eq_constr x y = 
-  Proofview.Goal.enter (fun gl ->
-    let evd = Proofview.Goal.sigma gl in
-      if Evarutil.eq_constr_univs_test evd evd x y then Proofview.tclUNIT () 
-      else Tacticals.New.tclFAIL 0 (str "Not equal"))
-
-TACTIC EXTEND constr_eq
-| [ "constr_eq" constr(x) constr(y) ] -> [ eq_constr x y ]
-END
-
-TACTIC EXTEND constr_eq_nounivs
-| [ "constr_eq_nounivs" constr(x) constr(y) ] -> [
-    if eq_constr_nounivs x y then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "Not equal") ]
-END
-
-TACTIC EXTEND is_evar
-| [ "is_evar" constr(x) ] ->
-    [ match kind_of_term x with
-        | Evar _ -> Proofview.tclUNIT ()
-        | _ -> Tacticals.New.tclFAIL 0 (str "Not an evar")
-    ]
-END
-
-let rec has_evar x =
-  match kind_of_term x with
-    | Evar _ -> true
-    | Rel _ | Var _ | Meta _ | Sort _ | Const _ | Ind _ | Construct _ ->
-      false
-    | Cast (t1, _, t2) | Prod (_, t1, t2) | Lambda (_, t1, t2) ->
-      has_evar t1 || has_evar t2
-    | LetIn (_, t1, t2, t3) ->
-      has_evar t1 || has_evar t2 || has_evar t3
-    | App (t1, ts) ->
-      has_evar t1 || has_evar_array ts
-    | Case (_, t1, t2, ts) ->
-      has_evar t1 || has_evar t2 || has_evar_array ts
-    | Fix ((_, tr)) | CoFix ((_, tr)) ->
-      has_evar_prec tr
-    | Proj (p, c) -> has_evar c
-and has_evar_array x =
-  Array.exists has_evar x
-and has_evar_prec (_, ts1, ts2) =
-  Array.exists has_evar ts1 || Array.exists has_evar ts2
-
-TACTIC EXTEND has_evar
-| [ "has_evar" constr(x) ] ->
-    [ if has_evar x then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "No evars") ]
-END
-
-TACTIC EXTEND is_hyp
-| [ "is_var" constr(x) ] ->
-  [ match kind_of_term x with
-    | Var _ ->  Proofview.tclUNIT ()
-    | _ -> Tacticals.New.tclFAIL 0 (str "Not a variable or hypothesis") ]
-END
-
-TACTIC EXTEND is_fix
-| [ "is_fix" constr(x) ] ->
-  [ match kind_of_term x with
-    | Fix _ -> Proofview.tclUNIT ()
-    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a fix definition") ]
-END;;
-
-TACTIC EXTEND is_cofix
-| [ "is_cofix" constr(x) ] ->
-  [ match kind_of_term x with
-    | CoFix _ -> Proofview.tclUNIT ()
-    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a cofix definition") ]
-END;;
-
-(* Command to grab the evars left unresolved at the end of a proof. *)
-(* spiwack: I put it in extratactics because it is somewhat tied with
-   the semantics of the LCF-style tactics, hence with the classic tactic
-   mode. *)
-VERNAC COMMAND EXTEND GrabEvars
-[ "Grab" "Existential" "Variables" ]
-  => [ Vernacexpr.VtProofStep false, Vernacexpr.VtLater ]
-  -> [ Proof_global.simple_with_current_proof (fun _ p  -> Proof.V82.grab_evars p) ]
-END
-
-(* Shelves all the goals under focus. *)
-TACTIC EXTEND shelve
-| [ "shelve" ] ->
-    [ Proofview.shelve ]
-END
-
-(* Shelves the unifiable goals under focus, i.e. the goals which
-   appear in other goals under focus (the unfocused goals are not
-   considered). *)
-TACTIC EXTEND shelve_unifiable
-| [ "shelve_unifiable" ] ->
-    [ Proofview.shelve_unifiable ]
-END
-
-(* Unshelves the goal shelved by the tactic. *)
-TACTIC EXTEND unshelve
-| [ "unshelve" tactic1(t) ] ->
-    [
-      Proofview.with_shelf (Tacinterp.eval_tactic t) >>= fun (gls, ()) ->
-      Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
-      Proofview.Unsafe.tclSETGOALS (gls @ ogls)
-    ]
-END
-
-(* Command to add every unshelved variables to the focus *)
-VERNAC COMMAND EXTEND Unshelve
-[ "Unshelve" ]
-  => [ Vernacexpr.VtProofStep false, Vernacexpr.VtLater ]
-  -> [ Proof_global.simple_with_current_proof (fun _ p  -> Proof.unshelve p) ]
-END
-
-(* Gives up on the goals under focus: the goals are considered solved,
-   but the proof cannot be closed until the user goes back and solve
-   these goals. *)
-TACTIC EXTEND give_up
-| [ "give_up" ] ->
-    [ Proofview.give_up ]
-END
-
-(* cycles [n] goals *)
-TACTIC EXTEND cycle
-| [ "cycle" int_or_var(n) ] -> [ Proofview.cycle (out_arg n) ]
-END
-
-(* swaps goals number [i] and [j] *)
-TACTIC EXTEND swap
-| [ "swap" int_or_var(i) int_or_var(j) ] -> [ Proofview.swap (out_arg i) (out_arg j) ]
-END
-
-(* reverses the list of focused goals *)
-TACTIC EXTEND revgoals
-| [ "revgoals" ] -> [ Proofview.revgoals ]
-END
-
-
-type cmp =
-  | Eq
-  | Lt | Le
-  | Gt | Ge
-
-type 'i test =
-  | Test of cmp * 'i * 'i
-
-let wit_cmp : (cmp,cmp,cmp) Genarg.genarg_type = Genarg.make0 None "cmp"
-let wit_test : (int or_var test,int or_var test,int test) Genarg.genarg_type =
-  Genarg.make0 None "tactest"
-
-let pr_cmp = function
-  | Eq -> Pp.str"="
-  | Lt -> Pp.str"<"
-  | Le -> Pp.str"<="
-  | Gt -> Pp.str">"
-  | Ge -> Pp.str">="
-
-let pr_cmp' _prc _prlc _prt = pr_cmp
-
-let pr_test_gen f (Test(c,x,y)) =
-  Pp.(f x ++ pr_cmp c ++ f y)
-
-let pr_test = pr_test_gen (Pptactic.pr_or_var Pp.int)
-
-let pr_test' _prc _prlc _prt = pr_test
-
-let pr_itest = pr_test_gen Pp.int
-
-let pr_itest' _prc _prlc _prt = pr_itest
-
-
-
-ARGUMENT EXTEND comparison TYPED AS cmp PRINTED BY pr_cmp'
-| [ "="  ] -> [ Eq ]
-| [ "<"  ] -> [ Lt ]
-| [ "<=" ] -> [ Le ]
-| [ ">"  ] -> [ Gt ]
-| [ ">=" ] -> [ Ge ]
-    END
-
-let interp_test ist gls = function
-  | Test (c,x,y) ->
-      project gls ,
-      Test(c,Tacinterp.interp_int_or_var ist x,Tacinterp.interp_int_or_var ist y)
-
-ARGUMENT EXTEND test
-  PRINTED BY pr_itest'
-  INTERPRETED BY interp_test
-  RAW_TYPED AS test
-  RAW_PRINTED BY pr_test'
-  GLOB_TYPED AS test
-  GLOB_PRINTED BY pr_test'
-| [ int_or_var(x) comparison(c) int_or_var(y) ] -> [ Test(c,x,y) ]
-END
-
-let interp_cmp = function
-  | Eq -> Int.equal
-  | Lt -> ((<):int->int->bool)
-  | Le -> ((<=):int->int->bool)
-  | Gt -> ((>):int->int->bool)
-  | Ge -> ((>=):int->int->bool)
-
-let run_test = function
-  | Test(c,x,y) -> interp_cmp c x y
-
-let guard tst =
-  if run_test tst then
-    Proofview.tclUNIT ()
-  else
-    let msg = Pp.(str"Condition not satisfied:"++ws 1++(pr_itest tst)) in
-    Tacticals.New.tclZEROMSG msg
-
-
-TACTIC EXTEND guard
-| [ "guard" test(tst) ] -> [ guard tst ]
-END
-
-let decompose l c =
-  Proofview.Goal.enter begin fun gl ->
-    let to_ind c =
-      if isInd c then Univ.out_punivs (destInd c)
-      else error "not an inductive type"
-    in
-    let l = List.map to_ind l in
-    Elim.h_decompose l c
-  end
-
-TACTIC EXTEND decompose
-| [ "decompose" "[" ne_constr_list(l) "]" constr(c) ] -> [ decompose l c ]
-END
-
-(** library/keys *)
-
-VERNAC COMMAND EXTEND Declare_keys CLASSIFIED AS SIDEFF
-| [ "Declare" "Equivalent" "Keys" constr(c) constr(c') ] -> [ 
-  let it c = snd (Constrintern.interp_open_constr (Global.env ()) Evd.empty c) in 
-  let k1 = Keys.constr_key (it c) in
-  let k2 = Keys.constr_key (it c') in
-    match k1, k2 with
-    | Some k1, Some k2 -> Keys.declare_equiv_keys k1 k2
-    | _ -> () ]
-END
-
-VERNAC COMMAND EXTEND Print_keys CLASSIFIED AS QUERY
-| [ "Print" "Equivalent" "Keys" ] -> [ msg_info (Keys.pr_keys Printer.pr_global) ]
-END
-
-
-VERNAC COMMAND EXTEND OptimizeProof
-| [ "Optimize" "Proof" ] => [ Vernac_classifier.classify_as_proofstep ] ->
-  [ Proof_global.compact_the_proof () ]
-| [ "Optimize" "Heap" ] => [ Vernac_classifier.classify_as_proofstep ] ->
-  [ Gc.compact () ]
-END
diff --git a/tactics/extratactics.mli b/tactics/extratactics.mli
deleted file mode 100644
index e0e9f377..00000000
--- a/tactics/extratactics.mli
+++ /dev/null
@@ -1,14 +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        *)
-(************************************************************************)
-
-val discrHyp : Names.Id.t -> unit Proofview.tactic
-val injHyp : Names.Id.t -> unit Proofview.tactic
-
-(* val refine_tac : Evd.open_constr -> unit Proofview.tactic *)
-
-val onSomeWithHoles : ('a option -> unit Proofview.tactic) -> 'a Evd.sigma option -> unit Proofview.tactic
diff --git a/tactics/ftactic.ml b/tactics/ftactic.ml
deleted file mode 100644
index 8e42dcba..00000000
--- a/tactics/ftactic.ml
+++ /dev/null
@@ -1,86 +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        *)
-(************************************************************************)
-
-open Proofview.Notations
-
-(** Focussing tactics *)
-
-type 'a focus =
-| Uniform of 'a
-| Depends of 'a list
-
-(** Type of tactics potentially goal-dependent. If it contains a [Depends],
-    then the length of the inner list is guaranteed to be the number of
-    currently focussed goals. Otherwise it means the tactic does not depend
-    on the current set of focussed goals. *)
-type 'a t = 'a focus Proofview.tactic
-
-let return (x : 'a) : 'a t = Proofview.tclUNIT (Uniform x)
-
-let bind (type a) (type b) (m : a t) (f : a -> b t) : b t = m >>= function
-| Uniform x -> f x
-| Depends l ->
-  let f arg = f arg >>= function
-  | Uniform x ->
-    (** We dispatch the uniform result on each goal under focus, as we know
-        that the [m] argument was actually dependent. *)
-    Proofview.Goal.goals >>= fun l ->
-    let ans = List.map (fun _ -> x) l in
-    Proofview.tclUNIT ans
-  | Depends l -> Proofview.tclUNIT l
-  in
-  Proofview.tclDISPATCHL (List.map f l) >>= fun l ->
-  Proofview.tclUNIT (Depends (List.concat l))
-
-let nf_enter f =
-  bind (Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l))
-    (fun gl ->
-      gl >>= fun gl ->
-      Proofview.Goal.normalize gl >>= fun nfgl ->
-      Proofview.V82.wrap_exceptions (fun () -> f nfgl))
-
-let enter f =
-  bind (Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l))
-    (fun gl -> gl >>= fun gl -> Proofview.V82.wrap_exceptions (fun () -> f gl))
-
-let with_env t =
-  t >>= function
-    | Uniform a ->
-        Proofview.tclENV >>= fun env -> Proofview.tclUNIT (Uniform (env,a))
-    | Depends l ->
-        Proofview.Goal.goals >>= fun gs ->
-        Proofview.Monad.(List.map (map Proofview.Goal.env) gs) >>= fun envs ->
-        Proofview.tclUNIT (Depends (List.combine envs l))
-
-let lift (type a) (t:a Proofview.tactic) : a t =
-  Proofview.tclBIND t (fun x -> Proofview.tclUNIT (Uniform x))
-
-(** If the tactic returns unit, we can focus on the goals if necessary. *)
-let run m k = m >>= function
-| Uniform v -> k v
-| Depends l ->
-  let tacs = List.map k l in
-  Proofview.tclDISPATCH tacs
-
-let (>>=) = bind
-
-let (<*>) = fun m n -> bind m (fun () -> n)
-
-module Self =
-struct
-  type 'a t = 'a focus Proofview.tactic
-  let return = return
-  let (>>=) = bind
-  let (>>) = (<*>)
-  let map f x = x >>= fun a -> return (f a)
-end
-
-module Ftac = Monad.Make(Self)
-module List = Ftac.List
-
-let debug_prompt = Tactic_debug.debug_prompt
diff --git a/tactics/ftactic.mli b/tactics/ftactic.mli
deleted file mode 100644
index 3f4da2a8..00000000
--- a/tactics/ftactic.mli
+++ /dev/null
@@ -1,67 +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        *)
-(************************************************************************)
-
-(** Potentially focussing tactics *)
-
-type +'a focus
-
-type +'a t = 'a focus Proofview.tactic
-(** The type of focussing tactics. A focussing tactic is like a normal tactic,
-    except that it is able to remember it have entered a goal. Whenever this is
-    the case, each subsequent effect of the tactic is dispatched on the
-    focussed goals. This is a monad. *)
-
-(** {5 Monadic interface} *)
-
-val return : 'a -> 'a t
-(** The unit of the monad. *)
-
-val bind : 'a t -> ('a -> 'b t) -> 'b t
-(** The bind of the monad. *)
-
-(** {5 Operations} *)
-
-val lift : 'a Proofview.tactic -> 'a t
-(** Transform a tactic into a focussing tactic. The resulting tactic is not
-    focussed. *)
-
-val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic
-(** Given a continuation producing a tactic, evaluates the focussing tactic. If
-    the tactic has not focussed, then the continuation is evaluated once.
-    Otherwise it is called in each of the currently focussed goals. *)
-
-(** {5 Focussing} *)
-
-val nf_enter : ([ `NF ] Proofview.Goal.t -> 'a t) -> 'a t
-(** Enter a goal. The resulting tactic is focussed. *)
-
-val enter : ([ `LZ ] Proofview.Goal.t -> 'a t) -> 'a t
-(** Enter a goal, without evar normalization. The resulting tactic is
-    focussed. *)
-
-val with_env : 'a t -> (Environ.env*'a) t
-(** [with_env t] returns, in addition to the return type of [t], an
-    environment, which is the global environment if [t] does not focus on
-    goals, or the local goal environment if [t] focuses on goals. *)
-
-(** {5 Notations} *)
-
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-(** Notation for {!bind}. *)
-
-val (<*>) : unit t -> 'a t -> 'a t
-(** Sequence. *)
-
-(** {5 List operations} *)
-
-module List : Monad.ListS with type 'a t := 'a t
-
-(** {5 Debug} *)
-
-val debug_prompt :
-  int -> Tacexpr.glob_tactic_expr -> (Tactic_debug.debug_info -> 'a t) -> 'a t
diff --git a/tactics/g_class.ml4 b/tactics/g_class.ml4
deleted file mode 100644
index e0c1f671..00000000
--- a/tactics/g_class.ml4
+++ /dev/null
@@ -1,84 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Misctypes
-open Class_tactics
-
-DECLARE PLUGIN "g_class"
-
-TACTIC EXTEND progress_evars
-  [ "progress_evars" tactic(t) ] -> [ progress_evars (Tacinterp.eval_tactic t) ]
-END
-
-(** Options: depth, debug and transparency settings. *)
-
-let set_transparency cl b =
-  List.iter (fun r ->
-    let gr = Smartlocate.global_with_alias r in
-    let ev = Tacred.evaluable_of_global_reference (Global.env ()) gr in
-      Classes.set_typeclass_transparency ev false b) cl
-
-VERNAC COMMAND EXTEND Typeclasses_Unfold_Settings CLASSIFIED AS SIDEFF
-| [ "Typeclasses" "Transparent" reference_list(cl) ] -> [
-    set_transparency cl true ]
-END
-
-VERNAC COMMAND EXTEND Typeclasses_Rigid_Settings CLASSIFIED AS SIDEFF
-| [ "Typeclasses" "Opaque" reference_list(cl) ] -> [
-    set_transparency cl false ]
-END
-
-open Genarg
-
-let pr_debug _prc _prlc _prt b =
-  if b then Pp.str "debug" else Pp.mt()
-
-ARGUMENT EXTEND debug TYPED AS bool PRINTED BY pr_debug
-| [ "debug" ] -> [ true ]
-| [ ] -> [ false ]
-END
-
-let pr_depth _prc _prlc _prt = function
-    Some i -> Pp.int i
-  | None -> Pp.mt()
-
-ARGUMENT EXTEND depth TYPED AS int option PRINTED BY pr_depth
-| [ int_or_var_opt(v) ] -> [ match v with Some (ArgArg i) -> Some i | _ -> None ]
-END
-
-(* true = All transparent, false = Opaque if possible *)
-
-VERNAC COMMAND EXTEND Typeclasses_Settings CLASSIFIED AS SIDEFF
- | [ "Typeclasses" "eauto" ":=" debug(d) depth(depth) ] -> [
-     set_typeclasses_debug d;
-     set_typeclasses_depth depth
-   ]
-END
-
-TACTIC EXTEND typeclasses_eauto
-| [ "typeclasses" "eauto" "with" ne_preident_list(l) ] -> [ Proofview.V82.tactic (typeclasses_eauto l) ]
-| [ "typeclasses" "eauto" ] -> [ Proofview.V82.tactic (typeclasses_eauto ~only_classes:true [Hints.typeclasses_db]) ]
-END
-
-TACTIC EXTEND head_of_constr
-  [ "head_of_constr" ident(h) constr(c) ] -> [ head_of_constr h c ]
-END
-
-TACTIC EXTEND not_evar
-  [ "not_evar" constr(ty) ] -> [ not_evar ty ]
-END
-
-TACTIC EXTEND is_ground
-  [ "is_ground" constr(ty) ] -> [ Proofview.V82.tactic (is_ground ty) ]
-END
-
-TACTIC EXTEND autoapply
-  [ "autoapply" constr(c) "using" preident(i) ] -> [ Proofview.V82.tactic (autoapply c i) ]
-END
diff --git a/tactics/g_eqdecide.ml4 b/tactics/g_eqdecide.ml4
deleted file mode 100644
index 90565328..00000000
--- a/tactics/g_eqdecide.ml4
+++ /dev/null
@@ -1,27 +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        *)
-(************************************************************************)
-
-(************************************************************************)
-(*                              EqDecide                               *)
-(*   A tactic for deciding propositional equality on inductive types   *)
-(*                           by Eduardo Gimenez                        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Eqdecide
-
-DECLARE PLUGIN "g_eqdecide"
-
-TACTIC EXTEND decide_equality
-| [ "decide" "equality" ] -> [ decideEqualityGoal ]
-END
-
-TACTIC EXTEND compare
-| [ "compare" constr(c1) constr(c2) ] -> [ compare c1 c2 ]
-END
diff --git a/tactics/g_rewrite.ml4 b/tactics/g_rewrite.ml4
deleted file mode 100644
index 72cfb01a..00000000
--- a/tactics/g_rewrite.ml4
+++ /dev/null
@@ -1,263 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-(* Syntax for rewriting with strategies *)
-
-open Names
-open Misctypes
-open Locus
-open Constrexpr
-open Glob_term
-open Geninterp
-open Extraargs
-open Tacmach
-open Tacticals
-open Rewrite
-
-DECLARE PLUGIN "g_rewrite"
-
-type constr_expr_with_bindings = constr_expr with_bindings
-type glob_constr_with_bindings = Tacexpr.glob_constr_and_expr with_bindings
-type glob_constr_with_bindings_sign = interp_sign * Tacexpr.glob_constr_and_expr with_bindings
-
-let pr_glob_constr_with_bindings_sign _ _ _ (ge : glob_constr_with_bindings_sign) = Printer.pr_glob_constr (fst (fst (snd ge)))
-let pr_glob_constr_with_bindings _ _ _ (ge : glob_constr_with_bindings) = Printer.pr_glob_constr (fst (fst ge))
-let pr_constr_expr_with_bindings prc _ _ (ge : constr_expr_with_bindings) = prc (fst ge)
-let interp_glob_constr_with_bindings ist gl c = Tacmach.project gl , (ist, c)
-let glob_glob_constr_with_bindings ist l = Tacintern.intern_constr_with_bindings ist l
-let subst_glob_constr_with_bindings s c =
-  Tacsubst.subst_glob_with_bindings s c
-
-ARGUMENT EXTEND glob_constr_with_bindings
-    PRINTED BY pr_glob_constr_with_bindings_sign
-
-    INTERPRETED BY interp_glob_constr_with_bindings
-    GLOBALIZED BY glob_glob_constr_with_bindings
-    SUBSTITUTED BY subst_glob_constr_with_bindings
-
-    RAW_TYPED AS constr_expr_with_bindings
-    RAW_PRINTED BY pr_constr_expr_with_bindings
-
-    GLOB_TYPED AS glob_constr_with_bindings
-    GLOB_PRINTED BY pr_glob_constr_with_bindings
-
-   [ constr_with_bindings(bl) ] -> [ bl ]
-END
-
-type raw_strategy = (constr_expr, Tacexpr.raw_red_expr) strategy_ast
-type glob_strategy = (Tacexpr.glob_constr_and_expr, Tacexpr.raw_red_expr) strategy_ast
-
-let interp_strategy ist gl s = 
-  let sigma = project gl in
-    sigma, strategy_of_ast s
-let glob_strategy ist s = map_strategy (Tacintern.intern_constr ist) (fun c -> c) s
-let subst_strategy s str = str
-
-let pr_strategy _ _ _ (s : strategy) = Pp.str "<strategy>"
-let pr_raw_strategy _ _ _ (s : raw_strategy) = Pp.str "<strategy>"
-let pr_glob_strategy _ _ _ (s : glob_strategy) = Pp.str "<strategy>"
-
-ARGUMENT EXTEND rewstrategy
-    PRINTED BY pr_strategy
-
-    INTERPRETED BY interp_strategy
-    GLOBALIZED BY glob_strategy
-    SUBSTITUTED BY subst_strategy
-
-    RAW_TYPED AS raw_strategy
-    RAW_PRINTED BY pr_raw_strategy
-
-    GLOB_TYPED AS glob_strategy
-    GLOB_PRINTED BY pr_glob_strategy
-
-    [ glob(c) ] -> [ StratConstr (c, true) ]
-  | [ "<-" constr(c) ] -> [ StratConstr (c, false) ]
-  | [ "subterms" rewstrategy(h) ] -> [ StratUnary (Subterms, h) ]
-  | [ "subterm" rewstrategy(h) ] -> [ StratUnary (Subterm, h) ]
-  | [ "innermost" rewstrategy(h) ] -> [ StratUnary(Innermost, h) ]
-  | [ "outermost" rewstrategy(h) ] -> [ StratUnary(Outermost, h) ]
-  | [ "bottomup" rewstrategy(h) ] -> [ StratUnary(Bottomup, h) ]
-  | [ "topdown" rewstrategy(h) ] -> [ StratUnary(Topdown, h) ]
-  | [ "id" ] -> [ StratId ]
-  | [ "fail" ] -> [ StratFail ]
-  | [ "refl" ] -> [ StratRefl ]
-  | [ "progress" rewstrategy(h) ] -> [ StratUnary (Progress, h) ]
-  | [ "try" rewstrategy(h) ] -> [ StratUnary (Try, h) ]
-  | [ "any" rewstrategy(h) ] -> [ StratUnary (Any, h) ]
-  | [ "repeat" rewstrategy(h) ] -> [ StratUnary (Repeat, h) ]
-  | [ rewstrategy(h) ";" rewstrategy(h') ] -> [ StratBinary (Compose, h, h') ]
-  | [ "(" rewstrategy(h) ")" ] -> [ h ]
-  | [ "choice" rewstrategy(h) rewstrategy(h') ] -> [ StratBinary (Choice, h, h') ]
-  | [ "old_hints" preident(h) ] -> [ StratHints (true, h) ]
-  | [ "hints" preident(h) ] -> [ StratHints (false, h) ]
-  | [ "terms" constr_list(h) ] -> [ StratTerms h ]
-  | [ "eval" red_expr(r) ] -> [ StratEval r ]
-  | [ "fold" constr(c) ] -> [ StratFold c ]
-END
-
-(* By default the strategy for "rewrite_db" is top-down *)
-
-let db_strat db = StratUnary (Topdown, StratHints (false, db))
-let cl_rewrite_clause_db db = cl_rewrite_clause_strat (strategy_of_ast (db_strat db))
-
-let cl_rewrite_clause_db = 
-  if Flags.profile then
-    let key = Profile.declare_profile "cl_rewrite_clause_db" in
-      Profile.profile3 key cl_rewrite_clause_db
-  else cl_rewrite_clause_db
-
-TACTIC EXTEND rewrite_strat
-| [ "rewrite_strat" rewstrategy(s) "in" hyp(id) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_strat s (Some id)) ]
-| [ "rewrite_strat" rewstrategy(s) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_strat s None) ]
-| [ "rewrite_db" preident(db) "in" hyp(id) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_db db (Some id)) ]
-| [ "rewrite_db" preident(db) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_db db None) ]
-END
-
-let clsubstitute o c =
-  let is_tac id = match fst (fst (snd c)) with GVar (_, id') when Id.equal id' id -> true | _ -> false in
-    Tacticals.onAllHypsAndConcl
-      (fun cl ->
-        match cl with
-          | Some id when is_tac id -> tclIDTAC
-          | _ -> cl_rewrite_clause c o AllOccurrences cl)
-
-TACTIC EXTEND substitute
-| [ "substitute" orient(o) glob_constr_with_bindings(c) ] -> [ Proofview.V82.tactic (clsubstitute o c) ]
-END
-
-
-(* Compatibility with old Setoids *)
-
-TACTIC EXTEND setoid_rewrite
-   [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) ]
-   -> [ Proofview.V82.tactic (cl_rewrite_clause c o AllOccurrences None) ]
- | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "in" hyp(id) ] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o AllOccurrences (Some id))]
- | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "at" occurrences(occ) ] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) None)]
- | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "at" occurrences(occ) "in" hyp(id)] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) (Some id))]
- | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "in" hyp(id) "at" occurrences(occ)] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) (Some id))]
-END
-
-VERNAC COMMAND EXTEND AddRelation CLASSIFIED AS SIDEFF
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-        "symmetry" "proved" "by" constr(lemma2) "as" ident(n) ] ->
-      [ declare_relation a aeq n (Some lemma1) (Some lemma2) None ]
-
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-        "as" ident(n) ] ->
-      [ declare_relation a aeq n (Some lemma1) None None ]
-  | [ "Add" "Relation" constr(a) constr(aeq)  "as" ident(n) ] ->
-      [ declare_relation a aeq n None None None ]
-END
-
-VERNAC COMMAND EXTEND AddRelation2 CLASSIFIED AS SIDEFF
-    [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2)
-      "as" ident(n) ] ->
-      [ declare_relation a aeq n None (Some lemma2) None ]
-  | [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)  "as" ident(n) ] ->
-      [ declare_relation a aeq n None (Some lemma2) (Some lemma3) ]
-END
-
-VERNAC COMMAND EXTEND AddRelation3 CLASSIFIED AS SIDEFF
-    [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-      "transitivity" "proved" "by" constr(lemma3) "as" ident(n) ] ->
-      [ declare_relation a aeq n (Some lemma1) None (Some lemma3) ]
-  | [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)
-      "as" ident(n) ] ->
-      [ declare_relation a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ]
-  | [ "Add" "Relation" constr(a) constr(aeq) "transitivity" "proved" "by" constr(lemma3)
-        "as" ident(n) ] ->
-      [ declare_relation a aeq n None None (Some lemma3) ]
-END
-
-type binders_argtype = local_binder list
-
-let wit_binders =
- (Genarg.create_arg None "binders" : binders_argtype Genarg.uniform_genarg_type)
-
-let binders = Pcoq.create_generic_entry "binders" (Genarg.rawwit wit_binders)
-
-open Pcoq
-
-GEXTEND Gram
-  GLOBAL: binders;
-    binders:
-    [ [ b = Pcoq.Constr.binders -> b ] ];
-END
-
-VERNAC COMMAND EXTEND AddParametricRelation CLASSIFIED AS SIDEFF
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq)
-        "reflexivity" "proved" "by" constr(lemma1)
-        "symmetry" "proved" "by" constr(lemma2) "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n (Some lemma1) (Some lemma2) None ]
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq)
-        "reflexivity" "proved" "by" constr(lemma1)
-        "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n (Some lemma1) None None ]
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq)  "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n None None None ]
-END
-
-VERNAC COMMAND EXTEND AddParametricRelation2 CLASSIFIED AS SIDEFF
-    [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2)
-      "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n None (Some lemma2) None ]
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq) "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)  "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n None (Some lemma2) (Some lemma3) ]
-END
-
-VERNAC COMMAND EXTEND AddParametricRelation3 CLASSIFIED AS SIDEFF
-    [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-      "transitivity" "proved" "by" constr(lemma3) "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n (Some lemma1) None (Some lemma3) ]
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(lemma1)
-      "symmetry" "proved" "by" constr(lemma2) "transitivity" "proved" "by" constr(lemma3)
-      "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n (Some lemma1) (Some lemma2) (Some lemma3) ]
-  | [ "Add" "Parametric" "Relation" binders(b) ":" constr(a) constr(aeq) "transitivity" "proved" "by" constr(lemma3)
-        "as" ident(n) ] ->
-      [ declare_relation ~binders:b a aeq n None None (Some lemma3) ]
-END
-
-VERNAC COMMAND EXTEND AddSetoid1 CLASSIFIED AS SIDEFF
-   [ "Add" "Setoid" constr(a) constr(aeq) constr(t) "as" ident(n) ] ->
-     [ add_setoid (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) [] a aeq t n ]
-  | [ "Add" "Parametric" "Setoid" binders(binders) ":" constr(a) constr(aeq) constr(t) "as" ident(n) ] ->
-     [  add_setoid (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) binders a aeq t n ]
-  | [ "Add" "Morphism" constr(m) ":" ident(n) ]
-    (* This command may or may not open a goal *)
-    => [ Vernacexpr.VtUnknown, Vernacexpr.VtNow ]
-    -> [ add_morphism_infer (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) m n ]
-  | [ "Add" "Morphism" constr(m) "with" "signature" lconstr(s) "as" ident(n) ]
-    => [ Vernacexpr.(VtStartProof("Classic",GuaranteesOpacity,[n]), VtLater) ]
-    -> [ add_morphism (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) [] m s n ]
-  | [ "Add" "Parametric" "Morphism" binders(binders) ":" constr(m)
-        "with" "signature" lconstr(s) "as" ident(n) ]
-    => [ Vernacexpr.(VtStartProof("Classic",GuaranteesOpacity,[n]), VtLater) ]
-    -> [ add_morphism (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) binders m s n ]
-END
-
-TACTIC EXTEND setoid_symmetry
-   [ "setoid_symmetry" ] -> [ setoid_symmetry ]
- | [ "setoid_symmetry" "in" hyp(n) ] -> [ setoid_symmetry_in n ]
-END
-
-TACTIC EXTEND setoid_reflexivity
-[ "setoid_reflexivity" ] -> [ setoid_reflexivity ]
-END
-
-TACTIC EXTEND setoid_transitivity
-  [ "setoid_transitivity" constr(t) ] -> [ setoid_transitivity (Some t) ]
-| [ "setoid_etransitivity" ] -> [ setoid_transitivity None ]
-END
diff --git a/tactics/geninterp.ml b/tactics/geninterp.ml
deleted file mode 100644
index 0ad3abb5..00000000
--- a/tactics/geninterp.ml
+++ /dev/null
@@ -1,38 +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        *)
-(************************************************************************)
-
-open Names
-open Genarg
-
-module TacStore = Store.Make(struct end)
-
-type interp_sign = {
-  lfun : tlevel generic_argument Id.Map.t;
-  extra : TacStore.t }
-
-type ('glb, 'top) interp_fun = interp_sign ->
-    Goal.goal Evd.sigma -> 'glb -> Evd.evar_map * 'top
-
-module InterpObj =
-struct
-  type ('raw, 'glb, 'top) obj = ('glb, 'top) interp_fun
-  let name = "interp"
-  let default _ = None
-end
-
-module Interp = Register(InterpObj)
-
-let interp = Interp.obj
-let register_interp0 = Interp.register0
-
-let generic_interp ist gl v =
-  let unpacker wit v =
-    let (sigma, ans) = interp wit ist gl (glb v) in
-    (sigma, in_gen (topwit wit) ans)
-  in
-  unpack { unpacker; } v
diff --git a/tactics/geninterp.mli b/tactics/geninterp.mli
deleted file mode 100644
index 7f25a022..00000000
--- a/tactics/geninterp.mli
+++ /dev/null
@@ -1,28 +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        *)
-(************************************************************************)
-
-(** Interpretation functions for generic arguments. *)
-
-open Names
-open Genarg
-
-module TacStore : Store.S
-
-type interp_sign = {
-  lfun : tlevel generic_argument Id.Map.t;
-  extra : TacStore.t }
-
-type ('glb, 'top) interp_fun = interp_sign ->
-    Goal.goal Evd.sigma -> 'glb -> Evd.evar_map * 'top
-
-val interp : ('raw, 'glb, 'top) genarg_type -> ('glb, 'top) interp_fun
-
-val generic_interp : (glob_generic_argument, typed_generic_argument) interp_fun
-
-val register_interp0 :
-  ('raw, 'glb, 'top) genarg_type -> ('glb, 'top) interp_fun -> unit
diff --git a/tactics/hightactics.mllib b/tactics/hightactics.mllib
deleted file mode 100644
index ff2e1ff6..00000000
--- a/tactics/hightactics.mllib
+++ /dev/null
@@ -1,11 +0,0 @@
-Extraargs
-Coretactics
-Extratactics
-Eauto
-Class_tactics
-G_class
-Rewrite
-G_rewrite
-Tauto
-Eqdecide
-G_eqdecide
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 42e5067c..9a96b738 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Vars
 open Term
@@ -33,6 +33,8 @@ open Pfedit
 open Tacred
 open Printer
 open Vernacexpr
+open Sigma.Notations
+open Context.Named.Declaration
 
 (****************************************)
 (* General functions                    *)
@@ -64,6 +66,28 @@ let decompose_app_bound t =
     | Proj (p, c) -> ConstRef (Projection.constant p), Array.cons c args
     | _ -> raise Bound
 
+(** Compute the set of section variables that remain in the named context.
+    Starts from the top to the bottom of the context, stops at the first
+    different declaration between the named hyps and the section context. *)
+let secvars_of_hyps hyps =
+  let secctx = Global.named_context () in
+  let pred, all =
+    List.fold_left (fun (pred,all) decl ->
+        try let _ = Context.Named.lookup (get_id decl) hyps in
+          (* Approximation, it might be an hypothesis reintroduced with same name and unconvertible types,
+             we must allow it currently, as comparing the declarations for syntactic equality is too
+             strong a check (e.g. an unfold in a section variable would make it unusable). *)
+          (Id.Pred.add (get_id decl) pred, all)
+        with Not_found -> (pred, false))
+      (Id.Pred.empty,true) secctx
+  in
+  if all then Id.Pred.full (* If the whole section context is available *)
+  else pred
+
+let empty_hint_info =
+  let open Vernacexpr in
+  { hint_priority = None; hint_pattern = None }
+
 (************************************************************************)
 (*           The Type of Constructions Autotactic Hints                 *)
 (************************************************************************)
@@ -74,20 +98,27 @@ type 'a hint_ast =
   | Give_exact of 'a
   | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *)
   | Unfold_nth of evaluable_global_reference       (* Hint Unfold *)
-  | Extern     of glob_tactic_expr       (* Hint Extern *)
+  | Extern     of Genarg.glob_generic_argument (* Hint Extern *)
 
-type hints_path_atom = 
-  | PathHints of global_reference list
+
+type 'a hints_path_atom_gen =
+  | PathHints of 'a list
+  (* For forward hints, their names is the list of projections *)
   | PathAny
 
-type hints_path =
-  | PathAtom of hints_path_atom
-  | PathStar of hints_path
-  | PathSeq of hints_path * hints_path
-  | PathOr of hints_path * hints_path
+type hints_path_atom = global_reference hints_path_atom_gen
+
+type 'a hints_path_gen =
+  | PathAtom of 'a hints_path_atom_gen
+  | PathStar of 'a hints_path_gen
+  | PathSeq of 'a hints_path_gen * 'a hints_path_gen
+  | PathOr of 'a hints_path_gen * 'a hints_path_gen
   | PathEmpty
   | PathEpsilon
 
+type pre_hints_path = Libnames.reference hints_path_gen
+type hints_path = global_reference hints_path_gen
+
 type hint_term =
   | IsGlobRef of global_reference
   | IsConstr of constr * Univ.universe_context_set
@@ -102,11 +133,13 @@ type raw_hint = constr * types * Univ.universe_context_set
 type hint = (raw_hint * clausenv) hint_ast with_uid
 
 type 'a with_metadata = {
-  pri  : int;            (* A number lower is higher priority *)
-  poly  : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
-  pat  : constr_pattern option; (* A pattern for the concl of the Goal *)
-  name  : hints_path_atom; (* A potential name to refer to the hint *) 
-  code : 'a;     (* the tactic to apply when the concl matches pat *)
+  pri     : int;            (* A number lower is higher priority *)
+  poly    : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
+  pat     : constr_pattern option; (* A pattern for the concl of the Goal *)
+  name    : hints_path_atom; (* A potential name to refer to the hint *)
+  db : string option; (** The database from which the hint comes *)
+  secvars : Id.Pred.t; (* The set of section variables the hint depends on *)
+  code    : 'a;     (* the tactic to apply when the concl matches pat *)
 }
 
 type full_hint = hint with_metadata
@@ -153,27 +186,6 @@ let fresh_key =
     in
     KerName.make mp dir (Label.of_id lbl)
 
-let eq_hints_path_atom p1 p2 = match p1, p2 with
-| PathHints gr1, PathHints gr2 -> List.equal eq_gr gr1 gr2
-| PathAny, PathAny -> true
-| (PathHints _ | PathAny), _ -> false
-
-let eq_auto_tactic t1 t2 = match t1, t2 with
-| Res_pf (c1, _), Res_pf (c2, _) -> Constr.equal c1 c2
-| ERes_pf (c1, _), ERes_pf (c2, _) -> Constr.equal c1 c2
-| Give_exact (c1, _), Give_exact (c2, _) -> Constr.equal c1 c2
-| Res_pf_THEN_trivial_fail (c1, _), Res_pf_THEN_trivial_fail (c2, _) -> Constr.equal c1 c2
-| Unfold_nth gr1, Unfold_nth gr2 -> eq_egr gr1 gr2
-| Extern tac1, Extern tac2 -> tac1 == tac2 (** May cause redundancy in addkv *)
-| (Res_pf _ | ERes_pf _ | Give_exact _ | Res_pf_THEN_trivial_fail _
-  | Unfold_nth _ | Extern _), _ -> false
-
-let eq_hint_metadata t1 t2 =
-  Int.equal t1.pri t2.pri &&
-  Option.equal constr_pattern_eq t1.pat t2.pat &&
-  eq_hints_path_atom t1.name t2.name &&
-  eq_auto_tactic t1.code t2.code
-
 let pri_order_int (id1, {pri=pri1}) (id2, {pri=pri2}) =
   let d = pri1 - pri2 in
     if Int.equal d 0 then id2 - id1
@@ -208,7 +220,7 @@ type search_entry = {
   sentry_nopat : stored_data list;
   sentry_pat : stored_data list;
   sentry_bnet : Bounded_net.t;
-  sentry_mode : bool array list;
+  sentry_mode : hint_mode array list;
 }
 
 let empty_se = {
@@ -336,6 +348,12 @@ let rec is_empty = function
   | PathEmpty -> true
   | PathEpsilon -> false
 
+let path_seq p p' =
+  match p, p' with
+  | PathEpsilon, p' -> p'
+  | p, PathEpsilon -> p
+  | p, p' -> PathSeq (p, p')
+                    
 let rec path_derivate hp hint =
   let rec derivate_atoms hints hints' =
     match hints, hints' with
@@ -343,26 +361,26 @@ let rec path_derivate hp hint =
     | [], [] -> PathEpsilon
     | [], hints -> PathEmpty
     | grs, [] -> PathAtom (PathHints grs)
-    | _, _ -> PathEmpty 
+    | _, _ -> PathEmpty
   in
-    match hp with
-    | PathAtom PathAny -> PathEpsilon
-    | PathAtom (PathHints grs) -> 
-      (match grs, hint with
-       | h :: hints, PathAny -> PathEmpty
-       | hints, PathHints hints' -> derivate_atoms hints hints'
-       | _, _ -> assert false)
-    | PathStar p -> if path_matches p [hint] then hp else PathEpsilon
-    | PathSeq (hp, hp') ->
-      let hpder = path_derivate hp hint in
-	if matches_epsilon hp then 
-	  PathOr (PathSeq (hpder, hp'), path_derivate hp' hint)
-	else if is_empty hpder then PathEmpty 
-	else PathSeq (hpder, hp')
-    | PathOr (hp, hp') ->
-      PathOr (path_derivate hp hint, path_derivate hp' hint)
-    | PathEmpty -> PathEmpty
-    | PathEpsilon -> PathEmpty
+  match hp with
+  | PathAtom PathAny -> PathEpsilon
+  | PathAtom (PathHints grs) -> 
+     (match grs, hint with
+      | h :: _, PathAny -> PathEmpty
+      | hints, PathHints hints' -> derivate_atoms hints hints'
+      | _, _ -> assert false)
+  | PathStar p -> if path_matches p [hint] then hp else PathEpsilon
+  | PathSeq (hp, hp') ->
+     let hpder = path_derivate hp hint in
+     if matches_epsilon hp then 
+       PathOr (path_seq hpder hp', path_derivate hp' hint)
+     else if is_empty hpder then PathEmpty 
+     else path_seq hpder hp'
+  | PathOr (hp, hp') ->
+     PathOr (path_derivate hp hint, path_derivate hp' hint)
+  | PathEmpty -> PathEmpty
+  | PathEpsilon -> PathEmpty
 
 let rec normalize_path h =
   match h with
@@ -382,19 +400,40 @@ let rec normalize_path h =
 
 let path_derivate hp hint = normalize_path (path_derivate hp hint)
 
-let pp_hints_path_atom a =
+let pp_hints_path_atom prg a =
   match a with
-  | PathAny -> str"*"
-  | PathHints grs -> pr_sequence pr_global grs
-					   
-let rec pp_hints_path = function
-  | PathAtom pa -> pp_hints_path_atom pa
-  | PathStar p -> str "!(" ++ pp_hints_path p ++ str")"
-  | PathSeq (p, p') -> pp_hints_path p ++ str" ; " ++ pp_hints_path p'
-  | PathOr (p, p') -> 
-    str "(" ++ pp_hints_path p ++ spc () ++ str"|" ++ spc () ++ pp_hints_path p' ++ str ")"
+  | PathAny -> str"_"
+  | PathHints grs -> pr_sequence prg grs
+
+let pp_hints_path_gen prg =
+  let rec aux = function
+    | PathAtom pa -> pp_hints_path_atom prg pa
+    | PathStar (PathAtom PathAny) -> str"_*"
+    | PathStar p -> str "(" ++ aux p ++ str")*"
+    | PathSeq (p, p') -> aux p ++ spc () ++ aux p'
+    | PathOr (p, p') -> 
+     str "(" ++ aux p ++ spc () ++ str"|" ++ cut () ++ spc () ++
+     aux p' ++ str ")"
   | PathEmpty -> str"emp"
   | PathEpsilon -> str"eps"
+  in aux
+     
+let pp_hints_path = pp_hints_path_gen pr_global
+
+let glob_hints_path_atom p =
+  match p with
+  | PathHints g -> PathHints (List.map Nametab.global g)
+  | PathAny -> PathAny
+
+let glob_hints_path =
+  let rec aux = function
+    | PathAtom pa -> PathAtom (glob_hints_path_atom pa)
+    | PathStar p -> PathStar (aux p)
+    | PathSeq (p, p') -> PathSeq (aux p, aux p')
+    | PathOr (p, p') -> PathOr (aux p, aux p')
+    | PathEmpty -> PathEmpty
+    | PathEpsilon -> PathEpsilon
+  in aux
 
 let subst_path_atom subst p =
   match p with
@@ -421,7 +460,38 @@ let rec subst_hints_path subst hp =
       if p' == p && q' == q then hp else PathOr (p', q')
   | _ -> hp
 
-module Hint_db = struct
+type hint_db_name = string
+
+module Hint_db :
+sig
+type t
+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 ->
+		      (global_reference * constr array) -> constr -> t -> full_hint list
+val map_eauto : secvars:Id.Pred.t ->
+		(global_reference * constr array) -> constr -> t -> full_hint list
+val map_auto : 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
+val remove_one : global_reference -> t -> t
+val remove_list : global_reference list -> t -> t
+val iter : (global_reference option -> hint_mode array list -> full_hint list -> unit) -> t -> unit
+val use_dn : t -> bool
+val transparent_state : t -> transparent_state
+val set_transparent_state : t -> transparent_state -> t
+val add_cut : hints_path -> t -> t
+val add_mode : global_reference -> hint_mode array -> t -> t
+val cut : t -> hints_path
+val unfolds : t -> Id.Set.t * Cset.t
+val fold : (global_reference option -> hint_mode array list -> full_hint list -> 'a -> 'a) ->
+  t -> 'a -> 'a
+
+end =
+struct
 
   type t = {
     hintdb_state : Names.transparent_state;
@@ -432,69 +502,83 @@ module Hint_db = struct
     hintdb_map : search_entry Constr_map.t;
     (* A list of unindexed entries starting with an unfoldable constant
        or with no associated pattern. *)
-    hintdb_nopat : (global_reference option * stored_data) list
+    hintdb_nopat : (global_reference option * stored_data) list;
+    hintdb_name : string option;
   }
 
   let next_hint_id db =
     let h = db.hintdb_max_id in
     { db with hintdb_max_id = succ db.hintdb_max_id }, h
 
-  let empty st use_dn = { hintdb_state = st;
+  let empty ?name st use_dn = { hintdb_state = st;
 			  hintdb_cut = PathEmpty;
 			  hintdb_unfolds = (Id.Set.empty, Cset.empty);
 			  hintdb_max_id = 0;
 			  use_dn = use_dn;
 			  hintdb_map = Constr_map.empty;
-			  hintdb_nopat = [] }
+			  hintdb_nopat = [];
+			  hintdb_name = name; }
 
   let find key db =
     try Constr_map.find key db.hintdb_map
     with Not_found -> empty_se
  
-  let realize_tac (id,tac) = tac
-
+  let realize_tac secvars (id,tac) =
+    if Id.Pred.subset tac.secvars secvars then Some tac
+    else
+      (** Warn about no longer typable hint? *)
+      None
+
+  let match_mode m arg =
+    match m with
+    | ModeInput -> not (occur_existential arg)
+    | ModeNoHeadEvar ->
+       Evarutil.(try ignore(head_evar arg); false
+                 with NoHeadEvar -> true)
+    | ModeOutput -> true
+                               
   let matches_mode args mode =
-    Array.length args == Array.length mode &&
-      Array.for_all2 (fun arg m -> not (m && occur_existential arg)) args mode
+    Array.length mode == Array.length args &&
+      Array.for_all2 match_mode mode args
       
   let matches_modes args modes =
     if List.is_empty modes then true
     else List.exists (matches_mode args) modes
 
-  let merge_entry db nopat pat =
+  let merge_entry secvars db nopat pat =
     let h = List.sort pri_order_int (List.map snd db.hintdb_nopat) in
     let h = List.merge pri_order_int h nopat in
     let h = List.merge pri_order_int h pat in
-    List.map realize_tac h
+    List.map_filter (realize_tac secvars) h
 
-  let map_none db =
-    merge_entry db [] []
+  let map_none ~secvars db =
+    merge_entry secvars db [] []
 
-  let map_all k db =
+  let map_all ~secvars k db =
     let se = find k db in
-    merge_entry db se.sentry_nopat se.sentry_pat
+    merge_entry secvars db se.sentry_nopat se.sentry_pat
 	
   (** Precondition: concl has no existentials *)
-  let map_auto (k,args) concl db =
+  let map_auto ~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
-    merge_entry db [] pat
+    merge_entry secvars db [] pat
 
-  let map_existential (k,args) concl db =
+  let map_existential ~secvars (k,args) concl db =
     let se = find k db in
       if matches_modes args se.sentry_mode then
-        merge_entry db se.sentry_nopat se.sentry_pat
-      else merge_entry db [] []
+        merge_entry secvars db se.sentry_nopat se.sentry_pat
+      else merge_entry secvars db [] []
 
   (* [c] contains an existential *)
-  let map_eauto (k,args) concl db =
+  let map_eauto ~secvars (k,args) concl db =
     let se = find k db in
       if matches_modes 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
-        merge_entry db [] pat
-      else merge_entry db [] []
+        merge_entry secvars db [] pat
+      else merge_entry secvars db [] []
 
   let is_exact = function
     | Give_exact _ -> true
@@ -505,7 +589,7 @@ module Hint_db = struct
     | _ -> false
 
   let addkv gr id v db =
-    let idv = id, v in
+    let idv = id, { v with db = db.hintdb_name } in
     let k = match gr with
       | Some gr -> if db.use_dn && is_transparent_gr db.hintdb_state gr &&
 	  is_unfold v.code.obj then None else Some gr
@@ -570,11 +654,11 @@ module Hint_db = struct
 
   let get_entry se =
     let h = List.merge pri_order_int se.sentry_nopat se.sentry_pat in
-    List.map realize_tac h
+    List.map snd h
 
   let iter f db =
     let iter_se k se = f (Some k) se.sentry_mode (get_entry se) in
-    f None [] (List.map (fun x -> realize_tac (snd x)) db.hintdb_nopat);
+    f None [] (List.map (fun x -> snd (snd x)) db.hintdb_nopat);
     Constr_map.iter iter_se db.hintdb_map
 
   let fold f db accu =
@@ -609,8 +693,6 @@ type hint_db = Hint_db.t
 
 type hint_db_table = hint_db Hintdbmap.t ref
 
-type hint_db_name = string
-
 (** Initially created hint databases, for typeclasses and rewrite *)
 
 let typeclasses_db = "typeclass_instances"
@@ -631,8 +713,7 @@ let searchtable_add (name,db) =
 let current_db_names () = Hintdbmap.domain !searchtable
 let current_db () = Hintdbmap.bindings !searchtable
 
-let current_pure_db () =
-  List.map snd (Hintdbmap.bindings (Hintdbmap.remove "v62" !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 ".")
@@ -672,7 +753,20 @@ let try_head_pattern c =
 
 let with_uid c = { obj = c; uid = fresh_key () }
 
-let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) =
+let secvars_of_idset s =
+  Id.Set.fold (fun id p ->
+      if is_section_variable id then
+        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_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
     | Prod _ -> failwith "make_exact_entry"
@@ -682,14 +776,17 @@ let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) =
 	  try head_pattern_bound pat
 	  with BoundPattern -> failwith "make_exact_entry"
 	in
-          (Some hd,
-	  { pri = (match pri with None -> 0 | Some p -> p);
-	    poly = poly;
-	    pat = Some pat;
-	    name = name;
-	    code = with_uid (Give_exact (c, cty, ctx)); })
+	let pri = match info.hint_priority with None -> 0 | Some p -> p in
+	let pat = match info.hint_pattern with
+	| Some pat -> snd pat
+	| None -> pat
+	in
+        (Some hd,
+	 { pri; poly; pat = Some pat; name;
+	   db = None; secvars;
+	   code = with_uid (Give_exact (c, cty, ctx)); })
 
-let make_apply_entry env sigma (eapply,hnf,verbose) pri 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 _ ->
@@ -701,23 +798,25 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c,
 	  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 = (match pri with None -> nb_hyp cty | Some p -> p);
-	    poly = poly;
-            pat = Some pat;
-	    name = name;
+          { 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
-	    msg_warning (str "the hint: eapply " ++ pr_lconstr c ++
+	    Feedback.msg_info (str "the hint: eapply " ++ pr_lconstr c ++
 	    str " will only be used by eauto");
           (Some hd,
-           { pri = (match pri with None -> nb_hyp cty + nmiss | Some p -> p);
-	     poly = poly;
-             pat = Some pat;
-	     name = name;
+           { pri; poly; pat = Some pat; name;
+	     db = None; secvars;
              code = with_uid (ERes_pf(c,cty,ctx)); })
         end
     | _ -> failwith "make_apply_entry"
@@ -726,18 +825,56 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c,
    c is a constr
    cty is the type of constr *)
 
-let fresh_global_or_constr env sigma poly cr =
-  match cr with
-  | IsGlobRef gr -> Universes.fresh_global_instance env gr
-  | IsConstr (c, ctx) -> (c, ctx)
+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
+
+(** We need an object to record the side-effect of registering
+  global universes associated with a hint. *)
+let cache_context_set (_,c) =
+  Global.push_context_set false c
+
+let input_context_set : Univ.ContextSet.t -> Libobject.obj =
+  let open Libobject in
+    declare_object
+    { (default_object "Global universe context") with
+      cache_function = cache_context_set;
+      load_function = (fun _ -> cache_context_set);
+      discharge_function = (fun (_,a) -> Some a);
+      classify_function = (fun a -> Keep a) }
+
+let warn_polymorphic_hint =
+  CWarnings.create ~name:"polymorphic-hint" ~category:"automation"
+         (fun hint -> strbrk"Using polymorphic hint " ++ hint ++
+                        str" monomorphically" ++
+                        strbrk" use Polymorphic Hint to use it polymorphically.")
 
-let make_resolves env sigma flags pri poly ?name cr =
+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
+    | IsConstr (c, ctx) -> false, (c, ctx)
+  in
+    if poly then (c, ctx)
+    else if Univ.ContextSet.is_empty ctx then (c, ctx)
+    else begin
+      if isgr then
+        warn_polymorphic_hint (pr_hint_term env sigma ctx cr);
+      Lib.add_anonymous_leaf (input_context_set ctx);
+      (c, Univ.ContextSet.empty)
+    end
+
+let make_resolves env sigma flags info poly ?name cr =
   let c, ctx = fresh_global_or_constr env sigma poly cr in
   let cty = Retyping.get_type_of env sigma c in
   let try_apply f =
     try Some (f (c, cty, ctx)) with Failure _ -> None in
   let ents = List.map_filter try_apply
-    [make_exact_entry env sigma pri poly ?name; make_apply_entry env sigma flags pri poly ?name]
+			     [make_exact_entry env sigma info poly ?name;
+			      make_apply_entry env sigma flags info poly ?name]
   in
   if List.is_empty ents then
     errorlabstrm "Hint"
@@ -747,16 +884,19 @@ let make_resolves env sigma flags pri poly ?name cr =
   ents
 
 (* used to add an hypothesis to the local hint database *)
-let make_resolve_hyp env sigma (hname,_,htyp) =
+let make_resolve_hyp env sigma decl =
+  let hname = get_id decl in
+  let c = mkVar hname in
   try
-    [make_apply_entry env sigma (true, true, false) None false
+    [make_apply_entry env sigma (true, true, false) empty_hint_info false
        ~name:(PathHints [VarRef hname])
-       (mkVar hname, htyp, Univ.ContextSet.empty)]
+       (c, get_type decl, Univ.ContextSet.empty)]
   with
     | Failure _ -> []
     | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp")
 
 (* REM : in most cases hintname = id *)
+
 let make_unfold eref =
   let g = global_of_evaluable_reference eref in
   (Some g,
@@ -764,15 +904,20 @@ let make_unfold eref =
      poly = false;
      pat = None;
      name = PathHints [g];
+     db = None;
+     secvars = secvars_of_global (Global.env ()) g;
      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;
      poly = false;
      pat = pat;
      name = PathAny;
+     db = None;
+     secvars = Id.Pred.empty; (* Approximation *)
      code = with_uid (Extern tacast) })  
 
 let make_mode ref m = 
@@ -796,6 +941,8 @@ let make_trivial env sigma poly ?(name=PathAny) r =
 	      poly = poly;
               pat = Some (Patternops.pattern_of_constr env ce.evd (clenv_type ce));
 	      name = name;
+              db = None;
+              secvars = secvars_of_constr env c;
               code= with_uid (Res_pf_THEN_trivial_fail(c,t,ctx)) })
 
 
@@ -809,7 +956,7 @@ let make_trivial env sigma poly ?(name=PathAny) r =
 
 let get_db dbname =
   try searchtable_map dbname
-  with Not_found -> Hint_db.empty empty_transparent_state false
+  with Not_found -> Hint_db.empty ~name:dbname empty_transparent_state false
 
 let add_hint dbname hintlist =
   let check (_, h) =
@@ -848,7 +995,7 @@ type hint_action =
   | AddHints of hint_entry list
   | RemoveHints of global_reference list
   | AddCut of hints_path
-  | AddMode of global_reference * bool array
+  | AddMode of global_reference * hint_mode array
 
 let add_cut dbname path =
   let db = get_db dbname in
@@ -869,7 +1016,7 @@ type hint_obj = {
 let load_autohint _ (kn, h) =
   let name = h.hint_name in
   match h.hint_action with
-  | CreateDB (b, st) -> searchtable_add (name, Hint_db.empty st b)
+  | CreateDB (b, st) -> searchtable_add (name, Hint_db.empty ~name st b)
   | AddTransparency (grs, b) -> add_transparency name grs b
   | AddHints hints -> add_hint name hints
   | RemoveHints grs -> remove_hint name grs
@@ -918,7 +1065,7 @@ let subst_autohint (subst, obj) =
           let ref' = subst_evaluable_reference subst ref in
           if ref==ref' then data.code.obj else Unfold_nth ref'
       | Extern tac ->
-	  let tac' = Tacsubst.subst_tactic subst tac in
+	  let tac' = Genintern.generic_substitute subst tac in
 	  if tac==tac' then data.code.obj else Extern tac'
     in
     let name' = subst_path_atom subst data.name in
@@ -1025,16 +1172,17 @@ let add_transparency l b local dbnames =
       Lib.add_anonymous_leaf (inAutoHint hint))
     dbnames
 
-let add_extern pri pat tacast local dbname =
-  let pat = match pat with
+let add_extern info tacast local dbname =
+  let pat = match info.hint_pattern with
   | None -> None
   | Some (_, pat) -> Some pat
   in
-  let hint = make_hint ~local dbname (AddHints [make_extern pri pat tacast]) in
+  let hint = make_hint ~local dbname
+		       (AddHints [make_extern (Option.get info.hint_priority) pat tacast]) in
   Lib.add_anonymous_leaf (inAutoHint hint)
 
-let add_externs pri pat tacast local dbnames =
-  List.iter (add_extern pri pat tacast local) dbnames
+let add_externs info tacast local dbnames =
+  List.iter (add_extern info tacast local) dbnames
 
 let add_trivials env sigma l local dbnames =
   List.iter
@@ -1048,15 +1196,16 @@ let (forward_intern_tac, extern_intern_tac) = Hook.make ()
 
 type hnf = bool
 
+type hint_info = (patvar list * constr_pattern) hint_info_gen
+
 type hints_entry =
-  | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * hint_term) list
+  | HintsResolveEntry of (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list
   | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list
   | HintsCutEntry of hints_path
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsModeEntry of global_reference * bool list
-  | HintsExternEntry of
-      int * (patvar list * constr_pattern) option * glob_tactic_expr
+  | HintsModeEntry of global_reference * hint_mode list
+  | HintsExternEntry of hint_info * glob_tactic_expr
 
 let default_prepare_hint_ident = Id.of_string "H"
 
@@ -1064,10 +1213,12 @@ exception Found of constr * types
 
 let prepare_hint check (poly,local) env init (sigma,c) =
   let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
-  (* We re-abstract over uninstantiated evars.
+  (* 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 c = drop_extra_implicit_args (Evarutil.nf_evar sigma c) in
+  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 subst = ref [] in
   let rec find_next_evar c = match kind_of_term c with
@@ -1081,7 +1232,7 @@ let prepare_hint check (poly,local) env init (sigma,c) =
 	(* Not clever enough to construct dependency graph of evars *)
 	error "Not clever enough to deal with evars dependent in other evars.";
       raise (Found (c,t))
-    | _ -> iter_constr find_next_evar c in
+    | _ -> Constr.iter find_next_evar c in
   let rec iter c =
     try find_next_evar c; c
     with Found (evar,t) ->
@@ -1090,11 +1241,11 @@ let prepare_hint check (poly,local) env init (sigma,c) =
       subst := (evar,mkVar id)::!subst;
       mkNamedLambda id t (iter (replace_term evar (mkVar id) c)) in
   let c' = iter c in
-    if check then Evarutil.check_evars (Global.env()) Evd.empty sigma c';
+    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
     if poly then IsConstr (c', diff)
     else if local then IsConstr (c', diff)
-    else (Global.push_context_set false diff;
+    else (Lib.add_anonymous_leaf (input_context_set diff);
 	  IsConstr (c', Univ.ContextSet.empty))
 
 let interp_hints poly =
@@ -1118,11 +1269,12 @@ let interp_hints poly =
 	(PathHints [gr], poly, IsGlobRef gr)
     | HintsConstr c -> (PathAny, poly, f poly c)
   in
-  let fres (pri, b, r) =
+  let fp = Constrintern.intern_constr_pattern (Global.env()) in
+  let fres (info, b, r) =
     let path, poly, gr = fi r in
-      (pri, poly, b, path, gr)
+    let info = { info with hint_pattern = Option.map fp info.hint_pattern } in
+      (info, poly, b, path, gr)
   in
-  let fp = Constrintern.intern_constr_pattern (Global.env()) in
   match h with
   | HintsResolve lhints -> HintsResolveEntry (List.map fres lhints)
   | HintsImmediate lhints -> HintsImmediateEntry (List.map fi lhints)
@@ -1138,14 +1290,14 @@ let interp_hints poly =
           List.init (nconstructors ind) 
 	    (fun i -> let c = (ind,i+1) in
 		      let gr = ConstructRef c in
-			None, mib.Declarations.mind_polymorphic, true, 
+			empty_hint_info, mib.Declarations.mind_polymorphic, 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
-      HintsExternEntry (pri, pat, tacexp)
+      HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp)
 
 let add_hints local dbnames0 h =
   if String.List.mem "nocore" dbnames0 then
@@ -1161,29 +1313,41 @@ let add_hints local dbnames0 h =
   | HintsUnfoldEntry lhints -> add_unfolds lhints local dbnames
   | HintsTransparencyEntry (lhints, b) ->
       add_transparency lhints b local dbnames
-  | HintsExternEntry (pri, pat, tacexp) ->
-      add_externs pri pat tacexp local dbnames
+  | HintsExternEntry (info, tacexp) ->
+      add_externs info tacexp local dbnames
 
 let expand_constructor_hints env sigma lems =
   List.map_append (fun (evd,lem) ->
     match kind_of_term lem with
     | Ind (ind,u) ->
 	List.init (nconstructors ind) 
-	  (fun i -> IsConstr (mkConstructU ((ind,i+1),u), 
-			      Univ.ContextSet.empty))
+		  (fun i ->
+		   let ctx = Univ.ContextSet.diff (Evd.universe_context_set evd)
+						  (Evd.universe_context_set sigma) in
+		   not (Univ.ContextSet.is_empty ctx),
+		   IsConstr (mkConstructU ((ind,i+1),u),ctx))
     | _ ->
-	[prepare_hint false (false,true) env sigma (evd,lem)]) lems
-
+       [match prepare_hint false (false,true) env sigma (evd,lem) with
+	| IsConstr (c, ctx) ->
+	   not (Univ.ContextSet.is_empty ctx), IsConstr (c, ctx)
+	| IsGlobRef _ -> assert false (* Impossible return value *) ]) lems
 (* builds a hint database from a constr signature *)
 (* typically used with (lid, ltyp) = pf_hyps_types <some goal> *)
 
 let add_hint_lemmas env sigma eapply lems hint_db =
   let lems = expand_constructor_hints env sigma lems in
   let hintlist' =
-    List.map_append (make_resolves env sigma (eapply,true,false) None false) lems in
+    List.map_append (fun (poly, lem) ->
+		     make_resolves env sigma (eapply,true,false) empty_hint_info poly lem) lems in
   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 lems = List.map map lems in
   let sign = Environ.named_context env in
   let ts = match ts with
     | None -> Hint_db.transparent_state (searchtable_map "core") 
@@ -1193,12 +1357,6 @@ let make_local_hint_db env sigma ts eapply lems =
   add_hint_lemmas env sigma eapply lems
     (Hint_db.add_list env sigma hintlist (Hint_db.empty ts false))
 
-let make_local_hint_db = 
-  if Flags.profile then
-    let key = Profile.declare_profile "make_local_hint_db" in
-      Profile.profile4 key make_local_hint_db
-  else make_local_hint_db
-
 let make_local_hint_db env sigma ?ts eapply lems =
   make_local_hint_db env sigma ts eapply lems
 
@@ -1218,23 +1376,25 @@ let make_db_list dbnames =
 let pr_hint_elt (c, _, _) = pr_constr c
 
 let pr_hint h = match h.obj with
-  | Res_pf (c, _) -> (str"apply " ++ pr_hint_elt c)
-  | ERes_pf (c, _) -> (str"eapply " ++ pr_hint_elt c)
+  | 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)
   | Res_pf_THEN_trivial_fail (c, _) ->
-      (str"apply " ++ pr_hint_elt c ++ str" ; trivial")
+      (str"simple apply " ++ pr_hint_elt 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 Errors.noncritical e -> Global.env ()
+        with e when CErrors.noncritical e -> Global.env ()
       in
-      (str "(*external*) " ++ Pptactic.pr_glob_tactic env tac)
+      (str "(*external*) " ++ Pptactic.pr_glb_generic env tac)
 
 let pr_id_hint (id, v) =
-  (pr_hint v.code ++ str"(level " ++ int v.pri ++ str", id " ++ int id ++ str ")" ++ spc ())
+  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
+   ++ str", id " ++ int id ++ str ")" ++ spc ())
 
 let pr_hint_list hintlist =
   (str "  " ++ hov 0 (prlist pr_id_hint hintlist) ++ fnl ())
@@ -1248,7 +1408,7 @@ let pr_hints_db (name,db,hintlist) =
 let pr_hint_list_for_head c =
   let dbs = current_db () in
   let validate (name, db) =
-    let hints = List.map (fun v -> 0, v) (Hint_db.map_all c db) in
+    let hints = List.map (fun v -> 0, v) (Hint_db.map_all Id.Pred.full c db) in
     (name, db, hints)
   in
   let valid_dbs = List.map validate dbs in
@@ -1270,9 +1430,9 @@ let pr_hint_term cl =
       let fn = try
 	  let hdc = decompose_app_bound cl in
 	    if occur_existential cl then
-	      Hint_db.map_existential hdc cl
-	    else Hint_db.map_auto hdc cl
-	with Bound -> Hint_db.map_none
+	      Hint_db.map_existential ~secvars:Id.Pred.full hdc cl
+	    else Hint_db.map_auto ~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
       List.map (fun (name, db) -> (name, db, fn db)) dbs
@@ -1290,13 +1450,18 @@ let pr_applicable_hint () =
   let pts = get_pftreestate () in
   let glss = Proof.V82.subgoals pts in
   match glss.Evd.it with
-  | [] -> Errors.error "No focused goal."
+  | [] -> CErrors.error "No focused goal."
   | g::_ ->
     pr_hint_term (Goal.V82.concl glss.Evd.sigma g)
 
+let pp_hint_mode = function
+  | ModeInput -> str"+"
+  | ModeNoHeadEvar -> str"!"
+  | ModeOutput -> str"-"
+
 (* displays the whole hint database db *)
 let pr_hint_db db =
-  let pr_mode = prvect_with_sep spc (fun x -> if x then str"+" else str"-") in
+  let pr_mode = prvect_with_sep spc pp_hint_mode in
   let pr_modes l = 
     if List.is_empty l then mt ()
     else str" (modes " ++ prlist_with_sep pr_comma pr_mode l ++ str")"
@@ -1344,10 +1509,15 @@ let print_mp mp =
 
 let is_imported h = try KNmap.find h.uid !statustable with Not_found -> true
 
+let warn_non_imported_hint =
+  CWarnings.create ~name:"non-imported-hint" ~category:"automation"
+         (fun (hint,mp) ->
+          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
-  let () = msg_warning (str "Hint used but not imported: " ++ hint ++ print_mp mp) in
+  warn_non_imported_hint (hint,mp);
   Proofview.tclUNIT x
 
 let run_hint tac k = match !warn_hint with
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 08ea71bb..1be3e0c5 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -10,7 +10,6 @@ open Pp
 open Util
 open Names
 open Term
-open Context
 open Environ
 open Globnames
 open Decl_kinds
@@ -26,6 +25,10 @@ exception Bound
 
 val decompose_app_bound : constr -> global_reference * constr array
 
+val secvars_of_hyps : Context.Named.t -> Id.Pred.t
+
+val empty_hint_info : 'a hint_info_gen
+
 (** Pre-created hint databases *)
 
 type 'a hint_ast =
@@ -34,21 +37,27 @@ type 'a hint_ast =
   | Give_exact of 'a
   | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *)
   | Unfold_nth of evaluable_global_reference       (* Hint Unfold *)
-  | Extern     of Tacexpr.glob_tactic_expr       (* Hint Extern *)
+  | Extern     of Genarg.glob_generic_argument       (* Hint Extern *)
 
 type hint
 type raw_hint = constr * types * Univ.universe_context_set
 
-type hints_path_atom = 
-  | PathHints of global_reference list
+type 'a hints_path_atom_gen =
+  | PathHints of 'a list
+  (* For forward hints, their names is the list of projections *)
   | PathAny
 
+type hints_path_atom = global_reference hints_path_atom_gen
+type hint_db_name = string
+
 type 'a with_metadata = private {
   pri   : int;            (** A number between 0 and 4, 4 = lower priority *)
   poly  : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
   pat   : constr_pattern option; (** A pattern for the concl of the Goal *)
   name  : hints_path_atom; (** A potential name to refer to the hint *) 
-  code  : 'a; (** the tactic to apply when the concl matches pat *)
+  db    : hint_db_name option;
+  secvars : Id.Pred.t; (** The section variables this hint depends on, as a predicate *)
+  code    : 'a; (** the tactic to apply when the concl matches pat *)
 }
 
 type full_hint = hint with_metadata
@@ -59,47 +68,63 @@ type search_entry
 
 type hint_entry
 
-type hints_path =
-  | PathAtom of hints_path_atom
-  | PathStar of hints_path
-  | PathSeq of hints_path * hints_path
-  | PathOr of hints_path * hints_path
+type 'a hints_path_gen =
+  | PathAtom of 'a hints_path_atom_gen
+  | PathStar of 'a hints_path_gen
+  | PathSeq of 'a hints_path_gen * 'a hints_path_gen
+  | PathOr of 'a hints_path_gen * 'a hints_path_gen
   | PathEmpty
   | PathEpsilon
 
+type pre_hints_path = Libnames.reference hints_path_gen
+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_atom : hints_path_atom -> Pp.std_ppcmds
+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 glob_hints_path_atom :
+  Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen
+val glob_hints_path :
+  Libnames.reference hints_path_gen -> Globnames.global_reference hints_path_gen
 
 module Hint_db :
   sig
     type t
-    val empty : transparent_state -> bool -> t
+    val empty : ?name:hint_db_name -> transparent_state -> bool -> t
     val find : global_reference -> t -> search_entry
-    val map_none : t -> full_hint list
+
+    (** All hints which have no pattern.
+     * [secvars] represent the set of section variables that
+     * can be used in the hint. *)
+    val map_none : secvars:Id.Pred.t -> t -> full_hint list
 
     (** All hints associated to the reference *)
-    val map_all : global_reference -> t -> full_hint list
+    val map_all : secvars:Id.Pred.t -> global_reference -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments, _not_ using the discrimination net. *)
-    val map_existential : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_existential : 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 : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_eauto : 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 : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_auto : 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
     val remove_one : global_reference -> t -> t
     val remove_list : global_reference list -> t -> t
-    val iter : (global_reference option -> bool array list -> full_hint list -> unit) -> t -> unit
+    val iter : (global_reference option ->
+                hint_mode array list -> full_hint list -> unit) -> t -> unit
 
     val use_dn : t -> bool
     val transparent_state : t -> transparent_state
@@ -111,26 +136,25 @@ module Hint_db :
     val unfolds : t -> Id.Set.t * Cset.t
   end
 
-type hint_db_name = string
-
 type hint_db = Hint_db.t
 
 type hnf = bool
 
+type hint_info = (patvar list * constr_pattern) hint_info_gen
+
 type hint_term =
   | IsGlobRef of global_reference
   | IsConstr of constr * Univ.universe_context_set
 
 type hints_entry =
-  | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * 
-			  hint_term) list
+  | HintsResolveEntry of
+    (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list
   | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list
   | HintsCutEntry of hints_path
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsModeEntry of global_reference * bool list      
-  | HintsExternEntry of
-      int * (patvar list * constr_pattern) option * Tacexpr.glob_tactic_expr
+  | HintsModeEntry of global_reference * hint_mode list
+  | HintsExternEntry of hint_info * Tacexpr.glob_tactic_expr
 
 val searchtable_map : hint_db_name -> hint_db
 
@@ -157,22 +181,34 @@ val prepare_hint : bool (* Check no remaining evars *) ->
   (bool * bool) (* polymorphic or monomorphic, local or global *) ->
   env -> evar_map -> open_constr -> hint_term
 
-(** [make_exact_entry pri (c, ctyp)].
+(** [make_exact_entry info (c, ctyp, ctx)].
    [c] is the term given as an exact proof to solve the goal;
-   [ctyp] is the type of [c]. *)
-
-val make_exact_entry : env -> evar_map -> int option -> polymorphic -> ?name:hints_path_atom -> 
+   [ctyp] is the type of [c].
+   [ctx] is its (refreshable) universe context. 
+   In info:
+   [hint_priority] is the hint's desired priority, it is 0 if unspecified
+   [hint_pattern] is the hint's desired pattern, it is inferred if not specified
+*)
+
+val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   (constr * types * Univ.universe_context_set) -> hint_entry
 
-(** [make_apply_entry (eapply,hnf,verbose) pri (c,cty)].
+(** [make_apply_entry (eapply,hnf,verbose) info (c,cty,ctx))].
    [eapply] is true if this hint will be used only with EApply;
    [hnf] should be true if we should expand the head of cty before searching for
    products;
    [c] is the term given as an exact proof to solve the goal;
-   [cty] is the type of [c]. *)
+   [cty] is the type of [c].
+   [ctx] is its (refreshable) universe context. 
+   In info:
+   [hint_priority] is the hint's desired priority, it is computed as the number of products in [cty]
+   if unspecified
+   [hint_pattern] is the hint's desired pattern, it is inferred from the conclusion of [cty]
+   if not specified
+*)
 
 val make_apply_entry :
-  env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> 
+  env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   (constr * types * Univ.universe_context_set) -> hint_entry
 
 (** A constr which is Hint'ed will be:
@@ -183,7 +219,7 @@ val make_apply_entry :
          has missing arguments. *)
 
 val make_resolves :
-  env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> 
+  env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   hint_term -> hint_entry list
 
 (** [make_resolve_hyp hname htyp].
@@ -192,7 +228,7 @@ val make_resolves :
    If the hyp cannot be used as a Hint, the empty list is returned. *)
 
 val make_resolve_hyp :
-  env -> evar_map -> named_declaration -> hint_entry list
+  env -> evar_map -> Context.Named.Declaration.t -> hint_entry list
 
 (** [make_extern pri pattern tactic_expr] *)
 
@@ -214,7 +250,7 @@ val extern_intern_tac :
    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 -> open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> Tacexpr.delayed_open_constr list -> hint_db
 
 val make_db_list : hint_db_name list -> hint_db list
 
diff --git a/tactics/hipattern.ml4 b/tactics/hipattern.ml
index 29d848ca..7b52a9ce 100644
--- a/tactics/hipattern.ml4
+++ b/tactics/hipattern.ml
@@ -6,10 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma grammar/q_constr.cmo" i*)
-
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -19,6 +17,7 @@ open Constr_matching
 open Coqlib
 open Declarations
 open Tacmach.New
+open 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
@@ -101,13 +100,16 @@ let match_with_one_constructor style onlybinary allow_rec t =
 	      (decompose_prod_n_assum mib.mind_nparams mip.mind_nf_lc.(0)))) in
 	  if
 	    List.for_all
-	      (fun (_,b,c) -> Option.is_empty b && isRel c && Int.equal (destRel c) mib.mind_nparams) ctx
+	      (fun decl -> let c = get_type decl in
+	                   is_local_assum decl &&
+			   isRel c &&
+                           Int.equal (destRel 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 pi3 ((prod_assum ctyp)) in
+	  let cargs = List.map get_type (prod_assum ctyp) in
 	  if not (is_lax_conjunction style) || has_nodep_prod ctyp then
 	    (* Record or non strict conjunction *)
 	    Some (hdapp,List.rev cargs)
@@ -152,7 +154,7 @@ let is_tuple t =
 let test_strict_disjunction n lc =
   Array.for_all_i (fun i c ->
     match (prod_assum (snd (decompose_prod_n_assum n c))) with
-    | [_,None,c] -> isRel c && Int.equal (destRel c) (n - i)
+    | [LocalAssum (_,c)] -> isRel c && Int.equal (destRel c) (n - i)
     | _ -> false) 0 lc
 
 let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
@@ -239,9 +241,36 @@ type equation_kind =
 
 exception NoEquationFound
 
-let coq_refl_leibniz1_pattern = PATTERN [ forall x:_, _ x x ]
-let coq_refl_leibniz2_pattern = PATTERN [ forall A:_, forall x:A, _ A x x ]
-let coq_refl_jm_pattern       = PATTERN [ forall A:_, forall x:A, _ A x A x ]
+open Glob_term
+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 mkGAppRef r args = mkGApp (mkGRef r) args
+
+(** forall x : _, _ x x *)
+let coq_refl_leibniz1_pattern =
+  mkPattern (mkGProd "x" mkGHole (mkGApp mkGHole [mkGVar "x"; mkGVar "x";]))
+
+(** forall A:_, forall x:A, _ A x x *)
+let coq_refl_leibniz2_pattern =
+  mkPattern (mkGProd "A" mkGHole (mkGProd "x" (mkGVar "A")
+    (mkGApp mkGHole [mkGVar "A"; mkGVar "x"; mkGVar "x";])))
+
+(** forall A:_, forall x:A, _ A x A x *)
+let coq_refl_jm_pattern       =
+  mkPattern (mkGProd "A" mkGHole (mkGProd "x" (mkGVar "A")
+    (mkGApp mkGHole [mkGVar "A"; mkGVar "x"; mkGVar "A"; mkGVar "x";])))
 
 open Globnames
 
@@ -297,7 +326,8 @@ let is_equality_type t = op2bool (match_with_equality_type t)
 
 (* Arrows/Implication/Negation *)
 
-let coq_arrow_pattern = PATTERN [ ?X1 -> ?X2 ]
+(** 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
@@ -376,33 +406,27 @@ let rec first_match matcher = function
 
 (*** Equality *)
 
-(* Patterns "(eq ?1 ?2 ?3)" and "(identity ?1 ?2 ?3)" *)
-let coq_eq_pattern_gen eq = lazy PATTERN [ %eq ?X1 ?X2 ?X3 ]
-let coq_eq_pattern = coq_eq_pattern_gen coq_eq_ref
-let coq_identity_pattern = coq_eq_pattern_gen coq_identity_ref
-let coq_jmeq_pattern = lazy PATTERN [ %coq_jmeq_ref ?X1 ?X2 ?X3 ?X4 ]
-
-let match_eq eqn eq_pat =
-  let pat =
-    try Lazy.force eq_pat
-    with e when Errors.noncritical e -> raise PatternMatchingFailure
+let match_eq eqn (ref, hetero) =
+  let ref =
+    try Lazy.force ref
+    with e when CErrors.noncritical e -> raise PatternMatchingFailure
   in
-  match Id.Map.bindings (matches pat eqn) with
-    | [(m1,t);(m2,x);(m3,y)] ->
-	assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3);
-        PolymorphicLeibnizEq (t,x,y)
-    | [(m1,t);(m2,x);(m3,t');(m4,x')] ->
-        assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3 && Id.equal m4 meta4);
-	HeterogenousEq (t,x,t',x')
-    | _ -> anomaly ~label:"match_eq" (Pp.str "an eq pattern should match 3 or 4 terms")
+  match kind_of_term eqn with
+  | App (c, [|t; x; y|]) ->
+    if not hetero && is_global 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')
+    else raise PatternMatchingFailure
+  | _ -> raise PatternMatchingFailure
 
 let no_check () = true
 let check_jmeq_loaded () = Library.library_is_loaded Coqlib.jmeq_module
 
 let equalities =
-  [coq_eq_pattern, no_check, build_coq_eq_data;
-   coq_jmeq_pattern, check_jmeq_loaded, build_coq_jmeq_data;
-   coq_identity_pattern, no_check, build_coq_identity_data]
+  [(coq_eq_ref, false), no_check, build_coq_eq_data;
+   (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
@@ -433,11 +457,14 @@ let find_this_eq_data_decompose gl eqn =
       error "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 eq_pat =
-  match Id.Map.bindings (pf_matches gls (Lazy.force eq_pat) eqn) with
+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_betadeltaiota gls x,pf_whd_betadeltaiota gls y)
+	(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 =
@@ -460,7 +487,8 @@ let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
   match_sigma ex
 
 (* Pattern "(sig ?1 ?2)" *)
-let coq_sig_pattern = lazy PATTERN [ %coq_sig_ref ?X1 ?X2 ]
+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
@@ -476,17 +504,25 @@ let is_matching_sigma t = is_matching (Lazy.force coq_sig_pattern) t
 (* Pattern "{<?1>x=y}+{~(<?1>x=y)}" *)
 (* i.e. "(sumbool (eq ?1 x y) ~(eq ?1 x y))" *)
 
-let coq_eqdec_inf_pattern =
- lazy PATTERN [ { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } ]
+let coq_eqdec ~sum ~rev =
+  lazy (
+    let eqn = mkGAppRef coq_eq_ref (List.map mkGPatVar ["X1"; "X2"; "X3"]) in
+    let args = [eqn; mkGAppRef coq_not_ref [eqn]] in
+    let args = if rev then List.rev args else args in
+    mkPattern (mkGAppRef sum args)
+  )
+
+(** { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } *)
+let coq_eqdec_inf_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:false
 
-let coq_eqdec_inf_rev_pattern =
- lazy PATTERN [ { ~ ?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
 
-let coq_eqdec_pattern =
- lazy PATTERN [ %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) ]
+(** %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) *)
+let coq_eqdec_pattern = coq_eqdec ~sum:coq_or_ref ~rev:false
 
-let coq_eqdec_rev_pattern =
- lazy PATTERN [ %coq_or_ref (~ ?X2 = ?X3 :> ?X1) (?X2 = ?X3 :> ?X1) ]
+(** %coq_or_ref (~ ?X2 = ?X3 :> ?X1) (?X2 = ?X3 :> ?X1) *)
+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
@@ -506,8 +542,8 @@ let match_eqdec t =
   | _ -> anomaly (Pp.str "Unexpected pattern")
 
 (* Patterns "~ ?" and "? -> False" *)
-let coq_not_pattern = lazy PATTERN [ ~ _ ]
-let coq_imp_False_pattern = lazy PATTERN [ _ -> %coq_False_ref ]
+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
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 32938ce5..7cc41f1b 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -119,11 +119,11 @@ val match_with_equation:
 
 (** Match terms [eq A t u], [identity A t u] or [JMeq A t A u] 
    Returns associated lemmas and [A,t,u] or fails PatternMatchingFailure *)
-val find_eq_data_decompose : [ `NF ] Proofview.Goal.t -> constr ->
+val find_eq_data_decompose : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
       coq_eq_data * Univ.universe_instance * (types * constr * constr)
 
 (** Idem but fails with an error message instead of PatternMatchingFailure *)
-val find_this_eq_data_decompose : [ `NF ] Proofview.Goal.t -> constr ->
+val find_this_eq_data_decompose : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
       coq_eq_data * Univ.universe_instance * (types * constr * constr)
 
 (** A variant that returns more informative structure on the equality found *)
@@ -144,7 +144,7 @@ val is_matching_sigma : constr -> bool
 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 ] Proofview.Goal.t -> constr -> (constr * constr * constr)
+val dest_nf_eq : ([ `NF ], 'r) Proofview.Goal.t -> constr -> (constr * constr * constr)
 
 (** Match a negation *)
 val is_matching_not : constr -> bool
diff --git a/tactics/inv.ml b/tactics/inv.ml
index 22bacdfc..bda16b01 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -7,13 +7,12 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
 open Term
 open Vars
-open Context
 open Termops
 open Namegen
 open Environ
@@ -27,9 +26,9 @@ open Elim
 open Equality
 open Misctypes
 open Tacexpr
+open Sigma.Notations
 open Proofview.Notations
-
-let clear hyps = Proofview.V82.tactic (clear hyps)
+open Context.Named.Declaration
 
 let var_occurs_in_pf gl id =
   let env = Proofview.Goal.env gl in
@@ -96,7 +95,7 @@ let make_inv_predicate env evd indf realargs id status concl =
 	  (* We lift to make room for the equations *)
 	  (hyps,lift nrealargs bodypred)
   in
-  let nhyps = rel_context_length hyps in
+  let nhyps = Context.Rel.length hyps in
   let env' = push_rel_context hyps env in
   (* Now the arity is pushed, and we need to construct the pairs
    * ai,mkRel(n-i+1) *)
@@ -181,9 +180,9 @@ let make_inv_predicate env evd indf realargs id status concl =
 let dependent_hyps env id idlist gl =
   let rec dep_rec =function
     | [] -> []
-    | (id1,_,_)::l ->
+    | d::l ->
 	(* Update the type of id1: it may have been subject to rewriting *)
-	let d = pf_get_hyp id1 gl in
+	let d = pf_get_hyp (get_id d) gl in
 	if occur_var_in_decl env id d
         then d :: dep_rec l
         else dep_rec l
@@ -192,8 +191,8 @@ let dependent_hyps env id idlist gl =
 
 let split_dep_and_nodep hyps gl =
   List.fold_right
-    (fun (id,_,_ as d) (l1,l2) ->
-       if var_occurs_in_pf gl id then (d::l1,l2) else (l1,d::l2))
+    (fun d (l1,l2) ->
+       if var_occurs_in_pf gl (get_id d) then (d::l1,l2) else (l1,d::l2))
     hyps ([],[])
 
 (* Computation of dids is late; must have been done in rewrite_equations*)
@@ -269,14 +268,14 @@ Nota: with Inversion_clear, only four useless hypotheses
 
 let generalizeRewriteIntros as_mode tac depids id =
   Proofview.tclENV >>= fun env ->
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { 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
@@ -284,10 +283,10 @@ let error_too_many_names pats =
   tclZEROMSG ~loc (
     str "Unexpected " ++
     str (String.plural (List.length pats) "introduction pattern") ++
-    str ": " ++ pr_enum (Miscprint.pr_intro_pattern (fun c -> Printer.pr_constr (snd (c env Evd.empty)))) pats ++
+    str ": " ++ pr_enum (Miscprint.pr_intro_pattern (fun c -> Printer.pr_constr (fst (run_delayed env Evd.empty c)))) pats ++
     str ".")
 
-let rec get_names (allow_conj,issimple) (loc,pat as x) = match pat with
+let get_names (allow_conj,issimple) (loc, pat as x) = match pat with
   | IntroNaming IntroAnonymous | IntroForthcoming _ ->
       error "Anonymous pattern not allowed for inversion equations."
   | IntroNaming (IntroFresh _) ->
@@ -296,17 +295,17 @@ let rec get_names (allow_conj,issimple) (loc,pat as x) = match pat with
       error "Discarding pattern not allowed for inversion equations."
   | IntroAction (IntroRewrite _) ->
       error "Rewriting pattern not allowed for inversion equations."
-  | IntroAction (IntroOrAndPattern [[]]) when allow_conj -> (None, [])
-  | IntroAction (IntroOrAndPattern [(_,IntroNaming (IntroIdentifier id)) :: _ as l])
+  | IntroAction (IntroOrAndPattern (IntroAndPattern [])) when allow_conj -> (None, [])
+  | IntroAction (IntroOrAndPattern (IntroAndPattern ((_,IntroNaming (IntroIdentifier id)) :: _ as l) | IntroOrPattern [(_,IntroNaming (IntroIdentifier id)) :: _ as l ]))
       when allow_conj -> (Some id,l)
-  | IntroAction (IntroOrAndPattern [_]) ->
+  | IntroAction (IntroOrAndPattern (IntroAndPattern _)) ->
       if issimple then
         error"Conjunctive patterns not allowed for simple inversion equations."
       else
         error"Nested conjunctive patterns not allowed for inversion equations."
   | IntroAction (IntroInjection l) ->
       error "Injection patterns not allowed for inversion equations."
-  | IntroAction (IntroOrAndPattern l) ->
+  | IntroAction (IntroOrAndPattern (IntroOrPattern _)) ->
       error "Disjunctive patterns not allowed for inversion equations."
   | IntroAction (IntroApplyOn (c,pat)) ->
       error "Apply patterns not allowed for inversion equations."
@@ -338,7 +337,7 @@ let projectAndApply as_mode thin avoid id eqname names depids =
       (if thin then clear [id] else (remember_first_eq id eqname; tclIDTAC))
   in
   let substHypIfVariable tac id =
-    Proofview.Goal.nf_enter begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
     (** 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
@@ -346,7 +345,7 @@ let projectAndApply as_mode thin avoid id eqname names depids =
     | 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);
@@ -373,7 +372,7 @@ let projectAndApply as_mode thin avoid id eqname names depids =
     id
 
 let nLastDecls i tac =
-  Proofview.Goal.nf_enter (fun gl -> tac (nLastDecls gl i))
+  Proofview.Goal.nf_enter { enter = begin fun gl -> tac (nLastDecls gl i) end }
 
 (* Introduction of the equations on arguments
    othin: discriminates Simple Inversion, Inversion and Inversion_clear
@@ -381,10 +380,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 begin fun gl ->
+  Proofview.Goal.nf_enter { 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 pi1 nodepids else [] in
+  let avoid = if as_mode then List.map get_id nodepids else [] in
   match othin with
     | Some thin ->
         tclTHENLIST
@@ -399,11 +398,11 @@ let rewrite_equations as_mode othin neqns names ba =
 		 (onLastHypId (fun id ->
 		   tclTRY (projectAndApply as_mode thin avoid id first_eq names depids)))))
 	       names;
-	     tclMAP (fun (id,_,_) -> tclIDTAC >>= fun () -> (* delay for [first_eq]. *)
-               let idopt = if as_mode then Some id else None in
+	     tclMAP (fun d -> tclIDTAC >>= fun () -> (* delay for [first_eq]. *)
+               let idopt = if as_mode then Some (get_id d) else None in
 	       intro_move idopt (if thin then MoveLast else !first_eq))
 	       nodepids;
-	     (tclMAP (fun (id,_,_) -> tclTRY (clear [id])) depids)]
+	     (tclMAP (fun d -> tclTRY (clear [get_id d])) depids)]
     | None ->
         (* simple inversion *)
         if as_mode then
@@ -414,7 +413,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
@@ -431,8 +430,9 @@ let rewrite_equations_tac as_mode othin id neqns names ba =
     tac
 
 let raw_inversion inv_kind id status names =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_s_enter { s_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
@@ -440,7 +440,7 @@ let raw_inversion inv_kind id status names =
       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
-        Errors.errorlabstrm "" msg
+        CErrors.errorlabstrm "" msg
     in
     let IndType (indf,realargs) = find_rectype env sigma t in
     let evdref = ref sigma in
@@ -457,19 +457,21 @@ let raw_inversion inv_kind id status names =
     in
     let refined id =
       let prf = mkApp (mkVar id, args) in
-      Proofview.Refine.refine (fun h -> h, prf)
+      Refine.refine { run = fun h -> Sigma (prf, h, Sigma.refl) }
     in
     let neqns = List.length realargs in
     let as_mode = names != None in
-    tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    let tac =
       (tclTHENS
         (assert_before Anonymous cut_concl)
         [case_tac names
-            (introCaseAssumsThen
+            (introCaseAssumsThen false (* ApplyOn not supported by inversion *)
                (rewrite_equations_tac as_mode inv_kind id neqns))
             (Some elim_predicate) ind (c, t);
         onLastHypId (fun id -> tclTHEN (refined id) reflexivity)])
-  end
+    in
+    Sigma.Unsafe.of_pair (tac, sigma)
+  end }
 
 (* Error messages of the inversion tactics *)
 let wrap_inv_error id = function (e, info) -> match e with
@@ -511,12 +513,12 @@ 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 begin fun gl ->
+  Proofview.Goal.nf_enter { 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 intros_replace_ids =
-      Proofview.Goal.enter begin fun gl ->
+      Proofview.Goal.enter { enter = begin fun gl ->
         let concl = pf_nf_concl gl in
         let nb_of_new_hyp =
           nb_prod concl - (List.length hyps + nb_prod_init)
@@ -525,7 +527,7 @@ let invIn k names ids id =
           intros_replacing ids
         else
           tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids)
-      end
+      end }
     in
     Proofview.tclORELSE
       (tclTHENLIST
@@ -533,7 +535,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/leminv.ml b/tactics/leminv.ml
index 894d4474..40b600c8 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -7,14 +7,13 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Vars
 open Termops
 open Namegen
-open Context
 open Evd
 open Printer
 open Reductionops
@@ -27,6 +26,8 @@ open Declare
 open Tacticals.New
 open Tactics
 open Decl_kinds
+open Proofview.Notations
+open Context.Named.Declaration
 
 let no_inductive_inconstr env sigma constr =
   (str "Cannot recognize an inductive predicate in " ++
@@ -113,15 +114,15 @@ 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_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
     | Prod (na,c1,b) ->
 	let id = id_of_name_using_hdchar env t na in
 	let b'= subst1 (mkVar id) b in
-        add_prods_sign (push_named (id,None,c1) env) sigma b'
+        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 b'= subst1 (mkVar id) b in
-        add_prods_sign (push_named (id,Some c1,t1) env) sigma b'
+        add_prods_sign (push_named (LocalDef (id,c1,t1)) env) sigma b'
     | _ -> (env,t)
 
 (* [dep_option] indicates whether the inversion lemma is dependent or not.
@@ -154,9 +155,10 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let ivars = global_vars env i in
       let revargs,ownsign =
 	fold_named_context
-	  (fun env (id,_,_ as d) (revargs,hyps) ->
+	  (fun env d (revargs,hyps) ->
+             let id = get_id d in
              if Id.List.mem id ivars then
-	       ((mkVar id)::revargs,add_named_decl d hyps)
+	       ((mkVar id)::revargs, Context.Named.add d hyps)
 	     else
 	       (revargs,hyps))
           env ~init:([],[])
@@ -165,8 +167,8 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let goal = mkArrow i (applist(mkVar p, List.rev revargs)) in
       (pty,goal)
   in
-  let npty = nf_betadeltaiota env sigma pty in
-  let extenv = push_named (p,None,npty) env in
+  let npty = nf_all env sigma pty in
+  let extenv = push_named (LocalAssum (p,npty)) env in
   extenv, goal
 
 (* [inversion_scheme sign I]
@@ -200,13 +202,13 @@ let inversion_scheme env sigma t sort dep_option inv_op =
       tclTHEN intro (onLastHypId inv_op)) pf)
   in
   let pfterm = List.hd (Proof.partial_proof pf) in
-  let global_named_context = Global.named_context () in
+  let global_named_context = Global.named_context_val () in
   let ownSign = ref begin
     fold_named_context
-      (fun env (id,_,_ as d) sign ->
-         if mem_named_context id global_named_context then sign
-	 else add_named_decl d sign)
-      invEnv ~init:empty_named_context
+      (fun env d sign ->
+         if mem_named_context_val (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
@@ -217,9 +219,9 @@ let inversion_scheme env sigma t sort dep_option inv_op =
 	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;
-	ownSign := add_named_decl (h,None,ty) !ownSign;
+	ownSign := Context.Named.add (LocalAssum (h,ty)) !ownSign;
 	applist (mkVar h, inst)
-    | _ -> map_constr fill_holes c
+    | _ -> Constr.map fill_holes c
   in
   let c = fill_holes pfterm in
   (* warning: side-effect on ownSign *)
@@ -269,7 +271,7 @@ let lemInv id c gls =
 let lemInv_gen id c = try_intros_until (fun id -> Proofview.V82.tactic (lemInv id c)) id
 
 let lemInvIn id c ids =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { 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
@@ -281,7 +283,7 @@ let lemInvIn id c ids =
     in
     ((tclTHEN (tclTHEN (bring_hyps hyps) (Proofview.V82.tactic (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/rewrite.ml b/tactics/rewrite.ml
deleted file mode 100644
index 74bb6d59..00000000
--- a/tactics/rewrite.ml
+++ /dev/null
@@ -1,2148 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Names
-open Pp
-open Errors
-open Util
-open Nameops
-open Namegen
-open Term
-open Vars
-open Reduction
-open Tacticals
-open Tacmach
-open Tactics
-open Pretype_errors
-open Typeclasses
-open Classes
-open Constrexpr
-open Globnames
-open Evd
-open Misctypes
-open Locus
-open Locusops
-open Decl_kinds
-open Elimschemes
-open Environ
-open Termops
-open Libnames
-
-(** Typeclass-based generalized rewriting. *)
-
-(** Constants used by the tactic. *)
-
-let classes_dirpath =
-  Names.DirPath.make (List.map Id.of_string ["Classes";"Coq"])
-
-let init_setoid () =
-  if is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then ()
-  else Coqlib.check_required_library ["Coq";"Setoids";"Setoid"]
-
-let make_dir l = DirPath.make (List.rev_map Id.of_string l)
-
-let try_find_global_reference dir s =
-  let sp = Libnames.make_path (make_dir ("Coq"::dir)) (Id.of_string s) in
-    try Nametab.global_of_path sp
-    with Not_found -> 
-      anomaly (str "Global reference " ++ str s ++ str " not found in generalized rewriting")
-
-let find_reference dir s =
-  let gr = lazy (try_find_global_reference dir s) in
-    fun () -> Lazy.force gr
-
-type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
-
-let find_global dir s =
-  let gr = lazy (try_find_global_reference dir s) in
-    fun (evd,cstrs) -> 
-      let evd, c = Evarutil.new_global evd (Lazy.force gr) in
-	(evd, cstrs), c
-
-(** Utility for dealing with polymorphic applications *)
-
-(** Global constants. *)
-
-let coq_eq_ref = find_reference ["Init"; "Logic"] "eq"
-let coq_eq = find_global ["Init"; "Logic"] "eq"
-let coq_f_equal = find_global ["Init"; "Logic"] "f_equal"
-let coq_all = find_global ["Init"; "Logic"] "all"
-let impl = find_global ["Program"; "Basics"] "impl"
-
-(** Bookkeeping which evars are constraints so that we can 
-    remove them at the end of the tactic. *)
-
-let goalevars evars = fst evars
-let cstrevars evars = snd evars
-
-let new_cstr_evar (evd,cstrs) env t =
-  let s = Typeclasses.set_resolvable Evd.Store.empty false in
-  let evd', t = Evarutil.new_evar ~store:s env evd t in
-  let ev, _ = destEvar t in
-    (evd', Evar.Set.add ev cstrs), t
-
-(** Building or looking up instances. *)
-let e_new_cstr_evar env evars t =
-  let evd', t = new_cstr_evar !evars env t in evars := evd'; t
-
-(** Building or looking up instances. *)
-
-let extends_undefined evars evars' =
-  let f ev evi found = found || not (Evd.mem evars ev)
-  in fold_undefined f evars' false
-
-let app_poly_check env evars f args =
-  let (evars, cstrs), fc = f evars in
-  let evdref = ref evars in 
-  let t = Typing.solve_evars env evdref (mkApp (fc, args)) in
-    (!evdref, cstrs), t
-
-let app_poly_nocheck env evars f args =
-  let evars, fc = f evars in 
-    evars, mkApp (fc, args)
-
-let app_poly_sort b =
-  if b then app_poly_nocheck
-  else app_poly_check
-    
-let find_class_proof proof_type proof_method env evars carrier relation =
-  try
-    let evars, goal = app_poly_check env evars proof_type [| carrier ; relation |] in
-    let evars', c = Typeclasses.resolve_one_typeclass env (goalevars evars) goal in
-      if extends_undefined (goalevars evars) evars' then raise Not_found
-      else app_poly_check env (evars',cstrevars evars) proof_method [| carrier; relation; c |]
-  with e when Logic.catchable_exception e -> raise Not_found
- 
-(** Utility functions *)
-
-module GlobalBindings (M : sig
-  val relation_classes : string list
-  val morphisms : string list
-  val relation : string list * string
-  val app_poly : env -> evars -> (evars -> evars * constr) -> constr array -> evars * constr
-  val arrow : evars -> evars * constr
-end) = struct
-  open M
-  let relation : evars -> evars * constr = find_global (fst relation) (snd relation)
-
-  let reflexive_type = find_global relation_classes "Reflexive"
-  let reflexive_proof = find_global relation_classes "reflexivity"
-    
-  let symmetric_type = find_global relation_classes "Symmetric"
-  let symmetric_proof = find_global relation_classes "symmetry"
-
-  let transitive_type = find_global relation_classes "Transitive"
-  let transitive_proof = find_global relation_classes "transitivity"
-
-  let forall_relation = find_global morphisms "forall_relation"
-  let pointwise_relation = find_global morphisms "pointwise_relation"
-
-  let forall_relation_ref = find_reference morphisms "forall_relation"
-  let pointwise_relation_ref = find_reference morphisms "pointwise_relation"
-
-  let respectful = find_global morphisms "respectful"
-  let respectful_ref = find_reference morphisms "respectful"
-
-  let default_relation = find_global ["Classes"; "SetoidTactics"] "DefaultRelation"
-
-  let coq_forall = find_global morphisms "forall_def"
-
-  let subrelation = find_global relation_classes "subrelation"
-  let do_subrelation = find_global morphisms "do_subrelation"
-  let apply_subrelation = find_global morphisms "apply_subrelation"
-
-  let rewrite_relation_class = find_global relation_classes "RewriteRelation"
-
-  let proper_class = lazy (class_info (try_find_global_reference morphisms "Proper"))
-  let proper_proxy_class = lazy (class_info (try_find_global_reference morphisms "ProperProxy"))
-    
-  let proper_proj = lazy (mkConst (Option.get (pi3 (List.hd (Lazy.force proper_class).cl_projs))))
-    
-  let proper_type = 
-    let l = lazy (Lazy.force proper_class).cl_impl in
-      fun (evd,cstrs) -> 
-	let evd, c = Evarutil.new_global evd (Lazy.force l) in
-	  (evd, cstrs), c
-	
-  let proper_proxy_type = 
-    let l = lazy (Lazy.force proper_proxy_class).cl_impl in
-      fun (evd,cstrs) -> 
-	let evd, c = Evarutil.new_global evd (Lazy.force l) in
-	  (evd, cstrs), c
-
-  let proper_proof env evars carrier relation x =
-    let evars, goal = app_poly env evars proper_proxy_type [| carrier ; relation; x |] in
-      new_cstr_evar evars env goal
-
-  let get_reflexive_proof env = find_class_proof reflexive_type reflexive_proof env
-  let get_symmetric_proof env = find_class_proof symmetric_type symmetric_proof env
-  let get_transitive_proof env = find_class_proof transitive_type transitive_proof env
-
-  let mk_relation env evd a = 
-    app_poly env evd relation [| a |]
-
-  (** Build an infered signature from constraints on the arguments and expected output
-      relation *)
-    
-  let build_signature evars env m (cstrs : (types * types option) option list)
-      (finalcstr : (types * types option) option) =
-    let mk_relty evars newenv ty obj =
-      match obj with
-      | None | Some (_, None) ->
-	let evars, relty = mk_relation env evars ty in
-	  if closed0 ty then 
-	    let env' = Environ.reset_with_named_context (Environ.named_context_val env) env in
-	      new_cstr_evar evars env' relty
-	  else new_cstr_evar evars newenv relty
-      | Some (x, Some rel) -> evars, rel
-    in
-    let rec aux env evars ty l =
-      let t = Reductionops.whd_betadeltaiota env (goalevars evars) ty in
-	match kind_of_term t, l with
-	| Prod (na, ty, b), obj :: cstrs ->
-          let b = Reductionops.nf_betaiota (goalevars evars) b in
-	  if noccurn 1 b (* non-dependent product *) then
-	    let ty = Reductionops.nf_betaiota (goalevars evars) ty in
-	    let (evars, b', arg, cstrs) = aux env evars (subst1 mkProp b) cstrs in
-	    let evars, relty = mk_relty evars env ty obj in
-	    let evars, newarg = app_poly env evars respectful [| ty ; b' ; relty ; arg |] in
-	      evars, mkProd(na, ty, b), newarg, (ty, Some relty) :: cstrs
-	  else
-	    let (evars, b, arg, cstrs) = 
-	      aux (Environ.push_rel (na, None, ty) env) evars b cstrs 
-	    in
-	    let ty = Reductionops.nf_betaiota (goalevars evars) ty in
-	    let pred = mkLambda (na, ty, b) in
-	    let liftarg = mkLambda (na, ty, arg) in
-	    let evars, arg' = app_poly env evars forall_relation [| ty ; pred ; liftarg |] in
-	      if Option.is_empty obj then evars, mkProd(na, ty, b), arg', (ty, None) :: cstrs
-	      else error "build_signature: no constraint can apply on a dependent argument"
-	| _, obj :: _ -> anomaly ~label:"build_signature" (Pp.str "not enough products")
-	| _, [] ->
-	  (match finalcstr with
-	  | None | Some (_, None) ->
-	    let t = Reductionops.nf_betaiota (fst evars) ty in
-	    let evars, rel = mk_relty evars env t None in
-	      evars, t, rel, [t, Some rel]
-	  | Some (t, Some rel) -> evars, t, rel, [t, Some rel])
-    in aux env evars m cstrs
-
-  (** Folding/unfolding of the tactic constants. *)
-
-  let unfold_impl t =
-    match kind_of_term t with
-    | App (arrow, [| a; b |])(*  when eq_constr arrow (Lazy.force impl) *) ->
-      mkProd (Anonymous, a, lift 1 b)
-    | _ -> assert false
-
-  let unfold_all t =
-    match kind_of_term t with
-    | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_all) *) ->
-      (match kind_of_term b with
-      | Lambda (n, ty, b) -> mkProd (n, ty, b)
-      | _ -> assert false)
-    | _ -> assert false
-
-  let unfold_forall t =
-    match kind_of_term t with
-    | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_all) *) ->
-      (match kind_of_term b with
-      | Lambda (n, ty, b) -> mkProd (n, ty, b)
-      | _ -> assert false)
-    | _ -> assert false
-
-  let arrow_morphism env evd ta tb a b =
-    let ap = is_Prop ta and bp = is_Prop tb in
-      if ap && bp then app_poly env evd impl [| a; b |], unfold_impl
-      else if ap then (* Domain in Prop, CoDomain in Type *)
-	(app_poly env evd arrow [| a; b |]), unfold_impl
-	(* (evd, mkProd (Anonymous, a, b)), (fun x -> x) *)
-      else if bp then (* Dummy forall *)
-	(app_poly env evd coq_all [| a; mkLambda (Anonymous, a, lift 1 b) |]), unfold_forall
-      else (* None in Prop, use arrow *)
-	(app_poly env evd arrow [| a; b |]), unfold_impl
-
-  let rec decomp_pointwise n c =
-    if Int.equal n 0 then c
-    else
-      match kind_of_term c with
-      | App (f, [| a; b; relb |]) when Globnames.is_global (pointwise_relation_ref ()) f ->
-	decomp_pointwise (pred n) relb
-      | App (f, [| a; b; arelb |]) when Globnames.is_global (forall_relation_ref ()) f ->
-	decomp_pointwise (pred n) (Reductionops.beta_applist (arelb, [mkRel 1]))
-      | _ -> invalid_arg "decomp_pointwise"
-
-  let rec apply_pointwise rel = function
-    | arg :: args ->
-      (match kind_of_term rel with
-      | App (f, [| a; b; relb |]) when Globnames.is_global (pointwise_relation_ref ()) f ->
-	apply_pointwise relb args
-      | App (f, [| a; b; arelb |]) when Globnames.is_global (forall_relation_ref ()) f ->
-	apply_pointwise (Reductionops.beta_applist (arelb, [arg])) args
-      | _ -> invalid_arg "apply_pointwise")
-    | [] -> rel
-
-  let pointwise_or_dep_relation env evd n t car rel =
-    if noccurn 1 car && noccurn 1 rel then
-      app_poly env evd pointwise_relation [| t; lift (-1) car; lift (-1) rel |]
-    else
-      app_poly env evd forall_relation
-	[| t; mkLambda (n, t, car); mkLambda (n, t, rel) |]
-
-  let lift_cstr env evars (args : constr list) c ty cstr =
-    let start evars env car =
-      match cstr with
-      | None | Some (_, None) -> 
-	let evars, rel = mk_relation env evars car in
-	  new_cstr_evar evars env rel
-      | Some (ty, Some rel) -> evars, rel
-    in
-    let rec aux evars env prod n = 
-      if Int.equal n 0 then start evars env prod
-      else
-	match kind_of_term (Reduction.whd_betadeltaiota env prod) with
-	| Prod (na, ty, b) ->
-	  if noccurn 1 b then
-	    let b' = lift (-1) b in
-	    let evars, rb = aux evars env b' (pred n) in
-	      app_poly env evars pointwise_relation [| ty; b'; rb |]
-	  else
-	    let evars, rb = aux evars (Environ.push_rel (na, None, ty) env) b (pred n) in
-	      app_poly env evars forall_relation
-		[| ty; mkLambda (na, ty, b); mkLambda (na, ty, rb) |]
-	| _ -> raise Not_found
-    in 
-    let rec find env c ty = function
-      | [] -> None
-      | arg :: args ->
-	try let evars, found = aux evars env ty (succ (List.length args)) in
-	      Some (evars, found, c, ty, arg :: args)
-	with Not_found ->
-	  let ty = whd_betadeltaiota env ty in
-	  find env (mkApp (c, [| arg |])) (prod_applist ty [arg]) args
-    in find env c ty args
-
-  let unlift_cstr env sigma = function
-    | None -> None
-    | Some codom -> Some (decomp_pointwise 1 codom)
-
-  (** Looking up declared rewrite relations (instances of [RewriteRelation]) *)
-  let is_applied_rewrite_relation env sigma rels t =
-    match kind_of_term t with
-    | App (c, args) when Array.length args >= 2 ->
-      let head = if isApp c then fst (destApp c) else c in
-	if Globnames.is_global (coq_eq_ref ()) head then None
-	else
-	  (try
-	   let params, args = Array.chop (Array.length args - 2) args in
-	   let env' = Environ.push_rel_context rels env in
-	   let evars, (evar, _) = Evarutil.new_type_evar env' sigma Evd.univ_flexible in
-	   let evars, inst = 
-	     app_poly env (evars,Evar.Set.empty)
-	       rewrite_relation_class [| evar; mkApp (c, params) |] in
-	   let _ = Typeclasses.resolve_one_typeclass env' (goalevars evars) inst in
-	     Some (it_mkProd_or_LetIn t rels)
-	   with e when Errors.noncritical e -> None)
-  | _ -> None
-
-
-end
-
-(* let my_type_of env evars c = Typing.e_type_of env evars c *)
-(* let mytypeofkey = Profile.declare_profile "my_type_of";; *)
-(* let my_type_of = Profile.profile3 mytypeofkey my_type_of *)
-
-
-let type_app_poly env env evd f args =
-  let evars, c = app_poly_nocheck env evd f args in
-  let evd', t = Typing.type_of env (goalevars evars) c in
-    (evd', cstrevars evars), c
-
-module PropGlobal = struct
-  module Consts =
-  struct 
-    let relation_classes = ["Classes"; "RelationClasses"]
-    let morphisms = ["Classes"; "Morphisms"]
-    let relation = ["Relations";"Relation_Definitions"], "relation"
-    let app_poly = app_poly_nocheck
-    let arrow = find_global ["Program"; "Basics"] "arrow"
-    let coq_inverse = find_global ["Program"; "Basics"] "flip"
-  end
-
-  module G = GlobalBindings(Consts)
-
-  include G
-  include Consts
-  let inverse env evd car rel = 
-    type_app_poly env env evd coq_inverse [| car ; car; mkProp; rel |]
-      (* app_poly env evd coq_inverse [| car ; car; mkProp; rel |] *)
-
-end
-
-module TypeGlobal = struct
-  module Consts = 
-    struct 
-      let relation_classes = ["Classes"; "CRelationClasses"]
-      let morphisms = ["Classes"; "CMorphisms"]
-      let relation = relation_classes, "crelation"
-      let app_poly = app_poly_check
-      let arrow = find_global ["Classes"; "CRelationClasses"] "arrow"
-      let coq_inverse = find_global ["Classes"; "CRelationClasses"] "flip"
-    end
-
-  module G = GlobalBindings(Consts)
-  include G
-  include Consts
-
-
-  let inverse env (evd,cstrs) car rel = 
-    let evd, sort = Evarutil.new_Type ~rigid:Evd.univ_flexible env evd in
-      app_poly_check env (evd,cstrs) coq_inverse [| car ; car; sort; rel |]
-
-end
-
-let sort_of_rel env evm rel =
-  Reductionops.sort_of_arity env evm (Retyping.get_type_of env evm rel)
-
-let is_applied_rewrite_relation = PropGlobal.is_applied_rewrite_relation
-
-(* let _ = *)
-(*   Hook.set Equality.is_applied_rewrite_relation is_applied_rewrite_relation *)
-
-let split_head = function
-    hd :: tl -> hd, tl
-  | [] -> assert(false)
-
-let evd_convertible env evd x y =
-  try
-    let evd = Evarconv.the_conv_x env x y evd in
-    (* Unfortunately, the_conv_x might say they are unifiable even if some
-        unsolvable constraints remain, so we check them here *)
-    let evd = Evarconv.consider_remaining_unif_problems env evd in
-    let () = Evarconv.check_problems_are_solved env evd in
-    Some evd
-  with e when Errors.noncritical e -> None
-
-let convertible env evd x y =
-  Reductionops.is_conv_leq env evd x y
-
-type hypinfo = {
-  prf : constr;
-  car : constr;
-  rel : constr;
-  sort : bool; (* true = Prop; false = Type *)
-  c1 : constr;
-  c2 : constr;
-  holes : Clenv.hole list;
-}
-
-let get_symmetric_proof b = 
-  if b then PropGlobal.get_symmetric_proof else TypeGlobal.get_symmetric_proof
-
-let rec decompose_app_rel env evd t = 
-  (** Head normalize for compatibility with the old meta mechanism *)
-  let t = Reductionops.whd_betaiota evd t in
-  match kind_of_term t with
-  | App (f, [||]) -> assert false
-  | App (f, [|arg|]) ->
-    let (f', argl, argr) = decompose_app_rel env evd arg in
-    let ty = Typing.unsafe_type_of env evd argl in
-    let f'' = mkLambda (Name default_dependent_ident, ty,
-      mkLambda (Name (Id.of_string "y"), lift 1 ty,
-        mkApp (lift 2 f, [| mkApp (lift 2 f', [| mkRel 2; mkRel 1 |]) |])))
-    in (f'', argl, argr)
-  | App (f, args) ->
-    let len = Array.length args in
-    let fargs = Array.sub args 0 (Array.length args - 2) in
-    mkApp (f, fargs), args.(len - 2), args.(len - 1)
-  | _ -> error "Cannot find a relation to rewrite."
-
-let decompose_applied_relation env sigma (c,l) =
-  let ctype = Retyping.get_type_of env sigma c in
-  let find_rel ty =
-    let sigma, cl = Clenv.make_evar_clause env sigma ty in
-    let sigma = Clenv.solve_evar_clause env sigma true cl l in
-    let { Clenv.cl_holes = holes; Clenv.cl_concl = t } = cl in
-    let (equiv, c1, c2) = decompose_app_rel env sigma t in
-    let ty1 = Retyping.get_type_of env sigma c1 in
-    let ty2 = Retyping.get_type_of env sigma c2 in
-    match evd_convertible env sigma ty1 ty2 with
-    | None -> None
-    | Some sigma ->
-      let sort = sort_of_rel env sigma equiv in
-      let args = Array.map_of_list (fun h -> h.Clenv.hole_evar) holes in
-      let value = mkApp (c, args) in
-        Some (sigma, { prf=value;
-                car=ty1; rel = equiv; sort = Sorts.is_prop sort;
-                c1=c1; c2=c2; holes })
-  in
-    match find_rel ctype with
-    | Some c -> c
-    | None ->
-	let ctx,t' = Reductionops.splay_prod env sigma ctype in (* Search for underlying eq *)
-	match find_rel (it_mkProd_or_LetIn t' (List.map (fun (n,t) -> n, None, t) ctx)) with
-	| Some c -> c
-	| None -> error "Cannot find an homogeneous relation to rewrite."
-
-let rewrite_db = "rewrite"
-
-let conv_transparent_state = (Id.Pred.empty, Cpred.full)
-
-let _ = 
-  Hints.add_hints_init
-    (fun () ->
-       Hints.create_hint_db false rewrite_db conv_transparent_state true)
-
-let rewrite_transparent_state () =
-  Hints.Hint_db.transparent_state (Hints.searchtable_map rewrite_db)
-
-let rewrite_core_unif_flags = {
-  Unification.modulo_conv_on_closed_terms = None;
-  Unification.use_metas_eagerly_in_conv_on_closed_terms = true;
-  Unification.use_evars_eagerly_in_conv_on_closed_terms = true;
-  Unification.modulo_delta = empty_transparent_state;
-  Unification.modulo_delta_types = full_transparent_state;
-  Unification.check_applied_meta_types = true;
-  Unification.use_pattern_unification = true;
-  Unification.use_meta_bound_pattern_unification = true;
-  Unification.frozen_evars = Evar.Set.empty;
-  Unification.restrict_conv_on_strict_subterms = false;
-  Unification.modulo_betaiota = false;
-  Unification.modulo_eta = true;
-}
-
-(* Flags used for the setoid variant of "rewrite" and for the strategies
-   "hints"/"old_hints"/"terms" of "rewrite_strat", and for solving pre-existing
-   evars in "rewrite" (see unify_abs) *)
-let rewrite_unif_flags =
-  let flags = rewrite_core_unif_flags in {
-  Unification.core_unify_flags = flags;
-  Unification.merge_unify_flags = flags;
-  Unification.subterm_unify_flags = flags;
-  Unification.allow_K_in_toplevel_higher_order_unification = true;
-  Unification.resolve_evars = true
-  }
-
-let rewrite_core_conv_unif_flags = {
-  rewrite_core_unif_flags with
-    Unification.modulo_conv_on_closed_terms = Some conv_transparent_state;
-    Unification.modulo_delta_types = conv_transparent_state;
-    Unification.modulo_betaiota = true
-}
-
-(* Fallback flags for the setoid variant of "rewrite" *)
-let rewrite_conv_unif_flags =
-  let flags = rewrite_core_conv_unif_flags in {
-  Unification.core_unify_flags = flags;
-  Unification.merge_unify_flags = flags;
-  Unification.subterm_unify_flags = flags;
-  Unification.allow_K_in_toplevel_higher_order_unification = true;
-  Unification.resolve_evars = true
-  }
-
-(* Flags for "setoid_rewrite c"/"rewrite_strat -> c" *)
-let general_rewrite_unif_flags () =
-  let ts = rewrite_transparent_state () in
-  let core_flags =
-    { rewrite_core_unif_flags with
-      Unification.modulo_conv_on_closed_terms = Some ts;
-      Unification.use_evars_eagerly_in_conv_on_closed_terms = false;
-      Unification.modulo_delta = ts;
-      Unification.modulo_delta_types = ts;
-      Unification.modulo_betaiota = true }
-  in {
-    Unification.core_unify_flags = core_flags;
-    Unification.merge_unify_flags = core_flags;
-    Unification.subterm_unify_flags = { core_flags with Unification.modulo_delta = empty_transparent_state };
-    Unification.allow_K_in_toplevel_higher_order_unification = true;
-    Unification.resolve_evars = true
-  }
-
-let refresh_hypinfo env sigma (is, cb) =
-  let sigma, cbl = Tacinterp.interp_open_constr_with_bindings is env sigma cb in
-  let sigma, hypinfo = decompose_applied_relation env sigma cbl in
-  let { c1; c2; car; rel; prf; sort; holes } = hypinfo in
-  sigma, (car, rel, prf, c1, c2, holes, sort)
-
-(** FIXME: write this in the new monad interface *)
-let solve_remaining_by env sigma holes by =
-  match by with
-  | None -> sigma
-  | Some tac ->
-    let map h =
-      if h.Clenv.hole_deps then None
-      else
-        let (evk, _) = destEvar (h.Clenv.hole_evar) in
-        Some evk
-    in
-    (** Only solve independent holes *)
-    let indep = List.map_filter map holes in
-    let solve_tac = Tacticals.New.tclCOMPLETE (Tacinterp.eval_tactic tac) in
-    let solve sigma evk =
-      let evi =
-        try Some (Evd.find_undefined sigma evk)
-        with Not_found -> None
-      in
-      match evi with
-      | None -> sigma
-        (** Evar should not be defined, but just in case *)
-      | Some evi ->
-        let env = Environ.reset_with_named_context evi.evar_hyps env in
-        let ty = evi.evar_concl in
-        let c, sigma = Pfedit.refine_by_tactic env sigma ty solve_tac in
-        Evd.define evk c sigma
-    in
-    List.fold_left solve sigma indep
-
-let no_constraints cstrs = 
-  fun ev _ -> not (Evar.Set.mem ev cstrs)
-
-let all_constraints cstrs = 
-  fun ev _ -> Evar.Set.mem ev cstrs
-
-let poly_inverse sort =
-  if sort then PropGlobal.inverse else TypeGlobal.inverse
-
-type rewrite_proof = 
-  | RewPrf of constr * constr
-  (** A Relation (R : rew_car -> rew_car -> Prop) and a proof of R rew_from rew_to *)
-  | RewCast of cast_kind
-  (** A proof of convertibility (with casts) *)
-
-type rewrite_result_info = {
-  rew_car : constr ;
-  (** A type *)
-  rew_from : constr ;
-  (** A term of type rew_car *)
-  rew_to : constr ;
-  (** A term of type rew_car *)
-  rew_prf : rewrite_proof ;
-  (** A proof of rew_from == rew_to *)
-  rew_evars : evars;
-}
-
-type rewrite_result =
-| Fail
-| Identity
-| Success of rewrite_result_info
-
-type 'a strategy_input = { state : 'a ; (* a parameter: for instance, a state *)
-			   env : Environ.env ;
-			   unfresh : Id.t list ; (* Unfresh names *)
-			   term1 : constr ;
-			   ty1 : types ; (* first term and its type (convertible to rew_from) *)
-			   cstr : (bool (* prop *) * constr option) ;
-			   evars : evars }
-	       
-type 'a pure_strategy = { strategy :
-  'a strategy_input ->
-  'a * rewrite_result (* the updated state and the "result" *) }
-
-type strategy = unit pure_strategy
-
-let symmetry env sort rew =
-  let { rew_evars = evars; rew_car = car; } = rew in
-  let (rew_evars, rew_prf) = match rew.rew_prf with
-  | RewCast _ -> (rew.rew_evars, rew.rew_prf)
-  | RewPrf (rel, prf) ->
-    try
-      let evars, symprf = get_symmetric_proof sort env evars car rel in
-      let prf = mkApp (symprf, [| rew.rew_from ; rew.rew_to ; prf |]) in
-      (evars, RewPrf (rel, prf))
-    with Not_found ->
-      let evars, rel = poly_inverse sort env evars car rel in
-      (evars, RewPrf (rel, prf))
-  in
-  { rew with rew_from = rew.rew_to; rew_to = rew.rew_from; rew_prf; rew_evars; }
-
-(* Matching/unifying the rewriting rule against [t] *)
-let unify_eqn (car, rel, prf, c1, c2, holes, sort) l2r flags env (sigma, cstrs) by t =
-  try
-    let left = if l2r then c1 else c2 in
-    let sigma = Unification.w_unify ~flags env sigma CONV left t in
-    let sigma = Typeclasses.resolve_typeclasses ~filter:(no_constraints cstrs)
-      ~fail:true env sigma in
-    let evd = solve_remaining_by env sigma holes by in
-    let nf c = Evarutil.nf_evar evd (Reductionops.nf_meta evd c) in
-    let c1 = nf c1 and c2 = nf c2
-    and rew_car = nf car and rel = nf rel
-    and prf = nf prf in
-    let ty1 = Retyping.get_type_of env evd c1 in
-    let ty2 = Retyping.get_type_of env evd c2 in
-    let () = if not (convertible env evd ty2 ty1) then raise Reduction.NotConvertible in
-    let rew_evars = evd, cstrs in
-    let rew_prf = RewPrf (rel, prf) in
-    let rew = { rew_evars; rew_prf; rew_car; rew_from = c1; rew_to = c2; } in
-    let rew = if l2r then rew else symmetry env sort rew in
-    Some rew
-  with 
-  | e when Class_tactics.catchable e -> None
-  | Reduction.NotConvertible -> None
-
-let unify_abs (car, rel, prf, c1, c2) l2r sort env (sigma, cstrs) t =
-  try
-    let left = if l2r then c1 else c2 in
-    (* The pattern is already instantiated, so the next w_unify is
-       basically an eq_constr, except when preexisting evars occur in
-       either the lemma or the goal, in which case the eq_constr also
-       solved this evars *)
-    let sigma = Unification.w_unify ~flags:rewrite_unif_flags env sigma CONV left t in
-    let rew_evars = sigma, cstrs in
-    let rew_prf = RewPrf (rel, prf) in
-    let rew = { rew_car = car; rew_from = c1; rew_to = c2; rew_prf; rew_evars; } in
-    let rew = if l2r then rew else symmetry env sort rew in
-    Some rew
-  with 
-  | e when Class_tactics.catchable e -> None
-  | Reduction.NotConvertible -> None
-
-type rewrite_flags = { under_lambdas : bool; on_morphisms : bool }
-
-let default_flags = { under_lambdas = true; on_morphisms = true; }
-
-let get_opt_rew_rel = function RewPrf (rel, prf) -> Some rel | _ -> None
-
-let make_eq () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq ())
-let make_eq_refl () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq_refl ())
-
-let get_rew_prf r = match r.rew_prf with
-  | RewPrf (rel, prf) -> rel, prf 
-  | RewCast c ->
-    let rel = mkApp (make_eq (), [| r.rew_car |]) in
-      rel, mkCast (mkApp (make_eq_refl (), [| r.rew_car; r.rew_from |]),
-		   c, mkApp (rel, [| r.rew_from; r.rew_to |]))
-
-let poly_subrelation sort = 
-  if sort then PropGlobal.subrelation else TypeGlobal.subrelation
-
-let resolve_subrelation env avoid car rel sort prf rel' res =
-  if eq_constr rel rel' then res
-  else
-    let evars, app = app_poly_check env res.rew_evars (poly_subrelation sort) [|car; rel; rel'|] in
-    let evars, subrel = new_cstr_evar evars env app in
-    let appsub = mkApp (subrel, [| res.rew_from ; res.rew_to ; prf |]) in
-      { res with
-	rew_prf = RewPrf (rel', appsub);
-	rew_evars = evars }
-
-let resolve_morphism env avoid oldt m ?(fnewt=fun x -> x) args args' (b,cstr) evars =
-  let evars, morph_instance, proj, sigargs, m', args, args' =
-    let first = match (Array.findi (fun _ b -> not (Option.is_empty b)) args') with
-    | Some i -> i
-    | None -> invalid_arg "resolve_morphism" in
-    let morphargs, morphobjs = Array.chop first args in
-    let morphargs', morphobjs' = Array.chop first args' in
-    let appm = mkApp(m, morphargs) in
-    let appmtype = Typing.unsafe_type_of env (goalevars evars) appm in
-    let cstrs = List.map 
-      (Option.map (fun r -> r.rew_car, get_opt_rew_rel r.rew_prf)) 
-      (Array.to_list morphobjs') 
-    in
-      (* Desired signature *)
-    let evars, appmtype', signature, sigargs = 
-      if b then PropGlobal.build_signature evars env appmtype cstrs cstr
-      else TypeGlobal.build_signature evars env appmtype cstrs cstr
-    in
-      (* Actual signature found *)
-    let cl_args = [| appmtype' ; signature ; appm |] in
-    let evars, app = app_poly_sort b env evars (if b then PropGlobal.proper_type else TypeGlobal.proper_type)
-      cl_args in
-    let env' = 
-      let dosub, appsub = 
-	if b then PropGlobal.do_subrelation, PropGlobal.apply_subrelation 
-	else TypeGlobal.do_subrelation, TypeGlobal.apply_subrelation
-      in
-	Environ.push_named
-	  (Id.of_string "do_subrelation", 
-	   Some (snd (app_poly_sort b env evars dosub [||])), 
-	   snd (app_poly_nocheck env evars appsub [||]))
-	  env
-    in
-    let evars, morph = new_cstr_evar evars env' app in
-      evars, morph, morph, sigargs, appm, morphobjs, morphobjs'
-  in
-  let projargs, subst, evars, respars, typeargs =
-    Array.fold_left2
-      (fun (acc, subst, evars, sigargs, typeargs') x y ->
-	let (carrier, relation), sigargs = split_head sigargs in
-	  match relation with
-	  | Some relation ->
-	      let carrier = substl subst carrier
-	      and relation = substl subst relation in
-	      (match y with
-	      | None ->
-		  let evars, proof = 
-		    (if b then PropGlobal.proper_proof else TypeGlobal.proper_proof) 
-		      env evars carrier relation x in
-		    [ proof ; x ; x ] @ acc, subst, evars, sigargs, x :: typeargs'
-	      | Some r ->
-		  [ snd (get_rew_prf r); r.rew_to; x ] @ acc, subst, evars, 
-	      sigargs, r.rew_to :: typeargs')
-	  | None ->
-	      if not (Option.is_empty y) then 
-		error "Cannot rewrite inside dependent arguments of a function";
-	      x :: acc, x :: subst, evars, sigargs, x :: typeargs')
-      ([], [], evars, sigargs, []) args args'
-  in
-  let proof = applistc proj (List.rev projargs) in
-  let newt = applistc m' (List.rev typeargs) in
-    match respars with
-	[ a, Some r ] -> evars, proof, substl subst a, substl subst r, oldt, fnewt newt
-      | _ -> assert(false)
-
-let apply_constraint env avoid car rel prf cstr res =
-  match snd cstr with
-  | None -> res
-  | Some r -> resolve_subrelation env avoid car rel (fst cstr) prf r res
-
-let coerce env avoid cstr res = 
-  let rel, prf = get_rew_prf res in
-    apply_constraint env avoid res.rew_car rel prf cstr res
-
-let apply_rule unify loccs : int pure_strategy =
-  let (nowhere_except_in,occs) = convert_occs loccs in
-  let is_occ occ =
-    if nowhere_except_in 
-    then List.mem occ occs 
-    else not (List.mem occ occs) 
-  in
-  { strategy = fun { state = occ ; env ; unfresh ;
-		     term1 = t ; ty1 = ty ; cstr ; evars } ->
-      let unif = if isEvar t then None else unify env evars t in
-	match unif with
-	| None -> (occ, Fail)
-        | Some rew ->
-	  let occ = succ occ in
-	    if not (is_occ occ) then (occ, Fail)
-	    else if eq_constr t rew.rew_to then (occ, Identity)
-	    else
-	      let res = { rew with rew_car = ty } in
-              let rel, prf = get_rew_prf res in
-	      let res = Success (apply_constraint env unfresh rew.rew_car rel prf cstr res) in
-              (occ, res)
-    }
-
-let apply_lemma l2r flags oc by loccs : strategy = { strategy =
-  fun ({ state = () ; env ; term1 = t ; evars = (sigma, cstrs) } as input) ->
-    let sigma, c = oc sigma in
-    let sigma, hypinfo = decompose_applied_relation env sigma c in
-    let { c1; c2; car; rel; prf; sort; holes } = hypinfo in
-    let rew = (car, rel, prf, c1, c2, holes, sort) in
-    let evars = (sigma, cstrs) in
-    let unify env evars t =
-      let rew = unify_eqn rew l2r flags env evars by t in
-      match rew with
-      | None -> None
-      | Some rew -> Some rew
-    in
-    let _, res = (apply_rule unify loccs).strategy { input with
-						     state = 0 ;
-						     evars } in
-    (), res
-						   }
-
-let e_app_poly env evars f args =
-  let evars', c = app_poly_nocheck env !evars f args in
-    evars := evars';
-    c
-
-let make_leibniz_proof env c ty r =
-  let evars = ref r.rew_evars in
-  let prf = 
-    match r.rew_prf with
-    | RewPrf (rel, prf) -> 
-	let rel = e_app_poly env evars coq_eq [| ty |] in
-	let prf =
-	  e_app_poly env evars coq_f_equal
-		[| r.rew_car; ty;
-		   mkLambda (Anonymous, r.rew_car, c);
-		   r.rew_from; r.rew_to; prf |]
-	in RewPrf (rel, prf)
-    | RewCast k -> r.rew_prf
-  in
-    { rew_car = ty; rew_evars = !evars;
-      rew_from = subst1 r.rew_from c; rew_to = subst1 r.rew_to c; rew_prf = prf }
-
-let reset_env env =
-  let env' = Global.env_of_context (Environ.named_context_val env) in
-    Environ.push_rel_context (Environ.rel_context env) env'
-      
-let fold_match ?(force=false) env sigma c =
-  let (ci, p, c, brs) = destCase c in
-  let cty = Retyping.get_type_of env sigma c in
-  let dep, pred, exists, (sk,eff) = 
-    let env', ctx, body =
-      let ctx, pred = decompose_lam_assum p in
-      let env' = Environ.push_rel_context ctx env in
-	env', ctx, pred
-    in
-    let sortp = Retyping.get_sort_family_of env' sigma body in
-    let sortc = Retyping.get_sort_family_of env sigma cty in
-    let dep = not (noccurn 1 body) in
-    let pred = if dep then p else
-	it_mkProd_or_LetIn (subst1 mkProp body) (List.tl ctx)
-    in
-    let sk = 
-      if sortp == InProp then
-	if sortc == InProp then
-	  if dep then case_dep_scheme_kind_from_prop
-	  else case_scheme_kind_from_prop
-	else (
-	  if dep
-	  then case_dep_scheme_kind_from_type_in_prop
-	  else case_scheme_kind_from_type)
-      else ((* sortc <> InProp by typing *)
-	if dep
-	then case_dep_scheme_kind_from_type
-	else case_scheme_kind_from_type)
-    in 
-    let exists = Ind_tables.check_scheme sk ci.ci_ind in
-      if exists || force then
-	dep, pred, exists, Ind_tables.find_scheme sk ci.ci_ind
-      else raise Not_found
-  in
-  let app =
-    let ind, args = Inductive.find_rectype env cty in
-    let pars, args = List.chop ci.ci_npar args in
-    let meths = List.map (fun br -> br) (Array.to_list brs) in
-      applist (mkConst sk, pars @ [pred] @ meths @ args @ [c])
-  in 
-    sk, (if exists then env else reset_env env), app, eff
-
-let unfold_match env sigma sk app =
-  match kind_of_term app with
-  | App (f', args) when eq_constant (fst (destConst f')) sk ->
-      let v = Environ.constant_value_in (Global.env ()) (sk,Univ.Instance.empty)(*FIXME*) in
-	Reductionops.whd_beta sigma (mkApp (v, args))
-  | _ -> app
-
-let is_rew_cast = function RewCast _ -> true | _ -> false
-
-let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
-  let rec aux { state ; env ; unfresh ;
-		term1 = t ; ty1 = ty ; cstr = (prop, cstr) ; evars } =
-    let cstr' = Option.map (fun c -> (ty, Some c)) cstr in
-      match kind_of_term t with
-      | App (m, args) ->
-	  let rewrite_args state success =
-	    let state, (args', evars', progress) =
-	      Array.fold_left
-		(fun (state, (acc, evars, progress)) arg ->
-		  if not (Option.is_empty progress) && not all then 
-		    state, (None :: acc, evars, progress)
-		  else
-		    let argty = Retyping.get_type_of env (goalevars evars) arg in
-		    let state, res = s.strategy { state ; env ;
-						  unfresh ;
-						  term1 = arg ;	ty1 = argty ;
-						  cstr = (prop,None) ;
-						  evars } in
-		    let res' = 
-		      match res with
-		      | Identity ->
-			let progress = if Option.is_empty progress then Some false else progress in
-			  (None :: acc, evars, progress)
-		      | Success r -> 
-			(Some r :: acc, r.rew_evars, Some true)
-		      | Fail -> (None :: acc, evars, progress)
-		    in state, res')
-		(state, ([], evars, success)) args
-	    in
-	    let res = 
-	      match progress with
-	      | None -> Fail
-	      | Some false -> Identity
-	      | Some true ->
-		let args' = Array.of_list (List.rev args') in
-		  if Array.exists
-		    (function 
-		      | None -> false 
-		      | Some r -> not (is_rew_cast r.rew_prf)) args'
-		  then
-		    let evars', prf, car, rel, c1, c2 = 
-		      resolve_morphism env unfresh t m args args' (prop, cstr') evars' 
-		    in
-		    let res = { rew_car = ty; rew_from = c1;
-				rew_to = c2; rew_prf = RewPrf (rel, prf);
-				rew_evars = evars' } 
-		    in Success res
-		  else 
-		    let args' = Array.map2
-		      (fun aorig anew ->
-			match anew with None -> aorig
-			| Some r -> r.rew_to) args args' 
-		    in
-		    let res = { rew_car = ty; rew_from = t;
-				rew_to = mkApp (m, args'); rew_prf = RewCast DEFAULTcast;
-				rew_evars = evars' }
-		    in Success res
-	    in state, res
-	  in
-	    if flags.on_morphisms then
-	      let mty = Retyping.get_type_of env (goalevars evars) m in
-	      let evars, cstr', m, mty, argsl, args = 
-		let argsl = Array.to_list args in
-		let lift = if prop then PropGlobal.lift_cstr else TypeGlobal.lift_cstr in
-		  match lift env evars argsl m mty None with
-		  | Some (evars, cstr', m, mty, args) -> 
-		    evars, Some cstr', m, mty, args, Array.of_list args
-		  | None -> evars, None, m, mty, argsl, args
-	      in
-	      let state, m' = s.strategy { state ; env ; unfresh ;
-					   term1 = m ; ty1 = mty ;
-					   cstr = (prop, cstr') ; evars } in
-		match m' with
-		| Fail -> rewrite_args state None (* Standard path, try rewrite on arguments *)
-		| Identity -> rewrite_args state (Some false)
-		| Success r ->
-		    (* We rewrote the function and get a proof of pointwise rel for the arguments.
-		       We just apply it. *)
-		    let prf = match r.rew_prf with
-		      | RewPrf (rel, prf) ->
-			let app = if prop then PropGlobal.apply_pointwise 
-			  else TypeGlobal.apply_pointwise 
-			in
-			  RewPrf (app rel argsl, mkApp (prf, args))
-		      | x -> x
-		    in
-		    let res =
-		      { rew_car = prod_appvect r.rew_car args;
-			rew_from = mkApp(r.rew_from, args); rew_to = mkApp(r.rew_to, args);
-			rew_prf = prf; rew_evars = r.rew_evars }
-		    in 
-		    let res = 
-		      match prf with
-		      | RewPrf (rel, prf) ->
-			Success (apply_constraint env unfresh res.rew_car
-				      rel prf (prop,cstr) res)
-		      | _ -> Success res
-		    in state, res
-	    else rewrite_args state None
-	      
-      | Prod (n, x, b) when noccurn 1 b ->
-	  let b = subst1 mkProp b in
-	  let tx = Retyping.get_type_of env (goalevars evars) x 
-	  and tb = Retyping.get_type_of env (goalevars evars) b in
-	  let arr = if prop then PropGlobal.arrow_morphism 
-	    else TypeGlobal.arrow_morphism 
-	  in
-	  let (evars', mor), unfold = arr env evars tx tb x b in
-	  let state, res = aux { state ; env ; unfresh ;
-				 term1 = mor ; ty1 = ty ;
-				 cstr = (prop,cstr) ; evars = evars' } in
-	  let res = 
-	    match res with
-	    | Success r -> Success { r with rew_to = unfold r.rew_to }
-	    | Fail | Identity -> res
-	  in state, res
-
-      (* 		if x' = None && flags.under_lambdas then *)
-      (* 		  let lam = mkLambda (n, x, b) in *)
-      (* 		  let lam', occ = aux env lam occ None in *)
-      (* 		  let res =  *)
-      (* 		    match lam' with *)
-      (* 		    | None -> None *)
-      (* 		    | Some (prf, (car, rel, c1, c2)) -> *)
-      (* 			Some (resolve_morphism env sigma t *)
-      (* 				 ~fnewt:unfold_all *)
-      (* 				 (Lazy.force coq_all) [| x ; lam |] [| None; lam' |] *)
-      (* 				 cstr evars) *)
-      (* 		  in res, occ *)
-      (* 		else *)
-
-      | Prod (n, dom, codom) ->
-	  let lam = mkLambda (n, dom, codom) in
-	  let (evars', app), unfold = 
-	    if eq_constr ty mkProp then
-	      (app_poly_sort prop env evars coq_all [| dom; lam |]), TypeGlobal.unfold_all
-	    else 
-	      let forall = if prop then PropGlobal.coq_forall else TypeGlobal.coq_forall in
-		(app_poly_sort prop env evars forall [| dom; lam |]), TypeGlobal.unfold_forall
-	  in
-	  let state, res = aux { state ; env ; unfresh ;
-				 term1 = app ; ty1 = ty ;
-				 cstr = (prop,cstr) ; evars = evars' } in
-	  let res = 
-	    match res with
-	    | Success r -> Success { r with rew_to = unfold r.rew_to }
-	    | Fail | Identity -> res
-	  in state, res
-
-(* TODO: real rewriting under binders: introduce x x' (H : R x x') and rewrite with 
-   H at any occurrence of x. Ask for (R ==> R') for the lambda. Formalize this.
-   B. Barras' idea is to have a context of relations, of length 1, with Σ for gluing
-   dependent relations and using projections to get them out.
- *)
-      (* | Lambda (n, t, b) when flags.under_lambdas -> *)
-      (* 	  let n' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n in *)
-      (* 	  let n'' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n' in *)
-      (* 	  let n''' = name_app (fun id -> Tactics.fresh_id_in_env avoid id env) n'' in *)
-      (* 	  let rel = new_cstr_evar cstr env (mkApp (Lazy.force coq_relation, [|t|])) in *)
-      (* 	  let env' = Environ.push_rel_context [(n'',None,lift 2 rel);(n'',None,lift 1 t);(n', None, t)] env in *)
-      (* 	  let b' = s env' avoid b (Typing.type_of env' (goalevars evars) (lift 2 b)) (unlift_cstr env (goalevars evars) cstr) evars in *)
-      (* 	    (match b' with *)
-      (* 	    | Some (Some r) -> *)
-      (* 		let prf = match r.rew_prf with *)
-      (* 		  | RewPrf (rel, prf) -> *)
-      (* 		      let rel = pointwise_or_dep_relation n' t r.rew_car rel in *)
-      (* 		      let prf = mkLambda (n', t, prf) in *)
-      (* 			RewPrf (rel, prf) *)
-      (* 		  | x -> x *)
-      (* 		in *)
-      (* 		  Some (Some { r with *)
-      (* 		    rew_prf = prf; *)
-      (* 		    rew_car = mkProd (n, t, r.rew_car); *)
-      (* 		    rew_from = mkLambda(n, t, r.rew_from); *)
-      (* 		    rew_to = mkLambda (n, t, r.rew_to) }) *)
-      (* 	    | _ -> b') *)
-
-      | Lambda (n, t, b) when flags.under_lambdas ->
-	let n' = name_app (fun id -> Tactics.fresh_id_in_env unfresh id env) n in
-	let env' = Environ.push_rel (n', None, t) env in
-	let bty = Retyping.get_type_of env' (goalevars evars) b in
-	let unlift = if prop then PropGlobal.unlift_cstr else TypeGlobal.unlift_cstr in
-	let state, b' = s.strategy { state ; env = env' ; unfresh ;
-				     term1 = b ; ty1 = bty ;
-				     cstr = (prop, unlift env evars cstr) ;
-				     evars } in
-	let res = 
-	  match b' with
-	  | Success r ->
-	    let r = match r.rew_prf with
-	      | RewPrf (rel, prf) ->
-		let point = if prop then PropGlobal.pointwise_or_dep_relation else
-		    TypeGlobal.pointwise_or_dep_relation
-		in
-		let evars, rel = point env r.rew_evars n' t r.rew_car rel in
-		let prf = mkLambda (n', t, prf) in
-		  { r with rew_prf = RewPrf (rel, prf); rew_evars = evars }
-	      | x -> r
-	    in
-	      Success { r with
-		rew_car = mkProd (n, t, r.rew_car);
-		rew_from = mkLambda(n, t, r.rew_from);
-		rew_to = mkLambda (n, t, r.rew_to) }
-	  | Fail | Identity -> b'
-	in state, res
-	    
-      | Case (ci, p, c, brs) ->
-	let cty = Retyping.get_type_of env (goalevars evars) c in
-	let evars', eqty = app_poly_sort prop env evars coq_eq [| cty |] in
-	let cstr' = Some eqty in
-	let state, c' = s.strategy { state ; env ; unfresh ;
-				     term1 = c ; ty1 = cty ;
-				     cstr = (prop, cstr') ; evars = evars' } in
-	let state, res = 
-	  match c' with
-	  | Success r ->
-	    let case = mkCase (ci, lift 1 p, mkRel 1, Array.map (lift 1) brs) in
-	    let res = make_leibniz_proof env case ty r in
-	      state, Success (coerce env unfresh (prop,cstr) res)
-	  | Fail | Identity ->
-	    if Array.for_all (Int.equal 0) ci.ci_cstr_ndecls then
-	      let evars', eqty = app_poly_sort prop env evars coq_eq [| ty |] in
-	      let cstr = Some eqty in
-	      let state, found, brs' = Array.fold_left 
-		(fun (state, found, acc) br ->
-		  if not (Option.is_empty found) then 
-		    (state, found, fun x -> lift 1 br :: acc x)
-		  else
-		    let state, res = s.strategy { state ; env ; unfresh ;
-						  term1 = br ; ty1 = ty ;
-						  cstr = (prop,cstr) ; evars } in
-		      match res with
-		      | Success r -> (state, Some r, fun x -> mkRel 1 :: acc x)
-		      | Fail | Identity -> (state, None, fun x -> lift 1 br :: acc x))
-		(state, None, fun x -> []) brs
-	      in
-		match found with
-		| Some r ->
-		  let ctxc = mkCase (ci, lift 1 p, lift 1 c, Array.of_list (List.rev (brs' c'))) in
-		    state, Success (make_leibniz_proof env ctxc ty r)
-		| None -> state, c'
-	    else
-	      match try Some (fold_match env (goalevars evars) t) with Not_found -> None with
-	      | None -> state, c'
-	      | Some (cst, _, t', eff (*FIXME*)) ->
-		 let state, res = aux { state ; env ; unfresh ;
-					term1 = t' ; ty1 = ty ;
-					cstr = (prop,cstr) ; evars } in
-		let res = 
-		  match res with
-		  | Success prf -> 
-		    Success { prf with
-		      rew_from = t; 
-		      rew_to = unfold_match env (goalevars evars) cst prf.rew_to }
-		  | x' -> c'
-		in state, res
-	in 
-	let res = 
-	  match res with
-	  | Success r ->  
-	    let rel, prf = get_rew_prf r in
-	      Success (apply_constraint env unfresh r.rew_car rel prf (prop,cstr) r)
-	  | Fail | Identity -> res
-	in state, res
-      | _ -> state, Fail
-  in { strategy = aux }
-
-let all_subterms = subterm true default_flags
-let one_subterm = subterm false default_flags
-
-(** Requires transitivity of the rewrite step, if not a reduction.
-    Not tail-recursive. *)
-
-let transitivity state env unfresh prop (res : rewrite_result_info) (next : 'a pure_strategy) : 
-    'a * rewrite_result =
-  let state, nextres =
-    next.strategy { state ; env ; unfresh ;
-		    term1 = res.rew_to ; ty1 = res.rew_car ;
-		    cstr = (prop, get_opt_rew_rel res.rew_prf) ;
-		    evars = res.rew_evars }
-  in 
-  let res = 
-    match nextres with
-    | Fail -> Fail
-    | Identity -> Success res
-    | Success res' ->
-      match res.rew_prf with
-      | RewCast c -> Success { res' with rew_from = res.rew_from }
-      | RewPrf (rew_rel, rew_prf) ->
-	match res'.rew_prf with
-	| RewCast _ -> Success { res with rew_to = res'.rew_to }
-	| RewPrf (res'_rel, res'_prf) ->
-	  let trans = 
-	    if prop then PropGlobal.transitive_type 
-	    else TypeGlobal.transitive_type
-	  in
-	  let evars, prfty = 
-	    app_poly_sort prop env res'.rew_evars trans [| res.rew_car; rew_rel |] 
-	  in
-	  let evars, prf = new_cstr_evar evars env prfty in
-	  let prf = mkApp (prf, [|res.rew_from; res'.rew_from; res'.rew_to;
-				  rew_prf; res'_prf |])
-	  in Success { res' with rew_from = res.rew_from; 
-	    rew_evars = evars; rew_prf = RewPrf (res'_rel, prf) }
-  in state, res
-
-(** Rewriting strategies.
-
-    Inspired by ELAN's rewriting strategies:
-    http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.21.4049
-*)
-
-module Strategies =
-  struct
-
-    let fail : 'a pure_strategy =
-      { strategy = fun { state } -> state, Fail }
-
-    let id : 'a pure_strategy =
-      { strategy = fun { state } -> state, Identity }
-
-    let refl : 'a pure_strategy =
-      { strategy =
-	fun { state ; env ;
-	      term1 = t ; ty1 = ty ;
-	      cstr = (prop,cstr) ; evars } ->
-	let evars, rel = match cstr with
-	  | None -> 
-	    let mkr = if prop then PropGlobal.mk_relation else TypeGlobal.mk_relation in
-	    let evars, rty = mkr env evars ty in
-	      new_cstr_evar evars env rty
-	  | Some r -> evars, r
-	in
-	let evars, proof =
-	  let proxy = 
-	    if prop then PropGlobal.proper_proxy_type 
-	    else TypeGlobal.proper_proxy_type
-	  in
-	  let evars, mty = app_poly_sort prop env evars proxy [| ty ; rel; t |] in
-	    new_cstr_evar evars env mty
-	in
-	let res = Success { rew_car = ty; rew_from = t; rew_to = t;
-			       rew_prf = RewPrf (rel, proof); rew_evars = evars }
-	in state, res
-      }
-
-    let progress (s : 'a pure_strategy) : 'a pure_strategy = { strategy =
-      fun input ->
-	let state, res = s.strategy input in
-	  match res with
-	  | Fail -> state, Fail
-	  | Identity -> state, Fail
-	  | Success r -> state, Success r
-							     }
-	    
-    let seq first snd : 'a pure_strategy = { strategy =
-      fun ({ env ; unfresh ; cstr } as input) ->
-	let state, res = first.strategy input in
-	  match res with
-	  | Fail -> state, Fail
-	  | Identity -> snd.strategy { input with state }
-	  | Success res -> transitivity state env unfresh (fst cstr) res snd
-					   }
-	    
-    let choice fst snd : 'a pure_strategy = { strategy =
-      fun input ->
-	let state, res = fst.strategy input in
-	  match res with
-	  | Fail -> snd.strategy { input with state }
-	  | Identity | Success _ -> state, res
-					    }
-
-    let try_ str : 'a pure_strategy = choice str id
-
-    let check_interrupt str input =
-      Control.check_for_interrupt ();
-      str input
-
-    let fix (f : 'a pure_strategy -> 'a pure_strategy) : 'a pure_strategy =
-      let rec aux input = (f { strategy = fun input -> check_interrupt aux input }).strategy input in
-      { strategy = aux }
-    
-    let any (s : 'a pure_strategy) : 'a pure_strategy =
-      fix (fun any -> try_ (seq s any))
-
-    let repeat (s : 'a pure_strategy) : 'a pure_strategy =
-      seq s (any s)
-
-    let bu (s : 'a pure_strategy) : 'a pure_strategy =
-      fix (fun s' -> seq (choice (progress (all_subterms s')) s) (try_ s'))
-
-    let td (s : 'a pure_strategy) : 'a pure_strategy =
-      fix (fun s' -> seq (choice s (progress (all_subterms s'))) (try_ s'))
-
-    let innermost (s : 'a pure_strategy) : 'a pure_strategy =
-      fix (fun ins -> choice (one_subterm ins) s)
-
-    let outermost (s : 'a pure_strategy) : 'a pure_strategy =
-      fix (fun out -> choice s (one_subterm out))
-
-    let lemmas cs : 'a pure_strategy =
-      List.fold_left (fun tac (l,l2r,by) ->
-	choice tac (apply_lemma l2r rewrite_unif_flags l by AllOccurrences))
-	fail cs
-
-    let inj_open hint = (); fun sigma ->
-      let ctx = Evd.evar_universe_context_of hint.Autorewrite.rew_ctx in
-      let sigma = Evd.merge_universe_context sigma ctx in
-      (sigma, (hint.Autorewrite.rew_lemma, NoBindings))
-
-    let old_hints (db : string) : 'a pure_strategy =
-      let rules = Autorewrite.find_rewrites db in
-	lemmas
-	  (List.map (fun hint -> (inj_open hint, hint.Autorewrite.rew_l2r,
-				  hint.Autorewrite.rew_tac)) rules)
-
-    let hints (db : string) : 'a pure_strategy = { strategy =
-      fun ({ term1 = t } as input) ->
-      let rules = Autorewrite.find_matches db t in
-      let lemma hint = (inj_open hint, hint.Autorewrite.rew_l2r,
-			hint.Autorewrite.rew_tac) in
-      let lems = List.map lemma rules in
-      (lemmas lems).strategy input
-						 }
-
-    let reduce (r : Redexpr.red_expr) : 'a pure_strategy = { strategy =
-	fun { state = state ; env = env ; term1 = t ; ty1 = ty ; cstr = cstr ; evars = evars } ->
-          let rfn, ckind = Redexpr.reduction_of_red_expr env r in
-	  let evars', t' = rfn env (goalevars evars) t in
-	    if eq_constr t' t then
-	      state, Identity
-	    else
-	      state, Success { rew_car = ty; rew_from = t; rew_to = t';
-			       rew_prf = RewCast ckind; 
-			       rew_evars = evars', cstrevars evars }
-							   }
-	
-    let fold_glob c : 'a pure_strategy = { strategy =
-      fun { state ; env ; term1 = t ; ty1 = ty ; cstr ; evars } ->
-(* 	let sigma, (c,_) = Tacinterp.interp_open_constr_with_bindings is env (goalevars evars) c in *)
-	let sigma, c = Pretyping.understand_tcc env (goalevars evars) c in
-	let unfolded =
-	  try Tacred.try_red_product env sigma c
-	  with e when Errors.noncritical e ->
-            error "fold: the term is not unfoldable !"
-	in
-	  try
-	    let sigma = Unification.w_unify env sigma CONV ~flags:(Unification.elim_flags ()) unfolded t in
-	    let c' = Evarutil.nf_evar sigma c in
-	      state, Success { rew_car = ty; rew_from = t; rew_to = c';
-				  rew_prf = RewCast DEFAULTcast;
-				  rew_evars = (sigma, snd evars) }
-	  with e when Errors.noncritical e -> state, Fail
-					 }
-  
-
-end
-
-(** The strategy for a single rewrite, dealing with occurrences. *)
-
-(** A dummy initial clauseenv to avoid generating initial evars before
-    even finding a first application of the rewriting lemma, in setoid_rewrite
-    mode *)
-
-let rewrite_with l2r flags c occs : strategy = { strategy =
-  fun ({ state = () } as input) ->
-    let unify env evars t =
-      let (sigma, cstrs) = evars in
-      let ans =
-        try Some (refresh_hypinfo env sigma c)
-        with e when Class_tactics.catchable e -> None
-      in
-      match ans with
-      | None -> None
-      | Some (sigma, rew) ->
-        let rew = unify_eqn rew l2r flags env (sigma, cstrs) None t in
-        match rew with
-        | None -> None
-        | Some rew -> Some rew
-    in
-    let app = apply_rule unify occs in
-    let strat = 
-      Strategies.fix (fun aux -> 
-	Strategies.choice app (subterm true default_flags aux))
-    in
-    let _, res = strat.strategy { input with state = 0 } in
-    ((), res)
-					       }
-
-let apply_strategy (s : strategy) env unfresh concl (prop, cstr) evars =
-  let ty = Retyping.get_type_of env (goalevars evars) concl in
-  let _, res = s.strategy { state = () ; env ; unfresh ;
-			    term1 = concl ; ty1 = ty ;
-			    cstr = (prop, Some cstr) ; evars } in
-  res
-
-let solve_constraints env (evars,cstrs) =
-  let filter = all_constraints cstrs in
-    Typeclasses.resolve_typeclasses env ~filter ~split:false ~fail:true 
-      (Typeclasses.mark_resolvables ~filter evars)
-      
-let nf_zeta =
-  Reductionops.clos_norm_flags (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
-
-exception RewriteFailure of Pp.std_ppcmds
-
-type result = (evar_map * constr option * types) option option
-
-let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : result =
-  let evdref = ref sigma in
-  let sort = Typing.sort_of env evdref concl in
-  let evars = (!evdref, Evar.Set.empty) in
-  let evars, cstr =
-    let prop, (evars, arrow) = 
-      if is_prop_sort sort then true, app_poly_sort true env evars impl [||]
-      else false, app_poly_sort false env evars TypeGlobal.arrow [||]
-    in
-      match is_hyp with
-      | None -> 
-	let evars, t = poly_inverse prop env evars (mkSort sort) arrow in 
-	  evars, (prop, t)
-      | Some _ -> evars, (prop, arrow)
-  in
-  let eq = apply_strategy strat env avoid concl cstr evars in
-    match eq with
-    | Fail -> None
-    | Identity -> Some None
-    | Success res ->
-      let (_, cstrs) = res.rew_evars in
-      let evars' = solve_constraints env res.rew_evars in
-      let newt = Evarutil.nf_evar evars' res.rew_to in
-      let evars = (* Keep only original evars (potentially instantiated) and goal evars,
-		     the rest has been defined and substituted already. *)
-	Evar.Set.fold 
-	  (fun ev acc -> 
-	   if not (Evd.is_defined acc ev) then 
-	     errorlabstrm "rewrite"
-			  (str "Unsolved constraint remaining: " ++ spc () ++
-			   Evd.pr_evar_info (Evd.find acc ev))
-	   else Evd.remove acc ev) 
-	  cstrs evars'
-      in
-      let res = match res.rew_prf with
-	| RewCast c -> None
-	| RewPrf (rel, p) ->
-	  let p = nf_zeta env evars' (Evarutil.nf_evar evars' p) in
-	  let term =
-	    match abs with
-	    | None -> p
-	    | Some (t, ty) ->
-              let t = Evarutil.nf_evar evars' t in
-              let ty = Evarutil.nf_evar evars' ty in
-		mkApp (mkLambda (Name (Id.of_string "lemma"), ty, p), [| t |])
-	  in
-	  let proof = match is_hyp with
-            | None -> term
-            | Some id -> mkApp (term, [| mkVar id |])
-          in Some proof
-      in Some (Some (evars, res, newt))
-
-(** Insert a declaration after the last declaration it depends on *)
-let rec insert_dependent env decl accu hyps = match hyps with
-| [] -> List.rev_append accu [decl]
-| (id, _, _  as ndecl) :: rem ->
-  if occur_var_in_decl env id decl then
-    List.rev_append accu (decl :: hyps)
-  else
-    insert_dependent env decl (ndecl :: accu) rem
-
-let assert_replacing id newt tac = 
-  let prf = Proofview.Goal.nf_enter begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let env = Proofview.Goal.env gl in
-    let ctx = Environ.named_context env in
-    let after, before = List.split_when (fun (n, b, t) -> Id.equal n id) ctx in
-    let nc = match before with
-    | [] -> assert false
-    | (id, b, _) :: rem -> insert_dependent env (id, None, newt) [] after @ rem
-    in
-    let env' = Environ.reset_with_named_context (val_of_named_context nc) env in
-    Proofview.Refine.refine ~unsafe:false begin fun sigma ->
-      let sigma, ev = Evarutil.new_evar env' sigma concl in
-      let sigma, ev' = Evarutil.new_evar env sigma newt in
-      let map (n, _, _) = if Id.equal n id then ev' else mkVar n in
-      let (e, _) = destEvar ev in
-      sigma, mkEvar (e, Array.map_of_list map nc)
-    end
-  end in
-  Proofview.tclTHEN prf (Proofview.tclFOCUS 2 2 tac)
-
-let newfail n s = 
-  Proofview.tclZERO (Refiner.FailError (n, lazy s))
-
-let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
-  let open Proofview.Notations in
-  let treat sigma res = 
-    match res with
-    | None -> newfail 0 (str "Nothing to rewrite")
-    | Some None -> if progress then newfail 0 (str"Failed to progress")
-		   else Proofview.tclUNIT ()
-    | Some (Some res) ->
-        let (undef, prf, newt) = res in
-        let fold ev _ accu = if Evd.mem sigma ev then accu else ev :: accu in
-        let gls = List.rev (Evd.fold_undefined fold undef []) in
-	match clause, prf with
-	| Some id, Some p ->
-            let tac = Proofview.Refine.refine ~unsafe:false (fun h -> (h, p)) <*> Proofview.Unsafe.tclNEWGOALS gls in
-            Proofview.Unsafe.tclEVARS undef <*>
-	    assert_replacing id newt tac
-	| Some id, None ->
-            Proofview.Unsafe.tclEVARS undef <*>
-            convert_hyp_no_check (id, None, newt)
-	| None, Some p ->
-            Proofview.Unsafe.tclEVARS undef <*>
-            Proofview.Goal.enter begin fun gl ->
-            let env = Proofview.Goal.env gl in
-            let make sigma =
-              let (sigma, ev) = Evarutil.new_evar env sigma newt in
-              sigma, mkApp (p, [| ev |])
-            in
-            Proofview.Refine.refine ~unsafe:false make <*> Proofview.Unsafe.tclNEWGOALS gls
-            end
-	| None, None ->
-            Proofview.Unsafe.tclEVARS undef <*>
-            convert_concl_no_check newt DEFAULTcast
-  in
-  let beta_red _ sigma c = Reductionops.nf_betaiota sigma c in
-  let beta = Proofview.V82.tactic (Tactics.reduct_in_concl (beta_red, DEFAULTcast)) in
-  let opt_beta = match clause with
-  | None -> Proofview.tclUNIT ()
-  | Some id -> Proofview.V82.tactic (Tactics.reduct_in_hyp beta_red (id, InHyp))
-  in
-  Proofview.Goal.nf_enter begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let ty = match clause with
-    | None -> concl
-    | Some id -> Environ.named_type id env
-    in
-    let env = match clause with
-    | None -> env
-    | Some id ->
-      (** Only consider variables not depending on [id] *)
-      let ctx = Environ.named_context env in
-      let filter decl = not (occur_var_in_decl env id decl) in
-      let nctx = List.filter filter ctx in
-      Environ.reset_with_named_context (Environ.val_of_named_context nctx) env
-    in
-    try
-      let res =
-        cl_rewrite_clause_aux ?abs strat env [] sigma ty clause
-      in
-      let sigma = match origsigma with None -> sigma | Some sigma -> sigma in
-      treat sigma res <*>
-      (** For compatibility *)
-      beta <*> opt_beta <*> Proofview.shelve_unifiable
-    with
-    | PretypeError (env, evd, (UnsatisfiableConstraints _ as e)) ->
-      raise (RewriteFailure (Himsg.explain_pretype_error env evd e))
-  end
-
-let tactic_init_setoid () = 
-  try init_setoid (); tclIDTAC
-  with e when Errors.noncritical e -> tclFAIL 0 (str"Setoid library not loaded")
-
-let cl_rewrite_clause_strat progress strat clause =
-  tclTHEN (tactic_init_setoid ())
-  ((if progress then tclWEAK_PROGRESS else fun x -> x)
-   (fun gl -> 
-    try Proofview.V82.of_tactic (cl_rewrite_clause_newtac ~progress strat clause) gl
-    with RewriteFailure e ->
-	 errorlabstrm "" (str"setoid rewrite failed: " ++ e)
-       | Refiner.FailError (n, pp) -> 
-	  tclFAIL n (str"setoid rewrite failed: " ++ Lazy.force pp) gl))
-
-(** Setoid rewriting when called with "setoid_rewrite" *)
-let cl_rewrite_clause l left2right occs clause gl =
-  let strat = rewrite_with left2right (general_rewrite_unif_flags ()) l occs in
-    cl_rewrite_clause_strat true strat clause gl
-
-(** Setoid rewriting when called with "rewrite_strat" *)
-let cl_rewrite_clause_strat strat clause =
-  cl_rewrite_clause_strat false strat clause
-  
-let apply_glob_constr c l2r occs = (); fun ({ state = () ; env = env } as input) ->
-  let c sigma =
-    let (sigma, c) = Pretyping.understand_tcc env sigma c in
-    (sigma, (c, NoBindings))
-  in
-  let flags = general_rewrite_unif_flags () in
-  (apply_lemma l2r flags c None occs).strategy input
-
-let interp_glob_constr_list env =
-  let make c = (); fun sigma ->
-    let sigma, c = Pretyping.understand_tcc env sigma c in
-    (sigma, (c, NoBindings))
-  in
-  List.map (fun c -> make c, true, None)
-
-(* Syntax for rewriting with strategies *)
-
-type unary_strategy = 
-    Subterms | Subterm | Innermost | Outermost
-  | Bottomup | Topdown | Progress | Try | Any | Repeat
-
-type binary_strategy = 
-  | Compose | Choice
-
-type ('constr,'redexpr) strategy_ast = 
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr) strategy_ast
-  | StratBinary of binary_strategy 
-    * ('constr,'redexpr) strategy_ast * ('constr,'redexpr) strategy_ast
-  | StratConstr of 'constr * bool
-  | StratTerms of 'constr list
-  | StratHints of bool * string
-  | StratEval of 'redexpr 
-  | StratFold of 'constr
-
-let rec map_strategy (f : 'a -> 'a2) (g : 'b -> 'b2) : ('a,'b) strategy_ast -> ('a2,'b2) strategy_ast = function
-  | StratId | StratFail | StratRefl as s -> s
-  | StratUnary (s, str) -> StratUnary (s, map_strategy f g str)
-  | StratBinary (s, str, str') -> StratBinary (s, map_strategy f g str, map_strategy f g str')
-  | StratConstr (c, b) -> StratConstr (f c, b)
-  | StratTerms l -> StratTerms (List.map f l)
-  | StratHints (b, id) -> StratHints (b, id)
-  | StratEval r -> StratEval (g r)
-  | StratFold c -> StratFold (f c)
-
-let rec strategy_of_ast = function
-  | StratId -> Strategies.id
-  | StratFail -> Strategies.fail
-  | StratRefl -> Strategies.refl
-  | StratUnary (f, s) -> 
-    let s' = strategy_of_ast s in
-    let f' = match f with
-      | Subterms -> all_subterms
-      | Subterm -> one_subterm
-      | Innermost -> Strategies.innermost
-      | Outermost -> Strategies.outermost
-      | Bottomup -> Strategies.bu
-      | Topdown -> Strategies.td
-      | Progress -> Strategies.progress
-      | Try -> Strategies.try_
-      | Any -> Strategies.any
-      | Repeat -> Strategies.repeat
-    in f' s'
-  | StratBinary (f, s, t) ->
-    let s' = strategy_of_ast s in
-    let t' = strategy_of_ast t in
-    let f' = match f with
-      | Compose -> Strategies.seq
-      | Choice -> Strategies.choice
-    in f' s' t'
-  | StratConstr (c, b) -> { strategy = apply_glob_constr (fst c) b AllOccurrences }
-  | StratHints (old, id) -> if old then Strategies.old_hints id else Strategies.hints id
-  | StratTerms l -> { strategy =
-    (fun ({ state = () ; env } as input) ->
-     let l' = interp_glob_constr_list env (List.map fst l) in
-     (Strategies.lemmas l').strategy input)
-		    }
-  | StratEval r -> { strategy =
-    (fun ({ state = () ; env ; evars } as input) ->
-     let (sigma,r_interp) = Tacinterp.interp_redexp env (goalevars evars) r in
-     (Strategies.reduce r_interp).strategy { input with
-					     evars = (sigma,cstrevars evars) }) }
-  | StratFold c -> Strategies.fold_glob (fst c)
-
-
-(* By default the strategy for "rewrite_db" is top-down *)
-
-let mkappc s l = CAppExpl (Loc.ghost,(None,(Libnames.Ident (Loc.ghost,Id.of_string s)),None),l)
-
-let declare_an_instance n s args =
-  ((Loc.ghost,Name n), Explicit,
-  CAppExpl (Loc.ghost, (None, Qualid (Loc.ghost, qualid_of_string s),None),
-	   args))
-
-let declare_instance a aeq n s = declare_an_instance n s [a;aeq]
-
-let anew_instance global binders instance fields =
-  new_instance (Flags.is_universe_polymorphism ()) 
-    binders instance (Some (true, CRecord (Loc.ghost,None,fields)))
-    ~global ~generalize:false None
-
-let declare_instance_refl global binders a aeq n lemma =
-  let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive"
-  in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "reflexivity"),lemma)]
-
-let declare_instance_sym global binders a aeq n lemma =
-  let instance = declare_instance a aeq (add_suffix n "_Symmetric") "Coq.Classes.RelationClasses.Symmetric"
-  in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "symmetry"),lemma)]
-
-let declare_instance_trans global binders a aeq n lemma =
-  let instance = declare_instance a aeq (add_suffix n "_Transitive") "Coq.Classes.RelationClasses.Transitive"
-  in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "transitivity"),lemma)]
-
-let declare_relation ?(binders=[]) a aeq n refl symm trans =
-  init_setoid ();
-  let global = not (Locality.make_section_locality (Locality.LocalityFixme.consume ())) in
-  let instance = declare_instance a aeq (add_suffix n "_relation") "Coq.Classes.RelationClasses.RewriteRelation"
-  in ignore(anew_instance global binders instance []);
-  match (refl,symm,trans) with
-      (None, None, None) -> ()
-    | (Some lemma1, None, None) ->
-	ignore (declare_instance_refl global binders a aeq n lemma1)
-    | (None, Some lemma2, None) ->
-	ignore (declare_instance_sym global binders a aeq n lemma2)
-    | (None, None, Some lemma3) ->
-	ignore (declare_instance_trans global binders a aeq n lemma3)
-    | (Some lemma1, Some lemma2, None) ->
-	ignore (declare_instance_refl global binders a aeq n lemma1);
-	ignore (declare_instance_sym global binders a aeq n lemma2)
-    | (Some lemma1, None, Some lemma3) ->
-	let _lemma_refl = declare_instance_refl global binders a aeq n lemma1 in
-	let _lemma_trans = declare_instance_trans global binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PreOrder"
-	in ignore(
-	    anew_instance global binders instance
-	      [(Ident (Loc.ghost,Id.of_string "PreOrder_Reflexive"), lemma1);
-	       (Ident (Loc.ghost,Id.of_string "PreOrder_Transitive"),lemma3)])
-    | (None, Some lemma2, Some lemma3) ->
-	let _lemma_sym = declare_instance_sym global binders a aeq n lemma2 in
-	let _lemma_trans = declare_instance_trans global binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PER"
-	in ignore(
-	    anew_instance global binders instance
-	      [(Ident (Loc.ghost,Id.of_string "PER_Symmetric"), lemma2);
-	       (Ident (Loc.ghost,Id.of_string "PER_Transitive"),lemma3)])
-     | (Some lemma1, Some lemma2, Some lemma3) ->
-	let _lemma_refl = declare_instance_refl global binders a aeq n lemma1 in
-	let _lemma_sym = declare_instance_sym global binders a aeq n lemma2 in
-	let _lemma_trans = declare_instance_trans global binders a aeq n lemma3 in
-	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
-	in ignore(
-	  anew_instance global binders instance
-	    [(Ident (Loc.ghost,Id.of_string "Equivalence_Reflexive"), lemma1);
-	     (Ident (Loc.ghost,Id.of_string "Equivalence_Symmetric"), lemma2);
-	     (Ident (Loc.ghost,Id.of_string "Equivalence_Transitive"), lemma3)])
-
-let cHole = CHole (Loc.ghost, None, Misctypes.IntroAnonymous, None)
-
-let proper_projection r ty =
-  let ctx, inst = decompose_prod_assum ty in
-  let mor, args = destApp inst in
-  let instarg = mkApp (r, rel_vect 0 (List.length ctx)) in
-  let app = mkApp (Lazy.force PropGlobal.proper_proj,
-		  Array.append args [| instarg |]) in
-    it_mkLambda_or_LetIn app ctx
-
-let declare_projection n instance_id r =
-  let poly = Global.is_polymorphic r in
-  let env = Global.env () in
-  let sigma = Evd.from_env env in
-  let evd,c = Evd.fresh_global env sigma r in
-  let ty = Retyping.get_type_of env sigma c in
-  let term = proper_projection c ty in
-  let typ = Typing.unsafe_type_of env sigma term in
-  let ctx, typ = decompose_prod_assum typ in
-  let typ =
-    let n =
-      let rec aux t =
-	match kind_of_term t with
-	| App (f, [| a ; a' ; rel; rel' |]) 
-	    when Globnames.is_global (PropGlobal.respectful_ref ()) f ->
-	  succ (aux rel')
-	| _ -> 0
-      in
-      let init =
-	match kind_of_term typ with
-	    App (f, args) when Globnames.is_global (PropGlobal.respectful_ref ()) f  ->
-	      mkApp (f, fst (Array.chop (Array.length args - 2) args))
-	  | _ -> typ
-      in aux init
-    in
-    let ctx,ccl = Reductionops.splay_prod_n (Global.env()) Evd.empty (3 * n) typ
-    in it_mkProd_or_LetIn ccl ctx
-  in
-  let typ = it_mkProd_or_LetIn typ ctx in
-  let pl, ctx = Evd.universe_context sigma in
-  let cst = 
-    Declare.definition_entry ~types:typ ~poly ~univs:ctx term
-  in
-    ignore(Declare.declare_constant n 
-	   (Entries.DefinitionEntry cst, Decl_kinds.IsDefinition Decl_kinds.Definition))
-
-let build_morphism_signature m =
-  let env = Global.env () in
-  let sigma = Evd.from_env env in
-  let m,ctx = Constrintern.interp_constr env sigma m in
-  let sigma = Evd.from_ctx ctx in
-  let t = Typing.unsafe_type_of env sigma m in
-  let cstrs =
-    let rec aux t =
-      match kind_of_term t with
-	| Prod (na, a, b) ->
-	    None :: aux b
-	| _ -> []
-    in aux t
-  in
-  let evars, t', sig_, cstrs = 
-    PropGlobal.build_signature (sigma, Evar.Set.empty) env t cstrs None in
-  let evd = ref evars in
-  let _ = List.iter
-    (fun (ty, rel) ->
-      Option.iter (fun rel ->
-	let default = e_app_poly env evd PropGlobal.default_relation [| ty; rel |] in
-	  ignore(e_new_cstr_evar env evd default))
-	rel)
-    cstrs
-  in
-  let morph = e_app_poly env evd PropGlobal.proper_type [| t; sig_; m |] in
-  let evd = solve_constraints env !evd in
-  let m = Evarutil.nf_evar evd morph in
-    Evarutil.check_evars env Evd.empty evd m; m
-
-let default_morphism sign m =
-  let env = Global.env () in
-  let sigma = Evd.from_env env in
-  let t = Typing.unsafe_type_of env sigma m in
-  let evars, _, sign, cstrs =
-    PropGlobal.build_signature (sigma, Evar.Set.empty) env t (fst sign) (snd sign)
-  in
-  let evars, morph = app_poly_check env evars PropGlobal.proper_type [| t; sign; m |] in
-  let evars, mor = resolve_one_typeclass env (goalevars evars) morph in
-    mor, proper_projection mor morph
-
-let add_setoid global binders a aeq t n =
-  init_setoid ();
-  let _lemma_refl = declare_instance_refl global binders a aeq n (mkappc "Seq_refl" [a;aeq;t]) in
-  let _lemma_sym = declare_instance_sym global binders a aeq n (mkappc "Seq_sym" [a;aeq;t]) in
-  let _lemma_trans = declare_instance_trans global binders a aeq n (mkappc "Seq_trans" [a;aeq;t]) in
-  let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
-  in ignore(
-    anew_instance global binders instance
-      [(Ident (Loc.ghost,Id.of_string "Equivalence_Reflexive"), mkappc "Seq_refl" [a;aeq;t]);
-       (Ident (Loc.ghost,Id.of_string "Equivalence_Symmetric"), mkappc "Seq_sym" [a;aeq;t]);
-       (Ident (Loc.ghost,Id.of_string "Equivalence_Transitive"), mkappc "Seq_trans" [a;aeq;t])])
-
-
-let make_tactic name =
-  let open Tacexpr in
-  let loc = Loc.ghost in
-  let tacpath = Libnames.qualid_of_string name in
-  let tacname = Qualid (loc, tacpath) in
-  TacArg (loc, TacCall (loc, tacname, []))
-
-let add_morphism_infer glob m n =
-  init_setoid ();
-  let poly = Flags.is_universe_polymorphism () in
-  let instance_id = add_suffix n "_Proper" in
-  let instance = build_morphism_signature m in
-  let evd = Evd.from_env (Global.env ()) in
-    if Lib.is_modtype () then
-      let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest instance_id
-				(Entries.ParameterEntry 
-				 (None,poly,(instance,Univ.UContext.empty),None), 
-				 Decl_kinds.IsAssumption Decl_kinds.Logical)
-      in
-	add_instance (Typeclasses.new_instance 
-			(Lazy.force PropGlobal.proper_class) None glob 
-			poly (ConstRef cst));
-	declare_projection n instance_id (ConstRef cst)
-    else
-      let kind = Decl_kinds.Global, poly, 
-	Decl_kinds.DefinitionBody Decl_kinds.Instance 
-      in
-      let tac = make_tactic "Coq.Classes.SetoidTactics.add_morphism_tactic" in
-      let hook _ = function
-	| Globnames.ConstRef cst ->
-	  add_instance (Typeclasses.new_instance 
-			  (Lazy.force PropGlobal.proper_class) None
-			  glob poly (ConstRef cst));
-	  declare_projection n instance_id (ConstRef cst)
-	| _ -> assert false
-      in
-      let hook = Lemmas.mk_hook hook in
-	Flags.silently
-	  (fun () ->
-	    Lemmas.start_proof instance_id kind evd instance hook;
-	    ignore (Pfedit.by (Tacinterp.interp tac))) ()
-
-let add_morphism glob binders m s n =
-  init_setoid ();
-  let poly = Flags.is_universe_polymorphism () in
-  let instance_id = add_suffix n "_Proper" in
-  let instance =
-    ((Loc.ghost,Name instance_id), Explicit,
-    CAppExpl (Loc.ghost,
-	     (None, Qualid (Loc.ghost, Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper"),None),
-	     [cHole; s; m]))
-  in
-  let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in
-    ignore(new_instance ~global:glob poly binders instance 
-	     (Some (true, CRecord (Loc.ghost,None,[])))
-	      ~generalize:false ~tac ~hook:(declare_projection n instance_id) None)
-
-(** Bind to "rewrite" too *)
-
-(** Taken from original setoid_replace, to emulate the old rewrite semantics where
-    lemmas are first instantiated and then rewrite proceeds. *)
-
-let check_evar_map_of_evars_defs evd =
- let metas = Evd.meta_list evd in
- let check_freemetas_is_empty rebus =
-  Evd.Metaset.iter
-   (fun m ->
-     if Evd.meta_defined evd m then () else
-      raise
-	(Logic.RefinerError (Logic.UnresolvedBindings [Evd.meta_name evd m])))
- in
-  List.iter
-   (fun (_,binding) ->
-     match binding with
-        Evd.Cltyp (_,{Evd.rebus=rebus; Evd.freemetas=freemetas}) ->
-         check_freemetas_is_empty rebus freemetas
-      | Evd.Clval (_,({Evd.rebus=rebus1; Evd.freemetas=freemetas1},_),
-                 {Evd.rebus=rebus2; Evd.freemetas=freemetas2}) ->
-         check_freemetas_is_empty rebus1 freemetas1 ;
-         check_freemetas_is_empty rebus2 freemetas2
-   ) metas
-
-(* Find a subterm which matches the pattern to rewrite for "rewrite" *)
-let unification_rewrite l2r c1 c2 sigma prf car rel but env =
-  let (sigma,c') =
-    try
-      (* ~flags:(false,true) to allow to mark occurrences that must not be
-         rewritten simply by replacing them with let-defined definitions
-         in the context *)
-      Unification.w_unify_to_subterm 
-       ~flags:rewrite_unif_flags
-        env sigma ((if l2r then c1 else c2),but)
-    with
-    | ex when Pretype_errors.precatchable_exception ex ->
-	(* ~flags:(true,true) to make Ring work (since it really
-           exploits conversion) *)
-      Unification.w_unify_to_subterm 
-        ~flags:rewrite_conv_unif_flags
-        env sigma ((if l2r then c1 else c2),but)
-  in
-  let nf c = Evarutil.nf_evar sigma c in
-  let c1 = if l2r then nf c' else nf c1
-  and c2 = if l2r then nf c2 else nf c'
-  and car = nf car and rel = nf rel in
-  check_evar_map_of_evars_defs sigma;
-  let prf = nf prf in
-  let prfty = nf (Retyping.get_type_of env sigma prf) in
-  let sort = sort_of_rel env sigma but in
-  let abs = prf, prfty in
-  let prf = mkRel 1 in
-  let res = (car, rel, prf, c1, c2) in
-  abs, sigma, res, Sorts.is_prop sort
-
-let get_hyp gl (c,l) clause l2r =
-  let evars = project gl in
-  let env = pf_env gl in
-  let sigma, hi = decompose_applied_relation env evars (c,l) in
-  let but = match clause with
-    | Some id -> pf_get_hyp_typ gl id 
-    | None -> Evarutil.nf_evar evars (pf_concl gl)
-  in
-  unification_rewrite l2r hi.c1 hi.c2 sigma hi.prf hi.car hi.rel but env
-
-let general_rewrite_flags = { under_lambdas = false; on_morphisms = true }
-
-(* let rewriteclaustac_key = Profile.declare_profile "cl_rewrite_clause_tac";; *)
-(* let cl_rewrite_clause_tac = Profile.profile5 rewriteclaustac_key cl_rewrite_clause_tac *)
-
-(** Setoid rewriting when called with "rewrite" *)
-let general_s_rewrite cl l2r occs (c,l) ~new_goals gl =
-  let abs, evd, res, sort = get_hyp gl (c,l) cl l2r in
-  let unify env evars t = unify_abs res l2r sort env evars t in
-  let app = apply_rule unify occs in
-  let recstrat aux = Strategies.choice app (subterm true general_rewrite_flags aux) in
-  let substrat = Strategies.fix recstrat in
-  let strat = { strategy = fun ({ state = () } as input) ->
-    let _, res = substrat.strategy { input with state = 0 } in
-    (), res
-	      }
-  in
-  let origsigma = project gl in
-  init_setoid ();
-    try
-      tclWEAK_PROGRESS 
-	(tclTHEN
-           (Refiner.tclEVARS evd)
-	   (Proofview.V82.of_tactic
-	    (cl_rewrite_clause_newtac ~progress:true ~abs:(Some abs) ~origsigma strat cl))) gl
-    with RewriteFailure e ->
-      tclFAIL 0 (str"setoid rewrite failed: " ++ e) gl
-
-let general_s_rewrite_clause x =
-  match x with
-    | None -> general_s_rewrite None
-    | Some id -> general_s_rewrite (Some id)
-
-let general_s_rewrite_clause x y z w ~new_goals =
-  Proofview.V82.tactic (general_s_rewrite_clause x y z w ~new_goals)
-
-let _ = Hook.set Equality.general_setoid_rewrite_clause general_s_rewrite_clause
-
-(** [setoid_]{reflexivity,symmetry,transitivity} tactics *)
-
-let not_declared env ty rel =
-  Tacticals.New.tclFAIL 0 (str" The relation " ++ Printer.pr_constr_env env Evd.empty rel ++ str" is not a declared " ++
-		str ty ++ str" relation. Maybe you need to require the Setoid library")
-
-let setoid_proof ty fn fallback =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let concl = Proofview.Goal.concl gl in
-    Proofview.tclORELSE
-      begin
-        try
-          let rel, _, _ = decompose_app_rel env sigma concl in
-          let evm = sigma in
-          let car = pi3 (List.hd (fst (Reduction.dest_prod env (Typing.unsafe_type_of env evm rel)))) in
-	    (try init_setoid () with _ -> raise Not_found);
-            fn env sigma car rel
-        with e -> Proofview.tclZERO e
-      end
-      begin function
-        | e ->
-            Proofview.tclORELSE
-              fallback
-              begin function (e', info) -> match e' with
-                | Hipattern.NoEquationFound ->
-	            begin match e with
-	            | (Not_found, _) ->
-	                let rel, _, _ = decompose_app_rel env sigma concl in
-		        not_declared env ty rel
-	            | (e, info) -> Proofview.tclZERO ~info e
-                    end
-                | e' -> Proofview.tclZERO ~info e'
-              end
-      end
-  end
-
-let tac_open ((evm,_), c) tac = 
-  Proofview.V82.tactic 
-    (tclTHEN (Refiner.tclEVARS evm) (tac c))
-
-let poly_proof getp gett env evm car rel =
-  if Sorts.is_prop (sort_of_rel env evm rel) then
-    getp env (evm,Evar.Set.empty) car rel
-  else gett env (evm,Evar.Set.empty) car rel
-
-let setoid_reflexivity =
-  setoid_proof "reflexive"
-    (fun env evm car rel -> 
-     tac_open (poly_proof PropGlobal.get_reflexive_proof
-			  TypeGlobal.get_reflexive_proof
-			  env evm car rel)
-	      (fun c -> tclCOMPLETE (Proofview.V82.of_tactic (apply c))))
-    (reflexivity_red true)
-
-let setoid_symmetry =
-  setoid_proof "symmetric"
-    (fun env evm car rel -> 
-      tac_open
-	(poly_proof PropGlobal.get_symmetric_proof TypeGlobal.get_symmetric_proof
-	   env evm car rel)
-	(fun c -> Proofview.V82.of_tactic (apply c)))
-    (symmetry_red true)
-    
-let setoid_transitivity c =
-  setoid_proof "transitive"
-    (fun env evm car rel ->
-      tac_open (poly_proof PropGlobal.get_transitive_proof TypeGlobal.get_transitive_proof
-	   env evm car rel)
-	(fun proof -> match c with
-	| None -> Proofview.V82.of_tactic (eapply proof)
-	| Some c -> Proofview.V82.of_tactic (apply_with_bindings (proof,ImplicitBindings [ c ]))))
-    (transitivity_red true c)
-    
-let setoid_symmetry_in id =
-  Proofview.V82.tactic (fun gl ->
-  let ctype = pf_unsafe_type_of gl (mkVar id) in
-  let binders,concl = decompose_prod_assum ctype in
-  let (equiv, args) = decompose_app concl in
-  let rec split_last_two = function
-    | [c1;c2] -> [],(c1, c2)
-    | x::y::z -> let l,res = split_last_two (y::z) in x::l, res
-    | _ -> error "Cannot find an equivalence relation to rewrite."
-  in
-  let others,(c1,c2) = split_last_two args in
-  let he,c1,c2 =  mkApp (equiv, Array.of_list others),c1,c2 in
-  let new_hyp' =  mkApp (he, [| c2 ; c1 |]) in
-  let new_hyp = it_mkProd_or_LetIn new_hyp'  binders in
-   Proofview.V82.of_tactic
-    (Tacticals.New.tclTHENLAST
-      (Tactics.assert_after_replacing id new_hyp)
-      (Tacticals.New.tclTHENLIST [ intros; setoid_symmetry; apply (mkVar id); Tactics.assumption ]))
-      gl)
-
-let _ = Hook.set Tactics.setoid_reflexivity setoid_reflexivity
-let _ = Hook.set Tactics.setoid_symmetry setoid_symmetry
-let _ = Hook.set Tactics.setoid_symmetry_in setoid_symmetry_in
-let _ = Hook.set Tactics.setoid_transitivity setoid_transitivity
-
-let get_lemma_proof f env evm x y = 
-  let (evm, _), c = f env (evm,Evar.Set.empty) x y in
-    evm, c
-
-let get_reflexive_proof =
-  get_lemma_proof PropGlobal.get_reflexive_proof
-
-let get_symmetric_proof = 
-  get_lemma_proof PropGlobal.get_symmetric_proof
-
-let get_transitive_proof = 
-  get_lemma_proof PropGlobal.get_transitive_proof
-  
diff --git a/tactics/rewrite.mli b/tactics/rewrite.mli
deleted file mode 100644
index b4d47d62..00000000
--- a/tactics/rewrite.mli
+++ /dev/null
@@ -1,114 +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        *)
-(************************************************************************)
-
-open Names
-open Constr
-open Environ
-open Constrexpr
-open Tacexpr
-open Misctypes
-open Evd
-open Proof_type
-open Tacinterp
-
-(** TODO: document and clean me! *)
-
-type unary_strategy = 
-    Subterms | Subterm | Innermost | Outermost
-  | Bottomup | Topdown | Progress | Try | Any | Repeat
-
-type binary_strategy = 
-  | Compose | Choice
-
-type ('constr,'redexpr) strategy_ast = 
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr) strategy_ast
-  | StratBinary of binary_strategy 
-    * ('constr,'redexpr) strategy_ast * ('constr,'redexpr) strategy_ast
-  | StratConstr of 'constr * bool
-  | StratTerms of 'constr list
-  | StratHints of bool * string
-  | StratEval of 'redexpr 
-  | StratFold of 'constr
-
-type rewrite_proof = 
-  | RewPrf of constr * constr
-  | RewCast of cast_kind
-
-type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
-
-type rewrite_result_info = {
-  rew_car : constr;
-  rew_from : constr;
-  rew_to : constr;
-  rew_prf : rewrite_proof;
-  rew_evars : evars;
-}
-
-type rewrite_result =
-| Fail
-| Identity
-| Success of rewrite_result_info
-
-type strategy
-
-val strategy_of_ast : (glob_constr_and_expr, raw_red_expr) strategy_ast -> strategy
-
-val map_strategy : ('a -> 'b) -> ('c -> 'd) ->
-  ('a, 'c) strategy_ast -> ('b, 'd) strategy_ast
-
-(** Entry point for user-level "rewrite_strat" *)
-val cl_rewrite_clause_strat : strategy -> Id.t option -> tactic
-
-(** Entry point for user-level "setoid_rewrite" *)
-val cl_rewrite_clause :
-  interp_sign * (glob_constr_and_expr * glob_constr_and_expr bindings) ->
-  bool -> Locus.occurrences -> Id.t option -> tactic
-
-val is_applied_rewrite_relation :
-  env -> evar_map -> Context.rel_context -> constr -> types option
-
-val declare_relation :
-  ?binders:local_binder list -> constr_expr -> constr_expr -> Id.t ->
-  constr_expr option -> constr_expr option -> constr_expr option -> unit
-
-val add_setoid :
-  bool -> local_binder list -> constr_expr -> constr_expr -> constr_expr ->
-  Id.t -> unit
-
-val add_morphism_infer : bool -> constr_expr -> Id.t -> unit
-
-val add_morphism :
-  bool -> local_binder list -> constr_expr -> constr_expr -> Id.t -> unit
-
-val get_reflexive_proof : env -> evar_map -> constr -> constr -> evar_map * constr
-
-val get_symmetric_proof : env -> evar_map -> constr -> constr -> evar_map * constr
-
-val get_transitive_proof : env -> evar_map -> constr -> constr -> evar_map * constr
-
-val default_morphism :
-  (types * constr option) option list * (types * types option) option ->
-  constr -> constr * constr
-
-val setoid_symmetry : unit Proofview.tactic
-
-val setoid_symmetry_in : Id.t -> unit Proofview.tactic
-
-val setoid_reflexivity : unit Proofview.tactic
-
-val setoid_transitivity : constr option -> unit Proofview.tactic
-
-
-val apply_strategy :
-  strategy ->
-  Environ.env ->
-  Names.Id.t list ->
-  Term.constr ->
-  bool * Term.constr ->
-  evars -> rewrite_result
diff --git a/tactics/taccoerce.ml b/tactics/taccoerce.ml
deleted file mode 100644
index 25f5c8e9..00000000
--- a/tactics/taccoerce.ml
+++ /dev/null
@@ -1,276 +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        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Pattern
-open Misctypes
-open Genarg
-open Stdarg
-open Constrarg
-
-exception CannotCoerceTo of string
-
-let (wit_constr_context : (Empty.t, Empty.t, constr) Genarg.genarg_type) =
-  Genarg.create_arg None "constr_context"
-
-(* includes idents known to be bound and references *)
-let (wit_constr_under_binders : (Empty.t, Empty.t, constr_under_binders) Genarg.genarg_type) =
-  Genarg.create_arg None "constr_under_binders"
-
-module Value =
-struct
-
-type t = tlevel generic_argument
-
-let rec normalize v =
-  if has_type v (topwit wit_genarg) then
-    normalize (out_gen (topwit wit_genarg) v)
-  else v
-
-let of_constr c = in_gen (topwit wit_constr) c
-
-let to_constr v =
-  let v = normalize v in
-  if has_type v (topwit wit_constr) then
-    let c = out_gen (topwit wit_constr) v in
-    Some c
-  else if has_type v (topwit wit_constr_under_binders) then
-    let vars, c = out_gen (topwit wit_constr_under_binders) v in
-    match vars with [] -> Some c | _ -> None
-  else None
-
-let of_uconstr c = in_gen (topwit wit_uconstr) c
-
-let to_uconstr v =
-  let v = normalize v in
-  if has_type v (topwit wit_uconstr) then
-    Some (out_gen (topwit wit_uconstr) v)
-  else None
-
-let of_int i = in_gen (topwit wit_int) i
-
-let to_int v =
-  let v = normalize v in
-  if has_type v (topwit wit_int) then
-    Some (out_gen (topwit wit_int) v)
-  else None
-
-let to_list v =
-  let v = normalize v in
-  let list_unpacker wit l = List.map (fun v -> in_gen (topwit wit) v) (top l) in
-  try Some (list_unpack { list_unpacker } v)
-  with Failure _ -> None
-
-end
-
-let is_variable env id =
-  Id.List.mem id (Termops.ids_of_named_context (Environ.named_context env))
-
-(* Transforms an id into a constr if possible, or fails with Not_found *)
-let constr_of_id env id =
-  Term.mkVar (let _ = Environ.lookup_named id env in id)
-
-(* Gives the constr corresponding to a Constr_context tactic_arg *)
-let coerce_to_constr_context v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_constr_context) then
-    out_gen (topwit wit_constr_context) v
-  else raise (CannotCoerceTo "a term context")
-
-(* Interprets an identifier which must be fresh *)
-let coerce_to_ident fresh env v =
-  let v = Value.normalize v in
-  let fail () = raise (CannotCoerceTo "a fresh identifier") in
-  if has_type v (topwit wit_intro_pattern) then
-    match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) -> id
-    | _ -> fail ()
-  else if has_type v (topwit wit_var) then
-    out_gen (topwit wit_var) v
-  else match Value.to_constr v with
-  | None -> fail ()
-  | Some c ->
-    (* We need it fresh for intro e.g. in "Tac H = clear H; intro H" *)
-    if isVar c && not (fresh && is_variable env (destVar c)) then
-      destVar c
-    else fail ()
-
-let coerce_to_intro_pattern env v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_intro_pattern) then
-    snd (out_gen (topwit wit_intro_pattern) v)
-  else if has_type v (topwit wit_var) then
-    let id = out_gen (topwit wit_var) v in
-    IntroNaming (IntroIdentifier id)
-  else match Value.to_constr v with
-  | Some c when isVar c ->
-      (* This happens e.g. in definitions like "Tac H = clear H; intro H" *)
-      (* but also in "destruct H as (H,H')" *)
-      IntroNaming (IntroIdentifier (destVar c))
-  | _ -> raise (CannotCoerceTo "an introduction pattern")
-
-let coerce_to_intro_pattern_naming env v =
-  match coerce_to_intro_pattern env v with
-  | IntroNaming pat -> pat
-  | _ -> raise (CannotCoerceTo "a naming introduction pattern")
-
-let coerce_to_hint_base v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_intro_pattern) then
-    match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) -> Id.to_string id
-    | _ -> raise (CannotCoerceTo "a hint base name")
-  else raise (CannotCoerceTo "a hint base name")
-
-let coerce_to_int v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_int) then
-    out_gen (topwit wit_int) v
-  else raise (CannotCoerceTo "an integer")
-
-let coerce_to_constr env v =
-  let v = Value.normalize v in
-  let fail () = raise (CannotCoerceTo "a term") in
-  if has_type v (topwit wit_intro_pattern) then
-    match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) ->
-      (try ([], constr_of_id env id) with Not_found -> fail ())
-    | _ -> fail ()
-  else if has_type v (topwit wit_constr) then
-    let c = out_gen (topwit wit_constr) v in
-    ([], c)
-  else if has_type v (topwit wit_constr_under_binders) then
-    out_gen (topwit wit_constr_under_binders) v
-  else if has_type v (topwit wit_var) then
-    let id = out_gen (topwit wit_var) v in
-    (try [], constr_of_id env id with Not_found -> fail ())
-  else fail ()
-
-let coerce_to_uconstr env v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_uconstr) then
-    out_gen (topwit wit_uconstr) v
-  else
-    raise (CannotCoerceTo "an untyped term")
-
-let coerce_to_closed_constr env v =
-  let ids,c = coerce_to_constr env v in
-  let () = if not (List.is_empty ids) then raise (CannotCoerceTo "a term") in
-  c
-
-let coerce_to_evaluable_ref env v =
-  let fail () = raise (CannotCoerceTo "an evaluable reference") in
-  let v = Value.normalize v in
-  if has_type v (topwit wit_intro_pattern) then
-    match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) when is_variable env id -> EvalVarRef id
-    | _ -> fail ()
-  else if has_type v (topwit wit_var) then
-    let id = out_gen (topwit wit_var) v in
-    if Id.List.mem id (Termops.ids_of_context env) then EvalVarRef id
-    else fail ()
-  else if has_type v (topwit wit_ref) then
-    let open Globnames in
-    let r = out_gen (topwit wit_ref) v in
-    match r with
-    | VarRef var -> EvalVarRef var
-    | ConstRef c -> EvalConstRef c
-    | IndRef _ | ConstructRef _ -> fail ()
-  else
-    let ev = match Value.to_constr v with
-    | Some c when isConst c -> EvalConstRef (Univ.out_punivs (destConst c))
-    | Some c when isVar c -> EvalVarRef (destVar c)
-    | _ -> fail ()
-    in
-    if Tacred.is_evaluable env ev then ev else fail ()
-
-let coerce_to_constr_list env v =
-  let v = Value.to_list v in
-  match v with
-  | Some l ->
-    let map v = coerce_to_closed_constr env v in
-    List.map map l
-  | None -> raise (CannotCoerceTo "a term list")
-
-let coerce_to_intro_pattern_list loc env v =
-  match Value.to_list v with
-  | None -> raise (CannotCoerceTo "an intro pattern list")
-  | Some l ->
-    let map v = (loc, coerce_to_intro_pattern env v) in
-    List.map map l
-
-let coerce_to_hyp env v =
-  let fail () = raise (CannotCoerceTo "a variable") in
-  let v = Value.normalize v in
-  if has_type v (topwit wit_intro_pattern) then
-    match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) when is_variable env id -> id
-    | _ -> fail ()
-  else if has_type v (topwit wit_var) then
-    let id = out_gen (topwit wit_var) v in
-    if is_variable env id then id else fail ()
-  else match Value.to_constr v with
-  | Some c when isVar c -> destVar c
-  | _ -> fail ()
-
-let coerce_to_hyp_list env v =
-  let v = Value.to_list v in
-  match v with
-  | Some l ->
-    let map n = coerce_to_hyp env n in
-    List.map map l
-  | None -> raise (CannotCoerceTo "a variable list")
-
-(* Interprets a qualified name *)
-let coerce_to_reference env v =
-  let v = Value.normalize v in
-  match Value.to_constr v with
-  | Some c ->
-    begin
-      try Globnames.global_of_constr c
-      with Not_found -> raise (CannotCoerceTo "a reference")
-    end
-  | None -> raise (CannotCoerceTo "a reference")
-
-(* Quantified named or numbered hypothesis or hypothesis in context *)
-(* (as in Inversion) *)
-let coerce_to_quantified_hypothesis v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_intro_pattern) then
-    let v = out_gen (topwit wit_intro_pattern) v in
-    match v with
-    | _, IntroNaming (IntroIdentifier id) -> NamedHyp id
-    | _ -> raise (CannotCoerceTo "a quantified hypothesis")
-  else if has_type v (topwit wit_var) then
-    let id = out_gen (topwit wit_var) v in
-    NamedHyp id
-  else if has_type v (topwit wit_int) then
-    AnonHyp (out_gen (topwit wit_int) v)
-  else match Value.to_constr v with
-  | Some c when isVar c -> NamedHyp (destVar c)
-  | _ -> raise (CannotCoerceTo "a quantified hypothesis")
-
-(* Quantified named or numbered hypothesis or hypothesis in context *)
-(* (as in Inversion) *)
-let coerce_to_decl_or_quant_hyp env v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_int) then
-    AnonHyp (out_gen (topwit wit_int) v)
-  else
-    try coerce_to_quantified_hypothesis v
-    with CannotCoerceTo _ ->
-      raise (CannotCoerceTo "a declared or quantified hypothesis")
-
-let coerce_to_int_or_var_list v =
-  match Value.to_list v with
-  | None -> raise (CannotCoerceTo "an int list")
-  | Some l ->
-    let map n = ArgArg (coerce_to_int n) in
-    List.map map l
diff --git a/tactics/taccoerce.mli b/tactics/taccoerce.mli
deleted file mode 100644
index d26a477e..00000000
--- a/tactics/taccoerce.mli
+++ /dev/null
@@ -1,95 +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        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Misctypes
-open Pattern
-open Genarg
-
-(** Coercions from highest level generic arguments to actual data used by Ltac
-    interpretation. Those functions examinate dynamic types and try to return
-    something sensible according to the object content. *)
-
-exception CannotCoerceTo of string
-(** Exception raised whenever a coercion failed. *)
-
-(** {5 High-level access to values}
-
-  The [of_*] functions cast a given argument into a value. The [to_*] do the
-  converse, and return [None] if there is a type mismatch.
-
-*)
-
-module Value :
-sig
-  type t = tlevel generic_argument
-  (** Tactics manipulate [tlevel generic_argument]. *)
-
-  val normalize : t -> t
-  (** Eliminated the leading dynamic type casts. *)
-
-  val of_constr : constr -> t
-  val to_constr : t -> constr option
-  val of_uconstr : Glob_term.closed_glob_constr -> t
-  val to_uconstr : t -> Glob_term.closed_glob_constr option
-  val of_int : int -> t
-  val to_int : t -> int option
-  val to_list : t -> t list option
-end
-
-(** {5 Coercion functions} *)
-
-val coerce_to_constr_context : Value.t -> constr
-
-val coerce_to_ident : bool -> Environ.env -> Value.t -> Id.t
-
-val coerce_to_intro_pattern : Environ.env -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
-
-val coerce_to_intro_pattern_naming :
-  Environ.env -> Value.t -> intro_pattern_naming_expr
-
-val coerce_to_intro_pattern_naming :
-  Environ.env -> Value.t -> intro_pattern_naming_expr
-
-val coerce_to_hint_base : Value.t -> string
-
-val coerce_to_int : Value.t -> int
-
-val coerce_to_constr : Environ.env -> Value.t -> constr_under_binders
-
-val coerce_to_uconstr : Environ.env -> Value.t -> Glob_term.closed_glob_constr
-
-val coerce_to_closed_constr : Environ.env -> Value.t -> constr
-
-val coerce_to_evaluable_ref :
-  Environ.env -> Value.t -> evaluable_global_reference
-
-val coerce_to_constr_list : Environ.env -> Value.t -> constr list
-
-val coerce_to_intro_pattern_list :
-  Loc.t -> Environ.env -> Value.t -> Tacexpr.intro_patterns
-
-val coerce_to_hyp : Environ.env -> Value.t -> Id.t
-
-val coerce_to_hyp_list : Environ.env -> Value.t -> Id.t list
-
-val coerce_to_reference : Environ.env -> Value.t -> Globnames.global_reference
-
-val coerce_to_quantified_hypothesis : Value.t -> quantified_hypothesis
-
-val coerce_to_decl_or_quant_hyp : Environ.env -> Value.t -> quantified_hypothesis
-
-val coerce_to_int_or_var_list : Value.t -> int or_var list
-
-(** {5 Missing generic arguments} *)
-
-val wit_constr_context : (Empty.t, Empty.t, constr) genarg_type
-
-val wit_constr_under_binders : (Empty.t, Empty.t, constr_under_binders) genarg_type
diff --git a/tactics/tacenv.ml b/tactics/tacenv.ml
deleted file mode 100644
index dc89a71e..00000000
--- a/tactics/tacenv.ml
+++ /dev/null
@@ -1,142 +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        *)
-(************************************************************************)
-
-open Util
-open Genarg
-open Pp
-open Names
-open Tacexpr
-
-(** Tactic notations (TacAlias) *)
-
-type alias = KerName.t
-
-let alias_map = Summary.ref ~name:"tactic-alias"
-  (KNmap.empty : glob_tactic_expr KNmap.t)
-
-let register_alias key tac =
-  alias_map := KNmap.add key tac !alias_map
-
-let interp_alias key =
-  try KNmap.find key !alias_map
-  with Not_found -> Errors.anomaly (str "Unknown tactic alias: " ++ KerName.print key)
-
-let check_alias key = KNmap.mem key !alias_map
-
-(** ML tactic extensions (TacML) *)
-
-type ml_tactic =
-  typed_generic_argument list -> Geninterp.interp_sign -> unit Proofview.tactic
-
-module MLName =
-struct
-  type t = ml_tactic_name
-  let compare tac1 tac2 =
-    let c = String.compare tac1.mltac_tactic tac2.mltac_tactic in
-    if c = 0 then String.compare tac1.mltac_plugin tac2.mltac_plugin
-    else c
-end
-
-module MLTacMap = Map.Make(MLName)
-
-let pr_tacname t =
-  str t.mltac_plugin ++ str "::" ++ str t.mltac_tactic
-
-let tac_tab = ref MLTacMap.empty
-
-let register_ml_tactic ?(overwrite = false) s (t : ml_tactic) =
-  let () =
-    if MLTacMap.mem s !tac_tab then
-      if overwrite then
-        let () = tac_tab := MLTacMap.remove s !tac_tab in
-        msg_warning (str "Overwriting definition of tactic " ++ pr_tacname s)
-      else
-        Errors.anomaly (str "Cannot redeclare tactic " ++ pr_tacname s ++ str ".")
-  in
-  tac_tab := MLTacMap.add s t !tac_tab
-
-let interp_ml_tactic s =
-  try
-    MLTacMap.find s !tac_tab
-  with Not_found ->
-    Errors.errorlabstrm ""
-      (str "The tactic " ++ pr_tacname s ++ str " is not installed.")
-
-(***************************************************************************)
-(* Tactic registration *)
-
-(* Summary and Object declaration *)
-
-open Nametab
-open Libobject
-
-type ltac_entry = {
-  tac_for_ml : bool;
-  tac_body : glob_tactic_expr;
-  tac_redef : ModPath.t list;
-}
-
-let mactab =
-  Summary.ref (KNmap.empty : ltac_entry KNmap.t)
-    ~name:"tactic-definition"
-
-let ltac_entries () = !mactab
-
-let interp_ltac r = (KNmap.find r !mactab).tac_body
-
-let is_ltac_for_ml_tactic r = (KNmap.find r !mactab).tac_for_ml
-
-let add kn b t =
-  let entry = { tac_for_ml = b; tac_body = t; tac_redef = [] } in
-  mactab := KNmap.add kn entry !mactab
-
-let replace kn path t =
-  let (path, _, _) = KerName.repr path in
-  let entry _ e = { e with tac_body = t; tac_redef = path :: e.tac_redef } in
-  mactab := KNmap.modify kn entry !mactab
-
-let load_md i ((sp, kn), (local, id, b, t)) = match id with
-| None ->
-  let () = if not local then Nametab.push_tactic (Until i) sp kn in
-  add kn b t
-| Some kn0 -> replace kn0 kn t
-
-let open_md i ((sp, kn), (local, id, b, t)) = match id with
-| None ->
-  let () = if not local then Nametab.push_tactic (Exactly i) sp kn in
-  add kn b t
-| Some kn0 -> replace kn0 kn t
-
-let cache_md ((sp, kn), (local, id ,b, t)) = match id with
-| None ->
-  let () = Nametab.push_tactic (Until 1) sp kn in
-  add kn b t
-| Some kn0 -> replace kn0 kn t
-
-let subst_kind subst id = match id with
-| None -> None
-| Some kn -> Some (Mod_subst.subst_kn subst kn)
-
-let subst_md (subst, (local, id, b, t)) =
-  (local, subst_kind subst id, b, Tacsubst.subst_tactic subst t)
-
-let classify_md (local, _, _, _ as o) = Substitute o
-
-let inMD : bool * Nametab.ltac_constant option * bool * glob_tactic_expr -> obj =
-  declare_object {(default_object "TAC-DEFINITION") with
-     cache_function  = cache_md;
-     load_function   = load_md;
-     open_function   = open_md;
-     subst_function = subst_md;
-     classify_function = classify_md}
-
-let register_ltac for_ml local id tac =
-  ignore (Lib.add_leaf id (inMD (local, None, for_ml, tac)))
-
-let redefine_ltac local kn tac =
-  Lib.add_anonymous_leaf (inMD (local, Some kn, false, tac))
diff --git a/tactics/tacenv.mli b/tactics/tacenv.mli
deleted file mode 100644
index 87cdce65..00000000
--- a/tactics/tacenv.mli
+++ /dev/null
@@ -1,71 +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        *)
-(************************************************************************)
-
-open Genarg
-open Names
-open Tacexpr
-
-(** This module centralizes the various ways of registering tactics. *)
-
-(** {5 Tactic notations} *)
-
-type alias = KerName.t
-(** Type of tactic alias, used in the [TacAlias] node. *)
-
-val register_alias : alias -> glob_tactic_expr -> unit
-(** Register a tactic alias. *)
-
-val interp_alias : alias -> glob_tactic_expr
-(** Recover the the body of an alias. Raises an anomaly if it does not exist. *)
-
-val check_alias : alias -> bool
-(** Returns [true] if an alias is defined, false otherwise. *)
-
-(** {5 Coq tactic definitions} *)
-
-val register_ltac : bool -> bool -> Id.t -> glob_tactic_expr -> unit
-(** Register a new Ltac with the given name and body.
-
-    The first boolean indicates whether this is done from ML side, rather than
-    Coq side. If the second boolean flag is set to true, then this is a local
-    definition. It also puts the Ltac name in the nametab, so that it can be
-    used unqualified. *)
-
-val redefine_ltac : bool -> KerName.t -> glob_tactic_expr -> unit
-(** Replace a Ltac with the given name and body. If the boolean flag is set
-    to true, then this is a local redefinition. *)
-
-val interp_ltac : KerName.t -> glob_tactic_expr
-(** Find a user-defined tactic by name. Raise [Not_found] if it is absent. *)
-
-val is_ltac_for_ml_tactic : KerName.t -> bool
-(** Whether the tactic is defined from ML-side *)
-
-type ltac_entry = {
-  tac_for_ml : bool;
-  (** Whether the tactic is defined from ML-side *)
-  tac_body : glob_tactic_expr;
-  (** The current body of the tactic *)
-  tac_redef : ModPath.t list;
-  (** List of modules redefining the tactic in reverse chronological order *)
-}
-
-val ltac_entries : unit -> ltac_entry KNmap.t
-(** Low-level access to all Ltac entries currently defined. *)
-
-(** {5 ML tactic extensions} *)
-
-type ml_tactic =
-  typed_generic_argument list -> Geninterp.interp_sign -> unit Proofview.tactic
-(** Type of external tactics, used by [TacML]. *)
-
-val register_ml_tactic : ?overwrite:bool -> ml_tactic_name -> ml_tactic -> unit
-(** Register an external tactic. *)
-
-val interp_ml_tactic : ml_tactic_name -> ml_tactic
-(** Get the named tactic. Raises a user error if it does not exist. *)
diff --git a/tactics/tacintern.ml b/tactics/tacintern.ml
deleted file mode 100644
index 11f2c594..00000000
--- a/tactics/tacintern.ml
+++ /dev/null
@@ -1,874 +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        *)
-(************************************************************************)
-
-open Pattern
-open Pp
-open Genredexpr
-open Glob_term
-open Tacred
-open Errors
-open Util
-open Names
-open Nameops
-open Libnames
-open Globnames
-open Nametab
-open Smartlocate
-open Constrexpr
-open Termops
-open Tacexpr
-open Genarg
-open Constrarg
-open Misctypes
-open Locus
-
-(** Globalization of tactic expressions :
-    Conversion from [raw_tactic_expr] to [glob_tactic_expr] *)
-
-let dloc = Loc.ghost
-
-let error_global_not_found_loc (loc,qid) =
-  error_global_not_found_loc loc qid
-
-let error_syntactic_metavariables_not_allowed loc =
-  user_err_loc
-    (loc,"out_ident",
-     str "Syntactic metavariables allowed only in quotations.")
-
-let error_tactic_expected loc =
-  user_err_loc (loc,"",str "Tactic expected.")
-
-(** Generic arguments *)
-
-type glob_sign = Genintern.glob_sign = {
-  ltacvars : Id.Set.t;
-     (* ltac variables and the subset of vars introduced by Intro/Let/... *)
-  genv : Environ.env }
-
-let fully_empty_glob_sign =
-  { ltacvars = Id.Set.empty; genv = Environ.empty_env }
-
-let make_empty_glob_sign () =
-  { fully_empty_glob_sign with genv = Global.env () }
-
-(* We have identifier <| global_reference <| constr *)
-
-let find_ident id ist =
-  Id.Set.mem id ist.ltacvars ||
-  Id.List.mem id (ids_of_named_context (Environ.named_context ist.genv))
-
-(* a "var" is a ltac var or a var introduced by an intro tactic *)
-let find_var id ist = Id.Set.mem id ist.ltacvars
-
-let find_hyp id ist =
-  Id.List.mem id (ids_of_named_context (Environ.named_context ist.genv))
-
-(* Globalize a name introduced by Intro/LetTac/... ; it is allowed to *)
-(* be fresh in which case it is binding later on *)
-let intern_ident s ist id =
-  (* We use identifier both for variables and new names; thus nothing to do *)
-  if not (find_ident id ist) then s := Id.Set.add id !s;
-  id
-
-let intern_name l ist = function
-  | Anonymous -> Anonymous
-  | Name id -> Name (intern_ident l ist id)
-
-let strict_check = ref false
-
-let adjust_loc loc = if !strict_check then dloc else loc
-
-(* Globalize a name which must be bound -- actually just check it is bound *)
-let intern_hyp ist (loc,id as locid) =
-  if not !strict_check then
-    locid
-  else if find_ident id ist then
-    (dloc,id)
-  else
-    Pretype_errors.error_var_not_found_loc loc id
-
-let intern_or_var f ist = function
-  | ArgVar locid -> ArgVar (intern_hyp ist locid)
-  | ArgArg x -> ArgArg (f x)
-
-let intern_int_or_var = intern_or_var (fun (n : int) -> n)
-let intern_id_or_var = intern_or_var (fun (id : Id.t) -> id)
-let intern_string_or_var = intern_or_var (fun (s : string) -> s)
-
-let intern_global_reference ist = function
-  | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
-  | r ->
-      let loc,_ as lqid = qualid_of_reference r in
-      try ArgArg (loc,locate_global_with_alias lqid)
-      with Not_found -> error_global_not_found_loc lqid
-
-let intern_ltac_variable ist = function
-  | Ident (loc,id) ->
-      if find_var id ist then
-	(* A local variable of any type *)
-	ArgVar (loc,id)
-      else raise Not_found
-  | _ ->
-      raise Not_found
-
-let intern_constr_reference strict ist = function
-  | Ident (_,id) as r when not strict && find_hyp id ist ->
-      GVar (dloc,id), Some (CRef (r,None))
-  | Ident (_,id) as r when find_var id ist ->
-      GVar (dloc,id), if strict then None else Some (CRef (r,None))
-  | r ->
-      let loc,_ as lqid = qualid_of_reference r in
-      GRef (loc,locate_global_with_alias lqid,None), 
-	if strict then None else Some (CRef (r,None))
-
-let intern_move_location ist = function
-  | MoveAfter id -> MoveAfter (intern_hyp ist id)
-  | MoveBefore id -> MoveBefore (intern_hyp ist id)
-  | MoveFirst -> MoveFirst
-  | MoveLast -> MoveLast
-
-(* Internalize an isolated reference in position of tactic *)
-
-let intern_isolated_global_tactic_reference r =
-  let (loc,qid) = qualid_of_reference r in
-  TacCall (loc,ArgArg (loc,locate_tactic qid),[])
-
-let intern_isolated_tactic_reference strict ist r =
-  (* An ltac reference *)
-  try Reference (intern_ltac_variable ist r)
-  with Not_found ->
-  (* A global tactic *)
-  try intern_isolated_global_tactic_reference r
-  with Not_found ->
-  (* Tolerance for compatibility, allow not to use "constr:" *)
-  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
-  with Not_found ->
-  (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
-
-(* Internalize an applied tactic reference *)
-
-let intern_applied_global_tactic_reference r =
-  let (loc,qid) = qualid_of_reference r in
-  ArgArg (loc,locate_tactic qid)
-
-let intern_applied_tactic_reference ist r =
-  (* An ltac reference *)
-  try intern_ltac_variable ist r
-  with Not_found ->
-  (* A global tactic *)
-  try intern_applied_global_tactic_reference r
-  with Not_found ->
-  (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
-
-(* Intern a reference parsed in a non-tactic entry *)
-
-let intern_non_tactic_reference strict ist r =
-  (* An ltac reference *)
-  try Reference (intern_ltac_variable ist r)
-  with Not_found ->
-  (* A constr reference *)
-  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
-  with Not_found ->
-  (* Tolerance for compatibility, allow not to use "ltac:" *)
-  try intern_isolated_global_tactic_reference r
-  with Not_found ->
-  (* By convention, use IntroIdentifier for unbound ident, when not in a def *)
-  match r with
-  | Ident (loc,id) when not strict ->
-    let ipat = in_gen (glbwit wit_intro_pattern) (loc, IntroNaming (IntroIdentifier id)) in
-    TacGeneric ipat
-  | _ ->
-  (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
-
-let intern_message_token ist = function
-  | (MsgString _ | MsgInt _ as x) -> x
-  | MsgIdent id -> MsgIdent (intern_hyp ist id)
-
-let intern_message ist = List.map (intern_message_token ist)
-
-let intern_quantified_hypothesis ist = function
-  | AnonHyp n -> AnonHyp n
-  | NamedHyp id ->
-      (* Uncomment to disallow "intros until n" in ltac when n is not bound *)
-      NamedHyp ((*snd (intern_hyp ist (dloc,*)id(* ))*))
-
-let intern_binding_name ist x =
-  (* We use identifier both for variables and binding names *)
-  (* Todo: consider the body of the lemma to which the binding refer
-     and if a term w/o ltac vars, check the name is indeed quantified *)
-  x
-
-let intern_constr_gen allow_patvar isarity {ltacvars=lfun; genv=env} c =
-  let warn = if !strict_check then fun x -> x else Constrintern.for_grammar in
-  let scope = if isarity then Pretyping.IsType else Pretyping.WithoutTypeConstraint in
-  let ltacvars = {
-    Constrintern.ltac_vars = lfun;
-    ltac_bound = Id.Set.empty;
-  } in
-  let c' =
-    warn (Constrintern.intern_gen scope ~allow_patvar ~ltacvars env) c
-  in
-  (c',if !strict_check then None else Some c)
-
-let intern_constr = intern_constr_gen false false
-let intern_type = intern_constr_gen false true
-
-(* Globalize bindings *)
-let intern_binding ist (loc,b,c) =
-  (loc,intern_binding_name ist b,intern_constr ist c)
-
-let intern_bindings ist = function
-  | NoBindings -> NoBindings
-  | ImplicitBindings l -> ImplicitBindings (List.map (intern_constr ist) l)
-  | ExplicitBindings l -> ExplicitBindings (List.map (intern_binding ist) l)
-
-let intern_constr_with_bindings ist (c,bl) =
-  (intern_constr ist c, intern_bindings ist bl)
-
-let intern_constr_with_bindings_arg ist (clear,c) =
-  (clear,intern_constr_with_bindings ist c)
-
-let rec intern_intro_pattern lf ist = function
-  | loc, IntroNaming pat ->
-      loc, IntroNaming (intern_intro_pattern_naming lf ist pat)
-  | loc, IntroAction pat ->
-      loc, IntroAction (intern_intro_pattern_action lf ist pat)
-  | loc, IntroForthcoming _ as x -> x
-
-and intern_intro_pattern_naming lf ist = function
-  | IntroIdentifier id ->
-      IntroIdentifier (intern_ident lf ist id)
-  | IntroFresh id ->
-      IntroFresh (intern_ident lf ist id)
-  | IntroAnonymous as x -> x
-
-and intern_intro_pattern_action lf ist = function
-  | IntroOrAndPattern l ->
-      IntroOrAndPattern (intern_or_and_intro_pattern lf ist l)
-  | IntroInjection l ->
-      IntroInjection (List.map (intern_intro_pattern lf ist) l)
-  | IntroWildcard | IntroRewrite _ as x -> x
-  | IntroApplyOn (c,pat) ->
-      IntroApplyOn (intern_constr ist c, intern_intro_pattern lf ist pat)
-
-and intern_or_and_intro_pattern lf ist =
-  List.map (List.map (intern_intro_pattern lf ist))
-
-let intern_or_and_intro_pattern_loc lf ist = function
-  | ArgVar (_,id) as x ->
-      if find_var id ist then x
-      else error "Disjunctive/conjunctive introduction pattern expected."
-  | ArgArg (loc,l) -> ArgArg (loc,intern_or_and_intro_pattern lf ist l)
-
-let intern_intro_pattern_naming_loc lf ist (loc,pat) =
-  (loc,intern_intro_pattern_naming lf ist pat)
-
-  (* TODO: catch ltac vars *)
-let intern_induction_arg ist = function
-  | clear,ElimOnConstr c -> clear,ElimOnConstr (intern_constr_with_bindings ist c)
-  | clear,ElimOnAnonHyp n as x -> x
-  | clear,ElimOnIdent (loc,id) ->
-      if !strict_check then
-	(* If in a defined tactic, no intros-until *)
-	match intern_constr ist (CRef (Ident (dloc,id), None)) with
-	| GVar (loc,id),_ -> clear,ElimOnIdent (loc,id)
-	| c -> clear,ElimOnConstr (c,NoBindings)
-      else
-	clear,ElimOnIdent (loc,id)
-
-let short_name = function
-  | AN (Ident (loc,id)) when not !strict_check -> Some (loc,id)
-  | _ -> None
-
-let intern_evaluable_global_reference ist r =
-  let lqid = qualid_of_reference r in
-  try evaluable_of_global_reference ist.genv (locate_global_with_alias ~head:true lqid)
-  with Not_found ->
-  match r with
-  | Ident (loc,id) when not !strict_check -> EvalVarRef id
-  | _ -> error_global_not_found_loc lqid
-
-let intern_evaluable_reference_or_by_notation ist = function
-  | AN r -> intern_evaluable_global_reference ist r
-  | ByNotation (loc,ntn,sc) ->
-      evaluable_of_global_reference ist.genv
-      (Notation.interp_notation_as_global_reference loc
-        (function ConstRef _ | VarRef _ -> true | _ -> false) ntn sc)
-
-(* Globalize a reduction expression *)
-let intern_evaluable ist = function
-  | AN (Ident (loc,id)) when find_var id ist -> ArgVar (loc,id)
-  | AN (Ident (loc,id)) when not !strict_check && find_hyp id ist ->
-      ArgArg (EvalVarRef id, Some (loc,id))
-  | r ->
-      let e = intern_evaluable_reference_or_by_notation ist r in
-      let na = short_name r in
-      ArgArg (e,na)
-
-let intern_unfold ist (l,qid) = (l,intern_evaluable ist qid)
-
-let intern_flag ist red =
-  { red with rConst = List.map (intern_evaluable ist) red.rConst }
-
-let intern_constr_with_occurrences ist (l,c) = (l,intern_constr ist c)
-
-let intern_constr_pattern ist ~as_type ~ltacvars pc =
-  let ltacvars = {
-    Constrintern.ltac_vars = ltacvars;
-    ltac_bound = Id.Set.empty;
-  } in
-  let metas,pat = Constrintern.intern_constr_pattern
-    ist.genv ~as_type ~ltacvars pc
-  in
-  let c = intern_constr_gen true false ist pc in
-  metas,(c,pat)
-
-let dummy_pat = PRel 0
-
-let intern_typed_pattern ist p =
-  (* we cannot ensure in non strict mode that the pattern is closed *)
-  (* keeping a constr_expr copy is too complicated and we want anyway to *)
-  (* type it, so we remember the pattern as a glob_constr only *)
-  (intern_constr_gen true false ist p,dummy_pat)
-
-let rec intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
-  let interp_ref r =
-    try Inl (intern_evaluable ist r)
-    with e when Logic.catchable_exception e ->
-      (* Compatibility. In practice, this means that the code above
-         is useless. Still the idea of having either an evaluable
-         ref or a pattern seems interesting, with "head" reduction
-         in case of an evaluable ref, and "strong" reduction in the
-         subterm matched when a pattern *)
-      let loc = loc_of_smart_reference r in
-      let r = match r with
-      | AN r -> r
-      | _ -> Qualid (loc,qualid_of_path (path_of_global (smart_global r))) in
-      let sign = { Constrintern.ltac_vars = ist.ltacvars; Constrintern.ltac_bound = Id.Set.empty } in
-      let c = Constrintern.interp_reference sign r in
-      match c with
-      | GRef (_,r,None) ->
-          Inl (ArgArg (evaluable_of_global_reference ist.genv r,None))
-      | GVar (_,id) ->
-          let r = evaluable_of_global_reference ist.genv (VarRef id) in
-          Inl (ArgArg (r,None))
-      | _ ->
-          Inr ((c,None),dummy_pat) in
-  (l, match p with
-  | Inl r -> interp_ref r
-  | Inr (CAppExpl(_,(None,r,None),[])) ->
-      (* We interpret similarly @ref and ref *)
-      interp_ref (AN r)
-  | Inr c ->
-      Inr (intern_typed_pattern ist c))
-
-(* This seems fairly hacky, but it's the first way I've found to get proper
-   globalization of [unfold].  --adamc *)
-let dump_glob_red_expr = function
-  | Unfold occs -> List.iter (fun (_, r) ->
-    try
-      Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
-	(Smartlocate.smart_global r)
-    with e when Errors.noncritical e -> ()) occs
-  | Cbv grf | Lazy grf ->
-    List.iter (fun r ->
-      try
-        Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
-	  (Smartlocate.smart_global r)
-      with e when Errors.noncritical e -> ()) grf.rConst
-  | _ -> ()
-
-let intern_red_expr ist = function
-  | Unfold l -> Unfold (List.map (intern_unfold ist) l)
-  | Fold l -> Fold (List.map (intern_constr ist) l)
-  | Cbv f -> Cbv (intern_flag ist f)
-  | Cbn f -> Cbn (intern_flag ist f)
-  | Lazy f -> Lazy (intern_flag ist f)
-  | Pattern l -> Pattern (List.map (intern_constr_with_occurrences ist) l)
-  | Simpl (f,o) ->
-     Simpl (intern_flag ist f,
-	    Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
-  | CbvVm o -> CbvVm (Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
-  | CbvNative o -> CbvNative (Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
-  | (Red _ | Hnf | ExtraRedExpr _ as r ) -> r
-
-let intern_in_hyp_as ist lf (id,ipat) =
-  (intern_hyp ist id, Option.map (intern_intro_pattern lf ist) ipat)
-
-let intern_hyp_list ist = List.map (intern_hyp ist)
-
-let intern_inversion_strength lf ist = function
-  | NonDepInversion (k,idl,ids) ->
-      NonDepInversion (k,intern_hyp_list ist idl,
-      Option.map (intern_or_and_intro_pattern_loc lf ist) ids)
-  | DepInversion (k,copt,ids) ->
-      DepInversion (k, Option.map (intern_constr ist) copt,
-      Option.map (intern_or_and_intro_pattern_loc lf ist) ids)
-  | InversionUsing (c,idl) ->
-      InversionUsing (intern_constr ist c, intern_hyp_list ist idl)
-
-(* Interprets an hypothesis name *)
-let intern_hyp_location ist ((occs,id),hl) =
-  ((Locusops.occurrences_map (List.map (intern_int_or_var ist)) occs,
-   intern_hyp ist id), hl)
-
-(* Reads a pattern *)
-let intern_pattern ist ?(as_type=false) ltacvars = function
-  | Subterm (b,ido,pc) ->
-      let (metas,pc) = intern_constr_pattern ist ~as_type ~ltacvars pc in
-      ido, metas, Subterm (b,ido,pc)
-  | Term pc ->
-      let (metas,pc) = intern_constr_pattern ist ~as_type ~ltacvars pc in
-      None, metas, Term pc
-
-let intern_constr_may_eval ist = function
-  | ConstrEval (r,c) -> ConstrEval (intern_red_expr ist r,intern_constr ist c)
-  | ConstrContext (locid,c) ->
-      ConstrContext (intern_hyp ist locid,intern_constr ist c)
-  | ConstrTypeOf c -> ConstrTypeOf (intern_constr ist c)
-  | ConstrTerm c -> ConstrTerm (intern_constr ist c)
-
-let name_cons accu = function
-| Anonymous -> accu
-| Name id -> Id.Set.add id accu
-
-let opt_cons accu = function
-| None -> accu
-| Some id -> Id.Set.add id accu
-
-(* Reads the hypotheses of a "match goal" rule *)
-let rec intern_match_goal_hyps ist lfun = function
-  | (Hyp ((_,na) as locna,mp))::tl ->
-      let ido, metas1, pat = intern_pattern ist ~as_type:true lfun mp in
-      let lfun, metas2, hyps = intern_match_goal_hyps ist lfun tl in
-      let lfun' = name_cons (opt_cons lfun ido) na in
-      lfun', metas1@metas2, Hyp (locna,pat)::hyps
-  | (Def ((_,na) as locna,mv,mp))::tl ->
-      let ido, metas1, patv = intern_pattern ist ~as_type:false lfun mv in
-      let ido', metas2, patt = intern_pattern ist ~as_type:true lfun mp in
-      let lfun, metas3, hyps = intern_match_goal_hyps ist lfun tl in
-      let lfun' = name_cons (opt_cons (opt_cons lfun ido) ido') na in
-      lfun', metas1@metas2@metas3, Def (locna,patv,patt)::hyps
-  | [] -> lfun, [], []
-
-(* Utilities *)
-let extract_let_names lrc =
-  let fold accu ((loc, name), _) =
-    if Id.Set.mem name accu then user_err_loc
-      (loc, "glob_tactic", str "This variable is bound several times.")
-    else Id.Set.add name accu
-  in
-  List.fold_left fold Id.Set.empty lrc
-
-let clause_app f = function
-    { onhyps=None; concl_occs=nl } ->
-      { onhyps=None; concl_occs=nl }
-  | { onhyps=Some l; concl_occs=nl } ->
-      { onhyps=Some(List.map f l); concl_occs=nl}
-
-let map_raw wit f ist x =
-  in_gen (glbwit wit) (f ist (out_gen (rawwit wit) x))
-
-(* Globalizes tactics : raw_tactic_expr -> glob_tactic_expr *)
-let rec intern_atomic lf ist x =
-  match (x:raw_atomic_tactic_expr) with
-  (* Basic tactics *)
-  | TacIntroPattern l ->
-      TacIntroPattern (List.map (intern_intro_pattern lf ist) l)
-  | TacIntroMove (ido,hto) ->
-      TacIntroMove (Option.map (intern_ident lf ist) ido,
-                    intern_move_location ist hto)
-  | TacExact c -> TacExact (intern_constr ist c)
-  | TacApply (a,ev,cb,inhyp) ->
-      TacApply (a,ev,List.map (intern_constr_with_bindings_arg ist) cb,
-                Option.map (intern_in_hyp_as ist lf) inhyp)
-  | TacElim (ev,cb,cbo) ->
-      TacElim (ev,intern_constr_with_bindings_arg ist cb,
-               Option.map (intern_constr_with_bindings ist) cbo)
-  | TacCase (ev,cb) -> TacCase (ev,intern_constr_with_bindings_arg ist cb)
-  | TacFix (idopt,n) -> TacFix (Option.map (intern_ident lf ist) idopt,n)
-  | TacMutualFix (id,n,l) ->
-      let f (id,n,c) = (intern_ident lf ist id,n,intern_type ist c) in
-      TacMutualFix (intern_ident lf ist id, n, List.map f l)
-  | TacCofix idopt -> TacCofix (Option.map (intern_ident lf ist) idopt)
-  | TacMutualCofix (id,l) ->
-      let f (id,c) = (intern_ident lf ist id,intern_type ist c) in
-      TacMutualCofix (intern_ident lf ist id, List.map f l)
-  | TacAssert (b,otac,ipat,c) ->
-      TacAssert (b,Option.map (intern_pure_tactic ist) otac,
-                 Option.map (intern_intro_pattern lf ist) ipat,
-                 intern_constr_gen false (not (Option.is_empty otac)) ist c)
-  | TacGeneralize cl ->
-      TacGeneralize (List.map (fun (c,na) ->
-	               intern_constr_with_occurrences ist c,
-                       intern_name lf ist na) cl)
-  | TacGeneralizeDep c -> TacGeneralizeDep (intern_constr ist c)
-  | TacLetTac (na,c,cls,b,eqpat) ->
-      let na = intern_name lf ist na in
-      TacLetTac (na,intern_constr ist c,
-                 (clause_app (intern_hyp_location ist) cls),b,
-		 (Option.map (intern_intro_pattern_naming_loc lf ist) eqpat))
-
-  (* Automation tactics *)
-  | TacTrivial (d,lems,l) -> TacTrivial (d,List.map (intern_constr ist) lems,l)
-  | TacAuto (d,n,lems,l) ->
-      TacAuto (d,Option.map (intern_int_or_var ist) n,
-        List.map (intern_constr ist) lems,l)
-
-  (* Derived basic tactics *)
-  | TacInductionDestruct (ev,isrec,(l,el)) ->
-      TacInductionDestruct (ev,isrec,(List.map (fun (c,(ipato,ipats),cls) ->
-	      (intern_induction_arg ist c,
-               (Option.map (intern_intro_pattern_naming_loc lf ist) ipato,
-               Option.map (intern_or_and_intro_pattern_loc lf ist) ipats),
-               Option.map (clause_app (intern_hyp_location ist)) cls)) l,
-               Option.map (intern_constr_with_bindings ist) el))
-  | TacDoubleInduction (h1,h2) ->
-      let h1 = intern_quantified_hypothesis ist h1 in
-      let h2 = intern_quantified_hypothesis ist h2 in
-      TacDoubleInduction (h1,h2)
-  (* Context management *)
-  | TacClear (b,l) -> TacClear (b,List.map (intern_hyp ist) l)
-  | TacClearBody l -> TacClearBody (List.map (intern_hyp ist) l)
-  | TacMove (id1,id2) ->
-    TacMove (intern_hyp ist id1,intern_move_location ist id2)
-  | TacRename l ->
-      TacRename (List.map (fun (id1,id2) ->
-			     intern_hyp ist id1,
-			     intern_hyp ist id2) l)
-
-  (* Constructors *)
-  | TacSplit (ev,bll) -> TacSplit (ev,List.map (intern_bindings ist) bll)
-
-  (* Conversion *)
-  | TacReduce (r,cl) ->
-      dump_glob_red_expr r;
-      TacReduce (intern_red_expr ist r, clause_app (intern_hyp_location ist) cl)
-  | TacChange (None,c,cl) ->
-      let is_onhyps = match cl.onhyps with
-      | None | Some [] -> true
-      | _ -> false
-      in
-      let is_onconcl = match cl.concl_occs with
-      | AllOccurrences | NoOccurrences -> true
-      | _ -> false
-      in
-      TacChange (None,
-        (if is_onhyps && is_onconcl
-         then intern_type ist c else intern_constr ist c),
-	clause_app (intern_hyp_location ist) cl)
-  | TacChange (Some p,c,cl) ->
-      TacChange (Some (intern_typed_pattern ist p),intern_constr ist c,
-	clause_app (intern_hyp_location ist) cl)
-
-  (* Equivalence relations *)
-  | TacSymmetry idopt ->
-      TacSymmetry (clause_app (intern_hyp_location ist) idopt)
-
-  (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) ->
-      TacRewrite
-	(ev,
-	List.map (fun (b,m,c) -> (b,m,intern_constr_with_bindings_arg ist c)) l,
-	clause_app (intern_hyp_location ist) cl,
-	Option.map (intern_pure_tactic ist) by)
-  | TacInversion (inv,hyp) ->
-      TacInversion (intern_inversion_strength lf ist inv,
-        intern_quantified_hypothesis ist hyp)
-
-and intern_tactic onlytac ist tac = snd (intern_tactic_seq onlytac ist tac)
-
-and intern_tactic_seq onlytac ist = function
-  | TacAtom (loc,t) ->
-      let lf = ref ist.ltacvars in
-      let t = intern_atomic lf ist t in
-      !lf, TacAtom (adjust_loc loc, t)
-  | TacFun tacfun -> ist.ltacvars, TacFun (intern_tactic_fun ist tacfun)
-  | TacLetIn (isrec,l,u) ->
-      let ltacvars = Id.Set.union (extract_let_names l) ist.ltacvars in
-      let ist' = { ist with ltacvars } in
-      let l = List.map (fun (n,b) ->
-	  (n,intern_tacarg !strict_check false (if isrec then ist' else ist) b)) l in
-      ist.ltacvars, TacLetIn (isrec,l,intern_tactic onlytac ist' u)
-
-  | TacMatchGoal (lz,lr,lmr) ->
-      ist.ltacvars, TacMatchGoal(lz,lr, intern_match_rule onlytac ist lmr)
-  | TacMatch (lz,c,lmr) ->
-      ist.ltacvars,
-      TacMatch (lz,intern_tactic_or_tacarg ist c,intern_match_rule onlytac ist lmr)
-  | TacId l -> ist.ltacvars, TacId (intern_message ist l)
-  | TacFail (g,n,l) ->
-      ist.ltacvars, TacFail (g,intern_int_or_var ist n,intern_message ist l)
-  | TacProgress tac -> ist.ltacvars, TacProgress (intern_pure_tactic ist tac)
-  | TacShowHyps tac -> ist.ltacvars, TacShowHyps (intern_pure_tactic ist tac)
-  | TacAbstract (tac,s) ->
-      ist.ltacvars, TacAbstract (intern_pure_tactic ist tac,s)
-  | TacThen (t1,t2) ->
-      let lfun', t1 = intern_tactic_seq onlytac ist t1 in
-      let lfun'', t2 = intern_tactic_seq onlytac { ist with ltacvars = lfun' } t2 in
-      lfun'', TacThen (t1,t2)
-  | TacDispatch tl ->
-      ist.ltacvars , TacDispatch (List.map (intern_pure_tactic ist) tl)
-  | TacExtendTac (tf,t,tl) ->
-      ist.ltacvars ,
-      TacExtendTac (Array.map (intern_pure_tactic ist) tf,
-                    intern_pure_tactic ist t,
-		    Array.map (intern_pure_tactic ist) tl)
-  | TacThens3parts (t1,tf,t2,tl) ->
-      let lfun', t1 = intern_tactic_seq onlytac ist t1 in
-      let ist' = { ist with ltacvars = lfun' } in
-      (* Que faire en cas de (tac complexe avec Match et Thens; tac2) ?? *)
-      lfun', TacThens3parts (t1,Array.map (intern_pure_tactic ist') tf,intern_pure_tactic ist' t2,
-		       Array.map (intern_pure_tactic ist') tl)
-  | TacThens (t,tl) ->
-      let lfun', t = intern_tactic_seq true ist t in
-      let ist' = { ist with ltacvars = lfun' } in
-      (* Que faire en cas de (tac complexe avec Match et Thens; tac2) ?? *)
-      lfun', TacThens (t, List.map (intern_pure_tactic ist') tl)
-  | TacDo (n,tac) ->
-      ist.ltacvars, TacDo (intern_int_or_var ist n,intern_pure_tactic ist tac)
-  | TacTry tac -> ist.ltacvars, TacTry (intern_pure_tactic ist tac)
-  | TacInfo tac -> ist.ltacvars, TacInfo (intern_pure_tactic ist tac)
-  | TacRepeat tac -> ist.ltacvars, TacRepeat (intern_pure_tactic ist tac)
-  | TacTimeout (n,tac) ->
-      ist.ltacvars, TacTimeout (intern_int_or_var ist n,intern_tactic onlytac ist tac)
-  | TacTime (s,tac) ->
-      ist.ltacvars, TacTime (s,intern_tactic onlytac ist tac)
-  | TacOr (tac1,tac2) ->
-      ist.ltacvars, TacOr (intern_pure_tactic ist tac1,intern_pure_tactic ist tac2)
-  | TacOnce tac ->
-      ist.ltacvars, TacOnce (intern_pure_tactic ist tac)
-  | TacExactlyOnce tac ->
-      ist.ltacvars, TacExactlyOnce (intern_pure_tactic ist tac)
-  | TacIfThenCatch (tac,tact,tace) ->
-      ist.ltacvars,
-      TacIfThenCatch (
-        intern_pure_tactic ist tac,
-        intern_pure_tactic ist tact,
-        intern_pure_tactic ist tace)
-  | TacOrelse (tac1,tac2) ->
-      ist.ltacvars, TacOrelse (intern_pure_tactic ist tac1,intern_pure_tactic ist tac2)
-  | TacFirst l -> ist.ltacvars, TacFirst (List.map (intern_pure_tactic ist) l)
-  | TacSolve l -> ist.ltacvars, TacSolve (List.map (intern_pure_tactic ist) l)
-  | TacComplete tac -> ist.ltacvars, TacComplete (intern_pure_tactic ist tac)
-  | TacArg (loc,a) -> ist.ltacvars, intern_tactic_as_arg loc onlytac ist a
-
-  (* For extensions *)
-  | TacAlias (loc,s,l) ->
-      let l = List.map (fun (id,a) -> (id,intern_genarg ist a)) l in
-      ist.ltacvars, TacAlias (loc,s,l)
-  | TacML (loc,opn,l) ->
-      let _ignore = Tacenv.interp_ml_tactic opn in
-      ist.ltacvars, TacML (adjust_loc loc,opn,List.map (intern_genarg ist) l)
-
-and intern_tactic_as_arg loc onlytac ist a =
-  match intern_tacarg !strict_check onlytac ist a with
-  | TacCall _ | Reference _
-  | TacDynamic _ | TacGeneric _ as a -> TacArg (loc,a)
-  | Tacexp a -> a
-  | ConstrMayEval _ | UConstr _ | TacFreshId _ | TacPretype _ | TacNumgoals as a ->
-      if onlytac then error_tactic_expected loc else TacArg (loc,a)
-  | MetaIdArg _ -> assert false
-
-and intern_tactic_or_tacarg ist = intern_tactic false ist
-
-and intern_pure_tactic ist = intern_tactic true ist
-
-and intern_tactic_fun ist (var,body) =
-  let lfun = List.fold_left opt_cons ist.ltacvars var in
-  (var,intern_tactic_or_tacarg { ist with ltacvars = lfun } body)
-
-and intern_tacarg strict onlytac ist = function
-  | Reference r -> intern_non_tactic_reference strict ist r
-  | ConstrMayEval c -> ConstrMayEval (intern_constr_may_eval ist c)
-  | UConstr c -> UConstr (intern_constr ist c)
-  | MetaIdArg (loc,istac,s) ->
-      (* $id can occur in Grammar tactic... *)
-      let id = Id.of_string s in
-      if find_var id ist then
-	if istac then Reference (ArgVar (adjust_loc loc,id))
-	else ConstrMayEval (ConstrTerm (GVar (adjust_loc loc,id), None))
-      else error_syntactic_metavariables_not_allowed loc
-  | TacCall (loc,f,[]) -> intern_isolated_tactic_reference strict ist f
-  | TacCall (loc,f,l) ->
-      TacCall (loc,
-        intern_applied_tactic_reference ist f,
-        List.map (intern_tacarg !strict_check false ist) l)
-  | TacFreshId x -> TacFreshId (List.map (intern_string_or_var ist) x)
-  | TacPretype c -> TacPretype (intern_constr ist c)
-  | TacNumgoals -> TacNumgoals
-  | Tacexp t -> Tacexp (intern_tactic onlytac ist t)
-  | TacGeneric arg ->
-    let (_, arg) = Genintern.generic_intern ist arg in
-    TacGeneric arg
-  | TacDynamic(loc,t) as x ->
-    if Dyn.has_tag t "tactic" || Dyn.has_tag t "value" then x
-    else if Dyn.has_tag t "constr" then
-      if onlytac then error_tactic_expected loc else x
-    else
-      let tag = Dyn.tag t in
-      anomaly ~loc (str "Unknown dynamic: <" ++ str tag ++ str ">")
-
-(* Reads the rules of a Match Context or a Match *)
-and intern_match_rule onlytac ist = function
-  | (All tc)::tl ->
-      All (intern_tactic onlytac ist tc) :: (intern_match_rule onlytac ist tl)
-  | (Pat (rl,mp,tc))::tl ->
-      let {ltacvars=lfun; genv=env} = ist in
-      let lfun',metas1,hyps = intern_match_goal_hyps ist lfun rl in
-      let ido,metas2,pat = intern_pattern ist lfun mp in
-      let fold accu x = Id.Set.add x accu in
-      let ltacvars = List.fold_left fold (opt_cons lfun' ido) metas1 in
-      let ltacvars = List.fold_left fold ltacvars metas2 in
-      let ist' = { ist with ltacvars } in
-      Pat (hyps,pat,intern_tactic onlytac ist' tc) :: (intern_match_rule onlytac ist tl)
-  | [] -> []
-
-and intern_genarg ist x =
-  match genarg_tag x with
-  | IntOrVarArgType -> map_raw wit_int_or_var intern_int_or_var ist x
-  | IdentArgType ->
-    let lf = ref Id.Set.empty in
-    map_raw wit_ident (intern_ident lf) ist x
-  | VarArgType ->
-    map_raw wit_var intern_hyp ist x
-  | GenArgType ->
-    map_raw wit_genarg intern_genarg ist x
-  | ConstrArgType ->
-    map_raw wit_constr intern_constr ist x
-  | ConstrMayEvalArgType ->
-    map_raw wit_constr_may_eval intern_constr_may_eval ist x
-  | QuantHypArgType ->
-    map_raw wit_quant_hyp intern_quantified_hypothesis ist x
-  | RedExprArgType ->
-    map_raw wit_red_expr intern_red_expr ist x
-  | OpenConstrArgType ->
-    map_raw wit_open_constr (fun ist -> on_snd (intern_constr ist)) ist x
-  | ConstrWithBindingsArgType ->
-    map_raw wit_constr_with_bindings intern_constr_with_bindings ist x
-  | BindingsArgType ->
-    map_raw wit_bindings intern_bindings ist x
-  | ListArgType _ ->
-      let list_unpacker wit l =
-        let map x =
-          let ans = intern_genarg ist (in_gen (rawwit wit) x) in
-          out_gen (glbwit wit) ans
-        in
-        in_gen (glbwit (wit_list wit)) (List.map map (raw l))
-      in
-      list_unpack { list_unpacker } x
-  | OptArgType _ ->
-      let opt_unpacker wit o = match raw o with
-      | None -> in_gen (glbwit (wit_opt wit)) None
-      | Some x ->
-        let s = out_gen (glbwit wit) (intern_genarg ist (in_gen (rawwit wit) x)) in
-        in_gen (glbwit (wit_opt wit)) (Some s)
-      in
-      opt_unpack { opt_unpacker } x
-  | PairArgType _ ->
-      let pair_unpacker wit1 wit2 o =
-        let p, q = raw o in
-        let p = out_gen (glbwit wit1) (intern_genarg ist (in_gen (rawwit wit1) p)) in
-        let q = out_gen (glbwit wit2) (intern_genarg ist (in_gen (rawwit wit2) q)) in
-        in_gen (glbwit (wit_pair wit1 wit2)) (p, q)
-      in
-      pair_unpack { pair_unpacker } x
-  | ExtraArgType s ->
-      snd (Genintern.generic_intern ist x)
-
-(** Other entry points *)
-
-let glob_tactic x =
-  Flags.with_option strict_check
-    (intern_pure_tactic (make_empty_glob_sign ())) x
-
-let glob_tactic_env l env x =
-  let ltacvars =
-    List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
-  Flags.with_option strict_check
-  (intern_pure_tactic
-    { ltacvars; genv = env })
-    x
-
-let split_ltac_fun = function
-  | TacFun (l,t) -> (l,t)
-  | t -> ([],t)
-
-let pr_ltac_fun_arg = function
-  | None -> spc () ++ str "_"
-  | Some id -> spc () ++ pr_id id
-
-let print_ltac id =
- try
-  let kn = Nametab.locate_tactic id in
-  let entries = Tacenv.ltac_entries () in
-  let tac = KNmap.find kn entries in
-  let filter mp =
-    try Some (Nametab.shortest_qualid_of_module mp)
-    with Not_found -> None
-  in
-  let mods = List.map_filter filter tac.Tacenv.tac_redef in
-  let redefined = match mods with
-  | [] -> mt ()
-  | mods ->
-    let redef = prlist_with_sep fnl pr_qualid mods in
-    fnl () ++ str "Redefined by:" ++ fnl () ++ redef
-  in
-  let l,t = split_ltac_fun tac.Tacenv.tac_body in
-  hv 2 (
-    hov 2 (str "Ltac" ++ spc() ++ pr_qualid id ++
-           prlist pr_ltac_fun_arg l ++ spc () ++ str ":=")
-    ++ spc() ++ Pptactic.pr_glob_tactic (Global.env ()) t) ++ redefined
- with
-  Not_found ->
-   errorlabstrm "print_ltac"
-    (pr_qualid id ++ spc() ++ str "is not a user defined tactic.")
-
-(** Registering *)
-
-let lift intern = (); fun ist x -> (ist, intern ist x)
-
-let () =
-  let intern_intro_pattern ist pat =
-    let lf = ref Id.Set.empty in
-    let ans = intern_intro_pattern lf ist pat in
-    let ist = { ist with ltacvars = !lf } in
-    (ist, ans)
-  in
-  Genintern.register_intern0 wit_intro_pattern intern_intro_pattern
-
-let () =
-  let intern_clause ist cl =
-    let ans = clause_app (intern_hyp_location ist) cl in
-    (ist, ans)
-  in
-  Genintern.register_intern0 wit_clause_dft_concl intern_clause
-
-let () =
-  Genintern.register_intern0 wit_ref (lift intern_global_reference);
-  Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_sort (fun ist s -> (ist, s))
-
-let () =
-  Genintern.register_intern0 wit_uconstr (fun ist c -> (ist,intern_constr ist c))
-
-(***************************************************************************)
-(* Backwarding recursive needs of tactic glob/interp/eval functions *)
-
-let _ =
-  let f l =
-    let ltacvars =
-      List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l
-    in
-    Flags.with_option strict_check
-    (intern_pure_tactic { (make_empty_glob_sign()) with ltacvars })
-  in
-  Hook.set Hints.extern_intern_tac f
diff --git a/tactics/tacintern.mli b/tactics/tacintern.mli
deleted file mode 100644
index 7901cfeb..00000000
--- a/tactics/tacintern.mli
+++ /dev/null
@@ -1,65 +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        *)
-(************************************************************************)
-
-open Pp
-open Names
-open Tacexpr
-open Genarg
-open Constrexpr
-open Misctypes
-open Nametab
-
-(** Globalization of tactic expressions :
-    Conversion from [raw_tactic_expr] to [glob_tactic_expr] *)
-
-type glob_sign = Genintern.glob_sign = {
-  ltacvars : Id.Set.t;
-  genv : Environ.env }
-
-val fully_empty_glob_sign : glob_sign
-
-val make_empty_glob_sign : unit -> glob_sign
- (** same as [fully_empty_glob_sign], but with [Global.env()] as
-     environment *)
-
-(** Main globalization functions *)
-
-val glob_tactic : raw_tactic_expr -> glob_tactic_expr
-
-val glob_tactic_env :
-  Id.t list -> Environ.env -> raw_tactic_expr -> glob_tactic_expr
-
-(** Low-level variants *)
-
-val intern_pure_tactic : glob_sign -> raw_tactic_expr -> glob_tactic_expr
-
-val intern_tactic_or_tacarg :
-  glob_sign -> raw_tactic_expr -> Tacexpr.glob_tactic_expr
-
-val intern_constr : glob_sign -> constr_expr -> glob_constr_and_expr
-
-val intern_constr_with_bindings :
-  glob_sign -> constr_expr * constr_expr bindings ->
-  glob_constr_and_expr * glob_constr_and_expr bindings
-
-val intern_hyp : glob_sign -> Id.t Loc.located -> Id.t Loc.located
-
-(** Adds a globalization function for extra generic arguments *)
-
-val intern_genarg : glob_sign -> raw_generic_argument -> glob_generic_argument
-
-(** printing *)
-val print_ltac : Libnames.qualid -> std_ppcmds
-
-(** Reduction expressions *)
-
-val intern_red_expr : glob_sign -> raw_red_expr -> glob_red_expr
-val dump_glob_red_expr : raw_red_expr -> unit
-
-(* Hooks *)
-val strict_check : bool ref
diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml
deleted file mode 100644
index 54adbd93..00000000
--- a/tactics/tacinterp.ml
+++ /dev/null
@@ -1,2411 +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        *)
-(************************************************************************)
-
-open Constrintern
-open Patternops
-open Pp
-open Genredexpr
-open Glob_term
-open Glob_ops
-open Tacred
-open Errors
-open Util
-open Names
-open Nameops
-open Libnames
-open Globnames
-open Nametab
-open Pfedit
-open Proof_type
-open Refiner
-open Tacmach
-open Tactic_debug
-open Constrexpr
-open Term
-open Termops
-open Tacexpr
-open Genarg
-open Stdarg
-open Constrarg
-open Printer
-open Pretyping
-module Monad_ = Monad
-open Evd
-open Misctypes
-open Locus
-open Tacintern
-open Taccoerce
-open Proofview.Notations
-
-let safe_msgnl s =
-  Proofview.NonLogical.catch
-    (Proofview.NonLogical.print_debug (s++fnl()))
-    (fun _ -> Proofview.NonLogical.print_warning (str "bug in the debugger: an exception is raised while printing debug information"++fnl()))
-
-type value = tlevel generic_argument
-
-(** Abstract application, to print ltac functions *)
-type appl =
-  | UnnamedAppl (** For generic applications: nothing is printed *)
-  | GlbAppl of (Names.kernel_name * typed_generic_argument list) list
-       (** For calls to global constants, some may alias other. *)
-let push_appl appl args =
-  match appl with
-  | UnnamedAppl -> UnnamedAppl
-  | GlbAppl l -> GlbAppl (List.map (fun (h,vs) -> (h,vs@args)) l)
-let pr_generic arg =
-  let pr_gtac _ x = Pptactic.pr_glob_tactic (Global.env()) x in
-  try
-    Pptactic.pr_top_generic pr_constr pr_lconstr pr_gtac pr_constr_pattern arg
-  with e when Errors.noncritical e -> str"<generic>"
-let pr_appl h vs =
-  Pptactic.pr_ltac_constant  h ++ spc () ++
-  Pp.prlist_with_sep spc pr_generic vs
-let rec name_with_list appl t =
-  match appl with
-  | [] -> t
-  | (h,vs)::l -> Proofview.Trace.name_tactic (fun () -> pr_appl h vs) (name_with_list l t)
-let name_if_glob appl t =
-  match appl with
-  | UnnamedAppl -> t
-  | GlbAppl l -> name_with_list l t
-let combine_appl appl1 appl2 =
-  match appl1,appl2 with
-  | UnnamedAppl,a | a,UnnamedAppl -> a
-  | GlbAppl l1 , GlbAppl l2 -> GlbAppl (l2@l1)
-
-(* Values for interpretation *)
-type tacvalue =
-  | VFun of appl*ltac_trace * value Id.Map.t *
-      Id.t option list * glob_tactic_expr
-  | VRec of value Id.Map.t ref * glob_tactic_expr
-
-let (wit_tacvalue : (Empty.t, Empty.t, tacvalue) Genarg.genarg_type) =
-  Genarg.create_arg None "tacvalue"
-
-let of_tacvalue v = in_gen (topwit wit_tacvalue) v
-let to_tacvalue v = out_gen (topwit wit_tacvalue) v
-
-(** More naming applications *)
-let name_vfun appl vle =
-  let vle = Value.normalize vle in
-  if has_type vle (topwit wit_tacvalue) then
-    match to_tacvalue vle with
-    | VFun (appl0,trace,lfun,vars,t) -> of_tacvalue (VFun (combine_appl appl0 appl,trace,lfun,vars,t))
-    | _ -> vle
-  else vle
-
-module TacStore = Geninterp.TacStore
-
-let f_avoid_ids : Id.t list TacStore.field = TacStore.field ()
-(* ids inherited from the call context (needed to get fresh ids) *)
-let f_debug : debug_info TacStore.field = TacStore.field ()
-let f_trace : ltac_trace TacStore.field = TacStore.field ()
-
-(* Signature for interpretation: val_interp and interpretation functions *)
-type interp_sign = Geninterp.interp_sign = {
-  lfun : value Id.Map.t;
-  extra : TacStore.t }
-
-let extract_trace ist = match TacStore.get ist.extra f_trace with
-| None -> []
-| Some l -> l
-
-module Value = struct
-
-  include Taccoerce.Value
-
-  let of_closure ist tac =
-    let closure = VFun (UnnamedAppl,extract_trace ist, ist.lfun, [], tac) in
-    of_tacvalue closure
-
-end
-
-let dloc = Loc.ghost
-
-let catching_error call_trace fail (e, info) =
-  let inner_trace =
-    Option.default [] (Exninfo.get info ltac_trace_info)
-  in
-  if List.is_empty call_trace && List.is_empty inner_trace then fail (e, info)
-  else begin
-    assert (Errors.noncritical e); (* preserved invariant *)
-    let new_trace = inner_trace @ call_trace in
-    let located_exc = (e, Exninfo.add info ltac_trace_info new_trace) in
-    fail located_exc
-  end
-
-let catch_error call_trace f x =
-  try f x
-  with e when Errors.noncritical e ->
-    let e = Errors.push e in
-    catching_error call_trace iraise e
-
-let catch_error_tac call_trace tac =
-  Proofview.tclORELSE
-    tac
-    (catching_error call_trace (fun (e, info) -> Proofview.tclZERO ~info e))
-
-let curr_debug ist = match TacStore.get ist.extra f_debug with
-| None -> DebugOff
-| Some level -> level
-
-(** TODO: unify printing of generic Ltac values in case of coercion failure. *)
-
-(* Displays a value *)
-let pr_value env v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then str "a tactic"
-  else if has_type v (topwit wit_constr_context) then
-    let c = out_gen (topwit wit_constr_context) v in
-    match env with
-    | Some (env,sigma) -> pr_lconstr_env env sigma c
-    | _ -> str "a term"
-  else if has_type v (topwit wit_constr) then
-    let c = out_gen (topwit wit_constr) v in
-    match env with
-    | Some (env,sigma) -> pr_lconstr_env env sigma c
-    | _ -> str "a term"
-  else if has_type v (topwit wit_constr_under_binders) then
-    let c = out_gen (topwit wit_constr_under_binders) v in
-    match env with
-    | Some (env,sigma) -> pr_lconstr_under_binders_env env sigma c
-    | _ -> str "a term"
-  else
-    str "a value of type" ++ spc () ++ pr_argument_type (genarg_tag v)
-
-let pr_closure env ist body =
-  let pp_body = Pptactic.pr_glob_tactic env body in
-  let pr_sep () = fnl () in
-  let pr_iarg (id, arg) =
-    let arg = pr_argument_type (genarg_tag arg) in
-    hov 0 (pr_id id ++ spc () ++ str ":" ++ spc () ++ arg)
-  in
-  let pp_iargs = v 0 (prlist_with_sep pr_sep pr_iarg (Id.Map.bindings ist)) in
-  pp_body ++ fnl() ++ str "in environment " ++ fnl() ++ pp_iargs
-
-let pr_inspect env expr result =
-  let pp_expr = Pptactic.pr_glob_tactic env expr in
-  let pp_result =
-    if has_type result (topwit wit_tacvalue) then
-    match to_tacvalue result with
-    | VFun (_,_, ist, ul, b) ->
-      let body = if List.is_empty ul then b else (TacFun (ul, b)) in
-      str "a closure with body " ++ fnl() ++ pr_closure env ist body
-    | VRec (ist, body) ->
-      str "a recursive closure" ++ fnl () ++ pr_closure env !ist body
-    else
-      let pp_type = pr_argument_type (genarg_tag result) in
-      str "an object of type" ++ spc () ++ pp_type
-  in
-  pp_expr ++ fnl() ++ str "this is " ++ pp_result
-
-(* Transforms an id into a constr if possible, or fails with Not_found *)
-let constr_of_id env id =
-  Term.mkVar (let _ = Environ.lookup_named id env in id)
-
-(* To embed tactics *)
-
-let ((tactic_in : (interp_sign -> glob_tactic_expr) -> Dyn.t),
-     (tactic_out : Dyn.t -> (interp_sign -> glob_tactic_expr))) =
-  Dyn.create "tactic"
-
-let ((value_in : value -> Dyn.t),
-     (value_out : Dyn.t -> value)) = Dyn.create "value"
-
-let valueIn t = TacDynamic (Loc.ghost, value_in t)
-
-(** Generic arguments : table of interpretation functions *)
-
-let push_trace call ist = match TacStore.get ist.extra f_trace with
-| None -> [call]
-| Some trace -> call :: trace
-
-let propagate_trace ist loc id v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then
-    let tacv = to_tacvalue v in
-    match tacv with
-    | VFun (appl,_,lfun,it,b) ->
-        let t = if List.is_empty it then b else TacFun (it,b) in
-        let ans = VFun (appl,push_trace(loc,LtacVarCall (id,t)) ist,lfun,it,b) in
-        of_tacvalue ans
-    | _ ->  v
-  else v
-
-let append_trace trace v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then
-    match to_tacvalue v with
-    | VFun (appl,trace',lfun,it,b) -> of_tacvalue (VFun (appl,trace'@trace,lfun,it,b))
-    | _ -> v
-  else v
-
-(* Dynamically check that an argument is a tactic *)
-let coerce_to_tactic loc id v =
-  let v = Value.normalize v in
-  let fail () = user_err_loc
-    (loc, "", str "Variable " ++ pr_id id ++ str " should be bound to a tactic.")
-  in
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then
-    let tacv = to_tacvalue v in
-    match tacv with
-    | VFun _ -> v
-    | _ -> fail ()
-  else fail ()
-
-let value_of_ident id =
-  in_gen (topwit wit_intro_pattern)
-    (Loc.ghost, IntroNaming (IntroIdentifier id))
-
-let (+++) lfun1 lfun2 = Id.Map.fold Id.Map.add lfun1 lfun2
-
-let extend_values_with_bindings (ln,lm) lfun =
-  let of_cub c = match c with
-  | [], c -> Value.of_constr c
-  | _ -> in_gen (topwit wit_constr_under_binders) c
-  in
-  (* For compatibility, bound variables are visible only if no other
-     binding of the same name exists *)
-  let accu = Id.Map.map value_of_ident ln in
-  let accu = lfun +++ accu in
-  Id.Map.fold (fun id c accu -> Id.Map.add id (of_cub c) accu) lm accu
-
-(***************************************************************************)
-(* Evaluation/interpretation *)
-
-let is_variable env id =
-  Id.List.mem id (ids_of_named_context (Environ.named_context env))
-
-(* Debug reference *)
-let debug = ref DebugOff
-
-(* Sets the debugger mode *)
-let set_debug pos = debug := pos
-
-(* Gives the state of debug *)
-let get_debug () = !debug
-
-let debugging_step ist pp = match curr_debug ist with
-  | DebugOn lev ->
-      safe_msgnl (str "Level " ++ int lev ++ str": " ++ pp () ++ fnl())
-  | _ -> Proofview.NonLogical.return ()
-
-let debugging_exception_step ist signal_anomaly e pp =
-  let explain_exc =
-    if signal_anomaly then explain_logic_error
-    else explain_logic_error_no_anomaly in
-  debugging_step ist (fun () ->
-    pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ !explain_exc e)
-
-let error_ltac_variable loc id env v s =
-   user_err_loc (loc, "", str "Ltac variable " ++ pr_id id ++
-   strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++
-   strbrk "which cannot be coerced to " ++ str s ++ str".")
-
-(* Raise Not_found if not in interpretation sign *)
-let try_interp_ltac_var coerce ist env (loc,id) =
-  let v = Id.Map.find id ist.lfun in
-  try coerce v with CannotCoerceTo s -> error_ltac_variable loc id env v s
-
-let interp_ltac_var coerce ist env locid =
-  try try_interp_ltac_var coerce ist env locid
-  with Not_found -> anomaly (str "Detected '" ++ Id.print (snd locid) ++ str "' as ltac var at interning time")
-
-let interp_ident ist env sigma id =
-  try try_interp_ltac_var (coerce_to_ident false env) ist (Some (env,sigma)) (dloc,id)
-  with Not_found -> id
-
-let pf_interp_ident id gl = interp_ident id (pf_env gl) (project gl)
-
-(* Interprets an optional identifier, bound or fresh *)
-let interp_name ist env sigma = function
-  | Anonymous -> Anonymous
-  | Name id -> Name (interp_ident ist env sigma id)
-
-let interp_intro_pattern_var loc ist env sigma id =
-  try try_interp_ltac_var (coerce_to_intro_pattern env) ist (Some (env,sigma)) (loc,id)
-  with Not_found -> IntroNaming (IntroIdentifier id)
-
-let interp_intro_pattern_naming_var loc ist env sigma id =
-  try try_interp_ltac_var (coerce_to_intro_pattern_naming env) ist (Some (env,sigma)) (loc,id)
-  with Not_found -> IntroIdentifier id
-
-let interp_hint_base ist s =
-  try try_interp_ltac_var coerce_to_hint_base ist None (dloc,Id.of_string s)
-  with Not_found -> s
-
-let interp_int ist locid =
-  try try_interp_ltac_var coerce_to_int ist None locid
-  with Not_found ->
-    user_err_loc(fst locid,"interp_int",
-      str "Unbound variable "  ++ pr_id (snd locid) ++ str".")
-
-let interp_int_or_var ist = function
-  | ArgVar locid -> interp_int ist locid
-  | ArgArg n -> n
-
-let interp_int_or_var_as_list ist = function
-  | ArgVar (_,id as locid) ->
-      (try coerce_to_int_or_var_list (Id.Map.find id ist.lfun)
-       with Not_found | CannotCoerceTo _ -> [ArgArg (interp_int ist locid)])
-  | ArgArg n as x -> [x]
-
-let interp_int_or_var_list ist l =
-  List.flatten (List.map (interp_int_or_var_as_list ist) l)
-
-(* Interprets a bound variable (especially an existing hypothesis) *)
-let interp_hyp ist env sigma (loc,id as locid) =
-  (* Look first in lfun for a value coercible to a variable *)
-  try try_interp_ltac_var (coerce_to_hyp env) ist (Some (env,sigma)) locid
-  with Not_found ->
-  (* Then look if bound in the proof context at calling time *)
-  if is_variable env id then id
-  else Loc.raise loc (Logic.RefinerError (Logic.NoSuchHyp id))
-
-let interp_hyp_list_as_list ist env sigma (loc,id as x) =
-  try coerce_to_hyp_list env (Id.Map.find id ist.lfun)
-  with Not_found | CannotCoerceTo _ -> [interp_hyp ist env sigma x]
-
-let interp_hyp_list ist env sigma l =
-  List.flatten (List.map (interp_hyp_list_as_list ist env sigma) l)
-
-let interp_move_location ist env sigma = function
-  | MoveAfter id -> MoveAfter (interp_hyp ist env sigma id)
-  | MoveBefore id -> MoveBefore (interp_hyp ist env sigma id)
-  | MoveFirst -> MoveFirst
-  | MoveLast -> MoveLast
-
-let interp_reference ist env sigma = function
-  | ArgArg (_,r) -> r
-  | ArgVar (loc, id) ->
-    try try_interp_ltac_var (coerce_to_reference env) ist (Some (env,sigma)) (loc, id)
-    with Not_found ->
-      try
-        let (v, _, _) = Environ.lookup_named id env in
-        VarRef v
-      with Not_found -> error_global_not_found_loc loc (qualid_of_ident id)
-
-let try_interp_evaluable env (loc, id) =
-  let v = Environ.lookup_named id env in
-  match v with
-  | (_, Some _, _) -> EvalVarRef id
-  | _ -> error_not_evaluable (VarRef id)
-
-let interp_evaluable ist env sigma = function
-  | ArgArg (r,Some (loc,id)) ->
-    (* Maybe [id] has been introduced by Intro-like tactics *)
-    begin
-      try try_interp_evaluable env (loc, id)
-      with Not_found ->
-        match r with
-        | EvalConstRef _ -> r
-        | _ -> error_global_not_found_loc loc (qualid_of_ident id)
-    end
-  | ArgArg (r,None) -> r
-  | ArgVar (loc, id) ->
-    try try_interp_ltac_var (coerce_to_evaluable_ref env) ist (Some (env,sigma)) (loc, id)
-    with Not_found ->
-      try try_interp_evaluable env (loc, id)
-      with Not_found -> error_global_not_found_loc loc (qualid_of_ident id)
-
-(* Interprets an hypothesis name *)
-let interp_occurrences ist occs =
-  Locusops.occurrences_map (interp_int_or_var_list ist) occs
-
-let interp_hyp_location ist env sigma ((occs,id),hl) =
-  ((interp_occurrences ist occs,interp_hyp ist env sigma id),hl)
-
-let interp_hyp_location_list_as_list ist env sigma ((occs,id),hl as x) =
-  match occs,hl with
-  | AllOccurrences,InHyp ->
-      List.map (fun id -> ((AllOccurrences,id),InHyp))
-        (interp_hyp_list_as_list ist env sigma id)
-  | _,_ -> [interp_hyp_location ist env sigma x]
-
-let interp_hyp_location_list ist env sigma l =
-  List.flatten (List.map (interp_hyp_location_list_as_list ist env sigma) l)
-
-let interp_clause ist env sigma { onhyps=ol; concl_occs=occs } : clause =
-  { onhyps=Option.map (interp_hyp_location_list ist env sigma) ol;
-    concl_occs=interp_occurrences ist occs }
-
-(* Interpretation of constructions *)
-
-(* Extract the constr list from lfun *)
-let extract_ltac_constr_values ist env =
-  let fold id v accu =
-    try
-      let c = coerce_to_constr env v in
-      Id.Map.add id c accu
-    with CannotCoerceTo _ -> accu
-  in
-  Id.Map.fold fold ist.lfun Id.Map.empty
-(** ppedrot: I have changed the semantics here. Before this patch, closure was
-    implemented as a list and a variable could be bound several times with
-    different types, resulting in its possible appearance on both sides. This
-    could barely be defined as a feature... *)
-
-(* Extract the identifier list from lfun: join all branches (what to do else?)*)
-let rec intropattern_ids (loc,pat) = match pat with
-  | IntroNaming (IntroIdentifier id) -> [id]
-  | IntroAction (IntroOrAndPattern ll) ->
-      List.flatten (List.map intropattern_ids (List.flatten ll))
-  | IntroAction (IntroInjection l) ->
-      List.flatten (List.map intropattern_ids l)
-  | IntroAction (IntroApplyOn (c,pat)) -> intropattern_ids pat
-  | IntroNaming (IntroAnonymous | IntroFresh _)
-  | IntroAction (IntroWildcard | IntroRewrite _)
-  | IntroForthcoming _ -> []
-
-let extract_ids ids lfun =
-  let fold id v accu =
-    let v = Value.normalize v in
-    if has_type v (topwit wit_intro_pattern) then
-      let (_, ipat) = out_gen (topwit wit_intro_pattern) v in
-      if Id.List.mem id ids then accu
-      else accu @ intropattern_ids (dloc, ipat)
-    else accu
-  in
-  Id.Map.fold fold lfun []
-
-let default_fresh_id = Id.of_string "H"
-
-let interp_fresh_id ist env sigma l =
-  let ids = List.map_filter (function ArgVar (_, id) -> Some id | _ -> None) l in
-  let avoid = match TacStore.get ist.extra f_avoid_ids with
-  | None -> []
-  | Some l -> l
-  in
-  let avoid = (extract_ids ids ist.lfun) @ avoid in
-  let id =
-    if List.is_empty l then default_fresh_id
-    else
-      let s =
-	String.concat "" (List.map (function
-	  | ArgArg s -> s
-	  | ArgVar (_,id) -> Id.to_string (interp_ident ist env sigma id)) l) in
-      let s = if Lexer.is_keyword s then s^"0" else s in
-      Id.of_string s in
-  Tactics.fresh_id_in_env avoid id env
-
-(* Extract the uconstr list from lfun *)
-let extract_ltac_constr_context ist env =
-  let open Glob_term in
-  let add_uconstr id env v map =
-    try Id.Map.add id (coerce_to_uconstr env v) map
-    with CannotCoerceTo _ -> map
-  in
-  let add_constr id env v map =
-    try Id.Map.add id (coerce_to_constr env v) map
-    with CannotCoerceTo _ -> map
-  in
-  let add_ident id env v map =
-    try Id.Map.add id (coerce_to_ident false env v) map
-    with CannotCoerceTo _ -> map
-  in
-  let fold id v {idents;typed;untyped} =
-    let idents = add_ident id env v idents in
-    let typed = add_constr id env v typed in
-    let untyped = add_uconstr id env v untyped in
-    { idents ; typed ; untyped }
-  in
-  let empty =  { idents = Id.Map.empty ;typed = Id.Map.empty ; untyped = Id.Map.empty } in
-  Id.Map.fold fold ist.lfun empty
-
-(** Significantly simpler than [interp_constr], to interpret an
-    untyped constr, it suffices to adjoin a closure environment. *)
-let interp_uconstr ist env = function
-  | (term,None) ->
-      { closure = extract_ltac_constr_context ist env ; term }
-  | (_,Some ce) ->
-      let ( {typed ; untyped } as closure) = extract_ltac_constr_context ist env in
-      let ltacvars = {
-        Constrintern.ltac_vars = Id.(Set.union (Map.domain typed) (Map.domain untyped));
-        ltac_bound = Id.Map.domain ist.lfun;
-      } in
-      { closure ; term =  intern_gen WithoutTypeConstraint ~ltacvars env ce }
-
-let interp_gen kind ist allow_patvar flags env sigma (c,ce) =
-  let constrvars = extract_ltac_constr_context ist env in
-  let vars = {
-    Pretyping.ltac_constrs = constrvars.typed;
-    Pretyping.ltac_uconstrs = constrvars.untyped;
-    Pretyping.ltac_idents = constrvars.idents;
-    Pretyping.ltac_genargs = ist.lfun;
-  } in
-  let c = match ce with
-  | None -> c
-    (* If at toplevel (ce<>None), the error can be due to an incorrect
-       context at globalization time: we retype with the now known
-       intros/lettac/inversion hypothesis names *)
-  | Some c ->
-      let constr_context =
-        Id.Set.union
-          (Id.Map.domain constrvars.typed)
-       (Id.Set.union
-          (Id.Map.domain constrvars.untyped)
-          (Id.Map.domain constrvars.idents))
-      in
-      let ltacvars = {
-        ltac_vars = constr_context;
-        ltac_bound = Id.Map.domain ist.lfun;
-      } in
-      let kind_for_intern =
-        match kind with OfType _ -> WithoutTypeConstraint | _ -> kind in
-      intern_gen kind_for_intern ~allow_patvar ~ltacvars env c
-  in
-  let trace =
-    push_trace (loc_of_glob_constr c,LtacConstrInterp (c,vars)) ist in
-  let (evd,c) =
-    catch_error trace (understand_ltac flags env sigma vars kind) c
-  in
-  (* spiwack: to avoid unnecessary modifications of tacinterp, as this
-     function already use effect, I call [run] hoping it doesn't mess
-     up with any assumption. *)
-  Proofview.NonLogical.run (db_constr (curr_debug ist) env c);
-  (evd,c)
-
-let constr_flags = {
-  use_typeclasses = true;
-  use_unif_heuristics = true;
-  use_hook = Some solve_by_implicit_tactic;
-  fail_evar = true;
-  expand_evars = true }
-
-(* Interprets a constr; expects evars to be solved *)
-let interp_constr_gen kind ist env sigma c =
-  interp_gen kind ist false constr_flags env sigma c
-
-let interp_constr = interp_constr_gen WithoutTypeConstraint
-
-let interp_type = interp_constr_gen IsType
-
-let open_constr_use_classes_flags = {
-  use_typeclasses = true;
-  use_unif_heuristics = true;
-  use_hook = Some solve_by_implicit_tactic;
-  fail_evar = false;
-  expand_evars = true }
-
-let open_constr_no_classes_flags = {
-  use_typeclasses = false;
-  use_unif_heuristics = true;
-  use_hook = Some solve_by_implicit_tactic;
-  fail_evar = false;
-  expand_evars = true }
-
-let pure_open_constr_flags = {
-  use_typeclasses = false;
-  use_unif_heuristics = true;
-  use_hook = None;
-  fail_evar = false;
-  expand_evars = false }
-
-(* Interprets an open constr *)
-let interp_open_constr ?(expected_type=WithoutTypeConstraint) ist =
-  let flags =
-    if expected_type == WithoutTypeConstraint then open_constr_no_classes_flags
-    else open_constr_use_classes_flags in
-  interp_gen expected_type ist false flags
-
-let interp_pure_open_constr ist =
-  interp_gen WithoutTypeConstraint ist false pure_open_constr_flags
-
-let interp_typed_pattern ist env sigma (c,_) =
-  let sigma, c =
-    interp_gen WithoutTypeConstraint ist true pure_open_constr_flags env sigma c in
-  pattern_of_constr env sigma c
-
-(* Interprets a constr expression casted by the current goal *)
-let pf_interp_casted_constr ist gl c =
-  interp_constr_gen (OfType (pf_concl gl)) ist (pf_env gl) (project gl) c
-
-(* Interprets a constr expression *)
-let pf_interp_constr ist gl =
-  interp_constr ist (pf_env gl) (project gl)
-
-let new_interp_constr ist c k =
-  let open Proofview in
-  Proofview.Goal.enter begin fun gl ->
-    let (sigma, c) = interp_constr ist (Goal.env gl) (Goal.sigma gl) c in
-    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) (k c)
-  end
-
-let interp_constr_in_compound_list inj_fun dest_fun interp_fun ist env sigma l =
-  let try_expand_ltac_var sigma x =
-    try match dest_fun x with
-    | GVar (_,id), _ ->
-      let v = Id.Map.find id ist.lfun in
-      sigma, List.map inj_fun (coerce_to_constr_list env v)
-    | _ ->
-        raise Not_found
-    with CannotCoerceTo _ | Not_found ->
-      (* dest_fun, List.assoc may raise Not_found *)
-      let sigma, c = interp_fun ist env sigma x in
-      sigma, [c] in
-  let sigma, l = List.fold_map try_expand_ltac_var sigma l in
-  sigma, List.flatten l
-
-let interp_constr_list ist env sigma c =
-  interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_constr ist env sigma c
-
-let interp_open_constr_list =
-  interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_open_constr
-
-let interp_auto_lemmas ist env sigma lems =
-  let local_sigma, lems = interp_open_constr_list ist env sigma lems in
-  List.map (fun lem -> (local_sigma,lem)) lems
-
-(* Interprets a type expression *)
-let pf_interp_type ist gl =
-  interp_type ist (pf_env gl) (project gl)
-
-(* Interprets a reduction expression *)
-let interp_unfold ist env sigma (occs,qid) =
-  (interp_occurrences ist occs,interp_evaluable ist env sigma qid)
-
-let interp_flag ist env sigma red =
-  { red with rConst = List.map (interp_evaluable ist env sigma) red.rConst }
-
-let interp_constr_with_occurrences ist env sigma (occs,c) =
-  let (sigma,c_interp) = interp_constr ist env sigma c in
-  sigma , (interp_occurrences ist occs, c_interp)
-
-let interp_closed_typed_pattern_with_occurrences ist env sigma (occs, a) =
-  let p = match a with
-  | Inl (ArgVar (loc,id)) ->
-      (* This is the encoding of an ltac var supposed to be bound
-         prioritary to an evaluable reference and otherwise to a constr
-         (it is an encoding to satisfy the "union" type given to Simpl) *)
-    let coerce_eval_ref_or_constr x =
-      try Inl (coerce_to_evaluable_ref env x)
-      with CannotCoerceTo _ ->
-        let c = coerce_to_closed_constr env x in
-        Inr (pattern_of_constr env sigma c) in
-    (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (loc,id)
-     with Not_found ->
-       error_global_not_found_loc loc (qualid_of_ident id))
-  | Inl (ArgArg _ as b) -> Inl (interp_evaluable ist env sigma b)
-  | Inr c -> Inr (interp_typed_pattern ist env sigma c) in
-  interp_occurrences ist occs, p
-
-let interp_constr_with_occurrences_and_name_as_list =
-  interp_constr_in_compound_list
-    (fun c -> ((AllOccurrences,c),Anonymous))
-    (function ((occs,c),Anonymous) when occs == AllOccurrences -> c
-      | _ -> raise Not_found)
-    (fun ist env sigma (occ_c,na) ->
-      let (sigma,c_interp) = interp_constr_with_occurrences ist env sigma occ_c in
-      sigma, (c_interp,
-       interp_name ist env sigma na))
-
-let interp_red_expr ist env sigma = function
-  | Unfold l -> sigma , Unfold (List.map (interp_unfold ist env sigma) l)
-  | Fold l ->
-    let (sigma,l_interp) = interp_constr_list ist env sigma l in
-    sigma , Fold l_interp
-  | Cbv f -> sigma , Cbv (interp_flag ist env sigma f)
-  | Cbn f -> sigma , Cbn (interp_flag ist env sigma f)
-  | Lazy f -> sigma , Lazy (interp_flag ist env sigma f)
-  | Pattern l ->
-      let (sigma,l_interp) =
-        Evd.MonadR.List.map_right
-          (fun c sigma -> interp_constr_with_occurrences ist env sigma c) l sigma
-      in
-      sigma , Pattern l_interp
-  | Simpl (f,o) ->
-     sigma , Simpl (interp_flag ist env sigma f,
-		    Option.map (interp_closed_typed_pattern_with_occurrences ist env sigma) o)
-  | CbvVm o ->
-    sigma , CbvVm (Option.map (interp_closed_typed_pattern_with_occurrences ist env sigma) o)
-  | CbvNative o ->
-    sigma , CbvNative (Option.map (interp_closed_typed_pattern_with_occurrences ist env sigma) o)
-  | (Red _ |  Hnf | ExtraRedExpr _ as r) -> sigma , r
-
-let interp_may_eval f ist env sigma = function
-  | ConstrEval (r,c) ->
-      let (sigma,redexp) = interp_red_expr ist env sigma r in
-      let (sigma,c_interp) = f ist env sigma c in
-      (fst (Redexpr.reduction_of_red_expr env redexp) env sigma c_interp)
-  | ConstrContext ((loc,s),c) ->
-      (try
-	let (sigma,ic) = f ist env sigma c in
-	let ctxt = coerce_to_constr_context (Id.Map.find s ist.lfun) in
-	let evdref = ref sigma in
-	let c = subst_meta [Constr_matching.special_meta,ic] ctxt in
-	let c = Typing.solve_evars env evdref c in
-	!evdref , c
-      with
-	| Not_found ->
-	    user_err_loc (loc, "interp_may_eval",
-	    str "Unbound context identifier" ++ pr_id s ++ str"."))
-  | ConstrTypeOf c ->
-      let (sigma,c_interp) = f ist env sigma c in
-      Typing.type_of ~refresh:true env sigma c_interp
-  | ConstrTerm c ->
-     try
-	f ist env sigma c
-     with reraise ->
-       let reraise = Errors.push reraise in
-       (* spiwack: to avoid unnecessary modifications of tacinterp, as this
-          function already use effect, I call [run] hoping it doesn't mess
-          up with any assumption. *)
-       Proofview.NonLogical.run (debugging_exception_step ist false (fst reraise) (fun () ->
-         str"interpretation of term " ++ pr_glob_constr_env env (fst c)));
-       iraise reraise
-
-(* Interprets a constr expression possibly to first evaluate *)
-let interp_constr_may_eval ist env sigma c =
-  let (sigma,csr) =
-    try
-      interp_may_eval interp_constr ist env sigma c
-    with reraise ->
-      let reraise = Errors.push reraise in
-      (* spiwack: to avoid unnecessary modifications of tacinterp, as this
-          function already use effect, I call [run] hoping it doesn't mess
-          up with any assumption. *)
-       Proofview.NonLogical.run (debugging_exception_step ist false (fst reraise) (fun () -> str"evaluation of term"));
-      iraise reraise
-  in
-  begin
-    (* spiwack: to avoid unnecessary modifications of tacinterp, as this
-       function already use effect, I call [run] hoping it doesn't mess
-       up with any assumption. *)
-    Proofview.NonLogical.run (db_constr (curr_debug ist) env csr);
-    sigma , csr
-  end
-
-(** TODO: should use dedicated printers *)
-let rec message_of_value v =
-  let v = Value.normalize v in
-  let open Tacmach.New in
-  let open Ftactic in
-  if has_type v (topwit wit_tacvalue) then
-    Ftactic.return (str "<tactic>")
-  else if has_type v (topwit wit_constr) then
-    let v = out_gen (topwit wit_constr) v in
-    Ftactic.nf_enter begin fun gl -> Ftactic.return (pr_constr_env (pf_env gl) (Proofview.Goal.sigma gl) v) end
-  else if has_type v (topwit wit_constr_under_binders) then
-    let c = out_gen (topwit wit_constr_under_binders) v in
-    Ftactic.nf_enter begin fun gl ->
-      Ftactic.return (pr_constr_under_binders_env (pf_env gl) (Proofview.Goal.sigma gl) c)
-    end
-  else if has_type v (topwit wit_unit) then
-    Ftactic.return (str "()")
-  else if has_type v (topwit wit_int) then
-    Ftactic.return (int (out_gen (topwit wit_int) v))
-  else if has_type v (topwit wit_intro_pattern) then
-    let p = out_gen (topwit wit_intro_pattern) v in
-    let print env sigma c = pr_constr_env env sigma (snd (c env Evd.empty)) in
-    Ftactic.nf_enter begin fun gl ->
-      Ftactic.return (Miscprint.pr_intro_pattern (fun c -> print (pf_env gl) (Proofview.Goal.sigma gl) c) p)
-    end
-  else if has_type v (topwit wit_constr_context) then
-    let c = out_gen (topwit wit_constr_context) v in
-    Ftactic.nf_enter begin fun gl -> Ftactic.return (pr_constr_env (pf_env gl) (Proofview.Goal.sigma gl) c) end
-  else if has_type v (topwit wit_uconstr) then
-    let c = out_gen (topwit wit_uconstr) v in
-    Ftactic.nf_enter begin fun gl ->
-      Ftactic.return (pr_closed_glob_env (pf_env gl)
-                        (Proofview.Goal.sigma gl) c)
-    end
-  else match Value.to_list v with
-  | Some l ->
-    Ftactic.List.map message_of_value l >>= fun l ->
-    Ftactic.return (prlist_with_sep spc (fun x -> x) l)
-  | None ->
-    let tag = pr_argument_type (genarg_tag v) in
-    Ftactic.return (str "<" ++ tag ++ str ">") (** TODO *)
-
-let interp_message_token ist = function
-  | MsgString s -> Ftactic.return (str s)
-  | MsgInt n -> Ftactic.return (int n)
-  | MsgIdent (loc,id) ->
-    let v = try Some (Id.Map.find id ist.lfun) with Not_found -> None in
-    match v with
-    | None -> Ftactic.lift (Tacticals.New.tclZEROMSG (pr_id id ++ str" not found."))
-    | Some v -> message_of_value v
-
-let interp_message ist l =
-  let open Ftactic in
-  Ftactic.List.map (interp_message_token ist) l >>= fun l ->
-  Ftactic.return (prlist_with_sep spc (fun x -> x) l)
-
-let interp_message ist l =
-  let open Ftactic in
-  Ftactic.List.map (interp_message_token ist) l >>= fun l ->
-  Ftactic.return (prlist_with_sep spc (fun x -> x) l)
-
-let rec interp_intro_pattern ist env sigma = function
-  | loc, IntroAction pat ->
-      let (sigma,pat) = interp_intro_pattern_action ist env sigma pat in
-      sigma, (loc, IntroAction pat)
-  | loc, IntroNaming (IntroIdentifier id) ->
-      sigma, (loc, interp_intro_pattern_var loc ist env sigma id)
-  | loc, IntroNaming pat ->
-      sigma, (loc, IntroNaming (interp_intro_pattern_naming loc ist env sigma pat))
-  | loc, IntroForthcoming _  as x -> sigma, x
-
-and interp_intro_pattern_naming loc ist env sigma = function
-  | IntroFresh id -> IntroFresh (interp_ident ist env sigma id)
-  | IntroIdentifier id -> interp_intro_pattern_naming_var loc ist env sigma id
-  | IntroAnonymous as x -> x
-
-and interp_intro_pattern_action ist env sigma = function
-  | IntroOrAndPattern l ->
-      let (sigma,l) = interp_or_and_intro_pattern ist env sigma l in
-      sigma, IntroOrAndPattern l
-  | IntroInjection l ->
-      let sigma,l = interp_intro_pattern_list_as_list ist env sigma l in
-      sigma, IntroInjection l
-  | IntroApplyOn (c,ipat) ->
-      let c = fun env sigma -> interp_open_constr ist env sigma c in
-      let sigma,ipat = interp_intro_pattern ist env sigma ipat in
-      sigma, IntroApplyOn (c,ipat)
-  | IntroWildcard | IntroRewrite _ as x -> sigma, x
-
-and interp_or_and_intro_pattern ist env sigma =
-  List.fold_map (interp_intro_pattern_list_as_list ist env) sigma
-
-and interp_intro_pattern_list_as_list ist env sigma = function
-  | [loc,IntroNaming (IntroIdentifier id)] as l ->
-      (try sigma, coerce_to_intro_pattern_list loc env (Id.Map.find id ist.lfun)
-       with Not_found | CannotCoerceTo _ ->
-         List.fold_map (interp_intro_pattern ist env) sigma l)
-  | l -> List.fold_map (interp_intro_pattern ist env) sigma l
-
-let interp_intro_pattern_naming_option ist env sigma = function
-  | None -> None
-  | Some (loc,pat) -> Some (loc, interp_intro_pattern_naming loc ist env sigma pat)
-
-let interp_or_and_intro_pattern_option ist env sigma = function
-  | None -> sigma, None
-  | Some (ArgVar (loc,id)) ->
-      (match coerce_to_intro_pattern env (Id.Map.find id ist.lfun) with
-      | IntroAction (IntroOrAndPattern l) -> sigma, Some (loc,l)
-      | _ ->
-        raise (CannotCoerceTo "a disjunctive/conjunctive introduction pattern"))
-  | Some (ArgArg (loc,l)) ->
-      let sigma,l = interp_or_and_intro_pattern ist env sigma l in
-      sigma, Some (loc,l)
-
-let interp_intro_pattern_option ist env sigma = function
-  | None -> sigma, None
-  | Some ipat ->
-      let sigma, ipat = interp_intro_pattern ist env sigma ipat in
-      sigma, Some ipat
-
-let interp_in_hyp_as ist env sigma (id,ipat) =
-  let sigma, ipat = interp_intro_pattern_option ist env sigma ipat in
-  sigma,(interp_hyp ist env sigma id,ipat)
-
-let interp_quantified_hypothesis ist = function
-  | AnonHyp n -> AnonHyp n
-  | NamedHyp id ->
-      try try_interp_ltac_var coerce_to_quantified_hypothesis ist None(dloc,id)
-      with Not_found -> NamedHyp id
-
-let interp_binding_name ist = function
-  | AnonHyp n -> AnonHyp n
-  | NamedHyp id ->
-      (* If a name is bound, it has to be a quantified hypothesis *)
-      (* user has to use other names for variables if these ones clash with *)
-      (* a name intented to be used as a (non-variable) identifier *)
-      try try_interp_ltac_var coerce_to_quantified_hypothesis ist None(dloc,id)
-      with Not_found -> NamedHyp id
-
-let interp_declared_or_quantified_hypothesis ist env sigma = function
-  | AnonHyp n -> AnonHyp n
-  | NamedHyp id ->
-      try try_interp_ltac_var
-	    (coerce_to_decl_or_quant_hyp env) ist (Some (env,sigma)) (dloc,id)
-      with Not_found -> NamedHyp id
-
-let interp_binding ist env sigma (loc,b,c) =
-  let sigma, c = interp_open_constr ist env sigma c in
-  sigma, (loc,interp_binding_name ist b,c)
-
-let interp_bindings ist env sigma = function
-| NoBindings ->
-    sigma, NoBindings
-| ImplicitBindings l ->
-    let sigma, l = interp_open_constr_list ist env sigma l in   
-    sigma, ImplicitBindings l
-| ExplicitBindings l ->
-    let sigma, l = List.fold_map (interp_binding ist env) sigma l in
-    sigma, ExplicitBindings l
-
-let interp_constr_with_bindings ist env sigma (c,bl) =
-  let sigma, bl = interp_bindings ist env sigma bl in
-  let sigma, c = interp_open_constr ist env sigma c in
-  sigma, (c,bl)
-
-let interp_constr_with_bindings_arg ist env sigma (keep,c) =
-  let sigma, c = interp_constr_with_bindings ist env sigma c in
-  sigma, (keep,c)
-
-let interp_open_constr_with_bindings ist env sigma (c,bl) =
-  let sigma, bl = interp_bindings ist env sigma bl in
-  let sigma, c = interp_open_constr ist env sigma c in
-  sigma, (c, bl)
-
-let interp_open_constr_with_bindings_arg ist env sigma (keep,c) =
-  let sigma, c = interp_open_constr_with_bindings ist env sigma c in
-  sigma,(keep,c)
-
-let loc_of_bindings = function
-| NoBindings -> Loc.ghost
-| ImplicitBindings l -> loc_of_glob_constr (fst (List.last l))
-| ExplicitBindings l -> pi1 (List.last l)
-
-let interp_open_constr_with_bindings_loc ist ((c,_),bl as cb) =
-  let loc1 = loc_of_glob_constr c in
-  let loc2 = loc_of_bindings bl in
-  let loc = if Loc.is_ghost loc2 then loc1 else Loc.merge loc1 loc2 in
-  let f env sigma = interp_open_constr_with_bindings ist env sigma cb in
-    (loc,f)
-
-let interp_induction_arg ist gl arg =
-  match arg with
-  | keep,ElimOnConstr c ->
-      keep,ElimOnConstr (fun env sigma -> interp_constr_with_bindings ist env sigma c)
-  | keep,ElimOnAnonHyp n as x -> x
-  | keep,ElimOnIdent (loc,id) ->
-      let error () = user_err_loc (loc, "",
-        strbrk "Cannot coerce " ++ pr_id id ++
-        strbrk " neither to a quantified hypothesis nor to a term.")
-      in
-      let try_cast_id id' =
-        if Tactics.is_quantified_hypothesis id' gl
-        then keep,ElimOnIdent (loc,id')
-        else keep, ElimOnConstr (fun env sigma ->
-          try sigma, (constr_of_id env id', NoBindings)
-          with Not_found ->
-            user_err_loc (loc, "interp_induction_arg",
-            pr_id id ++ strbrk " binds to " ++ pr_id id' ++ strbrk " which is neither a declared nor a quantified hypothesis."))
-      in
-      try
-        (** FIXME: should be moved to taccoerce *)
-        let v = Id.Map.find id ist.lfun in
-        let v = Value.normalize v in
-        if has_type v (topwit wit_intro_pattern) then
-          let v = out_gen (topwit wit_intro_pattern) v in
-          match v with
-          | _, IntroNaming (IntroIdentifier id) -> try_cast_id id
-          | _ -> error ()
-        else if has_type v (topwit wit_var) then
-          let id = out_gen (topwit wit_var) v in
-          try_cast_id id
-        else if has_type v (topwit wit_int) then
-          keep,ElimOnAnonHyp (out_gen (topwit wit_int) v)
-        else match Value.to_constr v with
-        | None -> error ()
-        | Some c -> keep,ElimOnConstr (fun env sigma -> sigma,(c,NoBindings))
-      with Not_found ->
-	(* We were in non strict (interactive) mode *)
-	if Tactics.is_quantified_hypothesis id gl then
-          keep,ElimOnIdent (loc,id)
-	else
-          let c = (GVar (loc,id),Some (CRef (Ident (loc,id),None))) in
-          let f env sigma = 
-            let (sigma,c) = interp_open_constr ist env sigma c in
-            sigma,(c,NoBindings) in
-          keep,ElimOnConstr f
-
-(* Associates variables with values and gives the remaining variables and
-   values *)
-let head_with_value (lvar,lval) =
-  let rec head_with_value_rec lacc = function
-    | ([],[]) -> (lacc,[],[])
-    | (vr::tvr,ve::tve) ->
-      (match vr with
-      |	None -> head_with_value_rec lacc (tvr,tve)
-      | Some v -> head_with_value_rec ((v,ve)::lacc) (tvr,tve))
-    | (vr,[]) -> (lacc,vr,[])
-    | ([],ve) -> (lacc,[],ve)
-  in
-  head_with_value_rec [] (lvar,lval)
-
-(** [interp_context ctxt] interprets a context (as in
-    {!Matching.matching_result}) into a context value of Ltac.  *)
-let interp_context ctxt = in_gen (topwit wit_constr_context) ctxt
-
-(* Reads a pattern by substituting vars of lfun *)
-let use_types = false
-
-let eval_pattern lfun ist env sigma ((glob,_),pat as c) =
-  let bound_names = bound_glob_vars glob in
-  if use_types then
-    (bound_names,interp_typed_pattern ist env sigma c)
-  else
-    (bound_names,instantiate_pattern env sigma lfun pat)
-
-let read_pattern lfun ist env sigma = function
-  | Subterm (b,ido,c) -> Subterm (b,ido,eval_pattern lfun ist env sigma c)
-  | Term c -> Term (eval_pattern lfun ist env sigma c)
-
-(* Reads the hypotheses of a Match Context rule *)
-let cons_and_check_name id l =
-  if Id.List.mem id l then
-    user_err_loc (dloc,"read_match_goal_hyps",
-      str "Hypothesis pattern-matching variable " ++ pr_id id ++
-      str " used twice in the same pattern.")
-  else id::l
-
-let rec read_match_goal_hyps lfun ist env sigma lidh = function
-  | (Hyp ((loc,na) as locna,mp))::tl ->
-      let lidh' = name_fold cons_and_check_name na lidh in
-      Hyp (locna,read_pattern lfun ist env sigma mp)::
-	(read_match_goal_hyps lfun ist env sigma lidh' tl)
-  | (Def ((loc,na) as locna,mv,mp))::tl ->
-      let lidh' = name_fold cons_and_check_name na lidh in
-      Def (locna,read_pattern lfun ist env sigma mv, read_pattern lfun ist env sigma mp)::
-	(read_match_goal_hyps lfun ist env sigma lidh' tl)
-  | [] -> []
-
-(* Reads the rules of a Match Context or a Match *)
-let rec read_match_rule lfun ist env sigma = function
-  | (All tc)::tl -> (All tc)::(read_match_rule lfun ist env sigma tl)
-  | (Pat (rl,mp,tc))::tl ->
-      Pat (read_match_goal_hyps lfun ist env sigma [] rl, read_pattern lfun ist env sigma mp,tc)
-      :: read_match_rule lfun ist env sigma tl
-  | [] -> []
-
-
-(* misc *)
-
-let mk_constr_value ist gl c =
-  let (sigma,c_interp) = pf_interp_constr ist gl c in
-  sigma, Value.of_constr c_interp
-let mk_open_constr_value ist gl c = 
-  let (sigma,c_interp) = pf_apply (interp_open_constr ist) gl c in
-  sigma, Value.of_constr c_interp
-let mk_hyp_value ist env sigma c =
-  Value.of_constr (mkVar (interp_hyp ist env sigma c))
-let mk_int_or_var_value ist c = in_gen (topwit wit_int) (interp_int_or_var ist c)
-
-let pack_sigma (sigma,c) = {it=c;sigma=sigma;}
-
-(* Interprets an l-tac expression into a value *)
-let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : typed_generic_argument Ftactic.t =
-  (* The name [appl] of applied top-level Ltac names is ignored in
-     [value_interp]. It is installed in the second step by a call to
-     [name_vfun], because it gives more opportunities to detect a
-     [VFun]. Otherwise a [Ltac t := let x := .. in tac] would never
-     register its name since it is syntactically a let, not a
-     function.  *)
-  let value_interp ist = match tac with
-  | TacFun (it, body) ->
-    Ftactic.return (of_tacvalue (VFun (UnnamedAppl,extract_trace ist, ist.lfun, it, body)))
-  | TacLetIn (true,l,u) -> interp_letrec ist l u
-  | TacLetIn (false,l,u) -> interp_letin ist l u
-  | TacMatchGoal (lz,lr,lmr) -> interp_match_goal ist lz lr lmr
-  | TacMatch (lz,c,lmr) -> interp_match ist lz c lmr
-  | TacArg (loc,a) -> interp_tacarg ist a
-  | t ->
-    (** Delayed evaluation *)
-    Ftactic.return (of_tacvalue (VFun (UnnamedAppl,extract_trace ist, ist.lfun, [], t)))
-  in
-  let open Ftactic in
-  Control.check_for_interrupt ();
-  match curr_debug ist with
-  | DebugOn lev ->
-        let eval v =
-          let ist = { ist with extra = TacStore.set ist.extra f_debug v } in
-          value_interp ist >>= fun v -> return (name_vfun appl v)
-        in
-	Ftactic.debug_prompt lev tac eval
-  | _ -> value_interp ist >>= fun v -> return (name_vfun appl v)
-      
-
-and eval_tactic ist tac : unit Proofview.tactic = match tac with
-  | TacAtom (loc,t) ->
-      let call = LtacAtomCall t in
-      catch_error_tac (push_trace(loc,call) ist) (interp_atomic ist t)
-  | TacFun _ | TacLetIn _ -> assert false
-  | TacMatchGoal _ | TacMatch _ -> assert false
-  | TacId [] -> Proofview.tclLIFT (db_breakpoint (curr_debug ist) [])
-  | TacId s ->
-      let msgnl =
-        let open Ftactic in
-        interp_message ist s >>= fun msg ->
-        return (hov 0 msg , hov 0 msg)
-      in
-      let print (_,msgnl) = Proofview.(tclLIFT (NonLogical.print_info msgnl)) in
-      let log (msg,_) = Proofview.Trace.log (fun () -> msg) in
-      let break = Proofview.tclLIFT (db_breakpoint (curr_debug ist) s) in
-      Ftactic.run msgnl begin fun msgnl ->
-        print msgnl <*> log msgnl <*> break
-      end
-  | TacFail (g,n,s) ->
-      let msg = interp_message ist s in
-      let tac l = Tacticals.New.tclFAIL (interp_int_or_var ist n) l in
-      let tac =
-        match g with
-        | TacLocal -> fun l -> Proofview.tclINDEPENDENT (tac l)
-        | TacGlobal -> tac
-      in
-      Ftactic.run msg tac
-  | TacProgress tac -> Tacticals.New.tclPROGRESS (interp_tactic ist tac)
-  | TacShowHyps tac ->
-         Proofview.V82.tactic begin
-           tclSHOWHYPS (Proofview.V82.of_tactic (interp_tactic ist tac))
-         end
-  | TacAbstract (tac,ido) ->
-      Proofview.Goal.nf_enter begin fun gl -> Tactics.tclABSTRACT
-        (Option.map (Tacmach.New.of_old (pf_interp_ident ist) gl) ido) (interp_tactic ist tac)
-      end
-  | TacThen (t1,t) ->
-      Tacticals.New.tclTHEN (interp_tactic ist t1) (interp_tactic ist t)
-  | TacDispatch tl ->
-      Proofview.tclDISPATCH (List.map (interp_tactic ist) tl)
-  | TacExtendTac (tf,t,tl) ->
-      Proofview.tclEXTEND (Array.map_to_list (interp_tactic ist) tf)
-                          (interp_tactic ist t)
-                          (Array.map_to_list (interp_tactic ist) tl)
-  | TacThens (t1,tl) -> Tacticals.New.tclTHENS (interp_tactic ist t1) (List.map (interp_tactic ist) tl)
-  | TacThens3parts (t1,tf,t,tl) ->
-      Tacticals.New.tclTHENS3PARTS (interp_tactic ist t1)
-	(Array.map (interp_tactic ist) tf) (interp_tactic ist t) (Array.map (interp_tactic ist) tl)
-  | TacDo (n,tac) -> Tacticals.New.tclDO (interp_int_or_var ist n) (interp_tactic ist tac)
-  | TacTimeout (n,tac) -> Tacticals.New.tclTIMEOUT (interp_int_or_var ist n) (interp_tactic ist tac)
-  | TacTime (s,tac) -> Tacticals.New.tclTIME s (interp_tactic ist tac)
-  | TacTry tac -> Tacticals.New.tclTRY (interp_tactic ist tac)
-  | TacRepeat tac -> Tacticals.New.tclREPEAT (interp_tactic ist tac)
-  | TacOr (tac1,tac2) ->
-      Tacticals.New.tclOR (interp_tactic ist tac1) (interp_tactic ist tac2)
-  | TacOnce tac ->
-      Tacticals.New.tclONCE (interp_tactic ist tac)
-  | TacExactlyOnce tac ->
-      Tacticals.New.tclEXACTLY_ONCE (interp_tactic ist tac)
-  | TacIfThenCatch (t,tt,te) ->
-      Tacticals.New.tclIFCATCH
-        (interp_tactic ist t)
-        (fun () -> interp_tactic ist tt)
-        (fun () -> interp_tactic ist te)
-  | TacOrelse (tac1,tac2) ->
-      Tacticals.New.tclORELSE (interp_tactic ist tac1) (interp_tactic ist tac2)
-  | TacFirst l -> Tacticals.New.tclFIRST (List.map (interp_tactic ist) l)
-  | TacSolve l -> Tacticals.New.tclSOLVE (List.map (interp_tactic ist) l)
-  | TacComplete tac -> Tacticals.New.tclCOMPLETE (interp_tactic ist tac)
-  | TacArg a -> interp_tactic ist (TacArg a)
-  | TacInfo tac ->
-      msg_warning
-	(strbrk "The general \"info\" tactic is currently not working." ++ spc()++
-           strbrk "There is an \"Info\" command to replace it." ++fnl () ++
-	   strbrk "Some specific verbose tactics may also exist, such as info_eauto.");
-      eval_tactic ist tac
-  (* For extensions *)
-  | TacAlias (loc,s,l) ->
-      let body = Tacenv.interp_alias s in
-      let rec f x = match genarg_tag x with
-      | QuantHypArgType | RedExprArgType
-      | ConstrWithBindingsArgType
-      | BindingsArgType
-      | OptArgType _ | PairArgType _ -> (** generic handler *)
-        Ftactic.nf_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 goal = Proofview.Goal.goal gl in
-          let (sigma, arg) = interp_genarg ist env sigma concl goal x in
-          Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return arg)
-        end
-      | _ as tag -> (** Special treatment. TODO: use generic handler  *)
-        Ftactic.nf_enter begin fun gl ->
-          let sigma = Proofview.Goal.sigma gl in
-          let env = Proofview.Goal.env gl in
-          match tag with
-          | IntOrVarArgType ->
-              Ftactic.return (mk_int_or_var_value ist (out_gen (glbwit wit_int_or_var) x))
-          | IdentArgType ->
-              Ftactic.return (value_of_ident (interp_ident ist env sigma
-                                               (out_gen (glbwit wit_ident) x)))
-          | VarArgType ->
-              Ftactic.return (mk_hyp_value ist env sigma (out_gen (glbwit wit_var) x))
-          | GenArgType -> f (out_gen (glbwit wit_genarg) x)
-          | ConstrArgType ->
-              let (sigma,v) =
-                Tacmach.New.of_old (fun gl -> mk_constr_value ist gl (out_gen (glbwit wit_constr) x)) gl
-              in
-              Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return v)
-          | OpenConstrArgType ->
-              let (sigma,v) =
-                Tacmach.New.of_old (fun gl -> mk_open_constr_value ist gl (snd (out_gen (glbwit wit_open_constr) x))) gl in
-              Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return v)
-          | ConstrMayEvalArgType ->
-              let (sigma,c_interp) =
-                interp_constr_may_eval ist env sigma
-                  (out_gen (glbwit wit_constr_may_eval) x)
-              in
-              Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return (Value.of_constr c_interp))
-          | ListArgType ConstrArgType ->
-              let wit = glbwit (wit_list wit_constr) in
-              let (sigma,l_interp) = Tacmach.New.of_old begin fun gl ->
-                Evd.MonadR.List.map_right
-                  (fun c sigma -> mk_constr_value ist { gl with sigma=sigma } c)
-                  (out_gen wit x)
-                  (project gl)
-              end gl in
-              Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return (in_gen (topwit (wit_list wit_genarg)) l_interp))
-          | ListArgType VarArgType ->
-              let wit = glbwit (wit_list wit_var) in
-              Ftactic.return (
-                let ans = List.map (mk_hyp_value ist env sigma) (out_gen wit x) in
-                in_gen (topwit (wit_list wit_genarg)) ans
-              )
-          | ListArgType IntOrVarArgType ->
-              let wit = glbwit (wit_list wit_int_or_var) in
-              let ans = List.map (mk_int_or_var_value ist) (out_gen wit x) in
-              Ftactic.return (in_gen (topwit (wit_list wit_genarg)) ans)
-          | ListArgType IdentArgType ->
-              let wit = glbwit (wit_list wit_ident) in
-              let mk_ident x = value_of_ident (interp_ident ist env sigma x) in
-              let ans = List.map mk_ident (out_gen wit x) in
-              Ftactic.return (in_gen (topwit (wit_list wit_genarg)) ans)
-          | ListArgType t  ->
-              let open Ftactic in
-              let list_unpacker wit l =
-                let map x =
-                  f (in_gen (glbwit wit) x) >>= fun v ->
-                  Ftactic.return (out_gen (topwit wit) v)
-                in
-                Ftactic.List.map map (glb l) >>= fun l ->
-                Ftactic.return (in_gen (topwit (wit_list wit)) l)
-              in
-              list_unpack { list_unpacker } x
-          | ExtraArgType _ ->
-              (** Special treatment of tactics *)
-              if has_type x (glbwit wit_tactic) then
-                let tac = out_gen (glbwit wit_tactic) x in
-                val_interp ist tac
-              else
-                let goal = Proofview.Goal.goal gl in
-                let (newsigma,v) = Geninterp.generic_interp ist {Evd.it=goal;sigma} x in
-                Ftactic.(lift (Proofview.Unsafe.tclEVARS newsigma) <*> return v)
-          | _ -> assert false
-        end
-      in
-      let (>>=) = Ftactic.bind in
-      let interp_vars =
-        Ftactic.List.map (fun (x,v) -> f v >>= fun v -> Ftactic.return (x,v)) l
-      in
-      let addvar (x, v) accu = Id.Map.add x v accu in
-      let tac l =
-        let lfun = List.fold_right addvar l ist.lfun in
-        let trace = push_trace (loc,LtacNotationCall s) ist in
-        let ist = {
-          lfun = lfun;
-          extra = TacStore.set ist.extra f_trace trace; } in
-        val_interp ist body >>= fun v ->
-        Ftactic.lift (tactic_of_value ist v)
-      in
-      let tac =
-        Ftactic.with_env interp_vars >>= fun (env,l) ->
-        let name () = Pptactic.pr_tactic env (TacAlias(loc,s,l)) in
-        Proofview.Trace.name_tactic name (tac l)
-      (* spiwack: this use of name_tactic is not robust to a
-         change of implementation of [Ftactic]. In such a situation,
-         some more elaborate solution will have to be used. *)
-      in
-      Ftactic.run tac (fun () -> Proofview.tclUNIT ())
-
-  | TacML (loc,opn,l) when List.for_all global_genarg l ->
-      let trace = push_trace (loc,LtacMLCall tac) ist in
-      let ist = { ist with extra = TacStore.set ist.extra f_trace trace; } in
-      (* spiwack: a special case for tactics (from TACTIC EXTEND) when
-         every argument can be interpreted without a
-         [Proofview.Goal.nf_enter]. *)
-      let tac = Tacenv.interp_ml_tactic opn in
-      (* dummy values, will be ignored *)
-      let env = Environ.empty_env in
-      let sigma = Evd.empty in
-      let concl = Term.mkRel (-1) in
-      let goal = Evar.unsafe_of_int (-1) in
-      (* /dummy values *)
-      let args = List.map (fun a -> snd(interp_genarg ist env sigma concl goal a)) l in
-      let name () = Pptactic.pr_tactic env (TacML(loc,opn,args)) in
-      Proofview.Trace.name_tactic name
-        (catch_error_tac trace (tac args ist))
-  | TacML (loc,opn,l) ->
-      let trace = push_trace (loc,LtacMLCall tac) ist in
-      let ist = { ist with extra = TacStore.set ist.extra f_trace trace; } in
-      Proofview.Goal.nf_enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let goal_sigma = Proofview.Goal.sigma gl in
-        let concl = Proofview.Goal.concl gl in
-        let goal = Proofview.Goal.goal gl in
-        let tac = Tacenv.interp_ml_tactic opn in
-        let (sigma,args) =
-          Evd.MonadR.List.map_right
-            (fun a sigma -> interp_genarg ist env sigma concl goal a) l goal_sigma
-        in
-        Proofview.Unsafe.tclEVARS sigma <*>
-        let name () = Pptactic.pr_tactic env (TacML(loc,opn,args)) in
-        Proofview.Trace.name_tactic name
-          (catch_error_tac trace (tac args ist))
-      end
-
-and force_vrec ist v : typed_generic_argument Ftactic.t =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then
-    let v = to_tacvalue v in
-    match v with
-    | VRec (lfun,body) -> val_interp {ist with lfun = !lfun} body
-    | v -> Ftactic.return (of_tacvalue v)
-  else Ftactic.return v
-
-and interp_ltac_reference loc' mustbetac ist r : typed_generic_argument Ftactic.t =
-  match r with
-  | ArgVar (loc,id) ->
-      let v =
-        try Id.Map.find id ist.lfun
-        with Not_found -> in_gen (topwit wit_var) id
-      in
-      Ftactic.bind (force_vrec ist v) begin fun v ->
-      let v = propagate_trace ist loc id v in
-      if mustbetac then Ftactic.return (coerce_to_tactic loc id v) else Ftactic.return v
-      end
-  | ArgArg (loc,r) ->
-      let ids = extract_ids [] ist.lfun in
-      let loc_info = ((if Loc.is_ghost loc' then loc else loc'),LtacNameCall r) in
-      let extra = TacStore.set ist.extra f_avoid_ids ids in 
-      let extra = TacStore.set extra f_trace (push_trace loc_info ist) in
-      let ist = { lfun = Id.Map.empty; extra = extra; } in
-      let appl = GlbAppl[r,[]] in
-      val_interp ~appl ist (Tacenv.interp_ltac r)
-
-and interp_tacarg ist arg : typed_generic_argument Ftactic.t =
-  match arg with
-  | TacGeneric arg ->
-      Ftactic.nf_enter begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let goal = Proofview.Goal.goal gl in
-        let (sigma,v) = Geninterp.generic_interp ist {Evd.it=goal;sigma} arg in
-        Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return v)
-      end
-  | Reference r -> interp_ltac_reference dloc false ist r
-  | ConstrMayEval c ->
-      Ftactic.enter begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let env = Proofview.Goal.env gl in
-        let (sigma,c_interp) = interp_constr_may_eval ist env sigma c in
-        Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return (Value.of_constr c_interp))
-      end
-  | UConstr c ->
-      Ftactic.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        Ftactic.return (Value.of_uconstr (interp_uconstr ist env c))
-      end
-  | MetaIdArg (loc,_,id) -> assert false
-  | TacCall (loc,r,[]) ->
-      interp_ltac_reference loc true ist r
-  | TacCall (loc,f,l) ->
-      let (>>=) = Ftactic.bind in
-      interp_ltac_reference loc true ist f >>= fun fv ->
-      Ftactic.List.map (fun a -> interp_tacarg ist a) l >>= fun largs ->
-      interp_app loc ist fv largs
-  | TacFreshId l ->
-      Ftactic.enter begin fun gl ->
-        let id = interp_fresh_id ist (Tacmach.New.pf_env gl) (Proofview.Goal.sigma gl) l in
-        Ftactic.return (in_gen (topwit wit_intro_pattern) (dloc, IntroNaming (IntroIdentifier id)))
-      end
-  | TacPretype c ->
-      Ftactic.enter begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let env = Proofview.Goal.env gl in
-        let {closure;term} = interp_uconstr ist env c in
-        let vars = {
-          Pretyping.ltac_constrs = closure.typed;
-          Pretyping.ltac_uconstrs = closure.untyped;
-          Pretyping.ltac_idents = closure.idents;
-          Pretyping.ltac_genargs = ist.lfun;
-        } in
-        let (sigma,c_interp) =
-          Pretyping.understand_ltac constr_flags env sigma vars WithoutTypeConstraint term
-        in
-        Ftactic.(lift (Proofview.Unsafe.tclEVARS sigma) <*> return (Value.of_constr c_interp))
-      end
-  | TacNumgoals ->
-      Ftactic.lift begin
-        let open Proofview.Notations in
-        Proofview.numgoals >>= fun i ->
-        Proofview.tclUNIT (Value.of_int i)
-      end
-  | Tacexp t -> val_interp ist t
-  | TacDynamic(_,t) ->
-      let tg = (Dyn.tag t) in
-      if String.equal tg "tactic" then
-        val_interp ist (tactic_out t ist)
-      else if String.equal tg "value" then
-        Ftactic.return (value_out t)
-      else if String.equal tg "constr" then
-        Ftactic.return (Value.of_constr (constr_out t))
-      else
-        Errors.anomaly ~loc:dloc ~label:"Tacinterp.val_interp"
-	  (str "Unknown dynamic: <" ++ str (Dyn.tag t) ++ str ">")
-
-(* Interprets an application node *)
-and interp_app loc ist fv largs : typed_generic_argument Ftactic.t =
-  let (>>=) = Ftactic.bind in
-  let fail = Tacticals.New.tclZEROMSG (str "Illegal tactic application.") in
-  let fv = Value.normalize fv in
-  if has_type fv (topwit wit_tacvalue) then
-  match to_tacvalue fv with
-     (* if var=[] and body has been delayed by val_interp, then body
-         is not a tactic that expects arguments.
-         Otherwise Ltac goes into an infinite loop (val_interp puts
-         a VFun back on body, and then interp_app is called again...) *)
-    | (VFun(appl,trace,olfun,(_::_ as var),body)
-      |VFun(appl,trace,olfun,([] as var),
-         (TacFun _|TacLetIn _|TacMatchGoal _|TacMatch _| TacArg _ as body))) ->
-	let (extfun,lvar,lval)=head_with_value (var,largs) in
-        let fold accu (id, v) = Id.Map.add id v accu in
-	let newlfun = List.fold_left fold olfun extfun in
-      if List.is_empty lvar then
-        begin Proofview.tclORELSE
-            begin
-              let ist = {
-                lfun = newlfun;
-                extra = TacStore.set ist.extra f_trace []; } in
-              catch_error_tac trace (val_interp ist body) >>= fun v ->
-              Ftactic.return (name_vfun (push_appl appl largs) v)
-            end
-	    begin fun (e, info) ->
-              Proofview.tclLIFT (debugging_exception_step ist false e (fun () -> str "evaluation")) <*>
-	      Proofview.tclZERO ~info e
-            end
-        end >>= fun v ->
-        (* No errors happened, we propagate the trace *)
-        let v = append_trace trace v in
-        Proofview.tclLIFT begin
-          debugging_step ist
-	    (fun () ->
-	      str"evaluation returns"++fnl()++pr_value None v)
-        end <*>
-        if List.is_empty lval then Ftactic.return v else interp_app loc ist v lval
-      else
-        Ftactic.return (of_tacvalue (VFun(push_appl appl largs,trace,newlfun,lvar,body)))
-    | _ -> fail
-  else fail
-
-(* Gives the tactic corresponding to the tactic value *)
-and tactic_of_value ist vle =
-  let vle = Value.normalize vle in
-  if has_type vle (topwit wit_tacvalue) then
-  match to_tacvalue vle with
-  | VFun (appl,trace,lfun,[],t) ->
-      let ist = {
-        lfun = lfun;
-        extra = TacStore.set ist.extra f_trace []; } in
-      let tac = name_if_glob appl (eval_tactic ist t) in
-      catch_error_tac trace tac
-  | (VFun _|VRec _) -> Tacticals.New.tclZEROMSG (str "A fully applied tactic is expected.")
-  else if has_type vle (topwit wit_tactic) then
-    let tac = out_gen (topwit wit_tactic) vle in
-    eval_tactic ist tac
-  else Tacticals.New.tclZEROMSG (str "Expression does not evaluate to a tactic.")
-
-(* Interprets the clauses of a recursive LetIn *)
-and interp_letrec ist llc u =
-  Proofview.tclUNIT () >>= fun () -> (* delay for the effects of [lref], just in case. *)
-  let lref = ref ist.lfun in
-  let fold accu ((_, id), b) =
-    let v = of_tacvalue (VRec (lref, TacArg (dloc, b))) in
-    Id.Map.add id v accu
-  in
-  let lfun = List.fold_left fold ist.lfun llc in
-  let () = lref := lfun in
-  let ist = { ist with lfun } in
-  val_interp ist u
-
-(* Interprets the clauses of a LetIn *)
-and interp_letin ist llc u =
-  let rec fold lfun = function
-  | [] ->
-    let ist = { ist with lfun } in
-    val_interp ist u
-  | ((_, id), body) :: defs ->
-    Ftactic.bind (interp_tacarg ist body) (fun v ->
-    fold (Id.Map.add id v lfun) defs)
-  in
-  fold ist.lfun llc
-
-(** [interp_match_success lz ist succ] interprets a single matching success
-    (of type {!Tactic_matching.t}). *)
-and interp_match_success ist { Tactic_matching.subst ; context ; terms ; lhs } =
-  let (>>=) = Ftactic.bind in
-  let lctxt = Id.Map.map interp_context context in
-  let hyp_subst = Id.Map.map Value.of_constr terms in
-  let lfun = extend_values_with_bindings subst (lctxt +++ hyp_subst +++ ist.lfun) in
-  let ist = { ist with lfun } in
-  val_interp ist lhs >>= fun v ->
-  if has_type v (topwit wit_tacvalue) then match to_tacvalue v with
-  | VFun (appl,trace,lfun,[],t) ->
-      let ist = {
-        lfun = lfun;
-        extra = TacStore.set ist.extra f_trace trace; } in
-      let tac = eval_tactic ist t in
-      let dummy = VFun (appl,extract_trace ist, Id.Map.empty, [], TacId []) in
-      catch_error_tac trace (tac <*> Ftactic.return (of_tacvalue dummy))
-  | _ -> Ftactic.return v
-  else Ftactic.return v
-
-
-(** [interp_match_successes lz ist s] interprets the stream of
-    matching of successes [s]. If [lz] is set to true, then only the
-    first success is considered, otherwise further successes are tried
-    if the left-hand side fails. *)
-and interp_match_successes lz ist s =
-   let general =
-     let break (e, info) = match e with
-       | FailError (0, _) -> None
-       | FailError (n, s) -> Some (FailError (pred n, s), info)
-       | _ -> None
-     in
-     Proofview.tclBREAK break s >>= fun ans -> interp_match_success ist ans
-   in
-    match lz with
-    | General ->
-        general
-    | Select ->
-      begin
-        (** Only keep the first matching result, we don't backtrack on it *)
-        let s = Proofview.tclONCE s in
-        s >>= fun ans -> interp_match_success ist ans
-      end
-    | Once ->
-        (** Once a tactic has succeeded, do not backtrack anymore *)
-        Proofview.tclONCE general
-
-(* Interprets the Match expressions *)
-and interp_match ist lz constr lmr =
-  let (>>=) = Ftactic.bind in
-  begin Proofview.tclORELSE
-    (interp_ltac_constr ist constr)
-    begin function
-      | (e, info) ->
-          Proofview.tclLIFT (debugging_exception_step ist true e
-          (fun () -> str "evaluation of the matched expression")) <*>
-          Proofview.tclZERO ~info e
-    end
-  end >>= fun constr ->
-  Ftactic.enter begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
-    let env = Proofview.Goal.env gl in
-    let ilr = read_match_rule (extract_ltac_constr_values ist env) ist env sigma lmr in
-    interp_match_successes lz ist (Tactic_matching.match_term env sigma constr ilr)
-  end
-
-(* Interprets the Match Context expressions *)
-and interp_match_goal ist lz lr lmr =
-    Ftactic.nf_enter begin fun gl ->
-      let sigma = Proofview.Goal.sigma gl in
-      let env = Proofview.Goal.env gl in
-      let hyps = Proofview.Goal.hyps gl in
-      let hyps = if lr then List.rev hyps else hyps in
-      let concl = Proofview.Goal.concl gl in
-      let ilr = read_match_rule (extract_ltac_constr_values ist env) ist env sigma lmr in
-      interp_match_successes lz ist (Tactic_matching.match_goal env sigma hyps concl ilr)
-    end
-
-(* Interprets extended tactic generic arguments *)
-(* spiwack: interp_genarg has an argument [concl] for the case of
-   "casted open constr". And [gl] for [Geninterp]. I haven't changed
-   the interface for geninterp yet as it is used by ARGUMENT EXTEND
-   (in turn used by plugins). At the time I'm writing this comment
-   though, the only concerned plugins are the declarative mode (which
-   needs the [extra] field of goals to interprete rules) and ssreflect
-   (a handful of time). I believe we'd need to address "casted open
-   constr" and the declarative mode rules to provide a reasonable
-   interface. *)
-and interp_genarg ist env sigma concl gl x =
-  let evdref = ref sigma in
-  let rec interp_genarg x =
-    match genarg_tag x with
-    | IntOrVarArgType ->
-      in_gen (topwit wit_int_or_var)
-        (ArgArg (interp_int_or_var ist (out_gen (glbwit wit_int_or_var) x)))
-    | IdentArgType ->
-      in_gen (topwit wit_ident)
-        (interp_ident ist env sigma (out_gen (glbwit wit_ident) x))
-    | VarArgType ->
-      in_gen (topwit wit_var) (interp_hyp ist env sigma (out_gen (glbwit wit_var) x))
-    | GenArgType ->
-      in_gen (topwit wit_genarg) (interp_genarg (out_gen (glbwit wit_genarg) x))
-    | ConstrArgType ->
-      let (sigma,c_interp) =
-        interp_constr ist env !evdref (out_gen (glbwit wit_constr) x)
-      in
-      evdref := sigma;
-      in_gen (topwit wit_constr) c_interp
-    | ConstrMayEvalArgType ->
-      let (sigma,c_interp) = interp_constr_may_eval ist env !evdref (out_gen (glbwit wit_constr_may_eval) x) in
-      evdref := sigma;
-      in_gen (topwit wit_constr_may_eval) c_interp
-    | QuantHypArgType ->
-      in_gen (topwit wit_quant_hyp)
-        (interp_declared_or_quantified_hypothesis ist env sigma
-           (out_gen (glbwit wit_quant_hyp) x))
-    | RedExprArgType ->
-      let (sigma,r_interp) =
-        interp_red_expr ist env !evdref (out_gen (glbwit wit_red_expr) x)
-      in
-      evdref := sigma;
-      in_gen (topwit wit_red_expr) r_interp
-    | OpenConstrArgType ->
-      let expected_type = WithoutTypeConstraint in
-      in_gen (topwit wit_open_constr)
-        (interp_open_constr ~expected_type
-           ist env !evdref
-           (snd (out_gen (glbwit wit_open_constr) x)))
-    | ConstrWithBindingsArgType ->
-      in_gen (topwit wit_constr_with_bindings)
-        (pack_sigma (interp_constr_with_bindings ist env !evdref
-		       (out_gen (glbwit wit_constr_with_bindings) x)))
-    | BindingsArgType ->
-      in_gen (topwit wit_bindings)
-        (pack_sigma (interp_bindings ist env !evdref (out_gen (glbwit wit_bindings) x)))
-    | ListArgType ConstrArgType ->
-        let (sigma,v) = interp_genarg_constr_list ist env !evdref x in
-	evdref := sigma;
-	v
-    | ListArgType VarArgType -> interp_genarg_var_list ist env sigma x
-    | ListArgType _ ->
-      let list_unpacker wit l =
-        let map x =
-          out_gen (topwit wit) (interp_genarg (in_gen (glbwit wit) x))
-        in
-        in_gen (topwit (wit_list wit)) (List.map map (glb l))
-      in
-      list_unpack { list_unpacker } x
-    | OptArgType _ ->
-      let opt_unpacker wit o = match glb o with
-      | None -> in_gen (topwit (wit_opt wit)) None
-      | Some x ->
-        let x = out_gen (topwit wit) (interp_genarg (in_gen (glbwit wit) x)) in
-        in_gen (topwit (wit_opt wit)) (Some x)
-      in
-      opt_unpack { opt_unpacker } x
-    | PairArgType _ ->
-      let pair_unpacker wit1 wit2 o =
-        let (p, q) = glb o in
-        let p = out_gen (topwit wit1) (interp_genarg (in_gen (glbwit wit1) p)) in
-        let q = out_gen (topwit wit2) (interp_genarg (in_gen (glbwit wit2) q)) in
-        in_gen (topwit (wit_pair wit1 wit2)) (p, q)
-      in
-      pair_unpack { pair_unpacker } x
-    | ExtraArgType s ->
-        let (sigma,v) = Geninterp.generic_interp ist { Evd.it=gl;sigma=(!evdref) } x in
-	evdref:=sigma;
-	v
-  in
-  let v = interp_genarg x in
-  !evdref , v
-
-
-(** returns [true] for genargs which have the same meaning
-    independently of goals. *)
-
-and global_genarg =
-  let rec global_tag = function
-    | IntOrVarArgType | GenArgType -> true
-    | ListArgType t | OptArgType t -> global_tag t
-    | PairArgType (t1,t2) -> global_tag t1 && global_tag t2
-    | _ -> false
-  in
-  fun x -> global_tag (genarg_tag x)
-
-and interp_genarg_constr_list ist env sigma x =
-  let lc = out_gen (glbwit (wit_list wit_constr)) x in
-  let (sigma,lc) = interp_constr_list ist env sigma lc in
-  sigma , in_gen (topwit (wit_list wit_constr)) lc
-
-and interp_genarg_var_list ist env sigma x =
-  let lc = out_gen (glbwit (wit_list wit_var)) x in
-  let lc = interp_hyp_list ist env sigma lc in
-  in_gen (topwit (wit_list wit_var)) lc
-
-(* Interprets tactic expressions : returns a "constr" *)
-and interp_ltac_constr ist e : constr Ftactic.t =
-  let (>>=) = Ftactic.bind in
-  begin Proofview.tclORELSE
-      (val_interp ist e)
-      begin function (err, info) -> match err with
-        | Not_found ->
-            Ftactic.enter begin fun gl ->
-              let env = Proofview.Goal.env gl in
-              Proofview.tclLIFT begin
-                debugging_step ist (fun () ->
-                  str "evaluation failed for" ++ fnl() ++
-                    Pptactic.pr_glob_tactic env e)
-              end
-            <*> Proofview.tclZERO Not_found
-            end
-        | err -> Proofview.tclZERO ~info err
-      end
-  end >>= fun result ->
-  Ftactic.enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let result = Value.normalize result in
-  try
-    let cresult = coerce_to_closed_constr env result in
-    Proofview.tclLIFT begin
-      debugging_step ist (fun () ->
-        Pptactic.pr_glob_tactic env e ++ fnl() ++
-          str " has value " ++ fnl() ++
-          pr_constr_env env sigma cresult)
-    end <*>
-    Ftactic.return cresult
-  with CannotCoerceTo _ ->
-    let env = Proofview.Goal.env gl in
-    Tacticals.New.tclZEROMSG (str "Must evaluate to a closed term" ++ fnl() ++
-      str "offending expression: " ++ fnl() ++ pr_inspect env e result)
-  end
-
-
-(* Interprets tactic expressions : returns a "tactic" *)
-and interp_tactic ist tac : unit Proofview.tactic =
-  Ftactic.run (val_interp ist tac) (fun v -> tactic_of_value ist v)
-
-(* Provides a "name" for the trace to atomic tactics *)
-and name_atomic ?env tacexpr tac : unit Proofview.tactic =
-  begin match env with
-  | Some e -> Proofview.tclUNIT e
-  | None -> Proofview.tclENV
-  end >>= fun env ->
-  let name () = Pptactic.pr_tactic env (TacAtom (Loc.ghost,tacexpr)) in
-  Proofview.Trace.name_tactic name tac
-
-(* Interprets a primitive tactic *)
-and interp_atomic ist tac : unit Proofview.tactic =
-  match tac with
-  (* Basic tactics *)
-  | TacIntroPattern l ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let sigma,l' = interp_intro_pattern_list_as_list ist env sigma l in
-        Tacticals.New.tclWITHHOLES false 
-        (name_atomic ~env
-          (TacIntroPattern l)
-          (* spiwack: print uninterpreted, not sure if it is the
-             expected behaviour. *)
-          (Tactics.intros_patterns l')) sigma
-      end
-  | TacIntroMove (ido,hto) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let mloc = interp_move_location ist env sigma hto in
-        let ido = Option.map (interp_ident ist env sigma) ido in
-        name_atomic ~env
-          (TacIntroMove(ido,mloc))
-          (Tactics.intro_move ido mloc)
-      end
-  | TacExact c ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<exact>") begin
-      Proofview.V82.tactic begin fun gl -> 
-        let (sigma,c_interp) = pf_interp_casted_constr ist gl c in
-        tclTHEN
-	  (tclEVARS sigma)
-	  (Tactics.exact_no_check c_interp)
-          gl
-      end
-      end
-  | TacApply (a,ev,cb,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<apply>") begin
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-	let l = List.map (fun (k,c) ->
-          let loc, f = interp_open_constr_with_bindings_loc ist c in
-	    (k,(loc,f))) cb 
-	in
-        let sigma,tac = match cl with
-          | None -> sigma, Tactics.apply_with_delayed_bindings_gen a ev l
-          | Some cl ->
-              let sigma,(id,cl) = interp_in_hyp_as ist env sigma cl in
-              sigma, Tactics.apply_delayed_in a ev id l cl in
-        Tacticals.New.tclWITHHOLES ev tac sigma
-      end
-      end
-  | TacElim (ev,(keep,cb),cbo) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in 
-        let sigma, cb = interp_constr_with_bindings ist env sigma cb in
-        let sigma, cbo = Option.fold_map (interp_constr_with_bindings ist env) sigma cbo in
-        let named_tac =
-          let tac = Tactics.elim ev keep cb cbo in
-          name_atomic ~env (TacElim (ev,(keep,cb),cbo)) tac
-        in
-        Tacticals.New.tclWITHHOLES ev named_tac sigma
-      end
-  | TacCase (ev,(keep,cb)) ->
-      Proofview.Goal.enter begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let env = Proofview.Goal.env gl in
-        let sigma, cb = interp_constr_with_bindings ist env sigma cb in
-        let named_tac =
-          let tac = Tactics.general_case_analysis ev keep cb in
-          name_atomic ~env (TacCase(ev,(keep,cb))) tac
-        in
-        Tacticals.New.tclWITHHOLES ev named_tac sigma
-      end
-  | TacFix (idopt,n) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let idopt = Option.map (interp_ident ist env sigma) idopt in
-        name_atomic ~env
-          (TacFix(idopt,n))
-          (Proofview.V82.tactic (Tactics.fix idopt n))
-      end
-  | TacMutualFix (id,n,l) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual fix>") begin
-      Proofview.V82.tactic begin fun gl ->
-        let env = pf_env gl in
-        let f sigma (id,n,c) =
-	  let (sigma,c_interp) = pf_interp_type ist { gl with sigma=sigma } c in
-	  sigma , (interp_ident ist env sigma id,n,c_interp) in
-        let (sigma,l_interp) =
-          Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
-        in
-        tclTHEN
-	  (tclEVARS sigma)
-	  (Tactics.mutual_fix (interp_ident ist env sigma id) n l_interp 0)
-          gl
-      end
-      end
-  | TacCofix idopt ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let idopt = Option.map (interp_ident ist env sigma) idopt in
-        name_atomic ~env
-          (TacCofix (idopt))
-          (Proofview.V82.tactic (Tactics.cofix idopt))
-      end
-  | TacMutualCofix (id,l) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual cofix>") begin
-      Proofview.V82.tactic begin fun gl ->
-        let env = pf_env gl in
-        let f sigma (id,c) =
-	  let (sigma,c_interp) = pf_interp_type ist { gl with sigma=sigma } c in
-	  sigma , (interp_ident ist env sigma id,c_interp) in
-        let (sigma,l_interp) =
-          Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
-        in
-        tclTHEN
-	  (tclEVARS sigma)
-	  (Tactics.mutual_cofix (interp_ident ist env sigma id) l_interp 0)
-          gl
-      end
-      end
-  | TacAssert (b,t,ipat,c) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let (sigma,c) = 
-          (if Option.is_empty t then interp_constr else interp_type) ist env sigma c
-        in
-        let sigma, ipat' = interp_intro_pattern_option ist env sigma ipat in
-        let tac = Option.map (interp_tactic ist) t in
-        Tacticals.New.tclWITHHOLES false
-        (name_atomic ~env
-          (TacAssert(b,t,ipat,c))
-          (Tactics.forward b tac ipat' c)) sigma
-      end
-  | TacGeneralize cl ->
-      Proofview.Goal.enter begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let env = Proofview.Goal.env gl in
-        let sigma, cl = interp_constr_with_occurrences_and_name_as_list ist env sigma cl in
-        Tacticals.New.tclWITHHOLES false
-        (name_atomic ~env
-          (TacGeneralize cl)
-          (Proofview.V82.tactic (Tactics.Simple.generalize_gen cl))) sigma
-      end
-  | TacGeneralizeDep c ->
-      (new_interp_constr ist c) (fun c ->
-        name_atomic (* spiwack: probably needs a goal environment *)
-        (TacGeneralizeDep c)
-        (Proofview.V82.tactic (Tactics.generalize_dep c))
-       )
-  | TacLetTac (na,c,clp,b,eqpat) ->
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let clp = interp_clause ist env sigma clp in
-        let eqpat = interp_intro_pattern_naming_option ist env sigma eqpat in
-        if Locusops.is_nowhere clp then
-        (* We try to fully-typecheck the term *)
-          let (sigma,c_interp) =
-            Tacmach.New.of_old (fun gl -> pf_interp_constr ist gl c) gl
-          in
-          let let_tac b na c cl eqpat =
-            let id = Option.default (Loc.ghost,IntroAnonymous) eqpat in
-            let with_eq = if b then None else Some (true,id) in
-            Tactics.letin_tac with_eq na c None cl
-          in
-          let na = interp_name ist env sigma na in
-          Tacticals.New.tclWITHHOLES false
-          (name_atomic ~env
-            (TacLetTac(na,c_interp,clp,b,eqpat))
-            (let_tac b na c_interp clp eqpat)) sigma
-        else
-        (* We try to keep the pattern structure as much as possible *)
-          let let_pat_tac b na c cl eqpat =
-            let id = Option.default (Loc.ghost,IntroAnonymous) eqpat in
-            let with_eq = if b then None else Some (true,id) in
-            Tactics.letin_pat_tac with_eq na c cl
-          in
-          let (sigma',c) = interp_pure_open_constr ist env sigma c in
-          name_atomic ~env
-            (TacLetTac(na,c,clp,b,eqpat))
-	    (Tacticals.New.tclWITHHOLES false (*in hope of a future "eset/epose"*)
-               (let_pat_tac b (interp_name ist env sigma na)
-                  ((sigma,sigma'),c) clp eqpat) sigma')
-      end
-
-  (* Automation tactics *)
-  | TacTrivial (debug,lems,l) ->
-      begin if debug == Tacexpr.Info then
-          msg_warning
-	    (strbrk"The \"info_trivial\" tactic" ++ spc ()
-           ++strbrk"does not print traces anymore." ++ spc()
-           ++strbrk"Use \"Info 1 trivial\", instead.")
-      end;
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let lems = interp_auto_lemmas ist env sigma lems in
-        name_atomic ~env
-          (TacTrivial(debug,List.map snd lems,l))
-          (Auto.h_trivial ~debug
-	     lems
-	     (Option.map (List.map (interp_hint_base ist)) l))
-      end
-  | TacAuto (debug,n,lems,l) ->
-      begin if debug == Tacexpr.Info then
-          msg_warning
-	    (strbrk"The \"info_auto\" tactic" ++ spc ()
-           ++strbrk"does not print traces anymore." ++ spc()
-           ++strbrk"Use \"Info 1 auto\", instead.")
-      end;
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let lems = interp_auto_lemmas ist env sigma lems in
-        name_atomic ~env
-          (TacAuto(debug,n,List.map snd lems,l))
-          (Auto.h_auto ~debug (Option.map (interp_int_or_var ist) n)
-	     lems
-	     (Option.map (List.map (interp_hint_base ist)) l))
-      end
-
-  (* Derived basic tactics *)
-  | TacInductionDestruct (isrec,ev,(l,el)) ->
-      (* spiwack: some unknown part of destruct needs the goal to be
-         prenormalised. *)
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let sigma,l =
-          List.fold_map begin fun sigma (c,(ipato,ipats),cls) ->
-            (* TODO: move sigma as a side-effect *)
-             (* spiwack: the [*p] variants are for printing *)
-            let cp = c in
-            let c = Tacmach.New.of_old (fun gl -> interp_induction_arg ist gl c) gl in
-            let ipato = interp_intro_pattern_naming_option ist env sigma ipato in
-            let ipatsp = ipats in
-            let sigma,ipats = interp_or_and_intro_pattern_option ist env sigma ipats in
-            let cls = Option.map (interp_clause ist env sigma) cls in
-            sigma,((c,(ipato,ipats),cls),(cp,(ipato,ipatsp),cls))
-          end sigma l
-        in
-        let l,lp = List.split l in
-        let sigma,el =
-          Option.fold_map (interp_constr_with_bindings ist env) sigma el in
-        name_atomic ~env
-          (TacInductionDestruct(isrec,ev,(lp,el)))
-          (Tacticals.New.tclTHEN
-             (Proofview.Unsafe.tclEVARS sigma)
-             (Tactics.induction_destruct isrec ev (l,el)))
-      end
-  | TacDoubleInduction (h1,h2) ->
-      let h1 = interp_quantified_hypothesis ist h1 in
-      let h2 = interp_quantified_hypothesis ist h2 in
-      name_atomic
-        (TacDoubleInduction (h1,h2))
-        (Elim.h_double_induction h1 h2)
-  (* Context management *)
-  | TacClear (b,l) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Tacmach.New.pf_env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let l = interp_hyp_list ist env sigma l in
-        if b then name_atomic ~env (TacClear (b, l)) (Tactics.keep l)
-        else
-          (* spiwack: until the tactic is in the monad *)
-          let tac = Proofview.V82.tactic (fun gl -> Tactics.clear l gl) in
-          Proofview.Trace.name_tactic (fun () -> Pp.str"<clear>") tac
-      end
-  | TacClearBody l ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Tacmach.New.pf_env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let l = interp_hyp_list ist env sigma l in
-        name_atomic ~env
-          (TacClearBody l)
-          (Tactics.clear_body l)
-      end
-  | TacMove (id1,id2) ->
-      Proofview.V82.tactic begin fun gl -> 
-        Tactics.move_hyp (interp_hyp ist (pf_env gl) (project gl) id1)
-                   (interp_move_location ist (pf_env gl) (project gl) id2)
-                   gl
-      end
-  | TacRename l ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Tacmach.New.pf_env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let l =
-          List.map (fun (id1,id2) ->
-	    interp_hyp ist env sigma id1,
-	    interp_ident ist env sigma (snd id2)) l
-        in
-        name_atomic ~env
-          (TacRename l)
-          (Tactics.rename_hyp l)
-      end
-
-  (* Constructors *)
-  | TacSplit (ev,bll) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let sigma, bll = List.fold_map (interp_bindings ist env) sigma bll in
-        let named_tac =
-          let tac = Tactics.split_with_bindings ev bll in
-          name_atomic ~env (TacSplit (ev, bll)) tac
-        in
-        Tacticals.New.tclWITHHOLES ev named_tac sigma
-      end
-  (* Conversion *)
-  | TacReduce (r,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<reduce>") begin
-      Proofview.V82.tactic begin fun gl -> 
-        let (sigma,r_interp) = interp_red_expr ist (pf_env gl) (project gl) r in
-        tclTHEN
-	  (tclEVARS sigma)
-	  (Tactics.reduce r_interp (interp_clause ist (pf_env gl) (project gl) cl))
-          gl
-      end
-      end
-  | TacChange (None,c,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<change>") begin
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.V82.tactic begin fun gl ->
-        let is_onhyps = match cl.onhyps with
-          | None | Some [] -> true
-          | _ -> false
-        in
-        let is_onconcl = match cl.concl_occs with
-          | AllOccurrences | NoOccurrences -> true
-          | _ -> false
-        in
-        let c_interp patvars sigma =
-	  let lfun' = Id.Map.fold (fun id c lfun ->
-	    Id.Map.add id (Value.of_constr c) lfun) 
-	    patvars ist.lfun
-	  in
-	  let ist = { ist with lfun = lfun' } in
-	  if is_onhyps && is_onconcl
-	  then interp_type ist (pf_env gl) sigma c
-	  else interp_constr ist (pf_env gl) sigma c
-        in
-	  (Tactics.change None c_interp (interp_clause ist (pf_env gl) (project gl) cl))
-          gl
-      end
-      end
-  | TacChange (Some op,c,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<change>") begin
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        Proofview.V82.tactic begin fun gl -> 
-          let op = interp_typed_pattern ist env sigma op in
-          let to_catch = function Not_found -> true | e -> Errors.is_anomaly e in
-          let c_interp patvars sigma =
-	    let lfun' = Id.Map.fold (fun id c lfun ->
-	      Id.Map.add id (Value.of_constr c) lfun) 
-	      patvars ist.lfun
-	    in
-	    let ist = { ist with lfun = lfun' } in
-	      try interp_constr ist env sigma c
-	      with e when to_catch e (* Hack *) ->
-		errorlabstrm "" (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
-          in
-	    (Tactics.change (Some op) c_interp (interp_clause ist env sigma cl))
-	      gl
-        end
-      end
-      end
-
-  (* Equivalence relations *)
-  | TacSymmetry c ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let cl = interp_clause ist env sigma c in
-        name_atomic ~env
-          (TacSymmetry cl)
-          (Tactics.intros_symmetry cl)
-      end
-
-  (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) ->
-      Proofview.Goal.enter begin fun gl ->
-        let l' = List.map (fun (b,m,(keep,c)) ->
-          let f env sigma = interp_open_constr_with_bindings ist env sigma c in
-	  (b,m,keep,f)) l in
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let cl = interp_clause ist env sigma cl in
-        name_atomic ~env
-          (TacRewrite (ev,l,cl,by))
-          (Equality.general_multi_rewrite ev l' cl
-             (Option.map (fun by -> Tacticals.New.tclCOMPLETE (interp_tactic ist by),
-               Equality.Naive)
-                by))
-      end
-  | TacInversion (DepInversion (k,c,ids),hyp) ->
-      Proofview.Goal.nf_enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let (sigma,c_interp) =
-          match c with
-          | None -> sigma , None
-          | Some c ->
-              let (sigma,c_interp) =
-                Tacmach.New.of_old (fun gl -> pf_interp_constr ist gl c) gl
-              in
-              sigma , Some c_interp
-        in
-        let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
-        let sigma,ids_interp = interp_or_and_intro_pattern_option ist env sigma ids in
-        Tacticals.New.tclWITHHOLES false
-        (name_atomic ~env
-          (TacInversion(DepInversion(k,c_interp,ids),dqhyps))
-          (Inv.dinv k c_interp ids_interp dqhyps)) sigma
-      end
-  | TacInversion (NonDepInversion (k,idl,ids),hyp) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let hyps = interp_hyp_list ist env sigma idl in
-        let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
-        let sigma, ids_interp = interp_or_and_intro_pattern_option ist env sigma ids in
-        Tacticals.New.tclWITHHOLES false
-        (name_atomic ~env
-          (TacInversion (NonDepInversion (k,hyps,ids),dqhyps))
-          (Inv.inv_clause k ids_interp hyps dqhyps)) sigma
-      end
-  | TacInversion (InversionUsing (c,idl),hyp) ->
-      Proofview.Goal.enter begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = Proofview.Goal.sigma gl in
-        let (sigma,c_interp) = interp_constr ist env sigma c in
-        let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
-        let hyps = interp_hyp_list ist env sigma idl in
-        Proofview.Unsafe.tclEVARS sigma <*>
-        name_atomic ~env
-          (TacInversion (InversionUsing (c_interp,hyps),dqhyps))
-          (Leminv.lemInv_clause dqhyps c_interp hyps)
-      end
-
-(* Initial call for interpretation *)
-
-let default_ist () =
-  let extra = TacStore.set TacStore.empty f_debug (get_debug ()) in
-  { lfun = Id.Map.empty; extra = extra }
-
-let eval_tactic t =
-  Proofview.tclUNIT () >>= fun () -> (* delay for [default_ist] *)
-  Proofview.tclLIFT db_initialize <*>
-  interp_tactic (default_ist ()) t
-
-let eval_tactic_ist ist t =
-  Proofview.tclLIFT db_initialize <*>
-  interp_tactic ist t
-
-(* globalization + interpretation *)
-
-
-let interp_tac_gen lfun avoid_ids debug t =
-  Proofview.Goal.enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let extra = TacStore.set TacStore.empty f_debug debug in
-  let extra = TacStore.set extra f_avoid_ids avoid_ids in
-  let ist = { lfun = lfun; extra = extra } in
-  let ltacvars = Id.Map.domain lfun in
-  interp_tactic ist
-    (intern_pure_tactic {
-      ltacvars; genv = env } t)
-  end
-
-let interp t = interp_tac_gen Id.Map.empty [] (get_debug()) t
-let _ = Proof_global.set_interp_tac interp
-
-(* Used to hide interpretation for pretty-print, now just launch tactics *)
-(* [global] means that [t] should be internalized outside of goals. *)
-let hide_interp global t ot =
-  let hide_interp env =
-    let ist = { ltacvars = Id.Set.empty; genv = env } in
-    let te = intern_pure_tactic ist t in
-    let t = eval_tactic te in
-    match ot with
-    | None -> t
-    | Some t' -> Tacticals.New.tclTHEN t t'
-  in
-  if global then
-    Proofview.tclENV >>= fun env ->
-    hide_interp env
-  else
-    Proofview.Goal.enter begin fun gl ->
-      hide_interp (Proofview.Goal.env gl)
-    end
-
-(***************************************************************************)
-(** Register standard arguments *)
-
-let def_intern ist x = (ist, x)
-let def_subst _ x = x
-let def_interp ist gl x = (project gl, x)
-
-let declare_uniform t =
-  Genintern.register_intern0 t def_intern;
-  Genintern.register_subst0 t def_subst;
-  Geninterp.register_interp0 t def_interp
-
-let () =
-  declare_uniform wit_unit
-
-let () =
-  declare_uniform wit_int
-
-let () =
-  declare_uniform wit_bool
-
-let () =
-  declare_uniform wit_string
-
-let () =
-  declare_uniform wit_pre_ident
-
-let () =
-  let interp ist gl ref = (project gl, interp_reference ist (pf_env gl) (project gl) ref) in
-  Geninterp.register_interp0 wit_ref interp;
-  let interp ist gl pat = interp_intro_pattern ist (pf_env gl) (project gl) pat in
-  Geninterp.register_interp0 wit_intro_pattern interp;
-  let interp ist gl pat = (project gl, interp_clause ist (pf_env gl) (project gl) pat) in
-  Geninterp.register_interp0 wit_clause_dft_concl interp;
-  let interp ist gl s = interp_sort (project gl) s in
-  Geninterp.register_interp0 wit_sort interp
-
-let () =
-  let interp ist gl tac =
-    let f = VFun (UnnamedAppl,extract_trace ist, ist.lfun, [], tac) in
-    (project gl, TacArg (dloc, valueIn (of_tacvalue f)))
-  in
-  Geninterp.register_interp0 wit_tactic interp
-
-let () =
-  Geninterp.register_interp0 wit_uconstr (fun ist gl c ->
-     project gl , interp_uconstr ist (pf_env gl) c
-  )
-
-(***************************************************************************)
-(* Other entry points *)
-
-let val_interp ist tac k = Ftactic.run (val_interp ist tac) k
-
-let interp_ltac_constr ist c k = Ftactic.run (interp_ltac_constr ist c) k
-
-let interp_redexp env sigma r =
-  let ist = default_ist () in
-  let gist = { fully_empty_glob_sign with genv = env; } in
-  interp_red_expr ist env sigma (intern_red_expr gist r)
-
-(***************************************************************************)
-(* Embed tactics in raw or glob tactic expr *)
-
-let globTacticIn t = TacArg (dloc,TacDynamic (dloc,tactic_in t))
-let tacticIn t =
-  globTacticIn (fun ist ->
-    try glob_tactic (t ist)
-    with e when Errors.noncritical e -> anomaly ~label:"tacticIn"
-      (str "Incorrect tactic expression. Received exception is:" ++
-       Errors.print e))
-
-(***************************************************************************)
-(* Backwarding recursive needs of tactic glob/interp/eval functions *)
-
-let _ =
-  let eval ty env sigma lfun arg =
-    let ist = { lfun = lfun; extra = TacStore.empty; } in
-    if has_type arg (glbwit wit_tactic) then
-      let tac = out_gen (glbwit wit_tactic) arg in
-      let tac = interp_tactic ist tac in
-      Pfedit.refine_by_tactic env sigma ty tac
-    else
-      failwith "not a tactic"
-  in
-  Hook.set Pretyping.genarg_interp_hook eval
-
-let _ = Hook.set Auto.extern_interp
-  (fun l ->
-    let lfun = Id.Map.map (fun c -> Value.of_constr c) l in
-    let ist = { (default_ist ()) with lfun; } in
-    interp_tactic ist)
-
-(** Used in tactic extension **)
-
-let dummy_id = Id.of_string "_"
-
-let lift_constr_tac_to_ml_tac vars tac =
-  let tac _ ist = Proofview.Goal.enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let map = function
-    | None -> None
-    | Some id ->
-      let c = Id.Map.find id ist.lfun in
-      try Some (coerce_to_closed_constr env c)
-      with CannotCoerceTo ty ->
-        error_ltac_variable Loc.ghost dummy_id (Some (env,sigma)) c ty
-    in
-    let args = List.map_filter map vars in
-    tac args ist
-  end in
-  tac
diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli
deleted file mode 100644
index ac7e2149..00000000
--- a/tactics/tacinterp.mli
+++ /dev/null
@@ -1,125 +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        *)
-(************************************************************************)
-
-open Names
-open Tactic_debug
-open Term
-open Tacexpr
-open Genarg
-open Redexpr
-open Misctypes
-
-module Value :
-sig
-  type t = tlevel generic_argument
-  val of_constr : constr -> t
-  val to_constr : t -> constr option
-  val of_int : int -> t
-  val to_int : t -> int option
-  val to_list : t -> t list option
-  val of_closure : Geninterp.interp_sign -> glob_tactic_expr -> t
-end
-
-(** Values for interpretation *)
-type value = Value.t
-
-module TacStore : Store.S with
-  type t = Geninterp.TacStore.t
-  and type 'a field = 'a Geninterp.TacStore.field
-
-(** Signature for interpretation: val\_interp and interpretation functions *)
-type interp_sign = Geninterp.interp_sign = {
-  lfun : value Id.Map.t;
-  extra : TacStore.t }
-
-val f_avoid_ids : Id.t list TacStore.field
-val f_debug : debug_info TacStore.field
-
-val extract_ltac_constr_values : interp_sign -> Environ.env ->
-  Pattern.constr_under_binders Id.Map.t
-(** Given an interpretation signature, extract all values which are coercible to
-    a [constr]. *)
-
-(** To embed several objects in Coqast.t *)
-val tactic_in : (interp_sign -> glob_tactic_expr) -> Dyn.t
-val tactic_out : Dyn.t -> (interp_sign -> glob_tactic_expr)
-
-val tacticIn : (interp_sign -> raw_tactic_expr) -> raw_tactic_expr
-val globTacticIn : (interp_sign -> glob_tactic_expr) -> raw_tactic_expr
-val valueIn : value -> raw_tactic_arg
-
-(** Sets the debugger mode *)
-val set_debug : debug_info -> unit
-
-(** Gives the state of debug *)
-val get_debug : unit -> debug_info
-
-(** Adds an interpretation function for extra generic arguments *)
-
-(* spiwack: the [Term.constr] argument is the conclusion of the goal,
-   for "casted open constr" *)
-val interp_genarg : interp_sign -> Environ.env -> Evd.evar_map -> Term.constr -> Goal.goal ->
-  glob_generic_argument -> Evd.evar_map * typed_generic_argument
-
-(** Interprets any expression *)
-val val_interp : interp_sign -> glob_tactic_expr -> (value -> unit Proofview.tactic) -> unit Proofview.tactic
-
-(** Interprets an expression that evaluates to a constr *)
-val interp_ltac_constr : interp_sign -> glob_tactic_expr -> (constr -> unit Proofview.tactic) -> unit Proofview.tactic
-
-(** Interprets redexp arguments *)
-val interp_redexp : Environ.env -> Evd.evar_map -> raw_red_expr -> Evd.evar_map * red_expr
-
-(** Interprets tactic expressions *)
-
-val interp_hyp : interp_sign -> Environ.env -> Evd.evar_map ->
-  Id.t Loc.located -> Id.t
-
-val interp_bindings : interp_sign -> Environ.env -> Evd.evar_map ->
- glob_constr_and_expr bindings -> Evd.evar_map * constr bindings
-
-val interp_open_constr_with_bindings : interp_sign -> Environ.env -> Evd.evar_map ->
-  glob_constr_and_expr with_bindings -> Evd.evar_map * constr with_bindings
-
-(** Initial call for interpretation *)
-
-val eval_tactic : glob_tactic_expr -> unit Proofview.tactic
-
-val eval_tactic_ist : interp_sign -> glob_tactic_expr -> unit Proofview.tactic
-(** Same as [eval_tactic], but with the provided [interp_sign]. *)
-
-(** Globalization + interpretation *)
-
-val interp_tac_gen : value Id.Map.t -> Id.t list ->
-                 debug_info -> raw_tactic_expr -> unit Proofview.tactic
-
-val interp : raw_tactic_expr -> unit Proofview.tactic
-
-(** Hides interpretation for pretty-print *)
-
-val hide_interp : bool -> raw_tactic_expr -> unit Proofview.tactic option -> unit Proofview.tactic
-
-(** Internals that can be useful for syntax extensions. *)
-
-val interp_ltac_var : (value -> 'a) -> interp_sign ->
-  (Environ.env * Evd.evar_map) option -> Id.t Loc.located -> 'a
-
-val interp_int : interp_sign -> Id.t Loc.located -> int
-
-val interp_int_or_var : interp_sign -> int or_var -> int
-
-val error_ltac_variable : Loc.t -> Id.t ->
-  (Environ.env * Evd.evar_map) option -> value -> string -> 'a
-
-(** Transforms a constr-expecting tactic into a tactic finding its arguments in
-    the Ltac environment according to the given names. *)
-val lift_constr_tac_to_ml_tac : Id.t option list ->
-  (constr list -> Geninterp.interp_sign -> unit Proofview.tactic) -> Tacenv.ml_tactic
-
-val default_ist : unit -> Geninterp.interp_sign
-(** Empty ist with debug set on the current value. *)
diff --git a/tactics/tacsubst.ml b/tactics/tacsubst.ml
deleted file mode 100644
index cef630da..00000000
--- a/tactics/tacsubst.ml
+++ /dev/null
@@ -1,350 +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        *)
-(************************************************************************)
-
-open Util
-open Tacexpr
-open Mod_subst
-open Genarg
-open Constrarg
-open Misctypes
-open Globnames
-open Term
-open Genredexpr
-open Patternops
-open Pretyping
-
-(** Substitution of tactics at module closing time *)
-
-(** For generic arguments, we declare and store substitutions
-    in a table *)
-
-let subst_quantified_hypothesis _ x = x
-
-let subst_declared_or_quantified_hypothesis _ x = x
-
-let subst_glob_constr_and_expr subst (c, e) =
-  (Detyping.subst_glob_constr subst c, e)
-
-let subst_glob_constr = subst_glob_constr_and_expr (* shortening *)
-
-let subst_binding subst (loc,b,c) =
-  (loc,subst_quantified_hypothesis subst b,subst_glob_constr subst c)
-
-let subst_bindings subst = function
-  | NoBindings -> NoBindings
-  | ImplicitBindings l -> ImplicitBindings (List.map (subst_glob_constr subst) l)
-  | ExplicitBindings l -> ExplicitBindings (List.map (subst_binding subst) l)
-
-let subst_glob_with_bindings subst (c,bl) =
-  (subst_glob_constr subst c, subst_bindings subst bl)
-
-let subst_glob_with_bindings_arg subst (clear,c) =
-  (clear,subst_glob_with_bindings subst c)
-
-let rec subst_intro_pattern subst = function
-  | loc,IntroAction p -> loc, IntroAction (subst_intro_pattern_action subst p)
-  | loc, IntroNaming _ | loc, IntroForthcoming _ as x -> x
-
-and subst_intro_pattern_action subst = function
-  | IntroApplyOn (t,pat) ->
-      IntroApplyOn (subst_glob_constr subst t,subst_intro_pattern subst pat)
-  | IntroOrAndPattern l ->
-      IntroOrAndPattern (List.map (List.map (subst_intro_pattern subst)) l)
-  | IntroInjection l -> IntroInjection (List.map (subst_intro_pattern subst) l)
-  | IntroWildcard | IntroRewrite _ as x -> x
-
-let subst_induction_arg subst = function
-  | clear,ElimOnConstr c -> clear,ElimOnConstr (subst_glob_with_bindings subst c)
-  | clear,ElimOnAnonHyp n as x -> x
-  | clear,ElimOnIdent id as x -> x
-
-let subst_and_short_name f (c,n) =
-(*  assert (n=None); *)(* since tacdef are strictly globalized *)
-  (f c,None)
-
-let subst_or_var f =  function
-  | ArgVar _ as x -> x
-  | ArgArg x -> ArgArg (f x)
-
-let dloc = Loc.ghost
-
-let subst_located f (_loc,id) = (dloc,f id)
-
-let subst_reference subst =
-  subst_or_var (subst_located (subst_kn subst))
-
-(*CSC: subst_global_reference is used "only" for RefArgType, that propagates
-  to the syntactic non-terminals "global", used in commands such as
-  Print. It is also used for non-evaluable references. *)
-open Pp
-open Printer
-
-let subst_global_reference subst =
- let subst_global ref =
-  let ref',t' = subst_global subst ref in
-   if not (eq_constr (Universes.constr_of_global ref') t') then
-    msg_warning (strbrk "The reference " ++ pr_global ref ++ str " is not " ++
-          str " expanded to \"" ++ pr_lconstr t' ++ str "\", but to " ++
-          pr_global ref') ;
-   ref'
- in
-  subst_or_var (subst_located subst_global)
-
-let subst_evaluable subst =
-  let subst_eval_ref = subst_evaluable_reference subst in
-    subst_or_var (subst_and_short_name subst_eval_ref)
-
-let subst_constr_with_occurrences subst (l,c) = (l,subst_glob_constr subst c)
-
-let subst_glob_constr_or_pattern subst (c,p) =
-  (subst_glob_constr subst c,subst_pattern subst p)
-
-let subst_redexp subst =
-  Miscops.map_red_expr_gen
-    (subst_glob_constr subst)
-    (subst_evaluable subst)
-    (subst_glob_constr_or_pattern subst)
-
-let subst_raw_may_eval subst = function
-  | ConstrEval (r,c) -> ConstrEval (subst_redexp subst r,subst_glob_constr subst c)
-  | ConstrContext (locid,c) -> ConstrContext (locid,subst_glob_constr subst c)
-  | ConstrTypeOf c -> ConstrTypeOf (subst_glob_constr subst c)
-  | ConstrTerm c -> ConstrTerm (subst_glob_constr subst c)
-
-let subst_match_pattern subst = function
-  | Subterm (b,ido,pc) -> Subterm (b,ido,(subst_glob_constr_or_pattern subst pc))
-  | Term pc -> Term (subst_glob_constr_or_pattern subst pc)
-
-let rec subst_match_goal_hyps subst = function
-  | Hyp (locs,mp) :: tl ->
-      Hyp (locs,subst_match_pattern subst mp)
-      :: subst_match_goal_hyps subst tl
-  | Def (locs,mv,mp) :: tl ->
-      Def (locs,subst_match_pattern subst mv, subst_match_pattern subst mp)
-      :: subst_match_goal_hyps subst tl
-  | [] -> []
-
-let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
-  (* Basic tactics *)
-  | TacIntroPattern l -> TacIntroPattern (List.map (subst_intro_pattern subst) l)
-  | TacIntroMove _ as x -> x
-  | TacExact c -> TacExact (subst_glob_constr subst c)
-  | TacApply (a,ev,cb,cl) ->
-      TacApply (a,ev,List.map (subst_glob_with_bindings_arg subst) cb,cl)
-  | TacElim (ev,cb,cbo) ->
-      TacElim (ev,subst_glob_with_bindings_arg subst cb,
-               Option.map (subst_glob_with_bindings subst) cbo)
-  | TacCase (ev,cb) -> TacCase (ev,subst_glob_with_bindings_arg subst cb)
-  | TacFix (idopt,n) as x -> x
-  | TacMutualFix (id,n,l) ->
-      TacMutualFix(id,n,List.map (fun (id,n,c) -> (id,n,subst_glob_constr subst c)) l)
-  | TacCofix idopt as x -> x
-  | TacMutualCofix (id,l) ->
-      TacMutualCofix (id, List.map (fun (id,c) -> (id,subst_glob_constr subst c)) l)
-  | TacAssert (b,otac,na,c) ->
-      TacAssert (b,Option.map (subst_tactic subst) otac,na,subst_glob_constr subst c)
-  | TacGeneralize cl ->
-      TacGeneralize (List.map (on_fst (subst_constr_with_occurrences subst))cl)
-  | TacGeneralizeDep c -> TacGeneralizeDep (subst_glob_constr subst c)
-  | TacLetTac (id,c,clp,b,eqpat) ->
-    TacLetTac (id,subst_glob_constr subst c,clp,b,eqpat)
-
-  (* Automation tactics *)
-  | TacTrivial (d,lems,l) -> TacTrivial (d,List.map (subst_glob_constr subst) lems,l)
-  | TacAuto (d,n,lems,l) -> TacAuto (d,n,List.map (subst_glob_constr subst) lems,l)
-
-  (* Derived basic tactics *)
-  | TacInductionDestruct (isrec,ev,(l,el)) ->
-      let l' = List.map (fun (c,ids,cls) ->
-        subst_induction_arg subst c, ids, cls) l in
-      let el' = Option.map (subst_glob_with_bindings subst) el in
-      TacInductionDestruct (isrec,ev,(l',el'))
-  | TacDoubleInduction (h1,h2) as x -> x
-
-  (* Context management *)
-  | TacClear _ as x -> x
-  | TacClearBody l as x -> x
-  | TacMove (id1,id2) as x -> x
-  | TacRename l as x -> x
-
-  (* Constructors *)
-  | TacSplit (ev,bll) -> TacSplit (ev,List.map (subst_bindings subst) bll)
-
-  (* Conversion *)
-  | TacReduce (r,cl) -> TacReduce (subst_redexp subst r, cl)
-  | TacChange (op,c,cl) ->
-      TacChange (Option.map (subst_glob_constr_or_pattern subst) op,
-        subst_glob_constr subst c, cl)
-
-  (* Equivalence relations *)
-  | TacSymmetry _ as x -> x
-
-  (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) ->
-      TacRewrite (ev,
-		  List.map (fun (b,m,c) ->
-			      b,m,subst_glob_with_bindings_arg subst c) l,
-		 cl,Option.map (subst_tactic subst) by)
-  | TacInversion (DepInversion (k,c,l),hyp) ->
-     TacInversion (DepInversion (k,Option.map (subst_glob_constr subst) c,l),hyp)
-  | TacInversion (NonDepInversion _,_) as x -> x
-  | TacInversion (InversionUsing (c,cl),hyp) ->
-      TacInversion (InversionUsing (subst_glob_constr subst c,cl),hyp)
-
-and subst_tactic subst (t:glob_tactic_expr) = match t with
-  | TacAtom (_loc,t) -> TacAtom (dloc, subst_atomic subst t)
-  | TacFun tacfun -> TacFun (subst_tactic_fun subst tacfun)
-  | TacLetIn (r,l,u) ->
-      let l = List.map (fun (n,b) -> (n,subst_tacarg subst b)) l in
-      TacLetIn (r,l,subst_tactic subst u)
-  | TacMatchGoal (lz,lr,lmr) ->
-      TacMatchGoal(lz,lr, subst_match_rule subst lmr)
-  | TacMatch (lz,c,lmr) ->
-      TacMatch (lz,subst_tactic subst c,subst_match_rule subst lmr)
-  | TacId _ | TacFail _ as x -> x
-  | TacProgress tac -> TacProgress (subst_tactic subst tac:glob_tactic_expr)
-  | TacShowHyps tac -> TacShowHyps (subst_tactic subst tac:glob_tactic_expr)
-  | TacAbstract (tac,s) -> TacAbstract (subst_tactic subst tac,s)
-  | TacThen (t1,t2) ->
-      TacThen (subst_tactic subst t1, subst_tactic subst t2)
-  | TacDispatch tl -> TacDispatch (List.map (subst_tactic subst) tl)
-  | TacExtendTac (tf,t,tl) ->
-      TacExtendTac (Array.map (subst_tactic subst) tf,
-	            subst_tactic subst t,
-                    Array.map (subst_tactic subst) tl)
-  | TacThens (t,tl) ->
-      TacThens (subst_tactic subst t, List.map (subst_tactic subst) tl)
-  | TacThens3parts (t1,tf,t2,tl) ->
-      TacThens3parts (subst_tactic subst t1,Array.map (subst_tactic subst) tf,
-	       subst_tactic subst t2,Array.map (subst_tactic subst) tl)
-  | TacDo (n,tac) -> TacDo (n,subst_tactic subst tac)
-  | TacTimeout (n,tac) -> TacTimeout (n,subst_tactic subst tac)
-  | TacTime (s,tac) -> TacTime (s,subst_tactic subst tac)
-  | TacTry tac -> TacTry (subst_tactic subst tac)
-  | TacInfo tac -> TacInfo (subst_tactic subst tac)
-  | TacRepeat tac -> TacRepeat (subst_tactic subst tac)
-  | TacOr (tac1,tac2) ->
-      TacOr (subst_tactic subst tac1,subst_tactic subst tac2)
-  | TacOnce tac ->
-      TacOnce (subst_tactic subst tac)
-  | TacExactlyOnce tac ->
-      TacExactlyOnce (subst_tactic subst tac)
-  | TacIfThenCatch (tac,tact,tace) ->
-      TacIfThenCatch (
-        subst_tactic subst tac,
-        subst_tactic subst tact,
-        subst_tactic subst tace)
-  | TacOrelse (tac1,tac2) ->
-      TacOrelse (subst_tactic subst tac1,subst_tactic subst tac2)
-  | TacFirst l -> TacFirst (List.map (subst_tactic subst) l)
-  | TacSolve l -> TacSolve (List.map (subst_tactic subst) l)
-  | TacComplete tac -> TacComplete (subst_tactic subst tac)
-  | TacArg (_,a) -> TacArg (dloc,subst_tacarg subst a)
-
-  (* For extensions *)
-  | TacAlias (_,s,l) ->
-      let s = subst_kn subst s in
-      TacAlias (dloc,s,List.map (fun (id,a) -> (id,subst_genarg subst a)) l)
-  | TacML (_loc,opn,l) -> TacML (dloc,opn,List.map (subst_genarg subst) l)
-
-and subst_tactic_fun subst (var,body) = (var,subst_tactic subst body)
-
-and subst_tacarg subst = function
-  | Reference r -> Reference (subst_reference subst r)
-  | ConstrMayEval c -> ConstrMayEval (subst_raw_may_eval subst c)
-  | UConstr c -> UConstr (subst_glob_constr subst c)
-  | MetaIdArg (_loc,_,_) -> assert false
-  | TacCall (_loc,f,l) ->
-      TacCall (_loc, subst_reference subst f, List.map (subst_tacarg subst) l)
-  | TacFreshId _ as x -> x
-  | TacPretype c -> TacPretype (subst_glob_constr subst c)
-  | TacNumgoals -> TacNumgoals
-  | Tacexp t -> Tacexp (subst_tactic subst t)
-  | TacGeneric arg -> TacGeneric (Genintern.generic_substitute subst arg)
-  | TacDynamic(the_loc,t) as x ->
-      (match Dyn.tag t with
-	| "tactic" | "value" -> x
-        | "constr" ->
-          TacDynamic(the_loc, constr_in (subst_mps subst (constr_out t)))
-	| s -> Errors.anomaly ~loc:dloc ~label:"Tacinterp.val_interp"
-                 (str "Unknown dynamic: <" ++ str s ++ str ">"))
-
-(* Reads the rules of a Match Context or a Match *)
-and subst_match_rule subst = function
-  | (All tc)::tl ->
-      (All (subst_tactic subst tc))::(subst_match_rule subst tl)
-  | (Pat (rl,mp,tc))::tl ->
-      let hyps = subst_match_goal_hyps subst rl in
-      let pat = subst_match_pattern subst mp in
-      Pat (hyps,pat,subst_tactic subst tc)
-      ::(subst_match_rule subst tl)
-  | [] -> []
-
-and subst_genarg subst (x:glob_generic_argument) =
-  match genarg_tag x with
-  | IntOrVarArgType -> in_gen (glbwit wit_int_or_var) (out_gen (glbwit wit_int_or_var) x)
-  | IdentArgType ->
-      in_gen (glbwit wit_ident) (out_gen (glbwit wit_ident) x)
-  | VarArgType -> in_gen (glbwit wit_var) (out_gen (glbwit wit_var) x)
-  | GenArgType -> in_gen (glbwit wit_genarg) (subst_genarg subst (out_gen (glbwit wit_genarg) x))
-  | ConstrArgType ->
-      in_gen (glbwit wit_constr) (subst_glob_constr subst (out_gen (glbwit wit_constr) x))
-  | ConstrMayEvalArgType ->
-      in_gen (glbwit wit_constr_may_eval) (subst_raw_may_eval subst (out_gen (glbwit wit_constr_may_eval) x))
-  | QuantHypArgType ->
-      in_gen (glbwit wit_quant_hyp)
-        (subst_declared_or_quantified_hypothesis subst
-          (out_gen (glbwit wit_quant_hyp) x))
-  | RedExprArgType ->
-      in_gen (glbwit wit_red_expr) (subst_redexp subst (out_gen (glbwit wit_red_expr) x))
-  | OpenConstrArgType ->
-      in_gen (glbwit wit_open_constr)
-        ((),subst_glob_constr subst (snd (out_gen (glbwit wit_open_constr) x)))
-  | ConstrWithBindingsArgType ->
-      in_gen (glbwit wit_constr_with_bindings)
-        (subst_glob_with_bindings subst (out_gen (glbwit wit_constr_with_bindings) x))
-  | BindingsArgType ->
-      in_gen (glbwit wit_bindings)
-        (subst_bindings subst (out_gen (glbwit wit_bindings) x))
-  | ListArgType _ ->
-    let list_unpacker wit l =
-      let map x =
-        let ans = subst_genarg subst (in_gen (glbwit wit) x) in
-        out_gen (glbwit wit) ans
-      in
-      in_gen (glbwit (wit_list wit)) (List.map map (glb l))
-    in
-    list_unpack { list_unpacker } x
-  | OptArgType _ ->
-    let opt_unpacker wit o = match glb o with
-    | None -> in_gen (glbwit (wit_opt wit)) None
-    | Some x ->
-      let s = out_gen (glbwit wit) (subst_genarg subst (in_gen (glbwit wit) x)) in
-      in_gen (glbwit (wit_opt wit)) (Some s)
-    in
-    opt_unpack { opt_unpacker } x
-  | PairArgType _ ->
-      let pair_unpacker wit1 wit2 o =
-        let p, q = glb o in
-        let p = out_gen (glbwit wit1) (subst_genarg subst (in_gen (glbwit wit1) p)) in
-        let q = out_gen (glbwit wit2) (subst_genarg subst (in_gen (glbwit wit2) q)) in
-        in_gen (glbwit (wit_pair wit1 wit2)) (p, q)
-      in
-      pair_unpack { pair_unpacker } x
-  | ExtraArgType s ->
-      Genintern.generic_substitute subst x
-
-(** Registering *)
-
-let () =
-  Genintern.register_subst0 wit_ref subst_global_reference;
-  Genintern.register_subst0 wit_intro_pattern (fun _ v -> v);
-  Genintern.register_subst0 wit_tactic subst_tactic;
-  Genintern.register_subst0 wit_sort (fun _ v -> v);
-  Genintern.register_subst0 wit_clause_dft_concl (fun _ v -> v);
-  Genintern.register_subst0 wit_uconstr (fun subst c -> subst_glob_constr subst c)
diff --git a/tactics/tacsubst.mli b/tactics/tacsubst.mli
deleted file mode 100644
index c1bf2725..00000000
--- a/tactics/tacsubst.mli
+++ /dev/null
@@ -1,30 +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        *)
-(************************************************************************)
-
-open Tacexpr
-open Mod_subst
-open Genarg
-open Misctypes
-
-(** Substitution of tactics at module closing time *)
-
-val subst_tactic : substitution -> glob_tactic_expr -> glob_tactic_expr
-
-(** For generic arguments, we declare and store substitutions
-    in a table *)
-
-val subst_genarg : substitution -> glob_generic_argument -> glob_generic_argument
-
-(** Misc *)
-
-val subst_glob_constr_and_expr :
-  substitution -> glob_constr_and_expr -> glob_constr_and_expr
-
-val subst_glob_with_bindings : substitution ->
-  glob_constr_and_expr with_bindings ->
-  glob_constr_and_expr with_bindings
diff --git a/tactics/tactic_matching.ml b/tactics/tactic_matching.ml
index 80786058..004492e7 100644
--- a/tactics/tactic_matching.ml
+++ b/tactics/tactic_matching.ml
@@ -11,6 +11,7 @@
 
 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
@@ -102,7 +103,7 @@ let verify_metas_coherence env sigma (ln1,lcm) (ln,lm) =
   (merged, Id.Map.merge merge lcm lm)
 
 let matching_error =
-  Errors.UserError ("tactic matching" , Pp.str "No matching clauses for match.")
+  CErrors.UserError ("tactic matching" , Pp.str "No matching clauses for match.")
 
 let imatching_error = (matching_error, Exninfo.null)
 
@@ -278,9 +279,10 @@ module PatternMatching (E:StaticEnvironment) = struct
       [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 (id,b,hyp) ->
-    let refresh = not (Option.is_empty b) in
-    pattern_match_term refresh pat hyp () <*>
+    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
 
@@ -290,12 +292,12 @@ module PatternMatching (E:StaticEnvironment) = struct
       success returns the name of the matched hypothesis. *)
   let hyp_match_body_and_type hypname bodypat typepat hyps =
     pick hyps >>= function
-      | (id,Some body,hyp) ->
+      | 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
-      | (id,None,hyp) -> fail
+      | LocalAssum (id,hyp) -> fail
 
   (** [hyp_match pat hyps] dispatches to
       {!hyp_match_type} or {!hyp_match_body_and_type} depending on whether
@@ -317,7 +319,7 @@ module PatternMatching (E:StaticEnvironment) = struct
         (* spiwack: alternatively it is possible to return the list
            with the matched hypothesis removed directly in
            [hyp_match]. *)
-        let select_matched_hyp (id,_,_) = Id.equal id matched_hyp in
+        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
diff --git a/tactics/tactic_matching.mli b/tactics/tactic_matching.mli
index d8e6dd0a..090207bc 100644
--- a/tactics/tactic_matching.mli
+++ b/tactics/tactic_matching.mli
@@ -43,7 +43,7 @@ val match_term :
 val match_goal:
   Environ.env ->
   Evd.evar_map ->
-  Context.named_context ->
+  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/tactic_option.ml b/tactics/tactic_option.ml
deleted file mode 100644
index a5ba3b83..00000000
--- a/tactics/tactic_option.ml
+++ /dev/null
@@ -1,51 +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        *)
-(************************************************************************)
-
-open Libobject
-open Pp
-
-let declare_tactic_option ?(default=Tacexpr.TacId []) name =
-  let locality = Summary.ref false ~name:(name^"-locality") in
-  let default_tactic_expr : Tacexpr.glob_tactic_expr ref =
-    Summary.ref default ~name:(name^"-default-tacexpr")
-  in
-  let default_tactic : Tacexpr.glob_tactic_expr ref =
-    Summary.ref !default_tactic_expr ~name:(name^"-default-tactic")
-  in
-  let set_default_tactic local t =
-    locality := local;
-    default_tactic_expr := t;
-    default_tactic := t
-  in
-  let cache (_, (local, tac)) = set_default_tactic local tac in
-  let load (_, (local, tac)) =
-    if not local then set_default_tactic local tac
-  in
-  let subst (s, (local, tac)) =
-    (local, Tacsubst.subst_tactic s tac)
-  in
-  let input : bool * Tacexpr.glob_tactic_expr -> obj =
-    declare_object
-      { (default_object name) with
-	cache_function = cache;
-	load_function = (fun _ -> load);
-	open_function = (fun _ -> load);
-	classify_function = (fun (local, tac) ->
-	  if local then Dispose else Substitute (local, tac));
-	subst_function = subst}
-  in
-  let put local tac =
-    set_default_tactic local tac;
-    Lib.add_anonymous_leaf (input (local, tac))
-  in
-  let get () = !locality, Tacinterp.eval_tactic !default_tactic in
-  let print () = 
-    Pptactic.pr_glob_tactic (Global.env ()) !default_tactic_expr ++
-      (if !locality then str" (locally defined)" else str" (globally defined)")
-  in
-  put, get, print
diff --git a/tactics/tactic_option.mli b/tactics/tactic_option.mli
deleted file mode 100644
index ed759a76..00000000
--- a/tactics/tactic_option.mli
+++ /dev/null
@@ -1,15 +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        *)
-(************************************************************************)
-
-open Tacexpr
-open Vernacexpr
-
-val declare_tactic_option : ?default:Tacexpr.glob_tactic_expr -> string -> 
-  (* put *) (locality_flag -> glob_tactic_expr -> unit) *
-  (* get *) (unit -> locality_flag * unit Proofview.tactic) *
-  (* print *) (unit -> Pp.std_ppcmds)
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index f5922411..66da9ee1 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -7,15 +7,16 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Termops
-open Context
 open Declarations
 open Tacmach
 open Clenv
+open Sigma.Notations
+open Context.Named.Declaration
 
 (************************************************************************)
 (* Tacticals re-exported from the Refiner module                        *)
@@ -69,7 +70,7 @@ let nthDecl m gl =
   try List.nth (pf_hyps gl) (m-1)
   with Failure _ -> error "No such assumption."
 
-let nthHypId m gl = pi1 (nthDecl m gl)
+let nthHypId m gl = nthDecl m gl |> get_id
 let nthHyp m gl   = mkVar (nthHypId m gl)
 
 let lastDecl gl   = nthDecl 1 gl
@@ -80,7 +81,7 @@ let nLastDecls n gl =
   try List.firstn n (pf_hyps gl)
   with Failure _ -> error "Not enough hypotheses in the goal."
 
-let nLastHypsId n gl = List.map pi1 (nLastDecls n gl)
+let nLastHypsId n gl = List.map 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
@@ -98,7 +99,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 (fun (hyp,_,_) -> Id.equal hyp id) (pf_hyps gl))
+  fst (List.split_when (Id.equal id % get_id) (pf_hyps gl))
 
 (***************************************)
 (*           Clause Tacticals          *)
@@ -147,14 +148,16 @@ type branch_args = {
   largs      : constr list; (* its arguments *)
   branchnum  : int;         (* the branch number *)
   pred       : constr;      (* the predicate we used *)
-  nassums    : int;         (* the number of assumptions to be introduced *)
+  nassums    : int;         (* number of assumptions/letin to be introduced *)
   branchsign : bool list;   (* the signature of the branch.
-                               true=recursive argument, false=constant *)
+                               true=assumption, false=let-in *)
   branchnames : Tacexpr.intro_patterns}
 
 type branch_assumptions = {
-  ba        : branch_args;     (* the branch args *)
-  assums    : named_context}   (* the list of assumptions introduced *)
+  ba        : branch_args;       (* the branch args *)
+  assums    : Context.Named.t}   (* the list of assumptions introduced *)
+
+open Misctypes
 
 let fix_empty_or_and_pattern nv l =
   (* 1- The syntax does not distinguish between "[ ]" for one clause with no
@@ -162,36 +165,78 @@ let fix_empty_or_and_pattern nv l =
   (* 2- More generally, we admit "[ ]" for any disjunctive pattern of
      arbitrary length *)
   match l with
-  | [[]] -> List.make nv []
+  | IntroOrPattern [[]] -> IntroOrPattern (List.make nv [])
   | _ -> l
 
-let check_or_and_pattern_size loc names n =
-  if not (Int.equal (List.length names) n) then
-    if Int.equal n 1 then
-      user_err_loc (loc,"",str "Expects a conjunctive pattern.")
-    else
-      user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n
-	++ str " branches.")
-
-let compute_induction_names n = function
+let check_or_and_pattern_size check_and loc 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
+  let errn n =
+    user_err_loc (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
+  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'));
+      if check_and then
+        let p1 = List.count (fun x -> x) branchsigns.(0) in
+        let p2 = List.length branchsigns.(0) in
+        let p = List.length l in
+        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)
+        else
+          names
+      else
+        names
+  | IntroOrPattern ll ->
+      if not (Int.equal n (List.length ll)) then
+        if Int.equal n 1 then
+          let p1 = List.count (fun x -> x) branchsigns.(0) in
+          let p2 = List.length branchsigns.(0) in
+          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
+  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 compute_induction_names_gen check_and branchletsigns = function
   | None ->
-      Array.make n []
+      Array.make (Array.length branchletsigns) []
   | Some (loc,names) ->
-      let names = fix_empty_or_and_pattern n names in
-      check_or_and_pattern_size loc names n;
-      Array.of_list 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
 
-let compute_construtor_signatures isrec ((_,k as ity),u) =
+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
     | Prod (_,_,c), recarg::rest ->
-	let b = match Declareops.dest_recarg recarg with
-	  | Norec | Imbr _  -> false
-	  | Mrec (_,j)  -> isrec && Int.equal j k
-	in b :: (analrec c rest)
-    | LetIn (_,_,_,c), rest -> false :: (analrec c rest)
+        let rest = analrec c rest in
+        begin match Declareops.dest_recarg recarg with
+        | Norec | Imbr _  -> true :: rest
+        | Mrec (_,j)  ->
+            if isrec && Int.equal j k then true :: true :: rest
+            else true :: rest
+        end
+    | LetIn (_,_,_,c), rest -> false :: analrec c rest
     | _, [] -> []
-    | _ -> anomaly (Pp.str "compute_construtor_signatures")
+    | _ -> anomaly (Pp.str "compute_constructor_signatures")
   in
   let (mib,mip) = Global.lookup_inductive ity in
   let n = mib.mind_nparams in
@@ -225,60 +270,28 @@ let gl_make_elim ind gl =
     pf_apply Evd.fresh_global gl gr
 
 let gl_make_case_dep ind gl =
-  pf_apply Indrec.build_case_analysis_scheme gl ind true
+  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 =
-  pf_apply Indrec.build_case_analysis_scheme gl ind false
+  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 rec makerec (assums,cargs,constargs,recargs,indargs) lb lc =
-    match lb,lc with
-      | ([], _) ->
-          { ba = ba;
-            assums    = assums}
-      | ((true::tl), ((idrec,_,_ as recarg)::(idind,_,_ as indarg)::idtl)) ->
-	  makerec (recarg::indarg::assums,
-		   idrec::cargs,
-		   idrec::recargs,
-		   constargs,
-		   idind::indargs) tl idtl
-      | ((false::tl), ((id,_,_ as constarg)::idtl))      ->
-	  makerec (constarg::assums,
-		   id::cargs,
-		   id::constargs,
-		   recargs,
-		   indargs) tl idtl
-      | (_, _) -> anomaly (Pp.str "make_elim_branch_assumptions")
-  in
-  makerec ([],[],[],[],[]) ba.branchsign
-    (try List.firstn ba.nassums (pf_hyps gl)
-     with Failure _ -> anomaly (Pp.str "make_elim_branch_assumptions"))
+  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 ba gl =
-  let rec makerec (assums,cargs,constargs,recargs) p_0 p_1 =
-    match p_0,p_1 with
-      | ([], _) ->
-          { ba = ba;
-            assums    = assums}
-      | ((true::tl), ((idrec,_,_ as recarg)::idtl)) ->
-	  makerec (recarg::assums,
-		   idrec::cargs,
-		   idrec::recargs,
-		   constargs) tl idtl
-      | ((false::tl), ((id,_,_ as constarg)::idtl)) ->
-	  makerec (constarg::assums,
-		   id::cargs,
-		   recargs,
-		   id::constargs) tl idtl
-      | (_, _) -> anomaly (Pp.str "make_case_branch_assumptions")
-  in
-  makerec ([],[],[],[]) ba.branchsign
-    (try List.firstn ba.nassums (pf_hyps gl)
-     with Failure _ -> anomaly (Pp.str "make_case_branch_assumptions"))
+let make_case_branch_assumptions = make_elim_branch_assumptions
 
 let case_on_ba tac ba gl = tac (make_case_branch_assumptions ba gl) gl
 
@@ -309,7 +322,7 @@ module New = struct
     try
       Refiner.catch_failerror e;
       tclUNIT ()
-    with e -> tclZERO e
+    with e when CErrors.noncritical e -> tclZERO e
 
   (* spiwack: I chose to give the Ltac + the same semantics as
      [Proofview.tclOR], however, for consistency with the or-else
@@ -463,6 +476,13 @@ module New = struct
   let tclPROGRESS t =
     Proofview.tclINDEPENDENT (Proofview.tclPROGRESS t)
 
+  (* 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
+
   (* Check that holes in arguments have been resolved *)
 
   let check_evars env sigma extsigma origsigma =
@@ -501,18 +521,26 @@ module New = struct
                 try
                   let () = check_evars env sigma_final sigma sigma_initial in
                   tclUNIT x
-                with e when Errors.noncritical e ->
+                with e when CErrors.noncritical e ->
                   tclZERO e
           else
             tclUNIT x
         in
         Proofview.Unsafe.tclEVARS sigma <*> tac >>= check_evars_if
 
+  let tclDELAYEDWITHHOLES check x tac =
+    Proofview.Goal.nf_enter { 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 tclTIMEOUT n t =
     Proofview.tclOR
       (Proofview.tclTIMEOUT n t)
       begin function (e, info) -> match e with
-        | Proofview.Timeout as e -> Proofview.tclZERO (Refiner.FailError (0,lazy (Errors.print e)))
+        | Proofview.Timeout as e -> Proofview.tclZERO (Refiner.FailError (0,lazy (CErrors.print e)))
         | e -> Proofview.tclZERO ~info e
       end
 
@@ -523,7 +551,7 @@ module New = struct
     let hyps = Proofview.Goal.hyps gl in
     try
       List.nth hyps (m-1)
-    with Failure _ -> Errors.error "No such assumption."
+    with Failure _ -> CErrors.error "No such assumption."
 
   let nLastDecls gl n =
     try List.firstn n (Proofview.Goal.hyps gl)
@@ -532,72 +560,70 @@ module New = struct
   let nthHypId m gl =
     (** We only use [id] *)
     let gl = Proofview.Goal.assume gl in
-    let (id,_,_) = nthDecl m gl in
-    id
+    nthDecl m gl |> get_id
   let nthHyp m gl = 
     mkVar (nthHypId m gl)
 
   let onNthHypId m tac =
-    Proofview.Goal.enter begin fun gl -> tac (nthHypId m gl) end
+    Proofview.Goal.enter { enter = begin fun gl -> tac (nthHypId m gl) end }
   let onNthHyp m tac =
-    Proofview.Goal.enter begin fun gl -> tac (nthHyp m gl) end
+    Proofview.Goal.enter { 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 begin fun gl ->
+    Proofview.Goal.nf_enter { 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 begin fun gl ->
+    Proofview.Goal.nf_enter { 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 (fun gl -> tac (find gl))
+  let onHyps find tac = Proofview.Goal.nf_enter { enter = begin fun gl -> tac (find.enter gl) end }
 
   let afterHyp id tac =
-    Proofview.Goal.nf_enter begin fun gl ->
-    let hyps = Proofview.Goal.hyps gl in
-    let rem, _ = List.split_when (fun (hyp,_,_) -> Id.equal hyp id) hyps in
+    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
     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 begin fun gl ->
+    Proofview.Goal.enter { 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 begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
       tclFIRST_PROGRESS_ON tac (fullGoal gl)
-    end
+    end }
 
   let onClause tac cl =
-    Proofview.Goal.enter begin fun gl ->
+    Proofview.Goal.enter { 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
-    begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
     let sigma, elim = Tacmach.New.of_old (mk_elim ind) gl in
     Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
-    (Proofview.Goal.nf_enter begin fun gl ->
+    (Proofview.Goal.nf_enter { enter = begin fun gl ->
     let indclause = Tacmach.New.of_old (fun gl -> mk_clenv_from gl (c, t)) gl 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
@@ -621,8 +647,8 @@ module New = struct
             (str "The elimination combinator " ++ str name_elim ++ str " is unknown.")
     in
     let elimclause' = clenv_fchain ~with_univs:false indmv elimclause indclause in
-    let branchsigns = compute_construtor_signatures isrec ind in
-    let brnames = compute_induction_names (Array.length branchsigns) allnames in
+    let branchsigns = compute_constructor_signatures isrec ind in
+    let brnames = compute_induction_names_gen false branchsigns allnames in
     let flags = Unification.elim_flags () in
     let elimclause' =
       match predicate with
@@ -634,10 +660,7 @@ module New = struct
       let (hd,largs) = decompose_app clenv'.templtyp.Evd.rebus in
       let ba = { branchsign = branchsigns.(i);
                  branchnames = brnames.(i);
-                 nassums =
-          List.fold_left
-            (fun acc b -> if b then acc+2 else acc+1)
-            0 branchsigns.(i);
+                 nassums = List.length branchsigns.(i);
                  branchnum = i+1;
                  ity = ind;
                  largs = List.map (clenv_nf_meta clenv') largs;
@@ -649,10 +672,10 @@ module New = struct
     Proofview.tclTHEN
       (Clenvtac.clenv_refine false clenv')
       (Proofview.tclEXTEND [] tclIDTAC branchtacs)
-    end) end
+    end }) end }
 
   let elimination_then tac c =
-    Proofview.Goal.nf_enter begin fun gl ->
+    Proofview.Goal.nf_enter { 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
@@ -660,7 +683,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
@@ -669,16 +692,16 @@ module New = struct
     general_elim_then_using gl_make_case_nodep false
 
   let elim_on_ba tac ba =
-    Proofview.Goal.nf_enter begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
     let branches = Tacmach.New.of_old (make_elim_branch_assumptions ba) gl in
     tac branches
-    end
+    end }
 
   let case_on_ba tac ba = 
-    Proofview.Goal.nf_enter begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
     let branches = Tacmach.New.of_old (make_case_branch_assumptions ba) gl in
     tac branches
-    end
+    end }
 
   let elimination_sort_of_goal gl =
     (** Retyping will expand evars anyway. *)
@@ -695,11 +718,11 @@ module New = struct
   | Some id -> elimination_sort_of_hyp id gl
 
   let pf_constr_of_global ref tac =
-    Proofview.Goal.nf_enter begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
       let env = Proofview.Goal.env gl in
-      let sigma = Proofview.Goal.sigma 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
+    end }
 
 end
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 1b3b04d9..cfdc2cff 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -9,7 +9,6 @@
 open Pp
 open Names
 open Term
-open Context
 open Tacmach
 open Proof_type
 open Tacexpr
@@ -60,29 +59,29 @@ val tclIFTHENTRYELSEMUST : tactic -> tactic -> tactic
 
 val onNthHypId       : int -> (Id.t -> tactic) -> tactic
 val onNthHyp         : int -> (constr -> tactic) -> tactic
-val onNthDecl        : int -> (named_declaration -> tactic) -> tactic
+val onNthDecl        : int -> (Context.Named.Declaration.t -> tactic) -> tactic
 val onLastHypId      : (Id.t -> tactic) -> tactic
 val onLastHyp        : (constr -> tactic) -> tactic
-val onLastDecl       : (named_declaration -> tactic) -> tactic
+val onLastDecl       : (Context.Named.Declaration.t -> tactic) -> tactic
 val onNLastHypsId    : int -> (Id.t list -> tactic) -> tactic
 val onNLastHyps      : int -> (constr list -> tactic) -> tactic
-val onNLastDecls     : int -> (named_context -> tactic) -> tactic
+val onNLastDecls     : int -> (Context.Named.t -> tactic) -> tactic
 
 val lastHypId   : goal sigma -> Id.t
 val lastHyp     : goal sigma -> constr
-val lastDecl    : goal sigma -> named_declaration
+val lastDecl    : goal sigma -> Context.Named.Declaration.t
 val nLastHypsId : int -> goal sigma -> Id.t list
 val nLastHyps   : int -> goal sigma -> constr list
-val nLastDecls  : int -> goal sigma -> named_context
+val nLastDecls  : int -> goal sigma -> Context.Named.t
 
-val afterHyp    : Id.t -> goal sigma -> named_context
+val afterHyp    : Id.t -> goal sigma -> Context.Named.t
 
 val ifOnHyp     : (Id.t * types -> bool) ->
                   (Id.t -> tactic) -> (Id.t -> tactic) ->
 		   Id.t -> tactic
 
-val onHyps      : (goal sigma -> named_context) ->
-                  (named_context -> tactic) -> tactic
+val onHyps      : (goal sigma -> Context.Named.t) ->
+                  (Context.Named.t -> tactic) -> tactic
 
 (** {6 Tacticals applying to goal components } *)
 
@@ -99,32 +98,36 @@ val onClauseLR : (Id.t option -> tactic) -> clause -> tactic
 (** {6 Elimination tacticals. } *)
 
 type branch_args = {
-  ity        : pinductive;   (** the type we were eliminating on *)
+  ity        : pinductive;  (** the type we were eliminating on *)
   largs      : constr list; (** its arguments *)
   branchnum  : int;         (** the branch number *)
   pred       : constr;      (** the predicate we used *)
-  nassums    : int;         (** the number of assumptions to be introduced *)
+  nassums    : int;         (** number of assumptions/letin to be introduced *)
   branchsign : bool list;   (** the signature of the branch.
-                               true=recursive argument, false=constant *)
+                                true=assumption, false=let-in *)
   branchnames : intro_patterns}
 
 type branch_assumptions = {
-  ba        : branch_args;     (** the branch args *)
-  assums    : named_context}   (** the list of assumptions introduced *)
+  ba        : branch_args;       (** the branch args *)
+  assums    : Context.Named.t}   (** the list of assumptions introduced *)
 
-(** [check_disjunctive_pattern_size loc pats n] returns an appropriate 
-   error message if |pats| <> n *)
-val check_or_and_pattern_size :
-  Loc.t -> delayed_open_constr or_and_intro_pattern_expr -> int -> unit
+(** [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 ->
+  bool list array -> intro_patterns array
 
 (** Tolerate "[]" to mean a disjunctive pattern of any length *)
 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
+
 (** Useful for [as intro_pattern] modifier *)
 val compute_induction_names :
-  int -> or_and_intro_pattern option -> intro_patterns array
+  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
@@ -144,7 +147,7 @@ val case_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
     semantics as the similarly named tacticals in [Proofview]. The
     tactical of [Proofview] are used in the definition of the
     tacticals of [Tacticals.New], but they are more atomic. In
-    particular [Tacticals.New.tclORELSE] sees like of progress as a
+    particular [Tacticals.New.tclORELSE] sees lack of progress as a
     failure, whereas [Proofview.tclORELSE] doesn't. Additionally every
     tactic which can catch failure ([tclOR], [tclORELSE], [tclTRY],
     [tclREPEAt], etc…) are run into each goal independently (failures
@@ -218,12 +221,14 @@ 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 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 ] Proofview.Goal.t -> int -> named_context
+  val nLastDecls  : ([ `NF ], 'r) Proofview.Goal.t -> int -> Context.Named.t
 
   val ifOnHyp     : (identifier * types -> bool) ->
     (identifier -> unit Proofview.tactic) -> (identifier -> unit Proofview.tactic) ->
@@ -232,19 +237,19 @@ module New : sig
   val onNthHypId : int -> (identifier -> unit tactic) -> unit tactic
   val onLastHypId      : (identifier -> unit tactic) -> unit tactic
   val onLastHyp        : (constr -> unit tactic) -> unit tactic
-  val onLastDecl       : (named_declaration -> unit tactic) -> unit tactic
+  val onLastDecl       : (Context.Named.Declaration.t -> unit tactic) -> unit tactic
 
-  val onHyps      : ([ `NF ] Proofview.Goal.t -> named_context) ->
-                    (named_context -> unit tactic) -> unit tactic
-  val afterHyp    : Id.t -> (named_context -> 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 tryAllHyps          : (identifier -> unit tactic) -> unit tactic
   val tryAllHypsAndConcl  : (identifier option -> unit tactic) -> unit tactic
   val onClause   : (identifier option -> unit tactic) -> clause -> unit tactic
 
-  val elimination_sort_of_goal : 'a Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_hyp  : Id.t -> 'a Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_clause : Id.t option -> 'a Proofview.Goal.t -> sorts_family
+  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_then :
     (branch_args -> unit Proofview.tactic) ->
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index f23808f6..9d64e7c5 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -7,13 +7,12 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
 open Term
 open Vars
-open Context
 open Termops
 open Find_subterm
 open Namegen
@@ -26,7 +25,7 @@ open Evd
 open Pfedit
 open Tacred
 open Genredexpr
-open Tacmach
+open Tacmach.New
 open Logic
 open Clenv
 open Refiner
@@ -43,21 +42,17 @@ open Locus
 open Locusops
 open Misctypes
 open Proofview.Notations
-
-let nb_prod x =
-  let rec count n c =
-    match kind_of_term c with
-        Prod(_,_,t) -> count (n+1) t
-      | LetIn(_,a,_,t) -> count n (subst1 a t)
-      | Cast(c,_,_) -> count n c
-      | _ -> n
-  in count 0 x
+open Sigma.Notations
 
 let inj_with_occurrences e = (AllOccurrences,e)
 
 let dloc = Loc.ghost
 
-let typ_of = Retyping.get_type_of
+let typ_of env sigma c =
+  let open Retyping in
+  try get_type_of ~lax:true env (Sigma.to_evar_map sigma) c
+  with RetypeError e ->
+    user_err_loc (Loc.ghost, "", print_retype_error e)
 
 open Goptions
 
@@ -88,7 +83,7 @@ let _ =
 
 let apply_solve_class_goals = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optsync = true; Goptions.optdepr = true;
   Goptions.optname =
     "Perform typeclass resolution on apply-generated subgoals.";
   Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"];
@@ -126,13 +121,26 @@ let _ =
       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.
    Kept as false for compatibility.
  *)
 
-let bracketing_last_or_and_intro_pattern = ref false
+let bracketing_last_or_and_intro_pattern = ref true
 
 let use_bracketing_last_or_and_intro_pattern () =
   !bracketing_last_or_and_intro_pattern
@@ -144,7 +152,7 @@ let _ =
       optdepr  = false;
       optname  = "bracketing last or-and introduction pattern";
       optkey   = ["Bracketing";"Last";"Introduction";"Pattern"];
-      optread  = (fun () -> !bracketing_last_or_and_intro_pattern) ;
+      optread  = (fun () -> !bracketing_last_or_and_intro_pattern);
       optwrite = (fun b -> bracketing_last_or_and_intro_pattern := b) }
 
 (*********************************************)
@@ -157,71 +165,77 @@ let _ =
 
 (** This tactic creates a partial proof realizing the introduction rule, but
     does not check anything. *)
-let unsafe_intro env store (id, c, t) b =
-  Proofview.Refine.refine ~unsafe:true begin fun sigma ->
+let unsafe_intro env store decl b =
+  let open Context.Named.Declaration in
+  Refine.refine ~unsafe:true { run = begin fun sigma ->
     let ctx = named_context_val env in
-    let nctx = push_named_context_val (id, c, t) ctx in
-    let inst = List.map (fun (id, _, _) -> mkVar id) (named_context env) in
+    let nctx = push_named_context_val decl ctx in
+    let inst = List.map (mkVar % get_id) (named_context env) in
     let ninst = mkRel 1 :: inst in
-    let nb = subst1 (mkVar id) b in
-    let sigma, ev = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
-    sigma, mkNamedLambda_or_LetIn (id, c, t) ev
-  end
+    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 introduction ?(check=true) id =
-  Proofview.Goal.enter begin fun gl ->
+  let open Context.Named.Declaration in
+  Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume gl in
     let concl = Proofview.Goal.concl gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let hyps = Proofview.Goal.hyps 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 id hyps then
+    let () = if check && mem_named_context_val id hyps then
       errorlabstrm "Tactics.introduction"
         (str "Variable " ++ pr_id id ++ str " is already declared.")
     in
     match kind_of_term (whd_evar sigma concl) with
-    | Prod (_, t, b) -> unsafe_intro env store (id, None, t) b
-    | LetIn (_, c, t, b) -> unsafe_intro env store (id, Some c, t) b
+    | 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
+  end }
 
 let refine          = Tacmach.refine
 
 let convert_concl ?(check=true) ty k =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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
-    Proofview.Refine.refine ~unsafe:true begin fun sigma ->
-      let sigma =
+    Refine.refine ~unsafe:true { run = begin fun sigma ->
+      let Sigma ((), sigma, p) =
         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
-        end else sigma in
-      let (sigma,x) = Evarutil.new_evar env sigma ~principal:true ~store ty in
-      (sigma, if k == DEFAULTcast then x else mkCast(x,k,conclty))
-    end
-  end
+          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
+      let ans = if k == DEFAULTcast then x else mkCast(x,k,conclty) in
+      Sigma (ans, sigma, p +> q)
+    end }
+  end }
 
 let convert_hyp ?(check=true) d =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     let ty = Proofview.Goal.raw_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
-    Proofview.Refine.refine ~unsafe:true (fun sigma -> Evarutil.new_evar env sigma ~principal:true ~store ty)
-  end
+    Refine.refine ~unsafe:true { run = begin fun sigma ->
+      Evarutil.new_evar env sigma ~principal:true ~store ty
+    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 begin fun gl ->
+  Proofview.Goal.enter { 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
@@ -229,7 +243,7 @@ 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
@@ -261,32 +275,64 @@ let replacing_dependency_msg env sigma id = function
 let error_replacing_dependency env sigma id err =
   errorlabstrm "" (replacing_dependency_msg env sigma id err)
 
-let thin l gl =
-  try thin l gl
-  with Evarutil.ClearDependencyError (id,err) ->
-    error_clear_dependency (pf_env gl) (project gl) 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
+ * subsequently used in other hypotheses or in the conclusion of the
+ * goal. *)
 
-let thin_for_replacing l gl =
-  try Tacmach.thin l gl
-  with Evarutil.ClearDependencyError (id,err) ->
-    error_replacing_dependency (pf_env gl) (project gl) id err
+let clear_gen fail = function
+| [] -> Proofview.tclUNIT ()
+| ids ->
+  Proofview.Goal.s_enter { s_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
+    let evdref = ref sigma in
+    let (hyps, concl) =
+      try clear_hyps_in_evi env evdref (named_context_val env) concl ids
+      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 ->
+      Evarutil.new_evar env sigma ~principal:true concl
+    } in
+    Sigma.Unsafe.of_pair (tac, !evdref)
+  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 =
   let check_isvar c =
     if not (isVar c) then
       error "keep/clear modifiers apply only to hypothesis names." in
-  let clear = match clear_flag with
+  let doclear = match clear_flag with
     | None -> dft && isVar c
     | Some true -> check_isvar c; true
     | Some false -> false in
-  if clear then Proofview.V82.tactic (thin [destVar c])
+  if doclear then clear [destVar c]
   else Tacticals.New.tclIDTAC
 
 (* Moving hypotheses *)
-let move_hyp id dest gl = Tacmach.move_hyp id dest gl
+let move_hyp id dest =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let ty = Proofview.Goal.raw_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 env = reset_with_named_context sign' env in
+    Refine.refine ~unsafe:true { run = begin fun sigma ->
+      Evarutil.new_evar env sigma ~principal:true ~store ty
+    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) ->
@@ -302,13 +348,13 @@ 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 begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
       let gl = Proofview.Goal.assume gl in
       let hyps = Proofview.Goal.hyps gl in
       let concl = Proofview.Goal.concl gl in
       let store = Proofview.Goal.extra gl in
       (** Check that we do not mess variables *)
-      let fold accu (id, _, _) = Id.Set.add id accu in
+      let fold accu decl = Id.Set.add (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
@@ -319,25 +365,25 @@ let rename_hyp repl =
       let () =
         try
           let elt = Id.Set.choose (Id.Set.inter dst mods) in
-          Errors.errorlabstrm "" (pr_id elt ++ str " is already used")
+          CErrors.errorlabstrm "" (pr_id elt ++ str " is already used")
         with Not_found -> ()
       in
       (** All is well *)
       let make_subst (src, dst) = (src, mkVar dst) in
       let subst = List.map make_subst repl in
       let subst c = Vars.replace_vars subst c in
-      let map (id, body, t) =
-        let id = try List.assoc_f Id.equal id repl with Not_found -> id in
-        (id, Option.map subst body, subst t)
+      let map decl =
+        decl |> map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
+             |> 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 (fun (id, _, _) -> mkVar id) hyps in
-      Proofview.Refine.refine ~unsafe:true begin fun sigma ->
-        Evarutil.new_evar_instance nctx sigma nconcl ~store instance
-      end
-    end
+      let instance = List.map (mkVar % get_id) hyps in
+      Refine.refine ~unsafe:true { run = begin fun sigma ->
+        Evarutil.new_evar_instance nctx sigma nconcl ~principal:true ~store instance
+      end }
+    end }
 
 (**************************************************************)
 (*          Fresh names                                       *)
@@ -359,11 +405,13 @@ let id_of_name_with_default id = function
 let default_id_of_sort s =
   if Sorts.is_small s then default_small_ident else default_type_ident
 
-let default_id env sigma = function
-  | (name,None,t) ->
+let default_id env sigma decl =
+  let open Context.Rel.Declaration in
+  match decl with
+  | LocalAssum (name,t) ->
       let dft = default_id_of_sort (Retyping.get_sort_of env sigma t) in
       id_of_name_with_default dft name
-  | (name,Some b,_) -> id_of_name_using_hdchar env b name
+  | LocalDef (name,b,_) -> id_of_name_using_hdchar env b name
 
 (* Non primitive introduction tactics are treated by intro_then_gen
    There is possibly renaming, with possibly names to avoid and
@@ -382,7 +430,7 @@ let find_name mayrepl decl naming gl = match naming with
   | NamingAvoid idl ->
       (* this case must be compatible with [find_intro_names] below. *)
       let env = Proofview.Goal.env gl in
-      let sigma = Proofview.Goal.sigma gl in
+      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) ->
@@ -398,16 +446,17 @@ let find_name mayrepl decl naming gl = match naming with
 (**************************************************************)
 
 let assert_before_then_gen b naming t tac =
-  Proofview.Goal.enter begin fun gl ->
-    let id = find_name b (Anonymous,None,t) naming gl in
+  let open Context.Rel.Declaration in
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENLAST
       (Proofview.V82.tactic
          (fun gl ->
-           try internal_cut b id t gl
+           try Tacmach.internal_cut b id t gl
            with Evarutil.ClearDependencyError (id,err) ->
              error_replacing_dependency (pf_env gl) (project gl) id err))
       (tac id)
-  end
+  end }
 
 let assert_before_gen b naming t =
   assert_before_then_gen b naming t (fun _ -> Proofview.tclUNIT ())
@@ -416,16 +465,17 @@ 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_after_then_gen b naming t tac =
-  Proofview.Goal.enter begin fun gl ->
-    let id = find_name b (Anonymous,None,t) naming gl in
+  let open Context.Rel.Declaration in
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENFIRST
       (Proofview.V82.tactic
          (fun gl ->
-           try internal_cut_rev b id t 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))
       (tac id)
-  end
+  end }
 
 let assert_after_gen b naming t =
   assert_after_then_gen b naming t (fun _ -> (Proofview.tclUNIT ()))
@@ -437,23 +487,120 @@ let assert_after_replacing id = assert_after_gen true (NamingMustBe (dloc,id))
 (*          Fixpoints and CoFixpoints                         *)
 (**************************************************************)
 
-(* Refine as a fixpoint *)
-let mutual_fix = Tacmach.mutual_fix
+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)
+| 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 rec check_mutind env sigma k cl = match kind_of_term (strip_outer_cast cl) with
+| Prod (na, c1, b) ->
+  if Int.equal k 1 then
+    try
+      let ((sp, _), u), _ = find_inductive env sigma c1 in
+      (sp, u)
+    with Not_found -> error "Cannot do a fixpoint on a non inductive type."
+  else
+    let open Context.Rel.Declaration in
+    check_mutind (push_rel (LocalAssum (na, c1)) env) sigma (pred k) b
+| _ -> error "Not enough products."
 
-let fix ido n gl = match ido with
+(* Refine as a fixpoint *)
+let mutual_fix f n rest j = Proofview.Goal.nf_enter { 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 (sp, u) = check_mutind env sigma n concl in
+  let firsts, lasts = List.chop j rest in
+  let all = firsts @ (f, n, concl) :: lasts in
+  let rec mk_sign sign = function
+  | [] -> sign
+  | (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
+      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");
+    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
+    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 fix ido n = match ido with
   | None ->
-      mutual_fix (fresh_id [] (Pfedit.get_current_proof_name ()) gl) n [] 0 gl
+    Proofview.Goal.enter { enter = begin fun gl ->
+      let name = Pfedit.get_current_proof_name () in
+      let id = new_fresh_id [] name gl in
+      mutual_fix id n [] 0
+    end }
   | Some id ->
-      mutual_fix id n [] 0 gl
+    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
+  | Prod (na, c1, b) ->
+    let open Context.Rel.Declaration in
+    check_is_mutcoind (push_rel (LocalAssum (na,c1)) env) sigma b
+  | _ ->
+    try
+      let _ = find_coinductive env sigma b in ()
+    with Not_found ->
+      error "All methods must construct elements in coinductive types."
 
 (* Refine as a cofixpoint *)
-let mutual_cofix = Tacmach.mutual_cofix
-
-let cofix ido gl = match ido with
+let mutual_cofix f others j = Proofview.Goal.nf_enter { 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 firsts,lasts = List.chop j others in
+  let all = firsts @ (f, concl) :: lasts in
+  List.iter (fun (_, c) -> check_is_mutcoind env sigma c) all;
+  let rec mk_sign sign = function
+  | [] -> sign
+  | (f, ar) :: oth ->
+    let open Context.Named.Declaration in
+    if mem_named_context_val f sign then
+      error "Name 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 (ids, types) = List.split all in
+    let Sigma (evs, sigma, p) = mk_holes nenv sigma Sigma.refl 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 cofix ido = match ido with
   | None ->
-      mutual_cofix (fresh_id [] (Pfedit.get_current_proof_name ()) gl) [] 0 gl
+    Proofview.Goal.enter { enter = begin fun gl ->
+      let name = Pfedit.get_current_proof_name () in
+      let id = new_fresh_id [] name gl in
+      mutual_cofix id [] 0
+    end }
   | Some id ->
-      mutual_cofix id [] 0 gl
+      mutual_cofix id [] 0
 
 (**************************************************************)
 (*          Reduction and conversion tactics                  *)
@@ -461,17 +608,18 @@ let cofix ido gl = match ido with
 
 type tactic_reduction = env -> evar_map -> constr -> constr
 
-let pf_reduce_decl redfun where (id,c,ty) gl =
-  let redfun' = pf_reduce redfun gl in
-  match c with
-  | None ->
+let pf_reduce_decl redfun where decl gl =
+  let open Context.Named.Declaration in
+  let redfun' = Tacmach.New.pf_apply redfun gl in
+  match decl with
+  | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
 	errorlabstrm "" (pr_id id ++ str " has no value.");
-      (id,None,redfun' ty)
-  | Some b ->
+      LocalAssum (id,redfun' ty)
+  | LocalDef (id,b,ty) ->
       let b' = if where != InHypTypeOnly then redfun' b else b in
       let ty' =	if where != InHypValueOnly then redfun' ty else ty in
-      (id,Some b',ty')
+      LocalDef (id,b',ty')
 
 (* Possibly equip a reduction with the occurrences mentioned in an
    occurrence clause *)
@@ -541,12 +689,15 @@ let bind_red_expr_occurrences occs nbcl redexp =
    reduction function either to the conclusion or to a
    certain hypothesis *)
 
-let reduct_in_concl (redfun,sty) gl =
-  Proofview.V82.of_tactic (convert_concl_no_check (pf_reduce redfun gl (pf_concl gl)) sty) gl
+let reduct_in_concl (redfun,sty) =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+    convert_concl_no_check (Tacmach.New.pf_apply redfun gl (Tacmach.New.pf_concl gl)) sty
+  end }
 
-let reduct_in_hyp ?(check=false) redfun (id,where) gl =
-  Proofview.V82.of_tactic (convert_hyp ~check
-    (pf_reduce_decl redfun where (pf_get_hyp gl id) gl)) gl
+let reduct_in_hyp ?(check=false) redfun (id,where) =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  convert_hyp ~check (pf_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl)
+  end }
 
 let revert_cast (redfun,kind as r) =
   if kind == DEFAULTcast then (redfun,REVERTcast) else r
@@ -557,78 +708,77 @@ let reduct_option ?(check=false) redfun = function
 
 (** Tactic reduction modulo evars (for universes essentially) *)
 
-let pf_e_reduce_decl redfun where (id,c,ty) gl =
-  let sigma = project gl in
-  let redfun = redfun (pf_env gl) in
-  match c with
-  | None ->
+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
+  match decl with
+  | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
 	errorlabstrm "" (pr_id id ++ str " has no value.");
-    let sigma, ty' = redfun sigma ty in
-      sigma, (id,None,ty')
-  | Some b ->
-      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, (id,Some b',ty')
-
-let e_reduct_in_concl (redfun,sty) gl =
-  Proofview.V82.of_tactic
-    (let sigma, c' = (pf_apply redfun gl (pf_concl gl)) in
-       Proofview.Unsafe.tclEVARS sigma <*> 
-	 convert_concl_no_check c' sty) gl
-
-let e_reduct_in_hyp ?(check=false) redfun (id,where) gl =
-  Proofview.V82.of_tactic 
-    (let sigma, decl' = pf_e_reduce_decl redfun where (pf_get_hyp gl id) gl in
-       Proofview.Unsafe.tclEVARS sigma <*> 
-	 convert_hyp ~check decl') gl
+    let Sigma (ty', sigma, p) = redfun sigma ty in
+    Sigma (LocalAssum (id, ty'), sigma, p)
+  | 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 e_reduct_in_concl ~check (redfun, sty) =
+  Proofview.Goal.nf_s_enter { s_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 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 }
 
 let e_reduct_option ?(check=false) redfun = function
   | Some id -> e_reduct_in_hyp ~check (fst redfun) id
-  | None    -> e_reduct_in_concl (revert_cast redfun)
+  | None    -> e_reduct_in_concl ~check (revert_cast redfun)
 
 (** Versions with evars to maintain the unification of universes resulting
     from conversions. *)
 
-let tclWITHEVARS f k =
-  Proofview.Goal.enter begin fun gl ->
-  let evm, c' = f gl in
-  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evm) (k c')
-  end
-
 let e_change_in_concl (redfun,sty) =
-  tclWITHEVARS
-    (fun gl -> redfun (Proofview.Goal.env gl) (Proofview.Goal.sigma gl)
-        (Proofview.Goal.raw_concl gl))
-    (fun c -> convert_concl_no_check c sty)
-
-let e_pf_change_decl (redfun : bool -> e_reduction_function) where (id,c,ty) env sigma =
-  match c with
-  | None ->
+  Proofview.Goal.s_enter { s_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 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' = redfun false env sigma ty in
-      sigma', (id,None,ty')
-  | Some b ->
-      let sigma',b' = 
-	if where != InHypTypeOnly then redfun true env sigma b else sigma, b 
+    let Sigma (ty', sigma, p) = (redfun false).e_redfun env sigma ty in
+    Sigma (LocalAssum (id, ty'), sigma, p)
+  | 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
       in
-      let sigma',ty' = 
-	if where != InHypValueOnly then redfun false env sigma' ty else sigma', ty 
+      let Sigma (ty', sigma, q) =
+	if where != InHypValueOnly then (redfun false).e_redfun env sigma ty else Sigma.here ty sigma
       in
-	sigma', (id,Some b',ty')
+      Sigma (LocalDef (id,b',ty'), sigma, p +> q)
 
 let e_change_in_hyp redfun (id,where) =
-  tclWITHEVARS
-    (fun gl -> e_pf_change_decl redfun where
-      (Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl))
-      (Proofview.Goal.env gl) (Proofview.Goal.sigma gl))
-    convert_hyp
+  Proofview.Goal.s_enter { s_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 }
 
-type change_arg = Pattern.patvar_map -> evar_map -> evar_map * constr
+type change_arg = Pattern.patvar_map -> constr Sigma.run
 
-let make_change_arg c =
-  fun pats sigma -> (sigma, replace_vars (Id.Map.bindings pats) c)
+let make_change_arg c pats =
+  { run = fun sigma -> Sigma.here (replace_vars (Id.Map.bindings pats) c) sigma }
 
 let check_types env sigma mayneedglobalcheck deep newc origc =
   let t1 = Retyping.get_type_of env sigma newc in
@@ -639,43 +789,46 @@ 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_betadeltaiota env sigma t1) &&
-        isSort (whd_betadeltaiota env sigma t2)
+        isSort (whd_all env sigma t1) &&
+        isSort (whd_all env sigma t2)
       then (mayneedglobalcheck := true; sigma)
       else
         errorlabstrm "convert-check-hyp" (str "Types are incompatible.")
     else sigma
   end
   else
-    if not (isSort (whd_betadeltaiota env sigma t1)) then
+    if not (isSort (whd_all env sigma t1)) then
       errorlabstrm "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 env sigma c =
-  let sigma, t' = t sigma in
+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 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, t'
+  Sigma.Unsafe.of_pair (t', sigma)
+end }
 
 (* Use cumulativity only if changing the conclusion not a subterm *)
-let change_on_subterm cv_pb deep t where env sigma c =
+let change_on_subterm cv_pb deep t where = { e_redfun = begin fun env sigma c ->
   let mayneedglobalcheck = ref false in
-  let sigma,c = match where with
-  | None -> change_and_check cv_pb mayneedglobalcheck deep (t Id.Map.empty) env sigma c
+  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
   | Some occl ->
-      e_contextually false occl
+      (e_contextually false occl
         (fun subst ->
-          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))
+          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))).e_redfun
         env sigma c in
   if !mayneedglobalcheck then
     begin
-      try ignore (Typing.unsafe_type_of env sigma c)
+      try ignore (Typing.unsafe_type_of env (Sigma.to_evar_map sigma) c)
       with e when catchable_exception e ->
         error "Replacement would lead to an ill-typed term."
     end;
-  sigma,c
+  Sigma (c, sigma, p)
+end }
 
 let change_in_concl occl t =
   e_change_in_concl ((change_on_subterm Reduction.CUMUL false t occl),DEFAULTcast)
@@ -687,14 +840,16 @@ let change_option occl t = function
   | Some id -> change_in_hyp occl t id
   | None -> change_in_concl occl t
 
-let change chg c cls gl =
-  let cls = concrete_clause_of (fun () -> pf_ids_of_hyps gl) cls in
-  Proofview.V82.of_tactic (Tacticals.New.tclMAP (function
+let change chg c cls =
+  Proofview.Goal.enter { 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) ->
        change_option (bind_change_occurrences occs chg) c (Some (id,where))
     | OnConcl occs ->
        change_option (bind_change_occurrences occs chg) c None)
-    cls) gl
+    cls
+  end }
 
 let change_concl t = 
   change_in_concl None (make_change_arg t)
@@ -728,14 +883,18 @@ let reduction_clause redexp cl =
     | OnConcl occs ->
 	(None, bind_red_expr_occurrences occs nbcl redexp)) cl
 
-let reduce redexp cl goal =
-  let cl = concrete_clause_of (fun () -> pf_ids_of_hyps goal) cl in
-  let redexps = reduction_clause redexp cl in
+let reduce redexp cl =
+  let trace () = Pp.(hov 2 (Pptactic.pr_atomic_tactic (Global.env()) (TacReduce (redexp,cl)))) in
+  Proofview.Trace.name_tactic trace begin
+  Proofview.Goal.enter { 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
-  let tac = tclMAP (fun (where,redexp) ->
+  Tacticals.New.tclMAP (fun (where,redexp) ->
     e_reduct_option ~check
-      (Redexpr.reduction_of_red_expr (pf_env goal) redexp) where) redexps in
-  if check then with_check tac goal else tac goal
+      (Redexpr.reduction_of_red_expr (Tacmach.New.pf_env gl) redexp) where) redexps
+  end }
+  end
 
 (* Unfolding occurrences of a constant *)
 
@@ -756,10 +915,9 @@ let unfold_constr = function
 let find_intro_names ctxt gl =
   let _, res = List.fold_right
     (fun decl acc ->
-      let wantedname,x,typdecl = decl in
       let env,idl = acc in
       let name = fresh_id idl (default_id env gl.sigma decl) gl in
-      let newenv = push_rel (wantedname,x,typdecl) env in
+      let newenv = push_rel decl env in
       (newenv,(name::idl)))
     ctxt (pf_env gl , []) in
   List.rev res
@@ -767,19 +925,19 @@ let find_intro_names ctxt gl =
 let build_intro_tac id dest tac = match dest with
   | MoveLast -> Tacticals.New.tclTHEN (introduction id) (tac id)
   | dest -> Tacticals.New.tclTHENLIST 
-    [introduction id; 
-     Proofview.V82.tactic (move_hyp id dest); tac id]
-    
+    [introduction id; move_hyp id dest; tac id]
+
 let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
-  Proofview.Goal.enter begin fun gl ->
+  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 (Proofview.Goal.sigma gl) concl 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) ->
-        let name = find_name false (name,None,t) name_flag gl in
+        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) ->
-        let name = find_name false (name,Some b,t) name_flag gl in
+        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)
@@ -790,14 +948,14 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
           else Proofview.tclUNIT ()
         end <*>
 	  Proofview.tclORELSE
-	  (Tacticals.New.tclTHEN (Proofview.V82.tactic hnf_in_concl)
+	  (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 ->
                 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
@@ -842,33 +1000,36 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
   aux n []
 
 let get_next_hyp_position id gl =
+  let open Context.Named.Declaration in
   let rec aux = function
   | [] -> raise (RefinerError (NoSuchHyp id))
-  | (hyp,_,_) :: right ->
-    if Id.equal hyp id then
-      match right with (id,_,_)::_ -> MoveBefore id | [] -> MoveLast
+  | 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))
-  | (hyp,_,_) :: right ->
-    if Id.equal hyp id then dest else aux (MoveAfter hyp) right
+  | 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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let next_hyp = get_next_hyp_position id gl in
   Tacticals.New.tclTHENLIST [
-    Proofview.V82.tactic (thin_for_replacing [id]);
+    clear_for_replacing [id];
     introduction id;
-    Proofview.V82.tactic (move_hyp id next_hyp);
+    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''
@@ -880,47 +1041,47 @@ let intro_replacing id =
 (* the behavior of inversion *)
 let intros_possibly_replacing ids =
   let suboptimal = true in
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
     Tacticals.New.tclTHEN
       (Tacticals.New.tclMAP (fun id -> 
-	Tacticals.New.tclTRY (Proofview.V82.tactic (thin_for_replacing [id])))
+	Tacticals.New.tclTRY (clear_for_replacing [id]))
 	 (if suboptimal then ids else List.rev 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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
     Tacticals.New.tclTHEN
-      (Proofview.V82.tactic (thin_for_replacing ids))
+      (clear_for_replacing ids)
       (Tacticals.New.tclMAP (fun (id,pos) -> intro_move (Some id) pos) posl)
-  end
+  end }
 
 (* User-level introduction tactics *)
 
-let pf_lookup_hypothesis_as_renamed env ccl = function
+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 pf_lookup_hypothesis_as_renamed_gen red h gl =
-  let env = pf_env gl in
+let lookup_hypothesis_as_renamed_gen red h gl =
+  let env = Proofview.Goal.env gl in
   let rec aux ccl =
-    match pf_lookup_hypothesis_as_renamed env ccl h with
+    match lookup_hypothesis_as_renamed env ccl h with
       | None when red ->
-          aux
-	    (snd ((fst (Redexpr.reduction_of_red_expr env (Red true)))
-	       env (project gl) ccl))
+        let (redfun, _) = Redexpr.reduction_of_red_expr env (Red true) in
+        let Sigma (c, _, _) = redfun.e_redfun env (Proofview.Goal.sigma gl) ccl in
+        aux c
       | x -> x
   in
-  try aux (pf_concl gl)
+  try aux (Proofview.Goal.concl gl)
   with Redelimination -> None
 
-let is_quantified_hypothesis id g =
-  match pf_lookup_hypothesis_as_renamed_gen false (NamedHyp id) g with
+let is_quantified_hypothesis id gl =
+  match lookup_hypothesis_as_renamed_gen false (NamedHyp id) gl with
     | Some _ -> true
     | None -> false
 
@@ -932,7 +1093,7 @@ let msg_quantified_hypothesis = function
       str " non dependent hypothesis"
 
 let depth_of_quantified_hypothesis red h gl =
-  match pf_lookup_hypothesis_as_renamed_gen red h gl with
+  match lookup_hypothesis_as_renamed_gen red h gl with
     | Some depth -> depth
     | None ->
         errorlabstrm "lookup_quantified_hypothesis"
@@ -942,10 +1103,10 @@ let depth_of_quantified_hypothesis red h gl =
 	  str".")
 
 let intros_until_gen red h =
-  Proofview.Goal.nf_enter begin fun gl ->
-  let n = Tacmach.New.of_old (depth_of_quantified_hypothesis red h) gl in
+  Proofview.Goal.nf_enter { 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)
@@ -953,10 +1114,14 @@ let intros_until_n_gen red n = intros_until_gen red (AnonHyp n)
 let intros_until = intros_until_gen true
 let intros_until_n = intros_until_n_gen true
 
-let tclCHECKVAR id gl = ignore (pf_get_hyp gl id); tclIDTAC gl
+let tclCHECKVAR id =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let _ = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
+    Proofview.tclUNIT ()
+  end }
 
 let try_intros_until_id_check id =
-  Tacticals.New.tclORELSE (intros_until_id id) (Proofview.V82.tactic (tclCHECKVAR id))
+  Tacticals.New.tclORELSE (intros_until_id id) (tclCHECKVAR id)
 
 let try_intros_until tac = function
   | NamedHyp id -> Tacticals.New.tclTHEN (try_intros_until_id_check id) (tac id)
@@ -968,12 +1133,23 @@ let rec intros_move = function
       Tacticals.New.tclTHEN (intro_gen (NamingMustBe (dloc,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.fail_evar = not with_evar;
+  Pretyping.expand_evars = true }
+
+
 let onOpenInductionArg env sigma tac = function
   | clear_flag,ElimOnConstr f ->
-      let (sigma',cbl) = f env sigma in
+      let (cbl, sigma') = run_delayed env sigma f in
       let pending = (sigma,sigma') in
       Tacticals.New.tclTHEN
         (Proofview.Unsafe.tclEVARS sigma')
@@ -983,20 +1159,20 @@ let onOpenInductionArg env sigma tac = function
         (intros_until_n n)
         (Tacticals.New.onLastHyp
            (fun c ->
-             Proofview.Goal.enter begin fun gl ->
-             let sigma = Proofview.Goal.sigma gl in
+             Proofview.Goal.enter { enter = begin fun gl ->
+             let sigma = Tacmach.New.project gl in
              let pending = (sigma,sigma) in
              tac clear_flag (pending,(c,NoBindings))
-             end))
+             end }))
   | clear_flag,ElimOnIdent (_,id) ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
-        (Proofview.Goal.enter begin fun gl ->
-         let sigma = Proofview.Goal.sigma gl in
+        (Proofview.Goal.enter { enter = begin fun gl ->
+         let sigma = Tacmach.New.project gl in
          let pending = (sigma,sigma) in
          tac clear_flag (pending,(mkVar id,NoBindings))
-        end)
+        end })
 
 let onInductionArg tac = function
   | clear_flag,ElimOnConstr cbl ->
@@ -1011,25 +1187,42 @@ let onInductionArg tac = function
         (try_intros_until_id_check id)
         (tac clear_flag (mkVar id,NoBindings))
 
-let map_induction_arg f = function
-  | clear_flag,ElimOnConstr g -> clear_flag,ElimOnConstr (f g)
-  | clear_flag,ElimOnAnonHyp n as x -> x
-  | clear_flag,ElimOnIdent id as x -> x
+let map_destruction_arg f sigma = function
+  | clear_flag,ElimOnConstr g -> let sigma,x = f sigma g in (sigma, (clear_flag,ElimOnConstr x))
+  | clear_flag,ElimOnAnonHyp n as x -> (sigma,x)
+  | 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 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 with_no_bindings (c, lbind) =
+  if lbind != NoBindings then error "'with' clause not supported here.";
+  c
+
+let force_destruction_arg with_evars env sigma c =
+  map_destruction_arg (finish_delayed_evar_resolution with_evars env) sigma c
 
 (****************************************)
 (* tactic "cut" (actually modus ponens) *)
 (****************************************)
 
+let normalize_cut = false
+
 let cut c =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     let concl = Tacmach.New.pf_nf_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_betadeltaiota env sigma typ in
+        let typ = whd_all env sigma typ in
         match kind_of_term typ with
         | Sort _ -> true
         | _ -> false
@@ -1038,16 +1231,16 @@ let cut c =
     if is_sort then
       let id = next_name_away_with_default "H" Anonymous (Tacmach.New.pf_ids_of_hyps gl) in
       (** Backward compat: normalize [c]. *)
-      let c = local_strong whd_betaiota sigma c in
-      Proofview.Refine.refine ~unsafe:true 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 = mkLambda (Name id, c, mkApp (Vars.lift 1 f, [|mkRel 1|])) in
-        (h, mkApp (f, [|x|]))
-      end
+      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
+        let f = mkLetIn (Name id, x, c, mkApp (Vars.lift 1 f, [|mkRel 1|])) in
+        Sigma (f, h, p +> q)
+      end }
     else
       Tacticals.New.tclZEROMSG (str "Not a proposition or a type.")
-  end
+  end }
 
 let error_uninstantiated_metas t clenv =
   let na = meta_name clenv.evd (List.hd (Metaset.elements (metavars_of t))) in
@@ -1091,11 +1284,11 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
   if not with_evars && occur_meta new_hyp_typ then
     error_uninstantiated_metas new_hyp_typ clenv;
   let new_hyp_prf = clenv_value clenv in
-  let exact_tac = Proofview.V82.tactic (refine_no_check new_hyp_prf) in
+  let exact_tac = Proofview.V82.tactic (Tacmach.refine_no_check new_hyp_prf) in
   let naming = NamingMustBe (dloc,targetid) in
   let with_clear = do_replace (Some id) naming in
   Tacticals.New.tclTHEN
-    (Proofview.Unsafe.tclEVARS clenv.evd)
+    (Proofview.Unsafe.tclEVARS (clear_metas clenv.evd))
     (if sidecond_first then
        Tacticals.New.tclTHENFIRST
          (assert_before_then_gen with_clear naming new_hyp_typ tac) exact_tac
@@ -1130,6 +1323,7 @@ let index_of_ind_arg t =
   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" *)
@@ -1149,19 +1343,19 @@ let enforce_prop_bound_names rename tac =
                 Name (add_suffix Namegen.default_prop_ident s)
               else
                 na in
-            mkProd (na,t,aux (push_rel (na,None,t) env) sigma (i-1) t')
+            mkProd (na,t,aux (push_rel (LocalAssum (na,t)) env) sigma (i-1) t')
         | Prod (Anonymous,t,t') ->
-            mkProd (Anonymous,t,aux (push_rel (Anonymous,None,t) env) sigma (i-1) 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 (na,Some c,t) env) sigma (i-1) t')
-        | _ -> print_int i; Pp.msg (print_constr t); assert false in
+            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 begin fun gl ->
+        Proofview.Goal.nf_enter { enter = begin fun gl ->
           let env = Proofview.Goal.env gl in
-          let sigma = Proofview.Goal.sigma 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
+        end } in
       (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
         tac
         (Array.map rename_branch nn)
@@ -1176,9 +1370,9 @@ let rec contract_letin_in_lam_header c =
 
 let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags ()) 
     rename i (elim, elimty, bindings) indclause =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let elim = contract_letin_in_lam_header elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
   let indmv =
@@ -1189,7 +1383,7 @@ let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags
   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
+  end }
 
 (*
  * Elimination tactic with bindings and using an arbitrary
@@ -1206,49 +1400,53 @@ type eliminator = {
 }
 
 let general_elim_clause_gen elimtac indclause elim =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma 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
   elimtac elim.elimrename i (elimc, elimt, lbindelimc) indclause
-  end
+  end }
 
 let general_elim with_evars clear_flag (c, lbindc) elim =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let ct = Retyping.get_type_of env sigma c in
   let t = try snd (reduce_to_quantified_ind env sigma ct) with UserError _ -> ct in
   let elimtac = elimination_clause_scheme with_evars in
   let indclause  = make_clenv_binding env sigma (c, t) lbindc in
+  let sigma = meta_merge sigma (clear_metas indclause.evd) in
+  Proofview.Unsafe.tclEVARS sigma <*>
   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_enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
+  Proofview.Goal.nf_s_enter { s_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 c in
-  let (mind,_) = reduce_to_quantified_ind env sigma t 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 sort = Tacticals.New.elimination_sort_of_goal gl in
-  let sigma, elim =
+  let Sigma (elim, sigma, p) =
     if occur_term c concl then
       build_case_analysis_scheme env sigma mind true sort
     else
       build_case_analysis_scheme_default env sigma mind sort in
-  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  let tac =
   (general_elim with_evars clear_flag (c,lbindc)
    {elimindex = None; elimbody = (elim,NoBindings);
     elimrename = Some (false, constructors_nrealdecls (fst mind))})
-  end
+  in
+  Sigma (tac, sigma, p)
+  end }
 
 let general_case_analysis with_evars clear_flag (c,lbindc as cx) =
   match kind_of_term c with
@@ -1259,6 +1457,7 @@ let general_case_analysis with_evars clear_flag (c,lbindc as cx) =
         general_case_analysis_in_context with_evars clear_flag cx
 
 let simplest_case c = general_case_analysis false None (c,NoBindings)
+let simplest_ecase c = general_case_analysis true None (c,NoBindings)
 
 (* Elimination tactic with bindings but using the default elimination
  * constant associated with the type. *)
@@ -1281,15 +1480,17 @@ let find_eliminator c gl =
 
 let default_elim with_evars clear_flag (c,_ as cx) =
   Proofview.tclORELSE
-    (Proofview.Goal.enter begin fun gl ->
-      let evd, elim = find_eliminator c gl in
-	Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evd)
+    (Proofview.Goal.s_enter { s_enter = begin fun gl ->
+      let sigma, elim = find_eliminator c gl in
+      let tac =
 	  (general_elim with_evars clear_flag cx elim)
-    end)
+      in
+      Sigma.Unsafe.of_pair (tac, sigma)
+    end })
     begin function (e, info) -> match e with
       | IsNonrec ->
           (* For records, induction principles aren't there by default
-             anymore.  Instead, we do a case analysis instead. *)
+             anymore.  Instead, we do a case analysis. *)
           general_case_analysis with_evars clear_flag cx
       | e -> Proofview.tclZERO ~info e
     end
@@ -1332,9 +1533,9 @@ 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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   let elim = contract_letin_in_lam_header elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
   let indmv = destMeta (nth_arg i elimclause.templval.rebus) in
@@ -1355,7 +1556,7 @@ let elimination_in_clause_scheme with_evars ?(flags=elim_flags ())
       (str "Nothing to rewrite in " ++ pr_id 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
@@ -1371,11 +1572,13 @@ type conjunction_status =
   | NotADefinedRecordUseScheme of constr
 
 let make_projection env sigma params cstr sign elim i n c u =
+  let open Context.Rel.Declaration in
   let elim = match elim with
   | NotADefinedRecordUseScheme elim ->
       (* bugs: goes from right to left when i increases! *)
-      let (na,b,t) = List.nth cstr.cs_args i in
-      let b = match b with None -> mkRel (i+1) | Some b -> b in
+      let decl = List.nth cstr.cs_args i in
+      let t = 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
       if
 	(* excludes dependent projection types *)
@@ -1387,7 +1590,7 @@ let make_projection env sigma params cstr sign elim i n c u =
       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, extended_rel_vect 0 sign)]) in
+	let c = beta_applist (abselim, [mkApp (c, Context.Rel.to_extended_vect 0 sign)]) in
 	  Some (it_mkLambda_or_LetIn c sign, it_mkProd_or_LetIn t sign)
       else
 	None
@@ -1395,7 +1598,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 = extended_rel_vect 0 sign in
+	  let args = Context.Rel.to_extended_vect 0 sign in
 	  let proj =
 	    if Environ.is_projection proj env then
 	      mkProj (Projection.make proj false, mkApp (c, args))
@@ -1410,9 +1613,9 @@ 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 begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma 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
@@ -1427,13 +1630,15 @@ let descend_in_conjunctions avoid tac (err, info) c =
 	let elim =
 	  try DefinedRecord (Recordops.lookup_projections ind)
 	  with Not_found ->
-	    let elim = build_case_analysis_scheme env sigma (ind,u) false sort in
-	    NotADefinedRecordUseScheme (snd elim) in
-	Tacticals.New.tclFIRST
+            let sigma = Sigma.Unsafe.of_evar_map sigma in
+	    let Sigma (elim, _, _) = build_case_analysis_scheme env sigma (ind,u) false sort in
+	    NotADefinedRecordUseScheme elim in
+	Tacticals.New.tclORELSE0
+	(Tacticals.New.tclFIRST
 	  (List.init n (fun i ->
-            Proofview.Goal.enter begin fun gl ->
+            Proofview.Goal.enter { enter = begin fun gl ->
             let env = Proofview.Goal.env gl in
-            let sigma = Proofview.Goal.sigma gl in
+            let sigma = Tacmach.New.project gl in
 	    match make_projection env sigma params cstr sign elim i n c u with
 	    | None -> Tacticals.New.tclFAIL 0 (mt())
 	    | Some (p,pt) ->
@@ -1442,31 +1647,32 @@ 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_enter begin fun gl ->
+  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 sigma = Proofview.Goal.sigma gl in
+      let evd = Sigma.to_evar_map sigma in
       let concl = Proofview.Goal.concl gl in
-      if Typeclasses.is_class_type sigma concl then
-        let evd', c' = Typeclasses.resolve_one_typeclass env sigma concl in
-	Tacticals.New.tclTHEN
-          (Proofview.Unsafe.tclEVARS evd')
-          (Proofview.V82.tactic (refine_no_check c'))
-	else Proofview.tclUNIT ()
-    with Not_found -> Proofview.tclUNIT ()
-  else Proofview.tclUNIT ()
-  end
+      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
@@ -1477,27 +1683,27 @@ let tclORELSEOPT t k =
     | Some tac -> tac)
 
 let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind)) =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let concl = Proofview.Goal.concl 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 concl in
+  let concl_nprod = nb_prod_modulo_zeta concl in
   let rec try_main_apply with_destruct c =
-    Proofview.Goal.enter begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
 
     let thm_ty0 = nf_betaiota sigma (Retyping.get_type_of env sigma c) in
     let try_apply thm_ty nprod =
       try
-        let n = nb_prod thm_ty - nprod in
+        let n = nb_prod_modulo_zeta thm_ty - nprod in
         if n<0 then error "Applied theorem has not enough premisses.";
         let clause = make_clenv_binding_apply env sigma (Some n) (c,thm_ty) lbind in
         Clenvtac.res_pf clause ~with_evars ~flags
-      with UserError _ as exn ->
+      with exn when catchable_exception exn ->
         Proofview.tclZERO exn
     in
     let rec try_red_apply thm_ty (exn0, info) =
@@ -1520,7 +1726,7 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
               (fun b id ->
                 Tacticals.New.tclTHEN
                   (try_main_apply b (mkVar id))
-                  (Proofview.V82.tactic (thin [id])))
+                  (clear [id]))
               (exn0, info) c
           else
             Proofview.tclZERO ~info exn0 in
@@ -1540,14 +1746,14 @@ 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
+  end }
 
 let rec apply_with_bindings_gen b e = function
   | [] -> Proofview.tclUNIT ()
@@ -1559,13 +1765,13 @@ let rec apply_with_bindings_gen b e = function
 
 let apply_with_delayed_bindings_gen b e l = 
   let one k (loc, f) =
-    Proofview.Goal.enter begin fun gl ->
-      let sigma = Proofview.Goal.sigma gl in
+    Proofview.Goal.enter { enter = begin fun gl ->
+      let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let sigma, cb = f env sigma in
+      let (cb, sigma) = run_delayed env sigma f in
 	Tacticals.New.tclWITHHOLES e
           (general_apply b b e k (loc,cb)) sigma
-    end
+    end }
   in
   let rec aux = function
     | [] -> Proofview.tclUNIT ()
@@ -1619,8 +1825,8 @@ let apply_in_once_main flags innerclause env sigma (d,lbind) =
   let thm = nf_betaiota sigma (Retyping.get_type_of env sigma d) in
   let rec aux clause =
     try progress_with_clause flags innerclause clause
-    with e when Errors.noncritical e ->
-    let e = Errors.push e in
+    with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
     try aux (clenv_push_prod clause)
     with NotExtensibleClause -> iraise e
   in
@@ -1628,48 +1834,49 @@ let apply_in_once_main flags innerclause env sigma (d,lbind) =
 
 let apply_in_once sidecond_first with_delta with_destruct with_evars naming
     id (clear_flag,(loc,(d,lbind))) tac =
-  Proofview.Goal.nf_enter begin fun gl ->
+  let open Context.Rel.Declaration in
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma 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
   let t' = Tacmach.New.pf_get_hyp_typ id gl in
   let innerclause = mk_clenv_from_env env sigma (Some 0) (mkVar id,t') in
-  let targetid = find_name true (Anonymous,None,t') naming gl in
+  let targetid = find_name true (LocalAssum (Anonymous,t')) naming gl in
   let rec aux idstoclear with_destruct c =
-    Proofview.Goal.enter begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     try
       let clause = apply_in_once_main flags innerclause env sigma (c,lbind) in
       clenv_refine_in ~sidecond_first with_evars targetid id sigma clause
         (fun id ->
           Tacticals.New.tclTHENLIST [
             apply_clear_request clear_flag false c;
-            Proofview.V82.tactic (thin idstoclear);
+            clear idstoclear;
             tac id
           ])
-    with e when with_destruct && Errors.noncritical e ->
-      let (e, info) = Errors.push e in
+    with e when with_destruct && CErrors.noncritical e ->
+      let (e, info) = CErrors.push e in
         (descend_in_conjunctions [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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let sigma, c = f env sigma in
+    let sigma = Tacmach.New.project gl in
+    let (c, sigma) = run_delayed env sigma f in
     Tacticals.New.tclWITHHOLES with_evars 
       (apply_in_once sidecond_first with_delta with_destruct with_evars
          naming id (clear_flag,(loc,c)) tac)
       sigma
-  end
+  end }
 
 (* A useful resolution tactic which, if c:A->B, transforms |- C into
    |- B -> C and |- A
@@ -1689,20 +1896,20 @@ let apply_in_delayed_once sidecond_first with_delta with_destruct with_evars nam
 *)
 
 let cut_and_apply c =
-  Proofview.Goal.nf_enter begin fun gl ->
+  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) ->
         let concl = Proofview.Goal.concl gl in
         let env = Tacmach.New.pf_env gl in
-        Proofview.Refine.refine begin fun sigma ->
+        Refine.refine { run = begin fun sigma ->
           let typ = mkProd (Anonymous, c2, concl) in
-          let (sigma, f) = Evarutil.new_evar env sigma typ in
-          let (sigma, x) = Evarutil.new_evar env sigma c1 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)
-        end
+          Sigma (ans, sigma, p +> q)
+        end }
       | _ -> error "lapply needs a non-dependent product."
-  end
+  end }
 
 (********************************************************************)
 (*               Exact tactics                                      *)
@@ -1714,45 +1921,55 @@ let cut_and_apply c =
 (* let refine_no_checkkey = Profile.declare_profile "refine_no_check";; *)
 (* let refine_no_check = Profile.profile2 refine_no_checkkey refine_no_check *)
 
-let new_exact_no_check c =
-  Proofview.Refine.refine ~unsafe:true (fun h -> (h, c))
+let exact_no_check c =
+  Refine.refine ~unsafe:true { run = fun h -> Sigma.here c h }
 
 let exact_check c =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.s_enter { s_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 env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Sigma.to_evar_map sigma in
   let sigma, ct = Typing.type_of env sigma c in
-    Proofview.Unsafe.tclEVARS sigma <*>
-      Tacticals.New.tclTHEN (convert_leq ct concl) (new_exact_no_check c)
-  end
-
-let exact_no_check = refine_no_check
-
-let vm_cast_no_check c gl =
-  let concl = pf_concl gl in
-  refine_no_check (Term.mkCast(c,Term.VMcast,concl)) gl
+  let tac =
+      Tacticals.New.tclTHEN (convert_leq ct concl) (exact_no_check c)
+  in
+  Sigma.Unsafe.of_pair (tac, sigma)
+  end }
 
-let native_cast_no_check c gl =
-  let concl = pf_concl gl in
-  refine_no_check (Term.mkCast(c,Term.NATIVEcast,concl)) gl
+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 }
 
+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 gl =
-  let c,ctx = Constrintern.interp_casted_constr (pf_env gl) (project gl) c (pf_concl gl)
-  in tclTHEN (tclEVARUNIVCONTEXT ctx) (refine_no_check c) gl
+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
+    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 }
 
 let assumption =
+  let open Context.Named.Declaration in
   let rec arec gl only_eq = function
   | [] ->
     if only_eq then
       let hyps = Proofview.Goal.hyps gl in
       arec gl false hyps
     else Tacticals.New.tclZEROMSG (str "No such assumption.")
-  | (id, c, t)::rest ->
+  | decl::rest ->
+    let t = get_type decl in
     let concl = Proofview.Goal.concl gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     let (sigma, is_same_type) =
       if only_eq then (sigma, Constr.equal t concl)
       else
@@ -1761,101 +1978,103 @@ let assumption =
     in
     if is_same_type then
       (Proofview.Unsafe.tclEVARS sigma) <*>
-	Proofview.Refine.refine ~unsafe:true (fun h -> (h, mkVar id))
+	exact_no_check (mkVar (get_id decl))
     else arec gl only_eq rest
   in
-  let assumption_tac gl =
+  let assumption_tac = { enter = begin fun gl ->
     let hyps = Proofview.Goal.hyps gl in
     arec gl true hyps
-  in
+  end } in
   Proofview.Goal.nf_enter assumption_tac
 
 (*****************************************************************)
 (*          Modification of a local context                      *)
 (*****************************************************************)
 
-(* This tactic enables the user to remove hypotheses from the signature.
- * Some care is taken to prevent him from removing variables that are
- * subsequently used in other hypotheses or in the conclusion of the
- * goal. *)
-
-let clear ids = (* avant seul dyn_clear n'echouait pas en [] *)
-  if List.is_empty ids then tclIDTAC else thin ids
-
 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
 
-let check_is_type env ty msg =
-  Proofview.tclEVARMAP >>= fun sigma ->
+exception DependsOnBody of Id.t option
+
+let check_is_type env sigma ty =
   let evdref = ref sigma in
   try
-    let _ = Typing.sort_of env evdref ty in
-    Proofview.Unsafe.tclEVARS !evdref
-  with e when Errors.noncritical e ->
-    msg e
-
-let check_decl env (_, c, ty) msg =
-  Proofview.tclEVARMAP >>= fun sigma ->
+    let _ = Typing.e_sort_of env evdref ty in
+    !evdref
+  with e when CErrors.noncritical e ->
+    raise (DependsOnBody None)
+
+let check_decl env sigma decl =
+  let open Context.Named.Declaration in
+  let ty = get_type decl in
   let evdref = ref sigma in
   try
-    let _ = Typing.sort_of env evdref ty in
-    let _ = match c with
-    | None -> ()
-    | Some c -> Typing.check env evdref c ty
+    let _ = Typing.e_sort_of env evdref ty in
+    let _ = match decl with
+    | LocalAssum _ -> ()
+    | LocalDef (_,c,_) -> Typing.e_check env evdref c ty
     in
-    Proofview.Unsafe.tclEVARS !evdref
-  with e when Errors.noncritical e ->
-    msg e
+    !evdref
+  with e when CErrors.noncritical e ->
+    let id = get_id decl in
+    raise (DependsOnBody (Some id))
 
 let clear_body ids =
-  Proofview.Goal.enter begin fun gl ->
+  let open Context.Named.Declaration in
+  Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+    let sigma = Tacmach.New.project gl in
     let ctx = named_context env in
-    let map (id, body, t as decl) = match body with
-    | None ->
+    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")
       in
       decl
-    | Some _ ->
-      if List.mem_f Id.equal id ids then (id, None, t) else decl
+    | LocalDef (id,_,t) as decl ->
+      if List.mem_f Id.equal id ids then LocalAssum (id, t) else decl
     in
     let ctx = List.map map ctx in
     let base_env = reset_context env in
     let env = push_named_context ctx base_env in
-    let check_hyps =
-      let check env (id, _, _ as decl) =
-        let msg _ = Tacticals.New.tclZEROMSG
-          (str "Hypothesis " ++ pr_id id ++ on_the_bodies ids)
+    let check =
+      try
+        let check (env, sigma, seen) decl =
+          (** 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
+              check_decl env sigma decl
+            else sigma
+          in
+          let seen = seen || List.mem_f Id.equal (get_id decl) ids in
+          (push_named decl env, sigma, seen)
         in
-        check_decl env decl msg <*> Proofview.tclUNIT (push_named decl env)
-      in
-      let checks = Proofview.Monad.List.fold_left check base_env (List.rev ctx) in
-      Proofview.tclIGNORE checks
-    in
-    let check_concl =
-      let msg _ = Tacticals.New.tclZEROMSG
-        (str "Conclusion" ++ on_the_bodies ids)
-      in
-      check_is_type env concl msg
+        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
+            check_is_type env sigma concl
+          else sigma
+        in
+        Proofview.Unsafe.tclEVARS sigma
+      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
+        in
+        Tacticals.New.tclZEROMSG msg
     in
-    check_hyps <*> check_concl <*>
-    Proofview.Refine.refine ~unsafe:true begin fun sigma ->
+    check <*>
+    Refine.refine ~unsafe:true { run = begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true concl
-    end
-  end
+    end }
+  end }
 
 let clear_wildcards ids =
-  Proofview.V82.tactic (tclMAP (fun (loc,id) gl ->
-    try with_check (Tacmach.thin_no_check [id]) gl
-    with ClearDependencyError (id,err) ->
-      (* Intercept standard [thin] error message *)
-      Loc.raise loc
-        (error_clear_dependency (pf_env gl) (project gl) (Id.of_string "_") err))
-    ids)
+  Tacticals.New.tclMAP (fun (loc, id) -> clear [id]) ids
 
 (*   Takes a list of booleans, and introduces all the variables
  *  quantified in the goal which are associated with a value
@@ -1866,51 +2085,18 @@ let rec intros_clearing = function
   | (false::tl) -> Tacticals.New.tclTHEN intro (intros_clearing tl)
   | (true::tl)  ->
       Tacticals.New.tclTHENLIST
-        [ intro; Tacticals.New.onLastHypId (fun id -> Proofview.V82.tactic (clear [id])); intros_clearing tl]
-
-(* Modifying/Adding an hypothesis  *)
-
-let specialize (c,lbind) g =
-  let tac, term =
-    if lbind == NoBindings then
-      let evd = Typeclasses.resolve_typeclasses (pf_env g) (project g) in
-	tclEVARS evd, nf_evar evd c
-    else
-      let clause = pf_apply make_clenv_binding g (c,pf_unsafe_type_of g 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 ".");
-       tclEVARS clause.evd, term
-  in
-  match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
-       | Var id when Id.List.mem id (pf_ids_of_hyps g) ->
-	   tclTHEN tac
-	     (tclTHENFIRST
-	       (fun g -> Proofview.V82.of_tactic (assert_before_replacing id (pf_unsafe_type_of g term)) g)
-	       (exact_no_check term)) g
-       | _ -> tclTHEN tac
-	   (tclTHENLAST
-              (fun g -> Proofview.V82.of_tactic (cut (pf_unsafe_type_of g term)) g)
-              (exact_no_check term)) g
+        [ intro; Tacticals.New.onLastHypId (fun id -> clear [id]); intros_clearing tl]
 
 (* Keeping only a few hypotheses *)
 
 let keep hyps =
-  Proofview.Goal.nf_enter begin fun gl ->
+  let open Context.Named.Declaration in
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   Proofview.tclENV >>= fun env ->
   let ccl = Proofview.Goal.concl gl in
   let cl,_ =
-    fold_named_context_reverse (fun (clear,keep) (hyp,_,_ as decl) ->
+    fold_named_context_reverse (fun (clear,keep) decl ->
+      let hyp = get_id decl in
       if Id.List.mem hyp hyps
         || List.exists (occur_var_in_decl env hyp) keep
 	|| occur_var env hyp ccl
@@ -1918,8 +2104,55 @@ let keep hyps =
       else (hyp::clear,keep))
       ~init:([],[]) (Proofview.Goal.env gl)
   in
-  Proofview.V82.tactic (fun gl -> thin cl gl)
-  end
+  clear cl
+  end }
+
+(*********************************)
+(*  Basic generalization tactics *)
+(*********************************)
+
+(* Given a type [T] convertible to [forall x1..xn:A1..An(x1..xn-1), G(x1..xn)]
+   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 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) =
+        Evarutil.new_evar env sigma ~principal:true ~store newcl in
+      Sigma (applist (ev, args), sigma, p)
+    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
+   [ctxt |- G(x1..xn] into [ctxt |- forall hyps, G(x1..xn)] *)
+
+let bring_hyps hyps =
+  if List.is_empty hyps then Tacticals.New.tclIDTAC
+  else
+    Proofview.Goal.enter { 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 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) =
+          Evarutil.new_evar env sigma ~principal:true ~store newcl in
+        Sigma (mkApp (ev, args), sigma, p)
+      end }
+    end }
+
+let revert hyps = 
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let gl = Proofview.Goal.assume gl in
+    let ctx = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) hyps in
+      (bring_hyps ctx) <*> (clear hyps)
+  end }
 
 (************************)
 (* Introduction tactics *)
@@ -1936,7 +2169,8 @@ let check_number_of_constructors expctdnumopt i nconstr =
   if i > nconstr then error "Not enough constructors."
 
 let constructor_tac with_evars expctdnumopt i lbind =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.s_enter { s_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
@@ -1946,16 +2180,19 @@ let constructor_tac with_evars expctdnumopt i lbind =
       Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
       check_number_of_constructors expctdnumopt i nconstr;
 
-      let sigma, cons = Evd.fresh_constructor_instance
-	(Proofview.Goal.env gl) (Proofview.Goal.sigma gl) (fst mind, i) in
+      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
-           [Proofview.Unsafe.tclEVARS sigma; 
+           [
 	    convert_concl_no_check redcl DEFAULTcast;
 	    intros; apply_tac])
-  end
+      in
+      Sigma (tac, sigma, p)
+  end }
 
 let one_constructor i lbind = constructor_tac false None i lbind
 
@@ -1972,7 +2209,7 @@ let rec tclANY tac = function
 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 begin fun gl ->
+  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
@@ -1982,7 +2219,7 @@ let any_constructor with_evars tacopt =
       Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
     if Int.equal nconstr 0 then error "The type has no constructors.";
     tclANY tac (List.interval 1 nconstr)
- end
+ 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
@@ -2033,7 +2270,7 @@ let my_find_eq_data_decompose gl t =
   | Constr_matching.PatternMatchingFailure -> None
 
 let intro_decomp_eq loc l thin tac id =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_enter { 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
@@ -2044,53 +2281,65 @@ let intro_decomp_eq loc l thin tac id =
     (eq,t,eq_args) (c, t)
   | None ->
     Tacticals.New.tclZEROMSG (str "Not a primitive equality here.")
-  end
+  end }
 
-let intro_or_and_pattern loc bracketed ll thin tac id =
-  Proofview.Goal.enter begin fun gl ->
+let intro_or_and_pattern loc with_evars bracketed ll thin tac id =
+  Proofview.Goal.enter { enter = begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
-  let ((ind,u),t) = Tacmach.New.pf_reduce_to_quantified_ind gl t in
-  let nv = constructors_nrealargs ind in
-  let ll = fix_empty_or_and_pattern (Array.length nv) ll in
-  check_or_and_pattern_size loc ll (Array.length nv);
+  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
   Tacticals.New.tclTHENLASTn
-    (Tacticals.New.tclTHEN (simplest_case c) (Proofview.V82.tactic (clear [id])))
+    (Tacticals.New.tclTHEN (simplest_ecase c) (clear [id]))
     (Array.map2 (fun n l -> tac thin (Some (bracketed,n)) l)
-       nv (Array.of_list ll))
-  end
+       nv_with_let ll)
+  end }
 
-let rewrite_hyp assert_style l2r id =
+let rewrite_hyp_then assert_style with_evars thin l2r id tac =
   let rew_on l2r =
-    Hook.get forward_general_rewrite_clause l2r false (mkVar id,NoBindings) in
+    Hook.get forward_general_rewrite_clause l2r with_evars (mkVar id,NoBindings) in
   let subst_on l2r x rhs =
     Hook.get forward_subst_one true x (id,rhs,l2r) in
-  let clear_var_and_eq c = tclTHEN (clear [id]) (clear [destVar c]) in
-  Proofview.Goal.enter begin fun gl ->
+  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 ->
     let env = Proofview.Goal.env gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
-    let whd_betadeltaiota = Tacmach.New.pf_apply whd_betadeltaiota gl in
-    let t = whd_betadeltaiota (type_of (mkVar id)) in
-    match match_with_equality_type t with
+    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
     | Some (hdcncl,[_;lhs;rhs]) ->
         if l2r && isVar lhs && not (occur_var env (destVar lhs) rhs) then
-          subst_on l2r (destVar lhs) rhs
+          let id' = destVar 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
-          subst_on l2r (destVar rhs) lhs
+          let id' = destVar rhs in
+          subst_on l2r id' lhs, early_clear id' thin
         else
-          Tacticals.New.tclTHEN (rew_on l2r onConcl) (Proofview.V82.tactic (clear [id]))
+          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
           Tacticals.New.tclTHEN (rew_on l2r allHypsAndConcl) 
-	    (Proofview.V82.tactic (clear_var_and_eq c))
+	    (clear_var_and_eq id'),
+          early_clear id' thin
         else
-          Tacticals.New.tclTHEN (rew_on l2r onConcl) (Proofview.V82.tactic (clear [id]))
+          Tacticals.New.tclTHEN (rew_on l2r onConcl) (clear [id]),
+          thin
     | _ ->
-        Tacticals.New.tclTHEN (rew_on l2r onConcl) (Proofview.V82.tactic (clear [id]))
-  end
+        Tacticals.New.tclTHEN (rew_on l2r onConcl) (clear [id]),
+        thin in
+    (* Skip the side conditions of the rewriting step *)
+    Tacticals.New.tclTHENFIRST eqtac (tac thin)
+  end }
 
-let rec prepare_naming loc = function
+let prepare_naming loc = function
   | IntroIdentifier id -> NamingMustBe (loc,id)
   | IntroAnonymous -> NamingAvoid []
   | IntroFresh id -> NamingBasedOn (id,[])
@@ -2098,7 +2347,8 @@ let rec prepare_naming loc = function
 let rec explicit_intro_names = function
 | (_, IntroForthcoming _) :: l -> explicit_intro_names l
 | (_, IntroNaming (IntroIdentifier id)) :: l -> id :: explicit_intro_names l
-| (_, IntroAction (IntroOrAndPattern ll)) :: l' ->
+| (_, 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' ->
     explicit_intro_names (l@l')
@@ -2161,12 +2411,13 @@ let exceed_bound n = function
      [patl]: introduction patterns to interpret
   *)
 
-let rec intro_patterns_core b avoid ids thin destopt bound n tac = function
+let rec intro_patterns_core with_evars b avoid ids thin destopt bound n tac =
+  function
   | [] when fit_bound n bound ->
       tac ids thin
   | [] ->
       (* Behave as IntroAnonymous *)
-      intro_patterns_core b avoid ids thin destopt bound n tac
+      intro_patterns_core with_evars b avoid ids thin destopt bound n tac
         [dloc,IntroNaming IntroAnonymous]
   | (loc,pat) :: l ->
   if exceed_bound n bound then error_unexpected_extra_pattern loc bound pat else
@@ -2174,98 +2425,100 @@ let rec intro_patterns_core b avoid ids thin destopt bound n tac = function
   | IntroForthcoming onlydeps ->
       intro_forthcoming_then_gen (NamingAvoid (avoid@explicit_intro_names l))
 	  destopt onlydeps n bound
-        (fun ids -> intro_patterns_core b avoid ids thin destopt 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 (b || not (List.is_empty l)) false pat thin
-          destopt
-          (fun thin bound' -> intro_patterns_core b avoid ids thin destopt bound' 0
+        (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 ->
-              intro_patterns_core b avoid ids thin destopt bound (n+1) tac l)))
+              intro_patterns_core with_evars b avoid ids thin destopt bound (n+1) tac l)))
   | IntroNaming pat ->
-      intro_pattern_naming loc b avoid ids pat thin destopt bound (n+1) tac l
+      intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound (n+1) tac l
 
   (* Pi-introduction rule, used backwards *)
-and intro_pattern_naming loc b avoid ids pat thin destopt bound n tac l =
+and intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound n tac l =
   match pat with
   | IntroIdentifier id ->
       check_thin_clash_then id thin avoid (fun thin ->
         intro_then_gen (NamingMustBe (loc,id)) destopt true false
-          (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l))
+          (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))
 	destopt true false
-        (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l)
+        (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))
 	destopt true false
-        (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l)
+        (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
 
-and intro_pattern_action loc b style pat thin destopt tac id = match pat with
+and intro_pattern_action loc with_evars b style pat thin destopt tac id =
+  match pat with
   | IntroWildcard ->
       tac ((loc,id)::thin) None []
   | IntroOrAndPattern ll ->
-      intro_or_and_pattern loc 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
   | IntroRewrite l2r ->
-      Tacticals.New.tclTHENLAST
-        (* Skip the side conditions of the rewriting step *)
-	(rewrite_hyp style l2r id)
-        (tac thin None [])
+      rewrite_hyp_then style with_evars thin l2r id (fun thin -> tac thin None [])
   | IntroApplyOn (f,(loc,pat)) ->
       let naming,tac_ipat =
-        prepare_intros_loc loc (IntroIdentifier id) destopt pat in
+        prepare_intros_loc loc with_evars (IntroIdentifier id) destopt pat in
       let doclear =
         if naming = NamingMustBe (loc,id) then
           Proofview.tclUNIT () (* apply_in_once do a replacement *)
         else
-          Proofview.V82.tactic (clear [id]) in
-      let f env sigma = let (sigma,c) = f env sigma in (sigma,(c,NoBindings)) in
-      apply_in_delayed_once false true true true naming id (None,(loc,f))
+          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))
         (fun id -> Tacticals.New.tclTHENLIST [doclear; tac_ipat id; tac thin None []])
 
-and prepare_intros_loc loc dft destopt = function
+and prepare_intros_loc loc with_evars dft destopt = function
   | IntroNaming ipat ->
       prepare_naming loc ipat,
-      (fun id -> Proofview.V82.tactic (move_hyp id destopt))
+      (fun id -> move_hyp id destopt)
   | IntroAction ipat ->
       prepare_naming loc dft,
       (let tac thin bound =
-        intro_patterns_core true [] [] thin destopt bound 0
+        intro_patterns_core with_evars true [] [] thin destopt bound 0
           (fun _ l -> clear_wildcards l) in
-      fun id -> intro_pattern_action loc true true ipat [] destopt tac id)
+      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.")
 
-let intro_patterns_bound_to n destopt =
-  intro_patterns_core true [] [] [] destopt
+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)
 
-let intro_patterns_to destopt =
-  intro_patterns_core (use_bracketing_last_or_and_intro_pattern ())
+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)
 
-let intro_pattern_to destopt pat =
-  intro_patterns_to destopt [dloc,pat]
+let intro_pattern_to with_evars destopt pat =
+  intro_patterns_to with_evars destopt [dloc,pat]
 
-let intro_patterns = intro_patterns_to MoveLast
+let intro_patterns with_evars = intro_patterns_to with_evars MoveLast
 
 (* Implements "intros" *)
-let intros_patterns = function
+let intros_patterns with_evars = function
   | [] -> intros
-  | l -> intro_patterns_to MoveLast l
+  | l -> intro_patterns_to with_evars MoveLast l
 
 (**************************)
 (*   Forward reasoning    *)
 (**************************)
 
-let prepare_intros dft destopt = function
+let prepare_intros with_evars dft destopt = function
   | None -> prepare_naming dloc dft, (fun _id -> Proofview.tclUNIT ())
-  | Some (loc,ipat) -> prepare_intros_loc loc dft destopt ipat
+  | Some (loc,ipat) -> prepare_intros_loc loc with_evars dft destopt ipat
 
 let ipat_of_name = function
   | Anonymous -> None
@@ -2276,7 +2529,7 @@ let head_ident c =
    if isVar c then Some (destVar c) else None
 
 let assert_as first hd ipat t =
-  let naming,tac = prepare_intros IntroAnonymous MoveLast ipat in
+  let naming,tac = prepare_intros 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
@@ -2289,18 +2542,19 @@ 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 begin fun gl ->
+  Proofview.Goal.enter { 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
-  let naming,ipat_tac = prepare_intros (IntroIdentifier id) destopt ipat in
+  let naming,ipat_tac =
+    prepare_intros 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)
   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
@@ -2311,7 +2565,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, fun _ sigma -> sigma, l)) lemmas in
+  let lemmas = List.map (fun (k,(loc,l)) -> k, (loc, { delayed = fun _ sigma -> Sigma.here l sigma })) lemmas in
   general_apply_in false simple simple with_evars id lemmas ipat
 
 let apply_delayed_in simple with_evars id lemmas ipat =
@@ -2324,13 +2578,6 @@ let apply_delayed_in simple with_evars id lemmas ipat =
 (* Implementation without generalisation: abbrev will be lost in hyps in *)
 (* in the extracted proof *)
 
-let tactic_infer_flags with_evar = {
-  Pretyping.use_typeclasses = true;
-  Pretyping.use_unif_heuristics = true;
-  Pretyping.use_hook = Some solve_by_implicit_tactic;
-  Pretyping.fail_evar = not with_evar;
-  Pretyping.expand_evars = true }
-
 let decode_hyp = function
   | None -> MoveLast
   | Some id -> MoveAfter id
@@ -2342,16 +2589,17 @@ let decode_hyp = function
 *)
 
 let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
-  Proofview.Goal.enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
+  Proofview.Goal.s_enter { s_enter = begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let (sigma, t) = match ty with
-    | Some t -> (sigma, t)
+    let env = Proofview.Goal.env gl in
+    let Sigma (t, sigma, p) = match ty with
+    | Some t -> Sigma.here t sigma
     | None ->
       let t = typ_of env sigma c in
-      Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma t
+      let sigma, c = Evarsolve.refresh_universes ~onlyalg:true (Some false) env (Sigma.to_evar_map sigma) t in
+      Sigma.Unsafe.of_pair (c, sigma)
     in
-    let eq_tac gl = match with_eq with
+    let Sigma ((newcl, eq_tac), sigma, q) = match with_eq with
       | Some (lr,(loc,ido)) ->
           let heq = match ido with
             | IntroAnonymous -> new_fresh_id [id] (add_prefix "Heq" id) gl
@@ -2359,42 +2607,51 @@ let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
             | 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 = Evd.fresh_global env sigma eqdata.eq in
-          let sigma, refl = Evd.fresh_global env sigma eqdata.refl 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 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
-            sigma, term,
+          let ans = term,
             Tacticals.New.tclTHEN
 	      (intro_gen (NamingMustBe (loc,heq)) (decode_hyp lastlhyp) true false)
 	      (clear_body [heq;id])
+          in
+          Sigma.Unsafe.of_pair (ans, sigma)
       | None ->
-	  (sigma, mkNamedLetIn id c t ccl, Proofview.tclUNIT ()) in
-    let (sigma,newcl,eq_tac) = eq_tac gl in
-    Tacticals.New.tclTHENLIST
-      [ Proofview.Unsafe.tclEVARS sigma;
-	convert_concl_no_check newcl DEFAULTcast;
+          Sigma.here (mkNamedLetIn id c t ccl, Proofview.tclUNIT ()) sigma
+    in
+    let tac =
+      Tacticals.New.tclTHENLIST
+      [ convert_concl_no_check newcl DEFAULTcast;
         intro_gen (NamingMustBe (dloc,id)) (decode_hyp lastlhyp) true false;
         Tacticals.New.tclMAP convert_hyp_no_check depdecls;
         eq_tac ]
-  end
+    in
+    Sigma (tac, sigma, p +> q)
+  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 _ (id',_,_ as d) env ->
-      let env = if Id.equal id id' then push_named_context decls env else env in
+    (fun _ d env ->
+      let env = if Id.equal id (get_id d) then push_named_context decls env else env in
       push_named d env)
     ~init:(reset_context env) env
 
 (* unsafe *)
 
 let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
-  let body = if dep then Some c else None in
+  let open Context.Named.Declaration in
   let t = match ty with Some t -> t | _ -> typ_of env sigma c in
+  let decl = if dep then LocalDef (id,c,t)
+	     else LocalAssum (id,t)
+  in
   match with_eq with
   | Some (lr,(loc,ido)) ->
       let heq = match ido with
@@ -2406,56 +2663,65 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
           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 = Evd.fresh_global env sigma eqdata.eq in
-      let sigma, refl = Evd.fresh_global env sigma eqdata.refl 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 eq = applist (eq,args) in
       let refl = applist (refl, [t;mkVar id]) in
-      let newenv = insert_before [heq,None,eq;id,body,t] lastlhyp env in
-      let (sigma,x) = new_evar newenv sigma ~principal:true ~store ccl in
-      (sigma,mkNamedLetIn id c t (mkNamedLetIn heq refl eq x))
+      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)
   | None ->
-      let newenv = insert_before [id,body,t] lastlhyp env in
-      let (sigma,x) = new_evar newenv sigma ~principal:true ~store ccl in
-      (sigma,mkNamedLetIn id c t x)
+      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 letin_tac with_eq id c ty occs =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
+  Proofview.Goal.nf_s_enter { s_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 abs = AbstractExact (id,c,ty,occs,true) in
-    let (id,_,depdecls,lastlhyp,ccl,_) = make_abstraction env sigma ccl abs in
-    (* We keep the original term to match *)
-    letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty
-  end
+    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)
+    in
+    let tac = letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty in
+    Sigma (tac, sigma, p)
+  end }
 
 let letin_pat_tac with_eq id c occs =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
+  Proofview.Goal.nf_s_enter { s_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 = match res with
+    let Sigma (c, sigma, p) = match res with
     | None -> finish_evar_resolution ~flags:(tactic_infer_flags false) env sigma c
-    | Some (sigma,c) -> (sigma,c) in
-    Tacticals.New.tclTHEN
-      (Proofview.Unsafe.tclEVARS sigma)
+    | Some res -> res in
+    let tac =
       (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) None)
-  end
+    in
+    Sigma (tac, sigma, p)
+  end }
 
 (* Tactics "pose proof" (usetac=None) and "assert"/"enough" (otherwise) *)
 let forward b usetac ipat c =
   match usetac with
   | None ->
-      Proofview.Goal.enter begin fun gl ->
-      let t = Tacmach.New.pf_unsafe_type_of gl c in
+      Proofview.Goal.enter { enter = begin fun gl ->
+      let t = Tacmach.New.pf_get_type_of gl c in
       let hd = head_ident c in
-      Tacticals.New.tclTHENFIRST (assert_as true hd ipat t)
-	(Proofview.V82.tactic (exact_no_check c))
-      end
+      Tacticals.New.tclTHENFIRST (assert_as true hd ipat t) (exact_no_check c)
+      end }
   | Some tac ->
+      let tac = match tac with
+        | None -> Tacticals.New.tclIDTAC
+        | Some tac -> Tacticals.New.tclCOMPLETE tac in
       if b then
         Tacticals.New.tclTHENFIRST (assert_as b None ipat c) tac
       else
@@ -2463,47 +2729,13 @@ let forward b usetac ipat c =
           (assert_as b None ipat c) [||] tac [|Tacticals.New.tclIDTAC|]
 
 let pose_proof na c = forward true None (ipat_of_name na) c
-let assert_by na t tac = forward true (Some tac) (ipat_of_name na) t
-let enough_by na t tac = forward false (Some tac) (ipat_of_name na) t
+let assert_by na t tac = forward true (Some (Some tac)) (ipat_of_name na) t
+let enough_by na t tac = forward false (Some (Some tac)) (ipat_of_name na) t
 
 (***************************)
 (*  Generalization tactics *)
 (***************************)
 
-(* Given a type [T] convertible to [forall x1..xn:A1..An(x1..xn-1), G(x1..xn)]
-   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 hdcty argl gl =
-  refine (applist (mkCast (Evarutil.mk_new_meta(),DEFAULTcast, hdcty),argl)) gl
-
-(* Given a context [hyps] with domain [x1..xn], possibly with let-ins,
-   and well-typed in the current goal, [bring_hyps hyps] generalizes
-   [ctxt |- G(x1..xn] into [ctxt |- forall hyps, G(x1..xn)] *)
-
-let bring_hyps hyps =
-  if List.is_empty hyps then Tacticals.New.tclIDTAC
-  else
-    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 newcl = List.fold_right mkNamedProd_or_LetIn hyps concl in
-      let args = Array.of_list (instance_from_named_context hyps) in
-      Proofview.Refine.refine begin fun sigma ->
-        let (sigma, ev) =
-          Evarutil.new_evar env sigma ~principal:true ~store newcl in
-        (sigma, (mkApp (ev, args)))
-      end
-    end
-
-let revert hyps = 
-  Proofview.Goal.enter begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
-    let ctx = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) hyps in
-      (bring_hyps ctx) <*> (Proofview.V82.tactic (clear hyps))
-  end
-
 (* Compute a name for a generalization *)
 
 let generalized_name c t ids cl = function
@@ -2527,100 +2759,117 @@ let generalized_name c t ids cl = function
    [forall x, x1:A1(x1), .., xi:Ai(x). T(x)] with all [c] abtracted in [Ai]
    but only those at [occs] in [T] *)
 
-let generalize_goal_gen env ids i ((occs,c,b),na) t (cl,evd) =
+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 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 cl',evd' = subst_closed_term_occ env evd (AtOccs occs) c (it_mkProd_or_LetIn cl newdecls) 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
-    mkProd_or_LetIn (na,b,t) cl', evd'
+  let decl = match b with
+    | None -> LocalAssum (na,t)
+    | Some b -> LocalDef (na,b,t)
+  in
+  mkProd_or_LetIn decl cl', sigma'
 
-let generalize_goal gl i ((occs,c,b),na as o) cl =
-  let t = pf_unsafe_type_of gl c in
-  let env = pf_env gl in
-    generalize_goal_gen env (pf_ids_of_hyps gl) i o t cl
+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 sigma, t = Typing.type_of env sigma c in
+  generalize_goal_gen env sigma ids i o t cl
 
-let generalize_dep ?(with_let=false) c gl =
+let old_generalize_dep ?(with_let=false) c gl =
+  let open Context.Named.Declaration in
   let env = pf_env gl in
   let sign = pf_hyps gl in
   let init_ids = ids_of_named_context (Global.named_context()) in
-  let seek d toquant =
-    if List.exists (fun (id,_,_) -> occur_var_in_decl env id d) toquant
+  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
       d::toquant
     else
       toquant in
-  let to_quantify = Context.fold_named_context seek sign ~init:[] 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 (fun (id,_,_) -> id) to_quantify_rev in
+  let qhyps = List.map 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
-      | Var id when mem_named_context id sign && not (Id.List.mem id init_ids)
+      | 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 (pf_concl gl) to_quantify in
+  let cl' = it_mkNamedProd_or_LetIn (Tacmach.pf_concl gl) to_quantify in
   let body =
     if with_let then
       match kind_of_term c with
-      | Var id -> pi2 (pf_get_hyp gl id)
+      | Var id -> Tacmach.pf_get_hyp gl id |> get_value
       | _ -> None
     else None
   in
   let cl'',evd = generalize_goal gl 0 ((AllOccurrences,c,body),Anonymous)
     (cl',project gl) in
-  let args = instance_from_named_context to_quantify_rev 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
   tclTHENLIST
     [tclEVARS evd;
-     apply_type cl'' (if Option.is_empty body then c::args else args);
-     thin (List.rev tothin')]
+     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)
+
 (**  *)
-let generalize_gen_let lconstr gl =
+let generalize_gen_let lconstr = Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let newcl, evd =
-    List.fold_right_i (generalize_goal gl) 0 lconstr
-      (pf_concl gl,project gl)
+    List.fold_right_i (Tacmach.New.of_old generalize_goal gl) 0 lconstr
+      (Tacmach.New.pf_concl gl,Tacmach.New.project gl)
   in
-  tclTHEN (tclEVARS evd)
-    (apply_type newcl (List.map_filter (fun ((_,c,b),_) ->
-      if Option.is_empty b then Some c else None) lconstr)) gl
+  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 }
 
 let new_generalize_gen_let lconstr =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.s_enter { s_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 = Proofview.Goal.sigma 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 =
+    let newcl, sigma, args =
       List.fold_right_i 
-	(fun i ((_,c,b),_ as o) (cl, args) ->
-	  let t = Tacmach.New.pf_unsafe_type_of gl c in
+	(fun i ((_,c,b),_ as o) (cl, sigma, args) ->
+	  let sigma, t = Typing.type_of env sigma c in
 	  let args = if Option.is_empty b then c :: args else args in
-	    generalize_goal_gen env ids i o t cl, args)
-	0 lconstr ((concl, sigma), [])
+          let cl, sigma = generalize_goal_gen env sigma ids i o t cl in
+          (cl, sigma, args))
+	0 lconstr (concl, sigma, [])
     in
-      Proofview.Unsafe.tclEVARS sigma <*>
-	Proofview.Refine.refine begin fun sigma ->
-          let (sigma, ev) = Evarutil.new_evar env sigma ~principal:true newcl in
-            (sigma, (applist (ev, args)))
-	end
-  end
+    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 }
 
 let generalize_gen lconstr =
-  generalize_gen_let (List.map (fun ((occs,c),na) ->
+  generalize_gen_let (List.map (fun (occs_c,na) ->
+    let (occs,c) = Redexpr.out_with_occurrences occs_c in
     (occs,c,None),na) lconstr)
 
 let new_generalize_gen lconstr =
   new_generalize_gen_let (List.map (fun ((occs,c),na) ->
     (occs,c,None),na) lconstr)
-    
-let generalize l =
-  generalize_gen_let (List.map (fun c -> ((AllOccurrences,c,None),Anonymous)) l)
 
-let new_generalize l =
+let generalize l =
   new_generalize_gen_let (List.map (fun c -> ((AllOccurrences,c,None),Anonymous)) l)
 
 (* Faudra-t-il une version avec plusieurs args de generalize_dep ?
@@ -2635,29 +2884,88 @@ let quantify lconstr =
    tclIDTAC
 *)
 
+(* Modifying/Adding an hypothesis  *)
+
+let specialize (c,lbind) ipat =
+  Proofview.Goal.enter { enter = begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let sigma = Sigma.to_evar_map (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
+    else
+      let clause = make_clenv_binding env sigma (c,Retyping.get_type_of env sigma 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 typ = Retyping.get_type_of env sigma term in
+  let tac =
+    match kind_of_term (fst(decompose_app (snd(decompose_lam_assum 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
+      let repl = do_replace (Some id) naming in
+      Tacticals.New.tclTHENFIRST
+        (assert_before_then_gen repl naming typ tac)
+	(exact_no_check term)
+    | _ ->
+      match ipat with
+      | 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) ->
+        (* 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
+        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 }
+
 (*****************************)
 (* Ad hoc unfold             *)
 (*****************************)
 
 (* The two following functions should already exist, but found nowhere *)
 (* Unfolds x by its definition everywhere *)
-let unfold_body x gl =
-  let hyps = pf_hyps gl in
-  let xval =
-    match Context.lookup_named x hyps with
-        (_,Some xval,_) -> xval
-      | _ -> errorlabstrm "unfold_body"
-          (pr_id x ++ str" is not a defined hypothesis.") in
-  let aft = afterHyp x gl in
-  let hl = List.fold_right (fun (y,yval,_) cl -> (y,InHyp) :: cl) aft [] in
-  let xvar = mkVar x in
-  let rfun _ _ c = replace_term xvar xval c in
-  tclTHENLIST
-    [tclMAP (fun h -> reduct_in_hyp rfun h) hl;
-     reduct_in_concl (rfun,DEFAULTcast)] gl
+let unfold_body x =
+  let open Context.Named.Declaration in
+  Proofview.Goal.enter { enter = begin fun gl ->
+  (** We normalize the given hypothesis immediately. *)
+  let env = Proofview.Goal.env (Proofview.Goal.assume gl) in
+  let xval = match Environ.lookup_named x env with
+  | LocalAssum _ -> errorlabstrm "unfold_body"
+    (pr_id x ++ str" is not a defined hypothesis.")
+  | LocalDef (_,xval,_) -> 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 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 }
 
 (* Either unfold and clear if defined or simply clear if not a definition *)
-let expand_hyp id = tclTHEN (tclTRY (unfold_body id)) (clear [id])
+let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
 
 (*****************************)
 (* High-level induction      *)
@@ -2670,8 +2978,6 @@ let expand_hyp id = tclTHEN (tclTRY (unfold_body id)) (clear [id])
   - [hyp0] is the induction hypothesis
   - we extract from [args] the variables which are not rigid parameters
     of the inductive type, this is [indvars] (other terms are forgotten);
-    [indhyps] are the ones which actually are declared in context
-    (done in [find_atomic_param_of_ind])
   - we look for all hyps depending of [hyp0] or one of [indvars]:
     this is [dephyps] of types [deptyps] respectively
   - [statuslist] tells for each hyps in [dephyps] after which other hyp
@@ -2683,7 +2989,7 @@ let expand_hyp id = tclTHEN (tclTRY (unfold_body id)) (clear [id])
   Strategy: (cf in [induction_with_atomization_of_ind_arg])
   - requantify and clear all [dephyps]
   - apply induction on [hyp0]
-  - clear [indhyps] and [hyp0]
+  - clear those of [indvars] that are variables and [hyp0]
   - in the i-th subgoal, intro the arguments of the i-th constructor
     of the inductive type after [hyp0succ] (done in
     [induct_discharge]) let the induction hypotheses on top of the
@@ -2695,13 +3001,17 @@ let expand_hyp id = tclTHEN (tclTRY (unfold_body id)) (clear [id])
 
  *)
 
+let warn_unused_intro_pattern =
+  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)
+
 let check_unused_names names =
   if not (List.is_empty names) && Flags.is_verbose () then
-    msg_warning
-      (str"Unused introduction " ++ str (String.plural (List.length names) "pattern")
-       ++ str": " ++ prlist_with_sep spc 
-	 (Miscprint.pr_intro_pattern 
-	    (fun c -> Printer.pr_constr (snd (c (Global.env()) Evd.empty)))) names)
+    warn_unused_intro_pattern names
 
 let intropattern_of_name gl avoid = function
   | Anonymous -> IntroNaming IntroAnonymous
@@ -2731,19 +3041,19 @@ let re_intro_dependent_hypotheses (lstatus,rstatus) (_,tophyp) =
     (intros_move rstatus)
     (intros_move newlstatus)
 
-let dest_intro_patterns avoid thin dest pat tac =
-  intro_patterns_core true avoid [] thin dest None 0 tac pat
+let dest_intro_patterns with_evars avoid thin dest pat tac =
+  intro_patterns_core with_evars true avoid [] thin dest None 0 tac pat
 
-let safe_dest_intro_patterns avoid thin dest pat tac =
+let safe_dest_intro_patterns with_evars avoid thin dest pat tac =
   Proofview.tclORELSE
-    (dest_intro_patterns avoid thin dest pat tac)
+    (dest_intro_patterns with_evars avoid thin dest pat tac)
     begin function (e, info) -> match e with
       | UserError ("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
           a constructor to be move at the place of x. *)
-          dest_intro_patterns avoid thin MoveLast pat tac
+          dest_intro_patterns with_evars avoid thin MoveLast pat tac
       | e -> Proofview.tclZERO ~info e
     end
 
@@ -2775,51 +3085,51 @@ let get_recarg_dest (recargdests,tophyp) =
    had to be introduced at the top of the context).
 *)
 
-let induct_discharge dests avoid' tac (avoid,ra) names =
+let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
   let avoid = avoid @ avoid' in
   let rec peel_tac ra dests names thin =
     match ra with
-    | (RecArg,deprec,recvarname) ::
-        (IndArg,depind,hyprecname) :: ra' ->
-        Proofview.Goal.enter begin fun gl ->
+    | (RecArg,_,deprec,recvarname) ::
+        (IndArg,_,depind,hyprecname) :: ra' ->
+        Proofview.Goal.enter { enter = begin fun gl ->
         let (recpat,names) = match names with
           | [loc,IntroNaming (IntroIdentifier id) as pat] ->
               let id' = next_ident_away (add_prefix "IH" id) avoid in
 	      (pat, [dloc, IntroNaming (IntroIdentifier id')])
           | _ -> consume_pattern avoid (Name recvarname) deprec gl names in
         let dest = get_recarg_dest dests in
-        dest_intro_patterns avoid thin dest [recpat] (fun ids thin ->
-        Proofview.Goal.enter begin fun gl ->
+        dest_intro_patterns with_evars avoid thin dest [recpat] (fun ids thin ->
+        Proofview.Goal.enter { enter = begin fun gl ->
           let (hyprec,names) =
             consume_pattern avoid (Name hyprecname) depind gl names
           in
-	  dest_intro_patterns avoid thin MoveLast [hyprec] (fun ids' thin ->
+	  dest_intro_patterns with_evars avoid thin MoveLast [hyprec] (fun ids' thin ->
 	    peel_tac ra' (update_dest dests ids') names thin)
-        end)
-        end
-    | (IndArg,dep,hyprecname) :: ra' ->
-        Proofview.Goal.enter begin fun gl ->
+        end })
+        end }
+    | (IndArg,_,dep,hyprecname) :: ra' ->
+        Proofview.Goal.enter { 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 avoid thin MoveLast [pat] (fun ids thin ->
+	dest_intro_patterns with_evars avoid thin MoveLast [pat] (fun ids thin ->
         peel_tac ra' (update_dest dests ids) names thin)
-        end
-    | (RecArg,dep,recvarname) :: ra' ->
-        Proofview.Goal.enter begin fun gl ->
+        end }
+    | (RecArg,_,dep,recvarname) :: ra' ->
+        Proofview.Goal.enter { 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 avoid thin dest [pat] (fun ids thin ->
+	dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
-        end
-    | (OtherArg,dep,_) :: ra' ->
-        Proofview.Goal.enter begin fun gl ->
+        end }
+    | (OtherArg,_,dep,_) :: ra' ->
+        Proofview.Goal.enter { 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 avoid thin dest [pat] (fun ids thin ->
+	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;
         Tacticals.New.tclTHEN (clear_wildcards thin) (tac dests)
@@ -2831,6 +3141,7 @@ let induct_discharge 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
     | Proj (p, c) -> Retyping.expand_projection env sigma p (aux env c) []
@@ -2841,7 +3152,7 @@ let expand_projections env sigma c =
 (* Marche pas... faut prendre en compte l'occurrence précise... *)
 
 let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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 reduce_to_quantified_ref = Tacmach.New.pf_apply reduce_to_quantified_ref gl in
@@ -2894,7 +3205,7 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
 	      (atomize_one (i-1) (mkVar x::args) (mkVar x::args') (x::avoid))
   in
   atomize_one (List.length argl) [] [] []
-  end
+  end }
 
 (* [cook_sign] builds the lists [beforetoclear] (preceding the
    ind. var.) and [aftertoclear] (coming after the ind. var.)  of hyps
@@ -2918,7 +3229,6 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
 
    Induction hypothesis is H4 ([hyp0])
    Variable parameters of (le O n) is the singleton list with "n" ([indvars])
-   Part of [indvars] really in context is the same ([indhyps])
    The dependent hyps are H3 and H6 ([dephyps])
    For H3 the memorized places are H5 ([lhyp]) and H2 ([rhyp])
     because these names are among the hyp which are fixed through the induction
@@ -2963,8 +3273,9 @@ 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 =
-  (* First phase from L to R: get [indhyps], [decldep] and [statuslist]
+  (* 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 decldeps = ref [] in
@@ -2973,7 +3284,8 @@ let cook_sign hyp0_opt inhyps indvars env =
   let lstatus = ref [] in
   let before = ref true in
   let maindep = ref false in
-  let seek_deps env (hyp,_,_ as decl) rhyp =
+  let seek_deps env decl rhyp =
+    let hyp = get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false)
     then begin
       before:=false;
@@ -2992,7 +3304,7 @@ let cook_sign hyp0_opt inhyps indvars env =
       in
       let depother = List.is_empty inhyps &&
 	(List.exists (fun id -> occur_var_in_decl env id decl) indvars ||
-         List.exists (fun (id,_,_) -> occur_var_in_decl env id decl) !decldeps)
+         List.exists (fun decl' -> occur_var_in_decl env (get_id decl') decl) !decldeps)
       in
       if not (List.is_empty inhyps) && Id.List.mem hyp inhyps
          || dephyp0 || depother
@@ -3014,7 +3326,8 @@ let cook_sign hyp0_opt inhyps indvars env =
   in
   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 (hyp,_,_) =
+  let compute_lstatus lhyp decl =
+    let hyp = 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
@@ -3064,20 +3377,20 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: rel_context;     (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
-  nparams: int;            (* number of parameters *)
-  predicates: rel_context; (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
-  npredicates: int;        (* Number of predicates *)
-  branches: rel_context;   (* branchr,...,branch1 *)
-  nbranches: int;          (* Number of branches *)
-  args: rel_context;       (* (xni, Ti_ni) ... (x1, Ti_1) *)
-  nargs: int;              (* number of arguments *)
-  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni)
-				     if HI is in premisses, None otherwise *)
-  concl: types;            (* Qi x1...xni HI (f...), HI and (f...)
-			      are optional and mutually exclusive *)
-  indarg_in_concl: bool;   (* true if HI appears at the end of conclusion *)
-  farg_in_concl: bool;     (* true if (f...) appears at the end of conclusion *)
+  params: Context.Rel.t;      (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  nparams: int;               (* number of parameters *)
+  predicates: Context.Rel.t;  (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  npredicates: int;           (* Number of predicates *)
+  branches: Context.Rel.t;    (* branchr,...,branch1 *)
+  nbranches: int;             (* Number of branches *)
+  args: Context.Rel.t;        (* (xni, Ti_ni) ... (x1, Ti_1) *)
+  nargs: int;                 (* number of arguments *)
+  indarg: Context.Rel.Declaration.t 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 *)
+  indarg_in_concl: bool;      (* true if HI appears at the end of conclusion *)
+  farg_in_concl: bool;        (* true if (f...) appears at the end of conclusion *)
 }
 
 let empty_scheme =
@@ -3197,31 +3510,36 @@ let decompose_indapp f 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'
   else
     mkHEq ty t ty' t', mkHRefl ty' t'
 
-let make_abstract_generalize gl id concl dep ctx body c eqs args refls =
-  let meta = Evarutil.new_meta() in
+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 ->
   let eqslen = List.length eqs in
-  let term, typ = mkVar id, pf_get_hyp_typ gl id in
     (* Abstract by the "generalized" hypothesis equality proof if necessary. *)
   let abshypeq, abshypt =
     if dep then
-      let eq, refl = mk_term_eq (push_rel_context ctx (pf_env gl)) (project gl) (lift 1 c) (mkRel 1) typ term in
+      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, [||]
   in
     (* Abstract by equalities *)
   let eqs = lift_togethern 1 eqs in (* lift together and past genarg *)
-  let abseqs = it_mkProd_or_LetIn (lift eqslen abshypeq) (List.map (fun x -> (Anonymous, None, x)) eqs) in
+  let abseqs = it_mkProd_or_LetIn (lift eqslen abshypeq) (List.map (fun x -> LocalAssum (Anonymous, x)) eqs) in
+  let decl = match body with
+    | None -> LocalAssum (Name id, c)
+    | Some body -> LocalDef (Name id, body, c)
+  in
     (* Abstract by the "generalized" hypothesis. *)
-  let genarg = mkProd_or_LetIn (Name id, body, c) abseqs in
+  let genarg = mkProd_or_LetIn decl abseqs in
     (* Abstract by the extension of the context *)
   let genctyp = it_mkProd_or_LetIn genarg ctx in
     (* The goal will become this product. *)
-  let genc = mkCast (mkMeta meta, DEFAULTcast, genctyp) in
+  let Sigma (genc, sigma, p) = 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. *)
@@ -3229,14 +3547,17 @@ let make_abstract_generalize gl id 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. *)
-    mkApp (appeqs, abshypt)
+  Sigma (mkApp (appeqs, abshypt), sigma, p)
+  end }
 
 let hyps_of_vars env sign nogen hyps =
+  let open Context.Named.Declaration in
   if Id.Set.is_empty hyps then []
   else
     let (_,lh) =
-      Context.fold_named_context_reverse
-        (fun (hs,hl) (x,_,_ as d) ->
+      Context.Named.fold_inside
+        (fun (hs,hl) d ->
+          let x = 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
@@ -3265,14 +3586,15 @@ let linear vars args =
       true
     with Seen -> false
 
-let is_defined_variable env id = match lookup_named id env with
-| (_, None, _) -> false
-| (_, Some _, _) -> true
+let is_defined_variable env id =
+  let open Context.Named.Declaration in
+  lookup_named id env |> is_local_def
 
 let abstract_args gl generalize_vars dep id defined f args =
-  let sigma = ref (project gl) in
-  let env = pf_env gl in
-  let concl = pf_concl gl 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 get_id name =
@@ -3286,11 +3608,12 @@ let abstract_args gl generalize_vars dep id defined f args =
        eqs are not lifted w.r.t. each other yet. (* will be needed when going to dependent indexes *)
     *)
   let aux (prod, ctx, ctxenv, c, args, eqs, refls, nongenvars, vars, env) arg =
-    let (name, _, ty), arity =
+    let name, ty, arity =
       let rel, c = Reductionops.splay_prod_n env !sigma 1 prod in
-	List.hd rel, c
+      let decl = List.hd rel in
+      get_name decl, get_type decl, c
     in
-    let argty = pf_unsafe_type_of gl arg in
+    let argty = Tacmach.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
@@ -3302,7 +3625,7 @@ let abstract_args gl generalize_vars dep id defined f args =
       	  Id.Set.add id nongenvars, Id.Set.remove id vars, env)
       | _ ->
 	  let name = get_id name in
-	  let decl = (Name name, None, ty) in
+	  let decl = LocalAssum (Name name, ty) in
 	  let ctx = decl :: ctx in
 	  let c' = mkApp (lift 1 c, [|mkRel 1|]) in
 	  let args = arg :: args in
@@ -3331,7 +3654,7 @@ let abstract_args gl generalize_vars dep id defined f args =
 	      true, mkApp (f', before), after
   in
     if dogen then
-      let tyf' = pf_unsafe_type_of gl f' in
+      let tyf' = Tacmach.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
@@ -3343,23 +3666,25 @@ let abstract_args gl generalize_vars dep id defined f args =
 	else []
       in
       let body, c' =
-	if defined then Some c', typ_of ctxenv !sigma c'
+	if defined then Some c', Retyping.get_type_of ctxenv !sigma c'
 	else None, c'
       in
-      let term = make_abstract_generalize {gl with sigma = !sigma} id concl dep ctx body c' eqs args refls in
-	Some (term, !sigma, dep, succ (List.length ctx), vars)
+      let typ = Tacmach.pf_get_hyp_typ gl id 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)
     else None
 
 let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
-  Proofview.Goal.nf_enter begin fun gl ->
+  let open Context.Named.Declaration in
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   Coqlib.check_required_library Coqlib.jmeq_module_name;
   let (f, args, def, id, oldid) =
     let oldid = Tacmach.New.pf_get_new_id id gl in
-    let (_, b, t) = Tacmach.New.pf_get_hyp id gl in
-      match b with
-      | None -> let f, args = decompose_app t in
+      match Tacmach.New.pf_get_hyp id gl with
+      | LocalAssum (_,t) -> let f, args = decompose_app t in
 	        (f, args, false, id, oldid)
-      | Some t ->
+      | LocalDef (_,t,_) ->
 	  let f, args = decompose_app t in
 	  (f, args, true, id, oldid)
   in
@@ -3369,35 +3694,34 @@ let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
     let newc = Tacmach.New.of_old (fun gl -> abstract_args gl generalize_vars force_dep id def f args) gl in
       match newc with
       | None -> Proofview.tclUNIT ()
-      | Some (newc, sigma, dep, n, vars) ->
+      | Some (tac, dep, n, vars) ->
 	  let tac =
 	    if dep then
-	      Tacticals.New.tclTHENLIST
-		[Proofview.Unsafe.tclEVARS sigma;
-		 Proofview.V82.tactic (refine newc);
+              Tacticals.New.tclTHENLIST [
+                tac;
 		 rename_hyp [(id, oldid)]; Tacticals.New.tclDO n intro;
-		 Proofview.V82.tactic (generalize_dep ~with_let:true (mkVar oldid))]
-	    else Tacticals.New.tclTHENLIST
-		   [Proofview.Unsafe.tclEVARS sigma;
-		    Proofview.V82.tactic (refine newc);
-		    Proofview.V82.tactic (clear [id]);
+		 generalize_dep ~with_let:true (mkVar oldid)]
+            else Tacticals.New.tclTHENLIST [
+                    tac;
+		    clear [id];
 		    Tacticals.New.tclDO n intro]
 	  in
 	    if List.is_empty vars then tac
 	    else Tacticals.New.tclTHEN tac
               (Tacticals.New.tclFIRST
                 [revert vars ;
-		 Proofview.V82.tactic (fun gl -> tclMAP (fun id ->
-		      tclTRY (generalize_dep ~with_let:true (mkVar id))) vars gl)])
-  end
+		 Tacticals.New.tclMAP (fun id ->
+		      Tacticals.New.tclTRY (generalize_dep ~with_let:true (mkVar id))) vars])
+  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 specialize_eqs id gl =
-  let env = pf_env gl in
-  let ty = pf_get_hyp_typ gl id in
+  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
   let unif env evars c1 c2 =
     compare_upto_variables c1 c2 && Evarconv.e_conv env evars c1 c2
@@ -3424,15 +3748,14 @@ let specialize_eqs id gl =
 	    if in_eqs then acc, in_eqs, ctx, ty
 	    else
 	      let e = e_new_evar (push_rel_context ctx env) evars t in
-		aux false ((na, Some e, t) :: ctx) (mkApp (lift 1 acc, [| mkRel 1 |])) b)
+		aux false (LocalDef (na,e,t) :: ctx) (mkApp (lift 1 acc, [| mkRel 1 |])) b)
     | t -> acc, in_eqs, ctx, ty
   in
   let acc, worked, ctx, ty = aux false [] (mkVar id) ty in
   let ctx' = nf_rel_context_evar !evars ctx in
-  let ctx'' = List.map (fun (n,b,t as decl) ->
-    match b with
-    | Some k when isEvar k -> (n,None,t)
-    | b -> decl) ctx'
+  let ctx'' = List.map (function
+    | LocalDef (n,k,t) when isEvar k -> LocalAssum (n,t)
+    | decl -> decl) ctx'
   in
   let ty' = it_mkProd_or_LetIn ty ctx'' in
   let acc' = it_mkLambda_or_LetIn acc ctx'' in
@@ -3441,17 +3764,16 @@ let specialize_eqs id gl =
   let ty' = Evarutil.nf_evar !evars ty' in
     if worked then
       tclTHENFIRST (Tacmach.internal_cut true id ty')
-	(exact_no_check ((* refresh_universes_strict *) acc')) gl
+	(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
 
 
-let specialize_eqs id gl =
-  if
-    (try ignore(clear [id] gl); false
-     with e when Errors.noncritical e -> true)
-  then
-    tclFAIL 0 (str "Specialization not allowed on dependent hypotheses") gl
-  else specialize_eqs id gl
+let specialize_eqs id = Proofview.Goal.nf_enter { 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 }
 
 let occur_rel n c =
   let res = not (noccurn n c) in
@@ -3466,18 +3788,19 @@ let occur_rel n c =
    We also return the conclusion.
 *)
 let decompose_paramspred_branch_args elimt =
-  let rec cut_noccur elimt acc2 : rel_context * rel_context * types =
+  let open Context.Rel.Declaration in
+  let rec cut_noccur elimt acc2 =
     match kind_of_term 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
-	  then cut_noccur elimt' ((nme,None,tpe)::acc2)
+	  then cut_noccur elimt' (LocalAssum (nme,tpe)::acc2)
 	  else let acc3,ccl = decompose_prod_assum elimt in acc2 , acc3 , ccl
       | App(_, _) | Rel _ -> acc2 , [] , elimt
       | _ -> error_ind_scheme "" in
-  let rec cut_occur elimt acc1 : rel_context * rel_context * rel_context * types =
+  let rec cut_occur elimt acc1 =
     match kind_of_term elimt with
-      | Prod(nme,tpe,c) when occur_rel 1 c -> cut_occur c ((nme,None,tpe)::acc1)
+      | Prod(nme,tpe,c) when occur_rel 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
@@ -3519,6 +3842,7 @@ let exchange_hd_app subst_hd t =
 
    - finish to fill in the elim_scheme: indarg/farg/args and finally indref. *)
 let compute_elim_sig ?elimc elimt =
+  let open Context.Rel.Declaration in
   let params_preds,branches,args_indargs,conclusion =
     decompose_paramspred_branch_args elimt in
 
@@ -3552,8 +3876,8 @@ let compute_elim_sig ?elimc elimt =
     (* 3- Look at last arg: is it the indarg? *)
     ignore (
       match List.hd args_indargs with
-	| hiname,Some _,hi -> error_ind_scheme ""
-	| hiname,None,hi ->
+	| LocalDef (hiname,_,hi) -> error_ind_scheme ""
+	| LocalAssum (hiname,hi) ->
 	    let hi_ind, hi_args = decompose_app hi in
 	    let hi_is_ind = (* hi est d'un type globalisable *)
 	      match kind_of_term hi_ind with
@@ -3577,24 +3901,25 @@ let compute_elim_sig ?elimc elimt =
   with Exit -> (* Ending by computing indref: *)
     match !res.indarg with
       | None -> !res (* No indref *)
-      | Some ( _,Some _,_) -> error_ind_scheme ""
-      | Some ( _,None,ind) ->
+      | Some (LocalDef _) -> error_ind_scheme ""
+      | Some (LocalAssum (_,ind)) ->
 	  let indhd,indargs = decompose_app ind in
 	  try {!res with indref = Some (global_of_constr indhd) }
-	  with e when Errors.noncritical e ->
+	  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 open Context.Rel.Declaration in
   let f,l = decompose_app scheme.concl in
   (* Vérifier que les arguments de Qi sont bien les xi. *)
   let cond, check_concl =
     match scheme.indarg with
-      | Some (_,Some _,_) ->
+      | 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
 	  in (cond, fun _ _ -> ())
-      | Some ( _,None,ind) -> (* Standard scheme from an inductive type *)
+      | 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 check_concl is_pred p =
@@ -3603,7 +3928,7 @@ let compute_scheme_signature scheme names_info ind_type_guess =
 	    let ind_is_ok =
 	      List.equal Term.eq_constr
 		(List.lastn scheme.nargs indargs)
-		(extended_rel_list 0 scheme.args) in
+		(Context.Rel.to_extended_list 0 scheme.args) in
 	    if not (ccl_arg_ok && ind_is_ok) then
 	      error_ind_scheme "the conclusion of"
 	  in (cond, check_concl)
@@ -3618,28 +3943,28 @@ let compute_scheme_signature scheme names_info ind_type_guess =
   let rec check_branch p c =
     match kind_of_term c with
       | Prod (_,t,c) ->
-	(is_pred p t, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(is_pred p t, true, dependent (mkRel 1) c) :: check_branch (p+1) c
       | LetIn (_,_,_,c) ->
-	(OtherArg, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(OtherArg, false, dependent (mkRel 1) c) :: check_branch (p+1) c
       | _ when is_pred p c == IndArg -> []
       | _ -> raise Exit
   in
   let rec find_branches p lbrch =
     match lbrch with
-      | (_,None,t)::brs ->
+      | LocalAssum (_,t) :: brs ->
 	(try
 	   let lchck_brch = check_branch p t in
 	   let n = List.fold_left
-	     (fun n (b,_) -> if b == RecArg then n+1 else n) 0 lchck_brch in
+	     (fun n (b,_,_) -> if b == RecArg then n+1 else n) 0 lchck_brch in
 	   let recvarname, hyprecname, avoid =
 	     make_up_names n scheme.indref names_info in
 	   let namesign =
-	     List.map (fun (b,dep) ->
-	       (b, dep, if b == IndArg then hyprecname else recvarname))
+	     List.map (fun (b,is_assum,dep) ->
+	       (b,is_assum,dep,if b == IndArg then hyprecname else recvarname))
 	       lchck_brch in
 	   (avoid,namesign) :: find_branches (p+1) brs
 	 with Exit-> error_ind_scheme "the branches of")
-      | (_,Some _,_)::_ -> error_ind_scheme "the branches of"
+      | LocalDef _ :: _ -> error_ind_scheme "the branches of"
       | [] -> check_concl is_pred p; []
   in
   Array.of_list (find_branches 0 (List.rev scheme.branches))
@@ -3661,21 +3986,26 @@ let guess_elim isrec dep s hyp0 gl =
   let evd, elimc =
     if isrec && not (is_nonrec (fst mind)) then find_ind_eliminator (fst 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
-	Tacmach.New.pf_apply build_case_analysis_scheme gl mind true s
+        let Sigma (ind, sigma, _) = build_case_analysis_scheme env sigma mind true s in
+        (Sigma.to_evar_map sigma, ind)
       else
-	Tacmach.New.pf_apply build_case_analysis_scheme_default gl mind s in
+        let Sigma (ind, sigma, _) = build_case_analysis_scheme_default env sigma mind s in
+        (Sigma.to_evar_map sigma, ind)
+  in
   let elimt = Tacmach.New.pf_unsafe_type_of gl elimc in
     evd, ((elimc, NoBindings), elimt), mkIndU mind
 
 let given_elim hyp0 (elimc,lbind as e) gl =
   let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 gl in
   let ind_type_guess,_ = decompose_app ((strip_prod tmptyp0)) in
-  Proofview.Goal.sigma gl, (e, Tacmach.New.pf_unsafe_type_of gl elimc), ind_type_guess
+  Tacmach.New.project gl, (e, Tacmach.New.pf_unsafe_type_of gl elimc), ind_type_guess
 
 type scheme_signature =
-    (Id.t list * (elim_arg_kind * bool * Id.t) list) array
+    (Id.t list * (elim_arg_kind * bool * bool * Id.t) list) array
 
 type eliminator_source =
   | ElimUsing of (eliminator * types) * scheme_signature
@@ -3715,13 +4045,15 @@ let is_functional_induction elimc gl =
 (* Wait the last moment to guess the eliminator so as to know if we
    need a dependent one or not *)
 
-let get_eliminator elim dep s gl = match elim with
+let get_eliminator elim dep s gl =
+  let open Context.Rel.Declaration in
+  match elim with
   | ElimUsing (elim,indsign) ->
-      Proofview.Goal.sigma gl, (* bugged, should be computed *) true, 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 (_,b,c) -> assert (b=None); pi1 (decompose_prod_letin c)) (List.rev s.branches) in
+      let branchlengthes = List.map (fun d -> assert (is_local_assum d); pi1 (decompose_prod_letin (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
@@ -3740,10 +4072,10 @@ let recolle_clenv i params args elimclause gl =
   let k = match i with -1 -> Array.length lindmv - List.length args | _ -> i in
   (* parameters correspond to first elts of lid. *)
   let clauses_params =
-    List.map_i (fun i id -> mkVar id , pf_get_hyp_typ gl id , lindmv.(i))
+    List.map_i (fun i id -> mkVar id , pf_get_hyp_typ id gl, lindmv.(i))
       0 params in
   let clauses_args =
-    List.map_i (fun i id -> mkVar id , pf_get_hyp_typ gl id , lindmv.(k+i))
+    List.map_i (fun i id -> mkVar id , pf_get_hyp_typ id gl, lindmv.(k+i))
       0 args in
   let clauses = clauses_params@clauses_args in
   (* iteration of clenv_fchain with all infos we have. *)
@@ -3753,7 +4085,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  = mk_clenv_from_n gl (Some 0) (x,y) in
+      let indclause  = Tacmach.New.of_old (fun gl -> mk_clenv_from_n gl (Some 0) (x,y)) gl in
       let elimclause' = clenv_fchain ~with_univs:false i acc indclause in
       elimclause')
     (List.rev clauses)
@@ -3763,59 +4095,69 @@ let recolle_clenv i params args elimclause gl =
    (elimc ?i ?j ?k...?l). This solves partly meta variables (and may
     produce new ones). Then refine with the resulting term with holes.
 *)
-let induction_tac with_evars params indvars elim gl =
+let induction_tac with_evars params indvars elim =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   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
   (* elimclause contains this: (elimc ?i ?j ?k...?l) *)
   let elimc = contract_letin_in_lam_header elimc in
   let elimc = mkCast (elimc, DEFAULTcast, elimt) in
-  let elimclause =
-    pf_apply make_clenv_binding gl (elimc,elimt) lbindelimc in
+  let elimclause = 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 = clenv_unique_resolver ~flags:(elim_flags ()) elimclause' gl in
-  Proofview.V82.of_tactic (enforce_prop_bound_names rename (Clenvtac.clenv_refine with_evars resolved)) gl
+  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 }
 
 (* 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 hyp0 inhyps elim indvars names induct_tac =
-  Proofview.Goal.enter begin fun gl ->
-    let env = Proofview.Goal.env gl in
+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 ->
     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 = cook_sign hyp0 inhyps indvars env in
-    let dep = dep || Option.cata (fun id -> occur_var env id concl) false hyp0 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 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 (id,b,_) -> if Option.is_empty b then (mkVar id)::a else a) [] deps in
+        (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
-    let names = compute_induction_names (Array.length indsign) names 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
+    let tac =
     (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
       (Tacticals.New.tclTHENLIST [
-        Proofview.Unsafe.tclEVARS sigma;
         (* Generalize dependent hyps (but not args) *)
-        if deps = [] then Proofview.tclUNIT () else Proofview.V82.tactic (apply_type tmpcl deps_cstr);
+        if deps = [] then Proofview.tclUNIT () else apply_type tmpcl deps_cstr;
         (* side-conditions in elim (resp case) schemes come last (resp first) *)
         induct_tac elim;
-        Proofview.V82.tactic (tclMAP expand_hyp toclear)
+        Tacticals.New.tclMAP expand_hyp toclear;
       ])
       (Array.map2
-         (induct_discharge lhyp0 avoid (re_intro_dependent_hypotheses statuslists))
+         (induct_discharge with_evars lhyp0 avoid
+            (re_intro_dependent_hypotheses statuslists))
          indsign names)
-  end
+    in
+    Sigma.Unsafe.of_pair (tac, sigma)
+  end }
 
 let induction_with_atomization_of_ind_arg isrec with_evars elim names hyp0 inhyps =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let elim_info = find_induction_type isrec elim hyp0 (Proofview.Goal.assume gl) in
   atomize_param_of_ind_then elim_info hyp0 (fun indvars ->
-    apply_induction_in_context (Some hyp0) inhyps (pi3 elim_info) indvars names
-      (fun elim -> Proofview.V82.tactic (induction_tac with_evars [] [hyp0] elim)))
-  end
+    apply_induction_in_context with_evars (Some hyp0) inhyps (pi3 elim_info) indvars names
+      (fun elim -> induction_tac with_evars [] [hyp0] elim))
+  end }
 
 let msg_not_right_number_induction_arguments scheme =
   str"Not the right number of induction arguments (expected " ++
@@ -3832,7 +4174,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 begin fun gl ->
+  Proofview.Goal.nf_enter { 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
@@ -3852,39 +4194,44 @@ let induction_without_atomization isrec with_evars elim names lid =
        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
-  let induct_tac elim = Proofview.V82.tactic (tclTHENLIST [
+  let induct_tac elim = Tacticals.New.tclTHENLIST [
     (* pattern to make the predicate appear. *)
     reduce (Pattern (List.map inj_with_occurrences lidcstr)) onConcl;
     (* Induction by "refine (indscheme ?i ?j ?k...)" + resolution of all
        possible holes using arguments given by the user (but the
        functional one). *)
     (* FIXME: Tester ca avec un principe dependant et non-dependant *)
-    induction_tac with_evars params realindvars elim
-  ]) in
+    induction_tac with_evars params realindvars elim;
+  ] in
   let elim = ElimUsing (({elimindex = Some (-1); elimbody = Option.get scheme.elimc; elimrename = None}, scheme.elimt), indsign) in
-  apply_induction_in_context None [] elim indvars names induct_tac
-  end
+  apply_induction_in_context with_evars None [] elim indvars names induct_tac
+  end }
 
 (* assume that no occurrences are selected *)
-let clear_unselected_context id inhyps cls gl =
-  if occur_var (pf_env gl) id (pf_concl gl) &&
+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) &&
     cls.concl_occs == NoOccurrences
   then errorlabstrm ""
     (str "Conclusion must be mentioned: it depends on " ++ pr_id id
      ++ str ".");
   match cls.onhyps with
   | Some hyps ->
-      let to_erase (id',_,_ as d) =
+      let to_erase d =
+        let id' = 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 (pf_env gl) id d in
+	  let test id = occur_var_in_decl (Tacmach.New.pf_env gl) id d in
 	  if List.exists test (id::inhyps) then Some id' else None in
-      let ids = List.map_filter to_erase (pf_hyps gl) in
-      thin ids gl
-  | None -> tclIDTAC gl
+      let ids = List.map_filter to_erase (Proofview.Goal.hyps gl) in
+      clear ids
+  | None -> Proofview.tclUNIT ()
+  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
@@ -3906,7 +4253,8 @@ let use_bindings env sigma elim must_be_closed (c,lbind) typ =
       if must_be_closed && occur_meta (clenv_value indclause) then
         error "Need a fully applied argument.";
       (* We lose the possibility of coercions in with-bindings *)
-      pose_all_metas_as_evars env indclause.evd (clenv_value indclause)
+      let (sigma, c) = pose_all_metas_as_evars env indclause.evd (clenv_value indclause) in
+      Sigma.Unsafe.of_pair (c, sigma)
     with e when catchable_exception e ->
     try find_clause (try_red_product env sigma typ)
     with Redelimination -> raise e in
@@ -3924,14 +4272,15 @@ let check_expected_type env sigma (elimc,bl) elimt =
   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_betadeltaiota env sigma u) in isInd t
+      let t,_ = decompose_app (whd_all env sigma u) in isInd t
   | Some elimc ->
-      let elimt = typ_of env sigma (fst elimc) in
+      let elimt = Retyping.get_type_of env sigma (fst elimc) in
       let scheme = compute_elim_sig ~elimc elimt in
       match scheme.indref with
       | None ->
@@ -3942,15 +4291,19 @@ let check_enough_applied env sigma elim =
           (* Last argument is supposed to be the induction argument *)
           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))
+
 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.enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
+  Proofview.Goal.s_enter { s_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 store = Proofview.Goal.extra gl in
   let check = check_enough_applied env sigma elim in
-  let (sigma',c) = use_bindings env sigma elim false (c0,lbind) t0 in
+  let Sigma (c, sigma', p) = 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
@@ -3960,7 +4313,8 @@ let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
       (* 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) = finish_evar_resolution ~flags env sigma (pending,c0) in
+      let Sigma (c0, sigma, q) = finish_evar_resolution ~flags env sigma (pending,c0) in
+      let tac =
       (if isrec then
           (* Historically, induction has side conditions last *)
           Tacticals.New.tclTHENFIRST
@@ -3968,32 +4322,38 @@ 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 [
-        Proofview.Unsafe.tclEVARS sigma;
-        Proofview.Refine.refine ~unsafe:true (fun sigma ->
+        Refine.refine ~unsafe:true { run = begin fun sigma ->
           let b = not with_evars && with_eq != None in
-          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));
-        Proofview.(if with_evars then shelve_unifiable else guard_no_unifiable);
+          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 };
+        if with_evars then Proofview.shelve_unifiable else guard_no_unifiable;
         if is_arg_pure_hyp
-        then Tacticals.New.tclTRY (Proofview.V82.tactic (thin [destVar c0]))
+        then Tacticals.New.tclTRY (clear [destVar c0])
         else Proofview.tclUNIT ();
         if isrec then Proofview.cycle (-1) else Proofview.tclUNIT ()
       ])
       tac
+      in
+      Sigma (tac, sigma, q)
 
-  | Some (sigma',c) ->
+  | Some (Sigma (c, sigma', q)) ->
       (* 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 tac =
       Tacticals.New.tclTHENLIST [
-        Proofview.Unsafe.tclEVARS sigma';
-        Proofview.Refine.refine ~unsafe:true (fun sigma ->
-          mkletin_goal env sigma store with_eq true (id,lastlhyp,ccl,c) None);
+        Refine.refine ~unsafe:true { run = begin fun sigma ->
+          mkletin_goal env sigma store with_eq true (id,lastlhyp,ccl,c) None
+        end };
         tac
       ]
-  end
+      in
+      Sigma (tac, sigma', p +> q)
+  end }
 
 let has_generic_occurrences_but_goal cls id env ccl =
   clause_with_generic_context_selection cls &&
@@ -4005,14 +4365,14 @@ let induction_gen clear_flag isrec with_evars elim
   let inhyps = match cls with
   | Some {onhyps=Some hyps} -> List.map (fun ((_,id),_) -> id) hyps
   | _ -> [] in
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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 cls = Option.default allHypsAndConcl cls in
   let t = typ_of env sigma c in
   let is_arg_pure_hyp =
-    isVar c && not (mem_named_context (destVar c) (Global.named_context()))
+    isVar c && not (mem_named_context_val (destVar 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
@@ -4025,7 +4385,7 @@ let induction_gen clear_flag isrec with_evars elim
        and w/o equality kept: no need to generalize *)
     let id = destVar c in
     Tacticals.New.tclTHEN
-      (Proofview.V82.tactic (clear_unselected_context id inhyps cls))
+      (clear_unselected_context id inhyps cls)
       (induction_with_atomization_of_ind_arg
          isrec with_evars elim names id inhyps)
   else
@@ -4040,7 +4400,7 @@ let induction_gen clear_flag isrec with_evars elim
       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
+  end }
 
 (* Induction on a list of arguments. First make induction arguments
    atomic (using letins), then do induction. The specificity here is
@@ -4059,13 +4419,13 @@ let induction_gen_l isrec with_evars elim names lc =
       | [] -> Proofview.tclUNIT ()
       | c::l' ->
 	  match kind_of_term c with
-	    | Var id when not (mem_named_context id (Global.named_context()))
+	    | 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 begin fun gl ->
+                Proofview.Goal.enter { enter = begin fun gl ->
                 let type_of = Tacmach.New.pf_unsafe_type_of gl in
                 let x =
 		  id_of_name_using_hdchar (Global.env()) (type_of c) Anonymous in
@@ -4076,7 +4436,7 @@ let induction_gen_l isrec with_evars elim names lc =
 		Tacticals.New.tclTHEN
 		  (letin_tac None (Name id) c None allHypsAndConcl)
 		  (atomize_list newl')
-                end in
+                end } in
   Tacticals.New.tclTHENLIST
     [
       (atomize_list lc);
@@ -4093,33 +4453,28 @@ 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 begin fun gl ->
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     match elim with
     | Some elim when is_functional_induction elim gl ->
       (* Standard induction on non-standard induction schemes *)
       (* will be removable when is_functional_induction will be more clever *)
       if not (Option.is_empty cls) then error "'in' clause not supported here.";
-      let finish_evar_resolution f =
-        let (sigma',(c,lbind)) = f env sigma in
-        let pending = (sigma,sigma') in
-        snd (finish_evar_resolution env sigma' (pending,c)),lbind in
-      let c = map_induction_arg finish_evar_resolution c in
+      let _,c = force_destruction_arg false env sigma c in
       onInductionArg
-	(fun _clear_flag (c,lbind) ->
-	  if lbind != NoBindings then
-	    error "'with' clause not supported here.";
-	  induction_gen_l isrec with_evars elim names [c,eqname]) c
+	(fun _clear_flag c ->
+	  induction_gen_l isrec with_evars elim names
+            [with_no_bindings c,eqname]) c
     | _ ->
       (* 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 begin fun gl ->
+    Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
+    let sigma = Tacmach.New.project gl in
     match elim with
     | None ->
       (* Several arguments, without "using" clause *)
@@ -4133,28 +4488,22 @@ 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 begin fun gl ->
+          Proofview.Goal.enter { enter = begin fun gl ->
           let env = Proofview.Goal.env gl in
-          let sigma = Proofview.Goal.sigma 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 finish_evar_resolution f =
-        let (sigma',(c,lbind)) = f env sigma in
-        let pending = (sigma,sigma') in
-	if lbind != NoBindings then
-	  error "'with' clause not supported here.";
-        snd (finish_evar_resolution env sigma' (pending,c)) in
-      let lc = List.map (on_pi1 (map_induction_arg finish_evar_resolution)) lc in
+      let lc = List.map (on_pi1 (fun c -> snd (force_destruction_arg false env sigma c))) lc in
       let newlc =
         List.map (fun (x,(eqn,names),cls) ->
           if cls != None then error "'in' clause not yet supported here.";
 	  match x with (* FIXME: should we deal with ElimOnIdent? *)
           | _clear_flag,ElimOnConstr x ->
               if eqn <> None then error "'eqn' clause not supported here.";
-              (x,names)
+              (with_no_bindings x,names)
 	  | _ -> error "Don't know where to find some argument.")
 	  lc in
       (* Check that "as", if any, is given only on the last argument *)
@@ -4163,7 +4512,7 @@ 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 
@@ -4205,7 +4554,7 @@ let simple_destruct = function
  *)
 
 let elim_scheme_type elim t =
-  Proofview.Goal.nf_enter begin fun gl ->
+  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
     | Meta mv ->
@@ -4215,23 +4564,24 @@ let elim_scheme_type elim 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
+  end }
 
 let elim_type t =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.s_enter { s_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
-  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
-  end
+  Sigma.Unsafe.of_pair (elim_scheme_type elimc t, evd)
+  end }
 
 let case_type t =
-  Proofview.Goal.enter begin fun gl ->
-  let (ind,t) = Tacmach.New.pf_apply reduce_to_atomic_ind gl t in
-  let evd, elimc =
-    Tacmach.New.pf_apply build_case_analysis_scheme_default gl ind (Tacticals.New.elimination_sort_of_goal gl)
-  in
-  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
-  end
+  Proofview.Goal.s_enter { s_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 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 }
 
 
 (************************************************)
@@ -4244,14 +4594,14 @@ let (forward_setoid_reflexivity, setoid_reflexivity) = Hook.make ()
 
 let maybe_betadeltaiota_concl allowred gl =
   let concl = Tacmach.New.pf_nf_concl gl in
-  let sigma = Proofview.Goal.sigma gl in
+  let sigma = Tacmach.New.project gl in
   if not allowred then concl
   else
     let env = Proofview.Goal.env gl in
-    whd_betadeltaiota env sigma concl
+    whd_all env sigma concl
 
 let reflexivity_red allowred =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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). *)
@@ -4259,7 +4609,7 @@ let reflexivity_red allowred =
     match match_with_equality_type concl with
     | None -> Proofview.tclZERO NoEquationFound
     | Some _ -> one_constructor 1 NoBindings
-  end
+  end }
 
 let reflexivity =
   Proofview.tclORELSE
@@ -4301,7 +4651,7 @@ let match_with_equation c =
     Proofview.tclZERO NoEquationFound
 
 let symmetry_red allowred =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { 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). *)
@@ -4313,7 +4663,7 @@ let symmetry_red allowred =
         (convert_concl_no_check concl DEFAULTcast)
         (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
@@ -4327,7 +4677,7 @@ let (forward_setoid_symmetry_in, setoid_symmetry_in) = Hook.make ()
 
 
 let symmetry_in id =
-  Proofview.Goal.enter begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let ctype = Tacmach.New.pf_unsafe_type_of gl (mkVar id) in
   let sign,t = decompose_prod_assum ctype in
   Proofview.tclORELSE
@@ -4345,7 +4695,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
@@ -4370,7 +4720,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 begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let (eq1,eq2) = match eq_kind with
   | MonomorphicLeibnizEq (c1,c2) ->
       mkApp (hdcncl, [| c1; t|]), mkApp (hdcncl, [| t; c2 |])
@@ -4378,7 +4728,7 @@ let prove_transitivity hdcncl eq_kind t =
       mkApp (hdcncl, [| typ; c1; t |]), mkApp (hdcncl, [| typ; t; c2 |])
   | HeterogenousEq (typ1,c1,typ2,c2) ->
       let env = Proofview.Goal.env gl in
-      let sigma = Proofview.Goal.sigma gl in
+      let sigma = Tacmach.New.project gl in
       let type_of = Typing.unsafe_type_of env sigma in
       let typt = type_of t in
         (mkApp(hdcncl, [| typ1; c1; typt ;t |]),
@@ -4390,10 +4740,10 @@ 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 begin fun gl ->
+  Proofview.Goal.enter { 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). *)
@@ -4410,7 +4760,7 @@ let transitivity_red allowred t =
       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
@@ -4430,28 +4780,80 @@ 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 = match d2,d1 with
-  | (_,Some _,_), (_,None,_) -> false
-  | (_,Some b1,t1), (_,Some b2,t2) -> 
+let interpretable_as_section_decl evd d1 d2 =
+  let open Context.Named.Declaration 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
-  | (_,None,t1), (_,_,t2) -> e_eq_constr_univs evd t1 t2
+  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (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 
+  | Lambda (na, u, c), Prod (_, _, t) ->
+    decompose (pred len) c t (LocalAssum (na, u) :: accu)
+  | LetIn (na, b, u, c), LetIn (_, _, _, t) ->
+    decompose (pred len) c t (LocalDef (na, b, u) :: accu)
+  | _ -> assert false
+
+let rec shrink ctx sign c t accu =
+  let open Context.Rel.Declaration in
+  match ctx, sign with
+  | [], [] -> (c, t, accu)
+  | p :: ctx, decl :: sign ->
+      if noccurn 1 c && noccurn 1 t then
+        let c = subst1 mkProp c in
+        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
+    in
+    shrink ctx sign c t accu
+| _ -> assert false
+
+let shrink_entry sign const =
+  let open Entries in
+  let typ = match const.const_entry_type with
+  | None -> assert false
+  | Some t -> t
+  in
+  (** The body has been forced by the call to [build_constant_by_tactic] *)
+  let () = assert (Future.is_over const.const_entry_body) in
+  let ((body, uctx), eff) = Future.force const.const_entry_body in
+  let (body, typ, ctx) = decompose (List.length sign) body typ [] in
+  let (body, typ, args) = shrink ctx sign body typ [] in
+  let const = { const with
+    const_entry_body = Future.from_val ((body, uctx), eff);
+    const_entry_type = Some typ;
+  } in
+  (const, args)
 
 let abstract_subproof id gk tac =
   let open Tacticals.New in
   let open Tacmach.New in
   let open Proofview.Notations in
-  Proofview.Goal.nf_enter begin fun gl ->
-  let current_sign = Global.named_context()
+  let open Context.Named.Declaration in
+  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  let sigma = Proofview.Goal.sigma gl in
+  let current_sign = Global.named_context_val ()
   and global_sign = Proofview.Goal.hyps gl in
-  let evdref = ref (Proofview.Goal.sigma gl) in
+  let sigma = Sigma.to_evar_map sigma in
+  let evdref = ref sigma in
   let sign,secsign =
     List.fold_right
-      (fun (id,_,_ as d) (s1,s2) ->
-	if mem_named_context id current_sign &&
-          interpretable_as_section_decl evdref (Context.lookup_named id current_sign) d
+      (fun d (s1,s2) ->
+        let id = get_id d in
+	if mem_named_context_val id current_sign &&
+          interpretable_as_section_decl evdref (lookup_named_val id current_sign) d
         then (s1,push_named_context_val d s2)
-	else (add_named_decl d s1,s2))
-      global_sign (empty_named_context,empty_named_context_val) in
+	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 concl =
@@ -4474,13 +4876,22 @@ let abstract_subproof id gk tac =
        which is an error irrelevant to the proof system (in fact it
        means that [e] comes from [tac] failing to yield enough
        success). Hence it reraises [e]. *)
-    let (_, info) = Errors.push src in
+    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
-  (** ppedrot: seems legit to have abstracted subproofs as local*)
-  let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl in
+  let cst () =
+    (** do not compute the implicit arguments, it may be costly *)
+    let () = Impargs.make_implicit_args false in
+    (** ppedrot: seems legit to have abstracted subproofs as local*)
+    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 evd = Evd.set_universe_context evd ectx in
@@ -4488,14 +4899,13 @@ let abstract_subproof id gk tac =
   let eff = private_con_of_con (Global.safe_env ()) cst in
   let effs = add_private eff
     Entries.(snd (Future.force const.const_entry_body)) in
-  let args = List.rev (instance_from_named_context sign) in
   let solve =
-    Proofview.Unsafe.tclEVARS evd <*>
     Proofview.tclEFFECTS effs <*>
-    new_exact_no_check (applist (lem, args))
+    exact_no_check (applist (lem, args))
   in
-  if not safe then Proofview.mark_as_unsafe <*> solve else solve
-  end
+  let tac = if not safe then Proofview.mark_as_unsafe <*> solve else solve in
+  Sigma.Unsafe.of_pair (tac, evd)
+  end }
 
 let anon_id = Id.of_string "anonymous"
 
@@ -4515,7 +4925,8 @@ let tclABSTRACT name_op tac =
   abstract_subproof s gk tac
 
 let unify ?(state=full_transparent_state) x y =
-  Proofview.Goal.nf_enter begin fun gl ->
+  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  let sigma = Proofview.Goal.sigma gl in
   try
     let core_flags =
       { (default_unify_flags ()).core_unify_flags with
@@ -4527,22 +4938,18 @@ 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 evd = w_unify (Tacmach.New.pf_env gl) (Proofview.Goal.sigma gl) Reduction.CONV ~flags x y
-    in Proofview.Unsafe.tclEVARS evd
-  with e when Errors.noncritical e -> Tacticals.New.tclFAIL 0 (str"Not unifiable")
-  end
+    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)
+  with e when CErrors.noncritical e ->
+    Sigma.here (Tacticals.New.tclFAIL 0 (str"Not unifiable")) sigma
+  end }
 
 module Simple = struct
   (** Simplified version of some of the above tactics *)
 
   let intro x = intro_move (Some x) MoveLast
 
-  let generalize_gen cl =
-    generalize_gen (List.map (on_fst Redexpr.out_with_occurrences) cl)
-  let generalize cl =
-    generalize_gen (List.map (fun c -> ((AllOccurrences,c),Names.Anonymous))
-                        cl)
-
   let apply c =
     apply_with_bindings_gen false false [None,(Loc.ghost,(c,NoBindings))]
   let eapply c =
@@ -4560,17 +4967,24 @@ end
 module New = struct
   open Proofview.Notations
 
-  let exact_proof c = Proofview.V82.tactic (exact_proof c)
+  let exact_proof c = exact_proof c
 
   open Genredexpr
   open Locus
 
   let reduce_after_refine =
-    Proofview.V82.tactic (reduce
-      (Lazy {rBeta=true;rIota=true;rZeta=false;rDelta=false;rConst=[]})
-      {onhyps=None; concl_occs=AllOccurrences })
+    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 }
 
   let refine ?unsafe c =
-    Proofview.Refine.refine ?unsafe c <*>
+    Refine.refine ?unsafe c <*>
     reduce_after_refine
 end
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index c28cb521..fb033363 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -9,7 +9,6 @@
 open Loc
 open Names
 open Term
-open Context
 open Environ
 open Proof_type
 open Evd
@@ -22,26 +21,27 @@ open Unification
 open Misctypes
 open Locus
 
-(** Main tactics. *)
+(** 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
+    implementation features various styles and stages of the proof engine.
+    This has to be uniformized someday. *)
 
 (** {6 General functions. } *)
 
-val is_quantified_hypothesis : Id.t -> goal sigma -> bool
+val is_quantified_hypothesis : Id.t -> ([`NF],'b) Proofview.Goal.t -> bool
 
 (** {6 Primitive tactics. } *)
 
 val introduction    : ?check:bool -> Id.t -> unit Proofview.tactic
-val refine          : constr -> tactic
 val convert_concl   : ?check:bool -> types -> cast_kind -> unit Proofview.tactic
-val convert_hyp     : ?check:bool -> named_declaration -> unit Proofview.tactic
+val convert_hyp     : ?check:bool -> Context.Named.Declaration.t -> unit Proofview.tactic
 val convert_concl_no_check : types -> cast_kind -> unit Proofview.tactic
-val convert_hyp_no_check : named_declaration -> unit Proofview.tactic
-val thin            : Id.t list -> tactic
+val convert_hyp_no_check : Context.Named.Declaration.t -> unit Proofview.tactic
 val mutual_fix      :
-  Id.t -> int -> (Id.t * int * constr) list -> int -> tactic
-val fix             : Id.t option -> int -> tactic
-val mutual_cofix    : Id.t -> (Id.t * constr) list -> int -> tactic
-val cofix           : Id.t option -> tactic
+  Id.t -> int -> (Id.t * int * constr) list -> int -> unit Proofview.tactic
+val fix             : Id.t option -> int -> unit Proofview.tactic
+val mutual_cofix    : Id.t -> (Id.t * constr) list -> int -> unit Proofview.tactic
+val cofix           : Id.t option -> unit Proofview.tactic
 
 val convert         : constr -> constr -> unit Proofview.tactic
 val convert_leq     : constr -> constr -> unit Proofview.tactic
@@ -50,7 +50,7 @@ val convert_leq     : constr -> constr -> unit Proofview.tactic
 
 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 : rel_context -> goal sigma -> Id.t list
+val find_intro_names : Context.Rel.t -> goal sigma -> Id.t list
 
 val intro                : unit Proofview.tactic
 val introf               : unit Proofview.tactic
@@ -74,7 +74,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 -> goal sigma -> int
+  bool -> quantified_hypothesis -> ([`NF],'b) Proofview.Goal.t -> int
 
 val intros_until         : quantified_hypothesis -> unit Proofview.tactic
 
@@ -94,7 +94,11 @@ val try_intros_until :
 
 val onInductionArg :
   (clear_flag -> constr with_bindings -> unit Proofview.tactic) ->
-    constr with_bindings induction_arg -> unit Proofview.tactic
+    constr with_bindings destruction_arg -> unit Proofview.tactic
+
+val force_destruction_arg : evars_flag -> env -> evar_map ->
+    delayed_open_constr_with_bindings destruction_arg ->
+    evar_map * constr with_bindings destruction_arg
 
 (** Tell if a used hypothesis should be cleared by default or not *)
 
@@ -102,85 +106,85 @@ val use_clear_hyp_by_default : unit -> bool
 
 (** {6 Introduction tactics with eliminations. } *)
 
-val intro_patterns : intro_patterns -> unit Proofview.tactic
-val intro_patterns_to : Id.t move_location -> intro_patterns ->
+val intro_patterns : evars_flag -> intro_patterns -> unit Proofview.tactic
+val intro_patterns_to : evars_flag -> Id.t move_location -> intro_patterns ->
   unit Proofview.tactic
-val intro_patterns_bound_to : int -> Id.t move_location -> intro_patterns ->
+val intro_patterns_bound_to : evars_flag -> int -> Id.t move_location -> intro_patterns ->
   unit Proofview.tactic
-val intro_pattern_to : Id.t move_location -> delayed_open_constr intro_pattern_expr ->
+val intro_pattern_to : evars_flag -> Id.t move_location -> delayed_open_constr intro_pattern_expr ->
   unit Proofview.tactic
 
 (** Implements user-level "intros", with [] standing for "**" *)
-val intros_patterns : intro_patterns -> unit Proofview.tactic
+val intros_patterns : evars_flag -> intro_patterns -> unit Proofview.tactic
 
 (** {6 Exact tactics. } *)
 
 val assumption       : unit Proofview.tactic
-val exact_no_check   : constr -> tactic
-val vm_cast_no_check : constr -> tactic
-val native_cast_no_check : constr -> tactic
+val exact_no_check   : constr -> unit Proofview.tactic
+val vm_cast_no_check : constr -> unit Proofview.tactic
+val native_cast_no_check : constr -> unit Proofview.tactic
 val exact_check      : constr -> unit Proofview.tactic
-val exact_proof      : Constrexpr.constr_expr -> tactic
+val exact_proof      : Constrexpr.constr_expr -> unit Proofview.tactic
 
 (** {6 Reduction tactics. } *)
 
 type tactic_reduction = env -> evar_map -> constr -> constr
 
-type change_arg = patvar_map -> evar_map -> evar_map * constr
+type change_arg = patvar_map -> constr Sigma.run
 
 val make_change_arg   : constr -> change_arg
-val reduct_in_hyp     : ?check:bool -> tactic_reduction -> hyp_location -> tactic
-val reduct_option     : ?check:bool -> tactic_reduction * cast_kind -> goal_location -> tactic
-val reduct_in_concl   : tactic_reduction * cast_kind -> tactic
+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 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 ->
                         hyp_location -> unit Proofview.tactic
-val red_in_concl      : tactic
-val red_in_hyp        : hyp_location -> tactic
-val red_option        : goal_location -> tactic
-val hnf_in_concl      : tactic
-val hnf_in_hyp        : hyp_location -> tactic
-val hnf_option        : goal_location -> tactic
-val simpl_in_concl    : tactic
-val simpl_in_hyp      : hyp_location -> tactic
-val simpl_option      : goal_location -> tactic
-val normalise_in_concl : tactic
-val normalise_in_hyp  : hyp_location -> tactic
-val normalise_option  : goal_location -> tactic
-val normalise_vm_in_concl : tactic
+val red_in_concl      : unit Proofview.tactic
+val red_in_hyp        : hyp_location -> unit Proofview.tactic
+val red_option        : goal_location -> unit Proofview.tactic
+val hnf_in_concl      : unit Proofview.tactic
+val hnf_in_hyp        : hyp_location -> unit Proofview.tactic
+val hnf_option        : goal_location -> unit Proofview.tactic
+val simpl_in_concl    : unit Proofview.tactic
+val simpl_in_hyp      : hyp_location -> unit Proofview.tactic
+val simpl_option      : goal_location -> unit Proofview.tactic
+val normalise_in_concl : unit Proofview.tactic
+val normalise_in_hyp  : hyp_location -> unit Proofview.tactic
+val normalise_option  : goal_location -> unit Proofview.tactic
+val normalise_vm_in_concl : unit Proofview.tactic
 val unfold_in_concl   :
-  (occurrences * evaluable_global_reference) list -> tactic
+  (occurrences * evaluable_global_reference) list -> unit Proofview.tactic
 val unfold_in_hyp     :
-  (occurrences * evaluable_global_reference) list -> hyp_location -> tactic
+  (occurrences * evaluable_global_reference) list -> hyp_location -> unit Proofview.tactic
 val unfold_option     :
-  (occurrences * evaluable_global_reference) list -> goal_location -> tactic
+  (occurrences * evaluable_global_reference) list -> goal_location -> unit Proofview.tactic
 val change            :
-  constr_pattern option -> change_arg -> clause -> tactic
+  constr_pattern option -> change_arg -> clause -> unit Proofview.tactic
 val pattern_option    :
-  (occurrences * constr) list -> goal_location -> tactic
-val reduce            : red_expr -> clause -> tactic
-val unfold_constr     : global_reference -> tactic
+  (occurrences * constr) list -> goal_location -> unit Proofview.tactic
+val reduce            : red_expr -> clause -> unit Proofview.tactic
+val unfold_constr     : global_reference -> unit Proofview.tactic
 
 (** {6 Modification of the local context. } *)
 
-val clear         : Id.t list -> tactic
+val clear         : Id.t list -> unit Proofview.tactic
 val clear_body    : Id.t list -> unit Proofview.tactic
-val unfold_body   : Id.t -> tactic
+val unfold_body   : Id.t -> unit Proofview.tactic
 val keep          : Id.t list -> unit Proofview.tactic
 val apply_clear_request : clear_flag -> bool -> constr -> unit Proofview.tactic
 
-val specialize    : constr with_bindings -> tactic
+val specialize    : constr with_bindings -> intro_pattern option -> unit Proofview.tactic
 
-val move_hyp      : Id.t -> Id.t move_location -> tactic
+val move_hyp      : Id.t -> Id.t move_location -> unit Proofview.tactic
 val rename_hyp    : (Id.t * Id.t) list -> unit Proofview.tactic
 
 val revert        : Id.t list -> unit Proofview.tactic
 
 (** {6 Resolution tactics. } *)
 
-val apply_type : constr -> constr list -> tactic
-val bring_hyps : named_context -> unit Proofview.tactic
+val apply_type : constr -> constr list -> unit Proofview.tactic
+val bring_hyps : Context.Named.t -> unit Proofview.tactic
 
 val apply                 : constr -> unit Proofview.tactic
 val eapply                : constr -> unit Proofview.tactic
@@ -206,6 +210,8 @@ val apply_delayed_in :
     (clear_flag * delayed_open_constr_with_bindings located) list ->
     intro_pattern option -> unit Proofview.tactic
 
+val run_delayed : Environ.env -> evar_map -> 'a delayed_open -> 'a * evar_map
+
 (** {6 Elimination tactics. } *)
 
 (*
@@ -237,20 +243,20 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: rel_context;     (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
-  nparams: int;            (** number of parameters *)
-  predicates: rel_context; (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
-  npredicates: int;        (** Number of predicates *)
-  branches: rel_context;   (** branchr,...,branch1 *)
-  nbranches: int;          (** Number of branches *)
-  args: rel_context;       (** (xni, Ti_ni) ... (x1, Ti_1) *)
-  nargs: int;              (** number of arguments *)
-  indarg: rel_declaration option; (** Some (H,I prm1..prmp x1...xni)
-				     if HI is in premisses, None otherwise *)
-  concl: types;            (** Qi x1...xni HI (f...), HI and (f...)
-			      are optional and mutually exclusive *)
-  indarg_in_concl: bool;   (** true if HI appears at the end of conclusion *)
-  farg_in_concl: bool;     (** true if (f...) appears at the end of conclusion *)
+  params: Context.Rel.t;      (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  nparams: int;               (** number of parameters *)
+  predicates: Context.Rel.t;  (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  npredicates: int;           (** Number of predicates *)
+  branches: Context.Rel.t;    (** branchr,...,branch1 *)
+  nbranches: int;             (** Number of branches *)
+  args: Context.Rel.t;        (** (xni, Ti_ni) ... (x1, Ti_1) *)
+  nargs: int;                 (** number of arguments *)
+  indarg: Context.Rel.Declaration.t 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 *)
+  indarg_in_concl: bool;      (** true if HI appears at the end of conclusion *)
+  farg_in_concl: bool;        (** true if (f...) appears at the end of conclusion *)
 }
 
 val compute_elim_sig : ?elimc: constr with_bindings -> types -> elim_scheme
@@ -293,7 +299,7 @@ val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option
 (** Implements user-level "destruct" and "induction" *)
 
 val induction_destruct : rec_flag -> evars_flag ->
-  (delayed_open_constr_with_bindings induction_arg
+  (delayed_open_constr_with_bindings destruction_arg
    * (intro_pattern_naming option * or_and_intro_pattern option)
    * clause option) list *
   constr with_bindings option -> unit Proofview.tactic
@@ -364,7 +370,7 @@ val pose_proof : Name.t -> constr ->
 
 (** Common entry point for user-level "assert", "enough" and "pose proof" *)
 
-val forward   : bool -> unit Proofview.tactic option ->
+val forward   : bool -> unit Proofview.tactic option option ->
   intro_pattern option -> constr -> unit Proofview.tactic
 
 (** Implements the tactic cut, actually a modus ponens rule *)
@@ -383,12 +389,12 @@ val letin_pat_tac : (bool * intro_pattern_naming) option ->
 
 (** {6 Generalize tactics. } *)
 
-val generalize      : constr list -> tactic
-val generalize_gen  : ((occurrences * constr) * Name.t) list -> tactic
-val new_generalize  : constr list -> unit Proofview.tactic
+val generalize      : constr list -> unit Proofview.tactic
+val generalize_gen  : (constr Locus.with_occurrences * Name.t) list -> unit Proofview.tactic
+
 val new_generalize_gen  : ((occurrences * constr) * Name.t) list -> unit Proofview.tactic
 
-val generalize_dep  : ?with_let:bool (** Don't lose let bindings *) -> constr  -> tactic
+val generalize_dep  : ?with_let:bool (** Don't lose let bindings *) -> constr  -> unit Proofview.tactic
 
 (** {6 Other tactics. } *)
 
@@ -397,7 +403,7 @@ val unify           : ?state:Names.transparent_state -> constr -> constr -> unit
 val tclABSTRACT : 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 -> tactic
+val specialize_eqs : Id.t -> unit Proofview.tactic
 
 val general_rewrite_clause :
   (bool -> evars_flag -> constr with_bindings -> clause -> unit Proofview.tactic) Hook.t
@@ -416,9 +422,6 @@ module Simple : sig
   (** Simplified version of some of the above tactics *)
 
   val intro           : Id.t -> unit Proofview.tactic
-  val generalize      : constr list -> tactic
-  val generalize_gen  : (constr Locus.with_occurrences * Name.t) list -> tactic
-
   val apply  : constr -> unit Proofview.tactic
   val eapply : constr -> unit Proofview.tactic
   val elim   : constr -> unit Proofview.tactic
@@ -431,13 +434,11 @@ end
 
 module New : sig
 
-  val refine : ?unsafe:bool -> (Evd.evar_map -> Evd.evar_map*constr) -> unit Proofview.tactic
-  (** [refine ?unsafe c] is [Proofview.Refine.refine ?unsafe c]
+  val refine : ?unsafe:bool -> constr Sigma.run -> unit Proofview.tactic
+  (** [refine ?unsafe c] is [Refine.refine ?unsafe c]
       followed by beta-iota-reduction of the conclusion. *)
 
   val reduce_after_refine : unit Proofview.tactic
   (** The reducing tactic called after {!refine}. *)
 
-  open Proofview
-  val exact_proof : Constrexpr.constr_expr -> unit tactic
 end
diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib
index 2c5edc20..09330260 100644
--- a/tactics/tactics.mllib
+++ b/tactics/tactics.mllib
@@ -1,5 +1,3 @@
-Ftactic
-Geninterp
 Dnet
 Dn
 Btermdn
@@ -14,15 +12,11 @@ Equality
 Contradiction
 Inv
 Leminv
-Tacsubst
-Taccoerce
-Tacenv
 Hints
 Auto
-Tacintern
+Eauto
+Class_tactics
 Tactic_matching
-Tacinterp
-Evar_tactics
 Term_dnet
+Eqdecide
 Autorewrite
-Tactic_option
diff --git a/tactics/tauto.ml4 b/tactics/tauto.ml4
deleted file mode 100644
index f41fac54..00000000
--- a/tactics/tauto.ml4
+++ /dev/null
@@ -1,398 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Term
-open Hipattern
-open Names
-open Pp
-open Genarg
-open Stdarg
-open Tacinterp
-open Tactics
-open Errors
-open Util
-
-DECLARE PLUGIN "tauto"
-
-let assoc_var s ist =
-  let v = Id.Map.find (Names.Id.of_string s) ist.lfun in
-  match Value.to_constr v with
-    | Some c -> c
-    | None -> failwith "tauto: anomaly"
-
-(** Parametrization of tauto *)
-
-type tauto_flags = {
-
-(* Whether conjunction and disjunction are restricted to binary connectives *)
-  binary_mode : bool;
-
-(* Whether compatibility for buggy detection of binary connective is on *)
-  binary_mode_bugged_detection : bool;
-
-(* Whether conjunction and disjunction are restricted to the connectives *)
-(* having the structure of "and" and "or" (up to the choice of sorts) in *)
-(* contravariant position in an hypothesis *)
-  strict_in_contravariant_hyp : bool;
-
-(* Whether conjunction and disjunction are restricted to the connectives *)
-(* having the structure of "and" and "or" (up to the choice of sorts) in *)
-(* an hypothesis and in the conclusion *)
-  strict_in_hyp_and_ccl : bool;
-
-(* Whether unit type includes equality types *)
-  strict_unit : bool;
-}
-
-(* Whether inner not are unfolded *)
-let negation_unfolding = ref true
-
-(* Whether inner iff are unfolded *)
-let iff_unfolding = ref false
-
-let unfold_iff () = !iff_unfolding || Flags.version_less_or_equal Flags.V8_2
-
-open Goptions
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "unfolding of not in intuition";
-      optkey   = ["Intuition";"Negation";"Unfolding"];
-      optread  = (fun () -> !negation_unfolding);
-      optwrite = (:=) negation_unfolding }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "unfolding of iff in intuition";
-      optkey   = ["Intuition";"Iff";"Unfolding"];
-      optread  = (fun () -> !iff_unfolding);
-      optwrite = (:=) iff_unfolding }
-
-(** Test *)
-
-let make_lfun l =
-  let fold accu (id, v) = Id.Map.add (Id.of_string id) v accu in
-  List.fold_left fold Id.Map.empty l
-
-let is_empty ist =
-  if is_empty_type (assoc_var "X1" ist) then
-    <:tactic<idtac>>
-  else
-    <:tactic<fail>>
-
-(* Strictly speaking, this exceeds the propositional fragment as it
-   matches also equality types (and solves them if a reflexivity) *)
-let is_unit_or_eq flags ist =
-  let test = if flags.strict_unit then is_unit_type else is_unit_or_eq_type in
-  if test (assoc_var "X1" ist) then
-    <:tactic<idtac>>
-  else
-    <:tactic<fail>>
-
-let is_record t =
-  let (hdapp,args) = decompose_app t in
-    match (kind_of_term hdapp) with
-      | Ind (ind,u) ->
-          let (mib,mip) = Global.lookup_inductive ind in
-	    mib.Declarations.mind_record <> None
-      | _ -> false
-
-let bugged_is_binary t =
-  isApp t &&
-  let (hdapp,args) = decompose_app t in
-    match (kind_of_term hdapp) with
-    | Ind (ind,u)  ->
-        let (mib,mip) = Global.lookup_inductive ind in
-         Int.equal mib.Declarations.mind_nparams 2
-    | _ -> false
-
-let iter_tac tacl =
-  List.fold_right (fun tac tacs -> <:tactic< $tac; $tacs >>) tacl
-
-(** Dealing with conjunction *)
-
-let is_conj flags ist =
-  let ind = assoc_var "X1" ist in
-    if (not flags.binary_mode_bugged_detection || bugged_is_binary ind) &&
-       is_conjunction
-         ~strict:flags.strict_in_hyp_and_ccl
-         ~onlybinary:flags.binary_mode ind
-    then
-      <:tactic<idtac>>
-    else
-      <:tactic<fail>>
-
-let flatten_contravariant_conj flags ist =
-  let typ = assoc_var "X1" ist in
-  let c = assoc_var "X2" ist in
-  let hyp = assoc_var "id" ist in
-  match match_with_conjunction
-          ~strict:flags.strict_in_contravariant_hyp
-          ~onlybinary:flags.binary_mode typ
-  with
-  | Some (_,args) ->
-      let newtyp = valueIn (Value.of_constr (List.fold_right mkArrow args c)) in
-      let hyp = valueIn (Value.of_constr hyp) in
-      let intros =
-	iter_tac (List.map (fun _ -> <:tactic< intro >>) args)
-	<:tactic< idtac >> in
-      <:tactic<
-        let newtyp := $newtyp in
-        let hyp := $hyp in
-	assert newtyp by ($intros; apply hyp; split; assumption);
-	clear hyp
-      >>
-  | _ ->
-      <:tactic<fail>>
-
-(** Dealing with disjunction *)
-
-let constructor i =
-  let name = { Tacexpr.mltac_plugin = "coretactics"; mltac_tactic = "constructor" } in
-  let i = in_gen (rawwit Constrarg.wit_int_or_var) (Misctypes.ArgArg i) in
-  Tacexpr.TacML (Loc.ghost, name, [i])
-
-let is_disj flags ist =
-  let t = assoc_var "X1" ist in
-  if (not flags.binary_mode_bugged_detection || bugged_is_binary t) &&
-     is_disjunction
-       ~strict:flags.strict_in_hyp_and_ccl
-       ~onlybinary:flags.binary_mode t
-  then
-    <:tactic<idtac>>
-  else
-    <:tactic<fail>>
-
-let flatten_contravariant_disj flags ist =
-  let typ = assoc_var "X1" ist in
-  let c = assoc_var "X2" ist in
-  let hyp = assoc_var "id" ist in
-  match match_with_disjunction
-          ~strict:flags.strict_in_contravariant_hyp
-          ~onlybinary:flags.binary_mode
-          typ with
-  | Some (_,args) ->
-      let hyp = valueIn (Value.of_constr hyp) in
-      iter_tac (List.map_i (fun i arg ->
-	let typ = valueIn (Value.of_constr (mkArrow arg c)) in
-	let ci = constructor i in
-	<:tactic<
-          let typ := $typ in
-          let hyp := $hyp in
-	  assert typ by (intro; apply hyp; $ci; assumption)
-	>>) 1 args) <:tactic< let hyp := $hyp in clear hyp >>
-  | _ ->
-      <:tactic<fail>>
-
-
-(** Main tactic *)
-
-let not_dep_intros ist =
-  <:tactic<
-  repeat match goal with
-  | |- (forall (_: ?X1), ?X2) => intro
-  | |- (Coq.Init.Logic.not _) => unfold Coq.Init.Logic.not at 1; intro
-  end >>
-
-let axioms flags ist =
-  let t_is_unit_or_eq = tacticIn (is_unit_or_eq flags)
-  and t_is_empty = tacticIn is_empty in
-  let c1 = constructor 1 in
-    <:tactic<
-    match reverse goal with
-      | |- ?X1 => $t_is_unit_or_eq; $c1
-      | _:?X1 |- _ => $t_is_empty; elimtype X1; assumption
-      | _:?X1 |- ?X1 => assumption
-    end >>
-
-
-let simplif flags ist =
-  let t_is_unit_or_eq = tacticIn (is_unit_or_eq flags)
-  and t_is_conj = tacticIn (is_conj flags)
-  and t_flatten_contravariant_conj = tacticIn (flatten_contravariant_conj flags)
-  and t_flatten_contravariant_disj = tacticIn (flatten_contravariant_disj flags)
-  and t_is_disj = tacticIn (is_disj flags)
-  and t_not_dep_intros = tacticIn not_dep_intros in
-  let c1 = constructor 1 in
-  <:tactic<
-    $t_not_dep_intros;
-    repeat
-       (match reverse goal with
-        | id: ?X1 |- _ => $t_is_conj; elim id; do 2 intro; clear id
-        | id: (Coq.Init.Logic.iff _ _) |- _ => elim id; do 2 intro; clear id
-        | id: (Coq.Init.Logic.not _) |- _ => red in id
-        | id: ?X1 |- _ => $t_is_disj; elim id; intro; clear id
-        | id0: (forall (_: ?X1), ?X2), id1: ?X1|- _ =>
-	    (* generalize (id0 id1); intro; clear id0 does not work
-	       (see Marco Maggiesi's bug PR#301)
-	    so we instead use Assert and exact. *)
-	    assert X2; [exact (id0 id1) | clear id0]
-        | id: forall (_ : ?X1), ?X2|- _ =>
-          $t_is_unit_or_eq; cut X2;
-	    [ intro; clear id
-	    | (* id : forall (_: ?X1), ?X2 |- ?X2 *)
-	      cut X1; [exact id| $c1; fail]
-	    ]
-        | id: forall (_ : ?X1), ?X2|- _ =>
-          $t_flatten_contravariant_conj
-	  (* moved from "id:(?A/\?B)->?X2|-" to "?A->?B->?X2|-" *)
-        | id: forall (_: Coq.Init.Logic.iff ?X1 ?X2), ?X3|- _ =>
-          assert (forall (_: forall _:X1, X2), forall (_: forall _: X2, X1), X3)
-	    by (do 2 intro; apply id; split; assumption);
-            clear id
-        | id: forall (_:?X1), ?X2|- _ =>
-          $t_flatten_contravariant_disj
-	  (* moved from "id:(?A\/?B)->?X2|-" to "?A->?X2,?B->?X2|-" *)
-        | |- ?X1 => $t_is_conj; split
-        | |- (Coq.Init.Logic.iff _ _) => split
-        | |- (Coq.Init.Logic.not _) => red
-        end;
-        $t_not_dep_intros) >>
-
-let rec tauto_intuit flags t_reduce solver =
-  let t_axioms = tacticIn (axioms flags)
-  and t_simplif = tacticIn (simplif flags)
-  and t_is_disj = tacticIn (is_disj flags) in
-  let lfun = make_lfun [("t_solver", solver)] in
-  let ist = { default_ist () with lfun = lfun; } in
-  let vars = [Id.of_string "t_solver"] in
-  (vars, ist, <:tactic<
-   let rec t_tauto_intuit :=
-   ($t_simplif;$t_axioms
-   || match reverse goal with
-      | id:forall(_: forall (_: ?X1), ?X2), ?X3|- _ =>
-	  cut X3;
-	    [ intro; clear id; t_tauto_intuit
-	    | cut (forall (_: X1), X2);
-		[ exact id
-		| generalize (fun y:X2 => id (fun x:X1 => y)); intro; clear id;
-		  solve [ t_tauto_intuit ]]]
-      | id:forall (_:not ?X1), ?X3|- _ =>
-	  cut X3;
-	    [ intro; clear id; t_tauto_intuit
-	    | cut (not X1); [ exact id | clear id; intro; solve [t_tauto_intuit ]]]
-      | |- ?X1 =>
-          $t_is_disj; solve [left;t_tauto_intuit | right;t_tauto_intuit]
-      end
-    ||
-    (* NB: [|- _ -> _] matches any product *)
-    match goal with | |- forall (_ : _),  _ => intro; t_tauto_intuit
-    |  |- _  => $t_reduce;t_solver
-    end
-    ||
-    t_solver
-   ) in t_tauto_intuit >>)
-
-let reduction_not_iff _ist =
-  match !negation_unfolding, unfold_iff () with
-    | true, true -> <:tactic< unfold Coq.Init.Logic.not, Coq.Init.Logic.iff in * >>
-    | true, false -> <:tactic< unfold Coq.Init.Logic.not in * >>
-    | false, true -> <:tactic< unfold Coq.Init.Logic.iff in * >>
-    | false, false -> <:tactic< idtac >>
-
-let t_reduction_not_iff = tacticIn reduction_not_iff
-
-let intuition_gen ist flags tac =
-  Proofview.Goal.enter begin fun gl ->
-  let tac = Value.of_closure ist tac in
-  let env = Proofview.Goal.env gl in
-  let vars, ist, intuition = tauto_intuit flags t_reduction_not_iff tac in
-  let glb_intuition = Tacintern.glob_tactic_env vars env intuition in
-  eval_tactic_ist ist glb_intuition
-  end
-
-let tauto_intuitionistic flags =
-  Proofview.tclORELSE
-    (intuition_gen (default_ist ()) flags <:tactic<fail>>)
-    begin function (e, info) -> match e with
-      | Refiner.FailError _ | UserError _ ->
-          Tacticals.New.tclZEROMSG (str "tauto failed.")
-      | e -> Proofview.tclZERO ~info e
-    end
-
-let coq_nnpp_path =
-  let dir = List.map Id.of_string ["Classical_Prop";"Logic";"Coq"] in
-  Libnames.make_path (DirPath.make dir) (Id.of_string "NNPP")
-
-let tauto_classical flags nnpp =
-  Proofview.tclORELSE
-    (Tacticals.New.tclTHEN (apply nnpp) (tauto_intuitionistic flags))
-    begin function (e, info) -> match e with
-      | UserError _ -> Tacticals.New.tclZEROMSG (str "Classical tauto failed.")
-      | e -> Proofview.tclZERO ~info e
-    end
-
-let tauto_gen flags =
-  (* spiwack: I use [tclBIND (tclUNIT ())] as a way to delay the effect
-     (in [constr_of_global]) to the application of the tactic. *)
-  Proofview.tclBIND
-    (Proofview.tclUNIT ())
-    begin fun () -> try
-      let nnpp = Universes.constr_of_global (Nametab.global_of_path coq_nnpp_path) in
-    (* try intuitionistic version first to avoid an axiom if possible *)
-      Tacticals.New.tclORELSE (tauto_intuitionistic flags) (tauto_classical flags nnpp)
-    with Not_found ->
-      tauto_intuitionistic flags
-    end
-
-let default_intuition_tac = <:tactic< auto with * >>
-
-(* This is the uniform mode dealing with ->, not, iff and types isomorphic to
-   /\ and *, \/ and +, False and Empty_set, True and unit, _and_ eq-like types.
-   For the moment not and iff are still always unfolded. *)
-let tauto_uniform_unit_flags = {
-  binary_mode = true;
-  binary_mode_bugged_detection = false;
-  strict_in_contravariant_hyp = true;
-  strict_in_hyp_and_ccl = true;
-  strict_unit = false
-}
-
-(* This is the compatibility mode (not used) *)
-let tauto_legacy_flags = {
-  binary_mode = true;
-  binary_mode_bugged_detection = true;
-  strict_in_contravariant_hyp = true;
-  strict_in_hyp_and_ccl = false;
-  strict_unit = false
-}
-
-(* This is the improved mode *)
-let tauto_power_flags = {
-  binary_mode = false; (* support n-ary connectives *)
-  binary_mode_bugged_detection = false;
-  strict_in_contravariant_hyp = false; (* supports non-regular connectives *)
-  strict_in_hyp_and_ccl = false;
-  strict_unit = false
-}
-
-let tauto = tauto_gen tauto_uniform_unit_flags
-let dtauto = tauto_gen tauto_power_flags
-
-TACTIC EXTEND tauto
-| [ "tauto" ] -> [ tauto ]
-END
-
-TACTIC EXTEND dtauto
-| [ "dtauto" ] -> [ dtauto ]
-END
-
-TACTIC EXTEND intuition
-| [ "intuition" ] -> [ intuition_gen ist tauto_uniform_unit_flags default_intuition_tac ]
-| [ "intuition" tactic(t) ] -> [ intuition_gen ist tauto_uniform_unit_flags t ]
-END
-
-TACTIC EXTEND dintuition
-| [ "dintuition" ] -> [ intuition_gen ist tauto_power_flags default_intuition_tac ]
-| [ "dintuition" tactic(t) ] -> [ intuition_gen ist tauto_power_flags t ]
-END