Make Parameters more like normal modules

jonludlam · jonludlam · commit 207d17c87c95 · 2022-06-29T17:18:18.000+01:00
diff --git a/src/document/url.ml b/src/document/url.ml
@@ -158,7 +158,7 @@ module Path = struct
         let kind = `Argument in
         let arg_num = functor_arg_pos p in
         let page =
-          Printf.sprintf "%d-%s" arg_num (ParameterName.to_string arg_name)
+          Printf.sprintf "%d-%s" arg_num (ModuleName.to_string arg_name)
         in
         mk ~parent kind page
     | { iv = `ModuleType (parent, modt_name); _ } ->
diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml
@@ -921,10 +921,10 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
           | 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 (ParameterName.of_ident id) env
+                | Some id -> Ident.name id,  Env.add_parameter parent id (ModuleName.of_ident id) env
                 | None -> "_", env
               in
-              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ParameterName.make_std name) in
+              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std name) in
               let arg = read_module_type env id arg in
               Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
         in
diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml
@@ -366,10 +366,10 @@ let rec read_module_expr env parent label_parent mexpr =
           | Named (id_opt, _, arg) ->
               let name, env =
                 match id_opt with
-                | Some id -> Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
+                | Some id -> Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
                 | None -> "_", env
               in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ParameterName.make_std name) 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
               
               Named { id; expr=arg }, env
@@ -383,11 +383,11 @@ let rec read_module_expr env parent label_parent mexpr =
           | None -> FunctorParameter.Unit
           | Some arg ->
               let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, ParameterName.make_std name) 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; }
         in
-        let env = Env.add_parameter parent id (ParameterName.of_ident id) env 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
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
@@ -520,10 +520,10 @@ and read_module_type env parent label_parent mty =
             let name, env =
               match id_opt with
               | Some id ->
-                 Ident.name id, Env.add_parameter parent id (ParameterName.of_ident id) env
+                 Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
               | None -> "_", env
             in
-            let id = Identifier.Mk.parameter (parent, ParameterName.make_std name) in
+            let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
             let arg = read_module_type env id label_parent arg in
             Named { id; expr = arg; }, env
         in
@@ -536,11 +536,11 @@ and read_module_type env parent label_parent mty =
           | None -> Odoc_model.Lang.FunctorParameter.Unit
           | Some arg ->
               let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ParameterName.make_std name) 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
               Named { FunctorParameter. id; expr = arg }
         in
-        let env = Env.add_parameter parent id (ParameterName.of_ident id) env 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
         Functor( f_parameter, res)
 #endif
diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml
@@ -478,8 +478,7 @@ let handle_signature_type_items : Paths.Identifier.Signature.t -> Compat.signatu
     env_of_items parent items env
 
 let add_parameter parent id name env =
-
-  let hidden = ParameterName.is_hidden name in
+  let hidden = ModuleName.is_hidden name in
   let path = `Identifier (Odoc_model.Paths.Identifier.Mk.parameter(parent, name), hidden) in
   let module_paths = Ident.add id path env.module_paths in
   { env with module_paths }
diff --git a/src/loader/ident_env.cppo.mli b/src/loader/ident_env.cppo.mli
@@ -21,7 +21,7 @@ type t
 val empty : t
 
 val add_parameter :
-  Paths.Identifier.Signature.t -> Ident.t -> Names.ParameterName.t -> t -> t
+  Paths.Identifier.Signature.t -> Ident.t -> Names.ModuleName.t -> t -> t
 
 val handle_signature_type_items :
   Paths.Identifier.Signature.t -> Compat.signature -> t -> t
diff --git a/src/model/names.ml b/src/model/names.ml
@@ -128,7 +128,6 @@ module SimpleName : SimpleName = struct
 end
 
 module ModuleName = Name
-module ParameterName = Name
 module ModuleTypeName = Name
 module TypeName = Name
 module ConstructorName = SimpleName
diff --git a/src/model/names.mli b/src/model/names.mli
@@ -70,8 +70,6 @@ end
 
 module ModuleName : Name
 
-module ParameterName : Name
-
 module ModuleTypeName : Name
 
 module TypeName : Name
diff --git a/src/model/paths.ml b/src/model/paths.ml
@@ -30,7 +30,7 @@ module Identifier = struct
     | `Page (_, name) -> PageName.to_string name
     | `LeafPage (_, name) -> PageName.to_string name
     | `Module (_, name) -> ModuleName.to_string name
