Imported Upstream version 8.8.2upstream/8.8.2

46 files changed, 1789 insertions, 4238 deletions

diff --git a/library/coqlib.ml b/library/coqlib.ml
new file mode 100644
index 00000000..3f01c617
--- /dev/null
+++ b/library/coqlib.ml
@@ -0,0 +1,381 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open CErrors
+open Util
+open Pp
+open Names
+open Libnames
+open Globnames
+open Nametab
+
+let coq = Libnames.coq_string (* "Coq" *)
+
+(************************************************************************)
+(* Generic functions to find Coq objects *)
+
+type message = string
+
+let make_dir l = DirPath.make (List.rev_map Id.of_string l)
+
+let find_reference locstr dir s =
+  let dp = make_dir dir in
+  let sp = Libnames.make_path dp (Id.of_string s) in
+  try Nametab.global_of_path sp
+  with Not_found ->
+    (* Following bug 5066 we are more permissive with the handling
+       of not found errors here *)
+    user_err ~hdr:locstr
+      Pp.(str "cannot find " ++ Libnames.pr_path sp ++
+          str "; maybe library " ++ DirPath.print dp ++
+          str " has to be required first.")
+
+let coq_reference locstr dir s = find_reference locstr (coq::dir) s
+
+let has_suffix_in_dirs dirs ref =
+  let dir = dirpath (path_of_global ref) in
+  List.exists (fun d -> is_dirpath_prefix_of d dir) dirs
+
+let gen_reference_in_modules locstr dirs s =
+  let dirs = List.map make_dir dirs in
+  let qualid = qualid_of_string s in
+  let all = Nametab.locate_all qualid in
+  let all = List.sort_uniquize RefOrdered_env.compare all in
+  let these = List.filter (has_suffix_in_dirs dirs) all in
+  match these with
+    | [x] -> x
+    | [] ->
+	anomaly ~label:locstr (str "cannot find " ++ str s ++
+	str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++
+        prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
+    | l ->
+      anomaly ~label:locstr
+	(str "ambiguous name " ++ str s ++ str " can represent " ++
+	   prlist_with_sep pr_comma
+	   (fun x -> Libnames.pr_path (Nametab.path_of_global x)) l ++
+	   str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++
+           prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
+
+(* For tactics/commands requiring vernacular libraries *)
+
+let check_required_library d =
+  let dir = make_dir d in
+  if Library.library_is_loaded dir then ()
+  else
+    let in_current_dir = match Lib.current_mp () with
+      | MPfile dp -> DirPath.equal dir dp
+      | _ -> false
+    in
+    if not in_current_dir then
+(* Loading silently ...
+    let m, prefix = List.sep_last d' in
+    read_library
+     (Loc.ghost,make_qualid (DirPath.make (List.rev prefix)) m)
+*)
+(* or failing ...*)
+      user_err ~hdr:"Coqlib.check_required_library"
+        (str "Library " ++ DirPath.print dir ++ str " has to be required first.")
+
+(************************************************************************)
+(* Specific Coq objects *)
+
+let init_reference dir s =
+  let d = coq::"Init"::dir in
+  check_required_library d; find_reference "Coqlib" d s
+
+let logic_reference dir s =
+  let d = coq::"Logic"::dir in
+  check_required_library d; find_reference "Coqlib" d s
+
+let arith_dir = [coq;"Arith"]
+let arith_modules = [arith_dir]
+
+let numbers_dir = [coq;"Numbers"]
+let parith_dir = [coq;"PArith"]
+let narith_dir = [coq;"NArith"]
+let zarith_dir = [coq;"ZArith"]
+
+let zarith_base_modules = [numbers_dir;parith_dir;narith_dir;zarith_dir]
+
+let init_dir = [coq;"Init"]
+let init_modules = [
+  init_dir@["Datatypes"];
+  init_dir@["Logic"];
+  init_dir@["Specif"];
+  init_dir@["Logic_Type"];
+  init_dir@["Nat"];
+  init_dir@["Peano"];
+  init_dir@["Wf"]
+]
+
+let prelude_module_name = init_dir@["Prelude"]
+let prelude_module = make_dir prelude_module_name
+
+let logic_module_name = init_dir@["Logic"]
+let logic_module = make_dir logic_module_name
+
+let logic_type_module_name = init_dir@["Logic_Type"]
+let logic_type_module = make_dir logic_type_module_name
+
+let datatypes_module_name = init_dir@["Datatypes"]
+let datatypes_module = make_dir datatypes_module_name
+
+let jmeq_module_name = [coq;"Logic";"JMeq"]
+let jmeq_module = make_dir jmeq_module_name
+
+(* TODO: temporary hack. Works only if the module isn't an alias *)
+let make_ind dir id = Globnames.encode_mind dir (Id.of_string id)
+let make_con dir id = Globnames.encode_con dir (Id.of_string id)
+
+(** Identity *)
+
+let id = make_con datatypes_module "idProp"
+let type_of_id = make_con datatypes_module "IDProp"
+
+(** Natural numbers *)
+let nat_kn = make_ind datatypes_module "nat"
+let nat_path = Libnames.make_path datatypes_module (Id.of_string "nat")
+
+let glob_nat = IndRef (nat_kn,0)
+
+let path_of_O = ((nat_kn,0),1)
+let path_of_S = ((nat_kn,0),2)
+let glob_O = ConstructRef path_of_O
+let glob_S = ConstructRef path_of_S
+
+(** Booleans *)
+let bool_kn = make_ind datatypes_module "bool"
+
+let glob_bool = IndRef (bool_kn,0)
+
+let path_of_true = ((bool_kn,0),1)
+let path_of_false = ((bool_kn,0),2)
+let glob_true  = ConstructRef path_of_true
+let glob_false  = ConstructRef path_of_false
+
+(** Equality *)
+let eq_kn = make_ind logic_module "eq"
+let glob_eq = IndRef (eq_kn,0)
+
+let identity_kn = make_ind datatypes_module "identity"
+let glob_identity = IndRef (identity_kn,0)
+
+let jmeq_kn = make_ind jmeq_module "JMeq"
+let glob_jmeq = IndRef (jmeq_kn,0)
+
+type coq_sigma_data = {
+  proj1 : global_reference;
+  proj2 : global_reference;
+  elim  : global_reference;
+  intro : global_reference;
+  typ   : global_reference }
+
+type coq_bool_data  = {
+  andb : global_reference;
+  andb_prop : global_reference;
+  andb_true_intro : global_reference}
+
+let build_bool_type () =
+  { andb =  init_reference ["Datatypes"] "andb";
+    andb_prop =  init_reference ["Datatypes"] "andb_prop";
+    andb_true_intro =  init_reference ["Datatypes"] "andb_true_intro" }
+
+let build_sigma_set () = anomaly (Pp.str "Use build_sigma_type.")
+
+let build_sigma_type () =
+  { proj1 = init_reference ["Specif"] "projT1";
+    proj2 = init_reference ["Specif"] "projT2";
+    elim = init_reference ["Specif"] "sigT_rect";
+    intro = init_reference ["Specif"] "existT";
+    typ = init_reference ["Specif"] "sigT" }
+
+let build_sigma () =
+  { proj1 = init_reference ["Specif"] "proj1_sig";
+    proj2 = init_reference ["Specif"] "proj2_sig";
+    elim = init_reference ["Specif"] "sig_rect";
+    intro = init_reference ["Specif"] "exist";
+    typ = init_reference ["Specif"] "sig" }
+
+
+let build_prod () =
+  { proj1 = init_reference ["Datatypes"] "fst";
+    proj2 = init_reference ["Datatypes"] "snd";
+    elim = init_reference ["Datatypes"] "prod_rec";
+    intro = init_reference ["Datatypes"] "pair";
+    typ = init_reference ["Datatypes"] "prod" }
+
+(* Equalities *)
+type coq_eq_data = {
+  eq   : global_reference;
+  ind  : global_reference;
+  refl : global_reference;
+  sym  : global_reference;
+  trans: global_reference;
+  congr: global_reference }
+
+(* Data needed for discriminate and injection *)
+type coq_inversion_data = {
+  inv_eq   : global_reference; (* : forall params, t -> Prop *)
+  inv_ind  : global_reference; (* : forall params P y, eq params y -> P y *)
+  inv_congr: global_reference  (* : forall params B (f:t->B) y, eq params y -> f c=f y *)
+}
+
+let lazy_init_reference dir id = lazy (init_reference dir id)
+let lazy_logic_reference dir id = lazy (logic_reference dir id)
+
+(* Leibniz equality on Type *)
+
+let coq_eq_eq = lazy_init_reference ["Logic"] "eq"
+let coq_eq_refl = lazy_init_reference ["Logic"] "eq_refl"
+let coq_eq_ind = lazy_init_reference ["Logic"] "eq_ind"
+let coq_eq_congr = lazy_init_reference ["Logic"] "f_equal"
+let coq_eq_sym  = lazy_init_reference ["Logic"] "eq_sym"
+let coq_eq_trans  = lazy_init_reference ["Logic"] "eq_trans"
+let coq_f_equal2 = lazy_init_reference ["Logic"] "f_equal2"
+let coq_eq_congr_canonical =
+  lazy_init_reference ["Logic"] "f_equal_canonical_form"
+
+let build_coq_eq_data () =
+  let _ = check_required_library logic_module_name in {
+  eq = Lazy.force coq_eq_eq;
+  ind = Lazy.force coq_eq_ind;
+  refl = Lazy.force coq_eq_refl;
+  sym = Lazy.force coq_eq_sym;
+  trans = Lazy.force coq_eq_trans;
+  congr = Lazy.force coq_eq_congr }
+
+let build_coq_eq () = Lazy.force coq_eq_eq
+let build_coq_eq_refl () = Lazy.force coq_eq_refl
+let build_coq_eq_sym () = Lazy.force coq_eq_sym
+let build_coq_f_equal2 () = Lazy.force coq_f_equal2
+
+let build_coq_inversion_eq_data () =
+  let _ = check_required_library logic_module_name in {
+  inv_eq = Lazy.force coq_eq_eq;
+  inv_ind = Lazy.force coq_eq_ind;
+  inv_congr = Lazy.force coq_eq_congr_canonical }
+
+(* Heterogenous equality on Type *)
+
+let coq_jmeq_eq = lazy_logic_reference ["JMeq"] "JMeq"
+let coq_jmeq_hom = lazy_logic_reference ["JMeq"] "JMeq_hom"
+let coq_jmeq_refl = lazy_logic_reference ["JMeq"] "JMeq_refl"
+let coq_jmeq_ind = lazy_logic_reference ["JMeq"] "JMeq_ind"
+let coq_jmeq_sym  = lazy_logic_reference ["JMeq"] "JMeq_sym"
+let coq_jmeq_congr  = lazy_logic_reference ["JMeq"] "JMeq_congr"
+let coq_jmeq_trans  = lazy_logic_reference ["JMeq"] "JMeq_trans"
+let coq_jmeq_congr_canonical =
+  lazy_logic_reference ["JMeq"] "JMeq_congr_canonical_form"
+
+let build_coq_jmeq_data () =
+  let _ = check_required_library jmeq_module_name in {
+  eq = Lazy.force coq_jmeq_eq;
+  ind = Lazy.force coq_jmeq_ind;
+  refl = Lazy.force coq_jmeq_refl;
+  sym = Lazy.force coq_jmeq_sym;
+  trans = Lazy.force coq_jmeq_trans;
+  congr = Lazy.force coq_jmeq_congr }
+
+let build_coq_inversion_jmeq_data () =
+  let _ = check_required_library logic_module_name in {
+  inv_eq = Lazy.force coq_jmeq_hom;
+  inv_ind = Lazy.force coq_jmeq_ind;
+  inv_congr = Lazy.force coq_jmeq_congr_canonical }
+
+(* Specif *)
+let coq_sumbool  = lazy_init_reference ["Specif"] "sumbool"
+
+let build_coq_sumbool () = Lazy.force coq_sumbool
+
+(* Equality on Type as a Type *)
+let coq_identity_eq = lazy_init_reference ["Datatypes"] "identity"
+let coq_identity_refl = lazy_init_reference ["Datatypes"] "identity_refl"
+let coq_identity_ind = lazy_init_reference ["Datatypes"] "identity_ind"
+let coq_identity_congr = lazy_init_reference ["Logic_Type"] "identity_congr"
+let coq_identity_sym = lazy_init_reference ["Logic_Type"] "identity_sym"
+let coq_identity_trans = lazy_init_reference ["Logic_Type"] "identity_trans"
+let coq_identity_congr_canonical = lazy_init_reference ["Logic_Type"] "identity_congr_canonical_form"
+
+let build_coq_identity_data () =
+  let _ = check_required_library datatypes_module_name in {
+  eq = Lazy.force coq_identity_eq;
+  ind = Lazy.force coq_identity_ind;
+  refl = Lazy.force coq_identity_refl;
+  sym = Lazy.force coq_identity_sym;
+  trans = Lazy.force coq_identity_trans;
+  congr = Lazy.force coq_identity_congr }
+
+let build_coq_inversion_identity_data () =
+  let _ = check_required_library datatypes_module_name in
+  let _ = check_required_library logic_type_module_name in {
+  inv_eq = Lazy.force coq_identity_eq;
+  inv_ind = Lazy.force coq_identity_ind;
+  inv_congr = Lazy.force coq_identity_congr_canonical }
+
+(* Equality to true *)
+let coq_eq_true_eq = lazy_init_reference ["Datatypes"] "eq_true"
+let coq_eq_true_ind = lazy_init_reference ["Datatypes"] "eq_true_ind"
+let coq_eq_true_congr = lazy_init_reference ["Logic"] "eq_true_congr"
+
+let build_coq_inversion_eq_true_data () =
+  let _ = check_required_library datatypes_module_name in
+  let _ = check_required_library logic_module_name in {
+  inv_eq = Lazy.force coq_eq_true_eq;
+  inv_ind = Lazy.force coq_eq_true_ind;
+  inv_congr = Lazy.force coq_eq_true_congr }
+
+(* The False proposition *)
+let coq_False  = lazy_init_reference ["Logic"] "False"
+
+(* The True proposition and its unique proof *)
+let coq_True   = lazy_init_reference ["Logic"] "True"
+let coq_I      = lazy_init_reference ["Logic"] "I"
+
+(* Connectives *)
+let coq_not = lazy_init_reference ["Logic"] "not"
+let coq_and = lazy_init_reference ["Logic"] "and"
+let coq_conj = lazy_init_reference ["Logic"] "conj"
+let coq_or = lazy_init_reference ["Logic"] "or"
+let coq_ex = lazy_init_reference ["Logic"] "ex"
+let coq_iff = lazy_init_reference ["Logic"] "iff"
+
+let coq_iff_left_proj  = lazy_init_reference ["Logic"] "proj1"
+let coq_iff_right_proj = lazy_init_reference ["Logic"] "proj2"
+
+(* Runtime part *)
+let build_coq_True ()  = Lazy.force coq_True
+let build_coq_I ()     = Lazy.force coq_I
+
+let build_coq_False () = Lazy.force coq_False
+let build_coq_not ()   = Lazy.force coq_not
+let build_coq_and ()   = Lazy.force coq_and
+let build_coq_conj ()  = Lazy.force coq_conj
+let build_coq_or ()    = Lazy.force coq_or
+let build_coq_ex ()    = Lazy.force coq_ex
+let build_coq_iff ()   = Lazy.force coq_iff
+
+let build_coq_iff_left_proj ()  = Lazy.force coq_iff_left_proj
+let build_coq_iff_right_proj () = Lazy.force coq_iff_right_proj
+
+
+(* The following is less readable but does not depend on parsing *)
+let coq_eq_ref      = lazy (init_reference ["Logic"] "eq")
+let coq_identity_ref = lazy (init_reference ["Datatypes"] "identity")
+let coq_jmeq_ref     = lazy (find_reference "Coqlib" [coq;"Logic";"JMeq"] "JMeq")
+let coq_eq_true_ref = lazy (find_reference "Coqlib" [coq;"Init";"Datatypes"] "eq_true")
+let coq_existS_ref  = lazy (anomaly (Pp.str "use coq_existT_ref."))
+let coq_existT_ref  = lazy (init_reference ["Specif"] "existT")
+let coq_exist_ref  = lazy (init_reference ["Specif"] "exist")
+let coq_not_ref     = lazy (init_reference ["Logic"] "not")
+let coq_False_ref   = lazy (init_reference ["Logic"] "False")
+let coq_sumbool_ref = lazy (init_reference ["Specif"] "sumbool")
+let coq_sig_ref = lazy (init_reference ["Specif"] "sig")
+let coq_or_ref     = lazy (init_reference ["Logic"] "or")
+let coq_iff_ref    = lazy (init_reference ["Logic"] "iff")
diff --git a/library/coqlib.mli b/library/coqlib.mli
new file mode 100644
index 00000000..8077c47c
--- /dev/null
+++ b/library/coqlib.mli
@@ -0,0 +1,209 @@
+(************************************************************************)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Libnames
+open Globnames
+open Util
+
+(** This module collects the global references, constructions and
+    patterns of the standard library used in ocaml files *)
+
+(** The idea is to migrate to rebindable name-based approach, thus the
+    only function this FILE will provide will be:
+
+    [find_reference : string -> global_reference]
+
+    such that [find_reference "core.eq.type"] returns the proper [global_reference]
+
+    [bind_reference : string -> global_reference -> unit]
+
+    will bind a reference.
+
+    A feature based approach would be possible too.
+
+    Contrary to the old approach of raising an anomaly, we expect
+    tactics to gracefully fail in the absence of some primitive.
+
+    This is work in progress, see below.
+*)
+
+(** {6 ... } *)
+(** [find_reference caller_message [dir;subdir;...] s] returns a global
+   reference to the name dir.subdir.(...).s; the corresponding module
+   must have been required or in the process of being compiled so that
+   it must be used lazily; it raises an anomaly with the given message
+   if not found *)
+
+type message = string
+
+val find_reference : message -> string list -> string -> global_reference
+val coq_reference : message -> string list -> string -> global_reference
+
+(** For tactics/commands requiring vernacular libraries *)
+val check_required_library : string list -> unit
+
+(** Search in several modules (not prefixed by "Coq") *)
+val gen_reference_in_modules : string->string list list-> string -> global_reference
+
+val arith_modules : string list list
+val zarith_base_modules : string list list
+val init_modules : string list list
+
+(** {6 Global references } *)
+
+(** Modules *)
+val prelude_module : DirPath.t
+
+val logic_module : DirPath.t
+val logic_module_name : string list
+
+val logic_type_module : DirPath.t
+
+val jmeq_module : DirPath.t
+val jmeq_module_name : string list
+
+val datatypes_module_name : string list
+
+(** Identity  *)
+val id : Constant.t
+val type_of_id : Constant.t
+
+(** Natural numbers *)
+val nat_path : full_path
+val glob_nat : global_reference
+val path_of_O : constructor
+val path_of_S : constructor
+val glob_O : global_reference
+val glob_S : global_reference
+
+(** Booleans *)
+val glob_bool : global_reference
+val path_of_true : constructor
+val path_of_false : constructor
+val glob_true : global_reference
+val glob_false : global_reference
+
+
+(** Equality *)
+val glob_eq : global_reference
+val glob_identity : global_reference
+val glob_jmeq : global_reference
+
+(** {6 ... } *)
+(** Constructions and patterns related to Coq initial state are unknown
+   at compile time. Therefore, we can only provide methods to build
+   them at runtime. This is the purpose of the [constr delayed] and
+   [constr_pattern delayed] types. Objects of this time needs to be
+   forced with [delayed_force] to get the actual constr or pattern 
+   at runtime. *)
+
+type coq_bool_data = {
+  andb : global_reference;
+  andb_prop : global_reference;
+  andb_true_intro : global_reference}
+val build_bool_type : coq_bool_data delayed
+
+(** {6 For Equality tactics } *)
+type coq_sigma_data = {
+  proj1 : global_reference;
+  proj2 : global_reference;
+  elim  : global_reference;
+  intro : global_reference;
+  typ   : global_reference }
+
+val build_sigma_set : coq_sigma_data delayed
+val build_sigma_type : coq_sigma_data delayed
+val build_sigma : coq_sigma_data delayed
+
+(* val build_sigma_type_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_sigma_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_prod_in : Environ.env -> coq_sigma_data Univ.in_universe_context_set *)
+(* val build_coq_eq_data_in : Environ.env -> coq_eq_data Univ.in_universe_context_set *)
+
+(** Non-dependent pairs in Set from Datatypes *)
+val build_prod : coq_sigma_data delayed
+
+type coq_eq_data = {
+  eq   : global_reference;
+  ind  : global_reference;
+  refl : global_reference;
+  sym  : global_reference;
+  trans: global_reference;
+  congr: global_reference }
+
+val build_coq_eq_data : coq_eq_data delayed
+
+val build_coq_identity_data : coq_eq_data delayed
+val build_coq_jmeq_data : coq_eq_data delayed
+
+val build_coq_eq       : global_reference delayed (** = [(build_coq_eq_data()).eq] *)
+val build_coq_eq_refl  : global_reference delayed (** = [(build_coq_eq_data()).refl] *)
+val build_coq_eq_sym   : global_reference delayed (** = [(build_coq_eq_data()).sym] *)
+val build_coq_f_equal2 : global_reference delayed
+
+(** Data needed for discriminate and injection *)
+
+type coq_inversion_data = {
+  inv_eq   : global_reference; (** : forall params, args -> Prop *)
+  inv_ind  : global_reference; (** : forall params P (H : P params) args, eq params args 
+			 ->  P args *)
+  inv_congr: global_reference  (** : forall params B (f:t->B) args, eq params args -> 
+			 f params = f args *)
+}
+
+val build_coq_inversion_eq_data : coq_inversion_data delayed
+val build_coq_inversion_identity_data : coq_inversion_data delayed
+val build_coq_inversion_jmeq_data : coq_inversion_data delayed
+val build_coq_inversion_eq_true_data : coq_inversion_data delayed
+
+(** Specif *)
+val build_coq_sumbool : global_reference delayed
+
+(** {6 ... } *)
+(** Connectives 
+   The False proposition *)
+val build_coq_False : global_reference delayed
+
+(** The True proposition and its unique proof *)
+val build_coq_True : global_reference delayed
+val build_coq_I : global_reference delayed
+
+(** Negation *)
+val build_coq_not : global_reference delayed
+
+(** Conjunction *)
+val build_coq_and : global_reference delayed
+val build_coq_conj : global_reference delayed
+val build_coq_iff : global_reference delayed
+
+val build_coq_iff_left_proj : global_reference delayed
+val build_coq_iff_right_proj : global_reference delayed
+
+(** Disjunction *)
+val build_coq_or : global_reference delayed
+
+(** Existential quantifier *)
+val build_coq_ex : global_reference delayed
+
+val coq_eq_ref : global_reference lazy_t
+val coq_identity_ref : global_reference lazy_t
+val coq_jmeq_ref : global_reference lazy_t
+val coq_eq_true_ref : global_reference lazy_t
+val coq_existS_ref : global_reference lazy_t
+val coq_existT_ref : global_reference lazy_t
+val coq_exist_ref : global_reference lazy_t
+val coq_not_ref : global_reference lazy_t
+val coq_False_ref : global_reference lazy_t
+val coq_sumbool_ref : global_reference lazy_t
+val coq_sig_ref : global_reference lazy_t
+
+val coq_or_ref : global_reference lazy_t
+val coq_iff_ref : global_reference lazy_t
diff --git a/library/declare.ml b/library/declare.ml
deleted file mode 100644
index c9992fff..00000000
--- a/library/declare.ml
+++ /dev/null
@@ -1,548 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This module is about the low-level declaration of logical objects *)
-
-open Pp
-open CErrors
-open Util
-open Names
-open Libnames
-open Globnames
-open Nameops
-open Term
-open Declarations
-open Entries
-open Libobject
-open Lib
-open Impargs
-open Safe_typing
-open Cooking
-open Decls
-open Decl_kinds
-
-(** flag for internal message display *)
-type internal_flag =
-  | UserAutomaticRequest (* kernel action, a message is displayed *)
-  | InternalTacticRequest  (* kernel action, no message is displayed *)
-  | UserIndividualRequest   (* user action, a message is displayed *)
-
-(** XML output hooks *)
-
-let (f_xml_declare_variable, xml_declare_variable) = Hook.make ~default:ignore ()
-let (f_xml_declare_constant, xml_declare_constant) = Hook.make ~default:ignore ()
-let (f_xml_declare_inductive, xml_declare_inductive) = Hook.make ~default:ignore ()
-
-let if_xml f x = if !Flags.xml_export then f x else ()
-
-(** Declaration of section variables and local definitions *)
-
-type section_variable_entry =
-  | SectionLocalDef of Safe_typing.private_constants definition_entry
-  | SectionLocalAssum of types Univ.in_universe_context_set * polymorphic * bool (** Implicit status *)
-
-type variable_declaration = DirPath.t * section_variable_entry * logical_kind
-
-let cache_variable ((sp,_),o) =
-  match o with
-  | Inl ctx -> Global.push_context_set false ctx
-  | Inr (id,(p,d,mk)) ->
-  (* Constr raisonne sur les noms courts *)
-  if variable_exists id then
-    alreadydeclared (pr_id id ++ str " already exists");
-
-  let impl,opaq,poly,ctx = match d with (* Fails if not well-typed *)
-    | SectionLocalAssum ((ty,ctx),poly,impl) ->
-      let () = Global.push_named_assum ((id,ty,poly),ctx) in
-      let impl = if impl then Implicit else Explicit in
-	impl, true, poly, ctx
-    | SectionLocalDef (de) ->
-      let univs = Global.push_named_def (id,de) in
-      Explicit, de.const_entry_opaque,
-      de.const_entry_polymorphic, univs in
-  Nametab.push (Nametab.Until 1) (restrict_path 0 sp) (VarRef id);
-  add_section_variable id impl poly ctx;
-  Dischargedhypsmap.set_discharged_hyps sp [];
-  add_variable_data id (p,opaq,ctx,poly,mk)
-
-let discharge_variable (_,o) = match o with
-  | Inr (id,_) ->
-    if variable_polymorphic id then None
-    else Some (Inl (variable_context id))
-  | Inl _ -> Some o
-
-type variable_obj =
-    (Univ.ContextSet.t, Id.t * variable_declaration) union
-
-let inVariable : variable_obj -> obj =
-  declare_object { (default_object "VARIABLE") with
-    cache_function = cache_variable;
-    discharge_function = discharge_variable;
-    classify_function = (fun _ -> Dispose) }
-
-(* for initial declaration *)
-let declare_variable id obj =
-  let oname = add_leaf id (inVariable (Inr (id,obj))) in
-  declare_var_implicits id;
-  Notation.declare_ref_arguments_scope (VarRef id);
-  Heads.declare_head (EvalVarRef id);
-  if_xml (Hook.get f_xml_declare_variable) oname;
-  oname
-
-
-(** Declaration of constants and parameters *)
-
-type constant_obj = {
-  cst_decl : global_declaration;
-  cst_hyps : Dischargedhypsmap.discharged_hyps;
-  cst_kind : logical_kind;
-  cst_locl : bool;
-  mutable cst_exported : Safe_typing.exported_private_constant list;
-  (* mutable: to avoid change the libobject API, since cache_function
-   * does not return an updated object *)
-  mutable cst_was_seff : bool
-}
-
-type constant_declaration = Safe_typing.private_constants constant_entry * logical_kind
-
-(* At load-time, the segment starting from the module name to the discharge *)
-(* section (if Remark or Fact) is needed to access a construction *)
-let load_constant i ((sp,kn), obj) =
-  if Nametab.exists_cci sp then
-    alreadydeclared (pr_id (basename sp) ++ str " already exists");
-  let con = Global.constant_of_delta_kn kn in
-  Nametab.push (Nametab.Until i) sp (ConstRef con);
-  add_constant_kind con obj.cst_kind
-
-(* Opening means making the name without its module qualification available *)
-let open_constant i ((sp,kn), obj) =
-  (** Never open a local definition *)
-  if obj.cst_locl then ()
-  else
-    let con = Global.constant_of_delta_kn kn in
-    Nametab.push (Nametab.Exactly i) sp (ConstRef con);
-    match (Global.lookup_constant con).const_body with
-    | (Def _ | Undef _) -> ()
-    | OpaqueDef lc ->
-        match Opaqueproof.get_constraints (Global.opaque_tables ()) lc with
-        | Some f when Future.is_val f ->
-	   Global.push_context_set false (Future.force f)
-        | _ -> ()
-
-let exists_name id =
-  variable_exists id || Global.exists_objlabel (Label.of_id id)
-
-let check_exists sp =
-  let id = basename sp in
-  if exists_name id then alreadydeclared (pr_id id ++ str " already exists")
-
-let cache_constant ((sp,kn), obj) =
-  let id = basename sp in
-  let _,dir,_ = repr_kn kn in
-  let kn' =
-    if obj.cst_was_seff then begin
-      obj.cst_was_seff <- false;  
-      if Global.exists_objlabel (Label.of_id (basename sp))
-      then constant_of_kn kn
-      else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp))
-    end else
-      let () = check_exists sp in
-      let kn', exported = Global.add_constant dir id obj.cst_decl in
-      obj.cst_exported <- exported;
-      kn' in
-  assert (eq_constant kn' (constant_of_kn kn));
-  Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn));
-  let cst = Global.lookup_constant kn' in
-  add_section_constant cst.const_polymorphic kn' cst.const_hyps;
-  Dischargedhypsmap.set_discharged_hyps sp obj.cst_hyps;
-  add_constant_kind (constant_of_kn kn) obj.cst_kind
-
-let discharged_hyps kn sechyps =
-  let (_,dir,_) = repr_kn kn in
-  let args = Array.to_list (instance_from_variable_context sechyps) in
-  List.rev_map (Libnames.make_path dir) args
-
-let discharge_constant ((sp, kn), obj) =
-  let con = constant_of_kn kn in
-  let from = Global.lookup_constant con in
-  let modlist = replacement_context () in
-  let hyps,subst,uctx = section_segment_of_constant con in
-  let new_hyps = (discharged_hyps kn hyps) @ obj.cst_hyps in
-  let abstract = (named_of_variable_context hyps, subst, uctx) in
-  let new_decl = GlobalRecipe{ from; info = { Opaqueproof.modlist; abstract}} in
-  Some { obj with cst_hyps = new_hyps; cst_decl = new_decl; }
-
-(* Hack to reduce the size of .vo: we keep only what load/open needs *)
-let dummy_constant_entry = 
-  ConstantEntry
-    (false, ParameterEntry (None,false,(mkProp,Univ.UContext.empty),None))
-
-let dummy_constant cst = {
-  cst_decl = dummy_constant_entry;
-  cst_hyps = [];
-  cst_kind = cst.cst_kind;
-  cst_locl = cst.cst_locl;
-  cst_exported = [];
-  cst_was_seff = cst.cst_was_seff;
-}
-
-let classify_constant cst = Substitute (dummy_constant cst)
-
-let (inConstant, outConstant : (constant_obj -> obj) * (obj -> constant_obj)) =
-  declare_object_full { (default_object "CONSTANT") with
-    cache_function = cache_constant;
-    load_function = load_constant;
-    open_function = open_constant;
-    classify_function = classify_constant;
-    subst_function = ident_subst_function;
-    discharge_function = discharge_constant }
-
-let declare_scheme = ref (fun _ _ -> assert false)
-let set_declare_scheme f = declare_scheme := f
-
-let declare_constant_common id cst =
-  let update_tables c =
-(*  Printf.eprintf "tables: %s\n%!" (Names.Constant.to_string c); *)
-    declare_constant_implicits c;
-    Heads.declare_head (EvalConstRef c);
-    Notation.declare_ref_arguments_scope (ConstRef c) in
-  let o = inConstant cst in
-  let _, kn as oname = add_leaf id o in
-  List.iter (fun (c,ce,role) ->
-      (* handling of private_constants just exported *)
-      let o = inConstant {
-        cst_decl = ConstantEntry (false, ce);
-        cst_hyps = [] ;
-        cst_kind = IsProof Theorem;
-        cst_locl = false;
-        cst_exported = [];
-        cst_was_seff = true; } in
-      let id = Label.to_id (pi3 (Constant.repr3 c)) in
-      ignore(add_leaf id o);
-      update_tables c;
-      let () = if_xml (Hook.get f_xml_declare_constant) (InternalTacticRequest, c) in
-      match role with
-      | Safe_typing.Subproof -> ()
-      | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|])
-    (outConstant o).cst_exported;
-  pull_to_head oname;
-  let c = Global.constant_of_delta_kn kn in
-  update_tables c;
-  c
-
-let definition_entry ?fix_exn ?(opaque=false) ?(inline=false) ?types
-    ?(poly=false) ?(univs=Univ.UContext.empty) ?(eff=Safe_typing.empty_private_constants) body =
-  { const_entry_body = Future.from_val ?fix_exn ((body,Univ.ContextSet.empty), eff);
-    const_entry_secctx = None;
-    const_entry_type = types;
-    const_entry_polymorphic = poly;
-    const_entry_universes = univs;
-    const_entry_opaque = opaque;
-    const_entry_feedback = None;
-    const_entry_inline_code = inline}
-
-let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(export_seff=false) (cd, kind) =
-  let export = (* We deal with side effects *)
-    match cd with
-    | DefinitionEntry de when
-        export_seff ||
-        not de.const_entry_opaque ||
-        de.const_entry_polymorphic ->
-          let bo = de.const_entry_body in
-          let _, seff = Future.force bo in
-          Safe_typing.empty_private_constants <> seff
-    | _ -> false
-  in
-  let cst = {
-    cst_decl = ConstantEntry (export,cd);
-    cst_hyps = [] ;
-    cst_kind = kind;
-    cst_locl = local;
-    cst_exported = [];
-    cst_was_seff = false;
-  } in
-  let kn = declare_constant_common id cst in
-  let () = if_xml (Hook.get f_xml_declare_constant) (internal, kn) in
-  kn
-
-let declare_definition ?(internal=UserIndividualRequest)
-  ?(opaque=false) ?(kind=Decl_kinds.Definition) ?(local = false)
-  ?(poly=false) id ?types (body,ctx) =
-  let cb =
-    definition_entry ?types ~poly ~univs:(Univ.ContextSet.to_context ctx) ~opaque body
-  in
-    declare_constant ~internal ~local id
-      (Entries.DefinitionEntry cb, Decl_kinds.IsDefinition kind)
-
-(** Declaration of inductive blocks *)
-
-let declare_inductive_argument_scopes kn mie =
-  List.iteri (fun i {mind_entry_consnames=lc} ->
-    Notation.declare_ref_arguments_scope (IndRef (kn,i));
-    for j=1 to List.length lc do
-      Notation.declare_ref_arguments_scope (ConstructRef ((kn,i),j));
-    done) mie.mind_entry_inds
-
-let inductive_names sp kn mie =
-  let (dp,_) = repr_path sp in
-  let kn = Global.mind_of_delta_kn kn in
-  let names, _ =
-    List.fold_left
-      (fun (names, n) ind ->
-	 let ind_p = (kn,n) in
-	 let names, _ =
-	   List.fold_left
-	     (fun (names, p) l ->
-		let sp =
-		  Libnames.make_path dp l
-		in
-		  ((sp, ConstructRef (ind_p,p)) :: names, p+1))
-	     (names, 1) ind.mind_entry_consnames in
-	 let sp = Libnames.make_path dp ind.mind_entry_typename
-	 in
-	   ((sp, IndRef ind_p) :: names, n+1))
-      ([], 0) mie.mind_entry_inds
-  in names
-
-let load_inductive i ((sp,kn),(_,mie)) =
-  let names = inductive_names sp kn mie in
-  List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until i) sp ref ) names
-
-let open_inductive i ((sp,kn),(_,mie)) =
-  let names = inductive_names sp kn mie in
-  List.iter (fun (sp, ref) -> Nametab.push (Nametab.Exactly i) sp ref) names
-
-let cache_inductive ((sp,kn),(dhyps,mie)) =
-  let names = inductive_names sp kn mie in
-  List.iter check_exists (List.map fst names);
-  let id = basename sp in
-  let _,dir,_ = repr_kn kn in
-  let kn' = Global.add_mind dir id mie in
-  assert (eq_mind kn' (mind_of_kn kn));
-  let mind = Global.lookup_mind kn' in
-  add_section_kn mind.mind_polymorphic kn' mind.mind_hyps;
-  Dischargedhypsmap.set_discharged_hyps sp dhyps;
-  List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until 1) sp ref) names
-
-let discharge_inductive ((sp,kn),(dhyps,mie)) =
-  let mind = Global.mind_of_delta_kn kn in
-  let mie = Global.lookup_mind mind in
-  let repl = replacement_context () in
-  let sechyps,usubst,uctx = section_segment_of_mutual_inductive mind in
-  Some (discharged_hyps kn sechyps,
-        Discharge.process_inductive (named_of_variable_context sechyps,uctx) repl mie)
-
-let dummy_one_inductive_entry mie = {
-  mind_entry_typename = mie.mind_entry_typename;
-  mind_entry_arity = mkProp;
-  mind_entry_template = false;
-  mind_entry_consnames = mie.mind_entry_consnames;
-  mind_entry_lc = []
-}
-
-(* Hack to reduce the size of .vo: we keep only what load/open needs *)
-let dummy_inductive_entry (_,m) = ([],{
-  mind_entry_params = [];
-  mind_entry_record = None;
-  mind_entry_finite = Decl_kinds.BiFinite;
-  mind_entry_inds = List.map dummy_one_inductive_entry m.mind_entry_inds;
-  mind_entry_polymorphic = false;
-  mind_entry_universes = Univ.UContext.empty;
-  mind_entry_private = None;
-})
-
-type inductive_obj = Dischargedhypsmap.discharged_hyps * mutual_inductive_entry
-
-let inInductive : inductive_obj -> obj =
-  declare_object {(default_object "INDUCTIVE") with
-    cache_function = cache_inductive;
-    load_function = load_inductive;
-    open_function = open_inductive;
-    classify_function = (fun a -> Substitute (dummy_inductive_entry a));
-    subst_function = ident_subst_function;
-    discharge_function = discharge_inductive }
-
-let declare_projections mind =
-  let spec,_ = Inductive.lookup_mind_specif (Global.env ()) (mind,0) in
-    match spec.mind_record with
-    | Some (Some (_, kns, pjs)) ->
-      Array.iteri (fun i kn ->
-	let id = Label.to_id (Constant.label kn) in
-	let entry = {proj_entry_ind = mind; proj_entry_arg = i} in
-	let kn' = declare_constant id (ProjectionEntry entry,
-				       IsDefinition StructureComponent)
-	in
-	  assert(eq_constant kn kn')) kns; true,true
-    | Some None -> true,false
-    | None -> false,false
-
-(* for initial declaration *)
-let declare_mind mie =
-  let id = match mie.mind_entry_inds with
-    | ind::_ -> ind.mind_entry_typename
-    | [] -> anomaly (Pp.str "cannot declare an empty list of inductives") in
-  let (sp,kn as oname) = add_leaf id (inInductive ([],mie)) in
-  let mind = Global.mind_of_delta_kn kn in
-  let isrecord,isprim = declare_projections mind in
-  declare_mib_implicits mind;
-  declare_inductive_argument_scopes mind mie;
-  if_xml (Hook.get f_xml_declare_inductive) (isrecord,oname);
-  oname, isprim
-
-(* Declaration messages *)
-
-let pr_rank i = pr_nth (i+1)
-
-let fixpoint_message indexes l =
-  Flags.if_verbose Feedback.msg_info (match l with
-  | [] -> anomaly (Pp.str "no recursive definition")
-  | [id] -> pr_id id ++ str " is recursively defined" ++
-      (match indexes with
-	 | Some [|i|] -> str " (decreasing on "++pr_rank i++str " argument)"
-	 | _ -> mt ())
-  | l -> hov 0 (prlist_with_sep pr_comma pr_id l ++
-		  spc () ++ str "are recursively defined" ++
-		  match indexes with
-		    | Some a -> spc () ++ str "(decreasing respectively on " ++
-			prvect_with_sep pr_comma pr_rank a ++
-			str " arguments)"
-		    | None -> mt ()))
-
-let cofixpoint_message l =
-  Flags.if_verbose Feedback.msg_info (match l with
-  | [] -> anomaly (Pp.str "No corecursive definition.")
-  | [id] -> pr_id id ++ str " is corecursively defined"
-  | l -> hov 0 (prlist_with_sep pr_comma pr_id l ++
-                    spc () ++ str "are corecursively defined"))
-
-let recursive_message isfix i l =
-  (if isfix then fixpoint_message i else cofixpoint_message) l
-
-let definition_message id =
-  Flags.if_verbose Feedback.msg_info (pr_id id ++ str " is defined")
-
-let assumption_message id =
-  (* Changing "assumed" to "declared", "assuming" referring more to
-  the type of the object than to the name of the object (see
-  discussion on coqdev: "Chapter 4 of the Reference Manual", 8/10/2015) *)
-  Flags.if_verbose Feedback.msg_info (pr_id id ++ str " is declared")
-
-(** Global universe names, in a different summary *)
-
-type universe_context_decl = polymorphic * Univ.universe_context_set
-
-let cache_universe_context (p, ctx) =
-  Global.push_context_set p ctx;
-  if p then Lib.add_section_context ctx
-
-let input_universe_context : universe_context_decl -> Libobject.obj =
-  declare_object
-    { (default_object "Global universe context state") with
-      cache_function = (fun (na, pi) -> cache_universe_context pi);
-      load_function = (fun _ (_, pi) -> cache_universe_context pi);
-      discharge_function = (fun (_, (p, _ as x)) -> if p then None else Some x);
-      classify_function = (fun a -> Keep a) }
-
-let declare_universe_context poly ctx =
-  Lib.add_anonymous_leaf (input_universe_context (poly, ctx))
-
-(* Discharged or not *)
-type universe_decl = polymorphic * (Id.t * Univ.universe_level) list
-
-let cache_universes (p, l) =
-  let glob = Universes.global_universe_names () in
-  let glob', ctx =
-    List.fold_left (fun ((idl,lid),ctx) (id, lev) ->
-        ((Idmap.add id (p, lev) idl,
-          Univ.LMap.add lev id lid),
-         Univ.ContextSet.add_universe lev ctx))
-      (glob, Univ.ContextSet.empty) l
-  in
-  cache_universe_context (p, ctx);
-  Universes.set_global_universe_names glob'
-
-let input_universes : universe_decl -> Libobject.obj =
-  declare_object
-    { (default_object "Global universe name state") with
-      cache_function = (fun (na, pi) -> cache_universes pi);
-      load_function = (fun _ (_, pi) -> cache_universes pi);
-      discharge_function = (fun (_, (p, _ as x)) -> if p then None else Some x);
-      classify_function = (fun a -> Keep a) }
-
-let do_universe poly l =
-  let in_section = Lib.sections_are_opened () in
-  let () =
-    if poly && not in_section then
-      user_err_loc (Loc.ghost, "Constraint",
-                    str"Cannot declare polymorphic universes outside sections")
-  in
-  let l =
-    List.map (fun (l, id) ->
-	      let lev = Universes.new_univ_level (Global.current_dirpath ()) in
-	      (id, lev)) l
-  in
-    Lib.add_anonymous_leaf (input_universes (poly, l))
-
-type constraint_decl = polymorphic * Univ.constraints
-
-let cache_constraints (na, (p, c)) =
-  let ctx =
-    Univ.ContextSet.add_constraints c
-      Univ.ContextSet.empty (* No declared universes here, just constraints *)
-  in cache_universe_context (p,ctx)
-
-let discharge_constraints (_, (p, c as a)) =
-  if p then None else Some a
-
-let input_constraints : constraint_decl -> Libobject.obj =
-  let open Libobject in
-    declare_object
-    { (default_object "Global universe constraints") with
-      cache_function = cache_constraints;
-      load_function = (fun _ -> cache_constraints);
-      discharge_function = discharge_constraints;
-      classify_function = (fun a -> Keep a) }
-
-let do_constraint poly l =
-  let open Misctypes in
-  let u_of_id x =
-    match x with
-    | GProp -> Loc.dummy_loc, (false, Univ.Level.prop)
-    | GSet -> Loc.dummy_loc, (false, Univ.Level.set)
-    | GType None ->
-       user_err_loc (Loc.dummy_loc, "Constraint",
-                     str "Cannot declare constraints on anonymous universes")
-    | GType (Some (loc, id)) ->
-       let id = Id.of_string id in
-       let names, _ = Universes.global_universe_names () in
-       try loc, Idmap.find id names
-       with Not_found ->
-         user_err_loc (loc, "Constraint", str "Undeclared universe " ++ pr_id id)
-  in
-  let in_section = Lib.sections_are_opened () in
-  let () =
-    if poly && not in_section then
-      user_err_loc (Loc.ghost, "Constraint",
-                    str"Cannot declare polymorphic constraints outside sections")
-  in
-  let check_poly loc p loc' p' =
-    if poly then ()
-    else if p || p' then
-      let loc = if p then loc else loc' in
-      user_err_loc (loc, "Constraint",
-                    str "Cannot declare a global constraint on " ++
-                    str "a polymorphic universe, use "
-                    ++ str "Polymorphic Constraint instead")
-  in
-  let constraints = List.fold_left (fun acc (l, d, r) ->
-     let ploc, (p, lu) = u_of_id l and rloc, (p', ru) = u_of_id r in
-     check_poly ploc p rloc p';
-     Univ.Constraint.add (lu, d, ru) acc)
-    Univ.Constraint.empty l
-  in
-    Lib.add_anonymous_leaf (input_constraints (poly, constraints))
diff --git a/library/declare.mli b/library/declare.mli
deleted file mode 100644
index f70d594d..00000000
--- a/library/declare.mli
+++ /dev/null
@@ -1,97 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Libnames
-open Term
-open Entries
-open Decl_kinds
-
-(** This module provides the official functions to declare new variables,
-   parameters, constants and inductive types. Using the following functions
-   will add the entries in the global environment (module [Global]), will
-   register the declarations in the library (module [Lib]) --- so that the
-   reset works properly --- and will fill some global tables such as
-   [Nametab] and [Impargs]. *)
-
-(** Declaration of local constructions (Variable/Hypothesis/Local) *)
-
-type section_variable_entry =
-  | SectionLocalDef of Safe_typing.private_constants definition_entry
-  | SectionLocalAssum of types Univ.in_universe_context_set * polymorphic * bool (** Implicit status *)
-
-type variable_declaration = DirPath.t * section_variable_entry * logical_kind
-
-val declare_variable : variable -> variable_declaration -> object_name
-
-(** Declaration of global constructions 
-   i.e. Definition/Theorem/Axiom/Parameter/... *)
-
-type constant_declaration = Safe_typing.private_constants constant_entry * logical_kind
-
-type internal_flag =
-  | UserAutomaticRequest
-  | InternalTacticRequest
-  | UserIndividualRequest
-
-(* Defaut definition entries, transparent with no secctx or proj information *)
-val definition_entry : ?fix_exn:Future.fix_exn ->
-  ?opaque:bool -> ?inline:bool -> ?types:types ->
-  ?poly:polymorphic -> ?univs:Univ.universe_context ->
-  ?eff:Safe_typing.private_constants -> constr -> Safe_typing.private_constants definition_entry
-
-(** [declare_constant id cd] declares a global declaration
-   (constant/parameter) with name [id] in the current section; it returns
-   the full path of the declaration
-
-  internal specify if the constant has been created by the kernel or by the
-  user, and in the former case, if its errors should be silent *)
-val declare_constant :
- ?internal:internal_flag -> ?local:bool -> Id.t -> ?export_seff:bool -> constant_declaration -> constant
-
-val declare_definition : 
-  ?internal:internal_flag -> ?opaque:bool -> ?kind:definition_object_kind ->
-  ?local:bool -> ?poly:polymorphic -> Id.t -> ?types:constr -> 
-  constr Univ.in_universe_context_set -> constant
-
-(** Since transparent constants' side effects are globally declared, we
- *  need that *)
-val set_declare_scheme :
-  (string -> (inductive * constant) array -> unit) -> unit
-
-(** [declare_mind me] declares a block of inductive types with
-   their constructors in the current section; it returns the path of
-   the whole block and a boolean indicating if it is a primitive record. *)
-val declare_mind : mutual_inductive_entry -> object_name * bool
-
-(** Hooks for XML output *)
-val xml_declare_variable : (object_name -> unit) Hook.t
-val xml_declare_constant : (internal_flag * constant -> unit) Hook.t
-val xml_declare_inductive : (bool * object_name -> unit) Hook.t
-
-(** Declaration messages *)
-
-val definition_message : Id.t -> unit
-val assumption_message : Id.t -> unit
-val fixpoint_message : int array option -> Id.t list -> unit
-val cofixpoint_message : Id.t list -> unit
-val recursive_message : bool (** true = fixpoint *) ->
-  int array option -> Id.t list -> unit
-
-val exists_name : Id.t -> bool
-
-
-
-(** Global universe contexts, names and constraints *)
-
-val declare_universe_context : polymorphic -> Univ.universe_context_set -> unit
-
-val do_universe : polymorphic -> Id.t Loc.located list -> unit
-val do_constraint : polymorphic ->
-  (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list ->
-  unit
diff --git a/library/declaremods.ml b/library/declaremods.ml
index b2806a1a..762efc5e 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -39,7 +41,7 @@ let inl2intopt = function
 
 type algebraic_objects =
   | Objs of Lib.lib_objects
-  | Ref of module_path * substitution
+  | Ref of ModPath.t * substitution
 
 type substitutive_objects = MBId.t list * algebraic_objects
 
@@ -62,9 +64,9 @@ type substitutive_objects = MBId.t list * algebraic_objects
 
 module ModSubstObjs :
  sig
-   val set : module_path -> substitutive_objects -> unit
-   val get : module_path -> substitutive_objects
-   val set_missing_handler : (module_path -> substitutive_objects) -> unit
+   val set : ModPath.t -> substitutive_objects -> unit
+   val get : ModPath.t -> substitutive_objects
+   val set_missing_handler : (ModPath.t -> substitutive_objects) -> unit
  end =
  struct
    let table =
@@ -126,8 +128,8 @@ type module_objects = object_prefix * Lib.lib_objects * Lib.lib_objects
 
 module ModObjs :
  sig
-   val set : module_path -> module_objects -> unit
-   val get : module_path -> module_objects (* may raise Not_found *)
+   val set : ModPath.t -> module_objects -> unit
+   val get : ModPath.t -> module_objects (* may raise Not_found *)
    val all : unit -> module_objects MPmap.t
  end =
  struct
@@ -143,11 +145,11 @@ module ModObjs :
 (** {6 Name management}
 
     Auxiliary functions to transform full_path and kernel_name given
-    by Lib into module_path and DirPath.t needed for modules
+    by Lib into ModPath.t and DirPath.t needed for modules
 *)
 
 let mp_of_kn kn =
-  let mp,sec,l = repr_kn kn in
+  let mp,sec,l = KerName.repr kn in
   assert (DirPath.is_empty sec);
   MPdot (mp,l)
 
@@ -166,30 +168,30 @@ let consistency_checks exists dir dirinfo =
     let globref =
       try Nametab.locate_dir (qualid_of_dirpath dir)
       with Not_found ->
-        errorlabstrm "consistency_checks"
-          (pr_dirpath dir ++ str " should already exist!")
+        user_err ~hdr:"consistency_checks"
+          (DirPath.print dir ++ str " should already exist!")
     in
     assert (eq_global_dir_reference globref dirinfo)
   else
     if Nametab.exists_dir dir then
-      errorlabstrm "consistency_checks"
-        (pr_dirpath dir ++ str " already exists")
+      user_err ~hdr:"consistency_checks"
+        (DirPath.print dir ++ str " already exists")
 
 let compute_visibility exists i =
   if exists then Nametab.Exactly i else Nametab.Until i
 
 (** Iterate some function [iter_objects] on all components of a module *)
 
-let do_module exists iter_objects i dir mp sobjs kobjs =
-  let prefix = (dir,(mp,DirPath.empty)) in
+let do_module exists iter_objects i obj_dir obj_mp sobjs kobjs =
+  let prefix = { obj_dir ; obj_mp; obj_sec = DirPath.empty } in
   let dirinfo = DirModule prefix in
-  consistency_checks exists dir dirinfo;
-  Nametab.push_dir (compute_visibility exists i) dir dirinfo;
-  ModSubstObjs.set mp sobjs;
+  consistency_checks exists obj_dir dirinfo;
+  Nametab.push_dir (compute_visibility exists i) obj_dir dirinfo;
+  ModSubstObjs.set obj_mp sobjs;
   (* If we're not a functor, let's iter on the internal components *)
   if sobjs_no_functor sobjs then begin
     let objs = expand_sobjs sobjs in
-    ModObjs.set mp (prefix,objs,kobjs);
+    ModObjs.set obj_mp (prefix,objs,kobjs);
     iter_objects (i+1) prefix objs;
     iter_objects (i+1) prefix kobjs
   end
@@ -222,20 +224,20 @@ let cache_keep _ = anomaly (Pp.str "This module should not be cached!")
 
 let load_keep i ((sp,kn),kobjs) =
   (* Invariant : seg isn't empty *)
-  let dir = dir_of_sp sp and mp = mp_of_kn kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = dir_of_sp sp and obj_mp  = mp_of_kn kn in
+  let prefix = { obj_dir ; obj_mp; obj_sec = DirPath.empty } in
   let prefix',sobjs,kobjs0 =
-    try ModObjs.get mp
+    try ModObjs.get obj_mp
     with Not_found -> assert false (* a substobjs should already be loaded *)
   in
   assert (eq_op prefix' prefix);
   assert (List.is_empty kobjs0);
-  ModObjs.set mp (prefix,sobjs,kobjs);
+  ModObjs.set obj_mp (prefix,sobjs,kobjs);
   Lib.load_objects i prefix kobjs
 
 let open_keep i ((sp,kn),kobjs) =
-  let dir = dir_of_sp sp and mp = mp_of_kn kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = dir_of_sp sp and obj_mp = mp_of_kn kn in
+  let prefix = { obj_dir; obj_mp; obj_sec = DirPath.empty } in
   Lib.open_objects i prefix kobjs
 
 let in_modkeep : Lib.lib_objects -> obj =
@@ -252,7 +254,7 @@ let in_modkeep : Lib.lib_objects -> obj =
 
 let do_modtype i sp mp sobjs =
   if Nametab.exists_modtype sp then
-    anomaly (pr_path sp ++ str " already exists");
+    anomaly (pr_path sp ++ str " already exists.");
   Nametab.push_modtype (Nametab.Until i) sp mp;
   ModSubstObjs.set mp sobjs
 
@@ -284,9 +286,9 @@ let (in_modtype : substitutive_objects -> obj),
 (** {6 Declaration of substitutive objects for Include} *)
 
 let do_include do_load do_open i ((sp,kn),aobjs) =
-  let dir = Libnames.dirpath sp in
-  let mp = KerName.modpath kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = Libnames.dirpath sp in
+  let obj_mp = KerName.modpath kn in
+  let prefix = { obj_dir; obj_mp; obj_sec = DirPath.empty } in
   let o = expand_aobjs aobjs in
   if do_load then Lib.load_objects i prefix o;
   if do_open then Lib.open_objects i prefix o
@@ -336,8 +338,8 @@ let () = ModSubstObjs.set_missing_handler handle_missing_substobjs
 
 (** {6 From module expression to substitutive objects} *)
 
-(** Turn a chain of [MSEapply] into the head module_path and the
-    list of module_path parameters (deepest param coming first).
+(** Turn a chain of [MSEapply] into the head ModPath.t and the
+    list of ModPath.t parameters (deepest param coming first).
     The left part of a [MSEapply] must be either [MSEident] or
     another [MSEapply]. *)
 
@@ -345,7 +347,7 @@ let get_applications mexpr =
   let rec get params = function
     | MEident mp -> mp, params
     | MEapply (fexpr, mp) -> get (mp::params) fexpr
-    | MEwith _ -> error "Non-atomic functor application."
+    | MEwith _ -> user_err Pp.(str "Non-atomic functor application.")
   in get [] mexpr
 
 (** Create the substitution corresponding to some functor applications *)
@@ -353,7 +355,7 @@ let get_applications mexpr =
 let rec compute_subst env mbids sign mp_l inl =
   match mbids,mp_l with
     | _,[] -> mbids,empty_subst
-    | [],r -> error "Application of a functor with too few arguments."
+    | [],r -> user_err Pp.(str "Application of a functor with too few arguments.")
     | mbid::mbids,mp::mp_l ->
 	let farg_id, farg_b, fbody_b = Modops.destr_functor sign in
 	let mb = Environ.lookup_module mp env in
@@ -442,23 +444,26 @@ let process_module_binding mbid me =
     Objects in these parameters are also loaded.
     Output is accumulated on top of [acc] (in reverse order). *)
 
-let intern_arg interp_modast acc (idl,(typ,ann)) =
+let intern_arg interp_modast (acc, cst) (idl,(typ,ann)) =
   let inl = inl2intopt ann in
   let lib_dir = Lib.library_dp() in
   let env = Global.env() in
-  let mty,_ = interp_modast env ModType typ in
+  let (mty, _, cst') = interp_modast env ModType typ in
+  let () = Global.push_context_set true cst' in
+  let env = Global.env () in
   let sobjs = get_module_sobjs false env inl mty in
   let mp0 = get_module_path mty in
-  List.fold_left
-    (fun acc (_,id) ->
-      let dir = DirPath.make [id] in
-      let mbid = MBId.make lib_dir id in
-      let mp = MPbound mbid in
-      let resolver = Global.add_module_parameter mbid mty inl in
-      let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
-      do_module false Lib.load_objects 1 dir mp sobjs [];
-      (mbid,mty,inl)::acc)
-    acc idl
+  let fold acc {CAst.v=id} =
+    let dir = DirPath.make [id] in
+    let mbid = MBId.make lib_dir id in
+    let mp = MPbound mbid in
+    let resolver = Global.add_module_parameter mbid mty inl in
+    let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
+    do_module false Lib.load_objects 1 dir mp sobjs [];
+    (mbid,mty,inl)::acc
+  in
+  let acc = List.fold_left fold acc idl in
+  (acc, Univ.ContextSet.union cst cst')
 
 (** Process a list of declarations of functor parameters
     (Id11 .. Id1n : Typ1)..(Idk1 .. Idkm : Typk)
@@ -472,7 +477,7 @@ let intern_arg interp_modast acc (idl,(typ,ann)) =
 *)
 
 let intern_args interp_modast params =
-  List.fold_left (intern_arg interp_modast) [] params
+  List.fold_left (intern_arg interp_modast) ([], Univ.ContextSet.empty) params
 
 
 (** {6 Auxiliary functions concerning subtyping checks} *)
@@ -524,13 +529,17 @@ let mk_funct_type env args seb0 =
 (** Prepare the module type list for check of subtypes *)
 
 let build_subtypes interp_modast env mp args mtys =
-  List.map
-    (fun (m,ann) ->
+  let (cst, ans) = List.fold_left_map
+    (fun cst (m,ann) ->
        let inl = inl2intopt ann in
-       let mte,_ = interp_modast env ModType m in
+       let mte, _, cst' = interp_modast env ModType m in
+       let env = Environ.push_context_set ~strict:true cst' env in
+       let cst = Univ.ContextSet.union cst cst' in
        let mtb = Mod_typing.translate_modtype env mp inl ([],mte) in
-       { mtb with mod_type = mk_funct_type env args mtb.mod_type })
-    mtys
+       cst, { mtb with mod_type = mk_funct_type env args mtb.mod_type })
+    Univ.ContextSet.empty mtys
+  in
+  (ans, cst)
 
 
 (** {6 Current module information}
@@ -557,40 +566,32 @@ let openmodtype_info =
   Summary.ref ([] : module_type_body list) ~name:"MODTYPE-INFO"
 
 
-(** XML output hooks *)
-
-let (f_xml_declare_module, xml_declare_module) = Hook.make ~default:ignore ()
-let (f_xml_start_module, xml_start_module) = Hook.make ~default:ignore ()
-let (f_xml_end_module, xml_end_module) = Hook.make ~default:ignore ()
-let (f_xml_declare_module_type, xml_declare_module_type) = Hook.make ~default:ignore ()
-let (f_xml_start_module_type, xml_start_module_type) = Hook.make ~default:ignore ()
-let (f_xml_end_module_type, xml_end_module_type) = Hook.make ~default:ignore ()
-
-let if_xml f x = if !Flags.xml_export then f x else ()
-
 (** {6 Modules : start, end, declare} *)
 
 module RawModOps = struct
 
 let start_module interp_modast export id args res fs =
   let mp = Global.start_module id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let env = Global.env () in
-  let res_entry_o, subtyps = match res with
+  let res_entry_o, subtyps, cst = match res with
     | Enforce (res,ann) ->
         let inl = inl2intopt ann in
-	let mte,_ = interp_modast env ModType res in
+        let (mte, _, cst) = interp_modast env ModType res in
+        let env = Environ.push_context_set ~strict:true cst env in
         (* We check immediately that mte is well-formed *)
-	let _ = Mod_typing.translate_mse env None inl mte in
-	Some (mte,inl), []
+        let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in
+        let cst = Univ.ContextSet.union cst cst' in
+        Some (mte, inl), [], cst
     | Check resl ->
-	None, build_subtypes interp_modast env mp arg_entries_r resl
+      let typs, cst = build_subtypes interp_modast env mp arg_entries_r resl in
+      None, typs, cst
   in
+  let () = Global.push_context_set true cst in
   openmod_info := { cur_typ = res_entry_o; cur_typs = subtyps };
   let prefix = Lib.start_module export id mp fs in
-  Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModule prefix);
-  Lib.add_frozen_state ();
-  if_xml (Hook.get f_xml_start_module) mp;
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModule prefix);
   mp
 
 let end_module () =
@@ -629,33 +630,39 @@ let end_module () =
   assert (eq_full_path (fst newoname) (fst oldoname));
   assert (ModPath.equal (mp_of_kn (snd newoname)) mp);
 
-  Lib.add_frozen_state () (* to prevent recaching *);
-  if_xml (Hook.get f_xml_end_module) mp;
   mp
 
 let declare_module interp_modast id args res mexpr_o fs =
   (* We simulate the beginning of an interactive module,
      then we adds the module parameters to the global env. *)
   let mp = Global.start_module id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
   let params = mk_params_entry arg_entries_r in
   let env = Global.env () in
-  let mty_entry_o, subs, inl_res = match res with
+  let env = Environ.push_context_set ~strict:true cst env in
+  let mty_entry_o, subs, inl_res, cst' = match res with
     | Enforce (mty,ann) ->
         let inl = inl2intopt ann in
-        let mte, _ = interp_modast env ModType mty in
+        let (mte, _, cst) = interp_modast env ModType mty in
+        let env = Environ.push_context_set ~strict:true cst env in
         (* We check immediately that mte is well-formed *)
-        let _ = Mod_typing.translate_mse env None inl mte in
-        Some mte, [], inl
+        let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in
+        let cst = Univ.ContextSet.union cst cst' in
+        Some mte, [], inl, cst
     | Check mtys ->
-	None, build_subtypes interp_modast env mp arg_entries_r mtys,
-        default_inline ()
+      let typs, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+      None, typs, default_inline (), cst
   in
-  let mexpr_entry_o, inl_expr = match mexpr_o with
-    | None -> None, default_inline ()
+  let env = Environ.push_context_set ~strict:true cst' env in
+  let cst = Univ.ContextSet.union cst cst' in
+  let mexpr_entry_o, inl_expr, cst' = match mexpr_o with
+    | None -> None, default_inline (), Univ.ContextSet.empty
     | Some (mexpr,ann) ->
-      Some (fst (interp_modast env Module mexpr)), inl2intopt ann
+      let (mte, _, cst) = interp_modast env Module mexpr in
+      Some mte, inl2intopt ann, cst
   in
+  let env = Environ.push_context_set ~strict:true cst' env in
+  let cst = Univ.ContextSet.union cst cst' in
   let entry = match mexpr_entry_o, mty_entry_o with
     | None, None -> assert false (* No body, no type ... *)
     | None, Some typ -> MType (params, typ)
@@ -674,6 +681,7 @@ let declare_module interp_modast id args res mexpr_o fs =
   | None -> None
   | _ -> inl_res
   in
+  let () = Global.push_context_set true cst in
   let mp_env,resolver = Global.add_module id entry inl in
 
   (* Name consistency check : kernel vs. library *)
@@ -684,7 +692,6 @@ let declare_module interp_modast id args res mexpr_o fs =
 
   let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
   ignore (Lib.add_leaf id (in_module sobjs));
-  if_xml (Hook.get f_xml_declare_module) mp;
   mp
 
 end
@@ -695,14 +702,14 @@ module RawModTypeOps = struct
 
 let start_modtype interp_modast id args mtys fs =
   let mp = Global.start_modtype id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let env = Global.env () in
-  let sub_mty_l = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let sub_mty_l, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let () = Global.push_context_set true cst in
   openmodtype_info := sub_mty_l;
   let prefix = Lib.start_modtype id mp fs in
-  Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModtype prefix);
-  Lib.add_frozen_state ();
-  if_xml (Hook.get f_xml_start_module_type) mp;
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModtype prefix);
   mp
 
 let end_modtype () =
@@ -719,8 +726,6 @@ let end_modtype () =
   assert (eq_full_path (fst oname) (fst oldoname));
   assert (ModPath.equal (mp_of_kn (snd oname)) mp);
 
-  Lib.add_frozen_state ()(* to prevent recaching *);
-  if_xml (Hook.get f_xml_end_module_type) mp;
   mp
 
 let declare_modtype interp_modast id args mtys (mty,ann) fs =
@@ -728,14 +733,21 @@ let declare_modtype interp_modast id args mtys (mty,ann) fs =
   (* We simulate the beginning of an interactive module,
      then we adds the module parameters to the global env. *)
   let mp = Global.start_modtype id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let params = mk_params_entry arg_entries_r in
   let env = Global.env () in
-  let mte, _ = interp_modast env ModType mty in
+  let mte, _, cst = interp_modast env ModType mty in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   (* We check immediately that mte is well-formed *)
-  let _ = Mod_typing.translate_mse env None inl mte in
+  let _, _, _, cst = Mod_typing.translate_mse env None inl mte in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let entry = params, mte in
-  let sub_mty_l = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let sub_mty_l, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let sobjs = get_functor_sobjs false env inl entry in
   let subst = map_mp (get_module_path (snd entry)) mp empty_delta_resolver in
   let sobjs = subst_sobjs subst sobjs in
@@ -754,7 +766,6 @@ let declare_modtype interp_modast id args mtys (mty,ann) fs =
   check_subtypes_mt mp sub_mty_l;
 
   ignore (Lib.add_leaf id (in_modtype sobjs));
-  if_xml (Hook.get f_xml_declare_module_type) mp;
   mp
 
 end
@@ -777,7 +788,7 @@ let rec decompose_functor mpl typ =
   match mpl, typ with
   | [], _ -> typ
   | _::mpl, MoreFunctor(_,_,str) -> decompose_functor mpl str
-  | _ -> error "Application of a functor with too much arguments."
+  | _ -> user_err Pp.(str "Application of a functor with too much arguments.")
 
 exception NoIncludeSelf
 
@@ -790,7 +801,9 @@ let type_of_incl env is_mod = function
 
 let declare_one_include interp_modast (me_ast,annot) =
   let env = Global.env() in
-  let me,kind = interp_modast env ModAny me_ast in
+  let me, kind, cst = interp_modast env ModAny me_ast in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let is_mod = (kind == Module) in
   let cur_mp = Lib.current_mp () in
   let inl = inl2intopt annot in
@@ -883,7 +896,7 @@ let register_library dir cenv (objs:library_objects) digest univ =
       (* If not, let's do it now ... *)
       let mp' = Global.import cenv univ digest in
       if not (ModPath.equal mp mp') then
-        anomaly (Pp.str "Unexpected disk module name");
+        anomaly (Pp.str "Unexpected disk module name.");
   in
   let sobjs,keepobjs = objs in
   do_module false Lib.load_objects 1 dir mp ([],Objs sobjs) keepobjs
@@ -894,8 +907,7 @@ let get_library_native_symbols dir =
 let start_library dir =
   let mp = Global.start_library dir in
   openmod_info := default_module_info;
-  Lib.start_compilation dir mp;
-  Lib.add_frozen_state ()
+  Lib.start_compilation dir mp
 
 let end_library_hook = ref ignore
 let append_end_library_hook f =
@@ -933,7 +945,7 @@ let subst_import (subst,(export,mp as obj)) =
   let mp' = subst_mp subst mp in
   if mp'==mp then obj else (export,mp')
 
-let in_import : bool * module_path -> obj =
+let in_import : bool * ModPath.t -> obj =
   declare_object {(default_object "IMPORT MODULE") with
     cache_function = cache_import;
     open_function = open_import;
@@ -969,11 +981,10 @@ let iter_all_segments f =
 
 type 'modast module_interpretor =
   Environ.env -> Misctypes.module_kind -> 'modast ->
-    Entries.module_struct_entry * Misctypes.module_kind
+    Entries.module_struct_entry * Misctypes.module_kind * Univ.ContextSet.t
 
 type 'modast module_params =
-  (Id.t Loc.located list * ('modast * inline)) list
-
+  (lident list * ('modast * inline)) list
 
 (** {6 Debug} *)
 
@@ -983,7 +994,7 @@ let debug_print_modtab _ =
     | l -> str "[." ++ int (List.length l) ++ str ".]"
   in
   let pr_modinfo mp (prefix,substobjs,keepobjs) s =
-    s ++ str (string_of_mp mp) ++ (spc ())
+    s ++ str (ModPath.to_string mp) ++ (spc ())
     ++ (pr_seg (Lib.segment_of_objects prefix (substobjs@keepobjs)))
   in
   let modules = MPmap.fold pr_modinfo (ModObjs.all ()) (mt ()) in
diff --git a/library/declaremods.mli b/library/declaremods.mli
index 3917fe8d..fd8d2961 100644
--- a/library/declaremods.mli
+++ b/library/declaremods.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
@@ -13,10 +15,10 @@ open Vernacexpr
 
 type 'modast module_interpretor =
   Environ.env -> Misctypes.module_kind -> 'modast ->
-    Entries.module_struct_entry * Misctypes.module_kind
+    Entries.module_struct_entry * Misctypes.module_kind * Univ.ContextSet.t
 
 type 'modast module_params =
-  (Id.t Loc.located list * ('modast * inline)) list
+  (Misctypes.lident list * ('modast * inline)) list
 
 (** [declare_module interp_modast id fargs typ exprs]
    declares module [id], with structure constructed by [interp_modast]
@@ -30,15 +32,15 @@ val declare_module :
   Id.t ->
   'modast module_params ->
   ('modast * inline) module_signature ->
-  ('modast * inline) list -> module_path
+  ('modast * inline) list -> ModPath.t
 
 val start_module :
   'modast module_interpretor ->
   bool option -> Id.t ->
   'modast module_params ->
-  ('modast * inline) module_signature -> module_path
+  ('modast * inline) module_signature -> ModPath.t
 
-val end_module : unit -> module_path
+val end_module : unit -> ModPath.t
 
 
 
@@ -53,23 +55,15 @@ val declare_modtype :
   'modast module_params ->
   ('modast * inline) list ->
   ('modast * inline) list ->
-  module_path
+  ModPath.t
 
 val start_modtype :
   'modast module_interpretor ->
   Id.t ->
   'modast module_params ->
-  ('modast * inline) list -> module_path
+  ('modast * inline) list -> ModPath.t
 
-val end_modtype : unit -> module_path
-
-(** Hooks for XML output *)
-val xml_declare_module : (module_path -> unit) Hook.t
-val xml_start_module : (module_path -> unit) Hook.t
-val xml_end_module : (module_path -> unit) Hook.t
-val xml_declare_module_type : (module_path -> unit) Hook.t
-val xml_start_module_type : (module_path -> unit) Hook.t
-val xml_end_module_type : (module_path -> unit) Hook.t
+val end_modtype : unit -> ModPath.t
 
 (** {6 Libraries i.e. modules on disk } *)
 
@@ -80,7 +74,7 @@ type library_objects
 val register_library :
   library_name ->
   Safe_typing.compiled_library -> library_objects -> Safe_typing.vodigest ->
-  Univ.universe_context_set -> unit
+  Univ.ContextSet.t -> unit
 
 val get_library_native_symbols : library_name -> Nativecode.symbols
 
@@ -98,13 +92,13 @@ val append_end_library_hook : (unit -> unit) -> unit
    every object of the module. Raises [Not_found] when [mp] is unknown
    or when [mp] corresponds to a functor. *)
 
-val really_import_module : module_path -> unit
+val really_import_module : ModPath.t -> unit
 
 (** [import_module export mp] is a synchronous version of
    [really_import_module]. If [export] is [true], the module is also
    opened every time the module containing it is. *)
 
-val import_module : bool -> module_path -> unit
+val import_module : bool -> ModPath.t -> unit
 
 (** Include  *)
 
@@ -121,7 +115,7 @@ val iter_all_segments :
   (Libnames.object_name -> Libobject.obj -> unit) -> unit
 
 
-val debug_print_modtab : unit -> Pp.std_ppcmds
+val debug_print_modtab : unit -> Pp.t
 
 (** For printing modules, [process_module_binding] adds names of
     bound module (and its components) to Nametab. It also loads
diff --git a/library/decls.ml b/library/decls.ml
index 6e21880f..12c820fb 100644
--- a/library/decls.ml
+++ b/library/decls.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This module registers tables for some non-logical informations
@@ -14,10 +16,12 @@ open Names
 open Decl_kinds
 open Libnames
 
+module NamedDecl = Context.Named.Declaration
+
 (** Datas associated to section variables and local definitions *)
 
 type variable_data =
-  DirPath.t * bool (* opacity *) * Univ.universe_context_set * polymorphic * logical_kind
+  DirPath.t * bool (* opacity *) * Univ.ContextSet.t * polymorphic * logical_kind
 
 let vartab =
   Summary.ref (Id.Map.empty : variable_data Id.Map.t) ~name:"VARIABLE"
@@ -46,20 +50,18 @@ let constant_kind kn = Cmap.find kn !csttab
 
 (** Miscellaneous functions. *)
 
-open Context.Named.Declaration
-
 let initialize_named_context_for_proof () =
   let sign = Global.named_context () in
   List.fold_right
     (fun d signv ->
-      let id = get_id d in
-      let d = if variable_opacity id then LocalAssum (id, get_type d) else d in
+      let id = NamedDecl.get_id d in
+      let d = if variable_opacity id then NamedDecl.LocalAssum (id, NamedDecl.get_type d) else d in
       Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
 
 let last_section_hyps dir =
   Context.Named.fold_outside
     (fun d sec_ids ->
-      let id = get_id d in
+      let id = NamedDecl.get_id d in
       try if DirPath.equal dir (variable_path id) then id::sec_ids else sec_ids
       with Not_found -> sec_ids)
     (Environ.named_context (Global.env()))
diff --git a/library/decls.mli b/library/decls.mli
index 1ca7f894..d9fc2915 100644
--- a/library/decls.mli
+++ b/library/decls.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
@@ -17,21 +19,21 @@ open Decl_kinds
 (** Registration and access to the table of variable *)
 
 type variable_data =
-  DirPath.t * bool (** opacity *) * Univ.universe_context_set * polymorphic * logical_kind
+  DirPath.t * bool (** opacity *) * Univ.ContextSet.t * polymorphic * logical_kind
 
 val add_variable_data : variable -> variable_data -> unit
 val variable_path : variable -> DirPath.t
 val variable_secpath : variable -> qualid
 val variable_kind : variable -> logical_kind
 val variable_opacity : variable -> bool
-val variable_context : variable -> Univ.universe_context_set
+val variable_context : variable -> Univ.ContextSet.t
 val variable_polymorphic : variable -> polymorphic
 val variable_exists : variable -> bool
 
 (** Registration and access to the table of constants *)
 
-val add_constant_kind : constant -> logical_kind -> unit
-val constant_kind : constant -> logical_kind
+val add_constant_kind : Constant.t -> logical_kind -> unit
+val constant_kind : Constant.t -> logical_kind
 
 (* Prepare global named context for proof session: remove proofs of
    opaque section definitions and remove vm-compiled code *)
diff --git a/library/dischargedhypsmap.ml b/library/dischargedhypsmap.ml
index cea1fd7d..abcdb93a 100644
--- a/library/dischargedhypsmap.ml
+++ b/library/dischargedhypsmap.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Libnames
diff --git a/library/dischargedhypsmap.mli b/library/dischargedhypsmap.mli
index ea4a9424..c7067722 100644
--- a/library/dischargedhypsmap.mli
+++ b/library/dischargedhypsmap.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Libnames
diff --git a/library/doc.tex b/library/doc.tex
deleted file mode 100644
index 33af5933..00000000
--- a/library/doc.tex
+++ /dev/null
@@ -1,16 +0,0 @@
-
-\newpage
-\section*{The Coq library}
-
-\ocwsection \label{library}
-This chapter describes the \Coq\ library, which is made of two parts:
-\begin{itemize}
-  \item a general mechanism to keep a trace of all operations and of
-    the state of the system, with backtrack capabilities;
-  \item a global environment for the CCI, with functions to export and 
-    import compiled modules.
-\end{itemize}
-The modules of the library are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=library.dep.ps}\end{center}
diff --git a/library/global.ml b/library/global.ml
index e748434d..dcb20a28 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
@@ -20,6 +22,7 @@ module GlobalSafeEnv : sig
   val set_safe_env : Safe_typing.safe_environment -> unit
   val join_safe_environment : ?except:Future.UUIDSet.t -> unit -> unit
   val is_joined_environment : unit -> bool
+  val global_env_summary_tag : Safe_typing.safe_environment Summary.Dyn.tag
 
 end = struct
 
@@ -30,9 +33,9 @@ let join_safe_environment ?except () =
 
 let is_joined_environment () =
   Safe_typing.is_joined_environment !global_env
-  
-let () =
-  Summary.declare_summary global_env_summary_name
+
+let global_env_summary_tag =
+  Summary.declare_summary_tag global_env_summary_name
     { Summary.freeze_function = (function
         | `Yes -> join_safe_environment (); !global_env
         | `No -> !global_env
@@ -43,7 +46,7 @@ let () =
 let assert_not_parsing () =
   if !Flags.we_are_parsing then
     CErrors.anomaly (
-      Pp.strbrk"The global environment cannot be accessed during parsing")
+      Pp.strbrk"The global environment cannot be accessed during parsing.")
 
 let safe_env () = assert_not_parsing(); !global_env
 
@@ -51,6 +54,8 @@ let set_safe_env e = global_env := e
 
 end
 
+let global_env_summary_tag = GlobalSafeEnv.global_env_summary_tag
+
 let safe_env = GlobalSafeEnv.safe_env
 let join_safe_environment ?except () =
   GlobalSafeEnv.join_safe_environment ?except ()
@@ -78,13 +83,14 @@ let globalize_with_summary fs f =
 let i2l = Label.of_id
 
 let push_named_assum a = globalize0 (Safe_typing.push_named_assum a)
-let push_named_def d = globalize (Safe_typing.push_named_def d)
+let push_named_def d = globalize0 (Safe_typing.push_named_def d)
 let add_constraints c = globalize0 (Safe_typing.add_constraints c)
 let push_context_set b c = globalize0 (Safe_typing.push_context_set b c)
 let push_context b c = globalize0 (Safe_typing.push_context b c)
 
 let set_engagement c = globalize0 (Safe_typing.set_engagement c)
 let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c)
+let export_private_constants ~in_section cd = globalize (Safe_typing.export_private_constants ~in_section cd)
 let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d)
 let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie)
 let add_modtype id me inl = globalize (Safe_typing.add_modtype (i2l id) me inl)
@@ -121,12 +127,22 @@ let lookup_modtype kn = lookup_modtype kn (env())
 let exists_objlabel id = Safe_typing.exists_objlabel id (safe_env ())
 
 let opaque_tables () = Environ.opaque_tables (env ())
-let body_of_constant_body cb = Declareops.body_of_constant (opaque_tables ()) cb
+
+let instantiate cb c =
+  let open Declarations in
+  match cb.const_universes with
+  | Monomorphic_const _ -> c, Univ.AUContext.empty
+  | Polymorphic_const ctx -> c, ctx
+
+let body_of_constant_body cb =
+  let open Declarations in
+  let otab = opaque_tables () in
+  match cb.const_body with
+  | Undef _ -> None
+  | Def c -> Some (instantiate cb (Mod_subst.force_constr c))
+  | OpaqueDef o -> Some (instantiate cb (Opaqueproof.force_proof otab o))
+
 let body_of_constant cst = body_of_constant_body (lookup_constant cst)
-let constraints_of_constant_body cb =
-  Declareops.constraints_of_constant (opaque_tables ()) cb
-let universes_of_constant_body cb =
-  Declareops.universes_of_constant (opaque_tables ()) cb
 
 (** Operations on kernel names *)
 
@@ -162,74 +178,64 @@ open Globnames
 (** Build a fresh instance for a given context, its associated substitution and 
     the instantiated constraints. *)
 
-let type_of_global_unsafe r = 
-  let env = env() in
+let constr_of_global_in_context env r =
+  let open Constr in
   match r with
-  | VarRef id -> Environ.named_type id env
-  | ConstRef c -> 
-     let cb = Environ.lookup_constant c env in 
-     let univs =
-       Declareops.universes_of_polymorphic_constant
-         (Environ.opaque_tables env) cb in
-     let ty = Typeops.type_of_constant_type env cb.Declarations.const_type in
-       Vars.subst_instance_constr (Univ.UContext.instance univs) ty
+  | VarRef id -> mkVar id, Univ.AUContext.empty
+  | ConstRef c ->
+    let cb = Environ.lookup_constant c env in
+    let univs = Declareops.constant_polymorphic_context cb in
+    mkConstU (c, Univ.make_abstract_instance univs), univs
   | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let inst = 
-       if mib.Declarations.mind_polymorphic then 
-	 Univ.UContext.instance mib.Declarations.mind_universes
-       else Univ.Instance.empty
-     in
-       Inductive.type_of_inductive env (specif, inst)
+    let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    mkIndU (ind, Univ.make_abstract_instance univs), univs
   | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let inst = Univ.UContext.instance mib.Declarations.mind_universes in
-       Inductive.type_of_constructor (cstr,inst) specif
+    let (mib,oib as specif) =
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr)
+    in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    mkConstructU (cstr, Univ.make_abstract_instance univs), univs
 
 let type_of_global_in_context env r = 
-  let open Declarations in
   match r with
-  | VarRef id -> Environ.named_type id env, Univ.UContext.empty
+  | VarRef id -> Environ.named_type id env, Univ.AUContext.empty
   | ConstRef c -> 
-     let cb = Environ.lookup_constant c env in 
-     let univs =
-       Declareops.universes_of_polymorphic_constant
-         (Environ.opaque_tables env) cb in
-       Typeops.type_of_constant_type env cb.Declarations.const_type, univs
+    let cb = Environ.lookup_constant c env in 
+    let univs = Declareops.constant_polymorphic_context cb in
+    cb.Declarations.const_type, univs
   | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let univs = 
-       if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes 
-       else Univ.UContext.empty
-     in Inductive.type_of_inductive env (specif, Univ.UContext.instance univs), univs
+    let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    let inst = Univ.make_abstract_instance univs in
+    let env = Environ.push_context ~strict:false (Univ.AUContext.repr univs) env in
+    Inductive.type_of_inductive env (specif, inst), univs
   | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let univs = 
-       if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes 
-       else Univ.UContext.empty
-     in
-     let inst = Univ.UContext.instance univs in
-       Inductive.type_of_constructor (cstr,inst) specif, univs
+    let (mib,oib as specif) =
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr) 
+    in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    let inst = Univ.make_abstract_instance univs in
+    Inductive.type_of_constructor (cstr,inst) specif, univs
 
 let universes_of_global env r = 
-  let open Declarations in
     match r with
-    | VarRef id -> Univ.UContext.empty
+    | VarRef id -> Univ.AUContext.empty
     | ConstRef c -> 
       let cb = Environ.lookup_constant c env in 
-	Declareops.universes_of_polymorphic_constant
-          (Environ.opaque_tables env) cb
+      Declareops.constant_polymorphic_context cb
     | IndRef ind ->
       let (mib, oib) = Inductive.lookup_mind_specif env ind in
-	Univ.instantiate_univ_context mib.mind_universes 
+      Declareops.inductive_polymorphic_context mib
     | ConstructRef cstr ->
-      let (mib,oib) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-	Univ.instantiate_univ_context mib.mind_universes 
+      let (mib,oib) = 
+        Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
+      Declareops.inductive_polymorphic_context mib
 
 let universes_of_global gr = 
   universes_of_global (env ()) gr
 
-let is_polymorphic r = 
+let is_polymorphic r =
   let env = env() in 
   match r with
   | VarRef id -> false
@@ -241,7 +247,7 @@ let is_template_polymorphic r =
   let env = env() in 
   match r with
   | VarRef id -> false
-  | ConstRef c -> Environ.template_polymorphic_constant c env
+  | ConstRef c -> false
   | IndRef ind -> Environ.template_polymorphic_ind ind env
   | ConstructRef cstr -> Environ.template_polymorphic_ind (inductive_of_constructor cstr) env
 
@@ -253,6 +259,9 @@ let is_type_in_type r =
   | IndRef ind -> Environ.type_in_type_ind ind env
   | ConstructRef cstr -> Environ.type_in_type_ind (inductive_of_constructor cstr) env
 
+let current_modpath () =
+  Safe_typing.current_modpath (safe_env ())
+
 let current_dirpath () = 
   Safe_typing.current_dirpath (safe_env ())
 
diff --git a/library/global.mli b/library/global.mli
index 247ca20b..b82039a0 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
@@ -32,41 +34,44 @@ val set_typing_flags : Declarations.typing_flags -> unit
 (** Variables, Local definitions, constants, inductive types *)
 
 val push_named_assum : (Id.t * Constr.types * bool) Univ.in_universe_context_set -> unit
-val push_named_def   : (Id.t * Safe_typing.private_constants Entries.definition_entry) -> Univ.universe_context_set
+val push_named_def   : (Id.t * Entries.section_def_entry) -> unit
+
+val export_private_constants : in_section:bool ->
+  Safe_typing.private_constants Entries.definition_entry ->
+  unit Entries.definition_entry * Safe_typing.exported_private_constant list
 
 val add_constant :
-  DirPath.t -> Id.t -> Safe_typing.global_declaration ->
-    constant * Safe_typing.exported_private_constant list
+  DirPath.t -> Id.t -> Safe_typing.global_declaration -> Constant.t
 val add_mind :
-  DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> mutual_inductive
+  DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> MutInd.t
 
 (** Extra universe constraints *)
-val add_constraints : Univ.constraints -> unit
+val add_constraints : Univ.Constraint.t -> unit
 
-val push_context : bool -> Univ.universe_context -> unit
-val push_context_set : bool -> Univ.universe_context_set -> unit
+val push_context : bool -> Univ.UContext.t -> unit
+val push_context_set : bool -> Univ.ContextSet.t -> unit
 
 (** Non-interactive modules and module types *)
 
 val add_module :
   Id.t -> Entries.module_entry -> Declarations.inline ->
-    module_path * Mod_subst.delta_resolver
+    ModPath.t * Mod_subst.delta_resolver
 val add_modtype :
-  Id.t -> Entries.module_type_entry -> Declarations.inline -> module_path
+  Id.t -> Entries.module_type_entry -> Declarations.inline -> ModPath.t
 val add_include :
   Entries.module_struct_entry -> bool -> Declarations.inline ->
     Mod_subst.delta_resolver
 
 (** Interactive modules and module types *)
 
-val start_module : Id.t -> module_path
-val start_modtype : Id.t -> module_path
+val start_module : Id.t -> ModPath.t
+val start_modtype : Id.t -> ModPath.t
 
 val end_module : Summary.frozen -> Id.t ->
   (Entries.module_struct_entry * Declarations.inline) option ->
-    module_path * MBId.t list * Mod_subst.delta_resolver
+    ModPath.t * MBId.t list * Mod_subst.delta_resolver
 
-val end_modtype : Summary.frozen -> Id.t -> module_path * MBId.t list
+val end_modtype : Summary.frozen -> Id.t -> ModPath.t * MBId.t list
 
 val add_module_parameter :
   MBId.t -> Entries.module_struct_entry -> Declarations.inline ->
@@ -75,35 +80,38 @@ val add_module_parameter :
 (** {6 Queries in the global environment } *)
 
 val lookup_named     : variable -> Context.Named.Declaration.t
-val lookup_constant  : constant -> Declarations.constant_body
+val lookup_constant  : Constant.t -> Declarations.constant_body
 val lookup_inductive : inductive ->
   Declarations.mutual_inductive_body * Declarations.one_inductive_body
 val lookup_pinductive : Constr.pinductive -> 
   Declarations.mutual_inductive_body * Declarations.one_inductive_body
-val lookup_mind      : mutual_inductive -> Declarations.mutual_inductive_body
-val lookup_module    : module_path -> Declarations.module_body
-val lookup_modtype   : module_path -> Declarations.module_type_body
+val lookup_mind      : MutInd.t -> Declarations.mutual_inductive_body
+val lookup_module    : ModPath.t -> Declarations.module_body
+val lookup_modtype   : ModPath.t -> Declarations.module_type_body
 val exists_objlabel  : Label.t -> bool
 
-val constant_of_delta_kn : kernel_name -> constant
-val mind_of_delta_kn : kernel_name -> mutual_inductive
+val constant_of_delta_kn : KerName.t -> Constant.t
+val mind_of_delta_kn : KerName.t -> MutInd.t
 
 val opaque_tables : unit -> Opaqueproof.opaquetab
-val body_of_constant : constant -> Term.constr option
-val body_of_constant_body : Declarations.constant_body -> Term.constr option
-val constraints_of_constant_body :
-  Declarations.constant_body -> Univ.constraints
-val universes_of_constant_body :
-  Declarations.constant_body -> Univ.universe_context
+
+val body_of_constant : Constant.t -> (Constr.constr * Univ.AUContext.t) option
+(** Returns the body of the constant if it has any, and the polymorphic context
+    it lives in. For monomorphic constant, the latter is empty, and for
+    polymorphic constants, the term contains De Bruijn universe variables that
+    need to be instantiated. *)
+
+val body_of_constant_body : Declarations.constant_body -> (Constr.constr * Univ.AUContext.t) option
+(** Same as {!body_of_constant} but on {!Declarations.constant_body}. *)
 
 (** {6 Compiled libraries } *)
 
-val start_library : DirPath.t -> module_path
+val start_library : DirPath.t -> ModPath.t
 val export : ?except:Future.UUIDSet.t -> DirPath.t ->
-  module_path * Safe_typing.compiled_library * Safe_typing.native_library
+  ModPath.t * Safe_typing.compiled_library * Safe_typing.native_library
 val import :
-  Safe_typing.compiled_library -> Univ.universe_context_set -> Safe_typing.vodigest ->
-  module_path
+  Safe_typing.compiled_library -> Univ.ContextSet.t -> Safe_typing.vodigest ->
+  ModPath.t
 
 (** {6 Misc } *)
 
@@ -119,42 +127,40 @@ val is_polymorphic : Globnames.global_reference -> bool
 val is_template_polymorphic : Globnames.global_reference -> bool
 val is_type_in_type : Globnames.global_reference -> bool
 
-val type_of_global_in_context : Environ.env -> 
-  Globnames.global_reference -> Constr.types Univ.in_universe_context
-(** Returns the type of the constant in its global or local universe
+val constr_of_global_in_context : Environ.env ->
+  Globnames.global_reference -> Constr.types * Univ.AUContext.t
+(** Returns the type of the constant in its local universe
     context. The type should not be used without pushing it's universe
     context in the environmnent of usage. For non-universe-polymorphic
     constants, it does not matter. *)
 
-val type_of_global_unsafe : Globnames.global_reference -> Constr.types 
-(** Returns the type of the constant, forgetting its universe context if
-    it is polymorphic, use with care: for polymorphic constants, the
-    type cannot be used to produce a term used by the kernel.  For safe
-    handling of polymorphic global references, one should look at a
-    particular instantiation of the reference, in some particular
-    universe context (part of an [env] or [evar_map]), see
-    e.g. [type_of_constant_in]. If you want to create a fresh instance
-    of the reference and get its type look at [Evd.fresh_global] or
-    [Evarutil.new_global] and [Retyping.get_type_of]. *)
+val type_of_global_in_context : Environ.env -> 
+  Globnames.global_reference -> Constr.types * Univ.AUContext.t
+(** Returns the type of the constant in its local universe
+    context. The type should not be used without pushing it's universe
+    context in the environmnent of usage. For non-universe-polymorphic
+    constants, it does not matter. *)
 
 (** Returns the universe context of the global reference (whatever its polymorphic status is). *)
-val universes_of_global : Globnames.global_reference -> Univ.universe_context
+val universes_of_global : Globnames.global_reference -> Univ.AUContext.t
 
 (** {6 Retroknowledge } *)
 
 val register :
-  Retroknowledge.field -> Term.constr -> Term.constr -> unit
+  Retroknowledge.field -> Constr.constr -> Constr.constr -> unit
 
-val register_inline : constant -> unit
+val register_inline : Constant.t -> unit
 
 (** {6 Oracle } *)
 
-val set_strategy : Names.constant Names.tableKey -> Conv_oracle.level -> unit
+val set_strategy : Constant.t Names.tableKey -> Conv_oracle.level -> unit
 
 (* Modifies the global state, registering new universes *)
 
-val current_dirpath : unit -> Names.dir_path
+val current_modpath : unit -> ModPath.t
+
+val current_dirpath : unit -> DirPath.t
 
-val with_global : (Environ.env -> Names.dir_path -> 'a Univ.in_universe_context_set) -> 'a
+val with_global : (Environ.env -> DirPath.t -> 'a Univ.in_universe_context_set) -> 'a
 
-val global_env_summary_name : string
+val global_env_summary_tag : Safe_typing.safe_environment Summary.Dyn.tag
diff --git a/library/globnames.ml b/library/globnames.ml
index a78f5f13..6c9c813e 100644
--- a/library/globnames.ml
+++ b/library/globnames.ml
@@ -1,21 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open CErrors
 open Names
-open Term
+open Constr
 open Mod_subst
 open Libnames
 
 (*s Global reference is a kernel side type for all references together *)
-type global_reference =
+type global_reference = Names.global_reference =
   | VarRef of variable           (** A reference to the section-context. *)
-  | ConstRef of constant         (** A reference to the environment. *)
+  | ConstRef of Constant.t       (** A reference to the environment. *)
   | IndRef of inductive          (** A reference to an inductive type. *)
   | ConstructRef of constructor  (** A reference to a constructor of an inductive type. *)
 
@@ -26,7 +28,7 @@ let isConstructRef = function ConstructRef _ -> true | _ -> false
 
 let eq_gr gr1 gr2 =
   gr1 == gr2 || match gr1,gr2 with
-    | ConstRef con1, ConstRef con2 -> eq_constant con1 con2
+    | ConstRef con1, ConstRef con2 -> Constant.equal con1 con2
     | IndRef kn1, IndRef kn2 -> eq_ind kn1 kn2
     | ConstructRef kn1, ConstructRef kn2 -> eq_constructor kn1 kn2
     | VarRef v1, VarRef v2 -> Id.equal v1 v2
@@ -67,12 +69,12 @@ let subst_global subst ref = match ref with
 	if c'==c then ref,t else ConstructRef c', t
 
 let canonical_gr = function
-  | ConstRef con -> ConstRef(constant_of_kn(canonical_con con))
-  | IndRef (kn,i) -> IndRef(mind_of_kn(canonical_mind kn),i)
-  | ConstructRef ((kn,i),j )-> ConstructRef((mind_of_kn(canonical_mind kn),i),j)
+  | ConstRef con -> ConstRef(Constant.make1 (Constant.canonical con))
+  | IndRef (kn,i) -> IndRef(MutInd.make1(MutInd.canonical kn),i)
+  | ConstructRef ((kn,i),j )-> ConstructRef((MutInd.make1(MutInd.canonical kn),i),j)
   | VarRef id -> VarRef id
 
-let global_of_constr c = match kind_of_term c with
+let global_of_constr c = match kind c with
   | Const (sp,u) -> ConstRef sp
   | Ind (ind_sp,u) -> IndRef ind_sp
   | Construct (cstr_cp,u) -> ConstructRef cstr_cp
@@ -80,11 +82,11 @@ let global_of_constr c = match kind_of_term c with
   |  _ -> raise Not_found
 
 let is_global c t =
-  match c, kind_of_term t with
-  | ConstRef c, Const (c', _) -> eq_constant c c'
+  match c, kind t with
+  | ConstRef c, Const (c', _) -> Constant.equal c c'
   | IndRef i, Ind (i', _) -> eq_ind i i'
   | ConstructRef i, Construct (i', _) -> eq_constructor i i'
-  | VarRef id, Var id' -> id_eq id id'
+  | VarRef id, Var id' -> Id.equal id id'
   | _ -> false
 
 let printable_constr_of_global = function
@@ -157,7 +159,7 @@ module Refset_env = Refmap_env.Set
 
 (* Extended global references *)
 
-type syndef_name = kernel_name
+type syndef_name = KerName.t
 
 type extended_global_reference =
   | TrueGlobal of global_reference
@@ -180,7 +182,7 @@ module ExtRefOrdered = struct
     if x == y then 0
     else match x, y with
       | TrueGlobal rx, TrueGlobal ry -> RefOrdered_env.compare rx ry
-      | SynDef knx, SynDef kny -> kn_ord knx kny
+      | SynDef knx, SynDef kny -> KerName.compare knx kny
       | TrueGlobal _, SynDef _ -> -1
       | SynDef _, TrueGlobal _ -> 1
 
@@ -215,12 +217,12 @@ let decode_mind kn =
 	  id::(DirPath.repr dp)
     | MPdot(mp,l) -> (Label.to_id l)::(dir_of_mp mp)
   in
-  let mp,sec_dir,l = repr_mind kn in
+  let mp,sec_dir,l = MutInd.repr3 kn in
   check_empty_section sec_dir;
   (DirPath.make (dir_of_mp mp)),Label.to_id l
 
 let decode_con kn =
-  let mp,sec_dir,l = repr_con kn in
+  let mp,sec_dir,l = Constant.repr3 kn in
   check_empty_section sec_dir;
   match mp with
     | MPfile dir -> (dir,Label.to_id l)
@@ -231,15 +233,15 @@ let decode_con kn =
     user and canonical kernel names must be equal. *)
 
 let pop_con con =
-  let (mp,dir,l) = repr_con con in
-  Names.make_con mp (pop_dirpath dir) l
+  let (mp,dir,l) = Constant.repr3 con in
+  Constant.make3 mp (pop_dirpath dir) l
 
 let pop_kn kn =
-  let (mp,dir,l) = repr_mind kn in
-  Names.make_mind mp (pop_dirpath dir) l
+  let (mp,dir,l) = MutInd.repr3 kn in
+  MutInd.make3 mp (pop_dirpath dir) l
 
 let pop_global_reference = function
   | ConstRef con -> ConstRef (pop_con con)
   | IndRef (kn,i) -> IndRef (pop_kn kn,i)
   | ConstructRef ((kn,i),j) -> ConstructRef ((pop_kn kn,i),j)
-  | VarRef id -> anomaly (Pp.str "VarRef not poppable")
+  | VarRef id -> anomaly (Pp.str "VarRef not poppable.")
diff --git a/library/globnames.mli b/library/globnames.mli
index f4956e3d..f2b88b87 100644
--- a/library/globnames.mli
+++ b/library/globnames.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
+open Constr
 open Mod_subst
 
 (** {6 Global reference is a kernel side type for all references together } *)
-type global_reference =
+type global_reference = Names.global_reference =
   | VarRef of variable           (** A reference to the section-context. *)
-  | ConstRef of constant         (** A reference to the environment. *)
+  | ConstRef of Constant.t       (** A reference to the environment. *)
   | IndRef of inductive          (** A reference to an inductive type. *)
   | ConstructRef of constructor  (** A reference to a constructor of an inductive type. *)
 
@@ -27,7 +29,7 @@ val eq_gr : global_reference -> global_reference -> bool
 val canonical_gr : global_reference -> global_reference
 
 val destVarRef : global_reference -> variable
-val destConstRef : global_reference -> constant
+val destConstRef : global_reference -> Constant.t
 val destIndRef : global_reference -> inductive
 val destConstructRef : global_reference -> constructor
 
@@ -47,6 +49,7 @@ val global_of_constr : constr -> global_reference
 
 (** Obsolete synonyms for constr_of_global and global_of_constr *)
 val reference_of_constr : constr -> global_reference
+[@@ocaml.deprecated "Alias of Globnames.global_of_constr"]
 
 module RefOrdered : sig
   type t = global_reference
@@ -72,7 +75,7 @@ module Refmap_env : Map.ExtS
 
 (** {6 Extended global references } *)
 
-type syndef_name = kernel_name
+type syndef_name = KerName.t
 
 type extended_global_reference =
   | TrueGlobal of global_reference
@@ -91,13 +94,13 @@ type global_reference_or_constr =
 
 (** {6 Temporary function to brutally form kernel names from section paths } *)
 
-val encode_mind : DirPath.t -> Id.t -> mutual_inductive
-val decode_mind : mutual_inductive -> DirPath.t * Id.t
-val encode_con : DirPath.t -> Id.t -> constant
-val decode_con : constant -> DirPath.t * Id.t
+val encode_mind : DirPath.t -> Id.t -> MutInd.t
+val decode_mind : MutInd.t -> DirPath.t * Id.t
+val encode_con : DirPath.t -> Id.t -> Constant.t
+val decode_con : Constant.t -> DirPath.t * Id.t
 
 (** {6 Popping one level of section in global names } *)
 
-val pop_con : constant -> constant
-val pop_kn : mutual_inductive-> mutual_inductive
+val pop_con : Constant.t -> Constant.t
+val pop_kn : MutInd.t-> MutInd.t
 val pop_global_reference : global_reference -> global_reference
diff --git a/library/goptions.ml b/library/goptions.ml
index 9dc0f405..eb7bb5b4 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (* This module manages customization parameters at the vernacular level     *)
@@ -24,7 +26,6 @@ type option_value =
 
 (** Summary of an option status *)
 type option_state = {
-  opt_sync  : bool;
   opt_depr  : bool;
   opt_name  : string;
   opt_value : option_value;
@@ -36,7 +37,7 @@ type option_state = {
 let nickname table = String.concat " " table
 
 let error_undeclared_key key =
-  errorlabstrm "Goptions" (str (nickname key) ++ str ": no table or option of this type")
+  user_err ~hdr:"Goptions" (str (nickname key) ++ str ": no table or option of this type")
 
 (****************************************************************************)
 (* 1- Tables                                                                *)
@@ -58,11 +59,10 @@ module MakeTable =
 	  val table : (string * key table_of_A) list ref
 	  val encode : key -> t
 	  val subst : substitution -> t -> t
-          val printer : t -> std_ppcmds
+          val printer : t -> Pp.t
           val key : option_name
           val title : string
-          val member_message : t -> bool -> std_ppcmds
-          val synchronous : bool
+          val member_message : t -> bool -> Pp.t
         end) ->
   struct
     type option_mark =
@@ -73,17 +73,13 @@ module MakeTable =
 
     let _ =
       if String.List.mem_assoc nick !A.table then
-	error "Sorry, this table name is already used."
+	user_err Pp.(str "Sorry, this table name is already used.")
 
     module MySet = Set.Make (struct type t = A.t let compare = A.compare end)
 
-    let t =
-      if A.synchronous
-      then Summary.ref MySet.empty ~name:nick
-      else ref MySet.empty
+    let t = Summary.ref MySet.empty ~name:nick
 
     let (add_option,remove_option) =
-      if A.synchronous then
         let cache_options (_,(f,p)) = match f with
           | GOadd -> t := MySet.add p !t
           | GOrmv -> t := MySet.remove p !t in
@@ -103,9 +99,6 @@ module MakeTable =
 	in
         ((fun c -> Lib.add_anonymous_leaf (inGo (GOadd, c))),
          (fun c -> Lib.add_anonymous_leaf (inGo (GOrmv, c))))
-      else
-        ((fun c -> t := MySet.add c !t),
-         (fun c -> t := MySet.remove c !t))
 
     let print_table table_name printer table =
       Feedback.msg_notice
@@ -140,8 +133,7 @@ module type StringConvertArg =
 sig
   val key : option_name
   val title : string
-  val member_message : string -> bool -> std_ppcmds
-  val synchronous : bool
+  val member_message : string -> bool -> Pp.t
 end
 
 module StringConvert = functor (A : StringConvertArg) ->
@@ -156,7 +148,6 @@ struct
   let key = A.key
   let title = A.title
   let member_message = A.member_message
-  let synchronous = A.synchronous
 end
 
 module MakeStringTable =
@@ -172,11 +163,10 @@ sig
   val compare : t -> t -> int
   val encode : reference -> t
   val subst : substitution -> t -> t
-  val printer : t -> std_ppcmds
+  val printer : t -> Pp.t
   val key : option_name
   val title : string
-  val member_message : t -> bool -> std_ppcmds
-  val synchronous : bool
+  val member_message : t -> bool -> Pp.t
 end
 
 module RefConvert = functor (A : RefConvertArg) ->
@@ -191,7 +181,6 @@ struct
   let key = A.key
   let title = A.title
   let member_message = A.member_message
-  let synchronous = A.synchronous
 end
 
 module MakeRefTable =
@@ -201,14 +190,13 @@ module MakeRefTable =
 (* 2- Flags.                                                              *)
 
 type 'a option_sig = {
-  optsync  : bool;
   optdepr  : bool;
   optname  : string;
   optkey   : option_name;
   optread  : unit -> 'a;
   optwrite : 'a -> unit }
 
-type option_locality = OptLocal | OptDefault | OptGlobal
+type option_locality = OptDefault | OptLocal | OptExport | OptGlobal
 
 type option_mod = OptSet | OptAppend
 
@@ -228,31 +216,24 @@ let get_option key = OptionMap.find key !value_tab
 
 let check_key key = try
   let _ = get_option key in
-  error "Sorry, this option name is already used."
+  user_err Pp.(str "Sorry, this option name is already used.")
 with Not_found ->
   if String.List.mem_assoc (nickname key) !string_table
     || String.List.mem_assoc (nickname key) !ref_table
-  then error "Sorry, this option name is already used."
+  then user_err Pp.(str "Sorry, this option name is already used.")
 
 open Libobject
-open Lib
 
 let warn_deprecated_option =
   CWarnings.create ~name:"deprecated-option" ~category:"deprecated"
          (fun key -> str "Option" ++ spc () ++ str (nickname key) ++
                        strbrk " is deprecated")
 
-let get_locality = function
-  | Some true -> OptLocal
-  | Some false -> OptGlobal
-  | None -> OptDefault
-
 let declare_option cast uncast append ?(preprocess = fun x -> x)
-  { optsync=sync; optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } =
+  { optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } =
   check_key key;
   let default = read() in
   let change =
-    if sync then
       let _ = Summary.declare_summary (nickname key)
         { Summary.freeze_function = (fun _ -> read ());
           Summary.unfreeze_function = write;
@@ -261,33 +242,41 @@ let declare_option cast uncast append ?(preprocess = fun x -> x)
         match m with
         | OptSet -> write v
         | OptAppend -> write (append (read ()) v) in
-      let load_options i o = cache_options o in
+      let load_options i (_, (l, _, _) as o) = match l with
+      | OptGlobal -> cache_options o
+      | OptExport -> ()
+      | OptLocal | OptDefault ->
+        (** Ruled out by classify_function *)
+        assert false
+      in
+      let open_options i  (_, (l, _, _) as o) = match l with
+      | OptExport -> if Int.equal i 1 then cache_options o
+      | OptGlobal -> ()
+      | OptLocal | OptDefault ->
+        (** Ruled out by classify_function *)
+        assert false
+      in
       let subst_options (subst,obj) = obj in
       let discharge_options (_,(l,_,_ as o)) =
-        match l with OptLocal -> None | _ -> Some o in
+        match l with OptLocal -> None | (OptExport | OptGlobal | OptDefault) -> Some o in
       let classify_options (l,_,_ as o) =
-        match l with OptGlobal -> Substitute o | _ -> Dispose in
+        match l with (OptExport | OptGlobal) -> Substitute o | (OptLocal | OptDefault) -> Dispose in
       let options : option_locality * option_mod * _ -> obj =
         declare_object
           { (default_object (nickname key)) with
             load_function = load_options;
+            open_function = open_options;
             cache_function = cache_options;
             subst_function = subst_options;
             discharge_function = discharge_options;
             classify_function = classify_options } in
       (fun l m v -> let v = preprocess v in Lib.add_anonymous_leaf (options (l, m, v)))
-    else
-      (fun _ m v ->
-        let v = preprocess v in
-        match m with
-       | OptSet -> write v
-       | OptAppend -> write (append (read ()) v))
   in
   let warn () = if depr then warn_deprecated_option key in
   let cread () = cast (read ()) in
   let cwrite l v = warn (); change l OptSet (uncast v) in
   let cappend l v = warn (); change l OptAppend (uncast v) in
-  value_tab := OptionMap.add key (name, depr, (sync,cread,cwrite,cappend)) !value_tab;
+  value_tab := OptionMap.add key (name, depr, (cread,cwrite,cappend)) !value_tab;
   write
 
 type 'a write_function = 'a -> unit
@@ -295,23 +284,23 @@ type 'a write_function = 'a -> unit
 let declare_int_option =
   declare_option
     (fun v -> IntValue v)
-    (function IntValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function IntValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 let declare_bool_option =
   declare_option
     (fun v -> BoolValue v)
-    (function BoolValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function BoolValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 let declare_string_option =
   declare_option
     (fun v -> StringValue v)
-    (function StringValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (function StringValue v -> v | _ -> anomaly (Pp.str "async_option."))
     (fun x y -> x^","^y)
 let declare_stringopt_option =
   declare_option
     (fun v -> StringOptValue v)
-    (function StringOptValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function StringOptValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 
 (* 3- User accessible commands *)
 
@@ -322,14 +311,14 @@ let warn_unknown_option =
                    (fun key -> strbrk "There is no option " ++
                                  str (nickname key) ++ str ".")
 
-let set_option_value locality check_and_cast key v =
+let set_option_value ?(locality = OptDefault) check_and_cast key v =
   let opt = try Some (get_option key) with Not_found -> None in
   match opt with
   | None -> warn_unknown_option key
-  | Some (name, depr, (_,read,write,append)) ->
-    write (get_locality locality) (check_and_cast v (read ()))
+  | Some (name, depr, (read,write,append)) ->
+    write locality (check_and_cast v (read ()))
 
-let bad_type_error () = error "Bad type of value for this option."
+let bad_type_error () = user_err Pp.(str "Bad type of value for this option.")
 
 let check_int_value v = function
   | IntValue _ -> IntValue v
@@ -354,25 +343,25 @@ let check_unset_value v = function
    warning. This allows a script to refer to an option that doesn't
    exist anymore *)
 
-let set_int_option_value_gen locality =
-  set_option_value locality check_int_value
-let set_bool_option_value_gen locality key v =
-  set_option_value locality check_bool_value key v
-let set_string_option_value_gen locality =
-  set_option_value locality check_string_value
-let unset_option_value_gen locality key =
-  set_option_value locality check_unset_value key ()
+let set_int_option_value_gen ?locality =
+  set_option_value ?locality check_int_value
+let set_bool_option_value_gen ?locality key v =
+  set_option_value ?locality check_bool_value key v
+let set_string_option_value_gen ?locality =
+  set_option_value ?locality check_string_value
+let unset_option_value_gen ?locality key =
+  set_option_value ?locality check_unset_value key ()
 
-let set_string_option_append_value_gen locality key v =
+let set_string_option_append_value_gen ?(locality = OptDefault) key v =
   let opt = try Some (get_option key) with Not_found -> None in
   match opt with
   | None -> warn_unknown_option key
-  | Some (name, depr, (_,read,write,append)) ->
-    append (get_locality locality) (check_string_value v (read ()))
+  | Some (name, depr, (read,write,append)) ->
+    append locality (check_string_value v (read ()))
 
-let set_int_option_value = set_int_option_value_gen None
-let set_bool_option_value = set_bool_option_value_gen None
-let set_string_option_value = set_string_option_value_gen None
+let set_int_option_value opt v = set_int_option_value_gen opt v
+let set_bool_option_value opt v = set_bool_option_value_gen opt v
+let set_string_option_value opt v = set_string_option_value_gen opt v
 
 (* Printing options/tables *)
 
@@ -382,13 +371,13 @@ let msg_option_value (name,v) =
     | BoolValue false -> str "off"
     | IntValue (Some n) -> int n
     | IntValue None   -> str "undefined"
-    | StringValue s   -> str "\"" ++ str s ++ str "\""
+    | StringValue s   -> quote (str s)
     | StringOptValue None   -> str"undefined"
-    | StringOptValue (Some s)   -> str "\"" ++ str s ++ str "\""
+    | StringOptValue (Some s)   -> quote (str s)
 (*     | IdentValue r    -> pr_global_env Id.Set.empty r *)
 
 let print_option_value key =
-  let (name, depr, (_,read,_,_)) = get_option key in
+  let (name, depr, (read,_,_)) = get_option key in
   let s = read () in
   match s with
     | BoolValue b ->
@@ -398,9 +387,8 @@ let print_option_value key =
 
 let get_tables () =
   let tables = !value_tab in
-  let fold key (name, depr, (sync,read,_,_)) accu =
+  let fold key (name, depr, (read,_,_)) accu =
     let state = {
-      opt_sync = sync;
       opt_name = name;
       opt_depr = depr;
       opt_value = read ();
@@ -415,17 +403,10 @@ let print_tables () =
     if depr then msg ++ str " [DEPRECATED]" ++ fnl ()
     else msg ++ fnl ()
   in
-  str "Synchronous options:" ++ fnl () ++
-    OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_)) p ->
-        if sync then p ++ print_option key name (read ()) depr
-        else p)
-      !value_tab (mt ()) ++
-  str "Asynchronous options:" ++ fnl () ++
+  str "Options:" ++ fnl () ++
     OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_)) p ->
-        if sync then p
-        else p ++ print_option key name (read ()) depr)
+      (fun key (name, depr, (read,_,_)) p ->
+        p ++ print_option key name (read ()) depr)
       !value_tab (mt ()) ++
   str "Tables:" ++ fnl () ++
     List.fold_right
diff --git a/library/goptions.mli b/library/goptions.mli
index 3b3651f3..6c14d19e 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This module manages customization parameters at the vernacular level     *)
@@ -40,15 +42,16 @@
        Unset Tata Tutu Titi.
        Print Table Tata Tutu Titi. (** synonym: Test Table Tata Tutu Titi. *)
 
-   The created table/option may be declared synchronous or not
-   (synchronous = consistent with the resetting commands)                   *)
+   All options are synchronized with the document.
+*)
 
-open Pp
 open Libnames
 open Mod_subst
 
 type option_name = string list
 
+type option_locality = OptDefault | OptLocal | OptExport | OptGlobal
+
 (** {6 Tables. } *)
 
 (** The functor [MakeStringTable] declares a table containing objects
@@ -64,8 +67,7 @@ module MakeStringTable :
     (A : sig
        val key : option_name
        val title : string
-       val member_message : string -> bool -> std_ppcmds
-       val synchronous : bool
+       val member_message : string -> bool -> Pp.t
      end) ->
 sig
   val active : string -> bool
@@ -89,11 +91,10 @@ module MakeRefTable :
            val compare : t -> t -> int
            val encode : reference -> t
 	   val subst : substitution -> t -> t
-           val printer : t -> std_ppcmds
+           val printer : t -> Pp.t
            val key : option_name
            val title : string
-           val member_message : t -> bool -> std_ppcmds
-           val synchronous : bool
+           val member_message : t -> bool -> Pp.t
          end) ->
     sig
       val active : A.t -> bool
@@ -108,8 +109,6 @@ module MakeRefTable :
    used when printing the option value (command "Print Toto Titi." *)
 
 type 'a option_sig = {
-  optsync    : bool;
-  (** whether the option is synchronous w.r.t to the section/module system. *)
   optdepr    : bool;
   (** whether the option is DEPRECATED *)
   optname    : string;
@@ -120,8 +119,6 @@ type 'a option_sig = {
   optwrite   : 'a -> unit
 }
 
-(** When an option is declared synchronous ([optsync] is [true]), the output is
-   a synchronous write function. Otherwise it is [optwrite] *)
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value. *)
 
@@ -155,13 +152,12 @@ val get_ref_table :
       mem : reference -> unit;
       print : unit >
 
-(** The first argument is a locality flag.
-    [Some true] = "Local", [Some false]="Global". *)
-val set_int_option_value_gen    : bool option -> option_name -> int option -> unit
-val set_bool_option_value_gen   : bool option -> option_name -> bool   -> unit
-val set_string_option_value_gen : bool option -> option_name -> string -> unit
-val set_string_option_append_value_gen : bool option -> option_name -> string -> unit
-val unset_option_value_gen : bool option -> option_name -> unit
+(** The first argument is a locality flag. *)
+val set_int_option_value_gen    : ?locality:option_locality -> option_name -> int option -> unit
+val set_bool_option_value_gen   : ?locality:option_locality -> option_name -> bool   -> unit
+val set_string_option_value_gen : ?locality:option_locality -> option_name -> string -> unit
+val set_string_option_append_value_gen : ?locality:option_locality -> option_name -> string -> unit
+val unset_option_value_gen : ?locality:option_locality -> option_name -> unit
 
 val set_int_option_value    : option_name -> int option -> unit
 val set_bool_option_value   : option_name -> bool   -> unit
@@ -177,13 +173,12 @@ type option_value =
 
 (** Summary of an option status *)
 type option_state = {
-  opt_sync  : bool;
   opt_depr  : bool;
   opt_name  : string;
   opt_value : option_value;
 }
 
 val get_tables : unit -> option_state OptionMap.t
-val print_tables : unit -> std_ppcmds
+val print_tables : unit -> Pp.t
 
 val error_undeclared_key : option_name -> 'a
diff --git a/library/heads.ml b/library/heads.ml
index 02465f22..198672a0 100644
--- a/library/heads.ml
+++ b/library/heads.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Mod_subst
 open Environ
@@ -25,7 +27,7 @@ open Context.Named.Declaration
    the evaluation of [phi(0)] and the head of [h] is declared unknown). *)
 
 type rigid_head_kind =
-| RigidParameter of constant (* a Const without body *)
+| RigidParameter of Constant.t (* a Const without body *)
 | RigidVar of variable (* a Var without body *)
 | RigidType (* an inductive, a product or a sort *)
 
@@ -57,7 +59,7 @@ let variable_head id  = Evalrefmap.find (EvalVarRef id) !head_map
 let constant_head cst = Evalrefmap.find (EvalConstRef cst) !head_map
 
 let kind_of_head env t =
-  let rec aux k l t b = match kind_of_term (Reduction.whd_betaiotazeta env t) with
+  let rec aux k l t b = match kind (Reduction.whd_betaiotazeta env t) with
   | Rel n when n > k -> NotImmediatelyComputableHead
   | Rel n -> FlexibleHead (k,k+1-n,List.length l,b)
   | Var id ->
@@ -72,7 +74,8 @@ let kind_of_head env t =
        with Not_found ->
          CErrors.anomaly
            Pp.(str "constant not found in kind_of_head: " ++
-               str (Names.Constant.to_string cst)))
+               Names.Constant.print cst ++
+               str "."))
   | Construct _ | CoFix _ ->
       if b then NotImmediatelyComputableHead else ConstructorHead
   | Sort _ | Ind _ | Prod _ -> RigidHead RigidType
@@ -127,11 +130,11 @@ let compute_head = function
    let is_Def = function Declarations.Def _ -> true | _ -> false in
    let body = 
      if cb.Declarations.const_proj = None && is_Def cb.Declarations.const_body
-     then Declareops.body_of_constant (Environ.opaque_tables env) cb else None 
+     then Global.body_of_constant cst else None
    in
      (match body with
      | None -> RigidHead (RigidParameter cst)
-     | Some c -> kind_of_head env c)
+     | Some (c, _) -> kind_of_head env c)
 | EvalVarRef id ->
     (match Global.lookup_named id with
      | LocalDef (_,c,_) when not (Decls.variable_opacity id) ->
@@ -155,7 +158,7 @@ let cache_head o =
 let subst_head_approximation subst = function
   | RigidHead (RigidParameter cst) as k ->
       let cst,c = subst_con_kn subst cst in
-      if isConst c && eq_constant (fst (destConst c)) cst then
+      if isConst c && Constant.equal (fst (destConst c)) cst then
         (* A change of the prefix of the constant *)
         k
       else
diff --git a/library/heads.mli b/library/heads.mli
index 5acf5f54..42124299 100644
--- a/library/heads.mli
+++ b/library/heads.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 
 (** This module is about the computation of an approximation of the
diff --git a/library/impargs.ml b/library/impargs.ml
deleted file mode 100644
index 828d652c..00000000
--- a/library/impargs.ml
+++ /dev/null
@@ -1,737 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open CErrors
-open Util
-open Names
-open Globnames
-open Nameops
-open Term
-open Reduction
-open Declarations
-open Environ
-open Libobject
-open Lib
-open Pp
-open Constrexpr
-open Termops
-open Namegen
-open Decl_kinds
-
-(*s Flags governing the computation of implicit arguments *)
-
-type implicits_flags = {
-  auto : bool;                     (* automatic or manual only *)
-  strict : bool;                   (* true = strict *)
-  strongly_strict : bool;          (* true = strongly strict *)
-  reversible_pattern : bool;
-  contextual : bool;               (* true = contextual *)
-  maximal : bool
-}
-
-let implicit_args = ref {
-  auto = false;
-  strict = true;
-  strongly_strict = false;
-  reversible_pattern = false;
-  contextual = false;
-  maximal = false;
-}
-
-let make_implicit_args flag =
-  implicit_args := { !implicit_args with auto = flag }
-
-let make_strict_implicit_args flag =
-  implicit_args := { !implicit_args with strict = flag }
-
-let make_strongly_strict_implicit_args flag =
-  implicit_args := { !implicit_args with strongly_strict = flag }
-
-let make_reversible_pattern_implicit_args flag =
-  implicit_args := { !implicit_args with reversible_pattern = flag }
-
-let make_contextual_implicit_args flag =
-  implicit_args := { !implicit_args with contextual = flag }
-
-let make_maximal_implicit_args flag =
-  implicit_args := { !implicit_args with maximal = flag }
-
-let is_implicit_args () = !implicit_args.auto
-let is_strict_implicit_args () = !implicit_args.strict
-let is_strongly_strict_implicit_args () = !implicit_args.strongly_strict
-let is_reversible_pattern_implicit_args () = !implicit_args.reversible_pattern
-let is_contextual_implicit_args () = !implicit_args.contextual
-let is_maximal_implicit_args () = !implicit_args.maximal
-
-let with_implicit_protection f x =
-  let oflags = !implicit_args in
-  try
-    let rslt = f x in
-    implicit_args := oflags;
-    rslt
-  with reraise ->
-    let reraise = CErrors.push reraise in
-    let () = implicit_args := oflags in
-    iraise reraise
-
-let set_maximality imps b =
-  (* Force maximal insertion on ending implicits (compatibility) *)
-  let is_set x = match x with None -> false | _ -> true in
-  b || List.for_all is_set imps
-
-(*s Computation of implicit arguments *)
-
-(* We remember various information about why an argument is
-   inferable as implicit
-
-- [DepRigid] means that the implicit argument can be found by
-  unification along a rigid path (we do not print the arguments of
-  this kind if there is enough arguments to infer them)
-
-- [DepFlex] means that the implicit argument can be found by unification
-  along a collapsable path only (e.g. as x in (P x) where P is another
-  argument) (we do (defensively) print the arguments of this kind)
-
-- [DepFlexAndRigid] means that the least argument from which the
-  implicit argument can be inferred is following a collapsable path
-  but there is a greater argument from where the implicit argument is
-  inferable following a rigid path (useful to know how to print a
-  partial application)
-
-- [Manual] means the argument has been explicitly set as implicit.
-
-  We also consider arguments inferable from the conclusion but it is
-  operational only if [conclusion_matters] is true.
-*)
-
-type argument_position =
-  | Conclusion
-  | Hyp of int
-
-let argument_position_eq p1 p2 = match p1, p2 with
-| Conclusion, Conclusion -> true
-| Hyp h1, Hyp h2 -> Int.equal h1 h2
-| _ -> false
-
-let explicitation_eq ex1 ex2 = match ex1, ex2 with
-| ExplByPos (i1, id1), ExplByPos (i2, id2) ->
-  Int.equal i1 i2 && Option.equal Id.equal id1 id2
-| ExplByName id1, ExplByName id2 ->
-  Id.equal id1 id2
-| _ -> false
-
-type implicit_explanation =
-  | DepRigid of argument_position
-  | DepFlex of argument_position
-  | DepFlexAndRigid of (*flex*) argument_position * (*rig*) argument_position
-  | Manual
-
-let argument_less = function
-  | Hyp n, Hyp n' -> n<n'
-  | Hyp _, Conclusion -> true
-  | Conclusion, _ -> false
-
-let update pos rig (na,st) =
-  let e =
-  if rig then
-    match st with
-      | None -> DepRigid pos
-      | Some (DepRigid n as x) ->
-          if argument_less (pos,n) then DepRigid pos else x
-      | Some (DepFlexAndRigid (fpos,rpos) as x) ->
-          if argument_less (pos,fpos) || argument_position_eq pos fpos then DepRigid pos else
-          if argument_less (pos,rpos) then DepFlexAndRigid (fpos,pos) else x
-      | Some (DepFlex fpos) ->
-          if argument_less (pos,fpos) || argument_position_eq pos fpos then DepRigid pos
-          else DepFlexAndRigid (fpos,pos)
-      | Some Manual -> assert false
-  else
-    match st with
-      | None -> DepFlex pos
-      | Some (DepRigid rpos as x) ->
-          if argument_less (pos,rpos) then DepFlexAndRigid (pos,rpos) else x
-      | Some (DepFlexAndRigid (fpos,rpos) as x) ->
-          if argument_less (pos,fpos) then DepFlexAndRigid (pos,rpos) else x
-      | Some (DepFlex fpos as x) ->
-          if argument_less (pos,fpos) then DepFlex pos else x
-      | Some Manual -> assert false
-  in na, Some e
-
-(* modified is_rigid_reference with a truncated env *)
-let is_flexible_reference env bound depth f =
-  let open Context.Named.Declaration in
-  match kind_of_term f with
-    | Rel n when n >= bound+depth -> (* inductive type *) false
-    | Rel n when n >= depth -> (* previous argument *) true
-    | Rel n -> (* since local definitions have been expanded *) false
-    | Const (kn,_) ->
-        let cb = Environ.lookup_constant kn env in
-	(match cb.const_body with Def _ -> true | _ -> false)
-    | Var id ->
-        Environ.lookup_named id env |> is_local_def
-    | Ind _ | Construct _ -> false
-    |  _ -> true
-
-let push_lift d (e,n) = (push_rel d e,n+1)
-
-let is_reversible_pattern bound depth f l =
-  isRel f && let n = destRel f in (n < bound+depth) && (n >= depth) &&
-  Array.for_all (fun c -> isRel c && destRel c < depth) l &&
-  Array.distinct l
-
-(* Precondition: rels in env are for inductive types only *)
-let add_free_rels_until strict strongly_strict revpat bound env m pos acc =
-  let rec frec rig (env,depth as ed) c =
-    let hd = if strict then whd_all env c else c in
-    let c = if strongly_strict then hd else c in
-    match kind_of_term hd with
-    | Rel n when (n < bound+depth) && (n >= depth) ->
-	let i = bound + depth - n - 1 in
-        acc.(i) <- update pos rig acc.(i)
-    | App (f,l) when revpat && is_reversible_pattern bound depth f l ->
-	let i = bound + depth - destRel f - 1 in
-	acc.(i) <- update pos rig acc.(i)
-    | App (f,_) when rig && is_flexible_reference env bound depth f ->
-	if strict then () else
-          iter_constr_with_full_binders push_lift (frec false) ed c
-    | Proj (p,c) when rig ->
-      if strict then () else
-        iter_constr_with_full_binders push_lift (frec false) ed c	  
-    | Case _ when rig ->
-	if strict then () else
-          iter_constr_with_full_binders push_lift (frec false) ed c
-    | Evar _ -> ()
-    | _ ->
-        iter_constr_with_full_binders push_lift (frec rig) ed c
-  in
-  let () = if not (Vars.noccur_between 1 bound m) then frec true (env,1) m in
-  acc
-
-let rec is_rigid_head t = match kind_of_term t with
-  | Rel _ | Evar _ -> false
-  | Ind _ | Const _ | Var _ | Sort _ -> true
-  | Case (_,_,f,_) -> is_rigid_head f
-  | Proj (p,c) -> true
-  | App (f,args) ->
-      (match kind_of_term f with
-	| Fix ((fi,i),_) -> is_rigid_head (args.(fi.(i)))
-	| _ -> is_rigid_head f)
-  | Lambda _ | LetIn _ | Construct _ | CoFix _ | Fix _
-  | Prod _ | Meta _ | Cast _ -> assert false
-
-(* calcule la liste des arguments implicites *)
-
-let find_displayed_name_in all avoid na (_,b as envnames_b) =
-  let flag = RenamingElsewhereFor envnames_b in
-  if all then compute_and_force_displayed_name_in flag avoid na b
-  else compute_displayed_name_in flag avoid na b
-
-let compute_implicits_gen strict strongly_strict revpat contextual all env t =
-  let rigid = ref true in
-  let open Context.Rel.Declaration in
-  let rec aux env avoid n names t =
-    let t = whd_all env t in
-    match kind_of_term t with
-      | Prod (na,a,b) ->
-	  let na',avoid' = find_displayed_name_in all avoid na (names,b) in
-	  add_free_rels_until strict strongly_strict revpat n env a (Hyp (n+1))
-            (aux (push_rel (LocalAssum (na',a)) env) avoid' (n+1) (na'::names) b)
-      | _ ->
-	  rigid := is_rigid_head t;
-	  let names = List.rev names in
-	  let v = Array.map (fun na -> na,None) (Array.of_list names) in
-	  if contextual then
-	    add_free_rels_until strict strongly_strict revpat n env t Conclusion v
-	  else v
-  in
-  match kind_of_term (whd_all env t) with
-    | Prod (na,a,b) ->
-	let na',avoid = find_displayed_name_in all [] na ([],b) in
-	let v = aux (push_rel (LocalAssum (na',a)) env) avoid 1 [na'] b in
-	!rigid, Array.to_list v
-    | _ -> true, []
-
-let compute_implicits_flags env f all t =
-  compute_implicits_gen
-    (f.strict || f.strongly_strict) f.strongly_strict
-    f.reversible_pattern f.contextual all env t
-
-let compute_auto_implicits env flags enriching t =
-  if enriching then compute_implicits_flags env flags true t
-  else compute_implicits_gen false false false true true env t
-
-let compute_implicits_names env t =
-  let _, impls = compute_implicits_gen false false false false true env t in
-  List.map fst impls
-
-(* Extra information about implicit arguments *)
-
-type maximal_insertion = bool (* true = maximal contextual insertion *)
-type force_inference = bool (* true = always infer, never turn into evar/subgoal *)
-
-type implicit_status =
-    (* None = Not implicit *)
-    (Id.t * implicit_explanation * (maximal_insertion * force_inference)) option
-
-type implicit_side_condition = DefaultImpArgs | LessArgsThan of int
-
-type implicits_list = implicit_side_condition * implicit_status list
-
-let is_status_implicit = function
-  | None -> false
-  | _ -> true
-
-let name_of_implicit = function
-  | None -> anomaly (Pp.str "Not an implicit argument")
-  | Some (id,_,_) -> id
-
-let maximal_insertion_of = function
-  | Some (_,_,(b,_)) -> b
-  | None -> anomaly (Pp.str "Not an implicit argument")
-
-let force_inference_of = function
-  | Some (_, _, (_, b)) -> b
-  | None -> anomaly (Pp.str "Not an implicit argument")
-
-(* [in_ctx] means we know the expected type, [n] is the index of the argument *)
-let is_inferable_implicit in_ctx n = function
-  | None -> false
-  | Some (_,DepRigid (Hyp p),_) -> in_ctx || n >= p
-  | Some (_,DepFlex (Hyp p),_) -> false
-  | Some (_,DepFlexAndRigid (_,Hyp q),_) -> in_ctx || n >= q
-  | Some (_,DepRigid Conclusion,_) -> in_ctx
-  | Some (_,DepFlex Conclusion,_) -> false
-  | Some (_,DepFlexAndRigid (_,Conclusion),_) -> in_ctx
-  | Some (_,Manual,_) -> true
-
-let positions_of_implicits (_,impls) =
-  let rec aux n = function
-      [] -> []
-    | Some _ :: l -> n :: aux (n+1) l
-    | None :: l -> aux (n+1) l
-  in aux 1 impls
-
-(* Manage user-given implicit arguments *)
-
-let rec prepare_implicits f = function
-  | [] -> []
-  | (Anonymous, Some _)::_ -> anomaly (Pp.str "Unnamed implicit")
-  | (Name id, Some imp)::imps ->
-      let imps' = prepare_implicits f imps in
-      Some (id,imp,(set_maximality imps' f.maximal,true)) :: imps'
-  | _::imps -> None :: prepare_implicits f imps
-
-let set_implicit id imp insmax =
-  (id,(match imp with None -> Manual | Some imp -> imp),insmax)
-
-let rec assoc_by_pos k = function
-    (ExplByPos (k', x), b) :: tl when Int.equal k k' -> (x,b), tl
-  | hd :: tl -> let (x, tl) = assoc_by_pos k tl in x, hd :: tl
-  | [] -> raise Not_found
-
-let check_correct_manual_implicits autoimps l =
-  List.iter (function
-    | ExplByName id,(b,fi,forced) ->
-	if not forced then
-	  errorlabstrm ""
-            (str "Wrong or non-dependent implicit argument name: " ++ pr_id id ++ str ".")
-    | ExplByPos (i,_id),_t ->
-	if i<1 || i>List.length autoimps then
-	  errorlabstrm ""
-            (str "Bad implicit argument number: " ++ int i ++ str ".")
-	else
-	  errorlabstrm ""
-	    (str "Cannot set implicit argument number " ++ int i ++
-	      str ": it has no name.")) l
-
-let set_manual_implicits env flags enriching autoimps l =
-  let try_forced k l =
-    try
-      let (id, (b, fi, fo)), l' = assoc_by_pos k l in
-	if fo then
-	  let id = match id with Some id -> id | None -> Id.of_string ("arg_" ^ string_of_int k) in
-	    l', Some (id,Manual,(b,fi))
-	else l, None
-    with Not_found -> l, None
-  in
-  if not (List.distinct l) then
-    error ("Some parameters are referred more than once.");
-  (* Compare with automatic implicits to recover printing data and names *)
-  let rec merge k l = function
-  | (Name id,imp)::imps ->
-      let l',imp,m =
-	try
-          let eq = explicitation_eq in
-	  let (b, fi, fo) = List.assoc_f eq (ExplByName id) l in
-	  List.remove_assoc_f eq (ExplByName id) l, (Some Manual), (Some (b, fi))
-	with Not_found ->
-	try
-	  let (id, (b, fi, fo)), l' = assoc_by_pos k l in
-	    l', (Some Manual), (Some (b,fi))
-	with Not_found ->
-          let m = match enriching, imp with
-          | true, Some _ -> Some (flags.maximal, true)
-          | _ -> None
-          in
-          l, imp, m
-      in
-      let imps' = merge (k+1) l' imps in
-      let m = Option.map (fun (b,f) -> 
-	(* match imp with Some Manual -> (b,f) *)
-	(* | _ ->  *)set_maximality imps' b, f) m in
-      Option.map (set_implicit id imp) m :: imps'
-  | (Anonymous,imp)::imps ->
-      let l', forced = try_forced k l in
-	forced :: merge (k+1) l' imps
-  | [] when begin match l with [] -> true | _ -> false end -> []
-  | [] ->
-      check_correct_manual_implicits autoimps l;
-      []
-  in
-  merge 1 l autoimps
-
-let compute_semi_auto_implicits env f manual t =
-  match manual with
-  | [] ->
-      if not f.auto then [DefaultImpArgs, []]
-      else let _,l = compute_implicits_flags env f false t in
-	     [DefaultImpArgs, prepare_implicits f l]
-  | _ ->
-      let _,autoimpls = compute_auto_implicits env f f.auto t in
-      [DefaultImpArgs, set_manual_implicits env f f.auto autoimpls manual]
-
-(*s Constants. *)
-
-let compute_constant_implicits flags manual cst =
-  let env = Global.env () in
-  let cb = Environ.lookup_constant cst env in
-  let ty = Typeops.type_of_constant_type env cb.const_type in
-  let impls = compute_semi_auto_implicits env flags manual ty in
-    impls
-
-(*s Inductives and constructors. Their implicit arguments are stored
-   in an array, indexed by the inductive number, of pairs $(i,v)$ where
-   $i$ are the implicit arguments of the inductive and $v$ the array of
-   implicit arguments of the constructors. *)
-
-let compute_mib_implicits flags manual kn =
-  let env = Global.env () in
-  let mib = lookup_mind kn env in
-  let ar =
-    Array.to_list
-      (Array.mapi  (* No need to lift, arities contain no de Bruijn *)
-        (fun i mip ->
-	  (** No need to care about constraints here *)
-	  Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, Global.type_of_global_unsafe (IndRef (kn,i))))
-        mib.mind_packets) in
-  let env_ar = push_rel_context ar env in
-  let imps_one_inductive i mip =
-    let ind = (kn,i) in
-    let ar = Global.type_of_global_unsafe (IndRef ind) in
-    ((IndRef ind,compute_semi_auto_implicits env flags manual ar),
-     Array.mapi (fun j c ->
-       (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar flags manual c))
-       mip.mind_nf_lc)
-  in
-  Array.mapi imps_one_inductive mib.mind_packets
-
-let compute_all_mib_implicits flags manual kn =
-  let imps = compute_mib_implicits flags manual kn in
-  List.flatten
-    (Array.map_to_list (fun (ind,cstrs) -> ind::Array.to_list cstrs) imps)
-
-(*s Variables. *)
-
-let compute_var_implicits flags manual id =
-  let env = Global.env () in
-  let open Context.Named.Declaration in
-  compute_semi_auto_implicits env flags manual (get_type (lookup_named id env))
-
-(* Implicits of a global reference. *)
-
-let compute_global_implicits flags manual = function
-  | VarRef id -> compute_var_implicits flags manual id
-  | ConstRef kn -> compute_constant_implicits flags manual kn
-  | IndRef (kn,i) ->
-      let ((_,imps),_) = (compute_mib_implicits flags manual kn).(i) in imps
-  | ConstructRef ((kn,i),j) ->
-      let (_,cimps) = (compute_mib_implicits flags manual kn).(i) in snd cimps.(j-1)
-
-(* Merge a manual explicitation with an implicit_status list *)
-
-let merge_impls (cond,oldimpls) (_,newimpls) =
-  let oldimpls,usersuffiximpls = List.chop (List.length newimpls) oldimpls in
-  cond, (List.map2 (fun orig ni ->
-    match orig with
-    | Some (_, Manual, _) -> orig
-    | _ -> ni) oldimpls newimpls)@usersuffiximpls
-
-(* Caching implicits *)
-
-type implicit_interactive_request =
-  | ImplAuto
-  | ImplManual of int
-
-type implicit_discharge_request =
-  | ImplLocal
-  | ImplConstant of constant * implicits_flags
-  | ImplMutualInductive of mutual_inductive * implicits_flags
-  | ImplInteractive of global_reference * implicits_flags *
-      implicit_interactive_request
-
-let implicits_table = Summary.ref Refmap.empty ~name:"implicits"
-
-let implicits_of_global ref =
-  try
-    let l = Refmap.find ref !implicits_table in
-    try
-      let rename_l = Arguments_renaming.arguments_names ref in
-      let rec rename implicits names = match implicits, names with
-        | [], _ -> []
-        | _, [] -> implicits
-        | Some (_, x,y) :: implicits, Name id :: names ->
-           Some (id, x,y) :: rename implicits names
-        | imp :: implicits, _ :: names -> imp :: rename implicits names
-      in
-      List.map (fun (t, il) -> t, rename il rename_l) l
-    with Not_found -> l
-  with Not_found -> [DefaultImpArgs,[]]
-
-let cache_implicits_decl (ref,imps) =
-  implicits_table := Refmap.add ref imps !implicits_table
-
-let load_implicits _ (_,(_,l)) = List.iter cache_implicits_decl l
-
-let cache_implicits o =
-  load_implicits 1 o
-
-let subst_implicits_decl subst (r,imps as o) =
-  let r' = fst (subst_global subst r) in if r==r' then o else (r',imps)
-
-let subst_implicits (subst,(req,l)) =
-  (ImplLocal,List.smartmap (subst_implicits_decl subst) l)
-
-let impls_of_context ctx =
-  let map (id, impl, _, _) = match impl with
-  | Implicit -> Some (id, Manual, (true, true))
-  | _ -> None
-  in
-  let is_set (_, _, b, _) = match b with
-  | None -> true
-  | Some _ -> false
-  in
-  List.rev_map map (List.filter is_set ctx)
-
-let adjust_side_condition p = function
-  | LessArgsThan n -> LessArgsThan (n+p)
-  | DefaultImpArgs -> DefaultImpArgs
-
-let add_section_impls vars extra_impls (cond,impls) =
-  let p = List.length vars - List.length extra_impls in
-  adjust_side_condition p cond, extra_impls @ impls
-
-let discharge_implicits (_,(req,l)) =
-  match req with
-  | ImplLocal -> None
-  | ImplInteractive (ref,flags,exp) ->
-    (try
-      let vars = variable_section_segment_of_reference ref in
-      let ref' = if isVarRef ref then ref else pop_global_reference ref in
-      let extra_impls = impls_of_context vars in
-      let l' = [ref', List.map (add_section_impls vars extra_impls) (snd (List.hd l))] in
-      Some (ImplInteractive (ref',flags,exp),l')
-    with Not_found -> (* ref not defined in this section *) Some (req,l))
-  | ImplConstant (con,flags) ->
-    (try
-      let con' = pop_con con in
-      let vars,_,_ = section_segment_of_constant con in
-      let extra_impls = impls_of_context vars in
-      let newimpls = List.map (add_section_impls vars extra_impls) (snd (List.hd l)) in
-      let l' = [ConstRef con',newimpls] in
-	Some (ImplConstant (con',flags),l')
-    with Not_found -> (* con not defined in this section *) Some (req,l))
-  | ImplMutualInductive (kn,flags) ->
-    (try
-      let l' = List.map (fun (gr, l) ->
-	let vars = variable_section_segment_of_reference gr in
-	let extra_impls = impls_of_context vars in
-	((if isVarRef gr then gr else pop_global_reference gr),
-	 List.map (add_section_impls vars extra_impls) l)) l
-      in
-	Some (ImplMutualInductive (pop_kn kn,flags),l')
-    with Not_found -> (* ref not defined in this section *) Some (req,l))
-
-let rebuild_implicits (req,l) =
-  match req with
-  | ImplLocal -> assert false
-  | ImplConstant (con,flags) ->
-      let oldimpls = snd (List.hd l) in
-      let newimpls = compute_constant_implicits flags [] con in
-      req, [ConstRef con, List.map2 merge_impls oldimpls newimpls]
-  | ImplMutualInductive (kn,flags) ->
-      let newimpls = compute_all_mib_implicits flags [] kn in
-      let rec aux olds news =
-	match olds, news with
-	| (_, oldimpls) :: old, (gr, newimpls) :: tl ->
-	    (gr, List.map2 merge_impls oldimpls newimpls) :: aux old tl
-	| [], [] -> []
-	| _, _ -> assert false
-      in req, aux l newimpls
-
-  | ImplInteractive (ref,flags,o) ->
-      (if isVarRef ref && is_in_section ref then ImplLocal else req),
-      match o with
-      | ImplAuto ->
-	  let oldimpls = snd (List.hd l) in
-	  let newimpls = compute_global_implicits flags [] ref in
-	    [ref,List.map2 merge_impls oldimpls newimpls]
-      | ImplManual userimplsize ->
-	  let oldimpls = snd (List.hd l) in
-	  if flags.auto then
-	    let newimpls = List.hd (compute_global_implicits flags [] ref) in
-	    let p = List.length (snd newimpls) - userimplsize in
-	    let newimpls = on_snd (List.firstn p) newimpls in
-	    [ref,List.map (fun o -> merge_impls o newimpls) oldimpls]
-	  else
-	    [ref,oldimpls]
-
-let classify_implicits (req,_ as obj) = match req with
-| ImplLocal -> Dispose
-| _ -> Substitute obj
-
-type implicits_obj =
-    implicit_discharge_request *
-      (global_reference * implicits_list list) list
-
-let inImplicits : implicits_obj -> obj =
-  declare_object {(default_object "IMPLICITS") with
-    cache_function = cache_implicits;
-    load_function = load_implicits;
-    subst_function = subst_implicits;
-    classify_function = classify_implicits;
-    discharge_function = discharge_implicits;
-    rebuild_function = rebuild_implicits }
-
-let is_local local ref = local || isVarRef ref && is_in_section ref
-
-let declare_implicits_gen req flags ref =
-  let imps = compute_global_implicits flags [] ref in
-  add_anonymous_leaf (inImplicits (req,[ref,imps]))
-
-let declare_implicits local ref =
-  let flags = { !implicit_args with auto = true } in
-  let req =
-    if is_local local ref then ImplLocal else ImplInteractive(ref,flags,ImplAuto) in
-    declare_implicits_gen req flags ref
-
-let declare_var_implicits id =
-  let flags = !implicit_args in
-    declare_implicits_gen ImplLocal flags (VarRef id)
-
-let declare_constant_implicits con =
-  let flags = !implicit_args in
-    declare_implicits_gen (ImplConstant (con,flags)) flags (ConstRef con)
-
-let declare_mib_implicits kn =
-  let flags = !implicit_args in
-  let imps = Array.map_to_list
-    (fun (ind,cstrs) -> ind::(Array.to_list cstrs))
-    (compute_mib_implicits flags [] kn) in
-    add_anonymous_leaf
-      (inImplicits (ImplMutualInductive (kn,flags),List.flatten imps))
-
-(* Declare manual implicits *)
-type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool)
-
-type manual_implicits = manual_explicitation list
-
-let compute_implicits_with_manual env typ enriching l =
-  let _,autoimpls = compute_auto_implicits env !implicit_args enriching typ in
-  set_manual_implicits env !implicit_args enriching autoimpls l
-
-let check_inclusion l =
-  (* Check strict inclusion *)
-  let rec aux = function
-    | n1::(n2::_ as nl) ->
-	if n1 <= n2 then
-	  error "Sequences of implicit arguments must be of different lengths.";
-	aux nl
-    | _ -> () in
-  aux (List.map (fun (imps,_) -> List.length imps) l)
-
-let check_rigidity isrigid =
-  if not isrigid then
-    errorlabstrm "" (strbrk "Multiple sequences of implicit arguments available only for references that cannot be applied to an arbitrarily large number of arguments.")
-
-let projection_implicits env p impls = 
-  let pb = Environ.lookup_projection p env in
-    CList.skipn_at_least pb.Declarations.proj_npars impls
-
-let declare_manual_implicits local ref ?enriching l =
-  let flags = !implicit_args in
-  let env = Global.env () in
-  let t = Global.type_of_global_unsafe ref in
-  let enriching = Option.default flags.auto enriching in
-  let isrigid,autoimpls = compute_auto_implicits env flags enriching t in
-  let l' = match l with
-    | [] -> assert false
-    | [l] ->
-	[DefaultImpArgs, set_manual_implicits env flags enriching autoimpls l]
-    | _ ->
-	check_rigidity isrigid;
-	let l = List.map (fun imps -> (imps,List.length imps)) l in
-	let l = List.sort (fun (_,n1) (_,n2) -> n2 - n1) l in
-	check_inclusion l;
-	let nargs = List.length autoimpls in
-	List.map (fun (imps,n) ->
-	  (LessArgsThan (nargs-n),
-	   set_manual_implicits env flags enriching autoimpls imps)) l in
-  let req =
-    if is_local local ref then ImplLocal
-    else ImplInteractive(ref,flags,ImplManual (List.length autoimpls))
-  in
-    add_anonymous_leaf (inImplicits (req,[ref,l']))
-
-let maybe_declare_manual_implicits local ref ?enriching l =
-  match l with
-  | [] -> ()
-  | _ -> declare_manual_implicits local ref ?enriching [l]
-
-let extract_impargs_data impls =
-  let rec aux p = function
-    | (DefaultImpArgs, imps)::_ -> [None,imps]
-    | (LessArgsThan n, imps)::l -> (Some (p,n),imps) :: aux (n+1) l
-    | [] -> [] in
-  aux 0 impls
-
-let lift_implicits n =
-  List.map (fun x ->
-    match fst x with
-	ExplByPos (k, id) -> ExplByPos (k + n, id), snd x
-      | _ -> x)
-
-let make_implicits_list l = [DefaultImpArgs, l]
-
-let rec drop_first_implicits p l =
-  if Int.equal p 0 then l else match l with
-  | _,[] as x -> x
-  | DefaultImpArgs,imp::impls ->
-      drop_first_implicits (p-1) (DefaultImpArgs,impls)
-  | LessArgsThan n,imp::impls ->
-      let n = if is_status_implicit imp then n-1 else n in
-      drop_first_implicits (p-1) (LessArgsThan n,impls)
-
-let rec select_impargs_size n = function
-  | [] -> [] (* Tolerance for (DefaultImpArgs,[]) *)
-  | [_, impls] | (DefaultImpArgs, impls)::_ -> impls
-  | (LessArgsThan p, impls)::l ->
-      if n <= p then impls else select_impargs_size n l
-
-let select_stronger_impargs = function
-  | [] -> [] (* Tolerance for (DefaultImpArgs,[]) *)
-  | (_,impls)::_ -> impls
diff --git a/library/impargs.mli b/library/impargs.mli
deleted file mode 100644
index 3919a519..00000000
--- a/library/impargs.mli
+++ /dev/null
@@ -1,139 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Globnames
-open Term
-open Environ
-
-(** {6 Implicit Arguments } *)
-(** Here we store the implicit arguments. Notice that we
-    are outside the kernel, which knows nothing about implicit arguments. *)
-
-val make_implicit_args : bool -> unit
-val make_strict_implicit_args : bool -> unit
-val make_strongly_strict_implicit_args : bool -> unit
-val make_reversible_pattern_implicit_args : bool -> unit
-val make_contextual_implicit_args : bool -> unit
-val make_maximal_implicit_args : bool -> unit
-
-val is_implicit_args : unit -> bool
-val is_strict_implicit_args : unit -> bool
-val is_strongly_strict_implicit_args : unit -> bool
-val is_reversible_pattern_implicit_args : unit -> bool
-val is_contextual_implicit_args : unit -> bool
-val is_maximal_implicit_args : unit -> bool
-
-val with_implicit_protection : ('a -> 'b) -> 'a -> 'b
-
-(** {6 ... } *)
-(** An [implicits_list] is a list of positions telling which arguments
-    of a reference can be automatically infered *)
-
-
-type argument_position =
-  | Conclusion
-  | Hyp of int
-
-(** We remember various information about why an argument is
-   inferable as implicit *)
-type implicit_explanation =
-  | DepRigid of argument_position
-      (** means that the implicit argument can be found by
-	  unification along a rigid path (we do not print the arguments of
-	  this kind if there is enough arguments to infer them) *)
-  | DepFlex of argument_position
-      (** means that the implicit argument can be found by unification
-	  along a collapsable path only (e.g. as x in (P x) where P is another
-	  argument) (we do (defensively) print the arguments of this kind) *)
-  | DepFlexAndRigid of (*flex*) argument_position * (*rig*) argument_position
-      (** means that the least argument from which the
-	  implicit argument can be inferred is following a collapsable path
-	  but there is a greater argument from where the implicit argument is
-	  inferable following a rigid path (useful to know how to print a
-	  partial application) *)
-  | Manual
-      (** means the argument has been explicitly set as implicit. *)
-
-(**  We also consider arguments inferable from the conclusion but it is
-     operational only if [conclusion_matters] is true. *)
-
-type maximal_insertion = bool (** true = maximal contextual insertion *)
-type force_inference = bool (** true = always infer, never turn into evar/subgoal *)
-
-type implicit_status = (Id.t * implicit_explanation * 
-			  (maximal_insertion * force_inference)) option
-    (** [None] = Not implicit *)
-
-type implicit_side_condition
-
-type implicits_list = implicit_side_condition * implicit_status list
-
-val is_status_implicit : implicit_status -> bool
-val is_inferable_implicit : bool -> int -> implicit_status -> bool
-val name_of_implicit : implicit_status -> Id.t
-val maximal_insertion_of : implicit_status -> bool
-val force_inference_of : implicit_status -> bool
-
-val positions_of_implicits : implicits_list -> int list
-
-(** A [manual_explicitation] is a tuple of a positional or named explicitation with
-   maximal insertion, force inference and force usage flags. Forcing usage makes
-   the argument implicit even if the automatic inference considers it not inferable. *)
-type manual_explicitation = Constrexpr.explicitation *
-    (maximal_insertion * force_inference * bool)
-
-type manual_implicits = manual_explicitation list
-
-val compute_implicits_with_manual : env -> types -> bool ->
-  manual_implicits -> implicit_status list
-
-val compute_implicits_names : env -> types -> Name.t list
-
-(** {6 Computation of implicits (done using the global environment). } *)
-
-val declare_var_implicits : variable -> unit
-val declare_constant_implicits : constant -> unit
-val declare_mib_implicits : mutual_inductive -> unit
-
-val declare_implicits : bool -> global_reference -> unit
-
-(** [declare_manual_implicits local ref enriching l]
-   Manual declaration of which arguments are expected implicit.
-   If not set, we decide if it should enrich by automatically inferd
-   implicits depending on the current state.
-   Unsets implicits if [l] is empty. *)
-
-val declare_manual_implicits : bool -> global_reference -> ?enriching:bool ->
-  manual_implicits list -> unit
-
-(** If the list is empty, do nothing, otherwise declare the implicits. *)
-
-val maybe_declare_manual_implicits : bool -> global_reference -> ?enriching:bool ->
-  manual_implicits -> unit
-
-val implicits_of_global : global_reference -> implicits_list list
-
-val extract_impargs_data :
-  implicits_list list -> ((int * int) option * implicit_status list) list
-
-val lift_implicits : int -> manual_implicits -> manual_implicits
-
-val make_implicits_list : implicit_status list -> implicits_list list
-
-val drop_first_implicits : int -> implicits_list -> implicits_list
-
-val projection_implicits : env -> projection -> implicit_status list -> 
-  implicit_status list
-
-val select_impargs_size : int -> implicits_list list -> implicit_status list
-
-val select_stronger_impargs : implicits_list list -> implicit_status list
-
-val explicitation_eq : Constrexpr.explicitation -> Constrexpr.explicitation -> bool
-(** Equality on [explicitation]. *)
diff --git a/library/keys.ml b/library/keys.ml
index 057dc3b6..34a6adab 100644
--- a/library/keys.ml
+++ b/library/keys.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** Keys for unification and indexing *)
@@ -114,11 +116,11 @@ let inKeys : key_obj -> obj =
 let declare_equiv_keys ref ref' =
   Lib.add_anonymous_leaf (inKeys (ref,ref'))
 
-let constr_key c =
+let constr_key kind c =
   let open Globnames in 
   try 
     let rec aux k = 
-      match kind_of_term k with
+      match kind k with
       | Const (c, _) -> KGlob (ConstRef c)
       | Ind (i, u) -> KGlob (IndRef i)
       | Construct (c,u) -> KGlob (ConstructRef c)
diff --git a/library/keys.mli b/library/keys.mli
index 69668590..1fb9a3de 100644
--- a/library/keys.mli
+++ b/library/keys.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Globnames
@@ -16,8 +18,8 @@ val declare_equiv_keys : key -> key -> unit
 val equiv_keys : key -> key -> bool
 (** Check equivalence of keys. *)
 
-val constr_key : Term.constr -> key option
+val constr_key : ('a -> ('a, 't, 'u, 'i) Constr.kind_of_term) -> 'a -> key option
 (** Compute the head key of a term. *)
 
-val pr_keys : (global_reference -> Pp.std_ppcmds) -> Pp.std_ppcmds
+val pr_keys : (global_reference -> Pp.t) -> Pp.t
 (** Pretty-print the mapping *)
diff --git a/library/kindops.ml b/library/kindops.ml
index 21b1bec3..247319fa 100644
--- a/library/kindops.ml
+++ b/library/kindops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Decl_kinds
@@ -23,45 +25,13 @@ let string_of_theorem_kind = function
   | Proposition -> "Proposition"
   | Corollary -> "Corollary"
 
-let string_of_definition_kind def =
-  let (locality, poly, kind) = def in
-  let error () = CErrors.anomaly (Pp.str "Internal definition kind") in
-  match kind with
-  | Definition ->
-    begin match locality with
-    | Discharge -> "Let"
-    | Local -> "Local Definition"
-    | Global -> "Definition"
-    end
-  | Example ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local Example"
-    | Global -> "Example"
-    end
-  | Coercion ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local Coercion"
-    | Global -> "Coercion"
-    end
-  | SubClass ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local SubClass"
-    | Global -> "SubClass"
-    end
-  | CanonicalStructure ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> error ()
-    | Global -> "Canonical Structure"
-    end
-  | Instance ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Instance"
-    | Global -> "Global Instance"
-    end
+let string_of_definition_object_kind = function
+  | Definition -> "Definition"
+  | Example -> "Example"
+  | Coercion -> "Coercion"
+  | SubClass -> "SubClass"
+  | CanonicalStructure -> "Canonical Structure"
+  | Instance -> "Instance"
+  | Let -> "Let"
   | (StructureComponent|Scheme|CoFixpoint|Fixpoint|IdentityCoercion|Method) ->
-    CErrors.anomaly (Pp.str "Internal definition kind")
+    CErrors.anomaly (Pp.str "Internal definition kind.")
diff --git a/library/kindops.mli b/library/kindops.mli
index 3e95eaa7..df39019d 100644
--- a/library/kindops.mli
+++ b/library/kindops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Decl_kinds
@@ -12,4 +14,4 @@ open Decl_kinds
 
 val logical_kind_of_goal_kind : goal_object_kind -> logical_kind
 val string_of_theorem_kind : theorem_kind -> string
-val string_of_definition_kind : definition_kind -> string
+val string_of_definition_object_kind : definition_object_kind -> string
diff --git a/library/lib.ml b/library/lib.ml
index f680ecee..543cb45b 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -1,18 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
+open Names
 open Libnames
 open Globnames
-open Nameops
 open Libobject
+open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type is_type = bool (* Module Type or just Module *)
 type export = bool option (* None for a Module Type *)
@@ -24,7 +29,6 @@ type node =
   | ClosedModule  of library_segment
   | OpenedSection of object_prefix * Summary.frozen
   | ClosedSection of library_segment
-  | FrozenState of Summary.frozen
 
 and library_entry = object_name * node
 
@@ -60,7 +64,7 @@ let classify_segment seg =
   let rec clean ((substl,keepl,anticipl) as acc) = function
     | (_,CompilingLibrary _) :: _ | [] -> acc
     | ((sp,kn),Leaf o) :: stk ->
-	let id = Names.Label.to_id (Names.label kn) in
+	let id = Names.Label.to_id (Names.KerName.label kn) in
 	  (match classify_object o with
 	     | Dispose -> clean acc stk
 	     | Keep o' ->
@@ -73,11 +77,10 @@ let classify_segment seg =
     (* LEM; TODO: Understand what this does and see if what I do is the
                   correct thing for ClosedMod(ule|type) *)
     | (_,ClosedModule _) :: stk -> clean acc stk
-    | (_,OpenedSection _) :: _ -> error "there are still opened sections"
+    | (_,OpenedSection _) :: _ -> user_err Pp.(str "there are still opened sections")
     | (_,OpenedModule (ty,_,_,_)) :: _ ->
-      errorlabstrm "Lib.classify_segment"
+      user_err ~hdr:"Lib.classify_segment"
         (str "there are still opened " ++ str (module_kind ty) ++ str "s")
-    | (_,FrozenState _) :: stk -> clean acc stk
   in
     clean ([],[],[]) (List.rev seg)
 
@@ -92,23 +95,35 @@ let segment_of_objects prefix =
    sections, but on the contrary there are many constructions of section
    paths based on the library path. *)
 
-let initial_prefix = default_library,(Names.initial_path,Names.DirPath.empty)
+let initial_prefix = {
+  obj_dir = default_library;
+  obj_mp  = ModPath.initial;
+  obj_sec = DirPath.empty;
+}
+
+type lib_state = {
+  comp_name   : DirPath.t option;
+  lib_stk     : library_segment;
+  path_prefix : object_prefix;
+}
 
-let lib_stk = ref ([] : library_segment)
+let initial_lib_state = {
+  comp_name   = None;
+  lib_stk     = [];
+  path_prefix = initial_prefix;
+}
 
-let comp_name = ref None
+let lib_state = ref initial_lib_state
 
 let library_dp () =
-  match !comp_name with Some m -> m | None -> default_library
+  match !lib_state.comp_name with Some m -> m | None -> default_library
 
 (* [path_prefix] is a pair of absolute dirpath and a pair of current
    module path and relative section path *)
-let path_prefix = ref initial_prefix
 
-let cwd () = fst !path_prefix
-let current_prefix () = snd !path_prefix
-let current_mp () = fst (snd !path_prefix)
-let current_sections () = snd (snd !path_prefix)
+let cwd () = !lib_state.path_prefix.obj_dir
+let current_mp () = !lib_state.path_prefix.obj_mp
+let current_sections () = !lib_state.path_prefix.obj_sec
 
 let sections_depth () = List.length (Names.DirPath.repr (current_sections ()))
 let sections_are_opened () = not (Names.DirPath.is_empty (current_sections ()))
@@ -126,10 +141,10 @@ let make_path_except_section id =
   Libnames.make_path (cwd_except_section ()) id
 
 let make_kn id =
-  let mp,dir = current_prefix () in
-  Names.make_kn mp dir (Names.Label.of_id id)
+  let mp, dir = current_mp (), current_sections () in
+  Names.KerName.make mp dir (Names.Label.of_id id)
 
-let make_oname id = Libnames.make_oname !path_prefix id
+let make_oname id = Libnames.make_oname !lib_state.path_prefix id
 
 let recalc_path_prefix () =
   let rec recalc = function
@@ -139,18 +154,28 @@ let recalc_path_prefix () =
     | _::l -> recalc l
     | [] -> initial_prefix
   in
-  path_prefix := recalc !lib_stk
+  lib_state := { !lib_state with path_prefix = recalc !lib_state.lib_stk }
 
 let pop_path_prefix () =
-  let dir,(mp,sec) = !path_prefix in
-  path_prefix := pop_dirpath dir, (mp, pop_dirpath sec)
+  let op = !lib_state.path_prefix in
+  lib_state := { !lib_state
+                 with path_prefix = { op with obj_dir = pop_dirpath op.obj_dir;
+                                              obj_sec = pop_dirpath op.obj_sec;
+                                    } }
 
 let find_entry_p p =
   let rec find = function
     | [] -> raise Not_found
     | ent::l -> if p ent then ent else find l
   in
-  find !lib_stk
+  find !lib_state.lib_stk
+
+let find_entries_p p =
+  let rec find = function
+    | [] -> []
+    | ent::l -> if p ent then ent::find l else find l
+  in
+  find !lib_state.lib_stk
 
 let split_lib_gen test =
   let rec collect after equal = function
@@ -171,8 +196,8 @@ let split_lib_gen test =
 		| _ -> findeq (hd::after) before)
     | [] -> None
   in
-    match findeq [] !lib_stk with
-      | None -> error "no such entry"
+    match findeq [] !lib_state.lib_stk with
+      | None -> user_err Pp.(str "no such entry")
       | Some r -> r
 
 let eq_object_name (fp1, kn1) (fp2, kn2) =
@@ -196,10 +221,10 @@ let split_lib_at_opening sp =
 (* Adding operations. *)
 
 let add_entry sp node =
-  lib_stk := (sp,node) :: !lib_stk
+  lib_state := { !lib_state with lib_stk = (sp,node) :: !lib_state.lib_stk }
 
 let pull_to_head oname =
-  lib_stk := (oname,List.assoc oname !lib_stk) :: List.remove_assoc oname !lib_stk
+  lib_state := { !lib_state with lib_stk = (oname,List.assoc oname !lib_state.lib_stk) :: List.remove_assoc oname !lib_state.lib_stk }
 
 let anonymous_id =
   let n = ref 0 in
@@ -209,8 +234,8 @@ let add_anonymous_entry node =
   add_entry (make_oname (anonymous_id ())) node
 
 let add_leaf id obj =
-  if Names.ModPath.equal (current_mp ()) Names.initial_path then
-    error ("No session module started (use -top dir)");
+  if ModPath.equal (current_mp ()) ModPath.initial then
+    user_err Pp.(str "No session module started (use -top dir)");
   let oname = make_oname id in
   cache_object (oname,obj);
   add_entry oname (Leaf obj);
@@ -242,10 +267,6 @@ let add_anonymous_leaf ?(cache_first = true) obj =
     cache_object (oname,obj)
   end
 
-let add_frozen_state () =
-  add_anonymous_entry
-    (FrozenState (Summary.freeze_summaries ~marshallable:`No))
-
 (* Modules. *)
 
 let is_opening_node = function
@@ -260,21 +281,21 @@ let current_mod_id () =
   try match find_entry_p is_opening_node_or_lib with
     | oname,OpenedModule (_,_,_,fs) -> basename (fst oname)
     | oname,CompilingLibrary _ -> basename (fst oname)
-    | _ -> error "you are not in a module"
-  with Not_found -> error "no opened modules"
+    | _ -> user_err Pp.(str "you are not in a module")
+  with Not_found -> user_err Pp.(str "no opened modules")
 
 
 let start_mod is_type export id mp fs =
-  let dir = add_dirpath_suffix (cwd ()) id in
-  let prefix = dir,(mp,Names.DirPath.empty) in
+  let dir = add_dirpath_suffix (!lib_state.path_prefix.obj_dir) id in
+  let prefix = { obj_dir = dir; obj_mp = mp; obj_sec = Names.DirPath.empty } in
   let exists =
     if is_type then Nametab.exists_cci (make_path id)
     else Nametab.exists_module dir
   in
   if exists then
-    errorlabstrm "open_module" (pr_id id ++ str " already exists");
+    user_err ~hdr:"open_module" (Id.print id ++ str " already exists");
   add_entry (make_oname id) (OpenedModule (is_type,export,prefix,fs));
-  path_prefix := prefix;
+  lib_state := { !lib_state with path_prefix = prefix} ;
   prefix
 
 let start_module = start_mod false
@@ -282,8 +303,8 @@ let start_modtype = start_mod true None
 
 let error_still_opened string oname =
   let id = basename (fst oname) in
-  errorlabstrm ""
-    (str "The " ++ str string ++ str " " ++ pr_id id ++ str " is still opened.")
+  user_err 
+    (str "The " ++ str string ++ str " " ++ Id.print id ++ str " is still opened.")
 
 let end_mod is_type =
   let oname,fs =
@@ -293,19 +314,19 @@ let end_mod is_type =
 	else error_still_opened (module_kind ty) oname
       | oname,OpenedSection _ -> error_still_opened "section" oname
       | _ -> assert false
-    with Not_found -> error "No opened modules."
+    with Not_found -> user_err (Pp.str "No opened modules.")
   in
   let (after,mark,before) = split_lib_at_opening oname in
-  lib_stk := before;
+  lib_state := { !lib_state with lib_stk = before };
   add_entry oname (ClosedModule (List.rev (mark::after)));
-  let prefix = !path_prefix in
+  let prefix = !lib_state.path_prefix in
   recalc_path_prefix ();
   (oname, prefix, fs, after)
 
 let end_module () = end_mod false
 let end_modtype () = end_mod true
 
-let contents () = !lib_stk
+let contents () = !lib_state.lib_stk
 
 let contents_after sp = let (after,_,_) = split_lib sp in after
 
@@ -313,47 +334,49 @@ let contents_after sp = let (after,_,_) = split_lib sp in after
 
 (* TODO: use check_for_module ? *)
 let start_compilation s mp =
-  if !comp_name != None then
-    error "compilation unit is already started";
-  if not (Names.DirPath.is_empty (current_sections ())) then
-    error "some sections are already opened";
-  let prefix = s, (mp, Names.DirPath.empty) in
-  let () = add_anonymous_entry (CompilingLibrary prefix) in
-  comp_name := Some s;
-  path_prefix := prefix
+  if !lib_state.comp_name != None then
+    user_err Pp.(str "compilation unit is already started");
+  if not (Names.DirPath.is_empty (!lib_state.path_prefix.obj_sec)) then
+    user_err Pp.(str "some sections are already opened");
+  let prefix = Libnames.{ obj_dir = s; obj_mp = mp; obj_sec = DirPath.empty } in
+  add_anonymous_entry (CompilingLibrary prefix);
+  lib_state := { !lib_state with comp_name = Some s;
+                                 path_prefix = prefix }
+
+let open_blocks_message es =
+  let open_block_name = function
+      | oname, OpenedSection _ -> str "section " ++ Id.print (basename (fst oname))
+      | oname, OpenedModule (ty,_,_,_) -> str (module_kind ty) ++ spc () ++ Id.print (basename (fst oname))
+      | _ -> assert false in
+  str "The " ++ pr_enum open_block_name es ++ spc () ++
+  str "need" ++ str (if List.length es == 1 then "s" else "") ++ str " to be closed."
 
 let end_compilation_checks dir =
-  let _ =
-    try match snd (find_entry_p is_opening_node) with
-      | OpenedSection _ -> error "There are some open sections."
-      | OpenedModule (ty,_,_,_) ->
-	errorlabstrm "Lib.end_compilation_checks"
-          (str "There are some open " ++ str (module_kind ty) ++ str "s.")
-      | _ -> assert false
-    with Not_found -> ()
-  in
+  let _ = match find_entries_p is_opening_node with
+    | [] -> ()
+    | es -> user_err ~hdr:"Lib.end_compilation_checks" (open_blocks_message es) in
   let is_opening_lib = function _,CompilingLibrary _ -> true | _ -> false
   in
   let oname =
     try match find_entry_p is_opening_lib with
       |	(oname, CompilingLibrary prefix) -> oname
       | _ -> assert false
-    with Not_found -> anomaly (Pp.str "No module declared")
+    with Not_found -> anomaly (Pp.str "No module declared.")
   in
   let _ =
-    match !comp_name with
+    match !lib_state.comp_name with
       | None -> anomaly (Pp.str "There should be a module name...")
       | Some m ->
 	  if not (Names.DirPath.equal m dir) then anomaly
-	    (str "The current open module has name" ++ spc () ++ pr_dirpath m ++
-             spc () ++ str "and not" ++ spc () ++ pr_dirpath m);
+           (str "The current open module has name" ++ spc () ++ DirPath.print m ++
+             spc () ++ str "and not" ++ spc () ++ DirPath.print m ++ str ".");
   in
   oname
 
 let end_compilation oname =
   let (after,mark,before) = split_lib_at_opening oname in
-  comp_name := None;
-  !path_prefix,after
+  lib_state := { !lib_state with comp_name = None };
+  !lib_state.path_prefix,after
 
 (* Returns true if we are inside an opened module or module type *)
 
@@ -379,10 +402,10 @@ let find_opening_node id =
     let oname,entry = find_entry_p is_opening_node in
     let id' = basename (fst oname) in
     if not (Names.Id.equal id id') then
-      errorlabstrm "Lib.find_opening_node"
-        (str "Last block to end has name " ++ pr_id id' ++ str ".");
+      user_err ~hdr:"Lib.find_opening_node"
+        (str "Last block to end has name " ++ Id.print id' ++ str ".");
     entry
-  with Not_found -> error "There is nothing to end."
+  with Not_found -> user_err Pp.(str "There is nothing to end.")
 
 (* Discharge tables *)
 
@@ -393,17 +416,20 @@ let find_opening_node id =
    - the list of substitution to do at section closing
 *)
 
-type variable_info = Names.Id.t * Decl_kinds.binding_kind * Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 
 type variable_context = variable_info list
-type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
-		  
+type abstr_info = {
+  abstr_ctx : variable_context;
+  abstr_subst : Univ.Instance.t;
+  abstr_uctx : Univ.AUContext.t;
+}
 type abstr_list = abstr_info Names.Cmap.t * abstr_info Names.Mindmap.t
 
 type secentry =
   | Variable of (Names.Id.t * Decl_kinds.binding_kind *
-		   Decl_kinds.polymorphic * Univ.universe_context_set)
-  | Context of Univ.universe_context_set
+		   Decl_kinds.polymorphic * Univ.ContextSet.t)
+  | Context of Univ.ContextSet.t
 
 let sectab =
   Summary.ref ([] : (secentry list * Opaqueproof.work_list * abstr_list) list)
@@ -416,7 +442,7 @@ let add_section () =
 let check_same_poly p vars =
   let pred = function Context _ -> p = false | Variable (_, _, poly, _) -> p != poly in
   if List.exists pred vars then
-    error "Cannot mix universe polymorphic and monomorphic declarations in sections."
+    user_err Pp.(str  "Cannot mix universe polymorphic and monomorphic declarations in sections.")
 
 let add_section_variable id impl poly ctx =
   match !sectab with
@@ -433,12 +459,10 @@ let add_section_context ctx =
        sectab := (Context ctx :: vars,repl,abs)::sl
 
 let extract_hyps (secs,ohyps) =
-  let open Context.Named.Declaration in
   let rec aux = function
-    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (get_id decl) ->
-      let (id',b,t) = to_tuple decl in
+    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (NamedDecl.get_id decl) ->
       let l, r = aux (idl,hyps) in 
-	(id',impl,b,t) :: l, if poly then Univ.ContextSet.union r ctx else r
+      (decl,impl) :: l, if poly then Univ.ContextSet.union r ctx else r
     | (Variable (_,_,poly,ctx)::idl,hyps) ->
         let l, r = aux (idl,hyps) in
           l, if poly then Univ.ContextSet.union r ctx else r
@@ -448,17 +472,11 @@ let extract_hyps (secs,ohyps) =
     | [], _ -> [],Univ.ContextSet.empty
   in aux (secs,ohyps)
 
-let instance_from_variable_context sign =
-  let rec inst_rec = function
-    | (id,b,None,_) :: sign -> id :: inst_rec sign
-    | _ :: sign -> inst_rec sign
-    | [] -> [] in
-  Array.of_list (inst_rec sign)
-
-let named_of_variable_context ctx = let open Context.Named.Declaration in
-                                    List.map (function id,_,None,t -> LocalAssum (id,t)
-                                                     | id,_,Some b,t -> LocalDef (id,b,t))
-                                             ctx
+let instance_from_variable_context =
+  List.map fst %> List.filter is_local_assum %> List.map NamedDecl.get_id %> Array.of_list
+
+let named_of_variable_context =
+  List.map fst
   
 let add_section_replacement f g poly hyps =
   match !sectab with
@@ -467,10 +485,15 @@ let add_section_replacement f g poly hyps =
     let () = check_same_poly poly vars in
     let sechyps,ctx = extract_hyps (vars,hyps) in
     let ctx = Univ.ContextSet.to_context ctx in
-    let subst, ctx = Univ.abstract_universes true ctx in
+    let inst = Univ.UContext.instance ctx in
+    let subst, ctx = Univ.abstract_universes ctx in
     let args = instance_from_variable_context (List.rev sechyps) in
-    sectab := (vars,f (Univ.UContext.instance ctx,args) exps,
-	      g (sechyps,subst,ctx) abs)::sl
+    let info = {
+      abstr_ctx = sechyps;
+      abstr_subst = subst;
+      abstr_uctx = ctx;
+    } in
+    sectab := (vars,f (inst,args) exps, g info abs) :: sl
 
 let add_section_kn poly kn =
   let f x (l1,l2) = (l1,Names.Mindmap.add kn x l2) in
@@ -488,16 +511,25 @@ let section_segment_of_constant con =
 let section_segment_of_mutual_inductive kn =
   Names.Mindmap.find kn (snd (pi3 (List.hd !sectab)))
 
-let variable_section_segment_of_reference = function
-  | ConstRef con -> pi1 (section_segment_of_constant con)
-  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
-      pi1 (section_segment_of_mutual_inductive kn)
-  | _ -> []
-                     
+let empty_segment = {
+  abstr_ctx = [];
+  abstr_subst = Univ.Instance.empty;
+  abstr_uctx = Univ.AUContext.empty;
+}
+
+let section_segment_of_reference = function
+| ConstRef c -> section_segment_of_constant c
+| IndRef (kn,_) | ConstructRef ((kn,_),_) ->
+  section_segment_of_mutual_inductive kn
+| VarRef _ -> empty_segment
+
+let variable_section_segment_of_reference gr =
+  (section_segment_of_reference gr).abstr_ctx
+
 let section_instance = function
   | VarRef id ->
      let eq = function
-       | Variable (id',_,_,_) -> Names.id_eq id id'
+       | Variable (id',_,_,_) -> Names.Id.equal id id'
        | Context _ -> false
      in
      if List.exists eq (pi1 (List.hd !sectab))
@@ -513,23 +545,17 @@ let is_in_section ref =
 
 (*************)
 (* Sections. *)
-
-(* XML output hooks *)
-let (f_xml_open_section, xml_open_section) = Hook.make ~default:ignore ()
-let (f_xml_close_section, xml_close_section) = Hook.make ~default:ignore ()
-
 let open_section id =
-  let olddir,(mp,oldsec) = !path_prefix in
-  let dir = add_dirpath_suffix olddir id in
-  let prefix = dir, (mp, add_dirpath_suffix oldsec id) in
-  if Nametab.exists_section dir then
-    errorlabstrm "open_section" (pr_id id ++ str " already exists.");
+  let opp = !lib_state.path_prefix in
+  let obj_dir = add_dirpath_suffix opp.obj_dir id in
+  let prefix = { obj_dir; obj_mp = opp.obj_mp; obj_sec = add_dirpath_suffix opp.obj_sec id } in
+  if Nametab.exists_section obj_dir then
+    user_err ~hdr:"open_section" (Id.print id ++ str " already exists.");
   let fs = Summary.freeze_summaries ~marshallable:`No in
   add_entry (make_oname id) (OpenedSection (prefix, fs));
   (*Pushed for the lifetime of the section: removed by unfrozing the summary*)
-  Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
-  path_prefix := prefix;
-  if !Flags.xml_export then Hook.get f_xml_open_section id;
+  Nametab.push_dir (Nametab.Until 1) obj_dir (DirOpenSection prefix);
+  lib_state := { !lib_state with path_prefix = prefix };
   add_section ()
 
 
@@ -540,10 +566,9 @@ let discharge_item ((sp,_ as oname),e) =
   match e with
   | Leaf lobj ->
       Option.map (fun o -> (basename sp,o)) (discharge_object (oname,lobj))
-  | FrozenState _ -> None
   | ClosedSection _ | ClosedModule _ -> None
   | OpenedSection _ | OpenedModule _ | CompilingLibrary _ ->
-      anomaly (Pp.str "discharge_item")
+      anomaly (Pp.str "discharge_item.")
 
 let close_section () =
   let oname,fs =
@@ -551,14 +576,13 @@ let close_section () =
       | oname,OpenedSection (_,fs) -> oname,fs
       | _ -> assert false
     with Not_found ->
-      error "No opened section."
+      user_err Pp.(str  "No opened section.")
   in
   let (secdecls,mark,before) = split_lib_at_opening oname in
-  lib_stk := before;
-  let full_olddir = fst !path_prefix in
+  lib_state := { !lib_state with lib_stk = before };
+  let full_olddir = !lib_state.path_prefix.obj_dir in
   pop_path_prefix ();
   add_entry oname (ClosedSection (List.rev (mark::secdecls)));
-  if !Flags.xml_export then Hook.get f_xml_close_section (basename (fst oname));
   let newdecls = List.map discharge_item secdecls in
   Summary.unfreeze_summaries fs;
   List.iter (Option.iter (fun (id,o) -> add_discharged_leaf id o)) newdecls;
@@ -566,7 +590,7 @@ let close_section () =
 
 (* State and initialization. *)
 
-type frozen = Names.DirPath.t option * library_segment
+type frozen = lib_state
 
 let freeze ~marshallable =
   match marshallable with
@@ -581,30 +605,25 @@ let freeze ~marshallable =
         | n, ClosedModule _ -> Some (n,ClosedModule [])
         | n, OpenedSection (op, _) ->
                Some(n,OpenedSection(op,Summary.empty_frozen))
-        | n, ClosedSection _ -> Some (n,ClosedSection [])
-        | _, FrozenState _ -> None)
-      !lib_stk in
-    !comp_name, lib_stk
+        | n, ClosedSection _ -> Some (n,ClosedSection []))
+      !lib_state.lib_stk in
+    { !lib_state with lib_stk }
   | _ ->
-    !comp_name, !lib_stk
+    !lib_state
 
-let unfreeze (mn,stk) =
-  comp_name := mn;
-  lib_stk := stk;
-  recalc_path_prefix ()
+let unfreeze st = lib_state := st
 
 let init () =
-  unfreeze (None,[]);
-  Summary.init_summaries ();
-  add_frozen_state () (* Stores e.g. the keywords declared in g_*.ml4 *)
+  unfreeze initial_lib_state;
+  Summary.init_summaries ()
 
 (* Misc *)
 
 let mp_of_global = function
-  |VarRef id -> current_mp ()
-  |ConstRef cst -> Names.con_modpath cst
-  |IndRef ind -> Names.ind_modpath ind
-  |ConstructRef constr -> Names.constr_modpath constr
+  | VarRef id -> !lib_state.path_prefix.obj_mp
+  | ConstRef cst -> Names.Constant.modpath cst
+  | IndRef ind -> Names.ind_modpath ind
+  | ConstructRef constr -> Names.constr_modpath constr
 
 let rec dp_of_mp = function
   |Names.MPfile dp -> dp
@@ -626,12 +645,12 @@ let library_part = function
 (* Discharging names *)
 
 let con_defined_in_sec kn =
-  let _,dir,_ = Names.repr_con kn in
+  let _,dir,_ = Names.Constant.repr3 kn in
   not (Names.DirPath.is_empty dir) &&
   Names.DirPath.equal (pop_dirpath dir) (current_sections ())
 
 let defined_in_sec kn =
-  let _,dir,_ = Names.repr_mind kn in
+  let _,dir,_ = Names.MutInd.repr3 kn in
   not (Names.DirPath.is_empty dir) &&
   Names.DirPath.equal (pop_dirpath dir) (current_sections ())
 
@@ -652,3 +671,11 @@ let discharge_con cst =
 
 let discharge_inductive (kn,i) =
   (discharge_kn kn,i)
+
+let discharge_abstract_universe_context { abstr_subst = subst; abstr_uctx = abs_ctx } auctx =
+  let open Univ in
+  let ainst = make_abstract_instance auctx in
+  let subst = Instance.append subst ainst in
+  let subst = make_instance_subst subst in
+  let auctx = Univ.subst_univs_level_abstract_universe_context subst auctx in
+  subst, AUContext.union abs_ctx auctx
diff --git a/library/lib.mli b/library/lib.mli
index a8e110c6..26f1718c 100644
--- a/library/lib.mli
+++ b/library/lib.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 
@@ -23,7 +25,6 @@ type node =
   | ClosedModule  of library_segment
   | OpenedSection of Libnames.object_prefix * Summary.frozen
   | ClosedSection of library_segment
-  | FrozenState of Summary.frozen
 
 and library_segment = (Libnames.object_name * node) list
 
@@ -61,8 +62,6 @@ val pull_to_head : Libnames.object_name -> unit
    for each of them *)
 val add_leaves : Names.Id.t -> Libobject.obj list -> Libnames.object_name
 
-val add_frozen_state : unit -> unit
-
 (** {6 ... } *)
 
 (** The function [contents] gives access to the current entire segment *)
@@ -84,8 +83,8 @@ val make_path : Names.Id.t -> Libnames.full_path
 val make_path_except_section : Names.Id.t -> Libnames.full_path
 
 (** Kernel-side names *)
-val current_mp : unit -> Names.module_path
-val make_kn : Names.Id.t -> Names.kernel_name
+val current_mp : unit -> Names.ModPath.t
+val make_kn : Names.Id.t -> Names.KerName.t
 
 (** Are we inside an opened section *)
 val sections_are_opened : unit -> bool
@@ -106,11 +105,11 @@ val find_opening_node : Names.Id.t -> node
 (** {6 Modules and module types } *)
 
 val start_module :
-  export -> Names.module_ident -> Names.module_path ->
+  export -> Names.module_ident -> Names.ModPath.t ->
   Summary.frozen -> Libnames.object_prefix
 
 val start_modtype :
-  Names.module_ident -> Names.module_path ->
+  Names.module_ident -> Names.ModPath.t ->
   Summary.frozen -> Libnames.object_prefix
 
 val end_module :
@@ -123,11 +122,9 @@ val end_modtype :
   Libnames.object_name * Libnames.object_prefix *
     Summary.frozen * library_segment
 
-(** [Lib.add_frozen_state] must be called after each of the above functions *)
-
 (** {6 Compilation units } *)
 
-val start_compilation : Names.DirPath.t -> Names.module_path -> unit
+val start_compilation : Names.DirPath.t -> Names.ModPath.t -> unit
 val end_compilation_checks : Names.DirPath.t -> Libnames.object_name
 val end_compilation :
   Libnames.object_name-> Libnames.object_prefix * library_segment
@@ -137,8 +134,8 @@ val end_compilation :
 val library_dp : unit -> Names.DirPath.t
 
 (** Extract the library part of a name even if in a section *)
-val dp_of_mp : Names.module_path -> Names.DirPath.t
-val split_modpath : Names.module_path -> Names.DirPath.t * Names.Id.t list
+val dp_of_mp : Names.ModPath.t -> Names.DirPath.t
+val split_modpath : Names.ModPath.t -> Names.DirPath.t * Names.Id.t list
 val library_part :  Globnames.global_reference -> Names.DirPath.t
 
 (** {6 Sections } *)
@@ -155,37 +152,43 @@ val unfreeze : frozen -> unit
 
 val init : unit -> unit
 
-(** XML output hooks *)
-val xml_open_section : (Names.Id.t -> unit) Hook.t
-val xml_close_section : (Names.Id.t -> unit) Hook.t
-
 (** {6 Section management for discharge } *)
-type variable_info = Names.Id.t * Decl_kinds.binding_kind *
-    Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 type variable_context = variable_info list 
-type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
+type abstr_info = private {
+  abstr_ctx : variable_context;
+  (** Section variables of this prefix *)
+  abstr_subst : Univ.Instance.t;
+  (** Actual names of the abstracted variables *)
+  abstr_uctx : Univ.AUContext.t;
+  (** Universe quantification, same length as the substitution *)
+}
 
 val instance_from_variable_context : variable_context -> Names.Id.t array
 val named_of_variable_context : variable_context -> Context.Named.t
 
-val section_segment_of_constant : Names.constant -> abstr_info
-val section_segment_of_mutual_inductive: Names.mutual_inductive -> abstr_info
+val section_segment_of_constant : Names.Constant.t -> abstr_info
+val section_segment_of_mutual_inductive: Names.MutInd.t -> abstr_info
+val section_segment_of_reference : Globnames.global_reference -> abstr_info
+
 val variable_section_segment_of_reference : Globnames.global_reference -> variable_context
-                                                                                                     
-val section_instance : Globnames.global_reference -> Univ.universe_instance * Names.Id.t array
+
+val section_instance : Globnames.global_reference -> Univ.Instance.t * Names.Id.t array
 val is_in_section : Globnames.global_reference -> bool
 
-val add_section_variable : Names.Id.t -> Decl_kinds.binding_kind -> Decl_kinds.polymorphic -> Univ.universe_context_set -> unit
-val add_section_context : Univ.universe_context_set -> unit
+val add_section_variable : Names.Id.t -> Decl_kinds.binding_kind -> Decl_kinds.polymorphic -> Univ.ContextSet.t -> unit
+val add_section_context : Univ.ContextSet.t -> unit
 val add_section_constant : Decl_kinds.polymorphic ->
-  Names.constant -> Context.Named.t -> unit
+  Names.Constant.t -> Context.Named.t -> unit
 val add_section_kn : Decl_kinds.polymorphic ->
-  Names.mutual_inductive -> Context.Named.t -> unit
+  Names.MutInd.t -> Context.Named.t -> unit
 val replacement_context : unit -> Opaqueproof.work_list
 
 (** {6 Discharge: decrease the section level if in the current section } *)
 
-val discharge_kn :  Names.mutual_inductive -> Names.mutual_inductive
-val discharge_con : Names.constant -> Names.constant
+val discharge_kn :  Names.MutInd.t -> Names.MutInd.t
+val discharge_con : Names.Constant.t -> Names.Constant.t
 val discharge_global : Globnames.global_reference -> Globnames.global_reference
 val discharge_inductive : Names.inductive -> Names.inductive
+val discharge_abstract_universe_context :
+  abstr_info -> Univ.AUContext.t -> Univ.universe_level_subst * Univ.AUContext.t
diff --git a/library/libnames.ml b/library/libnames.ml
index dd74e192..d8473132 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -13,7 +15,7 @@ open Names
 
 (**********************************************)
 
-let pr_dirpath sl = str (DirPath.to_string sl)
+let pr_dirpath sl = DirPath.print sl
 
 (*s Operations on dirpaths *)
 
@@ -58,14 +60,14 @@ let add_dirpath_suffix p id = DirPath.make (id :: DirPath.repr p)
 let parse_dir s =
   let len = String.length s in
   let rec decoupe_dirs dirs n =
-    if Int.equal n len && n > 0 then error (s ^ " is an invalid path.");
+    if Int.equal n len && n > 0 then user_err Pp.(str @@ s ^ " is an invalid path.");
     if n >= len then dirs else
     let pos =
       try
 	String.index_from s n '.'
       with Not_found -> len
     in
-    if Int.equal pos n then error (s ^ " is an invalid path.");
+    if Int.equal pos n then user_err Pp.(str @@ s ^ " is an invalid path.");
     let dir = String.sub s n (pos-n) in
     decoupe_dirs ((Id.of_string dir)::dirs) (pos+1)
   in
@@ -154,12 +156,17 @@ let qualid_of_dirpath dir =
   let (l,a) = split_dirpath dir in
   make_qualid l a
 
-type object_name = full_path * kernel_name
+type object_name = full_path * KerName.t
 
-type object_prefix = DirPath.t * (module_path * DirPath.t)
+type object_prefix = {
+  obj_dir : DirPath.t;
+  obj_mp  : ModPath.t;
+  obj_sec : DirPath.t;
+}
 
-let make_oname (dirpath,(mp,dir)) id =
-  make_path dirpath id, make_kn mp dir (Label.of_id id)
+(* let make_oname (dirpath,(mp,dir)) id = *)
+let make_oname { obj_dir; obj_mp; obj_sec } id =
+  make_path obj_dir id, KerName.make obj_mp obj_sec (Label.of_id id)
 
 (* to this type are mapped DirPath.t's in the nametab *)
 type global_dir_reference =
@@ -170,10 +177,10 @@ type global_dir_reference =
   | DirClosedSection of DirPath.t
       (* this won't last long I hope! *)
 
-let eq_op (d1, (mp1, p1)) (d2, (mp2, p2)) =
-  DirPath.equal d1 d2 &&
-  DirPath.equal p1 p2 &&
-  mp_eq mp1 mp2
+let eq_op op1 op2 =
+  DirPath.equal op1.obj_dir op2.obj_dir &&
+  DirPath.equal op1.obj_sec op2.obj_sec &&
+  ModPath.equal op1.obj_mp  op2.obj_mp
 
 let eq_global_dir_reference r1 r2 = match r1, r2 with
 | DirOpenModule op1, DirOpenModule op2 -> eq_op op1 op2
@@ -183,54 +190,59 @@ let eq_global_dir_reference r1 r2 = match r1, r2 with
 | DirClosedSection dp1, DirClosedSection dp2 -> DirPath.equal dp1 dp2
 | _ -> false
 
-type reference =
-  | Qualid of qualid Loc.located
-  | Ident of Id.t Loc.located
+type reference_r =
+  | Qualid of qualid
+  | Ident of Id.t
+type reference = reference_r CAst.t
 
-let qualid_of_reference = function
-  | Qualid (loc,qid) -> loc, qid
-  | Ident (loc,id) -> loc, qualid_of_ident id
+let qualid_of_reference = CAst.map (function
+  | Qualid qid -> qid
+  | Ident id -> qualid_of_ident id)
 
-let string_of_reference = function
-  | Qualid (loc,qid) -> string_of_qualid qid
-  | Ident (loc,id) -> Id.to_string id
+let string_of_reference = CAst.with_val (function
+  | Qualid qid -> string_of_qualid qid
+  | Ident id -> Id.to_string id)
 
-let pr_reference = function
-  | Qualid (_,qid) -> pr_qualid qid
-  | Ident (_,id) -> Id.print id
+let pr_reference = CAst.with_val (function
+  | Qualid qid -> pr_qualid qid
+  | Ident id -> Id.print id)
 
-let loc_of_reference = function
-  | Qualid (loc,qid) -> loc
-  | Ident (loc,id) -> loc
-
-let eq_reference r1 r2 = match r1, r2 with
-| Qualid (_, q1), Qualid (_, q2) -> qualid_eq q1 q2
-| Ident (_, id1), Ident (_, id2) -> Id.equal id1 id2
+let eq_reference {CAst.v=r1} {CAst.v=r2} = match r1, r2 with
+| Qualid q1, Qualid q2 -> qualid_eq q1 q2
+| Ident id1, Ident id2 -> Id.equal id1 id2
 | _ -> false
 
-let join_reference ns r =
+let join_reference {CAst.loc=l1;v=ns} {CAst.loc=l2;v=r} =
+  CAst.make ?loc:(Loc.merge_opt l1 l2) (
   match ns , r with
-    Qualid (_, q1), Qualid (loc, q2) ->
+    Qualid q1, Qualid q2 ->
       let (dp1,id1) = repr_qualid q1 in
       let (dp2,id2) = repr_qualid q2 in
-      Qualid (loc,
-	      make_qualid
+      Qualid (make_qualid
 		(append_dirpath (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1))) dp2)
 		id2)
-  | Qualid (_, q1), Ident (loc, id2) ->
+  | Qualid q1, Ident id2 ->
     let (dp1,id1) = repr_qualid q1 in
-    Qualid (loc,
-	    make_qualid
+    Qualid (make_qualid
 	      (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1)))
 	      id2)
-  | Ident (_, id1), Qualid (loc, q2) ->
+  | Ident id1, Qualid q2 ->
     let (dp2,id2) = repr_qualid q2 in
-    Qualid (loc, make_qualid
+    Qualid (make_qualid
       (append_dirpath (dirpath_of_string (Names.Id.to_string id1)) dp2)
       id2)
-  | Ident (_, id1), Ident (loc, id2) ->
-    Qualid (loc, make_qualid
+  | Ident id1, Ident id2 ->
+    Qualid (make_qualid
       (dirpath_of_string (Names.Id.to_string id1)) id2)
+  )
+
+(* Default paths *)
+let default_library = Names.DirPath.initial (* = ["Top"] *)
+
+(*s Roots of the space of absolute names *)
+let coq_string = "Coq"
+let coq_root = Id.of_string coq_string
+let default_root_prefix = DirPath.empty
 
 (* Deprecated synonyms *)
 
diff --git a/library/libnames.mli b/library/libnames.mli
index 58d1da9d..9dad2612 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -1,23 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
-open Pp
-open Loc
 open Names
 
 (** {6 Dirpaths } *)
-(** FIXME: ought to be in Names.dir_path *)
+val dirpath_of_string : string -> DirPath.t
 
-val pr_dirpath : DirPath.t -> Pp.std_ppcmds
+val pr_dirpath : DirPath.t -> Pp.t
+[@@ocaml.deprecated "Alias for DirPath.print"]
 
-val dirpath_of_string : string -> DirPath.t
 val string_of_dirpath : DirPath.t -> string
+[@@ocaml.deprecated "Alias for DirPath.to_string"]
 
 (** Pop the suffix of a [DirPath.t]. Raises a [Failure] for an empty path *)
 val pop_dirpath : DirPath.t -> DirPath.t
@@ -58,7 +59,7 @@ val basename : full_path -> Id.t
 (** Parsing and printing of section path as ["coq_root.module.id"] *)
 val path_of_string : string -> full_path
 val string_of_path : full_path -> string
-val pr_path : full_path -> std_ppcmds
+val pr_path : full_path -> Pp.t
 
 module Spmap  : CSig.MapS with type key = full_path
 
@@ -77,7 +78,7 @@ val repr_qualid : qualid -> DirPath.t * Id.t
 
 val qualid_eq : qualid -> qualid -> bool
 
-val pr_qualid : qualid -> std_ppcmds
+val pr_qualid : qualid -> Pp.t
 val string_of_qualid : qualid -> string
 val qualid_of_string : string -> qualid
 
@@ -92,9 +93,27 @@ val qualid_of_ident : Id.t -> qualid
    can be substituted and a "syntactic" [full_path] which can be printed
 *)
 
-type object_name = full_path * kernel_name
+type object_name = full_path * KerName.t
+
+(** Object prefix morally contains the "prefix" naming of an object to
+   be stored by [library], where [obj_dir] is the "absolute" path,
+   [obj_mp] is the current "module" prefix and [obj_sec] is the
+   "section" prefix.
+
+    Thus, for an object living inside [Module A. Section B.] the
+   prefix would be:
+
+    [ { obj_dir = "A.B"; obj_mp = "A"; obj_sec = "B" } ]
+
+    Note that both [obj_dir] and [obj_sec] are "paths" that is to say,
+   as opposed to [obj_mp] which is a single module name.
 
-type object_prefix = DirPath.t * (module_path * DirPath.t)
+ *)
+type object_prefix = {
+  obj_dir : DirPath.t;
+  obj_mp  : ModPath.t;
+  obj_sec : DirPath.t;
+}
 
 val eq_op : object_prefix -> object_prefix -> bool
 
@@ -117,18 +136,31 @@ val eq_global_dir_reference :
     global name (referred either by a qualified name or by a single
     name) or a variable *)
 
-type reference =
-  | Qualid of qualid located
-  | Ident of Id.t located
+type reference_r =
+  | Qualid of qualid
+  | Ident of Id.t
+type reference = reference_r CAst.t
 
 val eq_reference : reference -> reference -> bool
-val qualid_of_reference : reference -> qualid located
+val qualid_of_reference : reference -> qualid CAst.t
 val string_of_reference : reference -> string
-val pr_reference : reference -> std_ppcmds
-val loc_of_reference : reference -> Loc.t
+val pr_reference : reference -> Pp.t
 val join_reference : reference -> reference -> reference
 
-(** Deprecated synonyms *)
+(** some preset paths *)
+val default_library : DirPath.t
+
+(** This is the root of the standard library of Coq *)
+val coq_root : module_ident (** "Coq" *)
+val coq_string : string (** "Coq" *)
+
+(** This is the default root prefix for developments which doesn't
+   mention a root *)
+val default_root_prefix : DirPath.t
 
+(** Deprecated synonyms *)
 val make_short_qualid : Id.t -> qualid (** = qualid_of_ident *)
+[@@ocaml.deprecated "Alias for qualid_of_ident"]
+
 val qualid_of_sp : full_path -> qualid (** = qualid_of_path *)
+[@@ocaml.deprecated "Alias for qualid_of_sp"]
diff --git a/library/libobject.ml b/library/libobject.ml
index caa03c85..c5cd0152 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -1,16 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Libnames
 open Pp
-open Util
 
-module Dyn = Dyn.Make(struct end)
+module Dyn = Dyn.Make ()
 
 type 'a substitutivity =
     Dispose | Substitute of 'a | Keep of 'a | Anticipate of 'a
@@ -91,16 +92,8 @@ let declare_object_full odecl =
 			     dyn_rebuild_function = rebuild };
   (infun,outfun)
 
-(* The "try .. with .. " allows for correct printing when calling
-   declare_object a loading time.
-*)
-
-let declare_object odecl =
-  try fst (declare_object_full odecl)
-  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
-let declare_object_full odecl =
-  try declare_object_full odecl
-  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
+let declare_object odecl = fst (declare_object_full odecl)
+let declare_object_full odecl = declare_object_full odecl
 
 (* this function describes how the cache, load, open, and export functions
    are triggered. *)
diff --git a/library/libobject.mli b/library/libobject.mli
index 51b9af05..aefa81b2 100644
--- a/library/libobject.mli
+++ b/library/libobject.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Libnames
@@ -56,6 +58,9 @@ open Mod_subst
      rebuild the non volatile content of a section from the data
      collected by the discharge function
 
+  Any type defined as a persistent object must be pure (e.g. no references) and
+  marshallable by the OCaml Marshal module (e.g. no closures).
+
 *)
 
 type 'a substitutivity =
diff --git a/library/library.ml b/library/library.ml
index d44f796a..56d2709d 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -12,9 +14,8 @@ open Util
 
 open Names
 open Libnames
-open Nameops
-open Libobject
 open Lib
+open Libobject
 
 (************************************************************************)
 (*s Low-level interning/externing of libraries to files *)
@@ -97,7 +98,7 @@ type library_t = {
   library_deps : (compilation_unit_name * Safe_typing.vodigest) array;
   library_imports : compilation_unit_name array;
   library_digests : Safe_typing.vodigest;
-  library_extra_univs : Univ.universe_context_set;
+  library_extra_univs : Univ.ContextSet.t;
 }
 
 type library_summary = {
@@ -131,8 +132,8 @@ let find_library dir =
 let try_find_library dir =
   try find_library dir
   with Not_found ->
-    errorlabstrm "Library.find_library"
-      (str "Unknown library " ++ pr_dirpath dir)
+    user_err ~hdr:"Library.find_library"
+      (str "Unknown library " ++ DirPath.print dir)
 
 let register_library_filename dir f =
   (* Not synchronized: overwrite the previous binding if one existed *)
@@ -171,7 +172,7 @@ let register_loaded_library m =
     let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in
     let f = prefix ^ "cmo" in
     let f = Dynlink.adapt_filename f in
-    if not Coq_config.no_native_compiler then
+    if Coq_config.native_compiler then
       Nativelib.link_library ~prefix ~dirname ~basename:f
   in
   let rec aux = function
@@ -329,12 +330,12 @@ let locate_qualified_library ?root ?(warn = true) qid =
 
 let error_unmapped_dir qid =
   let prefix, _ = repr_qualid qid in
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str "Cannot load " ++ pr_qualid qid ++ str ":" ++ spc () ++
-     str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++ fnl ())
+     str "no physical path bound to" ++ spc () ++ DirPath.print prefix ++ fnl ())
 
 let error_lib_not_found qid =
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str"Cannot find library " ++ pr_qualid qid ++ str" in loadpath")
 
 let try_locate_absolute_library dir =
@@ -360,9 +361,9 @@ type 'a table_status =
   | Fetched of 'a Future.computation array
 
 let opaque_tables =
-  ref (LibraryMap.empty : (Term.constr table_status) LibraryMap.t)
+  ref (LibraryMap.empty : (Constr.constr table_status) LibraryMap.t)
 let univ_tables =
-  ref (LibraryMap.empty : (Univ.universe_context_set table_status) LibraryMap.t)
+  ref (LibraryMap.empty : (Univ.ContextSet.t table_status) LibraryMap.t)
 
 let add_opaque_table dp st =
   opaque_tables := LibraryMap.add dp st !opaque_tables
@@ -378,7 +379,7 @@ let access_table what tables dp i =
       let t =
         try fetch_delayed f
         with Faulty f ->
-          errorlabstrm "Library.access_table"
+          user_err ~hdr:"Library.access_table"
             (str "The file " ++ str f ++ str " (bound to " ++ str dir_path ++
              str ") is inaccessible or corrupted,\ncannot load some " ++
              str what ++ str " in it.\n")
@@ -408,9 +409,9 @@ let () =
 type seg_sum = summary_disk
 type seg_lib = library_disk
 type seg_univ = (* true = vivo, false = vi *)
-  Univ.universe_context_set Future.computation array * Univ.universe_context_set * bool
+  Univ.ContextSet.t Future.computation array * Univ.ContextSet.t * bool
 type seg_discharge = Opaqueproof.cooking_info list array
-type seg_proofs = Term.constr Future.computation array
+type seg_proofs = Constr.constr Future.computation array
 
 let mk_library sd md digests univs =
   {
@@ -463,10 +464,10 @@ let rec intern_library (needed, contents) (dir, f) from =
   let f = match f with Some f -> f | None -> try_locate_absolute_library dir in
   let m = intern_from_file f in
   if not (DirPath.equal dir m.library_name) then
-    errorlabstrm "load_physical_library"
+    user_err ~hdr:"load_physical_library"
       (str "The file " ++ str f ++ str " contains library" ++ spc () ++
-       pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
-       spc() ++ pr_dirpath dir);
+       DirPath.print m.library_name ++ spc () ++ str "and not library" ++
+       spc() ++ DirPath.print dir);
   Feedback.feedback (Feedback.FileLoaded(DirPath.to_string dir, f));
   m.library_digests, intern_library_deps (needed, contents) dir m f
 
@@ -477,9 +478,9 @@ and intern_library_deps libs dir m from =
 and intern_mandatory_library caller from libs (dir,d) =
   let digest, libs = intern_library libs (dir, None) (Some from) in
   if not (Safe_typing.digest_match ~actual:digest ~required:d) then
-    errorlabstrm "" (str "Compiled library " ++ pr_dirpath caller ++
+    user_err (str "Compiled library " ++ DirPath.print caller ++
     str " (in file " ++ str from ++ str ") makes inconsistent assumptions \
-    over library " ++ pr_dirpath dir);
+    over library " ++ DirPath.print dir);
   libs
 
 let rec_intern_library libs (dir, f) =
@@ -551,8 +552,6 @@ let in_require : require_obj -> obj =
 (* Require libraries, import them if [export <> None], mark them for export
    if [export = Some true] *)
 
-let (f_xml_require, xml_require) = Hook.make ~default:ignore ()
-
 let warn_require_in_module =
   CWarnings.create ~name:"require-in-module" ~category:"deprecated"
                    (fun () -> strbrk "Require inside a module is" ++
@@ -574,16 +573,15 @@ let require_library_from_dirpath modrefl export =
       end
     else
       add_anonymous_leaf (in_require (needed,modrefl,export));
-    if !Flags.xml_export then List.iter (Hook.get f_xml_require) modrefl;
-  add_frozen_state ()
+  ()
 
 (* the function called by Vernacentries.vernac_import *)
 
-let safe_locate_module (loc,qid) =
+let safe_locate_module {CAst.loc;v=qid} =
   try Nametab.locate_module qid
   with Not_found ->
-    user_err_loc
-      (loc,"import_library", pr_qualid qid ++ str " is not a module")
+    user_err ?loc ~hdr:"import_library"
+      (pr_qualid qid ++ str " is not a module")
 
 let import_module export modl =
   (* Optimization: libraries in a raw in the list are imported
@@ -597,7 +595,7 @@ let import_module export modl =
     | [] -> ()
     | modl -> add_anonymous_leaf (in_import_library (List.rev modl, export)) in
   let rec aux acc = function
-    | (loc,dir as m) :: l ->
+    | ({CAst.loc; v=dir} as m) :: l ->
         let m,acc =
           try Nametab.locate_module dir, acc
           with Not_found-> flush acc; safe_locate_module m, [] in
@@ -607,8 +605,8 @@ let import_module export modl =
             flush acc;
             try Declaremods.import_module export mp; aux [] l
             with Not_found ->
-              user_err_loc (loc,"import_library",
-                pr_qualid dir ++ str " is not a module"))
+              user_err ?loc ~hdr:"import_library"
+                (pr_qualid dir ++ str " is not a module"))
     | [] -> flush acc
   in aux [] modl
 
@@ -619,39 +617,19 @@ let check_coq_overwriting p id =
   let l = DirPath.repr p in
   let is_empty = match l with [] -> true | _ -> false in
   if not !Flags.boot && not is_empty && Id.equal (List.last l) coq_root then
-    errorlabstrm ""
-      (str "Cannot build module " ++ pr_dirpath p ++ str "." ++ pr_id id ++ str "." ++ spc () ++
+    user_err 
+      (str "Cannot build module " ++ DirPath.print p ++ str "." ++ Id.print id ++ str "." ++ spc () ++
       str "it starts with prefix \"Coq\" which is reserved for the Coq library.")
 
-(* Verifies that a string starts by a letter and do not contain
-   others caracters than letters, digits, or `_` *)
-
-let check_module_name s =
-  let msg c =
-    strbrk "Invalid module name: " ++ str s ++ strbrk " character " ++
-    (if c = '\'' then str "\"'\"" else (str "'" ++ str (String.make 1 c) ++ str "'")) ++
-    strbrk " is not allowed in module names\n"
-  in
-  let err c = errorlabstrm "" (msg c) in
-  match String.get s 0 with
-    | 'a' .. 'z' | 'A' .. 'Z' ->
-        for i = 1 to (String.length s)-1 do
-          match String.get s i with
-            | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_'  -> ()
-            | c -> err c
-        done
-    | c -> err c
-
 let start_library fo =
   let ldir0 =
     try
       let lp = Loadpath.find_load_path (Filename.dirname fo) in
       Loadpath.logical lp
-    with Not_found -> Nameops.default_root_prefix
+    with Not_found -> Libnames.default_root_prefix
   in
   let file = Filename.chop_extension (Filename.basename fo) in
   let id = Id.of_string file in
-  check_module_name file;
   check_coq_overwriting ldir0 id;
   let ldir = add_dirpath_suffix ldir0 id in
   Declaremods.start_library ldir;
@@ -668,10 +646,10 @@ let load_library_todo f =
   let tasks, _, _ = System.marshal_in_segment f ch in
   let (s5 : seg_proofs), _, _ = System.marshal_in_segment f ch in
   close_in ch;
-  if tasks = None then errorlabstrm "restart" (str"not a .vio file");
-  if s2 = None then errorlabstrm "restart" (str"not a .vio file");
-  if s3 = None then errorlabstrm "restart" (str"not a .vio file");
-  if pi3 (Option.get s2) then errorlabstrm "restart" (str"not a .vio file");
+  if tasks = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s2 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s3 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if pi3 (Option.get s2) then user_err ~hdr:"restart" (str"not a .vio file");
   longf, s0, s1, Option.get s2, Option.get s3, Option.get tasks, s5
 
 (************************************************************************)
@@ -687,8 +665,8 @@ let current_deps () =
 let current_reexports () = !libraries_exports_list
 
 let error_recursively_dependent_library dir =
-  errorlabstrm ""
-    (strbrk "Unable to use logical name " ++ pr_dirpath dir ++
+  user_err 
+    (strbrk "Unable to use logical name " ++ DirPath.print dir ++
      strbrk " to save current library because" ++
      strbrk " it already depends on a library of this name.")
 
@@ -706,7 +684,8 @@ let error_recursively_dependent_library dir =
 let save_library_to ?todo dir f otab =
   let except = match todo with
     | None ->
-        assert(!Flags.compilation_mode = Flags.BuildVo);
+        (* XXX *)
+        (* assert(!Flags.compilation_mode = Flags.BuildVo); *)
         assert(Filename.check_suffix f ".vo");
         Future.UUIDSet.empty
     | Some (l,_) ->
@@ -734,7 +713,7 @@ let save_library_to ?todo dir f otab =
       except Int.Set.empty in
   let is_done_or_todo i x = Future.is_val x || Int.Set.mem i except in
   Array.iteri (fun i x ->
-    if not(is_done_or_todo i x) then CErrors.errorlabstrm "library"
+    if not(is_done_or_todo i x) then CErrors.user_err ~hdr:"library"
       Pp.(str"Proof object "++int i++str" is not checked nor to be checked"))
     opaque_table;
   let sd = {
@@ -761,10 +740,10 @@ let save_library_to ?todo dir f otab =
     System.marshal_out_segment f' ch (opaque_table : seg_proofs);
     close_out ch;
     (* Writing native code files *)
-    if !Flags.native_compiler then
+    if !Flags.output_native_objects then
       let fn = Filename.dirname f'^"/"^Nativecode.mod_uid_of_dirpath dir in
       if not (Nativelib.compile_library dir ast fn) then
-	error "Could not compile the library to native code."
+	user_err Pp.(str "Could not compile the library to native code.")
    with reraise ->
     let reraise = CErrors.push reraise in
     let () = Feedback.msg_warning (str "Removed file " ++ str f') in
diff --git a/library/library.mli b/library/library.mli
index b9044b60..0877ebb5 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Loc
 open Names
 open Libnames
 
@@ -29,13 +30,13 @@ val require_library_from_dirpath : (DirPath.t * string) list -> bool option -> u
 type seg_sum
 type seg_lib
 type seg_univ = (* cst, all_cst, finished? *)
-  Univ.universe_context_set Future.computation array * Univ.universe_context_set * bool
+  Univ.ContextSet.t Future.computation array * Univ.ContextSet.t * bool
 type seg_discharge = Opaqueproof.cooking_info list array
-type seg_proofs = Term.constr Future.computation array
+type seg_proofs = Constr.constr Future.computation array
 
 (** Open a module (or a library); if the boolean is true then it's also
    an export otherwise just a simple import *)
-val import_module : bool -> qualid located list -> unit
+val import_module : bool -> qualid CAst.t list -> unit
 
 (** Start the compilation of a file as a library. The first argument must be
     output file, and the 
@@ -67,9 +68,6 @@ val library_full_filename : DirPath.t -> string
   (** - Overwrite the filename of all libraries (used when restoring a state) *)
 val overwrite_library_filenames : string -> unit
 
-(** {6 Hook for the xml exportation of libraries } *)
-val xml_require : (DirPath.t -> unit) Hook.t
-
 (** {6 Locate a library in the load paths } *)
 exception LibUnmappedDir
 exception LibNotFound
diff --git a/library/library.mllib b/library/library.mllib
index 92065736..e43bfb5a 100644
--- a/library/library.mllib
+++ b/library/library.mllib
@@ -1,11 +1,9 @@
-Nameops
 Libnames
 Globnames
 Libobject
 Summary
 Nametab
 Global
-Universes
 Lib
 Declaremods
 Loadpath
@@ -17,3 +15,4 @@ Goptions
 Decls
 Heads
 Keys
+Coqlib
diff --git a/library/loadpath.ml b/library/loadpath.ml
index d03c6c55..fc13c864 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
@@ -29,7 +31,7 @@ let physical p = p.path_physical
 let get_load_paths () = !load_paths
 
 let anomaly_too_many_paths path =
-  anomaly (str "Several logical paths are associated to" ++ spc () ++ str path)
+  anomaly (str "Several logical paths are associated to" ++ spc () ++ str path ++ str ".")
 
 let find_load_path phys_dir =
   let phys_dir = CUnix.canonical_path_name phys_dir in
@@ -54,8 +56,8 @@ let warn_overriding_logical_loadpath =
   CWarnings.create ~name:"overriding-logical-loadpath" ~category:"loadpath"
          (fun (phys_path, old_path, coq_path) ->
           str phys_path ++ strbrk " was previously bound to " ++
-            pr_dirpath old_path ++ strbrk "; it is remapped to " ++
-            pr_dirpath coq_path)
+            DirPath.print old_path ++ strbrk "; it is remapped to " ++
+            DirPath.print coq_path)
 
 let add_load_path phys_path coq_path ~implicit =
   let phys_path = CUnix.canonical_path_name phys_path in
@@ -75,7 +77,7 @@ let add_load_path phys_path coq_path ~implicit =
       else
         let () =
           (* Do not warn when overriding the default "-I ." path *)
-          if not (DirPath.equal old_path Nameops.default_root_prefix) then
+          if not (DirPath.equal old_path Libnames.default_root_prefix) then
           warn_overriding_logical_loadpath (phys_path, old_path, coq_path)
         in
         true in
@@ -113,5 +115,5 @@ let expand_path ?root dir =
 let locate_file fname =
   let paths = List.map physical !load_paths in
   let _,longfname =
-    System.find_file_in_path ~warn:(Flags.is_verbose()) paths fname in
+    System.find_file_in_path ~warn:(not !Flags.quiet) paths fname in
   longfname
diff --git a/library/loadpath.mli b/library/loadpath.mli
index 4e79edbd..4044ca11 100644
--- a/library/loadpath.mli
+++ b/library/loadpath.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Names
diff --git a/library/nameops.ml b/library/nameops.ml
deleted file mode 100644
index 71405d02..00000000
--- a/library/nameops.ml
+++ /dev/null
@@ -1,155 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open Names
-
-(* Identifiers *)
-
-let pr_id id = Id.print id
-
-let pr_name = function
-  | Anonymous -> str "_"
-  | Name id -> pr_id id
-
-(* Utilities *)
-
-let code_of_0 = Char.code '0'
-let code_of_9 = Char.code '9'
-
-let cut_ident skip_quote s =
-  let s = Id.to_string s in
-  let slen = String.length s in
-  (* [n'] is the position of the first non nullary digit *)
-  let rec numpart n n' =
-    if Int.equal n 0 then
-      (* ident made of _ and digits only [and ' if skip_quote]: don't cut it *)
-      slen
-    else
-      let c = Char.code (String.get s (n-1)) in
-      if Int.equal c code_of_0 && not (Int.equal n slen) then
-	numpart (n-1) n'
-      else if code_of_0 <= c && c <= code_of_9 then
-	numpart (n-1) (n-1)
-      else if skip_quote && (Int.equal c (Char.code '\'') || Int.equal c (Char.code '_')) then
-	numpart (n-1) (n-1)
-      else
-	n'
-  in
-  numpart slen slen
-
-let repr_ident s =
-  let numstart = cut_ident false s in
-  let s = Id.to_string s in
-  let slen = String.length s in
-  if Int.equal numstart slen then
-    (s, None)
-  else
-    (String.sub s 0 numstart,
-     Some (int_of_string (String.sub s numstart (slen - numstart))))
-
-let make_ident sa = function
-  | Some n ->
-      let c = Char.code (String.get sa (String.length sa -1)) in
-      let s =
-        if c < code_of_0 || c > code_of_9 then sa ^ (string_of_int n)
-        else sa ^ "_" ^ (string_of_int n) in
-      Id.of_string s
-  | None -> Id.of_string (String.copy sa)
-
-let root_of_id id =
-  let suffixstart = cut_ident true id in
-  Id.of_string (String.sub (Id.to_string id) 0 suffixstart)
-
-(* Rem: semantics is a bit different, if an ident starts with toto00 then
-  after successive renamings it comes to toto09, then it goes on with toto10 *)
-let lift_subscript id =
-  let id = Id.to_string id in
-  let len = String.length id in
-  let rec add carrypos =
-    let c = id.[carrypos] in
-    if is_digit c then
-      if Int.equal (Char.code c) (Char.code '9') then begin
-	assert (carrypos>0);
-	add (carrypos-1)
-      end
-      else begin
-	let newid = String.copy id in
-	String.fill newid (carrypos+1) (len-1-carrypos) '0';
-	newid.[carrypos] <- Char.chr (Char.code c + 1);
-	newid
-      end
-    else begin
-      let newid = id^"0" in
-      if carrypos < len-1 then begin
-	String.fill newid (carrypos+1) (len-1-carrypos) '0';
-	newid.[carrypos+1] <- '1'
-      end;
-      newid
-    end
-  in Id.of_string (add (len-1))
-
-let has_subscript id =
-  let id = Id.to_string id in
-  is_digit (id.[String.length id - 1])
-
-let forget_subscript id =
-  let numstart = cut_ident false id in
-  let newid = String.make (numstart+1) '0' in
-  String.blit (Id.to_string id) 0 newid 0 numstart;
-  (Id.of_string newid)
-
-let add_suffix id s = Id.of_string (Id.to_string id ^ s)
-let add_prefix s id = Id.of_string (s ^ Id.to_string id)
-
-let atompart_of_id id = fst (repr_ident id)
-
-(* Names *)
-
-let out_name = function
-  | Name id -> id
-  | Anonymous -> failwith "Nameops.out_name"
-
-let name_fold f na a =
-  match na with
-  | Name id -> f id a
-  | Anonymous -> a
-
-let name_iter f na = name_fold (fun x () -> f x) na ()
-
-let name_cons na l =
-  match na with
-  | Anonymous -> l
-  | Name id -> id::l
-
-let name_app f = function
-  | Name id -> Name (f id)
-  | Anonymous -> Anonymous
-
-let name_fold_map f e = function
-  | Name id -> let (e,id) = f e id in (e,Name id)
-  | Anonymous -> e,Anonymous
-
-let name_max na1 na2 =
-  match na1 with
-  | Name _ -> na1
-  | Anonymous -> na2
-
-let pr_lab l = Label.print l
-
-let default_library = Names.DirPath.initial (* = ["Top"] *)
-
-(*s Roots of the space of absolute names *)
-let coq_string = "Coq"
-let coq_root = Id.of_string coq_string
-let default_root_prefix = DirPath.empty
-
-(* Metavariables *)
-let pr_meta = Pp.int
-let string_of_meta = string_of_int
diff --git a/library/nameops.mli b/library/nameops.mli
deleted file mode 100644
index 39ce409b..00000000
--- a/library/nameops.mli
+++ /dev/null
@@ -1,55 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-
-(** Identifiers and names *)
-val pr_id : Id.t -> Pp.std_ppcmds
-val pr_name : Name.t -> Pp.std_ppcmds
-
-val make_ident : string -> int option -> Id.t
-val repr_ident : Id.t -> string * int option
-
-val atompart_of_id : Id.t -> string  (** remove trailing digits *)
-val root_of_id : Id.t -> Id.t (** remove trailing digits, ' and _ *)
-
-val add_suffix : Id.t -> string -> Id.t
-val add_prefix : string -> Id.t -> Id.t
-
-val has_subscript    : Id.t -> bool
-val lift_subscript   : Id.t -> Id.t
-val forget_subscript : Id.t -> Id.t
-
-val out_name : Name.t -> Id.t
-(** [out_name] associates [id] to [Name id]. Raises [Failure "Nameops.out_name"]
-    otherwise. *)
-
-val name_fold : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a
-val name_iter : (Id.t -> unit) -> Name.t -> unit
-val name_cons : Name.t -> Id.t list -> Id.t list
-val name_app : (Id.t -> Id.t) -> Name.t -> Name.t
-val name_fold_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t
-val name_max : Name.t -> Name.t -> Name.t
-
-val pr_lab : Label.t -> Pp.std_ppcmds
-
-(** some preset paths *)
-
-val default_library : DirPath.t
-
-(** This is the root of the standard library of Coq *)
-val coq_root : module_ident (** "Coq" *)
-val coq_string : string (** "Coq" *)
-
-(** This is the default root prefix for developments which doesn't
-   mention a root *)
-val default_root_prefix : DirPath.t
-
-(** Metavariables *)
-val pr_meta : Term.metavariable -> Pp.std_ppcmds
-val string_of_meta : Term.metavariable -> string
diff --git a/library/nametab.ml b/library/nametab.ml
index fa5db37e..2046bf75 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open CErrors
@@ -16,14 +18,8 @@ open Globnames
 
 exception GlobalizationError of qualid
 
-let error_global_not_found_loc loc q =
-  Loc.raise loc (GlobalizationError q)
-
-let error_global_not_found q = raise (GlobalizationError q)
-
-(* Kinds of global names *)
-
-type ltac_constant = kernel_name
+let error_global_not_found {CAst.loc;v} =
+  Loc.raise ?loc (GlobalizationError v)
 
 (* The visibility can be registered either
    - for all suffixes not shorter then a given int - when the object
@@ -87,8 +83,9 @@ struct
      Module F (X : S). Module X.
      The argument X of the functor F is masked by the inner module X.
    *)
-  let masking_absolute n =
-    Flags.if_verbose Feedback.msg_info (str ("Trying to mask the absolute name \"" ^ U.to_string n ^ "\"!"))
+  let warn_masking_absolute =
+    CWarnings.create ~name:"masking-absolute-name" ~category:"deprecated"
+      (fun n -> str ("Trying to mask the absolute name \"" ^ U.to_string n ^ "\"!"))
 
   type user_name = U.t
 
@@ -127,7 +124,7 @@ struct
 	      | Absolute (n,_) ->
 		  (* This is an absolute name, we must keep it
 		     otherwise it may become unaccessible forever *)
-                masking_absolute n; tree.path
+                warn_masking_absolute n; tree.path
 	      | Nothing
 	      | Relative _ -> Relative (uname,o)
           else tree.path
@@ -145,8 +142,8 @@ struct
 		(* This is an absolute name, we must keep it otherwise it may
 		   become unaccessible forever *)
 		(* But ours is also absolute! This is an error! *)
-		error ("Cannot mask the absolute name \""
-		       ^ U.to_string uname' ^ "\"!")
+		user_err Pp.(str @@ "Cannot mask the absolute name \""
+                                   ^ U.to_string uname' ^ "\"!")
 	  | Nothing
 	  | Relative _ -> mktree (Absolute (uname,o)) tree.map
 
@@ -160,7 +157,7 @@ let rec push_exactly uname o level tree = function
         | Absolute (n,_) ->
             (* This is an absolute name, we must keep it
                 otherwise it may become unaccessible forever *)
-            masking_absolute n; tree.path
+            warn_masking_absolute n; tree.path
         | Nothing
         | Relative _ -> Relative (uname,o)
     in
@@ -276,19 +273,14 @@ struct
 end
 
 module ExtRefEqual = ExtRefOrdered
-module KnEqual = Names.KerName
 module MPEqual = Names.ModPath
 
 module ExtRefTab = Make(FullPath)(ExtRefEqual)
-module KnTab = Make(FullPath)(KnEqual)
 module MPTab = Make(FullPath)(MPEqual)
 
 type ccitab = ExtRefTab.t
 let the_ccitab = ref (ExtRefTab.empty : ccitab)
 
-type kntab = KnTab.t
-let the_tactictab = ref (KnTab.empty : kntab)
-
 type mptab = MPTab.t
 let the_modtypetab = ref (MPTab.empty : mptab)
 
@@ -296,7 +288,7 @@ module DirPath' =
 struct
   include DirPath
   let repr dir = match DirPath.repr dir with
-    | [] -> anomaly (Pp.str "Empty dirpath")
+    | [] -> anomaly (Pp.str "Empty dirpath.")
     | id :: l -> (id, l)
 end
 
@@ -313,6 +305,16 @@ module DirTab = Make(DirPath')(GlobDir)
 type dirtab = DirTab.t
 let the_dirtab = ref (DirTab.empty : dirtab)
 
+type universe_id = DirPath.t * int
+
+module UnivIdEqual =
+struct
+  type t = universe_id
+  let equal (d, i) (d', i') = DirPath.equal d d' && Int.equal i i'
+end
+module UnivTab = Make(FullPath)(UnivIdEqual)
+type univtab = UnivTab.t
+let the_univtab = ref (UnivTab.empty : univtab)
 
 (* Reversed name tables ***************************************************)
 
@@ -329,9 +331,20 @@ let the_modrevtab = ref (MPmap.empty : mprevtab)
 type mptrevtab = full_path MPmap.t
 let the_modtyperevtab = ref (MPmap.empty : mptrevtab)
 
-type knrevtab = full_path KNmap.t
-let the_tacticrevtab = ref (KNmap.empty : knrevtab)
+module UnivIdOrdered =
+struct
+  type t = universe_id
+  let hash (d, i) = i + DirPath.hash d
+  let compare (d, i) (d', i') =
+    let c = Int.compare i i' in
+    if Int.equal c 0 then DirPath.compare d d'
+    else c
+end
+
+module UnivIdMap = HMap.Make(UnivIdOrdered)
 
+type univrevtab = full_path UnivIdMap.t
+let the_univrevtab = ref (UnivIdMap.empty : univrevtab)
 
 (* Push functions *********************************************************)
 
@@ -370,20 +383,18 @@ let push_modtype vis sp kn =
   the_modtypetab := MPTab.push vis sp kn !the_modtypetab;
   the_modtyperevtab := MPmap.add kn sp !the_modtyperevtab
 
-(* This is for tactic definition names *)
-
-let push_tactic vis sp kn =
-  the_tactictab := KnTab.push vis sp kn !the_tactictab;
-  the_tacticrevtab := KNmap.add kn sp !the_tacticrevtab
-
-
 (* This is to remember absolute Section/Module names and to avoid redundancy *)
 let push_dir vis dir dir_ref =
   the_dirtab := DirTab.push vis dir dir_ref !the_dirtab;
   match dir_ref with
-      DirModule (_,(mp,_)) -> the_modrevtab := MPmap.add mp dir !the_modrevtab
-    | _ -> ()
+  | DirModule { obj_mp; _ } -> the_modrevtab := MPmap.add obj_mp dir !the_modrevtab
+  | _ -> ()
+
+(* This is for global universe names *)
 
+let push_universe vis sp univ =
+  the_univtab := UnivTab.push vis sp univ !the_univtab;
+  the_univrevtab := UnivIdMap.add univ sp !the_univrevtab
 
 (* Locate functions *******************************************************)
 
@@ -404,23 +415,23 @@ let locate_syndef qid = match locate_extended qid with
 let locate_modtype qid = MPTab.locate qid !the_modtypetab
 let full_name_modtype qid = MPTab.user_name qid !the_modtypetab
 
-let locate_tactic qid = KnTab.locate qid !the_tactictab
+let locate_universe qid = UnivTab.locate qid !the_univtab
 
 let locate_dir qid = DirTab.locate qid !the_dirtab
 
 let locate_module qid =
   match locate_dir qid with
-    | DirModule (_,(mp,_)) -> mp
+    | DirModule { obj_mp ; _} -> obj_mp
     | _ -> raise Not_found
 
 let full_name_module qid =
   match locate_dir qid with
-    | DirModule (dir,_) -> dir
+    | DirModule { obj_dir ; _} -> obj_dir
     | _ -> raise Not_found
 
 let locate_section qid =
   match locate_dir qid with
-    | DirOpenSection (dir, _)
+    | DirOpenSection { obj_dir; _ } -> obj_dir
     | DirClosedSection dir -> dir
     | _ -> raise Not_found
 
@@ -430,8 +441,6 @@ let locate_all qid =
 
 let locate_extended_all qid = ExtRefTab.find_prefixes qid !the_ccitab
 
-let locate_extended_all_tactic qid = KnTab.find_prefixes qid !the_tactictab
-
 let locate_extended_all_dir qid = DirTab.find_prefixes qid !the_dirtab
 
 let locate_extended_all_modtype qid = MPTab.find_prefixes qid !the_modtypetab
@@ -450,16 +459,16 @@ let global_of_path sp =
 
 let extended_global_of_path sp = ExtRefTab.find sp !the_ccitab
 
-let global r =
-  let (loc,qid) = qualid_of_reference r in
-  try match locate_extended qid with
+let global ({CAst.loc;v=r} as lr)=
+  let {CAst.loc; v} as qid = qualid_of_reference lr in
+  try match locate_extended v with
     | TrueGlobal ref -> ref
     | SynDef _ ->
-        user_err_loc (loc,"global",
-          str "Unexpected reference to a notation: " ++
-          pr_qualid qid)
+        user_err ?loc ~hdr:"global"
+          (str "Unexpected reference to a notation: " ++
+           pr_qualid v)
   with Not_found ->
-    error_global_not_found_loc loc qid
+    error_global_not_found qid
 
 (* Exists functions ********************************************************)
 
@@ -473,7 +482,7 @@ let exists_module = exists_dir
 
 let exists_modtype sp = MPTab.exists sp !the_modtypetab
 
-let exists_tactic kn = KnTab.exists kn !the_tactictab
+let exists_universe kn = UnivTab.exists kn !the_univtab
 
 (* Reverse locate functions ***********************************************)
 
@@ -494,12 +503,12 @@ let path_of_syndef kn =
 let dirpath_of_module mp =
   MPmap.find mp !the_modrevtab
 
-let path_of_tactic kn =
-  KNmap.find kn !the_tacticrevtab
-
 let path_of_modtype mp =
   MPmap.find mp !the_modtyperevtab
 
+let path_of_universe mp =
+  UnivIdMap.find mp !the_univrevtab
+
 (* Shortest qualid functions **********************************************)
 
 let shortest_qualid_of_global ctx ref =
@@ -521,50 +530,49 @@ let shortest_qualid_of_modtype kn =
   let sp = MPmap.find kn !the_modtyperevtab in
     MPTab.shortest_qualid Id.Set.empty sp !the_modtypetab
 
-let shortest_qualid_of_tactic kn =
-  let sp = KNmap.find kn !the_tacticrevtab in
-    KnTab.shortest_qualid Id.Set.empty sp !the_tactictab
+let shortest_qualid_of_universe kn =
+  let sp = UnivIdMap.find kn !the_univrevtab in
+    UnivTab.shortest_qualid Id.Set.empty sp !the_univtab
 
 let pr_global_env env ref =
   try pr_qualid (shortest_qualid_of_global env ref)
   with Not_found as e ->
     if !Flags.debug then Feedback.msg_debug (Pp.str "pr_global_env not found"); raise e
 
-let global_inductive r =
-  match global r with
+let global_inductive ({CAst.loc; v=r} as lr) =
+  match global lr with
   | IndRef ind -> ind
   | ref ->
-      user_err_loc (loc_of_reference r,"global_inductive",
-        pr_reference r ++ spc () ++ str "is not an inductive type")
-
+      user_err ?loc ~hdr:"global_inductive"
+        (pr_reference lr ++ spc () ++ str "is not an inductive type")
 
 (********************************************************************)
 
 (********************************************************************)
 (* Registration of tables as a global table and rollback            *)
 
-type frozen = ccitab * dirtab * mptab * kntab
-    * globrevtab * mprevtab * mptrevtab * knrevtab
+type frozen = ccitab * dirtab * mptab * univtab
+    * globrevtab * mprevtab * mptrevtab * univrevtab
 
 let freeze _ : frozen =
   !the_ccitab,
   !the_dirtab,
   !the_modtypetab,
-  !the_tactictab,
+  !the_univtab,
   !the_globrevtab,
   !the_modrevtab,
   !the_modtyperevtab,
-  !the_tacticrevtab
+  !the_univrevtab
 
-let unfreeze (ccit,dirt,mtyt,tact,globr,modr,mtyr,tacr) =
+let unfreeze (ccit,dirt,mtyt,univt,globr,modr,mtyr,univr) =
   the_ccitab := ccit;
   the_dirtab := dirt;
   the_modtypetab := mtyt;
-  the_tactictab := tact;
+  the_univtab := univt;
   the_globrevtab := globr;
   the_modrevtab := modr;
   the_modtyperevtab := mtyr;
-  the_tacticrevtab := tacr
+  the_univrevtab := univr
 
 let _ =
   Summary.declare_summary "names"
diff --git a/library/nametab.mli b/library/nametab.mli
index a8a0572b..cd28518a 100644
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Pp
 open Names
 open Libnames
 open Globnames
@@ -60,8 +61,7 @@ open Globnames
 exception GlobalizationError of qualid
 
 (** Raises a globalization error *)
-val error_global_not_found_loc : Loc.t -> qualid -> 'a
-val error_global_not_found     : qualid -> 'a
+val error_global_not_found : qualid CAst.t -> 'a
 
 (** {6 Register visibility of things } *)
 
@@ -76,13 +76,15 @@ val error_global_not_found     : qualid -> 'a
 type visibility = Until of int | Exactly of int
 
 val push : visibility -> full_path -> global_reference -> unit
-val push_modtype : visibility -> full_path -> module_path -> unit
+val push_modtype : visibility -> full_path -> ModPath.t -> unit
 val push_dir : visibility -> DirPath.t -> global_dir_reference -> unit
 val push_syndef : visibility -> full_path -> syndef_name -> unit
 
-type ltac_constant = kernel_name
-val push_tactic : visibility -> full_path -> ltac_constant -> unit
+type universe_id = DirPath.t * int
 
+module UnivIdMap : CMap.ExtS with type key = universe_id
+
+val push_universe : visibility -> full_path -> universe_id -> unit
 
 (** {6 The following functions perform globalization of qualified names } *)
 
@@ -91,13 +93,13 @@ val push_tactic : visibility -> full_path -> ltac_constant -> unit
 
 val locate : qualid -> global_reference
 val locate_extended : qualid -> extended_global_reference
-val locate_constant : qualid -> constant
+val locate_constant : qualid -> Constant.t
 val locate_syndef : qualid -> syndef_name
-val locate_modtype : qualid -> module_path
+val locate_modtype : qualid -> ModPath.t
 val locate_dir : qualid -> global_dir_reference
-val locate_module : qualid -> module_path
+val locate_module : qualid -> ModPath.t
 val locate_section : qualid -> DirPath.t
-val locate_tactic : qualid -> ltac_constant
+val locate_universe : qualid -> universe_id
 
 (** These functions globalize user-level references into global
    references, like [locate] and co, but raise a nice error message
@@ -111,9 +113,8 @@ val global_inductive : reference -> inductive
 
 val locate_all : qualid -> global_reference list
 val locate_extended_all : qualid -> extended_global_reference list
-val locate_extended_all_tactic : qualid -> ltac_constant list
 val locate_extended_all_dir : qualid -> global_dir_reference list
-val locate_extended_all_modtype : qualid -> module_path list
+val locate_extended_all_modtype : qualid -> ModPath.t list
 
 (** Mapping a full path to a global reference *)
 
@@ -127,7 +128,7 @@ val exists_modtype : full_path -> bool
 val exists_dir : DirPath.t -> bool
 val exists_section : DirPath.t -> bool (** deprecated synonym of [exists_dir] *)
 val exists_module : DirPath.t -> bool (** deprecated synonym of [exists_dir] *)
-val exists_tactic : full_path -> bool (** deprecated synonym of [exists_dir] *)
+val exists_universe : full_path -> bool
 
 (** {6 These functions locate qualids into full user names } *)
 
@@ -144,9 +145,12 @@ val full_name_module : qualid -> DirPath.t
 
 val path_of_syndef : syndef_name -> full_path
 val path_of_global : global_reference -> full_path
-val dirpath_of_module : module_path -> DirPath.t
-val path_of_modtype : module_path -> full_path
-val path_of_tactic : ltac_constant -> full_path
+val dirpath_of_module : ModPath.t -> DirPath.t
+val path_of_modtype : ModPath.t -> full_path
+
+(** A universe_id might not be registered with a corresponding user name.
+    @raise Not_found if the universe was not introduced by the user. *)
+val path_of_universe : universe_id -> full_path
 
 (** Returns in particular the dirpath or the basename of the full path
    associated to global reference *)
@@ -156,7 +160,7 @@ val basename_of_global : global_reference -> Id.t
 
 (** Printing of global references using names as short as possible.
     @raise Not_found when the reference is not in the global tables. *)
-val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds
+val pr_global_env : Id.Set.t -> global_reference -> Pp.t
 
 
 (** The [shortest_qualid] functions given an object with [user_name]
@@ -166,11 +170,46 @@ val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds
 
 val shortest_qualid_of_global : Id.Set.t -> global_reference -> qualid
 val shortest_qualid_of_syndef : Id.Set.t -> syndef_name -> qualid
-val shortest_qualid_of_modtype : module_path -> qualid
-val shortest_qualid_of_module : module_path -> qualid
-val shortest_qualid_of_tactic : ltac_constant -> qualid
+val shortest_qualid_of_modtype : ModPath.t -> qualid
+val shortest_qualid_of_module : ModPath.t -> qualid
+val shortest_qualid_of_universe : universe_id -> qualid
 
 (** Deprecated synonyms *)
 
 val extended_locate : qualid -> extended_global_reference (*= locate_extended *)
 val absolute_reference : full_path -> global_reference (** = global_of_path *)
+
+(** {5 Generic name handling} *)
+
+(** NOT FOR PUBLIC USE YET. Plugin writers, please do not rely on this API. *)
+
+module type UserName = sig
+  type t
+  val equal : t -> t -> bool
+  val to_string : t -> string
+  val repr : t -> Id.t * module_ident list
+end
+
+module type EqualityType =
+sig
+  type t
+  val equal : t -> t -> bool
+end
+
+module type NAMETREE = sig
+  type elt
+  type t
+  type user_name
+
+  val empty : t
+  val push : visibility -> user_name -> elt -> t -> t
+  val locate : qualid -> t -> elt
+  val find : user_name -> t -> elt
+  val exists : user_name -> t -> bool
+  val user_name : qualid -> t -> user_name
+  val shortest_qualid : Id.Set.t -> user_name -> t -> qualid
+  val find_prefixes : qualid -> t -> elt list
+end
+
+module Make (U : UserName) (E : EqualityType) :
+  NAMETREE with type user_name = U.t and type elt = E.t
diff --git a/library/states.ml b/library/states.ml
index 95bd819d..ae45b18b 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Util
@@ -37,5 +39,3 @@ let with_state_protection f x =
   with reraise ->
     let reraise = CErrors.push reraise in
     (unfreeze st; iraise reraise)
-
-let with_state_protection_on_exception = Future.transactify
diff --git a/library/states.mli b/library/states.mli
index 12c71c99..1e0361ea 100644
--- a/library/states.mli
+++ b/library/states.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** {6 States of the system} *)
@@ -30,10 +32,3 @@ val replace_summary : state -> Summary.frozen -> state
 
 val with_state_protection : ('a -> 'b) -> 'a -> 'b
 
-(** [with_state_protection_on_exception f x] applies [f] to [x] and restores the
-  state of the whole system as it was before applying [f] only if an
-  exception is raised.  Unlike [with_state_protection] it also takes into
-  account the proof state *)
-
-val with_state_protection_on_exception : ('a -> 'b) -> 'a -> 'b
-
diff --git a/library/summary.ml b/library/summary.ml
index 6efa07f3..7ef19fbf 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -1,29 +1,36 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 
-module Dyn = Dyn.Make(struct end)
+module Dyn = Dyn.Make ()
 
 type marshallable = [ `Yes | `No | `Shallow ]
+
 type 'a summary_declaration = {
   freeze_function : marshallable -> 'a;
   unfreeze_function : 'a -> unit;
   init_function : unit -> unit }
 
-let summaries = ref Int.Map.empty
+let sum_mod = ref None
+let sum_map = ref String.Map.empty
 
 let mangle id = id ^ "-SUMMARY"
+let unmangle id = String.(sub id 0 (length id - 8))
+
+let ml_modules = "ML-MODULES"
 
-let internal_declare_summary hash sumname sdecl =
-  let (infun, outfun) = Dyn.Easy.make_dyn (mangle sumname) in
+let internal_declare_summary fadd sumname sdecl =
+  let infun, outfun, tag = Dyn.Easy.make_dyn_tag (mangle sumname) in
   let dyn_freeze b = infun (sdecl.freeze_function b)
   and dyn_unfreeze sum = sdecl.unfreeze_function (outfun sum)
   and dyn_init = sdecl.init_function in
@@ -32,138 +39,126 @@ let internal_declare_summary hash sumname sdecl =
     unfreeze_function = dyn_unfreeze;
     init_function = dyn_init }
   in
-  summaries := Int.Map.add hash (sumname, ddecl) !summaries
+  fadd sumname ddecl;
+  tag
 
-let all_declared_summaries = ref Int.Set.empty
+let declare_ml_modules_summary decl =
+  let ml_add _ ddecl = sum_mod := Some ddecl in
+  internal_declare_summary ml_add ml_modules decl
 
-let summary_names = ref []
-let name_of_summary name =
-  try List.assoc name !summary_names
-  with Not_found -> "summary name not found"
+let declare_ml_modules_summary decl =
+  ignore(declare_ml_modules_summary decl)
 
-let declare_summary sumname decl =
-  let hash = String.hash sumname in
-  let () = if Int.Map.mem hash !summaries then
-    let (name, _) = Int.Map.find hash !summaries in
-    anomaly ~label:"Summary.declare_summary"
-      (str "Colliding summary names: " ++ str sumname ++ str " vs. " ++ str name)
+let declare_summary_tag sumname decl =
+  let fadd name ddecl = sum_map := String.Map.add name ddecl !sum_map in
+  let () = if String.Map.mem sumname !sum_map then
+      anomaly ~label:"Summary.declare_summary"
+        (str "Colliding summary names: " ++ str sumname ++ str " vs. " ++ str sumname ++ str ".")
   in
-  all_declared_summaries := Int.Set.add hash !all_declared_summaries;
-  summary_names := (hash, sumname) :: !summary_names;
-  internal_declare_summary hash sumname decl
+  internal_declare_summary fadd sumname decl
+
+let declare_summary sumname decl =
+  ignore(declare_summary_tag sumname decl)
 
 type frozen = {
-  summaries : (int * Dyn.t) list;
+  summaries : Dyn.t String.Map.t;
   (** Ordered list w.r.t. the first component. *)
   ml_module : Dyn.t option;
   (** Special handling of the ml_module summary. *)
 }
 
-let empty_frozen = { summaries = []; ml_module = None; }
-
-let ml_modules = "ML-MODULES"
-let ml_modules_summary = String.hash ml_modules
+let empty_frozen = { summaries = String.Map.empty; ml_module = None }
 
 let freeze_summaries ~marshallable : frozen =
-  let fold id (_, decl) accu =
-    (* to debug missing Lazy.force
-    if marshallable <> `No then begin
-      let id, _ = Int.Map.find id !summaries in
-      prerr_endline ("begin marshalling " ^ id);
-      ignore(Marshal.to_string (decl.freeze_function marshallable) []);
-      prerr_endline ("end marshalling " ^ id);
-    end;
-    /debug *)
-    let state = decl.freeze_function marshallable in
-    if Int.equal id ml_modules_summary then { accu with ml_module = Some state }
-    else { accu with summaries = (id, state) :: accu.summaries }
+  let smap decl = decl.freeze_function marshallable in
+  { summaries = String.Map.map smap !sum_map;
+    ml_module = Option.map (fun decl -> decl.freeze_function marshallable) !sum_mod;
+  }
+
+let unfreeze_single name state =
+  let decl =
+    try String.Map.find name !sum_map
+    with
+    | Not_found ->
+      CErrors.anomaly Pp.(str "trying to unfreeze unregistered summary " ++ str name)
   in
-  Int.Map.fold_right fold !summaries empty_frozen
-
-let unfreeze_summaries fs =
+  try decl.unfreeze_function state
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
+    Feedback.msg_warning
+      Pp.(seq [str "Error unfreezing summary "; str name; fnl (); CErrors.iprint e]);
+    iraise e
+
+let warn_summary_out_of_scope =
+  let name = "summary-out-of-scope" in
+  let category = "dev" in
+  let default = CWarnings.Disabled in
+  CWarnings.create ~name ~category ~default (fun name ->
+    Pp.str (Printf.sprintf
+      "A Coq plugin was loaded inside a local scope (such as a Section). It is recommended to load plugins at the start of the file. Summary entry: %s"
+      name)
+    )
+
+let unfreeze_summaries ?(partial=false) { summaries; ml_module } =
   (* The unfreezing of [ml_modules_summary] has to be anticipated since it
-   * may modify the content of [summaries] ny loading new ML modules *)
-  let (_, decl) =
-    try Int.Map.find ml_modules_summary !summaries
-    with Not_found -> anomaly (str "Undeclared summary " ++ str ml_modules)
-  in
-  let () = match fs.ml_module with
-  | None -> anomaly (str "Undeclared summary " ++ str ml_modules)
-  | Some state -> decl.unfreeze_function state
-  in
-  let fold id (_, decl) states =
-    if Int.equal id ml_modules_summary then states
-    else match states with
-    | [] ->
-      let () = decl.init_function () in
-      []
-    | (nid, state) :: rstates ->
-      if Int.equal id nid then
-        let () = decl.unfreeze_function state in rstates
-      else
-        let () = decl.init_function () in states
+   * may modify the content of [summaries] by loading new ML modules *)
+  begin match !sum_mod with
+  | None -> anomaly (str "Undeclared summary " ++ str ml_modules ++ str ".")
+  | Some decl -> Option.iter (fun state -> decl.unfreeze_function state) ml_module
+  end;
+  (** We must be independent on the order of the map! *)
+  let ufz name decl =
+    try decl.unfreeze_function String.Map.(find name summaries)
+    with Not_found ->
+      if not partial then begin
+        warn_summary_out_of_scope name;
+        decl.init_function ()
+      end;
   in
-  let fold id decl state =
-    try fold id decl state
-    with e when CErrors.noncritical e ->
-      let e = CErrors.push e in
-      Printf.eprintf "Error unfrezing summay %s\n%s\n%!"
-        (name_of_summary id) (Pp.string_of_ppcmds (CErrors.iprint e));
-      iraise e
-  in
-  (** We rely on the order of the frozen list, and the order of folding *)
-  ignore (Int.Map.fold_left fold !summaries fs.summaries)
+  (* String.Map.iter unfreeze_single !sum_map *)
+  String.Map.iter ufz !sum_map
 
 let init_summaries () =
-  Int.Map.iter (fun _ (_, decl) -> decl.init_function ()) !summaries
+  String.Map.iter (fun _ decl -> decl.init_function ()) !sum_map
 
 (** For global tables registered statically before the end of coqtop
     launch, the following empty [init_function] could be used. *)
 
 let nop () = ()
 
-(** Selective freeze *)
+(** Summary projection *)
+let project_from_summary { summaries } tag =
+  let id = unmangle (Dyn.repr tag) in
+  let state = String.Map.find id summaries in
+  Option.get (Dyn.Easy.prj state tag)
+
+let modify_summary st tag v =
+  let id = unmangle (Dyn.repr tag) in
+  let summaries = String.Map.set id (Dyn.Easy.inj v tag) st.summaries in
+  {st with summaries}
 
-type frozen_bits = (int * Dyn.t) list
+let remove_from_summary st tag =
+  let id = unmangle (Dyn.repr tag) in
+  let summaries = String.Map.remove id st.summaries in
+  {st with summaries}
+
+(** Selective freeze *)
 
-let ids_of_string_list complement ids =
-  if not complement then List.map String.hash ids
-  else
-    let fold accu id =
-      let id = String.hash id in
-      Int.Set.remove id accu
-    in
-    let ids = List.fold_left fold !all_declared_summaries ids in
-    Int.Set.elements ids
+type frozen_bits = Dyn.t String.Map.t
 
 let freeze_summary ~marshallable ?(complement=false) ids =
-  let ids = ids_of_string_list complement ids in
-  List.map (fun id ->
-    let (_, summary) = Int.Map.find id !summaries in
-    id, summary.freeze_function marshallable)
-  ids
-
-let unfreeze_summary datas =
-  List.iter
-    (fun (id, data) ->
-      let (name, summary) = Int.Map.find id !summaries in
-      try summary.unfreeze_function data
-      with e ->
-        let e = CErrors.push e in
-        prerr_endline ("Exception unfreezing " ^ name);
-        iraise e)
-  datas
+  let sub_map = String.Map.filter (fun id _ -> complement <> List.(mem id ids)) !sum_map in
+  String.Map.map (fun decl -> decl.freeze_function marshallable) sub_map
+
+let unfreeze_summary = String.Map.iter unfreeze_single
 
 let surgery_summary { summaries; ml_module } bits =
-  let summaries = List.map (fun (id, _ as orig) ->
-      try id, List.assoc id bits
-      with Not_found -> orig)
-    summaries in
+  let summaries =
+    String.Map.fold (fun hash state sum -> String.Map.set hash state sum ) summaries bits in
   { summaries; ml_module }
 
 let project_summary { summaries; ml_module } ?(complement=false) ids =
-  let ids = ids_of_string_list complement ids in
-  List.filter (fun (id, _) -> List.mem id ids) summaries
+  String.Map.filter (fun name _ -> complement <> List.(mem name ids)) summaries
 
 let pointer_equal l1 l2 =
   let ptr_equal d1 d2 =
@@ -172,19 +167,22 @@ let pointer_equal l1 l2 =
     match Dyn.eq t1 t2 with
     | None -> false
     | Some Refl -> x1 == x2
-    in
+  in
+  let l1, l2 = String.Map.bindings l1, String.Map.bindings l2 in
   CList.for_all2eq
     (fun (id1,v1) (id2,v2) -> id1 = id2 && ptr_equal v1 v2) l1 l2
 
 (** All-in-one reference declaration + registration *)
 
-let ref ?(freeze=fun _ r -> r) ~name x =
+let ref_tag ?(freeze=fun _ r -> r) ~name x =
   let r = ref x in
-  declare_summary name
+  let tag = declare_summary_tag name
     { freeze_function = (fun b -> freeze b !r);
       unfreeze_function = ((:=) r);
-      init_function = (fun () -> r := x) };
-  r
+      init_function = (fun () -> r := x) } in
+  r, tag
+
+let ref ?freeze ~name x = fst @@ ref_tag ?freeze ~name x
 
 module Local = struct
 
@@ -196,8 +194,7 @@ let (!) r =
   let key, name = !r in
   try CEphemeron.get key
   with CEphemeron.InvalidKey ->
-    let _, { init_function } =
-      Int.Map.find (String.hash (mangle name)) !summaries in
+    let { init_function } = String.Map.find name !sum_map in
     init_function ();
     CEphemeron.get (fst !r)
 
diff --git a/library/summary.mli b/library/summary.mli
index 1b57613c..ed6c26b1 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
 (** This module registers the declaration of global tables, which will be kept
@@ -14,6 +16,8 @@ type marshallable =
   | `No        (* Full data will be store in memory, e.g. for Undo            *)
   | `Shallow ] (* Only part of the data will be marshalled to a slave process *)
 
+(** Types of global Coq states. The ['a] type should be pure and marshallable by
+    the standard OCaml marshalling function. *)
 type 'a summary_declaration = {
   (** freeze_function [true] is for marshalling to disk. 
    *  e.g. lazy must be forced *)
@@ -34,6 +38,12 @@ type 'a summary_declaration = {
 
 val declare_summary : string -> 'a summary_declaration -> unit
 
+(** We provide safe projection from the summary to the types stored in
+   it.*)
+module Dyn : Dyn.S
+
+val declare_summary_tag : string -> 'a summary_declaration -> 'a Dyn.tag
+
 (** All-in-one reference declaration + summary registration.
     It behaves just as OCaml's standard [ref] function, except
     that a [declare_summary] is done, with [name] as string.
@@ -41,6 +51,7 @@ val declare_summary : string -> 'a summary_declaration -> unit
     The [freeze_function] can be overridden *)
 
 val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref
+val ref_tag : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref * 'a Dyn.tag
 
 (* As [ref] but the value is local to a process, i.e. not sent to, say, proof
  * workers.  It is useful to implement a local cache for example. *)
@@ -53,10 +64,11 @@ module Local : sig
 
 end
 
-(** Special name for the summary of ML modules.  This summary entry is
-    special because its unfreeze may load ML code and hence add summary
-    entries.  Thus is has to be recognizable, and handled appropriately *)
-val ml_modules : string
+(** Special summary for ML modules.  This summary entry is special
+    because its unfreeze may load ML code and hence add summary
+    entries.  Thus is has to be recognizable, and handled properly.
+   *)
+val declare_ml_modules_summary : 'a summary_declaration -> unit
 
 (** For global tables registered statically before the end of coqtop
     launch, the following empty [init_function] could be used. *)
@@ -70,19 +82,34 @@ type frozen
 
 val empty_frozen : frozen
 val freeze_summaries : marshallable:marshallable -> frozen
-val unfreeze_summaries : frozen -> unit
+val unfreeze_summaries : ?partial:bool -> frozen -> unit
 val init_summaries : unit -> unit
 
-(** The type [frozen_bits] is a snapshot of some of the registered tables *)
+(** Typed projection of the summary. Experimental API, use with CARE *)
+
+val modify_summary : frozen -> 'a Dyn.tag -> 'a -> frozen
+val project_from_summary : frozen -> 'a Dyn.tag -> 'a
+val remove_from_summary : frozen -> 'a Dyn.tag -> frozen
+
+(** The type [frozen_bits] is a snapshot of some of the registered
+    tables. It is DEPRECATED in favor of the typed projection
+    version. *)
+
 type frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 
-val freeze_summary :
-  marshallable:marshallable -> ?complement:bool -> string list -> frozen_bits
+[@@@ocaml.warning "-3"]
+val freeze_summary : marshallable:marshallable -> ?complement:bool -> string list -> frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val unfreeze_summary : frozen_bits -> unit
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val surgery_summary : frozen -> frozen_bits -> frozen
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val project_summary : frozen -> ?complement:bool -> string list -> frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val pointer_equal : frozen_bits -> frozen_bits -> bool
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
+[@@@ocaml.warning "+3"]
 
 (** {6 Debug} *)
-
 val dump : unit -> (int * string) list
diff --git a/library/universes.ml b/library/universes.ml
deleted file mode 100644
index 112b20a4..00000000
--- a/library/universes.ml
+++ /dev/null
@@ -1,1162 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Pp
-open Names
-open Term
-open Environ
-open Univ
-open Globnames
-open Decl_kinds
-
-(** Global universe names *)
-type universe_names = 
-  (polymorphic * Univ.universe_level) Idmap.t * Id.t Univ.LMap.t
-
-let global_universes =
-  Summary.ref ~name:"Global universe names"
-  ((Idmap.empty, Univ.LMap.empty) : universe_names)
-
-let global_universe_names () = !global_universes
-let set_global_universe_names s = global_universes := s
-
-let pr_with_global_universes l = 
-  try Nameops.pr_id (LMap.find l (snd !global_universes))
-  with Not_found -> Level.pr l
-
-(** Local universe names of polymorphic references *)
-
-type universe_binders = (Id.t * Univ.universe_level) list
-
-let universe_binders_table = Summary.ref Refmap.empty ~name:"universe binders"
-
-let universe_binders_of_global ref =
-  try
-    let l = Refmap.find ref !universe_binders_table in l
-  with Not_found -> []
-
-let register_universe_binders ref l =
-  universe_binders_table := Refmap.add ref l !universe_binders_table
-		     
-(* To disallow minimization to Set *)
-
-let set_minimization = ref true
-let is_set_minimization () = !set_minimization
-			    
-type universe_constraint_type = ULe | UEq | ULub
-
-type universe_constraint = universe * universe_constraint_type * universe
-
-module Constraints = struct
-  module S = Set.Make(
-  struct 
-    type t = universe_constraint
-
-    let compare_type c c' =
-      match c, c' with
-      | ULe, ULe -> 0
-      | ULe, _ -> -1
-      | _, ULe -> 1
-      | UEq, UEq -> 0
-      | UEq, _ -> -1
-      | ULub, ULub -> 0
-      | ULub, _ -> 1
-      
-    let compare (u,c,v) (u',c',v') =
-      let i = compare_type c c' in
-	if Int.equal i 0 then
-	  let i' = Universe.compare u u' in
-	    if Int.equal i' 0 then Universe.compare v v'
-	    else 
-	      if c != ULe && Universe.compare u v' = 0 && Universe.compare v u' = 0 then 0
-	      else i'
-	else i
-  end)
-  
-  include S
-  
-  let add (l,d,r as cst) s = 
-    if Universe.equal l r then s
-    else add cst s
-
-  let tr_dir = function
-    | ULe -> Le
-    | UEq -> Eq
-    | ULub -> Eq
-
-  let op_str = function ULe -> " <= " | UEq -> " = " | ULub -> " /\\ "
-
-  let pr c =
-    fold (fun (u1,op,u2) pp_std ->
-	pp_std ++ Universe.pr u1 ++ str (op_str op) ++
-	Universe.pr u2 ++ fnl ()) c (str "")
-
-  let equal x y = 
-    x == y || equal x y
-
-end
-
-type universe_constraints = Constraints.t
-type 'a constraint_accumulator = universe_constraints -> 'a -> 'a option
-type 'a universe_constrained = 'a * universe_constraints
-
-type 'a universe_constraint_function = 'a -> 'a -> universe_constraints -> universe_constraints
-
-let enforce_eq_instances_univs strict x y c = 
-  let d = if strict then ULub else UEq in
-  let ax = Instance.to_array x and ay = Instance.to_array y in
-    if Array.length ax != Array.length ay then
-      CErrors.anomaly (Pp.str "Invalid argument: enforce_eq_instances_univs called with" ++
-	       Pp.str " instances of different lengths");
-    CArray.fold_right2
-      (fun x y -> Constraints.add (Universe.make x, d, Universe.make y))
-      ax ay c
-
-let subst_univs_universe_constraint fn (u,d,v) =
-  let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
-    if Universe.equal u' v' then None
-    else Some (u',d,v')
-
-let subst_univs_universe_constraints subst csts =
-  Constraints.fold 
-    (fun c -> Option.fold_right Constraints.add (subst_univs_universe_constraint subst c))
-    csts Constraints.empty 
-
-
-let to_constraints g s = 
-  let tr (x,d,y) acc =
-    let add l d l' acc = Constraint.add (l,Constraints.tr_dir d,l') acc in
-      match Universe.level x, d, Universe.level y with
-      | Some l, (ULe | UEq | ULub), Some l' -> add l d l' acc
-      | _, ULe, Some l' -> enforce_leq x y acc
-      | _, ULub, _ -> acc
-      | _, d, _ -> 
-	let f = if d == ULe then UGraph.check_leq else UGraph.check_eq in
-	  if f g x y then acc else 
-	    raise (Invalid_argument 
-		   "to_constraints: non-trivial algebraic constraint between universes")
-  in Constraints.fold tr s Constraint.empty
-
-let eq_constr_univs_infer univs fold m n accu =
-  if m == n then Some accu
-  else 
-    let cstrs = ref accu in
-    let eq_universes strict = UGraph.check_eq_instances univs in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, UEq, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
-    if res then Some !cstrs else None
-
-(** Variant of [eq_constr_univs_infer] taking kind-of-term functions,
-    to expose subterms of [m] and [n], arguments. *)
-let eq_constr_univs_infer_with kind1 kind2 univs fold m n accu =
-  (* spiwack: duplicates the code of [eq_constr_univs_infer] because I
-     haven't find a way to factor the code without destroying
-     pointer-equality optimisations in [eq_constr_univs_infer].
-     Pointer equality is not sufficient to ensure equality up to
-     [kind1,kind2], because [kind1] and [kind2] may be different,
-     typically evaluating [m] and [n] in different evar maps. *)
-  let cstrs = ref accu in
-  let eq_universes strict = UGraph.check_eq_instances univs in
-  let eq_sorts s1 s2 = 
-    if Sorts.equal s1 s2 then true
-    else
-      let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-      match fold (Constraints.singleton (u1, UEq, u2)) !cstrs with
-      | None -> false
-      | Some accu -> cstrs := accu; true
-  in
-  let rec eq_constr' m n = 
-    Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' m n
-  in
-  let res = Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' m n in
-  if res then Some !cstrs else None
-
-let leq_constr_univs_infer univs fold m n accu =
-  if m == n then Some accu
-  else 
-    let cstrs = ref accu in
-    let eq_universes strict l l' = UGraph.check_eq_instances univs l l' in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, UEq, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let leq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else 
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, ULe, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts 
-	eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    if res then Some !cstrs else None
-
-let eq_constr_universes m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1, UEq, Sorts.univ_of_sort s2) !cstrs;
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
-    res, !cstrs
-
-let leq_constr_universes m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else (cstrs := Constraints.add 
-	      (Sorts.univ_of_sort s1,UEq,Sorts.univ_of_sort s2) !cstrs; 
-	    true)
-    in
-    let leq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else 
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1,ULe,Sorts.univ_of_sort s2) !cstrs; 
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    res, !cstrs
-
-let compare_head_gen_proj env equ eqs eqc' m n =
-  match kind_of_term m, kind_of_term n with
-  | Proj (p, c), App (f, args)
-  | App (f, args), Proj (p, c) -> 
-      (match kind_of_term f with
-      | Const (p', u) when eq_constant (Projection.constant p) p' -> 
-          let pb = Environ.lookup_projection p env in
-          let npars = pb.Declarations.proj_npars in
-	  if Array.length args == npars + 1 then
-	    eqc' c args.(npars)
-	  else false
-      | _ -> false)
-  | _ -> Constr.compare_head_gen equ eqs eqc' m n
-      
-let eq_constr_universes_proj env m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1, UEq, Sorts.univ_of_sort s2) !cstrs;
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen_proj env eq_universes eq_sorts eq_constr' m n
-    in
-    let res = eq_constr' m n in
-    res, !cstrs
-
-(* Generator of levels *)
-let new_univ_level, set_remote_new_univ_level =
-  RemoteCounter.new_counter ~name:"Universes" 0 ~incr:((+) 1)
-    ~build:(fun n -> Univ.Level.make (Global.current_dirpath ()) n)
-
-let new_univ_level _ = new_univ_level ()
-  (* Univ.Level.make db (new_univ_level ()) *)
-
-let fresh_level () = new_univ_level (Global.current_dirpath ())
-
-(* TODO: remove *)
-let new_univ dp = Univ.Universe.make (new_univ_level dp)
-let new_Type dp = mkType (new_univ dp)
-let new_Type_sort dp = Type (new_univ dp)
-
-let fresh_universe_instance ctx =
-  Instance.subst_fn (fun _ -> new_univ_level (Global.current_dirpath ())) 
-    (UContext.instance ctx)
-
-let fresh_instance_from_context ctx =
-  let inst = fresh_universe_instance ctx in
-  let constraints = instantiate_univ_constraints inst ctx in
-    inst, constraints
-
-let fresh_instance ctx =
-  let ctx' = ref LSet.empty in
-  let inst = 
-    Instance.subst_fn (fun v -> 
-      let u = new_univ_level (Global.current_dirpath ()) in
-	ctx' := LSet.add u !ctx'; u) 
-      (UContext.instance ctx)
-  in !ctx', inst
-
-let existing_instance ctx inst = 
-  let () = 
-    let a1 = Instance.to_array inst 
-    and a2 = Instance.to_array (UContext.instance ctx) in
-    let len1 = Array.length a1 and len2 = Array.length a2 in 
-      if not (len1 == len2) then
-	CErrors.errorlabstrm "Universes"
-	  (str "Polymorphic constant expected " ++ int len2 ++ 
-	     str" levels but was given " ++ int len1)
-      else ()
-  in LSet.empty, inst
-
-let fresh_instance_from ctx inst =
-  let ctx', inst = 
-    match inst with 
-    | Some inst -> existing_instance ctx inst
-    | None -> fresh_instance ctx 
-  in
-  let constraints = instantiate_univ_constraints inst ctx in
-    inst, (ctx', constraints)
-
-let unsafe_instance_from ctx =
-  (Univ.UContext.instance ctx, ctx)
-    
-(** Fresh universe polymorphic construction *)
-
-let fresh_constant_instance env c inst =
-  let cb = lookup_constant c env in
-    if cb.Declarations.const_polymorphic then
-      let inst, ctx =
-        fresh_instance_from
-          (Declareops.universes_of_constant (Environ.opaque_tables env) cb) inst
-      in
-	((c, inst), ctx)
-    else ((c,Instance.empty), ContextSet.empty)
-
-let fresh_inductive_instance env ind inst = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = fresh_instance_from mib.Declarations.mind_universes inst in
-	((ind,inst), ctx)
-    else ((ind,Instance.empty), ContextSet.empty)
-
-let fresh_constructor_instance env (ind,i) inst = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = fresh_instance_from mib.Declarations.mind_universes inst in
-	(((ind,i),inst), ctx)
-    else (((ind,i),Instance.empty), ContextSet.empty)
-
-let unsafe_constant_instance env c =
-  let cb = lookup_constant c env in
-    if cb.Declarations.const_polymorphic then
-      let inst, ctx = unsafe_instance_from
-        (Declareops.universes_of_constant (Environ.opaque_tables env) cb) in
-	((c, inst), ctx)
-    else ((c,Instance.empty), UContext.empty)
-
-let unsafe_inductive_instance env ind = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = unsafe_instance_from mib.Declarations.mind_universes in
-	((ind,inst), ctx)
-    else ((ind,Instance.empty), UContext.empty)
-
-let unsafe_constructor_instance env (ind,i) = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = unsafe_instance_from mib.Declarations.mind_universes in
-	(((ind,i),inst), ctx)
-    else (((ind,i),Instance.empty), UContext.empty)
-
-open Globnames
-
-let fresh_global_instance ?names env gr =
-  match gr with
-  | VarRef id -> mkVar id, ContextSet.empty
-  | ConstRef sp -> 
-     let c, ctx = fresh_constant_instance env sp names in
-       mkConstU c, ctx
-  | ConstructRef sp ->
-     let c, ctx = fresh_constructor_instance env sp names in
-       mkConstructU c, ctx
-  | IndRef sp -> 
-     let c, ctx = fresh_inductive_instance env sp names in
-       mkIndU c, ctx
-
-let fresh_constant_instance env sp = 
-  fresh_constant_instance env sp None
-
-let fresh_inductive_instance env sp = 
-  fresh_inductive_instance env sp None
-
-let fresh_constructor_instance env sp = 
-  fresh_constructor_instance env sp None
-
-let unsafe_global_instance env gr =
-  match gr with
-  | VarRef id -> mkVar id, UContext.empty
-  | ConstRef sp -> 
-     let c, ctx = unsafe_constant_instance env sp in
-       mkConstU c, ctx
-  | ConstructRef sp ->
-     let c, ctx = unsafe_constructor_instance env sp in
-       mkConstructU c, ctx
-  | IndRef sp -> 
-     let c, ctx = unsafe_inductive_instance env sp in
-       mkIndU c, ctx
-
-let constr_of_global gr =
-  let c, ctx = fresh_global_instance (Global.env ()) gr in
-    if not (Univ.ContextSet.is_empty ctx) then
-      if Univ.LSet.is_empty (Univ.ContextSet.levels ctx) then 
-	(* Should be an error as we might forget constraints, allow for now
-	   to make firstorder work with "using" clauses *)
-	c
-      else raise (Invalid_argument 
-		    ("constr_of_global: globalization of polymorphic reference " ^ 
-			Pp.string_of_ppcmds (Nametab.pr_global_env Id.Set.empty gr) ^
-			" would forget universes."))
-    else c
-
-let constr_of_reference = constr_of_global
-
-let unsafe_constr_of_global gr =
-  unsafe_global_instance (Global.env ()) gr
-
-let constr_of_global_univ (gr,u) =
-  match gr with
-  | VarRef id -> mkVar id
-  | ConstRef sp -> mkConstU (sp,u)
-  | ConstructRef sp -> mkConstructU (sp,u)
-  | IndRef sp -> mkIndU (sp,u)
-
-let fresh_global_or_constr_instance env = function
-  | IsConstr c -> c, ContextSet.empty
-  | IsGlobal gr -> fresh_global_instance env gr
-
-let global_of_constr c =
-  match kind_of_term c with
-  | Const (c, u) -> ConstRef c, u
-  | Ind (i, u) -> IndRef i, u
-  | Construct (c, u) -> ConstructRef c, u
-  | Var id -> VarRef id, Instance.empty
-  | _ -> raise Not_found
-
-let global_app_of_constr c =
-  match kind_of_term c with
-  | Const (c, u) -> (ConstRef c, u), None
-  | Ind (i, u) -> (IndRef i, u), None
-  | Construct (c, u) -> (ConstructRef c, u), None
-  | Var id -> (VarRef id, Instance.empty), None
-  | Proj (p, c) -> (ConstRef (Projection.constant p), Instance.empty), Some c
-  | _ -> raise Not_found
-
-open Declarations
-
-let type_of_reference env r =
-  match r with
-  | VarRef id -> Environ.named_type id env, ContextSet.empty
-  | ConstRef c ->
-     let cb = Environ.lookup_constant c env in
-     let ty = Typeops.type_of_constant_type env cb.const_type in
-       if cb.const_polymorphic then
-	 let inst, ctx = fresh_instance_from (Declareops.universes_of_constant (Environ.opaque_tables env) cb) None in
-	   Vars.subst_instance_constr inst ty, ctx
-       else ty, ContextSet.empty
-
-  | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-       if mib.mind_polymorphic then
-	 let inst, ctx = fresh_instance_from mib.mind_universes None in
-	 let ty = Inductive.type_of_inductive env (specif, inst) in
-	   ty, ctx
-       else
-	 let ty = Inductive.type_of_inductive env (specif, Univ.Instance.empty) in
-	   ty, ContextSet.empty
-  | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-       if mib.mind_polymorphic then
-	 let inst, ctx = fresh_instance_from mib.mind_universes None in
-	   Inductive.type_of_constructor (cstr,inst) specif, ctx
-       else Inductive.type_of_constructor (cstr,Instance.empty) specif, ContextSet.empty
-
-let type_of_global t = type_of_reference (Global.env ()) t
-
-let unsafe_type_of_reference env r =
-  match r with
-  | VarRef id -> Environ.named_type id env
-  | ConstRef c ->
-     let cb = Environ.lookup_constant c env in
-       Typeops.type_of_constant_type env cb.const_type
-
-  | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let (_, inst), _ = unsafe_inductive_instance env ind in
-       Inductive.type_of_inductive env (specif, inst)
-
-  | ConstructRef (ind, _ as cstr) ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let (_, inst), _ = unsafe_inductive_instance env ind in
-       Inductive.type_of_constructor (cstr,inst) specif
-
-let unsafe_type_of_global t = unsafe_type_of_reference (Global.env ()) t
-
-let fresh_sort_in_family env = function
-  | InProp -> prop_sort, ContextSet.empty
-  | InSet -> set_sort, ContextSet.empty
-  | InType -> 
-    let u = fresh_level () in
-      Type (Univ.Universe.make u), ContextSet.singleton u
-
-let new_sort_in_family sf =
-  fst (fresh_sort_in_family (Global.env ()) sf)
-
-let extend_context (a, ctx) (ctx') =
-  (a, ContextSet.union ctx ctx')
-
-let new_global_univ () =
-  let u = fresh_level () in
-    (Univ.Universe.make u, ContextSet.singleton u)
-
-(** Simplification *)
-
-module LevelUnionFind = Unionfind.Make (Univ.LSet) (Univ.LMap)
-
-let add_list_map u t map =
-  try
-    let l = LMap.find u map in
-    LMap.update u (t :: l) map
-  with Not_found ->
-    LMap.add u [t] map
-
-module UF = LevelUnionFind
-
-(** Precondition: flexible <= ctx *)
-let choose_canonical ctx flexible algs s =
-  let global = LSet.diff s ctx in
-  let flexible, rigid = LSet.partition flexible (LSet.inter s ctx) in
-    (** If there is a global universe in the set, choose it *)
-    if not (LSet.is_empty global) then
-      let canon = LSet.choose global in
-	canon, (LSet.remove canon global, rigid, flexible)
-    else (** No global in the equivalence class, choose a rigid one *)
-	if not (LSet.is_empty rigid) then
-	  let canon = LSet.choose rigid in
-	    canon, (global, LSet.remove canon rigid, flexible)
-	else (** There are only flexible universes in the equivalence
-		 class, choose a non-algebraic. *)
-	  let algs, nonalgs = LSet.partition (fun x -> LSet.mem x algs) flexible in
-	    if not (LSet.is_empty nonalgs) then
-	      let canon = LSet.choose nonalgs in
-		canon, (global, rigid, LSet.remove canon flexible)
-	    else
-	      let canon = LSet.choose algs in
-		canon, (global, rigid, LSet.remove canon flexible)
-
-let subst_univs_fn_puniverses lsubst (c, u as cu) =
-  let u' = Instance.subst_fn lsubst u in
-    if u' == u then cu else (c, u')
-
-let nf_evars_and_universes_opt_subst f subst =
-  let subst = fun l -> match LMap.find l subst with None -> raise Not_found | Some l' -> l' in
-  let lsubst = Univ.level_subst_of subst in
-  let rec aux c =
-    match kind_of_term c with
-    | Evar (evk, args) ->
-      let args = Array.map aux args in
-      (match try f (evk, args) with Not_found -> None with
-      | None -> c
-      | Some c -> aux c)
-    | Const pu -> 
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkConstU pu'
-    | Ind pu ->
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkIndU pu'
-    | Construct pu ->
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkConstructU pu'
-    | Sort (Type u) ->
-      let u' = Univ.subst_univs_universe subst u in
-	if u' == u then c else mkSort (sort_of_univ u')
-    | _ -> map_constr aux c
-  in aux
-
-let fresh_universe_context_set_instance ctx =
-  if ContextSet.is_empty ctx then LMap.empty, ctx
-  else
-    let (univs, cst) = ContextSet.levels ctx, ContextSet.constraints ctx in
-    let univs',subst = LSet.fold
-      (fun u (univs',subst) ->
-	let u' = fresh_level () in
-	  (LSet.add u' univs', LMap.add u u' subst))
-      univs (LSet.empty, LMap.empty)
-    in
-    let cst' = subst_univs_level_constraints subst cst in
-      subst, (univs', cst')
-
-let normalize_univ_variable ~find ~update =
-  let rec aux cur =
-    let b = find cur in
-    let b' = subst_univs_universe aux b in
-      if Universe.equal b' b then b
-      else update cur b'
-  in aux
-
-let normalize_univ_variable_opt_subst ectx =
-  let find l = 
-    match Univ.LMap.find l !ectx with
-    | Some b -> b
-    | None -> raise Not_found
-  in
-  let update l b =
-    assert (match Universe.level b with Some l' -> not (Level.equal l l') | None -> true);
-    try ectx := Univ.LMap.add l (Some b) !ectx; b with Not_found -> assert false
-  in normalize_univ_variable ~find ~update
-
-let normalize_univ_variable_subst subst =
-  let find l = Univ.LMap.find l !subst in
-  let update l b =
-    assert (match Universe.level b with Some l' -> not (Level.equal l l') | None -> true);
-    try subst := Univ.LMap.update l b !subst; b with Not_found -> assert false in
-    normalize_univ_variable ~find ~update
-
-let normalize_universe_opt_subst subst =
-  let normlevel = normalize_univ_variable_opt_subst subst in
-    subst_univs_universe normlevel
-
-let normalize_universe_subst subst =
-  let normlevel = normalize_univ_variable_subst subst in
-    subst_univs_universe normlevel
-
-let normalize_opt_subst ctx = 
-  let ectx = ref ctx in
-  let normalize = normalize_univ_variable_opt_subst ectx in
-  let () =
-    Univ.LMap.iter (fun u v ->
-      if Option.is_empty v then ()
-      else try ignore(normalize u) with Not_found -> assert(false)) ctx 
-  in !ectx
-
-type universe_opt_subst = universe option universe_map
-	  
-let make_opt_subst s = 
-  fun x -> 
-    (match Univ.LMap.find x s with
-    | Some u -> u
-    | None -> raise Not_found)
-
-let subst_opt_univs_constr s = 
-  let f = make_opt_subst s in
-    Vars.subst_univs_fn_constr f
-
-
-let normalize_univ_variables ctx = 
-  let ctx = normalize_opt_subst ctx in
-  let undef, def, subst =
-    Univ.LMap.fold (fun u v (undef, def, subst) -> 
-      match v with
-      | None -> (Univ.LSet.add u undef, def, subst)
-      | Some b -> (undef, Univ.LSet.add u def, Univ.LMap.add u b subst))
-    ctx (Univ.LSet.empty, Univ.LSet.empty, Univ.LMap.empty)
-  in ctx, undef, def, subst
-
-let pr_universe_body = function
-  | None -> mt ()
-  | Some v -> str" := " ++ Univ.Universe.pr v
-
-let pr_universe_opt_subst = Univ.LMap.pr pr_universe_body
-
-let compare_constraint_type d d' =
-  match d, d' with
-  | Eq, Eq -> 0
-  | Eq, _ -> -1
-  | _, Eq -> 1
-  | Le, Le -> 0
-  | Le, _ -> -1
-  | _, Le -> 1
-  | Lt, Lt -> 0
-
-type lowermap = constraint_type LMap.t
-
-let lower_union =
-  let merge k a b =
-    match a, b with
-    | Some _, None -> a
-    | None, Some _ -> b
-    | None, None -> None
-    | Some l, Some r ->
-       if compare_constraint_type l r >= 0 then a
-       else b
-  in LMap.merge merge
-
-let lower_add l c m =
-  try let c' = LMap.find l m in
-      if compare_constraint_type c c' > 0 then
-        LMap.add l c m
-      else m
-  with Not_found -> LMap.add l c m
-
-let lower_of_list l =
-  List.fold_left (fun acc (d,l) -> LMap.add l d acc) LMap.empty l
-
-exception Found of Level.t * lowermap
-let find_inst insts v =
-  try LMap.iter (fun k (enf,alg,v',lower) ->
-    if not alg && enf && Universe.equal v' v then raise (Found (k, lower)))
-	insts; raise Not_found
-  with Found (f,l) -> (f,l)
-
-let compute_lbound left =
- (** The universe variable was not fixed yet.
-     Compute its level using its lower bound. *)
-  let sup l lbound = 
-    match lbound with
-    | None -> Some l
-    | Some l' -> Some (Universe.sup l l')
-  in
-    List.fold_left (fun lbound (d, l) -> 
-      if d == Le (* l <= ?u *) then sup l lbound
-      else (* l < ?u *) 
-	(assert (d == Lt); 
-	 if not (Universe.level l == None) then
-	   sup (Universe.super l) lbound
-	 else None))
-      None left
-  
-let instantiate_with_lbound u lbound lower alg enforce (ctx, us, algs, insts, cstrs) =
-  if enforce then
-    let inst = Universe.make u in
-    let cstrs' = enforce_leq lbound inst cstrs in
-      (ctx, us, LSet.remove u algs, 
-       LMap.add u (enforce,alg,lbound,lower) insts, cstrs'),
-      (enforce, alg, inst, lower)
-  else (* Actually instantiate *)
-    (Univ.LSet.remove u ctx, Univ.LMap.add u (Some lbound) us, algs,
-     LMap.add u (enforce,alg,lbound,lower) insts, cstrs),
-    (enforce, alg, lbound, lower)
-
-type constraints_map = (Univ.constraint_type * Univ.LMap.key) list Univ.LMap.t
-
-let pr_constraints_map cmap =
-  LMap.fold (fun l cstrs acc -> 
-    Level.pr l ++ str " => " ++ 
-      prlist_with_sep spc (fun (d,r) -> pr_constraint_type d ++ Level.pr r) cstrs ++
-      fnl () ++ acc)
-    cmap (mt ())
-
-let remove_alg l (ctx, us, algs, insts, cstrs) =
-  (ctx, us, LSet.remove l algs, insts, cstrs)
-
-let remove_lower u lower =
-  let levels = Universe.levels u in
-  LSet.fold (fun l acc -> LMap.remove l acc) levels lower
-    
-let minimize_univ_variables ctx us algs left right cstrs =
-  let left, lbounds = 
-    Univ.LMap.fold (fun r lower (left, lbounds as acc)  ->
-      if Univ.LMap.mem r us || not (Univ.LSet.mem r ctx) then acc
-      else (* Fixed universe, just compute its glb for sharing *)
-	let lbounds' = 
-	  match compute_lbound (List.map (fun (d,l) -> d, Universe.make l) lower) with
-	  | None -> lbounds
-	  | Some lbound -> LMap.add r (true, false, lbound, lower_of_list lower)
-                                   lbounds
-	in (Univ.LMap.remove r left, lbounds'))
-      left (left, Univ.LMap.empty)
-  in
-  let rec instance (ctx', us, algs, insts, cstrs as acc) u =
-    let acc, left, lower =
-      try
-        let l = LMap.find u left in
-	let acc, left, newlow, lower =
-          List.fold_left
-	  (fun (acc, left', newlow, lower') (d, l) ->
-	   let acc', (enf,alg,l',lower) = aux acc l in
-	   let l' =
-	     if enf then Universe.make l
-	     else l'
-	   in acc', (d, l') :: left',
-              lower_add l d newlow, lower_union lower lower')
-	  (acc, [], LMap.empty, LMap.empty) l
-        in
-        let not_lower (d,l) =
-        (* We're checking if (d,l) is already implied by the lower
-	  constraints on some level u. If it represents l < u (d is Lt
-	  or d is Le and i > 0, the i < 0 case is impossible due to
-	  invariants of Univ), and the lower constraints only have l <=
-	  u then it is not implied. *)
-          Univ.Universe.exists
-          (fun (l,i) ->
-             let d =
-               if i == 0 then d
-               else match d with
-                    | Le -> Lt
-                    | d -> d
-             in
-             try let d' = LMap.find l lower in
-                 (* If d is stronger than the already implied lower
-                  * constraints we must keep it. *)
-                 compare_constraint_type d d' > 0
-             with Not_found ->
-               (** No constraint existing on l *) true) l
-        in
-        let left = List.uniquize (List.filter not_lower left) in
-        (acc, left, LMap.union newlow lower)
-      with Not_found -> acc, [], LMap.empty
-    and right =
-      try Some (LMap.find u right)
-      with Not_found -> None
-    in
-    let instantiate_lbound lbound =
-      let alg = LSet.mem u algs in
-	if alg then
-	  (* u is algebraic: we instantiate it with its lower bound, if any,
-              or enforce the constraints if it is bounded from the top. *)
-          let lower = remove_lower lbound lower in
-	  instantiate_with_lbound u lbound lower true false acc
-	else (* u is non algebraic *)
-	  match Universe.level lbound with
-	  | Some l -> (* The lowerbound is directly a level *) 
-	     (* u is not algebraic but has no upper bounds,
-  	        we instantiate it with its lower bound if it is a 
-	        different level, otherwise we keep it. *)
-             let lower = LMap.remove l lower in
-	     if not (Level.equal l u) then
-	       (* Should check that u does not 
-  	          have upper constraints that are not already in right *)
-	       let acc' = remove_alg l acc in
-		 instantiate_with_lbound u lbound lower false false acc'
-	     else acc, (true, false, lbound, lower)
-	  | None ->
-	     try
-	       (* Another universe represents the same lower bound,
-                  we can share them with no harm. *)
-	       let can, lower = find_inst insts lbound in
-               let lower = LMap.remove can lower in
-	       instantiate_with_lbound u (Universe.make can) lower false false acc
-	  with Not_found -> 
-	    (* We set u as the canonical universe representing lbound *)
-	    instantiate_with_lbound u lbound lower false true acc
-    in
-    let acc' acc = 
-      match right with
-      | None -> acc
-      | Some cstrs -> 
-	let dangling = List.filter (fun (d, r) -> not (LMap.mem r us)) cstrs in
-	  if List.is_empty dangling then acc
-	  else
-	    let ((ctx', us, algs, insts, cstrs), (enf,_,inst,lower as b)) = acc in
-	    let cstrs' = List.fold_left (fun cstrs (d, r) -> 
-	      if d == Univ.Le then
-		enforce_leq inst (Universe.make r) cstrs
-	      else
-		try let lev = Option.get (Universe.level inst) in
-		      Constraint.add (lev, d, r) cstrs
-		with Option.IsNone -> failwith "")
-	      cstrs dangling
-	    in
-	      (ctx', us, algs, insts, cstrs'), b
-    in
-      if not (LSet.mem u ctx) then acc' (acc, (true, false, Universe.make u, lower))
-      else
-	let lbound = compute_lbound left in
-	  match lbound with
-	  | None -> (* Nothing to do *)
-	    acc' (acc, (true, false, Universe.make u, lower))
-	  | Some lbound ->
-	     try acc' (instantiate_lbound lbound) 
-	     with Failure _ -> acc' (acc, (true, false, Universe.make u, lower))
-  and aux (ctx', us, algs, seen, cstrs as acc) u =
-    try acc, LMap.find u seen 
-    with Not_found -> instance acc u
-  in
-    LMap.fold (fun u v (ctx', us, algs, seen, cstrs as acc) -> 
-      if v == None then fst (aux acc u)
-      else LSet.remove u ctx', us, LSet.remove u algs, seen, cstrs)
-      us (ctx, us, algs, lbounds, cstrs)
-
-let normalize_context_set ctx us algs = 
-  let (ctx, csts) = ContextSet.levels ctx, ContextSet.constraints ctx in
-  let uf = UF.create () in
-  (** Keep the Prop/Set <= i constraints separate for minimization *)
-  let smallles, csts =
-    Constraint.fold (fun (l,d,r as cstr) (smallles, noneqs) ->
-        if d == Le then
-	  if Univ.Level.is_small l then
-	    if is_set_minimization () && LSet.mem r ctx then
-	      (Constraint.add cstr smallles, noneqs)
-	    else (smallles, noneqs)
-	  else if Level.is_small r then
-	    if Level.is_prop r then
-	      raise (Univ.UniverseInconsistency
-		       (Le,Universe.make l,Universe.make r,None))
-	    else (smallles, Constraint.add (l,Eq,r) noneqs)
-	  else (smallles, Constraint.add cstr noneqs)
-	else (smallles, Constraint.add cstr noneqs))
-    csts (Constraint.empty, Constraint.empty)
-  in
-  let csts = 
-    (* We first put constraints in a normal-form: all self-loops are collapsed
-       to equalities. *)
-    let g = Univ.LSet.fold (fun v g -> UGraph.add_universe v false g)
-			   ctx UGraph.empty_universes
-    in
-    let g =
-      Univ.Constraint.fold
-	(fun (l, d, r) g ->
-	 let g =
-	   if not (Level.is_small l || LSet.mem l ctx) then
-	     try UGraph.add_universe l false g
-	     with UGraph.AlreadyDeclared -> g
-	   else g
-	 in
-	 let g =
-	   if not (Level.is_small r || LSet.mem r ctx) then
-	     try UGraph.add_universe r false g
-	     with UGraph.AlreadyDeclared -> g
-	   else g
-	 in g) csts g
-    in
-    let g = Univ.Constraint.fold UGraph.enforce_constraint csts g in
-      UGraph.constraints_of_universes g
-  in
-  let noneqs =
-    Constraint.fold (fun (l,d,r as cstr) noneqs ->
-      if d == Eq then (UF.union l r uf; noneqs)
-      else (* We ignore the trivial Prop/Set <= i constraints. *)
-	if d == Le && Univ.Level.is_small l then noneqs
-	else if Univ.Level.is_prop l && d == Lt && Univ.Level.is_set r
-	then noneqs
-	else Constraint.add cstr noneqs)
-      csts Constraint.empty
-  in
-  let noneqs = Constraint.union noneqs smallles in
-  let partition = UF.partition uf in
-  let flex x = LMap.mem x us in
-  let ctx, subst, us, eqs = List.fold_left (fun (ctx, subst, us, cstrs) s -> 
-    let canon, (global, rigid, flexible) = choose_canonical ctx flex algs s in
-    (* Add equalities for globals which can't be merged anymore. *)
-    let cstrs = LSet.fold (fun g cst -> 
-      Constraint.add (canon, Univ.Eq, g) cst) global
-      cstrs 
-    in
-    (* Also add equalities for rigid variables *)
-    let cstrs = LSet.fold (fun g cst -> 
-      Constraint.add (canon, Univ.Eq, g) cst) rigid
-      cstrs
-    in
-    let subst = LSet.fold (fun f -> LMap.add f canon) rigid subst in
-    let subst = LSet.fold (fun f -> LMap.add f canon) flexible subst in
-    let canonu = Some (Universe.make canon) in
-    let us = LSet.fold (fun f -> LMap.add f canonu) flexible us in
-      (LSet.diff ctx flexible, subst, us, cstrs))
-    (ctx, LMap.empty, us, Constraint.empty) partition
-  in
-  (* Noneqs is now in canonical form w.r.t. equality constraints, 
-     and contains only inequality constraints. *)
-  let noneqs = subst_univs_level_constraints subst noneqs in
-  (* Compute the left and right set of flexible variables, constraints
-     mentionning other variables remain in noneqs. *)
-  let noneqs, ucstrsl, ucstrsr = 
-    Constraint.fold (fun (l,d,r as cstr) (noneq, ucstrsl, ucstrsr) -> 
-      let lus = LMap.mem l us and rus = LMap.mem r us in
-      let ucstrsl' = 
-	if lus then add_list_map l (d, r) ucstrsl
-	else ucstrsl
-      and ucstrsr' = 
-	add_list_map r (d, l) ucstrsr
-      in 
-      let noneqs = 
-	if lus || rus then noneq 
-	else Constraint.add cstr noneq
-      in (noneqs, ucstrsl', ucstrsr'))
-    noneqs (Constraint.empty, LMap.empty, LMap.empty)
-  in
-  (* Now we construct the instantiation of each variable. *)
-  let ctx', us, algs, inst, noneqs = 
-    minimize_univ_variables ctx us algs ucstrsr ucstrsl noneqs
-  in
-  let us = normalize_opt_subst us in
-    (us, algs), (ctx', Constraint.union noneqs eqs)
-
-(* let normalize_conkey = Profile.declare_profile "normalize_context_set" *)
-(* let normalize_context_set a b c = Profile.profile3 normalize_conkey normalize_context_set a b c *)
-
-let universes_of_constr c =
-  let rec aux s c = 
-    match kind_of_term c with
-    | Const (_, u) | Ind (_, u) | Construct (_, u) ->
-      LSet.fold LSet.add (Instance.levels u) s
-    | Sort u when not (Sorts.is_small u) -> 
-      let u = univ_of_sort u in
-      LSet.fold LSet.add (Universe.levels u) s
-    | _ -> fold_constr aux s c
-  in aux LSet.empty c
-
-let restrict_universe_context (univs,csts) s =
-  (* Universes that are not necessary to typecheck the term.
-     E.g. univs introduced by tactics and not used in the proof term. *)
-  let diff = LSet.diff univs s in
-  let rec aux diff candid univs ness = 
-    let (diff', candid', univs', ness') = 
-      Constraint.fold
-	(fun (l, d, r as c) (diff, candid, univs, csts) ->
-	  if not (LSet.mem l diff) then
-	    (LSet.remove r diff, candid, univs, Constraint.add c csts)
-	  else if not (LSet.mem r diff) then
-	    (LSet.remove l diff, candid, univs, Constraint.add c csts)
-	  else (diff, Constraint.add c candid, univs, csts))
-	candid (diff, Constraint.empty, univs, ness)
-    in
-      if ness' == ness then (LSet.diff univs diff', ness)
-      else aux diff' candid' univs' ness'
-  in aux diff csts univs Constraint.empty
-
-let simplify_universe_context (univs,csts) =
-  let uf = UF.create () in
-  let noneqs =
-    Constraint.fold (fun (l,d,r) noneqs ->
-      if d == Eq && (LSet.mem l univs || LSet.mem r univs) then 
-	(UF.union l r uf; noneqs)
-      else Constraint.add (l,d,r) noneqs)
-      csts Constraint.empty
-  in
-  let partition = UF.partition uf in
-  let flex x = LSet.mem x univs in
-  let subst, univs', csts' = List.fold_left (fun (subst, univs, cstrs) s -> 
-    let canon, (global, rigid, flexible) = choose_canonical univs flex LSet.empty s in
-    (* Add equalities for globals which can't be merged anymore. *)
-    let cstrs = LSet.fold (fun g cst -> 
-      Constraint.add (canon, Univ.Eq, g) cst) (LSet.union global rigid)
-      cstrs 
-    in
-    let subst = LSet.fold (fun f -> LMap.add f canon)
-      flexible subst
-    in (subst, LSet.diff univs flexible, cstrs))
-    (LMap.empty, univs, noneqs) partition
-  in
-  (* Noneqs is now in canonical form w.r.t. equality constraints, 
-     and contains only inequality constraints. *)
-  let csts' = subst_univs_level_constraints subst csts' in
-    (univs', csts'), subst
-
-let is_trivial_leq (l,d,r) =
-  Univ.Level.is_prop l && (d == Univ.Le || (d == Univ.Lt && Univ.Level.is_set r))
-
-(* Prop < i <-> Set+1 <= i <-> Set < i *)
-let translate_cstr (l,d,r as cstr) =
-  if Level.equal Level.prop l && d == Univ.Lt && not (Level.equal Level.set r) then
-    (Level.set, d, r)
-  else cstr
-
-let refresh_constraints univs (ctx, cstrs) =
-  let cstrs', univs' = 
-    Univ.Constraint.fold (fun c (cstrs', univs as acc) -> 
-      let c = translate_cstr c in
-      if is_trivial_leq c then acc
-      else (Univ.Constraint.add c cstrs', UGraph.enforce_constraint c univs))
-      cstrs (Univ.Constraint.empty, univs)
-  in ((ctx, cstrs'), univs')
-
-
-(**********************************************************************)
-(* Tools for sort-polymorphic inductive types                         *)
-
-(* Miscellaneous functions to remove or test local univ assumed to
-   occur only in the le constraints *)
-
-(*
-   Solve a system of universe constraint of the form
-
-   u_s11, ..., u_s1p1, w1 <= u1
-   ...
-   u_sn1, ..., u_snpn, wn <= un
-
-where
-
-  - the ui (1 <= i <= n) are universe variables,
-  - the sjk select subsets of the ui for each equations,
-  - the wi are arbitrary complex universes that do not mention the ui.
-*)
-
-let is_direct_sort_constraint s v = match s with
-  | Some u -> univ_level_mem u v
-  | None -> false
-
-let solve_constraints_system levels level_bounds level_min =
-  let open Univ in
-  let levels =
-    Array.mapi (fun i o ->
-      match o with
-      | Some u ->
-	(match Universe.level u with 
-	| Some u -> Some u 
-	| _ -> level_bounds.(i) <- Universe.sup level_bounds.(i) u; None)
-      | None -> None)
-      levels in
-  let v = Array.copy level_bounds in
-  let nind = Array.length v in
-  let clos = Array.map (fun _ -> Int.Set.empty) levels in
-  (* First compute the transitive closure of the levels dependencies *)
-  for i=0 to nind-1 do
-    for j=0 to nind-1 do
-      if not (Int.equal i j) && is_direct_sort_constraint levels.(j) v.(i) then
-	clos.(i) <- Int.Set.add j clos.(i);
-    done;
-  done;
-  let rec closure () = 
-    let continue = ref false in
-      Array.iteri (fun i deps -> 
-	let deps' = 
-	  Int.Set.fold (fun j acc -> Int.Set.union acc clos.(j)) deps deps
-	in 
-	  if Int.Set.equal deps deps' then ()
-	  else (clos.(i) <- deps'; continue := true))
-	clos;
-      if !continue then closure ()
-      else ()
-  in 
-  closure ();
-  for i=0 to nind-1 do
-    for j=0 to nind-1 do
-      if not (Int.equal i j) && Int.Set.mem j clos.(i) then
-	(v.(i) <- Universe.sup v.(i) level_bounds.(j));
-    done;
-  done;
-  v
diff --git a/library/universes.mli b/library/universes.mli
deleted file mode 100644
index d3a271b8..00000000
--- a/library/universes.mli
+++ /dev/null
@@ -1,238 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Environ
-open Univ
-
-val set_minimization : bool ref
-val is_set_minimization : unit -> bool
-
-(** Universes *)
-
-(** Global universe name <-> level mapping *)
-type universe_names = 
-  (Decl_kinds.polymorphic * Univ.universe_level) Idmap.t * Id.t Univ.LMap.t
-
-val global_universe_names : unit -> universe_names
-val set_global_universe_names : universe_names -> unit
-
-val pr_with_global_universes : Level.t -> Pp.std_ppcmds
-
-(** Local universe name <-> level mapping *)
-
-type universe_binders = (Id.t * Univ.universe_level) list
-					   
-val register_universe_binders : Globnames.global_reference -> universe_binders -> unit
-val universe_binders_of_global : Globnames.global_reference -> universe_binders
-
-(** The global universe counter *)
-val set_remote_new_univ_level : universe_level RemoteCounter.installer
-
-(** Side-effecting functions creating new universe levels. *)
-
-val new_univ_level : Names.dir_path -> universe_level
-val new_univ : Names.dir_path -> universe
-val new_Type : Names.dir_path -> types
-val new_Type_sort : Names.dir_path -> sorts
-
-val new_global_univ : unit -> universe in_universe_context_set
-val new_sort_in_family : sorts_family -> sorts
-
-(** {6 Constraints for type inference}
-    
-    When doing conversion of universes, not only do we have =/<= constraints but
-    also Lub constraints which correspond to unification of two levels which might
-    not be necessary if unfolding is performed.
-*)
-
-type universe_constraint_type = ULe | UEq | ULub
-
-type universe_constraint = universe * universe_constraint_type * universe
-module Constraints : sig
-  include Set.S with type elt = universe_constraint
-		       
-  val pr : t -> Pp.std_ppcmds
-end
-
-type universe_constraints = Constraints.t
-type 'a constraint_accumulator = universe_constraints -> 'a -> 'a option
-type 'a universe_constrained = 'a * universe_constraints
-type 'a universe_constraint_function = 'a -> 'a -> universe_constraints -> universe_constraints
-
-val subst_univs_universe_constraints : universe_subst_fn -> 
-  universe_constraints -> universe_constraints
-
-val enforce_eq_instances_univs : bool -> universe_instance universe_constraint_function
-
-val to_constraints : UGraph.t -> universe_constraints -> constraints
-
-(** [eq_constr_univs_infer u a b] is [true, c] if [a] equals [b] modulo alpha, casts,
-   application grouping, the universe constraints in [u] and additional constraints [c]. *)
-val eq_constr_univs_infer : UGraph.t -> 'a constraint_accumulator ->
-  constr -> constr -> 'a -> 'a option
-
-(** [eq_constr_univs_infer_With kind1 kind2 univs m n] is a variant of
-    {!eq_constr_univs_infer} taking kind-of-term functions, to expose
-    subterms of [m] and [n], arguments. *)
-val eq_constr_univs_infer_with :
-  (constr -> (constr,types) kind_of_term) ->
-  (constr -> (constr,types) kind_of_term) ->
-  UGraph.t -> 'a constraint_accumulator -> constr -> constr -> 'a -> 'a option
-
-(** [leq_constr_univs u a b] is [true, c] if [a] is convertible to [b]
-    modulo alpha, casts, application grouping, the universe constraints
-    in [u] and additional constraints [c]. *)
-val leq_constr_univs_infer : UGraph.t -> 'a constraint_accumulator ->
-  constr -> constr -> 'a -> 'a option
-
-(** [eq_constr_universes a b] [true, c] if [a] equals [b] modulo alpha, casts,
-    application grouping and the universe constraints in [c]. *)
-val eq_constr_universes : constr -> constr -> bool universe_constrained
-
-(** [leq_constr_universes a b] [true, c] if [a] is convertible to [b] modulo
-    alpha, casts, application grouping and the universe constraints in [c]. *)
-val leq_constr_universes : constr -> constr -> bool universe_constrained
-
-(** [eq_constr_universes a b] [true, c] if [a] equals [b] modulo alpha, casts,
-    application grouping and the universe constraints in [c]. *)
-val eq_constr_universes_proj : env -> constr -> constr -> bool universe_constrained
-
-(** Build a fresh instance for a given context, its associated substitution and 
-    the instantiated constraints. *)
-
-val fresh_instance_from_context : universe_context -> 
-  universe_instance constrained
-
-val fresh_instance_from : universe_context -> universe_instance option ->
-  universe_instance in_universe_context_set
-
-val fresh_sort_in_family : env -> sorts_family -> 
-  sorts in_universe_context_set
-val fresh_constant_instance : env -> constant ->
-  pconstant in_universe_context_set
-val fresh_inductive_instance : env -> inductive ->
-  pinductive in_universe_context_set
-val fresh_constructor_instance : env -> constructor ->
-  pconstructor in_universe_context_set
-
-val fresh_global_instance : ?names:Univ.Instance.t -> env -> Globnames.global_reference -> 
-  constr in_universe_context_set
-
-val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_constr -> 
-  constr in_universe_context_set
-
-(** Get fresh variables for the universe context.
-    Useful to make tactics that manipulate constrs in universe contexts polymorphic. *)
-val fresh_universe_context_set_instance : universe_context_set -> 
-  universe_level_subst * universe_context_set
-
-(** Raises [Not_found] if not a global reference. *)
-val global_of_constr : constr -> Globnames.global_reference puniverses
-
-val global_app_of_constr : constr -> Globnames.global_reference puniverses * constr option
-
-val constr_of_global_univ : Globnames.global_reference puniverses -> constr
-
-val extend_context : 'a in_universe_context_set -> universe_context_set -> 
-  'a in_universe_context_set
-
-(** Simplification and pruning of constraints:
-    [normalize_context_set ctx us]
-
-    - Instantiate the variables in [us] with their most precise
-    universe levels respecting the constraints.
-
-    - Normalizes the context [ctx] w.r.t. equality constraints, 
-    choosing a canonical universe in each equivalence class 
-    (a global one if there is one) and transitively saturate
-    the constraints w.r.t to the equalities. *)
-
-module UF : Unionfind.PartitionSig with type elt = universe_level
-
-type universe_opt_subst = universe option universe_map
-
-val make_opt_subst : universe_opt_subst -> universe_subst_fn
-
-val subst_opt_univs_constr : universe_opt_subst -> constr -> constr
-
-val normalize_context_set : universe_context_set -> 
-  universe_opt_subst (* The defined and undefined variables *) ->
-  universe_set (* univ variables that can be substituted by algebraics *) -> 
-  (universe_opt_subst * universe_set) in_universe_context_set
-
-val normalize_univ_variables : universe_opt_subst -> 
-  universe_opt_subst * universe_set * universe_set * universe_subst
-
-val normalize_univ_variable : 
-  find:(universe_level -> universe) ->
-  update:(universe_level -> universe -> universe) ->
-  universe_level -> universe
-
-val normalize_univ_variable_opt_subst : universe_opt_subst ref ->
-  (universe_level -> universe)
-
-val normalize_univ_variable_subst : universe_subst ref ->
-  (universe_level -> universe)
-
-val normalize_universe_opt_subst : universe_opt_subst ref ->
-  (universe -> universe)
-
-val normalize_universe_subst : universe_subst ref ->
-  (universe -> universe)
-
-(** Create a fresh global in the global environment, without side effects.
-    BEWARE: this raises an ANOMALY on polymorphic constants/inductives: 
-    the constraints should be properly added to an evd. 
-    See Evd.fresh_global, Evarutil.new_global, and pf_constr_of_global for
-    the proper way to get a fresh copy of a global reference. *)
-val constr_of_global : Globnames.global_reference -> constr
-
-(** ** DEPRECATED ** synonym of [constr_of_global] *)
-val constr_of_reference : Globnames.global_reference -> constr
-
-(** [unsafe_constr_of_global gr] turns [gr] into a constr, works on polymorphic
-    references by taking the original universe instance that is not recorded 
-    anywhere. The constraints are forgotten as well. DO NOT USE in new code. *)
-val unsafe_constr_of_global : Globnames.global_reference -> constr in_universe_context
-
-(** Returns the type of the global reference, by creating a fresh instance of polymorphic 
-    references and computing their instantiated universe context. (side-effect on the
-    universe counter, use with care). *)
-val type_of_global : Globnames.global_reference -> types in_universe_context_set
-
-(** [unsafe_type_of_global gr] returns [gr]'s type, works on polymorphic
-    references by taking the original universe instance that is not recorded 
-    anywhere. The constraints are forgotten as well. 
-    USE with care. *)
-val unsafe_type_of_global : Globnames.global_reference -> types
-
-(** Full universes substitutions into terms *)
-
-val nf_evars_and_universes_opt_subst : (existential -> constr option) -> 
-  universe_opt_subst -> constr -> constr
-
-(** Shrink a universe context to a restricted set of variables *)
-
-val universes_of_constr : constr -> universe_set
-val restrict_universe_context : universe_context_set -> universe_set -> universe_context_set
-val simplify_universe_context : universe_context_set -> 
-  universe_context_set * universe_level_subst
-
-val refresh_constraints : UGraph.t -> universe_context_set -> universe_context_set * UGraph.t
-
-(** Pretty-printing *)
-
-val pr_universe_opt_subst : universe_opt_subst -> Pp.std_ppcmds
-
-(** {6 Support for old-style sort-polymorphism } *)
-
-val solve_constraints_system : universe option array -> universe array -> universe array ->
-  universe array