Checker/subtyping.ml: avoid adding in env a module already there (fix #2609)

 When doing a [check_subtypes env mtb1 mtb2], we used to always add [mtb1]
 in the environment. But since the stricter checks of commit r14150, this
 is an error if the environment already knows [mtb1] (for instance
 when doing (F M) and checking that M is compatible with the type of the
 arg of F.

 [check_subtypes] now expect [mtb1] to be already in env, and we move the
 add_module to the unique call site of this function that requires it.

 Moreover, we solve a second issue : when subtyping a functor, we
 update the environment once inside the functor, and this is also
 refused by the checks of commits r14150. So we first remove the module
 name from the env before doing the update. Since the module added
 earlier was a functor, there is no inner defs to chase in env.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14615 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 16 insertions, 12 deletions

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 315571705..9942816d1 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -253,18 +253,22 @@ and check_module env mp mb =
 	let sign = check_modexpr env mexpr mb.mod_mp mb.mod_delta in
 	let (_:struct_expr_body) =
 	  check_modtype env mb.mod_type mb.mod_mp mb.mod_delta in
-          check_subtypes env 
-	    {typ_mp=mp;
-	     typ_expr=sign;
-	     typ_expr_alg=None;
-	     typ_constraints=Univ.empty_constraint;
-	     typ_delta = mb.mod_delta;}
-	    {typ_mp=mp;
-	     typ_expr=mb.mod_type;
-	     typ_expr_alg=None;
-	     typ_constraints=Univ.empty_constraint;
-	     typ_delta = mb.mod_delta;};
-	  
+	let mtb1 =
+	  {typ_mp=mp;
+	   typ_expr=sign;
+	   typ_expr_alg=None;
+	   typ_constraints=Univ.empty_constraint;
+	   typ_delta = mb.mod_delta;}
+	and mtb2 =
+	  {typ_mp=mp;
+	   typ_expr=mb.mod_type;
+	   typ_expr_alg=None;
+	   typ_constraints=Univ.empty_constraint;
+	   typ_delta = mb.mod_delta;}
+	in
+	let env = add_module (module_body_of_type mp mtb1) env in
+	check_subtypes env mtb1 mtb2
+
 and check_structure_field env mp lab res = function
   | SFBconst cb ->
       let c = make_con mp empty_dirpath lab in