diff options
Diffstat (limited to 'ocamldoc')
| -rw-r--r-- | ocamldoc/odoc_ast.ml | 12 | ||||
| -rw-r--r-- | ocamldoc/odoc_env.ml | 22 | ||||
| -rw-r--r-- | ocamldoc/odoc_env.mli | 6 | ||||
| -rw-r--r-- | ocamldoc/odoc_html.ml | 269 | ||||
| -rw-r--r-- | ocamldoc/odoc_info.ml | 4 | ||||
| -rw-r--r-- | ocamldoc/odoc_info.mli | 19 | ||||
| -rw-r--r-- | ocamldoc/odoc_latex.ml | 128 | ||||
| -rw-r--r-- | ocamldoc/odoc_man.ml | 167 | ||||
| -rw-r--r-- | ocamldoc/odoc_misc.ml | 46 | ||||
| -rw-r--r-- | ocamldoc/odoc_misc.mli | 16 | ||||
| -rw-r--r-- | ocamldoc/odoc_module.ml | 5 | ||||
| -rw-r--r-- | ocamldoc/odoc_sig.ml | 10 | ||||
| -rw-r--r-- | ocamldoc/odoc_to_text.ml | 10 |
13 files changed, 219 insertions, 495 deletions
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 0485663e50..1b11ba14fd 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -917,7 +917,7 @@ module Analyser = let pos_start = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc.Location.loc_start in let type_parameters = tt_type_params in let virt = p_class_decl.Parsetree.pci_virt = Asttypes.Virtual in - let cltype = tt_class_exp.Typedtree.cl_type in + let cltype = Odoc_env.subst_class_type env tt_class_exp.Typedtree.cl_type in let (parameters, kind) = analyse_class_kind env complete_name @@ -1233,7 +1233,7 @@ module Analyser = let new_env2 = match new_module.m_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) - Some (Types.Tmty_signature s) -> + Types.Tmty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> @@ -1374,7 +1374,7 @@ module Analyser = { clt_name = complete_name ; clt_info = com_opt ; - clt_type = tt_cltype_declaration.Types.clty_type ; + clt_type = Odoc_env.subst_class_type env tt_cltype_declaration.Types.clty_type ; clt_type_parameters = List.map (Odoc_env.subst_type new_env) type_params ; clt_virtual = virt ; clt_kind = kind ; @@ -1407,7 +1407,7 @@ module Analyser = let m_base = { m_name = complete_name ; - m_type = Some tt_module_expr.Typedtree.mod_type ; + m_type = tt_module_expr.Typedtree.mod_type ; m_info = comment_opt ; m_is_interface = false ; m_file = !file_name ; @@ -1495,7 +1495,7 @@ module Analyser = in { m_base with - m_type = Some tt_modtype ; + m_type = tt_modtype ; m_kind = Module_constraint (m_base2.m_kind, mtkind) @@ -1534,7 +1534,7 @@ module Analyser = let m = { m_name = mod_name ; - m_type = None ; + m_type = Types.Tmty_signature [] ; m_info = info_opt ; m_is_interface = false ; m_file = !file_name ; diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index d492af9854..0c43f9d21d 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -249,9 +249,6 @@ let subst_type env t = (t, new_deja_vu) in let (res, _) = iter [] t in -(** print_string "Odoc_env.subst_type fini"; - print_newline (); -*) res let subst_module_type env t = @@ -267,5 +264,20 @@ let subst_module_type env t = in iter t - - +let subst_class_type env t = + let rec iter t = + match t with + Types.Tcty_constr (p,texp_list,ct) -> + let new_p = Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in + let new_texp_list = List.map (subst_type env) texp_list in + let new_ct = iter ct in + Types.Tcty_constr (new_p, new_texp_list, new_ct) + | Types.Tcty_signature cs -> + (* on ne s'occupe pas des vals et methods *) + t + | Types.Tcty_fun (l, texp, ct) -> + let new_texp = subst_type env texp in + let new_ct = iter ct in + Types.Tcty_fun (l, new_texp, new_ct) + in + iter t diff --git a/ocamldoc/odoc_env.mli b/ocamldoc/odoc_env.mli index 99b292b572..698a3877a3 100644 --- a/ocamldoc/odoc_env.mli +++ b/ocamldoc/odoc_env.mli @@ -67,3 +67,9 @@ val subst_type : env -> Types.type_expr -> Types.type_expr (** Replace the [Path.t] by a complete [Path.t] in a [Types.module_type].*) val subst_module_type : env -> Types.module_type -> Types.module_type + +(** Replace the [Path.t] by a complete [Path.t] in a [Types.class_type]. + Also empty the structures to get only [object end] when the type + is printed. +*) +val subst_class_type : env -> Types.class_type -> Types.class_type diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 1acce3e3eb..e742219e04 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -494,14 +494,6 @@ class html = ".title4 { font-size : 20pt ; background-color : #41CDFF }" ; ".title5 { font-size : 20pt ; background-color : #41EDFF }" ; ".title6 { font-size : 20pt ; background-color : #41FFFF }" ; -(* - ".title1 { font-size : 20pt ; background-color : #AAFF44 }" ; - ".title2 { font-size : 20pt ; background-color : #AAFF66 }" ; - ".title3 { font-size : 20pt ; background-color : #AAFF99 }" ; - ".title4 { font-size : 20pt ; background-color : #AAFFCC }" ; - ".title5 { font-size : 20pt ; background-color : #AAFFFF }" ; - ".title6 { font-size : 20pt ; background-color : #DDFF44 }" ; -*) "body { background-color : White }" ; "tr { background-color : White }" ; ] @@ -762,6 +754,15 @@ class html = let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in "<code class=\"type\">"^(self#create_fully_qualified_idents_links m_name s2)^"</code>" + + (** Return html code to display a [Types.class_type].*) + method html_of_class_type_expr m_name t = + let s = String.concat "\n" + (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t)) + in + let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + "<code class=\"type\">"^(self#create_fully_qualified_idents_links m_name s2)^"</code>" + (** Return html code to display a [Types.type_expr list].*) method html_of_type_expr_list m_name sep l = print_DEBUG "html#html_of_type_expr_list"; @@ -782,14 +783,14 @@ class html = (** Generate a file containing the module type in the given file name. *) method output_module_type in_title file mtyp = let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type mtyp)) + (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type ~complete: true mtyp)) in self#output_code in_title file s (** Generate a file containing the class type in the given file name. *) method output_class_type in_title file ctyp = let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ctyp)) + (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ~complete: true ctyp)) in self#output_code in_title file s @@ -1107,117 +1108,49 @@ class html = "</tr>\n"^ "</table>\n" - (** Return html code for a [module_kind]. *) - method html_of_module_kind ?(with_def_syntax=true) k = - match k with - Module_alias m_alias -> - (match m_alias.ma_module with - None -> - (if with_def_syntax then " = " else "")^ - m_alias.ma_name - | Some (Mod m) -> - let (html_file,_) = Naming.html_files m.m_name in - (if with_def_syntax then " = " else "")^ - "<a href=\""^html_file^"\">"^m.m_name^"</a>" - | Some (Modtype mt) -> - let (html_file,_) = Naming.html_files mt.mt_name in - (if with_def_syntax then " : " else "")^ - "<a href=\""^html_file^"\">"^mt.mt_name^"</a>" - ) - | Module_apply (k1, k2) -> - (if with_def_syntax then " = " else "")^ - (self#html_of_module_kind ~with_def_syntax: false k1)^ - " ( "^(self#html_of_module_kind ~with_def_syntax: false k2)^" ) " - - | Module_with (tk, code) -> - (if with_def_syntax then " : " else "")^ - (self#html_of_module_type_kind ~with_def_syntax: false tk)^ - (self#html_of_code ~with_pre: false code) - - | Module_constraint (k, tk) -> - (if with_def_syntax then " = " else "")^ - "( "^(self#html_of_module_kind ~with_def_syntax: false k)^" : "^ - (self#html_of_module_type_kind ~with_def_syntax: false tk)^" )" - - | Module_struct _ -> - (if with_def_syntax then " = " else "")^ - (self#html_of_code ~with_pre: false (Odoc_messages.struct_end^" ")) - - | Module_functor (_, k) -> - (if with_def_syntax then " = " else "")^ - (self#html_of_code ~with_pre: false "functor ... ")^ - " -> "^(self#html_of_module_kind ~with_def_syntax: false k) - - (** Return html code for a [module_type_kind]. *) - method html_of_module_type_kind ?(with_def_syntax=true) tk = - match tk with - | Module_type_struct _ -> - (if with_def_syntax then " : " else "")^ - (self#html_of_code ~with_pre: false Odoc_messages.sig_end) - - | Module_type_functor (params, k) -> - let f p = "("^p.mp_name^" : "^(self#html_of_module_type "" p.mp_type)^") -> " in - let s1 = String.concat "" (List.map f params) in - let s2 = self#html_of_module_type_kind ~with_def_syntax: false k in - (if with_def_syntax then " : " else "")^s1^s2 - - | Module_type_with (tk2, code) -> - let s = self#html_of_module_type_kind ~with_def_syntax: false tk2 in - (if with_def_syntax then " : " else "")^ - s^(self#html_of_code ~with_pre: false code) - - | Module_type_alias mt_alias -> - (if with_def_syntax then " : " else "")^ - (match mt_alias.mta_module with - None -> - mt_alias.mta_name - | Some mt -> - let (html_file,_) = Naming.html_files mt.mt_name in - "<a href=\""^html_file^"\">"^mt.mt_name^"</a>" - ) - (** Return html code for a module. *) method html_of_module ?(info=true) ?(complete=true) ?(with_link=true) m = let (html_file, _) = Naming.html_files m.m_name in - let s1 = - "<pre>"^(self#keyword "module")^" "^ - ( - if with_link then - "<a href=\""^html_file^"\">"^(Name.simple m.m_name)^"</a>" - else - Name.simple m.m_name - )^ - (self#html_of_module_kind m.m_kind)^ - "</pre>" - in - let s2 = - if info then - (if complete then self#html_of_info else self#html_of_info_first_sentence) m.m_info - else - "" - in - s1^s2 + let father = Name.father m.m_name in + let buf = Buffer.create 32 in + let p = Printf.bprintf in + p buf "<pre>%s " (self#keyword "module"); + ( + if with_link then + p buf "<a href=\"%s\">%s</a>" html_file (Name.simple m.m_name) + else + p buf "%s" (Name.simple m.m_name) + ); + p buf ": %s</pre>" (self#html_of_module_type father m.m_type); + if info then + p buf "%s" ((if complete then self#html_of_info else self#html_of_info_first_sentence) m.m_info) + else + (); + Buffer.contents buf (** Return html code for a module type. *) method html_of_modtype ?(info=true) ?(complete=true) ?(with_link=true) mt = let (html_file, _) = Naming.html_files mt.mt_name in - "<pre>"^(self#keyword "module type")^" "^ + let father = Name.father mt.mt_name in + let buf = Buffer.create 32 in + let p = Printf.bprintf in + p buf "<pre>%s " (self#keyword "module type"); ( if with_link then - "<a href=\""^html_file^"\">"^(Name.simple mt.mt_name)^"</a>" + p buf "<a href=\"%s\">%s</a>" html_file (Name.simple mt.mt_name) else - Name.simple mt.mt_name - )^ - (match mt.mt_kind with - | Some tk -> self#html_of_module_type_kind tk - | None -> "" - )^ - "</pre>"^ - (if info then - (if complete then self#html_of_info else self#html_of_info_first_sentence) mt.mt_info + p buf "%s" (Name.simple mt.mt_name) + ); + (match mt.mt_type with + None -> () + | Some mtyp -> p buf " = %s" (self#html_of_module_type father mtyp) + ); + Buffer.add_string buf "</pre>"; + if info then + p buf "%s" ((if complete then self#html_of_info else self#html_of_info_first_sentence) mt.mt_info) else - "" - ) + (); + Buffer.contents buf (** Return html code for an included module. *) method html_of_included_module im = @@ -1240,81 +1173,9 @@ class html = )^ "</pre>\n" - (** Return html code for the given [class_kind].*) - method html_of_class_kind father ckind = - print_DEBUG "html#html_of_class_kind"; - match ckind with - Class_structure _ -> - (self#html_of_code ~with_pre: false Odoc_messages.object_end) - - | Class_apply capp -> - ( - match capp.capp_class with - None -> capp.capp_name - | Some cl -> - let (html_file, _) = Naming.html_files cl.cl_name in - "<a href=\""^html_file^"\">"^cl.cl_name^"</a>" - )^ - " "^ - (String.concat " " - (List.map - (fun s -> self#html_of_code ~with_pre: false ("("^s^")")) - capp.capp_params_code)) - - | Class_constr cco -> - ( - match cco.cco_type_parameters with - [] -> "" - | l -> "["^(self#html_of_type_expr_list father ", " l)^"] " - )^ - ( - match cco.cco_class with - None -> cco.cco_name - | Some (Cl cl) -> - let (html_file, _) = Naming.html_files cl.cl_name in - let rel = Name.get_relative father cl.cl_name in - "<a href=\""^html_file^"\">"^rel^"</a> " - | Some (Cltype (clt,_)) -> - let (html_file, _) = Naming.html_files clt.clt_name in - let rel = Name.get_relative father clt.clt_name in - "<a href=\""^html_file^"\">"^rel^"</a> " - ) - | Class_constraint (ck, ctk) -> - "( "^(self#html_of_class_kind father ck)^ - " : "^ - (self#html_of_class_type_kind father ctk)^ - " )" - - (** Return html code for the given [class_type_kind].*) - method html_of_class_type_kind father ctkind = - match ctkind with - Class_type cta -> - ( - match cta.cta_type_parameters with - [] -> "" - | l -> "["^(self#html_of_type_expr_list father ", " l)^"] " - )^ - ( - match cta.cta_class with - None -> - if cta.cta_name = Odoc_messages.object_end then - self#html_of_code ~with_pre: false cta.cta_name - else - cta.cta_name - | Some (Cltype (clt, _)) -> - let (html_file, _) = Naming.html_files clt.clt_name in - let rel = Name.get_relative father clt.clt_name in - "<a href=\""^html_file^"\">"^rel^"</a>" - | Some (Cl cl) -> - let (html_file, _) = Naming.html_files cl.cl_name in - let rel = Name.get_relative father cl.cl_name in - "<a href=\""^html_file^"\">"^rel^"</a>" - ) - | Class_signature _ -> - self#html_of_code ~with_pre: false Odoc_messages.object_end - (** Return html code for a class. *) method html_of_class ?(complete=true) ?(with_link=true) c = + let father = Name.father c.cl_name in Odoc_info.reset_type_names (); let buf = Buffer.create 32 in let (html_file, _) = Naming.html_files c.cl_name in @@ -1335,7 +1196,7 @@ class html = [] -> () | l -> p buf "[%s] " - (self#html_of_type_expr_list (Name.father c.cl_name) ", " l) + (self#html_of_type_expr_list father ", " l) ); print_DEBUG "html#html_of_class : with link or not" ; ( @@ -1346,14 +1207,7 @@ class html = ); Buffer.add_string buf " : " ; - - List.iter - (fun param -> - p buf "%s -> " (self#html_of_parameter (Name.father c.cl_name) param)) - c.cl_parameters; - - print_DEBUG "html#html_of_class : class kind" ; - Buffer.add_string buf (self#html_of_class_kind (Name.father c.cl_name) c.cl_kind); + Buffer.add_string buf (self#html_of_class_type_expr father c.cl_type); Buffer.add_string buf "</pre>" ; print_DEBUG "html#html_of_class : info" ; Buffer.add_string buf @@ -1363,6 +1217,7 @@ class html = (** Return html code for a class type. *) method html_of_class_type ?(complete=true) ?(with_link=true) ct = Odoc_info.reset_type_names (); + let father = Name.father ct.clt_name in let buf = Buffer.create 32 in let p = Printf.bprintf in let (html_file, _) = Naming.html_files ct.clt_name in @@ -1379,7 +1234,7 @@ class html = ( match ct.clt_type_parameters with [] -> () - | l -> p buf "[%s] " (self#html_of_type_expr_list (Name.father ct.clt_name) ", " l) + | l -> p buf "[%s] " (self#html_of_type_expr_list father ", " l) ); if with_link then @@ -1388,7 +1243,7 @@ class html = p buf "%s" (Name.simple ct.clt_name); Buffer.add_string buf " = "; - Buffer.add_string buf (self#html_of_class_type_kind (Name.father ct.clt_name) ct.clt_kind); + Buffer.add_string buf (self#html_of_class_type_expr father ct.clt_type); Buffer.add_string buf "</pre>"; Buffer.add_string buf ((if complete then self#html_of_info else self#html_of_info_first_sentence) ct.clt_info); @@ -1419,15 +1274,6 @@ class html = (** Return html code for a module comment.*) method html_of_module_comment text = "<br>\n"^(self#html_of_text text)^"<br><br>\n" -(* - (* Add some style if there is no style for the first part of the text. *) - let text2 = - match text with - | (Odoc_info.Raw s) :: q -> (Odoc_info.Title (2, [Odoc_info.Raw s])) :: q - | _ -> text - in - self#html_of_text text2 -*) (** Return html code for a class comment.*) method html_of_class_comment text = @@ -1704,10 +1550,7 @@ class html = (self#navbar pre_name post_name modu.m_name)^ "<center><h1>"^(if Module.module_is_functor modu then Odoc_messages.functo else Odoc_messages.modul)^ " "^ - (match modu.m_type with - Some _ -> "<a href=\""^type_file^"\">"^modu.m_name^"</a>" - | None-> modu.m_name - )^ + "<a href=\""^type_file^"\">"^modu.m_name^"</a>"^ "</h1></center>\n"^ "<br>\n"^ (self#html_of_module ~with_link: false modu) @@ -1755,14 +1598,10 @@ class html = generate_elements self#generate_for_class_type (Module.module_class_types modu); (* generate the file with the complete module type *) - ( - match modu.m_type with - None -> () - | Some mty -> self#output_module_type - modu.m_name - (Filename.concat !Odoc_args.target_dir type_file) - mty - ) + self#output_module_type + modu.m_name + (Filename.concat !Odoc_args.target_dir type_file) + modu.m_type with Sys_error s -> raise (Failure s) diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index 0248353459..3393b4bf5c 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -127,9 +127,9 @@ let string_of_type_expr t = Odoc_misc.string_of_type_expr t with a given separator. *) let string_of_type_list sep type_list = Odoc_misc.string_of_type_list sep type_list -let string_of_module_type t = Odoc_misc.string_of_module_type t +let string_of_module_type = Odoc_misc.string_of_module_type -let string_of_class_type t = Odoc_misc.string_of_class_type t +let string_of_class_type = Odoc_misc.string_of_class_type let string_of_text t = Odoc_misc.string_of_text t diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index 63199498e7..1202660088 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -433,9 +433,7 @@ module Module : and t_module = Odoc_module.t_module = { m_name : Name.t ; (** Complete name of the module. *) - m_type : Types.module_type option ; - (** The type of the module. - It is [None] when we had only the .ml file and it is a top module. *) + m_type : Types.module_type ; (** The type of the module. *) mutable m_info : info option ; (** Information found in the optional associated comment. *) m_is_interface : bool ; (** [true] for modules read from interface files *) m_file : string ; (** The file the module is defined in. *) @@ -602,11 +600,18 @@ val string_of_type_expr : Types.type_expr -> string with a given separator. It writes in and flushes [Format.str_formatter].*) val string_of_type_list : string -> Types.type_expr list -> string -(** This function returns a string representing a [Types.module_type]. *) -val string_of_module_type : Types.module_type -> string +(** This function returns a string representing a [Types.module_type]. + @param complete indicates if we must print complete signatures + or just [sig end]. Default if [false]. +*) +val string_of_module_type : ?complete: bool -> Types.module_type -> string + +(** This function returns a string representing a [Types.class_type]. + @param complete indicates if we must print complete signatures + or just [object end]. Default if [false]. +*) +val string_of_class_type : ?complete: bool -> Types.class_type -> string -(** This function returns a string representing a [Types.class_type]. *) -val string_of_class_type : Types.class_type -> string (** Get a string from a text. *) val string_of_text : text -> string diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 4144f50e51..fe3d0e396d 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -449,10 +449,16 @@ class latex = (** Return the LaTeX code for the given module. *) method latex_of_module ?(with_link=true) m = + let buf = Buffer.create 32 in + let f = Format.formatter_of_buffer buf in + let father = Name.father m.m_name in let t = - [Code "module "] @ - [Code (Name.simple m.m_name)] @ - (self#text_of_module_kind m.m_kind) @ + Format.fprintf f "module %s" (Name.simple m.m_name); + Format.fprintf f " = %s" + (self#normal_module_type father m.m_type); + Format.pp_print_flush f (); + + (CodePre (Buffer.contents buf)) :: ( if with_link then [Odoc_info.Latex ("\\\n["^(self#make_ref m.m_name)^"]")] @@ -463,13 +469,21 @@ class latex = (** Return the LaTeX code for the given module type. *) method latex_of_module_type ?(with_link=true) mt = + let buf = Buffer.create 32 in + let f = Format.formatter_of_buffer buf in + let father = Name.father mt.mt_name in let t = - [Code "module type "] @ - [Code (Name.simple mt.mt_name)] @ - (match mt.mt_kind with - None -> [] - | Some k -> self#text_of_module_type_kind k - ) @ + Format.fprintf f "module type %s" (Name.simple mt.mt_name); + (match mt.mt_type with + None -> () + | Some mtyp -> + Format.fprintf f " = %s" + (self#normal_module_type father mtyp) + ); + + Format.pp_print_flush f (); + + (CodePre (Buffer.contents buf)) :: ( if with_link then [Odoc_info.Latex ("\\\n["^(self#make_ref mt.mt_name)^"]")] @@ -488,88 +502,6 @@ class latex = | Some (Modtype mt) -> mt.mt_name) ] ) - (** Return a well-formatted code string for the given [class_kind].*) - method pre_of_class_kind f father ckind = - let p = Format.fprintf in - match ckind with - Class_structure _ -> - p f "%s" Odoc_messages.object_end - - | Class_apply capp -> - p f "%s" - (match capp.capp_class with - None -> capp.capp_name - | Some cl -> cl.cl_name - ); - List.iter - (fun s -> p f " (%s)" s) - capp.capp_params_code - - | Class_constr cco -> - (match cco.cco_type_parameters with - [] -> () - | l -> - p f "["; - let s = self#normal_type_list father ", " l in - p f "%s] " s - ); - p f "%s" - (match cco.cco_class with - None -> cco.cco_name - | Some (Cl cl) -> Name.get_relative father cl.cl_name - | Some (Cltype (clt, _)) -> Name.get_relative father clt.clt_name - ) - - | Class_constraint (ck, ctk) -> - p f "(" ; - self#pre_of_class_kind f father ck ; - p f " : " ; - self#pre_of_class_type_kind f father ctk ; - p f ")" - - (** Return well-formatted string for the given [class_type_kind].*) - method pre_of_class_type_kind f father ctkind = - let p = Format.fprintf in - match ctkind with - Class_type cta -> - ( - match cta.cta_type_parameters with - [] -> () - | l -> - p f "[" ; - let s = self#normal_type_list father ", " l in - p f "%s] " s - ); - p f "%s" - ( - match cta.cta_class with - None -> cta.cta_name - | Some (Cltype (clt, _)) -> Name.get_relative father clt.clt_name - | Some (Cl cl) -> Name.get_relative father cl.cl_name - ) - - | Class_signature _ -> - p f "%s" Odoc_messages.object_end - - - (** Return a string for the given parameter, - and eventually its label. Note that we must remove - the option constructor if we print an optional argument.*) - method string_of_parameter m p = - let (pi,label) = p in - let (slabel, t) = - let t = Parameter.typ p in - match label with - "" -> ("", t) - | s -> - if is_optional label then - (s^":", Odoc_info.remove_option t) - else - (s^":", t) - in - slabel ^ (self#normal_type m t) - - (** Return the LaTeX code for the given class. *) method latex_of_class ?(with_link=true) c = Odoc_info.reset_type_names () ; @@ -588,14 +520,8 @@ class latex = Format.fprintf f "%s] " s1 ); Format.fprintf f "%s : " (Name.simple c.cl_name); - - List.iter - (fun param -> - Format.fprintf f "%s -> " - (self#string_of_parameter father param) - ) - c.cl_parameters; - self#pre_of_class_kind f father c.cl_kind ; + Format.fprintf f "%s" (self#normal_class_type father c.cl_type); + Format.pp_print_flush f (); (CodePre (Buffer.contents buf)) :: @@ -625,8 +551,8 @@ class latex = Format.fprintf f "%s] " s1 ); Format.fprintf f "%s = " (Name.simple ct.clt_name); - self#pre_of_class_type_kind f father ct.clt_kind ; - + Format.fprintf f "%s" (self#normal_class_type father ct.clt_type); + Format.pp_print_flush f (); (CodePre (Buffer.contents buf)) :: ( diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index d74272e526..ae965673a1 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -240,6 +240,14 @@ class man = let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in "\n.B "^(self#relative_idents m_name s2)^"\n" + (** Groff string to display a [Types.class_type].*) + method man_of_class_type_expr m_name t = + let s = String.concat "\n" + (Str.split (Str.regexp "\n") (Odoc_misc.string_of_class_type t)) + in + let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in + "\n.B "^(self#relative_idents m_name s2)^"\n" + (** Groff string to display a [Types.type_expr list].*) method man_of_type_expr_list m_name sep l = let s = Odoc_misc.string_of_type_list sep l in @@ -382,23 +390,6 @@ class man = ) )^"\n" - (** Groff for the given parameter, - and eventually its label. Note that we must remove - the option constructor if we print an optional argument.*) - method man_of_parameter m p = - let (pi,label) = p in - let (slabel, t) = - let t = Parameter.typ p in - match label with - "" -> ("", t) - | s -> - if is_optional label then - (s^":", Odoc_info.remove_option t) - else - (s^":", t) - in - slabel ^ (self#man_of_type_expr m t) - (** Groff for the description of a function parameter. *) method man_of_parameter_description p = match Parameter.names p with @@ -445,118 +436,6 @@ class man = ) )^"\n\n" - (** Groff string for a [class_kind]. *) - method man_of_class_kind ckind = - match ckind with - Class_structure _ -> - self#man_of_code Odoc_messages.object_end - - | Class_apply capp -> - ( - match capp.capp_class with - None -> capp.capp_name - | Some cl -> cl.cl_name - )^ - " "^ - (String.concat " " - (List.map - (fun s -> self#man_of_code ("("^s^")")) - capp.capp_params_code)) - - | Class_constr cco -> - ( - match cco.cco_type_parameters with - [] -> "" - | l -> "["^(Odoc_misc.string_of_type_list ", " l)^"] " - )^ - ( - match cco.cco_class with - None -> cco.cco_name - | Some (Cl cl) -> "\n.B "^cl.cl_name^"\n" - | Some (Cltype (clt, _)) -> "\n.B "^clt.clt_name^"\n" - ) - | Class_constraint (ck, ctk) -> - "( "^(self#man_of_class_kind ck)^ - " : "^ - (self#man_of_class_type_kind ctk)^ - " )" - - (** Groff string for the given [class_type_kind].*) - method man_of_class_type_kind ctkind = - match ctkind with - Class_type cta -> - ( - match cta.cta_class with - None -> cta.cta_name - | Some (Cltype (clt, _)) -> "\n.B "^clt.clt_name^"\n" - | Some (Cl cl) -> "\n.B "^cl.cl_name^"\n" - ) - | Class_signature _ -> - self#man_of_code Odoc_messages.object_end - - (** Groff string for a [module_kind]. *) - method man_of_module_kind ?(with_def_syntax=true) k = - match k with - Module_alias m_alias -> - (match m_alias.ma_module with - None -> - (if with_def_syntax then " = " else "")^ - m_alias.ma_name - | Some (Mod m) -> - (if with_def_syntax then " = " else "")^m.m_name - | Some (Modtype mt) -> - (if with_def_syntax then " : " else "")^mt.mt_name - ) - | Module_apply (k1, k2) -> - (if with_def_syntax then " = " else "")^ - (self#man_of_module_kind ~with_def_syntax: false k1)^ - " ( "^(self#man_of_module_kind ~with_def_syntax: false k2)^" ) " - - | Module_with (tk, code) -> - (if with_def_syntax then " : " else "")^ - (self#man_of_module_type_kind ~with_def_syntax: false tk)^ - (self#man_of_code code) - - | Module_constraint (k, tk) -> - (if with_def_syntax then " = " else "")^ - "( "^(self#man_of_module_kind ~with_def_syntax: false k)^" : "^ - (self#man_of_module_type_kind ~with_def_syntax: false tk)^" )" - - | Module_struct _ -> - (if with_def_syntax then " = " else "")^ - (self#man_of_code (Odoc_messages.struct_end^" ")) - - | Module_functor _ -> - (if with_def_syntax then " = " else "")^ - (self#man_of_code "functor ... ") - - (** Groff string for a [module_type_kind]. *) - method man_of_module_type_kind ?(with_def_syntax=true) tk = - match tk with - | Module_type_struct _ -> - (if with_def_syntax then " : " else "")^ - (self#man_of_code Odoc_messages.sig_end) - - | Module_type_functor (params, k) -> - let f p = "("^p.mp_name^" : "^(self#man_of_module_type "" p.mp_type)^") -> " in - let s1 = String.concat "" (List.map f params) in - let s2 = self#man_of_module_type_kind ~with_def_syntax: false k in - (if with_def_syntax then " : " else "")^s1^s2 - - | Module_type_with (tk2, code) -> (* we don't want to print nested with's *) - let s = self#man_of_module_type_kind ~with_def_syntax: false tk2 in - (if with_def_syntax then " : " else "")^ - s^(self#man_of_code code) - - | Module_type_alias mt_alias -> - (if with_def_syntax then " : " else "")^ - (match mt_alias.mta_module with - None -> - mt_alias.mta_name - | Some mt -> - mt.mt_name - ) - (** Groff string for a class. *) method man_of_class c = let buf = Buffer.create 32 in @@ -570,12 +449,9 @@ class man = [] -> () | l -> p buf "[%s.I] " (Odoc_misc.string_of_type_list ", " l) ); - p buf "%s : " (Name.simple c.cl_name); - List.iter - (fun param -> p buf "%s-> " (self#man_of_parameter father param)) - c.cl_parameters; - - p buf "%s" (self#man_of_class_kind c.cl_kind); + p buf "%s : %s" + (Name.simple c.cl_name) + (self#man_of_class_type_expr (Name.father c.cl_name) c.cl_type); p buf "\n.sp\n%s\n.sp\n" (self#man_of_info c.cl_info); Buffer.contents buf @@ -591,21 +467,26 @@ class man = [] -> () | l -> p buf "[%s.I ] " (Odoc_misc.string_of_type_list ", " l) ); - p buf "%s = " (Name.simple ct.clt_name); - p buf "%s" (self#man_of_class_type_kind ct.clt_kind); + p buf "%s = %s" + (Name.simple ct.clt_name) + (self#man_of_class_type_expr (Name.father ct.clt_name) ct.clt_type); p buf "\n.sp\n%s\n.sp\n" (self#man_of_info ct.clt_info); Buffer.contents buf (** Groff string for a module. *) method man_of_module m = ".I module "^(Name.simple m.m_name)^ - (self#man_of_module_kind m.m_kind)^ + " : "^(self#man_of_module_type (Name.father m.m_name) m.m_type)^ "\n.sp\n"^(self#man_of_info m.m_info)^"\n.sp\n" (** Groff string for a module type. *) method man_of_modtype mt = ".I module type "^(Name.simple mt.mt_name)^ - (match mt.mt_kind with None -> "" | Some k -> self#man_of_module_type_kind k)^ + " = "^ + (match mt.mt_type with + None -> "" + | Some t -> self#man_of_module_type (Name.father mt.mt_name) t + )^ "\n.sp\n"^(self#man_of_info mt.mt_info)^"\n.sp\n" (** Groff string for a module comment.*) @@ -758,7 +639,11 @@ class man = ".sp\n"^ Odoc_messages.module_type^"\n"^ ".BI \""^(Name.simple mt.mt_name)^"\"\n"^ - (match mt.mt_kind with None -> "" | Some k -> self#man_of_module_type_kind k)^ + " = "^ + (match mt.mt_type with + None -> "" + | Some t -> self#man_of_module_type (Name.father mt.mt_name) t + )^ "\n.sp\n"^ (self#man_of_info mt.mt_info)^"\n"^ ".sp\n" @@ -824,7 +709,7 @@ class man = ".sp\n"^ Odoc_messages.modul^"\n"^ ".BI \""^(Name.simple m.m_name)^"\"\n"^ - (self#man_of_module_kind m.m_kind)^ + " : "^(self#man_of_module_type (Name.father m.m_name) m.m_type)^ "\n.sp\n"^ (self#man_of_info m.m_info)^"\n"^ ".sp\n" diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index 485c626607..4eaf0cabe2 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -70,15 +70,51 @@ let string_of_type_list sep type_list = Format.fprintf Format.str_formatter "@]" end; Format.flush_str_formatter() - -let string_of_module_type t = - Printtyp.modtype Format.str_formatter t; + +(** Return the given module type where methods and vals have been removed + from the signatures. Used when we don't want to print a too long module type.*) +let simpl_module_type t = + let rec iter t = + match t with + Types.Tmty_ident p -> t + | Types.Tmty_signature _ -> Types.Tmty_signature [] + | Types.Tmty_functor (id, mt1, mt2) -> + Types.Tmty_functor (id, iter mt1, iter mt2) + in + iter t + +let string_of_module_type ?(complete=false) t = + let t2 = if complete then t else simpl_module_type t in + Printtyp.modtype Format.str_formatter t2; let s = Format.flush_str_formatter () in s -let string_of_class_type t = + +(** Return the given class type where methods and vals have been removed + from the signatures. Used when we don't want to print a too long class type.*) +let simpl_class_type t = + let rec iter t = + match t with + Types.Tcty_constr (p,texp_list,ct) -> t + | Types.Tcty_signature cs -> + (* on vire les vals et methods pour ne pas qu'elles soient imprimées + quand on affichera le type *) + let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in + Types.Tcty_signature { Types.cty_self = { cs.Types.cty_self with + Types.desc = Types.Tobject (tnil, ref None) }; + Types.cty_vars = Types.Vars.empty ; + Types.cty_concr = Types.Concr.empty ; + } + | Types.Tcty_fun (l, texp, ct) -> + let new_ct = iter ct in + Types.Tcty_fun (l, texp, new_ct) + in + iter t + +let string_of_class_type ?(complete=false) t = + let t2 = if complete then t else simpl_class_type t in (* A VOIR : ma propre version de Printtyp.class_type pour ne pas faire reset_names *) - Printtyp.class_type Format.str_formatter t; + Printtyp.class_type Format.str_formatter t2; let s = Format.flush_str_formatter () in s diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli index 9f9de92ba3..25c4389662 100644 --- a/ocamldoc/odoc_misc.mli +++ b/ocamldoc/odoc_misc.mli @@ -26,11 +26,17 @@ val string_of_type_expr : Types.type_expr -> string with a given separator. It writes in and flushes [Format.str_formatter].*) val string_of_type_list : string -> Types.type_expr list -> string -(** This function returns a string representing a [Types.module_type]. *) -val string_of_module_type : Types.module_type -> string - -(** This function returns a string representing a [Types.class_type]. *) -val string_of_class_type : Types.class_type -> string +(** This function returns a string representing a [Types.module_type]. + @param complete indicates if we must print complete signatures + or just [sig end]. Default if [false]. +*) +val string_of_module_type : ?complete: bool -> Types.module_type -> string + +(** This function returns a string representing a [Types.class_type]. + @param complete indicates if we must print complete signatures + or just [object end]. Default if [false]. +*) +val string_of_class_type : ?complete: bool -> Types.class_type -> string (** This function returns the list of (label, type_expr) describing the methods of a type_expr in a Tobject.*) diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index 45c5fd222b..1a18cc7db3 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -55,8 +55,7 @@ and module_kind = (** Representation of a module. *) and t_module = { m_name : Name.t ; - m_type : Types.module_type option ; - (** It is [None] when we had only the .ml file and it is a top module. *) + m_type : Types.module_type ; mutable m_info : Odoc_types.info option ; m_is_interface : bool ; (** true for modules read from interface files *) m_file : string ; (** the file the module is defined in. *) @@ -215,7 +214,7 @@ let rec module_elements ?(trans=true) m = | Module_constraint (k, tk) -> (* A VOIR : utiliser k ou tk ? *) module_elements ~trans: trans - { m_name = "" ; m_info = None ; m_type = None ; + { m_name = "" ; m_info = None ; m_type = Types.Tmty_signature [] ; m_is_interface = false ; m_file = "" ; m_kind = k ; m_loc = Odoc_types.dummy_loc ; m_top_deps = [] ; diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 67e624ffc0..1627703e1c 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -696,7 +696,7 @@ module Analyser = let new_module = { m_name = complete_name ; - m_type = Some sig_module_type; + m_type = sig_module_type; m_info = comment_opt ; m_is_interface = true ; m_file = !file_name ; @@ -714,7 +714,7 @@ module Analyser = let new_env = Odoc_env.add_module env new_module.m_name in let new_env2 = match new_module.m_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) - Some (Types.Tmty_signature s) -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s + Types.Tmty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> new_env in (maybe_more, new_env2, [ Element_module new_module ]) @@ -848,7 +848,7 @@ module Analyser = { cl_name = complete_name ; cl_info = assoc_com ; - cl_type = sig_class_type ; + cl_type = Odoc_env.subst_class_type env sig_class_type ; cl_type_parameters = sig_class_decl.Types.cty_params; cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ; cl_kind = class_kind ; @@ -919,7 +919,7 @@ module Analyser = { clt_name = complete_name ; clt_info = assoc_com ; - clt_type = sig_class_type ; + clt_type = Odoc_env.subst_class_type env sig_class_type ; clt_type_parameters = sig_cltype_decl.clty_params ; clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ; clt_kind = kind ; @@ -1209,7 +1209,7 @@ module Analyser = let m = { m_name = mod_name ; - m_type = Some (Types.Tmty_signature signat) ; + m_type = Types.Tmty_signature signat ; m_info = info_opt ; m_is_interface = true ; m_file = !file_name ; diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml index 358cb67bd2..f043bacf2d 100644 --- a/ocamldoc/odoc_to_text.ml +++ b/ocamldoc/odoc_to_text.ml @@ -187,6 +187,14 @@ class virtual to_text = in s2 + (** Get a string for a [Types.class_type] where all idents are relative. *) + method normal_class_type m_name t = + (self#relative_idents m_name (Odoc_info.string_of_class_type t)) + + (** Get a string for a [Types.module_type] where all idents are relative. *) + method normal_module_type m_name t = + (self#relative_idents m_name (Odoc_info.string_of_module_type t)) + (** Get a string for a type where all idents are relative. *) method normal_type m_name t = (self#relative_idents m_name (Odoc_info.string_of_type_expr t)) @@ -381,6 +389,8 @@ class virtual to_text = ) ] +(**/**) + (** Return [text] value for the given [class_kind].*) method text_of_class_kind father ckind = match ckind with |