Add anchor to the content of functor parameters

Since we don't want to generate the parent id, we needed it to be stored in the
environment.

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

Author: panglesd

src/loader/cmi.ml

@@ -929,12 +929,12 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
           match parameter with
           | Unit -> Odoc_model.Lang.FunctorParameter.Unit, env
           | Named (id_opt, arg) ->
-              let name, env = match id_opt with
-                | Some id -> Ident.name id,  Env.add_parameter parent id (ModuleName.of_ident id) env
-                | None -> "_", env
+              let id, env = match id_opt with
+                | None -> Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std "_"), env
+                | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                  Ident_env.find_parameter_identifier env id, env
               in
-              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = read_module_type env id arg in
+              let arg = read_module_type env (id :> Identifier.Signature.t) arg in
               Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
         in
         let res = read_module_type env (Identifier.Mk.result parent) res in

src/loader/cmt.ml

@@ -367,30 +367,29 @@ let rec read_module_expr env parent label_parent mexpr =
           match parameter with
           | Unit -> FunctorParameter.Unit, env
           | Named (id_opt, _, arg) ->
-              let name, env =
+              let id, env =
                 match id_opt with
-                | Some id -> Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
-                | None -> "_", env
+                | None -> Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std "_"), env
+                | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                  Env.find_parameter_identifier env id, env
               in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = Cmti.read_module_type env id label_parent arg in
+              let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
 
               Named { id; expr=arg }, env
           in
         let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
         Functor (f_parameter, res)
 #else
     | Tmod_functor(id, _, arg, res) ->
+        let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let f_parameter =
           match arg with
           | None -> FunctorParameter.Unit
           | Some arg ->
-              let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
-          let arg = Cmti.read_module_type env id label_parent arg in
-          Named { FunctorParameter. id; expr = arg; }
+              let id = Env.find_parameter_identifier env id in
+              let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
+              Named { FunctorParameter. id; expr = arg; }
         in
-        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
         Functor(f_parameter, res)
 #endif

src/loader/cmti.ml

@@ -519,31 +519,30 @@ and read_module_type env parent label_parent mty =
           match parameter with
           | Unit -> FunctorParameter.Unit, env
           | Named (id_opt, _, arg) ->
-            let name, env =
+            let id, env =
               match id_opt with
+              | None -> Identifier.Mk.parameter (parent, ModuleName.make_std "_"), env
               | Some id ->
-                 Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
-              | None -> "_", env
+                 let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                 Env.find_parameter_identifier env id, env
             in
-            let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
-            let arg = read_module_type env id label_parent arg in
+            let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in
             Named { id; expr = arg; }, env
         in
         let res = read_module_type env (Identifier.Mk.result parent) label_parent res in
         Functor (f_parameter, res)
 #else
     | Tmty_functor(id, _, arg, res) ->
+        let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let f_parameter =
           match arg with
           | None -> Odoc_model.Lang.FunctorParameter.Unit
           | Some arg ->
-              let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = read_module_type env id label_parent arg in
+              let id = Ident_env.find_parameter_identifier new_env id in
+              let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in
               Named { FunctorParameter. id; expr = arg }
         in
