1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2001 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 module String = Misc.Stdlib.String
17
18 (** Representation and manipulation of modules and module types. *)
19
20 let print_DEBUG s = print_string s ; print_newline ()
21
22 module Name = Odoc_name
23
24 (** To keep the order of elements in a module. *)
25 type module_element =
26 Element_module of t_module
27 | Element_module_type of t_module_type
28 | Element_included_module of included_module
29 | Element_class of Odoc_class.t_class
30 | Element_class_type of Odoc_class.t_class_type
31 | Element_value of Odoc_value.t_value
32 | Element_type_extension of Odoc_extension.t_type_extension
33 | Element_exception of Odoc_exception.t_exception
34 | Element_type of Odoc_type.t_type
35 | Element_module_comment of Odoc_types.text
36
37 (** Used where we can reference t_module or t_module_type *)
38 and mmt =
39 | Mod of t_module
40 | Modtype of t_module_type
41
42 and included_module = {
43 im_name : Name.t ; (** the name of the included module *)
44 mutable im_module : mmt option ; (** the included module or module type *)
45 mutable im_info : Odoc_types.info option ; (** comment associated to the include directive *)
46 }
47
48 and module_alias = {
49 ma_name : Name.t ;
50 mutable ma_module : mmt option ; (** the real module or module type if we could associate it *)
51 }
52
53 and module_parameter = {
54 mp_name : string ; (** the name *)
55 mp_type : Types.module_type option ; (** the type *)
56 mp_type_code : string ; (** the original code *)
57 mp_kind : module_type_kind ; (** the way the parameter was built *)
58 }
59
60 (** Different kinds of module. *)
61 and module_kind =
62 | Module_struct of module_element list
63 | Module_alias of module_alias (** complete name and corresponding module if we found it *)
64 | Module_functor of module_parameter * module_kind
65 | Module_apply of module_kind * module_kind
66 | Module_with of module_type_kind * string
67 | Module_constraint of module_kind * module_type_kind
68 | Module_typeof of string (** by now only the code of the module expression *)
69 | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)
70
71 (** Representation of a module. *)
72 and t_module = {
73 m_name : Name.t ;
74 mutable m_type : Types.module_type ;
75 mutable m_info : Odoc_types.info option ;
76 m_is_interface : bool ; (** true for modules read from interface files *)
77 m_file : string ; (** the file the module is defined in. *)
78 mutable m_kind : module_kind ;
79 mutable m_loc : Odoc_types.location ;
80 mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *)
81 mutable m_code : string option ; (** The whole code of the module *)
82 mutable m_code_intf : string option ; (** The whole code of the interface of the module *)
83 m_text_only : bool ; (** [true] if the module comes from a text file *)
84 }
85
86 and module_type_alias = {
87 mta_name : Name.t ;
88 mutable mta_module : t_module_type option ; (** the real module type if we could associate it *)
89 }
90
91 (** Different kinds of module type. *)
92 and module_type_kind =
93 | Module_type_struct of module_element list
94 | Module_type_functor of module_parameter * module_type_kind
95 | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *)
96 | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *)
97 | Module_type_typeof of string (** by now only the code of the module expression *)
98
99 (** Representation of a module type. *)
100 and t_module_type = {
101 mt_name : Name.t ;
102 mutable mt_info : Odoc_types.info option ;
103 mutable mt_type : Types.module_type option ; (** [None] = abstract module type *)
104 mt_is_interface : bool ; (** true for modules read from interface files *)
105 mt_file : string ; (** the file the module type is defined in. *)
106 mutable mt_kind : module_type_kind option ; (** [None] = abstract module type if mt_type = None ;
107 Always [None] when the module type was extracted from the implementation file. *)
108 mutable mt_loc : Odoc_types.location ;
109 }
110
111
112 (** {1 Functions} *)
113
114 (** Returns the list of values from a list of module_element. *)
115 let values l =
116 List.fold_left
117 (fun acc -> fun ele ->
118 match ele with
119 Element_value v -> acc @ [v]
120 | _ -> acc
121 )
122 []
123 l
124
125 (** Returns the list of types from a list of module_element. *)
126 let types l =
127 List.fold_left
128 (fun acc -> fun ele ->
129 match ele with
130 Element_type t -> acc @ [t]
131 | _ -> acc
132 )
133 []
134 l
135
136 (** Returns the list of type extensions from a list of module_element. *)
137 let type_extensions l =
138 List.fold_left
139 (fun acc -> fun ele ->
140 match ele with
141 Element_type_extension x -> acc @ [x]
142 | _ -> acc
143 )
144 []
145 l
146
147 (** Returns the list of exceptions from a list of module_element. *)
148 let exceptions l =
149 List.fold_left
150 (fun acc -> fun ele ->
151 match ele with
152 Element_exception e -> acc @ [e]
153 | _ -> acc
154 )
155 []
156 l
157
158 (** Returns the list of classes from a list of module_element. *)
159 let classes l =
160 List.fold_left
161 (fun acc -> fun ele ->
162 match ele with
163 Element_class c -> acc @ [c]
164 | _ -> acc
165 )
166 []
167 l
168
169 (** Returns the list of class types from a list of module_element. *)
170 let class_types l =
171 List.fold_left
172 (fun acc -> fun ele ->
173 match ele with
174 Element_class_type ct -> acc @ [ct]
175 | _ -> acc
176 )
177 []
178 l
179
180 (** Returns the list of modules from a list of module_element. *)
181 let modules l =
182 List.fold_left
183 (fun acc -> fun ele ->
184 match ele with
185 Element_module m -> acc @ [m]
186 | _ -> acc
187 )
188 []
189 l
190
191 (** Returns the list of module types from a list of module_element. *)
192 let mod_types l =
193 List.fold_left
194 (fun acc -> fun ele ->
195 match ele with
196 Element_module_type mt -> acc @ [mt]
197 | _ -> acc
198 )
199 []
200 l
201
202 (** Returns the list of module comment from a list of module_element. *)
203 let comments l =
204 List.fold_left
205 (fun acc -> fun ele ->
206 match ele with
207 Element_module_comment t -> acc @ [t]
208 | _ -> acc
209 )
210 []
211 l
212
213 (** Returns the list of included modules from a list of module_element. *)
214 let included_modules l =
215 List.fold_left
216 (fun acc -> fun ele ->
217 match ele with
218 Element_included_module m -> acc @ [m]
219 | _ -> acc
220 )
221 []
222 l
223
224 (** Returns the list of elements of a module type.
225 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
226 let rec module_type_elements ?(trans=true) mt =
227 let rec iter_kind = function
228 | None -> []
229 | Some (Module_type_struct l) -> l
230 | Some (Module_type_functor (_, k)) -> iter_kind (Some k)
231 | Some (Module_type_with (k, _)) ->
232 if trans then
233 iter_kind (Some k)
234 else
235 []
236 | Some (Module_type_alias mta) ->
237 if trans then
238 match mta.mta_module with
239 None -> []
240 | Some mt -> module_type_elements mt
241 else
242 []
243 | Some (Module_type_typeof _) -> []
244 in
245 iter_kind mt.mt_kind
246
247 (** Returns the list of elements of a module.
248 @param trans indicates if, for aliased modules, we must perform a transitive search.
249 *)
250 let module_elements ?(trans=true) m =
251 (* visited is used to guard against aliases loop
252 (e.g [module rec M:sig end=M] induced loop.
253 *)
254 let rec module_elements visited ?(trans=true) m =
255 let rec iter_kind = function
256 Module_struct l ->
257 print_DEBUG "Odoc_module.module_elements: Module_struct";
258 l
259 | Module_alias ma ->
260 print_DEBUG "Odoc_module.module_elements: Module_alias";
261 if trans then
262 match ma.ma_module with
263 None -> []
264 | Some (Mod m') ->
265 if String.Set.mem m'.m_name visited then
266 []
267 else
268 module_elements (String.Set.add m'.m_name visited) m'
269 | Some (Modtype mt) -> module_type_elements mt
270 else
271 []
272 | Module_functor (_, k)
273 | Module_apply (k, _) ->
274 print_DEBUG "Odoc_module.module_elements: Module_functor ou Module_apply";
275 iter_kind k
276 | Module_with (tk,_) ->
277 print_DEBUG "Odoc_module.module_elements: Module_with";
278 module_type_elements ~trans: trans
279 { mt_name = "" ; mt_info = None ; mt_type = None ;
280 mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
281 mt_loc = Odoc_types.dummy_loc ;
282 }
283 | Module_constraint (k, _tk) ->
284 print_DEBUG "Odoc_module.module_elements: Module_constraint";
285 (* FIXME : use k or tk ? *)
286 module_elements visited ~trans: trans
287 { m_name = "" ;
288 m_info = None ;
289 m_type = Types.Mty_signature [] ;
290 m_is_interface = false ; m_file = "" ; m_kind = k ;
291 m_loc = Odoc_types.dummy_loc ;
292 m_top_deps = [] ;
293 m_code = None ;
294 m_code_intf = None ;
295 m_text_only = false ;
296 }
297 | Module_typeof _ -> []
298 | Module_unpack _ -> []
299 (*
300 module_type_elements ~trans: trans
301 { mt_name = "" ; mt_info = None ; mt_type = None ;
302 mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
303 mt_loc = Odoc_types.dummy_loc }
304 *)
305 in
306 iter_kind m.m_kind in
307 module_elements String.Set.empty ~trans m
308
309 (** Returns the list of values of a module.
310 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
311 let module_values ?(trans=true) m = values (module_elements ~trans m)
312
313 (** Returns the list of functional values of a module.
314 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
315 let module_functions ?(trans=true) m =
316 List.filter
317 (fun v -> Odoc_value.is_function v)
318 (values (module_elements ~trans m))
319
320 (** Returns the list of non-functional values of a module.
321 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
322 let module_simple_values ?(trans=true) m =
323 List.filter
324 (fun v -> not (Odoc_value.is_function v))
325 (values (module_elements ~trans m))
326
327 (** Returns the list of types of a module.
328 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
329 let module_types ?(trans=true) m = types (module_elements ~trans m)
330
331 (** Returns the list of type extensions of a module.
332 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
333 let module_type_extensions ?(trans=true) m = type_extensions (module_elements ~trans m)
334
335 (** Returns the list of exceptions of a module.
336 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
337 let module_exceptions ?(trans=true) m = exceptions (module_elements ~trans m)
338
339 (** Returns the list of classes of a module.
340 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
341 let module_classes ?(trans=true) m = classes (module_elements ~trans m)
342
343 (** Returns the list of class types of a module.
344 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
345 let module_class_types ?(trans=true) m = class_types (module_elements ~trans m)
346
347 (** Returns the list of modules of a module.
348 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
349 let module_modules ?(trans=true) m = modules (module_elements ~trans m)
350
351 (** Returns the list of module types of a module.
352 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
353 let module_module_types ?(trans=true) m = mod_types (module_elements ~trans m)
354
355 (** Returns the list of included module of a module.
356 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
357 let module_included_modules ?(trans=true) m = included_modules (module_elements ~trans m)
358
359 (** Returns the list of comments of a module.
360 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
361 let module_comments ?(trans=true) m = comments (module_elements ~trans m)
362
363 (** Access to the parameters, for a functor type.
364 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
365 let rec module_type_parameters ?(trans=true) mt =
366 let rec iter k =
367 match k with
368 Some (Module_type_functor (p, k2)) ->
369 let param =
370 (* we create the couple (parameter, description opt), using
371 the description of the parameter if we can find it in the comment.*)
372 match mt.mt_info with
373 None -> (p, None)
374 | Some i ->
375 try
376 let d = List.assoc p.mp_name i.Odoc_types.i_params in
377 (p, Some d)
378 with
379 Not_found ->
380 (p, None)
381 in
382 param :: (iter (Some k2))
383 | Some (Module_type_alias mta) ->
384 if trans then
385 match mta.mta_module with
386 None -> []
387 | Some mt2 -> module_type_parameters ~trans mt2
388 else
389 []
390 | Some (Module_type_with (k, _)) ->
391 if trans then
392 iter (Some k)
393 else
394 []
395 | Some (Module_type_struct _) ->
396 []
397 | Some (Module_type_typeof _) -> []
398 | None ->
399 []
400 in
401 iter mt.mt_kind
402
403 (** Access to the parameters, for a functor.
404 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
405 and module_parameters ?(trans=true) m =
406 let rec iter = function
407 Module_functor (p, k) ->
408 let param =
409 (* we create the couple (parameter, description opt), using
410 the description of the parameter if we can find it in the comment.*)
411 match m.m_info with
412 None ->(p, None)
413 | Some i ->
414 try
415 let d = List.assoc p.mp_name i.Odoc_types.i_params in
416 (p, Some d)
417 with
418 Not_found ->
419 (p, None)
420 in
421 param :: (iter k)
422
423 | Module_alias ma ->
424 if trans then
425 match ma.ma_module with
426 None -> []
427 | Some (Mod m) -> module_parameters ~trans m
428 | Some (Modtype mt) -> module_type_parameters ~trans mt
429 else
430 []
431 | Module_constraint (_k, tk) ->
432 module_type_parameters ~trans: trans
433 { mt_name = "" ; mt_info = None ; mt_type = None ;
434 mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
435 mt_loc = Odoc_types.dummy_loc }
436 | Module_struct _
437 | Module_apply _
438 | Module_with _
439 | Module_typeof _
440 | Module_unpack _ -> []
441 in
442 iter m.m_kind
443
444 (** access to all submodules and submodules of submodules ... of the given module.
445 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
446 let rec module_all_submodules ?(trans=true) m =
447 let l = module_modules ~trans m in
448 List.fold_left
449 (fun acc -> fun m -> acc @ (module_all_submodules ~trans m))
450 l
451 l
452
453 (** The module type is a functor if it is defined as a functor or if it is an alias for a functor. *)
454 let rec module_type_is_functor mt =
455 let rec iter k =
456 match k with
457 Some (Module_type_functor _) -> true
458 | Some (Module_type_alias mta) ->
459 (
460 match mta.mta_module with
461 None -> false
462 | Some mtyp -> module_type_is_functor mtyp
463 )
464 | Some (Module_type_with (k, _)) ->
465 iter (Some k)
466 | Some (Module_type_struct _)
467 | Some (Module_type_typeof _)
468 | None -> false
469 in
470 iter mt.mt_kind
471
472 (** The module is a functor if it is defined as a functor or if it is an alias for a functor. *)
473 let module_is_functor m =
474 let rec iter visited = function
475 Module_functor _ -> true
476 | Module_alias ma ->
477 (
478 not (String.Set.mem ma.ma_name visited)
479 &&
480 match ma.ma_module with
481 None -> false
482 | Some (Mod mo) -> iter (String.Set.add ma.ma_name visited) mo.m_kind
483 | Some (Modtype mt) -> module_type_is_functor mt
484 )
485 | Module_constraint (k, _) ->
486 iter visited k
487 | _ -> false
488 in
489 iter String.Set.empty m.m_kind
490
491 (** Returns the list of values of a module type.
492 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
493 let module_type_values ?(trans=true) m = values (module_type_elements ~trans m)
494
495 (** Returns the list of types of a module.
496 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
497 let module_type_types ?(trans=true) m = types (module_type_elements ~trans m)
498
499 (** Returns the list of type extensions of a module.
500 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
501 let module_type_type_extensions ?(trans=true) m = type_extensions (module_type_elements ~trans m)
502
503 (** Returns the list of exceptions of a module.
504 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
505 let module_type_exceptions ?(trans=true) m = exceptions (module_type_elements ~trans m)
506
507 (** Returns the list of classes of a module.
508 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
509 let module_type_classes ?(trans=true) m = classes (module_type_elements ~trans m)
510
511 (** Returns the list of class types of a module.
512 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
513 let module_type_class_types ?(trans=true) m = class_types (module_type_elements ~trans m)
514
515 (** Returns the list of modules of a module.
516 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
517 let module_type_modules ?(trans=true) m = modules (module_type_elements ~trans m)
518
519 (** Returns the list of module types of a module.
520 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
521 let module_type_module_types ?(trans=true) m = mod_types (module_type_elements ~trans m)
522
523 (** Returns the list of included module of a module.
524 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
525 let module_type_included_modules ?(trans=true) m = included_modules (module_type_elements ~trans m)
526
527 (** Returns the list of comments of a module.
528 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
529 let module_type_comments ?(trans=true) m = comments (module_type_elements ~trans m)
530
531 (** Returns the list of functional values of a module type.
532 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
533 let module_type_functions ?(trans=true) mt =
534 List.filter
535 (fun v -> Odoc_value.is_function v)
536 (values (module_type_elements ~trans mt))
537
538 (** Returns the list of non-functional values of a module type.
539 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
540 let module_type_simple_values ?(trans=true) mt =
541 List.filter
542 (fun v -> not (Odoc_value.is_function v))
543 (values (module_type_elements ~trans mt))
544
545 (** {1 Functions for modules and module types} *)
546
547 (** The list of classes defined in this module and all its modules, functors, ....
548 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
549 let rec module_all_classes ?(trans=true) m =
550 List.fold_left
551 (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
552 (
553 List.fold_left
554 (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
555 (module_classes ~trans m)
556 (module_module_types ~trans m)
557 )
558 (module_modules ~trans m)
559
560 (** The list of classes defined in this module type and all its modules, functors, ....
561 @param trans indicates if, for aliased modules, we must perform a transitive search.*)
562 and module_type_all_classes ?(trans=true) mt =
563 List.fold_left
564 (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
565 (
566 List.fold_left
567 (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
568 (module_type_classes ~trans mt)
569 (module_type_module_types ~trans mt)
570 )
571 (module_type_modules ~trans mt)
572