Imported Upstream version 8.9.0upstream/8.9.0upstream

163 files changed, 4065 insertions, 5529 deletions

diff --git a/plugins/.merlin b/plugins/.merlin.in
index 2ba61696..2ba61696 100644
--- a/plugins/.merlin
+++ b/plugins/.merlin.in
diff --git a/plugins/btauto/Algebra.v b/plugins/btauto/Algebra.v
index ee7341a4..f1095fc9 100644
--- a/plugins/btauto/Algebra.v
+++ b/plugins/btauto/Algebra.v
@@ -1,4 +1,4 @@
-Require Import Bool PArith DecidableClass Omega ROmega.
+Require Import Bool PArith DecidableClass Omega Lia.
 
 Ltac bool :=
 repeat match goal with
@@ -84,9 +84,9 @@ Ltac case_decide := match goal with
   let H := fresh "H" in
   define (@decide P D) b H; destruct b; try_decide
 | [ |- context [Pos.compare ?x ?y] ] =>
-  destruct (Pos.compare_spec x y); try (exfalso; zify; romega)
+  destruct (Pos.compare_spec x y); try lia
 | [ X : context [Pos.compare ?x ?y] |- _ ] =>
-  destruct (Pos.compare_spec x y); try (exfalso; zify; romega)
+  destruct (Pos.compare_spec x y); try lia
 end.
 
 Section Definitions.
@@ -325,13 +325,13 @@ Qed.
 
 Lemma linear_le_compat : forall k l p, linear k p -> (k <= l)%positive -> linear l p.
 Proof.
-intros k l p H; revert l; induction H; constructor; eauto; zify; romega.
+intros k l p H; revert l; induction H; constructor; eauto; lia.
 Qed.
 
 Lemma linear_valid_incl : forall k p, linear k p -> valid k p.
 Proof.
 intros k p H; induction H; constructor; auto.
-eapply valid_le_compat; eauto; zify; romega.
+eapply valid_le_compat; eauto; lia.
 Qed.
 
 End Validity.
@@ -417,13 +417,13 @@ Qed.
 Hint Extern 5 =>
 match goal with
 | [ |- (Pos.max ?x ?y <= ?z)%positive ] =>
-  apply Pos.max_case_strong; intros; zify; romega
+  apply Pos.max_case_strong; intros; lia
 | [ |- (?z <= Pos.max ?x ?y)%positive ] =>
-  apply Pos.max_case_strong; intros; zify; romega
+  apply Pos.max_case_strong; intros; lia
 | [ |- (Pos.max ?x ?y < ?z)%positive ] =>
-  apply Pos.max_case_strong; intros; zify; romega
+  apply Pos.max_case_strong; intros; lia
 | [ |- (?z < Pos.max ?x ?y)%positive ] =>
-  apply Pos.max_case_strong; intros; zify; romega
+  apply Pos.max_case_strong; intros; lia
 | _ => zify; omega
 end.
 Hint Resolve Pos.le_max_r Pos.le_max_l.
@@ -445,8 +445,8 @@ intros kl kr pl pr Hl Hr; revert kr pr Hr; induction Hl; intros kr pr Hr; simpl.
       now rewrite <- (Pos.max_id i); intuition.
     destruct (Pos.compare_spec i i0); subst; try case_decide; repeat (constructor; intuition).
       + apply (valid_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; auto.
-      + apply (valid_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; zify; romega.
-      + apply (valid_le_compat (Pos.max (Pos.succ i0) (Pos.succ i0))); [now auto|]; rewrite Pos.max_id; zify; romega.
+      + apply (valid_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; lia.
+      + apply (valid_le_compat (Pos.max (Pos.succ i0) (Pos.succ i0))); [now auto|]; rewrite Pos.max_id; lia.
       + apply (valid_le_compat (Pos.max (Pos.succ i) i0)); intuition.
       + apply (valid_le_compat (Pos.max i (Pos.succ i0))); intuition.
 }
@@ -456,7 +456,7 @@ Lemma poly_mul_cst_valid_compat : forall k v p, valid k p -> valid k (poly_mul_c
 Proof.
 intros k v p H; induction H; simpl; [now auto|].
 case_decide; [|now auto].
-eapply (valid_le_compat i); [now auto|zify; romega].
+eapply (valid_le_compat i); [now auto|lia].
 Qed.
 
 Lemma poly_mul_mon_null_compat : forall i p, null (poly_mul_mon i p) -> null p.
diff --git a/plugins/btauto/g_btauto.ml4 b/plugins/btauto/g_btauto.mlg
index 3ae0f45c..312ef1e5 100644
--- a/plugins/btauto/g_btauto.ml4
+++ b/plugins/btauto/g_btauto.mlg
@@ -8,11 +8,15 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Ltac_plugin
 
+}
+
 DECLARE PLUGIN "btauto_plugin"
 
 TACTIC EXTEND btauto
-| [ "btauto" ] -> [ Refl_btauto.Btauto.tac ]
+| [ "btauto" ] -> { Refl_btauto.Btauto.tac }
 END
 
diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index a09abfa1..c2bc8c07 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -1,12 +1,24 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Constr
+
 let contrib_name = "btauto"
 
 let init_constant dir s =
   let find_constant contrib dir s =
-    Universes.constr_of_global (Coqlib.find_reference contrib dir s)
+    UnivGen.constr_of_global (Coqlib.find_reference contrib dir s)
   in
   find_constant contrib_name dir s
 
-let get_constant dir s = lazy (Universes.constr_of_global @@ Coqlib.coq_reference contrib_name dir s)
+let get_constant dir s = lazy (UnivGen.constr_of_global @@ Coqlib.coq_reference contrib_name dir s)
 
 let get_inductive dir s =
   let glob_ref () = Coqlib.find_reference contrib_name ("Coq" :: dir) s in
@@ -106,7 +118,7 @@ module Bool = struct
     let negb = Lazy.force negb in
 
     let rec aux c = match decomp_term sigma c with
-    | Term.App (head, args) ->
+    | App (head, args) ->
       if head === andb && Array.length args = 2 then
         Andb (aux args.(0), aux args.(1))
       else if head === orb && Array.length args = 2 then
@@ -116,9 +128,9 @@ module Bool = struct
       else if head === negb && Array.length args = 1 then
         Negb (aux args.(0))
       else Var (Env.add env c)
-    | Term.Case (info, r, arg, pats) ->
+    | Case (info, r, arg, pats) ->
       let is_bool =
-        let i = info.Term.ci_ind in
+        let i = info.ci_ind in
         Names.eq_ind i (Lazy.force ind)
       in
       if is_bool then
@@ -176,9 +188,9 @@ module Btauto = struct
     let _, var = Tacmach.pf_reduction_of_red_expr gl (Genredexpr.CbvVm None) var in
     let var = EConstr.Unsafe.to_constr var in
     let rec to_list l = match decomp_term (Tacmach.project gl) l with
-    | Term.App (c, _)
+    | App (c, _)
       when c === (Lazy.force CoqList._nil) -> []
-    | Term.App (c, [|_; h; t|])
+    | App (c, [|_; h; t|])
       when c === (Lazy.force CoqList._cons) ->
       if h === (Lazy.force Bool.trueb) then (true :: to_list t)
       else if h === (Lazy.force Bool.falseb) then (false :: to_list t)
@@ -218,7 +230,7 @@ module Btauto = struct
       let concl = EConstr.Unsafe.to_constr concl in
       let t = decomp_term (Tacmach.New.project gl) concl in
       match t with
-      | Term.App (c, [|typ; p; _|]) when c === eq ->
+      | App (c, [|typ; p; _|]) when c === eq ->
       (* should be an equality [@eq poly ?p (Cst false)] *)
           let tac = Tacticals.New.tclORELSE0 Tactics.reflexivity (Proofview.V82.tactic (print_counterexample p env)) in
           tac
@@ -236,7 +248,7 @@ module Btauto = struct
       let bool = Lazy.force Bool.typ in
       let t = decomp_term sigma concl in
       match t with
-      | Term.App (c, [|typ; tl; tr|])
+      | App (c, [|typ; tl; tr|])
           when typ === bool && c === eq ->
           let env = Env.empty () in
           let fl = Bool.quote env sigma tl in
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index 8e53a044..f26ec0f4 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -26,6 +26,10 @@ let init_size=5
 
 let cc_verbose=ref false
 
+let print_constr t =
+  let sigma, env = Pfedit.get_current_context () in
+  Printer.pr_econstr_env env sigma t
+
 let debug x =
   if !cc_verbose then Feedback.msg_debug (x ())
 
@@ -130,8 +134,8 @@ type cinfo=
      ci_nhyps: int}     (* # projectable args *)
 
 let family_eq f1 f2 = match f1, f2 with
-  | Prop Pos, Prop Pos
-  | Prop Null, Prop Null
+  | Set, Set
+  | Prop, Prop
   | Type _, Type _ -> true
   | _ -> false
 
@@ -457,10 +461,10 @@ let rec canonize_name sigma c =
       | LetIn (na,b,t,ct) ->
 	  mkLetIn (na, func b,func t,func ct)
       | App (ct,l) ->
-	  mkApp (func ct,Array.smartmap func l)
+          mkApp (func ct,Array.Smart.map func l)
       | Proj(p,c) ->
 	let p' = Projection.map (fun kn ->
-          Constant.make1 (Constant.canonical kn)) p in 
+          MutInd.make1 (MutInd.canonical kn)) p in
 	  (mkProj (p', func c))
       | _ -> c
 
@@ -483,10 +487,10 @@ let rec inst_pattern subst = function
 	   args t
 
 let pr_idx_term uf i = str "[" ++ int i ++ str ":=" ++
-  Termops.print_constr (EConstr.of_constr (constr_of_term (term uf i))) ++ str "]"
+  print_constr (EConstr.of_constr (constr_of_term (term uf i))) ++ str "]"
 
 let pr_term t = str "[" ++
-  Termops.print_constr (EConstr.of_constr (constr_of_term t)) ++ str "]"
+  print_constr (EConstr.of_constr (constr_of_term t)) ++ str "]"
 
 let rec add_term state t=
   let uf=state.uf in
@@ -601,7 +605,7 @@ let add_inst state (inst,int_subst) =
 	      begin
 		debug (fun () ->
 		   (str "Adding new equality, depth="++ int state.rew_depth) ++ fnl () ++
-	          (str "  [" ++ Termops.print_constr (EConstr.of_constr prf) ++ str " : " ++
+                  (str "  [" ++ print_constr (EConstr.of_constr prf) ++ str " : " ++
 			   pr_term s ++ str " == " ++ pr_term t ++ str "]"));
 		add_equality state prf s t
 	      end
@@ -609,7 +613,7 @@ let add_inst state (inst,int_subst) =
 	      begin
 		debug (fun () ->
 		   (str "Adding new disequality, depth="++ int state.rew_depth) ++ fnl () ++
-	          (str "  [" ++ Termops.print_constr (EConstr.of_constr prf) ++ str " : " ++
+                  (str "  [" ++ print_constr (EConstr.of_constr prf) ++ str " : " ++
 			   pr_term s ++ str " <> " ++ pr_term t ++ str "]"));
 		add_disequality state (Hyp prf) s t
 	      end
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index d19817e7..2eaa6146 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -49,7 +49,7 @@ let whd_delta env sigma t =
 (* decompose member of equality in an applicative format *)
 
 (** FIXME: evar leak *)
-let sf_of env sigma c = e_sort_of env (ref sigma) c
+let sf_of env sigma c = snd (sort_of env sigma c)
 
 let rec decompose_term env sigma t=
     match EConstr.kind sigma (whd env sigma t) with
@@ -84,13 +84,13 @@ let rec decompose_term env sigma t=
 	let canon_const = Constant.make1 (Constant.canonical c) in 
 	  (Symb (Constr.mkConstU (canon_const,u)))
     | Proj (p, c) -> 
-	let canon_const kn = Constant.make1 (Constant.canonical kn) in 
-	let p' = Projection.map canon_const p in
+        let canon_mind kn = MutInd.make1 (MutInd.canonical kn) in
+        let p' = Projection.map canon_mind p in
 	let c = Retyping.expand_projection env sigma p' c [] in
 	decompose_term env sigma c
     | _ ->
        let t = Termops.strip_outer_cast sigma t in
-       if closed0 sigma t then Symb (EConstr.to_constr sigma t) else raise Not_found
+       if closed0 sigma t then Symb (EConstr.to_constr ~abort_on_undefined_evars:false sigma t) else raise Not_found
 
 (* decompose equality in members and type *)
 open Termops
@@ -264,9 +264,8 @@ let app_global_with_holes f args n =
       let ans = mkApp (fc, args) in
       let (sigma, holes) = gen_holes env sigma t n [] in
       let ans = applist (ans, holes) in
-      let evdref = ref sigma in
-      let () = Typing.e_check env evdref ans concl in
-      (!evdref, ans)
+      let sigma = Typing.check env sigma ans concl in
+      (sigma, ans)
     end
   end
 
@@ -444,7 +443,7 @@ let cc_tactic depth additionnal_terms =
             let open Glob_term in
             let env = Proofview.Goal.env gl in
             let terms_to_complete = List.map (build_term_to_complete uf) (epsilons uf) in
-            let hole = DAst.make @@ GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None) in
+            let hole = DAst.make @@ GHole (Evar_kinds.InternalHole, Namegen.IntroAnonymous, None) in
             let pr_missing (c, missing) =
               let c = Detyping.detype Detyping.Now ~lax:true false Id.Set.empty env sigma c in
               let holes = List.init missing (fun _ -> hole) in
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.mlg
index fb013ac1..68505929 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.mlg
@@ -8,22 +8,26 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Ltac_plugin
 open Cctac
 open Stdarg
 
+}
+
 DECLARE PLUGIN "cc_plugin"
 
 (* Tactic registration *)
 
 TACTIC EXTEND cc
- [ "congruence" ] -> [ congruence_tac 1000 [] ]
- |[ "congruence" integer(n) ] -> [ congruence_tac n [] ]
- |[ "congruence" "with" ne_constr_list(l) ] -> [ congruence_tac 1000 l ]
+| [ "congruence" ] -> { congruence_tac 1000 [] }
+| [ "congruence" integer(n) ] -> { congruence_tac n [] }
+| [ "congruence" "with" ne_constr_list(l) ] -> { congruence_tac 1000 l }
  |[ "congruence" integer(n) "with" ne_constr_list(l) ] ->
-   [ congruence_tac n l ]
+   { congruence_tac n l }
 END
 
 TACTIC EXTEND f_equal
- [ "f_equal" ] -> [ f_equal ]
+| [ "f_equal" ] -> { f_equal }
 END
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index 8a55538b..480819eb 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -61,7 +61,7 @@ let start_deriving f suchthat lemma =
         | Proved (opaque, None, obj) ->
             match Proof_global.(obj.entries) with
             | [_;f_def;lemma_def] ->
-                opaque <> Vernacexpr.Transparent , f_def , lemma_def
+                opaque <> Proof_global.Transparent , f_def , lemma_def
             | _ -> assert false
       in
       (** The opacity of [f_def] is adjusted to be [false], as it
diff --git a/plugins/extraction/ExtrHaskellString.v b/plugins/extraction/ExtrHaskellString.v
index ac1f6f91..a4a40d3c 100644
--- a/plugins/extraction/ExtrHaskellString.v
+++ b/plugins/extraction/ExtrHaskellString.v
@@ -35,6 +35,8 @@ Extract Inductive ascii => "Prelude.Char"
               (Data.Bits.testBit (Data.Char.ord a) 6)
               (Data.Bits.testBit (Data.Char.ord a) 7))".
 Extract Inlined Constant Ascii.ascii_dec => "(Prelude.==)".
+Extract Inlined Constant Ascii.eqb => "(Prelude.==)".
 
 Extract Inductive string => "Prelude.String" [ "([])" "(:)" ].
 Extract Inlined Constant String.string_dec => "(Prelude.==)".
+Extract Inlined Constant String.eqb => "(Prelude.==)".
diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v
index 030b486b..a2a6a8fe 100644
--- a/plugins/extraction/ExtrOcamlString.v
+++ b/plugins/extraction/ExtrOcamlString.v
@@ -33,6 +33,7 @@ Extract Constant shift =>
  "fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)".
 
 Extract Inlined Constant ascii_dec => "(=)".
+Extract Inlined Constant Ascii.eqb => "(=)".
 
 Extract Inductive string => "char list" [ "[]" "(::)" ].
 
diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli
index 78545c8b..07237d75 100644
--- a/plugins/extraction/common.mli
+++ b/plugins/extraction/common.mli
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 open Names
-open Globnames
 open Miniml
 
 (** By default, in module Format, you can do horizontal placing of blocks
@@ -54,7 +53,7 @@ val opened_libraries : unit -> ModPath.t list
 
 type kind = Term | Type | Cons | Mod
 
-val pp_global : kind -> global_reference -> string
+val pp_global : kind -> GlobRef.t -> string
 val pp_module : ModPath.t -> string
 
 val top_visible_mp : unit -> ModPath.t
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 397cb292..4ede11b5 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -79,7 +79,7 @@ module type VISIT = sig
 
   (* Add reference / ... in the visit lists.
      These functions silently add the mp of their arg in the mp list *)
-  val add_ref : global_reference -> unit
+  val add_ref : GlobRef.t -> unit
   val add_kn : KerName.t -> unit
   val add_decl_deps : ml_decl -> unit
   val add_spec_deps : ml_spec -> unit
@@ -596,19 +596,18 @@ let warns () =
 
 let rec locate_ref = function
   | [] -> [],[]
-  | r::l ->
-      let q = qualid_of_reference r in
-      let mpo = try Some (Nametab.locate_module q.CAst.v) with Not_found -> None
+  | qid::l ->
+      let mpo = try Some (Nametab.locate_module qid) with Not_found -> None
       and ro =
-        try Some (Smartlocate.global_with_alias r)
+        try Some (Smartlocate.global_with_alias qid)
         with Nametab.GlobalizationError _ | UserError _ -> None
       in
       match mpo, ro with
-	| None, None -> Nametab.error_global_not_found q
+        | None, None -> Nametab.error_global_not_found qid
 	| None, Some r -> let refs,mps = locate_ref l in r::refs,mps
 	| Some mp, None -> let refs,mps = locate_ref l in refs,mp::mps
 	| Some mp, Some r ->
-           warning_ambiguous_name (q.CAst.v,mp,r);
+           warning_ambiguous_name (qid,mp,r);
            let refs,mps = locate_ref l in refs,mp::mps
 
 (*s Recursive extraction in the Coq toplevel. The vernacular command is
@@ -646,7 +645,7 @@ let separate_extraction lr =
     is \verb!Extraction! [qualid]. *)
 
 let simple_extraction r =
-  Vernacentries.dump_global CAst.(make (Misctypes.AN r));
+  Vernacentries.dump_global CAst.(make (Constrexpr.AN r));
   match locate_ref [r] with
   | ([], [mp]) as p -> full_extr None p
   | [r],[] ->
diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli
index 591d3bb8..54fde2ca 100644
--- a/plugins/extraction/extract_env.mli
+++ b/plugins/extraction/extract_env.mli
@@ -12,21 +12,20 @@
 
 open Names
 open Libnames
-open Globnames
 
-val simple_extraction : reference -> unit
-val full_extraction : string option -> reference list -> unit
-val separate_extraction : reference list -> unit
+val simple_extraction : qualid -> unit
+val full_extraction : string option -> qualid list -> unit
+val separate_extraction : qualid list -> unit
 val extraction_library : bool -> Id.t -> unit
 
 (* For the test-suite : extraction to a temporary file + ocamlc on it *)
 
-val extract_and_compile : reference list -> unit
+val extract_and_compile : qualid list -> unit
 
 (* For debug / external output via coqtop.byte + Drop : *)
 
 val mono_environment :
- global_reference list -> ModPath.t list -> Miniml.ml_structure
+ GlobRef.t list -> ModPath.t list -> Miniml.ml_structure
 
 (* Used by the Relation Extraction plugin *)
 
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index f25f6362..67c605ea 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -431,7 +431,7 @@ and extract_really_ind env kn mib =
     let packets =
       Array.mapi
 	(fun i mip ->
-	   let (_,u),_ = Universes.fresh_inductive_instance env (kn,i) in
+           let (_,u),_ = UnivGen.fresh_inductive_instance env (kn,i) in
 	   let ar = Inductive.type_of_inductive env ((mib,mip),u) in
            let ar = EConstr.of_constr ar in
            let info = (fst (flag_of_type env sg ar) = Info) in
@@ -488,7 +488,7 @@ and extract_really_ind env kn mib =
 	    Int.equal (List.length l) 1 && not (type_mem_kn kn (List.hd l))
 	then raise (I Singleton);
 	if List.is_empty l then raise (I Standard);
-	if Option.is_empty mib.mind_record then raise (I Standard);
+        if mib.mind_record == Declarations.NotRecord then raise (I Standard);
 	(* Now we're sure it's a record. *)
 	(* First, we find its field names. *)
 	let rec names_prod t = match Constr.kind t with
@@ -1065,9 +1065,14 @@ let extract_constant env kn cb =
         (match cb.const_body with
 	  | Undef _ -> warn_info (); mk_typ_ax ()
 	  | Def c ->
-	     (match cb.const_proj with
+             (match Recordops.find_primitive_projection kn with
               | None -> mk_typ (get_body c)
-              | Some pb -> mk_typ (EConstr.of_constr pb.proj_body))
+              | Some p ->
+                let p = Projection.make p false in
+                let ind = Projection.inductive p in
+                let bodies = Inductiveops.legacy_match_projection env ind in
+                let body = bodies.(Projection.arg p) in
+                mk_typ (EConstr.of_constr body))
 	  | OpaqueDef c ->
 	    add_opaque r;
             if access_opaque () then mk_typ (get_opaque env c)
@@ -1076,9 +1081,14 @@ let extract_constant env kn cb =
         (match cb.const_body with
 	  | Undef _ -> warn_info (); mk_ax ()
 	  | Def c ->
-	     (match cb.const_proj with
+             (match Recordops.find_primitive_projection kn with
               | None -> mk_def (get_body c)
-              | Some pb -> mk_def (EConstr.of_constr pb.proj_body))
+              | Some p ->
+                let p = Projection.make p false in
+                let ind = Projection.inductive p in
+                let bodies = Inductiveops.legacy_match_projection env ind in
+                let body = bodies.(Projection.arg p) in
+                mk_def (EConstr.of_constr body))
 	  | OpaqueDef c ->
 	    add_opaque r;
             if access_opaque () then mk_def (get_opaque env c)
diff --git a/plugins/extraction/miniml.ml b/plugins/extraction/miniml.ml
index e1e49d92..ce920ad6 100644
--- a/plugins/extraction/miniml.ml
+++ b/plugins/extraction/miniml.ml
@@ -11,7 +11,6 @@
 (*s Target language for extraction: a core ML called MiniML. *)
 
 open Names
-open Globnames
 
 (* The [signature] type is used to know how many arguments a CIC
    object expects, and what these arguments will become in the ML
@@ -26,7 +25,7 @@ open Globnames
 type kill_reason =
   | Ktype
   | Kprop
-  | Kimplicit of global_reference * int  (* n-th arg of a cst or construct *)
+  | Kimplicit of GlobRef.t * int  (* n-th arg of a cst or construct *)
 
 type sign = Keep | Kill of kill_reason
 
@@ -39,7 +38,7 @@ type signature = sign list
 
 type ml_type =
   | Tarr    of ml_type * ml_type
-  | Tglob   of global_reference * ml_type list
+  | Tglob   of GlobRef.t * ml_type list
   | Tvar    of int
   | Tvar'   of int (* same as Tvar, used to avoid clash *)
   | Tmeta   of ml_meta (* used during ML type reconstruction *)
@@ -60,7 +59,7 @@ type inductive_kind =
   | Singleton
   | Coinductive
   | Standard
-  | Record of global_reference option list (* None for anonymous field *)
+  | Record of GlobRef.t option list (* None for anonymous field *)
 
 (* A [ml_ind_packet] is the miniml counterpart of a [one_inductive_body].
    If the inductive is logical ([ip_logical = false]), then all other fields
@@ -118,8 +117,8 @@ and ml_ast =
   | MLapp    of ml_ast * ml_ast list
   | MLlam    of ml_ident * ml_ast
   | MLletin  of ml_ident * ml_ast * ml_ast
-  | MLglob   of global_reference
-  | MLcons   of ml_type * global_reference * ml_ast list
+  | MLglob   of GlobRef.t
+  | MLcons   of ml_type * GlobRef.t * ml_ast list
   | MLtuple  of ml_ast list
   | MLcase   of ml_type * ml_ast * ml_branch array
   | MLfix    of int * Id.t array * ml_ast array
@@ -129,24 +128,24 @@ and ml_ast =
   | MLmagic  of ml_ast
 
 and ml_pattern =
-  | Pcons   of global_reference * ml_pattern list
+  | Pcons   of GlobRef.t * ml_pattern list
   | Ptuple  of ml_pattern list
   | Prel    of int (** Cf. the idents in the branch. [Prel 1] is the last one. *)
   | Pwild
-  | Pusual  of global_reference (** Shortcut for Pcons (r,[Prel n;...;Prel 1]) **)
+  | Pusual  of GlobRef.t (** Shortcut for Pcons (r,[Prel n;...;Prel 1]) **)
 
 (*s ML declarations. *)
 
 type ml_decl =
   | Dind  of MutInd.t * ml_ind
-  | Dtype of global_reference * Id.t list * ml_type
-  | Dterm of global_reference * ml_ast * ml_type
-  | Dfix  of global_reference array * ml_ast array * ml_type array
+  | Dtype of GlobRef.t * Id.t list * ml_type
+  | Dterm of GlobRef.t * ml_ast * ml_type
+  | Dfix  of GlobRef.t array * ml_ast array * ml_type array
 
 type ml_spec =
   | Sind  of MutInd.t * ml_ind
-  | Stype of global_reference * Id.t list * ml_type option
-  | Sval  of global_reference * ml_type
+  | Stype of GlobRef.t * Id.t list * ml_type option
+  | Sval  of GlobRef.t * ml_type
 
 type ml_specif =
   | Spec of ml_spec
diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli
index e1e49d92..ce920ad6 100644
--- a/plugins/extraction/miniml.mli
+++ b/plugins/extraction/miniml.mli
@@ -11,7 +11,6 @@
 (*s Target language for extraction: a core ML called MiniML. *)
 
 open Names
-open Globnames
 
 (* The [signature] type is used to know how many arguments a CIC
    object expects, and what these arguments will become in the ML
@@ -26,7 +25,7 @@ open Globnames
 type kill_reason =
   | Ktype
   | Kprop
-  | Kimplicit of global_reference * int  (* n-th arg of a cst or construct *)
+  | Kimplicit of GlobRef.t * int  (* n-th arg of a cst or construct *)
 
 type sign = Keep | Kill of kill_reason
 
@@ -39,7 +38,7 @@ type signature = sign list
 
 type ml_type =
   | Tarr    of ml_type * ml_type
-  | Tglob   of global_reference * ml_type list
+  | Tglob   of GlobRef.t * ml_type list
   | Tvar    of int
   | Tvar'   of int (* same as Tvar, used to avoid clash *)
   | Tmeta   of ml_meta (* used during ML type reconstruction *)
@@ -60,7 +59,7 @@ type inductive_kind =
   | Singleton
   | Coinductive
   | Standard
-  | Record of global_reference option list (* None for anonymous field *)
+  | Record of GlobRef.t option list (* None for anonymous field *)
 
 (* A [ml_ind_packet] is the miniml counterpart of a [one_inductive_body].
    If the inductive is logical ([ip_logical = false]), then all other fields
@@ -118,8 +117,8 @@ and ml_ast =
   | MLapp    of ml_ast * ml_ast list
   | MLlam    of ml_ident * ml_ast
   | MLletin  of ml_ident * ml_ast * ml_ast
-  | MLglob   of global_reference
-  | MLcons   of ml_type * global_reference * ml_ast list
+  | MLglob   of GlobRef.t
+  | MLcons   of ml_type * GlobRef.t * ml_ast list
   | MLtuple  of ml_ast list
   | MLcase   of ml_type * ml_ast * ml_branch array
   | MLfix    of int * Id.t array * ml_ast array
@@ -129,24 +128,24 @@ and ml_ast =
   | MLmagic  of ml_ast
 
 and ml_pattern =
-  | Pcons   of global_reference * ml_pattern list
+  | Pcons   of GlobRef.t * ml_pattern list
   | Ptuple  of ml_pattern list
   | Prel    of int (** Cf. the idents in the branch. [Prel 1] is the last one. *)
   | Pwild
-  | Pusual  of global_reference (** Shortcut for Pcons (r,[Prel n;...;Prel 1]) **)
+  | Pusual  of GlobRef.t (** Shortcut for Pcons (r,[Prel n;...;Prel 1]) **)
 
 (*s ML declarations. *)
 
 type ml_decl =
   | Dind  of MutInd.t * ml_ind
-  | Dtype of global_reference * Id.t list * ml_type
-  | Dterm of global_reference * ml_ast * ml_type
-  | Dfix  of global_reference array * ml_ast array * ml_type array
+  | Dtype of GlobRef.t * Id.t list * ml_type
+  | Dterm of GlobRef.t * ml_ast * ml_type
+  | Dfix  of GlobRef.t array * ml_ast array * ml_type array
 
 type ml_spec =
   | Sind  of MutInd.t * ml_ind
-  | Stype of global_reference * Id.t list * ml_type option
-  | Sval  of global_reference * ml_type
+  | Stype of GlobRef.t * Id.t list * ml_type option
+  | Sval  of GlobRef.t * ml_type
 
 type ml_specif =
   | Spec of ml_spec
diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml
index 0656d487..9f5c1f1a 100644
--- a/plugins/extraction/mlutil.ml
+++ b/plugins/extraction/mlutil.ml
@@ -59,7 +59,7 @@ let rec eq_ml_type t1 t2 = match t1, t2 with
 | Tarr (tl1, tr1), Tarr (tl2, tr2) ->
   eq_ml_type tl1 tl2 && eq_ml_type tr1 tr2
 | Tglob (gr1, t1), Tglob (gr2, t2) ->
-  eq_gr gr1 gr2 && List.equal eq_ml_type t1 t2
+  GlobRef.equal gr1 gr2 && List.equal eq_ml_type t1 t2
 | Tvar i1, Tvar i2 -> Int.equal i1 i2
 | Tvar' i1, Tvar' i2 -> Int.equal i1 i2
 | Tmeta m1, Tmeta m2 -> eq_ml_meta m1 m2
@@ -120,7 +120,7 @@ let rec mgu = function
       | None -> m.contents <- Some t)
   | Tarr(a, b), Tarr(a', b') ->
       mgu (a, a'); mgu (b, b')
-  | Tglob (r,l), Tglob (r',l') when Globnames.eq_gr r r' ->
+  | Tglob (r,l), Tglob (r',l') when GlobRef.equal r r' ->
        List.iter mgu (List.combine l l')
   | Tdummy _, Tdummy _ -> ()
   | Tvar i, Tvar j when Int.equal i j -> ()
@@ -270,7 +270,7 @@ let rec var2var' = function
   | Tglob (r,l) -> Tglob (r, List.map var2var' l)
   | a -> a
 
-type abbrev_map = global_reference -> ml_type option
+type abbrev_map = GlobRef.t -> ml_type option
 
 (*s Delta-reduction of type constants everywhere in a ML type [t].
    [env] is a function of type [ml_type_env]. *)
@@ -381,9 +381,9 @@ let rec eq_ml_ast t1 t2 = match t1, t2 with
   eq_ml_ident na1 na2 && eq_ml_ast t1 t2
 | MLletin (na1, c1, t1), MLletin (na2, c2, t2) ->
   eq_ml_ident na1 na2 && eq_ml_ast c1 c2 && eq_ml_ast t1 t2
-| MLglob gr1, MLglob gr2 -> eq_gr gr1 gr2
+| MLglob gr1, MLglob gr2 -> GlobRef.equal gr1 gr2
 | MLcons (t1, gr1, c1), MLcons (t2, gr2, c2) ->
-  eq_ml_type t1 t2 && eq_gr gr1 gr2 && List.equal eq_ml_ast c1 c2
+  eq_ml_type t1 t2 && GlobRef.equal gr1 gr2 && List.equal eq_ml_ast c1 c2
 | MLtuple t1, MLtuple t2 ->
   List.equal eq_ml_ast t1 t2
 | MLcase (t1, c1, p1), MLcase (t2, c2, p2) ->
@@ -398,13 +398,13 @@ let rec eq_ml_ast t1 t2 = match t1, t2 with
 
 and eq_ml_pattern p1 p2 = match p1, p2 with
 | Pcons (gr1, p1), Pcons (gr2, p2) ->
-  eq_gr gr1 gr2 && List.equal eq_ml_pattern p1 p2
+  GlobRef.equal gr1 gr2 && List.equal eq_ml_pattern p1 p2
 | Ptuple p1, Ptuple p2 ->
   List.equal eq_ml_pattern p1 p2
 | Prel i1, Prel i2 ->
   Int.equal i1 i2
 | Pwild, Pwild -> true
-| Pusual gr1, Pusual gr2 -> eq_gr gr1 gr2
+| Pusual gr1, Pusual gr2 -> GlobRef.equal gr1 gr2
 | _ -> false
 
 and eq_ml_branch (id1, p1, t1) (id2, p2, t2) =
@@ -541,24 +541,24 @@ let dump_unused_vars a =
 
     | MLcase (t,e,br) ->
        let e' = ren env e in
-       let br' = Array.smartmap (ren_branch env) br in
+       let br' = Array.Smart.map (ren_branch env) br in
        if e' == e && br' == br then a else MLcase (t,e',br')
 
     | MLfix (i,ids,v) ->
        let env' = List.init (Array.length ids) (fun _ -> ref false) @ env in
-       let v' = Array.smartmap (ren env') v in
+       let v' = Array.Smart.map (ren env') v in
        if v' == v then a else MLfix (i,ids,v')
 
     | MLapp (b,l) ->
-       let b' = ren env b and l' = List.smartmap (ren env) l in
+       let b' = ren env b and l' = List.Smart.map (ren env) l in
        if b' == b && l' == l then a else MLapp (b',l')
 
     | MLcons(t,r,l) ->
-       let l' = List.smartmap (ren env) l in
+       let l' = List.Smart.map (ren env) l in
        if l' == l then a else MLcons (t,r,l')
 
     | MLtuple l ->
-       let l' = List.smartmap (ren env) l in
+       let l' = List.Smart.map (ren env) l in
        if l' == l then a else MLtuple l'
 
     | MLmagic b ->
@@ -984,7 +984,7 @@ let rec iota_red i lift br ((typ,r,a) as cons) =
   if i >= Array.length br then raise Impossible;
   let (ids,p,c) = br.(i) in
   match p with
-    | Pusual r' | Pcons (r',_) when not (Globnames.eq_gr r' r) -> iota_red (i+1) lift br cons
+    | Pusual r' | Pcons (r',_) when not (GlobRef.equal r' r) -> iota_red (i+1) lift br cons
     | Pusual r' ->
       let c = named_lams (List.rev ids) c in
       let c = ast_lift lift c
diff --git a/plugins/extraction/mlutil.mli b/plugins/extraction/mlutil.mli
index 55a1ee89..d23fdb3d 100644
--- a/plugins/extraction/mlutil.mli
+++ b/plugins/extraction/mlutil.mli
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 open Names
-open Globnames
 open Miniml
 open Table
 
@@ -59,7 +58,7 @@ val type_recomp : ml_type list * ml_type -> ml_type
 
 val var2var' : ml_type -> ml_type
 
-type abbrev_map = global_reference -> ml_type option
+type abbrev_map = GlobRef.t -> ml_type option
 
 val type_expand : abbrev_map -> ml_type -> ml_type
 val type_simpl : ml_type -> ml_type
@@ -117,7 +116,7 @@ val dump_unused_vars : ml_ast -> ml_ast
 
 val normalize : ml_ast -> ml_ast
 val optimize_fix : ml_ast -> ml_ast
-val inline : global_reference -> ml_ast -> bool
+val inline : GlobRef.t -> ml_ast -> bool
 
 val is_basic_pattern : ml_pattern -> bool
 val has_deep_pattern : ml_branch array -> bool
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index f33a59ed..b398bc07 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -76,7 +76,7 @@ let struct_iter do_decl do_spec do_mp s =
 (*s Apply some fonctions upon all references in [ml_type], [ml_ast],
   [ml_decl], [ml_spec] and [ml_structure]. *)
 
-type do_ref = global_reference -> unit
+type do_ref = GlobRef.t -> unit
 
 let record_iter_references do_term = function
   | Record l -> List.iter (Option.iter do_term) l
diff --git a/plugins/extraction/modutil.mli b/plugins/extraction/modutil.mli
index 6a81f270..f45773f0 100644
--- a/plugins/extraction/modutil.mli
+++ b/plugins/extraction/modutil.mli
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 open Names
-open Globnames
 open Miniml
 
 (*s Functions upon ML modules. *)
@@ -17,7 +16,7 @@ open Miniml
 val struct_ast_search : (ml_ast -> bool) -> ml_structure -> bool
 val struct_type_search : (ml_type -> bool) -> ml_structure -> bool
 
-type do_ref = global_reference -> unit
+type do_ref = GlobRef.t -> unit
 
 val type_iter_references : do_ref -> ml_type -> unit
 val ast_iter_references : do_ref -> do_ref -> do_ref -> ml_ast -> unit
@@ -30,7 +29,7 @@ val mtyp_of_mexpr : ml_module_expr -> ml_module_type
 
 val msid_of_mt : ml_module_type -> ModPath.t
 
-val get_decl_in_structure : global_reference -> ml_structure -> ml_decl
+val get_decl_in_structure : GlobRef.t -> ml_structure -> ml_decl
 
 (* Some transformations of ML terms. [optimize_struct] simplify
    all beta redexes (when the argument does not occur, it is just
@@ -39,5 +38,5 @@ val get_decl_in_structure : global_reference -> ml_structure -> ml_decl
    optimizations. The first argument is the list of objects we want to appear.
 *)
 
-val optimize_struct : global_reference list * ModPath.t list ->
+val optimize_struct : GlobRef.t list * ModPath.t list ->
   ml_structure -> ml_structure
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index 54c6d9d7..c3f4cfe6 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -652,7 +652,7 @@ let add_inline_entries b l =
 
 (* Registration of operations for rollback. *)
 
-let inline_extraction : bool * global_reference list -> obj =
+let inline_extraction : bool * GlobRef.t list -> obj =
   declare_object
     {(default_object "Extraction Inline") with
        cache_function = (fun (_,(b,l)) -> add_inline_entries b l);
@@ -736,7 +736,7 @@ let add_implicits r l =
 
 (* Registration of operations for rollback. *)
 
-let implicit_extraction : global_reference * int_or_id list -> obj =
+let implicit_extraction : GlobRef.t * int_or_id list -> obj =
   declare_object
     {(default_object "Extraction Implicit") with
        cache_function = (fun (_,(r,l)) -> add_implicits r l);
@@ -857,7 +857,7 @@ let find_custom_match pv =
 
 (* Registration of operations for rollback. *)
 
-let in_customs : global_reference * string list * string -> obj =
+let in_customs : GlobRef.t * string list * string -> obj =
   declare_object
     {(default_object "ML extractions") with
        cache_function = (fun (_,(r,ids,s)) -> add_custom r ids s);
@@ -867,7 +867,7 @@ let in_customs : global_reference * string list * string -> obj =
         (fun (s,(r,ids,str)) -> (fst (subst_global s r), ids, str))
     }
 
-let in_custom_matchs : global_reference * string -> obj =
+let in_custom_matchs : GlobRef.t * string -> obj =
   declare_object
     {(default_object "ML extractions custom matchs") with
        cache_function = (fun (_,(r,s)) -> add_custom_match r s);
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index 906dfd96..a8baeaf1 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -10,31 +10,30 @@
 
 open Names
 open Libnames
-open Globnames
 open Miniml
 open Declarations
 
-module Refset' : CSig.SetS with type elt = global_reference
-module Refmap' : CSig.MapS with type key = global_reference
+module Refset' : CSig.SetS with type elt = GlobRef.t
+module Refmap' : CSig.MapS with type key = GlobRef.t
 
-val safe_basename_of_global : global_reference -> Id.t
+val safe_basename_of_global : GlobRef.t -> Id.t
 
 (*s Warning and Error messages. *)
 
 val warning_axioms : unit -> unit
 val warning_opaques : bool -> unit
-val warning_ambiguous_name : ?loc:Loc.t -> qualid * ModPath.t * global_reference -> unit
+val warning_ambiguous_name : ?loc:Loc.t -> qualid * ModPath.t * GlobRef.t -> unit
 val warning_id : string -> unit
-val error_axiom_scheme : global_reference -> int -> 'a
-val error_constant : global_reference -> 'a
-val error_inductive : global_reference -> 'a
+val error_axiom_scheme : GlobRef.t -> int -> 'a
+val error_constant : GlobRef.t -> 'a
+val error_inductive : GlobRef.t -> 'a
 val error_nb_cons : unit -> 'a
 val error_module_clash : ModPath.t -> ModPath.t -> 'a
 val error_no_module_expr : ModPath.t -> 'a
-val error_singleton_become_prop : Id.t -> global_reference option -> 'a
+val error_singleton_become_prop : Id.t -> GlobRef.t option -> 'a
 val error_unknown_module : qualid -> 'a
 val error_scheme : unit -> 'a
-val error_not_visible : global_reference -> 'a
+val error_not_visible : GlobRef.t -> 'a
 val error_MPfile_as_mod : ModPath.t -> bool -> 'a
 val check_inside_module : unit -> unit
 val check_inside_section : unit -> unit
@@ -44,12 +43,12 @@ val err_or_warn_remaining_implicit : kill_reason -> unit
 
 val info_file : string -> unit
 
-(*s utilities about [module_path] and [kernel_names] and [global_reference] *)
+(*s utilities about [module_path] and [kernel_names] and [GlobRef.t] *)
 
-val occur_kn_in_ref : MutInd.t -> global_reference -> bool
-val repr_of_r : global_reference -> ModPath.t * DirPath.t * Label.t
-val modpath_of_r : global_reference -> ModPath.t
-val label_of_r : global_reference -> Label.t
+val occur_kn_in_ref : MutInd.t -> GlobRef.t -> bool
+val repr_of_r : GlobRef.t -> ModPath.t * DirPath.t * Label.t
+val modpath_of_r : GlobRef.t -> ModPath.t
+val label_of_r : GlobRef.t -> Label.t
 val base_mp : ModPath.t -> ModPath.t
 val is_modfile : ModPath.t -> bool
 val string_of_modfile : ModPath.t -> string
@@ -61,7 +60,7 @@ val prefixes_mp : ModPath.t -> MPset.t
 val common_prefix_from_list :
   ModPath.t -> ModPath.t list -> ModPath.t option
 val get_nth_label_mp : int -> ModPath.t -> Label.t
-val labels_of_ref : global_reference -> ModPath.t * Label.t list
+val labels_of_ref : GlobRef.t -> ModPath.t * Label.t list
 
 (*s Some table-related operations *)
 
@@ -83,27 +82,27 @@ val add_ind : MutInd.t -> mutual_inductive_body -> ml_ind -> unit
 val lookup_ind : MutInd.t -> mutual_inductive_body -> ml_ind option
 
 val add_inductive_kind : MutInd.t -> inductive_kind -> unit
-val is_coinductive : global_reference -> bool
+val is_coinductive : GlobRef.t -> bool
 val is_coinductive_type : ml_type -> bool
 (* What are the fields of a record (empty for a non-record) *)
 val get_record_fields :
-  global_reference -> global_reference option list
-val record_fields_of_type : ml_type -> global_reference option list
+  GlobRef.t -> GlobRef.t option list
+val record_fields_of_type : ml_type -> GlobRef.t option list
 
 val add_recursors : Environ.env -> MutInd.t -> unit
-val is_recursor : global_reference -> bool
+val is_recursor : GlobRef.t -> bool
 
 val add_projection : int -> Constant.t -> inductive -> unit
-val is_projection : global_reference -> bool
-val projection_arity : global_reference -> int
-val projection_info : global_reference -> inductive * int (* arity *)
+val is_projection : GlobRef.t -> bool
+val projection_arity : GlobRef.t -> int
+val projection_info : GlobRef.t -> inductive * int (* arity *)
 
-val add_info_axiom : global_reference -> unit
-val remove_info_axiom : global_reference -> unit
-val add_log_axiom : global_reference -> unit
+val add_info_axiom : GlobRef.t -> unit
+val remove_info_axiom : GlobRef.t -> unit
+val add_log_axiom : GlobRef.t -> unit
 
-val add_opaque : global_reference -> unit
-val remove_opaque : global_reference -> unit
+val add_opaque : GlobRef.t -> unit
+val remove_opaque : GlobRef.t -> unit
 
 val reset_tables : unit -> unit
 
@@ -172,22 +171,22 @@ val is_extrcompute : unit -> bool
 
 (*s Table for custom inlining *)
 
-val to_inline : global_reference -> bool
-val to_keep : global_reference -> bool
+val to_inline : GlobRef.t -> bool
+val to_keep : GlobRef.t -> bool
 
 (*s Table for implicits arguments *)
 
-val implicits_of_global : global_reference -> Int.Set.t
+val implicits_of_global : GlobRef.t -> Int.Set.t
 
 (*s Table for user-given custom ML extractions. *)
 
 (* UGLY HACK: registration of a function defined in [extraction.ml] *)
 val type_scheme_nb_args_hook : (Environ.env -> Constr.t -> int) Hook.t
 
-val is_custom : global_reference -> bool
-val is_inline_custom : global_reference -> bool
-val find_custom : global_reference -> string
-val find_type_custom : global_reference -> string list * string
+val is_custom : GlobRef.t -> bool
+val is_inline_custom : GlobRef.t -> bool
+val find_custom : GlobRef.t -> string
+val find_type_custom : GlobRef.t -> string list * string
 
 val is_custom_match : ml_branch array -> bool
 val find_custom_match : ml_branch array -> string
@@ -195,17 +194,17 @@ val find_custom_match : ml_branch array -> string
 (*s Extraction commands. *)
 
 val extraction_language : lang -> unit
-val extraction_inline : bool -> reference list -> unit
+val extraction_inline : bool -> qualid list -> unit
 val print_extraction_inline : unit -> Pp.t
 val reset_extraction_inline : unit -> unit
 val extract_constant_inline :
-  bool -> reference -> string list -> string -> unit
+  bool -> qualid -> string list -> string -> unit
 val extract_inductive :
-  reference -> string -> string list -> string option -> unit
+  qualid -> string -> string list -> string option -> unit
 
 
 type int_or_id = ArgInt of int | ArgId of Id.t
-val extraction_implicit : reference -> int_or_id list -> unit
+val extraction_implicit : qualid -> int_or_id list -> unit
 
 (*s Table of blacklisted filenames *)
 
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index 047fc9fb..a60a966c 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -211,7 +211,7 @@ type left_pattern=
   | Lexists of pinductive
   | LA of constr*left_arrow_pattern
 
-type t={id:global_reference;
+type t={id:GlobRef.t;
 	constr:constr;
 	pat:(left_pattern,right_pattern) sum;
 	atoms:atoms}
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 2962d923..e2c6f1c4 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -8,9 +8,9 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Names
 open Constr
 open EConstr
-open Globnames
 
 val qflag : bool ref
 
@@ -35,7 +35,7 @@ type atoms = {positive:constr list;negative:constr list}
 
 type side = Hyp | Concl | Hint
 
-val dummy_id: global_reference
+val dummy_id: GlobRef.t
 
 val build_atoms : Environ.env -> Evd.evar_map -> counter ->
   side -> constr -> bool * atoms
@@ -65,13 +65,13 @@ type left_pattern=
   | Lexists of pinductive
   | LA of constr*left_arrow_pattern
 
-type t={id: global_reference;
+type t={id: GlobRef.t;
 	constr: constr;
 	pat: (left_pattern,right_pattern) sum;
 	atoms: atoms}
 
 (*exception Is_atom of constr*)
 
-val build_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> types ->
+val build_formula : Environ.env -> Evd.evar_map -> side -> GlobRef.t -> types ->
   counter -> (t,types) sum
 
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 30deb6f4..7e54bc8a 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -17,7 +17,6 @@ open Goptions
 open Tacmach.New
 open Tacticals.New
 open Tacinterp
-open Libnames
 open Stdarg
 open Tacarg
 open Pcoq.Prim
@@ -127,7 +126,7 @@ let normalize_evaluables=
 open Genarg
 open Ppconstr
 open Printer
-let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_reference
+let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_qualid
 let pr_firstorder_using_glob _ _ _ = Pptactic.pr_auto_using (pr_or_var (fun x -> pr_global (snd x)))
 let pr_firstorder_using_typed _ _ _ = Pptactic.pr_auto_using pr_global
 
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index 4e3ba573..516b04ea 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -13,23 +13,21 @@ open Formula
 open Sequent
 open Rules
 open Instances
-open Constr
 open Tacmach.New
 open Tacticals.New
+open Globnames
 
 let update_flags ()=
-  let predref=ref Names.Cpred.empty in
-  let f coe=
-    try
-      let kn= fst (destConst (Classops.get_coercion_value coe)) in
-	predref:=Names.Cpred.add kn !predref
-    with DestKO -> ()
+  let f acc coe =
+    match coe.Classops.coe_value with
+    | ConstRef c -> Names.Cpred.add c acc
+    | _ -> acc
   in
-    List.iter f (Classops.coercions ());
+    let pred = List.fold_left f Names.Cpred.empty (Classops.coercions ()) in
     red_flags:=
     CClosure.RedFlags.red_add_transparent
       CClosure.betaiotazeta
-      (Names.Id.Pred.full,Names.Cpred.complement !predref)
+      (Names.Id.Pred.full,Names.Cpred.complement pred)
 
 let ground_tac solver startseq =
   Proofview.Goal.enter begin fun gl ->
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index e8c0b927..85f49395 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -22,7 +22,6 @@ open Reductionops
 open Formula
 open Sequent
 open Names
-open Misctypes
 open Context.Rel.Declaration
 
 let compare_instance inst1 inst2=
@@ -43,7 +42,7 @@ let compare_gr id1 id2 =
 
 module OrderedInstance=
 struct
-  type t=instance * Globnames.global_reference
+  type t=instance * GlobRef.t
   let compare (inst1,id1) (inst2,id2)=
     (compare_instance =? compare_gr) inst2 inst1 id2 id1
     (* we want a __decreasing__ total order *)
@@ -184,12 +183,12 @@ let right_instance_tac inst continue seq=
 	   [introf;
             Proofview.Goal.enter begin fun gl ->
               let id0 = List.nth (pf_ids_of_hyps gl) 0 in
-              split (ImplicitBindings [mkVar id0])
+              split (Tactypes.ImplicitBindings [mkVar id0])
             end;
 	    tclSOLVE [wrap 0 true continue (deepen seq)]];
 	 tclTRY assumption]
     | Real ((0,t),_) ->
-	(tclTHEN (split (ImplicitBindings [t]))
+        (tclTHEN (split (Tactypes.ImplicitBindings [t]))
 	   (tclSOLVE [wrap 0 true continue (deepen seq)]))
     | Real ((m,t),_) ->
 	tclFAIL 0 (Pp.str "not implemented ... yet")
diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli
index 61786ffd..9f9ade3a 100644
--- a/plugins/firstorder/instances.mli
+++ b/plugins/firstorder/instances.mli
@@ -8,13 +8,13 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Globnames
+open Names
 open Rules
 
 val collect_quantified : Evd.evar_map -> Sequent.t -> Formula.t list * Sequent.t
 
 val give_instances : Evd.evar_map -> Formula.t list -> Sequent.t ->
-  (Unify.instance * global_reference) list
+  (Unify.instance * GlobRef.t) list
 
 val quantified_tac : Formula.t list -> seqtac with_backtracking
 
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index cfcd6561..b13580bc 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -29,7 +29,7 @@ type tactic = unit Proofview.tactic
 
 type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
 
-type lseqtac= global_reference -> seqtac
+type lseqtac= GlobRef.t -> seqtac
 
 type 'a with_backtracking = tactic -> 'a
 
@@ -233,7 +233,7 @@ let ll_forall_tac prod backtrack id continue seq=
 
 (* special for compatibility with old Intuition *)
 
-let constant str = Universes.constr_of_global
+let constant str = UnivGen.constr_of_global
   @@ Coqlib.coq_reference "User" ["Init";"Logic"] str
 
 let defined_connectives=lazy
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index 859388b3..924c2679 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -11,21 +11,20 @@
 open Names
 open Constr
 open EConstr
-open Globnames
 
 type tactic = unit Proofview.tactic
 
 type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
 
-type lseqtac= global_reference -> seqtac
+type lseqtac= GlobRef.t -> seqtac
 
 type 'a with_backtracking = tactic -> 'a
 
 val wrap : int -> bool -> seqtac
 
-val basename_of_global: global_reference -> Id.t
+val basename_of_global: GlobRef.t -> Id.t
 
-val clear_global: global_reference -> tactic
+val clear_global: GlobRef.t -> tactic
 
 val axiom_tac : constr -> Sequent.t -> tactic
 
@@ -41,7 +40,7 @@ val left_and_tac : pinductive -> lseqtac with_backtracking
 
 val left_or_tac : pinductive -> lseqtac with_backtracking
 
-val left_false_tac : global_reference -> tactic
+val left_false_tac : GlobRef.t -> tactic
 
 val ll_ind_tac : pinductive -> constr list -> lseqtac with_backtracking
 
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 28599179..2a527da9 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -8,13 +8,13 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open EConstr
-open CErrors
 open Util
+open Pp
+open CErrors
+open Names
+open EConstr
 open Formula
 open Unify
-open Globnames
-open Pp
 
 let newcnt ()=
   let cnt=ref (-1) in
@@ -56,7 +56,7 @@ struct
 	(priority e1.pat) - (priority e2.pat)
 end
 
-type h_item = global_reference * (int*Constr.t) option
+type h_item = GlobRef.t * (int*Constr.t) option
 
 module Hitem=
 struct
@@ -77,17 +77,17 @@ module CM=Map.Make(Constr)
 module History=Set.Make(Hitem)
 
 let cm_add sigma typ nam cm=
-  let typ = EConstr.to_constr sigma typ in
+  let typ = EConstr.to_constr ~abort_on_undefined_evars:false sigma typ in
   try
     let l=CM.find typ cm in CM.add typ (nam::l) cm
   with
       Not_found->CM.add typ [nam] cm
 
 let cm_remove sigma typ nam cm=
-  let typ = EConstr.to_constr sigma typ in
+  let typ = EConstr.to_constr ~abort_on_undefined_evars:false sigma typ in
   try
     let l=CM.find typ cm in
-    let l0=List.filter (fun id-> not (Globnames.eq_gr id nam)) l in
+    let l0=List.filter (fun id-> not (GlobRef.equal id nam)) l in
       match l0 with
 	  []->CM.remove typ cm
 	| _ ->CM.add typ l0 cm
@@ -97,7 +97,7 @@ module HP=Heap.Functional(OrderedFormula)
 
 type t=
     {redexes:HP.t;
-     context:(global_reference list) CM.t;
+     context:(GlobRef.t list) CM.t;
      latoms:constr list;
      gl:types;
      glatom:constr option;
@@ -117,7 +117,7 @@ let lookup sigma item seq=
 	let p (id2,o)=
 	  match o with
 	      None -> false
-	    | Some (m2, t2)-> Globnames.eq_gr id id2 && m2>m && more_general sigma (m2, EConstr.of_constr t2) (m, EConstr.of_constr t) in
+            | Some (m2, t2)-> GlobRef.equal id id2 && m2>m && more_general sigma (m2, EConstr.of_constr t2) (m, EConstr.of_constr t) in
 	  History.exists p seq.history
 
 let add_formula env sigma side nam t seq =
@@ -152,7 +152,7 @@ let re_add_formula_list sigma lf seq=
      redexes=List.fold_right HP.add lf seq.redexes;
      context=List.fold_right do_one lf seq.context}
 
-let find_left sigma t seq=List.hd (CM.find (EConstr.to_constr sigma t) seq.context)
+let find_left sigma t seq=List.hd (CM.find (EConstr.to_constr ~abort_on_undefined_evars:false sigma t) seq.context)
 
 (*let rev_left seq=
   try
@@ -187,9 +187,9 @@ let empty_seq depth=
 
 let expand_constructor_hints =
   List.map_append (function
-    | IndRef ind ->
+    | GlobRef.IndRef ind ->
         List.init (Inductiveops.nconstructors ind)
-          (fun i -> ConstructRef (ind,i+1))
+          (fun i -> GlobRef.ConstructRef (ind,i+1))
     | gr ->
 	[gr])
 
@@ -197,7 +197,7 @@ let extend_with_ref_list env sigma l seq =
   let l = expand_constructor_hints l in
   let f gr (seq, sigma) =
     let sigma, c = Evd.fresh_global env sigma gr in
-    let sigma, typ= Typing.type_of env sigma (EConstr.of_constr c) in
+    let sigma, typ= Typing.type_of env sigma c in
       (add_formula env sigma Hyp gr typ seq, sigma) in
     List.fold_right f l (seq, sigma)
 
@@ -229,7 +229,9 @@ let extend_with_auto_hints env sigma l seq =
 
 let print_cmap map=
   let print_entry c l s=
-    let xc=Constrextern.extern_constr false (Global.env ()) Evd.empty (EConstr.of_constr c) in
+    let env = Global.env () in
+    let sigma = Evd.from_env env in
+    let xc=Constrextern.extern_constr false env sigma (EConstr.of_constr c) in
       str "| " ++
       prlist Printer.pr_global l ++
       str " : " ++
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index c4ed3e21..709b278e 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -8,26 +8,26 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Names
 open EConstr
 open Formula
-open Globnames
 
 module CM: CSig.MapS with type key=Constr.t
 
-type h_item = global_reference * (int*Constr.t) option
+type h_item = GlobRef.t * (int*Constr.t) option
 
 module History: Set.S with type elt = h_item
 
-val cm_add : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
-  global_reference list CM.t
+val cm_add : Evd.evar_map -> constr -> GlobRef.t -> GlobRef.t list CM.t ->
+  GlobRef.t list CM.t
 
-val cm_remove : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
-  global_reference list CM.t
+val cm_remove : Evd.evar_map -> constr -> GlobRef.t -> GlobRef.t list CM.t ->
+  GlobRef.t list CM.t
 
 module HP: Heap.S with type elt=Formula.t
 
 type t = {redexes:HP.t;
-	  context: global_reference list CM.t;
+          context: GlobRef.t list CM.t;
 	  latoms:constr list;
 	  gl:types;
 	  glatom:constr option;
@@ -41,20 +41,20 @@ val record: h_item -> t -> t
 
 val lookup: Evd.evar_map -> h_item -> t -> bool
 
-val add_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> constr -> t -> t
+val add_formula : Environ.env -> Evd.evar_map -> side -> GlobRef.t -> constr -> t -> t
 
 val re_add_formula_list : Evd.evar_map -> Formula.t list -> t -> t
 
-val find_left : Evd.evar_map -> constr -> t -> global_reference
+val find_left : Evd.evar_map -> constr -> t -> GlobRef.t
 
 val take_formula : Evd.evar_map -> t -> Formula.t * t
 
 val empty_seq : int -> t
 
-val extend_with_ref_list : Environ.env -> Evd.evar_map -> global_reference list ->
+val extend_with_ref_list : Environ.env -> Evd.evar_map -> GlobRef.t list ->
   t -> t * Evd.evar_map
 
 val extend_with_auto_hints : Environ.env -> Evd.evar_map -> Hints.hint_db_name list ->
   t -> t * Evd.evar_map
 
-val print_cmap: global_reference list CM.t -> Pp.t
+val print_cmap: GlobRef.t list CM.t -> Pp.t
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index b869c04a..d63fe9d7 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -9,7 +9,7 @@
 (************************************************************************)
 
 open Util
-open Term
+open Constr
 open EConstr
 open Vars
 open Termops
@@ -56,12 +56,12 @@ let unif evd t1 t2=
 	  | Meta i,_ ->
 	      let t=subst_meta !sigma nt2 in
 		if Int.Set.is_empty (free_rels evd t) &&
-		  not (dependent evd (EConstr.mkMeta i) t) then
+                  not (occur_metavariable evd i t) then
 		    bind i t else raise (UFAIL(nt1,nt2))
 	  | _,Meta i ->
 	      let t=subst_meta !sigma nt1 in
 		if Int.Set.is_empty (free_rels evd t) &&
-		  not (dependent evd (EConstr.mkMeta i) t) then
+                  not (occur_metavariable evd i t) then
 		    bind i t else raise (UFAIL(nt1,nt2))
 	  | Cast(_,_,_),_->Queue.add (strip_outer_cast evd nt1,nt2) bige
  	  | _,Cast(_,_,_)->Queue.add (nt1,strip_outer_cast evd nt2) bige
diff --git a/plugins/fourier/Fourier_util.v b/plugins/fourier/Fourier_util.v
deleted file mode 100644
index d3159698..00000000
--- a/plugins/fourier/Fourier_util.v
+++ /dev/null
@@ -1,222 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Rbase.
-Comments "Lemmas used by the tactic Fourier".
-
-Open Scope R_scope.
-
-Lemma Rfourier_lt : forall x1 y1 a:R, x1 < y1 -> 0 < a -> a * x1 < a * y1.
-intros; apply Rmult_lt_compat_l; assumption.
-Qed.
-
-Lemma Rfourier_le : forall x1 y1 a:R, x1 <= y1 -> 0 < a -> a * x1 <= a * y1.
-red.
-intros.
-case H; auto with real.
-Qed.
-
-Lemma Rfourier_lt_lt :
- forall x1 y1 x2 y2 a:R,
-   x1 < y1 -> x2 < y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2.
-intros x1 y1 x2 y2 a H H0 H1; try assumption.
-apply Rplus_lt_compat.
-try exact H.
-apply Rfourier_lt.
-try exact H0.
-try exact H1.
-Qed.
-
-Lemma Rfourier_lt_le :
- forall x1 y1 x2 y2 a:R,
-   x1 < y1 -> x2 <= y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2.
-intros x1 y1 x2 y2 a H H0 H1; try assumption.
-case H0; intros.
-apply Rplus_lt_compat.
-try exact H.
-apply Rfourier_lt; auto with real.
-rewrite H2.
-rewrite (Rplus_comm y1 (a * y2)).
-rewrite (Rplus_comm x1 (a * y2)).
-apply Rplus_lt_compat_l.
-try exact H.
-Qed.
-
-Lemma Rfourier_le_lt :
- forall x1 y1 x2 y2 a:R,
-   x1 <= y1 -> x2 < y2 -> 0 < a -> x1 + a * x2 < y1 + a * y2.
-intros x1 y1 x2 y2 a H H0 H1; try assumption.
-case H; intros.
-apply Rfourier_lt_le; auto with real.
-rewrite H2.
-apply Rplus_lt_compat_l.
-apply Rfourier_lt; auto with real.
-Qed.
-
-Lemma Rfourier_le_le :
- forall x1 y1 x2 y2 a:R,
-   x1 <= y1 -> x2 <= y2 -> 0 < a -> x1 + a * x2 <= y1 + a * y2.
-intros x1 y1 x2 y2 a H H0 H1; try assumption.
-case H0; intros.
-red.
-left; try assumption.
-apply Rfourier_le_lt; auto with real.
-rewrite H2.
-case H; intros.
-red.
-left; try assumption.
-rewrite (Rplus_comm x1 (a * y2)).
-rewrite (Rplus_comm y1 (a * y2)).
-apply Rplus_lt_compat_l.
-try exact H3.
-rewrite H3.
-red.
-right; try assumption.
-auto with real.
-Qed.
-
-Lemma Rlt_zero_pos_plus1 : forall x:R, 0 < x -> 0 < 1 + x.
-intros x H; try assumption.
-rewrite Rplus_comm.
-apply Rle_lt_0_plus_1.
-red; auto with real.
-Qed.
-
-Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y.
-intros x y H H0; try assumption.
-replace 0 with (x * 0).
-apply Rmult_lt_compat_l; auto with real.
-ring.
-Qed.
-
-Lemma Rlt_zero_1 : 0 < 1.
-exact Rlt_0_1.
-Qed.
-
-Lemma Rle_zero_pos_plus1 : forall x:R, 0 <= x -> 0 <= 1 + x.
-intros x H; try assumption.
-case H; intros.
-red.
-left; try assumption.
-apply Rlt_zero_pos_plus1; auto with real.
-rewrite <- H0.
-replace (1 + 0) with 1.
-red; left.
-exact Rlt_zero_1.
-ring.
-Qed.
-
-Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y.
-intros x y H H0; try assumption.
-case H; intros.
-red; left.
-apply Rlt_mult_inv_pos; auto with real.
-rewrite <- H1.
-red; right; ring.
-Qed.
-
-Lemma Rle_zero_1 : 0 <= 1.
-red; left.
-exact Rlt_zero_1.
-Qed.
-
-Lemma Rle_not_lt : forall n d:R, 0 <= n * / d -> ~ 0 < - n * / d.
-intros n d H; red; intros H0; try exact H0.
-generalize (Rgt_not_le 0 (n * / d)).
-intros H1; elim H1; try assumption.
-replace (n * / d) with (- - (n * / d)).
-replace 0 with (- -0).
-replace (- (n * / d)) with (- n * / d).
-replace (-0) with 0.
-red.
-apply Ropp_gt_lt_contravar.
-red.
-exact H0.
-ring.
-ring.
-ring.
-ring.
-Qed.
-
-Lemma Rnot_lt0 : forall x:R, ~ 0 < 0 * x.
-intros x; try assumption.
-replace (0 * x) with 0.
-apply Rlt_irrefl.
-ring.
-Qed.
-
-Lemma Rlt_not_le_frac_opp : forall n d:R, 0 < n * / d -> ~ 0 <= - n * / d.
-intros n d H; try assumption.
-apply Rgt_not_le.
-replace 0 with (-0).
-replace (- n * / d) with (- (n * / d)).
-apply Ropp_lt_gt_contravar.
-try exact H.
-ring.
-ring.
-Qed.
-
-Lemma Rnot_lt_lt : forall x y:R, ~ 0 < y - x -> ~ x < y.
-unfold not; intros.
-apply H.
-apply Rplus_lt_reg_l with x.
-replace (x + 0) with x.
-replace (x + (y - x)) with y.
-try exact H0.
-ring.
-ring.
-Qed.
-
-Lemma Rnot_le_le : forall x y:R, ~ 0 <= y - x -> ~ x <= y.
-unfold not; intros.
-apply H.
-case H0; intros.
-left.
-apply Rplus_lt_reg_l with x.
-replace (x + 0) with x.
-replace (x + (y - x)) with y.
-try exact H1.
-ring.
-ring.
-right.
-rewrite H1; ring.
-Qed.
-
-Lemma Rfourier_gt_to_lt : forall x y:R, y > x -> x < y.
-unfold Rgt; intros; assumption.
-Qed.
-
-Lemma Rfourier_ge_to_le : forall x y:R, y >= x -> x <= y.
-intros x y; exact (Rge_le y x).
-Qed.
-
-Lemma Rfourier_eqLR_to_le : forall x y:R, x = y -> x <= y.
-exact Req_le.
-Qed.
-
-Lemma Rfourier_eqRL_to_le : forall x y:R, y = x -> x <= y.
-exact Req_le_sym.
-Qed.
-
-Lemma Rfourier_not_ge_lt : forall x y:R, (x >= y -> False) -> x < y.
-exact Rnot_ge_lt.
-Qed.
-
-Lemma Rfourier_not_gt_le : forall x y:R, (x > y -> False) -> x <= y.
-exact Rnot_gt_le.
-Qed.
-
-Lemma Rfourier_not_le_gt : forall x y:R, (x <= y -> False) -> x > y.
-exact Rnot_le_lt.
-Qed.
-
-Lemma Rfourier_not_lt_ge : forall x y:R, (x < y -> False) -> x >= y.
-exact Rnot_lt_ge.
-Qed.
diff --git a/plugins/fourier/fourier.ml b/plugins/fourier/fourier.ml
deleted file mode 100644
index bee2b3b5..00000000
--- a/plugins/fourier/fourier.ml
+++ /dev/null
@@ -1,204 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-(* Méthode d'élimination de Fourier *)
-(* Référence:
-Auteur(s) : Fourier, Jean-Baptiste-Joseph
-
-Titre(s) : Oeuvres de Fourier [Document électronique]. Tome second. Mémoires publiés dans divers recueils / publ. par les soins de M. Gaston Darboux,...
-
-Publication : Numérisation BnF de l'édition de Paris : Gauthier-Villars, 1890
-
-Pages: 326-327
-
-http://gallica.bnf.fr/
-*)
-
-(* Un peu de calcul sur les rationnels...
-Les opérations rendent des rationnels normalisés,
-i.e. le numérateur et le dénominateur sont premiers entre eux.
-*)
-type rational = {num:int;
-                 den:int}
-;;
-let print_rational x =
-        print_int x.num;
-        print_string "/";
-        print_int x.den
-;;
-
-let rec pgcd x y = if y = 0 then x else pgcd y (x mod y);;
-
-
-let r0 = {num=0;den=1};;
-let r1 = {num=1;den=1};;
-
-let rnorm x = let x = (if x.den<0 then {num=(-x.num);den=(-x.den)} else x) in
-              if x.num=0 then r0
-              else (let d=pgcd x.num x.den in
-		    let d= (if d<0 then -d else d) in
-                    {num=(x.num)/d;den=(x.den)/d});;
-
-let rop x = rnorm {num=(-x.num);den=x.den};;
-
-let rplus x y = rnorm {num=x.num*y.den + y.num*x.den;den=x.den*y.den};;
-
-let rminus x y = rnorm {num=x.num*y.den - y.num*x.den;den=x.den*y.den};;
-
-let rmult x y = rnorm {num=x.num*y.num;den=x.den*y.den};;
-
-let rinv x = rnorm {num=x.den;den=x.num};;
-
-let rdiv x y = rnorm {num=x.num*y.den;den=x.den*y.num};;
-
-let rinf x y = x.num*y.den < y.num*x.den;;
-let rinfeq x y = x.num*y.den <= y.num*x.den;;
-
-(* {coef;hist;strict}, où coef=[c1; ...; cn; d], représente l'inéquation
-c1x1+...+cnxn < d si strict=true, <= sinon,
-hist donnant les coefficients (positifs) d'une combinaison linéaire qui permet d'obtenir l'inéquation à partir de celles du départ.
-*)
-
-type ineq = {coef:rational list;
-             hist:rational list;
-             strict:bool};;
-
-let pop x l = l:=x::(!l);;
-
-(* sépare la liste d'inéquations s selon que leur premier coefficient est
-négatif, nul ou positif. *)
-let partitionne s =
-   let lpos=ref [] in
-   let lneg=ref [] in
-   let lnul=ref [] in
-   List.iter (fun ie -> match ie.coef with
-                        [] ->  raise (Failure "empty ineq")
-                       |(c::r) -> if rinf c r0
-           	                  then pop ie lneg
-                                  else if rinf r0 c then pop ie lpos
-                                              else pop ie lnul)
-             s;
-   [!lneg;!lnul;!lpos]
-;;
-(* initialise les histoires d'une liste d'inéquations données par leurs listes de coefficients et leurs strictitudes (!):
-(add_hist [(equation 1, s1);...;(équation n, sn)])
-=
-[{équation 1, [1;0;...;0], s1};
- {équation 2, [0;1;...;0], s2};
- ...
- {équation n, [0;0;...;1], sn}]
-*)
-let add_hist le =
-   let n = List.length le in
-   let i = ref 0 in
-   List.map (fun (ie,s) ->
-              let h = ref [] in
-              for _k = 1 to (n - (!i) - 1) do pop r0 h; done;
-              pop r1 h;
-              for _k = 1 to !i do pop r0 h; done;
-              i:=!i+1;
-              {coef=ie;hist=(!h);strict=s})
-             le
-;;
-(* additionne deux inéquations *)
-let ie_add ie1 ie2 = {coef=List.map2 rplus ie1.coef ie2.coef;
-                      hist=List.map2 rplus ie1.hist ie2.hist;
-		      strict=ie1.strict || ie2.strict}
-;;
-(* multiplication d'une inéquation par un rationnel (positif) *)
-let ie_emult a ie = {coef=List.map (fun x -> rmult a x) ie.coef;
-                     hist=List.map (fun x -> rmult a x) ie.hist;
-		     strict= ie.strict}
-;;
-(* on enlève le premier coefficient *)
-let ie_tl ie = {coef=List.tl ie.coef;hist=ie.hist;strict=ie.strict}
-;;
-(* le premier coefficient: "tête" de l'inéquation *)
-let hd_coef ie = List.hd ie.coef
-;;
-
-(* calcule toutes les combinaisons entre inéquations de tête négative et inéquations de tête positive qui annulent le premier coefficient.
-*)
-let deduce_add lneg lpos =
-   let res=ref [] in
-   List.iter (fun i1 ->
-		 List.iter (fun i2 ->
-				let a = rop (hd_coef i1) in
-				let b = hd_coef i2 in
-				pop (ie_tl (ie_add (ie_emult b i1)
-						   (ie_emult a i2))) res)
-		           lpos)
-             lneg;
-   !res
-;;
-(* élimination de la première variable à partir d'une liste d'inéquations:
-opération qu'on itère dans l'algorithme de Fourier.
-*)
-let deduce1 s =
-    match (partitionne s) with
-      [lneg;lnul;lpos] ->
-    let lnew = deduce_add lneg lpos in
-    (List.map ie_tl lnul)@lnew
-     |_->assert false
-;;
-(* algorithme de Fourier: on élimine successivement toutes les variables.
-*)
-let deduce lie =
-   let n = List.length (fst (List.hd lie)) in
-   let lie=ref (add_hist lie) in
-   for _i = 1 to n - 1 do
-      lie:= deduce1 !lie;
-   done;
-   !lie
-;;
-
-(* donne [] si le système a des solutions,
-sinon donne [c,s,lc]
-où lc est la combinaison linéaire des inéquations de départ
-qui donne 0 < c si s=true
-       ou 0 <= c sinon
-cette inéquation étant absurde.
-*)
-
-exception Contradiction of (rational * bool * rational list) list
-
-let unsolvable lie =
-   let lr = deduce lie in
-   let check = function
-     | {coef=[c];hist=lc;strict=s} ->
-       if (rinf c r0 && (not s)) || (rinfeq c r0 && s)
-       then raise (Contradiction [c,s,lc])
-     |_->assert false
-   in
-   try List.iter check lr; []
-   with Contradiction l -> l
-
-(* Exemples:
-
-let test1=[[r1;r1;r0],true;[rop r1;r1;r1],false;[r0;rop r1;rop r1],false];;
-deduce test1;;
-unsolvable test1;;
-
-let test2=[
-[r1;r1;r0;r0;r0],false;
-[r0;r1;r1;r0;r0],false;
-[r0;r0;r1;r1;r0],false;
-[r0;r0;r0;r1;r1],false;
-[r1;r0;r0;r0;r1],false;
-[rop r1;rop r1;r0;r0;r0],false;
-[r0;rop r1;rop r1;r0;r0],false;
-[r0;r0;rop r1;rop r1;r0],false;
-[r0;r0;r0;rop r1;rop r1],false;
-[rop r1;r0;r0;r0;rop r1],false
-];;
-deduce test2;;
-unsolvable test2;;
-
-*)
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
deleted file mode 100644
index b1c003de..00000000
--- a/plugins/fourier/fourierR.ml
+++ /dev/null
@@ -1,644 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-
-
-(* La tactique Fourier ne fonctionne de manière sûre que si les coefficients
-des inéquations et équations sont entiers. En attendant la tactique Field.
-*)
-
-open Constr
-open Tactics
-open Names
-open Globnames
-open Fourier
-open Contradiction
-open Proofview.Notations
-
-(******************************************************************************
-Opérations sur les combinaisons linéaires affines.
-La partie homogène d'une combinaison linéaire est en fait une table de hash
-qui donne le coefficient d'un terme du calcul des constructions,
-qui est zéro si le terme n'y est pas.
-*)
-
-module Constrhash = Hashtbl.Make(Constr)
-
-type flin = {fhom: rational Constrhash.t;
-             fcste:rational};;
-
-let flin_zero () = {fhom=Constrhash.create 50;fcste=r0};;
-
-let flin_coef f x = try Constrhash.find f.fhom x with Not_found -> r0;;
-
-let flin_add f x c =
-    let cx = flin_coef f x in
-    Constrhash.replace f.fhom x (rplus cx c);
-    f
-;;
-let flin_add_cste f c =
-    {fhom=f.fhom;
-     fcste=rplus f.fcste c}
-;;
-
-let flin_one () = flin_add_cste (flin_zero()) r1;;
-
-let flin_plus f1 f2 =
-    let f3 = flin_zero() in
-    Constrhash.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
-    Constrhash.iter (fun x c -> let _=flin_add f3 x c in ()) f2.fhom;
-    flin_add_cste (flin_add_cste f3 f1.fcste) f2.fcste;
-;;
-
-let flin_minus f1 f2 =
-    let f3 = flin_zero() in
-    Constrhash.iter (fun x c -> let _=flin_add f3 x c in ()) f1.fhom;
-    Constrhash.iter (fun x c -> let _=flin_add f3 x (rop c) in ()) f2.fhom;
-    flin_add_cste (flin_add_cste f3 f1.fcste) (rop f2.fcste);
-;;
-let flin_emult a f =
-    let f2 = flin_zero() in
-    Constrhash.iter (fun x c -> let _=flin_add f2 x (rmult a c) in ()) f.fhom;
-    flin_add_cste f2 (rmult a f.fcste);
-;;
-
-(*****************************************************************************)
-
-type ineq = Rlt | Rle | Rgt | Rge
-
-let string_of_R_constant kn =
-  match Constant.repr3 kn with
-    | ModPath.MPfile dir, sec_dir, id when
-	sec_dir = DirPath.empty &&
-	DirPath.to_string dir = "Coq.Reals.Rdefinitions"
-	-> Label.to_string id
-    | _ -> "constant_not_of_R"
-
-let rec string_of_R_constr c =
- match Constr.kind c with
-   Cast (c,_,_) -> string_of_R_constr c
-  |Const (c,_) -> string_of_R_constant c
-  | _ -> "not_of_constant"
-
-exception NoRational
-
-let rec rational_of_constr c =
-  match Constr.kind c with
-  | Cast (c,_,_) -> (rational_of_constr c)
-  | App (c,args) ->
-      (match (string_of_R_constr c) with
-	 | "Ropp" ->
-	     rop (rational_of_constr args.(0))
-	 | "Rinv" ->
-	     rinv (rational_of_constr args.(0))
-	 | "Rmult" ->
-	     rmult (rational_of_constr args.(0))
-                   (rational_of_constr args.(1))
-	 | "Rdiv" ->
-	     rdiv (rational_of_constr args.(0))
-                  (rational_of_constr args.(1))
-	 | "Rplus" ->
-	     rplus (rational_of_constr args.(0))
-                   (rational_of_constr args.(1))
-	 | "Rminus" ->
-	     rminus (rational_of_constr args.(0))
-                    (rational_of_constr args.(1))
-	 | _ -> raise NoRational)
-  | Const (kn,_) ->
-      (match (string_of_R_constant kn) with
-	       "R1" -> r1
-              |"R0" -> r0
-              |  _ -> raise NoRational)
-  |  _ -> raise NoRational
-;;
-
-exception NoLinear
-
-let rec flin_of_constr c =
-  try(
-    match Constr.kind c with
-  | Cast (c,_,_) -> (flin_of_constr c)
-  | App (c,args) ->
-      (match (string_of_R_constr c) with
-	   "Ropp" ->
-             flin_emult (rop r1) (flin_of_constr args.(0))
-	 | "Rplus"->
-             flin_plus (flin_of_constr args.(0))
-	               (flin_of_constr args.(1))
-	 | "Rminus"->
-             flin_minus (flin_of_constr args.(0))
-	                (flin_of_constr args.(1))
-	 | "Rmult"->
-	     (try
-                let a = rational_of_constr args.(0) in
-                try
-                  let b = rational_of_constr args.(1) in
-		  flin_add_cste (flin_zero()) (rmult a b)
-		with NoRational ->
-                  flin_add (flin_zero()) args.(1) a
-	      with NoRational ->
-                flin_add (flin_zero()) args.(0)
-		  (rational_of_constr args.(1)))
-	 | "Rinv"->
-	     let a = rational_of_constr args.(0) in
-	     flin_add_cste (flin_zero()) (rinv a)
-	 | "Rdiv"->
-	     (let b = rational_of_constr args.(1) in
-	      try
-                let a = rational_of_constr args.(0) in
-	        flin_add_cste (flin_zero()) (rdiv a b)
-	      with NoRational ->
-                flin_add (flin_zero()) args.(0) (rinv b))
-         |_-> raise NoLinear)
-  | Const (c,_) ->
-        (match (string_of_R_constant c) with
-	       "R1" -> flin_one ()
-              |"R0" -> flin_zero ()
-              |_-> raise NoLinear)
-  |_-> raise NoLinear)
-  with NoRational | NoLinear -> flin_add (flin_zero()) c r1
-;;
-
-let flin_to_alist f =
-    let res=ref [] in
-    Constrhash.iter (fun x c -> res:=(c,x)::(!res)) f;
-    !res
-;;
-
-(* Représentation des hypothèses qui sont des inéquations ou des équations.
-*)
-type hineq={hname:constr; (* le nom de l'hypothèse *)
-            htype:string; (* Rlt, Rgt, Rle, Rge, eqTLR ou eqTRL *)
-            hleft:constr;
-            hright:constr;
-            hflin:flin;
-            hstrict:bool}
-;;
-
-(* Transforme une hypothese h:t en inéquation flin<0 ou flin<=0
-*)
-
-exception NoIneq
-
-let ineq1_of_constr (h,t) =
-  let h = EConstr.Unsafe.to_constr h in
-  let t = EConstr.Unsafe.to_constr t in
-    match (Constr.kind t) with
-      | App (f,args) ->
-        (match Constr.kind f with
-          | Const (c,_) when Array.length args = 2 ->
-            let t1= args.(0) in
-            let t2= args.(1) in
-            (match (string_of_R_constant c) with
-	      |"Rlt" -> [{hname=h;
-                           htype="Rlt";
-		           hleft=t1;
-			   hright=t2;
-			   hflin= flin_minus (flin_of_constr t1)
-                                             (flin_of_constr t2);
-			   hstrict=true}]
-	      |"Rgt" -> [{hname=h;
-                           htype="Rgt";
-		           hleft=t2;
-			   hright=t1;
-			   hflin= flin_minus (flin_of_constr t2)
-                                             (flin_of_constr t1);
-			   hstrict=true}]
-	      |"Rle" -> [{hname=h;
-                           htype="Rle";
-		           hleft=t1;
-			   hright=t2;
-			   hflin= flin_minus (flin_of_constr t1)
-                                             (flin_of_constr t2);
-			   hstrict=false}]
-	      |"Rge" -> [{hname=h;
-                           htype="Rge";
-		           hleft=t2;
-			   hright=t1;
-			   hflin= flin_minus (flin_of_constr t2)
-                                             (flin_of_constr t1);
-			   hstrict=false}]
-              |_-> raise NoIneq)
-          | Ind ((kn,i),_) ->
-            if not (eq_gr (IndRef(kn,i)) Coqlib.glob_eq) then raise NoIneq;
-            let t0= args.(0) in
-            let t1= args.(1) in
-            let t2= args.(2) in
-	    (match (Constr.kind t0) with
-              | Const (c,_) ->
-		(match (string_of_R_constant c) with
-		  | "R"->
-                         [{hname=h;
-                           htype="eqTLR";
-		           hleft=t1;
-			   hright=t2;
-			   hflin= flin_minus (flin_of_constr t1)
-                                             (flin_of_constr t2);
-			   hstrict=false};
-                          {hname=h;
-                           htype="eqTRL";
-		           hleft=t2;
-			   hright=t1;
-			   hflin= flin_minus (flin_of_constr t2)
-                                             (flin_of_constr t1);
-			   hstrict=false}]
-                  |_-> raise NoIneq)
-              |_-> raise NoIneq)
-          |_-> raise NoIneq)
-      |_-> raise NoIneq
-;;
-
-(* Applique la méthode de Fourier à une liste d'hypothèses (type hineq)
-*)
-
-let fourier_lineq lineq1 =
-   let nvar=ref (-1) in
-   let hvar=Constrhash.create 50 in (* la table des variables des inéquations *)
-   List.iter (fun f ->
-		Constrhash.iter (fun x _ -> if not (Constrhash.mem hvar x) then begin
-				nvar:=(!nvar)+1;
-				Constrhash.add hvar x (!nvar)
-			      end)
-                  f.hflin.fhom)
-             lineq1;
-   let sys= List.map (fun h->
-               let v=Array.make ((!nvar)+1) r0 in
-               Constrhash.iter (fun x c -> v.(Constrhash.find hvar x)<-c)
-                  h.hflin.fhom;
-               ((Array.to_list v)@[rop h.hflin.fcste],h.hstrict))
-             lineq1 in
-   unsolvable sys
-;;
-
-(*********************************************************************)
-(* Defined constants *)
-
-let get = Lazy.force
-let cget = get
-let eget c = EConstr.of_constr (Lazy.force c)
-let constant path s = Universes.constr_of_global @@
-  Coqlib.coq_reference "Fourier" path s
-
-(* Standard library *)
-open Coqlib
-let coq_sym_eqT = lazy (build_coq_eq_sym ())
-let coq_False = lazy (Universes.constr_of_global @@ build_coq_False ())
-let coq_not = lazy (Universes.constr_of_global @@ build_coq_not ())
-let coq_eq = lazy (Universes.constr_of_global @@ build_coq_eq ())
-
-(* Rdefinitions *)
-let constant_real = constant ["Reals";"Rdefinitions"]
-
-let coq_Rlt = lazy (constant_real "Rlt")
-let coq_Rgt = lazy (constant_real "Rgt")
-let coq_Rle = lazy (constant_real "Rle")
-let coq_Rge = lazy (constant_real "Rge")
-let coq_R = lazy (constant_real "R")
-let coq_Rminus = lazy (constant_real "Rminus")
-let coq_Rmult = lazy (constant_real "Rmult")
-let coq_Rplus = lazy (constant_real "Rplus")
-let coq_Ropp = lazy (constant_real "Ropp")
-let coq_Rinv = lazy (constant_real "Rinv")
-let coq_R0 = lazy (constant_real "R0")
-let coq_R1 = lazy (constant_real "R1")
-
-(* RIneq *)
-let coq_Rinv_1 = lazy (constant ["Reals";"RIneq"] "Rinv_1")
-
-(* Fourier_util *)
-let constant_fourier = constant ["fourier";"Fourier_util"]
-
-let coq_Rlt_zero_1 = lazy (constant_fourier "Rlt_zero_1")
-let coq_Rlt_zero_pos_plus1 = lazy (constant_fourier "Rlt_zero_pos_plus1")
-let coq_Rle_zero_pos_plus1 = lazy (constant_fourier "Rle_zero_pos_plus1")
-let coq_Rlt_mult_inv_pos = lazy (constant_fourier "Rlt_mult_inv_pos")
-let coq_Rle_zero_zero = lazy (constant_fourier "Rle_zero_zero")
-let coq_Rle_zero_1 = lazy (constant_fourier "Rle_zero_1")
-let coq_Rle_mult_inv_pos = lazy (constant_fourier "Rle_mult_inv_pos")
-let coq_Rnot_lt0 = lazy (constant_fourier "Rnot_lt0")
-let coq_Rle_not_lt = lazy (constant_fourier "Rle_not_lt")
-let coq_Rfourier_gt_to_lt = lazy (constant_fourier "Rfourier_gt_to_lt")
-let coq_Rfourier_ge_to_le = lazy (constant_fourier "Rfourier_ge_to_le")
-let coq_Rfourier_eqLR_to_le = lazy (constant_fourier "Rfourier_eqLR_to_le")
-let coq_Rfourier_eqRL_to_le = lazy (constant_fourier "Rfourier_eqRL_to_le")
-
-let coq_Rfourier_not_ge_lt = lazy (constant_fourier "Rfourier_not_ge_lt")
-let coq_Rfourier_not_gt_le = lazy (constant_fourier "Rfourier_not_gt_le")
-let coq_Rfourier_not_le_gt = lazy (constant_fourier "Rfourier_not_le_gt")
-let coq_Rfourier_not_lt_ge = lazy (constant_fourier "Rfourier_not_lt_ge")
-let coq_Rfourier_lt = lazy (constant_fourier "Rfourier_lt")
-let coq_Rfourier_le = lazy (constant_fourier "Rfourier_le")
-let coq_Rfourier_lt_lt = lazy (constant_fourier "Rfourier_lt_lt")
-let coq_Rfourier_lt_le = lazy (constant_fourier "Rfourier_lt_le")
-let coq_Rfourier_le_lt = lazy (constant_fourier "Rfourier_le_lt")
-let coq_Rfourier_le_le = lazy (constant_fourier "Rfourier_le_le")
-let coq_Rnot_lt_lt = lazy (constant_fourier "Rnot_lt_lt")
-let coq_Rnot_le_le = lazy (constant_fourier "Rnot_le_le")
-let coq_Rlt_not_le_frac_opp = lazy (constant_fourier "Rlt_not_le_frac_opp")
-
-(******************************************************************************
-Construction de la preuve en cas de succès de la méthode de Fourier,
-i.e. on obtient une contradiction.
-*)
-let is_int x = (x.den)=1
-;;
-
-(* fraction = couple (num,den) *)
-let rational_to_fraction x= (x.num,x.den)
-;;
-
-(* traduction -3 -> (Ropp (Rplus R1 (Rplus R1 R1)))
-*)
-let int_to_real n =
-   let nn=abs n in
-   if nn=0
-   then get coq_R0
-   else
-     (let s=ref (get coq_R1) in
-      for _i = 1 to (nn-1) do s:=mkApp (get coq_Rplus,[|get coq_R1;!s|]) done;
-      if n<0 then mkApp (get coq_Ropp, [|!s|]) else !s)
-;;
-(* -1/2 -> (Rmult (Ropp R1) (Rinv (Rplus R1 R1)))
-*)
-let rational_to_real x =
-   let (n,d)=rational_to_fraction x in
-   mkApp (get coq_Rmult,
-     [|int_to_real n;mkApp(get coq_Rinv,[|int_to_real d|])|])
-;;
-
-(* preuve que 0<n*1/d
-*)
-let tac_zero_inf_pos gl (n,d) =
-  let get = eget in
-   let tacn=ref (apply (get coq_Rlt_zero_1)) in
-   let tacd=ref (apply (get coq_Rlt_zero_1)) in
-   for _i = 1 to n - 1 do
-       tacn:=(Tacticals.New.tclTHEN (apply (get coq_Rlt_zero_pos_plus1)) !tacn); done;
-   for _i = 1 to d - 1 do
-       tacd:=(Tacticals.New.tclTHEN (apply (get coq_Rlt_zero_pos_plus1)) !tacd); done;
-   (Tacticals.New.tclTHENS (apply (get coq_Rlt_mult_inv_pos)) [!tacn;!tacd])
-;;
-
-(* preuve que 0<=n*1/d
-*)
-let tac_zero_infeq_pos gl (n,d)=
-  let get = eget in
-   let tacn=ref (if n=0
-                 then (apply (get coq_Rle_zero_zero))
-                 else (apply (get coq_Rle_zero_1))) in
-   let tacd=ref (apply (get coq_Rlt_zero_1)) in
-   for  _i = 1 to n - 1 do
-       tacn:=(Tacticals.New.tclTHEN (apply (get coq_Rle_zero_pos_plus1)) !tacn); done;
-   for _i = 1 to d - 1 do
-       tacd:=(Tacticals.New.tclTHEN (apply (get coq_Rlt_zero_pos_plus1)) !tacd); done;
-   (Tacticals.New.tclTHENS (apply (get coq_Rle_mult_inv_pos)) [!tacn;!tacd])
-;;
-
-(* preuve que 0<(-n)*(1/d) => False
-*)
-let tac_zero_inf_false gl (n,d) =
-      let get = eget in
-if n=0 then (apply (get coq_Rnot_lt0))
-    else
-     (Tacticals.New.tclTHEN (apply (get coq_Rle_not_lt))
-	      (tac_zero_infeq_pos gl (-n,d)))
-;;
-
-(* preuve que 0<=(-n)*(1/d) => False
-*)
-let tac_zero_infeq_false gl (n,d) =
-  let get = eget in
-     (Tacticals.New.tclTHEN (apply (get coq_Rlt_not_le_frac_opp))
-	      (tac_zero_inf_pos gl (-n,d)))
-;;
-
-let exact = exact_check;;
-
-let tac_use h =
-  let get = eget in
-  let tac = exact (EConstr.of_constr h.hname) in
-  match h.htype with
-    "Rlt" -> tac
-  |"Rle" -> tac
-  |"Rgt" -> (Tacticals.New.tclTHEN (apply (get coq_Rfourier_gt_to_lt)) tac)
-  |"Rge" -> (Tacticals.New.tclTHEN (apply (get coq_Rfourier_ge_to_le)) tac)
-  |"eqTLR" -> (Tacticals.New.tclTHEN (apply (get coq_Rfourier_eqLR_to_le)) tac)
-  |"eqTRL" -> (Tacticals.New.tclTHEN (apply (get coq_Rfourier_eqRL_to_le)) tac)
-  |_->assert false
-;;
-
-(*
-let is_ineq (h,t) =
-    match (Constr.kind t) with
-	App (f,args) ->
-	  (match (string_of_R_constr f) with
-	       "Rlt" -> true
-	     | "Rgt" -> true
-	     | "Rle" -> true
-	     | "Rge" -> true
-(* Wrong:not in Rdefinitions: *) | "eqT" ->
-                (match (string_of_R_constr args.(0)) with
-			     "R" -> true
-			   | _ -> false)
-             | _ ->false)
-      |_->false
-;;
-*)
-
-let list_of_sign s =
-  let open Context.Named.Declaration in
-  List.map (function LocalAssum (name, typ) -> name, typ
-                   | LocalDef (name, _, typ) -> name, typ)
-           s;;
-
-let mkAppL a =
-   let l = Array.to_list a in
-   mkApp(List.hd l, Array.of_list (List.tl l))
-;;
-
-exception GoalDone
-
-(* Résolution d'inéquations linéaires dans R *)
-let rec fourier () =
-  Proofview.Goal.nf_enter begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let sigma = Tacmach.New.project gl in
-    Coqlib.check_required_library ["Coq";"fourier";"Fourier"];
-    let goal = Termops.strip_outer_cast sigma concl in
-    let goal = EConstr.Unsafe.to_constr goal in
-    let fhyp=Id.of_string "new_hyp_for_fourier" in
-    (* si le but est une inéquation, on introduit son contraire,
-       et le but à prouver devient False *)
-    try 
-      match (Constr.kind goal) with
-      App (f,args) ->
-      let get = eget in
-      (match (string_of_R_constr f) with
-	     "Rlt" ->
-	       (Tacticals.New.tclTHEN
-	         (Tacticals.New.tclTHEN (apply (get coq_Rfourier_not_ge_lt))
-			  (intro_using  fhyp))
-		 (fourier ()))
-	    |"Rle" ->
-	     (Tacticals.New.tclTHEN
-	      (Tacticals.New.tclTHEN (apply (get coq_Rfourier_not_gt_le))
-		       (intro_using  fhyp))
-			(fourier ()))
-	    |"Rgt" ->
-	     (Tacticals.New.tclTHEN
-	      (Tacticals.New.tclTHEN (apply (get coq_Rfourier_not_le_gt))
-		       (intro_using  fhyp))
-	      (fourier ()))
-	    |"Rge" ->
-	     (Tacticals.New.tclTHEN
-	      (Tacticals.New.tclTHEN (apply (get coq_Rfourier_not_lt_ge))
-		       (intro_using  fhyp))
-	      (fourier ()))
-	    |_-> raise GoalDone)
-        |_-> raise GoalDone
-     with GoalDone ->
-    (* les hypothèses *)
-    let hyps = List.map (fun (h,t)-> (EConstr.mkVar h,t))
-                        (list_of_sign (Proofview.Goal.hyps gl)) in
-    let lineq =ref [] in
-    List.iter (fun h -> try (lineq:=(ineq1_of_constr h)@(!lineq))
-		        with NoIneq -> ())
-              hyps;
-    (* lineq = les inéquations découlant des hypothèses *)
-    if !lineq=[] then CErrors.user_err Pp.(str "No inequalities");
-    let res=fourier_lineq (!lineq) in
-    let tac=ref (Proofview.tclUNIT ()) in
-    if res=[]
-    then CErrors.user_err Pp.(str "fourier failed")
-    (* l'algorithme de Fourier a réussi: on va en tirer une preuve Coq *)
-    else (match res with
-        [(cres,sres,lc)]->
-    (* lc=coefficients multiplicateurs des inéquations
-       qui donnent 0<cres ou 0<=cres selon sres *)
-	(*print_string "Fourier's method can prove the goal...";flush stdout;*)
-          let lutil=ref [] in
-	  List.iter
-            (fun (h,c) ->
-			  if c<>r0
-        		  then (lutil:=(h,c)::(!lutil)(*;
-				print_rational(c);print_string " "*)))
-                    (List.combine (!lineq) lc);
-       (* on construit la combinaison linéaire des inéquation *)
-             (match (!lutil) with
-          (h1,c1)::lutil ->
-	  let s=ref (h1.hstrict) in
-	  let t1=ref (mkAppL [|get coq_Rmult;
-	                  rational_to_real c1;
-			  h1.hleft|]) in
-	  let t2=ref (mkAppL [|get coq_Rmult;
-	                  rational_to_real c1;
-			  h1.hright|]) in
-	  List.iter (fun (h,c) ->
-	       s:=(!s)||(h.hstrict);
-	       t1:=(mkAppL [|get coq_Rplus;
-	                     !t1;
-                             mkAppL [|get coq_Rmult;
-                                      rational_to_real c;
-			              h.hleft|] |]);
-	       t2:=(mkAppL [|get coq_Rplus;
-	                     !t2;
-                             mkAppL [|get coq_Rmult;
-                                      rational_to_real c;
-			              h.hright|] |]))
-               lutil;
-          let ineq=mkAppL [|if (!s) then get coq_Rlt else get coq_Rle;
-			      !t1;
-			      !t2 |] in
-	   let tc=rational_to_real cres in
-       (* puis sa preuve *)
-          let get = eget in
-           let tac1=ref (if h1.hstrict
-                         then (Tacticals.New.tclTHENS (apply (get coq_Rfourier_lt))
-                                 [tac_use h1;
-                                  tac_zero_inf_pos  gl
-                                      (rational_to_fraction c1)])
-                         else (Tacticals.New.tclTHENS (apply (get coq_Rfourier_le))
-                                 [tac_use h1;
-				  tac_zero_inf_pos  gl
-                                      (rational_to_fraction c1)])) in
-           s:=h1.hstrict;
-           List.iter (fun (h,c)->
-             (if (!s)
-	      then (if h.hstrict
-	            then tac1:=(Tacticals.New.tclTHENS (apply (get coq_Rfourier_lt_lt))
-			       [!tac1;tac_use h;
-			        tac_zero_inf_pos  gl
-                                      (rational_to_fraction c)])
-	            else tac1:=(Tacticals.New.tclTHENS (apply (get coq_Rfourier_lt_le))
-			       [!tac1;tac_use h;
-			        tac_zero_inf_pos  gl
-                                      (rational_to_fraction c)]))
-	      else (if h.hstrict
-	            then tac1:=(Tacticals.New.tclTHENS (apply (get coq_Rfourier_le_lt))
-			       [!tac1;tac_use h;
-			        tac_zero_inf_pos  gl
-                                      (rational_to_fraction c)])
-	            else tac1:=(Tacticals.New.tclTHENS (apply (get coq_Rfourier_le_le))
-			       [!tac1;tac_use h;
-			        tac_zero_inf_pos  gl
-                                      (rational_to_fraction c)])));
-	     s:=(!s)||(h.hstrict))
-              lutil;
-           let tac2= if sres
-                      then tac_zero_inf_false gl (rational_to_fraction cres)
-                      else tac_zero_infeq_false gl (rational_to_fraction cres)
-           in
-           tac:=(Tacticals.New.tclTHENS (cut (EConstr.of_constr ineq))
-                     [Tacticals.New.tclTHEN (change_concl
-			       (EConstr.of_constr (mkAppL [| cget coq_not; ineq|]
-				       )))
-		      (Tacticals.New.tclTHEN (apply (if sres then get coq_Rnot_lt_lt
-					       else get coq_Rnot_le_le))
-			    (Tacticals.New.tclTHENS (Equality.replace
-				       (EConstr.of_constr (mkAppL [|cget coq_Rminus;!t2;!t1|]
-					       ))
-				       (EConstr.of_constr tc))
-		 	       [tac2;
-                                (Tacticals.New.tclTHENS
-				  (Equality.replace
-				    (EConstr.of_constr (mkApp (cget coq_Rinv,
-				      [|cget coq_R1|])))
-				    (get coq_R1))
-(* en attendant Field, ça peut aider Ring de remplacer 1/1 par 1 ... *)
-
-      			        [Tacticals.New.tclORELSE
-                                   (* TODO : Ring.polynom []*) (Proofview.tclUNIT ())
-                                   (Proofview.tclUNIT ());
-				 Tacticals.New.pf_constr_of_global (cget coq_sym_eqT) >>= fun symeq ->
-					  (Tacticals.New.tclTHEN (apply symeq)
-						(apply (get coq_Rinv_1)))]
-
-					 )
-				]));
-                       !tac1]);
-	   tac:=(Tacticals.New.tclTHENS (cut (get coq_False))
-				  [Tacticals.New.tclTHEN intro (contradiction None);
-				   !tac])
-      |_-> assert false) |_-> assert false
-	  );
-(*    ((tclTHEN !tac (tclFAIL 1 (* 1 au hasard... *))) gl) *)
-      !tac
-(*      ((tclABSTRACT None !tac) gl) *)
-  end
-;;
-
-(*
-let fourier_tac x gl =
-     fourier gl
-;;
-
-let v_fourier = add_tactic "Fourier" fourier_tac
-*)
-
diff --git a/plugins/fourier/fourier_plugin.mlpack b/plugins/fourier/fourier_plugin.mlpack
deleted file mode 100644
index b6262f8a..00000000
--- a/plugins/fourier/fourier_plugin.mlpack
+++ /dev/null
@@ -1,3 +0,0 @@
-Fourier
-FourierR
-G_fourier
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index d04887a4..268a012b 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -230,7 +230,7 @@ let isAppConstruct ?(env=Global.env ()) sigma t =
   with Not_found -> false
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
-  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
+  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env @@ Evd.from_env Environ.empty_env
 
 
 exception NoChange
@@ -243,7 +243,7 @@ let change_eq env sigma hyp_id (context:rel_context) x t end_of_type  =
       raise NoChange;
     end
   in
-  let eq_constr c1 c2 = Evarconv.e_conv env (ref sigma) c1 c2 in
+  let eq_constr c1 c2 = Option.has_some (Evarconv.conv env sigma c1 c2) in
   if not (noccurn sigma 1 end_of_type)
   then nochange "dependent"; (* if end_of_type depends on this term we don't touch it  *)
     if not (isApp sigma t) then nochange "not an equality";
@@ -414,9 +414,9 @@ let rewrite_until_var arg_num eq_ids : tactic =
 
 let rec_pte_id = Id.of_string "Hrec"
 let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
-  let coq_False = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_False ()) in
-  let coq_True = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_True ()) in
-  let coq_I = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_I ()) in
+  let coq_False = EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_False ()) in
+  let coq_True = EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_True ()) in
+  let coq_I = EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_I ()) in
   let rec scan_type  context type_of_hyp : tactic =
     if isLetIn sigma type_of_hyp then
       let real_type_of_hyp = it_mkProd_or_LetIn type_of_hyp context in
@@ -598,7 +598,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
 	Proofview.V82.of_tactic (intro_using heq_id);
 	onLastHypId (fun heq_id -> tclTHENLIST [
 	(* Then the new hypothesis *)
-	tclMAP (fun id -> Proofview.V82.of_tactic (introduction ~check:false id)) dyn_infos.rec_hyps;
+        tclMAP (fun id -> Proofview.V82.of_tactic (introduction id)) dyn_infos.rec_hyps;
 	observe_tac "after_introduction" (fun g' ->
 	   (* We get infos on the equations introduced*)
 	   let new_term_value_eq = pf_unsafe_type_of g' (mkVar heq_id) in
@@ -638,11 +638,11 @@ let my_orelse tac1 tac2 g =
 (*     observe (str "using snd tac since : " ++ CErrors.print e); *)
     tac2 g
 
-let instanciate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
+let instantiate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
   let args = Array.of_list (List.map mkVar  args_id) in
-  let instanciate_one_hyp hid =
+  let instantiate_one_hyp hid =
     my_orelse
-      ( (* we instanciate the hyp if possible  *)
+      ( (* we instantiate the hyp if possible  *)
 	fun g ->
 	  let prov_hid = pf_get_new_id hid g in
 	  let c = mkApp(mkVar hid,args) in
@@ -678,7 +678,7 @@ let instanciate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
     tclTHENLIST
       [
 	tclMAP (fun hyp_id -> h_reduce_with_zeta (Locusops.onHyp hyp_id)) hyps;
-	tclMAP instanciate_one_hyp hyps;
+        tclMAP instantiate_one_hyp hyps;
 	(fun g ->
 	   let all_g_hyps_id =
 	     List.fold_right Id.Set.add (pf_ids_of_hyps g) Id.Set.empty
@@ -722,11 +722,11 @@ let build_proof
 			 tclTHENLIST [Proofview.V82.of_tactic (Simple.case t);
 				     (fun g' ->
 					let g'_nb_prod = nb_prod (project g') (pf_concl g') in
-					let nb_instanciate_partial = g'_nb_prod - g_nb_prod in
+                                        let nb_instantiate_partial = g'_nb_prod - g_nb_prod in
 			 		observe_tac "treat_new_case"
 					  (treat_new_case
 					     ptes_infos
-					     nb_instanciate_partial
+                                             nb_instantiate_partial
 					     (build_proof do_finalize)
 					     t
 					     dyn_infos)
@@ -760,7 +760,7 @@ let build_proof
 				  nb_rec_hyps  = List.length new_hyps
 			       }
 			   in
-(* 			   observe_tac "Lambda" *) (instanciate_hyps_with_args do_prove new_infos.rec_hyps [id]) g'
+(* 			   observe_tac "Lambda" *) (instantiate_hyps_with_args do_prove new_infos.rec_hyps [id]) g'
 			     (* 			   build_proof do_finalize new_infos g' *)
 			) g
 		  | _ ->
@@ -1013,7 +1013,7 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
   lemma_type
   (Lemmas.mk_hook (fun _ _ -> ()));
   ignore (Pfedit.by (Proofview.V82.tactic prove_replacement));
-  Lemmas.save_proof (Vernacexpr.(Proved(Transparent,None))); 
+  Lemmas.save_proof (Vernacexpr.(Proved(Proof_global.Transparent,None)));
   evd
 
 
@@ -1050,9 +1050,9 @@ let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num a
 	  (Global.env ()) !evd
 	  (Constrintern.locate_reference (qualid_of_ident equation_lemma_id))
       in
-      let res = EConstr.of_constr res in
-      evd:=evd';                       
-      let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd res in 
+      evd:=evd';
+      let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd res in
+      evd := sigma;
       res
   in
   let nb_intro_to_do = nb_prod (project g) (pf_concl g) in
@@ -1099,10 +1099,12 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
     let get_body const =
       match Global.body_of_constant const with
 	| Some (body, _) ->
+          let env = Global.env () in
+          let sigma = Evd.from_env env in
 	     Tacred.cbv_norm_flags
 	       (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
-	       (Global.env ())
-	       (Evd.empty)
+               env
+               sigma
 	       (EConstr.of_constr body)
 	| None -> user_err Pp.(str "Cannot define a principle over an axiom ")
     in
@@ -1118,7 +1120,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	in
 	(full_params, (* real params *)
 	 princ_params, (* the params of the principle which are not params of the function *)
-	 substl (* function instanciated with real params *)
+         substl (* function instantiated with real params *)
 	   (List.map var_of_decl full_params)
 	   f_body
 	)
@@ -1128,7 +1130,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	let f_body = compose_lam f_ctxt_other f_body in
 	(princ_info.params, (* real params *)
 	 [],(* all params are full params *)
-	 substl (* function instanciated with real params *)
+         substl (* function instantiated with real params *)
 	   (List.map var_of_decl princ_info.params)
 	   f_body
 	)
@@ -1242,7 +1244,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	      if this_fix_info.idx + 1 = 0
 	      then tclIDTAC (* Someone  tries to defined a principle on a fully parametric definition declared as a fixpoint (strange but ....) *)
 	      else
-		observe_tac_stream (str "h_fix " ++ int (this_fix_info.idx +1) ) (Proofview.V82.of_tactic (fix (Some this_fix_info.name) (this_fix_info.idx +1)))
+                observe_tac_stream (str "h_fix " ++ int (this_fix_info.idx +1) ) (Proofview.V82.of_tactic (fix this_fix_info.name (this_fix_info.idx +1)))
 	    else
 	      Proofview.V82.of_tactic (Tactics.mutual_fix this_fix_info.name (this_fix_info.idx + 1)
 		other_fix_infos 0)
@@ -1319,7 +1321,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 (* 			   str "args := " ++ prlist_with_sep spc Ppconstr.pr_id  args_id *)
 
 (* 			   ); *)
-		     (* observe_tac "instancing" *) (instanciate_hyps_with_args prove_tac
+                     (* observe_tac "instancing" *) (instantiate_hyps_with_args prove_tac
 		       (List.rev_map id_of_decl princ_info.branches)
 		       (List.rev args_id))
 		   ]
@@ -1340,7 +1342,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		     nb_rec_hyps = -100;
 		     rec_hyps = [];
 		     info =
-                       Reductionops.nf_betaiota (pf_env g) Evd.empty
+                       Reductionops.nf_betaiota (pf_env g) (project g)
 			 (applist(fbody_with_full_params,
 				  (List.rev_map var_of_decl princ_params)@
 				    (List.rev_map mkVar args_id)
@@ -1369,7 +1371,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 			 do_prove
 			 dyn_infos
 		    in
-		    instanciate_hyps_with_args prove_tac
+                    instantiate_hyps_with_args prove_tac
 		       (List.rev_map id_of_decl princ_info.branches)
 		      (List.rev args_id)
 		   ]
@@ -1603,7 +1605,7 @@ let prove_principle_for_gen
     match !tcc_lemma_ref with
      | Undefined -> user_err Pp.(str "No tcc proof !!")
      | Value lemma -> EConstr.of_constr lemma
-     | Not_needed -> EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_I ())
+     | Not_needed -> EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_I ())
   in
 (*   let rec list_diff del_list check_list = *)
 (*     match del_list with *)
@@ -1657,7 +1659,7 @@ let prove_principle_for_gen
 (*       observe_tac "reverting" *) (revert (List.rev (acc_rec_arg_id::args_ids)));
 (*       (fun g -> observe (Printer.pr_goal (sig_it g) ++ fnl () ++  *)
 (* 			   str "fix arg num" ++ int (List.length args_ids + 1) ); tclIDTAC g); *)
-      (* observe_tac "h_fix " *) (Proofview.V82.of_tactic (fix (Some fix_id) (List.length args_ids + 1)));
+      (* observe_tac "h_fix " *) (Proofview.V82.of_tactic (fix fix_id (List.length args_ids + 1)));
 (*       (fun g -> observe (Printer.pr_goal (sig_it g) ++ fnl() ++ pr_lconstr_env (pf_env g ) (pf_unsafe_type_of g (mkVar fix_id) )); tclIDTAC g); *)
       h_intros (List.rev (acc_rec_arg_id::args_ids));
       Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_ref));
@@ -1726,8 +1728,8 @@ let prove_principle_for_gen
 	     ptes_info
 	     (body_info rec_hyps)
 	 in
-	 (* observe_tac "instanciate_hyps_with_args"  *)
-	   (instanciate_hyps_with_args
+         (* observe_tac "instantiate_hyps_with_args"  *)
+           (instantiate_hyps_with_args
 	      make_proof
 	      (List.map (get_name %> Nameops.Name.get_id) princ_info.branches)
 	      (List.rev args_ids)
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 804548ce..b2a528a1 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -266,7 +266,7 @@ let change_property_sort evd toSort princ princName =
       (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident princName)) in
   let init =
     let nargs =  (princ_info.nparams + (List.length  princ_info.predicates)) in
-    mkApp(princName_as_constr,
+    mkApp(EConstr.Unsafe.to_constr princName_as_constr,
 	  Array.init nargs
 	    (fun i -> mkRel (nargs - i )))
   in
@@ -291,7 +291,8 @@ let build_functional_principle (evd:Evd.evar_map ref) interactive_proof old_prin
   let new_princ_name =
     next_ident_away_in_goal (Id.of_string "___________princ_________") Id.Set.empty
   in
-  let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd (EConstr.of_constr new_principle_type) in
+  let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd (EConstr.of_constr new_principle_type) in
+  evd := sigma;
   let hook = Lemmas.mk_hook (hook new_principle_type) in
   begin
     Lemmas.start_proof
@@ -321,8 +322,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
   try
 
   let f = funs.(i) in
-  let env = Global.env () in    
-  let type_sort = Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd InType in
+  let type_sort = Evarutil.evd_comb1 Evd.fresh_sort_in_family evd InType in
   let new_sorts =
     match sorts with
       | None -> Array.make (Array.length funs) (type_sort)
@@ -343,7 +343,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
       (*     let id_of_f = Label.to_id (con_label f) in *)
       let register_with_sort fam_sort =
         let evd' = Evd.from_env (Global.env ()) in
-        let evd',s = Evd.fresh_sort_in_family env evd' fam_sort in
+        let evd',s = Evd.fresh_sort_in_family evd' fam_sort in
         let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
         let evd',value = change_property_sort evd' s new_principle_type new_princ_name in
         let evd' = fst (Typing.type_of ~refresh:true (Global.env ()) evd' (EConstr.of_constr value)) in
@@ -353,7 +353,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
           Evd.const_univ_entry ~poly evd'
         in
         let ce = Declare.definition_entry ~univs value in
-	ignore(
+        ignore(
 	  Declare.declare_constant
 	    name
 	    (DefinitionEntry ce,
@@ -507,8 +507,8 @@ let make_scheme evd (fas : (pconstant*Sorts.family) list) : Safe_typing.private_
   let i = ref (-1) in
   let sorts =
     List.rev_map (fun (_,x) ->
-		  Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd x
-	     )
+                  Evarutil.evd_comb1 Evd.fresh_sort_in_family evd x
+             )
       fas
   in
   (* We create the first priciple by tactic *)
@@ -626,15 +626,19 @@ let build_scheme fas =
 		Smartlocate.global_with_alias f
 	      with Not_found ->
                 user_err ~hdr:"FunInd.build_scheme"
-                  (str "Cannot find " ++ Libnames.pr_reference f)
+                  (str "Cannot find " ++ Libnames.pr_qualid f)
 	    in
             let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
             let _ = evd := evd' in 
-	    let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd (EConstr.of_constr f) in 
-            if isConst f
-            then (destConst f,sort)
-            else user_err Pp.(pr_constr_env (Global.env ()) !evd f ++spc () ++ str "should be the named of a globally defined function")
-	 )
+            let sigma, _ = Typing.type_of ~refresh:true (Global.env ()) !evd f in
+            evd := sigma;
+            let c, u =
+              try EConstr.destConst !evd f
+              with DestKO ->
+                user_err Pp.(pr_econstr_env (Global.env ()) !evd f ++spc () ++ str "should be the named of a globally defined function")
+            in
+            (c, EConstr.EInstance.kind !evd u), sort
+         )
 	 fas
 		   ) in
   let bodies_types =
@@ -663,7 +667,7 @@ let build_case_scheme fa =
     try fst (Global.constr_of_global_in_context (Global.env ()) (Smartlocate.global_with_alias f))
     with Not_found ->
       user_err ~hdr:"FunInd.build_case_scheme"
-        (str "Cannot find " ++ Libnames.pr_reference f) in
+        (str "Cannot find " ++ Libnames.pr_qualid f) in
   let first_fun,u = destConst  funs in
   let funs_mp,funs_dp,_ = Constant.repr3 first_fun in
   let first_fun_kn = try fst (find_Function_infos  first_fun).graph_ind with Not_found -> raise No_graph_found in
@@ -684,7 +688,7 @@ let build_case_scheme fa =
   let scheme_type = EConstr.Unsafe.to_constr ((Typing.unsafe_type_of env sigma) (EConstr.of_constr scheme)) in
   let sorts =
     (fun (_,_,x) ->
-       Universes.new_sort_in_family x
+       UnivGen.new_sort_in_family x
     )
       fa
   in
diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli
index 33aeafef..97f9acdb 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -36,5 +36,5 @@ exception No_graph_found
 val make_scheme :   Evd.evar_map ref ->
  (pconstant*Sorts.family) list -> Safe_typing.private_constants Entries.definition_entry list
 
-val build_scheme : (Id.t*Libnames.reference*Sorts.family) list ->  unit
-val build_case_scheme : (Id.t*Libnames.reference*Sorts.family)  ->  unit
+val build_scheme : (Id.t*Libnames.qualid*Sorts.family) list ->  unit
+val build_case_scheme : (Id.t*Libnames.qualid*Sorts.family)  ->  unit
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index 90af20b4..a2d31780 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -15,7 +15,8 @@ open Indfun_common
 open Indfun
 open Genarg
 open Stdarg
-open Misctypes
+open Tacarg
+open Tactypes
 open Pcoq
 open Pcoq.Prim
 open Pcoq.Constr
@@ -38,7 +39,9 @@ let pr_fun_ind_using_typed prc prlc _ opt_c =
   match opt_c with
     | None -> mt ()
     | Some b ->
-      let (_, b) = b (Global.env ()) Evd.empty in
+      let env = Global.env () in
+      let evd = Evd.from_env env in
+      let (_, b) = b env evd in
       spc () ++ hov 2 (str "using" ++ spc () ++ Miscprint.pr_with_bindings prc prlc b)
 
 
@@ -123,7 +126,7 @@ ARGUMENT EXTEND auto_using'
 END
 
 module Gram = Pcoq.Gram
-module Vernac = Pcoq.Vernac_
+module Vernac = Pvernac.Vernac_
 module Tactic = Pltac
 
 type function_rec_definition_loc_argtype = (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) Loc.located
@@ -165,7 +168,7 @@ END
 
 let pr_fun_scheme_arg (princ_name,fun_name,s) =
   Names.Id.print princ_name ++ str " :=" ++ spc() ++ str "Induction for " ++
-  Libnames.pr_reference fun_name ++ spc() ++ str "Sort " ++
+  Libnames.pr_qualid fun_name ++ spc() ++ str "Sort " ++
   Termops.pr_sort_family s
 
 VERNAC ARGUMENT EXTEND fun_scheme_arg
@@ -178,11 +181,11 @@ let warning_error names e =
   let (e, _) = ExplainErr.process_vernac_interp_error (e, Exninfo.null) in
   match e with
     | Building_graph e ->
-       let names = pr_enum Libnames.pr_reference names in
+       let names = pr_enum Libnames.pr_qualid names in
        let error = if do_observe () then (spc () ++ CErrors.print e) else mt () in
        warn_cannot_define_graph (names,error)
     | Defining_principle e ->
-       let names = pr_enum Libnames.pr_reference names in
+       let names = pr_enum Libnames.pr_qualid names in
        let error = if do_observe () then CErrors.print e else mt () in
        warn_cannot_define_principle (names,error)
     | _ -> raise e
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 04006453..926a2056 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -10,7 +10,6 @@ open Indfun_common
 open CErrors
 open Util
 open Glob_termops
-open Misctypes
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
@@ -883,7 +882,7 @@ let is_res r = match DAst.get r with
 | _ -> false
 
 let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
+| GRef (r, _) -> GlobRef.equal r gr
 | _ -> false
 
 let is_gvar c = match DAst.get c with
@@ -892,7 +891,7 @@ let is_gvar c = match DAst.get c with
 
 let same_raw_term rt1 rt2 = 
   match DAst.get rt1, DAst.get rt2 with 
-    | GRef(r1,_), GRef (r2,_) -> Globnames.eq_gr r1 r2
+    | GRef(r1,_), GRef (r2,_) -> GlobRef.equal r1 r2
     | GHole _, GHole _ -> true
     | _ -> false
 let decompose_raw_eq lhs rhs = 
@@ -1498,7 +1497,7 @@ let do_build_inductive
   let _time2 = System.get_time () in
   try
     with_full_print
-      (Flags.silently (ComInductive.do_mutual_inductive rel_inds (Flags.is_universe_polymorphism ()) false false))
+      (Flags.silently (ComInductive.do_mutual_inductive rel_inds (Flags.is_universe_polymorphism ()) false false ~uniform:ComInductive.NonUniformParameters))
       Declarations.Finite
   with
     | UserError(s,msg) as e ->
@@ -1510,7 +1509,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(GlobalNonCumulativity,false,Declarations.Finite,repacked_rel_inds)))
+            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(None,false,Declarations.Finite,repacked_rel_inds)))
 	    ++ fnl () ++
 	    msg
 	in
@@ -1525,7 +1524,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(GlobalNonCumulativity,false,Declarations.Finite,repacked_rel_inds)))
+            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(None,false,Declarations.Finite,repacked_rel_inds)))
 	    ++ fnl () ++
 	    CErrors.print reraise
 	in
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 769fcc1c..f81de82d 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -1,10 +1,10 @@
 open Pp
+open Constr
 open Glob_term
 open CErrors
 open Util
 open Names
 open Decl_kinds
-open Misctypes
 
 (*
    Some basic functions to rebuild glob_constr
@@ -16,8 +16,8 @@ let mkGApp(rt,rtl)      = DAst.make @@ GApp(rt,rtl)
 let mkGLambda(n,t,b)    = DAst.make @@ GLambda(n,Explicit,t,b)
 let mkGProd(n,t,b)      = DAst.make @@ GProd(n,Explicit,t,b)
 let mkGLetIn(n,b,t,c)   = DAst.make @@ GLetIn(n,b,t,c)
-let mkGCases(rto,l,brl) = DAst.make @@ GCases(Term.RegularStyle,rto,l,brl)
-let mkGHole ()          = DAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Misctypes.IntroAnonymous,None)
+let mkGCases(rto,l,brl) = DAst.make @@ GCases(RegularStyle,rto,l,brl)
+let mkGHole ()          = DAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Namegen.IntroAnonymous,None)
 
 (*
   Some basic functions to decompose glob_constrs
@@ -108,7 +108,7 @@ let change_vars =
       | GHole _ as x -> x
       | GCast(b,c) ->
 	  GCast(change_vars mapping b,
-		Miscops.map_cast_type (change_vars mapping) c)
+                Glob_ops.map_cast_type (change_vars mapping) c)
       ) rt
   and change_vars_br mapping ({CAst.loc;v=(idl,patl,res)} as br) =
     let new_mapping = List.fold_right Id.Map.remove idl mapping in
@@ -288,7 +288,7 @@ let rec alpha_rt excluded rt =
     | GHole _ as rt -> rt
     | GCast (b,c) ->
 	GCast(alpha_rt excluded b,
-	      Miscops.map_cast_type (alpha_rt excluded) c)
+              Glob_ops.map_cast_type (alpha_rt excluded) c)
     | GApp(f,args) ->
 	GApp(alpha_rt excluded f,
 	     List.map (alpha_rt excluded) args
@@ -436,7 +436,7 @@ let replace_var_by_term x_id term =
       | GHole _ as rt -> rt
       | GCast(b,c) ->
 	  GCast(replace_var_by_pattern b,
-		Miscops.map_cast_type replace_var_by_pattern c)
+                Glob_ops.map_cast_type replace_var_by_pattern c)
     ) x
   and replace_var_by_pattern_br ({CAst.loc;v=(idl,patl,res)} as br) =
     if List.exists (fun id -> Id.compare id x_id == 0) idl
@@ -536,7 +536,7 @@ let expand_as =
       | GRec _ ->  user_err Pp.(str "Not handled GRec")
       | GCast(b,c) ->
 	  GCast(expand_as map b,
-		Miscops.map_cast_type (expand_as map) c)
+                Glob_ops.map_cast_type (expand_as map) c)
       | GCases(sty,po,el,brl) ->
 	  GCases(sty, Option.map (expand_as map) po, List.map (fun (rt,t) -> expand_as map rt,t) el,
 		List.map (expand_as_br map) brl)
@@ -557,7 +557,8 @@ let resolve_and_replace_implicits ?(flags=Pretyping.all_and_fail_flags) ?(expect
   (* FIXME : JF (30/03/2017) I'm not completely sure to have split understand as needed. 
 If someone knows how to prevent solved existantial removal in  understand, please do not hesitate to change the computation of [ctx] here *) 
   let ctx,_,_ = Pretyping.ise_pretype_gen flags env sigma Glob_ops.empty_lvar expected_type rt in
-  let ctx, f = Evarutil.nf_evars_and_universes ctx in
+  let ctx = Evd.minimize_universes ctx in
+  let f c = EConstr.of_constr (Evarutil.nf_evars_universes ctx (EConstr.Unsafe.to_constr c)) in
 
   (* then we map [rt] to replace the implicit holes by their values *)
   let rec change rt =
@@ -569,7 +570,7 @@ If someone knows how to prevent solved existantial removal in  understand, pleas
              (fun _ evi _ ->
                match evi.evar_source with
                | (loc_evi,ImplicitArg(gr_evi,p_evi,b_evi)) ->
-                  if Globnames.eq_gr grk gr_evi && pk=p_evi && bk=b_evi  && rt.CAst.loc = loc_evi
+                  if GlobRef.equal grk gr_evi && pk=p_evi && bk=b_evi  && rt.CAst.loc = loc_evi
                   then raise (Found evi)
                | _ -> ()
              )
@@ -580,8 +581,8 @@ If someone knows how to prevent solved existantial removal in  understand, pleas
          with Found evi -> (* we found the evar corresponding to this hole *)
            match evi.evar_body with
            | Evar_defined c ->
-           (* we just have to lift the solution in glob_term *)
-              Detyping.detype Detyping.Now false Id.Set.empty env ctx (EConstr.of_constr (f c))
+             (* we just have to lift the solution in glob_term *)
+              Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
            | Evar_empty -> rt (* the hole was not solved : we do nothing *)
        )
     | (GHole(BinderType na,_,_)) -> (* we only want to deal with implicit arguments *)
@@ -603,7 +604,7 @@ If someone knows how to prevent solved existantial removal in  understand, pleas
                 match evi.evar_body with
                 | Evar_defined c ->
                    (* we just have to lift the solution in glob_term *)
-                   Detyping.detype Detyping.Now false Id.Set.empty env ctx (EConstr.of_constr (f c))
+                   Detyping.detype Detyping.Now false Id.Set.empty env ctx (f c)
                 | Evar_empty -> rt (* the hole was not solved : we d when falseo nothing *)
          in 
          res
diff --git a/plugins/funind/glob_termops.mli b/plugins/funind/glob_termops.mli
index 7088ae59..481a8be3 100644
--- a/plugins/funind/glob_termops.mli
+++ b/plugins/funind/glob_termops.mli
@@ -13,7 +13,7 @@ val pattern_to_term : cases_pattern -> glob_constr
    Some basic functions to rebuild glob_constr
    In each of them the location is Util.Loc.ghost
 *)
-val mkGRef : Globnames.global_reference -> glob_constr
+val mkGRef : GlobRef.t -> glob_constr
 val mkGVar : Id.t -> glob_constr
 val mkGApp  : glob_constr*(glob_constr list) -> glob_constr
 val mkGLambda : Name.t * glob_constr * glob_constr -> glob_constr
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 57863ee6..9eda19a8 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -10,7 +10,7 @@ open Libnames
 open Globnames
 open Glob_term
 open Declarations
-open Misctypes
+open Tactypes
 open Decl_kinds
 
 module RelDecl = Context.Rel.Declaration
@@ -77,8 +77,7 @@ let functional_induction with_clean c princl pat =
 		    user_err  (str "Cannot find induction principle for "
                                      ++ Printer.pr_leconstr_env (Tacmach.pf_env g) sigma (mkConst c') )
 	      in
-	      let princ = EConstr.of_constr princ in
-	      (princ,NoBindings,Tacmach.pf_unsafe_type_of g' princ,g')
+              (princ,NoBindings,Tacmach.pf_unsafe_type_of g' princ,g')
 	   | _ -> raise (UserError(None,str "functional induction must be used with a function" ))
 	 end
       | Some ((princ,binding)) ->
@@ -99,7 +98,7 @@ let functional_induction with_clean c princl pat =
       List.map2
         (fun c pat ->
           ((None,
-            Ltac_plugin.Tacexpr.ElimOnConstr (fun env sigma -> (sigma,(c,NoBindings)))),
+            Tactics.ElimOnConstr (fun env sigma -> (sigma,(c,NoBindings)))),
            (None,pat),
            None))
         (args@c_list)
@@ -260,7 +259,6 @@ let derive_inversion fix_names =
 	 let evd,c =
 	   Evd.fresh_global
 	     (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident id)) in 
-        let c = EConstr.of_constr c in
         let (cst, u) = destConst evd c in
 	 evd, (cst, EInstance.kind evd u) :: l
 	)
@@ -282,8 +280,7 @@ let derive_inversion fix_names =
 	       (Global.env ()) evd
 	       (Constrintern.locate_reference (Libnames.qualid_of_ident (mk_rel_id id)))
 	   in 
-	   let id = EConstr.of_constr id in
-	   evd,(fst (destInd evd id))::l
+           evd,(fst (destInd evd id))::l
 	  )
 	  fix_names
 	  (evd',[])
@@ -364,17 +361,17 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 	(*i The next call to mk_rel_id is valid since we have just construct the graph
 	   Ensures by : do_built
 	i*)
-        let f_R_mut = CAst.make @@ Ident (mk_rel_id (List.nth names 0)) in
+        let f_R_mut = qualid_of_ident @@ mk_rel_id (List.nth names 0) in
 	let ind_kn =
 	  fst (locate_with_msg
-		 (pr_reference f_R_mut++str ": Not an inductive type!")
+                 (pr_qualid f_R_mut++str ": Not an inductive type!")
 		 locate_ind
 		 f_R_mut)
 	in
 	let fname_kn (((fname,_),_,_,_,_),_) =
-          let f_ref = CAst.map (fun n -> Ident n) fname in
-	  locate_with_msg
-	    (pr_reference f_ref++str ": Not an inductive type!")
+   let f_ref = qualid_of_ident ?loc:fname.CAst.loc fname.CAst.v in
+          locate_with_msg
+            (pr_qualid f_ref++str ": Not an inductive type!")
 	    locate_constant
 	    f_ref
 	in
@@ -387,7 +384,8 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 	     let evd = ref (Evd.from_env env) in
 	     let evd',uprinc = Evd.fresh_global env !evd princ in
              let _ = evd := evd' in 
-	     let princ_type = Typing.e_type_of ~refresh:true env evd (EConstr.of_constr uprinc) in
+             let sigma, princ_type = Typing.type_of ~refresh:true env !evd uprinc in
+             evd := sigma;
 	     let princ_type = EConstr.Unsafe.to_constr princ_type in
     	     Functional_principles_types.generate_functional_principle
 	       evd
@@ -424,7 +422,6 @@ let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexp
 	    let evd,c =
 	      Evd.fresh_global
 		(Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname)) in
-            let c = EConstr.of_constr c in
             let (cst, u) = destConst evd c in
             let u = EInstance.kind evd u in
             evd,((cst, u) :: l)
@@ -441,7 +438,6 @@ let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexp
 	    let evd,c =
 	      Evd.fresh_global
 		(Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname)) in
-            let c = EConstr.of_constr c in
             let (cst, u) = destConst evd c in
             let u = EInstance.kind evd u in
             evd,((cst, u) :: l)
@@ -480,7 +476,7 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
   let unbounded_eq =
     let f_app_args =
       CAst.make @@ Constrexpr.CAppExpl(
-         (None,CAst.make @@ Ident fname,None) ,
+         (None,qualid_of_ident fname,None) ,
 	 (List.map
 	    (function
                | {CAst.v=Anonymous} -> assert false
@@ -490,7 +486,7 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
 	 )
 	)
     in
-    CAst.make @@ Constrexpr.CApp ((None,Constrexpr_ops.mkRefC (CAst.make @@ Qualid (qualid_of_string "Logic.eq"))),
+    CAst.make @@ Constrexpr.CApp ((None,Constrexpr_ops.mkRefC (qualid_of_string "Logic.eq")),
 		    [(f_app_args,None);(body,None)])
   in
   let eq = Constrexpr_ops.mkCProdN args unbounded_eq in
@@ -547,9 +543,9 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
       | None ->
 	  let ltof =
 	    let make_dir l = DirPath.make (List.rev_map Id.of_string l) in
-            CAst.make @@ Libnames.Qualid (Libnames.qualid_of_path
-			       (Libnames.make_path (make_dir ["Arith";"Wf_nat"]) (Id.of_string "ltof")))
-	  in
+            Libnames.qualid_of_path
+              (Libnames.make_path (make_dir ["Arith";"Wf_nat"]) (Id.of_string "ltof"))
+          in
 	  let fun_from_mes =
 	    let applied_mes =
 	      Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC wf_arg])    in
@@ -730,12 +726,10 @@ let do_generate_principle pconstants on_error register_built interactive_proof
   ()
 
 let rec add_args id new_args = CAst.map (function
-  | CRef (r,_) as b ->
-      begin match r with
-        | {CAst.v=Libnames.Ident fname} when Id.equal fname id ->
-	    CAppExpl((None,r,None),new_args)
-	| _ -> b
-      end
+  | CRef (qid,_) as b ->
+    if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
+      CAppExpl((None,qid,None),new_args)
+    else b
   | CFix  _  | CCoFix _ -> anomaly ~label:"add_args " (Pp.str "todo.")
   | CProdN(nal,b1) ->
         CProdN(List.map (function  CLocalAssum (nal,k,b2) -> CLocalAssum (nal,k,add_args id new_args b2)
@@ -749,13 +743,10 @@ let rec add_args id new_args = CAst.map (function
 	       add_args id new_args  b1)
   | CLetIn(na,b1,t,b2) ->
       CLetIn(na,add_args id new_args b1,Option.map (add_args id new_args) t,add_args id new_args b2)
-  | CAppExpl((pf,r,us),exprl) ->
-      begin
-	match r with
-        | {CAst.v=Libnames.Ident fname} when Id.equal fname id ->
-	    CAppExpl((pf,r,us),new_args@(List.map (add_args id new_args) exprl))
-	| _ -> CAppExpl((pf,r,us),List.map (add_args id new_args) exprl)
-      end
+  | CAppExpl((pf,qid,us),exprl) ->
+    if qualid_is_ident qid && Id.equal (qualid_basename qid) id then
+      CAppExpl((pf,qid,us),new_args@(List.map (add_args id new_args) exprl))
+    else CAppExpl((pf,qid,us),List.map (add_args id new_args) exprl)
   | CApp((pf,b),bl) ->
       CApp((pf,add_args id new_args b),
 	   List.map (fun (e,o) -> add_args id new_args e,o) bl)
@@ -785,7 +776,7 @@ let rec add_args id new_args = CAst.map (function
   | CSort _ as b -> b
   | CCast(b1,b2)  ->
       CCast(add_args id new_args b1,
-	    Miscops.map_cast_type (add_args id new_args) b2)
+            Glob_ops.map_cast_type (add_args id new_args) b2)
   | CRecord pars ->
       CRecord (List.map (fun (e,o) -> e, add_args id new_args o) pars)
   | CNotation _ -> anomaly ~label:"add_args " (Pp.str "CNotation.")
@@ -849,7 +840,7 @@ let rec get_args b t : Constrexpr.local_binder_expr list *
     | _ -> [],b,t
 
 
-let make_graph (f_ref:global_reference) =
+let make_graph (f_ref : GlobRef.t) =
   let c,c_body =
     match f_ref with
     | ConstRef c ->
@@ -890,7 +881,7 @@ let make_graph (f_ref:global_reference) =
 				  | Constrexpr.CLocalAssum (nal,_,_) ->
 				      List.map
                                         (fun {CAst.loc;v=n} -> CAst.make ?loc @@
-                                           CRef(CAst.make ?loc @@ Libnames.Ident(Nameops.Name.get_id n),None))
+                                           CRef(Libnames.qualid_of_ident ?loc @@ Nameops.Name.get_id n,None))
 					nal
                                   | Constrexpr.CLocalPattern _ -> assert false
 			       )
diff --git a/plugins/funind/indfun.mli b/plugins/funind/indfun.mli
index dcc1c2ea..f209fb19 100644
--- a/plugins/funind/indfun.mli
+++ b/plugins/funind/indfun.mli
@@ -1,4 +1,5 @@
-open Misctypes
+open Names
+open Tactypes
 
 val warn_cannot_define_graph : ?loc:Loc.t -> Pp.t * Pp.t -> unit
 
@@ -18,4 +19,4 @@ val functional_induction :
   Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
 
 
-val make_graph :  Globnames.global_reference -> unit
+val make_graph : GlobRef.t -> unit
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index a0b9217c..4eee2c7a 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -31,9 +31,7 @@ let id_of_name = function
     Name id -> id
   | _ -> raise Not_found
 
-let locate  ref =
-    let {CAst.v=qid} = qualid_of_reference ref in
-    Nametab.locate qid
+let locate qid = Nametab.locate qid
 
 let locate_ind ref =
   match locate ref with
@@ -109,7 +107,7 @@ let const_of_id id =
 
 let def_of_const t =
    match Constr.kind t with
-    Term.Const sp ->
+    Const sp ->
       (try (match Environ.constant_opt_value_in (Global.env()) sp with
              | Some c -> c
 	     | _ -> assert false)
@@ -117,7 +115,7 @@ let def_of_const t =
     |_ -> assert false
 
 let coq_constant s =
-  Universes.constr_of_global @@
+  UnivGen.constr_of_global @@
   Coqlib.gen_reference_in_modules "RecursiveDefinition"
     Coqlib.init_modules s;;
 
@@ -269,12 +267,12 @@ let subst_Function (subst,finfos) =
   in
   let function_constant' = do_subst_con finfos.function_constant in
   let graph_ind' = do_subst_ind finfos.graph_ind in
-  let equation_lemma' = Option.smartmap do_subst_con finfos.equation_lemma in
-  let correctness_lemma' = Option.smartmap do_subst_con finfos.correctness_lemma in
-  let completeness_lemma' = Option.smartmap do_subst_con finfos.completeness_lemma in
-  let rect_lemma' = Option.smartmap do_subst_con finfos.rect_lemma in
-  let rec_lemma' = Option.smartmap do_subst_con finfos.rec_lemma in
-  let prop_lemma' =  Option.smartmap do_subst_con finfos.prop_lemma in
+  let equation_lemma' = Option.Smart.map do_subst_con finfos.equation_lemma in
+  let correctness_lemma' = Option.Smart.map do_subst_con finfos.correctness_lemma in
+  let completeness_lemma' = Option.Smart.map do_subst_con finfos.completeness_lemma in
+  let rect_lemma' = Option.Smart.map do_subst_con finfos.rect_lemma in
+  let rec_lemma' = Option.Smart.map do_subst_con finfos.rec_lemma in
+  let prop_lemma' =  Option.Smart.map do_subst_con finfos.prop_lemma in
   if function_constant' == finfos.function_constant &&
     graph_ind' == finfos.graph_ind &&
     equation_lemma' == finfos.equation_lemma &&
@@ -302,12 +300,12 @@ let classify_Function infos = Libobject.Substitute infos
 let discharge_Function (_,finfos) =
   let function_constant' = Lib.discharge_con finfos.function_constant
   and graph_ind' = Lib.discharge_inductive finfos.graph_ind
-  and equation_lemma' = Option.smartmap Lib.discharge_con finfos.equation_lemma
-  and correctness_lemma' = Option.smartmap Lib.discharge_con finfos.correctness_lemma
-  and completeness_lemma' = Option.smartmap Lib.discharge_con finfos.completeness_lemma
-  and rect_lemma' = Option.smartmap Lib.discharge_con finfos.rect_lemma
-  and rec_lemma' = Option.smartmap Lib.discharge_con finfos.rec_lemma
-  and prop_lemma' = Option.smartmap Lib.discharge_con finfos.prop_lemma
+  and equation_lemma' = Option.Smart.map Lib.discharge_con finfos.equation_lemma
+  and correctness_lemma' = Option.Smart.map Lib.discharge_con finfos.correctness_lemma
+  and completeness_lemma' = Option.Smart.map Lib.discharge_con finfos.completeness_lemma
+  and rect_lemma' = Option.Smart.map Lib.discharge_con finfos.rect_lemma
+  and rec_lemma' = Option.Smart.map Lib.discharge_con finfos.rec_lemma
+  and prop_lemma' = Option.Smart.map Lib.discharge_con finfos.prop_lemma
   in
   if function_constant' == finfos.function_constant &&
     graph_ind' == finfos.graph_ind &&
@@ -471,7 +469,7 @@ let jmeq () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
     EConstr.of_constr @@
-    Universes.constr_of_global @@
+    UnivGen.constr_of_global @@
       Coqlib.coq_reference "Function" ["Logic";"JMeq"] "JMeq"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
@@ -479,7 +477,7 @@ let jmeq_refl () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
     EConstr.of_constr @@
-    Universes.constr_of_global @@
+    UnivGen.constr_of_global @@
       Coqlib.coq_reference "Function" ["Logic";"JMeq"] "JMeq_refl"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
@@ -492,7 +490,7 @@ let well_founded = function () -> EConstr.of_constr (coq_constant "well_founded"
 let acc_rel = function () -> EConstr.of_constr (coq_constant "Acc")
 let acc_inv_id = function () -> EConstr.of_constr (coq_constant "Acc_inv")
 
-let well_founded_ltof () = EConstr.of_constr @@ Universes.constr_of_global @@
+let well_founded_ltof () = EConstr.of_constr @@ UnivGen.constr_of_global @@
     Coqlib.coq_reference "" ["Arith";"Wf_nat"] "well_founded_ltof"
 
 let ltof_ref = function  () -> (find_reference ["Coq";"Arith";"Wf_nat"] "ltof")
diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli
index 5cc7163a..7e52ee22 100644
--- a/plugins/funind/indfun_common.mli
+++ b/plugins/funind/indfun_common.mli
@@ -20,11 +20,11 @@ val array_get_start : 'a array -> 'a array
 
 val id_of_name : Name.t -> Id.t
 
-val locate_ind : Libnames.reference -> inductive
-val locate_constant : Libnames.reference -> Constant.t
+val locate_ind : Libnames.qualid -> inductive
+val locate_constant : Libnames.qualid -> Constant.t
 val locate_with_msg :
-  Pp.t -> (Libnames.reference -> 'a) ->
-  Libnames.reference -> 'a
+  Pp.t -> (Libnames.qualid -> 'a) ->
+  Libnames.qualid -> 'a
 
 val filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list
 val list_union_eq :
@@ -41,7 +41,7 @@ val chop_rprod_n : int -> Glob_term.glob_constr ->
 val def_of_const : Constr.t -> Constr.t
 val eq : EConstr.constr Lazy.t
 val refl_equal : EConstr.constr Lazy.t
-val const_of_id: Id.t ->  Globnames.global_reference(* constantyes *)
+val const_of_id: Id.t ->  GlobRef.t(* constantyes *)
 val jmeq : unit -> EConstr.constr
 val jmeq_refl : unit -> EConstr.constr
 
@@ -107,11 +107,11 @@ val h_intros: Names.Id.t list -> Tacmach.tactic
 val h_id :  Names.Id.t
 val hrec_id :  Names.Id.t
 val acc_inv_id :  EConstr.constr Util.delayed
-val ltof_ref : Globnames.global_reference Util.delayed
+val ltof_ref : GlobRef.t Util.delayed
 val well_founded_ltof : EConstr.constr Util.delayed
 val acc_rel : EConstr.constr Util.delayed
 val well_founded : EConstr.constr Util.delayed
-val evaluable_of_global_reference : Globnames.global_reference -> Names.evaluable_global_reference
+val evaluable_of_global_reference : GlobRef.t -> Names.evaluable_global_reference
 val list_rewrite : bool -> (EConstr.constr*bool) list -> Tacmach.tactic
 
 val decompose_lam_n : Evd.evar_map -> int -> EConstr.t ->
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index bed95740..ad11f853 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -23,7 +23,7 @@ open Tacticals
 open Tactics
 open Indfun_common
 open Tacmach
-open Misctypes
+open Tactypes
 open Termops
 open Context.Rel.Declaration
 
@@ -67,7 +67,7 @@ let observe_tac s tac g =
 let nf_zeta =
   Reductionops.clos_norm_flags  (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
     Environ.empty_env
-    Evd.empty
+    (Evd.from_env Environ.empty_env)
 
 let thin ids gl = Proofview.V82.of_tactic (Tactics.clear ids) gl
 
@@ -81,7 +81,7 @@ let thin ids gl = Proofview.V82.of_tactic (Tactics.clear ids) gl
 
 let make_eq () =
   try
-    EConstr.of_constr (Universes.constr_of_global (Coqlib.build_coq_eq ()))
+    EConstr.of_constr (UnivGen.constr_of_global (Coqlib.build_coq_eq ()))
   with _ -> assert false 
 
 	  
@@ -102,9 +102,9 @@ let generate_type evd g_to_f f graph i =
   let evd',graph =
     Evd.fresh_global  (Global.env ()) !evd  (Globnames.IndRef (fst (destInd !evd graph)))
   in
-  let graph = EConstr.of_constr graph in
   evd:=evd';
-  let graph_arity = Typing.e_type_of (Global.env ()) evd graph in
+  let sigma, graph_arity = Typing.type_of (Global.env ()) !evd graph in
+  evd := sigma;
   let ctxt,_ = decompose_prod_assum !evd graph_arity in
   let fun_ctxt,res_type =
     match ctxt with
@@ -172,7 +172,6 @@ let find_induction_principle evd f =
     | None -> raise Not_found
     | Some rect_lemma ->
        let evd',rect_lemma = Evd.fresh_global  (Global.env ()) !evd  (Globnames.ConstRef rect_lemma) in
-       let rect_lemma = EConstr.of_constr rect_lemma in
        let evd',typ = Typing.type_of ~refresh:true (Global.env ()) evd' rect_lemma in
        evd:=evd';
        rect_lemma,typ
@@ -240,7 +239,7 @@ let prove_fun_correct evd funs_constr graphs_constr schemes lemmas_types_infos i
       List.map
 	(fun decl ->
 	   List.map
-             (fun id -> CAst.make @@ IntroNaming (IntroIdentifier id))
+             (fun id -> CAst.make @@ IntroNaming (Namegen.IntroIdentifier id))
 	     (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum evd (RelDecl.get_type decl)))))
 	)
 	branches
@@ -258,7 +257,7 @@ let prove_fun_correct evd funs_constr graphs_constr schemes lemmas_types_infos i
       	List.fold_right
           (fun {CAst.v=pat} acc ->
       	     match pat with
-	       | IntroNaming (IntroIdentifier id) -> id::acc
+               | IntroNaming (Namegen.IntroIdentifier id) -> id::acc
       	       | _ -> anomaly (Pp.str "Not an identifier.")
       	  )
       	  (List.nth intro_pats (pred i))
@@ -513,7 +512,7 @@ and intros_with_rewrite_aux : Tacmach.tactic =
 			    intros_with_rewrite
 			  ] g
 			end
-		  | Ind _ when EConstr.eq_constr sigma t (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_False ())) ->
+                  | Ind _ when EConstr.eq_constr sigma t (EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_False ())) ->
 		      Proofview.V82.of_tactic tauto g
 		  | Case(_,_,v,_) ->
 		      tclTHENLIST[
@@ -771,7 +770,8 @@ let derive_correctness make_scheme (funs: pconstant list) (graphs:inductive list
 	 let type_info = (type_of_lemma_ctxt,type_of_lemma_concl) in
 	 graphs_constr.(i) <- graph;
 	 let type_of_lemma = EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt in
-	 let _ = Typing.e_type_of (Global.env ()) evd type_of_lemma in 
+         let sigma, _ = Typing.type_of (Global.env ()) !evd type_of_lemma in
+         evd := sigma;
 	   let type_of_lemma = nf_zeta type_of_lemma in
 	   observe (str "type_of_lemma := " ++ Printer.pr_leconstr_env (Global.env ()) !evd type_of_lemma);
 	   type_of_lemma,type_info
@@ -818,13 +818,12 @@ let derive_correctness make_scheme (funs: pconstant list) (graphs:inductive list
 	 ignore (Pfedit.by
 		   (Proofview.V82.tactic (observe_tac ("prove correctness ("^(Id.to_string f_id)^")")
 						      (proving_tac i))));
-	 (Lemmas.save_proof (Vernacexpr.(Proved(Transparent,None))));
+         (Lemmas.save_proof (Vernacexpr.(Proved(Proof_global.Transparent,None))));
 	 let finfo = find_Function_infos (fst f_as_constant) in
 	 (* let lem_cst = fst (destConst (Constrintern.global_reference lem_id)) in *)
 	 let _,lem_cst_constr = Evd.fresh_global
 				  (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-        let lem_cst_constr = EConstr.of_constr lem_cst_constr in
-	 let (lem_cst,_) = destConst !evd lem_cst_constr in
+         let (lem_cst,_) = destConst !evd lem_cst_constr in
 	 update_Function {finfo with correctness_lemma = Some lem_cst};
 
       )
@@ -880,12 +879,11 @@ let derive_correctness make_scheme (funs: pconstant list) (graphs:inductive list
 	 ignore (Pfedit.by
 	   (Proofview.V82.tactic (observe_tac ("prove completeness ("^(Id.to_string f_id)^")")
 	      (proving_tac i)))) ;
-	 (Lemmas.save_proof (Vernacexpr.(Proved(Transparent,None))));
+         (Lemmas.save_proof (Vernacexpr.(Proved(Proof_global.Transparent,None))));
 	 let finfo = find_Function_infos (fst f_as_constant) in
 	 let _,lem_cst_constr = Evd.fresh_global
 				  (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-         let lem_cst_constr = EConstr.of_constr lem_cst_constr in
-	 let (lem_cst,_) = destConst !evd lem_cst_constr in
+         let (lem_cst,_) = destConst !evd lem_cst_constr in
 	 update_Function {finfo with completeness_lemma = Some lem_cst}
       )
       funs)
@@ -969,7 +967,7 @@ let functional_inversion kn hid fconst f_correct : Tacmach.tactic =
 	    Proofview.V82.of_tactic (generalize [applist(f_correct,(Array.to_list f_args)@[res;mkVar hid])]);
 	    thin [hid];
 	    Proofview.V82.of_tactic (Simple.intro hid);
-	    Proofview.V82.of_tactic (Inv.inv FullInversion None (NamedHyp hid));
+            Proofview.V82.of_tactic (Inv.inv Inv.FullInversion None (NamedHyp hid));
 	    (fun g ->
 	       let new_ids = List.filter (fun id -> not (Id.Set.mem id old_ids)) (pf_ids_of_hyps g) in
 	       tclMAP (revert_graph kn pre_tac)  (hid::new_ids)  g
diff --git a/plugins/funind/invfun.mli b/plugins/funind/invfun.mli
index ad306ab2..3ddc6092 100644
--- a/plugins/funind/invfun.mli
+++ b/plugins/funind/invfun.mli
@@ -9,8 +9,8 @@
 (************************************************************************)
 
 val invfun :
-  Misctypes.quantified_hypothesis ->
-  Globnames.global_reference option ->
+  Tactypes.quantified_hypothesis ->
+  Names.GlobRef.t option ->
   Evar.t Evd.sigma -> Evar.t list Evd.sigma
 val derive_correctness :
   (Evd.evar_map ref ->
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index fb9ae64b..e9e8fcb6 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -37,7 +37,7 @@ open Glob_term
 open Pretyping
 open Termops
 open Constrintern
-open Misctypes
+open Tactypes
 open Genredexpr
 
 open Equality
@@ -49,7 +49,7 @@ open Context.Rel.Declaration
 
 (* Ugly things which should not be here *)
 
-let coq_constant m s = EConstr.of_constr @@ Universes.constr_of_global @@
+let coq_constant m s = EConstr.of_constr @@ UnivGen.constr_of_global @@
   Coqlib.coq_reference "RecursiveDefinition" m s
 
 let arith_Nat = ["Arith";"PeanoNat";"Nat"]
@@ -61,7 +61,7 @@ let pr_leconstr_rd =
 
 let coq_init_constant s =
   EConstr.of_constr (
-    Universes.constr_of_global @@
+    UnivGen.constr_of_global @@
     Coqlib.gen_reference_in_modules "RecursiveDefinition" Coqlib.init_modules s)
 
 let find_reference sl s =
@@ -72,7 +72,7 @@ let declare_fun f_id kind ?univs value =
   let ce = definition_entry ?univs value (*FIXME *) in
     ConstRef(declare_constant f_id (DefinitionEntry ce, kind));;
 
-let defined () = Lemmas.save_proof (Vernacexpr.(Proved (Transparent,None)))
+let defined () = Lemmas.save_proof (Vernacexpr.(Proved (Proof_global.Transparent,None)))
 
 let def_of_const t =
    match (Constr.kind t) with
@@ -106,12 +106,12 @@ let const_of_ref = function
 
 let nf_zeta env =
   Reductionops.clos_norm_flags  (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
-    env
-    Evd.empty
+    env (Evd.from_env env)
 
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
-  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
+  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env
+    (Evd.from_env Environ.empty_env)
 
 
 
@@ -181,7 +181,7 @@ let simpl_iter clause =
     clause
 
 (* Others ugly things ... *)
-let (value_f: Constr.t list -> global_reference -> Constr.t) =
+let (value_f: Constr.t list -> GlobRef.t -> Constr.t) =
   let open Term in
   let open Constr in
   fun al fterm ->
@@ -215,7 +215,7 @@ let (value_f: Constr.t list -> global_reference -> Constr.t) =
     let body = EConstr.Unsafe.to_constr body in
     it_mkLambda_or_LetIn body context
 
-let (declare_f : Id.t -> logical_kind -> Constr.t list -> global_reference -> global_reference) =
+let (declare_f : Id.t -> logical_kind -> Constr.t list -> GlobRef.t -> GlobRef.t) =
   fun f_id kind input_type fterm_ref ->
     declare_fun f_id kind (value_f input_type fterm_ref);;
 
@@ -356,7 +356,7 @@ type 'a infos =
       f_id : Id.t;  (* function name *)
       f_constr : constr;  (* function term *)
       f_terminate : constr; (* termination proof term *)
-      func : global_reference; (* functional reference *)
+      func : GlobRef.t; (* functional reference *)
       info : 'a;
       is_main_branch : bool; (* on the main branch or on a matched expression *)
       is_final : bool; (* final first order term or not *)
@@ -713,7 +713,7 @@ let mkDestructEq :
     observe_tclTHENLIST (str "mkDestructEq")
      [Proofview.V82.of_tactic (generalize new_hyps);
       (fun g2 ->
-        let changefun patvars sigma =
+        let changefun patvars env sigma =
           pattern_occs [Locus.AllOccurrencesBut [1], expr] (pf_env g2) sigma (pf_concl g2)
         in
 	Proofview.V82.of_tactic (change_in_concl None changefun) g2);
@@ -1152,7 +1152,7 @@ let termination_proof_header is_mes input_type ids args_id relation
 			tclTHEN (Proofview.V82.of_tactic (Tactics.generalize [mkVar id])) (Proofview.V82.of_tactic (clear [id])))
 		     ))
 	       ;
-		observe_tac (str "fix") (Proofview.V82.of_tactic (fix (Some hrec) (nargs+1)));
+                observe_tac (str "fix") (Proofview.V82.of_tactic (fix hrec (nargs+1)));
 		h_intros args_id;
 		Proofview.V82.of_tactic (Simple.intro wf_rec_arg);
 		observe_tac (str "tac") (tac wf_rec_arg hrec wf_rec_arg acc_inv)
@@ -1241,7 +1241,7 @@ let get_current_subgoals_types () =
 
 exception EmptySubgoals
 let build_and_l sigma l =
-  let and_constr =  Universes.constr_of_global @@ Coqlib.build_coq_and () in
+  let and_constr =  UnivGen.constr_of_global @@ Coqlib.build_coq_and () in
   let conj_constr = coq_conj () in
   let mk_and p1 p2 =
     mkApp(EConstr.of_constr and_constr,[|p1;p2|]) in
@@ -1306,9 +1306,9 @@ let build_new_goal_type () =
 let is_opaque_constant c =
   let cb = Global.lookup_constant c in
   match cb.Declarations.const_body with
-    | Declarations.OpaqueDef _ -> Vernacexpr.Opaque
-    | Declarations.Undef _ -> Vernacexpr.Opaque
-    | Declarations.Def _ -> Vernacexpr.Transparent
+    | Declarations.OpaqueDef _ -> Proof_global.Opaque
+    | Declarations.Undef _ -> Proof_global.Opaque
+    | Declarations.Def _ -> Proof_global.Transparent
 
 let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decompose_and_tac,nb_goal)   =
   (* Pp.msgnl (str "gls_type := " ++ Printer.pr_lconstr gls_type); *)
@@ -1318,14 +1318,14 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
     | None   ->
 	try add_suffix current_proof_name "_subproof"
 	with e when CErrors.noncritical e ->
-          anomaly (Pp.str "open_new_goal with an unamed theorem.")
+          anomaly (Pp.str "open_new_goal with an unnamed theorem.")
   in
   let na = next_global_ident_away name Id.Set.empty in
   if Termops.occur_existential sigma gls_type then
     CErrors.user_err Pp.(str "\"abstract\" cannot handle existentials");
   let hook _ _ =
     let opacity =
-      let na_ref = CAst.make @@ Libnames.Ident na in
+      let na_ref = qualid_of_ident na in
       let na_global = Smartlocate.global_with_alias na_ref in
       match na_global with
 	  ConstRef c -> is_opaque_constant c
@@ -1456,7 +1456,7 @@ let com_terminate
 
 
 
-let start_equation (f:global_reference) (term_f:global_reference)
+let start_equation (f:GlobRef.t) (term_f:GlobRef.t)
   (cont_tactic:Id.t list -> tactic) g =
   let sigma = project g in
   let ids = pf_ids_of_hyps g in
@@ -1473,7 +1473,7 @@ let start_equation (f:global_reference) (term_f:global_reference)
     observe_tac (str "prove_eq") (cont_tactic x)]) g;;
 
 let (com_eqn : int -> Id.t ->
-       global_reference -> global_reference -> global_reference
+       GlobRef.t -> GlobRef.t -> GlobRef.t
 	 -> Constr.t -> unit) =
   fun nb_arg eq_name functional_ref f_ref terminate_ref equation_lemma_type ->
     let open CVars in
@@ -1533,14 +1533,12 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
   let env = Global.env() in
   let evd = Evd.from_env env in
   let evd, function_type = interp_type_evars env evd type_of_f in
-  let function_type = EConstr.Unsafe.to_constr function_type in
-  let env = push_named (Context.Named.Declaration.LocalAssum (function_name,function_type)) env in
+  let env = EConstr.push_named (Context.Named.Declaration.LocalAssum (function_name,function_type)) env in
   (* Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type);  *)
   let evd, ty = interp_type_evars env evd ~impls:rec_impls eq in
-  let ty = EConstr.Unsafe.to_constr ty in
-  let evd, nf = Evarutil.nf_evars_and_universes evd in
-  let equation_lemma_type = nf_betaiotazeta (EConstr.of_constr (nf ty)) in
-  let function_type = nf function_type in
+  let evd = Evd.minimize_universes evd in
+  let equation_lemma_type = nf_betaiotazeta (Evarutil.nf_evar evd ty) in
+  let function_type = EConstr.to_constr ~abort_on_undefined_evars:false evd function_type in
   let equation_lemma_type = EConstr.Unsafe.to_constr equation_lemma_type in
  (* Pp.msgnl (str "lemma type := " ++ Printer.pr_lconstr equation_lemma_type ++ fnl ()); *)
   let res_vars,eq' = decompose_prod equation_lemma_type in
@@ -1579,7 +1577,7 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
   let hook _ _ = 
     let term_ref = Nametab.locate (qualid_of_ident term_id) in
     let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in
-    let _ = Extraction_plugin.Table.extraction_inline true [CAst.make @@ Ident term_id] in
+    let _ = Extraction_plugin.Table.extraction_inline true [qualid_of_ident term_id] in
     (*     message "start second proof"; *)
     let stop = 
       try com_eqn (List.length res_vars) equation_id functional_ref f_ref term_ref (subst_var function_name equation_lemma_type);
diff --git a/plugins/funind/recdef.mli b/plugins/funind/recdef.mli
index b95d64ce..549f1fc0 100644
--- a/plugins/funind/recdef.mli
+++ b/plugins/funind/recdef.mli
@@ -14,6 +14,6 @@ bool ->
            int -> Constrexpr.constr_expr -> (pconstant ->
             Indfun_common.tcc_lemma_value ref ->
             pconstant ->
-            pconstant -> int -> EConstr.types -> int -> EConstr.constr -> 'a) -> Constrexpr.constr_expr list -> unit
+            pconstant -> int -> EConstr.types -> int -> EConstr.constr -> unit) -> Constrexpr.constr_expr list -> unit
 
 
diff --git a/plugins/ltac/coretactics.ml4 b/plugins/ltac/coretactics.mlg
index 931633e1..6388906f 100644
--- a/plugins/ltac/coretactics.ml4
+++ b/plugins/ltac/coretactics.mlg
@@ -8,155 +8,165 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Util
 open Locus
-open Misctypes
+open Tactypes
 open Genredexpr
 open Stdarg
 open Extraargs
+open Tacarg
 open Names
+open Logic
+
+let wit_hyp = wit_var
+
+}
 
 DECLARE PLUGIN "ltac_plugin"
 
 (** Basic tactics *)
 
 TACTIC EXTEND reflexivity
-  [ "reflexivity" ] -> [ Tactics.intros_reflexivity ]
+| [ "reflexivity" ] -> { Tactics.intros_reflexivity }
 END
 
 TACTIC EXTEND exact
-  [ "exact" casted_constr(c) ] -> [ Tactics.exact_no_check c ]
+| [ "exact" casted_constr(c) ] -> { Tactics.exact_no_check c }
 END
 
 TACTIC EXTEND assumption
-  [ "assumption" ] -> [ Tactics.assumption ]
+| [ "assumption" ] -> { Tactics.assumption }
 END
 
 TACTIC EXTEND etransitivity
-  [ "etransitivity" ] -> [ Tactics.intros_transitivity None ]
+| [ "etransitivity" ] -> { Tactics.intros_transitivity None }
 END
 
 TACTIC EXTEND cut
-  [ "cut" constr(c) ] -> [ Tactics.cut c ]
+| [ "cut" constr(c) ] -> { Tactics.cut c }
 END
 
 TACTIC EXTEND exact_no_check
-  [ "exact_no_check" constr(c) ] -> [ Tactics.exact_no_check c ]
+| [ "exact_no_check" constr(c) ] -> { Tactics.exact_no_check c }
 END
 
 TACTIC EXTEND vm_cast_no_check
-  [ "vm_cast_no_check" constr(c) ] -> [ Tactics.vm_cast_no_check c ]
+| [ "vm_cast_no_check" constr(c) ] -> { Tactics.vm_cast_no_check c }
 END
 
 TACTIC EXTEND native_cast_no_check
-  [ "native_cast_no_check" constr(c) ] -> [ Tactics.native_cast_no_check c ]
+| [ "native_cast_no_check" constr(c) ] -> { Tactics.native_cast_no_check c }
 END
 
 TACTIC EXTEND casetype
-  [ "casetype" constr(c) ] -> [ Tactics.case_type c ]
+| [ "casetype" constr(c) ] -> { Tactics.case_type c }
 END
 
 TACTIC EXTEND elimtype
-  [ "elimtype" constr(c) ] -> [ Tactics.elim_type c ]
+| [ "elimtype" constr(c) ] -> { Tactics.elim_type c }
 END
 
 TACTIC EXTEND lapply
-  [ "lapply" constr(c) ] -> [ Tactics.cut_and_apply c ]
+| [ "lapply" constr(c) ] -> { Tactics.cut_and_apply c }
 END
 
 TACTIC EXTEND transitivity
-  [ "transitivity" constr(c) ] -> [ Tactics.intros_transitivity (Some c) ]
+| [ "transitivity" constr(c) ] -> { Tactics.intros_transitivity (Some c) }
 END
 
 (** Left *)
 
 TACTIC EXTEND left
-  [ "left" ] -> [ Tactics.left_with_bindings false NoBindings ]
+| [ "left" ] -> { Tactics.left_with_bindings false NoBindings }
 END
 
 TACTIC EXTEND eleft
-  [ "eleft" ] -> [ Tactics.left_with_bindings true NoBindings ]
+| [ "eleft" ] -> { Tactics.left_with_bindings true NoBindings }
 END
 
 TACTIC EXTEND left_with
-  [ "left" "with" bindings(bl) ] -> [
+| [ "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) ] -> [
+| [ "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 ]
+| [ "right" ] -> { Tactics.right_with_bindings false NoBindings }
 END
 
 TACTIC EXTEND eright
-  [ "eright" ] -> [ Tactics.right_with_bindings true NoBindings ]
+| [ "eright" ] -> { Tactics.right_with_bindings true NoBindings }
 END
 
 TACTIC EXTEND right_with
-  [ "right" "with" bindings(bl) ] -> [
+| [ "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) ] -> [
+| [ "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) ] -> [
+| [ "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) ] -> [
+  }
+| [ "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) ] -> [
+| [ "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) ] -> [
+  }
+| [ "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) ] -> [
+| [ "specialize" constr_with_bindings(c) ] -> {
     Tacticals.New.tclDELAYEDWITHHOLES false c (fun c -> Tactics.specialize c None)
-  ]
-| [ "specialize" constr_with_bindings(c) "as" intropattern(ipat) ] -> [
+  }
+| [ "specialize" constr_with_bindings(c) "as" intropattern(ipat) ] -> {
     Tacticals.New.tclDELAYEDWITHHOLES false c (fun c -> Tactics.specialize c (Some ipat))
-  ]
+  }
 END
 
 TACTIC EXTEND symmetry
-  [ "symmetry" ] -> [ Tactics.intros_symmetry {onhyps=Some[];concl_occs=AllOccurrences} ]
+| [ "symmetry" ] -> { Tactics.intros_symmetry {onhyps=Some[];concl_occs=AllOccurrences} }
 END
 
 TACTIC EXTEND symmetry_in
-| [ "symmetry" "in" in_clause(cl) ] -> [ Tactics.intros_symmetry cl ]
+| [ "symmetry" "in" in_clause(cl) ] -> { Tactics.intros_symmetry cl }
 END
 
 (** Split *)
 
+{
+
 let rec delayed_list = function
 | [] -> fun _ sigma -> (sigma, [])
 | x :: l ->
@@ -165,149 +175,159 @@ let rec delayed_list = function
     let (sigma, l) = delayed_list l env sigma in
     (sigma, x :: l)
 
+}
+
 TACTIC EXTEND split
-  [ "split" ] -> [ Tactics.split_with_bindings false [NoBindings] ]
+| [ "split" ] -> { Tactics.split_with_bindings false [NoBindings] }
 END
 
 TACTIC EXTEND esplit
-  [ "esplit" ] -> [ Tactics.split_with_bindings true [NoBindings] ]
+| [ "esplit" ] -> { Tactics.split_with_bindings true [NoBindings] }
 END
 
 TACTIC EXTEND split_with
-  [ "split" "with" bindings(bl) ] -> [
+| [ "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) ] -> [
+| [ "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, ",") ] -> [
+| [ "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, ",") ] -> [
+| [ "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 ]
+| [ "intros" "until" quantified_hypothesis(h) ] -> { Tactics.intros_until h }
 END
 
 TACTIC EXTEND intro
-| [ "intro" ] -> [ Tactics.intro_move None MoveLast ]
-| [ "intro" ident(id) ] -> [ Tactics.intro_move (Some id) MoveLast ]
-| [ "intro" ident(id) "at" "top" ] -> [ Tactics.intro_move (Some id) MoveFirst ]
-| [ "intro" ident(id) "at" "bottom" ] -> [ Tactics.intro_move (Some id) MoveLast ]
-| [ "intro" ident(id) "after" hyp(h) ] -> [ Tactics.intro_move (Some id) (MoveAfter h) ]
-| [ "intro" ident(id) "before" hyp(h) ] -> [ Tactics.intro_move (Some id) (MoveBefore h) ]
-| [ "intro" "at" "top" ] -> [ Tactics.intro_move None MoveFirst ]
-| [ "intro" "at" "bottom" ] -> [ Tactics.intro_move None MoveLast ]
-| [ "intro" "after" hyp(h) ] -> [ Tactics.intro_move None (MoveAfter h) ]
-| [ "intro" "before" hyp(h) ] -> [ Tactics.intro_move None (MoveBefore h) ]
+| [ "intro" ] -> { Tactics.intro_move None MoveLast }
+| [ "intro" ident(id) ] -> { Tactics.intro_move (Some id) MoveLast }
+| [ "intro" ident(id) "at" "top" ] -> { Tactics.intro_move (Some id) MoveFirst }
+| [ "intro" ident(id) "at" "bottom" ] -> { Tactics.intro_move (Some id) MoveLast }
+| [ "intro" ident(id) "after" hyp(h) ] -> { Tactics.intro_move (Some id) (MoveAfter h) }
+| [ "intro" ident(id) "before" hyp(h) ] -> { Tactics.intro_move (Some id) (MoveBefore h) }
+| [ "intro" "at" "top" ] -> { Tactics.intro_move None MoveFirst }
+| [ "intro" "at" "bottom" ] -> { Tactics.intro_move None MoveLast }
+| [ "intro" "after" hyp(h) ] -> { Tactics.intro_move None (MoveAfter h) }
+| [ "intro" "before" hyp(h) ] -> { Tactics.intro_move None (MoveBefore h) }
 END
 
 (** Move *)
 
 TACTIC EXTEND move
-  [ "move" hyp(id) "at" "top" ] -> [ Tactics.move_hyp id MoveFirst ]
-| [ "move" hyp(id) "at" "bottom" ] -> [ Tactics.move_hyp id MoveLast ]
-| [ "move" hyp(id) "after" hyp(h) ] -> [ Tactics.move_hyp id (MoveAfter h) ]
-| [ "move" hyp(id) "before" hyp(h) ] -> [ Tactics.move_hyp id (MoveBefore h) ]
+| [ "move" hyp(id) "at" "top" ] -> { Tactics.move_hyp id MoveFirst }
+| [ "move" hyp(id) "at" "bottom" ] -> { Tactics.move_hyp id MoveLast }
+| [ "move" hyp(id) "after" hyp(h) ] -> { Tactics.move_hyp id (MoveAfter h) }
+| [ "move" hyp(id) "before" hyp(h) ] -> { Tactics.move_hyp id (MoveBefore h) }
 END
 
 (** Rename *)
 
 TACTIC EXTEND rename
-| [ "rename" ne_rename_list_sep(ids, ",") ] -> [ Tactics.rename_hyp ids ]
+| [ "rename" ne_rename_list_sep(ids, ",") ] -> { Tactics.rename_hyp ids }
 END
 
 (** Revert *)
 
 TACTIC EXTEND revert
-  [ "revert" ne_hyp_list(hl) ] -> [ Tactics.revert hl ]
+| [ "revert" ne_hyp_list(hl) ] -> { Tactics.revert hl }
 END
 
 (** Simple induction / destruct *)
 
+{
+
 let simple_induct h =
   Tacticals.New.tclTHEN (Tactics.intros_until h)
     (Tacticals.New.onLastHyp Tactics.simplest_elim)
 
+}
+
 TACTIC EXTEND simple_induction
-  [ "simple" "induction" quantified_hypothesis(h) ] -> [ simple_induct h ]
+| [ "simple" "induction" quantified_hypothesis(h) ] -> { simple_induct h }
 END
 
+{
+
 let simple_destruct h =
   Tacticals.New.tclTHEN (Tactics.intros_until h)
     (Tacticals.New.onLastHyp Tactics.simplest_case)
 
+}
+
 TACTIC EXTEND simple_destruct
-  [ "simple" "destruct" quantified_hypothesis(h) ] -> [ simple_destruct h ]
+| [ "simple" "destruct" quantified_hypothesis(h) ] -> { simple_destruct h }
 END
 
 (** Double induction *)
 
 TACTIC EXTEND double_induction
-  [ "double" "induction" quantified_hypothesis(h1) quantified_hypothesis(h2) ] ->
-  [ Elim.h_double_induction h1 h2 ]
+| [ "double" "induction" quantified_hypothesis(h1) quantified_hypothesis(h2) ] ->
+  { Elim.h_double_induction h1 h2 }
 END
 
 (* Admit *)
 
 TACTIC EXTEND admit
- [ "admit" ] -> [ Proofview.give_up ]
+|[ "admit" ] -> { Proofview.give_up }
 END
 
 (* Fix *)
 
 TACTIC EXTEND fix
-  [ "fix" natural(n) ] -> [ Tactics.fix None n ]
-| [ "fix" ident(id) natural(n) ] -> [ Tactics.fix (Some id) n ]
+| [ "fix" ident(id) natural(n) ] -> { Tactics.fix id n }
 END
 
 (* Cofix *)
 
 TACTIC EXTEND cofix
-  [ "cofix" ] -> [ Tactics.cofix None ]
-| [ "cofix" ident(id) ] -> [ Tactics.cofix (Some id) ]
+| [ "cofix" ident(id) ] -> { Tactics.cofix id }
 END
 
 (* Clear *)
 
 TACTIC EXTEND clear
-  [ "clear" hyp_list(ids) ] -> [
+| [ "clear" hyp_list(ids) ] -> {
     if List.is_empty ids then Tactics.keep []
     else Tactics.clear ids
-  ]
-| [ "clear" "-" ne_hyp_list(ids) ] -> [ Tactics.keep ids ]
+  }
+| [ "clear" "-" ne_hyp_list(ids) ] -> { Tactics.keep ids }
 END
 
 (* Clearbody *)
 
 TACTIC EXTEND clearbody
-  [ "clearbody" ne_hyp_list(ids) ] -> [ Tactics.clear_body ids ]
+| [ "clearbody" ne_hyp_list(ids) ] -> { Tactics.clear_body ids }
 END
 
 (* Generalize dependent *)
 
 TACTIC EXTEND generalize_dependent
-  [ "generalize" "dependent" constr(c) ] -> [ Tactics.generalize_dep c ]
+| [ "generalize" "dependent" constr(c) ] -> { Tactics.generalize_dep c }
 END
 
 (* Table of "pervasives" macros tactics (e.g. auto, simpl, etc.) *)
 
+{
+
 open Tacexpr
 
 let initial_atomic () =
@@ -364,3 +384,5 @@ let initial_tacticals () =
   ]
 
 let () = Mltop.declare_cache_obj initial_tacticals "ltac_plugin"
+
+}
diff --git a/plugins/ltac/evar_tactics.ml b/plugins/ltac/evar_tactics.ml
index 9382f567..84f13d21 100644
--- a/plugins/ltac/evar_tactics.ml
+++ b/plugins/ltac/evar_tactics.ml
@@ -10,7 +10,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open CErrors
 open Evar_refiner
 open Tacmach
@@ -52,7 +52,7 @@ let instantiate_tac n c ido =
     match ido with
 	ConclLocation () -> evar_list sigma (pf_concl gl)
       | HypLocation (id,hloc) ->
-	  let decl = Environ.lookup_named_val id (Goal.V82.hyps sigma (sig_it gl)) in
+          let decl = Environ.lookup_named id (pf_env gl) in
 	    match hloc with
 		InHyp ->
 		  (match decl with
@@ -85,16 +85,14 @@ let let_evar name typ =
   Proofview.Goal.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 in
+    let sigma, _ = Typing.sort_of env sigma typ in
     let id = match name with
     | Name.Anonymous ->
       let id = Namegen.id_of_name_using_hdchar env sigma typ name in
       Namegen.next_ident_away_in_goal id (Termops.vars_of_env env)
     | Name.Name id -> id
     in
-    let (sigma, evar) = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
+    let (sigma, evar) = Evarutil.new_evar env sigma ~src ~naming:(Namegen.IntroFresh id) typ in
     Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
     (Tactics.letin_tac None (Name.Name id) evar None Locusops.nowhere)
   end
diff --git a/plugins/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4
index 702b8303..d7799511 100644
--- a/plugins/ltac/extraargs.ml4
+++ b/plugins/ltac/extraargs.ml4
@@ -19,7 +19,6 @@ open Tacmach
 open Tacexpr
 open Taccoerce
 open Tacinterp
-open Misctypes
 open Locus
 
 (** Adding scopes for generic arguments not defined through ARGUMENT EXTEND *)
@@ -35,7 +34,7 @@ let () = create_generic_quotation "ident" Pcoq.Prim.ident Stdarg.wit_ident
 let () = create_generic_quotation "reference" Pcoq.Prim.reference Stdarg.wit_ref
 let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Stdarg.wit_uconstr
 let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Stdarg.wit_constr
-let () = create_generic_quotation "ipattern" Pltac.simple_intropattern Stdarg.wit_intro_pattern
+let () = create_generic_quotation "ipattern" Pltac.simple_intropattern wit_intro_pattern
 let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Stdarg.wit_open_constr
 let () =
   let inject (loc, v) = Tacexpr.Tacexp v in
@@ -53,8 +52,11 @@ let () =
 
 (* Rewriting orientation *)
 
-let _ = Metasyntax.add_token_obj "<-"
-let _ = Metasyntax.add_token_obj "->"
+let _ =
+  Mltop.declare_cache_obj
+    (fun () -> Metasyntax.add_token_obj "<-";
+               Metasyntax.add_token_obj "->")
+    "ltac_plugin"
 
 let pr_orient _prc _prlc _prt = function
   | true -> Pp.mt ()
@@ -251,7 +253,7 @@ END
 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,Notation_term.E) t)
+    | Some t -> hov 2 (str "by" ++ spc () ++ prtac (3,Notation_gram.E) t)
 
 ARGUMENT EXTEND by_arg_tac
   TYPED AS tactic_opt
@@ -298,25 +300,6 @@ END
 
 (* 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
@@ -354,26 +337,6 @@ let pr_retroknowledge_field f =
   | Retroknowledge.KInt31 (group, i31f) -> (pr_r_int31_field i31f) ++
                                            spc () ++ str "in " ++ qs 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 ]
diff --git a/plugins/ltac/extraargs.mli b/plugins/ltac/extraargs.mli
index e5a4f090..e477b12c 100644
--- a/plugins/ltac/extraargs.mli
+++ b/plugins/ltac/extraargs.mli
@@ -12,17 +12,16 @@ 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 orient : bool Pcoq.Entry.t
 val pr_orient : bool -> Pp.t
 
 val wit_rename : (Id.t * Id.t) Genarg.uniform_genarg_type
 
-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.t
+val occurrences : (int list Locus.or_var) Pcoq.Entry.t
+val wit_occurrences : (int list Locus.or_var, int list Locus.or_var, int list) Genarg.genarg_type
+val pr_occurrences : int list Locus.or_var -> Pp.t
 val occurrences_of : int list -> Locus.occurrences
 
 val wit_natural : int Genarg.uniform_genarg_type
@@ -47,8 +46,8 @@ val wit_casted_constr :
   Tacexpr.glob_constr_and_expr,
   EConstr.t) Genarg.genarg_type
 
-val glob : constr_expr Pcoq.Gram.entry
-val lglob : constr_expr Pcoq.Gram.entry
+val glob : constr_expr Pcoq.Entry.t
+val lglob : constr_expr Pcoq.Entry.t
 
 type 'id gen_place= ('id * Locus.hyp_location_flag,unit) location
 
@@ -56,26 +55,26 @@ type loc_place = lident 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 hloc : loc_place Pcoq.Entry.t
 val pr_hloc : loc_place -> Pp.t
 
-val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.entry
+val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Entry.t
 val wit_by_arg_tac :
   (raw_tactic_expr option,
   glob_tactic_expr option,
   Geninterp.Val.t option) Genarg.genarg_type
 
 val pr_by_arg_tac : 
-  (int * Notation_term.parenRelation -> raw_tactic_expr -> Pp.t) ->
+  (int * Notation_gram.parenRelation -> raw_tactic_expr -> Pp.t) ->
   raw_tactic_expr option -> Pp.t
 
-val test_lpar_id_colon : unit Pcoq.Gram.entry
+val test_lpar_id_colon : unit Pcoq.Entry.t
 
 val wit_test_lpar_id_colon : (unit, unit, unit) Genarg.genarg_type
 
 (** Spiwack: Primitive for retroknowledge registration *)
 
-val retroknowledge_field : Retroknowledge.field Pcoq.Gram.entry
+val retroknowledge_field : Retroknowledge.field Pcoq.Entry.t
 val wit_retroknowledge_field : (Retroknowledge.field, unit, unit) Genarg.genarg_type
 
 val wit_in_clause :
diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4
index 2e90ce90..31695fc7 100644
--- a/plugins/ltac/extratactics.ml4
+++ b/plugins/ltac/extratactics.ml4
@@ -9,6 +9,7 @@
 (************************************************************************)
 
 open Pp
+open Constr
 open Genarg
 open Stdarg
 open Tacarg
@@ -23,7 +24,9 @@ open CErrors
 open Util
 open Termops
 open Equality
-open Misctypes
+open Namegen
+open Tactypes
+open Tactics
 open Proofview.Notations
 open Vernacinterp
 
@@ -284,80 +287,6 @@ VERNAC COMMAND FUNCTIONAL EXTEND HintRewrite CLASSIFIED BY classify_hint
 END
 
 (**********************************************************************)
-(* Hint Resolve                                                       *)
-
-open Term
-open EConstr
-open Vars
-open Coqlib
-
-let project_hint ~poly 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 c = EConstr.of_constr c 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 sigma t in
-  let (a,b) = match snd (decompose_app sigma 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 sigma, p = Evd.fresh_global env sigma p in
-  let p = EConstr.of_constr p in
-  let c = Reductionops.whd_beta sigma (mkApp (c, Context.Rel.to_extended_vect mkRel 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.const_univ_entry ~poly sigma in
-  let c = EConstr.to_constr sigma c in
-  let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
-  let info = {Vernacexpr.hint_priority = pri; hint_pattern = None} in
-    (info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
-
-let add_hints_iff ~atts l2r lc n bl =
-  let open Vernacinterp in
-  Hints.add_hints (Locality.make_module_locality atts.locality) bl
-    (Hints.HintsResolveEntry (List.map (project_hint ~poly:atts.polymorphic n l2r) lc))
-
-VERNAC COMMAND FUNCTIONAL EXTEND HintResolveIffLR CLASSIFIED AS SIDEFF
-  [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n)
-    ":" preident_list(bl) ] ->
-  [ fun ~atts ~st -> begin
-        add_hints_iff ~atts true lc n bl;
-        st
-      end
-  ]
-| [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n) ] ->
-  [ fun ~atts ~st -> begin
-        add_hints_iff ~atts true lc n ["core"];
-        st
-      end
-  ]
-END
-
-VERNAC COMMAND FUNCTIONAL EXTEND HintResolveIffRL CLASSIFIED AS SIDEFF
-  [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n)
-    ":" preident_list(bl) ] ->
-  [ fun ~atts ~st -> begin
-        add_hints_iff ~atts false lc n bl;
-        st
-      end
-  ]
-| [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n) ] ->
-  [ fun ~atts ~st -> begin
-        add_hints_iff ~atts false lc n ["core"];
-        st
-      end
-  ]
-END
-
-(**********************************************************************)
 (* Refine                                                             *)
 
 open EConstr
@@ -365,7 +294,7 @@ open Vars
 
 let constr_flags () = {
   Pretyping.use_typeclasses = true;
-  Pretyping.solve_unification_constraints = true;
+  Pretyping.solve_unification_constraints = Pfedit.use_unification_heuristics ();
   Pretyping.use_hook = Pfedit.solve_by_implicit_tactic ();
   Pretyping.fail_evar = false;
   Pretyping.expand_evars = true }
@@ -596,10 +525,16 @@ let inImplicitTactic : glob_tactic_expr option -> obj =
        subst_function = subst_implicit_tactic;
        classify_function = (fun o -> Dispose)}
 
+let warn_deprecated_implicit_tactic =
+  CWarnings.create ~name:"deprecated-implicit-tactic" ~category:"deprecated"
+    (fun () -> strbrk "Implicit tactics are deprecated")
+
 let declare_implicit_tactic tac =
+  let () = warn_deprecated_implicit_tactic () in
   Lib.add_anonymous_leaf (inImplicitTactic (Some (Tacintern.glob_tactic tac)))
 
 let clear_implicit_tactic () =
+  let () = warn_deprecated_implicit_tactic () in
   Lib.add_anonymous_leaf (inImplicitTactic None)
 
 VERNAC COMMAND EXTEND ImplicitTactic CLASSIFIED AS SIDEFF
@@ -615,10 +550,12 @@ END
 
 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
-             let tc = EConstr.to_constr Evd.empty tc in
-             let tb = EConstr.to_constr Evd.empty tb in
+           [ let env = Global.env () in
+             let evd = Evd.from_env env in
+             let tc,_ctx = Constrintern.interp_constr env evd c in
+             let tb,_ctx(*FIXME*) = Constrintern.interp_constr env evd b in
+             let tc = EConstr.to_constr evd tc in
+             let tb = EConstr.to_constr evd tb in
              Global.register f tc tb ]
 END
 
@@ -668,8 +605,11 @@ let subst_var_with_hole occ tid t =
            else
 	     (incr locref;
               DAst.make ~loc:(Loc.make_loc (!locref,0)) @@
-	      GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),
-                     Misctypes.IntroAnonymous, None)))
+              GHole (Evar_kinds.QuestionMark {
+                  Evar_kinds.qm_obligation=Evar_kinds.Define true;
+                  Evar_kinds.qm_name=Anonymous;
+                  Evar_kinds.qm_record_field=None;
+              }, IntroAnonymous, None)))
         else x
     | _ -> map_glob_constr_left_to_right substrec x in
   let t' = substrec t
@@ -680,13 +620,21 @@ let subst_hole_with_term occ tc t =
   let locref = ref 0 in
   let occref = ref occ in
   let rec substrec c = match DAst.get c with
-    | GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s) ->
+    | GHole (Evar_kinds.QuestionMark {
+                Evar_kinds.qm_obligation=Evar_kinds.Define true;
+                Evar_kinds.qm_name=Anonymous;
+                Evar_kinds.qm_record_field=None;
+            }, IntroAnonymous, s) ->
         decr occref;
         if Int.equal !occref 0 then tc
         else
 	  (incr locref;
            DAst.make ~loc:(Loc.make_loc (!locref,0)) @@
-	   GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s))
+           GHole (Evar_kinds.QuestionMark {
+               Evar_kinds.qm_obligation=Evar_kinds.Define true;
+               Evar_kinds.qm_name=Anonymous;
+               Evar_kinds.qm_record_field=None;
+           },IntroAnonymous,s))
     | _ -> map_glob_constr_left_to_right substrec c
   in
   substrec t
@@ -781,7 +729,7 @@ let  mkCaseEq a  : unit Proofview.tactic =
             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 (_, c) = Tacred.pattern_occs [Locus.OnlyOccurrences [1], a] env Evd.empty concl in
+            let (_, c) = Tacred.pattern_occs [Locus.OnlyOccurrences [1], a] env (Evd.from_env env) concl in
 	    change_concl c
           end;
 	  simplest_case a]
@@ -857,17 +805,12 @@ END
 
 (* ********************************************************************* *)
 
-let eq_constr x y = 
-  Proofview.Goal.enter begin fun gl ->
-    let env = Tacmach.New.pf_env gl in
-    let evd = Tacmach.New.project gl in
-      match EConstr.eq_constr_universes env evd x y with
-      | Some _ -> Proofview.tclUNIT () 
-      | None -> Tacticals.New.tclFAIL 0 (str "Not equal")
-  end
-
 TACTIC EXTEND constr_eq
-| [ "constr_eq" constr(x) constr(y) ] -> [ eq_constr x y ]
+| [ "constr_eq" constr(x) constr(y) ] -> [ Tactics.constr_eq ~strict:false x y ]
+END
+
+TACTIC EXTEND constr_eq_strict
+| [ "constr_eq_strict" constr(x) constr(y) ] -> [ Tactics.constr_eq ~strict:true x y ]
 END
 
 TACTIC EXTEND constr_eq_nounivs
@@ -1108,7 +1051,9 @@ END
 VERNAC COMMAND EXTEND Declare_keys CLASSIFIED AS SIDEFF
 | [ "Declare" "Equivalent" "Keys" constr(c) constr(c') ] -> [
   let get_key c =
-    let (evd, c) = Constrintern.interp_open_constr (Global.env ()) Evd.empty c in
+    let env = Global.env () in
+    let evd = Evd.from_env env in
+    let (evd, c) = Constrintern.interp_open_constr env evd c in
     let kind c = EConstr.kind evd c in
     Keys.constr_key kind c
   in
diff --git a/plugins/ltac/g_auto.ml4 b/plugins/ltac/g_auto.ml4
index 643f7e99..35ed14fc 100644
--- a/plugins/ltac/g_auto.ml4
+++ b/plugins/ltac/g_auto.ml4
@@ -9,6 +9,7 @@
 (************************************************************************)
 
 open Pp
+open Constr
 open Genarg
 open Stdarg
 open Pcoq.Prim
@@ -169,10 +170,10 @@ END
 
 
 TACTIC EXTEND convert_concl_no_check
-| ["convert_concl_no_check" constr(x) ] -> [ Tactics.convert_concl_no_check x Term.DEFAULTcast ]
+| ["convert_concl_no_check" constr(x) ] -> [ Tactics.convert_concl_no_check x DEFAULTcast ]
 END
 
-let pr_pre_hints_path_atom _ _ _ = Hints.pp_hints_path_atom Libnames.pr_reference
+let pr_pre_hints_path_atom _ _ _ = Hints.pp_hints_path_atom Libnames.pr_qualid
 let pr_hints_path_atom _ _ _ = Hints.pp_hints_path_atom Printer.pr_global
 let glob_hints_path_atom ist = Hints.glob_hints_path_atom
 
@@ -188,7 +189,7 @@ ARGUMENT EXTEND hints_path_atom
 END
 
 let pr_hints_path prc prx pry c = Hints.pp_hints_path c
-let pr_pre_hints_path prc prx pry c = Hints.pp_hints_path_gen Libnames.pr_reference c
+let pr_pre_hints_path prc prx pry c = Hints.pp_hints_path_gen Libnames.pr_qualid c
 let glob_hints_path ist = Hints.glob_hints_path
 
 ARGUMENT EXTEND hints_path
@@ -219,7 +220,7 @@ VERNAC COMMAND FUNCTIONAL EXTEND HintCut CLASSIFIED AS SIDEFF
     fun ~atts ~st -> begin
         let open Vernacinterp in
         let entry = Hints.HintsCutEntry (Hints.glob_hints_path p) in
-        Hints.add_hints (Locality.make_section_locality atts.locality)
+        Hints.add_hints ~local:(Locality.make_section_locality atts.locality)
           (match dbnames with None -> ["core"] | Some l -> l) entry;
         st
       end
diff --git a/plugins/ltac/g_eqdecide.ml4 b/plugins/ltac/g_eqdecide.mlg
index 2251a662..e57afe3e 100644
--- a/plugins/ltac/g_eqdecide.ml4
+++ b/plugins/ltac/g_eqdecide.mlg
@@ -14,15 +14,19 @@
 (*                           by Eduardo Gimenez                        *)
 (************************************************************************)
 
+{
+
 open Eqdecide
 open Stdarg
 
+}
+
 DECLARE PLUGIN "ltac_plugin"
 
 TACTIC EXTEND decide_equality
-| [ "decide" "equality" ] -> [ decideEqualityGoal ]
+| [ "decide" "equality" ] -> { decideEqualityGoal }
 END
 
 TACTIC EXTEND compare
-| [ "compare" constr(c1) constr(c2) ] -> [ compare c1 c2 ]
+| [ "compare" constr(c1) constr(c2) ] -> { compare c1 c2 }
 END
diff --git a/plugins/ltac/g_ltac.ml4 b/plugins/ltac/g_ltac.ml4
index 0c42a8bb..929390b1 100644
--- a/plugins/ltac/g_ltac.ml4
+++ b/plugins/ltac/g_ltac.ml4
@@ -12,21 +12,22 @@ DECLARE PLUGIN "ltac_plugin"
 
 open Util
 open Pp
+open Glob_term
 open Constrexpr
 open Tacexpr
-open Misctypes
+open Namegen
 open Genarg
 open Genredexpr
 open Tok (* necessary for camlp5 *)
 open Names
 
 open Pcoq
-open Pcoq.Constr
-open Pcoq.Vernac_
 open Pcoq.Prim
+open Pcoq.Constr
+open Pvernac.Vernac_
 open Pltac
 
-let fail_default_value = ArgArg 0
+let fail_default_value = Locus.ArgArg 0
 
 let arg_of_expr = function
     TacArg (loc,a) -> a
@@ -34,20 +35,21 @@ let arg_of_expr = function
 
 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 Stdarg.wit_intro_pattern) pat
+let genarg_of_ipattern pat = in_gen (rawwit Tacarg.wit_intro_pattern) pat
 let genarg_of_uconstr c = in_gen (rawwit Stdarg.wit_uconstr) c
 let in_tac tac = in_gen (rawwit Tacarg.wit_ltac) tac
 
-let reference_to_id = CAst.map_with_loc (fun ?loc -> function
-  | Libnames.Ident id -> id
-  | Libnames.Qualid _ ->
-    CErrors.user_err ?loc
-      (str "This expression should be a simple identifier."))
+let reference_to_id qid =
+  if Libnames.qualid_is_ident qid then
+    CAst.make ?loc:qid.CAst.loc @@ Libnames.qualid_basename qid
+  else
+    CErrors.user_err ?loc:qid.CAst.loc
+      (str "This expression should be a simple identifier.")
 
-let tactic_mode = Gram.entry_create "vernac:tactic_command"
+let tactic_mode = Entry.create "vernac:tactic_command"
 
 let new_entry name =
-  let e = Gram.entry_create name in
+  let e = Entry.create name in
   e
 
 let toplevel_selector = new_entry "vernac:toplevel_selector"
@@ -58,8 +60,8 @@ let tacdef_body = new_entry "tactic:tacdef_body"
 let _ =
   let mode = {
     Proof_global.name = "Classic";
-    set = (fun () -> set_command_entry tactic_mode);
-    reset = (fun () -> set_command_entry Pcoq.Vernac_.noedit_mode);
+    set = (fun () -> Pvernac.set_command_entry tactic_mode);
+    reset = (fun () -> Pvernac.(set_command_entry noedit_mode));
   } in
   Proof_global.register_proof_mode mode
 
@@ -197,9 +199,8 @@ GEXTEND Gram
      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 qid.CAst.v in
-                          ArgVar (CAst.make ~loc:!@loc id) ] ]
+    [ [ s = STRING -> Locus.ArgArg s (*| id = ident -> Locus.ArgVar (!@loc,id)*)
+        | qid = qualid -> Locus.ArgVar (CAst.make ~loc:!@loc @@ Libnames.qualid_basename qid) ] ]
   ;
   constr_eval:
     [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
@@ -286,12 +287,14 @@ GEXTEND Gram
 
   (* Definitions for tactics *)
   tacdef_body:
-    [ [ name = Constr.global; it=LIST1 input_fun; redef = ltac_def_kind; body = tactic_expr ->
+    [ [ name = Constr.global; it=LIST1 input_fun;
+        redef = ltac_def_kind; body = tactic_expr ->
           if redef then Tacexpr.TacticRedefinition (name, TacFun (it, body))
           else
             let id = reference_to_id name in
             Tacexpr.TacticDefinition (id, TacFun (it, body))
-      | name = Constr.global; redef = ltac_def_kind; body = tactic_expr ->
+      | name = Constr.global; redef = ltac_def_kind;
+        body = tactic_expr ->
           if redef then Tacexpr.TacticRedefinition (name, body)
           else
             let id = reference_to_id name in
@@ -311,21 +314,23 @@ GEXTEND Gram
   range_selector_or_nth:
     [ [ n = natural ; "-" ; m = natural;
         l = OPT [","; l = LIST1 range_selector SEP "," -> l] ->
-          SelectList ((n, m) :: Option.default [] l)
+          Goal_select.SelectList ((n, m) :: Option.default [] l)
       | n = natural;
         l = OPT [","; l = LIST1 range_selector SEP "," -> l] ->
+          let open Goal_select in
           Option.cata (fun l -> SelectList ((n, n) :: l)) (SelectNth n) l ] ]
   ;
   selector_body:
   [ [ l = range_selector_or_nth -> l
-    | test_bracket_ident; "["; id = ident; "]" -> SelectId id ] ]
+    | test_bracket_ident; "["; id = ident; "]" -> Goal_select.SelectId id ] ]
   ;
   selector:
     [ [ IDENT "only"; sel = selector_body; ":" -> sel ] ]
   ;
   toplevel_selector:
     [ [ sel = selector_body; ":" -> sel
-    |   IDENT "all"; ":" -> SelectAll ] ]
+    |   "!"; ":" -> Goal_select.SelectAlreadyFocused
+    |   IDENT "all"; ":" -> Goal_select.SelectAll ] ]
   ;
   tactic_mode:
     [ [ g = OPT toplevel_selector; tac = G_vernac.query_command -> tac g
@@ -342,7 +347,7 @@ GEXTEND Gram
   hint:
     [ [ IDENT "Extern"; n = natural; c = OPT Constr.constr_pattern ; "=>";
         tac = Pltac.tactic ->
-          Vernacexpr.HintsExtern (n,c, in_tac tac) ] ]
+          Hints.HintsExtern (n,c, in_tac tac) ] ]
   ;
   operconstr: LEVEL "0"
     [ [ IDENT "ltac"; ":"; "("; tac = Pltac.tactic_expr; ")" ->
@@ -369,6 +374,7 @@ let _ = declare_int_option {
 }
 
 let vernac_solve n info tcom b =
+  let open Goal_select in
   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 | SelectList _ -> true | _ -> false in
@@ -415,7 +421,7 @@ let is_explicit_terminator = function TacSolve _ -> true | _ -> false
 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_bullet.get_default_goal_selector ()) g in
+    let g = Option.default (Goal_select.get_default_goal_selector ()) g in
     vernac_solve g n t def
   ]
 | [ - "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
@@ -428,7 +434,7 @@ VERNAC tactic_mode EXTEND VernacSolve
       VtLater
     ] -> [
       let t = rm_abstract t in
-      vernac_solve SelectAll n t def
+      vernac_solve Goal_select.SelectAll n t def
     ]
 END
 
@@ -466,14 +472,15 @@ VERNAC COMMAND FUNCTIONAL EXTEND VernacTacticNotation
   [ VtSideff [], VtNow ] ->
   [ fun ~atts ~st -> let open Vernacinterp in
       let n = Option.default 0 n in
-      Tacentries.add_tactic_notation (Locality.make_module_locality atts.locality) n r e;
+      let deprecation = atts.deprecated in
+      Tacentries.add_tactic_notation (Locality.make_module_locality atts.locality) n ?deprecation r e;
       st
   ]
 END
 
 VERNAC COMMAND EXTEND VernacPrintLtac CLASSIFIED AS QUERY
 | [ "Print" "Ltac" reference(r) ] ->
-  [ Feedback.msg_notice (Tacintern.print_ltac (Libnames.qualid_of_reference r).CAst.v) ]
+  [ Feedback.msg_notice (Tacintern.print_ltac r) ]
 END
 
 VERNAC COMMAND EXTEND VernacLocateLtac CLASSIFIED AS QUERY
@@ -481,7 +488,7 @@ VERNAC COMMAND EXTEND VernacLocateLtac CLASSIFIED AS QUERY
   [ Tacentries.print_located_tactic r ]
 END
 
-let pr_ltac_ref = Libnames.pr_reference
+let pr_ltac_ref = Libnames.pr_qualid
 
 let pr_tacdef_body tacdef_body =
   let id, redef, body =
@@ -508,10 +515,10 @@ VERNAC COMMAND FUNCTIONAL EXTEND VernacDeclareTacticDefinition
 | [ "Ltac" ne_ltac_tacdef_body_list_sep(l, "with") ] => [
     VtSideff (List.map (function
       | TacticDefinition ({CAst.v=r},_) -> r
-      | TacticRedefinition ({CAst.v=Ident r},_) -> r
-      | TacticRedefinition ({CAst.v=Qualid q},_) -> snd(repr_qualid q)) l), VtLater
+      | TacticRedefinition (qid,_) -> qualid_basename qid) l), VtLater
   ] -> [ fun ~atts ~st -> let open Vernacinterp in
-           Tacentries.register_ltac (Locality.make_module_locality atts.locality) l;
+           let deprecation = atts.deprecated in
+           Tacentries.register_ltac (Locality.make_module_locality atts.locality) ?deprecation l;
            st
   ]
 END
diff --git a/plugins/ltac/g_obligations.ml4 b/plugins/ltac/g_obligations.ml4
index 352e92c2..1f56244c 100644
--- a/plugins/ltac/g_obligations.ml4
+++ b/plugins/ltac/g_obligations.ml4
@@ -12,7 +12,6 @@
   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
@@ -49,7 +48,7 @@ module Tactic = Pltac
 
 open Pcoq
 
-let sigref = mkRefC (CAst.make @@ Qualid (Libnames.qualid_of_string "Coq.Init.Specif.sig"))
+let sigref loc = mkRefC (Libnames.qualid_of_string ~loc "Coq.Init.Specif.sig")
 
 type 'a withtac_argtype = (Tacexpr.raw_tactic_expr option, 'a) Genarg.abstract_argument_type
 
@@ -68,7 +67,7 @@ GEXTEND Gram
 
   Constr.closed_binder:
     [[ "("; id=Prim.name; ":"; t=Constr.lconstr; "|"; c=Constr.lconstr; ")" ->
-	  let typ = mkAppC (sigref, [mkLambdaC ([id], default_binder_kind, t, c)]) in
+          let typ = mkAppC (sigref !@loc, [mkLambdaC ([id], default_binder_kind, t, c)]) in
           [CLocalAssum ([id], default_binder_kind, typ)]
     ] ];
 
diff --git a/plugins/ltac/g_rewrite.ml4 b/plugins/ltac/g_rewrite.ml4
index fbaa2e58..f1634f15 100644
--- a/plugins/ltac/g_rewrite.ml4
+++ b/plugins/ltac/g_rewrite.ml4
@@ -11,7 +11,6 @@
 (* Syntax for rewriting with strategies *)
 
 open Names
-open Misctypes
 open Locus
 open Constrexpr
 open Glob_term
@@ -20,9 +19,10 @@ open Extraargs
 open Tacmach
 open Rewrite
 open Stdarg
-open Pcoq.Vernac_
+open Tactypes
 open Pcoq.Prim
 open Pcoq.Constr
+open Pvernac.Vernac_
 open Pltac
 
 DECLARE PLUGIN "ltac_plugin"
@@ -67,13 +67,13 @@ let subst_strategy s str = str
 
 let pr_strategy _ _ _ (s : strategy) = Pp.str "<strategy>"
 let pr_raw_strategy prc prlc _ (s : raw_strategy) =
-  let prr = Pptactic.pr_red_expr (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_reference, prc) in
+  let prr = Pptactic.pr_red_expr (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_qualid, prc) in
   Rewrite.pr_strategy prc prr s
 let pr_glob_strategy prc prlc _ (s : glob_strategy) =
   let prr = Pptactic.pr_red_expr
     (Ppconstr.pr_constr_expr,
     Ppconstr.pr_lconstr_expr,
-    Pputils.pr_or_by_notation Libnames.pr_reference,
+    Pputils.pr_or_by_notation Libnames.pr_qualid,
     Ppconstr.pr_constr_expr)
   in
   Rewrite.pr_strategy prc prr s
diff --git a/plugins/ltac/g_tactic.ml4 b/plugins/ltac/g_tactic.mlg
index 7534e279..571595be 100644
--- a/plugins/ltac/g_tactic.ml4
+++ b/plugins/ltac/g_tactic.mlg
@@ -8,15 +8,21 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Pp
 open CErrors
 open Util
+open Names
+open Namegen
 open Tacexpr
 open Genredexpr
 open Constrexpr
 open Libnames
 open Tok
-open Misctypes
+open Tactypes
+open Tactics
+open Inv
 open Locus
 open Decl_kinds
 
@@ -154,7 +160,7 @@ let mkTacCase with_evar = function
   (* Reinterpret ident as notations for variables in the context *)
   (* because we don't know if they are quantified or not *)
   | [(clear,ElimOnIdent id),(None,None),None],None ->
-      TacCase (with_evar,(clear,(CAst.make @@ CRef (CAst.make ?loc:id.CAst.loc @@ Ident id.CAst.v,None),NoBindings)))
+      TacCase (with_evar,(clear,(CAst.make @@ CRef (qualid_of_ident ?loc:id.CAst.loc id.CAst.v,None),NoBindings)))
   | ic ->
       if List.exists (function ((_, ElimOnAnonHyp _),_,_) -> true | _ -> false) (fst ic)
       then
@@ -211,488 +217,490 @@ let warn_deprecated_eqn_syntax =
 
 (* Auxiliary grammar rules *)
 
-open Vernac_
+open Pvernac.Vernac_
+
+}
 
-GEXTEND Gram
+GRAMMAR EXTEND Gram
   GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
   bindings red_expr int_or_var open_constr uconstr
   simple_intropattern in_clause clause_dft_concl hypident destruction_arg;
 
   int_or_var:
-    [ [ n = integer  -> ArgArg n
-      | id = identref -> ArgVar id ] ]
+    [ [ n = integer  -> { ArgArg n }
+      | id = identref -> { ArgVar id } ] ]
   ;
   nat_or_var:
-    [ [ n = natural  -> ArgArg n
-      | id = identref -> ArgVar id ] ]
+    [ [ n = natural  -> { ArgArg n }
+      | id = identref -> { ArgVar id } ] ]
   ;
   (* An identifier or a quotation meta-variable *)
   id_or_meta:
-    [ [ id = identref -> id ] ]
+    [ [ id = identref -> { id } ] ]
   ;
   open_constr:
-    [ [ c = constr -> c ] ]
+    [ [ c = constr -> { c } ] ]
   ;
   uconstr:
-    [ [ c = constr -> c ] ]
+    [ [ c = constr -> { c } ] ]
   ;
   destruction_arg:
-    [ [ n = natural -> (None,ElimOnAnonHyp n)
+    [ [ n = natural -> { (None,ElimOnAnonHyp n) }
       | test_lpar_id_rpar; c = constr_with_bindings ->
-        (Some false,destruction_arg_of_constr c)
-      | c = constr_with_bindings_arg -> on_snd destruction_arg_of_constr c
+        { (Some false,destruction_arg_of_constr c) }
+      | c = constr_with_bindings_arg -> { on_snd destruction_arg_of_constr c }
     ] ]
   ;
   constr_with_bindings_arg:
-    [ [ ">"; c = constr_with_bindings -> (Some true,c)
-      | c = constr_with_bindings -> (None,c) ] ]
+    [ [ ">"; c = constr_with_bindings -> { (Some true,c) }
+      | c = constr_with_bindings -> { (None,c) } ] ]
   ;
   quantified_hypothesis:
-    [ [ id = ident -> NamedHyp id
-      | n = natural -> AnonHyp n ] ]
+    [ [ id = ident -> { NamedHyp id }
+      | n = natural -> { AnonHyp n } ] ]
   ;
   conversion:
-    [ [ c = constr -> (None, c)
-      | c1 = constr; "with"; c2 = constr -> (Some (AllOccurrences,c1),c2)
+    [ [ c = constr -> { (None, c) }
+      | c1 = constr; "with"; c2 = constr -> { (Some (AllOccurrences,c1),c2) }
       | c1 = constr; "at"; occs = occs_nums; "with"; c2 = constr ->
-          (Some (occs,c1), c2) ] ]
+          { (Some (occs,c1), c2) } ] ]
   ;
   occs_nums:
-    [ [ nl = LIST1 nat_or_var -> OnlyOccurrences nl
+    [ [ nl = LIST1 nat_or_var -> { OnlyOccurrences nl }
       | "-"; n = nat_or_var; nl = LIST0 int_or_var ->
 	  (* have used int_or_var instead of nat_or_var for compatibility *)
-	   AllOccurrencesBut (List.map (map_int_or_var abs) (n::nl)) ] ]
+	   { AllOccurrencesBut (List.map (map_int_or_var abs) (n::nl)) } ] ]
   ;
   occs:
-    [ [ "at"; occs = occs_nums -> occs | -> AllOccurrences ] ]
+    [ [ "at"; occs = occs_nums -> { occs } | -> { AllOccurrences } ] ]
   ;
   pattern_occ:
-    [ [ c = constr; nl = occs -> (nl,c) ] ]
+    [ [ c = constr; nl = occs -> { (nl,c) } ] ]
   ;
   ref_or_pattern_occ:
     (* If a string, it is interpreted as a ref
        (anyway a Coq string does not reduce) *)
-    [ [ c = smart_global; nl = occs -> nl,Inl c
-      | c = constr; nl = occs -> nl,Inr c ] ]
+    [ [ c = smart_global; nl = occs -> { nl,Inl c }
+      | c = constr; nl = occs -> { nl,Inr c } ] ]
   ;
   unfold_occ:
-    [ [ c = smart_global; nl = occs -> (nl,c) ] ]
+    [ [ c = smart_global; nl = occs -> { (nl,c) } ] ]
   ;
   intropatterns:
-    [ [ l = LIST0 nonsimple_intropattern -> l ]]
+    [ [ l = LIST0 nonsimple_intropattern -> { l } ] ]
   ;
   ne_intropatterns:
-    [ [ l = LIST1 nonsimple_intropattern -> l ]]
+    [ [ l = LIST1 nonsimple_intropattern -> { l } ] ]
   ;
   or_and_intropattern:
-    [ [ "["; tc = LIST1 intropatterns SEP "|"; "]" -> IntroOrPattern tc
-      | "()" -> IntroAndPattern []
-      | "("; si = simple_intropattern; ")" -> IntroAndPattern [si]
+    [ [ "["; tc = LIST1 intropatterns SEP "|"; "]" -> { IntroOrPattern tc }
+      | "()" -> { IntroAndPattern [] }
+      | "("; si = simple_intropattern; ")" -> { IntroAndPattern [si] }
       | "("; si = simple_intropattern; ",";
              tc = LIST1 simple_intropattern SEP "," ; ")" ->
-             IntroAndPattern (si::tc)
+             { IntroAndPattern (si::tc) }
       | "("; si = simple_intropattern; "&";
 	     tc = LIST1 simple_intropattern SEP "&" ; ")" ->
 	  (* (A & B & C) is translated into (A,(B,C)) *)
-	  let rec pairify = function
+	  { let rec pairify = function
 	    | ([]|[_]|[_;_]) as l -> l
             | t::q -> [t; CAst.make ?loc:(loc_of_ne_list q) (IntroAction (IntroOrAndPattern (IntroAndPattern (pairify q))))]
-	  in IntroAndPattern (pairify (si::tc)) ] ]
+	  in IntroAndPattern (pairify (si::tc)) } ] ]
   ;
   equality_intropattern:
-    [ [ "->" -> IntroRewrite true
-      | "<-" -> IntroRewrite false
-      | "[="; tc = intropatterns; "]" -> IntroInjection tc ] ]
+    [ [ "->" -> { IntroRewrite true }
+      | "<-" -> { IntroRewrite false }
+      | "[="; tc = intropatterns; "]" -> { IntroInjection tc } ] ]
   ;
   naming_intropattern:
-    [ [ prefix = pattern_ident -> IntroFresh prefix
-      | "?" -> IntroAnonymous
-      | id = ident -> IntroIdentifier id ] ]
+    [ [ prefix = pattern_ident -> { IntroFresh prefix }
+      | "?" -> { IntroAnonymous }
+      | id = ident -> { IntroIdentifier id } ] ]
   ;
   nonsimple_intropattern:
-    [ [ l = simple_intropattern -> l
-      | "*"  -> CAst.make ~loc:!@loc @@ IntroForthcoming true
-      | "**" -> CAst.make ~loc:!@loc @@ IntroForthcoming false ]]
+    [ [ l = simple_intropattern -> { l }
+      | "*"  -> { CAst.make ~loc @@ IntroForthcoming true }
+      | "**" -> { CAst.make ~loc @@ IntroForthcoming false } ] ]
   ;
   simple_intropattern:
     [ [ pat = simple_intropattern_closed;
-        l = LIST0 ["%"; c = operconstr LEVEL "0" -> c] ->
-          let {CAst.loc=loc0;v=pat} = pat in
+        l = LIST0 ["%"; c = operconstr LEVEL "0" -> { c } ] ->
+          { let {CAst.loc=loc0;v=pat} = pat in
           let f c pat =
             let loc1 = Constrexpr_ops.constr_loc c in
             let loc = Loc.merge_opt loc0 loc1 in
             IntroAction (IntroApplyOn (CAst.(make ?loc:loc1 c),CAst.(make ?loc pat))) in
-          CAst.make ~loc:!@loc @@ List.fold_right f l pat ] ]
+          CAst.make ~loc @@ List.fold_right f l pat } ] ]
   ;
   simple_intropattern_closed:
-    [ [ pat = or_and_intropattern   -> CAst.make ~loc:!@loc @@ IntroAction (IntroOrAndPattern pat)
-      | pat = equality_intropattern -> CAst.make ~loc:!@loc @@ IntroAction pat
-      | "_" -> CAst.make ~loc:!@loc @@ IntroAction IntroWildcard
-      | pat = naming_intropattern -> CAst.make ~loc:!@loc @@ IntroNaming pat ] ]
+    [ [ pat = or_and_intropattern   -> { CAst.make ~loc @@ IntroAction (IntroOrAndPattern pat) }
+      | pat = equality_intropattern -> { CAst.make ~loc @@ IntroAction pat }
+      | "_" -> { CAst.make ~loc @@ IntroAction IntroWildcard }
+      | pat = naming_intropattern -> { CAst.make ~loc @@ IntroNaming pat } ] ]
   ;
   simple_binding:
-    [ [ "("; id = ident; ":="; c = lconstr; ")" -> CAst.make ~loc:!@loc (NamedHyp id, c)
-      | "("; n = natural; ":="; c = lconstr; ")" -> CAst.make ~loc:!@loc (AnonHyp n, c) ] ]
+    [ [ "("; id = ident; ":="; c = lconstr; ")" -> { CAst.make ~loc (NamedHyp id, c) }
+      | "("; n = natural; ":="; c = lconstr; ")" -> { CAst.make ~loc (AnonHyp n, c) } ] ]
   ;
   bindings:
     [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
-          ExplicitBindings bl
-      | bl = LIST1 constr -> ImplicitBindings bl ] ]
+          { ExplicitBindings bl }
+      | bl = LIST1 constr -> { ImplicitBindings bl } ] ]
   ;
   constr_with_bindings:
-    [ [ c = constr; l = with_bindings -> (c, l) ] ]
+    [ [ c = constr; l = with_bindings -> { (c, l) } ] ]
   ;
   with_bindings:
-    [ [ "with"; bl = bindings -> bl | -> NoBindings ] ]
+    [ [ "with"; bl = bindings -> { bl } | -> { NoBindings } ] ]
   ;
   red_flags:
-    [ [ IDENT "beta" -> [FBeta]
-      | IDENT "iota" -> [FMatch;FFix;FCofix]
-      | IDENT "match" -> [FMatch]
-      | IDENT "fix" -> [FFix]
-      | IDENT "cofix" -> [FCofix]
-      | IDENT "zeta" -> [FZeta]
-      | IDENT "delta"; d = delta_flag -> [d]
+    [ [ IDENT "beta" -> { [FBeta] }
+      | IDENT "iota" -> { [FMatch;FFix;FCofix] }
+      | IDENT "match" -> { [FMatch] }
+      | IDENT "fix" -> { [FFix] }
+      | IDENT "cofix" -> { [FCofix] }
+      | IDENT "zeta" -> { [FZeta] }
+      | IDENT "delta"; d = delta_flag -> { [d] }
     ] ]
   ;
   delta_flag:
-    [ [ "-"; "["; idl = LIST1 smart_global; "]" -> FDeltaBut idl
-      | "["; idl = LIST1 smart_global; "]" -> FConst idl
-      | -> FDeltaBut []
+    [ [ "-"; "["; idl = LIST1 smart_global; "]" -> { FDeltaBut idl }
+      | "["; idl = LIST1 smart_global; "]" -> { FConst idl }
+      | -> { FDeltaBut [] }
     ] ]
   ;
   strategy_flag:
-    [ [ s = LIST1 red_flags -> Redops.make_red_flag (List.flatten s)
-      | d = delta_flag -> all_with d
+    [ [ s = LIST1 red_flags -> { Redops.make_red_flag (List.flatten s) }
+      | d = delta_flag -> { all_with d }
     ] ]
   ;
   red_expr:
-    [ [ IDENT "red" -> Red false
-      | IDENT "hnf" -> Hnf
-      | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ -> Simpl (all_with d,po)
-      | IDENT "cbv"; s = strategy_flag -> Cbv s
-      | IDENT "cbn"; s = strategy_flag -> Cbn s
-      | IDENT "lazy"; s = strategy_flag -> Lazy s
-      | IDENT "compute"; delta = delta_flag -> Cbv (all_with delta)
-      | IDENT "vm_compute"; po = OPT ref_or_pattern_occ -> CbvVm po
-      | IDENT "native_compute"; po = OPT ref_or_pattern_occ -> CbvNative po
-      | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
-      | IDENT "fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> Pattern pl
-      | s = IDENT -> ExtraRedExpr s ] ]
+    [ [ IDENT "red" -> { Red false }
+      | IDENT "hnf" -> { Hnf }
+      | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ -> { Simpl (all_with d,po) }
+      | IDENT "cbv"; s = strategy_flag -> { Cbv s }
+      | IDENT "cbn"; s = strategy_flag -> { Cbn s }
+      | IDENT "lazy"; s = strategy_flag -> { Lazy s }
+      | IDENT "compute"; delta = delta_flag -> { Cbv (all_with delta) }
+      | IDENT "vm_compute"; po = OPT ref_or_pattern_occ -> { CbvVm po }
+      | IDENT "native_compute"; po = OPT ref_or_pattern_occ -> { CbvNative po }
+      | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> { Unfold ul }
+      | IDENT "fold"; cl = LIST1 constr -> { Fold cl }
+      | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> { Pattern pl }
+      | s = IDENT -> { ExtraRedExpr s } ] ]
   ;
   hypident:
     [ [ id = id_or_meta ->
-        let id : Misctypes.lident = id in
-        id,InHyp
+        { let id : lident = id in
+        id,InHyp }
       | "("; IDENT "type"; IDENT "of"; id = id_or_meta; ")" ->
-        let id : Misctypes.lident = id in
-        id,InHypTypeOnly
+        { let id : lident = id in
+        id,InHypTypeOnly }
       | "("; IDENT "value"; IDENT "of"; id = id_or_meta; ")" ->
-        let id : Misctypes.lident = id in
-        id,InHypValueOnly
+        { let id : lident = id in
+        id,InHypValueOnly }
     ] ]
   ;
   hypident_occ:
-    [ [ (id,l)=hypident; occs=occs ->
-        let id : Misctypes.lident = id in
-        ((occs,id),l) ] ]
+    [ [ h=hypident; occs=occs ->
+        { let (id,l) = h in
+        let id : lident = id in
+        ((occs,id),l) } ] ]
   ;
   in_clause:
     [ [ "*"; occs=occs ->
-          {onhyps=None; concl_occs=occs}
+          { {onhyps=None; concl_occs=occs} }
       | "*"; "|-"; occs=concl_occ ->
-          {onhyps=None; concl_occs=occs}
+          { {onhyps=None; concl_occs=occs} }
       | hl=LIST0 hypident_occ SEP","; "|-"; occs=concl_occ ->
-          {onhyps=Some hl; concl_occs=occs}
+          { {onhyps=Some hl; concl_occs=occs} }
       | hl=LIST0 hypident_occ SEP"," ->
-          {onhyps=Some hl; concl_occs=NoOccurrences} ] ]
+          { {onhyps=Some hl; concl_occs=NoOccurrences} } ] ]
   ;
   clause_dft_concl:
-    [ [ "in"; cl = in_clause -> cl
-      | occs=occs -> {onhyps=Some[]; concl_occs=occs}
-      | -> all_concl_occs_clause ] ]
+    [ [ "in"; cl = in_clause -> { cl }
+      | occs=occs -> { {onhyps=Some[]; concl_occs=occs} }
+      | -> { all_concl_occs_clause } ] ]
   ;
   clause_dft_all:
-    [ [ "in"; cl = in_clause -> cl
-      | -> {onhyps=None; concl_occs=AllOccurrences} ] ]
+    [ [ "in"; cl = in_clause -> { cl }
+      | -> { {onhyps=None; concl_occs=AllOccurrences} } ] ]
   ;
   opt_clause:
-    [ [ "in"; cl = in_clause -> Some cl
-      | "at"; occs = occs_nums -> Some {onhyps=Some[]; concl_occs=occs}
-      | -> None ] ]
+    [ [ "in"; cl = in_clause -> { Some cl }
+      | "at"; occs = occs_nums -> { Some {onhyps=Some[]; concl_occs=occs} }
+      | -> { None } ] ]
   ;
   concl_occ:
-    [ [ "*"; occs = occs -> occs
-      | -> NoOccurrences ] ]
+    [ [ "*"; occs = occs -> { occs }
+      | -> { NoOccurrences } ] ]
   ;
   in_hyp_list:
-    [ [ "in"; idl = LIST1 id_or_meta -> idl
-      | -> [] ] ]
+    [ [ "in"; idl = LIST1 id_or_meta -> { idl }
+      | -> { [] } ] ]
   ;
   in_hyp_as:
-    [ [ "in"; id = id_or_meta; ipat = as_ipat -> Some (id,ipat)
-      | -> None ] ]
+    [ [ "in"; id = id_or_meta; ipat = as_ipat -> { Some (id,ipat) }
+      | -> { None } ] ]
   ;
   orient:
-    [ [ "->" -> true
-      | "<-" -> false
-      | -> true ]]
+    [ [ "->" -> { true }
+      | "<-" -> { false }
+      | -> { true } ] ]
   ;
   simple_binder:
-    [ [ na=name -> ([na],Default Explicit, CAst.make ~loc:!@loc @@
-                    CHole (Some (Evar_kinds.BinderType na.CAst.v), IntroAnonymous, None))
-      | "("; nal=LIST1 name; ":"; c=lconstr; ")" -> (nal,Default Explicit,c)
+    [ [ na=name -> { ([na],Default Explicit, CAst.make ~loc @@
+                    CHole (Some (Evar_kinds.BinderType na.CAst.v), IntroAnonymous, None)) }
+      | "("; nal=LIST1 name; ":"; c=lconstr; ")" -> { (nal,Default Explicit,c) }
     ] ]
   ;
   fixdecl:
     [ [ "("; id = ident; bl=LIST0 simple_binder; ann=fixannot;
-        ":"; ty=lconstr; ")" -> (!@loc, id, bl, ann, ty) ] ]
+        ":"; ty=lconstr; ")" -> { (loc, id, bl, ann, ty) } ] ]
   ;
   fixannot:
-    [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
-      | -> None ] ]
+    [ [ "{"; IDENT "struct"; id=name; "}" -> { Some id }
+      | -> { None } ] ]
   ;
   cofixdecl:
     [ [ "("; id = ident; bl=LIST0 simple_binder; ":"; ty=lconstr; ")" ->
-        (!@loc, id, bl, None, ty) ] ]
+        { (loc, id, bl, None, ty) } ] ]
   ;
   bindings_with_parameters:
     [ [ check_for_coloneq; "(";  id = ident; bl = LIST0 simple_binder;
-        ":="; c = lconstr; ")" -> (id, mkCLambdaN_simple bl c) ] ]
+        ":="; c = lconstr; ")" -> { (id, mkCLambdaN_simple bl c) } ] ]
   ;
   eliminator:
-    [ [ "using"; el = constr_with_bindings -> el ] ]
+    [ [ "using"; el = constr_with_bindings -> { el } ] ]
   ;
   as_ipat:
-    [ [ "as"; ipat = simple_intropattern -> Some ipat
-      | -> None ] ]
+    [ [ "as"; ipat = simple_intropattern -> { Some ipat }
+      | -> { None } ] ]
   ;
   or_and_intropattern_loc:
-    [ [ ipat = or_and_intropattern -> ArgArg (CAst.make ~loc:!@loc ipat)
-      | locid = identref -> ArgVar locid ] ]
+    [ [ ipat = or_and_intropattern -> { ArgArg (CAst.make ~loc ipat) }
+      | locid = identref -> { ArgVar locid } ] ]
   ;
   as_or_and_ipat:
-    [ [ "as"; ipat = or_and_intropattern_loc -> Some ipat
-      | -> None ] ]
+    [ [ "as"; ipat = or_and_intropattern_loc -> { Some ipat }
+      | -> { None } ] ]
   ;
   eqn_ipat:
-    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> Some (CAst.make ~loc:!@loc pat)
+    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> { Some (CAst.make ~loc pat) }
       | IDENT "_eqn"; ":"; pat = naming_intropattern ->
-         let loc = !@loc in
-         warn_deprecated_eqn_syntax ~loc "H"; Some (CAst.make ~loc pat)
+         { warn_deprecated_eqn_syntax ~loc "H"; Some (CAst.make ~loc pat) }
       | IDENT "_eqn" ->
-         let loc = !@loc in
-         warn_deprecated_eqn_syntax ~loc "?"; Some (CAst.make ~loc IntroAnonymous)
-      | -> None ] ]
+         { warn_deprecated_eqn_syntax ~loc "?"; Some (CAst.make ~loc IntroAnonymous) }
+      | -> { None } ] ]
   ;
   as_name:
-    [ [ "as"; id = ident ->Names.Name.Name id | -> Names.Name.Anonymous ] ]
+    [ [ "as"; id = ident -> { Names.Name.Name id } | -> { Names.Name.Anonymous } ] ]
   ;
   by_tactic:
-    [ [ "by"; tac = tactic_expr LEVEL "3" -> Some tac
-    | -> None ] ]
+    [ [ "by"; tac = tactic_expr LEVEL "3" -> { Some tac }
+    | -> { None } ] ]
   ;
   rewriter :
-    [ [ "!"; c = constr_with_bindings_arg -> (RepeatPlus,c)
-      | ["?"| LEFTQMARK]; c = constr_with_bindings_arg -> (RepeatStar,c)
-      | n = natural; "!"; c = constr_with_bindings_arg -> (Precisely n,c)
-      |	n = natural; ["?" | LEFTQMARK]; c = constr_with_bindings_arg -> (UpTo n,c)
-      | n = natural; c = constr_with_bindings_arg -> (Precisely n,c)
-      | c = constr_with_bindings_arg -> (Precisely 1, c)
+    [ [ "!"; c = constr_with_bindings_arg -> { (Equality.RepeatPlus,c) }
+      | ["?" -> { () } | LEFTQMARK -> { () } ]; c = constr_with_bindings_arg -> { (Equality.RepeatStar,c) }
+      | n = natural; "!"; c = constr_with_bindings_arg -> { (Equality.Precisely n,c) }
+      |	n = natural; ["?" -> { () } | LEFTQMARK -> { () } ]; c = constr_with_bindings_arg -> { (Equality.UpTo n,c) }
+      | n = natural; c = constr_with_bindings_arg -> { (Equality.Precisely n,c) }
+      | c = constr_with_bindings_arg -> { (Equality.Precisely 1, c) }
       ] ]
   ;
   oriented_rewriter :
-    [ [ b = orient; p = rewriter -> let (m,c) = p in (b,m,c) ] ]
+    [ [ b = orient; p = rewriter -> { let (m,c) = p in (b,m,c) } ] ]
   ;
   induction_clause:
     [ [ c = destruction_arg; pat = as_or_and_ipat; eq = eqn_ipat;
-        cl = opt_clause -> (c,(eq,pat),cl) ] ]
+        cl = opt_clause -> { (c,(eq,pat),cl) } ] ]
   ;
   induction_clause_list:
     [ [ ic = LIST1 induction_clause SEP ","; el = OPT eliminator;
         cl_tolerance = opt_clause ->
         (* Condition for accepting "in" at the end by compatibility *)
-        match ic,el,cl_tolerance with
+        { match ic,el,cl_tolerance with
         | [c,pat,None],Some _,Some _ -> ([c,pat,cl_tolerance],el)
         | _,_,Some _ -> err ()
-        | _,_,None -> (ic,el) ]]
+        | _,_,None -> (ic,el) } ] ]
   ;
   simple_tactic:
     [ [
       (* Basic tactics *)
         IDENT "intros"; pl = ne_intropatterns ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (false,pl))
+          { TacAtom (Loc.tag ~loc @@ TacIntroPattern (false,pl)) }
       | IDENT "intros" ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (false,[CAst.make ~loc:!@loc @@IntroForthcoming false]))
+          { TacAtom (Loc.tag ~loc @@ TacIntroPattern (false,[CAst.make ~loc @@IntroForthcoming false])) }
       | IDENT "eintros"; pl = ne_intropatterns ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (true,pl))
+          { TacAtom (Loc.tag ~loc @@ TacIntroPattern (true,pl)) }
 
       | IDENT "apply"; cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (true,false,cl,inhyp))
+          inhyp = in_hyp_as -> { TacAtom (Loc.tag ~loc @@ TacApply (true,false,cl,inhyp)) }
       | IDENT "eapply"; cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (true,true,cl,inhyp))
+          inhyp = in_hyp_as -> { TacAtom (Loc.tag ~loc @@ TacApply (true,true,cl,inhyp)) }
       | IDENT "simple"; IDENT "apply";
           cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (false,false,cl,inhyp))
+          inhyp = in_hyp_as -> { TacAtom (Loc.tag ~loc @@ TacApply (false,false,cl,inhyp)) }
       | IDENT "simple"; IDENT "eapply";
           cl = LIST1 constr_with_bindings_arg SEP",";
-          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (false,true,cl,inhyp))
+          inhyp = in_hyp_as -> { TacAtom (Loc.tag ~loc @@ TacApply (false,true,cl,inhyp)) }
       | IDENT "elim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacElim (false,cl,el))
+          { TacAtom (Loc.tag ~loc @@ TacElim (false,cl,el)) }
       | IDENT "eelim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacElim (true,cl,el))
-      | IDENT "case"; icl = induction_clause_list -> TacAtom (Loc.tag ~loc:!@loc @@ mkTacCase false icl)
-      | IDENT "ecase"; icl = induction_clause_list -> TacAtom (Loc.tag ~loc:!@loc @@ mkTacCase true icl)
+          { TacAtom (Loc.tag ~loc @@ TacElim (true,cl,el)) }
+      | IDENT "case"; icl = induction_clause_list -> { TacAtom (Loc.tag ~loc @@ mkTacCase false icl) }
+      | IDENT "ecase"; icl = induction_clause_list -> { TacAtom (Loc.tag ~loc @@ mkTacCase true icl) }
       | "fix"; id = ident; n = natural; "with"; fd = LIST1 fixdecl ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacMutualFix (id,n,List.map mk_fix_tac fd))
+	  { TacAtom (Loc.tag ~loc @@ TacMutualFix (id,n,List.map mk_fix_tac fd)) }
       | "cofix"; id = ident; "with"; fd = LIST1 cofixdecl ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacMutualCofix (id,List.map mk_cofix_tac fd))
+	  { TacAtom (Loc.tag ~loc @@ TacMutualCofix (id,List.map mk_cofix_tac fd)) }
 
-      | IDENT "pose"; (id,b) = bindings_with_parameters ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,Names.Name.Name id,b,Locusops.nowhere,true,None))
+      | IDENT "pose"; bl = bindings_with_parameters ->
+	  { let (id,b) = bl in TacAtom (Loc.tag ~loc @@ TacLetTac (false,Names.Name.Name id,b,Locusops.nowhere,true,None)) }
       | IDENT "pose"; b = constr; na = as_name ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,b,Locusops.nowhere,true,None))
-      | IDENT "epose"; (id,b) = bindings_with_parameters ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,Names.Name id,b,Locusops.nowhere,true,None))
+	  { TacAtom (Loc.tag ~loc @@ TacLetTac (false,na,b,Locusops.nowhere,true,None)) }
+      | IDENT "epose"; bl = bindings_with_parameters ->
+	  { let (id,b) = bl in TacAtom (Loc.tag ~loc @@ TacLetTac (true,Names.Name id,b,Locusops.nowhere,true,None)) }
       | IDENT "epose"; b = constr; na = as_name ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,b,Locusops.nowhere,true,None))
-      | IDENT "set"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,Names.Name.Name id,c,p,true,None))
+	  { TacAtom (Loc.tag ~loc @@ TacLetTac (true,na,b,Locusops.nowhere,true,None)) }
+      | IDENT "set"; bl = bindings_with_parameters; p = clause_dft_concl ->
+	  { let (id,c) = bl in TacAtom (Loc.tag ~loc @@ TacLetTac (false,Names.Name.Name id,c,p,true,None)) }
       | IDENT "set"; c = constr; na = as_name; p = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,c,p,true,None))
-      | IDENT "eset"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,Names.Name id,c,p,true,None))
+          { TacAtom (Loc.tag ~loc @@ TacLetTac (false,na,c,p,true,None)) }
+      | IDENT "eset"; bl = bindings_with_parameters; p = clause_dft_concl ->
+	  { let (id,c) = bl in TacAtom (Loc.tag ~loc @@ TacLetTac (true,Names.Name id,c,p,true,None)) }
       | IDENT "eset"; c = constr; na = as_name; p = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,c,p,true,None))
+          { TacAtom (Loc.tag ~loc @@ TacLetTac (true,na,c,p,true,None)) }
       | IDENT "remember"; c = constr; na = as_name; e = eqn_ipat;
           p = clause_dft_all ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,c,p,false,e))
+          { TacAtom (Loc.tag ~loc @@ TacLetTac (false,na,c,p,false,e)) }
       | IDENT "eremember"; c = constr; na = as_name; e = eqn_ipat;
           p = clause_dft_all ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,c,p,false,e))
+          { TacAtom (Loc.tag ~loc @@ TacLetTac (true,na,c,p,false,e)) }
 
       (* Alternative syntax for "pose proof c as id" *)
       | IDENT "assert"; test_lpar_id_coloneq; "("; lid = identref; ":=";
 	  c = lconstr; ")" ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,None,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,None,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
       | IDENT "eassert"; test_lpar_id_coloneq; "("; lid = identref; ":=";
 	  c = lconstr; ")" ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,None,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,None,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
 
       (* Alternative syntax for "assert c as id by tac" *)
       | IDENT "assert"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
       | IDENT "eassert"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
 
       (* Alternative syntax for "enough c as id by tac" *)
       | IDENT "enough"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (false,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
       | IDENT "eenough"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-          let { CAst.loc = loc; v = id } = lid in
-          TacAtom (Loc.tag ?loc @@ TacAssert (true,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+          { let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c)) }
 
       | IDENT "assert"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,Some tac,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (false,true,Some tac,ipat,c)) }
       | IDENT "eassert"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,Some tac,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (true,true,Some tac,ipat,c)) }
       | IDENT "pose"; IDENT "proof"; c = lconstr; ipat = as_ipat ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,None,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (false,true,None,ipat,c)) }
       | IDENT "epose"; IDENT "proof"; c = lconstr; ipat = as_ipat ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,None,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (true,true,None,ipat,c)) }
       | IDENT "enough"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,false,Some tac,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (false,false,Some tac,ipat,c)) }
       | IDENT "eenough"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,false,Some tac,ipat,c))
+	  { TacAtom (Loc.tag ~loc @@ TacAssert (true,false,Some tac,ipat,c)) }
 
       | IDENT "generalize"; c = constr ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize [((AllOccurrences,c),Names.Name.Anonymous)])
+	  { TacAtom (Loc.tag ~loc @@ TacGeneralize [((AllOccurrences,c),Names.Name.Anonymous)]) }
       | IDENT "generalize"; c = constr; l = LIST1 constr ->
-	  let gen_everywhere c = ((AllOccurrences,c),Names.Name.Anonymous) in
-          TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize (List.map gen_everywhere (c::l)))
+	  { let gen_everywhere c = ((AllOccurrences,c),Names.Name.Anonymous) in
+          TacAtom (Loc.tag ~loc @@ TacGeneralize (List.map gen_everywhere (c::l))) }
       | IDENT "generalize"; c = constr; lookup_at_as_comma; nl = occs;
           na = as_name;
-          l = LIST0 [","; c = pattern_occ; na = as_name -> (c,na)] ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize (((nl,c),na)::l))
+          l = LIST0 [","; c = pattern_occ; na = as_name -> { (c,na) } ] ->
+          { TacAtom (Loc.tag ~loc @@ TacGeneralize (((nl,c),na)::l)) }
 
       (* Derived basic tactics *)
       | IDENT "induction"; ic = induction_clause_list ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct (true,false,ic))
+	  { TacAtom (Loc.tag ~loc @@ TacInductionDestruct (true,false,ic)) }
       | IDENT "einduction"; ic = induction_clause_list ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(true,true,ic))
+	  { TacAtom (Loc.tag ~loc @@ TacInductionDestruct(true,true,ic)) }
       | IDENT "destruct"; icl = induction_clause_list ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(false,false,icl))
+	  { TacAtom (Loc.tag ~loc @@ TacInductionDestruct(false,false,icl)) }
       | IDENT "edestruct";  icl = induction_clause_list ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(false,true,icl))
+	  { TacAtom (Loc.tag ~loc @@ TacInductionDestruct(false,true,icl)) }
 
       (* Equality and inversion *)
       | IDENT "rewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=by_tactic -> TacAtom (Loc.tag ~loc:!@loc @@ TacRewrite (false,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> { TacAtom (Loc.tag ~loc @@ TacRewrite (false,l,cl,t)) }
       | IDENT "erewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=by_tactic -> TacAtom (Loc.tag ~loc:!@loc @@ TacRewrite (true,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> { TacAtom (Loc.tag ~loc @@ TacRewrite (true,l,cl,t)) }
       | IDENT "dependent"; k =
-	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
-	  | IDENT "inversion" -> FullInversion
-	  | IDENT "inversion_clear" -> FullInversionClear ];
+	  [ IDENT "simple"; IDENT "inversion" -> { SimpleInversion }
+	  | IDENT "inversion" -> { FullInversion }
+	  | IDENT "inversion_clear" -> { FullInversionClear } ];
 	  hyp = quantified_hypothesis;
-	  ids = as_or_and_ipat; co = OPT ["with"; c = constr -> c] ->
-	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (DepInversion (k,co,ids),hyp))
+	  ids = as_or_and_ipat; co = OPT ["with"; c = constr -> { c } ] ->
+	    { TacAtom (Loc.tag ~loc @@ TacInversion (DepInversion (k,co,ids),hyp)) }
       | IDENT "simple"; IDENT "inversion";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp))
+	    { TacAtom (Loc.tag ~loc @@ TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp)) }
       | IDENT "inversion";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (FullInversion, cl, ids), hyp))
+	    { TacAtom (Loc.tag ~loc @@ TacInversion (NonDepInversion (FullInversion, cl, ids), hyp)) }
       | IDENT "inversion_clear";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp))
+	    { TacAtom (Loc.tag ~loc @@ TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp)) }
       | IDENT "inversion"; hyp = quantified_hypothesis;
 	  "using"; c = constr; cl = in_hyp_list ->
-	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (InversionUsing (c,cl), hyp))
+	    { TacAtom (Loc.tag ~loc @@ TacInversion (InversionUsing (c,cl), hyp)) }
 
       (* Conversion *)
       | IDENT "red"; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Red false, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Red false, cl)) }
       | IDENT "hnf"; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Hnf, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Hnf, cl)) }
       | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Simpl (all_with d, po), cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Simpl (all_with d, po), cl)) }
       | IDENT "cbv"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbv s, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Cbv s, cl)) }
       | IDENT "cbn"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbn s, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Cbn s, cl)) }
       | IDENT "lazy"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Lazy s, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Lazy s, cl)) }
       | IDENT "compute"; delta = delta_flag; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbv (all_with delta), cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Cbv (all_with delta), cl)) }
       | IDENT "vm_compute"; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (CbvVm po, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (CbvVm po, cl)) }
       | IDENT "native_compute"; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (CbvNative po, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (CbvNative po, cl)) }
       | IDENT "unfold"; ul = LIST1 unfold_occ SEP ","; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Unfold ul, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Unfold ul, cl)) }
       | IDENT "fold"; l = LIST1 constr; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Fold l, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Fold l, cl)) }
       | IDENT "pattern"; pl = LIST1 pattern_occ SEP","; cl = clause_dft_concl ->
-          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Pattern pl, cl))
+          { TacAtom (Loc.tag ~loc @@ TacReduce (Pattern pl, cl)) }
 
       (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
-      | IDENT "change"; (oc,c) = conversion; cl = clause_dft_concl ->
-	  let p,cl = merge_occurrences (!@loc) cl oc in
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacChange (p,c,cl))
+      | IDENT "change"; c = conversion; cl = clause_dft_concl ->
+	  { let (oc, c) = c in
+	  let p,cl = merge_occurrences loc cl oc in
+	  TacAtom (Loc.tag ~loc @@ TacChange (p,c,cl)) }
     ] ]
   ;
-END;;
+END
diff --git a/plugins/ltac/pltac.ml b/plugins/ltac/pltac.ml
index e9711268..759bb62f 100644
--- a/plugins/ltac/pltac.ml
+++ b/plugins/ltac/pltac.ml
@@ -11,11 +11,10 @@
 open Pcoq
 
 (* Main entry for extensions *)
-let simple_tactic = Gram.entry_create "tactic:simple_tactic"
+let simple_tactic = Entry.create "tactic:simple_tactic"
 
-let make_gen_entry _ name = Gram.entry_create ("tactic:" ^ name)
+let make_gen_entry _ name = Entry.create ("tactic:" ^ name)
 
-(* Entries that can be referred via the string -> Gram.entry table *)
 (* Typically for tactic user extensions *)
 let open_constr =
   make_gen_entry utactic "open_constr"
@@ -23,7 +22,7 @@ let constr_with_bindings =
   make_gen_entry utactic "constr_with_bindings"
 let bindings =
   make_gen_entry utactic "bindings"
-let hypident = Gram.entry_create "hypident"
+let hypident = Entry.create "hypident"
 let constr_may_eval = make_gen_entry utactic "constr_may_eval"
 let constr_eval = make_gen_entry utactic "constr_eval"
 let uconstr =
@@ -40,7 +39,7 @@ let clause_dft_concl =
 
 
 (* Main entries for ltac *)
-let tactic_arg = Gram.entry_create "tactic:tactic_arg"
+let tactic_arg = Entry.create "tactic:tactic_arg"
 let tactic_expr = make_gen_entry utactic "tactic_expr"
 let binder_tactic = make_gen_entry utactic "binder_tactic"
 
diff --git a/plugins/ltac/pltac.mli b/plugins/ltac/pltac.mli
index 6637de74..9bff98b6 100644
--- a/plugins/ltac/pltac.mli
+++ b/plugins/ltac/pltac.mli
@@ -15,24 +15,24 @@ open Libnames
 open Constrexpr
 open Tacexpr
 open Genredexpr
-open Misctypes
+open Tactypes
 
-val open_constr : constr_expr Gram.entry
-val constr_with_bindings : constr_expr with_bindings Gram.entry
-val bindings : constr_expr bindings Gram.entry
-val hypident : (lident * Locus.hyp_location_flag) Gram.entry
-val constr_may_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-val constr_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-val uconstr : constr_expr Gram.entry
-val quantified_hypothesis : quantified_hypothesis Gram.entry
-val destruction_arg : constr_expr with_bindings destruction_arg Gram.entry
-val int_or_var : int or_var Gram.entry
-val simple_tactic : raw_tactic_expr Gram.entry
-val simple_intropattern : constr_expr intro_pattern_expr CAst.t Gram.entry
-val in_clause : lident Locus.clause_expr Gram.entry
-val clause_dft_concl : lident Locus.clause_expr Gram.entry
-val tactic_arg : raw_tactic_arg Gram.entry
-val tactic_expr : raw_tactic_expr Gram.entry
-val binder_tactic : raw_tactic_expr Gram.entry
-val tactic : raw_tactic_expr Gram.entry
-val tactic_eoi : raw_tactic_expr Gram.entry
+val open_constr : constr_expr Entry.t
+val constr_with_bindings : constr_expr with_bindings Entry.t
+val bindings : constr_expr bindings Entry.t
+val hypident : (Names.lident * Locus.hyp_location_flag) Entry.t
+val constr_may_eval : (constr_expr,qualid or_by_notation,constr_expr) may_eval Entry.t
+val constr_eval : (constr_expr,qualid or_by_notation,constr_expr) may_eval Entry.t
+val uconstr : constr_expr Entry.t
+val quantified_hypothesis : quantified_hypothesis Entry.t
+val destruction_arg : constr_expr with_bindings Tactics.destruction_arg Entry.t
+val int_or_var : int Locus.or_var Entry.t
+val simple_tactic : raw_tactic_expr Entry.t
+val simple_intropattern : constr_expr intro_pattern_expr CAst.t Entry.t
+val in_clause : Names.lident Locus.clause_expr Entry.t
+val clause_dft_concl : Names.lident Locus.clause_expr Entry.t
+val tactic_arg : raw_tactic_arg Entry.t
+val tactic_expr : raw_tactic_expr Entry.t
+val binder_tactic : raw_tactic_expr Entry.t
+val tactic : raw_tactic_expr Entry.t
+val tactic_eoi : raw_tactic_expr Entry.t
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 11bb7a23..b219ee25 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -17,9 +17,8 @@ open Constrexpr
 open Genarg
 open Geninterp
 open Stdarg
-open Libnames
-open Notation_term
-open Misctypes
+open Notation_gram
+open Tactypes
 open Locus
 open Decl_kinds
 open Genredexpr
@@ -29,6 +28,7 @@ open Printer
 
 open Tacexpr
 open Tacarg
+open Tactics
 
 module Tag =
 struct
@@ -116,7 +116,7 @@ let string_of_genarg_arg (ArgumentType arg) =
   let keyword x = tag_keyword (str x)
   let primitive x = tag_primitive (str x)
 
-  let has_type (Val.Dyn (tag, x)) t = match Val.eq tag t with
+  let has_type (Val.Dyn (tag, _)) t = match Val.eq tag t with
   | None -> false
   | Some _ -> true
 
@@ -149,9 +149,12 @@ let string_of_genarg_arg (ArgumentType arg) =
              let open Genprint in
              match generic_top_print (in_gen (Topwit wit) x) with
              | TopPrinterBasic pr -> pr ()
-             | TopPrinterNeedsContext pr -> pr (Global.env()) Evd.empty
+             | TopPrinterNeedsContext pr ->
+               let env = Global.env() in
+               pr env (Evd.from_env env)
              | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
-                printer (Global.env()) Evd.empty default_ensure_surrounded
+               let env = Global.env() in
+               printer env (Evd.from_env env) default_ensure_surrounded
           end
         | _ -> default
 
@@ -186,7 +189,7 @@ let string_of_genarg_arg (ArgumentType arg) =
     | AN v -> f v
     | ByNotation (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc)
 
-  let pr_located pr (loc,x) = pr x
+  let pr_located pr (_,x) = pr x
 
   let pr_evaluable_reference = function
     | EvalVarRef id -> pr_id id
@@ -238,7 +241,7 @@ let string_of_genarg_arg (ArgumentType arg) =
     in
     pr_sequence (fun x -> x) l
 
-  let pr_extend_gen pr_gen lev { mltac_name = s; mltac_index = i } l =
+  let pr_extend_gen pr_gen _ { mltac_name = s; mltac_index = i } l =
       let name =
         str s.mltac_plugin ++ str "::" ++ str s.mltac_tactic ++
         str "@" ++ int i
@@ -258,7 +261,7 @@ let string_of_genarg_arg (ArgumentType arg) =
   | Extend.Uentry tag ->
     let ArgT.Any tag = tag in
     ArgT.repr tag
-  | Extend.Uentryl (tkn, lvl) -> "tactic" ^ string_of_int lvl
+  | Extend.Uentryl (_, lvl) -> "tactic" ^ string_of_int lvl
 
   let pr_alias_key key =
     try
@@ -269,6 +272,8 @@ let string_of_genarg_arg (ArgumentType arg) =
       in
       pr_sequence pr prods
     with Not_found ->
+      (* FIXME: This key, moreover printed with a low-level printer,
+         has no meaning user-side *)
       KerName.print key
 
   let pr_alias_gen pr_gen lev key l =
@@ -286,7 +291,7 @@ let string_of_genarg_arg (ArgumentType arg) =
       let p = pr_tacarg_using_rule pr_gen prods in
       if pp.pptac_level > lev then surround p else p
     with Not_found ->
-      let pr arg = str "_" in
+      let pr _ = str "_" in
       KerName.print key ++ spc() ++ pr_sequence pr l ++ str" (* Generic printer *)"
 
   let pr_farg prtac arg = prtac (1, Any) (TacArg (Loc.tag arg))
@@ -339,14 +344,14 @@ let string_of_genarg_arg (ArgumentType arg) =
       pr_any_arg pr symb arg
     | _ -> str "ltac:(" ++ prtac (1, Any) arg ++ str ")"
 
-  let pr_raw_extend_rec prc prlc prtac prpat =
+  let pr_raw_extend_rec prtac =
     pr_extend_gen (pr_farg prtac)
-  let pr_glob_extend_rec prc prlc prtac prpat =
+  let pr_glob_extend_rec prtac =
     pr_extend_gen (pr_farg prtac)
 
-  let pr_raw_alias prc prlc prtac prpat lev key args =
+  let pr_raw_alias prtac lev key args =
     pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.tag a)))) lev key args
-  let pr_glob_alias prc prlc prtac prpat lev key args =
+  let pr_glob_alias prtac lev key args =
     pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.tag a)))) lev key args
 
   (**********************************************************************)
@@ -490,7 +495,7 @@ let string_of_genarg_arg (ArgumentType arg) =
 
   let pr_orient b = if b then mt () else str "<- "
 
-  let pr_multi = function
+  let pr_multi = let open Equality in function
     | Precisely 1 -> mt ()
     | Precisely n -> int n ++ str "!"
     | UpTo n -> int n ++ str "?"
@@ -505,7 +510,7 @@ let string_of_genarg_arg (ArgumentType arg) =
   let pr_destruction_arg prc prlc (clear_flag,h) =
     pr_clear_flag clear_flag (pr_core_destruction_arg prc prlc) h
 
-  let pr_inversion_kind = function
+  let pr_inversion_kind = let open Inv in function
     | SimpleInversion -> primitive "simple inversion"
     | FullInversion -> primitive "inversion"
     | FullInversionClear -> primitive "inversion_clear"
@@ -514,7 +519,8 @@ let string_of_genarg_arg (ArgumentType arg) =
     if Int.equal i j then int i
     else int i ++ str "-" ++ int j
 
-let pr_goal_selector toplevel = function
+let pr_goal_selector toplevel = let open Goal_select in function
+  | SelectAlreadyFocused -> str "!:"
   | SelectNth i -> int i ++ str ":"
   | SelectList l -> prlist_with_sep (fun () -> str ", ") pr_range_selector l ++ str ":"
   | SelectId id -> str "[" ++ Id.print id ++ str "]:"
@@ -740,12 +746,12 @@ let pr_goal_selector ~toplevel s =
       (* Main tactic printer *)
       and pr_atom1 a = tag_atom a (match a with
         (* Basic tactics *)
-        | TacIntroPattern (ev,[]) as t ->
+        | TacIntroPattern (_,[]) as t ->
           pr_atom0 t
         | TacIntroPattern (ev,(_::_ as p)) ->
            hov 1 (primitive (if ev then "eintros" else "intros") ++
                     (match p with
-                    | [{CAst.v=Misctypes.IntroForthcoming false}] -> mt ()
+                    | [{CAst.v=IntroForthcoming false}] -> mt ()
                     | _ -> spc () ++ prlist_with_sep spc (Miscprint.pr_intro_pattern pr.pr_dconstr) p))
         | TacApply (a,ev,cb,inhyp) ->
           hov 1 (
@@ -1051,7 +1057,7 @@ let pr_goal_selector ~toplevel s =
               primitive "fresh" ++ pr_fresh_ids l, latom
             | TacArg(_,TacGeneric arg) ->
               pr.pr_generic arg, latom
-            | TacArg(_,TacCall(loc,(f,[]))) ->
+            | TacArg(_,TacCall(_,(f,[]))) ->
               pr.pr_reference f, latom
             | TacArg(_,TacCall(loc,(f,l))) ->
               pr_with_comments ?loc (hov 1 (
@@ -1105,12 +1111,12 @@ let pr_goal_selector ~toplevel s =
       pr_lconstr = pr_lconstr_expr;
       pr_pattern = pr_constr_pattern_expr;
       pr_lpattern = pr_lconstr_pattern_expr;
-      pr_constant = pr_or_by_notation pr_reference;
-      pr_reference = pr_reference;
+      pr_constant = pr_or_by_notation pr_qualid;
+      pr_reference = pr_qualid;
       pr_name = pr_lident;
       pr_generic = (fun arg -> Pputils.pr_raw_generic (Global.env ()) arg);
-      pr_extend = pr_raw_extend_rec pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
-      pr_alias = pr_raw_alias pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
+      pr_extend = pr_raw_extend_rec pr_raw_tactic_level;
+      pr_alias = pr_raw_alias pr_raw_tactic_level;
     } in
     make_pr_tac
       pr raw_printers
@@ -1139,12 +1145,8 @@ let pr_goal_selector ~toplevel s =
         pr_reference = pr_ltac_or_var (pr_located pr_ltac_constant);
         pr_name = pr_lident;
         pr_generic = (fun arg -> Pputils.pr_glb_generic (Global.env ()) arg);
-        pr_extend = pr_glob_extend_rec
-          (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-          prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
-        pr_alias = pr_glob_alias
-          (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-          prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
+        pr_extend = pr_glob_extend_rec prtac;
+        pr_alias = pr_glob_alias prtac;
       } in
       make_pr_tac
         pr glob_printers
@@ -1165,8 +1167,8 @@ let pr_goal_selector ~toplevel s =
         | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
     strip_ty [] n ty
 
-  let pr_atomic_tactic_level env sigma n t =
-    let prtac n (t:atomic_tactic_expr) =
+  let pr_atomic_tactic_level env sigma t =
+    let prtac (t:atomic_tactic_expr) =
       let pr = {
         pr_tactic = (fun _ _ -> str "<tactic>");
         pr_constr = (fun c -> pr_econstr_env env sigma c);
@@ -1185,18 +1187,15 @@ let pr_goal_selector ~toplevel s =
       in
       pr_atom pr strip_prod_binders_constr tag_atomic_tactic_expr t
     in
-    prtac n t
+    prtac t
 
   let pr_raw_generic = Pputils.pr_raw_generic
 
   let pr_glb_generic = Pputils.pr_glb_generic
 
-  let pr_raw_extend env = pr_raw_extend_rec
-    pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr
+  let pr_raw_extend _ = pr_raw_extend_rec pr_raw_tactic_level
 
-  let pr_glob_extend env = pr_glob_extend_rec
-    (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-    (pr_glob_tactic_level env) (pr_pat_and_constr_expr (pr_glob_constr_env env))
+  let pr_glob_extend env = pr_glob_extend_rec (pr_glob_tactic_level env)
 
   let pr_alias pr lev key args =
     pr_alias_gen (fun _ arg -> pr arg) lev key args
@@ -1204,14 +1203,14 @@ let pr_goal_selector ~toplevel s =
   let pr_extend pr lev ml args =
     pr_extend_gen pr lev ml args
 
-  let pr_atomic_tactic env sigma c = pr_atomic_tactic_level env sigma ltop c
+  let pr_atomic_tactic env sigma c = pr_atomic_tactic_level env sigma c
 
 let declare_extra_genarg_pprule wit
   (f : 'a raw_extra_genarg_printer)
   (g : 'b glob_extra_genarg_printer)
   (h : 'c extra_genarg_printer) =
   begin match wit with
-    | ExtraArg s -> ()
+    | ExtraArg _ -> ()
     | _          -> user_err Pp.(str "Can declare a pretty-printing rule only for extra argument types.")
   end;
   let f x =
@@ -1319,7 +1318,7 @@ let () =
   let open Genprint in
   register_basic_print0 wit_int_or_var (pr_or_var int) (pr_or_var int) int;
   register_basic_print0 wit_ref
-    pr_reference (pr_or_var (pr_located pr_global)) pr_global;
+    pr_qualid (pr_or_var (pr_located pr_global)) pr_global;
   register_basic_print0 wit_ident pr_id pr_id pr_id;
   register_basic_print0 wit_var pr_lident pr_lident pr_id;
   register_print0
@@ -1353,7 +1352,7 @@ let () =
   ;
   Genprint.register_print0
     wit_red_expr
-    (lift (pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_reference, pr_constr_pattern_expr)))
+    (lift (pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_qualid, pr_constr_pattern_expr)))
     (lift (pr_red_expr (pr_and_constr_expr pr_glob_constr_pptac, pr_and_constr_expr pr_lglob_constr_pptac, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr_pptac)))
     pr_red_expr_env
   ;
diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli
index 5951f2b1..6c09e447 100644
--- a/plugins/ltac/pptactic.mli
+++ b/plugins/ltac/pptactic.mli
@@ -14,11 +14,11 @@
 open Genarg
 open Geninterp
 open Names
-open Misctypes
 open Environ
 open Constrexpr
-open Notation_term
+open Notation_gram
 open Tacexpr
+open Tactypes
 
 type 'a grammar_tactic_prod_item_expr =
 | TacTerm of string
@@ -84,7 +84,7 @@ type pp_tactic = {
   pptac_prods : grammar_terminals;
 }
 
-val pr_goal_selector : toplevel:bool -> goal_selector -> Pp.t
+val pr_goal_selector : toplevel:bool -> Goal_select.t -> Pp.t
 
 val declare_notation_tactic_pprule : KerName.t -> pp_tactic -> unit
 
@@ -97,7 +97,7 @@ val pr_may_eval :
   ('a -> Pp.t) -> ('a -> Pp.t) -> ('b -> Pp.t) ->
   ('c -> Pp.t) -> ('a,'b,'c) Genredexpr.may_eval -> Pp.t
 
-val pr_and_short_name : ('a -> Pp.t) -> 'a and_short_name -> Pp.t
+val pr_and_short_name : ('a -> Pp.t) -> 'a Stdarg.and_short_name -> Pp.t
 val pr_or_by_notation : ('a -> Pp.t) -> 'a or_by_notation -> Pp.t
 
 val pr_evaluable_reference_env : env -> evaluable_global_reference -> Pp.t
@@ -153,5 +153,5 @@ val pr_value : tolerability -> Val.t -> Pp.t
 
 val ltop : tolerability
 
-val make_constr_printer : (env -> Evd.evar_map -> Notation_term.tolerability -> 'a -> Pp.t) ->
+val make_constr_printer : (env -> Evd.evar_map -> tolerability -> 'a -> Pp.t) ->
   'a Genprint.top_printer
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index d32a2fae..9f8cd2fc 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -26,7 +26,7 @@ open Classes
 open Constrexpr
 open Globnames
 open Evd
-open Misctypes
+open Tactypes
 open Locus
 open Locusops
 open Decl_kinds
@@ -104,9 +104,8 @@ let extends_undefined evars evars' =
 
 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 evars, t = Typing.solve_evars env evars (mkApp (fc, args)) in
+  (evars, cstrs), t
 
 let app_poly_nocheck env evars f args =
   let evars, fc = f evars in 
@@ -410,7 +409,7 @@ module TypeGlobal = struct
 
 
   let inverse env (evd,cstrs) car rel = 
-    let (evd, sort) = Evarutil.new_Type ~rigid:Evd.univ_flexible env evd in
+    let (evd, sort) = Evarutil.new_Type ~rigid:Evd.univ_flexible evd in
       app_poly_check env (evd,cstrs) coq_inverse [| car ; car; sort; rel |]
 
 end
@@ -428,7 +427,8 @@ let split_head = function
   | [] -> assert(false)
 
 let eq_pb (ty, env, x, y as pb) (ty', env', x', y' as pb') =
-  pb == pb' || (ty == ty' && Constr.equal x x' && Constr.equal y y')
+  let equal x y = Constr.equal (EConstr.Unsafe.to_constr x) (EConstr.Unsafe.to_constr y) in
+  pb == pb' || (ty == ty' && equal x x' && equal y y')
 
 let problem_inclusion x y =
   List.for_all (fun pb -> List.exists (fun pb' -> eq_pb pb pb') y) x
@@ -626,9 +626,9 @@ let solve_remaining_by env sigma holes by =
         (** 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 = EConstr.of_constr evi.evar_concl 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
+        Evd.define evk (EConstr.of_constr c) sigma
     in
     List.fold_left solve sigma indep
 
@@ -1468,8 +1468,8 @@ exception RewriteFailure of Pp.t
 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 sigma, sort = Typing.sort_of env sigma concl in
   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) = 
@@ -1773,11 +1773,11 @@ let rec strategy_of_ast = function
 
 (* By default the strategy for "rewrite_db" is top-down *)
 
-let mkappc s l = CAst.make @@ CAppExpl ((None,CAst.make @@ Libnames.Ident (Id.of_string s),None),l)
+let mkappc s l = CAst.make @@ CAppExpl ((None,qualid_of_ident (Id.of_string s),None),l)
 
 let declare_an_instance n s args =
   (((CAst.make @@ Name n),None), Explicit,
-   CAst.make @@ CAppExpl ((None, CAst.make @@ Qualid (qualid_of_string s),None), args))
+   CAst.make @@ CAppExpl ((None, qualid_of_string s,None), args))
 
 let declare_instance a aeq n s = declare_an_instance n s [a;aeq]
 
@@ -1791,17 +1791,17 @@ let anew_instance global binders instance fields =
 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
-       [(CAst.make @@ Ident (Id.of_string "reflexivity"),lemma)]
+       [(qualid_of_ident (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
-       [(CAst.make @@ Ident (Id.of_string "symmetry"),lemma)]
+       [(qualid_of_ident (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
-       [(CAst.make @@ Ident (Id.of_string "transitivity"),lemma)]
+       [(qualid_of_ident (Id.of_string "transitivity"),lemma)]
 
 let declare_relation ?locality ?(binders=[]) a aeq n refl symm trans =
   init_setoid ();
@@ -1825,16 +1825,16 @@ let declare_relation ?locality ?(binders=[]) a aeq n refl symm trans =
 	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PreOrder"
 	in ignore(
 	    anew_instance global binders instance
-              [(CAst.make @@ Ident (Id.of_string "PreOrder_Reflexive"), lemma1);
-               (CAst.make @@ Ident (Id.of_string "PreOrder_Transitive"),lemma3)])
+              [(qualid_of_ident (Id.of_string "PreOrder_Reflexive"), lemma1);
+               (qualid_of_ident (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
-              [(CAst.make @@ Ident (Id.of_string "PER_Symmetric"), lemma2);
-               (CAst.make @@ Ident (Id.of_string "PER_Transitive"),lemma3)])
+              [(qualid_of_ident (Id.of_string "PER_Symmetric"), lemma2);
+               (qualid_of_ident (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
@@ -1842,11 +1842,11 @@ let declare_relation ?locality ?(binders=[]) a aeq n refl symm trans =
 	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
 	in ignore(
 	  anew_instance global binders instance
-            [(CAst.make @@ Ident (Id.of_string "Equivalence_Reflexive"), lemma1);
-             (CAst.make @@ Ident (Id.of_string "Equivalence_Symmetric"), lemma2);
-             (CAst.make @@ Ident (Id.of_string "Equivalence_Transitive"), lemma3)])
+            [(qualid_of_ident (Id.of_string "Equivalence_Reflexive"), lemma1);
+             (qualid_of_ident (Id.of_string "Equivalence_Symmetric"), lemma2);
+             (qualid_of_ident (Id.of_string "Equivalence_Transitive"), lemma3)])
 
-let cHole = CAst.make @@ CHole (None, Misctypes.IntroAnonymous, None)
+let cHole = CAst.make @@ CHole (None, Namegen.IntroAnonymous, None)
 
 let proper_projection sigma r ty =
   let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i)) in
@@ -1862,7 +1862,6 @@ let declare_projection n instance_id r =
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let sigma,c = Evd.fresh_global env sigma r in
-  let c = EConstr.of_constr c in
   let ty = Retyping.get_type_of env sigma c in
   let term = proper_projection sigma c ty in
   let sigma, typ = Typing.type_of env sigma term in
@@ -1923,7 +1922,7 @@ let build_morphism_signature env sigma m =
   let evd = solve_constraints env !evd in
   let evd = Evd.minimize_universes evd in
   let m = Evarutil.nf_evars_universes evd (EConstr.Unsafe.to_constr morph) in
-  Pretyping.check_evars env Evd.empty evd (EConstr.of_constr m);
+  Pretyping.check_evars env (Evd.from_env env) evd (EConstr.of_constr m);
   Evd.evar_universe_context evd, m
 
 let default_morphism sign m =
@@ -1950,16 +1949,15 @@ let add_setoid global binders a aeq t n =
   let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
   in ignore(
     anew_instance global binders instance
-      [(CAst.make @@ Ident (Id.of_string "Equivalence_Reflexive"), mkappc "Seq_refl" [a;aeq;t]);
-       (CAst.make @@ Ident (Id.of_string "Equivalence_Symmetric"), mkappc "Seq_sym" [a;aeq;t]);
-       (CAst.make @@ Ident (Id.of_string "Equivalence_Transitive"), mkappc "Seq_trans" [a;aeq;t])])
+      [(qualid_of_ident (Id.of_string "Equivalence_Reflexive"), mkappc "Seq_refl" [a;aeq;t]);
+       (qualid_of_ident (Id.of_string "Equivalence_Symmetric"), mkappc "Seq_sym" [a;aeq;t]);
+       (qualid_of_ident (Id.of_string "Equivalence_Transitive"), mkappc "Seq_trans" [a;aeq;t])])
 
 
 let make_tactic name =
   let open Tacexpr in
-  let tacpath = Libnames.qualid_of_string name in
-  let tacname = CAst.make @@ Qualid tacpath in
-  TacArg (Loc.tag @@ (TacCall (Loc.tag (tacname, []))))
+  let tacqid = Libnames.qualid_of_string name in
+  TacArg (Loc.tag @@ (TacCall (Loc.tag (tacqid, []))))
 
 let warn_add_morphism_deprecated =
   CWarnings.create ~name:"add-morphism" ~category:"deprecated" (fun () ->
@@ -2009,7 +2007,7 @@ let add_morphism glob binders m s n =
   let instance =
     (((CAst.make @@ Name instance_id),None), Explicit,
     CAst.make @@ CAppExpl (
-             (None, CAst.make @@ Qualid (Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper"),None),
+             (None, Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper",None),
 	     [cHole; s; m]))
   in
   let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in
diff --git a/plugins/ltac/rewrite.mli b/plugins/ltac/rewrite.mli
index 1e3d4733..0d014a0b 100644
--- a/plugins/ltac/rewrite.mli
+++ b/plugins/ltac/rewrite.mli
@@ -12,9 +12,9 @@ open Names
 open Environ
 open EConstr
 open Constrexpr
-open Tacexpr
-open Misctypes
 open Evd
+open Tactypes
+open Tacexpr
 open Tacinterp
 
 (** TODO: document and clean me! *)
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index 6eb482b1..8a25d485 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -19,6 +19,14 @@ let make0 ?dyn name =
   let () = Geninterp.register_val0 wit dyn in
   wit
 
+let wit_intro_pattern = make0 "intropattern"
+let wit_quant_hyp = make0 "quant_hyp"
+let wit_constr_with_bindings = make0 "constr_with_bindings"
+let wit_open_constr_with_bindings = make0 "open_constr_with_bindings"
+let wit_bindings = make0 "bindings"
+let wit_quantified_hypothesis = wit_quant_hyp
+let wit_intropattern = wit_intro_pattern
+
 let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
   make0 "tactic"
 
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
index 5347eda7..bdb0be03 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -9,9 +9,33 @@
 (************************************************************************)
 
 open Genarg
-open Tacexpr
+open EConstr
 open Constrexpr
-open Misctypes
+open Tactypes
+open Tacexpr
+
+(** Tactic related witnesses, could also live in tactics/ if other users *)
+val wit_intro_pattern : (constr_expr intro_pattern_expr CAst.t, glob_constr_and_expr intro_pattern_expr CAst.t, intro_pattern) genarg_type
+
+val wit_quant_hyp : quantified_hypothesis uniform_genarg_type
+
+val wit_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings delayed_open) genarg_type
+
+val wit_open_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings delayed_open) genarg_type
+
+val wit_bindings :
+  (constr_expr bindings,
+  glob_constr_and_expr bindings,
+  constr bindings delayed_open) genarg_type
+
+val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
+val wit_intropattern : (constr_expr intro_pattern_expr CAst.t, glob_constr_and_expr intro_pattern_expr CAst.t, intro_pattern) genarg_type
 
 (** Generic arguments based on Ltac. *)
 
@@ -23,7 +47,7 @@ val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_typ
 val wit_ltac : (raw_tactic_expr, glob_tactic_expr, unit) genarg_type
 
 val wit_destruction_arg :
-  (constr_expr with_bindings Tacexpr.destruction_arg,
-   glob_constr_and_expr with_bindings Tacexpr.destruction_arg,
-   delayed_open_constr_with_bindings Tacexpr.destruction_arg) genarg_type
+  (constr_expr with_bindings Tactics.destruction_arg,
+   glob_constr_and_expr with_bindings Tactics.destruction_arg,
+   delayed_open_constr_with_bindings Tactics.destruction_arg) genarg_type
 
diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index 3812a2ba..026c00b8 100644
--- a/plugins/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -12,9 +12,11 @@ open Util
 open Names
 open Constr
 open EConstr
-open Misctypes
+open Namegen
+open Tactypes
 open Genarg
 open Stdarg
+open Tacarg
 open Geninterp
 open Pp
 
@@ -163,8 +165,7 @@ let coerce_var_to_ident fresh env sigma v =
 (* Interprets, if possible, a constr to an identifier which may not
    be fresh but suitable to be given to the fresh tactic. Works for
    vars, constants, inductive, constructors and sorts. *)
-let coerce_to_ident_not_fresh env sigma v =
-let g = sigma in
+let coerce_to_ident_not_fresh sigma v =
 let id_of_name = function
   | Name.Anonymous -> Id.of_string "x"
   | Name.Name x -> x in
@@ -181,9 +182,9 @@ let id_of_name = function
     | Some c ->
        match EConstr.kind sigma c with
        | Var id -> id 
-       | Meta m -> id_of_name (Evd.meta_name g m)
+       | Meta m -> id_of_name (Evd.meta_name sigma m)
        | Evar (kn,_) ->
-        begin match Evd.evar_ident kn g with
+        begin match Evd.evar_ident kn sigma with
         | None -> fail ()
         | Some id -> id
         end
@@ -197,15 +198,16 @@ let id_of_name = function
 	  let basename = Nametab.basename_of_global ref in
 	  basename
        | Sort s ->
-	  begin
+          begin
 	    match ESorts.kind sigma s with
-	    | Sorts.Prop _ -> Label.to_id (Label.make "Prop")
-	    | Sorts.Type _ -> Label.to_id (Label.make "Type")
-	  end
+            | Sorts.Prop -> Label.to_id (Label.make "Prop")
+            | Sorts.Set -> Label.to_id (Label.make "Set")
+            | Sorts.Type _ -> Label.to_id (Label.make "Type")
+          end
        | _ -> fail()
 
 
-let coerce_to_intro_pattern env sigma v =
+let coerce_to_intro_pattern sigma v =
   if has_type v (topwit wit_intro_pattern) then
     (out_gen (topwit wit_intro_pattern) v).CAst.v
   else if has_type v (topwit wit_var) then
@@ -218,8 +220,8 @@ let coerce_to_intro_pattern env sigma v =
       IntroNaming (IntroIdentifier (destVar sigma c))
   | _ -> raise (CannotCoerceTo "an introduction pattern")
 
-let coerce_to_intro_pattern_naming env sigma v =
-  match coerce_to_intro_pattern env sigma v with
+let coerce_to_intro_pattern_naming sigma v =
+  match coerce_to_intro_pattern sigma v with
   | IntroNaming pat -> pat
   | _ -> raise (CannotCoerceTo "a naming introduction pattern")
 
@@ -252,7 +254,7 @@ let coerce_to_constr env v =
     (try [], constr_of_id env id with Not_found -> fail ())
   else fail ()
 
-let coerce_to_uconstr env v =
+let coerce_to_uconstr v =
   if has_type v (topwit wit_uconstr) then
     out_gen (topwit wit_uconstr) v
   else
@@ -296,11 +298,11 @@ let coerce_to_constr_list env v =
     List.map map l
   | None -> raise (CannotCoerceTo "a term list")
 
-let coerce_to_intro_pattern_list ?loc env sigma v =
+let coerce_to_intro_pattern_list ?loc sigma v =
   match Value.to_list v with
   | None -> raise (CannotCoerceTo "an intro pattern list")
   | Some l ->
-    let map v = CAst.make ?loc @@ coerce_to_intro_pattern env sigma v in
+    let map v = CAst.make ?loc @@ coerce_to_intro_pattern sigma v in
     List.map map l
 
 let coerce_to_hyp env sigma v =
@@ -325,7 +327,7 @@ let coerce_to_hyp_list env sigma v =
   | None -> raise (CannotCoerceTo "a variable list")
 
 (* Interprets a qualified name *)
-let coerce_to_reference env sigma v =
+let coerce_to_reference sigma v =
   match Value.to_constr v with
   | Some c ->
     begin
@@ -353,7 +355,7 @@ let coerce_to_quantified_hypothesis sigma v =
 
 (* Quantified named or numbered hypothesis or hypothesis in context *)
 (* (as in Inversion) *)
-let coerce_to_decl_or_quant_hyp env sigma v =
+let coerce_to_decl_or_quant_hyp sigma v =
   if has_type v (topwit wit_int) then
     AnonHyp (out_gen (topwit wit_int) v)
   else
@@ -365,7 +367,7 @@ let coerce_to_int_or_var_list v =
   match Value.to_list v with
   | None -> raise (CannotCoerceTo "an int list")
   | Some l ->
-    let map n = ArgArg (coerce_to_int n) in
+    let map n = Locus.ArgArg (coerce_to_int n) in
     List.map map l
 
 (** Abstract application, to print ltac functions *)
diff --git a/plugins/ltac/taccoerce.mli b/plugins/ltac/taccoerce.mli
index 1fa5e3c0..d2ae92f6 100644
--- a/plugins/ltac/taccoerce.mli
+++ b/plugins/ltac/taccoerce.mli
@@ -11,9 +11,9 @@
 open Util
 open Names
 open EConstr
-open Misctypes
 open Genarg
 open Geninterp
+open Tactypes
 
 (** Coercions from highest level generic arguments to actual data used by Ltac
     interpretation. Those functions examinate dynamic types and try to return
@@ -51,12 +51,12 @@ val coerce_to_constr_context : Value.t -> constr
 
 val coerce_var_to_ident : bool -> Environ.env -> Evd.evar_map -> Value.t -> Id.t
 
-val coerce_to_ident_not_fresh : Environ.env -> Evd.evar_map -> Value.t -> Id.t
+val coerce_to_ident_not_fresh : Evd.evar_map -> Value.t -> Id.t
 
-val coerce_to_intro_pattern : Environ.env -> Evd.evar_map -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
+val coerce_to_intro_pattern : Evd.evar_map -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
 
 val coerce_to_intro_pattern_naming :
-  Environ.env -> Evd.evar_map -> Value.t -> intro_pattern_naming_expr
+  Evd.evar_map -> Value.t -> Namegen.intro_pattern_naming_expr
 
 val coerce_to_hint_base : Value.t -> string
 
@@ -64,7 +64,7 @@ val coerce_to_int : Value.t -> int
 
 val coerce_to_constr : Environ.env -> Value.t -> Ltac_pretype.constr_under_binders
 
-val coerce_to_uconstr : Environ.env -> Value.t -> Ltac_pretype.closed_glob_constr
+val coerce_to_uconstr : Value.t -> Ltac_pretype.closed_glob_constr
 
 val coerce_to_closed_constr : Environ.env -> Value.t -> constr
 
@@ -74,19 +74,19 @@ val coerce_to_evaluable_ref :
 val coerce_to_constr_list : Environ.env -> Value.t -> constr list
 
 val coerce_to_intro_pattern_list :
-  ?loc:Loc.t -> Environ.env -> Evd.evar_map -> Value.t -> Tacexpr.intro_patterns
+  ?loc:Loc.t -> Evd.evar_map -> Value.t -> Tacexpr.intro_patterns
 
 val coerce_to_hyp : Environ.env -> Evd.evar_map -> Value.t -> Id.t
 
 val coerce_to_hyp_list : Environ.env -> Evd.evar_map -> Value.t -> Id.t list
 
-val coerce_to_reference : Environ.env -> Evd.evar_map -> Value.t -> Globnames.global_reference
+val coerce_to_reference : Evd.evar_map -> Value.t -> GlobRef.t
 
 val coerce_to_quantified_hypothesis : Evd.evar_map -> Value.t -> quantified_hypothesis
 
-val coerce_to_decl_or_quant_hyp : Environ.env -> Evd.evar_map -> Value.t -> quantified_hypothesis
+val coerce_to_decl_or_quant_hyp : Evd.evar_map -> Value.t -> quantified_hypothesis
 
-val coerce_to_int_or_var_list : Value.t -> int or_var list
+val coerce_to_int_or_var_list : Value.t -> int Locus.or_var list
 
 (** {5 Missing generic arguments} *)
 
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index e510b9f5..636cb8eb 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -45,7 +45,7 @@ let coincide s pat off =
 
 let atactic n =
   if n = 5 then Aentry Pltac.binder_tactic
-  else Aentryl (Pltac.tactic_expr, n)
+  else Aentryl (Pltac.tactic_expr, string_of_int n)
 
 type entry_name = EntryName :
   'a raw_abstract_argument_type * (Tacexpr.raw_tactic_expr, 'a) Extend.symbol -> entry_name
@@ -252,7 +252,7 @@ type tactic_grammar_obj = {
   tacobj_key : KerName.t;
   tacobj_local : locality_flag;
   tacobj_tacgram : tactic_grammar;
-  tacobj_body : Id.t list * Tacexpr.glob_tactic_expr;
+  tacobj_body : Tacenv.alias_tactic;
   tacobj_forml : bool;
 }
 
@@ -288,10 +288,11 @@ let load_tactic_notation i (_, tobj) =
     extend_tactic_grammar key tobj.tacobj_forml tobj.tacobj_tacgram
 
 let subst_tactic_notation (subst, tobj) =
-  let (ids, body) = tobj.tacobj_body in
+  let open Tacenv in
+  let alias = tobj.tacobj_body in
   { tobj with
     tacobj_key = Mod_subst.subst_kn subst tobj.tacobj_key;
-    tacobj_body = (ids, Tacsubst.subst_tactic subst body);
+    tacobj_body = { alias with alias_body = Tacsubst.subst_tactic subst alias.alias_body };
   }
 
 let classify_tactic_notation tacobj = Substitute tacobj
@@ -308,25 +309,26 @@ let cons_production_parameter = function
 | TacTerm _ -> None
 | TacNonTerm (_, (_, ido)) -> ido
 
-let add_glob_tactic_notation local ~level prods forml ids tac =
+let add_glob_tactic_notation local ~level ?deprecation prods forml ids tac =
   let parule = {
     tacgram_level = level;
     tacgram_prods = prods;
   } in
+  let open Tacenv in
   let tacobj = {
     tacobj_key = make_fresh_key prods;
     tacobj_local = local;
     tacobj_tacgram = parule;
-    tacobj_body = (ids, tac);
+    tacobj_body = { alias_args = ids; alias_body = tac; alias_deprecation = deprecation };
     tacobj_forml = forml;
   } in
   Lib.add_anonymous_leaf (inTacticGrammar tacobj)
 
-let add_tactic_notation local n prods e =
+let add_tactic_notation local n ?deprecation prods e =
   let ids = List.map_filter cons_production_parameter prods in
   let prods = List.map interp_prod_item prods in
   let tac = Tacintern.glob_tactic_env ids (Global.env()) e in
-  add_glob_tactic_notation local ~level:n prods false ids tac
+  add_glob_tactic_notation local ~level:n ?deprecation prods false ids tac
 
 (**********************************************************************)
 (* ML Tactic entries                                                  *)
@@ -366,7 +368,7 @@ let extend_atomic_tactic name entries =
   in
   List.iteri add_atomic entries
 
-let add_ml_tactic_notation name ~level prods =
+let add_ml_tactic_notation name ~level ?deprecation prods =
   let len = List.length prods in
   let iter i prods =
     let open Tacexpr in
@@ -376,9 +378,9 @@ let add_ml_tactic_notation name ~level prods =
     in
     let ids = List.map_filter get_id prods in
     let entry = { mltac_name = name; mltac_index = len - i - 1 } in
-    let map id = Reference (Misctypes.ArgVar (CAst.make id)) in
+    let map id = Reference (Locus.ArgVar (CAst.make id)) in
     let tac = TacML (Loc.tag (entry, List.map map ids)) in
-    add_glob_tactic_notation false ~level prods true ids tac
+    add_glob_tactic_notation false ~level ?deprecation prods true ids tac
   in
   List.iteri iter (List.rev prods);
   (** We call [extend_atomic_tactic] only for "basic tactics" (the ones at
@@ -398,7 +400,7 @@ let create_ltac_quotation name cast (e, l) =
   let () = ltac_quotations := String.Set.add name !ltac_quotations in
   let entry = match l with
   | None -> Aentry e
-  | Some l -> Aentryl (e, l)
+  | Some l -> Aentryl (e, string_of_int l)
   in
 (*   let level = Some "1" in *)
   let level = None in
@@ -430,7 +432,7 @@ let warn_unusable_identifier =
       (fun id -> strbrk "The Ltac name" ++ spc () ++ Id.print id ++ spc () ++
         strbrk "may be unusable because of a conflict with a notation.")
 
-let register_ltac local tacl =
+let register_ltac local ?deprecation tacl =
   let map tactic_body =
     match tactic_body with
     | Tacexpr.TacticDefinition ({CAst.loc;v=id}, body) ->
@@ -449,12 +451,12 @@ let register_ltac local tacl =
         in
         let () = if is_shadowed then warn_unusable_identifier id in
         NewTac id, body
-    | Tacexpr.TacticRedefinition (ident, body) ->
+    | Tacexpr.TacticRedefinition (qid, body) ->
         let kn =
-          try Tacenv.locate_tactic (qualid_of_reference ident).CAst.v
+          try Tacenv.locate_tactic qid
           with Not_found ->
-            CErrors.user_err ?loc:ident.CAst.loc
-                       (str "There is no Ltac named " ++ pr_reference ident ++ str ".")
+            CErrors.user_err ?loc:qid.CAst.loc
+                       (str "There is no Ltac named " ++ pr_qualid qid ++ str ".")
         in
         UpdateTac kn, body
   in
@@ -483,10 +485,10 @@ let register_ltac local tacl =
   let defs = States.with_state_protection defs () in
   let iter (def, tac) = match def with
   | NewTac id ->
-    Tacenv.register_ltac false local id tac;
+    Tacenv.register_ltac false local id tac ?deprecation;
     Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is defined")
   | UpdateTac kn ->
-    Tacenv.redefine_ltac local kn tac;
+    Tacenv.redefine_ltac local kn tac ?deprecation;
     let name = Tacenv.shortest_qualid_of_tactic kn in
     Flags.if_verbose Feedback.msg_info (Libnames.pr_qualid name ++ str " is redefined")
   in
@@ -554,13 +556,18 @@ let () =
   ] in
   register_grammars_by_name "tactic" entries
 
+let get_identifier id =
+  (** Workaround for badly-designed generic arguments lacking a closure *)
+  Names.Id.of_string_soft ("$" ^ id)
+
+
 type _ ty_sig =
 | TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
 | TyIdent : string * 'r ty_sig -> 'r ty_sig
 | TyArg :
-  (('a, 'b, 'c) Extend.ty_user_symbol * Id.t) Loc.located * 'r ty_sig -> ('c -> 'r) ty_sig
+  ('a, 'b, 'c) Extend.ty_user_symbol * string * 'r ty_sig -> ('c -> 'r) ty_sig
 | TyAnonArg :
-  ('a, 'b, 'c) Extend.ty_user_symbol Loc.located * 'r ty_sig -> 'r ty_sig
+  ('a, 'b, 'c) Extend.ty_user_symbol * 'r ty_sig -> 'r ty_sig
 
 type ty_ml = TyML : 'r ty_sig * 'r -> ty_ml
 
@@ -578,23 +585,15 @@ let rec clause_of_sign : type a. a ty_sig -> Genarg.ArgT.any Extend.user_symbol
   fun sign -> match sign with
   | TyNil -> []
   | TyIdent (s, sig') -> TacTerm s :: clause_of_sign sig'
-  | TyArg ((loc,(a,id)),sig') ->
-    TacNonTerm (loc,(untype_user_symbol a,Some id)) :: clause_of_sign sig'
-  | TyAnonArg ((loc,a),sig') ->
-    TacNonTerm (loc,(untype_user_symbol a,None)) :: clause_of_sign sig'
+  | TyArg (a, id, sig') ->
+    let id = get_identifier id in
+    TacNonTerm (None,(untype_user_symbol a,Some id)) :: clause_of_sign sig'
+  | TyAnonArg (a, sig') ->
+    TacNonTerm (None,(untype_user_symbol a,None)) :: clause_of_sign sig'
 
 let clause_of_ty_ml = function
   | TyML (t,_) -> clause_of_sign t
 
-let rec prj : type a b c. (a,b,c) Extend.ty_user_symbol -> (a,b,c) genarg_type = function
-  | TUentry a -> ExtraArg a
-  | TUentryl (a,l) -> ExtraArg a
-  | TUopt(o) -> OptArg (prj o)
-  | TUlist1 l -> ListArg (prj l)
-  | TUlist1sep (l,_) -> ListArg (prj l)
-  | TUlist0 l -> ListArg (prj l)
-  | TUlist0sep (l,_) -> ListArg (prj l)
-
 let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic =
   fun sign tac ->
     match sign with
@@ -604,15 +603,15 @@ let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.i
       | _ :: _ -> assert false
       end
     | TyIdent (s, sig') -> eval_sign sig' tac
-    | TyArg ((_loc,(a,id)), sig') ->
+    | TyArg (a, _, sig') ->
       let f = eval_sign sig' in
       begin fun tac vals ist -> match vals with
       | [] -> assert false
       | v :: vals ->
-        let v' = Taccoerce.Value.cast (topwit (prj a)) v in
+        let v' = Taccoerce.Value.cast (topwit (Egramml.proj_symbol a)) v in
         f (tac v') vals ist
       end tac
-    | TyAnonArg ((_loc,a), sig') -> eval_sign sig' tac
+    | TyAnonArg (a, sig') -> eval_sign sig' tac
 
 let eval : ty_ml -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic = function
   | TyML (t,tac) -> eval_sign t tac
@@ -624,14 +623,14 @@ let is_constr_entry = function
 let rec only_constr : type a. a ty_sig -> bool = function
 | TyNil -> true
 | TyIdent(_,_) -> false
-| TyArg((_,(u,_)),s) -> if is_constr_entry u then only_constr s else false
-| TyAnonArg((_,u),s) -> if is_constr_entry u then only_constr s else false
+| TyArg (u, _, s) -> if is_constr_entry u then only_constr s else false
+| TyAnonArg (u, s) -> if is_constr_entry u then only_constr s else false
 
 let rec mk_sign_vars : type a. a ty_sig -> Name.t list = function
 | TyNil -> []
 | TyIdent (_,s) -> mk_sign_vars s
-| TyArg((_,(_,name)),s) -> Name name :: mk_sign_vars s
-| TyAnonArg((_,_),s) -> Anonymous :: mk_sign_vars s
+| TyArg (_, name, s) -> Name (get_identifier name) :: mk_sign_vars s
+| TyAnonArg (_, s) -> Anonymous :: mk_sign_vars s
 
 let dummy_id = Id.of_string "_"
 
@@ -652,7 +651,7 @@ let lift_constr_tac_to_ml_tac vars tac =
   end in
   tac
 
-let tactic_extend plugin_name tacname ~level sign =
+let tactic_extend plugin_name tacname ~level ?deprecation sign =
   let open Tacexpr in
   let ml_tactic_name =
     { mltac_tactic = tacname;
@@ -681,10 +680,10 @@ let tactic_extend plugin_name tacname ~level sign =
       This is the rôle of the [lift_constr_tac_to_ml_tac] function. *)
     let body = Tacexpr.TacFun (vars, Tacexpr.TacML (Loc.tag (ml, [])))in
     let id = Names.Id.of_string name in
-    let obj () = Tacenv.register_ltac true false id body in
+    let obj () = Tacenv.register_ltac true false id body ?deprecation in
     let () = Tacenv.register_ml_tactic ml_tactic_name [|tac|] in
     Mltop.declare_cache_obj obj plugin_name
   | _ ->
-  let obj () = add_ml_tactic_notation ml_tactic_name ~level (List.map clause_of_ty_ml sign) in
+  let obj () = add_ml_tactic_notation ml_tactic_name ~level ?deprecation (List.map clause_of_ty_ml sign) in
   Tacenv.register_ml_tactic ml_tactic_name @@ Array.of_list (List.map eval sign);
   Mltop.declare_cache_obj obj plugin_name
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index 3f804ee8..138a584e 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -12,10 +12,12 @@
 
 open Vernacexpr
 open Tacexpr
+open Vernacinterp
 
 (** {5 Tactic Definitions} *)
 
-val register_ltac : locality_flag -> Tacexpr.tacdef_body list -> unit
+val register_ltac : locality_flag -> ?deprecation:deprecation ->
+  Tacexpr.tacdef_body list -> unit
 (** Adds new Ltac definitions to the environment. *)
 
 (** {5 Tactic Notations} *)
@@ -34,8 +36,8 @@ type argument = Genarg.ArgT.any Extend.user_symbol
     leaves. *)
 
 val add_tactic_notation :
-  locality_flag -> int -> raw_argument grammar_tactic_prod_item_expr list ->
-  raw_tactic_expr -> unit
+  locality_flag -> int -> ?deprecation:deprecation -> raw_argument
+  grammar_tactic_prod_item_expr list -> raw_tactic_expr -> unit
 (** [add_tactic_notation local level prods expr] adds a tactic notation in the
     environment at level [level] with locality [local] made of the grammar
     productions [prods] and returning the body [expr] *)
@@ -47,7 +49,7 @@ val register_tactic_notation_entry : string -> ('a, 'b, 'c) Genarg.genarg_type -
     to finding an argument by name (as in {!Genarg}) if there is none
     matching. *)
 
-val add_ml_tactic_notation : ml_tactic_name -> level:int ->
+val add_ml_tactic_notation : ml_tactic_name -> level:int -> ?deprecation:deprecation ->
   argument grammar_tactic_prod_item_expr list list -> unit
 (** A low-level variant of {!add_tactic_notation} used by the TACTIC EXTEND
     ML-side macro. *)
@@ -55,7 +57,7 @@ val add_ml_tactic_notation : ml_tactic_name -> level:int ->
 (** {5 Tactic Quotations} *)
 
 val create_ltac_quotation : string ->
-  ('grm Loc.located -> raw_tactic_arg) -> ('grm Pcoq.Gram.entry * int option) -> unit
+  ('grm Loc.located -> raw_tactic_arg) -> ('grm Pcoq.Entry.t * int option) -> unit
 (** [create_ltac_quotation name f e] adds a quotation rule to Ltac, that is,
     Ltac grammar now accepts arguments of the form ["name" ":" "(" <e> ")"], and
     generates an argument using [f] on the entry parsed by [e]. *)
@@ -65,17 +67,18 @@ val create_ltac_quotation : string ->
 val print_ltacs : unit -> unit
 (** Display the list of ltac definitions currently available. *)
 
-val print_located_tactic : Libnames.reference -> unit
+val print_located_tactic : Libnames.qualid -> unit
 (** Display the absolute name of a tactic. *)
 
 type _ ty_sig =
 | TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
 | TyIdent : string * 'r ty_sig -> 'r ty_sig
 | TyArg :
-  (('a, 'b, 'c) Extend.ty_user_symbol * Names.Id.t) Loc.located * 'r ty_sig -> ('c -> 'r) ty_sig
+  ('a, 'b, 'c) Extend.ty_user_symbol * string * 'r ty_sig -> ('c -> 'r) ty_sig
 | TyAnonArg :
-  ('a, 'b, 'c) Extend.ty_user_symbol Loc.located * 'r ty_sig -> 'r ty_sig
+  ('a, 'b, 'c) Extend.ty_user_symbol * 'r ty_sig -> 'r ty_sig
 
 type ty_ml = TyML : 'r ty_sig * 'r -> ty_ml
 
-val tactic_extend : string -> string -> level:Int.t -> ty_ml list -> unit
+val tactic_extend : string -> string -> level:Int.t ->
+  ?deprecation:deprecation -> ty_ml list -> unit
diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index d5ab2d69..1f2c722b 100644
--- a/plugins/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -52,7 +52,11 @@ let shortest_qualid_of_tactic kn =
 (** Tactic notations (TacAlias) *)
 
 type alias = KerName.t
-type alias_tactic = Id.t list * glob_tactic_expr
+type alias_tactic =
+  { alias_args: Id.t list;
+    alias_body: glob_tactic_expr;
+    alias_deprecation: Vernacinterp.deprecation option;
+  }
 
 let alias_map = Summary.ref ~name:"tactic-alias"
   (KNmap.empty : alias_tactic KNmap.t)
@@ -118,6 +122,7 @@ type ltac_entry = {
   tac_for_ml : bool;
   tac_body : glob_tactic_expr;
   tac_redef : ModPath.t list;
+  tac_deprecation : Vernacinterp.deprecation option
 }
 
 let mactab =
@@ -130,43 +135,51 @@ 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
+let add ~deprecation kn b t =
+  let entry = { tac_for_ml = b;
+                tac_body = t;
+                tac_redef = [];
+                tac_deprecation = deprecation;
+              } in
   mactab := KNmap.add kn entry !mactab
 
 let replace kn path t =
-  let (path, _, _) = KerName.repr path in
+  let path = KerName.modpath 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
+let tac_deprecation kn =
+  try (KNmap.find kn !mactab).tac_deprecation with Not_found -> None
+
+let load_md i ((sp, kn), (local, id, b, t, deprecation)) = match id with
 | None ->
   let () = if not local then push_tactic (Until i) sp kn in
-  add kn b t
+  add ~deprecation kn b t
 | Some kn0 -> replace kn0 kn t
 
-let open_md i ((sp, kn), (local, id, b, t)) = match id with
+let open_md i ((sp, kn), (local, id, b, t, deprecation)) = match id with
 | None ->
   let () = if not local then push_tactic (Exactly i) sp kn in
-  add kn b t
+  add ~deprecation kn b t
 | Some kn0 -> replace kn0 kn t
 
-let cache_md ((sp, kn), (local, id ,b, t)) = match id with
+let cache_md ((sp, kn), (local, id ,b, t, deprecation)) = match id with
 | None ->
   let () = push_tactic (Until 1) sp kn in
-  add kn b t
+  add ~deprecation 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 subst_md (subst, (local, id, b, t, deprecation)) =
+  (local, subst_kind subst id, b, Tacsubst.subst_tactic subst t, deprecation)
 
-let classify_md (local, _, _, _ as o) = Substitute o
+let classify_md (local, _, _, _, _ as o) = Substitute o
 
-let inMD : bool * ltac_constant option * bool * glob_tactic_expr -> obj =
+let inMD : bool * ltac_constant option * bool * glob_tactic_expr *
+           Vernacinterp.deprecation option -> obj =
   declare_object {(default_object "TAC-DEFINITION") with
      cache_function  = cache_md;
      load_function   = load_md;
@@ -174,8 +187,8 @@ let inMD : bool * ltac_constant option * bool * glob_tactic_expr -> obj =
      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 register_ltac for_ml local ?deprecation id tac =
+  ignore (Lib.add_leaf id (inMD (local, None, for_ml, tac, deprecation)))
 
-let redefine_ltac local kn tac =
-  Lib.add_anonymous_leaf (inMD (local, Some kn, false, tac))
+let redefine_ltac local ?deprecation kn tac =
+  Lib.add_anonymous_leaf (inMD (local, Some kn, false, tac, deprecation))
diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index e0bac67d..d5d36c97 100644
--- a/plugins/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -12,6 +12,7 @@ open Names
 open Libnames
 open Tacexpr
 open Geninterp
+open Vernacinterp
 
 (** This module centralizes the various ways of registering tactics. *)
 
@@ -29,7 +30,11 @@ val shortest_qualid_of_tactic : ltac_constant -> qualid
 type alias = KerName.t
 (** Type of tactic alias, used in the [TacAlias] node. *)
 
-type alias_tactic = Id.t list * glob_tactic_expr
+type alias_tactic =
+  { alias_args: Id.t list;
+    alias_body: glob_tactic_expr;
+    alias_deprecation: Vernacinterp.deprecation option;
+  }
 (** Contents of a tactic notation *)
 
 val register_alias : alias -> alias_tactic -> unit
@@ -43,7 +48,8 @@ val check_alias : alias -> bool
 
 (** {5 Coq tactic definitions} *)
 
-val register_ltac : bool -> bool -> Id.t -> glob_tactic_expr -> unit
+val register_ltac : bool -> bool -> ?deprecation:deprecation -> 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
@@ -51,7 +57,8 @@ val register_ltac : bool -> bool -> Id.t -> glob_tactic_expr -> unit
     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
+val redefine_ltac : bool -> ?deprecation:deprecation -> 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. *)
 
@@ -61,6 +68,9 @@ val interp_ltac : KerName.t -> glob_tactic_expr
 val is_ltac_for_ml_tactic : KerName.t -> bool
 (** Whether the tactic is defined from ML-side *)
 
+val tac_deprecation : KerName.t -> deprecation option
+(** The tactic deprecation notice, if any *)
+
 type ltac_entry = {
   tac_for_ml : bool;
   (** Whether the tactic is defined from ML-side *)
@@ -68,6 +78,8 @@ type ltac_entry = {
   (** The current body of the tactic *)
   tac_redef : ModPath.t list;
   (** List of modules redefining the tactic in reverse chronological order *)
+  tac_deprecation : deprecation option;
+  (** Deprecation notice to be printed when the tactic is used *)
 }
 
 val ltac_entries : unit -> ltac_entry KNmap.t
diff --git a/plugins/ltac/tacexpr.ml b/plugins/ltac/tacexpr.ml
index 8b0c4404..11d13d3a 100644
--- a/plugins/ltac/tacexpr.ml
+++ b/plugins/ltac/tacexpr.ml
@@ -15,7 +15,7 @@ open Libnames
 open Genredexpr
 open Genarg
 open Pattern
-open Misctypes
+open Tactypes
 open Locus
 
 type ltac_constant = KerName.t
@@ -35,30 +35,46 @@ type advanced_flag = bool  (* true = advanced         false = basic *)
 type letin_flag = bool     (* true = use local def    false = use Leibniz *)
 type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
 
-type goal_selector = Vernacexpr.goal_selector =
+type goal_selector = Goal_select.t =
+  | SelectAlreadyFocused
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectNth of int
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectList of (int * int) list
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectId of Id.t
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectAll
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
+[@@ocaml.deprecated "Use [Goal_select.t]"]
 
-type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg =
+type 'a core_destruction_arg = 'a Tactics.core_destruction_arg =
   | ElimOnConstr of 'a
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
   | ElimOnIdent of lident
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
   | ElimOnAnonHyp of int
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
+[@@ocaml.deprecated "Use Tactics.core_destruction_arg"]
 
 type 'a destruction_arg =
-  clear_flag * 'a core_destruction_arg
+  clear_flag * 'a Tactics.core_destruction_arg
+[@@ocaml.deprecated "Use Tactics.destruction_arg"]
 
-type inversion_kind = Misctypes.inversion_kind =
+type inversion_kind = Inv.inversion_kind =
   | SimpleInversion
+    [@ocaml.deprecated "Use constructors in [Inv]"]
   | FullInversion
+    [@ocaml.deprecated "Use constructors in [Inv]"]
   | FullInversionClear
+    [@ocaml.deprecated "Use constructors in [Inv]"]
+[@@ocaml.deprecated "Use Tactics.inversion_kind"]
 
 type ('c,'d,'id) inversion_strength =
   | NonDepInversion of
-      inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
+      Inv.inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
   | DepInversion of
-      inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
+      Inv.inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
   | InversionUsing of 'c * 'id list
 
 type ('a,'b) location = HypLocation of 'a | ConclLocation of 'b
@@ -69,8 +85,8 @@ type 'id message_token =
   | MsgIdent of 'id
 
 type ('dconstr,'id) induction_clause =
-    'dconstr with_bindings destruction_arg *
-    (intro_pattern_naming_expr CAst.t option (* eqn:... *)
+    'dconstr with_bindings Tactics.destruction_arg *
+    (Namegen.intro_pattern_naming_expr CAst.t option (* eqn:... *)
     * 'dconstr or_and_intro_pattern_expr CAst.t or_var option) (* as ... *)
     * 'id clause_expr option (* in ... *)
 
@@ -112,7 +128,7 @@ type ml_tactic_entry = {
 
 (** Composite types *)
 
-type glob_constr_and_expr = Tactypes.glob_constr_and_expr
+type glob_constr_and_expr = Genintern.glob_constr_and_expr
 
 type open_constr_expr = unit * constr_expr
 type open_glob_constr = unit * glob_constr_and_expr
@@ -129,7 +145,7 @@ type delayed_open_constr = EConstr.constr delayed_open
 type intro_pattern = delayed_open_constr intro_pattern_expr CAst.t
 type intro_patterns = delayed_open_constr intro_pattern_expr CAst.t list
 type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr CAst.t
-type intro_pattern_naming = intro_pattern_naming_expr CAst.t
+type intro_pattern_naming = Namegen.intro_pattern_naming_expr CAst.t
 
 (** Generic expressions for atomic tactics *)
 
@@ -147,7 +163,7 @@ type 'a gen_atomic_tactic_expr =
       'dtrm intro_pattern_expr CAst.t option * 'trm
   | TacGeneralize of ('trm with_occurrences * Name.t) list
   | TacLetTac of evars_flag * Name.t * 'trm * 'nam clause_expr * letin_flag *
-      intro_pattern_naming_expr CAst.t option
+      Namegen.intro_pattern_naming_expr CAst.t option
 
   (* Derived basic tactics *)
   | TacInductionDestruct of
@@ -159,7 +175,7 @@ type 'a gen_atomic_tactic_expr =
 
   (* Equality and inversion *)
   | TacRewrite of evars_flag *
-      (bool * multi * 'dtrm with_bindings_arg) list * 'nam clause_expr *
+      (bool * Equality.multi * 'dtrm with_bindings_arg) list * 'nam clause_expr *
       (* spiwack: using ['dtrm] here is a small hack, may not be
          stable by a change in the representation of delayed
          terms. Because, in fact, it is the whole "with_bindings"
@@ -265,7 +281,7 @@ and 'a gen_tactic_expr =
       ('p,'a gen_tactic_expr) match_rule list
   | TacFun of 'a gen_tactic_fun_ast
   | TacArg of 'a gen_tactic_arg located
-  | TacSelect of goal_selector * 'a gen_tactic_expr
+  | TacSelect of Goal_select.t * 'a gen_tactic_expr
   (* For ML extensions *)
   | TacML of (ml_tactic_entry * 'a gen_tactic_arg list) Loc.located
   (* For syntax extensions *)
@@ -300,7 +316,7 @@ constraint 'a = <
 
 type g_trm = glob_constr_and_expr
 type g_pat = glob_constr_pattern_and_expr
-type g_cst = evaluable_global_reference and_short_name or_var
+type g_cst = evaluable_global_reference Stdarg.and_short_name or_var
 type g_ref = ltac_constant located or_var
 type g_nam = lident
 
@@ -328,8 +344,8 @@ type glob_tactic_arg =
 
 type r_trm = constr_expr
 type r_pat = constr_pattern_expr
-type r_cst = reference or_by_notation
-type r_ref = reference
+type r_cst = qualid or_by_notation
+type r_ref = qualid
 type r_nam = lident
 type r_lev = rlevel
 
@@ -393,5 +409,5 @@ type ltac_call_kind =
 type ltac_trace = ltac_call_kind Loc.located list
 
 type tacdef_body =
-  | TacticDefinition of lident * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
-  | TacticRedefinition of reference * raw_tactic_expr       (* indicates that user employed '::=' in Ltac body *)
+  | TacticDefinition of lident * raw_tactic_expr (* indicates that user employed ':=' in Ltac body *)
+  | TacticRedefinition of qualid * raw_tactic_expr (* indicates that user employed '::=' in Ltac body *)
diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 8b0c4404..6b131eda 100644
--- a/plugins/ltac/tacexpr.mli
+++ b/plugins/ltac/tacexpr.mli
@@ -15,8 +15,8 @@ open Libnames
 open Genredexpr
 open Genarg
 open Pattern
-open Misctypes
 open Locus
+open Tactypes
 
 type ltac_constant = KerName.t
 
@@ -35,30 +35,46 @@ type advanced_flag = bool  (* true = advanced         false = basic *)
 type letin_flag = bool     (* true = use local def    false = use Leibniz *)
 type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
 
-type goal_selector = Vernacexpr.goal_selector =
+type goal_selector = Goal_select.t =
+  | SelectAlreadyFocused
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectNth of int
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectList of (int * int) list
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectId of Id.t
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
   | SelectAll
+    [@ocaml.deprecated "Use constructors in [Goal_select]"]
+[@@ocaml.deprecated "Use Vernacexpr.goal_selector"]
 
-type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg =
+type 'a core_destruction_arg = 'a Tactics.core_destruction_arg =
   | ElimOnConstr of 'a
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
   | ElimOnIdent of lident
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
   | ElimOnAnonHyp of int
+    [@ocaml.deprecated "Use constructors in [Tactics]"]
+[@@ocaml.deprecated "Use Tactics.core_destruction_arg"]
 
 type 'a destruction_arg =
-  clear_flag * 'a core_destruction_arg
+  clear_flag * 'a Tactics.core_destruction_arg
+[@@ocaml.deprecated "Use Tactics.destruction_arg"]
 
-type inversion_kind = Misctypes.inversion_kind =
+type inversion_kind = Inv.inversion_kind =
   | SimpleInversion
+    [@ocaml.deprecated "Use constructors in [Inv]"]
   | FullInversion
+    [@ocaml.deprecated "Use constructors in [Inv]"]
   | FullInversionClear
+    [@ocaml.deprecated "Use constructors in [Inv]"]
+[@@ocaml.deprecated "Use Tactics.inversion_kind"]
 
 type ('c,'d,'id) inversion_strength =
   | NonDepInversion of
-      inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
+      Inv.inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
   | DepInversion of
-      inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
+      Inv.inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
   | InversionUsing of 'c * 'id list
 
 type ('a,'b) location = HypLocation of 'a | ConclLocation of 'b
@@ -69,8 +85,8 @@ type 'id message_token =
   | MsgIdent of 'id
 
 type ('dconstr,'id) induction_clause =
-    'dconstr with_bindings destruction_arg *
-    (intro_pattern_naming_expr CAst.t option (* eqn:... *)
+    'dconstr with_bindings Tactics.destruction_arg *
+    (Namegen.intro_pattern_naming_expr CAst.t option (* eqn:... *)
     * 'dconstr or_and_intro_pattern_expr CAst.t or_var option) (* as ... *)
     * 'id clause_expr option (* in ... *)
 
@@ -112,7 +128,7 @@ type ml_tactic_entry = {
 
 (** Composite types *)
 
-type glob_constr_and_expr = Tactypes.glob_constr_and_expr
+type glob_constr_and_expr = Genintern.glob_constr_and_expr
 
 type open_constr_expr = unit * constr_expr
 type open_glob_constr = unit * glob_constr_and_expr
@@ -129,7 +145,7 @@ type delayed_open_constr = EConstr.constr delayed_open
 type intro_pattern = delayed_open_constr intro_pattern_expr CAst.t
 type intro_patterns = delayed_open_constr intro_pattern_expr CAst.t list
 type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr CAst.t
-type intro_pattern_naming = intro_pattern_naming_expr CAst.t
+type intro_pattern_naming = Namegen.intro_pattern_naming_expr CAst.t
 
 (** Generic expressions for atomic tactics *)
 
@@ -147,7 +163,7 @@ type 'a gen_atomic_tactic_expr =
       'dtrm intro_pattern_expr CAst.t option * 'trm
   | TacGeneralize of ('trm with_occurrences * Name.t) list
   | TacLetTac of evars_flag * Name.t * 'trm * 'nam clause_expr * letin_flag *
-      intro_pattern_naming_expr CAst.t option
+      Namegen.intro_pattern_naming_expr CAst.t option
 
   (* Derived basic tactics *)
   | TacInductionDestruct of
@@ -159,7 +175,7 @@ type 'a gen_atomic_tactic_expr =
 
   (* Equality and inversion *)
   | TacRewrite of evars_flag *
-      (bool * multi * 'dtrm with_bindings_arg) list * 'nam clause_expr *
+      (bool * Equality.multi * 'dtrm with_bindings_arg) list * 'nam clause_expr *
       (* spiwack: using ['dtrm] here is a small hack, may not be
          stable by a change in the representation of delayed
          terms. Because, in fact, it is the whole "with_bindings"
@@ -265,7 +281,7 @@ and 'a gen_tactic_expr =
       ('p,'a gen_tactic_expr) match_rule list
   | TacFun of 'a gen_tactic_fun_ast
   | TacArg of 'a gen_tactic_arg located
-  | TacSelect of goal_selector * 'a gen_tactic_expr
+  | TacSelect of Goal_select.t * 'a gen_tactic_expr
   (* For ML extensions *)
   | TacML of (ml_tactic_entry * 'a gen_tactic_arg list) Loc.located
   (* For syntax extensions *)
@@ -300,7 +316,7 @@ constraint 'a = <
 
 type g_trm = glob_constr_and_expr
 type g_pat = glob_constr_pattern_and_expr
-type g_cst = evaluable_global_reference and_short_name or_var
+type g_cst = evaluable_global_reference Stdarg.and_short_name or_var
 type g_ref = ltac_constant located or_var
 type g_nam = lident
 
@@ -328,8 +344,8 @@ type glob_tactic_arg =
 
 type r_trm = constr_expr
 type r_pat = constr_pattern_expr
-type r_cst = reference or_by_notation
-type r_ref = reference
+type r_cst = qualid or_by_notation
+type r_ref = qualid
 type r_nam = lident
 type r_lev = rlevel
 
@@ -393,5 +409,5 @@ type ltac_call_kind =
 type ltac_trace = ltac_call_kind Loc.located list
 
 type tacdef_body =
-  | TacticDefinition of lident * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
-  | TacticRedefinition of reference * raw_tactic_expr       (* indicates that user employed '::=' in Ltac body *)
+  | TacticDefinition of lident * raw_tactic_expr (* indicates that user employed ':=' in Ltac body *)
+  | TacticRedefinition of qualid * raw_tactic_expr (* indicates that user employed '::=' in Ltac body *)
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 9ad9e152..5501cf92 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -27,7 +27,9 @@ open Tacexpr
 open Genarg
 open Stdarg
 open Tacarg
-open Misctypes
+open Namegen
+open Tactypes
+open Tactics
 open Locus
 
 (** Globalization of tactic expressions :
@@ -91,88 +93,104 @@ let intern_or_var f ist = function
 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
-  | {CAst.loc;v=Ident id} when find_var id ist ->
-    ArgVar (make ?loc id)
-  | r ->
-    let {CAst.loc} as lqid = qualid_of_reference r in
-    try ArgArg (loc,locate_global_with_alias lqid)
-    with Not_found -> error_global_not_found lqid
-
-let intern_ltac_variable ist = function
-  | {loc;v=Ident id} ->
-      if find_var id ist then
-	(* A local variable of any type *)
-        ArgVar (make ?loc id)
-      else raise Not_found
-  | _ ->
-      raise Not_found
-
-let intern_constr_reference strict ist = function
-  | {v=Ident id} as r when not strict && find_hyp id ist ->
-      (DAst.make @@ GVar id), Some (make @@ CRef (r,None))
-  | {v=Ident id} as r when find_var id ist ->
-      (DAst.make @@ GVar id), if strict then None else Some (make @@ CRef (r,None))
-  | r ->
-      let {loc} as lqid = qualid_of_reference r in
-      DAst.make @@ GRef (locate_global_with_alias lqid,None), 
-        if strict then None else Some (make @@ CRef (r,None))
+let intern_global_reference ist qid =
+  if qualid_is_ident qid && find_var (qualid_basename qid) ist then
+    ArgVar (make ?loc:qid.CAst.loc @@ qualid_basename qid)
+  else
+    try ArgArg (qid.CAst.loc,locate_global_with_alias qid)
+    with Not_found -> error_global_not_found qid
+
+let intern_ltac_variable ist qid =
+  if qualid_is_ident qid && find_var (qualid_basename qid) ist then
+    (* A local variable of any type *)
+    ArgVar (make ?loc:qid.CAst.loc @@ qualid_basename qid)
+  else raise Not_found
+
+let intern_constr_reference strict ist qid =
+  let id = qualid_basename qid in
+  if qualid_is_ident qid && not strict && find_hyp (qualid_basename qid) ist then
+    (DAst.make @@ GVar id), Some (make @@ CRef (qid,None))
+  else if qualid_is_ident qid && find_var (qualid_basename qid) ist then
+    (DAst.make @@ GVar id), if strict then None else Some (make @@ CRef (qid,None))
+  else
+    DAst.make @@ GRef (locate_global_with_alias qid,None),
+    if strict then None else Some (make @@ CRef (qid,None))
 
 (* Internalize an isolated reference in position of tactic *)
 
-let intern_isolated_global_tactic_reference r =
-  let {loc;v=qid} = qualid_of_reference r in
-  TacCall (Loc.tag ?loc (ArgArg (loc,Tacenv.locate_tactic qid),[]))
-
-let intern_isolated_tactic_reference strict ist r =
+let warn_deprecated_tactic =
+  CWarnings.create ~name:"deprecated-tactic" ~category:"deprecated"
+    (fun (qid,depr) -> str "Tactic " ++ pr_qualid qid ++
+      strbrk " is deprecated" ++
+      pr_opt (fun since -> str "since " ++ str since) depr.Vernacinterp.since ++
+      str "." ++ pr_opt (fun note -> str note) depr.Vernacinterp.note)
+
+let warn_deprecated_alias =
+  CWarnings.create ~name:"deprecated-tactic-notation" ~category:"deprecated"
+    (fun (kn,depr) -> str "Tactic Notation " ++ Pptactic.pr_alias_key kn ++
+      strbrk " is deprecated since" ++
+      pr_opt (fun since -> str "since " ++ str since) depr.Vernacinterp.since ++
+      str "." ++ pr_opt (fun note -> str note) depr.Vernacinterp.note)
+
+let intern_isolated_global_tactic_reference qid =
+  let loc = qid.CAst.loc in
+  let kn = Tacenv.locate_tactic qid in
+  Option.iter (fun depr -> warn_deprecated_tactic ?loc (qid,depr)) @@
+    Tacenv.tac_deprecation kn;
+  TacCall (Loc.tag ?loc (ArgArg (loc,kn),[]))
+
+let intern_isolated_tactic_reference strict ist qid =
   (* An ltac reference *)
-  try Reference (intern_ltac_variable ist r)
+  try Reference (intern_ltac_variable ist qid)
   with Not_found ->
   (* A global tactic *)
-  try intern_isolated_global_tactic_reference r
+  try intern_isolated_global_tactic_reference qid
   with Not_found ->
   (* Tolerance for compatibility, allow not to use "constr:" *)
-  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
+  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist qid))
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found (qualid_of_reference r)
+  error_global_not_found qid
 
 (* Internalize an applied tactic reference *)
 
-let intern_applied_global_tactic_reference r =
-  let {loc;v=qid} = qualid_of_reference r in
-  ArgArg (loc,Tacenv.locate_tactic qid)
+let intern_applied_global_tactic_reference qid =
+  let loc = qid.CAst.loc in
+  let kn = Tacenv.locate_tactic qid in
+  Option.iter (fun depr -> warn_deprecated_tactic ?loc (qid,depr)) @@
+    Tacenv.tac_deprecation kn;
+  ArgArg (loc,kn)
 
-let intern_applied_tactic_reference ist r =
+let intern_applied_tactic_reference ist qid =
   (* An ltac reference *)
-  try intern_ltac_variable ist r
+  try intern_ltac_variable ist qid
   with Not_found ->
   (* A global tactic *)
-  try intern_applied_global_tactic_reference r
+  try intern_applied_global_tactic_reference qid
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found (qualid_of_reference r)
+  error_global_not_found qid
 
 (* Intern a reference parsed in a non-tactic entry *)
 
-let intern_non_tactic_reference strict ist r =
+let intern_non_tactic_reference strict ist qid =
   (* An ltac reference *)
-  try Reference (intern_ltac_variable ist r)
+  try Reference (intern_ltac_variable ist qid)
   with Not_found ->
   (* A constr reference *)
-  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
+  try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist qid))
   with Not_found ->
   (* Tolerance for compatibility, allow not to use "ltac:" *)
-  try intern_isolated_global_tactic_reference r
+  try intern_isolated_global_tactic_reference qid
   with Not_found ->
   (* By convention, use IntroIdentifier for unbound ident, when not in a def *)
-  match r with
-  | {loc;v=Ident id} when not strict ->
-    let ipat = in_gen (glbwit wit_intro_pattern) (make ?loc @@ IntroNaming (IntroIdentifier id)) in
+  if qualid_is_ident qid && not strict then
+    let id = qualid_basename qid in
+    let ipat = in_gen (glbwit wit_intro_pattern) (make ?loc:qid.CAst.loc @@ IntroNaming (IntroIdentifier id)) in
     TacGeneric ipat
-  | _ ->
-  (* Reference not found *)
-  error_global_not_found (qualid_of_reference r)
+  else
+    (* Reference not found *)
+    error_global_not_found qid
 
 let intern_message_token ist = function
   | (MsgString _ | MsgInt _ as x) -> x
@@ -268,7 +286,7 @@ let intern_destruction_arg ist = function
   | clear,ElimOnIdent {loc;v=id} ->
       if !strict_check then
 	(* If in a defined tactic, no intros-until *)
-        let c, p = intern_constr ist (make @@ CRef (make @@ Ident id, None)) in
+        let c, p = intern_constr ist (make @@ CRef (qualid_of_ident id, None)) in
 	match DAst.get c with
         | GVar id -> clear,ElimOnIdent (make ?loc:c.loc id)
 	| _ -> clear,ElimOnConstr ((c, p), NoBindings)
@@ -276,16 +294,15 @@ let intern_destruction_arg ist = function
         clear,ElimOnIdent (make ?loc id)
 
 let short_name = function
-  | {v=AN {loc;v=Ident id}} when not !strict_check -> Some (make ?loc id)
+  | {v=AN qid} when qualid_is_ident qid && not !strict_check ->
+    Some (make ?loc:qid.CAst.loc @@ qualid_basename qid)
   | _ -> 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)
+let intern_evaluable_global_reference ist qid =
+  try evaluable_of_global_reference ist.genv (locate_global_with_alias ~head:true qid)
   with Not_found ->
-  match r with
-  | {loc;v=Ident id} when not !strict_check -> EvalVarRef id
-  | _ -> error_global_not_found lqid
+  if qualid_is_ident qid && not !strict_check then EvalVarRef (qualid_basename qid)
+  else error_global_not_found qid
 
 let intern_evaluable_reference_or_by_notation ist = function
   | {v=AN r} -> intern_evaluable_global_reference ist r
@@ -295,14 +312,19 @@ let intern_evaluable_reference_or_by_notation ist = function
         (function ConstRef _ | VarRef _ -> true | _ -> false) ntn sc)
 
 (* Globalize a reduction expression *)
-let intern_evaluable ist = function
-  | {loc;v=AN {v=Ident id}} when find_var id ist -> ArgVar (make ?loc id)
-  | {loc;v=AN {v=Ident id}} when not !strict_check && find_hyp id ist ->
-      ArgArg (EvalVarRef id, Some (make ?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_evaluable ist r =
+  let f ist r =
+    let e = intern_evaluable_reference_or_by_notation ist r in
+    let na = short_name r in
+    ArgArg (e,na)
+  in
+  match r with
+  | {v=AN qid} when qualid_is_ident qid && find_var (qualid_basename qid) ist ->
+    ArgVar (make ?loc:qid.CAst.loc @@ qualid_basename qid)
+  | {v=AN qid} when qualid_is_ident qid && not !strict_check && find_hyp (qualid_basename qid) ist ->
+    let id = qualid_basename qid in
+      ArgArg (EvalVarRef id, Some (make ?loc:qid.CAst.loc id))
+  | _ -> f ist r
 
 let intern_unfold ist (l,qid) = (l,intern_evaluable ist qid)
 
@@ -355,7 +377,7 @@ let intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
          subterm matched when a pattern *)
       let r = match r with
       | {v=AN r} -> r
-      | {loc} -> make ?loc @@ Qualid (qualid_of_path (path_of_global (smart_global r))) in
+      | {loc} -> (qualid_of_path ?loc (path_of_global (smart_global r))) in
       let sign = {
         Constrintern.ltac_vars = ist.ltacvars;
         ltac_bound = Id.Set.empty;
@@ -643,6 +665,8 @@ and intern_tactic_seq onlytac ist = function
 
   (* For extensions *)
   | TacAlias (loc,(s,l)) ->
+      let alias = Tacenv.interp_alias s in
+      Option.iter (fun o -> warn_deprecated_alias ?loc (s,o)) @@ alias.Tacenv.alias_deprecation;
       let l = List.map (intern_tacarg !strict_check false ist) l in
       ist.ltacvars, TacAlias (Loc.tag ?loc (s,l))
   | TacML (loc,(opn,l)) ->
diff --git a/plugins/ltac/tacintern.mli b/plugins/ltac/tacintern.mli
index fb32508c..9146fced 100644
--- a/plugins/ltac/tacintern.mli
+++ b/plugins/ltac/tacintern.mli
@@ -12,7 +12,7 @@ open Names
 open Tacexpr
 open Genarg
 open Constrexpr
-open Misctypes
+open Tactypes
 
 (** Globalization of tactic expressions :
     Conversion from [raw_tactic_expr] to [glob_tactic_expr] *)
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index c6c4f469..b9e892e5 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -12,6 +12,7 @@ open Constrintern
 open Patternops
 open Pp
 open CAst
+open Namegen
 open Genredexpr
 open Glob_term
 open Glob_ops
@@ -35,7 +36,8 @@ open Stdarg
 open Tacarg
 open Printer
 open Pretyping
-open Misctypes
+open Tactypes
+open Tactics
 open Locus
 open Tacintern
 open Taccoerce
@@ -140,16 +142,6 @@ let extract_trace ist = match TacStore.get ist.extra f_trace with
 | None -> []
 | Some l -> l
 
-module Value = struct
-
-  include Taccoerce.Value
-
-  let of_closure ist tac =
-    let closure = VFun (UnnamedAppl,extract_trace ist, ist.lfun, [], tac) in
-    of_tacvalue closure
-
-end
-
 let print_top_val env v = Pptactic.pr_value Pptactic.ltop v
 
 let catching_error call_trace fail (e, info) =
@@ -291,6 +283,12 @@ let debugging_exception_step ist signal_anomaly e pp =
   debugging_step ist (fun () ->
     pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ explain_exc e)
 
+let ensure_freshness env =
+  (* We anonymize declarations which we know will not be used *)
+  (* This assumes that the original context had no rels *)
+  process_rel_context
+    (fun d e -> EConstr.push_rel (Context.Rel.Declaration.set_name Anonymous d) e) env
+
 (* Raise Not_found if not in interpretation sign *)
 let try_interp_ltac_var coerce ist env {loc;v=id} =
   let v = Id.Map.find id ist.lfun in
@@ -311,11 +309,11 @@ let interp_name ist env sigma = function
   | 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 sigma) ist (Some (env,sigma)) (make ?loc id)
+  try try_interp_ltac_var (coerce_to_intro_pattern sigma) ist (Some (env,sigma)) (make ?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 sigma) ist (Some (env,sigma)) (make ?loc id)
+  try try_interp_ltac_var (coerce_to_intro_pattern_naming sigma) ist (Some (env,sigma)) (make ?loc id)
   with Not_found -> IntroIdentifier id
 
 let interp_int ist ({loc;v=id} as locid) =
@@ -356,11 +354,11 @@ let interp_hyp_list ist env sigma l =
 let interp_reference ist env sigma = function
   | ArgArg (_,r) -> r
   | ArgVar {loc;v=id} ->
-    try try_interp_ltac_var (coerce_to_reference env sigma) ist (Some (env,sigma)) (make ?loc id)
+    try try_interp_ltac_var (coerce_to_reference sigma) ist (Some (env,sigma)) (make ?loc id)
     with Not_found ->
       try
         VarRef (get_id (Environ.lookup_named id env))
-      with Not_found -> error_global_not_found (make ?loc @@ qualid_of_ident id)
+      with Not_found -> error_global_not_found (qualid_of_ident ?loc id)
 
 let try_interp_evaluable env (loc, id) =
   let v = Environ.lookup_named id env in
@@ -376,14 +374,14 @@ let interp_evaluable ist env sigma = function
       with Not_found ->
         match r with
         | EvalConstRef _ -> r
-        | _ -> error_global_not_found (make ?loc @@ qualid_of_ident id)
+        | _ -> error_global_not_found (qualid_of_ident ?loc id)
     end
   | ArgArg (r,None) -> r
   | ArgVar {loc;v=id} ->
     try try_interp_ltac_var (coerce_to_evaluable_ref env sigma) ist (Some (env,sigma)) (make ?loc id)
     with Not_found ->
       try try_interp_evaluable env (loc, id)
-      with Not_found -> error_global_not_found (make ?loc @@ qualid_of_ident id)
+      with Not_found -> error_global_not_found (qualid_of_ident ?loc id)
 
 (* Interprets an hypothesis name *)
 let interp_occurrences ist occs =
@@ -450,7 +448,7 @@ let default_fresh_id = Id.of_string "H"
 
 let interp_fresh_id ist env sigma l =
   let extract_ident ist env sigma id =
-    try try_interp_ltac_var (coerce_to_ident_not_fresh env sigma)
+    try try_interp_ltac_var (coerce_to_ident_not_fresh sigma)
                             ist (Some (env,sigma)) (make id)
     with Not_found -> id in
   let ids = List.map_filter (function ArgVar {v=id} -> Some id | _ -> None) l in
@@ -473,7 +471,7 @@ let interp_fresh_id ist env sigma l =
 (* Extract the uconstr list from lfun *)
 let extract_ltac_constr_context ist env sigma =
   let add_uconstr id v map =
-    try Id.Map.add id (coerce_to_uconstr env v) map
+    try Id.Map.add id (coerce_to_uconstr v) map
     with CannotCoerceTo _ -> map
   in
   let add_constr id v map =
@@ -642,7 +640,7 @@ let interp_closed_typed_pattern_with_occurrences ist env sigma (occs, a) =
         Inr (pattern_of_constr env sigma (EConstr.to_constr sigma c)) in
     (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (make ?loc id)
      with Not_found ->
-       error_global_not_found (make ?loc @@ qualid_of_ident id))
+       error_global_not_found (qualid_of_ident ?loc 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
@@ -689,13 +687,11 @@ let interp_may_eval f ist env sigma = function
   | ConstrContext ({loc;v=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 ctxt = try_interp_ltac_var coerce_to_constr_context ist (Some (env, sigma)) (make ?loc s) in
 	let ctxt = EConstr.Unsafe.to_constr ctxt in
-	let evdref = ref sigma in
-	let ic = EConstr.Unsafe.to_constr ic in
+        let ic = EConstr.Unsafe.to_constr ic in
 	let c = subst_meta [Constr_matching.special_meta,ic] ctxt in
-	let c = Typing.e_solve_evars env evdref (EConstr.of_constr c) in
-	!evdref , c
+        Typing.solve_evars env sigma (EConstr.of_constr c)
       with
 	| Not_found ->
 	    user_err ?loc ~hdr:"interp_may_eval"
@@ -800,7 +796,7 @@ and interp_or_and_intro_pattern ist env sigma = function
 
 and interp_intro_pattern_list_as_list ist env sigma = function
   | [{loc;v=IntroNaming (IntroIdentifier id)}] as l ->
-      (try sigma, coerce_to_intro_pattern_list ?loc env sigma (Id.Map.find id ist.lfun)
+      (try sigma, coerce_to_intro_pattern_list ?loc sigma (Id.Map.find id ist.lfun)
        with Not_found | CannotCoerceTo _ ->
          List.fold_left_map (interp_intro_pattern ist env) sigma l)
   | l -> List.fold_left_map (interp_intro_pattern ist env) sigma l
@@ -843,7 +839,7 @@ 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 sigma) ist (Some (env,sigma)) (make id)
+            (coerce_to_decl_or_quant_hyp sigma) ist (Some (env,sigma)) (make id)
       with Not_found -> NamedHyp id
 
 let interp_binding ist env sigma {loc;v=(b,c)} =
@@ -926,7 +922,7 @@ let interp_destruction_arg ist gl arg =
 	if Tactics.is_quantified_hypothesis id gl then
           keep,ElimOnIdent (make ?loc id)
 	else
-          let c = (DAst.make ?loc @@ GVar id,Some (make @@ CRef (make ?loc @@ Ident id,None))) in
+          let c = (DAst.make ?loc @@ GVar id,Some (make @@ CRef (qualid_of_ident ?loc id,None))) in
           let f env sigma =
             let (sigma,c) = interp_open_constr ist env sigma c in
             (sigma, (c,NoBindings))
@@ -1126,17 +1122,17 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
   | TacSelect (sel, tac) -> Tacticals.New.tclSELECT sel (interp_tactic ist tac)
   (* For extensions *)
   | TacAlias (loc,(s,l)) ->
-      let (ids, body) = Tacenv.interp_alias s in
+      let alias = 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 lfun = List.fold_right2 addvar alias.Tacenv.alias_args l ist.lfun in
         Ftactic.lift (push_trace (loc,LtacNotationCall s) ist) >>= fun trace ->
         let ist = {
           lfun = lfun;
           extra = TacStore.set ist.extra f_trace trace; } in
-        val_interp ist body >>= fun v ->
+        val_interp ist alias.Tacenv.alias_body >>= fun v ->
         Ftactic.lift (tactic_of_value ist v)
       in
       let tac =
@@ -1148,7 +1144,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
          some more elaborate solution will have to be used. *)
       in
       let tac =
-        let len1 = List.length ids in
+        let len1 = List.length alias.Tacenv.alias_args in
         let len2 = List.length l in
         if len1 = len2 then tac
         else Tacticals.New.tclZEROMSG (str "Arguments length mismatch: \
@@ -1308,7 +1304,7 @@ and tactic_of_value ist vle =
        match appl with
          UnnamedAppl -> "An unnamed user-defined tactic"
        | GlbAppl apps ->
-          let nms = List.map (fun (kn,_) -> Names.KerName.to_string kn) apps in
+          let nms = List.map (fun (kn,_) -> string_of_qualid (Tacenv.shortest_qualid_of_tactic kn)) apps in
           match nms with
             []    -> assert false
           | kn::_ -> "The user-defined tactic \"" ^ kn ^ "\"" (* TODO: when do we not have a singleton? *)
@@ -1748,15 +1744,15 @@ and interp_atomic ist tac : unit Proofview.tactic =
           | AllOccurrences | NoOccurrences -> true
           | _ -> false
         in
-        let c_interp patvars sigma =
+        let c_interp patvars env sigma =
 	  let lfun' = Id.Map.fold (fun id c lfun ->
 	    Id.Map.add id (Value.of_constr c) lfun) 
 	    patvars ist.lfun
 	  in
 	  let ist = { ist with lfun = lfun' } in
             if is_onhyps && is_onconcl
-            then interp_type ist (pf_env gl) sigma c
-            else interp_constr ist (pf_env gl) sigma c
+            then interp_type ist env sigma c
+            else interp_constr ist env sigma c
         in
         Tactics.change None c_interp (interp_clause ist (pf_env gl) (project gl) cl)
       end
@@ -1769,11 +1765,12 @@ and interp_atomic ist tac : unit Proofview.tactic =
         let sigma = project gl in
         let op = interp_typed_pattern ist env sigma op in
         let to_catch = function Not_found -> true | e -> CErrors.is_anomaly e in
-        let c_interp patvars sigma =
+        let c_interp patvars env sigma =
           let lfun' = Id.Map.fold (fun id c lfun ->
             Id.Map.add id (Value.of_constr c) lfun) 
             patvars ist.lfun
           in
+          let env = ensure_freshness env in
           let ist = { ist with lfun = lfun' } in
             try
               interp_constr ist env sigma c
@@ -1861,6 +1858,31 @@ let eval_tactic_ist ist t =
   Proofview.tclLIFT db_initialize <*>
   interp_tactic ist t
 
+(** FFI *)
+
+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
+
+  (** Apply toplevel tactic values *)
+  let apply (f : value) (args: value list) =
+    let fold arg (i, vars, lfun) =
+      let id = Id.of_string ("x" ^ string_of_int i) in
+      let x = Reference (ArgVar CAst.(make id)) in
+      (succ i, x :: vars, Id.Map.add id arg lfun)
+    in
+    let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
+    let lfun = Id.Map.add (Id.of_string "F") f lfun in
+    let ist = { (default_ist ()) with lfun = lfun; } in
+    let tac = TacArg(Loc.tag @@ TacCall (Loc.tag (ArgVar CAst.(make @@ Id.of_string "F"),args))) in
+    eval_tactic_ist ist tac
+
+end
+
 (* globalization + interpretation *)
 
 
@@ -2009,7 +2031,8 @@ let interp_redexp env sigma r =
 
 let _ =
   let eval lfun env sigma ty tac =
-    let ist = { lfun = lfun; extra = TacStore.empty; } in
+    let extra = TacStore.set TacStore.empty f_debug (get_debug ()) in
+    let ist = { lfun = lfun; extra; } in
     let tac = interp_tactic ist tac in
     let (c, sigma) = Pfedit.refine_by_tactic env sigma ty tac in
     (EConstr.of_constr c, sigma)
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index bd44bdbe..f9883e44 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -14,7 +14,7 @@ open EConstr
 open Tacexpr
 open Genarg
 open Redexpr
-open Misctypes
+open Tactypes
 
 val ltac_trace_info : ltac_trace Exninfo.t
 
@@ -28,6 +28,7 @@ sig
   val to_list : t -> t list option
   val of_closure : Geninterp.interp_sign -> glob_tactic_expr -> t
   val cast : 'a typed_abstract_argument_type -> Geninterp.Val.t -> 'a
+  val apply : t -> t list -> unit Proofview.tactic
 end
 
 (** Values for interpretation *)
@@ -131,7 +132,7 @@ val interp_ltac_var : (value -> 'a) -> interp_sign ->
 
 val interp_int : interp_sign -> lident -> int
 
-val interp_int_or_var : interp_sign -> int or_var -> int
+val interp_int_or_var : interp_sign -> int Locus.or_var -> int
 
 val default_ist : unit -> Geninterp.interp_sign
 (** Empty ist with debug set on the current value. *)
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index a1d8b087..4626378d 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -14,7 +14,8 @@ open Mod_subst
 open Genarg
 open Stdarg
 open Tacarg
-open Misctypes
+open Tactypes
+open Tactics
 open Globnames
 open Genredexpr
 open Patternops
@@ -75,7 +76,7 @@ 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
+let subst_or_var f =  let open Locus in function
   | ArgVar _ as x -> x
   | ArgArg x -> ArgArg (f x)
 
@@ -112,7 +113,7 @@ let subst_glob_constr_or_pattern subst (bvars,c,p) =
   (bvars,subst_glob_constr subst c,subst_pattern subst p)
 
 let subst_redexp subst =
-  Miscops.map_red_expr_gen
+  Redops.map_red_expr_gen
     (subst_glob_constr subst)
     (subst_evaluable subst)
     (subst_glob_constr_or_pattern subst)
diff --git a/plugins/ltac/tacsubst.mli b/plugins/ltac/tacsubst.mli
index 0a894791..d406686c 100644
--- a/plugins/ltac/tacsubst.mli
+++ b/plugins/ltac/tacsubst.mli
@@ -11,7 +11,7 @@
 open Tacexpr
 open Mod_subst
 open Genarg
-open Misctypes
+open Tactypes
 
 (** Substitution of tactics at module closing time *)
 
diff --git a/plugins/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml
index bb815dcb..b15a8d6a 100644
--- a/plugins/ltac/tactic_debug.ml
+++ b/plugins/ltac/tactic_debug.ml
@@ -12,7 +12,6 @@ open Util
 open Names
 open Pp
 open Tacexpr
-open Termops
 
 let (ltac_trace_info : ltac_trace Exninfo.t) = Exninfo.make ()
 
@@ -51,8 +50,8 @@ let msg_tac_notice s = Proofview.NonLogical.print_notice (s++fnl())
 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 (Tacmach.New.project gl) concl in
+  let penv = Termops.Internal.print_named_context env in
+  let pc = Printer.pr_econstr_env env (Tacmach.New.project gl) concl in
     str"  " ++ hv 0 (penv ++ fnl () ++
                    str "============================" ++ fnl ()  ++
                    str" "  ++ pc) ++ fnl ()
@@ -243,7 +242,7 @@ let db_constr debug env sigma c =
   let open Proofview.NonLogical in
   is_debug debug >>= fun db ->
   if db then
-    msg_tac_debug (str "Evaluated term: " ++ print_constr_env env sigma c)
+    msg_tac_debug (str "Evaluated term: " ++ Printer.pr_econstr_env env sigma c)
   else return ()
 
 (* Prints the pattern rule *)
@@ -268,7 +267,7 @@ let db_matched_hyp debug env sigma (id,_,c) ido =
   is_debug debug >>= fun db ->
   if db then
     msg_tac_debug (str "Hypothesis " ++ Id.print id ++ hyp_bound ido ++
-                str " has been matched: " ++ print_constr_env env sigma c)
+                str " has been matched: " ++ Printer.pr_econstr_env env sigma c)
   else return ()
 
 (* Prints the matched conclusion *)
@@ -276,7 +275,7 @@ let db_matched_concl debug env sigma 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 sigma c)
+    msg_tac_debug (str "Conclusion has been matched: " ++ Printer.pr_econstr_env env sigma c)
   else return ()
 
 (* Prints a success message when the goal has been matched *)
@@ -391,13 +390,10 @@ let explain_ltac_call_trace last trace loc =
 
 let skip_extensions trace =
   let rec aux = function
-  | (_,Tacexpr.LtacNameCall f as tac) :: _
-       when Tacenv.is_ltac_for_ml_tactic f -> [tac]
-  | (_,Tacexpr.LtacNotationCall _ as tac) :: (_,Tacexpr.LtacMLCall _) :: _ ->
+  | (_,Tacexpr.LtacNotationCall _ as tac) :: (_,Tacexpr.LtacMLCall _) :: tail ->
      (* Case of an ML defined tactic with entry of the form <<"foo" args>> *)
      (* see tacextend.mlp *)
-     [tac]
-  | (_,Tacexpr.LtacMLCall _ as tac) :: _ -> [tac]
+     tac :: aux tail
   | t :: tail -> t :: aux tail
   | [] -> [] in
   List.rev (aux (List.rev trace))
diff --git a/plugins/ltac/tactic_debug.mli b/plugins/ltac/tactic_debug.mli
index 734e76b5..175341df 100644
--- a/plugins/ltac/tactic_debug.mli
+++ b/plugins/ltac/tactic_debug.mli
@@ -76,7 +76,7 @@ val db_logic_failure : debug_info -> exn -> unit Proofview.NonLogical.t
 
 (** Prints a logic failure message for a rule *)
 val db_breakpoint : debug_info ->
-  Misctypes.lident message_token list -> unit Proofview.NonLogical.t
+  lident message_token list -> unit Proofview.NonLogical.t
 
 val extract_ltac_trace :
   ?loc:Loc.t -> Tacexpr.ltac_trace -> Pp.t option Loc.located
diff --git a/plugins/ltac/tactic_matching.ml b/plugins/ltac/tactic_matching.ml
index b6462c81..c949589e 100644
--- a/plugins/ltac/tactic_matching.ml
+++ b/plugins/ltac/tactic_matching.ml
@@ -46,7 +46,7 @@ let adjust : Constr_matching.bound_ident_map * Ltac_pretype.patvar_map ->
 (** Adds a binding to a {!Id.Map.t} if the identifier is [Some id] *)
 let id_map_try_add id x m =
   match id with
-  | Some id -> Id.Map.add id x m
+  | Some id -> Id.Map.add id (Lazy.force x) m
   | None -> m
 
 (** Adds a binding to a {!Id.Map.t} if the name is [Name id] *)
diff --git a/plugins/ltac/tauto.ml b/plugins/ltac/tauto.ml
index a51c09ca..299bc7ea 100644
--- a/plugins/ltac/tauto.ml
+++ b/plugins/ltac/tauto.ml
@@ -8,12 +8,11 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open EConstr
 open Hipattern
 open Names
 open Geninterp
-open Misctypes
 open Ltac_plugin
 open Tacexpr
 open Tacinterp
@@ -94,7 +93,7 @@ let clear id = Tactics.clear [id]
 
 let assumption = Tactics.assumption
 
-let split = Tactics.split_with_bindings false [Misctypes.NoBindings]
+let split = Tactics.split_with_bindings false [Tactypes.NoBindings]
 
 (** Test *)
 
@@ -175,7 +174,7 @@ let flatten_contravariant_disj _ ist =
   | 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 ci = Tactics.constructor_tac false None (succ i) Tactypes.NoBindings in
         let by = tclTHENLIST [intro; apply hyp; ci; assumption] in
         assert_ ~by typ
       in
@@ -187,7 +186,7 @@ let flatten_contravariant_disj _ ist =
 let make_unfold name =
   let dir = DirPath.make (List.map Id.of_string ["Logic"; "Init"; "Coq"]) in
   let const = Constant.make2 (ModPath.MPfile dir) (Label.make name) in
-  (Locus.AllOccurrences, ArgArg (EvalConstRef const, None))
+  Locus.(AllOccurrences, ArgArg (EvalConstRef const, None))
 
 let u_not = make_unfold "not"
 
@@ -245,7 +244,7 @@ let with_flags flags _ ist =
   let x = CAst.make @@ Id.of_string "x" in
   let arg = Val.Dyn (tag_tauto_flags, flags) in
   let ist = { ist with lfun = Id.Map.add x.CAst.v arg ist.lfun } in
-  eval_tactic_ist ist (TacArg (Loc.tag @@ TacCall (Loc.tag (ArgVar f, [Reference (ArgVar x)]))))
+  eval_tactic_ist ist (TacArg (Loc.tag @@ TacCall (Loc.tag (Locus.ArgVar f, [Reference (Locus.ArgVar x)]))))
 
 let register_tauto_tactic tac name0 args =
   let ids = List.map (fun id -> Id.of_string id) args in
diff --git a/plugins/micromega/Fourier.v b/plugins/micromega/Fourier.v
new file mode 100644
index 00000000..0153de1d
--- /dev/null
+++ b/plugins/micromega/Fourier.v
@@ -0,0 +1,5 @@
+Require Import Lra.
+Require Export Fourier_util.
+
+#[deprecated(since = "8.9.0", note = "Use lra instead.")]
+Ltac fourier := lra.
diff --git a/plugins/micromega/Fourier_util.v b/plugins/micromega/Fourier_util.v
new file mode 100644
index 00000000..b62153de
--- /dev/null
+++ b/plugins/micromega/Fourier_util.v
@@ -0,0 +1,31 @@
+Require Export Rbase.
+Require Import Lra.
+
+Open Scope R_scope.
+
+Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y.
+intros x y H H0; try assumption.
+replace 0 with (x * 0).
+apply Rmult_lt_compat_l; auto with real.
+ring.
+Qed.
+
+Lemma Rlt_zero_pos_plus1 : forall x:R, 0 < x -> 0 < 1 + x.
+intros x H; try assumption.
+rewrite Rplus_comm.
+apply Rle_lt_0_plus_1.
+red; auto with real.
+Qed.
+
+Lemma Rle_zero_pos_plus1 : forall x:R, 0 <= x -> 0 <= 1 + x.
+  intros; lra.
+Qed.
+
+Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y.
+intros x y H H0; try assumption.
+case H; intros.
+red; left.
+apply Rlt_mult_inv_pos; auto with real.
+rewrite <- H1.
+red; right; ring.
+Qed.
diff --git a/plugins/micromega/Tauto.v b/plugins/micromega/Tauto.v
index 31f55ae9..458844e1 100644
--- a/plugins/micromega/Tauto.v
+++ b/plugins/micromega/Tauto.v
@@ -211,7 +211,7 @@ Set Implicit Arguments.
       (* BC *)
       simpl.
       case_eq (deduce t t) ; auto.
-      intros until 0.
+      intros *.
       case_eq (unsat t0) ; auto.
       unfold eval_clause.
       rewrite make_conj_cons. 
@@ -263,7 +263,7 @@ Set Implicit Arguments.
   Proof.
     induction cl.
     simpl. tauto.
-    intros until 0.
+    intros *.
     simpl.
     assert (HH := add_term_correct env a cl').
     case_eq (add_term a cl').
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index 9f39191f..3a9709b6 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -17,10 +17,9 @@
 (* We take as input a list of polynomials [p1...pn] and return an unfeasibility
    certificate polynomial. *)
 
-type var = int
-
-
+let debug = false
 
+open Util
 open Big_int
 open Num
 open Polynomial
@@ -59,9 +58,6 @@ let q_spec = {
  eqb  = Mc.qeq_bool
 }
 
-let r_spec = z_spec
-
-
 let dev_form n_spec  p =
  let rec dev_form p = 
   match p with
@@ -84,38 +80,6 @@ let dev_form n_spec  p =
    pow n in
  dev_form p
 
-
-let monomial_to_polynomial mn = 
- Monomial.fold 
-  (fun v i acc -> 
-   let v = Ml2C.positive v in
-   let mn = if Int.equal i 1 then Mc.PEX v else Mc.PEpow (Mc.PEX v ,Ml2C.n i) in
-   if Pervasives.(=) acc (Mc.PEc (Mc.Zpos Mc.XH)) (** FIXME *)
-   then mn 
-   else Mc.PEmul(mn,acc))
-  mn 
-  (Mc.PEc (Mc.Zpos Mc.XH))
-  
-
-
-let list_to_polynomial vars l = 
- assert (List.for_all (fun x -> ceiling_num x =/ x) l);
- let var x = monomial_to_polynomial (List.nth vars x)  in
- 
- let rec xtopoly p i = function
-  | [] -> p
-  | c::l -> if c =/  (Int 0) then xtopoly p (i+1) l 
-   else let c = Mc.PEc (Ml2C.bigint (numerator c)) in
-        let mn = 
-         if Pervasives.(=) c (Mc.PEc (Mc.Zpos Mc.XH))
-         then var i
-         else Mc.PEmul (c,var i) in
-        let p' = if Pervasives.(=) p (Mc.PEc Mc.Z0) then mn else
-          Mc.PEadd (mn, p) in
-        xtopoly p' (i+1) l in
- 
- xtopoly (Mc.PEc Mc.Z0) 0 l
-
 let rec fixpoint f x =
  let y' = f x in
  if Pervasives.(=) y' x then y'
@@ -135,15 +99,6 @@ let  rec_simpl_cone n_spec e =
   
   
 let simplify_cone n_spec c = fixpoint (rec_simpl_cone n_spec) c
- 
-type cone_prod = 
- Const of cone 
-| Ideal of cone *cone 
-| Mult of cone * cone 
-| Other of cone
-and cone =   Mc.zWitness
-
-
 
 let factorise_linear_cone c =
  
@@ -224,14 +179,6 @@ let positivity l =
  in
  xpositivity 0 l
 
-
-let string_of_op = function
- | Mc.Strict -> "> 0" 
- | Mc.NonStrict -> ">= 0" 
- | Mc.Equal -> "= 0"
- | Mc.NonEqual -> "<> 0"
-
-
 module MonSet = Set.Make(Monomial)
 
 (* If the certificate includes at least one strict inequality, 
@@ -261,9 +208,6 @@ let build_linear_system l =
   op = Ge ; 
   cst = Big_int zero_big_int}::(strict::(positivity l)@s0)
 
-
-let big_int_to_z = Ml2C.bigint
- 
 (* For Q, this is a pity that the certificate has been scaled 
    -- at a lower layer, certificates are using nums... *)
 let make_certificate n_spec (cert,li) = 
@@ -296,8 +240,6 @@ let make_certificate n_spec (cert,li) =
     (simplify_cone n_spec (scalar_product cert' li)))
 
 
-exception Found of Monomial.t
-
 exception Strict
 
 module MonMap = Map.Make(Monomial)
@@ -367,7 +309,7 @@ let simple_linear_prover  l =
 
 let linear_prover n_spec l  =
  let build_system n_spec l = 
-  let li = List.combine l (interval 0 (List.length l -1)) in
+  let li = List.combine l (CList.interval 0 (List.length l -1)) in
   let (l1,l') = List.partition 
    (fun (x,_) -> if Pervasives.(=) (snd x) Mc.NonEqual then true else false) li in
   List.map 
@@ -397,7 +339,7 @@ let nlinear_prover prfdepth (sys: (Mc.q Mc.pExpr * Mc.op1) list) =
  LinPoly.MonT.clear ();
  max_nb_cstr := compute_max_nb_cstr sys prfdepth ;
  (* Assign a proof to the initial hypotheses *)
- let sys  = mapi (fun c i -> (c,Mc.PsatzIn (Ml2C.nat i))) sys in
+ let sys  = List.mapi (fun i c -> (c,Mc.PsatzIn (Ml2C.nat i))) sys in
 
 
  (* Add all the product of hypotheses *)
@@ -452,39 +394,6 @@ let nlinear_prover prfdepth (sys: (Mc.q Mc.pExpr * Mc.op1) list) =
    | Mc.PsatzZ           -> Mc.PsatzZ in
   Some (map_psatz cert)
 
-
-
-let make_linear_system l =
- let l' = List.map fst l in
- let monomials = List.fold_left (fun acc p -> Poly.addition p acc) 
-  (Poly.constant (Int 0)) l' in
- let monomials = Poly.fold 
-  (fun mn _ l -> if Pervasives.(=) mn Monomial.const then l else mn::l) monomials [] in
- (List.map (fun (c,op) -> 
-  {coeffs = Vect.from_list (List.map (fun mn ->  (Poly.get mn c)) monomials) ; 
-   op = op ; 
-   cst = minus_num ( (Poly.get Monomial.const c))}) l
-   ,monomials)
-
-
-let pplus x y = Mc.PEadd(x,y)
-let pmult x y = Mc.PEmul(x,y)
-let pconst x = Mc.PEc x
-let popp x = Mc.PEopp x
-
-(* keep track of enumerated vectors *)
-let rec mem p x  l = 
- match l with  [] -> false | e::l -> if p x e then true else mem p x l
-
-let rec remove_assoc p x l = 
- match l with [] -> [] | e::l -> if p x (fst e) then
-   remove_assoc p x l else e::(remove_assoc p x l) 
-
-let eq x y = Int.equal (Vect.compare x y) 0
-
-let  remove e  l  = List.fold_left (fun l x -> if eq x e then l else x::l) [] l
-
-
 (* The prover is (probably) incomplete -- 
    only searching for naive cutting planes *)
 
@@ -494,38 +403,6 @@ let develop_constraint z_spec (e,k) =
  | Mc.Equal     ->  (dev_form z_spec e , Eq)
  | _     -> assert false
 
-
-let op_of_op_compat = function
- | Ge -> Mc.NonStrict
- | Eq -> Mc.Equal
-
-
-let integer_vector coeffs = 
- let vars , coeffs = List.split coeffs in
- List.combine vars (List.map (fun x -> Big_int x) (rats_to_ints coeffs))
-
-let integer_cstr {coeffs = coeffs ; op = op ; cst = cst } = 
- let vars , coeffs = List.split coeffs in
- match rats_to_ints (cst::coeffs) with
- | cst :: coeffs -> 
-  {
-   coeffs = List.combine vars (List.map (fun x -> Big_int x) coeffs) ;
-   op = op ; cst = Big_int cst}
- |  _ -> assert false
-  
-
-let pexpr_of_cstr_compat var cstr  = 
- let {coeffs = coeffs ; op = op ; cst = cst } = integer_cstr cstr in
- try 
-  let expr = list_to_polynomial var (Vect.to_list coeffs) in  
-  let d = Ml2C.bigint (denominator cst) in
-  let n = Ml2C.bigint (numerator cst) in
-  (pplus (pmult (pconst d) expr) (popp (pconst n)), op_of_op_compat op)
- with Failure _ -> failwith "pexpr_of_cstr_compat"
-
-
-
-
 open Sos_types
 
 let rec scale_term t = 
@@ -555,18 +432,6 @@ let scale_term t =
  let (s,t') = scale_term t in
  s,t'
 
-
-let get_index_of_ith_match f i l  =
- let rec get j res l =
-  match l with
-  | [] -> failwith "bad index"
-  | e::l -> if f e
-   then 
-    (if Int.equal j i then res else get (j+1) (res+1) l )
-   else get j (res+1) l in
- get 0 0 l
-
-
 let rec scale_certificate pos = match pos with
  | Axiom_eq i ->  unit_big_int , Axiom_eq i
  | Axiom_le i ->  unit_big_int , Axiom_le i
@@ -681,8 +546,6 @@ open Polynomial
 module Env = 
 struct
 
- type t = int list
-
  let id_of_hyp hyp l = 
   let rec xid_of_hyp i l = 
    match l with
@@ -749,9 +612,6 @@ let xlinear_prover sys =
  | Inl _   -> None
 
 
-let output_num o n = output_string o (string_of_num n)
-let output_bigint o n = output_string o (string_of_big_int n)
-
 let proof_of_farkas prf cert = 
   (*  Printf.printf "\nproof_of_farkas  %a , %a \n" (pp_list output_prf_rule) prf (pp_list output_bigint) cert ;  *)
  let rec mk_farkas acc prf cert = 
@@ -894,23 +754,6 @@ let rec ext_gcd a b =
   let (s,t) = ext_gcd b r in
   (t, sub_big_int s (mult_big_int q t))
 
-
-let pp_ext_gcd a b = 
- let a' = big_int_of_int a in
- let b' = big_int_of_int b in
- 
- let (x,y) = ext_gcd a' b' in
- Printf.fprintf stdout "%s * %s + %s * %s = %s\n" 
-  (string_of_big_int x) (string_of_big_int a')
-  (string_of_big_int y) (string_of_big_int b')
-  (string_of_big_int (add_big_int (mult_big_int x a') (mult_big_int y b')))
-
-exception Result of (int * (proof * cstr_compat))
-
-let split_equations psys = 
- List.partition (fun (c,p) -> c.op == Eq)
-
-
 let extract_coprime (c1,p1) (c2,p2) = 
  let rec exist2 vect1 vect2 = 
   match vect1 , vect2 with
@@ -1058,29 +901,6 @@ let reduce_var_change psys =
 
   Some (apply_and_normalise pivot_eq sys)
 
-
-
-
-let reduce_pivot psys = 
- let is_equation (cstr,prf) = 
-  if cstr.op == Eq
-  then
-   try 
-    Some (fst (List.hd cstr.coeffs))
-   with Not_found -> None
-  else None in
- let (oeq,sys) = extract is_equation psys in
- match oeq with
- | None -> None (* Nothing to do *)
- | Some(v,pc) -> 
-  if debug then 
-   Printf.printf "Bad news : loss of completeness %a=%s" Vect.pp_vect (fst pc).coeffs (string_of_num (fst pc).cst); 
-  Some(pivot_sys v pc sys)
-
-
-
-
-
 let iterate_until_stable f x = 
  let rec iter x = 
   match f x with
@@ -1225,7 +1045,7 @@ let xlia (can_enum:bool)  reduction_equations  sys =
  | None -> None
  | Some prf -> 
 	 (*Printf.printf "direct proof %a\n" output_proof prf ; *)
-  let env = mapi (fun _ i -> i) sys in
+  let env = List.mapi (fun i _ -> i) sys in
   let prf = compile_proof env prf in
 	   (*try 
 	     if Mc.zChecker sys' prf then Some prf else 
@@ -1244,7 +1064,7 @@ let lia (can_enum:bool) (prfdepth:int) sys =
  max_nb_cstr := compute_max_nb_cstr sys prfdepth ;
  let sys = List.map (develop_constraint z_spec) sys in
  let (sys:cstr_compat list) = List.map cstr_compat_of_poly sys in
- let sys = mapi (fun c i -> (c,Hyp i)) sys in
+ let sys = List.mapi (fun i c -> (c,Hyp i)) sys in
  xlia can_enum reduction_equations sys
 
 
@@ -1252,7 +1072,7 @@ let nlia enum prfdepth sys =
  LinPoly.MonT.clear ();
  max_nb_cstr := compute_max_nb_cstr sys prfdepth;
  let sys = List.map (develop_constraint z_spec) sys in
- let sys = mapi (fun c i -> (c,Hyp i)) sys in
+ let sys = List.mapi (fun i c -> (c,Hyp i)) sys in
 
  let is_linear =  List.for_all (fun ((p,_),_) -> Poly.is_linear p) sys in
 
diff --git a/plugins/fourier/Fourier.v b/plugins/micromega/certificate.mli
index 07f32be8..13d50d1e 100644
--- a/plugins/fourier/Fourier.v
+++ b/plugins/micromega/certificate.mli
@@ -8,13 +8,15 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-(* "Fourier's method to solve linear inequations/equations systems.".*)
+module Mc = Micromega
 
-Require Export Field.
-Require Export DiscrR.
-Require Export Fourier_util.
-Declare ML Module "fourier_plugin".
+type 'a number_spec
 
-Ltac fourier := abstract (compute [IZR IPR IPR_2] in *; fourierz; field; discrR).
-
-Ltac fourier_eq := apply Rge_antisym; fourier.
+val q_cert_of_pos : Sos_types.positivstellensatz -> Mc.q Mc.psatz
+val z_cert_of_pos : Sos_types.positivstellensatz -> Mc.z Mc.psatz
+val lia : bool -> int -> (Mc.z Mc.pExpr * Mc.op1) list -> Mc.zArithProof option
+val nlia : bool -> int -> (Mc.z Mc.pExpr * Mc.op1) list -> Mc.zArithProof option
+val nlinear_prover : int -> (Mc.q Mc.pExpr * Mc.op1) list -> Mc.q Mc.psatz option
+val linear_prover_with_cert : int -> 'a number_spec ->
+  ('a Mc.pExpr * Mc.op1) list -> 'a Mc.psatz option
+val q_spec : Mc.q number_spec
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 168105e8..f22147f8 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -19,10 +19,11 @@
 (************************************************************************)
 
 open Pp
-open Mutils
-open Goptions
 open Names
+open Goptions
+open Mutils
 open Constr
+open Tactypes
 
 (**
   * Debug flag 
@@ -30,19 +31,6 @@ open Constr
 
 let debug = false
 
-(**
-  * Time function
-  *)
-
-let time str f x =
- let t0 = (Unix.times()).Unix.tms_utime in
- let res = f x in
- let t1 = (Unix.times()).Unix.tms_utime in
-  (*if debug then*) (Printf.printf "time %s %f\n" str (t1 -. t0) ;
-		     flush stdout);
-  res
-
-
 (* Limit the proof search *)
 
 let max_depth = max_int
@@ -305,8 +293,7 @@ let rec add_term  t0 = function
   *)
 
 module ISet = Set.Make(Int)
-module IMap = Map.Make(Int)
-  
+
 (**
   * Given a set of integers s=\{i0,...,iN\} and a list m, return the list of
   * elements of m that are at position i0,...,iN.
@@ -373,7 +360,7 @@ struct
     * ZMicromega.v
     *)
 
-  let gen_constant_in_modules s m n = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules s m n)
+  let gen_constant_in_modules s m n = EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.gen_reference_in_modules s m n)
   let init_constant = gen_constant_in_modules "ZMicromega" Coqlib.init_modules
   let constant = gen_constant_in_modules "ZMicromega" coq_modules
   let bin_constant = gen_constant_in_modules "ZMicromega" bin_module
@@ -395,16 +382,10 @@ struct
 
   let coq_O = lazy (init_constant "O")
   let coq_S = lazy (init_constant "S")
-  let coq_nat = lazy (init_constant "nat")
 
   let coq_N0 = lazy (bin_constant "N0")
   let coq_Npos = lazy (bin_constant "Npos")
 
-  let coq_pair = lazy (init_constant "pair")
-  let coq_None = lazy (init_constant "None")
-  let coq_option = lazy (init_constant "option")
-
-  let coq_positive = lazy (bin_constant "positive")
   let coq_xH = lazy (bin_constant "xH")
   let coq_xO = lazy (bin_constant "xO")
   let coq_xI = lazy (bin_constant "xI")
@@ -417,8 +398,6 @@ struct
   let coq_Q = lazy (constant "Q")
   let coq_R = lazy (constant "R")
 
-  let coq_Build_Witness = lazy (constant "Build_Witness")
-
   let coq_Qmake = lazy (constant "Qmake")
 
   let coq_Rcst = lazy (constant "Rcst")
@@ -455,8 +434,6 @@ struct
   let coq_Zmult = lazy (z_constant "Z.mul")
   let coq_Zpower = lazy (z_constant "Z.pow")
 
-  let coq_Qgt = lazy (constant "Qgt")
-  let coq_Qge = lazy (constant "Qge")
   let coq_Qle = lazy (constant "Qle")
   let coq_Qlt = lazy (constant "Qlt")
   let coq_Qeq = lazy (constant "Qeq")
@@ -476,7 +453,6 @@ struct
   let coq_Rminus = lazy (r_constant "Rminus")
   let coq_Ropp = lazy (r_constant "Ropp")
   let coq_Rmult = lazy (r_constant "Rmult")
-  let coq_Rdiv = lazy (r_constant "Rdiv")
   let coq_Rinv = lazy (r_constant "Rinv")
   let coq_Rpower = lazy (r_constant "pow")
   let coq_IZR    = lazy (r_constant "IZR")
@@ -509,12 +485,6 @@ struct
   let coq_PsatzAdd  = lazy (constant "PsatzAdd")
   let coq_PsatzC  = lazy (constant "PsatzC")
   let coq_PsatzZ    = lazy (constant "PsatzZ")
-  let coq_coneMember    = lazy (constant "coneMember")
-
-  let coq_make_impl = lazy
-   (gen_constant_in_modules "Zmicromega" [["Refl"]] "make_impl")
-  let coq_make_conj = lazy
-   (gen_constant_in_modules "Zmicromega" [["Refl"]] "make_conj")
 
   let coq_TT = lazy
    (gen_constant_in_modules "ZMicromega"
@@ -552,13 +522,6 @@ struct
   let coq_QWitness = lazy
    (gen_constant_in_modules "QMicromega"
      [["Coq"; "micromega"; "QMicromega"]] "QWitness")
-  let coq_ZWitness = lazy
-   (gen_constant_in_modules "QMicromega"
-     [["Coq"; "micromega"; "ZMicromega"]] "ZWitness")
-
-  let coq_N_of_Z = lazy
-   (gen_constant_in_modules "ZArithRing"
-     [["Coq";"setoid_ring";"ZArithRing"]] "N_of_Z")
 
   let coq_Build = lazy
    (gen_constant_in_modules "RingMicromega"
@@ -577,34 +540,16 @@ struct
     * pp_*      functions pretty-print Coq terms.
     *)
 
-  (* Error datastructures *)
-
-  type parse_error  =
-    | Ukn
-    | BadStr of string
-    | BadNum of int
-    | BadTerm of constr
-    | Msg   of string
-    | Goal of (constr list ) * constr * parse_error
-
-  let string_of_error = function
-   | Ukn -> "ukn"
-   | BadStr s -> s
-   | BadNum i -> string_of_int i
-   | BadTerm _ -> "BadTerm"
-   | Msg  s    -> s
-   | Goal _    -> "Goal"
-
   exception ParseError
 
   (* A simple but useful getter function *)
 
   let get_left_construct sigma term =
    match EConstr.kind sigma term with
-    | Term.Construct((_,i),_) -> (i,[| |])
-    | Term.App(l,rst) ->
+    | Construct((_,i),_) -> (i,[| |])
+    | App(l,rst) ->
        (match EConstr.kind sigma l with
-        | Term.Construct((_,i),_) -> (i,rst)
+        | Construct((_,i),_) -> (i,rst)
         |   _     -> raise ParseError
        )
     | _ ->   raise ParseError
@@ -648,19 +593,6 @@ struct
     | Mc.N0 -> Lazy.force coq_N0
     | Mc.Npos p -> EConstr.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
 
-  let rec dump_index x =
-   match x with
-    | Mc.XH -> Lazy.force coq_xH
-    | Mc.XO p -> EConstr.mkApp(Lazy.force coq_xO,[| dump_index p |])
-    | Mc.XI p -> EConstr.mkApp(Lazy.force coq_xI,[| dump_index p |])
-
-  let pp_index o x = Printf.fprintf o "%i" (CoqToCaml.index x)
-
-  let pp_n o x =  output_string o  (string_of_int (CoqToCaml.n x))
-
-  let dump_pair t1 t2 dump_t1 dump_t2 (x,y) =
-   EConstr.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
-
   let parse_z sigma term =
    let (i,c) = get_left_construct sigma term in
     match i with
@@ -677,18 +609,13 @@ struct
 
   let pp_z o x = Printf.fprintf o "%s" (Big_int.string_of_big_int (CoqToCaml.z_big_int x))
 
-  let dump_num bd1 =
-   EConstr.mkApp(Lazy.force coq_Qmake,
-                 [|dump_z (CamlToCoq.bigint (numerator bd1)) ;
-                   dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
-
   let dump_q q =
    EConstr.mkApp(Lazy.force coq_Qmake,
                  [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
 
   let parse_q sigma term =
      match EConstr.kind sigma term with
-       | Term.App(c, args) -> if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then
+       | App(c, args) -> if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then
              {Mc.qnum = parse_z sigma args.(0) ; Mc.qden = parse_positive sigma args.(1) }
        else raise ParseError
    |  _ -> raise ParseError
@@ -719,29 +646,6 @@ struct
       | Mc.CInv t -> EConstr.mkApp(Lazy.force coq_CInv, [| dump_Rcst t |])
       | Mc.COpp t -> EConstr.mkApp(Lazy.force coq_COpp, [| dump_Rcst t |])
 
-  let rec parse_Rcst sigma term = 
-    let (i,c) = get_left_construct sigma term in
-      match i with
-	| 1 -> Mc.C0
-	| 2 -> Mc.C1
-	| 3 -> Mc.CQ (parse_q sigma c.(0))
-	| 4 -> Mc.CPlus(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
-	| 5 -> Mc.CMinus(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
-	| 6 -> Mc.CMult(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
-	| 7 -> Mc.CInv(parse_Rcst sigma c.(0))
-	| 8 -> Mc.COpp(parse_Rcst sigma c.(0))
-	| _ -> raise ParseError
-
-
-
-
-  let rec parse_list sigma parse_elt term =
-   let (i,c) = get_left_construct sigma term in
-    match i with
-     | 1 -> []
-     | 2 -> parse_elt sigma c.(1) :: parse_list sigma parse_elt c.(2)
-     | i -> raise ParseError
-
   let rec dump_list typ dump_elt l =
    match l with
     | [] -> EConstr.mkApp(Lazy.force coq_nil,[| typ |])
@@ -756,22 +660,8 @@ struct
      | e::l -> Printf.fprintf o "%a ,%a" elt e  _pp l in
     Printf.fprintf o "%s%a%s" op _pp l cl
 
-  let pp_var  = pp_positive
-
   let dump_var = dump_positive
 
-  let pp_expr pp_z o e =
-  let rec pp_expr  o e =
-   match e with
-    | Mc.PEX n -> Printf.fprintf o "V %a" pp_var n
-    | Mc.PEc z -> pp_z o z
-    | Mc.PEadd(e1,e2) -> Printf.fprintf o "(%a)+(%a)" pp_expr e1 pp_expr e2
-    | Mc.PEmul(e1,e2) -> Printf.fprintf o "%a*(%a)" pp_expr e1 pp_expr e2
-    | Mc.PEopp e -> Printf.fprintf o "-(%a)" pp_expr e
-    | Mc.PEsub(e1,e2) -> Printf.fprintf o "(%a)-(%a)" pp_expr e1 pp_expr e2
-    | Mc.PEpow(e,n) -> Printf.fprintf o "(%a)^(%a)" pp_expr e pp_n  n in
-    pp_expr o e
-
   let dump_expr typ dump_z e =
    let rec dump_expr  e =
    match e with
@@ -854,18 +744,6 @@ struct
    | Mc.OpGt-> Lazy.force coq_OpGt
    | Mc.OpLt-> Lazy.force coq_OpLt
 
-  let pp_op o e=
-   match e with
-    | Mc.OpEq-> Printf.fprintf o "="
-    | Mc.OpNEq-> Printf.fprintf o "<>"
-    | Mc.OpLe -> Printf.fprintf o "=<"
-    | Mc.OpGe -> Printf.fprintf o ">="
-    | Mc.OpGt-> Printf.fprintf o ">"
-    | Mc.OpLt-> Printf.fprintf o "<"
-
-  let pp_cstr pp_z o {Mc.flhs = l ; Mc.fop = op ; Mc.frhs = r } =
-   Printf.fprintf o"(%a %a %a)" (pp_expr pp_z) l pp_op op (pp_expr pp_z) r
-
   let dump_cstr typ dump_constant {Mc.flhs = e1 ; Mc.fop = o ; Mc.frhs = e2} =
     EConstr.mkApp(Lazy.force coq_Build,
                   [| typ; dump_expr typ dump_constant e1 ;
@@ -904,8 +782,8 @@ struct
   let parse_zop gl (op,args) =
     let sigma = gl.sigma in
     match EConstr.kind sigma op with
-    | Term.Const (x,_) -> (assoc_const sigma op zop_table, args.(0) , args.(1))
-    | Term.Ind((n,0),_) ->
+    | Const (x,_) -> (assoc_const sigma op zop_table, args.(0) , args.(1))
+    | Ind((n,0),_) ->
         if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_Z)
         then (Mc.OpEq, args.(1), args.(2))
         else raise ParseError
@@ -914,8 +792,8 @@ struct
   let parse_rop gl (op,args) =
     let sigma = gl.sigma in
     match EConstr.kind sigma op with
-     | Term.Const (x,_) -> (assoc_const sigma op rop_table, args.(0) , args.(1))
-     | Term.Ind((n,0),_) ->
+     | Const (x,_) -> (assoc_const sigma op rop_table, args.(0) , args.(1))
+     | Ind((n,0),_) ->
         if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_R)
         then (Mc.OpEq, args.(1), args.(2))
         else raise ParseError
@@ -924,11 +802,6 @@ struct
   let parse_qop gl (op,args) =
     (assoc_const gl.sigma op qop_table, args.(0) , args.(1))
 
-  let is_constant sigma t = (* This is an approx *)
-   match EConstr.kind sigma t with
-    | Term.Construct(i,_) -> true
-    |   _ -> false
-
   type 'a op =
     | Binop of ('a Mc.pExpr -> 'a Mc.pExpr -> 'a Mc.pExpr)
     | Opp
@@ -947,8 +820,6 @@ struct
 
   module Env =
   struct
-   type t = EConstr.constr list
-
    let compute_rank_add env sigma v =
     let rec _add env n v =
      match env with
@@ -1011,10 +882,10 @@ struct
        try (Mc.PEc (parse_constant term) , env)
        with ParseError -> 
 	 match EConstr.kind sigma term with
-	   | Term.App(t,args) ->
+           | App(t,args) ->
                (
 		 match EConstr.kind sigma t with
-		   | Term.Const c ->
+                   | Const c ->
 		       ( match assoc_ops sigma t ops_spec  with
 			   | Binop f -> combine env f (args.(0),args.(1))
                    | Opp     -> let (expr,env) = parse_expr env args.(0) in
@@ -1077,13 +948,13 @@ struct
 
   let rec rconstant sigma term =
    match EConstr.kind sigma term with
-    | Term.Const x ->
+    | Const x ->
         if EConstr.eq_constr sigma term (Lazy.force coq_R0)
         then Mc.C0
         else if EConstr.eq_constr sigma term (Lazy.force coq_R1)
         then Mc.C1
         else raise ParseError
-    | Term.App(op,args) -> 
+    | App(op,args) ->
 	begin
 	  try
             (* the evaluation order is important in the following *)
@@ -1153,7 +1024,7 @@ struct
     if debug
     then Feedback.msg_debug (Pp.str "parse_arith: " ++ Printer.pr_leconstr_env gl.env sigma cstr ++ fnl ());
     match EConstr.kind sigma cstr with
-    | Term.App(op,args) ->
+    | App(op,args) ->
        let (op,lhs,rhs) = parse_op gl (op,args) in
        let (e1,env) = parse_expr sigma env lhs in
        let (e2,env) = parse_expr sigma env rhs in
@@ -1168,17 +1039,6 @@ struct
 
   (* generic parsing of arithmetic expressions *)
 
-  let rec f2f = function
-   | TT  -> Mc.TT
-   | FF  -> Mc.FF
-   | X _  -> Mc.X
-   | A (x,_,_) -> Mc.A x
-   | C (a,b)  -> Mc.Cj(f2f a,f2f b)
-   | D (a,b)  -> Mc.D(f2f a,f2f b)
-   | N (a) -> Mc.N(f2f a)
-   | I(a,_,b)  -> Mc.I(f2f a,f2f b)
-
-
   let mkC f1 f2 = C(f1,f2)
   let mkD f1 f2 = D(f1,f2)
   let mkIff f1 f2 = C(I(f1,None,f2),I(f2,None,f1))
@@ -1208,7 +1068,7 @@ struct
      
     let rec xparse_formula env tg term =
       match EConstr.kind sigma term with
-      | Term.App(l,rst) ->
+      | App(l,rst) ->
         (match rst with
         | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_and) ->
           let f,env,tg = xparse_formula env tg a in
@@ -1225,7 +1085,7 @@ struct
           let g,env,tg = xparse_formula env tg b in
           mkformula_binary mkIff term f g,env,tg
         | _ -> parse_atom env tg term)
-      | Term.Prod(typ,a,b) when EConstr.Vars.noccurn sigma 1 b ->
+      | Prod(typ,a,b) when EConstr.Vars.noccurn sigma 1 b ->
         let f,env,tg = xparse_formula env tg a in
         let g,env,tg = xparse_formula env tg b in
         mkformula_binary mkI term f g,env,tg
@@ -1323,31 +1183,6 @@ let dump_qexpr = lazy
     dump_op  = List.map (fun (x,y) -> (y,Lazy.force x)) qop_table      
   }
 
-  let dump_positive_as_R p =
-  let mult = Lazy.force coq_Rmult in
-  let add  = Lazy.force coq_Rplus  in
-
-  let one  = Lazy.force coq_R1    in 
-  let mk_add x y  = EConstr.mkApp(add,[|x;y|]) in
-  let mk_mult x y = EConstr.mkApp(mult,[|x;y|]) in
-
-  let two  = mk_add one one in 
-
-  let rec dump_positive p = 
-      match p with
-      | Mc.XH   -> one
-      | Mc.XO p -> mk_mult two (dump_positive p)
-      | Mc.XI p -> mk_add one (mk_mult two (dump_positive p)) in
-
-  dump_positive p
-
-let dump_n_as_R n =
-  let z = CoqToCaml.n n in
-  if z = 0
-  then Lazy.force coq_R0
-  else dump_positive_as_R (CamlToCoq.positive z)
-    
-
 let rec dump_Rcst_as_R cst = 
   match cst with
   | Mc.C0 -> Lazy.force coq_R0 
@@ -1481,54 +1316,6 @@ end (**
 
 open M
 
-let rec sig_of_cone = function
- | Mc.PsatzIn n ->          [CoqToCaml.nat n]
- | Mc.PsatzMulE(w1,w2) ->   (sig_of_cone w1)@(sig_of_cone w2)
- | Mc.PsatzMulC(w1,w2) ->   (sig_of_cone w2)
- | Mc.PsatzAdd(w1,w2) ->    (sig_of_cone w1)@(sig_of_cone w2)
- | _  -> []
-
-let same_proof sg cl1 cl2 =
- let rec xsame_proof sg =
-  match sg with
-   | [] -> true
-   | n::sg ->
-     (try Int.equal (List.nth cl1 n) (List.nth cl2 n) with Invalid_argument _ -> false)
-      && (xsame_proof sg ) in
-  xsame_proof sg
-
-let tags_of_clause tgs wit clause =
- let rec xtags tgs = function
-  | Mc.PsatzIn n -> Names.Id.Set.union tgs
-     (snd (List.nth clause (CoqToCaml.nat n) ))
-  | Mc.PsatzMulC(e,w) -> xtags tgs w
-  | Mc.PsatzMulE (w1,w2) | Mc.PsatzAdd(w1,w2) -> xtags (xtags tgs w1) w2
-  |   _   -> tgs in
-  xtags tgs wit
-
-(*let tags_of_cnf wits cnf =
- List.fold_left2 (fun acc w cl -> tags_of_clause acc w cl)
-  Names.Id.Set.empty wits cnf *)
-
-let find_witness prover polys1 = try_any prover polys1
-
-let rec witness prover   l1 l2 =
- match l2 with
-  | [] -> Some []
-  | e :: l2 ->
-     match find_witness prover (e::l1) with
-      | None -> None
-      | Some w ->
-	 (match witness prover l1 l2 with
-	  | None -> None
-	  | Some l -> Some (w::l)
-	 )
-
-let rec apply_ids t ids =
- match ids with
-  | [] -> t
-  | i::ids -> apply_ids (mkApp(t,[| mkVar i |])) ids
-
 let coq_Node = 
  lazy (gen_constant_in_modules "VarMap"
    [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Node")
@@ -1559,15 +1346,6 @@ let vm_of_list env =
     List.fold_left (fun vm (c,i) ->
       Mc.vm_add d (CamlToCoq.positive i) c vm) Mc.Empty env 
 
-
-let rec pp_varmap o vm =
- match vm with
-  | Mc.Empty -> output_string o "[]"
-  | Mc.Leaf z -> Printf.fprintf o "[%a]" pp_z  z
-  | Mc.Node(l,z,r) -> Printf.fprintf o "[%a, %a, %a]" pp_varmap l  pp_z z pp_varmap r
-
-
-
 let rec dump_proof_term = function
   | Micromega.DoneProof -> Lazy.force coq_doneProof
   | Micromega.RatProof(cone,rst) ->
@@ -1662,45 +1440,11 @@ let qq_domain_spec  = lazy {
  dump_proof = dump_psatz coq_Q dump_q
 }
 
-let rcst_domain_spec  = lazy {
- typ = Lazy.force coq_R;
- coeff = Lazy.force coq_Rcst;
- dump_coeff = dump_Rcst;
- proof_typ = Lazy.force coq_QWitness ;
- dump_proof = dump_psatz coq_Q dump_q
-}
-
 (** Naive topological sort of constr according to the subterm-ordering *)
 
 (* An element is minimal x is minimal w.r.t y if 
    x <= y or (x and y are incomparable) *)
 
-let is_min le x y =
-  if le x y then true
-  else    if le y x then false else true
-
-let is_minimal le l c = List.for_all (is_min le c) l
-    
-let find_rem p l =
-  let rec xfind_rem  acc l =
-    match l with
-    | [] -> (None, acc)
-    | x :: l -> if p x then (Some x, acc @ l)
-      else xfind_rem (x::acc) l in
-  xfind_rem [] l
-
-let find_minimal le l = find_rem (is_minimal le l) l
-  
-let rec mk_topo_order le l =
-  match find_minimal le l with
-  | (None , _) -> []
-  | (Some v,l') -> v ::  (mk_topo_order le l')
-
-    
-let topo_sort_constr l =
-  mk_topo_order (fun c t -> Termops.dependent Evd.empty (** FIXME *) (EConstr.of_constr c) (EConstr.of_constr t)) l
-
-
 (**
   * Instanciate the current Coq goal with a Micromega formula, a varmap, and a
   * witness.
@@ -1778,13 +1522,6 @@ let witness_list prover l =
 
 let witness_list_tags  = witness_list
 
-(* *Deprecated* let is_singleton = function [] -> true | [e] -> true | _ -> false *)
-
-let pp_ml_list pp_elt o l =
-  output_string o "[" ;
-  List.iter (fun x -> Printf.fprintf o "%a ;" pp_elt x) l ;
-  output_string o "]"
-
 (**
   * Prune the proof object, according to the 'diff' between two cnf formulas.
   *)
@@ -1792,7 +1529,7 @@ let pp_ml_list pp_elt o l =
 let compact_proofs (cnf_ff: 'cst cnf) res (cnf_ff': 'cst cnf) =
 
   let compact_proof (old_cl:'cst clause) (prf,prover) (new_cl:'cst clause) =
-    let new_cl = Mutils.mapi (fun (f,_) i -> (f,i)) new_cl in
+    let new_cl = List.mapi (fun i (f,_) -> (f,i)) new_cl in
     let remap i =
       let formula = try fst (List.nth old_cl i) with Failure _ -> failwith "bad old index" in
       List.assoc formula new_cl in
@@ -1991,7 +1728,7 @@ let micromega_gen
 
        let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
        let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
-       let ipat_of_name id = Some (CAst.make @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
+       let ipat_of_name id = Some (CAst.make @@ IntroNaming (Namegen.IntroIdentifier id)) in
        let goal_name = fresh_id Id.Set.empty (Names.Id.of_string "__arith") gl in
        let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in 
 
@@ -2106,7 +1843,7 @@ let micromega_genr prover tac =
 
        let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
        let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
-       let ipat_of_name id = Some (CAst.make @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
+       let ipat_of_name id = Some (CAst.make @@ IntroNaming (Namegen.IntroIdentifier id)) in
        let goal_name = fresh_id Id.Set.empty (Names.Id.of_string "__arith") gl in
        let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in 
        
@@ -2158,7 +1895,11 @@ let lift_ratproof  prover l =
   | Some c -> Some (Mc.RatProof( c,Mc.DoneProof))
 
 type micromega_polys = (Micromega.q Mc.pol * Mc.op1) list
+
+[@@@ocaml.warning "-37"]
 type csdp_certificate = S of Sos_types.positivstellensatz option | F of string
+(* Used to read the result of the execution of csdpcert *)
+
 type provername = string * int option
 
 (**
@@ -2406,16 +2147,6 @@ let nlinear_Z =   {
   pp_f    = fun o x -> pp_pol pp_z o (fst x)
 }
 
-
-
-let tauto_lia ff = 
-  let prover = linear_Z in
-  let cnf_ff,_ = cnf Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce  ff in
-    match witness_list_tags [prover] cnf_ff with
-      | None -> None
-      | Some l -> Some (List.map fst l)
-
-
 (** 
   * Functions instantiating micromega_gen with the appropriate theories and
   * solvers
diff --git a/plugins/micromega/coq_micromega.mli b/plugins/micromega/coq_micromega.mli
new file mode 100644
index 00000000..b91feb39
--- /dev/null
+++ b/plugins/micromega/coq_micromega.mli
@@ -0,0 +1,22 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val psatz_Z : int -> unit Proofview.tactic -> unit Proofview.tactic
+val psatz_Q : int -> unit Proofview.tactic -> unit Proofview.tactic
+val psatz_R : int -> unit Proofview.tactic -> unit Proofview.tactic
+val xlia : unit Proofview.tactic -> unit Proofview.tactic
+val xnlia : unit Proofview.tactic -> unit Proofview.tactic
+val nra : unit Proofview.tactic -> unit Proofview.tactic
+val nqa : unit Proofview.tactic -> unit Proofview.tactic
+val sos_Z : unit Proofview.tactic -> unit Proofview.tactic
+val sos_Q : unit Proofview.tactic -> unit Proofview.tactic
+val sos_R : unit Proofview.tactic -> unit Proofview.tactic
+val lra_Q : unit Proofview.tactic -> unit Proofview.tactic
+val lra_R : unit Proofview.tactic -> unit Proofview.tactic
diff --git a/plugins/micromega/csdpcert.ml b/plugins/micromega/csdpcert.ml
index a1245b7c..9c1b4810 100644
--- a/plugins/micromega/csdpcert.ml
+++ b/plugins/micromega/csdpcert.ml
@@ -20,7 +20,6 @@ open Sos_types
 open Sos_lib
 
 module Mc = Micromega
-module Ml2C = Mutils.CamlToCoq
 module C2Ml = Mutils.CoqToCaml
 
 type micromega_polys = (Micromega.q Mc.pol * Mc.op1) list
@@ -28,7 +27,6 @@ type csdp_certificate = S of Sos_types.positivstellensatz option | F of string
 type provername = string * int option
 
 
-let debug = false
 let flags = [Open_append;Open_binary;Open_creat]
 
 let chan = open_out_gen flags 0o666 "trace"
@@ -55,27 +53,6 @@ struct
 end
 open M
 
-open Mutils
-
-
-
-
-let canonical_sum_to_string = function s -> failwith "not implemented"
-
-let print_canonical_sum m = Format.print_string (canonical_sum_to_string m)
-
-let print_list_term o l =
-  output_string o "print_list_term\n";
- List.iter (fun (e,k) -> Printf.fprintf o "q: %s %s ;"
-  (string_of_poly (poly_of_term (expr_to_term e)))
-  (match k with
-    Mc.Equal -> "= "
-   | Mc.Strict -> "> "
-   | Mc.NonStrict -> ">= "
-   | _ -> failwith "not_implemented")) (List.map (fun (e, o) -> Mc.denorm e , o) l) ;
- output_string o "\n"
-
-
 let partition_expr l =
  let rec f i = function
   | [] -> ([],[],[])
@@ -125,7 +102,7 @@ let real_nonlinear_prover d l =
    (sets_of_list neq) in
 
   let (cert_ideal, cert_cone,monoid) = deepen_until d (fun d ->
-   list_try_find (fun m -> let (ci,cc) =
+   tryfind (fun m -> let (ci,cc) =
     real_positivnullstellensatz_general false d peq pge (poly_neg (fst m) ) in
 		      (ci,cc,snd m)) monoids) 0 in
 
@@ -144,7 +121,7 @@ let real_nonlinear_prover d l =
     | l   -> Monoid l in
     List.fold_right (fun x y -> Product(x,y)) lt sq in
 
-  let proof = list_fold_right_elements
+  let proof = end_itlist
    (fun s t -> Sum(s,t)) (proof_ne :: proofs_ideal @ proofs_cone) in
    S (Some proof)
  with
@@ -158,7 +135,7 @@ let pure_sos  l =
  (* If there is no strict inequality,
     I should nonetheless be able to try something - over Z  > is equivalent to -1  >= *)
  try
-  let l = List.combine l (interval 0 (List.length l -1)) in
+  let l = List.combine l (CList.interval 0 (List.length l -1)) in
   let (lt,i) =  try (List.find (fun (x,_) -> Pervasives.(=) (snd x) Mc.Strict) l)
    with Not_found -> List.hd l in
   let plt = poly_neg (poly_of_term (expr_to_term (fst lt))) in
@@ -183,13 +160,6 @@ let run_prover prover pb =
     | "pure_sos", None -> pure_sos pb
     | prover, _ -> (Printf.printf "unknown prover: %s\n" prover; exit 1)
 
-
-let output_csdp_certificate o = function
-  | S None -> output_string o "S None"
-  | S (Some p) -> Printf.fprintf o "S (Some %a)" output_psatz p
-  | F s        -> Printf.fprintf o "F %s" s
-
-
 let main () =
   try
     let (prover,poly) = (input_value stdin : provername * micromega_polys) in
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/micromega/csdpcert.mli
index 44560ac1..7c3ee600 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/micromega/csdpcert.mli
@@ -7,12 +7,3 @@
 (*         *     GNU Lesser General Public License Version 2.1          *)
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
-
-open Ltac_plugin
-open FourierR
-
-DECLARE PLUGIN "fourier_plugin"
-
-TACTIC EXTEND fourier
-  [ "fourierz" ] -> [ fourier () ]
-END
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.mlg
index 81140a46..21f0414e 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.mlg
@@ -16,70 +16,74 @@
 (*                                                                      *)
 (************************************************************************)
 
+{
+
 open Ltac_plugin
 open Stdarg
 open Tacarg
 
+}
+
 DECLARE PLUGIN "micromega_plugin"
 
 TACTIC EXTEND RED
-| [ "myred"  ] -> [ Tactics.red_in_concl ]
+| [ "myred"  ] -> { Tactics.red_in_concl }
 END
 
 
 
 TACTIC EXTEND PsatzZ
-| [ "psatz_Z" int_or_var(i) tactic(t) ] -> [  (Coq_micromega.psatz_Z i
+| [ "psatz_Z" int_or_var(i) tactic(t) ] -> {  (Coq_micromega.psatz_Z i
                                                (Tacinterp.tactic_of_value ist t))
-                                               ]
-| [ "psatz_Z" tactic(t)] -> [  (Coq_micromega.psatz_Z (-1)) (Tacinterp.tactic_of_value ist t) ]
+                                               }
+| [ "psatz_Z" tactic(t)] -> {  (Coq_micromega.psatz_Z (-1)) (Tacinterp.tactic_of_value ist t) }
 END
 
 TACTIC EXTEND Lia
-[ "xlia" tactic(t) ] -> [   (Coq_micromega.xlia (Tacinterp.tactic_of_value ist t)) ]
+| [ "xlia" tactic(t) ] -> {   (Coq_micromega.xlia (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND Nia
-[ "xnlia" tactic(t) ] -> [  (Coq_micromega.xnlia (Tacinterp.tactic_of_value ist t)) ]
+| [ "xnlia" tactic(t) ] -> {  (Coq_micromega.xnlia (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND NRA
-[ "xnra" tactic(t) ] -> [  (Coq_micromega.nra (Tacinterp.tactic_of_value ist t))]
+| [ "xnra" tactic(t) ] -> {  (Coq_micromega.nra (Tacinterp.tactic_of_value ist t))}
 END
 
 TACTIC EXTEND NQA
-[ "xnqa" tactic(t) ] -> [  (Coq_micromega.nqa (Tacinterp.tactic_of_value ist t))]
+| [ "xnqa" tactic(t) ] -> {  (Coq_micromega.nqa (Tacinterp.tactic_of_value ist t))}
 END
 
 
   
 TACTIC EXTEND Sos_Z
-| [ "sos_Z" tactic(t) ] -> [ (Coq_micromega.sos_Z (Tacinterp.tactic_of_value ist t)) ]
+| [ "sos_Z" tactic(t) ] -> { (Coq_micromega.sos_Z (Tacinterp.tactic_of_value ist t)) }
    END
 
 TACTIC EXTEND Sos_Q
-| [ "sos_Q" tactic(t) ] -> [   (Coq_micromega.sos_Q (Tacinterp.tactic_of_value ist t)) ]
+| [ "sos_Q" tactic(t) ] -> {   (Coq_micromega.sos_Q (Tacinterp.tactic_of_value ist t)) }
    END
 
 TACTIC EXTEND Sos_R
-| [ "sos_R" tactic(t) ] -> [   (Coq_micromega.sos_R (Tacinterp.tactic_of_value ist t)) ]
+| [ "sos_R" tactic(t) ] -> {   (Coq_micromega.sos_R (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND LRA_Q
-[ "lra_Q"  tactic(t) ] -> [   (Coq_micromega.lra_Q (Tacinterp.tactic_of_value ist t)) ]
+| [ "lra_Q"  tactic(t) ] -> {   (Coq_micromega.lra_Q (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND LRA_R
-[ "lra_R" tactic(t) ] -> [   (Coq_micromega.lra_R (Tacinterp.tactic_of_value ist t)) ]
+| [ "lra_R" tactic(t) ] -> {   (Coq_micromega.lra_R (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND PsatzR
-| [ "psatz_R" int_or_var(i) tactic(t) ] -> [   (Coq_micromega.psatz_R i (Tacinterp.tactic_of_value ist t)) ]
-| [ "psatz_R" tactic(t) ] -> [   (Coq_micromega.psatz_R (-1) (Tacinterp.tactic_of_value ist t)) ]
+| [ "psatz_R" int_or_var(i) tactic(t) ] -> {   (Coq_micromega.psatz_R i (Tacinterp.tactic_of_value ist t)) }
+| [ "psatz_R" tactic(t) ] -> {   (Coq_micromega.psatz_R (-1) (Tacinterp.tactic_of_value ist t)) }
 END
 
 TACTIC EXTEND PsatzQ
-| [ "psatz_Q" int_or_var(i) tactic(t) ] -> [  (Coq_micromega.psatz_Q i (Tacinterp.tactic_of_value ist t)) ]
-| [ "psatz_Q" tactic(t) ] -> [  (Coq_micromega.psatz_Q (-1) (Tacinterp.tactic_of_value ist t)) ]
+| [ "psatz_Q" int_or_var(i) tactic(t) ] -> {  (Coq_micromega.psatz_Q i (Tacinterp.tactic_of_value ist t)) }
+| [ "psatz_Q" tactic(t) ] -> {  (Coq_micromega.psatz_Q (-1) (Tacinterp.tactic_of_value ist t)) }
 END
 
diff --git a/plugins/micromega/g_micromega.mli b/plugins/micromega/g_micromega.mli
new file mode 100644
index 00000000..7c3ee600
--- /dev/null
+++ b/plugins/micromega/g_micromega.mli
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
diff --git a/plugins/micromega/mfourier.ml b/plugins/micromega/mfourier.ml
index 37799441..3328abda 100644
--- a/plugins/micromega/mfourier.ml
+++ b/plugins/micromega/mfourier.ml
@@ -1,13 +1,9 @@
+open Util
 open Num
-module Utils = Mutils
 open Polynomial
 open Vect
 
-let map_option = Utils.map_option
-let from_option = Utils.from_option
-
 let debug = false
-type ('a,'b) lr = Inl of 'a | Inr of 'b
 
 let compare_float (p : float) q = Pervasives.compare p q
 
@@ -26,9 +22,6 @@ struct
       Intervals needs to be explicitly normalised.
       *)
 
-  type who = Left | Right
-
-
   (** if then interval [itv] is empty, [norm_itv itv] returns [None]
       otherwise, it returns [Some itv] *)
 
@@ -37,14 +30,6 @@ struct
       | Some a , Some b -> if a <=/ b then Some itv else None
       |   _             -> Some itv
 
-  (** [opp_itv itv] computes the opposite interval *)
-  let opp_itv itv =
-  let (l,r) = itv in
-    (map_option minus_num r, map_option minus_num l)
-
-
-
-
 (** [inter i1 i2 = None] if the intersection of intervals is empty
     [inter i1 i2 = Some i] if [i] is the intersection of the intervals [i1] and [i2] *)
   let inter i1 i2 =
@@ -92,10 +77,6 @@ type vector = Vect.t
 
 module ISet = Set.Make(Int)
 
-
-module PSet = ISet
-
-
 module System = Hashtbl.Make(Vect)
 
 type proof =
@@ -131,14 +112,6 @@ and cstr_info = {
 
 (** To be thrown when a system has no solution *)
 exception SystemContradiction of proof
-let hyps prf =
-  let rec hyps prf acc =
-    match prf with
-      | Assum i -> ISet.add i acc
-      | Elim(_,prf1,prf2)
-      | And(prf1,prf2) -> hyps prf1 (hyps prf2 acc) in
-    hyps prf ISet.empty
-
 
 (** Pretty printing *)
   let rec pp_proof o prf =
@@ -147,26 +120,6 @@ let hyps prf =
       | Elim(v, prf1,prf2) -> Printf.fprintf o "E(%i,%a,%a)" v pp_proof prf1 pp_proof prf2
       | And(prf1,prf2)   -> Printf.fprintf o "A(%a,%a)"  pp_proof prf1 pp_proof prf2
 
-let pp_bound o  = function
-  | None -> output_string o "oo"
-  | Some a -> output_string o (string_of_num a)
-
-let pp_itv o (l,r) = Printf.fprintf o "(%a,%a)" pp_bound l pp_bound r
-
-
-let pp_iset o s =
-  output_string o "{" ;
-  ISet.fold (fun i _ -> Printf.fprintf o "%i " i) s ();
-  output_string o "}"
-
-let pp_pset o s =
-  output_string o "{" ;
-  PSet.fold (fun i _ -> Printf.fprintf o "%i " i) s ();
-  output_string o "}"
-
-
-let pp_info o i = pp_itv o i.bound
-
 let pp_cstr o (vect,bnd) =
     let (l,r) = bnd in
       (match l with
@@ -183,11 +136,6 @@ let pp_system o sys=
   System.iter (fun vect ibnd ->
     pp_cstr o (vect,(!ibnd).bound)) sys
 
-
-
-let pp_split_cstr o (vl,v,c,_) =
-  Printf.fprintf o "(val x = %s ,%a,%s)" (string_of_num vl) pp_vect  v  (string_of_num c)
-
 (** [merge_cstr_info] takes:
     - the intersection of bounds and
     - the union of proofs
@@ -243,8 +191,8 @@ let normalise_cstr vect cinfo =
 	      (if n <>/ Int 1 then List.map (fun (x,nx) -> (x,nx // n)) vect else vect),
 			     let divn x = x // n in
 			       if Int.equal (sign_num n) 1
-			       then{cinfo with bound = (map_option divn l , map_option  divn r) }
-			       else {cinfo with pos = cinfo.neg ; neg = cinfo.pos ; bound = (map_option divn r , map_option divn l)})
+                               then{cinfo with bound = (Option.map divn l , Option.map  divn r) }
+                               else {cinfo with pos = cinfo.neg ; neg = cinfo.pos ; bound = (Option.map divn r , Option.map divn l)})
 
 (** For compatibility, there is an external representation of constraints *)
 
@@ -281,7 +229,7 @@ let load_system l =
 
   let sys = System.create 1000 in
 
-  let li = Mutils.mapi (fun e i -> (e,i)) l in
+  let li = List.mapi (fun i e -> (e,i)) l in
 
   let vars = List.fold_left (fun vrs (cstr,i) ->
     match norm_cstr cstr i with
@@ -335,9 +283,6 @@ let add (v1,c1)   (v2,c2)  =
     (*    Printf.printf "add(%a,%s,%a,%s) -> %a\n" pp_vect v1 (string_of_num c1) pp_vect v2 (string_of_num c2) pp_vect (fst res) ;*)
     res
 
-type tlr = (num * vector * cstr_info) list
-type tm = (vector * cstr_info ) list
-
 (** To perform Fourier elimination, constraints are categorised depending on the sign of the variable to eliminate. *)
 
 (** [split x vect info (l,m,r)]
@@ -381,8 +326,8 @@ let project vr sys =
       let {neg = n1 ; pos = p1 ; bound = bound1 ; prf = prf1} = info1
       and {neg = n2 ; pos = p2 ; bound = bound2 ; prf = prf2} = info2 in
 
-      let bnd1 = from_option (fst bound1)
-      and bnd2 = from_option (fst bound2) in
+      let bnd1 = Option.get (fst bound1)
+      and bnd2 = Option.get (fst bound2) in
       let bound = (bnd1 // v1) +/ (bnd2 // minus_num v2) in
       let vres,(n,p) = add (vect1,v1) (vect2,minus_num v2)  in
         (vres,{neg = n ; pos = p ; bound = (Some bound, None); prf = Elim(vr,info1.prf,info2.prf)}) in
@@ -419,13 +364,13 @@ let project_using_eq vr c vect bound  prf (vect',info') =
 	let bndres =
 	  let f x = cst +/ x // c2 in
 	  let (l,r) = info'.bound in
-	    (map_option f l , map_option f r) in
+            (Option.map f l , Option.map f r) in
 
 	  (vres,{neg = n ; pos = p ; bound = bndres ; prf = Elim(vr,prf,info'.prf)})
     | None -> (vect',info')
 
 let elim_var_using_eq vr vect cst  prf sys =
-  let c = from_option (get vr vect) in
+  let c = Option.get (get vr vect) in
 
   let elim_var = project_using_eq vr c vect cst prf  in
 
@@ -444,9 +389,7 @@ let elim_var_using_eq vr vect cst  prf sys =
 (** [size sys] computes the number of entries in the system of constraints *)
 let size sys = System.fold (fun v iref s -> s + (!iref).neg + (!iref).pos) sys 0
 
-module IMap = Map.Make(Int)
-
-let pp_map o map = IMap.fold (fun k elt () -> Printf.fprintf o "%i -> %s\n" k (string_of_num elt)) map ()
+module IMap = CMap.Make(Int)
 
 (** [eval_vect map vect] evaluates vector [vect] using the values of [map].
     If [map] binds all the variables of [vect], we get
@@ -475,8 +418,8 @@ let restrict_bound n sum (itv:interval) =
       | 0 -> if in_bound itv sum
 	then (None,None) (* redundant *)
 	else failwith "SystemContradiction"
-      | 1 ->  map_option f l , map_option f r
-      | _ -> map_option f r , map_option f l
+      | 1 ->  Option.map f l , Option.map f r
+      | _ -> Option.map f r , Option.map f l
 
 
 (** [bound_of_variable map v sys] computes the interval of [v] in
@@ -613,12 +556,6 @@ struct
       |(Some a, Some b) -> a =/ b
       | _   -> false
 
-  let eq_bound bnd c =
-    match bnd with
-      |(Some a, Some b) -> a =/ b && c =/ b
-      | _   -> false
-
-
   let rec unroll_until v l =
     match l with
       | [] -> (false,[])
diff --git a/plugins/micromega/mfourier.mli b/plugins/micromega/mfourier.mli
new file mode 100644
index 00000000..f1d8edea
--- /dev/null
+++ b/plugins/micromega/mfourier.mli
@@ -0,0 +1,49 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+module Itv : sig
+
+  type interval = Num.num option * Num.num option
+  val range : interval -> Num.num option
+  val smaller_itv : interval -> interval -> bool
+
+end
+
+module IMap : CSig.MapS with type key = int
+
+type proof
+
+module Fourier : sig
+
+  val find_point : Polynomial.cstr_compat list ->
+    ((IMap.key * Num.num) list, proof) Util.union
+
+  val optimise : Polynomial.Vect.t ->
+    Polynomial.cstr_compat list ->
+    Itv.interval option
+
+end
+
+val pp_proof : out_channel -> proof -> unit
+
+module Proof : sig
+
+  val mk_proof : Polynomial.cstr_compat list ->
+    proof -> (Polynomial.Vect.t * Polynomial.cstr_compat) list
+
+  val add_op : Polynomial.op -> Polynomial.op -> Polynomial.op
+
+end
+
+val max_nb_cstr : int ref
+
+val eval_op : Polynomial.op -> Num.num -> Num.num -> bool
+
+exception TimeOut
diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml
index 82367c0b..9d03560b 100644
--- a/plugins/micromega/mutils.ml
+++ b/plugins/micromega/mutils.ml
@@ -19,8 +19,6 @@
 (*                                                                      *)
 (************************************************************************)
 
-let debug = false
-
 let rec pp_list f o l =
   match l with
     | [] -> ()
@@ -36,15 +34,6 @@ let finally f rst =
     with any -> raise reraise
     ); raise reraise
 
-let map_option f x =
-  match x with
-    | None -> None
-    | Some v -> Some (f v)
-
-let from_option = function
-  | None -> failwith "from_option"
-  | Some v -> v
-
 let rec try_any l x =
  match l with
   | [] -> None
@@ -52,13 +41,6 @@ let rec try_any l x =
      | None -> try_any l x
      | x -> x
 
-let iteri f l =
- let rec xiter i l =
-  match l with
-   | [] -> ()
-   | e::l -> f i e ; xiter (i+1) l in
-  xiter 0 l
-
 let all_sym_pairs f l = 
   let pair_with acc e l = List.fold_left (fun acc x -> (f e x) ::acc) acc l in
 
@@ -77,14 +59,6 @@ let all_pairs f l =
       | e::lx -> xpairs (pair_with acc e l) lx in
     xpairs [] l
 
-
-
-let rec map3 f l1 l2 l3 =
-  match l1 , l2 ,l3 with
-    | [] , [] , [] -> []
-    | e1::l1 , e2::l2 , e3::l3 -> (f e1 e2 e3)::(map3 f l1 l2 l3)
-    |      _   -> invalid_arg "map3"
-
 let rec is_sublist f l1 l2 =
   match l1 ,l2 with
     | [] ,_ -> true
@@ -93,26 +67,6 @@ let rec is_sublist f l1 l2 =
 	if f e e' then is_sublist f l1' l2'
 	else is_sublist f l1 l2'
 
-let list_try_find f =
-  let rec try_find_f = function
-    | [] -> failwith "try_find"
-    | h::t -> try f h with Failure _ -> try_find_f t
-  in
-  try_find_f
-
-let list_fold_right_elements f l =
-  let rec aux = function
-    | [] -> invalid_arg "list_fold_right_elements"
-    | [x] -> x
-    | x::l -> f x (aux l) in
-  aux l
-
-let interval n m =
-  let rec interval_n (l,m) =
-    if n > m then l else interval_n (m::l,pred m)
-  in
-  interval_n ([],m)
-
 let extract pred l = 
   List.fold_left (fun (fd,sys) e -> 
 		    match fd with
@@ -163,51 +117,7 @@ let rats_to_ints l =
   List.map (fun x ->  (div_big_int (mult_big_int (numerator x) c)
 			(denominator x))) l
 
-(* Nasty reordering of lists - useful to trim certificate down *)
-let mapi f l =
- let rec xmapi i l =
-  match l with
-   | []   -> []
-   | e::l ->  (f e i)::(xmapi (i+1) l) in
-  xmapi 0 l
-
-let concatMapi f l = List.rev (mapi (fun e i -> (i,f e)) l)
-
 (* assoc_pos j [a0...an] = [j,a0....an,j+n],j+n+1 *)
-let assoc_pos j l = (mapi (fun e i -> e,i+j) l, j + (List.length l))
-
-let assoc_pos_assoc l =
- let rec xpos i l =
-  match l with
-   | [] -> []
-   | (x,l) ::rst -> let (l',j) = assoc_pos i l in
-		     (x,l')::(xpos j rst) in
-  xpos 0 l
-
-let filter_pos f l =
- (* Could sort ... take care of duplicates... *)
- let rec xfilter l =
-  match l with
-   | []  -> []
-   | (x,e)::l ->
-      if List.exists (fun ee -> List.mem ee f) (List.map snd e)
-      then (x,e)::(xfilter l)
-      else xfilter l in
-  xfilter l
-
-let  select_pos lpos l =
- let rec xselect i lpos l =
-  match lpos with
-   | [] -> []
-   | j::rpos ->
-      match l with
-       | []   -> failwith "select_pos"
-       | e::l ->
-	  if Int.equal i j
-	  then e:: (xselect (i+1) rpos l)
-	  else xselect (i+1) lpos l in
-  xselect 0 lpos l
-
 (**
   * MODULE: Coq to Caml data-structure mappings
   *)
@@ -238,12 +148,6 @@ struct
    | XI i -> 1+(2*(index i))
    | XO i -> 2*(index i)
 
- let z x =
-  match x with
-   | Z0 -> 0
-   | Zpos p -> (positive p)
-   | Zneg p -> - (positive p)
-
  open Big_int
 
  let rec positive_big_int p =
@@ -258,8 +162,6 @@ struct
    | Zpos p -> (positive_big_int p)
    | Zneg p -> minus_big_int (positive_big_int p)
 
- let num x = Num.Big_int (z_big_int x)
-
  let q_to_num {qnum = x ; qden = y} =
   Big_int (z_big_int x) // (Big_int (z_big_int (Zpos y)))
 
@@ -352,17 +254,6 @@ struct
       let c = cmp e1 e2 in
        if Int.equal c 0 then compare_list cmp l1 l2 else c
 
-(**
-  * hash_list takes a hash function and a list, and computes an integer which
-  * is the hash value of the list.
-  *)
- let hash_list hash l =
-  let rec _hash_list l h =
-   match l with
-    | []  -> h lxor (Hashtbl.hash [])
-    | e::l -> _hash_list l ((hash e) lxor h) 
-  in _hash_list l 0
-
 end
 
 (**
diff --git a/plugins/micromega/mutils.mli b/plugins/micromega/mutils.mli
new file mode 100644
index 00000000..094429ea
--- /dev/null
+++ b/plugins/micromega/mutils.mli
@@ -0,0 +1,70 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val numerator : Num.num -> Big_int.big_int
+val denominator : Num.num -> Big_int.big_int
+
+module Cmp : sig
+
+  val compare_list : ('a -> 'b -> int) -> 'a list -> 'b list -> int
+  val compare_lexical : (unit -> int) list -> int
+
+end
+
+module Tag : sig
+
+  type t
+
+  val pp : out_channel -> t -> unit
+  val next : t -> t
+  val from : int -> t
+
+end
+
+module TagSet : CSig.SetS with type elt = Tag.t
+
+val pp_list : (out_channel -> 'a -> unit) -> out_channel -> 'a list -> unit
+
+module CamlToCoq : sig
+
+  val positive : int -> Micromega.positive
+  val bigint : Big_int.big_int -> Micromega.z
+  val n : int -> Micromega.n
+  val nat : int -> Micromega.nat
+  val q : Num.num -> Micromega.q
+  val index : int -> Micromega.positive
+  val z : int -> Micromega.z
+  val positive_big_int : Big_int.big_int -> Micromega.positive
+
+end
+
+module CoqToCaml : sig
+
+  val z_big_int : Micromega.z -> Big_int.big_int
+  val q_to_num : Micromega.q -> Num.num
+  val positive : Micromega.positive -> int
+  val n : Micromega.n -> int
+  val nat : Micromega.nat -> int
+  val index : Micromega.positive -> int
+
+end
+
+val rats_to_ints : Num.num list -> Big_int.big_int list
+
+val all_pairs : ('a -> 'a -> 'b) -> 'a list -> 'b list
+val all_sym_pairs : ('a -> 'a -> 'b) -> 'a list -> 'b list
+val try_any : (('a -> 'b option) * 'c) list -> 'a -> 'b option
+val is_sublist : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+
+val gcd_list : Num.num list -> Big_int.big_int
+
+val extract : ('a -> 'b option) -> 'a list -> ('b * 'a) option * 'a list
+
+val command : string -> string array -> 'a -> 'b
diff --git a/plugins/micromega/persistent_cache.mli b/plugins/micromega/persistent_cache.mli
new file mode 100644
index 00000000..240fa490
--- /dev/null
+++ b/plugins/micromega/persistent_cache.mli
@@ -0,0 +1,47 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Hashtbl
+
+module type PHashtable =
+  sig
+    type 'a t
+    type key
+
+    val create : int -> string -> 'a t
+    (** [create i f] creates an empty persistent table
+        with initial size i associated with file [f] *)
+
+
+    val open_in : string -> 'a t
+    (** [open_in f] rebuilds a table from the records stored in file [f].
+        As marshaling is not type-safe, it migth segault.
+    *)
+
+    val find : 'a t -> key -> 'a
+    (** find has the specification of Hashtable.find *)
+
+    val add  : 'a t -> key -> 'a -> unit
+    (** [add tbl key elem] adds the binding [key] [elem] to the table [tbl].
+        (and writes the binding to the file associated with [tbl].)
+        If [key] is already bound, raises KeyAlreadyBound *)
+
+    val close : 'a t -> unit
+    (** [close tbl] is closing the table.
+        Once closed, a table cannot be used.
+        i.e, find,add will raise UnboundTable *)
+
+    val memo : string -> (key -> 'a) -> (key -> 'a)
+      (** [memo cache f] returns a memo function for [f] using file [cache] as persistent table.
+          Note that the cache will only be loaded when the function is used for the first time *)
+
+  end
+
+module PHashtable(Key:HashedType) : PHashtable with type key = Key.t
diff --git a/plugins/micromega/polynomial.ml b/plugins/micromega/polynomial.ml
index db8b73a2..1d18a26f 100644
--- a/plugins/micromega/polynomial.ml
+++ b/plugins/micromega/polynomial.ml
@@ -20,9 +20,9 @@ open Utils
 
 type var = int
 
+let debug = false
 
 let (<+>) = add_num
-let (<->) = minus_num
 let (<*>) = mult_num
 
 
@@ -33,8 +33,6 @@ sig
  val is_const : t -> bool
  val var : var -> t
  val is_var : t -> bool
- val find : var -> t -> int
- val mult : var -> t -> t
  val prod : t -> t -> t
  val exp  : t -> int -> t
  val div  : t -> t -> t *  int
@@ -99,9 +97,6 @@ struct
  (* Get the degre of a variable in a monomial *)
  let find x m = try find x m with Not_found -> 0
   
- (* Multiply a monomial by a variable *)
- let mult x m = add x (  (find x m) + 1) m
-   
  (* Product of monomials *)
  let prod m1 m2 = Map.fold (fun k d m -> add k ((find k m) + d) m) m1 m2
 
@@ -145,14 +140,10 @@ sig
  val variable : var -> t
  val add : Monomial.t -> num -> t -> t
  val constant : num -> t
- val mult : Monomial.t -> num -> t -> t
  val product : t -> t -> t
  val addition : t -> t -> t
  val uminus : t -> t
  val fold : (Monomial.t -> num -> 'a -> 'a) -> t -> 'a -> 'a
- val pp : out_channel -> t -> unit
- val compare : t -> t -> int
- val is_null : t -> bool
  val is_linear : t -> bool
 end =
 struct
@@ -162,12 +153,6 @@ struct
 
  type t = num P.t
 
- let pp o p = P.iter 
-   (fun k v -> 
-	if Monomial.compare Monomial.const k = 0
-	then         Printf.fprintf o "%s " (string_of_num v)
-	else Printf.fprintf o "%s*%a " (string_of_num v) Monomial.pp k) p  
-
  (* Get the coefficient of monomial mn *)
  let get : Monomial.t -> t -> num = 
   fun mn p -> try find mn p with Not_found -> (Int 0)
@@ -220,10 +205,6 @@ struct
 
  let fold = P.fold
 
- let is_null p = fold (fun mn vl b -> b && sign_num vl = 0) p  true
-
- let compare = compare compare_num
-
  let is_linear p = P.fold (fun m _ acc -> acc && (Monomial.is_const m || Monomial.is_var m)) p true
 
 (* let is_linear p = 
@@ -277,7 +258,6 @@ module Vect =
 	xfrom_list 0 l
 
     let zero_num = Int 0
-    let unit_num = Int 1
 
 
     let to_list m =
@@ -311,11 +291,6 @@ module Vect =
 	      |  1 -> (k,v) :: (set i n l)
 	      |  _  -> failwith "compare_num"
 
-    let gcd m =
-      let res = List.fold_left (fun x (i,e) -> Big_int.gcd_big_int  x (Utils.numerator e))  Big_int.zero_big_int m in
-	if Big_int.compare_big_int res Big_int.zero_big_int = 0
-	then Big_int.unit_big_int else res
-
     let mul z t =
       match z with
 	| Int 0 -> []
@@ -345,7 +320,7 @@ module Vect =
 
 
 
-    let compare : t -> t -> int = Utils.Cmp.compare_list (fun x y -> Utils.Cmp.compare_lexical
+    let compare : t -> t -> int = Mutils.Cmp.compare_list (fun x y -> Mutils.Cmp.compare_lexical
       [
 	(fun () -> Int.compare (fst x) (fst y));
 	(fun () -> compare_num (snd x) (snd y))])
@@ -395,18 +370,8 @@ let opMult o1 o2 =
     | Eq , Ge | Ge , Eq -> Ge
     | Ge , Ge -> Ge
 
-let opAdd o1 o2 =
-  match o1 , o2 with
-    | Eq , _ | _ , Eq -> Eq
-    | Ge , Ge -> Ge
-
-
-
-
 open Big_int
 
-type index = int
-
 type prf_rule = 
   | Hyp of int 
   | Def of int
@@ -550,35 +515,6 @@ let mul_proof_ext (p,c) prf =
    |  _ -> MulC((p,c),prf)
   
 
-
-(*
-  let rec scale_prf_rule = function
-	    | Hyp i -> (unit_big_int, Hyp i)
-  | Def i -> (unit_big_int, Def i)
-  | Cst c -> (unit_big_int, Cst i)
-  | Zero  -> (unit_big_int, Zero)
-  | Square p -> (unit_big_int,Square p)
-  | Div(c,pr) -> 
-  let (bi,pr') = scale_prf_rule pr in
-  (mult_big_int c bi , pr')
-  | MulC(p,pr) -> 
-  let bi,pr' = scale_prf_rule pr in
-  (bi,MulC p,pr')
-  | MulPrf(p1,p2) -> 
-  let b1,p1 = scale_prf_rule p1 in
-  let b2,p2 = scale_prf_rule p2 in
-	    
-  
-  | AddPrf(p1,p2) -> 
-	    let b1,p1 = scale_prf_rule p1 in
-  let b2,p2 = scale_prf_rule p2 in
-  let g =  gcd_big_int
-*)
-	  
-
-
-
-
 module LinPoly = 
 struct
   type t = Vect.t * num
diff --git a/plugins/micromega/polynomial.mli b/plugins/micromega/polynomial.mli
new file mode 100644
index 00000000..4c095202
--- /dev/null
+++ b/plugins/micromega/polynomial.mli
@@ -0,0 +1,118 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+type var = int
+
+module Monomial : sig
+
+  type t
+  val fold : (var -> int -> 'a -> 'a) -> t -> 'a -> 'a
+  val const : t
+  val sqrt : t -> t option
+  val is_var : t -> bool
+  val div : t -> t -> t * int
+
+  val compare : t -> t -> int
+
+end
+
+module Poly : sig
+
+  type t
+
+  val constant : Num.num -> t
+  val variable : var -> t
+  val addition : t -> t -> t
+  val product : t -> t -> t
+  val uminus : t -> t
+  val get : Monomial.t -> t -> Num.num
+  val fold : (Monomial.t -> Num.num -> 'a -> 'a) -> t -> 'a -> 'a
+
+  val is_linear : t -> bool
+
+  val add : Monomial.t -> Num.num -> t -> t
+
+end
+
+module Vect : sig
+
+  type var = int
+  type t = (var * Num.num) list
+  val hash : t -> int
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val pp_vect : 'a -> t -> unit
+
+  val get : var -> t -> Num.num option
+  val set : var -> Num.num -> t -> t
+  val fresh : (int * 'a) list -> int
+  val update : Int.t -> (Num.num -> Num.num) ->
+    (Int.t * Num.num) list -> (Int.t * Num.num) list
+  val null : t
+
+  val from_list : Num.num list -> t
+  val to_list : t -> Num.num list
+
+  val add : t -> t -> t
+  val mul : Num.num -> t -> t
+
+end
+
+type cstr_compat = {coeffs : Vect.t ; op : op ; cst : Num.num}
+and op = Eq | Ge
+
+type prf_rule =
+  | Hyp of int
+  | Def of int
+  | Cst  of Big_int.big_int
+  | Zero
+  | Square of (Vect.t * Num.num)
+  | MulC of (Vect.t * Num.num) * prf_rule
+  | Gcd of Big_int.big_int * prf_rule
+  | MulPrf of prf_rule * prf_rule
+  | AddPrf of prf_rule * prf_rule
+  | CutPrf of prf_rule
+
+type proof =
+  | Done
+  | Step of int * prf_rule * proof
+  | Enum of int * prf_rule * Vect.t * prf_rule * proof list
+
+val proof_max_id : proof -> int
+
+val normalise_proof : int -> proof -> int * proof
+
+val output_proof : out_channel -> proof -> unit
+
+val add_proof : prf_rule -> prf_rule -> prf_rule
+val mul_proof : Big_int.big_int -> prf_rule -> prf_rule
+
+module LinPoly : sig
+
+  type t = Vect.t * Num.num
+
+  module MonT : sig
+
+    val clear : unit -> unit
+    val retrieve : int -> Monomial.t
+
+  end
+
+  val pivot_eq : Vect.var ->
+           cstr_compat * prf_rule ->
+           cstr_compat * prf_rule -> (cstr_compat * prf_rule) option
+
+  val linpol_of_pol : Poly.t -> t
+
+end
+
+val output_cstr : out_channel -> cstr_compat -> unit
+
+val opMult : op -> op -> op
diff --git a/plugins/micromega/sos.ml b/plugins/micromega/sos.ml
index e1ceabe9..42a41e17 100644
--- a/plugins/micromega/sos.ml
+++ b/plugins/micromega/sos.ml
@@ -95,7 +95,7 @@ let dim (v:vector) = fst v;;
 
 let vector_const c n =
   if c =/ Int 0 then vector_0 n
-  else (n,itlist (fun k -> k |-> c) (1--n) undefined :vector);;
+  else (n,List.fold_right (fun k -> k |-> c) (1--n) undefined :vector);;
 
 let vector_cmul c (v:vector) =
   let n = dim v in
@@ -104,7 +104,7 @@ let vector_cmul c (v:vector) =
 
 let vector_of_list l =
   let n = List.length l in
-  (n,itlist2 (|->) (1--n) l undefined :vector);;
+  (n,List.fold_right2 (|->) (1--n) l undefined :vector);;
 
 (* ------------------------------------------------------------------------- *)
 (* Matrices; again rows and columns indexed from 1.                          *)
@@ -242,7 +242,7 @@ let string_of_monomial m =
   if m = monomial_1 then "1" else
   let vps = List.fold_right (fun (x,k) a -> string_of_varpow x k :: a)
                             (sort humanorder_varpow (graph m)) [] in
-  end_itlist (fun s t -> s^"*"^t) vps;;
+  String.concat "*" vps;;
 
 let string_of_cmonomial (c,m) =
   if m = monomial_1 then string_of_num c
@@ -310,7 +310,7 @@ let rec poly_of_term t = match t with
 let sdpa_of_vector (v:vector) =
   let n = dim v in
   let strs = List.map (o (decimalize 20)  (element v)) (1--n) in
-  end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";;
+  String.concat " " strs ^ "\n";;
 
 (* ------------------------------------------------------------------------- *)
 (* String for a matrix numbered k, in SDPA sparse format.                    *)
@@ -321,7 +321,7 @@ let sdpa_of_matrix k (m:matrix) =
   let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a)
                  (snd m) [] in
   let mss = sort (increasing fst) ms in
-  itlist (fun ((i,j),c) a ->
+  List.fold_right (fun ((i,j),c) a ->
      pfx ^ string_of_int i ^ " " ^ string_of_int j ^
      " " ^ decimalize 20 c ^ "\n" ^ a) mss "";;
 
@@ -340,7 +340,7 @@ let sdpa_of_problem comment obj mats =
   "1\n" ^
   string_of_int n ^ "\n" ^
   sdpa_of_vector obj ^
-  itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a)
+  List.fold_right2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a)
           (1--List.length mats) mats "";;
 
 (* ------------------------------------------------------------------------- *)
@@ -489,11 +489,11 @@ let scale_then =
   and maximal_element amat acc =
     foldl (fun maxa m c -> max_num maxa (abs_num c)) acc amat in
   fun solver obj mats ->
-    let cd1 = itlist common_denominator mats (Int 1)
+    let cd1 = List.fold_right common_denominator mats (Int 1)
     and cd2 = common_denominator (snd obj)  (Int 1) in
     let mats' = List.map (mapf (fun x -> cd1 */ x)) mats
     and obj' = vector_cmul cd2 obj in
-    let max1 = itlist maximal_element mats' (Int 0)
+    let max1 = List.fold_right maximal_element mats' (Int 0)
     and max2 = maximal_element (snd obj') (Int 0) in
     let scal1 = pow2 (20-int_of_float(log(float_of_num max1) /. log 2.0))
     and scal2 = pow2 (20-int_of_float(log(float_of_num max2) /. log 2.0)) in
@@ -551,7 +551,7 @@ let minimal_convex_hull =
     | (m::ms) -> if in_convex_hull ms m then ms else ms@[m] in
   let augment m ms = funpow 3 augment1 (m::ms) in
   fun mons ->
-    let mons' = itlist augment (List.tl mons) [List.hd mons] in
+    let mons' = List.fold_right augment (List.tl mons) [List.hd mons] in
     funpow (List.length mons') augment1 mons';;
 
 (* ------------------------------------------------------------------------- *)
@@ -612,11 +612,11 @@ let newton_polytope pol =
   let vars = poly_variables pol in
   let mons = List.map (fun m -> List.map (fun x -> monomial_degree x m) vars) (dom pol)
   and ds = List.map (fun x -> (degree x pol + 1) / 2) vars in
-  let all = itlist (fun n -> allpairs (fun h t -> h::t) (0--n)) ds [[]]
+  let all = List.fold_right (fun n -> allpairs (fun h t -> h::t) (0--n)) ds [[]]
   and mons' = minimal_convex_hull mons in
   let all' =
     List.filter (fun m -> in_convex_hull mons' (List.map (fun x -> 2 * x) m)) all in
-  List.map (fun m -> itlist2 (fun v i a -> if i = 0 then a else (v |-> i) a)
+  List.map (fun m -> List.fold_right2 (fun v i a -> if i = 0 then a else (v |-> i) a)
                         vars m monomial_1) (List.rev all');;
 
 (* ------------------------------------------------------------------------- *)
@@ -657,8 +657,8 @@ let deration d =
             foldl (fun a i c -> gcd_num a (numerator c)) (Int 0) (snd l) in
     (c // (a */ a)),mapa (fun x -> a */ x) l in
   let d' = List.map adj d in
-  let a = itlist ((o) lcm_num ( (o) denominator fst)) d' (Int 1) //
-          itlist ((o) gcd_num ( (o) numerator fst)) d' (Int 0)  in
+  let a = List.fold_right ((o) lcm_num ( (o) denominator fst)) d' (Int 1) //
+          List.fold_right ((o) gcd_num ( (o) numerator fst)) d' (Int 0)  in
   (Int 1 // a),List.map (fun (c,l) -> (a */ c,l)) d';;
 
 (* ------------------------------------------------------------------------- *)
@@ -719,7 +719,7 @@ let sdpa_of_blockdiagonal k m =
   let ents =
     foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in
   let entss = sort (increasing fst) ents in
-  itlist (fun ((b,i,j),c) a ->
+  List.fold_right (fun ((b,i,j),c) a ->
      pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
      " " ^ decimalize 20 c ^ "\n" ^ a) entss "";;
 
@@ -732,10 +732,10 @@ let sdpa_of_blockproblem comment nblocks blocksizes obj mats =
   "\"" ^ comment ^ "\"\n" ^
   string_of_int m ^ "\n" ^
   string_of_int nblocks ^ "\n" ^
-  (end_itlist (fun s t -> s^" "^t) (List.map string_of_int blocksizes)) ^
+  (String.concat " " (List.map string_of_int blocksizes)) ^
   "\n" ^
   sdpa_of_vector obj ^
-  itlist2 (fun k m a -> sdpa_of_blockdiagonal (k - 1) m ^ a)
+  List.fold_right2 (fun k m a -> sdpa_of_blockdiagonal (k - 1) m ^ a)
           (1--List.length mats) mats "";;
 
 (* ------------------------------------------------------------------------- *)
@@ -791,14 +791,14 @@ let blocks blocksizes bm =
           (fun a (b,i,j) c -> if b = b0 then ((i,j) |-> c) a else a)
           undefined bm in
         (((bs,bs),m):matrix))
-      (zip blocksizes (1--List.length blocksizes));;
+      (List.combine blocksizes (1--List.length blocksizes));;
 
 (* ------------------------------------------------------------------------- *)
 (* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *)
 (* ------------------------------------------------------------------------- *)
 
 let real_positivnullstellensatz_general linf d eqs leqs pol =
-  let vars = itlist ((o) union poly_variables) (pol::eqs @ List.map fst leqs) [] in
+  let vars = List.fold_right ((o) union poly_variables) (pol::eqs @ List.map fst leqs) [] in
   let monoid =
     if linf then
       (poly_const num_1,Rational_lt num_1)::
@@ -808,16 +808,16 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
   let mk_idmultiplier k p =
     let e = d - multidegree p in
     let mons = enumerate_monomials e vars in
-    let nons = zip mons (1--List.length mons) in
+    let nons = List.combine mons (1--List.length mons) in
     mons,
-    itlist (fun (m,n) -> (m |-> ((-k,-n,n) |=> Int 1))) nons undefined in
+    List.fold_right (fun (m,n) -> (m |-> ((-k,-n,n) |=> Int 1))) nons undefined in
   let mk_sqmultiplier k (p,c) =
     let e = (d - multidegree p) / 2 in
     let mons = enumerate_monomials e vars in
-    let nons = zip mons (1--List.length mons) in
+    let nons = List.combine mons (1--List.length mons) in
     mons,
-    itlist (fun (m1,n1) ->
-      itlist (fun (m2,n2) a ->
+    List.fold_right (fun (m1,n1) ->
+      List.fold_right (fun (m2,n2) a ->
           let m = monomial_mul m1 m2 in
           if n1 > n2 then a else
           let c = if n1 = n2 then Int 1 else Int 2 in
@@ -825,17 +825,17 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
           (m |-> equation_add ((k,n1,n2) |=> c) e) a)
          nons)
        nons undefined in
-  let sqmonlist,sqs = unzip(List.map2 mk_sqmultiplier (1--List.length monoid) monoid)
-  and idmonlist,ids =  unzip(List.map2 mk_idmultiplier (1--List.length eqs) eqs) in
+  let sqmonlist,sqs = List.split(List.map2 mk_sqmultiplier (1--List.length monoid) monoid)
+  and idmonlist,ids =  List.split(List.map2 mk_idmultiplier (1--List.length eqs) eqs) in
   let blocksizes = List.map List.length sqmonlist in
   let bigsum =
-    itlist2 (fun p q a -> epoly_pmul p q a) eqs ids
-            (itlist2 (fun (p,c) s a -> epoly_pmul p s a) monoid sqs
+    List.fold_right2 (fun p q a -> epoly_pmul p q a) eqs ids
+            (List.fold_right2 (fun (p,c) s a -> epoly_pmul p s a) monoid sqs
                      (epoly_of_poly(poly_neg pol))) in
   let eqns = foldl (fun a m e -> e::a) [] bigsum in
   let pvs,assig = eliminate_all_equations (0,0,0) eqns in
   let qvars = (0,0,0)::pvs in
-  let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in
+  let allassig = List.fold_right (fun v -> (v |-> (v |=> Int 1))) pvs assig in
   let mk_matrix v =
     foldl (fun m (b,i,j) ass -> if b < 0 then m else
                                 let c = tryapplyd ass v (Int 0) in
@@ -858,8 +858,8 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
     else ());
     let vec = nice_vector d raw_vec in
     let blockmat = iter (1,dim vec)
-     (fun i a -> bmatrix_add (bmatrix_cmul (element vec i) (el i mats)) a)
-     (bmatrix_neg (el 0 mats)) in
+     (fun i a -> bmatrix_add (bmatrix_cmul (element vec i) (List.nth mats i)) a)
+     (bmatrix_neg (List.nth mats 0)) in
     let allmats = blocks blocksizes blockmat in
     vec,List.map diag allmats in
   let vec,ratdias =
@@ -867,7 +867,7 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
     else tryfind find_rounding (List.map Num.num_of_int (1--31) @
                                 List.map pow2 (5--66)) in
   let newassigs =
-    itlist (fun k -> el (k - 1) pvs |-> element vec k)
+    List.fold_right (fun k -> List.nth pvs (k - 1) |-> element vec k)
            (1--dim vec) ((0,0,0) |=> Int(-1)) in
   let finalassigs =
     foldl (fun a v e -> (v |-> equation_eval newassigs e) a) newassigs
@@ -877,17 +877,17 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
           undefined p in
   let mk_sos mons =
     let mk_sq (c,m) =
-        c,itlist (fun k a -> (el (k - 1) mons |--> element m k) a)
+        c,List.fold_right (fun k a -> (List.nth mons (k - 1) |--> element m k) a)
                  (1--List.length mons) undefined in
     List.map mk_sq in
   let sqs = List.map2 mk_sos sqmonlist ratdias
   and cfs = List.map poly_of_epoly ids in
   let msq = List.filter (fun (a,b) -> b <> []) (List.map2 (fun a b -> a,b) monoid sqs) in
-  let eval_sq sqs = itlist
+  let eval_sq sqs = List.fold_right
    (fun (c,q) -> poly_add (poly_cmul c (poly_mul q q))) sqs poly_0 in
   let sanity =
-    itlist (fun ((p,c),s) -> poly_add (poly_mul p (eval_sq s))) msq
-           (itlist2 (fun p q -> poly_add (poly_mul p q)) cfs eqs
+    List.fold_right (fun ((p,c),s) -> poly_add (poly_mul p (eval_sq s))) msq
+           (List.fold_right2 (fun p q -> poly_add (poly_mul p q)) cfs eqs
                     (poly_neg pol)) in
   if not(is_undefined sanity) then raise Sanity else
   cfs,List.map (fun (a,b) -> snd a,b) msq;;
@@ -913,8 +913,8 @@ let monomial_order =
   fun m1 m2 ->
     if m2 = monomial_1 then true else if m1 = monomial_1 then false else
     let mon1 = dest_monomial m1 and mon2 = dest_monomial m2 in
-    let deg1 = itlist ((o) (+) snd) mon1 0
-    and deg2 = itlist ((o) (+) snd) mon2 0 in
+    let deg1 = List.fold_right ((o) (+) snd) mon1 0
+    and deg2 = List.fold_right ((o) (+) snd) mon2 0 in
     if deg1 < deg2 then false else if deg1 > deg2 then true
     else lexorder mon1 mon2;;
 
@@ -929,7 +929,7 @@ let term_of_varpow =
 let term_of_monomial =
   fun m -> if m = monomial_1 then Const num_1 else
            let m' = dest_monomial m in
-           let vps = itlist (fun (x,k) a -> term_of_varpow x k :: a) m' [] in
+           let vps = List.fold_right (fun (x,k) a -> term_of_varpow x k :: a) m' [] in
            end_itlist (fun s t -> Mul (s,t)) vps;;
 
 let term_of_cmonomial =
@@ -953,202 +953,12 @@ let term_of_sos (pr,sqs) =
   else Product(pr,end_itlist (fun a b -> Sum(a,b)) (List.map term_of_sqterm sqs));;
 
 (* ------------------------------------------------------------------------- *)
-(* Interface to HOL.                                                         *)
-(* ------------------------------------------------------------------------- *)
-(*
-let REAL_NONLINEAR_PROVER translator (eqs,les,lts) =
-  let eq0 = map (poly_of_term o lhand o concl) eqs
-  and le0 = map (poly_of_term o lhand o concl) les
-  and lt0 = map (poly_of_term o lhand o concl) lts in
-  let eqp0 = map (fun (t,i) -> t,Axiom_eq i) (zip eq0 (0--(length eq0 - 1)))
-  and lep0 = map (fun (t,i) -> t,Axiom_le i) (zip le0 (0--(length le0 - 1)))
-  and ltp0 = map (fun (t,i) -> t,Axiom_lt i) (zip lt0 (0--(length lt0 - 1))) in
-  let keq,eq = partition (fun (p,_) -> multidegree p = 0) eqp0
-  and klep,lep = partition (fun (p,_) -> multidegree p = 0) lep0
-  and kltp,ltp = partition (fun (p,_) -> multidegree p = 0) ltp0 in
-  let trivial_axiom (p,ax) =
-    match ax with
-      Axiom_eq n when eval undefined p <>/ num_0 -> el n eqs
-    | Axiom_le n when eval undefined p </ num_0 -> el n les
-    | Axiom_lt n when eval undefined p <=/ num_0 -> el n lts
-    | _ -> failwith "not a trivial axiom" in
-  try let th = tryfind trivial_axiom (keq @ klep @ kltp) in
-      CONV_RULE (LAND_CONV REAL_POLY_CONV THENC REAL_RAT_RED_CONV) th
-  with Failure _ ->
-  let pol = itlist poly_mul (map fst ltp) (poly_const num_1) in
-  let leq = lep @ ltp in
-  let tryall d =
-    let e = multidegree pol in
-    let k = if e = 0 then 0 else d / e in
-    let eq' = map fst eq in
-    tryfind (fun i -> d,i,real_positivnullstellensatz_general false d eq' leq
-                          (poly_neg(poly_pow pol i)))
-            (0--k) in
-  let d,i,(cert_ideal,cert_cone) = deepen tryall 0 in
-  let proofs_ideal =
-    map2 (fun q (p,ax) -> Eqmul(term_of_poly q,ax)) cert_ideal eq
-  and proofs_cone = map term_of_sos cert_cone
-  and proof_ne =
-    if ltp = [] then Rational_lt num_1 else
-    let p = end_itlist (fun s t -> Product(s,t)) (map snd ltp) in
-    funpow i (fun q -> Product(p,q)) (Rational_lt num_1) in
-  let proof = end_itlist (fun s t -> Sum(s,t))
-                         (proof_ne :: proofs_ideal @ proofs_cone) in
-  print_string("Translating proof certificate to HOL");
-  print_newline();
-  translator (eqs,les,lts) proof;;
-*)
-(* ------------------------------------------------------------------------- *)
-(* A wrapper that tries to substitute away variables first.                  *)
-(* ------------------------------------------------------------------------- *)
-(*
-let REAL_NONLINEAR_SUBST_PROVER =
-  let zero = `&0:real`
-  and mul_tm = `( * ):real->real->real`
-  and shuffle1 =
-    CONV_RULE(REWR_CONV(REAL_ARITH `a + x = (y:real) <=> x = y - a`))
-  and shuffle2 =
-    CONV_RULE(REWR_CONV(REAL_ARITH `x + a = (y:real) <=> x = y - a`)) in
-  let rec substitutable_monomial fvs tm =
-    match tm with
-      Var(_,Tyapp("real",[])) when not (mem tm fvs) -> Int 1,tm
-    | Comb(Comb(Const("real_mul",_),c),(Var(_,_) as t))
-         when is_ratconst c && not (mem t fvs)
-          -> rat_of_term c,t
-    | Comb(Comb(Const("real_add",_),s),t) ->
-         (try substitutable_monomial (union (frees t) fvs) s
-          with Failure _ -> substitutable_monomial (union (frees s) fvs) t)
-    | _ -> failwith "substitutable_monomial"
-  and isolate_variable v th =
-    match lhs(concl th) with
-      x when x = v -> th
-    | Comb(Comb(Const("real_add",_),(Var(_,Tyapp("real",[])) as x)),t)
-        when x = v -> shuffle2 th
-    | Comb(Comb(Const("real_add",_),s),t) ->
-        isolate_variable v(shuffle1 th) in
-  let make_substitution th =
-    let (c,v) = substitutable_monomial [] (lhs(concl th)) in
-    let th1 = AP_TERM (mk_comb(mul_tm,term_of_rat(Int 1 // c))) th in
-    let th2 = CONV_RULE(BINOP_CONV REAL_POLY_MUL_CONV) th1 in
-    CONV_RULE (RAND_CONV REAL_POLY_CONV) (isolate_variable v th2) in
-  fun translator ->
-    let rec substfirst(eqs,les,lts) =
-      try let eth = tryfind make_substitution eqs in
-          let modify =
-            CONV_RULE(LAND_CONV(SUBS_CONV[eth] THENC REAL_POLY_CONV)) in
-          substfirst(filter (fun t -> lhand(concl t) <> zero) (map modify eqs),
-                     map modify les,map modify lts)
-      with Failure _ -> REAL_NONLINEAR_PROVER translator (eqs,les,lts) in
-    substfirst;;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Overall function.                                                         *)
-(* ------------------------------------------------------------------------- *)
-(*
-let REAL_SOS =
-  let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL]
-  and pure = GEN_REAL_ARITH REAL_NONLINEAR_SUBST_PROVER in
-  fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Add hacks for division.                                                   *)
-(* ------------------------------------------------------------------------- *)
-(*
-let REAL_SOSFIELD =
-  let inv_tm = `inv:real->real` in
-  let prenex_conv =
-    TOP_DEPTH_CONV BETA_CONV THENC
-    PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; real_div;
-                      REAL_INV_INV; REAL_INV_MUL; GSYM REAL_POW_INV] THENC
-    NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC
-    PRENEX_CONV
-  and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV
-  and core_rule t =
-    try REAL_ARITH t
-    with Failure _ -> try REAL_RING t
-    with Failure _ -> REAL_SOS t
-  and is_inv =
-    let is_div = is_binop `(/):real->real->real` in
-    fun tm -> (is_div tm or (is_comb tm && rator tm = inv_tm)) &&
-              not(is_ratconst(rand tm)) in
-  let BASIC_REAL_FIELD tm =
-    let is_freeinv t = is_inv t && free_in t tm in
-    let itms = setify(map rand (find_terms is_freeinv tm)) in
-    let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in
-    let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in
-    let itms' = map (curry mk_comb inv_tm) itms in
-    let gvs = map (genvar o type_of) itms' in
-    let tm'' = subst (zip gvs itms') tm' in
-    let th1 = setup_conv tm'' in
-    let cjs = conjuncts(rand(concl th1)) in
-    let ths = map core_rule cjs in
-    let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in
-    rev_itlist (C MP) hyps (INST (zip itms' gvs) th2) in
-  fun tm ->
-    let th0 = prenex_conv tm in
-    let tm0 = rand(concl th0) in
-    let avs,bod = strip_forall tm0 in
-    let th1 = setup_conv bod in
-    let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in
-    EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Integer version.                                                          *)
-(* ------------------------------------------------------------------------- *)
-(*
-let INT_SOS =
-  let atom_CONV =
-    let pth = prove
-      (`(~(x <= y) <=> y + &1 <= x:int) /\
-        (~(x < y) <=> y <= x) /\
-        (~(x = y) <=> x + &1 <= y \/ y + &1 <= x) /\
-        (x < y <=> x + &1 <= y)`,
-       REWRITE_TAC[INT_NOT_LE; INT_NOT_LT; INT_NOT_EQ; INT_LT_DISCRETE]) in
-    GEN_REWRITE_CONV I [pth]
-  and bub_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV
-   [int_eq; int_le; int_lt; int_ge; int_gt;
-    int_of_num_th; int_neg_th; int_add_th; int_mul_th;
-    int_sub_th; int_pow_th; int_abs_th; int_max_th; int_min_th] in
-  let base_CONV = TRY_CONV atom_CONV THENC bub_CONV in
-  let NNF_NORM_CONV = GEN_NNF_CONV false
-   (base_CONV,fun t -> base_CONV t,base_CONV(mk_neg t)) in
-  let init_CONV =
-    GEN_REWRITE_CONV DEPTH_CONV [FORALL_SIMP; EXISTS_SIMP] THENC
-    GEN_REWRITE_CONV DEPTH_CONV [INT_GT; INT_GE] THENC
-    CONDS_ELIM_CONV THENC NNF_NORM_CONV in
-  let p_tm = `p:bool`
-  and not_tm = `(~)` in
-  let pth = TAUT(mk_eq(mk_neg(mk_neg p_tm),p_tm)) in
-  fun tm ->
-    let th0 = INST [tm,p_tm] pth
-    and th1 = NNF_NORM_CONV(mk_neg tm) in
-    let th2 = REAL_SOS(mk_neg(rand(concl th1))) in
-    EQ_MP th0 (EQ_MP (AP_TERM not_tm (SYM th1)) th2);;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Natural number version.                                                   *)
-(* ------------------------------------------------------------------------- *)
-(*
-let SOS_RULE tm =
-  let avs = frees tm in
-  let tm' = list_mk_forall(avs,tm) in
-  let th1 = NUM_TO_INT_CONV tm' in
-  let th2 = INT_SOS (rand(concl th1)) in
-  SPECL avs (EQ_MP (SYM th1) th2);;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Now pure SOS stuff.                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-(*prioritize_real();;*)
-
-(* ------------------------------------------------------------------------- *)
 (* Some combinatorial helper functions.                                      *)
 (* ------------------------------------------------------------------------- *)
 
 let rec allpermutations l =
   if l = [] then [[]] else
-  itlist (fun h acc -> List.map (fun t -> h::t)
+  List.fold_right (fun h acc -> List.map (fun t -> h::t)
                 (allpermutations (subtract l [h])) @ acc) l [];;
 
 let changevariables_monomial zoln (m:monomial) =
@@ -1165,14 +975,14 @@ let changevariables zoln pol =
 let sdpa_of_vector (v:vector) =
   let n = dim v in
   let strs = List.map (o (decimalize 20) (element v)) (1--n) in
-  end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";;
+  String.concat " " strs ^ "\n";;
 
 let sdpa_of_matrix k (m:matrix) =
   let pfx = string_of_int k ^ " 1 " in
   let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a)
                  (snd m) [] in
   let mss = sort (increasing fst) ms in
-  itlist (fun ((i,j),c) a ->
+  List.fold_right (fun ((i,j),c) a ->
      pfx ^ string_of_int i ^ " " ^ string_of_int j ^
      " " ^ decimalize 20 c ^ "\n" ^ a) mss "";;
 
@@ -1184,7 +994,7 @@ let sdpa_of_problem comment obj mats =
   "1\n" ^
   string_of_int n ^ "\n" ^
   sdpa_of_vector obj ^
-  itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a)
+  List.fold_right2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a)
           (1--List.length mats) mats "";;
 
 let run_csdp dbg obj mats =
@@ -1224,9 +1034,9 @@ let sumofsquares_general_symmetry tool pol =
   let sym_eqs =
     let invariants = List.filter
      (fun vars' ->
-        is_undefined(poly_sub pol (changevariables (zip vars vars') pol)))
+        is_undefined(poly_sub pol (changevariables (List.combine vars vars') pol)))
      (allpermutations vars) in
-    let lpns = zip lpps (1--List.length lpps) in
+    let lpns = List.combine lpps (1--List.length lpps) in
     let lppcs =
       List.filter (fun (m,(n1,n2)) -> n1 <= n2)
              (allpairs
@@ -1234,8 +1044,8 @@ let sumofsquares_general_symmetry tool pol =
     let clppcs = end_itlist (@)
        (List.map (fun ((m1,m2),(n1,n2)) ->
                 List.map (fun vars' ->
-                        (changevariables_monomial (zip vars vars') m1,
-                         changevariables_monomial (zip vars vars') m2),(n1,n2))
+                        (changevariables_monomial (List.combine vars vars') m1,
+                         changevariables_monomial (List.combine vars vars') m2),(n1,n2))
                     invariants)
             lppcs) in
     let clppcs_dom = setify(List.map fst clppcs) in
@@ -1247,7 +1057,7 @@ let sumofsquares_general_symmetry tool pol =
         [] -> raise Sanity
       | [h] -> acc
       | h::t -> List.map (fun k -> (k |-> Int(-1)) (h |=> Int 1)) t @ acc in
-    itlist mk_eq eqvcls [] in
+    List.fold_right mk_eq eqvcls [] in
   let eqs = foldl (fun a x y -> y::a) []
    (itern 1 lpps (fun m1 n1 ->
         itern 1 lpps (fun m2 n2 f ->
@@ -1259,7 +1069,7 @@ let sumofsquares_general_symmetry tool pol =
               undefined pol)) @
     sym_eqs in
   let pvs,assig = eliminate_all_equations (0,0) eqs in
-  let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in
+  let allassig = List.fold_right (fun v -> (v |-> (v |=> Int 1))) pvs assig in
   let qvars = (0,0)::pvs in
   let diagents =
     end_itlist equation_add (List.map (fun i -> apply allassig (i,i)) (1--n)) in
@@ -1281,18 +1091,18 @@ let sumofsquares_general_symmetry tool pol =
     else ());
     let vec = nice_vector d raw_vec in
     let mat = iter (1,dim vec)
-     (fun i a -> matrix_add (matrix_cmul (element vec i) (el i mats)) a)
-     (matrix_neg (el 0 mats)) in
+     (fun i a -> matrix_add (matrix_cmul (element vec i) (List.nth mats i)) a)
+     (matrix_neg (List.nth mats 0)) in
     deration(diag mat) in
   let rat,dia =
     if pvs = [] then
-       let mat = matrix_neg (el 0 mats) in
+       let mat = matrix_neg (List.nth mats 0) in
        deration(diag mat)
     else
        tryfind find_rounding (List.map Num.num_of_int (1--31) @
                               List.map pow2 (5--66)) in
   let poly_of_lin(d,v) =
-    d,foldl(fun a i c -> (el (i - 1) lpps |-> c) a) undefined (snd v) in
+    d,foldl(fun a i c -> (List.nth lpps (i - 1) |-> c) a) undefined (snd v) in
   let lins = List.map poly_of_lin dia in
   let sqs = List.map (fun (d,l) -> poly_mul (poly_const d) (poly_pow l 2)) lins in
   let sos = poly_cmul rat (end_itlist poly_add sqs) in
@@ -1300,325 +1110,3 @@ let sumofsquares_general_symmetry tool pol =
 
 let sumofsquares = sumofsquares_general_symmetry csdp;;
 
-(* ------------------------------------------------------------------------- *)
-(* Pure HOL SOS conversion.                                                  *)
-(* ------------------------------------------------------------------------- *)
-(*
-let SOS_CONV =
-  let mk_square =
-    let pow_tm = `(pow)` and two_tm = `2` in
-    fun tm -> mk_comb(mk_comb(pow_tm,tm),two_tm)
-  and mk_prod = mk_binop `( * )`
-  and mk_sum = mk_binop `(+)` in
-  fun tm ->
-    let k,sos = sumofsquares(poly_of_term tm) in
-    let mk_sqtm(c,p) =
-      mk_prod (term_of_rat(k */ c)) (mk_square(term_of_poly p)) in
-    let tm' = end_itlist mk_sum (map mk_sqtm sos) in
-    let th = REAL_POLY_CONV tm and th' = REAL_POLY_CONV tm' in
-    TRANS th (SYM th');;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Attempt to prove &0 <= x by direct SOS decomposition.                     *)
-(* ------------------------------------------------------------------------- *)
-(*
-let PURE_SOS_TAC =
-  let tac =
-    MATCH_ACCEPT_TAC(REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE) ORELSE
-    MATCH_ACCEPT_TAC REAL_LE_SQUARE ORELSE
-    (MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) ORELSE
-    (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) ORELSE
-    CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV THENC REAL_RAT_LE_CONV) in
-  REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN
-  GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN
-  CONV_TAC(RAND_CONV SOS_CONV) THEN
-  REPEAT tac THEN NO_TAC;;
-
-let PURE_SOS tm = prove(tm,PURE_SOS_TAC);;
-*)
-(* ------------------------------------------------------------------------- *)
-(* Examples.                                                                 *)
-(* ------------------------------------------------------------------------- *)
-
-(*****
-
-time REAL_SOS
-  `a1 >= &0 /\ a2 >= &0 /\
-   (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + &2) /\
-   (a1 * b1 + a2 * b2 = &0)
-   ==> a1 * a2 - b1 * b2 >= &0`;;
-
-time REAL_SOS `&3 * x + &7 * a < &4 /\ &3 < &2 * x ==> a < &0`;;
-
-time REAL_SOS
-  `b pow 2 < &4 * a * c ==> ~(a * x pow 2 + b * x + c = &0)`;;
-
-time REAL_SOS
-  `(a * x pow 2 + b * x + c = &0) ==> b pow 2 >= &4 * a * c`;;
-
-time REAL_SOS
- `&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1
-  ==> x pow 2 + y pow 2 < &1 \/
-      (x - &1) pow 2 + y pow 2 < &1 \/
-      x pow 2 + (y - &1) pow 2 < &1 \/
-      (x - &1) pow 2 + (y - &1) pow 2 < &1`;;
-
-time REAL_SOS
- `&0 <= b /\ &0 <= c /\ &0 <= x /\ &0 <= y /\
-  (x pow 2 = c) /\ (y pow 2 = a pow 2 * c + b)
-  ==> a * c <= y * x`;;
-
-time REAL_SOS
- `&0 <= x /\ &0 <= y /\ &0 <= z /\ x + y + z <= &3
-  ==> x * y + x * z + y * z >= &3 * x * y * z`;;
-
-time REAL_SOS
- `(x pow 2 + y pow 2 + z pow 2 = &1) ==> (x + y + z) pow 2 <= &3`;;
-
-time REAL_SOS
- `(w pow 2 + x pow 2 + y pow 2 + z pow 2 = &1)
-  ==> (w + x + y + z) pow 2 <= &4`;;
-
-time REAL_SOS
- `x >= &1 /\ y >= &1 ==> x * y >= x + y - &1`;;
-
-time REAL_SOS
- `x > &1 /\ y > &1 ==> x * y > x + y - &1`;;
-
-time REAL_SOS
- `abs(x) <= &1
-  ==> abs(&64 * x pow 7 - &112 * x pow 5 + &56 * x pow 3 - &7 * x) <= &1`;;
-
-time REAL_SOS
- `abs(x - z) <= e /\ abs(y - z) <= e /\ &0 <= u /\ &0 <= v /\ (u + v = &1)
-  ==> abs((u * x + v * y) - z) <= e`;;
-
-(* ------------------------------------------------------------------------- *)
-(* One component of denominator in dodecahedral example.                     *)
-(* ------------------------------------------------------------------------- *)
-
-time REAL_SOS
-  `&2 <= x /\ x <= &125841 / &50000 /\
-   &2 <= y /\ y <= &125841 / &50000 /\
-   &2 <= z /\ z <= &125841 / &50000
-   ==> &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) >= &0`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Over a larger but simpler interval.                                       *)
-(* ------------------------------------------------------------------------- *)
-
-time REAL_SOS
- `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4
-  ==> &0 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* We can do 12. I think 12 is a sharp bound; see PP's certificate.          *)
-(* ------------------------------------------------------------------------- *)
-
-time REAL_SOS
- `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4
-  ==> &12 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Gloptipoly example.                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-(*** This works but normalization takes minutes
-
-time REAL_SOS
- `(x - y - &2 * x pow 4 = &0) /\ &0 <= x /\ x <= &2 /\ &0 <= y /\ y <= &3
-  ==> y pow 2 - &7 * y - &12 * x + &17 >= &0`;;
-
- ***)
-
-(* ------------------------------------------------------------------------- *)
-(* Inequality from sci.math (see "Leon-Sotelo, por favor").                  *)
-(* ------------------------------------------------------------------------- *)
-
-time REAL_SOS
-  `&0 <= x /\ &0 <= y /\ (x * y = &1)
-   ==> x + y <= x pow 2 + y pow 2`;;
-
-time REAL_SOS
-  `&0 <= x /\ &0 <= y /\ (x * y = &1)
-   ==> x * y * (x + y) <= x pow 2 + y pow 2`;;
-
-time REAL_SOS
-  `&0 <= x /\ &0 <= y ==> x * y * (x + y) pow 2 <= (x pow 2 + y pow 2) pow 2`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Some examples over integers and natural numbers.                          *)
-(* ------------------------------------------------------------------------- *)
-
-time SOS_RULE `!m n. 2 * m + n = (n + m) + m`;;
-time SOS_RULE `!n. ~(n = 0) ==> (0 MOD n = 0)`;;
-time SOS_RULE  `!m n. m < n ==> (m DIV n = 0)`;;
-time SOS_RULE `!n:num. n <= n * n`;;
-time SOS_RULE  `!m n. n * (m DIV n) <= m`;;
-time SOS_RULE `!n. ~(n = 0) ==> (0 DIV n = 0)`;;
-time SOS_RULE `!m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`;;
-time SOS_RULE `!a b n. ~(a = 0) ==> (n <= b DIV a <=> a * n <= b)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* This is particularly gratifying --- cf hideous manual proof in arith.ml   *)
-(* ------------------------------------------------------------------------- *)
-
-(*** This doesn't now seem to work as well as it did; what changed?
-
-time SOS_RULE
- `!a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b`;;
-
- ***)
-
-(* ------------------------------------------------------------------------- *)
-(* Key lemma for injectivity of Cantor-type pairing functions.               *)
-(* ------------------------------------------------------------------------- *)
-
-time SOS_RULE
- `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1)
-                ==> (x1 + y1 = x2 + y2)`;;
-
-time SOS_RULE
- `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1) /\
-                (x1 + y1 = x2 + y2)
-                ==> (x1 = x2) /\ (y1 = y2)`;;
-
-time SOS_RULE
- `!x1 y1 x2 y2.
-      (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 =
-       ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2)
-       ==> (x1 + y1 = x2 + y2)`;;
-
-time SOS_RULE
- `!x1 y1 x2 y2.
-      (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 =
-       ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2) /\
-      (x1 + y1 = x2 + y2)
-      ==> (x1 = x2) /\ (y1 = y2)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Reciprocal multiplication (actually just ARITH_RULE does these).          *)
-(* ------------------------------------------------------------------------- *)
-
-time SOS_RULE `x <= 127 ==> ((86 * x) DIV 256 = x DIV 3)`;;
-
-time SOS_RULE `x < 2 EXP 16 ==> ((104858 * x) DIV (2 EXP 20) = x DIV 10)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* This is more impressive since it's really nonlinear. See REMAINDER_DECODE *)
-(* ------------------------------------------------------------------------- *)
-
-time SOS_RULE `0 < m /\ m < n  ==> ((m * ((n * x) DIV m + 1)) DIV n = x)`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Some conversion examples.                                                 *)
-(* ------------------------------------------------------------------------- *)
-
-time SOS_CONV
- `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;;
-
-time SOS_CONV
- `x pow 4 - (&2 * y * z + &1) * x pow 2 +
-  (y pow 2 * z pow 2 + &2 * y * z + &2)`;;
-
-time SOS_CONV `&4 * x pow 4 +
-          &4 * x pow 3 * y - &7 * x pow 2 * y pow 2 - &2 * x * y pow 3 +
-          &10 * y pow 4`;;
-
-time SOS_CONV `&4 * x pow 4 * y pow 6 + x pow 2 - x * y pow 2 + y pow 2`;;
-
-time SOS_CONV
-  `&4096 * (x pow 4 + x pow 2 + z pow 6 - &3 * x pow 2 * z pow 2) + &729`;;
-
-time SOS_CONV
- `&120 * x pow 2 - &63 * x pow 4 + &10 * x pow 6 +
-  &30 * x * y - &120 * y pow 2 + &120 * y pow 4 + &31`;;
-
-time SOS_CONV
- `&9 * x pow 2 * y pow 4 + &9 * x pow 2 * z pow 4 + &36 * x pow 2 * y pow 3 +
-  &36 * x pow 2 * y pow 2 - &48 * x * y * z pow 2 + &4 * y pow 4 +
-  &4 * z pow 4 - &16 * y pow 3 + &16 * y pow 2`;;
-
-time SOS_CONV
- `(x pow 2 + y pow 2 + z pow 2) *
-  (x pow 4 * y pow 2 + x pow 2 * y pow 4 +
-   z pow 6 - &3 * x pow 2 * y pow 2 *   z pow 2)`;;
-
-time SOS_CONV
- `x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3`;;
-
-(*** I think this will work, but normalization is slow
-
-time SOS_CONV
- `&100 * (x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z) + &212`;;
-
- ***)
-
-time SOS_CONV
- `&100 * ((&2 * x - &2) pow 2 + (x pow 3 - &8 * x - &2) pow 2) - &588`;;
-
-time SOS_CONV
- `x pow 2 * (&120 - &63 * x pow 2 + &10 * x pow 4) + &30 * x * y +
-    &30 * y pow 2 * (&4 * y pow 2 - &4) + &31`;;
-
-(* ------------------------------------------------------------------------- *)
-(* Example of basic rule.                                                    *)
-(* ------------------------------------------------------------------------- *)
-
-time PURE_SOS
-  `!x. x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3
-       >= &1 / &7`;;
-
-time PURE_SOS
- `&0 <= &98 * x pow 12 +
-        -- &980 * x pow 10 +
-        &3038 * x pow 8 +
-        -- &2968 * x pow 6 +
-        &1022 * x pow 4 +
-        -- &84 * x pow 2 +
-        &2`;;
-
-time PURE_SOS
- `!x. &0 <= &2 * x pow 14 +
-            -- &84 * x pow 12 +
-            &1022 * x pow 10 +
-            -- &2968 * x pow 8 +
-            &3038 * x pow 6 +
-            -- &980 * x pow 4 +
-            &98 * x pow 2`;;
-
-(* ------------------------------------------------------------------------- *)
-(* From Zeng et al, JSC vol 37 (2004), p83-99.                               *)
-(* All of them work nicely with pure SOS_CONV, except (maybe) the one noted. *)
-(* ------------------------------------------------------------------------- *)
-
-PURE_SOS
-  `x pow 6 + y pow 6 + z pow 6 - &3 * x pow 2 * y pow 2 * z pow 2 >= &0`;;
-
-PURE_SOS `x pow 4 + y pow 4 + z pow 4 + &1 - &4*x*y*z >= &0`;;
-
-PURE_SOS `x pow 4 + &2*x pow 2*z + x pow 2 - &2*x*y*z + &2*y pow 2*z pow 2 +
-&2*y*z pow 2 + &2*z pow 2 - &2*x + &2* y*z + &1 >= &0`;;
-
-(**** This is harder. Interestingly, this fails the pure SOS test, it seems.
-      Yet only on rounding(!?) Poor Newton polytope optimization or something?
-      But REAL_SOS does finally converge on the second run at level 12!
-
-REAL_SOS
-`x pow 4*y pow 4 - &2*x pow 5*y pow 3*z pow 2 + x pow 6*y pow 2*z pow 4 + &2*x
-pow 2*y pow 3*z - &4* x pow 3*y pow 2*z pow 3 + &2*x pow 4*y*z pow 5 + z pow
-2*y pow 2 - &2*z pow 4*y*x + z pow 6*x pow 2 >= &0`;;
-
- ****)
-
-PURE_SOS
-`x pow 4 + &4*x pow 2*y pow 2 + &2*x*y*z pow 2 + &2*x*y*w pow 2 + y pow 4 + z
-pow 4 + w pow 4 + &2*z pow 2*w pow 2 + &2*x pow 2*w + &2*y pow 2*w + &2*x*y +
-&3*w pow 2 + &2*z pow 2 + &1 >= &0`;;
-
-PURE_SOS
-`w pow 6 + &2*z pow 2*w pow 3 + x pow 4 + y pow 4 + z pow 4 + &2*x pow 2*w +
-&2*x pow 2*z + &3*x pow 2 + w pow 2 + &2*z*w + z pow 2 + &2*z + &2*w + &1 >=
-&0`;;
-
-*****)
diff --git a/plugins/micromega/sos_lib.ml b/plugins/micromega/sos_lib.ml
index 6b8b820a..6aebc4ca 100644
--- a/plugins/micromega/sos_lib.ml
+++ b/plugins/micromega/sos_lib.ml
@@ -9,8 +9,6 @@
 
 open Num
 
-let debugging = ref false;;
-
 (* ------------------------------------------------------------------------- *)
 (* Comparisons that are reflexive on NaN and also short-circuiting.          *)
 (* ------------------------------------------------------------------------- *)
@@ -21,7 +19,6 @@ let (=?) = fun x y -> cmp x y = 0;;
 let (<?) = fun x y -> cmp x y < 0;;
 let (<=?) = fun x y -> cmp x y <= 0;;
 let (>?) = fun x y -> cmp x y > 0;;
-let (>=?) = fun x y -> cmp x y >= 0;;
 
 (* ------------------------------------------------------------------------- *)
 (* Combinators.                                                              *)
@@ -59,48 +56,29 @@ let lcm_num x y =
 
 
 (* ------------------------------------------------------------------------- *)
-(* List basics.                                                              *)
-(* ------------------------------------------------------------------------- *)
-
-let rec el n l =
-  if n = 0 then List.hd l else el (n - 1) (List.tl l);;
-
-
-(* ------------------------------------------------------------------------- *)
 (* Various versions of list iteration.                                       *)
 (* ------------------------------------------------------------------------- *)
 
-let rec itlist f l b =
-  match l with
-    [] -> b
-  | (h::t) -> f h (itlist f t b);;
-
 let rec end_itlist f l =
   match l with
         []     -> failwith "end_itlist"
       | [x]    -> x
       | (h::t) -> f h (end_itlist f t);;
 
-let rec itlist2 f l1 l2 b =
-  match (l1,l2) with
-    ([],[]) -> b
-  | (h1::t1,h2::t2) -> f h1 h2 (itlist2 f t1 t2 b)
-  | _ -> failwith "itlist2";;
-
 (* ------------------------------------------------------------------------- *)
 (* All pairs arising from applying a function over two lists.                *)
 (* ------------------------------------------------------------------------- *)
 
 let rec allpairs f l1 l2 =
   match l1 with
-   h1::t1 ->  itlist (fun x a -> f h1 x :: a) l2 (allpairs f t1 l2)
+   h1::t1 -> List.fold_right (fun x a -> f h1 x :: a) l2 (allpairs f t1 l2)
   | [] -> [];;
 
 (* ------------------------------------------------------------------------- *)
 (* String operations (surely there is a better way...)                       *)
 (* ------------------------------------------------------------------------- *)
 
-let implode l = itlist (^) l "";;
+let implode l = List.fold_right (^) l "";;
 
 let explode s =
   let rec exap n l =
@@ -110,13 +88,6 @@ let explode s =
 
 
 (* ------------------------------------------------------------------------- *)
-(* Attempting function or predicate applications.                            *)
-(* ------------------------------------------------------------------------- *)
-
-let can f x = try (f x; true) with Failure _ -> false;;
-
-
-(* ------------------------------------------------------------------------- *)
 (* Repetition of a function.                                                 *)
 (* ------------------------------------------------------------------------- *)
 
@@ -126,36 +97,20 @@ let rec funpow n f x =
 
 
 (* ------------------------------------------------------------------------- *)
-(* Replication and sequences.                                                *)
+(* Sequences.                                                *)
 (* ------------------------------------------------------------------------- *)
 
-let rec replicate x n =
-    if n < 1 then []
-    else x::(replicate x (n - 1));;
-
 let rec (--) = fun m n -> if m > n then [] else m::((m + 1) -- n);;
 
 (* ------------------------------------------------------------------------- *)
 (* Various useful list operations.                                           *)
 (* ------------------------------------------------------------------------- *)
 
-let rec forall p l =
-  match l with
-    [] -> true
-  | h::t -> p(h) && forall p t;;
-
 let rec tryfind f l =
   match l with
       [] -> failwith "tryfind"
     | (h::t) -> try f h with Failure _ -> tryfind f t;;
 
-let index x =
-  let rec ind n l =
-    match l with
-      [] -> failwith "index"
-    | (h::t) -> if x =? h then n else ind (n + 1) t in
-  ind 0;;
-
 (* ------------------------------------------------------------------------- *)
 (* "Set" operations on lists.                                                *)
 (* ------------------------------------------------------------------------- *)
@@ -168,46 +123,16 @@ let rec mem x lis =
 let insert x l =
   if mem x l then l else x::l;;
 
-let union l1 l2 = itlist insert l1 l2;;
+let union l1 l2 = List.fold_right insert l1 l2;;
 
 let subtract l1 l2 = List.filter (fun x -> not (mem x l2)) l1;;
 
 (* ------------------------------------------------------------------------- *)
-(* Merging and bottom-up mergesort.                                          *)
-(* ------------------------------------------------------------------------- *)
-
-let rec merge ord l1 l2 =
-  match l1 with
-    [] -> l2
-  | h1::t1 -> match l2 with
-                [] -> l1
-              | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2)
-                          else h2::(merge ord l1 t2);;
-
-
-(* ------------------------------------------------------------------------- *)
 (* Common measure predicates to use with "sort".                             *)
 (* ------------------------------------------------------------------------- *)
 
 let increasing f x y = f x <? f y;;
 
-let decreasing f x y = f x >? f y;;
-
-(* ------------------------------------------------------------------------- *)
-(* Zipping, unzipping etc.                                                   *)
-(* ------------------------------------------------------------------------- *)
-
-let rec zip l1 l2 =
-  match (l1,l2) with
-        ([],[]) -> []
-      | (h1::t1,h2::t2) -> (h1,h2)::(zip t1 t2)
-      | _ -> failwith "zip";;
-
-let rec unzip =
-  function [] -> [],[]
-         | ((a,b)::rest) -> let alist,blist = unzip rest in
-                            (a::alist,b::blist);;
-
 (* ------------------------------------------------------------------------- *)
 (* Iterating functions over lists.                                           *)
 (* ------------------------------------------------------------------------- *)
@@ -443,8 +368,6 @@ let apply f = applyd f (fun x -> failwith "apply");;
 
 let tryapplyd f a d = applyd f (fun x -> d) a;;
 
-let defined f x = try apply f x; true with Failure _ -> false;;
-
 (* ------------------------------------------------------------------------- *)
 (* Undefinition.                                                             *)
 (* ------------------------------------------------------------------------- *)
@@ -490,8 +413,6 @@ let graph f = setify (foldl (fun a x y -> (x,y)::a) [] f);;
 
 let dom f = setify(foldl (fun a x y -> x::a) [] f);;
 
-let ran f = setify(foldl (fun a x y -> y::a) [] f);;
-
 (* ------------------------------------------------------------------------- *)
 (* More parser basics.                                                       *)
 (* ------------------------------------------------------------------------- *)
@@ -499,7 +420,7 @@ let ran f = setify(foldl (fun a x y -> y::a) [] f);;
 exception Noparse;;
 
 
-let isspace,issep,isbra,issymb,isalpha,isnum,isalnum =
+let isspace,isnum =
   let charcode s = Char.code(String.get s 0) in
   let spaces = " \t\n\r"
   and separators = ",;"
@@ -508,7 +429,7 @@ let isspace,issep,isbra,issymb,isalpha,isnum,isalnum =
   and alphas = "'abcdefghijklmnopqrstuvwxyz_ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   and nums = "0123456789" in
   let allchars = spaces^separators^brackets^symbs^alphas^nums in
-  let csetsize = itlist ((o) max charcode) (explode allchars) 256 in
+  let csetsize = List.fold_right ((o) max charcode) (explode allchars) 256 in
   let ctable = Array.make csetsize 0 in
   do_list (fun c -> Array.set ctable (charcode c) 1) (explode spaces);
   do_list (fun c -> Array.set ctable (charcode c) 2) (explode separators);
@@ -517,13 +438,8 @@ let isspace,issep,isbra,issymb,isalpha,isnum,isalnum =
   do_list (fun c -> Array.set ctable (charcode c) 16) (explode alphas);
   do_list (fun c -> Array.set ctable (charcode c) 32) (explode nums);
   let isspace c = Array.get ctable (charcode c) = 1
-  and issep c  = Array.get ctable (charcode c) = 2
-  and isbra c  = Array.get ctable (charcode c) = 4
-  and issymb c = Array.get ctable (charcode c) = 8
-  and isalpha c = Array.get ctable (charcode c) = 16
-  and isnum c = Array.get ctable (charcode c) = 32
-  and isalnum c = Array.get ctable (charcode c) >= 16 in
-  isspace,issep,isbra,issymb,isalpha,isnum,isalnum;;
+  and isnum c = Array.get ctable (charcode c) = 32 in
+  isspace,isnum;;
 
 let parser_or parser1 parser2 input =
   try parser1 input
@@ -566,9 +482,6 @@ let rec atleast n prs i =
   (if n <= 0 then many prs
    else prs ++ atleast (n - 1) prs >> (fun (h,t) -> h::t)) i;;
 
-let finished input =
-  if input = [] then 0,input else failwith "Unparsed input";;
-
 (* ------------------------------------------------------------------------- *)
 
 let temp_path = Filename.get_temp_dir_name ();;
@@ -589,7 +502,7 @@ let strings_of_file filename =
   (Pervasives.close_in fd; data);;
 
 let string_of_file filename =
-  end_itlist (fun s t -> s^"\n"^t) (strings_of_file filename);;
+  String.concat "\n" (strings_of_file filename);;
 
 let file_of_string filename s =
   let fd = Pervasives.open_out filename in
diff --git a/plugins/micromega/sos_lib.mli b/plugins/micromega/sos_lib.mli
new file mode 100644
index 00000000..8b53b815
--- /dev/null
+++ b/plugins/micromega/sos_lib.mli
@@ -0,0 +1,79 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
+
+val num_1 : Num.num
+val pow10 : int -> Num.num
+val pow2 : int -> Num.num
+
+val implode : string list -> string
+val explode : string -> string list
+
+val funpow : int -> ('a -> 'a) -> 'a -> 'a
+val tryfind : ('a -> 'b) -> 'a list -> 'b
+
+type ('a,'b) func =
+ | Empty
+ | Leaf of int * ('a*'b) list
+ | Branch of int * int * ('a,'b) func * ('a,'b) func
+
+val undefined : ('a, 'b) func
+val is_undefined : ('a, 'b) func -> bool
+val (|->) : 'a -> 'b -> ('a, 'b) func -> ('a, 'b) func
+val (|=>) : 'a -> 'b -> ('a, 'b) func
+val choose : ('a, 'b) func -> 'a * 'b
+val combine : ('a -> 'a -> 'a) -> ('a -> bool) -> ('b, 'a) func -> ('b, 'a) func -> ('b, 'a) func
+val (--) : int -> int -> int list
+
+val tryapplyd : ('a, 'b) func -> 'a -> 'b -> 'b
+val apply : ('a, 'b) func -> 'a -> 'b
+
+val foldl : ('a -> 'b -> 'c -> 'a) -> 'a -> ('b, 'c) func -> 'a
+val foldr : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) func -> 'c -> 'c
+val mapf : ('a -> 'b) -> ('c, 'a) func -> ('c, 'b) func
+
+val undefine : 'a -> ('a, 'b) func -> ('a, 'b) func
+
+val dom : ('a, 'b) func -> 'a list
+val graph : ('a, 'b) func -> ('a * 'b) list
+
+val union : 'a list -> 'a list -> 'a list
+val subtract : 'a list -> 'a list -> 'a list
+val sort : ('a -> 'a -> bool) -> 'a list -> 'a list
+val setify : 'a list -> 'a list
+val increasing : ('a -> 'b) -> 'a -> 'a -> bool
+val allpairs : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+
+val gcd_num : Num.num -> Num.num -> Num.num
+val lcm_num : Num.num -> Num.num -> Num.num
+val numerator : Num.num -> Num.num
+val denominator : Num.num -> Num.num
+val end_itlist : ('a -> 'a -> 'a) -> 'a list -> 'a
+
+val (>>) : ('a -> 'b * 'c) -> ('b -> 'd) -> 'a -> 'd * 'c
+val (++) : ('a -> 'b * 'c) -> ('c -> 'd * 'e) -> 'a -> ('b * 'd) * 'e
+
+val a : 'a -> 'a list -> 'a * 'a list
+val many : ('a -> 'b * 'a) -> 'a -> 'b list * 'a
+val some : ('a -> bool) -> 'a list -> 'a * 'a list
+val possibly : ('a -> 'b * 'a) -> 'a -> 'b list * 'a
+val isspace : string -> bool
+val parser_or : ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b
+val isnum : string -> bool
+val atleast : int -> ('a -> 'b * 'a) -> 'a -> 'b list * 'a
+val listof : ('a -> 'b * 'c) -> ('c -> 'd * 'a) -> string -> 'a -> 'b list * 'c
+
+val temp_path : string
+val string_of_file : string -> string
+val file_of_string : string -> string -> unit
+
+val deepen_until : int -> (int -> 'a) -> int -> 'a
+exception TooDeep
diff --git a/plugins/nsatz/g_nsatz.ml4 b/plugins/nsatz/g_nsatz.mlg
index 4ac49adb..16ff512e 100644
--- a/plugins/nsatz/g_nsatz.ml4
+++ b/plugins/nsatz/g_nsatz.mlg
@@ -8,11 +8,15 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Ltac_plugin
 open Stdarg
 
+}
+
 DECLARE PLUGIN "nsatz_plugin"
 
 TACTIC EXTEND nsatz_compute
-| [ "nsatz_compute"  constr(lt) ] -> [ Nsatz.nsatz_compute (EConstr.Unsafe.to_constr lt) ]
+| [ "nsatz_compute"  constr(lt) ] -> { Nsatz.nsatz_compute (EConstr.Unsafe.to_constr lt) }
 END
diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml
index 81b44ffa..d2d4639d 100644
--- a/plugins/nsatz/nsatz.ml
+++ b/plugins/nsatz/nsatz.ml
@@ -136,7 +136,7 @@ let mul = function
   | (Const n,q) when eq_num n num_1 -> q
   | (p,q) -> Mul(p,q)
 
-let gen_constant msg path s = Universes.constr_of_global @@
+let gen_constant msg path s = UnivGen.constr_of_global @@
   coq_reference msg path s
 
 let tpexpr  = lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PExpr")
diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v
index 59fd9b80..94a3d404 100644
--- a/plugins/omega/PreOmega.v
+++ b/plugins/omega/PreOmega.v
@@ -85,6 +85,7 @@ Ltac zify_binop t thm a b:=
 
 Ltac zify_op_1 :=
   match goal with
+   | x := ?t : Z |- _ => let h := fresh "heq_" x in pose proof (eq_refl : x = t) as h; clearbody x
    | |- context [ Z.max ?a ?b ] => zify_binop Z.max Z.max_spec a b
    | H : context [ Z.max ?a ?b ] |- _ => zify_binop Z.max Z.max_spec a b
    | |- context [ Z.min ?a ?b ] => zify_binop Z.min Z.min_spec a b
@@ -114,6 +115,7 @@ Ltac hide_Z_of_nat t :=
 Ltac zify_nat_rel :=
  match goal with
   (* I: equalities *)
+  | x := ?t : nat |- _ => let h := fresh "heq_" x in pose proof (eq_refl : x = t) as h; clearbody x
   | |- (@eq nat ?a ?b) => apply (Nat2Z.inj a b) (* shortcut *)
   | H : context [ @eq nat ?a ?b ] |- _ => rewrite <- (Nat2Z.inj_iff a b) in H
   | |- context [ @eq nat ?a ?b ] =>       rewrite <- (Nat2Z.inj_iff a b)
@@ -181,7 +183,7 @@ Ltac zify_nat_op :=
         let t := eval compute in (Z.of_nat (S a)) in
         change (Z.of_nat (S a)) with t in H
       | _ => rewrite (Nat2Z.inj_succ a) in H
-      | _ => (* if the [rewrite] fails (most likely a dependent occurence of [Z.of_nat (S a)]),
+      | _ => (* if the [rewrite] fails (most likely a dependent occurrence of [Z.of_nat (S a)]),
                 hide [Z.of_nat (S a)] in this one hypothesis *)
         change (Z.of_nat (S a)) with (Z_of_nat' (S a)) in H
      end
@@ -192,7 +194,7 @@ Ltac zify_nat_op :=
         let t := eval compute in (Z.of_nat (S a)) in
         change (Z.of_nat (S a)) with t
       | _ => rewrite (Nat2Z.inj_succ a)
-      | _ => (* if the [rewrite] fails (most likely a dependent occurence of [Z.of_nat (S a)]),
+      | _ => (* if the [rewrite] fails (most likely a dependent occurrence of [Z.of_nat (S a)]),
                 hide [Z.of_nat (S a)] in the goal *)
         change (Z.of_nat (S a)) with (Z_of_nat' (S a))
      end
@@ -223,6 +225,7 @@ Ltac hide_Zpos t :=
 Ltac zify_positive_rel :=
  match goal with
   (* I: equalities *)
+  | x := ?t : positive |- _ => let h := fresh "heq_" x in pose proof (eq_refl : x = t) as h; clearbody x
   | |- (@eq positive ?a ?b) => apply Pos2Z.inj
   | H : context [ @eq positive ?a ?b ] |- _ => rewrite <- (Pos2Z.inj_iff a b) in H
   | |- context [ @eq positive ?a ?b ] =>       rewrite <- (Pos2Z.inj_iff a b)
@@ -348,6 +351,7 @@ Ltac hide_Z_of_N t :=
 Ltac zify_N_rel :=
  match goal with
   (* I: equalities *)
+  | x := ?t : N |- _ => let h := fresh "heq_" x in pose proof (eq_refl : x = t) as h; clearbody x
   | |- (@eq N ?a ?b) => apply (N2Z.inj a b) (* shortcut *)
   | H : context [ @eq N ?a ?b ] |- _ => rewrite <- (N2Z.inj_iff a b) in H
   | |- context [ @eq N ?a ?b ] =>       rewrite <- (N2Z.inj_iff a b)
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index 51cd665f..e14c4e2e 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -18,8 +18,8 @@
 open CErrors
 open Util
 open Names
+open Constr
 open Nameops
-open Term
 open EConstr
 open Tacticals.New
 open Tacmach.New
@@ -29,7 +29,7 @@ open Libnames
 open Globnames
 open Nametab
 open Contradiction
-open Misctypes
+open Tactypes
 open Context.Named.Declaration
 
 module NamedDecl = Context.Named.Declaration
@@ -38,15 +38,9 @@ open OmegaSolver
 
 (* Added by JCF, 09/03/98 *)
 
-let elim_id id =
-  Proofview.Goal.enter begin fun gl ->
-    simplest_elim (mkVar id)
-  end
-let resolve_id id = Proofview.Goal.enter begin fun gl ->
-  apply (mkVar id)
-end
+let elim_id id = simplest_elim (mkVar id)
 
-let timing timer_name f arg = f arg
+let resolve_id id = apply (mkVar id)
 
 let display_time_flag = ref false
 let display_system_flag = ref false
@@ -206,7 +200,7 @@ let coq_modules =
   init_modules @arith_modules @ [logic_dir] @ zarith_base_modules
     @ [["Coq"; "omega"; "OmegaLemmas"]]
 
-let gen_constant_in_modules n m s = EConstr.of_constr (Universes.constr_of_global @@ gen_reference_in_modules n m s)
+let gen_constant_in_modules n m s = EConstr.of_constr (UnivGen.constr_of_global @@ gen_reference_in_modules n m s)
 let init_constant = gen_constant_in_modules "Omega" init_modules
 let constant = gen_constant_in_modules "Omega" coq_modules
 
@@ -369,8 +363,11 @@ let coq_True = lazy (init_constant "True")
 (* uses build_coq_and, build_coq_not, build_coq_or, build_coq_ex *)
 
 (* For unfold *)
-let evaluable_ref_of_constr s c = match EConstr.kind Evd.empty (Lazy.force c) with
-  | Const (kn,u) when Tacred.is_evaluable (Global.env()) (EvalConstRef kn) ->
+let evaluable_ref_of_constr s c =
+  let env = Global.env () in
+  let evd = Evd.from_env env in
+  match EConstr.kind evd (Lazy.force c) with
+  | Const (kn,u) when Tacred.is_evaluable env (EvalConstRef kn) ->
       EvalConstRef kn
   | _ -> anomaly ~label:"Coq_omega" (Pp.str (s^" is not an evaluable constant."))
 
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.mlg
index 170b937c..c3d063cf 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.mlg
@@ -18,6 +18,8 @@
 
 DECLARE PLUGIN "omega_plugin"
 
+{
+
 open Ltac_plugin
 open Names
 open Coq_omega
@@ -43,14 +45,15 @@ let omega_tactic l =
     (Tacticals.New.tclREPEAT (Tacticals.New.tclTHENLIST tacs))
     (omega_solver)
 
+}
 
 TACTIC EXTEND omega
-|  [ "omega" ] -> [ omega_tactic [] ]
+|  [ "omega" ] -> { omega_tactic [] }
 END
 
 TACTIC EXTEND omega'
 | [ "omega" "with" ne_ident_list(l) ] ->
-    [ omega_tactic (List.map Names.Id.to_string l) ]
-| [ "omega" "with" "*" ] -> [ omega_tactic ["nat";"positive";"N";"Z"] ]
+    { omega_tactic (List.map Names.Id.to_string l) }
+| [ "omega" "with" "*" ] -> { omega_tactic ["nat";"positive";"N";"Z"] }
 END
 
diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml
index 2510c169..7bca7c70 100644
--- a/plugins/omega/omega.ml
+++ b/plugins/omega/omega.ml
@@ -178,7 +178,7 @@ let rec display_action print_var = function
       | DIVIDE_AND_APPROX (e1,e2,k,d) ->
           Printf.printf
             "Inequation E%d is divided by %s and the constant coefficient is \
-            rounded by substracting %s.\n" e1.id (sbi k) (sbi d)
+            rounded by subtracting %s.\n" e1.id (sbi k) (sbi d)
       | NOT_EXACT_DIVIDE (e,k) ->
           Printf.printf
             "Constant in equation E%d is not divisible by the pgcd \
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.mlg
index c35e0fe1..749903c3 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.mlg
@@ -8,32 +8,39 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
+
 open Ltac_plugin
 open Names
-open Misctypes
 open Tacexpr
 open Geninterp
 open Quote
 open Stdarg
 open Tacarg
 
+}
+
 DECLARE PLUGIN "quote_plugin"
 
+{
+
 let cont = Id.of_string "cont"
 let x = Id.of_string "x"
 
 let make_cont (k : Val.t) (c : EConstr.t) =
   let c = Tacinterp.Value.of_constr c in
-  let tac = TacCall (Loc.tag (ArgVar CAst.(make cont), [Reference (ArgVar CAst.(make x))])) in
+  let tac = TacCall (Loc.tag (Locus.ArgVar CAst.(make cont), [Reference (Locus.ArgVar CAst.(make x))])) in
   let ist = { lfun = Id.Map.add cont k (Id.Map.singleton x c); extra = TacStore.empty; } in
   Tacinterp.eval_tactic_ist ist (TacArg (Loc.tag tac))
 
+}
+
 TACTIC EXTEND quote
-  [ "quote" ident(f) ] -> [ quote f [] ]
-| [ "quote" ident(f) "[" ne_ident_list(lc) "]"] -> [ quote f lc ]
+| [ "quote" ident(f) ] -> { quote f [] }
+| [ "quote" ident(f) "[" ne_ident_list(lc) "]"] -> { quote f lc }
 | [ "quote" ident(f) "in" constr(c) "using" tactic(k) ] ->
-  [ gen_quote (make_cont k) c f [] ]
+  { gen_quote (make_cont k) c f [] }
 | [ "quote" ident(f) "[" ne_ident_list(lc) "]"
     "in" constr(c) "using" tactic(k) ] ->
-  [ gen_quote (make_cont k) c f lc ]
+  { gen_quote (make_cont k) c f lc }
 END
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index 912429c3..7464b42d 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -120,7 +120,7 @@ open Proofview.Notations
   the constants are loaded in the environment *)
 
 let constant dir s =
-  EConstr.of_constr @@ Universes.constr_of_global @@
+  EConstr.of_constr @@ UnivGen.constr_of_global @@
     Coqlib.coq_reference "Quote" ("quote"::dir) s
 
 let coq_Empty_vm = lazy (constant ["Quote"] "Empty_vm")
diff --git a/plugins/romega/const_omega.ml b/plugins/romega/const_omega.ml
index ad3afafd..949cba2d 100644
--- a/plugins/romega/const_omega.ml
+++ b/plugins/romega/const_omega.ml
@@ -69,19 +69,19 @@ let z_module = [["Coq";"ZArith";"BinInt"]]
 
 let init_constant x =
   EConstr.of_constr @@
-  Universes.constr_of_global @@
+  UnivGen.constr_of_global @@
   Coqlib.gen_reference_in_modules "Omega" Coqlib.init_modules x
 let constant x =
   EConstr.of_constr @@
-  Universes.constr_of_global @@
+  UnivGen.constr_of_global @@
   Coqlib.gen_reference_in_modules "Omega" coq_modules x
 let z_constant x =
   EConstr.of_constr @@
-  Universes.constr_of_global @@
+  UnivGen.constr_of_global @@
   Coqlib.gen_reference_in_modules "Omega" z_module x
 let bin_constant x =
   EConstr.of_constr @@
-  Universes.constr_of_global @@
+  UnivGen.constr_of_global @@
   Coqlib.gen_reference_in_modules "Omega" bin_module x
 
 (* Logic *)
@@ -170,7 +170,7 @@ let mk_list univ typ l =
   loop l
 
 let mk_plist =
-  let type1lev = Universes.new_univ_level () in
+  let type1lev = UnivGen.new_univ_level () in
   fun l -> mk_list type1lev EConstr.mkProp l
 
 let mk_list = mk_list Univ.Level.set
diff --git a/plugins/romega/g_romega.ml4 b/plugins/romega/g_romega.mlg
index 5b77d08d..ac4f30b1 100644
--- a/plugins/romega/g_romega.ml4
+++ b/plugins/romega/g_romega.mlg
@@ -9,6 +9,8 @@
 
 DECLARE PLUGIN "romega_plugin"
 
+{
+
 open Ltac_plugin
 open Names
 open Refl_omega
@@ -39,13 +41,23 @@ let romega_tactic unsafe l =
        (Tactics.intros)
        (total_reflexive_omega_tactic unsafe))
 
+let romega_depr =
+  Vernacinterp.mk_deprecation
+    ~since:(Some "8.9")
+    ~note:(Some "Use lia instead.")
+    ()
+
+}
+
 TACTIC EXTEND romega
-|  [ "romega" ] -> [ romega_tactic false [] ]
-|  [ "unsafe_romega" ] -> [ romega_tactic true [] ]
+DEPRECATED { romega_depr }
+|  [ "romega" ] -> { romega_tactic false [] }
+|  [ "unsafe_romega" ] -> { romega_tactic true [] }
 END
 
 TACTIC EXTEND romega'
+DEPRECATED { romega_depr }
 | [ "romega" "with" ne_ident_list(l) ] ->
-    [ romega_tactic false (List.map Names.Id.to_string l) ]
-| [ "romega" "with" "*" ] -> [ romega_tactic false ["nat";"positive";"N";"Z"] ]
+    { romega_tactic false (List.map Names.Id.to_string l) }
+| [ "romega" "with" "*" ] -> { romega_tactic false ["nat";"positive";"N";"Z"] }
 END
diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml
index d1824978..e6034806 100644
--- a/plugins/romega/refl_omega.ml
+++ b/plugins/romega/refl_omega.ml
@@ -8,6 +8,7 @@
 
 open Pp
 open Util
+open Constr
 open Const_omega
 module OmegaSolver = Omega_plugin.Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
@@ -1036,13 +1037,13 @@ let resolution unsafe sigma env (reified_concl,reified_hyps) systems_list =
   let decompose_tactic = decompose_tree env context solution_tree in
 
   Tactics.generalize (l_generalize_arg @ l_reified_hypnames) >>
-  Tactics.convert_concl_no_check reified Term.DEFAULTcast >>
+  Tactics.convert_concl_no_check reified DEFAULTcast >>
   Tactics.apply (app coq_do_omega [|decompose_tactic|]) >>
   show_goal >>
   (if unsafe then
      (* Trust the produced term. Faster, but might fail later at Qed.
         Also handy when debugging, e.g. via a Show Proof after romega. *)
-     Tactics.convert_concl_no_check (Lazy.force coq_True) Term.VMcast
+     Tactics.convert_concl_no_check (Lazy.force coq_True) VMcast
    else
      Tactics.normalise_vm_in_concl) >>
   Tactics.apply (Lazy.force coq_I)
diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.mlg
index aa675763..9c9fdcfa 100644
--- a/plugins/rtauto/g_rtauto.ml4
+++ b/plugins/rtauto/g_rtauto.mlg
@@ -8,12 +8,15 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+{
 
 open Ltac_plugin
 
+}
+
 DECLARE PLUGIN "rtauto_plugin"
 
 TACTIC EXTEND rtauto
-  [ "rtauto" ] -> [ Proofview.V82.tactic (Refl_tauto.rtauto_tac) ]
+| [ "rtauto" ] -> { Proofview.V82.tactic (Refl_tauto.rtauto_tac) }
 END
 
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 946b6dff..8a0f48dc 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -26,27 +26,27 @@ let step_count = ref 0
 
 let node_count = ref 0
 
-let logic_constant s = Universes.constr_of_global @@
+let logic_constant s = UnivGen.constr_of_global @@
   Coqlib.coq_reference "refl_tauto" ["Init";"Logic"] s
 
 let li_False = lazy (destInd (logic_constant "False"))
 let li_and   = lazy (destInd (logic_constant "and"))
 let li_or    = lazy (destInd (logic_constant "or"))
 
-let pos_constant s = Universes.constr_of_global @@
+let pos_constant s = UnivGen.constr_of_global @@
   Coqlib.coq_reference "refl_tauto" ["Numbers";"BinNums"] s
 
 let l_xI = lazy (pos_constant "xI")
 let l_xO = lazy (pos_constant "xO")
 let l_xH = lazy (pos_constant "xH")
 
-let store_constant s = Universes.constr_of_global @@
+let store_constant s = UnivGen.constr_of_global @@
   Coqlib.coq_reference "refl_tauto" ["rtauto";"Bintree"] s
 
 let l_empty = lazy (store_constant "empty")
 let l_push = lazy (store_constant "push")
 
-let constant s = Universes.constr_of_global @@
+let constant s = UnivGen.constr_of_global @@
   Coqlib.coq_reference "refl_tauto" ["rtauto";"Rtauto"] s
 
 let l_Reflect = lazy (constant "Reflect")
diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4
index 5e4c9214..4ea0b30b 100644
--- a/plugins/setoid_ring/g_newring.ml4
+++ b/plugins/setoid_ring/g_newring.ml4
@@ -29,11 +29,6 @@ TACTIC EXTEND protect_fv
     [ protect_tac map ]
 END
 
-TACTIC EXTEND closed_term
-  [ "closed_term" constr(t) "[" ne_reference_list(l) "]" ] ->
-    [ closed_term t l ]
-END
-
 open Pptactic
 open Ppconstr
 
@@ -42,11 +37,11 @@ let pr_ring_mod = function
   | Ring_kind Abstract ->  str "abstract"
   | Ring_kind (Morphism morph) -> str "morphism" ++ pr_arg pr_constr_expr morph
   | Const_tac (CstTac cst_tac) -> str "constants" ++ spc () ++ str "[" ++ pr_raw_tactic cst_tac ++ str "]"
-  | Const_tac (Closed l) -> str "closed" ++ spc () ++ str "[" ++ prlist_with_sep spc pr_reference l ++ str "]"
+  | Const_tac (Closed l) -> str "closed" ++ spc () ++ str "[" ++ prlist_with_sep spc pr_qualid l ++ str "]"
   | Pre_tac t -> str "preprocess" ++ spc () ++ str "[" ++ pr_raw_tactic t ++ str "]"
   | Post_tac t -> str "postprocess" ++ spc () ++ str "[" ++ pr_raw_tactic t ++ str "]"
   | Setoid(sth,ext) -> str "setoid" ++ pr_arg pr_constr_expr sth ++ pr_arg pr_constr_expr ext
-  | Pow_spec(Closed l,spec) -> str "power_tac" ++ pr_arg pr_constr_expr spec ++ spc () ++ str "[" ++ prlist_with_sep spc pr_reference l ++ str "]"
+  | Pow_spec(Closed l,spec) -> str "power_tac" ++ pr_arg pr_constr_expr spec ++ spc () ++ str "[" ++ prlist_with_sep spc pr_qualid l ++ str "]"
   | Pow_spec(CstTac cst_tac,spec) -> str "power_tac" ++ pr_arg pr_constr_expr spec ++ spc () ++ str "[" ++ pr_raw_tactic cst_tac ++ str "]"
   | Sign_spec t -> str "sign" ++ pr_arg pr_constr_expr t
   | Div_spec t -> str "div" ++ pr_arg pr_constr_expr t
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index 99bb8440..a736eec5 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -20,6 +20,7 @@ open Environ
 open Libnames
 open Globnames
 open Glob_term
+open Locus
 open Tacexpr
 open Coqlib
 open Mod_subst
@@ -29,7 +30,6 @@ open Printer
 open Declare
 open Decl_kinds
 open Entries
-open Misctypes
 open Newring_ast
 open Proofview.Notations
 
@@ -40,11 +40,7 @@ let error msg = CErrors.user_err Pp.(str msg)
 
 type protect_flag = Eval|Prot|Rec
 
-let tag_arg tag_rec map subs i c =
-  match map i with
-      Eval -> mk_clos subs c
-    | Prot -> mk_atom c
-    | Rec -> if Int.equal i (-1) then mk_clos subs c else tag_rec c
+type protection = Evd.evar_map -> EConstr.t -> GlobRef.t -> (Int.t -> protect_flag) option
 
 let global_head_of_constr sigma c = 
   let f, args = decompose_app sigma c in
@@ -55,32 +51,24 @@ let global_of_constr_nofail c =
   try global_of_constr c
   with Not_found -> VarRef (Id.of_string "dummy")
 
-let rec mk_clos_but f_map subs t =
-  let open Term in
-  match f_map (global_of_constr_nofail t) with
-    | Some map -> tag_arg (mk_clos_but f_map subs) map subs (-1) t
-    | None ->
-        (match Constr.kind t with
-            App(f,args) -> mk_clos_app_but f_map subs f args 0
-          | Prod _ -> mk_clos_deep (mk_clos_but f_map) subs t
-          | _ -> mk_atom t)
+let rec mk_clos_but f_map n t =
+  let (f, args) = Constr.decompose_appvect t in
+  match f_map (global_of_constr_nofail f) with
+  | Some tag ->
+      let map i t = tag_arg f_map n (tag i) t in
+      if Array.is_empty args then map (-1) f
+      else mk_red (FApp (map (-1) f, Array.mapi map args))
+  | None -> mk_atom t
 
-and mk_clos_app_but f_map subs f args n =
-  let open Constr in
-  if n >= Array.length args then mk_atom(mkApp(f, args))
-  else
-    let fargs, args' = Array.chop n args in
-    let f' = mkApp(f,fargs) in
-    match f_map (global_of_constr_nofail f') with
-    | Some map ->
-       let f i t = tag_arg (mk_clos_but f_map subs) map subs i t in
-       mk_red (FApp (f (-1) f', Array.mapi f args'))
-    | None -> mk_atom (mkApp (f, args))
+and tag_arg f_map n tag c = match tag with
+| Eval -> mk_clos (Esubst.subs_id n) c
+| Prot -> mk_atom c
+| Rec -> mk_clos_but f_map n c
 
 let interp_map l t =
-  try Some(List.assoc_f eq_gr t l) with Not_found -> None
+  try Some(List.assoc_f GlobRef.equal t l) with Not_found -> None
 
-let protect_maps = ref String.Map.empty
+let protect_maps : protection String.Map.t ref = ref String.Map.empty
 let add_map s m = protect_maps := String.Map.add s m !protect_maps
 let lookup_map map =
   try String.Map.find map !protect_maps
@@ -90,8 +78,14 @@ let lookup_map map =
 let protect_red map env sigma c0 =
   let evars ev = Evarutil.safe_evar_value sigma ev in
   let c = EConstr.Unsafe.to_constr c0 in
-  EConstr.of_constr (kl (create_clos_infos ~evars all env) (create_tab ())
-    (mk_clos_but (lookup_map map sigma c0) (Esubst.subs_id 0) c));;
+  let tab = create_tab () in
+  let infos = create_clos_infos ~evars all env in
+  let map = lookup_map map sigma c0 in
+  let rec eval n c = match Constr.kind c with
+  | Prod (na, t, u) -> Constr.mkProd (na, eval n t, eval (n + 1) u)
+  | _ -> kl infos tab (mk_clos_but map n c)
+  in
+  EConstr.of_constr (eval 0 c)
 
 let protect_tac map =
   Tactics.reduct_option (protect_red map,DEFAULTcast) None
@@ -102,34 +96,36 @@ let protect_tac_in map id =
 
 (****************************************************************************)
 
-let closed_term t l =
-  let open Quote_plugin in
+let rec closed_under sigma cset t =
+  try
+    let (gr, _) = Termops.global_of_constr sigma t in
+    Refset_env.mem gr cset
+  with Not_found ->
+    match EConstr.kind sigma t with
+    | Cast(c,_,_) -> closed_under sigma cset c
+    | App(f,l) -> closed_under sigma cset f && Array.for_all (closed_under sigma cset) l
+    | _ -> false
+
+let closed_term args _ = match args with
+| [t; l] ->
+  let t = Option.get (Value.to_constr t) in
+  let l = List.map (fun c -> Value.cast (Genarg.topwit Stdarg.wit_ref) c) (Option.get (Value.to_list l)) in
   Proofview.tclEVARMAP >>= fun sigma ->
-  let l = List.map Universes.constr_of_global l in
-  let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in
-  if Quote.closed_under sigma cs t then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (mt())
-
-(* TACTIC EXTEND echo
-| [ "echo" constr(t) ] ->
-  [ Pp.msg (Termops.print_constr t);  Tacinterp.eval_tactic (TacId []) ]
-END;;*)
+  let cs = List.fold_right Refset_env.add l Refset_env.empty in
+  if closed_under sigma cs t then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (mt())
+| _ -> assert false
 
-(*
-let closed_term_ast l =
-  TacFun([Some(Id.of_string"t")],
-  TacAtom(Loc.ghost,TacExtend(Loc.ghost,"closed_term",
-  [Genarg.in_gen Constrarg.wit_constr (mkVar(Id.of_string"t"));
-   Genarg.in_gen (Genarg.wit_list Constrarg.wit_ref) l])))
-*)
-let closed_term_ast l =
+let closed_term_ast =
   let tacname = {
     mltac_plugin = "newring_plugin";
     mltac_tactic = "closed_term";
   } in
+  let () = Tacenv.register_ml_tactic tacname [|closed_term|] in
   let tacname = {
     mltac_name = tacname;
     mltac_index = 0;
   } in
+  fun l ->
   let l = List.map (fun gr -> ArgArg(Loc.tag gr)) l in
   TacFun([Name(Id.of_string"t")],
   TacML(Loc.tag (tacname,
@@ -154,8 +150,7 @@ let ic_unsafe c = (*FIXME remove *)
 
 let decl_constant na univs c =
   let open Constr in
-  let env = Global.env () in
-  let vars = Univops.universes_of_constr env c in
+  let vars = Univops.universes_of_constr c in
   let univs = Univops.restrict_universe_context univs vars in
   let univs = Monomorphic_const_entry univs in
   mkConst(declare_constant (Id.of_string na) 
@@ -166,28 +161,13 @@ let decl_constant na univs c =
 let ltac_call tac (args:glob_tactic_arg list) =
   TacArg(Loc.tag @@ TacCall (Loc.tag (ArgArg(Loc.tag @@ Lazy.force tac),args)))
 
-(* Calling a locally bound tactic *)
-let ltac_lcall tac args =
-  TacArg(Loc.tag @@ TacCall (Loc.tag (ArgVar CAst.(make @@ Id.of_string tac),args)))
-
-let ltac_apply (f : Value.t) (args: Tacinterp.Value.t list) =
-  let fold arg (i, vars, lfun) =
-    let id = Id.of_string ("x" ^ string_of_int i) in
-    let x = Reference (ArgVar CAst.(make id)) in
-    (succ i, x :: vars, Id.Map.add id arg lfun)
-  in
-  let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
-  let lfun = Id.Map.add (Id.of_string "F") f lfun in
-  let ist = { (Tacinterp.default_ist ()) with Tacinterp.lfun = lfun; } in
-  Tacinterp.eval_tactic_ist ist (ltac_lcall "F" args)
-
 let dummy_goal env sigma =
   let (gl,_,sigma) = 
     Goal.V82.mk_goal sigma (named_context_val env) EConstr.mkProp Evd.Store.empty in
   {Evd.it = gl; Evd.sigma = sigma}
 
-let constr_of v = match Value.to_constr v with
-  | Some c -> EConstr.Unsafe.to_constr c
+let constr_of evd v = match Value.to_constr v with
+  | Some c -> EConstr.to_constr evd c
   | None -> failwith "Ring.exec_tactic: anomaly"
 
 let tactic_res = ref [||]
@@ -221,8 +201,8 @@ let exec_tactic env evd n f args =
   (** Evaluate the whole result *)
   let gl = dummy_goal env evd in
   let gls = Proofview.V82.of_tactic (Tacinterp.eval_tactic_ist ist (ltac_call f (args@[getter]))) gl in
-  let evd, nf = Evarutil.nf_evars_and_universes (Refiner.project gls) in
-  let nf c = nf (constr_of c) in
+  let evd = Evd.minimize_universes (Refiner.project gls) in
+  let nf c = constr_of evd c in
   Array.map nf !tactic_res, Evd.universe_context_set evd
 
 let stdlib_modules =
@@ -233,7 +213,7 @@ let stdlib_modules =
   ]
 
 let coq_constant c =
-  lazy (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" stdlib_modules c))
+  lazy (EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" stdlib_modules c))
 let coq_reference c =
   lazy (Coqlib.gen_reference_in_modules "Ring" stdlib_modules c)
 
@@ -247,9 +227,10 @@ let coq_nil = coq_reference "nil"
 
 let lapp f args = mkApp(Lazy.force f,args)
 
-let plapp evd f args = 
-  let fc = Evarutil.e_new_global evd (Lazy.force f) in
-    mkApp(fc,args)
+let plapp evdref f args =
+  let evd, fc = Evarutil.new_global !evdref (Lazy.force f) in
+  evdref := evd;
+  mkApp(fc,args)
 
 let dest_rel0 sigma t =
   match EConstr.kind sigma t with
@@ -278,7 +259,7 @@ let plugin_modules =
     ]
 
 let my_constant c =
-  lazy (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" plugin_modules c))
+  lazy (EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" plugin_modules c))
 let my_reference c =
   lazy (Coqlib.gen_reference_in_modules "Ring" plugin_modules c)
 
@@ -504,10 +485,12 @@ let ring_equality env evd (r,add,mul,opp,req) =
 	let op_morph =
 	  match opp with
               Some opp -> plapp evd coq_eq_morph [|r;add;mul;opp|]
-            | None -> plapp evd coq_eq_smorph [|r;add;mul|] in
-	let setoid = Typing.e_solve_evars env evd setoid in
-	let op_morph = Typing.e_solve_evars env evd op_morph in
-	  (setoid,op_morph)
+          | None -> plapp evd coq_eq_smorph [|r;add;mul|] in
+        let sigma = !evd in
+        let sigma, setoid = Typing.solve_evars env sigma setoid in
+        let sigma, op_morph = Typing.solve_evars env sigma op_morph in
+        evd := sigma;
+        (setoid,op_morph)
     | _ ->
 	let setoid = setoid_of_relation (Global.env ()) evd r req in
 	let signature = [Some (r,Some req);Some (r,Some req)],Some(r,Some req) in
@@ -586,48 +569,53 @@ let make_hyp env evd c =
   let t = Retyping.get_type_of env !evd c in
    plapp evd coq_mkhypo [|t;c|]
 
-let make_hyp_list env evd lH =
-  let carrier = Evarutil.e_new_global evd (Lazy.force coq_hypo) in
+let make_hyp_list env evdref lH =
+  let evd, carrier = Evarutil.new_global !evdref (Lazy.force coq_hypo) in
+  evdref := evd;
   let l = 
     List.fold_right
-      (fun c l -> plapp evd coq_cons [|carrier; (make_hyp env evd c); l|]) lH
-      (plapp evd coq_nil [|carrier|])
+      (fun c l -> plapp evdref coq_cons [|carrier; (make_hyp env evdref c); l|]) lH
+      (plapp evdref coq_nil [|carrier|])
   in 
-  let l' = Typing.e_solve_evars env evd l in
+  let sigma, l' = Typing.solve_evars env !evdref l in
+  evdref := sigma;
   let l' = EConstr.Unsafe.to_constr l' in
-    Evarutil.nf_evars_universes !evd l'
+    Evarutil.nf_evars_universes !evdref l'
 
-let interp_power env evd pow =
-  let carrier = Evarutil.e_new_global evd (Lazy.force coq_hypo) in
+let interp_power env evdref pow =
+  let evd, carrier = Evarutil.new_global !evdref (Lazy.force coq_hypo) in
+  evdref := evd;
   match pow with
   | None ->
       let t = ArgArg(Loc.tag (Lazy.force ltac_inv_morph_nothing)) in
-      (TacArg(Loc.tag (TacCall(Loc.tag (t,[])))), plapp evd coq_None [|carrier|])
+      (TacArg(Loc.tag (TacCall(Loc.tag (t,[])))), plapp evdref coq_None [|carrier|])
   | Some (tac, spec) ->
       let tac =
         match tac with
         | CstTac t -> Tacintern.glob_tactic t
         | Closed lc ->
             closed_term_ast (List.map Smartlocate.global_with_alias lc) in
-      let spec = make_hyp env evd (ic_unsafe spec) in
-      (tac, plapp evd coq_Some [|carrier; spec|])
+      let spec = make_hyp env evdref (ic_unsafe spec) in
+      (tac, plapp evdref coq_Some [|carrier; spec|])
 
-let interp_sign env evd sign =
-  let carrier = Evarutil.e_new_global evd (Lazy.force coq_hypo) in
+let interp_sign env evdref sign =
+  let evd, carrier = Evarutil.new_global !evdref (Lazy.force coq_hypo) in
+  evdref := evd;
   match sign with
-  | None -> plapp evd coq_None [|carrier|]
+  | None -> plapp evdref coq_None [|carrier|]
   | Some spec ->
-      let spec = make_hyp env evd (ic_unsafe spec) in
-      plapp evd coq_Some [|carrier;spec|]
+      let spec = make_hyp env evdref (ic_unsafe spec) in
+      plapp evdref coq_Some [|carrier;spec|]
        (* Same remark on ill-typed terms ... *)
 
-let interp_div env evd div =
-  let carrier = Evarutil.e_new_global evd (Lazy.force coq_hypo) in
+let interp_div env evdref div =
+  let evd, carrier = Evarutil.new_global !evdref (Lazy.force coq_hypo) in
+  evdref := evd;
   match div with
-  | None -> plapp evd coq_None [|carrier|]
+  | None -> plapp evdref coq_None [|carrier|]
   | Some spec ->
-      let spec = make_hyp env evd (ic_unsafe spec) in
-      plapp evd coq_Some [|carrier;spec|]
+      let spec = make_hyp env evdref (ic_unsafe spec) in
+      plapp evdref coq_Some [|carrier;spec|]
        (* Same remark on ill-typed terms ... *)
 
 let add_theory0 name (sigma, rth) eqth morphth cst_tac (pre,post) power sign div =
@@ -728,7 +716,9 @@ let make_term_list env evd carrier rl =
   let l = List.fold_right
     (fun x l -> plapp evd coq_cons [|carrier;x;l|]) rl
     (plapp evd coq_nil [|carrier|])
-  in Typing.e_solve_evars env evd l
+  in
+  let sigma, l = Typing.solve_evars env !evd l in
+  evd := sigma; l
 
 let carg c = Tacinterp.Value.of_constr (EConstr.of_constr c)
 let tacarg expr =
@@ -760,7 +750,7 @@ let ring_lookup (f : Value.t) lH rl t =
       let rl = Value.of_constr (make_term_list env evdref (EConstr.of_constr e.ring_carrier) rl) in
       let lH = carg (make_hyp_list env evdref lH) in
       let ring = ltac_ring_structure e in
-      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (ltac_apply f (ring@[lH;rl]))
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (Value.apply f (ring@[lH;rl]))
     with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
   end
 
@@ -917,7 +907,7 @@ let ftheory_to_obj : field_info -> obj =
 let field_equality evd r inv req =
   match EConstr.kind !evd req with
     | App (f, [| _ |]) when eq_constr_nounivs !evd f (Lazy.force coq_eq) ->
-        let c = Universes.constr_of_global (Coqlib.build_coq_eq_data()).congr in
+        let c = UnivGen.constr_of_global (Coqlib.build_coq_eq_data()).congr in
         let c = EConstr.of_constr c in
         mkApp(c,[|r;r;inv|])
     | _ ->
@@ -1046,6 +1036,6 @@ let field_lookup (f : Value.t) lH rl t =
       let rl = Value.of_constr (make_term_list env evdref (EConstr.of_constr e.field_carrier) rl) in
       let lH = carg (make_hyp_list env evdref lH) in
       let field = ltac_field_structure e in
-      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (ltac_apply f (field@[lH;rl]))
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (Value.apply f (field@[lH;rl]))
     with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
   end
diff --git a/plugins/setoid_ring/newring.mli b/plugins/setoid_ring/newring.mli
index 1d1557b1..fcd04a2e 100644
--- a/plugins/setoid_ring/newring.mli
+++ b/plugins/setoid_ring/newring.mli
@@ -11,7 +11,6 @@
 open Names
 open EConstr
 open Libnames
-open Globnames
 open Constrexpr
 open Newring_ast
 
@@ -19,8 +18,6 @@ val protect_tac_in : string -> Id.t -> unit Proofview.tactic
 
 val protect_tac : string -> unit Proofview.tactic
 
-val closed_term : EConstr.constr -> global_reference list -> unit Proofview.tactic
-
 val add_theory :
   Id.t ->
   constr_expr ->
diff --git a/plugins/setoid_ring/newring_ast.ml b/plugins/setoid_ring/newring_ast.ml
index 3eb68b51..a83c79d1 100644
--- a/plugins/setoid_ring/newring_ast.ml
+++ b/plugins/setoid_ring/newring_ast.ml
@@ -22,7 +22,7 @@ type 'constr coeff_spec =
 
 type cst_tac_spec =
     CstTac of raw_tactic_expr
-  | Closed of reference list
+  | Closed of qualid list
 
 type 'constr ring_mod =
     Ring_kind of 'constr coeff_spec
diff --git a/plugins/setoid_ring/newring_ast.mli b/plugins/setoid_ring/newring_ast.mli
index 3eb68b51..a83c79d1 100644
--- a/plugins/setoid_ring/newring_ast.mli
+++ b/plugins/setoid_ring/newring_ast.mli
@@ -22,7 +22,7 @@ type 'constr coeff_spec =
 
 type cst_tac_spec =
     CstTac of raw_tactic_expr
-  | Closed of reference list
+  | Closed of qualid list
 
 type 'constr ring_mod =
     Ring_kind of 'constr coeff_spec
diff --git a/plugins/ssr/ssrast.mli b/plugins/ssr/ssrast.mli
index 7f5f2f63..a786b995 100644
--- a/plugins/ssr/ssrast.mli
+++ b/plugins/ssr/ssrast.mli
@@ -37,7 +37,7 @@ type ssrmult = int * ssrmmod
 type ssrocc = (bool * int list) option
 
 (* index MAYBE REMOVE ONLY INTERNAL stuff between {} *)
-type ssrindex = int Misctypes.or_var
+type ssrindex = int Locus.or_var
 
 (* clear switch {H G} *)
 type ssrclear = ssrhyps
@@ -84,11 +84,11 @@ type ssripat =
   | IPatId of (*TODO id_mod option * *) Id.t
   | IPatAnon of anon_iter (* inaccessible name *)
 (* TODO  | IPatClearMark *)
-  | IPatDispatch of ssripatss (* /[..|..] *)
+  | IPatDispatch of bool (* ssr exception: accept a dispatch on the empty list even when there are subgoals *) * ssripatss (* (..|..) *)
   | IPatCase of (* ipats_mod option * *) ssripatss (* this is not equivalent to /case /[..|..] if there are already multiple goals *)
   | IPatInj of ssripatss
   | IPatRewrite of (*occurrence option * rewrite_pattern **) ssrocc * ssrdir
-  | IPatView of ssrview (* /view *)
+  | IPatView of bool * ssrview (* {}/view (true if the clear is present) *)
   | IPatClear of ssrclear (* {H1 H2} *)
   | IPatSimpl of ssrsimpl
   | IPatAbstractVars of Id.t list
diff --git a/plugins/ssr/ssrbool.v b/plugins/ssr/ssrbool.v
index 7d05b643..a618fc78 100644
--- a/plugins/ssr/ssrbool.v
+++ b/plugins/ssr/ssrbool.v
@@ -10,264 +10,266 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
+(** #<style> .doc { font-family: monospace; white-space: pre; } </style># **)
+
 Require Bool.
 Require Import ssreflect ssrfun.
 
-(******************************************************************************)
-(* A theory of boolean predicates and operators. A large part of this file is *)
-(* concerned with boolean reflection.                                         *)
-(* Definitions and notations:                                                 *)
-(*               is_true b == the coercion of b : bool to Prop (:= b = true). *)
-(*                            This is just input and displayed as `b''.       *)
-(*             reflect P b == the reflection inductive predicate, asserting   *)
-(*                            that the logical proposition P : prop with the  *)
-(*                            formula b : bool. Lemmas asserting reflect P b  *)
-(*                            are often referred to as "views".               *)
-(*  iffP, appP, sameP, rwP :: lemmas for direct manipulation of reflection    *)
-(*                            views: iffP is used to prove reflection from    *)
-(*                            logical equivalence, appP to compose views, and *)
-(*                            sameP and rwP to perform boolean and setoid     *)
-(*                            rewriting.                                      *)
-(*                   elimT :: coercion reflect >-> Funclass, which allows the *)
-(*                            direct application of `reflect' views to        *)
-(*                            boolean assertions.                             *)
-(*             decidable P <-> P is effectively decidable (:= {P} + {~ P}.    *)
-(*    contra, contraL, ... :: contraposition lemmas.                          *)
-(*           altP my_viewP :: natural alternative for reflection; given       *)
-(*                            lemma myviewP: reflect my_Prop my_formula,      *)
-(*                              have [myP | not_myP] := altP my_viewP.        *)
-(*                            generates two subgoals, in which my_formula has *)
-(*                            been replaced by true and false, resp., with    *)
-(*                            new assumptions myP : my_Prop and               *)
-(*                            not_myP: ~~ my_formula.                         *)
-(*                            Caveat: my_formula must be an APPLICATION, not  *)
-(*                            a variable, constant, let-in, etc. (due to the  *)
-(*                            poor behaviour of dependent index matching).    *)
-(*        boolP my_formula :: boolean disjunction, equivalent to              *)
-(*                            altP (idP my_formula) but circumventing the     *)
-(*                            dependent index capture issue; destructing      *)
-(*                            boolP my_formula generates two subgoals with    *)
-(*                            assumtions my_formula and ~~ myformula. As      *)
-(*                            with altP, my_formula must be an application.   *)
-(*            \unless C, P <-> we can assume property P when a something that *)
-(*                            holds under condition C (such as C itself).     *)
-(*                         := forall G : Prop, (C -> G) -> (P -> G) -> G.     *)
-(*                            This is just C \/ P or rather its impredicative *)
-(*                            encoding, whose usage better fits the above     *)
-(*                            description: given a lemma UCP whose conclusion *)
-(*                            is \unless C, P we can assume P by writing:     *)
-(*                              wlog hP: / P by apply/UCP; (prove C -> goal). *)
-(*                           or even apply: UCP id _ => hP if the goal is C.  *)
-(*           classically P <-> we can assume P when proving is_true b.        *)
-(*                         := forall b : bool, (P -> b) -> b.                 *)
-(*                            This is equivalent to ~ (~ P) when P : Prop.    *)
-(*             implies P Q == wrapper coinductive type that coerces to P -> Q *)
-(*                            and can be used as a P -> Q view unambigously.  *)
-(*                            Useful to avoid spurious insertion of <-> views *)
-(*                            when Q is a conjunction of foralls, as in Lemma *)
-(*                            all_and2 below; conversely, avoids confusion in *)
-(*                            apply views for impredicative properties, such  *)
-(*                            as \unless C, P. Also supports contrapositives. *)
-(*                  a && b == the boolean conjunction of a and b.             *)
-(*                  a || b == the boolean disjunction of a and b.             *)
-(*                 a ==> b == the boolean implication of b by a.              *)
-(*                    ~~ a == the boolean negation of a.                      *)
-(*                 a (+) b == the boolean exclusive or (or sum) of a and b.   *)
-(*     [ /\ P1 , P2 & P3 ] == multiway logical conjunction, up to 5 terms.    *)
-(*     [ \/ P1 , P2 | P3 ] == multiway logical disjunction, up to 4 terms.    *)
-(*        [&& a, b, c & d] == iterated, right associative boolean conjunction *)
-(*                            with arbitrary arity.                           *)
-(*        [|| a, b, c | d] == iterated, right associative boolean disjunction *)
-(*                            with arbitrary arity.                           *)
-(*      [==> a, b, c => d] == iterated, right associative boolean implication *)
-(*                            with arbitrary arity.                           *)
-(*              and3P, ... == specific reflection lemmas for iterated         *)
-(*                            connectives.                                    *)
-(*       andTb, orbAC, ... == systematic names for boolean connective         *)
-(*                            properties (see suffix conventions below).      *)
-(*              prop_congr == a tactic to move a boolean equality from        *)
-(*                            its coerced form in Prop to the equality        *)
-(*                            in bool.                                        *)
-(*              bool_congr == resolution tactic for blindly weeding out       *)
-(*                            like terms from boolean equalities (can fail).  *)
-(* This file provides a theory of boolean predicates and relations:           *)
-(*                  pred T == the type of bool predicates (:= T -> bool).     *)
-(*            simpl_pred T == the type of simplifying bool predicates, using  *)
-(*                            the simpl_fun from ssrfun.v.                    *)
-(*                   rel T == the type of bool relations.                     *)
-(*                         := T -> pred T or T -> T -> bool.                  *)
-(*             simpl_rel T == type of simplifying relations.                  *)
-(*                predType == the generic predicate interface, supported for  *)
-(*                            for lists and sets.                             *)
-(*              pred_class == a coercion class for the predType projection to *)
-(*                            pred; declaring a coercion to pred_class is an  *)
-(*                            alternative way of equipping a type with a      *)
-(*                            predType structure, which interoperates better  *)
-(*                            with coercion subtyping. This is used, e.g.,    *)
-(*                            for finite sets, so that finite groups inherit  *)
-(*                            the membership operation by coercing to sets.   *)
-(* If P is a predicate the proposition "x satisfies P" can be written         *)
-(* applicatively as (P x), or using an explicit connective as (x \in P); in   *)
-(* the latter case we say that P is a "collective" predicate. We use A, B     *)
-(* rather than P, Q for collective predicates:                                *)
-(*                 x \in A == x satisfies the (collective) predicate A.       *)
-(*              x \notin A == x doesn't satisfy the (collective) predicate A. *)
-(* The pred T type can be used as a generic predicate type for either kind,   *)
-(* but the two kinds of predicates should not be confused. When a "generic"   *)
-(* pred T value of one type needs to be passed as the other the following     *)
-(* conversions should be used explicitly:                                     *)
-(*             SimplPred P == a (simplifying) applicative equivalent of P.    *)
-(*                   mem A == an applicative equivalent of A:                 *)
-(*                            mem A x simplifies to x \in A.                  *)
-(* Alternatively one can use the syntax for explicit simplifying predicates   *)
-(* and relations (in the following x is bound in E):                          *)
-(*            [pred x | E] == simplifying (see ssrfun) predicate x => E.      *)
-(*        [pred x : T | E] == predicate x => E, with a cast on the argument.  *)
-(*          [pred : T | P] == constant predicate P on type T.                 *)
-(*      [pred x | E1 & E2] == [pred x | E1 && E2]; an x : T cast is allowed.  *)
-(*           [pred x in A] == [pred x | x in A].                              *)
-(*       [pred x in A | E] == [pred x | x in A & E].                          *)
-(* [pred x in A | E1 & E2] == [pred x in A | E1 && E2].                       *)
-(*           [predU A & B] == union of two collective predicates A and B.     *)
-(*           [predI A & B] == intersection of collective predicates A and B.  *)
-(*           [predD A & B] == difference of collective predicates A and B.    *)
-(*               [predC A] == complement of the collective predicate A.       *)
-(*          [preim f of A] == preimage under f of the collective predicate A. *)
-(*          predU P Q, ... == union, etc of applicative predicates.           *)
-(*                   pred0 == the empty predicate.                            *)
-(*                   predT == the total (always true) predicate.              *)
-(*                            if T : predArgType, then T coerces to predT.    *)
-(*                   {: T} == T cast to predArgType (e.g., {: bool * nat})    *)
-(* In the following, x and y are bound in E:                                  *)
-(*           [rel x y | E] == simplifying relation x, y => E.                 *)
-(*       [rel x y : T | E] == simplifying relation with arguments cast.       *)
-(*  [rel x y in A & B | E] == [rel x y | [&& x \in A, y \in B & E]].          *)
-(*      [rel x y in A & B] == [rel x y | (x \in A) && (y \in B)].             *)
-(*      [rel x y in A | E] == [rel x y in A & A | E].                         *)
-(*          [rel x y in A] == [rel x y in A & A].                             *)
-(*                relU R S == union of relations R and S.                     *)
-(* Explicit values of type pred T (i.e., lamdba terms) should always be used  *)
-(* applicatively, while values of collection types implementing the predType  *)
-(* interface, such as sequences or sets should always be used as collective   *)
-(* predicates. Defined constants and functions of type pred T or simpl_pred T *)
-(* as well as the explicit simpl_pred T values described below, can generally *)
-(* be used either way. Note however that x \in A will not auto-simplify when  *)
-(* A is an explicit simpl_pred T value; the generic simplification rule inE   *)
-(* must be used (when A : pred T, the unfold_in rule can be used). Constants  *)
-(* of type pred T with an explicit simpl_pred value do not auto-simplify when *)
-(* used applicatively, but can still be expanded with inE. This behavior can  *)
-(* be controlled as follows:                                                  *)
-(*   Let A : collective_pred T := [pred x | ... ].                            *)
-(*     The collective_pred T type is just an alias for pred T, but this cast  *)
-(*     stops rewrite inE from expanding the definition of A, thus treating A  *)
-(*     into an abstract collection (unfold_in or in_collective can be used to *)
-(*     expand manually).                                                      *)
-(*   Let A : applicative_pred T := [pred x | ...].                            *)
-(*     This cast causes inE to turn x \in A into the applicative A x form;    *)
-(*     A will then have to unfolded explicitly with the /A rule. This will    *)
-(*     also apply to any definition that reduces to A (e.g., Let B := A).     *)
-(*   Canonical A_app_pred := ApplicativePred A.                               *)
-(*     This declaration, given after definition of A, similarly causes inE to *)
-(*     turn x \in A into A x, but in addition allows the app_predE rule to    *)
-(*     turn A x back into x \in A; it can be used for any definition of type  *)
-(*     pred T, which makes it especially useful for ambivalent predicates     *)
-(*     as the relational transitive closure connect, that are used in both    *)
-(*     applicative and collective styles.                                     *)
-(* Purely for aesthetics, we provide a subtype of collective predicates:      *)
-(*   qualifier q T == a pred T pretty-printing wrapper. An A : qualifier q T  *)
-(*                    coerces to pred_class and thus behaves as a collective  *)
-(*                    predicate, but x \in A and x \notin A are displayed as: *)
-(*             x \is A and x \isn't A when q = 0,                             *)
-(*         x \is a A and x \isn't a A when q = 1,                             *)
-(*       x \is an A and x \isn't an A when q = 2, respectively.               *)
-(*   [qualify x | P] := Qualifier 0 (fun x => P), constructor for the above.  *)
-(* [qualify x : T | P], [qualify a x | P], [qualify an X | P], etc.           *)
-(*                  variants of the above with type constraints and different *)
-(*                  values of q.                                              *)
-(* We provide an internal interface to support attaching properties (such as  *)
-(* being multiplicative) to predicates:                                       *)
-(*    pred_key p == phantom type that will serve as a support for properties  *)
-(*                  to be attached to p : pred_class; instances should be     *)
-(*                  created with Fact/Qed so as to be opaque.                 *)
-(* KeyedPred k_p == an instance of the interface structure that attaches      *)
-(*                  (k_p : pred_key P) to P; the structure projection is a    *)
-(*                  coercion to pred_class.                                   *)
-(* KeyedQualifier k_q == an instance of the interface structure that attaches *)
-(*                  (k_q : pred_key q) to (q : qualifier n T).                *)
-(* DefaultPredKey p == a default value for pred_key p; the vernacular command *)
-(*                  Import DefaultKeying attaches this key to all predicates  *)
-(*                  that are not explicitly keyed.                            *)
-(* Keys can be used to attach properties to predicates, qualifiers and        *)
-(* generic nouns in a way that allows them to be used transparently. The key  *)
-(* projection of a predicate property structure such as unsignedPred should   *)
-(* be a pred_key, not a pred, and corresponding lemmas will have the form     *)
-(*    Lemma rpredN R S (oppS : @opprPred R S) (kS : keyed_pred oppS) :        *)
-(*       {mono -%R: x / x \in kS}.                                            *)
-(* Because x \in kS will be displayed as x \in S (or x \is S, etc), the       *)
-(* canonical instance of opprPred will not normally be exposed (it will also  *)
-(* be erased by /= simplification). In addition each predicate structure      *)
-(* should have a DefaultPredKey Canonical instance that simply issues the     *)
-(* property as a proof obligation (which can be caught by the Prop-irrelevant *)
-(* feature of the ssreflect plugin).                                          *)
-(*   Some properties of predicates and relations:                             *)
-(*                  A =i B <-> A and B are extensionally equivalent.          *)
-(*         {subset A <= B} <-> A is a (collective) subpredicate of B.         *)
-(*             subpred P Q <-> P is an (applicative) subpredicate or Q.       *)
-(*              subrel R S <-> R is a subrelation of S.                       *)
-(* In the following R is in rel T:                                            *)
-(*             reflexive R <-> R is reflexive.                                *)
-(*           irreflexive R <-> R is irreflexive.                              *)
-(*             symmetric R <-> R (in rel T) is symmetric (equation).          *)
-(*         pre_symmetric R <-> R is symmetric (implication).                  *)
-(*         antisymmetric R <-> R is antisymmetric.                            *)
-(*                 total R <-> R is total.                                    *)
-(*            transitive R <-> R is transitive.                               *)
-(*       left_transitive R <-> R is a congruence on its left hand side.       *)
-(*      right_transitive R <-> R is a congruence on its right hand side.      *)
-(*       equivalence_rel R <-> R is an equivalence relation.                  *)
-(* Localization of (Prop) predicates; if P1 is convertible to forall x, Qx,   *)
-(* P2 to forall x y, Qxy and P3 to forall x y z, Qxyz :                       *)
-(*            {for y, P1} <-> Qx{y / x}.                                      *)
-(*             {in A, P1} <-> forall x, x \in A -> Qx.                        *)
-(*       {in A1 & A2, P2} <-> forall x y, x \in A1 -> y \in A2 -> Qxy.        *)
-(*           {in A &, P2} <-> forall x y, x \in A -> y \in A -> Qxy.          *)
-(*  {in A1 & A2 & A3, Q3} <-> forall x y z,                                   *)
-(*                            x \in A1 -> y \in A2 -> z \in A3 -> Qxyz.       *)
-(*     {in A1 & A2 &, Q3} == {in A1 & A2 & A2, Q3}.                           *)
-(*      {in A1 && A3, Q3} == {in A1 & A1 & A3, Q3}.                           *)
-(*          {in A &&, Q3} == {in A & A & A, Q3}.                              *)
-(*    {in A, bijective f} == f has a right inverse in A.                      *)
-(*             {on C, P1} == forall x, (f x) \in C -> Qx                      *)
-(*                           when P1 is also convertible to Pf f.             *)
-(*           {on C &, P2} == forall x y, f x \in C -> f y \in C -> Qxy        *)
-(*                           when P2 is also convertible to Pf f.             *)
-(*        {on C, P1' & g} == forall x, (f x) \in cd -> Qx                     *)
-(*                           when P1' is convertible to Pf f                  *)
-(*                           and P1' g is convertible to forall x, Qx.        *)
-(*    {on C, bijective f} == f has a right inverse on C.                      *)
-(* This file extends the lemma name suffix conventions of ssrfun as follows:  *)
-(*   A -- associativity, as in andbA : associative andb.                      *)
-(*  AC -- right commutativity.                                                *)
-(* ACA -- self-interchange (inner commutativity), e.g.,                       *)
-(*        orbACA : (a || b) || (c || d) = (a || c) || (b || d).               *)
-(*   b -- a boolean argument, as in andbb : idempotent andb.                  *)
-(*   C -- commutativity, as in andbC : commutative andb,                      *)
-(*        or predicate complement, as in predC.                               *)
-(*  CA -- left commutativity.                                                 *)
-(*   D -- predicate difference, as in predD.                                  *)
-(*   E -- elimination, as in negbFE : ~~ b = false -> b.                      *)
-(*   F or f -- boolean false, as in andbF : b && false = false.               *)
-(*   I -- left/right injectivity, as in addbI : right_injective addb,         *)
-(*        or predicate intersection, as in predI.                             *)
-(*   l -- a left-hand operation, as andb_orl : left_distributive andb orb.    *)
-(*   N or n -- boolean negation, as in andbN : a && (~~ a) = false.           *)
-(*   P -- a characteristic property, often a reflection lemma, as in          *)
-(*        andP : reflect (a /\ b) (a && b).                                   *)
-(*   r -- a right-hand operation, as orb_andr : rightt_distributive orb andb. *)
-(*   T or t -- boolean truth, as in andbT: right_id true andb.                *)
-(*   U -- predicate union, as in predU.                                       *)
-(*   W -- weakening, as in in1W : {in D, forall x, P} -> forall x, P.         *)
-(******************************************************************************)
+(**
+ A theory of boolean predicates and operators. A large part of this file is
+ concerned with boolean reflection.
+ Definitions and notations:
+               is_true b == the coercion of b : bool to Prop (:= b = true).
+                            This is just input and displayed as `b''.
+             reflect P b == the reflection inductive predicate, asserting
+                            that the logical proposition P : prop with the
+                            formula b : bool. Lemmas asserting reflect P b
+                            are often referred to as "views".
+  iffP, appP, sameP, rwP :: lemmas for direct manipulation of reflection
+                            views: iffP is used to prove reflection from
+                            logical equivalence, appP to compose views, and
+                            sameP and rwP to perform boolean and setoid
+                            rewriting.
+                   elimT :: coercion reflect >-> Funclass, which allows the
+                            direct application of `reflect' views to
+                            boolean assertions.
+             decidable P <-> P is effectively decidable (:= {P} + {~ P}.
+    contra, contraL, ... :: contraposition lemmas.
+           altP my_viewP :: natural alternative for reflection; given
+                            lemma myviewP: reflect my_Prop my_formula,
+                              have #[#myP | not_myP#]# := altP my_viewP.
+                            generates two subgoals, in which my_formula has
+                            been replaced by true and false, resp., with
+                            new assumptions myP : my_Prop and
+                            not_myP: ~~ my_formula.
+                            Caveat: my_formula must be an APPLICATION, not
+                            a variable, constant, let-in, etc. (due to the
+                            poor behaviour of dependent index matching).
+        boolP my_formula :: boolean disjunction, equivalent to
+                            altP (idP my_formula) but circumventing the
+                            dependent index capture issue; destructing
+                            boolP my_formula generates two subgoals with
+                            assumtions my_formula and ~~ myformula. As
+                            with altP, my_formula must be an application.
+            \unless C, P <-> we can assume property P when a something that
+                            holds under condition C (such as C itself).
+                         := forall G : Prop, (C -> G) -> (P -> G) -> G.
+                            This is just C \/ P or rather its impredicative
+                            encoding, whose usage better fits the above
+                            description: given a lemma UCP whose conclusion
+                            is \unless C, P we can assume P by writing:
+                              wlog hP: / P by apply/UCP; (prove C -> goal).
+                           or even apply: UCP id _ => hP if the goal is C.
+           classically P <-> we can assume P when proving is_true b.
+                         := forall b : bool, (P -> b) -> b.
+                            This is equivalent to ~ (~ P) when P : Prop.
+             implies P Q == wrapper variant type that coerces to P -> Q and
+                            can be used as a P -> Q view unambigously.
+                            Useful to avoid spurious insertion of <-> views
+                            when Q is a conjunction of foralls, as in Lemma
+                            all_and2 below; conversely, avoids confusion in
+                            apply views for impredicative properties, such
+                            as \unless C, P. Also supports contrapositives.
+                  a && b == the boolean conjunction of a and b.
+                  a || b == the boolean disjunction of a and b.
+                 a ==> b == the boolean implication of b by a.
+                    ~~ a == the boolean negation of a.
+                 a (+) b == the boolean exclusive or (or sum) of a and b.
+     #[# /\ P1 , P2 & P3 #]# == multiway logical conjunction, up to 5 terms.
+     #[# \/ P1 , P2 | P3 #]# == multiway logical disjunction, up to 4 terms.
+        #[#&& a, b, c & d#]# == iterated, right associative boolean conjunction
+                            with arbitrary arity.
+        #[#|| a, b, c | d#]# == iterated, right associative boolean disjunction
+                            with arbitrary arity.
+      #[#==> a, b, c => d#]# == iterated, right associative boolean implication
+                            with arbitrary arity.
+              and3P, ... == specific reflection lemmas for iterated
+                            connectives.
+       andTb, orbAC, ... == systematic names for boolean connective
+                            properties (see suffix conventions below).
+              prop_congr == a tactic to move a boolean equality from
+                            its coerced form in Prop to the equality
+                            in bool.
+              bool_congr == resolution tactic for blindly weeding out
+                            like terms from boolean equalities (can fail).
+ This file provides a theory of boolean predicates and relations:
+                  pred T == the type of bool predicates (:= T -> bool).
+            simpl_pred T == the type of simplifying bool predicates, using
+                            the simpl_fun from ssrfun.v.
+                   rel T == the type of bool relations.
+                         := T -> pred T or T -> T -> bool.
+             simpl_rel T == type of simplifying relations.
+                predType == the generic predicate interface, supported for
+                            for lists and sets.
+              pred_class == a coercion class for the predType projection to
+                            pred; declaring a coercion to pred_class is an
+                            alternative way of equipping a type with a
+                            predType structure, which interoperates better
+                            with coercion subtyping. This is used, e.g.,
+                            for finite sets, so that finite groups inherit
+                            the membership operation by coercing to sets.
+ If P is a predicate the proposition "x satisfies P" can be written
+ applicatively as (P x), or using an explicit connective as (x \in P); in
+ the latter case we say that P is a "collective" predicate. We use A, B
+ rather than P, Q for collective predicates:
+                 x \in A == x satisfies the (collective) predicate A.
+              x \notin A == x doesn't satisfy the (collective) predicate A.
+ The pred T type can be used as a generic predicate type for either kind,
+ but the two kinds of predicates should not be confused. When a "generic"
+ pred T value of one type needs to be passed as the other the following
+ conversions should be used explicitly:
+             SimplPred P == a (simplifying) applicative equivalent of P.
+                   mem A == an applicative equivalent of A:
+                            mem A x simplifies to x \in A.
+ Alternatively one can use the syntax for explicit simplifying predicates
+ and relations (in the following x is bound in E):
+            #[#pred x | E#]# == simplifying (see ssrfun) predicate x => E.
+        #[#pred x : T | E#]# == predicate x => E, with a cast on the argument.
+          #[#pred : T | P#]# == constant predicate P on type T.
+      #[#pred x | E1 & E2#]# == #[#pred x | E1 && E2#]#; an x : T cast is allowed.
+           #[#pred x in A#]# == #[#pred x | x in A#]#.
+       #[#pred x in A | E#]# == #[#pred x | x in A & E#]#.
+ #[#pred x in A | E1 & E2#]# == #[#pred x in A | E1 && E2#]#.
+           #[#predU A & B#]# == union of two collective predicates A and B.
+           #[#predI A & B#]# == intersection of collective predicates A and B.
+           #[#predD A & B#]# == difference of collective predicates A and B.
+               #[#predC A#]# == complement of the collective predicate A.
+          #[#preim f of A#]# == preimage under f of the collective predicate A.
+          predU P Q, ... == union, etc of applicative predicates.
+                   pred0 == the empty predicate.
+                   predT == the total (always true) predicate.
+                            if T : predArgType, then T coerces to predT.
+                   {: T} == T cast to predArgType (e.g., {: bool * nat})
+ In the following, x and y are bound in E:
+           #[#rel x y | E#]# == simplifying relation x, y => E.
+       #[#rel x y : T | E#]# == simplifying relation with arguments cast.
+  #[#rel x y in A & B | E#]# == #[#rel x y | #[#&& x \in A, y \in B & E#]# #]#.
+      #[#rel x y in A & B#]# == #[#rel x y | (x \in A) && (y \in B) #]#.
+      #[#rel x y in A | E#]# == #[#rel x y in A & A | E#]#.
+          #[#rel x y in A#]# == #[#rel x y in A & A#]#.
+                relU R S == union of relations R and S.
+ Explicit values of type pred T (i.e., lamdba terms) should always be used
+ applicatively, while values of collection types implementing the predType
+ interface, such as sequences or sets should always be used as collective
+ predicates. Defined constants and functions of type pred T or simpl_pred T
+ as well as the explicit simpl_pred T values described below, can generally
+ be used either way. Note however that x \in A will not auto-simplify when
+ A is an explicit simpl_pred T value; the generic simplification rule inE
+ must be used (when A : pred T, the unfold_in rule can be used). Constants
+ of type pred T with an explicit simpl_pred value do not auto-simplify when
+ used applicatively, but can still be expanded with inE. This behavior can
+ be controlled as follows:
+   Let A : collective_pred T := #[#pred x | ... #]#.
+     The collective_pred T type is just an alias for pred T, but this cast
+     stops rewrite inE from expanding the definition of A, thus treating A
+     into an abstract collection (unfold_in or in_collective can be used to
+     expand manually).
+   Let A : applicative_pred T := #[#pred x | ... #]#.
+     This cast causes inE to turn x \in A into the applicative A x form;
+     A will then have to unfolded explicitly with the /A rule. This will
+     also apply to any definition that reduces to A (e.g., Let B := A).
+   Canonical A_app_pred := ApplicativePred A.
+     This declaration, given after definition of A, similarly causes inE to
+     turn x \in A into A x, but in addition allows the app_predE rule to
+     turn A x back into x \in A; it can be used for any definition of type
+     pred T, which makes it especially useful for ambivalent predicates
+     as the relational transitive closure connect, that are used in both
+     applicative and collective styles.
+ Purely for aesthetics, we provide a subtype of collective predicates:
+   qualifier q T == a pred T pretty-printing wrapper. An A : qualifier q T
+                    coerces to pred_class and thus behaves as a collective
+                    predicate, but x \in A and x \notin A are displayed as:
+             x \is A and x \isn't A when q = 0,
+         x \is a A and x \isn't a A when q = 1,
+       x \is an A and x \isn't an A when q = 2, respectively.
+   #[#qualify x | P#]# := Qualifier 0 (fun x => P), constructor for the above.
+ #[#qualify x : T | P#]#, #[#qualify a x | P#]#, #[#qualify an X | P#]#, etc.
+                  variants of the above with type constraints and different
+                  values of q.
+ We provide an internal interface to support attaching properties (such as
+ being multiplicative) to predicates:
+    pred_key p == phantom type that will serve as a support for properties
+                  to be attached to p : pred_class; instances should be
+                  created with Fact/Qed so as to be opaque.
+ KeyedPred k_p == an instance of the interface structure that attaches
+                  (k_p : pred_key P) to P; the structure projection is a
+                  coercion to pred_class.
+ KeyedQualifier k_q == an instance of the interface structure that attaches
+                  (k_q : pred_key q) to (q : qualifier n T).
+ DefaultPredKey p == a default value for pred_key p; the vernacular command
+                  Import DefaultKeying attaches this key to all predicates
+                  that are not explicitly keyed.
+ Keys can be used to attach properties to predicates, qualifiers and
+ generic nouns in a way that allows them to be used transparently. The key
+ projection of a predicate property structure such as unsignedPred should
+ be a pred_key, not a pred, and corresponding lemmas will have the form
+    Lemma rpredN R S (oppS : @opprPred R S) (kS : keyed_pred oppS) :
+       {mono -%%R: x / x \in kS}.
+ Because x \in kS will be displayed as x \in S (or x \is S, etc), the
+ canonical instance of opprPred will not normally be exposed (it will also
+ be erased by /= simplification). In addition each predicate structure
+ should have a DefaultPredKey Canonical instance that simply issues the
+ property as a proof obligation (which can be caught by the Prop-irrelevant
+ feature of the ssreflect plugin).
+   Some properties of predicates and relations:
+                  A =i B <-> A and B are extensionally equivalent.
+         {subset A <= B} <-> A is a (collective) subpredicate of B.
+             subpred P Q <-> P is an (applicative) subpredicate or Q.
+              subrel R S <-> R is a subrelation of S.
+ In the following R is in rel T:
+             reflexive R <-> R is reflexive.
+           irreflexive R <-> R is irreflexive.
+             symmetric R <-> R (in rel T) is symmetric (equation).
+         pre_symmetric R <-> R is symmetric (implication).
+         antisymmetric R <-> R is antisymmetric.
+                 total R <-> R is total.
+            transitive R <-> R is transitive.
+       left_transitive R <-> R is a congruence on its left hand side.
+      right_transitive R <-> R is a congruence on its right hand side.
+       equivalence_rel R <-> R is an equivalence relation.
+ Localization of (Prop) predicates; if P1 is convertible to forall x, Qx,
+ P2 to forall x y, Qxy and P3 to forall x y z, Qxyz :
+            {for y, P1} <-> Qx{y / x}.
+             {in A, P1} <-> forall x, x \in A -> Qx.
+       {in A1 & A2, P2} <-> forall x y, x \in A1 -> y \in A2 -> Qxy.
+           {in A &, P2} <-> forall x y, x \in A -> y \in A -> Qxy.
+  {in A1 & A2 & A3, Q3} <-> forall x y z,
+                            x \in A1 -> y \in A2 -> z \in A3 -> Qxyz.
+     {in A1 & A2 &, Q3} == {in A1 & A2 & A2, Q3}.
+      {in A1 && A3, Q3} == {in A1 & A1 & A3, Q3}.
+          {in A &&, Q3} == {in A & A & A, Q3}.
+    {in A, bijective f} == f has a right inverse in A.
+             {on C, P1} == forall x, (f x) \in C -> Qx
+                           when P1 is also convertible to Pf f.
+           {on C &, P2} == forall x y, f x \in C -> f y \in C -> Qxy
+                           when P2 is also convertible to Pf f.
+        {on C, P1' & g} == forall x, (f x) \in cd -> Qx
+                           when P1' is convertible to Pf f
+                           and P1' g is convertible to forall x, Qx.
+    {on C, bijective f} == f has a right inverse on C.
+ This file extends the lemma name suffix conventions of ssrfun as follows:
+   A -- associativity, as in andbA : associative andb.
+  AC -- right commutativity.
+ ACA -- self-interchange (inner commutativity), e.g.,
+        orbACA : (a || b) || (c || d) = (a || c) || (b || d).
+   b -- a boolean argument, as in andbb : idempotent andb.
+   C -- commutativity, as in andbC : commutative andb,
+        or predicate complement, as in predC.
+  CA -- left commutativity.
+   D -- predicate difference, as in predD.
+   E -- elimination, as in negbFE : ~~ b = false -> b.
+   F or f -- boolean false, as in andbF : b && false = false.
+   I -- left/right injectivity, as in addbI : right_injective addb,
+        or predicate intersection, as in predI.
+   l -- a left-hand operation, as andb_orl : left_distributive andb orb.
+   N or n -- boolean negation, as in andbN : a && (~~ a) = false.
+   P -- a characteristic property, often a reflection lemma, as in
+        andP : reflect (a /\ b) (a && b).
+   r -- a right-hand operation, as orb_andr : rightt_distributive orb andb.
+   T or t -- boolean truth, as in andbT: right_id true andb.
+   U -- predicate union, as in predU.
+   W -- weakening, as in in1W : {in D, forall x, P} -> forall x, P.          **)
+
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -288,23 +290,24 @@ Reserved Notation "x \notin A"
 Reserved Notation "p1 =i p2"
   (at level 70, format "'[hv' p1 '/ '  =i  p2 ']'", no associativity).
 
-(* We introduce a number of n-ary "list-style" notations that share a common  *)
-(* format, namely                                                             *)
-(*    [op arg1, arg2, ... last_separator last_arg]                            *)
-(* This usually denotes a right-associative applications of op, e.g.,         *)
-(*  [&& a, b, c & d] denotes a && (b && (c && d))                             *)
-(* The last_separator must be a non-operator token. Here we use &, | or =>;   *)
-(* our default is &, but we try to match the intended meaning of op. The      *)
-(* separator is a workaround for limitations of the parsing engine; the same  *)
-(* limitations mean the separator cannot be omitted even when last_arg can.   *)
-(*   The Notation declarations are complicated by the separate treatment for  *)
-(* some fixed arities (binary for bool operators, and all arities for Prop    *)
-(* operators).                                                                *)
-(*   We also use the square brackets in comprehension-style notations         *)
-(*    [type var separator expr]                                               *)
-(* where "type" is the type of the comprehension (e.g., pred) and "separator" *)
-(* is | or => . It is important that in other notations a leading square      *)
-(* bracket [ is always followed by an operator symbol or a fixed identifier.  *)
+(**
+ We introduce a number of n-ary "list-style" notations that share a common
+ format, namely
+    #[#op arg1, arg2, ... last_separator last_arg#]#
+ This usually denotes a right-associative applications of op, e.g.,
+  #[#&& a, b, c & d#]# denotes a && (b && (c && d))
+ The last_separator must be a non-operator token. Here we use &, | or =>;
+ our default is &, but we try to match the intended meaning of op. The
+ separator is a workaround for limitations of the parsing engine; the same
+ limitations mean the separator cannot be omitted even when last_arg can.
+   The Notation declarations are complicated by the separate treatment for
+ some fixed arities (binary for bool operators, and all arities for Prop
+ operators).
+   We also use the square brackets in comprehension-style notations
+    #[#type var separator expr#]#
+ where "type" is the type of the comprehension (e.g., pred) and "separator"
+ is | or => . It is important that in other notations a leading square
+ bracket #[# is always followed by an operator symbol or a fixed identifier.   **)
 
 Reserved Notation "[ /\ P1 & P2 ]" (at level 0, only parsing).
 Reserved Notation "[ /\ P1 , P2 & P3 ]" (at level 0, format
@@ -344,19 +347,19 @@ Reserved Notation "[ 'rel' x y => E ]" (at level 0, x, y at level 8, format
 Reserved Notation "[ 'rel' x y : T => E ]" (at level 0, x, y at level 8, format
   "'[hv' [ 'rel'  x  y :  T  => '/ '  E ] ']'").
 
-(* Shorter delimiter *)
+(**  Shorter delimiter  **)
 Delimit Scope bool_scope with B.
 Open Scope bool_scope.
 
-(* An alternative to xorb that behaves somewhat better wrt simplification.    *)
+(**  An alternative to xorb that behaves somewhat better wrt simplification. **)
 Definition addb b := if b then negb else id.
 
-(* Notation for && and || is declared in Init.Datatypes. *)
+(**  Notation for && and || is declared in Init.Datatypes.  **)
 Notation "~~ b" := (negb b) : bool_scope.
 Notation "b ==> c" := (implb b c) : bool_scope.
 Notation "b1 (+) b2" := (addb b1 b2) : bool_scope.
 
-(* Constant is_true b := b = true is defined in Init.Datatypes. *)
+(**  Constant is_true b := b = true is defined in Init.Datatypes.  **)
 Coercion is_true : bool >-> Sortclass. (* Prop *)
 
 Lemma prop_congr : forall b b' : bool, b = b' -> b = b' :> Prop.
@@ -364,21 +367,22 @@ Proof. by move=> b b' ->. Qed.
 
 Ltac prop_congr := apply: prop_congr.
 
-(* Lemmas for trivial. *)
+(**  Lemmas for trivial.  **)
 Lemma is_true_true : true.               Proof. by []. Qed.
 Lemma not_false_is_true : ~ false.       Proof. by []. Qed.
 Lemma is_true_locked_true : locked true. Proof. by unlock. Qed.
 Hint Resolve is_true_true not_false_is_true is_true_locked_true.
 
-(* Shorter names. *)
+(**  Shorter names.  **)
 Definition isT := is_true_true.
 Definition notF := not_false_is_true.
 
-(* Negation lemmas. *)
+(**  Negation lemmas.  **)
 
-(* We generally take NEGATION as the standard form of a false condition:      *)
-(* negative boolean hypotheses should be of the form ~~ b, rather than ~ b or *)
-(* b = false, as much as possible.                                            *)
+(**
+ We generally take NEGATION as the standard form of a false condition:
+ negative boolean hypotheses should be of the form ~~ b, rather than ~ b or
+ b = false, as much as possible.                                             **)
 
 Lemma negbT b : b = false -> ~~ b.          Proof. by case: b. Qed.
 Lemma negbTE b : ~~ b -> b = false.         Proof. by case: b. Qed.
@@ -426,8 +430,9 @@ Proof. by move/contra=> notb_notc /notb_notc/negbTE. Qed.
 Lemma contraFF (c b : bool) : (c -> b) -> b = false -> c = false.
 Proof. by move/contraFN=> bF_notc /bF_notc/negbTE. Qed.
 
-(* Coercion of sum-style datatypes into bool, which makes it possible *)
-(* to use ssr's boolean if rather than Coq's "generic" if.            *)
+(**
+ Coercion of sum-style datatypes into bool, which makes it possible
+ to use ssr's boolean if rather than Coq's "generic" if.             **)
 
 Coercion isSome T (u : option T) := if u is Some _ then true else false.
 
@@ -441,22 +446,23 @@ Prenex Implicits  isSome is_inl is_left is_inleft.
 
 Definition decidable P := {P} + {~ P}.
 
-(* Lemmas for ifs with large conditions, which allow reasoning about the  *)
-(* condition without repeating it inside the proof (the latter IS         *)
-(* preferable when the condition is short).                               *)
-(* Usage :                                                                *)
-(*   if the goal contains (if cond then ...) = ...                        *)
-(*     case: ifP => Hcond.                                                *)
-(*   generates two subgoal, with the assumption Hcond : cond = true/false *)
-(*     Rewrite if_same  eliminates redundant ifs                          *)
-(*     Rewrite (fun_if f) moves a function f inside an if                 *)
-(*     Rewrite if_arg moves an argument inside a function-valued if       *)
+(**
+ Lemmas for ifs with large conditions, which allow reasoning about the
+ condition without repeating it inside the proof (the latter IS
+ preferable when the condition is short).
+ Usage :
+   if the goal contains (if cond then ...) = ...
+     case: ifP => Hcond.
+   generates two subgoal, with the assumption Hcond : cond = true/false
+     Rewrite if_same  eliminates redundant ifs
+     Rewrite (fun_if f) moves a function f inside an if
+     Rewrite if_arg moves an argument inside a function-valued if        **)
 
 Section BoolIf.
 
 Variables (A B : Type) (x : A) (f : A -> B) (b : bool) (vT vF : A).
 
-CoInductive if_spec (not_b : Prop) : bool -> A -> Set :=
+Variant if_spec (not_b : Prop) : bool -> A -> Set :=
   | IfSpecTrue  of      b : if_spec not_b true vT
   | IfSpecFalse of  not_b : if_spec not_b false vF.
 
@@ -483,13 +489,13 @@ Lemma if_arg (fT fF : A -> B) :
   (if b then fT else fF) x = if b then fT x else fF x.
 Proof. by case b. Qed.
 
-(* Turning a boolean "if" form into an application.                           *)
+(**  Turning a boolean "if" form into an application.  **)
 Definition if_expr := if b then vT else vF.
 Lemma ifE : (if b then vT else vF) = if_expr. Proof. by []. Qed.
 
 End BoolIf.
 
-(* Core (internal) reflection lemmas, used for the three kinds of views. *)
+(**  Core (internal) reflection lemmas, used for the three kinds of views.  **)
 
 Section ReflectCore.
 
@@ -517,7 +523,7 @@ Proof. by case Hb => [? _ H ? | ? H _]; case: H. Qed.
 
 End ReflectCore.
 
-(* Internal negated reflection lemmas *)
+(**  Internal negated reflection lemmas  **)
 Section ReflectNegCore.
 
 Variables (P Q : Prop) (b c : bool).
@@ -537,7 +543,7 @@ Proof. by rewrite -if_neg; apply: xorPif. Qed.
 
 End ReflectNegCore.
 
-(* User-oriented reflection lemmas *)
+(**  User-oriented reflection lemmas  **)
 Section Reflect.
 
 Variables (P Q : Prop) (b b' c : bool).
@@ -584,8 +590,8 @@ Lemma rwP : P <-> b. Proof. by split; [apply: introT | apply: elimT]. Qed.
 Lemma rwP2 : reflect Q b -> (P <-> Q).
 Proof. by move=> Qb; split=> ?; [apply: appP | apply: elimT; case: Qb]. Qed.
 
-(*  Predicate family to reflect excluded middle in bool.                      *)
-CoInductive alt_spec : bool -> Type :=
+(**   Predicate family to reflect excluded middle in bool.  **)
+Variant alt_spec : bool -> Type :=
   | AltTrue of     P : alt_spec true
   | AltFalse of ~~ b : alt_spec false.
 
@@ -600,10 +606,10 @@ Hint View for apply/ introTF|3 introNTF|3 introTFn|3 elimT|2 elimTn|2 elimN|2.
 
 Hint View for apply// equivPif|3 xorPif|3 equivPifn|3 xorPifn|3.
 
-(* Allow the direct application of a reflection lemma to a boolean assertion. *)
+(**  Allow the direct application of a reflection lemma to a boolean assertion.  **)
 Coercion elimT : reflect >-> Funclass.
 
-CoInductive implies P Q := Implies of P -> Q.
+Variant implies P Q := Implies of P -> Q.
 Lemma impliesP P Q : implies P Q -> P -> Q. Proof. by case. Qed.
 Lemma impliesPn (P Q : Prop) : implies P Q -> ~ Q -> ~ P.
 Proof. by case=> iP ? /iP. Qed.
@@ -611,7 +617,7 @@ Coercion impliesP : implies >-> Funclass.
 Hint View for move/ impliesPn|2 impliesP|2.
 Hint View for apply/ impliesPn|2 impliesP|2.
 
-(* Impredicative or, which can emulate a classical not-implies. *)
+(**  Impredicative or, which can emulate a classical not-implies.  **)
 Definition unless condition property : Prop :=
  forall goal : Prop, (condition -> goal) -> (property -> goal) -> goal.
 
@@ -637,8 +643,9 @@ Proof. by split; apply=> [hC|hP]; [apply/unlessL/unlessL | apply/unlessR]. Qed.
 Lemma unless_contra b C : implies (~~ b -> C) (\unless C, b).
 Proof. by split; case: b => [_ | hC]; [apply/unlessR | apply/unlessL/hC]. Qed.
 
-(* Classical reasoning becomes directly accessible for any bool subgoal.      *)
-(* Note that we cannot use "unless" here for lack of universe polymorphism.   *)
+(**
+ Classical reasoning becomes directly accessible for any bool subgoal.
+ Note that we cannot use "unless" here for lack of universe polymorphism.    **)
 Definition classically P : Prop := forall b : bool, (P -> b) -> b.
 
 Lemma classicP (P : Prop) : classically P <-> ~ ~ P.
@@ -669,11 +676,12 @@ move=> iPQ []// notPQ; apply/notPQ=> /iPQ-cQ.
 by case: notF; apply: cQ => hQ; apply: notPQ.
 Qed.
 
-(* List notations for wider connectives; the Prop connectives have a fixed    *)
-(* width so as to avoid iterated destruction (we go up to width 5 for /\, and *)
-(* width 4 for or). The bool connectives have arbitrary widths, but denote    *)
-(* expressions that associate to the RIGHT. This is consistent with the right *)
-(* associativity of list expressions and thus more convenient in most proofs. *)
+(**
+ List notations for wider connectives; the Prop connectives have a fixed
+ width so as to avoid iterated destruction (we go up to width 5 for /\, and
+ width 4 for or). The bool connectives have arbitrary widths, but denote
+ expressions that associate to the RIGHT. This is consistent with the right
+ associativity of list expressions and thus more convenient in most proofs.  **)
 
 Inductive and3 (P1 P2 P3 : Prop) : Prop := And3 of P1 & P2 & P3.
 
@@ -822,7 +830,7 @@ Arguments implyP [b1 b2].
 Prenex Implicits idP idPn negP negPn negPf.
 Prenex Implicits andP and3P and4P and5P orP or3P or4P nandP norP implyP.
 
-(* Shorter, more systematic names for the boolean connectives laws.       *)
+(**  Shorter, more systematic names for the boolean connectives laws.        **)
 
 Lemma andTb : left_id true andb.       Proof. by []. Qed.
 Lemma andFb : left_zero false andb.    Proof. by []. Qed.
@@ -880,14 +888,14 @@ Proof. by case: a; case: b. Qed.
 Lemma negb_or (a b : bool) : ~~ (a || b) = ~~ a && ~~ b.
 Proof. by case: a; case: b. Qed.
 
-(* Pseudo-cancellation -- i.e, absorbtion *)
+(**  Pseudo-cancellation -- i.e, absorbtion  **)
 
 Lemma andbK a b : a && b || a = a.  Proof. by case: a; case: b. Qed.
 Lemma andKb a b : a || b && a = a.  Proof. by case: a; case: b. Qed.
 Lemma orbK a b : (a || b) && a = a. Proof. by case: a; case: b. Qed.
 Lemma orKb a b : a && (b || a) = a. Proof. by case: a; case: b. Qed.
 
-(* Imply *)
+(**  Imply  **)
 
 Lemma implybT b : b ==> true.           Proof. by case: b. Qed.
 Lemma implybF b : (b ==> false) = ~~ b. Proof. by case: b. Qed.
@@ -917,7 +925,7 @@ Proof. by case: a; case: b => // ->. Qed.
 Lemma implyb_id2l (a b c : bool) : (a -> b = c) -> (a ==> b) = (a ==> c).
 Proof. by case: a; case: b; case: c => // ->. Qed.
 
-(* Addition (xor) *)
+(**  Addition (xor)  **)
 
 Lemma addFb : left_id false addb.               Proof. by []. Qed.
 Lemma addbF : right_id false addb.              Proof. by case. Qed.
@@ -946,9 +954,10 @@ Lemma addbP a b : reflect (~~ a = b) (a (+) b).
 Proof. by case: a; case: b; constructor. Qed.
 Arguments addbP [a b].
 
-(* Resolution tactic for blindly weeding out common terms from boolean       *)
-(* equalities. When faced with a goal of the form (andb/orb/addb b1 b2) = b3 *)
-(* they will try to locate b1 in b3 and remove it. This can fail!            *)
+(**
+ Resolution tactic for blindly weeding out common terms from boolean
+ equalities. When faced with a goal of the form (andb/orb/addb b1 b2) = b3
+ they will try to locate b1 in b3 and remove it. This can fail!             **)
 
 Ltac bool_congr :=
   match goal with
@@ -963,100 +972,101 @@ Ltac bool_congr :=
   | |- (~~ ?X1 = ?X2) => congr 1 negb
   end.
 
-(******************************************************************************)
-(* Predicates, i.e., packaged functions to bool.                              *)
-(* - pred T, the basic type for predicates over a type T, is simply an alias  *)
-(* for T -> bool.                                                             *)
-(* We actually distinguish two kinds of predicates, which we call applicative *)
-(* and collective, based on the syntax used to test them at some x in T:      *)
-(* - For an applicative predicate P, one uses prefix syntax:                  *)
-(*     P x                                                                    *)
-(*   Also, most operations on applicative predicates use prefix syntax as     *)
-(*   well (e.g., predI P Q).                                                  *)
-(* - For a collective predicate A, one uses infix syntax:                     *)
-(*     x \in A                                                                *)
-(*   and all operations on collective predicates use infix syntax as well     *)
-(*   (e.g., [predI A & B]).                                                   *)
-(* There are only two kinds of applicative predicates:                        *)
-(* - pred T, the alias for T -> bool mentioned above                          *)
-(* - simpl_pred T, an alias for simpl_fun T bool with a coercion to pred T    *)
-(*   that auto-simplifies on application (see ssrfun).                        *)
-(* On the other hand, the set of collective predicate types is open-ended via *)
-(* - predType T, a Structure that can be used to put Canonical collective     *)
-(*   predicate interpretation on other types, such as lists, tuples,          *)
-(*   finite sets, etc.                                                        *)
-(* Indeed, we define such interpretations for applicative predicate types,    *)
-(* which can therefore also be used with the infix syntax, e.g.,              *)
-(*     x \in predI P Q                                                        *)
-(* Moreover these infix forms are convertible to their prefix counterpart     *)
-(* (e.g., predI P Q x which in turn simplifies to P x && Q x). The converse   *)
-(* is not true, however; collective predicate types cannot, in general, be    *)
-(* general, be used applicatively, because of the "uniform inheritance"       *)
-(* restriction on implicit coercions.                                         *)
-(*   However, we do define an explicit generic coercion                       *)
-(* - mem : forall (pT : predType), pT -> mem_pred T                           *)
-(*   where mem_pred T is a variant of simpl_pred T that preserves the infix   *)
-(*   syntax, i.e., mem A x auto-simplifies to x \in A.                        *)
-(* Indeed, the infix "collective" operators are notation for a prefix         *)
-(* operator with arguments of type mem_pred T or pred T, applied to coerced   *)
-(* collective predicates, e.g.,                                               *)
-(*      Notation "x \in A" := (in_mem x (mem A)).                             *)
-(* This prevents the variability in the predicate type from interfering with  *)
-(* the application of generic lemmas. Moreover this also makes it much easier *)
-(* to define generic lemmas, because the simplest type -- pred T -- can be    *)
-(* used as the type of generic collective predicates, provided one takes care *)
-(* not to use it applicatively; this avoids the burden of having to declare a *)
-(* different predicate type for each predicate parameter of each section or   *)
-(* lemma.                                                                     *)
-(*   This trick is made possible by the fact that the constructor of the      *)
-(* mem_pred T type aligns the unification process, forcing a generic          *)
-(* "collective" predicate A : pred T to unify with the actual collective B,   *)
-(* which mem has coerced to pred T via an internal, hidden implicit coercion, *)
-(* supplied by the predType structure for B. Users should take care not to    *)
-(* inadvertently "strip" (mem B) down to the coerced B, since this will       *)
-(* expose the internal coercion: Coq will display a term B x that cannot be   *)
-(* typed as such. The topredE lemma can be used to restore the x \in B        *)
-(* syntax in this case. While -topredE can conversely be used to change       *)
-(* x \in P into P x, it is safer to use the inE and memE lemmas instead, as   *)
-(* they do not run the risk of exposing internal coercions. As a consequence  *)
-(* it is better to explicitly cast a generic applicative pred T to simpl_pred *)
-(* using the SimplPred constructor, when it is used as a collective predicate *)
-(* (see, e.g., Lemma eq_big in bigop).                                        *)
-(*   We also sometimes "instantiate" the predType structure by defining a     *)
-(* coercion to the sort of the predPredType structure. This works better for  *)
-(* types such as {set T} that have subtypes that coerce to them, since the    *)
-(* same coercion will be inserted by the application of mem. It also lets us  *)
-(* turn any Type aT : predArgType into the total predicate over that type,    *)
-(* i.e., fun _: aT => true. This allows us to write, e.g., #|'I_n| for the    *)
-(* cardinal of the (finite) type of integers less than n.                     *)
-(*   Collective predicates have a specific extensional equality,              *)
-(*   - A =i B,                                                                *)
-(* while applicative predicates use the extensional equality of functions,    *)
-(*   - P =1 Q                                                                 *)
-(* The two forms are convertible, however.                                    *)
-(* We lift boolean operations to predicates, defining:                        *)
-(* - predU (union), predI (intersection), predC (complement),                 *)
-(*   predD (difference), and preim (preimage, i.e., composition)              *)
-(* For each operation we define three forms, typically:                       *)
-(* - predU : pred T -> pred T -> simpl_pred T                                 *)
-(* - [predU A & B], a Notation for predU (mem A) (mem B)                      *)
-(* - xpredU, a Notation for the lambda-expression inside predU,               *)
-(*     which is mostly useful as an argument of =1, since it exposes the head *)
-(*     head constant of the expression to the ssreflect matching algorithm.   *)
-(* The syntax for the preimage of a collective predicate A is                 *)
-(* - [preim f of A]                                                           *)
-(* Finally, the generic syntax for defining a simpl_pred T is                 *)
-(* - [pred x : T | P(x)], [pred x | P(x)], [pred x in A | P(x)], etc.         *)
-(* We also support boolean relations, but only the applicative form, with     *)
-(* types                                                                      *)
-(* - rel T, an alias for T -> pred T                                          *)
-(* - simpl_rel T, an auto-simplifying version, and syntax                     *)
-(*   [rel x y | P(x,y)], [rel x y in A & B | P(x,y)], etc.                    *)
-(* The notation [rel of fA] can be used to coerce a function returning a      *)
-(* collective predicate to one returning pred T.                              *)
-(*   Finally, note that there is specific support for ambivalent predicates   *)
-(* that can work in either style, as per this file's head descriptor.         *)
-(******************************************************************************)
+
+(**
+ Predicates, i.e., packaged functions to bool.
+ - pred T, the basic type for predicates over a type T, is simply an alias
+ for T -> bool.
+ We actually distinguish two kinds of predicates, which we call applicative
+ and collective, based on the syntax used to test them at some x in T:
+ - For an applicative predicate P, one uses prefix syntax:
+     P x
+   Also, most operations on applicative predicates use prefix syntax as
+   well (e.g., predI P Q).
+ - For a collective predicate A, one uses infix syntax:
+     x \in A
+   and all operations on collective predicates use infix syntax as well
+   (e.g., #[#predI A & B#]#).
+ There are only two kinds of applicative predicates:
+ - pred T, the alias for T -> bool mentioned above
+ - simpl_pred T, an alias for simpl_fun T bool with a coercion to pred T
+   that auto-simplifies on application (see ssrfun).
+ On the other hand, the set of collective predicate types is open-ended via
+ - predType T, a Structure that can be used to put Canonical collective
+   predicate interpretation on other types, such as lists, tuples,
+   finite sets, etc.
+ Indeed, we define such interpretations for applicative predicate types,
+ which can therefore also be used with the infix syntax, e.g.,
+     x \in predI P Q
+ Moreover these infix forms are convertible to their prefix counterpart
+ (e.g., predI P Q x which in turn simplifies to P x && Q x). The converse
+ is not true, however; collective predicate types cannot, in general, be
+ general, be used applicatively, because of the "uniform inheritance"
+ restriction on implicit coercions.
+   However, we do define an explicit generic coercion
+ - mem : forall (pT : predType), pT -> mem_pred T
+   where mem_pred T is a variant of simpl_pred T that preserves the infix
+   syntax, i.e., mem A x auto-simplifies to x \in A.
+ Indeed, the infix "collective" operators are notation for a prefix
+ operator with arguments of type mem_pred T or pred T, applied to coerced
+ collective predicates, e.g.,
+      Notation "x \in A" := (in_mem x (mem A)).
+ This prevents the variability in the predicate type from interfering with
+ the application of generic lemmas. Moreover this also makes it much easier
+ to define generic lemmas, because the simplest type -- pred T -- can be
+ used as the type of generic collective predicates, provided one takes care
+ not to use it applicatively; this avoids the burden of having to declare a
+ different predicate type for each predicate parameter of each section or
+ lemma.
+   This trick is made possible by the fact that the constructor of the
+ mem_pred T type aligns the unification process, forcing a generic
+ "collective" predicate A : pred T to unify with the actual collective B,
+ which mem has coerced to pred T via an internal, hidden implicit coercion,
+ supplied by the predType structure for B. Users should take care not to
+ inadvertently "strip" (mem B) down to the coerced B, since this will
+ expose the internal coercion: Coq will display a term B x that cannot be
+ typed as such. The topredE lemma can be used to restore the x \in B
+ syntax in this case. While -topredE can conversely be used to change
+ x \in P into P x, it is safer to use the inE and memE lemmas instead, as
+ they do not run the risk of exposing internal coercions. As a consequence
+ it is better to explicitly cast a generic applicative pred T to simpl_pred
+ using the SimplPred constructor, when it is used as a collective predicate
+ (see, e.g., Lemma eq_big in bigop).
+   We also sometimes "instantiate" the predType structure by defining a
+ coercion to the sort of the predPredType structure. This works better for
+ types such as {set T} that have subtypes that coerce to them, since the
+ same coercion will be inserted by the application of mem. It also lets us
+ turn any Type aT : predArgType into the total predicate over that type,
+ i.e., fun _: aT => true. This allows us to write, e.g., ##|'I_n| for the
+ cardinal of the (finite) type of integers less than n.
+   Collective predicates have a specific extensional equality,
+   - A =i B,
+ while applicative predicates use the extensional equality of functions,
+   - P =1 Q
+ The two forms are convertible, however.
+ We lift boolean operations to predicates, defining:
+ - predU (union), predI (intersection), predC (complement),
+   predD (difference), and preim (preimage, i.e., composition)
+ For each operation we define three forms, typically:
+ - predU : pred T -> pred T -> simpl_pred T
+ - #[#predU A & B#]#, a Notation for predU (mem A) (mem B)
+ - xpredU, a Notation for the lambda-expression inside predU,
+     which is mostly useful as an argument of =1, since it exposes the head
+     head constant of the expression to the ssreflect matching algorithm.
+ The syntax for the preimage of a collective predicate A is
+ - #[#preim f of A#]#
+ Finally, the generic syntax for defining a simpl_pred T is
+ - #[#pred x : T | P(x) #]#, #[#pred x | P(x) #]#, #[#pred x in A | P(x) #]#, etc.
+ We also support boolean relations, but only the applicative form, with
+ types
+ - rel T, an alias for T -> pred T
+ - simpl_rel T, an auto-simplifying version, and syntax
+   #[#rel x y | P(x,y) #]#, #[#rel x y in A & B | P(x,y) #]#, etc.
+ The notation #[#rel of fA#]# can be used to coerce a function returning a
+ collective predicate to one returning pred T.
+   Finally, note that there is specific support for ambivalent predicates
+ that can work in either style, as per this file's head descriptor.          **)
+
 
 Definition pred T := T -> bool.
 
@@ -1094,8 +1104,9 @@ Coercion applicative_pred_of_simpl (p : simpl_pred) : applicative_pred :=
   fun_of_simpl p.
 Coercion collective_pred_of_simpl (p : simpl_pred) : collective_pred :=
   fun x => (let: SimplFun f := p in fun _ => f x) x.
-(* Note: applicative_of_simpl is convertible to pred_of_simpl, while *)
-(* collective_of_simpl is not. *)
+(**
+ Note: applicative_of_simpl is convertible to pred_of_simpl, while
+ collective_of_simpl is not.  **)
 
 Definition pred0 := SimplPred xpred0.
 Definition predT := SimplPred xpredT.
@@ -1119,7 +1130,7 @@ Proof. by move=> *; apply/orP; left. Qed.
 Lemma subrelUr r1 r2 : subrel r2 (relU r1 r2).
 Proof. by move=> *; apply/orP; right. Qed.
 
-CoInductive mem_pred := Mem of pred T.
+Variant mem_pred := Mem of pred T.
 
 Definition isMem pT topred mem := mem = (fun p : pT => Mem [eta topred p]).
 
@@ -1166,19 +1177,21 @@ Notation "[ 'rel' x y : T | E ]" := (SimplRel (fun x y : T => E%B))
 Notation "[ 'predType' 'of' T ]" := (@clone_pred _ T _ id _ _ id)
   (at level 0, format "[ 'predType'  'of'  T ]") : form_scope.
 
-(* This redundant coercion lets us "inherit" the simpl_predType canonical    *)
-(* instance by declaring a coercion to simpl_pred. This hack is the only way *)
-(* to put a predType structure on a predArgType. We use simpl_pred rather    *)
-(* than pred to ensure that /= removes the identity coercion. Note that the  *)
-(* coercion will never be used directly for simpl_pred, since the canonical  *)
-(* instance should always be resolved.                                       *)
+(**
+ This redundant coercion lets us "inherit" the simpl_predType canonical
+ instance by declaring a coercion to simpl_pred. This hack is the only way
+ to put a predType structure on a predArgType. We use simpl_pred rather
+ than pred to ensure that /= removes the identity coercion. Note that the
+ coercion will never be used directly for simpl_pred, since the canonical
+ instance should always be resolved.                                        **)
 
 Notation pred_class := (pred_sort (predPredType _)).
 Coercion sort_of_simpl_pred T (p : simpl_pred T) : pred_class := p : pred T.
 
-(* This lets us use some types as a synonym for their universal predicate.    *)
-(* Unfortunately, this won't work for existing types like bool, unless we     *)
-(* redefine bool, true, false and all bool ops.                               *)
+(**
+ This lets us use some types as a synonym for their universal predicate.
+ Unfortunately, this won't work for existing types like bool, unless we
+ redefine bool, true, false and all bool ops.                                **)
 Definition predArgType := Type.
 Bind Scope type_scope with predArgType.
 Identity Coercion sort_of_predArgType : predArgType >-> Sortclass.
@@ -1187,8 +1200,9 @@ Coercion pred_of_argType (T : predArgType) : simpl_pred T := predT.
 Notation "{ : T }" := (T%type : predArgType)
   (at level 0, format "{ :  T }") : type_scope.
 
-(* These must be defined outside a Section because "cooking" kills the        *)
-(* nosimpl tag.                                                               *)
+(**
+ These must be defined outside a Section because "cooking" kills the
+ nosimpl tag.                                                                **)
 
 Definition mem T (pT : predType T) : pT -> mem_pred T :=
   nosimpl (let: @PredType _ _ _ (exist _ mem _) := pT return pT -> _ in mem).
@@ -1254,12 +1268,13 @@ Section simpl_mem.
 Variables (T : Type) (pT : predType T).
 Implicit Types (x : T) (p : pred T) (sp : simpl_pred T) (pp : pT).
 
-(* Bespoke structures that provide fine-grained control over matching the     *)
-(* various forms of the \in predicate; note in particular the different forms *)
-(* of hoisting that are used. We had to work around several bugs in the       *)
-(* implementation of unification, notably improper expansion of telescope     *)
-(* projections and overwriting of a variable assignment by a later            *)
-(* unification (probably due to conversion cache cross-talk).                 *)
+(**
+ Bespoke structures that provide fine-grained control over matching the
+ various forms of the \in predicate; note in particular the different forms
+ of hoisting that are used. We had to work around several bugs in the
+ implementation of unification, notably improper expansion of telescope
+ projections and overwriting of a variable assignment by a later
+ unification (probably due to conversion cache cross-talk).                  **)
 Structure manifest_applicative_pred p := ManifestApplicativePred {
   manifest_applicative_pred_value :> pred T;
   _ : manifest_applicative_pred_value = p
@@ -1305,10 +1320,11 @@ Lemma in_simpl x p (msp : manifest_simpl_pred p) :
   in_mem x (Mem [eta fun_of_simpl (msp : simpl_pred T)]) = p x.
 Proof. by case: msp => _ /= ->. Qed.
 
-(* Because of the explicit eta expansion in the left-hand side, this lemma    *)
-(* should only be used in a right-to-left direction. The 8.3 hack allowing    *)
-(* partial right-to-left use does not work with the improved expansion        *)
-(* heuristics in 8.4.                                                         *)
+(**
+ Because of the explicit eta expansion in the left-hand side, this lemma
+ should only be used in a right-to-left direction. The 8.3 hack allowing
+ partial right-to-left use does not work with the improved expansion
+ heuristics in 8.4.                                                          **)
 Lemma unfold_in x p : (x \in ([eta p] : pred T)) = p x.
 Proof. by []. Qed.
 
@@ -1327,9 +1343,9 @@ Proof. by rewrite -mem_topred. Qed.
 
 End simpl_mem.
 
-(* Qualifiers and keyed predicates. *)
+(**  Qualifiers and keyed predicates.  **)
 
-CoInductive qualifier (q : nat) T := Qualifier of predPredType T.
+Variant qualifier (q : nat) T := Qualifier of predPredType T.
 
 Coercion has_quality n T (q : qualifier n T) : pred_class :=
   fun x => let: Qualifier _ p := q in p x.
@@ -1371,12 +1387,12 @@ Notation "[ 'qualify' 'an' x | P ]" := (Qualifier 2 (fun x => P%B))
 Notation "[ 'qualify' 'an' x : T | P ]" := (Qualifier 2 (fun x : T => P%B))
   (at level 0, x at level 99, only parsing) : form_scope.
 
-(* Keyed predicates: support for property-bearing predicate interfaces. *)
+(**  Keyed predicates: support for property-bearing predicate interfaces.  **)
 
 Section KeyPred.
 
 Variable T : Type.
-CoInductive pred_key (p : predPredType T) := DefaultPredKey.
+Variant pred_key (p : predPredType T) := DefaultPredKey.
 
 Variable p : predPredType T.
 Structure keyed_pred (k : pred_key p) :=
@@ -1388,13 +1404,14 @@ Definition KeyedPred := @PackKeyedPred k p (frefl _).
 Variable k_p : keyed_pred k.
 Lemma keyed_predE : k_p =i p. Proof. by case: k_p. Qed.
 
-(* Instances that strip the mem cast; the first one has "pred_of_mem" as its  *)
-(* projection head value, while the second has "pred_of_simpl". The latter    *)
-(* has the side benefit of preempting accidental misdeclarations.             *)
-(* Note: pred_of_mem is the registered mem >-> pred_class coercion, while     *)
-(* simpl_of_mem; pred_of_simpl is the mem >-> pred >=> Funclass coercion. We  *)
-(* must write down the coercions explicitly as the Canonical head constant    *)
-(* computation does not strip casts !!                                        *)
+(**
+ Instances that strip the mem cast; the first one has "pred_of_mem" as its
+ projection head value, while the second has "pred_of_simpl". The latter
+ has the side benefit of preempting accidental misdeclarations.
+ Note: pred_of_mem is the registered mem >-> pred_class coercion, while
+ simpl_of_mem; pred_of_simpl is the mem >-> pred >=> Funclass coercion. We
+ must write down the coercions explicitly as the Canonical head constant
+ computation does not strip casts !!                                         **)
 Canonical keyed_mem :=
   @PackKeyedPred k (pred_of_mem (mem k_p)) keyed_predE.
 Canonical keyed_mem_simpl :=
@@ -1434,7 +1451,7 @@ Canonical default_keyed_qualifier T n (q : qualifier n T) :=
 
 End DefaultKeying.
 
-(* Skolemizing with conditions. *)
+(**  Skolemizing with conditions.  **)
 
 Lemma all_tag_cond_dep I T (C : pred I) U :
     (forall x, T x) -> (forall x, C x -> {y : T x & U x y}) ->
@@ -1461,8 +1478,9 @@ Proof. by move=> y0; apply: all_sig_cond_dep. Qed.
 
 Section RelationProperties.
 
-(* Caveat: reflexive should not be used to state lemmas, as auto and trivial  *)
-(* will not expand the constant.                                              *)
+(**
+ Caveat: reflexive should not be used to state lemmas, as auto and trivial
+ will not expand the constant.                                               **)
 
 Variable T : Type.
 
@@ -1496,8 +1514,9 @@ Proof. by move=> x y /sym_left_transitive Rxy z; rewrite !(symR z) Rxy. Qed.
 
 End PER.
 
-(* We define the equivalence property with prenex quantification so that it   *)
-(* can be localized using the {in ..., ..} form defined below.                *)
+(**
+ We define the equivalence property with prenex quantification so that it
+ can be localized using the {in ..., ..} form defined below.                 **)
 
 Definition equivalence_rel := forall x y z, R z z * (R x y -> R x z = R y z).
 
@@ -1512,7 +1531,7 @@ End RelationProperties.
 Lemma rev_trans T (R : rel T) : transitive R -> transitive (fun x y => R y x).
 Proof. by move=> trR x y z Ryx Rzy; apply: trR Rzy Ryx. Qed.
 
-(* Property localization *)
+(**  Property localization  **)
 
 Local Notation "{ 'all1' P }" := (forall x, P x : Prop) (at level 0).
 Local Notation "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0).
@@ -1626,11 +1645,12 @@ Notation "{ 'on' cd , 'bijective' f }" := (bijective_on (mem cd) f)
   (at level 0, f at level 8,
    format "{ 'on'  cd ,  'bijective'  f }") : type_scope.
 
-(* Weakening and monotonicity lemmas for localized predicates.                *)
-(* Note that using these lemmas in backward reasoning will force expansion of *)
-(* the predicate definition, as Coq needs to expose the quantifier to apply   *)
-(* these lemmas. We define a few specialized variants to avoid this for some  *)
-(* of the ssrfun predicates.                                                  *)
+(**
+ Weakening and monotonicity lemmas for localized predicates.
+ Note that using these lemmas in backward reasoning will force expansion of
+ the predicate definition, as Coq needs to expose the quantifier to apply
+ these lemmas. We define a few specialized variants to avoid this for some
+ of the ssrfun predicates.                                                   **)
 
 Section LocalGlobal.
 
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index 82cae439..c94039a6 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -181,10 +181,9 @@ let option_assert_get o msg =
 (** Constructors for rawconstr *)
 open Glob_term
 open Globnames
-open Misctypes
 open Decl_kinds
 
-let mkRHole = DAst.make @@ GHole (Evar_kinds.InternalHole, IntroAnonymous, None)
+let mkRHole = DAst.make @@ GHole (Evar_kinds.InternalHole, Namegen.IntroAnonymous, None)
 
 let rec mkRHoles n = if n > 0 then mkRHole :: mkRHoles (n - 1) else []
 let rec isRHoles cl = match cl with
@@ -254,7 +253,7 @@ let interp_refine ist gl rc =
 
 
 let interp_open_constr ist gl gc =
-  let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist (pf_env gl) (project gl) (gc, Misctypes.NoBindings) in
+  let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist (pf_env gl) (project gl) (gc, Tactypes.NoBindings) in
   (project gl, (sigma, c))
 
 let interp_term ist gl (_, c) = snd (interp_open_constr ist gl c)
@@ -423,12 +422,12 @@ let mk_anon_id t gl_ids =
     (set s i (Char.chr (Char.code (get s i) + 1)); s) in
   Id.of_bytes (loop (n - 1))
 
-let convert_concl_no_check t = Tactics.convert_concl_no_check t Term.DEFAULTcast
-let convert_concl t = Tactics.convert_concl t Term.DEFAULTcast
+let convert_concl_no_check t = Tactics.convert_concl_no_check t DEFAULTcast
+let convert_concl t = Tactics.convert_concl t DEFAULTcast
 
 let rename_hd_prod orig_name_ref gl =
   match EConstr.kind (project gl) (pf_concl gl) with
-  | Term.Prod(_,src,tgt) ->
+  | Prod(_,src,tgt) ->
       Proofview.V82.of_tactic (convert_concl_no_check (EConstr.mkProd (!orig_name_ref,src,tgt))) gl
   | _ -> CErrors.anomaly (str "gentac creates no product")
 
@@ -504,16 +503,17 @@ let nf_evar sigma t =
   EConstr.Unsafe.to_constr (Evarutil.nf_evar sigma (EConstr.of_constr t))
 
 let pf_abs_evars2 gl rigid (sigma, c0) =
-  let c0 = EConstr.to_constr sigma c0 in
+  let c0 = EConstr.to_constr ~abort_on_undefined_evars:false sigma c0 in
   let sigma0, ucst = project gl, Evd.evar_universe_context sigma in
   let nenv = env_size (pf_env gl) in
   let abs_evar n k =
     let evi = Evd.find sigma k in
-    let dc = CList.firstn n (evar_filtered_context evi) in
+    let concl = EConstr.Unsafe.to_constr evi.evar_concl in
+    let dc = EConstr.Unsafe.to_named_context (CList.firstn n (evar_filtered_context evi)) in
     let abs_dc c = function
     | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
     | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
-    let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
+    let t = Context.Named.fold_inside abs_dc ~init:concl dc in
     nf_evar sigma t in
   let rec put evlist c = match Constr.kind c with
   | Evar (k, a) ->  
@@ -569,11 +569,12 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
   let nenv = env_size (pf_env gl) in
   let abs_evar n k =
     let evi = Evd.find sigma k in
-    let dc = CList.firstn n (evar_filtered_context evi) in
+    let concl = EConstr.Unsafe.to_constr evi.evar_concl in
+    let dc = EConstr.Unsafe.to_named_context (CList.firstn n (evar_filtered_context evi)) in
     let abs_dc c = function
     | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
     | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
-    let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
+    let t = Context.Named.fold_inside abs_dc ~init:concl dc in
     nf_evar sigma0 (nf_evar sigma t) in
   let rec put evlist c = match Constr.kind c with
   | Evar (k, a) ->  
@@ -581,7 +582,7 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
     let n = max 0 (Array.length a - nenv) in
     let k_ty = 
       Retyping.get_sort_family_of 
-        (pf_env gl) sigma (EConstr.of_constr (Evd.evar_concl (Evd.find sigma k))) in
+        (pf_env gl) sigma (Evd.evar_concl (Evd.find sigma k)) in
     let is_prop = k_ty = InProp in
     let t = abs_evar n k in (k, (n, t, is_prop)) :: put evlist t
   | _ -> Constr.fold put evlist c in
@@ -746,7 +747,7 @@ let pf_mkSsrConst name gl =
 let pf_fresh_global name gl =
   let sigma, env, it = project gl, pf_env gl, sig_it gl in
   let sigma,t  = Evd.fresh_global env sigma name in
-  t, re_sig it sigma
+  EConstr.Unsafe.to_constr t, re_sig it sigma
 
 let mkProt t c gl =
   let prot, gl = pf_mkSsrConst "protect_term" gl in
@@ -802,7 +803,7 @@ let rec is_name_in_ipats name = function
   | IPatId id :: tl -> id = name || is_name_in_ipats name tl
   | IPatAbstractVars ids :: tl ->
       CList.mem_f Id.equal name ids || is_name_in_ipats name tl
-  | (IPatCase l | IPatDispatch l | IPatInj l) :: tl ->
+  | (IPatCase l | IPatDispatch (_,l) | IPatInj l) :: tl ->
       List.exists (is_name_in_ipats name) l || is_name_in_ipats name tl
   | (IPatView _ | IPatAnon _ | IPatSimpl _ | IPatRewrite _ | IPatTac _ | IPatNoop) :: tl -> is_name_in_ipats name tl
   | [] -> false
@@ -857,10 +858,10 @@ open Util
 (** Constructors for constr_expr *)
 let mkCProp loc = CAst.make ?loc @@ CSort GProp
 let mkCType loc = CAst.make ?loc @@ CSort (GType [])
-let mkCVar ?loc id = CAst.make ?loc @@ CRef (CAst.make ?loc @@ Ident id, None)
+let mkCVar ?loc id = CAst.make ?loc @@ CRef (qualid_of_ident ?loc id, None)
 let rec mkCHoles ?loc n =
-  if n <= 0 then [] else (CAst.make ?loc @@ CHole (None, IntroAnonymous, None)) :: mkCHoles ?loc (n - 1)
-let mkCHole loc = CAst.make ?loc @@ CHole (None, IntroAnonymous, None)
+  if n <= 0 then [] else (CAst.make ?loc @@ CHole (None, Namegen.IntroAnonymous, None)) :: mkCHoles ?loc (n - 1)
+let mkCHole loc = CAst.make ?loc @@ CHole (None, Namegen.IntroAnonymous, None)
 let mkCLambda ?loc name ty t =  CAst.make ?loc @@
    CLambdaN ([CLocalAssum([CAst.make ?loc name], Default Explicit, ty)], t)
 let mkCArrow ?loc ty t = CAst.make ?loc @@
@@ -983,7 +984,7 @@ let applyn ~with_evars ?beta ?(with_shelve=false) n t gl =
               if not (EConstr.Vars.closed0 sigma ty) then
                 raise dependent_apply_error;
               let m = Evarutil.new_meta () in
-              loop (meta_declare m (EConstr.Unsafe.to_constr ty) sigma) bo ((EConstr.mkMeta m)::args) (n-1)
+              loop (meta_declare m ty sigma) bo ((EConstr.mkMeta m)::args) (n-1)
           | _ -> assert false
       in loop sigma t [] n in
     pp(lazy(str"Refiner.refiner " ++ Printer.pr_econstr_env (pf_env gl) (project gl) t));
@@ -1219,7 +1220,7 @@ let genclrtac cl cs clr =
       (fun type_err gl ->
          tclTHEN
            (tclTHEN (Proofview.V82.of_tactic (Tactics.elim_type (EConstr.of_constr
-             (Universes.constr_of_global @@ Coqlib.build_coq_False ())))) (old_cleartac clr))
+             (UnivGen.constr_of_global @@ Coqlib.build_coq_False ())))) (old_cleartac clr))
            (fun gl -> raise type_err)
            gl))
     (old_cleartac clr)
@@ -1444,7 +1445,7 @@ let tclINTRO_ANON = tclINTRO ~id:None ~conclusion:return
 
 let tclRENAME_HD_PROD name = Goal.enter begin fun gl ->
   let convert_concl_no_check t =
-    Tactics.convert_concl_no_check t Term.DEFAULTcast in
+    Tactics.convert_concl_no_check t DEFAULTcast in
   let concl = Goal.concl gl in
   let sigma = Goal.sigma gl in
   match EConstr.kind sigma concl with
@@ -1503,7 +1504,7 @@ let tclOPTION o d =
 let tacIS_INJECTION_CASE ?ty t = begin
   tclOPTION ty (tacTYPEOF t) >>= fun ty ->
   tacREDUCE_TO_QUANTIFIED_IND ty >>= fun ((mind,_),_) ->
-  tclUNIT (Globnames.eq_gr (Globnames.IndRef mind) (Coqlib.build_coq_eq ()))
+  tclUNIT (GlobRef.equal (GlobRef.IndRef mind) (Coqlib.build_coq_eq ()))
 end
 
 let tclWITHTOP tac = Goal.enter begin fun gl ->
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index 2b8f1d54..9ba23467 100644
--- a/plugins/ssr/ssrcommon.mli
+++ b/plugins/ssr/ssrcommon.mli
@@ -212,7 +212,7 @@ val pf_abs_prod :
            EConstr.t -> Goal.goal Evd.sigma * EConstr.types
 
 val mkSsrRRef : string -> Glob_term.glob_constr * 'a option
-val mkSsrRef : string -> Globnames.global_reference
+val mkSsrRef : string -> GlobRef.t
 val mkSsrConst : 
            string ->
            env -> evar_map -> evar_map * EConstr.t
@@ -224,7 +224,7 @@ val new_wild_id : tac_ctx -> Names.Id.t * tac_ctx
 
 
 val pf_fresh_global :
-           Globnames.global_reference ->
+           GlobRef.t ->
            Goal.goal Evd.sigma ->
            Constr.constr * Goal.goal Evd.sigma
 
diff --git a/plugins/ssr/ssreflect.v b/plugins/ssr/ssreflect.v
index b0a94413..bebbd4ad 100644
--- a/plugins/ssr/ssreflect.v
+++ b/plugins/ssr/ssreflect.v
@@ -10,50 +10,53 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
+(** #<style> .doc { font-family: monospace; white-space: pre; } </style># **)
+
 Require Import Bool. (* For bool_scope delimiter 'bool'. *)
 Require Import ssrmatching.
 Declare ML Module "ssreflect_plugin".
 
-(******************************************************************************)
-(* This file is the Gallina part of the ssreflect plugin implementation.      *)
-(* Files that use the ssreflect plugin should always Require ssreflect and    *)
-(* either Import ssreflect or Import ssreflect.SsrSyntax.                     *)
-(*   Part of the contents of this file is technical and will only interest    *)
-(* advanced developers; in addition the following are defined:                *)
-(*   [the str of v by f] == the Canonical s : str such that f s = v.          *)
-(*        [the str of v] == the Canonical s : str that coerces to v.          *)
-(*        argumentType c == the T such that c : forall x : T, P x.            *)
-(*          returnType c == the R such that c : T -> R.                       *)
-(*     {type of c for s} == P s where c : forall x : T, P x.                  *)
-(*           phantom T v == singleton type with inhabitant Phantom T v.       *)
-(*               phant T == singleton type with inhabitant Phant v.           *)
-(*                 =^~ r == the converse of rewriting rule r (e.g., in a      *)
-(*                          rewrite multirule).                               *)
-(*             unkeyed t == t, but treated as an unkeyed matching pattern by  *)
-(*                          the ssreflect matching algorithm.                 *)
-(*             nosimpl t == t, but on the right-hand side of Definition C :=  *)
-(*                          nosimpl disables expansion of C by /=.            *)
-(*              locked t == t, but locked t is not convertible to t.          *)
-(*       locked_with k t == t, but not convertible to t or locked_with k' t   *)
-(*                          unless k = k' (with k : unit). Coq type-checking  *)
-(*                          will be much more efficient if locked_with with a *)
-(*                          bespoke k is used for sealed definitions.         *)
-(*          unlockable v == interface for sealed constant definitions of v.   *)
-(*        Unlockable def == the unlockable that registers def : C = v.        *)
-(*     [unlockable of C] == a clone for C of the canonical unlockable for the *)
-(*                          definition of C (e.g., if it uses locked_with).   *)
-(*    [unlockable fun C] == [unlockable of C] with the expansion forced to be *)
-(*                          an explicit lambda expression.                    *)
-(*  -> The usage pattern for ADT operations is:                               *)
-(*       Definition foo_def x1 .. xn := big_foo_expression.                   *)
-(*       Fact foo_key : unit. Proof. by []. Qed.                              *)
-(*       Definition foo := locked_with foo_key foo_def.                       *)
-(*       Canonical foo_unlockable := [unlockable fun foo].                    *)
-(*     This minimizes the comparison overhead for foo, while still allowing   *)
-(*     rewrite unlock to expose big_foo_expression.                           *)
-(* More information about these definitions and their use can be found in the *)
-(* ssreflect manual, and in specific comments below.                          *)
-(******************************************************************************)
+
+(**
+ This file is the Gallina part of the ssreflect plugin implementation.
+ Files that use the ssreflect plugin should always Require ssreflect and
+ either Import ssreflect or Import ssreflect.SsrSyntax.
+   Part of the contents of this file is technical and will only interest
+ advanced developers; in addition the following are defined:
+   #[#the str of v by f#]# == the Canonical s : str such that f s = v.
+        #[#the str of v#]# == the Canonical s : str that coerces to v.
+        argumentType c == the T such that c : forall x : T, P x.
+          returnType c == the R such that c : T -> R.
+     {type of c for s} == P s where c : forall x : T, P x.
+           phantom T v == singleton type with inhabitant Phantom T v.
+               phant T == singleton type with inhabitant Phant v.
+                 =^~ r == the converse of rewriting rule r (e.g., in a
+                          rewrite multirule).
+             unkeyed t == t, but treated as an unkeyed matching pattern by
+                          the ssreflect matching algorithm.
+             nosimpl t == t, but on the right-hand side of Definition C :=
+                          nosimpl disables expansion of C by /=.
+              locked t == t, but locked t is not convertible to t.
+       locked_with k t == t, but not convertible to t or locked_with k' t
+                          unless k = k' (with k : unit). Coq type-checking
+                          will be much more efficient if locked_with with a
+                          bespoke k is used for sealed definitions.
+          unlockable v == interface for sealed constant definitions of v.
+        Unlockable def == the unlockable that registers def : C = v.
+     #[#unlockable of C#]# == a clone for C of the canonical unlockable for the
+                          definition of C (e.g., if it uses locked_with).
+    #[#unlockable fun C#]# == #[#unlockable of C#]# with the expansion forced to be
+                          an explicit lambda expression.
+  -> The usage pattern for ADT operations is:
+       Definition foo_def x1 .. xn := big_foo_expression.
+       Fact foo_key : unit. Proof. by #[# #]#. Qed.
+       Definition foo := locked_with foo_key foo_def.
+       Canonical foo_unlockable := #[#unlockable fun foo#]#.
+     This minimizes the comparison overhead for foo, while still allowing
+     rewrite unlock to expose big_foo_expression.
+ More information about these definitions and their use can be found in the
+ ssreflect manual, and in specific comments below.                           **)
+
 
 
 Set Implicit Arguments.
@@ -62,15 +65,16 @@ Unset Printing Implicit Defensive.
 
 Module SsrSyntax.
 
-(* Declare Ssr keywords: 'is' 'of' '//' '/=' and '//='. We also declare the   *)
-(* parsing level 8, as a workaround for a notation grammar factoring problem. *)
-(* Arguments of application-style notations (at level 10) should be declared  *)
-(* at level 8 rather than 9 or the camlp5 grammar will not factor properly.   *)
+(**
+ Declare Ssr keywords: 'is' 'of' '//' '/=' and '//='. We also declare the
+ parsing level 8, as a workaround for a notation grammar factoring problem.
+ Arguments of application-style notations (at level 10) should be declared
+ at level 8 rather than 9 or the camlp5 grammar will not factor properly.    **)
 
 Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)" (at level 8).
 Reserved Notation "(* 69 *)" (at level 69).
 
-(* Non ambiguous keyword to check if the SsrSyntax module is imported *)
+(**  Non ambiguous keyword to check if the SsrSyntax module is imported  **)
 Reserved Notation "(* Use to test if 'SsrSyntax_is_Imported' *)" (at level 8).
 
 Reserved Notation "<hidden n >" (at level 200).
@@ -81,10 +85,11 @@ End SsrSyntax.
 Export SsrMatchingSyntax.
 Export SsrSyntax.
 
-(* Make the general "if" into a notation, so that we can override it below.   *)
-(* The notations are "only parsing" because the Coq decompiler will not       *)
-(* recognize the expansion of the boolean if; using the default printer       *)
-(* avoids a spurrious trailing %GEN_IF.                                       *)
+(**
+ Make the general "if" into a notation, so that we can override it below.
+ The notations are "only parsing" because the Coq decompiler will not
+ recognize the expansion of the boolean if; using the default printer
+ avoids a spurrious trailing %%GEN_IF.                                        **)
 
 Delimit Scope general_if_scope with GEN_IF.
 
@@ -101,7 +106,7 @@ Notation "'if' c 'as' x 'return' t 'then' v1 'else' v2" :=
   (at level 200, c, t, v1, v2 at level 200, x ident, only parsing)
      : general_if_scope.
 
-(* Force boolean interpretation of simple if expressions.                     *)
+(**  Force boolean interpretation of simple if expressions.  **)
 
 Delimit Scope boolean_if_scope with BOOL_IF.
 
@@ -116,37 +121,40 @@ Notation "'if' c 'as' x 'return' t 'then' v1 'else' v2" :=
 
 Open Scope boolean_if_scope.
 
-(* To allow a wider variety of notations without reserving a large number of  *)
-(* of identifiers, the ssreflect library systematically uses "forms" to       *)
-(* enclose complex mixfix syntax. A "form" is simply a mixfix expression      *)
-(* enclosed in square brackets and introduced by a keyword:                   *)
-(*      [keyword ... ]                                                        *)
-(* Because the keyword follows a bracket it does not need to be reserved.     *)
-(* Non-ssreflect libraries that do not respect the form syntax (e.g., the Coq *)
-(* Lists library) should be loaded before ssreflect so that their notations   *)
-(* do not mask all ssreflect forms.                                           *)
+(**
+ To allow a wider variety of notations without reserving a large number of
+ of identifiers, the ssreflect library systematically uses "forms" to
+ enclose complex mixfix syntax. A "form" is simply a mixfix expression
+ enclosed in square brackets and introduced by a keyword:
+      #[#keyword ... #]#
+ Because the keyword follows a bracket it does not need to be reserved.
+ Non-ssreflect libraries that do not respect the form syntax (e.g., the Coq
+ Lists library) should be loaded before ssreflect so that their notations
+ do not mask all ssreflect forms.                                            **)
 Delimit Scope form_scope with FORM.
 Open Scope form_scope.
 
-(* Allow overloading of the cast (x : T) syntax, put whitespace around the    *)
-(* ":" symbol to avoid lexical clashes (and for consistency with the parsing  *)
-(* precedence of the notation, which binds less tightly than application),    *)
-(* and put printing boxes that print the type of a long definition on a       *)
-(* separate line rather than force-fit it at the right margin.                *)
+(**
+ Allow overloading of the cast (x : T) syntax, put whitespace around the
+ ":" symbol to avoid lexical clashes (and for consistency with the parsing
+ precedence of the notation, which binds less tightly than application),
+ and put printing boxes that print the type of a long definition on a
+ separate line rather than force-fit it at the right margin.                 **)
 Notation "x : T" := (x : T)
   (at level 100, right associativity,
    format "'[hv' x '/ '  :  T ']'") : core_scope.
 
-(* Allow the casual use of notations like nat * nat for explicit Type         *)
-(* declarations. Note that (nat * nat : Type) is NOT equivalent to            *)
-(* (nat * nat)%type, whose inferred type is legacy type "Set".                *)
+(**
+ Allow the casual use of notations like nat * nat for explicit Type
+ declarations. Note that (nat * nat : Type) is NOT equivalent to
+ (nat * nat)%%type, whose inferred type is legacy type "Set".                **)
 Notation "T : 'Type'" := (T%type : Type)
   (at level 100, only parsing) : core_scope.
-(* Allow similarly Prop annotation for, e.g., rewrite multirules.             *)
+(**  Allow similarly Prop annotation for, e.g., rewrite multirules. **)
 Notation "P : 'Prop'" := (P%type : Prop)
   (at level 100, only parsing) : core_scope.
 
-(* Constants for abstract: and [: name ] intro pattern *)
+(**  Constants for abstract: and #[#: name #]# intro pattern  **)
 Definition abstract_lock := unit.
 Definition abstract_key := tt.
 
@@ -156,35 +164,36 @@ Definition abstract (statement : Type) (id : nat) (lock : abstract_lock) :=
 Notation "<hidden n >" := (abstract _ n _).
 Notation "T (* n *)" := (abstract T n abstract_key).
 
-(* Constants for tactic-views *)
+(**  Constants for tactic-views  **)
 Inductive external_view : Type := tactic_view of Type.
 
-(* Syntax for referring to canonical structures:                              *)
-(*      [the struct_type of proj_val by proj_fun]                             *)
-(* This form denotes the Canonical instance s of the Structure type           *)
-(* struct_type whose proj_fun projection is proj_val, i.e., such that         *)
-(*      proj_fun s = proj_val.                                                *)
-(* Typically proj_fun will be A record field accessors of struct_type, but    *)
-(* this need not be the case; it can be, for instance, a field of a record    *)
-(* type to which struct_type coerces; proj_val will likewise be coerced to    *)
-(* the return type of proj_fun. In all but the simplest cases, proj_fun       *)
-(* should be eta-expanded to allow for the insertion of implicit arguments.   *)
-(*   In the common case where proj_fun itself is a coercion, the "by" part    *)
-(* can be omitted entirely; in this case it is inferred by casting s to the   *)
-(* inferred type of proj_val. Obviously the latter can be fixed by using an   *)
-(* explicit cast on proj_val, and it is highly recommended to do so when the  *)
-(* return type intended for proj_fun is "Type", as the type inferred for      *)
-(* proj_val may vary because of sort polymorphism (it could be Set or Prop).  *)
-(*   Note when using the [the _ of _] form to generate a substructure from a  *)
-(* telescopes-style canonical hierarchy (implementing inheritance with        *)
-(* coercions), one should always project or coerce the value to the BASE      *)
-(* structure, because Coq will only find a Canonical derived structure for    *)
-(* the Canonical base structure -- not for a base structure that is specific  *)
-(* to proj_value.                                                             *)
+(**
+ Syntax for referring to canonical structures:
+      #[#the struct_type of proj_val by proj_fun#]#
+ This form denotes the Canonical instance s of the Structure type
+ struct_type whose proj_fun projection is proj_val, i.e., such that
+      proj_fun s = proj_val.
+ Typically proj_fun will be A record field accessors of struct_type, but
+ this need not be the case; it can be, for instance, a field of a record
+ type to which struct_type coerces; proj_val will likewise be coerced to
+ the return type of proj_fun. In all but the simplest cases, proj_fun
+ should be eta-expanded to allow for the insertion of implicit arguments.
+   In the common case where proj_fun itself is a coercion, the "by" part
+ can be omitted entirely; in this case it is inferred by casting s to the
+ inferred type of proj_val. Obviously the latter can be fixed by using an
+ explicit cast on proj_val, and it is highly recommended to do so when the
+ return type intended for proj_fun is "Type", as the type inferred for
+ proj_val may vary because of sort polymorphism (it could be Set or Prop).
+   Note when using the #[#the _ of _ #]# form to generate a substructure from a
+ telescopes-style canonical hierarchy (implementing inheritance with
+ coercions), one should always project or coerce the value to the BASE
+ structure, because Coq will only find a Canonical derived structure for
+ the Canonical base structure -- not for a base structure that is specific
+ to proj_value.                                                              **)
 
 Module TheCanonical.
 
-CoInductive put vT sT (v1 v2 : vT) (s : sT) := Put.
+Variant put vT sT (v1 v2 : vT) (s : sT) := Put.
 
 Definition get vT sT v s (p : @put vT sT v v s) := let: Put _ _ _ := p in s.
 
@@ -203,11 +212,12 @@ Notation "[ 'the' sT 'of' v 'by' f ]" :=
 Notation "[ 'the' sT 'of' v ]" := (get ((fun s : sT => Put v (*coerce*)s s) _))
   (at level 0, only parsing) : form_scope.
 
-(* The following are "format only" versions of the above notations. Since Coq *)
-(* doesn't provide this facility, we fake it by splitting the "the" keyword.  *)
-(* We need to do this to prevent the formatter from being be thrown off by    *)
-(* application collapsing, coercion insertion and beta reduction in the right *)
-(* hand side of the notations above.                                          *)
+(**
+ The following are "format only" versions of the above notations. Since Coq
+ doesn't provide this facility, we fake it by splitting the "the" keyword.
+ We need to do this to prevent the formatter from being be thrown off by
+ application collapsing, coercion insertion and beta reduction in the right
+ hand side of the notations above.                                           **)
 
 Notation "[ 'th' 'e' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _)
   (at level 0,  format "[ 'th' 'e'  sT  'of'  v  'by'  f ]") : form_scope.
@@ -215,37 +225,39 @@ Notation "[ 'th' 'e' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _)
 Notation "[ 'th' 'e' sT 'of' v ]" := (@get _ sT v _ _)
   (at level 0, format "[ 'th' 'e'  sT  'of'  v ]") : form_scope.
 
-(* We would like to recognize
-Notation "[ 'th' 'e' sT 'of' v : 'Type' ]" := (@get Type sT v _ _)
-  (at level 0, format "[ 'th' 'e'  sT   'of'  v  :  'Type' ]") : form_scope.
-*)
-
-(* Helper notation for canonical structure inheritance support.               *)
-(* This is a workaround for the poor interaction between delta reduction and  *)
-(* canonical projections in Coq's unification algorithm, by which transparent *)
-(* definitions hide canonical instances, i.e., in                             *)
-(*   Canonical a_type_struct := @Struct a_type ...                            *)
-(*   Definition my_type := a_type.                                            *)
-(* my_type doesn't effectively inherit the struct structure from a_type. Our  *)
-(* solution is to redeclare the instance as follows                           *)
-(*   Canonical my_type_struct := Eval hnf in [struct of my_type].             *)
-(* The special notation [str of _] must be defined for each Strucure "str"    *)
-(* with constructor "Str", typically as follows                               *)
-(*   Definition clone_str s :=                                                *)
-(*      let: Str _ x y ... z := s return {type of Str for s} -> str in        *)
-(*      fun k => k _ x y ... z.                                               *)
-(*    Notation "[ 'str' 'of' T 'for' s ]" := (@clone_str s (@Str T))          *)
-(*      (at level 0, format "[ 'str'  'of'  T  'for'  s ]") : form_scope.     *)
-(*    Notation "[ 'str' 'of' T ]" := (repack_str (fun x => @Str T x))         *)
-(*      (at level 0, format "[ 'str'  'of'  T ]") : form_scope.               *)
-(* The notation for the match return predicate is defined below; the eta      *)
-(* expansion in the second form serves both to distinguish it from the first  *)
-(* and to avoid the delta reduction problem.                                  *)
-(*   There are several variations on the notation and the definition of the   *)
-(* the "clone" function, for telescopes, mixin classes, and join (multiple    *)
-(* inheritance) classes. We describe a different idiom for clones in ssrfun;  *)
-(* it uses phantom types (see below) and static unification; see fintype and  *)
-(* ssralg for examples.                                                       *)
+(**
+ We would like to recognize
+Notation " #[# 'th' 'e' sT 'of' v : 'Type' #]#" := (@get Type sT v _ _)
+  (at level 0, format " #[# 'th' 'e'  sT   'of'  v  :  'Type' #]#") : form_scope.
+ **)
+
+(**
+ Helper notation for canonical structure inheritance support.
+ This is a workaround for the poor interaction between delta reduction and
+ canonical projections in Coq's unification algorithm, by which transparent
+ definitions hide canonical instances, i.e., in
+   Canonical a_type_struct := @Struct a_type ...
+   Definition my_type := a_type.
+ my_type doesn't effectively inherit the struct structure from a_type. Our
+ solution is to redeclare the instance as follows
+   Canonical my_type_struct := Eval hnf in #[#struct of my_type#]#.
+ The special notation #[#str of _ #]# must be defined for each Strucure "str"
+ with constructor "Str", typically as follows
+   Definition clone_str s :=
+      let: Str _ x y ... z := s return {type of Str for s} -> str in
+      fun k => k _ x y ... z.
+    Notation " #[# 'str' 'of' T 'for' s #]#" := (@clone_str s (@Str T))
+      (at level 0, format " #[# 'str'  'of'  T  'for'  s #]#") : form_scope.
+    Notation " #[# 'str' 'of' T #]#" := (repack_str (fun x => @Str T x))
+      (at level 0, format " #[# 'str'  'of'  T #]#") : form_scope.
+ The notation for the match return predicate is defined below; the eta
+ expansion in the second form serves both to distinguish it from the first
+ and to avoid the delta reduction problem.
+   There are several variations on the notation and the definition of the
+ the "clone" function, for telescopes, mixin classes, and join (multiple
+ inheritance) classes. We describe a different idiom for clones in ssrfun;
+ it uses phantom types (see below) and static unification; see fintype and
+ ssralg for examples.                                                        **)
 
 Definition argumentType T P & forall x : T, P x := T.
 Definition dependentReturnType T P & forall x : T, P x := P.
@@ -254,79 +266,82 @@ Definition returnType aT rT & aT -> rT := rT.
 Notation "{ 'type' 'of' c 'for' s }" := (dependentReturnType c s)
   (at level 0, format "{ 'type'  'of'  c  'for'  s }") : type_scope.
 
-(* A generic "phantom" type (actually, a unit type with a phantom parameter). *)
-(* This type can be used for type definitions that require some Structure     *)
-(* on one of their parameters, to allow Coq to infer said structure so it     *)
-(* does not have to be supplied explicitly or via the "[the _ of _]" notation *)
-(* (the latter interacts poorly with other Notation).                         *)
-(*   The definition of a (co)inductive type with a parameter p : p_type, that *)
-(* needs to use the operations of a structure                                 *)
-(*  Structure p_str : Type := p_Str {p_repr :> p_type; p_op : p_repr -> ...}  *)
-(* should be given as                                                         *)
-(*  Inductive indt_type (p : p_str) := Indt ... .                             *)
-(*  Definition indt_of (p : p_str) & phantom p_type p := indt_type p.         *)
-(*  Notation "{ 'indt' p }" := (indt_of (Phantom p)).                         *)
-(*  Definition indt p x y ... z : {indt p} := @Indt p x y ... z.              *)
-(*  Notation "[ 'indt' x y ... z ]" := (indt x y ... z).                      *)
-(* That is, the concrete type and its constructor should be shadowed by       *)
-(* definitions that use a phantom argument to infer and display the true      *)
-(* value of p (in practice, the "indt" constructor often performs additional  *)
-(* functions, like "locking" the representation -- see below).                *)
-(*   We also define a simpler version ("phant" / "Phant") of phantom for the  *)
-(* common case where p_type is Type.                                          *)
-
-CoInductive phantom T (p : T) := Phantom.
+(**
+ A generic "phantom" type (actually, a unit type with a phantom parameter).
+ This type can be used for type definitions that require some Structure
+ on one of their parameters, to allow Coq to infer said structure so it
+ does not have to be supplied explicitly or via the " #[#the _ of _ #]#" notation
+ (the latter interacts poorly with other Notation).
+   The definition of a (co)inductive type with a parameter p : p_type, that
+ needs to use the operations of a structure
+  Structure p_str : Type := p_Str {p_repr :> p_type; p_op : p_repr -> ...}
+ should be given as
+  Inductive indt_type (p : p_str) := Indt ... .
+  Definition indt_of (p : p_str) & phantom p_type p := indt_type p.
+  Notation "{ 'indt' p }" := (indt_of (Phantom p)).
+  Definition indt p x y ... z : {indt p} := @Indt p x y ... z.
+  Notation " #[# 'indt' x y ... z #]#" := (indt x y ... z).
+ That is, the concrete type and its constructor should be shadowed by
+ definitions that use a phantom argument to infer and display the true
+ value of p (in practice, the "indt" constructor often performs additional
+ functions, like "locking" the representation -- see below).
+   We also define a simpler version ("phant" / "Phant") of phantom for the
+ common case where p_type is Type.                                           **)
+
+Variant phantom T (p : T) := Phantom.
 Arguments phantom : clear implicits.
 Arguments Phantom : clear implicits.
-CoInductive phant (p : Type) := Phant.
+Variant phant (p : Type) := Phant.
 
-(* Internal tagging used by the implementation of the ssreflect elim.         *)
+(**  Internal tagging used by the implementation of the ssreflect elim.  **)
 
 Definition protect_term (A : Type) (x : A) : A := x.
 
-(* The ssreflect idiom for a non-keyed pattern:                               *)
-(*  - unkeyed t wiil match any subterm that unifies with t, regardless of     *)
-(*    whether it displays the same head symbol as t.                          *)
-(*  - unkeyed t a b will match any application of a term f unifying with t,   *)
-(*    to two arguments unifying with with a and b, repectively, regardless of *)
-(*    apparent head symbols.                                                  *)
-(*  - unkeyed x where x is a variable will match any subterm with the same    *)
-(*    type as x (when x would raise the 'indeterminate pattern' error).       *)
+(**
+ The ssreflect idiom for a non-keyed pattern:
+  - unkeyed t wiil match any subterm that unifies with t, regardless of
+    whether it displays the same head symbol as t.
+  - unkeyed t a b will match any application of a term f unifying with t,
+    to two arguments unifying with with a and b, repectively, regardless of
+    apparent head symbols.
+  - unkeyed x where x is a variable will match any subterm with the same
+    type as x (when x would raise the 'indeterminate pattern' error).        **)
 
 Notation unkeyed x := (let flex := x in flex).
 
-(* Ssreflect converse rewrite rule rule idiom. *)
+(**  Ssreflect converse rewrite rule rule idiom.  **)
 Definition ssr_converse R (r : R) := (Logic.I, r).
 Notation "=^~ r" := (ssr_converse r) (at level 100) : form_scope.
 
-(* Term tagging (user-level).                                                 *)
-(* The ssreflect library uses four strengths of term tagging to restrict      *)
-(* convertibility during type checking:                                       *)
-(*  nosimpl t simplifies to t EXCEPT in a definition; more precisely, given   *)
-(*    Definition foo := nosimpl bar, foo (or foo t') will NOT be expanded by  *)
-(*    the /= and //= switches unless it is in a forcing context (e.g., in     *)
-(*    match foo t' with ... end, foo t' will be reduced if this allows the    *)
-(*    match to be reduced). Note that nosimpl bar is simply notation for a    *)
-(*    a term that beta-iota reduces to bar; hence rewrite /foo will replace   *)
-(*    foo by bar, and rewrite -/foo will replace bar by foo.                  *)
-(*    CAVEAT: nosimpl should not be used inside a Section, because the end of *)
-(*    section "cooking" removes the iota redex.                               *)
-(*  locked t is provably equal to t, but is not convertible to t; 'locked'    *)
-(*    provides support for selective rewriting, via the lock t : t = locked t *)
-(*    Lemma, and the ssreflect unlock tactic.                                 *)
-(*  locked_with k t is equal but not convertible to t, much like locked t,    *)
-(*    but supports explicit tagging with a value k : unit. This is used to    *)
-(*    mitigate a flaw in the term comparison heuristic of the Coq kernel,     *)
-(*    which treats all terms of the form locked t as equal and conpares their *)
-(*    arguments recursively, leading to an exponential blowup of comparison.  *)
-(*    For this reason locked_with should be used rather than locked when      *)
-(*    defining ADT operations. The unlock tactic does not support locked_with *)
-(*    but the unlock rewrite rule does, via the unlockable interface.         *)
-(*  we also use Module Type ascription to create truly opaque constants,      *)
-(*    because simple expansion of constants to reveal an unreducible term     *)
-(*    doubles the time complexity of a negative comparison. Such opaque       *)
-(*    constants can be expanded generically with the unlock rewrite rule.     *)
-(*    See the definition of card and subset in fintype for examples of this.  *)
+(**
+ Term tagging (user-level).
+ The ssreflect library uses four strengths of term tagging to restrict
+ convertibility during type checking:
+  nosimpl t simplifies to t EXCEPT in a definition; more precisely, given
+    Definition foo := nosimpl bar, foo (or foo t') will NOT be expanded by
+    the /= and //= switches unless it is in a forcing context (e.g., in
+    match foo t' with ... end, foo t' will be reduced if this allows the
+    match to be reduced). Note that nosimpl bar is simply notation for a
+    a term that beta-iota reduces to bar; hence rewrite /foo will replace
+    foo by bar, and rewrite -/foo will replace bar by foo.
+    CAVEAT: nosimpl should not be used inside a Section, because the end of
+    section "cooking" removes the iota redex.
+  locked t is provably equal to t, but is not convertible to t; 'locked'
+    provides support for selective rewriting, via the lock t : t = locked t
+    Lemma, and the ssreflect unlock tactic.
+  locked_with k t is equal but not convertible to t, much like locked t,
+    but supports explicit tagging with a value k : unit. This is used to
+    mitigate a flaw in the term comparison heuristic of the Coq kernel,
+    which treats all terms of the form locked t as equal and conpares their
+    arguments recursively, leading to an exponential blowup of comparison.
+    For this reason locked_with should be used rather than locked when
+    defining ADT operations. The unlock tactic does not support locked_with
+    but the unlock rewrite rule does, via the unlockable interface.
+  we also use Module Type ascription to create truly opaque constants,
+    because simple expansion of constants to reveal an unreducible term
+    doubles the time complexity of a negative comparison. Such opaque
+    constants can be expanded generically with the unlock rewrite rule.
+    See the definition of card and subset in fintype for examples of this.   **)
 
 Notation nosimpl t := (let: tt := tt in t).
 
@@ -335,11 +350,11 @@ Definition locked A := let: tt := master_key in fun x : A => x.
 
 Lemma lock A x : x = locked x :> A. Proof. unlock; reflexivity. Qed.
 
-(* Needed for locked predicates, in particular for eqType's.                  *)
+(**  Needed for locked predicates, in particular for eqType's.  **)
 Lemma not_locked_false_eq_true : locked false <> true.
 Proof. unlock; discriminate. Qed.
 
-(* The basic closing tactic "done".                                           *)
+(**  The basic closing tactic "done".  **)
 Ltac done :=
   trivial; hnf; intros; solve
    [ do ![solve [trivial | apply: sym_equal; trivial]
@@ -347,7 +362,7 @@ Ltac done :=
    | case not_locked_false_eq_true; assumption
    | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
 
-(* Quicker done tactic not including split, syntax: /0/ *)
+(**  Quicker done tactic not including split, syntax: /0/  **)
 Ltac ssrdone0 :=
   trivial; hnf; intros; solve
    [ do ![solve [trivial | apply: sym_equal; trivial]
@@ -355,7 +370,7 @@ Ltac ssrdone0 :=
    | case not_locked_false_eq_true; assumption
    | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
 
-(* To unlock opaque constants. *)
+(**  To unlock opaque constants.  **)
 Structure unlockable T v := Unlockable {unlocked : T; _ : unlocked = v}.
 Lemma unlock T x C : @unlocked T x C = x. Proof. by case: C. Qed.
 
@@ -365,25 +380,26 @@ Notation "[ 'unlockable' 'of' C ]" := (@Unlockable _ _ C (unlock _))
 Notation "[ 'unlockable' 'fun' C ]" := (@Unlockable _ (fun _ => _) C (unlock _))
   (at level 0, format "[ 'unlockable'  'fun'  C ]") : form_scope.
 
-(* Generic keyed constant locking. *)
+(**  Generic keyed constant locking.  **)
 
-(* The argument order ensures that k is always compared before T. *)
+(**  The argument order ensures that k is always compared before T.  **)
 Definition locked_with k := let: tt := k in fun T x => x : T.
 
-(* This can be used as a cheap alternative to cloning the unlockable instance *)
-(* below, but with caution as unkeyed matching can be expensive.              *)
+(**
+ This can be used as a cheap alternative to cloning the unlockable instance
+ below, but with caution as unkeyed matching can be expensive.               **)
 Lemma locked_withE T k x : unkeyed (locked_with k x) = x :> T.
 Proof. by case: k. Qed.
 
-(* Intensionaly, this instance will not apply to locked u. *)
+(**  Intensionaly, this instance will not apply to locked u.  **)
 Canonical locked_with_unlockable T k x :=
   @Unlockable T x (locked_with k x) (locked_withE k x).
 
-(* More accurate variant of unlock, and safer alternative to locked_withE. *)
+(**  More accurate variant of unlock, and safer alternative to locked_withE.  **)
 Lemma unlock_with T k x : unlocked (locked_with_unlockable k x) = x :> T.
 Proof. exact: unlock. Qed.
 
-(* The internal lemmas for the have tactics.                                  *)
+(**  The internal lemmas for the have tactics.  **)
 
 Definition ssr_have Plemma Pgoal (step : Plemma) rest : Pgoal := rest step.
 Arguments ssr_have Plemma [Pgoal].
@@ -398,7 +414,7 @@ Arguments ssr_suff Plemma [Pgoal].
 Definition ssr_wlog := ssr_suff.
 Arguments ssr_wlog Plemma [Pgoal].
 
-(* Internal N-ary congruence lemmas for the congr tactic.                     *)
+(**  Internal N-ary congruence lemmas for the congr tactic.  **)
 
 Fixpoint nary_congruence_statement (n : nat)
          : (forall B, (B -> B -> Prop) -> Prop) -> Prop :=
@@ -422,7 +438,7 @@ Lemma ssr_congr_arrow Plemma Pgoal : Plemma = Pgoal -> Plemma -> Pgoal.
 Proof. by move->. Qed.
 Arguments ssr_congr_arrow : clear implicits.
 
-(* View lemmas that don't use reflection.                                     *)
+(**  View lemmas that don't use reflection.  **)
 
 Section ApplyIff.
 
@@ -440,14 +456,15 @@ End ApplyIff.
 Hint View for move/ iffLRn|2 iffRLn|2 iffLR|2 iffRL|2.
 Hint View for apply/ iffRLn|2 iffLRn|2 iffRL|2 iffLR|2.
 
-(* To focus non-ssreflect tactics on a subterm, eg vm_compute. *)
-(* Usage:                                                      *)
-(*   elim/abstract_context: (pattern) => G defG.               *)
-(*   vm_compute; rewrite {}defG {G}.                           *)
-(* Note that vm_cast are not stored in the proof term          *)
-(* for reductions occuring in the context, hence               *)
-(*   set here := pattern; vm_compute in (value of here)        *)
-(* blows up at Qed time.                                       *)
+(**
+ To focus non-ssreflect tactics on a subterm, eg vm_compute.
+ Usage:
+   elim/abstract_context: (pattern) => G defG.
+   vm_compute; rewrite {}defG {G}.
+ Note that vm_cast are not stored in the proof term
+ for reductions occuring in the context, hence
+   set here := pattern; vm_compute in (value of here)
+ blows up at Qed time.                                        **)
 Lemma abstract_context T (P : T -> Type) x :
   (forall Q, Q = P -> Q x) -> P x.
 Proof. by move=> /(_ P); apply. Qed.
diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml
index 40af5187..602fcfca 100644
--- a/plugins/ssr/ssrelim.ml
+++ b/plugins/ssr/ssrelim.ml
@@ -14,9 +14,10 @@ open Util
 open Names
 open Printer
 open Term
+open Constr
 open Termops
 open Globnames
-open Misctypes
+open Tactypes
 open Tacmach
 
 open Ssrmatching_plugin
@@ -358,7 +359,7 @@ let ssrelim ?(ind=ref None) ?(is_case=false) deps what ?elim eqid elim_intro_tac
     let ev = List.fold_left Evar.Set.union Evar.Set.empty patterns_ev in
     let ty_ev = Evar.Set.fold (fun i e ->
          let ex = i in
-         let i_ty = EConstr.of_constr (Evd.evar_concl (Evd.find (project gl) ex)) in
+         let i_ty = Evd.evar_concl (Evd.find (project gl) ex) in
          Evar.Set.union e (evars_of_term i_ty))
       ev Evar.Set.empty in
     let inter = Evar.Set.inter ev ty_ev in
@@ -420,7 +421,7 @@ let injectl2rtac sigma c = match EConstr.kind sigma c with
 let is_injection_case c gl =
   let gl, cty = pfe_type_of gl c in
   let (mind,_), _ = pf_reduce_to_quantified_ind gl cty in
-  eq_gr (IndRef mind) (Coqlib.build_coq_eq ())
+  GlobRef.equal (IndRef mind) (Coqlib.build_coq_eq ())
 
 let perform_injection c gl =
   let gl, cty = pfe_type_of gl c in
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index c29203de..f23433f2 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -277,7 +277,7 @@ let unfoldintac occ rdx t (kt,_) gl =
 let foldtac occ rdx ft gl = 
   let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
   let sigma, t = ft in
-  let t = EConstr.to_constr sigma t in
+  let t = EConstr.to_constr ~abort_on_undefined_evars:false sigma t in
   let fold, conclude = match rdx with
   | Some (_, (In_T _ | In_X_In_T _)) | None ->
     let ise = Evd.create_evar_defs sigma in
@@ -288,7 +288,10 @@ let foldtac occ rdx ft gl =
     (fun env c _ h -> try find_T env c h ~k:(fun env t _ _ -> t) with NoMatch ->c),
     (fun () -> try end_T () with NoMatch -> fake_pmatcher_end ())
   | _ -> 
-    (fun env c _ h -> try let sigma = unify_HO env sigma (EConstr.of_constr c) (EConstr.of_constr t) in EConstr.to_constr sigma (EConstr.of_constr t)
+    (fun env c _ h ->
+       try
+         let sigma = unify_HO env sigma (EConstr.of_constr c) (EConstr.of_constr t) in
+         EConstr.to_constr ~abort_on_undefined_evars:false sigma (EConstr.of_constr t)
     with _ -> errorstrm Pp.(str "fold pattern " ++ pr_constr_pat t ++ spc ()
       ++ str "does not match redex " ++ pr_constr_pat c)), 
     fake_pmatcher_end in
@@ -360,7 +363,7 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
           let evs = Evar.Set.elements (Evarutil.undefined_evars_of_term sigma t) in
           let open_evs = List.filter (fun k ->
             Sorts.InProp <> Retyping.get_sort_family_of
-              env sigma (EConstr.of_constr (Evd.evar_concl (Evd.find sigma k))))
+              env sigma (Evd.evar_concl (Evd.find sigma k)))
             evs in
           if open_evs <> [] then Some name else None)
           (List.combine (Array.to_list args) names)
@@ -370,8 +373,8 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
 ;;
 
 let is_construct_ref sigma c r =
-  EConstr.isConstruct sigma c && eq_gr (ConstructRef (fst(EConstr.destConstruct sigma c))) r
-let is_ind_ref sigma c r = EConstr.isInd sigma c && eq_gr (IndRef (fst(EConstr.destInd sigma c))) r
+  EConstr.isConstruct sigma c && GlobRef.equal (ConstructRef (fst(EConstr.destConstruct sigma c))) r
+let is_ind_ref sigma c r = EConstr.isInd sigma c && GlobRef.equal (IndRef (fst(EConstr.destInd sigma c))) r
 
 let rwcltac cl rdx dir sr gl =
   let n, r_n,_, ucst = pf_abs_evars gl sr in
@@ -415,8 +418,6 @@ let rwcltac cl rdx dir sr gl =
       then errorstrm Pp.(str "Rewriting impacts evars")
       else errorstrm Pp.(str "Dependent type error in rewrite of "
         ++ pr_constr_env (pf_env gl) (project gl) (Term.mkNamedLambda pattern_id (EConstr.Unsafe.to_constr rdxt) (EConstr.Unsafe.to_constr cl)))
-    | CErrors.UserError _ as e -> raise e
-    | e -> anomaly ("cvtac's exception: " ^ Printexc.to_string e);
   in
   tclTHEN cvtac' rwtac gl
 
@@ -436,7 +437,7 @@ let lz_setoid_relation =
   | env', srel when env' == env -> srel
   | _ ->
     let srel =
-       try Some (Universes.constr_of_global @@
+       try Some (UnivGen.constr_of_global @@
                    Coqlib.coq_reference "Class_setoid" sdir "RewriteRelation")
        with _ -> None in
     last_srel := (env, srel); srel
@@ -479,11 +480,11 @@ let rwprocess_rule dir rule gl =
         | _ -> let ra = Array.append a [|r|] in
           function 1 ->
             let sigma, pi1 = Evd.fresh_global env sigma coq_prod.Coqlib.proj1 in
-            EConstr.mkApp (EConstr.of_constr pi1, ra), sigma
+            EConstr.mkApp (pi1, ra), sigma
           | _ ->
             let sigma, pi2 = Evd.fresh_global env sigma coq_prod.Coqlib.proj2 in
-            EConstr.mkApp (EConstr.of_constr pi2, ra), sigma in
-        if EConstr.eq_constr sigma a.(0) (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_True ())) then
+            EConstr.mkApp (pi2, ra), sigma in
+        if EConstr.eq_constr sigma a.(0) (EConstr.of_constr (UnivGen.constr_of_global @@ Coqlib.build_coq_True ())) then
          let s, sigma = sr sigma 2 in
          loop (converse_dir d) sigma s a.(1) rs 0
         else
@@ -558,7 +559,7 @@ let rwrxtac occ rdx_pat dir rule gl =
       let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
         let sigma, pat =
           let rw_progress rhs t evd = rw_progress rhs (EConstr.of_constr t) evd in
-          mk_tpattern env sigma0 (sigma,EConstr.to_constr sigma r) (rw_progress rhs) d (EConstr.to_constr sigma lhs) in
+          mk_tpattern env sigma0 (sigma, EConstr.to_constr ~abort_on_undefined_evars:false sigma r) (rw_progress rhs) d (EConstr.to_constr ~abort_on_undefined_evars:false sigma lhs) in
         sigma, pats @ [pat] in
       let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
       let find_R, end_R = mk_tpattern_matcher sigma0 occ ~upats_origin rpats in
@@ -568,7 +569,7 @@ let rwrxtac occ rdx_pat dir rule gl =
       let r = ref None in
       (fun env c _ h -> do_once r (fun () -> find_rule (EConstr.of_constr c), c); mkRel h),
       (fun concl -> closed0_check concl e gl;
-        let (d,(ev,ctx,c)) , x = assert_done r in (d,(ev,ctx, EConstr.to_constr ev c)) , x) in
+        let (d,(ev,ctx,c)) , x = assert_done r in (d,(ev,ctx, EConstr.to_constr ~abort_on_undefined_evars:false ev c)) , x) in
   let concl0 = EConstr.Unsafe.to_constr concl0 in
   let concl = eval_pattern env0 sigma0 concl0 rdx_pat occ find_R in
   let (d, r), rdx = conclude concl in
@@ -590,7 +591,10 @@ let ssrinstancesofrule ist dir arg gl =
     let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
       let sigma, pat =
         let rw_progress rhs t evd = rw_progress rhs (EConstr.of_constr t) evd in
-        mk_tpattern env sigma0 (sigma,EConstr.to_constr sigma r) (rw_progress rhs) d (EConstr.to_constr sigma lhs) in
+        mk_tpattern env sigma0
+          (sigma,EConstr.to_constr ~abort_on_undefined_evars:false sigma r)
+          (rw_progress rhs) d
+          (EConstr.to_constr ~abort_on_undefined_evars:false sigma lhs) in
       sigma, pats @ [pat] in
     let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
     mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true sigma0 None ~upats_origin rpats in
diff --git a/plugins/ssr/ssrfun.v b/plugins/ssr/ssrfun.v
index ac2c7824..4810c6e1 100644
--- a/plugins/ssr/ssrfun.v
+++ b/plugins/ssr/ssrfun.v
@@ -10,207 +10,210 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
+(** #<style> .doc { font-family: monospace; white-space: pre; } </style># **)
+
 Require Import ssreflect.
 
-(******************************************************************************)
-(* This file contains the basic definitions and notations for working with    *)
-(* functions. The definitions provide for:                                    *)
-(*                                                                            *)
-(* - Pair projections:                                                        *)
-(*    p.1  == first element of a pair                                         *)
-(*    p.2  == second element of a pair                                        *)
-(*   These notations also apply to p : P /\ Q, via an and >-> pair coercion.  *)
-(*                                                                            *)
-(* - Simplifying functions, beta-reduced by /= and simpl:                     *)
-(*           [fun : T => E] == constant function from type T that returns E   *)
-(*             [fun x => E] == unary function                                 *)
-(*         [fun x : T => E] == unary function with explicit domain type       *)
-(*           [fun x y => E] == binary function                                *)
-(*       [fun x y : T => E] == binary function with common domain type        *)
-(*         [fun (x : T) y => E] \                                             *)
-(* [fun (x : xT) (y : yT) => E] | == binary function with (some) explicit,    *)
-(*         [fun x (y : T) => E] / independent domain types for each argument  *)
-(*                                                                            *)
-(* - Partial functions using option type:                                     *)
-(*     oapp f d ox == if ox is Some x returns f x,        d otherwise         *)
-(*      odflt d ox == if ox is Some x returns x,          d otherwise         *)
-(*      obind f ox == if ox is Some x returns f x,        None otherwise      *)
-(*       omap f ox == if ox is Some x returns Some (f x), None otherwise      *)
-(*                                                                            *)
-(* - Singleton types:                                                         *)
-(*  all_equal_to x0 == x0 is the only value in its type, so any such value    *)
-(*                     can be rewritten to x0.                                *)
-(*                                                                            *)
-(* - A generic wrapper type:                                                  *)
-(*       wrapped T == the inductive type with values Wrap x for x : T.        *)
-(*        unwrap w == the projection of w : wrapped T on T.                   *)
-(*          wrap x == the canonical injection of x : T into wrapped T; it is  *)
-(*                    equivalent to Wrap x, but is declared as a (default)    *)
-(*                    Canonical Structure, which lets the Coq HO unification  *)
-(*                    automatically expand x into unwrap (wrap x). The delta  *)
-(*                    reduction of wrap x to Wrap can be exploited to         *)
-(*                    introduce controlled nondeterminism in Canonical        *)
-(*                    Structure inference, as in the implementation of        *)
-(*                    the mxdirect predicate in matrix.v.                     *)
-(*                                                                            *)
-(* - Sigma types:                                                             *)
-(*           tag w == the i of w : {i : I & T i}.                             *)
-(*        tagged w == the T i component of w : {i : I & T i}.                 *)
-(*      Tagged T x == the {i : I & T i} with component x : T i.               *)
-(*          tag2 w == the i of w : {i : I & T i & U i}.                       *)
-(*       tagged2 w == the T i component of w : {i : I & T i & U i}.           *)
-(*      tagged2' w == the U i component of w : {i : I & T i & U i}.           *)
-(* Tagged2 T U x y == the {i : I & T i} with components x : T i and y : U i.  *)
-(*          sval u == the x of u : {x : T | P x}.                             *)
-(*         s2val u == the x of u : {x : T | P x & Q x}.                       *)
-(*   The properties of sval u, s2val u are given by lemmas svalP, s2valP, and *)
-(*   s2valP'. We provide coercions sigT2 >-> sigT and sig2 >-> sig >-> sigT.  *)
-(*   A suite of lemmas (all_sig, ...) let us skolemize sig, sig2, sigT, sigT2 *)
-(*   and pair, e.g.,                                                          *)
-(*     have /all_sig[f fP] (x : T): {y : U | P y} by ...                      *)
-(*   yields an f : T -> U such that fP : forall x, P (f x).                   *)
-(* - Identity functions:                                                      *)
-(*    id           == NOTATION for the explicit identity function fun x => x. *)
-(*    @id T        == notation for the explicit identity at type T.           *)
-(*    idfun        == an expression with a head constant, convertible to id;  *)
-(*                    idfun x simplifies to x.                                *)
-(*    @idfun T     == the expression above, specialized to type T.            *)
-(*    phant_id x y == the function type phantom _ x -> phantom _ y.           *)
-(* *** In addition to their casual use in functional programming, identity    *)
-(* functions are often used to trigger static unification as part of the      *)
-(* construction of dependent Records and Structures. For example, if we need  *)
-(* a structure sT over a type T, we take as arguments T, sT, and a "dummy"    *)
-(* function T -> sort sT:                                                     *)
-(*   Definition foo T sT & T -> sort sT := ...                                *)
-(* We can avoid specifying sT directly by calling foo (@id T), or specify     *)
-(* the call completely while still ensuring the consistency of T and sT, by   *)
-(* calling @foo T sT idfun. The phant_id type allows us to extend this trick  *)
-(* to non-Type canonical projections. It also allows us to sidestep           *)
-(* dependent type constraints when building explicit records, e.g., given     *)
-(*    Record r := R {x; y : T(x)}.                                            *)
-(* if we need to build an r from a given y0 while inferring some x0, such     *)
-(* that y0 : T(x0), we pose                                                   *)
-(*    Definition mk_r .. y .. (x := ...) y' & phant_id y y' := R x y'.        *)
-(* Calling @mk_r .. y0 .. id will cause Coq to use y' := y0, while checking   *)
-(* the dependent type constraint y0 : T(x0).                                  *)
-(*                                                                            *)
-(* - Extensional equality for functions and relations (i.e. functions of two  *)
-(*   arguments):                                                              *)
-(*    f1 =1 f2      ==  f1 x is equal to f2 x for all x.                      *)
-(*    f1 =1 f2 :> A ==    ... and f2 is explicitly typed.                     *)
-(*    f1 =2 f2      ==  f1 x y is equal to f2 x y for all x y.                *)
-(*    f1 =2 f2 :> A ==    ... and f2 is explicitly typed.                     *)
-(*                                                                            *)
-(* - Composition for total and partial functions:                             *)
-(*            f^~ y == function f with second argument specialised to y,      *)
-(*                     i.e., fun x => f x y                                   *)
-(*                     CAVEAT: conditional (non-maximal) implicit arguments   *)
-(*                     of f are NOT inserted in this context                  *)
-(*            @^~ x == application at x, i.e., fun f => f x                   *)
-(*          [eta f] == the explicit eta-expansion of f, i.e., fun x => f x    *)
-(*                     CAVEAT: conditional (non-maximal) implicit arguments   *)
-(*                     of f are NOT inserted in this context.                 *)
-(*          fun=> v := the constant function fun _ => v.                      *)
-(*        f1 \o f2  == composition of f1 and f2.                              *)
-(*                     Note: (f1 \o f2) x simplifies to f1 (f2 x).            *)
-(*         f1 \; f2 == categorical composition of f1 and f2. This expands to  *)
-(*                     to f2 \o f1 and (f1 \; f2) x simplifies to f2 (f1 x).  *)
-(*      pcomp f1 f2 == composition of partial functions f1 and f2.            *)
-(*                                                                            *)
-(*                                                                            *)
-(* - Properties of functions:                                                 *)
-(*      injective f <-> f is injective.                                       *)
-(*       cancel f g <-> g is a left inverse of f / f is a right inverse of g. *)
-(*      pcancel f g <-> g is a left inverse of f where g is partial.          *)
-(*      ocancel f g <-> g is a left inverse of f where f is partial.          *)
-(*      bijective f <-> f is bijective (has a left and right inverse).        *)
-(*     involutive f <-> f is involutive.                                      *)
-(*                                                                            *)
-(* - Properties for operations.                                               *)
-(*              left_id e op <-> e is a left identity for op (e op x = x).    *)
-(*             right_id e op <-> e is a right identity for op (x op e = x).   *)
-(*     left_inverse e inv op <-> inv is a left inverse for op wrt identity e, *)
-(*                               i.e., (inv x) op x = e.                      *)
-(*    right_inverse e inv op <-> inv is a right inverse for op wrt identity e *)
-(*                               i.e., x op (i x) = e.                        *)
-(*         self_inverse e op <-> each x is its own op-inverse (x op x = e).   *)
-(*             idempotent op <-> op is idempotent for op (x op x = x).        *)
-(*              associative op <-> op is associative, i.e.,                   *)
-(*                               x op (y op z) = (x op y) op z.               *)
-(*            commutative op <-> op is commutative (x op y = y op x).         *)
-(*       left_commutative op <-> op is left commutative, i.e.,                *)
-(*                                   x op (y op z) = y op (x op z).           *)
-(*      right_commutative op <-> op is right commutative, i.e.,               *)
-(*                                   (x op y) op z = (x op z) op y.           *)
-(*            left_zero z op <-> z is a left zero for op (z op x = z).        *)
-(*           right_zero z op <-> z is a right zero for op (x op z = z).       *)
-(*  left_distributive op1 op2 <-> op1 distributes over op2 to the left:       *)
-(*                             (x op2 y) op1 z = (x op1 z) op2 (y op1 z).     *)
-(* right_distributive op1 op2 <-> op distributes over add to the right:       *)
-(*                             x op1 (y op2 z) = (x op1 z) op2 (x op1 z).     *)
-(*        interchange op1 op2 <-> op1 and op2 satisfy an interchange law:     *)
-(*                        (x op2 y) op1 (z op2 t) = (x op1 z) op2 (y op1 t).  *)
-(*  Note that interchange op op is a commutativity property.                  *)
-(*         left_injective op <-> op is injective in its left argument:        *)
-(*                             x op y = z op y -> x = z.                      *)
-(*        right_injective op <-> op is injective in its right argument:       *)
-(*                             x op y = x op z -> y = z.                      *)
-(*          left_loop inv op <-> op, inv obey the inverse loop left axiom:    *)
-(*                              (inv x) op (x op y) = y for all x, y, i.e.,   *)
-(*                              op (inv x) is always a left inverse of op x   *)
-(*      rev_left_loop inv op <-> op, inv obey the inverse loop reverse left   *)
-(*                              axiom: x op ((inv x) op y) = y, for all x, y. *)
-(*         right_loop inv op <-> op, inv obey the inverse loop right axiom:   *)
-(*                              (x op y) op (inv y) = x for all x, y.         *)
-(*     rev_right_loop inv op <-> op, inv obey the inverse loop reverse right  *)
-(*                              axiom: (x op y) op (inv y) = x for all x, y.  *)
-(*   Note that familiar "cancellation" identities like x + y - y = x or       *)
-(* x - y + y = x are respectively instances of right_loop and rev_right_loop  *)
-(* The corresponding lemmas will use the K and NK/VK suffixes, respectively.  *)
-(*                                                                            *)
-(* - Morphisms for functions and relations:                                   *)
-(*    {morph f : x / a >-> r} <-> f is a morphism with respect to functions   *)
-(*                               (fun x => a) and (fun x => r); if r == R[x], *)
-(*                               this states that f a = R[f x] for all x.     *)
-(*          {morph f : x / a} <-> f is a morphism with respect to the         *)
-(*                               function expression (fun x => a). This is    *)
-(*                               shorthand for {morph f : x / a >-> a}; note  *)
-(*                               that the two instances of a are often        *)
-(*                               interpreted at different types.              *)
-(*  {morph f : x y / a >-> r} <-> f is a morphism with respect to functions   *)
-(*                               (fun x y => a) and (fun x y => r).           *)
-(*        {morph f : x y / a} <-> f is a morphism with respect to the         *)
-(*                               function expression (fun x y => a).          *)
-(*     {homo f : x / a >-> r} <-> f is a homomorphism with respect to the     *)
-(*                               predicates (fun x => a) and (fun x => r);    *)
-(*                               if r == R[x], this states that a -> R[f x]   *)
-(*                               for all x.                                   *)
-(*           {homo f : x / a} <-> f is a homomorphism with respect to the     *)
-(*                               predicate expression (fun x => a).           *)
-(*   {homo f : x y / a >-> r} <-> f is a homomorphism with respect to the     *)
-(*                               relations (fun x y => a) and (fun x y => r). *)
-(*         {homo f : x y / a} <-> f is a homomorphism with respect to the     *)
-(*                               relation expression (fun x y => a).          *)
-(*     {mono f : x / a >-> r} <-> f is monotone with respect to projectors    *)
-(*                               (fun x => a) and (fun x => r); if r == R[x], *)
-(*                               this states that R[f x] = a for all x.       *)
-(*           {mono f : x / a} <-> f is monotone with respect to the projector *)
-(*                               expression (fun x => a).                     *)
-(*   {mono f : x y / a >-> r} <-> f is monotone with respect to relators      *)
-(*                               (fun x y => a) and (fun x y => r).           *)
-(*         {mono f : x y / a} <-> f is monotone with respect to the relator   *)
-(*                               expression (fun x y => a).                   *)
-(*                                                                            *)
-(* The file also contains some basic lemmas for the above concepts.           *)
-(* Lemmas relative to cancellation laws use some abbreviated suffixes:        *)
-(*   K - a cancellation rule like esymK : cancel (@esym T x y) (@esym T y x). *)
-(*  LR - a lemma moving an operation from the left hand side of a relation to *)
-(*       the right hand side, like canLR: cancel g f -> x = g y -> f x = y.   *)
-(*  RL - a lemma moving an operation from the right to the left, e.g., canRL. *)
-(* Beware that the LR and RL orientations refer to an "apply" (back chaining) *)
-(* usage; when using the same lemmas with "have" or "move" (forward chaining) *)
-(* the directions will be reversed!.                                          *)
-(******************************************************************************)
+
+(**
+ This file contains the basic definitions and notations for working with
+ functions. The definitions provide for:
+
+ - Pair projections:
+    p.1  == first element of a pair
+    p.2  == second element of a pair
+   These notations also apply to p : P /\ Q, via an and >-> pair coercion.
+
+ - Simplifying functions, beta-reduced by /= and simpl:
+           #[#fun : T => E#]# == constant function from type T that returns E
+             #[#fun x => E#]# == unary function
+         #[#fun x : T => E#]# == unary function with explicit domain type
+           #[#fun x y => E#]# == binary function
+       #[#fun x y : T => E#]# == binary function with common domain type
+         #[#fun (x : T) y => E#]# \
+ #[#fun (x : xT) (y : yT) => E#]# | == binary function with (some) explicit,
+         #[#fun x (y : T) => E#]# / independent domain types for each argument
+
+ - Partial functions using option type:
+     oapp f d ox == if ox is Some x returns f x,        d otherwise
+      odflt d ox == if ox is Some x returns x,          d otherwise
+      obind f ox == if ox is Some x returns f x,        None otherwise
+       omap f ox == if ox is Some x returns Some (f x), None otherwise
+
+ - Singleton types:
+  all_equal_to x0 == x0 is the only value in its type, so any such value
+                     can be rewritten to x0.
+
+ - A generic wrapper type:
+       wrapped T == the inductive type with values Wrap x for x : T.
+        unwrap w == the projection of w : wrapped T on T.
+          wrap x == the canonical injection of x : T into wrapped T; it is
+                    equivalent to Wrap x, but is declared as a (default)
+                    Canonical Structure, which lets the Coq HO unification
+                    automatically expand x into unwrap (wrap x). The delta
+                    reduction of wrap x to Wrap can be exploited to
+                    introduce controlled nondeterminism in Canonical
+                    Structure inference, as in the implementation of
+                    the mxdirect predicate in matrix.v.
+
+ - Sigma types:
+           tag w == the i of w : {i : I & T i}.
+        tagged w == the T i component of w : {i : I & T i}.
+      Tagged T x == the {i : I & T i} with component x : T i.
+          tag2 w == the i of w : {i : I & T i & U i}.
+       tagged2 w == the T i component of w : {i : I & T i & U i}.
+      tagged2' w == the U i component of w : {i : I & T i & U i}.
+ Tagged2 T U x y == the {i : I & T i} with components x : T i and y : U i.
+          sval u == the x of u : {x : T | P x}.
+         s2val u == the x of u : {x : T | P x & Q x}.
+   The properties of sval u, s2val u are given by lemmas svalP, s2valP, and
+   s2valP'. We provide coercions sigT2 >-> sigT and sig2 >-> sig >-> sigT.
+   A suite of lemmas (all_sig, ...) let us skolemize sig, sig2, sigT, sigT2
+   and pair, e.g.,
+     have /all_sig#[#f fP#]# (x : T): {y : U | P y} by ...
+   yields an f : T -> U such that fP : forall x, P (f x).
+ - Identity functions:
+    id           == NOTATION for the explicit identity function fun x => x.
+    @id T        == notation for the explicit identity at type T.
+    idfun        == an expression with a head constant, convertible to id;
+                    idfun x simplifies to x.
+    @idfun T     == the expression above, specialized to type T.
+    phant_id x y == the function type phantom _ x -> phantom _ y.
+ *** In addition to their casual use in functional programming, identity
+ functions are often used to trigger static unification as part of the
+ construction of dependent Records and Structures. For example, if we need
+ a structure sT over a type T, we take as arguments T, sT, and a "dummy"
+ function T -> sort sT:
+   Definition foo T sT & T -> sort sT := ...
+ We can avoid specifying sT directly by calling foo (@id T), or specify
+ the call completely while still ensuring the consistency of T and sT, by
+ calling @foo T sT idfun. The phant_id type allows us to extend this trick
+ to non-Type canonical projections. It also allows us to sidestep
+ dependent type constraints when building explicit records, e.g., given
+    Record r := R {x; y : T(x)}.
+ if we need to build an r from a given y0 while inferring some x0, such
+ that y0 : T(x0), we pose
+    Definition mk_r .. y .. (x := ...) y' & phant_id y y' := R x y'.
+ Calling @mk_r .. y0 .. id will cause Coq to use y' := y0, while checking
+ the dependent type constraint y0 : T(x0).
+
+ - Extensional equality for functions and relations (i.e. functions of two
+   arguments):
+    f1 =1 f2      ==  f1 x is equal to f2 x for all x.
+    f1 =1 f2 :> A ==    ... and f2 is explicitly typed.
+    f1 =2 f2      ==  f1 x y is equal to f2 x y for all x y.
+    f1 =2 f2 :> A ==    ... and f2 is explicitly typed.
+
+ - Composition for total and partial functions:
+            f^~ y == function f with second argument specialised to y,
+                     i.e., fun x => f x y
+                     CAVEAT: conditional (non-maximal) implicit arguments
+                     of f are NOT inserted in this context
+            @^~ x == application at x, i.e., fun f => f x
+          #[#eta f#]# == the explicit eta-expansion of f, i.e., fun x => f x
+                     CAVEAT: conditional (non-maximal) implicit arguments
+                     of f are NOT inserted in this context.
+          fun=> v := the constant function fun _ => v.
+        f1 \o f2  == composition of f1 and f2.
+                     Note: (f1 \o f2) x simplifies to f1 (f2 x).
+         f1 \; f2 == categorical composition of f1 and f2. This expands to
+                     to f2 \o f1 and (f1 \; f2) x simplifies to f2 (f1 x).
+      pcomp f1 f2 == composition of partial functions f1 and f2.
+
+
+ - Properties of functions:
+      injective f <-> f is injective.
+       cancel f g <-> g is a left inverse of f / f is a right inverse of g.
+      pcancel f g <-> g is a left inverse of f where g is partial.
+      ocancel f g <-> g is a left inverse of f where f is partial.
+      bijective f <-> f is bijective (has a left and right inverse).
+     involutive f <-> f is involutive.
+
+ - Properties for operations.
+              left_id e op <-> e is a left identity for op (e op x = x).
+             right_id e op <-> e is a right identity for op (x op e = x).
+     left_inverse e inv op <-> inv is a left inverse for op wrt identity e,
+                               i.e., (inv x) op x = e.
+    right_inverse e inv op <-> inv is a right inverse for op wrt identity e
+                               i.e., x op (i x) = e.
+         self_inverse e op <-> each x is its own op-inverse (x op x = e).
+             idempotent op <-> op is idempotent for op (x op x = x).
+              associative op <-> op is associative, i.e.,
+                               x op (y op z) = (x op y) op z.
+            commutative op <-> op is commutative (x op y = y op x).
+       left_commutative op <-> op is left commutative, i.e.,
+                                   x op (y op z) = y op (x op z).
+      right_commutative op <-> op is right commutative, i.e.,
+                                   (x op y) op z = (x op z) op y.
+            left_zero z op <-> z is a left zero for op (z op x = z).
+           right_zero z op <-> z is a right zero for op (x op z = z).
+  left_distributive op1 op2 <-> op1 distributes over op2 to the left:
+                             (x op2 y) op1 z = (x op1 z) op2 (y op1 z).
+ right_distributive op1 op2 <-> op distributes over add to the right:
+                             x op1 (y op2 z) = (x op1 z) op2 (x op1 z).
+        interchange op1 op2 <-> op1 and op2 satisfy an interchange law:
+                        (x op2 y) op1 (z op2 t) = (x op1 z) op2 (y op1 t).
+  Note that interchange op op is a commutativity property.
+         left_injective op <-> op is injective in its left argument:
+                             x op y = z op y -> x = z.
+        right_injective op <-> op is injective in its right argument:
+                             x op y = x op z -> y = z.
+          left_loop inv op <-> op, inv obey the inverse loop left axiom:
+                              (inv x) op (x op y) = y for all x, y, i.e.,
+                              op (inv x) is always a left inverse of op x
+      rev_left_loop inv op <-> op, inv obey the inverse loop reverse left
+                              axiom: x op ((inv x) op y) = y, for all x, y.
+         right_loop inv op <-> op, inv obey the inverse loop right axiom:
+                              (x op y) op (inv y) = x for all x, y.
+     rev_right_loop inv op <-> op, inv obey the inverse loop reverse right
+                              axiom: (x op y) op (inv y) = x for all x, y.
+   Note that familiar "cancellation" identities like x + y - y = x or
+ x - y + y = x are respectively instances of right_loop and rev_right_loop
+ The corresponding lemmas will use the K and NK/VK suffixes, respectively.
+
+ - Morphisms for functions and relations:
+    {morph f : x / a >-> r} <-> f is a morphism with respect to functions
+                               (fun x => a) and (fun x => r); if r == R#[#x#]#,
+                               this states that f a = R#[#f x#]# for all x.
+          {morph f : x / a} <-> f is a morphism with respect to the
+                               function expression (fun x => a). This is
+                               shorthand for {morph f : x / a >-> a}; note
+                               that the two instances of a are often
+                               interpreted at different types.
+  {morph f : x y / a >-> r} <-> f is a morphism with respect to functions
+                               (fun x y => a) and (fun x y => r).
+        {morph f : x y / a} <-> f is a morphism with respect to the
+                               function expression (fun x y => a).
+     {homo f : x / a >-> r} <-> f is a homomorphism with respect to the
+                               predicates (fun x => a) and (fun x => r);
+                               if r == R#[#x#]#, this states that a -> R#[#f x#]#
+                               for all x.
+           {homo f : x / a} <-> f is a homomorphism with respect to the
+                               predicate expression (fun x => a).
+   {homo f : x y / a >-> r} <-> f is a homomorphism with respect to the
+                               relations (fun x y => a) and (fun x y => r).
+         {homo f : x y / a} <-> f is a homomorphism with respect to the
+                               relation expression (fun x y => a).
+     {mono f : x / a >-> r} <-> f is monotone with respect to projectors
+                               (fun x => a) and (fun x => r); if r == R#[#x#]#,
+                               this states that R#[#f x#]# = a for all x.
+           {mono f : x / a} <-> f is monotone with respect to the projector
+                               expression (fun x => a).
+   {mono f : x y / a >-> r} <-> f is monotone with respect to relators
+                               (fun x y => a) and (fun x y => r).
+         {mono f : x y / a} <-> f is monotone with respect to the relator
+                               expression (fun x y => a).
+
+ The file also contains some basic lemmas for the above concepts.
+ Lemmas relative to cancellation laws use some abbreviated suffixes:
+   K - a cancellation rule like esymK : cancel (@esym T x y) (@esym T y x).
+  LR - a lemma moving an operation from the left hand side of a relation to
+       the right hand side, like canLR: cancel g f -> x = g y -> f x = y.
+  RL - a lemma moving an operation from the right to the left, e.g., canRL.
+ Beware that the LR and RL orientations refer to an "apply" (back chaining)
+ usage; when using the same lemmas with "have" or "move" (forward chaining)
+ the directions will be reversed!.                                           **)
+
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -219,7 +222,7 @@ Unset Printing Implicit Defensive.
 Delimit Scope fun_scope with FUN.
 Open Scope fun_scope.
 
-(* Notations for argument transpose *)
+(**  Notations for argument transpose  **)
 Notation "f ^~ y" := (fun x => f x y)
   (at level 10, y at level 8, no associativity, format "f ^~  y") : fun_scope.
 Notation "@^~ x" := (fun f => f x)
@@ -228,7 +231,7 @@ Notation "@^~ x" := (fun f => f x)
 Delimit Scope pair_scope with PAIR.
 Open Scope pair_scope.
 
-(* Notations for pair/conjunction projections *)
+(**  Notations for pair/conjunction projections  **)
 Notation "p .1" := (fst p)
   (at level 2, left associativity, format "p .1") : pair_scope.
 Notation "p .2" := (snd p)
@@ -239,8 +242,9 @@ Coercion pair_of_and P Q (PandQ : P /\ Q) := (proj1 PandQ, proj2 PandQ).
 Definition all_pair I T U (w : forall i : I, T i * U i) :=
   (fun i => (w i).1, fun i => (w i).2).
 
-(* Complements on the option type constructor, used below to  *)
-(* encode partial functions.                                  *)
+(**
+ Complements on the option type constructor, used below to
+ encode partial functions.                                   **)
 
 Module Option.
 
@@ -260,7 +264,7 @@ Notation obind := Option.bind.
 Notation omap := Option.map.
 Notation some := (@Some _) (only parsing).
 
-(* Shorthand for some basic equality lemmas. *)
+(**  Shorthand for some basic equality lemmas.  **)
 
 Notation erefl := refl_equal.
 Notation ecast i T e x := (let: erefl in _ = i := e return T in x).
@@ -269,31 +273,32 @@ Definition nesym := sym_not_eq.
 Definition etrans := trans_eq.
 Definition congr1 := f_equal.
 Definition congr2 := f_equal2.
-(* Force at least one implicit when used as a view. *)
+(**  Force at least one implicit when used as a view.  **)
 Prenex Implicits esym nesym.
 
-(* A predicate for singleton types.                                           *)
+(**  A predicate for singleton types.  **)
 Definition all_equal_to T (x0 : T) := forall x, unkeyed x = x0.
 
 Lemma unitE : all_equal_to tt. Proof. by case. Qed.
 
-(* A generic wrapper type *)
+(**  A generic wrapper type  **)
 
 Structure wrapped T := Wrap {unwrap : T}.
 Canonical wrap T x := @Wrap T x.
 
 Prenex Implicits unwrap wrap Wrap.
 
-(* Syntax for defining auxiliary recursive function.          *)
-(*  Usage:                                                    *)
-(* Section FooDefinition.                                     *)
-(* Variables (g1 : T1) (g2 : T2).  (globals)                  *)
-(* Fixoint foo_auxiliary (a3 : T3) ... :=                     *)
-(*        body, using [rec e3, ...] for recursive calls       *)
-(* where "[ 'rec' a3 , a4 , ... ]" := foo_auxiliary.          *)
-(* Definition foo x y .. := [rec e1, ...].                    *)
-(* + proofs about foo                                         *)
-(* End FooDefinition.                                         *)
+(**
+ Syntax for defining auxiliary recursive function.
+  Usage:
+ Section FooDefinition.
+ Variables (g1 : T1) (g2 : T2).  (globals)
+ Fixoint foo_auxiliary (a3 : T3) ... :=
+        body, using #[#rec e3, ... #]# for recursive calls
+ where " #[# 'rec' a3 , a4 , ... #]#" := foo_auxiliary.
+ Definition foo x y .. := #[#rec e1, ... #]#.
+ + proofs about foo
+ End FooDefinition.                                          **)
 
 Reserved Notation "[ 'rec' a0 ]"
   (at level 0, format "[ 'rec'  a0 ]").
@@ -319,14 +324,15 @@ Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 , a6 , a7 , a8 , a9 ]"
   (at level 0,
   format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ,  a6 ,  a7 ,  a8 ,  a9 ]").
 
-(* Definitions and notation for explicit functions with simplification,     *)
-(* i.e., which simpl and /= beta expand (this is complementary to nosimpl). *)
+(**
+ Definitions and notation for explicit functions with simplification,
+ i.e., which simpl and /= beta expand (this is complementary to nosimpl).  **)
 
 Section SimplFun.
 
 Variables aT rT : Type.
 
-CoInductive simpl_fun := SimplFun of aT -> rT.
+Variant simpl_fun := SimplFun of aT -> rT.
 
 Definition fun_of_simpl f := fun x => let: SimplFun lam := f in lam x.
 
@@ -362,11 +368,12 @@ Notation "[ 'fun' ( x : xT ) ( y : yT ) => E ]" :=
     (fun x : xT => [fun y : yT => E])
   (at level 0, x ident, y ident, only parsing) : fun_scope.
 
-(* For delta functions in eqtype.v. *)
+(**  For delta functions in eqtype.v.  **)
 Definition SimplFunDelta aT rT (f : aT -> aT -> rT) := [fun z => f z z].
 
-(* Extensional equality, for unary and binary functions, including syntactic  *)
-(* sugar.                                                                     *)
+(**
+ Extensional equality, for unary and binary functions, including syntactic
+ sugar.                                                                      **)
 
 Section ExtensionalEquality.
 
@@ -439,7 +446,7 @@ Notation "@ 'idfun' T " := (@id_head T explicit_id_key)
 
 Definition phant_id T1 T2 v1 v2 := phantom T1 v1 -> phantom T2 v2.
 
-(* Strong sigma types. *)
+(**  Strong sigma types.  **)
 
 Section Tag.
 
@@ -473,9 +480,9 @@ Lemma all_tag2 I T U V :
   {f : forall i, T i & forall i, U i (f i) & forall i, V i (f i)}.
 Proof. by case/all_tag=> f /all_pair[]; exists f. Qed.
 
-(* Refinement types. *)
+(**  Refinement types.  **)
 
-(* Prenex Implicits and renaming. *)
+(**  Prenex Implicits and renaming.  **)
 Notation sval := (@proj1_sig _ _).
 Notation "@ 'sval'" := (@proj1_sig) (at level 10, format "@ 'sval'").
 
@@ -514,16 +521,16 @@ Section Morphism.
 
 Variables (aT rT sT : Type) (f : aT -> rT).
 
-(* Morphism property for unary and binary functions *)
+(**  Morphism property for unary and binary functions  **)
 Definition morphism_1 aF rF := forall x, f (aF x) = rF (f x).
 Definition morphism_2 aOp rOp := forall x y, f (aOp x y) = rOp (f x) (f y).
 
-(* Homomorphism property for unary and binary relations *)
+(**  Homomorphism property for unary and binary relations  **)
 Definition homomorphism_1 (aP rP : _ -> Prop) := forall x, aP x -> rP (f x).
 Definition homomorphism_2 (aR rR : _ -> _ -> Prop) :=
   forall x y, aR x y -> rR (f x) (f y).
 
-(* Stability property for unary and binary relations *)
+(**  Stability property for unary and binary relations  **)
 Definition monomorphism_1 (aP rP : _ -> sT) := forall x, rP (f x) = aP x.
 Definition monomorphism_2 (aR rR : _ -> _ -> sT) :=
   forall x y, rR (f x) (f y) = aR x y.
@@ -600,16 +607,18 @@ Notation "{ 'mono' f : x y /~ a }" :=
   (at level 0, f at level 99, x ident, y ident,
    format "{ 'mono'  f  :  x  y  /~  a }") : type_scope.
 
-(* In an intuitionistic setting, we have two degrees of injectivity. The     *)
-(* weaker one gives only simplification, and the strong one provides a left  *)
-(* inverse (we show in `fintype' that they coincide for finite types).       *)
-(* We also define an intermediate version where the left inverse is only a   *)
-(* partial function.                                                         *)
+(**
+ In an intuitionistic setting, we have two degrees of injectivity. The
+ weaker one gives only simplification, and the strong one provides a left
+ inverse (we show in `fintype' that they coincide for finite types).
+ We also define an intermediate version where the left inverse is only a
+ partial function.                                                          **)
 
 Section Injections.
 
-(* rT must come first so we can use @ to mitigate the Coq 1st order   *)
-(* unification bug (e..g., Coq can't infer rT from a "cancel" lemma). *)
+(**
+ rT must come first so we can use @ to mitigate the Coq 1st order
+ unification bug (e..g., Coq can't infer rT from a "cancel" lemma).  **)
 Variables (rT aT : Type) (f : aT -> rT).
 
 Definition injective := forall x1 x2, f x1 = f x2 -> x1 = x2.
@@ -639,10 +648,10 @@ End Injections.
 
 Lemma Some_inj {T} : injective (@Some T). Proof. by move=> x y []. Qed.
 
-(* Force implicits to use as a view. *)
+(**  Force implicits to use as a view.  **)
 Prenex Implicits Some_inj.
 
-(* cancellation lemmas for dependent type casts.                             *)
+(**  cancellation lemmas for dependent type casts. **)
 Lemma esymK T x y : cancel (@esym T x y) (@esym T y x).
 Proof. by case: y /. Qed.
 
@@ -684,7 +693,7 @@ Section Bijections.
 
 Variables (A B : Type) (f : B -> A).
 
-CoInductive bijective : Prop := Bijective g of cancel f g & cancel g f.
+Variant bijective : Prop := Bijective g of cancel f g & cancel g f.
 
 Hypothesis bijf : bijective.
 
diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml
index a5765feb..e367cd32 100644
--- a/plugins/ssr/ssrfwd.ml
+++ b/plugins/ssr/ssrfwd.ml
@@ -68,25 +68,18 @@ open Ssripats
 
 let ssrhaveNOtcresolution = Summary.ref ~name:"SSR:havenotcresolution" false
 
-let inHaveTCResolution = Libobject.declare_object {
-  (Libobject.default_object "SSRHAVETCRESOLUTION") with
-  Libobject.cache_function = (fun (_,v) -> ssrhaveNOtcresolution := v);
-  Libobject.load_function = (fun _ (_,v) -> ssrhaveNOtcresolution := v);
-  Libobject.classify_function = (fun v -> Libobject.Keep v);
-}
 let _ =
   Goptions.declare_bool_option
     { Goptions.optname  = "have type classes";
       Goptions.optkey   = ["SsrHave";"NoTCResolution"];
       Goptions.optread  = (fun _ -> !ssrhaveNOtcresolution);
       Goptions.optdepr  = false;
-      Goptions.optwrite = (fun b ->
-        Lib.add_anonymous_leaf (inHaveTCResolution b)) }
+      Goptions.optwrite = (fun b -> ssrhaveNOtcresolution := b);
+    }
 
 
 open Constrexpr 
 open Glob_term 
-open Misctypes
 
 let combineCG t1 t2 f g = match t1, t2 with
  | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
@@ -184,9 +177,7 @@ let havetac ist
      let gs =
        List.map (fun (_,a) ->
          Ssripats.Internal.pf_find_abstract_proof false gl (EConstr.Unsafe.to_constr a.(1))) skols_args in
-     let tacopen_skols gl =
-        let stuff, g = Refiner.unpackage gl in
-        Refiner.repackage stuff (gs @ [g]) in
+     let tacopen_skols gl = re_sig (gs @ [gl.Evd.it]) gl.Evd.sigma in
      let gl, ty = pf_e_type_of gl t in
      gl, ty, Proofview.V82.of_tactic (Tactics.apply t), id,
        Tacticals.tclTHEN (Tacticals.tclTHEN itac_c simpltac)
diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml
index 35036b6c..37dd00a7 100644
--- a/plugins/ssr/ssripats.ml
+++ b/plugins/ssr/ssripats.ml
@@ -12,6 +12,7 @@ open Ssrmatching_plugin
 
 open Util
 open Names
+open Constr
 
 open Proofview
 open Proofview.Notations
@@ -90,11 +91,11 @@ open State
 (** Warning: unlike [nb_deps_assums], it does not perform reduction *)
 let rec nb_assums cur env sigma t =
   match EConstr.kind sigma t with
-  | Term.Prod(name,ty,body) ->
+  | Prod(name,ty,body) ->
      nb_assums (cur+1) env sigma body
-  | Term.LetIn(name,ty,t1,t2) ->
+  | LetIn(name,ty,t1,t2) ->
     nb_assums (cur+1) env sigma t2
-  | Term.Cast(t,_,_) ->
+  | Cast(t,_,_) ->
      nb_assums cur env sigma t
   | _ -> cur
 let nb_assums = nb_assums 0
@@ -118,13 +119,10 @@ let intro_end =
   Ssrcommon.tcl0G (isCLR_CONSUME)
 
 (** [=> _] *****************************************************************)
-let intro_clear ids future_ipats =
+let intro_clear ids =
   Goal.enter begin fun gl ->
     let _, clear_ids, ren =
       List.fold_left (fun (used_ids, clear_ids, ren) id ->
-          if not(Ssrcommon.is_name_in_ipats id future_ipats) then begin
-            used_ids, id :: clear_ids, ren
-          end else
             let new_id = Ssrcommon.mk_anon_id (Id.to_string id) used_ids in
             (new_id :: used_ids, new_id :: clear_ids, (id, new_id) :: ren))
                      (Tacmach.New.pf_ids_of_hyps gl, [], []) ids
@@ -212,22 +210,25 @@ let tclLOG p t =
     tclUNIT ()
   end
 
-let rec ipat_tac1 future_ipats ipat : unit tactic =
+let rec ipat_tac1 ipat : unit tactic =
   match ipat with
-  | IPatView l ->
-      Ssrview.tclIPAT_VIEWS ~views:l
-        ~conclusion:(fun ~to_clear:clr -> intro_clear clr future_ipats)
-  | IPatDispatch ipatss ->
-      tclEXTEND (List.map (ipat_tac future_ipats) ipatss) (tclUNIT ()) []
+  | IPatView (clear_if_id,l) ->
+      Ssrview.tclIPAT_VIEWS ~views:l ~clear_if_id
+        ~conclusion:(fun ~to_clear:clr -> intro_clear clr)
+
+  | IPatDispatch(true,[[]]) ->
+      tclUNIT ()
+  | IPatDispatch(_,ipatss) ->
+      tclDISPATCH (List.map ipat_tac ipatss)
 
   | IPatId id -> Ssrcommon.tclINTRO_ID id
 
   | IPatCase ipatss ->
-     tclIORPAT (Ssrcommon.tclWITHTOP tac_case) future_ipats ipatss
+     tclIORPAT (Ssrcommon.tclWITHTOP tac_case) ipatss
   | IPatInj ipatss ->
      tclIORPAT (Ssrcommon.tclWITHTOP
        (fun t -> V82.tactic  ~nf_evars:false (Ssrelim.perform_injection t)))
-       future_ipats ipatss
+       ipatss
 
   | IPatAnon Drop -> intro_drop
   | IPatAnon One -> Ssrcommon.tclINTRO_ANON
@@ -238,7 +239,7 @@ let rec ipat_tac1 future_ipats ipat : unit tactic =
 
   | IPatClear ids ->
       tacCHECK_HYPS_EXIST ids <*>
-      intro_clear (List.map Ssrcommon.hyp_id ids) future_ipats
+      intro_clear (List.map Ssrcommon.hyp_id ids)
 
   | IPatSimpl (Simpl n) ->
        V82.tactic ~nf_evars:false (Ssrequality.simpltac (Simpl n))
@@ -255,17 +256,17 @@ let rec ipat_tac1 future_ipats ipat : unit tactic =
 
   | IPatTac t -> t
 
-and ipat_tac future_ipats pl : unit tactic =
+and ipat_tac pl : unit tactic =
   match pl with
   | [] -> tclUNIT ()
   | pat :: pl ->
-      Ssrcommon.tcl0G (tclLOG pat (ipat_tac1 (pl @ future_ipats))) <*>
+      Ssrcommon.tcl0G (tclLOG pat ipat_tac1) <*>
       isTICK pat <*>
-      ipat_tac future_ipats pl
+      ipat_tac pl
 
-and tclIORPAT tac future_ipats = function
+and tclIORPAT tac = function
   | [[]] -> tac
-  | p -> Tacticals.New.tclTHENS tac (List.map (ipat_tac future_ipats) p)
+  | p -> Tacticals.New.tclTHENS tac (List.map ipat_tac p)
 
 let split_at_first_case ipats =
   let rec loop acc = function
@@ -276,17 +277,32 @@ let split_at_first_case ipats =
     loop [] ipats
 
 let ssr_exception is_on = function
-  | Some (IPatCase l) when is_on -> Some (IPatDispatch l)
+  | Some (IPatCase l) when is_on -> Some (IPatDispatch(true, l))
   | x -> x
 
 let option_to_list = function None -> [] | Some x -> [x]
 
+(* Simple pass doing {x}/v ->  /v{x} *)
+let elaborate_ipats l =
+  let rec elab = function
+  | [] -> []
+  | (IPatClear _ as p1) :: (IPatView _ as p2) :: rest -> p2 :: p1 :: elab rest
+  | IPatDispatch(s,p) :: rest -> IPatDispatch (s,List.map elab p) :: elab rest
+  | IPatCase p :: rest -> IPatCase (List.map elab p) :: elab rest
+  | IPatInj p :: rest -> IPatInj (List.map elab p) :: elab rest
+  | (IPatTac _ | IPatId _ | IPatSimpl _ | IPatClear _ |
+     IPatAnon _ | IPatView _ | IPatNoop | IPatRewrite _ |
+     IPatAbstractVars _) as x :: rest -> x :: elab rest
+  in
+    elab l
+
 let main ?eqtac ~first_case_is_dispatch ipats =
+  let ipats = elaborate_ipats ipats in
   let ip_before, case, ip_after = split_at_first_case ipats in
   let case = ssr_exception first_case_is_dispatch case in
   let case = option_to_list case in
   let eqtac = option_to_list (Option.map (fun x -> IPatTac x) eqtac) in
-  Ssrcommon.tcl0G (ipat_tac [] (ip_before @ case @ eqtac @ ip_after) <*> intro_end)
+  Ssrcommon.tcl0G (ipat_tac (ip_before @ case @ eqtac @ ip_after) <*> intro_end)
 
 end (* }}} *)
 
@@ -366,8 +382,9 @@ let elim_intro_tac ipats ?ist what eqid ssrelim is_rec clr =
          let ctx, last = EConstr.decompose_prod_assum sigma concl in
          let args = match EConstr.kind_of_type sigma last with
            | Term.AtomicType (hd, args) ->
-               assert(Ssrcommon.is_protect hd env sigma);
-               args
+               if Ssrcommon.is_protect hd env sigma then args
+               else Ssrcommon.errorstrm
+                  (Pp.str "Too many names in intro pattern")
            | _ -> assert false in
          let case = args.(Array.length args-1) in
          if not(EConstr.Vars.closed0 sigma case)
@@ -419,7 +436,7 @@ let tclLAST_GEN ~to_ind ((oclr, occ), t) conclusion = tclINDEPENDENTL begin
   Goal.enter_one begin fun g ->
   let pat = Ssrmatching.interp_cpattern sigma0 t None in
   let cl0, env, sigma, hyps = Goal.(concl g, env g, sigma g, hyps g) in
-  let cl = EConstr.to_constr sigma cl0 in
+  let cl = EConstr.to_constr ~abort_on_undefined_evars:false sigma cl0 in
   let (c, ucst), cl =
     try Ssrmatching.fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
     with Ssrmatching.NoMatch -> Ssrmatching.redex_of_pattern env pat, cl in
@@ -556,7 +573,7 @@ let rec eqmoveipats eqpat = function
 let ssrsmovetac = Goal.enter begin fun g ->
   let sigma, concl = Goal.(sigma g, concl g) in
   match EConstr.kind sigma concl with
-  | Term.Prod _ | Term.LetIn _ -> tclUNIT ()
+  | Prod _ | LetIn _ -> tclUNIT ()
   | _ -> Tactics.hnf_in_concl
 end
 
@@ -575,7 +592,7 @@ let ssrmovetac = function
        (tacVIEW_THEN_GRAB view ~conclusion) <*>
      tclIPAT (IPatClear clr :: ipats)
   | _::_ as view, (_, ({ gens = []; clr }, ipats)) ->
-     tclIPAT (IPatView view :: IPatClear clr :: ipats)
+     tclIPAT (IPatView (false,view) :: IPatClear clr :: ipats)
   | _, (Some pat, (dgens, ipats)) ->
     let dgentac = with_dgens dgens eqmovetac in
     dgentac <*> tclIPAT (eqmoveipats pat ipats)
@@ -594,8 +611,8 @@ let rec is_Evar_or_CastedMeta sigma x =
 
 let occur_existential_or_casted_meta sigma c =
   let rec occrec c = match EConstr.kind sigma c with
-    | Term.Evar _ -> raise Not_found
-    | Term.Cast (m,_,_) when EConstr.isMeta sigma m -> raise Not_found
+    | Evar _ -> raise Not_found
+    | Cast (m,_,_) when EConstr.isMeta sigma m -> raise Not_found
     | _ -> EConstr.iter sigma occrec c
   in
   try occrec c; false
@@ -624,8 +641,8 @@ let tacFIND_ABSTRACT_PROOF check_lock abstract_n =
   Goal.enter_one ~__LOC__ begin fun g ->
     let sigma, env = Goal.(sigma g, env g) in
     let l = Evd.fold_undefined (fun e ei l ->
-      match EConstr.kind sigma (EConstr.of_constr ei.Evd.evar_concl) with
-      | Term.App(hd, [|ty; n; lock|])
+      match EConstr.kind sigma ei.Evd.evar_concl with
+      | App(hd, [|ty; n; lock|])
         when (not check_lock ||
                    (occur_existential_or_casted_meta sigma ty &&
                     is_Evar_or_CastedMeta sigma lock)) &&
@@ -654,8 +671,8 @@ let ssrabstract dgens =
       let sigma, env, concl = Goal.(sigma g, env g, concl g) in
       let t = args_id.(0) in
       match EConstr.kind sigma t with
-      | (Term.Evar _ | Term.Meta _) -> Ssrcommon.tacUNIFY concl t <*> tclUNIT id
-      | Term.Cast(m,_,_)
+      | (Evar _ | Meta _) -> Ssrcommon.tacUNIFY concl t <*> tclUNIT id
+      | Cast(m,_,_)
         when EConstr.isEvar sigma m || EConstr.isMeta sigma m ->
           Ssrcommon.tacUNIFY concl t <*> tclUNIT id
       | _ ->
diff --git a/plugins/ssr/ssrparser.ml4 b/plugins/ssr/ssrparser.ml4
index 5f396744..eb69dca9 100644
--- a/plugins/ssr/ssrparser.ml4
+++ b/plugins/ssr/ssrparser.ml4
@@ -10,6 +10,7 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
+let _vmcast = Constr.VMcast
 open Names
 open Pp
 open Pcoq
@@ -17,18 +18,19 @@ open Ltac_plugin
 open Genarg
 open Stdarg
 open Tacarg
-open Term
 open Libnames
 open Tactics
 open Tacmach
 open Util
+open Locus
 open Tacexpr
 open Tacinterp
 open Pltac
 open Extraargs
 open Ppconstr
 
-open Misctypes
+open Namegen
+open Tactypes
 open Decl_kinds
 open Constrexpr
 open Constrexpr_ops
@@ -64,7 +66,7 @@ DECLARE PLUGIN "ssreflect_plugin"
  * we thus save the lexer to restore it at the end of the file *)
 let frozen_lexer = CLexer.get_keyword_state () ;;
 
-let tacltop = (5,Notation_term.E)
+let tacltop = (5,Notation_gram.E)
 
 let pr_ssrtacarg _ _ prt = prt tacltop
 ARGUMENT EXTEND ssrtacarg TYPED AS tactic PRINTED BY pr_ssrtacarg
@@ -301,24 +303,24 @@ END
 
 
 let pr_index = function
-  | Misctypes.ArgVar {CAst.v=id} -> pr_id id
-  | Misctypes.ArgArg n when n > 0 -> int n
+  | ArgVar {CAst.v=id} -> pr_id id
+  | ArgArg n when n > 0 -> int n
   | _ -> mt ()
 let pr_ssrindex _ _ _ = pr_index
 
-let noindex = Misctypes.ArgArg 0
+let noindex = ArgArg 0
 
 let check_index ?loc i =
   if i > 0 then i else CErrors.user_err ?loc (str"Index not positive")
 let mk_index ?loc = function
-  | Misctypes.ArgArg i -> Misctypes.ArgArg (check_index ?loc i)
+  | ArgArg i -> ArgArg (check_index ?loc i)
   | iv -> iv
 
 let interp_index ist gl idx =
   Tacmach.project gl,
   match idx with
-  | Misctypes.ArgArg _ -> idx
-  | Misctypes.ArgVar id ->
+  | ArgArg _ -> idx
+  | ArgVar id ->
     let i =
       try
         let v = Id.Map.find id.CAst.v ist.Tacinterp.lfun in
@@ -336,7 +338,7 @@ let interp_index ist gl idx =
         | None -> raise Not_found
         end end
     with _ -> CErrors.user_err ?loc:id.CAst.loc (str"Index not a number") in
-    Misctypes.ArgArg (check_index ?loc:id.CAst.loc i)
+    ArgArg (check_index ?loc:id.CAst.loc i)
 
 open Pltac
 
@@ -410,8 +412,8 @@ let pr_docc = function
 let pr_ssrdocc _ _ _ = pr_docc
 
 ARGUMENT EXTEND ssrdocc TYPED AS ssrclear option * ssrocc PRINTED BY pr_ssrdocc
-| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
 | [ "{" ssrocc(occ) "}" ] -> [ mkocc occ ]
+| [ "{" ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
 END
 
 (* Old kinds of terms *)
@@ -543,7 +545,7 @@ END
 
 let remove_loc x = x.CAst.v
 
-let ipat_of_intro_pattern p = Misctypes.(
+let ipat_of_intro_pattern p = Tactypes.(
   let rec ipat_of_intro_pattern = function
     | IntroNaming (IntroIdentifier id) -> IPatId id
     | IntroAction IntroWildcard -> IPatAnon Drop
@@ -574,9 +576,9 @@ let rec map_ipat map_id map_ssrhyp map_ast_closure_term = function
   | IPatAbstractVars l -> IPatAbstractVars (List.map map_id l)
   | IPatClear clr -> IPatClear (List.map map_ssrhyp clr)
   | IPatCase iorpat -> IPatCase (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
-  | IPatDispatch iorpat -> IPatDispatch (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
+  | IPatDispatch (s,iorpat) -> IPatDispatch (s,List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
   | IPatInj iorpat -> IPatInj (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
-  | IPatView v -> IPatView (List.map map_ast_closure_term v)
+  | IPatView (clr,v) -> IPatView (clr,List.map map_ast_closure_term v)
   | IPatTac _ -> assert false (*internal usage only *)
 
 let wit_ssripatrep = add_genarg "ssripatrep" pr_ipat
@@ -595,16 +597,15 @@ let intern_ipats ist = List.map (intern_ipat ist)
 
 let interp_intro_pattern = interp_wit wit_intro_pattern
 
-let interp_introid ist gl id = Misctypes.(
+let interp_introid ist gl id =
  try IntroNaming (IntroIdentifier (hyp_id (snd (interp_hyp ist gl (SsrHyp (Loc.tag id))))))
  with _ -> (snd (interp_intro_pattern ist gl (CAst.make @@ IntroNaming (IntroIdentifier id)))).CAst.v
-)
 
 let get_intro_id = function
   | IntroNaming (IntroIdentifier id) -> id
   | _ -> assert false
 
-let rec add_intro_pattern_hyps ipat hyps = Misctypes.(
+let rec add_intro_pattern_hyps ipat hyps =
   let {CAst.loc=loc;v=ipat} = ipat in
   match ipat with
   | IntroNaming (IntroIdentifier id) ->
@@ -623,7 +624,6 @@ let rec add_intro_pattern_hyps ipat hyps = Misctypes.(
   | IntroForthcoming _ -> 
     (* As in ipat_of_intro_pattern, was unable to determine which kind
       of ipat interp_introid could return [HH] *) assert false
-)
 
 (* We interp the ipat using the standard ltac machinery for ids, since
  * we have no clue what a name could be bound to (maybe another ipat) *)
@@ -641,12 +641,12 @@ let interp_ipat ist gl =
     check_hyps_uniq [] clr'; IPatClear clr'
   | IPatCase(iorpat) ->
       IPatCase(List.map (List.map interp) iorpat)
-  | IPatDispatch(iorpat) ->
-      IPatDispatch(List.map (List.map interp) iorpat)
+  | IPatDispatch(s,iorpat) ->
+      IPatDispatch(s,List.map (List.map interp) iorpat)
   | IPatInj iorpat -> IPatInj (List.map (List.map interp) iorpat)
   | IPatAbstractVars l ->
      IPatAbstractVars (List.map get_intro_id (List.map (interp_introid ist gl) l))
-  | IPatView l -> IPatView (List.map (fun x -> snd(interp_ast_closure_term ist
+  | IPatView (clr,l) -> IPatView (clr,List.map (fun x -> snd(interp_ast_closure_term ist
      gl x)) l)
   | (IPatSimpl _ | IPatAnon _ | IPatRewrite _ | IPatNoop) as x -> x
   | IPatTac _ -> assert false (*internal usage only *)
@@ -683,11 +683,17 @@ ARGUMENT EXTEND ssripat TYPED AS ssripatrep list PRINTED BY pr_ssripats
 (* TODO  | [ "+" ] -> [ [IPatAnon Temporary] ] *)
   | [ ssrsimpl_ne(sim) ] -> [ [IPatSimpl sim] ]
   | [ ssrdocc(occ) "->" ] -> [ match occ with
+      | Some [], _ -> CErrors.user_err ~loc (str"occ_switch expected")
       | None, occ -> [IPatRewrite (occ, L2R)]
       | Some clr, _ -> [IPatClear clr; IPatRewrite (allocc, L2R)]]
   | [ ssrdocc(occ) "<-" ] -> [ match occ with
+      | Some [], _ -> CErrors.user_err ~loc (str"occ_switch expected")
       | None, occ ->  [IPatRewrite (occ, R2L)]
       | Some clr, _ -> [IPatClear clr; IPatRewrite (allocc, R2L)]]
+  | [ ssrdocc(occ) ssrfwdview(v) ] -> [ match occ with
+      | Some [], _ -> [IPatView (true,v)]
+      | Some cl, _ -> check_hyps_uniq [] cl; [IPatClear cl;IPatView (false,v)]
+      | _ -> CErrors.user_err ~loc (str"Only identifiers are allowed here") ]
   | [ ssrdocc(occ) ] -> [ match occ with
       | Some cl, _ -> check_hyps_uniq [] cl; [IPatClear cl]
       | _ -> CErrors.user_err ~loc (str"Only identifiers are allowed here")]
@@ -705,7 +711,7 @@ ARGUMENT EXTEND ssripat TYPED AS ssripatrep list PRINTED BY pr_ssripats
   | [ "-/" integer(n) "/=" ] -> [ [IPatNoop;IPatSimpl(SimplCut (n,~-1))] ]
   | [ "-/" integer(n) "/" integer (m) "=" ] ->
       [ [IPatNoop;IPatSimpl(SimplCut(n,m))] ]
-  | [ ssrfwdview(v) ] -> [ [IPatView v] ]
+  | [ ssrfwdview(v) ] -> [ [IPatView (false,v)] ]
   | [ "[" ":" ident_list(idl) "]" ] -> [ [IPatAbstractVars idl] ]
   | [ "[:" ident_list(idl) "]" ] -> [ [IPatAbstractVars idl] ]
 END
@@ -956,6 +962,7 @@ END
 (* the default simpl and unfold tactics would erase blindly.               *)
 
 open Ssrmatching_plugin.Ssrmatching
+open Ssrmatching_plugin.G_ssrmatching
 
 let pr_wgen = function 
   | (clr, Some((id,k),None)) -> spc() ++ pr_clear mt clr ++ str k ++ pr_hoi id
@@ -1064,7 +1071,7 @@ let rec format_constr_expr h0 c0 = let open CAst in match h0, c0 with
   | BFdef :: h, { v = CLetIn({CAst.v=x}, v, oty, c) } ->
     let bs, c' = format_constr_expr h c in
     Bdef (x, oty, v) :: bs, c'
-  | [BFcast], { v = CCast (c, CastConv t) } ->
+  | [BFcast], { v = CCast (c, Glob_term.CastConv t) } ->
     [Bcast t], c
   | BFrec (has_str, has_cast) :: h, 
     { v = CFix ( _, [_, (Some locn, CStructRec), bl, t, c]) } ->
@@ -1093,7 +1100,7 @@ let wit_ssrfwdfmt = add_genarg "ssrfwdfmt" pr_fwdfmt
 
 let mkFwdVal fk c = ((fk, []), c)
 let mkssrFwdVal fk c = ((fk, []), (c,None))
-let dC t = CastConv t
+let dC t = Glob_term.CastConv t
 
 let same_ist { interp_env = x } { interp_env = y } =
   match x,y with
@@ -1154,7 +1161,8 @@ ARGUMENT EXTEND ssrbvar TYPED AS constr PRINTED BY pr_ssrbvar
 END
 
 let bvar_lname = let open CAst in function
-  | { v = CRef ({loc;v=Ident id}, _) } -> CAst.make ?loc @@ Name id
+  | { v = CRef (qid, _) } when qualid_is_ident qid ->
+    CAst.make ?loc:qid.CAst.loc @@ Name (qualid_basename qid)
   | { loc = loc } -> CAst.make ?loc Anonymous
 
 let pr_ssrbinder prc _ _ (_, c) = prc c
@@ -1210,8 +1218,8 @@ let push_binders c2 bs =
   | [] -> c
   | _ -> anomaly "binder not a lambda nor a let in" in
   match c2 with
-  | { loc; v = CCast (ct, CastConv cty) } ->
-      CAst.make ?loc @@ (CCast (loop false ct bs, CastConv (loop true cty bs)))
+  | { loc; v = CCast (ct, Glob_term.CastConv cty) } ->
+      CAst.make ?loc @@ (CCast (loop false ct bs, Glob_term.CastConv (loop true cty bs)))
   | ct -> loop false ct bs
 
 let rec fix_binders = let open CAst in function
@@ -1246,7 +1254,8 @@ END
 let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd
 
 let bvar_locid = function
-  | { CAst.v = CRef ({CAst.loc=loc;v=Ident id}, _) } -> CAst.make ?loc id
+  | { CAst.v = CRef (qid, _) } when qualid_is_ident qid ->
+    CAst.make ?loc:qid.CAst.loc (qualid_basename qid)
   | _ -> CErrors.user_err (Pp.str "Missing identifier after \"(co)fix\"")
 
 
@@ -1399,7 +1408,7 @@ let check_seqtacarg dir arg = match snd arg, dir with
     CErrors.user_err ?loc (str "expected \"first\"")
   | _, _ -> arg
 
-let ssrorelse = Gram.entry_create "ssrorelse"
+let ssrorelse = Entry.create "ssrorelse"
 GEXTEND Gram
   GLOBAL: ssrorelse ssrseqarg;
   ssrseqidx: [
@@ -1676,7 +1685,10 @@ let pr_gen (docc, dt) = pr_docc docc ++ pr_cpattern dt
 let pr_ssrgen _ _ _ = pr_gen
 
 ARGUMENT EXTEND ssrgen TYPED AS ssrdocc * cpattern PRINTED BY pr_ssrgen
-| [ ssrdocc(docc) cpattern(dt) ] -> [ docc, dt ]
+| [ ssrdocc(docc) cpattern(dt) ] -> [
+     match docc with
+     | Some [], _ -> CErrors.user_err ~loc (str"Clear flag {} not allowed here")
+     | _ -> docc, dt ]
 | [ cpattern(dt) ] -> [ nodocc, dt ]
 END
 
@@ -1938,7 +1950,7 @@ END
 
 let vmexacttac pf =
   Goal.nf_enter begin fun gl ->
-  exact_no_check (EConstr.mkCast (pf, VMcast, Tacmach.New.pf_concl gl))
+  exact_no_check (EConstr.mkCast (pf, _vmcast, Tacmach.New.pf_concl gl))
   end
 
 TACTIC EXTEND ssrexact
diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli
index 2ac7c7e2..862a9376 100644
--- a/plugins/ssr/ssrparser.mli
+++ b/plugins/ssr/ssrparser.mli
@@ -12,13 +12,13 @@
 
 open Ltac_plugin
 
-val ssrtacarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry
+val ssrtacarg : Tacexpr.raw_tactic_expr Pcoq.Entry.t
 val wit_ssrtacarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
-val pr_ssrtacarg : 'a -> 'b -> (Notation_term.tolerability -> 'c) -> 'c
+val pr_ssrtacarg : 'a -> 'b -> (Notation_gram.tolerability -> 'c) -> 'c
 
-val ssrtclarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry
+val ssrtclarg : Tacexpr.raw_tactic_expr Pcoq.Entry.t
 val wit_ssrtclarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
-val pr_ssrtclarg : 'a -> 'b -> (Notation_term.tolerability -> 'c -> 'd) -> 'c -> 'd
+val pr_ssrtclarg : 'a -> 'b -> (Notation_gram.tolerability -> 'c -> 'd) -> 'c -> 'd
 
 val add_genarg : string -> ('a -> Pp.t) -> 'a Genarg.uniform_genarg_type
 
diff --git a/plugins/ssr/ssrprinters.ml b/plugins/ssr/ssrprinters.ml
index 11369228..824666ba 100644
--- a/plugins/ssr/ssrprinters.ml
+++ b/plugins/ssr/ssrprinters.ml
@@ -101,13 +101,14 @@ let rec pr_ipat p =
   | IPatSimpl sim -> pr_simpl sim
   | IPatClear clr -> pr_clear mt clr
   | IPatCase iorpat -> hov 1 (str "[" ++ pr_iorpat iorpat ++ str "]")
-  | IPatDispatch iorpat -> hov 1 (str "/[" ++ pr_iorpat iorpat ++ str "]")
+  | IPatDispatch(_,iorpat) -> hov 1 (str "/[" ++ pr_iorpat iorpat ++ str "]")
   | IPatInj iorpat -> hov 1 (str "[=" ++ pr_iorpat iorpat ++ str "]")
   | IPatRewrite (occ, dir) -> pr_occ occ ++ pr_dir dir
   | IPatAnon All -> str "*"
   | IPatAnon Drop -> str "_"
   | IPatAnon One -> str "?"
-  | IPatView v -> pr_view2 v
+  | IPatView (false,v) -> pr_view2 v
+  | IPatView (true,v) -> str"{}" ++ pr_view2 v
   | IPatNoop -> str "-"
   | IPatAbstractVars l -> str "[:" ++ pr_list spc Id.print l ++ str "]"
   | IPatTac _ -> str "<tac>"
diff --git a/plugins/ssr/ssrtacticals.ml b/plugins/ssr/ssrtacticals.ml
index 9cc4f5ce..83581f34 100644
--- a/plugins/ssr/ssrtacticals.ml
+++ b/plugins/ssr/ssrtacticals.ml
@@ -11,9 +11,9 @@
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
 open Names
+open Constr
 open Termops
 open Tacmach
-open Misctypes
 open Locusops
 
 open Ssrast
@@ -24,7 +24,7 @@ module NamedDecl = Context.Named.Declaration
 
 (** Tacticals (+, -, *, done, by, do, =>, first, and last). *)
 
-let get_index = function ArgArg i -> i | _ ->
+let get_index = function Locus.ArgArg i -> i | _ ->
   anomaly "Uninterpreted index"
 (* Toplevel constr must be globalized twice ! *)
 
@@ -32,9 +32,8 @@ let get_index = function ArgArg i -> i | _ ->
 
 let tclPERM perm tac gls =
   let subgls = tac gls in
-  let sigma, subgll = Refiner.unpackage subgls in
-  let subgll' = perm subgll in
-  Refiner.repackage sigma subgll'
+  let subgll' = perm subgls.Evd.it in
+  re_sig subgll' subgls.Evd.sigma
 
 let rot_hyps dir i hyps =
   let n = List.length hyps in
@@ -104,10 +103,10 @@ let endclausestac id_map clseq gl_id cl0 gl =
   | ids, dc' ->
     forced && ids = [] && (not hide_goal || dc' = [] && c_hidden) in
   let rec unmark c = match EConstr.kind (project gl) c with
-  | Term.Var id when hidden_clseq clseq && id = gl_id -> cl0
-  | Term.Prod (Name id, t, c') when List.mem_assoc id id_map ->
+  | Var id when hidden_clseq clseq && id = gl_id -> cl0
+  | Prod (Name id, t, c') when List.mem_assoc id id_map ->
     EConstr.mkProd (Name (orig_id id), unmark t, unmark c')
-  | Term.LetIn (Name id, v, t, c') when List.mem_assoc id id_map ->
+  | LetIn (Name id, v, t, c') when List.mem_assoc id id_map ->
     EConstr.mkLetIn (Name (orig_id id), unmark v, unmark t, unmark c')
   | _ -> EConstr.map (project gl) unmark c in
   let utac hyp =
diff --git a/plugins/ssr/ssrtacticals.mli b/plugins/ssr/ssrtacticals.mli
index a5636ad0..684e0023 100644
--- a/plugins/ssr/ssrtacticals.mli
+++ b/plugins/ssr/ssrtacticals.mli
@@ -17,7 +17,7 @@ val tclSEQAT :
   Tacinterp.interp_sign ->
   Tacinterp.Value.t ->
   Ssrast.ssrdir ->
-  int Misctypes.or_var *
+  int Locus.or_var *
     (('a * Tacinterp.Value.t option list) *
        Tacinterp.Value.t option) ->
   Tacmach.tactic
@@ -37,7 +37,7 @@ val hinttac :
 
 val ssrdotac :
   Tacinterp.interp_sign ->
-  ((int Misctypes.or_var * Ssrast.ssrmmod) *
+  ((int Locus.or_var * Ssrast.ssrmmod) *
      (bool * Tacinterp.Value.t option list)) *
     ((Ssrast.ssrhyps *
         ((Ssrast.ssrhyp_or_id * string) *
diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4
index 05dbf0a8..989a6c5b 100644
--- a/plugins/ssr/ssrvernac.ml4
+++ b/plugins/ssr/ssrvernac.ml4
@@ -19,17 +19,14 @@ open Constrexpr_ops
 open Pcoq
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Vernac_
+open Pvernac.Vernac_
 open Ltac_plugin
 open Notation_ops
 open Notation_term
 open Glob_term
-open Globnames
 open Stdarg
 open Genarg
-open Misctypes
 open Decl_kinds
-open Libnames
 open Pp
 open Ppconstr
 open Printer
@@ -144,21 +141,21 @@ END
 let declare_one_prenex_implicit locality f =
   let fref =
     try Smartlocate.global_with_alias f 
-    with _ -> errorstrm (pr_reference f ++ str " is not declared") in
+    with _ -> errorstrm (pr_qualid f ++ str " is not declared") in
   let rec loop = function
   | a :: args' when Impargs.is_status_implicit a ->
     (ExplByName (Impargs.name_of_implicit a), (true, true, true)) :: loop args'
   | args' when List.exists Impargs.is_status_implicit args' ->
-      errorstrm (str "Expected prenex implicits for " ++ pr_reference f)
+      errorstrm (str "Expected prenex implicits for " ++ pr_qualid f)
   | _ -> [] in
   let impls =
     match Impargs.implicits_of_global fref  with
     | [cond,impls] -> impls
-    | [] -> errorstrm (str "Expected some implicits for " ++ pr_reference f)
+    | [] -> errorstrm (str "Expected some implicits for " ++ pr_qualid f)
     | _ -> errorstrm (str "Multiple implicits not supported") in
   match loop impls  with
   | [] ->
-    errorstrm (str "Expected some implicits for " ++ pr_reference f)
+    errorstrm (str "Expected some implicits for " ++ pr_qualid f)
   | impls ->
     Impargs.declare_manual_implicits locality fref ~enriching:false [impls]
 
@@ -220,8 +217,8 @@ let interp_search_notation ?loc tag okey =
          (Bytes.set s' i' '_'; loop (j + 1) (i' + 2))
       else (String.blit s i s' i' m; loop (j + 1) (i' + m + 1)) in
     loop 0 1 in
-  let trim_ntn (pntn, m) = Bytes.sub_string pntn 1 (max 0 m) in
-  let pr_ntn ntn = str "(" ++ str ntn ++ str ")" in
+  let trim_ntn (pntn, m) = (InConstrEntrySomeLevel,Bytes.sub_string pntn 1 (max 0 m)) in
+  let pr_ntn ntn = str "(" ++ Notation.pr_notation ntn ++ str ")" in
   let pr_and_list pr = function
     | [x] -> pr x
     | x :: lx -> pr_list pr_comma pr lx ++ pr_comma () ++ str "and " ++ pr x
@@ -296,7 +293,7 @@ let interp_search_notation ?loc tag okey =
     let scs' = List.remove (=) sc !scs in
     let w = pr_ntn ntn ++ str " is also defined " ++ pr_scs scs' in
     Feedback.msg_warning (hov 4 w)
-  else if String.string_contains ~where:ntn ~what:" .. " then
+  else if String.string_contains ~where:(snd ntn) ~what:" .. " then
     err (pr_ntn ntn ++ str " is an n-ary notation");
   let nvars = List.filter (fun (_,(_,typ)) -> typ = NtnTypeConstr) nvars in
   let rec sub () = function
@@ -361,13 +358,12 @@ let coerce_search_pattern_to_sort hpat =
       true, cp
     with _ -> false, [] in
   let coerce hp coe_index =
-    let coe = Classops.get_coercion_value coe_index in
+    let coe_ref = coe_index.Classops.coe_value in
     try
-      let coe_ref = global_of_constr coe in
       let n_imps = Option.get (Classops.hide_coercion coe_ref) in
       mkPApp (Pattern.PRef coe_ref) n_imps [|hp|]
-    with _ ->
-    errorstrm (str "need explicit coercion " ++ pr_constr_env env sigma coe ++ spc ()
+    with Not_found | Option.IsNone ->
+    errorstrm (str "need explicit coercion " ++ pr_global coe_ref ++ spc ()
             ++ str "to interpret head search pattern as type") in
   filter_head, List.fold_left coerce hpat' coe_path
 
@@ -377,7 +373,10 @@ let interp_head_pat hpat =
   | Cast (c', _, _) -> loop c'
   | Prod (_, _, c') -> loop c'
   | LetIn (_, _, _, c') -> loop c'
-  | _ -> Constr_matching.is_matching (Global.env()) Evd.empty p (EConstr.of_constr c) in
+  | _ ->
+    let env = Global.env () in
+    let sigma = Evd.from_env env in
+    Constr_matching.is_matching env sigma p (EConstr.of_constr c) in
   filter_head, loop
 
 let all_true _ = true
@@ -413,7 +412,7 @@ let interp_search_arg arg =
 
 (* Module path postfilter *)
 
-let pr_modloc (b, m) = if b then str "-" ++ pr_reference m else pr_reference m
+let pr_modloc (b, m) = if b then str "-" ++ pr_qualid m else pr_qualid m
 
 let wit_ssrmodloc = add_genarg "ssrmodloc" pr_modloc
 
@@ -431,10 +430,9 @@ GEXTEND Gram
 END
 
 let interp_modloc mr =
-  let interp_mod (_, mr) =
-    let {CAst.loc=loc; v=qid} = qualid_of_reference mr in
+  let interp_mod (_, qid) =
     try Nametab.full_name_module qid with Not_found ->
-    CErrors.user_err ?loc (str "No Module " ++ pr_qualid qid) in
+    CErrors.user_err ?loc:qid.CAst.loc (str "No Module " ++ pr_qualid qid) in
   let mr_out, mr_in = List.partition fst mr in
   let interp_bmod b = function
   | [] -> fun _ _ _ -> true
diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
index aa614fbc..3f974ea0 100644
--- a/plugins/ssr/ssrview.ml
+++ b/plugins/ssr/ssrview.ml
@@ -67,9 +67,9 @@ end
 module State : sig
 
   (* View storage API *)
-  val vsINIT    : EConstr.t -> unit tactic
-  val vsPUSH    : (EConstr.t -> EConstr.t tactic) -> unit tactic
-  val vsCONSUME : (Id.t option -> EConstr.t -> unit tactic) -> unit tactic
+  val vsINIT    : EConstr.t * Id.t list -> unit tactic
+  val vsPUSH    : (EConstr.t -> (EConstr.t * Id.t list) tactic) -> unit tactic
+  val vsCONSUME : (name:Id.t option -> EConstr.t -> to_clear:Id.t list -> unit tactic) -> unit tactic
   val vsASSERT_EMPTY : unit tactic
 
 end = struct (* {{{ *)
@@ -78,6 +78,7 @@ type vstate = {
   subject_name : Id.t option;   (* top *)
     (* None if views are being applied to a term *)
   view : EConstr.t;  (* v2 (v1 top) *)
+  to_clear : Id.t list;
 }
 
 include Ssrcommon.MakeState(struct
@@ -85,13 +86,14 @@ include Ssrcommon.MakeState(struct
   let init = None
 end)
 
-let vsINIT view = tclSET (Some { subject_name = None; view })
+let vsINIT (view, to_clear) =
+  tclSET (Some { subject_name = None; view; to_clear })
 
 let vsPUSH k =
   tacUPDATE (fun s -> match s with
-  | Some { subject_name; view } ->
-      k view >>= fun view ->
-      tclUNIT (Some { subject_name; view })
+  | Some { subject_name; view; to_clear } ->
+      k view >>= fun (view, clr) ->
+      tclUNIT (Some { subject_name; view; to_clear = to_clear @ clr })
   | None ->
       Goal.enter_one ~__LOC__ begin fun gl ->
         let concl = Goal.concl gl in
@@ -102,15 +104,15 @@ let vsPUSH k =
           | _ -> mk_anon_id "view_subject" (Tacmach.New.pf_ids_of_hyps gl) in
         let view = EConstr.mkVar id in
         Ssrcommon.tclINTRO_ID id <*>
-        k view >>= fun view ->
-        tclUNIT (Some { subject_name = Some id; view })
+        k view >>= fun (view, to_clear) ->
+        tclUNIT (Some { subject_name = Some id; view; to_clear })
       end)
 
 let vsCONSUME k =
   tclGET (fun s -> match s with
-  | Some { subject_name; view } ->
+  | Some { subject_name; view; to_clear } ->
         tclSET None <*>
-        k subject_name view
+        k ~name:subject_name view ~to_clear
   | None -> anomaly "vsCONSUME: empty storage")
 
 let vsASSERT_EMPTY =
@@ -157,7 +159,7 @@ let tclINJ_CONSTR_IST ist p =
 
 let mkGHole =
   DAst.make
-    (Glob_term.GHole(Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None))
+    (Glob_term.GHole(Evar_kinds.InternalHole, Namegen.IntroAnonymous, None))
 let rec mkGHoles n = if n > 0 then mkGHole :: mkGHoles (n - 1) else []
 let mkGApp f args =
   if args = [] then f
@@ -187,6 +189,16 @@ end
  * modular, see the 2 functions below that would need to "uncommit" *)
 let tclKeepOpenConstr (_env, sigma, t) = Unsafe.tclEVARS sigma <*> tclUNIT t
 
+let tclADD_CLEAR_IF_ID (env, ist, t) x =
+  Ssrprinters.ppdebug (lazy
+    Pp.(str"tclADD_CLEAR_IF_ID: " ++ Printer.pr_econstr_env env ist t));
+  let hd, _ = EConstr.decompose_app ist t in
+  match EConstr.kind ist hd with
+  | Constr.Var id when Ssrcommon.not_section_id id -> tclUNIT (x, [id])
+  | _ -> tclUNIT (x,[])
+
+let tclPAIR p x = tclUNIT (x, p)
+
 (* The ssr heuristic : *)
 (* Estimate a bound on the number of arguments of a raw constr. *)
 (* This is not perfect, because the unifier may fail to         *)
@@ -203,14 +215,15 @@ let guess_max_implicits ist glob =
   (fun _ -> tclUNIT 5)
 
 let pad_to_inductive ist glob = Goal.enter_one ~__LOC__ begin fun goal ->
-  interp_glob ist glob >>= fun (env, sigma, term) ->
+  interp_glob ist glob >>= fun (env, sigma, term as ot) ->
   let term_ty = Retyping.get_type_of env sigma term in
   let ctx, i = Reductionops.splay_prod env sigma term_ty in
   let rel_ctx =
     List.map (fun (a,b) -> Context.Rel.Declaration.LocalAssum(a,b)) ctx in
-  if Ssrcommon.isAppInd (EConstr.push_rel_context rel_ctx env) sigma i
-  then tclUNIT (mkGApp glob (mkGHoles (List.length ctx)))
-  else Tacticals.New.tclZEROMSG Pp.(str"not an inductive")
+  if not (Ssrcommon.isAppInd (EConstr.push_rel_context rel_ctx env) sigma i)
+  then Tacticals.New.tclZEROMSG Pp.(str"not an inductive")
+  else tclUNIT (mkGApp glob (mkGHoles (List.length ctx)))
+       >>= tclADD_CLEAR_IF_ID ot
 end
 
 (* There are two ways of "applying" a view to term:            *)
@@ -221,7 +234,7 @@ end
 (* They require guessing the view hints and the number of      *)
 (* implicits, respectively, which we do by brute force.        *)
 (* Builds v p *)
-let interp_view ist v p =
+let interp_view ~clear_if_id ist v p =
   let is_specialize hd =
     match DAst.get hd with Glob_term.GHole _ -> true | _ -> false in
   (* We cast the pile of views p into a term p_id *)
@@ -230,42 +243,48 @@ let interp_view ist v p =
   match DAst.get v with
   | Glob_term.GApp (hd, rargs) when is_specialize hd ->
      Ssrprinters.ppdebug (lazy Pp.(str "specialize"));
-     interp_glob ist (mkGApp p_id rargs) >>= tclKeepOpenConstr
+     interp_glob ist (mkGApp p_id rargs)
+     >>= tclKeepOpenConstr >>= tclPAIR []
   | _ ->
      Ssrprinters.ppdebug (lazy Pp.(str "view"));
      (* We find out how to build (v p) eventually using an adaptor *)
      let adaptors = AdaptorDb.(get Forward) in
      Proofview.tclORELSE
-       (pad_to_inductive ist v >>= fun vpad ->
+       (pad_to_inductive ist v >>= fun (vpad,clr) ->
         Ssrcommon.tclFIRSTa (List.map
-          (fun a -> interp_glob ist (mkGApp a [vpad; p_id])) adaptors))
+          (fun a -> interp_glob ist (mkGApp a [vpad; p_id])) adaptors)
+        >>= tclPAIR clr)
        (fun _ ->
         guess_max_implicits ist v >>= fun n ->
         Ssrcommon.tclFIRSTi (fun n ->
-           interp_glob ist (mkGApp v (mkGHoles n @ [p_id]))) n)
-     >>= tclKeepOpenConstr
+           interp_glob ist (mkGApp v (mkGHoles n @ [p_id]))) n
+        >>= fun x -> tclADD_CLEAR_IF_ID x x)
+     >>= fun (ot,clr) ->
+       if clear_if_id
+       then tclKeepOpenConstr ot >>= tclPAIR clr
+       else tclKeepOpenConstr ot >>= tclPAIR []
 
 (* we store in the state (v top), then (v1 (v2 top))... *)
-let pile_up_view (ist, v) =
+let pile_up_view ~clear_if_id (ist, v) =
   let ist = Ssrcommon.option_assert_get ist (Pp.str"not a term") in
-  State.vsPUSH (fun p -> interp_view ist v p)
+  State.vsPUSH (fun p -> interp_view ~clear_if_id ist v p)
 
 let finalize_view s0 ?(simple_types=true) p =
 Goal.enter_one ~__LOC__ begin fun g ->
   let env = Goal.env g in
   let sigma = Goal.sigma g in
-  let evars_of_p = Evd.evars_of_term (EConstr.to_constr sigma p) in
+  let evars_of_p = Evd.evars_of_term (EConstr.to_constr ~abort_on_undefined_evars:false sigma p) in
   let filter x _ = Evar.Set.mem x evars_of_p in
   let sigma = Typeclasses.resolve_typeclasses ~fail:false ~filter env sigma in
   let p = Reductionops.nf_evar sigma p in
   let get_body = function Evd.Evar_defined x -> x | _ -> assert false in
   let evars_of_econstr sigma t =
-    Evd.evars_of_term (EConstr.to_constr sigma (EConstr.of_constr t)) in
+    Evarutil.undefined_evars_of_term sigma (EConstr.of_constr t) in
   let rigid_of s =
     List.fold_left (fun l k ->
       if Evd.is_defined sigma k then
         let bo = get_body Evd.(evar_body (find sigma k)) in
-          k :: l @ Evar.Set.elements (evars_of_econstr sigma bo)
+          k :: l @ Evar.Set.elements (evars_of_econstr sigma (EConstr.Unsafe.to_constr bo))
       else l
     ) [] s in
   let und0 = (* Unassigned evars in the initial goal *)
@@ -292,7 +311,7 @@ let pose_proof subject_name p =
   <*>
   Tactics.New.reduce_after_refine
 
-let rec apply_all_views ending vs s0 =
+let rec apply_all_views ~clear_if_id ending vs s0 =
   match vs with
   | [] -> ending s0
   | v :: vs ->
@@ -301,31 +320,35 @@ let rec apply_all_views ending vs s0 =
       | `Tac tac ->
            Ssrprinters.ppdebug (lazy Pp.(str"..a tactic"));
            ending s0 <*> Tacinterp.eval_tactic tac <*>
-           Ssrcommon.tacSIGMA >>= apply_all_views ending vs
+           Ssrcommon.tacSIGMA >>= apply_all_views ~clear_if_id ending vs
       | `Term v ->
            Ssrprinters.ppdebug (lazy Pp.(str"..a term"));
-           pile_up_view v <*> apply_all_views ending vs s0
+           pile_up_view ~clear_if_id v <*>
+           apply_all_views ~clear_if_id ending vs s0
 
 (* Entry points *********************************************************)
 
-let tclIPAT_VIEWS ~views:vs ~conclusion:tac =
+let tclIPAT_VIEWS ~views:vs ?(clear_if_id=false) ~conclusion:tac =
   let end_view_application s0 =
-    State.vsCONSUME (fun name t ->
-      finalize_view s0 t >>= pose_proof name <*>
-      tac ~to_clear:(Option.cata (fun x -> [x]) [] name)) in
+    State.vsCONSUME (fun ~name t ~to_clear ->
+      let to_clear = Option.cata (fun x -> [x]) [] name @ to_clear in
+      finalize_view s0 t >>= pose_proof name <*> tac ~to_clear) in
   tclINDEPENDENT begin
     State.vsASSERT_EMPTY <*>
-    Ssrcommon.tacSIGMA >>= apply_all_views end_view_application vs <*>
+    Ssrcommon.tacSIGMA >>=
+      apply_all_views ~clear_if_id end_view_application vs <*>
     State.vsASSERT_EMPTY
   end
 
 let tclWITH_FWD_VIEWS ~simple_types ~subject ~views:vs ~conclusion:tac =
   let ending_tac s0 =
-    State.vsCONSUME (fun _ t -> finalize_view s0 ~simple_types t >>= tac) in
+    State.vsCONSUME (fun ~name:_ t ~to_clear:_ ->
+      finalize_view s0 ~simple_types t >>= tac) in
   tclINDEPENDENT begin
     State.vsASSERT_EMPTY <*>
-    State.vsINIT subject <*>
-    Ssrcommon.tacSIGMA >>= apply_all_views ending_tac vs <*>
+    State.vsINIT (subject,[]) <*>
+    Ssrcommon.tacSIGMA >>=
+      apply_all_views ~clear_if_id:false ending_tac vs <*>
     State.vsASSERT_EMPTY
   end
 
diff --git a/plugins/ssr/ssrview.mli b/plugins/ssr/ssrview.mli
index be51fe7f..b128a95d 100644
--- a/plugins/ssr/ssrview.mli
+++ b/plugins/ssr/ssrview.mli
@@ -20,9 +20,11 @@ module AdaptorDb : sig
 
 end
 
-(* Apply views to the top of the stack (intro pattern) *)
+(* Apply views to the top of the stack (intro pattern). If clear_if_id is
+ * true (default false) then views that happen to be a variable are considered
+ * as to be cleared (see the to_clear argument to the continuation) *)
 val tclIPAT_VIEWS :
-    views:ast_closure_term list ->
+    views:ast_closure_term list -> ?clear_if_id:bool ->
     conclusion:(to_clear:Names.Id.t list -> unit Proofview.tactic) ->
   unit Proofview.tactic
 
diff --git a/plugins/ssrmatching/g_ssrmatching.ml4 b/plugins/ssrmatching/g_ssrmatching.ml4
new file mode 100644
index 00000000..746c368a
--- /dev/null
+++ b/plugins/ssrmatching/g_ssrmatching.ml4
@@ -0,0 +1,101 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Ltac_plugin
+open Genarg
+open Pcoq
+open Pcoq.Constr
+open Ssrmatching
+open Ssrmatching.Internal
+
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.get_keyword_state () ;;
+
+DECLARE PLUGIN "ssrmatching_plugin"
+
+let pr_rpattern _ _ _ = pr_rpattern
+
+ARGUMENT EXTEND rpattern
+  TYPED AS rpatternty
+  PRINTED BY pr_rpattern
+  INTERPRETED BY interp_rpattern
+  GLOBALIZED BY glob_rpattern
+  SUBSTITUTED BY subst_rpattern
+  | [ lconstr(c) ] -> [ mk_rpattern (T (mk_lterm c None)) ]
+  | [ "in" lconstr(c) ] -> [ mk_rpattern (In_T (mk_lterm c None)) ]
+  | [ lconstr(x) "in" lconstr(c) ] ->
+    [ mk_rpattern (X_In_T (mk_lterm x None, mk_lterm c None)) ]
+  | [ "in" lconstr(x) "in" lconstr(c) ] ->
+    [ mk_rpattern (In_X_In_T (mk_lterm x None, mk_lterm c None)) ]
+  | [ lconstr(e) "in" lconstr(x) "in" lconstr(c) ] ->
+    [ mk_rpattern (E_In_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None)) ]
+  | [ lconstr(e) "as" lconstr(x) "in" lconstr(c) ] ->
+    [ mk_rpattern (E_As_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None)) ]
+END
+
+let pr_ssrterm _ _ _ = pr_ssrterm
+
+ARGUMENT EXTEND cpattern
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "Qed" constr(c) ] -> [ mk_lterm c None ]
+END
+
+let input_ssrtermkind strm = match Util.stream_nth 0 strm with
+  | Tok.KEYWORD "(" -> '('
+  | Tok.KEYWORD "@" -> '@'
+  | _ -> ' '
+let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
+
+GEXTEND Gram
+  GLOBAL: cpattern;
+  cpattern: [[ k = ssrtermkind; c = constr ->
+    let pattern = mk_term k c None in
+    if loc_of_cpattern pattern <> Some !@loc && k = '('
+    then mk_term 'x' c None
+    else pattern ]];
+END
+
+ARGUMENT EXTEND lcpattern
+     TYPED AS cpattern
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "Qed" lconstr(c) ] -> [ mk_lterm c None ]
+END
+
+GEXTEND Gram
+  GLOBAL: lcpattern;
+  lcpattern: [[ k = ssrtermkind; c = lconstr ->
+    let pattern = mk_term k c None in
+    if loc_of_cpattern pattern <> Some !@loc && k = '('
+    then mk_term 'x' c None
+    else pattern ]];
+END
+
+ARGUMENT EXTEND ssrpatternarg TYPED AS rpattern PRINTED BY pr_rpattern
+| [ rpattern(pat) ] -> [ pat ]
+END
+
+TACTIC EXTEND ssrinstoftpat
+| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof arg) ]
+END
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.set_keyword_state frozen_lexer ;;
diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml
index 307bc21a..4a63dd47 100644
--- a/plugins/ssrmatching/ssrmatching.ml4
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -10,10 +10,6 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
-(* Defining grammar rules with "xx" in it automatically declares keywords too,
- * we thus save the lexer to restore it at the end of the file *)
-let frozen_lexer = CLexer.get_keyword_state () ;;
-
 open Ltac_plugin
 open Names
 open Pp
@@ -22,8 +18,6 @@ open Stdarg
 open Term
 module CoqConstr = Constr
 open CoqConstr
-open Pcoq
-open Pcoq.Constr
 open Vars
 open Libnames
 open Tactics
@@ -40,14 +34,12 @@ open Pretyping
 open Ppconstr
 open Printer
 open Globnames
-open Misctypes
+open Namegen
 open Decl_kinds
 open Evar_kinds
 open Constrexpr
 open Constrexpr_ops
 
-DECLARE PLUGIN "ssrmatching_plugin"
-
 let errorstrm = CErrors.user_err ~hdr:"ssrmatching"
 let loc_error loc msg = CErrors.user_err ?loc ~hdr:msg (str msg)
 let ppnl = Feedback.msg_info
@@ -131,9 +123,12 @@ let add_genarg tag pr =
 (** Constructors for cast type *)
 let dC t = CastConv t
 (** Constructors for constr_expr *)
-let isCVar   = function { CAst.v = CRef ({CAst.v=Ident _},_) } -> true | _ -> false
-let destCVar = function { CAst.v = CRef ({CAst.v=Ident id},_) } -> id | _ ->
-  CErrors.anomaly (str"not a CRef.")
+let isCVar   = function { CAst.v = CRef (qid,_) } -> qualid_is_ident qid | _ -> false
+let destCVar = function
+  | { CAst.v = CRef (qid,_) } when qualid_is_ident qid ->
+    qualid_basename qid
+  | _ ->
+    CErrors.anomaly (str"not a CRef.")
 let isGLambda c = match DAst.get c with GLambda (Name _, _, _, _) -> true | _ -> false
 let destGLambda c = match DAst.get c with GLambda (Name id, _, _, c) -> (id, c)
   | _ -> CErrors.anomaly (str "not a GLambda")
@@ -283,7 +278,7 @@ exception NoProgress
 (*      comparison can be much faster than the HO one.          *)
 
 let unif_EQ env sigma p c =
-  let evars = existential_opt_value sigma, Evd.universes sigma in 
+  let evars = existential_opt_value0 sigma, Evd.universes sigma in
   try let _ = Reduction.conv env p ~evars c in true with _ -> false
 
 let unif_EQ_args env sigma pa a =
@@ -314,24 +309,27 @@ let unif_HO_args env ise0 pa i ca =
 (* evars into metas, since 8.2 does not TC metas. This means some lossage *)
 (* for HO evars, though hopefully Miller patterns can pick up some of     *)
 (* those cases, and HO matching will mop up the rest.                     *)
-let flags_FO =
+let flags_FO env =
+  let oracle = Environ.oracle env in
+  let ts = Conv_oracle.get_transp_state oracle in
   let flags =
-    { (Unification.default_no_delta_unify_flags ()).Unification.core_unify_flags
+    { (Unification.default_no_delta_unify_flags ts).Unification.core_unify_flags
       with
         Unification.modulo_conv_on_closed_terms = None;
         Unification.modulo_eta = true;
         Unification.modulo_betaiota = true;
-        Unification.modulo_delta_types = full_transparent_state}
+        Unification.modulo_delta_types = ts }
   in
   { Unification.core_unify_flags = flags;
     Unification.merge_unify_flags = flags;
     Unification.subterm_unify_flags = flags;
     Unification.allow_K_in_toplevel_higher_order_unification = false;
     Unification.resolve_evars =
-      (Unification.default_no_delta_unify_flags ()).Unification.resolve_evars
+      (Unification.default_no_delta_unify_flags ts).Unification.resolve_evars
   }
 let unif_FO env ise p c =
-  Unification.w_unify env ise Reduction.CONV ~flags:flags_FO (EConstr.of_constr p) (EConstr.of_constr c)
+  Unification.w_unify env ise Reduction.CONV ~flags:(flags_FO env)
+    (EConstr.of_constr p) (EConstr.of_constr c)
 
 (* Perform evar substitution in main term and prune substitution. *)
 let nf_open_term sigma0 ise c =
@@ -339,7 +337,7 @@ let nf_open_term sigma0 ise c =
   let s = ise and s' = ref sigma0 in
   let rec nf c' = match kind c' with
   | Evar ex ->
-    begin try nf (existential_value s ex) with _ ->
+    begin try nf (existential_value0 s ex) with _ ->
     let k, a = ex in let a' = Array.map nf a in
     if not (Evd.mem !s' k) then
       s' := Evd.add !s' k (Evarutil.nf_evar_info s (Evd.find s k));
@@ -349,7 +347,9 @@ let nf_open_term sigma0 ise c =
   let copy_def k evi () =
     if evar_body evi != Evd.Evar_empty then () else
     match Evd.evar_body (Evd.find s k) with
-    | Evar_defined c' -> s' := Evd.define k (nf c') !s'
+      | Evar_defined c' ->
+        let c' = EConstr.of_constr (nf (EConstr.Unsafe.to_constr c')) in
+        s' := Evd.define k c' !s'
     | _ -> () in
   let c' = nf c in let _ = Evd.fold copy_def sigma0 () in
   !s', Evd.evar_universe_context s, EConstr.of_constr c'
@@ -448,7 +448,7 @@ let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
   let nenv = env_size env + if hack then 1 else 0 in
   let rec put c = match kind c with
   | Evar (k, a as ex) ->
-    begin try put (existential_value !sigma ex)
+    begin try put (existential_value0 !sigma ex)
     with NotInstantiatedEvar ->
     if Evd.mem sigma0 k then map put c else
     let evi = Evd.find !sigma k in
@@ -459,11 +459,13 @@ let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
     | Context.Named.Declaration.LocalAssum (x, t) ->
         mkVar x :: d, mkNamedProd x (put t) c in
     let a, t =
-      Context.Named.fold_inside abs_dc ~init:([], (put evi.evar_concl)) dc in
+      Context.Named.fold_inside abs_dc
+        ~init:([], (put @@ EConstr.Unsafe.to_constr evi.evar_concl))
+        (EConstr.Unsafe.to_named_context dc) in
     let m = Evarutil.new_meta () in
-    ise := meta_declare m t !ise;
-    sigma := Evd.define k (applistc (mkMeta m) a) !sigma;
-    put (existential_value !sigma ex)
+    ise := meta_declare m (EConstr.of_constr t) !ise;
+    sigma := Evd.define k (EConstr.of_constr (applistc (mkMeta m) a)) !sigma;
+    put (existential_value0 !sigma ex)
     end
   | _ -> map put c in
   let c1 = put c0 in !ise, c1
@@ -543,7 +545,7 @@ let splay_app ise =
   | App (f, a') -> loop f (Array.append a' a)
   | Cast (c', _, _) -> loop c' a
   | Evar ex ->
-    (try loop (existential_value ise ex) a with _ -> c, a)
+    (try loop (existential_value0 ise ex) a with _ -> c, a)
   | _ -> c, a in
   fun c -> match kind c with
   | App (f, a) -> loop f a
@@ -706,9 +708,9 @@ let match_upats_HO ~on_instance upats env sigma0 ise c =
 ;;
 
 
-let fixed_upat = function
+let fixed_upat evd = function
 | {up_k = KpatFlex | KpatEvar _ | KpatProj _} -> false 
-| {up_t = t} -> not (occur_existential Evd.empty (EConstr.of_constr t)) (** FIXME *)
+| {up_t = t} -> not (occur_existential evd (EConstr.of_constr t)) (** FIXME *)
 
 let do_once r f = match !r with Some _ -> () | None -> r := Some (f ())
 
@@ -767,7 +769,7 @@ let mk_tpattern_matcher ?(all_instances=false)
 let p2t p = mkApp(p.up_f,p.up_a) in 
 let source () = match upats_origin, upats with
   | None, [p] -> 
-      (if fixed_upat p then str"term " else str"partial term ") ++ 
+      (if fixed_upat ise p then str"term " else str"partial term ") ++
       pr_constr_pat (p2t p) ++ spc()
   | Some (dir,rule), [p] -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
       pr_constr_pat rule ++ fnl() ++ ws 4 ++ pr_constr_pat (p2t p) ++ fnl()
@@ -854,7 +856,7 @@ let rec uniquize = function
   let p' = mkApp (pf, pa) in
   if max_occ <= !nocc then p', u.up_dir, (sigma, uc, u.up_t)
   else errorstrm (str"Only " ++ int !nocc ++ str" < " ++ int max_occ ++
-        str(String.plural !nocc " occurence") ++ match upats_origin with
+        str(String.plural !nocc " occurrence") ++ match upats_origin with
         | None -> str" of" ++ spc() ++ pr_constr_pat p'
         | Some (dir,rule) -> str" of the " ++ pr_dir_side dir ++ fnl() ++
             ws 4 ++ pr_constr_pat p' ++ fnl () ++ 
@@ -900,7 +902,6 @@ let pr_pattern_aux pr_constr = function
 let pp_pattern (sigma, p) =
   pr_pattern_aux (fun t -> pr_constr_pat (EConstr.Unsafe.to_constr (pi3 (nf_open_term sigma sigma (EConstr.of_constr t))))) p
 let pr_cpattern = pr_term
-let pr_rpattern _ _ _ = pr_pattern
 
 let wit_rpatternty = add_genarg "rpatternty" pr_pattern
 
@@ -931,7 +932,7 @@ let glob_cpattern gs p =
   | k, (v, Some t), _ as orig ->
      if k = 'x' then glob_ssrterm gs ('(', (v, Some t), None) else
      match t.CAst.v with
-     | CNotation("( _ in _ )", ([t1; t2], [], [], [])) ->
+     | CNotation((InConstrEntrySomeLevel,"( _ in _ )"), ([t1; t2], [], [], [])) ->
          (try match glob t1, glob t2 with
          | (r1, None), (r2, None) -> encode k "In" [r1;r2]
          | (r1, Some _), (r2, Some _) when isCVar t1 ->
@@ -939,11 +940,11 @@ let glob_cpattern gs p =
          | (r1, Some _), (r2, Some _) -> encode k "In" [r1; r2]
          | _ -> CErrors.anomaly (str"where are we?.")
          with _ when isCVar t1 -> encode k "In" [bind_in t1 t2])
-     | CNotation("( _ in _ in _ )", ([t1; t2; t3], [], [], [])) ->
+     | CNotation((InConstrEntrySomeLevel,"( _ in _ in _ )"), ([t1; t2; t3], [], [], [])) ->
          check_var t2; encode k "In" [fst (glob t1); bind_in t2 t3]
-     | CNotation("( _ as _ )", ([t1; t2], [], [], [])) ->
+     | CNotation((InConstrEntrySomeLevel,"( _ as _ )"), ([t1; t2], [], [], [])) ->
          encode k "As" [fst (glob t1); fst (glob t2)]
-     | CNotation("( _ as _ in _ )", ([t1; t2; t3], [], [], [])) ->
+     | CNotation((InConstrEntrySomeLevel,"( _ as _ in _ )"), ([t1; t2; t3], [], [], [])) ->
          check_var t2; encode k "As" [fst (glob t1); bind_in t2 t3]
      | _ -> glob_ssrterm gs orig
 ;;
@@ -980,27 +981,7 @@ let interp_rpattern s = function
   | E_As_X_In_T(e,x,t) ->
       E_As_X_In_T (interp_ssrterm s e,interp_ssrterm s x,interp_ssrterm s t)
 
-let interp_rpattern ist gl t = Tacmach.project gl, interp_rpattern ist t
-
-ARGUMENT EXTEND rpattern
-  TYPED AS rpatternty
-  PRINTED BY pr_rpattern
-  INTERPRETED BY interp_rpattern
-  GLOBALIZED BY glob_rpattern
-  SUBSTITUTED BY subst_rpattern
-  | [ lconstr(c) ] -> [ T (mk_lterm c None) ]
-  | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c None) ]
-  | [ lconstr(x) "in" lconstr(c) ] -> 
-    [ X_In_T (mk_lterm x None, mk_lterm c None) ]
-  | [ "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ In_X_In_T (mk_lterm x None, mk_lterm c None) ]
-  | [ lconstr(e) "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_In_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None) ]
-  | [ lconstr(e) "as" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_As_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None) ]
-END
-
-
+let interp_rpattern0 ist gl t = Tacmach.project gl, interp_rpattern ist t
 
 type cpattern = char * glob_constr_and_expr * Geninterp.interp_sign option
 let tag_of_cpattern = pi1
@@ -1015,8 +996,10 @@ type pattern = Evd.evar_map * (constr, constr) ssrpattern
 let id_of_cpattern (_, (c1, c2), _) =
   let open CAst in
   match DAst.get c1, c2 with
-  | _, Some { v = CRef ({CAst.v=Ident x}, _) } -> Some x
-  | _, Some { v = CAppExpl ((_, {CAst.v=Ident x}, _), []) } -> Some x
+  | _, Some { v = CRef (qid, _) } when qualid_is_ident qid ->
+    Some (qualid_basename qid)
+  | _, Some { v = CAppExpl ((_, qid, _), []) } when qualid_is_ident qid ->
+    Some (qualid_basename qid)
   | GRef (VarRef x, _), None -> Some x
   | _ -> None
 let id_of_Cterm t = match id_of_cpattern t with
@@ -1042,52 +1025,9 @@ let interp_wit wit ist gl x =
 let interp_open_constr ist gl gc =
   interp_wit wit_open_constr ist gl gc
 let pf_intern_term gl (_, c, ist) = glob_constr ist (pf_env gl) (project gl) c
-let pr_ssrterm _ _ _ = pr_term
-let input_ssrtermkind strm = match stream_nth 0 strm with
-  | Tok.KEYWORD "(" -> '('
-  | Tok.KEYWORD "@" -> '@'
-  | _ -> ' '
-let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
 
 let interp_ssrterm ist gl t = Tacmach.project gl, interp_ssrterm ist t
 
-ARGUMENT EXTEND cpattern
-     PRINTED BY pr_ssrterm
-     INTERPRETED BY interp_ssrterm
-     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
-     RAW_PRINTED BY pr_ssrterm
-     GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" constr(c) ] -> [ mk_lterm c None ]
-END
-
-GEXTEND Gram
-  GLOBAL: cpattern;
-  cpattern: [[ k = ssrtermkind; c = constr ->
-    let pattern = mk_term k c None in
-    if loc_ofCG pattern <> Some !@loc && k = '('
-    then mk_term 'x' c None
-    else pattern ]];
-END
-
-ARGUMENT EXTEND lcpattern
-     TYPED AS cpattern
-     PRINTED BY pr_ssrterm
-     INTERPRETED BY interp_ssrterm
-     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
-     RAW_PRINTED BY pr_ssrterm
-     GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" lconstr(c) ] -> [ mk_lterm c None ]
-END
-
-GEXTEND Gram
-  GLOBAL: lcpattern;
-  lcpattern: [[ k = ssrtermkind; c = lconstr ->
-    let pattern = mk_term k c None in
-    if loc_ofCG pattern <> Some !@loc && k = '('
-    then mk_term 'x' c None
-    else pattern ]];
-END
-
 let interp_term gl = function
   | (_, c, Some ist) ->
       on_snd EConstr.Unsafe.to_constr (interp_open_constr ist gl c)
@@ -1097,15 +1037,14 @@ let thin id sigma goal =
   let ids = Id.Set.singleton id in
   let env = Goal.V82.env sigma goal in
   let cl = Goal.V82.concl sigma goal in
-  let evdref = ref (Evd.clear_metas sigma) in
+  let sigma = Evd.clear_metas sigma in
   let ans =
-    try Some (Evarutil.clear_hyps_in_evi env evdref (Environ.named_context_val env) cl ids)
+    try Some (Evarutil.clear_hyps_in_evi env sigma (Environ.named_context_val env) cl ids)
     with Evarutil.ClearDependencyError _ -> None
   in
   match ans with
   | None -> sigma
-  | Some (hyps, concl) ->
-    let sigma = !evdref in
+  | Some (sigma, hyps, concl) ->
     let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
     let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
     sigma
@@ -1257,7 +1196,7 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
   let fs sigma x = nf_evar sigma x in
   let pop_evar sigma e p =
     let { Evd.evar_body = e_body } as e_def = Evd.find sigma e in
-    let e_body = match e_body with Evar_defined c -> c
+    let e_body = match e_body with Evar_defined c -> EConstr.Unsafe.to_constr c
     | _ -> errorstrm (str "Matching the pattern " ++ pr_constr_env env0 sigma0 p ++
           str " did not instantiate ?" ++ int (Evar.repr e) ++ spc () ++
           str "Does the variable bound by the \"in\" construct occur "++
@@ -1408,10 +1347,6 @@ let is_wildcard ((_, (l, r), _) : cpattern) : bool = match DAst.get l, r with
 
 (* "ssrpattern" *)
 
-ARGUMENT EXTEND ssrpatternarg TYPED AS rpattern PRINTED BY pr_rpattern
-| [ rpattern(pat) ] -> [ pat ]
-END
-
 let pr_rpattern = pr_pattern
   
 let pf_merge_uc uc gl =
@@ -1420,6 +1355,9 @@ let pf_merge_uc uc gl =
 let pf_unsafe_merge_uc uc gl =
   re_sig (sig_it gl) (Evd.set_universe_context (project gl) uc)
 
+(** All the pattern types reuse the same dynamic toplevel tag *)
+let wit_ssrpatternarg = wit_rpatternty
+
 let interp_rpattern = interp_rpattern ~wit_ssrpatternarg
 
 let ssrpatterntac _ist arg gl =
@@ -1428,7 +1366,7 @@ let ssrpatterntac _ist arg gl =
   let concl0 = pf_concl gl in
   let concl0 = EConstr.Unsafe.to_constr concl0 in
   let (t, uc), concl_x =
-    fill_occ_pattern (Global.env()) sigma0 concl0 pat noindex 1 in
+    fill_occ_pattern (pf_env gl) sigma0 concl0 pat noindex 1 in
   let t = EConstr.of_constr t in
   let concl_x = EConstr.of_constr concl_x in
   let gl, tty = pf_type_of gl t in
@@ -1471,14 +1409,20 @@ let ssrinstancesof arg gl =
     done; raise NoMatch
   with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl
 
-TACTIC EXTEND ssrinstoftpat
-| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof arg) ]
-END
-
-(* We wipe out all the keywords generated by the grammar rules we defined. *)
-(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
-(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
-(* consequence the extended ssreflect grammar.                             *)
-let () = CLexer.set_keyword_state frozen_lexer ;;
+module Internal =
+struct
+  let wit_rpatternty = wit_rpatternty
+  let glob_rpattern = glob_rpattern
+  let subst_rpattern = subst_rpattern
+  let interp_rpattern = interp_rpattern0
+  let pr_rpattern = pr_rpattern
+  let mk_rpattern x = x
+  let mk_lterm = mk_lterm
+  let mk_term = mk_term
+  let glob_cpattern = glob_cpattern
+  let subst_ssrterm = subst_ssrterm
+  let interp_ssrterm = interp_ssrterm
+  let pr_ssrterm = pr_term
+end
 
 (* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
new file mode 100644
index 00000000..9c79879d
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching.mli
@@ -0,0 +1,258 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+
+open Goal
+open Environ
+open Evd
+open Constr
+
+open Ltac_plugin
+open Tacexpr
+
+(** ******** Small Scale Reflection pattern matching facilities ************* *)
+
+(** Pattern parsing *)
+
+(** The type of context patterns, the patterns of the [set] tactic and 
+    [:] tactical. These are patterns that identify a precise subterm. *)
+type cpattern
+val pr_cpattern : cpattern -> Pp.t
+
+(** The type of rewrite patterns, the patterns of the [rewrite] tactic.
+    These patterns also include patterns that identify all the subterms
+    of a context (i.e. "in" prefix) *)
+type rpattern
+val pr_rpattern : rpattern -> Pp.t
+
+(** Pattern interpretation and matching *)
+
+exception NoMatch
+exception NoProgress
+
+(** AST for [rpattern] (and consequently [cpattern]) *)
+type ('ident, 'term) ssrpattern =
+  | T of 'term
+  | In_T of 'term
+  | X_In_T of 'ident * 'term
+  | In_X_In_T of 'ident * 'term
+  | E_In_X_In_T of 'term * 'ident * 'term
+  | E_As_X_In_T of 'term * 'ident * 'term
+
+type pattern = evar_map * (constr, constr) ssrpattern
+val pp_pattern : pattern -> Pp.t
+
+(** Extracts the redex and applies to it the substitution part of the pattern.
+  @raise Anomaly if called on [In_T] or [In_X_In_T] *)
+val redex_of_pattern :
+  ?resolve_typeclasses:bool -> env -> pattern ->
+     constr Evd.in_evar_universe_context
+
+(** [interp_rpattern ise gl rpat] "internalizes" and "interprets" [rpat]
+    in the current [Ltac] interpretation signature [ise] and tactic input [gl]*)
+val interp_rpattern :
+  goal sigma ->
+  rpattern ->
+    pattern
+
+(** [interp_cpattern ise gl cpat ty] "internalizes" and "interprets" [cpat]
+    in the current [Ltac] interpretation signature [ise] and tactic input [gl].
+    [ty] is an optional type for the redex of [cpat] *)
+val interp_cpattern :
+  goal sigma ->
+  cpattern -> (glob_constr_and_expr * Geninterp.interp_sign) option ->
+    pattern
+
+(** The set of occurrences to be matched. The boolean is set to true
+ *  to signal the complement of this set (i.e. \{-1 3\}) *)
+type occ = (bool * int list) option
+
+(** [subst e p t i]. [i] is the number of binders
+    traversed so far, [p] the term from the pattern, [t] the matched one *)
+type subst = env -> constr -> constr -> int -> constr
+
+(** [eval_pattern b env sigma t pat occ subst] maps [t] calling [subst] on every
+    [occ] occurrence of [pat]. The [int] argument is the number of 
+    binders traversed. If [pat] is [None] then then subst is called on [t].
+    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
+    (an extension of) [sigma]. 
+  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false])
+  @return [t] where all [occ] occurrences of [pat] have been mapped using
+    [subst] *)
+val eval_pattern :
+  ?raise_NoMatch:bool ->
+  env -> evar_map -> constr ->
+  pattern option -> occ -> subst ->
+    constr
+
+(** [fill_occ_pattern b env sigma t pat occ h] is a simplified version of 
+    [eval_pattern]. 
+    It replaces all [occ] occurrences of [pat] in [t] with Rel [h]. 
+    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
+    (an extension of) [sigma]. 
+  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false]) 
+  @return the instance of the redex of [pat] that was matched and [t]
+    transformed as described above. *)
+val fill_occ_pattern :
+  ?raise_NoMatch:bool ->
+  env -> evar_map -> constr ->
+  pattern -> occ -> int ->
+    constr Evd.in_evar_universe_context * constr
+
+(** *************************** Low level APIs ****************************** *)
+
+(* The primitive matching facility. It matches of a term with holes, like 
+   the T pattern above, and calls a continuation on its occurrences. *)
+
+type ssrdir = L2R | R2L
+val pr_dir_side : ssrdir -> Pp.t
+
+(** a pattern for a term with wildcards *)
+type tpattern
+
+(** [mk_tpattern env sigma0 sigma_p ok p_origin dir t] compiles a term [t] 
+    living in [env] [sigma] (an extension of [sigma0]) intro a [tpattern].
+    The [tpattern] can hold a (proof) term [p] and a diction [dir]. The [ok]
+    callback is used to filter occurrences.
+  @return the compiled [tpattern] and its [evar_map]
+  @raise UserEerror is the pattern is a wildcard *)
+val mk_tpattern :
+  ?p_origin:ssrdir * constr ->
+  env -> evar_map ->
+  evar_map * constr ->
+  (constr -> evar_map -> bool) ->
+  ssrdir -> constr ->
+    evar_map * tpattern
+
+(** [findP env t i k] is a stateful function that finds the next occurrence 
+    of a tpattern and calls the callback [k] to map the subterm matched. 
+    The [int] argument passed to [k] is the number of binders traversed so far 
+    plus the initial value [i]. 
+  @return [t] where the subterms identified by the selected occurrences of 
+    the patter have been mapped using [k]
+  @raise NoMatch if the raise_NoMatch flag given to [mk_tpattern_matcher] is
+    [true] and if the pattern did not match 
+  @raise UserEerror if the raise_NoMatch flag given to [mk_tpattern_matcher] is
+    [false] and if the pattern did not match *)
+type find_P =
+  env -> constr -> int -> k:subst -> constr
+
+(** [conclude ()] asserts that all mentioned ocurrences have been visited.
+  @return the instance of the pattern, the evarmap after the pattern
+    instantiation, the proof term and the ssrdit stored in the tpattern
+  @raise UserEerror if too many occurrences were specified *)
+type conclude =
+  unit -> constr * ssrdir * (evar_map * UState.t * constr)
+
+(** [mk_tpattern_matcher b o sigma0 occ sigma_tplist] creates a pair 
+    a function [find_P] and [conclude] with the behaviour explained above.
+    The flag [b] (default [false]) changes the error reporting behaviour
+    of [find_P] if none of the [tpattern] matches. The argument [o] can
+    be passed to tune the [UserError] eventually raised (useful if the 
+    pattern is coming from the LHS/RHS of an equation) *)
+val mk_tpattern_matcher :
+  ?all_instances:bool ->
+  ?raise_NoMatch:bool ->
+  ?upats_origin:ssrdir * constr ->
+  evar_map -> occ -> evar_map * tpattern list ->
+    find_P * conclude
+
+(** Example of [mk_tpattern_matcher] to implement 
+    [rewrite \{occ\}\[in t\]rules].
+    It first matches "in t" (called [pat]), then in all matched subterms 
+    it matches the LHS of the rules using [find_R].
+    [concl0] is the initial goal, [concl] will be the goal where some terms
+    are replaced by a De Bruijn index. The [rw_progress] extra check
+    selects only occurrences that are not rewritten to themselves (e.g.
+    an occurrence "x + x" rewritten with the commutativity law of addition 
+    is skipped) {[
+  let find_R, conclude = match pat with
+  | Some (_, In_T _) ->
+      let aux (sigma, pats) (d, r, lhs, rhs) =
+        let sigma, pat = 
+          mk_tpattern env0 sigma0 (sigma, r) (rw_progress rhs) d lhs in
+        sigma, pats @ [pat] in
+      let rpats = List.fold_left aux (r_sigma, []) rules in
+      let find_R, end_R = mk_tpattern_matcher sigma0 occ rpats in
+      find_R ~k:(fun _ _ h -> mkRel h), 
+      fun cl -> let rdx, d, r = end_R () in (d,r),rdx
+  | _ -> ... in
+  let concl = eval_pattern env0 sigma0 concl0 pat occ find_R in
+  let (d, r), rdx = conclude concl in ]} *)
+
+(* convenience shortcut: [pf_fill_occ_term gl occ (sigma,t)] returns
+ * the conclusion of [gl] where [occ] occurrences of [t] have been replaced
+ * by [Rel 1] and the instance of [t] *)
+val pf_fill_occ_term : goal sigma -> occ -> evar_map * EConstr.t -> EConstr.t * EConstr.t
+
+(* It may be handy to inject a simple term into the first form of cpattern *)
+val cpattern_of_term : char * glob_constr_and_expr -> Geninterp.interp_sign -> cpattern
+
+(** Helpers to make stateful closures. Example: a [find_P] function may be 
+    called many times, but the pattern instantiation phase is performed only the
+    first time. The corresponding [conclude] has to return the instantiated
+    pattern redex. Since it is up to [find_P] to raise [NoMatch] if the pattern
+    has no instance, [conclude] considers it an anomaly if the pattern did
+    not match *)
+
+(** [do_once r f] calls [f] and updates the ref only once *)
+val do_once : 'a option ref -> (unit -> 'a) -> unit
+(** [assert_done r] return the content of r. @raise Anomaly is r is [None] *)
+val assert_done : 'a option ref -> 'a
+
+(** Very low level APIs.
+    these are calls to evarconv's [the_conv_x] followed by
+    [solve_unif_constraints_with_heuristics] and [resolve_typeclasses].
+    In case of failure they raise [NoMatch] *)
+
+val unify_HO : env -> evar_map -> EConstr.constr -> EConstr.constr -> evar_map
+val pf_unify_HO : goal sigma -> EConstr.constr -> EConstr.constr -> goal sigma
+
+(** Some more low level functions needed to implement the full SSR language
+    on top of the former APIs *)
+val tag_of_cpattern : cpattern -> char
+val loc_of_cpattern : cpattern -> Loc.t option
+val id_of_pattern : pattern -> Names.Id.t option
+val is_wildcard : cpattern -> bool
+val cpattern_of_id : Names.Id.t -> cpattern
+val pr_constr_pat : constr -> Pp.t
+val pf_merge_uc : UState.t -> goal Evd.sigma -> goal Evd.sigma
+val pf_unsafe_merge_uc : UState.t -> goal Evd.sigma -> goal Evd.sigma
+
+(* One can also "Set SsrMatchingDebug" from a .v *)
+val debug : bool -> unit
+
+(* One should delimit a snippet with "Set SsrMatchingProfiling" and
+ * "Unset SsrMatchingProfiling" to get timings *)
+val profile : bool -> unit
+
+val ssrinstancesof : cpattern -> Tacmach.tactic
+
+(** Functions used for grammar extensions. Do not use. *)
+
+module Internal :
+sig
+  val wit_rpatternty : (rpattern, rpattern, rpattern) Genarg.genarg_type
+  val glob_rpattern : Genintern.glob_sign -> rpattern -> rpattern
+  val subst_rpattern : Mod_subst.substitution -> rpattern -> rpattern
+  val interp_rpattern : Geninterp.interp_sign -> Proof_type.goal Evd.sigma -> rpattern -> Evd.evar_map * rpattern
+  val pr_rpattern : rpattern -> Pp.t
+  val mk_rpattern : (cpattern, cpattern) ssrpattern -> rpattern
+  val mk_lterm : Constrexpr.constr_expr -> Geninterp.interp_sign option -> cpattern
+  val mk_term : char -> Constrexpr.constr_expr -> Geninterp.interp_sign option -> cpattern
+
+  val glob_cpattern : Genintern.glob_sign -> cpattern -> cpattern
+  val subst_ssrterm : Mod_subst.substitution -> cpattern -> cpattern
+  val interp_ssrterm : Geninterp.interp_sign -> Proof_type.goal Evd.sigma -> cpattern -> Evd.evar_map * cpattern
+  val pr_ssrterm : cpattern -> Pp.t
+end
+
+(* eof *)
diff --git a/plugins/ssrmatching/ssrmatching.v b/plugins/ssrmatching/ssrmatching.v
new file mode 100644
index 00000000..fee09cc9
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching.v
@@ -0,0 +1,36 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+
+Declare ML Module "ssrmatching_plugin".
+
+Module SsrMatchingSyntax.
+
+(* Reserve the notation for rewrite patterns so that the user is not allowed  *)
+(* to declare it at a different level.                                        *)
+Reserved Notation "( a 'in' b )"        (at level 0).
+Reserved Notation "( a 'as' b )"        (at level 0).
+Reserved Notation "( a 'in' b 'in' c )" (at level 0).
+Reserved Notation "( a 'as' b 'in' c )" (at level 0).
+
+(* Notation to define shortcuts for the "X in t" part of a pattern.           *)
+Notation "( X 'in' t )" := (_ : fun X => t) : ssrpatternscope.
+Delimit Scope ssrpatternscope with pattern.
+
+(* Some shortcuts for recurrent "X in t" parts.                               *)
+Notation RHS := (X in _ = X)%pattern.
+Notation LHS := (X in X = _)%pattern.
+
+End SsrMatchingSyntax.
+
+Export SsrMatchingSyntax.
+
+Tactic Notation "ssrpattern" ssrpatternarg(p) := ssrpattern p .
diff --git a/plugins/ssrmatching/ssrmatching_plugin.mlpack b/plugins/ssrmatching/ssrmatching_plugin.mlpack
index 5fb1f156..02c75f14 100644
--- a/plugins/ssrmatching/ssrmatching_plugin.mlpack
+++ b/plugins/ssrmatching/ssrmatching_plugin.mlpack
@@ -1 +1,2 @@
 Ssrmatching
+G_ssrmatching
diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml
index acb297dd..53153198 100644
--- a/plugins/syntax/ascii_syntax.ml
+++ b/plugins/syntax/ascii_syntax.ml
@@ -28,7 +28,7 @@ let make_kn dir id = Globnames.encode_mind (make_dir dir) (Id.of_string id)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
 let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
+| GRef (r, _) -> GlobRef.equal r gr
 | _ -> false
 
 let ascii_module = ["Coq";"Strings";"Ascii"]
@@ -83,8 +83,18 @@ let make_ascii_string n =
 
 let uninterp_ascii_string (AnyGlobConstr r) = Option.map make_ascii_string (uninterp_ascii r)
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 let _ =
-  Notation.declare_string_interpreter "char_scope"
-    (ascii_path,ascii_module)
-    interp_ascii_string
-    ([DAst.make @@ GRef (static_glob_Ascii,None)], uninterp_ascii_string, true)
+  let sc = "char_scope" in
+  register_string_interpretation sc (interp_ascii_string,uninterp_ascii_string);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_local = false;
+      pt_scope = sc;
+      pt_interp_info = Uid sc;
+      pt_required = (ascii_path,ascii_module);
+      pt_refs = [static_glob_Ascii];
+      pt_in_match = true }
diff --git a/plugins/syntax/g_numeral.ml4 b/plugins/syntax/g_numeral.ml4
new file mode 100644
index 00000000..55f61a58
--- /dev/null
+++ b/plugins/syntax/g_numeral.ml4
@@ -0,0 +1,38 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+DECLARE PLUGIN "numeral_notation_plugin"
+
+open Notation
+open Numeral
+open Pp
+open Names
+open Vernacinterp
+open Ltac_plugin
+open Stdarg
+open Pcoq.Prim
+
+let pr_numnot_option _ _ _ = function
+  | Nop -> mt ()
+  | Warning n -> str "(warning after " ++ str n ++ str ")"
+  | Abstract n -> str "(abstract after " ++ str n ++ str ")"
+
+ARGUMENT EXTEND numnotoption
+  PRINTED BY pr_numnot_option
+| [ ] -> [ Nop ]
+| [ "(" "warning" "after" bigint(waft) ")" ] -> [ Warning waft ]
+| [ "(" "abstract" "after" bigint(n) ")" ] -> [ Abstract n ]
+END
+
+VERNAC COMMAND EXTEND NumeralNotation CLASSIFIED AS SIDEFF
+  | [ "Numeral" "Notation" reference(ty) reference(f) reference(g) ":"
+      ident(sc) numnotoption(o) ] ->
+    [ vernac_numeral_notation (Locality.make_module_locality atts.locality) ty f g (Id.to_string sc) o ]
+END
diff --git a/plugins/syntax/int31_syntax.ml b/plugins/syntax/int31_syntax.ml
index 5529ea70..e34a401c 100644
--- a/plugins/syntax/int31_syntax.ml
+++ b/plugins/syntax/int31_syntax.ml
@@ -26,7 +26,7 @@ let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
 let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
+| GRef (r, _) -> GlobRef.equal r gr
 | _ -> false
 
 let make_mind mp id = Names.MutInd.make2 mp (Label.make id)
@@ -96,10 +96,19 @@ let uninterp_int31 (AnyGlobConstr i) =
   with Non_closed ->
     None
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 (* Actually declares the interpreter for int31 *)
-let _ = Notation.declare_numeral_interpreter int31_scope
-  (int31_path, int31_module)
-  interp_int31
-  ([DAst.make (GRef (int31_construct, None))],
-   uninterp_int31,
-   true)
+
+let _ =
+  register_bignumeral_interpretation int31_scope (interp_int31,uninterp_int31);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_local = false;
+      pt_scope = int31_scope;
+      pt_interp_info = Uid int31_scope;
+      pt_required = (int31_path,int31_module);
+      pt_refs = [int31_construct];
+      pt_in_match = true }
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
deleted file mode 100644
index ad8b54d4..00000000
--- a/plugins/syntax/nat_syntax.ml
+++ /dev/null
@@ -1,84 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-
-(* Poor's man DECLARE PLUGIN *)
-let __coq_plugin_name = "nat_syntax_plugin"
-let () = Mltop.add_known_module __coq_plugin_name
-
-(* This file defines the printer for natural numbers in [nat] *)
-
-(*i*)
-open Glob_term
-open Bigint
-open Coqlib
-open Pp
-open CErrors
-(*i*)
-
-(**********************************************************************)
-(* Parsing via scopes *)
-(* For example, (nat_of_string "3") is <<(S (S (S O)))>> *)
-
-let threshold = of_int 5000
-
-let warn_large_nat =
-  CWarnings.create ~name:"large-nat" ~category:"numbers"
-    (fun () -> strbrk "Stack overflow or segmentation fault happens when " ++
-                 strbrk "working with large numbers in nat (observed threshold " ++
-                 strbrk "may vary from 5000 to 70000 depending on your system " ++
-                 strbrk "limits and on the command executed).")
-
-let nat_of_int ?loc n =
-  if is_pos_or_zero n then begin
-      if less_than threshold n then warn_large_nat ();
-      let ref_O = DAst.make ?loc @@ GRef (glob_O, None) in
-      let ref_S = DAst.make ?loc @@ GRef (glob_S, None) in
-      let rec mk_nat acc n =
-	if n <> zero then
-	  mk_nat (DAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n)
-	else
-	  acc
-      in
-      mk_nat ref_O n
-    end
-  else
-      user_err ?loc ~hdr:"nat_of_int"
-       (str "Cannot interpret a negative number as a number of type nat")
-
-(************************************************************************)
-(* Printing via scopes *)
-
-exception Non_closed_number
-
-let rec int_of_nat x = DAst.with_val (function
-  | GApp (r, [a]) ->
-    begin match DAst.get r with
-    | GRef (s,_) when Globnames.eq_gr s glob_S -> add_1 (int_of_nat a)
-    | _ -> raise Non_closed_number
-    end
-  | GRef (z,_) when Globnames.eq_gr z glob_O -> zero
-  | _ -> raise Non_closed_number
-  ) x
-
-let uninterp_nat (AnyGlobConstr p) =
-  try
-    Some (int_of_nat p)
-  with
-    Non_closed_number -> None
-
-(************************************************************************)
-(* Declare the primitive parsers and printers *)
-
-let _ =
-  Notation.declare_numeral_interpreter "nat_scope"
-    (nat_path,datatypes_module_name)
-    nat_of_int
-    ([DAst.make @@ GRef (glob_S,None); DAst.make @@ GRef (glob_O,None)], uninterp_nat, true)
diff --git a/plugins/syntax/nat_syntax_plugin.mlpack b/plugins/syntax/nat_syntax_plugin.mlpack
deleted file mode 100644
index 39bdd62f..00000000
--- a/plugins/syntax/nat_syntax_plugin.mlpack
+++ /dev/null
@@ -1 +0,0 @@
-Nat_syntax
diff --git a/plugins/syntax/numeral.ml b/plugins/syntax/numeral.ml
new file mode 100644
index 00000000..10a0af0b
--- /dev/null
+++ b/plugins/syntax/numeral.ml
@@ -0,0 +1,142 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open Util
+open Names
+open Libnames
+open Globnames
+open Constrexpr
+open Constrexpr_ops
+open Notation
+
+(** * Numeral notation *)
+
+let warn_abstract_large_num_no_op =
+  CWarnings.create ~name:"abstract-large-number-no-op" ~category:"numbers"
+    (fun f ->
+      strbrk "The 'abstract after' directive has no effect when " ++
+      strbrk "the parsing function (" ++
+      Nametab.pr_global_env (Termops.vars_of_env (Global.env ())) f ++ strbrk ") targets an " ++
+      strbrk "option type.")
+
+let get_constructors ind =
+  let mib,oib = Global.lookup_inductive ind in
+  let mc = oib.Declarations.mind_consnames in
+  Array.to_list
+    (Array.mapi (fun j c -> ConstructRef (ind, j + 1)) mc)
+
+let q_z = qualid_of_string "Coq.Numbers.BinNums.Z"
+let q_positive = qualid_of_string "Coq.Numbers.BinNums.positive"
+let q_int = qualid_of_string "Coq.Init.Decimal.int"
+let q_uint = qualid_of_string "Coq.Init.Decimal.uint"
+let q_option = qualid_of_string "Coq.Init.Datatypes.option"
+
+let unsafe_locate_ind q =
+  match Nametab.locate q with
+  | IndRef i -> i
+  | _ -> raise Not_found
+
+let locate_ind q =
+  try unsafe_locate_ind q
+  with Not_found -> Nametab.error_global_not_found q
+
+let locate_z () =
+  try
+    Some { z_ty = unsafe_locate_ind q_z;
+           pos_ty = unsafe_locate_ind q_positive }
+  with Not_found -> None
+
+let locate_int () =
+  { uint = locate_ind q_uint;
+    int = locate_ind q_int }
+
+let has_type f ty =
+  let (sigma, env) = Pfedit.get_current_context () in
+  let c = mkCastC (mkRefC f, Glob_term.CastConv ty) in
+  try let _ = Constrintern.interp_constr env sigma c in true
+  with Pretype_errors.PretypeError _ -> false
+
+let type_error_to f ty loadZ =
+  CErrors.user_err
+    (pr_qualid f ++ str " should go from Decimal.int to " ++
+     pr_qualid ty ++ str " or (option " ++ pr_qualid ty ++ str ")." ++
+     fnl () ++ str "Instead of Decimal.int, the types Decimal.uint or Z could be used" ++
+     (if loadZ then str " (require BinNums first)." else str "."))
+
+let type_error_of g ty loadZ =
+  CErrors.user_err
+    (pr_qualid g ++ str " should go from " ++ pr_qualid ty ++
+     str " to Decimal.int or (option Decimal.int)." ++ fnl () ++
+     str "Instead of Decimal.int, the types Decimal.uint or Z could be used" ++
+     (if loadZ then str " (require BinNums first)." else str "."))
+
+let vernac_numeral_notation local ty f g scope opts =
+  let int_ty = locate_int () in
+  let z_pos_ty = locate_z () in
+  let tyc = Smartlocate.global_inductive_with_alias ty in
+  let to_ty = Smartlocate.global_with_alias f in
+  let of_ty = Smartlocate.global_with_alias g in
+  let cty = mkRefC ty in
+  let app x y = mkAppC (x,[y]) in
+  let cref q = mkRefC q in
+  let arrow x y =
+    mkProdC ([CAst.make Anonymous],Default Decl_kinds.Explicit, x, y)
+  in
+  let cZ = cref q_z in
+  let cint = cref q_int in
+  let cuint = cref q_uint in
+  let coption = cref q_option in
+  let opt r = app coption r in
+  let constructors = get_constructors tyc in
+  (* Check the type of f *)
+  let to_kind =
+    if has_type f (arrow cint cty) then Int int_ty, Direct
+    else if has_type f (arrow cint (opt cty)) then Int int_ty, Option
+    else if has_type f (arrow cuint cty) then UInt int_ty.uint, Direct
+    else if has_type f (arrow cuint (opt cty)) then UInt int_ty.uint, Option
+    else
+      match z_pos_ty with
+      | Some z_pos_ty ->
+         if has_type f (arrow cZ cty) then Z z_pos_ty, Direct
+         else if has_type f (arrow cZ (opt cty)) then Z z_pos_ty, Option
+         else type_error_to f ty false
+      | None -> type_error_to f ty true
+  in
+  (* Check the type of g *)
+  let of_kind =
+    if has_type g (arrow cty cint) then Int int_ty, Direct
+    else if has_type g (arrow cty (opt cint)) then Int int_ty, Option
+    else if has_type g (arrow cty cuint) then UInt int_ty.uint, Direct
+    else if has_type g (arrow cty (opt cuint)) then UInt int_ty.uint, Option
+    else
+      match z_pos_ty with
+      | Some z_pos_ty ->
+         if has_type g (arrow cty cZ) then Z z_pos_ty, Direct
+         else if has_type g (arrow cty (opt cZ)) then Z z_pos_ty, Option
+         else type_error_of g ty false
+      | None -> type_error_of g ty true
+  in
+  let o = { to_kind; to_ty; of_kind; of_ty;
+            num_ty = ty;
+            warning = opts }
+  in
+  (match opts, to_kind with
+   | Abstract _, (_, Option) -> warn_abstract_large_num_no_op o.to_ty
+   | _ -> ());
+  let i =
+       { pt_local = local;
+         pt_scope = scope;
+         pt_interp_info = NumeralNotation o;
+         pt_required = Nametab.path_of_global (IndRef tyc),[];
+         pt_refs = constructors;
+         pt_in_match = true }
+  in
+  enable_prim_token_interpretation i
diff --git a/plugins/syntax/numeral.mli b/plugins/syntax/numeral.mli
new file mode 100644
index 00000000..f96b8321
--- /dev/null
+++ b/plugins/syntax/numeral.mli
@@ -0,0 +1,17 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Libnames
+open Vernacexpr
+open Notation
+
+(** * Numeral notation *)
+
+val vernac_numeral_notation : locality_flag -> qualid -> qualid -> qualid -> Notation_term.scope_name -> numnot_option -> unit
diff --git a/plugins/syntax/numeral_notation_plugin.mlpack b/plugins/syntax/numeral_notation_plugin.mlpack
new file mode 100644
index 00000000..f4d9cae3
--- /dev/null
+++ b/plugins/syntax/numeral_notation_plugin.mlpack
@@ -0,0 +1,2 @@
+Numeral
+G_numeral
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 372e8ff3..49497aef 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -30,7 +30,7 @@ let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
 let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
+| GRef (r, _) -> GlobRef.equal r gr
 | _ -> false
 
 let positive_path = make_path binnums "positive"
@@ -66,7 +66,7 @@ let pos_of_bignat ?loc x =
 let rec bignat_of_pos c = match DAst.get c with
   | GApp (r, [a]) when is_gr r glob_xO -> mult_2(bignat_of_pos a)
   | GApp (r, [a]) when is_gr r glob_xI -> add_1(mult_2(bignat_of_pos a))
-  | GRef (a, _) when Globnames.eq_gr a glob_xH -> Bigint.one
+  | GRef (a, _) when GlobRef.equal a glob_xH -> Bigint.one
   | _ -> raise Non_closed_number
 
 (**********************************************************************)
@@ -98,7 +98,7 @@ let z_of_int ?loc n =
 let bigint_of_z c = match DAst.get c with
   | GApp (r,[a]) when is_gr r glob_POS -> bignat_of_pos a
   | GApp (r,[a]) when is_gr r glob_NEG -> Bigint.neg (bignat_of_pos a)
-  | GRef (a, _) when Globnames.eq_gr a glob_ZERO -> Bigint.zero
+  | GRef (a, _) when GlobRef.equal a glob_ZERO -> Bigint.zero
   | _ -> raise Non_closed_number
 
 (**********************************************************************)
@@ -131,9 +131,19 @@ let uninterp_r (AnyGlobConstr p) =
   with Non_closed_number ->
     None
 
-let _ = Notation.declare_numeral_interpreter "R_scope"
-  (r_path,["Coq";"Reals";"Rdefinitions"])
-  r_of_int
-  ([DAst.make @@ GRef (glob_IZR, None)],
-    uninterp_r,
-    false)
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
+let r_scope = "R_scope"
+
+let _ =
+  register_bignumeral_interpretation r_scope (r_of_int,uninterp_r);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_local = false;
+      pt_scope = r_scope;
+      pt_interp_info = Uid r_scope;
+      pt_required = (r_path,["Coq";"Reals";"Rdefinitions"]);
+      pt_refs = [glob_IZR];
+      pt_in_match = false }
diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml
index 2421cc12..7478c1e9 100644
--- a/plugins/syntax/string_syntax.ml
+++ b/plugins/syntax/string_syntax.ml
@@ -8,6 +8,7 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Names
 open Globnames
 open Ascii_syntax_plugin.Ascii_syntax
 open Glob_term
@@ -34,7 +35,7 @@ let glob_String = lazy (make_reference "String")
 let glob_EmptyString = lazy (make_reference "EmptyString")
 
 let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
+| GRef (r, _) -> GlobRef.equal r gr
 | _ -> false
 
 open Lazy
@@ -55,7 +56,7 @@ let uninterp_string (AnyGlobConstr r) =
 	(match uninterp_ascii a with
 	  | Some c -> Buffer.add_char b (Char.chr c); aux s
 	  | _ -> raise Non_closed_string)
-    | GRef (z,_) when eq_gr z (force glob_EmptyString) ->
+    | GRef (z,_) when GlobRef.equal z (force glob_EmptyString) ->
 	Some (Buffer.contents b)
     | _ ->
 	raise Non_closed_string
@@ -63,10 +64,18 @@ let uninterp_string (AnyGlobConstr r) =
   with
    Non_closed_string -> None
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 let _ =
-  Notation.declare_string_interpreter "string_scope"
-    (string_path,["Coq";"Strings";"String"])
-    interp_string
-    ([DAst.make @@ GRef (static_glob_String,None);
-      DAst.make @@ GRef (static_glob_EmptyString,None)],
-     uninterp_string, true)
+  let sc = "string_scope" in
+  register_string_interpretation sc (interp_string,uninterp_string);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_local = false;
+      pt_scope = sc;
+      pt_interp_info = Uid sc;
+      pt_required = (string_path,["Coq";"Strings";"String"]);
+      pt_refs = [static_glob_String; static_glob_EmptyString];
+      pt_in_match = true }
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
deleted file mode 100644
index d5300e47..00000000
--- a/plugins/syntax/z_syntax.ml
+++ /dev/null
@@ -1,202 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-open Pp
-open CErrors
-open Util
-open Names
-open Bigint
-
-(* Poor's man DECLARE PLUGIN *)
-let __coq_plugin_name = "z_syntax_plugin"
-let () = Mltop.add_known_module __coq_plugin_name
-
-exception Non_closed_number
-
-(**********************************************************************)
-(* Parsing positive via scopes                                        *)
-(**********************************************************************)
-
-open Globnames
-open Glob_term
-
-let binnums = ["Coq";"Numbers";"BinNums"]
-
-let make_dir l = DirPath.make (List.rev_map Id.of_string l)
-let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
-
-let positive_path = make_path binnums "positive"
-
-(* TODO: temporary hack *)
-let make_kn dir id = Globnames.encode_mind dir id
-
-let positive_kn = make_kn (make_dir binnums) (Id.of_string "positive")
-let glob_positive = IndRef (positive_kn,0)
-let path_of_xI = ((positive_kn,0),1)
-let path_of_xO = ((positive_kn,0),2)
-let path_of_xH = ((positive_kn,0),3)
-let glob_xI = ConstructRef path_of_xI
-let glob_xO = ConstructRef path_of_xO
-let glob_xH = ConstructRef path_of_xH
-
-let pos_of_bignat ?loc x = 
-  let ref_xI = DAst.make ?loc @@ GRef (glob_xI, None) in
-  let ref_xH = DAst.make ?loc @@ GRef (glob_xH, None) in
-  let ref_xO = DAst.make ?loc @@ GRef (glob_xO, None) in
-  let rec pos_of x =
-    match div2_with_rest x with
-      | (q,false) -> DAst.make ?loc @@ GApp (ref_xO,[pos_of q])
-      | (q,true) when not (Bigint.equal q zero) -> DAst.make ?loc @@ GApp (ref_xI,[pos_of q])
-      | (q,true) -> ref_xH
-  in
-  pos_of x
-
-let error_non_positive ?loc =
-  user_err ?loc ~hdr:"interp_positive"
-   (str "Only strictly positive numbers in type \"positive\".")
-
-let interp_positive ?loc n =
-  if is_strictly_pos n then pos_of_bignat ?loc n
-  else error_non_positive ?loc
-
-(**********************************************************************)
-(* Printing positive via scopes                                       *)
-(**********************************************************************)
-
-let is_gr c gr = match DAst.get c with
-| GRef (r, _) -> Globnames.eq_gr r gr
-| _ -> false
-
-let rec bignat_of_pos x = DAst.with_val (function
-  | GApp (r ,[a]) when is_gr r glob_xO -> mult_2(bignat_of_pos a)
-  | GApp (r ,[a]) when is_gr r glob_xI -> add_1(mult_2(bignat_of_pos a))
-  | GRef (a, _)                when Globnames.eq_gr a glob_xH -> Bigint.one
-  | _ -> raise Non_closed_number
-  ) x
-
-let uninterp_positive (AnyGlobConstr p) =
-  try
-    Some (bignat_of_pos p)
-  with Non_closed_number ->
-    None
-
-(************************************************************************)
-(* Declaring interpreters and uninterpreters for positive *)
-(************************************************************************)
-
-let _ = Notation.declare_numeral_interpreter "positive_scope"
-  (positive_path,binnums)
-  interp_positive
-  ([DAst.make @@ GRef (glob_xI, None);
-    DAst.make @@ GRef (glob_xO, None);
-    DAst.make @@ GRef (glob_xH, None)],
-   uninterp_positive,
-   true)
-
-(**********************************************************************)
-(* Parsing N via scopes                                               *)
-(**********************************************************************)
-
-let n_kn = make_kn (make_dir binnums) (Id.of_string "N")
-let glob_n = IndRef (n_kn,0)
-let path_of_N0 = ((n_kn,0),1)
-let path_of_Npos = ((n_kn,0),2)
-let glob_N0 = ConstructRef path_of_N0
-let glob_Npos = ConstructRef path_of_Npos
-
-let n_path = make_path binnums "N"
-
-let n_of_binnat ?loc pos_or_neg n = DAst.make ?loc @@
-  if not (Bigint.equal n zero) then
-    GApp(DAst.make @@ GRef (glob_Npos,None), [pos_of_bignat ?loc n])
-  else
-    GRef(glob_N0, None)
-
-let error_negative ?loc =
-  user_err ?loc ~hdr:"interp_N" (str "No negative numbers in type \"N\".")
-
-let n_of_int ?loc n =
-  if is_pos_or_zero n then n_of_binnat ?loc true n
-  else error_negative ?loc
-
-(**********************************************************************)
-(* Printing N via scopes                                              *)
-(**********************************************************************)
-
-let bignat_of_n n = DAst.with_val (function
-  | GApp (r, [a]) when is_gr r glob_Npos -> bignat_of_pos a
-  | GRef (a,_) when Globnames.eq_gr a glob_N0 -> Bigint.zero
-  | _ -> raise Non_closed_number
-  ) n
-
-let uninterp_n (AnyGlobConstr p) =
-  try Some (bignat_of_n p)
-  with Non_closed_number -> None
-
-(************************************************************************)
-(* Declaring interpreters and uninterpreters for N *)
-
-let _ = Notation.declare_numeral_interpreter "N_scope"
-  (n_path,binnums)
-  n_of_int
-  ([DAst.make @@ GRef (glob_N0, None);
-    DAst.make @@ GRef (glob_Npos, None)],
-  uninterp_n,
-  true)
-
-(**********************************************************************)
-(* Parsing Z via scopes                                               *)
-(**********************************************************************)
-
-let z_path = make_path binnums "Z"
-let z_kn = make_kn (make_dir binnums) (Id.of_string "Z")
-let glob_z = IndRef (z_kn,0)
-let path_of_ZERO = ((z_kn,0),1)
-let path_of_POS = ((z_kn,0),2)
-let path_of_NEG = ((z_kn,0),3)
-let glob_ZERO = ConstructRef path_of_ZERO
-let glob_POS = ConstructRef path_of_POS
-let glob_NEG = ConstructRef path_of_NEG
-
-let z_of_int ?loc n =
-  if not (Bigint.equal n zero) then
-    let sgn, n =
-      if is_pos_or_zero n then glob_POS, n else glob_NEG, Bigint.neg n in
-    DAst.make ?loc @@ GApp(DAst.make ?loc @@ GRef(sgn,None), [pos_of_bignat ?loc n])
-  else
-    DAst.make ?loc @@ GRef(glob_ZERO, None)
-
-(**********************************************************************)
-(* Printing Z via scopes                                              *)
-(**********************************************************************)
-
-let bigint_of_z z = DAst.with_val (function
-  | GApp (r, [a]) when is_gr r glob_POS -> bignat_of_pos a
-  | GApp (r, [a]) when is_gr r glob_NEG -> Bigint.neg (bignat_of_pos a)
-  | GRef (a, _) when Globnames.eq_gr a glob_ZERO -> Bigint.zero
-  | _ -> raise Non_closed_number
-  ) z
-
-let uninterp_z (AnyGlobConstr p) =
-  try
-    Some (bigint_of_z p)
-  with Non_closed_number -> None
-
-(************************************************************************)
-(* Declaring interpreters and uninterpreters for Z *)
-
-let _ = Notation.declare_numeral_interpreter "Z_scope"
-  (z_path,binnums)
-  z_of_int
-  ([DAst.make @@ GRef (glob_ZERO, None);
-    DAst.make @@ GRef (glob_POS, None);
-    DAst.make @@ GRef (glob_NEG, None)],
-  uninterp_z,
-  true)
diff --git a/plugins/syntax/z_syntax_plugin.mlpack b/plugins/syntax/z_syntax_plugin.mlpack
deleted file mode 100644
index 411260c0..00000000
--- a/plugins/syntax/z_syntax_plugin.mlpack
+++ /dev/null
@@ -1 +0,0 @@
-Z_syntax