1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(** Representation and manipulation of classes and class types.*)
module Name = Odoc_name
(** To keep the order of elements in a class *)
type class_element =
Class_attribute of Odoc_value.t_attribute
| Class_method of Odoc_value.t_method
| Class_comment of Odoc_types.text
(** Used when we can reference t_class or t_class_type. *)
type cct =
Cl of t_class
| Cltype of t_class_type * Types.type_expr list (** class type and type parameters *)
and inherited_class = {
ic_name : Name.t ; (** Complete name of the inherited class *)
mutable ic_class : cct option ; (** The associated t_class or t_class_type *)
ic_text : Odoc_types.text option ; (** The inheritance comment, if any *)
}
and class_apply = {
capp_name : Name.t ; (** The complete name of the applied class *)
mutable capp_class : t_class option; (** The associated t_class if we found it *)
capp_params : Types.type_expr list; (** The type of expressions the class is applied to *)
capp_params_code : string list ; (** The code of these expressions *)
}
and class_constr = {
cco_name : Name.t ; (** The complete name of the applied class *)
mutable cco_class : cct option; (** The associated class of the class type if we found it *)
cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed *)
}
and class_kind =
Class_structure of inherited_class list * class_element list
(** an explicit class structure, used in implementation and interface *)
| Class_apply of class_apply (** application/alias of a class, used in implementation only *)
| Class_constr of class_constr (** a class used to give the type of the defined class,
instead of a structure, used in interface only.
For example, it will be used with the name "M1.M2....tutu"
when the class toto is defined like this :
class toto : int -> tutu *)
| Class_constraint of class_kind * class_type_kind
(** A class definition with a constraint. *)
(** Representation of a class. *)
and t_class = {
cl_name : Name.t ; (** Name of the class *)
mutable cl_info : Odoc_types.info option ; (** The optional associated user information *)
cl_type : Types.class_type ;
cl_type_parameters : Types.type_expr list ; (** Type parameters *)
cl_virtual : bool ; (** true = virtual *)
mutable cl_kind : class_kind ;
mutable cl_parameters : Odoc_parameter.parameter list ;
mutable cl_loc : Odoc_types.location ;
}
and class_type_alias = {
cta_name : Name.t ;
mutable cta_class : cct option ; (** we can have a t_class or a t_class_type *)
cta_type_parameters : Types.type_expr list ; (** the type parameters *)
}
and class_type_kind =
Class_signature of inherited_class list * class_element list
| Class_type of class_type_alias (** a class type eventually applied to type args *)
(** Representation of a class type. *)
and t_class_type = {
clt_name : Name.t ;
mutable clt_info : Odoc_types.info option ; (** The optional associated user information *)
clt_type : Types.class_type ;
clt_type_parameters : Types.type_expr list ; (** type parameters *)
clt_virtual : bool ; (** true = virtual *)
mutable clt_kind : class_type_kind ;
mutable clt_loc : Odoc_types.location ;
}
(** {1 Functions} *)
(** Returns the text associated to the given parameter label
in the given class, or None. *)
let class_parameter_text_by_name cl label =
match cl.cl_info with
None -> None
| Some i ->
try
let t = List.assoc label i.Odoc_types.i_params in
Some t
with
Not_found ->
None
(** Returns the list of elements of a t_class. *)
let rec class_elements ?(trans=true) cl =
let rec iter_kind k =
match k with
Class_structure (_, elements) -> elements
| Class_constraint (c_kind, _ct_kind) ->
iter_kind c_kind
(* FIXME : use c_kind or ct_kind ?
For now, as ct_kind is not analyzed,
we search inside c_kind
class_type_elements ~trans: trans
{ clt_name = "" ; clt_info = None ;
clt_type_parameters = [] ;
clt_virtual = false ;
clt_kind = ct_kind }
*)
| Class_apply capp ->
(
match capp.capp_class with
Some c when trans -> class_elements ~trans: trans c
| _ -> []
)
| Class_constr cco ->
(
match cco.cco_class with
Some (Cl c) when trans -> class_elements ~trans: trans c
| Some (Cltype (ct,_)) when trans -> class_type_elements ~trans: trans ct
| _ -> []
)
in
iter_kind cl.cl_kind
(** Returns the list of elements of a t_class_type. *)
and class_type_elements ?(trans=true) clt =
match clt.clt_kind with
Class_signature (_, elements) -> elements
| Class_type { cta_class = Some (Cltype (ct, _)) } when trans ->
class_type_elements ~trans ct
| Class_type { cta_class = Some (Cl c) } when trans ->
class_elements ~trans c
| Class_type _ ->
[]
(** Returns the attributes of a t_class. *)
let class_attributes ?(trans=true) cl =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_attribute a ->
acc @ [ a ]
| _ ->
acc
)
[]
(class_elements ~trans cl)
(** Returns the methods of a t_class. *)
let class_methods ?(trans=true) cl =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_method m ->
acc @ [ m ]
| _ ->
acc
)
[]
(class_elements ~trans cl)
(** Returns the comments in a t_class. *)
let class_comments ?(trans=true) cl =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_comment t ->
acc @ [ t ]
| _ ->
acc
)
[]
(class_elements ~trans cl)
(** Update the parameters text of a t_class, according to the cl_info field. *)
let class_update_parameters_text cl =
let f p =
Odoc_parameter.update_parameter_text (class_parameter_text_by_name cl) p
in
List.iter f cl.cl_parameters
(** Returns the attributes of a t_class_type. *)
let class_type_attributes ?(trans=true) clt =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_attribute a ->
acc @ [ a ]
| _ ->
acc
)
[]
(class_type_elements ~trans clt)
(** Returns the methods of a t_class_type. *)
let class_type_methods ?(trans=true) clt =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_method m ->
acc @ [ m ]
| _ ->
acc
)
[]
(class_type_elements ~trans clt)
(** Returns the comments in a t_class_type. *)
let class_type_comments ?(trans=true) clt =
List.fold_left
(fun acc -> fun ele ->
match ele with
Class_comment m ->
acc @ [ m ]
| _ ->
acc
)
[]
(class_type_elements ~trans clt)
(** Returns the text associated to the given parameter label
in the given class type, or None. *)
let class_type_parameter_text_by_name clt label =
match clt.clt_info with
None -> None
| Some i ->
try
let t = List.assoc label i.Odoc_types.i_params in
Some t
with
Not_found ->
None
|
