Skip to content

Commit 5826eb1

Browse files
panglesdjonludlam
panglesd
authored and
jonludlam
committed
Adding datatype and constructor to lang model
Signed-off-by: Paul-Elliot <peada@free.fr>
1 parent 04b6335 commit 5826eb1

File tree

6 files changed

+114
-0
lines changed

6 files changed

+114
-0
lines changed

‎src/document/url.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,8 @@ let render_path : Odoc_model.Paths.Path.t -> string =
3333
| `CanonicalModuleType (p, _) -> render_resolved (p :> t)
3434
| `CanonicalType (_, `Resolved p) -> render_resolved (p :> t)
3535
| `CanonicalType (p, _) -> render_resolved (p :> t)
36+
| `CanonicalDataType (_, `Resolved p) -> render_resolved (p :> t)
37+
| `CanonicalDataType (p, _) -> render_resolved (p :> t)
3638
| `Apply (rp, p) ->
3739
render_resolved (rp :> t)
3840
^ "("
@@ -42,6 +44,8 @@ let render_path : Odoc_model.Paths.Path.t -> string =
4244
render_resolved (p :> t) ^ "." ^ ModuleTypeName.to_string s
4345
| `Type (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s
4446
| `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s
47+
| `Constructor (p, s) ->
48+
render_resolved (p :> t) ^ "." ^ ConstructorName.to_string s
4549
| `Class (p, s) -> render_resolved (p :> t) ^ "." ^ ClassName.to_string s
4650
| `ClassType (p, s) ->
4751
render_resolved (p :> t) ^ "." ^ ClassTypeName.to_string s

‎src/model/paths.ml‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -421,6 +421,22 @@ module Identifier = struct
421421
let compare = compare
422422
end
423423

424+
module DataType = struct
425+
type t = Id.path_datatype
426+
type t_pv = Id.path_datatype_pv
427+
let equal = equal
428+
let hash = hash
429+
let compare = compare
430+
end
431+
432+
module Constructor = struct
433+
type t = Id.path_constructor
434+
type t_pv = Id.constructor_pv
435+
let equal = equal
436+
let hash = hash
437+
let compare = compare
438+
end
439+
424440
module Value = struct
425441
type t = Id.path_value
426442
type t_pv = Id.value_pv
@@ -666,6 +682,7 @@ module Path = struct
666682
| `Type (p, _) -> inner (p : module_ :> any)
667683
| `Value (_, t) when Names.ValueName.is_internal t -> true
668684
| `Value (p, _) -> inner (p : module_ :> any)
685+
| `Constructor (p, _) -> inner (p : datatype :> any)
669686
| `Class (p, _) -> inner (p : module_ :> any)
670687
| `ClassType (p, _) -> inner (p : module_ :> any)
671688
| `Alias (dest, `Resolved src) ->
@@ -680,6 +697,8 @@ module Path = struct
680697
| `CanonicalModuleType (x, _) -> inner (x : module_type :> any)
681698
| `CanonicalType (_, `Resolved _) -> false
682699
| `CanonicalType (x, _) -> inner (x : type_ :> any)
700+
| `CanonicalDataType (_, `Resolved _) -> false
701+
| `CanonicalDataType (x, _) -> inner (x : datatype :> any)
683702
| `OpaqueModule m -> inner (m :> any)
684703
| `OpaqueModuleType mt -> inner (mt :> any)
685704
in
@@ -742,6 +761,14 @@ module Path = struct
742761
| `Alias (dest, _src) -> parent_module_identifier dest
743762
| `OpaqueModule m -> parent_module_identifier m
744763

764+
and parent_datatype_identifier :
765+
Paths_types.Resolved_path.datatype -> Identifier.DataType.t = function
766+
| `Identifier id ->
767+
(id : Identifier.Path.DataType.t :> Identifier.DataType.t)
768+
| `CanonicalDataType (_, `Resolved p) -> parent_datatype_identifier p
769+
| `CanonicalDataType (p, _) -> parent_datatype_identifier p
770+
| `Type (m, n) -> Identifier.Mk.type_ (parent_module_identifier m, n)
771+
745772
module Module = struct
746773
type t = Paths_types.Resolved_path.module_
747774

@@ -757,6 +784,14 @@ module Path = struct
757784
type t = Paths_types.Resolved_path.type_
758785
end
759786

787+
module DataType = struct
788+
type t = Paths_types.Resolved_path.datatype
789+
end
790+
791+
module Constructor = struct
792+
type t = Paths_types.Resolved_path.constructor
793+
end
794+
760795
module Value = struct
761796
type t = Paths_types.Resolved_path.value
762797
end
@@ -775,6 +810,8 @@ module Path = struct
775810
| `Apply (m, _) -> identifier (m :> t)
776811
| `Type (m, n) -> Identifier.Mk.type_ (parent_module_identifier m, n)
777812
| `Value (m, n) -> Identifier.Mk.value (parent_module_identifier m, n)
813+
| `Constructor (m, n) ->
814+
Identifier.Mk.constructor (parent_datatype_identifier m, n)
778815
| `ModuleType (m, n) ->
779816
Identifier.Mk.module_type (parent_module_identifier m, n)
780817
| `Class (m, n) -> Identifier.Mk.class_ (parent_module_identifier m, n)
@@ -794,6 +831,8 @@ module Path = struct
794831
| `CanonicalModuleType (p, _) -> identifier (p :> t)
795832
| `CanonicalType (_, `Resolved p) -> identifier (p :> t)
796833
| `CanonicalType (p, _) -> identifier (p :> t)
834+
| `CanonicalDataType (_, `Resolved p) -> identifier (p :> t)
835+
| `CanonicalDataType (p, _) -> identifier (p :> t)
797836
| `OpaqueModule m -> identifier (m :> t)
798837
| `OpaqueModuleType mt -> identifier (mt :> t)
799838

@@ -812,6 +851,14 @@ module Path = struct
812851
type t = Paths_types.Path.type_
813852
end
814853

854+
module DataType = struct
855+
type t = Paths_types.Path.datatype
856+
end
857+
858+
module Constructor = struct
859+
type t = Paths_types.Path.constructor
860+
end
861+
815862
module Value = struct
816863
type t = Paths_types.Path.value
817864
end

‎src/model/paths.mli‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -182,6 +182,12 @@ module Identifier : sig
182182
module Type :
183183
IdSig with type t = Id.path_type and type t_pv = Id.path_type_pv
184184

185+
module DataType :
186+
IdSig with type t = Id.path_datatype and type t_pv = Id.path_datatype_pv
187+
188+
module Constructor :
189+
IdSig with type t = Id.path_constructor and type t_pv = Id.constructor_pv
190+
185191
module Value : IdSig with type t = Id.path_value and type t_pv = Id.value_pv
186192

187193
module ClassType :
@@ -367,6 +373,14 @@ module rec Path : sig
367373
(* val identifier : t -> Identifier.Path.Type.t *)
368374
end
369375

376+
module DataType : sig
377+
type t = Paths_types.Resolved_path.datatype
378+
end
379+
380+
module Constructor : sig
381+
type t = Paths_types.Resolved_path.constructor
382+
end
383+
370384
module Value : sig
371385
type t = Paths_types.Resolved_path.value
372386

@@ -406,6 +420,14 @@ module rec Path : sig
406420
type t = Paths_types.Path.type_
407421
end
408422

423+
module DataType : sig
424+
type t = Paths_types.Path.datatype
425+
end
426+
427+
module Constructor : sig
428+
type t = Paths_types.Path.constructor
429+
end
430+
409431
module Value : sig
410432
type t = Paths_types.Path.value
411433
end

‎src/model/paths_types.ml‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -256,6 +256,14 @@ module Identifier = struct
256256
and path_type = path_type_pv id
257257
(** @canonical Odoc_model.Paths.Identifier.Path.Type.t *)
258258

259+
type path_datatype_pv = type_pv
260+
(** @canonical Odoc_model.Paths.Identifier.Path.DataType.t_pv *)
261+
262+
and path_datatype = path_datatype_pv id
263+
(** @canonical Odoc_model.Paths.Identifier.Path.DataType.t *)
264+
265+
type path_constructor = constructor
266+
259267
type path_value = value
260268

261269
type path_class_type_pv = [ class_pv | class_type_pv ]
@@ -331,6 +339,16 @@ module rec Path : sig
331339
| `Dot of module_ * string ]
332340
(** @canonical Odoc_model.Paths.Path.Type.t *)
333341

342+
type datatype =
343+
[ `Resolved of Resolved_path.datatype
344+
| `Identifier of Identifier.path_datatype * bool
345+
| `Dot of module_ * string ]
346+
(** @canonical Odoc_model.Paths.Path.DataType.t *)
347+
348+
type constructor =
349+
[ `Resolved of Resolved_path.constructor | `Dot of datatype * string ]
350+
(** @canonical Odoc_model.Paths.Path.Constructor.t *)
351+
334352
type value = [ `Resolved of Resolved_path.value | `Dot of module_ * string ]
335353
(** @canonical Odoc_model.Paths.Path.Value.t *)
336354

@@ -380,6 +398,15 @@ and Resolved_path : sig
380398
| `ClassType of module_ * ClassTypeName.t ]
381399
(** @canonical Odoc_model.Paths.Path.Resolved.Type.t *)
382400

401+
type datatype =
402+
[ `Identifier of Identifier.datatype
403+
| `CanonicalDataType of datatype * Path.datatype
404+
| `Type of module_ * TypeName.t ]
405+
(** @canonical Odoc_model.Paths.Path.Resolved.DataType.t *)
406+
407+
type constructor = [ `Constructor of datatype * ConstructorName.t ]
408+
(** @canonical Odoc_model.Paths.Path.Resolved.Constructor.t *)
409+
383410
type value = [ `Value of module_ * ValueName.t ]
384411
(** @canonical Odoc_model.Paths.Path.Resolved.Value.t *)
385412

