Skip to content

Allow to omit parent type in constructor reference. #933

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 10 commits into from
Dec 6, 2023
Merged

Allow to omit parent type in constructor reference. #933

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
7b66c13
Add test for omitting parent type in constructor reference (#447)
EmileTrotignon Feb 22, 2023
d318a5f
Allow signature to be parent in constructor references
EmileTrotignon Feb 27, 2023
be87d3a
move `class_signature_pv` from `parent` to `label_parent`
panglesd Feb 28, 2023
c280154
Force identifiers + resolved references to have a datatype as parent
panglesd Feb 28, 2023
bed9ef2
rename `parent` into `fragment_type_parent`
panglesd Mar 29, 2023
725d900
renaming fragment_type_parent to field_parent in resolved ref and id
panglesd Mar 29, 2023
c2228c0
invert type and datatype in Component
panglesd Mar 30, 2023
b637501
do not look for class when resolving a fragment_type_parent
panglesd Mar 30, 2023
c2c16a4
Improve test for omitted type in constructor parent
panglesd Dec 6, 2023
3c90fe0
Changelog entry for #933
panglesd Dec 6, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ Tags:
### Added
- Display 'private' keyword for private type extensions (@gpetiot, #1019)
- Add support for search (@panglesd, @EmileTrotignon, #972)
- Allow to omit parent type in constructor reference (@panglesd,
@EmileTrotignon, #933)

### Fixed

Expand Down
12 changes: 6 additions & 6 deletions src/loader/cmi.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -628,11 +628,11 @@ let read_constructor_declaration_arguments env 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.DataType.t :> Identifier.LabelParent.t) in
let container = (parent :> Identifier.LabelParent.t) in
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.FieldParent.t) cd.cd_args
in
let res = opt_map (read_type_expr env) cd.cd_res in
{id; doc; args; res}
Expand All @@ -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.FieldParent.t))
lbls
in
Some (Record lbls)
Expand Down Expand Up @@ -713,7 +713,7 @@ let read_type_declaration env parent id decl =
let params = mark_type_declaration decl in
let manifest = opt_map (read_type_expr env) decl.type_manifest in
let constraints = read_type_constraints env params in
let representation = read_type_kind env id decl.type_kind in
let representation = read_type_kind env (id :> Identifier.DataType.t) decl.type_kind in
let abstr =
match decl.type_kind with
Type_abstract ->
Expand Down Expand Up @@ -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.FieldParent.t) ext.ext_args
in
let res = opt_map (read_type_expr env) ext.ext_ret_type in
{id; locs; doc; args; res}
Expand Down Expand Up @@ -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.FieldParent.t) ext.ext_args
in
let res = opt_map (read_type_expr env) ext.ext_ret_type in
{id; locs; doc; args; res}
Expand Down
10 changes: 5 additions & 5 deletions src/loader/cmti.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.DataType.t :> Identifier.Parent.t) in
let container = (parent :> Identifier.FieldParent.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 =
Expand All @@ -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.DataType.t :> Identifier.Parent.t) in
let parent = (parent :> Identifier.FieldParent.t) in
let label_parent = (parent :> Identifier.LabelParent.t) in
let lbls =
List.map (read_label_declaration env parent label_parent) lbls in
Expand Down Expand Up @@ -260,7 +260,7 @@ let read_type_declaration env parent decl =
let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.typ_attributes in
let canonical = (canonical :> Path.Type.t option) in
let equation = read_type_equation env container decl in
let representation = read_type_kind env (id :> Identifier.DataType.t) decl.typ_kind in
let representation = read_type_kind env id decl.typ_kind in
{id; locs; doc; canonical; equation; representation}

let read_type_declarations env parent rec_flag decls =
Expand Down Expand Up @@ -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.FieldParent.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
Expand Down Expand Up @@ -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.FieldParent.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
Expand Down
43 changes: 23 additions & 20 deletions src/model/paths.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 : field_parent :> label_parent)

let label_parent n = label_parent_aux (n :> Id.non_src)

Expand Down Expand Up @@ -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 FieldParent = struct
type t = Paths_types.Identifier.field_parent
type t_pv = Paths_types.Identifier.field_parent_pv
end

