diff options
Diffstat (limited to 'ocamldoc/odoc_sig.ml')
| -rw-r--r-- | ocamldoc/odoc_sig.ml | 95 |
1 files changed, 66 insertions, 29 deletions
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 74de957ed..ea42ddb7b 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -257,6 +257,38 @@ module Analyser = in Odoc_type.Type_record (List.map f l) + let erased_names_of_constraints constraints acc = + List.fold_right (fun (longident, constraint_) acc -> + match constraint_ with + | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc + | Parsetree.Pwith_typesubst _ | Parsetree.Pwith_modsubst _ -> + Name.Set.add (Name.from_longident longident.txt) acc) + constraints acc + + let filter_out_erased_items_from_signature erased signature = + if Name.Set.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_value (_, _) + | Parsetree.Psig_exception (_, _) + | Parsetree.Psig_open _ + | Parsetree.Psig_include _ + | Parsetree.Psig_class _ + | Parsetree.Psig_class_type _ as tp -> take_item tp + | Parsetree.Psig_type types -> + (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) types with + | [] -> acc + | types -> take_item (Parsetree.Psig_type types)) + | Parsetree.Psig_module (name, _) + | Parsetree.Psig_modtype (name, _) as m -> + if Name.Set.mem name.txt erased then acc else take_item m + | Parsetree.Psig_recmodule mods -> + (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt 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 @@ -292,7 +324,7 @@ module Analyser = val_recursive = false ; val_parameters = Odoc_value.dummy_parameter_list subst_typ ; val_code = None ; - val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) }; + val_loc = { loc_impl = None ; loc_inter = Some loc }; } ; met_private = private_flag = Asttypes.Private ; met_virtual = false ; @@ -352,7 +384,7 @@ module Analyser = val_recursive = false ; val_parameters = [] ; val_code = None ; - val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ; + val_loc = { loc_impl = None ; loc_inter = Some loc} ; } ; att_mutable = mutable_flag = Asttypes.Mutable ; att_virtual = virtual_flag = Asttypes.Virtual ; @@ -466,6 +498,7 @@ module Analyser = signat table current_module_name + ele.Parsetree.psig_loc ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum (match q with @@ -488,7 +521,7 @@ module Analyser = (** 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 - pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc = + sig_item_loc pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc = match sig_item_desc with Parsetree.Psig_value (name_pre, value_desc) -> let type_expr = @@ -506,7 +539,7 @@ module Analyser = val_recursive = false ; val_parameters = Odoc_value.dummy_parameter_list subst_typ ; val_code = None ; - val_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele)} + val_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; } in let (maybe_more, info_after_opt) = @@ -533,7 +566,7 @@ module Analyser = ex_info = comment_opt ; ex_args = List.map (Odoc_env.subst_type env) types_excep_decl.exn_args ; ex_alias = None ; - ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; ex_code = ( if !Odoc_global.keep_code then @@ -618,10 +651,7 @@ module Analyser = (match sig_type_decl.Types.type_manifest with None -> None | Some t -> Some (Odoc_env.subst_type new_env t)); - ty_loc = - { loc_impl = None ; - loc_inter = Some (!file_name,loc_start) ; - }; + ty_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; ty_code = ( if !Odoc_global.keep_code then @@ -683,7 +713,7 @@ module Analyser = m_is_interface = true ; m_file = !file_name ; m_kind = module_kind ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + m_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; @@ -734,8 +764,9 @@ module Analyser = (acc_maybe_more, []) | (name, modtype) :: q -> let complete_name = Name.concat current_module_name name.txt in - let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in - let loc_end = modtype.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let loc = modtype.Parsetree.pmty_loc in + let loc_start = loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = loc.Location.loc_end.Lexing.pos_cnum in let (assoc_com, ele_comments) = if first then (comment_opt, []) @@ -747,7 +778,7 @@ module Analyser = let pos_limit2 = match q with [] -> pos_limit - | (_, mty) :: _ -> mty.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum + | (_, mty) :: _ -> loc.Location.loc_start.Lexing.pos_cnum in (* get the information for the module in the signature *) let sig_module_type = @@ -759,7 +790,6 @@ module Analyser = 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 loc = modtype.Parsetree.pmty_loc in let st = loc.Location.loc_start.Lexing.pos_cnum in let en = loc.Location.loc_end.Lexing.pos_cnum in Some (get_string_of_file st en) @@ -774,7 +804,7 @@ module Analyser = m_is_interface = true ; m_file = !file_name ; m_kind = module_kind ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + m_loc = { loc_impl = None ; loc_inter = Some loc } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; @@ -822,7 +852,7 @@ module Analyser = mt_is_interface = true ; mt_file = !file_name ; mt_kind = module_type_kind ; - mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + mt_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; } in let (maybe_more, info_after_opt) = @@ -863,7 +893,7 @@ module Analyser = im_info = comment_opt; } in - (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *) + (0, env, [ Element_included_module im ]) (* A VOIR : etendre l'environnement ? avec quoi ? *) | Parsetree.Psig_class class_description_list -> (* we start by extending the environment *) @@ -920,7 +950,7 @@ module Analyser = cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ; cl_kind = class_kind ; cl_parameters = parameters ; - cl_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + cl_loc = { loc_impl = None ; loc_inter = Some class_desc.Parsetree.pci_loc } ; } in let (maybe_more, info_after_opt) = @@ -994,7 +1024,7 @@ module Analyser = 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 (!file_name, pos_start_ele) } ; + clt_loc = { loc_impl = None ; loc_inter = Some ct_decl.Parsetree.pci_loc } ; } in let (maybe_more, info_after_opt) = @@ -1015,7 +1045,8 @@ module Analyser = (maybe_more, new_env, eles) (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *) - and analyse_module_type_kind env current_module_name module_type sig_module_type = + and analyse_module_type_kind + ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type = match module_type.Parsetree.pmty_desc with Parsetree.Pmty_ident longident -> let name = @@ -1029,6 +1060,7 @@ module Analyser = | Parsetree.Pmty_signature ast -> ( + let ast = filter_out_erased_items_from_signature erased ast in (* we must have a signature in the module type *) match sig_module_type with Types.Mty_signature signat -> @@ -1059,7 +1091,7 @@ module Analyser = mp_kind = mp_kind ; } in - let k = analyse_module_type_kind env + let k = analyse_module_type_kind ~erased env current_module_name module_type2 body_module_type @@ -1071,13 +1103,15 @@ module Analyser = raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _") ) - | Parsetree.Pmty_with (module_type2, _) -> + | Parsetree.Pmty_with (module_type2, constraints) -> (* of module_type * (Longident.t * with_constraint) list *) ( let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let s = get_string_of_file loc_start loc_end in - let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type 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) ) @@ -1088,7 +1122,8 @@ module Analyser = Module_type_typeof s (** analyse of a Parsetree.module_type and a Types.module_type.*) - and analyse_module_kind env current_module_name module_type sig_module_type = + and analyse_module_kind + ?(erased = Name.Set.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 @@ -1096,6 +1131,7 @@ module Analyser = | Parsetree.Pmty_signature signature -> ( + let signature = filter_out_erased_items_from_signature erased signature in match sig_module_type with Types.Mty_signature signat -> Module_struct @@ -1130,7 +1166,7 @@ module Analyser = mp_kind = mp_kind ; } in - let k = analyse_module_kind env + let k = analyse_module_kind ~erased env current_module_name module_type2 body_module_type @@ -1141,13 +1177,14 @@ module Analyser = (* if we're here something's wrong *) raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _") ) - | Parsetree.Pmty_with (module_type2, _) -> + | Parsetree.Pmty_with (module_type2, constraints) -> (*of module_type * (Longident.t * with_constraint) list*) ( let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let s = get_string_of_file loc_start loc_end in - let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type 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 -> @@ -1202,7 +1239,7 @@ module Analyser = ) else ( - raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents") + raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels differents") ) | _ -> @@ -1304,7 +1341,7 @@ module Analyser = m_is_interface = true ; m_file = !file_name ; m_kind = Module_struct elements ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ; + m_loc = { loc_impl = None ; loc_inter = Some (Location.in_file !file_name) } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; |