ocaml/ocamldoc/odoc_cross.ml

(***********************************************************************)
(*                             OCamldoc                                *)
(*                                                                     *)
(*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
(*                                                                     *)
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)


(** Cross referencing. *)

module Name = Odoc_name
open Odoc_module
open Odoc_class
open Odoc_exception
open Odoc_types
open Odoc_value
open Odoc_type
open Odoc_parameter 

(*** Replacements of aliases : if e1 = e2 and e2 = e3, then replace e2 by e3 to have e1 = e3, 
   in order to associate the element with complete information. *)

(** The module with the predicates used to get the aliased modules, classes and exceptions. *)
module P_alias =
  struct
    type t = int

    let p_module m _ = 
      (true,
       match m.m_kind with
	 Module_alias _ -> true
       | _ -> false
      )
    let p_module_type mt _ =
      (true,
       match mt.mt_kind with
	 Some (Module_type_alias _) -> true
       | _ -> false
      )
    let p_class c _ = (false, false)
    let p_class_type ct _ = (false, false)
    let p_value v _ = false
    let p_type t _ = false
    let p_exception e _ = e.ex_alias <> None
    let p_attribute a _ = false
    let p_method m _ = false
    let p_section s _ = false
  end

(** The module used to get the aliased elements. *)
module Search_alias = Odoc_search.Search (P_alias)

let rec build_alias_list (acc_m, acc_mt, acc_ex) = function
    [] ->
      (acc_m, acc_mt, acc_ex)
  | (Odoc_search.Res_module m) :: q ->
      let new_acc_m = 
	match m.m_kind with
	  Module_alias ma -> (m.m_name, ma.ma_name) :: acc_m
	| _ -> acc_m
      in
      build_alias_list (new_acc_m, acc_mt, acc_ex) q
  | (Odoc_search.Res_module_type mt) :: q ->
      let new_acc_mt = 
	match mt.mt_kind with
	  Some (Module_type_alias mta) -> (mt.mt_name, mta.mta_name) :: acc_mt
	| _ -> acc_mt
      in
      build_alias_list (acc_m, new_acc_mt, acc_ex) q
  | (Odoc_search.Res_exception e) :: q ->
      let new_acc_ex = 
	match e.ex_alias with
	  None -> acc_ex
	| Some ea -> (e.ex_name, ea.ea_name) :: acc_ex
      in
      build_alias_list (acc_m, acc_mt, new_acc_ex) q
  | _ :: q ->
      build_alias_list (acc_m, acc_mt, acc_ex) q



(** Couples of module name aliases. *)
let module_aliases = ref [] ;;
(** Couples of module type name aliases. *)
let module_type_aliases = ref [] ;;
(** Couples of exception name aliases. *)
let exception_aliases = ref [] ;;

(** Retrieve the aliases for modules, module types and exceptions and put them in global variables. *)
let get_alias_names module_list =
  let (alias_m, alias_mt, alias_ex) = 
    build_alias_list
      ([], [], []) 
      (Search_alias.search module_list 0)
  in
  module_aliases := alias_m ;
  module_type_aliases := alias_mt ;
  exception_aliases := alias_ex 
  

