Imported Upstream version 8.5~beta1+dfsg

author: Enrico Tassi <gareuselesinge@debian.org> 2015-01-25 14:42:51 +0100
committer: Enrico Tassi <gareuselesinge@debian.org> 2015-01-25 14:42:51 +0100
commit: 7cfc4e5146be5666419451bdd516f1f3f264d24a (patch)
tree: e4197645da03dc3c7cc84e434cc31d0a0cca7056 /parsing
parent: 420f78b2caeaaddc6fe484565b2d0e49c66888e5 (diff)
47 files changed, 2012 insertions, 8304 deletions
diff --git a/parsing/argextend.ml4 b/parsing/argextend.ml4
deleted file mode 100644
index 1fc429c6..00000000
--- a/parsing/argextend.ml4
+++ /dev/null
@@ -1,340 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "tools/compat5b.cmo" i*)
-
-open Genarg
-open Q_util
-open Egrammar
-open Pcoq
-open Compat
-
-let loc = Util.dummy_loc
-let default_loc = <:expr< Util.dummy_loc >>
-
-let rec make_rawwit loc = function
-  | BoolArgType -> <:expr< Genarg.rawwit_bool >>
-  | IntArgType -> <:expr< Genarg.rawwit_int >>
-  | IntOrVarArgType -> <:expr< Genarg.rawwit_int_or_var >>
-  | StringArgType -> <:expr< Genarg.rawwit_string >>
-  | PreIdentArgType -> <:expr< Genarg.rawwit_pre_ident >>
-  | IntroPatternArgType -> <:expr< Genarg.rawwit_intro_pattern >>
-  | IdentArgType b -> <:expr< Genarg.rawwit_ident_gen $mlexpr_of_bool b$ >>
-  | VarArgType -> <:expr< Genarg.rawwit_var >>
-  | RefArgType -> <:expr< Genarg.rawwit_ref >>
-  | SortArgType -> <:expr< Genarg.rawwit_sort >>
-  | ConstrArgType -> <:expr< Genarg.rawwit_constr >>
-  | ConstrMayEvalArgType -> <:expr< Genarg.rawwit_constr_may_eval >>
-  | QuantHypArgType -> <:expr< Genarg.rawwit_quant_hyp >>
-  | RedExprArgType -> <:expr< Genarg.rawwit_red_expr >>
-  | OpenConstrArgType (b1,b2) -> <:expr< Genarg.rawwit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >>
-  | ConstrWithBindingsArgType -> <:expr< Genarg.rawwit_constr_with_bindings >>
-  | BindingsArgType -> <:expr< Genarg.rawwit_bindings >>
-  | List0ArgType t -> <:expr< Genarg.wit_list0 $make_rawwit loc t$ >>
-  | List1ArgType t -> <:expr< Genarg.wit_list1 $make_rawwit loc t$ >>
-  | OptArgType t -> <:expr< Genarg.wit_opt $make_rawwit loc t$ >>
-  | PairArgType (t1,t2) ->
-      <:expr< Genarg.wit_pair $make_rawwit loc t1$ $make_rawwit loc t2$ >>
-  | ExtraArgType s ->
-    <:expr<
-      let module WIT = struct
-        open Extrawit;
-        value wit = $lid:"rawwit_"^s$;
-      end in WIT.wit >>
-
-let rec make_globwit loc = function
-  | BoolArgType -> <:expr< Genarg.globwit_bool >>
-  | IntArgType -> <:expr< Genarg.globwit_int >>
-  | IntOrVarArgType -> <:expr< Genarg.globwit_int_or_var >>
-  | StringArgType -> <:expr< Genarg.globwit_string >>
-  | PreIdentArgType -> <:expr< Genarg.globwit_pre_ident >>
-  | IntroPatternArgType -> <:expr< Genarg.globwit_intro_pattern >>
-  | IdentArgType b -> <:expr< Genarg.globwit_ident_gen $mlexpr_of_bool b$ >>
-  | VarArgType -> <:expr< Genarg.globwit_var >>
-  | RefArgType -> <:expr< Genarg.globwit_ref >>
-  | QuantHypArgType -> <:expr< Genarg.globwit_quant_hyp >>
-  | SortArgType -> <:expr< Genarg.globwit_sort >>
-  | ConstrArgType -> <:expr< Genarg.globwit_constr >>
-  | ConstrMayEvalArgType -> <:expr< Genarg.globwit_constr_may_eval >>
-  | RedExprArgType -> <:expr< Genarg.globwit_red_expr >>
-  | OpenConstrArgType (b1,b2) -> <:expr< Genarg.globwit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >>
-  | ConstrWithBindingsArgType -> <:expr< Genarg.globwit_constr_with_bindings >>
-  | BindingsArgType -> <:expr< Genarg.globwit_bindings >>
-  | List0ArgType t -> <:expr< Genarg.wit_list0 $make_globwit loc t$ >>
-  | List1ArgType t -> <:expr< Genarg.wit_list1 $make_globwit loc t$ >>
-  | OptArgType t -> <:expr< Genarg.wit_opt $make_globwit loc t$ >>
-  | PairArgType (t1,t2) ->
-      <:expr< Genarg.wit_pair $make_globwit loc t1$ $make_globwit loc t2$ >>
-  | ExtraArgType s ->
-    <:expr<
-      let module WIT = struct
-        open Extrawit;
-        value wit = $lid:"globwit_"^s$;
-      end in WIT.wit >>
-
-let rec make_wit loc = function
-  | BoolArgType -> <:expr< Genarg.wit_bool >>
-  | IntArgType -> <:expr< Genarg.wit_int >>
-  | IntOrVarArgType -> <:expr< Genarg.wit_int_or_var >>
-  | StringArgType -> <:expr< Genarg.wit_string >>
-  | PreIdentArgType -> <:expr< Genarg.wit_pre_ident >>
-  | IntroPatternArgType -> <:expr< Genarg.wit_intro_pattern >>
-  | IdentArgType b -> <:expr< Genarg.wit_ident_gen $mlexpr_of_bool b$ >>
-  | VarArgType -> <:expr< Genarg.wit_var >>
-  | RefArgType -> <:expr< Genarg.wit_ref >>
-  | QuantHypArgType -> <:expr< Genarg.wit_quant_hyp >>
-  | SortArgType -> <:expr< Genarg.wit_sort >>
-  | ConstrArgType -> <:expr< Genarg.wit_constr >>
-  | ConstrMayEvalArgType -> <:expr< Genarg.wit_constr_may_eval >>
-  | RedExprArgType -> <:expr< Genarg.wit_red_expr >>
-  | OpenConstrArgType (b1,b2) -> <:expr< Genarg.wit_open_constr_gen ($mlexpr_of_bool b1$,$mlexpr_of_bool b2$) >>
-  | ConstrWithBindingsArgType -> <:expr< Genarg.wit_constr_with_bindings >>
-  | BindingsArgType -> <:expr< Genarg.wit_bindings >>
-  | List0ArgType t -> <:expr< Genarg.wit_list0 $make_wit loc t$ >>
-  | List1ArgType t -> <:expr< Genarg.wit_list1 $make_wit loc t$ >>
-  | OptArgType t -> <:expr< Genarg.wit_opt $make_wit loc t$ >>
-  | PairArgType (t1,t2) ->
-      <:expr< Genarg.wit_pair $make_wit loc t1$ $make_wit loc t2$ >>
-  | ExtraArgType s ->
-    <:expr<
-      let module WIT = struct
-        open Extrawit;
-        value wit = $lid:"wit_"^s$;
-      end in WIT.wit >>
-
-let has_extraarg =
-  List.exists (function GramNonTerminal(_,ExtraArgType _,_,_) -> true | _ -> false)
-
-let statically_known_possibly_empty s (prods,_) =
-  List.for_all (function
-    | GramNonTerminal(_,ExtraArgType s',_,_) ->
-        (* For ExtraArg we don't know (we'll have to test dynamically) *)
-        (* unless it is a recursive call *)
-        s <> s'
-    | GramNonTerminal(_,(OptArgType _|List0ArgType _),_,_) ->
-        (* Opt and List0 parses the empty string *)
-        true
-    | _ ->
-        (* This consumes a token for sure *) false)
-      prods
-
-let possibly_empty_subentries loc (prods,act) =
-  let bind_name p v e = match p with
-    | None -> e
-    | Some id ->
-        let s = Names.string_of_id id in <:expr< let $lid:s$ = $v$ in $e$ >> in
-  let rec aux = function
-    | [] -> <:expr< let loc = $default_loc$ in let _ = loc = loc in $act$ >>
-    | GramNonTerminal(_,OptArgType _,_,p) :: tl ->
-        bind_name p <:expr< None >> (aux tl)
-    | GramNonTerminal(_,List0ArgType _,_,p) :: tl ->
-        bind_name p <:expr< [] >> (aux tl)
-    | GramNonTerminal(_,(ExtraArgType _ as t),_,p) :: tl ->
-        (* We check at runtime if extraarg s parses "epsilon" *)
-        let s = match p with None -> "_" | Some id -> Names.string_of_id id in
-        <:expr< let $lid:s$ = match Genarg.default_empty_value $make_rawwit loc t$ with
-          [ None -> raise Exit
-          | Some v -> v ] in $aux tl$ >>
-    | _ -> assert false (* already filtered out *) in
-  if has_extraarg prods then
-    (* Needs a dynamic check; catch all exceptions if ever some rhs raises *)
-    (* an exception rather than returning a value; *)
-    (* declares loc because some code can refer to it; *)
-    (* ensures loc is used to avoid "unused variable" warning *)
-    (true, <:expr< try Some $aux prods$ with [ e when Errors.noncritical e -> None ] >>)
-  else
-    (* Static optimisation *)
-    (false, aux prods)
-
-let make_possibly_empty_subentries loc s cl =
-  let cl = List.filter (statically_known_possibly_empty s) cl in
-  if cl = [] then
-    <:expr< None >>
-  else
-    let rec aux = function
-    | (true, e) :: l ->
-        <:expr< match $e$ with [ Some v -> Some v | None -> $aux l$ ] >>
-    | (false, e) :: _ ->
-        <:expr< Some $e$ >>
-    | [] ->
-        <:expr< None >> in
-    aux (List.map (possibly_empty_subentries loc) cl)
-
-let make_act loc act pil =
-  let rec make = function
-    | [] -> <:expr< Pcoq.Gram.action (fun loc -> ($act$ : 'a)) >>
-    | GramNonTerminal (_,t,_,Some p) :: tl ->
-	let p = Names.string_of_id p in
-	<:expr<
-          Pcoq.Gram.action
-            (fun $lid:p$ ->
-               let _ = Genarg.in_gen $make_rawwit loc t$ $lid:p$ in $make tl$)
-        >>
-    | (GramTerminal _ | GramNonTerminal (_,_,_,None)) :: tl ->
-	<:expr< Pcoq.Gram.action (fun _ -> $make tl$) >> in
-  make (List.rev pil)
-
-let make_prod_item = function
-  | GramTerminal s -> <:expr< Pcoq.gram_token_of_string $str:s$ >>
-  | GramNonTerminal (_,_,g,_) ->
-      <:expr< Pcoq.symbol_of_prod_entry_key $mlexpr_of_prod_entry_key g$ >>
-
-let make_rule loc (prods,act) =
-  <:expr< ($mlexpr_of_list make_prod_item prods$,$make_act loc act prods$) >>
-
-let declare_tactic_argument loc s (typ, pr, f, g, h) cl =
-  let rawtyp, rawpr, globtyp, globpr = match typ with
-    | `Uniform typ -> typ, pr, typ, pr
-    | `Specialized (a, b, c, d) -> a, b, c, d
-  in
-  let glob = match g with
-    | None ->
-	<:expr< fun e x ->
-          out_gen $make_globwit loc rawtyp$
-            (Tacinterp.intern_genarg e
-               (Genarg.in_gen $make_rawwit loc rawtyp$ x)) >>
-    | Some f -> <:expr< $lid:f$>> in
-  let interp = match f with
-    | None ->
-	<:expr< fun ist gl x ->
-	  let (sigma,a_interp) =
-	    Tacinterp.interp_genarg ist gl
-               (Genarg.in_gen $make_globwit loc globtyp$ x)
-	  in
-          (sigma , out_gen $make_wit loc globtyp$ a_interp)>>
-    | Some f -> <:expr< $lid:f$>> in
-  let substitute = match h with
-    | None ->
-	<:expr< fun s x ->
-          out_gen $make_globwit loc globtyp$
-	    (Tacinterp.subst_genarg s
-               (Genarg.in_gen $make_globwit loc globtyp$ x)) >>
-    | Some f -> <:expr< $lid:f$>> in
-  let se = mlexpr_of_string s in
-  let wit = <:expr< $lid:"wit_"^s$ >> in
-  let rawwit = <:expr< $lid:"rawwit_"^s$ >> in
-  let globwit = <:expr< $lid:"globwit_"^s$ >> in
-  let rules = mlexpr_of_list (make_rule loc) (List.rev cl) in
-  let default_value = <:expr< $make_possibly_empty_subentries loc s cl$ >> in
-  declare_str_items loc
-   [ <:str_item<
-      value ($lid:"wit_"^s$, $lid:"globwit_"^s$, $lid:"rawwit_"^s$) =
-      Genarg.create_arg $default_value$ $se$>>;
-     <:str_item<
-      value $lid:s$ = Pcoq.create_generic_entry $se$ $rawwit$ >>;
-     <:str_item< do {
-      Tacinterp.add_interp_genarg $se$
-        ((fun e x ->
-          (Genarg.in_gen $globwit$ ($glob$ e (out_gen $rawwit$ x)))),
-        (fun ist gl x ->
-	  let (sigma,a_interp) = $interp$ ist gl (out_gen $globwit$ x) in
-          (sigma , Genarg.in_gen $wit$ a_interp)),
-        (fun subst x ->
-          (Genarg.in_gen $globwit$ ($substitute$ subst (out_gen $globwit$ x)))));
-      Compat.maybe_uncurry (Pcoq.Gram.extend ($lid:s$ : Pcoq.Gram.entry 'a))
-	(None, [(None, None, $rules$)]);
-      Pptactic.declare_extra_genarg_pprule
-        ($rawwit$, $lid:rawpr$)
-        ($globwit$, $lid:globpr$)
-        ($wit$, $lid:pr$) }
-     >> ]
-
-let declare_vernac_argument loc s pr cl =
-  let se = mlexpr_of_string s in
-  let wit = <:expr< $lid:"wit_"^s$ >> in
-  let rawwit = <:expr< $lid:"rawwit_"^s$ >> in
-  let globwit = <:expr< $lid:"globwit_"^s$ >> in
-  let rules = mlexpr_of_list (make_rule loc) (List.rev cl) in
-  let pr_rules = match pr with
-    | None -> <:expr< fun _ _ _ _ -> str $str:"[No printer for "^s^"]"$ >>
-    | Some pr -> <:expr< fun _ _ _ -> $lid:pr$ >> in
-  declare_str_items loc
-   [ <:str_item<
-      value (($lid:"wit_"^s$:Genarg.abstract_argument_type unit Genarg.tlevel),
-             ($lid:"globwit_"^s$:Genarg.abstract_argument_type unit Genarg.glevel),
-              $lid:"rawwit_"^s$) = Genarg.create_arg None $se$ >>;
-     <:str_item<
-      value $lid:s$ = Pcoq.create_generic_entry $se$ $rawwit$ >>;
-    <:str_item< do {
-      Compat.maybe_uncurry (Pcoq.Gram.extend ($lid:s$ : Pcoq.Gram.entry 'a))
-	(None, [(None, None, $rules$)]);
-      Pptactic.declare_extra_genarg_pprule
-        ($rawwit$, $pr_rules$)
-        ($globwit$, fun _ _ _ _ -> Util.anomaly "vernac argument needs not globwit printer")
-        ($wit$, fun _ _ _ _ -> Util.anomaly "vernac argument needs not wit printer") }
-      >> ]
-
-open Vernacexpr
-open Pcoq
-open Pcaml
-open PcamlSig
-
-EXTEND
-  GLOBAL: str_item;
-  str_item:
-    [ [ "ARGUMENT"; "EXTEND"; s = entry_name;
-        header = argextend_header;
-        OPT "|"; l = LIST1 argrule SEP "|";
-        "END" ->
-         declare_tactic_argument loc s header l
-      | "VERNAC"; "ARGUMENT"; "EXTEND"; s = entry_name;
-        pr = OPT ["PRINTED"; "BY"; pr = LIDENT -> pr];
-        OPT "|"; l = LIST1 argrule SEP "|";
-        "END" ->
-         declare_vernac_argument loc s pr l ] ]
-  ;
-  argextend_header:
-    [ [ "TYPED"; "AS"; typ = argtype;
-        "PRINTED"; "BY"; pr = LIDENT;
-        f = OPT [ "INTERPRETED"; "BY"; f = LIDENT -> f ];
-        g = OPT [ "GLOBALIZED"; "BY"; f = LIDENT -> f ];
-        h = OPT [ "SUBSTITUTED"; "BY"; f = LIDENT -> f ] ->
-        (`Uniform typ, pr, f, g, h)
-      | "PRINTED"; "BY"; pr = LIDENT;
-        f = OPT [ "INTERPRETED"; "BY"; f = LIDENT -> f ];
-        g = OPT [ "GLOBALIZED"; "BY"; f = LIDENT -> f ];
-        h = OPT [ "SUBSTITUTED"; "BY"; f = LIDENT -> f ];
-        "RAW_TYPED"; "AS"; rawtyp = argtype;
-        "RAW_PRINTED"; "BY"; rawpr = LIDENT;
-        "GLOB_TYPED"; "AS"; globtyp = argtype;
-        "GLOB_PRINTED"; "BY"; globpr = LIDENT ->
-        (`Specialized (rawtyp, rawpr, globtyp, globpr), pr, f, g, h) ] ]
-  ;
-  argtype:
-    [ "2"
-      [ e1 = argtype; "*"; e2 = argtype -> PairArgType (e1, e2) ]
-    | "1"
-      [ e = argtype; LIDENT "list" -> List0ArgType e
-      | e = argtype; LIDENT "option" -> OptArgType e ]
-    | "0"
-      [ e = LIDENT -> fst (interp_entry_name false None e "")
-      | "("; e = argtype; ")" -> e ] ]
-  ;
-  argrule:
-    [ [ "["; l = LIST0 genarg; "]"; "->"; "["; e = Pcaml.expr; "]" -> (l,e) ] ]
-  ;
-  genarg:
-    [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = interp_entry_name false None e "" in
-	GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
-        let t, g = interp_entry_name false None e sep in
-	GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | s = STRING ->
-	  if String.length s > 0 && Util.is_letter s.[0] then
-	    Lexer.add_keyword s;
-          GramTerminal s
-    ] ]
-  ;
-  entry_name:
-    [ [ s = LIDENT -> s
-      | UIDENT -> failwith "Argument entry names must be lowercase"
-      ] ]
-  ;
-  END
-
diff --git a/parsing/compat.ml4 b/parsing/compat.ml4
new file mode 100644
index 00000000..eba1d2b8
--- /dev/null
+++ b/parsing/compat.ml4
@@ -0,0 +1,325 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Compatibility file depending on ocaml/camlp4 version *)
+
+(** Locations *)
+
+IFDEF CAMLP5 THEN
+
+module CompatLoc = struct
+  include Ploc
+  let ghost = dummy
+  let merge = encl
+end
+
+exception Exc_located = Ploc.Exc
+
+IFDEF CAMLP5_6_00 THEN
+let ploc_make_loc fname lnb pos bpep = Ploc.make_loc fname lnb pos bpep ""
+let ploc_file_name = Ploc.file_name
+ELSE
+let ploc_make_loc fname lnb pos bpep = Ploc.make lnb pos bpep
+let ploc_file_name _ = ""
+END
+
+let of_coqloc loc =
+  let (fname, lnb, pos, bp, ep) = Loc.represent loc in
+  ploc_make_loc fname lnb pos (bp,ep)
+
+let to_coqloc loc =
+  Loc.create (ploc_file_name loc) (Ploc.line_nb loc)
+    (Ploc.bol_pos loc) (Ploc.first_pos loc, Ploc.last_pos loc)
+
+let make_loc = Ploc.make_unlined
+
+ELSE
+
+module CompatLoc = Camlp4.PreCast.Loc
+
+exception Exc_located = CompatLoc.Exc_located
+
+let of_coqloc loc =
+  let (fname, lnb, pos, bp, ep) = Loc.represent loc in
+  CompatLoc.of_tuple (fname, 0, 0, bp, 0, 0, ep, false)
+
+let to_coqloc loc =
+  Loc.create (CompatLoc.file_name loc) (CompatLoc.start_line loc)
+    (CompatLoc.start_bol loc) (CompatLoc.start_off loc, CompatLoc.stop_off loc)
+
+let make_loc (start, stop) =
+  CompatLoc.of_tuple ("", 0, 0, start, 0, 0, stop, false)
+
+END
+
+let (!@) = to_coqloc
+
+(** Misc module emulation *)
+
+IFDEF CAMLP5 THEN
+
+module PcamlSig = struct end
+module Token = Token
+
+ELSE
+
+module PcamlSig = Camlp4.Sig
+module Ast = Camlp4.PreCast.Ast
+module Pcaml = Camlp4.PreCast.Syntax
+module MLast = Ast
+module Token = struct exception Error of string end
+
+END
+
+
+(** Grammar auxiliary types *)
+
+IFDEF CAMLP5 THEN
+
+let to_coq_assoc = function
+| Gramext.RightA -> Extend.RightA
+| Gramext.LeftA -> Extend.LeftA
+| Gramext.NonA -> Extend.NonA
+
+let of_coq_assoc = function
+| Extend.RightA -> Gramext.RightA
+| Extend.LeftA -> Gramext.LeftA
+| Extend.NonA -> Gramext.NonA
+
+let of_coq_position = function
+| Extend.First -> Gramext.First
+| Extend.Last -> Gramext.Last
+| Extend.Before s -> Gramext.Before s
+| Extend.After s -> Gramext.After s
+| Extend.Level s -> Gramext.Level s
+
+let to_coq_position = function
+| Gramext.First -> Extend.First
+| Gramext.Last -> Extend.Last
+| Gramext.Before s -> Extend.Before s
+| Gramext.After s -> Extend.After s
+| Gramext.Level s -> Extend.Level s
+| Gramext.Like _ -> assert false (** dont use it, not in camlp4 *)
+
+ELSE
+
+let to_coq_assoc = function
+| PcamlSig.Grammar.RightA -> Extend.RightA
+| PcamlSig.Grammar.LeftA -> Extend.LeftA
+| PcamlSig.Grammar.NonA -> Extend.NonA
+
+let of_coq_assoc = function
+| Extend.RightA -> PcamlSig.Grammar.RightA
+| Extend.LeftA -> PcamlSig.Grammar.LeftA
+| Extend.NonA -> PcamlSig.Grammar.NonA
+
+let of_coq_position = function
+| Extend.First -> PcamlSig.Grammar.First
+| Extend.Last -> PcamlSig.Grammar.Last
+| Extend.Before s -> PcamlSig.Grammar.Before s
+| Extend.After s -> PcamlSig.Grammar.After s
+| Extend.Level s -> PcamlSig.Grammar.Level s
+
+let to_coq_position = function
+| PcamlSig.Grammar.First -> Extend.First
+| PcamlSig.Grammar.Last -> Extend.Last
+| PcamlSig.Grammar.Before s -> Extend.Before s
+| PcamlSig.Grammar.After s -> Extend.After s
+| PcamlSig.Grammar.Level s -> Extend.Level s
+
+END
+
+
+(** Signature of Lexer *)
+
+IFDEF CAMLP5 THEN
+
+module type LexerSig = sig
+  include Grammar.GLexerType with type te = Tok.t
+  module Error : sig
+    type t
+    exception E of t
+    val to_string : t -> string
+  end
+end
+
+ELSE
+
+module type LexerSig =
+  Camlp4.Sig.Lexer with module Loc = CompatLoc and type Token.t = Tok.t
+
+END
+
+(** Signature and implementation of grammars *)
+
+IFDEF CAMLP5 THEN
+
+module type GrammarSig = sig
+  include Grammar.S with type te = Tok.t
+  type 'a entry = 'a Entry.e
+  type internal_entry = Tok.t Gramext.g_entry
+  type symbol = Tok.t Gramext.g_symbol
+  type action = Gramext.g_action
+  type production_rule = symbol list * action
+  type single_extend_statment =
+      string option * Gramext.g_assoc option * production_rule list
+  type extend_statment =
+      Gramext.position option * single_extend_statment list
+  val action : 'a -> action
+  val entry_create : string -> 'a entry
+  val entry_parse : 'a entry -> parsable -> 'a
+  val entry_print : Format.formatter -> 'a entry -> unit
+  val srules' : production_rule list -> symbol
+  val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a
+end
+
+module GrammarMake (L:LexerSig) : GrammarSig = struct
+  include Grammar.GMake (L)
+  type 'a entry = 'a Entry.e
+  type internal_entry = Tok.t Gramext.g_entry
+  type symbol = Tok.t Gramext.g_symbol
+  type action = Gramext.g_action
+  type production_rule = symbol list * action
+  type single_extend_statment =
+      string option * Gramext.g_assoc option * production_rule list
+  type extend_statment =
+      Gramext.position option * single_extend_statment list
+  let action = Gramext.action
+  let entry_create = Entry.create
+  let entry_parse e p =
+    try Entry.parse e p
+    with Exc_located (loc,e) -> Loc.raise (to_coqloc loc) e
+IFDEF CAMLP5_6_02_1 THEN
+  let entry_print ft x = Entry.print ft x
+ELSE
+  let entry_print _ x = Entry.print x
+END
+  let srules' = Gramext.srules
+  let parse_tokens_after_filter = Entry.parse_token
+end
+
+ELSE
+
+module type GrammarSig = sig
+  include Camlp4.Sig.Grammar.Static
+    with module Loc = CompatLoc and type Token.t = Tok.t
+  type 'a entry = 'a Entry.t
+  type action = Action.t
+  type parsable
+  val parsable : char Stream.t -> parsable
+  val action : 'a -> action
+  val entry_create : string -> 'a entry
+  val entry_parse : 'a entry -> parsable -> 'a
+  val entry_print : Format.formatter -> 'a entry -> unit
+  val srules' : production_rule list -> symbol
+end
+
+module GrammarMake (L:LexerSig) : GrammarSig = struct
+  (* We need to refer to Coq's module Loc before it is hidden by include *)
+  let raise_coq_loc loc e = Loc.raise (to_coqloc loc) e
+  include Camlp4.Struct.Grammar.Static.Make (L)
+  type 'a entry = 'a Entry.t
+  type action = Action.t
+  type parsable = char Stream.t
+  let parsable s = s
+  let action = Action.mk
+  let entry_create = Entry.mk
+  let entry_parse e s =
+    try parse e (*FIXME*)CompatLoc.ghost s
+    with Exc_located (loc,e) -> raise_coq_loc loc e
+  let entry_print ft x = Entry.print ft x
+  let srules' = srules (entry_create "dummy")
+end
+
+END
+
+
+(** Misc functional adjustments *)
+
+(** - The lexer produces streams made of pairs in camlp4 *)
+
+let get_tok = IFDEF CAMLP5 THEN fun x -> x ELSE fst END
+
+(** - Gram.extend is more currified in camlp5 than in camlp4 *)
+
+IFDEF CAMLP5 THEN
+let maybe_curry f x y = f (x,y)
+let maybe_uncurry f (x,y) = f x y
+ELSE
+let maybe_curry f = f
+let maybe_uncurry f = f
+END
+
+(** Compatibility with camlp5 strict mode *)
+IFDEF CAMLP5 THEN
+  IFDEF STRICT THEN
+    let vala x = Ploc.VaVal x
+  ELSE
+    let vala x = x
+  END
+ELSE
+  let vala x = x
+END
+
+(** Fix a quotation difference in [str_item] *)
+
+let declare_str_items loc l =
+IFDEF CAMLP5 THEN
+  MLast.StDcl (loc, vala l) (* correspond to <:str_item< declare $list:l'$ end >> *)
+ELSE
+  Ast.stSem_of_list l
+END
+
+(** Quotation difference for match clauses *)
+
+let default_patt loc =
+  (<:patt< _ >>, vala None, <:expr< failwith "Extension: cannot occur" >>)
+
+IFDEF CAMLP5 THEN
+
+let make_fun loc cl =
+  let l = cl @ [default_patt loc] in
+  MLast.ExFun (loc, vala l)  (* correspond to <:expr< fun [ $list:l$ ] >> *)
+
+ELSE
+
+let make_fun loc cl =
+  let mk_when = function
+    | Some w -> w
+    | None -> Ast.ExNil loc
+  in
+  let mk_clause (patt,optwhen,expr) =
+    (* correspond to <:match_case< ... when ... -> ... >> *)
+    Ast.McArr (loc, patt, mk_when optwhen, expr) in
+  let init = mk_clause (default_patt loc) in
+  let add_clause x acc = Ast.McOr (loc, mk_clause x, acc) in
+  let l = List.fold_right add_clause cl init in
+  Ast.ExFun (loc,l) (* correspond to <:expr< fun [ $l$ ] >> *)
+
+END
+
+(** Explicit antiquotation $anti:... $ *)
+
+IFDEF CAMLP5 THEN
+let expl_anti loc e = <:expr< $anti:e$ >>
+ELSE
+let expl_anti _loc e = e (* FIXME: understand someday if we can do better *)
+END
+
+(** Qualified names in OCaml *)
+
+IFDEF CAMLP5 THEN
+let qualified_name loc path name =
+  let fold dir accu = <:expr< $uid:dir$.$accu$ >> in
+  List.fold_right fold path <:expr< $lid:name$ >>
+ELSE
+let qualified_name loc path name =
+  let fold dir accu = Ast.IdAcc (loc, Ast.IdUid (loc, dir), accu) in
+  let path = List.fold_right fold path (Ast.IdLid (loc, name)) in
+  Ast.ExId (loc, path)
+END
diff --git a/parsing/egrammar.ml b/parsing/egramcoq.ml
index 6deb7622..01194c60 100644
--- a/parsing/egrammar.ml
+++ b/parsing/egramcoq.ml
@@ -1,24 +1,22 @@
 (************************************************************************)
 (*  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 Compat
+open Errors
 open Util
 open Pcoq
 open Extend
-open Ppextend
-open Topconstr
-open Genarg
+open Constrexpr
+open Notation_term
 open Libnames
-open Nameops
 open Tacexpr
 open Names
-open Vernacexpr
+open Egramml
 
 (**************************************************************************)
 (*
@@ -48,8 +46,8 @@ open Vernacexpr
 (** Declare Notations grammar rules                                   *)
 
 let constr_expr_of_name (loc,na) = match na with
-  | Anonymous -> CHole (loc,None)
-  | Name id -> CRef (Ident (loc,id))
+  | Anonymous -> CHole (loc,None,Misctypes.IntroAnonymous,None)
+  | Name id -> CRef (Ident (loc,id), None)
 
 let cases_pattern_expr_of_name (loc,na) = match na with
   | Anonymous -> CPatAtom (loc,None)
@@ -57,16 +55,16 @@ let cases_pattern_expr_of_name (loc,na) = match na with
 
 type grammar_constr_prod_item =
   | GramConstrTerminal of Tok.t
-  | GramConstrNonTerminal of constr_prod_entry_key * identifier option
+  | GramConstrNonTerminal of constr_prod_entry_key * Id.t option
   | GramConstrListMark of int * bool
-    (* tells action rule to make a list of the n previous parsed items; 
+    (* tells action rule to make a list of the n previous parsed items;
        concat with last parsed list if true *)
 
 let make_constr_action
-  (f : loc -> constr_notation_substitution -> constr_expr) pil =
+  (f : Loc.t -> constr_notation_substitution -> constr_expr) pil =
   let rec make (constrs,constrlists,binders as fullsubst) = function
   | [] ->
-      Gram.action (fun loc -> f loc fullsubst)
+      Gram.action (fun (loc:CompatLoc.t) -> f (!@loc) fullsubst)
   | (GramConstrTerminal _ | GramConstrNonTerminal (_,None)) :: tl ->
       (* parse a non-binding item *)
       Gram.action (fun _ -> make fullsubst tl)
@@ -78,13 +76,13 @@ let make_constr_action
 	  make (v :: constrs, constrlists, binders) tl)
     | ETReference ->
         Gram.action (fun (v:reference) ->
-	  make (CRef v :: constrs, constrlists, binders) tl)
+	  make (CRef (v,None) :: constrs, constrlists, binders) tl)
     | ETName ->
-        Gram.action (fun (na:name located) ->
+        Gram.action (fun (na:Loc.t * Name.t) ->
 	  make (constr_expr_of_name na :: constrs, constrlists, binders) tl)
     | ETBigint ->
         Gram.action (fun (v:Bigint.bigint) ->
-	  make (CPrim(dummy_loc,Numeral v) :: constrs, constrlists, binders) tl)
+	  make (CPrim(Loc.ghost,Numeral v) :: constrs, constrlists, binders) tl)
     | ETConstrList (_,n) ->
 	Gram.action (fun (v:constr_expr list) ->
 	  make (constrs, v::constrlists, binders) tl)
@@ -98,7 +96,7 @@ let make_constr_action
 	failwith "Unexpected entry of type cases pattern")
   | GramConstrListMark (n,b) :: tl ->
       (* Rebuild expansions of ConstrList *)
-      let heads,constrs = list_chop n constrs in
+      let heads,constrs = List.chop n constrs in
       let constrlists =
 	if b then (heads@List.hd constrlists)::List.tl constrlists
 	else heads::constrlists
@@ -107,13 +105,17 @@ let make_constr_action
   make ([],[],[]) (List.rev pil)
 
 let check_cases_pattern_env loc (env,envlist,hasbinders) =
-  if hasbinders then error_invalid_pattern_notation loc else (env,envlist)
+  if hasbinders then Topconstr.error_invalid_pattern_notation loc
+  else (env,envlist)
 
 let make_cases_pattern_action
-  (f : loc -> cases_pattern_notation_substitution -> cases_pattern_expr) pil =
+  (f : Loc.t -> cases_pattern_notation_substitution -> cases_pattern_expr) pil =
   let rec make (env,envlist,hasbinders as fullenv) = function
   | [] ->
-      Gram.action (fun loc -> f loc (check_cases_pattern_env loc fullenv))
+      Gram.action
+	(fun (loc:CompatLoc.t) ->
+	  let loc = !@loc in
+	  f loc (check_cases_pattern_env loc fullenv))
   | (GramConstrTerminal _ | GramConstrNonTerminal (_,None)) :: tl ->
       (* parse a non-binding item *)
       Gram.action (fun _ -> make fullenv tl)
@@ -125,13 +127,13 @@ let make_cases_pattern_action
           make (v::env, envlist, hasbinders) tl)
     | ETReference ->
         Gram.action (fun (v:reference) ->
-	  make (CPatAtom (dummy_loc,Some v) :: env, envlist, hasbinders) tl)
+	  make (CPatAtom (Loc.ghost,Some v) :: env, envlist, hasbinders) tl)
     | ETName ->
-        Gram.action (fun (na:name located) ->
+        Gram.action (fun (na:Loc.t * Name.t) ->
 	  make (cases_pattern_expr_of_name na :: env, envlist, hasbinders) tl)
     | ETBigint ->
         Gram.action (fun (v:Bigint.bigint) ->
-	  make (CPatPrim (dummy_loc,Numeral v) :: env, envlist, hasbinders) tl)
+	  make (CPatPrim (Loc.ghost,Numeral v) :: env, envlist, hasbinders) tl)
     | ETConstrList (_,_) ->
         Gram.action  (fun (vl:cases_pattern_expr list) ->
 	  make (env, vl :: envlist, hasbinders) tl)
@@ -142,10 +144,10 @@ let make_cases_pattern_action
 	Gram.action (fun (v:local_binder list list) ->
 	  make (env, envlist, true) tl)
     | (ETPattern | ETOther _) ->
-        anomaly "Unexpected entry of type cases pattern or other")
+        anomaly (Pp.str "Unexpected entry of type cases pattern or other"))
   | GramConstrListMark (n,b) :: tl ->
       (* Rebuild expansions of ConstrList *)
-      let heads,env = list_chop n env in
+      let heads,env = List.chop n env in
       if b then
         make (env,(heads@List.hd envlist)::List.tl envlist,hasbinders) tl
       else
@@ -171,169 +173,158 @@ let prepare_empty_levels forpat (pos,p4assoc,name,reinit) =
   grammar_extend entry reinit (pos,[(name, p4assoc, [])])
 
 let pure_sublevels level symbs =
-  map_succeed
-    (function s ->
-       let i = level_of_snterml s in
-       if level = Some i then failwith "";
-       i)
-    symbs
+  let filter s =
+    try
+      let i = level_of_snterml s in
+      begin match level with
+      | Some j when Int.equal i j -> None
+      | _ -> Some i
+      end
+    with Failure _ -> None
+  in
+  List.map_filter filter symbs
 
 let extend_constr (entry,level) (n,assoc) mkact forpat rules =
   List.fold_left (fun nb pt ->
   let symbs = make_constr_prod_item assoc n forpat pt in
   let pure_sublevels = pure_sublevels level symbs in
   let needed_levels = register_empty_levels forpat pure_sublevels in
+  let map_level (pos, ass1, name, ass2) =
+    (Option.map of_coq_position pos, Option.map of_coq_assoc ass1, name, ass2) in
+  let needed_levels = List.map map_level needed_levels in
   let pos,p4assoc,name,reinit = find_position forpat assoc level in
   let nb_decls = List.length needed_levels + 1 in
   List.iter (prepare_empty_levels forpat) needed_levels;
-  grammar_extend entry reinit (pos,[(name, p4assoc, [symbs, mkact pt])]);
+  grammar_extend entry reinit (Option.map of_coq_position pos,
+    [(name, Option.map of_coq_assoc p4assoc, [symbs, mkact pt])]);
   nb_decls) 0 rules
 
-let extend_constr_notation (n,assoc,ntn,rules) =
+type notation_grammar = {
+  notgram_level : int;
+  notgram_assoc : gram_assoc option;
+  notgram_notation : notation;
+  notgram_prods : grammar_constr_prod_item list list;
+  notgram_typs : notation_var_internalization_type list;
+}
+
+let extend_constr_constr_notation ng =
+  let level = ng.notgram_level in
+  let mkact loc env = CNotation (loc, ng.notgram_notation, env) in
+  let e = interp_constr_entry_key false (ETConstr (level, ())) in
+  let ext = (ETConstr (level, ()), ng.notgram_assoc) in
+  extend_constr e ext (make_constr_action mkact) false ng.notgram_prods
+
+let extend_constr_pat_notation ng =
+  let level = ng.notgram_level in
+  let mkact loc env = CPatNotation (loc, ng.notgram_notation, env, []) in
+  let e = interp_constr_entry_key true (ETConstr (level, ())) in
+  let ext = ETConstr (level, ()), ng.notgram_assoc in
+  extend_constr e ext (make_cases_pattern_action mkact) true ng.notgram_prods
+
+let extend_constr_notation ng =
   (* Add the notation in constr *)
-  let mkact loc env = CNotation (loc,ntn,env) in
-  let e = interp_constr_entry_key false (ETConstr (n,())) in
-  let nb = extend_constr e (ETConstr(n,()),assoc) (make_constr_action mkact) false rules in
+  let nb = extend_constr_constr_notation ng in
   (* Add the notation in cases_pattern *)
-  let mkact loc env = CPatNotation (loc,ntn,env) in
-  let e = interp_constr_entry_key true (ETConstr (n,())) in
-  let nb' = extend_constr e (ETConstr (n,()),assoc) (make_cases_pattern_action mkact)
-    true rules in
-  nb+nb'
-
-(**********************************************************************)
-(** Making generic actions in type generic_argument                   *)
-
-let make_generic_action
-  (f:loc -> ('b * raw_generic_argument) list -> 'a) pil =
-  let rec make env = function
-    | [] ->
-	Gram.action (fun loc -> f loc env)
-    | None :: tl -> (* parse a non-binding item *)
-        Gram.action (fun _ -> make env tl)
-    | Some (p, t) :: tl -> (* non-terminal *)
-        Gram.action (fun v -> make ((p,in_generic t v) :: env) tl) in
-  make [] (List.rev pil)
-
-let make_rule univ f g pt =
-  let (symbs,ntl) = List.split (List.map g pt) in
-  let act = make_generic_action f ntl in
-  (symbs, act)
-
-(**********************************************************************)
-(** Grammar extensions declared at ML level                           *)
-
-type grammar_prod_item =
-  | GramTerminal of string
-  | GramNonTerminal of
-      loc * argument_type * prod_entry_key * identifier option
-
-let make_prod_item = function
-  | GramTerminal s -> (gram_token_of_string s, None)
-  | GramNonTerminal (_,t,e,po) ->
-      (symbol_of_prod_entry_key e, Option.map (fun p -> (p,t)) po)
-
-(* Tactic grammar extensions *)
-
-let extend_tactic_grammar s gl =
-  let univ = get_univ "tactic" in
-  let mkact loc l = Tacexpr.TacExtend (loc,s,List.map snd l) in
-  let rules = List.map (make_rule univ mkact make_prod_item) gl in
-  maybe_uncurry (Gram.extend Tactic.simple_tactic)
-    (None,[(None, None, List.rev rules)])
-
-(* Vernac grammar extensions *)
-
-let vernac_exts = ref []
-let get_extend_vernac_grammars () = !vernac_exts
-
-let extend_vernac_command_grammar s nt gl =
-  let nt = Option.default Vernac_.command nt in
-  vernac_exts := (s,gl) :: !vernac_exts;
-  let univ = get_univ "vernac" in
-  let mkact loc l = VernacExtend (s,List.map snd l) in
-  let rules = List.map (make_rule univ mkact make_prod_item) gl in
-  maybe_uncurry (Gram.extend nt) (None,[(None, None, List.rev rules)])
+  let nb' = extend_constr_pat_notation ng in
+  nb + nb'
 
 (**********************************************************************)
 (** Grammar declaration for Tactic Notation (Coq level)               *)
 
 let get_tactic_entry n =
-  if n = 0 then
+  if Int.equal n 0 then
     weaken_entry Tactic.simple_tactic, None
-  else if n = 5 then
+  else if Int.equal n 5 then
     weaken_entry Tactic.binder_tactic, None
   else if 1<=n && n<5 then
-    weaken_entry Tactic.tactic_expr, Some (Compat.Level (string_of_int n))
+    weaken_entry Tactic.tactic_expr, Some (Extend.Level (string_of_int n))
   else
     error ("Invalid Tactic Notation level: "^(string_of_int n)^".")
 
-(* Declaration of the tactic grammar rule *)
+(**********************************************************************)
+(** State of the grammar extensions                                   *)
 
-let head_is_ident = function GramTerminal _::_ -> true | _ -> false
-
-let add_tactic_entry (key,lev,prods,tac) =
-  let univ = get_univ "tactic" in
-  let entry, pos = get_tactic_entry lev in
-  let rules =
-    if lev = 0 then begin
-      if not (head_is_ident prods) then
-	error "Notation for simple tactic must start with an identifier.";
-      let mkact s tac loc l =
-	(TacAlias(loc,s,l,tac):raw_atomic_tactic_expr) in
-      make_rule univ (mkact key tac) make_prod_item prods
-    end
-    else
-      let mkact s tac loc l =
-	(TacAtom(loc,TacAlias(loc,s,l,tac)):raw_tactic_expr) in
-      make_rule univ (mkact key tac) make_prod_item prods in
+type tactic_grammar = {
+  tacgram_level : int;
+  tacgram_prods : grammar_prod_item list;
+}
+
+type all_grammar_command =
+  | Notation of Notation.level * notation_grammar
+  | TacticGrammar of KerName.t * tactic_grammar
+  | MLTacticGrammar of ml_tactic_name * grammar_prod_item list list
+
+(** ML Tactic grammar extensions *)
+
+let add_ml_tactic_entry name prods =
+  let entry = weaken_entry Tactic.simple_tactic in
+  let mkact loc l : raw_tactic_expr = Tacexpr.TacML (loc, name, List.map snd l) in
+  let rules = List.map (make_rule mkact) prods in
   synchronize_level_positions ();
-  grammar_extend entry None (pos,[(None, None, List.rev [rules])]);
+  grammar_extend entry None (None ,[(None, None, List.rev rules)]);
   1
 
-(**********************************************************************)
-(** State of the grammar extensions                                   *)
+(* Declaration of the tactic grammar rule *)
 
-type notation_grammar =
-    int * gram_assoc option * notation * grammar_constr_prod_item list list
+let head_is_ident tg = match tg.tacgram_prods with
+| GramTerminal _::_ -> true
+| _ -> false
 
-type all_grammar_command =
-  | Notation of
-	 (precedence * tolerability list) *
-	  notation_var_internalization_type list *
-	  notation_grammar
-  | TacticGrammar of
-      (string * int * grammar_prod_item list *
-         (dir_path * Tacexpr.glob_tactic_expr))
+(** Tactic grammar extensions *)
+
+let add_tactic_entry kn tg =
+  let entry, pos = get_tactic_entry tg.tacgram_level in
+  let mkact loc l = (TacAlias (loc,kn,l):raw_tactic_expr) in
+  let () =
+    if Int.equal tg.tacgram_level 0 && not (head_is_ident tg) then
+      error "Notation for simple tactic must start with an identifier."
+  in
+  let rules = make_rule mkact tg.tacgram_prods in
+  synchronize_level_positions ();
+  grammar_extend entry None (Option.map of_coq_position pos,[(None, None, List.rev [rules])]);
+  1
 
 let (grammar_state : (int * all_grammar_command) list ref) = ref []
 
 let extend_grammar gram =
   let nb = match gram with
-  | Notation (_,_,a) -> extend_constr_notation a
-  | TacticGrammar g -> add_tactic_entry g in
+  | Notation (_,a) -> extend_constr_notation a
+  | TacticGrammar (kn, g) -> add_tactic_entry kn g
+  | MLTacticGrammar (name, pr) -> add_ml_tactic_entry name pr
+  in
   grammar_state := (nb,gram) :: !grammar_state
 
-let recover_notation_grammar ntn prec =
-  let l = map_succeed (function
-    | _, Notation (prec',vars,(_,_,ntn',_ as x)) when prec = prec' & ntn = ntn' ->
-	 vars, x
-    | _ ->
-	 failwith "") !grammar_state in
-  assert (List.length l = 1);
-  List.hd l
+let extend_constr_grammar pr ntn =
+  extend_grammar (Notation (pr, ntn))
+
+let extend_tactic_grammar kn ntn =
+  extend_grammar (TacticGrammar (kn, ntn))
+
+let extend_ml_tactic_grammar name ntn =
+  extend_grammar (MLTacticGrammar (name, ntn))
+
+let recover_constr_grammar ntn prec =
+  let filter = function
+  | _, Notation (prec', ng) when
+      Notation.level_eq prec prec' &&
+      String.equal ntn ng.notgram_notation -> Some ng
+  | _ -> None
+  in
+  match List.map_filter filter !grammar_state with
+  | [x] -> x
+  | _ -> assert false
 
 (* Summary functions: the state of the lexer is included in that of the parser.
    Because the grammar affects the set of keywords when adding or removing
    grammar rules. *)
-type frozen_t = all_grammar_command list * Lexer.frozen_t
+type frozen_t = (int * all_grammar_command) list * Lexer.frozen_t
 
-let freeze () = (!grammar_state, Lexer.freeze ())
+let freeze _ : frozen_t = (!grammar_state, Lexer.freeze ())
 
 (* We compare the current state of the grammar and the state to unfreeze,
    by computing the longest common suffixes *)
 let factorize_grams l1 l2 =
-  if l1 == l2 then ([], [], l1) else list_share_tails l1 l2
+  if l1 == l2 then ([], [], l1) else List.share_tails l1 l2
 
 let number_of_entries gcl =
   List.fold_left (fun n (p,_) -> n + p) 0 gcl
@@ -345,24 +336,50 @@ let unfreeze (grams, lex) =
   remove_levels n;
   grammar_state := common;
   Lexer.unfreeze lex;
-  List.iter extend_grammar (List.rev (List.map snd redo))
-
-let init_grammar () =
-  remove_grammars (number_of_entries !grammar_state);
-  grammar_state := []
+  List.iter extend_grammar (List.rev_map snd redo)
 
-let init () =
-  init_grammar ()
-
-open Summary
+(** No need to provide an init function : the grammar state is
+    statically available, and already empty initially, while
+    the lexer state should not be resetted, since it contains
+    keywords declared in g_*.ml4 *)
 
 let _ =
-  declare_summary "GRAMMAR_LEXER"
-    { freeze_function = freeze;
-      unfreeze_function = unfreeze;
-      init_function = init }
+  Summary.declare_summary "GRAMMAR_LEXER"
+    { Summary.freeze_function = freeze;
+      Summary.unfreeze_function = unfreeze;
+      Summary.init_function = Summary.nop }
 
 let with_grammar_rule_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
+
+(**********************************************************************)
+(** Ltac quotations                                                   *)
+
+let ltac_quotations = ref String.Set.empty
+
+let create_ltac_quotation name cast wit e =
+  let () =
+    if String.Set.mem name !ltac_quotations then
+      failwith ("Ltac quotation " ^ name ^ " already registered")
+  in
+  let () = ltac_quotations := String.Set.add name !ltac_quotations in
+(*   let level = Some "1" in *)
+  let level = None in
+  let assoc = Some (of_coq_assoc Extend.RightA) in
+  let rule = [
+    gram_token_of_string name;
+    gram_token_of_string ":";
+    symbol_of_prod_entry_key (Agram (Gram.Entry.name e));
+  ] in
+  let action v _ _ loc =
+    let loc = !@loc in
+    let arg = TacGeneric (Genarg.in_gen (Genarg.rawwit wit) (cast (loc, v))) in
+    TacArg (loc, arg)
+  in
+  let gram = (level, assoc, [rule, Gram.action action]) in
+  maybe_uncurry (Gram.extend Tactic.tactic_expr) (None, [gram])
diff --git a/parsing/egramcoq.mli b/parsing/egramcoq.mli
new file mode 100644
index 00000000..2b0f7da8
--- /dev/null
+++ b/parsing/egramcoq.mli
@@ -0,0 +1,69 @@
+(************************************************************************)
+(*  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 Constrexpr
+open Notation_term
+open Pcoq
+open Extend
+open Genarg
+open Egramml
+
+(** Mapping of grammar productions to camlp4 actions *)
+
+(** This is the part specific to Coq-level Notation and Tactic Notation.
+    For the ML-level tactic and vernac extensions, see Egramml. *)
+
+(** For constr notations *)
+
+type grammar_constr_prod_item =
+  | GramConstrTerminal of Tok.t
+  | GramConstrNonTerminal of constr_prod_entry_key * Id.t option
+  | GramConstrListMark of int * bool
+    (* tells action rule to make a list of the n previous parsed items;
+       concat with last parsed list if true *)
+
+type notation_grammar = {
+  notgram_level : int;
+  notgram_assoc : gram_assoc option;
+  notgram_notation : notation;
+  notgram_prods : grammar_constr_prod_item list list;
+  notgram_typs : notation_var_internalization_type list;
+}
+
+type tactic_grammar = {
+  tacgram_level : int;
+  tacgram_prods : grammar_prod_item list;
+}
+
+(** {5 Adding notations} *)
+
+val extend_constr_grammar : Notation.level -> notation_grammar -> unit
+(** Add a term notation rule to the parsing system. *)
+
+val extend_tactic_grammar : KerName.t -> tactic_grammar -> unit
+(** Add a tactic notation rule to the parsing system. This produces a TacAlias
+    tactic with the provided kernel name. *)
+
+val extend_ml_tactic_grammar : Tacexpr.ml_tactic_name -> grammar_prod_item list list -> unit
+(** Add a ML tactic notation rule to the parsing system. This produces a
+    TacML tactic with the provided string as name. *)
+
+val recover_constr_grammar : notation -> Notation.level -> notation_grammar
+(** For a declared grammar, returns the rule + the ordered entry types
+    of variables in the rule (for use in the interpretation) *)
+
+val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b
+
+(** {5 Adding tactic quotations} *)
+
+val create_ltac_quotation : string -> ('grm Loc.located -> 'raw) ->
+  ('raw, 'glb, 'top) genarg_type -> 'grm Gram.entry -> unit
+(** [create_ltac_quotation name f wit e] adds a quotation rule to Ltac, that is,
+    Ltac grammar now accepts arguments of the form ["name" ":" <e>], and
+    generates a generic argument using [f] on the entry parsed by [e]. *)
diff --git a/parsing/egrammar.mli b/parsing/egrammar.mli
deleted file mode 100644
index 094b4203..00000000
--- a/parsing/egrammar.mli
+++ /dev/null
@@ -1,75 +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 Compat
-open Util
-open Names
-open Topconstr
-open Pcoq
-open Extend
-open Vernacexpr
-open Ppextend
-open Glob_term
-open Genarg
-open Mod_subst
-
-(** Mapping of grammar productions to camlp4 actions
-    Used for Coq-level Notation and Tactic Notation,
-    and for ML-level tactic and vernac extensions
- *)
-
-(** For constr notations *)
-
-type grammar_constr_prod_item =
-  | GramConstrTerminal of Tok.t
-  | GramConstrNonTerminal of constr_prod_entry_key * identifier option
-  | GramConstrListMark of int * bool
-    (* tells action rule to make a list of the n previous parsed items; 
-       concat with last parsed list if true *)
-
-type notation_grammar =
-    int * gram_assoc option * notation * grammar_constr_prod_item list list
-
-(** For tactic and vernac notations *)
-
-type grammar_prod_item =
-  | GramTerminal of string
-  | GramNonTerminal of loc * argument_type *
-      prod_entry_key * identifier option
-
-(** Adding notations *)
-
-type all_grammar_command =
-  | Notation of
-	 (precedence * tolerability list)
-	  * notation_var_internalization_type list
-	   (** not needed for defining grammar, hosted by egrammar for
-	       transmission to interp_aconstr (via recover_notation_grammar) *)
-	  * notation_grammar
-  | TacticGrammar of
-      (string * int * grammar_prod_item list *
-         (dir_path * Tacexpr.glob_tactic_expr))
-
-val extend_grammar : all_grammar_command -> unit
-
-val extend_tactic_grammar :
-  string -> grammar_prod_item list list -> unit
-
-val extend_vernac_command_grammar :
-  string -> vernac_expr Gram.entry option -> grammar_prod_item list list -> unit
-
-val get_extend_vernac_grammars :
- unit -> (string * grammar_prod_item list list) list
-
-(** For a declared grammar, returns the rule + the ordered entry types
-    of variables in the rule (for use in the interpretation) *)
-val recover_notation_grammar :
-  notation -> (precedence * tolerability list) ->
-  notation_var_internalization_type list * notation_grammar
-
-val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b
diff --git a/parsing/egramml.ml b/parsing/egramml.ml
new file mode 100644
index 00000000..8fe03b36
--- /dev/null
+++ b/parsing/egramml.ml
@@ -0,0 +1,63 @@
+(************************************************************************)
+(*  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 Util
+open Compat
+open Names
+open Pcoq
+open Genarg
+open Vernacexpr
+
+(** Making generic actions in type generic_argument *)
+
+let make_generic_action
+  (f:Loc.t -> ('b * raw_generic_argument) list -> 'a) pil =
+  let rec make env = function
+    | [] ->
+	Gram.action (fun loc -> f (to_coqloc loc) env)
+    | None :: tl -> (* parse a non-binding item *)
+        Gram.action (fun _ -> make env tl)
+    | Some (p, t) :: tl -> (* non-terminal *)
+        Gram.action (fun v -> make ((p, Unsafe.inj t v) :: env) tl) in
+  make [] (List.rev pil)
+
+(** Grammar extensions declared at ML level *)
+
+type grammar_prod_item =
+  | GramTerminal of string
+  | GramNonTerminal of
+      Loc.t * argument_type * prod_entry_key * Id.t option
+
+let make_prod_item = function
+  | GramTerminal s -> (gram_token_of_string s, None)
+  | GramNonTerminal (_,t,e,po) ->
+      (symbol_of_prod_entry_key e, Option.map (fun p -> (p,t)) po)
+
+let make_rule mkact pt =
+  let (symbs,ntl) = List.split (List.map make_prod_item pt) in
+  let act = make_generic_action mkact ntl in
+  (symbs, act)
+
+(** Vernac grammar extensions *)
+
+let vernac_exts = ref []
+
+let get_extend_vernac_rule (s, i) =
+  try
+    let find ((name, j), _) = String.equal name s && Int.equal i j in
+    let (_, rules) = List.find find !vernac_exts in
+    rules
+  with
+  | Failure _ -> raise Not_found
+
+let extend_vernac_command_grammar s nt gl =
+  let nt = Option.default Vernac_.command nt in
+  vernac_exts := (s,gl) :: !vernac_exts;
+  let mkact loc l = VernacExtend (s,List.map snd l) in
+  let rules = [make_rule mkact gl] in
+  maybe_uncurry (Gram.extend nt) (None,[(None, None, List.rev rules)])
diff --git a/parsing/egramml.mli b/parsing/egramml.mli
new file mode 100644
index 00000000..9ebb5b83
--- /dev/null
+++ b/parsing/egramml.mli
@@ -0,0 +1,29 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Mapping of grammar productions to camlp4 actions. *)
+
+(** This is the part specific to vernac extensions.
+    For the Coq-level Notation and Tactic Notation, see Egramcoq. *)
+
+type grammar_prod_item =
+  | GramTerminal of string
+  | GramNonTerminal of Loc.t * Genarg.argument_type *
+      Pcoq.prod_entry_key * Names.Id.t option
+
+val extend_vernac_command_grammar :
+  Vernacexpr.extend_name -> Vernacexpr.vernac_expr Pcoq.Gram.entry option ->
+    grammar_prod_item list -> unit
+
+val get_extend_vernac_rule : Vernacexpr.extend_name -> grammar_prod_item list
+
+(** Utility function reused in Egramcoq : *)
+
+val make_rule :
+  (Loc.t -> (Names.Id.t * Genarg.raw_generic_argument) list -> 'b) ->
+  grammar_prod_item list -> Pcoq.Gram.symbol list * Pcoq.Gram.action
diff --git a/parsing/extend.ml b/parsing/extend.ml
deleted file mode 100644
index 620e2ac2..00000000
--- a/parsing/extend.ml
+++ /dev/null
@@ -1,46 +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 Compat
-open Util
-
-(** Entry keys for constr notations *)
-
-type side = Left | Right
-
-type production_position =
-  | BorderProd of side * gram_assoc option
-  | InternalProd
-
-type production_level =
-  | NextLevel
-  | NumLevel of int
-
-type ('lev,'pos) constr_entry_key_gen =
-  | ETName | ETReference | ETBigint
-  | ETBinder of bool (* true=open, as in "fun .."; false as in "let f .. :=" *)
-  | ETConstr of ('lev * 'pos)
-  | ETPattern
-  | ETOther of string * string
-  | ETConstrList of ('lev * 'pos) * Tok.t list
-  | ETBinderList of bool * Tok.t list
-
-(**  Entries level (left-hand-side of grammar rules) *)
-
-type constr_entry_key =
-    (int,unit) constr_entry_key_gen
-
-(** Entries used in productions (in right-hand side of grammar rules) *)
-
-type constr_prod_entry_key =
-    (production_level,production_position) constr_entry_key_gen
-
-(** Entries used in productions, vernac side (e.g. "x bigint" or "x ident") *)
-
-type simple_constr_prod_entry_key =
-    (production_level,unit) constr_entry_key_gen
diff --git a/parsing/extend.mli b/parsing/extend.mli
deleted file mode 100644
index dd8ed0cd..00000000
--- a/parsing/extend.mli
+++ /dev/null
@@ -1,45 +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 Compat
-
-(** Entry keys for constr notations *)
-
-type side = Left | Right
-
-type production_position =
-  | BorderProd of side * gram_assoc option
-  | InternalProd
-
-type production_level =
-  | NextLevel
-  | NumLevel of int
-
-type ('lev,'pos) constr_entry_key_gen =
-  | ETName | ETReference | ETBigint
-  | ETBinder of bool
-  | ETConstr of ('lev * 'pos)
-  | ETPattern
-  | ETOther of string * string
-  | ETConstrList of ('lev * 'pos) * Tok.t list
-  | ETBinderList of bool * Tok.t list
-
-(** Entries level (left-hand-side of grammar rules) *)
-
-type constr_entry_key =
-    (int,unit) constr_entry_key_gen
-
-(** Entries used in productions (in right-hand-side of grammar rules) *)
-
-type constr_prod_entry_key =
-    (production_level,production_position) constr_entry_key_gen
-
-(** Entries used in productions, vernac side (e.g. "x bigint" or "x ident") *)
-
-type simple_constr_prod_entry_key =
-    (production_level,unit) constr_entry_key_gen
diff --git a/parsing/extrawit.ml b/parsing/extrawit.ml
deleted file mode 100644
index aaf64523..00000000
--- a/parsing/extrawit.ml
+++ /dev/null
@@ -1,60 +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 Genarg
-
-(* This file defines extra argument types *)
-
-(* Tactics as arguments *)
-
-let tactic_main_level = 5
-
-let (wit_tactic0,globwit_tactic0,rawwit_tactic0) = create_arg None "tactic0"
-let (wit_tactic1,globwit_tactic1,rawwit_tactic1) = create_arg None "tactic1"
-let (wit_tactic2,globwit_tactic2,rawwit_tactic2) = create_arg None "tactic2"
-let (wit_tactic3,globwit_tactic3,rawwit_tactic3) = create_arg None "tactic3"
-let (wit_tactic4,globwit_tactic4,rawwit_tactic4) = create_arg None "tactic4"
-let (wit_tactic5,globwit_tactic5,rawwit_tactic5) = create_arg None "tactic5"
-
-let wit_tactic = function
-  | 0 -> wit_tactic0
-  | 1 -> wit_tactic1
-  | 2 -> wit_tactic2
-  | 3 -> wit_tactic3
-  | 4 -> wit_tactic4
-  | 5 -> wit_tactic5
-  | n -> anomaly ("Unavailable tactic level: "^string_of_int n)
-
-let globwit_tactic = function
-  | 0 -> globwit_tactic0
-  | 1 -> globwit_tactic1
-  | 2 -> globwit_tactic2
-  | 3 -> globwit_tactic3
-  | 4 -> globwit_tactic4
-  | 5 -> globwit_tactic5
-  | n -> anomaly ("Unavailable tactic level: "^string_of_int n)
-
-let rawwit_tactic = function
-  | 0 -> rawwit_tactic0
-  | 1 -> rawwit_tactic1
-  | 2 -> rawwit_tactic2
-  | 3 -> rawwit_tactic3
-  | 4 -> rawwit_tactic4
-  | 5 -> rawwit_tactic5
-  | n -> anomaly ("Unavailable tactic level: "^string_of_int n)
-
-let tactic_genarg_level s =
-  if String.length s = 7 && String.sub s 0 6 = "tactic" then
-    let c = s.[6] in if '5' >= c && c >= '0' then Some (Char.code c - 48)
-    else None
-  else None
-
-let is_tactic_genarg = function
-| ExtraArgType s -> tactic_genarg_level s <> None
-| _ -> false
diff --git a/parsing/extrawit.mli b/parsing/extrawit.mli
deleted file mode 100644
index d8f36928..00000000
--- a/parsing/extrawit.mli
+++ /dev/null
@@ -1,49 +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 Genarg
-open Tacexpr
-
-(** This file defines extra argument types *)
-
-(** Tactics as arguments *)
-
-val tactic_main_level : int
-
-val rawwit_tactic : int -> (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic : int -> (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic : int -> (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic0 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic0 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic0 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic1 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic1 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic1 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic2 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic2 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic2 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic3 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic3 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic3 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic4 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic4 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic4 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val rawwit_tactic5 : (raw_tactic_expr,rlevel) abstract_argument_type
-val globwit_tactic5 : (glob_tactic_expr,glevel) abstract_argument_type
-val wit_tactic5 : (glob_tactic_expr,tlevel) abstract_argument_type
-
-val is_tactic_genarg : argument_type -> bool
-
-val tactic_genarg_level : string -> int option
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index 325c1cec..8246df28 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -1,23 +1,27 @@
 (************************************************************************)
 (*  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 Pcoq
-open Constr
-open Prim
-open Glob_term
-open Term
 open Names
 open Libnames
-open Topconstr
+open Constrexpr
+open Constrexpr_ops
 open Util
 open Tok
 open Compat
+open Misctypes
+open Decl_kinds
+
+open Pcoq
+open Pcoq.Prim
+open Pcoq.Constr
+
+(* TODO: avoid this redefinition without an extra dep to Notation_ops *)
+let ldots_var = Id.of_string ".."
 
 let constr_kw =
   [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "in"; "for";
@@ -29,32 +33,34 @@ let _ = List.iter Lexer.add_keyword constr_kw
 
 let mk_cast = function
     (c,(_,None)) -> c
-  | (c,(_,Some ty)) -> CCast(join_loc (constr_loc c) (constr_loc ty), c, CastConv (DEFAULTcast, ty))
+  | (c,(_,Some ty)) ->
+    let loc = Loc.merge (constr_loc c) (constr_loc ty)
+    in CCast(loc, c, CastConv ty)
+
+let binder_of_name expl (loc,na) =
+  LocalRawAssum ([loc, na], Default expl,
+    CHole (loc, Some (Evar_kinds.BinderType na), IntroAnonymous, None))
 
 let binders_of_names l =
-  List.map (fun (loc, na) ->
-    LocalRawAssum ([loc, na], Default Explicit,
-		   CHole (loc, Some (Evd.BinderType na)))) l
+  List.map (binder_of_name Explicit) l
 
 let binders_of_lidents l =
-  List.map (fun (loc, id) ->
-    LocalRawAssum ([loc, Name id], Default Glob_term.Explicit,
-		  CHole (loc, Some (Evd.BinderType (Name id))))) l
+  List.map (fun (loc, id) -> binder_of_name Explicit (loc, Name id)) l
 
 let mk_fixb (id,bl,ann,body,(loc,tyc)) =
   let ty = match tyc with
       Some ty -> ty
-    | None -> CHole (loc, None) in
+    | None -> CHole (loc, None, IntroAnonymous, None) in
   (id,ann,bl,ty,body)
 
 let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
   let _ = Option.map (fun (aloc,_) ->
-    Util.user_err_loc
+    Errors.user_err_loc
       (aloc,"Constr:mk_cofixb",
        Pp.str"Annotation forbidden in cofix expression.")) (fst ann) in
   let ty = match tyc with
       Some ty -> ty
-    | None -> CHole (loc, None) in
+    | None -> CHole (loc, None, IntroAnonymous, None) in
   (id,bl,ty,body)
 
 let mk_fix(loc,kw,id,dcls) =
@@ -82,7 +88,7 @@ let lpar_id_coloneq =
                   (match get_tok (stream_nth 2 strm) with
                     | KEYWORD ":=" ->
                         stream_njunk 3 strm;
-                        Names.id_of_string s
+                        Names.Id.of_string s
 	            | _ -> err ())
               | _ -> err ())
         | _ -> err ())
@@ -96,7 +102,7 @@ let impl_ident_head =
 	      | IDENT ("wf"|"struct"|"measure") -> err ()
 	      | IDENT s ->
 		  stream_njunk 2 strm;
-		  Names.id_of_string s
+		  Names.Id.of_string s
 	      | _ -> err ())
 	| _ -> err ())
 
@@ -108,7 +114,7 @@ let name_colon =
             (match get_tok (stream_nth 1 strm) with
               | KEYWORD ":" ->
                   stream_njunk 2 strm;
-                  Name (Names.id_of_string s)
+                  Name (Names.Id.of_string s)
               | _ -> err ())
 	| KEYWORD "_" ->
           (match get_tok (stream_nth 1 strm) with
@@ -129,10 +135,10 @@ GEXTEND Gram
     [ [ id = Prim.ident -> id
 
       (* This is used in quotations and Syntax *)
-      | id = METAIDENT -> id_of_string id ] ]
+      | id = METAIDENT -> Id.of_string id ] ]
   ;
   Prim.name:
-    [ [ "_" -> (loc, Anonymous) ] ]
+    [ [ "_" -> (!@loc, Anonymous) ] ]
   ;
   global:
     [ [ r = Prim.reference -> r ] ]
@@ -144,65 +150,77 @@ GEXTEND Gram
     [ [ c = lconstr -> c ] ]
   ;
   sort:
-    [ [ "Set"  -> GProp Pos
-      | "Prop" -> GProp Null
-      | "Type" -> GType None ] ]
+    [ [ "Set"  -> GSet
+      | "Prop" -> GProp
+      | "Type" -> GType []
+      | "Type"; "@{"; u = universe; "}" -> GType (List.map Id.to_string u)
+      ] ]
+  ;
+  universe:
+    [ [ "max("; ids = LIST1 ident SEP ","; ")" -> ids
+      | id = ident -> [id]
+      ] ]
   ;
   lconstr:
     [ [ c = operconstr LEVEL "200" -> c ] ]
   ;
   constr:
     [ [ c = operconstr LEVEL "8" -> c
-      | "@"; f=global -> CAppExpl(loc,(None,f),[]) ] ]
+      | "@"; f=global; i = instance -> CAppExpl(!@loc,(None,f,i),[]) ] ]
   ;
   operconstr:
     [ "200" RIGHTA
       [ c = binder_constr -> c ]
     | "100" RIGHTA
       [ c1 = operconstr; "<:"; c2 = binder_constr ->
-                 CCast(loc,c1, CastConv (VMcast,c2))
+                 CCast(!@loc,c1, CastVM c2)
       | c1 = operconstr; "<:"; c2 = SELF ->
-                 CCast(loc,c1, CastConv (VMcast,c2))
+                 CCast(!@loc,c1, CastVM c2)
+      | c1 = operconstr; "<<:"; c2 = binder_constr ->
+                 CCast(!@loc,c1, CastNative c2)
+      | c1 = operconstr; "<<:"; c2 = SELF ->
+                 CCast(!@loc,c1, CastNative c2)
       | c1 = operconstr; ":";c2 = binder_constr ->
-                 CCast(loc,c1, CastConv (DEFAULTcast,c2))
+                 CCast(!@loc,c1, CastConv c2)
       | c1 = operconstr; ":"; c2 = SELF ->
-                 CCast(loc,c1, CastConv (DEFAULTcast,c2))
+                 CCast(!@loc,c1, CastConv c2)
       | c1 = operconstr; ":>" ->
-                 CCast(loc,c1, CastCoerce) ]
+                 CCast(!@loc,c1, CastCoerce) ]
     | "99" RIGHTA [ ]
-    | "90" RIGHTA
-      [ c1 = operconstr; "->"; c2 = binder_constr -> CArrow(loc,c1,c2)
-      | c1 = operconstr; "->"; c2 = SELF -> CArrow(loc,c1,c2)]
+    | "90" RIGHTA [ ]
     | "10" LEFTA
-      [ f=operconstr; args=LIST1 appl_arg -> CApp(loc,(None,f),args)
-      | "@"; f=global; args=LIST0 NEXT -> CAppExpl(loc,(None,f),args)
+      [ f=operconstr; args=LIST1 appl_arg -> CApp(!@loc,(None,f),args)
+      | "@"; f=global; i = instance; args=LIST0 NEXT -> CAppExpl(!@loc,(None,f,i),args)
       | "@"; (locid,id) = pattern_identref; args=LIST1 identref ->
-          let args = List.map (fun x -> CRef (Ident x), None) args in
-          CApp(loc,(None,CPatVar(locid,(true,id))),args) ]
+          let args = List.map (fun x -> CRef (Ident x,None), None) args in
+          CApp(!@loc,(None,CPatVar(locid,id)),args) ]
     | "9"
         [ ".."; c = operconstr LEVEL "0"; ".." ->
-          CAppExpl (loc,(None,Ident (loc,Topconstr.ldots_var)),[c]) ]
+          CAppExpl (!@loc,(None,Ident (!@loc,ldots_var),None),[c]) ]
     | "8" [ ]
     | "1" LEFTA
       [ c=operconstr; ".("; f=global; args=LIST0 appl_arg; ")" ->
-	CApp(loc,(Some (List.length args+1),CRef f),args@[c,None])
+	CApp(!@loc,(Some (List.length args+1),CRef (f,None)),args@[c,None])
       | c=operconstr; ".("; "@"; f=global;
         args=LIST0 (operconstr LEVEL "9"); ")" ->
-        CAppExpl(loc,(Some (List.length args+1),f),args@[c])
-      | c=operconstr; "%"; key=IDENT -> CDelimiters (loc,key,c) ]
+        CAppExpl(!@loc,(Some (List.length args+1),f,None),args@[c])
+      | c=operconstr; "%"; key=IDENT -> CDelimiters (!@loc,key,c) ]
     | "0"
       [ c=atomic_constr -> c
       | c=match_constr -> c
       | "("; c = operconstr LEVEL "200"; ")" ->
           (match c with
               CPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
-                CNotation(loc,"( _ )",([c],[],[]))
+                CNotation(!@loc,"( _ )",([c],[],[]))
             | _ -> c)
       | "{|"; c = record_declaration; "|}" -> c
       | "`{"; c = operconstr LEVEL "200"; "}" ->
-	  CGeneralization (loc, Implicit, None, c)
+	  CGeneralization (!@loc, Implicit, None, c)
       | "`("; c = operconstr LEVEL "200"; ")" ->
-	  CGeneralization (loc, Explicit, None, c)
+	  CGeneralization (!@loc, Explicit, None, c)
+      | "$("; tac = Tactic.tactic; ")$" ->
+          let arg = Genarg.in_gen (Genarg.rawwit Constrarg.wit_tactic) tac in
+          CHole (!@loc, None, IntroAnonymous, Some arg)
       ] ]
   ;
   forall:
@@ -212,74 +230,96 @@ GEXTEND Gram
     [ [ "fun" -> () ] ]
   ;
   record_declaration:
-    [ [ fs = LIST0 record_field_declaration SEP ";" -> CRecord (loc, None, fs)
+    [ [ fs = LIST0 record_field_declaration SEP ";" -> CRecord (!@loc, None, fs)
 (*       | c = lconstr; "with"; fs = LIST1 record_field_declaration SEP ";" -> *)
-(* 	  CRecord (loc, Some c, fs) *)
+(* 	  CRecord (!@loc, Some c, fs) *)
     ] ]
   ;
   record_field_declaration:
     [ [ id = global; params = LIST0 identref; ":="; c = lconstr ->
-      (id, Topconstr.abstract_constr_expr c (binders_of_lidents params)) ] ]
+      (id, abstract_constr_expr c (binders_of_lidents params)) ] ]
   ;
   binder_constr:
     [ [ forall; bl = open_binders; ","; c = operconstr LEVEL "200" ->
-          mkCProdN loc bl c
+          mkCProdN (!@loc) bl c
       | lambda; bl = open_binders; "=>"; c = operconstr LEVEL "200" ->
-          mkCLambdaN loc bl c
+          mkCLambdaN (!@loc) bl c
       | "let"; id=name; bl = binders; ty = type_cstr; ":=";
         c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
-          let loc1 = join_loc (local_binders_loc bl) (constr_loc c1) in
-          CLetIn(loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
+          let loc1 =
+	    Loc.merge (local_binders_loc bl) (constr_loc c1)
+	  in
+          CLetIn(!@loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
       | "let"; fx = single_fix; "in"; c = operconstr LEVEL "200" ->
           let fixp = mk_single_fix fx in
           let (li,id) = match fixp with
               CFix(_,id,_) -> id
             | CCoFix(_,id,_) -> id
             | _ -> assert false in
-          CLetIn(loc,(li,Name id),fixp,c)
+          CLetIn(!@loc,(li,Name id),fixp,c)
       | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> l | "()" -> []];
 	  po = return_type;
 	  ":="; c1 = operconstr LEVEL "200"; "in";
           c2 = operconstr LEVEL "200" ->
-          CLetTuple (loc,lb,po,c1,c2)
+          CLetTuple (!@loc,lb,po,c1,c2)
       | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
           "in"; c2 = operconstr LEVEL "200" ->
-	    CCases (loc, LetPatternStyle, None, [(c1,(None,None))], [(loc, [(loc,[p])], c2)])
+	    CCases (!@loc, LetPatternStyle, None, [(c1,(None,None))], [(!@loc, [(!@loc,[p])], c2)])
       | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
 	  rt = case_type; "in"; c2 = operconstr LEVEL "200" ->
-	    CCases (loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, None))], [(loc, [(loc, [p])], c2)])
-      | "let"; "'"; p=pattern; "in"; t = operconstr LEVEL "200";
+	    CCases (!@loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, None))], [(!@loc, [(!@loc, [p])], c2)])
+      | "let"; "'"; p=pattern; "in"; t = pattern LEVEL "200";
 	  ":="; c1 = operconstr LEVEL "200"; rt = case_type;
           "in"; c2 = operconstr LEVEL "200" ->
-	    CCases (loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, Some t))], [(loc, [(loc, [p])], c2)])
+	    CCases (!@loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, Some t))], [(!@loc, [(!@loc, [p])], c2)])
       | "if"; c=operconstr LEVEL "200"; po = return_type;
 	"then"; b1=operconstr LEVEL "200";
         "else"; b2=operconstr LEVEL "200" ->
-          CIf (loc, c, po, b1, b2)
+          CIf (!@loc, c, po, b1, b2)
       | c=fix_constr -> c ] ]
   ;
   appl_arg:
     [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
-	  (c,Some (loc,ExplByName id))
+	  (c,Some (!@loc,ExplByName id))
       | c=operconstr LEVEL "9" -> (c,None) ] ]
   ;
   atomic_constr:
-    [ [ g=global -> CRef g
-      | s=sort -> CSort (loc,s)
-      | n=INT -> CPrim (loc, Numeral (Bigint.of_string n))
-      | s=string -> CPrim (loc, String s)
-      | "_" -> CHole (loc, None)
-      | id=pattern_ident -> CPatVar(loc,(false,id)) ] ]
+    [ [ g=global; i=instance -> CRef (g,i)
+      | s=sort -> CSort (!@loc,s)
+      | n=INT -> CPrim (!@loc, Numeral (Bigint.of_string n))
+      | s=string -> CPrim (!@loc, String s)
+      | "_" -> CHole (!@loc, None, IntroAnonymous, None)
+      | "?"; "["; id=ident; "]"  -> CHole (!@loc, None, IntroIdentifier id, None)
+      | "?"; "["; id=pattern_ident; "]"  -> CHole (!@loc, None, IntroFresh id, None)
+      | id=pattern_ident; inst = evar_instance -> CEvar(!@loc,id,inst) ] ]
+  ;
+  inst:
+    [ [ id = ident; ":="; c = lconstr -> (id,c) ] ]
+  ;
+  evar_instance:
+    [ [ "@{"; l = LIST1 inst SEP ";"; "}" -> l
+      | -> [] ] ]
+  ;
+  instance:
+    [ [ "@{"; l = LIST1 level; "}" -> Some l
+      | -> None ] ]
+  ;
+  level:
+    [ [ "Set" -> GSet
+      | "Prop" -> GProp
+      | "Type" -> GType None
+      | id = ident -> GType (Some (Id.to_string id))
+      ] ]
   ;
   fix_constr:
     [ [ fx1=single_fix -> mk_single_fix fx1
       | (_,kw,dcl1)=single_fix; "with"; dcls=LIST1 fix_decl SEP "with";
         "for"; id=identref ->
-          mk_fix(loc,kw,id,dcl1::dcls)
+          mk_fix(!@loc,kw,id,dcl1::dcls)
     ] ]
   ;
   single_fix:
-    [ [ kw=fix_kw; dcl=fix_decl -> (loc,kw,dcl) ] ]
+    [ [ kw=fix_kw; dcl=fix_decl -> (!@loc,kw,dcl) ] ]
   ;
   fix_kw:
     [ [ "fix" -> true
@@ -292,14 +332,14 @@ GEXTEND Gram
   ;
   match_constr:
     [ [ "match"; ci=LIST1 case_item SEP ","; ty=OPT case_type; "with";
-        br=branches; "end" -> CCases(loc,RegularStyle,ty,ci,br) ] ]
+        br=branches; "end" -> CCases(!@loc,RegularStyle,ty,ci,br) ] ]
   ;
   case_item:
     [ [ c=operconstr LEVEL "100"; p=pred_pattern -> (c,p) ] ]
   ;
   pred_pattern:
     [ [ ona = OPT ["as"; id=name -> id];
-        ty = OPT ["in"; t=lconstr -> t] -> (ona,ty) ] ]
+        ty = OPT ["in"; t=pattern -> t] -> (ona,ty) ] ]
   ;
   case_type:
     [ [ "return"; ty = operconstr LEVEL "100" -> ty ] ]
@@ -316,11 +356,11 @@ GEXTEND Gram
     [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
   ;
   mult_pattern:
-    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> (loc,pl) ] ]
+    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> (!@loc,pl) ] ]
   ;
   eqn:
     [ [ pll = LIST1 mult_pattern SEP "|";
-        "=>"; rhs = lconstr -> (loc,pll,rhs) ] ]
+        "=>"; rhs = lconstr -> (!@loc,pll,rhs) ] ]
   ;
   recordpattern:
     [ [ id = global; ":="; pat = pattern -> (id, pat) ] ]
@@ -328,42 +368,44 @@ GEXTEND Gram
   pattern:
     [ "200" RIGHTA [ ]
     | "100" RIGHTA
-      [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CPatOr (loc,p::pl) ]
+      [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CPatOr (!@loc,p::pl) ]
     | "99" RIGHTA [ ]
     | "10" LEFTA
       [ p = pattern; "as"; id = ident ->
-	  CPatAlias (loc, p, id) ]
+	  CPatAlias (!@loc, p, id) ]
     | "9" RIGHTA
       [ p = pattern; lp = LIST1 NEXT ->
         (match p with
-          | CPatAtom (_, Some r) -> CPatCstr (loc, r, lp)
-          | _ -> Util.user_err_loc
+	  | CPatAtom (_, Some r) -> CPatCstr (!@loc, r, [], lp)
+	  | CPatCstr (_, r, l1, l2) -> CPatCstr (!@loc, r, l1 , l2@lp)
+	  | CPatNotation (_, n, s, l) -> CPatNotation (!@loc, n , s, l@lp)
+          | _ -> Errors.user_err_loc
               (cases_pattern_expr_loc p, "compound_pattern",
-               Pp.str "Constructor expected."))
+               Pp.str "Such pattern cannot have arguments."))
       |"@"; r = Prim.reference; lp = LIST1 NEXT ->
-        CPatCstrExpl (loc, r, lp) ]
+        CPatCstr (!@loc, r, lp, []) ]
     | "1" LEFTA
-      [ c = pattern; "%"; key=IDENT -> CPatDelimiters (loc,key,c) ]
+      [ c = pattern; "%"; key=IDENT -> CPatDelimiters (!@loc,key,c) ]
     | "0"
-      [ r = Prim.reference -> CPatAtom (loc,Some r)
-      | "{|"; pat = LIST0 recordpattern SEP ";" ; "|}" -> CPatRecord (loc, pat)
-      | "_" -> CPatAtom (loc,None)
+      [ r = Prim.reference -> CPatAtom (!@loc,Some r)
+      | "{|"; pat = LIST0 recordpattern SEP ";" ; "|}" -> CPatRecord (!@loc, pat)
+      | "_" -> CPatAtom (!@loc,None)
       | "("; p = pattern LEVEL "200"; ")" ->
           (match p with
               CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
-                CPatNotation(loc,"( _ )",([p],[]))
+                CPatNotation(!@loc,"( _ )",([p],[]),[])
             | _ -> p)
-      | n = INT -> CPatPrim (loc, Numeral (Bigint.of_string n))
-      | s = string -> CPatPrim (loc, String s) ] ]
+      | n = INT -> CPatPrim (!@loc, Numeral (Bigint.of_string n))
+      | s = string -> CPatPrim (!@loc, String s) ] ]
   ;
   impl_ident_tail:
-    [ [ "}" -> fun id -> LocalRawAssum([id], Default Implicit, CHole(loc, None))
-    | idl=LIST1 name; ":"; c=lconstr; "}" ->
-        (fun id -> LocalRawAssum (id::idl,Default Implicit,c))
-    | idl=LIST1 name; "}" ->
-        (fun id -> LocalRawAssum (id::idl,Default Implicit,CHole (loc, None)))
+    [ [ "}" -> binder_of_name Implicit
+    | nal=LIST1 name; ":"; c=lconstr; "}" ->
+        (fun na -> LocalRawAssum (na::nal,Default Implicit,c))
+    | nal=LIST1 name; "}" ->
+        (fun na -> LocalRawAssum (na::nal,Default Implicit,CHole (Loc.join_loc (fst na) !@loc, Some (Evar_kinds.BinderType (snd na)), IntroAnonymous, None)))
     | ":"; c=lconstr; "}" ->
-	(fun id -> LocalRawAssum ([id],Default Implicit,c))
+	(fun na -> LocalRawAssum ([na],Default Implicit,c))
     ] ]
   ;
   fixannot:
@@ -373,9 +415,12 @@ GEXTEND Gram
 	rel=OPT constr; "}" -> (id, CMeasureRec (m,rel))
     ] ]
   ;
+  impl_name_head:
+    [ [ id = impl_ident_head -> (!@loc,Name id) ] ]
+  ;
   binders_fixannot:
-    [ [ id = impl_ident_head; assum = impl_ident_tail; bl = binders_fixannot ->
-          (assum (loc, Name id) :: fst bl), snd bl
+    [ [ na = impl_name_head; assum = impl_ident_tail; bl = binders_fixannot ->
+          (assum na :: fst bl), snd bl
       | f = fixannot -> [], f
       | b = binder; bl = binders_fixannot -> b @ fst bl, snd bl
       | -> [], (None, CStructRec)
@@ -391,8 +436,8 @@ GEXTEND Gram
       | id = name; idl = LIST0 name; bl = binders ->
           binders_of_names (id::idl) @ bl
       | id1 = name; ".."; id2 = name ->
-          [LocalRawAssum ([id1;(loc,Name ldots_var);id2],
-	                  Default Explicit,CHole (loc,None))]
+          [LocalRawAssum ([id1;(!@loc,Name ldots_var);id2],
+	                  Default Explicit,CHole (!@loc, None, IntroAnonymous, None))]
       | bl = closed_binder; bl' = binders ->
 	  bl@bl'
     ] ]
@@ -401,7 +446,7 @@ GEXTEND Gram
     [ [ l = LIST0 binder -> List.flatten l ] ]
   ;
   binder:
-    [ [ id = name -> [LocalRawAssum ([id],Default Explicit,CHole (loc, None))]
+    [ [ id = name -> [LocalRawAssum ([id],Default Explicit,CHole (!@loc, None, IntroAnonymous, None))]
       | bl = closed_binder -> bl ] ]
   ;
   closed_binder:
@@ -412,15 +457,15 @@ GEXTEND Gram
       | "("; id=name; ":="; c=lconstr; ")" ->
           [LocalRawDef (id,c)]
       | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" ->
-          [LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c, CastConv (DEFAULTcast,t)))]
+          [LocalRawDef (id,CCast (Loc.merge (constr_loc t) (!@loc),c, CastConv t))]
       | "{"; id=name; "}" ->
-          [LocalRawAssum ([id],Default Implicit,CHole (loc, None))]
+          [LocalRawAssum ([id],Default Implicit,CHole (!@loc, None, IntroAnonymous, None))]
       | "{"; id=name; idl=LIST1 name; ":"; c=lconstr; "}" ->
           [LocalRawAssum (id::idl,Default Implicit,c)]
       | "{"; id=name; ":"; c=lconstr; "}" ->
           [LocalRawAssum ([id],Default Implicit,c)]
       | "{"; id=name; idl=LIST1 name; "}" ->
-          List.map (fun id -> LocalRawAssum ([id],Default Implicit,CHole (loc, None))) (id::idl)
+          List.map (fun id -> LocalRawAssum ([id],Default Implicit,CHole (!@loc, None, IntroAnonymous, None))) (id::idl)
       | "`("; tc = LIST1 typeclass_constraint SEP "," ; ")" ->
 	  List.map (fun (n, b, t) -> LocalRawAssum ([n], Generalized (Implicit, Explicit, b), t)) tc
       | "`{"; tc = LIST1 typeclass_constraint SEP "," ; "}" ->
@@ -428,17 +473,17 @@ GEXTEND Gram
     ] ]
   ;
   typeclass_constraint:
-    [ [ "!" ; c = operconstr LEVEL "200" -> (loc, Anonymous), true, c
+    [ [ "!" ; c = operconstr LEVEL "200" -> (!@loc, Anonymous), true, c
       | "{"; id = name; "}"; ":" ; expl = [ "!" -> true | -> false ] ; c = operconstr LEVEL "200" ->
 	  id, expl, c
       | iid=name_colon ; expl = [ "!" -> true | -> false ] ; c = operconstr LEVEL "200" ->
-	  (loc, iid), expl, c
+	  (!@loc, iid), expl, c
       | c = operconstr LEVEL "200" ->
-	  (loc, Anonymous), false, c
+	  (!@loc, Anonymous), false, c
     ] ]
   ;
 
   type_cstr:
-    [ [ c=OPT [":"; c=lconstr -> c] -> (loc,c) ] ]
+    [ [ c=OPT [":"; c=lconstr -> c] -> (!@loc,c) ] ]
   ;
   END;;
diff --git a/parsing/g_ltac.ml4 b/parsing/g_ltac.ml4
index 34615ad1..b4d96e5c 100644
--- a/parsing/g_ltac.ml4
+++ b/parsing/g_ltac.ml4
@@ -1,21 +1,23 @@
 (************************************************************************)
 (*  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 Topconstr
-open Glob_term
+open Compat
+open Constrexpr
 open Tacexpr
-open Vernacexpr
+open Misctypes
+open Genarg
+open Genredexpr
+open Tok (* necessary for camlp4 *)
+
 open Pcoq
-open Prim
-open Tactic
-open Tok
+open Pcoq.Prim
+open Pcoq.Tactic
 
 let fail_default_value = ArgArg 0
 
@@ -23,10 +25,14 @@ let arg_of_expr = function
     TacArg (loc,a) -> a
   | e -> Tacexp (e:raw_tactic_expr)
 
+let genarg_of_unit () = in_gen (rawwit Stdarg.wit_unit) ()
+let genarg_of_int n = in_gen (rawwit Stdarg.wit_int) n
+let genarg_of_ipattern pat = in_gen (rawwit Constrarg.wit_intro_pattern) pat
+
 (* Tactics grammar rules *)
 
 GEXTEND Gram
-  GLOBAL: tactic Vernac_.command tactic_expr binder_tactic tactic_arg
+  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg
           constr_may_eval;
 
   tactic_then_last:
@@ -44,29 +50,44 @@ GEXTEND Gram
       | -> ([TacId []], None)
     ] ]
   ;
+  tactic_then_locality: (* [true] for the local variant [TacThens] and [false]
+                           for [TacExtend] *)
+  [ [ "[" ; l = OPT">" -> if Option.is_empty l then true else false ] ]
+  ;
   tactic_expr:
     [ "5" RIGHTA
       [ te = binder_tactic -> te ]
     | "4" LEFTA
-      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, [||], ta1, [||])
-      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0,  [||], ta1, [||])
-      | ta0 = tactic_expr; ";"; "["; (first,tail) = tactic_then_gen; "]" ->
-	  match tail with
-	  | Some (t,last) -> TacThen (ta0, Array.of_list first, t, last)
-	  | None -> TacThens (ta0,first) ]
+      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, ta1)
+      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0,ta1)
+      | ta0 = tactic_expr; ";"; l = tactic_then_locality; (first,tail) = tactic_then_gen; "]" ->
+	  match l , tail with
+          | false , Some (t,last) -> TacThen (ta0,TacExtendTac (Array.of_list first, t, last))
+	  | true  , Some (t,last) -> TacThens3parts (ta0, Array.of_list first, t, last)
+          | false , None -> TacThen (ta0,TacDispatch first)
+	  | true  , None -> TacThens (ta0,first) ]
     | "3" RIGHTA
       [ IDENT "try"; ta = tactic_expr -> TacTry ta
       | IDENT "do"; n = int_or_var; ta = tactic_expr -> TacDo (n,ta)
       | IDENT "timeout"; n = int_or_var; ta = tactic_expr -> TacTimeout (n,ta)
+      | IDENT "time"; s = OPT string; ta = tactic_expr -> TacTime (s,ta)
       | IDENT "repeat"; ta = tactic_expr -> TacRepeat ta
       | IDENT "progress"; ta = tactic_expr -> TacProgress ta
+      | IDENT "once"; ta = tactic_expr -> TacOnce ta
+      | IDENT "exactly_once"; ta = tactic_expr -> TacExactlyOnce ta
+      | IDENT "infoH"; ta = tactic_expr -> TacShowHyps ta
 (*To do: put Abstract in Refiner*)
       | IDENT "abstract"; tc = NEXT -> TacAbstract (tc,None)
       | IDENT "abstract"; tc = NEXT; "using";  s = ident ->
           TacAbstract (tc,Some s) ]
 (*End of To do*)
     | "2" RIGHTA
-      [ ta0 = tactic_expr; "||"; ta1 = binder_tactic -> TacOrelse (ta0,ta1)
+      [ ta0 = tactic_expr; "+"; ta1 = binder_tactic -> TacOr (ta0,ta1)
+      | ta0 = tactic_expr; "+"; ta1 = tactic_expr -> TacOr (ta0,ta1) 
+      | IDENT "tryif" ; ta = tactic_expr ;
+              "then" ; tat = tactic_expr ;
+              "else" ; tae = tactic_expr -> TacIfThenCatch(ta,tat,tae)
+      | ta0 = tactic_expr; "||"; ta1 = binder_tactic -> TacOrelse (ta0,ta1)
       | ta0 = tactic_expr; "||"; ta1 = tactic_expr -> TacOrelse (ta0,ta1) ]
     | "1" RIGHTA
       [ b = match_key; IDENT "goal"; "with"; mrl = match_context_list; "end" ->
@@ -81,23 +102,25 @@ GEXTEND Gram
       | IDENT "solve" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
 	  TacSolve l
       | IDENT "idtac"; l = LIST0 message_token -> TacId l
-      | IDENT "fail"; n = [ n = int_or_var -> n | -> fail_default_value ];
-	  l = LIST0 message_token -> TacFail (n,l)
-      | IDENT "external"; com = STRING; req = STRING; la = LIST1 tactic_arg ->
-	  TacArg (loc,TacExternal (loc,com,req,la))
-      | st = simple_tactic -> TacAtom (loc,st)
-      | a = may_eval_arg -> TacArg(loc,a)
-      | IDENT "constr"; ":"; id = METAIDENT ->
-          TacArg(loc,MetaIdArg (loc,false,id))
+      | g=failkw; n = [ n = int_or_var -> n | -> fail_default_value ];
+	  l = LIST0 message_token -> TacFail (g,n,l)
+      | st = simple_tactic -> st
       | IDENT "constr"; ":"; c = Constr.constr ->
-          TacArg(loc,ConstrMayEval(ConstrTerm c))
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern ->
-	  TacArg(loc,IntroPattern ipat)
+          TacArg(!@loc,ConstrMayEval(ConstrTerm c))
+      | a = tactic_top_or_arg -> TacArg(!@loc,a)
       | r = reference; la = LIST0 tactic_arg ->
-          TacArg(loc,TacCall (loc,r,la)) ]
+          TacArg(!@loc,TacCall (!@loc,r,la)) ]
     | "0"
       [ "("; a = tactic_expr; ")" -> a
-      | a = tactic_atom -> TacArg (loc,a) ] ]
+      | "["; ">"; (tf,tail) = tactic_then_gen; "]" ->
+          begin match tail with
+          | Some (t,tl) -> TacExtendTac(Array.of_list tf,t,tl)
+          | None -> TacDispatch tf
+          end
+      | a = tactic_atom -> TacArg (!@loc,a) ] ]
+  ;
+  failkw:
+  [ [ IDENT "fail" -> TacLocal | IDENT "gfail" -> TacGlobal ] ]
   ;
   (* binder_tactic: level 5 of tactic_expr *)
   binder_tactic:
@@ -112,21 +135,26 @@ GEXTEND Gram
   (* Tactic arguments *)
   tactic_arg:
     [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> arg_of_expr a
-      | IDENT "ltac"; ":"; n = natural -> Integer n
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
-      | a = may_eval_arg -> a
+      | IDENT "ltac"; ":"; n = natural -> TacGeneric (genarg_of_int n)
+      | a = tactic_top_or_arg -> a
       | r = reference -> Reference r
       | c = Constr.constr -> ConstrMayEval (ConstrTerm c)
       (* Unambigous entries: tolerated w/o "ltac:" modifier *)
-      | id = METAIDENT -> MetaIdArg (loc,true,id)
-      | "()" -> TacVoid ] ]
+      | id = METAIDENT -> MetaIdArg (!@loc,true,id)
+      | "()" -> TacGeneric (genarg_of_unit ()) ] ]
   ;
-  may_eval_arg:
-    [ [ c = constr_eval -> ConstrMayEval c
-      | IDENT "fresh"; l = LIST0 fresh_id -> TacFreshId l ] ]
+  (* Can be used as argument and at toplevel in tactic expressions. *)
+  tactic_top_or_arg:
+    [ [ IDENT "uconstr"; ":" ; c = uconstr -> UConstr c
+      | IDENT "ipattern"; ":"; ipat = simple_intropattern ->
+        TacGeneric (genarg_of_ipattern ipat)
+      | c = constr_eval -> ConstrMayEval c
+      | IDENT "fresh"; l = LIST0 fresh_id -> TacFreshId l
+      | IDENT "type_term"; c=uconstr -> TacPretype c
+      | IDENT "numgoals" -> TacNumgoals ] ]
   ;
   fresh_id:
-    [ [ s = STRING -> ArgArg s | id = ident -> ArgVar (loc,id) ] ]
+    [ [ s = STRING -> ArgArg s | id = ident -> ArgVar (!@loc,id) ] ]
   ;
   constr_eval:
     [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
@@ -141,13 +169,15 @@ GEXTEND Gram
       | c = Constr.constr -> ConstrTerm c ] ]
   ;
   tactic_atom:
-    [ [ id = METAIDENT -> MetaIdArg (loc,true,id)
-      | n = integer -> Integer n
-      | r = reference -> TacCall (loc,r,[])
-      | "()" -> TacVoid ] ]
+    [ [ id = METAIDENT -> MetaIdArg (!@loc,true,id)
+      | n = integer -> TacGeneric (genarg_of_int n)
+      | r = reference -> TacCall (!@loc,r,[])
+      | "()" -> TacGeneric (genarg_of_unit ()) ] ]
   ;
   match_key:
-    [ [ "match" -> false | "lazymatch" -> true ] ]
+    [ [ "match" -> Once
+      | "lazymatch" -> Select
+      | "multimatch" -> General ] ]
   ;
   input_fun:
     [ [ "_" -> None
@@ -162,9 +192,11 @@ GEXTEND Gram
   match_pattern:
     [ [ IDENT "context";  oid = OPT Constr.ident;
           "["; pc = Constr.lconstr_pattern; "]" ->
-        Subterm (false,oid, pc)
+        let mode = not (!Flags.tactic_context_compat) in
+        Subterm (mode, oid, pc)
       | IDENT "appcontext";  oid = OPT Constr.ident;
           "["; pc = Constr.lconstr_pattern; "]" ->
+        msg_warning (strbrk "appcontext is deprecated");
         Subterm (true,oid, pc)
       | pc = Constr.lconstr_pattern -> Term pc ] ]
   ;
@@ -175,10 +207,10 @@ GEXTEND Gram
 	  let t, ty =
 	    match mpv with
 	    | Term t -> (match t with
-	      | CCast (loc, t, CastConv (_, ty)) -> Term t, Some (Term ty)
+	      | CCast (loc, t, (CastConv ty | CastVM ty | CastNative ty)) -> Term t, Some (Term ty)
 	      | _ -> mpv, None)
 	    | _ -> mpv, None
-	  in Def (na, t, Option.default (Term (CHole (dummy_loc, None))) ty)
+	  in Def (na, t, Option.default (Term (CHole (Loc.ghost, None, IntroAnonymous, None))) ty)
     ] ]
   ;
   match_context_rule:
@@ -201,7 +233,7 @@ GEXTEND Gram
       | "|"; mrl = LIST1 match_rule SEP "|" -> mrl ] ]
   ;
   message_token:
-    [ [ id = identref -> MsgIdent (AI id)
+    [ [ id = identref -> MsgIdent id
       | s = STRING -> MsgString s
       | n = integer -> MsgInt n ] ]
   ;
@@ -221,9 +253,4 @@ GEXTEND Gram
   tactic:
     [ [ tac = tactic_expr -> tac ] ]
   ;
-  Vernac_.command:
-    [ [ IDENT "Ltac";
-        l = LIST1 tacdef_body SEP "with" ->
-          VernacDeclareTacticDefinition (use_module_locality (), true, l) ] ]
-  ;
   END
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index e0aae9a6..84da9c42 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -1,25 +1,24 @@
 (************************************************************************)
 (*  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 Pcoq
+open Compat
 open Names
 open Libnames
-open Topconstr
-open Tok
-open Compat
+open Tok (* necessary for camlp4 *)
+
+open Pcoq
+open Pcoq.Prim
 
 let prim_kw = ["{"; "}"; "["; "]"; "("; ")"; "'"]
 let _ = List.iter Lexer.add_keyword prim_kw
 
-open Prim
-open Nametab
 
-let local_make_qualid l id = make_qualid (make_dirpath l) id
+let local_make_qualid l id = make_qualid (DirPath.make l) id
 
 let my_int_of_string loc s =
   try
@@ -29,7 +28,7 @@ let my_int_of_string loc s =
     if n > 1024 * 2048 then raise Exit;
     n
   with Failure _ | Exit ->
-    Util.user_err_loc (loc,"",Pp.str "Cannot support a so large number.")
+    Errors.user_err_loc (loc,"",Pp.str "Cannot support a so large number.")
 
 GEXTEND Gram
   GLOBAL:
@@ -40,22 +39,22 @@ GEXTEND Gram
     [ [ s = IDENT -> s ] ]
   ;
   ident:
-    [ [ s = IDENT -> id_of_string s ] ]
+    [ [ s = IDENT -> Id.of_string s ] ]
   ;
   pattern_ident:
     [ [ LEFTQMARK; id = ident -> id ] ]
   ;
   pattern_identref:
-    [ [ id = pattern_ident -> (loc, id) ] ]
+    [ [ id = pattern_ident -> (!@loc, id) ] ]
   ;
   var: (* as identref, but interpret as a term identifier in ltac *)
-    [ [ id = ident -> (loc,id) ] ]
+    [ [ id = ident -> (!@loc, id) ] ]
   ;
   identref:
-    [ [ id = ident -> (loc,id) ] ]
+    [ [ id = ident -> (!@loc, id) ] ]
   ;
   field:
-    [ [ s = FIELD -> id_of_string s ] ]
+    [ [ s = FIELD -> Id.of_string s ] ]
   ;
   fields:
     [ [ id = field; (l,id') = fields -> (l@[id],id')
@@ -63,8 +62,8 @@ GEXTEND Gram
       ] ]
   ;
   fullyqualid:
-    [ [ id = ident; (l,id')=fields -> loc,id::List.rev (id'::l)
-      | id = ident -> loc,[id]
+    [ [ id = ident; (l,id')=fields -> !@loc,id::List.rev (id'::l)
+      | id = ident -> !@loc,[id]
       ] ]
   ;
   basequalid:
@@ -73,46 +72,46 @@ GEXTEND Gram
       ] ]
   ;
   name:
-    [ [ IDENT "_" -> (loc, Anonymous)
-      | id = ident -> (loc, Name id) ] ]
+    [ [ IDENT "_" -> (!@loc, Anonymous)
+      | id = ident -> (!@loc, Name id) ] ]
   ;
   reference:
     [ [ id = ident; (l,id') = fields ->
-        Qualid (loc, local_make_qualid (l@[id]) id')
-      | id = ident -> Ident (loc,id)
+        Qualid (!@loc, local_make_qualid (l@[id]) id')
+      | id = ident -> Ident (!@loc,id)
       ] ]
   ;
   by_notation:
-    [ [ s = ne_string; sc = OPT ["%"; key = IDENT -> key ] -> (loc,s,sc) ] ]
+    [ [ s = ne_string; sc = OPT ["%"; key = IDENT -> key ] -> (!@loc, s, sc) ] ]
   ;
   smart_global:
-    [ [ c = reference -> Genarg.AN c
-      | ntn = by_notation -> Genarg.ByNotation ntn ] ]
+    [ [ c = reference -> Misctypes.AN c
+      | ntn = by_notation -> Misctypes.ByNotation ntn ] ]
   ;
   qualid:
-    [ [ qid = basequalid -> loc, qid ] ]
+    [ [ qid = basequalid -> !@loc, qid ] ]
   ;
   ne_string:
     [ [ s = STRING ->
-        if s="" then Util.user_err_loc(loc,"",Pp.str"Empty string."); s
+        if s="" then Errors.user_err_loc(!@loc, "", Pp.str"Empty string."); s
     ] ]
   ;
   ne_lstring:
-    [ [ s = ne_string -> (loc,s) ] ]
+    [ [ s = ne_string -> (!@loc, s) ] ]
   ;
   dirpath:
     [ [ id = ident; l = LIST0 field ->
-        make_dirpath (l@[id]) ] ]
+        DirPath.make (List.rev (id::l)) ] ]
   ;
   string:
     [ [ s = STRING -> s ] ]
   ;
   integer:
-    [ [ i = INT      -> my_int_of_string loc i
-      | "-"; i = INT -> - my_int_of_string loc i ] ]
+    [ [ i = INT      -> my_int_of_string (!@loc) i
+      | "-"; i = INT -> - my_int_of_string (!@loc) i ] ]
   ;
   natural:
-    [ [ i = INT -> my_int_of_string loc i ] ]
+    [ [ i = INT -> my_int_of_string (!@loc) i ] ]
   ;
   bigint: (* Negative numbers are dealt with specially *)
     [ [ i = INT -> (Bigint.of_string i) ] ]
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 557972ce..27f14c79 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -1,24 +1,31 @@
 (************************************************************************)
 (*  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 Pcoq
-open Pp
-open Tactic
-open Util
-open Vernac_
-open Topconstr
+open Compat
+open Constrexpr
 open Vernacexpr
-open Prim
-open Constr
+open Misctypes
 open Tok
 
+open Pcoq
+open Pcoq.Tactic
+open Pcoq.Prim
+open Pcoq.Constr
+open Pcoq.Vernac_
+
 let thm_token = G_vernac.thm_token
 
+let hint_proof_using e = function
+  | Some _ as x -> x
+  | None -> match Proof_using.get_default_proof_using () with
+     | None -> None
+     | Some s -> Some (Gram.entry_parse e (Gram.parsable (Stream.of_string s)))
+
 (* Proof commands *)
 GEXTEND Gram
   GLOBAL: command;
@@ -29,12 +36,13 @@ GEXTEND Gram
   ;
   command:
     [ [ IDENT "Goal"; c = lconstr -> VernacGoal c
-      | IDENT "Proof" -> VernacProof (None,None)
+      | IDENT "Proof" ->
+          VernacProof (None,hint_proof_using G_vernac.section_subset_descr None)
       | IDENT "Proof" ; IDENT "Mode" ; mn = string -> VernacProofMode mn
       | IDENT "Proof"; "with"; ta = tactic; 
-        l = OPT [ "using"; l = LIST0 identref  -> l ] ->
-          VernacProof (Some ta, l)
-      | IDENT "Proof"; "using"; l = LIST0 identref; 
+        l = OPT [ "using"; l = G_vernac.section_subset_descr -> l ] ->
+          VernacProof (Some ta,hint_proof_using G_vernac.section_subset_descr l)
+      | IDENT "Proof"; "using"; l = G_vernac.section_subset_descr;
         ta = OPT [ "with"; ta = tactic -> ta ] ->
           VernacProof (ta,Some l)
       | IDENT "Proof"; c = lconstr -> VernacExactProof c
@@ -70,6 +78,7 @@ GEXTEND Gram
       | IDENT "Show"; IDENT "Node" -> VernacShow ShowNode
       | IDENT "Show"; IDENT "Script" -> VernacShow ShowScript
       | IDENT "Show"; IDENT "Existentials" -> VernacShow ShowExistentials
+      | IDENT "Show"; IDENT "Universes" -> VernacShow ShowUniverses
       | IDENT "Show"; IDENT "Tree" -> VernacShow ShowTree
       | IDENT "Show"; IDENT "Conjectures" -> VernacShow ShowProofNames
       | IDENT "Show"; IDENT "Proof" -> VernacShow ShowProof
@@ -81,29 +90,35 @@ GEXTEND Gram
       (* Hints for Auto and EAuto *)
       | IDENT "Create"; IDENT "HintDb" ;
 	  id = IDENT ; b = [ "discriminated" -> true | -> false ] ->
-	    VernacCreateHintDb (use_module_locality (), id, b)
+	    VernacCreateHintDb (id, b)
       | IDENT "Remove"; IDENT "Hints"; ids = LIST1 global; dbnames = opt_hintbases ->
-	  VernacRemoveHints (use_module_locality (), dbnames, ids)
+	  VernacRemoveHints (dbnames, ids)
       | IDENT "Hint"; local = obsolete_locality; h = hint;
 	  dbnames = opt_hintbases ->
-	  VernacHints (enforce_module_locality local,dbnames, h)
+	  VernacHints (local,dbnames, h)
       (* Declare "Resolve" explicitly so as to be able to later extend with
          "Resolve ->" and "Resolve <-" *)
-      | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 constr; n = OPT natural;
+      | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 reference_or_constr; 
+	  pri = OPT [ "|"; i = natural -> i ];
 	  dbnames = opt_hintbases ->
-	  VernacHints (use_module_locality (),dbnames,
-	    HintsResolve (List.map (fun x -> (n, true, x)) lc))
+	  VernacHints (false,dbnames,
+	    HintsResolve (List.map (fun x -> (pri, true, x)) lc))
       ] ];
-
   obsolete_locality:
     [ [ IDENT "Local" -> true | -> false ] ]
   ;
+  reference_or_constr:
+   [ [ r = global -> HintsReference r
+     | c = constr -> HintsConstr c ] ]
+  ;
   hint:
-    [ [ IDENT "Resolve"; lc = LIST1 constr; n = OPT natural ->
-          HintsResolve (List.map (fun x -> (n, true, x)) lc)
-      | IDENT "Immediate"; lc = LIST1 constr -> HintsImmediate lc
+    [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; 
+	pri = OPT [ "|"; i = natural -> i ] ->
+          HintsResolve (List.map (fun x -> (pri, true, x)) lc)
+      | IDENT "Immediate"; lc = LIST1 reference_or_constr -> HintsImmediate lc
       | IDENT "Transparent"; lc = LIST1 global -> HintsTransparency (lc, true)
       | IDENT "Opaque"; lc = LIST1 global -> HintsTransparency (lc, false)
+      | IDENT "Mode"; l = global; m = mode -> HintsMode (l, m)
       | IDENT "Unfold"; lqid = LIST1 global -> HintsUnfold lqid
       | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc
       | IDENT "Extern"; n = natural; c = OPT constr_pattern ; "=>";
@@ -112,6 +127,9 @@ GEXTEND Gram
     ;
   constr_body:
     [ [ ":="; c = lconstr -> c
-      | ":"; t = lconstr; ":="; c = lconstr -> CCast(loc,c, Glob_term.CastConv (Term.DEFAULTcast,t)) ] ]
+      | ":"; t = lconstr; ":="; c = lconstr -> CCast(!@loc,c,CastConv t) ] ]
+  ;
+  mode:
+    [ [ l = LIST1 ["+" -> true | "-" -> false] -> l ] ]
   ;
 END
diff --git a/parsing/g_tactic.ml4 b/parsing/g_tactic.ml4
index 820a1f16..b42b2c6d 100644
--- a/parsing/g_tactic.ml4
+++ b/parsing/g_tactic.ml4
@@ -1,24 +1,28 @@
 (************************************************************************)
 (*  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 Pcoq
+open Errors
 open Util
 open Tacexpr
-open Glob_term
-open Genarg
-open Topconstr
+open Genredexpr
+open Constrexpr
 open Libnames
-open Termops
 open Tok
 open Compat
+open Misctypes
+open Locus
+open Decl_kinds
+
+open Pcoq
 
-let all_with delta = make_red_flag [FBeta;FIota;FZeta;delta]
+
+let all_with delta = Redops.make_red_flag [FBeta;FIota;FZeta;delta]
 
 let tactic_kw = [ "->"; "<-" ; "by" ]
 let _ = List.iter Lexer.add_keyword tactic_kw
@@ -73,18 +77,18 @@ let check_for_coloneq =
   Gram.Entry.of_parser "lpar_id_colon"
     (fun strm ->
       let rec skip_to_rpar p n =
-	match get_tok (list_last (Stream.npeek n strm)) with
+	match get_tok (List.last (Stream.npeek n strm)) with
         | KEYWORD "(" -> skip_to_rpar (p+1) (n+1)
-        | KEYWORD ")" -> if p=0 then n+1 else skip_to_rpar (p-1) (n+1)
+        | KEYWORD ")" -> if Int.equal p 0 then n+1 else skip_to_rpar (p-1) (n+1)
 	| KEYWORD "." -> err ()
 	| _ -> skip_to_rpar p (n+1) in
       let rec skip_names n =
-	match get_tok (list_last (Stream.npeek n strm)) with
+	match get_tok (List.last (Stream.npeek n strm)) with
         | IDENT _ | KEYWORD "_" -> skip_names (n+1)
 	| KEYWORD ":" -> skip_to_rpar 0 (n+1) (* skip a constr *)
 	| _ -> err () in
       let rec skip_binders n =
-	match get_tok (list_last (Stream.npeek n strm)) with
+	match get_tok (List.last (Stream.npeek n strm)) with
         | KEYWORD "(" -> skip_binders (skip_names (n+1))
         | IDENT _ | KEYWORD "_" -> skip_binders (n+1)
 	| KEYWORD ":=" -> ()
@@ -110,39 +114,41 @@ let mk_fix_tac (loc,id,bl,ann,ty) =
         [([_],_,_)], None -> 1
       | _, Some x ->
           let ids = List.map snd (List.flatten (List.map pi1 bl)) in
-          (try list_index (snd x) ids
+          (try List.index Names.Name.equal (snd x) ids
           with Not_found -> error "No such fix variable.")
       | _ -> error "Cannot guess decreasing argument of fix." in
   (id,n,CProdN(loc,bl,ty))
 
 let mk_cofix_tac (loc,id,bl,ann,ty) =
   let _ = Option.map (fun (aloc,_) ->
-    Util.user_err_loc
+    user_err_loc
       (aloc,"Constr:mk_cofix_tac",
        Pp.str"Annotation forbidden in cofix expression.")) ann in
   (id,CProdN(loc,bl,ty))
 
 (* Functions overloaded by quotifier *)
-let induction_arg_of_constr (c,lbind as clbind) =
-  if lbind = NoBindings then
-    try ElimOnIdent (constr_loc c,snd(coerce_to_id c))
-    with e when Errors.noncritical e -> ElimOnConstr clbind
-  else ElimOnConstr clbind
+let induction_arg_of_constr (c,lbind as clbind) = match lbind with
+  | NoBindings ->
+    begin
+      try ElimOnIdent (Constrexpr_ops.constr_loc c,snd(Constrexpr_ops.coerce_to_id c))
+      with e when Errors.noncritical e -> ElimOnConstr clbind
+    end
+  | _ -> ElimOnConstr clbind
 
 let mkTacCase with_evar = function
-  | [ElimOnConstr cl,(None,None)],None,None ->
-      TacCase (with_evar,cl)
+  | [(clear,ElimOnConstr cl),(None,None),None],None ->
+      TacCase (with_evar,(clear,cl))
   (* Reinterpret numbers as a notation for terms *)
-  | [ElimOnAnonHyp n,(None,None)],None,None ->
+  | [(clear,ElimOnAnonHyp n),(None,None),None],None ->
       TacCase (with_evar,
-        (CPrim (dummy_loc, Numeral (Bigint.of_int n)),
-	 NoBindings))
+        (clear,(CPrim (Loc.ghost, Numeral (Bigint.of_int n)),
+	 NoBindings)))
   (* Reinterpret ident as notations for variables in the context *)
   (* because we don't know if they are quantified or not *)
-  | [ElimOnIdent id,(None,None)],None,None ->
-      TacCase (with_evar,(CRef (Ident id),NoBindings))
+  | [(clear,ElimOnIdent id),(None,None),None],None ->
+      TacCase (with_evar,(clear,(CRef (Ident id,None),NoBindings)))
   | ic ->
-      if List.exists (function (ElimOnAnonHyp _,_) -> true | _ -> false) (pi1 ic)
+      if List.exists (function ((_, ElimOnAnonHyp _),_,_) -> true | _ -> false) (fst ic)
       then
 	error "Use of numbers as direct arguments of 'case' is not supported.";
       TacInductionDestruct (false,with_evar,ic)
@@ -150,146 +156,156 @@ let mkTacCase with_evar = function
 let rec mkCLambdaN_simple_loc loc bll c =
   match bll with
   | ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CLambdaN (loc,[idl,bk,t],mkCLambdaN_simple_loc (join_loc loc1 loc) bll c)
+      CLambdaN (loc,[idl,bk,t],mkCLambdaN_simple_loc (Loc.merge loc1 loc) bll c)
   | ([],_,_) :: bll -> mkCLambdaN_simple_loc loc bll c
   | [] -> c
 
-let mkCLambdaN_simple bl c =
-  if bl=[] then c
-  else
-    let loc = join_loc (fst (List.hd (pi1 (List.hd bl)))) (constr_loc c) in
+let mkCLambdaN_simple bl c = match bl with
+  | [] -> c
+  | h :: _ ->
+    let loc = Loc.merge (fst (List.hd (pi1 h))) (Constrexpr_ops.constr_loc c) in
     mkCLambdaN_simple_loc loc bl c
 
-let loc_of_ne_list l = join_loc (fst (List.hd l)) (fst (list_last l))
+let loc_of_ne_list l = Loc.merge (fst (List.hd l)) (fst (List.last l))
 
 let map_int_or_var f = function
-  | Glob_term.ArgArg x -> Glob_term.ArgArg (f x)
-  | Glob_term.ArgVar _ as y -> y
-
-let all_concl_occs_clause = { onhyps=Some[]; concl_occs=all_occurrences_expr }
+  | ArgArg x -> ArgArg (f x)
+  | ArgVar _ as y -> y
 
-let has_no_specified_occs cl =
-  (cl.onhyps = None || 
-    List.for_all (fun ((occs,_),_) -> occs = all_occurrences_expr)
-    (Option.get cl.onhyps))
-  && (cl.concl_occs = all_occurrences_expr 
-      || cl.concl_occs = no_occurrences_expr)
+let all_concl_occs_clause = { onhyps=Some[]; concl_occs=AllOccurrences }
 
 let merge_occurrences loc cl = function
   | None ->
-      if has_no_specified_occs cl then (None, cl)
+      if Locusops.clause_with_generic_occurrences cl then (None, cl)
       else
 	user_err_loc (loc,"",str "Found an \"at\" clause without \"with\" clause.")
-  | Some (occs,p) ->
-      (Some p,
-      if occs = all_occurrences_expr then cl
-      else if cl = all_concl_occs_clause then { onhyps=Some[]; concl_occs=occs }
-      else match cl.onhyps with
-      | Some [(occs',id),l] when
-	  occs' = all_occurrences_expr && cl.concl_occs = no_occurrences_expr ->
-	  { cl with onhyps=Some[(occs,id),l] }
+  | Some (occs, p) ->
+    let ans = match occs with
+    | AllOccurrences -> cl
+    | _ ->
+      begin match cl with
+      | { onhyps = Some []; concl_occs = AllOccurrences } ->
+        { onhyps = Some []; concl_occs = occs }
+      | { onhyps = Some [(AllOccurrences, id), l]; concl_occs = NoOccurrences } ->
+        { cl with onhyps = Some [(occs, id), l] }
       | _ ->
-	  if has_no_specified_occs cl then
-	    user_err_loc (loc,"",str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
-	  else
-	    user_err_loc (loc,"",str "Cannot use clause \"at\" twice."))
+        if Locusops.clause_with_generic_occurrences cl then
+          user_err_loc (loc,"",str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
+        else
+          user_err_loc (loc,"",str "Cannot use clause \"at\" twice.")
+      end
+    in
+    (Some p, ans)
 
 (* Auxiliary grammar rules *)
 
 GEXTEND Gram
   GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
-  bindings red_expr int_or_var open_constr casted_open_constr open_constr_wTC
-  simple_intropattern;
+  bindings red_expr int_or_var open_constr uconstr
+  simple_intropattern clause_dft_concl;
 
   int_or_var:
-    [ [ n = integer  -> Glob_term.ArgArg n
-      | id = identref -> Glob_term.ArgVar id ] ]
+    [ [ n = integer  -> ArgArg n
+      | id = identref -> ArgVar id ] ]
   ;
   nat_or_var:
-    [ [ n = natural  -> Glob_term.ArgArg n
-      | id = identref -> Glob_term.ArgVar id ] ]
+    [ [ n = natural  -> ArgArg n
+      | id = identref -> ArgVar id ] ]
   ;
   (* An identifier or a quotation meta-variable *)
   id_or_meta:
-    [ [ id = identref -> AI id
-
-      (* This is used in quotations *)
-      | id = METAIDENT -> MetaId (loc,id) ] ]
+    [ [ id = identref -> id ] ]
   ;
   open_constr:
     [ [ c = constr -> ((),c) ] ]
   ;
-  open_constr_wTC:
-    [ [ c = constr -> ((),c) ] ]
-  ;
-  casted_open_constr:
-    [ [ c = constr -> ((),c) ] ]
+  uconstr:
+    [ [ c = constr -> c ] ]
   ;
   induction_arg:
-    [ [ n = natural -> ElimOnAnonHyp n
-      | c = constr_with_bindings -> induction_arg_of_constr c
+    [ [ n = natural -> (None,ElimOnAnonHyp n)
+      | c = constr_with_bindings -> (None,induction_arg_of_constr c)
+      | "!"; c = constr_with_bindings -> (Some false,induction_arg_of_constr c)
     ] ]
   ;
+  constr_with_bindings_arg:
+    [ [ ">"; c = constr_with_bindings -> (Some true,c)
+      | c = constr_with_bindings -> (None,c) ] ]
+  ;
   quantified_hypothesis:
     [ [ id = ident -> NamedHyp id
       | n = natural -> AnonHyp n ] ]
   ;
   conversion:
     [ [ c = constr -> (None, c)
-      | c1 = constr; "with"; c2 = constr -> (Some (all_occurrences_expr,c1),c2)
+      | c1 = constr; "with"; c2 = constr -> (Some (AllOccurrences,c1),c2)
       | c1 = constr; "at"; occs = occs_nums; "with"; c2 = constr ->
           (Some (occs,c1), c2) ] ]
   ;
   occs_nums:
-    [ [ nl = LIST1 nat_or_var -> no_occurrences_expr_but nl
+    [ [ nl = LIST1 nat_or_var -> OnlyOccurrences nl
       | "-"; n = nat_or_var; nl = LIST0 int_or_var ->
 	  (* have used int_or_var instead of nat_or_var for compatibility *)
-	   all_occurrences_expr_but (List.map (map_int_or_var abs) (n::nl)) ] ]
+	   AllOccurrencesBut (List.map (map_int_or_var abs) (n::nl)) ] ]
   ;
   occs:
-    [ [ "at"; occs = occs_nums -> occs | -> all_occurrences_expr ] ]
+    [ [ "at"; occs = occs_nums -> occs | -> AllOccurrences ] ]
   ;
   pattern_occ:
     [ [ c = constr; nl = occs -> (nl,c) ] ]
   ;
+  ref_or_pattern_occ:
+    (* If a string, it is interpreted as a ref
+       (anyway a Coq string does not reduce) *)
+    [ [ c = smart_global; nl = occs -> nl,Inl c
+      | c = constr; nl = occs -> nl,Inr c ] ]
+  ;
   unfold_occ:
     [ [ c = smart_global; nl = occs -> (nl,c) ] ]
   ;
   intropatterns:
-    [ [ l = LIST0 simple_intropattern -> l ]]
+    [ [ l = LIST0 nonsimple_intropattern -> l ]]
   ;
-  disjunctive_intropattern:
-    [ [ "["; tc = LIST1 intropatterns SEP "|"; "]" -> loc,IntroOrAndPattern tc
-      | "()" -> loc,IntroOrAndPattern [[]]
-      | "("; si = simple_intropattern; ")" -> loc,IntroOrAndPattern [[si]]
+  or_and_intropattern:
+    [ [ "["; tc = LIST1 intropatterns SEP "|"; "]" -> tc
+      | "()" -> [[]]
+      | "("; si = simple_intropattern; ")" -> [[si]]
       | "("; si = simple_intropattern; ",";
-             tc = LIST1 simple_intropattern SEP "," ; ")" ->
-	       loc,IntroOrAndPattern [si::tc]
+             tc = LIST1 simple_intropattern SEP "," ; ")" -> [si::tc]
       | "("; si = simple_intropattern; "&";
 	     tc = LIST1 simple_intropattern SEP "&" ; ")" ->
 	  (* (A & B & C) is translated into (A,(B,C)) *)
 	  let rec pairify = function
-	    | ([]|[_]|[_;_]) as l -> IntroOrAndPattern [l]
-	    | t::q -> IntroOrAndPattern [[t;(loc_of_ne_list q,pairify q)]]
-	  in loc,pairify (si::tc) ] ]
+	    | ([]|[_]|[_;_]) as l -> [l]
+	    | t::q -> [[t;(loc_of_ne_list q,IntroAction (IntroOrAndPattern (pairify q)))]]
+	  in pairify (si::tc) ] ]
+  ;
+  equality_intropattern:
+    [ [ "->" -> IntroRewrite true
+      | "<-" -> IntroRewrite false
+      | "[="; tc = intropatterns; "]" -> IntroInjection tc ] ]
   ;
   naming_intropattern:
-    [ [ prefix = pattern_ident -> loc, IntroFresh prefix
-      | "?" -> loc, IntroAnonymous
-      | id = ident -> loc, IntroIdentifier id
-      | "*" -> loc, IntroForthcoming true
-      | "**" -> loc, IntroForthcoming false ] ]
+    [ [ prefix = pattern_ident -> IntroFresh prefix
+      | "?" -> IntroAnonymous
+      | id = ident -> IntroIdentifier id ] ]
+  ;
+  nonsimple_intropattern:
+    [ [ l = simple_intropattern -> l
+      | "*" -> !@loc, IntroForthcoming true
+      | "**" -> !@loc, IntroForthcoming false ]]
   ;
   simple_intropattern:
-    [ [ pat = disjunctive_intropattern -> pat
-      | pat = naming_intropattern -> pat
-      | "_" -> loc, IntroWildcard
-      | "->" -> loc, IntroRewrite true
-      | "<-" -> loc, IntroRewrite false ] ]
+    [ [ pat = or_and_intropattern -> !@loc, IntroAction (IntroOrAndPattern pat)
+      | pat = equality_intropattern -> !@loc, IntroAction pat
+      | "_" -> !@loc, IntroAction IntroWildcard 
+      | pat = simple_intropattern; "/"; c = constr ->
+          !@loc, IntroAction (IntroApplyOn (c,pat))
+      | pat = naming_intropattern -> !@loc, IntroNaming pat ] ]
   ;
   simple_binding:
-    [ [ "("; id = ident; ":="; c = lconstr; ")" -> (loc, NamedHyp id, c)
-      | "("; n = natural; ":="; c = lconstr; ")" -> (loc, AnonHyp n, c) ] ]
+    [ [ "("; id = ident; ":="; c = lconstr; ")" -> (!@loc, NamedHyp id, c)
+      | "("; n = natural; ":="; c = lconstr; ")" -> (!@loc, AnonHyp n, c) ] ]
   ;
   bindings:
     [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
@@ -297,7 +313,7 @@ GEXTEND Gram
       | bl = LIST1 constr -> ImplicitBindings bl ] ]
   ;
   opt_bindings:
-    [ [ bl = bindings -> bl | -> NoBindings ] ]
+    [ [ bl = LIST1 bindings SEP "," -> bl | -> [NoBindings] ] ]
   ;
   constr_with_bindings:
     [ [ c = constr; l = with_bindings -> (c, l) ] ]
@@ -319,18 +335,20 @@ GEXTEND Gram
     ] ]
   ;
   strategy_flag:
-    [ [ s = LIST1 red_flag -> make_red_flag s
+    [ [ s = LIST1 red_flag -> Redops.make_red_flag s
       | d = delta_flag -> all_with d
     ] ]
   ;
   red_tactic:
     [ [ IDENT "red" -> Red false
       | IDENT "hnf" -> Hnf
-      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
+      | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ -> Simpl (all_with d,po)
       | IDENT "cbv"; s = strategy_flag -> Cbv s
+      | IDENT "cbn"; s = strategy_flag -> Cbn s
       | IDENT "lazy"; s = strategy_flag -> Lazy s
       | IDENT "compute"; delta = delta_flag -> Cbv (all_with delta)
-      | IDENT "vm_compute" -> CbvVm
+      | IDENT "vm_compute"; po = OPT ref_or_pattern_occ -> CbvVm po
+      | IDENT "native_compute"; po = OPT ref_or_pattern_occ -> CbvNative po
       | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
       | IDENT "fold"; cl = LIST1 constr -> Fold cl
       | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> Pattern pl ] ]
@@ -339,11 +357,13 @@ GEXTEND Gram
   red_expr:
     [ [ IDENT "red" -> Red false
       | IDENT "hnf" -> Hnf
-      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
+      | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ -> Simpl (all_with d,po)
       | IDENT "cbv"; s = strategy_flag -> Cbv s
+      | IDENT "cbn"; s = strategy_flag -> Cbn s
       | IDENT "lazy"; s = strategy_flag -> Lazy s
       | IDENT "compute"; delta = delta_flag -> Cbv (all_with delta)
-      | IDENT "vm_compute" -> CbvVm
+      | IDENT "vm_compute"; po = OPT ref_or_pattern_occ -> CbvVm po
+      | IDENT "native_compute"; po = OPT ref_or_pattern_occ -> CbvNative po
       | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
       | IDENT "fold"; cl = LIST1 constr -> Fold cl
       | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> Pattern pl
@@ -369,7 +389,7 @@ GEXTEND Gram
       | hl=LIST0 hypident_occ SEP","; "|-"; occs=concl_occ ->
           {onhyps=Some hl; concl_occs=occs}
       | hl=LIST0 hypident_occ SEP"," ->
-          {onhyps=Some hl; concl_occs=no_occurrences_expr} ] ]
+          {onhyps=Some hl; concl_occs=NoOccurrences} ] ]
   ;
   clause_dft_concl:
     [ [ "in"; cl = in_clause -> cl
@@ -378,21 +398,23 @@ GEXTEND Gram
   ;
   clause_dft_all:
     [ [ "in"; cl = in_clause -> cl
-      | -> {onhyps=None; concl_occs=all_occurrences_expr} ] ]
+      | -> {onhyps=None; concl_occs=AllOccurrences} ] ]
   ;
   opt_clause:
-    [ [ "in"; cl = in_clause -> Some cl | -> None ] ]
+    [ [ "in"; cl = in_clause -> Some cl
+      | "at"; occs = occs_nums -> Some {onhyps=Some[]; concl_occs=occs}
+      | -> None ] ]
   ;
   concl_occ:
     [ [ "*"; occs = occs -> occs
-      | -> no_occurrences_expr ] ]
+      | -> NoOccurrences ] ]
   ;
   in_hyp_list:
     [ [ "in"; idl = LIST1 id_or_meta -> idl
       | -> [] ] ]
   ;
   in_hyp_as:
-    [ [ "in"; id = id_or_meta; ipat = as_ipat -> Some (id,ipat)
+    [ [ "in"; id = id_or_meta; ipat = as_ipat -> Some (None,id,ipat)
       | -> None ] ]
   ;
   orient:
@@ -401,13 +423,13 @@ GEXTEND Gram
       | -> true ]]
   ;
   simple_binder:
-    [ [ na=name -> ([na],Default Explicit,CHole (loc, None))
+    [ [ na=name -> ([na],Default Explicit,CHole (!@loc, Some (Evar_kinds.BinderType (snd na)), IntroAnonymous, None))
       | "("; nal=LIST1 name; ":"; c=lconstr; ")" -> (nal,Default Explicit,c)
     ] ]
   ;
   fixdecl:
     [ [ "("; id = ident; bl=LIST0 simple_binder; ann=fixannot;
-        ":"; ty=lconstr; ")" -> (loc,id,bl,ann,ty) ] ]
+        ":"; ty=lconstr; ")" -> (!@loc, id, bl, ann, ty) ] ]
   ;
   fixannot:
     [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
@@ -415,7 +437,7 @@ GEXTEND Gram
   ;
   cofixdecl:
     [ [ "("; id = ident; bl=LIST0 simple_binder; ":"; ty=lconstr; ")" ->
-        (loc,id,bl,None,ty) ] ]
+        (!@loc, id, bl, None, ty) ] ]
   ;
   bindings_with_parameters:
     [ [ check_for_coloneq; "(";  id = ident; bl = LIST0 simple_binder;
@@ -430,6 +452,16 @@ GEXTEND Gram
     [ [ "using"; l = LIST1 constr SEP "," -> l
       | -> [] ] ]
   ;
+  trivial:
+    [ [ IDENT "trivial" -> Off
+      | IDENT "info_trivial" -> Info
+      | IDENT "debug"; IDENT "trivial" -> Debug ] ]
+  ;
+  auto:
+    [ [ IDENT "auto" -> Off
+      | IDENT "info_auto" -> Info
+      | IDENT "debug"; IDENT "auto" -> Debug ] ]
+  ;
   eliminator:
     [ [ "using"; el = constr_with_bindings -> el ] ]
   ;
@@ -437,18 +469,22 @@ GEXTEND Gram
     [ [ "as"; ipat = simple_intropattern -> Some ipat
       | -> None ] ]
   ;
-  with_inversion_names:
-    [ [ "as"; ipat = simple_intropattern -> Some ipat
+  or_and_intropattern_loc:
+    [ [ ipat = or_and_intropattern -> ArgArg (!@loc,ipat)
+      | locid = identref -> ArgVar locid ] ]
+  ;
+  as_or_and_ipat:
+    [ [ "as"; ipat = or_and_intropattern_loc -> Some ipat
       | -> None ] ]
   ;
   eqn_ipat:
-    [ [ IDENT "eqn"; ":"; id = naming_intropattern -> Some id
-      | IDENT "_eqn"; ":"; id = naming_intropattern ->
+    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> Some (!@loc, pat)
+      | IDENT "_eqn"; ":"; pat = naming_intropattern ->
         let msg = "Obsolete syntax \"_eqn:H\" could be replaced by \"eqn:H\"" in
-        msg_warning (strbrk msg); Some id
+        msg_warning (strbrk msg); Some (!@loc, pat)
       | IDENT "_eqn" ->
         let msg = "Obsolete syntax \"_eqn\" could be replaced by \"eqn:?\"" in
-        msg_warning (strbrk msg); Some (loc, IntroAnonymous)
+        msg_warning (strbrk msg); Some (!@loc, IntroAnonymous)
       | -> None ] ]
   ;
   as_name:
@@ -466,215 +502,186 @@ GEXTEND Gram
     [ [ id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> (id1,id2) ] ]
   ;
   rewriter :
-    [ [ "!"; c = constr_with_bindings -> (RepeatPlus,c)
-      | ["?"| LEFTQMARK]; c = constr_with_bindings -> (RepeatStar,c)
-      | n = natural; "!"; c = constr_with_bindings -> (Precisely n,c)
-      |	n = natural; ["?" | LEFTQMARK]; c = constr_with_bindings -> (UpTo n,c)
-      | n = natural; c = constr_with_bindings -> (Precisely n,c)
-      | c = constr_with_bindings -> (Precisely 1, c)
+    [ [ "!"; c = constr_with_bindings -> (RepeatPlus,(None,c))
+      | ["?"| LEFTQMARK]; c = constr_with_bindings_arg -> (RepeatStar,c)
+      | n = natural; "!"; c = constr_with_bindings -> (Precisely n,(None,c))
+      |	n = natural; ["?" | LEFTQMARK]; c = constr_with_bindings_arg -> (UpTo n,c)
+      | n = natural; c = constr_with_bindings_arg -> (Precisely n,c)
+      | c = constr_with_bindings -> (Precisely 1, (None,c))
       ] ]
   ;
   oriented_rewriter :
     [ [ b = orient; p = rewriter -> let (m,c) = p in (b,m,c) ] ]
   ;
   induction_clause:
-    [ [ c = induction_arg; pat = as_ipat; eq = eqn_ipat -> (c,(eq,pat)) ] ]
+    [ [ c = induction_arg; pat = as_or_and_ipat; eq = eqn_ipat; cl = opt_clause
+        -> (c,(eq,pat),cl) ] ]
   ;
   induction_clause_list:
-    [ [ ic = LIST1 induction_clause SEP ",";
-	el = OPT eliminator; cl = opt_clause -> (ic,el,cl) ] ]
+    [ [ ic = LIST1 induction_clause SEP ","; el = OPT eliminator;
+        cl_tolerance = opt_clause ->
+        (* Condition for accepting "in" at the end by compatibility *)
+        match ic,el,cl_tolerance with
+        | [c,pat,None],Some _,Some _ -> ([c,pat,cl_tolerance],el)
+        | _,_,Some _ -> err ()
+        | _,_,None -> (ic,el) ]]
   ;
   move_location:
     [ [ IDENT "after"; id = id_or_meta -> MoveAfter id
       | IDENT "before"; id = id_or_meta -> MoveBefore id
-      | "at"; IDENT "bottom" -> MoveToEnd true
-      | "at"; IDENT "top" -> MoveToEnd false ] ]
+      | "at"; IDENT "top" -> MoveFirst
+      | "at"; IDENT "bottom" -> MoveLast ] ]
   ;
   simple_tactic:
     [ [
       (* Basic tactics *)
-        IDENT "intros"; IDENT "until"; id = quantified_hypothesis ->
-	  TacIntrosUntil id
-      | IDENT "intros"; pl = intropatterns -> TacIntroPattern pl
+        IDENT "intros"; pl = intropatterns -> TacAtom (!@loc, TacIntroPattern pl)
       | IDENT "intro"; id = ident; hto = move_location ->
-	  TacIntroMove (Some id, hto)
-      | IDENT "intro"; hto = move_location -> TacIntroMove (None, hto)
-      | IDENT "intro"; id = ident -> TacIntroMove (Some id, no_move)
-      | IDENT "intro" -> TacIntroMove (None, no_move)
-
-      | IDENT "assumption" -> TacAssumption
-      | IDENT "exact"; c = constr -> TacExact c
-      | IDENT "exact_no_check"; c = constr -> TacExactNoCheck c
-      | IDENT "vm_cast_no_check"; c = constr -> TacVmCastNoCheck c
-
-      | IDENT "apply"; cl = LIST1 constr_with_bindings SEP ",";
-          inhyp = in_hyp_as -> TacApply (true,false,cl,inhyp)
-      | IDENT "eapply"; cl = LIST1 constr_with_bindings SEP ",";
-          inhyp = in_hyp_as -> TacApply (true,true,cl,inhyp)
-      | IDENT "simple"; IDENT "apply"; cl = LIST1 constr_with_bindings SEP ",";
-          inhyp = in_hyp_as -> TacApply (false,false,cl,inhyp)
-      | IDENT "simple"; IDENT "eapply"; cl = LIST1 constr_with_bindings SEP",";
-          inhyp = in_hyp_as -> TacApply (false,true,cl,inhyp)
-      | IDENT "elim"; cl = constr_with_bindings; el = OPT eliminator ->
-          TacElim (false,cl,el)
-      | IDENT "eelim"; cl = constr_with_bindings; el = OPT eliminator ->
-          TacElim (true,cl,el)
-      | IDENT "elimtype"; c = constr -> TacElimType c
-      | IDENT "case"; icl = induction_clause_list -> mkTacCase false icl
-      | IDENT "ecase"; icl = induction_clause_list -> mkTacCase true icl
-      | IDENT "casetype"; c = constr -> TacCaseType c
-      | "fix"; n = natural -> TacFix (None,n)
-      | "fix"; id = ident; n = natural -> TacFix (Some id,n)
+	  TacAtom (!@loc, TacIntroMove (Some id, hto))
+      | IDENT "intro"; hto = move_location -> TacAtom (!@loc, TacIntroMove (None, hto))
+      | IDENT "intro"; id = ident -> TacAtom (!@loc, TacIntroMove (Some id, MoveLast))
+      | IDENT "intro" -> TacAtom (!@loc, TacIntroMove (None, MoveLast))
+
+      | IDENT "exact"; c = constr -> TacAtom (!@loc, TacExact c)
+
+      | IDENT "apply"; cl = LIST1 constr_with_bindings_arg SEP ",";
+          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (true,false,cl,inhyp))
+      | IDENT "eapply"; cl = LIST1 constr_with_bindings_arg SEP ",";
+          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (true,true,cl,inhyp))
+      | IDENT "simple"; IDENT "apply";
+          cl = LIST1 constr_with_bindings_arg SEP ",";
+          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (false,false,cl,inhyp))
+      | IDENT "simple"; IDENT "eapply";
+          cl = LIST1 constr_with_bindings_arg SEP",";
+          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (false,true,cl,inhyp))
+      | IDENT "elim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
+          TacAtom (!@loc, TacElim (false,cl,el))
+      | IDENT "eelim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
+          TacAtom (!@loc, TacElim (true,cl,el))
+      | IDENT "case"; icl = induction_clause_list -> TacAtom (!@loc, mkTacCase false icl)
+      | IDENT "ecase"; icl = induction_clause_list -> TacAtom (!@loc, mkTacCase true icl)
+      | "fix"; n = natural -> TacAtom (!@loc, TacFix (None,n))
+      | "fix"; id = ident; n = natural -> TacAtom (!@loc, TacFix (Some id,n))
       | "fix"; id = ident; n = natural; "with"; fd = LIST1 fixdecl ->
-	  TacMutualFix (false,id,n,List.map mk_fix_tac fd)
-      | "cofix" -> TacCofix None
-      | "cofix"; id = ident -> TacCofix (Some id)
+	  TacAtom (!@loc, TacMutualFix (id,n,List.map mk_fix_tac fd))
+      | "cofix" -> TacAtom (!@loc, TacCofix None)
+      | "cofix"; id = ident -> TacAtom (!@loc, TacCofix (Some id))
       | "cofix"; id = ident; "with"; fd = LIST1 cofixdecl ->
-	  TacMutualCofix (false,id,List.map mk_cofix_tac fd)
+	  TacAtom (!@loc, TacMutualCofix (id,List.map mk_cofix_tac fd))
 
       | IDENT "pose"; (id,b) = bindings_with_parameters ->
-	  TacLetTac (Names.Name id,b,nowhere,true,None)
+	  TacAtom (!@loc, TacLetTac (Names.Name id,b,Locusops.nowhere,true,None))
       | IDENT "pose"; b = constr; na = as_name ->
-	  TacLetTac (na,b,nowhere,true,None)
+	  TacAtom (!@loc, TacLetTac (na,b,Locusops.nowhere,true,None))
       | IDENT "set"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
-	  TacLetTac (Names.Name id,c,p,true,None)
+	  TacAtom (!@loc, TacLetTac (Names.Name id,c,p,true,None))
       | IDENT "set"; c = constr; na = as_name; p = clause_dft_concl ->
-          TacLetTac (na,c,p,true,None)
+          TacAtom (!@loc, TacLetTac (na,c,p,true,None))
       | IDENT "remember"; c = constr; na = as_name; e = eqn_ipat;
           p = clause_dft_all ->
-          TacLetTac (na,c,p,false,e)
+          TacAtom (!@loc, TacLetTac (na,c,p,false,e))
 
-      (* Begin compatibility *)
+      (* Alternative syntax for "pose proof c as id" *)
       | IDENT "assert"; test_lpar_id_coloneq; "("; (loc,id) = identref; ":=";
 	  c = lconstr; ")" ->
-	  TacAssert (None,Some (loc,IntroIdentifier id),c)
+	  TacAtom (!@loc, TacAssert (true,None,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
+
+      (* Alternative syntax for "assert c as id by tac" *)
       | IDENT "assert"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAssert (Some tac,Some (loc,IntroIdentifier id),c)
-      (* End compatibility *)
+	  TacAtom (!@loc, TacAssert (true,Some tac,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
+
+      (* Alternative syntax for "enough c as id by tac" *)
+      | IDENT "enough"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
+	  c = lconstr; ")"; tac=by_tactic ->
+	  TacAtom (!@loc, TacAssert (false,Some tac,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
 
       | IDENT "assert"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAssert (Some tac,ipat,c)
+	  TacAtom (!@loc, TacAssert (true,Some tac,ipat,c))
       | IDENT "pose"; IDENT "proof"; c = lconstr; ipat = as_ipat ->
-	  TacAssert (None,ipat,c)
+	  TacAtom (!@loc, TacAssert (true,None,ipat,c))
+      | IDENT "enough"; c = constr; ipat = as_ipat; tac = by_tactic ->
+	  TacAtom (!@loc, TacAssert (false,Some tac,ipat,c))
 
-      | IDENT "cut"; c = constr -> TacCut c
       | IDENT "generalize"; c = constr ->
-	  TacGeneralize [((all_occurrences_expr,c),Names.Anonymous)]
+	  TacAtom (!@loc, TacGeneralize [((AllOccurrences,c),Names.Anonymous)])
       | IDENT "generalize"; c = constr; l = LIST1 constr ->
-	  let gen_everywhere c = ((all_occurrences_expr,c),Names.Anonymous) in
-          TacGeneralize (List.map gen_everywhere (c::l))
+	  let gen_everywhere c = ((AllOccurrences,c),Names.Anonymous) in
+          TacAtom (!@loc, TacGeneralize (List.map gen_everywhere (c::l)))
       | IDENT "generalize"; c = constr; lookup_at_as_coma; nl = occs;
           na = as_name;
           l = LIST0 [","; c = pattern_occ; na = as_name -> (c,na)] ->
-          TacGeneralize (((nl,c),na)::l)
-      | IDENT "generalize"; IDENT "dependent"; c = constr -> TacGeneralizeDep c
-
-      | IDENT "specialize"; n = OPT natural; lcb = constr_with_bindings ->
-	  TacSpecialize (n,lcb)
-      | IDENT "lapply"; c = constr -> TacLApply c
+          TacAtom (!@loc, TacGeneralize (((nl,c),na)::l))
+      | IDENT "generalize"; IDENT "dependent"; c = constr -> TacAtom (!@loc, TacGeneralizeDep c)
 
       (* Derived basic tactics *)
-      | IDENT "simple"; IDENT"induction"; h = quantified_hypothesis ->
-          TacSimpleInductionDestruct (true,h)
       | IDENT "induction"; ic = induction_clause_list ->
-	  TacInductionDestruct (true,false,ic)
+	  TacAtom (!@loc, TacInductionDestruct (true,false,ic))
       | IDENT "einduction"; ic = induction_clause_list ->
-	  TacInductionDestruct(true,true,ic)
+	  TacAtom (!@loc, TacInductionDestruct(true,true,ic))
       | IDENT "double"; IDENT "induction"; h1 = quantified_hypothesis;
-	  h2 = quantified_hypothesis -> TacDoubleInduction (h1,h2)
-      | IDENT "simple"; IDENT "destruct"; h = quantified_hypothesis ->
-          TacSimpleInductionDestruct (false,h)
+	  h2 = quantified_hypothesis -> TacAtom (!@loc, TacDoubleInduction (h1,h2))
       | IDENT "destruct"; icl = induction_clause_list ->
-	  TacInductionDestruct(false,false,icl)
+	  TacAtom (!@loc, TacInductionDestruct(false,false,icl))
       | IDENT "edestruct";  icl = induction_clause_list ->
-	  TacInductionDestruct(false,true,icl)
-      | IDENT "decompose"; IDENT "record" ; c = constr -> TacDecomposeAnd c
-      | IDENT "decompose"; IDENT "sum"; c = constr -> TacDecomposeOr c
-      | IDENT "decompose"; "["; l = LIST1 smart_global; "]"; c = constr
-        -> TacDecompose (l,c)
+	  TacAtom (!@loc, TacInductionDestruct(false,true,icl))
 
       (* Automation tactic *)
-      | IDENT "trivial"; lems = auto_using; db = hintbases ->
-          TacTrivial (Off,lems,db)
-      | IDENT "info_trivial"; lems = auto_using; db = hintbases ->
-          TacTrivial (Info,lems,db)
-      | IDENT "debug"; IDENT "trivial"; lems = auto_using; db = hintbases ->
-          TacTrivial (Debug,lems,db)
-
-      | IDENT "auto"; n = OPT int_or_var; lems = auto_using; db = hintbases ->
-          TacAuto (Off,n,lems,db)
-      | IDENT "info_auto"; n = OPT int_or_var; lems = auto_using;
-          db = hintbases -> TacAuto (Info,n,lems,db)
-      | IDENT "debug"; IDENT "auto"; n = OPT int_or_var; lems = auto_using;
-          db = hintbases -> TacAuto (Debug,n,lems,db)
+      | d = trivial; lems = auto_using; db = hintbases -> TacAtom (!@loc, TacTrivial (d,lems,db))
+      | d = auto; n = OPT int_or_var; lems = auto_using; db = hintbases ->
+          TacAtom (!@loc, TacAuto (d,n,lems,db))
 
       (* Context management *)
-      | IDENT "clear"; "-"; l = LIST1 id_or_meta -> TacClear (true, l)
-      | IDENT "clear"; l = LIST0 id_or_meta -> TacClear (l=[], l)
-      | IDENT "clearbody"; l = LIST1 id_or_meta -> TacClearBody l
+      | IDENT "clear"; "-"; l = LIST1 id_or_meta -> TacAtom (!@loc, TacClear (true, l))
+      | IDENT "clear"; l = LIST0 id_or_meta ->
+        let is_empty = match l with [] -> true | _ -> false in
+        TacAtom (!@loc, TacClear (is_empty, l))
+      | IDENT "clearbody"; l = LIST1 id_or_meta -> TacAtom (!@loc, TacClearBody l)
       | IDENT "move"; hfrom = id_or_meta; hto = move_location ->
-	  TacMove (true,hfrom,hto)
-      | IDENT "rename"; l = LIST1 rename SEP "," -> TacRename l
-      | IDENT "revert"; l = LIST1 id_or_meta -> TacRevert l
+	  TacAtom (!@loc, TacMove (hfrom,hto))
+      | IDENT "rename"; l = LIST1 rename SEP "," -> TacAtom (!@loc, TacRename l)
 
       (* Constructors *)
-      | IDENT "left";   bl = with_bindings -> TacLeft  (false,bl)
-      | IDENT "eleft";  bl = with_bindings -> TacLeft  (true,bl)
-      | IDENT "right";  bl = with_bindings -> TacRight (false,bl)
-      | IDENT "eright"; bl = with_bindings -> TacRight (true,bl)
-      | IDENT "split";  bl = with_bindings -> TacSplit (false,false,[bl])
-      | IDENT "esplit"; bl = with_bindings -> TacSplit (true,false,[bl])
-      | "exists"; bll = LIST1 opt_bindings SEP "," -> TacSplit (false,true,bll)
-      | IDENT "eexists"; bll = LIST1 opt_bindings SEP "," ->
-	  TacSplit (true,true,bll)
-      | IDENT "constructor"; n = nat_or_var; l = with_bindings ->
-	  TacConstructor (false,n,l)
-      | IDENT "econstructor"; n = nat_or_var; l = with_bindings ->
-	  TacConstructor (true,n,l)
-      | IDENT "constructor"; t = OPT tactic -> TacAnyConstructor (false,t)
-      | IDENT "econstructor"; t = OPT tactic -> TacAnyConstructor (true,t)
-
+      | "exists"; bll = opt_bindings -> TacAtom (!@loc, TacSplit (false,bll))
+      | IDENT "eexists"; bll = opt_bindings ->
+	  TacAtom (!@loc, TacSplit (true,bll))
       (* Equivalence relations *)
-      | IDENT "reflexivity" -> TacReflexivity
-      | IDENT "symmetry"; cl = clause_dft_concl -> TacSymmetry cl
-      | IDENT "transitivity"; c = constr -> TacTransitivity (Some c)
-      | IDENT "etransitivity" -> TacTransitivity None
+      | IDENT "symmetry"; "in"; cl = in_clause -> TacAtom (!@loc, TacSymmetry cl)
 
       (* Equality and inversion *)
       | IDENT "rewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=opt_by_tactic -> TacRewrite (false,l,cl,t)
+	  cl = clause_dft_concl; t=opt_by_tactic -> TacAtom (!@loc, TacRewrite (false,l,cl,t))
       | IDENT "erewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=opt_by_tactic -> TacRewrite (true,l,cl,t)
+	  cl = clause_dft_concl; t=opt_by_tactic -> TacAtom (!@loc, TacRewrite (true,l,cl,t))
       | IDENT "dependent"; k =
 	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
 	  | IDENT "inversion" -> FullInversion
 	  | IDENT "inversion_clear" -> FullInversionClear ];
 	  hyp = quantified_hypothesis;
-	  ids = with_inversion_names; co = OPT ["with"; c = constr -> c] ->
-	    TacInversion (DepInversion (k,co,ids),hyp)
+	  ids = as_or_and_ipat; co = OPT ["with"; c = constr -> c] ->
+	    TacAtom (!@loc, TacInversion (DepInversion (k,co,ids),hyp))
       | IDENT "simple"; IDENT "inversion";
-	  hyp = quantified_hypothesis; ids = with_inversion_names;
+	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp)
+	    TacAtom (!@loc, TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp))
       | IDENT "inversion";
-	  hyp = quantified_hypothesis; ids = with_inversion_names;
+	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacInversion (NonDepInversion (FullInversion, cl, ids), hyp)
+	    TacAtom (!@loc, TacInversion (NonDepInversion (FullInversion, cl, ids), hyp))
       | IDENT "inversion_clear";
-	  hyp = quantified_hypothesis; ids = with_inversion_names;
+	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp)
+	    TacAtom (!@loc, TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp))
       | IDENT "inversion"; hyp = quantified_hypothesis;
 	  "using"; c = constr; cl = in_hyp_list ->
-	    TacInversion (InversionUsing (c,cl), hyp)
+	    TacAtom (!@loc, TacInversion (InversionUsing (c,cl), hyp))
 
       (* Conversion *)
-      | r = red_tactic; cl = clause_dft_concl -> TacReduce (r, cl)
+      | r = red_tactic; cl = clause_dft_concl -> TacAtom (!@loc, TacReduce (r, cl))
       (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
       | IDENT "change"; (oc,c) = conversion; cl = clause_dft_concl ->
-	  let p,cl = merge_occurrences loc cl oc in
-	  TacChange (p,c,cl)
+	  let p,cl = merge_occurrences (!@loc) cl oc in
+	  TacAtom (!@loc, TacChange (p,c,cl))
     ] ]
   ;
 END;;
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index 75cd7d67..70a8ec55 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -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,24 +8,23 @@
 
 open Pp
 open Compat
-open Tok
+open Errors
 open Util
 open Names
-open Topconstr
+open Constrexpr
+open Constrexpr_ops
 open Extend
 open Vernacexpr
-open Pcoq
-open Tactic
 open Decl_kinds
-open Genarg
-open Ppextend
-open Goptions
-open Declaremods
+open Misctypes
+open Tok (* necessary for camlp4 *)
 
-open Prim
-open Constr
-open Vernac_
-open Module
+open Pcoq
+open Pcoq.Tactic
+open Pcoq.Prim
+open Pcoq.Constr
+open Pcoq.Vernac_
+open Pcoq.Module
 
 let vernac_kw = [ ";"; ","; ">->"; ":<"; "<:"; "where"; "at" ]
 let _ = List.iter Lexer.add_keyword vernac_kw
@@ -33,7 +32,7 @@ let _ = List.iter Lexer.add_keyword vernac_kw
 (* Rem: do not join the different GEXTEND into one, it breaks native *)
 (* compilation on PowerPC and Sun architectures *)
 
-let check_command = Gram.entry_create "vernac:check_command"
+let query_command = Gram.entry_create "vernac:query_command"
 
 let tactic_mode = Gram.entry_create "vernac:tactic_command"
 let noedit_mode = Gram.entry_create "vernac:noedit_command"
@@ -47,6 +46,7 @@ let record_field = Gram.entry_create "vernac:record_field"
 let of_type_with_opt_coercion = Gram.entry_create "vernac:of_type_with_opt_coercion"
 let subgoal_command = Gram.entry_create "proof_mode:subgoal_command"
 let instance_name = Gram.entry_create "vernac:instance_name"
+let section_subset_descr = Gram.entry_create "vernac:section_subset_descr"
 
 let command_entry = ref noedit_mode
 let set_command_entry e = command_entry := e
@@ -63,81 +63,118 @@ let _ = Proof_global.register_proof_mode {Proof_global.
 					    reset = set_noedit_mode
 					 }
 
+let make_bullet s =
+  let n = String.length s in
+  match s.[0] with
+  | '-' -> Dash n
+  | '+' -> Plus n
+  | '*' -> Star n
+  | _ -> assert false
+
 let default_command_entry =
   Gram.Entry.of_parser "command_entry"
     (fun strm -> Gram.parse_tokens_after_filter (get_command_entry ()) strm)
 
-let no_hook _ _ = ()
 GEXTEND Gram
   GLOBAL: vernac gallina_ext tactic_mode noedit_mode subprf subgoal_command;
   vernac: FIRST
-    [ [ IDENT "Time"; v = vernac -> VernacTime v
+    [ [ IDENT "Time"; l = vernac_list -> VernacTime l
       | IDENT "Timeout"; n = natural; v = vernac -> VernacTimeout(n,v)
       | IDENT "Fail"; v = vernac -> VernacFail v
-      | locality; v = vernac_aux -> v ] ]
+
+      | IDENT "Local"; v = vernac_poly -> VernacLocal (true, v)
+      | IDENT "Global"; v = vernac_poly -> VernacLocal (false, v)
+
+      (* Stm backdoor *)
+      | IDENT "Stm"; IDENT "JoinDocument"; "." -> VernacStm JoinDocument
+      | IDENT "Stm"; IDENT "Finish"; "." -> VernacStm Finish
+      | IDENT "Stm"; IDENT "Wait"; "." -> VernacStm Wait
+      | IDENT "Stm"; IDENT "PrintDag"; "." -> VernacStm PrintDag
+      | IDENT "Stm"; IDENT "Observe"; id = INT; "." ->
+          VernacStm (Observe (Stateid.of_int (int_of_string id)))
+      | IDENT "Stm"; IDENT "Command"; v = vernac_aux -> VernacStm (Command v)
+      | IDENT "Stm"; IDENT "PGLast"; v = vernac_aux -> VernacStm (PGLast v)
+
+      | v = vernac_poly -> v ] 
+    ]
+  ;
+  vernac_poly: 
+    [ [ IDENT "Polymorphic"; v = vernac_aux -> VernacPolymorphic (true, v)
+      | IDENT "Monomorphic"; v = vernac_aux -> VernacPolymorphic (false, v) 
+      | v = vernac_aux -> v ]
+    ]
   ;
   vernac_aux:
     (* Better to parse "." here: in case of failure (e.g. in coerce_to_var), *)
     (* "." is still in the stream and discard_to_dot works correctly         *)
-    [ [ g = gallina; "." -> g
+    [ [ IDENT "Program"; g = gallina; "." -> VernacProgram g
+      | IDENT "Program"; g = gallina_ext; "." -> VernacProgram g
+      | g = gallina; "." -> g
       | g = gallina_ext; "." -> g
       | c = command; "." -> c
       | c = syntax; "." -> c
-      | "["; l = LIST1 located_vernac; "]"; "." -> VernacList l
       | c = subprf -> c
     ] ]
   ;
+  vernac_list:
+    [ [ c = located_vernac -> [c] ] ]
+  ;
   vernac_aux: LAST
     [ [ prfcom = default_command_entry -> prfcom ] ]
   ;
-  locality:
-    [ [ IDENT "Local" -> locality_flag := Some (loc,true)
-      | IDENT "Global" -> locality_flag := Some (loc,false)
-      | -> locality_flag := None ] ]
-  ;
   noedit_mode:
     [ [ c = subgoal_command -> c None] ]
   ;
+
+  selector:
+    [ [ n=natural; ":" -> SelectNth n
+      | "["; id = ident; "]"; ":" -> SelectId id
+      | IDENT "all" ; ":" -> SelectAll
+      | IDENT "par" ; ":" -> SelectAllParallel ] ]
+  ;
+
   tactic_mode:
-  [ [ gln = OPT[n=natural; ":" -> n];
+  [ [ gln = OPT selector;
       tac = subgoal_command -> tac gln ] ]
   ;
 
   subprf:
-  [ [
-      "-" -> VernacBullet Dash
-    | "*" -> VernacBullet Star
-    | "+" -> VernacBullet Plus
+  [ [ s = BULLET -> VernacBullet (make_bullet s)
     | "{" -> VernacSubproof None
     | "}" -> VernacEndSubproof
     ] ]
   ;
 
-
-
   subgoal_command: 
-    [ [ c = check_command; "." -> fun g -> c g
-      | tac = Tactic.tactic;
+    [ [ c = query_command; "." ->
+                  begin function
+                    | Some (SelectNth g) -> c (Some g)
+                    | None -> c None
+                    | _ ->
+                        VernacError (UserError ("",str"Typing and evaluation commands, cannot be used with the \"all:\" selector."))
+                  end
+      | info = OPT [IDENT "Info";n=natural -> n];
+        tac = Tactic.tactic;
         use_dft_tac = [ "." -> false | "..." -> true ] ->
-          (fun g ->
-            let g = Option.default 1 g in
-            VernacSolve(g,tac,use_dft_tac)) ] ]
+        (fun g ->
+            let g = Option.default (Proof_global.get_default_goal_selector ()) g in
+            VernacSolve(g,info,tac,use_dft_tac)) ] ]
   ;
   located_vernac:
-    [ [ v = vernac -> loc, v ] ]
+    [ [ v = vernac -> !@loc, v ] ]
   ;
 END
 
 let test_plurial_form = function
   | [(_,([_],_))] ->
       Flags.if_verbose msg_warning
-   (str "Keywords Variables/Hypotheses/Parameters expect more than one assumption")
+   (strbrk "Keywords Variables/Hypotheses/Parameters expect more than one assumption")
   | _ -> ()
 
 let test_plurial_form_types = function
   | [([_],_)] ->
       Flags.if_verbose msg_warning
-   (str "Keywords Implicit Types expect more than one type")
+   (strbrk "Keywords Implicit Types expect more than one type")
   | _ -> ()
 
 (* Gallina declarations *)
@@ -150,39 +187,42 @@ GEXTEND Gram
     [ [ thm = thm_token; id = identref; bl = binders; ":"; c = lconstr;
         l = LIST0
           [ "with"; id = identref; bl = binders; ":"; c = lconstr ->
-            (Some id,(bl,c,None)) ] ->
-          VernacStartTheoremProof (thm,(Some id,(bl,c,None))::l, false, no_hook)
+          (Some id,(bl,c,None)) ] ->
+          VernacStartTheoremProof (thm, (Some id,(bl,c,None))::l, false)
       | stre = assumption_token; nl = inline; bl = assum_list ->
 	  VernacAssumption (stre, nl, bl)
       | stre = assumptions_token; nl = inline; bl = assum_list ->
 	  test_plurial_form bl;
 	  VernacAssumption (stre, nl, bl)
-      | (f,d) = def_token; id = identref; b = def_body ->
-          VernacDefinition (d, id, b, f)
+      | d = def_token; id = identref; b = def_body ->
+          VernacDefinition (d, id, b)
+      | IDENT "Let"; id = identref; b = def_body ->
+          VernacDefinition ((Some Discharge, Definition), id, b)
       (* Gallina inductive declarations *)
-      | f = finite_token;
+      | priv = private_token; f = finite_token;
         indl = LIST1 inductive_definition SEP "with" ->
 	  let (k,f) = f in
 	  let indl=List.map (fun ((a,b,c,d),e) -> ((a,b,c,k,d),e)) indl in
-          VernacInductive (f,false,indl)
+          VernacInductive (priv,f,indl)
       | "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
-          VernacFixpoint recs
+          VernacFixpoint (None, recs)
+      | IDENT "Let"; "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
+          VernacFixpoint (Some Discharge, recs)
       | "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
-          VernacCoFixpoint corecs
+          VernacCoFixpoint (None, corecs)
+      | IDENT "Let"; "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
+          VernacCoFixpoint (Some Discharge, corecs)
       | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> VernacScheme l
       | IDENT "Combined"; IDENT "Scheme"; id = identref; IDENT "from";
-	l = LIST1 identref SEP "," -> VernacCombinedScheme (id, l) ] ]
-  ;
-  gallina_ext:
-    [ [ b = record_token; infer = infer_token; oc = opt_coercion; name = identref;
-        ps = binders;
-	s = OPT [ ":"; s = lconstr -> s ];
-	cfs = [ ":="; l = constructor_list_or_record_decl -> l
-	  | -> RecordDecl (None, []) ] ->
-	  let (recf,indf) = b in
-	    VernacInductive (indf,infer,[((oc,name),ps,s,recf,cfs),[]])
+	      l = LIST1 identref SEP "," -> VernacCombinedScheme (id, l)
+      | IDENT "Register"; IDENT "Inline"; id = identref ->
+          VernacRegister(id, RegisterInline)
+      | IDENT "Universe"; l = LIST1 identref -> VernacUniverse l
+      | IDENT "Universes"; l = LIST1 identref -> VernacUniverse l
+      | IDENT "Constraint"; l = LIST1 univ_constraint SEP "," -> VernacConstraint l
   ] ]
   ;
+
   thm_token:
     [ [ "Theorem" -> Theorem
       | IDENT "Lemma" -> Lemma
@@ -193,50 +233,48 @@ GEXTEND Gram
       | IDENT "Property" -> Property ] ]
   ;
   def_token:
-    [ [ "Definition" ->
-	no_hook, (Global, Definition)
-      | IDENT "Let" ->
-	no_hook, (Local, Definition)
-      | IDENT "Example" ->
-	no_hook, (Global, Example)
-      | IDENT "SubClass"  ->
-          Class.add_subclass_hook, (use_locality_exp (), SubClass) ] ]
+    [ [ "Definition" -> (None, Definition)
+      | IDENT "Example" -> (None, Example)
+      | IDENT "SubClass" -> (None, SubClass) ] ]
   ;
   assumption_token:
-    [ [ "Hypothesis" -> (Local, Logical)
-      | "Variable" -> (Local, Definitional)
-      | "Axiom" -> (Global, Logical)
-      | "Parameter" -> (Global, Definitional)
-      | IDENT "Conjecture" -> (Global, Conjectural) ] ]
+    [ [ "Hypothesis" -> (Some Discharge, Logical)
+      | "Variable" -> (Some Discharge, Definitional)
+      | "Axiom" -> (None, Logical)
+      | "Parameter" -> (None, Definitional)
+      | IDENT "Conjecture" -> (None, Conjectural) ] ]
   ;
   assumptions_token:
-    [ [ IDENT "Hypotheses" -> (Local, Logical)
-      | IDENT "Variables" -> (Local, Definitional)
-      | IDENT "Axioms" -> (Global, Logical)
-      | IDENT "Parameters" -> (Global, Definitional) ] ]
+    [ [ IDENT "Hypotheses" -> (Some Discharge, Logical)
+      | IDENT "Variables" -> (Some Discharge, Definitional)
+      | IDENT "Axioms" -> (None, Logical)
+      | IDENT "Parameters" -> (None, Definitional) ] ]
   ;
   inline:
-    [ [ IDENT "Inline"; "("; i = INT; ")" -> Some (int_of_string i)
-      | IDENT "Inline" -> Some (Flags.get_inline_level())
-      | -> None] ]
+    [ [ IDENT "Inline"; "("; i = INT; ")" -> InlineAt (int_of_string i)
+      | IDENT "Inline" -> DefaultInline
+      | -> NoInline] ]
+  ;
+  univ_constraint:
+    [ [ l = identref; ord = [ "<" -> Univ.Lt | "=" -> Univ.Eq | "<=" -> Univ.Le ];
+	r = identref -> (l, ord, r) ] ]
   ;
   finite_token:
     [ [ "Inductive" -> (Inductive_kw,Finite)
-      | "CoInductive" -> (CoInductive,CoFinite) ] ]
-  ;
-  infer_token:
-    [ [ IDENT "Infer" -> true | -> false ] ]
-  ;
-  record_token:
-    [ [ IDENT "Record" -> (Record,BiFinite)
+      | "CoInductive" -> (CoInductive,CoFinite)
+      | "Variant" -> (Variant,BiFinite)
+      | IDENT "Record" -> (Record,BiFinite)
       | IDENT "Structure" -> (Structure,BiFinite)
       | IDENT "Class" -> (Class true,BiFinite) ] ]
   ;
+  private_token:
+    [ [ IDENT "Private" -> true | -> false ] ]
+  ;
   (* Simple definitions *)
   def_body:
     [ [ bl = binders; ":="; red = reduce; c = lconstr ->
       (match c with
-          CCast(_,c, Glob_term.CastConv (Term.DEFAULTcast,t)) -> DefineBody (bl, red, c, Some t)
+          CCast(_,c, CastConv t) -> DefineBody (bl, red, c, Some t)
         | _ -> DefineBody (bl, red, c, None))
     | bl = binders; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
 	DefineBody (bl, red, c, Some t)
@@ -256,10 +294,14 @@ GEXTEND Gram
     | -> [] ] ]
   ;
   (* Inductives and records *)
+  opt_constructors_or_fields:
+    [ [ ":="; lc = constructor_list_or_record_decl -> lc
+      | -> RecordDecl (None, []) ] ]
+  ;
   inductive_definition:
-    [ [ id = identref; oc = opt_coercion; indpar = binders;
+    [ [ oc = opt_coercion; id = identref; indpar = binders;
         c = OPT [ ":"; c = lconstr -> c ];
-        ":="; lc = constructor_list_or_record_decl; ntn = decl_notation ->
+        lc=opt_constructors_or_fields; ntn = decl_notation ->
 	   (((oc,id),indpar,c,lc),ntn) ] ]
   ;
   constructor_list_or_record_decl:
@@ -296,7 +338,7 @@ GEXTEND Gram
   ;
   type_cstr:
     [ [ ":"; c=lconstr -> c
-      | -> CHole (loc, None) ] ]
+      | -> CHole (!@loc, None, Misctypes.IntroAnonymous, None) ] ]
   ;
   (* Inductive schemes *)
   scheme:
@@ -333,19 +375,19 @@ GEXTEND Gram
   ;
   record_binder_body:
     [ [ l = binders; oc = of_type_with_opt_coercion;
-         t = lconstr -> fun id -> (oc,AssumExpr (id,mkCProdN loc l t))
+         t = lconstr -> fun id -> (oc,AssumExpr (id,mkCProdN (!@loc) l t))
       | l = binders; oc = of_type_with_opt_coercion;
          t = lconstr; ":="; b = lconstr -> fun id ->
-	   (oc,DefExpr (id,mkCLambdaN loc l b,Some (mkCProdN loc l t)))
+	   (oc,DefExpr (id,mkCLambdaN (!@loc) l b,Some (mkCProdN (!@loc) l t)))
       | l = binders; ":="; b = lconstr -> fun id ->
          match b with
-	 | CCast(_,b, Glob_term.CastConv (_, t)) ->
-	     (None,DefExpr(id,mkCLambdaN loc l b,Some (mkCProdN loc l t)))
+	 | CCast(_,b, (CastConv t|CastVM t|CastNative t)) ->
+	     (None,DefExpr(id,mkCLambdaN (!@loc) l b,Some (mkCProdN (!@loc) l t)))
          | _ ->
-	     (None,DefExpr(id,mkCLambdaN loc l b,None)) ] ]
+	     (None,DefExpr(id,mkCLambdaN (!@loc) l b,None)) ] ]
   ;
   record_binder:
-    [ [ id = name -> (None,AssumExpr(id,CHole (loc, None)))
+    [ [ id = name -> (None,AssumExpr(id,CHole (!@loc, None, Misctypes.IntroAnonymous, None)))
       | id = name; f = record_binder_body -> f id ] ]
   ;
   assum_list:
@@ -356,15 +398,15 @@ GEXTEND Gram
   ;
   simple_assum_coe:
     [ [ idl = LIST1 identref; oc = of_type_with_opt_coercion; c = lconstr ->
-        (oc <> None,(idl,c)) ] ]
+        (not (Option.is_empty oc),(idl,c)) ] ]
   ;
 
   constructor_type:
     [[ l = binders;
       t= [ coe = of_type_with_opt_coercion; c = lconstr ->
-	            fun l id -> (coe <> None,(id,mkCProdN loc l c))
+	            fun l id -> (not (Option.is_empty coe),(id,mkCProdN (!@loc) l c))
             |  ->
-		 fun l id -> (false,(id,mkCProdN loc l (CHole (loc, None)))) ]
+		 fun l id -> (false,(id,mkCProdN (!@loc) l (CHole (!@loc, None, Misctypes.IntroAnonymous, None)))) ]
 	 -> t l
      ]]
 ;
@@ -382,10 +424,20 @@ GEXTEND Gram
   ;
 END
 
+let only_identrefs =
+  Gram.Entry.of_parser "test_only_identrefs"
+    (fun strm ->
+      let rec aux n =
+      match get_tok (Util.stream_nth n strm) with
+        | KEYWORD "." -> ()
+        | KEYWORD ")" -> ()
+        | IDENT _ -> aux (n+1)
+        | _ -> raise Stream.Failure in
+      aux 0)
 
 (* Modules and Sections *)
 GEXTEND Gram
-  GLOBAL: gallina_ext module_expr module_type;
+  GLOBAL: gallina_ext module_expr module_type section_subset_descr;
 
   gallina_ext:
     [ [ (* Interactive module declaration *)
@@ -407,18 +459,24 @@ GEXTEND Gram
       (* This end a Section a Module or a Module Type *)
       | IDENT "End"; id = identref -> VernacEndSegment id
 
+      (* Naming a set of section hyps *)
+      | IDENT "Collection"; id = identref; ":="; expr = section_subset_descr ->
+          VernacNameSectionHypSet (id, expr)
+
       (* Requiring an already compiled module *)
       | IDENT "Require"; export = export_token; qidl = LIST1 global ->
-          VernacRequire (export, None, qidl)
-      | IDENT "Require"; export = export_token; filename = ne_string ->
-	  VernacRequireFrom (export, None, filename)
+          VernacRequire (export, qidl)
+      | IDENT "From" ; ns = global ; IDENT "Require"; export = export_token
+	; qidl = LIST1 global ->
+	let qidl = List.map (Libnames.join_reference ns) qidl in
+	VernacRequire (export, qidl)
       | IDENT "Import"; qidl = LIST1 global -> VernacImport (false,qidl)
       | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl)
       | IDENT "Include"; e = module_type_inl; l = LIST0 ext_module_expr ->
 	  VernacInclude(e::l)
       | IDENT "Include"; "Type"; e = module_type_inl; l = LIST0 ext_module_type ->
 	  Flags.if_verbose
-            msg_warning (str "Include Type is deprecated; use Include instead");
+            msg_warning (strbrk "Include Type is deprecated; use Include instead");
           VernacInclude(e::l) ] ]
   ;
   export_token:
@@ -451,32 +509,19 @@ GEXTEND Gram
       | -> [] ] ]
   ;
   functor_app_annot:
-    [ [ IDENT "inline"; "at"; IDENT "level"; i = INT ->
-        [InlineAt (int_of_string i)], []
-      | IDENT "no"; IDENT "inline" -> [NoInline], []
-      | IDENT "scope"; sc1 = IDENT; IDENT "to"; sc2 = IDENT -> [], [sc1,sc2]
-      ] ]
-  ;
-  functor_app_annots:
-    [ [ "["; l = LIST1 functor_app_annot SEP ","; "]" ->
-        let inl,scs = List.split l in
-	let inl = match List.concat inl with
-	  | [] -> DefaultInline
-	  | [inl] -> inl
-	  | _ -> error "Functor application with redundant inline annotations"
-	in { ann_inline = inl; ann_scope_subst = List.concat scs }
-      | -> { ann_inline = DefaultInline; ann_scope_subst = [] }
+    [ [ "["; IDENT "inline"; "at"; IDENT "level"; i = INT; "]" ->
+        InlineAt (int_of_string i)
+      | "["; IDENT "no"; IDENT "inline"; "]" -> NoInline
+      | -> DefaultInline
       ] ]
   ;
   module_expr_inl:
-    [ [ "!"; me = module_expr ->
-        (me, { ann_inline = NoInline; ann_scope_subst = []})
-      | me = module_expr; a = functor_app_annots -> (me,a) ] ]
+    [ [ "!"; me = module_expr -> (me,NoInline)
+      | me = module_expr; a = functor_app_annot -> (me,a) ] ]
   ;
   module_type_inl:
-    [ [ "!"; me = module_type ->
-        (me, { ann_inline = NoInline; ann_scope_subst = []})
-      | me = module_type; a = functor_app_annots -> (me,a) ] ]
+    [ [ "!"; me = module_type -> (me,NoInline)
+      | me = module_type; a = functor_app_annot -> (me,a) ] ]
   ;
   (* Module binder  *)
   module_binder:
@@ -486,7 +531,7 @@ GEXTEND Gram
   (* Module expressions *)
   module_expr:
     [ [ me = module_expr_atom -> me
-      | me1 = module_expr; me2 = module_expr_atom -> CMapply (loc,me1,me2)
+      | me1 = module_expr; me2 = module_expr_atom -> CMapply (!@loc,me1,me2)
       ] ]
   ;
   module_expr_atom:
@@ -502,11 +547,28 @@ GEXTEND Gram
   module_type:
     [ [ qid = qualid -> CMident qid
       | "("; mt = module_type; ")" -> mt
-      | mty = module_type; me = module_expr_atom -> CMapply (loc,mty,me)
+      | mty = module_type; me = module_expr_atom -> CMapply (!@loc,mty,me)
       | mty = module_type; "with"; decl = with_declaration ->
-          CMwith (loc,mty,decl)
+          CMwith (!@loc,mty,decl)
       ] ]
   ;
+  section_subset_descr:
+    [ [ IDENT "All" -> SsAll
+      | "Type" -> SsType
+      | only_identrefs; l = LIST0 identref -> SsExpr (SsSet l)
+      | e = section_subset_expr -> SsExpr e ] ]
+  ;
+  section_subset_expr:
+    [ "35" 
+      [ "-"; e = section_subset_expr -> SsCompl e ]
+    | "50"
+      [ e1 = section_subset_expr; "-"; e2 = section_subset_expr->SsSubstr(e1,e2)
+      | e1 = section_subset_expr; "+"; e2 = section_subset_expr->SsUnion(e1,e2)]
+    | "0"
+      [ i = identref -> SsSet [i]
+      | "("; only_identrefs; l = LIST0 identref; ")"-> SsSet l
+      | "("; e = section_subset_expr; ")"-> e ] ]
+  ;
 END
 
 (* Extensions: implicits, coercions, etc. *)
@@ -516,12 +578,12 @@ GEXTEND Gram
   gallina_ext:
     [ [ (* Transparent and Opaque *)
         IDENT "Transparent"; l = LIST1 smart_global ->
-          VernacSetOpacity (use_non_locality (),[Conv_oracle.transparent,l])
+          VernacSetOpacity (Conv_oracle.transparent, l)
       | IDENT "Opaque"; l = LIST1 smart_global ->
-          VernacSetOpacity (use_non_locality (),[Conv_oracle.Opaque, l])
+          VernacSetOpacity (Conv_oracle.Opaque, l)
       | IDENT "Strategy"; l =
-          LIST1 [ lev=strategy_level; "["; q=LIST1 smart_global; "]" -> (lev,q)] ->
-            VernacSetOpacity (use_locality (),l)
+          LIST1 [ v=strategy_level; "["; q=LIST1 smart_global; "]" -> (v,q)] ->
+            VernacSetStrategy l
       (* Canonical structure *)
       | IDENT "Canonical"; IDENT "Structure"; qid = global ->
 	  VernacCanonical (AN qid)
@@ -531,50 +593,50 @@ GEXTEND Gram
           d = def_body ->
           let s = coerce_reference_to_id qid in
 	  VernacDefinition
-	    ((Global,CanonicalStructure),(dummy_loc,s),d,
-	     (fun _ -> Recordops.declare_canonical_structure))
+	    ((Some Global,CanonicalStructure),(Loc.ghost,s),d)
 
       (* Coercions *)
       | IDENT "Coercion"; qid = global; d = def_body ->
           let s = coerce_reference_to_id qid in
-	  VernacDefinition ((use_locality_exp (),Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
+	  VernacDefinition ((None,Coercion),(Loc.ghost,s),d)
       | IDENT "Coercion"; IDENT "Local"; qid = global; d = def_body ->
            let s = coerce_reference_to_id qid in
-	  VernacDefinition ((enforce_locality_exp true,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
+	  VernacDefinition ((Some Decl_kinds.Local,Coercion),(Loc.ghost,s),d)
       | IDENT "Identity"; IDENT "Coercion"; IDENT "Local"; f = identref;
          ":"; s = class_rawexpr; ">->"; t = class_rawexpr ->
-	   VernacIdentityCoercion (enforce_locality_exp true, f, s, t)
+	   VernacIdentityCoercion (true, f, s, t)
       | IDENT "Identity"; IDENT "Coercion"; f = identref; ":";
          s = class_rawexpr; ">->"; t = class_rawexpr ->
-	   VernacIdentityCoercion (use_locality_exp (), f, s, t)
+	   VernacIdentityCoercion (false, f, s, t)
       | IDENT "Coercion"; IDENT "Local"; qid = global; ":";
 	 s = class_rawexpr; ">->"; t = class_rawexpr ->
-	  VernacCoercion (enforce_locality_exp true, AN qid, s, t)
+	  VernacCoercion (true, AN qid, s, t)
       | IDENT "Coercion"; IDENT "Local"; ntn = by_notation; ":";
 	 s = class_rawexpr; ">->"; t = class_rawexpr ->
-	  VernacCoercion (enforce_locality_exp true, ByNotation ntn, s, t)
+	  VernacCoercion (true, ByNotation ntn, s, t)
       | IDENT "Coercion"; qid = global; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
-	  VernacCoercion (use_locality_exp (), AN qid, s, t)
+	  VernacCoercion (false, AN qid, s, t)
       | IDENT "Coercion"; ntn = by_notation; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
-	  VernacCoercion (use_locality_exp (), ByNotation ntn, s, t)
+	  VernacCoercion (false, ByNotation ntn, s, t)
 
       | IDENT "Context"; c = binders ->
 	  VernacContext c
 
       | IDENT "Instance"; namesup = instance_name; ":";
-	 expl = [ "!" -> Glob_term.Implicit | -> Glob_term.Explicit ] ; t = operconstr LEVEL "200";
+	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
 	 pri = OPT [ "|"; i = natural -> i ] ;
-	 props = [ ":="; "{"; r = record_declaration; "}" -> Some r |
-	     ":="; c = lconstr -> Some c | -> None ] ->
-	   VernacInstance (false, not (use_section_locality ()),
-			   snd namesup, (fst namesup, expl, t), props, pri)
+	 props = [ ":="; "{"; r = record_declaration; "}" -> Some (true,r) |
+	     ":="; c = lconstr -> Some (false,c) | -> None ] ->
+	   VernacInstance (false,snd namesup,(fst namesup,expl,t),props,pri)
 
-      | IDENT "Existing"; IDENT "Instance"; id = global ->
-	  VernacDeclareInstances (not (use_section_locality ()), [id])
-      | IDENT "Existing"; IDENT "Instances"; ids = LIST1 global ->
-	  VernacDeclareInstances (not (use_section_locality ()), ids)
+      | IDENT "Existing"; IDENT "Instance"; id = global;
+          pri = OPT [ "|"; i = natural -> i ] ->
+	  VernacDeclareInstances ([id], pri)
+      | IDENT "Existing"; IDENT "Instances"; ids = LIST1 global;
+          pri = OPT [ "|"; i = natural -> i ] ->
+	  VernacDeclareInstances (ids, pri)
 
       | IDENT "Existing"; IDENT "Class"; is = global -> VernacDeclareClass is
 
@@ -586,17 +648,17 @@ GEXTEND Gram
         | "/" -> [`Slash]
         | "("; items = LIST1 argument_spec; ")"; sc = OPT scope ->
             let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> loc, y) x
+            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
             | Some _, Some _ -> error "scope declared twice" in
             List.map (fun (id,r,s) -> `Id(id,r,f s,false,false)) items
         | "["; items = LIST1 argument_spec; "]"; sc = OPT scope ->
             let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> loc, y) x
+            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
             | Some _, Some _ -> error "scope declared twice" in
             List.map (fun (id,r,s) -> `Id(id,r,f s,true,false)) items
         | "{"; items = LIST1 argument_spec; "}"; sc = OPT scope ->
             let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> loc, y) x
+            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
             | Some _, Some _ -> error "scope declared twice" in
             List.map (fun (id,r,s) -> `Id(id,r,f s,true,true)) items
         ] -> l ] SEP ",";
@@ -609,31 +671,30 @@ GEXTEND Gram
            | [] -> narg, impl in
          let nargs, impl = List.split (List.map (aux 0 (-1, [])) impl) in
          let nargs, rest = List.hd nargs, List.tl nargs in
-         if List.exists ((<>) nargs) rest then
+         if List.exists (fun arg -> not (Int.equal arg nargs)) rest then
            error "All arguments lists must have the same length";
          let err_incompat x y =
            error ("Options \""^x^"\" and \""^y^"\" are incompatible") in
-         if nargs > 0 && List.mem `SimplNeverUnfold mods then
+         if nargs > 0 && List.mem `ReductionNeverUnfold mods then
            err_incompat "simpl never" "/";
-         if List.mem `SimplNeverUnfold mods &&
-            List.mem `SimplDontExposeCase mods then
+         if List.mem `ReductionNeverUnfold mods &&
+            List.mem `ReductionDontExposeCase mods then
            err_incompat "simpl never" "simpl nomatch";
-         VernacArguments (use_section_locality(), qid, impl, nargs, mods)
+         VernacArguments (qid, impl, nargs, mods)
 
      (* moved there so that camlp5 factors it with the previous rule *)
      | IDENT "Arguments"; IDENT "Scope"; qid = smart_global;
        "["; scl = LIST0 [ "_" -> None | sc = IDENT -> Some sc ]; "]" ->
-	   Flags.if_verbose
-             msg_warning (str "Arguments Scope is deprecated; use Arguments instead");
-	 VernacArgumentsScope (use_section_locality (),qid,scl)
+        msg_warning (strbrk "Arguments Scope is deprecated; use Arguments instead");
+        VernacArgumentsScope (qid,scl)
 
       (* Implicit *)
       | IDENT "Implicit"; IDENT "Arguments"; qid = smart_global;
 	   pos = LIST0 [ "["; l = LIST0 implicit_name; "]" ->
 	     List.map (fun (id,b,f) -> (ExplByName id,b,f)) l ] ->
 	   Flags.if_verbose
-             msg_warning (str "Implicit Arguments is deprecated; use Arguments instead");
-	   VernacDeclareImplicits (use_section_locality (),qid,pos)
+             msg_warning (strbrk "Implicit Arguments is deprecated; use Arguments instead");
+	   VernacDeclareImplicits (qid,pos)
 
       | IDENT "Implicit"; "Type"; bl = reserv_list ->
 	   VernacReserve bl
@@ -647,15 +708,16 @@ GEXTEND Gram
 	     | IDENT "No"; IDENT "Variables" -> None
 	     | ["Variable" | IDENT "Variables"];
 		  idl = LIST1 identref -> Some idl ] ->
-	     VernacGeneralizable (use_non_locality (), gen) ] ]
+	     VernacGeneralizable gen ] ]
   ;
   arguments_modifier:
-    [ [ IDENT "simpl"; IDENT "nomatch" -> [`SimplDontExposeCase]
-      | IDENT "simpl"; IDENT "never" -> [`SimplNeverUnfold]
+    [ [ IDENT "simpl"; IDENT "nomatch" -> [`ReductionDontExposeCase]
+      | IDENT "simpl"; IDENT "never" -> [`ReductionNeverUnfold]
       | IDENT "default"; IDENT "implicits" -> [`DefaultImplicits]
       | IDENT "clear"; IDENT "implicits" -> [`ClearImplicits]
       | IDENT "clear"; IDENT "scopes" -> [`ClearScopes]
       | IDENT "rename" -> [`Rename]
+      | IDENT "assert" -> [`Assert]
       | IDENT "extra"; IDENT "scopes" -> [`ExtraScopes]
       | IDENT "clear"; IDENT "scopes"; IDENT "and"; IDENT "implicits" ->
           [`ClearImplicits; `ClearScopes]
@@ -674,7 +736,7 @@ GEXTEND Gram
   ;
   argument_spec: [
        [ b = OPT "!"; id = name ; s = OPT scope ->
-       snd id, b <> None, Option.map (fun x -> loc, x) s
+       snd id, not (Option.is_empty b), Option.map (fun x -> !@loc, x) s
     ]
   ];
   strategy_level:
@@ -688,7 +750,7 @@ GEXTEND Gram
     [ [ name = identref; sup = OPT binders ->
 	  (let (loc,id) = name in (loc, Name id)),
           (Option.default [] sup)
-      | -> (loc, Anonymous), []  ] ]
+      | -> (!@loc, Anonymous), []  ] ]
   ;
   reserv_list:
     [ [ bl = LIST1 reserv_tuple -> bl | b = simple_reserv -> [b] ] ]
@@ -703,18 +765,20 @@ GEXTEND Gram
 END
 
 GEXTEND Gram
-  GLOBAL: command check_command class_rawexpr;
+  GLOBAL: command query_command class_rawexpr;
 
   command:
-    [ [ IDENT "Comments"; l = LIST0 comment -> VernacComments l
+    [ [ IDENT "Ltac";
+        l = LIST1 tacdef_body SEP "with" ->
+          VernacDeclareTacticDefinition (true, l)
+
+      | IDENT "Comments"; l = LIST0 comment -> VernacComments l
 
       (* Hack! Should be in grammar_ext, but camlp4 factorize badly *)
       | IDENT "Declare"; IDENT "Instance"; namesup = instance_name; ":";
-	 expl = [ "!" -> Glob_term.Implicit | -> Glob_term.Explicit ] ; t = operconstr LEVEL "200";
+	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
 	 pri = OPT [ "|"; i = natural -> i ] ->
-	   VernacInstance (true, not (use_section_locality ()),
-			   snd namesup, (fst namesup, expl, t),
-			   None, pri)
+	   VernacInstance (true, snd namesup, (fst namesup, expl, t), None, pri)
 
       (* System directory *)
       | IDENT "Pwd" -> VernacChdir None
@@ -729,7 +793,7 @@ GEXTEND Gram
 	s = [ s = ne_string -> s | s = IDENT -> s ] ->
 	  VernacLoad (verbosely, s)
       | IDENT "Declare"; IDENT "ML"; IDENT "Module"; l = LIST1 ne_string ->
-	  VernacDeclareMLModule (use_locality (), l)
+	  VernacDeclareMLModule l
 
       | IDENT "Locate"; l = locatable -> VernacLocate l
 
@@ -759,44 +823,32 @@ GEXTEND Gram
 	  VernacPrint (PrintModuleType qid)
       | IDENT "Print"; IDENT "Module"; qid = global ->
 	  VernacPrint (PrintModule qid)
+      | IDENT "Print"; IDENT "Namespace" ; ns = dirpath ->
+          VernacPrint (PrintNamespace ns)
       | IDENT "Inspect"; n = natural -> VernacPrint (PrintInspect n)
-      | IDENT "About"; qid = smart_global -> VernacPrint (PrintAbout qid)
-
-      (* Searching the environment *)
-      | IDENT "Search"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchHead c, l)
-      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchPattern c, l)
-      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchRewrite c, l)
-      | IDENT "SearchAbout"; s = searchabout_query; l = searchabout_queries ->
-	  let (sl,m) = l in VernacSearch (SearchAbout (s::sl), m)
-      (* compatibility format of SearchAbout, with "[ ... ]" *)
-      | IDENT "SearchAbout"; "["; sl = LIST1 searchabout_query; "]";
-	  l = in_or_out_modules -> VernacSearch (SearchAbout sl, l)
 
       | IDENT "Add"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
 	  VernacAddMLPath (false, dir)
       | IDENT "Add"; IDENT "Rec"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
 	  VernacAddMLPath (true, dir)
 
-      (* Pour intervenir sur les tables de param��tres *)
+      (* For acting on parameter tables *)
       | "Set"; table = option_table; v = option_value ->
-  	  VernacSetOption (use_locality_full(),table,v)
+  	  VernacSetOption (table,v)
       | "Set"; table = option_table ->
-  	  VernacSetOption (use_locality_full(),table,BoolValue true)
+  	  VernacSetOption (table,BoolValue true)
       | IDENT "Unset"; table = option_table ->
-  	  VernacUnsetOption (use_locality_full(),table)
+  	  VernacUnsetOption table
 
       | IDENT "Print"; IDENT "Table"; table = option_table ->
 	  VernacPrintOption table
 
       | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
         -> VernacAddOption ([table;field], v)
-      (* Un value global ci-dessous va ��tre cach�� par un field au dessus! *)
-      (* En fait, on donne priorit�� aux tables secondaires *)
-      (* Pas de syntaxe pour les tables tertiaires pour cause de conflit *)
-      (* (mais de toutes fa��ons, pas utilis��es) *)
+      (* A global value below will be hidden by a field above! *)
+      (* In fact, we give priority to secondary tables *)
+      (* No syntax for tertiary tables due to conflict *)
+      (* (but they are unused anyway) *)
       | IDENT "Add"; table = IDENT; v = LIST1 option_ref_value ->
           VernacAddOption ([table], v)
 
@@ -810,13 +862,31 @@ GEXTEND Gram
       | IDENT "Remove"; table = IDENT; v = LIST1 option_ref_value ->
 	  VernacRemoveOption ([table], v) ]] 
   ;
-  check_command: (* TODO: rapprocher Eval et Check *)
+  query_command: (* TODO: rapprocher Eval et Check *)
     [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
           fun g -> VernacCheckMayEval (Some r, g, c)
       | IDENT "Compute"; c = lconstr ->
-	  fun g -> VernacCheckMayEval (Some Glob_term.CbvVm, g, c)
+	  fun g -> VernacCheckMayEval (Some (Genredexpr.CbvVm None), g, c)
       | IDENT "Check"; c = lconstr ->
-	  fun g -> VernacCheckMayEval (None, g, c) ] ]
+	 fun g -> VernacCheckMayEval (None, g, c)
+      (* Searching the environment *)
+      | IDENT "About"; qid = smart_global ->
+	 fun g -> VernacPrint (PrintAbout (qid,g))
+      | IDENT "SearchHead"; c = constr_pattern; l = in_or_out_modules ->
+	  fun g -> VernacSearch (SearchHead c,g, l)
+      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules ->
+	  fun g -> VernacSearch (SearchPattern c,g, l)
+      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
+	  fun g -> VernacSearch (SearchRewrite c,g, l)
+      | IDENT "Search"; s = searchabout_query; l = searchabout_queries ->
+	  let (sl,m) = l in fun g -> VernacSearch (SearchAbout (s::sl),g, m)
+      (* compatibility: SearchAbout *)
+      | IDENT "SearchAbout"; s = searchabout_query; l = searchabout_queries ->
+	  fun g -> let (sl,m) = l in VernacSearch (SearchAbout (s::sl),g, m)
+      (* compatibility: SearchAbout with "[ ... ]" *)
+      | IDENT "SearchAbout"; "["; sl = LIST1 searchabout_query; "]";
+	  l = in_or_out_modules -> fun g -> VernacSearch (SearchAbout sl,g, l)
+      ] ]
   ;
   printable:
     [ [ IDENT "Term"; qid = smart_global -> PrintName qid
@@ -832,6 +902,7 @@ GEXTEND Gram
 
       | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
       | IDENT "ML"; IDENT "Modules" -> PrintMLModules
+      | IDENT "Debug"; IDENT "GC" -> PrintDebugGC
       | IDENT "Graph" -> PrintGraph
       | IDENT "Classes" ->  PrintClasses
       | IDENT "TypeClasses" -> PrintTypeClasses
@@ -854,8 +925,12 @@ GEXTEND Gram
       | IDENT "Implicit"; qid = smart_global -> PrintImplicit qid
       | IDENT "Universes"; fopt = OPT ne_string -> PrintUniverses (false, fopt)
       | IDENT "Sorted"; IDENT "Universes"; fopt = OPT ne_string -> PrintUniverses (true, fopt)
-      | IDENT "Assumptions"; qid = smart_global -> PrintAssumptions (false, qid)
-      | IDENT "Opaque"; IDENT "Dependencies"; qid = smart_global -> PrintAssumptions (true, qid) ] ]
+      | IDENT "Assumptions"; qid = smart_global -> PrintAssumptions (false, false, qid)
+      | IDENT "Opaque"; IDENT "Dependencies"; qid = smart_global -> PrintAssumptions (true, false, qid)
+      | IDENT "Transparent"; IDENT "Dependencies"; qid = smart_global -> PrintAssumptions (false, true, qid)
+      | IDENT "All"; IDENT "Dependencies"; qid = smart_global -> PrintAssumptions (true, true, qid)
+      | IDENT "Strategy"; qid = smart_global -> PrintStrategy (Some qid)
+      | IDENT "Strategies" -> PrintStrategy None ] ]
   ;
   class_rawexpr:
     [ [ IDENT "Funclass" -> FunClass
@@ -863,7 +938,8 @@ GEXTEND Gram
       | qid = smart_global -> RefClass qid ] ]
   ;
   locatable:
-    [ [ qid = smart_global -> LocateTerm qid
+    [ [ qid = smart_global -> LocateAny qid
+      | IDENT "Term"; qid = smart_global -> LocateTerm qid
       | IDENT "File"; f = ne_string -> LocateFile f
       | IDENT "Library"; qid = global -> LocateLibrary qid
       | IDENT "Module"; qid = global -> LocateModule qid
@@ -938,16 +1014,16 @@ GEXTEND Gram
 
 (* Tactic Debugger *)
       |	IDENT "Debug"; IDENT "On" ->
-          VernacSetOption (None,["Ltac";"Debug"], BoolValue true)
+          VernacSetOption (["Ltac";"Debug"], BoolValue true)
 
       |	IDENT "Debug"; IDENT "Off" ->
-          VernacSetOption (None,["Ltac";"Debug"], BoolValue false)
+          VernacSetOption (["Ltac";"Debug"], BoolValue false)
 
 (* registration of a custom reduction *)
 
       | IDENT "Declare"; IDENT "Reduction"; s = IDENT; ":=";
          r = Tactic.red_expr ->
-	   VernacDeclareReduction (use_locality(),s,r)
+	   VernacDeclareReduction (s,r)
 
  ] ];
     END
@@ -960,31 +1036,33 @@ GEXTEND Gram
 
   syntax:
    [ [ IDENT "Open"; local = obsolete_locality; IDENT "Scope"; sc = IDENT ->
-         VernacOpenCloseScope (enforce_section_locality local,true,sc)
+         VernacOpenCloseScope (local,(true,sc))
 
      | IDENT "Close"; local = obsolete_locality; IDENT "Scope"; sc = IDENT ->
-         VernacOpenCloseScope (enforce_section_locality local,false,sc)
+         VernacOpenCloseScope (local,(false,sc))
 
      | IDENT "Delimit"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT ->
 	 VernacDelimiters (sc,key)
 
      | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with";
-       refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
+       refl = LIST1 smart_global -> VernacBindScope (sc,refl)
 
      | IDENT "Infix"; local = obsolete_locality;
 	 op = ne_lstring; ":="; p = constr;
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-         VernacInfix (enforce_module_locality local,(op,modl),p,sc)
+         VernacInfix (local,(op,modl),p,sc)
      | IDENT "Notation"; local = obsolete_locality; id = identref;
 	 idl = LIST0 ident; ":="; c = constr; b = only_parsing ->
            VernacSyntacticDefinition
-	     (id,(idl,c),enforce_module_locality local,b)
+	     (id,(idl,c),local,b)
      | IDENT "Notation"; local = obsolete_locality; s = ne_lstring; ":=";
 	 c = constr;
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-           VernacNotation (enforce_module_locality local,c,(s,modl),sc)
+           VernacNotation (local,c,(s,modl),sc)
+     | IDENT "Format"; IDENT "Notation"; n = STRING; s = STRING; fmt = STRING ->
+           VernacNotationAddFormat (n,s,fmt)
 
      | IDENT "Tactic"; IDENT "Notation"; n = tactic_level;
 	 pil = LIST1 production_item; ":="; t = Tactic.tactic
@@ -994,12 +1072,12 @@ GEXTEND Gram
 	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ] ->
 	   Metasyntax.check_infix_modifiers l;
 	   let (loc,s) = s in
-	   VernacSyntaxExtension (use_module_locality(),((loc,"x '"^s^"' y"),l))
+	   VernacSyntaxExtension (false,((loc,"x '"^s^"' y"),l))
 
      | IDENT "Reserved"; IDENT "Notation"; local = obsolete_locality;
 	 s = ne_lstring;
 	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ]
-	 -> VernacSyntaxExtension (enforce_module_locality local,(s,l))
+	 -> VernacSyntaxExtension (local,(s,l))
 
      (* "Print" "Grammar" should be here but is in "command" entry in order
         to factorize with other "Print"-based vernac entries *)
@@ -1031,7 +1109,11 @@ GEXTEND Gram
         SetOnlyParsing Flags.Current
       | IDENT "compat"; s = STRING ->
         SetOnlyParsing (Coqinit.get_compat_version s)
-      | IDENT "format"; s = [s = STRING -> (loc,s)] -> SetFormat s
+      | IDENT "format"; s1 = [s = STRING -> (!@loc,s)];
+                        s2 = OPT [s = STRING -> (!@loc,s)] ->
+          begin match s1, s2 with
+          | (_,k), Some s -> SetFormat(k,s)
+          | s, None -> SetFormat ("text",s) end
       | x = IDENT; ","; l = LIST1 [id = IDENT -> id ] SEP ","; "at";
         lev = level -> SetItemLevel (x::l,lev)
       | x = IDENT; "at"; lev = level -> SetItemLevel ([x],lev)
@@ -1049,6 +1131,6 @@ GEXTEND Gram
     [ [ s = ne_string -> TacTerm s
       | nt = IDENT;
         po = OPT [ "("; p = ident; sep = [ -> "" | ","; sep = STRING -> sep ];
-                   ")" -> (p,sep) ] -> TacNonTerm (loc,nt,po) ] ]
+                   ")" -> (p,sep) ] -> TacNonTerm (!@loc,nt,po) ] ]
   ;
 END
diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4
index 6f5e378a..84e4a573 100644
--- a/parsing/g_xml.ml4
+++ b/parsing/g_xml.ml4
@@ -1,32 +1,34 @@
 (************************************************************************)
 (*  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 Compat
 open Pp
+open Errors
 open Util
 open Names
-open Term
 open Pcoq
 open Glob_term
-open Genarg
 open Tacexpr
 open Libnames
-
-open Nametab
+open Globnames
 open Detyping
-open Tok
+open Misctypes
+open Decl_kinds
+open Genredexpr
+open Tok (* necessary for camlp4 *)
 
 (* Generic xml parser without raw data *)
 
-type attribute = string * (loc * string)
-type xml = XmlTag of loc * string * attribute list * xml list
+type attribute = string * (Loc.t * string)
+type xml = XmlTag of Loc.t * string * attribute list * xml list
 
 let check_tags loc otag ctag =
-  if otag <> ctag then
+  if not (String.equal otag ctag) then
     user_err_loc (loc,"",str "closing xml tag " ++ str ctag ++
       str "does not match open xml tag " ++ str otag ++ str ".")
 
@@ -41,27 +43,22 @@ GEXTEND Gram
   xml:
     [ [ "<"; otag = IDENT; attrs = LIST0 attr; ">"; l = LIST1 xml;
         "<"; "/"; ctag = IDENT; ">"  ->
-	  check_tags loc otag ctag;
-	  XmlTag (loc,ctag,attrs,l)
+	  check_tags (!@loc) otag ctag;
+	  XmlTag (!@loc,ctag,attrs,l)
       | "<"; tag = IDENT; attrs = LIST0 attr; "/"; ">" ->
-	  XmlTag (loc,tag,attrs,[])
+	  XmlTag (!@loc,tag,attrs,[])
     ] ]
   ;
   attr:
-    [ [ name = IDENT; "="; data = STRING -> (name, (loc, data)) ] ]
+    [ [ name = IDENT; "="; data = STRING -> (name, (!@loc, data)) ] ]
   ;
 END
 
 (* Errors *)
 
-let error_expect_two_arguments loc =
-  user_err_loc (loc,"",str "wrong number of arguments (expect two).")
-
-let error_expect_one_argument loc =
-  user_err_loc (loc,"",str "wrong number of arguments (expect one).")
-
-let error_expect_no_argument loc =
-  user_err_loc (loc,"",str "wrong number of arguments (expect none).")
+let error_bad_arity loc n =
+  let s = match n with 0 -> "none" | 1 -> "one" | 2 -> "two" | _ -> "many" in
+  user_err_loc (loc,"",str ("wrong number of arguments (expect "^s^")."))
 
 (* Interpreting attributes *)
 
@@ -70,33 +67,49 @@ let nmtoken (loc,a) =
   with Failure _ -> user_err_loc (loc,"",str "nmtoken expected.")
 
 let get_xml_attr s al =
-  try List.assoc s al
+  try String.List.assoc s al
   with Not_found -> error ("No attribute "^s)
 
 (* Interpreting specific attributes *)
 
-let ident_of_cdata (loc,a) = id_of_string a
+let ident_of_cdata (loc,a) = Id.of_string a
 
 let uri_of_data s =
-  let n = String.index s ':' in
-  let p = String.index s '.' in
-  let s = String.sub s (n+2) (p-n-2) in
-  for i=0 to String.length s - 1 do if s.[i]='/' then s.[i]<-'.' done;
-  qualid_of_string s
-
-let constant_of_cdata (loc,a) = Nametab.locate_constant (uri_of_data a)
-
-let global_of_cdata (loc,a) = Nametab.locate (uri_of_data a)
+  try
+    let n = String.index s ':' in
+    let p = String.index s '.' in
+    let s = String.sub s (n+2) (p-n-2) in
+    for i = 0 to String.length s - 1 do
+      match s.[i] with
+      | '/' -> s.[i] <- '.'
+      | _ -> ()
+    done;
+    qualid_of_string s
+  with Not_found | Invalid_argument _ ->
+    error ("Malformed URI \""^s^"\"")
+
+let constant_of_cdata (loc,a) =
+  let q = uri_of_data a in
+  try Nametab.locate_constant q
+  with Not_found -> error ("No such constant "^string_of_qualid q)
+
+let global_of_cdata (loc,a) =
+  let q = uri_of_data a in
+  try Nametab.locate q
+  with Not_found -> error ("No such global "^string_of_qualid q)
 
 let inductive_of_cdata a = match global_of_cdata a with
-    | IndRef (kn,_) -> kn
-    | _ -> anomaly "XML parser: not an inductive"
+  | IndRef (kn,_) -> kn
+  | _ -> error (string_of_qualid (uri_of_data (snd a)) ^" is not an inductive")
 
-let ltacref_of_cdata (loc,a) = (loc,locate_tactic (uri_of_data a))
+let ltacref_of_cdata (loc,a) =
+  let q = uri_of_data a in
+  try (loc,Nametab.locate_tactic q)
+  with Not_found -> error ("No such ltac "^string_of_qualid q)
 
 let sort_of_cdata (loc,a) = match a with
-  | "Prop" -> GProp Null
-  | "Set" -> GProp Pos
+  | "Prop" -> GProp
+  | "Set" -> GSet
   | "Type" -> GType None
   | _ -> user_err_loc (loc,"",str "sort expected.")
 
@@ -105,7 +118,7 @@ let get_xml_sort al = sort_of_cdata (get_xml_attr "value" al)
 let get_xml_inductive_kn al =
   inductive_of_cdata (* uriType apparent synonym of uri *)
     (try get_xml_attr "uri" al
-     with e when Errors.noncritical e -> get_xml_attr "uriType" al)
+     with UserError _ -> get_xml_attr "uriType" al)
 
 let get_xml_constant al = constant_of_cdata (get_xml_attr "uri" al)
 
@@ -116,7 +129,7 @@ let get_xml_constructor al =
   (get_xml_inductive al, nmtoken (get_xml_attr "noConstr" al))
 
 let get_xml_binder al =
-  try Name (ident_of_cdata (List.assoc "binder" al))
+  try Name (ident_of_cdata (String.List.assoc "binder" al))
   with Not_found -> Anonymous
 
 let get_xml_ident al = ident_of_cdata (get_xml_attr "binder" al)
@@ -125,7 +138,7 @@ let get_xml_name al = ident_of_cdata (get_xml_attr "name" al)
 
 let get_xml_noFun al = nmtoken (get_xml_attr "noFun" al)
 
-let get_xml_no al = nmtoken (get_xml_attr "no" al)
+let get_xml_no al = Evar.unsafe_of_int (nmtoken (get_xml_attr "no" al))
 
 (* A leak in the xml dtd: arities of constructor need to know global env *)
 
@@ -133,8 +146,8 @@ let compute_branches_lengths ind =
   let (_,mip) = Inductive.lookup_mind_specif (Global.env()) ind in
   mip.Declarations.mind_consnrealdecls
 
-let compute_inductive_nargs ind =
-  Inductiveops.inductive_nargs (Global.env()) ind
+let compute_inductive_ndecls ind =
+  Inductiveops.inductive_nrealdecls ind
 
 (* Interpreting constr as a glob_constr *)
 
@@ -144,17 +157,17 @@ let rec interp_xml_constr = function
   | XmlTag (loc,"VAR",al,[]) ->
       error "XML parser: unable to interp free variables"
   | XmlTag (loc,"LAMBDA",al,(_::_ as xl)) ->
-      let body,decls = list_sep_last xl in
+      let body,decls = List.sep_last xl in
       let ctx = List.map interp_xml_decl decls in
       List.fold_right (fun (na,t) b -> GLambda (loc, na, Explicit, t, b))
 	ctx (interp_xml_target body)
   | XmlTag (loc,"PROD",al,(_::_ as xl)) ->
-      let body,decls = list_sep_last xl in
+      let body,decls = List.sep_last xl in
       let ctx = List.map interp_xml_decl decls in
       List.fold_right (fun (na,t) b -> GProd (loc, na, Explicit, t, b))
 	ctx (interp_xml_target body)
   | XmlTag (loc,"LETIN",al,(_::_ as xl)) ->
-      let body,defs = list_sep_last xl in
+      let body,defs = List.sep_last xl in
       let ctx = List.map interp_xml_def defs in
       List.fold_right (fun (na,t) b -> GLetIn (loc, na, t, b))
         ctx (interp_xml_target body)
@@ -164,48 +177,48 @@ let rec interp_xml_constr = function
       (XmlTag (_,("CONST"|"MUTIND"|"MUTCONSTRUCT"),_,_) as x)::xl) ->
       GApp (loc, interp_xml_constr x, List.map interp_xml_arg xl)
   | XmlTag (loc,"META",al,xl) ->
-      GEvar (loc, get_xml_no al, Some (List.map interp_xml_substitution xl))
+      GEvar (loc, get_xml_name al, Some (List.map interp_xml_substitution xl))
   | XmlTag (loc,"CONST",al,[]) ->
-      GRef (loc, ConstRef (get_xml_constant al))
+      GRef (loc, ConstRef (get_xml_constant al), None)
   | XmlTag (loc,"MUTCASE",al,x::y::yl) ->
       let ind = get_xml_inductive al in
       let p = interp_xml_patternsType x in
       let tm = interp_xml_inductiveTerm y in
       let vars = compute_branches_lengths ind in
-      let brs = list_map_i (fun i c -> (i,vars.(i),interp_xml_pattern c)) 0 yl
+      let brs = List.map_i (fun i c -> (i,vars.(i),interp_xml_pattern c)) 0 yl
       in
       let mat = simple_cases_matrix_of_branches ind brs in
-      let nparams,n = compute_inductive_nargs ind in
-      let nal,rtn = return_type_of_predicate ind nparams n p in
+      let n = compute_inductive_ndecls ind in
+      let nal,rtn = return_type_of_predicate ind n p in
       GCases (loc,RegularStyle,rtn,[tm,nal],mat)
   | XmlTag (loc,"MUTIND",al,[]) ->
-      GRef (loc, IndRef (get_xml_inductive al))
+      GRef (loc, IndRef (get_xml_inductive al), None)
   | XmlTag (loc,"MUTCONSTRUCT",al,[]) ->
-      GRef (loc, ConstructRef (get_xml_constructor al))
+      GRef (loc, ConstructRef (get_xml_constructor al), None)
   | XmlTag (loc,"FIX",al,xl) ->
       let li,lnct = List.split (List.map interp_xml_FixFunction xl) in
-      let ln,lc,lt = list_split3 lnct in
+      let ln,lc,lt = List.split3 lnct in
       let lctx = List.map (fun _ -> []) ln in
       GRec (loc, GFix (Array.of_list li, get_xml_noFun al), Array.of_list ln, Array.of_list lctx, Array.of_list lc, Array.of_list lt)
   | XmlTag (loc,"COFIX",al,xl) ->
-      let ln,lc,lt = list_split3 (List.map interp_xml_CoFixFunction xl) in
+      let ln,lc,lt = List.split3 (List.map interp_xml_CoFixFunction xl) in
       GRec (loc, GCoFix (get_xml_noFun al), Array.of_list ln, [||], Array.of_list lc, Array.of_list lt)
   | XmlTag (loc,"CAST",al,[x1;x2]) ->
-      GCast (loc, interp_xml_term x1, CastConv (DEFAULTcast, interp_xml_type x2))
+      GCast (loc, interp_xml_term x1, CastConv (interp_xml_type x2))
   | XmlTag (loc,"SORT",al,[]) ->
       GSort (loc, get_xml_sort al)
   | XmlTag (loc,s,_,_) ->
       user_err_loc (loc,"", str "Unexpected tag " ++ str s ++ str ".")
 
 and interp_xml_tag s = function
-  | XmlTag (loc,tag,al,xl) when tag=s -> (loc,al,xl)
+  | XmlTag (loc,tag,al,xl) when String.equal tag s -> (loc,al,xl)
   | XmlTag (loc,tag,_,_) -> user_err_loc (loc, "",
     str "Expect tag " ++ str s ++ str " but find " ++ str s ++ str ".")
 
 and interp_xml_constr_alias s x =
   match interp_xml_tag s x with
     | (_,_,[x]) -> interp_xml_constr x
-    | (loc,_,_) -> error_expect_one_argument loc
+    | (loc,_,_) -> error_bad_arity loc 1
 
 and interp_xml_term x = interp_xml_constr_alias "term" x
 and interp_xml_type x = interp_xml_constr_alias "type" x
@@ -215,13 +228,16 @@ and interp_xml_pattern x = interp_xml_constr_alias "pattern" x
 and interp_xml_patternsType x = interp_xml_constr_alias "patternsType" x
 and interp_xml_inductiveTerm x = interp_xml_constr_alias "inductiveTerm" x
 and interp_xml_arg x = interp_xml_constr_alias "arg" x
-and interp_xml_substitution x = interp_xml_constr_alias "substitution" x
+and interp_xml_substitution x =
+  match interp_xml_tag "substitution" x with
+    _, al, [x] -> get_xml_name al, interp_xml_constr x
+  | loc, _, _ -> error_bad_arity loc 1
                      (* no support for empty substitution from official dtd *)
 
 and interp_xml_decl_alias s x =
   match interp_xml_tag s x with
     | (_,al,[x]) -> (get_xml_binder al, interp_xml_constr x)
-    | (loc,_,_) -> error_expect_one_argument loc
+    | (loc,_,_) -> error_bad_arity loc 1
 
 and interp_xml_def x = interp_xml_decl_alias "def" x
 and interp_xml_decl x = interp_xml_decl_alias "decl" x
@@ -229,20 +245,14 @@ and interp_xml_decl x = interp_xml_decl_alias "decl" x
 and interp_xml_recursionOrder x =
   let (loc, al, l) = interp_xml_tag "RecursionOrder" x in
   let (locs, s) = get_xml_attr "type" al in
-    match s with
-	"Structural" ->
-	  (match l with [] -> GStructRec
-	     | _ -> error_expect_no_argument loc)
-      | "WellFounded" ->
-	  (match l with
-	       [c] -> GWfRec (interp_xml_type c)
-	     | _ -> error_expect_one_argument loc)
-      | "Measure" ->
-	  (match l with
-	       [m;r] -> GMeasureRec (interp_xml_type m, Some (interp_xml_type r))
-	     | _ -> error_expect_two_arguments loc)
-      | _ ->
-          user_err_loc (locs,"",str "Invalid recursion order.")
+  match s, l with
+  | "Structural", [] -> GStructRec
+  | "Structural", _ -> error_bad_arity loc 0
+  | "WellFounded", [c] -> GWfRec (interp_xml_type c)
+  | "WellFounded", _ -> error_bad_arity loc 1
+  | "Measure", [m;r] -> GMeasureRec (interp_xml_type m, Some (interp_xml_type r))
+  | "Measure", _ -> error_bad_arity loc 2
+  | _ -> user_err_loc (locs,"",str "Invalid recursion order.")
 
 and interp_xml_FixFunction x =
   match interp_xml_tag "FixFunction" x with
@@ -254,14 +264,14 @@ and interp_xml_FixFunction x =
       ((Some (nmtoken (get_xml_attr "recIndex" al)), GStructRec),
        (get_xml_name al, interp_xml_type x1, interp_xml_body x2))
   | (loc,_,_) ->
-      error_expect_one_argument loc
+      error_bad_arity loc 1
 
 and interp_xml_CoFixFunction x =
   match interp_xml_tag "CoFixFunction" x with
   | (loc,al,[x1;x2]) ->
       (get_xml_name al, interp_xml_type x1, interp_xml_body x2)
     | (loc,_,_) ->
-	error_expect_one_argument loc
+	error_bad_arity loc 1
 
 (* Interpreting tactic argument *)
 
diff --git a/parsing/grammar.mllib b/parsing/grammar.mllib
deleted file mode 100644
index ba393e63..00000000
--- a/parsing/grammar.mllib
+++ /dev/null
@@ -1,88 +0,0 @@
-Coq_config
-
-Profile
-Pp_control
-Pp
-Compat
-Flags
-Segmenttree
-Unicodetable
-Util
-Errors
-Bigint
-Dyn
-Hashcons
-Predicate
-Rtree
-Option
-Store
-Hashtbl_alt
-
-Names
-Univ
-Esubst
-Term
-Mod_subst
-Sign
-Cbytecodes
-Copcodes
-Cemitcodes
-Declarations
-Retroknowledge
-Pre_env
-Cbytegen
-Environ
-Conv_oracle
-Closure
-Reduction
-Type_errors
-Entries
-Modops
-Inductive
-Typeops
-Indtypes
-Cooking
-Term_typing
-Subtyping
-Mod_typing
-Safe_typing
-
-Nameops
-Libnames
-Summary
-Nametab
-Libobject
-Lib
-Goptions
-Decl_kinds
-Global
-Termops
-Namegen
-Evd
-Reductionops
-Inductiveops
-Glob_term
-Detyping
-Pattern
-Topconstr
-Genarg
-Ppextend
-Tacexpr
-Tok
-Lexer
-Extend
-Vernacexpr
-Extrawit
-Pcoq
-Q_util
-Q_coqast
-
-Egrammar
-Argextend
-Tacextend
-Vernacextend
-
-G_prim
-G_tactic
-G_ltac
-G_constr
diff --git a/parsing/highparsing.mllib b/parsing/highparsing.mllib
index eed6caea..13ed8046 100644
--- a/parsing/highparsing.mllib
+++ b/parsing/highparsing.mllib
@@ -4,3 +4,4 @@ G_prim
 G_proofs
 G_tactic
 G_ltac
+G_obligations
diff --git a/parsing/lexer.ml4 b/parsing/lexer.ml4
index 82ae2dc8..8e839296 100644
--- a/parsing/lexer.ml4
+++ b/parsing/lexer.ml4
@@ -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        *)
@@ -14,7 +14,8 @@ open Tok
 (* Dictionaries: trees annotated with string options, each node being a map
    from chars to dictionaries (the subtrees). A trie, in other words. *)
 
-module CharMap = Map.Make (struct type t = char let compare = compare end)
+module CharOrd = struct type t = char let compare : char -> char -> int = compare end
+module CharMap = Map.Make (CharOrd)
 
 type ttree = {
   node : string option;
@@ -86,27 +87,28 @@ module Error = struct
   let to_string x =
     "Syntax Error: Lexer: " ^
       (match x with
-	 | Illegal_character -> "Illegal character"
-	 | Unterminated_comment -> "Unterminated comment"
-	 | Unterminated_string -> "Unterminated string"
-	 | Undefined_token -> "Undefined token"
-	 | Bad_token tok -> Format.sprintf "Bad token %S" tok
-	 | UnsupportedUnicode x ->
-	     Printf.sprintf "Unsupported Unicode character (0x%x)" x)
+         | Illegal_character -> "Illegal character"
+         | Unterminated_comment -> "Unterminated comment"
+         | Unterminated_string -> "Unterminated string"
+         | Undefined_token -> "Undefined token"
+         | Bad_token tok -> Format.sprintf "Bad token %S" tok
+         | UnsupportedUnicode x ->
+             Printf.sprintf "Unsupported Unicode character (0x%x)" x)
 
-  let print ppf x = Format.fprintf ppf "%s@." (to_string x)
+  (* Require to fix the Camlp4 signature *)
+  let print ppf x = Pp.pp_with ppf (Pp.str (to_string x))
 
 end
 open Error
 
-let err loc str = Loc.raise (make_loc loc) (Error.E str)
+let err loc str = Loc.raise (Loc.make_loc loc) (Error.E str)
 
 let bad_token str = raise (Error.E (Bad_token str))
 
 (* Lexer conventions on tokens *)
 
 type token_kind =
-  | Utf8Token of (utf8_status * int)
+  | Utf8Token of (Unicode.status * int)
   | AsciiChar
   | EmptyStream
 
@@ -130,38 +132,38 @@ let utf8_char_size cs = function
 let njunk n = Util.repeat n Stream.junk
 
 let check_utf8_trailing_byte cs c =
-  if Char.code c land 0xC0 <> 0x80 then error_utf8 cs
+  if not (Int.equal (Char.code c land 0xC0) 0x80) then error_utf8 cs
 
 (* Recognize utf8 blocks (of length less than 4 bytes) *)
 (* but don't certify full utf8 compliance (e.g. no emptyness check) *)
 let lookup_utf8_tail c cs =
   let c1 = Char.code c in
-  if c1 land 0x40 = 0 or c1 land 0x38 = 0x38 then error_utf8 cs
+  if Int.equal (c1 land 0x40) 0 || Int.equal (c1 land 0x38) 0x38 then error_utf8 cs
   else
     let n, unicode =
-      if c1 land 0x20 = 0 then
+      if Int.equal (c1 land 0x20) 0 then
       match Stream.npeek 2 cs with
       | [_;c2] ->
-	  check_utf8_trailing_byte cs c2;
-	  2, (c1 land 0x1F) lsl 6 + (Char.code c2 land 0x3F)
+          check_utf8_trailing_byte cs c2;
+          2, (c1 land 0x1F) lsl 6 + (Char.code c2 land 0x3F)
       | _ -> error_utf8 cs
-      else if c1 land 0x10 = 0 then
+      else if Int.equal (c1 land 0x10) 0 then
       match Stream.npeek 3 cs with
       | [_;c2;c3] ->
-	  check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
-	  3, (c1 land 0x0F) lsl 12 + (Char.code c2 land 0x3F) lsl 6 +
-	  (Char.code c3 land 0x3F)
+          check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
+          3, (c1 land 0x0F) lsl 12 + (Char.code c2 land 0x3F) lsl 6 +
+          (Char.code c3 land 0x3F)
       | _ -> error_utf8 cs
       else match Stream.npeek 4 cs with
       | [_;c2;c3;c4] ->
-	  check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
-	  check_utf8_trailing_byte cs c4;
-	  4, (c1 land 0x07) lsl 18 + (Char.code c2 land 0x3F) lsl 12 +
-	  (Char.code c3 land 0x3F) lsl 6 + (Char.code c4 land 0x3F)
+          check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
+          check_utf8_trailing_byte cs c4;
+          4, (c1 land 0x07) lsl 18 + (Char.code c2 land 0x3F) lsl 12 +
+          (Char.code c3 land 0x3F) lsl 6 + (Char.code c4 land 0x3F)
       | _ -> error_utf8 cs
     in
-    try classify_unicode unicode, n
-    with UnsupportedUtf8 ->
+    try Unicode.classify unicode, n
+    with Unicode.Unsupported ->
       njunk n cs; error_unsupported_unicode_character n unicode cs
 
 let lookup_utf8 cs =
@@ -170,17 +172,18 @@ let lookup_utf8 cs =
     | Some ('\x80'..'\xFF' as c) -> Utf8Token (lookup_utf8_tail c cs)
     | None -> EmptyStream
 
-let unlocated f x =
-  try f x with Loc.Exc_located (_,exc) -> raise exc
+let unlocated f x = f x
+  (** FIXME: should we still unloc the exception? *)
+(*   try f x with Loc.Exc_located (_, exc) -> raise exc *)
 
 let check_keyword str =
   let rec loop_symb = parser
     | [< ' (' ' | '\n' | '\r' | '\t' | '"') >] -> bad_token str
     | [< s >] ->
-	match unlocated lookup_utf8 s with
-	| Utf8Token (_,n) -> njunk n s; loop_symb s
-	| AsciiChar -> Stream.junk s; loop_symb s
-	| EmptyStream -> ()
+        match unlocated lookup_utf8 s with
+        | Utf8Token (_,n) -> njunk n s; loop_symb s
+        | AsciiChar -> Stream.junk s; loop_symb s
+        | EmptyStream -> ()
   in
   loop_symb (Stream.of_string str)
 
@@ -188,7 +191,8 @@ let check_keyword_to_add s =
   try check_keyword s
   with Error.E (UnsupportedUnicode unicode) ->
     Flags.if_verbose msg_warning
-      (strbrk (Printf.sprintf "Token '%s' contains unicode character 0x%x which will not be parsable." s unicode))
+      (strbrk (Printf.sprintf "Token '%s' contains unicode character 0x%x \
+                               which will not be parsable." s unicode))
 
 let check_ident str =
   let rec loop_id intail = parser
@@ -197,11 +201,13 @@ let check_ident str =
     | [< ' ('0'..'9' | ''') when intail; s >] ->
         loop_id true s
     | [< s >] ->
-	match unlocated lookup_utf8 s with
-	| Utf8Token (UnicodeLetter, n) -> njunk n s; loop_id true s
-	| Utf8Token (UnicodeIdentPart, n) when intail -> njunk n s; loop_id true s
-	| EmptyStream -> ()
-	| Utf8Token _ | AsciiChar -> bad_token str
+        match unlocated lookup_utf8 s with
+        | Utf8Token (Unicode.Letter, n) -> njunk n s; loop_id true s
+        | Utf8Token (Unicode.IdentPart, n) when intail ->
+          njunk n s;
+          loop_id true s
+        | EmptyStream -> ()
+        | Utf8Token _ | AsciiChar -> bad_token str
   in
   loop_id false (Stream.of_string str)
 
@@ -229,14 +235,7 @@ let remove_keyword str =
 type frozen_t = ttree
 
 let freeze () = !token_tree
-
-let unfreeze tt =
-  token_tree := tt
-
-let init () =
-  unfreeze empty_ttree
-
-let _ = init()
+let unfreeze tt = (token_tree := tt)
 
 (* The string buffering machinery *)
 
@@ -260,8 +259,8 @@ let rec ident_tail len = parser
       ident_tail (store len c) s
   | [< s >] ->
       match lookup_utf8 s with
-      | Utf8Token ((UnicodeIdentPart | UnicodeLetter), n) ->
-	  ident_tail (nstore n len s) s
+      | Utf8Token ((Unicode.IdentPart | Unicode.Letter), n) ->
+          ident_tail (nstore n len s) s
       | _ -> len
 
 let rec number len = parser
@@ -274,28 +273,36 @@ let rec string in_comments bp len = parser
   | [< ''('; s >] ->
       (parser
         | [< ''*'; s >] ->
-            string (Option.map succ in_comments) bp (store (store len '(') '*') s
+            string
+              (Option.map succ in_comments)
+              bp (store (store len '(') '*')
+              s
         | [< >] ->
-	    string in_comments bp (store len '(') s) s
+            string in_comments bp (store len '(') s) s
   | [< ''*'; s >] ->
       (parser
         | [< '')'; s >] ->
-            if in_comments = Some 0 then
-	      msg_warning (str "Not interpreting \"*)\" as the end of current non-terminated comment because it occurs in a non-terminated string of the comment.");
+            let () = match in_comments with
+            | Some 0 ->
+                msg_warning
+                  (strbrk
+                     "Not interpreting \"*)\" as the end of current \
+                      non-terminated comment because it occurs in a \
+                      non-terminated string of the comment.")
+            | _ -> ()
+            in
             let in_comments = Option.map pred in_comments in
- 	    string in_comments bp (store (store len '*') ')') s
+            string in_comments bp (store (store len '*') ')') s
         | [< >] ->
-	    string in_comments bp (store len '*') s) s
+            string in_comments bp (store len '*') s) s
   | [< 'c; s >] -> string in_comments bp (store len c) s
   | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
 
-(* Hook for exporting comment into xml theory files *)
-let xml_output_comment = ref (fun _ -> ())
-let set_xml_output_comment f = xml_output_comment := f
-
 (* Utilities for comments in beautify *)
 let comment_begin = ref None
-let comm_loc bp = if !comment_begin=None then comment_begin := Some bp
+let comm_loc bp = match !comment_begin with
+| None -> comment_begin := Some bp
+| _ -> ()
 
 let current = Buffer.create 8192
 let between_com = ref true
@@ -318,9 +325,9 @@ let push_char c =
   if
     !between_com || List.mem c ['\n';'\r'] ||
     (List.mem c [' ';'\t']&&
-     (Buffer.length current = 0 ||
+     (Int.equal (Buffer.length current) 0 ||
       not (let s = Buffer.contents current in
-	   List.mem s.[String.length s - 1] [' ';'\t';'\n';'\r'])))
+           List.mem s.[String.length s - 1] [' ';'\t';'\n';'\r'])))
   then
     real_push_char c
 
@@ -333,15 +340,14 @@ let null_comment s =
 
 let comment_stop ep =
   let current_s = Buffer.contents current in
-  if !Flags.xml_export && Buffer.length current > 0 &&
-    (!between_com || not(null_comment current_s)) then
-      !xml_output_comment current_s;
   (if Flags.do_beautify() && Buffer.length current > 0 &&
     (!between_com || not(null_comment current_s)) then
     let bp = match !comment_begin with
         Some bp -> bp
       | None ->
-          msgerrnl(str"No begin location for comment '"++str current_s ++str"' ending at  "++int ep);
+          msgerrnl(str "No begin location for comment '"
+                   ++ str current_s ++str"' ending at  "
+                   ++ int ep);
           ep-1 in
     Pp.comments := ((bp,ep),current_s) :: !Pp.comments);
   Buffer.clear current;
@@ -353,8 +359,11 @@ let rec comm_string bp = parser
   | [< ''"' >] -> push_string "\""
   | [< ''\\'; _ =
            (parser [< ' ('"' | '\\' as c) >] ->
-             if c='"' then real_push_char c;
-             real_push_char c
+              let () = match c with
+              | '"' -> real_push_char c
+              | _ -> ()
+              in
+              real_push_char c
                  | [< >] -> real_push_char '\\'); s >]
      -> comm_string bp s
   | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
@@ -388,26 +397,26 @@ let rec progress_further last nj tt cs =
 and update_longest_valid_token last nj tt cs =
   match tt.node with
   | Some _ as last' ->
-      for i=1 to nj do Stream.junk cs done;
-      progress_further last' 0 tt cs
+    stream_njunk nj cs;
+    progress_further last' 0 tt cs
   | None ->
-      progress_further last nj tt cs
+    progress_further last nj tt cs
 
 (* nj is the number of char peeked since last valid token *)
 (* n the number of char in utf8 block *)
 and progress_utf8 last nj n c tt cs =
   try
     let tt = CharMap.find c tt.branch in
-    if n=1 then
+    if Int.equal n 1 then
       update_longest_valid_token last (nj+n) tt cs
     else
-      match Util.list_skipn (nj+1) (Stream.npeek (nj+n) cs) with
-      | l when List.length l = n-1 ->
-	 List.iter (check_utf8_trailing_byte cs) l;
-	 let tt = List.fold_left (fun tt c -> CharMap.find c tt.branch) tt l in
-	 update_longest_valid_token last (nj+n) tt cs
+      match Util.List.skipn (nj+1) (Stream.npeek (nj+n) cs) with
+      | l when Int.equal (List.length l) (n - 1) ->
+         List.iter (check_utf8_trailing_byte cs) l;
+         let tt = List.fold_left (fun tt c -> CharMap.find c tt.branch) tt l in
+         update_longest_valid_token last (nj+n) tt cs
       | _ ->
-	  error_utf8 cs
+          error_utf8 cs
   with Not_found ->
     last
 
@@ -420,6 +429,14 @@ let find_keyword id s =
   | None -> raise Not_found
   | Some c -> KEYWORD c
 
+let process_sequence bp c cs =
+  let rec aux n cs =
+    match Stream.peek cs with
+    | Some c' when c == c' -> Stream.junk cs; aux (n+1) cs
+    | _ -> BULLET (String.make n c), (bp, Stream.count cs)
+  in
+  aux 1 cs
+
 (* Must be a special token *)
 let process_chars bp c cs =
   let t = progress_from_byte None (-1) !token_tree cs c in
@@ -427,9 +444,9 @@ let process_chars bp c cs =
   match t with
     | Some t -> (KEYWORD t, (bp, ep))
     | None ->
-	let ep' = bp + utf8_char_size cs c in
-	njunk (ep' - ep) cs;
-	err (bp, ep') Undefined_token
+        let ep' = bp + utf8_char_size cs c in
+        njunk (ep' - ep) cs;
+        err (bp, ep') Undefined_token
 
 let token_of_special c s = match c with
   | '$' -> METAIDENT s
@@ -444,8 +461,8 @@ let parse_after_special c bp =
       token_of_special c (get_buff len)
   | [< s >] ->
       match lookup_utf8 s with
-      | Utf8Token (UnicodeLetter, n) ->
-	  token_of_special c (get_buff (ident_tail (nstore n 0 s) s))
+      | Utf8Token (Unicode.Letter, n) ->
+          token_of_special c (get_buff (ident_tail (nstore n 0 s) s))
       | AsciiChar | Utf8Token _ | EmptyStream -> fst (process_chars bp c s)
 
 (* Parse what follows a question mark *)
@@ -455,9 +472,10 @@ let parse_after_qmark bp s =
     | Some ('a'..'z' | 'A'..'Z' | '_') -> LEFTQMARK
     | None -> KEYWORD "?"
     | _ ->
-	match lookup_utf8 s with
-	  | Utf8Token (UnicodeLetter, _) -> LEFTQMARK
-	  | AsciiChar | Utf8Token _ | EmptyStream -> fst (process_chars bp '?' s)
+        match lookup_utf8 s with
+          | Utf8Token (Unicode.Letter, _) -> LEFTQMARK
+          | AsciiChar | Utf8Token _ | EmptyStream ->
+            fst (process_chars bp '?' s)
 
 let blank_or_eof cs =
   match Stream.peek cs with
@@ -476,11 +494,19 @@ let rec next_token = parser bp
       comment_stop bp;
       (* We enforce that "." should either be part of a larger keyword,
          for instance ".(", or followed by a blank or eof. *)
-      if t = KEYWORD "." then begin
-	if not (blank_or_eof s) then err (bp,ep+1) Undefined_token;
-	if Flags.do_beautify() then between_com := true;
-      end;
+      let () = match t with
+      | KEYWORD ("." | "...") ->
+        if not (blank_or_eof s) then err (bp,ep+1) Undefined_token;
+        between_com := true;
+      | _ -> ()
+      in
       (t, (bp,ep))
+  | [< ' ('-'|'+'|'*' as c); s >] ->
+      let t,new_between_com =
+        if !between_com then process_sequence bp c s,true
+        else process_chars bp c s,false
+      in
+      comment_stop bp; between_com := new_between_com; t
   | [< ''?'; s >] ep ->
       let t = parse_after_qmark bp s in comment_stop bp; (t, (ep, bp))
   | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
@@ -499,23 +525,25 @@ let rec next_token = parser bp
         | [< ''*'; s >] ->
             comm_loc bp;
             push_string "(*";
-	    comment bp s;
-	    next_token s
+            comment bp s;
+            next_token s
         | [< t = process_chars bp c >] -> comment_stop bp; t >] ->
       t
   | [< s >] ->
       match lookup_utf8 s with
-	| Utf8Token (UnicodeLetter, n) ->
-	    let len = ident_tail (nstore n 0 s) s in
-	    let id = get_buff len in
-	    let ep = Stream.count s in
-	    comment_stop bp;
-	    (try find_keyword id s with Not_found -> IDENT id), (bp, ep)
-	| AsciiChar | Utf8Token ((UnicodeSymbol | UnicodeIdentPart), _) ->
-	    let t = process_chars bp (Stream.next s) s in
-	    comment_stop bp; t
-	| EmptyStream ->
-	    comment_stop bp; (EOI, (bp, bp + 1))
+        | Utf8Token (Unicode.Letter, n) ->
+            let len = ident_tail (nstore n 0 s) s in
+            let id = get_buff len in
+            let ep = Stream.count s in
+            comment_stop bp;
+            (try find_keyword id s with Not_found -> IDENT id), (bp, ep)
+        | AsciiChar | Utf8Token ((Unicode.Symbol | Unicode.IdentPart), _) ->
+            let t = process_chars bp (Stream.next s) s in
+            let new_between_com = match t with
+              (KEYWORD ("{"|"}"),_) -> !between_com | _ -> false in
+            comment_stop bp; between_com := new_between_com; t
+        | EmptyStream ->
+            comment_stop bp; (EOI, (bp, bp + 1))
 
 (* (* Debug: uncomment this for tracing tokens seen by coq...*)
 let next_token s =
@@ -537,10 +565,9 @@ let loct_add loct i loc = Hashtbl.add loct i loc
 
 let current_location_table = ref (loct_create ())
 
-type location_table = (int, loc) Hashtbl.t
+type location_table = (int, CompatLoc.t) Hashtbl.t
 let location_table () = !current_location_table
 let restore_location_table t = current_location_table := t
-let location_function n = loct_func !current_location_table n
 
 (** {6 The lexer of Coq} *)
 
@@ -575,7 +602,7 @@ let func cs =
     Stream.from
       (fun i ->
          let (tok, loc) = next_token cs in
-	 loct_add loct i (make_loc loc); Some tok)
+         loct_add loct i (make_loc loc); Some tok)
   in
   current_location_table := loct;
   (ts, loct_func loct)
@@ -595,10 +622,10 @@ ELSE (* official camlp4 for ocaml >= 3.10 *)
 
 module M_ = Camlp4.ErrorHandler.Register (Error)
 
-module Loc = Loc
+module Loc = CompatLoc
 module Token = struct
   include Tok (* Cf. tok.ml *)
-  module Loc = Loc
+  module Loc = CompatLoc
   module Error = Camlp4.Struct.EmptyError
   module Filter = struct
     type token_filter = (Tok.t * Loc.t) Stream.t -> (Tok.t * Loc.t) Stream.t
@@ -631,14 +658,14 @@ let is_ident_not_keyword s =
 
 let is_number s =
   let rec aux i =
-    String.length s = i or
+    Int.equal (String.length s) i ||
     match s.[i] with '0'..'9' -> aux (i+1) | _ -> false
   in aux 0
 
 let strip s =
   let len =
     let rec loop i len =
-      if i = String.length s then len
+      if Int.equal i (String.length s) then len
       else if s.[i] == ' ' then loop (i + 1) len
       else loop (i + 1) (len + 1)
     in
@@ -656,7 +683,7 @@ let strip s =
 
 let terminal s =
   let s = strip s in
-  if s = "" then Util.error "empty token.";
+  let () = match s with "" -> Errors.error "empty token." | _ -> () in
   if is_ident_not_keyword s then IDENT s
   else if is_number s then INT s
   else KEYWORD s
diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index cb6b694c..2b9bd37d 100644
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -1,19 +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
-
 val add_keyword : string -> unit
 val remove_keyword : string -> unit
 val is_keyword : string -> bool
 
-val location_function : int -> loc
+(* val location_function : int -> Loc.t *)
 
 (** for coqdoc *)
 type location_table
@@ -27,14 +24,11 @@ val check_keyword : string -> unit
 type frozen_t
 val freeze : unit -> frozen_t
 val unfreeze : frozen_t -> unit
-val init : unit -> unit
 
 type com_state
 val com_state: unit -> com_state
 val restore_com_state: com_state -> unit
 
-val set_xml_output_comment : (string -> unit) -> unit
-
 val terminal : string -> Tok.t
 
 (** The lexer of Coq: *)
diff --git a/parsing/parsing.mllib b/parsing/parsing.mllib
index 84a08d54..a0cb8319 100644
--- a/parsing/parsing.mllib
+++ b/parsing/parsing.mllib
@@ -1,11 +1,6 @@
-Extend
-Extrawit
+Tok
+Compat
+Lexer
 Pcoq
-Egrammar
-G_xml
-Ppconstr
-Printer
-Pptactic
-Tactic_printer
-Printmod
-Prettyp
+Egramml
+Egramcoq
diff --git a/parsing/pcoq.ml4 b/parsing/pcoq.ml4
index 7949a77d..cf6435fe 100644
--- a/parsing/pcoq.ml4
+++ b/parsing/pcoq.ml4
@@ -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,17 +8,13 @@
 
 open Pp
 open Compat
-open Tok
+open Errors
 open Util
-open Names
 open Extend
-open Libnames
-open Glob_term
-open Topconstr
 open Genarg
-open Tacexpr
-open Extrawit
-open Ppextend
+open Stdarg
+open Constrarg
+open Tok (* necessary for camlp4 *)
 
 (** The parser of Coq *)
 
@@ -32,6 +28,7 @@ let warning_verbose = ref true
 IFDEF CAMLP5 THEN
 open Gramext
 ELSE
+open PcamlSig.Grammar
 open G
 END
 
@@ -82,7 +79,7 @@ type prod_entry_key =
   | Aself
   | Anext
   | Atactic of int
-  | Agram of G.internal_entry
+  | Agram of string
   | Aentry of string * string
 
 (** [grammar_object] is the superclass of all grammar entries *)
@@ -111,7 +108,6 @@ let weaken_entry x = Gramobj.weaken_entry x
 
 module type Gramtypes =
 sig
-  open Decl_kinds
   val inGramObj : 'a raw_abstract_argument_type -> 'a G.entry -> typed_entry
   val outGramObj : 'a raw_abstract_argument_type -> typed_entry -> 'a G.entry
 end
@@ -120,8 +116,8 @@ module Gramtypes : Gramtypes =
 struct
   let inGramObj rawwit = in_typed_entry (unquote rawwit)
   let outGramObj (a:'a raw_abstract_argument_type) o =
-    if type_of_typed_entry o <> unquote a
-      then anomaly "outGramObj: wrong type";
+    if not (argument_type_eq (type_of_typed_entry o) (unquote a))
+      then anomaly ~label:"outGramObj" (str "wrong type");
     (* downcast from grammar_object *)
     Obj.magic (object_of_typed_entry o)
 end
@@ -139,10 +135,13 @@ open Gramtypes
     In [single_extend_statement], first two parameters are name and
     assoc iff a level is created *)
 
+(** Type of reinitialization data *)
+type gram_reinit = gram_assoc * gram_position
+
 type ext_kind =
   | ByGrammar of
       grammar_object G.entry
-      * gram_assoc option (** for reinitialization if ever needed *)
+      * gram_reinit option (** for reinitialization if ever needed *)
       * G.extend_statment
   | ByEXTEND of (unit -> unit) * (unit -> unit)
 
@@ -150,28 +149,18 @@ type ext_kind =
 
 let camlp4_state = ref []
 
-(** Deletion
-
-   Caveat: deletion is not the converse of extension: when an
-   empty level is extended, deletion removes the level instead
-   of keeping it empty. This has an effect on the empty levels 8,
-   99 and 200. We didn't find a good solution to this problem
-   (e.g. using G.extend to know if the level exists results in a
-   printed error message as side effect). As a consequence an
-   extension at 99 or 8 (and for pattern 200 too) inside a section
-   corrupts the parser. *)
+(** Deletion *)
 
 let grammar_delete e reinit (pos,rls) =
   List.iter
     (fun (n,ass,lev) ->
       List.iter (fun (pil,_) -> G.delete_rule e pil) (List.rev lev))
     (List.rev rls);
-  if reinit <> None then
+  match reinit with
+  | Some (a,ext) ->
     let lev = match pos with Some (Level n) -> n | _ -> assert false in
-    let pos =
-      if lev = "200" then First
-      else After (string_of_int (int_of_string lev + 1)) in
-    maybe_uncurry (G.extend e) (Some pos, [Some lev,reinit,[]])
+    maybe_uncurry (G.extend e) (Some ext, [Some lev,Some a,[]])
+  | None -> ()
 
 (** The apparent parser of Coq; encapsulate G to keep track
     of the extensions. *)
@@ -213,9 +202,10 @@ let grammar_extend e reinit ext =
 let rec remove_grammars n =
   if n>0 then
     (match !camlp4_state with
-       | [] -> anomaly "Pcoq.remove_grammars: too many rules to remove"
+       | [] -> anomaly ~label:"Pcoq.remove_grammars" (Pp.str "too many rules to remove")
        | ByGrammar(g,reinit,ext)::t ->
-           grammar_delete g reinit ext;
+           let f (a,b) = (of_coq_assoc a, of_coq_position b) in
+           grammar_delete g (Option.map f reinit) ext;
            camlp4_state := t;
            remove_grammars (n-1)
        | ByEXTEND (undo,redo)::t ->
@@ -270,7 +260,7 @@ let get_univ s =
   try
     Hashtbl.find univ_tab s
   with Not_found ->
-    anomaly ("Unknown grammar universe: "^s)
+    anomaly (Pp.str ("Unknown grammar universe: "^s))
 
 let get_entry (u, utab) s = Hashtbl.find utab s
 
@@ -283,14 +273,14 @@ let new_entry etyp (u, utab) s =
 let create_entry (u, utab) s etyp =
   try
     let e = Hashtbl.find utab s in
-    if type_of_typed_entry e <> etyp then
+    if not (argument_type_eq (type_of_typed_entry e) etyp) then
       failwith ("Entry " ^ u ^ ":" ^ s ^ " already exists with another type");
     e
   with Not_found ->
     new_entry etyp (u, utab) s
 
 let create_constr_entry s =
-  outGramObj rawwit_constr (create_entry uconstr s ConstrArgType)
+  outGramObj (rawwit wit_constr) (create_entry uconstr s ConstrArgType)
 
 let create_generic_entry s wit =
   outGramObj wit (create_entry utactic s (unquote wit))
@@ -310,22 +300,22 @@ module Prim =
 
     (* Entries that can be refered via the string -> Gram.entry table *)
     (* Typically for tactic or vernac extensions *)
-    let preident = gec_gen rawwit_pre_ident "preident"
-    let ident = gec_gen rawwit_ident "ident"
-    let natural = gec_gen rawwit_int "natural"
-    let integer = gec_gen rawwit_int "integer"
+    let preident = gec_gen (rawwit wit_pre_ident) "preident"
+    let ident = gec_gen (rawwit wit_ident) "ident"
+    let natural = gec_gen (rawwit wit_int) "natural"
+    let integer = gec_gen (rawwit wit_int) "integer"
     let bigint = Gram.entry_create "Prim.bigint"
-    let string = gec_gen rawwit_string "string"
-    let reference = make_gen_entry uprim rawwit_ref "reference"
+    let string = gec_gen (rawwit wit_string) "string"
+    let reference = make_gen_entry uprim (rawwit wit_ref) "reference"
     let by_notation = Gram.entry_create "by_notation"
     let smart_global = Gram.entry_create "smart_global"
 
     (* parsed like ident but interpreted as a term *)
-    let var = gec_gen rawwit_var "var"
+    let var = gec_gen (rawwit wit_var) "var"
 
     let name = Gram.entry_create "Prim.name"
     let identref = Gram.entry_create "Prim.identref"
-    let pattern_ident = gec_gen rawwit_pattern_ident "pattern_ident"
+    let pattern_ident = Gram.entry_create "pattern_ident"
     let pattern_identref = Gram.entry_create "pattern_identref"
 
     (* A synonym of ident - maybe ident will be located one day *)
@@ -342,7 +332,7 @@ module Prim =
 
 module Constr =
   struct
-    let gec_constr = make_gen_entry uconstr rawwit_constr
+    let gec_constr = make_gen_entry uconstr (rawwit wit_constr)
 
     (* Entries that can be refered via the string -> Gram.entry table *)
     let constr = gec_constr "constr"
@@ -350,9 +340,9 @@ module Constr =
     let constr_eoi = eoi_entry constr
     let lconstr = gec_constr "lconstr"
     let binder_constr = create_constr_entry "binder_constr"
-    let ident = make_gen_entry uconstr rawwit_ident "ident"
-    let global = make_gen_entry uconstr rawwit_ref "global"
-    let sort = make_gen_entry uconstr rawwit_sort "sort"
+    let ident = make_gen_entry uconstr (rawwit wit_ident) "ident"
+    let global = make_gen_entry uconstr (rawwit wit_ref) "global"
+    let sort = make_gen_entry uconstr (rawwit wit_sort) "sort"
     let pattern = Gram.entry_create "constr:pattern"
     let constr_pattern = gec_constr "constr_pattern"
     let lconstr_pattern = gec_constr "lconstr_pattern"
@@ -380,33 +370,37 @@ module Tactic =
     (* Entries that can be refered via the string -> Gram.entry table *)
     (* Typically for tactic user extensions *)
     let open_constr =
-      make_gen_entry utactic (rawwit_open_constr_gen (false,false)) "open_constr"
-    let casted_open_constr =
-      make_gen_entry utactic (rawwit_open_constr_gen (true,false)) "casted_open_constr"
-    let open_constr_wTC =
-      make_gen_entry utactic (rawwit_open_constr_gen (false,true)) "open_constr_wTC"
+      make_gen_entry utactic (rawwit wit_open_constr) "open_constr"
     let constr_with_bindings =
-      make_gen_entry utactic rawwit_constr_with_bindings "constr_with_bindings"
+      make_gen_entry utactic (rawwit wit_constr_with_bindings) "constr_with_bindings"
     let bindings =
-      make_gen_entry utactic rawwit_bindings "bindings"
-    let constr_may_eval = make_gen_entry utactic rawwit_constr_may_eval "constr_may_eval"
+      make_gen_entry utactic (rawwit wit_bindings) "bindings"
+    let constr_may_eval = make_gen_entry utactic (rawwit wit_constr_may_eval) "constr_may_eval"
+    let uconstr =
+      make_gen_entry utactic (rawwit wit_uconstr) "uconstr"
     let quantified_hypothesis =
-      make_gen_entry utactic rawwit_quant_hyp "quantified_hypothesis"
-    let int_or_var = make_gen_entry utactic rawwit_int_or_var "int_or_var"
-    let red_expr = make_gen_entry utactic rawwit_red_expr "red_expr"
+      make_gen_entry utactic (rawwit wit_quant_hyp) "quantified_hypothesis"
+    let int_or_var = make_gen_entry utactic (rawwit wit_int_or_var) "int_or_var"
+    let red_expr = make_gen_entry utactic (rawwit wit_red_expr) "red_expr"
     let simple_intropattern =
-      make_gen_entry utactic rawwit_intro_pattern "simple_intropattern"
+      make_gen_entry utactic (rawwit wit_intro_pattern) "simple_intropattern"
+    let clause_dft_concl = 
+      make_gen_entry utactic (rawwit wit_clause_dft_concl) "clause"
+
 
     (* Main entries for ltac *)
     let tactic_arg = Gram.entry_create "tactic:tactic_arg"
     let tactic_expr = Gram.entry_create "tactic:tactic_expr"
     let binder_tactic = Gram.entry_create "tactic:binder_tactic"
 
-    let tactic = make_gen_entry utactic (rawwit_tactic tactic_main_level) "tactic"
+    let tactic = make_gen_entry utactic (rawwit wit_tactic) "tactic"
 
     (* Main entry for quotations *)
     let tactic_eoi = eoi_entry tactic
 
+    (* For Ltac definition *)
+    let tacdef_body = Gram.entry_create "tactic:tacdef_body"
+
   end
 
 module Vernac_ =
@@ -426,7 +420,7 @@ module Vernac_ =
 
     GEXTEND Gram
     main_entry:
-      [ [ a = vernac -> Some (loc,a) | EOI -> None ] ]
+      [ [ a = vernac -> Some (!@loc, a) | EOI -> None ] ]
     ;
     END
 
@@ -450,24 +444,23 @@ let main_entry = Vernac_.main_entry
 let constr_level = string_of_int
 
 let default_levels =
-  [200,RightA,false;
-   100,RightA,false;
-   99,RightA,true;
-   90,RightA,false;
-   10,RightA,false;
-   9,RightA,false;
-   8,RightA,true;
-   1,LeftA,false;
-   0,RightA,false]
+  [200,Extend.RightA,false;
+   100,Extend.RightA,false;
+   99,Extend.RightA,true;
+   10,Extend.RightA,false;
+   9,Extend.RightA,false;
+   8,Extend.RightA,true;
+   1,Extend.LeftA,false;
+   0,Extend.RightA,false]
 
 let default_pattern_levels =
-  [200,RightA,true;
-   100,RightA,false;
-   99,RightA,true;
-   10,LeftA,false;
-   9,RightA,false;
-   1,LeftA,false;
-   0,RightA,false]
+  [200,Extend.RightA,true;
+   100,Extend.RightA,false;
+   99,Extend.RightA,true;
+   10,Extend.LeftA,false;
+   9,Extend.RightA,false;
+   1,Extend.LeftA,false;
+   0,Extend.RightA,false]
 
 let level_stack =
   ref [(default_levels, default_pattern_levels)]
@@ -475,27 +468,30 @@ let level_stack =
 (* At a same level, LeftA takes precedence over RightA and NoneA *)
 (* In case, several associativity exists for a level, we make two levels, *)
 (* first LeftA, then RightA and NoneA together *)
-open Ppextend
 
 let admissible_assoc = function
-  | LeftA, Some (RightA | NonA) -> false
-  | RightA, Some LeftA -> false
+  | Extend.LeftA, Some (Extend.RightA | Extend.NonA) -> false
+  | Extend.RightA, Some Extend.LeftA -> false
   | _ -> true
 
 let create_assoc = function
-  | None -> RightA
+  | None -> Extend.RightA
   | Some a -> a
 
 let error_level_assoc p current expected =
   let pr_assoc = function
-    | LeftA -> str "left"
-    | RightA -> str "right"
-    | NonA -> str "non" in
+    | Extend.LeftA -> str "left"
+    | Extend.RightA -> str "right"
+    | Extend.NonA -> str "non" in
   errorlabstrm ""
     (str "Level " ++ int p ++ str " is already declared " ++
      pr_assoc current ++ str " associative while it is now expected to be " ++
      pr_assoc expected ++ str " associative.")
 
+let create_pos = function
+  | None -> Extend.First
+  | Some lev -> Extend.After (constr_level lev)
+
 let find_position_gen forpat ensure assoc lev =
   let ccurrent,pcurrent as current = List.hd !level_stack in
   match lev with
@@ -507,9 +503,10 @@ let find_position_gen forpat ensure assoc lev =
       let init = ref None in
       let rec add_level q = function
         | (p,_,_ as pa)::l when p > n -> pa :: add_level (Some p) l
-        | (p,a,reinit)::l when p = n ->
+        | (p,a,reinit)::l when Int.equal p n ->
             if reinit then
-	      let a' = create_assoc assoc in (init := Some a'; (p,a',false)::l)
+	      let a' = create_assoc assoc in
+              (init := Some (a',create_pos q); (p,a',false)::l)
 	    else if admissible_assoc (a,assoc) then
 	      raise Exit
             else
@@ -522,35 +519,38 @@ let find_position_gen forpat ensure assoc lev =
 	  else (add_level None ccurrent, pcurrent) in
         level_stack := updated:: !level_stack;
 	let assoc = create_assoc assoc in
-        if !init = None then
+        begin match !init with
+        | None ->
 	  (* Create the entry *)
-	  (if !after = None then Some First
-	   else Some (After (constr_level (Option.get !after)))),
-	   Some assoc, Some (constr_level n), None
-        else
+	   Some (create_pos !after), Some assoc, Some (constr_level n), None
+        | _ ->
 	  (* The reinit flag has been updated *)
-	   Some (Level (constr_level n)), None, None, !init
+	   Some (Extend.Level (constr_level n)), None, None, !init
+        end
       with
 	  (* Nothing has changed *)
           Exit ->
             level_stack := current :: !level_stack;
 	    (* Just inherit the existing associativity and name (None) *)
-	    Some (Level (constr_level n)), None, None, None
+	    Some (Extend.Level (constr_level n)), None, None, None
 
 let remove_levels n =
-  level_stack := list_skipn n !level_stack
+  level_stack := List.skipn n !level_stack
 
 let rec list_mem_assoc_triple x = function
   | [] -> false
-  | (a,b,c) :: l -> a = x or list_mem_assoc_triple x l
+  | (a,b,c) :: l -> Int.equal a x || list_mem_assoc_triple x l
 
 let register_empty_levels forpat levels =
-  map_succeed (fun n ->
-    let levels = (if forpat then snd else fst) (List.hd !level_stack) in
-    if not (list_mem_assoc_triple n levels) then
-      find_position_gen forpat true None (Some n)
-    else
-      failwith "") levels
+  let filter n =
+    try
+      let levels = (if forpat then snd else fst) (List.hd !level_stack) in
+      if not (list_mem_assoc_triple n levels) then
+        Some (find_position_gen forpat true None (Some n))
+      else None
+    with Failure _ -> None
+  in
+  List.map_filter filter levels
 
 let find_position forpat assoc level =
   find_position_gen forpat false assoc level
@@ -564,8 +564,14 @@ let synchronize_level_positions () =
 
 (* Camlp4 levels do not treat NonA: use RightA with a NEXT on the left *)
 let camlp4_assoc = function
-  | Some NonA | Some RightA -> RightA
-  | None | Some LeftA -> LeftA
+  | Some Extend.NonA | Some Extend.RightA -> Extend.RightA
+  | None | Some Extend.LeftA -> Extend.LeftA
+
+let assoc_eq al ar = match al, ar with
+| Extend.NonA, Extend.NonA
+| Extend.RightA, Extend.RightA
+| Extend.LeftA, Extend.LeftA -> true
+| _, _ -> false
 
 (* [adjust_level assoc from prod] where [assoc] and [from] are the name
    and associativity of the level where to add the rule; the meaning of
@@ -580,27 +586,30 @@ let adjust_level assoc from = function
   | (NumLevel n,BorderProd (_,None)) -> Some (Some (n,true))
 (* Compute production name on the right side *)
   (* If NonA or LeftA on the right-hand side, set to NEXT *)
-  | (NumLevel n,BorderProd (Right,Some (NonA|LeftA))) ->
+  | (NumLevel n,BorderProd (Right,Some (Extend.NonA|Extend.LeftA))) ->
       Some None
   (* If RightA on the right-hand side, set to the explicit (current) level *)
-  | (NumLevel n,BorderProd (Right,Some RightA)) ->
+  | (NumLevel n,BorderProd (Right,Some Extend.RightA)) ->
       Some (Some (n,true))
 (* Compute production name on the left side *)
   (* If NonA on the left-hand side, adopt the current assoc ?? *)
-  | (NumLevel n,BorderProd (Left,Some NonA)) -> None
+  | (NumLevel n,BorderProd (Left,Some Extend.NonA)) -> None
   (* If the expected assoc is the current one, set to SELF *)
-  | (NumLevel n,BorderProd (Left,Some a)) when a = camlp4_assoc assoc ->
+  | (NumLevel n,BorderProd (Left,Some a)) when assoc_eq a (camlp4_assoc assoc) ->
       None
   (* Otherwise, force the level, n or n-1, according to expected assoc *)
   | (NumLevel n,BorderProd (Left,Some a)) ->
-      if a = LeftA then Some (Some (n,true)) else Some None
+    begin match a with
+    | Extend.LeftA -> Some (Some (n, true))
+    | _ -> Some None
+    end
   (* None means NEXT *)
   | (NextLevel,_) -> Some None
 (* Compute production name elsewhere *)
   | (NumLevel n,InternalProd) ->
       match from with
-	| ETConstr (p,()) when p = n+1 -> Some None
-	| ETConstr (p,()) -> Some (Some (n,n=p))
+	| ETConstr (p,()) when Int.equal p (n + 1) -> Some None
+	| ETConstr (p,()) -> Some (Some (n, Int.equal n p))
 	| _ -> Some (Some (n,false))
 
 let compute_entry allow_create adjust forpat = function
@@ -609,15 +618,16 @@ let compute_entry allow_create adjust forpat = function
        else weaken_entry Constr.operconstr),
       adjust (n,q), false
   | ETName -> weaken_entry Prim.name, None, false
-  | ETBinder true -> anomaly "Should occur only as part of BinderList"
+  | ETBinder true -> anomaly (Pp.str "Should occur only as part of BinderList")
   | ETBinder false -> weaken_entry Constr.binder, None, false
   | ETBinderList (true,tkl) ->
-      assert (tkl=[]); weaken_entry Constr.open_binders, None, false
-  | ETBinderList (false,_) -> anomaly "List of entries cannot be registered."
+    let () = match tkl with [] -> () | _ -> assert false in
+    weaken_entry Constr.open_binders, None, false
+  | ETBinderList (false,_) -> anomaly (Pp.str "List of entries cannot be registered.")
   | ETBigint -> weaken_entry Prim.bigint, None, false
   | ETReference -> weaken_entry Constr.global, None, false
   | ETPattern -> weaken_entry Constr.pattern, None, false
-  | ETConstrList _ -> anomaly "List of entries cannot be registered."
+  | ETConstrList _ -> anomaly (Pp.str "List of entries cannot be registered.")
   | ETOther (u,n) ->
       let u = get_univ u in
       let e =
@@ -645,10 +655,11 @@ let is_self from e =
   match from, e with
       ETConstr(n,()), ETConstr(NumLevel n',
         BorderProd(Right, _ (* Some(NonA|LeftA) *))) -> false
-    | ETConstr(n,()), ETConstr(NumLevel n',BorderProd(Left,_)) -> n=n'
+    | ETConstr(n,()), ETConstr(NumLevel n',BorderProd(Left,_)) -> Int.equal n n'
     | (ETName,ETName | ETReference, ETReference | ETBigint,ETBigint
       | ETPattern, ETPattern) -> true
-    | ETOther(s1,s2), ETOther(s1',s2') -> s1=s1' & s2=s2'
+    | ETOther(s1,s2), ETOther(s1',s2') ->
+      String.equal s1 s1' && String.equal s2 s2'
     | _ -> false
 
 let is_binder_level from e =
@@ -716,10 +727,23 @@ let rec symbol_of_prod_entry_key = function
   | Atactic 5 -> Snterm (Gram.Entry.obj Tactic.binder_tactic)
   | Atactic n ->
       Snterml (Gram.Entry.obj Tactic.tactic_expr, string_of_int n)
-  | Agram s -> Snterm s
+  | Agram s ->
+    let e =
+      try
+      (** ppedrot: we should always generate Agram entries which have already
+          been registered, so this should not fail. *)
+        let (u, s) = match String.split ':' s with
+        | u :: s :: [] -> (u, s)
+        | _ -> raise Not_found
+        in
+        get_entry (get_univ u) s
+      with Not_found ->
+        Errors.anomaly (str "Unregistered grammar entry: " ++ str s)
+    in
+    Snterm (Gram.Entry.obj (object_of_typed_entry e))
   | Aentry (u,s) ->
-      Snterm (Gram.Entry.obj
-	(object_of_typed_entry (get_entry (get_univ u) s)))
+    let e = get_entry (get_univ u) s in
+    Snterm (Gram.Entry.obj (object_of_typed_entry e))
 
 let level_of_snterml = function
   | Snterml (_,l) -> int_of_string l
@@ -728,44 +752,83 @@ let level_of_snterml = function
 (**********************************************************************)
 (* Interpret entry names of the form "ne_constr_list" as entry keys   *)
 
+let coincide s pat off =
+  let len = String.length pat in
+  let break = ref true in
+  let i = ref 0 in
+  while !break && !i < len do
+    let c = Char.code s.[off + !i] in
+    let d = Char.code pat.[!i] in
+    break := Int.equal c d;
+    incr i
+  done;
+  !break
+
+let tactic_level s =
+  if Int.equal (String.length s) 7 && coincide s "tactic" 0 then
+    let c = s.[6] in if '5' >= c && c >= '0' then Some (Char.code c - 48)
+    else None
+  else None
+
+let type_of_entry u s =
+  type_of_typed_entry (get_entry u s)
+
 let rec interp_entry_name static up_level s sep =
   let l = String.length s in
-  if l > 8 & String.sub s 0 3 = "ne_" & String.sub s (l-5) 5 = "_list" then
+  if l > 8 && coincide s "ne_" 0 && coincide s "_list" (l - 5) then
     let t, g = interp_entry_name static up_level (String.sub s 3 (l-8)) "" in
-    List1ArgType t, Alist1 g
-  else if l > 12 & String.sub s 0 3 = "ne_" &
-                   String.sub s (l-9) 9 = "_list_sep" then
+    ListArgType t, Alist1 g
+  else if l > 12 && coincide s "ne_" 0 &&
+                   coincide s "_list_sep" (l-9) then
     let t, g = interp_entry_name static up_level (String.sub s 3 (l-12)) "" in
-    List1ArgType t, Alist1sep (g,sep)
-  else if l > 5 & String.sub s (l-5) 5 = "_list" then
+    ListArgType t, Alist1sep (g,sep)
+  else if l > 5 && coincide s "_list" (l-5) then
     let t, g = interp_entry_name static up_level (String.sub s 0 (l-5)) "" in
-    List0ArgType t, Alist0 g
-  else if l > 9 & String.sub s (l-9) 9 = "_list_sep" then
+    ListArgType t, Alist0 g
+  else if l > 9 && coincide s "_list_sep" (l-9) then
     let t, g = interp_entry_name static up_level (String.sub s 0 (l-9)) "" in
-    List0ArgType t, Alist0sep (g,sep)
-  else if l > 4 & String.sub s (l-4) 4 = "_opt" then
+    ListArgType t, Alist0sep (g,sep)
+  else if l > 4 && coincide s "_opt" (l-4) then
     let t, g = interp_entry_name static up_level (String.sub s 0 (l-4)) "" in
     OptArgType t, Aopt g
-  else if l > 5 & String.sub s (l-5) 5 = "_mods" then
+  else if l > 5 && coincide s "_mods" (l-5) then
     let t, g = interp_entry_name static up_level (String.sub s 0 (l-1)) "" in
-    List0ArgType t, Amodifiers g
+    ListArgType t, Amodifiers g
   else
-    let s = if s = "hyp" then "var" else s in
+    let s = match s with "hyp" -> "var" | _ -> s in
+    let check_lvl n = match up_level with
+    | None -> false
+    | Some m -> Int.equal m n
+                && not (Int.equal m 5) (* Because tactic5 is at binder_tactic *)
+                && not (Int.equal m 0) (* Because tactic0 is at simple_tactic *)
+    in
     let t, se =
-      match Extrawit.tactic_genarg_level s with
-	| Some n when Some n = up_level & up_level <> Some 5 -> None, Aself
-	| Some n when Some (n+1) = up_level & up_level <> Some 5 -> None, Anext
-	| Some n -> None, Atactic n
-	| None ->
-      try Some (get_entry uprim s), Aentry ("prim",s) with Not_found ->
-      try Some (get_entry uconstr s), Aentry ("constr",s) with Not_found ->
-      try Some (get_entry utactic s), Aentry ("tactic",s) with Not_found ->
+      match tactic_level s with
+      | Some n ->
+        (** Quite ad-hoc *)
+        let t = unquote (rawwit wit_tactic) in
+        let se =
+          if check_lvl n then Aself
+          else if check_lvl (n + 1) then Anext
+          else Atactic n
+        in
+        (Some t, se)
+      | None ->
+      try Some (type_of_entry uprim s), Aentry ("prim",s) with Not_found ->
+      try Some (type_of_entry uconstr s), Aentry ("constr",s) with Not_found ->
+      try Some (type_of_entry utactic s), Aentry ("tactic",s) with Not_found ->
 	if static then
 	  error ("Unknown entry "^s^".")
 	else
 	  None, Aentry ("",s) in
     let t =
       match t with
-	| Some t -> type_of_typed_entry t
+	| Some t -> t
 	| None -> ExtraArgType s in
     t, se
+
+let list_entry_names () =
+  let add_entry key (entry, _) accu = (key, entry) :: accu in
+  let ans = Hashtbl.fold add_entry (snd uprim) [] in
+  let ans = Hashtbl.fold add_entry (snd uconstr) ans in
+  Hashtbl.fold add_entry (snd utactic) ans
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 1b04b117..dbd2aadf 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -1,21 +1,22 @@
 (************************************************************************)
 (*  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 Extend
 open Vernacexpr
 open Genarg
-open Topconstr
+open Constrexpr
 open Tacexpr
 open Libnames
 open Compat
+open Misctypes
+open Genredexpr
 
 (** The parser of Coq *)
 
@@ -102,10 +103,13 @@ val gram_token_of_string : string -> Gram.symbol
 (** The superclass of all grammar entries *)
 type grammar_object
 
+(** Type of reinitialization data *)
+type gram_reinit = gram_assoc * gram_position
+
 (** Add one extension at some camlp4 position of some camlp4 entry *)
 val grammar_extend :
   grammar_object Gram.entry ->
-  gram_assoc option (** for reinitialization if ever needed *) ->
+  gram_reinit option (** for reinitialization if ever needed *) ->
   Gram.extend_statment -> unit
 
 (** Remove the last n extensions *)
@@ -153,29 +157,28 @@ val create_generic_entry : string -> ('a, rlevel) abstract_argument_type ->
 
 module Prim :
   sig
-    open Util
     open Names
     open Libnames
     val preident : string Gram.entry
-    val ident : identifier Gram.entry
-    val name : name located Gram.entry
-    val identref : identifier located Gram.entry
-    val pattern_ident : identifier Gram.entry
-    val pattern_identref : identifier located Gram.entry
-    val base_ident : identifier Gram.entry
+    val ident : Id.t Gram.entry
+    val name : Name.t located Gram.entry
+    val identref : Id.t located Gram.entry
+    val pattern_ident : Id.t Gram.entry
+    val pattern_identref : Id.t located Gram.entry
+    val base_ident : Id.t Gram.entry
     val natural : int Gram.entry
     val bigint : Bigint.bigint Gram.entry
     val integer : int Gram.entry
     val string : string Gram.entry
     val qualid : qualid located Gram.entry
-    val fullyqualid : identifier list located Gram.entry
+    val fullyqualid : Id.t list located Gram.entry
     val reference : reference Gram.entry
-    val by_notation : (loc * string * string option) Gram.entry
+    val by_notation : (Loc.t * string * string option) Gram.entry
     val smart_global : reference or_by_notation Gram.entry
-    val dirpath : dir_path Gram.entry
+    val dirpath : DirPath.t Gram.entry
     val ne_string : string Gram.entry
     val ne_lstring : string located Gram.entry
-    val var : identifier located Gram.entry
+    val var : Id.t located Gram.entry
   end
 
 module Constr :
@@ -185,7 +188,7 @@ module Constr :
     val lconstr : constr_expr Gram.entry
     val binder_constr : constr_expr Gram.entry
     val operconstr : constr_expr Gram.entry
-    val ident : identifier Gram.entry
+    val ident : Id.t Gram.entry
     val global : reference Gram.entry
     val sort : glob_sort Gram.entry
     val pattern : cases_pattern_expr Gram.entry
@@ -195,8 +198,8 @@ module Constr :
     val binder : local_binder list Gram.entry (* closed_binder or variable *)
     val binders : local_binder list Gram.entry (* list of binder *)
     val open_binders : local_binder list Gram.entry
-    val binders_fixannot : (local_binder list * (identifier located option * recursion_order_expr)) Gram.entry
-    val typeclass_constraint : (name located * bool * constr_expr) Gram.entry
+    val binders_fixannot : (local_binder list * (Id.t located option * recursion_order_expr)) Gram.entry
+    val typeclass_constraint : (Name.t located * bool * constr_expr) Gram.entry
     val record_declaration : constr_expr Gram.entry
     val appl_arg : (constr_expr * explicitation located option) Gram.entry
   end
@@ -209,28 +212,27 @@ module Module :
 
 module Tactic :
   sig
-    open Glob_term
     val open_constr : open_constr_expr Gram.entry
-    val open_constr_wTC : open_constr_expr Gram.entry
-    val casted_open_constr : open_constr_expr Gram.entry
     val constr_with_bindings : constr_expr with_bindings Gram.entry
     val bindings : constr_expr bindings Gram.entry
     val constr_may_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
+    val uconstr : constr_expr Gram.entry
     val quantified_hypothesis : quantified_hypothesis Gram.entry
     val int_or_var : int or_var Gram.entry
     val red_expr : raw_red_expr Gram.entry
-    val simple_tactic : raw_atomic_tactic_expr Gram.entry
-    val simple_intropattern : Genarg.intro_pattern_expr located Gram.entry
+    val simple_tactic : raw_tactic_expr Gram.entry
+    val simple_intropattern : constr_expr intro_pattern_expr located Gram.entry
+    val clause_dft_concl : Names.Id.t Loc.located Locus.clause_expr Gram.entry
     val tactic_arg : raw_tactic_arg Gram.entry
     val tactic_expr : raw_tactic_expr Gram.entry
     val binder_tactic : raw_tactic_expr Gram.entry
     val tactic : raw_tactic_expr Gram.entry
     val tactic_eoi : raw_tactic_expr Gram.entry
+    val tacdef_body : (reference * bool * raw_tactic_expr) Gram.entry
   end
 
 module Vernac_ :
   sig
-    open Decl_kinds
     val gallina : vernac_expr Gram.entry
     val gallina_ext : vernac_expr Gram.entry
     val command : vernac_expr Gram.entry
@@ -241,7 +243,7 @@ module Vernac_ :
   end
 
 (** The main entry: reads an optional vernac command *)
-val main_entry : (loc * vernac_expr) option Gram.entry
+val main_entry : (Loc.t * vernac_expr) option Gram.entry
 
 (** Mapping formal entries into concrete ones *)
 
@@ -271,7 +273,7 @@ type prod_entry_key =
   | Aself
   | Anext
   | Atactic of int
-  | Agram of Gram.internal_entry
+  | Agram of string
   | Aentry of string * string
 
 (** Binding general entry keys to symbols *)
@@ -284,19 +286,22 @@ val symbol_of_prod_entry_key :
 val interp_entry_name : bool (** true to fail on unknown entry *) ->
   int option -> string -> string -> entry_type * prod_entry_key
 
+(** Recover the list of all known tactic notation entries. *)
+val list_entry_names : unit -> (string * entry_type) list
+
 (** Registering/resetting the level of a constr entry *)
 
 val find_position :
   bool (** true if for creation in pattern entry; false if in constr entry *) ->
-  gram_assoc option -> int option ->
-    gram_position option * gram_assoc option * string option *
-    (** for reinitialization: *) gram_assoc option
+  Extend.gram_assoc option -> int option ->
+    Extend.gram_position option * Extend.gram_assoc option * string option *
+    (** for reinitialization: *) gram_reinit option
 
 val synchronize_level_positions : unit -> unit
 
 val register_empty_levels : bool -> int list ->
-    (gram_position option * gram_assoc option *
-     string option * gram_assoc option) list
+    (Extend.gram_position option * Extend.gram_assoc option *
+     string option * gram_reinit option) list
 
 val remove_levels : int -> unit
 
diff --git a/parsing/ppconstr.ml b/parsing/ppconstr.ml
deleted file mode 100644
index 4fde091d..00000000
--- a/parsing/ppconstr.ml
+++ /dev/null
@@ -1,654 +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        *)
-(************************************************************************)
-
-(*i*)
-open Util
-open Pp
-open Nametab
-open Names
-open Nameops
-open Libnames
-open Ppextend
-open Topconstr
-open Term
-open Pattern
-open Glob_term
-open Constrextern
-open Termops
-(*i*)
-
-let sep_v = fun _ -> str"," ++ spc()
-let pr_tight_coma () = str "," ++ cut ()
-
-let latom = 0
-let lprod = 200
-let llambda = 200
-let lif = 200
-let lletin = 200
-let lletpattern = 200
-let lfix = 200
-let larrow = 90
-let lcast = 100
-let larg = 9
-let lapp = 10
-let lposint = 0
-let lnegint = 35 (* must be consistent with Notation "- x" *)
-let ltop = (200,E)
-let lproj = 1
-let ldelim = 1
-let lsimpleconstr = (8,E)
-let lsimplepatt = (1,E)
-
-let prec_less child (parent,assoc) =
-  if parent < 0 && child = lprod then true
-  else
-    let parent = abs parent in
-    match assoc with
-      | E -> (<=) child parent
-      | L -> (<) child parent
-      | Prec n -> child<=n
-      | Any -> true
-
-let prec_of_prim_token = function
-  | Numeral p -> if Bigint.is_pos_or_zero p then lposint else lnegint
-  | String _ -> latom
-
-open Notation
-
-let print_hunks n pr pr_binders (terms,termlists,binders) unp =
-  let env = ref terms and envlist = ref termlists and bll = ref binders in
-  let pop r = let a = List.hd !r in r := List.tl !r; a in
-  let rec aux = function
-  | [] -> mt ()
-  | UnpMetaVar (_,prec) :: l ->
-      let c = pop env in pr (n,prec) c ++ aux l
-  | UnpListMetaVar (_,prec,sl) :: l ->
-      let cl = pop envlist in
-      let pp1 = prlist_with_sep (fun () -> aux sl) (pr (n,prec)) cl in
-      let pp2 = aux l in
-      pp1 ++ pp2
-  | UnpBinderListMetaVar (_,isopen,sl) :: l ->
-      let cl = pop bll in pr_binders (fun () -> aux sl) isopen cl ++ aux l
-  | UnpTerminal s :: l -> str s ++ aux l
-  | UnpBox (b,sub) :: l ->
-      (* Keep order: side-effects *)
-      let pp1 = ppcmd_of_box b (aux sub) in
-      let pp2 = aux l in
-      pp1 ++ pp2
-  | UnpCut cut :: l -> ppcmd_of_cut cut ++ aux l in
-  aux unp
-
-let pr_notation pr pr_binders s env =
-  let unpl, level = find_notation_printing_rule s in
-  print_hunks level pr pr_binders env unpl, level
-
-let pr_delimiters key strm =
-  strm ++ str ("%"^key)
-
-let pr_generalization bk ak c =
-  let hd, tl =
-    match bk with
-    | Implicit -> "{", "}"
-    | Explicit -> "(", ")"
-  in (* TODO: syntax Abstraction Kind *)
-    str "`" ++ str hd ++ c ++ str tl
-
-let pr_com_at n =
-  if Flags.do_beautify() && n <> 0 then comment n
-  else mt()
-
-let pr_with_comments loc pp = pr_located (fun x -> x) (loc,pp)
-
-let pr_sep_com sep f c = pr_with_comments (constr_loc c) (sep() ++ f c)
-
-let pr_in_comment pr x = str "(* " ++ pr x ++ str " *)"
-
-let pr_universe = Univ.pr_uni
-
-let pr_glob_sort = function
-  | GProp Term.Null -> str "Prop"
-  | GProp Term.Pos -> str "Set"
-  | GType u -> hov 0 (str "Type" ++ pr_opt (pr_in_comment pr_universe) u)
-
-let pr_id = pr_id
-let pr_name = pr_name
-let pr_qualid = pr_qualid
-let pr_patvar = pr_id
-
-let pr_expl_args pr (a,expl) =
-  match expl with
-  | None -> pr (lapp,L) a
-  | Some (_,ExplByPos (n,_id)) ->
-      anomaly("Explicitation by position not implemented")
-  | Some (_,ExplByName id) ->
-      str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
-
-let pr_opt_type pr = function
-  | CHole _ -> mt ()
-  | t -> cut () ++ str ":" ++ pr t
-
-let pr_opt_type_spc pr = function
-  | CHole _ -> mt ()
-  | t ->  str " :" ++ pr_sep_com (fun()->brk(1,2)) (pr ltop) t
-
-let pr_lident (loc,id) =
-  if loc <> dummy_loc then
-    let (b,_) = unloc loc in
-    pr_located pr_id (make_loc (b,b+String.length(string_of_id id)),id)
-  else pr_id id
-
-let pr_lname = function
-    (loc,Name id) -> pr_lident (loc,id)
-  | lna -> pr_located pr_name lna
-
-let pr_or_var pr = function
-  | ArgArg x -> pr x
-  | ArgVar (loc,s) -> pr_lident (loc,s)
-
-let pr_prim_token = function
-  | Numeral n -> str (Bigint.to_string n)
-  | String s -> qs s
-
-let pr_evar pr n l =
-  hov 0 (str (Evd.string_of_existential n) ++
-  (match l with
-   | Some l ->
-       spc () ++ pr_in_comment
-         (fun l ->
-	   str"[" ++ hov 0 (prlist_with_sep pr_comma (pr ltop) l) ++ str"]")
-         (List.rev l)
-   | None -> mt()))
-
-let las = lapp
-let lpator = 100
-let lpatrec = 0
-
-let rec pr_patt sep inh p =
-  let (strm,prec) = match p with
-  | CPatRecord (_, l) ->
-      let pp (c, p) =
-	pr_reference c ++ spc() ++ str ":=" ++ pr_patt spc (lpatrec, Any) p in
-      str "{| " ++ prlist_with_sep pr_semicolon pp l ++ str " |}", lpatrec
-  | CPatAlias (_,p,id) ->
-      pr_patt mt (las,E) p ++ str " as " ++ pr_id id, las
-  | CPatCstr (_,c,[]) -> pr_reference c, latom
-  | CPatCstr (_,c,args) ->
-      pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
-  | CPatCstrExpl (_,c,args) ->
-      str "@" ++ pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
-  | CPatAtom (_,None) -> str "_", latom
-  | CPatAtom (_,Some r) -> pr_reference r, latom
-  | CPatOr (_,pl) ->
-      hov 0 (prlist_with_sep pr_bar (pr_patt spc (lpator,L)) pl), lpator
-  | CPatNotation (_,"( _ )",([p],[])) ->
-      pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom
-  | CPatNotation (_,s,(l,ll)) ->
-      pr_notation (pr_patt mt) (fun _ _ _ -> mt()) s (l,ll,[])
-  | CPatPrim (_,p) -> pr_prim_token p, latom
-  | CPatDelimiters (_,k,p) -> pr_delimiters k (pr_patt mt lsimplepatt p), 1
-  in
-  let loc = cases_pattern_expr_loc p in
-  pr_with_comments loc
-    (sep() ++ if prec_less prec inh then strm else surround strm)
-
-let pr_patt = pr_patt mt
-
-let pr_eqn pr (loc,pl,rhs) =
-  let pl = List.map snd pl in
-  spc() ++ hov 4
-    (pr_with_comments loc
-      (str "| " ++
-      hov 0 (prlist_with_sep pr_bar (prlist_with_sep sep_v (pr_patt ltop)) pl
-             ++ str " =>") ++
-      pr_sep_com spc (pr ltop) rhs))
-
-let begin_of_binder = function
-    LocalRawDef((loc,_),_) -> fst (unloc loc)
-  | LocalRawAssum((loc,_)::_,_,_) -> fst (unloc loc)
-  | _ -> assert false
-
-let begin_of_binders = function
-  | b::_ -> begin_of_binder b
-  | _ -> 0
-
-let surround_impl k p =
-  match k with
-  | Explicit -> str"(" ++ p ++ str")"
-  | Implicit -> str"{" ++ p ++ str"}"
-
-let surround_implicit k p =
-  match k with
-  | Explicit -> p
-  | Implicit -> (str"{" ++ p ++ str"}")
-
-let pr_binder many pr (nal,k,t) =
-  match k with
-    | Generalized (b, b', t') ->
-      assert (b=Implicit);
-      begin match nal with
-	|[loc,Anonymous] ->
-	  hov 1 (str"`" ++ (surround_impl b'
-			      ((if t' then str "!" else mt ()) ++ pr t)))
-	|[loc,Name id] ->
-	  hov 1 (str "`" ++ (surround_impl b'
-			       (pr_lident (loc,id) ++ str " : " ++
-				  (if t' then str "!" else mt()) ++ pr t)))
-	|_ -> anomaly "List of generalized binders have alwais one element."
-      end
-    | Default b ->
-      match t with
-	| CHole _ ->
-	  let s = prlist_with_sep spc pr_lname nal in
-	  hov 1 (surround_implicit b s)
-	| _ ->
-	  let s = prlist_with_sep spc pr_lname nal ++ str " : " ++ pr t in
-	  hov 1 (if many then surround_impl b s else surround_implicit b s)
-
-let pr_binder_among_many pr_c = function
-  | LocalRawAssum (nal,k,t) ->
-      pr_binder true pr_c (nal,k,t)
-  | LocalRawDef (na,c) ->
-      let c,topt = match c with
-        | CCast(_,c, CastConv (_,t)) -> c, t
-        | _ -> c, CHole (dummy_loc, None) in
-      surround (pr_lname na ++ pr_opt_type pr_c topt ++
-         str":=" ++ cut() ++ pr_c c)
-
-let pr_undelimited_binders sep pr_c =
-  prlist_with_sep sep (pr_binder_among_many pr_c)
-
-let pr_delimited_binders kw sep pr_c bl =
-  let n = begin_of_binders bl in
-  match bl with
-  | [LocalRawAssum (nal,k,t)] ->
-      pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,k,t)
-  | LocalRawAssum _ :: _ as bdl ->
-      pr_com_at n ++ kw() ++ pr_undelimited_binders sep pr_c bdl
-  | _ -> assert false
-
-let pr_binders_gen pr_c sep is_open =
-  if is_open then pr_delimited_binders mt sep pr_c
-  else pr_undelimited_binders sep pr_c
-
-let rec extract_prod_binders = function
-(*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_prod_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-  | CProdN (loc,[],c) ->
-      extract_prod_binders c
-  | CProdN (loc,(nal,bk,t)::bl,c) ->
-      let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
-      LocalRawAssum (nal,bk,t) :: bl, c
-  | c -> [], c
-
-let rec extract_lam_binders = function
-(*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_lam_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-  | CLambdaN (loc,[],c) ->
-      extract_lam_binders c
-  | CLambdaN (loc,(nal,bk,t)::bl,c) ->
-      let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
-      LocalRawAssum (nal,bk,t) :: bl, c
-  | c -> [], c
-
-let split_lambda = function
-  | CLambdaN (loc,[[na],bk,t],c) -> (na,t,c)
-  | CLambdaN (loc,([na],bk,t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
-  | CLambdaN (loc,(na::nal,bk,t)::bl,c) -> (na,t,CLambdaN(loc,(nal,bk,t)::bl,c))
-  | _ -> anomaly "ill-formed fixpoint body"
-
-let rename na na' t c =
-  match (na,na') with
-    | (_,Name id), (_,Name id') -> (na',t,replace_vars_constr_expr [id,id'] c)
-    | (_,Name id), (_,Anonymous) -> (na,t,c)
-    | _ -> (na',t,c)
-
-let split_product na' = function
-  | CArrow (loc,t,c) -> (na',t,c)
-  | CProdN (loc,[[na],bk,t],c) -> rename na na' t c
-  | CProdN (loc,([na],bk,t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
-  | CProdN (loc,(na::nal,bk,t)::bl,c) ->
-      rename na na' t (CProdN(loc,(nal,bk,t)::bl,c))
-  | _ -> anomaly "ill-formed fixpoint body"
-
-let rec split_fix n typ def =
-  if n = 0 then ([],typ,def)
-  else
-    let (na,_,def) = split_lambda def in
-    let (na,t,typ) = split_product na typ in
-    let (bl,typ,def) = split_fix (n-1) typ def in
-    (LocalRawAssum ([na],default_binder_kind,t)::bl,typ,def)
-
-let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
-  let pr_body =
-    if dangling_with_for then pr_dangling else pr in
-  pr_id id ++ str" " ++
-  hov 0 (pr_undelimited_binders spc (pr ltop) bl ++ annot) ++
-  pr_opt_type_spc pr t ++ str " :=" ++
-  pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
-
-let pr_guard_annot pr_aux bl (n,ro) =
-  match n with
-    | None -> mt ()
-    | Some (loc, id) ->
-      match (ro : Topconstr.recursion_order_expr) with
-	| CStructRec ->
-	  let names_of_binder = function
-	    | LocalRawAssum (nal,_,_) -> nal
-	    | LocalRawDef (_,_) -> []
-	  in let ids = List.flatten (List.map names_of_binder bl) in
-	     if List.length ids > 1 then
-	       spc() ++ str "{struct " ++ pr_id id ++ str"}"
-	     else mt()
-	| CWfRec c ->
-	  spc() ++ str "{wf " ++ pr_aux c ++ spc() ++ pr_id id ++ str"}"
-	| CMeasureRec (m,r) ->
-	  spc() ++ str "{measure " ++ pr_aux m ++ spc() ++ pr_id id++
-	    (match r with None -> mt() | Some r -> str" on " ++ pr_aux r) ++ str"}"
-
-let pr_fixdecl pr prd dangling_with_for ((_,id),ro,bl,t,c) =
-  let annot = pr_guard_annot (pr lsimpleconstr) bl ro in
-    pr_recursive_decl pr prd dangling_with_for id bl annot t c
-
-let pr_cofixdecl pr prd dangling_with_for ((_,id),bl,t,c) =
-  pr_recursive_decl pr prd dangling_with_for id bl (mt()) t c
-
-let pr_recursive pr_decl id = function
-  | [] -> anomaly "(co)fixpoint with no definition"
-  | [d1] -> pr_decl false d1
-  | dl ->
-      prlist_with_sep (fun () -> fnl() ++ str "with ")
-        (pr_decl true) dl ++
-      fnl() ++ str "for " ++ pr_id id
-
-let pr_asin pr (na,indnalopt) =
-  (match na with (* Decision of printing "_" or not moved to constrextern.ml *)
-    | Some na -> spc () ++ str "as " ++  pr_lname na
-    | None -> mt ()) ++
-  (match indnalopt with
-    | None -> mt ()
-    | Some t -> spc () ++ str "in " ++ pr lsimpleconstr t)
-
-let pr_case_item pr (tm,asin) =
-  hov 0 (pr (lcast,E) tm ++ pr_asin pr asin)
-
-let pr_case_type pr po =
-  match po with
-    | None | Some (CHole _) -> mt()
-    | Some p ->
-        spc() ++ hov 2 (str "return" ++ pr_sep_com spc (pr lsimpleconstr) p)
-
-let pr_simple_return_type pr na po =
-  (match na with
-    | Some (_,Name id) ->
-        spc () ++ str "as " ++  pr_id id
-    | _ -> mt ()) ++
-  pr_case_type pr po
-
-let pr_proj pr pr_app a f l =
-  hov 0 (pr (lproj,E) a ++ cut() ++ str ".(" ++ pr_app pr f l ++ str ")")
-
-let pr_appexpl pr f l =
-      hov 2 (
-	str "@" ++ pr_reference f ++
-	prlist (pr_sep_com spc (pr (lapp,L))) l)
-
-let pr_app pr a l =
-  hov 2 (
-    pr (lapp,L) a  ++
-    prlist (fun a -> spc () ++ pr_expl_args pr a) l)
-
-let pr_forall () = str"forall" ++ spc ()
-
-let pr_fun () = str"fun" ++ spc ()
-
-let pr_fun_sep = str " =>"
-
-
-let pr_dangling_with_for sep pr inherited a =
-  match a with
-  | (CFix (_,_,[_])|CCoFix(_,_,[_])) -> pr sep (latom,E) a
-  | _ -> pr sep inherited a
-
-let pr pr sep inherited a =
-  let (strm,prec) = match a with
-  | CRef r -> pr_reference r, latom
-  | CFix (_,id,fix) ->
-      hov 0 (str"fix " ++
-             pr_recursive
-               (pr_fixdecl (pr mt) (pr_dangling_with_for mt pr)) (snd id) fix),
-      lfix
-  | CCoFix (_,id,cofix) ->
-      hov 0 (str "cofix " ++
-             pr_recursive
-              (pr_cofixdecl (pr mt) (pr_dangling_with_for mt pr)) (snd id) cofix),
-      lfix
-  | CArrow (_,a,b) ->
-      hov 0 (pr mt (larrow,L) a ++ str " ->" ++
-             pr (fun () ->brk(1,0)) (-larrow,E) b),
-      larrow
-  | CProdN _ ->
-      let (bl,a) = extract_prod_binders a in
-      hov 0 (
-	hov 2 (pr_delimited_binders pr_forall spc
-                 (pr mt ltop) bl) ++
-        str "," ++ pr spc ltop a),
-      lprod
-  | CLambdaN _ ->
-      let (bl,a) = extract_lam_binders a in
-      hov 0 (
-        hov 2 (pr_delimited_binders pr_fun spc
-                (pr mt ltop) bl) ++
-	       pr_fun_sep ++ pr spc ltop a),
-      llambda
-  | CLetIn (_,(_,Name x),(CFix(_,(_,x'),[_])|CCoFix(_,(_,x'),[_]) as fx), b)
-      when x=x' ->
-      hv 0 (
-        hov 2 (str "let " ++ pr mt ltop fx ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CLetIn (_,x,a,b) ->
-      hv 0 (
-        hov 2 (str "let " ++ pr_lname x ++ str " :=" ++
-               pr spc ltop a ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CAppExpl (_,(Some i,f),l) ->
-      let l1,l2 = list_chop i l in
-      let c,l1 = list_sep_last l1 in
-      let p = pr_proj (pr mt) pr_appexpl c f l1 in
-      if l2<>[] then
-	p ++ prlist (pr spc (lapp,L)) l2, lapp
-      else
-	p, lproj
-  | CAppExpl (_,(None,Ident (_,var)),[t])
-  | CApp (_,(_,CRef(Ident(_,var))),[t,None])
-        when var = Topconstr.ldots_var ->
-      hov 0 (str ".." ++ pr spc (latom,E) t ++ spc () ++ str ".."), larg
-  | CAppExpl (_,(None,f),l) -> pr_appexpl (pr mt) f l, lapp
-  | CApp (_,(Some i,f),l) ->
-      let l1,l2 = list_chop i l in
-      let c,l1 = list_sep_last l1 in
-      assert (snd c = None);
-      let p = pr_proj (pr mt) pr_app (fst c) f l1 in
-      if l2<>[] then
-	p ++ prlist (fun a -> spc () ++ pr_expl_args (pr mt) a) l2, lapp
-      else
-	p, lproj
-  | CApp (_,(None,a),l) -> pr_app (pr mt) a l, lapp
-  | CRecord (_,w,l) ->
-      let beg =
-	match w with
-	| None -> spc ()
-	| Some t -> spc () ++ pr spc ltop t ++ spc () ++ str"with" ++ spc ()
-      in
-	hv 0 (str"{|" ++ beg ++
-	      prlist_with_sep pr_semicolon
-		(fun (id, c) -> h 1 (pr_reference id ++ spc () ++ str":=" ++ pr spc ltop c)) l
-	      ++ str" |}"), latom
-
-  | CCases (_,LetPatternStyle,rtntypopt,[c,asin],[(_,[(loc,[p])],b)]) ->
-      hv 0 (
-	str "let '" ++
-	  hov 0 (pr_patt ltop p ++
-		 pr_asin (pr_dangling_with_for mt pr) asin ++
-		 str " :=" ++ pr spc ltop c ++
-		 pr_case_type (pr_dangling_with_for mt pr) rtntypopt ++
-		 str " in" ++ pr spc ltop b)),
-	lletpattern
-  | CCases(_,_,rtntypopt,c,eqns) ->
-      v 0
-        (hv 0 (str "match" ++ brk (1,2) ++
-		  hov 0 (
-		    prlist_with_sep sep_v
-		      (pr_case_item (pr_dangling_with_for mt pr)) c
-		    ++ pr_case_type (pr_dangling_with_for mt pr) rtntypopt) ++
-		  spc () ++ str "with") ++
-		  prlist (pr_eqn (pr mt)) eqns ++ spc() ++ str "end"),
-      latom
-  | CLetTuple (_,nal,(na,po),c,b) ->
-      hv 0 (
-        str "let " ++
-	hov 0 (str "(" ++
-               prlist_with_sep sep_v pr_lname nal ++
-               str ")" ++
-	       pr_simple_return_type (pr mt) na po ++ str " :=" ++
-               pr spc ltop c ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CIf (_,c,(na,po),b1,b2) ->
-      (* On force les parenthèses autour d'un "if" sous-terme (même si le
-	 parsing est lui plus tolérant) *)
-      hv 0 (
-	hov 1 (str "if " ++ pr mt ltop c ++ pr_simple_return_type (pr mt) na po) ++
-	spc () ++
-	hov 0 (str "then" ++ pr (fun () -> brk (1,1)) ltop b1) ++ spc () ++
-	hov 0 (str "else" ++ pr (fun () -> brk (1,1)) ltop b2)),
-      lif
-
-  | CHole _ -> str "_", latom
-  | CEvar (_,n,l) -> pr_evar (pr mt) n l, latom
-  | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom
-  | CSort (_,s) -> pr_glob_sort s, latom
-  | CCast (_,a,CastConv (k,b)) ->
-      let s = match k with VMcast -> "<:" | DEFAULTcast | REVERTcast -> ":" in
-      hv 0 (pr mt (lcast,L) a ++ cut () ++ str s ++ pr mt (-lcast,E) b),
-      lcast
-  | CCast (_,a,CastCoerce) ->
-      hv 0 (pr mt (lcast,L) a ++ cut () ++ str ":>"),
-      lcast
-  | CNotation (_,"( _ )",([t],[],[])) ->
-      pr (fun()->str"(") (max_int,L) t ++ str")", latom
-  | CNotation (_,s,env) ->
-      pr_notation (pr mt) (pr_binders_gen (pr mt ltop)) s env
-  | CGeneralization (_,bk,ak,c) -> pr_generalization bk ak (pr mt ltop c), latom
-  | CPrim (_,p) -> pr_prim_token p, prec_of_prim_token p
-  | CDelimiters (_,sc,a) -> pr_delimiters sc (pr mt (ldelim,E) a), ldelim
-  in
-  let loc = constr_loc a in
-  pr_with_comments loc
-    (sep() ++ if prec_less prec inherited then strm else surround strm)
-
-type term_pr = {
-  pr_constr_expr   : constr_expr -> std_ppcmds;
-  pr_lconstr_expr  : constr_expr -> std_ppcmds;
-  pr_constr_pattern_expr  : constr_pattern_expr -> std_ppcmds;
-  pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
-}
-
-type precedence =  Ppextend.precedence * Ppextend.parenRelation
-let modular_constr_pr = pr
-let rec fix rf x =rf (fix rf) x
-let pr = fix modular_constr_pr mt
-
-let pr_simpleconstr = function
-  | CAppExpl (_,(None,f),[]) -> str "@" ++ pr_reference f
-  | c -> pr lsimpleconstr c
-
-let default_term_pr = {
-  pr_constr_expr   = pr_simpleconstr;
-  pr_lconstr_expr  = pr ltop;
-  pr_constr_pattern_expr  = pr_simpleconstr;
-  pr_lconstr_pattern_expr = pr ltop
-}
-
-let term_pr = ref default_term_pr
-
-let set_term_pr = (:=) term_pr
-
-let pr_constr_expr c   = !term_pr.pr_constr_expr   c
-let pr_lconstr_expr c  = !term_pr.pr_lconstr_expr  c
-let pr_constr_pattern_expr c  = !term_pr.pr_constr_pattern_expr  c
-let pr_lconstr_pattern_expr c = !term_pr.pr_lconstr_pattern_expr c
-
-let pr_cases_pattern_expr = pr_patt ltop
-
-let pr_binders = pr_undelimited_binders spc (pr ltop)
-
-let pr_with_occurrences pr occs =
-  match occs with
-    ((false,[]),c) -> pr c
-  | ((nowhere_except_in,nl),c) ->
-      hov 1 (pr c ++ spc() ++ str"at " ++
-        (if nowhere_except_in then mt() else str "- ") ++
-        hov 0 (prlist_with_sep spc (pr_or_var int) nl))
-
-let pr_red_flag pr r =
-  (if r.rBeta then pr_arg str "beta" else mt ()) ++
-  (if r.rIota then pr_arg str "iota" else mt ()) ++
-  (if r.rZeta then pr_arg str "zeta" else mt ()) ++
-  (if r.rConst = [] then
-     if r.rDelta then pr_arg str "delta"
-     else mt ()
-   else
-     pr_arg str "delta " ++ (if r.rDelta then str "-" else mt ()) ++
-     hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]"))
-
-open Genarg
-
-let pr_metaid id = str"?" ++ pr_id id
-
-let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) = function
-  | Red false -> str "red"
-  | Hnf -> str "hnf"
-  | Simpl o -> str "simpl" ++ pr_opt (pr_with_occurrences pr_pattern) o
-  | Cbv f ->
-      if f = {rBeta=true;rIota=true;rZeta=true;rDelta=true;rConst=[]} then
-	str "compute"
-      else
-	hov 1 (str "cbv" ++ pr_red_flag pr_ref f)
-  | Lazy f ->
-      hov 1 (str "lazy" ++ pr_red_flag pr_ref f)
-  | Unfold l ->
-      hov 1 (str "unfold" ++ spc() ++
-             prlist_with_sep pr_comma (pr_with_occurrences pr_ref) l)
-  | Fold l -> hov 1 (str "fold" ++ prlist (pr_arg pr_constr) l)
-  | Pattern l ->
-      hov 1 (str "pattern" ++
-        pr_arg (prlist_with_sep pr_comma (pr_with_occurrences pr_constr)) l)
-
-  | Red true -> error "Shouldn't be accessible from user."
-  | ExtraRedExpr s -> str s
-  | CbvVm -> str "vm_compute"
-
-let rec pr_may_eval test prc prlc pr2 pr3 = function
-  | ConstrEval (r,c) ->
-      hov 0
-        (str "eval" ++ brk (1,1) ++
-         pr_red_expr (prc,prlc,pr2,pr3) r ++
-	 str " in" ++ spc() ++ prc c)
-  | ConstrContext ((_,id),c) ->
-      hov 0
-	(str "context " ++ pr_id id ++ spc () ++
-	 str "[" ++ prlc c ++ str "]")
-  | ConstrTypeOf c -> hov 1 (str "type of" ++ spc() ++ prc c)
-  | ConstrTerm c when test c -> h 0 (str "(" ++ prc c ++ str ")")
-  | ConstrTerm c -> prc c
-
-let pr_may_eval a = pr_may_eval (fun _ -> false) a
diff --git a/parsing/ppconstr.mli b/parsing/ppconstr.mli
deleted file mode 100644
index bc3a6668..00000000
--- a/parsing/ppconstr.mli
+++ /dev/null
@@ -1,102 +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 Environ
-open Term
-open Libnames
-open Pcoq
-open Glob_term
-open Topconstr
-open Names
-open Util
-open Genarg
-
-val extract_lam_binders :
-  constr_expr -> local_binder list * constr_expr
-val extract_prod_binders :
-  constr_expr -> local_binder list * constr_expr
-val split_fix :
-  int -> constr_expr -> constr_expr ->
-  local_binder list *  constr_expr * constr_expr
-
-val prec_less : int -> int * Ppextend.parenRelation -> bool
-
-val pr_tight_coma : unit -> std_ppcmds
-
-val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
-val pr_metaid : identifier -> std_ppcmds
-
-val pr_lident : identifier located -> std_ppcmds
-val pr_lname : name located -> std_ppcmds
-
-val pr_with_comments : loc -> std_ppcmds -> std_ppcmds
-val pr_com_at : int -> std_ppcmds
-val pr_sep_com :
-  (unit -> std_ppcmds) ->
-  (constr_expr -> std_ppcmds) ->
-  constr_expr -> std_ppcmds
-
-val pr_id : identifier -> std_ppcmds
-val pr_name : name -> std_ppcmds
-val pr_qualid : qualid -> std_ppcmds
-val pr_patvar : patvar -> std_ppcmds
-
-val pr_with_occurrences :
-  ('a -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds
-val pr_red_expr :
-  ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) * ('c -> std_ppcmds) ->
-  ('a,'b,'c) red_expr_gen -> std_ppcmds
-val pr_may_eval :
-  ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
-  ('c -> std_ppcmds) -> ('a,'b,'c) may_eval -> std_ppcmds
-
-val pr_glob_sort : glob_sort -> std_ppcmds
-val pr_guard_annot : (constr_expr -> std_ppcmds) ->
-  local_binder list ->
-  ('a * Names.identifier) option * recursion_order_expr ->
-  std_ppcmds
-
-val pr_binders : local_binder list -> std_ppcmds
-val pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds
-val pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
-val pr_constr_expr : constr_expr -> std_ppcmds
-val pr_lconstr_expr : constr_expr -> std_ppcmds
-val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds
-
-type term_pr = {
-  pr_constr_expr   : constr_expr -> std_ppcmds;
-  pr_lconstr_expr  : constr_expr -> std_ppcmds;
-  pr_constr_pattern_expr  : constr_pattern_expr -> std_ppcmds;
-  pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
-}
-
-val set_term_pr : term_pr -> unit
-val default_term_pr : term_pr
-
-(** The modular constr printer.
-    [modular_constr_pr pr s p t] prints the head of the term [t] and calls
-    [pr] on its subterms.
-    [s] is typically {!Pp.mt} and [p] is [lsimpleconstr] for "constr" printers
-    and [ltop] for "lconstr" printers (spiwack: we might need more
-    specification here).
-    We can make a new modular constr printer by overriding certain branches,
-    for instance if we want to build a printer which prints "Prop" as "Omega"
-    instead we can proceed as follows:
-    let my_modular_constr_pr pr s p = function
-      | CSort (_,GProp Null) -> str "Omega"
-      | t -> modular_constr_pr pr s p t
-    Which has the same type. We can turn a modular printer into a printer by
-    taking its fixpoint. *)
-
-type precedence
-val lsimpleconstr : precedence
-val ltop : precedence
-val modular_constr_pr :
-               ((unit->std_ppcmds) -> precedence -> constr_expr -> std_ppcmds) ->
-                (unit->std_ppcmds) -> precedence  -> constr_expr -> std_ppcmds
diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml
deleted file mode 100644
index fa573c8a..00000000
--- a/parsing/pptactic.ml
+++ /dev/null
@@ -1,1072 +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 Names
-open Namegen
-open Util
-open Tacexpr
-open Glob_term
-open Topconstr
-open Genarg
-open Libnames
-open Pattern
-open Ppextend
-open Ppconstr
-open Printer
-
-let pr_global x = Nametab.pr_global_env Idset.empty x
-
-type grammar_terminals = string option list
-
-  (* Extensions *)
-let prtac_tab = Hashtbl.create 17
-
-let declare_extra_tactic_pprule (s,tags,prods) =
-  Hashtbl.add prtac_tab (s,tags) prods
-
-let exists_extra_tactic_pprule s tags = Hashtbl.mem prtac_tab (s,tags)
-
-type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) ->
-    (constr_expr -> std_ppcmds) ->
-    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a glob_extra_genarg_printer =
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) ->
-    (Term.constr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-let genarg_pprule = ref Stringmap.empty
-
-let declare_extra_genarg_pprule (rawwit, f) (globwit, g) (wit, h) =
-  let s = match unquote wit with
-    | ExtraArgType s -> s
-    | _ -> error
-	"Can declare a pretty-printing rule only for extra argument types."
-  in
-  let f prc prlc prtac x = f prc prlc prtac (out_gen rawwit x) in
-  let g prc prlc prtac x = g prc prlc prtac (out_gen globwit x) in
-  let h prc prlc prtac x = h prc prlc prtac (out_gen wit x) in
-  genarg_pprule := Stringmap.add s (f,g,h) !genarg_pprule
-
-let pr_arg pr x = spc () ++ pr x
-
-let pr_or_var pr = function
-  | ArgArg x -> pr x
-  | ArgVar (_,s) -> pr_id s
-
-let pr_or_metaid pr = function
-  | AI x -> pr x
-  | _ -> failwith "pr_hyp_location: unexpected quotation meta-variable"
-
-let pr_and_short_name pr (c,_) = pr c
-
-let pr_or_by_notation f = function
-  | AN v -> f v
-  | ByNotation (_,s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
-
-let pr_located pr (loc,x) = pr x
-
-let pr_evaluable_reference = function
-  | EvalVarRef id -> pr_id id
-  | EvalConstRef sp -> pr_global (Libnames.ConstRef sp)
-
-let pr_quantified_hypothesis = function
-  | AnonHyp n -> int n
-  | NamedHyp id -> pr_id id
-
-let pr_binding prc = function
-  | loc, NamedHyp id, c -> hov 1 (pr_id id ++ str " := " ++ cut () ++ prc c)
-  | loc, AnonHyp n, c -> hov 1 (int n ++ str " := " ++ cut () ++ prc c)
-
-let pr_bindings prc prlc = function
-  | ImplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-      prlist_with_sep spc prc l
-  | ExplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-        prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
-  | NoBindings -> mt ()
-
-let pr_bindings_no_with prc prlc = function
-  | ImplicitBindings l ->
-      brk (1,1) ++
-      prlist_with_sep spc prc l
-  | ExplicitBindings l ->
-      brk (1,1) ++
-        prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
-  | NoBindings -> mt ()
-
-let pr_with_bindings prc prlc (c,bl) =
-  prc c ++ hv 0 (pr_bindings prc prlc bl)
-
-let pr_with_constr prc = function
-  | None -> mt ()
-  | Some c -> spc () ++ hov 1 (str "with" ++ spc () ++ prc c)
-
-let rec pr_message_token prid = function
-  | MsgString s -> qs s
-  | MsgInt n -> int n
-  | MsgIdent id -> prid id
-
-let pr_fresh_ids = prlist (fun s -> spc() ++ pr_or_var qs s)
-
-let with_evars ev s = if ev then "e" ^ s else s
-
-let if_pattern_ident b pr c = (if b then str "?" else mt()) ++ pr c
-
-let rec pr_raw_generic prc prlc prtac prpat prref (x:Genarg.rlevel Genarg.generic_argument) =
-  match Genarg.genarg_tag x with
-  | BoolArgType -> str (if out_gen rawwit_bool x then "true" else "false")
-  | IntArgType -> int (out_gen rawwit_int x)
-  | IntOrVarArgType -> pr_or_var pr_int (out_gen rawwit_int_or_var x)
-  | StringArgType -> str "\"" ++ str (out_gen rawwit_string x) ++ str "\""
-  | PreIdentArgType -> str (out_gen rawwit_pre_ident x)
-  | IntroPatternArgType -> pr_intro_pattern (out_gen rawwit_intro_pattern x)
-  | IdentArgType b -> if_pattern_ident b pr_id (out_gen rawwit_ident x)
-  | VarArgType -> pr_located pr_id (out_gen rawwit_var x)
-  | RefArgType -> prref (out_gen rawwit_ref x)
-  | SortArgType -> pr_glob_sort (out_gen rawwit_sort x)
-  | ConstrArgType -> prc (out_gen rawwit_constr x)
-  | ConstrMayEvalArgType ->
-      pr_may_eval prc prlc (pr_or_by_notation prref) prpat
-        (out_gen rawwit_constr_may_eval x)
-  | QuantHypArgType -> pr_quantified_hypothesis (out_gen rawwit_quant_hyp x)
-  | RedExprArgType ->
-      pr_red_expr (prc,prlc,pr_or_by_notation prref,prpat)
-        (out_gen rawwit_red_expr x)
-  | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (rawwit_open_constr_gen (b1,b2)) x))
-  | ConstrWithBindingsArgType ->
-      pr_with_bindings prc prlc (out_gen rawwit_constr_with_bindings x)
-  | BindingsArgType ->
-      pr_bindings_no_with prc prlc (out_gen rawwit_bindings x)
-  | List0ArgType _ ->
-      hov 0 (pr_sequence (pr_raw_generic prc prlc prtac prpat prref)
-	(fold_list0 (fun a l -> a::l) x []))
-  | List1ArgType _ ->
-      hov 0 (pr_sequence (pr_raw_generic prc prlc prtac prpat prref)
-	(fold_list1 (fun a l -> a::l) x []))
-  | OptArgType _ -> hov 0 (fold_opt (pr_raw_generic prc prlc prtac prpat prref) (mt()) x)
-  | PairArgType _ ->
-      hov 0
-        (fold_pair
-	  (fun a b -> pr_sequence (pr_raw_generic prc prlc prtac prpat prref)
-            [a;b])
-	  x)
-  | ExtraArgType s ->
-      try pi1 (Stringmap.find s !genarg_pprule) prc prlc prtac x
-      with Not_found -> str "[no printer for " ++ str s ++ str "]"
-
-
-let rec pr_glob_generic prc prlc prtac prpat x =
-  match Genarg.genarg_tag x with
-  | BoolArgType -> str (if out_gen globwit_bool x then "true" else "false")
-  | IntArgType -> int (out_gen globwit_int x)
-  | IntOrVarArgType -> pr_or_var pr_int (out_gen globwit_int_or_var x)
-  | StringArgType -> str "\"" ++ str (out_gen globwit_string x) ++ str "\""
-  | PreIdentArgType -> str (out_gen globwit_pre_ident x)
-  | IntroPatternArgType -> pr_intro_pattern (out_gen globwit_intro_pattern x)
-  | IdentArgType b -> if_pattern_ident b pr_id (out_gen globwit_ident x)
-  | VarArgType -> pr_located pr_id (out_gen globwit_var x)
-  | RefArgType -> pr_or_var (pr_located pr_global) (out_gen globwit_ref x)
-  | SortArgType -> pr_glob_sort (out_gen globwit_sort x)
-  | ConstrArgType -> prc (out_gen globwit_constr x)
-  | ConstrMayEvalArgType ->
-      pr_may_eval prc prlc
-        (pr_or_var (pr_and_short_name pr_evaluable_reference)) prpat
-        (out_gen globwit_constr_may_eval x)
-  | QuantHypArgType ->
-      pr_quantified_hypothesis (out_gen globwit_quant_hyp x)
-  | RedExprArgType ->
-      pr_red_expr
-        (prc,prlc,pr_or_var (pr_and_short_name pr_evaluable_reference),prpat)
-        (out_gen globwit_red_expr x)
-  | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (globwit_open_constr_gen (b1,b2)) x))
-  | ConstrWithBindingsArgType ->
-      pr_with_bindings prc prlc (out_gen globwit_constr_with_bindings x)
-  | BindingsArgType ->
-      pr_bindings_no_with prc prlc (out_gen globwit_bindings x)
-  | List0ArgType _ ->
-      hov 0 (pr_sequence (pr_glob_generic prc prlc prtac prpat)
-	(fold_list0 (fun a l -> a::l) x []))
-  | List1ArgType _ ->
-      hov 0 (pr_sequence (pr_glob_generic prc prlc prtac prpat)
-	(fold_list1 (fun a l -> a::l) x []))
-  | OptArgType _ -> hov 0 (fold_opt (pr_glob_generic prc prlc prtac prpat) (mt()) x)
-  | PairArgType _ ->
-      hov 0
-        (fold_pair
-	  (fun a b -> pr_sequence (pr_glob_generic prc prlc prtac prpat) [a;b])
-	  x)
-  | ExtraArgType s ->
-      try pi2 (Stringmap.find s !genarg_pprule) prc prlc prtac x
-      with Not_found -> str "[no printer for " ++ str s ++ str "]"
-
-open Closure
-
-let rec pr_generic prc prlc prtac prpat x =
-  match Genarg.genarg_tag x with
-  | BoolArgType -> str (if out_gen wit_bool x then "true" else "false")
-  | IntArgType -> int (out_gen wit_int x)
-  | IntOrVarArgType -> pr_or_var pr_int (out_gen wit_int_or_var x)
-  | StringArgType -> str "\"" ++ str (out_gen wit_string x) ++ str "\""
-  | PreIdentArgType -> str (out_gen wit_pre_ident x)
-  | IntroPatternArgType -> pr_intro_pattern (out_gen wit_intro_pattern x)
-  | IdentArgType b -> if_pattern_ident b pr_id (out_gen wit_ident x)
-  | VarArgType -> pr_id (out_gen wit_var x)
-  | RefArgType -> pr_global (out_gen wit_ref x)
-  | SortArgType -> pr_sort (out_gen wit_sort x)
-  | ConstrArgType -> prc (out_gen wit_constr x)
-  | ConstrMayEvalArgType -> prc (out_gen wit_constr_may_eval x)
-  | QuantHypArgType -> pr_quantified_hypothesis (out_gen wit_quant_hyp x)
-  | RedExprArgType ->
-      pr_red_expr (prc,prlc,pr_evaluable_reference,prpat)
-        (out_gen wit_red_expr x)
-  | OpenConstrArgType (b1,b2) -> prc (snd (out_gen (wit_open_constr_gen (b1,b2)) x))
-  | ConstrWithBindingsArgType ->
-      let (c,b) = (out_gen wit_constr_with_bindings x).Evd.it in
-      pr_with_bindings prc prlc (c,b)
-  | BindingsArgType ->
-      pr_bindings_no_with prc prlc (out_gen wit_bindings x).Evd.it
-  | List0ArgType _ ->
-      hov 0 (pr_sequence (pr_generic prc prlc prtac prpat)
-	(fold_list0 (fun a l -> a::l) x []))
-  | List1ArgType _ ->
-      hov 0 (pr_sequence (pr_generic prc prlc prtac prpat)
-	(fold_list1 (fun a l -> a::l) x []))
-  | OptArgType _ -> hov 0 (fold_opt (pr_generic prc prlc prtac prpat) (mt()) x)
-  | PairArgType _ ->
-      hov 0
-        (fold_pair (fun a b -> pr_sequence (pr_generic prc prlc prtac prpat)
-          [a;b])
-	  x)
-  | ExtraArgType s ->
-      try pi3 (Stringmap.find s !genarg_pprule) prc prlc prtac x
-      with Not_found -> str "[no printer for " ++ str s ++ str "]"
-
-let rec tacarg_using_rule_token pr_gen = function
-  | Some s :: l, al -> str s :: tacarg_using_rule_token pr_gen (l,al)
-  | None :: l, a :: al ->
-      let print_it =
-        match genarg_tag a with
-        | OptArgType _ -> fold_opt (fun _ -> true) false a
-        | _ -> true
-      in
-      let r = tacarg_using_rule_token pr_gen (l,al) in
-      if print_it then pr_gen a :: r else r
-  | [], [] -> []
-  | _ -> failwith "Inconsistent arguments of extended tactic"
-
-let pr_tacarg_using_rule pr_gen l=
-  pr_sequence (fun x -> x) (tacarg_using_rule_token pr_gen l)
-
-let pr_extend_gen pr_gen lev s l =
-  try
-    let tags = List.map genarg_tag l in
-    let (lev',pl) = Hashtbl.find prtac_tab (s,tags) in
-    let p = pr_tacarg_using_rule pr_gen (pl,l) in
-    if lev' > lev then surround p else p
-  with Not_found ->
-    str s ++ spc() ++ pr_sequence pr_gen l ++ str" (* Generic printer *)"
-
-let pr_raw_extend prc prlc prtac prpat =
-  pr_extend_gen (pr_raw_generic prc prlc prtac prpat pr_reference)
-let pr_glob_extend prc prlc prtac prpat =
-  pr_extend_gen (pr_glob_generic prc prlc prtac prpat)
-let pr_extend prc prlc prtac prpat =
-  pr_extend_gen (pr_generic prc prlc prtac prpat)
-
-(**********************************************************************)
-(* The tactic printer                                                 *)
-
-let strip_prod_binders_expr n ty =
-  let rec strip_ty acc n ty =
-    match ty with
-        Topconstr.CProdN(_,bll,a) ->
-          let nb =
-            List.fold_left (fun i (nal,_,_) -> i + List.length nal) 0 bll in
-	  let bll = List.map (fun (x, _, y) -> x, y) bll in
-            if nb >= n then (List.rev (bll@acc)), a
-            else strip_ty (bll@acc) (n-nb) a
-      | Topconstr.CArrow(_,a,b) ->
-          if n=1 then
-            (List.rev (([(dummy_loc,Anonymous)],a)::acc), b)
-          else strip_ty (([(dummy_loc,Anonymous)],a)::acc) (n-1) b
-      | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-let pr_ltac_or_var pr = function
-  | ArgArg x -> pr x
-  | ArgVar (loc,id) -> pr_with_comments loc (pr_id id)
-
-let pr_ltac_constant sp =
-  pr_qualid (Nametab.shortest_qualid_of_tactic sp)
-
-let pr_evaluable_reference_env env = function
-  | EvalVarRef id -> pr_id id
-  | EvalConstRef sp ->
-      Nametab.pr_global_env (Termops.vars_of_env env) (Libnames.ConstRef sp)
-
-let pr_esubst prc l =
-  let pr_qhyp = function
-      (_,AnonHyp n,c) -> str "(" ++ int n ++ str" := " ++ prc c ++ str ")"
-    | (_,NamedHyp id,c) ->
-        str "(" ++ pr_id id ++ str" := " ++ prc c ++ str ")"
-  in
-  prlist_with_sep spc pr_qhyp l
-
-let pr_bindings_gen for_ex prlc prc = function
-  | ImplicitBindings l ->
-      spc () ++
-      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
-            prlist_with_sep spc prc l)
-  | ExplicitBindings l ->
-      spc () ++
-      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
-            pr_esubst prlc l)
-  | NoBindings -> mt ()
-
-let pr_bindings prlc prc = pr_bindings_gen false prlc prc
-
-let pr_with_bindings prlc prc (c,bl) =
-  hov 1 (prc c ++ pr_bindings prlc prc bl)
-
-let pr_as_ipat pat = str "as " ++ pr_intro_pattern pat
-let pr_eqn_ipat pat = str "eqn:" ++ pr_intro_pattern pat
-
-let pr_with_induction_names = function
-  | None, None -> mt ()
-  | Some eqpat, None -> spc () ++ hov 1 (pr_eqn_ipat eqpat)
-  | None, Some ipat -> spc () ++ hov 1 (pr_as_ipat ipat)
-  | Some eqpat, Some ipat ->
-    spc () ++ hov 1 (pr_as_ipat ipat ++ spc () ++ pr_eqn_ipat eqpat)
-
-let pr_as_intro_pattern ipat =
-  spc () ++ hov 1 (str "as" ++ spc () ++ pr_intro_pattern ipat)
-
-let pr_with_inversion_names = function
-  | None -> mt ()
-  | Some ipat -> pr_as_intro_pattern ipat
-
-let pr_as_ipat = function
-  | None -> mt ()
-  | Some ipat -> pr_as_intro_pattern ipat
-
-let pr_as_name = function
-  | Anonymous -> mt ()
-  | Name id -> str " as " ++ pr_lident (dummy_loc,id)
-
-let pr_pose_as_style prc na c =
-  spc() ++ prc c ++ pr_as_name na
-
-let pr_pose prlc prc na c = match na with
-  | Anonymous -> spc() ++ prc c
-  | Name id -> spc() ++ surround (pr_id id ++ str " :=" ++ spc() ++ prlc c)
-
-let pr_assertion _prlc prc ipat c = match ipat with
-(* Use this "optimisation" or use only the general case ?
-  | IntroIdentifier id ->
-      spc() ++ surround (pr_intro_pattern ipat ++ str " :" ++ spc() ++ prlc c)
-*)
-  | ipat ->
-      spc() ++ prc c ++ pr_as_ipat ipat
-
-let pr_assumption prlc prc ipat c = match ipat with
-(* Use this "optimisation" or use only the general case ?
-  | IntroIdentifier id ->
-      spc() ++ surround (pr_intro_pattern ipat ++ str " :" ++ spc() ++ prlc c)
-*)
-  | ipat ->
-      spc() ++ prc c ++ pr_as_ipat ipat
-
-let pr_by_tactic prt = function
-  | TacId [] -> mt ()
-  | tac -> spc() ++ str "by " ++ prt tac
-
-let pr_hyp_location pr_id = function
-  | occs, Termops.InHyp -> spc () ++ pr_with_occurrences pr_id occs
-  | occs, Termops.InHypTypeOnly ->
-      spc () ++
-      pr_with_occurrences (fun id -> str "(type of " ++ pr_id id ++ str ")") occs
-  | occs, Termops.InHypValueOnly ->
-      spc () ++
-      pr_with_occurrences (fun id -> str "(value of " ++ pr_id id ++ str ")") occs
-
-let pr_in pp = spc () ++ hov 0 (str "in" ++ pp)
-
-let pr_simple_hyp_clause pr_id = function
-  | [] -> mt ()
-  | l -> pr_in (spc () ++ prlist_with_sep spc pr_id l)
-
-let pr_in_hyp_as pr_id = function
-  | None -> mt ()
-  | Some (id,ipat) -> pr_simple_hyp_clause pr_id [id] ++ pr_as_ipat ipat
-
-let pr_clauses default_is_concl pr_id = function
-  | { onhyps=Some []; concl_occs=occs }
-      when occs = all_occurrences_expr & default_is_concl = Some true -> mt ()
-  | { onhyps=None; concl_occs=occs }
-      when occs = all_occurrences_expr & default_is_concl = Some false -> mt ()
-  | { onhyps=None; concl_occs=occs } ->
-      if occs = no_occurrences_expr then pr_in (str " * |-")
-      else pr_in (pr_with_occurrences (fun () -> str " *") (occs,()))
-  | { onhyps=Some l; concl_occs=occs } ->
-      pr_in
-        (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l ++
-	 (if occs = no_occurrences_expr then mt ()
-	  else pr_with_occurrences (fun () -> str" |- *") (occs,())))
-
-let pr_orient b = if b then mt () else str "<- "
-
-let pr_multi = function
-  | Precisely 1 -> mt ()
-  | Precisely n -> pr_int n ++ str "!"
-  | UpTo n -> pr_int n ++ str "?"
-  | RepeatStar -> str "?"
-  | RepeatPlus -> str "!"
-
-let pr_induction_arg prlc prc = function
-  | ElimOnConstr c -> pr_with_bindings prlc prc c
-  | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id)
-  | ElimOnAnonHyp n -> int n
-
-let pr_induction_kind = function
-  | SimpleInversion -> str "simple inversion"
-  | FullInversion -> str "inversion"
-  | FullInversionClear -> str "inversion_clear"
-
-let pr_lazy lz = if lz then str "lazy" else mt ()
-
-let pr_match_pattern pr_pat = function
-  | Term a -> pr_pat a
-  | Subterm (b,None,a) -> (if b then str"appcontext [" else str "context [") ++ pr_pat a ++ str "]"
-  | Subterm (b,Some id,a) ->
-      (if b then str"appcontext " else str "context ") ++ pr_id id ++ str "[" ++ pr_pat a ++ str "]"
-
-let pr_match_hyps pr_pat = function
-  | Hyp (nal,mp) ->
-      pr_lname nal ++ str ":" ++ pr_match_pattern pr_pat mp
-  | Def (nal,mv,mp) ->
-      pr_lname nal ++ str ":=" ++ pr_match_pattern pr_pat mv
-      ++ str ":" ++ pr_match_pattern pr_pat mp
-
-let pr_match_rule m pr pr_pat = function
-  | Pat ([],mp,t) when m ->
-      pr_match_pattern pr_pat mp ++
-      spc () ++ str "=>" ++ brk (1,4) ++ pr t
-(*
-  | Pat (rl,mp,t) ->
-      hv 0 (prlist_with_sep pr_comma (pr_match_hyps pr_pat) rl ++
-        (if rl <> [] then spc () else mt ()) ++
-         hov 0 (str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++
-	 str "=>" ++ brk (1,4) ++ pr t))
-*)
-  | Pat (rl,mp,t) ->
-      hov 0 (
-	hv 0 (prlist_with_sep pr_comma (pr_match_hyps pr_pat) rl) ++
-        (if rl <> [] then spc () else mt ()) ++
-        hov 0 (
-	  str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++
-	  str "=>" ++ brk (1,4) ++ pr t))
-  | All t -> str "_" ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t
-
-let pr_funvar = function
-  | None -> spc () ++ str "_"
-  | Some id -> spc () ++ pr_id id
-
-let pr_let_clause k pr (id,(bl,t)) =
-  hov 0 (str k ++ pr_lident id ++ prlist pr_funvar bl ++
-         str " :=" ++ brk (1,1) ++ pr (TacArg (dummy_loc,t)))
-
-let pr_let_clauses recflag pr = function
-  | hd::tl ->
-      hv 0
-        (pr_let_clause (if recflag then "let rec " else "let ") pr hd ++
-         prlist (fun t -> spc () ++ pr_let_clause "with " pr t) tl)
-  | [] -> anomaly "LetIn must declare at least one binding"
-
-let pr_seq_body pr tl =
-  hv 0 (str "[ " ++
-        prlist_with_sep (fun () -> spc () ++ str "| ") pr tl ++
-        str " ]")
-
-let pr_opt_tactic pr = function
-  | TacId [] -> mt ()
-  | t -> pr t
-
-let pr_then_gen pr tf tm tl =
-  hv 0 (str "[ " ++
-        prvect_with_sep mt (fun t -> pr t ++ spc () ++ str "| ") tf ++
-	pr_opt_tactic pr tm ++ str ".." ++
-	prvect_with_sep mt (fun t -> spc () ++ str "| " ++ pr t) tl ++
-        str " ]")
-
-let pr_hintbases = function
-  | None -> spc () ++ str "with *"
-  | Some [] -> mt ()
-  | Some l ->
-      spc () ++ hov 2 (str "with" ++ prlist (fun s -> spc () ++ str s) l)
-
-let pr_auto_using prc = function
-  | [] -> mt ()
-  | l -> spc () ++
-      hov 2 (str "using" ++ spc () ++ prlist_with_sep pr_comma prc l)
-
-let string_of_debug = function
-  | Off -> ""
-  | Debug -> "debug "
-  | Info -> "info_"
-
-let pr_then () = str ";"
-
-let ltop = (5,E)
-let lseq = 4
-let ltactical = 3
-let lorelse = 2
-let llet = 5
-let lfun = 5
-let lcomplete = 1
-let labstract = 3
-let lmatch = 1
-let latom = 0
-let lcall = 1
-let leval = 1
-let ltatom = 1
-let linfo = 5
-
-let level_of (n,p) = match p with E -> n | L -> n-1 | Prec n -> n | Any -> lseq
-
-open Closure
-
-(** A printer for tactics that polymorphically works on the three
-    "raw", "glob" and "typed" levels; in practice, the environment is
-    used only at the glob and typed level: it is used to feed the
-    constr printers *)
-
-let make_pr_tac
-  (pr_tac_level,pr_constr,pr_lconstr,pr_pat,
-   pr_cst,pr_ind,pr_ref,pr_ident,
-   pr_extend,strip_prod_binders) env =
-
-(* The environment is not used by the tactic printer: it is passed to the
-   constr and cst printers; hence we can make some abbreviations *)
-let pr_constr = pr_constr env in
-let pr_lconstr = pr_lconstr env in
-let pr_lpat = pr_pat true in
-let pr_pat = pr_pat false in
-let pr_cst = pr_cst env in
-let pr_ind = pr_ind env in
-let pr_tac_level = pr_tac_level env in
-
-(* Other short cuts *)
-let pr_bindings = pr_bindings pr_lconstr pr_constr in
-let pr_ex_bindings = pr_bindings_gen true pr_lconstr pr_constr in
-let pr_with_bindings = pr_with_bindings pr_lconstr pr_constr in
-let pr_extend = pr_extend pr_constr pr_lconstr pr_tac_level pr_pat in
-let pr_red_expr = pr_red_expr (pr_constr,pr_lconstr,pr_cst,pr_pat) in
-
-let pr_constrarg c = spc () ++ pr_constr c in
-let pr_lconstrarg c = spc () ++ pr_lconstr c in
-let pr_intarg n = spc () ++ int n in
-
-(* Some printing combinators *)
-let pr_eliminator cb = str "using" ++ pr_arg pr_with_bindings cb in
-
-let extract_binders = function
-  | Tacexp (TacFun (lvar,body)) -> (lvar,Tacexp body)
-  | body -> ([],body) in
-
-let pr_binder_fix (nal,t) =
-(*  match t with
-  | CHole _ -> spc() ++ prlist_with_sep spc (pr_lname) nal
-  | _ ->*)
-    let s = prlist_with_sep spc pr_lname nal ++ str ":" ++ pr_lconstr t in
-    spc() ++ hov 1 (str"(" ++ s ++ str")") in
-
-let pr_fix_tac (id,n,c) =
-  let rec set_nth_name avoid n = function
-      (nal,ty)::bll ->
-        if n <= List.length nal then
-          match list_chop (n-1) nal with
-              _, (_,Name id) :: _ -> id, (nal,ty)::bll
-            | bef, (loc,Anonymous) :: aft ->
-                let id = next_ident_away (id_of_string"y") avoid in
-                id, ((bef@(loc,Name id)::aft, ty)::bll)
-            | _ -> assert false
-        else
-          let (id,bll') = set_nth_name avoid (n-List.length nal) bll in
-          (id,(nal,ty)::bll')
-    | [] -> assert false in
-  let (bll,ty) = strip_prod_binders n c in
-  let names =
-    List.fold_left
-      (fun ln (nal,_) -> List.fold_left
-          (fun ln na -> match na with (_,Name id) -> id::ln | _ -> ln)
-          ln nal)
-      [] bll in
-  let idarg,bll = set_nth_name names n bll in
-  let annot =
-    if List.length names = 1 then mt()
-    else spc() ++ str"{struct " ++ pr_id idarg ++ str"}" in
-  hov 1 (str"(" ++ pr_id id ++
-        prlist pr_binder_fix bll ++ annot ++ str" :" ++
-        pr_lconstrarg ty ++ str")") in
-(*  spc() ++
-  hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ pr_constrarg
-    c)
-*)
-let pr_cofix_tac (id,c) =
-  hov 1 (str"(" ++ pr_id id ++ str" :" ++ pr_lconstrarg c ++ str")") in
-
-  (* Printing tactics as arguments *)
-let rec pr_atom0 = function
-  | TacIntroPattern [] -> str "intros"
-  | TacIntroMove (None,hto) when hto = no_move -> str "intro"
-  | TacAssumption -> str "assumption"
-  | TacAnyConstructor (false,None) -> str "constructor"
-  | TacAnyConstructor (true,None) -> str "econstructor"
-  | TacTrivial (d,[],Some []) -> str (string_of_debug d ^ "trivial")
-  | TacAuto (d,None,[],Some []) -> str (string_of_debug d ^ "auto")
-  | TacReflexivity -> str "reflexivity"
-  | TacClear (true,[]) -> str "clear"
-  | t -> str "(" ++ pr_atom1 t ++ str ")"
-
-  (* Main tactic printer *)
-and pr_atom1 = function
-  | TacExtend (loc,s,l) ->
-      pr_with_comments loc (pr_extend 1 s l)
-  | TacAlias (loc,s,l,_) ->
-      pr_with_comments loc (pr_extend 1 s (List.map snd l))
-
-  (* Basic tactics *)
-  | TacIntroPattern [] as t -> pr_atom0 t
-  | TacIntroPattern (_::_ as p) ->
-      hov 1 (str "intros" ++ spc () ++ prlist_with_sep spc pr_intro_pattern p)
-  | TacIntrosUntil h ->
-      hv 1 (str "intros until" ++ pr_arg pr_quantified_hypothesis h)
-  | TacIntroMove (None,hto) as t when hto = no_move -> pr_atom0 t
-  | TacIntroMove (Some id,hto) when hto = no_move -> str "intro " ++ pr_id id
-  | TacIntroMove (ido,hto) ->
-      hov 1 (str"intro" ++ pr_opt pr_id ido ++ pr_move_location pr_ident hto)
-  | TacAssumption as t -> pr_atom0 t
-  | TacExact c -> hov 1 (str "exact" ++ pr_constrarg c)
-  | TacExactNoCheck c -> hov 1 (str "exact_no_check" ++ pr_constrarg c)
-  | TacVmCastNoCheck c -> hov 1 (str "vm_cast_no_check" ++ pr_constrarg c)
-  | TacApply (a,ev,cb,inhyp) ->
-      hov 1 ((if a then mt() else str "simple ") ++
-             str (with_evars ev "apply") ++ spc () ++
-             prlist_with_sep pr_comma pr_with_bindings cb ++
-             pr_in_hyp_as pr_ident inhyp)
-  | TacElim (ev,cb,cbo) ->
-      hov 1 (str (with_evars ev "elim") ++ pr_arg pr_with_bindings cb ++
-        pr_opt pr_eliminator cbo)
-  | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg c)
-  | TacCase (ev,cb) ->
-      hov 1 (str (with_evars ev "case") ++ spc () ++ pr_with_bindings cb)
-  | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg c)
-  | TacFix (ido,n) -> hov 1 (str "fix" ++ pr_opt pr_id ido ++ pr_intarg n)
-  | TacMutualFix (hidden,id,n,l) ->
-      if hidden then str "idtac" (* should caught before! *) else
-      hov 1 (str "fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc() ++
-             str"with " ++ prlist_with_sep spc pr_fix_tac l)
-  | TacCofix ido -> hov 1 (str "cofix" ++ pr_opt pr_id ido)
-  | TacMutualCofix (hidden,id,l) ->
-      if hidden then str "idtac" (* should be caught before! *) else
-      hov 1 (str "cofix" ++ spc () ++ pr_id id ++ spc() ++
-             str"with " ++ prlist_with_sep spc pr_cofix_tac l)
-  | TacCut c -> hov 1 (str "cut" ++ pr_constrarg c)
-  | TacAssert (Some tac,ipat,c) ->
-      hov 1 (str "assert" ++
-             pr_assumption pr_lconstr pr_constr ipat c ++
-             pr_by_tactic (pr_tac_level ltop) tac)
-  | TacAssert (None,ipat,c) ->
-      hov 1 (str "pose proof" ++
-             pr_assertion pr_lconstr pr_constr ipat c)
-  | TacGeneralize l ->
-      hov 1 (str "generalize" ++ spc () ++
-             prlist_with_sep pr_comma (fun (cl,na) ->
-	       pr_with_occurrences pr_constr cl ++ pr_as_name na)
-	     l)
-  | TacGeneralizeDep c ->
-      hov 1 (str "generalize" ++ spc () ++ str "dependent" ++
-             pr_constrarg c)
-  | TacLetTac (na,c,cl,true,_) when cl = nowhere ->
-      hov 1 (str "pose" ++ pr_pose pr_lconstr pr_constr na c)
-  | TacLetTac (na,c,cl,b,e) ->
-      hov 1 ((if b then str "set" else str "remember") ++
-             (if b then pr_pose pr_lconstr else pr_pose_as_style)
-	        pr_constr na c ++
-             pr_opt (fun p -> pr_eqn_ipat p ++ spc ()) e ++
-             pr_clauses (Some b) pr_ident cl)
-(*  | TacInstantiate (n,c,ConclLocation ()) ->
-      hov 1 (str "instantiate" ++ spc() ++
-             hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++
-                    pr_lconstrarg c ++ str ")" ))
-  | TacInstantiate (n,c,HypLocation (id,hloc)) ->
-      hov 1 (str "instantiate" ++ spc() ++
-             hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++
-                    pr_lconstrarg c ++ str ")" )
-	     ++ str "in" ++ pr_hyp_location pr_ident (id,[],(hloc,ref None)))
-*)
-  (* Derived basic tactics *)
-  | TacSimpleInductionDestruct (isrec,h) ->
-      hov 1 (str "simple " ++ str (if isrec then "induction" else "destruct")
-             ++ pr_arg pr_quantified_hypothesis h)
-  | TacInductionDestruct (isrec,ev,(l,el,cl)) ->
-      hov 1 (str (with_evars ev (if isrec then "induction" else "destruct")) ++
-             spc () ++
-             prlist_with_sep pr_comma (fun (h,ids) ->
-	       pr_induction_arg pr_lconstr pr_constr h ++
-	       pr_with_induction_names ids) l ++
-             pr_opt pr_eliminator el ++
-	     pr_opt_no_spc (pr_clauses None pr_ident) cl)
-  | TacDoubleInduction (h1,h2) ->
-      hov 1
-        (str "double induction" ++
-         pr_arg pr_quantified_hypothesis h1 ++
- 	 pr_arg pr_quantified_hypothesis h2)
-  | TacDecomposeAnd c ->
-      hov 1 (str "decompose record" ++ pr_constrarg c)
-  | TacDecomposeOr c ->
-      hov 1 (str "decompose sum" ++ pr_constrarg c)
-  | TacDecompose (l,c) ->
-      hov 1 (str "decompose" ++ spc () ++
-        hov 0 (str "[" ++ prlist_with_sep spc pr_ind l
-	  ++ str "]" ++ pr_constrarg c))
-  | TacSpecialize (n,c) ->
-      hov 1 (str "specialize" ++ spc () ++ pr_opt int n ++
-             pr_with_bindings c)
-  | TacLApply c ->
-      hov 1 (str "lapply" ++ pr_constrarg c)
-
-  (* Automation tactics *)
-  | TacTrivial (_,[],Some []) as x -> pr_atom0 x
-  | TacTrivial (d,lems,db) ->
-      hov 0 (str (string_of_debug d ^ "trivial") ++
-             pr_auto_using pr_constr lems ++ pr_hintbases db)
-  | TacAuto (_,None,[],Some []) as x -> pr_atom0 x
-  | TacAuto (d,n,lems,db) ->
-      hov 0 (str (string_of_debug d ^ "auto") ++
-	     pr_opt (pr_or_var int) n ++
-             pr_auto_using pr_constr lems ++ pr_hintbases db)
-
-  (* Context management *)
-  | TacClear (true,[]) as t -> pr_atom0 t
-  | TacClear (keep,l) ->
-      hov 1 (str "clear" ++ spc () ++ (if keep then str "- " else mt ()) ++
-             prlist_with_sep spc pr_ident l)
-  | TacClearBody l ->
-      hov 1 (str "clearbody" ++ spc () ++ prlist_with_sep spc pr_ident l)
-  | TacMove (b,id1,id2) ->
-      (* Rem: only b = true is available for users *)
-      assert b;
-      hov 1
-        (str "move" ++ brk (1,1) ++ pr_ident id1 ++
-	 pr_move_location pr_ident id2)
-  | TacRename l ->
-      hov 1
-        (str "rename" ++ brk (1,1) ++
-         prlist_with_sep
-	   (fun () -> str "," ++ brk (1,1))
-	   (fun (i1,i2) ->
-	      pr_ident i1 ++ spc () ++ str "into" ++ spc () ++ pr_ident i2)
-	   l)
-  | TacRevert l ->
-      hov 1 (str "revert" ++ spc () ++ prlist_with_sep spc pr_ident l)
-
-  (* Constructors *)
-  | TacLeft (ev,l) -> hov 1 (str (with_evars ev "left") ++ pr_bindings l)
-  | TacRight (ev,l) -> hov 1 (str (with_evars ev "right") ++ pr_bindings l)
-  | TacSplit (ev,false,l) -> hov 1 (str (with_evars ev "split") ++ prlist_with_sep pr_comma pr_bindings l)
-  | TacSplit (ev,true,l) -> hov 1 (str (with_evars ev "exists") ++ prlist_with_sep (fun () -> str",") pr_ex_bindings l)
-  | TacAnyConstructor (ev,Some t) ->
-      hov 1 (str (with_evars ev "constructor") ++ pr_arg (pr_tac_level (latom,E)) t)
-  | TacAnyConstructor (ev,None) as t -> pr_atom0 t
-  | TacConstructor (ev,n,l) ->
-      hov 1 (str (with_evars ev "constructor") ++
-             pr_or_var pr_intarg n ++ pr_bindings l)
-
-  (* Conversion *)
-  | TacReduce (r,h) ->
-      hov 1 (pr_red_expr r ++
-             pr_clauses (Some true) pr_ident h)
-  | TacChange (op,c,h) ->
-      hov 1 (str "change" ++ brk (1,1) ++
-      (match op with
-          None -> mt()
-        | Some p -> pr_pat p ++ spc () ++ str "with ") ++
-      pr_constr c ++ pr_clauses (Some true) pr_ident h)
-
-  (* Equivalence relations *)
-  | TacReflexivity as x -> pr_atom0 x
-  | TacSymmetry cls -> str "symmetry" ++ pr_clauses (Some true) pr_ident cls
-  | TacTransitivity (Some c) -> str "transitivity" ++ pr_constrarg c
-  | TacTransitivity None -> str "etransitivity"
-
-  (* Equality and inversion *)
-  | TacRewrite (ev,l,cl,by) ->
-      hov 1 (str (with_evars ev "rewrite") ++ spc () ++
-	     prlist_with_sep
-	     (fun () -> str ","++spc())
-	     (fun (b,m,c) ->
-		pr_orient b ++ pr_multi m ++ pr_with_bindings c)
-	     l
-	     ++ pr_clauses (Some true) pr_ident cl
-	     ++	(match by with Some by -> pr_by_tactic (pr_tac_level ltop) by | None -> mt()))
-  | TacInversion (DepInversion (k,c,ids),hyp) ->
-      hov 1 (str "dependent " ++ pr_induction_kind k ++ spc () ++
-      pr_quantified_hypothesis hyp ++
-      pr_with_inversion_names ids ++ pr_with_constr pr_constr c)
-  | TacInversion (NonDepInversion (k,cl,ids),hyp) ->
-      hov 1 (pr_induction_kind k ++ spc () ++
-      pr_quantified_hypothesis hyp ++
-      pr_with_inversion_names ids ++ pr_simple_hyp_clause pr_ident cl)
-  | TacInversion (InversionUsing (c,cl),hyp) ->
-      hov 1 (str "inversion" ++ spc() ++ pr_quantified_hypothesis hyp ++
-      spc () ++ str "using" ++ spc () ++ pr_constr c ++
-      pr_simple_hyp_clause pr_ident cl)
-
-in
-
-let rec pr_tac inherited tac =
-  let (strm,prec) = match tac with
-  | TacAbstract (t,None) ->
-      str "abstract " ++ pr_tac (labstract,L) t, labstract
-  | TacAbstract (t,Some s) ->
-      hov 0
-       (str "abstract (" ++ pr_tac (labstract,L) t ++ str")" ++ spc () ++
-        str "using " ++ pr_id s),
-      labstract
-  | TacLetIn (recflag,llc,u) ->
-      let llc = List.map (fun (id,t) -> (id,extract_binders t)) llc in
-      v 0
-       (hv 0 (pr_let_clauses recflag (pr_tac ltop) llc ++ str " in") ++
-       fnl () ++ pr_tac (llet,E) u),
-      llet
-  | TacMatch (lz,t,lrul) ->
-      hov 0 (pr_lazy lz ++ str "match " ++ pr_tac ltop t ++ str " with"
-        ++ prlist
-	  (fun r -> fnl () ++ str "| " ++
-            pr_match_rule true (pr_tac ltop) pr_lpat r)
-	lrul
-        ++ fnl() ++ str "end"),
-      lmatch
-  | TacMatchGoal (lz,lr,lrul) ->
-      hov 0 (pr_lazy lz ++
-	str (if lr then "match reverse goal with" else "match goal with")
-	++ prlist
-	  (fun r -> fnl () ++ str "| " ++
-            pr_match_rule false (pr_tac ltop) pr_lpat r)
-	lrul
-        ++ fnl() ++ str "end"),
-      lmatch
-  | TacFun (lvar,body) ->
-      hov 2 (str "fun" ++
-        prlist pr_funvar lvar ++ str " =>" ++ spc () ++
-        pr_tac (lfun,E) body),
-      lfun
-  | TacThens (t,tl) ->
-      hov 1 (pr_tac (lseq,E) t ++ pr_then () ++ spc () ++
-             pr_seq_body (pr_tac ltop) tl),
-      lseq
-  | TacThen (t1,[||],t2,[||]) ->
-      hov 1 (pr_tac (lseq,E) t1 ++ pr_then () ++ spc () ++
-             pr_tac (lseq,L) t2),
-      lseq
-  | TacThen (t1,tf,t2,tl) ->
-      hov 1 (pr_tac (lseq,E) t1 ++ pr_then () ++ spc () ++
-             pr_then_gen (pr_tac ltop) tf t2 tl),
-      lseq
-  | TacTry t ->
-      hov 1 (str "try" ++ spc () ++ pr_tac (ltactical,E) t),
-      ltactical
-  | TacDo (n,t) ->
-      hov 1 (str "do " ++ pr_or_var int n ++ spc () ++
-             pr_tac (ltactical,E) t),
-      ltactical
-  | TacTimeout (n,t) ->
-      hov 1 (str "timeout " ++ pr_or_var int n ++ spc () ++
-             pr_tac (ltactical,E) t),
-      ltactical
-  | TacRepeat t ->
-      hov 1 (str "repeat" ++ spc () ++ pr_tac (ltactical,E) t),
-      ltactical
-  | TacProgress t ->
-      hov 1 (str "progress" ++ spc () ++ pr_tac (ltactical,E) t),
-      ltactical
-  | TacInfo t ->
-      hov 1 (str "info" ++ spc () ++ pr_tac (ltactical,E) t),
-      linfo
-  | TacOrelse (t1,t2) ->
-      hov 1 (pr_tac (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++
-             pr_tac (lorelse,E) t2),
-      lorelse
-  | TacFail (n,l) ->
-      hov 1 (str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++
-      prlist (pr_arg (pr_message_token pr_ident)) l), latom
-  | TacFirst tl ->
-      str "first" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet
-  | TacSolve tl ->
-      str "solve" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet
-  | TacComplete t ->
-      pr_tac (lcomplete,E) t, lcomplete
-  | TacId l ->
-      str "idtac" ++ prlist (pr_arg (pr_message_token pr_ident)) l, latom
-  | TacAtom (loc,TacAlias (_,s,l,_)) ->
-      pr_with_comments loc
-        (pr_extend (level_of inherited) s (List.map snd l)),
-      latom
-  | TacAtom (loc,t) ->
-      pr_with_comments loc (hov 1 (pr_atom1 t)), ltatom
-  | TacArg(_,Tacexp e) -> pr_tac_level (latom,E) e, latom
-  | TacArg(_,ConstrMayEval (ConstrTerm c)) ->
-      str "constr:" ++ pr_constr c, latom
-  | TacArg(_,ConstrMayEval c) ->
-      pr_may_eval pr_constr pr_lconstr pr_cst pr_pat c, leval
-  | TacArg(_,TacFreshId l) -> str "fresh" ++ pr_fresh_ids l, latom
-  | TacArg(_,Integer n) -> int n, latom
-  | TacArg(_,TacCall(loc,f,[])) -> pr_ref f, latom
-  | TacArg(_,TacCall(loc,f,l)) ->
-      pr_with_comments loc
-        (hov 1 (pr_ref f ++ spc () ++
-         prlist_with_sep spc pr_tacarg l)),
-      lcall
-  | TacArg (_,a) -> pr_tacarg a, latom
-  in
-  if prec_less prec inherited then strm
-  else str"(" ++ strm ++ str")"
-
-and pr_tacarg = function
-  | TacDynamic (loc,t) ->
-      pr_with_comments loc (str ("<dynamic ["^(Dyn.tag t)^"]>"))
-  | MetaIdArg (loc,true,s) -> pr_with_comments loc (str ("$" ^ s))
-  | MetaIdArg (loc,false,s) -> pr_with_comments loc (str ("constr: $" ^ s))
-  | IntroPattern ipat -> str "ipattern:" ++ pr_intro_pattern ipat
-  | TacVoid -> str "()"
-  | Reference r -> pr_ref r
-  | ConstrMayEval c -> pr_may_eval pr_constr pr_lconstr pr_cst pr_pat c
-  | TacFreshId l -> str "fresh" ++ pr_fresh_ids l
-  | TacExternal (_,com,req,la) ->
-      str "external" ++ spc() ++ qs com ++ spc() ++ qs req ++
-      spc() ++ prlist_with_sep spc pr_tacarg la
-  | (TacCall _|Tacexp _|Integer _) as a ->
-      str "ltac:" ++ pr_tac (latom,E) (TacArg (dummy_loc,a))
-
-in (pr_tac, pr_match_rule)
-
-let strip_prod_binders_glob_constr n (ty,_) =
-  let rec strip_ty acc n ty =
-    if n=0 then (List.rev acc, (ty,None)) else
-      match ty with
-          Glob_term.GProd(loc,na,Explicit,a,b) ->
-            strip_ty (([dummy_loc,na],(a,None))::acc) (n-1) b
-        | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-let strip_prod_binders_constr n ty =
-  let rec strip_ty acc n ty =
-    if n=0 then (List.rev acc, ty) else
-      match Term.kind_of_term ty with
-          Term.Prod(na,a,b) ->
-            strip_ty (([dummy_loc,na],a)::acc) (n-1) b
-        | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-let drop_env f _env = f
-
-let pr_constr_or_lconstr_pattern_expr b =
-  if b then pr_lconstr_pattern_expr else pr_constr_pattern_expr
-
-let rec raw_printers =
-    (pr_raw_tactic_level,
-     drop_env pr_constr_expr,
-     drop_env pr_lconstr_expr,
-     pr_constr_or_lconstr_pattern_expr,
-     drop_env (pr_or_by_notation pr_reference),
-     drop_env (pr_or_by_notation pr_reference),
-     pr_reference,
-     pr_or_metaid pr_lident,
-     pr_raw_extend,
-     strip_prod_binders_expr)
-
-and pr_raw_tactic_level env n (t:raw_tactic_expr) =
-  fst (make_pr_tac raw_printers env) n t
-
-let pr_and_constr_expr pr (c,_) = pr c
-
-let pr_pat_and_constr_expr b (c,_) =
-  pr_and_constr_expr ((if b then pr_lglob_constr_env else pr_glob_constr_env)
-    (Global.env())) c
-
-let rec glob_printers =
-    (pr_glob_tactic_level,
-     (fun env -> pr_and_constr_expr (pr_glob_constr_env env)),
-     (fun env -> pr_and_constr_expr (pr_lglob_constr_env env)),
-     pr_pat_and_constr_expr,
-     (fun env -> pr_or_var (pr_and_short_name (pr_evaluable_reference_env env))),
-     (fun env -> pr_or_var (pr_inductive env)),
-     pr_ltac_or_var (pr_located pr_ltac_constant),
-     pr_lident,
-     pr_glob_extend,
-     strip_prod_binders_glob_constr)
-
-and pr_glob_tactic_level env n (t:glob_tactic_expr) =
-  fst (make_pr_tac glob_printers env) n t
-
-let pr_constr_or_lconstr_pattern b =
-  if b then pr_lconstr_pattern else pr_constr_pattern
-
-let typed_printers =
-    (pr_glob_tactic_level,
-     pr_constr_env,
-     pr_lconstr_env,
-     pr_constr_or_lconstr_pattern,
-     pr_evaluable_reference_env,
-     pr_inductive,
-     pr_ltac_constant,
-     pr_id,
-     pr_extend,
-     strip_prod_binders_constr)
-
-let pr_tactic_level env = fst (make_pr_tac typed_printers env)
-
-let pr_raw_tactic env = pr_raw_tactic_level env ltop
-let pr_glob_tactic env = pr_glob_tactic_level env ltop
-let pr_tactic env = pr_tactic_level env ltop
-
-let _ = Tactic_debug.set_tactic_printer
-  (fun x -> pr_glob_tactic (Global.env()) x)
-
-let _ = Tactic_debug.set_match_pattern_printer
-  (fun env hyp -> pr_match_pattern (pr_constr_pattern_env env) hyp)
-
-let _ = Tactic_debug.set_match_rule_printer
-  (fun rl ->
-    pr_match_rule false (pr_glob_tactic (Global.env())) 
-      (fun (_,p) -> pr_constr_pattern p) rl)
-
-open Extrawit
-
-let pr_tac_polymorphic n _ _ prtac = prtac (n,E)
-
-let _ = for i=0 to 5 do
-  declare_extra_genarg_pprule
-  (rawwit_tactic i, pr_tac_polymorphic i)
-  (globwit_tactic i, pr_tac_polymorphic i)
-  (wit_tactic i, pr_tac_polymorphic i)
-done
-
diff --git a/parsing/pptactic.mli b/parsing/pptactic.mli
deleted file mode 100644
index c5953da1..00000000
--- a/parsing/pptactic.mli
+++ /dev/null
@@ -1,100 +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 Genarg
-open Tacexpr
-open Pretyping
-open Proof_type
-open Topconstr
-open Glob_term
-open Pattern
-open Ppextend
-open Environ
-open Evd
-
-val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
-val pr_or_metaid : ('a -> std_ppcmds) -> 'a or_metaid -> std_ppcmds
-val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds
-val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds
-
-type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) ->
-    (constr_expr -> std_ppcmds) ->
-    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a glob_extra_genarg_printer =
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) ->
-    (Term.constr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-  (** if the boolean is false then the extension applies only to old syntax *)
-val declare_extra_genarg_pprule :
-  ('c raw_abstract_argument_type * 'c raw_extra_genarg_printer) ->
-  ('a glob_abstract_argument_type * 'a glob_extra_genarg_printer) ->
-  ('b typed_abstract_argument_type * 'b extra_genarg_printer) -> unit
-
-type grammar_terminals = string option list
-
-  (** if the boolean is false then the extension applies only to old syntax *)
-val declare_extra_tactic_pprule :
-  string * argument_type list * (int * grammar_terminals) -> unit
-
-val exists_extra_tactic_pprule : string -> argument_type list -> bool
-
-val pr_raw_generic :
-  (constr_expr -> std_ppcmds) ->
-  (constr_expr -> std_ppcmds) ->
-  (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-  (constr_expr -> std_ppcmds) ->
-  (Libnames.reference -> std_ppcmds) -> rlevel generic_argument ->
-    std_ppcmds
-
-val pr_raw_extend:
-  (constr_expr -> std_ppcmds) -> (constr_expr -> std_ppcmds) ->
-  (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-  (constr_expr -> std_ppcmds) -> int ->
-    string -> raw_generic_argument list -> std_ppcmds
-
-val pr_glob_extend:
-  (glob_constr_and_expr -> std_ppcmds) -> (glob_constr_and_expr -> std_ppcmds) ->
-  (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-  (glob_constr_pattern_and_expr -> std_ppcmds) -> int ->
-    string -> glob_generic_argument list -> std_ppcmds
-
-val pr_extend :
-  (Term.constr -> std_ppcmds) -> (Term.constr -> std_ppcmds) ->
-  (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-  (constr_pattern -> std_ppcmds) -> int ->
-    string -> typed_generic_argument list -> std_ppcmds
-
-val pr_ltac_constant : Nametab.ltac_constant -> std_ppcmds
-
-val pr_raw_tactic : env -> raw_tactic_expr -> std_ppcmds
-
-val pr_raw_tactic_level : env -> tolerability -> raw_tactic_expr -> std_ppcmds
-
-val pr_glob_tactic : env -> glob_tactic_expr -> std_ppcmds
-
-val pr_tactic : env -> Proof_type.tactic_expr -> std_ppcmds
-
-val pr_hintbases : string list option -> std_ppcmds
-
-val pr_auto_using : ('constr -> std_ppcmds) -> 'constr list -> std_ppcmds
-
-val pr_bindings :
-  ('constr -> std_ppcmds) ->
-  ('constr -> std_ppcmds) -> 'constr bindings -> std_ppcmds
diff --git a/parsing/ppvernac.ml b/parsing/ppvernac.ml
deleted file mode 100644
index 98c02567..00000000
--- a/parsing/ppvernac.ml
+++ /dev/null
@@ -1,979 +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 Names
-open Nameops
-open Nametab
-open Compat
-open Util
-open Extend
-open Vernacexpr
-open Ppconstr
-open Pptactic
-open Glob_term
-open Genarg
-open Pcoq
-open Libnames
-open Ppextend
-open Topconstr
-open Decl_kinds
-open Tacinterp
-open Declaremods
-
-let pr_spc_lconstr = pr_sep_com spc pr_lconstr_expr
-
-let pr_lident (loc,id) =
-  if loc <> dummy_loc then
-    let (b,_) = unloc loc in
-    pr_located pr_id (make_loc (b,b+String.length(string_of_id id)),id)
-  else pr_id id
-
-let string_of_fqid fqid =
- String.concat "." (List.map string_of_id fqid)
-
-let pr_fqid fqid = str (string_of_fqid fqid)
-
-let pr_lfqid (loc,fqid) =
-  if loc <> dummy_loc then
-   let (b,_) = unloc loc in
-    pr_located pr_fqid (make_loc (b,b+String.length(string_of_fqid fqid)),fqid)
-  else
-   pr_fqid fqid
-
-let pr_lname = function
-    (loc,Name id) -> pr_lident (loc,id)
-  | lna -> pr_located pr_name lna
-
-let pr_smart_global = pr_or_by_notation pr_reference
-
-let pr_ltac_ref = Libnames.pr_reference
-
-let pr_module = Libnames.pr_reference
-
-let pr_import_module = Libnames.pr_reference
-
-let sep_end = function
-  | VernacBullet _
-  | VernacSubproof None
-  | VernacEndSubproof -> str""
-  | _ -> str"."
-
-(* Warning: [pr_raw_tactic] globalises and fails if globalisation fails *)
-
-let pr_raw_tactic_env l env t =
-  pr_glob_tactic env (Tacinterp.glob_tactic_env l env t)
-
-let pr_gen env t =
-  pr_raw_generic
-    pr_constr_expr
-    pr_lconstr_expr
-    (pr_raw_tactic_level env) pr_constr_expr pr_reference t
-
-let pr_raw_tactic tac = pr_raw_tactic (Global.env()) tac
-
-let rec extract_signature = function
-  | [] -> []
-  | Egrammar.GramNonTerminal (_,t,_,_) :: l -> t :: extract_signature l
-  | _::l -> extract_signature l
-
-let rec match_vernac_rule tys = function
-    [] -> raise Not_found
-  | pargs::rls ->
-      if extract_signature pargs = tys then pargs
-      else match_vernac_rule tys rls
-
-let sep = fun _ -> spc()
-let sep_v2 = fun _ -> str"," ++ spc()
-
-let pr_ne_sep sep pr = function
-    [] -> mt()
-  | l -> sep() ++ pr l
-
-let pr_set_entry_type = function
-  | ETName -> str"ident"
-  | ETReference -> str"global"
-  | ETPattern -> str"pattern"
-  | ETConstr _ -> str"constr"
-  | ETOther (_,e) -> str e
-  | ETBigint -> str "bigint"
-  | ETBinder true -> str "binder"
-  | ETBinder false -> str "closed binder"
-  | ETBinderList _ | ETConstrList _ -> failwith "Internal entry type"
-
-let strip_meta id =
-  let s = string_of_id id in
-  if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1))
-  else id
-
-let pr_production_item = function
-  | TacNonTerm (loc,nt,Some (p,sep)) ->
-      let pp_sep = if sep <> "" then str "," ++ quote (str sep) else mt () in
-      str nt ++ str"(" ++ pr_id (strip_meta p) ++ pp_sep ++ str")"
-  | TacNonTerm (loc,nt,None) -> str nt
-  | TacTerm s -> qs s
-
-let pr_comment pr_c = function
-  | CommentConstr c -> pr_c c
-  | CommentString s -> qs s
-  | CommentInt n -> int n
-
-let pr_in_out_modules = function
-  | SearchInside l -> spc() ++ str"inside" ++ spc() ++ prlist_with_sep sep pr_module l
-  | SearchOutside [] -> mt()
-  | SearchOutside l -> spc() ++ str"outside" ++ spc() ++ prlist_with_sep sep pr_module l
-
-let pr_search_about (b,c) =
-  (if b then str "-" else mt()) ++
-  match c with
-  | SearchSubPattern p -> pr_constr_pattern_expr p
-  | SearchString (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
-
-let pr_search a b pr_p = match a with
-  | SearchHead c -> str"Search" ++ spc() ++ pr_p c ++ pr_in_out_modules b
-  | SearchPattern c -> str"SearchPattern" ++ spc() ++ pr_p c ++ pr_in_out_modules b
-  | SearchRewrite c -> str"SearchRewrite" ++ spc() ++ pr_p c ++ pr_in_out_modules b
-  | SearchAbout sl -> str"SearchAbout" ++ spc() ++ str "[" ++ prlist_with_sep spc pr_search_about sl ++ str "]" ++ pr_in_out_modules b
-
-let pr_locality_full = function
-  | None -> mt()
-  | Some true -> str"Local "
-  | Some false -> str"Global "
-let pr_locality local = if local then str "Local " else str ""
-let pr_non_locality local = if local then str "" else str "Global "
-let pr_section_locality local =
-  if Lib.sections_are_opened () && not local then str "Global "
-  else if not (Lib.sections_are_opened ()) && local then str "Local "
-  else mt ()
-
-let pr_explanation (e,b,f) =
-  let a = match e with
-  | ExplByPos (n,_) -> anomaly "No more supported"
-  | ExplByName id -> pr_id id in
-  let a = if f then str"!" ++ a else a in
-    if b then str "[" ++ a ++ str "]" else a
-
-let pr_option_ref_value = function
-  | QualidRefValue id -> pr_reference id
-  | StringRefValue s -> qs s
-
-let pr_printoption table b =
-  prlist_with_sep spc str table ++
-  pr_opt (prlist_with_sep sep pr_option_ref_value) b
-
-let pr_set_option a b =
-  let pr_opt_value = function
-    | IntValue None -> assert false
-    (* This should not happen because of the grammar *)
-    | IntValue (Some n) -> spc() ++ int n
-    | StringValue s -> spc() ++ str s
-    | BoolValue b -> mt()
-  in pr_printoption a None ++ pr_opt_value b
-
-let pr_topcmd _ = str"(* <Warning> : No printer for toplevel commands *)"
-
-let pr_destruct_location = function
-  | Tacexpr.ConclLocation ()  -> str"Conclusion"
-  | Tacexpr.HypLocation b -> if b then str"Discardable Hypothesis" else str"Hypothesis"
-
-let pr_opt_hintbases l = match l with
-  | [] -> mt()
-  | _ as z -> str":" ++ spc() ++ prlist_with_sep sep str z
-
-let pr_hints local db h pr_c pr_pat =
-  let opth = pr_opt_hintbases db  in
-  let pph =
-    match h with
-    | HintsResolve l ->
-        str "Resolve " ++ prlist_with_sep sep
-	  (fun (pri, _, c) -> pr_c c ++
-	    match pri with Some x -> spc () ++ str"(" ++ int x ++ str")" | None -> mt ())
-	  l
-    | HintsImmediate l ->
-        str"Immediate" ++ spc() ++ prlist_with_sep sep pr_c l
-    | HintsUnfold l ->
-        str "Unfold " ++ prlist_with_sep sep pr_reference l
-    | HintsTransparency (l, b) ->
-        str (if b then "Transparent " else "Opaque ") ++ prlist_with_sep sep
-	  pr_reference l
-    | HintsConstructors c ->
-        str"Constructors" ++ spc() ++ prlist_with_sep spc pr_reference c
-    | HintsExtern (n,c,tac) ->
-	let pat = match c with None -> mt () | Some pat -> pr_pat pat in
-          str "Extern" ++ spc() ++ int n ++ spc() ++ pat ++ str" =>" ++
-          spc() ++ pr_raw_tactic tac
-  in
-  hov 2 (str"Hint "++pr_locality local ++ pph ++ opth)
-
-let pr_with_declaration pr_c = function
-  | CWith_Definition (id,c) ->
-      let p = pr_c c in
-      str"Definition" ++ spc() ++ pr_lfqid id ++ str" := " ++ p
-  | CWith_Module (id,qid) ->
-      str"Module" ++ spc() ++ pr_lfqid id ++ str" := " ++
-      pr_located pr_qualid qid
-
-let rec pr_module_ast pr_c = function
-  | CMident qid -> spc () ++ pr_located pr_qualid qid
-  | CMwith (_,mty,decl) ->
-      let m = pr_module_ast pr_c mty in
-      let p = pr_with_declaration pr_c decl in
-      m ++ spc() ++ str"with" ++ spc() ++ p
-  | CMapply (_,me1,(CMident _ as me2)) ->
-      pr_module_ast pr_c me1 ++ spc() ++ pr_module_ast pr_c me2
-  | CMapply (_,me1,me2) ->
-      pr_module_ast pr_c me1 ++ spc() ++
-      hov 1 (str"(" ++ pr_module_ast pr_c me2 ++ str")")
-
-let pr_annot { ann_inline = ann; ann_scope_subst = scl } =
-  let sep () = if scl=[] then mt () else str "," in
-  if ann = DefaultInline && scl = [] then mt ()
-  else
-    str " [" ++
-    (match ann with
-      | DefaultInline -> mt ()
-      | NoInline -> str "no inline" ++ sep ()
-      | InlineAt i -> str "inline at level " ++ int i ++ sep ()) ++
-    prlist_with_sep (fun () -> str ", ")
-      (fun (sc1,sc2) -> str ("scope "^sc1^" to "^sc2)) scl ++
-    str "]"
-
-let pr_module_ast_inl pr_c (mast,ann) =
-  pr_module_ast pr_c mast ++ pr_annot ann
-
-let pr_of_module_type prc = function
-  | Enforce mty -> str ":" ++ pr_module_ast_inl prc mty
-  | Check mtys ->
-      prlist_strict (fun m -> str "<:" ++ pr_module_ast_inl prc m) mtys
-
-let pr_require_token = function
-  | Some true -> str "Export "
-  | Some false -> str "Import "
-  | None -> mt()
-
-let pr_module_vardecls pr_c (export,idl,(mty,inl)) =
-  let m = pr_module_ast pr_c mty in
-  (* Update the Nametab for interpreting the body of module/modtype *)
-  let lib_dir = Lib.library_dp() in
-  List.iter (fun (_,id) ->
-    Declaremods.process_module_bindings [id]
-      [make_mbid lib_dir id,
-       (Modintern.interp_modtype (Global.env()) mty, inl)]) idl;
-  (* Builds the stream *)
-  spc() ++
-  hov 1 (str"(" ++ pr_require_token export ++
-   prlist_with_sep spc pr_lident idl ++ str":" ++ m ++ str")")
-
-let pr_module_binders l pr_c =
-  (* Effet de bord complexe pour garantir la declaration des noms des
-  modules parametres dans la Nametab des l'appel de pr_module_binders
-  malgre l'aspect paresseux des streams *)
-  let ml = List.map (pr_module_vardecls pr_c) l in
-  prlist (fun id -> id) ml
-
-let pr_module_binders_list l pr_c = pr_module_binders l pr_c
-
-let pr_type_option pr_c = function
-  | CHole (loc, k) -> mt()
-  | _ as c -> brk(0,2) ++ str":" ++ pr_c c
-
-let pr_decl_notation prc ((loc,ntn),c,scopt) =
-  fnl () ++ str "where " ++ qs ntn ++ str " := " ++ prc c ++
-  pr_opt (fun sc -> str ": " ++ str sc) scopt
-
-let pr_binders_arg =
-  pr_ne_sep spc pr_binders
-
-let pr_and_type_binders_arg bl =
-  pr_binders_arg bl
-
-let pr_onescheme (idop,schem) =
-  match schem with
-  | InductionScheme (dep,ind,s) ->
-    (match idop with
-      | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
-      | None -> spc ()
-    ) ++
-    hov 0 ((if dep then str"Induction for" else str"Minimality for")
-    ++ spc() ++ pr_smart_global ind) ++ spc() ++
-    hov 0 (str"Sort" ++ spc() ++ pr_glob_sort s)
-  | CaseScheme (dep,ind,s) ->
-    (match idop with
-      | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
-      | None -> spc ()
-    ) ++
-    hov 0 ((if dep then str"Elimination for" else str"Case for")
-    ++ spc() ++ pr_smart_global ind) ++ spc() ++
-    hov 0 (str"Sort" ++ spc() ++ pr_glob_sort s)
-  | EqualityScheme ind ->
-    (match idop with
-      | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
-      | None -> spc()
-    ) ++
-    hov 0 (str"Equality for")
-    ++ spc() ++ pr_smart_global ind
-
-let begin_of_inductive = function
-    [] -> 0
-  | (_,((loc,_),_))::_ -> fst (unloc loc)
-
-let pr_class_rawexpr = function
-  | FunClass -> str"Funclass"
-  | SortClass -> str"Sortclass"
-  | RefClass qid -> pr_smart_global qid
-
-let pr_assumption_token many = function
-  | (Local,Logical) ->
-      str (if many then "Hypotheses" else "Hypothesis")
-  | (Local,Definitional) ->
-      str (if many then "Variables" else "Variable")
-  | (Global,Logical) ->
-      str (if many then "Axioms" else "Axiom")
-  | (Global,Definitional) ->
-      str (if many then "Parameters" else "Parameter")
-  | (Global,Conjectural) -> str"Conjecture"
-  | (Local,Conjectural) ->
-      anomaly "Don't know how to beautify a local conjecture"
-
-let pr_params pr_c (xl,(c,t)) =
-  hov 2 (prlist_with_sep sep pr_lident xl ++ spc() ++
-         (if c then str":>" else str":" ++
-         spc() ++ pr_c t))
-
-let rec factorize = function
-  | [] -> []
-  | (c,(idl,t))::l ->
-      match factorize l with
-	| (xl,t')::l' when t' = (c,t) -> (idl@xl,t')::l'
-	| l' -> (idl,(c,t))::l'
-
-let pr_ne_params_list pr_c l =
-  match factorize l with
-    | [p] -> pr_params pr_c p
-    | l ->
-	prlist_with_sep spc
-          (fun p -> hov 1 (str "(" ++ pr_params pr_c p ++ str ")")) l
-(*
-  prlist_with_sep pr_semicolon (pr_params pr_c)
-*)
-
-let pr_thm_token k = str (string_of_theorem_kind k)
-
-let pr_syntax_modifier = function
-  | SetItemLevel (l,NextLevel) ->
-      prlist_with_sep sep_v2 str l ++
-      spc() ++ str"at next level"
-  | SetItemLevel (l,NumLevel n) ->
-      prlist_with_sep sep_v2 str l ++
-      spc() ++ str"at level" ++ spc() ++ int n
-  | SetLevel n -> str"at level" ++ spc() ++ int n
-  | SetAssoc LeftA -> str"left associativity"
-  | SetAssoc RightA -> str"right associativity"
-  | SetAssoc NonA -> str"no associativity"
-  | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_entry_type typ
-  | SetOnlyParsing Flags.Current -> str"only parsing"
-  | SetOnlyParsing v -> str("compat \"" ^ Flags.pr_version v ^ "\"")
-  | SetFormat s -> str"format " ++ pr_located qs s
-
-let pr_syntax_modifiers = function
-  | [] -> mt()
-  | l -> spc() ++
-      hov 1 (str"(" ++ prlist_with_sep sep_v2 pr_syntax_modifier l ++ str")")
-
-let print_level n =
-  if n <> 0 then str " (at level " ++ int n ++ str ")" else mt ()
-
-let pr_grammar_tactic_rule n (_,pil,t) =
-  hov 2 (str "Tactic Notation" ++ print_level n ++ spc() ++
-    hov 0 (prlist_with_sep sep pr_production_item pil ++
-    spc() ++ str":=" ++ spc() ++ pr_raw_tactic t))
-
-let pr_statement head (id,(bl,c,guard)) =
-  assert (id<>None);
-  hov 1
-    (head ++ spc() ++ pr_lident (Option.get id) ++ spc() ++
-    (match bl with [] -> mt() | _ -> pr_binders bl ++ spc()) ++
-    pr_opt (pr_guard_annot pr_lconstr_expr bl) guard ++
-    str":" ++ pr_spc_lconstr c)
-
-(**************************************)
-(* Pretty printer for vernac commands *)
-(**************************************)
-let make_pr_vernac pr_constr pr_lconstr =
-
-let pr_constrarg c = spc () ++ pr_constr c in
-let pr_lconstrarg c = spc () ++ pr_lconstr c in
-let pr_intarg n = spc () ++ int n in
-let pr_oc = function 
-    None -> str" :"
-  | Some true -> str" :>"
-  | Some false -> str" :>>"
-in
-let pr_record_field ((x, pri), ntn) =
-  let prx = match x with
-    | (oc,AssumExpr (id,t)) ->
-	hov 1 (pr_lname id ++
-	       pr_oc oc ++ spc() ++
-	       pr_lconstr_expr t)
-    | (oc,DefExpr(id,b,opt)) -> (match opt with
-      | Some t ->
-          hov 1 (pr_lname id ++
-                 pr_oc oc ++ spc() ++
-                 pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b)
-      | None ->
-          hov 1 (pr_lname id ++ str" :=" ++ spc() ++
-                    pr_lconstr b)) in
-  let prpri = match pri with None -> mt() | Some i -> str "| " ++ int i in
-    prx ++ prpri ++ prlist (pr_decl_notation pr_constr) ntn
-in
-let pr_record_decl b c fs =
-    pr_opt pr_lident c ++ str"{"  ++
-    hv 0 (prlist_with_sep pr_semicolon pr_record_field fs ++ str"}")
-in
-
-let rec pr_vernac = function
-
-  (* Proof management *)
-  | VernacAbortAll -> str "Abort All"
-  | VernacRestart -> str"Restart"
-  | VernacUnfocus -> str"Unfocus"
-  | VernacUnfocused -> str"Unfocused"
-  | VernacGoal c -> str"Goal" ++ pr_lconstrarg c
-  | VernacAbort id -> str"Abort" ++ pr_opt pr_lident id
-  | VernacUndo i -> if i=1 then str"Undo" else str"Undo" ++ pr_intarg i
-  | VernacUndoTo i -> str"Undo" ++ spc() ++ str"To" ++ pr_intarg i
-  | VernacBacktrack (i,j,k) ->
-      str "Backtrack" ++  spc() ++ prlist_with_sep sep int [i;j;k]
-  | VernacFocus i -> str"Focus" ++ pr_opt int i
-  | VernacShow s ->
-      let pr_goal_reference = function
-        | OpenSubgoals -> mt ()
-        | NthGoal n -> spc () ++ int n
-        | GoalId n -> spc () ++ str n in
-      let pr_showable = function
-	| ShowGoal n -> str"Show" ++ pr_goal_reference n
-	| ShowGoalImplicitly n -> str"Show Implicit Arguments" ++ pr_opt int n
-	| ShowProof -> str"Show Proof"
-	| ShowNode -> str"Show Node"
-	| ShowScript -> str"Show Script"
-	| ShowExistentials -> str"Show Existentials"
-	| ShowTree -> str"Show Tree"
-	| ShowProofNames -> str"Show Conjectures"
-	| ShowIntros b -> str"Show " ++ (if b then str"Intros" else str"Intro")
-	| ShowMatch id -> str"Show Match " ++ pr_lident id
-	| ShowThesis -> str "Show Thesis"
-      in pr_showable s
-  | VernacCheckGuard -> str"Guarded"
-
-  (* Resetting *)
-  | VernacResetName id -> str"Reset" ++ spc() ++ pr_lident id
-  | VernacResetInitial -> str"Reset Initial"
-  | VernacBack i -> if i=1 then str"Back" else str"Back" ++ pr_intarg i
-  | VernacBackTo i -> str"BackTo" ++ pr_intarg i
-
-  (* State management *)
-  | VernacWriteState s -> str"Write State" ++ spc () ++ qs s
-  | VernacRestoreState s -> str"Restore State" ++ spc() ++ qs s
-
-  (* Control *)
-  | VernacList l ->
-      hov 2 (str"[" ++ spc() ++
-             prlist (fun v -> pr_located pr_vernac v ++ sep_end (snd v) ++ fnl()) l
-             ++ spc() ++ str"]")
-  | VernacLoad (f,s) -> str"Load" ++ if f then (spc() ++ str"Verbose"
-  ++ spc()) else spc()  ++ qs s
-  | VernacTime v -> str"Time" ++ spc() ++ pr_vernac v
-  | VernacTimeout(n,v) -> str"Timeout " ++ int n ++ spc() ++ pr_vernac v
-  | VernacFail v -> str"Fail" ++ spc() ++ pr_vernac v
-
-  (* Syntax *)
-  | VernacTacticNotation (n,r,e) -> pr_grammar_tactic_rule n ("",r,e)
-  | VernacOpenCloseScope (local,opening,sc) ->
-      pr_section_locality local ++ 
-      str (if opening then "Open " else "Close ") ++
-      str "Scope" ++ spc() ++ str sc
-  | VernacDelimiters (sc,key) ->
-      str"Delimit Scope" ++ spc () ++ str sc ++
-      spc() ++ str "with " ++ str key
-  | VernacBindScope (sc,cll) ->
-      str"Bind Scope" ++ spc () ++ str sc ++
-      spc() ++ str "with " ++ prlist_with_sep spc pr_class_rawexpr cll
-  | VernacArgumentsScope (local,q,scl) -> let pr_opt_scope = function
-      |	None -> str"_"
-      |	Some sc -> str sc in
-    pr_section_locality local ++ str"Arguments Scope" ++ spc() ++ 
-    pr_smart_global q
-    ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
-  | VernacInfix (local,((_,s),mv),q,sn) -> (* A Verifier *)
-      hov 0 (hov 0 (pr_locality local ++ str"Infix "
-      ++ qs s ++ str " :=" ++ pr_constrarg q) ++
-      pr_syntax_modifiers mv ++
-      (match sn with
-    | None -> mt()
-    | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
-  | VernacNotation (local,c,((_,s),l),opt) ->
-      let ps =
-	let n = String.length s in
-	if n > 2 & s.[0] = '\'' & s.[n-1] = '\''
-	then
-          let s' = String.sub s 1 (n-2) in
-          if String.contains s' '\'' then qs s else str s'
-	else qs s in
-      hov 2 (pr_locality local ++ str"Notation" ++ spc() ++ ps ++
-      str " :=" ++ pr_constrarg c ++ pr_syntax_modifiers l ++
-      (match opt with
-        | None -> mt()
-        | Some sc -> str" :" ++ spc() ++ str sc))
-  | VernacSyntaxExtension (local,(s,l)) ->
-      pr_locality local ++ str"Reserved Notation" ++ spc() ++ pr_located qs s ++
-      pr_syntax_modifiers l
-
-  (* Gallina *)
-  | VernacDefinition (d,id,b,f) -> (* A verifier... *)
-      let pr_def_token dk = str (string_of_definition_kind dk) in
-      let pr_reduce = function
-        | None -> mt()
-        | Some r ->
-            str"Eval" ++ spc() ++
-            pr_red_expr (pr_constr, pr_lconstr, pr_smart_global, pr_constr) r ++
-            str" in" ++ spc() in
-      let pr_def_body = function
-        | DefineBody (bl,red,body,d) ->
-            let ty = match d with
-              | None -> mt()
-              | Some ty -> spc() ++ str":" ++ pr_spc_lconstr ty
-	    in
-            (pr_binders_arg bl,ty,Some (pr_reduce red ++ pr_lconstr body))
-        | ProveBody (bl,t) ->
-            (pr_binders_arg bl, str" :" ++ pr_spc_lconstr t, None) in
-      let (binds,typ,c) = pr_def_body b in
-      hov 2 (pr_def_token d ++ spc() ++ pr_lident id ++ binds ++ typ ++
-      (match c with
-        | None -> mt()
-        | Some cc -> str" :=" ++ spc() ++ cc))
-
-  | VernacStartTheoremProof (ki,l,_,_) ->
-      hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
-             prlist (pr_statement (spc () ++ str "with")) (List.tl l))
-
-  | VernacEndProof Admitted -> str"Admitted"
-  | VernacEndProof (Proved (opac,o)) -> (match o with
-    | None -> if opac then str"Qed" else str"Defined"
-    | Some (id,th) -> (match th with
-      |	None -> (if opac then str"Save" else str"Defined") ++ spc() ++ pr_lident id
-      |	Some tok -> str"Save" ++ spc() ++ pr_thm_token tok ++ spc() ++ pr_lident id))
-  | VernacExactProof c ->
-      hov 2 (str"Proof" ++ pr_lconstrarg c)
-  | VernacAssumption (stre,_,l) ->
-      let n = List.length (List.flatten (List.map fst (List.map snd l))) in
-      hov 2
-        (pr_assumption_token (n > 1) stre ++ spc() ++
-	 pr_ne_params_list pr_lconstr_expr l)
-  | VernacInductive (f,i,l) ->
-
-      let pr_constructor (coe,(id,c)) =
-        hov 2 (pr_lident id ++ str" " ++
-               (if coe then str":>" else str":") ++
-                pr_spc_lconstr c) in
-      let pr_constructor_list b l = match l with
-        | Constructors [] -> mt()
-        | Constructors l ->
-            pr_com_at (begin_of_inductive l) ++
-            fnl() ++
-            str (if List.length l = 1 then "   " else " | ") ++
-            prlist_with_sep (fun _ -> fnl() ++ str" | ") pr_constructor l
-       | RecordDecl (c,fs) ->
-	    spc() ++
-	    pr_record_decl b c fs in
-      let pr_oneind key (((coe,id),indpar,s,k,lc),ntn) =
-	hov 0 (
-	    str key ++ spc() ++
-	      (if i then str"Infer " else str"") ++
-              (if coe then str"> " else str"") ++ pr_lident id ++
-              pr_and_type_binders_arg indpar ++ spc() ++
-	      Option.cata (fun s -> str":" ++ spc() ++ pr_lconstr_expr s) (mt()) s ++
-	      str" :=") ++ pr_constructor_list k lc ++
-	    prlist (pr_decl_notation pr_constr) ntn
-      in
-      let key =
-        let (_,_,_,k,_),_ = List.hd l in
-	match k with Record -> "Record" | Structure -> "Structure"
-	  | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
-	  | Class _ -> "Class" in
-      hov 1 (pr_oneind key (List.hd l)) ++
-      (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
-
-
-  | VernacFixpoint recs ->
-      let pr_onerec = function
-        | ((loc,id),ro,bl,type_,def),ntn ->
-            let annot = pr_guard_annot pr_lconstr_expr bl ro in
-            pr_id id ++ pr_binders_arg bl ++ annot
-            ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_
-            ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) def ++
-	    prlist (pr_decl_notation pr_constr) ntn
-      in
-      hov 0 (str "Fixpoint" ++ spc() ++
-        prlist_with_sep (fun _ -> fnl() ++ str"with ") pr_onerec recs)
-
-  | VernacCoFixpoint corecs ->
-      let pr_onecorec (((loc,id),bl,c,def),ntn) =
-        pr_id id ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
-        spc() ++ pr_lconstr_expr c ++
-        pr_opt (fun def -> str" :=" ++ brk(1,2) ++ pr_lconstr def) def ++
-	prlist (pr_decl_notation pr_constr) ntn
-      in
-      hov 0 (str "CoFixpoint" ++ spc() ++
-      prlist_with_sep (fun _ -> fnl() ++ str"with ") pr_onecorec corecs)
-  | VernacScheme l ->
-      hov 2 (str"Scheme" ++ spc() ++
-             prlist_with_sep (fun _ -> fnl() ++ str"with ") pr_onescheme l)
-  | VernacCombinedScheme (id, l) ->
-      hov 2 (str"Combined Scheme" ++ spc() ++
-	       pr_lident id ++ spc() ++ str"from" ++ spc() ++
-	       prlist_with_sep (fun _ -> fnl() ++ str", ") pr_lident l)
-
-
-  (* Gallina extensions *)
-  | VernacBeginSection id -> hov 2 (str"Section" ++ spc () ++ pr_lident id)
-  | VernacEndSegment id -> hov 2 (str"End" ++ spc() ++ pr_lident id)
-  | VernacRequire (exp,spe,l) -> hov 2
-      (str "Require" ++ spc() ++ pr_require_token exp ++
-      (match spe with
-      |	None -> mt()
-      |	Some flag ->
-          (if flag then str"Specification" else str"Implementation") ++
-          spc ()) ++
-      prlist_with_sep sep pr_module l)
-  | VernacImport (f,l) ->
-      (if f then str"Export" else str"Import") ++ spc() ++
-      prlist_with_sep sep pr_import_module l
-  | VernacCanonical q -> str"Canonical Structure" ++ spc() ++ pr_smart_global q
-  | VernacCoercion (s,id,c1,c2) ->
-      hov 1 (
-	str"Coercion" ++ (match s with | Local -> spc() ++
-	  str"Local" ++ spc() | Global -> spc()) ++
-	pr_smart_global id ++ spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++
-	spc() ++ str">->" ++ spc() ++ pr_class_rawexpr c2)
-  | VernacIdentityCoercion (s,id,c1,c2) ->
-      hov 1 (
-	str"Identity Coercion" ++ (match s with | Local -> spc() ++
-	  str"Local" ++ spc() | Global -> spc()) ++ pr_lident id ++
-	spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++
-	spc() ++ pr_class_rawexpr c2)
-
- | VernacInstance (abst,glob, sup, (instid, bk, cl), props, pri) ->
-     hov 1 (
-       pr_non_locality (not glob) ++
-       (if abst then str"Declare " else mt ()) ++
-       str"Instance" ++ 
-       (match snd instid with Name id -> spc () ++ pr_lident (fst instid, id) ++ spc () | 
-	Anonymous -> mt ()) ++
-       pr_and_type_binders_arg sup ++
-       str":" ++ spc () ++	 
-       pr_constr_expr cl ++ spc () ++
-	 (match props with
-	  | Some p -> spc () ++ str":=" ++ spc () ++ pr_constr_expr p
-	  | None -> mt()))
-
- | VernacContext l ->
-     hov 1 (
-       str"Context" ++ spc () ++ pr_and_type_binders_arg l)
-
-
- | VernacDeclareInstances (glob, ids) ->
-     hov 1 (pr_non_locality (not glob) ++
-               str"Existing" ++ spc () ++ str(plural (List.length ids) "Instance") ++
-               spc () ++ prlist_with_sep spc pr_reference ids)
-
- | VernacDeclareClass id ->
-     hov 1 (str"Existing" ++ spc () ++ str"Class" ++ spc () ++ pr_reference id)
-
-  (* Modules and Module Types *)
-  | VernacDefineModule (export,m,bl,tys,bd) ->
-      let b = pr_module_binders_list bl pr_lconstr in
-      hov 2 (str"Module" ++ spc() ++ pr_require_token export ++
-               pr_lident m ++ b ++
-               pr_of_module_type pr_lconstr tys ++
-	       (if bd = [] then mt () else str ":= ") ++
-	       prlist_with_sep (fun () -> str " <+ ")
-	        (pr_module_ast_inl pr_lconstr) bd)
-  | VernacDeclareModule (export,id,bl,m1) ->
-      let b = pr_module_binders_list bl pr_lconstr in
-	hov 2 (str"Declare Module" ++ spc() ++ pr_require_token export ++
-             pr_lident id ++ b ++
-             pr_module_ast_inl pr_lconstr m1)
-  | VernacDeclareModuleType (id,bl,tyl,m) ->
-      let b = pr_module_binders_list bl pr_lconstr in
-      let pr_mt = pr_module_ast_inl pr_lconstr in
-	hov 2 (str"Module Type " ++ pr_lident id ++ b ++
-		 prlist_strict (fun m -> str " <: " ++ pr_mt m) tyl ++
-		 (if m = [] then mt () else str ":= ") ++
-		 prlist_with_sep (fun () -> str " <+ ") pr_mt m)
-  | VernacInclude (mexprs) ->
-      let pr_m = pr_module_ast_inl pr_lconstr in
-      hov 2 (str"Include " ++
-	     prlist_with_sep (fun () -> str " <+ ") pr_m mexprs)
-  (* Solving *)
-  | VernacSolve (i,tac,deftac) ->
-      (if i = 1 then mt() else int i ++ str ": ") ++
-      pr_raw_tactic tac
-      ++ (try if deftac then str ".." else mt ()
-      with UserError _|Loc.Exc_located _ -> mt())
-
-  | VernacSolveExistential (i,c) ->
-      str"Existential " ++ int i ++ pr_lconstrarg c
-
-  (* Auxiliary file and library management *)
-  | VernacRequireFrom (exp,spe,f) -> hov 2
-      (str"Require" ++ spc() ++ pr_require_token exp ++
-      (match spe with
-        | None -> mt()
-        | Some false -> str"Implementation" ++ spc()
-        | Some true -> str"Specification" ++ spc ()) ++
-      qs f)
-  | VernacAddLoadPath (fl,s,d) -> hov 2
-      (str"Add" ++
-       (if fl then str" Rec " else spc()) ++
-       str"LoadPath" ++ spc() ++ qs s ++
-       (match d with
-         | None -> mt()
-         | Some dir -> spc() ++ str"as" ++ spc() ++ pr_dirpath dir))
-  | VernacRemoveLoadPath s -> str"Remove LoadPath" ++ qs s
-  | VernacAddMLPath (fl,s) ->
-      str"Add" ++ (if fl then str" Rec " else spc()) ++ str"ML Path" ++ qs s
-  | VernacDeclareMLModule (local, l) ->
-      pr_locality local ++
-      hov 2 (str"Declare ML Module" ++ spc() ++ prlist_with_sep sep qs l)
-  | VernacChdir s -> str"Cd" ++ pr_opt qs s
-
-  (* Commands *)
-  | VernacDeclareTacticDefinition (local,rc,l) ->
-      let pr_tac_body (id, redef, body) =
-        let idl, body =
-          match body with
-	    | Tacexpr.TacFun (idl,b) -> idl,b
-            | _ -> [], body in
-        pr_ltac_ref id ++
-	prlist (function None -> str " _"
-                       | Some id -> spc () ++ pr_id id) idl
-	++ (if redef then str" ::=" else str" :=") ++ brk(1,1) ++
-	let idl = List.map Option.get (List.filter (fun x -> not (x=None)) idl)in
-        pr_raw_tactic_env
-	  (idl @ List.map coerce_reference_to_id
-	    (List.map (fun (x, _, _) -> x) (List.filter (fun (_, redef, _) -> not redef) l)))
-	  (Global.env())
-	  body in
-      hov 1
-        (pr_locality local ++ str "Ltac " ++
-        prlist_with_sep (fun () -> fnl() ++ str"with ") pr_tac_body l)
-  | VernacCreateHintDb (local,dbname,b) ->
-      hov 1 (pr_locality local ++ str "Create HintDb " ++ 
-		str dbname ++ (if b then str" discriminated" else mt ()))
-  | VernacRemoveHints (local, dbnames, ids) ->
-      hov 1 (pr_locality local ++ str "Remove Hints " ++
-	       prlist_with_sep spc (fun r -> pr_id (coerce_reference_to_id r)) ids ++ 
-	       pr_opt_hintbases dbnames)
-  | VernacHints (local,dbnames,h) ->
-      pr_hints local dbnames h pr_constr pr_constr_pattern_expr
-  | VernacSyntacticDefinition (id,(ids,c),local,onlyparsing) ->
-      hov 2
-        (pr_locality local ++ str"Notation " ++ pr_lident id ++ spc () ++
-	 prlist (fun x -> spc() ++ pr_id x) ids ++ str":=" ++ pr_constrarg c ++
-         pr_syntax_modifiers
-	   (match onlyparsing with None -> [] | Some v -> [SetOnlyParsing v]))
-  | VernacDeclareImplicits (local,q,[]) ->
-      hov 2 (pr_section_locality local ++ str"Implicit Arguments" ++ spc() ++ 
-	pr_smart_global q)
-  | VernacDeclareImplicits (local,q,impls) ->
-      hov 1 (pr_section_locality local ++ str"Implicit Arguments " ++ 
-	spc() ++ pr_smart_global q ++ spc() ++
-	prlist_with_sep spc (fun imps ->
-	  str"[" ++ prlist_with_sep sep pr_explanation imps ++ str"]")
-	  impls)
-  | VernacArguments (local, q, impl, nargs, mods) ->
-      hov 2 (pr_section_locality local ++ str"Arguments" ++ spc() ++
-        pr_smart_global q ++
-      let pr_s = function None -> str"" | Some (_,s) -> str "%" ++ str s in
-      let pr_if b x = if b then x else str "" in
-      let pr_br imp max x = match imp, max with
-        | true, false -> str "[" ++ x ++ str "]"
-        | true, true -> str "{" ++ x ++ str "}"
-        | _ -> x in
-      let rec aux n l =
-        match n, l with
-        | 0, l -> spc () ++ str"/" ++ aux ~-1 l
-        | _, [] -> mt()
-        | n, (id,k,s,imp,max) :: tl ->
-            spc() ++ pr_br imp max (pr_if k (str"!") ++ pr_name id ++ pr_s s) ++
-            aux (n-1) tl in
-      prlist_with_sep (fun () -> str", ") (aux nargs) impl ++
-      if mods <> [] then str" : " else str"" ++
-      prlist_with_sep (fun () -> str", " ++ spc()) (function
-        | `SimplDontExposeCase -> str "simpl nomatch"
-        | `SimplNeverUnfold -> str "simpl never"
-        | `DefaultImplicits -> str "default implicits"
-        | `Rename -> str "rename"
-        | `ExtraScopes -> str "extra scopes"
-        | `ClearImplicits -> str "clear implicits"
-        | `ClearScopes -> str "clear scopes")
-        mods)
-  | VernacReserve bl ->
-      let n = List.length (List.flatten (List.map fst bl)) in
-      hov 2 (str"Implicit Type" ++
-        str (if n > 1 then "s " else " ") ++
-        pr_ne_params_list pr_lconstr_expr (List.map (fun sb -> false,sb) bl))
-  | VernacGeneralizable (local, g) ->
-      hov 1 (pr_locality local ++ str"Generalizable Variable" ++
-		match g with
-		| None -> str "s none"
-		| Some [] -> str "s all"
-		| Some idl ->
-		    str (if List.length idl > 1 then "s " else " ") ++
-		      prlist_with_sep spc pr_lident idl)
-  | VernacSetOpacity(b,[k,l]) when k=Conv_oracle.transparent ->
-      hov 1 (str"Transparent" ++ pr_non_locality b ++
-             spc() ++ prlist_with_sep sep pr_smart_global l)
-  | VernacSetOpacity(b,[Conv_oracle.Opaque,l]) ->
-      hov 1 (str"Opaque" ++ pr_non_locality b ++
-             spc() ++ prlist_with_sep sep pr_smart_global l)
-  | VernacSetOpacity (local,l) ->
-      let pr_lev = function
-          Conv_oracle.Opaque -> str"opaque"
-        | Conv_oracle.Expand -> str"expand"
-        | l when l = Conv_oracle.transparent -> str"transparent"
-        | Conv_oracle.Level n -> int n in
-      let pr_line (l,q) =
-        hov 2 (pr_lev l ++ spc() ++
-               str"[" ++ prlist_with_sep sep pr_smart_global q ++ str"]") in
-      hov 1 (pr_non_locality local ++ str"Strategy" ++ spc() ++
-             hv 0 (prlist_with_sep sep pr_line l))
-  | VernacUnsetOption (l,na) ->
-      hov 1 (pr_locality_full l ++ str"Unset" ++ spc() ++ pr_printoption na None)
-  | VernacSetOption (l,na,v) ->
-      hov 2 (pr_locality_full l ++ str"Set" ++ spc() ++ pr_set_option na v)
-  | VernacAddOption (na,l) -> hov 2 (str"Add" ++ spc() ++ pr_printoption na (Some l))
-  | VernacRemoveOption (na,l) -> hov 2 (str"Remove" ++ spc() ++ pr_printoption na (Some l))
-  | VernacMemOption (na,l) -> hov 2 (str"Test" ++ spc() ++ pr_printoption na (Some l))
-  | VernacPrintOption na -> hov 2 (str"Test" ++ spc() ++ pr_printoption na None)
-  | VernacCheckMayEval (r,io,c) ->
-      let pr_mayeval r c = match r with
-      | Some r0 ->
-          hov 2 (str"Eval" ++ spc() ++
-          pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r0 ++
-          spc() ++ str"in" ++ spc () ++ pr_lconstr c)
-      | None -> hov 2 (str"Check" ++ spc() ++ pr_lconstr c)
-      in
-      (if io = None then mt() else int (Option.get io) ++ str ": ") ++
-      pr_mayeval r c
-  | VernacGlobalCheck c -> hov 2 (str"Type" ++ pr_constrarg c)
-  | VernacDeclareReduction (b,s,r) ->
-     pr_locality b ++ str "Declare Reduction " ++ str s ++ str " := " ++
-     pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r
-  | VernacPrint p ->
-      let pr_printable = function
-	| PrintFullContext -> str"Print All"
-	| PrintSectionContext s ->
-            str"Print Section" ++ spc() ++ Libnames.pr_reference s
-	| PrintGrammar ent ->
-            str"Print Grammar" ++ spc() ++ str ent
-	| PrintLoadPath dir -> str"Print LoadPath" ++ pr_opt pr_dirpath dir
-	| PrintModules -> str"Print Modules"
-	| PrintMLLoadPath -> str"Print ML Path"
-	| PrintMLModules -> str"Print ML Modules"
-	| PrintGraph -> str"Print Graph"
-	| PrintClasses -> str"Print Classes"
-	| PrintTypeClasses -> str"Print TypeClasses"
-	| PrintInstances qid -> str"Print Instances" ++ spc () ++ pr_smart_global qid
-	| PrintLtac qid -> str"Print Ltac" ++ spc() ++ pr_ltac_ref qid
-	| PrintCoercions -> str"Print Coercions"
-	| PrintCoercionPaths (s,t) -> str"Print Coercion Paths" ++ spc() ++ pr_class_rawexpr s ++ spc() ++ pr_class_rawexpr t
-	| PrintCanonicalConversions -> str"Print Canonical Structures"
-	| PrintTables -> str"Print Tables"
-	| PrintHintGoal -> str"Print Hint"
-	| PrintHint qid -> str"Print Hint" ++ spc() ++ pr_smart_global qid
-	| PrintHintDb -> str"Print Hint *"
-	| PrintHintDbName s -> str"Print HintDb" ++ spc() ++ str s
-	| PrintRewriteHintDbName s -> str"Print Rewrite HintDb" ++ spc() ++ str s
-	| PrintUniverses (b, fopt) -> Printf.ksprintf str "Print %sUniverses" (if b then "Sorted " else "") ++ pr_opt str fopt
-	| PrintName qid -> str"Print" ++ spc()  ++ pr_smart_global qid
-	| PrintModuleType qid -> str"Print Module Type" ++ spc() ++ pr_reference qid
-	| PrintModule qid -> str"Print Module" ++ spc() ++ pr_reference qid
-	| PrintInspect n -> str"Inspect" ++ spc() ++ int n
-	| PrintScopes -> str"Print Scopes"
-	| PrintScope s -> str"Print Scope" ++ spc() ++ str s
-	| PrintVisibility s -> str"Print Visibility" ++ pr_opt str s
-	| PrintAbout qid -> str"About" ++ spc()  ++ pr_smart_global qid
-	| PrintImplicit qid -> str"Print Implicit" ++ spc()  ++ pr_smart_global qid
-(* spiwack: command printing all the axioms and section variables used in a
-         term *)
-	| PrintAssumptions (b,qid) -> (if b then str"Print Assumptions" else str"Print Opaque Dependencies")
-	    ++ spc() ++ pr_smart_global qid
-      in pr_printable p
-  | VernacSearch (sea,sea_r) -> pr_search sea sea_r pr_constr_pattern_expr
-  | VernacLocate loc ->
-      let pr_locate =function
-	| LocateTerm qid -> pr_smart_global qid
-	| LocateFile f -> str"File" ++ spc() ++ qs f
-	| LocateLibrary qid -> str"Library" ++ spc () ++ pr_module qid
-	| LocateModule qid -> str"Module" ++ spc () ++ pr_module qid
-	| LocateTactic qid -> str"Ltac" ++ spc () ++ pr_ltac_ref qid
-      in str"Locate" ++ spc() ++ pr_locate loc
-  | VernacComments l ->
-      hov 2
-        (str"Comments" ++ spc() ++ prlist_with_sep sep (pr_comment pr_constr) l)
-  | VernacNop -> mt()
-
-  (* Toplevel control *)
-  | VernacToplevelControl exn -> pr_topcmd exn
-
-  (* For extension *)
-  | VernacExtend (s,c) -> pr_extend s c
-  | VernacProof (None, None) -> str "Proof"
-  | VernacProof (None, Some l) -> str "Proof using" ++spc()++ prlist pr_lident l
-  | VernacProof (Some te, None) -> str "Proof with" ++ spc() ++ pr_raw_tactic te
-  | VernacProof (Some te, Some l) -> 
-      str "Proof using" ++spc()++ prlist pr_lident l ++ spc() ++
-      str "with" ++ spc() ++pr_raw_tactic te
-  | VernacProofMode s -> str ("Proof Mode "^s)
-  | VernacBullet b -> begin match b with
-      | Dash -> str"-"
-      | Star -> str"*"
-      | Plus -> str"+"
-  end ++ spc()
-  | VernacSubproof None -> str "{"
-  | VernacSubproof (Some i) -> str "BeginSubproof " ++ pr_int i
-  | VernacEndSubproof -> str "}"
-
-and pr_extend s cl =
-  let pr_arg a =
-    try pr_gen (Global.env()) a
-    with Failure _ -> str ("<error in "^s^">") in
-  try
-    let rls = List.assoc s (Egrammar.get_extend_vernac_grammars()) in
-    let rl = match_vernac_rule (List.map Genarg.genarg_tag cl) rls in
-    let start,rl,cl =
-      match rl with
-      | Egrammar.GramTerminal s :: rl -> str s, rl, cl
-      | Egrammar.GramNonTerminal _ :: rl -> pr_arg (List.hd cl), rl, List.tl cl
-      | [] -> anomaly "Empty entry" in
-    let (pp,_) =
-      List.fold_left
-        (fun (strm,args) pi ->
-          let pp,args = match pi with
-          | Egrammar.GramNonTerminal _ -> (pr_arg (List.hd args), List.tl args)
-          | Egrammar.GramTerminal s -> (str s, args) in
-          (strm ++ spc() ++ pp), args)
-        (start,cl) rl in
-    hov 1 pp
-  with Not_found ->
-    hov 1 (str ("TODO("^s) ++ prlist_with_sep sep pr_arg cl ++ str ")")
-
-in pr_vernac
-
-let pr_vernac v = make_pr_vernac pr_constr_expr pr_lconstr_expr v ++ sep_end v
diff --git a/parsing/ppvernac.mli b/parsing/ppvernac.mli
deleted file mode 100644
index 87b4fe56..00000000
--- a/parsing/ppvernac.mli
+++ /dev/null
@@ -1,24 +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 Genarg
-open Vernacexpr
-open Names
-open Nameops
-open Nametab
-open Util
-open Ppconstr
-open Pptactic
-open Glob_term
-open Pcoq
-open Libnames
-open Ppextend
-open Topconstr
-
-val pr_vernac : vernac_expr -> std_ppcmds
diff --git a/parsing/prettyp.ml b/parsing/prettyp.ml
deleted file mode 100644
index 3b3fb2c3..00000000
--- a/parsing/prettyp.ml
+++ /dev/null
@@ -1,794 +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        *)
-(************************************************************************)
-
-(* Changed by (and thus parts copyright ©) by Lionel Elie Mamane <lionel@mamane.lu>
- * on May-June 2006 for implementation of abstraction of pretty-printing of objects.
- *)
-
-open Pp
-open Util
-open Names
-open Nameops
-open Term
-open Termops
-open Declarations
-open Inductive
-open Inductiveops
-open Sign
-open Reduction
-open Environ
-open Declare
-open Impargs
-open Libobject
-open Printer
-open Printmod
-open Libnames
-open Nametab
-open Recordops
-
-type object_pr = {
-  print_inductive           : mutual_inductive -> std_ppcmds;
-  print_constant_with_infos : constant -> std_ppcmds;
-  print_section_variable    : variable -> std_ppcmds;
-  print_syntactic_def       : kernel_name -> std_ppcmds;
-  print_module              : bool -> Names.module_path -> std_ppcmds;
-  print_modtype             : module_path -> std_ppcmds;
-  print_named_decl          : identifier * constr option * types -> std_ppcmds;
-  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
-  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
-  print_typed_value_in_env  : Environ.env -> Term.constr * Term.types -> Pp.std_ppcmds;
-  print_eval                : Reductionops.reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds;
-}
-
-let gallina_print_module  = print_module
-let gallina_print_modtype = print_modtype
-
-(**************)
-(** Utilities *)
-
-let print_closed_sections = ref false
-
-let pr_infos_list l = v 0 (prlist_with_sep cut (fun x -> x) l) ++ fnl()
-
-let with_line_skip l = if l = [] then mt() else fnl() ++ pr_infos_list l
-
-let blankline = mt() (* add a blank sentence in the list of infos *)
-
-let add_colon prefix = if ismt prefix then mt () else prefix ++ str ": "
-
-let int_or_no n = if n=0 then str "no" else int n
-
-(*******************)
-(** Basic printing *)
-
-let print_basename sp = pr_global (ConstRef sp)
-
-let print_ref reduce ref =
-  let typ = Global.type_of_global ref in
-  let typ =
-    if reduce then
-      let ctx,ccl = Reductionops.splay_prod_assum (Global.env()) Evd.empty typ
-      in it_mkProd_or_LetIn ccl ctx
-    else typ in
-  hov 0 (pr_global ref ++ str " :" ++ spc () ++ pr_ltype typ)
-
-(********************************)
-(** Printing implicit arguments *)
-
-let conjugate_verb_to_be = function [_] -> "is" | _ -> "are"
-
-let pr_impl_name imp = pr_id (name_of_implicit imp)
-
-let print_impargs_by_name max = function
-  | []  -> []
-  | impls ->
-     [hov 0 (str (plural (List.length impls) "Argument") ++ spc() ++
-      prlist_with_sep pr_comma pr_impl_name impls ++ spc() ++
-      str (conjugate_verb_to_be impls) ++ str" implicit" ++
-      (if max then strbrk " and maximally inserted" else mt()))]
-
-let print_one_impargs_list l =
-  let imps = List.filter is_status_implicit l in
-  let maximps = List.filter Impargs.maximal_insertion_of imps in
-  let nonmaximps = list_subtract imps maximps in
-  print_impargs_by_name false nonmaximps @
-  print_impargs_by_name true maximps
-
-let print_impargs_list prefix l =
-  let l = extract_impargs_data l in
-  List.flatten (List.map (fun (cond,imps) ->
-    match cond with
-    | None ->
-	List.map (fun pp -> add_colon prefix ++ pp)
-	  (print_one_impargs_list imps)
-    | Some (n1,n2) ->
-       [v 2 (prlist_with_sep cut (fun x -> x)
-	 [(if ismt prefix then str "When" else prefix ++ str ", when") ++
-	   str " applied to " ++
-	   (if n1 = n2 then int_or_no n2 else
-	    if n1 = 0 then str "less than " ++ int n2
-	    else int n1 ++ str " to " ++ int_or_no n2) ++
-	    str (plural n2 " argument") ++ str ":";
-          v 0 (prlist_with_sep cut (fun x -> x)
-	    (if List.exists is_status_implicit imps
-	    then print_one_impargs_list imps
-	    else [str "No implicit arguments"]))])]) l)
-
-let print_renames_list prefix l =
-  if l = [] then [] else
-  [add_colon prefix ++ str "Arguments are renamed to " ++
-    hv 2 (prlist_with_sep pr_comma (fun x -> x) (List.map pr_name l))]
-
-let need_expansion impl ref =
-  let typ = Global.type_of_global ref in
-  let ctx = (prod_assum typ) in
-  let nprods = List.length (List.filter (fun (_,b,_) -> b=None) ctx) in
-  impl <> [] & List.length impl >= nprods &
-    let _,lastimpl = list_chop nprods impl in
-      List.filter is_status_implicit lastimpl <> []
-
-let print_impargs ref =
-  let ref = Smartlocate.smart_global ref in
-  let impl = implicits_of_global ref in
-  let has_impl = impl <> [] in
-  (* Need to reduce since implicits are computed with products flattened *)
-  pr_infos_list
-    ([ print_ref (need_expansion (select_impargs_size 0 impl) ref) ref;
-       blankline ] @
-    (if has_impl then print_impargs_list (mt()) impl
-     else [str "No implicit arguments"]))
-
-(*********************)
-(** Printing Scopes  *)
-
-let print_argument_scopes prefix = function
-  | [Some sc] ->
-      [add_colon prefix ++ str"Argument scope is [" ++ str sc ++ str"]"]
-  | l when not (List.for_all ((=) None) l) ->
-     [add_colon prefix ++ hov 2 (str"Argument scopes are" ++ spc() ++
-      str "[" ++
-      prlist_with_sep spc (function Some sc -> str sc | None -> str "_") l ++
-      str "]")]
-  | _  -> []
-
-(*****************************)
-(** Printing simpl behaviour *)
-
-let print_simpl_behaviour ref =
-  match Tacred.get_simpl_behaviour ref with
-  | None -> []
-  | Some (recargs, nargs, flags) ->
-     let never = List.mem `SimplNeverUnfold flags in
-     let nomatch = List.mem `SimplDontExposeCase flags in
-     let pp_nomatch = spc() ++ if nomatch then
-       str "avoiding to expose match constructs" else str"" in
-     let pp_recargs = spc() ++ str "when the " ++
-       let rec aux = function
-         | [] -> mt()
-         | [x] -> str (ordinal (x+1))
-         | [x;y] -> str (ordinal (x+1)) ++ str " and " ++ str (ordinal (y+1))
-         | x::tl -> str (ordinal (x+1)) ++ str ", " ++ aux tl in
-       aux recargs ++ str (plural (List.length recargs) " argument") ++
-       str (plural (if List.length recargs >= 2 then 1 else 2) " evaluate") ++
-       str " to a constructor" in
-     let pp_nargs =
-       spc() ++ str "when applied to " ++ int nargs ++
-       str (plural nargs " argument") in
-     [hov 2 (str "The simpl tactic " ++
-     match recargs, nargs, never with
-     | _,_, true -> str "never unfolds " ++ pr_global ref
-     | [], 0, _ -> str "always unfolds " ++ pr_global ref
-     | _::_, n, _ when n < 0 ->
-        str "unfolds " ++ pr_global ref ++ pp_recargs ++ pp_nomatch
-     | _::_, n, _ when n > List.fold_left max 0 recargs ->
-        str "unfolds " ++ pr_global ref ++ pp_recargs ++
-        str " and" ++ pp_nargs ++ pp_nomatch
-     | _::_, _, _ ->
-        str "unfolds " ++ pr_global ref ++ pp_recargs ++ pp_nomatch
-     | [], n, _ when n > 0 ->
-        str "unfolds " ++ pr_global ref ++ pp_nargs ++ pp_nomatch
-     | _ -> str "unfolds " ++ pr_global ref ++ pp_nomatch )]
-;;
-
-(*********************)
-(** Printing Opacity *)
-
-type opacity =
-  | FullyOpaque
-  | TransparentMaybeOpacified of Conv_oracle.level
-
-let opacity env = function
-  | VarRef v when pi2 (Environ.lookup_named v env) <> None ->
-      Some(TransparentMaybeOpacified (Conv_oracle.get_strategy(VarKey v)))
-  | ConstRef cst ->
-      let cb = Environ.lookup_constant cst env in
-      (match cb.const_body with
-	| Undef _ -> None
-	| OpaqueDef _ -> Some FullyOpaque
-	| Def _ -> Some
-          (TransparentMaybeOpacified (Conv_oracle.get_strategy(ConstKey cst))))
-  | _ -> None
-
-let print_opacity ref =
-  match opacity (Global.env()) ref with
-    | None -> []
-    | Some s ->
-       [pr_global ref ++ str " is " ++
-        str (match s with
-          | FullyOpaque -> "opaque"
-          | TransparentMaybeOpacified Conv_oracle.Opaque ->
-              "basically transparent but considered opaque for reduction"
-          | TransparentMaybeOpacified lev when lev = Conv_oracle.transparent ->
-              "transparent"
-          | TransparentMaybeOpacified (Conv_oracle.Level n) ->
-              "transparent (with expansion weight "^string_of_int n^")"
-          | TransparentMaybeOpacified Conv_oracle.Expand ->
-              "transparent (with minimal expansion weight)")]
-
-(*******************)
-(* *)
-
-let print_name_infos ref =
-  let impls = implicits_of_global ref in
-  let scopes = Notation.find_arguments_scope ref in
-  let renames =
-    try List.hd (Arguments_renaming.arguments_names ref) with Not_found -> [] in
-  let type_info_for_implicit =
-    if need_expansion (select_impargs_size 0 impls) ref then
-      (* Need to reduce since implicits are computed with products flattened *)
-      [str "Expanded type for implicit arguments";
-       print_ref true ref; blankline]
-    else
-      [] in
-  type_info_for_implicit @
-  print_renames_list (mt()) renames @
-  print_impargs_list (mt()) impls @
-  print_argument_scopes (mt()) scopes
-
-let print_id_args_data test pr id l =
-  if List.exists test l then
-    pr (str "For " ++ pr_id id) l
-  else
-    []
-
-let print_args_data_of_inductive_ids get test pr sp mipv =
-  List.flatten (Array.to_list (Array.mapi
-    (fun i mip ->
-      print_id_args_data test pr mip.mind_typename (get (IndRef (sp,i))) @
-      List.flatten (Array.to_list (Array.mapi
-	(fun j idc ->
-	  print_id_args_data test pr idc (get (ConstructRef ((sp,i),j+1))))
-        mip.mind_consnames)))
-    mipv))
-
-let print_inductive_implicit_args =
-  print_args_data_of_inductive_ids
-    implicits_of_global (fun l -> positions_of_implicits l <> [])
-    print_impargs_list
-
-let print_inductive_renames =
-  print_args_data_of_inductive_ids
-    (fun r ->
-      try List.hd (Arguments_renaming.arguments_names r)
-      with e when Errors.noncritical e -> [])
-    ((<>) Anonymous)
-    print_renames_list
-
-let print_inductive_argument_scopes =
-  print_args_data_of_inductive_ids
-    Notation.find_arguments_scope ((<>) None) print_argument_scopes
-
-(*********************)
-(* "Locate" commands *)
-
-type logical_name =
-  | Term of global_reference
-  | Dir of global_dir_reference
-  | Syntactic of kernel_name
-  | ModuleType of qualid * module_path
-  | Undefined of qualid
-
-let locate_any_name ref =
-  let module N = Nametab in
-  let (loc,qid) = qualid_of_reference ref in
-  try Term (N.locate qid)
-  with Not_found ->
-  try Syntactic (N.locate_syndef qid)
-  with Not_found ->
-  try Dir (N.locate_dir qid)
-  with Not_found ->
-  try ModuleType (qid, N.locate_modtype qid)
-  with Not_found -> Undefined qid
-
-let pr_located_qualid = function
-  | Term ref ->
-      let ref_str = match ref with
-	  ConstRef _ -> "Constant"
-	| IndRef _ -> "Inductive"
-	| ConstructRef _ -> "Constructor"
-	| VarRef _ -> "Variable" in
-      str ref_str ++ spc () ++ pr_path (Nametab.path_of_global ref)
-  | Syntactic kn ->
-      str "Notation" ++ spc () ++ pr_path (Nametab.path_of_syndef kn)
-  | Dir dir ->
-      let s,dir = match dir with
-	| DirOpenModule (dir,_) -> "Open Module", dir
-	| DirOpenModtype (dir,_) -> "Open Module Type", dir
-	| DirOpenSection (dir,_) -> "Open Section", dir
-	| DirModule (dir,_) -> "Module", dir
-	| DirClosedSection dir -> "Closed Section", dir
-      in
-      str s ++ spc () ++ pr_dirpath dir
-  | ModuleType (qid,_) ->
-      str "Module Type" ++ spc () ++ pr_path (Nametab.full_name_modtype qid)
-  | Undefined qid ->
-      pr_qualid qid ++ spc () ++ str "not a defined object."
-
-let print_located_qualid ref =
-  let (loc,qid) = qualid_of_reference ref in
-  let module N = Nametab in
-  let expand = function
-    | TrueGlobal ref ->
-	Term ref, N.shortest_qualid_of_global Idset.empty ref
-    | SynDef kn ->
-	Syntactic kn, N.shortest_qualid_of_syndef Idset.empty kn in
-  match List.map expand (N.locate_extended_all qid) with
-    | [] ->
-	let (dir,id) = repr_qualid qid in
-	if dir = empty_dirpath then
-	  str "No object of basename " ++ pr_id id
-	else
-	  str "No object of suffix " ++ pr_qualid qid
-    | l ->
-	prlist_with_sep fnl
-	(fun (o,oqid) ->
-	  hov 2 (pr_located_qualid o ++
-	  (if oqid <> qid then
-	    spc() ++ str "(shorter name to refer to it in current context is " ++ pr_qualid oqid ++ str")"
-	  else
-	    mt ()))) l
-
-(******************************************)
-(**** Printing declarations and judgments *)
-(****  Gallina layer                  *****)
-
-let gallina_print_typed_value_in_env env (trm,typ) =
-  (pr_lconstr_env env trm ++ fnl () ++
-     str "     : " ++ pr_ltype_env env typ ++ fnl ())
-
-(* To be improved; the type should be used to provide the types in the
-   abstractions. This should be done recursively inside pr_lconstr, so that
-   the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u)
-   synthesizes the type nat of the abstraction on u *)
-
-let print_named_def name body typ =
-  let pbody = pr_lconstr body in
-  let ptyp = pr_ltype typ in
-  let pbody = if isCast body then surround pbody else pbody in
-  (str "*** [" ++ str name ++ str " " ++
-     hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++
-	      str ":" ++ brk (1,2) ++ ptyp) ++
-	   str "]")
-
-let print_named_assum name typ =
-  str "*** [" ++ str name ++ str " : " ++ pr_ltype typ ++ str "]"
-
-let gallina_print_named_decl (id,c,typ) =
-  let s = string_of_id id in
-  match c with
-    | Some body -> print_named_def s body typ
-    | None -> print_named_assum s typ
-
-let assumptions_for_print lna =
-  List.fold_right (fun na env -> add_name na env) lna empty_names_context
-
-(*********************)
-(* *)
-
-let gallina_print_inductive sp =
-  let env = Global.env() in
-  let mib = Environ.lookup_mind sp env in
-  let mipv = mib.mind_packets in
-  pr_mutual_inductive_body env sp mib ++ fnl () ++
-  with_line_skip
-    (print_inductive_renames sp mipv @
-     print_inductive_implicit_args sp mipv @
-     print_inductive_argument_scopes sp mipv)
-
-let print_named_decl id =
-  gallina_print_named_decl (Global.lookup_named id) ++ fnl ()
-
-let gallina_print_section_variable id =
-  print_named_decl id ++
-  with_line_skip (print_name_infos (VarRef id))
-
-let print_body = function
-  | Some lc  -> pr_lconstr (Declarations.force lc)
-  | None -> (str"<no body>")
-
-let print_typed_body (val_0,typ) =
-  (print_body val_0 ++ fnl () ++ str "     : " ++ pr_ltype typ)
-
-let ungeneralized_type_of_constant_type = function
-  | PolymorphicArity (ctx,a) -> mkArity (ctx, Type a.poly_level)
-  | NonPolymorphicType t -> t
-
-let print_constant with_values sep sp =
-  let cb = Global.lookup_constant sp in
-  let val_0 = body_of_constant cb in
-  let typ = ungeneralized_type_of_constant_type cb.const_type in
-  hov 0 (
-    match val_0 with
-    | None ->
-	str"*** [ " ++
-	print_basename sp ++ str " : " ++ cut () ++ pr_ltype typ ++
-	str" ]"
-    | _ ->
-	print_basename sp ++ str sep ++ cut () ++
-	(if with_values then print_typed_body (val_0,typ) else pr_ltype typ))
-  ++ fnl ()
-
-let gallina_print_constant_with_infos sp =
-  print_constant true " = " sp ++
-  with_line_skip (print_name_infos (ConstRef sp))
-
-let gallina_print_syntactic_def kn =
-  let qid = Nametab.shortest_qualid_of_syndef Idset.empty kn
-  and (vars,a) = Syntax_def.search_syntactic_definition kn in
-  let c = Topconstr.glob_constr_of_aconstr dummy_loc a in
-  hov 2
-    (hov 4
-       (str "Notation " ++ pr_qualid qid ++
-        prlist (fun id -> spc () ++ pr_id id) (List.map fst vars) ++ 
-        spc () ++ str ":=") ++
-     spc () ++ Constrextern.without_symbols pr_glob_constr c) ++ fnl ()
-
-let gallina_print_leaf_entry with_values ((sp,kn as oname),lobj) =
-  let sep = if with_values then " = " else " : "
-  and tag = object_tag lobj in
-    match (oname,tag) with
-      | (_,"VARIABLE") ->
-	  (* Outside sections, VARIABLES still exist but only with universes
-             constraints *)
-	  (try Some(print_named_decl (basename sp)) with Not_found -> None)
-      | (_,"CONSTANT") ->
-	  Some (print_constant with_values sep (constant_of_kn kn))
-      | (_,"INDUCTIVE") ->
-	  Some (gallina_print_inductive (mind_of_kn kn))
-      | (_,"MODULE") ->
-	  let (mp,_,l) = repr_kn kn in
-	    Some (print_module with_values (MPdot (mp,l)))
-      | (_,"MODULE TYPE") ->
-	  let (mp,_,l) = repr_kn kn in
-	  Some (print_modtype (MPdot (mp,l)))
-      | (_,("AUTOHINT"|"GRAMMAR"|"SYNTAXCONSTANT"|"PPSYNTAX"|"TOKEN"|"CLASS"|
-	    "COERCION"|"REQUIRE"|"END-SECTION"|"STRUCTURE")) -> None
-      (* To deal with forgotten cases... *)
-      | (_,s) -> None
-
-let gallina_print_library_entry with_values ent =
-  let pr_name (sp,_) = pr_id (basename sp) in
-  match ent with
-    | (oname,Lib.Leaf lobj) ->
-	gallina_print_leaf_entry with_values (oname,lobj)
-    | (oname,Lib.OpenedSection (dir,_)) ->
-        Some (str " >>>>>>> Section " ++ pr_name oname)
-    | (oname,Lib.ClosedSection _) ->
-        Some (str " >>>>>>> Closed Section " ++ pr_name oname)
-    | (_,Lib.CompilingLibrary (dir,_)) ->
-	Some (str " >>>>>>> Library " ++ pr_dirpath dir)
-    | (oname,Lib.OpenedModule _) ->
-	Some (str " >>>>>>> Module " ++ pr_name oname)
-    | (oname,Lib.ClosedModule _) ->
-        Some (str " >>>>>>> Closed Module " ++ pr_name oname)
-    | (_,Lib.FrozenState _) ->
-	None
-
-let gallina_print_context with_values =
-  let rec prec n = function
-    | h::rest when n = None or Option.get n > 0 ->
-	(match gallina_print_library_entry with_values h with
-	  | None -> prec n rest
-	  | Some pp -> prec (Option.map ((+) (-1)) n) rest ++ pp ++ fnl ())
-    | _ -> mt ()
-  in
-  prec
-
-let gallina_print_eval red_fun env evmap _ {uj_val=trm;uj_type=typ} =
-  let ntrm = red_fun env evmap trm in
-  (str "     = " ++ gallina_print_typed_value_in_env env (ntrm,typ))
-
-(******************************************)
-(**** Printing abstraction layer          *)
-
-let default_object_pr = {
-  print_inductive           = gallina_print_inductive;
-  print_constant_with_infos = gallina_print_constant_with_infos;
-  print_section_variable    = gallina_print_section_variable;
-  print_syntactic_def       = gallina_print_syntactic_def;
-  print_module              = gallina_print_module;
-  print_modtype             = gallina_print_modtype;
-  print_named_decl          = gallina_print_named_decl;
-  print_library_entry       = gallina_print_library_entry;
-  print_context             = gallina_print_context;
-  print_typed_value_in_env  = gallina_print_typed_value_in_env;
-  print_eval                = gallina_print_eval;
-}
-
-let object_pr = ref default_object_pr
-let set_object_pr = (:=) object_pr
-
-let print_inductive x = !object_pr.print_inductive x
-let print_constant_with_infos c = !object_pr.print_constant_with_infos c
-let print_section_variable c = !object_pr.print_section_variable c
-let print_syntactic_def x = !object_pr.print_syntactic_def x
-let print_module x  = !object_pr.print_module  x
-let print_modtype x = !object_pr.print_modtype x
-let print_named_decl x = !object_pr.print_named_decl x
-let print_library_entry x = !object_pr.print_library_entry x
-let print_context x = !object_pr.print_context x
-let print_typed_value_in_env x = !object_pr.print_typed_value_in_env x
-let print_eval x = !object_pr.print_eval x
-
-(******************************************)
-(**** Printing declarations and judgments *)
-(****  Abstract layer                 *****)
-
-let print_typed_value x = print_typed_value_in_env (Global.env ()) x
-
-let print_judgment env {uj_val=trm;uj_type=typ} =
-  print_typed_value_in_env env (trm, typ)
-
-let print_safe_judgment env j =
-  let trm = Safe_typing.j_val j in
-  let typ = Safe_typing.j_type j in
-  print_typed_value_in_env env (trm, typ)
-
-(*********************)
-(* *)
-
-let print_full_context () =
-  print_context true None (Lib.contents_after None)
-
-let print_full_context_typ () =
-  print_context false None (Lib.contents_after None)
-
-let print_full_pure_context () =
-  let rec prec = function
-  | ((_,kn),Lib.Leaf lobj)::rest ->
-      let pp = match object_tag lobj with
-      | "CONSTANT" ->
-	  let con = Global.constant_of_delta_kn kn in
-	  let cb = Global.lookup_constant con in
-	  let typ = ungeneralized_type_of_constant_type cb.const_type in
-	  hov 0 (
-	    match cb.const_body with
-	      | Undef _ ->
-		str "Parameter " ++
-		print_basename con ++ str " : " ++ cut () ++ pr_ltype typ
-	      | OpaqueDef lc ->
-		str "Theorem " ++ print_basename con ++ cut () ++
-		str " : " ++ pr_ltype typ ++ str "." ++ fnl () ++
-		str "Proof " ++ pr_lconstr (Declarations.force_opaque lc)
-	      | Def c ->
-		str "Definition " ++ print_basename con ++ cut () ++
-		str "  : " ++ pr_ltype typ ++ cut () ++ str " := " ++
-		pr_lconstr (Declarations.force c))
-          ++ str "." ++ fnl () ++ fnl ()
-      | "INDUCTIVE" ->
-	  let mind = Global.mind_of_delta_kn kn in
-	  let mib = Global.lookup_mind mind in
-	  pr_mutual_inductive_body (Global.env()) mind mib ++
-	    str "." ++ fnl () ++ fnl ()
-      | "MODULE" ->
-	  (* TODO: make it reparsable *)
-	  let (mp,_,l) = repr_kn kn in
-	  print_module true (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
-      | "MODULE TYPE" ->
-	  (* TODO: make it reparsable *)
-	  (* TODO: make it reparsable *)
-	  let (mp,_,l) = repr_kn kn in
-	  print_modtype (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
-      | _ -> mt () in
-      prec rest ++ pp
-  | _::rest -> prec rest
-  | _ -> mt () in
-  prec (Lib.contents_after None)
-
-(* For printing an inductive definition with
-   its constructors and elimination,
-   assume that the declaration of constructors and eliminations
-   follows the definition of the inductive type *)
-
-(* This is designed to print the contents of an opened section *)
-let read_sec_context r =
-  let loc,qid = qualid_of_reference r in
-  let dir =
-    try Nametab.locate_section qid
-    with Not_found ->
-      user_err_loc (loc,"read_sec_context", str "Unknown section.") in
-  let rec get_cxt in_cxt = function
-    | (_,Lib.OpenedSection ((dir',_),_) as hd)::rest ->
-        if dir = dir' then (hd::in_cxt) else get_cxt (hd::in_cxt) rest
-    | (_,Lib.ClosedSection _)::rest ->
-        error "Cannot print the contents of a closed section."
-	(* LEM: Actually, we could if we wanted to. *)
-    | [] -> []
-    | hd::rest -> get_cxt (hd::in_cxt) rest
-  in
-  let cxt = (Lib.contents_after None) in
-  List.rev (get_cxt [] cxt)
-
-let print_sec_context sec =
-  print_context true None (read_sec_context sec)
-
-let print_sec_context_typ sec =
-  print_context false None (read_sec_context sec)
-
-let print_any_name = function
-  | Term (ConstRef sp) -> print_constant_with_infos sp
-  | Term (IndRef (sp,_)) -> print_inductive sp
-  | Term (ConstructRef ((sp,_),_)) -> print_inductive sp
-  | Term (VarRef sp) -> print_section_variable sp
-  | Syntactic kn -> print_syntactic_def kn
-  | Dir (DirModule(dirpath,(mp,_))) -> print_module (printable_body dirpath) mp
-  | Dir _ -> mt ()
-  | ModuleType (_,kn) -> print_modtype kn
-  | Undefined qid ->
-  try  (* Var locale de but, pas var de section... donc pas d'implicits *)
-    let dir,str = repr_qualid qid in
-    if (repr_dirpath dir) <> [] then raise Not_found;
-    let (_,c,typ) = Global.lookup_named str in
-    (print_named_decl (str,c,typ))
-  with Not_found ->
-    errorlabstrm
-      "print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
-
-let print_name = function
-  | Genarg.ByNotation (loc,ntn,sc) ->
-      print_any_name
-        (Term (Notation.interp_notation_as_global_reference loc (fun _ -> true)
-               ntn sc))
-  | Genarg.AN ref ->
-      print_any_name (locate_any_name ref)
-
-let print_opaque_name qid =
-  let env = Global.env () in
-  match global qid with
-    | ConstRef cst ->
-	let cb = Global.lookup_constant cst in
-        if constant_has_body cb then
-	  print_constant_with_infos cst
-        else
-	  error "Not a defined constant."
-    | IndRef (sp,_) ->
-        print_inductive sp
-    | ConstructRef cstr ->
-	let ty = Inductiveops.type_of_constructor env cstr in
-	print_typed_value (mkConstruct cstr, ty)
-    | VarRef id ->
-        let (_,c,ty) = lookup_named id env in
-	print_named_decl (id,c,ty)
-
-let print_about_any loc k =
-  match k with
-  | Term ref ->
-    Dumpglob.add_glob loc ref;
-      pr_infos_list
-       (print_ref false ref :: blankline ::
-	print_name_infos ref @
-	print_simpl_behaviour ref @
-	print_opacity ref @
-	[hov 0 (str "Expands to: " ++ pr_located_qualid k)])
-  | Syntactic kn ->
-    let () = match Syntax_def.search_syntactic_definition kn with
-    | [],Topconstr.ARef ref -> Dumpglob.add_glob loc ref
-    | _ -> () in
-      v 0 (
-      print_syntactic_def kn ++
-      hov 0 (str "Expands to: " ++ pr_located_qualid k)) ++ fnl()
-  | Dir _ | ModuleType _ | Undefined _ ->
-      hov 0 (pr_located_qualid k) ++ fnl()
-
-let print_about = function
-  | Genarg.ByNotation (loc,ntn,sc) ->
-      print_about_any loc
-        (Term (Notation.interp_notation_as_global_reference loc (fun _ -> true)
-               ntn sc))
-  | Genarg.AN ref ->
-      print_about_any (loc_of_reference ref) (locate_any_name ref)
-
-(* for debug *)
-let inspect depth =
-  print_context false (Some depth) (Lib.contents_after None)
-
-
-(*************************************************************************)
-(* Pretty-printing functions coming from classops.ml                     *)
-
-open Classops
-
-let print_coercion_value v = pr_lconstr (get_coercion_value v)
-
-let print_class i =
-  let cl,_ = class_info_from_index i in
-  pr_class cl
-
-let print_path ((i,j),p) =
-  hov 2 (
-    str"[" ++ hov 0 (prlist_with_sep pr_semicolon print_coercion_value p) ++
-    str"] : ") ++
-  print_class i ++ str" >-> " ++ print_class j
-
-let _ = Classops.install_path_printer print_path
-
-let print_graph () =
-  prlist_with_sep pr_fnl print_path (inheritance_graph())
-
-let print_classes () =
-  prlist_with_sep pr_spc pr_class (classes())
-
-let print_coercions () =
-  prlist_with_sep pr_spc print_coercion_value (coercions())
-
-let index_of_class cl =
-  try
-    fst (class_info cl)
-  with e when Errors.noncritical e ->
-    errorlabstrm "index_of_class"
-      (pr_class cl ++ spc() ++ str "not a defined class.")
-
-let print_path_between cls clt =
-  let i = index_of_class cls in
-  let j = index_of_class clt in
-  let p =
-    try
-      lookup_path_between_class (i,j)
-    with e when Errors.noncritical e ->
-      errorlabstrm "index_cl_of_id"
-        (str"No path between " ++ pr_class cls ++ str" and " ++ pr_class clt
-	 ++ str ".")
-  in
-  print_path ((i,j),p)
-
-let print_canonical_projections () =
-  prlist_with_sep pr_fnl
-    (fun ((r1,r2),o) -> pr_cs_pattern r2 ++
-    str " <- " ++
-    pr_global r1 ++ str " ( " ++ pr_lconstr o.o_DEF ++ str " )")
-    (canonical_projections ())
-
-(*************************************************************************)
-
-(*************************************************************************)
-(* Pretty-printing functions for type classes                     *)
-
-open Typeclasses
-
-let pr_typeclass env t =
-  print_ref false t.cl_impl ++ fnl ()
-
-let print_typeclasses () =
-  let env = Global.env () in
-    prlist_with_sep fnl (pr_typeclass env) (typeclasses ())
-
-let pr_instance env i =
-  (*   gallina_print_constant_with_infos i.is_impl *)
-  (* lighter *)
-  print_ref false (instance_impl i) ++ fnl ()
-
-let print_all_instances () =
-  let env = Global.env () in
-  let inst = all_instances () in
-    prlist_with_sep fnl (pr_instance env) inst
-
-let print_instances r =
-  let env = Global.env () in
-  let inst = instances r in
-    prlist_with_sep fnl (pr_instance env) inst
-
diff --git a/parsing/prettyp.mli b/parsing/prettyp.mli
deleted file mode 100644
index 4cf3e489..00000000
--- a/parsing/prettyp.mli
+++ /dev/null
@@ -1,74 +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 Sign
-open Term
-open Environ
-open Reductionops
-open Libnames
-open Nametab
-open Genarg
-
-(** A Pretty-Printer for the Calculus of Inductive Constructions. *)
-
-val assumptions_for_print : name list -> Termops.names_context
-
-val print_closed_sections : bool ref
-val print_context : bool -> int option -> Lib.library_segment -> std_ppcmds
-val print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option
-val print_full_context : unit -> std_ppcmds
-val print_full_context_typ : unit -> std_ppcmds
-val print_full_pure_context : unit -> std_ppcmds
-val print_sec_context : reference -> std_ppcmds
-val print_sec_context_typ : reference -> std_ppcmds
-val print_judgment : env -> unsafe_judgment -> std_ppcmds
-val print_safe_judgment : env -> Safe_typing.judgment -> std_ppcmds
-val print_eval :
-  reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds
-
-val print_name : reference or_by_notation -> std_ppcmds
-val print_opaque_name : reference -> std_ppcmds
-val print_about : reference or_by_notation -> std_ppcmds
-val print_impargs : reference or_by_notation -> std_ppcmds
-
-(** Pretty-printing functions for classes and coercions *)
-val print_graph : unit -> std_ppcmds
-val print_classes : unit -> std_ppcmds
-val print_coercions : unit -> std_ppcmds
-val print_path_between : Classops.cl_typ -> Classops.cl_typ -> std_ppcmds
-val print_canonical_projections : unit -> std_ppcmds
-
-(** Pretty-printing functions for type classes and instances *)
-val print_typeclasses : unit -> std_ppcmds
-val print_instances : global_reference -> std_ppcmds
-val print_all_instances : unit -> std_ppcmds
-
-val inspect : int -> std_ppcmds
-
-(** Locate *)
-val print_located_qualid : reference -> std_ppcmds
-
-type object_pr = {
-  print_inductive           : mutual_inductive -> std_ppcmds;
-  print_constant_with_infos : constant -> std_ppcmds;
-  print_section_variable    : variable -> std_ppcmds;
-  print_syntactic_def       : kernel_name -> std_ppcmds;
-  print_module              : bool -> Names.module_path -> std_ppcmds;
-  print_modtype             : module_path -> std_ppcmds;
-  print_named_decl          : identifier * constr option * types -> std_ppcmds;
-  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
-  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
-  print_typed_value_in_env  : Environ.env -> Term.constr * Term.types -> Pp.std_ppcmds;
-  print_eval                : reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds
-}
-
-val set_object_pr : object_pr -> unit
-val default_object_pr : object_pr
diff --git a/parsing/printer.ml b/parsing/printer.ml
deleted file mode 100644
index 1b887e6e..00000000
--- a/parsing/printer.ml
+++ /dev/null
@@ -1,790 +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 Term
-open Sign
-open Environ
-open Global
-open Declare
-open Libnames
-open Nametab
-open Evd
-open Proof_type
-open Refiner
-open Pfedit
-open Ppconstr
-open Constrextern
-open Tacexpr
-open Declarations
-
-open Store.Field
-
-let emacs_str s =
-  if !Flags.print_emacs then s else ""
-let delayed_emacs_cmd s =
-  if !Flags.print_emacs then s () else str ""
-
-(**********************************************************************)
-(** Terms                                                             *)
-
-(* [goal_concl_style] means that all names of goal/section variables
-   and all names of rel variables (if any) in the given env and all short
-   names of global definitions of the current module must be avoided while
-   printing bound variables.
-   Otherwise, short names of global definitions are printed qualified
-   and only names of goal/section variables and rel names that do
-   _not_ occur in the scope of the binder to be printed are avoided. *)
-
-let pr_constr_core goal_concl_style env t =
-  pr_constr_expr (extern_constr goal_concl_style env t)
-let pr_lconstr_core goal_concl_style env t =
-  pr_lconstr_expr (extern_constr goal_concl_style env t)
-
-let pr_lconstr_env env = pr_lconstr_core false env
-let pr_constr_env env = pr_constr_core false env
-
-let pr_open_lconstr_env env (_,c) = pr_lconstr_env env c
-let pr_open_constr_env env (_,c) = pr_constr_env env c
-
-  (* NB do not remove the eta-redexes! Global.env() has side-effects... *)
-let pr_lconstr t = pr_lconstr_env (Global.env()) t
-let pr_constr t = pr_constr_env (Global.env()) t
-
-let pr_open_lconstr (_,c) = pr_lconstr c
-let pr_open_constr (_,c) = pr_constr c
-
-let pr_constr_under_binders_env_gen pr env (ids,c) =
-  (* Warning: clashes can occur with variables of same name in env but *)
-  (* we also need to preserve the actual names of the patterns *)
-  (* So what to do? *)
-  let assums = List.map (fun id -> (Name id,(* dummy *) mkProp)) ids in
-  pr (Termops.push_rels_assum assums env) c
-
-let pr_constr_under_binders_env = pr_constr_under_binders_env_gen pr_constr_env
-let pr_lconstr_under_binders_env = pr_constr_under_binders_env_gen pr_lconstr_env
-
-let pr_constr_under_binders c = pr_constr_under_binders_env (Global.env()) c
-let pr_lconstr_under_binders c = pr_lconstr_under_binders_env (Global.env()) c
-
-let pr_type_core goal_concl_style env t =
-  pr_constr_expr (extern_type goal_concl_style env t)
-let pr_ltype_core goal_concl_style env t =
-  pr_lconstr_expr (extern_type goal_concl_style env t)
-
-let pr_goal_concl_style_env env = pr_ltype_core true env
-let pr_ltype_env env = pr_ltype_core false env
-let pr_type_env env = pr_type_core false env
-
-let pr_ltype t = pr_ltype_env (Global.env()) t
-let pr_type t = pr_type_env (Global.env()) t
-
-let pr_ljudge_env env j =
-  (pr_lconstr_env env j.uj_val, pr_lconstr_env env j.uj_type)
-
-let pr_ljudge j = pr_ljudge_env (Global.env()) j
-
-let pr_lglob_constr_env env c =
-  pr_lconstr_expr (extern_glob_constr (Termops.vars_of_env env) c)
-let pr_glob_constr_env env c =
-  pr_constr_expr (extern_glob_constr (Termops.vars_of_env env) c)
-
-let pr_lglob_constr c =
-  pr_lconstr_expr (extern_glob_constr Idset.empty c)
-let pr_glob_constr c =
-  pr_constr_expr (extern_glob_constr Idset.empty c)
-
-let pr_cases_pattern t =
-  pr_cases_pattern_expr (extern_cases_pattern Idset.empty t)
-
-let pr_lconstr_pattern_env env c =
-  pr_lconstr_pattern_expr (extern_constr_pattern (Termops.names_of_rel_context env) c)
-let pr_constr_pattern_env env c =
-  pr_constr_pattern_expr (extern_constr_pattern (Termops.names_of_rel_context env) c)
-
-let pr_lconstr_pattern t =
-  pr_lconstr_pattern_expr (extern_constr_pattern Termops.empty_names_context t)
-let pr_constr_pattern t =
-  pr_constr_pattern_expr (extern_constr_pattern Termops.empty_names_context t)
-
-let pr_sort s = pr_glob_sort (extern_sort s)
-
-let _ = Termops.set_print_constr pr_lconstr_env
-
-
-(** Term printers resilient to [Nametab] errors *)
-
-(** When the nametab isn't up-to-date, the term printers above
-    could raise [Not_found] during [Nametab.shortest_qualid_of_global].
-    In this case, we build here a fully-qualified name based upon
-    the kernel modpath and label of constants, and the idents in
-    the [mutual_inductive_body] for the inductives and constructors
-    (needs an environment for this). *)
-
-let id_of_global env = function
-  | ConstRef kn -> id_of_label (con_label kn)
-  | IndRef (kn,0) -> id_of_label (mind_label kn)
-  | IndRef (kn,i) ->
-    (Environ.lookup_mind kn env).mind_packets.(i).mind_typename
-  | ConstructRef ((kn,i),j) ->
-    (Environ.lookup_mind kn env).mind_packets.(i).mind_consnames.(j-1)
-  | VarRef v -> v
-
-let cons_dirpath id dp = make_dirpath (id :: repr_dirpath dp)
-
-let rec dirpath_of_mp = function
-  | MPfile sl -> sl
-  | MPbound uid -> make_dirpath [id_of_mbid uid]
-  | MPdot (mp,l) -> cons_dirpath (id_of_label l) (dirpath_of_mp mp)
-
-let dirpath_of_global = function
-  | ConstRef kn -> dirpath_of_mp (con_modpath kn)
-  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
-    dirpath_of_mp (mind_modpath kn)
-  | VarRef _ -> empty_dirpath
-
-let qualid_of_global env r =
-  Libnames.make_qualid (dirpath_of_global r) (id_of_global env r)
-
-let safe_gen f env c =
-  let orig_extern_ref = Constrextern.get_extern_reference () in
-  let extern_ref loc vars r =
-    try orig_extern_ref loc vars r
-    with e when Errors.noncritical e ->
-      Libnames.Qualid (loc, qualid_of_global env r)
-  in
-  Constrextern.set_extern_reference extern_ref;
-  try
-    let p = f env c in
-    Constrextern.set_extern_reference orig_extern_ref;
-    p
-  with e when Errors.noncritical e ->
-    Constrextern.set_extern_reference orig_extern_ref;
-    str "??"
-
-let safe_pr_lconstr_env = safe_gen pr_lconstr_env
-let safe_pr_constr_env = safe_gen pr_constr_env
-let safe_pr_lconstr t = safe_pr_lconstr_env (Global.env()) t
-let safe_pr_constr t = safe_pr_constr_env (Global.env()) t
-
-
-(**********************************************************************)
-(* Global references *)
-
-let pr_global_env = pr_global_env
-let pr_global = pr_global_env Idset.empty
-
-let pr_constant env cst = pr_global_env (Termops.vars_of_env env) (ConstRef cst)
-let pr_existential env ev = pr_lconstr_env env (mkEvar ev)
-let pr_inductive env ind = pr_lconstr_env env (mkInd ind)
-let pr_constructor env cstr = pr_lconstr_env env (mkConstruct cstr)
-
-let pr_evaluable_reference ref =
-  pr_global (Tacred.global_of_evaluable_reference ref)
-
-(*let pr_glob_constr t =
-  pr_lconstr (Constrextern.extern_glob_constr Idset.empty t)*)
-
-(*open Pattern
-
-let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t*)
-
-(**********************************************************************)
-(* Contexts and declarations                                          *)
-
-let pr_var_decl env (id,c,typ) =
-  let pbody = match c with
-    | None ->  (mt ())
-    | Some c ->
-	(* Force evaluation *)
-	let pb = pr_lconstr_core true env c in
-	let pb = if isCast c then surround pb else pb in
-	(str" := " ++ pb ++ cut () ) in
-  let pt = pr_ltype_core true env typ in
-  let ptyp = (str" : " ++ pt) in
-  (pr_id id ++ hov 0 (pbody ++ ptyp))
-
-let pr_rel_decl env (na,c,typ) =
-  let pbody = match c with
-    | None -> mt ()
-    | Some c ->
-	(* Force evaluation *)
-	let pb = pr_lconstr_core true env c in
-	let pb = if isCast c then surround pb else pb in
-	(str":=" ++ spc () ++ pb ++ spc ()) in
-  let ptyp = pr_ltype_core true env typ in
-  match na with
-  | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
-  | Name id -> hov 0 (pr_id id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
-
-
-(* Prints out an "env" in a nice format.  We print out the
- * signature,then a horizontal bar, then the debruijn environment.
- * It's printed out from outermost to innermost, so it's readable. *)
-
-(* Prints a signature, all declarations on the same line if possible *)
-let pr_named_context_of env =
-  let make_decl_list env d pps = pr_var_decl env d :: pps in
-  let psl = List.rev (fold_named_context make_decl_list env ~init:[]) in
-  hv 0 (prlist_with_sep (fun _ -> ws 2) (fun x -> x) psl)
-
-let pr_named_context env ne_context =
-  hv 0 (Sign.fold_named_context
-	  (fun d pps -> pps ++ ws 2 ++ pr_var_decl env d)
-          ne_context ~init:(mt ()))
-
-let pr_rel_context env rel_context =
-  pr_binders (extern_rel_context None env rel_context)
-
-let pr_rel_context_of env =
-  pr_rel_context env (rel_context env)
-
-(* Prints an env (variables and de Bruijn). Separator: newline *)
-let pr_context_unlimited env =
-  let sign_env =
-    fold_named_context
-      (fun env d pps ->
-         let pidt =  pr_var_decl env d in (pps ++ fnl () ++ pidt))
-      env ~init:(mt ())
-  in
-  let db_env =
-    fold_rel_context
-      (fun env d pps ->
-         let pnat = pr_rel_decl env d in (pps ++ fnl () ++ pnat))
-      env ~init:(mt ())
-  in
-  (sign_env ++ db_env)
-
-let pr_ne_context_of header env =
-  if Environ.rel_context env = empty_rel_context &
-    Environ.named_context env = empty_named_context  then (mt ())
-  else let penv = pr_context_unlimited env in (header ++ penv ++ fnl ())
-
-let pr_context_limit n env =
-  let named_context = Environ.named_context env in
-  let lgsign = List.length named_context in
-  if n >= lgsign then
-    pr_context_unlimited env
-  else
-    let k = lgsign-n in
-    let _,sign_env =
-      fold_named_context
-        (fun env d (i,pps) ->
-           if i < k then
-	     (i+1, (pps ++str "."))
-	   else
-             let pidt = pr_var_decl env d in
-	     (i+1, (pps ++ fnl () ++
-		      str (emacs_str "") ++
-		      pidt)))
-        env ~init:(0,(mt ()))
-    in
-    let db_env =
-      fold_rel_context
-        (fun env d pps ->
-           let pnat = pr_rel_decl env d in
-	   (pps ++ fnl () ++
-	      str (emacs_str "") ++
-	      pnat))
-        env ~init:(mt ())
-    in
-    (sign_env ++ db_env)
-
-let pr_context_of env = match Flags.print_hyps_limit () with
-  | None -> hv 0 (pr_context_unlimited env)
-  | Some n -> hv 0 (pr_context_limit n env)
-
-(* display goal parts (Proof mode) *)
-
-let pr_predicate pr_elt (b, elts) =
-  let pr_elts = prlist_with_sep spc pr_elt elts in
-    if b then
-      str"all" ++
-	(if elts = [] then mt () else str" except: " ++ pr_elts)
-    else
-      if elts = [] then str"none" else pr_elts
-
-let pr_cpred p = pr_predicate (pr_constant (Global.env())) (Cpred.elements p)
-let pr_idpred p = pr_predicate Nameops.pr_id (Idpred.elements p)
-
-let pr_transparent_state (ids, csts) =
-  hv 0 (str"VARIABLES: " ++ pr_idpred ids ++ fnl () ++
-	str"CONSTANTS: " ++ pr_cpred csts ++ fnl ())
-
-(* display complete goal *)
-let default_pr_goal gs =
-  let (g,sigma) = Goal.V82.nf_evar (project gs) (sig_it gs) in
-  let env = Goal.V82.unfiltered_env sigma g in
-  let preamb,thesis,penv,pc =
-    mt (), mt (),
-    pr_context_of env,
-    pr_goal_concl_style_env env (Goal.V82.concl sigma g)
-  in
-    preamb ++
-    str"  " ++ hv 0 (penv ++ fnl () ++
-		       str (emacs_str "")  ++
-		       str "============================" ++ fnl ()  ++
-		       thesis ++ str " " ++  pc) ++ fnl ()
-
-(* display a goal tag *)
-let pr_goal_tag g =
-  let s = " (ID " ^ Goal.uid g ^ ")" in
-  str (emacs_str s)
-
-(* display the conclusion of a goal *)
-let pr_concl n sigma g =
-  let (g,sigma) = Goal.V82.nf_evar sigma g in
-  let env = Goal.V82.env sigma g in
-  let pc = pr_goal_concl_style_env env (Goal.V82.concl sigma g) in
-    str (emacs_str "")  ++
-      str "subgoal " ++ int n ++ pr_goal_tag g ++
-      str " is:" ++ cut () ++ str" "  ++ pc
-
-(* display evar type: a context and a type *)
-let pr_evgl_sign gl =
-  let ps = pr_named_context_of (evar_unfiltered_env gl) in
-  let _,l = list_filter2 (fun b c -> not b) (evar_filter gl,evar_context gl) in
-  let ids = List.rev (List.map pi1 l) in
-  let warn =
-    if ids = [] then mt () else
-      (str "(" ++ prlist_with_sep pr_comma pr_id ids ++ str " cannot be used)")
-  in
-  let pc = pr_lconstr gl.evar_concl in
-  hov 0 (str"[" ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]" ++ spc () ++ warn)
-
-(* Print an existential variable *)
-
-let pr_evar (ev, evd) =
-  let pegl = pr_evgl_sign evd in
-  (hov 0 (str (string_of_existential ev)  ++ str " : " ++ pegl))
-
-(* Print an enumerated list of existential variables *)
-let rec pr_evars_int i = function
-  | [] -> (mt ())
-  | (ev,evd)::rest ->
-      let pegl = pr_evgl_sign evd in
-      let pei = pr_evars_int (i+1) rest in
-      (hov 0 (str "Existential " ++ int i ++ str " =" ++ spc () ++
-              str (string_of_existential ev)  ++ str " : " ++ pegl)) ++
-      fnl () ++ pei
-
-let default_pr_subgoal n sigma =
-  let rec prrec p = function
-    | [] -> error "No such goal."
-    | g::rest ->
-       	if p = 1 then
-          let pg = default_pr_goal { sigma=sigma ; it=g } in
-          v 0 (str "subgoal " ++ int n ++ pr_goal_tag g
-	       ++ str " is:" ++ cut () ++ pg)
-       	else
-	  prrec (p-1) rest
-  in
-  prrec n
-
-let emacs_print_dependent_evars sigma seeds =
-  let evars () =
-    let evars = Evarutil.gather_dependent_evars sigma seeds in
-    let evars =
-      Intmap.fold begin fun e i s ->
-	let e' = str (string_of_existential e) in
-	match i with
-	| None -> s ++ str" " ++ e' ++ str " open,"
-	| Some i ->
-	  s ++ str " " ++ e' ++ str " using " ++
-	    Intset.fold begin fun d s ->
-	      str (string_of_existential d) ++ str " " ++ s
-	    end i (str ",")
-      end evars (str "")
-    in
-    cut () ++ 
-    str "(dependent evars:" ++ evars ++ str ")" ++ fnl ()
-  in
-  delayed_emacs_cmd evars
-
-(* Print open subgoals. Checks for uninstantiated existential variables *)
-(* spiwack: [seeds] is for printing dependent evars in emacs mode. *)
-(* spiwack: [pr_first] is true when the first goal must be singled out
-   and printed in its entirety. *)
-(* courtieu: in emacs mode, even less cases where the first goal is printed
-   in its entirety *)
-let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds stack goals =
-  let rec print_stack a = function
-    | [] -> Pp.int a
-    | b::l -> Pp.int a ++ str"-" ++ print_stack b l
-  in
-  let print_unfocused a l =
-    str"unfocused: " ++ print_stack a l
-  in
-  let rec pr_rec n = function
-    | [] -> (mt ())
-    | g::rest ->
-        let pc = pr_concl n sigma g in
-        let prest = pr_rec (n+1) rest in
-        (cut () ++ pc ++ prest)
-  in
-  let print_multiple_goals g l =
-    if pr_first then
-      default_pr_goal { it = g ; sigma = sigma } ++
-      pr_rec 2 l
-    else 
-      pr_rec 1 (g::l)
-  in
-  match goals,stack with
-  | [],_ ->
-      begin
-	match close_cmd with
-	  Some cmd ->
-	    (str "Subproof completed, now type " ++ str cmd ++
-	       str "." ++ fnl ())
-	| None ->
-	    let exl = Evarutil.non_instantiated sigma in
-	    if exl = [] then
-	      (str"No more subgoals." ++ fnl ()
-	       ++ emacs_print_dependent_evars sigma seeds)
-	    else
-	      let pei = pr_evars_int 1 exl in
-	      (str "No more subgoals but non-instantiated existential " ++
-		 str "variables:" ++ fnl () ++ (hov 0 pei)
-	       ++ emacs_print_dependent_evars sigma seeds ++ fnl () ++
-                 str "You can use Grab Existential Variables.")
-      end
-  | [g],[] when not !Flags.print_emacs ->
-      let pg = default_pr_goal { it = g ; sigma = sigma } in
-      v 0 (
-	str "1 subgoal" ++ pr_goal_tag g ++ cut () ++ pg
-	++ emacs_print_dependent_evars sigma seeds
-      )
-  | [g],a::l when not !Flags.print_emacs ->
-      let pg = default_pr_goal { it = g ; sigma = sigma } in
-      v 0 (
-	str "1 focused subgoal (" ++ print_unfocused a l ++ str")" ++ pr_goal_tag g ++ cut () ++ pg
-	++ emacs_print_dependent_evars sigma seeds
-      )
-  | g1::rest,[] ->
-      let goals = print_multiple_goals g1 rest in
-      v 0 (
-	int(List.length rest+1) ++ str" subgoals" ++
-          str (emacs_str ", subgoal 1") ++ pr_goal_tag g1 ++ cut ()
-	++ goals ++ fnl ()
-	++ emacs_print_dependent_evars sigma seeds
-      )
-  | g1::rest,a::l ->
-      let goals = print_multiple_goals g1 rest in
-      v 0 (
-	int(List.length rest+1) ++ str" focused subgoals (" ++
-          print_unfocused a l ++ str")" ++ cut () ++
-          str (emacs_str ", subgoal 1") ++ pr_goal_tag g1 ++ cut ()
-	++ goals
-	++ emacs_print_dependent_evars sigma seeds
-      )
-
-(**********************************************************************)
-(* Abstraction layer                                                  *)
-
-
-type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> string option -> evar_map -> evar list -> int list -> goal list -> std_ppcmds;
- pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds;
- pr_goal                : goal sigma -> std_ppcmds;
-}
-
-let default_printer_pr = {
- pr_subgoals = default_pr_subgoals;
- pr_subgoal  = default_pr_subgoal;
- pr_goal     = default_pr_goal;
-}
-
-let printer_pr = ref default_printer_pr
-
-let set_printer_pr = (:=) printer_pr
-
-let pr_subgoals ?pr_first x = !printer_pr.pr_subgoals ?pr_first x
-let pr_subgoal  x = !printer_pr.pr_subgoal  x
-let pr_goal     x = !printer_pr.pr_goal     x
-
-(* End abstraction layer                                              *)
-(**********************************************************************)
-
-let pr_open_subgoals () =
-  (* spiwack: it shouldn't be the job of the printer to look up stuff
-     in the [evar_map], I did stuff that way because it was more
-     straightforward, but seriously, [Proof.proof] should return
-     [evar_info]-s instead. *)
-  let p = Proof_global.give_me_the_proof () in
-  let (goals , stack , sigma ) = Proof.proof p in
-  let stack = List.map (fun (l,r) -> List.length l + List.length r) stack in
-  let seeds = Proof.V82.top_evars p in
-  begin match goals with
-  | [] -> let { Evd.it = bgoals ; sigma = bsigma } = Proof.V82.background_subgoals p in
-          begin match bgoals with
-	  | [] -> pr_subgoals None sigma seeds stack goals
-	  | _ ->
-	    (* emacs mode: xml-like flag for detecting information message *)
-	    str (emacs_str "<infomsg>") ++
-	    str"This subproof is complete, but there are still unfocused goals."
-	    ++ str (emacs_str "</infomsg>")
-	    ++ fnl () ++ fnl () ++ pr_subgoals ~pr_first:false None bsigma seeds [] bgoals
-	  end
-  | _ -> pr_subgoals None sigma seeds stack goals
-  end
-
-let pr_nth_open_subgoal n =
-  let pf = get_pftreestate () in
-  let { it=gls ; sigma=sigma } = Proof.V82.subgoals pf in
-  pr_subgoal n sigma gls
-
-let pr_goal_by_id id =
-  let p = Proof_global.give_me_the_proof () in
-  let g = Goal.get_by_uid id in
-  let pr gs = 
-    v 0 (str ("goal / evar " ^ id ^ " is:") ++ cut ()
-	 ++ pr_goal gs)
-  in
-  try
-    Proof.in_proof p (fun sigma -> pr {it=g;sigma=sigma})
-  with Not_found -> error "Invalid goal identifier."
-
-(* Elementary tactics *)
-
-let pr_prim_rule = function
-  | Intro id ->
-      str"intro " ++ pr_id id
-
-  | Cut (b,replace,id,t) ->
-     if b then
-       (* TODO: express "replace" *)
-       (str"assert " ++ str"(" ++ pr_id id ++ str":" ++ pr_lconstr t ++ str")")
-     else
-       let cl = if replace then str"clear " ++ pr_id id ++ str"; " else mt() in
-       (str"cut " ++ pr_constr t ++
-        str ";[" ++ cl ++ str"intro " ++ pr_id id ++ str"|idtac]")
-
-  | FixRule (f,n,[],_) ->
-      (str"fix " ++ pr_id f ++ str"/" ++ int n)
-
-  | FixRule (f,n,others,j) ->
-      if j<>0 then msg_warn "Unsupported printing of \"fix\"";
-      let rec print_mut = function
-	| (f,n,ar)::oth ->
-           pr_id f ++ str"/" ++ int n ++ str" : " ++ pr_lconstr ar ++ print_mut oth
-        | [] -> mt () in
-      (str"fix " ++ pr_id f ++ str"/" ++ int n ++
-         str" with " ++ print_mut others)
-
-  | Cofix (f,[],_) ->
-      (str"cofix " ++ pr_id f)
-
-  | Cofix (f,others,j) ->
-      if j<>0 then msg_warn "Unsupported printing of \"fix\"";
-      let rec print_mut = function
-	| (f,ar)::oth ->
-	  (pr_id f ++ str" : " ++ pr_lconstr ar ++ print_mut oth)
-        | [] -> mt () in
-      (str"cofix " ++ pr_id f ++  str" with " ++ print_mut others)
-  | Refine c ->
-      str(if Termops.occur_meta c then "refine " else "exact ") ++
-      Constrextern.with_meta_as_hole pr_constr c
-
-  | Convert_concl (c,_) ->
-      (str"change "  ++ pr_constr c)
-
-  | Convert_hyp (id,None,t) ->
-      (str"change "  ++ pr_constr t  ++ spc ()  ++ str"in "  ++ pr_id id)
-
-  | Convert_hyp (id,Some c,t) ->
-      (str"change "  ++ pr_constr c  ++ spc ()  ++ str"in "
-       ++ pr_id id ++ str" (type of "  ++ pr_id id ++ str ")")
-
-  | Thin ids ->
-      (str"clear "  ++ prlist_with_sep pr_spc pr_id ids)
-
-  | ThinBody ids ->
-      (str"clearbody "  ++ prlist_with_sep pr_spc pr_id ids)
-
-  | Move (withdep,id1,id2) ->
-      (str (if withdep then "dependent " else "") ++
-	 str"move "  ++ pr_id id1 ++ pr_move_location pr_id id2)
-
-  | Order ord ->
-      (str"order "  ++ prlist_with_sep pr_spc pr_id ord)
-
-  | Rename (id1,id2) ->
-      (str "rename " ++ pr_id id1 ++ str " into " ++ pr_id id2)
-
-  | Change_evars ->
-      (* This is internal tactic and cannot be replayed at user-level.
-         Function pr_rule_dot below is used when we want to hide
-         Change_evars *)
-      str "Evar change"
-
-
-(* Backwards compatibility *)
-
-let prterm = pr_lconstr
-
-
-(* Printer function for sets of Assumptions.assumptions.
-   It is used primarily by the Print Assumptions command. *)
-
-open Assumptions
-
-let pr_assumptionset env s =
-  if ContextObjectMap.is_empty s then
-    str "Closed under the global context" ++ fnl()
-  else
-    let safe_pr_constant env kn =
-      try pr_constant env kn
-      with Not_found ->
-	let mp,_,lab = repr_con kn in
-	str (string_of_mp mp ^ "." ^ string_of_label lab)
-    in
-    let safe_pr_ltype typ =
-      try str " : " ++ pr_ltype typ with e when Errors.noncritical e -> mt ()
-    in
-    let (vars,axioms,opaque) =
-      ContextObjectMap.fold (fun t typ r ->
-	let (v,a,o) = r in
-	match t with
-	| Variable id -> (  Some (
-	                      Option.default (fnl ()) v
-			   ++ str (string_of_id id)
-			   ++ str " : "
-	                   ++ pr_ltype typ
-	                   ++ fnl ()
-			    )
-	                 ,
-	                   a, o)
-	| Axiom kn    -> ( v ,
-			     Some (
-			      Option.default (fnl ()) a
-			   ++ safe_pr_constant env kn
-	                   ++ safe_pr_ltype typ
-	                   ++ fnl ()
-			     )
-			 , o
-			 )
-	| Opaque kn    -> ( v , a ,
-			     Some (
-			      Option.default (fnl ()) o
-			   ++ safe_pr_constant env kn
-	                   ++ safe_pr_ltype typ
-	                   ++ fnl ()
-			     )
-			 )
-      )
-	s (None,None,None)
-    in
-    let (vars,axioms,opaque) =
-      ( Option.map (fun p -> str "Section Variables:" ++ p) vars ,
-	Option.map (fun p -> str "Axioms:" ++ p) axioms ,
-	Option.map (fun p -> str "Opaque constants:" ++ p) opaque
-      )
-    in
-    (Option.default (mt ()) vars) ++ (Option.default (mt ()) axioms)
-      ++ (Option.default (mt ()) opaque)
-
-let cmap_to_list m = Cmap.fold (fun k v acc -> v :: acc) m []
-
-open Typeclasses
-
-let pr_instance i = 
-  pr_global (instance_impl i)
-    
-let pr_instance_gmap insts =
-  prlist_with_sep fnl (fun (gr, insts) ->
-    prlist_with_sep fnl pr_instance (cmap_to_list insts))
-    (Gmap.to_list insts)
-
-(** Inductive declarations *)
-
-open Termops
-open Reduction
-open Inductive
-open Inductiveops
-
-let print_params env params =
-  if params = [] then mt () else pr_rel_context env params ++ brk(1,2)
-
-let print_constructors envpar names types =
-  let pc =
-    prlist_with_sep (fun () -> brk(1,0) ++ str "| ")
-      (fun (id,c) -> pr_id id ++ str " : " ++ pr_lconstr_env envpar c)
-      (Array.to_list (array_map2 (fun n t -> (n,t)) names types))
-  in
-  hv 0 (str "  " ++ pc)
-
-let build_ind_type env mip =
-  match mip.mind_arity with
-    | Monomorphic ar -> ar.mind_user_arity
-    | Polymorphic ar ->
-      it_mkProd_or_LetIn (mkSort (Type ar.poly_level)) mip.mind_arity_ctxt
-
-let print_one_inductive env mib ((_,i) as ind) =
-  let mip = mib.mind_packets.(i) in
-  let params = mib.mind_params_ctxt in
-  let args = extended_rel_list 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env mip) args in
-  let cstrtypes = Inductive.type_of_constructors ind (mib,mip) in
-  let cstrtypes = Array.map (fun c -> hnf_prod_applist env c args) cstrtypes in
-  let envpar = push_rel_context params env in
-  hov 0 (
-    pr_id mip.mind_typename ++ brk(1,4) ++ print_params env params ++
-    str ": " ++ pr_lconstr_env envpar arity ++ str " :=") ++
-  brk(0,2) ++ print_constructors envpar mip.mind_consnames cstrtypes
-
-let print_mutual_inductive env mind mib =
-  let inds = list_tabulate (fun x -> (mind,x)) (Array.length mib.mind_packets)
-  in
-  hov 0 (
-    str (if mib.mind_finite then "Inductive " else "CoInductive ") ++
-    prlist_with_sep (fun () -> fnl () ++ str"  with ")
-      (print_one_inductive env mib) inds)
-
-let get_fields =
-  let rec prodec_rec l subst c =
-    match kind_of_term c with
-    | Prod (na,t,c) ->
-	let id = match na with Name id -> id | Anonymous -> id_of_string "_" in
-	prodec_rec ((id,true,substl subst t)::l) (mkVar id::subst) c
-    | LetIn (na,b,_,c) ->
-	let id = match na with Name id -> id | Anonymous -> id_of_string "_" in
-	prodec_rec ((id,false,substl subst b)::l) (mkVar id::subst) c
-    | _               -> List.rev l
-  in
-  prodec_rec [] []
-
-let print_record env mind mib =
-  let mip = mib.mind_packets.(0) in
-  let params = mib.mind_params_ctxt in
-  let args = extended_rel_list 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env mip) args in
-  let cstrtypes = Inductive.type_of_constructors (mind,0) (mib,mip) in
-  let cstrtype = hnf_prod_applist env cstrtypes.(0) args in
-  let fields = get_fields cstrtype in
-  let envpar = push_rel_context params env in
-  hov 0 (
-    hov 0 (
-      str "Record " ++ pr_id mip.mind_typename ++ brk(1,4) ++
-      print_params env params ++
-      str ": " ++ pr_lconstr_env envpar arity ++ brk(1,2) ++
-      str ":= " ++ pr_id mip.mind_consnames.(0)) ++
-    brk(1,2) ++
-    hv 2 (str "{ " ++
-      prlist_with_sep (fun () -> str ";" ++ brk(2,0))
-        (fun (id,b,c) ->
-	  pr_id id ++ str (if b then " : " else " := ") ++
-	  pr_lconstr_env envpar c) fields) ++ str" }")
-
-let pr_mutual_inductive_body env mind mib =
-  if mib.mind_record & not !Flags.raw_print then
-    print_record env mind mib
-  else
-    print_mutual_inductive env mind mib
diff --git a/parsing/printer.mli b/parsing/printer.mli
deleted file mode 100644
index c0ef1932..00000000
--- a/parsing/printer.mli
+++ /dev/null
@@ -1,169 +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 Names
-open Libnames
-open Term
-open Sign
-open Environ
-open Glob_term
-open Pattern
-open Nametab
-open Termops
-open Evd
-open Proof_type
-open Glob_term
-open Tacexpr
-
-(** These are the entry points for printing terms, context, tac, ... *)
-
-(** Terms *)
-
-val pr_lconstr_env         : env -> constr -> std_ppcmds
-val pr_lconstr             : constr -> std_ppcmds
-
-val pr_constr_env          : env -> constr -> std_ppcmds
-val pr_constr              : constr -> std_ppcmds
-
-(** Same, but resilient to [Nametab] errors. Prints fully-qualified
-    names when [shortest_qualid_of_global] has failed. Prints "??"
-    in case of remaining issues (such as reference not in env). *)
-
-val safe_pr_lconstr_env         : env -> constr -> std_ppcmds
-val safe_pr_lconstr             : constr -> std_ppcmds
-
-val safe_pr_constr_env          : env -> constr -> std_ppcmds
-val safe_pr_constr              : constr -> std_ppcmds
-
-
-val pr_open_constr_env     : env -> open_constr -> std_ppcmds
-val pr_open_constr         : open_constr -> std_ppcmds
-
-val pr_open_lconstr_env    : env -> open_constr -> std_ppcmds
-val pr_open_lconstr        : open_constr -> std_ppcmds
-
-val pr_constr_under_binders_env  : env -> constr_under_binders -> std_ppcmds
-val pr_constr_under_binders      : constr_under_binders -> std_ppcmds
-
-val pr_lconstr_under_binders_env : env -> constr_under_binders -> std_ppcmds
-val pr_lconstr_under_binders     : constr_under_binders -> std_ppcmds
-
-val pr_goal_concl_style_env : env -> types -> std_ppcmds
-val pr_ltype_env           : env -> types -> std_ppcmds
-val pr_ltype               : types -> std_ppcmds
-
-val pr_type_env            : env -> types -> std_ppcmds
-val pr_type                : types -> std_ppcmds
-
-val pr_ljudge_env          : env -> unsafe_judgment -> std_ppcmds * std_ppcmds
-val pr_ljudge              : unsafe_judgment -> std_ppcmds * std_ppcmds
-
-val pr_lglob_constr_env      : env -> glob_constr -> std_ppcmds
-val pr_lglob_constr          : glob_constr -> std_ppcmds
-
-val pr_glob_constr_env       : env -> glob_constr -> std_ppcmds
-val pr_glob_constr           : glob_constr -> std_ppcmds
-
-val pr_lconstr_pattern_env : env -> constr_pattern -> std_ppcmds
-val pr_lconstr_pattern     : constr_pattern -> std_ppcmds
-
-val pr_constr_pattern_env  : env -> constr_pattern -> std_ppcmds
-val pr_constr_pattern      : constr_pattern -> std_ppcmds
-
-val pr_cases_pattern       : cases_pattern -> std_ppcmds
-
-val pr_sort                : sorts -> std_ppcmds
-
-(** Printing global references using names as short as possible *)
-
-val pr_global_env          : Idset.t -> global_reference -> std_ppcmds
-val pr_global              : global_reference -> std_ppcmds
-
-val pr_constant            : env -> constant -> std_ppcmds
-val pr_existential         : env -> existential -> std_ppcmds
-val pr_constructor         : env -> constructor -> std_ppcmds
-val pr_inductive           : env -> inductive -> std_ppcmds
-val pr_evaluable_reference : evaluable_global_reference -> std_ppcmds
-
-(** Contexts *)
-
-val pr_ne_context_of       : std_ppcmds -> env -> std_ppcmds
-
-val pr_var_decl            : env -> named_declaration -> std_ppcmds
-val pr_rel_decl            : env -> rel_declaration -> std_ppcmds
-
-val pr_named_context       : env -> named_context -> std_ppcmds
-val pr_named_context_of    : env -> std_ppcmds
-val pr_rel_context         : env -> rel_context -> std_ppcmds
-val pr_rel_context_of      : env -> std_ppcmds
-val pr_context_of          : env -> std_ppcmds
-
-(** Predicates *)
-
-val pr_predicate           : ('a -> std_ppcmds) -> (bool * 'a list) -> std_ppcmds
-val pr_cpred               : Cpred.t -> std_ppcmds
-val pr_idpred              : Idpred.t -> std_ppcmds
-val pr_transparent_state   : transparent_state -> std_ppcmds
-
-(** Proofs *)
-
-val pr_goal                : goal sigma -> std_ppcmds
-val pr_subgoals            : ?pr_first:bool -> string option -> evar_map -> evar list -> int list -> goal list -> std_ppcmds
-val pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds
-val pr_concl               : int -> evar_map -> goal -> std_ppcmds
-
-val pr_open_subgoals       : unit -> std_ppcmds
-val pr_nth_open_subgoal    : int -> std_ppcmds
-val pr_evar                : (evar * evar_info) -> std_ppcmds
-val pr_evars_int           : int -> (evar * evar_info) list -> std_ppcmds
-
-val pr_prim_rule           : prim_rule -> std_ppcmds
-
-(** Emacs/proof general support 
-   (emacs_str s) outputs
-    - s if emacs mode,
-    - nothing otherwise.
-    This function was previously used to insert special chars like
-    [(String.make 1 (Char.chr 253))] to parenthesize sub-parts of the
-    proof context for proof by pointing. This part of the code is
-    removed for now because it interacted badly with utf8. We may put
-    it back some day using some xml-like tags instead of special
-    chars. See for example the <prompt> tag in the prompt when in
-    emacs mode. *)
-val emacs_str              : string -> string
-
-(** Backwards compatibility *)
-
-val prterm                 : constr -> std_ppcmds (** = pr_lconstr *)
-
-
-(** spiwack: printer function for sets of Environ.assumption.
-            It is used primarily by the Print Assumption command. *)
-val pr_assumptionset :
-  env -> Term.types Assumptions.ContextObjectMap.t ->std_ppcmds
-
-val pr_goal_by_id : string -> std_ppcmds
-
-type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> string option -> evar_map -> evar list -> int list -> goal list -> std_ppcmds;
- pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds;
- pr_goal                : goal sigma -> std_ppcmds;
-};;
-
-val set_printer_pr : printer_pr -> unit
-
-val default_printer_pr : printer_pr
-
-val pr_instance_gmap : (global_reference, Typeclasses.instance Names.Cmap.t) Gmap.t ->
-  Pp.std_ppcmds
-
-(** Inductive declarations *)
-
-val pr_mutual_inductive_body :
-  env -> mutual_inductive -> Declarations.mutual_inductive_body -> std_ppcmds
diff --git a/parsing/printmod.ml b/parsing/printmod.ml
deleted file mode 100644
index ad791de9..00000000
--- a/parsing/printmod.ml
+++ /dev/null
@@ -1,279 +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 Declarations
-open Nameops
-open Libnames
-open Goptions
-
-(** Note: there is currently two modes for printing modules.
-    - The "short" one, that just prints the names of the fields.
-    - The "rich" one, that also tries to print the types of the fields.
-    The short version used to be the default behavior, but now we print
-    types by default. The following option allows to change this.
-    Technically, the environments in this file are either None in
-    the "short" mode or (Some env) in the "rich" one.
-*)
-
-let short = ref false
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "short module printing";
-      optkey   = ["Short";"Module";"Printing"];
-      optread  = (fun () -> !short) ;
-      optwrite = ((:=) short) }
-
-let get_new_id locals id =
-  let rec get_id l id =
-    let dir = make_dirpath [id] in
-      if not (Nametab.exists_module dir) then
-	id
-      else
-	get_id (id::l) (Namegen.next_ident_away id l)
-  in
-    get_id (List.map snd locals) id
-
-let rec print_local_modpath locals = function
-  | MPbound mbid -> pr_id (List.assoc mbid locals)
-  | MPdot(mp,l) ->
-      print_local_modpath locals mp ++ str "." ++ pr_lab l
-  | MPfile _ -> raise Not_found
-
-let print_modpath locals mp =
-  try (* must be with let because streams are lazy! *)
-    let qid = Nametab.shortest_qualid_of_module mp in
-      pr_qualid qid
-  with
-    | Not_found -> print_local_modpath locals mp
-
-let print_kn locals kn =
-  try
-    let qid = Nametab.shortest_qualid_of_modtype kn in
-      pr_qualid qid
-  with
-      Not_found ->
-	try
-	  print_local_modpath locals kn
-	with
-	    Not_found -> print_modpath locals kn
-
-(** Each time we have to print a non-globally visible structure,
-    we place its elements in a fake fresh namespace. *)
-
-let mk_fake_top =
-  let r = ref 0 in
-  fun () -> incr r; id_of_string ("FAKETOP"^(string_of_int !r))
-
-let nametab_register_dir mp =
-  let id = mk_fake_top () in
-  let dir = make_dirpath [id] in
-  Nametab.push_dir (Nametab.Until 1) dir (DirModule (dir,(mp,empty_dirpath)))
-
-(** Nota: the [global_reference] we register in the nametab below
-    might differ from internal ones, since we cannot recreate here
-    the canonical part of constant and inductive names, but only
-    the user names. This works nonetheless since we search now
-    [Nametab.the_globrevtab] modulo user name. *)
-
-let nametab_register_body mp dir (l,body) =
-  let push id ref =
-    Nametab.push (Nametab.Until (1+List.length (repr_dirpath dir)))
-      (make_path dir id) ref
-  in
-  match body with
-    | SFBmodule _ -> () (* TODO *)
-    | SFBmodtype _ -> () (* TODO *)
-    | SFBconst _ ->
-      push (id_of_label l) (ConstRef (make_con mp empty_dirpath l))
-    | SFBmind mib ->
-      let mind = make_mind mp empty_dirpath l in
-      Array.iteri
-	(fun i mip ->
-	  push mip.mind_typename (IndRef (mind,i));
-	  Array.iteri (fun j id -> push id (ConstructRef ((mind,i),j+1)))
-	    mip.mind_consnames)
-	mib.mind_packets
-
-let nametab_register_module_body mp struc =
-  (* If [mp] is a globally visible module, we simply import it *)
-  try Declaremods.really_import_module mp
-  with Not_found ->
-    (* Otherwise we try to emulate an import by playing with nametab *)
-    nametab_register_dir mp;
-    List.iter (nametab_register_body mp empty_dirpath) struc
-
-let nametab_register_module_param mbid seb =
-  (* For algebraic seb, we use a Declaremods function that converts into mse *)
-  try Declaremods.process_module_seb_binding mbid seb
-  with e when Errors.noncritical e ->
-    (* Otherwise, for expanded structure, we try to play with the nametab *)
-    match seb with
-      | SEBstruct struc ->
-        let mp = MPbound mbid in
-        let dir = make_dirpath [id_of_mbid mbid] in
-        nametab_register_dir mp;
-        List.iter (nametab_register_body mp dir) struc
-      | _ -> ()
-
-let print_body is_impl env mp (l,body) =
-  let name = str (string_of_label l) in
-  hov 2 (match body with
-    | SFBmodule _ -> str "Module " ++ name
-    | SFBmodtype _ -> str "Module Type " ++ name
-    | SFBconst cb ->
-      (match cb.const_body with
-	| Def _ -> str "Definition "
-	| OpaqueDef _ when is_impl -> str "Theorem "
-	| _ -> str "Parameter ") ++ name ++
-      (match env with
-	  | None -> mt ()
-	  | Some env ->
-	    str " :" ++ spc () ++
-	    hov 0 (Printer.pr_ltype_env env
-		     (Typeops.type_of_constant_type env cb.const_type)) ++
-	    (match cb.const_body with
-	      | Def l when is_impl ->
-		spc () ++
-		hov 2 (str ":= " ++
-		       Printer.pr_lconstr_env env (Declarations.force l))
-	      | _ -> mt ()) ++
-            str ".")
-    | SFBmind mib ->
-      try
-	let env = Option.get env in
-	Printer.pr_mutual_inductive_body env (make_mind mp empty_dirpath l) mib
-      with e when Errors.noncritical e ->
-	(if mib.mind_finite then str "Inductive " else str "CoInductive")
-	++ name)
-
-let print_struct is_impl env mp struc =
-  prlist_with_sep spc (print_body is_impl env mp) struc
-
-let rec flatten_app mexpr l = match mexpr with
-  | SEBapply (mexpr, SEBident arg,_) -> flatten_app mexpr (arg::l)
-  | SEBident mp -> mp::l
-  | _ -> assert false
-
-let rec print_modtype env mp locals mty =
-  match mty with
-    | SEBident kn -> print_kn locals kn
-    | SEBfunctor (mbid,mtb1,mtb2) ->
-      let mp1 = MPbound mbid in
-      let env' = Option.map
-	  (Modops.add_module (Modops.module_body_of_type mp1 mtb1)) env in
-      let seb1 = Option.default mtb1.typ_expr mtb1.typ_expr_alg in
-      let locals' = (mbid, get_new_id locals (id_of_mbid mbid))::locals
-      in
-      nametab_register_module_param mbid seb1;
-      hov 2 (str "Funsig" ++ spc () ++ str "(" ++
-	       pr_id (id_of_mbid mbid) ++ str ":" ++
-	       print_modtype env mp1 locals seb1 ++
-	       str ")" ++ spc() ++ print_modtype env' mp locals' mtb2)
-  | SEBstruct (sign) ->
-      let env' = Option.map
-	(Modops.add_signature mp sign Mod_subst.empty_delta_resolver) env in
-      nametab_register_module_body mp sign;
-      hv 2 (str "Sig" ++ spc () ++ print_struct false env' mp sign ++
-	    brk (1,-2) ++ str "End")
-  | SEBapply _ ->
-      let lapp = flatten_app mty [] in
-      let fapp = List.hd lapp in
-      let mapp = List.tl lapp in
-      hov 3 (str"(" ++ (print_kn locals fapp) ++ spc () ++
-		 prlist_with_sep spc (print_modpath locals) mapp ++ str")")
-  | SEBwith(seb,With_definition_body(idl,cb))->
-      let env' = None in (* TODO: build a proper environment if env <> None *)
-      let s = (String.concat "." (List.map string_of_id idl)) in
-      hov 2 (print_modtype env' mp locals seb ++ spc() ++ str "with" ++ spc() ++
-	       str "Definition"++ spc() ++ str s ++ spc() ++  str ":="++ spc())
-  | SEBwith(seb,With_module_body(idl,mp))->
-      let s =(String.concat "." (List.map string_of_id idl)) in
-      hov 2 (print_modtype env mp locals seb ++ spc() ++ str "with" ++ spc() ++
-	       str "Module"++ spc() ++ str s ++ spc() ++ str ":="++ spc())
-
-let rec print_modexpr env mp locals mexpr = match mexpr with
-  | SEBident mp -> print_modpath locals mp
-  | SEBfunctor (mbid,mty,mexpr) ->
-      let mp' = MPbound mbid in
-      let env' = Option.map
-	(Modops.add_module (Modops.module_body_of_type mp' mty)) env in
-      let typ = Option.default mty.typ_expr mty.typ_expr_alg in
-      let locals' = (mbid, get_new_id locals (id_of_mbid mbid))::locals in
-      nametab_register_module_param mbid typ;
-      hov 2 (str "Functor" ++ spc() ++ str"(" ++ pr_id(id_of_mbid mbid) ++
-	     str ":" ++ print_modtype env mp' locals typ ++
-      str ")" ++ spc () ++ print_modexpr env' mp locals' mexpr)
-  | SEBstruct struc ->
-      let env' = Option.map
-	(Modops.add_signature mp struc Mod_subst.empty_delta_resolver) env in
-      nametab_register_module_body mp struc;
-      hv 2 (str "Struct" ++ spc () ++ print_struct true env' mp struc ++
-	    brk (1,-2) ++ str "End")
-  | SEBapply _ ->
-      let lapp = flatten_app mexpr [] in
-      hov 3 (str"(" ++ prlist_with_sep spc (print_modpath locals) lapp ++ str")")
-  | SEBwith (_,_)-> anomaly "Not available yet"
-
-
-let rec printable_body dir =
-  let dir = pop_dirpath dir in
-    dir = empty_dirpath ||
-    try
-      match Nametab.locate_dir (qualid_of_dirpath dir) with
-	  DirOpenModtype _ -> false
-	| DirModule _ | DirOpenModule _ -> printable_body dir
-	| _ -> true
-    with
-	Not_found -> true
-
-(** Since we might play with nametab above, we should reset to prior
-    state after the printing *)
-
-let print_modexpr' env mp mexpr =
-  States.with_state_protection (fun e -> eval_ppcmds (print_modexpr env mp [] e)) mexpr
-let print_modtype' env mp mty =
-  States.with_state_protection (fun e -> eval_ppcmds (print_modtype env mp [] e)) mty
-
-let print_module' env mp with_body mb =
-  let name = print_modpath [] mp in
-  let body = match with_body, mb.mod_expr with
-    | false, _
-    | true, None -> mt()
-    | true, Some mexpr ->
-	spc () ++ str ":= " ++ print_modexpr' env mp mexpr
-  in
-  let modtype = brk (1,1) ++ str": " ++ print_modtype' env mp mb.mod_type
-  in
-  hv 0 (str "Module " ++ name ++ modtype ++ body)
-
-exception ShortPrinting
-
-let print_module with_body mp =
-  let me = Global.lookup_module mp in
-  try
-    if !short then raise ShortPrinting;
-    print_module' (Some (Global.env ())) mp with_body me ++ fnl ()
-  with e when Errors.noncritical e ->
-    print_module' None mp with_body me ++ fnl ()
-
-let print_modtype kn =
-  let mtb = Global.lookup_modtype kn in
-  let name = print_kn [] kn in
-  hv 1
-    (str "Module Type " ++ name ++ str " =" ++ spc () ++
-     (try
-	if !short then raise ShortPrinting;
-	print_modtype' (Some (Global.env ())) kn mtb.typ_expr
-      with e when Errors.noncritical e ->
-	print_modtype' None kn mtb.typ_expr))
diff --git a/parsing/printmod.mli b/parsing/printmod.mli
deleted file mode 100644
index f60d19b3..00000000
--- a/parsing/printmod.mli
+++ /dev/null
@@ -1,17 +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 Names
-
-(** false iff the module is an element of an open module type *)
-val printable_body : dir_path -> bool
-
-val print_module : bool -> module_path -> std_ppcmds
-
-val print_modtype : module_path -> std_ppcmds
diff --git a/parsing/q_constr.ml4 b/parsing/q_constr.ml4
deleted file mode 100644
index 7e69163e..00000000
--- a/parsing/q_constr.ml4
+++ /dev/null
@@ -1,126 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "tools/compat5b.cmo" i*)
-
-open Glob_term
-open Term
-open Names
-open Pattern
-open Q_util
-open Util
-open Compat
-open Pcaml
-open PcamlSig
-
-let loc = dummy_loc
-let dloc = <:expr< Util.dummy_loc >>
-
-let apply_ref f l =
-  <:expr<
-    Glob_term.GApp ($dloc$, Glob_term.GRef ($dloc$, Lazy.force $f$), $mlexpr_of_list (fun x -> x) l$)
-  >>
-
-EXTEND
-  GLOBAL: expr;
-  expr:
-    [ [ "PATTERN"; "["; c = constr; "]" ->
-      <:expr< snd (Pattern.pattern_of_glob_constr $c$) >> ] ]
-  ;
-  sort:
-    [ [ "Set"  -> GProp Pos
-      | "Prop" -> GProp Null
-      | "Type" -> GType None ] ]
-  ;
-  ident:
-    [ [ s = string -> <:expr< Names.id_of_string $str:s$ >> ] ]
-  ;
-  name:
-    [ [ "_" -> <:expr< Anonymous >> | id = ident -> <:expr< Name $id$ >> ] ]
-  ;
-  string:
-    [ [ s = UIDENT -> s | s = LIDENT -> s ] ]
-  ;
-  constr:
-    [ "200" RIGHTA
-      [ LIDENT "forall"; id = ident; ":"; c1 = constr; ","; c2 = constr ->
-        <:expr< Glob_term.GProd ($dloc$,Name $id$,Glob_term.Explicit,$c1$,$c2$) >>
-      | "fun"; id = ident; ":"; c1 = constr; "=>"; c2 = constr ->
-        <:expr< Glob_term.GLambda ($dloc$,Name $id$,Glob_term.Explicit,$c1$,$c2$) >>
-      | "let"; id = ident; ":="; c1 = constr; "in"; c2 = constr ->
-        <:expr< Glob_term.RLetin ($dloc$,Name $id$,$c1$,$c2$) >>
-      (* fix todo *)
-      ]
-    | "100" RIGHTA
-      [ c1 = constr; ":"; c2 = SELF ->
-        <:expr< Glob_term.GCast($dloc$,$c1$,DEFAULTcast,$c2$) >> ]
-    | "90" RIGHTA
-      [ c1 = constr; "->"; c2 = SELF ->
-        <:expr< Glob_term.GProd ($dloc$,Anonymous,Glob_term.Explicit,$c1$,$c2$) >> ]
-    | "75" RIGHTA
-      [ "~"; c = constr ->
-        apply_ref <:expr< coq_not_ref >> [c] ]
-    | "70" RIGHTA
-      [ c1 = constr; "="; c2 = NEXT; ":>"; t = NEXT ->
-        apply_ref <:expr< coq_eq_ref >> [t;c1;c2] ]
-    | "10" LEFTA
-      [ f = constr; args = LIST1 NEXT ->
-        let args = mlexpr_of_list (fun x -> x) args in
-        <:expr< Glob_term.GApp ($dloc$,$f$,$args$) >> ]
-    | "0"
-      [ s = sort -> <:expr< Glob_term.GSort ($dloc$,s) >>
-      | id = ident -> <:expr< Glob_term.GVar ($dloc$,$id$) >>
-      | "_" -> <:expr< Glob_term.GHole ($dloc$, QuestionMark (Define False)) >>
-      | "?"; id = ident -> <:expr< Glob_term.GPatVar($dloc$,(False,$id$)) >>
-      | "{"; c1 = constr; "}"; "+"; "{"; c2 = constr; "}" ->
-          apply_ref <:expr< coq_sumbool_ref >> [c1;c2]
-      | "%"; e = string -> <:expr< Glob_term.GRef ($dloc$,Lazy.force $lid:e$) >>
-      | c = match_constr -> c
-      | "("; c = constr LEVEL "200"; ")" -> c ] ]
-  ;
-  match_constr:
-    [ [ "match"; c = constr LEVEL "100"; (ty,nal) = match_type;
-        "with"; OPT"|"; br = LIST0 eqn SEP "|"; "end" ->
-          let br = mlexpr_of_list (fun x -> x) br in
-     <:expr< Glob_term.GCases ($dloc$,$ty$,[($c$,$nal$)],$br$) >>
-    ] ]
-  ;
-  match_type:
-    [ [ "as"; id = ident; "in"; ind = LIDENT; nal = LIST0 name;
-        "return"; ty = constr LEVEL "100" ->
-          let nal = mlexpr_of_list (fun x -> x) nal in
-          <:expr< Some $ty$ >>,
-          <:expr< (Name $id$, Some ($dloc$,$lid:ind$,$nal$)) >>
-      | -> <:expr< None >>, <:expr< (Anonymous, None) >> ] ]
-  ;
-  eqn:
-    [ [ (lid,pl) = pattern; "=>"; rhs = constr ->
-        let lid = mlexpr_of_list (fun x -> x) lid in
-        <:expr< ($dloc$,$lid$,[$pl$],$rhs$) >>
-    ] ]
-  ;
-  pattern:
-    [ [ "%"; e = string; lip = LIST0 patvar ->
-        let lp = mlexpr_of_list (fun (_,x) -> x) lip in
-        let lid = List.flatten (List.map fst lip) in
-        lid, <:expr< Glob_term.PatCstr ($dloc$,$lid:e$,$lp$,Anonymous) >>
-      | p = patvar -> p
-      | "("; p = pattern; ")" -> p ] ]
-  ;
-  patvar:
-    [ [ "_" -> [], <:expr< Glob_term.PatVar ($dloc$,Anonymous) >>
-      | id = ident -> [id], <:expr< Glob_term.PatVar ($dloc$,Name $id$) >>
-    ] ]
-  ;
-  END;;
-
-(* Example
-open Coqlib
-let a = PATTERN [ match ?X with %path_of_S n => n | %path_of_O => ?X end ]
-*)
-
diff --git a/parsing/q_coqast.ml4 b/parsing/q_coqast.ml4
deleted file mode 100644
index f5508352..00000000
--- a/parsing/q_coqast.ml4
+++ /dev/null
@@ -1,568 +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 Libnames
-open Q_util
-open Compat
-
-let is_meta s = String.length s > 0 && s.[0] == '$'
-
-let purge_str s =
-  if String.length s == 0 || s.[0] <> '$' then s
-  else String.sub s 1 (String.length s - 1)
-
-let anti loc x =
-  expl_anti loc <:expr< $lid:purge_str x$ >>
-
-(* We don't give location for tactic quotation! *)
-let loc = dummy_loc
-
-let dloc = <:expr< Util.dummy_loc >>
-
-let mlexpr_of_ident id =
-  <:expr< Names.id_of_string $str:Names.string_of_id id$ >>
-
-let mlexpr_of_name = function
-  | Names.Anonymous -> <:expr< Names.Anonymous >>
-  | Names.Name id ->
-      <:expr< Names.Name (Names.id_of_string $str:Names.string_of_id id$) >>
-
-let mlexpr_of_dirpath dir =
-  let l = Names.repr_dirpath dir in
-  <:expr< Names.make_dirpath $mlexpr_of_list mlexpr_of_ident l$ >>
-
-let mlexpr_of_qualid qid =
-  let (dir, id) = repr_qualid qid in
-  <:expr< make_qualid $mlexpr_of_dirpath dir$ $mlexpr_of_ident id$ >>
-
-let mlexpr_of_reference = function
-  | Libnames.Qualid (loc,qid) -> <:expr< Libnames.Qualid $dloc$ $mlexpr_of_qualid qid$ >>
-  | Libnames.Ident (loc,id) -> <:expr< Libnames.Ident $dloc$ $mlexpr_of_ident id$ >>
-
-let mlexpr_of_located f (loc,x) = <:expr< ($dloc$, $f x$) >>
-
-let mlexpr_of_loc loc = <:expr< $dloc$ >>
-
-let mlexpr_of_by_notation f = function
-  | Genarg.AN x -> <:expr< Genarg.AN $f x$ >>
-  | Genarg.ByNotation (loc,s,sco) ->
-      <:expr< Genarg.ByNotation $dloc$ $str:s$ $mlexpr_of_option mlexpr_of_string sco$ >>
-
-let mlexpr_of_intro_pattern = function
-  | Genarg.IntroWildcard -> <:expr< Genarg.IntroWildcard >>
-  | Genarg.IntroAnonymous -> <:expr< Genarg.IntroAnonymous >>
-  | Genarg.IntroFresh id -> <:expr< Genarg.IntroFresh (mlexpr_of_ident $dloc$ id) >>
-  | Genarg.IntroForthcoming b -> <:expr< Genarg.IntroForthcoming (mlexpr_of_bool $dloc$ b) >>
-  | Genarg.IntroIdentifier id ->
-      <:expr< Genarg.IntroIdentifier (mlexpr_of_ident $dloc$ id) >>
-  | Genarg.IntroOrAndPattern _ | Genarg.IntroRewrite _ ->
-      failwith "mlexpr_of_intro_pattern: TODO"
-
-let mlexpr_of_ident_option = mlexpr_of_option (mlexpr_of_ident)
-
-let mlexpr_of_or_metaid f = function
-  | Tacexpr.AI a -> <:expr< Tacexpr.AI $f a$ >>
-  | Tacexpr.MetaId (_,id) -> <:expr< Tacexpr.AI $anti loc id$ >>
-
-let mlexpr_of_quantified_hypothesis = function
-  | Glob_term.AnonHyp n -> <:expr< Glob_term.AnonHyp $mlexpr_of_int n$ >>
-  | Glob_term.NamedHyp id ->  <:expr< Glob_term.NamedHyp $mlexpr_of_ident id$ >>
-
-let mlexpr_of_or_var f = function
-  | Glob_term.ArgArg x -> <:expr< Glob_term.ArgArg $f x$ >>
-  | Glob_term.ArgVar id -> <:expr< Glob_term.ArgVar $mlexpr_of_located mlexpr_of_ident id$ >>
-
-let mlexpr_of_hyp = mlexpr_of_or_metaid (mlexpr_of_located mlexpr_of_ident)
-
-let mlexpr_of_occs =
-  mlexpr_of_pair
-    mlexpr_of_bool (mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int))
-
-let mlexpr_of_occurrences f = mlexpr_of_pair mlexpr_of_occs f
-
-let mlexpr_of_hyp_location = function
-  | occs, Termops.InHyp ->
-      <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Termops.InHyp) >>
-  | occs, Termops.InHypTypeOnly ->
-      <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Termops.InHypTypeOnly) >>
-  | occs, Termops.InHypValueOnly ->
-      <:expr< ($mlexpr_of_occurrences mlexpr_of_hyp occs$, Termops.InHypValueOnly) >>
-
-let mlexpr_of_clause cl =
-  <:expr< {Tacexpr.onhyps=
-             $mlexpr_of_option (mlexpr_of_list mlexpr_of_hyp_location)
-               cl.Tacexpr.onhyps$;
-           Tacexpr.concl_occs= $mlexpr_of_occs cl.Tacexpr.concl_occs$} >>
-
-let mlexpr_of_red_flags {
-  Glob_term.rBeta = bb;
-  Glob_term.rIota = bi;
-  Glob_term.rZeta = bz;
-  Glob_term.rDelta = bd;
-  Glob_term.rConst = l
-} = <:expr< {
-  Glob_term.rBeta = $mlexpr_of_bool bb$;
-  Glob_term.rIota = $mlexpr_of_bool bi$;
-  Glob_term.rZeta = $mlexpr_of_bool bz$;
-  Glob_term.rDelta = $mlexpr_of_bool bd$;
-  Glob_term.rConst = $mlexpr_of_list (mlexpr_of_by_notation mlexpr_of_reference) l$
-} >>
-
-let mlexpr_of_explicitation = function
-  | Topconstr.ExplByName id -> <:expr< Topconstr.ExplByName $mlexpr_of_ident id$ >>
-  | Topconstr.ExplByPos (n,_id) -> <:expr< Topconstr.ExplByPos $mlexpr_of_int n$ >>
-
-let mlexpr_of_binding_kind = function
-  | Glob_term.Implicit -> <:expr< Glob_term.Implicit >>
-  | Glob_term.Explicit -> <:expr< Glob_term.Explicit >>
-
-let mlexpr_of_binder_kind = function
-  | Topconstr.Default b -> <:expr< Topconstr.Default $mlexpr_of_binding_kind b$ >>
-  | Topconstr.Generalized (b,b',b'') ->
-      <:expr< Topconstr.TypeClass $mlexpr_of_binding_kind b$
-	$mlexpr_of_binding_kind b'$ $mlexpr_of_bool b''$ >>
-
-let rec mlexpr_of_constr = function
-  | Topconstr.CRef (Libnames.Ident (loc,id)) when is_meta (string_of_id id) ->
-      anti loc (string_of_id id)
-  | Topconstr.CRef r -> <:expr< Topconstr.CRef $mlexpr_of_reference r$ >>
-  | Topconstr.CFix (loc,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.CCoFix (loc,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.CArrow (loc,a,b) ->
-  <:expr< Topconstr.CArrow $dloc$ $mlexpr_of_constr a$ $mlexpr_of_constr b$ >>
-  | Topconstr.CProdN (loc,l,a) -> <:expr< Topconstr.CProdN $dloc$ $mlexpr_of_list
-      (mlexpr_of_triple (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_binder_kind mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
-  | Topconstr.CLambdaN (loc,l,a) -> <:expr< Topconstr.CLambdaN $dloc$ $mlexpr_of_list (mlexpr_of_triple (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_binder_kind mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
-  | Topconstr.CLetIn (loc,_,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.CAppExpl (loc,a,l) -> <:expr< Topconstr.CAppExpl $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_reference a$ $mlexpr_of_list mlexpr_of_constr l$ >>
-  | Topconstr.CApp (loc,a,l) -> <:expr< Topconstr.CApp $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_constr a$ $mlexpr_of_list (mlexpr_of_pair mlexpr_of_constr (mlexpr_of_option (mlexpr_of_located mlexpr_of_explicitation))) l$ >>
-  | Topconstr.CCases (loc,_,_,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.CHole (loc, None) -> <:expr< Topconstr.CHole $dloc$ None >>
-  | Topconstr.CHole (loc, Some _) -> failwith "mlexpr_of_constr: TODO CHole (Some _)"
-  | Topconstr.CNotation(_,ntn,(subst,substl,[])) ->
-      <:expr< Topconstr.CNotation $dloc$ $mlexpr_of_string ntn$
-              ($mlexpr_of_list mlexpr_of_constr subst$,
-               $mlexpr_of_list (mlexpr_of_list mlexpr_of_constr) substl$,[]) >>
-  | Topconstr.CPatVar (loc,n) ->
-      <:expr< Topconstr.CPatVar $dloc$ $mlexpr_of_pair mlexpr_of_bool mlexpr_of_ident n$ >>
-  | _ -> failwith "mlexpr_of_constr: TODO"
-
-let mlexpr_of_occ_constr =
-  mlexpr_of_occurrences mlexpr_of_constr
-
-let mlexpr_of_red_expr = function
-  | Glob_term.Red b -> <:expr< Glob_term.Red $mlexpr_of_bool b$ >>
-  | Glob_term.Hnf -> <:expr< Glob_term.Hnf >>
-  | Glob_term.Simpl o -> <:expr< Glob_term.Simpl $mlexpr_of_option mlexpr_of_occ_constr o$ >>
-  | Glob_term.Cbv f ->
-      <:expr< Glob_term.Cbv $mlexpr_of_red_flags f$ >>
-  | Glob_term.Lazy f ->
-      <:expr< Glob_term.Lazy $mlexpr_of_red_flags f$ >>
-  | Glob_term.Unfold l ->
-      let f1 = mlexpr_of_by_notation mlexpr_of_reference in
-      let f = mlexpr_of_list (mlexpr_of_occurrences f1) in
-      <:expr< Glob_term.Unfold $f l$ >>
-  | Glob_term.Fold l ->
-      <:expr< Glob_term.Fold $mlexpr_of_list mlexpr_of_constr l$ >>
-  | Glob_term.Pattern l ->
-      let f = mlexpr_of_list mlexpr_of_occ_constr in
-      <:expr< Glob_term.Pattern $f l$ >>
-  | Glob_term.CbvVm -> <:expr< Glob_term.CbvVm >>
-  | Glob_term.ExtraRedExpr s ->
-      <:expr< Glob_term.ExtraRedExpr $mlexpr_of_string s$ >>
-
-let rec mlexpr_of_argtype loc = function
-  | Genarg.BoolArgType -> <:expr< Genarg.BoolArgType >>
-  | Genarg.IntArgType -> <:expr< Genarg.IntArgType >>
-  | Genarg.IntOrVarArgType -> <:expr< Genarg.IntOrVarArgType >>
-  | Genarg.RefArgType -> <:expr< Genarg.RefArgType >>
-  | Genarg.PreIdentArgType -> <:expr< Genarg.PreIdentArgType >>
-  | Genarg.IntroPatternArgType -> <:expr< Genarg.IntroPatternArgType >>
-  | Genarg.IdentArgType b -> <:expr< Genarg.IdentArgType $mlexpr_of_bool b$ >>
-  | Genarg.VarArgType -> <:expr< Genarg.VarArgType >>
-  | Genarg.StringArgType -> <:expr< Genarg.StringArgType >>
-  | Genarg.QuantHypArgType -> <:expr< Genarg.QuantHypArgType >>
-  | Genarg.OpenConstrArgType (b1,b2) -> <:expr< Genarg.OpenConstrArgType ($mlexpr_of_bool b1$, $mlexpr_of_bool b2$) >>
-  | Genarg.ConstrWithBindingsArgType -> <:expr< Genarg.ConstrWithBindingsArgType >>
-  | Genarg.BindingsArgType -> <:expr< Genarg.BindingsArgType >>
-  | Genarg.RedExprArgType -> <:expr< Genarg.RedExprArgType >>
-  | Genarg.SortArgType -> <:expr< Genarg.SortArgType >>
-  | Genarg.ConstrArgType -> <:expr< Genarg.ConstrArgType >>
-  | Genarg.ConstrMayEvalArgType -> <:expr< Genarg.ConstrMayEvalArgType >>
-  | Genarg.List0ArgType t -> <:expr< Genarg.List0ArgType $mlexpr_of_argtype loc t$ >>
-  | Genarg.List1ArgType t -> <:expr< Genarg.List1ArgType $mlexpr_of_argtype loc t$ >>
-  | Genarg.OptArgType t -> <:expr< Genarg.OptArgType $mlexpr_of_argtype loc t$ >>
-  | Genarg.PairArgType (t1,t2) ->
-      let t1 = mlexpr_of_argtype loc t1 in
-      let t2 = mlexpr_of_argtype loc t2 in
-      <:expr< Genarg.PairArgType $t1$ $t2$ >>
-  | Genarg.ExtraArgType s -> <:expr< Genarg.ExtraArgType $str:s$ >>
-
-let rec mlexpr_of_may_eval f = function
-  | Glob_term.ConstrEval (r,c) ->
-      <:expr< Glob_term.ConstrEval $mlexpr_of_red_expr r$ $f c$ >>
-  | Glob_term.ConstrContext ((loc,id),c) ->
-      let id = mlexpr_of_ident id in
-      <:expr< Glob_term.ConstrContext (loc,$id$) $f c$ >>
-  | Glob_term.ConstrTypeOf c ->
-      <:expr< Glob_term.ConstrTypeOf $mlexpr_of_constr c$ >>
-  | Glob_term.ConstrTerm c ->
-      <:expr< Glob_term.ConstrTerm $mlexpr_of_constr c$ >>
-
-let mlexpr_of_binding_kind = function
-  | Glob_term.ExplicitBindings l ->
-      let l = mlexpr_of_list (mlexpr_of_triple mlexpr_of_loc mlexpr_of_quantified_hypothesis mlexpr_of_constr) l in
-      <:expr< Glob_term.ExplicitBindings $l$ >>
-  | Glob_term.ImplicitBindings l ->
-      let l = mlexpr_of_list mlexpr_of_constr l in
-      <:expr< Glob_term.ImplicitBindings $l$ >>
-  | Glob_term.NoBindings ->
-       <:expr< Glob_term.NoBindings >>
-
-let mlexpr_of_binding = mlexpr_of_pair mlexpr_of_binding_kind mlexpr_of_constr
-
-let mlexpr_of_constr_with_binding =
-  mlexpr_of_pair mlexpr_of_constr mlexpr_of_binding_kind
-
-let mlexpr_of_move_location f = function
-  | Tacexpr.MoveAfter id -> <:expr< Tacexpr.MoveAfter $f id$ >>
-  | Tacexpr.MoveBefore id -> <:expr< Tacexpr.MoveBefore $f id$ >>
-  | Tacexpr.MoveToEnd b -> <:expr< Tacexpr.MoveToEnd $mlexpr_of_bool b$ >>
-
-let mlexpr_of_induction_arg = function
-  | Tacexpr.ElimOnConstr c ->
-      <:expr< Tacexpr.ElimOnConstr $mlexpr_of_constr_with_binding c$ >>
-  | Tacexpr.ElimOnIdent (_,id) ->
-      <:expr< Tacexpr.ElimOnIdent $dloc$ $mlexpr_of_ident id$ >>
-  | Tacexpr.ElimOnAnonHyp n ->
-      <:expr< Tacexpr.ElimOnAnonHyp $mlexpr_of_int n$ >>
-
-let mlexpr_of_clause_pattern _ = failwith "mlexpr_of_clause_pattern: TODO"
-
-let mlexpr_of_pattern_ast = mlexpr_of_constr
-
-let mlexpr_of_entry_type = function
-    _ -> failwith "mlexpr_of_entry_type: TODO"
-
-let mlexpr_of_match_pattern = function
-  | Tacexpr.Term t -> <:expr< Tacexpr.Term $mlexpr_of_pattern_ast t$ >>
-  | Tacexpr.Subterm (b,ido,t) ->
-      <:expr< Tacexpr.Subterm $mlexpr_of_bool b$ $mlexpr_of_option mlexpr_of_ident ido$ $mlexpr_of_pattern_ast t$ >>
-
-let mlexpr_of_match_context_hyps = function
-  | Tacexpr.Hyp (id,l) ->
-      let f = mlexpr_of_located mlexpr_of_name in
-      <:expr< Tacexpr.Hyp $f id$ $mlexpr_of_match_pattern l$ >>
-  | Tacexpr.Def (id,v,l) ->
-      let f = mlexpr_of_located mlexpr_of_name in
-      <:expr< Tacexpr.Def $f id$ $mlexpr_of_match_pattern v$ $mlexpr_of_match_pattern l$ >>
-
-let mlexpr_of_match_rule f = function
-  | Tacexpr.Pat (l,mp,t) -> <:expr< Tacexpr.Pat $mlexpr_of_list mlexpr_of_match_context_hyps l$ $mlexpr_of_match_pattern mp$ $f t$ >>
-  | Tacexpr.All t -> <:expr< Tacexpr.All $f t$ >>
-
-let mlexpr_of_message_token = function
-  | Tacexpr.MsgString s -> <:expr< Tacexpr.MsgString $str:s$ >>
-  | Tacexpr.MsgInt n -> <:expr< Tacexpr.MsgInt $mlexpr_of_int n$ >>
-  | Tacexpr.MsgIdent id -> <:expr< Tacexpr.MsgIdent $mlexpr_of_hyp id$ >>
-
-let mlexpr_of_debug = function
-  | Tacexpr.Off -> <:expr< Tacexpr.Off >>
-  | Tacexpr.Debug -> <:expr< Tacexpr.Debug >>
-  | Tacexpr.Info -> <:expr< Tacexpr.Info >>
-
-let rec mlexpr_of_atomic_tactic = function
-  (* Basic tactics *)
-  | Tacexpr.TacIntroPattern pl ->
-      let pl = mlexpr_of_list (mlexpr_of_located mlexpr_of_intro_pattern) pl in
-      <:expr< Tacexpr.TacIntroPattern $pl$ >>
-  | Tacexpr.TacIntrosUntil h ->
-      <:expr< Tacexpr.TacIntrosUntil $mlexpr_of_quantified_hypothesis h$ >>
-  | Tacexpr.TacIntroMove (idopt,idopt') ->
-      let idopt = mlexpr_of_ident_option idopt in
-      let idopt'= mlexpr_of_move_location mlexpr_of_hyp idopt' in
-      <:expr< Tacexpr.TacIntroMove $idopt$ $idopt'$ >>
-  | Tacexpr.TacAssumption ->
-      <:expr< Tacexpr.TacAssumption >>
-  | Tacexpr.TacExact c ->
-      <:expr< Tacexpr.TacExact $mlexpr_of_constr c$ >>
-  | Tacexpr.TacExactNoCheck c ->
-      <:expr< Tacexpr.TacExactNoCheck $mlexpr_of_constr c$ >>
-  | Tacexpr.TacVmCastNoCheck c ->
-      <:expr< Tacexpr.TacVmCastNoCheck $mlexpr_of_constr c$ >>
-  | Tacexpr.TacApply (b,false,cb,None) ->
-      <:expr< Tacexpr.TacApply $mlexpr_of_bool b$ False $mlexpr_of_list mlexpr_of_constr_with_binding cb$ None >>
-  | Tacexpr.TacElim (false,cb,cbo) ->
-      let cb = mlexpr_of_constr_with_binding cb in
-      let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
-      <:expr< Tacexpr.TacElim False $cb$ $cbo$ >>
-  | Tacexpr.TacElimType c ->
-      <:expr< Tacexpr.TacElimType $mlexpr_of_constr c$ >>
-  | Tacexpr.TacCase (false,cb) ->
-      let cb = mlexpr_of_constr_with_binding cb in
-      <:expr< Tacexpr.TacCase False $cb$ >>
-  | Tacexpr.TacCaseType c ->
-      <:expr< Tacexpr.TacCaseType $mlexpr_of_constr c$ >>
-  | Tacexpr.TacFix (ido,n) ->
-      let ido = mlexpr_of_ident_option ido in
-      let n = mlexpr_of_int n in
-      <:expr< Tacexpr.TacFix $ido$ $n$ >>
-  | Tacexpr.TacMutualFix (b,id,n,l) ->
-      let b = mlexpr_of_bool b in
-      let id = mlexpr_of_ident id in
-      let n = mlexpr_of_int n in
-      let f =mlexpr_of_triple mlexpr_of_ident mlexpr_of_int mlexpr_of_constr in
-      let l = mlexpr_of_list f l in
-      <:expr< Tacexpr.TacMutualFix $b$ $id$ $n$ $l$ >>
-  | Tacexpr.TacCofix ido ->
-      let ido = mlexpr_of_ident_option ido in
-      <:expr< Tacexpr.TacCofix $ido$ >>
-  | Tacexpr.TacMutualCofix (b,id,l) ->
-      let b = mlexpr_of_bool b in
-      let id = mlexpr_of_ident id in
-      let f = mlexpr_of_pair mlexpr_of_ident mlexpr_of_constr in
-      let l = mlexpr_of_list f l in
-      <:expr< Tacexpr.TacMutualCofix $b$ $id$ $l$ >>
-
-  | Tacexpr.TacCut c ->
-      <:expr< Tacexpr.TacCut $mlexpr_of_constr c$ >>
-  | Tacexpr.TacAssert (t,ipat,c) ->
-      let ipat = mlexpr_of_option (mlexpr_of_located mlexpr_of_intro_pattern) ipat in
-      <:expr< Tacexpr.TacAssert $mlexpr_of_option mlexpr_of_tactic t$ $ipat$
-	      $mlexpr_of_constr c$ >>
-  | Tacexpr.TacGeneralize cl ->
-      <:expr< Tacexpr.TacGeneralize
-	      $mlexpr_of_list
-                (mlexpr_of_pair mlexpr_of_occ_constr mlexpr_of_name) cl$ >>
-  | Tacexpr.TacGeneralizeDep c ->
-      <:expr< Tacexpr.TacGeneralizeDep $mlexpr_of_constr c$ >>
-  | Tacexpr.TacLetTac (na,c,cl,b,e) ->
-      let na = mlexpr_of_name na in
-      let cl = mlexpr_of_clause_pattern cl in
-      <:expr< Tacexpr.TacLetTac $na$ $mlexpr_of_constr c$ $cl$
-	      $mlexpr_of_bool b$
-	      (mlexpr_of_option (mlexpr_of_located mlexpr_of_intro_pattern) e)
-      >>
-
-  (* Derived basic tactics *)
-  | Tacexpr.TacSimpleInductionDestruct (isrec,h) ->
-      <:expr< Tacexpr.TacSimpleInductionDestruct $mlexpr_of_bool isrec$
-                  $mlexpr_of_quantified_hypothesis h$ >>
-  | Tacexpr.TacInductionDestruct (isrec,ev,l) ->
-      <:expr< Tacexpr.TacInductionDestruct $mlexpr_of_bool isrec$ $mlexpr_of_bool ev$
-	$mlexpr_of_triple
-	(mlexpr_of_list
-	   (mlexpr_of_pair
-	      mlexpr_of_induction_arg
-	      (mlexpr_of_pair
-		 (mlexpr_of_option (mlexpr_of_located mlexpr_of_intro_pattern))
-		 (mlexpr_of_option (mlexpr_of_located mlexpr_of_intro_pattern)))))
-	(mlexpr_of_option mlexpr_of_constr_with_binding)
-	(mlexpr_of_option mlexpr_of_clause) l$ >>
-
-  (* Context management *)
-  | Tacexpr.TacClear (b,l) ->
-      let l = mlexpr_of_list (mlexpr_of_hyp) l in
-      <:expr< Tacexpr.TacClear $mlexpr_of_bool b$ $l$ >>
-  | Tacexpr.TacClearBody l ->
-      let l = mlexpr_of_list (mlexpr_of_hyp) l in
-      <:expr< Tacexpr.TacClearBody $l$ >>
-  | Tacexpr.TacMove (dep,id1,id2) ->
-      <:expr< Tacexpr.TacMove $mlexpr_of_bool dep$
-              $mlexpr_of_hyp id1$
-              $mlexpr_of_move_location mlexpr_of_hyp id2$ >>
-
-  (* Constructors *)
-  | Tacexpr.TacLeft (ev,l) ->
-      <:expr< Tacexpr.TacLeft $mlexpr_of_bool ev$ $mlexpr_of_binding_kind l$>>
-  | Tacexpr.TacRight (ev,l) ->
-      <:expr< Tacexpr.TacRight $mlexpr_of_bool ev$ $mlexpr_of_binding_kind l$>>
-  | Tacexpr.TacSplit (ev,b,l) ->
-      <:expr< Tacexpr.TacSplit
-        ($mlexpr_of_bool ev$,$mlexpr_of_bool b$,$mlexpr_of_list mlexpr_of_binding_kind l$)>>
-  | Tacexpr.TacAnyConstructor (ev,t) ->
-      <:expr< Tacexpr.TacAnyConstructor $mlexpr_of_bool ev$ $mlexpr_of_option mlexpr_of_tactic t$>>
-  | Tacexpr.TacConstructor (ev,n,l) ->
-      let n = mlexpr_of_or_var mlexpr_of_int n in
-      <:expr< Tacexpr.TacConstructor $mlexpr_of_bool ev$ $n$ $mlexpr_of_binding_kind l$>>
-
-  (* Conversion *)
-  | Tacexpr.TacReduce (r,cl) ->
-      let l = mlexpr_of_clause cl in
-      <:expr< Tacexpr.TacReduce $mlexpr_of_red_expr r$ $l$ >>
-  | Tacexpr.TacChange (p,c,cl) ->
-      let l = mlexpr_of_clause cl in
-      let g = mlexpr_of_option mlexpr_of_constr in
-      <:expr< Tacexpr.TacChange $g p$ $mlexpr_of_constr c$ $l$ >>
-
-  (* Equivalence relations *)
-  | Tacexpr.TacReflexivity -> <:expr< Tacexpr.TacReflexivity >>
-  | Tacexpr.TacSymmetry ido -> <:expr< Tacexpr.TacSymmetry $mlexpr_of_clause ido$ >>
-  | Tacexpr.TacTransitivity c -> <:expr< Tacexpr.TacTransitivity $mlexpr_of_option mlexpr_of_constr c$ >>
-
-  (* Automation tactics *)
-  | Tacexpr.TacAuto (debug,n,lems,l) ->
-      let d = mlexpr_of_debug debug in
-      let n = mlexpr_of_option (mlexpr_of_or_var mlexpr_of_int) n in
-      let lems = mlexpr_of_list mlexpr_of_constr lems in
-      let l = mlexpr_of_option (mlexpr_of_list mlexpr_of_string) l in
-      <:expr< Tacexpr.TacAuto $d$ $n$ $lems$ $l$ >>
-  | Tacexpr.TacTrivial (debug,lems,l) ->
-      let d = mlexpr_of_debug debug in
-      let l = mlexpr_of_option (mlexpr_of_list mlexpr_of_string) l in
-      let lems = mlexpr_of_list mlexpr_of_constr lems in
-      <:expr< Tacexpr.TacTrivial $d$ $lems$ $l$ >>
-
-  | _ -> failwith "Quotation of atomic tactic expressions: TODO"
-
-and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
-  | Tacexpr.TacAtom (loc,t) ->
-      <:expr< Tacexpr.TacAtom $dloc$ $mlexpr_of_atomic_tactic t$ >>
-  | Tacexpr.TacThen (t1,[||],t2,[||]) ->
-      <:expr< Tacexpr.TacThen $mlexpr_of_tactic t1$ [||] $mlexpr_of_tactic t2$ [||]>>
-  | Tacexpr.TacThens (t,tl) ->
-      <:expr< Tacexpr.TacThens $mlexpr_of_tactic t$ $mlexpr_of_list mlexpr_of_tactic tl$>>
-  | Tacexpr.TacFirst tl ->
-      <:expr< Tacexpr.TacFirst $mlexpr_of_list mlexpr_of_tactic tl$ >>
-  | Tacexpr.TacSolve tl ->
-      <:expr< Tacexpr.TacSolve $mlexpr_of_list mlexpr_of_tactic tl$ >>
-  | Tacexpr.TacTry t ->
-      <:expr< Tacexpr.TacTry $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacOrelse (t1,t2) ->
-      <:expr< Tacexpr.TacOrelse $mlexpr_of_tactic t1$ $mlexpr_of_tactic t2$ >>
-  | Tacexpr.TacDo (n,t) ->
-      <:expr< Tacexpr.TacDo $mlexpr_of_or_var mlexpr_of_int n$ $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacTimeout (n,t) ->
-      <:expr< Tacexpr.TacTimeout $mlexpr_of_or_var mlexpr_of_int n$ $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacRepeat t ->
-      <:expr< Tacexpr.TacRepeat $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacProgress t ->
-      <:expr< Tacexpr.TacProgress $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacId l ->
-      <:expr< Tacexpr.TacId $mlexpr_of_list mlexpr_of_message_token l$ >>
-  | Tacexpr.TacFail (n,l) ->
-      <:expr< Tacexpr.TacFail $mlexpr_of_or_var mlexpr_of_int n$ $mlexpr_of_list mlexpr_of_message_token l$ >>
-(*
-  | Tacexpr.TacInfo t -> TacInfo (loc,f t)
-
-  | Tacexpr.TacRec (id,(idl,t)) -> TacRec (loc,(id,(idl,f t)))
-  | Tacexpr.TacRecIn (l,t) -> TacRecIn(loc,List.map (fun (id,t) -> (id,f t)) l,f t)
-*)
-  | Tacexpr.TacLetIn (isrec,l,t) ->
-      let f =
-	mlexpr_of_pair
-	  (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_ident)
-	  mlexpr_of_tactic_arg in
-      <:expr< Tacexpr.TacLetIn $mlexpr_of_bool isrec$ $mlexpr_of_list f l$ $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacMatch (lz,t,l) ->
-      <:expr< Tacexpr.TacMatch
-        $mlexpr_of_bool lz$
-        $mlexpr_of_tactic t$
-        $mlexpr_of_list (mlexpr_of_match_rule mlexpr_of_tactic) l$>>
-  | Tacexpr.TacMatchGoal (lz,lr,l) ->
-      <:expr< Tacexpr.TacMatchGoal
-        $mlexpr_of_bool lz$
-        $mlexpr_of_bool lr$
-        $mlexpr_of_list (mlexpr_of_match_rule mlexpr_of_tactic) l$>>
-
-  | Tacexpr.TacFun (idol,body) ->
-      <:expr< Tacexpr.TacFun
-        ($mlexpr_of_list mlexpr_of_ident_option idol$,
-         $mlexpr_of_tactic body$) >>
-  | Tacexpr.TacArg (_,Tacexpr.MetaIdArg (_,true,id)) -> anti loc id
-  | Tacexpr.TacArg (_,t) ->
-      <:expr< Tacexpr.TacArg $dloc$ $mlexpr_of_tactic_arg t$ >>
-  | Tacexpr.TacComplete t ->
-      <:expr< Tacexpr.TacComplete $mlexpr_of_tactic t$ >>
-  | _ -> failwith "Quotation of tactic expressions: TODO"
-
-and mlexpr_of_tactic_arg = function
-  | Tacexpr.MetaIdArg (loc,true,id) -> anti loc id
-  | Tacexpr.MetaIdArg (loc,false,id) ->
-      <:expr< Tacexpr.ConstrMayEval (Glob_term.ConstrTerm $anti loc id$) >>
-  | Tacexpr.TacCall (loc,t,tl) ->
-      <:expr< Tacexpr.TacCall $dloc$ $mlexpr_of_reference t$ $mlexpr_of_list mlexpr_of_tactic_arg tl$>>
-  | Tacexpr.Tacexp t ->
-      <:expr< Tacexpr.Tacexp $mlexpr_of_tactic t$ >>
-  | Tacexpr.ConstrMayEval c ->
-      <:expr< Tacexpr.ConstrMayEval $mlexpr_of_may_eval mlexpr_of_constr c$ >>
-  | Tacexpr.Reference r ->
-      <:expr< Tacexpr.Reference $mlexpr_of_reference r$ >>
-  | _ -> failwith "mlexpr_of_tactic_arg: TODO"
-
-
-IFDEF CAMLP5 THEN
-
-let not_impl x =
-  let desc =
-    if Obj.is_block (Obj.repr x) then
-      "tag = " ^ string_of_int (Obj.tag (Obj.repr x))
-    else "int_val = " ^ string_of_int (Obj.magic x)
-  in
-  failwith ("<Q_coqast.patt_of_expt, not impl: " ^ desc)
-
-(* The following function is written without quotation
-   in order to be parsable even by camlp4. The version with
-   quotation can be found in revision <= 12972 of [q_util.ml4] *)
-
-open MLast
-
-let rec patt_of_expr e =
-  let loc = loc_of_expr e in
-  match e with
-    | ExAcc (_, e1, e2) -> PaAcc (loc, patt_of_expr e1, patt_of_expr e2)
-    | ExApp (_, e1, e2) -> PaApp (loc, patt_of_expr e1, patt_of_expr e2)
-    | ExLid (_, x) when x = vala "loc" -> PaAny loc
-    | ExLid (_, s) -> PaLid (loc, s)
-    | ExUid (_, s) -> PaUid (loc, s)
-    | ExStr (_, s) -> PaStr (loc, s)
-    | ExAnt (_, e) -> PaAnt (loc, patt_of_expr e)
-    | _ -> not_impl e
-
-let fconstr e =
-  let ee s =
-    mlexpr_of_constr (Pcoq.Gram.entry_parse e
-			(Pcoq.Gram.parsable (Stream.of_string s)))
-  in
-  let ep s = patt_of_expr (ee s) in
-  Quotation.ExAst (ee, ep)
-
-let ftac e =
-  let ee s =
-    mlexpr_of_tactic (Pcoq.Gram.entry_parse e
-			(Pcoq.Gram.parsable (Stream.of_string s)))
-  in
-  let ep s = patt_of_expr (ee s) in
-  Quotation.ExAst (ee, ep)
-
-let _ =
-  Quotation.add "constr" (fconstr Pcoq.Constr.constr_eoi);
-  Quotation.add "tactic" (ftac Pcoq.Tactic.tactic_eoi);
-  Quotation.default := "constr"
-
-ELSE
-
-open Pcaml
-
-let expand_constr_quot_expr loc _loc_name_opt contents =
-  mlexpr_of_constr
-    (Pcoq.Gram.parse_string Pcoq.Constr.constr_eoi loc contents)
-
-let expand_tactic_quot_expr loc _loc_name_opt contents =
-  mlexpr_of_tactic
-    (Pcoq.Gram.parse_string Pcoq.Tactic.tactic_eoi loc contents)
-
-let _ =
-  (* FIXME: for the moment, we add quotations in expressions only, not pattern *)
-  Quotation.add "constr" Quotation.DynAst.expr_tag expand_constr_quot_expr;
-  Quotation.add "tactic" Quotation.DynAst.expr_tag expand_tactic_quot_expr;
-  Quotation.default := "constr"
-
-END
diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4
deleted file mode 100644
index 947e7e54..00000000
--- a/parsing/q_util.ml4
+++ /dev/null
@@ -1,69 +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        *)
-(************************************************************************)
-
-(* This file defines standard combinators to build ml expressions *)
-
-open Extrawit
-open Compat
-open Util
-
-let mlexpr_of_list f l =
-  List.fold_right
-    (fun e1 e2 ->
-      let e1 = f e1 in
-       let loc = join_loc (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
-       <:expr< [$e1$ :: $e2$] >>)
-    l (let loc = dummy_loc in <:expr< [] >>)
-
-let mlexpr_of_pair m1 m2 (a1,a2) =
-  let e1 = m1 a1 and e2 = m2 a2 in
-  let loc = join_loc (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
-  <:expr< ($e1$, $e2$) >>
-
-let mlexpr_of_triple m1 m2 m3 (a1,a2,a3)=
-  let e1 = m1 a1 and e2 = m2 a2 and e3 = m3 a3 in
-  let loc = join_loc (MLast.loc_of_expr e1) (MLast.loc_of_expr e3) in
-  <:expr< ($e1$, $e2$, $e3$) >>
-
-let mlexpr_of_quadruple m1 m2 m3 m4 (a1,a2,a3,a4)=
-  let e1 = m1 a1 and e2 = m2 a2 and e3 = m3 a3 and e4 = m4 a4 in
-  let loc = join_loc (MLast.loc_of_expr e1) (MLast.loc_of_expr e4) in
-  <:expr< ($e1$, $e2$, $e3$, $e4$) >>
-
-(* We don't give location for tactic quotation! *)
-let loc = dummy_loc
-
-
-let mlexpr_of_bool = function
-  | true -> <:expr< True >>
-  | false -> <:expr< False >>
-
-let mlexpr_of_int n = <:expr< $int:string_of_int n$ >>
-
-let mlexpr_of_string s = <:expr< $str:s$ >>
-
-let mlexpr_of_option f = function
-  | None -> <:expr< None >>
-  | Some e -> <:expr< Some $f e$ >>
-
-open Vernacexpr
-open Genarg
-
-let rec mlexpr_of_prod_entry_key = function
-  | Pcoq.Alist1 s -> <:expr< Pcoq.Alist1 $mlexpr_of_prod_entry_key s$ >>
-  | Pcoq.Alist1sep (s,sep) -> <:expr< Pcoq.Alist1sep $mlexpr_of_prod_entry_key s$ $str:sep$ >>
-  | Pcoq.Alist0 s -> <:expr< Pcoq.Alist0 $mlexpr_of_prod_entry_key s$ >>
-  | Pcoq.Alist0sep (s,sep) -> <:expr< Pcoq.Alist0sep $mlexpr_of_prod_entry_key s$ $str:sep$ >>
-  | Pcoq.Aopt s -> <:expr< Pcoq.Aopt $mlexpr_of_prod_entry_key s$ >>
-  | Pcoq.Amodifiers s -> <:expr< Pcoq.Amodifiers $mlexpr_of_prod_entry_key s$ >>
-  | Pcoq.Aself -> <:expr< Pcoq.Aself >>
-  | Pcoq.Anext -> <:expr< Pcoq.Anext >>
-  | Pcoq.Atactic n -> <:expr< Pcoq.Atactic $mlexpr_of_int n$ >>
-  | Pcoq.Agram s -> Util.anomaly "Agram not supported"
-  | Pcoq.Aentry ("",s) -> <:expr< Pcoq.Agram (Pcoq.Gram.Entry.obj $lid:s$) >>
-  | Pcoq.Aentry (u,s) -> <:expr< Pcoq.Aentry $str:u$ $str:s$ >>
diff --git a/parsing/q_util.mli b/parsing/q_util.mli
deleted file mode 100644
index babbfb8a..00000000
--- a/parsing/q_util.mli
+++ /dev/null
@@ -1,33 +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 Compat
-
-val mlexpr_of_list :  ('a -> MLast.expr) -> 'a list -> MLast.expr
-
-val mlexpr_of_pair :
-  ('a -> MLast.expr) -> ('b -> MLast.expr)
-    -> 'a * 'b -> MLast.expr
-
-val mlexpr_of_triple :
-  ('a -> MLast.expr) -> ('b -> MLast.expr) -> ('c -> MLast.expr)
-    -> 'a * 'b * 'c -> MLast.expr
-
-val mlexpr_of_quadruple :
-  ('a -> MLast.expr) -> ('b -> MLast.expr) ->
-    ('c -> MLast.expr) -> ('d -> MLast.expr) -> 'a * 'b * 'c * 'd -> MLast.expr
-
-val mlexpr_of_bool : bool -> MLast.expr
-
-val mlexpr_of_int : int -> MLast.expr
-
-val mlexpr_of_string : string -> MLast.expr
-
-val mlexpr_of_option : ('a -> MLast.expr) -> 'a option -> MLast.expr
-
-val mlexpr_of_prod_entry_key : Pcoq.prod_entry_key -> MLast.expr
diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4
deleted file mode 100644
index 7bcd1cf2..00000000
--- a/parsing/tacextend.ml4
+++ /dev/null
@@ -1,238 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "tools/compat5b.cmo" i*)
-
-open Util
-open Genarg
-open Q_util
-open Q_coqast
-open Argextend
-open Pcoq
-open Extrawit
-open Egrammar
-open Compat
-
-let rec make_patt = function
-  | [] -> <:patt< [] >>
-  | GramNonTerminal(loc',_,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      <:patt< [ $lid:p$ :: $make_patt l$ ] >>
-  | _::l -> make_patt l
-
-let rec make_when loc = function
-  | [] -> <:expr< True >>
-  | GramNonTerminal(loc',t,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      let l = make_when loc l in
-      let loc = join_loc loc' loc in
-      let t = mlexpr_of_argtype loc' t in
-      <:expr< Genarg.genarg_tag $lid:p$ = $t$ && $l$ >>
-  | _::l -> make_when loc l
-
-let rec make_let e = function
-  | [] -> e
-  | GramNonTerminal(loc,t,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      let loc = join_loc loc (MLast.loc_of_expr e) in
-      let e = make_let e l in
-      let v = <:expr< Genarg.out_gen $make_wit loc t$ $lid:p$ >> in
-      <:expr< let $lid:p$ = $v$ in $e$ >>
-  | _::l -> make_let e l
-
-let rec extract_signature = function
-  | [] -> []
-  | GramNonTerminal (_,t,_,_) :: l -> t :: extract_signature l
-  | _::l -> extract_signature l
-
-let check_unicity s l =
-  let l' = List.map (fun (l,_) -> extract_signature l) l in
-  if not (Util.list_distinct l') then
-    Pp.warning_with !Pp_control.err_ft
-      ("Two distinct rules of tactic entry "^s^" have the same\n"^
-      "non-terminals in the same order: put them in distinct tactic entries")
-
-let make_clause (pt,e) =
-  (make_patt pt,
-   vala (Some (make_when (MLast.loc_of_expr e) pt)),
-   make_let e pt)
-
-let make_fun_clauses loc s l =
-  check_unicity s l;
-  Compat.make_fun loc (List.map make_clause l)
-
-let rec make_args = function
-  | [] -> <:expr< [] >>
-  | GramNonTerminal(loc,t,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      <:expr< [ Genarg.in_gen $make_wit loc t$ $lid:p$ :: $make_args l$ ] >>
-  | _::l -> make_args l
-
-let rec make_eval_tactic e = function
-  | [] -> e
-  | GramNonTerminal(loc,tag,_,Some p)::l when is_tactic_genarg tag ->
-      let p = Names.string_of_id p in
-      let loc = join_loc loc (MLast.loc_of_expr e) in
-      let e = make_eval_tactic e l in
-      <:expr< let $lid:p$ = $lid:p$ in $e$ >>
-  | _::l -> make_eval_tactic e l
-
-let rec make_fun e = function
-  | [] -> e
-  | GramNonTerminal(loc,_,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      <:expr< fun $lid:p$ -> $make_fun e l$ >>
-  | _::l -> make_fun e l
-
-let mlexpr_terminals_of_grammar_tactic_prod_item_expr = function
-  | GramTerminal s -> <:expr< Some $mlexpr_of_string s$ >>
-  | GramNonTerminal (loc,nt,_,sopt) -> <:expr< None >>
-
-let make_prod_item = function
-  | GramTerminal s -> <:expr< Egrammar.GramTerminal $str:s$ >>
-  | GramNonTerminal (loc,nt,g,sopt) ->
-      <:expr< Egrammar.GramNonTerminal $default_loc$ $mlexpr_of_argtype loc nt$
-      $mlexpr_of_prod_entry_key g$ $mlexpr_of_option mlexpr_of_ident sopt$ >>
-
-let mlexpr_of_clause =
-  mlexpr_of_list (fun (a,b) -> mlexpr_of_list make_prod_item a)
-
-let rec make_tags loc = function
-  | [] -> <:expr< [] >>
-  | GramNonTerminal(loc',t,_,Some p)::l ->
-      let l = make_tags loc l in
-      let loc = join_loc loc' loc in
-      let t = mlexpr_of_argtype loc' t in
-      <:expr< [ $t$ :: $l$ ] >>
-  | _::l -> make_tags loc l
-
-let make_one_printing_rule se (pt,e) =
-  let level = mlexpr_of_int 0 in (* only level 0 supported here *)
-  let loc = MLast.loc_of_expr e in
-  let prods = mlexpr_of_list mlexpr_terminals_of_grammar_tactic_prod_item_expr pt in
-  <:expr< ($se$, $make_tags loc pt$, ($level$, $prods$)) >>
-
-let make_printing_rule se = mlexpr_of_list (make_one_printing_rule se)
-
-let rec possibly_empty_subentries loc = function
-  | [] -> []
-  | (s,prodsl) :: l ->
-    let rec aux = function
-    | [] -> (false,<:expr< None >>)
-    | prods :: rest ->
-      try
-        let l = List.map (function
-        | GramNonTerminal(_,(List0ArgType _|
-                             OptArgType _|
-                             ExtraArgType _ as t),_,_)->
-            (* This possibly parses epsilon *)
-            let rawwit = make_rawwit loc t in
-            <:expr< match Genarg.default_empty_value $rawwit$ with
-                    [ None -> failwith ""
-                    | Some v ->
-                        Tacinterp.intern_genarg Tacinterp.fully_empty_glob_sign
-                          (Genarg.in_gen $rawwit$ v) ] >>
-        | GramTerminal _ | GramNonTerminal(_,_,_,_) ->
-            (* This does not parse epsilon (this Exit is static time) *)
-             raise Exit) prods in
-        if has_extraarg prods then
-          (true,<:expr< try Some $mlexpr_of_list (fun x -> x) l$
-                        with [ Failure "" -> $snd (aux rest)$ ] >>)
-        else
-          (true, <:expr< Some $mlexpr_of_list (fun x -> x) l$ >>)
-      with Exit -> aux rest in
-    let (nonempty,v) = aux prodsl in
-    if nonempty then (s,v) :: possibly_empty_subentries loc l
-    else possibly_empty_subentries loc l
-
-let possibly_atomic loc prods =
-  let l = list_map_filter (function
-    | GramTerminal s :: l, _ -> Some (s,l)
-    | _ -> None) prods in
-  possibly_empty_subentries loc (list_factorize_left l)
-
-let declare_tactic loc s cl =
-  let se = mlexpr_of_string s in
-  let pp = make_printing_rule se cl in
-  let gl = mlexpr_of_clause cl in
-  let hide_tac (p,e) =
-    (* reste a definir les fonctions cachees avec des noms frais *)
-    let stac = "h_"^s in
-    let e =
-      make_fun
-        <:expr<
-          Refiner.abstract_extended_tactic $mlexpr_of_string s$ $make_args p$ $make_eval_tactic e p$
-        >>
-      p in
-    <:str_item< value $lid:stac$ = $e$ >>
-  in
-  let hidden = if List.length cl = 1 then List.map hide_tac cl else [] in
-  let atomic_tactics =
-    mlexpr_of_list (mlexpr_of_pair mlexpr_of_string (fun x -> x))
-      (possibly_atomic loc cl) in
-  declare_str_items loc
-   (hidden @
-    [ <:str_item< do {
-      try
-        let _=Tacinterp.add_tactic $se$ $make_fun_clauses loc s cl$ in
-        List.iter
-          (fun (s,l) -> match l with
-           [ Some l ->
-              Tacinterp.add_primitive_tactic s
-              (Tacexpr.TacAtom($default_loc$,
-                 Tacexpr.TacExtend($default_loc$,$se$,l)))
-           | None -> () ])
-          $atomic_tactics$
-      with [ e when Errors.noncritical e ->
-	    Pp.msg_warning
-	      (Stream.iapp
-	        (Pp.str ("Exception in tactic extend " ^ $se$ ^": "))
-	        (Errors.print e)) ];
-      Egrammar.extend_tactic_grammar $se$ $gl$;
-      List.iter Pptactic.declare_extra_tactic_pprule $pp$; } >>
-    ])
-
-open Pcaml
-open PcamlSig
-
-EXTEND
-  GLOBAL: str_item;
-  str_item:
-    [ [ "TACTIC"; "EXTEND"; s = tac_name;
-        OPT "|"; l = LIST1 tacrule SEP "|";
-        "END" ->
-         declare_tactic loc s l ] ]
-  ;
-  tacrule:
-    [ [ "["; l = LIST1 tacargs; "]"; "->"; "["; e = Pcaml.expr; "]"
-        ->
-	  if match List.hd l with GramNonTerminal _ -> true | _ -> false then
-	    (* En attendant la syntaxe de tacticielles *)
-	    failwith "Tactic syntax must start with an identifier";
-	  (l,e)
-    ] ]
-  ;
-  tacargs:
-    [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = interp_entry_name false None e "" in
-        GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
-        let t, g = interp_entry_name false None e sep in
-        GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | s = STRING ->
-	if s = "" then Util.user_err_loc (loc,"",Pp.str "Empty terminal.");
-        GramTerminal s
-    ] ]
-  ;
-  tac_name:
-    [ [ s = LIDENT -> s
-      | s = UIDENT -> s
-    ] ]
-  ;
-  END
-
diff --git a/parsing/tactic_printer.ml b/parsing/tactic_printer.ml
deleted file mode 100644
index 9355a2a5..00000000
--- a/parsing/tactic_printer.ml
+++ /dev/null
@@ -1,172 +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 Sign
-open Evd
-open Tacexpr
-open Proof_type
-open Logic
-open Printer
-
-let pr_tactic = function
-  | TacArg (_,Tacexp t) ->
-      (*top tactic from tacinterp*)
-      Pptactic.pr_glob_tactic (Global.env()) t
-  | t ->
-      Pptactic.pr_tactic (Global.env()) t
-
-let pr_rule = function
-  | Prim r -> hov 0 (pr_prim_rule r)
-  | Nested(cmpd,_) ->
-      begin
-	match cmpd with
-	  | Tactic (texp,_) -> hov 0 (pr_tactic texp)
-      end
-  | Daimon -> str "<Daimon>"
-  | Decl_proof _ -> str "proof"
-
-let uses_default_tac = function
-  | Nested(Tactic(_,dflt),_) -> dflt
-  | _ -> false
-
-(* Does not print change of evars *)
-let pr_rule_dot = function
-  | Prim Change_evars ->str "PC: ch_evars" ++  mt ()
-      (* PC: this might be redundant *)
-  | r ->
-      pr_rule r ++ if uses_default_tac r then str "..." else str"."
-
-let pr_rule_dot_fnl = function
-  | Nested (Tactic (TacAtom (_,(TacMutualFix (true,_,_,_)
-                              | TacMutualCofix (true,_,_))),_),_) ->
-      (* Very big hack to not display hidden tactics in "Theorem with" *)
-      (* (would not scale!) *)
-      mt ()
-   | Prim Change_evars -> mt ()
-   | r -> pr_rule_dot r ++ fnl ()
-
-exception Different
-
-let rec print_proof sigma osign pf =
-  (* spiwack: [osign] is currently ignored, not sure if this function is even used. *)
-  let hyps = Environ.named_context_of_val (Goal.V82.hyps sigma pf.goal) in
-  match pf.ref with
-    | None ->
-	hov 0 (pr_goal {sigma = sigma; it=pf.goal })
-    | Some(r,spfl) ->
-    	hov 0
-	  (hov 0 (pr_goal {sigma = sigma; it=pf.goal }) ++
-	   spc () ++ str" BY " ++
-	   hov 0 (pr_rule r) ++ fnl () ++
-	   str"  " ++
-	   hov 0 (prlist_with_sep pr_fnl (print_proof sigma hyps) spfl))
-
-let pr_change sigma gl =
-  str"change " ++
-  pr_lconstr_env (Goal.V82.env sigma gl) (Goal.V82.concl sigma gl) ++ str"."
-
-let print_decl_script tac_printer ?(nochange=true) sigma pf =
-  let rec print_prf pf =
-  match pf.ref with
-    | None ->
-	(if nochange then
-	   (str"<Your Proof Text here>")
-	 else
-	   pr_change sigma pf.goal)
-	++ fnl ()
-    | Some (Daimon,[]) -> str "(* Some proof has been skipped here *)"
-    | Some (Prim Change_evars,[subpf]) -> print_prf subpf
-    | _ -> anomaly "Not Applicable" in
-  print_prf pf
-
-let print_script ?(nochange=true) sigma pf =
-  let rec print_prf pf =
-  match pf.ref with
-    | None ->
-        (if nochange then
-	   (str"<Your Tactic Text here>")
-	 else
-	   pr_change sigma pf.goal)
-	++ fnl ()
-    | Some(Decl_proof opened,script) ->
-	assert (List.length script = 1);
-	begin
-	  if nochange then (mt ()) else (pr_change sigma pf.goal ++ fnl ())
-	end ++
-	  begin
-	    hov 0 (str "proof." ++ fnl () ++
-		     print_decl_script print_prf
-		     ~nochange sigma (List.hd script))
-	  end ++ fnl () ++
-	  begin
-	    if opened then mt () else (str "end proof." ++ fnl ())
-	  end
-    | Some(Daimon,spfl) ->
-	((if nochange then (mt ()) else (pr_change sigma pf.goal ++ fnl ())) ++
-	   prlist_with_sep pr_fnl print_prf spfl )
-    | Some(rule,spfl) ->
-	((if nochange then (mt ()) else (pr_change sigma pf.goal ++ fnl ())) ++
-	   pr_rule_dot_fnl rule ++
-	   prlist_with_sep pr_fnl print_prf spfl ) in
-  print_prf pf
-
-(* printed by Show Script command *)
-
-let print_treescript ?(nochange=true) sigma pf =
-  let rec print_prf pf =
-    match pf.ref with
-    | None ->
-        if nochange then
-	  str"<Your Proof Text here>"
-	else pr_change sigma pf.goal
-    | Some(Decl_proof opened,script) ->
-	assert (List.length script = 1);
-	begin
-	  if nochange then mt () else pr_change sigma pf.goal ++ fnl ()
-	end ++
-	hov 0
-	  begin str "proof." ++ fnl () ++
-	    print_decl_script print_prf ~nochange sigma (List.hd script)
-	  end ++ fnl () ++
-	begin
-	  if opened then mt () else (str "end proof." ++ fnl ())
-	end
-    | Some(Daimon,spfl) ->
-	(if nochange then mt () else pr_change sigma pf.goal ++ fnl ()) ++
-	prlist_with_sep pr_fnl (print_script ~nochange sigma) spfl
-    | Some(r,spfl) ->
-        let indent = if List.length spfl >= 2 then 1 else 0 in
-        (if nochange then mt () else pr_change sigma pf.goal ++ fnl ()) ++
-        hv indent (pr_rule_dot_fnl r ++ prlist_with_sep fnl print_prf spfl)
-  in hov 0 (print_prf pf)
-
-let rec print_info_script sigma osign pf =
-  let sign = Goal.V82.hyps sigma pf.goal in
-  match pf.ref with
-    | None -> (mt ())
-    | Some(r,spfl) ->
-        (pr_rule r ++
-           match spfl with
-             | [pf1] ->
-                 if pf1.ref = None then
-		   (str "." ++ fnl ())
-                 else
-		   (str";" ++ brk(1,3) ++
-		      print_info_script sigma
-		      (Environ.named_context_of_val sign) pf1)
-             | _ -> (str"." ++ fnl () ++
-                       prlist_with_sep pr_fnl
-                         (print_info_script sigma
-			    (Environ.named_context_of_val sign)) spfl))
-
-let format_print_info_script sigma osign pf =
-  hov 0 (print_info_script sigma osign pf)
-
-
diff --git a/parsing/tactic_printer.mli b/parsing/tactic_printer.mli
deleted file mode 100644
index 2348706f..00000000
--- a/parsing/tactic_printer.mli
+++ /dev/null
@@ -1,23 +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 Sign
-open Evd
-open Tacexpr
-open Proof_type
-
-(** These are the entry points for tactics, proof trees, ... *)
-
-val print_proof : evar_map -> named_context -> proof_tree -> std_ppcmds
-val pr_rule     : rule -> std_ppcmds
-val pr_tactic   : tactic_expr -> std_ppcmds
-val print_script :
-  ?nochange:bool -> evar_map -> proof_tree -> std_ppcmds
-val print_treescript :
-  ?nochange:bool -> evar_map -> proof_tree -> std_ppcmds
diff --git a/parsing/tok.ml b/parsing/tok.ml
index 5b9aed6d..efd57968 100644
--- a/parsing/tok.ml
+++ b/parsing/tok.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        *)
@@ -17,8 +17,22 @@ type t =
   | INT of string
   | STRING of string
   | LEFTQMARK
+  | BULLET of string
   | EOI
 
+let equal t1 t2 = match t1, t2 with
+| KEYWORD s1, KEYWORD s2 -> CString.equal s1 s2
+| METAIDENT s1, METAIDENT s2 -> CString.equal s1 s2
+| PATTERNIDENT s1, PATTERNIDENT s2 -> CString.equal s1 s2
+| IDENT s1, IDENT s2 -> CString.equal s1 s2
+| FIELD s1, FIELD s2 -> CString.equal s1 s2
+| INT s1, INT s2 -> CString.equal s1 s2
+| STRING s1, STRING s2 -> CString.equal s1 s2
+| LEFTQMARK, LEFTQMARK -> true
+| BULLET s1, BULLET s2 -> CString.equal s1 s2
+| EOI, EOI -> true
+| _ -> false
+
 let extract_string = function
   | KEYWORD s -> s
   | IDENT s -> s
@@ -28,6 +42,7 @@ let extract_string = function
   | FIELD s -> s
   | INT s -> s
   | LEFTQMARK -> "?"
+  | BULLET s -> s
   | EOI -> ""
 
 let to_string = function
@@ -39,13 +54,16 @@ let to_string = function
   | INT s -> Format.sprintf "INT %s" s
   | STRING s -> Format.sprintf "STRING %S" s
   | LEFTQMARK -> "LEFTQMARK"
+  | BULLET s -> Format.sprintf "STRING %S" s
   | EOI -> "EOI"
 
 let match_keyword kwd = function
   | KEYWORD kwd' when kwd = kwd' -> true
   | _ -> false
 
-let print ppf tok = Format.fprintf ppf "%s" (to_string tok)
+(* Needed to fix Camlp4 signature.
+ Cannot use Pp because of silly Tox -> Compat -> Pp dependency *)
+let print ppf tok = Format.pp_print_string ppf (to_string tok)
 
 (** For camlp5, conversion from/to [Plexing.pattern],
     and a match function analoguous to [Plexing.default_match] *)
@@ -59,6 +77,7 @@ let of_pattern = function
   | "INT", s -> INT s
   | "STRING", s -> STRING s
   | "LEFTQMARK", _ -> LEFTQMARK
+  | "BULLET", s -> BULLET s
   | "EOI", _ -> EOI
   | _ -> failwith "Tok.of_pattern: not a constructor"
 
@@ -71,6 +90,7 @@ let to_pattern = function
   | INT s -> "INT", s
   | STRING s -> "STRING", s
   | LEFTQMARK -> "LEFTQMARK", ""
+  | BULLET s -> "BULLET", s
   | EOI -> "EOI", ""
 
 let match_pattern =
@@ -84,7 +104,8 @@ let match_pattern =
     | "INT", "" -> (function INT s -> s | _ -> err ())
     | "STRING", "" -> (function STRING s -> s | _ -> err ())
     | "LEFTQMARK", "" -> (function LEFTQMARK -> ""  | _ -> err ())
+    | "BULLET", "" ->  (function BULLET s -> s  | _ -> err ())
     | "EOI", "" -> (function EOI -> "" | _ -> err ())
     | pat ->
 	let tok = of_pattern pat in
-	function tok' -> if tok = tok' then snd pat else err ()
+	function tok' -> if equal tok tok' then snd pat else err ()
diff --git a/parsing/tok.mli b/parsing/tok.mli
index 50a51198..feee1983 100644
--- a/parsing/tok.mli
+++ b/parsing/tok.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        *)
@@ -17,10 +17,12 @@ type t =
   | INT of string
   | STRING of string
   | LEFTQMARK
+  | BULLET of string
   | EOI
 
 val extract_string : t -> string
 val to_string : t -> string
+(* Needed to fit Camlp4 signature *)
 val print : Format.formatter -> t -> unit
 val match_keyword : string -> t -> bool
 (** for camlp5 *)
diff --git a/parsing/vernacextend.ml4 b/parsing/vernacextend.ml4
deleted file mode 100644
index 1df5fbbd..00000000
--- a/parsing/vernacextend.ml4
+++ /dev/null
@@ -1,105 +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        *)
-(************************************************************************)
-
-(*i camlp4deps: "tools/compat5b.cmo" i*)
-
-open Util
-open Genarg
-open Q_util
-open Q_coqast
-open Argextend
-open Tacextend
-open Pcoq
-open Egrammar
-open Compat
-
-let rec make_let e = function
-  | [] -> e
-  | GramNonTerminal(loc,t,_,Some p)::l ->
-      let p = Names.string_of_id p in
-      let loc = join_loc loc (MLast.loc_of_expr e) in
-      let e = make_let e l in
-      <:expr< let $lid:p$ = Genarg.out_gen $make_rawwit loc t$ $lid:p$ in $e$ >>
-  | _::l -> make_let e l
-
-let check_unicity s l =
-  let l' = List.map (fun (_,l,_) -> extract_signature l) l in
-  if not (Util.list_distinct l') then
-    Pp.warning_with !Pp_control.err_ft
-      ("Two distinct rules of entry "^s^" have the same\n"^
-      "non-terminals in the same order: put them in distinct vernac entries")
-
-let make_clause (_,pt,e) =
-  (make_patt pt,
-   vala (Some (make_when (MLast.loc_of_expr e) pt)),
-   make_let e pt)
-
-let make_fun_clauses loc s l =
-  check_unicity s l;
-  Compat.make_fun loc (List.map make_clause l)
-
-let mlexpr_of_clause =
-  mlexpr_of_list
-    (fun (a,b,c) -> mlexpr_of_list make_prod_item 
-       (Option.List.cons (Option.map (fun a -> GramTerminal a) a) b))
-
-let declare_command loc s nt cl =
-  let se = mlexpr_of_string s in
-  let gl = mlexpr_of_clause cl in
-  let funcl = make_fun_clauses loc s cl in
-  declare_str_items loc
-    [ <:str_item< do {
-	try Vernacinterp.vinterp_add $se$ $funcl$
-	with [ e when Errors.noncritical e ->
-	  Pp.msg_warning
-	    (Stream.iapp
-	       (Pp.str ("Exception in vernac extend " ^ $se$ ^": "))
-	       (Errors.print e)) ];
-	Egrammar.extend_vernac_command_grammar $se$ $nt$ $gl$
-      } >> ]
-
-open Pcaml
-open PcamlSig
-
-EXTEND
-  GLOBAL: str_item;
-  str_item:
-    [ [ "VERNAC"; "COMMAND"; "EXTEND"; s = UIDENT;
-        OPT "|"; l = LIST1 rule SEP "|";
-        "END" ->
-         declare_command loc s <:expr<None>> l 
-      | "VERNAC"; nt = LIDENT ; "EXTEND"; s = UIDENT;
-        OPT "|"; l = LIST1 rule SEP "|";
-        "END" ->
-          declare_command loc s <:expr<Some $lid:nt$>> l ] ]
-  ;
-  (* spiwack: comment-by-guessing: it seems that the isolated string (which
-      otherwise could have been another argument) is not passed to the
-      VernacExtend interpreter function to discriminate between the clauses. *)
-  rule:
-    [ [ "["; s = STRING; l = LIST0 args; "]"; "->"; "["; e = Pcaml.expr; "]"
-        ->
-      if s = "" then Util.user_err_loc (loc,"",Pp.str"Command name is empty.");
-      (Some s,l,<:expr< fun () -> $e$ >>)
-      | "[" ; "-" ; l = LIST1 args ; "]" ; "->" ; "[" ; e = Pcaml.expr ; "]" ->
-	  (None,l,<:expr< fun () -> $e$ >>)
-    ] ]
-  ;
-  args:
-    [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = interp_entry_name false None e "" in
-        GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
-        let t, g = interp_entry_name false None e sep in
-        GramNonTerminal (loc, t, g, Some (Names.id_of_string s))
-      | s = STRING ->
-        GramTerminal s
-    ] ]
-  ;
-  END
-;;
author	Enrico Tassi <gareuselesinge@debian.org>	2015-01-25 14:42:51 +0100
committer	Enrico Tassi <gareuselesinge@debian.org>	2015-01-25 14:42:51 +0100
commit	7cfc4e5146be5666419451bdd516f1f3f264d24a (patch)
tree	e4197645da03dc3c7cc84e434cc31d0a0cca7056 /parsing
parent	420f78b2caeaaddc6fe484565b2d0e49c66888e5 (diff)