diff options
-rw-r--r-- | ocamldoc/odoc_ast.ml | 86 | ||||
-rw-r--r-- | ocamldoc/odoc_env.ml | 9 | ||||
-rw-r--r-- | ocamldoc/odoc_sig.ml | 81 |
3 files changed, 169 insertions, 7 deletions
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 337592c85..4b5c0ee13 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -66,8 +66,13 @@ module Typedtree_search = match tt with | Typedtree.Tstr_module (ident, _) -> Hashtbl.add table (M (Name.from_ident ident)) tt - | Typedtree.Tstr_recmodule bindings -> - assert false (* to be fixed *) + | Typedtree.Tstr_recmodule mods -> + List.iter + (fun (ident,mod_expr) -> + Hashtbl.add table (M (Name.from_ident ident)) + (Typedtree.Tstr_module (ident,mod_expr)) + ) + mods | Typedtree.Tstr_modtype (ident, _) -> Hashtbl.add table (MT (Name.from_ident ident)) tt | Typedtree.Tstr_exception (ident, _) -> @@ -1106,8 +1111,69 @@ module Analyser = raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) ) - | Parsetree.Pstr_recmodule bindings -> - assert false (* to be fixed *) + | Parsetree.Pstr_recmodule mods -> + let new_env = + List.fold_left + (fun acc_env (name, _, mod_exp) -> + let complete_name = Name.concat current_module_name name in + let e = Odoc_env.add_module acc_env complete_name in + let tt_mod_exp = + try Typedtree_search.search_module table name + with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) + in + let new_module = analyse_module + e + current_module_name + name + None + mod_exp + tt_mod_exp + in + match new_module.m_type with + Types.Tmty_signature s -> + Odoc_env.add_signature e new_module.m_name + ~rel: (Name.simple new_module.m_name) s + | _ -> + e + ) + env + mods + in + let rec f ?(first=false) last_pos name_mod_exp_list = + match name_mod_exp_list with + [] -> [] + | (name, _, mod_exp) :: q -> + let complete_name = Name.concat current_module_name name in + let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in + let pos_limit2 = + match q with + [] -> pos_limit + | (_, _, me) :: _ -> me.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum + in + let tt_mod_exp = + try Typedtree_search.search_module table name + with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) + in + let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) + if first then + (comment_opt, []) + else + get_comments_in_module last_pos loc_start + in + let new_module = analyse_module + new_env + current_module_name + name + com_opt + mod_exp + tt_mod_exp + in + let eles = f loc_end q in + ele_comments @ ((Element_module new_module) :: eles) + in + let eles = f ~first: true loc.Location.loc_start.Lexing.pos_cnum mods in + (0, new_env, eles) | Parsetree.Pstr_modtype (name, modtype) -> let complete_name = Name.concat current_module_name name in @@ -1367,6 +1433,18 @@ module Analyser = *) } + | (Parsetree.Pmod_structure p_structure, + Typedtree.Tmod_constraint + ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure}, + tt_modtype, _) + ) -> + (* needed for recursive modules *) + let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in + (* we must complete the included modules *) + let included_modules_from_tt = tt_get_included_module_list tt_structure in + let elements2 = replace_dummy_included_modules elements included_modules_from_tt in + { m_base with m_kind = Module_struct elements2 } + | _ -> raise (Failure "analyse_module: parsetree and typedtree don't match.") diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index a9432a5af..5294d0ca1 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -171,9 +171,14 @@ let full_class_or_class_type_name env n = try List.assoc n env.env_classes with Not_found -> full_class_type_name env n +let print_env_types env = + List.iter (fun (s1,s2) -> Printf.printf "%s = %s\n" s1 s2) env.env_types + let subst_type env t = -(** print_string "Odoc_env.subst_type"; - print_newline (); +(* + print_string "Odoc_env.subst_type\n"; + print_env_types env ; + print_newline (); *) Printtyp.mark_loops t; let deja_vu = ref [] in diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 59bdbcdad..6b4656e23 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -708,7 +708,86 @@ module Analyser = (maybe_more, new_env2, [ Element_module new_module ]) | Parsetree.Psig_recmodule decls -> - assert false (* to be fixed *) + (* we start by extending the environment *) + let new_env = + List.fold_left + (fun acc_env -> fun (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 + (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) + Types.Tmty_signature s -> + Odoc_env.add_signature e complete_name ~rel: name s + | _ -> + print_DEBUG "not a Tmty_signature"; + 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, []) + | (name, modtype) :: q -> + let complete_name = Name.concat current_module_name name 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 (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 + | (_, mty) :: _ -> mty.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum + 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 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 (!file_name, pos_start_ele) } ; + m_top_deps = [] ; + } + in + let (maybe_more, info_after_opt) = + My_ir.just_after_special + !file_name + (get_string_of_file loc_end pos_limit2) + in + new_module.m_info <- merge_infos new_module.m_info info_after_opt ; + + 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 (name, Parsetree.Pmodtype_abstract) -> let sig_mtype = |