Skip to content

Commit d1924fb

Browse files
Julowjonludlam
Julow
authored and
jonludlam
committed
Handle comments on class inherit and constraint
Comment were not added into the model.
1 parent c3f025d commit d1924fb

File tree

14 files changed

+152
-72
lines changed

14 files changed

+152
-72
lines changed

‎src/document/generator.ml

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -954,20 +954,27 @@ module Make (Syntax : SYNTAX) = struct
954954
let doc = Comment.to_ir t.doc in
955955
Item.Declaration { attr; anchor; doc; content }
956956

957-
let inherit_ cte =
957+
let inherit_ (ih : Lang.ClassSignature.Inherit.t) =
958+
let cte =
959+
match ih.expr with
960+
| Signature _ -> assert false (* Bold. *)
961+
| cty -> cty
962+
in
958963
let content =
959964
O.documentedSrc (O.keyword "inherit" ++ O.txt " " ++ class_type_expr cte)
960965
in
961966
let attr = [ "inherit" ] in
962967
let anchor = None in
963-
let doc = [] in
968+
let doc = Comment.to_ir ih.doc in
964969
Item.Declaration { attr; anchor; doc; content }
965970

966-
let constraint_ t1 t2 =
967-
let content = O.documentedSrc (format_constraints [ (t1, t2) ]) in
971+
let constraint_ (cst : Lang.ClassSignature.Constraint.t) =
972+
let content =
973+
O.documentedSrc (format_constraints [ (cst.left, cst.right) ])
974+
in
968975
let attr = [] in
969976
let anchor = None in
970-
let doc = [] in
977+
let doc = Comment.to_ir cst.doc in
971978
Item.Declaration { attr; anchor; doc; content }
972979

