diff options
Diffstat (limited to 'ocamldoc/odoc_cross.ml')
| -rw-r--r-- | ocamldoc/odoc_cross.ml | 169 |
1 files changed, 85 insertions, 84 deletions
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index cbe949edee..f589858fa3 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -20,13 +20,13 @@ open Odoc_exception open Odoc_types open Odoc_value open Odoc_type -open Odoc_parameter +open Odoc_parameter -(*** Replacements of aliases : if e1 = e2 and e2 = e3, then replace e2 by e3 to have e1 = e3, +(*** 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 used to keep what refs were modified. *) -module S = Set.Make +module S = Set.Make ( struct type t = string * ref_kind option let compare = Pervasives.compare @@ -43,7 +43,7 @@ module P_alias = struct type t = int - let p_module m _ = + let p_module m _ = (true, match m.m_kind with Module_alias _ -> true @@ -86,7 +86,7 @@ let rec build_alias_list = function | (Odoc_search.Res_module m) :: q -> ( match m.m_kind with - Module_alias ma -> + Module_alias ma -> Hashtbl.add module_aliases m.m_name (ma.ma_name, Alias_to_resolve); Hashtbl.add module_and_modtype_aliases m.m_name (ma.ma_name, Alias_to_resolve) | _ -> () @@ -95,8 +95,8 @@ let rec build_alias_list = function | (Odoc_search.Res_module_type mt) :: q -> ( match mt.mt_kind with - Some (Module_type_alias mta) -> - Hashtbl.add module_and_modtype_aliases + Some (Module_type_alias mta) -> + Hashtbl.add module_and_modtype_aliases mt.mt_name (mta.mta_name, Alias_to_resolve) | _ -> () ); @@ -105,22 +105,22 @@ let rec build_alias_list = function ( match e.ex_alias with None -> () - | Some ea -> - Hashtbl.add exception_aliases + | Some ea -> + Hashtbl.add exception_aliases e.ex_name (ea.ea_name,Alias_to_resolve) ); build_alias_list q | _ :: q -> build_alias_list q -(** Retrieve the aliases for modules, module types and exceptions +(** Retrieve the aliases for modules, module types and exceptions and put them in global hash tables. *) let get_alias_names module_list = Hashtbl.clear module_aliases; Hashtbl.clear module_and_modtype_aliases; Hashtbl.clear exception_aliases; build_alias_list (Search_alias.search module_list 0) - + exception Found of string let name_alias = let rec f t name = @@ -153,14 +153,14 @@ let name_alias = module Map_ord = struct - type t = string + type t = string let compare = Pervasives.compare end module Ele_map = Map.Make (Map_ord) let known_elements = ref Ele_map.empty -let add_known_element name k = +let add_known_element name k = try let l = Ele_map.find name !known_elements in let s = Ele_map.remove name !known_elements in @@ -174,7 +174,7 @@ let get_known_elements name = with Not_found -> [] let kind_name_exists kind = - let pred = + let pred = match kind with RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false) | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false) @@ -203,7 +203,7 @@ let method_exists = kind_name_exists RK_method let lookup_module name = match List.find - (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_module m -> m @@ -211,7 +211,7 @@ let lookup_module name = let lookup_module_type name = match List.find - (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_module_type m -> m @@ -219,7 +219,7 @@ let lookup_module_type name = let lookup_class name = match List.find - (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_class c -> c @@ -227,7 +227,7 @@ let lookup_class name = let lookup_class_type name = match List.find - (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_class_type c -> c @@ -235,7 +235,7 @@ let lookup_class_type name = let lookup_exception name = match List.find - (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_exception e -> e @@ -244,9 +244,9 @@ let lookup_exception name = class scan = object inherit Odoc_scan.scanner - method scan_value v = + method scan_value v = add_known_element v.val_name (Odoc_search.Res_value v) - method scan_type t = + method scan_type t = add_known_element t.ty_name (Odoc_search.Res_type t) method scan_exception e = add_known_element e.ex_name (Odoc_search.Res_exception e) @@ -277,7 +277,7 @@ let init_known_elements_map module_list = (** The type to describe the names not found. *) -type not_found_name = +type not_found_name = NF_m of Name.t | NF_mt of Name.t | NF_mmt of Name.t @@ -296,7 +296,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ (associate_in_module_element module_list m.m_name) (acc_b, acc_inc, acc_names) elements - + | Module_alias ma -> ( match ma.ma_module with @@ -310,16 +310,16 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ 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 + 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 + (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 -> + | Some mmt -> ma.ma_module <- Some mmt ; (true, acc_inc, acc_names) ) @@ -332,7 +332,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ { 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 @@ -345,7 +345,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ 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 @@ -371,28 +371,28 @@ and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module 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 + 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 + (if mta.mta_name = Odoc_messages.struct_end or mta.mta_name = Odoc_messages.sig_end then - acc_names - else + acc_names + else (NF_mt mta.mta_name) :: acc_names) ) - | Some mt -> + | 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 -> + | Element_included_module im -> ( match im.im_module with Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) @@ -404,16 +404,16 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ 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 + 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 + (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 -> + | Some mmt -> im.im_module <- Some mmt ; (true, acc_incomplete_top_module_names, acc_names_not_found) ) @@ -426,9 +426,9 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) | Some ea -> match ea.ea_ex with - Some _ -> + Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) - | None -> + | None -> let ex_opt = try Some (lookup_exception ea.ea_name) with Not_found -> None @@ -443,7 +443,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ | 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 = + 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 = @@ -460,7 +460,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names 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 -> + | Some cct -> ic.ic_class <- Some cct ; (true, acc_inc2, acc_names2) in @@ -470,13 +470,13 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names ( match capp.capp_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cl_opt = try Some (lookup_class capp.capp_name) with Not_found -> None in match cl_opt with - None -> (acc_b, (Name.head c.cl_name) :: acc_inc, + 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 -> @@ -488,13 +488,13 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names ( match cco.cco_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cl_opt = try Some (lookup_class cco.cco_name) with Not_found -> None in match cl_opt with - None -> + None -> ( let clt_opt = try Some (lookup_class_type cco.cco_name) @@ -502,7 +502,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names in match clt_opt with None -> - (acc_b, (Name.head c.cl_name) :: acc_inc, + (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 -> @@ -526,7 +526,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names 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 = + 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 = @@ -540,10 +540,10 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ with Not_found -> None in match cct_opt with - None -> (acc_b2, (Name.head ct.clt_name) :: acc_inc2, + 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 -> + | Some cct -> ic.ic_class <- Some cct ; (true, acc_inc2, acc_names2) in @@ -553,15 +553,15 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ ( match cta.cta_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cct_opt = try Some (Cltype (lookup_class_type cta.cta_name, [])) - with Not_found -> + with Not_found -> try Some (Cl (lookup_class cta.cta_name)) with Not_found -> None in match cct_opt with - None -> (acc_b, (Name.head ct.clt_name) :: acc_inc, + 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 -> @@ -574,7 +574,7 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ (*************************************************************) (** Association of types to elements referenced in comments .*) -let ao = Odoc_misc.apply_opt +let ao = Odoc_misc.apply_opt let rec assoc_comments_text_elements module_list t_ele = match t_ele with @@ -615,7 +615,7 @@ let rec assoc_comments_text_elements module_list t_ele = ) | ele :: _ -> (* we look for the first element with this name *) - let kind = + let kind = match ele with Odoc_search.Res_module _ -> RK_module | Odoc_search.Res_module_type _ -> RK_module_type @@ -631,7 +631,7 @@ let rec assoc_comments_text_elements module_list t_ele = add_verified (name, Some kind) ; Ref (name, Some kind) ) - | Ref (name, Some kind) -> + | Ref (name, Some kind) -> ( let v = (name, Some kind) in if was_verified v then @@ -653,7 +653,7 @@ let rec assoc_comments_text_elements module_list t_ele = Ref (name, None) ) | _ -> - let (f,f_mes) = + let (f,f_mes) = match kind with RK_module -> module_exists, Odoc_messages.cross_module_not_found | RK_module_type -> module_type_exists, Odoc_messages.cross_module_type_not_found @@ -677,10 +677,11 @@ let rec assoc_comments_text_elements module_list t_ele = Ref (name, None) ) ) - | Module_list l -> + | Module_list l -> Module_list l | Index_list -> Index_list + | Custom (s,t) -> Custom (s, (assoc_comments_text module_list t)) and assoc_comments_text module_list text = List.map (assoc_comments_text_elements module_list) text @@ -696,8 +697,8 @@ and assoc_comments_info module_list i = i_raised_exceptions = List.map (fun (name, t) -> (name, ft t)) i.i_raised_exceptions; i_return_value = ao ft i.i_return_value ; i_custom = List.map (fun (tag, t) -> (tag, ft t)) i.i_custom ; - } - + } + let rec assoc_comments_module_element module_list m_ele = match m_ele with @@ -719,17 +720,17 @@ and assoc_comments_class_element module_list c_ele = and assoc_comments_module_kind module_list mk = match mk with - | Module_struct eles -> + | Module_struct eles -> Module_struct (List.map (assoc_comments_module_element module_list) eles) - | Module_alias _ - | Module_functor _ -> + | Module_alias _ + | Module_functor _ -> mk - | Module_apply (mk1, mk2) -> + | 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 (mtk, s) -> Module_with (assoc_comments_module_type_kind module_list mtk, s) - | Module_constraint (mk1, mtk) -> + | Module_constraint (mk1, mtk) -> Module_constraint (assoc_comments_module_kind module_list mk1, assoc_comments_module_type_kind module_list mtk) @@ -737,7 +738,7 @@ 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, mtk1) -> Module_type_functor (params, assoc_comments_module_type_kind module_list mtk1) | Module_type_alias _ -> mtk @@ -747,9 +748,9 @@ and assoc_comments_module_type_kind module_list mtk = and assoc_comments_class_kind module_list ck = match ck with Class_structure (inher, eles) -> - let inher2 = - List.map - (fun ic -> { ic with + let inher2 = + List.map + (fun ic -> { ic with ic_text = ao (assoc_comments_text module_list) ic.ic_text }) inher in @@ -764,9 +765,9 @@ and assoc_comments_class_kind module_list ck = and assoc_comments_class_type_kind module_list ctk = match ctk with Class_signature (inher, eles) -> - let inher2 = - List.map - (fun ic -> { ic with + let inher2 = + List.map + (fun ic -> { ic with ic_text = ao (assoc_comments_text module_list) ic.ic_text }) inher in @@ -785,7 +786,7 @@ and assoc_comments_module_type module_list mt = mt.mt_kind <- ao (assoc_comments_module_type_kind module_list) mt.mt_kind ; mt -and assoc_comments_class module_list c = +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; @@ -798,7 +799,7 @@ and assoc_comments_class_type module_list ct = and assoc_comments_parameter module_list p = match p with - Simple_name sn -> + 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 @@ -820,11 +821,11 @@ and assoc_comments_type module_list t = (match t.ty_kind with Type_abstract -> () | Type_variant (vl, _) -> - List.iter + List.iter (fun vc -> vc.vc_text <- ao (assoc_comments_text module_list) vc.vc_text) - vl + vl | Type_record (fl, _) -> - List.iter + List.iter (fun rf -> rf.rf_text <- ao (assoc_comments_text module_list) rf.rf_text) fl ); @@ -856,7 +857,7 @@ let associate module_list = else remove_doubles (h :: acc) q in let rec iter incomplete_modules = - let (b_modif, remaining_inc_modules, acc_names_not_found) = + 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 @@ -877,7 +878,7 @@ let associate module_list = [] -> () | l -> - List.iter + List.iter (fun nf -> Odoc_messages.pwarning ( @@ -896,6 +897,6 @@ let associate module_list = (* Find a type for each name of element which is referenced in comments. *) ignore (associate_type_of_elements_in_comments module_list) - + (* eof $Id$ *) |