Source

ocaml / ocamldoc / odoc_module.ml

  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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
(***********************************************************************)
(*                                                                     *)
(*                             OCamldoc                                *)
(*                                                                     *)
(*            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 Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(** Representation and manipulation of modules and module types. *)

let print_DEBUG s = print_string s ; print_newline ()

module Name = Odoc_name

(** To keep the order of elements in a module. *)
type module_element =
    Element_module of t_module
  | Element_module_type of t_module_type
  | Element_included_module of included_module
  | Element_class of Odoc_class.t_class
  | Element_class_type of Odoc_class.t_class_type
  | Element_value of Odoc_value.t_value
  | Element_exception of Odoc_exception.t_exception
  | Element_type of Odoc_type.t_type
  | Element_module_comment of Odoc_types.text

(** Used where we can reference t_module or t_module_type *)
and mmt =
  | Mod of t_module
  | Modtype of t_module_type

and included_module = {
    im_name : Name.t ; (** the name of the included module *)
    mutable im_module : mmt option ; (** the included module or module type *)
    mutable im_info : Odoc_types.info option ; (** comment associated to the includ directive *)
  }

and module_alias = {
    ma_name : Name.t ;
    mutable ma_module : mmt option ; (** the real module or module type if we could associate it *)
  }

and module_parameter = {
    mp_name : string ; (** the name *)
    mp_type : Types.module_type ; (** the type *)
    mp_type_code : string ; (** the original code *)
    mp_kind : module_type_kind ; (** the way the parameter was built *)
  }

(** Different kinds of module. *)
and module_kind =
  | Module_struct of module_element list
  | Module_alias of module_alias (** complete name and corresponding module if we found it *)
  | Module_functor of module_parameter * module_kind
  | Module_apply of module_kind * module_kind
  | Module_with of module_type_kind * string
  | Module_constraint of module_kind * module_type_kind
  | Module_typeof of string (** by now only the code of the module expression *)
  | Module_unpack of string * module_type_alias (** code of the expression and module type alias *)

(** Representation of a module. *)
and t_module = {
    m_name : Name.t ;
    mutable m_type : Types.module_type ;
    mutable m_info : Odoc_types.info option ;
    m_is_interface : bool ; (** true for modules read from interface files *)
    m_file : string ; (** the file the module is defined in. *)
    mutable m_kind : module_kind ;
    mutable m_loc : Odoc_types.location ;
    mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *)
    mutable m_code : string option ; (** The whole code of the module *)
    mutable m_code_intf : string option ; (** The whole code of the interface of the module *)
    m_text_only : bool ; (** [true] if the module comes from a text file *)
  }

and module_type_alias = {
    mta_name : Name.t ;
    mutable mta_module : t_module_type option ; (** the real module type if we could associate it *)
  }

(** Different kinds of module type. *)
and module_type_kind =
  | Module_type_struct of module_element list
  | Module_type_functor of module_parameter * module_type_kind
  | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *)
  | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *)
  | Module_type_typeof of string (** by now only the code of the module expression *)

(** Representation of a module type. *)
and t_module_type = {
    mt_name : Name.t ;
    mutable mt_info : Odoc_types.info option ;
    mutable mt_type : Types.module_type option ; (** [None] = abstract module type *)
    mt_is_interface : bool ; (** true for modules read from interface files *)
    mt_file : string ; (** the file the module type is defined in. *)
    mutable mt_kind : module_type_kind option ; (** [None] = abstract module type if mt_type = None ;
                                           Always [None] when the module type was extracted from the implementation file. *)
    mutable mt_loc : Odoc_types.location ;
  }


(** {2 Functions} *)

(** Returns the list of values from a list of module_element. *)
let values l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_value v -> acc @ [v]
      | _ -> acc
    )
    []
    l

(** Returns the list of types from a list of module_element. *)
let types l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_type t -> acc @ [t]
      | _ -> acc
    )
    []
    l

(** Returns the list of exceptions from a list of module_element. *)
let exceptions l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_exception e -> acc @ [e]
      | _ -> acc
    )
    []
    l

(** Returns the list of classes from a list of module_element. *)
let classes l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_class c -> acc @ [c]
      | _ -> acc
    )
    []
    l

(** Returns the list of class types from a list of module_element. *)
let class_types l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_class_type ct -> acc @ [ct]
      | _ -> acc
    )
    []
    l

(** Returns the list of modules from a list of module_element. *)
let modules l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_module m -> acc @ [m]
      | _ -> acc
    )
    []
    l

(** Returns the list of module types from a list of module_element. *)
let mod_types l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_module_type mt -> acc @ [mt]
      | _ -> acc
    )
    []
    l

(** Returns the list of module comment from a list of module_element. *)
let comments l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_module_comment t -> acc @ [t]
      | _ -> acc
    )
    []
    l