(** The module with lookup predicates. *)
module P_lookup = 
  struct
    type t = Name.t
    let p_module m name = (Name.prefix m.m_name name, m.m_name = (Name.name_alias name !module_aliases))
    let p_module_type mt name = (Name.prefix mt.mt_name name, mt.mt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
    let p_class c name = (false, c.cl_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
    let p_class_type ct name = (false, ct.clt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
    let p_value v name = false
    let p_type t name = false
    let p_exception e name = e.ex_name = (Name.name_alias name !exception_aliases)
    let p_attribute a name = false
    let p_method m name = false
    let p_section s name = false
  end

(** The module used to search by a complete name.*)
module Search_by_complete_name = Odoc_search.Search (P_lookup)

let rec lookup_module module_list name =
  let l = List.filter
      (fun res ->
	match res with
	  Odoc_search.Res_module _ -> true
	| _ -> false
      )
      (Search_by_complete_name.search module_list name)
  in
  match l with
    (Odoc_search.Res_module m) :: _ -> m
  | _ -> raise Not_found

let rec lookup_module_type module_list name =
  let l = List.filter
      (fun res ->
	match res with
	  Odoc_search.Res_module_type _ -> true
	| _ -> false
      )
      (Search_by_complete_name.search module_list name)
  in
  match l with
    (Odoc_search.Res_module_type mt) :: _ -> mt
  | _ -> raise Not_found

let rec lookup_class module_list name =
  let l = List.filter
      (fun res ->
	match res with
	  Odoc_search.Res_class _ -> true
	| _ -> false
      )
      (Search_by_complete_name.search module_list name)
  in
  match l with
    (Odoc_search.Res_class c) :: _ -> c
  | _ -> raise Not_found

let rec lookup_class_type module_list name =
  let l = List.filter
      (fun res ->
	match res with
	  Odoc_search.Res_class_type _ -> true
	| _ -> false
      )
      (Search_by_complete_name.search module_list name)
  in
  match l with
    (Odoc_search.Res_class_type ct) :: _ -> ct
  | _ -> raise Not_found

let rec lookup_exception module_list name =
  let l = List.filter
      (fun res ->
	match res with
	  Odoc_search.Res_exception _ -> true
	| _ -> false
      )
      (Search_by_complete_name.search module_list name)
  in
  match l with
    (Odoc_search.Res_exception e) :: _ -> e
  | _ -> raise Not_found

(** The type to describe the names not found. *)
type not_found_name = 
    NF_m of Name.t
  | NF_mt of Name.t
  | NF_mmt of Name.t
  | NF_c of Name.t
  | NF_ct of Name.t
  | NF_cct of Name.t
  | NF_ex of Name.t

(** Functions to find and associate aliases elements. *)

let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m =
  let rec iter_kind (acc_b, acc_inc, acc_names) k =
    match k with
      Module_struct elements ->
	List.fold_left
	  (associate_in_module_element module_list m.m_name)
	  (acc_b, acc_inc, acc_names)
	  elements
	  
    | Module_alias ma ->
	(
	 match ma.ma_module with
	   Some _ ->
	     (acc_b, acc_inc, acc_names)
	 | None ->
	     let mmt_opt =
	       try Some (Mod (lookup_module module_list ma.ma_name))
	       with Not_found ->
		 try Some (Modtype (lookup_module_type module_list ma.ma_name))
		 with Not_found -> None
	     in
	     match mmt_opt with
	       None -> (acc_b, (Name.head m.m_name) :: acc_inc, 
			(* we don't want to output warning messages for 
			   "sig ... end" or "struct ... end" modules not found *)
			(if ma.ma_name = Odoc_messages.struct_end or 
			  ma.ma_name = Odoc_messages.sig_end then
			  acc_names
			else
			  (NF_mmt ma.ma_name) :: acc_names)
		       )
	     | Some mmt -> 
		 ma.ma_module <- Some mmt ;
		 (true, acc_inc, acc_names)
	)

    | Module_functor (_, k) ->
	iter_kind (acc_b, acc_inc, acc_names) k

    | Module_with (tk, _) ->
	associate_in_module_type module_list (acc_b, acc_inc, acc_names)
	  { mt_name = "" ; mt_info = None ; mt_type = None ;
	    mt_is_interface = false ; mt_file = ""; mt_kind = Some tk ;
	    mt_loc = Odoc_types.dummy_loc }
	  
    | Module_apply (k1, k2) ->
	let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) k1 in
	iter_kind (acc_b2, acc_inc2, acc_names2) k2

    | Module_constraint (k, tk) ->
	let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) k in
	associate_in_module_type module_list (acc_b2, acc_inc2, acc_names2)
	  { mt_name = "" ; mt_info = None ; mt_type = None ;
	    mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
	    mt_loc = Odoc_types.dummy_loc }
  in
  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m.m_kind
	
and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt =
  let rec iter_kind (acc_b, acc_inc, acc_names) k =
    match k with
      Module_type_struct elements ->
	List.fold_left
	  (associate_in_module_element module_list mt.mt_name)
	  (acc_b, acc_inc, acc_names)
	  elements

    | Module_type_functor (_, k) ->
	iter_kind (acc_b, acc_inc, acc_names) k

    | Module_type_with (k, _) ->
	iter_kind (acc_b, acc_inc, acc_names) k

    | Module_type_alias mta ->
	match mta.mta_module with
	   Some _ ->
	     (acc_b, acc_inc, acc_names)
	 | None ->
	     let mt_opt =
	       try Some (lookup_module_type module_list mta.mta_name)
	       with Not_found -> None
	     in
	     match mt_opt with
	       None -> (acc_b, (Name.head mt.mt_name) :: acc_inc, 
			(* we don't want to output warning messages for 
			   "sig ... end" or "struct ... end" modules not found *)
			(if mta.mta_name = Odoc_messages.struct_end or 
			  mta.mta_name = Odoc_messages.sig_end then
			  acc_names 
			else 
			  (NF_mt mta.mta_name) :: acc_names)
		       )
	     | Some mt -> 
		 mta.mta_module <- Some mt ;
		 (true, acc_inc, acc_names)
  in
  match mt.mt_kind with
    None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
  | Some k -> iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) k
  
