Imported Upstream version 8.5~beta1+dfsg

37 files changed, 4329 insertions, 4096 deletions

diff --git a/interp/constrarg.ml b/interp/constrarg.ml
new file mode 100644
index 00000000..3f232c36
--- /dev/null
+++ b/interp/constrarg.ml
@@ -0,0 +1,71 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Loc
+open Tacexpr
+open Term
+open Misctypes
+open Genarg
+
+(** This is a hack for now, to break the dependency of Genarg on constr-related
+    types. We should use dedicated functions someday. *)
+
+let loc_of_or_by_notation f = function
+  | AN c -> f c
+  | ByNotation (loc,s,_) -> loc
+
+let unsafe_of_type (t : argument_type) : ('a, 'b, 'c) Genarg.genarg_type =
+  Obj.magic t
+
+let wit_int_or_var = unsafe_of_type IntOrVarArgType
+
+let wit_intro_pattern : (Constrexpr.constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type =
+  Genarg.make0 None "intropattern"
+
+let wit_tactic : (raw_tactic_expr, glob_tactic_expr, glob_tactic_expr) genarg_type =
+  Genarg.make0 None "tactic"
+
+let wit_ident = unsafe_of_type IdentArgType
+
+let wit_var = unsafe_of_type VarArgType
+
+let wit_ref = Genarg.make0 None "ref"
+
+let wit_quant_hyp = unsafe_of_type QuantHypArgType
+
+let wit_genarg = unsafe_of_type GenArgType
+
+let wit_sort : (glob_sort, glob_sort, sorts) genarg_type =
+  Genarg.make0 None "sort"
+
+let wit_constr = unsafe_of_type ConstrArgType
+
+let wit_constr_may_eval = unsafe_of_type ConstrMayEvalArgType
+
+let wit_uconstr = Genarg.make0 None "uconstr"
+
+let wit_open_constr = unsafe_of_type OpenConstrArgType
+
+let wit_constr_with_bindings = unsafe_of_type ConstrWithBindingsArgType
+
+let wit_bindings = unsafe_of_type BindingsArgType
+
+let wit_red_expr = unsafe_of_type RedExprArgType
+
+let wit_clause_dft_concl  =
+  Genarg.make0 None "clause_dft_concl"
+
+(** Register location *)
+
+let () =
+  register_name0 wit_ref "Constrarg.wit_ref";
+  register_name0 wit_intro_pattern "Constrarg.wit_intro_pattern";
+  register_name0 wit_tactic "Constrarg.wit_tactic";
+  register_name0 wit_sort "Constrarg.wit_sort";
+  register_name0 wit_uconstr "Constrarg.wit_uconstr";
+  register_name0 wit_clause_dft_concl "Constrarg.wit_clause_dft_concl";
diff --git a/interp/constrarg.mli b/interp/constrarg.mli
new file mode 100644
index 00000000..74c6bd31
--- /dev/null
+++ b/interp/constrarg.mli
@@ -0,0 +1,74 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Generic arguments based on [constr]. We put them here to avoid a dependency
+    of Genarg in [constr]-related interfaces. *)
+
+open Loc
+open Names
+open Term
+open Libnames
+open Globnames
+open Genredexpr
+open Pattern
+open Constrexpr
+open Tacexpr
+open Misctypes
+open Genarg
+
+(** FIXME: nothing to do there. *)
+val loc_of_or_by_notation : ('a -> Loc.t) -> 'a or_by_notation -> Loc.t
+
+(** {5 Additional generic arguments} *)
+
+val wit_int_or_var : int or_var uniform_genarg_type
+
+val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
+
+val wit_ident : Id.t uniform_genarg_type
+
+val wit_var : (Id.t located, Id.t located, Id.t) genarg_type
+
+val wit_ref : (reference, global_reference located or_var, global_reference) genarg_type
+
+val wit_quant_hyp : quantified_hypothesis uniform_genarg_type
+
+val wit_genarg : (raw_generic_argument, glob_generic_argument, typed_generic_argument) genarg_type
+
+val wit_sort : (glob_sort, glob_sort, sorts) genarg_type
+
+val wit_constr : (constr_expr, glob_constr_and_expr, constr) genarg_type
+
+val wit_constr_may_eval :
+  ((constr_expr,reference or_by_notation,constr_expr) may_eval,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) may_eval,
+  constr) genarg_type
+
+val wit_uconstr : (constr_expr , glob_constr_and_expr, Glob_term.closed_glob_constr) genarg_type
+
+val wit_open_constr :
+  (open_constr_expr, open_glob_constr, Evd.open_constr) genarg_type
+
+val wit_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings Evd.sigma) genarg_type
+
+val wit_bindings :
+  (constr_expr bindings,
+  glob_constr_and_expr bindings,
+  constr bindings Evd.sigma) genarg_type
+
+val wit_red_expr :
+  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
+  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
+
+val wit_tactic : (raw_tactic_expr, glob_tactic_expr, glob_tactic_expr) genarg_type
+
+val wit_clause_dft_concl :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
new file mode 100644
index 00000000..2d48ea4d
--- /dev/null
+++ b/interp/constrexpr_ops.ml
@@ -0,0 +1,345 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+open Util
+open Names
+open Libnames
+open Constrexpr
+open Misctypes
+open Decl_kinds
+
+(***********************)
+(* For binders parsing *)
+
+let binding_kind_eq bk1 bk2 = match bk1, bk2 with
+| Explicit, Explicit -> true
+| Implicit, Implicit -> true
+| _ -> false
+
+let abstraction_kind_eq ak1 ak2 = match ak1, ak2 with
+| AbsLambda, AbsLambda -> true
+| AbsPi, AbsPi -> true
+| _ -> false
+
+let binder_kind_eq b1 b2 = match b1, b2 with
+| Default bk1, Default bk2 -> binding_kind_eq bk1 bk2
+| Generalized (bk1, ck1, b1), Generalized (bk2, ck2, b2) ->
+  binding_kind_eq bk1 bk2 && binding_kind_eq ck1 ck2 &&
+  (if b1 then b2 else not b2)
+| _ -> false
+
+let default_binder_kind = Default Explicit
+
+let names_of_local_assums bl =
+  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|_->[]) bl)
+
+let names_of_local_binders bl =
+  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|LocalRawDef(l,_)->[l]) bl)
+
+(**********************************************************************)
+(* Functions on constr_expr *)
+
+let prim_token_eq t1 t2 = match t1, t2 with
+| Numeral i1, Numeral i2 -> Bigint.equal i1 i2
+| String s1, String s2 -> String.equal s1 s2
+| _ -> false
+
+let explicitation_eq ex1 ex2 = match ex1, ex2 with
+| ExplByPos (i1, id1), ExplByPos (i2, id2) ->
+  Int.equal i1 i2 && Option.equal Id.equal id1 id2
+| ExplByName id1, ExplByName id2 ->
+  Id.equal id1 id2
+| _ -> false
+
+let eq_located f (_, x) (_, y) = f x y
+
+let rec cases_pattern_expr_eq p1 p2 =
+  if p1 == p2 then true
+  else match p1, p2 with
+  | CPatAlias(_,a1,i1), CPatAlias(_,a2,i2) ->
+      Id.equal i1 i2 && cases_pattern_expr_eq a1 a2
+  | CPatCstr(_,c1,a1,b1), CPatCstr(_,c2,a2,b2) ->
+      eq_reference c1 c2 &&
+      List.equal cases_pattern_expr_eq a1 a2 &&
+      List.equal cases_pattern_expr_eq b1 b2
+  | CPatAtom(_,r1), CPatAtom(_,r2) ->
+      Option.equal eq_reference r1 r2
+  | CPatOr (_, a1), CPatOr (_, a2) ->
+      List.equal cases_pattern_expr_eq a1 a2
+  | CPatNotation (_, n1, s1, l1), CPatNotation (_, n2, s2, l2) ->
+    String.equal n1 n2 &&
+    cases_pattern_notation_substitution_eq s1 s2 &&
+    List.equal cases_pattern_expr_eq l1 l2
+  | CPatPrim(_,i1), CPatPrim(_,i2) ->
+      prim_token_eq i1 i2
+  | CPatRecord (_, l1), CPatRecord (_, l2) ->
+      let equal (r1, e1) (r2, e2) =
+        eq_reference r1 r2 && cases_pattern_expr_eq e1 e2
+      in
+      List.equal equal l1 l2
+  | CPatDelimiters(_,s1,e1), CPatDelimiters(_,s2,e2) ->
+      String.equal s1 s2 && cases_pattern_expr_eq e1 e2
+  | _ -> false
+
+and cases_pattern_notation_substitution_eq (s1, n1) (s2, n2) =
+  List.equal cases_pattern_expr_eq s1 s2 &&
+  List.equal (List.equal cases_pattern_expr_eq) n1 n2
+
+let eq_universes u1 u2 =
+  match u1, u2 with
+  | None, None -> true
+  | Some l, Some l' -> l = l'
+  | _, _ -> false
+
+let rec constr_expr_eq e1 e2 =
+  if e1 == e2 then true
+  else match e1, e2 with
+  | CRef (r1,u1), CRef (r2,u2) -> eq_reference r1 r2 && eq_universes u1 u2
+  | CFix(_,id1,fl1), CFix(_,id2,fl2) ->
+      eq_located Id.equal id1 id2 &&
+      List.equal fix_expr_eq fl1 fl2
+  | CCoFix(_,id1,fl1), CCoFix(_,id2,fl2) ->
+      eq_located Id.equal id1 id2 &&
+      List.equal cofix_expr_eq fl1 fl2
+  | CProdN(_,bl1,a1), CProdN(_,bl2,a2) ->
+      List.equal binder_expr_eq bl1 bl2 &&
+      constr_expr_eq a1 a2
+  | CLambdaN(_,bl1,a1), CLambdaN(_,bl2,a2) ->
+      List.equal binder_expr_eq bl1 bl2 &&
+      constr_expr_eq a1 a2
+  | CLetIn(_,(_,na1),a1,b1), CLetIn(_,(_,na2),a2,b2) ->
+      Name.equal na1 na2 &&
+      constr_expr_eq a1 a2 &&
+      constr_expr_eq b1 b2
+  | CAppExpl(_,(proj1,r1,_),al1), CAppExpl(_,(proj2,r2,_),al2) ->
+      Option.equal Int.equal proj1 proj2 &&
+      eq_reference r1 r2 &&
+      List.equal constr_expr_eq al1 al2
+  | CApp(_,(proj1,e1),al1), CApp(_,(proj2,e2),al2) ->
+      Option.equal Int.equal proj1 proj2 &&
+      constr_expr_eq e1 e2 &&
+      List.equal args_eq al1 al2
+  | CRecord (_, e1, l1), CRecord (_, e2, l2) ->
+    let field_eq (r1, e1) (r2, e2) =
+      eq_reference r1 r2 && constr_expr_eq e1 e2
+    in
+    Option.equal constr_expr_eq e1 e2 &&
+    List.equal field_eq l1 l2
+  | CCases(_,_,r1,a1,brl1), CCases(_,_,r2,a2,brl2) ->
+      (** Don't care about the case_style *)
+      Option.equal constr_expr_eq r1 r2 &&
+      List.equal case_expr_eq a1 a2 &&
+      List.equal branch_expr_eq brl1 brl2
+  | CLetTuple (_, n1, (m1, e1), t1, b1), CLetTuple (_, n2, (m2, e2), t2, b2) ->
+    List.equal (eq_located Name.equal) n1 n2 &&
+    Option.equal (eq_located Name.equal) m1 m2 &&
+    Option.equal constr_expr_eq e1 e2 &&
+    constr_expr_eq t1 t2 &&
+    constr_expr_eq b1 b2
+  | CIf (_, e1, (n1, r1), t1, f1), CIf (_, e2, (n2, r2), t2, f2) ->
+    constr_expr_eq e1 e2 &&
+    Option.equal (eq_located Name.equal) n1 n2 &&
+    Option.equal constr_expr_eq r1 r2 &&
+    constr_expr_eq t1 t2 &&
+    constr_expr_eq f1 f2
+  | CHole _, CHole _ -> true
+  | CPatVar(_,i1), CPatVar(_,i2) ->
+    Id.equal i1 i2
+  | CEvar (_, id1, c1), CEvar (_, id2, c2) ->
+    Id.equal id1 id2 && List.equal instance_eq c1 c2
+  | CSort(_,s1), CSort(_,s2) ->
+    Miscops.glob_sort_eq s1 s2
+  | CCast(_,a1,(CastConv b1|CastVM b1)), CCast(_,a2,(CastConv b2|CastVM b2)) ->
+      constr_expr_eq a1 a2 &&
+      constr_expr_eq b1 b2
+  | CCast(_,a1,CastCoerce), CCast(_,a2, CastCoerce) ->
+      constr_expr_eq a1 a2
+  | CNotation(_, n1, s1), CNotation(_, n2, s2) ->
+      String.equal n1 n2 &&
+      constr_notation_substitution_eq s1 s2
+  | CPrim(_,i1), CPrim(_,i2) ->
+    prim_token_eq i1 i2
+  | CGeneralization (_, bk1, ak1, e1), CGeneralization (_, bk2, ak2, e2) ->
+    binding_kind_eq bk1 bk2 &&
+    Option.equal abstraction_kind_eq ak1 ak2 &&
+    constr_expr_eq e1 e2
+  | CDelimiters(_,s1,e1), CDelimiters(_,s2,e2) ->
+    String.equal s1 s2 &&
+    constr_expr_eq e1 e2
+  | _ -> false
+
+and args_eq (a1,e1) (a2,e2) =
+  Option.equal (eq_located explicitation_eq) e1 e2 &&
+  constr_expr_eq a1 a2
+
+and case_expr_eq (e1, (n1, p1)) (e2, (n2, p2)) =
+  constr_expr_eq e1 e2 &&
+  Option.equal (eq_located Name.equal) n1 n2 &&
+  Option.equal cases_pattern_expr_eq p1 p2
+
+and branch_expr_eq (_, p1, e1) (_, p2, e2) =
+  List.equal (eq_located (List.equal cases_pattern_expr_eq)) p1 p2 &&
+  constr_expr_eq e1 e2
+
+and binder_expr_eq ((n1, _, e1) : binder_expr) (n2, _, e2) =
+  (** Don't care about the [binder_kind] *)
+  List.equal (eq_located Name.equal) n1 n2 && constr_expr_eq e1 e2
+
+and fix_expr_eq (id1,(j1, r1),bl1,a1,b1) (id2,(j2, r2),bl2,a2,b2) =
+  (eq_located Id.equal id1 id2) &&
+  Option.equal (eq_located Id.equal) j1 j2 &&
+  recursion_order_expr_eq r1 r2 &&
+  List.equal local_binder_eq bl1 bl2 &&
+  constr_expr_eq a1 a2 &&
+  constr_expr_eq b1 b2
+
+and cofix_expr_eq (id1,bl1,a1,b1) (id2,bl2,a2,b2) =
+  (eq_located Id.equal id1 id2) &&
+  List.equal local_binder_eq bl1 bl2 &&
+  constr_expr_eq a1 a2 &&
+  constr_expr_eq b1 b2
+
+and recursion_order_expr_eq r1 r2 = match r1, r2 with
+| CStructRec, CStructRec -> true
+| CWfRec e1, CWfRec e2 -> constr_expr_eq e1 e2
+| CMeasureRec (e1, o1), CMeasureRec (e2, o2) ->
+  constr_expr_eq e1 e2 && Option.equal constr_expr_eq o1 o2
+| _ -> false
+
+and local_binder_eq l1 l2 = match l1, l2 with
+| LocalRawDef (n1, e1), LocalRawDef (n2, e2) ->
+  eq_located Name.equal n1 n2 && constr_expr_eq e1 e2
+| LocalRawAssum (n1, _, e1), LocalRawAssum (n2, _, e2) ->
+  (** Don't care about the [binder_kind] *)
+  List.equal (eq_located Name.equal) n1 n2 && constr_expr_eq e1 e2
+| _ -> false
+
+and constr_notation_substitution_eq (e1, el1, bl1) (e2, el2, bl2) =
+  List.equal constr_expr_eq e1 e2 &&
+  List.equal (List.equal constr_expr_eq) el1 el2 &&
+  List.equal (List.equal local_binder_eq) bl1 bl2
+
+and instance_eq (x1,c1) (x2,c2) =
+  Id.equal x1 x2 && constr_expr_eq c1 c2
+
+let constr_loc = function
+  | CRef (Ident (loc,_),_) -> loc
+  | CRef (Qualid (loc,_),_) -> loc
+  | CFix (loc,_,_) -> loc
+  | CCoFix (loc,_,_) -> loc
+  | CProdN (loc,_,_) -> loc
+  | CLambdaN (loc,_,_) -> loc
+  | CLetIn (loc,_,_,_) -> loc
+  | CAppExpl (loc,_,_) -> loc
+  | CApp (loc,_,_) -> loc
+  | CRecord (loc,_,_) -> loc
+  | CCases (loc,_,_,_,_) -> loc
+  | CLetTuple (loc,_,_,_,_) -> loc
+  | CIf (loc,_,_,_,_) -> loc
+  | CHole (loc,_,_,_) -> loc
+  | CPatVar (loc,_) -> loc
+  | CEvar (loc,_,_) -> loc
+  | CSort (loc,_) -> loc
+  | CCast (loc,_,_) -> loc
+  | CNotation (loc,_,_) -> loc
+  | CGeneralization (loc,_,_,_) -> loc
+  | CPrim (loc,_) -> loc
+  | CDelimiters (loc,_,_) -> loc
+
+let cases_pattern_expr_loc = function
+  | CPatAlias (loc,_,_) -> loc
+  | CPatCstr (loc,_,_,_) -> loc
+  | CPatAtom (loc,_) -> loc
+  | CPatOr (loc,_) -> loc
+  | CPatNotation (loc,_,_,_) -> loc
+  | CPatRecord (loc, _) -> loc
+  | CPatPrim (loc,_) -> loc
+  | CPatDelimiters (loc,_,_) -> loc
+
+let raw_cases_pattern_expr_loc = function
+  | RCPatAlias (loc,_,_) -> loc
+  | RCPatCstr (loc,_,_,_) -> loc
+  | RCPatAtom (loc,_) -> loc
+  | RCPatOr (loc,_) -> loc
+
+let local_binder_loc = function
+  | LocalRawAssum ((loc,_)::_,_,t)
+  | LocalRawDef ((loc,_),t) -> Loc.merge loc (constr_loc t)
+  | LocalRawAssum ([],_,_) -> assert false
+
+let local_binders_loc bll = match bll with
+  | [] -> Loc.ghost
+  | h :: l ->
+    Loc.merge (local_binder_loc h) (local_binder_loc (List.last bll))
+
+(** Pseudo-constructors *)
+
+let mkIdentC id  = CRef (Ident (Loc.ghost, id),None)
+let mkRefC r     = CRef (r,None)
+let mkCastC (a,k)  = CCast (Loc.ghost,a,k)
+let mkLambdaC (idl,bk,a,b) = CLambdaN (Loc.ghost,[idl,bk,a],b)
+let mkLetInC (id,a,b)   = CLetIn (Loc.ghost,id,a,b)
+let mkProdC (idl,bk,a,b)   = CProdN (Loc.ghost,[idl,bk,a],b)
+
+let mkAppC (f,l) =
+  let l = List.map (fun x -> (x,None)) l in
+  match f with
+  | CApp (_,g,l') -> CApp (Loc.ghost, g, l' @ l)
+  | _ -> CApp (Loc.ghost, (None, f), l)
+
+let rec mkCProdN loc bll c =
+  match bll with
+  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
+      CProdN (loc,[idl,bk,t],mkCProdN (Loc.merge loc1 loc) bll c)
+  | LocalRawDef ((loc1,_) as id,b) :: bll ->
+      CLetIn (loc,id,b,mkCProdN (Loc.merge loc1 loc) bll c)
+  | [] -> c
+  | LocalRawAssum ([],_,_) :: bll -> mkCProdN loc bll c
+
+let rec mkCLambdaN loc bll c =
+  match bll with
+  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
+      CLambdaN (loc,[idl,bk,t],mkCLambdaN (Loc.merge loc1 loc) bll c)
+  | LocalRawDef ((loc1,_) as id,b) :: bll ->
+      CLetIn (loc,id,b,mkCLambdaN (Loc.merge loc1 loc) bll c)
+  | [] -> c
+  | LocalRawAssum ([],_,_) :: bll -> mkCLambdaN loc bll c
+
+let rec abstract_constr_expr c = function
+  | [] -> c
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
+  | LocalRawAssum (idl,bk,t)::bl ->
+      List.fold_right (fun x b -> mkLambdaC([x],bk,t,b)) idl
+      (abstract_constr_expr c bl)
+
+let rec prod_constr_expr c = function
+  | [] -> c
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,prod_constr_expr c bl)
+  | LocalRawAssum (idl,bk,t)::bl ->
+      List.fold_right (fun x b -> mkProdC([x],bk,t,b)) idl
+      (prod_constr_expr c bl)
+
+let coerce_reference_to_id = function
+  | Ident (_,id) -> id
+  | Qualid (loc,_) ->
+      Errors.user_err_loc (loc, "coerce_reference_to_id",
+        str "This expression should be a simple identifier.")
+
+let coerce_to_id = function
+  | CRef (Ident (loc,id),_) -> (loc,id)
+  | a -> Errors.user_err_loc
+        (constr_loc a,"coerce_to_id",
+         str "This expression should be a simple identifier.")
+
+let coerce_to_name = function
+  | CRef (Ident (loc,id),_) -> (loc,Name id)
+  | CHole (loc,_,_,_) -> (loc,Anonymous)
+  | a -> Errors.user_err_loc
+        (constr_loc a,"coerce_to_name",
+         str "This expression should be a name.")
diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli
new file mode 100644
index 00000000..10c84b8d
--- /dev/null
+++ b/interp/constrexpr_ops.mli
@@ -0,0 +1,81 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Loc
+open Names
+open Libnames
+open Misctypes
+open Constrexpr
+
+(** Constrexpr_ops: utilities on [constr_expr] *)
+
+(** {6 Equalities on [constr_expr] related types} *)
+
+val explicitation_eq : explicitation -> explicitation -> bool
+(** Equality on [explicitation]. *)
+
+val constr_expr_eq : constr_expr -> constr_expr -> bool
+(** Equality on [constr_expr]. This is a syntactical one, which is oblivious to
+    some parsing details, including locations. *)
+
+val local_binder_eq : local_binder -> local_binder -> bool
+(** Equality on [local_binder]. Same properties as [constr_expr_eq]. *)
+
+val binding_kind_eq : Decl_kinds.binding_kind -> Decl_kinds.binding_kind -> bool
+(** Equality on [binding_kind] *)
+
+val binder_kind_eq : binder_kind -> binder_kind -> bool
+(** Equality on [binder_kind] *)
+
+(** {6 Retrieving locations} *)
+
+val constr_loc : constr_expr -> Loc.t
+val cases_pattern_expr_loc : cases_pattern_expr -> Loc.t
+val raw_cases_pattern_expr_loc : raw_cases_pattern_expr -> Loc.t
+val local_binders_loc : local_binder list -> Loc.t
+
+(** {6 Constructors}*)
+
+val mkIdentC : Id.t -> constr_expr
+val mkRefC : reference -> constr_expr
+val mkAppC : constr_expr * constr_expr list -> constr_expr
+val mkCastC : constr_expr * constr_expr cast_type -> constr_expr
+val mkLambdaC : Name.t located list * binder_kind * constr_expr * constr_expr -> constr_expr
+val mkLetInC : Name.t located * constr_expr * constr_expr -> constr_expr
+val mkProdC : Name.t located list * binder_kind * constr_expr * constr_expr -> constr_expr
+
+val abstract_constr_expr : constr_expr -> local_binder list -> constr_expr
+val prod_constr_expr : constr_expr -> local_binder list -> constr_expr
+
+val mkCLambdaN : Loc.t -> local_binder list -> constr_expr -> constr_expr
+(** Same as [abstract_constr_expr], with location *)
+
+val mkCProdN : Loc.t -> local_binder list -> constr_expr -> constr_expr
+(** Same as [prod_constr_expr], with location *)
+
+(** {6 Destructors}*)
+
+val coerce_reference_to_id : reference -> Id.t
+(** FIXME: nothing to do here *)
+
+val coerce_to_id : constr_expr -> Id.t located
+(** Destruct terms of the form [CRef (Ident _)]. *)
+
+val coerce_to_name : constr_expr -> Name.t located
+(** Destruct terms of the form [CRef (Ident _)] or [CHole _]. *)
+
+(** {6 Binder manipulation} *)
+
+val default_binder_kind : binder_kind
+
+val names_of_local_binders : local_binder list -> Name.t located list
+(** Retrieve a list of binding names from a list of binders. *)
+
+val names_of_local_assums : local_binder list -> Name.t located list
+(** Same as [names_of_local_binders], but does not take the [let] bindings into
+    account. *)
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 911d3741..58e1eb1d 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,25 +8,27 @@
 
 (*i*)
 open Pp
+open Errors
 open Util
-open Univ
 open Names
 open Nameops
 open Term
 open Termops
-open Namegen
-open Inductive
-open Sign
-open Environ
 open Libnames
+open Globnames
 open Impargs
+open Constrexpr
+open Constrexpr_ops
+open Notation_ops
 open Topconstr
 open Glob_term
+open Glob_ops
 open Pattern
 open Nametab
 open Notation
-open Reserve
 open Detyping
+open Misctypes
+open Decl_kinds
 (*i*)
 
 (* Translation from glob_constr to front constr *)
@@ -37,8 +39,8 @@ open Detyping
 (* This governs printing of local context of references *)
 let print_arguments = ref false
 
-(* If true, prints local context of evars, whatever print_arguments *)
-let print_evar_arguments = ref false
+(* If true, prints local context of evars *)
+let print_evar_arguments = Detyping.print_evar_arguments
 
 (* This governs printing of implicit arguments.  When
    [print_implicits] is on then [print_implicits_explicit_args] tells
@@ -56,11 +58,14 @@ let print_implicits_defensive = ref true
 let print_coercions = ref false
 
 (* This forces printing universe names of Type{.} *)
-let print_universes = ref false
+let print_universes = Detyping.print_universes
 
-(* This suppresses printing of primitive tokens (e.g. numeral) and symbols *)
+(* This suppresses printing of primitive tokens (e.g. numeral) and notations *)
 let print_no_symbol = ref false
 
+(* This tells which notations still not to used if print_no_symbol is true *)
+let print_non_active_notations = ref ([] : interp_rule list)
+
 (* This governs printing of projections using the dot notation symbols *)
 let print_projections = ref false
 
@@ -70,8 +75,10 @@ let with_arguments f = Flags.with_option print_arguments f
 let with_implicits f = Flags.with_option print_implicits f
 let with_coercions f = Flags.with_option print_coercions f
 let with_universes f = Flags.with_option print_universes f
-let without_symbols f = Flags.with_option print_no_symbol f
 let with_meta_as_hole f = Flags.with_option print_meta_as_hole f
+let without_symbols f = Flags.with_option print_no_symbol f
+let without_specific_symbols l f =
+  Flags.with_extra_values print_non_active_notations l f
 
 (**********************************************************************)
 (* Control printing of records *)
@@ -121,7 +128,7 @@ module PrintingConstructor = Goptions.MakeRefTable(PrintingRecordConstructor)
 
 let insert_delimiters e = function
   | None -> e
-  | Some sc -> CDelimiters (dummy_loc,sc,e)
+  | Some sc -> CDelimiters (Loc.ghost,sc,e)
 
 let insert_pat_delimiters loc p = function
   | None -> p
@@ -134,8 +141,7 @@ let insert_pat_alias loc p = function
 (**********************************************************************)
 (* conversion of references                                           *)
 
-let extern_evar loc n l =
-  if !print_evar_arguments then CEvar (loc,n,l) else CEvar (loc,n,None)
+let extern_evar loc n l = CEvar (loc,n,l)
 
 (** We allow customization of the global_reference printer.
     For instance, in the debugger the tables of global references
@@ -151,124 +157,44 @@ let get_extern_reference () = !my_extern_reference
 
 let extern_reference loc vars l = !my_extern_reference loc vars l
 
-let in_debugger = ref false
-
-
-(************************************************************************)
-(* Equality up to location (useful for translator v8) *)
-
-let rec check_same_pattern p1 p2 =
-  match p1, p2 with
-    | CPatAlias(_,a1,i1), CPatAlias(_,a2,i2) when i1=i2 ->
-        check_same_pattern a1 a2
-    | CPatCstr(_,c1,a1), CPatCstr(_,c2,a2) when c1=c2 ->
-        List.iter2 check_same_pattern a1 a2
-    | CPatCstrExpl(_,c1,a1), CPatCstrExpl(_,c2,a2) when c1=c2 ->
-        List.iter2 check_same_pattern a1 a2
-    | CPatAtom(_,r1), CPatAtom(_,r2) when r1=r2 -> ()
-    | CPatPrim(_,i1), CPatPrim(_,i2) when i1=i2 -> ()
-    | CPatDelimiters(_,s1,e1), CPatDelimiters(_,s2,e2) when s1=s2 ->
-        check_same_pattern e1 e2
-    | _ -> failwith "not same pattern"
-
-let check_same_ref r1 r2 =
-  match r1,r2 with
-  | Qualid(_,q1), Qualid(_,q2) when q1=q2 -> ()
-  | Ident(_,i1), Ident(_,i2) when i1=i2 -> ()
-  | _ -> failwith "not same ref"
-
-let rec check_same_type ty1 ty2 =
-  match ty1, ty2 with
-  | CRef r1, CRef r2 -> check_same_ref r1 r2
-  | CFix(_,(_,id1),fl1), CFix(_,(_,id2),fl2) when id1=id2 ->
-      List.iter2 (fun (id1,i1,bl1,a1,b1) (id2,i2,bl2,a2,b2) ->
-        if id1<>id2 || i1<>i2 then failwith "not same fix";
-        check_same_fix_binder bl1 bl2;
-        check_same_type a1 a2;
-        check_same_type b1 b2)
-        fl1 fl2
-  | CCoFix(_,(_,id1),fl1), CCoFix(_,(_,id2),fl2) when id1=id2 ->
-      List.iter2 (fun (id1,bl1,a1,b1) (id2,bl2,a2,b2) ->
-        if id1<>id2 then failwith "not same fix";
-        check_same_fix_binder bl1 bl2;
-        check_same_type a1 a2;
-        check_same_type b1 b2)
-        fl1 fl2
-  | CArrow(_,a1,b1), CArrow(_,a2,b2) ->
-      check_same_type a1 a2;
-      check_same_type b1 b2
-  | CProdN(_,bl1,a1), CProdN(_,bl2,a2) ->
-      List.iter2 check_same_binder bl1 bl2;
-      check_same_type a1 a2
-  | CLambdaN(_,bl1,a1), CLambdaN(_,bl2,a2) ->
-      List.iter2 check_same_binder bl1 bl2;
-      check_same_type a1 a2
-  | CLetIn(_,(_,na1),a1,b1), CLetIn(_,(_,na2),a2,b2) when na1=na2 ->
-      check_same_type a1 a2;
-      check_same_type b1 b2
-  | CAppExpl(_,(proj1,r1),al1), CAppExpl(_,(proj2,r2),al2) when proj1=proj2 ->
-      check_same_ref r1 r2;
-      List.iter2 check_same_type al1 al2
-  | CApp(_,(_,e1),al1), CApp(_,(_,e2),al2) ->
-      check_same_type e1 e2;
-      List.iter2 (fun (a1,e1) (a2,e2) ->
-                    if e1<>e2 then failwith "not same expl";
-                    check_same_type a1 a2) al1 al2
-  | CCases(_,_,_,a1,brl1), CCases(_,_,_,a2,brl2) ->
-      List.iter2 (fun (tm1,_) (tm2,_) -> check_same_type tm1 tm2) a1 a2;
-      List.iter2 (fun (_,pl1,r1) (_,pl2,r2) ->
-        List.iter2 (located_iter2 (List.iter2 check_same_pattern)) pl1 pl2;
-        check_same_type r1 r2) brl1 brl2
-  | CHole _, CHole _ -> ()
-  | CPatVar(_,i1), CPatVar(_,i2) when i1=i2 -> ()
-  | CSort(_,s1), CSort(_,s2) when s1=s2 -> ()
-  | CCast(_,a1,CastConv (_,b1)), CCast(_,a2, CastConv(_,b2)) ->
-      check_same_type a1 a2;
-      check_same_type b1 b2
-  | CCast(_,a1,CastCoerce), CCast(_,a2, CastCoerce) ->
-      check_same_type a1 a2
-  | CNotation(_,n1,(e1,el1,bl1)), CNotation(_,n2,(e2,el2,bl2)) when n1=n2 ->
-      List.iter2 check_same_type e1 e2;
-      List.iter2 (List.iter2 check_same_type) el1 el2;
-      List.iter2 check_same_fix_binder bl1 bl2
-  | CPrim(_,i1), CPrim(_,i2) when i1=i2 -> ()
-  | CDelimiters(_,s1,e1), CDelimiters(_,s2,e2) when s1=s2 ->
-      check_same_type e1 e2
-  | _ when ty1=ty2 -> ()
-  | _ -> failwith "not same type"
-
-and check_same_binder (nal1,_,e1) (nal2,_,e2) =
-  List.iter2 (fun (_,na1) (_,na2) ->
-    if na1<>na2 then failwith "not same name") nal1 nal2;
-  check_same_type e1 e2
-
-and check_same_fix_binder bl1 bl2 =
-  List.iter2 (fun b1 b2 ->
-    match b1,b2 with
-        LocalRawAssum(nal1,k,ty1), LocalRawAssum(nal2,k',ty2) ->
-          check_same_binder (nal1,k,ty1) (nal2,k',ty2)
-      | LocalRawDef(na1,def1), LocalRawDef(na2,def2) ->
-          check_same_binder ([na1],default_binder_kind,def1) ([na2],default_binder_kind,def2)
-      | _ -> failwith "not same binder") bl1 bl2
-
-let is_same_type c d =
-  try let () = check_same_type c d in true
-  with Failure _ | Invalid_argument _ -> false
-
 (**********************************************************************)
 (* mapping patterns to cases_pattern_expr                                *)
 
+let add_patt_for_params ind l =
+  if !Flags.in_debugger then l else
+    Util.List.addn (Inductiveops.inductive_nparamdecls ind) (CPatAtom (Loc.ghost,None)) l
+
+let drop_implicits_in_patt cst nb_expl args =
+  let impl_st = (implicits_of_global cst) in
+  let impl_data = extract_impargs_data impl_st in
+  let rec impls_fit l = function
+    |[],t -> Some (List.rev_append l t)
+    |_,[] -> None
+    |h::t,CPatAtom(_,None)::tt when is_status_implicit h -> impls_fit l (t,tt)
+    |h::_,_ when is_status_implicit h -> None
+    |_::t,hh::tt -> impls_fit (hh::l) (t,tt)
+  in let rec aux = function
+    |[] -> None
+    |(_,imps)::t -> match impls_fit [] (imps,args) with
+	|None -> aux t
+	|x -> x
+     in
+     if Int.equal nb_expl 0 then aux impl_data
+     else
+       let imps = List.skipn_at_least nb_expl (select_stronger_impargs impl_st) in
+       impls_fit [] (imps,args)
+
 let has_curly_brackets ntn =
-  String.length ntn >= 6 & (String.sub ntn 0 6 = "{ _ } " or
-    String.sub ntn (String.length ntn - 6) 6 = " { _ }" or
-    string_string_contains ~where:ntn ~what:" { _ } ")
+  String.length ntn >= 6 && (String.is_sub "{ _ } " ntn 0 ||
+    String.is_sub " { _ }" ntn (String.length ntn - 6) ||
+    String.string_contains ~where:ntn ~what:" { _ } ")
 
 let rec wildcards ntn n =
-  if n = String.length ntn then []
-  else let l = spaces ntn (n+1) in if ntn.[n] = '_' then n::l else l
+  if Int.equal n (String.length ntn) then []
+  else let l = spaces ntn (n+1) in if ntn.[n] == '_' then n::l else l
 and spaces ntn n =
-  if n = String.length ntn then []
-  else if ntn.[n] = ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
+  if Int.equal n (String.length ntn) then []
+  else if ntn.[n] == ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
 
 let expand_curly_brackets loc mknot ntn l =
   let ntn' = ref ntn in
@@ -278,7 +204,7 @@ let expand_curly_brackets loc mknot ntn l =
     | a::l ->
         let a' =
           let p = List.nth (wildcards !ntn' 0) i - 2 in
-          if p>=0 & p+5 <= String.length !ntn' & String.sub !ntn' p 5 = "{ _ }"
+          if p>=0 && p+5 <= String.length !ntn' && String.is_sub "{ _ }" !ntn' p
           then begin
             ntn' :=
               String.sub !ntn' 0 p ^ "_" ^
@@ -304,128 +230,199 @@ let make_notation_gen loc ntn mknot mkprim destprim l =
 	match decompose_notation_key ntn, l with
 	| [Terminal "-"; Terminal x], [] ->
 	    (try mkprim (loc, Numeral (Bigint.neg (Bigint.of_string x)))
-	     with e when Errors.noncritical e -> mknot (loc,ntn,[]))
+	     with Failure _ -> mknot (loc,ntn,[]))
 	| [Terminal x], [] ->
 	    (try mkprim (loc, Numeral (Bigint.of_string x))
-	     with e when Errors.noncritical e -> mknot (loc,ntn,[]))
+	     with Failure _ -> mknot (loc,ntn,[]))
 	| _ ->
 	    mknot (loc,ntn,l)
 
 let make_notation loc ntn (terms,termlists,binders as subst) =
-  if termlists <> [] or binders <> [] then CNotation (loc,ntn,subst) else
-  make_notation_gen loc ntn
-    (fun (loc,ntn,l) -> CNotation (loc,ntn,(l,[],[])))
-    (fun (loc,p) -> CPrim (loc,p))
-    destPrim terms
+  if not (List.is_empty termlists) || not (List.is_empty binders) then
+    CNotation (loc,ntn,subst)
+  else
+    make_notation_gen loc ntn
+      (fun (loc,ntn,l) -> CNotation (loc,ntn,(l,[],[])))
+      (fun (loc,p) -> CPrim (loc,p))
+      destPrim terms
 
-let make_pat_notation loc ntn (terms,termlists as subst) =
-  if termlists <> [] then CPatNotation (loc,ntn,subst) else
+let make_pat_notation loc ntn (terms,termlists as subst) args =
+  if not (List.is_empty termlists) then CPatNotation (loc,ntn,subst,args) else
   make_notation_gen loc ntn
-    (fun (loc,ntn,l) -> CPatNotation (loc,ntn,(l,[])))
+    (fun (loc,ntn,l) -> CPatNotation (loc,ntn,(l,[]),args))
     (fun (loc,p) -> CPatPrim (loc,p))
     destPatPrim terms
 
 let mkPat loc qid l =
   (* Normally irrelevant test with v8 syntax, but let's do it anyway *)
-  if l = [] then CPatAtom (loc,Some qid) else CPatCstr (loc,qid,l)
+  if List.is_empty l then CPatAtom (loc,Some qid) else CPatCstr (loc,qid,[],l)
+
+let pattern_printable_in_both_syntax (ind,_ as c) =
+  let impl_st = extract_impargs_data (implicits_of_global (ConstructRef c)) in
+  let nb_params = Inductiveops.inductive_nparams ind in
+  List.exists (fun (_,impls) ->
+    (List.length impls >= nb_params) &&
+      let params,args = Util.List.chop nb_params impls in
+      (List.for_all is_status_implicit params)&&(List.for_all (fun x -> not (is_status_implicit x)) args)
+  ) impl_st
 
  (* Better to use extern_glob_constr composed with injection/retraction ?? *)
 let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat =
+  (* pboutill: There are letins in pat which is incompatible with notations and
+     not explicit application. *)
+  match pat with
+    | PatCstr(loc,cstrsp,args,na)
+	when !Flags.in_debugger||Inductiveops.constructor_has_local_defs cstrsp ->
+      let c = extern_reference loc Id.Set.empty (ConstructRef cstrsp) in
+      let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
+      CPatCstr (loc, c, add_patt_for_params (fst cstrsp) args, [])
+    | _ ->
   try
-    if !Flags.raw_print or !print_no_symbol then raise No_match;
+    if !Flags.raw_print || !print_no_symbol then raise No_match;
     let (na,sc,p) = uninterp_prim_token_cases_pattern pat in
     match availability_of_prim_token p sc scopes with
-    | None -> raise No_match
-    | Some key ->
-      let loc = cases_pattern_loc pat in
-      insert_pat_alias loc (insert_pat_delimiters loc (CPatPrim(loc,p)) key) na
-  with No_match ->
-  try
-    if !Flags.raw_print or !print_no_symbol then raise No_match;
-    extern_symbol_pattern scopes vars pat
-      (uninterp_cases_pattern_notations pat)
+      | None -> raise No_match
+      | Some key ->
+	let loc = cases_pattern_loc pat in
+	insert_pat_alias loc (insert_pat_delimiters loc (CPatPrim(loc,p)) key) na
   with No_match ->
-  match pat with
-  | PatVar (loc,Name id) -> CPatAtom (loc,Some (Ident (loc,id)))
-  | PatVar (loc,Anonymous) -> CPatAtom (loc, None)
-  | PatCstr(loc,cstrsp,args,na) ->
-      let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
-      let p =
-	try
-          if !in_debugger || !Flags.raw_print then raise Exit;
-	  let projs = Recordops.lookup_projections (fst cstrsp) in
-	  let rec ip projs args acc =
-	    match projs with
-	      | [] -> acc
-	      | None :: q -> ip q args acc
-	      | Some c :: q ->
-		  match args with
-		    | [] -> raise No_match
-		    | CPatAtom(_, None) :: tail -> ip q tail acc
-			(* we don't want to have 'x = _' in our patterns *)
-		    | head :: tail -> ip q tail
-		        ((extern_reference loc Idset.empty (ConstRef c), head) :: acc)
+    try
+      if !Flags.raw_print || !print_no_symbol then raise No_match;
+      extern_symbol_pattern scopes vars pat
+	(uninterp_cases_pattern_notations pat)
+    with No_match ->
+      match pat with
+	| PatVar (loc,Name id) -> CPatAtom (loc,Some (Ident (loc,id)))
+	| PatVar (loc,Anonymous) -> CPatAtom (loc, None)
+	| PatCstr(loc,cstrsp,args,na) ->
+	  let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
+	  let p =
+	    try
+              if !Flags.raw_print then raise Exit;
+	      let projs = Recordops.lookup_projections (fst cstrsp) in
+	      let rec ip projs args acc =
+		match projs with
+		  | [] -> acc
+		  | None :: q -> ip q args acc
+		  | Some c :: q ->
+		    match args with
+		      | [] -> raise No_match
+		      | CPatAtom(_, None) :: tail -> ip q tail acc
+		    (* we don't want to have 'x = _' in our patterns *)
+		      | head :: tail -> ip q tail
+		        ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
+	      in
+	      CPatRecord(loc, List.rev (ip projs args []))
+	    with
+		Not_found | No_match | Exit ->
+                  let c = extern_reference loc Id.Set.empty (ConstructRef cstrsp) in
+		  if !Topconstr.oldfashion_patterns then
+		    if pattern_printable_in_both_syntax cstrsp
+		    then CPatCstr (loc, c, [], args)
+		    else CPatCstr (loc, c, add_patt_for_params (fst cstrsp) args, [])
+		  else
+		    let full_args = add_patt_for_params (fst cstrsp) args in
+		    match drop_implicits_in_patt (ConstructRef cstrsp) 0 full_args with
+		      |Some true_args -> CPatCstr (loc, c, [], true_args)
+		      |None -> CPatCstr (loc, c, full_args, [])
+	  in insert_pat_alias loc p na
+and apply_notation_to_pattern loc gr ((subst,substlist),(nb_to_drop,more_args))
+    (tmp_scope, scopes as allscopes) vars =
+  function
+    | NotationRule (sc,ntn) ->
+      begin
+	match availability_of_notation (sc,ntn) allscopes with
+	  (* Uninterpretation is not allowed in current context *)
+	  | None -> raise No_match
+	  (* Uninterpretation is allowed in current context *)
+	  | Some (scopt,key) ->
+	    let scopes' = Option.List.cons scopt scopes in
+	    let l =
+	      List.map (fun (c,(scopt,scl)) ->
+		extern_cases_pattern_in_scope (scopt,scl@scopes') vars c)
+		subst in
+	    let ll =
+	      List.map (fun (c,(scopt,scl)) ->
+		let subscope = (scopt,scl@scopes') in
+		List.map (extern_cases_pattern_in_scope subscope vars) c)
+		substlist in
+	    let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
+	    let l2' = if !Topconstr.oldfashion_patterns || not (List.is_empty ll) then l2
+	      else
+		match drop_implicits_in_patt gr nb_to_drop l2 with
+		  |Some true_args -> true_args
+		  |None -> raise No_match
 	    in
-	  CPatRecord(loc, List.rev (ip projs args []))
-	with
-	  Not_found | No_match | Exit ->
-	    CPatCstr (loc, extern_reference loc vars (ConstructRef cstrsp), args) in
-      insert_pat_alias loc p na
-
+	    insert_pat_delimiters loc
+	      (make_pat_notation loc ntn (l,ll) l2') key
+      end
+    | SynDefRule kn ->
+      let qid = Qualid (loc, shortest_qualid_of_syndef vars kn) in
+      let l1 =
+	List.rev_map (fun (c,(scopt,scl)) ->
+          extern_cases_pattern_in_scope (scopt,scl@scopes) vars c)
+          subst in
+      let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
+      let l2' = if !Topconstr.oldfashion_patterns then l2
+	else
+	  match drop_implicits_in_patt gr (nb_to_drop + List.length l1) l2 with
+	    |Some true_args -> true_args
+	    |None -> raise No_match
+      in
+      assert (List.is_empty substlist);
+      mkPat loc qid (List.rev_append l1 l2')
 and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
   | (keyrule,pat,n as _rule)::rules ->
     try
-      match t,n with
-      | PatCstr (loc,(ind,_),l,na), n when (n = Some 0 or n = None or
-	 n = Some(fst(Global.lookup_inductive ind)).Declarations.mind_nparams)
-          && (match keyrule with SynDefRule _ -> true | _ -> false) ->
-        (* Abbreviation for the constructor name only *)
-	(match keyrule with
-        | NotationRule _ -> assert false
-        | SynDefRule kn ->
-	    let qid = Qualid (loc, shortest_qualid_of_syndef vars kn) in
-	    let l = List.map (extern_cases_pattern_in_scope allscopes vars) l in
-	    insert_pat_alias loc (mkPat loc qid l) na)
-      | PatCstr (_,f,l,_), Some n when List.length l > n ->
-	  raise No_match
-      | PatCstr (loc,_,_,na),_ ->
-	(* Try matching ... *)
-	let subst,substlist = match_aconstr_cases_pattern t pat in
-	(* Try availability of interpretation ... *)
-	let p = match keyrule with
-          | NotationRule (sc,ntn) ->
-	      (match availability_of_notation (sc,ntn) allscopes with
-                  (* Uninterpretation is not allowed in current context *)
-              | None -> raise No_match
-                  (* Uninterpretation is allowed in current context *)
-	      | Some (scopt,key) ->
-	          let scopes' = Option.List.cons scopt scopes in
-	          let l =
-		    List.map (fun (c,(scopt,scl)) ->
-		      extern_cases_pattern_in_scope (scopt,scl@scopes') vars c)
-                      subst in
-		  let ll =
-		    List.map (fun (c,(scopt,scl)) ->
-		      let subscope = (scopt,scl@scopes') in
-		      List.map (extern_cases_pattern_in_scope subscope vars) c)
-                      substlist in
-		  insert_pat_delimiters loc
-		    (make_pat_notation loc ntn (l,ll)) key)
-          | SynDefRule kn ->
-	      let qid = Qualid (loc, shortest_qualid_of_syndef vars kn) in
-	      let l =
-		List.map (fun (c,(scopt,scl)) ->
-                  extern_cases_pattern_in_scope (scopt,scl@scopes) vars c) 
-                  subst in
-              assert (substlist = []);
-	      mkPat loc qid l in
-	insert_pat_alias loc p na
-      | PatVar (loc,Anonymous),_ -> CPatAtom (loc, None)
-      | PatVar (loc,Name id),_ -> CPatAtom (loc, Some (Ident (loc,id)))
+      if List.mem keyrule !print_non_active_notations then raise No_match;
+      match t with
+	| PatCstr (loc,cstr,_,na) ->
+	  let p = apply_notation_to_pattern loc (ConstructRef cstr)
+	    (match_notation_constr_cases_pattern t pat) allscopes vars keyrule in
+	  insert_pat_alias loc p na
+	| PatVar (loc,Anonymous) -> CPatAtom (loc, None)
+	| PatVar (loc,Name id) -> CPatAtom (loc, Some (Ident (loc,id)))
     with
 	No_match -> extern_symbol_pattern allscopes vars t rules
 
+let rec extern_symbol_ind_pattern allscopes vars ind args = function
+  | [] -> raise No_match
+  | (keyrule,pat,n as _rule)::rules ->
+    try
+      if List.mem keyrule !print_non_active_notations then raise No_match;
+      apply_notation_to_pattern Loc.ghost (IndRef ind)
+	(match_notation_constr_ind_pattern ind args pat) allscopes vars keyrule
+    with
+	No_match -> extern_symbol_ind_pattern allscopes vars ind args rules
+
+let extern_ind_pattern_in_scope (scopes:local_scopes) vars ind args =
+  (* pboutill: There are letins in pat which is incompatible with notations and
+     not explicit application. *)
+  if !Flags.in_debugger||Inductiveops.inductive_has_local_defs ind then
+    let c = extern_reference Loc.ghost vars (IndRef ind) in
+    let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
+    CPatCstr (Loc.ghost, c, add_patt_for_params ind args, [])
+  else
+    try
+      if !Flags.raw_print || !print_no_symbol then raise No_match;
+      let (sc,p) = uninterp_prim_token_ind_pattern ind args in
+      match availability_of_prim_token p sc scopes with
+	| None -> raise No_match
+	| Some key ->
+	  insert_pat_delimiters Loc.ghost (CPatPrim(Loc.ghost,p)) key
+    with No_match ->
+      try
+	if !Flags.raw_print || !print_no_symbol then raise No_match;
+	extern_symbol_ind_pattern scopes vars ind args
+	  (uninterp_ind_pattern_notations ind)
+    with No_match ->
+      let c = extern_reference Loc.ghost vars (IndRef ind) in
+      let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
+      match drop_implicits_in_patt (IndRef ind) 0 args with
+	   |Some true_args -> CPatCstr (Loc.ghost, c, [], true_args)
+	   |None -> CPatCstr (Loc.ghost, c, args, [])
+
 let extern_cases_pattern vars p =
   extern_cases_pattern_in_scope (None,[]) vars p
 
@@ -438,20 +435,32 @@ let occur_name na aty =
     | Anonymous -> false
 
 let is_projection nargs = function
-  | Some r when not !Flags.raw_print & !print_projections ->
-      (try
-	let n = Recordops.find_projection_nparams r + 1 in
-	if n <= nargs then Some n else None
-      with Not_found -> None)
+  | Some r when not !Flags.in_debugger && not !Flags.raw_print && !print_projections ->
+    (try
+       let n = Recordops.find_projection_nparams r + 1 in
+	 if n <= nargs then None
+	 else Some n
+     with Not_found -> None)
   | _ -> None
-
-let is_hole = function CHole _ -> true | _ -> false
+	
+let is_hole = function CHole _ | CEvar _ -> true | _ -> false
 
 let is_significant_implicit a =
   not (is_hole a)
 
 let is_needed_for_correct_partial_application tail imp =
-  tail = [] & not (maximal_insertion_of imp)
+  List.is_empty tail && not (maximal_insertion_of imp)
+
+exception Expl
+
+let params_implicit n impl = 
+  let rec aux n impl =
+    if n == 0 then true
+    else match impl with
+    | [] -> false
+    | imp :: impl when is_status_implicit imp -> aux (pred n) impl
+    | _ -> false
+  in aux n impl
 
 (* Implicit args indexes are in ascending order *)
 (* inctx is useful only if there is a last argument to be deduced from ctxt *)
@@ -462,55 +471,70 @@ let explicitize loc inctx impl (cf,f) args =
     | a::args, imp::impl when is_status_implicit imp ->
         let tail = exprec (q+1) (args,impl) in
         let visible =
-          !Flags.raw_print or
-          (!print_implicits & !print_implicits_explicit_args) or
-          (is_needed_for_correct_partial_application tail imp) or
-	  (!print_implicits_defensive &
-	   is_significant_implicit a &
+          !Flags.raw_print ||
+          (!print_implicits && !print_implicits_explicit_args) ||
+          (is_needed_for_correct_partial_application tail imp) ||
+	  (!print_implicits_defensive &&
+	   is_significant_implicit a &&
 	   not (is_inferable_implicit inctx n imp))
 	in
         if visible then
-	  (a,Some (dummy_loc, ExplByName (name_of_implicit imp))) :: tail
+	  (a,Some (Loc.ghost, ExplByName (name_of_implicit imp))) :: tail
 	else
 	  tail
     | a::args, _::impl -> (a,None) :: exprec (q+1) (args,impl)
     | args, [] -> List.map (fun a -> (a,None)) args (*In case of polymorphism*)
-    | [], _ -> [] in
-  match is_projection (List.length args) cf with
-    | Some i as ip ->
-	if impl <> [] & is_status_implicit (List.nth impl (i-1)) then
-	  let f' = match f with CRef f -> f | _ -> assert false in
-	  CAppExpl (loc,(ip,f'),args)
-	else
-	  let (args1,args2) = list_chop i args in
-	  let (impl1,impl2) = if impl=[] then [],[] else list_chop i impl in
-	  let args1 = exprec 1 (args1,impl1) in
-	  let args2 = exprec (i+1) (args2,impl2) in
-	  CApp (loc,(Some (List.length args1),f),args1@args2)
+    | [], (imp :: _) when is_status_implicit imp && maximal_insertion_of imp -> 
+      (* The non-explicit application cannot be parsed back with the same type *)
+      raise Expl
+    | [], _ -> []
+  in
+  let ip = is_projection (List.length args) cf in
+  let expl () = 
+    match ip with
+    | Some i ->
+      if not (List.is_empty impl) && is_status_implicit (List.nth impl (i-1)) then
+	raise Expl
+      else
+	let (args1,args2) = List.chop i args in
+	let (impl1,impl2) = if List.is_empty impl then [],[] else List.chop i impl in
+	let args1 = exprec 1 (args1,impl1) in
+	let args2 = exprec (i+1) (args2,impl2) in
+	let ip = Some (List.length args1) in
+	  CApp (loc,(ip,f),args1@args2)
     | None ->
-	let args = exprec 1 (args,impl) in
-	if args = [] then f else CApp (loc, (None, f), args)
-
-let extern_global loc impl f =
-  if not !Constrintern.parsing_explicit &&
-     impl <> [] && List.for_all is_status_implicit impl
+      let args = exprec 1 (args,impl) in
+	if List.is_empty args then f else CApp (loc, (None, f), args)
+  in
+    try expl ()
+    with Expl -> 
+      let f',us = match f with CRef (f,us) -> f,us | _ -> assert false in
+      let ip = if !print_projections then ip else None in
+	CAppExpl (loc, (ip, f', us), args)
+
+let is_start_implicit = function
+  | imp :: _ -> is_status_implicit imp && maximal_insertion_of imp
+  | [] -> false
+
+let extern_global loc impl f us =
+  if not !Constrintern.parsing_explicit && is_start_implicit impl
   then
-    CAppExpl (loc, (None, f), [])
-  else
-    CRef f
-
-let extern_app loc inctx impl (cf,f) args =
-  if args = [] (* maybe caused by a hidden coercion *) then
-    extern_global loc impl f
+    CAppExpl (loc, (None, f, us), [])
   else
-  if not !Constrintern.parsing_explicit &&
-    ((!Flags.raw_print or
-      (!print_implicits & not !print_implicits_explicit_args)) &
+    CRef (f,us)
+
+let extern_app loc inctx impl (cf,f) us args =
+  if List.is_empty args then
+    (* If coming from a notation "Notation a := @b" *)
+    CAppExpl (loc, (None, f, us), [])
+  else if not !Constrintern.parsing_explicit &&
+    ((!Flags.raw_print ||
+      (!print_implicits && not !print_implicits_explicit_args)) &&
      List.exists is_status_implicit impl)
   then
-    CAppExpl (loc, (is_projection (List.length args) cf, f), args)
+    CAppExpl (loc, (is_projection (List.length args) cf,f,us), args)
   else
-    explicitize loc inctx impl (cf,CRef f) args
+    explicitize loc inctx impl (cf,CRef (f,us)) args
 
 let rec extern_args extern scopes env args subscopes =
   match args with
@@ -521,15 +545,19 @@ let rec extern_args extern scopes env args subscopes =
 	  | scopt::subscopes -> (scopt,scopes), subscopes in
 	extern argscopes env a :: extern_args extern scopes env args subscopes
 
-let rec remove_coercions inctx = function
-  | GApp (loc,GRef (_,r),args) as c
-      when  not (!Flags.raw_print or !print_coercions)
-      ->
+
+let match_coercion_app = function
+  | GApp (loc,GRef (_,r,_),args) -> Some (loc, r, 0, args)
+  | _ -> None
+
+let rec remove_coercions inctx c =
+  match match_coercion_app c with
+  | Some (loc,r,pars,args) when not (!Flags.raw_print || !print_coercions) ->
       let nargs = List.length args in
       (try match Classops.hide_coercion r with
-	  | Some n when n < nargs && (inctx or n+1 < nargs) ->
+	  | Some n when (n - pars) < nargs && (inctx || (n - pars)+1 < nargs) ->
 	      (* We skip a coercion *)
-	      let l = list_skipn n args in
+	      let l = List.skipn (n - pars) args in
 	      let (a,l) = match l with a::l -> (a,l) | [] -> assert false in
               (* Recursively remove the head coercions *)
 	      let a' = remove_coercions true a in
@@ -541,10 +569,10 @@ let rec remove_coercions inctx = function
 		 been confused with ordinary application or would have need
                  a surrounding context and the coercion to funclass would
                  have been made explicit to match *)
-	      if l = [] then a' else GApp (loc,a',l)
+	      if List.is_empty l then a' else GApp (loc,a',l)
 	  | _ -> c
       with Not_found -> c)
-  | c -> c
+  | _ -> c
 
 let rec flatten_application = function
   | GApp (loc,GApp(_,a,l'),l) -> flatten_application (GApp (loc,a,l'@l))
@@ -574,38 +602,44 @@ let extern_optimal_prim_token scopes r r' =
 (* mapping glob_constr to constr_expr                                    *)
 
 let extern_glob_sort = function
-  | GProp _ as s -> s
-  | GType (Some _) as s when !print_universes -> s
-  | GType _ -> GType None
+  | GProp -> GProp
+  | GSet -> GSet
+  | GType _ as s when !print_universes -> s
+  | GType _ -> GType []
 
+let extern_universes = function
+  | Some _ as l when !print_universes -> l
+  | _ -> None
+  
 let rec extern inctx scopes vars r =
   let r' = remove_coercions inctx r in
   try
-    if !Flags.raw_print or !print_no_symbol then raise No_match;
+    if !Flags.raw_print || !print_no_symbol then raise No_match;
     extern_optimal_prim_token scopes r r'
   with No_match ->
   try
     let r'' = flatten_application r' in
-    if !Flags.raw_print or !print_no_symbol then raise No_match;
+    if !Flags.raw_print || !print_no_symbol then raise No_match;
     extern_symbol scopes vars r'' (uninterp_notations r'')
   with No_match -> match r' with
-  | GRef (loc,ref) ->
+  | GRef (loc,ref,us) ->
       extern_global loc (select_stronger_impargs (implicits_of_global ref))
-        (extern_reference loc vars ref)
+        (extern_reference loc vars ref) (extern_universes us)
 
-  | GVar (loc,id) -> CRef (Ident (loc,id))
+  | GVar (loc,id) -> CRef (Ident (loc,id),None)
 
-  | GEvar (loc,n,None) when !print_meta_as_hole -> CHole (loc, None)
+  | GEvar (loc,n,[]) when !print_meta_as_hole -> CHole (loc, None, Misctypes.IntroAnonymous, None)
 
   | GEvar (loc,n,l) ->
-      extern_evar loc n (Option.map (List.map (extern false scopes vars)) l)
+      extern_evar loc n (List.map (on_snd (extern false scopes vars)) l)
 
-  | GPatVar (loc,n) ->
-      if !print_meta_as_hole then CHole (loc, None) else CPatVar (loc,n)
+  | GPatVar (loc,(b,n)) ->
+      if !print_meta_as_hole then CHole (loc, None, Misctypes.IntroAnonymous, None) else
+        if b then CPatVar (loc,n) else CEvar (loc,n,[])
 
   | GApp (loc,f,args) ->
       (match f with
-	 | GRef (rloc,ref) ->
+	 | GRef (rloc,ref,us) ->
 	     let subscopes = find_arguments_scope ref in
 	     let args =
 	       extern_args (extern true) (snd scopes) vars args subscopes in
@@ -623,7 +657,7 @@ let rec extern inctx scopes vars r =
 		 let projs = struc.Recordops.s_PROJ in
 		 let locals = struc.Recordops.s_PROJKIND in
 		 let rec cut args n =
-		   if n = 0 then args
+		   if Int.equal n 0 then args
 		   else
 		     match args with
 		     | [] -> raise No_match
@@ -635,7 +669,7 @@ let rec extern inctx scopes vars r =
 		     | None :: q -> raise No_match
 		     | Some c :: q ->
 		         match locs with
-			   | [] -> anomaly "projections corruption [Constrextern.extern]"
+			   | [] -> anomaly (Pp.str "projections corruption [Constrextern.extern]")
 			   | (_, false) :: locs' ->
 			       (* we don't want to print locals *)
 			       ip q locs' args acc
@@ -644,92 +678,93 @@ let rec extern inctx scopes vars r =
 				 | [] -> raise No_match
 				     (* we give up since the constructor is not complete *)
 				 | head :: tail -> ip q locs' tail
-				     ((extern_reference loc Idset.empty (ConstRef c), head) :: acc)
+				     ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
 		   in
 		 CRecord (loc, None, List.rev (ip projs locals args []))
 	       with
 		 | Not_found | No_match | Exit ->
 		     extern_app loc inctx
 		       (select_stronger_impargs (implicits_of_global ref))
-		       (Some ref,extern_reference rloc vars ref) args
+		       (Some ref,extern_reference rloc vars ref) (extern_universes us) args
 	     end
+	       
 	 | _       ->
-	     explicitize loc inctx [] (None,sub_extern false scopes vars f)
-               (List.map (sub_extern true scopes vars) args))
-
-  | GProd (loc,Anonymous,_,t,c) ->
-      (* Anonymous product are never factorized *)
-      CArrow (loc,extern_typ scopes vars t, extern_typ scopes vars c)
+	   explicitize loc inctx [] (None,sub_extern false scopes vars f)
+             (List.map (sub_extern true scopes vars) args))
 
   | GLetIn (loc,na,t,c) ->
       CLetIn (loc,(loc,na),sub_extern false scopes vars t,
               extern inctx scopes (add_vname vars na) c)
 
   | GProd (loc,na,bk,t,c) ->
-      let t = extern_typ scopes vars (anonymize_if_reserved na t) in
+      let t = extern_typ scopes vars t in
       let (idl,c) = factorize_prod scopes (add_vname vars na) na bk t c in
-      CProdN (loc,[(dummy_loc,na)::idl,Default bk,t],c)
+      CProdN (loc,[(Loc.ghost,na)::idl,Default bk,t],c)
 
   | GLambda (loc,na,bk,t,c) ->
-      let t = extern_typ scopes vars (anonymize_if_reserved na t) in
+      let t = extern_typ scopes vars t in
       let (idl,c) = factorize_lambda inctx scopes (add_vname vars na) na bk t c in
-      CLambdaN (loc,[(dummy_loc,na)::idl,Default bk,t],c)
+      CLambdaN (loc,[(Loc.ghost,na)::idl,Default bk,t],c)
 
   | GCases (loc,sty,rtntypopt,tml,eqns) ->
-      let vars' =
-	List.fold_right (name_fold Idset.add)
-	  (cases_predicate_names tml) vars in
-      let rtntypopt' = Option.map (extern_typ scopes vars') rtntypopt in
-      let tml = List.map (fun (tm,(na,x)) ->
-        let na' = match na,tm with
-            Anonymous, GVar (_,id) when
-              rtntypopt<>None & occur_glob_constr id (Option.get rtntypopt)
-              -> Some (dummy_loc,Anonymous)
-          | Anonymous, _ -> None
-          | Name id, GVar (_,id') when id=id' -> None
-          | Name _, _ -> Some (dummy_loc,na) in
-	(sub_extern false scopes vars tm,
-	(na',Option.map (fun (loc,ind,n,nal) ->
-	  let params = list_tabulate
-	    (fun _ -> GHole (dummy_loc,Evd.InternalHole)) n in
-	  let args = List.map (function
-	    | Anonymous -> GHole (dummy_loc,Evd.InternalHole)
-	    | Name id -> GVar (dummy_loc,id)) nal in
-	  let t = GApp (dummy_loc,GRef (dummy_loc,IndRef ind),params@args) in
-	  (extern_typ scopes vars t)) x))) tml in
-      let eqns = List.map (extern_eqn inctx scopes vars) eqns in
-      CCases (loc,sty,rtntypopt',tml,eqns)
+    let vars' =
+      List.fold_right (name_fold Id.Set.add)
+	(cases_predicate_names tml) vars in
+    let rtntypopt' = Option.map (extern_typ scopes vars') rtntypopt in
+    let tml = List.map (fun (tm,(na,x)) ->
+      let na' = match na,tm with
+        | Anonymous, GVar (_, id) ->
+            begin match rtntypopt with
+            | None -> None
+            | Some ntn ->
+              if occur_glob_constr id ntn then
+                Some (Loc.ghost, Anonymous)
+              else None
+            end
+        | Anonymous, _ -> None
+        | Name id, GVar (_,id') when Id.equal id id' -> None
+        | Name _, _ -> Some (Loc.ghost,na) in
+      (sub_extern false scopes vars tm,
+       (na',Option.map (fun (loc,ind,nal) ->
+	 let args = List.map (fun x -> PatVar (Loc.ghost, x)) nal in
+	 let fullargs =
+	   if !Flags.in_debugger then args else
+	     Notation_ops.add_patterns_for_params ind args in
+	 extern_ind_pattern_in_scope scopes vars ind fullargs
+	) x))) tml in
+    let eqns = List.map (extern_eqn inctx scopes vars) eqns in
+    CCases (loc,sty,rtntypopt',tml,eqns)
 
   | GLetTuple (loc,nal,(na,typopt),tm,b) ->
-      CLetTuple (loc,List.map (fun na -> (dummy_loc,na)) nal,
-        (Option.map (fun _ -> (dummy_loc,na)) typopt,
+      CLetTuple (loc,List.map (fun na -> (Loc.ghost,na)) nal,
+        (Option.map (fun _ -> (Loc.ghost,na)) typopt,
          Option.map (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern false scopes vars tm,
         extern inctx scopes (List.fold_left add_vname vars nal) b)
 
   | GIf (loc,c,(na,typopt),b1,b2) ->
       CIf (loc,sub_extern false scopes vars c,
-        (Option.map (fun _ -> (dummy_loc,na)) typopt,
+        (Option.map (fun _ -> (Loc.ghost,na)) typopt,
          Option.map (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern inctx scopes vars b1, sub_extern inctx scopes vars b2)
 
   | GRec (loc,fk,idv,blv,tyv,bv) ->
-      let vars' = Array.fold_right Idset.add idv vars in
+      let vars' = Array.fold_right Id.Set.add idv vars in
       (match fk with
 	 | GFix (nv,n) ->
 	     let listdecl =
 	       Array.mapi (fun i fi ->
                  let (bl,ty,def) = blv.(i), tyv.(i), bv.(i) in
                  let (assums,ids,bl) = extern_local_binder scopes vars bl in
-                 let vars0 = List.fold_right (name_fold Idset.add) ids vars in
-                 let vars1 = List.fold_right (name_fold Idset.add) ids vars' in
+                 let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
+                 let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
 		 let n =
 		   match fst nv.(i) with
 		     | None -> None
-		     | Some x -> Some (dummy_loc, out_name (List.nth assums x))
+		     | Some x -> Some (Loc.ghost, out_name (List.nth assums x))
 		 in
 		 let ro = extern_recursion_order scopes vars (snd nv.(i)) in
-		 ((dummy_loc, fi), (n, ro), bl, extern_typ scopes vars0 ty,
+		 ((Loc.ghost, fi), (n, ro), bl, extern_typ scopes vars0 ty,
                   extern false scopes vars1 def)) idv
 	     in
 	     CFix (loc,(loc,idv.(n)),Array.to_list listdecl)
@@ -737,21 +772,20 @@ let rec extern inctx scopes vars r =
 	     let listdecl =
                Array.mapi (fun i fi ->
                  let (_,ids,bl) = extern_local_binder scopes vars blv.(i) in
-                 let vars0 = List.fold_right (name_fold Idset.add) ids vars in
-                 let vars1 = List.fold_right (name_fold Idset.add) ids vars' in
-		 ((dummy_loc, fi),bl,extern_typ scopes vars0 tyv.(i),
+                 let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
+                 let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
+		 ((Loc.ghost, fi),bl,extern_typ scopes vars0 tyv.(i),
                   sub_extern false scopes vars1 bv.(i))) idv
 	     in
 	     CCoFix (loc,(loc,idv.(n)),Array.to_list listdecl))
 
   | GSort (loc,s) -> CSort (loc,extern_glob_sort s)
 
-  | GHole (loc,e) -> CHole (loc, Some e)
+  | GHole (loc,e,naming,_) -> CHole (loc, Some e, naming, None) (** TODO: extern tactics. *)
 
-  | GCast (loc,c, CastConv (k,t)) ->
-      CCast (loc,sub_extern true scopes vars c, CastConv (k,extern_typ scopes vars t))
-  | GCast (loc,c, CastCoerce) ->
-      CCast (loc,sub_extern true scopes vars c, CastCoerce)
+  | GCast (loc,c, c') ->
+      CCast (loc,sub_extern true scopes vars c,
+	     Miscops.map_cast_type (extern_typ scopes vars) c')
 
 and extern_typ (_,scopes) =
   extern true (Some Notation.type_scope,scopes)
@@ -762,8 +796,8 @@ and factorize_prod scopes vars na bk aty c =
   let c = extern_typ scopes vars c in
   match na, c with
   | Name id, CProdN (loc,[nal,Default bk',ty],c)
-      when bk = bk' && is_same_type aty ty
-      & not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *) ->
+      when binding_kind_eq bk bk' && constr_expr_eq aty ty
+      && not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *) ->
       nal,c
   | _ ->
       [],c
@@ -772,8 +806,8 @@ and factorize_lambda inctx scopes vars na bk aty c =
   let c = sub_extern inctx scopes vars c in
   match c with
   | CLambdaN (loc,[nal,Default bk',ty],c)
-      when bk = bk' && is_same_type aty ty
-      & not (occur_name na ty) (* avoid na in ty escapes scope *) ->
+      when binding_kind_eq bk bk' && constr_expr_eq aty ty
+      && not (occur_name na ty) (* avoid na in ty escapes scope *) ->
       nal,c
   | _ ->
       [],c
@@ -782,22 +816,22 @@ and extern_local_binder scopes vars = function
     [] -> ([],[],[])
   | (na,bk,Some bd,ty)::l ->
       let (assums,ids,l) =
-        extern_local_binder scopes (name_fold Idset.add na vars) l in
+        extern_local_binder scopes (name_fold Id.Set.add na vars) l in
       (assums,na::ids,
-       LocalRawDef((dummy_loc,na), extern false scopes vars bd) :: l)
+       LocalRawDef((Loc.ghost,na), extern false scopes vars bd) :: l)
 
   | (na,bk,None,ty)::l ->
-      let ty = extern_typ scopes vars (anonymize_if_reserved na ty) in
-      (match extern_local_binder scopes (name_fold Idset.add na vars) l with
+      let ty = extern_typ scopes vars ty in
+      (match extern_local_binder scopes (name_fold Id.Set.add na vars) l with
           (assums,ids,LocalRawAssum(nal,k,ty')::l)
-            when is_same_type ty ty' &
+            when constr_expr_eq ty ty' &&
               match na with Name id -> not (occur_var_constr_expr id ty')
                 | _ -> true ->
               (na::assums,na::ids,
-               LocalRawAssum((dummy_loc,na)::nal,k,ty')::l)
+               LocalRawAssum((Loc.ghost,na)::nal,k,ty')::l)
         | (assums,ids,l) ->
             (na::assums,na::ids,
-             LocalRawAssum([(dummy_loc,na)],Default bk,ty) :: l))
+             LocalRawAssum([(Loc.ghost,na)],Default bk,ty) :: l))
 
 and extern_eqn inctx scopes vars (loc,ids,pl,c) =
   (loc,[loc,List.map (extern_cases_pattern_in_scope scopes vars) pl],
@@ -806,42 +840,42 @@ and extern_eqn inctx scopes vars (loc,ids,pl,c) =
 and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
   | (keyrule,pat,n as _rule)::rules ->
-      let loc = Glob_term.loc_of_glob_constr t in
+      let loc = Glob_ops.loc_of_glob_constr t in
       try
+        if List.mem keyrule !print_non_active_notations then raise No_match;
 	(* Adjusts to the number of arguments expected by the notation *)
 	let (t,args,argsscopes,argsimpls) = match t,n with
 	  | GApp (_,f,args), Some n
 	      when List.length args >= n ->
-	      let args1, args2 = list_chop n args in
+	      let args1, args2 = List.chop n args in
               let subscopes, impls =
                 match f with
-                | GRef (_,ref) ->
+                | GRef (_,ref,us) ->
 	          let subscopes =
-		    try list_skipn n (find_arguments_scope ref)
-                    with e when Errors.noncritical e -> [] in
+		    try List.skipn n (find_arguments_scope ref)
+                    with Failure _ -> [] in
 	          let impls =
 		    let impls =
 		      select_impargs_size
 		        (List.length args) (implicits_of_global ref) in
-		    try list_skipn n impls
-                    with e when Errors.noncritical e -> [] in
+		    try List.skipn n impls with Failure _ -> [] in
                   subscopes,impls
                 | _ ->
                   [], [] in
-	      (if n = 0 then f else GApp (dummy_loc,f,args1)),
+	      (if Int.equal n 0 then f else GApp (Loc.ghost,f,args1)),
 	      args2, subscopes, impls
-	  | GApp (_,(GRef (_,ref) as f),args), None ->
+	  | GApp (_,(GRef (_,ref,us) as f),args), None ->
 	      let subscopes = find_arguments_scope ref in
 	      let impls =
 		  select_impargs_size
 		    (List.length args) (implicits_of_global ref) in
 	      f, args, subscopes, impls
-	  | GRef _, Some 0 -> GApp (dummy_loc,t,[]), [], [], []
+	  | GRef (_,ref,us), Some 0 -> GApp (Loc.ghost,t,[]), [], [], []
           | _, None -> t, [], [], []
           | _ -> raise No_match in
 	(* Try matching ... *)
 	let terms,termlists,binders =
-          match_aconstr !print_universes t pat in
+          match_notation_constr !print_universes t pat in
 	(* Try availability of interpretation ... *)
         let e =
           match keyrule with
@@ -871,9 +905,9 @@ and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
 		List.map (fun (c,(scopt,scl)) ->
 		  extern true (scopt,scl@scopes) vars c, None)
 		  terms in
-              let a = CRef (Qualid (loc, shortest_qualid_of_syndef vars kn)) in
-	      if l = [] then a else CApp (loc,(None,a),l) in
- 	if args = [] then e
+              let a = CRef (Qualid (loc, shortest_qualid_of_syndef vars kn),None) in
+	      if List.is_empty l then a else CApp (loc,(None,a),l) in
+ 	if List.is_empty args then e
 	else
 	  let args = extern_args (extern true) scopes vars args argsscopes in
 	  explicitize loc false argsimpls (None,e) args
@@ -896,9 +930,9 @@ let extern_glob_type vars c =
 (******************************************************************)
 (* Main translation function from constr -> constr_expr *)
 
-let loc = dummy_loc (* for constr and pattern, locations are lost *)
+let loc = Loc.ghost (* for constr and pattern, locations are lost *)
 
-let extern_constr_gen goal_concl_style scopt env t =
+let extern_constr_gen lax goal_concl_style scopt env sigma t =
   (* "goal_concl_style" means do alpha-conversion using the "goal" convention *)
   (* i.e.: avoid using the names of goal/section/rel variables and the short *)
   (* names of global definitions of current module when computing names for *)
@@ -907,87 +941,99 @@ let extern_constr_gen goal_concl_style scopt env t =
   (* those goal/section/rel variables that occurs in the subterm under *)
   (* consideration; see namegen.ml for further details *)
   let avoid = if goal_concl_style then ids_of_context env else [] in
-  let rel_env_names = names_of_rel_context env in
-  let r = Detyping.detype goal_concl_style avoid rel_env_names t in
+  let r = Detyping.detype ~lax:lax goal_concl_style avoid env sigma t in
   let vars = vars_of_env env in
   extern false (scopt,[]) vars r
 
-let extern_constr_in_scope goal_concl_style scope env t =
-  extern_constr_gen goal_concl_style (Some scope) env t
+let extern_constr_in_scope goal_concl_style scope env sigma t =
+  extern_constr_gen false goal_concl_style (Some scope) env sigma t
 
-let extern_constr goal_concl_style env t =
-  extern_constr_gen goal_concl_style None env t
+let extern_constr ?(lax=false) goal_concl_style env sigma t =
+  extern_constr_gen lax goal_concl_style None env sigma t
 
-let extern_type goal_concl_style env t =
+let extern_type goal_concl_style env sigma t =
   let avoid = if goal_concl_style then ids_of_context env else [] in
-  let rel_env_names = names_of_rel_context env in
-  let r = Detyping.detype goal_concl_style avoid rel_env_names t in
+  let r = Detyping.detype goal_concl_style avoid env sigma t in
   extern_glob_type (vars_of_env env) r
 
-let extern_sort s = extern_glob_sort (detype_sort s)
+let extern_sort sigma s = extern_glob_sort (detype_sort sigma s)
+
+let extern_closed_glob ?lax goal_concl_style env sigma t =
+  let avoid = if goal_concl_style then ids_of_context env else [] in
+  let r =
+    Detyping.detype_closed_glob ?lax goal_concl_style avoid env sigma t
+  in
+  let vars = vars_of_env env in
+  extern false (None,[]) vars r
 
 (******************************************************************)
 (* Main translation function from pattern -> constr_expr *)
 
 let any_any_branch =
   (* | _ => _ *)
-  (loc,[],[PatVar (loc,Anonymous)],GHole (loc,Evd.InternalHole))
+  (loc,[],[PatVar (loc,Anonymous)],GHole (loc,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None))
 
-let rec glob_of_pat env = function
-  | PRef ref -> GRef (loc,ref)
+let rec glob_of_pat env sigma = function
+  | PRef ref -> GRef (loc,ref,None)
   | PVar id -> GVar (loc,id)
-  | PEvar (n,l) -> GEvar (loc,n,Some (array_map_to_list (glob_of_pat env) l))
+  | PEvar (evk,l) ->
+      let test id = function PVar id' -> Id.equal id id' | _ -> false in
+      let l = Evd.evar_instance_array test (Evd.find sigma evk) l in
+      let id = Evd.evar_ident evk sigma in
+      GEvar (loc,id,List.map (on_snd (glob_of_pat env sigma)) l)
   | PRel n ->
       let id = try match lookup_name_of_rel n env with
 	| Name id   -> id
 	| Anonymous ->
-	    anomaly "glob_constr_of_pattern: index to an anonymous variable"
-      with Not_found -> id_of_string ("_UNBOUND_REL_"^(string_of_int n)) in
+	    anomaly ~label:"glob_constr_of_pattern" (Pp.str "index to an anonymous variable")
+      with Not_found -> Id.of_string ("_UNBOUND_REL_"^(string_of_int n)) in
       GVar (loc,id)
-  | PMeta None -> GHole (loc,Evd.InternalHole)
+  | PMeta None -> GHole (loc,Evar_kinds.InternalHole, Misctypes.IntroAnonymous,None)
   | PMeta (Some n) -> GPatVar (loc,(false,n))
+  | PProj (p,c) -> GApp (loc,GRef (loc, ConstRef (Projection.constant p),None),
+			 [glob_of_pat env sigma c])
   | PApp (f,args) ->
-      GApp (loc,glob_of_pat env f,array_map_to_list (glob_of_pat env) args)
+      GApp (loc,glob_of_pat env sigma f,Array.map_to_list (glob_of_pat env sigma) args)
   | PSoApp (n,args) ->
       GApp (loc,GPatVar (loc,(true,n)),
-        List.map (glob_of_pat env) args)
+        List.map (glob_of_pat env sigma) args)
   | PProd (na,t,c) ->
-      GProd (loc,na,Explicit,glob_of_pat env t,glob_of_pat (na::env) c)
+      GProd (loc,na,Explicit,glob_of_pat env sigma t,glob_of_pat (na::env) sigma c)
   | PLetIn (na,t,c) ->
-      GLetIn (loc,na,glob_of_pat env t, glob_of_pat (na::env) c)
+      GLetIn (loc,na,glob_of_pat env sigma t, glob_of_pat (na::env) sigma c)
   | PLambda (na,t,c) ->
-      GLambda (loc,na,Explicit,glob_of_pat env t, glob_of_pat (na::env) c)
+      GLambda (loc,na,Explicit,glob_of_pat env sigma t, glob_of_pat (na::env) sigma c)
   | PIf (c,b1,b2) ->
-      GIf (loc, glob_of_pat env c, (Anonymous,None),
-           glob_of_pat env b1, glob_of_pat env b2)
-  | PCase ({cip_style=LetStyle; cip_ind_args=None},PMeta None,tm,[(0,n,b)]) ->
-      let nal,b = it_destRLambda_or_LetIn_names n (glob_of_pat env b) in
-      GLetTuple (loc,nal,(Anonymous,None),glob_of_pat env tm,b)
+      GIf (loc, glob_of_pat env sigma c, (Anonymous,None),
+           glob_of_pat env sigma b1, glob_of_pat env sigma b2)
+  | PCase ({cip_style=LetStyle; cip_ind_tags=None},PMeta None,tm,[(0,n,b)]) ->
+      let nal,b = it_destRLambda_or_LetIn_names n (glob_of_pat env sigma b) in
+      GLetTuple (loc,nal,(Anonymous,None),glob_of_pat env sigma tm,b)
   | PCase (info,p,tm,bl) ->
       let mat = match bl, info.cip_ind with
 	| [], _ -> []
 	| _, Some ind ->
-	  let bl' = List.map (fun (i,n,c) -> (i,n,glob_of_pat env c)) bl in
+	  let bl' = List.map (fun (i,n,c) -> (i,n,glob_of_pat env sigma c)) bl in
 	  simple_cases_matrix_of_branches ind bl'
-	| _, None -> anomaly "PCase with some branches but unknown inductive"
+	| _, None -> anomaly (Pp.str "PCase with some branches but unknown inductive")
       in
       let mat = if info.cip_extensible then mat @ [any_any_branch] else mat
       in
-      let indnames,rtn = match p, info.cip_ind, info.cip_ind_args with
+      let indnames,rtn = match p, info.cip_ind, info.cip_ind_tags with
 	| PMeta None, _, _ -> (Anonymous,None),None
-	| _, Some ind, Some (nparams,nargs) ->
-	  return_type_of_predicate ind nparams nargs (glob_of_pat env p)
-	| _ -> anomaly "PCase with non-trivial predicate but unknown inductive"
+	| _, Some ind, Some nargs ->
+	  return_type_of_predicate ind nargs (glob_of_pat env sigma p)
+	| _ -> anomaly (Pp.str "PCase with non-trivial predicate but unknown inductive")
       in
-      GCases (loc,RegularStyle,rtn,[glob_of_pat env tm,indnames],mat)
-  | PFix f -> Detyping.detype false [] env (mkFix f)
-  | PCoFix c -> Detyping.detype false [] env (mkCoFix c)
+      GCases (loc,RegularStyle,rtn,[glob_of_pat env sigma tm,indnames],mat)
+  | PFix f -> Detyping.detype_names false [] env (Global.env()) sigma (mkFix f) (** FIXME bad env *)
+  | PCoFix c -> Detyping.detype_names false [] env (Global.env()) sigma (mkCoFix c)
   | PSort s -> GSort (loc,s)
 
-let extern_constr_pattern env pat =
-  extern true (None,[]) Idset.empty (glob_of_pat env pat)
+let extern_constr_pattern env sigma pat =
+  extern true (None,[]) Id.Set.empty (glob_of_pat env sigma pat)
 
-let extern_rel_context where env sign =
-  let a = detype_rel_context where [] (names_of_rel_context env) sign in
+let extern_rel_context where env sigma sign =
+  let a = detype_rel_context where [] (names_of_rel_context env,env) sigma sign in
   let vars = vars_of_env env in
   pi3 (extern_local_binder (None,[]) vars a)
diff --git a/interp/constrextern.mli b/interp/constrextern.mli
index 8933d3af..b797e455 100644
--- a/interp/constrextern.mli
+++ b/interp/constrextern.mli
@@ -1,43 +1,47 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Util
 open Names
 open Term
+open Context
 open Termops
-open Sign
 open Environ
 open Libnames
-open Nametab
+open Globnames
 open Glob_term
 open Pattern
-open Topconstr
+open Constrexpr
+open Notation_term
 open Notation
-
-val is_same_type : constr_expr -> constr_expr -> bool
+open Misctypes
 
 (** Translation of pattern, cases pattern, glob_constr and term into syntax
    trees for printing *)
 
-val extern_cases_pattern : Idset.t -> cases_pattern -> cases_pattern_expr
-val extern_glob_constr : Idset.t -> glob_constr -> constr_expr
-val extern_glob_type : Idset.t -> glob_constr -> constr_expr
-val extern_constr_pattern : names_context -> constr_pattern -> constr_expr
+val extern_cases_pattern : Id.Set.t -> cases_pattern -> cases_pattern_expr
+val extern_glob_constr : Id.Set.t -> glob_constr -> constr_expr
+val extern_glob_type : Id.Set.t -> glob_constr -> constr_expr
+val extern_constr_pattern : names_context -> Evd.evar_map ->
+  constr_pattern -> constr_expr
+val extern_closed_glob : ?lax:bool -> bool -> env -> Evd.evar_map -> closed_glob_constr -> constr_expr
 
 (** If [b=true] in [extern_constr b env c] then the variables in the first
-   level of quantification clashing with the variables in [env] are renamed *)
+   level of quantification clashing with the variables in [env] are renamed.
+    ~lax is for debug printing, when the constr might not be well typed in 
+    env, sigma
+*)
 
-val extern_constr : bool -> env -> constr -> constr_expr
-val extern_constr_in_scope : bool -> scope_name -> env -> constr -> constr_expr
-val extern_reference : loc -> Idset.t -> global_reference -> reference
-val extern_type : bool -> env -> types -> constr_expr
-val extern_sort : sorts -> glob_sort
-val extern_rel_context : constr option -> env ->
+val extern_constr : ?lax:bool -> bool -> env -> Evd.evar_map -> constr -> constr_expr
+val extern_constr_in_scope : bool -> scope_name -> env -> Evd.evar_map -> constr -> constr_expr
+val extern_reference : Loc.t -> Id.Set.t -> global_reference -> reference
+val extern_type : bool -> env -> Evd.evar_map -> types -> constr_expr
+val extern_sort : Evd.evar_map -> sorts -> glob_sort
+val extern_rel_context : constr option -> env -> Evd.evar_map ->
   rel_context -> local_binder list
 
 (** Printing options *)
@@ -52,11 +56,9 @@ val print_projections : bool ref
 
 (** Customization of the global_reference printer *)
 val set_extern_reference :
-  (loc -> Idset.t -> global_reference -> reference) -> unit
+  (Loc.t -> Id.Set.t -> global_reference -> reference) -> unit
 val get_extern_reference :
-  unit -> (loc -> Idset.t -> global_reference -> reference)
-
-val in_debugger : bool ref
+  unit -> (Loc.t -> Id.Set.t -> global_reference -> reference)
 
 (** This governs printing of implicit arguments. If [with_implicits] is
    on and not [with_arguments] then implicit args are printed prefixed
@@ -71,8 +73,11 @@ val with_coercions : ('a -> 'b) -> 'a -> 'b
 (** This forces printing universe names of Type\{.\} *)
 val with_universes : ('a -> 'b) -> 'a -> 'b
 
-(** This suppresses printing of numeral and symbols *)
+(** This suppresses printing of primitive tokens and notations *)
 val without_symbols : ('a -> 'b) -> 'a -> 'b
 
+(** This suppresses printing of specific notations only *)
+val without_specific_symbols : interp_rule list -> ('a -> 'b) -> 'a -> 'b
+
 (** This prints metas as anonymous holes *)
 val with_meta_as_hole : ('a -> 'b) -> 'a -> 'b
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index b6f18fe3..68f0050d 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1,33 +1,50 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
 open Pp
+open Errors
 open Util
-open Flags
 open Names
 open Nameops
 open Namegen
 open Libnames
+open Globnames
 open Impargs
 open Glob_term
-open Pattern
+open Glob_ops
+open Patternops
 open Pretyping
 open Cases
+open Constrexpr
+open Constrexpr_ops
+open Notation_term
+open Notation_ops
 open Topconstr
 open Nametab
 open Notation
 open Inductiveops
+open Decl_kinds
+
+(** constr_expr -> glob_constr translation:
+    - it adds holes for implicit arguments
+    - it remplaces notations by their value (scopes stuff are here)
+    - it recognizes global vars from local ones
+    - it prepares pattern maching problems (a pattern becomes a tree where nodes
+    are constructor/variable pairs and leafs are variables)
+
+    All that at once, fasten your seatbelt!
+*)
 
 (* To interpret implicits and arg scopes of variables in inductive
    types and recursive definitions and of projection names in records *)
 
 type var_internalization_type =
-  | Inductive of identifier list (* list of params *)
+  | Inductive of Id.t list (* list of params *)
   | Recursive
   | Method
   | Variable
@@ -38,16 +55,21 @@ type var_internalization_data =
     var_internalization_type *
     (* impargs to automatically add to the variable, e.g. for "JMeq A a B b"
        in implicit mode, this is [A;B] and this adds (A:=A) and (B:=B) *)
-    identifier list *
+    Id.t list *
     (* signature of impargs of the variable *)
     Impargs.implicit_status list *
     (* subscopes of the args of the variable *)
     scope_name option list
 
 type internalization_env =
-    (var_internalization_data) Idmap.t
+    (var_internalization_data) Id.Map.t
+
+type glob_binder = (Name.t * binding_kind * glob_constr option * glob_constr)
 
-type glob_binder = (name * binding_kind * glob_constr option * glob_constr)
+type ltac_sign = {
+  ltac_vars : Id.Set.t;
+  ltac_bound : Id.Set.t;
+}
 
 let interning_grammar = ref false
 
@@ -75,38 +97,33 @@ let global_reference_of_reference ref =
   locate_reference (snd (qualid_of_reference ref))
 
 let global_reference id =
-  constr_of_global (locate_reference (qualid_of_ident id))
+  Universes.constr_of_global (locate_reference (qualid_of_ident id))
 
 let construct_reference ctx id =
   try
-    Term.mkVar (let _ = Sign.lookup_named id ctx in id)
+    Term.mkVar (let _ = Context.lookup_named id ctx in id)
   with Not_found ->
     global_reference id
 
 let global_reference_in_absolute_module dir id =
-  constr_of_global (Nametab.global_of_path (Libnames.make_path dir id))
+  Universes.constr_of_global (Nametab.global_of_path (Libnames.make_path dir id))
 
 (**********************************************************************)
 (* Internalization errors                                             *)
 
 type internalization_error =
-  | VariableCapture of identifier
-  | WrongExplicitImplicit
+  | VariableCapture of Id.t * Id.t
   | IllegalMetavariable
   | NotAConstructor of reference
-  | UnboundFixName of bool * identifier
-  | NonLinearPattern of identifier
+  | UnboundFixName of bool * Id.t
+  | NonLinearPattern of Id.t
   | BadPatternsNumber of int * int
-  | BadExplicitationNumber of explicitation * int option
 
-exception InternalizationError of loc * internalization_error
+exception InternalizationError of Loc.t * internalization_error
 
-let explain_variable_capture id =
-  str "The variable " ++ pr_id id ++ str " occurs in its type"
-
-let explain_wrong_explicit_implicit =
-  str "Found an explicitly given implicit argument but was expecting" ++
-  fnl () ++ str "a regular one"
+let explain_variable_capture id id' =
+  pr_id id ++ str " is dependent in the type of " ++ pr_id id' ++
+  strbrk ": cannot interpret both of them with the same type"
 
 let explain_illegal_metavariable =
   str "Metavariables allowed only in patterns"
@@ -123,44 +140,31 @@ let explain_non_linear_pattern id =
   str "The variable " ++ pr_id id ++ str " is bound several times in pattern"
 
 let explain_bad_patterns_number n1 n2 =
-  str "Expecting " ++ int n1 ++ str (plural n1 " pattern") ++
+  str "Expecting " ++ int n1 ++ str (String.plural n1 " pattern") ++
   str " but found " ++ int n2
 
-let explain_bad_explicitation_number n po =
-  match n with
-  | ExplByPos (n,_id) ->
-      let s = match po with
-	| None -> str "a regular argument"
-	| Some p -> int p in
-      str "Bad explicitation number: found " ++ int n ++
-      str" but was expecting " ++ s
-  | ExplByName id ->
-      let s = match po with
-	| None -> str "a regular argument"
-	| Some p -> (*pr_id (name_of_position p) in*) failwith "" in
-      str "Bad explicitation name: found " ++ pr_id id ++
-      str" but was expecting " ++ s
-
 let explain_internalization_error e =
   let pp = match e with
-  | VariableCapture id -> explain_variable_capture id
-  | WrongExplicitImplicit -> explain_wrong_explicit_implicit
+  | VariableCapture (id,id') -> explain_variable_capture id id'
   | IllegalMetavariable -> explain_illegal_metavariable
   | NotAConstructor ref -> explain_not_a_constructor ref
   | UnboundFixName (iscofix,id) -> explain_unbound_fix_name iscofix id
   | NonLinearPattern id -> explain_non_linear_pattern id
   | BadPatternsNumber (n1,n2) -> explain_bad_patterns_number n1 n2
-  | BadExplicitationNumber (n,po) -> explain_bad_explicitation_number n po in
-  pp ++ str "."
+  in pp ++ str "."
 
 let error_bad_inductive_type loc =
   user_err_loc (loc,"",str
-    "This should be an inductive type applied to names or \"_\".")
+    "This should be an inductive type applied to patterns.")
 
-let error_inductive_parameter_not_implicit loc =
+let error_parameter_not_implicit loc =
   user_err_loc (loc,"", str
-   ("The parameters of inductive types do not bind in\n"^
-    "the 'return' clauses; they must be replaced by '_' in the 'in' clauses."))
+   "The parameters do not bind in patterns;" ++ spc () ++ str
+    "they must be replaced by '_'.")
+
+let error_ldots_var loc =
+  user_err_loc (loc,"",str "Special token " ++ pr_id ldots_var ++
+    str " is for use in the Notation command.")
 
 (**********************************************************************)
 (* Pre-computing the implicit arguments and arguments scopes needed   *)
@@ -168,12 +172,12 @@ let error_inductive_parameter_not_implicit loc =
 
 let parsing_explicit = ref false
 
-let empty_internalization_env = Idmap.empty
+let empty_internalization_env = Id.Map.empty
 
 let compute_explicitable_implicit imps = function
   | Inductive params ->
       (* In inductive types, the parameters are fixed implicit arguments *)
-      let sub_impl,_ = list_chop (List.length params) imps in
+      let sub_impl,_ = List.chop (List.length params) imps in
       let sub_impl' = List.filter is_status_implicit sub_impl in
       List.map name_of_implicit sub_impl'
   | Recursive | Method | Variable ->
@@ -186,25 +190,25 @@ let compute_internalization_data env ty typ impl =
   (ty, expls_impl, impl, compute_arguments_scope typ)
 
 let compute_internalization_env env ty =
-  list_fold_left3
-    (fun map id typ impl -> Idmap.add id (compute_internalization_data env ty typ impl) map)
+  List.fold_left3
+    (fun map id typ impl -> Id.Map.add id (compute_internalization_data env ty typ impl) map)
     empty_internalization_env
 
 (**********************************************************************)
 (* Contracting "{ _ }" in notations *)
 
 let rec wildcards ntn n =
-  if n = String.length ntn then []
-  else let l = spaces ntn (n+1) in if ntn.[n] = '_' then n::l else l
+  if Int.equal n (String.length ntn) then []
+  else let l = spaces ntn (n+1) in if ntn.[n] == '_' then n::l else l
 and spaces ntn n =
-  if n = String.length ntn then []
-  else if ntn.[n] = ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
+  if Int.equal n (String.length ntn) then []
+  else if ntn.[n] == ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
 
 let expand_notation_string ntn n =
   let pos = List.nth (wildcards ntn 0) n in
-  let hd = if pos = 0 then "" else String.sub ntn 0 pos in
+  let hd = if Int.equal pos 0 then "" else String.sub ntn 0 pos in
   let tl =
-    if pos = String.length ntn then ""
+    if Int.equal pos (String.length ntn) then ""
     else String.sub ntn (pos+1) (String.length ntn - pos -1) in
   hd ^ "{ _ }" ^ tl
 
@@ -227,7 +231,7 @@ let contract_pat_notation ntn (l,ll) =
   let ntn' = ref ntn in
   let rec contract_squash n = function
     | [] -> []
-    | CPatNotation (_,"{ _ }",([a],[])) :: l ->
+    | CPatNotation (_,"{ _ }",([a],[]),[]) :: l ->
         ntn' := expand_notation_string !ntn' n;
         contract_squash n (a::l)
     | a :: l ->
@@ -237,19 +241,19 @@ let contract_pat_notation ntn (l,ll) =
   !ntn',(l,ll)
 
 type intern_env = {
-  ids: Names.Idset.t;
+  ids: Names.Id.Set.t;
   unb: bool;
-  tmp_scope: Topconstr.tmp_scope_name option;
-  scopes: Topconstr.scope_name list;
+  tmp_scope: Notation_term.tmp_scope_name option;
+  scopes: Notation_term.scope_name list;
   impls: internalization_env }
 
 (**********************************************************************)
 (* Remembering the parsing scope of variables in notations            *)
 
-let make_current_scope = function
-  | (Some tmp_scope,(sc::_ as scopes)) when sc = tmp_scope -> scopes
-  | (Some tmp_scope,scopes) -> tmp_scope::scopes
-  | None,scopes -> scopes
+let make_current_scope tmp scopes = match tmp, scopes with
+| Some tmp_scope, (sc :: _) when String.equal sc tmp_scope -> scopes
+| Some tmp_scope, scopes -> tmp_scope :: scopes
+| None, scopes -> scopes
 
 let pr_scope_stack = function
   | [] -> str "the empty scope stack"
@@ -263,10 +267,6 @@ let error_inconsistent_scope loc id scopes1 scopes2 =
     pr_scope_stack scopes2 ++ strbrk " while it was elsewhere used in " ++
     pr_scope_stack scopes1)
 
-let error_expect_constr_notation_type loc id =
-  user_err_loc (loc,"",
-    pr_id id ++ str " is bound in the notation to a term variable.")
-
 let error_expect_binder_notation_type loc id =
   user_err_loc (loc,"",
     pr_id id ++
@@ -274,18 +274,17 @@ let error_expect_binder_notation_type loc id =
 
 let set_var_scope loc id istermvar env ntnvars =
   try
-    let idscopes,typ = List.assoc id ntnvars in
-    if istermvar then
+    let idscopes,typ = Id.Map.find id ntnvars in
+    let () = if istermvar then
       (* scopes have no effect on the interpretation of identifiers *)
-      if !idscopes = None then
-        idscopes := Some (env.tmp_scope,env.scopes)
-      else
-        if make_current_scope (Option.get !idscopes)
-          <> make_current_scope (env.tmp_scope,env.scopes)
-        then
-	  error_inconsistent_scope loc id
-	    (make_current_scope (Option.get !idscopes))
-	    (make_current_scope (env.tmp_scope,env.scopes));
+      begin match !idscopes with
+      | None -> idscopes := Some (env.tmp_scope, env.scopes)
+      | Some (tmp, scope) ->
+        let s1 = make_current_scope tmp scope in
+        let s2 = make_current_scope env.tmp_scope env.scopes in
+        if not (List.equal String.equal s1 s2) then error_inconsistent_scope loc id s1 s2
+      end
+    in
     match typ with
     | NtnInternTypeBinder ->
 	if istermvar then error_expect_binder_notation_type loc id
@@ -303,14 +302,14 @@ let set_type_scope env = {env with tmp_scope = Some Notation.type_scope}
 
 let reset_tmp_scope env = {env with tmp_scope = None}
 
-let rec it_mkGProd env body =
+let rec it_mkGProd loc2 env body =
   match env with
-      (na, bk, _, t) :: tl -> it_mkGProd tl (GProd (dummy_loc, na, bk, t, body))
+      (loc1, (na, bk, _, t)) :: tl -> it_mkGProd loc2 tl (GProd (Loc.merge loc1 loc2, na, bk, t, body))
     | [] -> body
 
-let rec it_mkGLambda env body =
+let rec it_mkGLambda loc2 env body =
   match env with
-      (na, bk, _, t) :: tl -> it_mkGLambda tl (GLambda (dummy_loc, na, bk, t, body))
+      (loc1, (na, bk, _, t)) :: tl -> it_mkGLambda loc2 tl (GLambda (Loc.merge loc1 loc2, na, bk, t, body))
     | [] -> body
 
 (**********************************************************************)
@@ -318,7 +317,7 @@ let rec it_mkGLambda env body =
 let build_impls = function
   |Implicit -> (function
 		  |Name id ->  Some (id, Impargs.Manual, (true,true))
-		  |Anonymous -> anomaly "Anonymous implicit argument")
+		  |Anonymous -> anomaly (Pp.str "Anonymous implicit argument"))
   |Explicit -> fun _ -> None
 
 let impls_type_list ?(args = []) =
@@ -337,30 +336,32 @@ let impls_term_list ?(args = []) =
     |_ -> (Variable,[],List.append args (List.rev acc),[])
   in aux []
 
-let check_capture loc ty = function
-  | Name id when occur_var_constr_expr id ty ->
-      raise (InternalizationError (loc,VariableCapture id))
-  | _ ->
+(* Check if in binder "(x1 x2 .. xn : t)", none of x1 .. xn-1 occurs in t *)
+let rec check_capture ty = function
+  | (loc,Name id)::(_,Name id')::_ when occur_glob_constr id ty ->
+      raise (InternalizationError (loc,VariableCapture (id,id')))
+  | _::nal ->
+      check_capture ty nal
+  | [] ->
       ()
 
-let locate_if_isevar loc na = function
-  | GHole _ ->
+let locate_if_hole loc na = function
+  | GHole (_,_,naming,arg) ->
       (try match na with
-	| Name id -> glob_constr_of_aconstr loc (Reserve.find_reserved_type id)
+	| Name id -> glob_constr_of_notation_constr loc
+	               (Reserve.find_reserved_type id)
 	| Anonymous -> raise Not_found
-      with Not_found -> GHole (loc, Evd.BinderType na))
+      with Not_found -> GHole (loc, Evar_kinds.BinderType na, naming, arg))
   | x -> x
 
 let reset_hidden_inductive_implicit_test env =
-  { env with impls = Idmap.fold (fun id x ->
-       let x = match x with
+  { env with impls = Id.Map.map (function
          | (Inductive _,b,c,d) -> (Inductive [],b,c,d)
-         | x -> x
-       in Idmap.add id x) env.impls Idmap.empty }
+         | x -> x) env.impls }
 
 let check_hidden_implicit_parameters id impls =
-  if Idmap.exists (fun _ -> function
-    | (Inductive indparams,_,_,_) -> List.mem id indparams
+  if Id.Map.exists (fun _ -> function
+    | (Inductive indparams,_,_,_) -> Id.List.mem id indparams
     | _ -> false) impls
   then
     errorlabstrm "" (strbrk "A parameter of an inductive type " ++
@@ -374,14 +375,17 @@ let push_name_env ?(global_level=false) lvar implargs env =
       env
   | loc,Name id ->
       check_hidden_implicit_parameters id env.impls ;
-      set_var_scope loc id false env (let (_,ntnvars) = lvar in ntnvars);
+      let (_,ntnvars) = lvar in
+      if Id.Map.is_empty ntnvars && Id.equal id ldots_var
+        then error_ldots_var loc;
+      set_var_scope loc id false env ntnvars;
       if global_level then Dumpglob.dump_definition (loc,id) true "var"
       else Dumpglob.dump_binding loc id;
-      {env with ids = Idset.add id env.ids; impls = Idmap.add id implargs env.impls}
+      {env with ids = Id.Set.add id env.ids; impls = Id.Map.add id implargs env.impls}
 
 let intern_generalized_binder ?(global_level=false) intern_type lvar
-    env bl (loc, na) b b' t ty =
-  let ids = (match na with Anonymous -> fun x -> x | Name na -> Idset.add na) env.ids in
+    env (loc, na) b b' t ty =
+  let ids = (match na with Anonymous -> fun x -> x | Name na -> Id.Set.add na) env.ids in
   let ty, ids' =
     if t then ty, ids else
       Implicit_quantifiers.implicit_application ids
@@ -392,7 +396,11 @@ let intern_generalized_binder ?(global_level=false) intern_type lvar
   let env' = List.fold_left
     (fun env (x, l) -> push_name_env ~global_level lvar (Variable,[],[],[])(*?*) env (l, Name x))
     env fvs in
-  let bl = List.map (fun (id, loc) -> (Name id, b, None, GHole (loc, Evd.BinderType (Name id)))) fvs in
+  let bl = List.map
+    (fun (id, loc) ->
+      (loc, (Name id, b, None, GHole (loc, Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None))))
+    fvs
+  in
   let na = match na with
     | Anonymous ->
 	if global_level then na
@@ -400,183 +408,221 @@ let intern_generalized_binder ?(global_level=false) intern_type lvar
 	  let name =
 	    let id =
 	      match ty with
-	      | CApp (_, (_, CRef (Ident (loc,id))), _) -> id
-	      | _ -> id_of_string "H"
+	      | CApp (_, (_, CRef (Ident (loc,id),_)), _) -> id
+	      | _ -> default_non_dependent_ident
 	    in Implicit_quantifiers.make_fresh ids' (Global.env ()) id
 	  in Name name
     | _ -> na
-  in (push_name_env ~global_level lvar (impls_type_list ty')(*?*) env' (loc,na)), (na,b',None,ty') :: List.rev bl
-
-let intern_local_binder_aux ?(global_level=false) intern intern_type lvar (env,bl) = function
+  in (push_name_env ~global_level lvar (impls_type_list ty')(*?*) env' (loc,na)), (loc,(na,b',None,ty')) :: List.rev bl
+
+let intern_assumption intern lvar env nal bk ty =
+  let intern_type env = intern (set_type_scope env) in
+  match bk with
+  | Default k ->
+      let ty = intern_type env ty in
+      check_capture ty nal;
+      let impls = impls_type_list ty in
+      List.fold_left
+	(fun (env, bl) (loc, na as locna) ->
+          (push_name_env lvar impls env locna,
+           (loc,(na,k,None,locate_if_hole loc na ty))::bl))
+	(env, []) nal
+  | Generalized (b,b',t) ->
+     let env, b = intern_generalized_binder intern_type lvar env (List.hd nal) b b' t ty in
+     env, b
+
+let intern_local_binder_aux ?(global_level=false) intern lvar (env,bl) = function
   | LocalRawAssum(nal,bk,ty) ->
-      (match bk with
-      | Default k ->
-	  let ty = intern_type env ty in
-          let impls = impls_type_list ty in
-	    List.fold_left
-	     (fun (env,bl) (loc,na as locna) ->
-	       (push_name_env lvar impls env locna,
-                (na,k,None,locate_if_isevar loc na ty)::bl))
-	      (env,bl) nal
-      | Generalized (b,b',t) ->
-	  let env, b = intern_generalized_binder ~global_level intern_type lvar env bl (List.hd nal) b b' t ty in
-	    env, b @ bl)
+      let env, bl' = intern_assumption intern lvar env nal bk ty in
+      env, bl' @ bl
   | LocalRawDef((loc,na as locna),def) ->
       let indef = intern env def in
       (push_name_env lvar (impls_term_list indef) env locna,
-      (na,Explicit,Some(indef),GHole(loc,Evd.BinderType na))::bl)
+      (loc,(na,Explicit,Some(indef),GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)))::bl)
 
 let intern_generalization intern env lvar loc bk ak c =
   let c = intern {env with unb = true} c in
   let fvs = Implicit_quantifiers.generalizable_vars_of_glob_constr ~bound:env.ids c in
   let env', c' =
     let abs =
-      let pi =
-	match ak with
+      let pi = match ak with
 	| Some AbsPi -> true
-	| None when env.tmp_scope = Some Notation.type_scope
-	    || List.mem Notation.type_scope env.scopes -> true
-	| _ -> false
+        | Some _ -> false
+	| None ->
+          let is_type_scope = match env.tmp_scope with
+          | None -> false
+          | Some sc -> String.equal sc Notation.type_scope
+          in
+          is_type_scope ||
+          String.List.mem Notation.type_scope env.scopes
       in
 	if pi then
 	  (fun (id, loc') acc ->
-	    GProd (join_loc loc' loc, Name id, bk, GHole (loc', Evd.BinderType (Name id)), acc))
+	    GProd (Loc.merge loc' loc, Name id, bk, GHole (loc', Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
 	else
 	  (fun (id, loc') acc ->
-	    GLambda (join_loc loc' loc, Name id, bk, GHole (loc', Evd.BinderType (Name id)), acc))
+	    GLambda (Loc.merge loc' loc, Name id, bk, GHole (loc', Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
     in
       List.fold_right (fun (id, loc as lid) (env, acc) ->
 	let env' = push_name_env lvar (Variable,[],[],[]) env (loc, Name id) in
 	  (env', abs lid acc)) fvs (env,c)
   in c'
 
-let iterate_binder intern lvar (env,bl) = function
-  | LocalRawAssum(nal,bk,ty) ->
-      let intern_type env = intern (set_type_scope env) in
-      (match bk with
-      | Default k ->
-	  let ty = intern_type env ty in
-          let impls = impls_type_list ty in
-	  List.fold_left
-	    (fun (env,bl) (loc,na as locna) ->
-              (push_name_env lvar impls env locna,
-               (na,k,None,locate_if_isevar loc na ty)::bl))
-	    (env,bl) nal
-      | Generalized (b,b',t) ->
-	  let env, b = intern_generalized_binder intern_type lvar env bl (List.hd nal) b b' t ty in
-	    env, b @ bl)
-  | LocalRawDef((loc,na as locna),def) ->
-      let indef = intern env def in
-      (push_name_env lvar (impls_term_list indef) env locna,
-      (na,Explicit,Some(indef),GHole(loc,Evd.BinderType na))::bl)
-
 (**********************************************************************)
 (* Syntax extensions                                                  *)
 
 let option_mem_assoc id = function
-  | Some (id',c) -> id = id'
+  | Some (id',c) -> Id.equal id id'
   | None -> false
 
-let find_fresh_name renaming (terms,termlists,binders) id =
-  let fvs1 = List.map (fun (_,(c,_)) -> free_vars_of_constr_expr c) terms in
-  let fvs2 = List.flatten (List.map (fun (_,(l,_)) -> List.map free_vars_of_constr_expr l) termlists) in
-  let fvs3 = List.map snd renaming in
+let find_fresh_name renaming (terms,termlists,binders) avoid id =
+  let fold1 _ (c, _) accu = Id.Set.union (free_vars_of_constr_expr c) accu in
+  let fold2 _ (l, _) accu =
+    let fold accu c = Id.Set.union (free_vars_of_constr_expr c) accu in
+    List.fold_left fold accu l
+  in
+  let fold3 _ x accu = Id.Set.add x accu in
+  let fvs1 = Id.Map.fold fold1 terms avoid in
+  let fvs2 = Id.Map.fold fold2 termlists fvs1 in
+  let fvs3 = Id.Map.fold fold3 renaming fvs2 in
   (* TODO binders *)
-  let fvs = List.flatten (List.map Idset.elements (fvs1@fvs2)) @ fvs3 in
-  next_ident_away id fvs
+  next_ident_away_from id (fun id -> Id.Set.mem id fvs3)
 
-let traverse_binder (terms,_,_ as subst)
-    (renaming,env)=
- function
+let traverse_binder (terms,_,_ as subst) avoid (renaming,env) = function
  | Anonymous -> (renaming,env),Anonymous
  | Name id ->
   try
     (* Binders bound in the notation are considered first-order objects *)
-    let _,na = coerce_to_name (fst (List.assoc id terms)) in
-    (renaming,{env with ids = name_fold Idset.add na env.ids}), na
+    let _,na = coerce_to_name (fst (Id.Map.find id terms)) in
+    (renaming,{env with ids = name_fold Id.Set.add na env.ids}), na
   with Not_found ->
     (* Binders not bound in the notation do not capture variables *)
     (* outside the notation (i.e. in the substitution) *)
-    let id' = find_fresh_name renaming subst id in
-    let renaming' = if id=id' then renaming else (id,id')::renaming in
+    let id' = find_fresh_name renaming subst avoid id in
+    let renaming' =
+      if Id.equal id id' then renaming else Id.Map.add id id' renaming
+    in
     (renaming',env), Name id'
 
-let make_letins loc = List.fold_right (fun (na,b,t) c -> GLetIn (loc,na,b,c))
+let make_letins = List.fold_right (fun (loc,(na,b,t)) c -> GLetIn (loc,na,b,c))
 
 let rec subordinate_letins letins = function
   (* binders come in reverse order; the non-let are returned in reverse order together *)
   (* with the subordinated let-in in writing order *)
-  | (na,_,Some b,t)::l ->
-      subordinate_letins ((na,b,t)::letins) l
-  | (na,bk,None,t)::l ->
+  | (loc,(na,_,Some b,t))::l ->
+      subordinate_letins ((loc,(na,b,t))::letins) l
+  | (loc,(na,bk,None,t))::l ->
       let letins',rest = subordinate_letins [] l in
-      letins',((na,bk,t),letins)::rest
+      letins',((loc,(na,bk,t)),letins)::rest
   | [] ->
       letins,[]
 
 let rec subst_iterator y t = function
-  | GVar (_,id) as x -> if id = y then t else x
+  | GVar (_,id) as x -> if Id.equal id y then t else x
   | x -> map_glob_constr (subst_iterator y t) x
 
-let subst_aconstr_in_glob_constr loc intern lvar subst infos c =
+let subst_aconstr_in_glob_constr loc intern (_,ntnvars as lvar) subst infos c =
   let (terms,termlists,binders) = subst in
+  (* when called while defining a notation, avoid capturing the private binders
+     of the expression by variables bound by the notation (see #3892) *)
+  let avoid = Id.Map.domain ntnvars in
   let rec aux (terms,binderopt as subst') (renaming,env) c =
     let subinfos = renaming,{env with tmp_scope = None} in
     match c with
-    | AVar id ->
-      begin
-	(* subst remembers the delimiters stack in the interpretation *)
-	(* of the notations *)
-	try
-	  let (a,(scopt,subscopes)) = List.assoc id terms in
-	  intern {env with tmp_scope = scopt;
-		    scopes = subscopes @ env.scopes} a
-	with Not_found ->
-	try
-	  GVar (loc,List.assoc id renaming)
-	with Not_found ->
-	  (* Happens for local notation joint with inductive/fixpoint defs *)
-	  GVar (loc,id)
-      end
-    | AList (x,_,iter,terminator,lassoc) ->
+    | NVar id -> subst_var subst' (renaming, env) id
+    | NList (x,_,iter,terminator,lassoc) ->
       (try
         (* All elements of the list are in scopes (scopt,subscopes) *)
-	let (l,(scopt,subscopes)) = List.assoc x termlists in
+	let (l,(scopt,subscopes)) = Id.Map.find x termlists in
         let termin = aux subst' subinfos terminator in
-	List.fold_right (fun a t ->
-          subst_iterator ldots_var t
-            (aux ((x,(a,(scopt,subscopes)))::terms,binderopt) subinfos iter))
-            (if lassoc then List.rev l else l) termin
+        let fold a t =
+          let nterms = Id.Map.add x (a, (scopt, subscopes)) terms in
+          subst_iterator ldots_var t (aux (nterms, binderopt) subinfos iter)
+        in
+	List.fold_right fold (if lassoc then List.rev l else l) termin
       with Not_found ->
-          anomaly "Inconsistent substitution of recursive notation")
-    | AHole (Evd.BinderType (Name id as na)) ->
-      let na =
-        try snd (coerce_to_name (fst (List.assoc id terms)))
-        with Not_found -> na in
-      GHole (loc,Evd.BinderType na)
-    | ABinderList (x,_,iter,terminator) ->
+          anomaly (Pp.str "Inconsistent substitution of recursive notation"))
+    | NHole (knd, naming, arg) ->
+      let knd = match knd with
+      | Evar_kinds.BinderType (Name id as na) ->
+        let na =
+          try snd (coerce_to_name (fst (Id.Map.find id terms)))
+          with Not_found ->
+          try Name (Id.Map.find id renaming)
+          with Not_found -> na
+        in
+        Evar_kinds.BinderType na
+      | _ -> knd
+      in
+      let arg = match arg with
+      | None -> None
+      | Some arg ->
+        let open Tacexpr in
+        let open Genarg in
+        let wit = glbwit Constrarg.wit_tactic in
+        let body =
+          if has_type arg wit then out_gen wit arg
+          else assert false (** FIXME *)
+        in
+        let mk_env id (c, (tmp_scope, subscopes)) accu =
+          let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in
+          let gc = intern nenv c in
+          let c = ConstrMayEval (Genredexpr.ConstrTerm (gc, Some c)) in
+          ((loc, id), c) :: accu
+        in
+        let bindings = Id.Map.fold mk_env terms [] in
+        let tac = TacLetIn (false, bindings, body) in
+        let arg = in_gen wit tac in
+        Some arg
+      in
+      GHole (loc, knd, naming, arg)
+    | NBinderList (x,_,iter,terminator) ->
       (try
         (* All elements of the list are in scopes (scopt,subscopes) *)
-	let (bl,(scopt,subscopes)) = List.assoc x binders in
-	let env,bl = List.fold_left (iterate_binder intern lvar) (env,[]) bl in
+	let (bl,(scopt,subscopes)) = Id.Map.find x binders in
+	let env,bl = List.fold_left (intern_local_binder_aux intern lvar) (env,[]) bl in
 	let letins,bl = subordinate_letins [] bl in
         let termin = aux subst' (renaming,env) terminator in
 	let res = List.fold_left (fun t binder ->
           subst_iterator ldots_var t
 	    (aux (terms,Some(x,binder)) subinfos iter))
 	  termin bl in
-	make_letins loc letins res
+	make_letins letins res
       with Not_found ->
-          anomaly "Inconsistent substitution of recursive notation")
-    | AProd (Name id, AHole _, c') when option_mem_assoc id binderopt ->
-        let (na,bk,t),letins = snd (Option.get binderopt) in
-	GProd (loc,na,bk,t,make_letins loc letins (aux subst' infos c'))
-    | ALambda (Name id,AHole _,c') when option_mem_assoc id binderopt ->
-        let (na,bk,t),letins = snd (Option.get binderopt) in
-	GLambda (loc,na,bk,t,make_letins loc letins (aux subst' infos c'))
+          anomaly (Pp.str "Inconsistent substitution of recursive notation"))
+    | NProd (Name id, NHole _, c') when option_mem_assoc id binderopt ->
+        let (loc,(na,bk,t)),letins = snd (Option.get binderopt) in
+	GProd (loc,na,bk,t,make_letins letins (aux subst' infos c'))
+    | NLambda (Name id,NHole _,c') when option_mem_assoc id binderopt ->
+        let (loc,(na,bk,t)),letins = snd (Option.get binderopt) in
+	GLambda (loc,na,bk,t,make_letins letins (aux subst' infos c'))
+    (* Two special cases to keep binder name synchronous with BinderType *)
+    | NProd (na,NHole(Evar_kinds.BinderType na',naming,arg),c')
+        when Name.equal na na' ->
+        let subinfos,na = traverse_binder subst avoid subinfos na in
+        let ty = GHole (loc,Evar_kinds.BinderType na,naming,arg) in
+	GProd (loc,na,Explicit,ty,aux subst' subinfos c')
+    | NLambda (na,NHole(Evar_kinds.BinderType na',naming,arg),c')
+        when Name.equal na na' ->
+        let subinfos,na = traverse_binder subst avoid subinfos na in
+        let ty = GHole (loc,Evar_kinds.BinderType na,naming,arg) in
+	GLambda (loc,na,Explicit,ty,aux subst' subinfos c')
     | t ->
-      glob_constr_of_aconstr_with_binders loc (traverse_binder subst)
-	(aux subst') subinfos t
+      glob_constr_of_notation_constr_with_binders loc
+        (traverse_binder subst avoid) (aux subst') subinfos t
+  and subst_var (terms, binderopt) (renaming, env) id =
+    (* subst remembers the delimiters stack in the interpretation *)
+    (* of the notations *)
+    try
+      let (a,(scopt,subscopes)) = Id.Map.find id terms in
+      intern {env with tmp_scope = scopt;
+                scopes = subscopes @ env.scopes} a
+    with Not_found ->
+    try
+      GVar (loc, Id.Map.find id renaming)
+    with Not_found ->
+      (* Happens for local notation joint with inductive/fixpoint defs *)
+      GVar (loc,id)
   in aux (terms,None) infos c
 
 let split_by_type ids =
@@ -586,7 +632,9 @@ let split_by_type ids =
     | NtnTypeConstrList -> (l1,(x,scl)::l2,l3)
     | NtnTypeBinderList -> (l1,l2,(x,scl)::l3)) ids ([],[],[])
 
-let make_subst ids l = List.map2 (fun (id,scl) a -> (id,(a,scl))) ids l
+let make_subst ids l =
+  let fold accu (id, scl) a = Id.Map.add id (a, scl) accu in
+  List.fold_left2 fold Id.Map.empty ids l
 
 let intern_notation intern env lvar loc ntn fullargs =
   let ntn,(args,argslist,bll as fullargs) = contract_notation ntn fullargs in
@@ -597,7 +645,7 @@ let intern_notation intern env lvar loc ntn fullargs =
   let termlists = make_subst idsl argslist in
   let binders = make_subst idsbl bll in
   subst_aconstr_in_glob_constr loc intern lvar
-    (terms,termlists,binders) ([],env) c
+    (terms, termlists, binders) (Id.Map.empty, env) c
 
 (**********************************************************************)
 (* Discriminating between bound variables and global references       *)
@@ -609,39 +657,35 @@ let string_of_ty = function
   | Variable -> "var"
 
 let intern_var genv (ltacvars,ntnvars) namedctx loc id =
-  let (ltacvars,unbndltacvars) = ltacvars in
   (* Is [id] an inductive type potentially with implicit *)
   try
-    let ty,expl_impls,impls,argsc = Idmap.find id genv.impls in
+    let ty,expl_impls,impls,argsc = Id.Map.find id genv.impls in
     let expl_impls = List.map
-      (fun id -> CRef (Ident (loc,id)), Some (loc,ExplByName id)) expl_impls in
+      (fun id -> CRef (Ident (loc,id),None), Some (loc,ExplByName id)) expl_impls in
     let tys = string_of_ty ty in
-    Dumpglob.dump_reference loc "<>" (string_of_id id) tys;
+    Dumpglob.dump_reference loc "<>" (Id.to_string id) tys;
     GVar (loc,id), make_implicits_list impls, argsc, expl_impls
   with Not_found ->
   (* Is [id] bound in current term or is an ltac var bound to constr *)
-  if Idset.mem id genv.ids or List.mem id ltacvars
+  if Id.Set.mem id genv.ids || Id.Set.mem id ltacvars.ltac_vars
   then
     GVar (loc,id), [], [], []
   (* Is [id] a notation variable *)
-
-  else if List.mem_assoc id ntnvars
+  else if Id.Map.mem id ntnvars
   then
     (set_var_scope loc id true genv ntnvars; GVar (loc,id), [], [], [])
   (* Is [id] the special variable for recursive notations *)
-  else if ntnvars <> [] && id = ldots_var
-  then
-    GVar (loc,id), [], [], []
+  else if Id.equal id ldots_var
+  then if Id.Map.is_empty ntnvars
+    then error_ldots_var loc
+    else GVar (loc,id), [], [], []
+  else if Id.Set.mem id ltacvars.ltac_bound then
+    (* Is [id] bound to a free name in ltac (this is an ltac error message) *)
+    user_err_loc (loc,"intern_var",
+      str "variable " ++ pr_id id ++ str " should be bound to a term.")
   else
-  (* Is [id] bound to a free name in ltac (this is an ltac error message) *)
-  try
-    match List.assoc id unbndltacvars with
-      | None -> user_err_loc (loc,"intern_var",
-	  str "variable " ++ pr_id id ++ str " should be bound to a term.")
-      | Some id0 -> Pretype_errors.error_var_not_found_loc loc id0
-  with Not_found ->
     (* Is [id] a goal or section variable *)
-    let _ = Sign.lookup_named id namedctx in
+    let _ = Context.lookup_named id namedctx in
       try
 	(* [id] a section variable *)
 	(* Redundant: could be done in intern_qualid *)
@@ -649,128 +693,171 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id =
 	let impls = implicits_of_global ref in
 	let scopes = find_arguments_scope ref in
 	Dumpglob.dump_reference loc "<>" (string_of_qualid (Decls.variable_secpath id)) "var";
-	GRef (loc, ref), impls, scopes, []
+	GRef (loc, ref, None), impls, scopes, []
       with e when Errors.noncritical e ->
 	(* [id] a goal variable *)
 	GVar (loc,id), [], [], []
 
-let find_appl_head_data = function
-  | GRef (_,ref) as x -> x,implicits_of_global ref,find_arguments_scope ref,[]
-  | GApp (_,GRef (_,ref),l) as x
-      when l <> [] & Flags.version_strictly_greater Flags.V8_2 ->
+let proj_impls r impls =
+  let env = Global.env () in
+  let f (x, l) = x, projection_implicits env r l in
+    List.map f impls
+
+let proj_scopes n scopes = 
+  List.skipn_at_least n scopes
+
+let proj_impls_scopes p impls scopes =
+  match p with
+  | Some (r, n) -> proj_impls r impls, proj_scopes n scopes
+  | None -> impls, scopes
+
+let find_appl_head_data c =
+  match c with
+  | GRef (loc,ref,_) as x -> 
+    let impls = implicits_of_global ref in
+    let scopes = find_arguments_scope ref in
+      x, impls, scopes, []
+  | GApp (_,GRef (_,ref,_),l) as x
+      when l != [] && Flags.version_strictly_greater Flags.V8_2 ->
       let n = List.length l in
-      x,List.map (drop_first_implicits n) (implicits_of_global ref),
-      list_skipn_at_least n (find_arguments_scope ref),[]
+      let impls = implicits_of_global ref in 
+      let scopes = find_arguments_scope ref in
+	x, List.map (drop_first_implicits n) impls,
+	List.skipn_at_least n scopes,[]
   | x -> x,[],[],[]
 
 let error_not_enough_arguments loc =
   user_err_loc (loc,"",str "Abbreviation is not applied enough.")
 
 let check_no_explicitation l =
-  let l = List.filter (fun (a,b) -> b <> None) l in
-  if l <> [] then
-    let loc = fst (Option.get (snd (List.hd l))) in
-    user_err_loc
-     (loc,"",str"Unexpected explicitation of the argument of an abbreviation.")
+  let is_unset (a, b) = match b with None -> false | Some _ -> true in
+  let l = List.filter is_unset l in
+  match l with
+  | [] -> ()
+  | (_, None) :: _ -> assert false
+  | (_, Some (loc, _)) :: _ ->
+    user_err_loc (loc,"",str"Unexpected explicitation of the argument of an abbreviation.")
 
 let dump_extended_global loc = function
-  | TrueGlobal ref -> Dumpglob.add_glob loc ref
+  | TrueGlobal ref -> (*feedback_global loc ref;*) Dumpglob.add_glob loc ref
   | SynDef sp -> Dumpglob.add_glob_kn loc sp
 
 let intern_extended_global_of_qualid (loc,qid) =
-  try let r = Nametab.locate_extended qid in dump_extended_global loc r; r
-  with Not_found -> error_global_not_found_loc loc qid
+  let r = Nametab.locate_extended qid in dump_extended_global loc r; r
 
 let intern_reference ref =
-  Smartlocate.global_of_extended_global
-    (intern_extended_global_of_qualid (qualid_of_reference ref))
+  let qid = qualid_of_reference ref in
+  let r =
+    try intern_extended_global_of_qualid qid
+    with Not_found -> error_global_not_found_loc (fst qid) (snd qid)
+  in
+  Smartlocate.global_of_extended_global r
 
 (* Is it a global reference or a syntactic definition? *)
-let intern_qualid loc qid intern env lvar args =
+let intern_qualid loc qid intern env lvar us args =
   match intern_extended_global_of_qualid (loc,qid) with
-  | TrueGlobal ref ->
-      GRef (loc, ref), args
+  | TrueGlobal ref -> GRef (loc, ref, us), true, args
   | SynDef sp ->
       let (ids,c) = Syntax_def.search_syntactic_definition sp in
       let nids = List.length ids in
       if List.length args < nids then error_not_enough_arguments loc;
-      let args1,args2 = list_chop nids args in
+      let args1,args2 = List.chop nids args in
       check_no_explicitation args1;
-      let subst = make_subst ids (List.map fst args1) in
-      subst_aconstr_in_glob_constr loc intern lvar (subst,[],[]) ([],env) c, args2
+      let terms = make_subst ids (List.map fst args1) in
+      let subst = (terms, Id.Map.empty, Id.Map.empty) in
+      let infos = (Id.Map.empty, env) in
+      let projapp = match c with NRef _ -> true | _ -> false in
+	subst_aconstr_in_glob_constr loc intern lvar subst infos c, projapp, args2
 
 (* Rule out section vars since these should have been found by intern_var *)
-let intern_non_secvar_qualid loc qid intern env lvar args =
-  match intern_qualid loc qid intern env lvar args with
-    | GRef (loc, VarRef id),_ -> error_global_not_found_loc loc qid
+let intern_non_secvar_qualid loc qid intern env lvar us args =
+  match intern_qualid loc qid intern env lvar us args with
+    | GRef (_, VarRef _, _),_,_ -> raise Not_found
     | r -> r
 
-let intern_applied_reference intern env namedctx lvar args = function
+let intern_applied_reference intern env namedctx lvar us args = function
   | Qualid (loc, qid) ->
-      let r,args2 = intern_qualid loc qid intern env lvar args in
-      find_appl_head_data r, args2
+      let r,projapp,args2 =
+	try intern_qualid loc qid intern env lvar us args
+	with Not_found -> error_global_not_found_loc loc qid
+      in
+      let x, imp, scopes, l = find_appl_head_data r in
+	(x,imp,scopes,l), args2
   | Ident (loc, id) ->
       try intern_var env lvar namedctx loc id, args
       with Not_found ->
       let qid = qualid_of_ident id in
       try
-	let r,args2 = intern_non_secvar_qualid loc qid intern env lvar args in
-	find_appl_head_data r, args2
-      with e when Errors.noncritical e ->
+	let r, projapp, args2 = intern_non_secvar_qualid loc qid intern env lvar us args in
+	let x, imp, scopes, l = find_appl_head_data r in
+	  (x,imp,scopes,l), args2
+      with Not_found ->
 	(* Extra allowance for non globalizing functions *)
 	if !interning_grammar || env.unb then
-	  (GVar (loc,id), [], [], []),args
-	else raise e
+	  (GVar (loc,id), [], [], []), args
+	else error_global_not_found_loc loc qid
 
 let interp_reference vars r =
   let (r,_,_,_),_ =
-    intern_applied_reference (fun _ -> error_not_enough_arguments dummy_loc)
-      {ids = Idset.empty; unb = false ;
+    intern_applied_reference (fun _ -> error_not_enough_arguments Loc.ghost)
+      {ids = Id.Set.empty; unb = false ;
        tmp_scope = None; scopes = []; impls = empty_internalization_env} []
-      (vars,[]) [] r
+      (vars, Id.Map.empty) None [] r
   in r
 
+(**********************************************************************)
+(** {5 Cases }                                                        *)
+
+(** {6 Elemtary bricks } *)
 let apply_scope_env env = function
   | [] -> {env with tmp_scope = None}, []
   | sc::scl -> {env with tmp_scope = sc}, scl
 
 let rec simple_adjust_scopes n scopes =
-  if n=0 then [] else match scopes with
+  (* Note: they can be less scopes than arguments but also more scopes *)
+  (* than arguments because extra scopes are used in the presence of *)
+  (* coercions to funclass *)
+  if Int.equal n 0 then [] else match scopes with
   | [] -> None :: simple_adjust_scopes (n-1) []
   | sc::scopes -> sc :: simple_adjust_scopes (n-1) scopes
 
-let find_remaining_constructor_scopes pl1 pl2 (ind,j as cstr) =
-  let (mib,mip) = Inductive.lookup_mind_specif (Global.env()) ind in
-  let npar = mib.Declarations.mind_nparams in
-  snd (list_chop (npar + List.length pl1)
-    (simple_adjust_scopes (npar + List.length pl1 + List.length pl2)
-      (find_arguments_scope (ConstructRef cstr))))
+let find_remaining_scopes pl1 pl2 ref =
+  let impls_st = implicits_of_global ref in
+  let len_pl1 = List.length pl1 in
+  let len_pl2 = List.length pl2 in
+  let impl_list = if Int.equal len_pl1 0
+    then select_impargs_size len_pl2 impls_st
+    else List.skipn_at_least len_pl1 (select_stronger_impargs impls_st) in
+  let allscs = find_arguments_scope ref in
+  let scope_list = List.skipn_at_least len_pl1 allscs in
+  let rec aux = function
+    |[],l -> l
+    |_,[] -> []
+    |h::t,_::tt when is_status_implicit h -> aux (t,tt)
+    |_::t,h::tt -> h :: aux (t,tt)
+  in ((try List.firstn len_pl1 allscs with Failure _ -> simple_adjust_scopes len_pl1 allscs),
+      simple_adjust_scopes len_pl2 (aux (impl_list,scope_list)))
 
-(**********************************************************************)
-(* Cases                                                              *)
+let merge_subst s1 s2 = Id.Map.fold Id.Map.add s1 s2
 
 let product_of_cases_patterns ids idspl =
   List.fold_right (fun (ids,pl) (ids',ptaill) ->
-    (ids@ids',
-    (* Cartesian prod of the or-pats for the nth arg and the tail args *)
-    List.flatten (
-    List.map (fun (subst,p) ->
-      List.map (fun (subst',ptail) -> (subst@subst',p::ptail)) ptaill) pl)))
-    idspl (ids,[[],[]])
-
-let simple_product_of_cases_patterns pl =
-  List.fold_right (fun pl ptaill ->
-    List.flatten (List.map (fun (subst,p) ->
-      List.map (fun (subst',ptail) -> (subst@subst',p::ptail)) ptaill) pl))
-    pl [[],[]]
-
-(* Check linearity of pattern-matching *)
+    (ids @ ids',
+     (* Cartesian prod of the or-pats for the nth arg and the tail args *)
+     List.flatten (
+       List.map (fun (subst,p) ->
+	 List.map (fun (subst',ptail) -> (merge_subst subst subst',p::ptail)) ptaill) pl)))
+    idspl (ids,[Id.Map.empty,[]])
+
+(* @return the first variable that occurs twice in a pattern
+
+naive n^2 algo *)
 let rec has_duplicate = function
   | [] -> None
-  | x::l -> if List.mem x l then (Some x) else has_duplicate l
+  | x::l -> if Id.List.mem x l then (Some x) else has_duplicate l
 
 let loc_of_lhs lhs =
- join_loc (fst (List.hd lhs)) (fst (list_last lhs))
+ Loc.merge (fst (List.hd lhs)) (fst (List.last lhs))
 
 let check_linearity lhs ids =
   match has_duplicate ids with
@@ -782,167 +869,89 @@ let check_linearity lhs ids =
 (* Match the number of pattern against the number of matched args *)
 let check_number_of_pattern loc n l =
   let p = List.length l in
-  if n<>p then raise (InternalizationError (loc,BadPatternsNumber (n,p)))
+  if not (Int.equal n p) then raise (InternalizationError (loc,BadPatternsNumber (n,p)))
 
 let check_or_pat_variables loc ids idsl =
-  if List.exists (fun ids' -> not (list_eq_set ids ids')) idsl then
+  if List.exists (fun ids' -> not (List.eq_set Id.equal ids ids')) idsl then
     user_err_loc (loc, "", str
     "The components of this disjunctive pattern must bind the same variables.")
 
-let check_constructor_length env loc cstr pl pl0 =
-  let n = List.length pl + List.length pl0 in
-  let nargs = Inductiveops.constructor_nrealargs env cstr in
-  let nhyps = Inductiveops.constructor_nrealhyps env cstr in
-  if n <> nargs && n <> nhyps (* i.e. with let's *) then
-    error_wrong_numarg_constructor_loc loc env cstr nargs
-
-(* Manage multiple aliases *)
-
-  (* [merge_aliases] returns the sets of all aliases encountered at this
-     point and a substitution mapping extra aliases to the first one *)
-let merge_aliases (ids,asubst as _aliases) id =
-  ids@[id], if ids=[] then asubst else (id, List.hd ids)::asubst
-
-let alias_of = function
-  | ([],_) -> Anonymous
-  | (id::_,_) -> Name id
-
-let message_redundant_alias (id1,id2) =
-  if_warn msg_warning
-    (str "Alias variable " ++ pr_id id1 ++ str " is merged with " ++ pr_id id2)
-
-(* Expanding notations *)
-
-let chop_aconstr_constructor loc (ind,k) args =
-  if List.length args = 0 then (* Tolerance for a @id notation *) args else
-    begin
-      let mib,_ = Global.lookup_inductive ind in
-      let nparams = mib.Declarations.mind_nparams in
-      if nparams > List.length args then error_invalid_pattern_notation loc;
-      let params,args = list_chop nparams args in
-      List.iter (function AHole _ -> ()
-	| _ -> error_invalid_pattern_notation loc) params;
-      args
-    end
-
-let rec subst_pat_iterator y t (subst,p) = match p with
-  | PatVar (_,id) as x ->
-      if id = Name y then t else [subst,x]
-  | PatCstr (loc,id,l,alias) ->
-      let l' = List.map (fun a -> (subst_pat_iterator y t ([],a))) l in
-      let pl = simple_product_of_cases_patterns l' in
-      List.map (fun (subst',pl) -> subst'@subst,PatCstr (loc,id,pl,alias)) pl
-
-let subst_cases_pattern loc alias intern fullsubst env a =
-  let rec aux alias (subst,substlist as fullsubst) = function
-  | AVar id ->
-      begin
-	(* subst remembers the delimiters stack in the interpretation *)
-	(* of the notations *)
-	try
-	  let (a,(scopt,subscopes)) = List.assoc id subst in
-	    intern {env with scopes=subscopes@env.scopes;
-		      tmp_scope = scopt} ([],[]) a
-	with Not_found ->
-	  if id = ldots_var then [], [[], PatVar (loc,Name id)] else
-	  anomaly ("Unbound pattern notation variable: "^(string_of_id id))
-	  (*
-	  (* Happens for local notation joint with inductive/fixpoint defs *)
-	  if aliases <> ([],[]) then
-	    anomaly "Pattern notation without constructors";
-	  [[id],[]], PatVar (loc,Name id)
-	  *)
-      end
-  | ARef (ConstructRef c) ->
-      ([],[[], PatCstr (loc,c, [], alias)])
-  | AApp (ARef (ConstructRef cstr),args) ->
-      let args = chop_aconstr_constructor loc cstr args in
-      let idslpll = List.map (aux Anonymous fullsubst) args in
-      let ids',pll = product_of_cases_patterns [] idslpll in
-      let pl' = List.map (fun (asubst,pl) ->
-        asubst,PatCstr (loc,cstr,pl,alias)) pll in
-	ids', pl'
-  | AList (x,_,iter,terminator,lassoc) ->
-      (try
-        (* All elements of the list are in scopes (scopt,subscopes) *)
-	let (l,(scopt,subscopes)) = List.assoc x substlist in
-        let termin = aux Anonymous fullsubst terminator in
-        let idsl,v =
-	  List.fold_right (fun a (tids,t) ->
-            let uids,u = aux Anonymous ((x,(a,(scopt,subscopes)))::subst,substlist) iter in
-            let pll = List.map (subst_pat_iterator ldots_var t) u in
-            tids@uids, List.flatten pll)
-            (if lassoc then List.rev l else l) termin in
-        idsl, List.map (fun ((asubst, pl) as x) ->
-	  match pl with PatCstr (loc, c, pl, Anonymous) -> (asubst, PatCstr (loc, c, pl, alias)) | _ -> x) v
-      with Not_found ->
-          anomaly "Inconsistent substitution of recursive notation")
-  | AHole _ -> ([],[[], PatVar (loc,Anonymous)])
-  | t -> error_invalid_pattern_notation loc
-  in aux alias fullsubst a
-
-(* Differentiating between constructors and matching variables *)
-type pattern_qualid_kind =
-  | ConstrPat of constructor * (identifier list *
-      ((identifier * identifier) list * cases_pattern) list) list
-  | VarPat of identifier
-
-let find_constructor ref f aliases pats env =
-  let (loc,qid) = qualid_of_reference ref in
-  let gref =
-    try locate_extended qid
-    with Not_found -> raise (InternalizationError (loc,NotAConstructor ref)) in
-  match gref with
-  | SynDef sp ->
-      let (vars,a) = Syntax_def.search_syntactic_definition sp in
-      (match a with
-       | ARef (ConstructRef cstr) ->
-	   assert (vars=[]);
-	   cstr, [], pats
-       | AApp (ARef (ConstructRef cstr),args) ->
-	   let args = chop_aconstr_constructor loc cstr args in
-	   let nvars = List.length vars in
-	   if List.length pats < nvars then error_not_enough_arguments loc;
-	   let pats1,pats2 = list_chop nvars pats in
-	   let subst = List.map2 (fun (id,scl) a -> (id,(a,scl))) vars pats1 in
-	   let idspl1 = List.map (subst_cases_pattern loc Anonymous f (subst,[]) env) args in
-	   cstr, idspl1, pats2
-       | _ -> raise Not_found)
-
-  | TrueGlobal r ->
-      let rec unf = function
-        | ConstRef cst ->
-	    let v = Environ.constant_value (Global.env()) cst in
-	    unf (global_of_constr v)
-        | ConstructRef cstr ->
-	    Dumpglob.add_glob loc r;
-	    cstr, [], pats
-        | _ -> raise Not_found
-      in unf r
+(** Use only when params were NOT asked to the user.
+    @return if letin are included *)
+let check_constructor_length env loc cstr len_pl pl0 =
+  let n = len_pl + List.length pl0 in
+  if Int.equal n (Inductiveops.constructor_nallargs cstr) then false else
+    (Int.equal n (Inductiveops.constructor_nalldecls cstr) ||
+      (error_wrong_numarg_constructor_loc loc env cstr
+         (Inductiveops.constructor_nrealargs cstr)))
+
+let add_implicits_check_length fail nargs nargs_with_letin impls_st len_pl1 pl2 =
+  let impl_list = if Int.equal len_pl1 0
+    then select_impargs_size (List.length pl2) impls_st
+    else List.skipn_at_least len_pl1 (select_stronger_impargs impls_st) in
+  let remaining_args = List.fold_left (fun i x -> if is_status_implicit x then i else succ i) in
+  let rec aux i = function
+    |[],l -> let args_len = List.length l + List.length impl_list + len_pl1 in
+	     ((if Int.equal args_len nargs then false
+	      else Int.equal args_len nargs_with_letin || (fst (fail (nargs - List.length impl_list + i))))
+	       ,l)
+    |imp::q as il,[] -> if is_status_implicit imp && maximal_insertion_of imp
+      then let (b,out) = aux i (q,[]) in (b,RCPatAtom(Loc.ghost,None)::out)
+      else fail (remaining_args (len_pl1+i) il)
+    |imp::q,(hh::tt as l) -> if is_status_implicit imp
+      then let (b,out) = aux i (q,l) in (b,RCPatAtom(Loc.ghost,None)::out)
+      else let (b,out) = aux (succ i) (q,tt) in (b,hh::out)
+  in aux 0 (impl_list,pl2)
+
+let add_implicits_check_constructor_length env loc c len_pl1 pl2 =
+  let nargs = Inductiveops.constructor_nallargs c in
+  let nargs' = Inductiveops.constructor_nalldecls c in
+  let impls_st = implicits_of_global (ConstructRef c) in
+  add_implicits_check_length (error_wrong_numarg_constructor_loc loc env c)
+    nargs nargs' impls_st len_pl1 pl2
+
+let add_implicits_check_ind_length env loc c len_pl1 pl2 =
+  let nallargs = inductive_nallargs_env env c in
+  let nalldecls = inductive_nalldecls_env env c in
+  let impls_st = implicits_of_global (IndRef c) in
+  add_implicits_check_length (error_wrong_numarg_inductive_loc loc env c)
+    nallargs nalldecls impls_st len_pl1 pl2
+
+(** Do not raise NotEnoughArguments thanks to preconditions*)
+let chop_params_pattern loc ind args with_letin =
+  let nparams = if with_letin
+    then Inductiveops.inductive_nparamdecls ind
+    else Inductiveops.inductive_nparams ind in
+  assert (nparams <= List.length args);
+  let params,args = List.chop nparams args in
+  List.iter (function PatVar(_,Anonymous) -> ()
+    | PatVar (loc',_) | PatCstr(loc',_,_,_) -> error_parameter_not_implicit loc') params;
+  args
+
+let find_constructor loc add_params ref =
+  let cstr = match ref with
+  | ConstructRef cstr -> cstr
+  | IndRef _ ->
+    let error = str "There is an inductive name deep in a \"in\" clause." in
+    user_err_loc (loc, "find_constructor", error)
+  | ConstRef _ | VarRef _ ->
+    let error = str "This reference is not a constructor." in
+    user_err_loc (loc, "find_constructor", error)
+  in
+  cstr, (function (ind,_ as c) -> match add_params with
+    |Some nb_args ->
+      let nb =
+        if Int.equal nb_args (Inductiveops.constructor_nrealdecls c)
+          then Inductiveops.inductive_nparamdecls ind
+          else Inductiveops.inductive_nparams ind
+      in
+      List.make nb ([], [(Id.Map.empty, PatVar(Loc.ghost,Anonymous))])
+    |None -> []) cstr
 
 let find_pattern_variable = function
   | Ident (loc,id) -> id
   | Qualid (loc,_) as x -> raise (InternalizationError(loc,NotAConstructor x))
 
-let maybe_constructor ref f aliases env =
-  try
-    let c,idspl1,pl2 = find_constructor ref f aliases [] env in
-    assert (pl2 = []);
-    ConstrPat (c,idspl1)
-  with
-      (* patt var does not exists globally *)
-    | InternalizationError _ -> VarPat (find_pattern_variable ref)
-      (* patt var also exists globally but does not satisfy preconditions *)
-    | (Environ.NotEvaluableConst _ | Not_found) ->
-        if_warn msg_warning (str "pattern " ++ pr_reference ref ++
-              str " is understood as a pattern variable");
-        VarPat (find_pattern_variable ref)
-
-let mustbe_constructor loc ref f aliases patl env =
-  try find_constructor ref f aliases patl env
-  with (Environ.NotEvaluableConst _ | Not_found) ->
-    raise (InternalizationError (loc,NotAConstructor ref))
-
 let sort_fields mode loc l completer =
 (*mode=false if pattern and true if constructor*)
   match l with
@@ -966,18 +975,19 @@ let sort_fields mode loc l completer =
 	      | [] -> (i, acc)
 	      | (Some name) :: b->
 		 (match m with
-		    | [] -> anomaly "Number of projections mismatch"
+		    | [] -> anomaly (Pp.str "Number of projections mismatch")
 		    | (_, regular)::tm ->
 		       let boolean = not regular in
-                       (match global_reference_of_reference refer with
-                       | ConstRef name' when eq_constant name name' ->
+                       begin match global_reference_of_reference refer with
+		       | ConstRef name' when eq_constant name name' ->
 			 if boolean && mode then
 			   user_err_loc (loc, "", str"No local fields allowed in a record construction.")
 			 else build_patt b tm (i + 1) (i, snd acc) (* we found it *)
                        | _ ->
 			  build_patt b tm (if boolean&&mode then i else i + 1)
 			    (if boolean && mode then acc
-			     else fst acc, (i, ConstRef name) :: snd acc)))
+			     else fst acc, (i, ConstRef name) :: snd acc)
+                       end)
 	      | None :: b-> (* we don't want anonymous fields *)
 		 if mode then
 		   user_err_loc (loc, "", str "This record contains anonymous fields.")
@@ -987,9 +997,9 @@ let sort_fields mode loc l completer =
 	  let ind = record.Recordops.s_CONST in
 	  try (* insertion of Constextern.reference_global *)
 	    (record.Recordops.s_EXPECTEDPARAM,
-	     Qualid (loc, shortest_qualid_of_global Idset.empty (ConstructRef ind)),
+	     Qualid (loc, shortest_qualid_of_global Id.Set.empty (ConstructRef ind)),
 	     build_patt record.Recordops.s_PROJ record.Recordops.s_PROJKIND 1 (0,[]))
-	  with Not_found -> anomaly "Environment corruption for records."
+	  with Not_found -> anomaly (Pp.str "Environment corruption for records.")
 	  in
 	(* now we want to have all fields of the pattern indexed by their place in
 	   the constructor *)
@@ -1032,111 +1042,287 @@ let sort_fields mode loc l completer =
 	Some (nparams, base_constructor,
 	  List.rev (clean_list sorted_indexed_pattern 0 []))
 
-let rec intern_cases_pattern genv env (ids,asubst as aliases) pat =
-  let intern_pat = intern_cases_pattern genv in
-  match pat with
-  | CPatAlias (loc, p, id) ->
-      let aliases' = merge_aliases aliases id in
-      intern_pat env aliases' p
+(** {6 Manage multiple aliases} *)
+
+type alias = {
+  alias_ids : Id.t list;
+  alias_map : Id.t Id.Map.t;
+}
+
+let empty_alias = {
+  alias_ids = [];
+  alias_map = Id.Map.empty;
+}
+
+  (* [merge_aliases] returns the sets of all aliases encountered at this
+     point and a substitution mapping extra aliases to the first one *)
+let merge_aliases aliases id =
+  let alias_ids = aliases.alias_ids @ [id] in
+  let alias_map = match aliases.alias_ids with
+  | [] -> aliases.alias_map
+  | id' :: _ -> Id.Map.add id id' aliases.alias_map
+  in
+  { alias_ids; alias_map; }
+
+let alias_of als = match als.alias_ids with
+| [] -> Anonymous
+| id :: _ -> Name id
+
+let message_redundant_alias id1 id2 =
+  msg_warning
+    (str "Alias variable " ++ pr_id id1 ++ str " is merged with " ++ pr_id id2)
+
+(** {6 Expanding notations }
+
+    @returns a raw_case_pattern_expr :
+    - no notations and syntactic definition
+    - global reference and identifeir instead of reference
+
+*)
+
+let rec subst_pat_iterator y t p = match p with
+  | RCPatAtom (_,id) ->
+    begin match id with Some x when Id.equal x y -> t | _ -> p end
+  | RCPatCstr (loc,id,l1,l2) ->
+     RCPatCstr (loc,id,List.map (subst_pat_iterator y t) l1,
+	       List.map (subst_pat_iterator y t) l2)
+  | RCPatAlias (l,p,a) -> RCPatAlias (l,subst_pat_iterator y t p,a)
+  | RCPatOr (l,pl) -> RCPatOr (l,List.map (subst_pat_iterator y t) pl)
+
+let drop_notations_pattern looked_for =
+  (* At toplevel, Constructors and Inductives are accepted, in recursive calls
+     only constructor are allowed *)
+  let ensure_kind top loc g =
+    try
+      if top then looked_for g else
+      match g with ConstructRef _ -> () | _ -> raise Not_found
+    with Not_found ->
+      error_invalid_pattern_notation loc
+  in
+  let test_kind top =
+    if top then looked_for else function ConstructRef _ -> () | _ -> raise Not_found
+  in
+  let rec drop_syndef top env re pats =
+    let (loc,qid) = qualid_of_reference re in
+    try
+      match locate_extended qid with
+      |SynDef sp ->
+	let (vars,a) = Syntax_def.search_syntactic_definition sp in
+	(match a with
+	| NRef g ->
+	  test_kind top g;
+	  let () = assert (List.is_empty vars) in
+	  let (_,argscs) = find_remaining_scopes [] pats g in
+	  Some (g, [], List.map2 (in_pat_sc env) argscs pats)
+	| NApp (NRef g,[]) -> (* special case : Syndef for @Cstr *)
+	      test_kind top g;
+              let () = assert (List.is_empty vars) in
+	      let (argscs,_) = find_remaining_scopes pats [] g in
+	      Some (g, List.map2 (in_pat_sc env) argscs pats, [])
+	| NApp (NRef g,args) ->
+	      ensure_kind top loc g;
+	      let nvars = List.length vars in
+	      if List.length pats < nvars then error_not_enough_arguments loc;
+	      let pats1,pats2 = List.chop nvars pats in
+	      let subst = make_subst vars pats1 in
+	      let idspl1 = List.map (in_not false loc env (subst, Id.Map.empty) []) args in
+	      let (_,argscs) = find_remaining_scopes pats1 pats2 g in
+	      Some (g, idspl1, List.map2 (in_pat_sc env) argscs pats2)
+	| _ -> raise Not_found)
+      |TrueGlobal g ->
+	  test_kind top g;
+	  Dumpglob.add_glob loc g;
+	  let (_,argscs) = find_remaining_scopes [] pats g in
+	  Some (g,[],List.map2 (fun x -> in_pat false {env with tmp_scope = x}) argscs pats)
+    with Not_found -> None
+  and in_pat top env = function
+    | CPatAlias (loc, p, id) -> RCPatAlias (loc, in_pat top env p, id)
     | CPatRecord (loc, l) ->
-	let sorted_fields = sort_fields false loc l (fun _ l -> (CPatAtom (loc, None))::l) in
-	let self_patt =
-	  match sorted_fields with
-	    | None -> CPatAtom (loc, None)
-	    | Some (_, head, pl) -> CPatCstr(loc, head, pl)
-	  in
-	intern_pat env aliases self_patt
-  | CPatCstr (loc, head, pl) | CPatCstrExpl (loc, head, pl) ->
-      let c,idslpl1,pl2 = mustbe_constructor loc head intern_pat aliases pl env in
-      check_constructor_length genv loc c idslpl1 pl2;
-      let argscs2 = find_remaining_constructor_scopes idslpl1 pl2 c in
-      let idslpl2 = List.map2 (fun x -> intern_pat {env with tmp_scope = x} ([],[])) argscs2 pl2 in
-      let (ids',pll) = product_of_cases_patterns ids (idslpl1@idslpl2) in
-      let pl' = List.map (fun (asubst,pl) ->
-        (asubst, PatCstr (loc,c,pl,alias_of aliases))) pll in
-      ids',pl'
-  | CPatNotation (loc,"- _",([CPatPrim(_,Numeral p)],[]))
-      when Bigint.is_strictly_pos p ->
-      intern_pat env aliases (CPatPrim(loc,Numeral(Bigint.neg p)))
-  | CPatNotation (_,"( _ )",([a],[])) ->
-      intern_pat env aliases a
-  | CPatNotation (loc, ntn, fullargs) ->
+      let sorted_fields =
+	sort_fields false loc l (fun _ l -> (CPatAtom (loc, None))::l) in
+      begin match sorted_fields with
+	| None -> RCPatAtom (loc, None)
+	| Some (_, head, pl) ->
+	  match drop_syndef top env head pl with
+	    |Some (a,b,c) -> RCPatCstr(loc, a, b, c)
+	    |None -> raise (InternalizationError (loc,NotAConstructor head))
+      end
+    | CPatCstr (loc, head, [], pl) ->
+      begin
+	match drop_syndef top env head pl with
+	  | Some (a,b,c) -> RCPatCstr(loc, a, b, c)
+	  | None -> raise (InternalizationError (loc,NotAConstructor head))
+      end
+    | CPatCstr (loc, r, expl_pl, pl) ->
+      let g = try
+		      (locate (snd (qualid_of_reference r)))
+	    with Not_found ->
+ 	      raise (InternalizationError (loc,NotAConstructor r)) in
+      let (argscs1,argscs2) = find_remaining_scopes expl_pl pl g in
+      RCPatCstr (loc, g, List.map2 (in_pat_sc env) argscs1 expl_pl, List.map2 (in_pat_sc env) argscs2 pl)
+    | CPatNotation (loc,"- _",([CPatPrim(_,Numeral p)],[]),[])
+	when Bigint.is_strictly_pos p ->
+      fst (Notation.interp_prim_token_cases_pattern_expr loc (ensure_kind false loc) (Numeral (Bigint.neg p))
+	     (env.tmp_scope,env.scopes))
+    | CPatNotation (_,"( _ )",([a],[]),[]) ->
+      in_pat top env a
+    | CPatNotation (loc, ntn, fullargs,extrargs) ->
       let ntn,(args,argsl as fullargs) = contract_pat_notation ntn fullargs in
       let ((ids',c),df) = Notation.interp_notation loc ntn (env.tmp_scope,env.scopes) in
       let (ids',idsl',_) = split_by_type ids' in
       Dumpglob.dump_notation_location (patntn_loc loc fullargs ntn) ntn df;
-      let subst = List.map2 (fun (id,scl) a -> (id,(a,scl))) ids' args in
-      let substlist = List.map2 (fun (id,scl) a -> (id,(a,scl))) idsl' argsl in
-      let ids'',pl =
-	subst_cases_pattern loc (alias_of aliases) intern_pat (subst,substlist)
-	  env c
-      in ids@ids'', pl
-  | CPatPrim (loc, p) ->
-      let a = alias_of aliases in
-      let (c,_) = Notation.interp_prim_token_cases_pattern loc p a
-	(env.tmp_scope,env.scopes) in
-      (ids,[asubst,c])
-  | CPatDelimiters (loc, key, e) ->
-      intern_pat {env with scopes=find_delimiters_scope loc key::env.scopes;
-		    tmp_scope = None} aliases e
-  | CPatAtom (loc, Some head) ->
-      (match maybe_constructor head intern_pat aliases env with
-	 | ConstrPat (c,idspl) ->
-	     check_constructor_length genv loc c idspl [];
-	     let (ids',pll) = product_of_cases_patterns ids idspl in
-	     (ids,List.map (fun (asubst,pl) ->
-	       (asubst, PatCstr (loc,c,pl,alias_of aliases))) pll)
-	 | VarPat id ->
-	     let ids,asubst = merge_aliases aliases id in
-	     (ids,[asubst, PatVar (loc,alias_of (ids,asubst))]))
-  | CPatAtom (loc, None) ->
-      (ids,[asubst, PatVar (loc,alias_of aliases)])
-  | CPatOr (loc, pl) ->
-      assert (pl <> []);
-      let pl' = List.map (intern_pat env aliases) pl in
+      let substlist = make_subst idsl' argsl in
+      let subst = make_subst ids' args in
+      in_not top loc env (subst,substlist) extrargs c
+    | CPatDelimiters (loc, key, e) ->
+      in_pat top {env with scopes=find_delimiters_scope loc key::env.scopes;
+	tmp_scope = None} e
+    | CPatPrim (loc,p) -> fst (Notation.interp_prim_token_cases_pattern_expr loc (test_kind false) p
+				 (env.tmp_scope,env.scopes))
+    | CPatAtom (loc, Some id) ->
+      begin
+	match drop_syndef top env id [] with
+	  |Some (a,b,c) -> RCPatCstr (loc, a, b, c)
+	  |None -> RCPatAtom (loc, Some (find_pattern_variable id))
+      end
+    | CPatAtom (loc,None) -> RCPatAtom (loc,None)
+    | CPatOr (loc, pl) ->
+      RCPatOr (loc,List.map (in_pat top env) pl)
+  and in_pat_sc env x = in_pat false {env with tmp_scope = x}
+  and in_not top loc env (subst,substlist as fullsubst) args = function
+    | NVar id ->
+      let () = assert (List.is_empty args) in
+      begin
+	(* subst remembers the delimiters stack in the interpretation *)
+	(* of the notations *)
+	try
+	  let (a,(scopt,subscopes)) = Id.Map.find id subst in
+	  in_pat top {env with scopes=subscopes@env.scopes;
+	    tmp_scope = scopt} a
+	with Not_found ->
+	  if Id.equal id ldots_var then RCPatAtom (loc,Some id) else
+	    anomaly (str "Unbound pattern notation variable: " ++ Id.print id)
+      end
+    | NRef g ->
+      ensure_kind top loc g;
+      let (_,argscs) = find_remaining_scopes [] args g in
+      RCPatCstr (loc, g, [], List.map2 (in_pat_sc env) argscs args)
+    | NApp (NRef g,pl) ->
+      ensure_kind top loc g;
+      let (argscs1,argscs2) = find_remaining_scopes pl args g in
+      RCPatCstr (loc, g,
+		 List.map2 (fun x -> in_not false loc {env with tmp_scope = x} fullsubst []) argscs1 pl,
+		 List.map2 (in_pat_sc env) argscs2 args)
+    | NList (x,_,iter,terminator,lassoc) ->
+      let () = assert (List.is_empty args) in
+      (try
+         (* All elements of the list are in scopes (scopt,subscopes) *)
+	 let (l,(scopt,subscopes)) = Id.Map.find x substlist in
+         let termin = in_not top loc env fullsubst [] terminator in
+	 List.fold_right (fun a t ->
+           let nsubst = Id.Map.add x (a, (scopt, subscopes)) subst in
+           let u = in_not false loc env (nsubst, substlist) [] iter in
+           subst_pat_iterator ldots_var t u)
+           (if lassoc then List.rev l else l) termin
+       with Not_found ->
+         anomaly (Pp.str "Inconsistent substitution of recursive notation"))
+    | NHole _ ->
+      let () = assert (List.is_empty args) in
+      RCPatAtom (loc, None)
+    | t -> error_invalid_pattern_notation loc
+  in in_pat true
+
+let rec intern_pat genv aliases pat =
+  let intern_cstr_with_all_args loc c with_letin idslpl1 pl2 =
+    let idslpl2 = List.map (intern_pat genv empty_alias) pl2 in
+    let (ids',pll) = product_of_cases_patterns aliases.alias_ids (idslpl1@idslpl2) in
+    let pl' = List.map (fun (asubst,pl) ->
+      (asubst, PatCstr (loc,c,chop_params_pattern loc (fst c) pl with_letin,alias_of aliases))) pll in
+    ids',pl' in
+  match pat with
+    | RCPatAlias (loc, p, id) ->
+      let aliases' = merge_aliases aliases id in
+      intern_pat genv aliases' p
+    | RCPatCstr (loc, head, expl_pl, pl) ->
+      if !oldfashion_patterns then
+        let len = if List.is_empty expl_pl then Some (List.length pl) else None in
+	let c,idslpl1 = find_constructor loc len head in
+	let with_letin =
+	  check_constructor_length genv loc c (List.length idslpl1 + List.length expl_pl) pl in
+	intern_cstr_with_all_args loc c with_letin idslpl1 (expl_pl@pl)
+      else
+	let c,idslpl1 = find_constructor loc None head in
+	let with_letin, pl2 =
+	  add_implicits_check_constructor_length genv loc c (List.length idslpl1 + List.length expl_pl) pl in
+	intern_cstr_with_all_args loc c with_letin idslpl1 (expl_pl@pl2)
+    | RCPatAtom (loc, Some id) ->
+      let aliases = merge_aliases aliases id in
+      (aliases.alias_ids,[aliases.alias_map, PatVar (loc, alias_of aliases)])
+    | RCPatAtom (loc, None) ->
+      let { alias_ids = ids; alias_map = asubst; } = aliases in
+      (ids, [asubst, PatVar (loc, alias_of aliases)])
+    | RCPatOr (loc, pl) ->
+      assert (not (List.is_empty pl));
+      let pl' = List.map (intern_pat genv aliases) pl in
       let (idsl,pl') = List.split pl' in
       let ids = List.hd idsl in
       check_or_pat_variables loc ids (List.tl idsl);
       (ids,List.flatten pl')
 
+let intern_cases_pattern genv env aliases pat =
+  intern_pat genv aliases
+    (drop_notations_pattern (function ConstructRef _ -> () | _ -> raise Not_found) env pat)
+
+let intern_ind_pattern genv env pat =
+  let no_not =
+    try
+      drop_notations_pattern (function (IndRef _ | ConstructRef _) -> () | _ -> raise Not_found) env pat
+    with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type loc
+ in
+  match no_not with
+    | RCPatCstr (loc, head,expl_pl, pl) ->
+      let c = (function IndRef ind -> ind
+	|_ -> error_bad_inductive_type loc) head in
+      let with_letin, pl2 = add_implicits_check_ind_length genv loc c
+	(List.length expl_pl) pl in
+      let idslpl1 = List.rev_map (intern_pat genv empty_alias) expl_pl in
+      let idslpl2 = List.map (intern_pat genv empty_alias) pl2 in
+      (with_letin,
+       match product_of_cases_patterns [] (List.rev_append idslpl1 idslpl2) with
+	 |_,[_,pl] ->
+	   (c,chop_params_pattern loc c pl with_letin)
+	 |_ -> error_bad_inductive_type loc)
+    | x -> error_bad_inductive_type (raw_cases_pattern_expr_loc x)
+
 (**********************************************************************)
 (* Utilities for application                                          *)
 
 let merge_impargs l args =
+  let test x = function
+  | (_, Some (_, y)) -> explicitation_eq x y
+  | _ -> false
+  in
   List.fold_right (fun a l ->
     match a with
       | (_,Some (_,(ExplByName id as x))) when
-	  List.exists (function (_,Some (_,y)) -> x=y | _ -> false) args -> l
+	  List.exists (test x) args -> l
       | _ -> a::l)
     l args
 
-let check_projection isproj nargs r =
-  match (r,isproj) with
-  | GRef (loc, ref), Some _ ->
-      (try
-	let n = Recordops.find_projection_nparams ref + 1 in
-	if nargs <> n then
-	  user_err_loc (loc,"",str "Projection does not have the right number of explicit parameters.");
-      with Not_found ->
-	user_err_loc
-	(loc,"",pr_global_env Idset.empty ref ++ str " is not a registered projection."))
-  | _, Some _ -> user_err_loc (loc_of_glob_constr r, "", str "Not a projection.")
-  | _, None -> ()
-
 let get_implicit_name n imps =
   Some (Impargs.name_of_implicit (List.nth imps (n-1)))
 
 let set_hole_implicit i b = function
-  | GRef (loc,r) | GApp (_,GRef (loc,r),_) -> (loc,Evd.ImplicitArg (r,i,b))
-  | GVar (loc,id) -> (loc,Evd.ImplicitArg (VarRef id,i,b))
-  | _ -> anomaly "Only refs have implicits"
+  | GRef (loc,r,_) | GApp (_,GRef (loc,r,_),_) -> (loc,Evar_kinds.ImplicitArg (r,i,b),Misctypes.IntroAnonymous,None)
+  | GVar (loc,id) -> (loc,Evar_kinds.ImplicitArg (VarRef id,i,b),Misctypes.IntroAnonymous,None)
+  | _ -> anomaly (Pp.str "Only refs have implicits")
 
 let exists_implicit_name id =
-  List.exists (fun imp -> is_status_implicit imp & id = name_of_implicit imp)
+  List.exists (fun imp -> is_status_implicit imp && Id.equal id (name_of_implicit imp))
 
 let extract_explicit_arg imps args =
   let rec aux = function
-  | [] -> [],[]
+  | [] -> Id.Map.empty, []
   | (a,e)::l ->
       let (eargs,rargs) = aux l in
       match e with
@@ -1147,7 +1333,7 @@ let extract_explicit_arg imps args =
 	      if not (exists_implicit_name id imps) then
 		user_err_loc
 		  (loc,"",str "Wrong argument name: " ++ pr_id id ++ str ".");
-	      if List.mem_assoc id eargs then
+	      if Id.Map.mem id eargs then
 		user_err_loc (loc,"",str "Argument name " ++ pr_id id
 		++ str " occurs more than once.");
 	      id
@@ -1161,29 +1347,30 @@ let extract_explicit_arg imps args =
 		  user_err_loc
 		    (loc,"",str"Wrong argument position: " ++ int p ++ str ".")
 	      in
-	      if List.mem_assoc id eargs then
+	      if Id.Map.mem id eargs then
 		user_err_loc (loc,"",str"Argument at position " ++ int p ++
 		  str " is mentioned more than once.");
 	      id in
-	  ((id,(loc,a))::eargs,rargs)
+	  (Id.Map.add id (loc, a) eargs, rargs)
   in aux args
 
 (**********************************************************************)
 (* Main loop                                                          *)
 
-let internalize sigma globalenv env allow_patvar lvar c =
+let internalize globalenv env allow_patvar lvar c =
   let rec intern env = function
-    | CRef ref as x ->
+    | CRef (ref,us) as x ->
 	let (c,imp,subscopes,l),_ =
-	  intern_applied_reference intern env (Environ.named_context globalenv) lvar [] ref in
-	(match intern_impargs c env imp subscopes l with
-           | [] -> c
-           | l -> GApp (constr_loc x, c, l))
+	  intern_applied_reference intern env (Environ.named_context globalenv) 
+	    lvar us [] ref 
+	in
+	  apply_impargs c env imp subscopes l (constr_loc x)
+
     | CFix (loc, (locid,iddef), dl) ->
         let lf = List.map (fun ((_, id),_,_,_,_) -> id) dl in
         let dl = Array.of_list dl in
 	let n =
-	  try list_index0 iddef lf
+	  try List.index0 Id.equal iddef lf
           with Not_found ->
 	    raise (InternalizationError (locid,UnboundFixName (false,iddef)))
 	in
@@ -1194,7 +1381,7 @@ let internalize sigma globalenv env allow_patvar lvar c =
 	       let (env',rbefore) =
 		 List.fold_left intern_local_binder (env,[]) before in
 	       let ro = f (intern env') in
-	       let n' = Option.map (fun _ -> List.length rbefore) n in
+	       let n' = Option.map (fun _ -> List.length (List.filter (fun (_,(_,_,b,_)) -> (* remove let-ins *) b = None) rbefore)) n in
 		 n', ro, List.fold_left intern_local_binder (env',rbefore) after
 	     in
 	     let n, ro, (env',rbl) =
@@ -1207,47 +1394,45 @@ let internalize sigma globalenv env allow_patvar lvar c =
 		   intern_ro_arg (fun f -> GMeasureRec (f m, Option.map f r))
 	     in
 	       ((n, ro), List.rev rbl, intern_type env' ty, env')) dl in
-        let idl = array_map2 (fun (_,_,_,_,bd) (a,b,c,env') ->
-	     let env'' = list_fold_left_i (fun i en name -> 
+        let idl = Array.map2 (fun (_,_,_,_,bd) (a,b,c,env') ->
+	     let env'' = List.fold_left_i (fun i en name -> 
 					     let (_,bli,tyi,_) = idl_temp.(i) in
-					     let fix_args = (List.map (fun (na, bk, _, _) -> (build_impls bk na)) bli) in
+					     let fix_args = (List.map (fun (_,(na, bk, _, _)) -> (build_impls bk na)) bli) in
 					       push_name_env lvar (impls_type_list ~args:fix_args tyi)
-					    en (dummy_loc, Name name)) 0 env' lf in
+					    en (Loc.ghost, Name name)) 0 env' lf in
              (a,b,c,intern {env'' with tmp_scope = None} bd)) dl idl_temp in
 	GRec (loc,GFix
 	      (Array.map (fun (ro,_,_,_) -> ro) idl,n),
               Array.of_list lf,
-              Array.map (fun (_,bl,_,_) -> bl) idl,
+              Array.map (fun (_,bl,_,_) -> List.map snd bl) idl,
               Array.map (fun (_,_,ty,_) -> ty) idl,
               Array.map (fun (_,_,_,bd) -> bd) idl)
     | CCoFix (loc, (locid,iddef), dl) ->
         let lf = List.map (fun ((_, id),_,_,_) -> id) dl in
         let dl = Array.of_list dl in
 	let n =
-          try list_index0 iddef lf
+          try List.index0 Id.equal iddef lf
           with Not_found ->
 	    raise (InternalizationError (locid,UnboundFixName (true,iddef)))
 	in
         let idl_tmp = Array.map
-          (fun (id,bl,ty,_) ->
+          (fun ((loc,id),bl,ty,_) ->
             let (env',rbl) =
               List.fold_left intern_local_binder (env,[]) bl in
             (List.rev rbl,
              intern_type env' ty,env')) dl in
-	let idl = array_map2 (fun (_,_,_,bd) (b,c,env') ->
-	     let env'' = list_fold_left_i (fun i en name ->
+	let idl = Array.map2 (fun (_,_,_,bd) (b,c,env') ->
+	     let env'' = List.fold_left_i (fun i en name ->
 					     let (bli,tyi,_) = idl_tmp.(i) in
-					     let cofix_args =  List.map (fun (na, bk, _, _) -> (build_impls bk na)) bli in
+					     let cofix_args =  List.map (fun (_, (na, bk, _, _)) -> (build_impls bk na)) bli in
 	       push_name_env lvar (impls_type_list ~args:cofix_args tyi)
-					    en (dummy_loc, Name name)) 0 env' lf in
+					    en (Loc.ghost, Name name)) 0 env' lf in
              (b,c,intern {env'' with tmp_scope = None} bd)) dl idl_tmp in
 	GRec (loc,GCoFix n,
               Array.of_list lf,
-              Array.map (fun (bl,_,_) -> bl) idl,
+              Array.map (fun (bl,_,_) -> List.map snd bl) idl,
               Array.map (fun (_,ty,_) -> ty) idl,
               Array.map (fun (_,_,bd) -> bd) idl)
-    | CArrow (loc,c1,c2) ->
-        GProd (loc, Anonymous, Explicit, intern_type env c1, intern_type env c2)
     | CProdN (loc,[],c2) ->
         intern_type env c2
     | CProdN (loc,(nal,bk,ty)::bll,c2) ->
@@ -1273,100 +1458,154 @@ let internalize sigma globalenv env allow_patvar lvar c =
     | CDelimiters (loc, key, e) ->
 	intern {env with tmp_scope = None;
 		  scopes = find_delimiters_scope loc key :: env.scopes} e
-    | CAppExpl (loc, (isproj,ref), args) ->
+    | CAppExpl (loc, (isproj,ref,us), args) ->
         let (f,_,args_scopes,_),args =
 	  let args = List.map (fun a -> (a,None)) args in
-	  intern_applied_reference intern env (Environ.named_context globalenv) lvar args ref in
-	check_projection isproj (List.length args) f;
-	(* Rem: GApp(_,f,[]) stands for @f *)
-	GApp (loc, f, intern_args env args_scopes (List.map fst args))
+	  intern_applied_reference intern env (Environ.named_context globalenv) 
+	    lvar us args ref 
+	in
+	  (* Rem: GApp(_,f,[]) stands for @f *)
+	  GApp (loc, f, intern_args env args_scopes (List.map fst args))
+
     | CApp (loc, (isproj,f), args) ->
-        let isproj,f,args = match f with
+        let f,args = match f with
           (* Compact notations like "t.(f args') args" *)
-          | CApp (_,(Some _,f), args') when isproj=None -> isproj,f,args'@args
+          | CApp (_,(Some _,f), args') when not (Option.has_some isproj) -> 
+	    f,args'@args
           (* Don't compact "(f args') args" to resolve implicits separately *)
-          | _ -> isproj,f,args in
+          | _ -> f,args in
 	let (c,impargs,args_scopes,l),args =
           match f with
-            | CRef ref -> intern_applied_reference intern env (Environ.named_context globalenv) lvar args ref
+            | CRef (ref,us) -> 
+	       intern_applied_reference intern env
+		 (Environ.named_context globalenv) lvar us args ref
             | CNotation (loc,ntn,([],[],[])) ->
                 let c = intern_notation intern env lvar loc ntn ([],[],[]) in
-                find_appl_head_data c, args
+                let x, impl, scopes, l = find_appl_head_data c in
+		  (x,impl,scopes,l), args
             | x -> (intern env f,[],[],[]), args in
-	let args =
-          intern_impargs c env impargs args_scopes (merge_impargs l args) in
-	check_projection isproj (List.length args) c;
-	(match c with
-          (* Now compact "(f args') args" *)
-	  | GApp (loc', f', args') -> GApp (join_loc loc' loc, f',args'@args)
-	  | _ -> GApp (loc, c, args))
+          apply_impargs c env impargs args_scopes 
+	    (merge_impargs l args) loc
+
     | CRecord (loc, _, fs) ->
 	let cargs =
 	  sort_fields true loc fs
-	    (fun k l -> CHole (loc, Some (Evd.QuestionMark (Evd.Define true))) :: l)
-	  in
+	    (fun k l -> CHole (loc, Some (Evar_kinds.QuestionMark (Evar_kinds.Define true)), Misctypes.IntroAnonymous, None) :: l)
+	in
 	begin
 	  match cargs with
 	    | None -> user_err_loc (loc, "intern", str"No constructor inference.")
 	    | Some (n, constrname, args) ->
-		let pars = list_make n (CHole (loc, None)) in
-		let app = CAppExpl (loc, (None, constrname), List.rev_append pars args) in
+		let pars = List.make n (CHole (loc, None, Misctypes.IntroAnonymous, None)) in
+                let app = CAppExpl (loc, (None, constrname,None), List.rev_append pars args) in
 	  intern env app
 	end
     | CCases (loc, sty, rtnpo, tms, eqns) ->
-        let tms,env' = List.fold_right
-          (fun citm (inds,env) ->
-	    let (tm,ind),nal = intern_case_item env citm in
-	    (tm,ind)::inds,List.fold_left (push_name_env lvar (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) nal)
-	  tms ([],env) in
-        let rtnpo = Option.map (intern_type env') rtnpo in
+      let as_in_vars = List.fold_left (fun acc (_,(na,inb)) ->
+	Option.fold_left (fun x tt -> List.fold_right Id.Set.add (ids_of_cases_indtype tt) x)
+	  (Option.fold_left (fun x (_,y) -> match y with | Name y' -> Id.Set.add y' x |_ -> x) acc na)
+	  inb) Id.Set.empty tms in
+      (* as, in & return vars *)
+      let forbidden_vars = Option.cata free_vars_of_constr_expr as_in_vars rtnpo in
+      let tms,ex_ids,match_from_in = List.fold_right
+	(fun citm (inds,ex_ids,matchs) ->
+	  let ((tm,ind),extra_id,match_td) = intern_case_item env forbidden_vars citm in
+	  (tm,ind)::inds, Option.fold_right Id.Set.add extra_id ex_ids, List.rev_append match_td matchs)
+	    tms ([],Id.Set.empty,[]) in
+      let env' = Id.Set.fold
+	(fun var bli -> push_name_env lvar (Variable,[],[],[]) bli (Loc.ghost,Name var))
+	(Id.Set.union ex_ids as_in_vars) (reset_hidden_inductive_implicit_test env) in
+      (* PatVars before a real pattern do not need to be matched *)
+      let stripped_match_from_in = let rec aux = function
+	|[] -> []
+	|(_,PatVar _) :: q -> aux q
+	|l -> l
+				   in aux match_from_in in
+        let rtnpo = match stripped_match_from_in with
+	  | [] -> Option.map (intern_type env') rtnpo (* Only PatVar in "in" clauses *)
+	  | l -> let thevars,thepats=List.split l in
+		 Some (
+		   GCases(Loc.ghost,Term.RegularStyle,(* Some (GSort (Loc.ghost,GType None)) *)None, (* "return Type" *)
+			  List.map (fun id -> GVar (Loc.ghost,id),(Name id,None)) thevars, (* "match v1,..,vn" *)
+			  [Loc.ghost,[],thepats, (* "|p1,..,pn" *)
+			   Option.cata (intern_type env') (GHole(Loc.ghost,Evar_kinds.CasesType false,Misctypes.IntroAnonymous,None)) rtnpo; (* "=> P" is there were a P "=> _" else *)
+			   Loc.ghost,[],List.make (List.length thepats) (PatVar(Loc.ghost,Anonymous)), (* "|_,..,_" *)
+			   GHole(Loc.ghost,Evar_kinds.ImpossibleCase,Misctypes.IntroAnonymous,None) (* "=> _" *)]))
+	in
         let eqns' = List.map (intern_eqn (List.length tms) env) eqns in
 	GCases (loc, sty, rtnpo, tms, List.flatten eqns')
     | CLetTuple (loc, nal, (na,po), b, c) ->
 	let env' = reset_tmp_scope env in
-        let ((b',(na',_)),ids) = intern_case_item env' (b,(na,None)) in
-        let p' = Option.map (fun p ->
-          let env'' = List.fold_left (push_name_env lvar (Variable,[],[],[])) env ids in
-	  intern_type env'' p) po in
+	(* "in" is None so no match to add *)
+        let ((b',(na',_)),_,_) = intern_case_item env' Id.Set.empty (b,(na,None)) in
+        let p' = Option.map (fun u ->
+	  let env'' = push_name_env lvar (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env')
+	    (Loc.ghost,na') in
+	  intern_type env'' u) po in
         GLetTuple (loc, List.map snd nal, (na', p'), b',
                    intern (List.fold_left (push_name_env lvar (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) nal) c)
     | CIf (loc, c, (na,po), b1, b2) ->
-	let env' = reset_tmp_scope env in
-        let ((c',(na',_)),ids) = intern_case_item env' (c,(na,None)) in
-        let p' = Option.map (fun p ->
-          let env'' = List.fold_left (push_name_env lvar (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) ids in
+      let env' = reset_tmp_scope env in
+      let ((c',(na',_)),_,_) = intern_case_item env' Id.Set.empty (c,(na,None)) in (* no "in" no match to ad too *)
+      let p' = Option.map (fun p ->
+          let env'' = push_name_env lvar (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env)
+	    (Loc.ghost,na') in
 	  intern_type env'' p) po in
         GIf (loc, c', (na', p'), intern env b1, intern env b2)
-    | CHole (loc, k) ->
-	GHole (loc, match k with Some k -> k | None -> Evd.QuestionMark (Evd.Define true))
+    | CHole (loc, k, naming, solve) ->
+        let k = match k with
+        | None -> Evar_kinds.QuestionMark (Evar_kinds.Define true)
+        | Some k -> k
+        in
+        let solve = match solve with
+        | None -> None
+        | Some gen ->
+          let (ltacvars, ntnvars) = lvar in
+          let ntnvars = Id.Map.domain ntnvars in
+          let lvars = Id.Set.union ltacvars.ltac_bound ltacvars.ltac_vars in
+          let lvars = Id.Set.union lvars ntnvars in
+          let lvars = Id.Set.union lvars env.ids in
+          let ist = {
+            Genintern.ltacvars = lvars;
+            ltacrecvars = Id.Map.empty;
+            genv = globalenv;
+          } in
+          let (_, glb) = Genintern.generic_intern ist gen in
+          Some glb
+        in
+	GHole (loc, k, naming, solve)
+    (* Parsing pattern variables *)
     | CPatVar (loc, n) when allow_patvar ->
-	GPatVar (loc, n)
-    | CPatVar (loc, _) ->
-	raise (InternalizationError (loc,IllegalMetavariable))
+	GPatVar (loc, (true,n))
+    | CEvar (loc, n, []) when allow_patvar ->
+	GPatVar (loc, (false,n))
+    (* end *)
+    (* Parsing existential variables *)
     | CEvar (loc, n, l) ->
-	GEvar (loc, n, Option.map (List.map (intern env)) l)
+	GEvar (loc, n, List.map (on_snd (intern env)) l)
+    | CPatVar (loc, _) ->
+        raise (InternalizationError (loc,IllegalMetavariable))
+    (* end *)
     | CSort (loc, s) ->
 	GSort(loc,s)
-    | CCast (loc, c1, CastConv (k, c2)) ->
-	GCast (loc,intern env c1, CastConv (k, intern_type env c2))
-    | CCast (loc, c1, CastCoerce) ->
-	GCast (loc,intern env c1, CastCoerce)
+    | CCast (loc, c1, c2) ->
+        GCast (loc,intern env c1, Miscops.map_cast_type (intern_type env) c2)
 
   and intern_type env = intern (set_type_scope env)
 
   and intern_local_binder env bind =
-    intern_local_binder_aux intern intern_type lvar env bind
+    intern_local_binder_aux intern lvar env bind
 
   (* Expands a multiple pattern into a disjunction of multiple patterns *)
   and intern_multiple_pattern env n (loc,pl) =
     let idsl_pll =
-      List.map (intern_cases_pattern globalenv {env with tmp_scope = None} ([],[])) pl in
+      List.map (intern_cases_pattern globalenv {env with tmp_scope = None} empty_alias) pl in
     check_number_of_pattern loc n pl;
     product_of_cases_patterns [] idsl_pll
 
   (* Expands a disjunction of multiple pattern *)
   and intern_disjunctive_multiple_pattern env loc n mpl =
-    assert (mpl <> []);
+    assert (not (List.is_empty mpl));
     let mpl' = List.map (intern_multiple_pattern env n) mpl in
     let (idsl,mpl') = List.split mpl' in
     let ids = List.hd idsl in
@@ -1378,91 +1617,77 @@ let internalize sigma globalenv env allow_patvar lvar c =
     let eqn_ids,pll = intern_disjunctive_multiple_pattern env loc n lhs in
     (* Linearity implies the order in ids is irrelevant *)
     check_linearity lhs eqn_ids;
-    let env_ids = List.fold_right Idset.add eqn_ids env.ids in
+    let env_ids = List.fold_right Id.Set.add eqn_ids env.ids in
     List.map (fun (asubst,pl) ->
       let rhs = replace_vars_constr_expr asubst rhs in
-      List.iter message_redundant_alias asubst;
+      Id.Map.iter message_redundant_alias asubst;
       let rhs' = intern {env with ids = env_ids} rhs in
       (loc,eqn_ids,pl,rhs')) pll
 
-  and intern_case_item env (tm,(na,t)) =
+  and intern_case_item env forbidden_names_for_gen (tm,(na,t)) =
+    (*the "match" part *)
     let tm' = intern env tm in
-    let ids,typ = match t with
+    (* the "as" part *)
+    let extra_id,na = match tm', na with
+      | GVar (loc,id), None when not (Id.Map.mem id (snd lvar)) -> Some id,(loc,Name id)
+      | GRef (loc, VarRef id, _), None -> Some id,(loc,Name id)
+      | _, None -> None,(Loc.ghost,Anonymous)
+      | _, Some (loc,na) -> None,(loc,na) in
+    (* the "in" part *)
+    let match_td,typ = match t with
     | Some t ->
 	let tids = ids_of_cases_indtype t in
-	let tids = List.fold_right Idset.add tids Idset.empty in
-	let t = intern_type {env with ids = tids; tmp_scope = None} t in
-	let loc,ind,l = match t with
-	    | GRef (loc,IndRef ind) -> (loc,ind,[])
-	    | GApp (loc,GRef (_,IndRef ind),l) -> (loc,ind,l)
-	    | _ -> error_bad_inductive_type (loc_of_glob_constr t) in
-	let nparams, nrealargs = inductive_nargs globalenv ind in
-	let nindargs = nparams + nrealargs in
-	if List.length l <> nindargs then
-	  error_wrong_numarg_inductive_loc loc globalenv ind nindargs;
-	let nal = List.map (function
-	  | GHole (loc,_) -> loc,Anonymous
-	  | GVar (loc,id) -> loc,Name id
-	  | c -> user_err_loc (loc_of_glob_constr c,"",str "Not a name.")) l in
-	let parnal,realnal = list_chop nparams nal in
-	if List.exists (fun (_,na) -> na <> Anonymous) parnal then
-	  error_inductive_parameter_not_implicit loc;
-	realnal, Some (loc,ind,nparams,List.map snd realnal)
+	let tids = List.fold_right Id.Set.add tids Id.Set.empty in
+	let with_letin,(ind,l) = intern_ind_pattern globalenv {env with ids = tids; tmp_scope = None} t in
+	let (mib,mip) = Inductive.lookup_mind_specif globalenv ind in
+	let nparams = (List.length (mib.Declarations.mind_params_ctxt)) in
+	(* for "in Vect n", we answer (["n","n"],[(loc,"n")])
+
+	   for "in Vect (S n)", we answer ((match over "m", relevant branch is "S
+	   n"), abstract over "m") = ([("m","S n")],[(loc,"m")]) where "m" is
+	   generated from the canonical name of the inductive and outside of
+	   {forbidden_names_for_gen} *)
+	let (match_to_do,nal) =
+	  let rec canonize_args case_rel_ctxt arg_pats forbidden_names match_acc var_acc =
+	    let add_name l = function
+	      |_,Anonymous -> l
+	      |loc,(Name y as x) -> (y,PatVar(loc,x)) :: l in
+	    match case_rel_ctxt,arg_pats with
+	      (* LetIn in the rel_context *)
+	      |(_,Some _,_)::t, l when not with_letin ->
+		canonize_args t l forbidden_names match_acc ((Loc.ghost,Anonymous)::var_acc)
+	      |[],[] ->
+		(add_name match_acc na, var_acc)
+	      |_::t,PatVar (loc,x)::tt ->
+		canonize_args t tt forbidden_names
+		  (add_name match_acc (loc,x)) ((loc,x)::var_acc)
+	      |(cano_name,_,ty)::t,c::tt ->
+		let fresh =
+		  Namegen.next_name_away_with_default_using_types "iV" cano_name forbidden_names ty in
+		canonize_args t tt (fresh::forbidden_names)
+		  ((fresh,c)::match_acc) ((cases_pattern_loc c,Name fresh)::var_acc)
+	      |_ -> assert false in
+	  let _,args_rel =
+	    List.chop nparams (List.rev mip.Declarations.mind_arity_ctxt) in
+	  canonize_args args_rel l (Id.Set.elements forbidden_names_for_gen) [] [] in
+	match_to_do, Some (cases_pattern_expr_loc t,ind,List.rev_map snd nal)
     | None ->
-	[], None in
-    let na = match tm', na with
-      | GVar (loc,id), None when not (List.mem_assoc id (snd lvar)) ->
-          loc,Name id
-      | GRef (loc, VarRef id), None -> loc,Name id
-      | _, None -> dummy_loc,Anonymous
-      | _, Some (loc,na) -> loc,na in
-    (tm',(snd na,typ)), na::ids
+      [], None in
+    (tm',(snd na,typ)), extra_id, match_td
 
   and iterate_prod loc2 env bk ty body nal =
-    let default env bk = function
-    | (loc1,na)::nal' as nal ->
-	if nal' <> [] then check_capture loc1 ty na;
-        let ty = intern_type env ty in
-        let impls = impls_type_list ty in
-	let env = List.fold_left (push_name_env lvar impls) env nal in
-        List.fold_right (fun (loc,na) c ->
-          GProd (join_loc loc loc2, na, bk, locate_if_isevar loc na ty, c))
-          nal (intern_type env body)
-    | [] -> assert false
-    in
-      match bk with
-	| Default b -> default env b nal
-	| Generalized (b,b',t) ->
-	    let env, ibind = intern_generalized_binder intern_type lvar env [] (List.hd nal) b b' t ty in
-	    let body = intern_type env body in
-	      it_mkGProd ibind body
+    let env, bl = intern_assumption intern lvar env nal bk ty in
+    it_mkGProd loc2 bl (intern_type env body)
 
   and iterate_lam loc2 env bk ty body nal =
-    let default env bk = function
-    | (loc1,na)::nal' as nal ->
-        if nal' <> [] then check_capture loc1 ty na;
-        let ty = intern_type env ty in
-        let impls = impls_type_list ty in
-	let env = List.fold_left (push_name_env lvar impls) env nal in
-        List.fold_right (fun (loc,na) c ->
-          GLambda (join_loc loc loc2, na, bk, locate_if_isevar loc na ty, c))
-          nal (intern env body)
-    | [] -> assert false
-    in match bk with
-      | Default b -> default env b nal
-      | Generalized (b, b', t) ->
-	  let env, ibind = intern_generalized_binder intern_type lvar env [] (List.hd nal) b b' t ty in
-	  let body = intern env body in
-	    it_mkGLambda ibind body
+    let env, bl = intern_assumption intern lvar env nal bk ty in
+    it_mkGLambda loc2 bl (intern env body)
 
   and intern_impargs c env l subscopes args =
-    let l = select_impargs_size (List.length args) l in
     let eargs, rargs = extract_explicit_arg l args in
     if !parsing_explicit then
-      if eargs <> [] then
-        error "Arguments given by name or position not supported in explicit mode."
-      else
-        intern_args env subscopes rargs
+      if Id.Map.is_empty eargs then intern_args env subscopes rargs
+      else error "Arguments given by name or position not supported in explicit mode."
     else
     let rec aux n impl subscopes eargs rargs =
       let (enva,subscopes') = apply_scope_env env subscopes in
@@ -1470,11 +1695,11 @@ let internalize sigma globalenv env allow_patvar lvar c =
       | (imp::impl', rargs) when is_status_implicit imp ->
 	  begin try
 	    let id = name_of_implicit imp in
-	    let (_,a) = List.assoc id eargs in
-	    let eargs' = List.remove_assoc id eargs in
+	    let (_,a) = Id.Map.find id eargs in
+	    let eargs' = Id.Map.remove id eargs in
 	    intern enva a :: aux (n+1) impl' subscopes' eargs' rargs
 	  with Not_found ->
-	  if rargs=[] & eargs=[] & not (maximal_insertion_of imp) then
+	  if List.is_empty rargs && Id.Map.is_empty eargs && not (maximal_insertion_of imp) then
             (* Less regular arguments than expected: complete *)
             (* with implicit arguments if maximal insertion is set *)
 	    []
@@ -1485,17 +1710,28 @@ let internalize sigma globalenv env allow_patvar lvar c =
       | (imp::impl', a::rargs') ->
 	  intern enva a :: aux (n+1) impl' subscopes' eargs rargs'
       | (imp::impl', []) ->
-	  if eargs <> [] then
-	    (let (id,(loc,_)) = List.hd eargs in
+	  if not (Id.Map.is_empty eargs) then
+	    (let (id,(loc,_)) = Id.Map.choose eargs in
 	       user_err_loc (loc,"",str "Not enough non implicit \
 	    arguments to accept the argument bound to " ++
 		 pr_id id ++ str"."));
 	  []
       | ([], rargs) ->
-	  assert (eargs = []);
+	  assert (Id.Map.is_empty eargs);
 	  intern_args env subscopes rargs
     in aux 1 l subscopes eargs rargs
 
+  and apply_impargs c env imp subscopes l loc = 
+    let imp = select_impargs_size (List.length l) imp in
+    let l = intern_impargs c env imp subscopes l in
+      smart_gapp c loc l
+
+  and smart_gapp f loc = function
+    | [] -> f
+    | l -> match f with 
+      | GApp (loc', g, args) -> GApp (Loc.merge loc' loc, g, args@l)
+      | _ -> GApp (Loc.merge (loc_of_glob_constr f) loc, f, l)
+      
   and intern_args env subscopes = function
     | [] -> []
     | a::args ->
@@ -1515,29 +1751,38 @@ let internalize sigma globalenv env allow_patvar lvar c =
 (**************************************************************************)
 
 let extract_ids env =
-  List.fold_right Idset.add
+  List.fold_right Id.Set.add
     (Termops.ids_of_rel_context (Environ.rel_context env))
-    Idset.empty
+    Id.Set.empty
+
+let scope_of_type_kind = function
+  | IsType -> Some Notation.type_scope
+  | OfType typ -> compute_type_scope typ
+  | WithoutTypeConstraint -> None
+
+let empty_ltac_sign = {
+  ltac_vars = Id.Set.empty;
+  ltac_bound = Id.Set.empty;
+}
 
-let intern_gen isarity sigma env
-               ?(impls=empty_internalization_env) ?(allow_patvar=false) ?(ltacvars=([],[]))
+let intern_gen kind env
+               ?(impls=empty_internalization_env) ?(allow_patvar=false) ?(ltacvars=empty_ltac_sign)
                c =
-  let tmp_scope =
-    if isarity then Some Notation.type_scope else None in
-    internalize sigma env {ids = extract_ids env; unb = false;
-			   tmp_scope = tmp_scope; scopes = [];
-			  impls = impls}
-      allow_patvar (ltacvars, []) c
+  let tmp_scope = scope_of_type_kind kind in
+  internalize env {ids = extract_ids env; unb = false;
+		         tmp_scope = tmp_scope; scopes = [];
+			 impls = impls}
+    allow_patvar (ltacvars, Id.Map.empty) c
 
-let intern_constr sigma env c = intern_gen false sigma env c
+let intern_constr env c = intern_gen WithoutTypeConstraint env c
 
-let intern_type sigma env c = intern_gen true sigma env c
+let intern_type env c = intern_gen IsType env c
 
 let intern_pattern globalenv patt =
   try
     intern_cases_pattern globalenv {ids = extract_ids globalenv; unb = false;
 				    tmp_scope = None; scopes = [];
-				    impls = empty_internalization_env} ([],[]) patt
+				    impls = empty_internalization_env} empty_alias patt
   with
       InternalizationError (loc,e) ->
 	user_err_loc (loc,"internalize",explain_internalization_error e)
@@ -1546,158 +1791,135 @@ let intern_pattern globalenv patt =
 (*********************************************************************)
 (* Functions to parse and interpret constructions *)
 
-let interp_gen kind sigma env
-               ?(impls=empty_internalization_env) ?(allow_patvar=false) ?(ltacvars=([],[]))
-               c =
-  let c = intern_gen (kind=IsType) ~impls ~allow_patvar ~ltacvars sigma env c in
-    Default.understand_gen kind sigma env c
+(* All evars resolved *)
 
-let interp_constr sigma env c =
-  interp_gen (OfType None) sigma env c
+let interp_gen kind env sigma ?(impls=empty_internalization_env) c =
+  let c = intern_gen kind ~impls env c in
+  understand ~expected_type:kind env sigma c
 
-let interp_type sigma env ?(impls=empty_internalization_env) c =
-  interp_gen IsType sigma env ~impls c
+let interp_constr env sigma ?(impls=empty_internalization_env) c =
+  interp_gen WithoutTypeConstraint env sigma c
 
-let interp_casted_constr sigma env ?(impls=empty_internalization_env) c typ =
-  interp_gen (OfType (Some typ)) sigma env ~impls c
+let interp_type env sigma ?(impls=empty_internalization_env) c =
+  interp_gen IsType env sigma ~impls c
 
-let interp_open_constr sigma env c =
-  Default.understand_tcc sigma env (intern_constr sigma env c)
+let interp_casted_constr env sigma ?(impls=empty_internalization_env) c typ =
+  interp_gen (OfType typ) env sigma ~impls c
 
-let interp_open_constr_patvar sigma env c =
-  let raw = intern_gen false sigma env c ~allow_patvar:true in
-  let sigma = ref sigma in
-  let evars = ref (Gmap.empty : (identifier,glob_constr) Gmap.t) in
-  let rec patvar_to_evar r = match r with
-    | GPatVar (loc,(_,id)) ->
-	( try Gmap.find id !evars
-	  with Not_found ->
-	    let ev = Evarutil.e_new_evar sigma env (Termops.new_Type()) in
-	    let ev = Evarutil.e_new_evar sigma env ev in
-	    let rev = GEvar (loc,(fst (Term.destEvar ev)),None) (*TODO*) in
-	    evars := Gmap.add id rev !evars;
-	    rev
-	)
-    | _ -> map_glob_constr patvar_to_evar r in
-  let raw = patvar_to_evar raw in
-  Default.understand_tcc !sigma env raw
-
-let interp_constr_judgment sigma env c =
-  Default.understand_judgment sigma env (intern_constr sigma env c)
-
-let interp_constr_evars_gen_impls ?evdref ?(fail_evar=true)
-    env ?(impls=empty_internalization_env) kind c =
-  let evdref =
-    match evdref with
-    | None -> ref Evd.empty
-    | Some evdref -> evdref
-  in
-  let istype = kind = IsType in
-  let c = intern_gen istype ~impls !evdref env c in
-  let imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:istype c in
-    Default.understand_tcc_evars ~fail_evar evdref env kind c, imps
+(* Not all evars expected to be resolved *)
+
+let interp_open_constr env sigma c =
+  understand_tcc env sigma (intern_constr env c)
 
-let interp_casted_constr_evars_impls ?evdref ?(fail_evar=true)
-    env ?(impls=empty_internalization_env) c typ =
-  interp_constr_evars_gen_impls ?evdref ~fail_evar env ~impls (OfType (Some typ)) c
+(* Not all evars expected to be resolved and computation of implicit args *)
 
-let interp_type_evars_impls ?evdref ?(fail_evar=true) env ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen_impls ?evdref ~fail_evar env IsType ~impls c
+let interp_constr_evars_gen_impls env evdref
+    ?(impls=empty_internalization_env) expected_type c =
+  let c = intern_gen expected_type ~impls env c in
+  let imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:(expected_type == IsType) c in
+    understand_tcc_evars env evdref ~expected_type c, imps
 
-let interp_constr_evars_impls ?evdref ?(fail_evar=true) env ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen_impls ?evdref ~fail_evar env (OfType None) ~impls c
+let interp_constr_evars_impls env evdref ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen_impls env evdref ~impls WithoutTypeConstraint c
 
-let interp_constr_evars_gen evdref env ?(impls=empty_internalization_env) kind c =
-  let c = intern_gen (kind=IsType) ~impls !evdref env c in
-    Default.understand_tcc_evars evdref env kind c
+let interp_casted_constr_evars_impls env evdref ?(impls=empty_internalization_env) c typ =
+  interp_constr_evars_gen_impls env evdref ~impls (OfType typ) c
 
-let interp_casted_constr_evars evdref env ?(impls=empty_internalization_env) c typ =
-  interp_constr_evars_gen evdref env ~impls (OfType (Some typ)) c
+let interp_type_evars_impls env evdref ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen_impls env evdref ~impls IsType c
 
-let interp_type_evars evdref env ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen evdref env IsType ~impls c
+(* Not all evars expected to be resolved, with side-effect on evars *)
 
-type ltac_sign = identifier list * unbound_ltac_var_map
+let interp_constr_evars_gen env evdref ?(impls=empty_internalization_env) expected_type c =
+  let c = intern_gen expected_type ~impls env c in
+  understand_tcc_evars env evdref ~expected_type c
 
-let intern_constr_pattern sigma env ?(as_type=false) ?(ltacvars=([],[])) c =
-  let c = intern_gen as_type ~allow_patvar:true ~ltacvars sigma env c in
+let interp_constr_evars env evdref ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen env evdref WithoutTypeConstraint ~impls c
+
+let interp_casted_constr_evars env evdref ?(impls=empty_internalization_env) c typ =
+  interp_constr_evars_gen env evdref ~impls (OfType typ) c
+
+let interp_type_evars env evdref ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen env evdref IsType ~impls c
+
+(* Miscellaneous *)
+
+let intern_constr_pattern env ?(as_type=false) ?(ltacvars=empty_ltac_sign) c =
+  let c = intern_gen (if as_type then IsType else WithoutTypeConstraint)
+            ~allow_patvar:true ~ltacvars env c in
   pattern_of_glob_constr c
 
-let interp_aconstr ?(impls=empty_internalization_env) vars recvars a =
+let interp_notation_constr ?(impls=empty_internalization_env) nenv a =
   let env = Global.env () in
   (* [vl] is intended to remember the scope of the free variables of [a] *)
-  let vl = List.map (fun (id,typ) -> (id,(ref None,typ))) vars in
-  let c = internalize Evd.empty (Global.env()) {ids = extract_ids env; unb = false;
+  let vl = Id.Map.map (fun typ -> (ref None, typ)) nenv.ninterp_var_type in
+  let c = internalize (Global.env()) {ids = extract_ids env; unb = false;
 						tmp_scope = None; scopes = []; impls = impls}
-    false (([],[]),vl) a in
+    false (empty_ltac_sign, vl) a in
   (* Translate and check that [c] has all its free variables bound in [vars] *)
-  let a = aconstr_of_glob_constr vars recvars c in
+  let a = notation_constr_of_glob_constr nenv c in
   (* Splits variables into those that are binding, bound, or both *)
   (* binding and bound *)
   let out_scope = function None -> None,[] | Some (a,l) -> a,l in
-  let vars = List.map (fun (id,(sc,typ)) -> (id,(out_scope !sc,typ))) vl in
+  let vars = Id.Map.map (fun (sc, typ) -> (out_scope !sc, typ)) vl in
   (* Returns [a] and the ordered list of variables with their scopes *)
   vars, a
 
 (* Interpret binders and contexts  *)
 
-let interp_binder sigma env na t =
-  let t = intern_gen true sigma env t in
-  let t' = locate_if_isevar (loc_of_glob_constr t) na t in
-  Default.understand_type sigma env t'
+let interp_binder env sigma na t =
+  let t = intern_gen IsType env t in
+  let t' = locate_if_hole (loc_of_glob_constr t) na t in
+  understand ~expected_type:IsType env sigma t'
 
-let interp_binder_evars evdref env na t =
-  let t = intern_gen true !evdref env t in
-  let t' = locate_if_isevar (loc_of_glob_constr t) na t in
-  Default.understand_tcc_evars evdref env IsType t'
+let interp_binder_evars env evdref na t =
+  let t = intern_gen IsType env t in
+  let t' = locate_if_hole (loc_of_glob_constr t) na t in
+  understand_tcc_evars env evdref ~expected_type:IsType t'
 
 open Environ
-open Term
 
-let my_intern_constr sigma env lvar acc c =
-  internalize sigma env acc false lvar c
+let my_intern_constr env lvar acc c =
+  internalize env acc false lvar c
 
-let my_intern_type sigma env lvar acc c = my_intern_constr sigma env lvar (set_type_scope acc) c
-
-let intern_context global_level sigma env impl_env params =
-  let lvar = (([],[]), []) in
+let intern_context global_level env impl_env binders =
+  try
+  let lvar = (empty_ltac_sign, Id.Map.empty) in
   let lenv, bl = List.fold_left
-	    (intern_local_binder_aux ~global_level (my_intern_constr sigma env lvar) (my_intern_type sigma env lvar) lvar)
+	    (intern_local_binder_aux ~global_level (my_intern_constr env lvar) lvar)
 	    ({ids = extract_ids env; unb = false;
-	      tmp_scope = None; scopes = []; impls = impl_env}, []) params in (lenv.impls, bl)
+	      tmp_scope = None; scopes = []; impls = impl_env}, []) binders in
+  (lenv.impls, List.map snd bl)
+  with InternalizationError (loc,e) ->
+    user_err_loc (loc,"internalize", explain_internalization_error e)
 
-let interp_rawcontext_gen understand_type understand_judgment env bl =
+let interp_rawcontext_evars env evdref bl =
   let (env, par, _, impls) =
     List.fold_left
       (fun (env,params,n,impls) (na, k, b, t) ->
 	match b with
 	    None ->
-	      let t' = locate_if_isevar (loc_of_glob_constr t) na t in
-	      let t = understand_type env t' in
+	      let t' = locate_if_hole (loc_of_glob_constr t) na t in
+	      let t =
+                understand_tcc_evars env evdref ~expected_type:IsType t' in
 	      let d = (na,None,t) in
 	      let impls =
-		if k = Implicit then
+		if k == Implicit then
 		  let na = match na with Name n -> Some n | Anonymous -> None in
 		    (ExplByPos (n, na), (true, true, true)) :: impls
 		else impls
 	      in
 		(push_rel d env, d::params, succ n, impls)
 	  | Some b ->
-	      let c = understand_judgment env b in
-	      let d = (na, Some c.uj_val, Termops.refresh_universes c.uj_type) in
+	      let c = understand_judgment_tcc env evdref b in
+	      let d = (na, Some c.uj_val, c.uj_type) in
 		(push_rel d env, d::params, succ n, impls))
       (env,[],1,[]) (List.rev bl)
   in (env, par), impls
 
-let interp_context_gen understand_type understand_judgment ?(global_level=false) ?(impl_env=empty_internalization_env) sigma env params =
-  let int_env,bl = intern_context global_level sigma env impl_env params in
-    int_env, interp_rawcontext_gen understand_type understand_judgment env bl
-
-let interp_context ?(global_level=false) ?(impl_env=empty_internalization_env) sigma env params =
-  interp_context_gen (Default.understand_type sigma)
-    (Default.understand_judgment sigma) ~global_level ~impl_env sigma env params
-
-let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) evdref env params =
-  interp_context_gen (fun env t -> Default.understand_tcc_evars evdref env IsType t)
-    (Default.understand_judgment_tcc evdref) ~global_level ~impl_env !evdref env params
+let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) env evdref params =
+  let int_env,bl = intern_context global_level env impl_env params in
+  let x = interp_rawcontext_evars env evdref bl in
+  int_env, x
 
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index b8b3d995..792e6f63 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,15 +8,18 @@
 
 open Names
 open Term
-open Sign
+open Context
 open Evd
 open Environ
 open Libnames
+open Globnames
 open Glob_term
 open Pattern
-open Topconstr
-open Termops
+open Constrexpr
+open Notation_term
 open Pretyping
+open Misctypes
+open Decl_kinds
 
 (** Translation from front abstract syntax of term to untyped terms (glob_constr) *)
 
@@ -37,7 +40,7 @@ open Pretyping
    of [env] *)
 
 type var_internalization_type =
-  | Inductive of identifier list (* list of params *)
+  | Inductive of Id.t list (* list of params *)
   | Recursive
   | Method
   | Variable
@@ -46,14 +49,14 @@ type var_internalization_data =
     var_internalization_type *
       (** type of the "free" variable, for coqdoc, e.g. while typing the
 	  constructor of JMeq, "JMeq" behaves as a variable of type Inductive *)
-    identifier list *
+    Id.t list *
       (** impargs to automatically add to the variable, e.g. for "JMeq A a B b"
           in implicit mode, this is [A;B] and this adds (A:=A) and (B:=B) *)
     Impargs.implicit_status list * (** signature of impargs of the variable *)
-    scope_name option list (** subscopes of the args of the variable *)
+    Notation_term.scope_name option list (** subscopes of the args of the variable *)
 
 (** A map of free variables to their implicit arguments and scopes *)
-type internalization_env = var_internalization_data Idmap.t
+type internalization_env = var_internalization_data Id.Map.t
 
 val empty_internalization_env : internalization_env
 
@@ -61,79 +64,81 @@ val compute_internalization_data : env -> var_internalization_type ->
   types -> Impargs.manual_explicitation list -> var_internalization_data
 
 val compute_internalization_env : env -> var_internalization_type ->
-  identifier list -> types list -> Impargs.manual_explicitation list list ->
+  Id.t list -> types list -> Impargs.manual_explicitation list list ->
   internalization_env
 
-type ltac_sign = identifier list * unbound_ltac_var_map
+type ltac_sign = {
+  ltac_vars : Id.Set.t;
+  (** Variables of Ltac which may be bound to a term *)
+  ltac_bound : Id.Set.t;
+  (** Other variables of Ltac *)
+}
 
-type glob_binder = (name * binding_kind * glob_constr option * glob_constr)
+val empty_ltac_sign : ltac_sign
+
+type glob_binder = (Name.t * binding_kind * glob_constr option * glob_constr)
 
 (** {6 Internalization performs interpretation of global names and notations } *)
 
-val intern_constr : evar_map -> env -> constr_expr -> glob_constr
+val intern_constr : env -> constr_expr -> glob_constr
 
-val intern_type : evar_map -> env -> constr_expr -> glob_constr
+val intern_type : env -> constr_expr -> glob_constr
 
-val intern_gen : bool -> evar_map -> env ->
+val intern_gen : typing_constraint -> env ->
   ?impls:internalization_env -> ?allow_patvar:bool -> ?ltacvars:ltac_sign ->
   constr_expr -> glob_constr
 
 val intern_pattern : env -> cases_pattern_expr ->
-  Names.identifier list *
-    ((Names.identifier * Names.identifier) list * Glob_term.cases_pattern) list
-
-val intern_context : bool -> evar_map -> env -> internalization_env -> local_binder list -> internalization_env * glob_binder list
+  Id.t list * (Id.t Id.Map.t * cases_pattern) list
 
-(** {6 Composing internalization with pretyping } *)
+val intern_context : bool -> env -> internalization_env -> local_binder list -> internalization_env * glob_binder list
 
-(** Main interpretation function *)
-
-val interp_gen : typing_constraint -> evar_map -> env ->
-  ?impls:internalization_env -> ?allow_patvar:bool -> ?ltacvars:ltac_sign ->
-  constr_expr -> constr
+(** {6 Composing internalization with type inference (pretyping) } *)
 
-(** Particular instances *)
+(** Main interpretation functions expecting evars to be all resolved *)
 
-val interp_constr : evar_map -> env ->
-  constr_expr -> constr
+val interp_constr : env -> evar_map -> ?impls:internalization_env ->
+  constr_expr -> constr Evd.in_evar_universe_context
 
-val interp_type : evar_map -> env -> ?impls:internalization_env ->
-  constr_expr -> types
+val interp_casted_constr : env -> evar_map -> ?impls:internalization_env ->
+  constr_expr -> types -> constr Evd.in_evar_universe_context
 
-val interp_open_constr   : evar_map -> env -> constr_expr -> evar_map * constr
+val interp_type : env -> evar_map -> ?impls:internalization_env ->
+  constr_expr -> types Evd.in_evar_universe_context
 
-val interp_open_constr_patvar   : evar_map -> env -> constr_expr -> evar_map * constr
+(** Main interpretation function expecting evars to be all resolved *)
 
-val interp_casted_constr : evar_map -> env -> ?impls:internalization_env ->
-  constr_expr -> types -> constr
+val interp_open_constr   : env -> evar_map -> constr_expr -> evar_map * constr
 
-(** Accepting evars and giving back the manual implicits in addition. *)
+(** Accepting unresolved evars *)
 
-val interp_casted_constr_evars_impls : ?evdref:(evar_map ref) -> ?fail_evar:bool -> env ->
-  ?impls:internalization_env -> constr_expr -> types -> constr * Impargs.manual_implicits
+val interp_constr_evars : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr -> constr
 
-val interp_type_evars_impls : ?evdref:(evar_map ref) -> ?fail_evar:bool ->
-  env -> ?impls:internalization_env ->
-  constr_expr -> types * Impargs.manual_implicits
+val interp_casted_constr_evars : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr -> types -> constr
 
-val interp_constr_evars_impls : ?evdref:(evar_map ref) -> ?fail_evar:bool ->
-  env -> ?impls:internalization_env ->
-  constr_expr -> constr * Impargs.manual_implicits
+val interp_type_evars : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr -> types
 
-val interp_casted_constr_evars : evar_map ref -> env ->
-  ?impls:internalization_env -> constr_expr -> types -> constr
+(** Accepting unresolved evars and giving back the manual implicit arguments *)
 
-val interp_type_evars : evar_map ref -> env -> ?impls:internalization_env ->
-  constr_expr -> types
+val interp_constr_evars_impls : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr ->
+  constr * Impargs.manual_implicits
 
-(** {6 Build a judgment  } *)
+val interp_casted_constr_evars_impls : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr -> types ->
+  constr * Impargs.manual_implicits
 
-val interp_constr_judgment : evar_map -> env -> constr_expr -> unsafe_judgment
+val interp_type_evars_impls : env -> evar_map ref ->
+  ?impls:internalization_env -> constr_expr ->
+  types * Impargs.manual_implicits
 
 (** Interprets constr patterns *)
 
 val intern_constr_pattern :
-  evar_map -> env -> ?as_type:bool -> ?ltacvars:ltac_sign ->
+  env -> ?as_type:bool -> ?ltacvars:ltac_sign ->
     constr_pattern_expr -> patvar list * constr_pattern
 
 (** Raise Not_found if syndef not bound to a name and error if unexisting ref *)
@@ -144,39 +149,42 @@ val interp_reference : ltac_sign -> reference -> glob_constr
 
 (** Interpret binders *)
 
-val interp_binder  : evar_map -> env -> name -> constr_expr -> types
+val interp_binder  : env -> evar_map -> Name.t -> constr_expr -> 
+  types Evd.in_evar_universe_context
 
-val interp_binder_evars : evar_map ref -> env -> name -> constr_expr -> types
+val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> types
 
 (** Interpret contexts: returns extended env and context *)
 
-val interp_context_gen : (env -> glob_constr -> types) ->
-  (env -> glob_constr -> unsafe_judgment) ->
+val interp_context_evars :
   ?global_level:bool -> ?impl_env:internalization_env ->
-  evar_map -> env -> local_binder list -> internalization_env * ((env * rel_context) * Impargs.manual_implicits)
-  
-val interp_context : ?global_level:bool -> ?impl_env:internalization_env ->
-  evar_map -> env -> local_binder list -> internalization_env * ((env * rel_context) * Impargs.manual_implicits)
+  env -> evar_map ref -> local_binder list ->
+  internalization_env * ((env * rel_context) * Impargs.manual_implicits)
 
-val interp_context_evars : ?global_level:bool -> ?impl_env:internalization_env ->
-  evar_map ref -> env -> local_binder list -> internalization_env * ((env * rel_context) * Impargs.manual_implicits)
+(* val interp_context_gen : (env -> glob_constr -> unsafe_type_judgment Evd.in_evar_universe_context) -> *)
+(*   (env -> Evarutil.type_constraint -> glob_constr -> unsafe_judgment Evd.in_evar_universe_context) -> *)
+(*   ?global_level:bool -> ?impl_env:internalization_env -> *)
+(*   env -> evar_map -> local_binder list -> internalization_env * ((env * Evd.evar_universe_context * rel_context * sorts list) * Impargs.manual_implicits) *)
+  
+(* val interp_context : ?global_level:bool -> ?impl_env:internalization_env -> *)
+(*   env -> evar_map -> local_binder list ->  *)
+(*   internalization_env *  *)
+(*   ((env * Evd.evar_universe_context * rel_context * sorts list) * Impargs.manual_implicits) *)
 
 (** Locating references of constructions, possibly via a syntactic definition 
    (these functions do not modify the glob file) *)
 
-val is_global : identifier -> bool
-val construct_reference : named_context -> identifier -> constr
-val global_reference : identifier -> constr
-val global_reference_in_absolute_module : dir_path -> identifier -> constr
-
-(** Interprets a term as the left-hand side of a notation; the boolean
-    list is a set and this set is [true] for a variable occurring in
-    term position, [false] for a variable occurring in binding
-    position; [true;false] if in both kinds of position *)
-val interp_aconstr : ?impls:internalization_env ->
-  (identifier * notation_var_internalization_type) list ->
-  (identifier * identifier) list -> constr_expr ->
-  (identifier * (subscopes * notation_var_internalization_type)) list * aconstr
+val is_global : Id.t -> bool
+val construct_reference : named_context -> Id.t -> constr
+val global_reference : Id.t -> constr
+val global_reference_in_absolute_module : DirPath.t -> Id.t -> constr
+
+(** Interprets a term as the left-hand side of a notation. The returned map is
+    guaranteed to have the same domain as the input one. *)
+val interp_notation_constr : ?impls:internalization_env ->
+  notation_interp_env -> constr_expr ->
+  (subscopes * notation_var_internalization_type) Id.Map.t *
+  notation_constr
 
 (** Globalization options *)
 val parsing_explicit : bool ref
diff --git a/interp/coqlib.ml b/interp/coqlib.ml
index e446d177..e722615a 100644
--- a/interp/coqlib.ml
+++ b/interp/coqlib.ml
@@ -1,34 +1,38 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Errors
 open Util
 open Pp
 open Names
 open Term
 open Libnames
-open Pattern
+open Globnames
 open Nametab
 open Smartlocate
 
+let coq = Nameops.coq_string (* "Coq" *)
+
 (************************************************************************)
 (* Generic functions to find Coq objects *)
 
 type message = string
 
-let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
+let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 
 let find_reference locstr dir s =
-  let sp = Libnames.make_path (make_dir dir) (id_of_string s) in
+  let sp = Libnames.make_path (make_dir dir) (Id.of_string s) in
   try global_of_extended_global (Nametab.extended_global_of_path sp)
-  with Not_found -> anomaly (locstr^": cannot find "^(string_of_path sp))
+  with Not_found ->
+    anomaly ~label:locstr (str "cannot find " ++ Libnames.pr_path sp)
 
-let coq_reference locstr dir s = find_reference locstr ("Coq"::dir) s
-let coq_constant locstr dir s = constr_of_global (coq_reference locstr dir s)
+let coq_reference locstr dir s = find_reference locstr (coq::dir) s
+let coq_constant locstr dir s = Universes.constr_of_global (coq_reference locstr dir s)
 
 let gen_reference = coq_reference
 let gen_constant = coq_constant
@@ -40,103 +44,119 @@ let has_suffix_in_dirs dirs ref =
 let global_of_extended q =
   try Some (global_of_extended_global q) with Not_found -> None
 
-let gen_constant_in_modules locstr dirs s =
+let gen_reference_in_modules locstr dirs s =
   let dirs = List.map make_dir dirs in
   let qualid = qualid_of_string s in
   let all = Nametab.locate_extended_all qualid in
-  let all = list_uniquize (list_map_filter global_of_extended all) in
+  let all = List.map_filter global_of_extended all in
+  let all = List.sort_uniquize RefOrdered_env.compare all in
   let these = List.filter (has_suffix_in_dirs dirs) all in
   match these with
-    | [x] -> constr_of_global x
+    | [x] -> x
     | [] ->
-	anomalylabstrm "" (str (locstr^": cannot find "^s^
+	anomaly ~label:locstr (str ("cannot find "^s^
 	" in module"^(if List.length dirs > 1 then "s " else " ")) ++
 	prlist_with_sep pr_comma pr_dirpath dirs)
     | l ->
-	anomalylabstrm ""
-	(str (locstr^": found more than once object of name "^s^
-	" in module"^(if List.length dirs > 1 then "s " else " ")) ++
-	prlist_with_sep pr_comma pr_dirpath dirs)
+      anomaly ~label:locstr
+	(str ("ambiguous name "^s^" can represent ") ++
+	   prlist_with_sep pr_comma
+	   (fun x -> Libnames.pr_path (Nametab.path_of_global x)) l ++
+	   str (" in module"^(if List.length dirs > 1 then "s " else " ")) ++
+	   prlist_with_sep pr_comma pr_dirpath dirs)
+
+let gen_constant_in_modules locstr dirs s =
+  Universes.constr_of_global (gen_reference_in_modules locstr dirs s)
 
 
 (* For tactics/commands requiring vernacular libraries *)
 
 let check_required_library d =
-  let d' = List.map id_of_string d in
-  let dir = make_dirpath (List.rev d') in
-  let mp = (fst(Lib.current_prefix())) in
-  let current_dir = match mp with
-    | MPfile dp -> (dir=dp)
-    | _ -> false
-  in
-  if not (Library.library_is_loaded dir) then
-    if not current_dir then
+  let dir = make_dir d in
+  if Library.library_is_loaded dir then ()
+  else
+    let in_current_dir = match Lib.current_mp () with
+      | MPfile dp -> DirPath.equal dir dp
+      | _ -> false
+    in
+    if not in_current_dir then
 (* Loading silently ...
-    let m, prefix = list_sep_last d' in
+    let m, prefix = List.sep_last d' in
     read_library
-     (dummy_loc,make_qualid (make_dirpath (List.rev prefix)) m)
+     (Loc.ghost,make_qualid (DirPath.make (List.rev prefix)) m)
 *)
 (* or failing ...*)
-      error ("Library "^(string_of_dirpath dir)^" has to be required first.")
+      error ("Library "^(DirPath.to_string dir)^" has to be required first.")
 
 (************************************************************************)
 (* Specific Coq objects *)
 
-let init_reference dir s = gen_reference "Coqlib" ("Init"::dir) s
+let init_reference dir s =
+  let d = "Init"::dir in
+  check_required_library (coq::d); gen_reference "Coqlib" d s
 
-let init_constant dir s = gen_constant "Coqlib" ("Init"::dir) s
+let init_constant dir s =
+  let d = "Init"::dir in
+  check_required_library (coq::d); gen_constant "Coqlib" d s
 
-let logic_constant dir s = gen_constant "Coqlib" ("Logic"::dir) s
+let logic_reference dir s =
+  let d = "Logic"::dir in
+  check_required_library ("Coq"::d); gen_reference "Coqlib" d s
 
-let arith_dir = ["Coq";"Arith"]
+let arith_dir = [coq;"Arith"]
 let arith_modules = [arith_dir]
 
-let numbers_dir = [ "Coq";"Numbers"]
-let parith_dir = ["Coq";"PArith"]
-let narith_dir = ["Coq";"NArith"]
-let zarith_dir = ["Coq";"ZArith"]
+let numbers_dir = [coq;"Numbers"]
+let parith_dir = [coq;"PArith"]
+let narith_dir = [coq;"NArith"]
+let zarith_dir = [coq;"ZArith"]
 
 let zarith_base_modules = [numbers_dir;parith_dir;narith_dir;zarith_dir]
 
-let init_dir = ["Coq";"Init"]
+let init_dir = [coq;"Init"]
 let init_modules = [
   init_dir@["Datatypes"];
   init_dir@["Logic"];
   init_dir@["Specif"];
   init_dir@["Logic_Type"];
+  init_dir@["Nat"];
   init_dir@["Peano"];
   init_dir@["Wf"]
 ]
 
-let logic_module_name = ["Coq";"Init";"Logic"]
+let prelude_module_name = init_dir@["Prelude"]
+let prelude_module = make_dir prelude_module_name
+
+let logic_module_name = init_dir@["Logic"]
 let logic_module = make_dir logic_module_name
 
-let logic_type_module_name = ["Coq";"Init";"Logic_Type"]
+let logic_type_module_name = init_dir@["Logic_Type"]
 let logic_type_module = make_dir logic_type_module_name
 
-let datatypes_module_name = ["Coq";"Init";"Datatypes"]
+let datatypes_module_name = init_dir@["Datatypes"]
 let datatypes_module = make_dir datatypes_module_name
 
-let arith_module_name = ["Coq";"Arith";"Arith"]
-let arith_module = make_dir arith_module_name
-
-let jmeq_module_name = ["Coq";"Logic";"JMeq"]
+let jmeq_module_name = [coq;"Logic";"JMeq"]
 let jmeq_module = make_dir jmeq_module_name
 
-(* TODO: temporary hack *)
-let make_kn dir id = Libnames.encode_mind dir id
-let make_con dir id = Libnames.encode_con dir id
+(* TODO: temporary hack. Works only if the module isn't an alias *)
+let make_ind dir id = Globnames.encode_mind dir (Id.of_string id)
+let make_con dir id = Globnames.encode_con dir (Id.of_string id)
 
 (** Identity *)
 
-let id = make_con datatypes_module (id_of_string "id")
-let type_of_id = make_con datatypes_module (id_of_string "ID")
+let id = make_con datatypes_module "idProp"
+let type_of_id = make_con datatypes_module "IDProp"
 
-let _ = Termops.set_impossible_default_clause (mkConst id,mkConst type_of_id)
+let _ = Termops.set_impossible_default_clause 
+  (fun () -> 
+    let c, ctx = Universes.fresh_global_instance (Global.env()) (ConstRef id) in
+    let (_, u) = destConst c in
+      (c,mkConstU (type_of_id,u)), ctx)
 
 (** Natural numbers *)
-let nat_kn = make_kn datatypes_module (id_of_string "nat")
-let nat_path = Libnames.make_path datatypes_module (id_of_string "nat")
+let nat_kn = make_ind datatypes_module "nat"
+let nat_path = Libnames.make_path datatypes_module (Id.of_string "nat")
 
 let glob_nat = IndRef (nat_kn,0)
 
@@ -146,7 +166,7 @@ let glob_O = ConstructRef path_of_O
 let glob_S = ConstructRef path_of_S
 
 (** Booleans *)
-let bool_kn = make_kn datatypes_module (id_of_string "bool")
+let bool_kn = make_ind datatypes_module "bool"
 
 let glob_bool = IndRef (bool_kn,0)
 
@@ -156,21 +176,21 @@ let glob_true  = ConstructRef path_of_true
 let glob_false  = ConstructRef path_of_false
 
 (** Equality *)
-let eq_kn = make_kn logic_module (id_of_string "eq")
+let eq_kn = make_ind logic_module "eq"
 let glob_eq = IndRef (eq_kn,0)
 
-let identity_kn = make_kn datatypes_module (id_of_string "identity")
+let identity_kn = make_ind datatypes_module "identity"
 let glob_identity = IndRef (identity_kn,0)
 
-let jmeq_kn = make_kn jmeq_module (id_of_string "JMeq")
+let jmeq_kn = make_ind jmeq_module "JMeq"
 let glob_jmeq = IndRef (jmeq_kn,0)
 
 type coq_sigma_data = {
-  proj1 : constr;
-  proj2 : constr;
-  elim  : constr;
-  intro : constr;
-  typ   : constr }
+  proj1 : global_reference;
+  proj2 : global_reference;
+  elim  : global_reference;
+  intro : global_reference;
+  typ   : global_reference }
 
 type coq_bool_data  = {
   andb : constr;
@@ -182,59 +202,61 @@ let build_bool_type () =
     andb_prop =  init_constant ["Datatypes"] "andb_prop";
     andb_true_intro =  init_constant ["Datatypes"] "andb_true_intro" }
 
-let build_sigma_set () = anomaly "Use build_sigma_type"
+let build_sigma_set () = anomaly (Pp.str "Use build_sigma_type")
 
 let build_sigma_type () =
-  { proj1 = init_constant ["Specif"] "projT1";
-    proj2 = init_constant ["Specif"] "projT2";
-    elim = init_constant ["Specif"] "sigT_rect";
-    intro = init_constant ["Specif"] "existT";
-    typ = init_constant ["Specif"] "sigT" }
+  { proj1 = init_reference ["Specif"] "projT1";
+    proj2 = init_reference ["Specif"] "projT2";
+    elim = init_reference ["Specif"] "sigT_rect";
+    intro = init_reference ["Specif"] "existT";
+    typ = init_reference ["Specif"] "sigT" }
 
 let build_sigma () =
-  { proj1 = init_constant ["Specif"] "proj1_sig";
-    proj2 = init_constant ["Specif"] "proj2_sig";
-    elim = init_constant ["Specif"] "sig_rect";
-    intro = init_constant ["Specif"] "exist";
-    typ = init_constant ["Specif"] "sig" }
+  { proj1 = init_reference ["Specif"] "proj1_sig";
+    proj2 = init_reference ["Specif"] "proj2_sig";
+    elim = init_reference ["Specif"] "sig_rect";
+    intro = init_reference ["Specif"] "exist";
+    typ = init_reference ["Specif"] "sig" }
+
 
 let build_prod () =
-  { proj1 = init_constant ["Datatypes"] "fst";
-    proj2 = init_constant ["Datatypes"] "snd";
-    elim = init_constant ["Datatypes"] "prod_rec";
-    intro = init_constant ["Datatypes"] "pair";
-    typ = init_constant ["Datatypes"] "prod" }
+  { proj1 = init_reference ["Datatypes"] "fst";
+    proj2 = init_reference ["Datatypes"] "snd";
+    elim = init_reference ["Datatypes"] "prod_rec";
+    intro = init_reference ["Datatypes"] "pair";
+    typ = init_reference ["Datatypes"] "prod" }
 
 (* Equalities *)
 type coq_eq_data = {
-  eq   : constr;
-  ind  : constr;
-  refl : constr;
-  sym  : constr;
-  trans: constr;
-  congr: constr }
+  eq   : global_reference;
+  ind  : global_reference;
+  refl : global_reference;
+  sym  : global_reference;
+  trans: global_reference;
+  congr: global_reference }
 
 (* Data needed for discriminate and injection *)
 type coq_inversion_data = {
-  inv_eq   : constr; (* : forall params, t -> Prop *)
-  inv_ind  : constr; (* : forall params P y, eq params y -> P y *)
-  inv_congr: constr  (* : forall params B (f:t->B) y, eq params y -> f c=f y *)
+  inv_eq   : global_reference; (* : forall params, t -> Prop *)
+  inv_ind  : global_reference; (* : forall params P y, eq params y -> P y *)
+  inv_congr: global_reference  (* : forall params B (f:t->B) y, eq params y -> f c=f y *)
 }
 
+let lazy_init_reference dir id = lazy (init_reference dir id)
 let lazy_init_constant dir id = lazy (init_constant dir id)
-let lazy_logic_constant dir id = lazy (logic_constant dir id)
+let lazy_logic_reference dir id = lazy (logic_reference dir id)
 
 (* Leibniz equality on Type *)
 
-let coq_eq_eq = lazy_init_constant ["Logic"] "eq"
-let coq_eq_refl = lazy_init_constant ["Logic"] "eq_refl"
-let coq_eq_ind = lazy_init_constant ["Logic"] "eq_ind"
-let coq_eq_congr = lazy_init_constant ["Logic"] "f_equal"
-let coq_eq_sym  = lazy_init_constant ["Logic"] "eq_sym"
-let coq_eq_trans  = lazy_init_constant ["Logic"] "eq_trans"
-let coq_f_equal2 = lazy_init_constant ["Logic"] "f_equal2"
+let coq_eq_eq = lazy_init_reference ["Logic"] "eq"
+let coq_eq_refl = lazy_init_reference ["Logic"] "eq_refl"
+let coq_eq_ind = lazy_init_reference ["Logic"] "eq_ind"
+let coq_eq_congr = lazy_init_reference ["Logic"] "f_equal"
+let coq_eq_sym  = lazy_init_reference ["Logic"] "eq_sym"
+let coq_eq_trans  = lazy_init_reference ["Logic"] "eq_trans"
+let coq_f_equal2 = lazy_init_reference ["Logic"] "f_equal2"
 let coq_eq_congr_canonical =
-  lazy_init_constant ["Logic"] "f_equal_canonical_form"
+  lazy_init_reference ["Logic"] "f_equal_canonical_form"
 
 let build_coq_eq_data () =
   let _ = check_required_library logic_module_name in {
@@ -258,14 +280,15 @@ let build_coq_inversion_eq_data () =
 
 (* Heterogenous equality on Type *)
 
-let coq_jmeq_eq = lazy_logic_constant ["JMeq"] "JMeq"
-let coq_jmeq_refl = lazy_logic_constant ["JMeq"] "JMeq_refl"
-let coq_jmeq_ind = lazy_logic_constant ["JMeq"] "JMeq_ind"
-let coq_jmeq_sym  = lazy_logic_constant ["JMeq"] "JMeq_sym"
-let coq_jmeq_congr  = lazy_logic_constant ["JMeq"] "JMeq_congr"
-let coq_jmeq_trans  = lazy_logic_constant ["JMeq"] "JMeq_trans"
+let coq_jmeq_eq = lazy_logic_reference ["JMeq"] "JMeq"
+let coq_jmeq_hom = lazy_logic_reference ["JMeq"] "JMeq_hom"
+let coq_jmeq_refl = lazy_logic_reference ["JMeq"] "JMeq_refl"
+let coq_jmeq_ind = lazy_logic_reference ["JMeq"] "JMeq_ind"
+let coq_jmeq_sym  = lazy_logic_reference ["JMeq"] "JMeq_sym"
+let coq_jmeq_congr  = lazy_logic_reference ["JMeq"] "JMeq_congr"
+let coq_jmeq_trans  = lazy_logic_reference ["JMeq"] "JMeq_trans"
 let coq_jmeq_congr_canonical =
-  lazy_logic_constant ["JMeq"] "JMeq_congr_canonical_form"
+  lazy_logic_reference ["JMeq"] "JMeq_congr_canonical_form"
 
 let build_coq_jmeq_data () =
   let _ = check_required_library jmeq_module_name in {
@@ -276,14 +299,9 @@ let build_coq_jmeq_data () =
   trans = Lazy.force coq_jmeq_trans;
   congr = Lazy.force coq_jmeq_congr }
 
-let join_jmeq_types eq =
-  mkLambda(Name (id_of_string "A"),Termops.new_Type(),
-  mkLambda(Name (id_of_string "x"),mkRel 1,
-  mkApp (eq,[|mkRel 2;mkRel 1;mkRel 2|])))
-
 let build_coq_inversion_jmeq_data () =
   let _ = check_required_library logic_module_name in {
-  inv_eq = join_jmeq_types (Lazy.force coq_jmeq_eq);
+  inv_eq = Lazy.force coq_jmeq_hom;
   inv_ind = Lazy.force coq_jmeq_ind;
   inv_congr = Lazy.force coq_jmeq_congr_canonical }
 
@@ -293,13 +311,13 @@ let coq_sumbool  = lazy_init_constant ["Specif"] "sumbool"
 let build_coq_sumbool () = Lazy.force coq_sumbool
 
 (* Equality on Type as a Type *)
-let coq_identity_eq = lazy_init_constant ["Datatypes"] "identity"
-let coq_identity_refl = lazy_init_constant ["Datatypes"] "identity_refl"
-let coq_identity_ind = lazy_init_constant ["Datatypes"] "identity_ind"
-let coq_identity_congr = lazy_init_constant ["Logic_Type"] "identity_congr"
-let coq_identity_sym = lazy_init_constant ["Logic_Type"] "identity_sym"
-let coq_identity_trans = lazy_init_constant ["Logic_Type"] "identity_trans"
-let coq_identity_congr_canonical = lazy_init_constant ["Logic_Type"] "identity_congr_canonical_form"
+let coq_identity_eq = lazy_init_reference ["Datatypes"] "identity"
+let coq_identity_refl = lazy_init_reference ["Datatypes"] "identity_refl"
+let coq_identity_ind = lazy_init_reference ["Datatypes"] "identity_ind"
+let coq_identity_congr = lazy_init_reference ["Logic_Type"] "identity_congr"
+let coq_identity_sym = lazy_init_reference ["Logic_Type"] "identity_sym"
+let coq_identity_trans = lazy_init_reference ["Logic_Type"] "identity_trans"
+let coq_identity_congr_canonical = lazy_init_reference ["Logic_Type"] "identity_congr_canonical_form"
 
 let build_coq_identity_data () =
   let _ = check_required_library datatypes_module_name in {
@@ -318,9 +336,9 @@ let build_coq_inversion_identity_data () =
   inv_congr = Lazy.force coq_identity_congr_canonical }
 
 (* Equality to true *)
-let coq_eq_true_eq = lazy_init_constant ["Datatypes"] "eq_true"
-let coq_eq_true_ind = lazy_init_constant ["Datatypes"] "eq_true_ind"
-let coq_eq_true_congr = lazy_init_constant ["Logic"] "eq_true_congr"
+let coq_eq_true_eq = lazy_init_reference ["Datatypes"] "eq_true"
+let coq_eq_true_ind = lazy_init_reference ["Datatypes"] "eq_true_ind"
+let coq_eq_true_congr = lazy_init_reference ["Logic"] "eq_true_congr"
 
 let build_coq_inversion_eq_true_data () =
   let _ = check_required_library datatypes_module_name in
@@ -331,6 +349,7 @@ let build_coq_inversion_eq_true_data () =
 
 (* The False proposition *)
 let coq_False  = lazy_init_constant ["Logic"] "False"
+let coq_proof_admitted = lazy_init_constant ["Logic"] "proof_admitted"
 
 (* The True proposition and its unique proof *)
 let coq_True   = lazy_init_constant ["Logic"] "True"
@@ -352,6 +371,7 @@ let build_coq_True ()  = Lazy.force coq_True
 let build_coq_I ()     = Lazy.force coq_I
 
 let build_coq_False () = Lazy.force coq_False
+let build_coq_proof_admitted () = Lazy.force coq_proof_admitted
 let build_coq_not ()   = Lazy.force coq_not
 let build_coq_and ()   = Lazy.force coq_and
 let build_coq_conj ()  = Lazy.force coq_conj
@@ -368,7 +388,7 @@ let coq_eq_ref      = lazy (init_reference ["Logic"] "eq")
 let coq_identity_ref = lazy (init_reference ["Datatypes"] "identity")
 let coq_jmeq_ref     = lazy (gen_reference "Coqlib" ["Logic";"JMeq"] "JMeq")
 let coq_eq_true_ref = lazy (gen_reference "Coqlib" ["Init";"Datatypes"] "eq_true")
-let coq_existS_ref  = lazy (anomaly "use coq_existT_ref")
+let coq_existS_ref  = lazy (anomaly (Pp.str "use coq_existT_ref"))
 let coq_existT_ref  = lazy (init_reference ["Specif"] "existT")
 let coq_exist_ref  = lazy (init_reference ["Specif"] "exist")
 let coq_not_ref     = lazy (init_reference ["Logic"] "not")
diff --git a/interp/coqlib.mli b/interp/coqlib.mli
index 0efebc29..986a4385 100644
--- a/interp/coqlib.mli
+++ b/interp/coqlib.mli
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,9 +8,8 @@
 
 open Names
 open Libnames
-open Nametab
+open Globnames
 open Term
-open Pattern
 open Util
 
 (** This module collects the global references, constructions and
@@ -43,6 +42,7 @@ val gen_reference :  message -> string list -> string -> global_reference
 
 (** Search in several modules (not prefixed by "Coq") *)
 val gen_constant_in_modules : string->string list list-> string -> constr
+val gen_reference_in_modules : string->string list list-> string -> global_reference
 val arith_modules : string list list
 val zarith_base_modules : string list list
 val init_modules : string list list
@@ -53,12 +53,18 @@ val check_required_library : string list -> unit
 (** {6 Global references } *)
 
 (** Modules *)
-val logic_module : dir_path
-val logic_type_module : dir_path
+val prelude_module : DirPath.t
 
-val datatypes_module_name : string list
+val logic_module : DirPath.t
 val logic_module_name : string list
 
+val logic_type_module : DirPath.t
+
+val jmeq_module : DirPath.t
+val jmeq_module_name : string list
+
+val datatypes_module_name : string list
+
 (** Natural numbers *)
 val nat_path : full_path
 val glob_nat : global_reference
@@ -96,43 +102,49 @@ val build_bool_type : coq_bool_data delayed
 
 (** {6 For Equality tactics } *)
 type coq_sigma_data = {
-  proj1 : constr;
-  proj2 : constr;
-  elim  : constr;
-  intro : constr;
-  typ   : constr }
+  proj1 : global_reference;
+  proj2 : global_reference;
+  elim  : global_reference;
+  intro : global_reference;
+  typ   : global_reference }
 
 val build_sigma_set : coq_sigma_data delayed
 val build_sigma_type : coq_sigma_data delayed
 val build_sigma : coq_sigma_data delayed
 
+(* val build_sigma_type_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_sigma_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_prod_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_coq_eq_data_in : Environ.env -> coq_eq_data Univ.in_universe_context_set *)
+
 (** Non-dependent pairs in Set from Datatypes *)
 val build_prod : coq_sigma_data delayed
 
 type coq_eq_data = {
-  eq   : constr;
-  ind  : constr;
-  refl : constr;
-  sym  : constr;
-  trans: constr;
-  congr: constr }
+  eq   : global_reference;
+  ind  : global_reference;
+  refl : global_reference;
+  sym  : global_reference;
+  trans: global_reference;
+  congr: global_reference }
 
 val build_coq_eq_data : coq_eq_data delayed
+
 val build_coq_identity_data : coq_eq_data delayed
 val build_coq_jmeq_data : coq_eq_data delayed
 
-val build_coq_eq       : constr delayed (** = [(build_coq_eq_data()).eq] *)
-val build_coq_eq_refl  : constr delayed (** = [(build_coq_eq_data()).refl] *)
-val build_coq_eq_sym   : constr delayed (** = [(build_coq_eq_data()).sym] *)
-val build_coq_f_equal2 : constr delayed
+val build_coq_eq       : global_reference delayed (** = [(build_coq_eq_data()).eq] *)
+val build_coq_eq_refl  : global_reference delayed (** = [(build_coq_eq_data()).refl] *)
+val build_coq_eq_sym   : global_reference delayed (** = [(build_coq_eq_data()).sym] *)
+val build_coq_f_equal2 : global_reference delayed
 
 (** Data needed for discriminate and injection *)
 
 type coq_inversion_data = {
-  inv_eq   : constr; (** : forall params, args -> Prop *)
-  inv_ind  : constr; (** : forall params P (H : P params) args, eq params args 
+  inv_eq   : global_reference; (** : forall params, args -> Prop *)
+  inv_ind  : global_reference; (** : forall params P (H : P params) args, eq params args 
 			 ->  P args *)
-  inv_congr: constr  (** : forall params B (f:t->B) args, eq params args -> 
+  inv_congr: global_reference  (** : forall params B (f:t->B) args, eq params args -> 
 			 f params = f args *)
 }
 
@@ -148,6 +160,7 @@ val build_coq_sumbool : constr delayed
 (** Connectives 
    The False proposition *)
 val build_coq_False : constr delayed
+val build_coq_proof_admitted : constr delayed
 
 (** The True proposition and its unique proof *)
 val build_coq_True : constr delayed
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index dbccf8ae..c18ceeca 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.ml
@@ -1,11 +1,12 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Util
 
 (* Dump of globalization (to be used by coqdoc) *)
 
@@ -21,6 +22,7 @@ type glob_output_t =
     | NoGlob
     | StdOut
     | MultFiles
+    | Feedback
     | File of string
 
 let glob_output = ref NoGlob
@@ -29,14 +31,19 @@ let dump () = !glob_output != NoGlob
 
 let noglob () = glob_output := NoGlob
 
-let dump_to_stdout () = glob_output := StdOut; glob_file := Pervasives.stdout
+let dump_to_dotglob () = glob_output := MultFiles
 
-let dump_to_dotglob f = glob_output := MultFiles
+let dump_into_file f =
+  if String.equal f "stdout" then
+    (glob_output := StdOut; glob_file := Pervasives.stdout)
+  else
+    (glob_output := File f; open_glob_file f)
 
-let dump_into_file f = glob_output := File f; open_glob_file f
+let feedback_glob () = glob_output := Feedback
 
 let dump_string s =
-  if dump () then Pervasives.output_string !glob_file s
+  if dump () && !glob_output != Feedback then 
+    Pervasives.output_string !glob_file s
 
 let start_dump_glob vfile =
   match !glob_output with
@@ -48,23 +55,18 @@ let start_dump_glob vfile =
   | File f ->
       open_glob_file f;
       output_string !glob_file "DIGEST NO\n"
-  | NoGlob | StdOut ->
+  | NoGlob | Feedback | StdOut ->
       ()
 
 let end_dump_glob () =
   match !glob_output with
   | MultFiles | File _ -> close_glob_file ()
-  | NoGlob | StdOut -> ()
+  | NoGlob | Feedback | StdOut -> ()
 
 let previous_state = ref MultFiles
 let pause () = previous_state := !glob_output; glob_output := NoGlob
 let continue () = glob_output := !previous_state
 
-type coqdoc_state = Lexer.location_table
-
-let coqdoc_freeze = Lexer.location_table
-let coqdoc_unfreeze = Lexer.restore_location_table
-
 open Decl_kinds
 
 let type_of_logical_kind = function
@@ -102,18 +104,27 @@ let type_of_global_ref gr =
     "class"
   else
     match gr with
-    | Libnames.ConstRef cst ->
+    | Globnames.ConstRef cst ->
 	type_of_logical_kind (Decls.constant_kind cst)
-    | Libnames.VarRef v ->
+    | Globnames.VarRef v ->
 	"var" ^ type_of_logical_kind (Decls.variable_kind v)
-    | Libnames.IndRef ind ->
+    | Globnames.IndRef ind ->
 	let (mib,oib) = Inductive.lookup_mind_specif (Global.env ()) ind in
-	  if mib.Declarations.mind_record then
-	    if mib.Declarations.mind_finite then "rec"
-	    else "corec"
-	  else if mib.Declarations.mind_finite then "ind"
-	  else "coind"
-    | Libnames.ConstructRef _ -> "constr"
+	  if mib.Declarations.mind_record <> None then
+            let open Decl_kinds in
+            begin match mib.Declarations.mind_finite with
+            | Finite -> "indrec"
+            | BiFinite -> "rec"
+	    | CoFinite -> "corec"
+            end
+	  else
+            let open Decl_kinds in
+            begin match mib.Declarations.mind_finite with
+            | Finite -> "ind"
+            | BiFinite -> "variant"
+	    | CoFinite -> "coind"
+            end
+    | Globnames.ConstructRef _ -> "constr"
 
 let remove_sections dir =
   if Libnames.is_dirpath_prefix_of dir (Lib.cwd ()) then
@@ -124,79 +135,30 @@ let remove_sections dir =
     dir
 
 let interval loc =
-  let loc1,loc2 = Util.unloc loc in
+  let loc1,loc2 = Loc.unloc loc in
   loc1, loc2-1
 
 let dump_ref loc filepath modpath ident ty =
-  let bl,el = interval loc in
-  dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
+  if !glob_output = Feedback then
+    Pp.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
+  else
+    let bl,el = interval loc in
+    dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
 		  bl el filepath modpath ident ty)
 
-let add_glob_gen loc sp lib_dp ty =
-  if dump () then
-    let mod_dp,id = Libnames.repr_path sp in
-    let mod_dp = remove_sections mod_dp in
-    let mod_dp_trunc = Libnames.drop_dirpath_prefix lib_dp mod_dp in
-    let filepath = Names.string_of_dirpath lib_dp in
-    let modpath = Names.string_of_dirpath mod_dp_trunc in
-    let ident = Names.string_of_id id in
-      dump_ref loc filepath modpath ident ty
-
-let add_glob loc ref =
-  if dump () && loc <> Util.dummy_loc then
-    let sp = Nametab.path_of_global ref in
-    let lib_dp = Lib.library_part ref in
-    let ty = type_of_global_ref ref in
-      add_glob_gen loc sp lib_dp ty
-
-let mp_of_kn kn =
-  let mp,sec,l = Names.repr_kn kn in
-    Names.MPdot (mp,l)
-
-let add_glob_kn loc kn =
-  if dump () && loc <> Util.dummy_loc then
-    let sp = Nametab.path_of_syndef kn in
-    let lib_dp = Lib.dp_of_mp (mp_of_kn kn) in
-      add_glob_gen loc sp lib_dp "syndef"
-
-let dump_binding loc id = ()
-
-let dump_definition (loc, id) sec s =
-  let bl,el = interval loc in
-  dump_string (Printf.sprintf "%s %d:%d %s %s\n" s bl el
-			(Names.string_of_dirpath (Lib.current_dirpath sec)) (Names.string_of_id id))
-
 let dump_reference loc modpath ident ty =
-  let bl,el = interval loc in
-  dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
-		  bl el (Names.string_of_dirpath (Lib.library_dp ())) modpath ident ty)
-
-let dump_constraint ((loc, n), _, _) sec ty =
-  match n with
-    | Names.Name id -> dump_definition (loc, id) sec ty
-    | Names.Anonymous -> ()
+  let filepath = Names.DirPath.to_string (Lib.library_dp ()) in
+  dump_ref loc filepath modpath ident ty
 
 let dump_modref loc mp ty =
-  if dump () then
-    let (dp, l) = Lib.split_modpath mp in
-    let l = if l = [] then l else Util.list_drop_last l in
-    let fp = Names.string_of_dirpath dp in
-    let mp = Names.string_of_dirpath (Names.make_dirpath l) in
-    let bl,el = interval loc in
-      dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
-		      bl el fp mp "<>" ty)
-
-let dump_moddef loc mp ty =
-  if dump () then
-    let bl,el = interval loc in
-    let (dp, l) = Lib.split_modpath mp in
-    let mp = Names.string_of_dirpath (Names.make_dirpath l) in
-      dump_string (Printf.sprintf "%s %d:%d %s %s\n" ty bl el "<>" mp)
+  let (dp, l) = Lib.split_modpath mp in
+  let filepath = Names.DirPath.to_string dp in
+  let modpath = Names.DirPath.to_string (Names.DirPath.make l) in
+  let ident = "<>" in
+  dump_ref loc filepath modpath ident ty
 
 let dump_libref loc dp ty =
-  let bl,el = interval loc in
-  dump_string (Printf.sprintf "R%d:%d %s <> <> %s\n"
-		  bl el (Names.string_of_dirpath dp) ty)
+  dump_ref loc (Names.DirPath.to_string dp) "<>" "<>" ty
 
 let cook_notation df sc =
   (* We encode notations so that they are space-free and still human-readable *)
@@ -212,19 +174,19 @@ let cook_notation df sc =
   let l = String.length df - 1 in
   let i = ref 0 in
   while !i <= l do
-    assert (df.[!i] <> ' ');
-    if df.[!i] = '_' && (!i = l || df.[!i+1] = ' ') then
+    assert (df.[!i] != ' ');
+    if df.[!i] == '_' && (Int.equal !i l || df.[!i+1] == ' ') then
       (* Next token is a non-terminal *)
       (ntn.[!j] <- 'x'; incr j; incr i)
     else begin
       (* Next token is a terminal *)
       ntn.[!j] <- '\''; incr j;
-      while !i <= l && df.[!i] <> ' ' do
+      while !i <= l && df.[!i] != ' ' do
 	if df.[!i] < ' ' then
 	  let c = char_of_int (int_of_char 'A' + int_of_char df.[!i] - 1) in
 	  (String.blit ("'^" ^ String.make 1 c) 0 ntn !j 3; j := !j+3; incr i)
 	else begin
-	  if df.[!i] = '\'' then (ntn.[!j] <- '\''; incr j);
+	  if df.[!i] == '\'' then (ntn.[!j] <- '\''; incr j);
 	  ntn.[!j] <- df.[!i]; incr j; incr i
 	end
       done;
@@ -235,16 +197,67 @@ let cook_notation df sc =
   let df = String.sub ntn 0 !j in
   match sc with Some sc -> ":" ^ sc ^ ":" ^ df | _ -> "::" ^ df
 
-let dump_notation (loc,(df,_)) sc sec =
-  (* We dump the location of the opening '"' *)
-  dump_string (Printf.sprintf "not %d %s %s\n" (fst (Util.unloc loc))
-    (Names.string_of_dirpath (Lib.current_dirpath sec)) (cook_notation df sc))
-
 let dump_notation_location posl df (((path,secpath),_),sc) =
   if dump () then
-    let path = Names.string_of_dirpath path in
-    let secpath = Names.string_of_dirpath secpath in
+    let path = Names.DirPath.to_string path in
+    let secpath = Names.DirPath.to_string secpath in
     let df = cook_notation df sc in
-    List.iter (fun (bl,el) ->
-      dump_string(Printf.sprintf "R%d:%d %s %s %s not\n" bl el path secpath df))
+    List.iter (fun l ->
+      dump_ref (Loc.make_loc l) path secpath df "not")
       posl
+
+let add_glob_gen loc sp lib_dp ty =
+  if dump () then
+    let mod_dp,id = Libnames.repr_path sp in
+    let mod_dp = remove_sections mod_dp in
+    let mod_dp_trunc = Libnames.drop_dirpath_prefix lib_dp mod_dp in
+    let filepath = Names.DirPath.to_string lib_dp in
+    let modpath = Names.DirPath.to_string mod_dp_trunc in
+    let ident = Names.Id.to_string id in
+      dump_ref loc filepath modpath ident ty
+
+let add_glob loc ref =
+  if dump () && not (Loc.is_ghost loc) then
+    let sp = Nametab.path_of_global ref in
+    let lib_dp = Lib.library_part ref in
+    let ty = type_of_global_ref ref in
+      add_glob_gen loc sp lib_dp ty
+
+let mp_of_kn kn =
+  let mp,sec,l = Names.repr_kn kn in
+    Names.MPdot (mp,l)
+
+let add_glob_kn loc kn =
+  if dump () && not (Loc.is_ghost loc) then
+    let sp = Nametab.path_of_syndef kn in
+    let lib_dp = Lib.dp_of_mp (mp_of_kn kn) in
+      add_glob_gen loc sp lib_dp "syndef"
+
+let dump_binding loc id = ()
+
+let dump_def ty loc secpath id =
+  if !glob_output = Feedback then
+    Pp.feedback (Feedback.GlobDef (loc, id, secpath, ty))
+  else
+    let bl,el = interval loc in
+    dump_string (Printf.sprintf "%s %d:%d %s %s\n" ty bl el secpath id)
+
+let dump_definition (loc, id) sec s =
+  dump_def s loc (Names.DirPath.to_string (Lib.current_dirpath sec)) (Names.Id.to_string id)
+
+let dump_constraint ((loc, n), _, _) sec ty =
+  match n with
+    | Names.Name id -> dump_definition (loc, id) sec ty
+    | Names.Anonymous -> ()
+
+let dump_moddef loc mp ty =
+  let (dp, l) = Lib.split_modpath mp in
+  let mp = Names.DirPath.to_string (Names.DirPath.make l) in
+  dump_def ty loc "<>" mp
+
+let dump_notation (loc,(df,_)) sc sec =
+  (* We dump the location of the opening '"' *)
+  let i = fst (Loc.unloc loc) in
+  let location = (Loc.make_loc (i, i+1)) in
+  dump_def "not" location (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc)
+
diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli
index df192e9b..428189be 100644
--- a/interp/dumpglob.mli
+++ b/interp/dumpglob.mli
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -15,29 +15,30 @@ val end_dump_glob : unit -> unit
 val dump : unit -> bool
 
 val noglob : unit -> unit
-val dump_to_stdout : unit -> unit
-val dump_into_file : string -> unit
+val dump_into_file : string -> unit (** special handling of "stdout" *)
 val dump_to_dotglob : unit -> unit
+val feedback_glob : unit -> unit
 
 val pause : unit -> unit
 val continue : unit -> unit
 
-type coqdoc_state = Lexer.location_table
-val coqdoc_freeze : unit -> coqdoc_state
-val coqdoc_unfreeze : coqdoc_state -> unit
-
-val add_glob : Util.loc -> Libnames.global_reference -> unit
-val add_glob_kn : Util.loc -> Names.kernel_name -> unit
-
-val dump_definition : Util.loc * Names.identifier -> bool -> string -> unit
-val dump_moddef : Util.loc -> Names.module_path -> string -> unit
-val dump_modref  : Util.loc -> Names.module_path -> string -> unit
-val dump_reference  : Util.loc -> string -> string -> string -> unit
-val dump_libref : Util.loc -> Names.dir_path -> string -> unit
-val dump_notation_location : (int * int) list -> Topconstr.notation -> (Notation.notation_location * Topconstr.scope_name option) -> unit
-val dump_binding : Util.loc -> Names.Idset.elt -> unit
-val dump_notation : Util.loc * (Topconstr.notation * Notation.notation_location) -> Topconstr.scope_name option -> bool -> unit
-val dump_constraint :  Topconstr.typeclass_constraint -> bool -> string -> unit
+val add_glob : Loc.t -> Globnames.global_reference -> unit
+val add_glob_kn : Loc.t -> Names.kernel_name -> unit
+
+val dump_definition : Loc.t * Names.Id.t -> bool -> string -> unit
+val dump_moddef : Loc.t -> Names.module_path -> string -> unit
+val dump_modref  : Loc.t -> Names.module_path -> string -> unit
+val dump_reference  : Loc.t -> string -> string -> string -> unit
+val dump_libref : Loc.t -> Names.DirPath.t -> string -> unit
+val dump_notation_location : (int * int) list -> Constrexpr.notation ->
+  (Notation.notation_location * Notation_term.scope_name option) -> unit
+val dump_binding : Loc.t -> Names.Id.Set.elt -> unit
+val dump_notation :
+  Loc.t * (Constrexpr.notation * Notation.notation_location) ->
+  Notation_term.scope_name option -> bool -> unit
+val dump_constraint :
+  Constrexpr.typeclass_constraint -> bool -> string -> unit
 
 val dump_string : string -> unit
 
+val type_of_global_ref : Globnames.global_reference -> string 
diff --git a/interp/genarg.ml b/interp/genarg.ml
deleted file mode 100644
index 41cbcdaf..00000000
--- a/interp/genarg.ml
+++ /dev/null
@@ -1,281 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open Names
-open Nameops
-open Nametab
-open Glob_term
-open Topconstr
-open Term
-open Evd
-
-type argument_type =
-  (* Basic types *)
-  | BoolArgType
-  | IntArgType
-  | IntOrVarArgType
-  | StringArgType
-  | PreIdentArgType
-  | IntroPatternArgType
-  | IdentArgType of bool
-  | VarArgType
-  | RefArgType
-  (* Specific types *)
-  | SortArgType
-  | ConstrArgType
-  | ConstrMayEvalArgType
-  | QuantHypArgType
-  | OpenConstrArgType of bool * bool (* casted, TC resolution *)
-  | ConstrWithBindingsArgType
-  | BindingsArgType
-  | RedExprArgType
-  | List0ArgType of argument_type
-  | List1ArgType of argument_type
-  | OptArgType of argument_type
-  | PairArgType of argument_type * argument_type
-  | ExtraArgType of string
-
-type 'a and_short_name = 'a * identifier located option
-type 'a or_by_notation =
-  | AN of 'a
-  | ByNotation of (loc * string * Notation.delimiters option)
-
-let loc_of_or_by_notation f = function
-  | AN c -> f c
-  | ByNotation (loc,s,_) -> loc
-
-type glob_constr_and_expr = glob_constr * constr_expr option
-type open_constr_expr = unit * constr_expr
-type open_glob_constr = unit * glob_constr_and_expr
-
-type glob_constr_pattern_and_expr = glob_constr_and_expr * Pattern.constr_pattern
-
-type 'a with_ebindings = 'a * open_constr bindings
-
-(* Dynamics but tagged by a type expression *)
-
-type 'a generic_argument = argument_type * Obj.t
-
-type rlevel
-type glevel
-type tlevel
-
-type intro_pattern_expr =
-  | IntroOrAndPattern of or_and_intro_pattern_expr
-  | IntroWildcard
-  | IntroRewrite of bool
-  | IntroIdentifier of identifier
-  | IntroFresh of identifier
-  | IntroForthcoming of bool
-  | IntroAnonymous
-and or_and_intro_pattern_expr = (loc * intro_pattern_expr) list list
-
-let rec pr_intro_pattern (_,pat) = match pat with
-  | IntroOrAndPattern pll -> pr_or_and_intro_pattern pll
-  | IntroWildcard -> str "_"
-  | IntroRewrite true -> str "->"
-  | IntroRewrite false -> str "<-"
-  | IntroIdentifier id -> pr_id id
-  | IntroFresh id -> str "?" ++ pr_id id
-  | IntroForthcoming true -> str "*"
-  | IntroForthcoming false -> str "**"
-  | IntroAnonymous -> str "?"
-
-and pr_or_and_intro_pattern = function
-  | [pl] ->
-      str "(" ++ hv 0 (prlist_with_sep pr_comma pr_intro_pattern pl) ++ str ")"
-  | pll ->
-      str "[" ++
-      hv 0 (prlist_with_sep pr_bar (prlist_with_sep spc pr_intro_pattern) pll)
-      ++ str "]"
-
-let rawwit_bool = BoolArgType
-let globwit_bool = BoolArgType
-let wit_bool = BoolArgType
-
-let rawwit_int = IntArgType
-let globwit_int = IntArgType
-let wit_int = IntArgType
-
-let rawwit_int_or_var = IntOrVarArgType
-let globwit_int_or_var = IntOrVarArgType
-let wit_int_or_var = IntOrVarArgType
-
-let rawwit_string = StringArgType
-let globwit_string = StringArgType
-let wit_string = StringArgType
-
-let rawwit_pre_ident = PreIdentArgType
-let globwit_pre_ident = PreIdentArgType
-let wit_pre_ident = PreIdentArgType
-
-let rawwit_intro_pattern = IntroPatternArgType
-let globwit_intro_pattern = IntroPatternArgType
-let wit_intro_pattern = IntroPatternArgType
-
-let rawwit_ident_gen b = IdentArgType b
-let globwit_ident_gen b = IdentArgType b
-let wit_ident_gen b = IdentArgType b
-
-let rawwit_ident = rawwit_ident_gen true
-let globwit_ident = globwit_ident_gen true
-let wit_ident = wit_ident_gen true
-
-let rawwit_pattern_ident = rawwit_ident_gen false
-let globwit_pattern_ident = globwit_ident_gen false
-let wit_pattern_ident = wit_ident_gen false
-
-let rawwit_var = VarArgType
-let globwit_var = VarArgType
-let wit_var = VarArgType
-
-let rawwit_ref = RefArgType
-let globwit_ref = RefArgType
-let wit_ref = RefArgType
-
-let rawwit_quant_hyp = QuantHypArgType
-let globwit_quant_hyp = QuantHypArgType
-let wit_quant_hyp = QuantHypArgType
-
-let rawwit_sort = SortArgType
-let globwit_sort = SortArgType
-let wit_sort = SortArgType
-
-let rawwit_constr = ConstrArgType
-let globwit_constr = ConstrArgType
-let wit_constr = ConstrArgType
-
-let rawwit_constr_may_eval = ConstrMayEvalArgType
-let globwit_constr_may_eval = ConstrMayEvalArgType
-let wit_constr_may_eval = ConstrMayEvalArgType
-
-let rawwit_open_constr_gen (b1,b2) = OpenConstrArgType (b1,b2)
-let globwit_open_constr_gen (b1,b2) = OpenConstrArgType (b1,b2)
-let wit_open_constr_gen (b1,b2) = OpenConstrArgType (b1,b2)
-
-let rawwit_open_constr = rawwit_open_constr_gen (false,false)
-let globwit_open_constr = globwit_open_constr_gen (false,false)
-let wit_open_constr = wit_open_constr_gen (false,false)
-
-let rawwit_casted_open_constr = rawwit_open_constr_gen (true,false)
-let globwit_casted_open_constr = globwit_open_constr_gen (true,false)
-let wit_casted_open_constr = wit_open_constr_gen (true,false)
-
-let rawwit_open_constr_wTC = rawwit_open_constr_gen (false,true)
-let globwit_open_constr_wTC = globwit_open_constr_gen (false,true)
-let wit_open_constr_wTC = wit_open_constr_gen (false,true)
-
-let rawwit_constr_with_bindings = ConstrWithBindingsArgType
-let globwit_constr_with_bindings = ConstrWithBindingsArgType
-let wit_constr_with_bindings = ConstrWithBindingsArgType
-
-let rawwit_bindings = BindingsArgType
-let globwit_bindings = BindingsArgType
-let wit_bindings = BindingsArgType
-
-let rawwit_red_expr = RedExprArgType
-let globwit_red_expr = RedExprArgType
-let wit_red_expr = RedExprArgType
-
-let wit_list0 t = List0ArgType t
-
-let wit_list1 t = List1ArgType t
-
-let wit_opt t = OptArgType t
-
-let wit_pair t1 t2 = PairArgType (t1,t2)
-
-let in_gen t o = (t,Obj.repr o)
-let out_gen t (t',o) = if t = t' then Obj.magic o else failwith "out_gen"
-let genarg_tag (s,_) = s
-
-let fold_list0 f = function
-  | (List0ArgType t, l) ->
-      List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l)
-  | _ -> failwith "Genarg: not a list0"
-
-let fold_list1 f = function
-  | (List1ArgType t, l) ->
-      List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l)
-  | _ -> failwith "Genarg: not a list1"
-
-let fold_opt f a = function
-  | (OptArgType t, l) ->
-      (match Obj.magic l with
-	| None -> a
-	| Some x -> f (in_gen t x))
-  | _ -> failwith "Genarg: not a opt"
-
-let fold_pair f = function
-  | (PairArgType (t1,t2), l) ->
-      let (x1,x2) = Obj.magic l in
-      f (in_gen t1 x1) (in_gen t2 x2)
-  | _ -> failwith "Genarg: not a pair"
-
-let app_list0 f = function
-  | (List0ArgType t as u, l) ->
-      let o = Obj.magic l in
-      (u, Obj.repr (List.map (fun x -> out_gen t (f (in_gen t x))) o))
-  | _ -> failwith "Genarg: not a list0"
-
-let app_list1 f = function
-  | (List1ArgType t as u, l) ->
-      let o = Obj.magic l in
-      (u, Obj.repr (List.map (fun x -> out_gen t (f (in_gen t x))) o))
-  | _ -> failwith "Genarg: not a list1"
-
-let app_opt f = function
-  | (OptArgType t as u, l) ->
-      let o = Obj.magic l in
-      (u, Obj.repr (Option.map (fun x -> out_gen t (f (in_gen t x))) o))
-  | _ -> failwith "Genarg: not an opt"
-
-let app_pair f1 f2 = function
-  | (PairArgType (t1,t2) as u, l) ->
-      let (o1,o2) = Obj.magic l in
-      let o1 = out_gen t1 (f1 (in_gen t1 o1)) in
-      let o2 = out_gen t2 (f2 (in_gen t2 o2)) in
-      (u, Obj.repr (o1,o2))
-  | _ -> failwith "Genarg: not a pair"
-
-let unquote x = x
-
-type an_arg_of_this_type = Obj.t
-
-let in_generic t x = (t, Obj.repr x)
-
-let dyntab = ref ([] : (string * glevel generic_argument option) list)
-
-type ('a,'b) abstract_argument_type = argument_type
-
-let create_arg v s =
-  if List.mem_assoc s !dyntab then
-    anomaly ("Genarg.create: already declared generic argument " ^ s);
-  let t = ExtraArgType s in
-  dyntab := (s,Option.map (in_gen t) v) :: !dyntab;
-  (t,t,t)
-
-let exists_argtype s = List.mem_assoc s !dyntab
-
-let default_empty_argtype_value s = List.assoc s !dyntab
-
-let default_empty_value t =
-  let rec aux = function
-  | List0ArgType _ -> Some (in_gen t [])
-  | OptArgType _ -> Some (in_gen t None)
-  | PairArgType(t1,t2) ->
-      (match aux t1, aux t2 with
-      | Some (_,v1), Some (_,v2) -> Some (in_gen t (v1,v2))
-      | _ -> None)
-  | ExtraArgType s -> default_empty_argtype_value s
-  | _ -> None in
-  match aux t with
-  | Some v -> Some (out_gen t v)
-  | None -> None
diff --git a/interp/genarg.mli b/interp/genarg.mli
deleted file mode 100644
index f1425c55..00000000
--- a/interp/genarg.mli
+++ /dev/null
@@ -1,320 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Libnames
-open Glob_term
-open Pattern
-open Topconstr
-open Term
-open Evd
-
-type 'a and_short_name = 'a * identifier located option
-
-type 'a or_by_notation =
-  | AN of 'a
-  | ByNotation of (loc * string * Notation.delimiters option)
-
-val loc_of_or_by_notation : ('a -> loc) -> 'a or_by_notation -> loc
-
-(** In globalize tactics, we need to keep the initial [constr_expr] to recompute
-   in the environment by the effective calls to Intro, Inversion, etc 
-   The [constr_expr] field is [None] in TacDef though *)
-type glob_constr_and_expr = glob_constr * constr_expr option
-
-type open_constr_expr = unit * constr_expr
-type open_glob_constr = unit * glob_constr_and_expr
-
-type glob_constr_pattern_and_expr = glob_constr_and_expr * constr_pattern
-
-type 'a with_ebindings = 'a * open_constr bindings
-
-type intro_pattern_expr =
-  | IntroOrAndPattern of or_and_intro_pattern_expr
-  | IntroWildcard
-  | IntroRewrite of bool
-  | IntroIdentifier of identifier
-  | IntroFresh of identifier
-  | IntroForthcoming of bool
-  | IntroAnonymous
-and or_and_intro_pattern_expr = (loc * intro_pattern_expr) list list
-
-val pr_intro_pattern : intro_pattern_expr located -> Pp.std_ppcmds
-val pr_or_and_intro_pattern : or_and_intro_pattern_expr -> Pp.std_ppcmds
-
-(** The route of a generic argument, from parsing to evaluation.
-In the following diagram, "object" can be tactic_expr, constr, tactic_arg, etc.
-
-{% \begin{%}verbatim{% }%}
-             parsing          in_raw                            out_raw
-   char stream ---> raw_object ---> raw_object generic_argument -------+
-                          encapsulation                          decaps|
-                                                                       |
-                                                                       V
-                                                                   raw_object
-                                                                       |
-                                                         globalization |
-                                                                       V
-                                                                   glob_object
-                                                                       |
-                                                                encaps |
-                                                               in_glob |
-                                                                       V
-                                                           glob_object generic_argument
-                                                                       |
-          out                          in                     out_glob |
-  object <--- object generic_argument <--- object <--- glob_object <---+
-    |   decaps                       encaps      interp           decaps
-    |
-    V
-effective use
-{% \end{%}verbatim{% }%}
-
-To distinguish between the uninterpreted (raw), globalized and
-interpreted worlds, we annotate the type [generic_argument] by a
-phantom argument which is either [constr_expr], [glob_constr] or
-[constr].
-
-Transformation for each type :
-{% \begin{%}verbatim{% }%}
-tag                            raw open type            cooked closed type
-
-BoolArgType                    bool                      bool
-IntArgType                     int                       int
-IntOrVarArgType                int or_var                int
-StringArgType                  string (parsed w/ "")     string
-PreIdentArgType                string (parsed w/o "")    (vernac only)
-IdentArgType true              identifier                identifier
-IdentArgType false             identifier (pattern_ident) identifier
-IntroPatternArgType            intro_pattern_expr        intro_pattern_expr
-VarArgType                     identifier located        identifier
-RefArgType                     reference                 global_reference
-QuantHypArgType                quantified_hypothesis     quantified_hypothesis
-ConstrArgType                  constr_expr               constr
-ConstrMayEvalArgType           constr_expr may_eval      constr
-OpenConstrArgType              open_constr_expr          open_constr
-ConstrWithBindingsArgType      constr_expr with_bindings constr with_bindings
-BindingsArgType                constr_expr bindings      constr bindings
-List0ArgType of argument_type
-List1ArgType of argument_type
-OptArgType of argument_type
-ExtraArgType of string         '_a                      '_b
-{% \end{%}verbatim{% }%}
-*)
-
-(** All of [rlevel], [glevel] and [tlevel] must be non convertible
-   to ensure the injectivity of the type inference from type
-   ['co generic_argument] to [('a,'co) abstract_argument_type];
-   this guarantees that, for 'co fixed, the type of
-   out_gen is monomorphic over 'a, hence type-safe
-*)
-
-type rlevel
-type glevel
-type tlevel
-
-type ('a,'co) abstract_argument_type
-
-val rawwit_bool : (bool,rlevel) abstract_argument_type
-val globwit_bool : (bool,glevel) abstract_argument_type
-val wit_bool : (bool,tlevel) abstract_argument_type
-
-val rawwit_int : (int,rlevel) abstract_argument_type
-val globwit_int : (int,glevel) abstract_argument_type
-val wit_int : (int,tlevel) abstract_argument_type
-
-val rawwit_int_or_var : (int or_var,rlevel) abstract_argument_type
-val globwit_int_or_var : (int or_var,glevel) abstract_argument_type
-val wit_int_or_var : (int or_var,tlevel) abstract_argument_type
-
-val rawwit_string : (string,rlevel) abstract_argument_type
-val globwit_string : (string,glevel) abstract_argument_type
-
-val wit_string : (string,tlevel) abstract_argument_type
-
-val rawwit_pre_ident : (string,rlevel) abstract_argument_type
-val globwit_pre_ident : (string,glevel) abstract_argument_type
-val wit_pre_ident : (string,tlevel) abstract_argument_type
-
-val rawwit_intro_pattern : (intro_pattern_expr located,rlevel) abstract_argument_type
-val globwit_intro_pattern : (intro_pattern_expr located,glevel) abstract_argument_type
-val wit_intro_pattern : (intro_pattern_expr located,tlevel) abstract_argument_type
-
-val rawwit_ident : (identifier,rlevel) abstract_argument_type
-val globwit_ident : (identifier,glevel) abstract_argument_type
-val wit_ident : (identifier,tlevel) abstract_argument_type
-
-val rawwit_pattern_ident : (identifier,rlevel) abstract_argument_type
-val globwit_pattern_ident : (identifier,glevel) abstract_argument_type
-val wit_pattern_ident : (identifier,tlevel) abstract_argument_type
-
-val rawwit_ident_gen : bool -> (identifier,rlevel) abstract_argument_type
-val globwit_ident_gen : bool -> (identifier,glevel) abstract_argument_type
-val wit_ident_gen : bool -> (identifier,tlevel) abstract_argument_type
-
-val rawwit_var : (identifier located,rlevel) abstract_argument_type
-val globwit_var : (identifier located,glevel) abstract_argument_type
-val wit_var : (identifier,tlevel) abstract_argument_type
-
-val rawwit_ref : (reference,rlevel) abstract_argument_type
-val globwit_ref : (global_reference located or_var,glevel) abstract_argument_type
-val wit_ref : (global_reference,tlevel) abstract_argument_type
-
-val rawwit_quant_hyp : (quantified_hypothesis,rlevel) abstract_argument_type
-val globwit_quant_hyp : (quantified_hypothesis,glevel) abstract_argument_type
-val wit_quant_hyp : (quantified_hypothesis,tlevel) abstract_argument_type
-
-val rawwit_sort : (glob_sort,rlevel) abstract_argument_type
-val globwit_sort : (glob_sort,glevel) abstract_argument_type
-val wit_sort : (sorts,tlevel) abstract_argument_type
-
-val rawwit_constr : (constr_expr,rlevel) abstract_argument_type
-val globwit_constr : (glob_constr_and_expr,glevel) abstract_argument_type
-val wit_constr : (constr,tlevel) abstract_argument_type
-
-val rawwit_constr_may_eval : ((constr_expr,reference or_by_notation,constr_expr) may_eval,rlevel) abstract_argument_type
-val globwit_constr_may_eval : ((glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) may_eval,glevel) abstract_argument_type
-val wit_constr_may_eval : (constr,tlevel) abstract_argument_type
-
-val rawwit_open_constr_gen : bool * bool -> (open_constr_expr,rlevel) abstract_argument_type
-val globwit_open_constr_gen : bool * bool -> (open_glob_constr,glevel) abstract_argument_type
-val wit_open_constr_gen : bool * bool -> (open_constr,tlevel) abstract_argument_type
-
-val rawwit_open_constr : (open_constr_expr,rlevel) abstract_argument_type
-val globwit_open_constr : (open_glob_constr,glevel) abstract_argument_type
-val wit_open_constr : (open_constr,tlevel) abstract_argument_type
-
-val rawwit_casted_open_constr : (open_constr_expr,rlevel) abstract_argument_type
-val globwit_casted_open_constr : (open_glob_constr,glevel) abstract_argument_type
-val wit_casted_open_constr : (open_constr,tlevel) abstract_argument_type
-
-val rawwit_open_constr_wTC : (open_constr_expr,rlevel) abstract_argument_type
-val globwit_open_constr_wTC : (open_glob_constr,glevel) abstract_argument_type
-val wit_open_constr_wTC : (open_constr,tlevel) abstract_argument_type
-
-val rawwit_constr_with_bindings : (constr_expr with_bindings,rlevel) abstract_argument_type
-val globwit_constr_with_bindings : (glob_constr_and_expr with_bindings,glevel) abstract_argument_type
-val wit_constr_with_bindings : (constr with_bindings sigma,tlevel) abstract_argument_type
-
-val rawwit_bindings : (constr_expr bindings,rlevel) abstract_argument_type
-val globwit_bindings : (glob_constr_and_expr bindings,glevel) abstract_argument_type
-val wit_bindings : (constr bindings sigma,tlevel) abstract_argument_type
-
-val rawwit_red_expr : ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,rlevel) abstract_argument_type
-val globwit_red_expr : ((glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,glevel) abstract_argument_type
-val wit_red_expr : ((constr,evaluable_global_reference,constr_pattern) red_expr_gen,tlevel) abstract_argument_type
-
-val wit_list0 :
-  ('a,'co) abstract_argument_type -> ('a list,'co) abstract_argument_type
-
-val wit_list1 :
-  ('a,'co) abstract_argument_type -> ('a list,'co) abstract_argument_type
-
-val wit_opt :
-  ('a,'co) abstract_argument_type -> ('a option,'co) abstract_argument_type
-
-val wit_pair :
-  ('a,'co) abstract_argument_type ->
-  ('b,'co) abstract_argument_type ->
-      ('a * 'b,'co) abstract_argument_type
-
-(** ['a generic_argument] = (Sigma t:type. t[[constr/'a]]) *)
-type 'a generic_argument
-
-val fold_list0 :
- ('a generic_argument -> 'c -> 'c) -> 'a generic_argument -> 'c -> 'c
-
-val fold_list1 :
- ('a generic_argument -> 'c -> 'c) -> 'a generic_argument -> 'c -> 'c
-
-val fold_opt :
- ('a generic_argument -> 'c) -> 'c -> 'a generic_argument -> 'c
-
-val fold_pair :
- ('a generic_argument -> 'a generic_argument -> 'c) ->
-      'a generic_argument -> 'c
-
-(** [app_list0] fails if applied to an argument not of tag [List0 t]
-    for some [t]; it's the responsability of the caller to ensure it *)
-
-val app_list0 : ('a generic_argument -> 'b generic_argument) ->
-'a generic_argument -> 'b generic_argument
-
-val app_list1 : ('a generic_argument -> 'b generic_argument) ->
-'a generic_argument -> 'b generic_argument
-
-val app_opt : ('a generic_argument -> 'b generic_argument) ->
-'a generic_argument -> 'b generic_argument
-
-val app_pair :
-  ('a generic_argument -> 'b generic_argument) ->
-      ('a generic_argument -> 'b generic_argument)
-   -> 'a generic_argument -> 'b generic_argument
-
-(** create a new generic type of argument: force to associate
-   unique ML types at each of the three levels *)
-val create_arg : 'rawa option ->
-    string ->
-      ('a,tlevel) abstract_argument_type
-      * ('globa,glevel) abstract_argument_type
-      * ('rawa,rlevel) abstract_argument_type
-
-val exists_argtype : string -> bool
-
-type argument_type =
-  (** Basic types *)
-  | BoolArgType
-  | IntArgType
-  | IntOrVarArgType
-  | StringArgType
-  | PreIdentArgType
-  | IntroPatternArgType
-  | IdentArgType of bool
-  | VarArgType
-  | RefArgType
-  (** Specific types *)
-  | SortArgType
-  | ConstrArgType
-  | ConstrMayEvalArgType
-  | QuantHypArgType
-  | OpenConstrArgType of bool * bool
-  | ConstrWithBindingsArgType
-  | BindingsArgType
-  | RedExprArgType
-  | List0ArgType of argument_type
-  | List1ArgType of argument_type
-  | OptArgType of argument_type
-  | PairArgType of argument_type * argument_type
-  | ExtraArgType of string
-
-val genarg_tag : 'a generic_argument -> argument_type
-
-val unquote : ('a,'co) abstract_argument_type -> argument_type
-
-val in_gen :
-  ('a,'co) abstract_argument_type -> 'a -> 'co generic_argument
-val out_gen :
-  ('a,'co) abstract_argument_type -> 'co generic_argument -> 'a
-
-(** [in_generic] is used in combination with camlp4 [Gramext.action] magic
-
-   [in_generic: !l:type, !a:argument_type -> |a|_l -> 'l generic_argument]
-
-   where |a|_l is the interpretation of a at level l
-
-   [in_generic] is not typable; we replace the second argument by an absurd
-   type (with no introduction rule)
-*)
-type an_arg_of_this_type
-
-val in_generic :
-  argument_type -> an_arg_of_this_type -> 'co generic_argument
-
-val default_empty_value : ('a,rlevel) abstract_argument_type -> 'a option
diff --git a/interp/genintern.ml b/interp/genintern.ml
new file mode 100644
index 00000000..c78b13a8
--- /dev/null
+++ b/interp/genintern.ml
@@ -0,0 +1,57 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Mod_subst
+open Genarg
+
+type glob_sign = {
+  ltacvars : Id.Set.t;
+  ltacrecvars : Nametab.ltac_constant Id.Map.t;
+  genv : Environ.env }
+
+type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
+type 'glb subst_fun = substitution -> 'glb -> 'glb
+
+module InternObj =
+struct
+  type ('raw, 'glb, 'top) obj = ('raw, 'glb) intern_fun
+  let name = "intern"
+  let default _ = None
+end
+
+module SubstObj =
+struct
+  type ('raw, 'glb, 'top) obj = 'glb subst_fun
+  let name = "subst"
+  let default _ = None
+end
+
+module Intern = Register (InternObj)
+module Subst = Register (SubstObj)
+
+let intern = Intern.obj
+let register_intern0 = Intern.register0
+
+let generic_intern ist v =
+  let unpacker wit v =
+    let (ist, v) = intern wit ist (raw v) in
+    (ist, in_gen (glbwit wit) v)
+  in
+  unpack { unpacker; } v
+
+(** Substitution functions *)
+
+let substitute = Subst.obj
+let register_subst0 = Subst.register0
+
+let generic_substitute subs v =
+  let unpacker wit v = in_gen (glbwit wit) (substitute wit subs (glb v)) in
+  unpack { unpacker; } v
+
+let () = Hook.set Detyping.subst_genarg_hook generic_substitute
diff --git a/interp/genintern.mli b/interp/genintern.mli
new file mode 100644
index 00000000..6e63f71c
--- /dev/null
+++ b/interp/genintern.mli
@@ -0,0 +1,42 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Mod_subst
+open Genarg
+
+type glob_sign = {
+  ltacvars : Id.Set.t;
+  ltacrecvars : Nametab.ltac_constant Id.Map.t;
+  genv : Environ.env }
+
+(** {5 Internalization functions} *)
+
+type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
+(** The type of functions used for internalizing generic arguments. *)
+
+val intern : ('raw, 'glb, 'top) genarg_type -> ('raw, 'glb) intern_fun
+
+val generic_intern : (raw_generic_argument, glob_generic_argument) intern_fun
+
+(** {5 Substitution functions} *)
+
+type 'glb subst_fun = substitution -> 'glb -> 'glb
+(** The type of functions used for substituting generic arguments. *)
+
+val substitute : ('raw, 'glb, 'top) genarg_type -> 'glb subst_fun
+
+val generic_substitute : glob_generic_argument subst_fun
+
+(** Registering functions *)
+
+val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
+  ('raw, 'glb) intern_fun -> unit
+
+val register_subst0 : ('raw, 'glb, 'top) genarg_type ->
+  'glb subst_fun -> unit
diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml
index 1b0f1341..e304725d 100644
--- a/interp/implicit_quantifiers.ml
+++ b/interp/implicit_quantifiers.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -9,45 +9,35 @@
 (*i*)
 open Names
 open Decl_kinds
-open Term
-open Sign
-open Evd
-open Environ
-open Nametab
-open Mod_subst
+open Errors
 open Util
 open Glob_term
-open Topconstr
+open Constrexpr
 open Libnames
 open Typeclasses
 open Typeclasses_errors
 open Pp
 open Libobject
 open Nameops
+open Misctypes
 (*i*)
 
-let generalizable_table = ref Idpred.empty
-
-let _ =
-  Summary.declare_summary "generalizable-ident"
-    { Summary.freeze_function = (fun () -> !generalizable_table);
-      Summary.unfreeze_function = (fun r -> generalizable_table := r);
-      Summary.init_function = (fun () -> generalizable_table := Idpred.empty) }
+let generalizable_table = Summary.ref Id.Pred.empty ~name:"generalizable-ident"
 
 let declare_generalizable_ident table (loc,id) =
-  if id <> root_of_id id then
+  if not (Id.equal id (root_of_id id)) then
     user_err_loc(loc,"declare_generalizable_ident",
     (pr_id id ++ str
       " is not declarable as generalizable identifier: it must have no trailing digits, quote, or _"));
-  if Idpred.mem id table then
+  if Id.Pred.mem id table then
     user_err_loc(loc,"declare_generalizable_ident",
 		(pr_id id++str" is already declared as a generalizable identifier"))
-  else Idpred.add id table
+  else Id.Pred.add id table
 
 let add_generalizable gen table =
   match gen with
-  | None -> Idpred.empty
-  | Some [] -> Idpred.full
+  | None -> Id.Pred.empty
+  | Some [] -> Id.Pred.full
   | Some l -> List.fold_left (fun table lid -> declare_generalizable_ident table lid)
       table l
 
@@ -57,7 +47,7 @@ let cache_generalizable_type (_,(local,cmd)) =
 let load_generalizable_type _ (_,(local,cmd)) =
   generalizable_table := add_generalizable cmd !generalizable_table
 
-let in_generalizable : bool * identifier located list option -> obj =
+let in_generalizable : bool * Id.t Loc.located list option -> obj =
   declare_object {(default_object "GENERALIZED-IDENT") with
     load_function = load_generalizable_type;
     cache_function = cache_generalizable_type;
@@ -67,29 +57,22 @@ let in_generalizable : bool * identifier located list option -> obj =
 let declare_generalizable local gen =
  Lib.add_anonymous_leaf (in_generalizable (local, gen))
 
-let find_generalizable_ident id = Idpred.mem (root_of_id id) !generalizable_table
+let find_generalizable_ident id = Id.Pred.mem (root_of_id id) !generalizable_table
 
 let ids_of_list l =
-  List.fold_right Idset.add l Idset.empty
-
-let locate_reference qid =
-  match Nametab.locate_extended qid with
-    | TrueGlobal ref -> true
-    | SynDef kn -> true
+  List.fold_right Id.Set.add l Id.Set.empty
 
 let is_global id =
-  try
-    locate_reference (qualid_of_ident id)
-  with Not_found ->
-    false
+  try ignore (Nametab.locate_extended (qualid_of_ident id)); true
+  with Not_found -> false
+
+let is_named id env =
+  try ignore (Environ.lookup_named id env); true
+  with Not_found -> false
 
 let is_freevar ids env x =
-  try
-    if Idset.mem x ids then false
-    else
-      try ignore(Environ.lookup_named x env) ; false
-      with e when Errors.noncritical e -> not (is_global x)
-  with e when Errors.noncritical e -> true
+  not (Id.Set.mem x ids || is_named x env || is_global x)
+
 
 (* Auxiliary functions for the inference of implicitly quantified variables. *)
 
@@ -97,9 +80,9 @@ let ungeneralizable loc id =
   user_err_loc (loc, "Generalization", 
 	       str "Unbound and ungeneralizable variable " ++ pr_id id)
 
-let free_vars_of_constr_expr c ?(bound=Idset.empty) l =
+let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
   let found loc id bdvars l =
-    if List.mem id l then l
+    if Id.List.mem id l then l
     else if is_freevar bdvars (Global.env ()) id
     then
       if find_generalizable_ident id then id :: l
@@ -107,26 +90,26 @@ let free_vars_of_constr_expr c ?(bound=Idset.empty) l =
     else l
   in
   let rec aux bdvars l c = match c with
-    | CRef (Ident (loc,id)) -> found loc id bdvars l
-    | CNotation (_, "{ _ : _ | _ }", (CRef (Ident (_, id)) :: _, [], [])) when not (Idset.mem id bdvars) ->
-	fold_constr_expr_with_binders (fun a l -> Idset.add a l) aux (Idset.add id bdvars) l c
-    | c -> fold_constr_expr_with_binders (fun a l -> Idset.add a l) aux bdvars l c
+    | CRef (Ident (loc,id),_) -> found loc id bdvars l
+    | CNotation (_, "{ _ : _ | _ }", (CRef (Ident (_, id),_) :: _, [], [])) when not (Id.Set.mem id bdvars) ->
+	Topconstr.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux (Id.Set.add id bdvars) l c
+    | c -> Topconstr.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux bdvars l c
   in aux bound l c
 
 let ids_of_names l =
   List.fold_left (fun acc x -> match snd x with Name na -> na :: acc | Anonymous -> acc) [] l
 
-let free_vars_of_binders ?(bound=Idset.empty) l (binders : local_binder list) =
+let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder list) =
   let rec aux bdvars l c = match c with
       ((LocalRawAssum (n, _, c)) :: tl) ->
 	let bound = ids_of_names n in
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
-	  aux (Idset.union (ids_of_list bound) bdvars) l' tl
+	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
 
     | ((LocalRawDef (n, c)) :: tl) ->
 	let bound = match snd n with Anonymous -> [] | Name n -> [n] in
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
-	  aux (Idset.union (ids_of_list bound) bdvars) l' tl
+	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
 
     | [] -> bdvars, l
   in aux bound l binders
@@ -134,13 +117,13 @@ let free_vars_of_binders ?(bound=Idset.empty) l (binders : local_binder list) =
 let add_name_to_ids set na =
   match na with
   | Anonymous -> set
-  | Name id -> Idset.add id set
+  | Name id -> Id.Set.add id set
 
-let generalizable_vars_of_glob_constr ?(bound=Idset.empty) ?(allowed=Idset.empty) =
+let generalizable_vars_of_glob_constr ?(bound=Id.Set.empty) ?(allowed=Id.Set.empty) =
   let rec vars bound vs = function
     | GVar (loc,id) ->
 	if is_freevar bound (Global.env ()) id then
-	  if List.mem_assoc id vs then vs
+	  if Id.List.mem_assoc id vs then vs
 	  else (id, loc) :: vs
 	else vs
     | GApp (loc,f,args) -> List.fold_left (vars bound) vs (f::args)
@@ -163,7 +146,7 @@ let generalizable_vars_of_glob_constr ?(bound=Idset.empty) ?(allowed=Idset.empty
 	let vs3 = vars bound vs2 b1 in
 	vars bound vs3 b2
     | GRec (loc,fk,idl,bl,tyl,bv) ->
-	let bound' = Array.fold_right Idset.add idl bound in
+	let bound' = Array.fold_right Id.Set.add idl bound in
 	let vars_fix i vs fid =
 	  let vs1,bound1 =
 	    List.fold_left
@@ -179,13 +162,13 @@ let generalizable_vars_of_glob_constr ?(bound=Idset.empty) ?(allowed=Idset.empty
 	  let vs2 = vars bound1 vs1 tyl.(i) in
 	  vars bound1 vs2 bv.(i)
 	in
-	array_fold_left_i vars_fix vs idl
+	Array.fold_left_i vars_fix vs idl
     | GCast (loc,c,k) -> let v = vars bound vs c in
-	(match k with CastConv (_,t) -> vars bound v t | _ -> v)
+	(match k with CastConv t | CastVM t -> vars bound v t | _ -> v)
     | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> vs
 
   and vars_pattern bound vs (loc,idl,p,c) =
-    let bound' = List.fold_right Idset.add idl bound  in
+    let bound' = List.fold_right Id.Set.add idl bound  in
     vars bound' vs c
 
   and vars_option bound vs = function None -> vs | Some p -> vars bound vs p
@@ -196,7 +179,7 @@ let generalizable_vars_of_glob_constr ?(bound=Idset.empty) ?(allowed=Idset.empty
   in fun rt -> 
     let vars = List.rev (vars bound [] rt) in
       List.iter (fun (id, loc) ->
-	if not (Idset.mem id allowed || find_generalizable_ident id) then 
+	if not (Id.Set.mem id allowed || find_generalizable_ident id) then 
 	  ungeneralizable loc id) vars;
       vars
 
@@ -205,7 +188,7 @@ let rec make_fresh ids env x =
 
 let next_name_away_from na avoid =
   match na with
-  | Anonymous -> make_fresh avoid (Global.env ()) (id_of_string "anon")
+  | Anonymous -> make_fresh avoid (Global.env ()) (Id.of_string "anon")
   | Name id -> make_fresh avoid (Global.env ()) id
 
 let combine_params avoid fn applied needed =
@@ -213,7 +196,11 @@ let combine_params avoid fn applied needed =
     List.partition
       (function
 	  (t, Some (loc, ExplByName id)) ->
-	    if not (List.exists (fun (_, (id', _, _)) -> Name id = id') needed) then
+            let is_id (_, (na, _, _)) = match na with
+            | Name id' -> Id.equal id id'
+            | Anonymous -> false
+            in
+	    if not (List.exists is_id needed) then
 	      user_err_loc (loc,"",str "Wrong argument name: " ++ Nameops.pr_id id);
 	    true
 	| _ -> false) applied
@@ -222,13 +209,17 @@ let combine_params avoid fn applied needed =
     (fun x -> match x with (t, Some (loc, ExplByName id)) -> id, t | _ -> assert false)
     named
   in
-  let needed = List.filter (fun (_, (_, b, _)) -> b = None) needed in
+  let is_unset (_, (_, b, _)) = match b with
+  | None -> true
+  | Some _ -> false
+  in
+  let needed = List.filter is_unset needed in
   let rec aux ids avoid app need =
     match app, need with
 	[], [] -> List.rev ids, avoid
 
-      | app, (_, (Name id, _, _)) :: need when List.mem_assoc id named ->
-	  aux (List.assoc id named :: ids) avoid app need
+      | app, (_, (Name id, _, _)) :: need when Id.List.mem_assoc id named ->
+	  aux (Id.List.assoc id named :: ids) avoid app need
 
       | (x, None) :: app, (None, (Name id, _, _)) :: need ->
 	  aux (x :: ids) avoid app need
@@ -244,25 +235,25 @@ let combine_params avoid fn applied needed =
 	    aux (t' :: ids) avoid' app need
 
       | (x,_) :: _, [] ->
-	  user_err_loc (constr_loc x,"",str "Typeclass does not expect more arguments")
+	  user_err_loc (Constrexpr_ops.constr_loc x,"",str "Typeclass does not expect more arguments")
   in aux [] avoid applied needed
 
 let combine_params_freevar =
   fun avoid (_, (na, _, _)) ->
     let id' = next_name_away_from na avoid in
-      (CRef (Ident (dummy_loc, id')), Idset.add id' avoid)
+      (CRef (Ident (Loc.ghost, id'),None), Id.Set.add id' avoid)
 
 let destClassApp cl =
   match cl with
-    | CApp (loc, (None, CRef ref), l) -> loc, ref, List.map fst l
-    | CAppExpl (loc, (None, ref), l) -> loc, ref, l
-    | CRef ref -> loc_of_reference ref, ref, []
+    | CApp (loc, (None, CRef (ref,_)), l) -> loc, ref, List.map fst l
+    | CAppExpl (loc, (None, ref,_), l) -> loc, ref, l
+    | CRef (ref,_) -> loc_of_reference ref, ref, []
     | _ -> raise Not_found
 
 let destClassAppExpl cl =
   match cl with
-    | CApp (loc, (None, CRef ref), l) -> loc, ref, l
-    | CRef ref -> loc_of_reference ref, ref, []
+    | CApp (loc, (None, CRef (ref,_)), l) -> loc, ref, l
+    | CRef (ref,_) -> loc_of_reference ref, ref, []
     | _ -> raise Not_found
 
 let implicit_application env ?(allow_partial=true) f ty =
@@ -277,32 +268,37 @@ let implicit_application env ?(allow_partial=true) f ty =
     match is_class with
     | None -> ty, env
     | Some ((loc, id, par), gr) ->
-	let avoid = Idset.union env (ids_of_list (free_vars_of_constr_expr ty ~bound:env [])) in
+	let avoid = Id.Set.union env (ids_of_list (free_vars_of_constr_expr ty ~bound:env [])) in
 	let c, avoid =
 	  let c = class_info gr in
 	  let (ci, rd) = c.cl_context in
 	  if not allow_partial then
 	    begin
-	      let applen = List.fold_left (fun acc (x, y) -> if y = None then succ acc else acc) 0 par in
-	      let needlen = List.fold_left (fun acc x -> if x = None then succ acc else acc) 0 ci in
-		if needlen <> applen then
+              let opt_succ x n = match x with
+              | None -> succ n
+              | Some _ -> n
+              in
+	      let applen = List.fold_left (fun acc (x, y) -> opt_succ y acc) 0 par in
+	      let needlen = List.fold_left (fun acc x -> opt_succ x acc) 0 ci in
+		if not (Int.equal needlen applen) then
 		  Typeclasses_errors.mismatched_ctx_inst (Global.env ()) Parameters (List.map fst par) rd
 	    end;
 	  let pars = List.rev (List.combine ci rd) in
 	  let args, avoid = combine_params avoid f par pars in
-	    CAppExpl (loc, (None, id), args), avoid
+	    CAppExpl (loc, (None, id, None), args), avoid
 	in c, avoid
 
 let implicits_of_glob_constr ?(with_products=true) l =
-  let add_impl i na bk l =
- 	if bk = Implicit then
-	  let name =
-	    match na with
-	    | Name id -> Some id
-	    | Anonymous -> None
-	  in
-	    (ExplByPos (i, name), (true, true, true)) :: l
-	else l in
+  let add_impl i na bk l = match bk with
+  | Implicit ->
+    let name =
+      match na with
+      | Name id -> Some id
+      | Anonymous -> None
+    in
+    (ExplByPos (i, name), (true, true, true)) :: l
+  | _ -> l
+  in
   let rec aux i c =
     let abs na bk b =
       add_impl i na bk (aux (succ i) b)
@@ -310,15 +306,17 @@ let implicits_of_glob_constr ?(with_products=true) l =
       match c with
       | GProd (loc, na, bk, t, b) ->
 	  if with_products then abs na bk b
-	  else 
-	    (if bk = Implicit then
-	       msg_warning (str "Ignoring implicit status of product binder " ++ 
-			      pr_name na ++ str " and following binders");
-	     [])
+	  else
+            let () = match bk with
+            | Implicit ->
+	       msg_warning (strbrk "Ignoring implicit status of product binder " ++ 
+			      pr_name na ++ strbrk " and following binders")
+            | _ -> ()
+            in []
       | GLambda (loc, na, bk, t, b) -> abs na bk b
       | GLetIn (loc, na, t, b) -> aux i b
       | GRec (_, fix_kind, nas, args, tys, bds) ->
        let nb = match fix_kind with |GFix (_, n) -> n | GCoFix n -> n in
-       list_fold_left_i (fun i l (na,bk,_,_) -> add_impl i na bk l) i (aux (List.length args.(nb) + i) bds.(nb)) args.(nb)
+       List.fold_left_i (fun i l (na,bk,_,_) -> add_impl i na bk l) i (aux (List.length args.(nb) + i) bds.(nb)) args.(nb)
       | _ -> []
   in aux 1 l
diff --git a/interp/implicit_quantifiers.mli b/interp/implicit_quantifiers.mli
index ab2ad566..818f7e9a 100644
--- a/interp/implicit_quantifiers.mli
+++ b/interp/implicit_quantifiers.mli
@@ -1,54 +1,47 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Loc
 open Names
-open Decl_kinds
-open Term
-open Sign
-open Evd
-open Environ
-open Nametab
-open Mod_subst
 open Glob_term
-open Topconstr
-open Util
+open Constrexpr
 open Libnames
-open Typeclasses
+open Globnames
 
-val declare_generalizable : Vernacexpr.locality_flag -> (identifier located) list option -> unit
+val declare_generalizable : Vernacexpr.locality_flag -> (Id.t located) list option -> unit
 
-val ids_of_list : identifier list -> Idset.t
-val destClassApp : constr_expr -> loc * reference * constr_expr list
-val destClassAppExpl : constr_expr -> loc * reference * (constr_expr * explicitation located option) list
+val ids_of_list : Id.t list -> Id.Set.t
+val destClassApp : constr_expr -> Loc.t * reference * constr_expr list
+val destClassAppExpl : constr_expr -> Loc.t * reference * (constr_expr * explicitation located option) list
 
 (** Fragile, should be used only for construction a set of identifiers to avoid *)
 
-val free_vars_of_constr_expr : constr_expr -> ?bound:Idset.t ->
-  identifier list -> identifier list
+val free_vars_of_constr_expr : constr_expr -> ?bound:Id.Set.t ->
+  Id.t list -> Id.t list
 
 val free_vars_of_binders :
-  ?bound:Idset.t -> Names.identifier list -> local_binder list -> Idset.t * Names.identifier list
+  ?bound:Id.Set.t -> Id.t list -> local_binder list -> Id.Set.t * Id.t list
 
 (** Returns the generalizable free ids in left-to-right
    order with the location of their first occurence *)
 
-val generalizable_vars_of_glob_constr : ?bound:Idset.t -> ?allowed:Idset.t ->
-  glob_constr -> (Names.identifier * loc) list
+val generalizable_vars_of_glob_constr : ?bound:Id.Set.t -> ?allowed:Id.Set.t ->
+  glob_constr -> (Id.t * Loc.t) list
 
-val make_fresh : Names.Idset.t -> Environ.env -> identifier -> identifier
+val make_fresh : Id.Set.t -> Environ.env -> Id.t -> Id.t
 
 val implicits_of_glob_constr : ?with_products:bool -> Glob_term.glob_constr -> Impargs.manual_implicits
 
 val combine_params_freevar :
-  Names.Idset.t -> (global_reference * bool) option * (Names.name * Term.constr option * Term.types) ->
-  Topconstr.constr_expr * Names.Idset.t
+  Id.Set.t -> (global_reference * bool) option * (Name.t * Term.constr option * Term.types) ->
+  Constrexpr.constr_expr * Id.Set.t
 
-val implicit_application : Idset.t -> ?allow_partial:bool ->
-  (Names.Idset.t -> (global_reference * bool) option * (Names.name * Term.constr option * Term.types) ->
-    Topconstr.constr_expr * Names.Idset.t) ->
-  constr_expr -> constr_expr * Idset.t
+val implicit_application : Id.Set.t -> ?allow_partial:bool ->
+  (Id.Set.t -> (global_reference * bool) option * (Name.t * Term.constr option * Term.types) ->
+    Constrexpr.constr_expr * Id.Set.t) ->
+  constr_expr -> constr_expr * Id.Set.t
diff --git a/interp/interp.mllib b/interp/interp.mllib
index 546f277e..c9a03152 100644
--- a/interp/interp.mllib
+++ b/interp/interp.mllib
@@ -1,10 +1,12 @@
-Tok
-Lexer
+Stdarg
+Constrarg
+Genintern
+Constrexpr_ops
+Notation_ops
 Topconstr
 Ppextend
 Notation
 Dumpglob
-Genarg
 Syntax_def
 Smartlocate
 Reserve
diff --git a/interp/modintern.ml b/interp/modintern.ml
index 2feac863..fdc6e609 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Pp
-open Util
-open Names
-open Entries
+open Declarations
 open Libnames
-open Topconstr
+open Constrexpr
 open Constrintern
+open Misctypes
 
 type module_internalization_error =
   | NotAModuleNorModtype of string
@@ -21,172 +19,72 @@ type module_internalization_error =
 
 exception ModuleInternalizationError of module_internalization_error
 
-(*
-val error_declaration_not_path : module_struct_entry -> 'a
-
-val error_not_a_functor :  module_struct_entry -> 'a
-
-val error_not_equal : module_path -> module_path -> 'a
-
-val error_result_must_be_signature : unit -> 'a
-
-oval error_not_a_modtype_loc : loc -> string -> 'a
-
-val error_not_a_module_loc : loc -> string -> 'a
-
-val error_not_a_module_or_modtype_loc : loc -> string -> 'a
-
-val error_with_in_module : unit -> 'a
-
-val error_application_to_module_type : unit -> 'a
-*)
-
-let error_result_must_be_signature () =
-  error "The result module type must be a signature."
-
-let error_not_a_modtype_loc loc s =
-  Compat.Loc.raise loc (Modops.ModuleTypingError (Modops.NotAModuleType s))
-
-let error_not_a_module_loc loc s =
-  Compat.Loc.raise loc (Modops.ModuleTypingError (Modops.NotAModule s))
+let error_not_a_module_loc kind loc qid =
+  let s = string_of_qualid qid in
+  let e = match kind with
+    | Module -> Modops.ModuleTypingError (Modops.NotAModule s)
+    | ModType -> Modops.ModuleTypingError (Modops.NotAModuleType s)
+    | ModAny -> ModuleInternalizationError (NotAModuleNorModtype s)
+  in
+  Loc.raise loc e
 
-let error_not_a_module_nor_modtype_loc loc s =
-  Compat.Loc.raise loc (ModuleInternalizationError (NotAModuleNorModtype s))
+let error_application_to_not_path loc me =
+  Loc.raise loc (Modops.ModuleTypingError (Modops.ApplicationToNotPath me))
 
 let error_incorrect_with_in_module loc =
-  Compat.Loc.raise loc (ModuleInternalizationError IncorrectWithInModule)
+  Loc.raise loc (ModuleInternalizationError IncorrectWithInModule)
 
 let error_application_to_module_type loc =
-  Compat.Loc.raise loc (ModuleInternalizationError IncorrectModuleApplication)
-
-
+  Loc.raise loc (ModuleInternalizationError IncorrectModuleApplication)
 
+(** Searching for a module name in the Nametab.
 
-let rec make_mp mp = function
-    [] -> mp
-  | h::tl -> make_mp (MPdot(mp, label_of_id h)) tl
+    According to the input module kind, modules or module types
+    or both are searched. The returned kind is never ModAny, and
+    it is equal to the input kind when this one isn't ModAny. *)
 
-(*
-(* Since module components are not put in the nametab we try to locate
-the module prefix *)
-exception BadRef
-
-let lookup_qualid (modtype:bool) qid =
-  let rec make_mp mp = function
-      [] -> mp
-    | h::tl -> make_mp (MPdot(mp, label_of_id h)) tl
-  in
-  let rec find_module_prefix dir n =
-    if n<0 then raise Not_found;
-    let dir',dir'' = list_chop n dir in
-    let id',dir''' =
-      match dir'' with
-	| hd::tl -> hd,tl
-	| _ -> anomaly "This list should not be empty!"
-    in
-    let qid' = make_qualid dir' id' in
-      try
-	match Nametab.locate qid' with
-	  | ModRef mp -> mp,dir'''
-	  | _ -> raise BadRef
-      with
-	  Not_found -> find_module_prefix dir (pred n)
-  in
-    try Nametab.locate qid
-    with Not_found ->
-      let (dir,id) = repr_qualid qid in
-      let pref_mp,dir' = find_module_prefix dir (List.length dir - 1) in
-      let mp =
-	List.fold_left (fun mp id -> MPdot (mp, label_of_id id)) pref_mp dir'
-      in
-	if modtype then
-	  ModTypeRef (make_ln mp (label_of_id id))
-	else
-	  ModRef (MPdot (mp,label_of_id id))
-
-*)
-
-
-(* Search for the head of [qid] in [binders].
-   If found, returns the module_path/kernel_name created from the dirpath
-   and the basename. Searches Nametab otherwise.
-*)
-let lookup_module (loc,qid) =
+let lookup_module_or_modtype kind (loc,qid) =
   try
+    if kind == ModType then raise Not_found;
     let mp = Nametab.locate_module qid in
-      Dumpglob.dump_modref loc mp "modtype"; mp
-  with
-    | Not_found -> error_not_a_module_loc loc (string_of_qualid qid)
-
-let lookup_modtype (loc,qid) =
-  try
-    let mp = Nametab.locate_modtype qid in
-      Dumpglob.dump_modref loc mp "mod"; mp
-  with
-    | Not_found ->
-	error_not_a_modtype_loc loc (string_of_qualid qid)
-
-let lookup_module_or_modtype (loc,qid) =
-  try
-    let mp = Nametab.locate_module qid in
-    Dumpglob.dump_modref loc mp "modtype"; (mp,true)
-  with Not_found -> try
-    let mp = Nametab.locate_modtype qid in
-    Dumpglob.dump_modref loc mp "mod"; (mp,false)
+    Dumpglob.dump_modref loc mp "modtype"; (mp,Module)
   with Not_found ->
-    error_not_a_module_nor_modtype_loc loc (string_of_qualid qid)
+    try
+      if kind == Module then raise Not_found;
+      let mp = Nametab.locate_modtype qid in
+      Dumpglob.dump_modref loc mp "mod"; (mp,ModType)
+    with Not_found -> error_not_a_module_loc kind loc qid
+
+let lookup_module lqid = fst (lookup_module_or_modtype Module lqid)
 
 let transl_with_decl env = function
   | CWith_Module ((_,fqid),qid) ->
-      With_Module (fqid,lookup_module qid)
+      WithMod (fqid,lookup_module qid)
   | CWith_Definition ((_,fqid),c) ->
-      With_Definition (fqid,interp_constr Evd.empty env c)
+      WithDef (fqid,fst (interp_constr env Evd.empty c)) (*FIXME*)
 
 let loc_of_module = function
   | CMident (loc,_) | CMapply (loc,_,_) | CMwith (loc,_,_) -> loc
 
-let check_module_argument_is_path me' = function
-  | CMident _ -> ()
-  | (CMapply (loc,_,_) | CMwith (loc,_,_)) ->
-      Compat.Loc.raise loc
-        (Modops.ModuleTypingError (Modops.ApplicationToNotPath me'))
+(* Invariant : the returned kind is never ModAny, and it is
+   equal to the input kind when this one isn't ModAny. *)
 
-let rec interp_modexpr env = function
+let rec interp_module_ast env kind = function
   | CMident qid ->
-      MSEident (lookup_module qid)
+      let (mp,kind) = lookup_module_or_modtype kind qid in
+      (MEident mp, kind)
   | CMapply (_,me1,me2) ->
-      let me1' = interp_modexpr env me1 in
-      let me2' = interp_modexpr env me2 in
-      check_module_argument_is_path me2' me2;
-      MSEapply(me1',me2')
-  | CMwith (loc,_,_) -> error_incorrect_with_in_module loc
-
-
-let rec interp_modtype env = function
-  | CMident qid ->
-      MSEident (lookup_modtype qid)
-  | CMapply (_,mty1,me) ->
-      let mty' = interp_modtype env mty1 in
-      let me' = interp_modexpr env me in
-      check_module_argument_is_path me' me;
-      MSEapply(mty',me')
-  | CMwith (_,mty,decl) ->
-      let mty = interp_modtype env mty in
-      let decl = transl_with_decl env decl in
-	MSEwith(mty,decl)
-
-let rec interp_modexpr_or_modtype env = function
-  | CMident qid ->
-      let (mp,ismod) = lookup_module_or_modtype qid in
-      (MSEident mp, ismod)
-  | CMapply (_,me1,me2) ->
-      let me1',ismod1 = interp_modexpr_or_modtype env me1 in
-      let me2',ismod2 = interp_modexpr_or_modtype env me2 in
-      check_module_argument_is_path me2' me2;
-      if not ismod2 then error_application_to_module_type (loc_of_module me2);
-      (MSEapply (me1',me2'), ismod1)
+      let me1',kind1 = interp_module_ast env kind me1 in
+      let me2',kind2 = interp_module_ast env ModAny me2 in
+      let mp2 = match me2' with
+        | MEident mp -> mp
+        | _ -> error_application_to_not_path (loc_of_module me2) me2'
+      in
+      if kind2 == ModType then
+        error_application_to_module_type (loc_of_module me2);
+      (MEapply (me1',mp2), kind1)
   | CMwith (loc,me,decl) ->
-      let me,ismod = interp_modexpr_or_modtype env me in
+      let me,kind = interp_module_ast env kind me in
+      if kind == Module then error_incorrect_with_in_module loc;
       let decl = transl_with_decl env decl in
-      if ismod then error_incorrect_with_in_module loc;
-      (MSEwith(me,decl), ismod)
+      (MEwith(me,decl), kind)
diff --git a/interp/modintern.mli b/interp/modintern.mli
index d832ffc6..8b6d002e 100644
--- a/interp/modintern.mli
+++ b/interp/modintern.mli
@@ -1,18 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Declarations
 open Environ
 open Entries
-open Util
-open Libnames
-open Names
-open Topconstr
+open Constrexpr
+open Misctypes
 
 (** Module internalization errors *)
 
@@ -24,17 +21,11 @@ type module_internalization_error =
 exception ModuleInternalizationError of module_internalization_error
 
 (** Module expressions and module types are interpreted relatively to
-   possible functor or functor signature arguments. *)
-
-val interp_modtype : env -> module_ast -> module_struct_entry
-
-val interp_modexpr : env -> module_ast -> module_struct_entry
-
-(** The following function tries to interprete an ast as a module,
-   and in case of failure, interpretes this ast as a module type.
-   The boolean is true for a module, false for a module type *)
-
-val interp_modexpr_or_modtype : env -> module_ast ->
- module_struct_entry * bool
-
-val lookup_module : qualid located -> module_path
+   possible functor or functor signature arguments. When the input kind
+   is ModAny (i.e. module or module type), we tries to interprete this ast
+   as a module, and in case of failure, as a module type. The returned
+   kind is never ModAny, and it is equal to the input kind when this one
+   isn't ModAny. *)
+
+val interp_module_ast :
+  env -> module_kind -> module_ast -> module_struct_entry * module_kind
diff --git a/interp/notation.ml b/interp/notation.ml
index dddc8aad..aeec4b61 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -1,12 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
 (*i*)
+open Errors
 open Util
 open Pp
 open Bigint
@@ -14,9 +15,11 @@ open Names
 open Term
 open Nametab
 open Libnames
-open Summary
+open Globnames
+open Constrexpr
+open Notation_term
 open Glob_term
-open Topconstr
+open Glob_ops
 open Ppextend
 (*i*)
 
@@ -40,24 +43,24 @@ open Ppextend
 
 type level = precedence * tolerability list
 type delimiters = string
-type notation_location = (dir_path * dir_path) * string
+type notation_location = (DirPath.t * DirPath.t) * string
 
 type scope = {
-  notations: (string, interpretation * notation_location) Gmap.t;
+  notations: (interpretation * notation_location) String.Map.t;
   delimiters: delimiters option
 }
 
-(* Uninterpreted notation map: notation -> level * dir_path *)
-let notation_level_map = ref Gmap.empty
+(* Uninterpreted notation map: notation -> level * DirPath.t *)
+let notation_level_map = ref String.Map.empty
 
 (* Scopes table: scope_name -> symbol_interpretation *)
-let scope_map = ref Gmap.empty
+let scope_map = ref String.Map.empty
 
 (* Delimiter table : delimiter -> scope_name *)
-let delimiters_map = ref Gmap.empty
+let delimiters_map = ref String.Map.empty
 
 let empty_scope = {
-  notations = Gmap.empty;
+  notations = String.Map.empty;
   delimiters = None
 }
 
@@ -65,22 +68,33 @@ let default_scope = "" (* empty name, not available from outside *)
 let type_scope = "type_scope" (* special scope used for interpreting types *)
 
 let init_scope_map () =
-  scope_map := Gmap.add default_scope empty_scope !scope_map;
-  scope_map := Gmap.add type_scope empty_scope !scope_map
+  scope_map := String.Map.add default_scope empty_scope !scope_map;
+  scope_map := String.Map.add type_scope empty_scope !scope_map
 
 (**********************************************************************)
 (* Operations on scopes *)
 
+let parenRelation_eq t1 t2 = match t1, t2 with
+| L, L | E, E | Any, Any -> true
+| Prec l1, Prec l2 -> Int.equal l1 l2
+| _ -> false
+
+let level_eq (l1, t1) (l2, t2) =
+  let tolerability_eq (i1, r1) (i2, r2) =
+    Int.equal i1 i2 && parenRelation_eq r1 r2
+  in
+  Int.equal l1 l2 && List.equal tolerability_eq t1 t2
+
 let declare_scope scope =
-  try let _ = Gmap.find scope !scope_map in ()
+  try let _ = String.Map.find scope !scope_map in ()
   with Not_found ->
 (*    Flags.if_warn message ("Creating scope "^scope);*)
-    scope_map := Gmap.add scope empty_scope !scope_map
+    scope_map := String.Map.add scope empty_scope !scope_map
 
 let error_unknown_scope sc = error ("Scope "^sc^" is not declared.")
 
 let find_scope scope =
-  try Gmap.find scope !scope_map
+  try String.Map.find scope !scope_map
   with Not_found -> error_unknown_scope scope
 
 let check_scope sc = let _ = find_scope sc in ()
@@ -89,11 +103,11 @@ let check_scope sc = let _ = find_scope sc in ()
    (now allowed after Open Scope) *)
 
 let normalize_scope sc =
-  try let _ = Gmap.find sc !scope_map in sc
+  try let _ = String.Map.find sc !scope_map in sc
   with Not_found ->
     try
-      let sc = Gmap.find sc !delimiters_map in
-      let _ = Gmap.find sc !scope_map in sc
+      let sc = String.Map.find sc !delimiters_map in
+      let _ = String.Map.find sc !scope_map in sc
     with Not_found -> error_unknown_scope sc
 
 (**********************************************************************)
@@ -102,12 +116,18 @@ let normalize_scope sc =
 type scope_elem = Scope of scope_name | SingleNotation of string
 type scopes = scope_elem list
 
+let scope_eq s1 s2 = match s1, s2 with
+| Scope s1, Scope s2
+| SingleNotation s1, SingleNotation s2 -> String.equal s1 s2
+| Scope _, SingleNotation _
+| SingleNotation _, Scope _ -> false
+
 let scope_stack = ref []
 
 let current_scopes () = !scope_stack
 
 let scope_is_open_in_scopes sc l =
-  List.mem (Scope sc) l
+  List.exists (function Scope sc' -> String.equal sc sc' | _ -> false) l
 
 let scope_is_open sc = scope_is_open_in_scopes sc (!scope_stack)
 
@@ -115,13 +135,14 @@ let scope_is_open sc = scope_is_open_in_scopes sc (!scope_stack)
 
 (* Exportation of scopes *)
 let open_scope i (_,(local,op,sc)) =
-  if i=1 then
+  if Int.equal i 1 then
     let sc = match sc with
       | Scope sc -> Scope (normalize_scope sc)
       | _ -> sc
     in
     scope_stack :=
-      if op then sc :: !scope_stack else list_except sc !scope_stack
+      if op then sc :: !scope_stack
+      else List.except scope_eq sc !scope_stack
 
 let cache_scope o =
   open_scope 1 o
@@ -165,24 +186,24 @@ let declare_delimiters scope key =
   let sc = find_scope scope in
   let newsc = { sc with delimiters = Some key } in
   begin match sc.delimiters with
-    | None -> scope_map := Gmap.add scope newsc !scope_map
-    | Some oldkey when oldkey = key -> ()
+    | None -> scope_map := String.Map.add scope newsc !scope_map
+    | Some oldkey when String.equal oldkey key -> ()
     | Some oldkey ->
-	Flags.if_warn msg_warning
-	  (str ("Overwriting previous delimiting key "^oldkey^" in scope "^scope));
-	scope_map := Gmap.add scope newsc !scope_map
+	msg_warning
+	  (strbrk ("Overwriting previous delimiting key "^oldkey^" in scope "^scope));
+	scope_map := String.Map.add scope newsc !scope_map
   end;
   try
-    let oldscope = Gmap.find key !delimiters_map in
-    if oldscope = scope then ()
+    let oldscope = String.Map.find key !delimiters_map in
+    if String.equal oldscope scope then ()
     else begin
-      Flags.if_warn msg_warning (str ("Hiding binding of key "^key^" to "^oldscope));
-      delimiters_map := Gmap.add key scope !delimiters_map
+      msg_warning (strbrk ("Hiding binding of key "^key^" to "^oldscope));
+      delimiters_map := String.Map.add key scope !delimiters_map
     end
-  with Not_found -> delimiters_map := Gmap.add key scope !delimiters_map
+  with Not_found -> delimiters_map := String.Map.add key scope !delimiters_map
 
 let find_delimiters_scope loc key =
-  try Gmap.find key !delimiters_map
+  try String.Map.find key !delimiters_map
   with Not_found ->
     user_err_loc
     (loc, "find_delimiters", str ("Unknown scope delimiting key "^key^"."))
@@ -200,29 +221,50 @@ type key =
   | RefKey of global_reference
   | Oth
 
+let key_compare k1 k2 = match k1, k2 with
+| RefKey gr1, RefKey gr2 -> RefOrdered.compare gr1 gr2
+| RefKey _, Oth -> -1
+| Oth, RefKey _ -> 1
+| Oth, Oth -> 0
+
+module KeyOrd = struct type t = key let compare = key_compare end
+module KeyMap = Map.Make(KeyOrd)
+
+type notation_rule = interp_rule * interpretation * int option
+
+let keymap_add key interp map =
+  let old = try KeyMap.find key map with Not_found -> [] in
+  KeyMap.add key (interp :: old) map
+
+let keymap_find key map =
+  try KeyMap.find key map
+  with Not_found -> []
+
 (* Scopes table : interpretation -> scope_name *)
-let notations_key_table = ref Gmapl.empty
-let prim_token_key_table = Hashtbl.create 7
+let notations_key_table = ref (KeyMap.empty : notation_rule list KeyMap.t)
+
+let prim_token_key_table = ref KeyMap.empty
 
 let glob_prim_constr_key = function
-  | GApp (_,GRef (_,ref),_) | GRef (_,ref) -> RefKey (canonical_gr ref)
+  | GApp (_,GRef (_,ref,_),_) | GRef (_,ref,_) -> RefKey (canonical_gr ref)
   | _ -> Oth
 
 let glob_constr_keys = function
-  | GApp (_,GRef (_,ref),_) -> [RefKey (canonical_gr ref); Oth]
-  | GRef (_,ref) -> [RefKey (canonical_gr ref)]
+  | GApp (_,GRef (_,ref,_),_) -> [RefKey (canonical_gr ref); Oth]
+  | GRef (_,ref,_) -> [RefKey (canonical_gr ref)]
   | _ -> [Oth]
 
 let cases_pattern_key = function
   | PatCstr (_,ref,_,_) -> RefKey (canonical_gr (ConstructRef ref))
   | _ -> Oth
 
-let aconstr_key = function (* Rem: AApp(ARef ref,[]) stands for @ref *)
-  | AApp (ARef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
-  | AList (_,_,AApp (ARef ref,args),_,_)
-  | ABinderList (_,_,AApp (ARef ref,args),_) -> RefKey (canonical_gr ref), Some (List.length args)
-  | ARef ref -> RefKey(canonical_gr ref), None
-  | AApp (_,args) -> Oth, Some (List.length args)
+let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *)
+  | NApp (NRef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
+  | NList (_,_,NApp (NRef ref,args),_,_)
+  | NBinderList (_,_,NApp (NRef ref,args),_) ->
+      RefKey (canonical_gr ref), Some (List.length args)
+  | NRef ref -> RefKey(canonical_gr ref), None
+  | NApp (_,args) -> Oth, Some (List.length args)
   | _ -> Oth, None
 
 (**********************************************************************)
@@ -231,7 +273,7 @@ let aconstr_key = function (* Rem: AApp(ARef ref,[]) stands for @ref *)
 type required_module = full_path * string list
 
 type 'a prim_token_interpreter =
-    loc -> 'a -> glob_constr
+    Loc.t -> 'a -> glob_constr
 
 type cases_pattern_status = bool (* true = use prim token in patterns *)
 
@@ -239,7 +281,7 @@ type 'a prim_token_uninterpreter =
     glob_constr list * (glob_constr -> 'a option) * cases_pattern_status
 
 type internal_prim_token_interpreter =
-    loc -> prim_token -> required_module * (unit -> glob_constr)
+    Loc.t -> prim_token -> required_module * (unit -> glob_constr)
 
 let prim_token_interpreter_tab =
   (Hashtbl.create 7 : (scope_name, internal_prim_token_interpreter) Hashtbl.t)
@@ -256,8 +298,8 @@ let declare_prim_token_interpreter sc interp (patl,uninterp,b) =
   declare_scope sc;
   add_prim_token_interpreter sc interp;
   List.iter (fun pat ->
-      Hashtbl.add prim_token_key_table
-        (glob_prim_constr_key pat) (sc,uninterp,b))
+      prim_token_key_table := KeyMap.add
+        (glob_prim_constr_key pat) (sc,uninterp,b) !prim_token_key_table)
     patl
 
 let mkNumeral n = Numeral n
@@ -280,7 +322,7 @@ let check_required_module loc sc (sp,d) =
   with Not_found ->
     user_err_loc (loc,"prim_token_interpreter",
     str ("Cannot interpret in "^sc^" without requiring first module "
-    ^(list_last d)^"."))
+    ^(List.last d)^"."))
 
 (* Look if some notation or numeral printer in [scope] can be used in
    the scope stack [scopes], and if yes, using delimiters or not *)
@@ -288,27 +330,31 @@ let check_required_module loc sc (sp,d) =
 let find_with_delimiters = function
   | None -> None
   | Some scope ->
-      match (Gmap.find scope !scope_map).delimiters with
+      match (String.Map.find scope !scope_map).delimiters with
 	| Some key -> Some (Some scope, Some key)
 	| None -> None
 
 let rec find_without_delimiters find (ntn_scope,ntn) = function
   | Scope scope :: scopes ->
       (* Is the expected ntn/numpr attached to the most recently open scope? *)
-      if Some scope = ntn_scope then
+      begin match ntn_scope with
+      | Some scope' when String.equal scope scope' ->
 	Some (None,None)
-      else
+      | _ ->
 	(* If the most recently open scope has a notation/numeral printer
     	   but not the expected one then we need delimiters *)
 	if find scope then
 	  find_with_delimiters ntn_scope
 	else
 	  find_without_delimiters find (ntn_scope,ntn) scopes
+      end
   | SingleNotation ntn' :: scopes ->
-      if ntn_scope = None & ntn = Some ntn' then
-	Some (None,None)
-      else
+      begin match ntn_scope, ntn with
+      | None, Some ntn when String.equal ntn ntn' ->
+	Some (None, None)
+      | _ ->
 	find_without_delimiters find (ntn_scope,ntn) scopes
+      end
   | [] ->
       (* Can we switch to [scope]? Yes if it has defined delimiters *)
       find_with_delimiters ntn_scope
@@ -316,35 +362,43 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function
 (* Uninterpreted notation levels *)
 
 let declare_notation_level ntn level =
-  if Gmap.mem ntn !notation_level_map then
-    anomaly ("Notation "^ntn^" is already assigned a level");
-  notation_level_map := Gmap.add ntn level !notation_level_map
+  if String.Map.mem ntn !notation_level_map then
+    anomaly (str "Notation " ++ str ntn ++ str " is already assigned a level");
+  notation_level_map := String.Map.add ntn level !notation_level_map
 
 let level_of_notation ntn =
-  Gmap.find ntn !notation_level_map
+  String.Map.find ntn !notation_level_map
 
 (* The mapping between notations and their interpretation *)
 
 let declare_notation_interpretation ntn scopt pat df =
   let scope = match scopt with Some s -> s | None -> default_scope in
   let sc = find_scope scope in
-  if Gmap.mem ntn sc.notations then
-    Flags.if_warn msg_warning (str ("Notation "^ntn^" was already used"^
-    (if scopt = None then "" else " in scope "^scope)));
-  let sc = { sc with notations = Gmap.add ntn (pat,df) sc.notations } in
-  scope_map := Gmap.add scope sc !scope_map;
-  if scopt = None then scope_stack := SingleNotation ntn :: !scope_stack
+  let () =
+    if String.Map.mem ntn sc.notations then
+    let which_scope = match scopt with
+    | None -> ""
+    | Some _ -> " in scope " ^ scope in
+    let message = "Notation " ^ ntn ^ " was already used" ^ which_scope in
+    msg_warning (strbrk message)
+  in
+  let sc = { sc with notations = String.Map.add ntn (pat,df) sc.notations } in
+  let () = scope_map := String.Map.add scope sc !scope_map in
+  begin match scopt with
+  | None -> scope_stack := SingleNotation ntn :: !scope_stack
+  | Some _ -> ()
+  end
 
 let declare_uninterpretation rule (metas,c as pat) =
-  let (key,n) = aconstr_key c in
-  notations_key_table := Gmapl.add key (rule,pat,n) !notations_key_table
+  let (key,n) = notation_constr_key c in
+  notations_key_table := keymap_add key (rule,pat,n) !notations_key_table
 
 let rec find_interpretation ntn find = function
   | [] -> raise Not_found
   | Scope scope :: scopes ->
       (try let (pat,df) = find scope in pat,(df,Some scope)
        with Not_found -> find_interpretation ntn find scopes)
-  | SingleNotation ntn'::scopes when ntn' = ntn ->
+  | SingleNotation ntn'::scopes when String.equal ntn' ntn ->
       (try let (pat,df) = find default_scope in pat,(df,None)
        with Not_found ->
          (* e.g. because single notation only for constr, not cases_pattern *)
@@ -353,7 +407,7 @@ let rec find_interpretation ntn find = function
       find_interpretation ntn find scopes
 
 let find_notation ntn sc =
-  Gmap.find ntn (find_scope sc).notations
+  String.Map.find ntn (find_scope sc).notations
 
 let notation_of_prim_token = function
   | Numeral n when is_pos_or_zero n -> to_string n
@@ -364,12 +418,12 @@ let find_prim_token g loc p sc =
   (* Try for a user-defined numerical notation *)
   try
     let (_,c),df = find_notation (notation_of_prim_token p) sc in
-    g (glob_constr_of_aconstr loc c),df
+    g (Notation_ops.glob_constr_of_notation_constr loc c),df
   with Not_found ->
   (* Try for a primitive numerical notation *)
   let (spdir,interp) = Hashtbl.find prim_token_interpreter_tab sc loc p in
   check_required_module loc sc spdir;
-  g (interp ()), ((dirpath (fst spdir),empty_dirpath),"")
+  g (interp ()), ((dirpath (fst spdir),DirPath.empty),"")
 
 let interp_prim_token_gen g loc p local_scopes =
   let scopes = make_current_scopes local_scopes in
@@ -384,90 +438,129 @@ let interp_prim_token_gen g loc p local_scopes =
 let interp_prim_token =
   interp_prim_token_gen (fun x -> x)
 
-let interp_prim_token_cases_pattern loc p name =
-  interp_prim_token_gen (cases_pattern_of_glob_constr name) loc p
+(** [rcp_of_glob] : from [glob_constr] to [raw_cases_pattern_expr] *)
 
-let rec interp_notation loc ntn local_scopes =
+let rec rcp_of_glob looked_for = function
+  | GVar (loc,id) -> RCPatAtom (loc,Some id)
+  | GHole (loc,_,_,_) -> RCPatAtom (loc,None)
+  | GRef (loc,g,_) -> looked_for g; RCPatCstr (loc, g,[],[])
+  | GApp (loc,GRef (_,g,_),l) ->
+    looked_for g; RCPatCstr (loc, g, List.map (rcp_of_glob looked_for) l,[])
+  | _ -> raise Not_found
+
+let interp_prim_token_cases_pattern_expr loc looked_for p =
+  interp_prim_token_gen (rcp_of_glob looked_for) loc p
+
+let interp_notation loc ntn local_scopes =
   let scopes = make_current_scopes local_scopes in
   try find_interpretation ntn (find_notation ntn) scopes
   with Not_found ->
     user_err_loc
     (loc,"",str ("Unknown interpretation for notation \""^ntn^"\"."))
 
-let isGApp = function GApp _ -> true | _ -> false
-
 let uninterp_notations c =
-  list_map_append (fun key -> Gmapl.find key !notations_key_table)
+  List.map_append (fun key -> keymap_find key !notations_key_table)
     (glob_constr_keys c)
 
 let uninterp_cases_pattern_notations c =
-  Gmapl.find (cases_pattern_key c) !notations_key_table
+  keymap_find (cases_pattern_key c) !notations_key_table
+
+let uninterp_ind_pattern_notations ind =
+  keymap_find (RefKey (canonical_gr (IndRef ind))) !notations_key_table
 
 let availability_of_notation (ntn_scope,ntn) scopes =
   let f scope =
-    Gmap.mem ntn (Gmap.find scope !scope_map).notations in
+    String.Map.mem ntn (String.Map.find scope !scope_map).notations in
   find_without_delimiters f (ntn_scope,Some ntn) (make_current_scopes scopes)
 
 let uninterp_prim_token c =
   try
     let (sc,numpr,_) =
-      Hashtbl.find prim_token_key_table (glob_prim_constr_key c) in
+      KeyMap.find (glob_prim_constr_key c) !prim_token_key_table in
     match numpr c with
-      | None -> raise No_match
+      | None -> raise Notation_ops.No_match
+      | Some n -> (sc,n)
+  with Not_found -> raise Notation_ops.No_match
+
+let uninterp_prim_token_ind_pattern ind args =
+  let ref = IndRef ind in
+  try
+    let k = RefKey (canonical_gr ref) in
+    let (sc,numpr,b) = KeyMap.find k !prim_token_key_table in
+    if not b then raise Notation_ops.No_match;
+    let args' = List.map
+      (fun x -> snd (glob_constr_of_closed_cases_pattern x)) args in
+    let ref = GRef (Loc.ghost,ref,None) in
+    match numpr (GApp (Loc.ghost,ref,args')) with
+      | None -> raise Notation_ops.No_match
       | Some n -> (sc,n)
-  with Not_found -> raise No_match
+  with Not_found -> raise Notation_ops.No_match
 
 let uninterp_prim_token_cases_pattern c =
   try
     let k = cases_pattern_key c in
-    let (sc,numpr,b) = Hashtbl.find prim_token_key_table k in
-    if not b then raise No_match;
+    let (sc,numpr,b) = KeyMap.find k !prim_token_key_table in
+    if not b then raise Notation_ops.No_match;
     let na,c = glob_constr_of_closed_cases_pattern c in
     match numpr c with
-      | None -> raise No_match
+      | None -> raise Notation_ops.No_match
       | Some n -> (na,sc,n)
-  with Not_found -> raise No_match
+  with Not_found -> raise Notation_ops.No_match
 
 let availability_of_prim_token n printer_scope local_scopes =
   let f scope =
-    try ignore (Hashtbl.find prim_token_interpreter_tab scope dummy_loc n); true
+    try ignore (Hashtbl.find prim_token_interpreter_tab scope Loc.ghost n); true
     with Not_found -> false in
   let scopes = make_current_scopes local_scopes in
   Option.map snd (find_without_delimiters f (Some printer_scope,None) scopes)
 
 (* Miscellaneous *)
 
-let exists_notation_in_scope scopt ntn r =
-  let scope = match scopt with Some s -> s | None -> default_scope in
-  try
-    let sc = Gmap.find scope !scope_map in
-    let (r',_) = Gmap.find ntn sc.notations in
-    r' = r
-  with Not_found -> false
-
-let isAVar_or_AHole = function AVar _ | AHole _ -> true | _ -> false
+let isNVar_or_NHole = function NVar _ | NHole _ -> true | _ -> false
 
 (**********************************************************************)
 (* Mapping classes to scopes *)
 
-open Classops
+type scope_class = ScopeRef of global_reference | ScopeSort
 
-let class_scope_map = ref (Gmap.empty : (cl_typ,scope_name) Gmap.t)
+let scope_class_compare sc1 sc2 = match sc1, sc2 with
+| ScopeRef gr1, ScopeRef gr2 -> RefOrdered.compare gr1 gr2
+| ScopeRef _, ScopeSort -> -1
+| ScopeSort, ScopeRef _ -> 1
+| ScopeSort, ScopeSort -> 0
 
-let _ =
-  class_scope_map := Gmap.add CL_SORT "type_scope" Gmap.empty
+let scope_class_of_reference x = ScopeRef x
 
-let declare_class_scope sc cl =
-  class_scope_map := Gmap.add cl sc !class_scope_map
+let compute_scope_class t =
+  let t', _ = decompose_appvect (Reductionops.whd_betaiotazeta Evd.empty t) in
+  match kind_of_term t' with
+  | Var _ | Const _ | Ind _ -> ScopeRef (global_of_constr t')
+  | Proj (p, c) -> ScopeRef (ConstRef (Projection.constant p))
+  | Sort _ -> ScopeSort
+  |  _ -> raise Not_found
 
-let find_class_scope cl =
-  Gmap.find cl !class_scope_map
+module ScopeClassOrd =
+struct
+  type t = scope_class
+  let compare = scope_class_compare
+end
 
-let find_class_scope_opt = function
-  | None -> None
-  | Some cl -> try Some (find_class_scope cl) with Not_found -> None
+module ScopeClassMap = Map.Make(ScopeClassOrd)
 
-let find_class t = fst (find_class_type Evd.empty t)
+let initial_scope_class_map : scope_name ScopeClassMap.t =
+  ScopeClassMap.add ScopeSort "type_scope" ScopeClassMap.empty
+
+let scope_class_map = ref initial_scope_class_map
+
+let declare_scope_class sc cl =
+  scope_class_map := ScopeClassMap.add cl sc !scope_class_map
+
+let find_scope_class cl =
+  ScopeClassMap.find cl !scope_class_map
+
+let find_scope_class_opt = function
+  | None -> None
+  | Some cl -> try Some (find_scope_class cl) with Not_found -> None
 
 (**********************************************************************)
 (* Special scopes associated to arguments of a global reference *)
@@ -475,26 +568,37 @@ let find_class t = fst (find_class_type Evd.empty t)
 let rec compute_arguments_classes t =
   match kind_of_term (Reductionops.whd_betaiotazeta Evd.empty t) with
     | Prod (_,t,u) ->
-	let cl = try Some (find_class t) with Not_found -> None in
+	let cl = try Some (compute_scope_class t) with Not_found -> None in
 	cl :: compute_arguments_classes u
     | _ -> []
 
 let compute_arguments_scope_full t =
   let cls = compute_arguments_classes t in
-  let scs = List.map find_class_scope_opt cls in
+  let scs = List.map find_scope_class_opt cls in
   scs, cls
 
 let compute_arguments_scope t = fst (compute_arguments_scope_full t)
 
-(** When merging scope list, we give priority to the first one (computed
-    by substitution), using the second one (user given or earlier automatic)
-    as fallback *)
+let compute_type_scope t =
+  find_scope_class_opt (try Some (compute_scope_class t) with Not_found -> None)
+
+let compute_scope_of_global ref =
+  find_scope_class_opt (Some (ScopeRef ref))
+
+(** Updating a scope list, thanks to a list of argument classes
+    and the current Bind Scope base. When some current scope
+    have been manually given, the corresponding argument class
+    is emptied below, so this manual scope will be preserved. *)
 
-let rec merge_scope sc1 sc2 = match sc1, sc2 with
-  | [], _ -> sc2
-  | _, [] -> sc1
-  | Some sc :: sc1, _ :: sc2 -> Some sc :: merge_scope sc1 sc2
-  | None :: sc1, sco :: sc2 -> sco :: merge_scope sc1 sc2
+let update_scope cl sco =
+  match find_scope_class_opt cl with
+  | None -> sco
+  | sco' -> sco'
+
+let rec update_scopes cls scl = match cls, scl with
+  | [], _ -> scl
+  | _, [] -> List.map find_scope_class_opt cls
+  | cl :: cls, sco :: scl -> update_scope cl sco :: update_scopes cls scl
 
 let arguments_scope = ref Refmap.empty
 
@@ -505,43 +609,56 @@ type arguments_scope_discharge_request =
 
 let load_arguments_scope _ (_,(_,r,scl,cls)) =
   List.iter (Option.iter check_scope) scl;
-  arguments_scope := Refmap.add r (scl,cls) !arguments_scope
+  let initial_stamp = ScopeClassMap.empty in
+  arguments_scope := Refmap.add r (scl,cls,initial_stamp) !arguments_scope
 
 let cache_arguments_scope o =
   load_arguments_scope 1 o
 
+let subst_scope_class subst cs = match cs with
+  | ScopeSort -> Some cs
+  | ScopeRef t ->
+      let (t',c) = subst_global subst t in
+      if t == t' then Some cs
+      else try Some (compute_scope_class c) with Not_found -> None
+
 let subst_arguments_scope (subst,(req,r,scl,cls)) =
   let r' = fst (subst_global subst r) in
-  let subst_cl cl =
-    try Option.smartmap (subst_cl_typ subst) cl with Not_found -> None in
-  let cls' = list_smartmap subst_cl cls in
-  let scl' = merge_scope (List.map find_class_scope_opt cls') scl in
-  let scl'' = List.map (Option.map Declaremods.subst_scope) scl' in
-  (ArgsScopeNoDischarge,r',scl'',cls')
+  let subst_cl ocl = match ocl with
+    | None -> ocl
+    | Some cl ->
+        match subst_scope_class subst cl with
+        | Some cl'  as ocl' when cl' != cl -> ocl'
+        | _ -> ocl in
+  let cls' = List.smartmap subst_cl cls in
+  (ArgsScopeNoDischarge,r',scl,cls')
 
 let discharge_arguments_scope (_,(req,r,l,_)) =
-  if req = ArgsScopeNoDischarge or (isVarRef r & Lib.is_in_section r) then None
+  if req == ArgsScopeNoDischarge || (isVarRef r && Lib.is_in_section r) then None
   else Some (req,Lib.discharge_global r,l,[])
 
 let classify_arguments_scope (req,_,_,_ as obj) =
-  if req = ArgsScopeNoDischarge then Dispose else Substitute obj
+  if req == ArgsScopeNoDischarge then Dispose else Substitute obj
 
 let rebuild_arguments_scope (req,r,l,_) =
   match req with
     | ArgsScopeNoDischarge -> assert false
     | ArgsScopeAuto ->
-        let scs,cls = compute_arguments_scope_full (Global.type_of_global r) in
+        let scs,cls = compute_arguments_scope_full (fst(Universes.type_of_global r)(*FIXME?*)) in
 	(req,r,scs,cls)
     | ArgsScopeManual ->
 	(* Add to the manually given scopes the one found automatically
-           for the extra parameters of the section *)
-	let l',cls = compute_arguments_scope_full (Global.type_of_global r) in
-	let l1,_ = list_chop (List.length l' - List.length l) l' in
-	(req,r,l1@l,cls)
+           for the extra parameters of the section. Discard the classes
+           of the manually given scopes to avoid further re-computations. *)
+	let l',cls = compute_arguments_scope_full (Global.type_of_global_unsafe r) in
+        let nparams = List.length l' - List.length l in
+	let l1 = List.firstn nparams l' in
+        let cls1 = List.firstn nparams cls in
+	(req,r,l1@l,cls1)
 
 type arguments_scope_obj =
     arguments_scope_discharge_request * global_reference *
-      scope_name option list * Classops.cl_typ option list
+      scope_name option list * scope_class option list
 
 let inArgumentsScope : arguments_scope_obj -> obj =
   declare_object {(default_object "ARGUMENTS-SCOPE") with
@@ -557,17 +674,27 @@ let is_local local ref = local || isVarRef ref && Lib.is_in_section ref
 let declare_arguments_scope_gen req r (scl,cls) =
   Lib.add_anonymous_leaf (inArgumentsScope (req,r,scl,cls))
 
-let declare_arguments_scope local ref scl =
-  let req =
-    if is_local local ref then ArgsScopeNoDischarge else ArgsScopeManual in
-  declare_arguments_scope_gen req ref (scl,[])
+let declare_arguments_scope local r scl =
+  let req = if is_local local r then ArgsScopeNoDischarge else ArgsScopeManual
+  in
+  (* We empty the list of argument classes to disable futher scope
+     re-computations and keep these manually given scopes. *)
+  declare_arguments_scope_gen req r (scl,[])
 
 let find_arguments_scope r =
-  try fst (Refmap.find r !arguments_scope)
+  try
+    let (scl,cls,stamp) = Refmap.find r !arguments_scope in
+    let cur_stamp = !scope_class_map in
+    if stamp == cur_stamp then scl
+    else
+      (* Recent changes in the Bind Scope base, we re-compute the scopes *)
+      let scl' = update_scopes cls scl in
+      arguments_scope := Refmap.add r (scl',cls,cur_stamp) !arguments_scope;
+      scl'
   with Not_found -> []
 
 let declare_ref_arguments_scope ref =
-  let t = Global.type_of_global ref in
+  let t = Global.type_of_global_unsafe ref in
   declare_arguments_scope_gen ArgsScopeAuto ref (compute_arguments_scope_full t)
 
 
@@ -576,10 +703,18 @@ let declare_ref_arguments_scope ref =
 
 type symbol =
   | Terminal of string
-  | NonTerminal of identifier
-  | SProdList of identifier * symbol list
+  | NonTerminal of Id.t
+  | SProdList of Id.t * symbol list
   | Break of int
 
+let rec symbol_eq s1 s2 = match s1, s2 with
+| Terminal s1, Terminal s2 -> String.equal s1 s2
+| NonTerminal id1, NonTerminal id2 -> Id.equal id1 id2
+| SProdList (id1, l1), SProdList (id2, l2) ->
+  Id.equal id1 id2 && List.equal symbol_eq l1 l2
+| Break i1, Break i2 -> Int.equal i1 i2
+| _ -> false
+
 let rec string_of_symbol = function
   | NonTerminal _ -> ["_"]
   | Terminal "_" -> ["'_'"]
@@ -602,8 +737,8 @@ let decompose_notation_key s =
     in
     let tok =
       match String.sub s n (pos-n) with
-      | "_" -> NonTerminal (id_of_string "_")
-      | s -> Terminal (drop_simple_quotes s) in
+      | "_" -> NonTerminal (Id.of_string "_")
+      | s -> Terminal (String.drop_simple_quotes s) in
     decomp_ntn (tok::dirs) (pos+1)
   in
     decomp_ntn [] 0
@@ -616,29 +751,35 @@ let pr_delimiters_info = function
   | Some key -> str "Delimiting key is " ++ str key
 
 let classes_of_scope sc =
-  Gmap.fold (fun cl sc' l -> if sc = sc' then cl::l else l) !class_scope_map []
+  ScopeClassMap.fold (fun cl sc' l -> if String.equal sc sc' then cl::l else l) !scope_class_map []
+
+let pr_scope_class = function
+  | ScopeSort -> str "Sort"
+  | ScopeRef t -> pr_global_env Id.Set.empty t
 
 let pr_scope_classes sc =
   let l = classes_of_scope sc in
-  if l = [] then mt()
-  else
-    hov 0 (str ("Bound to class"^(if List.tl l=[] then "" else "es")) ++
-      spc() ++ prlist_with_sep spc pr_class l) ++ fnl()
+  match l with
+  | [] -> mt ()
+  | _ :: l ->
+    let opt_s = match l with [] -> "" | _ -> "es" in
+    hov 0 (str ("Bound to class" ^ opt_s) ++
+      spc() ++ prlist_with_sep spc pr_scope_class l) ++ fnl()
 
 let pr_notation_info prglob ntn c =
   str "\"" ++ str ntn ++ str "\" := " ++
-  prglob (glob_constr_of_aconstr dummy_loc c)
+  prglob (Notation_ops.glob_constr_of_notation_constr Loc.ghost c)
 
 let pr_named_scope prglob scope sc =
- (if scope = default_scope then
-   match Gmap.fold (fun _ _ x -> x+1) sc.notations 0 with
+ (if String.equal scope default_scope then
+   match String.Map.cardinal sc.notations with
      | 0 -> str "No lonely notation"
-     | n -> str "Lonely notation" ++ (if n=1 then mt() else str"s")
+     | n -> str "Lonely notation" ++ (if Int.equal n 1 then mt() else str"s")
   else
     str "Scope " ++ str scope ++ fnl () ++ pr_delimiters_info sc.delimiters)
   ++ fnl ()
   ++ pr_scope_classes scope
-  ++ Gmap.fold
+  ++ String.Map.fold
        (fun ntn ((_,r),(_,df)) strm ->
 	 pr_notation_info prglob df r ++ fnl () ++ strm)
        sc.notations (mt ())
@@ -646,16 +787,19 @@ let pr_named_scope prglob scope sc =
 let pr_scope prglob scope = pr_named_scope prglob scope (find_scope scope)
 
 let pr_scopes prglob =
- Gmap.fold
+ String.Map.fold
    (fun scope sc strm -> pr_named_scope prglob scope sc ++ fnl () ++ strm)
    !scope_map (mt ())
 
 let rec find_default ntn = function
-  | Scope scope::_ when Gmap.mem ntn (find_scope scope).notations ->
-      Some scope
-  | SingleNotation ntn'::_ when ntn = ntn' -> Some default_scope
-  | _::scopes -> find_default ntn scopes
   | [] -> None
+  | Scope scope :: scopes ->
+    if String.Map.mem ntn (find_scope scope).notations then
+      Some scope
+    else find_default ntn scopes
+  | SingleNotation ntn' :: scopes ->
+    if String.equal ntn ntn' then Some default_scope
+    else find_default ntn scopes
 
 let factorize_entries = function
   | [] -> []
@@ -663,29 +807,32 @@ let factorize_entries = function
       let (ntn,l_of_ntn,rest) =
 	List.fold_left
           (fun (a',l,rest) (a,c) ->
-	    if a = a' then (a',c::l,rest) else (a,[c],(a',l)::rest))
+	    if String.equal a a' then (a',c::l,rest) else (a,[c],(a',l)::rest))
 	  (ntn,[c],[]) l in
       (ntn,l_of_ntn)::rest
 
 let browse_notation strict ntn map =
-  let find =
-    if String.contains ntn ' ' then (=) ntn
-    else fun ntn' ->
+  let find ntn' =
+    if String.contains ntn ' ' then String.equal ntn ntn'
+    else
       let toks = decompose_notation_key ntn' in
-      let trms = List.filter (function Terminal _ -> true | _ -> false) toks in
-      if strict then [Terminal ntn] = trms else List.mem (Terminal ntn) trms in
+      let get_terminals = function Terminal ntn -> Some ntn | _ -> None in
+      let trms = List.map_filter get_terminals toks in
+      if strict then String.List.equal [ntn] trms
+      else String.List.mem ntn trms
+  in
   let l =
-    Gmap.fold
+    String.Map.fold
       (fun scope_name sc ->
-	Gmap.fold (fun ntn ((_,r),df) l ->
+	String.Map.fold (fun ntn ((_,r),df) l ->
 	  if find ntn then (ntn,(scope_name,r,df))::l else l) sc.notations)
       map [] in
-  List.sort (fun x y -> Pervasives.compare (fst x) (fst y)) l
+  List.sort (fun x y -> String.compare (fst x) (fst y)) l
 
 let global_reference_of_notation test (ntn,(sc,c,_)) =
   match c with
-  | ARef ref when test ref -> Some (ntn,sc,ref)
-  | AApp (ARef ref, l) when List.for_all isAVar_or_AHole l & test ref ->
+  | NRef ref when test ref -> Some (ntn,sc,ref)
+  | NApp (NRef ref, l) when List.for_all isNVar_or_NHole l && test ref ->
       Some (ntn,sc,ref)
   | _ -> None
 
@@ -700,7 +847,8 @@ let error_notation_not_reference loc ntn =
 let interp_notation_as_global_reference loc test ntn sc =
   let scopes = match sc with
   | Some sc ->
-      Gmap.add sc (find_scope (find_delimiters_scope dummy_loc sc)) Gmap.empty
+      let scope = find_scope (find_delimiters_scope Loc.ghost sc) in
+      String.Map.add sc scope String.Map.empty
   | None -> !scope_map in
   let ntns = browse_notation true ntn scopes in
   let refs = List.map (global_reference_of_notation test) ntns in
@@ -708,7 +856,12 @@ let interp_notation_as_global_reference loc test ntn sc =
   | [_,_,ref] -> ref
   | [] -> error_notation_not_reference loc ntn
   | refs ->
-      let f (ntn,sc,ref) = find_default ntn !scope_stack = Some sc in
+      let f (ntn,sc,ref) =
+        let def = find_default ntn !scope_stack in
+        match def with
+        | None -> false
+        | Some sc' -> String.equal sc sc'
+      in
       match List.filter f refs with
       | [_,_,ref] -> ref
       | [] -> error_notation_not_reference loc ntn
@@ -717,9 +870,9 @@ let interp_notation_as_global_reference loc test ntn sc =
 let locate_notation prglob ntn scope =
   let ntns = factorize_entries (browse_notation false ntn !scope_map) in
   let scopes = Option.fold_right push_scope scope !scope_stack in
-  if ntns = [] then
-    str "Unknown notation"
-  else
+  match ntns with
+  | [] -> str "Unknown notation"
+  | _ ->
     t (str "Notation            " ++
     tab () ++ str "Scope     " ++ tab () ++ fnl () ++
     prlist (fun (ntn,l) ->
@@ -728,35 +881,35 @@ let locate_notation prglob ntn scope =
 	(fun (sc,r,(_,df)) ->
 	  hov 0 (
 	    pr_notation_info prglob df r ++ tbrk (1,2) ++
-	    (if sc = default_scope then mt () else (str ": " ++ str sc)) ++
+	    (if String.equal sc default_scope then mt () else (str ": " ++ str sc)) ++
 	    tbrk (1,2) ++
-	    (if Some sc = scope then str "(default interpretation)" else mt ())
+	    (if Option.equal String.equal (Some sc) scope then str "(default interpretation)" else mt ())
 	    ++ fnl ()))
 	l) ntns)
 
 let collect_notation_in_scope scope sc known =
-  assert (scope <> default_scope);
-  Gmap.fold
+  assert (not (String.equal scope default_scope));
+  String.Map.fold
     (fun ntn ((_,r),(_,df)) (l,known as acc) ->
-      if List.mem ntn known then acc else ((df,r)::l,ntn::known))
+      if String.List.mem ntn known then acc else ((df,r)::l,ntn::known))
     sc.notations ([],known)
 
 let collect_notations stack =
   fst (List.fold_left
     (fun (all,knownntn as acc) -> function
       | Scope scope ->
-	  if List.mem_assoc scope all then acc
+	  if String.List.mem_assoc scope all then acc
 	  else
 	    let (l,knownntn) =
 	      collect_notation_in_scope scope (find_scope scope) knownntn in
 	    ((scope,l)::all,knownntn)
       | SingleNotation ntn ->
-	  if List.mem ntn knownntn then (all,knownntn)
+	  if String.List.mem ntn knownntn then (all,knownntn)
 	  else
 	    let ((_,r),(_,df)) =
-	      Gmap.find ntn (find_scope default_scope).notations in
+	      String.Map.find ntn (find_scope default_scope).notations in
 	    let all' = match all with
-	      | (s,lonelyntn)::rest when s = default_scope ->
+	      | (s,lonelyntn)::rest when String.equal s default_scope ->
 		  (s,(df,r)::lonelyntn)::rest
 	      | _ ->
 		  (default_scope,[df,r])::all in
@@ -768,8 +921,8 @@ let pr_visible_in_scope prglob (scope,ntns) =
     List.fold_right
       (fun (df,r) strm -> pr_notation_info prglob df r ++ fnl () ++ strm)
       ntns (mt ()) in
-  (if scope = default_scope then
-     str "Lonely notation" ++ (if List.length ntns <> 1 then str "s" else mt())
+  (if String.equal scope default_scope then
+     str "Lonely notation" ++ (match ntns with [_] -> mt () | _ -> str "s")
    else
      str "Visible in scope " ++ str scope)
   ++ fnl () ++ strm
@@ -787,25 +940,36 @@ let pr_visibility prglob = function
 (* Mapping notations to concrete syntax *)
 
 type unparsing_rule = unparsing list * precedence
-
+type extra_unparsing_rules = (string * string) list
 (* Concrete syntax for symbolic-extension table *)
 let printing_rules =
-  ref (Gmap.empty : (string,unparsing_rule) Gmap.t)
+  ref (String.Map.empty : (unparsing_rule * extra_unparsing_rules) String.Map.t)
 
-let declare_notation_printing_rule ntn unpl =
-  printing_rules := Gmap.add ntn unpl !printing_rules
+let declare_notation_printing_rule ntn ~extra unpl =
+  printing_rules := String.Map.add ntn (unpl,extra) !printing_rules
 
 let find_notation_printing_rule ntn =
-  try Gmap.find ntn !printing_rules
-  with Not_found -> anomaly ("No printing rule found for "^ntn)
+  try fst (String.Map.find ntn !printing_rules)
+  with Not_found -> anomaly (str "No printing rule found for " ++ str ntn)
+let find_notation_extra_printing_rules ntn =
+  try snd (String.Map.find ntn !printing_rules)
+  with Not_found -> []
+let add_notation_extra_printing_rule ntn k v =
+  try
+    printing_rules := 
+      let p, pp = String.Map.find ntn !printing_rules in
+      String.Map.add ntn (p, (k,v) :: pp) !printing_rules
+  with Not_found ->
+    user_err_loc (Loc.ghost,"add_notation_extra_printing_rule",
+      str "No such Notation.")
 
 (**********************************************************************)
 (* Synchronisation with reset *)
 
-let freeze () =
+let freeze _ =
  (!scope_map, !notation_level_map, !scope_stack, !arguments_scope,
   !delimiters_map, !notations_key_table, !printing_rules,
-  !class_scope_map)
+  !scope_class_map)
 
 let unfreeze (scm,nlm,scs,asc,dlm,fkm,pprules,clsc) =
   scope_map := scm;
@@ -815,27 +979,26 @@ let unfreeze (scm,nlm,scs,asc,dlm,fkm,pprules,clsc) =
   arguments_scope := asc;
   notations_key_table := fkm;
   printing_rules := pprules;
-  class_scope_map := clsc
+  scope_class_map := clsc
 
 let init () =
   init_scope_map ();
-(*
-  scope_stack := Gmap.empty
-  arguments_scope := Refmap.empty
-*)
-  notation_level_map := Gmap.empty;
-  delimiters_map := Gmap.empty;
-  notations_key_table := Gmapl.empty;
-  printing_rules := Gmap.empty;
-  class_scope_map := Gmap.add CL_SORT "type_scope" Gmap.empty
+  notation_level_map := String.Map.empty;
+  delimiters_map := String.Map.empty;
+  notations_key_table := KeyMap.empty;
+  printing_rules := String.Map.empty;
+  scope_class_map := initial_scope_class_map
 
 let _ =
-  declare_summary "symbols"
-    { freeze_function = freeze;
-      unfreeze_function = unfreeze;
-      init_function = init }
+  Summary.declare_summary "symbols"
+    { Summary.freeze_function = freeze;
+      Summary.unfreeze_function = unfreeze;
+      Summary.init_function = init }
 
 let with_notation_protection f x =
-  let fs = freeze () in
+  let fs = freeze false in
   try let a = f x in unfreeze fs; a
-  with reraise -> unfreeze fs; raise reraise
+  with reraise ->
+    let reraise = Errors.push reraise in
+    let () = unfreeze fs in
+    iraise reraise
diff --git a/interp/notation.mli b/interp/notation.mli
index bb2d5090..c66115cb 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -1,19 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Util
 open Pp
 open Bigint
 open Names
-open Nametab
 open Libnames
+open Globnames
+open Constrexpr
 open Glob_term
-open Topconstr
+open Notation_term
 open Ppextend
 
 (** Notations *)
@@ -34,6 +34,8 @@ val declare_scope : scope_name -> unit
 
 val current_scopes : unit -> scopes
 
+val level_eq : level -> level -> bool
+
 (** Check where a scope is opened or not in a scope list, or in
  * the current opened scopes *)
 val scope_is_open_in_scopes : scope_name -> scopes -> bool
@@ -53,7 +55,7 @@ val find_scope : scope_name -> scope
 (** Declare delimiters for printing *)
 
 val declare_delimiters : scope_name -> delimiters -> unit
-val find_delimiters_scope : loc -> delimiters -> scope_name
+val find_delimiters_scope : Loc.t -> delimiters -> scope_name
 
 (** {6 Declare and uses back and forth an interpretation of primitive token } *)
 
@@ -62,12 +64,12 @@ val find_delimiters_scope : loc -> delimiters -> scope_name
    negative numbers are not supported, the interpreter must fail with
    an appropriate error message *)
 
-type notation_location = (dir_path * dir_path) * string
+type notation_location = (DirPath.t * DirPath.t) * string
 type required_module = full_path * string list
 type cases_pattern_status = bool (** true = use prim token in patterns *)
 
 type 'a prim_token_interpreter =
-    loc -> 'a -> glob_constr
+    Loc.t -> 'a -> glob_constr
 
 type 'a prim_token_uninterpreter =
     glob_constr list * (glob_constr -> 'a option) * cases_pattern_status
@@ -81,10 +83,10 @@ val declare_string_interpreter : scope_name -> required_module ->
 (** Return the [term]/[cases_pattern] bound to a primitive token in a
    given scope context*)
 
-val interp_prim_token : loc -> prim_token -> local_scopes ->
+val interp_prim_token : Loc.t -> prim_token -> local_scopes ->
   glob_constr * (notation_location * scope_name option)
-val interp_prim_token_cases_pattern : loc -> prim_token -> name ->
-  local_scopes -> cases_pattern * (notation_location * scope_name option)
+val interp_prim_token_cases_pattern_expr : Loc.t -> (global_reference -> unit) -> prim_token ->
+  local_scopes -> raw_cases_pattern_expr * (notation_location * scope_name option)
 
 (** Return the primitive token associated to a [term]/[cases_pattern];
    raise [No_match] if no such token *)
@@ -92,7 +94,9 @@ val interp_prim_token_cases_pattern : loc -> prim_token -> name ->
 val uninterp_prim_token :
   glob_constr -> scope_name * prim_token
 val uninterp_prim_token_cases_pattern :
-  cases_pattern -> name * scope_name * prim_token
+  cases_pattern -> Name.t * scope_name * prim_token
+val uninterp_prim_token_ind_pattern :
+ inductive -> cases_pattern list -> scope_name * prim_token
 
 val availability_of_prim_token :
   prim_token -> scope_name -> local_scopes -> delimiters option option
@@ -110,14 +114,15 @@ val declare_notation_interpretation : notation -> scope_name option ->
 val declare_uninterpretation : interp_rule -> interpretation -> unit
 
 (** Return the interpretation bound to a notation *)
-val interp_notation : loc -> notation -> local_scopes ->
+val interp_notation : Loc.t -> notation -> local_scopes ->
       interpretation * (notation_location * scope_name option)
 
+type notation_rule = interp_rule * interpretation * int option
+
 (** Return the possible notations for a given term *)
-val uninterp_notations : glob_constr ->
-      (interp_rule * interpretation * int option) list
-val uninterp_cases_pattern_notations : cases_pattern ->
-      (interp_rule * interpretation * int option) list
+val uninterp_notations : glob_constr -> notation_rule list
+val uninterp_cases_pattern_notations : cases_pattern -> notation_rule list
+val uninterp_ind_pattern_notations : inductive -> notation_rule list
 
 (** Test if a notation is available in the scopes 
    context [scopes]; if available, the result is not None; the first 
@@ -132,36 +137,43 @@ val level_of_notation : notation -> level (** raise [Not_found] if no level *)
 
 (** {6 Miscellaneous} *)
 
-val interp_notation_as_global_reference : loc -> (global_reference -> bool) ->
+val interp_notation_as_global_reference : Loc.t -> (global_reference -> bool) ->
       notation -> delimiters option -> global_reference
 
-(** Checks for already existing notations *)
-val exists_notation_in_scope : scope_name option -> notation ->
-      interpretation -> bool
-
 (** Declares and looks for scopes associated to arguments of a global ref *)
 val declare_arguments_scope :
   bool (** true=local *) -> global_reference -> scope_name option list -> unit
 
 val find_arguments_scope : global_reference -> scope_name option list
 
-val declare_class_scope : scope_name -> Classops.cl_typ -> unit
+type scope_class
+
+val scope_class_of_reference : global_reference -> scope_class
+val subst_scope_class :
+  Mod_subst.substitution -> scope_class -> scope_class option
+
+val declare_scope_class : scope_name -> scope_class -> unit
 val declare_ref_arguments_scope : global_reference -> unit
 
 val compute_arguments_scope : Term.types -> scope_name option list
+val compute_type_scope : Term.types -> scope_name option
+val compute_scope_of_global : global_reference -> scope_name option
 
 (** Building notation key *)
 
 type symbol =
   | Terminal of string
-  | NonTerminal of identifier
-  | SProdList of identifier * symbol list
+  | NonTerminal of Id.t
+  | SProdList of Id.t * symbol list
   | Break of int
 
+val symbol_eq : symbol -> symbol -> bool
+
 val make_notation_key : symbol list -> notation
 val decompose_notation_key : notation -> symbol list
 
 (** Prints scopes (expects a pure aconstr printer) *)
+val pr_scope_class : scope_class -> std_ppcmds
 val pr_scope : (glob_constr -> std_ppcmds) -> scope_name -> std_ppcmds
 val pr_scopes : (glob_constr -> std_ppcmds) -> std_ppcmds
 val locate_notation : (glob_constr -> std_ppcmds) -> notation ->
@@ -173,8 +185,12 @@ val pr_visibility: (glob_constr -> std_ppcmds) -> scope_name option -> std_ppcmd
 
 (** Declare and look for the printing rule for symbolic notations *)
 type unparsing_rule = unparsing list * precedence
-val declare_notation_printing_rule : notation -> unparsing_rule -> unit
+type extra_unparsing_rules = (string * string) list
+val declare_notation_printing_rule :
+  notation -> extra:extra_unparsing_rules -> unparsing_rule -> unit
 val find_notation_printing_rule : notation -> unparsing_rule
+val find_notation_extra_printing_rules : notation -> extra_unparsing_rules
+val add_notation_extra_printing_rule : notation -> string -> string -> unit
 
 (** Rem: printing rules for primitive token are canonical *)
 
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
new file mode 100644
index 00000000..c91c7815
--- /dev/null
+++ b/interp/notation_ops.ml
@@ -0,0 +1,856 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+open Errors
+open Util
+open Names
+open Nameops
+open Globnames
+open Misctypes
+open Glob_term
+open Glob_ops
+open Mod_subst
+open Notation_term
+open Decl_kinds
+
+(**********************************************************************)
+(* Re-interpret a notation as a glob_constr, taking care of binders     *)
+
+let name_to_ident = function
+  | Anonymous -> Errors.error "This expression should be a simple identifier."
+  | Name id -> id
+
+let to_id g e id = let e,na = g e (Name id) in e,name_to_ident na
+
+let rec cases_pattern_fold_map loc g e = function
+  | PatVar (_,na) ->
+      let e',na' = g e na in e', PatVar (loc,na')
+  | PatCstr (_,cstr,patl,na) ->
+      let e',na' = g e na in
+      let e',patl' = List.fold_map (cases_pattern_fold_map loc g) e patl in
+      e', PatCstr (loc,cstr,patl',na')
+
+let rec subst_glob_vars l = function
+  | GVar (_,id) as r -> (try Id.List.assoc id l with Not_found -> r)
+  | GProd (loc,Name id,bk,t,c) ->
+      let id =
+	try match Id.List.assoc id l with GVar(_,id') -> id' | _ -> id
+	with Not_found -> id in
+      GProd (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
+  | GLambda (loc,Name id,bk,t,c) ->
+      let id =
+	try match Id.List.assoc id l with GVar(_,id') -> id' | _ -> id
+	with Not_found -> id in
+      GLambda (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
+  | r -> map_glob_constr (subst_glob_vars l) r (* assume: id is not binding *)
+
+let ldots_var = Id.of_string ".."
+
+let glob_constr_of_notation_constr_with_binders loc g f e = function
+  | NVar id -> GVar (loc,id)
+  | NApp (a,args) -> GApp (loc,f e a, List.map (f e) args)
+  | NList (x,y,iter,tail,swap) ->
+      let t = f e tail in let it = f e iter in
+      let innerl = (ldots_var,t)::(if swap then [] else [x,GVar(loc,y)]) in
+      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
+      let outerl = (ldots_var,inner)::(if swap then [x,GVar(loc,y)] else []) in
+      subst_glob_vars outerl it
+  | NBinderList (x,y,iter,tail) ->
+      let t = f e tail in let it = f e iter in
+      let innerl = [(ldots_var,t);(x,GVar(loc,y))] in
+      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
+      let outerl = [(ldots_var,inner)] in
+      subst_glob_vars outerl it
+  | NLambda (na,ty,c) ->
+      let e',na = g e na in GLambda (loc,na,Explicit,f e ty,f e' c)
+  | NProd (na,ty,c) ->
+      let e',na = g e na in GProd (loc,na,Explicit,f e ty,f e' c)
+  | NLetIn (na,b,c) ->
+      let e',na = g e na in GLetIn (loc,na,f e b,f e' c)
+  | NCases (sty,rtntypopt,tml,eqnl) ->
+      let e',tml' = List.fold_right (fun (tm,(na,t)) (e',tml') ->
+	let e',t' = match t with
+	| None -> e',None
+	| Some (ind,nal) ->
+	  let e',nal' = List.fold_right (fun na (e',nal) ->
+	      let e',na' = g e' na in e',na'::nal) nal (e',[]) in
+	  e',Some (loc,ind,nal') in
+	let e',na' = g e' na in
+	(e',(f e tm,(na',t'))::tml')) tml (e,[]) in
+      let fold (idl,e) na = let (e,na) = g e na in ((name_cons na idl,e),na) in
+      let eqnl' = List.map (fun (patl,rhs) ->
+	let ((idl,e),patl) =
+	  List.fold_map (cases_pattern_fold_map loc fold) ([],e) patl in
+	(loc,idl,patl,f e rhs)) eqnl in
+      GCases (loc,sty,Option.map (f e') rtntypopt,tml',eqnl')
+  | NLetTuple (nal,(na,po),b,c) ->
+      let e',nal = List.fold_map g e nal in
+      let e'',na = g e na in
+      GLetTuple (loc,nal,(na,Option.map (f e'') po),f e b,f e' c)
+  | NIf (c,(na,po),b1,b2) ->
+      let e',na = g e na in
+      GIf (loc,f e c,(na,Option.map (f e') po),f e b1,f e b2)
+  | NRec (fk,idl,dll,tl,bl) ->
+      let e,dll = Array.fold_map (List.fold_map (fun e (na,oc,b) ->
+	  let e,na = g e na in
+	  (e,(na,Explicit,Option.map (f e) oc,f e b)))) e dll in
+      let e',idl = Array.fold_map (to_id g) e idl in
+      GRec (loc,fk,idl,dll,Array.map (f e) tl,Array.map (f e') bl)
+  | NCast (c,k) -> GCast (loc,f e c,Miscops.map_cast_type (f e) k)
+  | NSort x -> GSort (loc,x)
+  | NHole (x, naming, arg)  -> GHole (loc, x, naming, arg)
+  | NPatVar n -> GPatVar (loc,(false,n))
+  | NRef x -> GRef (loc,x,None)
+
+let glob_constr_of_notation_constr loc x =
+  let rec aux () x =
+    glob_constr_of_notation_constr_with_binders loc (fun () id -> ((),id)) aux () x
+  in aux () x
+
+(****************************************************************************)
+(* Translating a glob_constr into a notation, interpreting recursive patterns *)
+
+let add_id r id = r := (id :: pi1 !r, pi2 !r, pi3 !r)
+let add_name r = function Anonymous -> () | Name id -> add_id r id
+
+let split_at_recursive_part c =
+  let sub = ref None in
+  let rec aux = function
+  | GApp (loc0,GVar(loc,v),c::l) when Id.equal v ldots_var ->
+      begin match !sub with
+      | None ->
+        let () = sub := Some c in
+        begin match l with
+        | [] -> GVar (loc, ldots_var)
+        | _ :: _ -> GApp (loc0, GVar (loc, ldots_var), l)
+        end
+      | Some _ ->
+        (* Not narrowed enough to find only one recursive part *)
+        raise Not_found
+      end
+  | c -> map_glob_constr aux c in
+  let outer_iterator = aux c in
+  match !sub with
+  | None -> (* No recursive pattern found *) raise Not_found
+  | Some c ->
+  match outer_iterator with
+  | GVar (_,v) when Id.equal v ldots_var -> (* Not enough context *) raise Not_found
+  | _ -> outer_iterator, c
+
+let on_true_do b f c = if b then (f c; b) else b
+
+let compare_glob_constr f add t1 t2 = match t1,t2 with
+  | GRef (_,r1,_), GRef (_,r2,_) -> eq_gr r1 r2
+  | GVar (_,v1), GVar (_,v2) -> on_true_do (Id.equal v1 v2) add (Name v1)
+  | GApp (_,f1,l1), GApp (_,f2,l2) -> f f1 f2 && List.for_all2eq f l1 l2
+  | GLambda (_,na1,bk1,ty1,c1), GLambda (_,na2,bk2,ty2,c2)
+    when Name.equal na1 na2 && Constrexpr_ops.binding_kind_eq bk1 bk2 ->
+    on_true_do (f ty1 ty2 && f c1 c2) add na1
+  | GProd (_,na1,bk1,ty1,c1), GProd (_,na2,bk2,ty2,c2)
+    when Name.equal na1 na2 && Constrexpr_ops.binding_kind_eq bk1 bk2 ->
+      on_true_do (f ty1 ty2 && f c1 c2) add na1
+  | GHole _, GHole _ -> true
+  | GSort (_,s1), GSort (_,s2) -> Miscops.glob_sort_eq s1 s2
+  | GLetIn (_,na1,b1,c1), GLetIn (_,na2,b2,c2) when Name.equal na1 na2 ->
+      on_true_do (f b1 b2 && f c1 c2) add na1
+  | (GCases _ | GRec _
+    | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _),_
+  | _,(GCases _ | GRec _
+      | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _)
+      -> error "Unsupported construction in recursive notations."
+  | (GRef _ | GVar _ | GApp _ | GLambda _ | GProd _
+    | GHole _ | GSort _ | GLetIn _), _
+      -> false
+
+let rec eq_glob_constr t1 t2 = compare_glob_constr eq_glob_constr (fun _ -> ()) t1 t2
+
+let subtract_loc loc1 loc2 = Loc.make_loc (fst (Loc.unloc loc1),fst (Loc.unloc loc2)-1)
+
+let check_is_hole id = function GHole _ -> () | t ->
+  user_err_loc (loc_of_glob_constr t,"",
+    strbrk "In recursive notation with binders, " ++ pr_id id ++
+    strbrk " is expected to come without type.")
+
+let compare_recursive_parts found f (iterator,subc) =
+  let diff = ref None in
+  let terminator = ref None in
+  let rec aux c1 c2 = match c1,c2 with
+  | GVar(_,v), term when Id.equal v ldots_var ->
+      (* We found the pattern *)
+      assert (match !terminator with None -> true | Some _ -> false);
+      terminator := Some term;
+      true
+  | GApp (_,GVar(_,v),l1), GApp (_,term,l2) when Id.equal v ldots_var ->
+      (* We found the pattern, but there are extra arguments *)
+      (* (this allows e.g. alternative (recursive) notation of application) *)
+      assert (match !terminator with None -> true | Some _ -> false);
+      terminator := Some term;
+      List.for_all2eq aux l1 l2
+  | GVar (_,x), GVar (_,y) when not (Id.equal x y) ->
+      (* We found the position where it differs *)
+      let lassoc = match !terminator with None -> false | Some _ -> true in
+      let x,y = if lassoc then y,x else x,y in
+      begin match !diff with
+      | None ->
+        let () = diff := Some (x, y, Some lassoc) in
+        true
+      | Some _ -> false
+      end
+  | GLambda (_,Name x,_,t_x,c), GLambda (_,Name y,_,t_y,term)
+  | GProd (_,Name x,_,t_x,c), GProd (_,Name y,_,t_y,term) ->
+      (* We found a binding position where it differs *)
+      check_is_hole x t_x;
+      check_is_hole y t_y;
+      begin match !diff with
+      | None ->
+        let () = diff := Some (x, y, None) in
+        aux c term
+      | Some _ -> false
+      end
+  | _ ->
+      compare_glob_constr aux (add_name found) c1 c2 in
+  if aux iterator subc then
+    match !diff with
+    | None ->
+	let loc1 = loc_of_glob_constr iterator in
+	let loc2 = loc_of_glob_constr (Option.get !terminator) in
+	(* Here, we would need a loc made of several parts ... *)
+	user_err_loc (subtract_loc loc1 loc2,"",
+          str "Both ends of the recursive pattern are the same.")
+    | Some (x,y,Some lassoc) ->
+	let newfound = (pi1 !found, (x,y) :: pi2 !found, pi3 !found) in
+	let iterator =
+	  f (if lassoc then subst_glob_vars [y,GVar(Loc.ghost,x)] iterator
+	  else iterator) in
+	(* found have been collected by compare_constr *)
+	found := newfound;
+	NList (x,y,iterator,f (Option.get !terminator),lassoc)
+    | Some (x,y,None) ->
+	let newfound = (pi1 !found, pi2 !found, (x,y) :: pi3 !found) in
+	let iterator = f iterator in
+	(* found have been collected by compare_constr *)
+	found := newfound;
+	NBinderList (x,y,iterator,f (Option.get !terminator))
+  else
+    raise Not_found
+
+let notation_constr_and_vars_of_glob_constr a =
+  let found = ref ([],[],[]) in
+  let rec aux c =
+    let keepfound = !found in
+    (* n^2 complexity but small and done only once per notation *)
+    try compare_recursive_parts found aux' (split_at_recursive_part c)
+    with Not_found ->
+    found := keepfound;
+    match c with
+    | GApp (_,GVar (loc,f),[c]) when Id.equal f ldots_var ->
+	(* Fall on the second part of the recursive pattern w/o having
+	   found the first part *)
+	user_err_loc (loc,"",
+	str "Cannot find where the recursive pattern starts.")
+    | c ->
+	aux' c
+  and aux' = function
+  | GVar (_,id) -> add_id found id; NVar id
+  | GApp (_,g,args) -> NApp (aux g, List.map aux args)
+  | GLambda (_,na,bk,ty,c) -> add_name found na; NLambda (na,aux ty,aux c)
+  | GProd (_,na,bk,ty,c) -> add_name found na; NProd (na,aux ty,aux c)
+  | GLetIn (_,na,b,c) -> add_name found na; NLetIn (na,aux b,aux c)
+  | GCases (_,sty,rtntypopt,tml,eqnl) ->
+      let f (_,idl,pat,rhs) = List.iter (add_id found) idl; (pat,aux rhs) in
+      NCases (sty,Option.map aux rtntypopt,
+        List.map (fun (tm,(na,x)) ->
+	  add_name found na;
+	  Option.iter
+	    (fun (_,_,nl) -> List.iter (add_name found) nl) x;
+          (aux tm,(na,Option.map (fun (_,ind,nal) -> (ind,nal)) x))) tml,
+        List.map f eqnl)
+  | GLetTuple (loc,nal,(na,po),b,c) ->
+      add_name found na;
+      List.iter (add_name found) nal;
+      NLetTuple (nal,(na,Option.map aux po),aux b,aux c)
+  | GIf (loc,c,(na,po),b1,b2) ->
+      add_name found na;
+      NIf (aux c,(na,Option.map aux po),aux b1,aux b2)
+  | GRec (_,fk,idl,dll,tl,bl) ->
+      Array.iter (add_id found) idl;
+      let dll = Array.map (List.map (fun (na,bk,oc,b) ->
+	 if bk != Explicit then
+	   error "Binders marked as implicit not allowed in notations.";
+	 add_name found na; (na,Option.map aux oc,aux b))) dll in
+      NRec (fk,idl,dll,Array.map aux tl,Array.map aux bl)
+  | GCast (_,c,k) -> NCast (aux c,Miscops.map_cast_type aux k)
+  | GSort (_,s) -> NSort s
+  | GHole (_,w,naming,arg) -> NHole (w, naming, arg)
+  | GRef (_,r,_) -> NRef r
+  | GPatVar (_,(_,n)) -> NPatVar n
+  | GEvar _ ->
+      error "Existential variables not allowed in notations."
+
+  in
+  let t = aux a in
+  (* Side effect *)
+  t, !found
+
+let pair_equal eq1 eq2 (a,b) (a',b') = eq1 a a' && eq2 b b'
+
+let check_variables nenv (found,foundrec,foundrecbinding) =
+  let recvars = nenv.ninterp_rec_vars in
+  let fold _ y accu = Id.Set.add y accu in
+  let useless_vars = Id.Map.fold fold recvars Id.Set.empty in
+  let filter y _ = not (Id.Set.mem y useless_vars) in
+  let vars = Id.Map.filter filter nenv.ninterp_var_type in
+  let check_recvar x =
+    if Id.List.mem x found then
+      errorlabstrm "" (pr_id x ++
+	strbrk " should only be used in the recursive part of a pattern.") in
+  let check (x, y) = check_recvar x; check_recvar y in
+  let () = List.iter check foundrec in
+  let () = List.iter check foundrecbinding in
+  let check_bound x =
+    if not (Id.List.mem x found) then
+      if Id.List.mem_assoc x foundrec ||
+         Id.List.mem_assoc x foundrecbinding ||
+         Id.List.mem_assoc_sym x foundrec ||
+         Id.List.mem_assoc_sym x foundrecbinding
+      then
+	error
+          (Id.to_string x ^
+          " should not be bound in a recursive pattern of the right-hand side.")
+      else nenv.ninterp_only_parse <- true
+  in
+  let check_pair s x y where =
+    if not (List.mem_f (pair_equal Id.equal Id.equal) (x,y) where) then
+      errorlabstrm "" (strbrk "in the right-hand side, " ++ pr_id x ++
+	str " and " ++ pr_id y ++ strbrk " should appear in " ++ str s ++
+	str " position as part of a recursive pattern.") in
+  let check_type x typ =
+    match typ with
+    | NtnInternTypeConstr ->
+	begin
+	  try check_pair "term" x (Id.Map.find x recvars) foundrec
+	  with Not_found -> check_bound x
+	end
+    | NtnInternTypeBinder ->
+	begin
+	  try check_pair "binding" x (Id.Map.find x recvars) foundrecbinding
+	  with Not_found -> check_bound x
+	end
+    | NtnInternTypeIdent -> check_bound x in
+  Id.Map.iter check_type vars
+
+let notation_constr_of_glob_constr nenv a =
+  let a, found = notation_constr_and_vars_of_glob_constr a in
+  let () = check_variables nenv found in
+  a
+
+(* Substitution of kernel names, avoiding a list of bound identifiers *)
+
+let notation_constr_of_constr avoiding t =
+  let t = Detyping.detype false avoiding (Global.env()) Evd.empty t in
+  let nenv = {
+    ninterp_var_type = Id.Map.empty;
+    ninterp_rec_vars = Id.Map.empty;
+    ninterp_only_parse = false;
+  } in
+  notation_constr_of_glob_constr nenv t
+
+let rec subst_pat subst pat =
+  match pat with
+  | PatVar _ -> pat
+  | PatCstr (loc,((kn,i),j),cpl,n) ->
+      let kn' = subst_mind subst kn
+      and cpl' = List.smartmap (subst_pat subst) cpl in
+        if kn' == kn && cpl' == cpl then pat else
+          PatCstr (loc,((kn',i),j),cpl',n)
+
+let rec subst_notation_constr subst bound raw =
+  match raw with
+  | NRef ref ->
+      let ref',t = subst_global subst ref in
+	if ref' == ref then raw else
+	  notation_constr_of_constr bound t
+
+  | NVar _ -> raw
+
+  | NApp (r,rl) ->
+      let r' = subst_notation_constr subst bound r
+      and rl' = List.smartmap (subst_notation_constr subst bound) rl in
+	if r' == r && rl' == rl then raw else
+	  NApp(r',rl')
+
+  | NList (id1,id2,r1,r2,b) ->
+      let r1' = subst_notation_constr subst bound r1
+      and r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  NList (id1,id2,r1',r2',b)
+
+  | NLambda (n,r1,r2) ->
+      let r1' = subst_notation_constr subst bound r1
+      and r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  NLambda (n,r1',r2')
+
+  | NProd (n,r1,r2) ->
+      let r1' = subst_notation_constr subst bound r1
+      and r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  NProd (n,r1',r2')
+
+  | NBinderList (id1,id2,r1,r2) ->
+      let r1' = subst_notation_constr subst bound r1
+      and r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  NBinderList (id1,id2,r1',r2')
+
+  | NLetIn (n,r1,r2) ->
+      let r1' = subst_notation_constr subst bound r1
+      and r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  NLetIn (n,r1',r2')
+
+  | NCases (sty,rtntypopt,rl,branches) ->
+      let rtntypopt' = Option.smartmap (subst_notation_constr subst bound) rtntypopt
+      and rl' = List.smartmap
+        (fun (a,(n,signopt) as x) ->
+	  let a' = subst_notation_constr subst bound a in
+	  let signopt' = Option.map (fun ((indkn,i),nal as z) ->
+	    let indkn' = subst_mind subst indkn in
+	    if indkn == indkn' then z else ((indkn',i),nal)) signopt in
+	  if a' == a && signopt' == signopt then x else (a',(n,signopt')))
+        rl
+      and branches' = List.smartmap
+                        (fun (cpl,r as branch) ->
+                           let cpl' = List.smartmap (subst_pat subst) cpl
+                           and r' = subst_notation_constr subst bound r in
+                             if cpl' == cpl && r' == r then branch else
+                               (cpl',r'))
+                        branches
+      in
+        if rtntypopt' == rtntypopt && rtntypopt == rtntypopt' &&
+          rl' == rl && branches' == branches then raw else
+          NCases (sty,rtntypopt',rl',branches')
+
+  | NLetTuple (nal,(na,po),b,c) ->
+      let po' = Option.smartmap (subst_notation_constr subst bound) po
+      and b' = subst_notation_constr subst bound b
+      and c' = subst_notation_constr subst bound c in
+	if po' == po && b' == b && c' == c then raw else
+	  NLetTuple (nal,(na,po'),b',c')
+
+  | NIf (c,(na,po),b1,b2) ->
+      let po' = Option.smartmap (subst_notation_constr subst bound) po
+      and b1' = subst_notation_constr subst bound b1
+      and b2' = subst_notation_constr subst bound b2
+      and c' = subst_notation_constr subst bound c in
+	if po' == po && b1' == b1 && b2' == b2 && c' == c then raw else
+	  NIf (c',(na,po'),b1',b2')
+
+  | NRec (fk,idl,dll,tl,bl) ->
+      let dll' =
+	Array.smartmap (List.smartmap (fun (na,oc,b as x) ->
+	  let oc' =  Option.smartmap (subst_notation_constr subst bound) oc in
+	  let b' =  subst_notation_constr subst bound b in
+	  if oc' == oc && b' == b then x else (na,oc',b'))) dll in
+      let tl' = Array.smartmap (subst_notation_constr subst bound) tl in
+      let bl' = Array.smartmap (subst_notation_constr subst bound) bl in
+      if dll' == dll && tl' == tl && bl' == bl then raw else
+	  NRec (fk,idl,dll',tl',bl')
+
+  | NPatVar _ | NSort _ -> raw
+
+  | NHole (knd, naming, solve) ->
+    let nknd = match knd with
+    | Evar_kinds.ImplicitArg (ref, i, b) ->
+      let nref, _ = subst_global subst ref in
+      if nref == ref then knd else Evar_kinds.ImplicitArg (nref, i, b)
+    | _ -> knd
+    in
+    let nsolve = Option.smartmap (Genintern.generic_substitute subst) solve in
+    if nsolve == solve && nknd == knd then raw
+    else NHole (nknd, naming, nsolve)
+
+  | NCast (r1,k) ->
+      let r1' = subst_notation_constr subst bound r1 in
+      let k' = Miscops.smartmap_cast_type (subst_notation_constr subst bound) k in
+      if r1' == r1 && k' == k then raw else NCast(r1',k')
+
+let subst_interpretation subst (metas,pat) =
+  let bound = List.map fst metas in
+  (metas,subst_notation_constr subst bound pat)
+
+(* Pattern-matching glob_constr and notation_constr *)
+
+let abstract_return_type_context pi mklam tml rtno =
+  Option.map (fun rtn ->
+    let nal =
+      List.flatten (List.map (fun (_,(na,t)) ->
+	match t with Some x -> (pi x)@[na] | None -> [na]) tml) in
+    List.fold_right mklam nal rtn)
+    rtno
+
+let abstract_return_type_context_glob_constr =
+  abstract_return_type_context (fun (_,_,nal) -> nal)
+    (fun na c ->
+      GLambda(Loc.ghost,na,Explicit,GHole(Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None),c))
+
+let abstract_return_type_context_notation_constr =
+  abstract_return_type_context snd
+    (fun na c -> NLambda(na,NHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None),c))
+
+exception No_match
+
+let rec alpha_var id1 id2 = function
+  | (i1,i2)::_ when Id.equal i1 id1 -> Id.equal i2 id2
+  | (i1,i2)::_ when Id.equal i2 id2 -> Id.equal i1 id1
+  | _::idl -> alpha_var id1 id2 idl
+  | [] -> Id.equal id1 id2
+
+let add_env alp (sigma,sigmalist,sigmabinders) var v =
+  (* Check that no capture of binding variables occur *)
+  if List.exists (fun (id,_) ->occur_glob_constr id v) alp then raise No_match;
+  (* TODO: handle the case of multiple occs in different scopes *)
+  ((var,v)::sigma,sigmalist,sigmabinders)
+
+let bind_env alp (sigma,sigmalist,sigmabinders as fullsigma) var v =
+  try
+    let v' = Id.List.assoc var sigma in
+    match v, v' with
+    | GHole _, _ -> fullsigma
+    | _, GHole _ ->
+      add_env alp (Id.List.remove_assoc var sigma,sigmalist,sigmabinders) var v
+    | _, _ ->
+        if glob_constr_eq v v' then fullsigma
+        else raise No_match
+  with Not_found -> add_env alp fullsigma var v
+
+let bind_binder (sigma,sigmalist,sigmabinders) x bl =
+  (sigma,sigmalist,(x,List.rev bl)::sigmabinders)
+
+let match_fix_kind fk1 fk2 =
+  match (fk1,fk2) with
+  | GCoFix n1, GCoFix n2 -> Int.equal n1 n2
+  | GFix (nl1,n1), GFix (nl2,n2) ->
+      let test (n1, _) (n2, _) = match n1, n2 with
+      | _, None -> true
+      | Some id1, Some id2 -> Int.equal id1 id2
+      | _ -> false
+      in
+      Int.equal n1 n2 &&
+      Array.for_all2 test nl1 nl2
+  | _ -> false
+
+let match_opt f sigma t1 t2 = match (t1,t2) with
+  | None, None -> sigma
+  | Some t1, Some t2 -> f sigma t1 t2
+  | _ -> raise No_match
+
+let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
+  | (_,Name id2) when Id.List.mem id2 (fst metas) ->
+      let rhs = match na1 with
+      | Name id1 -> GVar (Loc.ghost,id1)
+      | Anonymous -> GHole (Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None) in
+      alp, bind_env alp sigma id2 rhs
+  | (Name id1,Name id2) -> (id1,id2)::alp,sigma
+  | (Anonymous,Anonymous) -> alp,sigma
+  | _ -> raise No_match
+
+let rec match_cases_pattern_binders metas acc pat1 pat2 =
+  match (pat1,pat2) with
+  | PatVar (_,na1), PatVar (_,na2) -> match_names metas acc na1 na2
+  | PatCstr (_,c1,patl1,na1), PatCstr (_,c2,patl2,na2)
+      when eq_constructor c1 c2 && Int.equal (List.length patl1) (List.length patl2) ->
+      List.fold_left2 (match_cases_pattern_binders metas)
+	(match_names metas acc na1 na2) patl1 patl2
+  | _ -> raise No_match
+
+let glue_letin_with_decls = true
+
+let rec match_iterated_binders islambda decls = function
+  | GLambda (_,na,bk,t,b) when islambda ->
+      match_iterated_binders islambda ((na,bk,None,t)::decls) b
+  | GProd (_,(Name _ as na),bk,t,b) when not islambda ->
+      match_iterated_binders islambda ((na,bk,None,t)::decls) b
+  | GLetIn (loc,na,c,b) when glue_letin_with_decls ->
+      match_iterated_binders islambda
+	((na,Explicit (*?*), Some c,GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None))::decls) b
+  | b -> (decls,b)
+
+let remove_sigma x (sigmavar,sigmalist,sigmabinders) =
+  (Id.List.remove_assoc x sigmavar,sigmalist,sigmabinders)
+
+let match_abinderlist_with_app match_fun metas sigma rest x iter termin =
+  let rec aux sigma acc rest =
+    try
+      let sigma = match_fun (ldots_var::fst metas,snd metas) sigma rest iter in
+      let rest = Id.List.assoc ldots_var (pi1 sigma) in
+      let b =
+        match Id.List.assoc x (pi3 sigma) with [b] -> b | _ ->assert false
+      in
+      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
+      aux sigma (b::acc) rest
+    with No_match when not (List.is_empty acc) ->
+      acc, match_fun metas sigma rest termin in
+  let bl,sigma = aux sigma [] rest in
+  bind_binder sigma x bl
+
+let match_alist match_fun metas sigma rest x iter termin lassoc =
+  let rec aux sigma acc rest =
+    try
+      let sigma = match_fun (ldots_var::fst metas,snd metas) sigma rest iter in
+      let rest = Id.List.assoc ldots_var (pi1 sigma) in
+      let t = Id.List.assoc x (pi1 sigma) in
+      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
+      aux sigma (t::acc) rest
+    with No_match when not (List.is_empty acc) ->
+      acc, match_fun metas sigma rest termin in
+  let l,sigma = aux sigma [] rest in
+  (pi1 sigma, (x,if lassoc then l else List.rev l)::pi2 sigma, pi3 sigma)
+
+let does_not_come_from_already_eta_expanded_var =
+  (* This is hack to avoid looping on a rule with rhs of the form *)
+  (* "?f (fun ?x => ?g)" since otherwise, matching "F H" expands in *)
+  (* "F (fun x => H x)" and "H x" is recursively matched against the same *)
+  (* rule, giving "H (fun x' => x x')" and so on. *)
+  (* Ideally, we would need the type of the expression to know which of *)
+  (* the arguments applied to it can be eta-expanded without looping. *)
+  (* The following test is then an approximation of what can be done *)
+  (* optimally (whether other looping situations can occur remains to be *)
+  (* checked). *)
+  function GVar _ -> false | _ -> true
+
+let rec match_ inner u alp (tmetas,blmetas as metas) sigma a1 a2 =
+  match (a1,a2) with
+
+  (* Matching notation variable *)
+  | r1, NVar id2 when Id.List.mem id2 tmetas -> bind_env alp sigma id2 r1
+
+  (* Matching recursive notations for terms *)
+  | r1, NList (x,_,iter,termin,lassoc) ->
+      match_alist (match_hd u alp) metas sigma r1 x iter termin lassoc
+
+  (* Matching recursive notations for binders: ad hoc cases supporting let-in *)
+  | GLambda (_,na1,bk,t1,b1), NBinderList (x,_,NLambda (Name id2,_,b2),termin)->
+      let (decls,b) = match_iterated_binders true [(na1,bk,None,t1)] b1 in
+      (* TODO: address the possibility that termin is a Lambda itself *)
+      match_in u alp metas (bind_binder sigma x decls) b termin
+  | GProd (_,na1,bk,t1,b1), NBinderList (x,_,NProd (Name id2,_,b2),termin)
+      when na1 != Anonymous ->
+      let (decls,b) = match_iterated_binders false [(na1,bk,None,t1)] b1 in
+      (* TODO: address the possibility that termin is a Prod itself *)
+      match_in u alp metas (bind_binder sigma x decls) b termin
+  (* Matching recursive notations for binders: general case *)
+  | r, NBinderList (x,_,iter,termin) ->
+      match_abinderlist_with_app (match_hd u alp) metas sigma r x iter termin
+
+  (* Matching individual binders as part of a recursive pattern *)
+  | GLambda (_,na,bk,t,b1), NLambda (Name id,_,b2) when Id.List.mem id blmetas ->
+      match_in u alp metas (bind_binder sigma id [(na,bk,None,t)]) b1 b2
+  | GProd (_,na,bk,t,b1), NProd (Name id,_,b2)
+      when Id.List.mem id blmetas && na != Anonymous ->
+      match_in u alp metas (bind_binder sigma id [(na,bk,None,t)]) b1 b2
+
+  (* Matching compositionally *)
+  | GVar (_,id1), NVar id2 when alpha_var id1 id2 alp -> sigma
+  | GRef (_,r1,_), NRef r2 when (eq_gr r1 r2) -> sigma
+  | GPatVar (_,(_,n1)), NPatVar n2 when Id.equal n1 n2 -> sigma
+  | GApp (loc,f1,l1), NApp (f2,l2) ->
+      let n1 = List.length l1 and n2 = List.length l2 in
+      let f1,l1,f2,l2 =
+	if n1 < n2 then
+	  let l21,l22 = List.chop (n2-n1) l2 in f1,l1, NApp (f2,l21), l22
+	else if n1 > n2 then
+	  let l11,l12 = List.chop (n1-n2) l1 in GApp (loc,f1,l11),l12, f2,l2
+	else f1,l1, f2, l2 in
+      let may_use_eta = does_not_come_from_already_eta_expanded_var f1 in
+      List.fold_left2 (match_ may_use_eta u alp metas)
+        (match_in u alp metas sigma f1 f2) l1 l2
+  | GLambda (_,na1,_,t1,b1), NLambda (na2,t2,b2) ->
+     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
+  | GProd (_,na1,_,t1,b1), NProd (na2,t2,b2) ->
+     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
+  | GLetIn (_,na1,t1,b1), NLetIn (na2,t2,b2) ->
+     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
+  | GCases (_,sty1,rtno1,tml1,eqnl1), NCases (sty2,rtno2,tml2,eqnl2)
+      when sty1 == sty2
+	 && Int.equal (List.length tml1) (List.length tml2)
+	 && Int.equal (List.length eqnl1) (List.length eqnl2) ->
+      let rtno1' = abstract_return_type_context_glob_constr tml1 rtno1 in
+      let rtno2' = abstract_return_type_context_notation_constr tml2 rtno2 in
+      let sigma =
+	try Option.fold_left2 (match_in u alp metas) sigma rtno1' rtno2'
+	with Option.Heterogeneous -> raise No_match
+      in
+      let sigma = List.fold_left2
+      (fun s (tm1,_) (tm2,_) ->
+        match_in u alp metas s tm1 tm2) sigma tml1 tml2 in
+      List.fold_left2 (match_equations u alp metas) sigma eqnl1 eqnl2
+  | GLetTuple (_,nal1,(na1,to1),b1,c1), NLetTuple (nal2,(na2,to2),b2,c2)
+      when Int.equal (List.length nal1) (List.length nal2) ->
+      let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
+      let sigma = match_in u alp metas sigma b1 b2 in
+      let (alp,sigma) =
+	List.fold_left2 (match_names metas) (alp,sigma) nal1 nal2 in
+      match_in u alp metas sigma c1 c2
+  | GIf (_,a1,(na1,to1),b1,c1), NIf (a2,(na2,to2),b2,c2) ->
+      let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
+      List.fold_left2 (match_in u alp metas) sigma [a1;b1;c1] [a2;b2;c2]
+  | GRec (_,fk1,idl1,dll1,tl1,bl1), NRec (fk2,idl2,dll2,tl2,bl2)
+      when match_fix_kind fk1 fk2 && Int.equal (Array.length idl1) (Array.length idl2) &&
+	Array.for_all2 (fun l1 l2 -> Int.equal (List.length l1) (List.length l2)) dll1 dll2
+	->
+      let alp,sigma = Array.fold_left2
+	(List.fold_left2 (fun (alp,sigma) (na1,_,oc1,b1) (na2,oc2,b2) ->
+	  let sigma =
+	    match_in u alp metas
+              (match_opt (match_in u alp metas) sigma oc1 oc2) b1 b2
+	  in match_names metas (alp,sigma) na1 na2)) (alp,sigma) dll1 dll2 in
+      let sigma = Array.fold_left2 (match_in u alp metas) sigma tl1 tl2 in
+      let alp,sigma = Array.fold_right2 (fun id1 id2 alsig ->
+	match_names metas alsig (Name id1) (Name id2)) idl1 idl2 (alp,sigma) in
+      Array.fold_left2 (match_in u alp metas) sigma bl1 bl2
+  | GCast(_,c1,CastConv t1), NCast (c2,CastConv t2)
+  | GCast(_,c1,CastVM t1), NCast (c2,CastVM t2) ->
+      match_in u alp metas (match_in u alp metas sigma c1 c2) t1 t2
+  | GCast(_,c1, CastCoerce), NCast(c2, CastCoerce) ->
+      match_in u alp metas sigma c1 c2
+  | GSort (_,GType _), NSort (GType _) when not u -> sigma
+  | GSort (_,s1), NSort s2 when Miscops.glob_sort_eq s1 s2 -> sigma
+  | GPatVar _, NHole _ -> (*Don't hide Metas, they bind in ltac*) raise No_match
+  | a, NHole _ -> sigma
+
+  (* On the fly eta-expansion so as to use notations of the form
+     "exists x, P x" for "ex P"; ensure at least one constructor is
+     consumed to avoid looping; expects type not given because don't know
+     otherwise how to ensure it corresponds to a well-typed eta-expansion;
+     we make an exception for types which are metavariables: this is useful e.g.
+     to print "{x:_ & P x}" knowing that notation "{x & P x}" is not defined. *)
+  | b1, NLambda (Name id,(NHole _ | NVar _ as t2),b2) when inner ->
+      let id' = Namegen.next_ident_away id (free_glob_vars b1) in
+      let t1 = GHole(Loc.ghost,Evar_kinds.BinderType (Name id'),Misctypes.IntroAnonymous,None) in
+      let sigma = match t2 with
+      | NHole _ -> sigma
+      | NVar id2 -> bind_env alp sigma id2 t1
+      | _ -> assert false in
+      match_in u alp metas (bind_binder sigma id [(Name id',Explicit,None,t1)])
+       (mkGApp Loc.ghost b1 (GVar (Loc.ghost,id'))) b2
+
+  | (GRec _ | GEvar _), _
+  | _,_ -> raise No_match
+
+and match_in u = match_ true u
+
+and match_hd u = match_ false u
+
+and match_binders u alp metas na1 na2 sigma b1 b2 =
+  let (alp,sigma) = match_names metas (alp,sigma) na1 na2 in
+  match_in u alp metas sigma b1 b2
+
+and match_equations u alp metas sigma (_,_,patl1,rhs1) (patl2,rhs2) =
+  (* patl1 and patl2 have the same length because they respectively
+     correspond to some tml1 and tml2 that have the same length *)
+  let (alp,sigma) =
+    List.fold_left2 (match_cases_pattern_binders metas)
+      (alp,sigma) patl1 patl2 in
+  match_in u alp metas sigma rhs1 rhs2
+
+let match_notation_constr u c (metas,pat) =
+  let test (_, (_, x)) = match x with NtnTypeBinderList -> false | _ -> true in
+  let vars = List.partition test metas in
+  let vars = (List.map fst (fst vars), List.map fst (snd vars)) in
+  let terms,termlists,binders = match_ false u [] vars ([],[],[]) c pat in
+  (* Reorder canonically the substitution *)
+  let find x =
+    try Id.List.assoc x terms
+    with Not_found ->
+      (* Happens for binders bound to Anonymous *)
+      (* Find a better way to propagate Anonymous... *)
+      GVar (Loc.ghost,x) in
+  List.fold_right (fun (x,(scl,typ)) (terms',termlists',binders') ->
+    match typ with
+    | NtnTypeConstr ->
+       ((find x, scl)::terms',termlists',binders')
+    | NtnTypeConstrList ->
+       (terms',(Id.List.assoc x termlists,scl)::termlists',binders')
+    | NtnTypeBinderList ->
+       (terms',termlists',(Id.List.assoc x binders,scl)::binders'))
+    metas ([],[],[])
+
+(* Matching cases pattern *)
+let add_patterns_for_params ind l =
+  let mib,_ = Global.lookup_inductive ind in
+  let nparams = mib.Declarations.mind_nparams in
+    Util.List.addn nparams (PatVar (Loc.ghost,Anonymous)) l
+
+let bind_env_cases_pattern (sigma,sigmalist,x as fullsigma) var v =
+  try
+    let vvar = Id.List.assoc var sigma in
+    if cases_pattern_eq v vvar then fullsigma else raise No_match
+  with Not_found ->
+    (* TODO: handle the case of multiple occs in different scopes *)
+    (var,v)::sigma,sigmalist,x
+
+let rec match_cases_pattern metas sigma a1 a2 =
+ match (a1,a2) with
+  | r1, NVar id2 when Id.List.mem id2 metas -> (bind_env_cases_pattern sigma id2 r1),(0,[])
+  | PatVar (_,Anonymous), NHole _ -> sigma,(0,[])
+  | PatCstr (loc,(ind,_ as r1),largs,_), NRef (ConstructRef r2) when eq_constructor r1 r2 ->
+      sigma,(0,add_patterns_for_params (fst r1) largs)
+  | PatCstr (loc,(ind,_ as r1),args1,_), NApp (NRef (ConstructRef r2),l2)
+      when eq_constructor r1 r2 ->
+      let l1 = add_patterns_for_params (fst r1) args1 in
+      let le2 = List.length l2 in
+      if Int.equal le2 0 (* Special case of a notation for a @Cstr *) || le2 > List.length l1
+      then
+	raise No_match
+      else
+	let l1',more_args = Util.List.chop le2 l1 in
+	(List.fold_left2 (match_cases_pattern_no_more_args metas) sigma l1' l2),(le2,more_args)
+  | r1, NList (x,_,iter,termin,lassoc) ->
+      (match_alist (fun (metas,_) -> match_cases_pattern_no_more_args metas)
+	(metas,[]) (pi1 sigma,pi2 sigma,()) r1 x iter termin lassoc),(0,[])
+  | _ -> raise No_match
+
+and match_cases_pattern_no_more_args metas sigma a1 a2 =
+    match match_cases_pattern metas sigma a1 a2 with
+      |out,(_,[]) -> out
+      |_ -> raise No_match
+
+let match_ind_pattern metas sigma ind pats a2 =
+  match a2 with
+  | NRef (IndRef r2) when eq_ind ind r2 ->
+      sigma,(0,pats)
+  | NApp (NRef (IndRef r2),l2)
+      when eq_ind ind r2 ->
+      let le2 = List.length l2 in
+      if Int.equal le2 0 (* Special case of a notation for a @Cstr *) || le2 > List.length pats
+      then
+	raise No_match
+      else
+	let l1',more_args = Util.List.chop le2 pats in
+	(List.fold_left2 (match_cases_pattern_no_more_args metas) sigma l1' l2),(le2,more_args)
+  |_ -> raise No_match
+
+let reorder_canonically_substitution terms termlists metas =
+  List.fold_right (fun (x,(scl,typ)) (terms',termlists') ->
+    match typ with
+      | NtnTypeConstr -> ((Id.List.assoc x terms, scl)::terms',termlists')
+      | NtnTypeConstrList -> (terms',(Id.List.assoc x termlists,scl)::termlists')
+      | NtnTypeBinderList -> assert false)
+    metas ([],[])
+
+let match_notation_constr_cases_pattern c (metas,pat) =
+  let vars = List.map fst metas in
+  let (terms,termlists,()),more_args = match_cases_pattern vars ([],[],()) c pat in
+  reorder_canonically_substitution terms termlists metas, more_args
+
+let match_notation_constr_ind_pattern ind args (metas,pat) =
+  let vars = List.map fst metas in
+  let (terms,termlists,()),more_args = match_ind_pattern vars ([],[],()) ind args pat in
+  reorder_canonically_substitution terms termlists metas, more_args
diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli
new file mode 100644
index 00000000..7283ed6f
--- /dev/null
+++ b/interp/notation_ops.mli
@@ -0,0 +1,61 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Notation_term
+open Glob_term
+
+(** Utilities about [notation_constr] *)
+
+(** Translate a [glob_constr] into a notation given the list of variables
+    bound by the notation; also interpret recursive patterns           *)
+
+val notation_constr_of_glob_constr : notation_interp_env ->
+  glob_constr -> notation_constr
+
+(** Name of the special identifier used to encode recursive notations  *)
+val ldots_var : Id.t
+
+(** Equality of [glob_constr] (warning: only partially implemented) *)
+(** FIXME: nothing to do here *)
+val eq_glob_constr : glob_constr -> glob_constr -> bool
+
+(** Re-interpret a notation as a [glob_constr], taking care of binders     *)
+
+val glob_constr_of_notation_constr_with_binders : Loc.t ->
+  ('a -> Name.t -> 'a * Name.t) ->
+  ('a -> notation_constr -> glob_constr) ->
+  'a -> notation_constr -> glob_constr
+
+val glob_constr_of_notation_constr : Loc.t -> notation_constr -> glob_constr
+
+(** [match_notation_constr] matches a [glob_constr] against a notation
+    interpretation; raise [No_match] if the matching fails   *)
+
+exception No_match
+
+val match_notation_constr : bool -> glob_constr -> interpretation ->
+      (glob_constr * subscopes) list * (glob_constr list * subscopes) list *
+      (glob_decl list * subscopes) list
+
+val match_notation_constr_cases_pattern :
+  cases_pattern -> interpretation ->
+  ((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
+    (int * cases_pattern list)
+
+val match_notation_constr_ind_pattern :
+  inductive -> cases_pattern  list -> interpretation ->
+  ((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
+    (int * cases_pattern list)
+
+(** Substitution of kernel names in interpretation data                *)
+
+val subst_interpretation :
+  Mod_subst.substitution -> interpretation -> interpretation
+
+val add_patterns_for_params : inductive -> cases_pattern list -> cases_pattern list
diff --git a/interp/ppextend.ml b/interp/ppextend.ml
index f244c4da..cb12b98a 100644
--- a/interp/ppextend.ml
+++ b/interp/ppextend.ml
@@ -1,16 +1,12 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i*)
 open Pp
-open Util
-open Names
-(*i*)
 
 (*s Pretty-print. *)
 
diff --git a/interp/ppextend.mli b/interp/ppextend.mli
index f3dcda8c..0385eea2 100644
--- a/interp/ppextend.mli
+++ b/interp/ppextend.mli
@@ -1,13 +1,12 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
 open Pp
-open Names
 
 (** {6 Pretty-print. } *)
 
diff --git a/interp/reserve.ml b/interp/reserve.ml
index 88d3546f..3100298e 100644
--- a/interp/reserve.ml
+++ b/interp/reserve.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,57 +8,89 @@
 
 (* Reserved names *)
 
+open Errors
 open Util
 open Pp
 open Names
 open Nameops
-open Summary
 open Libobject
 open Lib
-open Topconstr
-open Libnames
+open Notation_term
+open Notation_ops
+open Globnames
 
 type key =
   | RefKey of global_reference
   | Oth
 
-let reserve_table = ref Idmap.empty
-let reserve_revtable = ref Gmapl.empty
+(** TODO: share code from Notation *)
 
-let aconstr_key = function (* Rem: AApp(ARef ref,[]) stands for @ref *)
-  | AApp (ARef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
-  | AList (_,_,AApp (ARef ref,args),_,_)
-  | ABinderList (_,_,AApp (ARef ref,args),_) -> RefKey (canonical_gr ref), Some (List.length args)
-  | ARef ref -> RefKey(canonical_gr ref), None
+let key_compare k1 k2 = match k1, k2 with
+| RefKey gr1, RefKey gr2 -> RefOrdered.compare gr1 gr2
+| RefKey _, Oth -> -1
+| Oth, RefKey _ -> 1
+| Oth, Oth -> 0
+
+module KeyOrd = struct type t = key let compare = key_compare end
+module KeyMap = Map.Make(KeyOrd)
+
+module ReservedSet :
+sig
+  type t
+  val empty : t
+  val add : (Id.t * notation_constr) -> t -> t
+  val find : (Id.t -> notation_constr -> bool) -> t -> Id.t * notation_constr
+end =
+struct
+  type t = (Id.t * notation_constr) list
+
+  let empty = []
+
+  let rec mem id c = function
+  | [] -> false
+  | (id', c') :: l ->
+    if c == c' && Id.equal id id' then true else mem id c l
+
+  let add p l =
+    let (id, c) = p in
+    if mem id c l then l else p :: l
+
+  let rec find f = function
+  | [] -> raise Not_found
+  | (id, c) as p :: l -> if f id c then p else find f l
+end
+
+
+let keymap_add key data map =
+  let old = try KeyMap.find key map with Not_found -> ReservedSet.empty in
+  KeyMap.add key (ReservedSet.add data old) map
+
+let reserve_table = Summary.ref Id.Map.empty ~name:"reserved-type"
+let reserve_revtable = Summary.ref KeyMap.empty ~name:"reserved-type-rev"
+
+let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *)
+  | NApp (NRef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
+  | NList (_,_,NApp (NRef ref,args),_,_)
+  | NBinderList (_,_,NApp (NRef ref,args),_) -> RefKey (canonical_gr ref), Some (List.length args)
+  | NRef ref -> RefKey(canonical_gr ref), None
   | _ -> Oth, None
 
 let cache_reserved_type (_,(id,t)) =
-  let key = fst (aconstr_key t) in
-  reserve_table := Idmap.add id t !reserve_table;
-  reserve_revtable := Gmapl.add key (t,id) !reserve_revtable
+  let key = fst (notation_constr_key t) in
+  reserve_table := Id.Map.add id t !reserve_table;
+  reserve_revtable := keymap_add key (id, t) !reserve_revtable
 
-let in_reserved : identifier * aconstr -> obj =
+let in_reserved : Id.t * notation_constr -> obj =
   declare_object {(default_object "RESERVED-TYPE") with
     cache_function = cache_reserved_type }
 
-let freeze_reserved () = (!reserve_table,!reserve_revtable)
-let unfreeze_reserved (r,rr) = reserve_table := r; reserve_revtable := rr
-let init_reserved () =
-  reserve_table := Idmap.empty; reserve_revtable := Gmapl.empty
-
-let _ =
-  Summary.declare_summary "reserved-type"
-    { Summary.freeze_function = freeze_reserved;
-      Summary.unfreeze_function = unfreeze_reserved;
-      Summary.init_function = init_reserved }
-
 let declare_reserved_type_binding (loc,id) t =
-  if id <> root_of_id id then
+  if not (Id.equal id (root_of_id id)) then
     user_err_loc(loc,"declare_reserved_type",
     (pr_id id ++ str
       " is not reservable: it must have no trailing digits, quote, or _"));
   begin try
-    let _ = Idmap.find id !reserve_table in
+    let _ = Id.Map.find id !reserve_table in
     user_err_loc(loc,"declare_reserved_type",
     (pr_id id++str" is already bound to a type"))
   with Not_found -> () end;
@@ -67,7 +99,7 @@ let declare_reserved_type_binding (loc,id) t =
 let declare_reserved_type idl t =
   List.iter (fun id -> declare_reserved_type_binding id t) (List.rev idl)
 
-let find_reserved_type id = Idmap.find (root_of_id id) !reserve_table
+let find_reserved_type id = Id.Map.find (root_of_id id) !reserve_table
 
 let constr_key c =
   try RefKey (canonical_gr (global_of_constr (fst (Term.decompose_app c))))
@@ -75,25 +107,18 @@ let constr_key c =
 
 let revert_reserved_type t =
   try
-    let l = Gmapl.find (constr_key t) !reserve_revtable in
-    let t = Detyping.detype false [] [] t in
-    list_try_find
-      (fun (pat,id) ->
-	try let _ = match_aconstr false t ([],pat) in Name id
-	with No_match -> failwith "") l
+    let reserved = KeyMap.find (constr_key t) !reserve_revtable in
+    let t = Detyping.detype false [] (Global.env()) Evd.empty t in
+    (* pedrot: if [Notation_ops.match_notation_constr] may raise [Failure _]
+        then I've introduced a bug... *)
+    let filter _ pat =
+      try
+        let _ = match_notation_constr false t ([], pat) in
+        true
+      with No_match -> false
+    in
+    let (id, _) = ReservedSet.find filter reserved in
+    Name id
   with Not_found | Failure _ -> Anonymous
 
 let _ = Namegen.set_reserved_typed_name revert_reserved_type
-
-open Glob_term
-
-let anonymize_if_reserved na t = match na with
-  | Name id as na ->
-      (try
-	if not !Flags.raw_print &
-	   (try aconstr_of_glob_constr [] [] t = find_reserved_type id
-            with UserError _ -> false)
-	then GHole (dummy_loc,Evd.BinderType na)
-	else t
-      with Not_found -> t)
-  | Anonymous -> t
diff --git a/interp/reserve.mli b/interp/reserve.mli
index 4d7685e3..6cae2b02 100644
--- a/interp/reserve.mli
+++ b/interp/reserve.mli
@@ -1,16 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Util
+open Loc
 open Names
-open Glob_term
-open Topconstr
+open Notation_term
 
-val declare_reserved_type : identifier located list -> aconstr -> unit
-val find_reserved_type : identifier -> aconstr
-val anonymize_if_reserved : name -> glob_constr -> glob_constr
+val declare_reserved_type : Id.t located list -> notation_constr -> unit
+val find_reserved_type : Id.t -> notation_constr
diff --git a/interp/smartlocate.ml b/interp/smartlocate.ml
index 5779231d..ce3c9b8f 100644
--- a/interp/smartlocate.ml
+++ b/interp/smartlocate.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -13,23 +13,38 @@
 
 (* *)
 open Pp
-open Util
-open Names
+open Errors
 open Libnames
-open Genarg
+open Globnames
+open Misctypes
 open Syntax_def
-open Topconstr
+open Notation_term
+
+let global_of_extended_global_head = function
+  | TrueGlobal ref -> ref
+  | SynDef kn ->
+      let _, syn_def = search_syntactic_definition kn in
+      let rec head_of = function
+        | NRef ref -> ref
+        | NApp (rc, _) -> head_of rc
+        | NCast (rc, _) -> head_of rc
+        | NLetIn (_, _, rc) -> head_of rc
+        | _ -> raise Not_found in
+      head_of syn_def
 
 let global_of_extended_global = function
   | TrueGlobal ref -> ref
   | SynDef kn ->
   match search_syntactic_definition kn with
-  | [],ARef ref -> ref
+  | [],NRef ref -> ref
+  | [],NApp (NRef ref,[]) -> ref
   | _ -> raise Not_found
 
-let locate_global_with_alias (loc,qid) =
+let locate_global_with_alias ?(head=false) (loc,qid) =
   let ref = Nametab.locate_extended qid in
-  try global_of_extended_global ref
+  try
+    if head then global_of_extended_global_head ref
+    else global_of_extended_global ref
   with Not_found ->
     user_err_loc (loc,"",pr_qualid qid ++
       str " is bound to a notation that does not denote a reference.")
@@ -43,14 +58,14 @@ let global_inductive_with_alias r =
         pr_reference r ++ spc () ++ str "is not an inductive type.")
   with Not_found -> Nametab.error_global_not_found_loc loc qid
 
-let global_with_alias r =
+let global_with_alias ?head r =
   let (loc,qid as lqid) = qualid_of_reference r in
-  try locate_global_with_alias lqid
+  try locate_global_with_alias ?head lqid
   with Not_found -> Nametab.error_global_not_found_loc loc qid
 
-let smart_global = function
+let smart_global ?head = function
   | AN r ->
-      global_with_alias r
+      global_with_alias ?head r
   | ByNotation (loc,ntn,sc) ->
       Notation.interp_notation_as_global_reference loc (fun _ -> true) ntn sc
 
@@ -60,3 +75,7 @@ let smart_global_inductive = function
   | ByNotation (loc,ntn,sc) ->
       destIndRef
         (Notation.interp_notation_as_global_reference loc isIndRef ntn sc)
+
+let loc_of_smart_reference = function
+  | AN r -> loc_of_reference r
+  | ByNotation (loc,_,_) -> loc
diff --git a/interp/smartlocate.mli b/interp/smartlocate.mli
index 589505c3..68ef6594 100644
--- a/interp/smartlocate.mli
+++ b/interp/smartlocate.mli
@@ -1,35 +1,41 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Util
+open Loc
 open Names
 open Libnames
-open Genarg
+open Globnames
+open Misctypes
 
 (** [locate_global_with_alias] locates global reference possibly following
-   a notation if this notation has a role of aliasing; raise Not_found
-   if not bound in the global env; raise an error if bound to a
+   a notation if this notation has a role of aliasing; raise [Not_found]
+   if not bound in the global env; raise a [UserError] if bound to a
    syntactic def that does not denote a reference *)
 
-val locate_global_with_alias : qualid located -> global_reference
+val locate_global_with_alias : ?head:bool -> qualid located -> global_reference
 
 (** Extract a global_reference from a reference that can be an "alias" *)
 val global_of_extended_global : extended_global_reference -> global_reference
 
-(** Locate a reference taking into account possible "alias" notations *)
-val global_with_alias : reference -> global_reference
+(** Locate a reference taking into account possible "alias" notations.
+    May raise [Nametab.GlobalizationError _] for an unknown reference,
+    or a [UserError] if bound to a syntactic def that does not denote
+    a reference. *)
+val global_with_alias : ?head:bool -> reference -> global_reference
 
 (** The same for inductive types *)
 val global_inductive_with_alias : reference -> inductive
 
 (** Locate a reference taking into account notations and "aliases" *)
-val smart_global : reference or_by_notation -> global_reference
+val smart_global : ?head:bool -> reference or_by_notation -> global_reference
 
 (** The same for inductive types *)
 val smart_global_inductive : reference or_by_notation -> inductive
 
+(** Return the loc of a smart reference *)
+val loc_of_smart_reference : reference or_by_notation -> Loc.t
diff --git a/interp/stdarg.ml b/interp/stdarg.ml
new file mode 100644
index 00000000..e155a521
--- /dev/null
+++ b/interp/stdarg.ml
@@ -0,0 +1,30 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Genarg
+
+let wit_unit : unit uniform_genarg_type =
+  make0 None "unit"
+
+let wit_bool : bool uniform_genarg_type =
+  make0 None "bool"
+
+let wit_int : int uniform_genarg_type =
+  make0 None "int"
+
+let wit_string : string uniform_genarg_type =
+  make0 None "string"
+
+let wit_pre_ident : string uniform_genarg_type =
+  make0 None "preident"
+
+let () = register_name0 wit_unit "Stdarg.wit_unit"
+let () = register_name0 wit_bool "Stdarg.wit_bool"
+let () = register_name0 wit_int "Stdarg.wit_int"
+let () = register_name0 wit_string "Stdarg.wit_string"
+let () = register_name0 wit_pre_ident "Stdarg.wit_pre_ident"
diff --git a/interp/stdarg.mli b/interp/stdarg.mli
new file mode 100644
index 00000000..5a44b1ca
--- /dev/null
+++ b/interp/stdarg.mli
@@ -0,0 +1,21 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Basic generic arguments. *)
+
+open Genarg
+
+val wit_unit : unit uniform_genarg_type
+
+val wit_bool : bool uniform_genarg_type
+
+val wit_int : int uniform_genarg_type
+
+val wit_string : string uniform_genarg_type
+
+val wit_pre_ident : string uniform_genarg_type
diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml
index da29c5e0..9be7abcf 100644
--- a/interp/syntax_def.ml
+++ b/interp/syntax_def.ml
@@ -1,16 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Errors
 open Util
 open Pp
 open Names
 open Libnames
-open Topconstr
+open Notation_term
 open Libobject
 open Lib
 open Nameops
@@ -20,13 +21,9 @@ open Nametab
 
 type version = Flags.compat_version option
 
-let syntax_table = ref (KNmap.empty : (interpretation*version) KNmap.t)
-
-let _ = Summary.declare_summary
-	  "SYNTAXCONSTANT"
-	  { Summary.freeze_function = (fun () -> !syntax_table);
-	    Summary.unfreeze_function = (fun ft -> syntax_table := ft);
-	    Summary.init_function = (fun () -> syntax_table := KNmap.empty) }
+let syntax_table =
+  Summary.ref (KNmap.empty : (interpretation*version) KNmap.t)
+    ~name:"SYNTAXCONSTANT"
 
 let add_syntax_constant kn c onlyparse =
   syntax_table := KNmap.add kn (c,onlyparse) !syntax_table
@@ -39,19 +36,21 @@ let load_syntax_constant i ((sp,kn),(_,pat,onlyparse)) =
   Nametab.push_syndef (Nametab.Until i) sp kn
 
 let is_alias_of_already_visible_name sp = function
-  | _,ARef ref ->
-      let (dir,id) = repr_qualid (shortest_qualid_of_global Idset.empty ref) in
-      dir = empty_dirpath && id = basename sp
+  | _,NRef ref ->
+      let (dir,id) = repr_qualid (shortest_qualid_of_global Id.Set.empty ref) in
+      DirPath.is_empty dir && Id.equal id (basename sp)
   | _ ->
       false
 
 let open_syntax_constant i ((sp,kn),(_,pat,onlyparse)) =
   if not (is_alias_of_already_visible_name sp pat) then begin
     Nametab.push_syndef (Nametab.Exactly i) sp kn;
-    if onlyparse = None then
+    match onlyparse with
+    | None ->
       (* Redeclare it to be used as (short) name in case an other (distfix)
 	 notation was declared inbetween *)
       Notation.declare_uninterpretation (Notation.SynDefRule kn) pat
+    | _ -> ()
   end
 
 let cache_syntax_constant d =
@@ -59,7 +58,7 @@ let cache_syntax_constant d =
   open_syntax_constant 1 d
 
 let subst_syntax_constant (subst,(local,pat,onlyparse)) =
-  (local,subst_interpretation subst pat,onlyparse)
+  (local,Notation_ops.subst_interpretation subst pat,onlyparse)
 
 let classify_syntax_constant (local,_,_ as o) =
   if local then Dispose else Substitute o
@@ -73,7 +72,7 @@ let in_syntax_constant
     subst_function = subst_syntax_constant;
     classify_function = classify_syntax_constant }
 
-type syndef_interpretation = (identifier * subscopes) list * aconstr
+type syndef_interpretation = (Id.t * subscopes) list * notation_constr
 
 (* Coercions to the general format of notation that also supports
    variables bound to list of expressions *)
@@ -83,8 +82,7 @@ let out_pat (ids,ac) = (List.map (fun (id,(sc,typ)) -> (id,sc)) ids,ac)
 let declare_syntactic_definition local id onlyparse pat =
   let _ = add_leaf id (in_syntax_constant (local,in_pat pat,onlyparse)) in ()
 
-let pr_global r = pr_global_env Idset.empty r
-let pr_syndef kn = pr_qualid (shortest_qualid_of_syndef Idset.empty kn)
+let pr_syndef kn = pr_qualid (shortest_qualid_of_syndef Id.Set.empty kn)
 
 let allow_compat_notations = ref true
 let verbose_compat_notations = ref false
@@ -98,7 +96,7 @@ let verbose_compat kn def = function
       if !verbose_compat_notations then msg_warning else errorlabstrm ""
     in
     let pp_def = match def with
-      | [], ARef r -> str " is " ++ pr_global_env Idset.empty r
+      | [], NRef r -> str " is " ++ pr_global_env Id.Set.empty r
       | _ -> str " is a compatibility notation"
     in
     let since = str (" since Coq > " ^ Flags.pr_version v ^ ".") in
diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli
index 338538a9..e5a3f4ce 100644
--- a/interp/syntax_def.mli
+++ b/interp/syntax_def.mli
@@ -1,23 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Util
 open Names
-open Topconstr
-open Glob_term
-open Nametab
-open Libnames
+open Notation_term
 
 (** Syntactic definitions. *)
 
-type syndef_interpretation = (identifier * subscopes) list * aconstr
+type syndef_interpretation = (Id.t * subscopes) list * notation_constr
 
-val declare_syntactic_definition : bool -> identifier ->
+val declare_syntactic_definition : bool -> Id.t ->
   Flags.compat_version option -> syndef_interpretation -> unit
 
 val search_syntactic_definition : kernel_name -> syndef_interpretation
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index ff49fb73..1231f115 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,921 +8,26 @@
 
 (*i*)
 open Pp
+open Errors
 open Util
 open Names
 open Nameops
 open Libnames
-open Glob_term
-open Term
-open Mod_subst
+open Misctypes
+open Constrexpr
+open Constrexpr_ops
 (*i*)
 
-(**********************************************************************)
-(* This is the subtype of glob_constr allowed in syntactic extensions *)
-
-(* For AList: first constr is iterator, second is terminator;
-   first id is where each argument of the list has to be substituted
-   in iterator and snd id is alternative name just for printing;
-   boolean is associativity *)
-
-type aconstr =
-  (* Part common to glob_constr and cases_pattern *)
-  | ARef of global_reference
-  | AVar of identifier
-  | AApp of aconstr * aconstr list
-  | AList of identifier * identifier * aconstr * aconstr * bool
-  (* Part only in glob_constr *)
-  | ALambda of name * aconstr * aconstr
-  | AProd of name * aconstr * aconstr
-  | ABinderList of identifier * identifier * aconstr * aconstr
-  | ALetIn of name * aconstr * aconstr
-  | ACases of case_style * aconstr option *
-      (aconstr * (name * (inductive * int * name list) option)) list *
-      (cases_pattern list * aconstr) list
-  | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
-  | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
-  | ARec of fix_kind * identifier array *
-      (name * aconstr option * aconstr) list array * aconstr array *
-      aconstr array
-  | ASort of glob_sort
-  | AHole of Evd.hole_kind
-  | APatVar of patvar
-  | ACast of aconstr * aconstr cast_type
-
-type scope_name = string
-
-type tmp_scope_name = scope_name
-
-type subscopes = tmp_scope_name option * scope_name list
-
-type notation_var_instance_type =
-  | NtnTypeConstr | NtnTypeConstrList | NtnTypeBinderList
-
-type notation_var_internalization_type =
-  | NtnInternTypeConstr | NtnInternTypeBinder | NtnInternTypeIdent
-
-type interpretation =
-    (identifier * (subscopes * notation_var_instance_type)) list * aconstr
-
-(**********************************************************************)
-(* Re-interpret a notation as a glob_constr, taking care of binders     *)
-
-let name_to_ident = function
-  | Anonymous -> error "This expression should be a simple identifier."
-  | Name id -> id
-
-let to_id g e id = let e,na = g e (Name id) in e,name_to_ident na
-
-let rec cases_pattern_fold_map loc g e = function
-  | PatVar (_,na) ->
-      let e',na' = g e na in e', PatVar (loc,na')
-  | PatCstr (_,cstr,patl,na) ->
-      let e',na' = g e na in
-      let e',patl' = list_fold_map (cases_pattern_fold_map loc g) e patl in
-      e', PatCstr (loc,cstr,patl',na')
-
-let rec subst_glob_vars l = function
-  | GVar (_,id) as r -> (try List.assoc id l with Not_found -> r)
-  | GProd (loc,Name id,bk,t,c) ->
-      let id =
-	try match List.assoc id l with GVar(_,id') -> id' | _ -> id
-	with Not_found -> id in
-      GProd (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
-  | GLambda (loc,Name id,bk,t,c) ->
-      let id =
-	try match List.assoc id l with GVar(_,id') -> id' | _ -> id
-	with Not_found -> id in
-      GLambda (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
-  | r -> map_glob_constr (subst_glob_vars l) r (* assume: id is not binding *)
-
-let ldots_var = id_of_string ".."
-
-let glob_constr_of_aconstr_with_binders loc g f e = function
-  | AVar id -> GVar (loc,id)
-  | AApp (a,args) -> GApp (loc,f e a, List.map (f e) args)
-  | AList (x,y,iter,tail,swap) ->
-      let t = f e tail in let it = f e iter in
-      let innerl = (ldots_var,t)::(if swap then [] else [x,GVar(loc,y)]) in
-      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
-      let outerl = (ldots_var,inner)::(if swap then [x,GVar(loc,y)] else []) in
-      subst_glob_vars outerl it
-  | ABinderList (x,y,iter,tail) ->
-      let t = f e tail in let it = f e iter in
-      let innerl = [(ldots_var,t);(x,GVar(loc,y))] in
-      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
-      let outerl = [(ldots_var,inner)] in
-      subst_glob_vars outerl it
-  | ALambda (na,ty,c) ->
-      let e',na = g e na in GLambda (loc,na,Explicit,f e ty,f e' c)
-  | AProd (na,ty,c) ->
-      let e',na = g e na in GProd (loc,na,Explicit,f e ty,f e' c)
-  | ALetIn (na,b,c) ->
-      let e',na = g e na in GLetIn (loc,na,f e b,f e' c)
-  | ACases (sty,rtntypopt,tml,eqnl) ->
-      let e',tml' = List.fold_right (fun (tm,(na,t)) (e',tml') ->
-	let e',t' = match t with
-	| None -> e',None
-	| Some (ind,npar,nal) ->
-	  let e',nal' = List.fold_right (fun na (e',nal) ->
-	      let e',na' = g e' na in e',na'::nal) nal (e',[]) in
-	  e',Some (loc,ind,npar,nal') in
-	let e',na' = g e' na in
-	(e',(f e tm,(na',t'))::tml')) tml (e,[]) in
-      let fold (idl,e) na = let (e,na) = g e na in ((name_cons na idl,e),na) in
-      let eqnl' = List.map (fun (patl,rhs) ->
-	let ((idl,e),patl) =
-	  list_fold_map (cases_pattern_fold_map loc fold) ([],e) patl in
-	(loc,idl,patl,f e rhs)) eqnl in
-      GCases (loc,sty,Option.map (f e') rtntypopt,tml',eqnl')
-  | ALetTuple (nal,(na,po),b,c) ->
-      let e',nal = list_fold_map g e nal in
-      let e'',na = g e na in
-      GLetTuple (loc,nal,(na,Option.map (f e'') po),f e b,f e' c)
-  | AIf (c,(na,po),b1,b2) ->
-      let e',na = g e na in
-      GIf (loc,f e c,(na,Option.map (f e') po),f e b1,f e b2)
-  | ARec (fk,idl,dll,tl,bl) ->
-      let e,dll = array_fold_map (list_fold_map (fun e (na,oc,b) ->
-	  let e,na = g e na in
-	  (e,(na,Explicit,Option.map (f e) oc,f e b)))) e dll in
-      let e',idl = array_fold_map (to_id g) e idl in
-      GRec (loc,fk,idl,dll,Array.map (f e) tl,Array.map (f e') bl)
-  | ACast (c,k) -> GCast (loc,f e c,
-			  match k with
-			    | CastConv (k,t) -> CastConv (k,f e t)
-			    | CastCoerce -> CastCoerce)
-  | ASort x -> GSort (loc,x)
-  | AHole x  -> GHole (loc,x)
-  | APatVar n -> GPatVar (loc,(false,n))
-  | ARef x -> GRef (loc,x)
-
-let rec glob_constr_of_aconstr loc x =
-  let rec aux () x =
-    glob_constr_of_aconstr_with_binders loc (fun () id -> ((),id)) aux () x
-  in aux () x
-
-(****************************************************************************)
-(* Translating a glob_constr into a notation, interpreting recursive patterns *)
-
-let add_id r id = r := (id :: pi1 !r, pi2 !r, pi3 !r)
-let add_name r = function Anonymous -> () | Name id -> add_id r id
-
-let split_at_recursive_part c =
-  let sub = ref None in
-  let rec aux = function
-  | GApp (loc0,GVar(loc,v),c::l) when v = ldots_var ->
-      if !sub <> None then
-	(* Not narrowed enough to find only one recursive part *)
-	raise Not_found
-      else
-	(sub := Some c;
-	 if l = [] then GVar (loc,ldots_var)
-	 else GApp (loc0,GVar (loc,ldots_var),l))
-  | c -> map_glob_constr aux c in
-  let outer_iterator = aux c in
-  match !sub with
-  | None -> (* No recursive pattern found *) raise Not_found
-  | Some c ->
-  match outer_iterator with
-  | GVar (_,v) when v = ldots_var -> (* Not enough context *) raise Not_found
-  | _ -> outer_iterator, c
-
-let on_true_do b f c = if b then (f c; b) else b
-
-let compare_glob_constr f add t1 t2 = match t1,t2 with
-  | GRef (_,r1), GRef (_,r2) -> eq_gr r1 r2
-  | GVar (_,v1), GVar (_,v2) -> on_true_do (v1 = v2) add (Name v1)
-  | GApp (_,f1,l1), GApp (_,f2,l2) -> f f1 f2 & list_for_all2eq f l1 l2
-  | GLambda (_,na1,bk1,ty1,c1), GLambda (_,na2,bk2,ty2,c2) when na1 = na2 && bk1 = bk2 -> on_true_do (f ty1 ty2 & f c1 c2) add na1
-  | GProd (_,na1,bk1,ty1,c1), GProd (_,na2,bk2,ty2,c2) when na1 = na2 && bk1 = bk2 ->
-      on_true_do (f ty1 ty2 & f c1 c2) add na1
-  | GHole _, GHole _ -> true
-  | GSort (_,s1), GSort (_,s2) -> s1 = s2
-  | GLetIn (_,na1,b1,c1), GLetIn (_,na2,b2,c2) when na1 = na2 ->
-      on_true_do (f b1 b2 & f c1 c2) add na1
-  | (GCases _ | GRec _
-    | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _),_
-  | _,(GCases _ | GRec _
-      | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _)
-      -> error "Unsupported construction in recursive notations."
-  | (GRef _ | GVar _ | GApp _ | GLambda _ | GProd _
-    | GHole _ | GSort _ | GLetIn _), _
-      -> false
-
-let rec eq_glob_constr t1 t2 = compare_glob_constr eq_glob_constr (fun _ -> ()) t1 t2
-
-let subtract_loc loc1 loc2 = make_loc (fst (unloc loc1),fst (unloc loc2)-1)
-
-let check_is_hole id = function GHole _ -> () | t ->
-  user_err_loc (loc_of_glob_constr t,"",
-    strbrk "In recursive notation with binders, " ++ pr_id id ++
-    strbrk " is expected to come without type.")
-
-let compare_recursive_parts found f (iterator,subc) =
-  let diff = ref None in
-  let terminator = ref None in
-  let rec aux c1 c2 = match c1,c2 with
-  | GVar(_,v), term when v = ldots_var ->
-      (* We found the pattern *)
-      assert (!terminator = None); terminator := Some term;
-      true
-  | GApp (_,GVar(_,v),l1), GApp (_,term,l2) when v = ldots_var ->
-      (* We found the pattern, but there are extra arguments *)
-      (* (this allows e.g. alternative (recursive) notation of application) *)
-      assert (!terminator = None); terminator := Some term;
-      list_for_all2eq aux l1 l2
-  | GVar (_,x), GVar (_,y) when x<>y ->
-      (* We found the position where it differs *)
-      let lassoc = (!terminator <> None) in
-      let x,y = if lassoc then y,x else x,y in
-      !diff = None && (diff := Some (x,y,Some lassoc); true)
-  | GLambda (_,Name x,_,t_x,c), GLambda (_,Name y,_,t_y,term)
-  | GProd (_,Name x,_,t_x,c), GProd (_,Name y,_,t_y,term) ->
-      (* We found a binding position where it differs *)
-      check_is_hole x t_x;
-      check_is_hole y t_y;
-      !diff = None && (diff := Some (x,y,None); aux c term)
-  | _ ->
-      compare_glob_constr aux (add_name found) c1 c2 in
-  if aux iterator subc then
-    match !diff with
-    | None ->
-	let loc1 = loc_of_glob_constr iterator in
-	let loc2 = loc_of_glob_constr (Option.get !terminator) in
-	(* Here, we would need a loc made of several parts ... *)
-	user_err_loc (subtract_loc loc1 loc2,"",
-          str "Both ends of the recursive pattern are the same.")
-    | Some (x,y,Some lassoc) ->
-	let newfound = (pi1 !found, (x,y) :: pi2 !found, pi3 !found) in
-	let iterator =
-	  f (if lassoc then subst_glob_vars [y,GVar(dummy_loc,x)] iterator
-	  else iterator) in
-	(* found have been collected by compare_constr *)
-	found := newfound;
-	AList (x,y,iterator,f (Option.get !terminator),lassoc)
-    | Some (x,y,None) ->
-	let newfound = (pi1 !found, pi2 !found, (x,y) :: pi3 !found) in
-	let iterator = f iterator in
-	(* found have been collected by compare_constr *)
-	found := newfound;
-	ABinderList (x,y,iterator,f (Option.get !terminator))
-  else
-    raise Not_found
-
-let aconstr_and_vars_of_glob_constr a =
-  let found = ref ([],[],[]) in
-  let rec aux c =
-    let keepfound = !found in
-    (* n^2 complexity but small and done only once per notation *)
-    try compare_recursive_parts found aux' (split_at_recursive_part c)
-    with Not_found ->
-    found := keepfound;
-    match c with
-    | GApp (_,GVar (loc,f),[c]) when f = ldots_var ->
-	(* Fall on the second part of the recursive pattern w/o having
-	   found the first part *)
-	user_err_loc (loc,"",
-	str "Cannot find where the recursive pattern starts.")
-    | c ->
-	aux' c
-  and aux' = function
-  | GVar (_,id) -> add_id found id; AVar id
-  | GApp (_,g,args) -> AApp (aux g, List.map aux args)
-  | GLambda (_,na,bk,ty,c) -> add_name found na; ALambda (na,aux ty,aux c)
-  | GProd (_,na,bk,ty,c) -> add_name found na; AProd (na,aux ty,aux c)
-  | GLetIn (_,na,b,c) -> add_name found na; ALetIn (na,aux b,aux c)
-  | GCases (_,sty,rtntypopt,tml,eqnl) ->
-      let f (_,idl,pat,rhs) = List.iter (add_id found) idl; (pat,aux rhs) in
-      ACases (sty,Option.map aux rtntypopt,
-        List.map (fun (tm,(na,x)) ->
-	  add_name found na;
-	  Option.iter
-	    (fun (_,_,_,nl) -> List.iter (add_name found) nl) x;
-          (aux tm,(na,Option.map (fun (_,ind,n,nal) -> (ind,n,nal)) x))) tml,
-        List.map f eqnl)
-  | GLetTuple (loc,nal,(na,po),b,c) ->
-      add_name found na;
-      List.iter (add_name found) nal;
-      ALetTuple (nal,(na,Option.map aux po),aux b,aux c)
-  | GIf (loc,c,(na,po),b1,b2) ->
-      add_name found na;
-      AIf (aux c,(na,Option.map aux po),aux b1,aux b2)
-  | GRec (_,fk,idl,dll,tl,bl) ->
-      Array.iter (add_id found) idl;
-      let dll = Array.map (List.map (fun (na,bk,oc,b) ->
-	 if bk <> Explicit then
-	   error "Binders marked as implicit not allowed in notations.";
-	 add_name found na; (na,Option.map aux oc,aux b))) dll in
-      ARec (fk,idl,dll,Array.map aux tl,Array.map aux bl)
-  | GCast (_,c,k) -> ACast (aux c,
-			    match k with CastConv (k,t) -> CastConv (k,aux t)
-			      | CastCoerce -> CastCoerce)
-  | GSort (_,s) -> ASort s
-  | GHole (_,w) -> AHole w
-  | GRef (_,r) -> ARef r
-  | GPatVar (_,(_,n)) -> APatVar n
-  | GEvar _ ->
-      error "Existential variables not allowed in notations."
-
-  in
-  let t = aux a in
-  (* Side effect *)
-  t, !found
-
-let rec list_rev_mem_assoc x = function
-  | [] -> false
-  | (_,x')::l -> x = x' || list_rev_mem_assoc x l
-
-let check_variables vars recvars (found,foundrec,foundrecbinding) =
-  let useless_vars = List.map snd recvars in
-  let vars = List.filter (fun (y,_) -> not (List.mem y useless_vars)) vars in
-  let check_recvar x =
-    if List.mem x found then
-      errorlabstrm "" (pr_id x ++
-	strbrk " should only be used in the recursive part of a pattern.") in
-  List.iter (fun (x,y) -> check_recvar x; check_recvar y)
-    (foundrec@foundrecbinding);
-  let check_bound x =
-    if not (List.mem x found) then
-      if List.mem_assoc x foundrec or List.mem_assoc x foundrecbinding
-	or list_rev_mem_assoc x foundrec or list_rev_mem_assoc x foundrecbinding
-      then
-	error ((string_of_id x)^" should not be bound in a recursive pattern of the right-hand side.")
-      else
-	error ((string_of_id x)^" is unbound in the right-hand side.") in
-  let check_pair s x y where =
-    if not (List.mem (x,y) where) then
-      errorlabstrm "" (strbrk "in the right-hand side, " ++ pr_id x ++
-	str " and " ++ pr_id y ++ strbrk " should appear in " ++ str s ++
-	str " position as part of a recursive pattern.") in
-  let check_type (x,typ) =
-    match typ with
-    | NtnInternTypeConstr ->
-	begin
-	  try check_pair "term" x (List.assoc x recvars) foundrec
-	  with Not_found -> check_bound x
-	end
-    | NtnInternTypeBinder ->
-	begin
-	  try check_pair "binding" x (List.assoc x recvars) foundrecbinding
-	  with Not_found -> check_bound x
-	end
-    | NtnInternTypeIdent -> check_bound x in
-  List.iter check_type vars
-
-let aconstr_of_glob_constr vars recvars a =
-  let a,found = aconstr_and_vars_of_glob_constr a in
-  check_variables vars recvars found;
-  a
-
-(* Substitution of kernel names, avoiding a list of bound identifiers *)
-
-let aconstr_of_constr avoiding t =
- aconstr_of_glob_constr [] [] (Detyping.detype false avoiding [] t)
-
-let rec subst_pat subst pat =
-  match pat with
-  | PatVar _ -> pat
-  | PatCstr (loc,((kn,i),j),cpl,n) ->
-      let kn' = subst_ind subst kn
-      and cpl' = list_smartmap (subst_pat subst) cpl in
-        if kn' == kn && cpl' == cpl then pat else
-          PatCstr (loc,((kn',i),j),cpl',n)
-
-let rec subst_aconstr subst bound raw =
-  match raw with
-  | ARef ref ->
-      let ref',t = subst_global subst ref in
-	if ref' == ref then raw else
-	  aconstr_of_constr bound t
-
-  | AVar _ -> raw
-
-  | AApp (r,rl) ->
-      let r' = subst_aconstr subst bound r
-      and rl' = list_smartmap (subst_aconstr subst bound) rl in
-	if r' == r && rl' == rl then raw else
-	  AApp(r',rl')
-
-  | AList (id1,id2,r1,r2,b) ->
-      let r1' = subst_aconstr subst bound r1
-      and r2' = subst_aconstr subst bound r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  AList (id1,id2,r1',r2',b)
-
-  | ALambda (n,r1,r2) ->
-      let r1' = subst_aconstr subst bound r1
-      and r2' = subst_aconstr subst bound r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ALambda (n,r1',r2')
-
-  | AProd (n,r1,r2) ->
-      let r1' = subst_aconstr subst bound r1
-      and r2' = subst_aconstr subst bound r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  AProd (n,r1',r2')
-
-  | ABinderList (id1,id2,r1,r2) ->
-      let r1' = subst_aconstr subst bound r1
-      and r2' = subst_aconstr subst bound r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ABinderList (id1,id2,r1',r2')
-
-  | ALetIn (n,r1,r2) ->
-      let r1' = subst_aconstr subst bound r1
-      and r2' = subst_aconstr subst bound r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ALetIn (n,r1',r2')
-
-  | ACases (sty,rtntypopt,rl,branches) ->
-      let rtntypopt' = Option.smartmap (subst_aconstr subst bound) rtntypopt
-      and rl' = list_smartmap
-        (fun (a,(n,signopt) as x) ->
-	  let a' = subst_aconstr subst bound a in
-	  let signopt' = Option.map (fun ((indkn,i),n,nal as z) ->
-	    let indkn' = subst_ind subst indkn in
-	    if indkn == indkn' then z else ((indkn',i),n,nal)) signopt in
-	  if a' == a && signopt' == signopt then x else (a',(n,signopt')))
-        rl
-      and branches' = list_smartmap
-                        (fun (cpl,r as branch) ->
-                           let cpl' = list_smartmap (subst_pat subst) cpl
-                           and r' = subst_aconstr subst bound r in
-                             if cpl' == cpl && r' == r then branch else
-                               (cpl',r'))
-                        branches
-      in
-        if rtntypopt' == rtntypopt && rtntypopt == rtntypopt' &
-          rl' == rl && branches' == branches then raw else
-          ACases (sty,rtntypopt',rl',branches')
-
-  | ALetTuple (nal,(na,po),b,c) ->
-      let po' = Option.smartmap (subst_aconstr subst bound) po
-      and b' = subst_aconstr subst bound b
-      and c' = subst_aconstr subst bound c in
-	if po' == po && b' == b && c' == c then raw else
-	  ALetTuple (nal,(na,po'),b',c')
-
-  | AIf (c,(na,po),b1,b2) ->
-      let po' = Option.smartmap (subst_aconstr subst bound) po
-      and b1' = subst_aconstr subst bound b1
-      and b2' = subst_aconstr subst bound b2
-      and c' = subst_aconstr subst bound c in
-	if po' == po && b1' == b1 && b2' == b2 && c' == c then raw else
-	  AIf (c',(na,po'),b1',b2')
-
-  | ARec (fk,idl,dll,tl,bl) ->
-      let dll' =
-	array_smartmap (list_smartmap (fun (na,oc,b as x) ->
-	  let oc' =  Option.smartmap (subst_aconstr subst bound) oc in
-	  let b' =  subst_aconstr subst bound b in
-	  if oc' == oc && b' == b then x else (na,oc',b'))) dll in
-      let tl' = array_smartmap (subst_aconstr subst bound) tl in
-      let bl' = array_smartmap (subst_aconstr subst bound) bl in
-      if dll' == dll && tl' == tl && bl' == bl then raw else
-	  ARec (fk,idl,dll',tl',bl')
-
-  | APatVar _ | ASort _ -> raw
-
-  | AHole (Evd.ImplicitArg (ref,i,b)) ->
-      let ref',t = subst_global subst ref in
-	if ref' == ref then raw else
-	  AHole (Evd.InternalHole)
-  | AHole (Evd.BinderType _ | Evd.QuestionMark _ | Evd.CasesType
-    | Evd.InternalHole | Evd.TomatchTypeParameter _ | Evd.GoalEvar
-    | Evd.ImpossibleCase | Evd.MatchingVar _) -> raw
-
-  | ACast (r1,k) ->
-      match k with
-	  CastConv (k, r2) ->
-	    let r1' = subst_aconstr subst bound r1
-	    and r2' = subst_aconstr subst bound r2 in
-	      if r1' == r1 && r2' == r2 then raw else
-		ACast (r1',CastConv (k,r2'))
-	| CastCoerce ->
-	    let r1' = subst_aconstr subst bound r1 in
-	      if r1' == r1 then raw else
-		ACast (r1',CastCoerce)
-
-let subst_interpretation subst (metas,pat) =
-  let bound = List.map fst metas in
-  (metas,subst_aconstr subst bound pat)
-
-(* Pattern-matching glob_constr and aconstr *)
-
-let abstract_return_type_context pi mklam tml rtno =
-  Option.map (fun rtn ->
-    let nal =
-      List.flatten (List.map (fun (_,(na,t)) ->
-	match t with Some x -> (pi x)@[na] | None -> [na]) tml) in
-    List.fold_right mklam nal rtn)
-    rtno
-
-let abstract_return_type_context_glob_constr =
-  abstract_return_type_context (fun (_,_,_,nal) -> nal)
-    (fun na c -> GLambda(dummy_loc,na,Explicit,GHole(dummy_loc,Evd.InternalHole),c))
-
-let abstract_return_type_context_aconstr =
-  abstract_return_type_context pi3
-    (fun na c -> ALambda(na,AHole Evd.InternalHole,c))
-
-exception No_match
-
-let rec alpha_var id1 id2 = function
-  | (i1,i2)::_ when i1=id1 -> i2 = id2
-  | (i1,i2)::_ when i2=id2 -> i1 = id1
-  | _::idl -> alpha_var id1 id2 idl
-  | [] -> id1 = id2
-
-let alpha_eq_val (x,y) = x = y
-
-let bind_env alp (sigma,sigmalist,sigmabinders as fullsigma) var v =
-  try
-    let vvar = List.assoc var sigma in
-    if alpha_eq_val (v,vvar) then fullsigma
-    else raise No_match
-  with Not_found ->
-    (* Check that no capture of binding variables occur *)
-    if List.exists (fun (id,_) ->occur_glob_constr id v) alp then raise No_match;
-    (* TODO: handle the case of multiple occs in different scopes *)
-    ((var,v)::sigma,sigmalist,sigmabinders)
-
-let bind_binder (sigma,sigmalist,sigmabinders) x bl =
-  (sigma,sigmalist,(x,List.rev bl)::sigmabinders)
-
-let match_fix_kind fk1 fk2 =
-  match (fk1,fk2) with
-  | GCoFix n1, GCoFix n2 -> n1 = n2
-  | GFix (nl1,n1), GFix (nl2,n2) ->
-      n1 = n2 &&
-      array_for_all2 (fun (n1,_) (n2,_) -> n2 = None || n1 = n2) nl1 nl2
-  | _ -> false
-
-let match_opt f sigma t1 t2 = match (t1,t2) with
-  | None, None -> sigma
-  | Some t1, Some t2 -> f sigma t1 t2
-  | _ -> raise No_match
-
-let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
-  | (_,Name id2) when List.mem id2 (fst metas) ->
-      let rhs = match na1 with
-      | Name id1 -> GVar (dummy_loc,id1)
-      | Anonymous -> GHole (dummy_loc,Evd.InternalHole) in
-      alp, bind_env alp sigma id2 rhs
-  | (Name id1,Name id2) -> (id1,id2)::alp,sigma
-  | (Anonymous,Anonymous) -> alp,sigma
-  | _ -> raise No_match
 
-let rec match_cases_pattern_binders metas acc pat1 pat2 =
-  match (pat1,pat2) with
-  | PatVar (_,na1), PatVar (_,na2) -> match_names metas acc na1 na2
-  | PatCstr (_,c1,patl1,na1), PatCstr (_,c2,patl2,na2)
-      when c1 = c2 & List.length patl1 = List.length patl2 ->
-      List.fold_left2 (match_cases_pattern_binders metas)
-	(match_names metas acc na1 na2) patl1 patl2
-  | _ -> raise No_match
-
-let glue_letin_with_decls = true
-
-let rec match_iterated_binders islambda decls = function
-  | GLambda (_,na,bk,t,b) when islambda ->
-      match_iterated_binders islambda ((na,bk,None,t)::decls) b
-  | GProd (_,(Name _ as na),bk,t,b) when not islambda ->
-      match_iterated_binders islambda ((na,bk,None,t)::decls) b
-  | GLetIn (loc,na,c,b) when glue_letin_with_decls ->
-      match_iterated_binders islambda
-	((na,Explicit (*?*), Some c,GHole(loc,Evd.BinderType na))::decls) b
-  | b -> (decls,b)
-
-let remove_sigma x (sigmavar,sigmalist,sigmabinders) =
-  (List.remove_assoc x sigmavar,sigmalist,sigmabinders)
-
-let rec match_abinderlist_with_app match_fun metas sigma rest x iter termin =
-  let rec aux sigma acc rest =
-    try
-      let sigma = match_fun (ldots_var::fst metas,snd metas) sigma rest iter in
-      let rest = List.assoc ldots_var (pi1 sigma) in
-      let b = match List.assoc x (pi3 sigma) with [b] -> b | _ ->assert false in
-      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
-      aux sigma (b::acc) rest
-    with No_match when acc <> [] ->
-      acc, match_fun metas sigma rest termin in
-  let bl,sigma = aux sigma [] rest in
-  bind_binder sigma x bl
-
-let match_alist match_fun metas sigma rest x iter termin lassoc =
-  let rec aux sigma acc rest =
-    try
-      let sigma = match_fun (ldots_var::fst metas,snd metas) sigma rest iter in
-      let rest = List.assoc ldots_var (pi1 sigma) in
-      let t = List.assoc x (pi1 sigma) in
-      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
-      aux sigma (t::acc) rest
-    with No_match when acc <> [] ->
-      acc, match_fun metas sigma rest termin in
-  let l,sigma = aux sigma [] rest in
-  (pi1 sigma, (x,if lassoc then l else List.rev l)::pi2 sigma, pi3 sigma)
-
-let does_not_come_from_already_eta_expanded_var =
-  (* This is hack to avoid looping on a rule with rhs of the form *)
-  (* "?f (fun ?x => ?g)" since otherwise, matching "F H" expands in *)
-  (* "F (fun x => H x)" and "H x" is recursively matched against the same *)
-  (* rule, giving "H (fun x' => x x')" and so on. *)
-  (* Ideally, we would need the type of the expression to know which of *)
-  (* the arguments applied to it can be eta-expanded without looping. *)
-  (* The following test is then an approximation of what can be done *)
-  (* optimally (whether other looping situations can occur remains to be *)
-  (* checked). *)
-  function GVar _ -> false | _ -> true
-
-let rec match_ inner u alp (tmetas,blmetas as metas) sigma a1 a2 =
-  match (a1,a2) with
-
-  (* Matching notation variable *)
-  | r1, AVar id2 when List.mem id2 tmetas -> bind_env alp sigma id2 r1
-
-  (* Matching recursive notations for terms *)
-  | r1, AList (x,_,iter,termin,lassoc) ->
-      match_alist (match_hd u alp) metas sigma r1 x iter termin lassoc
-
-  (* Matching recursive notations for binders: ad hoc cases supporting let-in *)
-  | GLambda (_,na1,bk,t1,b1), ABinderList (x,_,ALambda (Name id2,_,b2),termin)->
-      let (decls,b) = match_iterated_binders true [(na1,bk,None,t1)] b1 in
-      (* TODO: address the possibility that termin is a Lambda itself *)
-      match_in u alp metas (bind_binder sigma x decls) b termin
-  | GProd (_,na1,bk,t1,b1), ABinderList (x,_,AProd (Name id2,_,b2),termin)
-      when na1 <> Anonymous ->
-      let (decls,b) = match_iterated_binders false [(na1,bk,None,t1)] b1 in
-      (* TODO: address the possibility that termin is a Prod itself *)
-      match_in u alp metas (bind_binder sigma x decls) b termin
-  (* Matching recursive notations for binders: general case *)
-  | r, ABinderList (x,_,iter,termin) ->
-      match_abinderlist_with_app (match_hd u alp) metas sigma r x iter termin
-
-  (* Matching individual binders as part of a recursive pattern *)
-  | GLambda (_,na,bk,t,b1), ALambda (Name id,_,b2) when List.mem id blmetas ->
-      match_in u alp metas (bind_binder sigma id [(na,bk,None,t)]) b1 b2
-  | GProd (_,na,bk,t,b1), AProd (Name id,_,b2)
-      when List.mem id blmetas & na <> Anonymous ->
-      match_in u alp metas (bind_binder sigma id [(na,bk,None,t)]) b1 b2
-
-  (* Matching compositionally *)
-  | GVar (_,id1), AVar id2 when alpha_var id1 id2 alp -> sigma
-  | GRef (_,r1), ARef r2 when (eq_gr r1 r2) -> sigma
-  | GPatVar (_,(_,n1)), APatVar n2 when n1=n2 -> sigma
-  | GApp (loc,f1,l1), AApp (f2,l2) ->
-      let n1 = List.length l1 and n2 = List.length l2 in
-      let f1,l1,f2,l2 =
-	if n1 < n2 then
-	  let l21,l22 = list_chop (n2-n1) l2 in f1,l1, AApp (f2,l21), l22
-	else if n1 > n2 then
-	  let l11,l12 = list_chop (n1-n2) l1 in GApp (loc,f1,l11),l12, f2,l2
-	else f1,l1, f2, l2 in
-      let may_use_eta = does_not_come_from_already_eta_expanded_var f1 in
-      List.fold_left2 (match_ may_use_eta u alp metas)
-        (match_in u alp metas sigma f1 f2) l1 l2
-  | GLambda (_,na1,_,t1,b1), ALambda (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
-  | GProd (_,na1,_,t1,b1), AProd (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
-  | GLetIn (_,na1,t1,b1), ALetIn (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
-  | GCases (_,sty1,rtno1,tml1,eqnl1), ACases (sty2,rtno2,tml2,eqnl2)
-      when sty1 = sty2
-	 & List.length tml1 = List.length tml2
-	 & List.length eqnl1 = List.length eqnl2 ->
-      let rtno1' = abstract_return_type_context_glob_constr tml1 rtno1 in
-      let rtno2' = abstract_return_type_context_aconstr tml2 rtno2 in
-      let sigma =
-	try Option.fold_left2 (match_in u alp metas) sigma rtno1' rtno2'
-	with Option.Heterogeneous -> raise No_match
-      in
-      let sigma = List.fold_left2
-      (fun s (tm1,_) (tm2,_) ->
-        match_in u alp metas s tm1 tm2) sigma tml1 tml2 in
-      List.fold_left2 (match_equations u alp metas) sigma eqnl1 eqnl2
-  | GLetTuple (_,nal1,(na1,to1),b1,c1), ALetTuple (nal2,(na2,to2),b2,c2)
-      when List.length nal1 = List.length nal2 ->
-      let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
-      let sigma = match_in u alp metas sigma b1 b2 in
-      let (alp,sigma) =
-	List.fold_left2 (match_names metas) (alp,sigma) nal1 nal2 in
-      match_in u alp metas sigma c1 c2
-  | GIf (_,a1,(na1,to1),b1,c1), AIf (a2,(na2,to2),b2,c2) ->
-      let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
-      List.fold_left2 (match_in u alp metas) sigma [a1;b1;c1] [a2;b2;c2]
-  | GRec (_,fk1,idl1,dll1,tl1,bl1), ARec (fk2,idl2,dll2,tl2,bl2)
-      when match_fix_kind fk1 fk2 & Array.length idl1 =  Array.length idl2 &
-	array_for_all2 (fun l1 l2 -> List.length l1 = List.length l2) dll1 dll2
-	->
-      let alp,sigma = array_fold_left2
-	(List.fold_left2 (fun (alp,sigma) (na1,_,oc1,b1) (na2,oc2,b2) ->
-	  let sigma =
-	    match_in u alp metas
-              (match_opt (match_in u alp metas) sigma oc1 oc2) b1 b2
-	  in match_names metas (alp,sigma) na1 na2)) (alp,sigma) dll1 dll2 in
-      let sigma = array_fold_left2 (match_in u alp metas) sigma tl1 tl2 in
-      let alp,sigma = array_fold_right2 (fun id1 id2 alsig ->
-	match_names metas alsig (Name id1) (Name id2)) idl1 idl2 (alp,sigma) in
-      array_fold_left2 (match_in u alp metas) sigma bl1 bl2
-  | GCast(_,c1, CastConv(_,t1)), ACast(c2, CastConv (_,t2)) ->
-      match_in u alp metas (match_in u alp metas sigma c1 c2) t1 t2
-  | GCast(_,c1, CastCoerce), ACast(c2, CastCoerce) ->
-      match_in u alp metas sigma c1 c2
-  | GSort (_,GType _), ASort (GType None) when not u -> sigma
-  | GSort (_,s1), ASort s2 when s1 = s2 -> sigma
-  | GPatVar _, AHole _ -> (*Don't hide Metas, they bind in ltac*) raise No_match
-  | a, AHole _ -> sigma
-
-  (* On the fly eta-expansion so as to use notations of the form
-     "exists x, P x" for "ex P"; expects type not given because don't know
-     otherwise how to ensure it corresponds to a well-typed eta-expansion;
-     ensure at least one constructor is consumed to avoid looping *)
-  | b1, ALambda (Name id,AHole _,b2) when inner ->
-      let id' = Namegen.next_ident_away id (free_glob_vars b1) in
-      match_in u alp metas (bind_binder sigma id
-       [(Name id',Explicit,None,GHole(dummy_loc,Evd.BinderType (Name id')))])
-       (mkGApp dummy_loc b1 (GVar (dummy_loc,id'))) b2
-
-  | (GRec _ | GEvar _), _
-  | _,_ -> raise No_match
-
-and match_in u = match_ true u
-
-and match_hd u = match_ false u
-
-and match_binders u alp metas na1 na2 sigma b1 b2 =
-  let (alp,sigma) = match_names metas (alp,sigma) na1 na2 in
-  match_in u alp metas sigma b1 b2
-
-and match_equations u alp metas sigma (_,_,patl1,rhs1) (patl2,rhs2) =
-  (* patl1 and patl2 have the same length because they respectively
-     correspond to some tml1 and tml2 that have the same length *)
-  let (alp,sigma) =
-    List.fold_left2 (match_cases_pattern_binders metas)
-      (alp,sigma) patl1 patl2 in
-  match_in u alp metas sigma rhs1 rhs2
-
-let match_aconstr u c (metas,pat) =
-  let vars = list_split_by (fun (_,(_,x)) -> x <> NtnTypeBinderList) metas in
-  let vars = (List.map fst (fst vars), List.map fst (snd vars)) in
-  let terms,termlists,binders = match_ false u [] vars ([],[],[]) c pat in
-  (* Reorder canonically the substitution *)
-  let find x =
-    try List.assoc x terms
-    with Not_found ->
-      (* Happens for binders bound to Anonymous *)
-      (* Find a better way to propagate Anonymous... *)
-      GVar (dummy_loc,x) in
-  List.fold_right (fun (x,(scl,typ)) (terms',termlists',binders') ->
-    match typ with
-    | NtnTypeConstr ->
-       ((find x, scl)::terms',termlists',binders')
-    | NtnTypeConstrList ->
-       (terms',(List.assoc x termlists,scl)::termlists',binders')
-    | NtnTypeBinderList ->
-       (terms',termlists',(List.assoc x binders,scl)::binders'))
-    metas ([],[],[])
-
-(* Matching cases pattern *)
-
-let bind_env_cases_pattern (sigma,sigmalist,x as fullsigma) var v =
-  try
-    let vvar = List.assoc var sigma in
-    if v=vvar then fullsigma else raise No_match
-  with Not_found ->
-    (* TODO: handle the case of multiple occs in different scopes *)
-    (var,v)::sigma,sigmalist,x
-
-let rec match_cases_pattern metas sigma a1 a2 = match (a1,a2) with
-  | r1, AVar id2 when List.mem id2 metas -> bind_env_cases_pattern sigma id2 r1
-  | PatVar (_,Anonymous), AHole _ -> sigma
-  | PatCstr (loc,(ind,_ as r1),[],_), ARef (ConstructRef r2) when r1 = r2 ->
-      sigma
-  | PatCstr (loc,(ind,_ as r1),args1,_), AApp (ARef (ConstructRef r2),l2)
-      when r1 = r2 ->
-      let nparams = Inductive.inductive_params (Global.lookup_inductive ind) in
-      if List.length l2 <> nparams + List.length args1
-      then
-	(* TODO: revert partially applied notations of the form
-           "Notation P := (@pair)." *)
-	raise No_match
-      else
-        let (p2,args2) = list_chop nparams l2 in
-        (* All parameters must be _ *)
-        List.iter (function AHole _ -> () | _ -> raise No_match) p2;
-	List.fold_left2 (match_cases_pattern metas) sigma args1 args2
-  | r1, AList (x,_,iter,termin,lassoc) ->
-      match_alist (fun (metas,_) -> match_cases_pattern metas)
-	(metas,[]) (pi1 sigma,pi2 sigma,()) r1 x iter termin lassoc
-  | _ -> raise No_match
-
-let match_aconstr_cases_pattern c (metas,pat) =
-  let vars = List.map fst metas in
-  let terms,termlists,() = match_cases_pattern vars ([],[],()) c pat in
-  (* Reorder canonically the substitution *)
-  List.fold_right (fun (x,(scl,typ)) (terms',termlists') ->
-    match typ with
-    | NtnTypeConstr -> ((List.assoc x terms, scl)::terms',termlists')
-    | NtnTypeConstrList -> (terms',(List.assoc x termlists,scl)::termlists')
-    | NtnTypeBinderList -> assert false)
-    metas ([],[])
-
-(**********************************************************************)
-(*s Concrete syntax for terms *)
-
-type notation = string
-
-type explicitation = ExplByPos of int * identifier option | ExplByName of identifier
-
-type binder_kind = Default of binding_kind | Generalized of binding_kind * binding_kind * bool
-
-type abstraction_kind = AbsLambda | AbsPi
-
-type proj_flag = int option (* [Some n] = proj of the n-th visible argument *)
-
-type prim_token = Numeral of Bigint.bigint | String of string
-
-type cases_pattern_expr =
-  | CPatAlias of loc * cases_pattern_expr * identifier
-  | CPatCstr of loc * reference * cases_pattern_expr list
-  | CPatCstrExpl of loc * reference * cases_pattern_expr list
-  | CPatAtom of loc * reference option
-  | CPatOr of loc * cases_pattern_expr list
-  | CPatNotation of loc * notation * cases_pattern_notation_substitution
-  | CPatPrim of loc * prim_token
-  | CPatRecord of Util.loc * (reference * cases_pattern_expr) list
-  | CPatDelimiters of loc * string * cases_pattern_expr
-
-and cases_pattern_notation_substitution =
-    cases_pattern_expr list *     (** for constr subterms *)
-    cases_pattern_expr list list  (** for recursive notations *)
-
-type constr_expr =
-  | CRef of reference
-  | CFix of loc * identifier located * fix_expr list
-  | CCoFix of loc * identifier located * cofix_expr list
-  | CArrow of loc * constr_expr * constr_expr
-  | CProdN of loc * (name located list * binder_kind * constr_expr) list * constr_expr
-  | CLambdaN of loc * (name located list * binder_kind * constr_expr) list * constr_expr
-  | CLetIn of loc * name located * constr_expr * constr_expr
-  | CAppExpl of loc * (proj_flag * reference) * constr_expr list
-  | CApp of loc * (proj_flag * constr_expr) *
-      (constr_expr * explicitation located option) list
-  | CRecord of loc * constr_expr option * (reference * constr_expr) list
-  | CCases of loc * case_style * constr_expr option *
-      (constr_expr * (name located option * constr_expr option)) list *
-      (loc * cases_pattern_expr list located list * constr_expr) list
-  | CLetTuple of loc * name located list * (name located option * constr_expr option) *
-      constr_expr * constr_expr
-  | CIf of loc * constr_expr * (name located option * constr_expr option)
-      * constr_expr * constr_expr
-  | CHole of loc * Evd.hole_kind option
-  | CPatVar of loc * (bool * patvar)
-  | CEvar of loc * existential_key * constr_expr list option
-  | CSort of loc * glob_sort
-  | CCast of loc * constr_expr * constr_expr cast_type
-  | CNotation of loc * notation * constr_notation_substitution
-  | CGeneralization of loc * binding_kind * abstraction_kind option * constr_expr
-  | CPrim of loc * prim_token
-  | CDelimiters of loc * string * constr_expr
-
-and fix_expr =
-    identifier located * (identifier located option * recursion_order_expr) * local_binder list * constr_expr * constr_expr
-
-and cofix_expr =
-    identifier located * local_binder list * constr_expr * constr_expr
-
-and recursion_order_expr =
-  | CStructRec
-  | CWfRec of constr_expr
-  | CMeasureRec of constr_expr * constr_expr option (* measure, relation *)
-
-and local_binder =
-  | LocalRawDef of name located * constr_expr
-  | LocalRawAssum of name located list * binder_kind * constr_expr
-
-and constr_notation_substitution =
-    constr_expr list *      (* for constr subterms *)
-    constr_expr list list * (* for recursive notations *)
-    local_binder list list      (* for binders subexpressions *)
-
-type typeclass_constraint = name located * binding_kind * constr_expr
-
-and typeclass_context = typeclass_constraint list
-
-type constr_pattern_expr = constr_expr
-
-(***********************)
-(* For binders parsing *)
-
-let default_binder_kind = Default Explicit
-
-let names_of_local_assums bl =
-  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|_->[]) bl)
-
-let names_of_local_binders bl =
-  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|LocalRawDef(l,_)->[l]) bl)
+let oldfashion_patterns = ref (false)
+let _ = Goptions.declare_bool_option {
+  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optname =
+    "Constructors in patterns require all their arguments but no parameters instead of explicit parameters and arguments";
+  Goptions.optkey = ["Asymmetric";"Patterns"];
+  Goptions.optread = (fun () -> !oldfashion_patterns);
+  Goptions.optwrite = (fun a -> oldfashion_patterns:=a);
+}
 
 (**********************************************************************)
 (* Miscellaneous *)
@@ -933,68 +38,22 @@ let error_invalid_pattern_notation loc =
 (**********************************************************************)
 (* Functions on constr_expr *)
 
-let constr_loc = function
-  | CRef (Ident (loc,_)) -> loc
-  | CRef (Qualid (loc,_)) -> loc
-  | CFix (loc,_,_) -> loc
-  | CCoFix (loc,_,_) -> loc
-  | CArrow (loc,_,_) -> loc
-  | CProdN (loc,_,_) -> loc
-  | CLambdaN (loc,_,_) -> loc
-  | CLetIn (loc,_,_,_) -> loc
-  | CAppExpl (loc,_,_) -> loc
-  | CApp (loc,_,_) -> loc
-  | CRecord (loc,_,_) -> loc
-  | CCases (loc,_,_,_,_) -> loc
-  | CLetTuple (loc,_,_,_,_) -> loc
-  | CIf (loc,_,_,_,_) -> loc
-  | CHole (loc, _) -> loc
-  | CPatVar (loc,_) -> loc
-  | CEvar (loc,_,_) -> loc
-  | CSort (loc,_) -> loc
-  | CCast (loc,_,_) -> loc
-  | CNotation (loc,_,_) -> loc
-  | CGeneralization (loc,_,_,_) -> loc
-  | CPrim (loc,_) -> loc
-  | CDelimiters (loc,_,_) -> loc
-
-let cases_pattern_expr_loc = function
-  | CPatAlias (loc,_,_) -> loc
-  | CPatCstr (loc,_,_) -> loc
-  | CPatCstrExpl (loc,_,_) -> loc
-  | CPatAtom (loc,_) -> loc
-  | CPatOr (loc,_) -> loc
-  | CPatNotation (loc,_,_) -> loc
-  | CPatRecord (loc, _) -> loc
-  | CPatPrim (loc,_) -> loc
-  | CPatDelimiters (loc,_,_) -> loc
-
-let local_binder_loc = function
-  | LocalRawAssum ((loc,_)::_,_,t)
-  | LocalRawDef ((loc,_),t) -> join_loc loc (constr_loc t)
-  | LocalRawAssum ([],_,_) -> assert false
-
-let local_binders_loc bll =
-  if bll = [] then dummy_loc else
-  join_loc (local_binder_loc (List.hd bll)) (local_binder_loc (list_last bll))
-
 let ids_of_cases_indtype =
-  let add_var ids = function CRef (Ident (_,id)) -> id::ids | _ -> ids in
-  let rec vars_of = function
+  let rec vars_of ids = function
     (* We deal only with the regular cases *)
-    | CApp (_,_,l) -> List.fold_left add_var [] (List.map fst l)
-    | CNotation (_,_,(l,[],[]))
+    | (CPatCstr (_,_,l1,l2)|CPatNotation (_,_,(l1,[]),l2)) ->
+      List.fold_left vars_of (List.fold_left vars_of [] l2) l1
     (* assume the ntn is applicative and does not instantiate the head !! *)
-    | CAppExpl (_,_,l) -> List.fold_left add_var [] l
-    | CDelimiters(_,_,c) -> vars_of c
-    | _ -> [] in
-  vars_of
+    | CPatDelimiters(_,_,c) -> vars_of ids c
+    | CPatAtom (_, Some (Libnames.Ident (_, x))) -> x::ids
+    | _ -> ids in
+  vars_of []
 
 let ids_of_cases_tomatch tms =
   List.fold_right
     (fun (_,(ona,indnal)) l ->
       Option.fold_right (fun t -> (@) (ids_of_cases_indtype t))
-      indnal (Option.fold_right (down_located name_cons) ona l))
+      indnal (Option.fold_right (Loc.down_located name_cons) ona l))
     tms []
 
 let is_constructor id =
@@ -1005,19 +64,23 @@ let rec cases_pattern_fold_names f a = function
   | CPatRecord (_, l) ->
       List.fold_left (fun acc (r, cp) -> cases_pattern_fold_names f acc cp) a l
   | CPatAlias (_,pat,id) -> f id a
-  | CPatCstr (_,_,patl) | CPatCstrExpl (_,_,patl) | CPatOr (_,patl) ->
+  | CPatOr (_,patl) ->
       List.fold_left (cases_pattern_fold_names f) a patl
-  | CPatNotation (_,_,(patl,patll)) ->
-      List.fold_left (cases_pattern_fold_names f) a (patl@List.flatten patll)
+  | CPatCstr (_,_,patl1,patl2) ->
+    List.fold_left (cases_pattern_fold_names f)
+      (List.fold_left (cases_pattern_fold_names f) a patl1) patl2
+  | CPatNotation (_,_,(patl,patll),patl') ->
+      List.fold_left (cases_pattern_fold_names f)
+	(List.fold_left (cases_pattern_fold_names f) a (patl@List.flatten patll)) patl'
   | CPatDelimiters (_,_,pat) -> cases_pattern_fold_names f a pat
   | CPatAtom (_,Some (Ident (_,id))) when not (is_constructor id) -> f id a
   | CPatPrim _ | CPatAtom _ -> a
 
 let ids_of_pattern_list =
   List.fold_left
-    (located_fold_left
-      (List.fold_left (cases_pattern_fold_names Idset.add)))
-    Idset.empty
+    (Loc.located_fold_left
+      (List.fold_left (cases_pattern_fold_names Id.Set.add)))
+    Id.Set.empty
 
 let rec fold_constr_expr_binders g f n acc b = function
   | (nal,bk,t)::l ->
@@ -1038,18 +101,17 @@ let rec fold_local_binders g f n acc b = function
       f n acc b
 
 let fold_constr_expr_with_binders g f n acc = function
-  | CArrow (loc,a,b) -> f n (f n acc a) b
-  | CAppExpl (loc,(_,_),l) -> List.fold_left (f n) acc l
+  | CAppExpl (loc,(_,_,_),l) -> List.fold_left (f n) acc l
   | CApp (loc,(_,t),l) -> List.fold_left (f n) (f n acc t) (List.map fst l)
   | CProdN (_,l,b) | CLambdaN (_,l,b) -> fold_constr_expr_binders g f n acc b l
   | CLetIn (_,na,a,b) -> fold_constr_expr_binders g f n acc b [[na],default_binder_kind,a]
-  | CCast (loc,a,CastConv(_,b)) -> f n (f n acc a) b
+  | CCast (loc,a,(CastConv b|CastVM b|CastNative b)) -> f n (f n acc a) b
   | CCast (loc,a,CastCoerce) -> f n acc a
   | CNotation (_,_,(l,ll,bll)) ->
       (* The following is an approximation: we don't know exactly if
          an ident is binding nor to which subterms bindings apply *)
       let acc = List.fold_left (f n) acc (l@List.flatten ll) in
-      List.fold_left (fun acc bl -> fold_local_binders g f n acc (CHole (dummy_loc,None)) bl) acc bll
+      List.fold_left (fun acc bl -> fold_local_binders g f n acc (CHole (Loc.ghost,None,IntroAnonymous,None)) bl) acc bll
   | CGeneralization (_,_,_,c) -> f n acc c
   | CDelimiters (loc,_,a) -> f n acc a
   | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CRef _ ->
@@ -1061,93 +123,29 @@ let fold_constr_expr_with_binders g f n acc = function
       let acc = List.fold_left (f n) acc (List.map fst al) in
       List.fold_right (fun (loc,patl,rhs) acc ->
 	let ids = ids_of_pattern_list patl in
-	f (Idset.fold g ids n) acc rhs) bl acc
+	f (Id.Set.fold g ids n) acc rhs) bl acc
   | CLetTuple (loc,nal,(ona,po),b,c) ->
-      let n' = List.fold_right (down_located (name_fold g)) nal n in
-      f (Option.fold_right (down_located (name_fold g)) ona n') (f n acc b) c
+      let n' = List.fold_right (Loc.down_located (name_fold g)) nal n in
+      f (Option.fold_right (Loc.down_located (name_fold g)) ona n') (f n acc b) c
   | CIf (_,c,(ona,po),b1,b2) ->
       let acc = f n (f n (f n acc b1) b2) c in
       Option.fold_left
-	(f (Option.fold_right (down_located (name_fold g)) ona n)) acc po
+	(f (Option.fold_right (Loc.down_located (name_fold g)) ona n)) acc po
   | CFix (loc,_,l) ->
       let n' = List.fold_right (fun ((_,id),_,_,_,_) -> g id) l n in
       List.fold_right (fun (_,(_,o),lb,t,c) acc ->
 	fold_local_binders g f n'
 	  (fold_local_binders g f n acc t lb) c lb) l acc
   | CCoFix (loc,_,_) ->
-      Pp.msg_warn "Capture check in multiple binders not done"; acc
+      msg_warning (strbrk "Capture check in multiple binders not done"); acc
 
 let free_vars_of_constr_expr c =
   let rec aux bdvars l = function
-  | CRef (Ident (_,id)) -> if List.mem id bdvars then l else Idset.add id l
+  | CRef (Ident (_,id),_) -> if Id.List.mem id bdvars then l else Id.Set.add id l
   | c -> fold_constr_expr_with_binders (fun a l -> a::l) aux bdvars l c
-  in aux [] Idset.empty c
-
-let occur_var_constr_expr id c = Idset.mem id (free_vars_of_constr_expr c)
-
-let mkIdentC id  = CRef (Ident (dummy_loc, id))
-let mkRefC r     = CRef r
-let mkCastC (a,k)  = CCast (dummy_loc,a,k)
-let mkLambdaC (idl,bk,a,b) = CLambdaN (dummy_loc,[idl,bk,a],b)
-let mkLetInC (id,a,b)   = CLetIn (dummy_loc,id,a,b)
-let mkProdC (idl,bk,a,b)   = CProdN (dummy_loc,[idl,bk,a],b)
-
-let mkAppC (f,l) =
-  let l = List.map (fun x -> (x,None)) l in
-  match f with
-  | CApp (_,g,l') -> CApp (dummy_loc, g, l' @ l)
-  | _ -> CApp (dummy_loc, (None, f), l)
-
-let rec mkCProdN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CProdN (loc,[idl,bk,t],mkCProdN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll ->
-      CLetIn (loc,id,b,mkCProdN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_,_) :: bll -> mkCProdN loc bll c
-
-let rec mkCLambdaN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CLambdaN (loc,[idl,bk,t],mkCLambdaN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll ->
-      CLetIn (loc,id,b,mkCLambdaN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_,_) :: bll -> mkCLambdaN loc bll c
-
-let rec abstract_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
-  | LocalRawAssum (idl,bk,t)::bl ->
-      List.fold_right (fun x b -> mkLambdaC([x],bk,t,b)) idl
-      (abstract_constr_expr c bl)
+  in aux [] Id.Set.empty c
 
-let rec prod_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,prod_constr_expr c bl)
-  | LocalRawAssum (idl,bk,t)::bl ->
-      List.fold_right (fun x b -> mkProdC([x],bk,t,b)) idl
-      (prod_constr_expr c bl)
-
-let coerce_reference_to_id = function
-  | Ident (_,id) -> id
-  | Qualid (loc,_) ->
-      user_err_loc (loc, "coerce_reference_to_id",
-        str "This expression should be a simple identifier.")
-
-let coerce_to_id = function
-  | CRef (Ident (loc,id)) -> (loc,id)
-  | a -> user_err_loc
-        (constr_loc a,"coerce_to_id",
-         str "This expression should be a simple identifier.")
-
-let coerce_to_name = function
-  | CRef (Ident (loc,id)) -> (loc,Name id)
-  | CHole (loc,_) -> (loc,Anonymous)
-  | a -> user_err_loc
-        (constr_loc a,"coerce_to_name",
-         str "This expression should be a name.")
+let occur_var_constr_expr id c = Id.Set.mem id (free_vars_of_constr_expr c)
 
 (* Interpret the index of a recursion order annotation *)
 
@@ -1155,16 +153,27 @@ let split_at_annot bl na =
   let names = List.map snd (names_of_local_assums bl) in
   match na with
   | None ->
-      if names = [] then error "A fixpoint needs at least one parameter."
-      else [], bl
+      begin match names with
+      | [] -> error "A fixpoint needs at least one parameter."
+      | _ -> ([], bl)
+      end
   | Some (loc, id) ->
       let rec aux acc = function
 	| LocalRawAssum (bls, k, t) as x :: rest ->
-	    let l, r = list_split_when (fun (loc, na) -> na = Name id) bls in
-	      if r = [] then aux (x :: acc) rest
-	      else
-		(List.rev (if l = [] then acc else LocalRawAssum (l, k, t) :: acc),
-		 LocalRawAssum (r, k, t) :: rest)
+            let test (_, na) = match na with
+            | Name id' -> Id.equal id id'
+            | Anonymous -> false
+            in
+	    let l, r = List.split_when test bls in
+            begin match r with
+            | [] -> aux (x :: acc) rest
+            | _ ->
+              let ans = match l with
+              | [] -> acc
+              | _ -> LocalRawAssum (l, k, t) :: acc
+              in
+              (List.rev ans, LocalRawAssum (r, k, t) :: rest)
+            end
 	| LocalRawDef _ as x :: rest -> aux (x :: acc) rest
 	| [] ->
             user_err_loc(loc,"",
@@ -1173,7 +182,7 @@ let split_at_annot bl na =
 
 (* Used in correctness and interface *)
 
-let map_binder g e nal = List.fold_right (down_located (name_fold g)) nal e
+let map_binder g e nal = List.fold_right (Loc.down_located (name_fold g)) nal e
 
 let map_binders f g e bl =
   (* TODO: avoid variable capture in [t] by some [na] in [List.tl nal] *)
@@ -1192,7 +201,6 @@ let map_local_binders f g e bl =
   (e, List.rev rbl)
 
 let map_constr_expr_with_binders g f e = function
-  | CArrow (loc,a,b) -> CArrow (loc,f e a,f e b)
   | CAppExpl (loc,r,l) -> CAppExpl (loc,r,List.map (f e) l)
   | CApp (loc,(p,a),l) ->
       CApp (loc,(p,f e a),List.map (fun (a,i) -> (f e a,i)) l)
@@ -1201,8 +209,7 @@ let map_constr_expr_with_binders g f e = function
   | CLambdaN (loc,bl,b) ->
       let (e,bl) = map_binders f g e bl in CLambdaN (loc,bl,f e b)
   | CLetIn (loc,na,a,b) -> CLetIn (loc,na,f e a,f (name_fold g (snd na) e) b)
-  | CCast (loc,a,CastConv (k,b)) -> CCast (loc,f e a,CastConv(k, f e b))
-  | CCast (loc,a,CastCoerce) -> CCast (loc,f e a,CastCoerce)
+  | CCast (loc,a,c) -> CCast (loc,f e a, Miscops.map_cast_type (f e) c)
   | CNotation (loc,n,(l,ll,bll)) ->
       (* This is an approximation because we don't know what binds what *)
       CNotation (loc,n,(List.map (f e) l,List.map (List.map (f e)) ll,
@@ -1219,11 +226,11 @@ let map_constr_expr_with_binders g f e = function
       let po = Option.map (f (List.fold_right g ids e)) rtnpo in
       CCases (loc, sty, po, List.map (fun (tm,x) -> (f e tm,x)) a,bl)
   | CLetTuple (loc,nal,(ona,po),b,c) ->
-      let e' = List.fold_right (down_located (name_fold g)) nal e in
-      let e'' = Option.fold_right (down_located (name_fold g)) ona e in
+      let e' = List.fold_right (Loc.down_located (name_fold g)) nal e in
+      let e'' = Option.fold_right (Loc.down_located (name_fold g)) ona e in
       CLetTuple (loc,nal,(ona,Option.map (f e'') po),f e b,f e' c)
   | CIf (loc,c,(ona,po),b1,b2) ->
-      let e' = Option.fold_right (down_located (name_fold g)) ona e in
+      let e' = Option.fold_right (Loc.down_located (name_fold g)) ona e in
       CIf (loc,f e c,(ona,Option.map (f e') po),f e b1,f e b2)
   | CFix (loc,id,dl) ->
       CFix (loc,id,List.map (fun (id,n,bl,t,d) ->
@@ -1243,33 +250,21 @@ let map_constr_expr_with_binders g f e = function
 
 (* Used in constrintern *)
 let rec replace_vars_constr_expr l = function
-  | CRef (Ident (loc,id)) as x ->
-      (try CRef (Ident (loc,List.assoc id l)) with Not_found -> x)
-  | c -> map_constr_expr_with_binders List.remove_assoc
+  | CRef (Ident (loc,id),us) as x ->
+      (try CRef (Ident (loc,Id.Map.find id l),us) with Not_found -> x)
+  | c -> map_constr_expr_with_binders Id.Map.remove
            replace_vars_constr_expr l c
 
-(**********************************************************************)
-(* Concrete syntax for modules and modules types *)
-
-type with_declaration_ast =
-  | CWith_Module of identifier list located * qualid located
-  | CWith_Definition of identifier list located * constr_expr
-
-type module_ast =
-  | CMident of qualid located
-  | CMapply of loc * module_ast * module_ast
-  | CMwith of loc * module_ast * with_declaration_ast
-
 (* Returns the ranges of locs of the notation that are not occupied by args  *)
 (* and which are then occupied by proper symbols of the notation (or spaces) *)
 
 let locs_of_notation loc locs ntn =
-  let (bl,el) = Util.unloc loc in
-  let locs =  List.map Util.unloc locs in
+  let (bl, el) = Loc.unloc loc in
+  let locs =  List.map Loc.unloc locs in
   let rec aux pos = function
-    | [] -> if pos = el then [] else [(pos,el-1)]
-    | (ba,ea)::l ->if pos = ba then aux ea l else (pos,ba-1)::aux ea l
-  in aux bl (Sort.list (fun l1 l2 -> fst l1 < fst l2) locs)
+    | [] -> if Int.equal pos el then [] else [(pos,el)]
+    | (ba,ea)::l -> if Int.equal pos ba then aux ea l else (pos,ba)::aux ea l
+  in aux bl (List.sort (fun l1 l2 -> fst l1 - fst l2) locs)
 
 let ntn_loc loc (args,argslist,binderslist) =
   locs_of_notation loc
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index 39ec8e74..b25d7082 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -1,274 +1,49 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Pp
-open Util
+open Loc
 open Names
-open Libnames
-open Glob_term
-open Term
-open Mod_subst
+open Constrexpr
 
-(** Topconstr: definitions of [aconstr] et [constr_expr] *)
+(** Topconstr *)
 
-(** {6 aconstr } *)
-(** This is the subtype of glob_constr allowed in syntactic extensions 
-   No location since intended to be substituted at any place of a text 
-   Complex expressions such as fixpoints and cofixpoints are excluded, 
-   non global expressions such as existential variables also *)
+val oldfashion_patterns : bool ref
 
-type aconstr =
-  (** Part common to [glob_constr] and [cases_pattern] *)
-  | ARef of global_reference
-  | AVar of identifier
-  | AApp of aconstr * aconstr list
-  | AList of identifier * identifier * aconstr * aconstr * bool
-  (** Part only in [glob_constr] *)
-  | ALambda of name * aconstr * aconstr
-  | AProd of name * aconstr * aconstr
-  | ABinderList of identifier * identifier * aconstr * aconstr
-  | ALetIn of name * aconstr * aconstr
-  | ACases of case_style * aconstr option *
-      (aconstr * (name * (inductive * int * name list) option)) list *
-      (cases_pattern list * aconstr) list
-  | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
-  | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
-  | ARec of fix_kind * identifier array *
-      (name * aconstr option * aconstr) list array * aconstr array *
-      aconstr array
-  | ASort of glob_sort
-  | AHole of Evd.hole_kind
-  | APatVar of patvar
-  | ACast of aconstr * aconstr cast_type
-
-type scope_name = string
-
-type tmp_scope_name = scope_name
-
-type subscopes = tmp_scope_name option * scope_name list
-
-(** Type of the meta-variables of an aconstr: in a recursive pattern x..y,
-    x carries the sequence of objects bound to the list x..y  *)
-type notation_var_instance_type =
-  | NtnTypeConstr | NtnTypeConstrList | NtnTypeBinderList
-
-(** Type of variables when interpreting a constr_expr as an aconstr:
-    in a recursive pattern x..y, both x and y carry the individual type
-    of each element of the list x..y *)
-type notation_var_internalization_type =
-  | NtnInternTypeConstr | NtnInternTypeBinder | NtnInternTypeIdent
-
-(** This characterizes to what a notation is interpreted to *)
-type interpretation =
-    (identifier * (subscopes * notation_var_instance_type)) list * aconstr
-
-(** Translate a glob_constr into a notation given the list of variables
-    bound by the notation; also interpret recursive patterns           *)
-
-val aconstr_of_glob_constr :
-  (identifier * notation_var_internalization_type) list ->
-  (identifier * identifier) list -> glob_constr -> aconstr
-
-(** Name of the special identifier used to encode recursive notations  *)
-val ldots_var : identifier
-
-(** Equality of glob_constr (warning: only partially implemented) *)
-val eq_glob_constr : glob_constr -> glob_constr -> bool
-
-(** Re-interpret a notation as a glob_constr, taking care of binders     *)
-
-val glob_constr_of_aconstr_with_binders : loc ->
-  ('a -> name -> 'a * name) ->
-  ('a -> aconstr -> glob_constr) -> 'a -> aconstr -> glob_constr
-
-val glob_constr_of_aconstr : loc -> aconstr -> glob_constr
-
-(** [match_aconstr] matches a glob_constr against a notation interpretation;
-    raise [No_match] if the matching fails   *)
-
-exception No_match
-
-val match_aconstr : bool -> glob_constr -> interpretation ->
-      (glob_constr * subscopes) list * (glob_constr list * subscopes) list *
-      (glob_decl list * subscopes) list
-
-val match_aconstr_cases_pattern :  cases_pattern -> interpretation ->
-      (cases_pattern * subscopes) list * (cases_pattern list * subscopes) list
-
-(** Substitution of kernel names in interpretation data                *)
-
-val subst_interpretation : substitution -> interpretation -> interpretation
-
-(** {6 Concrete syntax for terms }                                        *)
-
-type notation = string
-
-type explicitation = ExplByPos of int * identifier option | ExplByName of identifier
-
-type binder_kind =
-  | Default of binding_kind
-  | Generalized of binding_kind * binding_kind * bool
-      (** Inner binding, outer bindings, typeclass-specific flag
-	 for implicit generalization of superclasses *)
-
-type abstraction_kind = AbsLambda | AbsPi
-
-type proj_flag = int option (** [Some n] = proj of the n-th visible argument *)
-
-type prim_token = Numeral of Bigint.bigint | String of string
-
-type cases_pattern_expr =
-  | CPatAlias of loc * cases_pattern_expr * identifier
-  | CPatCstr of loc * reference * cases_pattern_expr list
-  | CPatCstrExpl of loc * reference * cases_pattern_expr list
-  | CPatAtom of loc * reference option
-  | CPatOr of loc * cases_pattern_expr list
-  | CPatNotation of loc * notation * cases_pattern_notation_substitution
-  | CPatPrim of loc * prim_token
-  | CPatRecord of Util.loc * (reference * cases_pattern_expr) list
-  | CPatDelimiters of loc * string * cases_pattern_expr
-
-and cases_pattern_notation_substitution =
-    cases_pattern_expr list *     (** for constr subterms *)
-    cases_pattern_expr list list  (** for recursive notations *)
-
-type constr_expr =
-  | CRef of reference
-  | CFix of loc * identifier located * fix_expr list
-  | CCoFix of loc * identifier located * cofix_expr list
-  | CArrow of loc * constr_expr * constr_expr
-  | CProdN of loc * (name located list * binder_kind * constr_expr) list * constr_expr
-  | CLambdaN of loc * (name located list * binder_kind * constr_expr) list * constr_expr
-  | CLetIn of loc * name located * constr_expr * constr_expr
-  | CAppExpl of loc * (proj_flag * reference) * constr_expr list
-  | CApp of loc * (proj_flag * constr_expr) *
-      (constr_expr * explicitation located option) list
-  | CRecord of loc * constr_expr option * (reference * constr_expr) list
-  | CCases of loc * case_style * constr_expr option *
-      (constr_expr * (name located option * constr_expr option)) list *
-      (loc * cases_pattern_expr list located list * constr_expr) list
-  | CLetTuple of loc * name located list * (name located option * constr_expr option) *
-      constr_expr * constr_expr
-  | CIf of loc * constr_expr * (name located option * constr_expr option)
-      * constr_expr * constr_expr
-  | CHole of loc * Evd.hole_kind option
-  | CPatVar of loc * (bool * patvar)
-  | CEvar of loc * existential_key * constr_expr list option
-  | CSort of loc * glob_sort
-  | CCast of loc * constr_expr * constr_expr cast_type
-  | CNotation of loc * notation * constr_notation_substitution
-  | CGeneralization of loc * binding_kind * abstraction_kind option * constr_expr
-  | CPrim of loc * prim_token
-  | CDelimiters of loc * string * constr_expr
-
-and fix_expr =
-    identifier located * (identifier located option * recursion_order_expr) * local_binder list * constr_expr * constr_expr
-
-and cofix_expr =
-    identifier located * local_binder list * constr_expr * constr_expr
-
-and recursion_order_expr =
-  | CStructRec
-  | CWfRec of constr_expr
-  | CMeasureRec of constr_expr * constr_expr option (** measure, relation *)
-
-(** Anonymous defs allowed ?? *)
-and local_binder =
-  | LocalRawDef of name located * constr_expr
-  | LocalRawAssum of name located list * binder_kind * constr_expr
-
-and constr_notation_substitution =
-    constr_expr list *      (** for constr subterms *)
-    constr_expr list list * (** for recursive notations *)
-    local_binder list list (** for binders subexpressions *)
-
-type typeclass_constraint = name located * binding_kind * constr_expr
-
-and typeclass_context = typeclass_constraint list
-
-type constr_pattern_expr = constr_expr
-
-(** Utilities on constr_expr                                           *)
-
-val constr_loc : constr_expr -> loc
-
-val cases_pattern_expr_loc : cases_pattern_expr -> loc
-
-val local_binders_loc : local_binder list -> loc
+(** Utilities on constr_expr *)
 
 val replace_vars_constr_expr :
-  (identifier * identifier) list -> constr_expr -> constr_expr
+  Id.t Id.Map.t -> constr_expr -> constr_expr
 
-val free_vars_of_constr_expr : constr_expr -> Idset.t
-val occur_var_constr_expr : identifier -> constr_expr -> bool
-
-val default_binder_kind : binder_kind
+val free_vars_of_constr_expr : constr_expr -> Id.Set.t
+val occur_var_constr_expr : Id.t -> constr_expr -> bool
 
 (** Specific function for interning "in indtype" syntax of "match" *)
-val ids_of_cases_indtype : constr_expr -> identifier list
-
-val mkIdentC : identifier -> constr_expr
-val mkRefC : reference -> constr_expr
-val mkAppC : constr_expr * constr_expr list -> constr_expr
-val mkCastC : constr_expr * constr_expr cast_type -> constr_expr
-val mkLambdaC : name located list * binder_kind * constr_expr * constr_expr -> constr_expr
-val mkLetInC : name located * constr_expr * constr_expr -> constr_expr
-val mkProdC : name located list * binder_kind * constr_expr * constr_expr -> constr_expr
-
-val coerce_reference_to_id : reference -> identifier
-val coerce_to_id : constr_expr -> identifier located
-val coerce_to_name : constr_expr -> name located
-
-val split_at_annot : local_binder list -> identifier located option -> local_binder list * local_binder list
-
-val abstract_constr_expr : constr_expr -> local_binder list -> constr_expr
-val prod_constr_expr : constr_expr -> local_binder list -> constr_expr
+val ids_of_cases_indtype : cases_pattern_expr -> Id.t list
 
-(** Same as [abstract_constr_expr] and [prod_constr_expr], with location *)
-val mkCLambdaN : loc -> local_binder list -> constr_expr -> constr_expr
-val mkCProdN : loc -> local_binder list -> constr_expr -> constr_expr
-
-(** For binders parsing *)
-
-(** With let binders *)
-val names_of_local_binders : local_binder list -> name located list
-
-(** Does not take let binders into account *)
-val names_of_local_assums : local_binder list -> name located list
+val split_at_annot : local_binder list -> Id.t located option -> local_binder list * local_binder list
 
 (** Used in typeclasses *)
 
-val fold_constr_expr_with_binders : (identifier -> 'a -> 'a) ->
+val fold_constr_expr_with_binders : (Id.t -> 'a -> 'a) ->
    ('a -> 'b -> constr_expr -> 'b) -> 'a -> 'b -> constr_expr -> 'b
 
 (** Used in correctness and interface; absence of var capture not guaranteed 
    in pattern-matching clauses and in binders of the form [x,y:T(x)] *)
 
 val map_constr_expr_with_binders :
-  (identifier -> 'a -> 'a) -> ('a -> constr_expr -> constr_expr) ->
+  (Id.t -> 'a -> 'a) -> ('a -> constr_expr -> constr_expr) ->
       'a -> constr_expr -> constr_expr
 
-(** Concrete syntax for modules and module types                       *)
-
-type with_declaration_ast =
-  | CWith_Module of identifier list located * qualid located
-  | CWith_Definition of identifier list located * constr_expr
-
-type module_ast =
-  | CMident of qualid located
-  | CMapply of loc * module_ast * module_ast
-  | CMwith of loc * module_ast * with_declaration_ast
-
 val ntn_loc :
-  Util.loc -> constr_notation_substitution -> string -> (int * int) list
+  Loc.t -> constr_notation_substitution -> string -> (int * int) list
 val patntn_loc :
-  Util.loc -> cases_pattern_notation_substitution -> string -> (int * int) list
+  Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list
 
 (** For cases pattern parsing errors *)
 
-val error_invalid_pattern_notation : Util.loc -> 'a
+val error_invalid_pattern_notation : Loc.t -> 'a