diff options
Diffstat (limited to 'ocamldoc/odoc_cross.ml')
| -rw-r--r-- | ocamldoc/odoc_cross.ml | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index 70c3c0eb2..28e6ae5bf 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -15,6 +15,7 @@ module Name = Odoc_name open Odoc_module open Odoc_class +open Odoc_extension open Odoc_exception open Odoc_types open Odoc_value @@ -60,6 +61,7 @@ module P_alias = let p_recfield _ _ _ = false let p_const _ _ _ = false let p_type t _ = (false, false) + let p_extension x _ = x.xt_alias <> None let p_exception e _ = e.ex_alias <> None let p_attribute a _ = false let p_method m _ = false @@ -79,6 +81,9 @@ let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create (** Couples of module or module type name aliases. *) let module_and_modtype_aliases = Hashtbl.create 13;; +(** Couples of extension name aliases. *) +let extension_aliases = Hashtbl.create 13;; + (** Couples of exception name aliases. *) let exception_aliases = Hashtbl.create 13;; @@ -102,6 +107,15 @@ let rec build_alias_list = function | _ -> () ); build_alias_list q + | (Odoc_search.Res_extension x) :: q -> + ( + match x.xt_alias with + None -> () + | Some xa -> + Hashtbl.add extension_aliases + x.xt_name (xa.xa_name,Alias_to_resolve) + ); + build_alias_list q | (Odoc_search.Res_exception e) :: q -> ( match e.ex_alias with @@ -119,6 +133,7 @@ let rec build_alias_list = function let get_alias_names module_list = Hashtbl.clear module_aliases; Hashtbl.clear module_and_modtype_aliases; + Hashtbl.clear extension_aliases; Hashtbl.clear exception_aliases; build_alias_list (Search_alias.search module_list 0) @@ -183,6 +198,7 @@ let kind_name_exists kind = | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false) | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false) + | RK_extension -> (fun e -> match e with Odoc_search.Res_extension _ -> true | _ -> false) | RK_exception -> (fun e -> match e with Odoc_search.Res_exception _ -> true | _ -> false) | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false) | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false) @@ -200,6 +216,7 @@ let class_exists = kind_name_exists RK_class let class_type_exists = kind_name_exists RK_class_type let value_exists = kind_name_exists RK_value let type_exists = kind_name_exists RK_type +let extension_exists = kind_name_exists RK_extension let exception_exists = kind_name_exists RK_exception let attribute_exists = kind_name_exists RK_attribute let method_exists = kind_name_exists RK_method @@ -238,6 +255,14 @@ let lookup_class_type name = | Odoc_search.Res_class_type c -> c | _ -> assert false +let lookup_extension name = + match List.find + (fun k -> match k with Odoc_search.Res_extension _ -> true | _ -> false) + (get_known_elements name) + with + | Odoc_search.Res_extension x -> x + | _ -> assert false + let lookup_exception name = match List.find (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) @@ -262,6 +287,8 @@ class scan = method! scan_type_pre t = add_known_element t.ty_name (Odoc_search.Res_type t); true + method! scan_extension_constructor x = + add_known_element x.xt_name (Odoc_search.Res_extension x) method! scan_exception e = add_known_element e.ex_name (Odoc_search.Res_exception e) method! scan_attribute a = @@ -298,6 +325,7 @@ type not_found_name = | NF_c of Name.t | NF_ct of Name.t | NF_cct of Name.t + | NF_xt of Name.t | NF_ex of Name.t (** Functions to find and associate aliases elements. *) @@ -466,6 +494,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ | 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_type_extension te -> associate_in_type_extension module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te | Element_exception ex -> ( match ex.ex_alias with @@ -617,6 +646,29 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ in iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct.clt_kind +and associate_in_type_extension module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te = + List.fold_left + (fun (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) xt -> + match xt.xt_alias with + None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) + | Some xa -> + match xa.xa_xt with + Some _ -> + (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) + | None -> + let xt_opt = + try Some (lookup_extension xa.xa_name) + with Not_found -> None + in + match xt_opt with + None -> (acc_b_modif, (Name.head xt.xt_name) :: acc_incomplete_top_module_names, (NF_xt xa.xa_name) :: acc_names_not_found) + | Some x -> + xa.xa_xt <- Some x ; + (true, acc_incomplete_top_module_names, acc_names_not_found)) + (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) + te.te_constructors + + (*************************************************************) (** Association of types to elements referenced in comments .*) @@ -630,6 +682,7 @@ let not_found_of_kind kind name = | RK_class_type -> Odoc_messages.cross_class_type_not_found | RK_value -> Odoc_messages.cross_value_not_found | RK_type -> Odoc_messages.cross_type_not_found + | RK_extension -> Odoc_messages.cross_extension_not_found | RK_exception -> Odoc_messages.cross_exception_not_found | RK_attribute -> Odoc_messages.cross_attribute_not_found | RK_method -> Odoc_messages.cross_method_not_found @@ -687,6 +740,7 @@ let rec assoc_comments_text_elements parent_name module_list t_ele = | Odoc_search.Res_class_type ct -> (ct.clt_name, RK_class_type) | Odoc_search.Res_value v -> (v.val_name, RK_value) | Odoc_search.Res_type t -> (t.ty_name, RK_type) + | Odoc_search.Res_extension x -> (x.xt_name, RK_extension) | Odoc_search.Res_exception e -> (e.ex_name, RK_exception) | Odoc_search.Res_attribute a -> (a.att_value.val_name, RK_attribute) | Odoc_search.Res_method m -> (m.met_value.val_name, RK_method) @@ -747,6 +801,7 @@ let rec assoc_comments_text_elements parent_name module_list t_ele = | RK_class_type -> class_type_exists | RK_value -> value_exists | RK_type -> type_exists + | RK_extension -> extension_exists | RK_exception -> exception_exists | RK_attribute -> attribute_exists | RK_method -> method_exists @@ -817,6 +872,8 @@ let rec assoc_comments_module_element parent_name module_list m_ele = Element_class_type (assoc_comments_class_type module_list ct) | Element_value v -> Element_value (assoc_comments_value module_list v) + | Element_type_extension te -> + Element_type_extension (assoc_comments_type_extension parent_name module_list te) | Element_exception e -> Element_exception (assoc_comments_exception module_list e) | Element_type t -> @@ -938,6 +995,15 @@ and assoc_comments_value module_list v = assoc_comments_parameter_list parent module_list v.val_parameters; v +and assoc_comments_extension_constructor module_list x = + let parent = Name.father x.xt_name in + x.xt_text <- ao (assoc_comments_info parent module_list) x.xt_text + +and assoc_comments_type_extension parent_name module_list te = + te.te_info <- ao (assoc_comments_info parent_name module_list) te.te_info; + List.iter (assoc_comments_extension_constructor module_list) te.te_constructors; + te + and assoc_comments_exception module_list e = let parent = Name.father e.ex_name in e.ex_info <- ao (assoc_comments_info parent module_list) e.ex_info ; @@ -956,6 +1022,7 @@ and assoc_comments_type module_list t = List.iter (fun rf -> rf.rf_text <- ao (assoc_comments_info parent module_list) rf.rf_text) fl + | Type_open -> () ); t @@ -1018,6 +1085,7 @@ let associate module_list = | 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_xt n -> Odoc_messages.cross_extension_not_found n | NF_ex n -> Odoc_messages.cross_exception_not_found n ); ) |