@@ -403,7 +430,9 @@ and Resolved_path : sig
403430
| `SubstT of module_type * module_type
404431
| `OpaqueModuleType of module_type
405432
| `CanonicalType of type_ * Path.type_
433+
| `CanonicalDataType of datatype * Path.datatype
406434
| `Type of module_ * TypeName.t
435+
| `Constructor of datatype * ConstructorName.t
407436
| `Class of module_ * ClassName.t
408437
| `ClassType of module_ * ClassTypeName.t
409438
| `Class of module_ * ClassName.t

‎src/model_desc/paths_desc.ml‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -262,11 +262,21 @@ module General_paths = struct
262262
( "`CanonicalType",
263263
((x1 :> rp), (x2 :> p)),
264264
Pair (resolved_path, path) )
265+
| `CanonicalDataType (x1, x2) ->
266+
C
267+
( "`CanonicalDataType",
268+
((x1 :> rp), (x2 :> p)),
269+
Pair (resolved_path, path) )
265270
| `OpaqueModuleType x -> C ("`OpaqueModuleType", (x :> rp), resolved_path)
266271
| `Type (x1, x2) ->
267272
C ("`Type", ((x1 :> rp), x2), Pair (resolved_path, Names.typename))
268273
| `Value (x1, x2) ->
269274
C ("`Value", ((x1 :> rp), x2), Pair (resolved_path, Names.valuename))
275+
| `Constructor (x1, x2) ->
276+
C
277+
( "`Constructor",
278+
((x1 :> rp), x2),
279+
Pair (resolved_path, Names.constructorname) )
270280
| `Class (x1, x2) ->
271281
C ("`Class", ((x1 :> rp), x2), Pair (resolved_path, Names.classname))
272282
| `ClassType (x1, x2) ->

‎test/xref2/lib/common.cppo.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -565,11 +565,13 @@ module LangUtils = struct
565565
| `ModuleType (p, mt) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (Odoc_model.Names.ModuleTypeName.to_string mt)
566566
| `Type (p, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (Odoc_model.Names.TypeName.to_string t)
567567
| `Value (p, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (Odoc_model.Names.ValueName.to_string t)
568+
| `Constructor (p, t) -> Format.fprintf ppf "%a.%s" resolved_path (cast p) (Odoc_model.Names.ConstructorName.to_string t)
568569
| `OpaqueModule m -> Format.fprintf ppf "opaquemodule(%a)" resolved_path (cast m)
569570
| `OpaqueModuleType m -> Format.fprintf ppf "opaquemoduletype(%a)" resolved_path (cast m)
570571
| `SubstT (_, _)
571572
| `CanonicalModuleType (_, _)
572573
| `CanonicalType (_, _)
574+
| `CanonicalDataType (_, _)
573575
| `Class (_, _)
574576
| `ClassType (_, _)
575577
| `Hidden _

0 commit comments

Comments
 (0)