Skip to content

Add value and constructor path #1030

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 5 commits into from
Nov 7, 2023
Merged

Add value and constructor path #1030

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
1056aff
Adding path to values in the odoc model
panglesd Jun 22, 2023
5207ea1
Adding datatype and constructor to lang model
panglesd Jul 4, 2023
619ca16
Adding constructors and datatypes to component path
panglesd Jul 4, 2023
20221d9
Adding support for resolving constructor and datatype
panglesd Jul 4, 2023
949f955
Ignore {value/constructor}_path unused value
panglesd Oct 27, 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
5 changes: 5 additions & 0 deletions src/document/url.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,8 @@ let render_path : Odoc_model.Paths.Path.t -> string =
| `CanonicalModuleType (p, _) -> render_resolved (p :> t)
| `CanonicalType (_, `Resolved p) -> render_resolved (p :> t)
| `CanonicalType (p, _) -> render_resolved (p :> t)
| `CanonicalDataType (_, `Resolved p) -> render_resolved (p :> t)
| `CanonicalDataType (p, _) -> render_resolved (p :> t)
| `Apply (rp, p) ->
render_resolved (rp :> t)
^ "("
Expand All @@ -41,6 +43,9 @@ let render_path : Odoc_model.Paths.Path.t -> string =
| `ModuleType (p, s) ->
render_resolved (p :> t) ^ "." ^ ModuleTypeName.to_string s
| `Type (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s
| `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s
| `Constructor (p, s) ->
render_resolved (p :> t) ^ "." ^ ConstructorName.to_string s
| `Class (p, s) -> render_resolved (p :> t) ^ "." ^ ClassName.to_string s
| `ClassType (p, s) ->
render_resolved (p :> t) ^ "." ^ ClassTypeName.to_string s
Expand Down
66 changes: 66 additions & 0 deletions src/model/paths.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -330,6 +330,30 @@ module Identifier = struct
let compare = compare
end

module DataType = struct
type t = Id.path_datatype
type t_pv = Id.path_datatype_pv
let equal = equal
let hash = hash
let compare = compare
end

module Constructor = struct
type t = Id.path_constructor
type t_pv = Id.constructor_pv
let equal = equal
let hash = hash
let compare = compare
end

module Value = struct
type t = Id.path_value
type t_pv = Id.value_pv
let equal = equal
let hash = hash
let compare = compare
end

module ClassType = struct
type t = Id.path_class_type
type t_pv = Id.path_class_type_pv
Expand Down Expand Up @@ -555,6 +579,9 @@ module Path = struct
| `ModuleType (p, _) -> inner (p : module_ :> any)
| `Type (_, t) when Names.TypeName.is_internal t -> true
| `Type (p, _) -> inner (p : module_ :> any)
| `Value (_, t) when Names.ValueName.is_internal t -> true
| `Value (p, _) -> inner (p : module_ :> any)
| `Constructor (p, _) -> inner (p : datatype :> any)
| `Class (p, _) -> inner (p : module_ :> any)
| `ClassType (p, _) -> inner (p : module_ :> any)
| `Alias (dest, `Resolved src) ->
Expand All @@ -569,6 +596,8 @@ module Path = struct
| `CanonicalModuleType (x, _) -> inner (x : module_type :> any)
| `CanonicalType (_, `Resolved _) -> false
| `CanonicalType (x, _) -> inner (x : type_ :> any)
| `CanonicalDataType (_, `Resolved _) -> false
| `CanonicalDataType (x, _) -> inner (x : datatype :> any)
| `OpaqueModule m -> inner (m :> any)
| `OpaqueModuleType mt -> inner (mt :> any)
in
Expand Down Expand Up @@ -631,6 +660,14 @@ module Path = struct
| `Alias (dest, _src) -> parent_module_identifier dest
| `OpaqueModule m -> parent_module_identifier m

and parent_datatype_identifier :
Paths_types.Resolved_path.datatype -> Identifier.DataType.t = function
| `Identifier id ->
(id : Identifier.Path.DataType.t :> Identifier.DataType.t)
| `CanonicalDataType (_, `Resolved p) -> parent_datatype_identifier p
| `CanonicalDataType (p, _) -> parent_datatype_identifier p
| `Type (m, n) -> Identifier.Mk.type_ (parent_module_identifier m, n)

module Module = struct
type t = Paths_types.Resolved_path.module_

Expand All @@ -646,6 +683,18 @@ module Path = struct
type t = Paths_types.Resolved_path.type_
end

module DataType = struct
type t = Paths_types.Resolved_path.datatype
end

module Constructor = struct
type t = Paths_types.Resolved_path.constructor
end

module Value = struct
type t = Paths_types.Resolved_path.value
end

