Fix for spurious typing error related to expanding through functor ar…

…guments (ocaml-flambda#997)

ocaml/testsuite/tests/typing-modules/functors.ml

@@ -1701,3 +1701,47 @@ Error: The functor application Bar(A)(FiveArgsExt)(TY)(TY)(TY)(TY)(TY) is ill-ty
        8. Module TY matches the expected module type ty
        9. Module TY matches the expected module type ty
 |}]
+
+module Shape_arg = struct
+  module M1 (Arg1 : sig end) = struct
+    module type S1 = sig
+      type t
+    end
+  end
+
+  module type S2 = sig
+    module Make (Arg2 : sig end) : M1(Arg2).S1
+  end
+
+  module M2 : S2 = struct
+    module Make (Arg3 : sig end) = struct
+      type t = T
+    end
+  end
+
+  module M3 (Arg4 : sig end) = struct
+    module type S3 = sig
+      type t = M2.Make(Arg4).t
+    end
+  end
+
+  module M4 (Arg5 : sig end) : M3(Arg5).S3 = struct
+    module M5 = M2.Make (Arg5)
+
+    type t = M5.t
+  end
+end
+[%%expect{|
+module Shape_arg :
+  sig
+    module M1 :
+      functor (Arg1 : sig end) -> sig module type S1 = sig type t end end
+    module type S2 =
+      sig module Make : functor (Arg2 : sig end) -> M1(Arg2).S1 end
+    module M2 : S2
+    module M3 :
+      functor (Arg4 : sig end) ->
+        sig module type S3 = sig type t = M2.Make(Arg4).t end end
+    module M4 : functor (Arg5 : sig end) -> M3(Arg5).S3
+  end
+|}]

ocaml/typing/env.ml

@@ -2311,6 +2311,14 @@ and add_cltype ?shape id ty env =
   let shape = shape_or_leaf ty.clty_uid shape in
   store_cltype id ty shape env
 
+let add_module_lazy ~update_summary id presence mty env =
+  let md = Subst.Lazy.{mdl_type = mty;
+                       mdl_attributes = [];
+                       mdl_loc = Location.none;
+                       mdl_uid = Uid.internal_not_actually_unique}
+  in
+  add_module_declaration_lazy ~update_summary id presence md env
+
 let add_module ?arg ?shape id presence mty env =
   add_module_declaration ~check:false ?arg ?shape id presence (md mty) env
 

ocaml/typing/env.mli

@@ -302,6 +302,8 @@ val add_extension:
   check:bool -> rebind:bool -> Ident.t -> extension_constructor -> t -> t
 val add_module: ?arg:bool -> ?shape:Shape.t ->
   Ident.t -> module_presence -> module_type -> t -> t
+val add_module_lazy: update_summary:bool ->
+  Ident.t -> module_presence -> Subst.Lazy.modtype -> t -> t
 val add_module_declaration: ?arg:bool -> ?shape:Shape.t -> check:bool ->
   Ident.t -> module_presence -> module_declaration -> t -> t
 val add_module_declaration_lazy: update_summary:bool ->

ocaml/typing/mtype.ml

@@ -46,6 +46,9 @@ let rec strengthen_lazy ~aliasable env mty p =
       MtyL_signature(strengthen_lazy_sig ~aliasable env sg p)
   | MtyL_functor(Named (Some param, arg), res)
     when !Clflags.applicative_functors ->
+      let env =
+        Env.add_module_lazy ~update_summary:false param Mp_present arg env
+      in
       MtyL_functor(Named (Some param, arg),
         strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
   | MtyL_functor(Named (None, arg), res)