973980
let class_signature (c : Lang.ClassSignature.t) =
@@ -977,11 +984,10 @@ module Make (Syntax : SYNTAX) = struct
977984
| item :: rest -> (
978985
let continue item = loop rest (item :: acc_items) in
979986
match (item : Lang.ClassSignature.item) with
980-
| Inherit (Signature _) -> assert false (* Bold. *)
981987
| Inherit cty -> continue @@ inherit_ cty
982988
| Method m -> continue @@ method_ m
983989
| InstanceVariable v -> continue @@ instance_variable v
984-
| Constraint (t1, t2) -> continue @@ constraint_ t1 t2
990+
| Constraint cst -> continue @@ constraint_ cst
985991
| Comment `Stop ->
986992
let rest =
987993
Utils.skip_until rest ~p:(function

‎src/loader/cmi.ml

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -691,6 +691,12 @@ let read_type_constraints env params =
691691
else acc)
692692
params []
693693

694+
let read_class_constraints env params =
695+
let open ClassSignature in
696+
read_type_constraints env params
697+
|> List.map (fun (left, right) ->
698+
Constraint { Constraint.left; right; doc = [] })
699+
694700
let read_type_declaration env parent id decl =
695701
let open TypeDecl in
696702
let id = Env.find_type_identifier env id in
@@ -810,12 +816,7 @@ let rec read_class_signature env parent params =
810816
| Cty_signature csig ->
811817
let open ClassSignature in
812818
let self = read_self_type csig.csig_self in
813-
let constraints = read_type_constraints env params in
814-
let constraints =
815-
List.map
816-
(fun (typ1, typ2) -> Constraint(typ1, typ2))
817-
constraints
818-
in
819+
let constraints = read_class_constraints env params in
819820
let instance_variables =
820821
Vars.fold
821822
(fun name (mutable_, virtual_, typ) acc ->

‎src/loader/cmi.mli

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,11 @@ val read_type_constraints : Ident_env.t -> Types.type_expr list ->
5151
(Odoc_model.Lang.TypeExpr.t
5252
* Odoc_model.Lang.TypeExpr.t) list
5353

54+
val read_class_constraints :
55+
Ident_env.t ->
56+
Types.type_expr list ->
57+
Odoc_model.Lang.ClassSignature.item list
58+
5459
val read_class_signature : Ident_env.t ->
5560
Paths.Identifier.ClassSignature.t ->
5661
Types.type_expr list -> Types.class_type ->

‎src/loader/cmt.ml

Lines changed: 6 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -127,7 +127,6 @@ let read_type_extension env parent tyext =
127127
let rec read_class_type_field env parent ctf =
128128
let open ClassSignature in
129129
let open Odoc_model.Names in
130-
131130
let container = (parent : Identifier.ClassSignature.t :> Identifier.LabelParent.t) in
132131
let doc = Doc_attr.attached_no_tag container ctf.ctf_attributes in
133132
match ctf.ctf_desc with
@@ -147,7 +146,8 @@ let rec read_class_type_field env parent ctf =
147146
Some (Method {id; doc; private_; virtual_; type_})
148147
| Tctf_constraint(_, _) -> None
149148
| Tctf_inherit cltyp ->
150-
Some (Inherit (read_class_signature env parent [] cltyp))
149+
let expr = read_class_signature env parent [] cltyp in
150+
Some (Inherit { Inherit.expr; doc })
151151
| Tctf_attribute attr ->
152152
match Doc_attr.standalone container attr with
153153
| None -> None
@@ -165,14 +165,7 @@ and read_class_signature env parent params cltyp =
165165
let self =
166166
Cmi.read_self_type csig.csig_self.ctyp_type
167167
in
168-
let constraints =
169-
Cmi.read_type_constraints env params
170-
in
171-
let constraints =
172-
List.map
173-
(fun (typ1, typ2) -> Constraint(typ1, typ2))
174-
constraints
175-
in
168+
let constraints = Cmi.read_class_constraints env params in
176169
let items =
177170
List.fold_left
178171
(fun rest item ->
@@ -244,7 +237,8 @@ let rec read_class_field env parent cf =
244237
Some (Method {id; doc; private_; virtual_; type_})
245238
| Tcf_constraint(_, _) -> None
246239
| Tcf_inherit(_, cl, _, _, _) ->
247-
Some (Inherit (read_class_structure env parent [] cl))
240+
let expr = read_class_structure env parent [] cl in
241+
Some (Inherit {Inherit.expr; doc})
248242
| Tcf_initializer _ -> None
249243
| Tcf_attribute attr ->
250244
match Doc_attr.standalone container attr with
@@ -259,14 +253,7 @@ and read_class_structure env parent params cl =
259253
| Tcl_structure cstr ->
260254
let open ClassSignature in
261255
let self = Cmi.read_self_type cstr.cstr_self.pat_type in
262-
let constraints =
263-
Cmi.read_type_constraints env params
264-
in
265-
let constraints =
266-
List.map
267-
(fun (typ1, typ2) -> Constraint(typ1, typ2))
268-
constraints
269-
in
256+
let constraints = Cmi.read_class_constraints env params in
270257
let items =
271258
List.fold_left
272259
(fun rest item ->

‎src/loader/cmti.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -347,7 +347,6 @@ let read_exception env parent (ext : extension_constructor) =
347347
let rec read_class_type_field env parent ctf =
348348
let open ClassSignature in
349349
let open Odoc_model.Names in
350-
351350
let container = (parent : Identifier.ClassSignature.t :> Identifier.LabelParent.t) in
352351
let doc = Doc_attr.attached_no_tag container ctf.ctf_attributes in
353352
match ctf.ctf_desc with
@@ -356,21 +355,22 @@ let rec read_class_type_field env parent ctf =
356355
let id = Identifier.Mk.instance_variable(parent, InstanceVariableName.make_std name) in
357356
let mutable_ = (mutable_ = Mutable) in
358357
let virtual_ = (virtual_ = Virtual) in
359-
let type_ = read_core_type env container typ in
360-
Some (InstanceVariable {id; doc; mutable_; virtual_; type_})
358+
let type_ = read_core_type env container typ in
359+
Some (InstanceVariable {id; doc; mutable_; virtual_; type_})
361360
| Tctf_method(name, private_, virtual_, typ) ->
362361
let open Method in
363362
let id = Identifier.Mk.method_(parent, MethodName.make_std name) in
364363
let private_ = (private_ = Private) in
365364
let virtual_ = (virtual_ = Virtual) in
366-
let type_ = read_core_type env container typ in
367-
Some (Method {id; doc; private_; virtual_; type_})
365+
let type_ = read_core_type env container typ in
366+
Some (Method {id; doc; private_; virtual_; type_})
368367
| Tctf_constraint(typ1, typ2) ->
369-
let typ1 = read_core_type env container typ1 in
370-
let typ2 = read_core_type env container typ2 in
371-
Some (Constraint(typ1, typ2))
368+
let left = read_core_type env container typ1 in
369+
let right = read_core_type env container typ2 in
370+
Some (Constraint {left; right; doc})
372371
| Tctf_inherit cltyp ->
373-
Some (Inherit (read_class_signature env parent container cltyp))
372+
let expr = read_class_signature env parent container cltyp in
373+
Some (Inherit {expr; doc})
374374
| Tctf_attribute attr ->
375375
match Doc_attr.standalone container attr with
376376
| None -> None

‎src/model/lang.ml

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -335,11 +335,19 @@ end =
335335
(** {3 Class Signatures} *)
336336

337337
and ClassSignature : sig
338+
module Constraint : sig
339+
type t = { left : TypeExpr.t; right : TypeExpr.t; doc : Comment.docs }
340+
end
341+
342+
module Inherit : sig
343+
type t = { expr : ClassType.expr; doc : Comment.docs }
344+
end
345+
338346
type item =
339347
| Method of Method.t
340348
| InstanceVariable of InstanceVariable.t
341-
| Constraint of TypeExpr.t * TypeExpr.t
342-
| Inherit of ClassType.expr
349+
| Constraint of Constraint.t
350+
| Inherit of Inherit.t
343351
| Comment of Comment.docs_or_stop
344352

345353
type t = { self : TypeExpr.t option; items : item list; doc : Comment.docs }

‎src/model_desc/lang_desc.ml

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -470,9 +470,12 @@ and classsignature_item =
470470
(function
471471
| Method x -> C ("Method", x, method_t)
472472
| InstanceVariable x -> C ("InstanceVariable", x, instancevariable_t)
473-
| Constraint (x1, x2) ->
474-
C ("Constraint", (x1, x2), Pair (typeexpr_t, typeexpr_t))
475-
| Inherit x -> C ("Inherit", x, classtype_expr)
473+
| Constraint cst ->
474+
C
475+
( "Constraint",
476+
(cst.left, cst.right, cst.doc),
477+
Triple (typeexpr_t, typeexpr_t, docs) )
478+
| Inherit ih -> C ("Inherit", (ih.expr, ih.doc), Pair (classtype_expr, docs))
476479
| Comment x -> C ("Comment", x, docs_or_stop))
477480

478481
and classsignature_t =

‎src/xref2/compile.ml

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -139,10 +139,8 @@ and class_signature env parent c =
139139
let map_item = function
140140
| Method m -> Method (method_ env parent m)
141141
| InstanceVariable i -> InstanceVariable (instance_variable env parent i)
142-
| Constraint (t1, t2) ->
143-
Constraint
144-
(type_expression env container t1, type_expression env container t2)
145-
| Inherit c -> Inherit (class_type_expr env parent c)
142+
| Constraint cst -> Constraint (class_constraint env container cst)
143+
| Inherit ih -> Inherit (inherit_ env parent ih)
146144
| Comment c -> Comment c
147145
in
148146
{
@@ -161,6 +159,18 @@ and instance_variable env parent i =
161159
let container = (parent :> Id.Parent.t) in
162160
{ i with type_ = type_expression env container i.type_ }
163161

162+
and class_constraint env parent cst =
163+
let open ClassSignature.Constraint in
164+
{
165+
cst with
166+
left = type_expression env parent cst.left;
167+
right = type_expression env parent cst.right;
168+
}
169+
170+
and inherit_ env parent ih =
171+
let open ClassSignature.Inherit in
172+
{ ih with expr = class_type_expr env parent ih.expr }
173+
164174
and class_ env parent c =
165175
let open Class in
166176
let container = (parent :> Id.Parent.t) in

‎src/xref2/component.ml

Lines changed: 31 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -378,11 +378,19 @@ end =
378378
ClassType
379379

380380
and ClassSignature : sig
381+
module Constraint : sig
382+
type t = { left : TypeExpr.t; right : TypeExpr.t; doc : CComment.docs }
383+
end
384+
385+
module Inherit : sig
386+
type t = { expr : ClassType.expr; doc : CComment.docs }
387+
end
388+
381389
type item =
382390
| Method of Ident.method_ * Method.t
383391
| InstanceVariable of Ident.instance_variable * InstanceVariable.t
384-
| Constraint of TypeExpr.t * TypeExpr.t
385-
| Inherit of ClassType.expr
392+
| Constraint of Constraint.t
393+
| Inherit of Inherit.t
386394
| Comment of CComment.docs_or_stop
387395

388396
type t = { self : TypeExpr.t option; items : item list; doc : CComment.docs }
@@ -602,10 +610,12 @@ module Fmt = struct
602610
| InstanceVariable (id, i) ->
603611
Format.fprintf ppf "@[<v 2>instance variable %a : %a@]@," Ident.fmt
604612
id instance_variable i
605-
| Constraint (t1, t2) ->
606-
Format.fprintf ppf "@[<v 2>constraint %a = %a@]@," type_expr t1
607-
type_expr t2
608-
| Inherit i -> Format.fprintf ppf "@[<v 2>inherit %a" class_type_expr i
613+
| Constraint cst ->
614+
Format.fprintf ppf "@[<v 2>constraint %a = %a@]@," type_expr
615+
cst.Constraint.left type_expr cst.right
616+
| Inherit i ->
617+
Format.fprintf ppf "@[<v 2>inherit %a" class_type_expr
618+
i.Inherit.expr
609619
| Comment _ -> ())
610620
sg.items
611621

@@ -2223,10 +2233,8 @@ module Of_Lang = struct
22232233
let id = Ident.Of_Identifier.instance_variable i.id in
22242234
let i' = instance_variable ident_map i in
22252235
ClassSignature.InstanceVariable (id, i')
2226-
| Constraint (t1, t2) ->
2227-
Constraint
2228-
(type_expression ident_map t1, type_expression ident_map t2)
2229-
| Inherit e -> Inherit (class_type_expr ident_map e)
2236+
| Constraint cst -> Constraint (class_constraint ident_map cst)
2237+
| Inherit e -> Inherit (inherit_ ident_map e)
22302238
| Comment c -> Comment (docs_or_stop ident_map c))
22312239
sg.items
22322240
in
@@ -2253,6 +2261,19 @@ module Of_Lang = struct
22532261
type_ = type_expression ident_map i.type_;
22542262
}
22552263

2264+
and class_constraint ident_map cst =
2265+
{
2266+
ClassSignature.Constraint.doc = docs ident_map cst.doc;
2267+
left = type_expression ident_map cst.left;
2268+
right = type_expression ident_map cst.right;
2269+
}
2270+
2271+
and inherit_ ident_map ih =
2272+
{
2273+
ClassSignature.Inherit.doc = docs ident_map ih.doc;
2274+
expr = class_type_expr ident_map ih.expr;
2275+
}
2276+
22562277
and module_substitution ident_map (t : Odoc_model.Lang.ModuleSubstitution.t) =
22572278
{
22582279
ModuleSubstitution.doc = docs ident_map t.doc;

‎src/xref2/component.mli

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -352,11 +352,19 @@ and ClassType : sig
352352
end
353353

354354
and ClassSignature : sig
355+
module Constraint : sig
356+
type t = { left : TypeExpr.t; right : TypeExpr.t; doc : CComment.docs }
357+
end
358+
359+
module Inherit : sig
360+
type t = { expr : ClassType.expr; doc : CComment.docs }
361+
end
362+
355363
type item =
356364
| Method of Ident.method_ * Method.t
357365
| InstanceVariable of Ident.instance_variable * InstanceVariable.t
358-
| Constraint of TypeExpr.t * TypeExpr.t
359-
| Inherit of ClassType.expr
366+
| Constraint of Constraint.t
367+
| Inherit of Inherit.t
360368
| Comment of CComment.docs_or_stop
361369

362370
type t = { self : TypeExpr.t option; items : item list; doc : CComment.docs }

0 commit comments

Comments
 (0)