and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) element =
   match element with
     Element_module m -> associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m
   | Element_module_type mt -> associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt
   | Element_included_module im -> 
       (
	match im.im_module with
	  Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
	| None ->
	    let mmt_opt =
	      try Some (Mod (lookup_module module_list im.im_name))
	      with Not_found ->
		try Some (Modtype (lookup_module_type module_list im.im_name))
		with Not_found -> None
	    in
	    match mmt_opt with
	      None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names, 
		       (* we don't want to output warning messages for 
			   "sig ... end" or "struct ... end" modules not found *)
			(if im.im_name = Odoc_messages.struct_end or 
			  im.im_name = Odoc_messages.sig_end then
			  acc_names_not_found
			else
			  (NF_mmt im.im_name) :: acc_names_not_found)
		      )
	    | Some mmt -> 
		im.im_module <- Some mmt ;
		(true, acc_incomplete_top_module_names, acc_names_not_found)
       )
   | Element_class cl -> associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) cl
   | Element_class_type ct -> associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct
   | Element_value _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
   | Element_exception ex ->
       (
	match ex.ex_alias with
	  None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
	| Some ea ->
	    match ea.ea_ex with
	      Some _ -> 
		(acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
	    | None -> 
		let ex_opt =
		  try Some (lookup_exception module_list ea.ea_name)
		  with Not_found -> None
		in
		match ex_opt with
		  None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names, (NF_ex ea.ea_name) :: acc_names_not_found)
		| Some e ->
		    ea.ea_ex <- Some e ;
		    (true, acc_incomplete_top_module_names, acc_names_not_found)
       )
   | Element_type _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
   | Element_module_comment _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)