(** Returns the list of included modules from a list of module_element. *)
let included_modules l =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Element_included_module m -> acc @ [m]
      | _ -> acc
    )
    []
    l

(** Returns the list of elements of a module.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let rec module_elements ?(trans=true) m =
  let rec iter_kind = function
      Module_struct l ->
        print_DEBUG "Odoc_module.module_element: Module_struct";
        l
    | Module_alias ma ->
        print_DEBUG "Odoc_module.module_element: Module_alias";
        if trans then
          match ma.ma_module with
            None -> []
          | Some (Mod m) -> module_elements m
          | Some (Modtype mt) -> module_type_elements mt
        else
          []
    | Module_functor (_, k)
    | Module_apply (k, _) ->
        print_DEBUG "Odoc_module.module_element: Module_functor ou Module_apply";
        iter_kind k
    | Module_with (tk,_) ->
        print_DEBUG "Odoc_module.module_element: Module_with";
        module_type_elements ~trans: trans
          { mt_name = "" ; mt_info = None ; mt_type = None ;
            mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
            mt_loc = Odoc_types.dummy_loc ;
          }
    | Module_constraint (k, tk) ->
        print_DEBUG "Odoc_module.module_element: Module_constraint";
      (* A VOIR : utiliser k ou tk ? *)
        module_elements ~trans: trans
          { m_name = "" ;
            m_info = None ;
            m_type = Types.Mty_signature [] ;
            m_is_interface = false ; m_file = "" ; m_kind = k ;
            m_loc = Odoc_types.dummy_loc ;
            m_top_deps = [] ;
            m_code = None ;
            m_code_intf = None ;
            m_text_only = false ;
          }
    | Module_typeof _ -> []
    | Module_unpack _ -> []
(*
   module_type_elements ~trans: trans
   { mt_name = "" ; mt_info = None ; mt_type = None ;
   mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
   mt_loc = Odoc_types.dummy_loc }
*)
  in
  iter_kind m.m_kind

(** Returns the list of elements of a module type.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
and module_type_elements ?(trans=true) mt =
  let rec iter_kind = function
    | None -> []
    | Some (Module_type_struct l) -> l
    | Some (Module_type_functor (_, k)) -> iter_kind (Some k)
    | Some (Module_type_with (k, _)) ->
        if trans then
          iter_kind (Some k)
        else
          []
    | Some (Module_type_alias mta) ->
        if trans then
          match mta.mta_module with
            None -> []
          | Some mt -> module_type_elements mt
        else
          []
  | Some (Module_type_typeof _) -> []
  in
  iter_kind mt.mt_kind

(** Returns the list of values of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_values ?(trans=true) m = values (module_elements ~trans m)

(** Returns the list of functional values of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_functions ?(trans=true) m =
  List.filter
    (fun v -> Odoc_value.is_function v)
    (values (module_elements ~trans m))

(** Returns the list of non-functional values of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_simple_values ?(trans=true) m =
    List.filter
    (fun v -> not (Odoc_value.is_function v))
    (values (module_elements ~trans m))

(** Returns the list of types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_types ?(trans=true) m = types (module_elements ~trans m)

(** Returns the list of excptions of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_exceptions ?(trans=true) m = exceptions (module_elements ~trans m)

(** Returns the list of classes of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_classes ?(trans=true) m = classes (module_elements ~trans m)

(** Returns the list of class types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_class_types ?(trans=true) m = class_types (module_elements ~trans m)

(** Returns the list of modules of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_modules ?(trans=true) m = modules (module_elements ~trans m)

(** Returns the list of module types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_module_types ?(trans=true) m = mod_types (module_elements ~trans m)

(** Returns the list of included module of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_included_modules ?(trans=true) m = included_modules (module_elements ~trans m)

(** Returns the list of comments of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_comments ?(trans=true) m = comments (module_elements ~trans m)

(** Access to the parameters, for a functor type.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let rec module_type_parameters ?(trans=true) mt =
  let rec iter k =
    match k with
      Some (Module_type_functor (p, k2)) ->
        let param =
           (* we create the couple (parameter, description opt), using
              the description of the parameter if we can find it in the comment.*)
          match mt.mt_info with
            None -> (p, None)
          | Some i ->
              try
                let d = List.assoc p.mp_name i.Odoc_types.i_params in
                (p, Some d)
              with
                Not_found ->
                  (p, None)
        in
        param :: (iter (Some k2))
    | Some (Module_type_alias mta) ->
        if trans then
          match mta.mta_module with
            None -> []
          | Some mt2 -> module_type_parameters ~trans mt2
        else
          []
    | Some (Module_type_with (k, _)) ->
        if trans then
          iter (Some k)
        else
          []
    | Some (Module_type_struct _) ->
        []
    | Some (Module_type_typeof _) -> []
      | None ->
        []
  in
  iter mt.mt_kind

(** Access to the parameters, for a functor.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
and module_parameters ?(trans=true) m =
  let rec iter = function
      Module_functor (p, k) ->
        let param =
         (* we create the couple (parameter, description opt), using
            the description of the parameter if we can find it in the comment.*)
          match m.m_info with
            None ->(p, None)
          | Some i ->
              try
                let d = List.assoc p.mp_name i.Odoc_types.i_params in
                (p, Some d)
              with
                Not_found ->
                  (p, None)
        in
        param :: (iter k)

    | Module_alias ma ->
        if trans then
          match ma.ma_module with
            None -> []
          | Some (Mod m) -> module_parameters ~trans m
          | Some (Modtype mt) -> module_type_parameters ~trans mt
        else
          []
    | Module_constraint (k, tk) ->
        module_type_parameters ~trans: trans
          { mt_name = "" ; mt_info = None ; mt_type = None ;
            mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
            mt_loc = Odoc_types.dummy_loc }
    | Module_struct _
    | Module_apply _
    | Module_with _
    | Module_typeof _
    | Module_unpack _ -> []
  in
  iter m.m_kind

(** access to all submodules and sudmobules of submodules ... of the given module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let rec module_all_submodules ?(trans=true) m =
  let l = module_modules ~trans m in
  List.fold_left
    (fun acc -> fun m -> acc @ (module_all_submodules ~trans m))
    l
    l

(** The module type is a functor if is defined as a functor or if it is an alias for a functor. *)
let rec module_type_is_functor mt =
  let rec iter k =
    match k with
      Some (Module_type_functor _) -> true
    | Some (Module_type_alias mta) ->
        (
         match mta.mta_module with
           None -> false
         | Some mtyp -> module_type_is_functor mtyp
        )
    | Some (Module_type_with (k, _)) ->
        iter (Some k)
    | Some (Module_type_struct _)
    | Some (Module_type_typeof _)
    | None -> false
  in
  iter mt.mt_kind

(** The module is a functor if is defined as a functor or if it is an alias for a functor. *)
let module_is_functor m =
  let rec iter = function
      Module_functor _ -> true
    | Module_alias ma ->
        (
         match ma.ma_module with
           None -> false
         | Some (Mod mo) -> iter mo.m_kind
         | Some (Modtype mt) -> module_type_is_functor mt
        )
    | Module_constraint (k, _) ->
        iter k
    | _ -> false
  in
  iter m.m_kind

(** Returns the list of values of a module type.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_values ?(trans=true) m = values (module_type_elements ~trans m)

(** Returns the list of types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_types ?(trans=true) m = types (module_type_elements ~trans m)

(** Returns the list of excptions of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_exceptions ?(trans=true) m = exceptions (module_type_elements ~trans m)

(** Returns the list of classes of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_classes ?(trans=true) m = classes (module_type_elements ~trans m)

(** Returns the list of class types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_class_types ?(trans=true) m = class_types (module_type_elements ~trans m)

(** Returns the list of modules of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_modules ?(trans=true)  m = modules (module_type_elements ~trans m)

(** Returns the list of module types of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_module_types ?(trans=true) m = mod_types (module_type_elements ~trans m)

(** Returns the list of included module of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_included_modules ?(trans=true) m = included_modules (module_type_elements ~trans m)

(** Returns the list of comments of a module.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_comments ?(trans=true) m = comments (module_type_elements ~trans m)

(** Returns the list of functional values of a module type.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_functions ?(trans=true) mt =
  List.filter
    (fun v -> Odoc_value.is_function v)
    (values (module_type_elements ~trans mt))

(** Returns the list of non-functional values of a module type.
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let module_type_simple_values ?(trans=true) mt =
    List.filter
    (fun v -> not (Odoc_value.is_function v))
    (values (module_type_elements ~trans mt))

(** {2 Functions for modules and module types} *)

(** The list of classes defined in this module and all its modules, functors, ....
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
let rec module_all_classes ?(trans=true) m =
  List.fold_left
    (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
    (
       List.fold_left
       (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
       (module_classes ~trans m)
       (module_module_types ~trans m)
    )
    (module_modules ~trans m)

(** The list of classes defined in this module type and all its modules, functors, ....
  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
and module_type_all_classes ?(trans=true) mt =
  List.fold_left
    (fun acc -> fun m -> acc @ (module_all_classes ~trans m))
    (
     List.fold_left
       (fun acc -> fun mtyp -> acc @ (module_type_all_classes ~trans mtyp))
       (module_type_classes ~trans mt)
       (module_type_module_types ~trans mt)
    )
    (module_type_modules ~trans mt)