flambda-backend: Fix include functor issue after 4.14 merge. (#948)

testsuite/tests/typing-modules/include_functor.ml

@@ -675,3 +675,25 @@ Line 20, characters 16-17:
 Error: This expression has type int but an expression was expected of type
          string
 |}];;
+
+(* Test 21: Check that scraping of result type happens in environment expanded
+   with parameter type. *)
+module M21 = struct
+  module F (_ : sig end) = struct
+    module type S = sig end
+  end
+
+  module P = struct
+    module Make (M : sig end) : F(M).S = struct end
+  end
+
+  include functor P.Make
+end;;
+[%%expect{|
+module M21 :
+  sig
+    module F : sig end -> sig module type S = sig end end
+    module P : sig module Make : functor (M : sig end) -> F(M).S end
+  end
+|}];;
+

typing/typemod.ml

@@ -131,38 +131,42 @@ let extract_sig_functor_open funct_body env loc mty sig_acc =
         with Includemod.Error msg ->
           raise (Error(loc, env, Not_included_functor msg))
       in
+      (* We must scrape the result type in an environment expanded with the
+         parameter type (to avoid `Not_found` exceptions when it is referenced).
+         Because we don't have an actual parameter, we create definitions for
+         the parameter's types with [sig_make_manifest].  References to this
+         fake parameter are eliminated later.  *)
+      let extended_env =
+        match param with
+        | None -> env
+        | Some id ->
+          let sg_param = Mtype.sig_make_manifest sig_acc in
+          Env.add_module ~arg:true id Mp_present (Mty_signature sg_param) env
+      in
       let incl_kind, sg_result =
         (* Accept functor types of the forms:
               sig..end -> sig..end
            and
               sig..end -> () -> sig..end *)
-        match Mtype.scrape env mty_result with
+        match Mtype.scrape extended_env mty_result with
         | Mty_signature sg_result -> Tincl_functor coercion, sg_result
         | Mty_functor (Unit,_) when funct_body && Mtype.contains_type env mty ->
             raise (Error (loc, env, Not_includable_in_functor_body))
         | Mty_functor (Unit,mty_result) -> begin
-            match Mtype.scrape env mty_result with
+            match Mtype.scrape extended_env mty_result with
             | Mty_signature sg_result -> Tincl_gen_functor coercion, sg_result
             | sg -> raise (Error (loc,env,Signature_result_expected
                                             (Mty_functor (Unit,sg))))
           end
         | sg -> raise (Error (loc,env,Signature_result_expected sg))
       in
-      (* Like the [Pmod_apply] case, we want to use [nondep_supertype] to
-         eliminate references to the functor's parameter in its result type.
-         Unlike that case, we don't have an actual parameter, just the previous
-         contents of the module currently being checked.  So we create
-         definitions for the parameter's types with [sig_make_manifest] before
-         the call to [nondep_sig]. *)
+      (* Here we eliminate references to the non-existent parameter module using
+         [nondep_sig]. *)
       let sg =
         match param with
         | None -> sg_result
         | Some id ->
-          let sg_param = Mtype.sig_make_manifest sig_acc in
-          let env =
-            Env.add_module ~arg:true id Mp_present (Mty_signature sg_param) env
-          in
-          try Mtype.nondep_sig env [id] sg_result
+          try Mtype.nondep_sig extended_env [id] sg_result
           with Ctype.Nondep_cannot_erase _ ->
             raise(Error(loc, env, Cannot_eliminate_dependency
                                     (Functor_included, mty_func)))