and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c =
  let rec iter_kind (acc_b, acc_inc, acc_names) k = 
    match k with
      Class_structure (inher_l, _) ->
	let f (acc_b2, acc_inc2, acc_names2) ic =
	  match ic.ic_class with
	  Some _ -> (acc_b2, acc_inc2, acc_names2)
	| None ->
	    let cct_opt =
	      try Some (Cl (lookup_class module_list ic.ic_name))
	      with Not_found ->
		try Some (Cltype (lookup_class_type module_list ic.ic_name, []))
		with Not_found -> None
	    in
	    match cct_opt with
	      None -> (acc_b2, (Name.head c.cl_name) :: acc_inc2,
		       (* we don't want to output warning messages for "object ... end" classes not found *)
		       (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2))
	    | Some cct -> 
		ic.ic_class <- Some cct ;
		(true, acc_inc2, acc_names2)
	in
	List.fold_left f (acc_b, acc_inc, acc_names) inher_l

    | Class_apply capp ->
	(
	 match capp.capp_class with
	   Some _ ->  (acc_b, acc_inc, acc_names)
	 | None -> 
	     let cl_opt =
	       try Some (lookup_class module_list capp.capp_name)
	       with Not_found -> None
	     in
	     match cl_opt with
	       None -> (acc_b, (Name.head c.cl_name) :: acc_inc, 
			(* we don't want to output warning messages for "object ... end" classes not found *)
			(if capp.capp_name = Odoc_messages.object_end then acc_names else (NF_c capp.capp_name) :: acc_names))
	     | Some c ->
		 capp.capp_class <- Some c ;
		 (true, acc_inc, acc_names)
	)

    | Class_constr cco ->
	(
	 match cco.cco_class with
	   Some _ ->  (acc_b, acc_inc, acc_names)
	 | None -> 
	     let cl_opt =
	       try Some (lookup_class module_list cco.cco_name)
	       with Not_found -> None
	     in
	     match cl_opt with
	       None -> 
		 (
		  let clt_opt =
		    try Some (lookup_class_type module_list cco.cco_name)
		    with Not_found -> None
		  in
		  match clt_opt with
		    None ->
		      (acc_b, (Name.head c.cl_name) :: acc_inc, 
			(* we don't want to output warning messages for "object ... end" classes not found *)
		       (if cco.cco_name = Odoc_messages.object_end then acc_names else (NF_cct cco.cco_name) :: acc_names))
		  | Some ct ->
		      cco.cco_class <- Some (Cltype (ct, [])) ;
		      (true, acc_inc, acc_names)
		 )
	     | Some c ->
		 cco.cco_class <- Some (Cl c) ;
		 (true, acc_inc, acc_names)
	)
    | Class_constraint (ckind, ctkind) ->
	let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) ckind in
	associate_in_class_type module_list (acc_b2, acc_inc2, acc_names2)
	    { clt_name = "" ; clt_info = None ;
	      clt_type = c.cl_type ; (* should be ok *)
	      clt_type_parameters = [] ;
	      clt_virtual = false ;
	      clt_kind = ctkind ;
	      clt_loc = Odoc_types.dummy_loc }
  in
  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c.cl_kind

and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct =
  let rec iter_kind (acc_b, acc_inc, acc_names) k = 
    match k with
      Class_signature (inher_l, _) ->
	let f (acc_b2, acc_inc2, acc_names2) ic =
	  match ic.ic_class with
	    Some _ -> (acc_b2, acc_inc2, acc_names2)
	  | None ->
	      let cct_opt =
		try Some (Cltype (lookup_class_type module_list ic.ic_name, []))
		with Not_found ->
		  try Some (Cl (lookup_class module_list ic.ic_name))
		  with Not_found -> None
	      in
	      match cct_opt with
		None -> (acc_b2, (Name.head ct.clt_name) :: acc_inc2, 
			 (* we don't want to output warning messages for "object ... end" class types not found *)
			 (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2))
	      | Some cct -> 
		  ic.ic_class <- Some cct ;
		  (true, acc_inc2, acc_names2)
	in
	List.fold_left f (acc_b, acc_inc, acc_names) inher_l

    | Class_type cta ->
	(
	 match cta.cta_class with
	   Some _ ->  (acc_b, acc_inc, acc_names)
	 | None -> 
	     let cct_opt =
	       try Some (Cltype (lookup_class_type module_list cta.cta_name, []))
	       with Not_found -> 
		 try Some (Cl (lookup_class module_list cta.cta_name))
		 with Not_found -> None
	     in
	     match cct_opt with
	       None -> (acc_b, (Name.head ct.clt_name) :: acc_inc, 
			(* we don't want to output warning messages for "object ... end" class types not found *)
			(if cta.cta_name = Odoc_messages.object_end then acc_names else (NF_cct cta.cta_name) :: acc_names))
	     | Some c ->
		 cta.cta_class <- Some c ;
		 (true, acc_inc, acc_names)
	)
  in
  iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct.clt_kind

(*************************************************************)
(** Association of types to elements referenced in comments .*)

let ao = Odoc_misc.apply_opt 

let rec assoc_comments_text_elements module_list t_ele =
  match t_ele with
    | Raw _
    | Code _
    | CodePre _
    | Latex _
    | Verbatim _ 
    | Ref (_, Some _) -> t_ele
    | Bold t -> Bold (assoc_comments_text module_list t)
    | Italic t -> Italic (assoc_comments_text module_list t)
    | Center t -> Center (assoc_comments_text module_list t)
    | Left t -> Left (assoc_comments_text module_list t)
    | Right t -> Right (assoc_comments_text module_list t)
    | Emphasize t -> Emphasize (assoc_comments_text module_list t)
    | List l ->	List (List.map (assoc_comments_text module_list) l)
    | Enum l ->	Enum (List.map (assoc_comments_text module_list) l)
    | Newline -> Newline
    | Block t -> Block (assoc_comments_text module_list t)
    | Superscript t -> Superscript (assoc_comments_text module_list t)
    | Subscript t -> Subscript (assoc_comments_text module_list t)
    | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text module_list t))
    | Link (s, t) -> Link (s, (assoc_comments_text module_list t))
    | Ref (name, None) ->
	let re = Str.regexp ("^"^(Str.quote name)^"$") in
	let res = Odoc_search.Search_by_name.search module_list re in
	match res with
	  [] ->
	    Odoc_messages.pwarning (Odoc_messages.cross_element_not_found name);
	    t_ele
	| ele :: _ ->
	    let kind = 
	      match ele with
		Odoc_search.Res_module _ -> RK_module
	      | Odoc_search.Res_module_type _ -> RK_module_type
	      | Odoc_search.Res_class _ -> RK_class
	      | Odoc_search.Res_class_type _ -> RK_class_type
	      | Odoc_search.Res_value _ -> RK_value
	      | Odoc_search.Res_type _ -> RK_type
	      | Odoc_search.Res_exception _ -> RK_exception
	      | Odoc_search.Res_attribute _ -> RK_attribute
	      | Odoc_search.Res_method _ -> RK_method
	      | Odoc_search.Res_section _ -> RK_section
	    in
	    Ref (name, Some kind)

and assoc_comments_text module_list text =
  List.map (assoc_comments_text_elements module_list) text

and assoc_comments_info module_list i =
  let ft = assoc_comments_text module_list in
  {
    i with
    i_desc = ao ft i.i_desc ;
    i_sees = List.map (fun (sr, t) -> (sr, ft t)) i.i_sees;
    i_deprecated = ao ft i.i_deprecated ;
    i_params = List.map (fun (name, t) -> (name, ft t)) i.i_params;
    i_raised_exceptions = List.map (fun (name, t) -> (name, ft t)) i.i_raised_exceptions;
    i_return_value = ao ft i.i_return_value
  } 
    

let rec assoc_comments_module_element module_list m_ele =
  match m_ele with
    Element_module m -> Element_module (assoc_comments_module module_list m)
  | Element_module_type mt -> Element_module_type (assoc_comments_module_type module_list mt)
  | Element_included_module _ -> m_ele (* don't go down into the aliases *)
  | Element_class c -> Element_class (assoc_comments_class module_list c)
  | Element_class_type ct -> Element_class_type (assoc_comments_class_type module_list ct)
  | Element_value v -> Element_value (assoc_comments_value module_list v)
  | Element_exception e -> Element_exception (assoc_comments_exception module_list e)
  | Element_type t -> Element_type (assoc_comments_type module_list t)
  | Element_module_comment t -> Element_module_comment (assoc_comments_text module_list t)

and assoc_comments_class_element module_list c_ele =
  match c_ele with
    Class_attribute a -> Class_attribute (assoc_comments_attribute module_list a)
  | Class_method m -> Class_method (assoc_comments_method module_list m)
  | Class_comment t -> Class_comment (assoc_comments_text module_list t)

and assoc_comments_module_kind module_list mk =
  match mk with
  | Module_struct eles -> 
      Module_struct (List.map (assoc_comments_module_element module_list) eles)
  | Module_alias _ 
  | Module_functor _ -> 
      mk
  | Module_apply (mk1, mk2) -> 
      Module_apply (assoc_comments_module_kind module_list mk1,
		    assoc_comments_module_kind module_list mk2)
  | Module_with (mtk, s) -> 
      Module_with (assoc_comments_module_type_kind module_list mtk, s)
  | Module_constraint (mk1, mtk) -> 
      Module_constraint (assoc_comments_module_kind module_list mk1,
			 assoc_comments_module_type_kind module_list mtk)

and assoc_comments_module_type_kind module_list mtk =
  match mtk with
  | Module_type_struct eles ->
      Module_type_struct (List.map (assoc_comments_module_element module_list) eles)
  | Module_type_functor (params, mtk1) -> 
      Module_type_functor (params, assoc_comments_module_type_kind module_list mtk1)
  | Module_type_alias _ ->
      mtk
  | Module_type_with (mtk1, s) ->
      Module_type_with (assoc_comments_module_type_kind module_list mtk1, s)

and assoc_comments_class_kind module_list ck =
  match ck with
    Class_structure (inher, eles) ->
      let inher2 = 
	List.map 
	  (fun ic -> { ic with 
		       ic_text = ao (assoc_comments_text module_list) ic.ic_text })
	  inher
      in
      Class_structure (inher2, List.map (assoc_comments_class_element module_list) eles)

  | Class_apply _
  | Class_constr _ -> ck
  | Class_constraint (ck1, ctk) ->
      Class_constraint (assoc_comments_class_kind module_list ck1,
			assoc_comments_class_type_kind module_list ctk)

and assoc_comments_class_type_kind module_list ctk =
  match ctk with
    Class_signature (inher, eles) ->
      let inher2 = 
	List.map 
	  (fun ic -> { ic with 
		       ic_text = ao (assoc_comments_text module_list) ic.ic_text })
	  inher
      in
      Class_signature (inher2, List.map (assoc_comments_class_element module_list) eles)

  | Class_type _ -> ctk


and assoc_comments_module module_list m =
  m.m_info <- ao (assoc_comments_info module_list) m.m_info ;
  m.m_kind <- assoc_comments_module_kind module_list m.m_kind ;
  m

and assoc_comments_module_type module_list mt =
  mt.mt_info <- ao (assoc_comments_info module_list) mt.mt_info ;
  mt.mt_kind <- ao (assoc_comments_module_type_kind module_list) mt.mt_kind ;
  mt

and assoc_comments_class module_list c = 
  c.cl_info <- ao (assoc_comments_info module_list) c.cl_info ;
  c.cl_kind <- assoc_comments_class_kind module_list c.cl_kind ;
  assoc_comments_parameter_list module_list c.cl_parameters;
  c

and assoc_comments_class_type module_list ct =
  ct.clt_info <- ao (assoc_comments_info module_list) ct.clt_info ;
  ct.clt_kind <- assoc_comments_class_type_kind module_list ct.clt_kind ;
  ct

and assoc_comments_parameter module_list p =
  match p with
    Simple_name sn -> 
      sn.sn_text <- ao (assoc_comments_text module_list) sn.sn_text
  | Tuple (l, t) ->
      List.iter (assoc_comments_parameter module_list) l

and assoc_comments_parameter_list module_list pl =
  List.iter (assoc_comments_parameter module_list) pl

and assoc_comments_value module_list v =
  v.val_info <- ao (assoc_comments_info module_list) v.val_info ;
  assoc_comments_parameter_list module_list v.val_parameters;
  v

and assoc_comments_exception module_list e =
  e.ex_info <- ao (assoc_comments_info module_list) e.ex_info ;
  e

and assoc_comments_type module_list t =
  t.ty_info <- ao (assoc_comments_info module_list) t.ty_info ;
  (match t.ty_kind with
    Type_abstract -> ()
  | Type_variant vl ->
      List.iter 
	(fun vc -> vc.vc_text <- ao (assoc_comments_text module_list) vc.vc_text)
	vl 
  | Type_record fl ->
      List.iter 
	(fun rf -> rf.rf_text <- ao (assoc_comments_text module_list) rf.rf_text)
	fl
  );
  t

and assoc_comments_attribute module_list a =
  let _ = assoc_comments_value module_list a.att_value in
  a

and assoc_comments_method module_list m =
  let _ = assoc_comments_value module_list m.met_value in
  assoc_comments_parameter_list module_list m.met_value.val_parameters;
  m


let associate_type_of_elements_in_comments module_list =
  List.map (assoc_comments_module module_list) module_list


(***********************************************************)
(** The function which performs all the cross referencing. *)
let associate module_list =
  get_alias_names module_list ;
  let rec remove_doubles acc = function
      [] -> acc
    | h :: q ->
	if List.mem h acc then remove_doubles acc q
	else remove_doubles (h :: acc) q
  in
  let rec iter incomplete_modules =
    let (b_modif, remaining_inc_modules, acc_names_not_found) = 
      List.fold_left (associate_in_module module_list) (false, [], []) incomplete_modules
    in
    let remaining_no_doubles = remove_doubles [] remaining_inc_modules in
    let remaining_modules = List.filter
	(fun m -> List.mem m.m_name remaining_no_doubles)
	incomplete_modules
    in
    if b_modif then
      (* we may be able to associate something else *)
      iter remaining_modules
    else
      (* nothing changed, we won' be able to associate any more *)
      acc_names_not_found
  in
  let names_not_found = iter module_list in
  (
   match names_not_found with
     [] ->
       ()
   | l ->
       List.iter 
	 (fun nf ->
	   Odoc_messages.pwarning
	     (
	      match nf with
		NF_m n -> Odoc_messages.cross_module_not_found n
	      | NF_mt n -> Odoc_messages.cross_module_type_not_found n
	      | NF_mmt n -> Odoc_messages.cross_module_or_module_type_not_found n
	      | NF_c n -> Odoc_messages.cross_class_not_found n
	      | NF_ct n -> Odoc_messages.cross_class_type_not_found n
	      | NF_cct n -> Odoc_messages.cross_class_or_class_type_not_found n
	      | NF_ex n -> Odoc_messages.cross_exception_not_found n
	     );
	 )
	 l
  ) ;

  (* Find a type for each name of element which is referenced in comments. *)
  let _ = associate_type_of_elements_in_comments module_list in
  ()