-    | `Parameter (_, name) -> ParameterName.to_string name
+    | `Parameter (_, name) -> ModuleName.to_string name
     | `Result x -> name_aux (x :> t)
     | `ModuleType (_, name) -> ModuleTypeName.to_string name
     | `Type (_, name) -> TypeName.to_string name
@@ -466,9 +466,9 @@ module Identifier = struct
       mk_parent ModuleName.to_string "m" (fun (p, n) -> `Module (p, n))
 
     let parameter :
-        Signature.t * ParameterName.t ->
-        [> `Parameter of Signature.t * ParameterName.t ] id =
-      mk_parent ParameterName.to_string "p" (fun (p, n) -> `Parameter (p, n))
+        Signature.t * ModuleName.t ->
+        [> `Parameter of Signature.t * ModuleName.t ] id =
+      mk_parent ModuleName.to_string "p" (fun (p, n) -> `Parameter (p, n))
 
     let result : Signature.t -> [> `Result of Signature.t ] id =
      fun s ->
diff --git a/src/model/paths.mli b/src/model/paths.mli
@@ -401,8 +401,8 @@ module Identifier : sig
       [> `Module of Signature.t * ModuleName.t ] id
 
     val parameter :
-      Signature.t * ParameterName.t ->
-      [> `Parameter of Signature.t * ParameterName.t ] id
+      Signature.t * ModuleName.t ->
+      [> `Parameter of Signature.t * ModuleName.t ] id
 
     val result : Signature.t -> [> `Result of Signature.t ] id
 
diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml
@@ -23,7 +23,7 @@ module Identifier = struct
   type signature_pv =
     [ `Root of container_page option * ModuleName.t
     | `Module of signature * ModuleName.t
-    | `Parameter of signature * ParameterName.t
+    | `Parameter of signature * ModuleName.t
     | `Result of signature
     | `ModuleType of signature * ModuleTypeName.t ]
 
@@ -58,12 +58,15 @@ module Identifier = struct
   and root_module = root_module_pv id
   (** @canonical Odoc_model.Paths.Identifier.RootModule.t *)
 
-  type module_pv = [ root_module_pv | `Module of signature * ModuleName.t ]
+  type module_pv =
+    [ root_module_pv
+    | `Module of signature * ModuleName.t
+    | `Parameter of signature * ModuleName.t ]
 
   and module_ = module_pv id
   (** @canonical Odoc_model.Paths.Identifier.Module.t *)
 
-  type functor_parameter_pv = [ `Parameter of signature * ParameterName.t ]
+  type functor_parameter_pv = [ `Parameter of signature * ModuleName.t ]
 
   and functor_parameter = functor_parameter_pv id
   (** @canonical Odoc_model.Paths.Identifier.FunctorParameter.t *)
diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml
@@ -36,7 +36,7 @@ module Names = struct
 
   let pagename = To_string PageName.to_string
 
-  let parametername = To_string ParameterName.to_string
+  let parametername = To_string ModuleName.to_string
 end
 
 module General_paths = struct
diff --git a/src/xref2/component.ml b/src/xref2/component.ml
@@ -1169,7 +1169,7 @@ module Fmt = struct
     | `Parameter (parent, name) ->
         Format.fprintf ppf "(param %a %s)" model_identifier
           (parent :> Odoc_model.Paths.Identifier.t)
-          (Odoc_model.Names.ParameterName.to_string name)
+          (Odoc_model.Names.ModuleName.to_string name)
     | `Result parent ->
         Format.fprintf ppf "%a.result" model_identifier
           (parent :> Odoc_model.Paths.Identifier.t)
@@ -1636,7 +1636,7 @@ module Of_Lang = struct
 
   let find_any_module i ident_map =
     match i with
