rename parent into fragment_type_parent

The former was too generic. Added some comments at the definition.

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

Author: panglesd

src/loader/cmi.ml

@@ -632,7 +632,7 @@ let read_constructor_declaration env parent cd =
   let doc = Doc_attr.attached_no_tag container cd.cd_attributes in
   let args =
     read_constructor_declaration_arguments env
-      (parent :> Identifier.Parent.t) cd.cd_args
+      (parent :> Identifier.FragmentTypeParent.t) cd.cd_args
   in
   let res = opt_map (read_type_expr env) cd.cd_res in
     {id; doc; args; res}
@@ -652,7 +652,7 @@ let read_type_kind env parent =
     | Type_record(lbls, _) ->
         let lbls =
           List.map
-            (read_label_declaration env (parent :> Identifier.Parent.t))
+            (read_label_declaration env (parent :> Identifier.FragmentTypeParent.t))
             lbls
         in
           Some (Record lbls)
@@ -745,7 +745,7 @@ let read_extension_constructor env parent id ext =
   let doc = Doc_attr.attached_no_tag container ext.ext_attributes in
   let args =
     read_constructor_declaration_arguments env
-      (parent : Identifier.Signature.t :> Identifier.Parent.t) ext.ext_args
+      (parent : Identifier.Signature.t :> Identifier.FragmentTypeParent.t) ext.ext_args
   in
   let res = opt_map (read_type_expr env) ext.ext_ret_type in
   {id; locs; doc; args; res}
@@ -779,7 +779,7 @@ let read_exception env parent id ext =
     mark_exception ext;
     let args =
       read_constructor_declaration_arguments env
-        (parent : Identifier.Signature.t :> Identifier.Parent.t) ext.ext_args
+        (parent : Identifier.Signature.t :> Identifier.FragmentTypeParent.t) ext.ext_args
     in
     let res = opt_map (read_type_expr env) ext.ext_ret_type in
     {id; locs; doc; args; res}

src/loader/cmti.ml

@@ -214,7 +214,7 @@ let read_constructor_declaration_arguments env parent label_parent arg =
 let read_constructor_declaration env parent cd =
   let open TypeDecl.Constructor in
   let id = Ident_env.find_constructor_identifier env cd.cd_id in
