Strengthen everything inside includes

Author: jonludlam

src/loader/cmt.ml

@@ -530,7 +530,7 @@ and read_include env parent incl =
   | Some m when not (contains_signature m) ->
     let decl = ModuleType m in
     let expansion = { content; shadowed; } in
-    [Include {parent; doc; decl; expansion; inline=false }]
+    [Include {parent; doc; decl; expansion; inline=false; strengthened=None }]
   | Some (ModuleType.U.Signature { items; _ }) ->
     items
   | _ ->

src/loader/cmti.ml

@@ -691,7 +691,7 @@ and read_include env parent incl =
   | Some uexpr when not (contains_signature uexpr) ->
     let decl = Include.ModuleType uexpr in
     let expansion = { content; shadowed; } in
-    [Include {parent; doc; decl; expansion; inline=false }]
+    [Include {parent; doc; decl; expansion; inline=false; strengthened=None }]
   | Some ModuleType.U.Signature { items; _ } when is_inlinable items ->
     items
   | _ ->

src/model/lang.ml

@@ -168,6 +168,7 @@ and Include : sig
 
   type t = {
     parent : Identifier.Signature.t;
+    strengthened : Path.Module.t option;
     doc : Comment.docs;
     decl : decl;
     inline : bool;

src/xref2/compile.ml

@@ -329,7 +329,14 @@ and include_ : Env.t -> Include.t -> Include.t =
         i.expansion
     | Ok sg ->
         let map = { Lang_of.empty with shadowed = i.expansion.shadowed } in
-        let e = Lang_of.(simple_expansion map i.parent (Signature sg)) in
+        let sg' =
+          match i.strengthened with
+          | Some p ->
+              let cp = Component.Of_Lang.(module_path empty p) in
+              Strengthen.signature cp sg
+          | None -> sg
+        in
+        let e = Lang_of.(simple_expansion map i.parent (Signature sg')) in
 
         let expansion_sg =
           match e with

src/xref2/component.ml

@@ -326,6 +326,7 @@ and Include : sig
 
   type t = {
     parent : Odoc_model.Paths.Identifier.Signature.t;
+    strengthened : Cpath.module_ option;
     doc : CComment.docs;
     shadowed : Odoc_model.Lang.Include.shadowed;
     expansion_ : Signature.t;
@@ -2117,6 +2118,7 @@ module Of_Lang = struct
       doc = docs ident_map i.doc;
       shadowed = i.expansion.shadowed;
       expansion_ = apply_sig_map ident_map i.expansion.content;
+      strengthened = option module_path ident_map i.strengthened;
       decl;
     }
 

src/xref2/component.mli

@@ -304,6 +304,7 @@ and Include : sig
 
   type t = {
     parent : Odoc_model.Paths.Identifier.Signature.t;
+    strengthened : Cpath.module_ option;
     doc : CComment.docs;
     shadowed : Odoc_model.Lang.Include.shadowed;
     expansion_ : Signature.t;

src/xref2/lang_of.ml

@@ -586,20 +586,26 @@ and include_decl :
 
 and include_ parent map i =
   let open Component.Include in
-  {
-    Odoc_model.Lang.Include.parent;
-    doc = docs (parent :> Identifier.LabelParent.t) i.doc;
-    decl = include_decl map parent i.decl;
-    expansion =
-      {
-        shadowed = i.shadowed;
-        content =
-          signature parent
-            { map with shadowed = combine_shadowed map.shadowed i.shadowed }
-            i.expansion_;
-      };
-    inline = false;
-  }
+  try
+    {
+      Odoc_model.Lang.Include.parent;
+      doc = docs (parent :> Identifier.LabelParent.t) i.doc;
+      decl = include_decl map parent i.decl;
+      expansion =
+        {
+          shadowed = i.shadowed;
+          content =
+            signature parent
+              { map with shadowed = combine_shadowed map.shadowed i.shadowed }
+              i.expansion_;
+        };
+      inline = false;
+      strengthened = Opt.map (Path.module_ map) i.strengthened;
+    }
+  with e ->
+    Format.eprintf "Caught exception %s\n%!" (Printexc.to_string e);
+    Format.eprintf "%a\n" Component.Fmt.include_ i;
+    raise e
 
 and open_ parent map o =
   let open Component.Open in

src/xref2/strengthen.ml

@@ -20,8 +20,18 @@ open Delayed
 let rec signature :
     Cpath.module_ -> ?canonical:Cpath.module_ -> Signature.t -> Signature.t =
  fun prefix ?canonical sg ->
+  let sg', strengthened_modules = sig_items prefix ?canonical sg in
+  (* Format.eprintf "Invalidating modules: %a\n%!" (Format.pp_print_list Ident.fmt) strengthened_modules; *)
+  let substs =
+    List.fold_left
+      (fun s mid -> Subst.path_invalidate_module (mid :> Ident.path_module) s)
+      Subst.identity strengthened_modules
+  in
+  Subst.signature substs sg'
+
+and sig_items prefix ?canonical sg =
   let open Signature in
-  let items, strengthened_modules =
+  let items, ids =
     List.fold_left
       (fun (items, s) item ->
         match item with
@@ -51,19 +61,15 @@ let rec signature :
                       type_decl (`Dot (prefix, Ident.Name.type_ id)) (get t)) )
               :: items,
               s )
+        | Include i ->
+            let i', strengthened = include_ prefix i in
+            (Include i' :: items, strengthened @ s)
         | Exception _ | TypExt _ | Value _ | External _ | Class _ | ClassType _
-        | Include _ | ModuleSubstitution _ | TypeSubstitution _ | Comment _
-        | Open _ ->
+        | ModuleSubstitution _ | TypeSubstitution _ | Comment _ | Open _ ->
             (item :: items, s))
       ([], []) sg.items
   in
-  (* Format.eprintf "Invalidating modules: %a\n%!" (Format.pp_print_list Ident.fmt) strengthened_modules; *)
-  let substs =
-    List.fold_left
-      (fun s mid -> Subst.path_invalidate_module (mid :> Ident.path_module) s)
-      Subst.identity strengthened_modules
-  in
-  Subst.signature substs { sg with items = List.rev items }
+  ({ sg with items = List.rev items }, ids)
 
 and module_ :
     ?canonical:Cpath.module_ ->
@@ -109,3 +115,8 @@ and type_decl : Cpath.type_ -> TypeDecl.t -> TypeDecl.t =
     }
   in
   { t with equation }
+
+and include_ : Cpath.module_ -> Include.t -> Include.t * Ident.module_ list =
+ fun path i ->
+  let expansion_, strengthened = sig_items path i.expansion_ in
+  ({ i with expansion_; strengthened = Some path }, strengthened)

src/xref2/subst.ml

@@ -724,6 +724,7 @@ and include_ s i =
   {
     i with
     decl = include_decl s i.decl;
+    strengthened = option_ module_path s i.strengthened;
     expansion_ = apply_sig_map_sg s i.expansion_;
   }
 

src/xref2/tools.ml

@@ -1278,7 +1278,9 @@ and fragmap :
                       compiled = false;
                     }
                 in
-                Ok (Component.Signature.Include { i with decl; expansion_ })
+                Ok
+                  (Component.Signature.Include
+                     { i with decl; expansion_; strengthened = None })
               else Ok item
             in
             component >>= fun c ->