-    | { Odoc_model.Paths.iv = #Paths.Identifier.Module.t_pv; _ } as id ->
+    | { Odoc_model.Paths.iv = `Root _ | `Module _; _ } as id ->
         (Maps.Module.find id ident_map.modules :> Ident.path_module)
     | { Odoc_model.Paths.iv = #Paths.Identifier.FunctorParameter.t_pv; _ } as id
       ->
diff --git a/src/xref2/ident.ml b/src/xref2/ident.ml
@@ -8,7 +8,7 @@ type signature =
   [ `LRoot of ModuleName.t * int
   | `LModule of ModuleName.t * int
   | `LResult of signature * int
-  | `LParameter of ParameterName.t * int
+  | `LParameter of ModuleName.t * int
   | `LModuleType of ModuleTypeName.t * int ]
 
 type class_signature =
@@ -21,9 +21,12 @@ type parent = [ signature | datatype | class_signature ]
 type label_parent =
   [ parent | `LPage of PageName.t * int | `LLeafPage of PageName.t * int ]
 
-type module_ = [ `LRoot of ModuleName.t * int | `LModule of ModuleName.t * int ]
+type module_ =
+  [ `LRoot of ModuleName.t * int
+  | `LModule of ModuleName.t * int
+  | `LParameter of ModuleName.t * int ]
 
-type functor_parameter = [ `LParameter of ParameterName.t * int ]
+type functor_parameter = [ `LParameter of ModuleName.t * int ]
 
 type path_module = [ module_ | `LResult of signature * int | functor_parameter ]
 
@@ -145,10 +148,13 @@ module Of_Identifier = struct
     | { iv = `Page (_, n); _ } -> `LPage (n, fresh_int ())
     | { iv = `LeafPage (_, n); _ } -> `LLeafPage (n, fresh_int ())
 
-  let module_ : Odoc_model.Paths.Identifier.Module.t -> module_ =
-   fun { iv = `Module (_, n) | `Root (_, n); _ } ->
-    let i = fresh_int () in
-    `LModule (n, i)
+  let module_ : Odoc_model.Paths.Identifier.Module.t -> module_ = function
+    | { iv = `Module (_, n) | `Root (_, n); _ } ->
+        let i = fresh_int () in
+        `LModule (n, i)
+    | { iv = `Parameter (_, n); _ } ->
+        let i = fresh_int () in
+        `LParameter (n, i)
 
   let functor_parameter :
       Odoc_model.Paths.Identifier.FunctorParameter.t -> functor_parameter =
@@ -218,14 +224,14 @@ module Name = struct
     | `LRoot (n, _) -> ModuleName.to_string n
     | `LModule (n, _) -> ModuleName.to_string n
     | `LResult (x, _) -> signature x
-    | `LParameter (n, _) -> ParameterName.to_string n
+    | `LParameter (n, _) -> ModuleName.to_string n
     | `LModuleType (n, _) -> ModuleTypeName.to_string n
 
   let typed_module : module_ -> ModuleName.t = function
-    | `LRoot (n, _) | `LModule (n, _) -> n
+    | `LRoot (n, _) | `LModule (n, _) | `LParameter (n, _) -> n
 
   let module' : module_ -> ModuleName.t = function
-    | `LRoot (n, _) | `LModule (n, _) -> n
+    | `LRoot (n, _) | `LModule (n, _) | `LParameter (n, _) -> n
 
   let module_ m = ModuleName.to_string (module' m)
 
@@ -235,13 +241,13 @@ module Name = struct
     | `LRoot (n, _) -> ModuleName.to_string n
     | `LModule (n, _) -> ModuleName.to_string n
     | `LResult (x, _) -> signature x
-    | `LParameter (n, _) -> ParameterName.to_string n
+    | `LParameter (n, _) -> ModuleName.to_string n
 
-  let typed_functor_parameter : functor_parameter -> ParameterName.t =
+  let typed_functor_parameter : functor_parameter -> ModuleName.t =
    fun (`LParameter (n, _)) -> n
 
   let functor_parameter : functor_parameter -> string =
-   fun (`LParameter (n, _)) -> ParameterName.to_string n
+   fun (`LParameter (n, _)) -> ModuleName.to_string n
 
   let type' : type_ -> TypeName.t = function `LType (n, _) -> n
 
@@ -328,6 +334,7 @@ module Rename = struct
   let module_ : module_ -> module_ = function
     | `LRoot (n, _) -> `LRoot (n, fresh_int ())
     | `LModule (n, _) -> `LModule (n, fresh_int ())
+    | `LParameter (n, _) -> `LParameter (n, fresh_int ())
 
   let path_module : path_module -> path_module = function
     | `LRoot (n, _) -> `LRoot (n, fresh_int ())
@@ -385,8 +392,7 @@ let rec fmt_aux ppf (id : any) =
   match id with
   | `LRoot (n, i) -> Format.fprintf ppf "%s/%d" (ModuleName.to_string n) i
   | `LModule (n, i) -> Format.fprintf ppf "%s/%d" (ModuleName.to_string n) i
-  | `LParameter (n, i) ->
-      Format.fprintf ppf "%s/%d" (ParameterName.to_string n) i
+  | `LParameter (n, i) -> Format.fprintf ppf "%s/%d" (ModuleName.to_string n) i
   | `LResult (x, _) -> Format.fprintf ppf "result(%a)" fmt_aux (x :> any)
   | `LModuleType (n, i) ->
       Format.fprintf ppf "%s/%d" (ModuleTypeName.to_string n) i
diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml
@@ -48,7 +48,7 @@ let with_shadowed shadowed = { (empty ()) with shadowed }
 
 (** Raises [Not_found] *)
 let lookup_module map : Ident.path_module -> _ = function
-  | #Ident.module_ as id ->
+  | (`LRoot _ | `LModule _) as id ->
       (Component.ModuleMap.find id map.module_ :> Identifier.Path.Module.t)
   | #Ident.functor_parameter as id ->
       (List.assoc id map.functor_parameter :> Identifier.Path.Module.t)
diff --git a/src/xref2/paths.md b/src/xref2/paths.md
@@ -16,7 +16,6 @@ open Odoc_xref_test;;
 #install_printer Odoc_model.Names.ModuleName.fmt;;
 #install_printer Odoc_model.Names.ModuleTypeName.fmt;;
 #install_printer Odoc_model.Names.TypeName.fmt;;
-#install_printer Odoc_model.Names.ParameterName.fmt;;
 #install_printer Odoc_model.Names.PageName.fmt;;
 let id = Common.id;;
 let mod_sig =
@@ -51,7 +50,7 @@ so we either have named type declarations that are associated with a particular
 type signature = [
     | `Root of Root.t * UnitName.t
     | `Module of signature * ModuleName.t
-    | `Parameter of signature * ParameterName.t
+    | `Parameter of signature * ModuleName.t
     | `Result of signature
     | `ModuleType of signature * ModuleTypeName.t
 ]
diff --git a/src/xref2/scratch.md b/src/xref2/scratch.md
@@ -5,7 +5,6 @@ open Odoc_xref2;;
 open Odoc_xref_test;;
 #install_printer Common.root_pp;;
 #install_printer Odoc_model.Names.ModuleName.fmt;;
-#install_printer Odoc_model.Names.ParameterName.fmt;;
 #install_printer Odoc_model.Names.TypeName.fmt;;
 #install_printer Odoc_model.Names.ValueName.fmt;;
 #install_printer Odoc_xref2.Component.Fmt.model_identifier;;
diff --git a/src/xref2/test.md b/src/xref2/test.md
@@ -32,7 +32,6 @@ open Odoc_model.Names;;
 #install_printer Odoc_model.Names.ModuleName.fmt;;
 #install_printer Odoc_model.Names.ModuleTypeName.fmt;;
 #install_printer Odoc_model.Names.TypeName.fmt;;
-#install_printer Odoc_model.Names.ParameterName.fmt;;
 #install_printer Odoc_model.Names.ExceptionName.fmt;;
 #install_printer Odoc_model.Names.FieldName.fmt;;
 #install_printer Odoc_model.Names.PageName.fmt;;
diff --git a/test/xref2/lib/prelude.ml b/test/xref2/lib/prelude.ml
@@ -15,7 +15,6 @@ open Odoc_xref_test;;
 #install_printer Odoc_model.Names.TypeName.fmt;;
 #install_printer Odoc_model.Names.ClassName.fmt;;
 #install_printer Odoc_model.Names.ClassTypeName.fmt;;
-#install_printer Odoc_model.Names.ParameterName.fmt;;
 #install_printer Odoc_model.Names.ExceptionName.fmt;;
 #install_printer Odoc_model.Names.FieldName.fmt;;
 #install_printer Odoc_model.Names.ConstructorName.fmt;;
