l4/pkg/ocaml/contrib/ocamldoc/odoc_module.ml

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