-  let container = (parent :> Identifier.Parent.t) in
+  let container = (parent :> Identifier.FragmentTypeParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag label_container cd.cd_attributes in
   let args =
@@ -231,7 +231,7 @@ let read_type_kind env parent =
         let cstrs = List.map (read_constructor_declaration env parent) cstrs in
           Some (Variant cstrs)
     | Ttype_record lbls ->
-        let parent = (parent :> Identifier.Parent.t) in
+        let parent = (parent :> Identifier.FragmentTypeParent.t) in
       let label_parent = (parent :> Identifier.LabelParent.t) in
       let lbls =
         List.map (read_label_declaration env parent label_parent) lbls in
@@ -292,7 +292,7 @@ let read_extension_constructor env parent ext =
   let open Extension.Constructor in
   let id = Env.find_extension_identifier env ext.ext_id in
   let locs = None in
-  let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
+  let container = (parent : Identifier.Signature.t :> Identifier.FragmentTypeParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in
   match ext.ext_kind with
@@ -325,7 +325,7 @@ let read_exception env parent (ext : extension_constructor) =
   let open Exception in
   let id = Env.find_exception_identifier env ext.ext_id in
   let locs = None in
-  let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
+  let container = (parent : Identifier.Signature.t :> Identifier.FragmentTypeParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in
   match ext.ext_kind with

src/model/paths.ml

@@ -166,7 +166,7 @@ module Identifier = struct
       | { iv = `Method (p, _); _ } | { iv = `InstanceVariable (p, _); _ } ->
           (p : class_signature :> label_parent)
       | { iv = `Constructor (p, _); _ } -> (p : datatype :> label_parent)
-      | { iv = `Field (p, _); _ } -> (p : parent :> label_parent)
+      | { iv = `Field (p, _); _ } -> (p : fragment_type_parent :> label_parent)
 
   let label_parent n = label_parent_aux (n :> Id.non_src)
 
@@ -217,9 +217,9 @@ module Identifier = struct
     type t_pv = Id.datatype_pv
   end
 
-  module Parent = struct
-    type t = Id.parent
-    type t_pv = Id.parent_pv
+  module FragmentTypeParent = struct
+    type t = Paths_types.Identifier.fragment_type_parent
+    type t_pv = Paths_types.Identifier.fragment_type_parent_pv
   end
 
   module LabelParent = struct
@@ -578,7 +578,8 @@ module Identifier = struct
           `Constructor (p, n))
 
     let field :
-        Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id =
+        FragmentTypeParent.t * FieldName.t ->
+        [> `Field of FragmentTypeParent.t * FieldName.t ] id =
       mk_parent FieldName.to_string "fld" (fun (p, n) -> `Field (p, n))
 
     let extension :
@@ -991,12 +992,14 @@ module Reference = struct
       | `ClassType (sg, s) ->
           Identifier.Mk.class_type (parent_signature_identifier sg, s)
 
-    and parent_identifier : parent -> Identifier.Parent.t = function
+    and parent_identifier :
+        fragment_type_parent -> Identifier.FragmentTypeParent.t = function
       | `Identifier id -> id
       | (`Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _)
         as sg ->
-          (parent_signature_identifier sg :> Identifier.Parent.t)
-      | `Type _ as t -> (parent_type_identifier t :> Identifier.Parent.t)
+          (parent_signature_identifier sg :> Identifier.FragmentTypeParent.t)
+      | `Type _ as t ->
+          (parent_type_identifier t :> Identifier.FragmentTypeParent.t)
 
     and label_parent_identifier : label_parent -> Identifier.LabelParent.t =
       function
@@ -1042,8 +1045,8 @@ module Reference = struct
       type t = Paths_types.Resolved_reference.datatype
     end
 
-    module Parent = struct
-      type t = Paths_types.Resolved_reference.parent
+    module FragmentTypeParent = struct
+      type t = Paths_types.Resolved_reference.fragment_type_parent
     end
 
     module LabelParent = struct
@@ -1127,8 +1130,8 @@ module Reference = struct
     type t = Paths_types.Reference.datatype
   end
 
-  module Parent = struct
-    type t = Paths_types.Reference.parent
+  module FragmentTypeParent = struct
+    type t = Paths_types.Reference.fragment_type_parent
   end
 
   module LabelParent = struct

src/model/paths.mli

@@ -79,9 +79,9 @@ module Identifier : sig
     type t = Id.datatype
     type t_pv = Id.datatype_pv
   end
-  module Parent : sig
-    type t = Id.parent
-    type t_pv = Id.parent_pv
+  module FragmentTypeParent : sig
+    type t = Id.fragment_type_parent
+    type t_pv = Id.fragment_type_parent_pv
   end
 
   module FunctorResult : sig
@@ -294,7 +294,8 @@ module Identifier : sig
       [> `Constructor of DataType.t * ConstructorName.t ] id
 
     val field :
-      Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id
+      FragmentTypeParent.t * FieldName.t ->
+      [> `Field of FragmentTypeParent.t * FieldName.t ] id
 
     val extension :
       Signature.t * ExtensionName.t ->
@@ -507,8 +508,8 @@ module rec Reference : sig
       type t = Paths_types.Resolved_reference.datatype
     end
 
-    module Parent : sig
-      type t = Paths_types.Resolved_reference.parent
+    module FragmentTypeParent : sig
+      type t = Paths_types.Resolved_reference.fragment_type_parent
     end
 
     module LabelParent : sig
@@ -592,8 +593,8 @@ module rec Reference : sig
     type t = Paths_types.Reference.datatype
   end
 
-  module Parent : sig
-    type t = Paths_types.Reference.parent
+  module FragmentTypeParent : sig
+    type t = Paths_types.Reference.fragment_type_parent
   end
 
   module LabelParent : sig

src/model/paths_types.ml

@@ -81,13 +81,17 @@ module Identifier = struct
   and datatype = datatype_pv id
   (** @canonical Odoc_model.Paths.Identifier.DataType.t *)
 
-  type parent_pv = [ signature_pv | datatype_pv ]
-  (** @canonical Odoc_model.Paths.Identifier.Parent.t_pv *)
+  type fragment_type_parent_pv = [ signature_pv | datatype_pv ]
+  (** @canonical Odoc_model.Paths.Identifier.FragmentTypeParent.t_pv *)
 
-  and parent = parent_pv id
-  (** @canonical Odoc_model.Paths.Identifier.Parent.t *)
+  (* fragment_type_parent in identifiers is for record fields parent. It’s type
+     (for usual record fields) or [signature] for fields of inline records of
+     extension constructor. *)
+  and fragment_type_parent = fragment_type_parent_pv id
+  (** @canonical Odoc_model.Paths.Identifier.FragmentTypeParent.t *)
 
-  type label_parent_pv = [ parent_pv | page_pv | class_signature_pv ]
+  type label_parent_pv =
+    [ fragment_type_parent_pv | page_pv | class_signature_pv ]
   (** @canonical Odoc_model.Paths.Identifier.LabelParent.t_pv *)
 
   and label_parent = label_parent_pv id
@@ -138,7 +142,7 @@ module Identifier = struct
   and constructor = constructor_pv id
   (** @canonical Odoc_model.Paths.Identifier.Constructor.t *)
 
-  type field_pv = [ `Field of parent * FieldName.t ]
+  type field_pv = [ `Field of fragment_type_parent * FieldName.t ]
   (** @canonical Odoc_model.Paths.Identifier.Field.t_pv *)
 
   and field = field_pv id
@@ -206,7 +210,7 @@ module Identifier = struct
     [ signature_pv
     | class_signature_pv
     | datatype_pv
-    | parent_pv
+    | fragment_type_parent_pv
     | label_parent_pv
     | module_pv
     | functor_parameter_pv
@@ -617,14 +621,15 @@ module rec Reference : sig
     | `Type of signature * TypeName.t ]
   (** @canonical Odoc_model.Paths.Reference.DataType.t *)
 
-  and parent =
-    [ `Resolved of Resolved_reference.parent
+  (* Parent of fields and constructor. Can be either a type or [signature] *)
+  and fragment_type_parent =
+    [ `Resolved of Resolved_reference.fragment_type_parent
     | `Root of string * tag_parent
     | `Dot of label_parent * string
     | `Module of signature * ModuleName.t
     | `ModuleType of signature * ModuleTypeName.t
     | `Type of signature * TypeName.t ]
-  (** @canonical Odoc_model.Paths.Reference.Parent.t *)
+  (** @canonical Odoc_model.Paths.Reference.FragmentTypeParent.t *)
 
   and label_parent =
     [ `Resolved of Resolved_reference.label_parent
@@ -664,7 +669,7 @@ module rec Reference : sig
     [ `Resolved of Resolved_reference.constructor
     | `Root of string * [ `TConstructor | `TExtension | `TException | `TUnknown ]
     | `Dot of label_parent * string
-    | `Constructor of parent * ConstructorName.t
+    | `Constructor of fragment_type_parent * ConstructorName.t
     | `Extension of signature * ExtensionName.t
     | `Exception of signature * ExceptionName.t ]
   (** @canonical Odoc_model.Paths.Reference.Constructor.t *)
@@ -673,7 +678,7 @@ module rec Reference : sig
     [ `Resolved of Resolved_reference.field
     | `Root of string * [ `TField | `TUnknown ]
     | `Dot of label_parent * string
-    | `Field of parent * FieldName.t ]
+    | `Field of fragment_type_parent * FieldName.t ]
   (** @canonical Odoc_model.Paths.Reference.Field.t *)
 
   type extension =
@@ -754,8 +759,8 @@ module rec Reference : sig
     | `Module of signature * ModuleName.t
     | `ModuleType of signature * ModuleTypeName.t
     | `Type of signature * TypeName.t
-    | `Constructor of parent * ConstructorName.t
-    | `Field of parent * FieldName.t
+    | `Constructor of fragment_type_parent * ConstructorName.t
+    | `Field of fragment_type_parent * FieldName.t
     | `Extension of signature * ExtensionName.t
     | `ExtensionDecl of signature * ExtensionName.t
     | `Exception of signature * ExceptionName.t
@@ -803,16 +808,18 @@ and Resolved_reference : sig
     | `ClassType of signature * ClassTypeName.t ]
   (** @canonical Odoc_model.Paths.Reference.Resolved.ClassSignature.t *)
 
-  (* parent is [ signature | class_signature ] *)
-  and parent =
-    [ `Identifier of Identifier.parent
+  (* fragment_type_parent in resolved references is for record fields parent.
+     It’s type (for usual record fields) or [signature] for fields of inline
+     records of extension constructor. *)
+  and fragment_type_parent =
+    [ `Identifier of Identifier.fragment_type_parent
     | `Alias of Resolved_path.module_ * module_
     | `AliasModuleType of Resolved_path.module_type * module_type
     | `Module of signature * ModuleName.t
     | `Hidden of module_
     | `ModuleType of signature * ModuleTypeName.t
     | `Type of signature * TypeName.t ]
-  (** @canonical Odoc_model.Paths.Reference.Resolved.Parent.t *)
+  (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *)
 
   (* The only difference between parent and label_parent
      is that the Identifier allows more types *)
@@ -850,7 +857,7 @@ and Resolved_reference : sig
 
   type field =
     [ `Identifier of Identifier.reference_field
-    | `Field of parent * FieldName.t ]
+    | `Field of fragment_type_parent * FieldName.t ]
   (** @canonical Odoc_model.Paths.Reference.Resolved.Field.t *)
 
   type extension =
@@ -917,7 +924,7 @@ and Resolved_reference : sig
     | `ModuleType of signature * ModuleTypeName.t
     | `Type of signature * TypeName.t
     | `Constructor of datatype * ConstructorName.t
-    | `Field of parent * FieldName.t
+    | `Field of fragment_type_parent * FieldName.t
     | `Extension of signature * ExtensionName.t
     | `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t
     | `Exception of signature * ExceptionName.t

src/model/reference.ml

@@ -214,7 +214,7 @@ let parse whole_reference_location s :
         | _ ->
             expected [ "module"; "module-type" ] location
             |> Error.raise_exception)
-  and parent (kind, identifier, location) tokens : Parent.t =
+  and parent (kind, identifier, location) tokens : FragmentTypeParent.t =
     let kind = match_reference_kind location kind in
     match tokens with
     | [] -> (

src/xref2/env.ml

@@ -301,7 +301,7 @@ let add_type (identifier : Identifier.Type.t) t env =
     and add_field env (field : TypeDecl.Field.t) =
       let ident =
         Paths.Identifier.Mk.field
-          ( (identifier :> Paths.Identifier.Parent.t),
+          ( (identifier :> Paths.Identifier.FragmentTypeParent.t),
             FieldName.make_std field.name )
       in
       add_to_elts Kind_Field ident (`Field (ident, field)) env

src/xref2/ident.ml

@@ -141,7 +141,7 @@ module Of_Identifier = struct
     | `Type (_, n) -> `LType (n, i)
     | `CoreType _n -> failwith "Bad"
 
-  let parent : Parent.t -> parent =
+  let parent : FragmentTypeParent.t -> parent =
    fun p ->
     match p with
     | { iv = #Signature.t_pv; _ } as s -> (signature s :> parent)
@@ -152,7 +152,7 @@ module Of_Identifier = struct
     match p with
     | { iv = #ClassSignature.t_pv; _ } as s ->
         (class_signature s :> label_parent)
-    | { iv = #Parent.t_pv; _ } as s -> (parent s :> label_parent)
+    | { iv = #FragmentTypeParent.t_pv; _ } as s -> (parent s :> label_parent)
     | { iv = `Page (_, n); _ } -> `LPage (n, fresh_int ())
     | { iv = `LeafPage (_, n); _ } -> `LLeafPage (n, fresh_int ())