diff --git a/.depend b/.depend
index adb6d709870a..45da7d2febf4 100644
--- a/.depend
+++ b/.depend
@@ -1195,6 +1195,7 @@ typing/subst.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/local_store.cmi \
+    utils/lazy_backtrack.cmi \
     typing/ident.cmi \
     utils/clflags.cmi \
     typing/btype.cmi \
@@ -1207,6 +1208,7 @@ typing/subst.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/local_store.cmx \
+    utils/lazy_backtrack.cmx \
     typing/ident.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
@@ -1215,6 +1217,7 @@ typing/subst.cmx : \
 typing/subst.cmi : \
     typing/types.cmi \
     typing/path.cmi \
+    parsing/parsetree.cmi \
     parsing/location.cmi \
     typing/ident.cmi
 typing/tast_iterator.cmo : \
diff --git a/Changes b/Changes
index b6458e341919..a1eb9158d30e 100644
--- a/Changes
+++ b/Changes
@@ -130,6 +130,9 @@ Working version
 - #10555: Do not use ghost locations for type constraints
   (Nicolás Ojeda Bär, report by Anton Bachin, review by Thomas Refis)
 
+- #10559: Evaluate signature substitutions lazily
+  (Stephen Dolan, review by Leo White)
+
 ### Build system:
 
 ### Bug fixes:
