l4/pkg/ocaml/contrib/ocamldoc/odoc_sig.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_sig.ml 8927 2008-07-23 08:55:36Z guesdon $ *)
  13
  14 (** Analysis of interface files. *)
  15
  16 open Misc
  17 open Asttypes
  18 open Types
  19 open Typedtree
  20 open Path
  21
  22 let print_DEBUG s = print_string s ; print_newline ();;
  23
  24 module Name = Odoc_name
  25 open Odoc_parameter
  26 open Odoc_value
  27 open Odoc_type
  28 open Odoc_exception
  29 open Odoc_class
  30 open Odoc_module
  31 open Odoc_types
  32
  33 module Signature_search =
  34   struct
  35     type ele =
  36       | M of string
  37       | MT of string
  38       | V of string
  39       | T of string
  40       | C of string
  41       | CT of string
  42       | E of string
  43       | ER of string
  44       | P of string
  45
  46     type tab = (ele, Types.signature_item) Hashtbl.t
  47
  48     let add_to_hash table signat =
  49       match signat with
  50         Types.Tsig_value (ident, _) ->
  51           Hashtbl.add table (V (Name.from_ident ident)) signat
  52       | Types.Tsig_exception (ident, _) ->
  53           Hashtbl.add table (E (Name.from_ident ident)) signat
  54       | Types.Tsig_type (ident, _, _) ->
  55           Hashtbl.add table (T (Name.from_ident ident)) signat
  56       | Types.Tsig_class (ident, _, _) ->
  57           Hashtbl.add table (C (Name.from_ident ident)) signat
  58       | Types.Tsig_cltype (ident, _, _) ->
  59           Hashtbl.add table (CT (Name.from_ident ident)) signat
  60       | Types.Tsig_module (ident, _, _) ->
  61           Hashtbl.add table (M (Name.from_ident ident)) signat
  62       | Types.Tsig_modtype (ident,_) ->
  63           Hashtbl.add table (MT (Name.from_ident ident)) signat
  64
  65     let table signat =
  66       let t = Hashtbl.create 13 in
  67       List.iter (add_to_hash t) signat;
  68       t
  69
  70     let search_value table name =
  71       match Hashtbl.find table (V name) with
  72       | (Types.Tsig_value (_, val_desc)) ->  val_desc.Types.val_type
  73       | _ -> assert false
  74
  75     let search_exception table name =
  76       match Hashtbl.find table (E name) with
  77       | (Types.Tsig_exception (_, type_expr_list)) ->
  78           type_expr_list
  79       | _ -> assert false
  80
  81     let search_type table name =
  82       match Hashtbl.find table (T name) with
  83       | (Types.Tsig_type (_, type_decl, _)) -> type_decl
  84       | _ -> assert false
  85
  86     let search_class table name =
  87       match Hashtbl.find table (C name) with
  88       | (Types.Tsig_class (_, class_decl, _)) -> class_decl
  89       | _ -> assert false
  90
  91     let search_class_type table name =
  92       match Hashtbl.find table (CT name) with
  93       | (Types.Tsig_cltype (_, cltype_decl, _)) -> cltype_decl
  94       | _ -> assert false
  95
  96     let search_module table name =
  97       match Hashtbl.find table (M name) with
  98       | (Types.Tsig_module (ident, module_type, _)) -> module_type
  99       | _ -> assert false
 100
 101     let search_module_type table name =
 102       match Hashtbl.find table (MT name) with
 103       | (Types.Tsig_modtype (_, Types.Tmodtype_manifest module_type)) ->
 104           Some module_type
 105       | (Types.Tsig_modtype (_, Types.Tmodtype_abstract)) ->
 106           None
 107       | _ -> assert false
 108
 109     let search_attribute_type name class_sig =
 110       let (_, _, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
 111       type_expr
 112
 113     let search_method_type name class_sig =
 114       let fields = Odoc_misc.get_fields class_sig.Types.cty_self in
 115       List.assoc name fields
 116   end
 117
 118 module type Info_retriever =
 119   sig
 120     val all_special : string -> string -> int * (Odoc_types.info list)
 121     val blank_line_outside_simple : string -> string -> bool
 122     val just_after_special : string -> string -> (int * Odoc_types.info option)
 123     val first_special : string -> string -> (int * Odoc_types.info option)
 124     val get_comments :
 125         (Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
 126   end
 127
 128 module Analyser =
 129   functor (My_ir : Info_retriever) ->
 130   struct
 131     (** This variable is used to load a file as a string and retrieve characters from it.*)
 132     let file = ref ""
 133     (** The name of the analysed file. *)
 134     let file_name = ref ""
 135
 136     (** This function takes two indexes (start and end) and return the string
 137        corresponding to the indexes in the file global variable. The function
 138        prepare_file must have been called to fill the file global variable.*)
 139     let get_string_of_file the_start the_end =
 140       try
 141         let s = String.sub !file the_start (the_end-the_start) in
 142         s
 143       with
 144         Invalid_argument _ ->
 145           ""
 146
 147     (** This function loads the given file in the file global variable,
 148        and sets file_name.*)
 149     let prepare_file f input_f =
 150       try
 151         let s = Odoc_misc.input_file_as_string input_f in
 152         file := s;
 153         file_name := f
 154       with
 155         e ->
 156           file := "";
 157           raise e
 158
 159     (** The function used to get the comments in a class. *)
 160     let get_comments_in_class pos_start pos_end =
 161       My_ir.get_comments (fun t -> Class_comment t)
 162         !file_name
 163         (get_string_of_file pos_start pos_end)
 164
 165     (** The function used to get the comments in a module. *)
 166     let get_comments_in_module pos_start pos_end =
 167       My_ir.get_comments (fun t -> Element_module_comment t)
 168         !file_name
 169         (get_string_of_file pos_start pos_end)
 170
 171     let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options
 172
 173     let name_comment_from_type_kind pos_end pos_limit tk =
 174       match tk with
 175         Parsetree.Ptype_abstract ->
 176           (0, [])
 177       | Parsetree.Ptype_variant cons_core_type_list_list ->
 178           let rec f acc cons_core_type_list_list =
 179             match cons_core_type_list_list with
 180               [] ->
 181                 (0, acc)
 182             | (name, core_type_list, loc) :: [] ->
 183                 let s = get_string_of_file
 184                     loc.Location.loc_end.Lexing.pos_cnum
 185                     pos_limit
 186                 in
 187                 let (len, comment_opt) =  My_ir.just_after_special !file_name s in
 188                 (len, acc @ [ (name, comment_opt) ])
 189             | (name, core_type_list, loc) :: (name2, core_type_list2, loc2)
 190               :: q ->
 191                 let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in
 192                 let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in
 193                 let s = get_string_of_file pos_end_first pos_start_second in
 194                 let (_,comment_opt) = My_ir.just_after_special !file_name  s in
 195                 f (acc @ [name, comment_opt])
 196                   ((name2, core_type_list2, loc2) :: q)
 197           in
 198           f [] cons_core_type_list_list
 199
 200       | Parsetree.Ptype_record name_mutable_type_list (* of (string * mutable_flag * core_type) list*) ->
 201           let rec f = function
 202               [] ->
 203                 []
 204             | (name, _, ct, xxloc) :: [] ->
 205                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
 206                 let s = get_string_of_file pos pos_end in
 207                 let (_,comment_opt) =  My_ir.just_after_special !file_name s in
 208                 [name, comment_opt]
 209             | (name,_,ct,xxloc) :: ((name2,_,ct2,xxloc2) as ele2) :: q ->
 210                 let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
 211                 let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
 212                 let s = get_string_of_file pos pos2 in
 213                 let (_,comment_opt) =  My_ir.just_after_special !file_name s in
 214                 (name, comment_opt) :: (f (ele2 :: q))
 215           in
 216           (0, f name_mutable_type_list)
 217
 218     let get_type_kind env name_comment_list type_kind =
 219       match type_kind with
 220         Types.Type_abstract ->
 221           Odoc_type.Type_abstract
 222
 223       | Types.Type_variant l ->
 224           let f (constructor_name, type_expr_list) =
 225             let comment_opt =
 226               try
 227                 match List.assoc constructor_name name_comment_list with
 228                   None -> None
 229                 | Some d -> d.Odoc_types.i_desc
 230               with Not_found -> None
 231             in
 232             {
 233               vc_name = constructor_name ;
 234               vc_args = List.map (Odoc_env.subst_type env) type_expr_list ;
 235               vc_text = comment_opt
 236             }
 237           in
 238           Odoc_type.Type_variant (List.map f l)
 239
 240       | Types.Type_record (l, _) ->
 241           let f (field_name, mutable_flag, type_expr) =
 242             let comment_opt =
 243               try
 244                 match List.assoc field_name name_comment_list with
 245                   None -> None
 246                 | Some d -> d.Odoc_types.i_desc
 247               with Not_found -> None
 248             in
 249             {
 250               rf_name = field_name ;
 251               rf_mutable = mutable_flag = Mutable ;
 252               rf_type = Odoc_env.subst_type env type_expr ;
 253               rf_text = comment_opt
 254             }
 255           in
 256           Odoc_type.Type_record (List.map f l)
 257
 258     (** Analysis of the elements of a class, from the information in the parsetree and in the class
 259        signature. @return the couple (inherited_class list, elements).*)
 260     let analyse_class_elements env current_class_name last_pos pos_limit
 261         class_type_field_list class_signature =
 262       let get_pos_limit2 q =
 263         match q with
 264           [] -> pos_limit
 265         | ele2 :: _ ->
 266             match ele2 with
 267               Parsetree.Pctf_val (_, _, _, _, loc)
 268             | Parsetree.Pctf_virt (_, _, _, loc)
 269             | Parsetree.Pctf_meth (_, _, _, loc)
 270             | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum
 271             | Parsetree.Pctf_inher class_type ->
 272                 class_type.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum
 273       in
 274       let get_method name comment_opt private_flag loc q =
 275         let complete_name = Name.concat current_class_name name in
 276         let typ =
 277           try Signature_search.search_method_type name class_signature
 278           with Not_found ->
 279             raise (Failure (Odoc_messages.method_type_not_found current_class_name name))
 280         in
 281         let subst_typ = Odoc_env.subst_type env typ in
 282         let met =
 283           {
 284             met_value =
 285             {
 286               val_name = complete_name ;
 287               val_info = comment_opt ;
 288               val_type = subst_typ ;
 289               val_recursive = false ;
 290               val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
 291               val_code = None ;
 292               val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) };
 293             } ;
 294             met_private = private_flag = Asttypes.Private ;
 295             met_virtual = false ;
 296           }
 297         in
 298         let pos_limit2 = get_pos_limit2 q in
 299         let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
 300         let (maybe_more, info_after_opt) =
 301           My_ir.just_after_special
 302             !file_name
 303             (get_string_of_file pos_end pos_limit2)
 304         in
 305         met.met_value.val_info <- merge_infos met.met_value.val_info info_after_opt ;
 306         (* update the parameter description *)
 307         Odoc_value.update_value_parameters_text met.met_value;
 308         (met, maybe_more)
 309       in
 310       let rec f last_pos class_type_field_list =
 311         match class_type_field_list with
 312           [] ->
 313             let s = get_string_of_file last_pos pos_limit in
 314             let (_, ele_coms) = My_ir.all_special !file_name s in
 315             let ele_comments =
 316               List.fold_left
 317                 (fun acc -> fun sc ->
 318                   match sc.Odoc_types.i_desc with
 319                     None ->
 320                       acc
 321                   | Some t ->
 322                       acc @ [Class_comment t])
 323                 []
 324                 ele_coms
 325             in
 326             ([], ele_comments)
 327
 328         | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _, loc) :: q ->
 329             (* of (string * mutable_flag * core_type option * Location.t)*)
 330             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
 331             let complete_name = Name.concat current_class_name name in
 332             let typ =
 333               try Signature_search.search_attribute_type name class_signature
 334               with Not_found ->
 335                 raise (Failure (Odoc_messages.attribute_type_not_found current_class_name name))
 336             in
 337             let subst_typ = Odoc_env.subst_type env typ in
 338             let att =
 339               {
 340                 att_value =
 341                 {
 342                   val_name = complete_name ;
 343                   val_info = comment_opt ;
 344                   val_type = subst_typ;
 345                   val_recursive = false ;
 346                   val_parameters = [] ;
 347                   val_code = None ;
 348                   val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ;
 349                 } ;
 350                 att_mutable = mutable_flag = Asttypes.Mutable ;
 351                 att_virtual = virtual_flag = Asttypes.Virtual ;
 352               }
 353             in
 354             let pos_limit2 = get_pos_limit2 q in
 355             let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
 356             let (maybe_more, info_after_opt) =
 357               My_ir.just_after_special
 358                 !file_name
 359                 (get_string_of_file pos_end pos_limit2)
 360             in
 361             att.att_value.val_info <- merge_infos att.att_value.val_info info_after_opt ;
 362             let (inher_l, eles) = f (pos_end + maybe_more) q in
 363             (inher_l, eles_comments @ ((Class_attribute att) :: eles))
 364
 365         | Parsetree.Pctf_virt (name, private_flag, _, loc) :: q ->
 366             (* of (string * private_flag * core_type * Location.t) *)
 367             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
 368             let (met, maybe_more) = get_method name comment_opt private_flag loc q in
 369             let met2 = { met with met_virtual = true } in
 370             let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
 371             (inher_l, eles_comments @ ((Class_method met2) :: eles))
 372
 373         | Parsetree.Pctf_meth (name, private_flag, _, loc) :: q ->
 374             (* of (string * private_flag * core_type * Location.t) *)
 375             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
 376             let (met, maybe_more) = get_method name comment_opt private_flag loc q in
 377             let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in
 378             (inher_l, eles_comments @ ((Class_method met) :: eles))
 379
 380         | (Parsetree.Pctf_cstr (_, _, loc)) :: q ->
 381             (* of (core_type * core_type * Location.t) *)
 382             (* A VOIR : cela correspond aux contraintes, non ? on ne les garde pas pour l'instant *)
 383             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
 384             let (inher_l, eles) = f loc.Location.loc_end.Lexing.pos_cnum q in
 385             (inher_l, eles_comments @ eles)
 386
 387         | Parsetree.Pctf_inher class_type :: q ->
 388             let loc = class_type.Parsetree.pcty_loc in
 389             let (comment_opt, eles_comments) =
 390               get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum
 391             in
 392             let pos_limit2 = get_pos_limit2 q in
 393             let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
 394             let (maybe_more, info_after_opt) =
 395               My_ir.just_after_special
 396                 !file_name
 397                 (get_string_of_file pos_end pos_limit2)
 398             in
 399             let comment_opt2 = merge_infos comment_opt info_after_opt in
 400             let text_opt = match comment_opt2 with None -> None | Some i -> i.Odoc_types.i_desc in
 401             let inh  =
 402               match class_type.Parsetree.pcty_desc with
 403                 Parsetree.Pcty_constr (longident, _) ->
 404                   (*of Longident.t * core_type list*)
 405                   let name = Name.from_longident longident in
 406                   let ic =
 407                     {
 408                       ic_name = Odoc_env.full_class_or_class_type_name env name ;
 409                       ic_class = None ;
 410                       ic_text = text_opt ;
 411                     }
 412                   in
 413                   ic
 414
 415               | Parsetree.Pcty_signature _
 416               | Parsetree.Pcty_fun _ ->
 417                   (* we don't have a name for the class signature, so we call it "object ... end"  *)
 418                   {
 419                     ic_name = Odoc_messages.object_end ;
 420                     ic_class = None ;
 421                     ic_text = text_opt ;
 422                   }
 423             in
 424             let (inher_l, eles) = f (pos_end + maybe_more) q in
 425             (inh :: inher_l , eles_comments @ eles)
 426       in
 427       f last_pos class_type_field_list
 428
 429     (** Analyse of a .mli parse tree, to get the corresponding elements.
 430        last_pos is the position of the first character which may be used to look for special comments.
 431     *)
 432     let rec analyse_parsetree env signat current_module_name last_pos pos_limit sig_item_list =
 433       let table = Signature_search.table signat in
 434       (* we look for the comment of each item then analyse the item *)
 435       let rec f acc_eles acc_env last_pos = function
 436           [] ->
 437             let s = get_string_of_file last_pos pos_limit in
 438             let (_, ele_coms) = My_ir.all_special !file_name s in
 439             let ele_comments =
 440               List.fold_left
 441                 (fun acc -> fun sc ->
 442                   match sc.Odoc_types.i_desc with
 443                     None ->
 444                       acc
 445                   | Some t ->
 446                       acc @ [Element_module_comment t])
 447                 []
 448                 ele_coms
 449             in
 450             acc_eles @ ele_comments
 451
 452         | ele :: q ->
 453             let (assoc_com, ele_comments) =  get_comments_in_module
 454                 last_pos
 455                 ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
 456             in
 457             let (maybe_more, new_env, elements) = analyse_signature_item_desc
 458                 acc_env
 459                 signat
 460                 table
 461                 current_module_name
 462                 ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
 463                 ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum
 464                 (match q with
 465                   [] -> pos_limit
 466                 | ele2 :: _ -> ele2.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
 467                 )
 468                 assoc_com
 469                 ele.Parsetree.psig_desc
 470             in
 471             f (acc_eles @ (ele_comments @ elements))
 472               new_env
 473               (ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum + maybe_more)
 474                    (* for the comments of constructors in types,
 475                       which are after the constructor definition and can
 476                       go beyond ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum *)
 477               q
 478       in
 479       f [] env last_pos sig_item_list
 480
 481     (** Analyse the given signature_item_desc to create the corresponding module element
 482        (with the given attached comment).*)
 483     and analyse_signature_item_desc env signat table current_module_name
 484         pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
 485         match sig_item_desc with
 486           Parsetree.Psig_value (name_pre, value_desc) ->
 487             let type_expr =
 488               try Signature_search.search_value table name_pre
 489               with Not_found ->
 490                 raise (Failure (Odoc_messages.value_not_found current_module_name name_pre))
 491             in
 492             let name = Name.parens_if_infix name_pre in
 493             let subst_typ = Odoc_env.subst_type env type_expr in
 494             let v =
 495               {
 496                 val_name = Name.concat current_module_name name ;
 497                 val_info = comment_opt ;
 498                 val_type = subst_typ ;
 499                 val_recursive = false ;
 500                 val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
 501                 val_code = None ;
 502                 val_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele)}
 503               }
 504             in
 505             let (maybe_more, info_after_opt) =
 506               My_ir.just_after_special
 507                 !file_name
 508                 (get_string_of_file pos_end_ele pos_limit)
 509             in
 510             v.val_info <- merge_infos v.val_info info_after_opt ;
 511             (* update the parameter description *)
 512             Odoc_value.update_value_parameters_text v;
 513
 514             let new_env = Odoc_env.add_value env v.val_name in
 515             (maybe_more, new_env, [ Element_value v ])
 516
 517         | Parsetree.Psig_exception (name, exception_decl) ->
 518             let types_excep_decl =
 519               try Signature_search.search_exception table name
 520               with Not_found ->
 521                 raise (Failure (Odoc_messages.exception_not_found current_module_name name))
 522             in
 523             let e =
 524               {
 525                 ex_name = Name.concat current_module_name name ;
 526                 ex_info = comment_opt ;
 527                 ex_args = List.map (Odoc_env.subst_type env) types_excep_decl ;
 528                 ex_alias = None ;
 529                 ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 530                 ex_code =
 531                    (
 532                     if !Odoc_args.keep_code then
 533                       Some (get_string_of_file pos_start_ele pos_end_ele)
 534                     else
 535                       None
 536                    ) ;
 537               }
 538             in
 539             let (maybe_more, info_after_opt) =
 540               My_ir.just_after_special
 541                 !file_name
 542                 (get_string_of_file pos_end_ele pos_limit)
 543             in
 544             e.ex_info <- merge_infos e.ex_info info_after_opt ;
 545             let new_env = Odoc_env.add_exception env e.ex_name in
 546             (maybe_more, new_env, [ Element_exception e ])
 547
 548         | Parsetree.Psig_type name_type_decl_list ->
 549             (* we start by extending the environment *)
 550             let new_env =
 551               List.fold_left
 552                 (fun acc_env -> fun (name, _) ->
 553                   let complete_name = Name.concat current_module_name name in
 554                   Odoc_env.add_type acc_env complete_name
 555                 )
 556                 env
 557                 name_type_decl_list
 558             in
 559             let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
 560               match name_type_decl_list with
 561                 [] ->
 562                   (acc_maybe_more, [])
 563               | (name, type_decl) :: q ->
 564                   let (assoc_com, ele_comments) =
 565                     if first then
 566                       (comment_opt, [])
 567                     else
 568                       get_comments_in_module
 569                         last_pos
 570                         type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
 571                   in
 572                   let pos_limit2 =
 573                     match q with
 574                       [] -> pos_limit
 575                     | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
 576                   in
 577                   let (maybe_more, name_comment_list) =
 578                     name_comment_from_type_kind
 579                       type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum
 580                       pos_limit2
 581                       type_decl.Parsetree.ptype_kind
 582                   in
 583                   print_DEBUG ("Type "^name^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
 584                   let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
 585                   List.iter f_DEBUG name_comment_list;
 586                   (* get the information for the type in the signature *)
 587                   let sig_type_decl =
 588                     try Signature_search.search_type table name
 589                     with Not_found ->
 590                       raise (Failure (Odoc_messages.type_not_found current_module_name name))
 591                   in
 592                   (* get the type kind with the associated comments *)
 593                   let type_kind = get_type_kind new_env name_comment_list sig_type_decl.Types.type_kind in
 594                   let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in
 595                   let new_end = type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum + maybe_more in
 596                   (* associate the comments to each constructor and build the [Type.t_type] *)
 597                   let new_type =
 598                     {
 599                       ty_name = Name.concat current_module_name name ;
 600                       ty_info = assoc_com ;
 601                       ty_parameters =
 602                         List.map2 (fun p (co,cn,_) ->
 603                                      (Odoc_env.subst_type new_env p,
 604                                       co, cn)
 605                                   )
 606                         sig_type_decl.Types.type_params
 607                         sig_type_decl.Types.type_variance;
 608                       ty_kind = type_kind;
 609                       ty_private = sig_type_decl.Types.type_private;
 610                       ty_manifest =
 611                       (match sig_type_decl.Types.type_manifest with
 612                         None -> None
 613                       | Some t -> Some (Odoc_env.subst_type new_env t));
 614                       ty_loc =
 615                       { loc_impl = None ;
 616                         loc_inter = Some (!file_name,loc_start) ;
 617                       };
 618                       ty_code =
 619                         (
 620                          if !Odoc_args.keep_code then
 621                            Some (get_string_of_file loc_start new_end)
 622                          else
 623                            None
 624                         ) ;
 625                     }
 626                   in
 627                   let (maybe_more2, info_after_opt) =
 628                     My_ir.just_after_special
 629                       !file_name
 630                       (get_string_of_file new_end pos_limit2)
 631                   in
 632                   new_type.ty_info <- merge_infos new_type.ty_info info_after_opt ;
 633                   let (new_maybe_more, eles) = f
 634                       (maybe_more + maybe_more2)
 635                       (new_end + maybe_more2)
 636                       q
 637                   in
 638                   (new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
 639             in
 640             let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
 641             (maybe_more, new_env, types)
 642
 643         | Parsetree.Psig_open _ -> (* A VOIR *)
 644             let ele_comments = match comment_opt with
 645               None -> []
 646             | Some i ->
 647                 match i.i_desc with
 648                   None -> []
 649                 | Some t -> [Element_module_comment t]
 650             in
 651             (0, env, ele_comments)
 652
 653         | Parsetree.Psig_module (name, module_type) ->
 654             let complete_name = Name.concat current_module_name name in
 655             (* get the the module type in the signature by the module name *)
 656             let sig_module_type =
 657               try Signature_search.search_module table name
 658               with Not_found ->
 659                 raise (Failure (Odoc_messages.module_not_found current_module_name name))
 660             in
 661             let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
 662             let code_intf =
 663               if !Odoc_args.keep_code then
 664                 let loc = module_type.Parsetree.pmty_loc in
 665                 let st = loc.Location.loc_start.Lexing.pos_cnum in
 666                 let en = loc.Location.loc_end.Lexing.pos_cnum in
 667                 Some (get_string_of_file st en)
 668               else
 669                 None
 670             in
 671             let new_module =
 672               {
 673                 m_name = complete_name ;
 674                 m_type = sig_module_type;
 675                 m_info = comment_opt ;
 676                 m_is_interface = true ;
 677                 m_file = !file_name ;
 678                 m_kind = module_kind ;
 679                 m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 680                 m_top_deps = [] ;
 681                 m_code = None ;
 682                 m_code_intf = code_intf ;
 683                 m_text_only = false ;
 684               }
 685             in
 686             let (maybe_more, info_after_opt) =
 687               My_ir.just_after_special
 688                 !file_name
 689                 (get_string_of_file pos_end_ele pos_limit)
 690             in
 691             new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
 692             let new_env = Odoc_env.add_module env new_module.m_name in
 693             let new_env2 =
 694               match new_module.m_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
 695                 Types.Tmty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
 696               | _ -> new_env
 697             in
 698             (maybe_more, new_env2, [ Element_module new_module ])
 699
 700         | Parsetree.Psig_recmodule decls ->
 701             (* we start by extending the environment *)
 702             let new_env =
 703               List.fold_left
 704                 (fun acc_env -> fun (name, _) ->
 705                   let complete_name = Name.concat current_module_name name in
 706                   let e = Odoc_env.add_module acc_env complete_name in
 707                   (* get the information for the module in the signature *)
 708                   let sig_module_type =
 709                     try Signature_search.search_module table name
 710                     with Not_found ->
 711                       raise (Failure (Odoc_messages.module_not_found current_module_name name))
 712                   in
 713                   match sig_module_type with
 714                     (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
 715                     Types.Tmty_signature s ->
 716                       Odoc_env.add_signature e complete_name ~rel: name s
 717                   | _ ->
 718                       print_DEBUG "not a Tmty_signature";
 719                       e
 720                 )
 721                 env
 722                 decls
 723             in
 724             let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list =
 725               match name_mtype_list with
 726                 [] ->
 727                   (acc_maybe_more, [])
 728               | (name, modtype) :: q ->
 729                   let complete_name = Name.concat current_module_name name in
 730                   let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
 731                   let loc_end = modtype.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
 732                   let (assoc_com, ele_comments) =
 733                     if first then
 734                       (comment_opt, [])
 735                     else
 736                       get_comments_in_module
 737                         last_pos
 738                         loc_start
 739                   in
 740                   let pos_limit2 =
 741                     match q with
 742                       [] -> pos_limit
 743                     | (_, mty) :: _ -> mty.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum
 744                   in
 745                   (* get the information for the module in the signature *)
 746                   let sig_module_type =
 747                     try Signature_search.search_module table name
 748                     with Not_found ->
 749                       raise (Failure (Odoc_messages.module_not_found current_module_name name))
 750                   in
 751                   (* associate the comments to each constructor and build the [Type.t_type] *)
 752                   let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in
 753                   let code_intf =
 754                     if !Odoc_args.keep_code then
 755                       let loc = modtype.Parsetree.pmty_loc in
 756                       let st = loc.Location.loc_start.Lexing.pos_cnum in
 757                       let en = loc.Location.loc_end.Lexing.pos_cnum in
 758                       Some (get_string_of_file st en)
 759                     else
 760                       None
 761                   in
 762                   let new_module =
 763                     {
 764                       m_name = complete_name ;
 765                       m_type = sig_module_type;
 766                       m_info = assoc_com ;
 767                       m_is_interface = true ;
 768                       m_file = !file_name ;
 769                       m_kind = module_kind ;
 770                       m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 771                       m_top_deps = [] ;
 772                       m_code = None ;
 773                       m_code_intf = code_intf ;
 774                       m_text_only = false ;
 775                     }
 776                   in
 777                   let (maybe_more, info_after_opt) =
 778                     My_ir.just_after_special
 779                       !file_name
 780                       (get_string_of_file loc_end pos_limit2)
 781                   in
 782                   new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
 783
 784                   let (maybe_more2, eles) = f
 785                       maybe_more
 786                       (loc_end + maybe_more)
 787                       q
 788                   in
 789                   (maybe_more2, (ele_comments @ [Element_module new_module]) @ eles)
 790             in
 791             let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
 792             (maybe_more, new_env, mods)
 793
 794         | Parsetree.Psig_modtype (name, Parsetree.Pmodtype_abstract) ->
 795             let sig_mtype =
 796               try Signature_search.search_module_type table name
 797               with Not_found ->
 798                 raise (Failure (Odoc_messages.module_type_not_found current_module_name name))
 799             in
 800             let complete_name = Name.concat current_module_name name in
 801             let mt =
 802               {
 803                 mt_name = complete_name ;
 804                 mt_info = comment_opt ;
 805                 mt_type = sig_mtype ;
 806                 mt_is_interface = true ;
 807                 mt_file = !file_name ;
 808                 mt_kind = None ;
 809                 mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 810               }
 811             in
 812             let (maybe_more, info_after_opt) =
 813               My_ir.just_after_special
 814                 !file_name
 815                 (get_string_of_file pos_end_ele pos_limit)
 816             in
 817             mt.mt_info <- merge_infos mt.mt_info info_after_opt ;
 818             let new_env = Odoc_env.add_module_type env mt.mt_name in
 819             (maybe_more, new_env, [ Element_module_type mt ])
 820
 821         | Parsetree.Psig_modtype (name, Parsetree.Pmodtype_manifest module_type) ->
 822             let complete_name = Name.concat current_module_name name in
 823             let sig_mtype_opt =
 824               try Signature_search.search_module_type table name
 825               with Not_found ->
 826                 raise (Failure (Odoc_messages.module_type_not_found current_module_name name))
 827             in
 828             let module_type_kind =
 829               match sig_mtype_opt with
 830               | Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
 831               | None -> None
 832             in
 833             let mt =
 834               {
 835                 mt_name = complete_name ;
 836                 mt_info = comment_opt ;
 837                 mt_type = sig_mtype_opt ;
 838                 mt_is_interface = true ;
 839                 mt_file = !file_name ;
 840                 mt_kind = module_type_kind ;
 841                 mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 842               }
 843             in
 844             let (maybe_more, info_after_opt) =
 845               My_ir.just_after_special
 846                 !file_name
 847                 (get_string_of_file pos_end_ele pos_limit)
 848             in
 849             mt.mt_info <- merge_infos mt.mt_info info_after_opt ;
 850             let new_env = Odoc_env.add_module_type env mt.mt_name in
 851             let new_env2 =
 852               match sig_mtype_opt with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
 853                 Some (Types.Tmty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
 854               | _ -> new_env
 855             in
 856             (maybe_more, new_env2, [ Element_module_type mt ])
 857
 858         | Parsetree.Psig_include module_type ->
 859             let rec f = function
 860                 Parsetree.Pmty_ident longident ->
 861                   Name.from_longident longident
 862               | Parsetree.Pmty_signature _ ->
 863                   "??"
 864               | Parsetree.Pmty_functor _ ->
 865                   "??"
 866               | Parsetree.Pmty_with (mt, _) ->
 867                   f mt.Parsetree.pmty_desc
 868             in
 869             let name = (f module_type.Parsetree.pmty_desc) in
 870             let full_name = Odoc_env.full_module_or_module_type_name env name in
 871             let im =
 872               {
 873                 im_name = full_name ;
 874                 im_module = None ;
 875                 im_info = comment_opt;
 876               }
 877             in
 878             (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *)
 879
 880         | Parsetree.Psig_class class_description_list ->
 881             (* we start by extending the environment *)
 882             let new_env =
 883               List.fold_left
 884                 (fun acc_env -> fun class_desc ->
 885                   let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name in
 886                   Odoc_env.add_class acc_env complete_name
 887                 )
 888                 env
 889                 class_description_list
 890             in
 891             let rec f ?(first=false) acc_maybe_more last_pos class_description_list =
 892               match class_description_list with
 893                 [] ->
 894                   (acc_maybe_more, [])
 895               | class_desc :: q ->
 896                   let (assoc_com, ele_comments) =
 897                     if first then
 898                       (comment_opt, [])
 899                     else
 900                       get_comments_in_module
 901                         last_pos
 902                         class_desc.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 903                   in
 904                   let pos_end = class_desc.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
 905                   let pos_limit2 =
 906                     match q with
 907                       [] -> pos_limit
 908                     | cd :: _ -> cd.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 909                   in
 910                   let name = class_desc.Parsetree.pci_name in
 911                   let complete_name = Name.concat current_module_name name in
 912                   let sig_class_decl =
 913                     try Signature_search.search_class table name
 914                     with Not_found ->
 915                       raise (Failure (Odoc_messages.class_not_found current_module_name name))
 916                   in
 917                   let sig_class_type = sig_class_decl.Types.cty_type in
 918                   let (parameters, class_kind) =
 919                     analyse_class_kind
 920                      new_env
 921                      complete_name
 922                      class_desc.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 923                      class_desc.Parsetree.pci_expr
 924                      sig_class_type
 925                  in
 926                  let new_class =
 927                    {
 928                      cl_name = complete_name ;
 929                      cl_info = assoc_com ;
 930                      cl_type = Odoc_env.subst_class_type env sig_class_type ;
 931                      cl_type_parameters = sig_class_decl.Types.cty_params;
 932                      cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ;
 933                      cl_kind = class_kind ;
 934                      cl_parameters = parameters ;
 935                      cl_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
 936                    }
 937                  in
 938                  let (maybe_more, info_after_opt) =
 939                    My_ir.just_after_special
 940                      !file_name
 941                      (get_string_of_file pos_end pos_limit2)
 942                  in
 943                  new_class.cl_info <- merge_infos new_class.cl_info info_after_opt ;
 944                  Odoc_class.class_update_parameters_text new_class ;
 945                  let (new_maybe_more, eles) =
 946                    f maybe_more (pos_end + maybe_more) q
 947                  in
 948                  (new_maybe_more,
 949                   ele_comments @ (( Element_class new_class ) :: eles))
 950             in
 951             let (maybe_more, eles) =
 952               f ~first: true 0 pos_start_ele class_description_list
 953             in
 954             (maybe_more, new_env, eles)
 955
 956         | Parsetree.Psig_class_type class_type_declaration_list ->
 957             (* we start by extending the environment *)
 958             let new_env =
 959               List.fold_left
 960                 (fun acc_env -> fun class_type_decl ->
 961                   let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name in
 962                   Odoc_env.add_class_type acc_env complete_name
 963                 )
 964                 env
 965                 class_type_declaration_list
 966             in
 967             let rec f ?(first=false) acc_maybe_more last_pos class_type_description_list =
 968               match class_type_description_list with
 969                 [] ->
 970                   (acc_maybe_more, [])
 971               | ct_decl :: q ->
 972                   let (assoc_com, ele_comments) =
 973                     if first then
 974                       (comment_opt, [])
 975                     else
 976                       get_comments_in_module
 977                         last_pos
 978                         ct_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 979                   in
 980                   let pos_end = ct_decl.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
 981                   let pos_limit2 =
 982                     match q with
 983                       [] -> pos_limit
 984                     | ct_decl2 :: _ -> ct_decl2.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 985                   in
 986                   let name = ct_decl.Parsetree.pci_name in
 987                   let complete_name = Name.concat current_module_name name in
 988                   let sig_cltype_decl =
 989                     try Signature_search.search_class_type table name
 990                     with Not_found ->
 991                       raise (Failure (Odoc_messages.class_type_not_found current_module_name name))
 992                   in
 993                   let sig_class_type = sig_cltype_decl.Types.clty_type in
 994                   let kind = analyse_class_type_kind
 995                       new_env
 996                       complete_name
 997                       ct_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
 998                       ct_decl.Parsetree.pci_expr
 999                       sig_class_type
1000                   in
1001                   let ct =
1002                     {
1003                       clt_name = complete_name ;
1004                       clt_info = assoc_com ;
1005                       clt_type = Odoc_env.subst_class_type env sig_class_type ;
1006                       clt_type_parameters = sig_cltype_decl.clty_params ;
1007                       clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ;
1008                       clt_kind = kind ;
1009                       clt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
1010                     }
1011                   in
1012                   let (maybe_more, info_after_opt) =
1013                     My_ir.just_after_special
1014                       !file_name
1015                       (get_string_of_file pos_end pos_limit2)
1016                   in
1017                   ct.clt_info <- merge_infos ct.clt_info info_after_opt ;
1018                   let (new_maybe_more, eles) =
1019                     f maybe_more (pos_end + maybe_more) q
1020                   in
1021                  (new_maybe_more,
1022                   ele_comments @ (( Element_class_type ct) :: eles))
1023             in
1024             let (maybe_more, eles) =
1025               f ~first: true 0 pos_start_ele class_type_declaration_list
1026             in
1027             (maybe_more, new_env, eles)
1028
1029     (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
1030     and analyse_module_type_kind env current_module_name module_type sig_module_type =
1031       match module_type.Parsetree.pmty_desc with
1032         Parsetree.Pmty_ident longident ->
1033           let name =
1034             match sig_module_type with
1035               Types.Tmty_ident path -> Name.from_path path
1036             | _ -> Name.from_longident longident
1037               (* A VOIR cela arrive quand on fait module type F : functor ... -> Toto, Toto n'est pas un ident mais une structure *)
1038           in
1039           Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
1040                               mta_module = None }
1041
1042       | Parsetree.Pmty_signature ast ->
1043           (
1044            (* we must have a signature in the module type *)
1045            match sig_module_type with
1046              Types.Tmty_signature signat ->
1047                let pos_start = module_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
1048                let pos_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1049                let elements = analyse_parsetree env signat current_module_name pos_start pos_end ast in
1050                Module_type_struct elements
1051            | _ ->
1052                raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
1053           )
1054
1055       | Parsetree.Pmty_functor (_,pmodule_type2, module_type2) ->
1056           (
1057            let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
1058            let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1059            let mp_type_code = get_string_of_file loc_start loc_end in
1060            print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
1061            match sig_module_type with
1062              Types.Tmty_functor (ident, param_module_type, body_module_type) ->
1063                let mp_kind = analyse_module_type_kind env
1064                    current_module_name pmodule_type2 param_module_type
1065                in
1066                let param =
1067                  {
1068                    mp_name = Name.from_ident ident ;
1069                    mp_type = Odoc_env.subst_module_type env param_module_type ;
1070                    mp_type_code = mp_type_code ;
1071                    mp_kind = mp_kind ;
1072                  }
1073                in
1074                let k = analyse_module_type_kind env
1075                    current_module_name
1076                    module_type2
1077                    body_module_type
1078                in
1079                Module_type_functor (param, k)
1080
1081            | _ ->
1082                (* if we're here something's wrong *)
1083                raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _")
1084           )
1085
1086       | Parsetree.Pmty_with (module_type2, _) ->
1087           (* of module_type * (Longident.t * with_constraint) list *)
1088           (
1089            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1090            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1091            let s = get_string_of_file loc_start loc_end in
1092            let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
1093            Module_type_with (k, s)
1094           )
1095
1096     (** Analyse of a Parsetree.module_type and a Types.module_type.*)
1097     and analyse_module_kind env current_module_name module_type sig_module_type =
1098       match module_type.Parsetree.pmty_desc with
1099         Parsetree.Pmty_ident longident ->
1100           let k = analyse_module_type_kind env current_module_name module_type sig_module_type in
1101           Module_with ( k, "" )
1102
1103       | Parsetree.Pmty_signature signature ->
1104           (
1105            match sig_module_type with
1106              Types.Tmty_signature signat ->
1107                Module_struct
1108                  (analyse_parsetree
1109                     env
1110                     signat
1111                     current_module_name
1112                     module_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum
1113                     module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum
1114                     signature
1115                  )
1116            | _ ->
1117                (* if we're here something's wrong *)
1118                raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
1119           )
1120       | Parsetree.Pmty_functor (_,pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
1121           (
1122            match sig_module_type with
1123              Types.Tmty_functor (ident, param_module_type, body_module_type) ->
1124                let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
1125                let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1126                let mp_type_code = get_string_of_file loc_start loc_end in
1127                print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
1128                let mp_kind = analyse_module_type_kind env
1129                    current_module_name pmodule_type2 param_module_type
1130                in
1131                let param =
1132                  {
1133                    mp_name = Name.from_ident ident ;
1134                    mp_type = Odoc_env.subst_module_type env param_module_type ;
1135                    mp_type_code = mp_type_code ;
1136                    mp_kind = mp_kind ;
1137                  }
1138                in
1139                let k = analyse_module_kind env
1140                    current_module_name
1141                    module_type2
1142                    body_module_type
1143                in
1144                Module_functor (param, k)
1145
1146            | _ ->
1147                (* if we're here something's wrong *)
1148                raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _")
1149           )
1150       | Parsetree.Pmty_with (module_type2, _) ->
1151           (*of module_type * (Longident.t * with_constraint) list*)
1152           (
1153            let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1154            let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
1155            let s = get_string_of_file loc_start loc_end in
1156            let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in
1157            Module_with (k, s)
1158           )
1159
1160     (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple
1161        (class parameters, class_kind).*)
1162     and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type =
1163       match parse_class_type.Parsetree.pcty_desc, sig_class_type with
1164         (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
1165          Types.Tcty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
1166           print_DEBUG "Tcty_constr _";
1167            let path_name = Name.from_path p in
1168            let name = Odoc_env.full_class_or_class_type_name env path_name in
1169            let k =
1170              Class_constr
1171                {
1172                  cco_name = name ;
1173                  cco_class = None ;
1174                  cco_type_parameters = List.map (Odoc_env.subst_type env) typ_list
1175                }
1176            in
1177            ([], k)
1178
1179       | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
1180           (* we get the elements of the class in class_type_field_list *)
1181           let (inher_l, ele) = analyse_class_elements env current_class_name
1182               last_pos
1183               parse_class_type.Parsetree.pcty_loc.Location.loc_end.Lexing.pos_cnum
1184               class_type_field_list
1185               class_signature
1186           in
1187           ([], Class_structure (inher_l, ele))
1188
1189       | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
1190           (* label = string. Dans les signatures, pas de nom de paramètres à l'intérieur des tuples *)
1191           (* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *)
1192           if parse_label = label then
1193             (
1194              let new_param = Simple_name
1195                  {
1196                    sn_name = Btype.label_name label ;
1197                    sn_type = Odoc_env.subst_type env type_expr ;
1198                    sn_text = None ; (* will be updated when the class will be created *)
1199                  }
1200              in
1201              let (l, k) = analyse_class_kind env current_class_name last_pos pclass_type class_type in
1202              ( (new_param :: l), k )
1203             )
1204           else
1205             (
1206              raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents")
1207             )
1208
1209       | _ ->
1210           raise (Failure "analyse_class_kind pas de correspondance dans le match")
1211
1212     (** Analyse of a Parsetree.class_type and a Types.class_type to return a class_type_kind.*)
1213     and analyse_class_type_kind env current_class_name last_pos parse_class_type sig_class_type =
1214       match parse_class_type.Parsetree.pcty_desc, sig_class_type with
1215         (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
1216          Types.Tcty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
1217           print_DEBUG "Tcty_constr _";
1218            let k =
1219              Class_type
1220                {
1221                  cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ;
1222                  cta_class = None ;
1223                  cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list
1224                }
1225            in
1226            k
1227
1228       | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
1229           (* we get the elements of the class in class_type_field_list *)
1230           let (inher_l, ele) = analyse_class_elements env current_class_name
1231               last_pos
1232               parse_class_type.Parsetree.pcty_loc.Location.loc_end.Lexing.pos_cnum
1233               class_type_field_list
1234               class_signature
1235           in
1236           Class_signature (inher_l, ele)
1237
1238       | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
1239           raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Tcty_fun (...)")
1240 (*
1241       | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
1242          Types.Tcty_signature class_signature) ->
1243            (* A VOIR : c'est pour le cas des contraintes de classes :
1244               class type cons = object
1245                 method m : int
1246               end
1247
1248               class ['a] maxou x =
1249                 (object
1250                   val a = (x : 'a)
1251                   method m = a
1252                 end : cons )
1253                     ^^^^^^
1254            *)
1255            let k =
1256              Class_type
1257                {
1258                  cta_name = Odoc_env.full_class_name env (Name.from_longident longident) ;
1259                  cta_class = None ;
1260                  cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list (* ?? *)
1261                }
1262            in
1263            ([], k)
1264 *)
1265       | _ ->
1266           raise (Failure "analyse_class_type_kind pas de correspondance dans le match")
1267
1268     let analyse_signature source_file input_file
1269         (ast : Parsetree.signature) (signat : Types.signature) =
1270       let complete_source_file =
1271         try
1272           let curdir = Sys.getcwd () in
1273           let (dirname, basename) = (Filename.dirname source_file, Filename.basename source_file) in
1274           Sys.chdir dirname ;
1275           let complete = Filename.concat (Sys.getcwd ()) basename in
1276           Sys.chdir curdir ;
1277           complete
1278         with
1279           Sys_error s ->
1280             prerr_endline s ;
1281             incr Odoc_global.errors ;
1282             source_file
1283       in
1284       prepare_file complete_source_file input_file;
1285       (* We create the t_module for this file. *)
1286       let mod_name = String.capitalize
1287           (Filename.basename (try Filename.chop_extension source_file with _ -> source_file))
1288       in
1289       let (len,info_opt) = My_ir.first_special !file_name !file in
1290       let elements =
1291         analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast
1292       in
1293       let code_intf =
1294         if !Odoc_args.keep_code then
1295           Some !file
1296         else
1297           None
1298       in
1299       {
1300         m_name = mod_name ;
1301         m_type = Types.Tmty_signature signat ;
1302         m_info = info_opt ;
1303         m_is_interface = true ;
1304         m_file = !file_name ;
1305         m_kind = Module_struct elements ;
1306         m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ;
1307         m_top_deps = [] ;
1308         m_code = None ;
1309         m_code_intf = code_intf ;
1310         m_text_only = false ;
1311       }
1312
1313     end