Creating a dedicated ltac/ folder for Hightactics.

40 files changed, 0 insertions, 12402 deletions

diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
deleted file mode 100644
index ea598b61c..000000000
--- a/tactics/autorewrite.ml
+++ /dev/null
@@ -1,315 +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 Equality
-open Names
-open Pp
-open Tacticals
-open Tactics
-open Term
-open Termops
-open Errors
-open Util
-open Tacexpr
-open Mod_subst
-open Locus
-open Sigma.Notations
-open Proofview.Notations
-
-(* Rewriting rules *)
-type rew_rule = { rew_lemma: constr;
-		  rew_type: types;
-		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
-		  rew_l2r: bool;
-		  rew_tac: glob_tactic_expr 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
-    if hint.rew_lemma == cst' && hint.rew_type == typ' && hint.rew_tac == t' then hint else
-      { hint with
-	rew_lemma = cst'; rew_type = typ';
-	rew_pat = pat';	rew_tac = t' }
-
-module HintIdent =
-struct
-  type t = int * rew_rule
-
-  let compare (i, t) (j, t') = i - j
-
-  let subst s (i,t) = (i,subst_hint s t)
-
-  let constr_of (i,t) = t.rew_pat
-end
-
-module HintOpt =
-struct
-  let reduce c = c
-  let direction = true
-end
-
-module HintDN = Term_dnet.Make(HintIdent)(HintOpt)
-
-(* Summary and Object declaration *)
-let rewtab =
-  Summary.ref (String.Map.empty : HintDN.t String.Map.t) ~name:"autorewrite"
-
-let raw_find_base bas = String.Map.find bas !rewtab
-
-let find_base bas =
-  try raw_find_base bas
-  with Not_found ->
-    errorlabstrm "AutoRewrite"
-      (str "Rewriting base " ++ str bas ++ str " does not exist.")
-
-let find_rewrites bas =
-  List.rev_map snd (HintDN.find_all (find_base bas))
-
-let find_matches bas pat =
-  let base = find_base bas in
-  let res = HintDN.search_pattern base pat in
-  List.map snd res
-
-let print_rewrite_hintdb bas =
-  (str "Database " ++ str bas ++ fnl () ++
-	   prlist_with_sep fnl
-	   (fun h ->
-	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
-	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
-	       Option.cata (fun tac -> str " then use tactic " ++
-	       Pptactic.pr_glob_tactic (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
-
-(* Applies all the rules of one base *)
-let one_base general_rewrite_maybe_in tac_main bas =
-  let lrul = find_rewrites bas in
-  let try_rewrite dir ctx c tc =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
-    let subst, ctx' = Universes.fresh_universe_context_set_instance ctx in
-    let c' = Vars.subst_univs_level_constr subst c in
-    let sigma = Sigma.to_evar_map sigma in
-    let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx' in
-    let tac = general_rewrite_maybe_in dir c' tc in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end } in
-  let lrul = List.map (fun h -> 
-  let tac = match h.rew_tac with None -> Proofview.tclUNIT () | Some t -> Tacinterp.eval_tactic t 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
-        (Tacticals.New.tclREPEAT_MAIN
-	    (Tacticals.New.tclTHENFIRST (try_rewrite dir ctx csr tc) tac_main)))
-      (Proofview.tclUNIT()) lrul))
-
-(* The AutoRewrite tactic *)
-let autorewrite ?(conds=Naive) tac_main lbas =
-  Tacticals.New.tclREPEAT_MAIN (Proofview.tclPROGRESS
-    (List.fold_left (fun tac bas ->
-       Tacticals.New.tclTHEN tac
-        (one_base (fun dir c tac ->
-	  let tac = (tac, conds) in
-	    general_rewrite dir AllOccurrences true false ~tac c)
-	  tac_main bas))
-      (Proofview.tclUNIT()) lbas))
-
-let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
- Proofview.Goal.nf_enter { enter = begin fun gl ->
- (* let's check at once if id exists (to raise the appropriate error) *)
- let _ = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) idl in
- let general_rewrite_in id =
-  let id = ref id in
-  let to_be_cleared = ref false in
-   fun dir cstr tac gl ->
-    let last_hyp_id =
-     match Tacmach.pf_hyps gl with
-        d :: _ -> Context.Named.Declaration.get_id d
-      | _ -> (* even the hypothesis id is missing *)
-        raise (Logic.RefinerError (Logic.NoSuchHyp !id))
-    in
-    let gl' = Proofview.V82.of_tactic (general_rewrite_in dir AllOccurrences true ~tac:(tac, conds) false !id cstr false) gl in
-    let gls = gl'.Evd.it in
-    match gls with
-       g::_ ->
-        (match Environ.named_context_of_val (Goal.V82.hyps gl'.Evd.sigma g) with
-            d ::_ ->
-              let lastid = Context.Named.Declaration.get_id d in
-              if not (Id.equal last_hyp_id lastid) then
-               begin
-                let gl'' =
-                  if !to_be_cleared then
-                   tclTHEN (fun _ -> gl') (tclTRY (clear [!id])) gl
-                  else gl' in
-                id := lastid ;
-                to_be_cleared := true ;
-                gl''
-               end
-              else
-               begin
-                to_be_cleared := false ;
-                gl'
-               end
-          | _ -> assert false) (* there must be at least an hypothesis *)
-     | _ -> assert false (* rewriting cannot complete a proof *)
- in
- let general_rewrite_in x y z w = Proofview.V82.tactic (general_rewrite_in x y z w) in
- Tacticals.New.tclMAP (fun id ->
-  Tacticals.New.tclREPEAT_MAIN (Proofview.tclPROGRESS
-    (List.fold_left (fun tac bas ->
-       Tacticals.New.tclTHEN tac (one_base (general_rewrite_in id) tac_main bas)) (Proofview.tclUNIT()) lbas)))
-   idl
- end }
-
-let autorewrite_in ?(conds=Naive) id = autorewrite_multi_in ~conds [id]
-
-let gen_auto_multi_rewrite conds tac_main lbas cl =
-  let try_do_hyps treat_id l =
-    autorewrite_multi_in ~conds (List.map treat_id l) tac_main lbas
-  in
-  if cl.concl_occs != AllOccurrences &&
-     cl.concl_occs != NoOccurrences
-  then
-    Tacticals.New.tclZEROMSG (str"The \"at\" syntax isn't available yet for the autorewrite tactic.")
-  else
-    let compose_tac t1 t2 =
-      match cl.onhyps with
-	| Some [] -> t1
-	| _ ->      Tacticals.New.tclTHENFIRST t1 t2
-    in
-    compose_tac
-	(if cl.concl_occs != NoOccurrences then autorewrite ~conds tac_main lbas else Proofview.tclUNIT ())
-	(match cl.onhyps with
-	   | Some l -> try_do_hyps (fun ((_,id),_) -> id) l
-	   | None ->
-		 (* try to rewrite in all hypothesis
-		    (except maybe the rewritten one) *)
-               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 })
-
-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
-  match onconcl,cl.Locus.onhyps with
-    | false,Some [_] | true,Some [] | false,Some [] ->
-	(* autorewrite with .... in clause using tac n'est sur que
-	   si clause represente soit le but soit UNE hypothese
-	*)
-	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.")
-
-(* Functions necessary to the library object declaration *)
-let cache_hintrewrite (_,(rbase,lrl)) =
-  let base = try raw_find_base rbase with Not_found -> HintDN.empty in
-  let max = try fst (Util.List.last (HintDN.find_all base)) with Failure _ -> 0
-  in
-  let lrl = HintDN.refresh_metas lrl in
-  let lrl = HintDN.map (fun (i,h) -> (i + max, h)) lrl in
-    rewtab:=String.Map.add rbase (HintDN.union lrl base) !rewtab
-
-
-let subst_hintrewrite (subst,(rbase,list as node)) =
-  let list' = HintDN.subst subst list in
-    if list' == list then node else
-      (rbase,list')
-
-let classify_hintrewrite x = Libobject.Substitute x
-
-
-(* Declaration of the Hint Rewrite library object *)
-let inHintRewrite : string * HintDN.t -> Libobject.obj =
-  Libobject.declare_object {(Libobject.default_object "HINT_REWRITE") with
-    Libobject.cache_function = cache_hintrewrite;
-    Libobject.load_function = (fun _ -> cache_hintrewrite);
-    Libobject.subst_function = subst_hintrewrite;
-    Libobject.classify_function = classify_hintrewrite }
-
-
-open Clenv
-
-type hypinfo = {
-  hyp_cl : clausenv;
-  hyp_prf : constr;
-  hyp_ty : types;
-  hyp_car : constr;
-  hyp_rel : constr;
-  hyp_l2r : bool;
-  hyp_left : constr;
-  hyp_right : constr;
-}
-
-let decompose_applied_relation metas env sigma c ctype left2right =
-  let find_rel ty =
-    let eqclause = Clenv.mk_clenv_from_env env sigma None (c,ty) in
-    let eqclause =
-      if metas then eqclause
-      else clenv_pose_metas_as_evars eqclause (Evd.undefined_metas eqclause.evd)
-    in
-    let (equiv, args) = decompose_app (Clenv.clenv_type eqclause) in
-    let rec split_last_two = function
-      | [c1;c2] -> [],(c1, c2)
-      | x::y::z ->
-	  let l,res = split_last_two (y::z) in x::l, res
-      | _ -> raise Not_found
-    in
-      try
-	let others,(c1,c2) = split_last_two args in
-	let ty1, ty2 =
-	  Typing.unsafe_type_of env eqclause.evd c1, Typing.unsafe_type_of env eqclause.evd c2
-	in
-(* 	  if not (evd_convertible env eqclause.evd ty1 ty2) then None *)
-(* 	  else *)
-	    Some { hyp_cl=eqclause; hyp_prf=(Clenv.clenv_value eqclause); hyp_ty = ty;
-		   hyp_car=ty1; hyp_rel=mkApp (equiv, Array.of_list others);
-		   hyp_l2r=left2right; hyp_left=c1; hyp_right=c2; }
-      with Not_found -> None
-  in
-    match find_rel ctype with
-    | Some c -> Some c
-    | None ->
-	let ctx,t' = Reductionops.splay_prod_assum env sigma ctype in (* Search for underlying eq *)
-	match find_rel (it_mkProd_or_LetIn t' ctx) with
-	| Some c -> Some c
-	| None -> None
-
-let find_applied_relation metas loc env sigma c left2right =
-  let ctype = Typing.unsafe_type_of env sigma c in
-    match decompose_applied_relation metas env sigma c ctype left2right with
-    | Some c -> c
-    | None ->
-	user_err_loc (loc, "decompose_applied_relation",
-		     str"The type" ++ spc () ++ Printer.pr_constr_env env sigma ctype ++
-		       spc () ++ str"of this term does not end with an applied relation.")
-
-(* To add rewriting rules to a base *)
-let add_rew_rules base lrul =
-  let counter = ref 0 in
-  let env = Global.env () in
-  let sigma = Evd.from_env env in
-  let lrul =
-    List.fold_left
-      (fun dn (loc,(c,ctx),b,t) ->
-	let sigma = Evd.merge_context_set Evd.univ_rigid sigma ctx in
-	let info = find_applied_relation false loc env sigma c b in
-	let 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}
-	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
deleted file mode 100644
index 6196b04e1..000000000
--- a/tactics/autorewrite.mli
+++ /dev/null
@@ -1,61 +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 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
-
-(** To add rewriting rules to a base *)
-val add_rew_rules : string -> raw_rew_rule list -> unit
-
-(** The AutoRewrite tactic.
-   The optional conditions tell rewrite how to handle matching and side-condition solving.
-   Default is Naive: first match in the clause, don't look at the side-conditions to
-   tell if the rewrite succeeded. *)
-val autorewrite : ?conds:conditions -> unit Proofview.tactic -> string list -> unit Proofview.tactic
-val autorewrite_in : ?conds:conditions -> Names.Id.t -> unit Proofview.tactic -> string list -> unit Proofview.tactic
-
-(** Rewriting rules *)
-type rew_rule = { rew_lemma: constr;
-		  rew_type: types;
-		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
-		  rew_l2r: bool;
-		  rew_tac: glob_tactic_expr option }
-
-val find_rewrites : string -> rew_rule list
-
-val find_matches : string -> constr -> rew_rule list
-
-val auto_multi_rewrite : ?conds:conditions -> string list -> Locus.clause -> unit Proofview.tactic
-
-val auto_multi_rewrite_with : ?conds:conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic
-
-val print_rewrite_hintdb : string -> Pp.std_ppcmds
-
-open Clenv
-
-
-type hypinfo = {
-  hyp_cl : clausenv;
-  hyp_prf : constr;
-  hyp_ty : types;
-  hyp_car : constr;
-  hyp_rel : constr;
-  hyp_l2r : bool;
-  hyp_left : constr;
-  hyp_right : constr;
-}
-
-val find_applied_relation : bool ->
-  Loc.t ->
-  Environ.env -> Evd.evar_map -> Term.constr -> bool -> hypinfo
-
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
deleted file mode 100644
index 485559898..000000000
--- a/tactics/class_tactics.ml
+++ /dev/null
@@ -1,903 +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 Errors
-open Util
-open Names
-open Term
-open Termops
-open Reduction
-open Proof_type
-open Tacticals
-open Tacmach
-open Tactics
-open Clenv
-open Typeclasses
-open Globnames
-open Evd
-open Locus
-open Misctypes
-open Proofview.Notations
-open Hints
-
-(** Hint database named "typeclass_instances", now created directly in Auto *)
-
-let typeclasses_debug = ref false
-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
-
-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
-
-open Goptions
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "do typeclass search modulo eta conversion";
-      optkey   = ["Typeclasses";"Modulo";"Eta"];
-      optread  = get_typeclasses_modulo_eta;
-      optwrite = set_typeclasses_modulo_eta; }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      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; }
-
-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; }
-
-(** 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 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 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)
-
-(** Typeclasses instance search tactic / eauto *)
-
-open Auto
-
-open Unification
-
-let auto_core_unif_flags st freeze = {
-  modulo_conv_on_closed_terms = Some st;
-  use_metas_eagerly_in_conv_on_closed_terms = true;
-  use_evars_eagerly_in_conv_on_closed_terms = false;
-  modulo_delta = st;
-  modulo_delta_types = st;
-  check_applied_meta_types = false;
-  use_pattern_unification = true;
-  use_meta_bound_pattern_unification = true;
-  frozen_evars = freeze;
-  restrict_conv_on_strict_subterms = false; (* ? *)
-  modulo_betaiota = true;
-  modulo_eta = !typeclasses_modulo_eta;
-}
-
-let auto_unif_flags freeze st = 
-  let fl = auto_core_unif_flags st freeze in
-  { core_unify_flags = fl;
-    merge_unify_flags = fl;
-    subterm_unify_flags = fl;
-    allow_K_in_toplevel_higher_order_unification = false;
-    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 { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let check =
-      Proofview.Goal.nf_enter { 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 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 = 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
-
-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 = { 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 }
-
-let clenv_of_prods poly nprods (c, clenv) gl =
-  let (c, _, _) = c in
-  if poly || Int.equal nprods 0 then Some clenv
-  else
-    let ty = Tacmach.New.pf_unsafe_type_of 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
-
-let with_prods nprods poly (c, clenv) f =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  match clenv_of_prods poly nprods (c, clenv) gl with
-  | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
-  | Some clenv' -> f.enter gl (c, clenv')
-  end }
-
-(** Hack to properly solve dependent evars that are typeclasses *)
-
-let rec e_trivial_fail_db db_list local_db goal =
-  let tacl =
-    Proofview.V82.of_tactic 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)))
-  in
-  tclFIRST (List.map tclCOMPLETE tacl) goal
-
-and e_my_find_search db_list local_db hdc complete sigma concl =
-  let prods, concl = decompose_prod_assum concl in
-  let nprods = List.length prods in
-  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
-  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)
-      (local_db::db_list)
-  in
-  let tac_of_hint =
-    fun (flags, {pri = b; pat = p; poly = poly; code = t; 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_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 (Proofview.V82.of_tactic (unfold_in_concl [AllOccurrences,c])))
-      | 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))
-  in List.map tac_of_hint hintl
-
-and e_trivial_resolve db_list local_db sigma concl =
-  try
-    e_my_find_search db_list local_db
-     (decompose_app_bound concl) true sigma concl
-  with Bound | Not_found -> []
-
-let e_possible_resolve db_list local_db sigma concl =
-  try
-    e_my_find_search db_list local_db
-      (decompose_app_bound concl) false sigma concl
-  with Bound | Not_found -> []
-
-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 failure = NotApplicable | ReachedLimit
-type 'ans fk = failure -> 'ans
-type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
-type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-
-type auto_result = autogoal list sigma
-
-type atac = auto_result tac
-
-(* Some utility types to avoid the need of -rectypes *)
-
-type 'a optionk =
-  | Nonek
-  | Somek of 'a * 'a optionk fk
-
-type ('a,'b) optionk2 =
-  | Nonek2 of failure
-  | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
-
-let 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
-  in
-  let is_class = iscl env cty in
-  let keep = not only_classes || is_class in
-    if keep then
-      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 []
-      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])
-    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 =
-    List.fold_left
-    (fun (paths, 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 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
-  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 NotApplicable }
-
-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 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 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
-
-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 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 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) (Some e') tl
-		  else fk e')
-	    in
-	      sk glsv fk')
-      | [] ->
-	if foundone == None && !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");
-	match foundone with
-	| Some e -> fk e
-	| None -> fk NotApplicable
-      in aux 1 None 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 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 depth limit 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 cut_of_hints h =
-  List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h
-
-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)
-    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 =
-  if get_typeclasses_iterative_deepening () then
-    match limit with
-    | None -> fix_iterative (eauto_tac hints)
-    | Some limit -> fix_iterative_limit limit (eauto_tac hints)
-  else
-    match limit with
-    | None -> fix (eauto_tac hints)
-    | Some limit -> fix_limit limit (eauto_tac hints)
-
-let real_eauto ?limit unique st hints p evd =
-  let res =
-    run_on_evars ~st ~unique p evd hints (eauto_tac ?limit 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 limit unique p evd =
-  let db = searchtable_map typeclasses_db in
-    real_eauto ?limit unique (Hint_db.transparent_state db) [db] p evd
-
-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
-    | None -> raise Not_found
-    | Some {it = goals; sigma = s; } ->
-	{it = List.map fst goals; sigma = s;}
-
-(** We compute dependencies via a union-find algorithm.
-    Beware of the imperative effects on the partition structure,
-    it should not be shared, but only used locally. *)
-
-module Intpart = Unionfind.Make(Evar.Set)(Evar.Map)
-
-let deps_of_constraints cstrs evm p =
-  List.iter (fun (_, _, x, y) ->
-    let evx = Evarutil.undefined_evars_of_term evm x in
-    let evy = Evarutil.undefined_evars_of_term evm y in
-    Intpart.union_set (Evar.Set.union evx evy) p)
-    cstrs
-
-let evar_dependencies evm p =
-  Evd.fold_undefined
-    (fun ev evi _ ->
-      let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi)
-      in Intpart.union_set evars p)
-    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 =
-  let p = Intpart.create () in
-  evar_dependencies evm p;
-  deps_of_constraints (snd (extract_all_conv_pbs evm)) evm p;
-  Intpart.partition p
-
-let is_inference_forced p evd ev =
-  try
-    let evi = Evd.find_undefined evd ev in
-    if Typeclasses.is_resolvable evi && snd (p ev evi)
-    then
-      let (loc, k) = evar_source ev evd in
-      match k with
-	| Evar_kinds.ImplicitArg (_, _, b) -> b
-	| Evar_kinds.QuestionMark _ -> false
-	| _ -> true
-    else true
-  with Not_found -> assert false
-
-let is_mandatory p comp evd =
-  Evar.Set.exists (is_inference_forced p evd) comp
-
-(** In case of unsatisfiable constraints, build a nice error message *)
-
-let error_unresolvable env comp evd =
-  let evd = Evarutil.nf_evar_map_undefined evd in
-  let is_part ev = match comp with
-  | None -> true
-  | Some s -> Evar.Set.mem ev s
-  in
-  let fold ev evi (found, accu) =
-    let ev_class = class_of_constr evi.evar_concl in
-    if not (Option.is_empty ev_class) && is_part ev then
-      (* focus on one instance if only one was searched for *)
-      if not found then (true, Some ev)
-      else (found, None)
-    else (found, accu)
-   in
-  let (_, ev) = Evd.fold_undefined fold evd (true, None) in
-    Pretype_errors.unsatisfiable_constraints
-      (Evarutil.nf_env_evar evd env) evd ev comp
-
-(** Check if an evar is concerned by the current resolution attempt,
-    (and in particular is in the current component), and also update
-    its evar_info.
-    Invariant : this should only be applied to undefined evars,
-    and return undefined evar_info *)
-
-let select_and_update_evars p oevd in_comp evd ev evi =
-  assert (evi.evar_body == Evar_empty);
-  try
-    let oevi = Evd.find_undefined oevd ev in
-    if Typeclasses.is_resolvable oevi then
-      Typeclasses.mark_unresolvable evi,
-      (in_comp ev && p evd ev evi)
-    else evi, false
-  with Not_found ->
-    Typeclasses.mark_unresolvable evi, p evd ev evi
-
-(** Do we still have unresolved evars that should be resolved ? *)
-
-let has_undefined p oevd evd =
-  let check ev evi = snd (p oevd ev evi) in
-  Evar.Map.exists check (Evd.undefined_map evd)
-
-(** Revert the resolvability status of evars after resolution,
-    potentially unprotecting some evars that were set unresolvable
-    just for this call to resolution. *)
-
-let revert_resolvability oevd evd =
-  let map ev evi =
-    try
-      if not (Typeclasses.is_resolvable evi) then
-        let evi' = Evd.find_undefined oevd ev in
-        if Typeclasses.is_resolvable evi' then
-          Typeclasses.mark_resolvable evi
-        else evi
-      else evi
-    with Not_found -> evi
-  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 =
-  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
-  let rec docomp evd = function
-    | [] -> revert_resolvability oevd evd
-    | 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
-      with Unresolved | Not_found ->
-	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
-  in docomp oevd split
-
-let initial_select_evars filter =
-  fun evd ev evi ->
-    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 evd =
-    try Evarconv.consider_remaining_unif_problems
-      ~ts:(Typeclasses.classes_transparent_state ()) env evd
-    with e when Errors.noncritical e -> evd
-  in
-    resolve_all_evars debug m 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 _ =
-  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
-
-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 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
-
-(** Take the head of the arity of a constr.
-    Used in the partial application tactic. *)
-
-let rec head_of_constr t =
-  let t = strip_outer_cast(collapse_appl t) in
-    match kind_of_term t with
-    | Prod (_,_,c2)  -> head_of_constr c2
-    | LetIn (_,_,_,c2) -> head_of_constr c2
-    | App (f,args)  -> head_of_constr f
-    | _      -> t
-
-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 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 
-    (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 = { enter = fun gl -> (unify_e_resolve false flags).enter gl ((c,cty,Univ.ContextSet.empty),ce) } in
-  Proofview.V82.of_tactic (Proofview.Goal.nf_enter tac) gl
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
deleted file mode 100644
index f1bcfa7dd..000000000
--- a/tactics/class_tactics.mli
+++ /dev/null
@@ -1,32 +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 Tacmach
-
-val catchable : exn -> bool
-
-val set_typeclasses_debug : bool -> unit
-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
-
-val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state ->
-  Hints.hint_db_name list -> tactic
-
-val head_of_constr : Id.t -> Term.constr -> unit Proofview.tactic
-
-val not_evar : constr -> unit Proofview.tactic
-
-val is_ground : constr -> tactic
-
-val autoapply : constr -> Hints.hint_db_name -> tactic
diff --git a/tactics/coretactics.ml4 b/tactics/coretactics.ml4
deleted file mode 100644
index 6c02a7202..000000000
--- a/tactics/coretactics.ml4
+++ /dev/null
@@ -1,299 +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 Stdarg
-open Constrarg
-open Extraargs
-open Pcoq.Constr
-open Pcoq.Prim
-open Pcoq.Tactic
-
-open Proofview.Notations
-open Sigma.Notations
-
-DECLARE PLUGIN "coretactics"
-
-(** Basic tactics *)
-
-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) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false bl (fun bl -> Tactics.left_with_bindings false bl)
-  ]
-END
-
-TACTIC EXTEND eleft_with
-  [ "eleft" "with" bindings(bl) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES true bl (fun bl -> Tactics.left_with_bindings true bl)
-  ]
-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) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false bl (fun bl -> Tactics.right_with_bindings false bl)
-  ]
-END
-
-TACTIC EXTEND eright_with
-  [ "eright" "with" bindings(bl) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES true bl (fun bl -> Tactics.right_with_bindings true bl)
-  ]
-END
-
-(** Constructor *)
-
-TACTIC EXTEND constructor
-  [ "constructor" ] -> [ Tactics.any_constructor false None ]
-| [ "constructor" int_or_var(i) ] -> [
-    Tactics.constructor_tac false None i NoBindings
-  ]
-| [ "constructor" int_or_var(i) "with" bindings(bl) ] -> [
-    let tac bl = Tactics.constructor_tac false None i bl in
-    Tacticals.New.tclDELAYEDWITHHOLES false bl tac
-  ]
-END
-
-TACTIC EXTEND econstructor
-  [ "econstructor" ] -> [ Tactics.any_constructor true None ]
-| [ "econstructor" int_or_var(i) ] -> [
-    Tactics.constructor_tac true None i NoBindings
-  ]
-| [ "econstructor" int_or_var(i) "with" bindings(bl) ] -> [
-    let tac bl = Tactics.constructor_tac true None i bl in
-    Tacticals.New.tclDELAYEDWITHHOLES true bl tac
-  ]
-END
-
-(** Specialize *)
-
-TACTIC EXTEND specialize
-  [ "specialize" constr_with_bindings(c) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false c Tactics.specialize
-  ]
-END
-
-TACTIC EXTEND symmetry
-  [ "symmetry" ] -> [ Tactics.intros_symmetry {onhyps=Some[];concl_occs=AllOccurrences} ]
-| [ "symmetry" clause_dft_concl(cl) ] -> [ Tactics.intros_symmetry cl ]
-END
-
-(** Split *)
-
-let rec delayed_list = function
-| [] -> { Tacexpr.delayed = fun _ sigma -> Sigma.here [] sigma }
-| x :: l ->
-  { Tacexpr.delayed = fun env sigma ->
-    let Sigma (x, sigma, p) = x.Tacexpr.delayed env sigma in
-    let Sigma (l, sigma, q) = (delayed_list l).Tacexpr.delayed env sigma in
-    Sigma (x :: l, sigma, p +> q) }
-
-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) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false bl (fun bl -> Tactics.split_with_bindings false [bl])
-  ]
-END
-
-TACTIC EXTEND esplit_with
-  [ "esplit" "with" bindings(bl) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES true bl (fun bl -> Tactics.split_with_bindings true [bl])
-  ]
-END
-
-TACTIC EXTEND exists
-  [ "exists" ] -> [ Tactics.split_with_bindings false [NoBindings] ]
-| [ "exists" ne_bindings_list_sep(bll, ",") ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false (delayed_list bll) (fun bll -> Tactics.split_with_bindings false bll)
-  ]
-END
-
-TACTIC EXTEND eexists
-  [ "eexists" ] -> [ Tactics.split_with_bindings true [NoBindings] ]
-| [ "eexists" ne_bindings_list_sep(bll, ",") ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES true (delayed_list bll) (fun bll -> Tactics.split_with_bindings true bll)
-  ]
-END
-
-(** Intro *)
-
-TACTIC EXTEND intros_until
-  [ "intros" "until" quantified_hypothesis(h) ] -> [ Tactics.intros_until h ]
-END
-
-(** Move *)
-
-TACTIC EXTEND move
-  [ "move" hyp(id) "at" "top" ] -> [ Proofview.V82.tactic (Tactics.move_hyp id MoveFirst) ]
-| [ "move" hyp(id) "at" "bottom" ] -> [ Proofview.V82.tactic (Tactics.move_hyp id MoveLast) ]
-| [ "move" hyp(id) "after" hyp(h) ] -> [ Proofview.V82.tactic (Tactics.move_hyp id (MoveAfter h)) ]
-| [ "move" hyp(id) "before" hyp(h) ] -> [ Proofview.V82.tactic (Tactics.move_hyp id (MoveBefore 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
-
-(* Fix *)
-
-TACTIC EXTEND fix
-  [ "fix" natural(n) ] -> [ Proofview.V82.tactic (Tactics.fix None n) ]
-| [ "fix" ident(id) natural(n) ] -> [ Proofview.V82.tactic (Tactics.fix (Some id) n) ]
-END
-
-(* Cofix *)
-
-TACTIC EXTEND cofix
-  [ "cofix" ] -> [ Proofview.V82.tactic (Tactics.cofix None) ]
-| [ "cofix" ident(id) ] -> [ Proofview.V82.tactic (Tactics.cofix (Some id)) ]
-END
-
-(* Clear *)
-
-TACTIC EXTEND clear
-  [ "clear" hyp_list(ids) ] -> [
-    if List.is_empty ids then Tactics.keep []
-    else Proofview.V82.tactic (Tactics.clear ids)
-  ]
-| [ "clear" "-" ne_hyp_list(ids) ] -> [ Tactics.keep ids ]
-END
-
-(* Clearbody *)
-
-TACTIC EXTEND clearbody
-  [ "clearbody" ne_hyp_list(ids) ] -> [ Tactics.clear_body ids ]
-END
-
-(* Generalize dependent *)
-
-TACTIC EXTEND generalize_dependent
-  [ "generalize" "dependent" constr(c) ] -> [ Proofview.V82.tactic (Tactics.generalize_dep c) ]
-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 [];
-      ]
-  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.ml b/tactics/eauto.ml
deleted file mode 100644
index 044946759..000000000
--- a/tactics/eauto.ml
+++ /dev/null
@@ -1,526 +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 Errors
-open Util
-open Names
-open Nameops
-open Term
-open Termops
-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
-open Proofview.Notations
-
-let eauto_unif_flags = auto_flags_of_state full_transparent_state
-
-let e_give_exact ?(flags=eauto_unif_flags) c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let t1 = Tacmach.New.pf_unsafe_type_of gl c in
-  let t2 = Tacmach.New.pf_concl gl in
-  if occur_existential t1 || occur_existential t2 then
-     Tacticals.New.tclTHEN (Clenvtac.unify ~flags t1) (Proofview.V82.tactic (exact_no_check c))
-  else exact_check c
-  end }
-
-let assumption id = e_give_exact (mkVar id)
-
-let e_assumption =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    Tacticals.New.tclFIRST (List.map assumption (Tacmach.New.pf_ids_of_hyps gl))
-  end }
-
-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 }
-
-let eval_uconstrs ist cs =
-  let flags = {
-    Pretyping.use_typeclasses = false;
-    use_unif_heuristics = true;
-    use_hook = Some Pfedit.solve_by_implicit_tactic;
-    fail_evar = false;
-    expand_evars = true
-  } in
-  List.map (fun c -> Tacinterp.type_uconstr ~flags ist c) cs
-
-(************************************************************************)
-(*   PROLOG tactic                                                      *)
-(************************************************************************)
-
-(*s Tactics handling a list of goals. *)
-
-(* first_goal : goal list sigma -> goal sigma *)
-
-let first_goal gls =
-  let gl = gls.Evd.it and sig_0 = gls.Evd.sigma in
-  if List.is_empty gl then error "first_goal";
-  { Evd.it = List.hd gl; Evd.sigma = sig_0; }
-
-(* tactic -> tactic_list : Apply a tactic to the first goal in the list *)
-
-let apply_tac_list tac glls =
-  let (sigr,lg) = unpackage glls in
-  match lg with
-  | (g1::rest) ->
-      let gl = apply_sig_tac sigr tac g1 in
-      repackage sigr (gl@rest)
-  | _ -> error "apply_tac_list"
-
-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 (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";
-  let prol = (prolog l (n-1)) in
-  (tclFIRST (List.map (fun t -> (tclTHEN t prol)) (one_step l gl))) gl
-
-let out_term = function
-  | IsConstr (c, _) -> c
-  | IsGlobRef gr -> fst (Universes.fresh_global_instance (Global.env ()) gr)
-
-let prolog_tac l n =
-  Proofview.V82.tactic begin fun gl ->
-  let map c =
-    let (c, sigma) = Tactics.run_delayed (pf_env gl) (project gl) c in
-    let 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.")
-  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 { enter = begin fun gl ->
-      let clenv', c = connect_hint_clenv poly c clenv gl in
-      Proofview.V82.tactic
-	(fun gls ->
-	 let clenv' = clenv_unique_resolver ~flags clenv' gls in
-	 tclTHEN (Refiner.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
-		 (Proofview.V82.of_tactic (Tactics.Simple.eapply c)) gls)
-    end }
-
-let hintmap_of hdc concl =
-  match hdc with
-  | None -> fun db -> Hint_db.map_none 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)
-   (* 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 =
-  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 tacl =
-    registered_e_assumption ::
-    (Tacticals.New.tclTHEN Tactics.intro next) ::
-    (List.map fst (e_trivial_resolve db_list local_db (Tacmach.New.pf_nf_concl gl)))
-  in
-  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
-  let hintl =
-      List.map_append (fun db ->
-	let flags = auto_flags_of_state (Hint_db.transparent_state db) in
-	  List.map (fun x -> flags, x) (hint_of_db db)) (local_db::db_list)
-  in
-  let tac_of_hint =
-    fun (st, {pri = b; pat = p; code = t; poly = poly}) ->
-      let b = match Hints.repr_hint t with
-      | Unfold_nth _ -> 1
-      | _ -> b
-      in
-      (b,
-        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) -> e_exact poly st (c,cl)
-        | Res_pf_THEN_trivial_fail (term,cl) ->
-          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 = 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 =
-  let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try priority (e_my_find_search db_list local_db hd gl)
-  with Not_found -> []
-
-let e_possible_resolve db_list local_db 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)
-  with Not_found -> []
-
-let find_first_goal gls =
-  try first_goal gls with UserError _ -> assert false
-
-(*s The following module [SearchProblem] is used to instantiate the generic
-    exploration functor [Explore.Make]. *)
-
-type search_state = {
-  priority : int;
-  depth : int; (*r depth of search before failing *)
-  tacres : goal list sigma;
-  last_tactic : std_ppcmds Lazy.t;
-  dblist : hint_db list;
-  localdb :  hint_db list;
-  prev : prev_search_state;
-  local_lemmas : Tacexpr.delayed_open_constr list;
-}
-
-and prev_search_state = (* for info eauto *)
-  | Unknown
-  | Init
-  | State of search_state
-
-module SearchProblem = struct
-
-  type state = search_state
-
-  let success s = List.is_empty (sig_it s.tacres)
-
-(*   let pr_ev evs ev = Printer.pr_constr_env (Evd.evar_env ev) (Evarutil.nf_evar evs ev.Evd.evar_concl) *)
-
-  let filter_tactics glls l =
-(*     let _ = Proof_trees.db_pr_goal (List.hd (sig_it glls)) in *)
-(*     let evars = Evarutil.nf_evars (Refiner.project glls) in *)
-(*     msg (str"Goal:" ++ pr_ev evars (List.hd (sig_it glls)) ++ str"\n"); *)
-    let rec aux = function
-      | [] -> []
-      | (tac, cost, pptac) :: tacl ->
-	  try
-	    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
-            Refiner.catch_failerror e; aux tacl
-    in aux l
-
-  (* Ordering of states is lexicographic on depth (greatest first) then
-     number of remaining goals. *)
-  let compare s s' =
-    let d = s'.depth - s.depth in
-    let d' = Int.compare s.priority s'.priority in
-    let nbgoals s = List.length (sig_it s.tacres) in
-    if not (Int.equal d 0) then d
-    else if not (Int.equal d' 0) then d'
-    else Int.compare (nbgoals s) (nbgoals s')
-
-  let branching s =
-    if Int.equal s.depth 0 then
-      []
-    else
-      let ps = if s.prev == Unknown then Unknown else State s in
-      let lg = s.tacres in
-      let nbgl = List.length (sig_it lg) in
-      assert (nbgl > 0);
-      let g = find_first_goal lg 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 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;
-				    localdb = List.tl s.localdb;
-				    prev = ps; local_lemmas = s.local_lemmas}) l
-      in
-      let intro_tac =
-        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
-	     let hintl =
-	       make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
-	     in
-             let ldb = Hint_db.add_list (pf_env g') (project g')
-		  hintl (List.hd s.localdb) in
-	     { depth = s.depth; priority = cost; tacres = lgls;
-	       last_tactic = pp; dblist = s.dblist;
-	       localdb = ldb :: List.tl s.localdb; prev = ps;
-               local_lemmas = s.local_lemmas})
-	  l
-      in
-      let rec_tacs =
-	let l =
-	  filter_tactics s.tacres (e_possible_resolve s.dblist (List.hd s.localdb) (pf_concl g))
-	in
-	List.map
-	  (fun (lgls, cost, pp) ->
-	     let nbgl' = List.length (sig_it lgls) in
-	     if nbgl' < nbgl then
-	       { depth = s.depth; priority = cost; tacres = lgls; last_tactic = pp;
-                  prev = ps; dblist = s.dblist; localdb = List.tl s.localdb;
-                  local_lemmas = s.local_lemmas }
-	     else
-	       let newlocal = 
-		 let hyps = pf_hyps g in
-		   List.map (fun gl ->
-		     let gls = {Evd.it = gl; sigma = lgls.Evd.sigma } in
-		     let hyps' = pf_hyps gls in
-		       if hyps' == hyps then List.hd s.localdb
-		       else make_local_hint_db (pf_env gls) (project gls) ~ts:full_transparent_state true s.local_lemmas)
-		     (List.firstn ((nbgl'-nbgl) + 1) (sig_it lgls))
-	       in
-		 { depth = pred s.depth; priority = cost; tacres = lgls;
-		   dblist = s.dblist; last_tactic = pp; prev = ps;
-		   localdb = newlocal @ List.tl s.localdb;
-                   local_lemmas = s.local_lemmas })
-	  l
-      in
-      List.sort compare (assumption_tacs @ intro_tac @ rec_tacs)
-
-  let pp s = hov 0 (str " depth=" ++ int s.depth ++ spc () ++
-		      (Lazy.force s.last_tactic))
-
-end
-
-module Search = Explore.Make(SearchProblem)
-
-(** Utilities for debug eauto / info eauto *)
-
-let global_debug_eauto = ref false
-let global_info_eauto = ref false
-
-let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
-      Goptions.optname  = "Debug Eauto";
-      Goptions.optkey   = ["Debug";"Eauto"];
-      Goptions.optread  = (fun () -> !global_debug_eauto);
-      Goptions.optwrite = (:=) global_debug_eauto }
-
-let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
-      Goptions.optname  = "Info Eauto";
-      Goptions.optkey   = ["Info";"Eauto"];
-      Goptions.optread  = (fun () -> !global_info_eauto);
-      Goptions.optwrite = (:=) global_info_eauto }
-
-let mk_eauto_dbg d =
-  if d == Debug || !global_debug_eauto then Debug
-  else if d == Info || !global_info_eauto then Info
-  else Off
-
-let pr_info_nop = function
-  | Info -> msg_debug (str "idtac.")
-  | _ -> ()
-
-let pr_dbg_header = function
-  | Off -> ()
-  | Debug -> msg_debug (str "(* debug eauto : *)")
-  | Info -> msg_debug (str "(* info eauto : *)")
-
-let pr_info dbg s =
-  if dbg != Info then ()
-  else
-    let rec loop s =
-      match s.prev with
-	| Unknown | Init -> s.depth
-	| 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 ".");
-	  mindepth
-    in
-    ignore (loop s)
-
-(** Eauto main code *)
-
-let make_initial_state dbg n gl dblist localdb lems =
-  { depth = n;
-    priority = 0;
-    tacres = tclIDTAC gl;
-    last_tactic = lazy (mt());
-    dblist = dblist;
-    localdb = [localdb];
-    prev = if dbg == Info then Init else Unknown;
-    local_lemmas = lems;
-  }
-
-let e_search_auto debug (in_depth,p) lems db_list gl =
-  let local_db = make_local_hint_db (pf_env gl) (project gl) ~ts:full_transparent_state true lems in
-  let d = mk_eauto_dbg debug in
-  let tac = match in_depth,d with
-    | (true,Debug) -> Search.debug_depth_first
-    | (true,_) -> Search.depth_first
-    | (false,Debug) -> Search.debug_breadth_first
-    | (false,_) -> Search.breadth_first
-  in
-  try
-    pr_dbg_header d;
-    let s = tac (make_initial_state d p gl db_list local_db lems) in
-    pr_info d s;
-    s.tacres
-  with Not_found ->
-    pr_info_nop d;
-    error "eauto: search failed"
-
-(* let e_search_auto_key = Profile.declare_profile "e_search_auto" *)
-(* let e_search_auto = Profile.profile5 e_search_auto_key e_search_auto *)
-
-let eauto_with_bases ?(debug=Off) np lems db_list =
-  tclTRY (e_search_auto debug np lems db_list)
-
-let eauto ?(debug=Off) np lems dbnames =
-  let db_list = make_db_list dbnames in
-  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
-  tclTRY (e_search_auto debug n lems db_list) gl
-
-let gen_eauto ?(debug=Off) np lems = function
-  | 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 d -> d
-
-let make_dimension n = function
-  | None -> (true,make_depth n)
-  | Some d -> (false,d)
-
-let cons a l = a :: l
-
-let autounfolds db occs cls gl =
-  let unfolds = List.concat (List.map (fun dbname -> 
-    let db = try searchtable_map dbname 
-      with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
-    in
-    let (ids, csts) = Hint_db.unfolds db in
-    let hyps = pf_ids_of_hyps gl in
-    let ids = Idset.filter (fun id -> List.mem id hyps) ids in
-      Cset.fold (fun cst -> cons (AllOccurrences, EvalConstRef cst)) csts
-	(Id.Set.fold (fun id -> cons (AllOccurrences, EvalVarRef id)) ids [])) db)
-  in Proofview.V82.of_tactic (unfold_option unfolds cls) gl
-
-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 =
-  Proofview.tclUNIT () >>= fun () ->
-  let dbs = match db with
-  | None -> String.Set.elements (current_db_names ())
-  | Some [] -> ["core"]
-  | Some l -> l
-  in
-  autounfold dbs cls
-
-let unfold_head env (ids, csts) c = 
-  let rec aux c = 
-    match kind_of_term c with
-    | Var id when Id.Set.mem id ids ->
-	(match Environ.named_body id env with
-	| Some b -> true, b
-	| None -> false, c)
-    | Const (cst,u as c) when Cset.mem cst csts ->
-	true, Environ.constant_value_in env c
-    | App (f, args) ->
-	(match aux f with
-	| true, f' -> true, Reductionops.whd_betaiota Evd.empty (mkApp (f', args))
-	| false, _ -> 
-	    let done_, args' = 
-	      Array.fold_left_i (fun i (done_, acc) arg -> 
-		if done_ then done_, arg :: acc 
-		else match aux arg with
-		| true, arg' -> true, arg' :: acc
-		| false, arg' -> false, arg :: acc)
-		(false, []) args
-	    in 
-	      if done_ then true, mkApp (f, Array.of_list (List.rev args'))
-	      else false, c)
-    | _ -> 
-	let done_ = ref false in
-	let c' = map_constr (fun c -> 
-	  if !done_ then c else 
-	    let x, c' = aux c in
-	      done_ := x; c') c
-	in !done_, c'
-  in aux c
-
-let autounfold_one db cl =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let concl = Proofview.Goal.concl gl in
-  let st =
-    List.fold_left (fun (i,c) dbname -> 
-      let db = try searchtable_map dbname 
-	with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
-      in
-      let (ids, csts) = Hint_db.unfolds db in
-	(Id.Set.union ids i, Cset.union csts c)) (Id.Set.empty, Cset.empty) db
-  in
-  let did, c' = unfold_head env st 
-    (match cl with Some (id, _) -> Tacmach.New.pf_get_hyp_typ id gl | None -> concl) 
-  in
-    if did then
-      match cl with
-      | 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 }
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
deleted file mode 100644
index 8812093d5..000000000
--- a/tactics/eauto.mli
+++ /dev/null
@@ -1,33 +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 Term
-open Proof_type
-open Hints
-
-val e_assumption : unit Proofview.tactic
-
-val registered_e_assumption : unit Proofview.tactic
-
-val e_give_exact : ?flags:Unification.unify_flags -> constr -> unit Proofview.tactic
-
-val prolog_tac : Tacexpr.delayed_open_constr list -> int -> unit Proofview.tactic
-
-val 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 ->
-  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 make_dimension : int option -> int option -> bool * int
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
deleted file mode 100644
index 7d0df2f52..000000000
--- a/tactics/eqdecide.ml
+++ /dev/null
@@ -1,225 +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                        *)
-(************************************************************************)
-
-open Errors
-open Util
-open Names
-open Namegen
-open Term
-open Declarations
-open Tactics
-open Tacticals.New
-open Auto
-open Constr_matching
-open Hipattern
-open Tacmach.New
-open Coqlib
-open Proofview.Notations
-
-(* This file containts the implementation of the tactics ``Decide
-   Equality'' and ``Compare''. They can be used to decide the
-   propositional equality of two objects that belongs to a small
-   inductive datatype --i.e., an inductive set such that all the
-   arguments of its constructors are non-functional sets.
-
-   The procedure for proving (x,y:R){x=y}+{~x=y} can be scketched as
-   follows:
-   1. Eliminate x and then y.
-   2. Try discrimination to solve those goals where x and y has
-      been introduced by different constructors.
-   3. If x and y have been introduced by the same constructor,
-      then analyse one by one the corresponding pairs of arguments.
-      If they are equal, rewrite one into the other. If they are
-      not, derive a contradiction from the injectiveness of the
-      constructor.
-   4. Once all the arguments have been rewritten, solve the remaining half
-      of the disjunction by reflexivity.
-
-   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 =
-  if eqonleft then
-    left_with_bindings false Misctypes.NoBindings
-  else
-    right_with_bindings false Misctypes.NoBindings
-let choose_noteq eqonleft =
-  if eqonleft then
-    right_with_bindings false Misctypes.NoBindings
-  else
-    left_with_bindings false Misctypes.NoBindings
-
-let mkBranches c1 c2 =
-  tclTHENLIST
-    [Proofview.V82.tactic (generalize [c2]);
-     Simple.elim c1;
-     intros;
-     onLastHyp Simple.case;
-     clear_last;
-     intros]
-
-let solveNoteqBranch side =
-  tclTHEN (choose_noteq side)
-    (tclTHEN introf
-      (onLastHypId (fun id -> Extratactics.discrHyp id)))
-
-(* Constructs the type {c1=c2}+{~c1=c2} *)
-
-let make_eq () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq ())
-
-let mkDecideEqGoal eqonleft op rectype c1 c2 =
-  let equality    = mkApp(make_eq(), [|rectype; c1; c2|]) in
-  let disequality = mkApp(build_coq_not (), [|equality|]) in
-  if eqonleft then mkApp(op, [|equality; disequality |])
-  else mkApp(op, [|disequality; equality |])
-
-
-(* Constructs the type (x1,x2:R){x1=x2}+{~x1=x2} *)
-
-let idx = Id.of_string "x"
-let idy = Id.of_string "y"
-
-let mkGenDecideEqGoal rectype g =
-  let hypnames = pf_ids_of_hyps g in
-  let xname    = next_ident_away idx hypnames
-  and yname    = next_ident_away idy hypnames in
-  (mkNamedProd xname rectype
-     (mkNamedProd yname rectype
-        (mkDecideEqGoal true (build_coq_sumbool ())
-          rectype (mkVar xname) (mkVar yname))))
-
-let rec rewrite_and_clear hyps = match hyps with
-| [] -> Proofview.tclUNIT ()
-| id :: hyps ->
-  tclTHENLIST [
-    Equality.rewriteLR (mkVar id);
-    clear [id];
-    rewrite_and_clear hyps;
-  ]
-
-let eqCase tac =
-  tclTHEN intro (onLastHypId 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  (red_in_concl)
-  (tclTHEN  (intro_using absurd)
-  (tclTHEN  (Simple.apply (mkVar diseq))
-  (tclTHEN  (Extratactics.injHyp absurd)
-            (full_trivial []))))))))
-
-open Proofview.Notations
-
-(* spiwack: a small wrapper around [Hipattern]. *)
-
-let match_eqdec c =
-  try Proofview.tclUNIT (match_eqdec c)
-  with PatternMatchingFailure -> Proofview.tclZERO PatternMatchingFailure
-
-(* /spiwack *)
-
-let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
-| [], [] ->
-  tclTHENLIST [
-    choose_eq eqonleft;
-    rewrite_and_clear (List.rev hyps);
-    intros_reflexivity;
-  ]
-| a1 :: largs, a2 :: rargs ->
-  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
-  let subtacs =
-    if eqonleft then [eqCase tac;diseqCase hyps eqonleft;default_auto]
-    else [diseqCase hyps eqonleft;eqCase tac;default_auto] in
-  (tclTHENS (elim_type decide) subtacs)
-  end }
-| _ -> invalid_arg "List.fold_right2"
-
-let solveEqBranch rectype =
-  Proofview.tclORELSE
-    begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,op,lhs,rhs,_) ->
-          let (mib,mip) = Global.lookup_inductive rectype in
-          let nparams   = mib.mind_nparams in
-          let getargs l = List.skipn nparams (snd (decompose_app l)) in
-          let rargs   = getargs rhs
-          and largs   = getargs lhs in
-          solveArg [] eqonleft op largs rargs
-      end }
-    end
-    begin function (e, info) -> match e with
-      | PatternMatchingFailure -> Tacticals.New.tclZEROMSG (Pp.str"Unexpected conclusion!")
-      | e -> Proofview.tclZERO ~info e
-    end
-
-(* The tactic Decide Equality *)
-
-let hd_app c = match kind_of_term c with
-  | App (h,_) -> h
-  | _ -> c
-
-let decideGralEquality =
-  Proofview.tclORELSE
-    begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,_,c1,c2,typ) ->
-        let headtyp = hd_app (pf_compute gl typ) in
-        begin match kind_of_term headtyp with
-        | Ind (mi,_) -> Proofview.tclUNIT mi
-        | _ -> tclZEROMSG (Pp.str"This decision procedure only works for inductive objects.")
-        end >>= fun rectype ->
-          (tclTHEN
-             (mkBranches c1 c2)
-             (tclORELSE (solveNoteqBranch eqonleft) (solveEqBranch rectype)))
-      end }
-    end
-    begin function (e, info) -> match e with
-      | PatternMatchingFailure ->
-          Tacticals.New.tclZEROMSG (Pp.str"The goal must be of the form {x<>y}+{x=y} or {x=y}+{x<>y}.")
-      | e -> Proofview.tclZERO ~info e
-    end
-
-let decideEqualityGoal = tclTHEN intros decideGralEquality
-
-let decideEquality rectype =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let decide = mkGenDecideEqGoal rectype gl in
-  (tclTHENS (cut decide) [default_auto;decideEqualityGoal])
-  end }
-
-
-(* The tactic Compare *)
-
-let compare c1 c2 =
-  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 }
diff --git a/tactics/eqdecide.mli b/tactics/eqdecide.mli
deleted file mode 100644
index cb48a5bcc..000000000
--- a/tactics/eqdecide.mli
+++ /dev/null
@@ -1,17 +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                        *)
-(************************************************************************)
-
-val decideEqualityGoal : unit Proofview.tactic
-
-val compare : Constr.t -> Constr.t -> unit Proofview.tactic
diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml
deleted file mode 100644
index 2e0996bf5..000000000
--- a/tactics/evar_tactics.ml
+++ /dev/null
@@ -1,91 +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
-open Sigma.Notations
-open Proofview.Notations
-open Context.Named.Declaration
-
-(* 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
-                    | LocalAssum (_,typ) -> evar_list typ
-		    | _ -> error
-			"Please be more specific: in type or value?")
-	      | InHypTypeOnly ->
-		  evar_list (get_type decl)
-	      | InHypValueOnly ->
-		  (match decl with
-		    | LocalDef (_,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.s_enter { s_enter = begin fun gl ->
-    let sigma = Tacmach.New.project gl in
-    let env = Proofview.Goal.env gl in
-    let sigma = ref sigma in
-    let _ = Typing.e_sort_of env sigma typ in
-    let sigma = Sigma.Unsafe.of_evar_map !sigma 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, sigma, p) = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
-    let tac =
-      (Tactics.letin_tac None (Names.Name id) evar None Locusops.nowhere)
-    in
-    Sigma (tac, sigma, p)
-  end }
diff --git a/tactics/evar_tactics.mli b/tactics/evar_tactics.mli
deleted file mode 100644
index e67540c05..000000000
--- 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 d33ec91f9..000000000
--- a/tactics/extraargs.ml4
+++ /dev/null
@@ -1,345 +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 Stdarg
-open Constrarg
-open Pcoq.Prim
-open Pcoq.Constr
-open Names
-open Tacexpr
-open Taccoerce
-open Tacinterp
-open Misctypes
-open Locus
-
-(** Adding scopes for generic arguments not defined through ARGUMENT EXTEND *)
-
-let create_generic_quotation name e wit =
-  let inject (loc, v) = Tacexpr.TacGeneric (Genarg.in_gen (Genarg.rawwit wit) v) in
-  Egramcoq.create_ltac_quotation name inject (e, None)
-
-let () = create_generic_quotation "integer" Pcoq.Prim.integer Stdarg.wit_int
-let () = create_generic_quotation "string" Pcoq.Prim.string Stdarg.wit_string
-
-let () = create_generic_quotation "ident" Pcoq.Prim.ident Constrarg.wit_ident
-let () = create_generic_quotation "reference" Pcoq.Prim.reference Constrarg.wit_ref
-let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Constrarg.wit_uconstr
-let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Constrarg.wit_constr
-let () = create_generic_quotation "ipattern" Pcoq.Tactic.simple_intropattern Constrarg.wit_intro_pattern
-let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Constrarg.wit_open_constr
-let () =
-  let inject (loc, v) = Tacexpr.Tacexp v in
-  Egramcoq.create_ltac_quotation "ltac" inject (Pcoq.Tactic.tactic_expr, Some 5)
-
-(* 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_int _ _ _ i = Pp.int i
-
-let _natural = Pcoq.Prim.natural
-
-ARGUMENT EXTEND natural TYPED AS int PRINTED BY pr_int
-| [ _natural(i) ] -> [ i ]
-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 pr_lconstr _ prc _ c = prc c
-
-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
-
-let l_constr = Pcoq.Constr.lconstr
-
-ARGUMENT EXTEND lconstr
-    TYPED AS constr
-    PRINTED BY pr_lconstr
-  [ l_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 14aa69875..000000000
--- a/tactics/extraargs.mli
+++ /dev/null
@@ -1,66 +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_natural : int Genarg.uniform_genarg_type
-
-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 wit_lconstr :
-  (constr_expr,
-  Tacexpr.glob_constr_and_expr,
-  Constr.t) 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,
-  Genarg.Val.t 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 23aa8dcb4..000000000
--- a/tactics/extratactics.ml4
+++ /dev/null
@@ -1,1048 +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 Stdarg
-open Constrarg
-open Extraargs
-open Pcoq.Prim
-open Pcoq.Constr
-open Pcoq.Tactic
-open Mod_subst
-open Names
-open Tacexpr
-open Glob_ops
-open Tactics
-open Errors
-open Util
-open Evd
-open Termops
-open Equality
-open Misctypes
-open Sigma.Notations
-open Proofview.Notations
-
-DECLARE PLUGIN "extratactics"
-
-(**********************************************************************)
-(* replace, discriminate, injection, simplify_eq                      *)
-(* cutrewrite, dependent rewrite                                      *)
-
-let with_delayed_uconstr ist c tac =
-  let flags = {
-    Pretyping.use_typeclasses = false;
-    use_unif_heuristics = true;
-    use_hook = Some Pfedit.solve_by_implicit_tactic;
-    fail_evar = false;
-    expand_evars = true
-  } in
-  let c = Tacinterp.type_uconstr ~flags ist c in
-  Tacticals.New.tclDELAYEDWITHHOLES false c tac
-
-let replace_in_clause_maybe_by ist c1 c2 cl tac =
-  with_delayed_uconstr ist c1
-  (fun c1 -> replace_in_clause_maybe_by c1 c2 cl (Option.map (Tacinterp.tactic_of_value ist) tac))
-
-let replace_term ist dir_opt c cl =
-  with_delayed_uconstr ist c (fun c -> replace_term dir_opt c cl)
-
-let clause = Pcoq.Tactic.clause_dft_concl
-
-TACTIC EXTEND replace
-   ["replace" uconstr(c1) "with" constr(c2) clause(cl) by_arg_tac(tac) ]
--> [ replace_in_clause_maybe_by ist c1 c2 cl tac ]
-END
-
-TACTIC EXTEND replace_term_left
-  [ "replace"  "->" uconstr(c) clause(cl) ]
-  -> [ replace_term ist (Some true) c cl ]
-END
-
-TACTIC EXTEND replace_term_right
-  [ "replace"  "<-" uconstr(c) clause(cl) ]
-  -> [ replace_term ist (Some false) c cl ]
-END
-
-TACTIC EXTEND replace_term
-  [ "replace" uconstr(c) clause(cl) ]
-  -> [ replace_term ist 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.tclDELAYEDWITHHOLES with_evars c
-    (fun c -> tac with_evars (Some (None,ElimOnConstr c)))
-
-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 { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) 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" intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) false c ]
-END
-TACTIC EXTEND injection_as
-| [ "injection" "as" intropattern_list(ipat)] ->
-    [ injClause (Some ipat) false None ]
-| [ "injection" quantified_hypothesis(h) "as" 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" intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) true c ]
-END
-TACTIC EXTEND einjection_as
-| [ "einjection" "as" intropattern_list(ipat)] ->
-    [ injClause (Some ipat) true None ]
-| [ "einjection" quantified_hypothesis(h) "as" intropattern_list(ipat) ] ->
-    [ injClause (Some ipat) true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-
-let injHyp id =
-  Proofview.tclEVARMAP >>= fun sigma ->
-  injection_main { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) 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.tclDELAYEDWITHHOLES false c (fun c -> tac (Some c))
-
-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.tactic_of_value ist 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.tactic_of_value ist t) l cl ]
-END
-
-(**********************************************************************)
-(* Rewrite star                                                       *)
-
-let rewrite_star ist clause orient occs c (tac : Val.t option) =
-  let tac' = Option.map (fun t -> Tacinterp.tactic_of_value ist t, FirstSolved) tac in
-  with_delayed_uconstr ist c
-    (fun c -> general_rewrite_ebindings_clause clause orient occs ?tac:tac' true true (c,NoBindings) true)
-
-TACTIC EXTEND rewrite_star
-| [ "rewrite" "*" orient(o) uconstr(c) "in" hyp(id) "at" occurrences(occ) by_arg_tac(tac) ] ->
-    [ rewrite_star ist (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) uconstr(c) "at" occurrences(occ) "in" hyp(id) by_arg_tac(tac) ] ->
-    [ rewrite_star ist (Some id) o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) uconstr(c) "in" hyp(id) by_arg_tac(tac) ] ->
-    [ rewrite_star ist (Some id) o Locus.AllOccurrences c tac ]
-| [ "rewrite" "*" orient(o) uconstr(c) "at" occurrences(occ) by_arg_tac(tac) ] ->
-    [ rewrite_star ist None o (occurrences_of occ) c tac ]
-| [ "rewrite" "*" orient(o) uconstr(c) by_arg_tac(tac) ] ->
-    [ rewrite_star ist 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 = UState.context_set 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, Context.Rel.to_extended_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 ist simple c =
-  Proofview.Goal.nf_enter { 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 expected_type = Pretyping.OfType concl in
-    let c = Tacinterp.type_uconstr ~flags ~expected_type ist c in
-    let update = { run = fun sigma -> c.delayed env sigma } in
-    let refine = 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 ist false c ]
-END
-
-TACTIC EXTEND simple_refine
-| [ "simple" "refine" uconstr(c) ] -> [ refine_tac ist 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.tactic_of_value ist tac) ]
-| ["stepl" constr(c) ] -> [ step true c (Proofview.tclUNIT ()) ]
-END
-
-TACTIC EXTEND stepr
-| ["stepr" constr(c) "by" tactic(tac) ] -> [ step false c (Tacinterp.tactic_of_value ist 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 hResolve id c occ t =
-  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 = 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
-  let tac =
-    (change_concl (mkLetIn (Anonymous,t_constr,t_constr_type,concl)))
-  in
-  Sigma.Unsafe.of_pair (tac, sigma)
-  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 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 { enter = begin fun gl ->
-  let sigma = Tacmach.New.project 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 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 { 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 { 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.generalize [mkApp(delayed_force refl_equal, [| type_of_a; a|])]);
-          Proofview.Goal.nf_enter { enter = begin fun gl ->
-            let concl = Proofview.Goal.concl gl in
-            let env = Proofview.Goal.env gl in
-            (** FIXME: this looks really wrong. Does anybody really use this tactic? *)
-            let Sigma (c, _, _) = (Tacred.pattern_occs [Locus.OnlyOccurrences [1], a]).Reductionops.e_redfun env (Sigma.Unsafe.of_evar_map Evd.empty) concl in
-	    change_concl c
-          end };
-	  simplest_case a]
-  end }
-
-
-let case_eq_intros_rewrite x =
-  Proofview.Goal.nf_enter { 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 { 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 =
-  let cl = induction_arg_of_quantified_hyp (NamedHyp (Id.of_string "x")) in
-  let cl = [cl, (None, None), None], None in
-  let dest = TacAtom (Loc.ghost, TacInductionDestruct(false, false, cl)) in
-  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 dest))
-	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 { 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 { enter = begin fun gl -> destauto (Proofview.Goal.concl gl) end } ]
-| [ "destauto" "in" hyp(id) ] -> [ destauto_in id ]
-END
-
-
-(* ********************************************************************* *)
-
-let eq_constr x y = 
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let evd = Tacmach.New.project gl in
-      if Evarutil.eq_constr_univs_test evd evd x y then Proofview.tclUNIT () 
-      else Tacticals.New.tclFAIL 0 (str "Not equal")
-  end }
-
-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.tactic_of_value ist 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 n ]
-END
-
-(* swaps goals number [i] and [j] *)
-TACTIC EXTEND swap
-| [ "swap" int_or_var(i) int_or_var(j) ] -> [ Proofview.swap i 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 "cmp"
-let wit_test : (int or_var test,int or_var test,int test) Genarg.genarg_type =
-  Genarg.make0 "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 { 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 18334dafe..000000000
--- 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 Tacexpr.delayed_open option -> unit Proofview.tactic
diff --git a/tactics/g_auto.ml4 b/tactics/g_auto.ml4
deleted file mode 100644
index 788443944..000000000
--- a/tactics/g_auto.ml4
+++ /dev/null
@@ -1,211 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
-(*   \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 Stdarg
-open Constrarg
-open Pcoq.Prim
-open Pcoq.Constr
-open Pcoq.Tactic
-open Tacexpr
-
-DECLARE PLUGIN "g_auto"
-
-(* Hint bases *)
-
-
-TACTIC EXTEND eassumption
-| [ "eassumption" ] -> [ Eauto.e_assumption ]
-END
-
-TACTIC EXTEND eexact
-| [ "eexact" constr(c) ] -> [ Eauto.e_give_exact c ]
-END
-
-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 eval_uconstrs ist cs =
-  let flags = {
-    Pretyping.use_typeclasses = false;
-    use_unif_heuristics = true;
-    use_hook = Some Pfedit.solve_by_implicit_tactic;
-    fail_evar = false;
-    expand_evars = true
-  } in
-  List.map (fun c -> Tacinterp.type_uconstr ~flags ist c) cs
-
-let pr_auto_using _ _ _ = Pptactic.pr_auto_using (fun _ -> mt ())
-
-ARGUMENT EXTEND auto_using
-  TYPED AS uconstr_list
-  PRINTED BY pr_auto_using
-| [ "using" ne_uconstr_list_sep(l, ",") ] -> [ l ]
-| [ ] -> [ [] ]
-END
-
-(** Auto *)
-
-TACTIC EXTEND trivial
-| [ "trivial" auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_trivial (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND info_trivial
-| [ "info_trivial" auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_trivial ~debug:Info (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND debug_trivial
-| [ "debug" "trivial" auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_trivial ~debug:Debug (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND auto
-| [ "auto" int_or_var_opt(n) auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_auto n (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND info_auto
-| [ "info_auto" int_or_var_opt(n) auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_auto ~debug:Info n (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND debug_auto
-| [ "debug" "auto" int_or_var_opt(n) auto_using(lems) hintbases(db) ] ->
-    [ Auto.h_auto ~debug:Debug n (eval_uconstrs ist lems) db ]
-END
-
-(** Eauto *)
-
-TACTIC EXTEND prolog
-| [ "prolog" "[" uconstr_list(l) "]" int_or_var(n) ] ->
-    [ Eauto.prolog_tac (eval_uconstrs ist l) n ]
-END
-
-let make_depth n = snd (Eauto.make_dimension n None)
-
-TACTIC EXTEND eauto
-| [ "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Eauto.gen_eauto (Eauto.make_dimension n p) (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND new_eauto
-| [ "new" "auto" int_or_var_opt(n) auto_using(lems)
-    hintbases(db) ] ->
-    [ match db with
-      | None -> Auto.new_full_auto (make_depth n) (eval_uconstrs ist lems)
-      | Some l -> Auto.new_auto (make_depth n) (eval_uconstrs ist lems) l ]
-END
-
-TACTIC EXTEND debug_eauto
-| [ "debug" "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Eauto.gen_eauto ~debug:Debug (Eauto.make_dimension n p) (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND info_eauto
-| [ "info_eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems)
-    hintbases(db) ] ->
-    [ Eauto.gen_eauto ~debug:Info (Eauto.make_dimension n p) (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND dfs_eauto
-| [ "dfs" "eauto" int_or_var_opt(p) auto_using(lems)
-      hintbases(db) ] ->
-    [ Eauto.gen_eauto (Eauto.make_dimension p None) (eval_uconstrs ist lems) db ]
-END
-
-TACTIC EXTEND autounfold
-| [ "autounfold" hintbases(db) clause_dft_concl(cl) ] -> [ Eauto.autounfold_tac db cl ]
-END
-
-TACTIC EXTEND autounfold_one
-| [ "autounfold_one" hintbases(db) "in" hyp(id) ] ->
-    [ Eauto.autounfold_one (match db with None -> ["core"] | Some x -> "core"::x) (Some (id, Locus.InHyp)) ]
-| [ "autounfold_one" hintbases(db) ] ->
-    [ Eauto.autounfold_one (match db with None -> ["core"] | Some x -> "core"::x) None ]
-      END
-
-TACTIC EXTEND autounfoldify
-| [ "autounfoldify" constr(x) ] -> [
-    let db = match Term.kind_of_term x with
-      | Term.Const (c,_) -> Names.Label.to_string (Names.con_label c)
-      | _ -> assert false
-    in Eauto.autounfold ["core";db] Locusops.onConcl 
-  ]
-END
-
-TACTIC EXTEND unify
-| ["unify" constr(x) constr(y) ] -> [ Tactics.unify x y ]
-| ["unify" constr(x) constr(y) "with" preident(base)  ] -> [
-    let table = try Some (Hints.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 = Hints.Hint_db.transparent_state t in
-      Tactics.unify ~state x y
-  ]
-END
-
-
-TACTIC EXTEND convert_concl_no_check
-| ["convert_concl_no_check" constr(x) ] -> [ Tactics.convert_concl_no_check x Term.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) ] -> [ Hints.PathHints (List.map Nametab.global g) ]
-| [ "*" ] -> [ Hints.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)  ] -> [ Hints.PathStar p ]
-| [ "emp" ] -> [ Hints.PathEmpty ]
-| [ "eps" ] -> [ Hints.PathEpsilon ]
-| [ hints_path_atom(a) ] -> [ Hints.PathAtom a ]
-| [ hints_path(p) "|" hints_path(q) ] -> [ Hints.PathOr (p, q) ]
-| [ hints_path(p) ";" hints_path(q) ] -> [ Hints.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 = Hints.HintsCutEntry p in
-    Hints.add_hints (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
-      (match dbnames with None -> ["core"] | Some l -> l) entry ]
-END
diff --git a/tactics/g_class.ml4 b/tactics/g_class.ml4
deleted file mode 100644
index 9ef154541..000000000
--- a/tactics/g_class.ml4
+++ /dev/null
@@ -1,89 +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
-open Pcoq.Prim
-open Pcoq.Constr
-open Pcoq.Tactic
-open Stdarg
-open Constrarg
-
-DECLARE PLUGIN "g_class"
-
-TACTIC EXTEND progress_evars
-  [ "progress_evars" tactic(t) ] -> [ progress_evars (Tacinterp.tactic_of_value ist 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 905653281..000000000
--- 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_ltac.ml4 b/tactics/g_ltac.ml4
deleted file mode 100644
index b55ac9ad0..000000000
--- a/tactics/g_ltac.ml4
+++ /dev/null
@@ -1,430 +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 Pp
-open Compat
-open Constrexpr
-open Tacexpr
-open Misctypes
-open Genarg
-open Genredexpr
-open Tok (* necessary for camlp4 *)
-
-open Pcoq
-open Pcoq.Prim
-open Pcoq.Tactic
-
-let fail_default_value = ArgArg 0
-
-let arg_of_expr = function
-    TacArg (loc,a) -> a
-  | e -> Tacexp (e:raw_tactic_expr)
-
-let genarg_of_unit () = in_gen (rawwit Stdarg.wit_unit) ()
-let genarg_of_int n = in_gen (rawwit Stdarg.wit_int) n
-let genarg_of_ipattern pat = in_gen (rawwit Constrarg.wit_intro_pattern) pat
-let genarg_of_uconstr c = in_gen (rawwit Constrarg.wit_uconstr) c
-
-let reference_to_id = function
-  | Libnames.Ident (loc, id) -> (loc, id)
-  | Libnames.Qualid (loc,_) ->
-      Errors.user_err_loc (loc, "",
-        str "This expression should be a simple identifier.")
-
-let tactic_mode = Gram.entry_create "vernac:tactic_command"
-
-let new_entry name =
-  let e = Gram.entry_create name in
-  let entry = Entry.create name in
-  let () = Pcoq.set_grammar entry e in
-  e
-
-let selector = new_entry "vernac:selector"
-let tacdef_body = new_entry "tactic:tacdef_body"
-
-(* Registers the Classic Proof Mode (which uses [tactic_mode] as a parser for
-    proof editing and changes nothing else). Then sets it as the default proof mode. *)
-let _ =
-  let mode = {
-    Proof_global.name = "Classic";
-    set = (fun () -> set_command_entry tactic_mode);
-    reset = (fun () -> set_command_entry Pcoq.Vernac_.noedit_mode);
-  } in
-  Proof_global.register_proof_mode mode
-
-(* Hack to parse "[ id" without dropping [ *)
-let test_bracket_ident =
-  Gram.Entry.of_parser "test_bracket_ident"
-    (fun strm ->
-      match get_tok (stream_nth 0 strm) with
-        | KEYWORD "[" ->
-            (match get_tok (stream_nth 1 strm) with
-              | IDENT _ -> ()
-	      | _ -> raise Stream.Failure)
-	| _ -> raise Stream.Failure)
-
-(* Tactics grammar rules *)
-
-GEXTEND Gram
-  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg
-          tactic_mode constr_may_eval constr_eval selector;
-
-  tactic_then_last:
-    [ [ "|"; lta = LIST0 OPT tactic_expr SEP "|" ->
-          Array.map (function None -> TacId [] | Some t -> t) (Array.of_list lta)
-      | -> [||]
-    ] ]
-  ;
-  tactic_then_gen:
-    [ [ ta = tactic_expr; "|"; (first,last) = tactic_then_gen -> (ta::first, last)
-      | ta = tactic_expr; ".."; l = tactic_then_last -> ([], Some (ta, l))
-      | ".."; l = tactic_then_last -> ([], Some (TacId [], l))
-      | ta = tactic_expr -> ([ta], None)
-      | "|"; (first,last) = tactic_then_gen -> (TacId [] :: first, last)
-      | -> ([TacId []], None)
-    ] ]
-  ;
-  tactic_then_locality: (* [true] for the local variant [TacThens] and [false]
-                           for [TacExtend] *)
-  [ [ "[" ; l = OPT">" -> if Option.is_empty l then true else false ] ]
-  ;
-  tactic_expr:
-    [ "5" RIGHTA
-      [ te = binder_tactic -> te ]
-    | "4" LEFTA
-      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, ta1)
-      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0,ta1)
-      | ta0 = tactic_expr; ";"; l = tactic_then_locality; (first,tail) = tactic_then_gen; "]" ->
-	  match l , tail with
-          | false , Some (t,last) -> TacThen (ta0,TacExtendTac (Array.of_list first, t, last))
-	  | true  , Some (t,last) -> TacThens3parts (ta0, Array.of_list first, t, last)
-          | false , None -> TacThen (ta0,TacDispatch first)
-	  | true  , None -> TacThens (ta0,first) ]
-    | "3" RIGHTA
-      [ IDENT "try"; ta = tactic_expr -> TacTry ta
-      | IDENT "do"; n = int_or_var; ta = tactic_expr -> TacDo (n,ta)
-      | IDENT "timeout"; n = int_or_var; ta = tactic_expr -> TacTimeout (n,ta)
-      | IDENT "time"; s = OPT string; ta = tactic_expr -> TacTime (s,ta)
-      | IDENT "repeat"; ta = tactic_expr -> TacRepeat ta
-      | IDENT "progress"; ta = tactic_expr -> TacProgress ta
-      | IDENT "once"; ta = tactic_expr -> TacOnce ta
-      | IDENT "exactly_once"; ta = tactic_expr -> TacExactlyOnce ta
-      | IDENT "infoH"; ta = tactic_expr -> TacShowHyps ta
-(*To do: put Abstract in Refiner*)
-      | IDENT "abstract"; tc = NEXT -> TacAbstract (tc,None)
-      | IDENT "abstract"; tc = NEXT; "using";  s = ident ->
-          TacAbstract (tc,Some s) ]
-(*End of To do*)
-    | "2" RIGHTA
-      [ ta0 = tactic_expr; "+"; ta1 = binder_tactic -> TacOr (ta0,ta1)
-      | ta0 = tactic_expr; "+"; ta1 = tactic_expr -> TacOr (ta0,ta1) 
-      | IDENT "tryif" ; ta = tactic_expr ;
-              "then" ; tat = tactic_expr ;
-              "else" ; tae = tactic_expr -> TacIfThenCatch(ta,tat,tae)
-      | ta0 = tactic_expr; "||"; ta1 = binder_tactic -> TacOrelse (ta0,ta1)
-      | ta0 = tactic_expr; "||"; ta1 = tactic_expr -> TacOrelse (ta0,ta1) ]
-    | "1" RIGHTA
-      [ b = match_key; IDENT "goal"; "with"; mrl = match_context_list; "end" ->
-          TacMatchGoal (b,false,mrl)
-      | b = match_key; IDENT "reverse"; IDENT "goal"; "with";
-        mrl = match_context_list; "end" ->
-          TacMatchGoal (b,true,mrl)
-      |	b = match_key; c = tactic_expr; "with"; mrl = match_list; "end" ->
-          TacMatch (b,c,mrl)
-      | IDENT "first" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacFirst l
-      | IDENT "solve" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacSolve l
-      | IDENT "idtac"; l = LIST0 message_token -> TacId l
-      | g=failkw; n = [ n = int_or_var -> n | -> fail_default_value ];
-	  l = LIST0 message_token -> TacFail (g,n,l)
-      | st = simple_tactic -> st
-      | a = tactic_arg -> TacArg(!@loc,a)
-      | r = reference; la = LIST0 tactic_arg_compat ->
-          TacArg(!@loc,TacCall (!@loc,r,la)) ]
-    | "0"
-      [ "("; a = tactic_expr; ")" -> a
-      | "["; ">"; (tf,tail) = tactic_then_gen; "]" ->
-          begin match tail with
-          | Some (t,tl) -> TacExtendTac(Array.of_list tf,t,tl)
-          | None -> TacDispatch tf
-          end
-      | a = tactic_atom -> TacArg (!@loc,a) ] ]
-  ;
-  failkw:
-  [ [ IDENT "fail" -> TacLocal | IDENT "gfail" -> TacGlobal ] ]
-  ;
-  (* binder_tactic: level 5 of tactic_expr *)
-  binder_tactic:
-    [ RIGHTA
-      [ "fun"; it = LIST1 input_fun ; "=>"; body = tactic_expr LEVEL "5" ->
-          TacFun (it,body)
-      | "let"; isrec = [IDENT "rec" -> true | -> false];
-          llc = LIST1 let_clause SEP "with"; "in";
-          body = tactic_expr LEVEL "5" -> TacLetIn (isrec,llc,body)
-      | IDENT "info"; tc = tactic_expr LEVEL "5" -> TacInfo tc ] ]
-  ;
-  (* Tactic arguments to the right of an application *)
-  tactic_arg_compat:
-    [ [ a = tactic_arg -> a
-      | r = reference -> Reference r
-      | c = Constr.constr -> ConstrMayEval (ConstrTerm c)
-      (* Unambigous entries: tolerated w/o "ltac:" modifier *)
-      | "()" -> TacGeneric (genarg_of_unit ()) ] ]
-  ;
-  (* Can be used as argument and at toplevel in tactic expressions. *)
-  tactic_arg:
-    [ [ c = constr_eval -> ConstrMayEval c
-      | IDENT "fresh"; l = LIST0 fresh_id -> TacFreshId l
-      | IDENT "type_term"; c=uconstr -> TacPretype c
-      | IDENT "numgoals" -> TacNumgoals ] ]
-  ;
-  (* If a qualid is given, use its short name. TODO: have the shortest
-     non ambiguous name where dots are replaced by "_"? Probably too
-     verbose most of the time. *)
-  fresh_id:
-    [ [ s = STRING -> ArgArg s (*| id = ident -> ArgVar (!@loc,id)*)
-	| qid = qualid -> let (_pth,id) = Libnames.repr_qualid (snd qid) in ArgVar (!@loc,id) ] ]
-  ;
-  constr_eval:
-    [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
-          ConstrEval (rtc,c)
-      | IDENT "context"; id = identref; "["; c = Constr.lconstr; "]" ->
-          ConstrContext (id,c)
-      | IDENT "type"; IDENT "of"; c = Constr.constr ->
-          ConstrTypeOf c ] ]
-  ;
-  constr_may_eval: (* For extensions *)
-    [ [ c = constr_eval -> c
-      | c = Constr.constr -> ConstrTerm c ] ]
-  ;
-  tactic_atom:
-    [ [ n = integer -> TacGeneric (genarg_of_int n)
-      | r = reference -> TacCall (!@loc,r,[])
-      | "()" -> TacGeneric (genarg_of_unit ()) ] ]
-  ;
-  match_key:
-    [ [ "match" -> Once
-      | "lazymatch" -> Select
-      | "multimatch" -> General ] ]
-  ;
-  input_fun:
-    [ [ "_" -> None
-      | l = ident -> Some l ] ]
-  ;
-  let_clause:
-    [ [ id = identref; ":="; te = tactic_expr ->
-         (id, arg_of_expr te)
-      | id = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
-         (id, arg_of_expr (TacFun(args,te))) ] ]
-  ;
-  match_pattern:
-    [ [ IDENT "context";  oid = OPT Constr.ident;
-          "["; pc = Constr.lconstr_pattern; "]" ->
-        let mode = not (!Flags.tactic_context_compat) in
-        Subterm (mode, oid, pc)
-      | IDENT "appcontext";  oid = OPT Constr.ident;
-          "["; pc = Constr.lconstr_pattern; "]" ->
-        msg_warning (strbrk "appcontext is deprecated");
-        Subterm (true,oid, pc)
-      | pc = Constr.lconstr_pattern -> Term pc ] ]
-  ;
-  match_hyps:
-    [ [ na = name; ":"; mp =  match_pattern -> Hyp (na, mp)
-      | na = name; ":="; "["; mpv = match_pattern; "]"; ":"; mpt = match_pattern -> Def (na, mpv, mpt)
-      | na = name; ":="; mpv = match_pattern ->
-	  let t, ty =
-	    match mpv with
-	    | Term t -> (match t with
-	      | CCast (loc, t, (CastConv ty | CastVM ty | CastNative ty)) -> Term t, Some (Term ty)
-	      | _ -> mpv, None)
-	    | _ -> mpv, None
-	  in Def (na, t, Option.default (Term (CHole (Loc.ghost, None, IntroAnonymous, None))) ty)
-    ] ]
-  ;
-  match_context_rule:
-    [ [ largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
-        "=>"; te = tactic_expr -> Pat (largs, mp, te)
-      | "["; largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
-        "]"; "=>"; te = tactic_expr -> Pat (largs, mp, te)
-      | "_"; "=>"; te = tactic_expr -> All te ] ]
-  ;
-  match_context_list:
-    [ [ mrl = LIST1 match_context_rule SEP "|" -> mrl
-      | "|"; mrl = LIST1 match_context_rule SEP "|" -> mrl ] ]
-  ;
-  match_rule:
-    [ [ mp = match_pattern; "=>"; te = tactic_expr -> Pat ([],mp,te)
-      | "_"; "=>"; te = tactic_expr -> All te ] ]
-  ;
-  match_list:
-    [ [ mrl = LIST1 match_rule SEP "|" -> mrl
-      | "|"; mrl = LIST1 match_rule SEP "|" -> mrl ] ]
-  ;
-  message_token:
-    [ [ id = identref -> MsgIdent id
-      | s = STRING -> MsgString s
-      | n = integer -> MsgInt n ] ]
-  ;
-
-  ltac_def_kind:
-    [ [ ":=" -> false
-      | "::=" -> true ] ]
-  ;
-
-  (* Definitions for tactics *)
-  tacdef_body:
-    [ [ name = Constr.global; it=LIST1 input_fun; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, TacFun (it, body))
-          else
-            let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, TacFun (it, body))
-      | name = Constr.global; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, body)
-          else
-            let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, body)
-    ] ]
-  ;
-  tactic:
-    [ [ tac = tactic_expr -> tac ] ]
-  ;
-  selector:
-    [ [ n=natural; ":" -> Vernacexpr.SelectNth n
-      | test_bracket_ident; "["; id = ident; "]"; ":" -> Vernacexpr.SelectId id
-      | IDENT "all" ; ":" -> Vernacexpr.SelectAll ] ]
-  ;
-  tactic_mode:
-    [ [ g = OPT selector; tac = G_vernac.subgoal_command -> tac g ] ]
-  ;
-  END
-
-open Stdarg
-open Constrarg
-open Vernacexpr
-open Vernac_classifier
-open Goptions
-open Libnames
-
-let print_info_trace = ref None
-
-let _ = declare_int_option {
-  optsync = true;
-  optdepr = false;
-  optname = "print info trace";
-  optkey = ["Info" ; "Level"];
-  optread = (fun () -> !print_info_trace);
-  optwrite = fun n -> print_info_trace := n;
-}
-
-let vernac_solve n info tcom b =
-  let status = Proof_global.with_current_proof (fun etac p ->
-    let with_end_tac = if b then Some etac else None in
-    let global = match n with SelectAll -> true | _ -> false in
-    let info = Option.append info !print_info_trace in
-    let (p,status) =
-      Pfedit.solve n info (Tacinterp.hide_interp global tcom None) ?with_end_tac p
-    in
-    (* in case a strict subtree was completed,
-       go back to the top of the prooftree *)
-    let p = Proof.maximal_unfocus Vernacentries.command_focus p in
-    p,status) in
-    if not status then Pp.feedback Feedback.AddedAxiom
-
-let pr_ltac_selector = function
-| SelectNth i -> int i ++ str ":"
-| SelectId id -> str "[" ++ Nameops.pr_id id ++ str "]" ++ str ":"
-| SelectAll -> str "all" ++ str ":"
-
-VERNAC ARGUMENT EXTEND ltac_selector PRINTED BY pr_ltac_selector
-| [ selector(s) ] -> [ s ]
-END
-
-let pr_ltac_info n = str "Info" ++ spc () ++ int n
-
-VERNAC ARGUMENT EXTEND ltac_info PRINTED BY pr_ltac_info
-| [ "Info" natural(n) ] -> [ n ]
-END
-
-let pr_ltac_use_default b = if b then str ".." else mt ()
-
-VERNAC ARGUMENT EXTEND ltac_use_default PRINTED BY pr_ltac_use_default
-| [ "." ] -> [ false ]
-| [ "..." ] -> [ true ]
-END
-
-VERNAC tactic_mode EXTEND VernacSolve
-| [ - ltac_selector_opt(g) ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
-    [ classify_as_proofstep ] -> [
-    let g = Option.default (Proof_global.get_default_goal_selector ()) g in
-    vernac_solve g n t def
-  ]
-| [ - "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
-    [ VtProofStep true, VtLater ] -> [
-    vernac_solve SelectAll n t def
-  ]
-END
-
-let pr_ltac_tactic_level n = str "(at level " ++ int n ++ str ")"
-
-VERNAC ARGUMENT EXTEND ltac_tactic_level PRINTED BY pr_ltac_tactic_level
-| [ "(" "at" "level" natural(n) ")" ] -> [ n ]
-END
-
-VERNAC ARGUMENT EXTEND ltac_production_sep
-| [ "," string(sep) ] -> [ sep ]
-END
-
-let pr_ltac_production_item = function
-| TacTerm s -> quote (str s)
-| TacNonTerm (_, arg, (id, sep)) ->
-  let sep = match sep with
-  | "" -> mt ()
-  | sep -> str "," ++ spc () ++ quote (str sep)
-  in
-  str arg ++ str "(" ++ Nameops.pr_id id ++ sep ++ str ")"
-
-VERNAC ARGUMENT EXTEND ltac_production_item PRINTED BY pr_ltac_production_item
-| [ string(s) ] -> [ TacTerm s ]
-| [ ident(nt) "(" ident(p) ltac_production_sep_opt(sep) ")" ] ->
-  [ TacNonTerm (loc, Names.Id.to_string nt, (p, Option.default "" sep)) ]
-END
-
-VERNAC COMMAND EXTEND VernacTacticNotation
-| [ "Tactic" "Notation" ltac_tactic_level_opt(n) ne_ltac_production_item_list(r) ":=" tactic(e) ] =>
-  [ VtUnknown, VtNow ] ->
-  [
-    let l = Locality.LocalityFixme.consume () in
-    let n = Option.default 0 n in
-    Tacentries.add_tactic_notation (Locality.make_module_locality l, n, r, e)
-  ]
-END
-
-VERNAC COMMAND EXTEND VernacPrintLtac CLASSIFIED AS QUERY
-| [ "Print" "Ltac" reference(r) ] ->
-  [ msg_notice (Tacintern.print_ltac (snd (Libnames.qualid_of_reference r))) ]
-END
-
-VERNAC ARGUMENT EXTEND ltac_tacdef_body
-| [ tacdef_body(t) ] -> [ t ]
-END
-
-VERNAC COMMAND EXTEND VernacDeclareTacticDefinition
-| [ "Ltac" ne_ltac_tacdef_body_list_sep(l, "with") ] => [
-    VtSideff (List.map (function
-      | TacticDefinition ((_,r),_) -> r
-      | TacticRedefinition (Ident (_,r),_) -> r
-      | TacticRedefinition (Qualid (_,q),_) -> snd(repr_qualid q)) l), VtLater
-  ] -> [
-    let lc = Locality.LocalityFixme.consume () in
-    Tacentries.register_ltac (Locality.make_module_locality lc) l
-  ]
-END
diff --git a/tactics/g_obligations.ml4 b/tactics/g_obligations.ml4
deleted file mode 100644
index 4cd8bf1fe..000000000
--- a/tactics/g_obligations.ml4
+++ /dev/null
@@ -1,147 +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 the subtac terms and types.
-  Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
-
-
-open Libnames
-open Constrexpr
-open Constrexpr_ops
-open Stdarg
-open Constrarg
-open Extraargs
-
-let (set_default_tactic, get_default_tactic, print_default_tactic) = 
-  Tactic_option.declare_tactic_option "Program tactic"
-
-let () =
-  (** Delay to recover the tactic imperatively *)
-  let tac = Proofview.tclBIND (Proofview.tclUNIT ()) begin fun () ->
-    snd (get_default_tactic ())
-  end in
-  Obligations.default_tactic := tac
-
-(* We define new entries for programs, with the use of this module
- * Subtac. These entries are named Subtac.<foo>
- *)
-
-module Gram = Pcoq.Gram
-module Tactic = Pcoq.Tactic
-
-open Pcoq
-
-let sigref = mkRefC (Qualid (Loc.ghost, Libnames.qualid_of_string "Coq.Init.Specif.sig"))
-
-type 'a withtac_argtype = (Tacexpr.raw_tactic_expr option, 'a) Genarg.abstract_argument_type
-
-let wit_withtac : Tacexpr.raw_tactic_expr option Genarg.uniform_genarg_type =
-  Genarg.create_arg "withtac"
-
-let withtac = Pcoq.create_generic_entry Pcoq.utactic "withtac" (Genarg.rawwit wit_withtac)
-
-GEXTEND Gram
-  GLOBAL: withtac;
-
-  withtac:
-    [ [ "with"; t = Tactic.tactic -> Some t
-      | -> None ] ]
-  ;
-
-  Constr.closed_binder:
-    [[ "("; id=Prim.name; ":"; t=Constr.lconstr; "|"; c=Constr.lconstr; ")" ->
-	  let typ = mkAppC (sigref, [mkLambdaC ([id], default_binder_kind, t, c)]) in
-          [LocalRawAssum ([id], default_binder_kind, typ)]
-    ] ];
-
-  END
-
-open Obligations
-
-let classify_obbl _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]), VtLater)
-
-VERNAC COMMAND EXTEND Obligations CLASSIFIED BY classify_obbl
-| [ "Obligation" integer(num) "of" ident(name) ":" lglob(t) withtac(tac) ] ->
-    [ obligation (num, Some name, Some t) tac ]
-| [ "Obligation" integer(num) "of" ident(name) withtac(tac) ] ->
-    [ obligation (num, Some name, None) tac ]
-| [ "Obligation" integer(num) ":" lglob(t) withtac(tac) ] ->
-    [ obligation (num, None, Some t) tac ]
-| [ "Obligation" integer(num) withtac(tac) ] ->
-    [ obligation (num, None, None) tac ]
-| [ "Next" "Obligation" "of" ident(name) withtac(tac) ] ->
-    [ next_obligation (Some name) tac ]
-| [ "Next" "Obligation" withtac(tac) ] -> [ next_obligation None tac ]
-END
-
-VERNAC COMMAND EXTEND Solve_Obligation CLASSIFIED AS SIDEFF
-| [ "Solve" "Obligation" integer(num) "of" ident(name) "with" tactic(t) ] ->
-    [ try_solve_obligation num (Some name) (Some (Tacinterp.interp t)) ]
-| [ "Solve" "Obligation" integer(num) "with" tactic(t) ] ->
-    [ try_solve_obligation num None (Some (Tacinterp.interp t)) ]
-END
-
-VERNAC COMMAND EXTEND Solve_Obligations CLASSIFIED AS SIDEFF
-| [ "Solve" "Obligations" "of" ident(name) "with" tactic(t) ] ->
-    [ try_solve_obligations (Some name) (Some (Tacinterp.interp t)) ]
-| [ "Solve" "Obligations" "with" tactic(t) ] ->
-    [ try_solve_obligations None (Some (Tacinterp.interp t)) ]
-| [ "Solve" "Obligations" ] ->
-    [ try_solve_obligations None None ]
-END
-
-VERNAC COMMAND EXTEND Solve_All_Obligations CLASSIFIED AS SIDEFF
-| [ "Solve" "All" "Obligations" "with" tactic(t) ] ->
-    [ solve_all_obligations (Some (Tacinterp.interp t)) ]
-| [ "Solve" "All" "Obligations" ] ->
-    [ solve_all_obligations None ]
-END
-
-VERNAC COMMAND EXTEND Admit_Obligations CLASSIFIED AS SIDEFF
-| [ "Admit" "Obligations" "of" ident(name) ] -> [ admit_obligations (Some name) ]
-| [ "Admit" "Obligations" ] -> [ admit_obligations None ]
-END
-
-VERNAC COMMAND EXTEND Set_Solver CLASSIFIED AS SIDEFF
-| [ "Obligation" "Tactic" ":=" tactic(t) ] -> [
-    set_default_tactic
-      (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
-      (Tacintern.glob_tactic t) ]
-END
-
-open Pp
-
-VERNAC COMMAND EXTEND Show_Solver CLASSIFIED AS QUERY
-| [ "Show" "Obligation" "Tactic" ] -> [
-    msg_info (str"Program obligation tactic is " ++ print_default_tactic ()) ]
-END
-
-VERNAC COMMAND EXTEND Show_Obligations CLASSIFIED AS QUERY
-| [ "Obligations" "of" ident(name) ] -> [ show_obligations (Some name) ]
-| [ "Obligations" ] -> [ show_obligations None ]
-END
-
-VERNAC COMMAND EXTEND Show_Preterm CLASSIFIED AS QUERY
-| [ "Preterm" "of" ident(name) ] -> [ msg_info (show_term (Some name)) ]
-| [ "Preterm" ] -> [ msg_info (show_term None) ]
-END
-
-open Pp
-
-(* Declare a printer for the content of Program tactics *)
-let () =
-  let printer _ _ _ = function
-  | None -> mt ()
-  | Some tac -> str "with" ++ spc () ++ Pptactic.pr_raw_tactic tac
-  in
-  (* should not happen *)
-  let dummy _ _ _ expr = assert false in
-  Pptactic.declare_extra_genarg_pprule wit_withtac printer dummy dummy
diff --git a/tactics/g_rewrite.ml4 b/tactics/g_rewrite.ml4
deleted file mode 100644
index c4ef1f297..000000000
--- a/tactics/g_rewrite.ml4
+++ /dev/null
@@ -1,272 +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
-open Stdarg
-open Constrarg
-open Pcoq.Prim
-open Pcoq.Constr
-open Pcoq.Tactic
-
-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 "binders" : binders_argtype Genarg.uniform_genarg_type)
-
-let binders = Pcoq.create_generic_entry Pcoq.utactic "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
-
-VERNAC COMMAND EXTEND PrintRewriteHintDb CLASSIFIED AS QUERY
-  [ "Print" "Rewrite" "HintDb" preident(s) ] -> [ Pp.msg_notice (Autorewrite.print_rewrite_hintdb s) ]
-END
diff --git a/tactics/hightactics.mllib b/tactics/hightactics.mllib
deleted file mode 100644
index 7987d774d..000000000
--- a/tactics/hightactics.mllib
+++ /dev/null
@@ -1,23 +0,0 @@
-Tacsubst
-Tacenv
-Tactic_debug
-Tacintern
-Tacentries
-Tacinterp
-Evar_tactics
-Tactic_option
-Extraargs
-G_obligations
-Coretactics
-Autorewrite
-Extratactics
-Eauto
-G_auto
-Class_tactics
-G_class
-Rewrite
-G_rewrite
-Tauto
-Eqdecide
-G_eqdecide
-G_ltac
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
deleted file mode 100644
index fb04bee07..000000000
--- a/tactics/rewrite.ml
+++ /dev/null
@@ -1,2184 +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 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
-open Sigma.Notations
-open Proofview.Notations
-open Context.Named.Declaration
-
-(** Typeclass-based generalized rewriting. *)
-
-(** Constants used by the tactic. *)
-
-let classes_dirpath =
-  Names.DirPath.make (List.map Id.of_string ["Classes";"Coq"])
-
-let init_relation_classes () =
-  if is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then ()
-  else Coqlib.check_required_library ["Coq";"Classes";"RelationClasses"]
-
-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 sigma = Sigma.Unsafe.of_evar_map evd in
-      let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force gr) in
-      let evd = Sigma.to_evar_map sigma 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 = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (t, evd', _) = Evarutil.new_evar ~store:s env evd t in
-  let evd' = Sigma.to_evar_map evd' 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.e_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
-  open Context.Rel.Declaration
-  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 sigma = Sigma.Unsafe.of_evar_map evd in
-        let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force l) in
-        let evd = Sigma.to_evar_map sigma in
-	  (evd, cstrs), c
-	
-  let proper_proxy_type = 
-    let l = lazy (Lazy.force proper_proxy_class).cl_impl in
-      fun (evd,cstrs) -> 
-        let sigma = Sigma.Unsafe.of_evar_map evd in
-        let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force l) in
-        let evd = Sigma.to_evar_map sigma 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 (LocalAssum (na, 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 (LocalAssum (na, 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 sigma = Sigma.Unsafe.of_evar_map sigma in
-	   let Sigma ((evar, _), evars, _) = Evarutil.new_type_evar env' sigma Evd.univ_flexible in
-	   let evars = Sigma.to_evar_map sigma 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 sigma = Sigma.Unsafe.of_evar_map evd in
-    let Sigma (sort, sigma, _) = Evarutil.new_Type ~rigid:Evd.univ_flexible env sigma in
-    let evd = Sigma.to_evar_map sigma 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 error_no_relation () = error "Cannot find a relation to rewrite."
-
-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
-    let rel = mkApp (f, fargs) in
-    rel, args.(len - 2), args.(len - 1)
-  | _ -> error_no_relation ()
-
-let decompose_app_rel env evd t =
-  let (rel, t1, t2) = decompose_app_rel env evd t in
-  let ty = Retyping.get_type_of env evd rel in
-  let () = if not (Reduction.is_arity env ty) then error_no_relation () in
-  (rel, t1, t2)
-
-let decompose_applied_relation env sigma (c,l) =
-  let open Context.Rel.Declaration in
-  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) -> LocalAssum (n, 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
-	  (LocalDef (Id.of_string "do_subrelation",
-	             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 open Context.Rel.Declaration in
-	let env' = Environ.push_rel (LocalAssum (n', 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 sigma = Sigma.Unsafe.of_evar_map (goalevars evars) in
-	  let Sigma (t', sigma, _) = rfn.Reductionops.e_redfun env sigma t in
-	  let evars' = Sigma.to_evar_map sigma 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.e_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]
-| ndecl :: rem ->
-  if occur_var_in_decl env (get_id ndecl) 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 { 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 (Id.equal id % get_id) ctx in
-    let nc = match before with
-    | [] -> assert false
-    | d :: rem -> insert_dependent env (LocalAssum (get_id d, newt)) [] after @ rem
-    in
-    let env' = Environ.reset_with_named_context (val_of_named_context nc) env in
-    Refine.refine ~unsafe:false { run = begin fun sigma ->
-      let Sigma (ev, sigma, p) = Evarutil.new_evar env' sigma concl in
-      let Sigma (ev', sigma, q) = Evarutil.new_evar env sigma newt in
-      let map d =
-        let n = get_id d in
-        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), sigma, p +> q)
-    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 = Refine.refine ~unsafe:false { run = fun h -> Sigma (p, h, Sigma.refl) } <*> 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 (LocalAssum (id, newt))
-	| None, Some p ->
-            Proofview.Unsafe.tclEVARS undef <*>
-            Proofview.Goal.enter { enter = begin fun gl ->
-            let env = Proofview.Goal.env gl in
-            let make = { run = begin fun sigma ->
-              let Sigma (ev, sigma, q) = Evarutil.new_evar env sigma newt in
-              Sigma (mkApp (p, [| ev |]), sigma, q)
-            end } in
-            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 = Tactics.reduct_in_concl (beta_red, DEFAULTcast) in
-  let opt_beta = match clause with
-  | None -> Proofview.tclUNIT ()
-  | Some id -> Tactics.reduct_in_hyp beta_red (id, InHyp)
-  in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let env = Proofview.Goal.env gl in
-    let sigma = Tacmach.New.project 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),None), 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,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
-    Pretyping.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),None), 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,[])))
-	      ~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 Coq.Classes.RelationClasses library")
-
-let setoid_proof ty fn fallback =
-  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
-    Proofview.tclORELSE
-      begin
-        try
-          let rel, _, _ = decompose_app_rel env sigma concl in
-          let open Context.Rel.Declaration in
-          let (sigma, t) = Typing.type_of env sigma rel in
-          let car = get_type (List.hd (fst (Reduction.dest_prod env t))) in
-	    (try init_relation_classes () 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 01709f29f..000000000
--- 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.t -> 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/tacentries.ml b/tactics/tacentries.ml
deleted file mode 100644
index 711cd8d9d..000000000
--- a/tactics/tacentries.ml
+++ /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        *)
-(************************************************************************)
-
-open Pp
-open Errors
-open Util
-open Names
-open Libobject
-open Pcoq
-open Egramml
-open Egramcoq
-open Vernacexpr
-open Libnames
-open Nameops
-
-(**********************************************************************)
-(* Tactic Notation                                                    *)
-
-let interp_prod_item lev = function
-  | TacTerm s -> GramTerminal s
-  | TacNonTerm (loc, nt, (_, sep)) ->
-      let EntryName (etyp, e) = interp_entry_name lev nt sep in
-      GramNonTerminal (loc, etyp, e)
-
-let make_terminal_status = function
-  | GramTerminal s -> Some s
-  | GramNonTerminal _ -> None
-
-let make_fresh_key =
-  let id = Summary.ref ~name:"TACTIC-NOTATION-COUNTER" 0 in
-  fun () ->
-    let cur = incr id; !id in
-    let lbl = Id.of_string ("_" ^ string_of_int cur) in
-    let kn = Lib.make_kn lbl in
-    let (mp, dir, _) = KerName.repr kn in
-    (** We embed the full path of the kernel name in the label so that the
-        identifier should be unique. This ensures that including two modules
-        together won't confuse the corresponding labels. *)
-    let lbl = Id.of_string_soft (Printf.sprintf "%s#%s#%i"
-      (ModPath.to_string mp) (DirPath.to_string dir) cur)
-    in
-    KerName.make mp dir (Label.of_id lbl)
-
-type tactic_grammar_obj = {
-  tacobj_key : KerName.t;
-  tacobj_local : locality_flag;
-  tacobj_tacgram : tactic_grammar;
-  tacobj_tacpp : Pptactic.pp_tactic;
-  tacobj_body : Id.t list * Tacexpr.glob_tactic_expr;
-}
-
-let check_key key =
-  if Tacenv.check_alias key then
-    error "Conflicting tactic notations keys. This can happen when including \
-    twice the same module."
-
-let cache_tactic_notation (_, tobj) =
-  let key = tobj.tacobj_key in
-  let () = check_key key in
-  Tacenv.register_alias key tobj.tacobj_body;
-  Egramcoq.extend_tactic_grammar key tobj.tacobj_tacgram;
-  Pptactic.declare_notation_tactic_pprule key tobj.tacobj_tacpp
-
-let open_tactic_notation i (_, tobj) =
-  let key = tobj.tacobj_key in
-  if Int.equal i 1 && not tobj.tacobj_local then
-    Egramcoq.extend_tactic_grammar key tobj.tacobj_tacgram
-
-let load_tactic_notation i (_, tobj) =
-  let key = tobj.tacobj_key in
-  let () = check_key key in
-  (** Only add the printing and interpretation rules. *)
-  Tacenv.register_alias key tobj.tacobj_body;
-  Pptactic.declare_notation_tactic_pprule key tobj.tacobj_tacpp;
-  if Int.equal i 1 && not tobj.tacobj_local then
-    Egramcoq.extend_tactic_grammar key tobj.tacobj_tacgram
-
-let subst_tactic_notation (subst, tobj) =
-  let (ids, body) = tobj.tacobj_body in
-  { tobj with
-    tacobj_key = Mod_subst.subst_kn subst tobj.tacobj_key;
-    tacobj_body = (ids, Tacsubst.subst_tactic subst body);
-  }
-
-let classify_tactic_notation tacobj = Substitute tacobj
-
-let inTacticGrammar : tactic_grammar_obj -> obj =
-  declare_object {(default_object "TacticGrammar") with
-       open_function = open_tactic_notation;
-       load_function = load_tactic_notation;
-       cache_function = cache_tactic_notation;
-       subst_function = subst_tactic_notation;
-       classify_function = classify_tactic_notation}
-
-let cons_production_parameter = function
-| TacTerm _ -> None
-| TacNonTerm (_, _, (id, _)) -> Some id
-
-let add_tactic_notation (local,n,prods,e) =
-  let ids = List.map_filter cons_production_parameter prods in
-  let prods = List.map (interp_prod_item n) prods in
-  let pprule = {
-    Pptactic.pptac_level = n;
-    pptac_prods = prods;
-  } in
-  let tac = Tacintern.glob_tactic_env ids (Global.env()) e in
-  let parule = {
-    tacgram_level = n;
-    tacgram_prods = prods;
-  } in
-  let tacobj = {
-    tacobj_key = make_fresh_key ();
-    tacobj_local = local;
-    tacobj_tacgram = parule;
-    tacobj_tacpp = pprule;
-    tacobj_body = (ids, tac);
-  } in
-  Lib.add_anonymous_leaf (inTacticGrammar tacobj)
-
-(**********************************************************************)
-(* ML Tactic entries                                                  *)
-
-type ml_tactic_grammar_obj = {
-  mltacobj_name : Tacexpr.ml_tactic_name;
-  (** ML-side unique name *)
-  mltacobj_prod : Tacexpr.raw_tactic_expr grammar_prod_item list list;
-  (** Grammar rules generating the ML tactic. *)
-}
-
-exception NonEmptyArgument
-
-(** ML tactic notations whose use can be restricted to an identifier are added
-    as true Ltac entries. *)
-let extend_atomic_tactic name entries =
-  let open Tacexpr in
-  let map_prod prods =
-    let (hd, rem) = match prods with
-    | GramTerminal s :: rem -> (s, rem)
-    | _ -> assert false (** Not handled by the ML extension syntax *)
-    in
-    let empty_value = function
-    | GramTerminal s -> raise NonEmptyArgument
-    | GramNonTerminal (_, typ, e) ->
-      let Genarg.Rawwit wit = typ in
-      let inj x = TacArg (Loc.ghost, TacGeneric (Genarg.in_gen typ x)) in
-      let default = epsilon_value inj e in
-      match default with
-      | None -> raise NonEmptyArgument
-      | Some def -> Tacintern.intern_tactic_or_tacarg Tacintern.fully_empty_glob_sign def
-    in
-    try Some (hd, List.map empty_value rem) with NonEmptyArgument -> None
-  in
-  let entries = List.map map_prod entries in
-  let add_atomic i args = match args with
-  | None -> ()
-  | Some (id, args) ->
-    let args = List.map (fun a -> Tacexp a) args in
-    let entry = { mltac_name = name; mltac_index = i } in
-    let body = TacML (Loc.ghost, entry, args) in
-    Tacenv.register_ltac false false (Names.Id.of_string id) body
-  in
-  List.iteri add_atomic entries
-
-let cache_ml_tactic_notation (_, obj) =
-  extend_ml_tactic_grammar obj.mltacobj_name obj.mltacobj_prod
-
-let open_ml_tactic_notation i obj =
-  if Int.equal i 1 then cache_ml_tactic_notation obj
-
-let inMLTacticGrammar : ml_tactic_grammar_obj -> obj =
-  declare_object { (default_object "MLTacticGrammar") with
-    open_function = open_ml_tactic_notation;
-    cache_function = cache_ml_tactic_notation;
-    classify_function = (fun o -> Substitute o);
-    subst_function = (fun (_, o) -> o);
-  }
-
-let add_ml_tactic_notation name prods =
-  let obj = {
-    mltacobj_name = name;
-    mltacobj_prod = prods;
-  } in
-  Lib.add_anonymous_leaf (inMLTacticGrammar obj);
-  extend_atomic_tactic name prods
-
-(** Command *)
-
-
-type tacdef_kind =
-  | NewTac of Id.t
-  | UpdateTac of Nametab.ltac_constant
-
-let is_defined_tac kn =
-  try ignore (Tacenv.interp_ltac kn); true with Not_found -> false
-
-let register_ltac local tacl =
-  let map tactic_body =
-    match tactic_body with
-    | TacticDefinition ((loc,id), body) ->
-        let kn = Lib.make_kn id in
-        let id_pp = pr_id id in
-        let () = if is_defined_tac kn then
-          Errors.user_err_loc (loc, "",
-            str "There is already an Ltac named " ++ id_pp ++ str".")
-        in
-        let is_primitive =
-          try
-            match Pcoq.parse_string Pcoq.Tactic.tactic (Id.to_string id) with
-            | Tacexpr.TacArg _ -> false
-            | _ -> true (* most probably TacAtom, i.e. a primitive tactic ident *)
-          with e when Errors.noncritical e -> true (* prim tactics with args, e.g. "apply" *)
-        in
-        let () = if is_primitive then
-          msg_warning (str "The Ltac name " ++ id_pp ++
-            str " may be unusable because of a conflict with a notation.")
-        in
-        NewTac id, body
-    | TacticRedefinition (ident, body) ->
-        let loc = loc_of_reference ident in
-        let kn =
-          try Nametab.locate_tactic (snd (qualid_of_reference ident))
-          with Not_found ->
-            Errors.user_err_loc (loc, "",
-                        str "There is no Ltac named " ++ pr_reference ident ++ str ".")
-        in
-        UpdateTac kn, body
-  in
-  let rfun = List.map map tacl in
-  let recvars =
-    let fold accu (op, _) = match op with
-    | UpdateTac _ -> accu
-    | NewTac id -> (Lib.make_path id, Lib.make_kn id) :: accu
-    in
-    List.fold_left fold [] rfun
-  in
-  let ist = Tacintern.make_empty_glob_sign () in
-  let map (name, body) =
-    let body = Flags.with_option Tacintern.strict_check (Tacintern.intern_tactic_or_tacarg ist) body in
-    (name, body)
-  in
-  let defs () =
-    (** Register locally the tactic to handle recursivity. This function affects
-        the whole environment, so that we transactify it afterwards. *)
-    let iter_rec (sp, kn) = Nametab.push_tactic (Nametab.Until 1) sp kn in
-    let () = List.iter iter_rec recvars in
-    List.map map rfun
-  in
-  let defs = Future.transactify defs () in
-  let iter (def, tac) = match def with
-  | NewTac id ->
-    Tacenv.register_ltac false local id tac;
-    Flags.if_verbose msg_info (Nameops.pr_id id ++ str " is defined")
-  | UpdateTac kn ->
-    Tacenv.redefine_ltac local kn tac;
-    let name = Nametab.shortest_qualid_of_tactic kn in
-    Flags.if_verbose msg_info (Libnames.pr_qualid name ++ str " is redefined")
-  in
-  List.iter iter defs
diff --git a/tactics/tacentries.mli b/tactics/tacentries.mli
deleted file mode 100644
index 3cf0bc5cc..000000000
--- a/tactics/tacentries.mli
+++ /dev/null
@@ -1,21 +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 Vernacexpr
-open Tacexpr
-
-(** Adding a tactic notation in the environment *)
-
-val add_tactic_notation :
-  locality_flag * int * grammar_tactic_prod_item_expr list * raw_tactic_expr ->
-    unit
-
-val add_ml_tactic_notation : ml_tactic_name ->
-  Tacexpr.raw_tactic_expr Egramml.grammar_prod_item list list -> unit
-
-val register_ltac : bool -> Vernacexpr.tacdef_body list -> unit
diff --git a/tactics/tacenv.ml b/tactics/tacenv.ml
deleted file mode 100644
index d2d3f3117..000000000
--- a/tactics/tacenv.ml
+++ /dev/null
@@ -1,145 +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
-type alias_tactic = Id.t list * glob_tactic_expr
-
-let alias_map = Summary.ref ~name:"tactic-alias"
-  (KNmap.empty : alias_tactic 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 =
-  Val.t 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 array) =
-  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 { mltac_name = s; mltac_index = i } =
-  try
-    let tacs = MLTacMap.find s !tac_tab in
-    let () = if Array.length tacs <= i then raise Not_found in
-    tacs.(i)
-  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 88b54993b..000000000
--- a/tactics/tacenv.mli
+++ /dev/null
@@ -1,74 +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. *)
-
-type alias_tactic = Id.t list * glob_tactic_expr
-(** Contents of a tactic notation *)
-
-val register_alias : alias -> alias_tactic -> unit
-(** Register a tactic alias. *)
-
-val interp_alias : alias -> alias_tactic
-(** 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 =
-  Val.t 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 array -> unit
-(** Register an external tactic. *)
-
-val interp_ml_tactic : ml_tactic_entry -> 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 a75805b4f..000000000
--- a/tactics/tacintern.ml
+++ /dev/null
@@ -1,821 +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_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_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 = function
-   | IntroAndPattern l ->
-      IntroAndPattern (List.map (intern_intro_pattern lf ist) l)
-  | IntroOrPattern ll ->
-      IntroOrPattern (List.map (List.map (intern_intro_pattern lf ist)) ll)
-
-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 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)
-  | 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)
-  | 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)
-  | 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))
-
-  (* 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 *)
-  | TacRename l ->
-      TacRename (List.map (fun (id1,id2) ->
-			     intern_hyp ist id1,
-			     intern_hyp ist id2) l)
-
-  (* 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)
-
-  (* 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 (intern_tacarg !strict_check false ist) 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_tacarg !strict_check false ist) l)
-
-and intern_tactic_as_arg loc onlytac ist a =
-  match intern_tacarg !strict_check onlytac ist a with
-  | TacCall _ | Reference _
-  | TacGeneric _ as a -> TacArg (loc,a)
-  | Tacexp a -> a
-  | ConstrMayEval _ | TacFreshId _ | TacPretype _ | TacNumgoals as a ->
-      if onlytac then error_tactic_expected loc else TacArg (loc,a)
-
-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)
-  | 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 = intern_genarg ist arg in
-    TacGeneric arg
-
-(* 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 (GenArg (Rawwit wit, x)) =
-  match wit with
-  | ListArg wit ->
-      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 x)
-  | OptArg wit ->
-      let ans = match x 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
-      ans
-  | PairArg (wit1, wit2) ->
-      let p, q = x 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)
-  | ExtraArg s ->
-      snd (Genintern.generic_intern ist (in_gen (rawwit wit) 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 intern_ident' ist id =
-  let lf = ref Id.Set.empty in
-  (ist, intern_ident lf ist id)
-
-let () =
-  Genintern.register_intern0 wit_int_or_var (lift intern_int_or_var);
-  Genintern.register_intern0 wit_ref (lift intern_global_reference);
-  Genintern.register_intern0 wit_ident intern_ident';
-  Genintern.register_intern0 wit_var (lift intern_hyp);
-  Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_ltac (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_sort (fun ist s -> (ist, s));
-  Genintern.register_intern0 wit_quant_hyp (lift intern_quantified_hypothesis);
-  Genintern.register_intern0 wit_constr (fun ist c -> (ist,intern_constr ist c));
-  Genintern.register_intern0 wit_uconstr (fun ist c -> (ist,intern_constr ist c));
-  Genintern.register_intern0 wit_open_constr (fun ist c -> (ist,intern_constr ist c));
-  Genintern.register_intern0 wit_red_expr (lift intern_red_expr);
-  Genintern.register_intern0 wit_bindings (lift intern_bindings);
-  Genintern.register_intern0 wit_constr_with_bindings (lift intern_constr_with_bindings);
-  Genintern.register_intern0 wit_constr_may_eval (lift intern_constr_may_eval);
-  ()
-
-(***************************************************************************)
-(* 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 71ca354fa..000000000
--- a/tactics/tacintern.mli
+++ /dev/null
@@ -1,64 +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
-
-(** 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 4506f8159..000000000
--- a/tactics/tacinterp.ml
+++ /dev/null
@@ -1,2216 +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.New
-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 Sigma.Notations
-open Proofview.Notations
-open Context.Named.Declaration
-
-let ltac_trace_info = Tactic_debug.ltac_trace_info
-
-let has_type : type a. Val.t -> a typed_abstract_argument_type -> bool = fun v wit ->
-  let Val.Dyn (t, _) = v in
-  match Val.eq t (val_tag wit) with
-  | None -> false
-  | Some Refl -> true
-
-let prj : type a. a Val.tag -> Val.t -> a option = fun t v ->
-  let Val.Dyn (t', x) = v in
-  match Val.eq t t' with
-  | None -> None
-  | Some Refl -> Some x
-
-let in_gen wit v = Val.Dyn (val_tag wit, v)
-let out_gen wit v = match prj (val_tag wit) v with None -> assert false | Some x -> x
-
-let val_tag wit = val_tag (topwit wit)
-
-let pr_argument_type arg =
-  let Val.Dyn (tag, _) = arg in
-  Val.repr tag
-
-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 = Val.t
-
-(** Abstract application, to print ltac functions *)
-type appl =
-  | UnnamedAppl (** For generic applications: nothing is printed *)
-  | GlbAppl of (Names.kernel_name * Val.t 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 = (** FIXME *)
-    let Val.Dyn (tag, _) = arg in
-    str"<" ++ Val.repr tag ++ str ">"
-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, tacvalue, tacvalue) Genarg.genarg_type) =
-  Genarg.create_arg "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
-
-  let cast_error wit v =
-    let pr_v = mt () in (** FIXME *)
-    let Val.Dyn (tag, _) = v in
-    let tag = Val.repr tag in
-    errorlabstrm "" (str "Type error: value " ++ pr_v ++ str "is a " ++ tag
-      ++ str " while type " ++ Genarg.pr_argument_type (unquote (rawwit wit)) ++ str " was expected.")
-
-  let prj : type a. a Val.tag -> Val.t -> a option = fun t v ->
-    let Val.Dyn (t', x) = v in
-    match Val.eq t t' with
-    | None -> None
-    | Some Refl -> Some x
-
-  let try_prj wit v = match prj (val_tag wit) v with
-  | None -> cast_error wit v
-  | Some x -> x
-
-  let rec val_cast : type a b c. (a, b, c) genarg_type -> Val.t -> c =
-  fun wit v -> match wit with
-  | ExtraArg _ -> try_prj wit v
-  | ListArg t ->
-    let Val.Dyn (tag, v) = v in
-    begin match tag with
-    | Val.List tag ->
-      let map x = val_cast t (Val.Dyn (tag, x)) in
-      List.map map v
-    | _ -> cast_error wit (Val.Dyn (tag, v))
-    end
-  | OptArg t ->
-    let Val.Dyn (tag, v) = v in
-    begin match tag with
-    | Val.Opt tag ->
-      let map x = val_cast t (Val.Dyn (tag, x)) in
-      Option.map map v
-    | _ -> cast_error wit (Val.Dyn (tag, v))
-    end
-  | PairArg (t1, t2) ->
-    let Val.Dyn (tag, v) = v in
-    begin match tag with
-    | Val.Pair (tag1, tag2) ->
-      let (v1, v2) = v in
-      let v1 = Val.Dyn (tag1, v1) in
-      let v2 = Val.Dyn (tag2, v2) in
-      (val_cast t1 v1, val_cast t2 v2)
-    | _ -> cast_error wit (Val.Dyn (tag, v))
-    end
-
-  let cast (Topwit wit) v = val_cast wit v
-
-end
-
-let print_top_val env v = mt () (** FIXME *)
-
-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 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 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 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)
-
-(** 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 intro_pattern_of_ident id = (Loc.ghost, IntroNaming (IntroIdentifier id))
-let value_of_ident id =
-  in_gen (topwit wit_intro_pattern) (intro_pattern_of_ident 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_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
-        VarRef (get_id (Environ.lookup_named id env))
-      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
-  | LocalDef _ -> 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 (IntroAndPattern l)) ->
-      List.flatten (List.map intropattern_ids l)
-  | IntroAction (IntroOrAndPattern (IntroOrPattern 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.s_enter { s_enter = begin fun gl ->
-    let (sigma, c) = interp_constr ist (Goal.env gl) (project gl) c in
-    Sigma.Unsafe.of_pair (k c, sigma)
-  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
-
-(* Interprets a type expression *)
-let pf_interp_type ist env sigma =
-  interp_type ist env sigma
-
-(* Fully evaluate an untyped constr *)
-let type_uconstr ?(flags = constr_flags)
-  ?(expected_type = WithoutTypeConstraint) ist c =
-  { delayed = begin fun env sigma ->
-  let open Pretyping in
-  let { closure; term } = c in
-  let vars = {
-    ltac_constrs = closure.typed;
-    ltac_uconstrs = closure.untyped;
-    ltac_idents = closure.idents;
-    ltac_genargs = ist.lfun;
-  } in
-  let sigma = Sigma.to_evar_map sigma in
-  let (sigma, c) = understand_ltac flags env sigma vars expected_type term in
-  Sigma.Unsafe.of_pair (c, sigma)
-  end }
-
-
-(* 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
-      let (redfun, _) = Redexpr.reduction_of_red_expr env redexp in
-      let sigma = Sigma.Unsafe.of_evar_map sigma in
-      let Sigma (c, sigma, _) = redfun.Reductionops.e_redfun env sigma c_interp in
-      (Sigma.to_evar_map sigma, c)
-  | 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.e_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 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 {enter = begin fun gl -> Ftactic.return (pr_constr_env (pf_env gl) (project 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 { enter = begin fun gl ->
-      Ftactic.return (pr_constr_under_binders_env (pf_env gl) (project 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 (fst (Tactics.run_delayed env Evd.empty c)) in
-    Ftactic.nf_enter { enter = begin fun gl ->
-      Ftactic.return (Miscprint.pr_intro_pattern (fun c -> print (pf_env gl) (project 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 { enter = begin fun gl -> Ftactic.return (pr_constr_env (pf_env gl) (project gl) c) end }
-  else if has_type v (topwit wit_uconstr) then
-    let c = out_gen (topwit wit_uconstr) v in
-    Ftactic.nf_enter { enter = begin fun gl ->
-      Ftactic.return (pr_closed_glob_env (pf_env gl)
-                        (project 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 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 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 = { delayed = fun env sigma ->
-        let sigma = Sigma.to_evar_map sigma in
-        let (sigma, c) = interp_open_constr ist env sigma c in
-        Sigma.Unsafe.of_pair (c, sigma)
-      } 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 = function
-  | IntroAndPattern l ->
-      let sigma, l = List.fold_map (interp_intro_pattern ist env) sigma l in
-      sigma, IntroAndPattern l
-  | IntroOrPattern ll ->
-      let sigma, ll = List.fold_map (interp_intro_pattern_list_as_list ist env) sigma ll in
-      sigma, IntroOrPattern ll
-
-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_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 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 = { delayed = fun env sigma ->
-    let sigma = Sigma.to_evar_map sigma in
-    let (sigma, c) = interp_open_constr_with_bindings ist env sigma cb in
-    Sigma.Unsafe.of_pair (c, sigma)
-  } in
-    (loc,f)
-
-let interp_induction_arg ist gl arg =
-  match arg with
-  | keep,ElimOnConstr c ->
-      keep,ElimOnConstr { delayed = fun env sigma ->
-        let sigma = Sigma.to_evar_map sigma in
-        let (sigma, c) = interp_constr_with_bindings ist env sigma c in
-        Sigma.Unsafe.of_pair (c, sigma)
-      }
-  | 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 { delayed = begin fun env sigma ->
-          try Sigma.here (constr_of_id env id', NoBindings) sigma
-          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.")
-          end })
-      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 { delayed = fun env sigma -> Sigma ((c,NoBindings), sigma, Sigma.refl) }
-      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 = { delayed = fun env sigma ->
-            let sigma = Sigma.to_evar_map sigma in
-            let (sigma,c) = interp_open_constr ist env sigma c in
-            Sigma.Unsafe.of_pair ((c,NoBindings), sigma)
-          } 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 interp_focussed wit f v =
-  Ftactic.nf_enter { enter = begin fun gl ->
-    let v = Genarg.out_gen (glbwit wit) v in
-    let env = Proofview.Goal.env gl in
-    let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-    let v = in_gen (topwit wit) (f env sigma v) in
-    Ftactic.return v
-  end }
-
-(* Interprets an l-tac expression into a value *)
-let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t 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
-	Tactic_debug.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 { enter = begin fun gl -> Tactics.tclABSTRACT
-        (Option.map (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 (ids, body) = Tacenv.interp_alias s in
-      let (>>=) = Ftactic.bind in
-      let interp_vars = Ftactic.List.map (fun v -> interp_tacarg ist v) l in
-      let tac l =
-        let addvar x v accu = Id.Map.add x v accu in
-        let lfun = List.fold_right2 addvar ids 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, lr) ->
-        let name () = Pptactic.pr_alias (fun v -> print_top_val env v) 0 s lr in
-        Proofview.Trace.name_tactic name (tac lr)
-      (* 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
-      let tac =
-        let len1 = List.length ids in
-        let len2 = List.length l in
-        if len1 = len2 then tac
-        else Tacticals.New.tclZEROMSG (str "Arguments length mismatch: \
-          expected " ++ int len1 ++ str ", found " ++ int len2)
-      in
-      Ftactic.run tac (fun () -> Proofview.tclUNIT ())
-
-  | TacML (loc,opn,l) ->
-      let open Ftactic.Notations in
-      let trace = push_trace (loc,LtacMLCall tac) ist in
-      let ist = { ist with extra = TacStore.set ist.extra f_trace trace; } in
-      let tac = Tacenv.interp_ml_tactic opn in
-      let args = Ftactic.List.map_right (fun a -> interp_tacarg ist a) l in
-      let tac args =
-        let name () = Pptactic.pr_extend (fun v -> print_top_val () v) 0 opn args in
-        Proofview.Trace.name_tactic name (catch_error_tac trace (tac args ist))
-      in
-      Ftactic.run args tac
-
-and force_vrec ist v : Val.t 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 : Val.t 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 : Val.t Ftactic.t =
-  match arg with
-  | TacGeneric arg -> interp_genarg ist arg
-  | Reference r -> interp_ltac_reference dloc false ist r
-  | ConstrMayEval c ->
-      Ftactic.s_enter { s_enter = begin fun gl ->
-        let sigma = project gl in
-        let env = Proofview.Goal.env gl in
-        let (sigma,c_interp) = interp_constr_may_eval ist env sigma c in
-        Sigma.Unsafe.of_pair (Ftactic.return (Value.of_constr c_interp), sigma)
-      end }
-  | 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 { enter = begin fun gl ->
-        let id = interp_fresh_id ist (pf_env gl) (project gl) l in
-        Ftactic.return (in_gen (topwit wit_intro_pattern) (dloc, IntroNaming (IntroIdentifier id)))
-      end }
-  | TacPretype c ->
-      Ftactic.s_enter { s_enter = begin fun gl ->
-        let sigma = Proofview.Goal.sigma gl in
-        let env = Proofview.Goal.env gl in
-        let c = interp_uconstr ist env c in
-        let Sigma (c, sigma, p) = (type_uconstr ist c).delayed env sigma in
-        Sigma (Ftactic.return (Value.of_constr c), sigma, p)
-      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
-
-(* Interprets an application node *)
-and interp_app loc ist fv largs : Val.t 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
-    tactic_of_value 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 { enter = begin fun gl ->
-    let sigma = project 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 { enter = begin fun gl ->
-      let sigma = project 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 *)
-and interp_genarg ist x : Val.t Ftactic.t =
-    let open Ftactic.Notations in
-    (** Ad-hoc handling of some types. *)
-    let tag = genarg_tag x in
-    if argument_type_eq tag (unquote (topwit (wit_list wit_var))) then
-      interp_genarg_var_list ist x
-    else if argument_type_eq tag (unquote (topwit (wit_list wit_constr))) then
-      interp_genarg_constr_list ist x
-    else
-    let GenArg (Glbwit wit, x) = x in
-    match wit with
-    | ListArg wit ->
-      let map x =
-        interp_genarg ist (Genarg.in_gen (glbwit wit) x) >>= fun x ->
-        Ftactic.return (Value.cast (topwit wit) x)
-      in
-      Ftactic.List.map map x >>= fun l ->
-      Ftactic.return (Value.of_list (val_tag wit) l)
-    | OptArg wit ->
-      let ans = match x with
-      | None -> Ftactic.return (Value.of_option (val_tag wit) None)
-      | Some x ->
-        interp_genarg ist (Genarg.in_gen (glbwit wit) x) >>= fun x ->
-        let x = Value.cast (topwit wit) x in
-        Ftactic.return (Value.of_option (val_tag wit) (Some x))
-      in
-      ans
-    | PairArg (wit1, wit2) ->
-      let (p, q) = x in
-      interp_genarg ist (Genarg.in_gen (glbwit wit1) p) >>= fun p ->
-      interp_genarg ist (Genarg.in_gen (glbwit wit2) q) >>= fun q ->
-      let p = Value.cast (topwit wit1) p in
-      let q = Value.cast (topwit wit2) q in
-      Ftactic.return (Val.Dyn (Val.Pair (val_tag wit1, val_tag wit2), (p, q)))
-    | ExtraArg s ->
-      Geninterp.generic_interp ist (Genarg.in_gen (glbwit wit) x)
-
-(** returns [true] for genargs which have the same meaning
-    independently of goals. *)
-
-and interp_genarg_constr_list ist x =
-  Ftactic.nf_s_enter { s_enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  let lc = Genarg.out_gen (glbwit (wit_list wit_constr)) x in
-  let (sigma,lc) = interp_constr_list ist env sigma lc in
-  let lc = Value.of_list (val_tag wit_constr) lc in
-  Sigma.Unsafe.of_pair (Ftactic.return lc, sigma)
-  end }
-
-and interp_genarg_var_list ist x =
-  Ftactic.nf_enter { enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  let lc = Genarg.out_gen (glbwit (wit_list wit_var)) x in
-  let lc = interp_hyp_list ist env sigma lc in
-  Ftactic.return (Value.of_list (val_tag wit_var) lc)
-  end }
-
-(* 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 { 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 { enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = project 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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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.intro_patterns l')) sigma
-      end }
-  | TacIntroMove (ido,hto) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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.Goal.nf_s_enter { s_enter = begin fun gl ->
-        let (sigma, c_interp) = pf_interp_casted_constr ist gl c in
-        Sigma.Unsafe.of_pair (Proofview.V82.tactic (Tactics.exact_no_check c_interp), sigma)
-      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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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 { enter = begin fun gl ->
-        let sigma = project 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 }
-  | TacMutualFix (id,n,l) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual fix>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-        let env = pf_env gl in
-        let f sigma (id,n,c) =
-          let (sigma,c_interp) = pf_interp_type ist env 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
-        let tac = Proofview.V82.tactic (Tactics.mutual_fix (interp_ident ist env sigma id) n l_interp 0) in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
-      end
-  | TacMutualCofix (id,l) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual cofix>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-        let env = pf_env gl in
-        let f sigma (id,c) =
-	  let (sigma,c_interp) = pf_interp_type ist env 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
-        let tac = Proofview.V82.tactic (Tactics.mutual_cofix (interp_ident ist env sigma id) l_interp 0) in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
-      end
-  | TacAssert (b,t,ipat,c) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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 { enter = begin fun gl ->
-        let sigma = project 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.generalize_gen cl))) sigma
-      end }
-  | TacLetTac (na,c,clp,b,eqpat) ->
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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) = pf_interp_constr ist gl c 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 }
-
-  (* 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_s_enter { s_enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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 = interp_induction_arg ist gl c 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
-        let tac = name_atomic ~env
-          (TacInductionDestruct(isrec,ev,(lp,el)))
-            (Tactics.induction_destruct isrec ev (l,el))
-        in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      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 *)
-  | TacRename l ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let env = pf_env gl in
-        let sigma = project 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 }
-
-  (* Conversion *)
-  | TacReduce (r,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<reduce>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-        let (sigma,r_interp) = interp_red_expr ist (pf_env gl) (project gl) r in
-        Sigma.Unsafe.of_pair (Tactics.reduce r_interp (interp_clause ist (pf_env gl) (project gl) cl), sigma)
-      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.Goal.nf_enter { enter = 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.run = begin fun sigma ->
-	  let lfun' = Id.Map.fold (fun id c lfun ->
-	    Id.Map.add id (Value.of_constr c) lfun) 
-	    patvars ist.lfun
-	  in
-	  let sigma = Sigma.to_evar_map sigma in
-	  let ist = { ist with lfun = lfun' } in
-	  let (sigma, c) =
-            if is_onhyps && is_onconcl
-            then interp_type ist (pf_env gl) sigma c
-            else interp_constr ist (pf_env gl) sigma c
-          in
-          Sigma.Unsafe.of_pair (c, sigma)
-        end } in
-        Proofview.V82.tactic (Tactics.change None c_interp (interp_clause ist (pf_env gl) (project gl) cl))
-      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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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.run = begin fun 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
-                let sigma = Sigma.to_evar_map sigma in
-                let (sigma, c) = interp_constr ist env sigma c in
-                Sigma.Unsafe.of_pair (c, sigma)
-	      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.")
-          end } in
-	    (Tactics.change (Some op) c_interp (interp_clause ist env sigma cl))
-	      gl
-        end
-      end }
-      end
-
-
-  (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let l' = List.map (fun (b,m,(keep,c)) ->
-          let f = { delayed = fun env sigma ->
-            let sigma = Sigma.to_evar_map sigma in
-            let (sigma, c) = interp_open_constr_with_bindings ist env sigma c in
-            Sigma.Unsafe.of_pair (c, sigma)
-          } in
-	  (b,m,keep,f)) l in
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project gl in
-        let (sigma,c_interp) =
-          match c with
-          | None -> sigma , None
-          | Some c ->
-              let (sigma,c_interp) = pf_interp_constr ist gl c 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 { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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.s_enter { s_enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project 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
-        let tac = name_atomic ~env
-          (TacInversion (InversionUsing (c_interp,hyps),dqhyps))
-          (Leminv.lemInv_clause dqhyps c_interp hyps)
-        in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      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 { 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 { 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 x = Ftactic.return 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 lift f = (); fun ist x -> Ftactic.nf_enter { enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  Ftactic.return (f ist env sigma x)
-end }
-
-let lifts f = (); fun ist x -> Ftactic.nf_s_enter { s_enter = begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  let (sigma, v) = f ist env sigma x in
-  Sigma.Unsafe.of_pair (Ftactic.return v, sigma)
-end }
-
-let interp_bindings' ist bl = Ftactic.return { delayed = fun env sigma ->
-  let (sigma, bl) = interp_bindings ist env (Sigma.to_evar_map sigma) bl in
-  Sigma.Unsafe.of_pair (bl, sigma)
-  }
-
-let interp_constr_with_bindings' ist c = Ftactic.return { delayed = fun env sigma ->
-  let (sigma, c) = interp_constr_with_bindings ist env (Sigma.to_evar_map sigma) c in
-  Sigma.Unsafe.of_pair (c, sigma)
-  }
-
-let () =
-  Geninterp.register_interp0 wit_int_or_var (fun ist n -> Ftactic.return (interp_int_or_var ist n));
-  Geninterp.register_interp0 wit_ref (lift interp_reference);
-  Geninterp.register_interp0 wit_ident (lift interp_ident);
-  Geninterp.register_interp0 wit_var (lift interp_hyp);
-  Geninterp.register_interp0 wit_intro_pattern (lifts interp_intro_pattern);
-  Geninterp.register_interp0 wit_clause_dft_concl (lift interp_clause);
-  Geninterp.register_interp0 wit_constr (lifts interp_constr);
-  Geninterp.register_interp0 wit_sort (lifts (fun _ _ evd s -> interp_sort evd s));
-  Geninterp.register_interp0 wit_tacvalue (fun ist v -> Ftactic.return v);
-  Geninterp.register_interp0 wit_red_expr (lifts interp_red_expr);
-  Geninterp.register_interp0 wit_quant_hyp (lift interp_declared_or_quantified_hypothesis);
-  Geninterp.register_interp0 wit_open_constr (lifts interp_open_constr);
-  Geninterp.register_interp0 wit_bindings interp_bindings';
-  Geninterp.register_interp0 wit_constr_with_bindings interp_constr_with_bindings';
-  Geninterp.register_interp0 wit_constr_may_eval (lifts interp_constr_may_eval);
-  ()
-
-let () =
-  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
-  Geninterp.register_interp0 wit_tactic interp
-
-let () =
-  let interp ist tac = interp_tactic ist tac >>= fun () -> Ftactic.return () in
-  Geninterp.register_interp0 wit_ltac interp
-
-let () =
-  Geninterp.register_interp0 wit_uconstr (fun ist c -> Ftactic.nf_enter { enter = begin fun gl ->
-    Ftactic.return (interp_uconstr ist (Proofview.Goal.env gl) c)
-  end })
-
-(***************************************************************************)
-(* 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)
-
-(***************************************************************************)
-(* 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 Genarg.has_type arg (glbwit wit_tactic) then
-      let tac = Genarg.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
-
-(** 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 { enter = begin fun gl ->
-    let env = Proofview.Goal.env gl in
-    let sigma = project 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
-
-let vernac_debug b =
-  set_debug (if b then Tactic_debug.DebugOn 0 else Tactic_debug.DebugOff)
-
-let _ =
-  let open Goptions in
-  declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
-      optname  = "Ltac debug";
-      optkey   = ["Ltac";"Debug"];
-      optread  = (fun () -> get_debug () != Tactic_debug.DebugOff);
-      optwrite = vernac_debug }
-
-let () = Hook.set Vernacentries.interp_redexp_hook interp_redexp
diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli
deleted file mode 100644
index 31327873e..000000000
--- a/tactics/tacinterp.mli
+++ /dev/null
@@ -1,124 +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
-
-val ltac_trace_info : ltac_trace Exninfo.t
-
-module Value :
-sig
-  type t = Val.t
-  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
-  val cast : 'a typed_abstract_argument_type -> Val.t -> 'a
-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]. *)
-
-(** 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 *)
-
-val interp_genarg : interp_sign -> glob_generic_argument -> Value.t Ftactic.t
-
-(** 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
-
-val type_uconstr :
-  ?flags:Pretyping.inference_flags ->
-  ?expected_type:Pretyping.typing_constraint ->
-  interp_sign -> Glob_term.closed_glob_constr -> constr delayed_open
-
-(** 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]. *)
-
-val tactic_of_value : interp_sign -> Value.t -> unit Proofview.tactic
-
-(** 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 4059877b7..000000000
--- a/tactics/tacsubst.ml
+++ /dev/null
@@ -1,313 +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 (subst_intro_or_and_pattern subst l)
-  | IntroInjection l -> IntroInjection (List.map (subst_intro_pattern subst) l)
-  | IntroWildcard | IntroRewrite _ as x -> x
-
-and subst_intro_or_and_pattern subst = function
-  | IntroAndPattern l ->
-      IntroAndPattern (List.map (subst_intro_pattern subst) l)
-  | IntroOrPattern ll ->
-      IntroOrPattern (List.map (List.map (subst_intro_pattern subst)) ll)
-
-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)
-  | TacMutualFix (id,n,l) ->
-      TacMutualFix(id,n,List.map (fun (id,n,c) -> (id,n,subst_glob_constr subst c)) l)
-  | 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)
-  | TacLetTac (id,c,clp,b,eqpat) ->
-    TacLetTac (id,subst_glob_constr subst c,clp,b,eqpat)
-
-  (* 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 *)
-  | TacRename l as x -> x
-
-  (* 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)
-
-  (* 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 (subst_tacarg subst) l)
-  | TacML (_loc,opn,l) -> TacML (dloc,opn,List.map (subst_tacarg 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)
-  | 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 (subst_genarg subst arg)
-
-(* 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 (GenArg (Glbwit wit, x)) =
-  match wit with
-  | ListArg wit ->
-    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 x)
-  | OptArg wit ->
-    let ans = match x 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
-    ans
-  | PairArg (wit1, wit2) ->
-    let p, q = x 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)
-  | ExtraArg s ->
-      Genintern.generic_substitute subst (in_gen (glbwit wit) x)
-
-(** Registering *)
-
-let () =
-  Genintern.register_subst0 wit_int_or_var (fun _ v -> v);
-  Genintern.register_subst0 wit_ref subst_global_reference;
-  Genintern.register_subst0 wit_ident (fun _ v -> v);
-  Genintern.register_subst0 wit_var (fun _ v -> v);
-  Genintern.register_subst0 wit_intro_pattern (fun _ v -> v);
-  Genintern.register_subst0 wit_tactic subst_tactic;
-  Genintern.register_subst0 wit_ltac subst_tactic;
-  Genintern.register_subst0 wit_constr subst_glob_constr;
-  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);
-  Genintern.register_subst0 wit_open_constr (fun subst c -> subst_glob_constr subst c);
-  Genintern.register_subst0 wit_red_expr subst_redexp;
-  Genintern.register_subst0 wit_quant_hyp subst_declared_or_quantified_hypothesis;
-  Genintern.register_subst0 wit_bindings subst_bindings;
-  Genintern.register_subst0 wit_constr_with_bindings subst_glob_with_bindings;
-  Genintern.register_subst0 wit_constr_may_eval subst_raw_may_eval;
-  ()
diff --git a/tactics/tacsubst.mli b/tactics/tacsubst.mli
deleted file mode 100644
index c1bf27257..000000000
--- 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_debug.ml b/tactics/tactic_debug.ml
deleted file mode 100644
index d661f9677..000000000
--- a/tactics/tactic_debug.ml
+++ /dev/null
@@ -1,412 +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 Pp
-open Tacexpr
-open Termops
-open Nameops
-open Proofview.Notations
-
-
-let (ltac_trace_info : ltac_trace Exninfo.t) = Exninfo.make ()
-
-let prtac x =
-  Pptactic.pr_glob_tactic (Global.env()) x
-let prmatchpatt env sigma hyp =
-  Pptactic.pr_match_pattern (Printer.pr_constr_pattern_env env sigma) hyp
-let prmatchrl rl =
-  Pptactic.pr_match_rule false (Pptactic.pr_glob_tactic (Global.env()))
-    (fun (_,p) -> Printer.pr_constr_pattern p) rl
-
-(* This module intends to be a beginning of debugger for tactic expressions.
-   Currently, it is quite simple and we can hope to have, in the future, a more
-   complete panel of commands dedicated to a proof assistant framework *)
-
-(* Debug information *)
-type debug_info =
-  | DebugOn of int
-  | DebugOff
-
-(* An exception handler *)
-let explain_logic_error e =
-  Errors.print (fst (Cerrors.process_vernac_interp_error (e, Exninfo.null)))
-
-let explain_logic_error_no_anomaly e =
-  Errors.print_no_report (fst (Cerrors.process_vernac_interp_error (e, Exninfo.null)))
-
-let msg_tac_debug s = Proofview.NonLogical.print_debug (s++fnl())
-let msg_tac_notice s = Proofview.NonLogical.print_notice (s++fnl())
-
-(* Prints the goal *)
-
-let db_pr_goal gl =
-  let env = Proofview.Goal.env gl in
-  let concl = Proofview.Goal.concl gl in
-  let penv = print_named_context env in
-  let pc = print_constr_env env concl in
-    str"  " ++ hv 0 (penv ++ fnl () ++
-                   str "============================" ++ fnl ()  ++
-                   str" "  ++ pc) ++ fnl ()
-
-let db_pr_goal =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let pg = db_pr_goal gl in
-  Proofview.tclLIFT (msg_tac_notice (str "Goal:" ++ fnl () ++ pg))
-  end }
-
-
-(* Prints the commands *)
-let help () =
-  msg_tac_debug (str "Commands: <Enter> = Continue" ++ fnl() ++
-         str "          h/? = Help" ++ fnl() ++
-         str "          r <num> = Run <num> times" ++ fnl() ++
-         str "          r <string> = Run up to next idtac <string>" ++ fnl() ++
-         str "          s = Skip" ++ fnl() ++
-         str "          x = Exit")
-
-(* Prints the goal and the command to be executed *)
-let goal_com tac =
-  Proofview.tclTHEN
-    db_pr_goal
-    (Proofview.tclLIFT (msg_tac_debug (str "Going to execute:" ++ fnl () ++ prtac tac)))
-
-(* [run (new_ref _)] gives us a ref shared among [NonLogical.t]
-   expressions. It avoids parametrizing everything over a
-   reference. *)
-let skipped = Proofview.NonLogical.run (Proofview.NonLogical.ref 0)
-let skip = Proofview.NonLogical.run (Proofview.NonLogical.ref 0)
-let breakpoint = Proofview.NonLogical.run (Proofview.NonLogical.ref None)
-
-let rec drop_spaces inst i =
-  if String.length inst > i && inst.[i] == ' ' then drop_spaces inst (i+1)
-  else i
-
-let possibly_unquote s =
-  if String.length s >= 2 && s.[0] == '"' && s.[String.length s - 1] == '"' then
-    String.sub s 1 (String.length s - 2)
-  else
-    s
-
-(* (Re-)initialize debugger *)
-let db_initialize =
-  let open Proofview.NonLogical in
-  (skip:=0) >> (skipped:=0) >> (breakpoint:=None)
-
-let int_of_string s =
-  try Proofview.NonLogical.return (int_of_string s)
-  with e -> Proofview.NonLogical.raise e
-
-let string_get s i =
-  try Proofview.NonLogical.return (String.get s i)
-  with e -> Proofview.NonLogical.raise e
-
-(* Gives the number of steps or next breakpoint of a run command *)
-let run_com inst =
-  let open Proofview.NonLogical in
-  string_get inst 0 >>= fun first_char ->
-  if first_char ='r' then
-    let i = drop_spaces inst 1 in
-    if String.length inst > i then
-      let s = String.sub inst i (String.length inst - i) in
-      if inst.[0] >= '0' && inst.[0] <= '9' then
-        int_of_string s >>= fun num ->
-        (if num<0 then invalid_arg "run_com" else return ()) >>
-        (skip:=num) >> (skipped:=0)
-      else
-        breakpoint:=Some (possibly_unquote s)
-    else
-      invalid_arg "run_com"
-  else
-    invalid_arg "run_com"
-
-(* Prints the run counter *)
-let run ini =
-  let open Proofview.NonLogical in
-  if not ini then
-    begin
-      Proofview.NonLogical.print_notice (str"\b\r\b\r") >>
-      !skipped >>= fun skipped ->
-      msg_tac_debug (str "Executed expressions: " ++ int skipped ++ fnl())
-    end >>
-    !skipped >>= fun x ->
-    skipped := x+1
-  else
-    return ()
-
-(* Prints the prompt *)
-let rec prompt level =
-  (* spiwack: avoid overriding by the open below *)
-  let runtrue = run true in
-  begin
-    let open Proofview.NonLogical in
-    Proofview.NonLogical.print_notice (fnl () ++ str "TcDebug (" ++ int level ++ str ") > ") >>
-    let exit = (skip:=0) >> (skipped:=0) >> raise Sys.Break in
-    Proofview.NonLogical.catch Proofview.NonLogical.read_line
-      begin function (e, info) -> match e with
-        | End_of_file -> exit
-        | e -> raise ~info e
-      end
-    >>= fun inst ->
-    match inst with
-    | ""  -> return (DebugOn (level+1))
-    | "s" -> return (DebugOff)
-    | "x" -> Proofview.NonLogical.print_char '\b' >> exit
-    | "h"| "?" ->
-      begin
-        help () >>
-        prompt level
-      end
-    | _ ->
-        Proofview.NonLogical.catch (run_com inst >> runtrue >> return (DebugOn (level+1)))
-          begin function (e, info) -> match e with
-            | Failure _ | Invalid_argument _ -> prompt level
-            | e -> raise ~info e
-          end
-  end
-
-(* Prints the state and waits for an instruction *)
-(* spiwack: the only reason why we need to take the continuation [f]
-   as an argument rather than returning the new level directly seems to
-   be that [f] is wrapped in with "explain_logic_error". I don't think
-   it serves any purpose in the current design, so we could just drop
-   that. *)
-let debug_prompt lev tac f =
-  (* spiwack: avoid overriding by the open below *)
-  let runfalse = run false in
-  let open Proofview.NonLogical in
-  let (>=) = Proofview.tclBIND in
-  (* What to print and to do next *)
-  let newlevel =
-    Proofview.tclLIFT !skip >= fun initial_skip ->
-    if Int.equal initial_skip 0 then
-      Proofview.tclLIFT !breakpoint >= fun breakpoint ->
-      if Option.is_empty breakpoint then Proofview.tclTHEN (goal_com tac) (Proofview.tclLIFT (prompt lev))
-      else Proofview.tclLIFT(runfalse >> return (DebugOn (lev+1)))
-    else Proofview.tclLIFT begin
-      (!skip >>= fun s -> skip:=s-1) >>
-      runfalse >>
-      !skip >>= fun new_skip ->
-      (if Int.equal new_skip 0 then skipped:=0 else return ()) >>
-      return (DebugOn (lev+1))
-    end in
-  newlevel >= fun newlevel ->
-  (* What to execute *)
-  Proofview.tclOR
-    (f newlevel)
-    begin fun (reraise, info) ->
-      Proofview.tclTHEN
-        (Proofview.tclLIFT begin
-          (skip:=0) >> (skipped:=0) >>
-            if Logic.catchable_exception reraise then
-              msg_tac_debug (str "Level " ++ int lev ++ str ": " ++ explain_logic_error reraise)
-            else return ()
-        end)
-        (Proofview.tclZERO ~info reraise)
-    end
-
-let is_debug db =
-  let open Proofview.NonLogical in
-  !breakpoint >>= fun breakpoint ->
-  match db, breakpoint with
-  | DebugOff, _ -> return false
-  | _, Some _ -> return false
-  | _ ->
-      !skip >>= fun skip ->
-      return (Int.equal skip 0)
-
-(* Prints a constr *)
-let db_constr debug env c =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "Evaluated term: " ++ print_constr_env env c)
-  else return ()
-
-(* Prints the pattern rule *)
-let db_pattern_rule debug num r =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-  begin
-    msg_tac_debug (str "Pattern rule " ++ int num ++ str ":" ++ fnl () ++
-      str "|" ++ spc () ++ prmatchrl r)
-  end
-  else return ()
-
-(* Prints the hypothesis pattern identifier if it exists *)
-let hyp_bound = function
-  | Anonymous -> str " (unbound)"
-  | Name id -> str " (bound to " ++ pr_id id ++ str ")"
-
-(* Prints a matched hypothesis *)
-let db_matched_hyp debug env (id,_,c) ido =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "Hypothesis " ++ pr_id id ++ hyp_bound ido ++
-                str " has been matched: " ++ print_constr_env env c)
-  else return ()
-
-(* Prints the matched conclusion *)
-let db_matched_concl debug env c =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "Conclusion has been matched: " ++ print_constr_env env c)
-  else return ()
-
-(* Prints a success message when the goal has been matched *)
-let db_mc_pattern_success debug =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "The goal has been successfully matched!" ++ fnl() ++
-           str "Let us execute the right-hand side part..." ++ fnl())
-  else return ()
-
-(* Prints a failure message for an hypothesis pattern *)
-let db_hyp_pattern_failure debug env sigma (na,hyp) =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "The pattern hypothesis" ++ hyp_bound na ++
-                str " cannot match: " ++
-           prmatchpatt env sigma hyp)
-  else return ()
-
-(* Prints a matching failure message for a rule *)
-let db_matching_failure debug =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    msg_tac_debug (str "This rule has failed due to matching errors!" ++ fnl() ++
-           str "Let us try the next one...")
-  else return ()
-
-(* Prints an evaluation failure message for a rule *)
-let db_eval_failure debug s =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-    let s = str "message \"" ++ s ++ str "\"" in
-    msg_tac_debug
-      (str "This rule has failed due to \"Fail\" tactic (" ++
-       s ++ str ", level 0)!" ++ fnl() ++ str "Let us try the next one...")
-  else return ()
-
-(* Prints a logic failure message for a rule *)
-let db_logic_failure debug err =
-  let open Proofview.NonLogical in
-  is_debug debug >>= fun db ->
-  if db then
-  begin
-    msg_tac_debug (explain_logic_error err) >>
-    msg_tac_debug (str "This rule has failed due to a logic error!" ++ fnl() ++
-           str "Let us try the next one...")
-  end
-  else return ()
-
-let is_breakpoint brkname s = match brkname, s with
-  | Some s, MsgString s'::_ -> String.equal s s'
-  | _ -> false
-
-let db_breakpoint debug s =
-  let open Proofview.NonLogical in
-  !breakpoint >>= fun opt_breakpoint ->
-  match debug with
-  | DebugOn lev when not (CList.is_empty s) && is_breakpoint opt_breakpoint s ->
-      breakpoint:=None
-  | _ ->
-      return ()
-
-(** Extrating traces *)
-
-let is_defined_ltac trace =
-  let rec aux = function
-  | (_, Tacexpr.LtacNameCall f) :: tail ->
-      not (Tacenv.is_ltac_for_ml_tactic f)
-  | (_, Tacexpr.LtacAtomCall _) :: tail ->
-      false
-  | _ :: tail -> aux tail
-  | [] -> false in
-  aux (List.rev trace)
-
-let explain_ltac_call_trace last trace loc =
-  let calls = last :: List.rev_map snd trace in
-  let pr_call ck = match ck with
-  | Tacexpr.LtacNotationCall kn -> quote (KerName.print kn)
-  | Tacexpr.LtacNameCall cst -> quote (Pptactic.pr_ltac_constant cst)
-  | Tacexpr.LtacMLCall t ->
-      quote (Pptactic.pr_glob_tactic (Global.env()) t)
-  | Tacexpr.LtacVarCall (id,t) ->
-      quote (Nameops.pr_id id) ++ strbrk " (bound to " ++
-        Pptactic.pr_glob_tactic (Global.env()) t ++ str ")"
-  | Tacexpr.LtacAtomCall te ->
-      quote (Pptactic.pr_glob_tactic (Global.env())
-              (Tacexpr.TacAtom (Loc.ghost,te)))
-  | Tacexpr.LtacConstrInterp (c, { Pretyping.ltac_constrs = vars }) ->
-      quote (Printer.pr_glob_constr_env (Global.env()) c) ++
-        (if not (Id.Map.is_empty vars) then
-          strbrk " (with " ++
-            prlist_with_sep pr_comma
-            (fun (id,c) ->
-                pr_id id ++ str ":=" ++ Printer.pr_lconstr_under_binders c)
-            (List.rev (Id.Map.bindings vars)) ++ str ")"
-        else mt())
-  in
-  match calls with
-  | [] -> mt ()
-  | _ ->
-    let kind_of_last_call = match List.last calls with
-    | Tacexpr.LtacConstrInterp _ -> ", last term evaluation failed."
-    | _ -> ", last call failed."
-    in
-    hov 0 (str "In nested Ltac calls to " ++
-           pr_enum pr_call calls ++ strbrk kind_of_last_call)
-
-let skip_extensions trace =
-  let rec aux = function
-  | (_,Tacexpr.LtacNameCall f as tac) :: _ 
-      when Tacenv.is_ltac_for_ml_tactic f -> [tac]
-  | (_,(Tacexpr.LtacNotationCall _ | Tacexpr.LtacMLCall _) as tac)
-      :: _ -> [tac]
-  | t :: tail -> t :: aux tail
-  | [] -> [] in
-  List.rev (aux (List.rev trace))
-
-let extract_ltac_trace trace eloc =
-  let trace = skip_extensions trace in
-  let (loc,c),tail = List.sep_last trace in
-  if is_defined_ltac trace then
-    (* We entered a user-defined tactic,
-       we display the trace with location of the call *)
-    let msg = hov 0 (explain_ltac_call_trace c tail eloc ++ fnl()) in
-    Some msg, loc
-  else
-    (* We entered a primitive tactic, we don't display trace but
-       report on the finest location *)
-    let best_loc =
-      if not (Loc.is_ghost eloc) then eloc else
-        (* trace is with innermost call coming first *)
-        let rec aux = function
-        | (loc,_)::tail when not (Loc.is_ghost loc) -> loc
-        | _::tail -> aux tail
-        | [] -> Loc.ghost in
-        aux trace in
-    None, best_loc
-
-let get_ltac_trace (_, info) =
-  let ltac_trace = Exninfo.get info ltac_trace_info in
-  let loc = Option.default Loc.ghost (Loc.get_loc info) in
-  match ltac_trace with
-  | None -> None
-  | Some trace -> Some (extract_ltac_trace trace loc)
-
-let () = Cerrors.register_additional_error_info get_ltac_trace
diff --git a/tactics/tactic_debug.mli b/tactics/tactic_debug.mli
deleted file mode 100644
index 520fb41ef..000000000
--- a/tactics/tactic_debug.mli
+++ /dev/null
@@ -1,80 +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 Environ
-open Pattern
-open Names
-open Tacexpr
-open Term
-open Evd
-
-(** TODO: Move those definitions somewhere sensible *)
-
-val ltac_trace_info : ltac_trace Exninfo.t
-
-(** This module intends to be a beginning of debugger for tactic expressions.
-   Currently, it is quite simple and we can hope to have, in the future, a more
-   complete panel of commands dedicated to a proof assistant framework *)
-
-(** Debug information *)
-type debug_info =
-  | DebugOn of int
-  | DebugOff
-
-(** Prints the state and waits *)
-val debug_prompt :
-  int -> glob_tactic_expr -> (debug_info -> 'a Proofview.tactic) -> 'a Proofview.tactic
-
-(** Initializes debugger *)
-val db_initialize : unit Proofview.NonLogical.t
-
-(** Prints a constr *)
-val db_constr : debug_info -> env -> constr -> unit Proofview.NonLogical.t
-
-(** Prints the pattern rule *)
-val db_pattern_rule :
-  debug_info -> int -> (Tacexpr.glob_constr_and_expr * constr_pattern,glob_tactic_expr) match_rule -> unit Proofview.NonLogical.t
-
-(** Prints a matched hypothesis *)
-val db_matched_hyp :
-  debug_info -> env -> Id.t * constr option * constr -> Name.t -> unit Proofview.NonLogical.t
-
-(** Prints the matched conclusion *)
-val db_matched_concl : debug_info -> env -> constr -> unit Proofview.NonLogical.t
-
-(** Prints a success message when the goal has been matched *)
-val db_mc_pattern_success : debug_info -> unit Proofview.NonLogical.t
-
-(** Prints a failure message for an hypothesis pattern *)
-val db_hyp_pattern_failure :
-  debug_info -> env -> evar_map -> Name.t * constr_pattern match_pattern -> unit Proofview.NonLogical.t
-
-(** Prints a matching failure message for a rule *)
-val db_matching_failure : debug_info -> unit Proofview.NonLogical.t
-
-(** Prints an evaluation failure message for a rule *)
-val db_eval_failure : debug_info -> Pp.std_ppcmds -> unit Proofview.NonLogical.t
-
-(** An exception handler *)
-val explain_logic_error: exn -> Pp.std_ppcmds
-
-(** For use in the Ltac debugger: some exception that are usually
-   consider anomalies are acceptable because they are caught later in
-   the process that is being debugged.  One should not require
-   from users that they report these anomalies. *)
-val explain_logic_error_no_anomaly : exn -> Pp.std_ppcmds
-
-(** Prints a logic failure message for a rule *)
-val db_logic_failure : debug_info -> exn -> unit Proofview.NonLogical.t
-
-(** Prints a logic failure message for a rule *)
-val db_breakpoint : debug_info ->
-  Id.t Loc.located message_token list -> unit Proofview.NonLogical.t
-
-val extract_ltac_trace :
-  Tacexpr.ltac_trace -> Loc.t -> Pp.std_ppcmds option * Loc.t
diff --git a/tactics/tactic_option.ml b/tactics/tactic_option.ml
deleted file mode 100644
index a5ba3b837..000000000
--- 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 ed759a76d..000000000
--- 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/tauto.ml b/tactics/tauto.ml
deleted file mode 100644
index a86fdb98a..000000000
--- a/tactics/tauto.ml
+++ /dev/null
@@ -1,282 +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 Term
-open Hipattern
-open Names
-open Pp
-open Genarg
-open Stdarg
-open Misctypes
-open Tacexpr
-open Tacinterp
-open Tactics
-open Errors
-open Util
-open Tacticals.New
-open Proofview.Notations
-
-let tauto_plugin = "tauto"
-let () = Mltop.add_known_module tauto_plugin
-
-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;
-}
-
-let wit_tauto_flags : tauto_flags uniform_genarg_type =
-  Genarg.create_arg "tauto_flags"
-
-let assoc_flags ist =
-  let v = Id.Map.find (Names.Id.of_string "tauto_flags") ist.lfun in
-  try Value.cast (topwit wit_tauto_flags) v with _ -> assert false
-
-(* 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 }
-
-(** Base tactics *)
-
-let loc = Loc.ghost
-let idtac = Proofview.tclUNIT ()
-let fail = Proofview.tclINDEPENDENT (tclFAIL 0 (Pp.mt ()))
-
-let intro = Tactics.intro
-
-let assert_ ?by c =
-  let tac = match by with
-  | None -> None
-  | Some tac -> Some (tclCOMPLETE tac)
-  in
-  Proofview.tclINDEPENDENT (Tactics.forward true tac None c)
-
-let apply c = Tactics.apply c
-
-let clear id = Proofview.V82.tactic (fun gl -> Tactics.clear [id] gl)
-
-let assumption = Tactics.assumption
-
-let split = Tactics.split_with_bindings false [Misctypes.NoBindings]
-
-(** Test *)
-
-let is_empty _ ist =
-  if is_empty_type (assoc_var "X1" ist) then idtac else 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 _ ist =
-  let flags = assoc_flags ist in
-  let test = if flags.strict_unit then is_unit_type else is_unit_or_eq_type in
-  if test (assoc_var "X1" ist) then idtac else fail
-
-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
-
-(** Dealing with conjunction *)
-
-let is_conj _ ist =
-  let flags = assoc_flags ist in
-  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 idtac
-    else fail
-
-let flatten_contravariant_conj _ ist =
-  let flags = assoc_flags ist in
-  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 = List.fold_right mkArrow args c in
-    let intros = tclMAP (fun _ -> intro) args in
-    let by = tclTHENLIST [intros; apply hyp; split; assumption] in
-    tclTHENLIST [assert_ ~by newtyp; clear (destVar hyp)]
-  | _ -> fail
-
-(** Dealing with disjunction *)
-
-let is_disj _ ist =
-  let flags = assoc_flags ist in
-  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 idtac
-  else fail
-
-let flatten_contravariant_disj _ ist =
-  let flags = assoc_flags ist in
-  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 map i arg =
-        let typ = mkArrow arg c in
-        let ci = Tactics.constructor_tac false None (succ i) Misctypes.NoBindings in
-        let by = tclTHENLIST [intro; apply hyp; ci; assumption] in
-        assert_ ~by typ
-      in
-      let tacs = List.mapi map args in
-      let tac0 = clear (destVar hyp) in
-      tclTHEN (tclTHENLIST tacs) tac0
-  | _ -> fail
-
-let make_unfold name =
-  let dir = DirPath.make (List.map Id.of_string ["Logic"; "Init"; "Coq"]) in
-  let const = Constant.make2 (MPfile dir) (Label.make name) in
-  (Locus.AllOccurrences, ArgArg (EvalConstRef const, None))
-
-let u_iff = make_unfold "iff"
-let u_not = make_unfold "not"
-
-let reduction_not_iff _ ist =
-  let make_reduce c = TacAtom (loc, TacReduce (Genredexpr.Unfold c, Locusops.allHypsAndConcl)) in
-  let tac = match !negation_unfolding, unfold_iff () with
-    | true, true -> make_reduce [u_not; u_iff]
-    | true, false -> make_reduce [u_not]
-    | false, true -> make_reduce [u_iff]
-    | false, false -> TacId []
-  in
-  eval_tactic_ist ist tac
-
-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 apply_nnpp _ ist =
-  Proofview.tclBIND
-    (Proofview.tclUNIT ())
-    begin fun () -> try
-      let nnpp = Universes.constr_of_global (Nametab.global_of_path coq_nnpp_path) in
-      apply nnpp
-    with Not_found -> tclFAIL 0 (Pp.mt ())
-    end
-
-(* 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 with_flags flags _ ist =
-  let f = (loc, Id.of_string "f") in
-  let x = (loc, Id.of_string "x") in
-  let arg = Val.Dyn (val_tag (topwit wit_tauto_flags), flags) in
-  let ist = { ist with lfun = Id.Map.add (snd x) arg ist.lfun } in
-  eval_tactic_ist ist (TacArg (loc, TacCall (loc, ArgVar f, [Reference (ArgVar x)])))
-
-let register_tauto_tactic tac name0 args =
-  let ids = List.map (fun id -> Id.of_string id) args in
-  let ids = List.map (fun id -> Some id) ids in
-  let name = { mltac_plugin = tauto_plugin; mltac_tactic = name0; } in
-  let entry = { mltac_name = name; mltac_index = 0 } in
-  let () = Tacenv.register_ml_tactic name [| tac |] in
-  let tac = TacFun (ids, TacML (loc, entry, [])) in
-  let obj () = Tacenv.register_ltac true true (Id.of_string name0) tac in
-  Mltop.declare_cache_obj obj tauto_plugin
-
-let () = register_tauto_tactic is_empty "is_empty" ["tauto_flags"; "X1"]
-let () = register_tauto_tactic is_unit_or_eq "is_unit_or_eq" ["tauto_flags"; "X1"]
-let () = register_tauto_tactic is_disj "is_disj" ["tauto_flags"; "X1"]
-let () = register_tauto_tactic is_conj "is_conj" ["tauto_flags"; "X1"]
-let () = register_tauto_tactic flatten_contravariant_disj "flatten_contravariant_disj" ["tauto_flags"; "X1"; "X2"; "id"]
-let () = register_tauto_tactic flatten_contravariant_conj "flatten_contravariant_conj" ["tauto_flags"; "X1"; "X2"; "id"]
-let () = register_tauto_tactic apply_nnpp "apply_nnpp" []
-let () = register_tauto_tactic reduction_not_iff "reduction_not_iff" []
-let () = register_tauto_tactic (with_flags tauto_uniform_unit_flags) "with_uniform_flags" ["f"]
-let () = register_tauto_tactic (with_flags tauto_power_flags) "with_power_flags" ["f"]
diff --git a/tactics/tauto.mli b/tactics/tauto.mli
deleted file mode 100644
index e69de29bb..000000000
--- a/tactics/tauto.mli
+++ /dev/null