module ClassType = struct
type t = Paths_types.Resolved_path.class_type
end
Expand All @@ -659,6 +708,9 @@ module Path = struct
| `Canonical (p, _) -> identifier (p :> t)
| `Apply (m, _) -> identifier (m :> t)
| `Type (m, n) -> Identifier.Mk.type_ (parent_module_identifier m, n)
| `Value (m, n) -> Identifier.Mk.value (parent_module_identifier m, n)
| `Constructor (m, n) ->
Identifier.Mk.constructor (parent_datatype_identifier m, n)
| `ModuleType (m, n) ->
Identifier.Mk.module_type (parent_module_identifier m, n)
| `Class (m, n) -> Identifier.Mk.class_ (parent_module_identifier m, n)
Expand All @@ -678,6 +730,8 @@ module Path = struct
| `CanonicalModuleType (p, _) -> identifier (p :> t)
| `CanonicalType (_, `Resolved p) -> identifier (p :> t)
| `CanonicalType (p, _) -> identifier (p :> t)
| `CanonicalDataType (_, `Resolved p) -> identifier (p :> t)
| `CanonicalDataType (p, _) -> identifier (p :> t)
| `OpaqueModule m -> identifier (m :> t)
| `OpaqueModuleType mt -> identifier (mt :> t)

Expand All @@ -696,6 +750,18 @@ module Path = struct
type t = Paths_types.Path.type_
end

module DataType = struct
type t = Paths_types.Path.datatype
end

module Constructor = struct
type t = Paths_types.Path.constructor
end

module Value = struct
type t = Paths_types.Path.value
end

module ClassType = struct
type t = Paths_types.Path.class_type
end
Expand Down
38 changes: 38 additions & 0 deletions src/model/paths.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -170,6 +170,14 @@ module Identifier : sig
module Type :
IdSig with type t = Id.path_type and type t_pv = Id.path_type_pv

module DataType :
IdSig with type t = Id.path_datatype and type t_pv = Id.path_datatype_pv

module Constructor :
IdSig with type t = Id.path_constructor and type t_pv = Id.constructor_pv

module Value : IdSig with type t = Id.path_value and type t_pv = Id.value_pv

module ClassType :
IdSig
with type t = Id.path_class_type
Expand Down Expand Up @@ -339,6 +347,24 @@ module rec Path : sig
(* val identifier : t -> Identifier.Path.Type.t *)
end

module DataType : sig
type t = Paths_types.Resolved_path.datatype
end

module Constructor : sig
type t = Paths_types.Resolved_path.constructor
end

module Value : sig
type t = Paths_types.Resolved_path.value

(* val of_ident : Identifier.Path.Value.t -> t *)

(* val is_hidden : t -> bool *)

(* val identifier : t -> Identifier.Path.Type.t *)
end

module ClassType : sig
type t = Paths_types.Resolved_path.class_type

Expand Down Expand Up @@ -368,6 +394,18 @@ module rec Path : sig
type t = Paths_types.Path.type_
end

module DataType : sig
type t = Paths_types.Path.datatype
end

module Constructor : sig
type t = Paths_types.Path.constructor
end

module Value : sig
type t = Paths_types.Path.value
end

module ClassType : sig
type t = Paths_types.Path.class_type
end
Expand Down
45 changes: 44 additions & 1 deletion src/model/paths_types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -248,14 +248,29 @@ module Identifier = struct
and path_type = path_type_pv id
(** @canonical Odoc_model.Paths.Identifier.Path.Type.t *)

type path_datatype_pv = type_pv
(** @canonical Odoc_model.Paths.Identifier.Path.DataType.t_pv *)

and path_datatype = path_datatype_pv id
(** @canonical Odoc_model.Paths.Identifier.Path.DataType.t *)

type path_constructor = constructor

type path_value = value

type path_class_type_pv = [ class_pv | class_type_pv ]
(** @canonical Odoc_model.Paths.Identifier.Path.ClassType.t_pv *)

and path_class_type = path_class_type_pv id
(** @canonical Odoc_model.Paths.Identifier.Path.ClassType.t *)

type path_any =
[ path_module_pv | module_type_pv | path_type_pv | path_class_type_pv ] id
[ path_module_pv
| module_type_pv
| path_type_pv
| path_class_type_pv
| value_pv ]
id
(** @canonical Odoc_model.Paths.Identifier.Path.t *)

type fragment_module = path_module
Expand Down Expand Up @@ -314,6 +329,19 @@ module rec Path : sig
| `Dot of module_ * string ]
(** @canonical Odoc_model.Paths.Path.Type.t *)

type datatype =
[ `Resolved of Resolved_path.datatype
| `Identifier of Identifier.path_datatype * bool
| `Dot of module_ * string ]
(** @canonical Odoc_model.Paths.Path.DataType.t *)

type constructor =
[ `Resolved of Resolved_path.constructor | `Dot of datatype * string ]
(** @canonical Odoc_model.Paths.Path.Constructor.t *)