diff --git a/boot/ocamlc b/boot/ocamlc
index 6ade52006c98..fcea0c2c614d 100755
Binary files a/boot/ocamlc and b/boot/ocamlc differ
diff --git a/boot/ocamllex b/boot/ocamllex
index 8292ef79202f..bc245273cea7 100755
Binary files a/boot/ocamllex and b/boot/ocamllex differ
diff --git a/testsuite/tests/shadow_include/shadow_all.ml b/testsuite/tests/shadow_include/shadow_all.ml
index d409b1365fe4..2b63387812b7 100644
--- a/testsuite/tests/shadow_include/shadow_all.ml
+++ b/testsuite/tests/shadow_include/shadow_all.ml
@@ -304,7 +304,7 @@ module NN :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -329,7 +329,7 @@ module Type :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -352,7 +352,7 @@ module Module :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -370,12 +370,12 @@ end
 [%%expect{|
 module Module_type :
   sig
-    module type U = sig end
+    module type U = N.T
     type t = N.t
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -398,7 +398,7 @@ module Exception :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -421,7 +421,7 @@ module Extension :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -444,7 +444,7 @@ module Class :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
@@ -467,7 +467,7 @@ module Class_type :
     val unit : unit
     external e : unit -> unit = "%identity"
     module M = N.M
-    module type T = sig end
+    module type T = N.T
     exception E
     type ext = N.ext = ..
     type ext += C
diff --git a/testsuite/tests/typing-modules/functors.ml b/testsuite/tests/typing-modules/functors.ml
index 1459c66a08b5..932bc9f9fc33 100644
--- a/testsuite/tests/typing-modules/functors.ml
+++ b/testsuite/tests/typing-modules/functors.ml
@@ -1310,22 +1310,14 @@ module Add_one' :
     module type t = arg -> sig type arg = A.arg end
   end
 module Add_one :
-  sig
-    type witness
-    module M = Add_one'.M
-    module type t = arg -> sig type arg = A.arg end
-  end
+  sig type witness module M = Add_one'.M module type t = Add_one'.t end
 module Add_three' :
   sig
     module M : arg -> arg -> arg -> sig type arg = A.arg end
     module type t = arg -> arg -> arg -> sig type arg = A.arg end
   end
 module Add_three :
-  sig
-    module M = Add_three'.M
-    module type t = arg -> arg -> arg -> sig type arg = A.arg end
-    type witness
-  end
+  sig module M = Add_three'.M module type t = Add_three'.t type witness end
 Line 22, characters 21-43:
 22 | module Wrong_intro = F(Add_three')(A)(A)(A)
                           ^^^^^^^^^^^^^^^^^^^^^^
@@ -1336,10 +1328,7 @@ Error: The functor application is ill-typed.
          functor (X : $T1) arg arg arg -> ...
        1. Modules do not match:
             Add_three' :
-            sig
-              module M = Add_three'.M
-              module type t = arg -> arg -> arg -> sig type arg = A.arg end
-            end
+            sig module M = Add_three'.M module type t = Add_three'.t end
           is not included in
             $T1 = sig type witness module type t module M : t end
           The type `witness' is required but not provided
@@ -1360,10 +1349,7 @@ Error: The functor application is ill-typed.
          functor (X : ...) arg arg arg -> ...
        1. The following extra argument is provided
               Add_one' :
-              sig
-                module M = Add_one'.M
-                module type t = arg -> sig type arg = A.arg end
-              end
+              sig module M = Add_one'.M module type t = Add_one'.t end
        2. Module Add_three matches the expected module type
        3. Module A matches the expected module type arg
        4. Module A matches the expected module type arg
@@ -1388,7 +1374,7 @@ Error: The functor application is ill-typed.
               sig
                 type witness = Add_one.witness
                 module M = Add_one'.M
-                module type t = arg -> sig type arg = A.arg end
+                module type t = Add_one.t
               end
        2. Module Add_three matches the expected module type
        3. Module A matches the expected module type arg
diff --git a/typing/env.ml b/typing/env.ml
index b06f28cef502..ba7057c7512d 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -500,10 +500,6 @@ type t = {
   flags: int;
 }
 
-and module_declaration_lazy =
-  (Subst.t * Subst.scoping * module_declaration, module_declaration)
-    Lazy_backtrack.t
-
 and module_components =
   {
     alerts: alerts;
@@ -520,7 +516,7 @@ and components_maker = {
   cm_prefixing_subst: Subst.t;
   cm_path: Path.t;
   cm_addr: address_lazy;
-  cm_mty: Types.module_type;
+  cm_mty: Subst.Lazy.modtype;
 }
 
 and module_components_repr =
@@ -575,7 +571,7 @@ and type_data =
     tda_descriptions : type_descriptions; }
 
 and module_data =
-  { mda_declaration : module_declaration_lazy;
+  { mda_declaration : Subst.Lazy.module_decl;
     mda_components : module_components;
     mda_address : address_lazy; }
 
@@ -584,7 +580,7 @@ and module_entry =
   | Mod_persistent
   | Mod_unbound of module_unbound_reason
 
-and modtype_data = modtype_declaration
+and modtype_data = Subst.Lazy.modtype_declaration
 
 and class_data =
   { clda_declaration : class_declaration;
@@ -671,9 +667,6 @@ let check_shadowing env = function
   | `Class None | `Class_type None | `Component None ->
       None
 
-let subst_modtype_maker (subst, scoping, md) =
-  {md with md_type = Subst.modtype scoping subst md.md_type}
-
 let empty = {
   values = IdTbl.empty; constrs = TycompTbl.empty;
   labels = TycompTbl.empty; types = IdTbl.empty;
@@ -747,7 +740,8 @@ let check_functor_application =
 let strengthen =
   (* to be filled with Mtype.strengthen *)
   ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
-         aliasable:bool -> t -> module_type -> Path.t -> module_type)
+         aliasable:bool -> t -> Subst.Lazy.modtype ->
+         Path.t -> Subst.Lazy.modtype)
 
 let md md_type =
   {md_type; md_attributes=[]; md_loc=Location.none
@@ -865,7 +859,7 @@ let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
   in
   let mda_address = Lazy_backtrack.create_forced (Aident id) in
   let mda_declaration =
-    Lazy_backtrack.create (Subst.identity, Subst.Make_local, md)
+    Subst.(Lazy.module_decl Make_local identity (Lazy.of_module_decl md))
   in
   let mda_components =
     let freshening_subst =
@@ -873,7 +867,7 @@ let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } =
     in
     components_of_module ~alerts ~uid:md.md_uid
       empty freshening_subst Subst.identity
-      path mda_address (Mty_signature sign)
+      path mda_address (Subst.Lazy.of_modtype (Mty_signature sign))
   in
   {
     mda_declaration;
@@ -1013,16 +1007,38 @@ let find_module ~alias path env =
   match path with
   | Pident id ->
       let data = find_ident_module id env in
-      Lazy_backtrack.force subst_modtype_maker data.mda_declaration
+      Subst.Lazy.force_module_decl data.mda_declaration
   | Pdot(p, s) ->
       let sc = find_structure_components p env in
       let data = NameMap.find s sc.comp_modules in
-      Lazy_backtrack.force subst_modtype_maker data.mda_declaration
+      Subst.Lazy.force_module_decl data.mda_declaration
   | Papply(p1, p2) ->
       let fc = find_functor_components p1 env in
       if alias then md (fc.fcomp_res)
       else md (modtype_of_functor_appl fc p1 p2)
 
+let find_module_lazy ~alias path env =
+  match path with
+  | Pident id ->
+      let data = find_ident_module id env in
+      data.mda_declaration
+  | Pdot(p, s) ->
+      let sc = find_structure_components p env in
+      let data = NameMap.find s sc.comp_modules in
+      data.mda_declaration
+  | Papply(p1, p2) ->
+      let fc = find_functor_components p1 env in
+      let md =
+        if alias then md (fc.fcomp_res)
+        else md (modtype_of_functor_appl fc p1 p2)
+      in
+      Subst.Lazy.of_module_decl md
+
+let find_strengthened_module ~aliasable path env =
+  let md = find_module_lazy ~alias:true path env in
+  let mty = !strengthen ~aliasable env md.mdl_type path in
+  Subst.Lazy.force_modtype mty
+
 let find_value_full path env =
   match path with
   | Pident id -> begin
@@ -1043,7 +1059,7 @@ let find_type_full path env =
       NameMap.find s sc.comp_types
   | Papply _ -> raise Not_found
 
-let find_modtype path env =
+let find_modtype_lazy path env =
   match path with
   | Pident id -> IdTbl.find_same id env.modtypes
   | Pdot(p, s) ->
@@ -1051,6 +1067,9 @@ let find_modtype path env =
       NameMap.find s sc.comp_modtypes
   | Papply _ -> raise Not_found
 
+let find_modtype path env =
+  Subst.Lazy.force_modtype_decl (find_modtype_lazy path env)
+
 let find_class_full path env =
   match path with
   | Pident id -> IdTbl.find_same id env.classes
@@ -1226,8 +1245,8 @@ let rec normalize_module_path lax env = function
       expand_module_path lax env path
 
 and expand_module_path lax env path =
-  try match find_module ~alias:true path env with
-    {md_type=Mty_alias path1} ->
+  try match find_module_lazy ~alias:true path env with
+    {mdl_type=MtyL_alias path1} ->
       let path' = normalize_module_path lax env path1 in
       if lax || !Clflags.transparent_modules then path' else
       let id = Path.head path in
@@ -1283,13 +1302,16 @@ let rec normalize_modtype_path env path =
   expand_modtype_path env path
 
 and expand_modtype_path env path =
-  match (find_modtype path env).mtd_type with
-  | Some (Mty_ident path) -> normalize_modtype_path env path
+  match (find_modtype_lazy path env).mtdl_type with
+  | Some (MtyL_ident path) -> normalize_modtype_path env path
   | _ | exception Not_found -> path
 
 let find_module path env =
   find_module ~alias:false path env
 
+let find_module_lazy path env =
+  find_module_lazy ~alias:false path env
+
 (* Find the manifest type associated to a type when appropriate:
    - the type should be public or should have a private row,
    - the type should have an associated manifest type. *)
@@ -1319,11 +1341,14 @@ let find_type_expansion_opt path env =
       (decl.type_params, body, decl.type_expansion_scope)
   | _ -> raise Not_found
 
-let find_modtype_expansion path env =
-  match (find_modtype path env).mtd_type with
+let find_modtype_expansion_lazy path env =
+  match (find_modtype_lazy path env).mtdl_type with
   | None -> raise Not_found
   | Some mty -> mty
 
+let find_modtype_expansion path env =
+  Subst.Lazy.force_modtype (find_modtype_expansion_lazy path env)
+
 let rec is_functor_arg path env =
   match path with
     Pident id ->
@@ -1374,15 +1399,17 @@ type iter_cont = unit -> unit
 let iter_env_cont = ref []
 
 let rec scrape_alias_for_visit env (sub : Subst.t option) mty =
+  let open Subst.Lazy in
   match mty with
-  | Mty_alias path ->
+  | MtyL_alias path ->
       begin match may_subst Subst.module_path sub path with
       | Pident id
         when Ident.persistent id
           && not (Persistent_env.looked_up !persistent_env (Ident.name id)) ->
           false
       | path -> (* PR#6600: find_module may raise Not_found *)
-          try scrape_alias_for_visit env sub (find_module path env).md_type
+          try
+            scrape_alias_for_visit env sub (find_module_lazy path env).mdl_type
           with Not_found -> false
       end
   | _ -> true
@@ -1490,22 +1517,23 @@ let find_shadowed_types path env =
 (* Expand manifest module type names at the top of the given module type *)
 
 let rec scrape_alias env sub ?path mty =
+  let open Subst.Lazy in
   match mty, path with
-    Mty_ident _, _ ->
+    MtyL_ident _, _ ->
       let p =
-        match may_subst (Subst.modtype Keep) sub mty with
-        | Mty_ident p -> p
+        match may_subst (Subst.Lazy.modtype Keep) sub mty with
+        | MtyL_ident p -> p
         | _ -> assert false (* only [Mty_ident]s in [sub] *)
       in
       begin try
-        scrape_alias env sub (find_modtype_expansion p env) ?path
+        scrape_alias env sub (find_modtype_expansion_lazy p env) ?path
       with Not_found ->
         mty
       end
-  | Mty_alias path, _ ->
+  | MtyL_alias path, _ ->
       let path = may_subst Subst.module_path sub path in
       begin try
-        scrape_alias env sub (find_module path env).md_type ~path
+        scrape_alias env sub ((find_module_lazy path env).mdl_type) ~path
       with Not_found ->
         (*Location.prerr_warning Location.none
           (Warnings.No_cmi_file (Path.name path));*)
@@ -1525,67 +1553,69 @@ let prefix_idents root freshening_sub prefixing_sub sg =
       let id' = Ident.rename id in
       id', Some (add_fn id (Pident id') sub)
   in
+  let open Subst.Lazy in
   let rec prefix_idents root items_and_paths freshening_sub prefixing_sub =
     function
     | [] -> (List.rev items_and_paths, freshening_sub, prefixing_sub)
-    | Sig_value(id, _, _) as item :: rem ->
+    | SigL_value(id, _, _) as item :: rem ->
       let p = Pdot(root, Ident.name id) in
       prefix_idents root
         ((item, p) :: items_and_paths) freshening_sub prefixing_sub rem
-    | Sig_type(id, td, rs, vis) :: rem ->
+    | SigL_type(id, td, rs, vis) :: rem ->
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub = refresh id Subst.add_type freshening_sub in
       prefix_idents root
-        ((Sig_type(id', td, rs, vis), p) :: items_and_paths)
+        ((SigL_type(id', td, rs, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_type id' p prefixing_sub)
         rem
-    | Sig_typext(id, ec, es, vis) :: rem ->
+    | SigL_typext(id, ec, es, vis) :: rem ->
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub = refresh id Subst.add_type freshening_sub in
       (* we extend the substitution in case of an inlined record *)
       prefix_idents root
-        ((Sig_typext(id', ec, es, vis), p) :: items_and_paths)
+        ((SigL_typext(id', ec, es, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_type id' p prefixing_sub)
         rem
-    | Sig_module(id, pres, md, rs, vis) :: rem ->
+    | SigL_module(id, pres, md, rs, vis) :: rem ->
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub = refresh id Subst.add_module freshening_sub in
       prefix_idents root
-        ((Sig_module(id', pres, md, rs, vis), p) :: items_and_paths)
+        ((SigL_module(id', pres, md, rs, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_module id' p prefixing_sub)
         rem
-    | Sig_modtype(id, mtd, vis) :: rem ->
+    | SigL_modtype(id, mtd, vis) :: rem ->
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub =
         refresh id (fun i p s -> Subst.add_modtype i (Mty_ident p) s)
           freshening_sub
       in
       prefix_idents root
-        ((Sig_modtype(id', mtd, vis), p) :: items_and_paths)
+        ((SigL_modtype(id', mtd, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_modtype id' (Mty_ident p) prefixing_sub)
         rem
-    | Sig_class(id, cd, rs, vis) :: rem ->
+    | SigL_class(id, cd, rs, vis) :: rem ->
       (* pretend this is a type, cf. PR#6650 *)
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub = refresh id Subst.add_type freshening_sub in
       prefix_idents root
-        ((Sig_class(id', cd, rs, vis), p) :: items_and_paths)
+        ((SigL_class(id', cd, rs, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_type id' p prefixing_sub)
         rem
-    | Sig_class_type(id, ctd, rs, vis) :: rem ->
+    | SigL_class_type(id, ctd, rs, vis) :: rem ->
       let p = Pdot(root, Ident.name id) in
       let id', freshening_sub = refresh id Subst.add_type freshening_sub in
       prefix_idents root
-        ((Sig_class_type(id', ctd, rs, vis), p) :: items_and_paths)
+        ((SigL_class_type(id', ctd, rs, vis), p) :: items_and_paths)
         freshening_sub
         (Subst.add_type id' p prefixing_sub)
         rem
   in
+  let sg = Subst.Lazy.force_signature_once sg in
   prefix_idents root [] freshening_sub prefixing_sub sg
 
 (* Compute structure descriptions *)
@@ -1608,8 +1638,9 @@ let class_declaration_address (_ : t) id (_ : class_declaration) =
 let module_declaration_address env id presence md =
   match presence with
   | Mp_absent -> begin
-      match md.md_type with
-      | Mty_alias path -> Lazy_backtrack.create (ModAlias {env; path})
+      let open Subst.Lazy in
+      match md.mdl_type with
+      | MtyL_alias path -> Lazy_backtrack.create (ModAlias {env; path})
       | _ -> assert false
     end
   | Mp_present ->
@@ -1629,7 +1660,7 @@ let rec components_of_module_maker
           {cm_env; cm_freshening_subst; cm_prefixing_subst;
            cm_path; cm_addr; cm_mty} : _ result =
   match scrape_alias cm_env cm_freshening_subst cm_mty with
-    Mty_signature sg ->
+    MtyL_signature sg ->
       let c =
         { comp_values = NameMap.empty;
           comp_constrs = NameMap.empty;
@@ -1650,9 +1681,9 @@ let rec components_of_module_maker
         Lazy_backtrack.create addr
       in
       let sub = may_subst Subst.compose freshening_sub prefixing_sub in
-      List.iter (fun (item, path) ->
+      List.iter (fun ((item : Subst.Lazy.signature_item), path) ->
         match item with
-          Sig_value(id, decl, _) ->
+          SigL_value(id, decl, _) ->
             let decl' = Subst.value_description sub decl in
             let addr =
               match decl.val_kind with
@@ -1661,7 +1692,7 @@ let rec components_of_module_maker
             in
             let vda = { vda_description = decl'; vda_address = addr } in
             c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values;
-        | Sig_type(id, decl, _, _) ->
+        | SigL_type(id, decl, _, _) ->
             let fresh_decl =
               may_subst Subst.type_declaration freshening_sub decl
             in
@@ -1704,7 +1735,7 @@ let rec components_of_module_maker
             in
             c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
             env := store_type_infos id fresh_decl !env
-        | Sig_typext(id, ext, _, _) ->
+        | SigL_typext(id, ext, _, _) ->
             let ext' = Subst.extension_constructor sub ext in
             let descr =
               Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
@@ -1713,18 +1744,18 @@ let rec components_of_module_maker
             let addr = next_address () in
             let cda = { cda_description = descr; cda_address = Some addr } in
             c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
-        | Sig_module(id, pres, md, _, _) ->
+        | SigL_module(id, pres, md, _, _) ->
             let md' =
               (* The prefixed items get the same scope as [cm_path], which is
                  the prefix. *)
-              Lazy_backtrack.create
-                (sub, Subst.Rescope (Path.scope cm_path), md)
+              Subst.Lazy.module_decl
+                (Subst.Rescope (Path.scope cm_path)) sub md
             in
             let addr =
               match pres with
               | Mp_absent -> begin
-                  match md.md_type with
-                  | Mty_alias p ->
+                  match md.mdl_type with
+                  | MtyL_alias p ->
                       let path = may_subst Subst.module_path freshening_sub p in
                       Lazy_backtrack.create (ModAlias {env = !env; path})
                   | _ -> assert false
@@ -1732,11 +1763,11 @@ let rec components_of_module_maker
               | Mp_present -> next_address ()
             in
             let alerts =
-              Builtin_attributes.alerts_of_attrs md.md_attributes
+              Builtin_attributes.alerts_of_attrs md.mdl_attributes
             in
             let comps =
-              components_of_module ~alerts ~uid:md.md_uid !env freshening_sub
-                prefixing_sub path addr md.md_type
+              components_of_module ~alerts ~uid:md.mdl_uid !env freshening_sub
+                prefixing_sub path addr md.mdl_type
             in
             let mda =
               { mda_declaration = md';
@@ -1746,39 +1777,41 @@ let rec components_of_module_maker
             c.comp_modules <-
               NameMap.add (Ident.name id) mda c.comp_modules;
             env :=
-              store_module ~freshening_sub ~check:None id addr pres md !env
-        | Sig_modtype(id, decl, _) ->
+              store_module ~update_summary:false ~freshening_sub ~check:None
+                id addr pres md !env
+        | SigL_modtype(id, decl, _) ->
             let fresh_decl =
               (* the fresh_decl is only going in the local temporary env, and
                  shouldn't be used for anything. So we make the items local. *)
-              may_subst (Subst.modtype_declaration Make_local) freshening_sub
+              may_subst (Subst.Lazy.modtype_decl Make_local) freshening_sub
                 decl
             in
             let final_decl =
               (* The prefixed items get the same scope as [cm_path], which is
                  the prefix. *)
-              Subst.modtype_declaration (Rescope (Path.scope cm_path))
+              Subst.Lazy.modtype_decl (Rescope (Path.scope cm_path))
                 prefixing_sub fresh_decl
             in
             c.comp_modtypes <-
               NameMap.add (Ident.name id) final_decl c.comp_modtypes;
-            env := store_modtype id fresh_decl !env
-        | Sig_class(id, decl, _, _) ->
+            env := store_modtype ~update_summary:false id fresh_decl !env
+        | SigL_class(id, decl, _, _) ->
             let decl' = Subst.class_declaration sub decl in
             let addr = next_address () in
             let clda = { clda_declaration = decl'; clda_address = addr } in
             c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes
-        | Sig_class_type(id, decl, _, _) ->
+        | SigL_class_type(id, decl, _, _) ->
             let decl' = Subst.cltype_declaration sub decl in
             c.comp_cltypes <-
               NameMap.add (Ident.name id) decl' c.comp_cltypes)
         items_and_paths;
         Ok (Structure_comps c)
-  | Mty_functor(arg, ty_res) ->
+  | MtyL_functor(arg, ty_res) ->
       let sub =
         may_subst Subst.compose cm_freshening_subst cm_prefixing_subst
       in
       let scoping = Subst.Rescope (Path.scope cm_path) in
+      let open Subst.Lazy in
         Ok (Functor_comps {
           (* fcomp_arg and fcomp_res must be prefixed eagerly, because
              they are interpreted in the outer environment *)
@@ -1786,12 +1819,12 @@ let rec components_of_module_maker
             (match arg with
             | Unit -> Unit
             | Named (param, ty_arg) ->
-              Named (param, Subst.modtype scoping sub ty_arg));
-          fcomp_res = Subst.modtype scoping sub ty_res;
+              Named (param, force_modtype (modtype scoping sub ty_arg)));
+          fcomp_res = force_modtype (modtype scoping sub ty_res);
           fcomp_cache = Hashtbl.create 17;
           fcomp_subst_cache = Hashtbl.create 17 })
-  | Mty_ident _ -> Error No_components_abstract
-  | Mty_alias p -> Error (No_components_alias p)
+  | MtyL_ident _ -> Error No_components_abstract
+  | MtyL_alias p -> Error (No_components_alias p)
 
 (* Insertion of bindings by identifier + path *)
 
@@ -1965,33 +1998,41 @@ and store_extension ~check ~rebind id addr ext env =
     constrs = TycompTbl.add id cda env.constrs;
     summary = Env_extension(env.summary, id, ext) }
 
-and store_module ~check ~freshening_sub id addr presence md env =
-  let loc = md.md_loc in
+and store_module ?(update_summary=true) ~check ~freshening_sub
+                 id addr presence md env =
+  let open Subst.Lazy in
+  let loc = md.mdl_loc in
   Option.iter
-    (fun f -> check_usage loc id md.md_uid f !module_declarations) check;
-  let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
+    (fun f -> check_usage loc id md.mdl_uid f !module_declarations) check;
+  let alerts = Builtin_attributes.alerts_of_attrs md.mdl_attributes in
   let module_decl_lazy =
     match freshening_sub with
-    | None -> Lazy_backtrack.create_forced md
-    | Some s -> Lazy_backtrack.create (s, Subst.Rescope (Ident.scope id), md)
+    | None -> md
+    | Some s -> module_decl (Rescope (Ident.scope id)) s md
   in
   let comps =
-    components_of_module ~alerts ~uid:md.md_uid
-      env freshening_sub Subst.identity (Pident id) addr md.md_type
+    components_of_module ~alerts ~uid:md.mdl_uid
+      env freshening_sub Subst.identity (Pident id) addr md.mdl_type
   in
   let mda =
     { mda_declaration = module_decl_lazy;
       mda_components = comps;
       mda_address = addr }
   in
+  let summary =
+    if not update_summary then env.summary
+    else Env_module (env.summary, id, presence, force_module_decl md) in
   { env with
     modules = IdTbl.add id (Mod_local mda) env.modules;
-    summary = Env_module(env.summary, id, presence, md) }
+    summary }
 
-and store_modtype id info env =
+and store_modtype ?(update_summary=true) id info env =
+  let summary =
+    if not update_summary then env.summary
+    else Env_modtype (env.summary, id, Subst.Lazy.force_modtype_decl info) in
   { env with
     modtypes = IdTbl.add id info env.modtypes;
-    summary = Env_modtype(env.summary, id, info) }
+    summary }
 
 and store_class id addr desc env =
   let clda = { clda_declaration = desc; clda_address = addr } in
@@ -2030,7 +2071,7 @@ let components_of_functor_appl ~loc ~f_path ~f_comp ~arg env =
       components_of_module ~alerts:Misc.Stdlib.String.Map.empty
         ~uid:Uid.internal_not_actually_unique
         (*???*)
-        env None Subst.identity p addr mty
+        env None Subst.identity p addr (Subst.Lazy.of_modtype mty)
     in
     Hashtbl.add f_comp.fcomp_cache arg comps;
     comps
@@ -2068,12 +2109,22 @@ and add_module_declaration ?(arg=false) ~check id presence md env =
     else
       Some (fun s -> Warnings.Unused_module s)
   in
+  let md = Subst.Lazy.of_module_decl md in
   let addr = module_declaration_address env id presence md in
   let env = store_module ~freshening_sub:None ~check id addr presence md env in
   if arg then add_functor_arg id env else env
 
+and add_module_declaration_lazy ~update_summary id presence md env =
+  let addr = module_declaration_address env id presence md in
+  let env = store_module ~update_summary ~freshening_sub:None
+              ~check:None id addr presence md env in
+  env
+
 and add_modtype id info env =
-  store_modtype id info env
+  store_modtype id (Subst.Lazy.of_modtype_decl info) env
+
+and add_modtype_lazy ~update_summary id info env =
+  store_modtype ~update_summary id info env
 
 and add_class id ty env =
   let addr = class_declaration_address env id ty in
@@ -2089,6 +2140,9 @@ let add_local_type path info env =
   { env with
     local_constraints = Path.Map.add path info env.local_constraints }
 
+(* Non-lazy version of scrape_alias *)
+let scrape_alias t mty =
+  mty |> Subst.Lazy.of_modtype |> scrape_alias t |> Subst.Lazy.force_modtype
 
 (* Insertion of bindings by name *)
 
@@ -2115,7 +2169,7 @@ let enter_module_declaration ~scope ?arg s presence md env =
 
 let enter_modtype ~scope name mtd env =
   let id = Ident.create_scoped ~scope name in
-  let env = store_modtype id mtd env in
+  let env = store_modtype id (Subst.Lazy.of_modtype_decl mtd) env in
   (id, env)
 
 let enter_class ~scope name desc env =
@@ -2318,7 +2372,7 @@ let open_signature
 (* Read a signature from a file *)
 let read_signature modname filename =
   let mda = read_pers_mod modname filename in
-  let md = Lazy_backtrack.force subst_modtype_maker mda.mda_declaration in
+  let md = Subst.Lazy.force_module_decl mda.mda_declaration in
   match md.md_type with
   | Mty_signature sg -> sg
   | Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
@@ -2517,9 +2571,10 @@ let use_type ~use ~loc path tda =
   end
 
 let use_modtype ~use ~loc path desc =
+  let open Subst.Lazy in
   if use then begin
-    mark_modtype_used desc.mtd_uid;
-    Builtin_attributes.check_alerts loc desc.mtd_attributes
+    mark_modtype_used desc.mtdl_uid;
+    Builtin_attributes.check_alerts loc desc.mtdl_attributes
       (Path.name path)
   end
 
@@ -2608,9 +2663,9 @@ let lookup_ident_type ~errors ~use ~loc s env =
 
 let lookup_ident_modtype ~errors ~use ~loc s env =
   match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with
-  | (path, data) as res ->
+  | (path, data) ->
       use_modtype ~use ~loc path data;
-      res
+      (path, data)
   | exception Not_found ->
       may_lookup_error errors loc env (Unbound_modtype (Lident s))
 
@@ -2749,11 +2804,11 @@ and lookup_module ~errors ~use ~loc lid env =
   match lid with
   | Lident s ->
       let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
-      let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
+      let md = Subst.Lazy.force_module_decl data.mda_declaration in
       path, md
   | Ldot(l, s) ->
       let path, data = lookup_dot_module ~errors ~use ~loc l s env in
-      let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
+      let md = Subst.Lazy.force_module_decl data.mda_declaration in
       path, md
   | Lapply _ as lid ->
       let path_f, comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
@@ -2882,12 +2937,16 @@ let lookup_type ~errors ~use ~loc lid env =
   let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in
   path, tda.tda_declaration
 
-let lookup_modtype ~errors ~use ~loc lid env =
+let lookup_modtype_lazy ~errors ~use ~loc lid env =
   match lid with
   | Lident s -> lookup_ident_modtype ~errors ~use ~loc s env
   | Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env
   | Lapply _ -> assert false
 
+let lookup_modtype ~errors ~use ~loc lid env =
+  let (path, mt) = lookup_modtype_lazy ~errors ~use ~loc lid env in
+  path, Subst.Lazy.force_modtype_decl mt
+
 let lookup_class ~errors ~use ~loc lid env =
   match lid with
   | Lident s -> lookup_ident_class ~errors ~use ~loc s env
@@ -3000,6 +3059,9 @@ let lookup_type ?(use=true) ~loc lid env =
 let lookup_modtype ?(use=true) ~loc lid env =
   lookup_modtype ~errors:true ~use ~loc lid env
 
+let lookup_modtype_path ?(use=true) ~loc lid env =
+  fst (lookup_modtype_lazy ~errors:true ~use ~loc lid env)
+
 let lookup_class ?(use=true) ~loc lid env =
   lookup_class ~errors:true ~use ~loc lid env
 
@@ -3139,7 +3201,7 @@ let fold_modules f lid env acc =
            | Mod_unbound _ -> acc
            | Mod_local mda ->
                let md =
-                 Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
+                 Subst.Lazy.force_module_decl mda.mda_declaration
                in
                f name p md acc
            | Mod_persistent ->
@@ -3147,8 +3209,7 @@ let fold_modules f lid env acc =
                | None -> acc
                | Some mda ->
                    let md =
-                     Lazy_backtrack.force subst_modtype_maker
-                       mda.mda_declaration
+                     Subst.Lazy.force_module_decl mda.mda_declaration
                    in
                    f name p md acc)
         env.modules
@@ -3163,7 +3224,7 @@ let fold_modules f lid env acc =
           NameMap.fold
             (fun s mda acc ->
                let md =
-                 Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
+                 Subst.Lazy.force_module_decl mda.mda_declaration
                in
                f s (Pdot (p, s)) md acc)
             c.comp_modules
@@ -3188,6 +3249,7 @@ and fold_types f =
     (fun env -> env.types) (fun sc -> sc.comp_types)
     (fun k p tda acc -> f k p tda.tda_declaration acc)
 and fold_modtypes f =
+  let f l path data acc = f l path (Subst.Lazy.force_modtype_decl data) acc in
   find_all wrap_identity
     (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
 and fold_classes f =
diff --git a/typing/env.mli b/typing/env.mli
index 463e5a6ba30d..a403f6707115 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -86,6 +86,9 @@ val find_modtype: Path.t -> t -> modtype_declaration
 val find_class: Path.t -> t -> class_declaration
 val find_cltype: Path.t -> t -> class_type_declaration
 
+val find_strengthened_module:
+  aliasable:bool -> Path.t -> t -> module_type
+
 val find_ident_constructor: Ident.t -> t -> constructor_description
 val find_ident_label: Ident.t -> t -> label_description
 
@@ -96,6 +99,7 @@ val find_type_expansion_opt:
 (* Find the manifest type information associated to a type for the sake
    of the compiler's type-based optimisations. *)
 val find_modtype_expansion: Path.t -> t -> module_type
+val find_modtype_expansion_lazy: Path.t -> t -> Subst.Lazy.modtype
 
 val find_hash_type: Path.t -> t -> type_declaration
 (* Find the "#t" type given the path for "t" *)
@@ -211,6 +215,8 @@ val lookup_cltype:
 
 val lookup_module_path:
   ?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t
+val lookup_modtype_path:
+  ?use:bool -> loc:Location.t -> Longident.t -> t -> Path.t
 
 val lookup_constructor:
   ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
@@ -278,7 +284,11 @@ val add_module:
   ?arg:bool -> Ident.t -> module_presence -> module_type -> t -> t
 val add_module_declaration: ?arg:bool -> check:bool -> Ident.t ->
   module_presence -> module_declaration -> t -> t
+val add_module_declaration_lazy: update_summary:bool ->
+  Ident.t -> module_presence -> Subst.Lazy.module_decl -> t -> t
 val add_modtype: Ident.t -> modtype_declaration -> t -> t
+val add_modtype_lazy: update_summary:bool ->
+   Ident.t -> Subst.Lazy.modtype_declaration -> t -> t
 val add_class: Ident.t -> class_declaration -> t -> t
 val add_cltype: Ident.t -> class_type_declaration -> t -> t
 val add_local_type: Path.t -> type_declaration -> t -> t
@@ -438,7 +448,8 @@ val check_well_formed_module:
 val add_delayed_check_forward: ((unit -> unit) -> unit) ref
 (* Forward declaration to break mutual recursion with Mtype. *)
 val strengthen:
-    (aliasable:bool -> t -> module_type -> Path.t -> module_type) ref
+    (aliasable:bool -> t -> Subst.Lazy.modtype ->
+     Path.t -> Subst.Lazy.modtype) ref
 (* Forward declaration to break mutual recursion with Ctype. *)
 val same_constr: (t -> type_expr -> type_expr -> bool) ref
 (* Forward declaration to break mutual recursion with Printtyp. *)
diff --git a/typing/includemod.ml b/typing/includemod.ml
index 8bef2d02403b..892ad504d7ce 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -210,8 +210,11 @@ let expand_modtype_path env path =
      | exception Not_found -> None
      | x -> Some x
 
-let expand_module_alias env path =
-  match (Env.find_module path env).md_type with
+let expand_module_alias ~strengthen env path =
+  match
+    if strengthen then Env.find_strengthened_module ~aliasable:true path env
+    else (Env.find_module path env).md_type
+  with
   | x -> Ok x
   | exception Not_found -> Error (Error.Unbound_module_path path)
 
@@ -345,7 +348,7 @@ let retrieve_functor_params env mty =
         | None -> List.rev before, res
         end
     | Mty_alias p as res ->
-        begin match expand_module_alias env p with
+        begin match expand_module_alias ~strengthen:false env p with
         | Ok mty ->  retrieve_functor_params before env mty
         | Error _ -> List.rev before, res
         end
@@ -380,7 +383,7 @@ and try_modtypes ~loc env ~mark subst mty1 mty2 =
       | exception Env.Error (Env.Missing_module (_, _, path)) ->
           Error Error.(Mt_core(Unbound_module_path path))
       | p1 ->
-          begin match expand_module_alias env  p1 with
+          begin match expand_module_alias ~strengthen:false env p1 with
           | Error e -> Error (Error.Mt_core e)
           | Ok mty1 ->
               match strengthened_modtypes ~loc ~aliasable:true env ~mark
@@ -1032,8 +1035,8 @@ let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
   | Error mdiff ->
       raise (Error(env,Error.(In_Module_type mdiff)))
 
-let expand_module_alias env path =
-  match expand_module_alias env path with
+let expand_module_alias ~strengthen env path =
+  match expand_module_alias ~strengthen env path with
   | Ok x -> x
   | Result.Error _ ->
       raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
diff --git a/typing/includemod.mli b/typing/includemod.mli
index 29b95864390f..874308b9521e 100644
--- a/typing/includemod.mli
+++ b/typing/includemod.mli
@@ -214,7 +214,7 @@ exception Apply_error of {
     args : (Error.functor_arg_descr * Types.module_type)  list ;
   }
 
-val expand_module_alias: Env.t -> Path.t -> Types.module_type
+val expand_module_alias: strengthen:bool -> Env.t -> Path.t -> Types.module_type
 
 module Functor_inclusion_diff: sig
   module Defs: sig
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 70a1c3fb46a5..d649bcdc8714 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -19,45 +19,53 @@ open Asttypes
 open Path
 open Types
 
-
-let rec scrape env mty =
+let rec scrape_lazy env mty =
+  let open Subst.Lazy in
   match mty with
-    Mty_ident p ->
+    MtyL_ident p ->
       begin try
-        scrape env (Env.find_modtype_expansion p env)
+        scrape_lazy env (Env.find_modtype_expansion_lazy p env)
       with Not_found ->
         mty
       end
   | _ -> mty
 
+let scrape env mty =
+  match mty with
+    Mty_ident p ->
+     Subst.Lazy.force_modtype (scrape_lazy env (MtyL_ident p))
+  | _ -> mty
+
 let freshen ~scope mty =
   Subst.modtype (Rescope scope) Subst.identity mty
 
-let rec strengthen ~aliasable env mty p =
-  match scrape env mty with
-    Mty_signature sg ->
-      Mty_signature(strengthen_sig ~aliasable env sg p)
-  | Mty_functor(Named (Some param, arg), res)
+let rec strengthen_lazy ~aliasable env mty p =
+  let open Subst.Lazy in
+  match scrape_lazy env mty with
+    MtyL_signature sg ->
+      MtyL_signature(strengthen_lazy_sig ~aliasable env sg p)
+  | MtyL_functor(Named (Some param, arg), res)
     when !Clflags.applicative_functors ->
-      Mty_functor(Named (Some param, arg),
-        strengthen ~aliasable:false env res (Papply(p, Pident param)))
-  | Mty_functor(Named (None, arg), res)
+      MtyL_functor(Named (Some param, arg),
+        strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
+  | MtyL_functor(Named (None, arg), res)
     when !Clflags.applicative_functors ->
       let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in
-      Mty_functor(Named (Some param, arg),
-        strengthen ~aliasable:false env res (Papply(p, Pident param)))
+      MtyL_functor(Named (Some param, arg),
+        strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
   | mty ->
       mty
 
-and strengthen_sig ~aliasable env sg p =
+and strengthen_lazy_sig' ~aliasable env sg p =
+  let open Subst.Lazy in
   match sg with
     [] -> []
-  | (Sig_value(_, _, _) as sigelt) :: rem ->
-      sigelt :: strengthen_sig ~aliasable env rem p
-  | Sig_type(id, {type_kind=Type_abstract}, _, _) :: rem
+  | (SigL_value(_, _, _) as sigelt) :: rem ->
+      sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+  | SigL_type(id, {type_kind=Type_abstract}, _, _) :: rem
     when Btype.is_row_name (Ident.name id) ->
-      strengthen_sig ~aliasable env rem p
-  | Sig_type(id, decl, rs, vis) :: rem ->
+      strengthen_lazy_sig' ~aliasable env rem p
+  | SigL_type(id, decl, rs, vis) :: rem ->
       let newdecl =
         match decl.type_manifest, decl.type_private, decl.type_kind with
           Some _, Public, _ -> decl
@@ -71,40 +79,60 @@ and strengthen_sig ~aliasable env sg p =
             else
               { decl with type_manifest = manif }
       in
-      Sig_type(id, newdecl, rs, vis) :: strengthen_sig ~aliasable env rem p
-  | (Sig_typext _ as sigelt) :: rem ->
-      sigelt :: strengthen_sig ~aliasable env rem p
-  | Sig_module(id, pres, md, rs, vis) :: rem ->
+      SigL_type(id, newdecl, rs, vis) ::
+        strengthen_lazy_sig' ~aliasable env rem p
+  | (SigL_typext _ as sigelt) :: rem ->
+      sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+  | SigL_module(id, pres, md, rs, vis) :: rem ->
       let str =
-        strengthen_decl ~aliasable env md (Pdot(p, Ident.name id))
+        strengthen_lazy_decl ~aliasable env md (Pdot(p, Ident.name id))
       in
-      Sig_module(id, pres, str, rs, vis)
-      :: strengthen_sig ~aliasable
-        (Env.add_module_declaration ~check:false id pres md env) rem p
+      let env =
+        Env.add_module_declaration_lazy ~update_summary:false id pres md env in
+      SigL_module(id, pres, str, rs, vis)
+      :: strengthen_lazy_sig' ~aliasable env rem p
       (* Need to add the module in case it defines manifest module types *)
-  | Sig_modtype(id, decl, vis) :: rem ->
+  | SigL_modtype(id, decl, vis) :: rem ->
       let newdecl =
-        match decl.mtd_type with
-          None ->
-            {decl with mtd_type = Some(Mty_ident(Pdot(p,Ident.name id)))}
-        | Some _ ->
+        match decl.mtdl_type with
+        | Some _ when not aliasable ->
+            (* [not alisable] condition needed because of recursive modules.
+               See [Typemod.check_recmodule_inclusion]. *)
             decl
+        | _ ->
+            {decl with mtdl_type = Some(MtyL_ident(Pdot(p,Ident.name id)))}
       in
-      Sig_modtype(id, newdecl, vis) ::
-      strengthen_sig ~aliasable (Env.add_modtype id decl env) rem p
+      let env = Env.add_modtype_lazy ~update_summary:false id decl env in
+      SigL_modtype(id, newdecl, vis) ::
+      strengthen_lazy_sig' ~aliasable env rem p
       (* Need to add the module type in case it is manifest *)
-  | (Sig_class _ as sigelt) :: rem ->
-      sigelt :: strengthen_sig ~aliasable env rem p
-  | (Sig_class_type _ as sigelt) :: rem ->
-      sigelt :: strengthen_sig ~aliasable env rem p
-
-and strengthen_decl ~aliasable env md p =
-  match md.md_type with
-  | Mty_alias _ -> md
-  | _ when aliasable -> {md with md_type = Mty_alias p}
-  | mty -> {md with md_type = strengthen ~aliasable env mty p}
-
-let () = Env.strengthen := strengthen
+  | (SigL_class _ as sigelt) :: rem ->
+      sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+  | (SigL_class_type _ as sigelt) :: rem ->
+      sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+
+and strengthen_lazy_sig ~aliasable env sg p =
+  let sg = Subst.Lazy.force_signature_once sg in
+  let sg = strengthen_lazy_sig' ~aliasable env sg p in
+  Subst.Lazy.of_signature_items sg
+
+and strengthen_lazy_decl ~aliasable env md p =
+  let open Subst.Lazy in
+  match md.mdl_type with
+  | MtyL_alias _ -> md
+  | _ when aliasable -> {md with mdl_type = MtyL_alias p}
+  | mty -> {md with mdl_type = strengthen_lazy ~aliasable env mty p}
+
+let () = Env.strengthen := strengthen_lazy
+
+let strengthen ~aliasable env mty p =
+  let mty = strengthen_lazy ~aliasable env (Subst.Lazy.of_modtype mty) p in
+  Subst.Lazy.force_modtype mty
+
+let strengthen_decl ~aliasable env md p =
+  let md = strengthen_lazy_decl ~aliasable env
+             (Subst.Lazy.of_module_decl md) p in
+  Subst.Lazy.force_module_decl md
 
 let rec make_aliases_absent pres mty =
   match mty with
diff --git a/typing/subst.ml b/typing/subst.ml
index 7fa8a1c26075..30230707aa0c 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -417,11 +417,80 @@ let extension_constructor s ext =
   For_copy.with_scope
     (fun copy_scope -> extension_constructor' copy_scope s ext)
 
+
+(* For every binding k |-> d of m1, add k |-> f d to m2
+   and return resulting merged map. *)
+
+let merge_path_maps f m1 m2 =
+  Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
+
+let keep_latest_loc l1 l2 =
+  match l2 with
+  | None -> l1
+  | Some _ -> l2
+
+let type_replacement s = function
+  | Path p -> Path (type_path s p)
+  | Type_function { params; body } ->
+    For_copy.with_scope (fun copy_scope ->
+     let params = List.map (typexp copy_scope s) params in
+     let body = typexp copy_scope s body in
+     Type_function { params; body })
+
 type scoping =
   | Keep
   | Make_local
   | Rescope of int
 
+module Lazy_types = struct
+
+  type module_decl =
+    {
+      mdl_type: modtype;
+      mdl_attributes: Parsetree.attributes;
+      mdl_loc: Location.t;
+      mdl_uid: Uid.t;
+    }
+
+  and modtype =
+    | MtyL_ident of Path.t
+    | MtyL_signature of signature
+    | MtyL_functor of functor_parameter * modtype
+    | MtyL_alias of Path.t
+
+  and modtype_declaration =
+    {
+      mtdl_type: modtype option;
+      mtdl_attributes: Parsetree.attributes;
+      mtdl_loc: Location.t;
+      mtdl_uid: Uid.t;
+    }
+
+  and signature' =
+    | S_eager of Types.signature
+    | S_lazy of signature_item list
+
+  and signature =
+    (scoping * t * signature', signature') Lazy_backtrack.t
+
+  and signature_item =
+      SigL_value of Ident.t * value_description * visibility
+    | SigL_type of Ident.t * type_declaration * rec_status * visibility
+    | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+    | SigL_module of
+        Ident.t * module_presence * module_decl * rec_status * visibility
+    | SigL_modtype of Ident.t * modtype_declaration * visibility
+    | SigL_class of Ident.t * class_declaration * rec_status * visibility
+    | SigL_class_type of Ident.t * class_type_declaration *
+                           rec_status * visibility
+
+  and functor_parameter =
+    | Unit
+    | Named of Ident.t option * modtype
+
+end
+open Lazy_types
+
 let rename_bound_idents scoping s sg =
   let rename =
     let open Ident in
@@ -432,149 +501,266 @@ let rename_bound_idents scoping s sg =
   in
   let rec rename_bound_idents s sg = function
     | [] -> sg, s
-    | Sig_type(id, td, rs, vis) :: rest ->
+    | SigL_type(id, td, rs, vis) :: rest ->
         let id' = rename id in
         rename_bound_idents
           (add_type id (Pident id') s)
-          (Sig_type(id', td, rs, vis) :: sg)
+          (SigL_type(id', td, rs, vis) :: sg)
           rest
-    | Sig_module(id, pres, md, rs, vis) :: rest ->
+    | SigL_module(id, pres, md, rs, vis) :: rest ->
         let id' = rename id in
         rename_bound_idents
           (add_module id (Pident id') s)
-          (Sig_module (id', pres, md, rs, vis) :: sg)
+          (SigL_module (id', pres, md, rs, vis) :: sg)
           rest
-    | Sig_modtype(id, mtd, vis) :: rest ->
+    | SigL_modtype(id, mtd, vis) :: rest ->
         let id' = rename id in
         rename_bound_idents
           (add_modtype id (Mty_ident(Pident id')) s)
-          (Sig_modtype(id', mtd, vis) :: sg)
+          (SigL_modtype(id', mtd, vis) :: sg)
           rest
-    | Sig_class(id, cd, rs, vis) :: rest ->
+    | SigL_class(id, cd, rs, vis) :: rest ->
         (* cheat and pretend they are types cf. PR#6650 *)
         let id' = rename id in
         rename_bound_idents
           (add_type id (Pident id') s)
-          (Sig_class(id', cd, rs, vis) :: sg)
+          (SigL_class(id', cd, rs, vis) :: sg)
           rest
-    | Sig_class_type(id, ctd, rs, vis) :: rest ->
+    | SigL_class_type(id, ctd, rs, vis) :: rest ->
         (* cheat and pretend they are types cf. PR#6650 *)
         let id' = rename id in
         rename_bound_idents
           (add_type id (Pident id') s)
-          (Sig_class_type(id', ctd, rs, vis) :: sg)
+          (SigL_class_type(id', ctd, rs, vis) :: sg)
           rest
-    | Sig_value(id, vd, vis) :: rest ->
+    | SigL_value(id, vd, vis) :: rest ->
         (* scope doesn't matter for value identifiers. *)
         let id' = Ident.rename id in
-        rename_bound_idents s (Sig_value(id', vd, vis) :: sg) rest
-    | Sig_typext(id, ec, es, vis) :: rest ->
+        rename_bound_idents s (SigL_value(id', vd, vis) :: sg) rest
+    | SigL_typext(id, ec, es, vis) :: rest ->
         let id' = rename id in
-        rename_bound_idents s (Sig_typext(id',ec,es,vis) :: sg) rest
+        rename_bound_idents s (SigL_typext(id',ec,es,vis) :: sg) rest
   in
   rename_bound_idents s [] sg
 
-let rec modtype scoping s = function
-    Mty_ident p as mty ->
+let rec lazy_module_decl md =
+  { mdl_type = lazy_modtype md.md_type;
+    mdl_attributes = md.md_attributes;
+    mdl_loc = md.md_loc;
+    mdl_uid = md.md_uid }
+
+and subst_lazy_module_decl scoping s md =
+  let mdl_type = subst_lazy_modtype scoping s md.mdl_type in
+  { mdl_type;
+    mdl_attributes = attrs s md.mdl_attributes;
+    mdl_loc = loc s md.mdl_loc;
+    mdl_uid = md.mdl_uid }
+
+and force_module_decl md =
+  let md_type = force_modtype md.mdl_type in
+  { md_type;
+    md_attributes = md.mdl_attributes;
+    md_loc = md.mdl_loc;
+    md_uid = md.mdl_uid }
+
+and lazy_modtype = function
+  | Mty_ident p -> MtyL_ident p
+  | Mty_signature sg ->
+     MtyL_signature (Lazy_backtrack.create_forced (S_eager sg))
+  | Mty_functor (Unit, mty) -> MtyL_functor (Unit, lazy_modtype mty)
+  | Mty_functor (Named (id, arg), res) ->
+     MtyL_functor (Named (id, lazy_modtype arg), lazy_modtype res)
+  | Mty_alias p -> MtyL_alias p
+
+and subst_lazy_modtype scoping s = function
+  | MtyL_ident p ->
       begin match Path.Map.find p s.modtypes with
-       | mty -> mty
+       | mty -> lazy_modtype mty
        | exception Not_found ->
           begin match p with
-          | Pident _ -> mty
+          | Pident _ -> MtyL_ident p
           | Pdot(p, n) ->
-             Mty_ident(Pdot(module_path s p, n))
+             MtyL_ident(Pdot(module_path s p, n))
           | Papply _ ->
              fatal_error "Subst.modtype"
           end
       end
-  | Mty_signature sg ->
-      Mty_signature(signature scoping s sg)
-  | Mty_functor(Unit, res) ->
-      Mty_functor(Unit, modtype scoping s res)
-  | Mty_functor(Named (None, arg), res) ->
-      Mty_functor(Named (None, (modtype scoping s) arg), modtype scoping s res)
-  | Mty_functor(Named (Some id, arg), res) ->
+  | MtyL_signature sg ->
+      MtyL_signature(subst_lazy_signature scoping s sg)
+  | MtyL_functor(Unit, res) ->
+      MtyL_functor(Unit, subst_lazy_modtype scoping s res)
+  | MtyL_functor(Named (None, arg), res) ->
+      MtyL_functor(Named (None, (subst_lazy_modtype scoping s) arg),
+                   subst_lazy_modtype scoping s res)
+  | MtyL_functor(Named (Some id, arg), res) ->
       let id' = Ident.rename id in
-      Mty_functor(Named (Some id', (modtype scoping s) arg),
-                  modtype scoping (add_module id (Pident id') s) res)
-  | Mty_alias p ->
-      Mty_alias (module_path s p)
-
-and signature scoping s sg =
+      MtyL_functor(Named (Some id', (subst_lazy_modtype scoping s) arg),
+                  subst_lazy_modtype scoping (add_module id (Pident id') s) res)
+  | MtyL_alias p ->
+      MtyL_alias (module_path s p)
+
+and force_modtype = function
+  | MtyL_ident p -> Mty_ident p
+  | MtyL_signature sg -> Mty_signature (force_signature sg)
+  | MtyL_functor (param, res) ->
+     let param : Types.functor_parameter =
+       match param with
+       | Unit -> Unit
+       | Named (id, mty) -> Named (id, force_modtype mty) in
+     Mty_functor (param, force_modtype res)
+  | MtyL_alias p -> Mty_alias p
+
+and lazy_modtype_decl mtd =
+  let mtdl_type = Option.map lazy_modtype mtd.mtd_type in
+  { mtdl_type;
+    mtdl_attributes = mtd.mtd_attributes;
+    mtdl_loc = mtd.mtd_loc;
+    mtdl_uid = mtd.mtd_uid }
+
+and subst_lazy_modtype_decl scoping s mtd =
+  { mtdl_type = Option.map (subst_lazy_modtype scoping s) mtd.mtdl_type;
+    mtdl_attributes = attrs s mtd.mtdl_attributes;
+    mtdl_loc = loc s mtd.mtdl_loc;
+    mtdl_uid = mtd.mtdl_uid }
+
+and force_modtype_decl mtd =
+  let mtd_type = Option.map force_modtype mtd.mtdl_type in
+  { mtd_type;
+    mtd_attributes = mtd.mtdl_attributes;
+    mtd_loc = mtd.mtdl_loc;
+    mtd_uid = mtd.mtdl_uid }
+
+and subst_lazy_signature scoping s sg =
+  match Lazy_backtrack.get_contents sg with
+  | Left (scoping', s', sg) ->
+     let scoping =
+       match scoping', scoping with
+       | sc, Keep -> sc
+       | _, (Make_local|Rescope _) -> scoping
+     in
+     let s = compose s' s in
+     Lazy_backtrack.create (scoping, s, sg)
+  | Right sg ->
+     Lazy_backtrack.create (scoping, s, sg)
+
+and force_signature sg =
+  List.map force_signature_item (force_signature_once sg)
+
+and force_signature_once sg =
+  lazy_signature' (Lazy_backtrack.force force_signature_once' sg)
+
+and lazy_signature' = function
+  | S_lazy sg -> sg
+  | S_eager sg -> List.map lazy_signature_item sg
+
+and force_signature_once' (scoping, s, sg) =
+  let sg = lazy_signature' sg in
   (* Components of signature may be mutually recursive (e.g. type declarations
      or class and type declarations), so first build global renaming
      substitution... *)
   let (sg', s') = rename_bound_idents scoping s sg in
   (* ... then apply it to each signature component in turn *)
   For_copy.with_scope (fun copy_scope ->
-    List.rev_map (signature_item' copy_scope scoping s') sg'
+    S_lazy (List.rev_map (subst_lazy_signature_item' copy_scope scoping s') sg')
   )
 
-
-and signature_item' copy_scope scoping s comp =
-  match comp with
-    Sig_value(id, d, vis) ->
-      Sig_value(id, value_description' copy_scope s d, vis)
+and lazy_signature_item = function
+  | Sig_value(id, d, vis) ->
+     SigL_value(id, d, vis)
   | Sig_type(id, d, rs, vis) ->
-      Sig_type(id, type_declaration' copy_scope s d, rs, vis)
+     SigL_type(id, d, rs, vis)
   | Sig_typext(id, ext, es, vis) ->
-      Sig_typext(id, extension_constructor' copy_scope s ext, es, vis)
-  | Sig_module(id, pres, d, rs, vis) ->
-      Sig_module(id, pres, module_declaration scoping s d, rs, vis)
+     SigL_typext(id, ext, es, vis)
+  | Sig_module(id, res, d, rs, vis) ->
+     SigL_module(id, res, lazy_module_decl d, rs, vis)
   | Sig_modtype(id, d, vis) ->
-      Sig_modtype(id, modtype_declaration scoping s d, vis)
+     SigL_modtype(id, lazy_modtype_decl d, vis)
   | Sig_class(id, d, rs, vis) ->
-      Sig_class(id, class_declaration' copy_scope s d, rs, vis)
+     SigL_class(id, d, rs, vis)
   | Sig_class_type(id, d, rs, vis) ->
-      Sig_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
+     SigL_class_type(id, d, rs, vis)
 
-and signature_item scoping s comp =
-  For_copy.with_scope
-    (fun copy_scope -> signature_item' copy_scope scoping s comp)
-
-and module_declaration scoping s decl =
-  {
-    md_type = modtype scoping s decl.md_type;
-    md_attributes = attrs s decl.md_attributes;
-    md_loc = loc s decl.md_loc;
-    md_uid = decl.md_uid;
-  }
-
-and modtype_declaration scoping s decl  =
-  {
-    mtd_type = Option.map (modtype scoping s) decl.mtd_type;
-    mtd_attributes = attrs s decl.mtd_attributes;
-    mtd_loc = loc s decl.mtd_loc;
-    mtd_uid = decl.mtd_uid;
-  }
-
-
-(* For every binding k |-> d of m1, add k |-> f d to m2
-   and return resulting merged map. *)
-
-let merge_path_maps f m1 m2 =
-  Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
-
-let keep_latest_loc l1 l2 =
-  match l2 with
-  | None -> l1
-  | Some _ -> l2
-
-let type_replacement s = function
-  | Path p -> Path (type_path s p)
-  | Type_function { params; body } ->
-    For_copy.with_scope (fun copy_scope ->
-     let params = List.map (typexp copy_scope s) params in
-     let body = typexp copy_scope s body in
-     Type_function { params; body })
+and subst_lazy_signature_item' copy_scope scoping s comp =
+  match comp with
+    SigL_value(id, d, vis) ->
+      SigL_value(id, value_description' copy_scope s d, vis)
+  | SigL_type(id, d, rs, vis) ->
+      SigL_type(id, type_declaration' copy_scope s d, rs, vis)
+  | SigL_typext(id, ext, es, vis) ->
+      SigL_typext(id, extension_constructor' copy_scope s ext, es, vis)
+  | SigL_module(id, pres, d, rs, vis) ->
+      SigL_module(id, pres, subst_lazy_module_decl scoping s d, rs, vis)
+  | SigL_modtype(id, d, vis) ->
+      SigL_modtype(id, subst_lazy_modtype_decl scoping s d, vis)
+  | SigL_class(id, d, rs, vis) ->
+      SigL_class(id, class_declaration' copy_scope s d, rs, vis)
+  | SigL_class_type(id, d, rs, vis) ->
+      SigL_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
+
+and force_signature_item = function
+  | SigL_value(id, vd, vis) -> Sig_value(id, vd, vis)
+  | SigL_type(id, d, rs, vis) -> Sig_type(id, d, rs, vis)
+  | SigL_typext(id, ext, es, vis) -> Sig_typext(id, ext, es, vis)
+  | SigL_module(id, pres, d, rs, vis) ->
+     Sig_module(id, pres, force_module_decl d, rs, vis)
+  | SigL_modtype(id, d, vis) ->
+     Sig_modtype (id, force_modtype_decl d, vis)
+  | SigL_class(id, d, rs, vis) -> Sig_class(id, d, rs, vis)
+  | SigL_class_type(id, d, rs, vis) -> Sig_class_type(id, d, rs, vis)
+
+and modtype scoping s t =
+  t |> lazy_modtype |> subst_lazy_modtype scoping s |> force_modtype
 
 (* Composition of substitutions:
      apply (compose s1 s2) x = apply s2 (apply s1 x) *)
 
-let compose s1 s2 =
+and compose s1 s2 =
+  if s1 == identity then s2 else
+  if s2 == identity then s1 else
   { types = merge_path_maps (type_replacement s2) s1.types s2.types;
     modules = merge_path_maps (module_path s2) s1.modules s2.modules;
     modtypes = merge_path_maps (modtype Keep s2) s1.modtypes s2.modtypes;
     for_saving = s1.for_saving || s2.for_saving;
     loc = keep_latest_loc s1.loc s2.loc;
   }
+
+
+let subst_lazy_signature_item scoping s comp =
+  For_copy.with_scope
+    (fun copy_scope -> subst_lazy_signature_item' copy_scope scoping s comp)
+
+module Lazy = struct
+  include Lazy_types
+
+  let of_module_decl = lazy_module_decl
+  let of_modtype = lazy_modtype
+  let of_modtype_decl = lazy_modtype_decl
+  let of_signature sg = Lazy_backtrack.create_forced (S_eager sg)
+  let of_signature_items sg = Lazy_backtrack.create_forced (S_lazy sg)
+  let of_signature_item = lazy_signature_item
+
+  let module_decl = subst_lazy_module_decl
+  let modtype = subst_lazy_modtype
+  let modtype_decl = subst_lazy_modtype_decl
+  let signature = subst_lazy_signature
+  let signature_item = subst_lazy_signature_item
+
+  let force_module_decl = force_module_decl
+  let force_modtype = force_modtype
+  let force_modtype_decl = force_modtype_decl
+  let force_signature = force_signature
+  let force_signature_once = force_signature_once
+  let force_signature_item = force_signature_item
+end
+
+let signature sc s sg =
+  Lazy.(sg |> of_signature |> signature sc s |> force_signature)
+
+let signature_item sc s comp =
+  Lazy.(comp|> of_signature_item |> signature_item sc s |> force_signature_item)
+
+let modtype_declaration sc s decl =
+  Lazy.(decl |> of_modtype_decl |> modtype_decl sc s |> force_modtype_decl)
+
+let module_declaration scoping s decl =
+  Lazy.(decl |> of_module_decl |> module_decl scoping s |> force_module_decl)
diff --git a/typing/subst.mli b/typing/subst.mli
index 4ae8e13679db..b55d2cc6f24e 100644
--- a/typing/subst.mli
+++ b/typing/subst.mli
@@ -87,3 +87,66 @@ val compose: t -> t -> t
 (* A forward reference to be filled in ctype.ml. *)
 val ctype_apply_env_empty:
   (type_expr list -> type_expr -> type_expr list -> type_expr) ref
+
+
+module Lazy : sig
+  type module_decl =
+    {
+      mdl_type: modtype;
+      mdl_attributes: Parsetree.attributes;
+      mdl_loc: Location.t;
+      mdl_uid: Uid.t;
+    }
+
+  and modtype =
+    | MtyL_ident of Path.t
+    | MtyL_signature of signature
+    | MtyL_functor of functor_parameter * modtype
+    | MtyL_alias of Path.t
+
+  and modtype_declaration =
+    {
+      mtdl_type: modtype option;  (* Note: abstract *)
+      mtdl_attributes: Parsetree.attributes;
+      mtdl_loc: Location.t;
+      mtdl_uid: Uid.t;
+    }
+
+  and signature
+
+  and signature_item =
+      SigL_value of Ident.t * value_description * visibility
+    | SigL_type of Ident.t * type_declaration * rec_status * visibility
+    | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+    | SigL_module of
+        Ident.t * module_presence * module_decl * rec_status * visibility
+    | SigL_modtype of Ident.t * modtype_declaration * visibility
+    | SigL_class of Ident.t * class_declaration * rec_status * visibility
+    | SigL_class_type of Ident.t * class_type_declaration *
+                           rec_status * visibility
+
+  and functor_parameter =
+    | Unit
+    | Named of Ident.t option * modtype
+
+
+  val of_module_decl : Types.module_declaration -> module_decl
+  val of_modtype : Types.module_type -> modtype
+  val of_modtype_decl : Types.modtype_declaration -> modtype_declaration
+  val of_signature : Types.signature -> signature
+  val of_signature_items : signature_item list -> signature
+  val of_signature_item : Types.signature_item -> signature_item
+
+  val module_decl : scoping -> t -> module_decl -> module_decl
+  val modtype : scoping -> t -> modtype -> modtype
+  val modtype_decl : scoping -> t -> modtype_declaration -> modtype_declaration
+  val signature : scoping -> t -> signature -> signature
+  val signature_item : scoping -> t -> signature_item -> signature_item
+
+  val force_module_decl : module_decl -> Types.module_declaration
+  val force_modtype : modtype -> Types.module_type
+  val force_modtype_decl : modtype_declaration -> Types.modtype_declaration
+  val force_signature : signature -> Types.signature
+  val force_signature_once : signature -> signature_item list
+  val force_signature_item : signature_item -> Types.signature_item
+end
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 0d1b03f80b06..08d454e06e30 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -767,8 +767,8 @@ let map_ext fn exts rem =
 let rec approx_modtype env smty =
   match smty.pmty_desc with
     Pmty_ident lid ->
-      let (path, _info) =
-        Env.lookup_modtype ~use:false ~loc:smty.pmty_loc lid.txt env
+      let path =
+        Env.lookup_modtype_path ~use:false ~loc:smty.pmty_loc lid.txt env
       in
       Mty_ident path
   | Pmty_alias lid ->
@@ -809,9 +809,11 @@ let rec approx_modtype env smty =
           | Pwith_module (_, lid') ->
               (* Lookup the module to make sure that it is not recursive.
                  (GPR#1626) *)
-              ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env)
+              ignore (Env.lookup_module_path ~use:false ~load:false
+                        ~loc:lid'.loc lid'.txt env)
           | Pwith_modsubst (_, lid') ->
-              ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env))
+              ignore (Env.lookup_module_path ~use:false ~load:false
+                        ~loc:lid'.loc lid'.txt env))
         constraints;
       body
   | Pmty_typeof smod ->
@@ -1262,8 +1264,7 @@ let has_remove_aliases_attribute attr =
 (* Check and translate a module type expression *)
 
 let transl_modtype_longident loc env lid =
-  let (path, _info) = Env.lookup_modtype ~loc lid env in
-  path
+  Env.lookup_modtype_path ~loc lid env
 
 let transl_module_alias loc env lid =
   Env.lookup_module_path ~load:false ~loc lid env
@@ -2104,27 +2105,28 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
                  mod_attributes = smod.pmod_attributes;
                  mod_loc = smod.pmod_loc } in
       let aliasable = not (Env.is_functor_arg path env) in
-      let md =
-        if alias && aliasable then
-          (Env.add_required_global (Path.head path); md)
-        else match (Env.find_module path env).md_type with
+      if alias && aliasable then
+        (Env.add_required_global (Path.head path); md)
+      else begin
+        let mty =
+          if sttn then
+            Env.find_strengthened_module ~aliasable path env
+          else
+            (Env.find_module path env).md_type
+        in
+        match mty with
         | Mty_alias p1 when not alias ->
             let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
-            let mty = Includemod.expand_module_alias env p1 in
+            let mty = Includemod.expand_module_alias
+                        ~strengthen:sttn env p1 in
             { md with
               mod_desc =
                 Tmod_constraint (md, mty, Tmodtype_implicit,
                                  Tcoerce_alias (env, path, Tcoerce_none));
-              mod_type =
-                if sttn then Mtype.strengthen ~aliasable:true env mty p1
-                else mty }
+              mod_type = mty }
         | mty ->
-            let mty =
-              if sttn then Mtype.strengthen ~aliasable env mty path
-              else mty
-            in
             { md with mod_type = mty }
-      in md
+      end
   | Pmod_structure sstr ->
       let (str, sg, names, _finalenv) =
         type_structure funct_body anchor env sstr in
diff --git a/utils/lazy_backtrack.ml b/utils/lazy_backtrack.ml
index a86701321527..13e4eb440016 100644
--- a/utils/lazy_backtrack.ml
+++ b/utils/lazy_backtrack.ml
@@ -42,6 +42,12 @@ let force f x =
 let get_arg x =
   match !x with Thunk a -> Some a | _ -> None
 
+let get_contents x =
+  match !x with
+  | Thunk a -> Either.Left a
+  | Done b -> Either.Right b
+  | Raise e -> raise e
+
 let create x =
   ref (Thunk x)
 
diff --git a/utils/lazy_backtrack.mli b/utils/lazy_backtrack.mli
index b3673be47b5e..4e2fbd380800 100644
--- a/utils/lazy_backtrack.mli
+++ b/utils/lazy_backtrack.mli
@@ -20,6 +20,7 @@ type log
 val force : ('a -> 'b) -> ('a,'b) t -> 'b
 val create : 'a -> ('a,'b) t
 val get_arg : ('a,'b) t -> 'a option
+val get_contents : ('a,'b) t -> ('a,'b) Either.t
 val create_forced : 'b -> ('a, 'b) t
 val create_failed : exn -> ('a, 'b) t