-        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
-        let res = read_module_type env (Identifier.Mk.result parent) label_parent res in
+        let res = read_module_type new_env (Identifier.Mk.result parent) label_parent res in
         Functor( f_parameter, res)
 #endif
     | Tmty_with(body, subs) -> (

src/loader/ident_env.cppo.ml

@@ -31,6 +31,7 @@ module LocHashtbl = Hashtbl.Make(struct
 
 type t =
   { modules : Id.Module.t Ident.tbl;
+    parameters : Id.FunctorParameter.t Ident.tbl;
     module_paths : P.Module.t Ident.tbl;
     module_types : Id.ModuleType.t Ident.tbl;
     types : Id.DataType.t Ident.tbl;
@@ -45,6 +46,7 @@ type t =
 
 let empty () =
   { modules = Ident.empty;
+    parameters = Ident.empty;
     module_paths = Ident.empty;
     module_types = Ident.empty;
     types = Ident.empty;
@@ -578,16 +580,22 @@ let handle_signature_type_items : Paths.Identifier.Signature.t -> Compat.signatu
 
 let add_parameter parent id name env =
   let hidden = ModuleName.is_hidden name in
-  let path = `Identifier (Odoc_model.Paths.Identifier.Mk.parameter(parent, name), hidden) in
+  let oid = Odoc_model.Paths.Identifier.Mk.parameter(parent, name) in
+  let path = `Identifier (oid, hidden) in
   let module_paths = Ident.add id path env.module_paths in
-  { env with module_paths }
+  let modules = Ident.add id oid env.modules in
+  let parameters = Ident.add id oid env.parameters in
+  { env with module_paths; modules; parameters }
 
 let find_module env id =
   Ident.find_same id env.module_paths
 
 let find_module_identifier env id =
   Ident.find_same id env.modules
 
+let find_parameter_identifier env id =
+  Ident.find_same id env.parameters
+
 let find_module_type env id =
   Ident.find_same id env.module_types
 

src/loader/ident_env.cppo.mli

@@ -46,6 +46,9 @@ val find_module : t -> Ident.t -> Paths.Path.Module.t
 
 val find_module_identifier : t -> Ident.t -> Paths.Identifier.Module.t
 
+val find_parameter_identifier :
+  t -> Ident.t -> Paths.Identifier.FunctorParameter.t
+
 val find_module_type : t -> Ident.t -> Paths.Identifier.ModuleType.t
 
 val find_value_identifier : t -> Ident.t -> Paths.Identifier.Value.t

src/loader/implementation.ml

@@ -297,11 +297,23 @@ module Analysis = struct
     | Tmod_structure str ->
         let sg = structure env parent str in
         sg
-    | Tmod_functor (_, res) ->
-        let res =
-          module_expr env (Odoc_model.Paths.Identifier.Mk.result parent) res
+    | Tmod_functor (parameter, res) ->
+      let open Odoc_model.Names in
+      let x, env =
+        match parameter with
+        | Unit -> [], env
+        | Named (id_opt, _, arg) ->
+            match id_opt with
+            | Some id ->
+              let env = env_wrap
+                (Ident_env.add_parameter parent id
+                   (ModuleName.of_ident id))
+                env in
+              let id = Ident_env.find_module_identifier (get_env env) id in
+              module_type env (id :> Identifier.Signature.t) arg, env
+            | None -> [], env
         in
-        res
+        x @ module_expr env (Odoc_model.Paths.Identifier.Mk.result parent) res
     | Tmod_constraint (me, _, constr, _) ->
         let c =
           match constr with

test/sources/source.t/a.ml

@@ -33,10 +33,12 @@ type a1 = int
 and a2 = a1
 
 module F (M : sig
-  type t
+  module A : sig end
 end) =
-struct end
+struct
+  module B = M.A
+end
 
 module FM = F (struct
-  type t = int
+  module A = struct end
 end)

test/sources/source.t/run.t

@@ -36,12 +36,14 @@ Files containing some values:
   and a2 = a1
 
   module F (M : sig
-    type t
+    module A : sig end
   end) =
-  struct end
+  struct
+    module B = M.A
+  end
 
   module FM = F (struct
-    type t = int
+    module A = struct end
   end)
 
 Source pages require a parent:
@@ -208,6 +210,8 @@ Ids generated in the source code:
   id="L40"
   id="L41"
   id="L42"
+  id="L43"
+  id="L44"
   id="type-t"
   id="type-truc"
   id="value-{x}2"
@@ -232,6 +236,7 @@ Ids generated in the source code:
   id="type-a1"
   id="type-a2"
   id="module-F"
-  id="def_430_436"
+  id="module-F.parameter-M.module-A"
+  id="module-F.module-B"
   id="module-FM"
-  id="def_480_492"
+  id="def_509_530"