odoc_sig.ml

(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
(*                                                                        *)
(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(** Analysis of interface files. *)

open Asttypes
open Types
open Odoc_parameter
open Odoc_value
open Odoc_type
open Odoc_extension
open Odoc_exception
open Odoc_class
open Odoc_module
open Odoc_types

module Signature_search =
  struct
    type ele =
      | M of string
      | MT of string
      | V of string
      | T of string
      | C of string
      | CT of string
      | X of string

    type tab = (ele, Types.signature_item) Hashtbl.t

    let add_to_hash table signat =
      match signat with
        Types.Sig_value (ident, _, _) ->
          Hashtbl.add table (V (Name.from_ident ident)) signat
      | Types.Sig_typext (ident, _, _, _) ->
          Hashtbl.add table (X (Name.from_ident ident)) signat
      | Types.Sig_type (ident, _, _, _) ->
          Hashtbl.add table (T (Name.from_ident ident)) signat
      | Types.Sig_class (ident, _, _, _) ->
          Hashtbl.add table (C (Name.from_ident ident)) signat
      | Types.Sig_class_type (ident, _, _, _) ->
          Hashtbl.add table (CT (Name.from_ident ident)) signat
      | Types.Sig_module (ident, _, _, _, _) ->
          Hashtbl.add table (M (Name.from_ident ident)) signat
      | Types.Sig_modtype (ident,_,_) ->
          Hashtbl.add table (MT (Name.from_ident ident)) signat

    let table signat =
      let t = Hashtbl.create 13 in
      List.iter (add_to_hash t) signat;
      t

    let search_value table name =
      match Hashtbl.find table (V name) with
      | (Types.Sig_value (_, val_desc, _)) ->  val_desc.Types.val_type
      | _ -> assert false

    let search_extension table name =
      match Hashtbl.find table (X name) with
      | (Types.Sig_typext (_, ext, _, _)) -> ext
      | _ -> assert false

    let search_type table name =
      match Hashtbl.find table (T name) with
      | (Types.Sig_type (_, type_decl, _, _)) -> type_decl
      | _ -> assert false

    let search_class table name =
      match Hashtbl.find table (C name) with
      | (Types.Sig_class (_, class_decl, _, _)) -> class_decl
      | _ -> assert false

    let search_class_type table name =
      match Hashtbl.find table (CT name) with
      | (Types.Sig_class_type (_, cltype_decl, _, _)) -> cltype_decl
      | _ -> assert false

    let search_module table name =
      match Hashtbl.find table (M name) with
      | (Types.Sig_module (_ident, _, md, _, _)) -> md.Types.md_type
      | _ -> assert false

    let search_module_type table name =
      match Hashtbl.find table (MT name) with
      | (Types.Sig_modtype (_, {Types.mtd_type = Some module_type}, _)) ->
          Some module_type
      | (Types.Sig_modtype (_, {Types.mtd_type = None}, _)) ->
          None
      | _ -> assert false

    let search_attribute_type name class_sig =
      let (_, _, type_expr) = Types.Vars.find name class_sig.Types.csig_vars in
      type_expr

    let search_method_type name class_sig =
      let (_, _, type_expr) = Types.Meths.find name class_sig.Types.csig_meths in
      type_expr
  end

module type Info_retriever =
  sig
    val all_special : string -> string -> int * (Odoc_types.info list)
    val blank_line_outside_simple : string -> string -> bool
    val just_after_special : string -> string -> (int * Odoc_types.info option)
    val first_special : string -> string -> (int * Odoc_types.info option)
    val get_comments :
        (Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
  end

let alert_of_attribute attr =
  let open Parsetree in
  let load_constant_string = function
    | { pexp_desc = Pexp_constant (Pconst_string (text, _, _)); _ } -> Some text
    | _ -> None
  in
  let load_alert_name name = Longident.last name.Location.txt in
  let deprecated_payload = function
    | PStr [ { pstr_desc = Pstr_eval (s, _); _ } ] -> load_constant_string s
    | _ -> None
  in
  let alert_payload = function
    | PStr [ { pstr_desc = Pstr_eval ({ pexp_desc; _ }, _); _ } ] -> (
        match pexp_desc with
        | Pexp_apply ({ pexp_desc = Pexp_ident name; _ }, [ (_, payload) ]) ->
            Some (load_alert_name name, load_constant_string payload)
        | Pexp_ident name -> Some (load_alert_name name, None)
        | _ -> None)
    | _ -> None
  in
  match attr.attr_name.txt with
  | "deprecated" | "ocaml.deprecated" ->
      Some
        {
          alert_name = "deprecated";
          alert_payload = deprecated_payload attr.attr_payload;
        }
  | "alert" | "ocaml.alert" -> (
      match alert_payload attr.attr_payload with
      | Some (alert_name, alert_payload) -> Some { alert_name; alert_payload }
      | None -> None)
  | _ -> None

let analyze_alerts info attrs =
  (* Remove any deprecated alert if the tag is present. *)
  let unify_deprecated alert (depr_tag, acc) =
    match alert.alert_name with
    | "deprecated" ->
        let depr_tag =
          match (depr_tag, alert.alert_payload) with
          | Some (_ :: _), _ -> depr_tag
          | _, Some text -> Some [ Odoc_types.Raw text ]
          | _, None -> Some []
        in
        (depr_tag, acc)
    | _ -> (depr_tag, alert :: acc)
  in
  match List.filter_map alert_of_attribute attrs with
  | [] -> info
  | _ :: _ as alerts ->
      let info = Option.value ~default:Odoc_types.dummy_info info in
      let i_deprecated, i_alerts =
        List.fold_right unify_deprecated alerts (info.i_deprecated, [])
      in
      Some { info with i_deprecated; i_alerts }

(** Look for signature-item alerts ([\[@@@...\]]) at the beginning of a
    signature. Stop at any other item. These alerts are considered attached to
    the entire signature, similarly to the first comment, which becomes the
    preamble. *)
let analyze_toplevel_alerts info ast =
  let rec extract_attributes = function
    | { Parsetree.psig_desc = Parsetree.Psig_attribute attr; _ } :: tl ->
        attr :: extract_attributes tl
    | _ :: _ | [] -> []
  in
  analyze_alerts info (extract_attributes ast)

module Analyser =
  functor (My_ir : Info_retriever) ->
  struct
    (** This variable is used to load a file as a string and retrieve characters from it.*)
    let file = ref ""

    (** The name of the analysed file. *)
    let file_name = ref ""

    (** This function takes two indexes (start and end) and returns the string
       corresponding to the indexes in the file global variable. The function
       prepare_file must have been called to fill the file global variable.*)
    let get_string_of_file the_start the_end =
      try
        String.sub !file the_start (the_end-the_start)
      with
        Invalid_argument _ ->
          ""

    let just_after_special start stop =
      let s = get_string_of_file start stop in
      My_ir.just_after_special !file_name s

    (** Helper functions for extracting location*)
    module Loc = struct
      let gen proj =
        (fun ct -> (proj ct).Location.loc_start.Lexing.pos_cnum),
        (fun ct -> (proj ct).Location.loc_end.Lexing.pos_cnum)
    let ptyp' ct = ct.Parsetree.ptyp_loc
    let pcd' pcd = pcd.Parsetree.pcd_loc
    let loc' loc = loc
    let psig' p = p.Parsetree.psig_loc

    let start, end_ = gen loc'
    let ptyp_start, ptyp_end = gen ptyp'
    let pcd_start, pcd_end = gen pcd'
    let psig_start, psig_end = gen psig'
    end

    (** This function loads the given file in the file global variable,
       and sets file_name.*)
    let prepare_file f input_f =
      try
        let s = Odoc_misc.input_file_as_string input_f in
        file := s;
        file_name := f
      with
        e ->
          file := "";
          raise e

    (** The function used to get the comments in a class. *)
    let get_comments_in_class pos_start pos_end =
      My_ir.get_comments (fun t -> Class_comment t)
        !file_name
        (get_string_of_file pos_start pos_end)

    (** The function used to get the comments in a module. *)
    let get_comments_in_module pos_start pos_end =
      My_ir.get_comments (fun t -> Element_module_comment t)
        !file_name
        (get_string_of_file pos_start pos_end)

    let preamble filename file proj ast =
      let info = My_ir.first_special filename file in
      (* Only use as module preamble documentation comments that occur before
           any module elements *)
      match ast with
      | a :: _ when  Loc.start (proj a) < fst info -> (0,None)
      | _ -> info

    let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options

    (** Fetch the comment just after an item then merge the info with
        [comment_opt]. If [attrs] is passed, alerts will be read from it. *)
    let get_info ?(attrs = []) comment_opt start stop =
      let maybe_more, info_after_opt = just_after_special start stop in
      let comment_opt = merge_infos comment_opt info_after_opt in
      maybe_more, analyze_alerts comment_opt attrs

    (** Module for extracting documentation comments for record from different
        tree types *)
    module Record = struct

      (** A structure to abstract over the tree type *)
      type ('a,'b,'c) projector = {
        name:'a -> string;
        inline_record: 'b -> 'c option;
        inline_end: 'b -> int;
        start:'a -> int;
        end_: 'a -> int }

    (** A function to extract documentation from a list of label declarations *)
    let doc p pos_end ld =
      let rec f = function
        | [] -> []
        | ld :: [] ->
            let name = p.name ld in
            let pos = p.end_ ld in
            let (_,comment_opt) =  just_after_special pos pos_end in
            [name, comment_opt]
        | ld  :: ele2 :: q ->
            let pos = p.end_ ld in
            let pos2 = p.start ele2 in
            let name = p.name ld in
            let (_,comment_opt) = just_after_special pos pos2 in
            (name, comment_opt) :: (f (ele2 :: q))
      in
      f ld

    let inline_doc p cstr =
      match p.inline_record cstr with
      | None -> []
      | Some r ->
          doc p (p.inline_end cstr) r

    (** The three tree types used in the rest of the source: *)

    let parsetree =
      let open Parsetree in
      { name = (fun ld -> ld.pld_name.txt );
        start = (fun ld -> Loc.ptyp_start ld.pld_type);
        end_ =  (fun ld -> Loc.ptyp_end ld.pld_type);
        inline_record = begin
          fun c -> match c.pcd_args with
            | Pcstr_tuple _ -> None
            | Pcstr_record r -> Some r
        end;
        inline_end = (fun c -> Loc.end_ c.pcd_loc)
      }

    let types =
      let open Types in
      { name = (fun ld -> Ident.name ld.ld_id );
        start = (fun ld -> Loc.start ld.ld_loc);
        end_ =  (fun ld -> Loc.start ld.ld_loc);
        (* Beware, Loc.start is correct in the code above:
           type_expr's do not hold location information, and ld.ld_loc
           ends after the documentation comment, so we use Loc.start as
           the least problematic approximation for end_. *)
        inline_record = begin
          fun c -> match c.cd_args with
            | Cstr_tuple _ -> None
            | Cstr_record r -> Some r
        end;
        inline_end = (fun c -> Loc.end_ c.cd_loc)
      }

    let typedtree =
      let open Typedtree in
      { name = (fun ld -> Ident.name ld.ld_id );
        start = (fun ld -> Loc.start ld.ld_type.ctyp_loc);
        end_ =  (fun ld -> Loc.end_ ld.ld_type.ctyp_loc);
        inline_record = begin
          fun c -> match c.cd_args with
            | Cstr_tuple _ -> None
            | Cstr_record r -> Some r
        end;
        inline_end = (fun c -> Loc.end_ c.cd_loc)
      }


    end

    let name_comment_from_type_decl pos_end pos_limit ty_decl =
      match ty_decl.Parsetree.ptype_kind with
      | Parsetree.Ptype_abstract ->
        let open Parsetree in
        begin match ty_decl.ptype_manifest with
        | None -> (0, [])
        | Some core_ty ->
          begin match core_ty.ptyp_desc with
          | Ptyp_object (fields, _) ->
            let fields = List.map (fun {pof_desc; _} -> pof_desc) fields in
            let rec f = function
              | [] -> []
              | Otag ({txt=""},_) :: _ ->
                (* Fields with no name have been eliminated previously. *)
                assert false
              | Otag ({txt=name}, ct) :: [] ->
                let pos = Loc.ptyp_end ct in
                let (_,comment_opt) = just_after_special pos pos_end in
                [name, comment_opt]
              | Otag ({txt=name}, ct) ::
                  ((Oinherit ct2 | Otag (_, ct2)) as ele2) :: q ->
                let pos = Loc.ptyp_end ct in
                let pos2 = Loc.ptyp_start ct2 in
                let (_,comment_opt) = just_after_special pos pos2 in
                (name, comment_opt) :: (f (ele2 :: q))
              | _ :: q -> f q
            in
            let is_named_field field =
              match field with
              | Otag ({txt=""},_) -> false
              | _ -> true
            in
            (0, f @@ List.filter is_named_field fields)

          | _ -> (0, [])
          end
        end

      | Parsetree.Ptype_variant cons_core_type_list_list ->
          let rec f acc cons_core_type_list_list =
            let open Parsetree in
            match cons_core_type_list_list with
              [] ->
                (0, acc)
            | pcd :: [] ->
                let acc = Record.(inline_doc parsetree) pcd @ acc in
                let (len, comment_opt) =
                  just_after_special (Loc.pcd_end pcd) pos_limit in
                (len, List.rev @@ (pcd.pcd_name.txt, comment_opt):: acc )
            | pcd :: (pcd2 :: _ as q) ->
                let acc = Record.(inline_doc parsetree) pcd @ acc in
                let pos_end_first = Loc.pcd_end pcd in
                let pos_start_second = Loc.pcd_start pcd2 in
                let (_,comment_opt) =
                  just_after_special pos_end_first pos_start_second in
                f ((pcd.pcd_name.txt, comment_opt)::acc) q
          in
          f [] cons_core_type_list_list

      | Parsetree.Ptype_record label_declaration_list ->
          (0, Record.(doc parsetree) pos_end label_declaration_list)
      | Parsetree.Ptype_open ->
          (0, [])


    let manifest_structure env name_comment_list type_expr =
      match get_desc type_expr with
      | Tobject (fields, _) ->
        let f (field_name, _, type_expr) =
          let comment_opt =
            try List.assoc field_name name_comment_list
            with Not_found -> None
          in {
            of_name = field_name ;
            of_type = Odoc_env.subst_type env type_expr ;
            of_text = comment_opt ;
          }
        in
        Object_type (List.map f @@ fst @@ Ctype.flatten_fields fields)
      | _ -> Other (Odoc_env.subst_type env type_expr)

    let get_field env name_comment_list {Types.ld_id=field_name;ld_mutable=mutable_flag;ld_type=type_expr;ld_attributes} =
      let field_name = Ident.name field_name in
      let comment_opt =
        try List.assoc field_name name_comment_list
        with Not_found -> None
      in
      let comment_opt = analyze_alerts comment_opt ld_attributes in
      {
        rf_name = field_name ;
        rf_mutable = Types.is_mutable mutable_flag;
        rf_type = Odoc_env.subst_type env type_expr ;
        rf_text = comment_opt
      }

    let get_type_kind env name_comment_list type_kind =
      match type_kind with
        Types.Type_abstract _ ->
          Odoc_type.Type_abstract
      | Types.Type_variant (l,_) ->
          let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type;cd_attributes} =
            let constructor_name = Ident.name constructor_name in
            let comment_opt =
              try match List.assoc constructor_name name_comment_list with
                | Some { i_desc = None | Some []; _ } -> None
                | x -> x
              with Not_found -> None
            in
            let comment_opt = analyze_alerts comment_opt cd_attributes in
            let vc_args =
              match cd_args with
              | Cstr_tuple l -> Cstr_tuple (List.map (fun {ca_type=ty; _} -> Odoc_env.subst_type env ty) l)
              | Cstr_record l ->
                  Cstr_record (List.map (get_field env name_comment_list) l)
            in
            let vc_name = match constructor_name with
              | "::" ->
                  (* The only infix constructor is always printed (::) *)
                  "(::)"
              | s -> s
            in
            {
              vc_name;
              vc_args;
              vc_ret =  Option.map (Odoc_env.subst_type env) ret_type;
              vc_text = comment_opt
            }
          in
          Odoc_type.Type_variant (List.map f l)

      | Types.Type_record (l, _) ->
          Odoc_type.Type_record (List.map (get_field env name_comment_list) l)

      | Types.Type_open ->
          Odoc_type.Type_open


    let get_cstr_args env pos_end =
      let tuple ct = Odoc_env.subst_type env ct.Typedtree.ctyp_type in
      let record comments
          { Typedtree.ld_id; ld_mutable; ld_type; ld_loc; ld_attributes } =
        get_field env comments @@
        {Types.ld_id; ld_mutable; ld_modalities = Mode.Modality.Value.Const.id;
         ld_jkind=Jkind.Builtin.any ~why:Dummy_jkind (* ignored *);
         ld_type=ld_type.Typedtree.ctyp_type;
         ld_loc; ld_attributes; ld_uid=Types.Uid.internal_not_actually_unique} in
      let open Typedtree in
      function
      | Cstr_tuple l ->
          Odoc_type.Cstr_tuple (List.map (fun {ca_type=ty; _} -> tuple ty) l)
      | Cstr_record l ->
          let comments = Record.(doc typedtree) pos_end l in
          Odoc_type.Cstr_record (List.map (record comments) l)

    (* Given a constraint "with type M.N.t := foo", this function adds "M" ->
       "with type N.t := foo" to acc, ie it build the constraint to put on the
       first element of the path being modified.
       When filter_out_erased_items_from_signature finds "M", it applies the
       constraint on its module type. *)
    let constraint_for_subitem =
      let split_longident p =
        match Longident.flatten p with
        | [] -> assert false
        | hd :: tl -> hd, Longident.unflatten tl
      in
      fun acc s rebuild_constraint ->
        match split_longident s.txt with
        | hd, None -> Name.Map.add hd `Removed acc
        | hd, Some p ->
           let constraint_ = rebuild_constraint { s with txt = p } in
           match Name.Map.find hd acc with
           | exception Not_found ->
              Name.Map.add hd (`Constrained [constraint_]) acc
           | `Constrained old ->
              Name.Map.add hd (`Constrained (constraint_ :: old)) acc
           | `Removed -> acc

    let erased_names_of_constraints constraints acc =
      List.fold_right (fun constraint_ acc ->
        match constraint_ with
        | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ | Parsetree.Pwith_modtype _ -> acc
        | Parsetree.Pwith_typesubst (s, typedecl) ->
           constraint_for_subitem acc s (fun s -> Parsetree.Pwith_typesubst (s, typedecl))
        | Parsetree.Pwith_modsubst (s, modpath) ->
           constraint_for_subitem acc s (fun s -> Parsetree.Pwith_modsubst (s, modpath))
        | Parsetree.Pwith_modtypesubst (s, modpath) ->
            constraint_for_subitem acc s
              (fun s -> Parsetree.Pwith_modtypesubst (s, modpath)))
        constraints acc

    let is_erased ident map =
      match Name.Map.find ident map with
      | exception Not_found -> false
      | `Removed -> true
      | `Constrained _ -> false

    let apply_constraint module_type constraints  =
      match module_type.Parsetree.pmty_desc with
      | Parsetree.Pmty_alias _ -> module_type
      | _ ->
         { Parsetree.
           pmty_desc = Parsetree.Pmty_with (module_type, List.rev constraints);
           pmty_loc = module_type.Parsetree.pmty_loc;
           pmty_attributes = []
         }

    let filter_out_erased_items_from_signature erased signature =
      if Name.Map.is_empty erased then signature
      else List.fold_right (fun sig_item acc ->
        let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in
        match sig_item.Parsetree.psig_desc with
        | Parsetree.Psig_kind_abbrev _ -> Misc.fatal_error "Psig_kind_abbrev"
        | Parsetree.Psig_attribute _
        | Parsetree.Psig_extension _
        | Parsetree.Psig_value _
        | Parsetree.Psig_typext _
        | Parsetree.Psig_exception _
        | Parsetree.Psig_open _
        | Parsetree.Psig_include ({pincl_kind=Structure;_}, _)
        | Parsetree.Psig_class _
        | Parsetree.Psig_class_type _ as tp -> take_item tp
        | Parsetree.Psig_include ({pincl_kind=Functor;_}, _)
        | Parsetree.Psig_typesubst _ -> acc
        | Parsetree.Psig_type (rf, types) ->
          (match List.filter (fun td -> not (is_erased td.Parsetree.ptype_name.txt erased)) types with
          | [] -> acc
          | types -> take_item (Parsetree.Psig_type (rf, types)))
        | Parsetree.Psig_modsubst _ -> acc
        | Parsetree.Psig_module {Parsetree.pmd_name={ txt = None }} -> acc
        | Parsetree.Psig_module ({Parsetree.pmd_name={txt = Some name };
                                             pmd_type=module_type} as r)
          as m ->
           begin match Name.Map.find name erased with
           | exception Not_found -> take_item m
           | `Removed -> acc
           | `Constrained constraints ->
              take_item
                (Parsetree.Psig_module
                   { r with
                     Parsetree.pmd_type =
                       apply_constraint module_type constraints })
           end
        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
          if is_erased name.txt erased then acc else take_item m
        | Parsetree.Psig_modtypesubst _  -> acc
        | Parsetree.Psig_recmodule mods ->
          (match List.filter
                   (fun pmd ->
                      match pmd.Parsetree.pmd_name.txt with
                      | None -> false
                      | Some name -> not (is_erased name erased))
                   mods
           with
           | [] -> acc
           | mods -> take_item (Parsetree.Psig_recmodule mods)))
        signature []

    (** Analysis of the elements of a class, from the information in the parsetree and in the class
       signature. @return the couple (inherited_class list, elements).*)
    let analyse_class_elements env current_class_name last_pos pos_limit
        class_type_field_list class_signature =
      let get_pos_limit2 q =
        match q with
          [] -> pos_limit
          | ele2 :: _ ->
              let loc = ele2.Parsetree.pctf_loc in
            match ele2.Parsetree.pctf_desc with
              Parsetree.Pctf_val (_, _, _, _)
            | Parsetree.Pctf_method (_, _, _, _)
            | Parsetree.Pctf_constraint (_, _)
            | Parsetree.Pctf_attribute _ -> Loc.start loc
            | Parsetree.Pctf_inherit class_type ->
                Loc.start class_type.Parsetree.pcty_loc
            | Parsetree.Pctf_extension _ -> assert false
      in
      let get_method name comment_opt private_flag loc q =
        let complete_name = Name.concat current_class_name name in
        let typ =
          try Signature_search.search_method_type name class_signature
          with Not_found ->
            raise (Failure (Odoc_messages.method_type_not_found current_class_name name))
        in
        let subst_typ = Odoc_env.subst_type env typ in
        let met =
          {
            met_value =
            {
              val_name = complete_name ;
              val_info = comment_opt ;
              val_type = subst_typ ;
              val_recursive = false ;
              val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
              val_code = None ;
              val_loc = { loc_impl = None ; loc_inter = Some loc };
            } ;
            met_private = private_flag = Asttypes.Private ;
            met_virtual = false ;
          }
        in
        let pos_limit2 = get_pos_limit2 q in
        let pos_end = Loc.end_ loc in
        let (maybe_more, info_after_opt) =
          My_ir.just_after_special
            !file_name
            (get_string_of_file pos_end pos_limit2)
        in
        met.met_value.val_info <- merge_infos met.met_value.val_info info_after_opt ;
        (* update the parameter description *)
        Odoc_value.update_value_parameters_text met.met_value;
        (met, maybe_more)
      in
      let rec f last_pos class_type_field_list =
        match class_type_field_list with
          [] ->
            let s = get_string_of_file last_pos pos_limit in
            let (_, ele_coms) = My_ir.all_special !file_name s in
            let ele_comments =
              List.fold_left
                (fun acc -> fun sc ->
                  match sc.Odoc_types.i_desc with
                    None ->
                      acc
                  | Some t ->
                      acc @ [Class_comment t])
                []
                ele_coms
            in
            ([], ele_comments)

          | item :: q ->
              let loc = item.Parsetree.pctf_loc in
              match item.Parsetree.pctf_desc with

        | Parsetree.Pctf_val ({txt=name}, mutable_flag, virtual_flag, _) ->
            (* of (string * mutable_flag * core_type option * Location.t)*)
            let (comment_opt, eles_comments) = get_comments_in_class last_pos
                (Loc.start loc) in
            let complete_name = Name.concat current_class_name name in
            let typ =
              try Signature_search.search_attribute_type name class_signature
              with Not_found ->
                raise (Failure (Odoc_messages.attribute_type_not_found current_class_name name))
            in
            let subst_typ = Odoc_env.subst_type env typ in
            let att =
              {
                att_value =
                {
                  val_name = complete_name ;
                  val_info = comment_opt ;
                  val_type = subst_typ;
                  val_recursive = false ;
                  val_parameters = [] ;
                  val_code = None ;
                  val_loc = { loc_impl = None ; loc_inter = Some loc} ;
                } ;
                att_mutable = mutable_flag = Asttypes.Mutable ;
                att_virtual = virtual_flag = Asttypes.Virtual ;
              }
            in
            let pos_limit2 = get_pos_limit2 q in
            let pos_end = Loc.end_ loc in
            let (maybe_more, info_after_opt) =
              My_ir.just_after_special
                !file_name
                (get_string_of_file pos_end pos_limit2)
            in
            att.att_value.val_info <- merge_infos att.att_value.val_info info_after_opt ;
            let (inher_l, eles) = f (pos_end + maybe_more) q in
            (inher_l, eles_comments @ ((Class_attribute att) :: eles))

        | Parsetree.Pctf_method ({txt=name}, private_flag, virtual_flag, _) ->
            (* of (string * private_flag * virtual_flag * core_type) *)
            let (comment_opt, eles_comments) =
              get_comments_in_class last_pos (Loc.start  loc) in
            let (met, maybe_more) = get_method name comment_opt private_flag loc q in
            let met2 =
              match virtual_flag with
              | Concrete -> met
              | Virtual -> { met with met_virtual = true }
            in
            let (inher_l, eles) = f (Loc.end_ loc + maybe_more) q in
            (inher_l, eles_comments @ ((Class_method met2) :: eles))

        | (Parsetree.Pctf_constraint (_, _)) ->
            (* of (core_type * core_type) *)
            (* FIXME: this corresponds to constraints, isn't it? We don't keep them for now *)
            let (_comment_opt, eles_comments) = get_comments_in_class last_pos
                (Loc.start loc) in
            let (inher_l, eles) = f (Loc.end_ loc) q in
            (inher_l, eles_comments @ eles)

        | Parsetree.Pctf_inherit class_type ->
            let loc = class_type.Parsetree.pcty_loc in
            let (comment_opt, eles_comments) =
              get_comments_in_class last_pos (Loc.start loc) in
            let pos_limit2 = get_pos_limit2 q in
            let pos_end = Loc.end_ loc in
            let (maybe_more, info_after_opt) =
             just_after_special pos_end pos_limit2
            in
            let comment_opt2 = merge_infos comment_opt info_after_opt in
            let text_opt = match comment_opt2 with None -> None | Some i -> i.Odoc_types.i_desc in
            let inh  =
              match class_type.Parsetree.pcty_desc with
                Parsetree.Pcty_constr (longident, _) ->
                  (*of Longident.t * core_type list*)
                  let name = Name.from_longident longident.txt in
                  {
                    ic_name = Odoc_env.full_class_or_class_type_name env name ;
                    ic_class = None ;
                    ic_text = text_opt ;
                  }

              | Parsetree.Pcty_open _ (* one could also traverse the open *)
              | Parsetree.Pcty_signature _
              | Parsetree.Pcty_arrow _ ->
                    (* we don't have a name for the class signature, so we call it "object ... end"  *)
                  {
                    ic_name = Odoc_messages.object_end ;
                    ic_class = None ;
                    ic_text = text_opt ;
                  }
              | Parsetree.Pcty_extension _ -> assert false
            in
            let (inher_l, eles) = f (pos_end + maybe_more) q in
            (inh :: inher_l , eles_comments @ eles)
        | Parsetree.Pctf_attribute _ ->
            let (_comment_opt, eles_comments) =
              get_comments_in_class last_pos (Loc.start loc) in
            let (inher_l, eles) = f (Loc.end_ loc) q in
            (inher_l, eles_comments @ eles)

        | Parsetree.Pctf_extension _ -> assert false
      in
      f last_pos class_type_field_list

    (** Analyse of a .mli parse tree, to get the corresponding elements.
       last_pos is the position of the first character which may be used to look for special comments.
    *)
    let rec analyse_parsetree env signat current_module_name last_pos pos_limit sig_item_list =
      let table = Signature_search.table signat in
      (* we look for the comment of each item then analyse the item *)
      let rec f acc_eles acc_env last_pos = function
          [] ->
            let s = get_string_of_file last_pos pos_limit in
            let (_, ele_coms) = My_ir.all_special !file_name s in
            let ele_comments =
              List.fold_left
                (fun acc -> fun sc ->
                  match sc.Odoc_types.i_desc with
                    None ->
                      acc
                  | Some t ->
                      acc @ [Element_module_comment t])
                []
                ele_coms
            in
            acc_eles @ ele_comments

        | ele :: q ->
            let (assoc_com, ele_comments) =
              get_comments_in_module last_pos (Loc.psig_start ele)
            in
            let (maybe_more, new_env, elements) = analyse_signature_item
                acc_env
                signat
                table
                current_module_name
                ele.Parsetree.psig_loc
                (Loc.psig_start ele)
                (Loc.psig_end ele)
                (match q with
                  [] -> pos_limit
                | ele2 :: _ -> Loc.psig_start ele2
                )
                assoc_com
                ele
            in
            let new_pos = Loc.psig_end ele + maybe_more
              (* for the comments of constructors in types,
                 which are after the constructor definition and can
                 go beyond ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum *)
            in
            f (acc_eles @ (ele_comments @ elements))
              new_env
              new_pos
              q
      in
      f [] env last_pos sig_item_list

    and analyse_signature_item_desc_include ~env ~comment_opt incl =
      let rec f = function
          Parsetree.Pmty_ident longident ->
            Name.from_longident longident.txt
        | Parsetree.Pmty_alias longident ->
            Name.from_longident longident.txt
        | Parsetree.Pmty_signature _ ->
            "??"
        | Parsetree.Pmty_functor _ ->
            "??"
        | Parsetree.Pmty_with (mt, _) ->
            f mt.Parsetree.pmty_desc
        | Parsetree.Pmty_typeof mexpr ->
            let open Parsetree in
            begin match mexpr.pmod_desc with
              Pmod_ident longident -> Name.from_longident longident.txt
            | Pmod_structure [
                {pstr_desc=Pstr_include
                     {pincl_mod={pmod_desc=Pmod_ident longident};
                      pincl_kind=Structure}
                }] -> (* include module type of struct include M end*)
                Name.from_longident longident.txt
            | _ -> "??"
            end
        | Parsetree.Pmty_extension _ -> assert false
        | Parsetree.Pmty_strengthen _ -> failwith "strengthen not implemented yet"
      in
      let name = f incl.Parsetree.pincl_mod.Parsetree.pmty_desc in
      let full_name = Odoc_env.full_module_or_module_type_name env name in
      let im =
        {
          im_name = full_name ;
          im_module = None ;
          im_info = comment_opt;
        }
      in
      (0, env, [ Element_included_module im ]) (* FIXME : extend the environment? How? *)

    (** Analyse the given signature_item_desc to create the corresponding module element
       (with the given attached comment).*)
    and analyse_signature_item_desc env _signat table current_module_name
        sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
        match sig_item_desc with
        | Parsetree.Psig_kind_abbrev _ -> Misc.fatal_error "Psig_kind_abbrev"
        | Parsetree.Psig_value value_desc ->
            let name_pre = value_desc.Parsetree.pval_name in
            let type_expr =
              try Signature_search.search_value table name_pre.txt
              with Not_found ->
                raise (Failure (Odoc_messages.value_not_found current_module_name name_pre.txt))
            in
            let name = Name.parens_if_infix name_pre.txt in
            let subst_typ = Odoc_env.subst_type env type_expr in
            let (maybe_more, comment_opt) =
              get_info ~attrs:value_desc.Parsetree.pval_attributes comment_opt
                pos_end_ele pos_limit
            in
            let v =
              {
                val_name = Name.concat current_module_name name ;
                val_info = comment_opt ;
                val_type = subst_typ ;
                val_recursive = false ;
                val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
                val_code = None ;
                val_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
              }
            in
            (* update the parameter description *)
            Odoc_value.update_value_parameters_text v;

            let new_env = Odoc_env.add_value env v.val_name in
            (maybe_more, new_env, [ Element_value v ])

        | Parsetree.Psig_typext tyext ->
          let new_env, types_ext_list, last_ext =
            List.fold_left
              (fun (env_acc, exts_acc, _) ->
               fun {Parsetree.pext_name = { txt = name }; pext_attributes; _} ->
                let complete_name = Name.concat current_module_name name in
                let env_acc = Odoc_env.add_extension env_acc complete_name in
                let types_ext =
                  try Signature_search.search_extension table name
                  with Not_found ->
                    raise (Failure (Odoc_messages.extension_not_found current_module_name name))
                in
                  env_acc, ((name, pext_attributes, types_ext) :: exts_acc), Some types_ext
              )
              (env, [], None)
              tyext.Parsetree.ptyext_constructors
          in
          let types_ext_list = List.rev types_ext_list in
          let ty_path, ty_params, priv =
            match last_ext with
              None -> assert false
            | Some ext -> ext.ext_type_path, ext.ext_type_params, ext.ext_private
          in
          let new_te =
            {
              te_info = None;
              te_type_name =
                Odoc_env.full_type_name new_env (Name.from_path ty_path);
              te_type_parameters =
                List.map (Odoc_env.subst_type new_env) ty_params;
              te_private = priv;
              te_constructors = [];
              te_loc = { loc_impl = None ; loc_inter = Some sig_item_loc} ;
              te_code =
                (
                  if !Odoc_global.keep_code then
                    Some (get_string_of_file pos_start_ele pos_end_ele)
                  else
                    None
                ) ;
            }
          in
          let rec analyse_extension_constructors maybe_more exts_acc types_ext_list =
            match types_ext_list with
              [] -> (maybe_more, List.rev exts_acc)
            | (name, attrs, types_ext) :: q ->
              let ext_loc_end =  Loc.end_ types_ext.Types.ext_loc in
              let xt_args =
                match types_ext.ext_args with
                | Cstr_tuple l ->
                    Cstr_tuple (List.map (fun {ca_type=ty; _} -> Odoc_env.subst_type new_env ty) l)
                | Cstr_record l ->
                    let docs = Record.(doc types ext_loc_end) l in
                    Cstr_record (List.map (get_field new_env docs) l)
              in
              let (maybe_more, comment_opt) =
                let pos_limit2 =
                  match q with
                    [] -> pos_limit
                  | (_, _, next) :: _ -> Loc.start (next.Types.ext_loc)
                in
                get_info ~attrs None ext_loc_end pos_limit2
              in
              let new_x =
                {
                  xt_name = Name.concat current_module_name name ;
                  xt_args;
                  xt_ret = Option.map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ;
                  xt_type_extension = new_te;
                  xt_alias = None ;
                  xt_loc = { loc_impl = None ; loc_inter = Some types_ext.Types.ext_loc} ;
                  xt_text = comment_opt;
                }
              in
              analyse_extension_constructors maybe_more (new_x :: exts_acc) q
          in
          let (maybe_more, exts) = analyse_extension_constructors 0 [] types_ext_list in
          new_te.te_constructors <- exts;
          let (maybe_more2, comment_opt) =
            get_info ~attrs:tyext.Parsetree.ptyext_attributes comment_opt
              (pos_end_ele + maybe_more) pos_limit
          in
          new_te.te_info <- comment_opt;
          (maybe_more + maybe_more2, new_env, [ Element_type_extension new_te ])

        | Parsetree.Psig_exception {Parsetree.ptyexn_constructor;ptyexn_attributes;_} ->
            let {Parsetree.pext_name;pext_attributes;_} = ptyexn_constructor in
            let name = pext_name.txt in
            let types_ext =
              try Signature_search.search_extension table name
              with Not_found ->
                raise (Failure (Odoc_messages.exception_not_found current_module_name name))
            in
            let ex_args =
              let pos_end = Loc.end_ types_ext.ext_loc in
              match types_ext.ext_args with
              | Cstr_tuple l -> Cstr_tuple (List.map (fun {ca_type=ty; _} -> Odoc_env.subst_type env ty) l)
              | Cstr_record l ->
                  let docs = Record.(doc types) pos_end l in
                  Cstr_record (List.map (get_field env docs) l)
            in
            let (maybe_more, comment_opt) =
              get_info ~attrs:(ptyexn_attributes @ pext_attributes) comment_opt
                pos_end_ele pos_limit
            in
            let e =
              {
                ex_name = Name.concat current_module_name name ;
                ex_info = comment_opt ;
                ex_args;
                ex_ret = Option.map (Odoc_env.subst_type env) types_ext.ext_ret_type ;
                ex_alias = None ;
                ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
                ex_code =
                   (
                    if !Odoc_global.keep_code then
                      Some (get_string_of_file pos_start_ele pos_end_ele)
                    else
                      None
                   ) ;
              }
            in
            let new_env = Odoc_env.add_extension env e.ex_name in
            (maybe_more, new_env, [ Element_exception e ])

        | Parsetree.Psig_type (rf, name_type_decl_list) ->
            let extended_env =
              List.fold_left
                (fun acc_env td ->
                  let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
                  Odoc_env.add_type acc_env complete_name
                )
                env
                name_type_decl_list
            in
            let env =
              match rf with
              | Recursive -> extended_env
              | Nonrecursive -> env
            in
            let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
              match name_type_decl_list with
                [] ->
                  (acc_maybe_more, [])
              | type_decl :: q ->
                  let name = type_decl.Parsetree.ptype_name in
                  let (assoc_com, ele_comments) =
                    if first then
                      (comment_opt, [])
                    else
                      get_comments_in_module
                        last_pos
                        (Loc.start type_decl.Parsetree.ptype_loc)
                  in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | td :: _ -> Loc.start (td.Parsetree.ptype_loc)
                  in
                  let (maybe_more, name_comment_list) =
                    name_comment_from_type_decl
                      (Loc.end_ type_decl.Parsetree.ptype_loc)
                      pos_limit2
                      type_decl
                  in
                  (* get the information for the type in the signature *)
                  let sig_type_decl =
                    try Signature_search.search_type table name.txt
                    with Not_found ->
                      raise (Failure (Odoc_messages.type_not_found current_module_name name.txt))
                  in
                  (* get the type kind with the associated comments *)
                  let type_kind = get_type_kind env name_comment_list sig_type_decl.Types.type_kind in
                  let loc_start = Loc.start type_decl.Parsetree.ptype_loc in
                  let new_end = Loc.end_ type_decl.Parsetree.ptype_loc
                                + maybe_more in
                  (* get the comment associated to the whole type *)
                  let (maybe_more2, assoc_com) =
                    get_info ~attrs:type_decl.Parsetree.ptype_attributes
                      assoc_com new_end pos_limit2
                  in
                  (* associate the comments to each constructor and build the [Type.t_type] *)
                  let new_type =
                    {
                      ty_name = Name.concat current_module_name name.txt ;
                      ty_info = assoc_com ;
                      ty_parameters =
                        List.map2 (fun p v -> Odoc_env.subst_type env p,v)
                        sig_type_decl.Types.type_params
                        sig_type_decl.Types.type_variance;
                      ty_kind = type_kind;
                      ty_private = sig_type_decl.Types.type_private;
                      ty_manifest =
                        begin match sig_type_decl.Types.type_manifest with
                        | None   -> None
                        | Some t ->
                          Some (manifest_structure env name_comment_list t)
                        end ;
                      ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
                      ty_code =
                        (
                         if !Odoc_global.keep_code then
                           Some (get_string_of_file loc_start new_end)
                         else
                           None
                        ) ;
                    }
                  in
                  let (new_maybe_more, eles) = f
                      (maybe_more + maybe_more2)
                      (new_end + maybe_more2)
                      q
                  in
                  (new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
            in
            let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
            (maybe_more, extended_env, types)

        | Parsetree.Psig_typesubst (name_type_decl_list) (* FIXME *) ->
            let extended_env =
              List.fold_left
                (fun acc_env td ->
                  let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
                  Odoc_env.add_type acc_env complete_name
                )
                env
                name_type_decl_list
            in
            let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
              match name_type_decl_list with
                [] ->
                  (acc_maybe_more, [])
              | type_decl :: q ->
                  let name = type_decl.Parsetree.ptype_name in
                  let (assoc_com, ele_comments) =
                    if first then
                      (comment_opt, [])
                    else
                      get_comments_in_module
                        last_pos
                        (Loc.start type_decl.Parsetree.ptype_loc)
                  in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | td :: _ -> Loc.start (td.Parsetree.ptype_loc)
                  in
                  let (maybe_more, name_comment_list) =
                    name_comment_from_type_decl
                      (Loc.end_ type_decl.Parsetree.ptype_loc)
                      pos_limit2
                      type_decl
                  in
                  (* get the information for the type in the signature *)
                  let sig_type_decl =
                    try Signature_search.search_type table name.txt
                    with Not_found ->
                      raise (Failure (Odoc_messages.type_not_found current_module_name name.txt))
                  in
                  (* get the type kind with the associated comments *)
                  let type_kind = get_type_kind env name_comment_list sig_type_decl.Types.type_kind in
                  let loc_start = Loc.start type_decl.Parsetree.ptype_loc in
                  let new_end = Loc.end_ type_decl.Parsetree.ptype_loc
                                + maybe_more in
                  (* associate the comments to each constructor and build the [Type.t_type] *)
                  let new_type =
                    {
                      ty_name = Name.concat current_module_name name.txt ;
                      ty_info = assoc_com ;
                      ty_parameters =
                        List.map2 (fun p v -> Odoc_env.subst_type env p,v)
                        sig_type_decl.Types.type_params
                        sig_type_decl.Types.type_variance;
                      ty_kind = type_kind;
                      ty_private = sig_type_decl.Types.type_private;
                      ty_manifest =
                        begin match sig_type_decl.Types.type_manifest with
                        | None   -> None
                        | Some t ->
                          Some (manifest_structure env name_comment_list t)
                        end ;
                      ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
                      ty_code =
                        (
                         if !Odoc_global.keep_code then
                           Some (get_string_of_file loc_start new_end)
                         else
                           None
                        ) ;
                    }
                  in
                  let (maybe_more2, info_after_opt) =
                    My_ir.just_after_special
                      !file_name
                      (get_string_of_file new_end pos_limit2)
                  in
                  new_type.ty_info <- merge_infos new_type.ty_info info_after_opt ;
                  let (new_maybe_more, eles) = f
                      (maybe_more + maybe_more2)
                      (new_end + maybe_more2)
                      q
                  in
                  (new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
            in
            let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
            (maybe_more, extended_env, types)

        | Parsetree.Psig_open _ -> (* FIXME *)
            let ele_comments = match comment_opt with
              None -> []
            | Some i ->
                match i.i_desc with
                  None -> []
                | Some t -> [Element_module_comment t]
            in
            (0, env, ele_comments)

        | Parsetree.Psig_modsubst _ -> (* FIXME *)
            (0, env, [])

        | Parsetree.Psig_module {Parsetree.pmd_name={txt=None}} ->
            (0, env, [])

        | Parsetree.Psig_module {Parsetree.pmd_name={txt=Some name};
                                 pmd_type=module_type; pmd_attributes} ->
            let complete_name = Name.concat current_module_name name in
            (* get the module type in the signature by the module name *)
            let sig_module_type =
              try Signature_search.search_module table name
              with Not_found ->
                raise (Failure (Odoc_messages.module_not_found current_module_name name))
            in
            let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
            let code_intf =
              if !Odoc_global.keep_code then
                let loc = module_type.Parsetree.pmty_loc in
                let st = Loc.start loc in
                let en = Loc.end_ loc in
                Some (get_string_of_file st en)
              else
                None
            in
            let (maybe_more, comment_opt) =
              get_info ~attrs:pmd_attributes comment_opt pos_end_ele pos_limit
            in
            let new_module =
              {
                m_name = complete_name ;
                m_type = sig_module_type;
                m_info = comment_opt ;
                m_is_interface = true ;
                m_file = !file_name ;
                m_kind = module_kind ;
                m_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
                m_top_deps = [] ;
                m_code = None ;
                m_code_intf = code_intf ;
                m_text_only = false ;
              }
            in
            let new_env = Odoc_env.add_module env new_module.m_name in
            let new_env2 =
              match new_module.m_type with (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
                Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
              | _ -> new_env
            in
            (maybe_more, new_env2, [ Element_module new_module ])

        | Parsetree.Psig_recmodule decls ->
            (* we start by extending the environment *)
            let new_env =
              List.fold_left
                (fun acc_env {Parsetree.pmd_name={txt=name}} ->
                   match name with
                   | None -> acc_env
                   | Some name ->
                      let complete_name = Name.concat current_module_name name in
                      let e = Odoc_env.add_module acc_env complete_name in
                      (* get the information for the module in the signature *)
                      let sig_module_type =
                        try Signature_search.search_module table name
                        with Not_found ->
                          raise (Failure (Odoc_messages.module_not_found current_module_name name))
                      in
                      match sig_module_type with
                        (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
                        Types.Mty_signature s ->
                          Odoc_env.add_signature e complete_name ~rel: name s
                      | _ -> e
                    )
                    env
                    decls
            in
            let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list =
              match name_mtype_list with
                [] ->
                  (acc_maybe_more, [])
              | {Parsetree.pmd_name={txt = None}; pmd_type=modtype} :: q ->
                  let loc = modtype.Parsetree.pmty_loc in
                  let loc_start = Loc.start loc in
                  let loc_end = Loc.end_ loc in
                  let _, ele_comments =
                    if first then (None, [])
                    else get_comments_in_module last_pos loc_start
                  in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | _ :: _ -> Loc.start loc
                  in
                  let (maybe_more, _) =
                    My_ir.just_after_special
                      !file_name
                      (get_string_of_file loc_end pos_limit2)
                  in

                  let (maybe_more2, eles) = f
                      maybe_more
                      (loc_end + maybe_more)
                      q
                  in
                  (maybe_more2, ele_comments @ eles)

              | {Parsetree.pmd_name={txt = Some name}; pmd_type=modtype;
                 pmd_attributes} :: q ->
                  let complete_name = Name.concat current_module_name name in
                  let loc = modtype.Parsetree.pmty_loc in
                  let loc_start = Loc.start loc in
                  let loc_end = Loc.end_ loc in
                  let (assoc_com, ele_comments) =
                    if first then
                      (comment_opt, [])
                    else
                      get_comments_in_module
                        last_pos
                        loc_start
                  in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | _ :: _ -> Loc.start loc
                  in
                  (* get the information for the module in the signature *)
                  let sig_module_type =
                    try Signature_search.search_module table name
                    with Not_found ->
                      raise (Failure (Odoc_messages.module_not_found current_module_name name))
                  in
                  (* associate the comments to each constructor and build the [Type.t_type] *)
                  let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in
                  let code_intf =
                    if !Odoc_global.keep_code then
                      let st = Loc.start loc in
                      let en = Loc.end_ loc in
                      Some (get_string_of_file st en)
                    else
                      None
                  in
                  let (maybe_more, assoc_com) =
                    get_info ~attrs:pmd_attributes assoc_com loc_end pos_limit2
                  in
                  let new_module =
                    {
                      m_name = complete_name ;
                      m_type = sig_module_type;
                      m_info = assoc_com ;
                      m_is_interface = true ;
                      m_file = !file_name ;
                      m_kind = module_kind ;
                      m_loc = { loc_impl = None ; loc_inter = Some loc } ;
                      m_top_deps = [] ;
                      m_code = None ;
                      m_code_intf = code_intf ;
                      m_text_only = false ;
                    }
                  in

                  let (maybe_more2, eles) = f
                      maybe_more
                      (loc_end + maybe_more)
                      q
                  in
                  (maybe_more2, (ele_comments @ [Element_module new_module]) @ eles)
            in
            let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
            (maybe_more, new_env, mods)

        | Parsetree.Psig_modtype {Parsetree.pmtd_name=name;
                                  pmtd_type=pmodtype_decl;
                                  pmtd_attributes=pmodtype_attrs}
        | Parsetree.Psig_modtypesubst {Parsetree.pmtd_name=name;
                                       pmtd_type=pmodtype_decl;
                                       pmtd_attributes=pmodtype_attrs} ->
            let complete_name = Name.concat current_module_name name.txt in
            let sig_mtype =
              try Signature_search.search_module_type table name.txt
              with Not_found ->
                raise (Failure (Odoc_messages.module_type_not_found current_module_name name.txt))
            in
            let module_type_kind =
              match pmodtype_decl with
                None -> None
              | Some module_type ->
                match sig_mtype with
                | Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
                | None -> None
            in
            let (maybe_more, comment_opt) =
              get_info ~attrs:pmodtype_attrs comment_opt pos_end_ele pos_limit
            in
            let mt =
              {
                mt_name = complete_name ;
                mt_info = comment_opt ;
                mt_type = sig_mtype ;
                mt_is_interface = true ;
                mt_file = !file_name ;
                mt_kind = module_type_kind ;
                mt_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
              }
            in
            let new_env = Odoc_env.add_module_type env mt.mt_name in
            let new_env2 =
              match sig_mtype with (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
                Some (Types.Mty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
              | _ -> new_env
            in
            (maybe_more, new_env2, [ Element_module_type mt ])

        | Parsetree.Psig_include (incl, _) ->
            analyse_signature_item_desc_include ~env ~comment_opt incl

        | Parsetree.Psig_class class_description_list ->
            (* we start by extending the environment *)
            let new_env =
              List.fold_left
                (fun acc_env -> fun class_desc ->
                  let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name.txt in
                  Odoc_env.add_class acc_env complete_name
                )
                env
                class_description_list
            in
            let rec f ?(first=false) acc_maybe_more last_pos class_description_list =
              match class_description_list with
                [] ->
                  (acc_maybe_more, [])
              | class_desc :: q ->
                  let (assoc_com, ele_comments) =
                    if first then
                      (comment_opt, [])
                    else
                      get_comments_in_module
                        last_pos
                        (Loc.start class_desc.Parsetree.pci_loc)
                  in
                  let pos_end = Loc.end_ class_desc.Parsetree.pci_loc in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | cd :: _ -> Loc.start cd.Parsetree.pci_loc in
                  let name = class_desc.Parsetree.pci_name in
                  let complete_name = Name.concat current_module_name name.txt in
                  let sig_class_decl =
                    try Signature_search.search_class table name.txt
                    with Not_found ->
                      raise (Failure (Odoc_messages.class_not_found current_module_name name.txt))
                  in
                  let sig_class_type = sig_class_decl.Types.cty_type in
                  let (parameters, class_kind) =
                    analyse_class_kind
                     new_env
                     complete_name
                     (Loc.start class_desc.Parsetree.pci_loc)
                     class_desc.Parsetree.pci_expr
                     sig_class_type
                 in
                 let (maybe_more, assoc_com) =
                   get_info ~attrs:class_desc.Parsetree.pci_attributes
                     assoc_com pos_end pos_limit2
                 in
                 let new_class =
                   {
                     cl_name = complete_name ;
                     cl_info = assoc_com ;
                     cl_type = Odoc_env.subst_class_type env sig_class_type ;
                     cl_type_parameters = sig_class_decl.Types.cty_params;
                     cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ;
                     cl_kind = class_kind ;
                     cl_parameters = parameters ;
                     cl_loc = { loc_impl = None ; loc_inter = Some class_desc.Parsetree.pci_loc } ;
                   }
                 in
                 Odoc_class.class_update_parameters_text new_class ;
                 let (new_maybe_more, eles) =
                   f maybe_more (pos_end + maybe_more) q
                 in
                 (new_maybe_more,
                  ele_comments @ (( Element_class new_class ) :: eles))
            in
            let (maybe_more, eles) =
              f ~first: true 0 pos_start_ele class_description_list
            in
            (maybe_more, new_env, eles)

        | Parsetree.Psig_class_type class_type_declaration_list ->
            (* we start by extending the environment *)
            let new_env =
              List.fold_left
                (fun acc_env -> fun class_type_decl ->
                  let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in
                  Odoc_env.add_class_type acc_env complete_name
                )
                env
                class_type_declaration_list
            in
            let rec f ?(first=false) acc_maybe_more last_pos class_type_description_list =
              match class_type_description_list with
                [] ->
                  (acc_maybe_more, [])
              | ct_decl :: q ->
                  let (assoc_com, ele_comments) =
                    if first then
                      (comment_opt, [])
                    else
                      get_comments_in_module
                        last_pos
                        (Loc.start ct_decl.Parsetree.pci_loc)
                  in
                  let pos_end = Loc.end_ ct_decl.Parsetree.pci_loc in
                  let pos_limit2 =
                    match q with
                      [] -> pos_limit
                    | ct_decl2 :: _ -> Loc.start ct_decl2.Parsetree.pci_loc
                  in
                  let name = ct_decl.Parsetree.pci_name in
                  let complete_name = Name.concat current_module_name name.txt in
                  let sig_cltype_decl =
                    try Signature_search.search_class_type table name.txt
                    with Not_found ->
                      raise (Failure (Odoc_messages.class_type_not_found current_module_name name.txt))
                  in
                  let sig_class_type = sig_cltype_decl.Types.clty_type in
                  let kind = analyse_class_type_kind
                      new_env
                      complete_name
                      (Loc.start ct_decl.Parsetree.pci_loc)
                      ct_decl.Parsetree.pci_expr
                      sig_class_type
                  in
                  let (maybe_more, assoc_com) =
                    get_info ~attrs:ct_decl.Parsetree.pci_attributes assoc_com
                      pos_end pos_limit2
                  in
                  let ct =
                    {
                      clt_name = complete_name ;
                      clt_info = assoc_com ;
                      clt_type = Odoc_env.subst_class_type env sig_class_type ;
                      clt_type_parameters = sig_cltype_decl.clty_params ;
                      clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ;
                      clt_kind = kind ;
                      clt_loc = { loc_impl = None ; loc_inter = Some ct_decl.Parsetree.pci_loc } ;
                    }
                  in
                  let (new_maybe_more, eles) =
                    f maybe_more (pos_end + maybe_more) q
                  in
                 (new_maybe_more,
                  ele_comments @ (( Element_class_type ct) :: eles))
            in
            let (maybe_more, eles) =
              f ~first: true 0 pos_start_ele class_type_declaration_list
            in
            (maybe_more, new_env, eles)
        | Parsetree.Psig_attribute _
        | Parsetree.Psig_extension _ ->
            (0, env, [])

    and analyse_signature_item env _signat table current_module_name
        sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item =
      analyse_signature_item_desc
        env _signat table current_module_name
        sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt
        sig_item.Parsetree.psig_desc

    (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
    and analyse_module_type_kind
      ?(erased = Name.Map.empty) env current_module_name module_type sig_module_type =
      match module_type.Parsetree.pmty_desc with
        Parsetree.Pmty_ident longident ->
          let name =
            match sig_module_type with
              Types.Mty_ident path -> Name.from_path path
            | _ -> Name.from_longident longident.txt
              (* FIXME this happens for module type F : functor ... -> Toto, Toto is not an ident but a structure *)
          in
          Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
                              mta_module = None }

      | Parsetree.Pmty_alias longident ->
          let name =
            match sig_module_type with
              Types.Mty_alias path -> Name.from_path path
            | _ -> Name.from_longident longident.txt
          in
          (* Wrong naming... *)
          Module_type_alias { mta_name = Odoc_env.full_module_name env name ;
                              mta_module = None }

      | Parsetree.Pmty_signature {psg_items; _} ->
          (
           let psg_items = filter_out_erased_items_from_signature erased psg_items in
           (* we must have a signature in the module type *)
           match sig_module_type with
             Types.Mty_signature signat ->
               let pos_start = Loc.start module_type.Parsetree.pmty_loc in
               let pos_end = Loc.end_ module_type.Parsetree.pmty_loc in
               let elements = analyse_parsetree env signat current_module_name pos_start pos_end psg_items in
               Module_type_struct elements
           | _ ->
               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
          )

      | Parsetree.Pmty_functor (param2, module_type2) ->
          (
           let loc = match param2 with Parsetree.Unit -> Location.none
                     | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
           let loc_start = Loc.start loc in
           let loc_end = Loc.end_ loc in
           let mp_type_code = get_string_of_file loc_start loc_end in
           match sig_module_type with
             Types.Mty_functor (param, body_module_type) ->
               let mp_name, mp_kind =
                 match param2, param with
                   Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
                     Name.from_ident ident,
                     analyse_module_type_kind env current_module_name pmty mty
                 | _ -> "*", Module_type_struct []
               in
               let param =
                 {
                   mp_name = mp_name;
                   mp_type =
                     (match param with
                      | Types.Unit -> None
                      | Types.Named (_, mty) ->
                        Some (Odoc_env.subst_module_type env mty));
                   mp_type_code = mp_type_code ;
                   mp_kind = mp_kind ;
                 }
               in
               let k = analyse_module_type_kind ~erased env
                   current_module_name
                   module_type2
                   body_module_type
               in
               Module_type_functor (param, k)

           | _ ->
               (* if we're here something's wrong *)
               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
          )

      | Parsetree.Pmty_with (module_type2, constraints) ->
          (* of module_type * (Longident.t * with_constraint) list *)
          (
           let loc_start = Loc.end_ module_type2.Parsetree.pmty_loc in
           let loc_end = Loc.end_ module_type.Parsetree.pmty_loc in
           let s = get_string_of_file loc_start loc_end in
           let erased = erased_names_of_constraints constraints erased in
           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in

           Module_type_with (k, s)
          )

      | Parsetree.Pmty_typeof module_expr ->
          let loc_start = Loc.start module_expr.Parsetree.pmod_loc in
          let loc_end = Loc.end_ module_expr.Parsetree.pmod_loc in
          let s = get_string_of_file loc_start loc_end in
          Module_type_typeof s

      | Parsetree.Pmty_extension _ -> assert false
      | Parsetree.Pmty_strengthen _ -> failwith "strengthen not implemented yet"

    (** analyse of a Parsetree.module_type and a Types.module_type.*)
    and analyse_module_kind
        ?(erased = Name.Map.empty) env current_module_name module_type sig_module_type =
      match module_type.Parsetree.pmty_desc with
      | Parsetree.Pmty_ident _longident ->
          let k = analyse_module_type_kind env current_module_name module_type sig_module_type in
          Module_with ( k, "" )
      | Parsetree.Pmty_alias _longident ->
          begin
            match sig_module_type with
              Types.Mty_alias path ->
                let ln = !Odoc_global.library_namespace in
                let alias_name = Odoc_env.full_module_name env
                    Name.(alias_unprefix ln @@ from_path path) in
                let ma = { ma_name = alias_name ; ma_module = None } in
                Module_alias ma
            | _ ->
              raise (Failure "Parsetree.Pmty_alias _ but not Types.Mty_alias _")
           end
      | Parsetree.Pmty_signature {psg_items; _} ->
          (
           let psg_items = filter_out_erased_items_from_signature erased psg_items in
           match sig_module_type with
             Types.Mty_signature signat ->
               Module_struct
                 (analyse_parsetree
                    env
                    signat
                    current_module_name
                    (Loc.start module_type.Parsetree.pmty_loc)
                    (Loc.end_ module_type.Parsetree.pmty_loc)
                    psg_items
                 )
           | _ ->
               (* if we're here something's wrong *)
               raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
          )
      | Parsetree.Pmty_functor (param2,module_type2) (* of string * module_type * module_type *) ->
          (
           match sig_module_type with
             Types.Mty_functor (param, body_module_type) ->
               let loc = match param2 with Parsetree.Unit -> Location.none
                     | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
               let loc_start = Loc.start loc in
               let loc_end = Loc.end_ loc in
               let mp_type_code = get_string_of_file loc_start loc_end in
               let mp_name, mp_kind =
                 match param2, param with
                   Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
                     Name.from_ident ident,
                     analyse_module_type_kind env current_module_name pmty mty
                 | _ -> "*", Module_type_struct []
               in
               let param =
                 {
                   mp_name;
                   mp_type =
                     (match param with
                      | Types.Unit -> None
                      | Types.Named(_, mty) -> Some (Odoc_env.subst_module_type env mty));
                   mp_type_code = mp_type_code ;
                   mp_kind = mp_kind ;
                 }
               in
               let k = analyse_module_kind ~erased env
                   current_module_name
                   module_type2
                   body_module_type
               in
               Module_functor (param, k)

           | _ ->
               (* if we're here something's wrong *)
               raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _")
          )
      | Parsetree.Pmty_with (module_type2, constraints) ->
          (* of module_type * (Longident.t * with_constraint) list*)
          (
           let loc_start = Loc.end_ module_type2.Parsetree.pmty_loc in
           let loc_end = Loc.end_ module_type.Parsetree.pmty_loc in
           let s = get_string_of_file loc_start loc_end in
           let erased = erased_names_of_constraints constraints erased in
           let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in
           Module_with (k, s)
          )
      | Parsetree.Pmty_typeof module_expr ->
          let loc_start = Loc.start module_expr.Parsetree.pmod_loc in
          let loc_end = Loc.end_ module_expr.Parsetree.pmod_loc in
          let s = get_string_of_file loc_start loc_end in
          Module_typeof s

      | Parsetree.Pmty_extension _ -> assert false
      | Parsetree.Pmty_strengthen _ -> failwith "strengthen not implemented yet"

    (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple
       (class parameters, class_kind).*)
    and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type =
      match parse_class_type.Parsetree.pcty_desc, sig_class_type with
        (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
           let path_name = Name.from_path p in
           let name = Odoc_env.full_class_or_class_type_name env path_name in
           let k =
             Class_constr
               {
                 cco_name = name ;
                 cco_class = None ;
                 cco_type_parameters = List.map (Odoc_env.subst_type env) typ_list
               }
           in
           ([], k)

      | (Parsetree.Pcty_signature { Parsetree.pcsig_fields = class_type_field_list }, Types.Cty_signature class_signature) ->
          (* we get the elements of the class in class_type_field_list *)
          let (inher_l, ele) = analyse_class_elements env current_class_name
              last_pos
              (Loc.end_ parse_class_type.Parsetree.pcty_loc)
              class_type_field_list
              class_signature
          in
          ([], Class_structure (inher_l, ele))

      | (Parsetree.Pcty_arrow (parse_label, type_, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
          (* label = string. In signature, there is no parameter names inside tuples *)
          (* if label = "", no label . Here we have the information to determine if a label is explicit or not. *)
          if (Typetexp.transl_label parse_label (Some type_)) = label then
            (
             let new_param = Simple_name
                 {
                   sn_name = Btype.label_name label ;
                   sn_type = Odoc_env.subst_type env type_expr ;
                   sn_text = None ; (* will be updated when the class will be created *)
                 }
             in
             let (l, k) = analyse_class_kind env current_class_name last_pos pclass_type class_type in
             ( (new_param :: l), k )
            )
          else
            (
             raise (Failure "Parsetree.Pcty_arrow (parse_label, _, pclass_type), different labels")
            )

      | _ ->
          raise (Failure "analyse_class_kind: match failure")

    (** Analyse of a Parsetree.class_type and a Types.class_type to return a class_type_kind.*)
    and analyse_class_type_kind env current_class_name last_pos parse_class_type sig_class_type =
      match parse_class_type.Parsetree.pcty_desc, sig_class_type with
        (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *),
         Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) ->
          Class_type
            {
              cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ;
              cta_class = None ;
              cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list
            }

        | (Parsetree.Pcty_signature {
              Parsetree.pcsig_fields = class_type_field_list;
              }, Types.Cty_signature class_signature) ->
          (* we get the elements of the class in class_type_field_list *)
          let (inher_l, ele) = analyse_class_elements env current_class_name
              last_pos
              (Loc.end_ parse_class_type.Parsetree.pcty_loc)
              class_type_field_list
              class_signature
          in
          Class_signature (inher_l, ele)

      | (Parsetree.Pcty_arrow _, Types.Cty_arrow _) ->
          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_arrow (...) with Types.Cty_arrow (...)")
(*
      | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
         Types.Cty_signature class_signature) ->
           (* FIXME : this for the case of class constraints :
              class type cons = object
                method m : int
              end

              class ['a] maxou x =
                (object
                  val a = (x : 'a)
                  method m = a
                end : cons )
                    ^^^^^^
           *)
           let k =
             Class_type
               {
                 cta_name = Odoc_env.full_class_name env (Name.from_longident longident) ;
                 cta_class = None ;
                 cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list (* ?? *)
               }
           in
           ([], k)
*)
      | _ ->
          raise (Failure "analyse_class_type_kind: match failure")

    let analyse_signature source_file input_file
        ({psg_items; _} : Parsetree.signature) (signat : Types.signature) =
      prepare_file source_file input_file;
      (* We create the t_module for this file. *)
      let mod_name = Unit_info.modname_from_source source_file in
      let len, info_opt = preamble !file_name !file
          (fun x -> x.Parsetree.psig_loc) psg_items in
      let info_opt = analyze_toplevel_alerts info_opt psg_items in
      let elements =
        analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) psg_items
      in
      let code_intf =
        if !Odoc_global.keep_code then
          Some !file
        else
          None
      in
      {
        m_name = mod_name ;
        m_type = Types.Mty_signature signat ;
        m_info = info_opt ;
        m_is_interface = true ;
        m_file = !file_name ;
        m_kind = Module_struct elements ;
        m_loc = { loc_impl = None ; loc_inter = Some (Location.in_file !file_name) } ;
        m_top_deps = [] ;
        m_code = None ;
        m_code_intf = code_intf ;
        m_text_only = false ;
      }

    end