Occurrence: collect local module definitions

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/loader/typedtree_traverse.ml

@@ -56,8 +56,12 @@ module Analysis = struct
         ()
     | _ -> ()
 
-  (* Add module_binding equivalent of pat *)
-
+  let module_binding env poses = function
+    | { Typedtree.mb_id = Some id; mb_loc; _ } when not mb_loc.loc_ghost -> (
+        match Ident_env.identifier_of_loc env mb_loc with
+        | None -> poses := (LocalDefinition id, mb_loc) :: !poses
+        | Some _ -> ())
+    | _ -> ()
 
   let module_expr poses mod_expr =
     match mod_expr with
@@ -114,6 +118,10 @@ let of_cmt env structure =
     Analysis.class_type poses cl_type;
     Tast_iterator.default_iterator.class_type iterator cl_type
   in
+  let module_binding iterator mb =
+    Analysis.module_binding env poses mb;
+    Tast_iterator.default_iterator.module_binding iterator mb
+  in
   let iterator =
     {
       Tast_iterator.default_iterator with
@@ -123,6 +131,7 @@ let of_cmt env structure =
       typ;
       module_type;
       class_type;
+      module_binding;
     }
   in
   iterator.structure iterator structure;

src/odoc/occurrences.ml

@@ -77,7 +77,7 @@ end = struct
       | `Value (parent, _) -> do_ parent
       | `ClassType (parent, _) -> do_ parent
       | `Root _ -> incr tbl id
-      | `SourcePage _ | `Page _ | `LeafPage _  | `SourceLocation _
+      | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
       | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
       | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
           assert false

src/xref2/link.ml

@@ -185,20 +185,20 @@ let constructor_path :
   (* else *)
   if not (should_resolve_constructor p) then p
   else
-  let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
-  match cp with
-  | `Resolved p ->
-      let result = Tools.reresolve_constructor env p in
-      `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-  | _ -> (
-      match Tools.resolve_constructor_path env cp with
-      | Ok p' ->
-          let result = Tools.reresolve_constructor env p' in
-          `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-      | Error e ->
-          if report_errors then
-            Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup;
-          p)
+    let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
+    match cp with
+    | `Resolved p ->
+        let result = Tools.reresolve_constructor env p in
+        `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
+    | _ -> (
+        match Tools.resolve_constructor_path env cp with
+        | Ok p' ->
+            let result = Tools.reresolve_constructor env p' in
+            `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
+        | Error e ->
+            if report_errors then
+              Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup;
+            p)
 
 let class_type_path :
     ?report_errors:bool ->
@@ -427,6 +427,11 @@ let rec unit env t =
       | Pack _ as p -> p
   in
   let source_info =
+    let env =
+      match t.content with
+      | Module sg -> Env.open_signature sg env |> Env.add_docs sg.doc
+      | Pack _ -> env
+    in
     let open Source_info in
     match t.source_info with
     | Some inf ->
@@ -455,14 +460,25 @@ let rec unit env t =
                          (Shape_tools.lookup_value_path env)
                          (value_path ~report_errors:false env))
                 | Module v ->
-                    Module (jump_to v (fun _ -> None) (module_path ~report_errors:false env))
+                    Module
+                      (jump_to v
+                         (fun _ -> None)
+                         (module_path ~report_errors:false env))
                 | ModuleType v ->
                     ModuleType
-                      (jump_to v (fun _ -> None) (module_type_path ~report_errors:false env))
-                | Type v -> Type (jump_to v (fun _ -> None) (type_path ~report_errors:false env))
+                      (jump_to v
+                         (fun _ -> None)
+                         (module_type_path ~report_errors:false env))
+                | Type v ->
+                    Type
+                      (jump_to v
+                         (fun _ -> None)
+                         (type_path ~report_errors:false env))
                 | Constructor v ->
                     Constructor
-                      (jump_to v (fun _ -> None) (constructor_path ~report_errors:false env))
+                      (jump_to v
+                         (fun _ -> None)
+                         (constructor_path ~report_errors:false env))
                 | i -> i
               in
               (info, pos))