From a4c7f8bd98be2a200489325ff7c5061cf80ab4f3 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <gareuselesinge@debian.org>
Date: Tue, 27 Dec 2016 16:53:30 +0100
Subject: Imported Upstream version 8.6

---
 library/declaremods.ml | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

(limited to 'library/declaremods.ml')

diff --git a/library/declaremods.ml b/library/declaremods.ml
index 04348415..b2806a1a 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Declarations
@@ -371,7 +371,7 @@ let rec replace_module_object idl mp0 objs0 mp1 objs1 =
   match idl, objs0 with
   | _,[] -> []
   | id::idl,(id',obj)::tail when Id.equal id id' ->
-    assert (object_has_tag obj "MODULE");
+    assert (String.equal (object_tag obj) "MODULE");
     let mp_id = MPdot(mp0, Label.of_id id) in
     let objs = match idl with
       | [] -> Lib.subst_objects (map_mp mp1 mp_id empty_delta_resolver) objs1
@@ -642,7 +642,11 @@ let declare_module interp_modast id args res mexpr_o fs =
   let env = Global.env () in
   let mty_entry_o, subs, inl_res = match res with
     | Enforce (mty,ann) ->
-        Some (fst (interp_modast env ModType mty)), [], inl2intopt ann
+        let inl = inl2intopt ann in
+        let mte, _ = interp_modast env ModType mty in
+        (* We check immediately that mte is well-formed *)
+        let _ = Mod_typing.translate_mse env None inl mte in
+        Some mte, [], inl
     | Check mtys ->
 	None, build_subtypes interp_modast env mp arg_entries_r mtys,
         default_inline ()
@@ -727,7 +731,10 @@ let declare_modtype interp_modast id args mtys (mty,ann) fs =
   let arg_entries_r = intern_args interp_modast args in
   let params = mk_params_entry arg_entries_r in
   let env = Global.env () in
-  let entry = params, fst (interp_modast env ModType mty) in
+  let mte, _ = interp_modast env ModType mty in
+  (* We check immediately that mte is well-formed *)
+  let _ = Mod_typing.translate_mse env None inl mte in
+  let entry = params, mte in
   let sub_mty_l = build_subtypes interp_modast env mp arg_entries_r mtys 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
@@ -815,7 +822,7 @@ let protect_summaries f =
   try f fs
   with reraise ->
     (* Something wrong: undo the whole process *)
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = Summary.unfreeze_summaries fs in
     iraise reraise
 
@@ -890,7 +897,13 @@ let start_library dir =
   Lib.start_compilation dir mp;
   Lib.add_frozen_state ()
 
+let end_library_hook = ref ignore
+let append_end_library_hook f =
+  let old_f = !end_library_hook in
+  end_library_hook := fun () -> old_f(); f ()
+
 let end_library ?except dir =
+  !end_library_hook();
   let oname = Lib.end_compilation_checks dir in
   let mp,cenv,ast = Global.export ?except dir in
   let prefix, lib_stack = Lib.end_compilation oname in
-- 
cgit v1.2.3