From b2b74bf07937b635897210674dcf2ca3e5759d46 Mon Sep 17 00:00:00 2001
From: Chris Casinghino <ccasinghino@janestreet.com>
Date: Thu, 1 Dec 2022 01:31:40 -0500
Subject: [PATCH] Fix bug in `Mtype.strengthen_lazy` causing spurious typing
 errors (#11776)

(cherry picked from commit 4243c4b26d2bdcc02d00a6f0b5de7df909788ee2)
---
 Changes                                    |  3 ++
 testsuite/tests/typing-modules/functors.ml | 44 ++++++++++++++++++++++
 typing/env.ml                              |  8 ++++
 typing/env.mli                             |  2 +
 typing/mtype.ml                            |  3 ++
 5 files changed, 60 insertions(+)

diff --git a/Changes b/Changes
index 0bf5a3ea2900..6b6c8562ae1c 100644
--- a/Changes
+++ b/Changes
@@ -75,6 +75,9 @@ OCaml 4.14 maintenance branch
   multiple threads.
   (Marc Lasson, Nicolás Ojeda Bär, review by Gabriel Scherer and David Allsopp)
 
+- #11776: Extend environment with functor parameters in `strengthen_lazy`.
+  (Chris Casinghino and Luke Maurer, review by Gabriel Scherer)
+
 OCaml 4.14.0 (28 March 2022)
 ----------------------------
 
diff --git a/testsuite/tests/typing-modules/functors.ml b/testsuite/tests/typing-modules/functors.ml
index 932bc9f9fc33..3fa34a1d89c4 100644
--- a/testsuite/tests/typing-modules/functors.ml
+++ b/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
+|}]
diff --git a/typing/env.ml b/typing/env.ml
index 29d7cdb0e42b..6e324888da89 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -2223,6 +2223,14 @@ and add_cltype ?shape id ty env =
 let add_module ?arg ?shape id presence mty env =
   add_module_declaration ~check:false ?arg ?shape id presence (md mty) 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_local_type path info env =
   { env with
     local_constraints = Path.Map.add path info env.local_constraints }
diff --git a/typing/env.mli b/typing/env.mli
index 55ab3a5b6f01..49040b83cb34 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -289,6 +289,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 ->
diff --git a/typing/mtype.ml b/typing/mtype.ml
index d649bcdc8714..f6aba7922288 100644
--- a/typing/mtype.ml
+++ b/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)