module LabelParent = struct
Expand Down Expand Up @@ -572,13 +572,14 @@ module Identifier = struct
mk_fresh (fun s -> s) "coret" (fun s -> `CoreType (TypeName.make_std s))

let constructor :
Type.t * ConstructorName.t ->
[> `Constructor of Type.t * ConstructorName.t ] id =
DataType.t * ConstructorName.t ->
[> `Constructor of DataType.t * ConstructorName.t ] id =
mk_parent ConstructorName.to_string "ctor" (fun (p, n) ->
`Constructor (p, n))

let field :
Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id =
FieldParent.t * FieldName.t ->
[> `Field of FieldParent.t * FieldName.t ] id =
mk_parent FieldName.to_string "fld" (fun (p, n) -> `Field (p, n))

let extension :
Expand Down Expand Up @@ -991,30 +992,32 @@ module Reference = struct
| `ClassType (sg, s) ->
Identifier.Mk.class_type (parent_signature_identifier sg, s)

and parent_identifier : parent -> Identifier.Parent.t = function
and field_parent_identifier : field_parent -> Identifier.FieldParent.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)
| (`Class _ | `ClassType _) as c ->
(parent_class_signature_identifier c :> Identifier.Parent.t)
(parent_signature_identifier sg :> Identifier.FieldParent.t)
| `Type _ as t -> (parent_type_identifier t :> Identifier.FieldParent.t)

and label_parent_identifier : label_parent -> Identifier.LabelParent.t =
function
| `Identifier id -> id
| (`Class _ | `ClassType _) as c ->
(parent_class_signature_identifier c :> Identifier.LabelParent.t)
| ( `Hidden _ | `Alias _ | `AliasModuleType _ | `Module _ | `ModuleType _
| `Type _ | `Class _ | `ClassType _ ) as r ->
(parent_identifier r :> Identifier.LabelParent.t)
| `Type _ ) as r ->
(field_parent_identifier r :> Identifier.LabelParent.t)

and identifier : t -> Identifier.t = function
| `Identifier id -> id
| ( `Alias _ | `AliasModuleType _ | `Module _ | `Hidden _ | `Type _
| `Class _ | `ClassType _ | `ModuleType _ ) as r ->
(label_parent_identifier r :> Identifier.t)
| `Field (p, n) -> Identifier.Mk.field (parent_identifier p, n)
| `Field (p, n) -> Identifier.Mk.field (field_parent_identifier p, n)
| `Constructor (s, n) ->
Identifier.Mk.constructor (parent_type_identifier s, n)
Identifier.Mk.constructor
((parent_type_identifier s :> Identifier.DataType.t), n)
| `Extension (p, q) ->
Identifier.Mk.extension (parent_signature_identifier p, q)
| `ExtensionDecl (p, q, r) ->
Expand All @@ -1041,8 +1044,8 @@ module Reference = struct
type t = Paths_types.Resolved_reference.datatype
end

module Parent = struct
type t = Paths_types.Resolved_reference.parent
module FieldParent = struct
type t = Paths_types.Resolved_reference.field_parent
end

module LabelParent = struct
Expand Down Expand Up @@ -1126,8 +1129,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
Expand Down
21 changes: 11 additions & 10 deletions src/model/paths.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 FieldParent : sig
type t = Id.field_parent
type t_pv = Id.field_parent_pv
end

module FunctorResult : sig
Expand Down Expand Up @@ -290,11 +290,12 @@ module Identifier : sig
val core_type : string -> [> `CoreType of TypeName.t ] id

val constructor :
Type.t * ConstructorName.t ->
[> `Constructor of Type.t * ConstructorName.t ] id
DataType.t * ConstructorName.t ->
[> `Constructor of DataType.t * ConstructorName.t ] id

val field :
Parent.t * FieldName.t -> [> `Field of Parent.t * FieldName.t ] id
FieldParent.t * FieldName.t ->
[> `Field of FieldParent.t * FieldName.t ] id

val extension :
Signature.t * ExtensionName.t ->
Expand Down Expand Up @@ -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 FieldParent : sig
type t = Paths_types.Resolved_reference.field_parent
end

module LabelParent : sig
Expand Down Expand Up @@ -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
Expand Down
Loading