type value = [ `Resolved of Resolved_path.value | `Dot of module_ * string ]
(** @canonical Odoc_model.Paths.Path.Value.t *)

type class_type =
[ `Resolved of Resolved_path.class_type
| `Identifier of Identifier.path_class_type * bool
Expand Down Expand Up @@ -360,6 +388,18 @@ and Resolved_path : sig
| `ClassType of module_ * ClassTypeName.t ]
(** @canonical Odoc_model.Paths.Path.Resolved.Type.t *)

type datatype =
[ `Identifier of Identifier.datatype
| `CanonicalDataType of datatype * Path.datatype
| `Type of module_ * TypeName.t ]
(** @canonical Odoc_model.Paths.Path.Resolved.DataType.t *)

type constructor = [ `Constructor of datatype * ConstructorName.t ]
(** @canonical Odoc_model.Paths.Path.Resolved.Constructor.t *)

type value = [ `Value of module_ * ValueName.t ]
(** @canonical Odoc_model.Paths.Path.Resolved.Value.t *)

type class_type =
[ `Identifier of Identifier.path_class_type
| `Class of module_ * ClassName.t
Expand All @@ -380,10 +420,13 @@ and Resolved_path : sig
| `SubstT of module_type * module_type
| `OpaqueModuleType of module_type
| `CanonicalType of type_ * Path.type_
| `CanonicalDataType of datatype * Path.datatype
| `Type of module_ * TypeName.t
| `Constructor of datatype * ConstructorName.t
| `Class of module_ * ClassName.t
| `ClassType of module_ * ClassTypeName.t
| `Class of module_ * ClassName.t
| `Value of module_ * ValueName.t
| `ClassType of module_ * ClassTypeName.t ]
(** @canonical Odoc_model.Paths.Path.Resolved.t *)
end =
Expand Down
12 changes: 12 additions & 0 deletions src/model_desc/paths_desc.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -256,9 +256,21 @@ module General_paths = struct
( "`CanonicalType",
((x1 :> rp), (x2 :> p)),
Pair (resolved_path, path) )
| `CanonicalDataType (x1, x2) ->
C
( "`CanonicalDataType",
((x1 :> rp), (x2 :> p)),
Pair (resolved_path, path) )
| `OpaqueModuleType x -> C ("`OpaqueModuleType", (x :> rp), resolved_path)
| `Type (x1, x2) ->
C ("`Type", ((x1 :> rp), x2), Pair (resolved_path, Names.typename))
| `Value (x1, x2) ->
C ("`Value", ((x1 :> rp), x2), Pair (resolved_path, Names.valuename))
| `Constructor (x1, x2) ->
C
( "`Constructor",
((x1 :> rp), x2),
Pair (resolved_path, Names.constructorname) )
| `Class (x1, x2) ->
C ("`Class", ((x1 :> rp), x2), Pair (resolved_path, Names.classname))
| `ClassType (x1, x2) ->
Expand Down
26 changes: 26 additions & 0 deletions src/xref2/compile.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,27 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
| Ok p' -> `Resolved Lang_of.(Path.resolved_type (empty ()) p')
| Error _ -> p)

and value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t =
fun env p ->
match p with
| `Resolved _ -> p
| _ -> (
let cp = Component.Of_Lang.(value_path (empty ()) p) in
match Tools.resolve_value_path env cp with
| Ok p' -> `Resolved Lang_of.(Path.resolved_value (empty ()) p')
| Error _ -> p)

and constructor_path :
Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t =
fun env p ->
match p with
| `Resolved _ -> p
| _ -> (
let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
match Tools.resolve_constructor_path env cp with
| Ok p' -> `Resolved Lang_of.(Path.resolved_constructor (empty ()) p')
| Error _ -> p)

and module_type_path :
Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t =
fun env p ->
Expand Down Expand Up @@ -53,6 +74,11 @@ and class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t
| Ok p' -> `Resolved Lang_of.(Path.resolved_class_type (empty ()) p')
| Error _ -> p)

let () =
(* Until those are used *)
ignore value_path;
ignore constructor_path
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Would it break things to modify source_info_infos like in #976, or would it allow to check more things in the tests?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure about the question! Initially, #976 was a single PR, but I turned it into three PRs:

So no, it won't break things to have source_infos as in #976, on the contrary that is the goal!

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What I meant is it could be done in this PR to avoid ignoring the new functions. And then we end up having a source_info_infos different, but could we ignore the new values when processing the source_infos later down the code or would it break something, in which case we should not modify the source_infos yet?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok I think I understand your point: without test, it's harder to review and be sure the PR is correct...

The problem is that having source_info as in #976 is equivalent to merging the three PRs in one, which is back to the initial situation!

Copy link
Collaborator

@gpetiot gpetiot Oct 30, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Got it, thanks!


let rec unit env t =
let open Compilation_unit in
let source_info =
Expand Down
Loading