diff options
| -rw-r--r-- | ocamldoc/.depend | 34 | ||||
| -rw-r--r-- | ocamldoc/odoc_ast.ml | 75 | ||||
| -rw-r--r-- | ocamldoc/odoc_class.ml | 5 | ||||
| -rw-r--r-- | ocamldoc/odoc_cross.ml | 20 | ||||
| -rw-r--r-- | ocamldoc/odoc_html.ml | 146 | ||||
| -rw-r--r-- | ocamldoc/odoc_info.ml | 2 | ||||
| -rw-r--r-- | ocamldoc/odoc_info.mli | 10 | ||||
| -rw-r--r-- | ocamldoc/odoc_iso.ml | 2 | ||||
| -rw-r--r-- | ocamldoc/odoc_latex.ml | 3 | ||||
| -rw-r--r-- | ocamldoc/odoc_man.ml | 3 | ||||
| -rw-r--r-- | ocamldoc/odoc_merge.ml | 6 | ||||
| -rw-r--r-- | ocamldoc/odoc_misc.ml | 30 | ||||
| -rw-r--r-- | ocamldoc/odoc_misc.mli | 5 | ||||
| -rw-r--r-- | ocamldoc/odoc_parameter.ml | 26 | ||||
| -rw-r--r-- | ocamldoc/odoc_sig.ml | 19 | ||||
| -rw-r--r-- | ocamldoc/odoc_to_text.ml | 3 | ||||
| -rw-r--r-- | ocamldoc/odoc_value.ml | 16 |
17 files changed, 261 insertions, 144 deletions
diff --git a/ocamldoc/.depend b/ocamldoc/.depend index 220075823..0a5c209bf 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -1,15 +1,15 @@ odoc.cmo: ../stdlib/array.cmi ../utils/clflags.cmo ../utils/config.cmi \ ../otherlibs/dynlink/dynlink.cmi ../stdlib/filename.cmi \ ../stdlib/format.cmi ../stdlib/list.cmi ../utils/misc.cmi \ - odoc_analyse.cmi odoc_args.cmi odoc_crc.cmo odoc_dot.cmo odoc_global.cmi \ - odoc_html.cmo odoc_info.cmi odoc_iso.cmo odoc_latex.cmo odoc_man.cmo \ - odoc_messages.cmo ../stdlib/sys.cmi ../typing/typedtree.cmi + odoc_analyse.cmi odoc_args.cmi odoc_dot.cmo odoc_global.cmi odoc_html.cmo \ + odoc_info.cmi odoc_iso.cmo odoc_latex.cmo odoc_man.cmo odoc_messages.cmo \ + ../stdlib/sys.cmi ../typing/typedtree.cmi odoc.cmx: ../stdlib/array.cmx ../utils/clflags.cmx ../utils/config.cmx \ ../otherlibs/dynlink/dynlink.cmx ../stdlib/filename.cmx \ ../stdlib/format.cmx ../stdlib/list.cmx ../utils/misc.cmx \ - odoc_analyse.cmx odoc_args.cmx odoc_crc.cmx odoc_dot.cmx odoc_global.cmx \ - odoc_html.cmx odoc_info.cmx odoc_iso.cmx odoc_latex.cmx odoc_man.cmx \ - odoc_messages.cmx ../stdlib/sys.cmx ../typing/typedtree.cmx + odoc_analyse.cmx odoc_args.cmx odoc_dot.cmx odoc_global.cmx odoc_html.cmx \ + odoc_info.cmx odoc_iso.cmx odoc_latex.cmx odoc_man.cmx odoc_messages.cmx \ + ../stdlib/sys.cmx ../typing/typedtree.cmx odoc_analyse.cmo: ../utils/ccomp.cmi ../utils/clflags.cmo ../utils/config.cmi \ ../typing/ctype.cmi ../typing/env.cmi ../stdlib/filename.cmi \ ../stdlib/format.cmi ../typing/includemod.cmi ../parsing/lexer.cmi \ @@ -110,12 +110,12 @@ odoc_global.cmo: odoc_global.cmi odoc_global.cmx: odoc_global.cmi odoc_html.cmo: ../stdlib/array.cmi ../stdlib/buffer.cmi ../stdlib/char.cmi \ ../stdlib/filename.cmi ../stdlib/list.cmi odoc_args.cmi odoc_dag2html.cmi \ - odoc_info.cmi odoc_messages.cmo odoc_text.cmi ../stdlib/sort.cmi \ - ../otherlibs/str/str.cmi ../stdlib/string.cmi + odoc_info.cmi odoc_messages.cmo odoc_text.cmi ../stdlib/printf.cmi \ + ../stdlib/sort.cmi ../otherlibs/str/str.cmi ../stdlib/string.cmi odoc_html.cmx: ../stdlib/array.cmx ../stdlib/buffer.cmx ../stdlib/char.cmx \ ../stdlib/filename.cmx ../stdlib/list.cmx odoc_args.cmx odoc_dag2html.cmx \ - odoc_info.cmx odoc_messages.cmx odoc_text.cmx ../stdlib/sort.cmx \ - ../otherlibs/str/str.cmx ../stdlib/string.cmx + odoc_info.cmx odoc_messages.cmx odoc_text.cmx ../stdlib/printf.cmx \ + ../stdlib/sort.cmx ../otherlibs/str/str.cmx ../stdlib/string.cmx odoc_info.cmo: odoc_analyse.cmi odoc_args.cmi odoc_class.cmo odoc_dep.cmo \ odoc_exception.cmo odoc_global.cmi odoc_messages.cmo odoc_misc.cmi \ odoc_module.cmo odoc_name.cmi odoc_parameter.cmo odoc_scan.cmo \ @@ -196,10 +196,10 @@ odoc_opt.cmx: ../utils/clflags.cmx ../utils/config.cmx ../stdlib/format.cmx \ ../stdlib/list.cmx ../utils/misc.cmx odoc_analyse.cmx odoc_args.cmx \ odoc_dot.cmx odoc_global.cmx odoc_html.cmx odoc_info.cmx odoc_iso.cmx \ odoc_latex.cmx odoc_man.cmx odoc_messages.cmx ../typing/typedtree.cmx -odoc_parameter.cmo: ../stdlib/list.cmi odoc_types.cmo ../stdlib/string.cmi \ - ../typing/types.cmi -odoc_parameter.cmx: ../stdlib/list.cmx odoc_types.cmx ../stdlib/string.cmx \ - ../typing/types.cmx +odoc_parameter.cmo: ../parsing/asttypes.cmi ../stdlib/list.cmi odoc_types.cmo \ + ../stdlib/string.cmi ../typing/types.cmi +odoc_parameter.cmx: ../parsing/asttypes.cmi ../stdlib/list.cmx odoc_types.cmx \ + ../stdlib/string.cmx ../typing/types.cmx odoc_parser.cmo: ../stdlib/lexing.cmi ../stdlib/obj.cmi \ odoc_comments_global.cmi odoc_types.cmo ../stdlib/parsing.cmi \ ../otherlibs/str/str.cmi ../stdlib/string.cmi odoc_parser.cmi @@ -272,9 +272,9 @@ odoc_comments.cmi: odoc_types.cmo odoc_cross.cmi: odoc_module.cmo odoc_dag2html.cmi: odoc_info.cmi odoc_env.cmi: odoc_name.cmi ../typing/types.cmi -odoc_info.cmi: odoc_class.cmo odoc_exception.cmo odoc_module.cmo \ - odoc_name.cmi odoc_parameter.cmo odoc_search.cmi odoc_type.cmo \ - odoc_types.cmo odoc_value.cmo ../otherlibs/str/str.cmi \ +odoc_info.cmi: ../parsing/asttypes.cmi odoc_class.cmo odoc_exception.cmo \ + odoc_module.cmo odoc_name.cmi odoc_parameter.cmo odoc_search.cmi \ + odoc_type.cmo odoc_types.cmo odoc_value.cmo ../otherlibs/str/str.cmi \ ../typing/types.cmi odoc_merge.cmi: odoc_module.cmo odoc_types.cmo odoc_misc.cmi: ../parsing/longident.cmi odoc_types.cmo ../typing/types.cmi diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 46dea6501..3c68717a6 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -261,7 +261,7 @@ module Analyser = (** This function takes a parameter pattern and builds the corresponding [parameter] structure. The f_desc function is used to retrieve a parameter description, if any, from - a prarameter name. + a parameter name. *) let tt_param_info_from_pattern env f_desc pat = let rec iter_pattern pat = @@ -314,26 +314,35 @@ module Analyser = | (pattern_param, exp) :: second_ele :: q -> (* implicit pattern matching -> anonymous parameter and no more parameter *) - let parameter = Odoc_parameter.Tuple ([], Odoc_env.subst_type env pattern_param.pat_type) in + (* A VOIR : le label ? *) + let parameter = (Odoc_parameter.Tuple ([], Odoc_env.subst_type env pattern_param.pat_type), "") in [ parameter ] | (pattern_param, func_body) :: [] -> - let parameter = tt_param_info_from_pattern env (Odoc_parameter.desc_from_info_opt current_comment_opt) pattern_param in + let parameter = + (tt_param_info_from_pattern + env + (Odoc_parameter.desc_from_info_opt current_comment_opt) + pattern_param, + "") (* A VOIR : le label ? *) + in (* For optional parameters with a default value, a special treatment is required *) (* we look if the name of the parameter we just add is "*opt*", which means that there is a let param_name = ... in ... just right now *) let (p, next_exp) = match parameter with - Simple_name { sn_name = "*opt*" } -> + (Simple_name { sn_name = "*opt*" }, label) -> ( ( match func_body.exp_desc with Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, func_body2) -> let name = Name.from_ident id in - let new_param = Simple_name { sn_name = name ; - sn_text = Odoc_parameter.desc_from_info_opt current_comment_opt name ; - sn_type = Odoc_env.subst_type env exp.exp_type - } + let new_param = + (Simple_name { sn_name = name ; + sn_text = Odoc_parameter.desc_from_info_opt current_comment_opt name ; + sn_type = Odoc_env.subst_type env exp.exp_type + }, + label) in (new_param, func_body2) | _ -> @@ -553,34 +562,45 @@ module Analyser = match l with [] -> (* cas impossible, on l'a filtré avant *) - raise (Failure "") + assert false | (pattern_param, exp) :: second_ele :: q -> (* implicit pattern matching -> anonymous parameter *) (* Note : We can't match this pattern if it is the first call to the function. *) - let new_param = Simple_name { sn_name = "??" ; sn_text = None; - sn_type = Odoc_env.subst_type env pattern_param.Typedtree.pat_type } in + let new_param = + (Simple_name { sn_name = "??" ; sn_text = None; + sn_type = Odoc_env.subst_type env pattern_param.Typedtree.pat_type }, + "") (* A VOIR : le label ? *) + in [ new_param ] | (pattern_param, body) :: [] -> (* if this is the first call to the function, this is the first parameter and we skip it *) if not first then ( - let parameter = tt_param_info_from_pattern env (Odoc_parameter.desc_from_info_opt comment_opt) pattern_param in + let parameter = + (tt_param_info_from_pattern + env + (Odoc_parameter.desc_from_info_opt comment_opt) + pattern_param , + "") (* A VOIR : le label ? *) + in (* For optional parameters with a default value, a special treatment is required. *) (* We look if the name of the parameter we just add is "*opt*", which means that there is a let param_name = ... in ... just right now. *) let (current_param, next_exp) = match parameter with - Simple_name { sn_name = "*opt*"} -> + (Simple_name { sn_name = "*opt*"}, label) -> ( ( match body.exp_desc with Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, body2) -> let name = Name.from_ident id in - let new_param = Simple_name { sn_name = name ; - sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ; - sn_type = Odoc_env.subst_type env exp.Typedtree.exp_type ; - } + let new_param = + (Simple_name { sn_name = name ; + sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ; + sn_type = Odoc_env.subst_type env exp.Typedtree.exp_type ; + }, + label) in (new_param, body2) | _ -> @@ -791,6 +811,7 @@ module Analyser = Typedtree.Tclass_fun (pat, ident_exp_list, tt_class_expr2, partial)) -> (* we check that this is not an optional parameter with a default value. In this case, we look for the good parameter pattern *) + prerr_endline ("label="^label); let (parameter, next_tt_class_exp) = match pat.Typedtree.pat_desc with Typedtree.Tpat_var ident when Name.from_ident ident = "*opt*" -> @@ -799,11 +820,13 @@ module Analyser = match tt_class_expr2.Typedtree.cl_desc with Typedtree.Tclass_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, _, tt_class_expr3) -> let name = Name.from_ident id in - let new_param = Simple_name - { sn_name = name ; - sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ; - sn_type = Odoc_env.subst_type env exp.exp_type - } + let new_param = + (Simple_name + { sn_name = name ; + sn_text = Odoc_parameter.desc_from_info_opt comment_opt name ; + sn_type = Odoc_env.subst_type env exp.exp_type + }, + label) in (new_param, tt_class_expr3) | _ -> @@ -813,7 +836,13 @@ module Analyser = ) | _ -> (* no optional parameter with default value, we create the parameter *) - let new_param = tt_param_info_from_pattern env (Odoc_parameter.desc_from_info_opt comment_opt) pat in + let new_param = + (tt_param_info_from_pattern + env + (Odoc_parameter.desc_from_info_opt comment_opt) + pat, + label) + in (new_param, tt_class_expr2) in let (params, k) = analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 next_tt_class_exp in diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml index 1826eaddb..3992c387a 100644 --- a/ocamldoc/odoc_class.ml +++ b/ocamldoc/odoc_class.ml @@ -40,7 +40,7 @@ and class_apply = { and class_constr = { cco_name : Name.t ; (** The complete name of the applied class *) - mutable cco_class : t_class option; (** The associated t_class if we found it *) + mutable cco_class : cct option; (** The associated class ot class type if we found it *) cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed *) } @@ -131,7 +131,8 @@ let rec class_elements ?(trans=true) cl = | Class_constr cco -> ( match cco.cco_class with - Some c when trans -> class_elements ~trans: trans c + Some (Cl c) when trans -> class_elements ~trans: trans c + | Some (Cltype (ct,_)) when trans -> class_type_elements ~trans: trans ct | _ -> [] ) in diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index 895a2e2c3..82fa26950 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -404,11 +404,23 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names with Not_found -> None in match cl_opt with - None -> (acc_b, (Name.head c.cl_name) :: acc_inc, + None -> + ( + let clt_opt = + try Some (lookup_class_type module_list cco.cco_name) + with Not_found -> None + in + match clt_opt with + 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 cco.cco_name = Odoc_messages.object_end then acc_names else (NF_c cco.cco_name) :: acc_names)) + (if cco.cco_name = Odoc_messages.object_end then acc_names else (NF_cct cco.cco_name) :: acc_names)) + | Some ct -> + cco.cco_class <- Some (Cltype (ct, [])) ; + (true, acc_inc, acc_names) + ) | Some c -> - cco.cco_class <- Some c ; + cco.cco_class <- Some (Cl c) ; (true, acc_inc, acc_names) ) | Class_constraint (ckind, ctkind) -> @@ -640,7 +652,7 @@ and assoc_comments_parameter module_list p = List.iter (assoc_comments_parameter module_list) l and assoc_comments_parameter_list module_list pl = - List.iter (assoc_comments_parameter module_list) pl + List.iter (fun (pi, label) -> assoc_comments_parameter module_list pi) pl and assoc_comments_value module_list v = v.val_info <- ao (assoc_comments_info module_list) v.val_info ; diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 3b066eb7a..2613e5669 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -981,6 +981,23 @@ class html = self#html_of_described_parameter_list module_name m.met_value.val_parameters ) + (** Return HTML code to print the type of the given parameter, + and eventually its label. Note that we must remove + the option constructor if we print an optional argument.*) + method html_of_parameter m p = + let (pi,label) = p in + let (slabel, t) = + let t = Parameter.typ p in + match label with + "" -> ("", t) + | s -> + if s.[0] = '?' then + (s^":", Odoc_info.remove_option t) + else + (s^":", t) + in + slabel^(self#html_of_type_expr m t) + (** Return html code for the description of a function parameter. *) method html_of_parameter_description p = match Parameter.names p with @@ -1224,15 +1241,13 @@ class html = "</pre>\n" (** Return html code for the given [class_kind].*) - method html_of_class_kind father ?(with_def_syntax=true) ckind = + method html_of_class_kind father ckind = print_DEBUG "html#html_of_class_kind"; match ckind with Class_structure _ -> - (if with_def_syntax then " = " else "")^ (self#html_of_code ~with_pre: false Odoc_messages.object_end) | Class_apply capp -> - (if with_def_syntax then " = " else "")^ ( match capp.capp_class with None -> capp.capp_name @@ -1247,7 +1262,6 @@ class html = capp.capp_params_code)) | Class_constr cco -> - (if with_def_syntax then " = " else "")^ ( match cco.cco_type_parameters with [] -> "" @@ -1256,24 +1270,23 @@ class html = ( match cco.cco_class with None -> cco.cco_name - | Some cl -> + | Some (Cl cl) -> let (html_file, _) = Naming.html_files cl.cl_name in "<a href=\""^html_file^"\">"^cl.cl_name^"</a> " + | Some (Cltype (clt,_)) -> + let (html_file, _) = Naming.html_files clt.clt_name in + "<a href=\""^html_file^"\">"^clt.clt_name^"</a> " ) | Class_constraint (ck, ctk) -> - (if with_def_syntax then " = " else "")^ - "( "^(self#html_of_class_kind father ~with_def_syntax: false ck)^ + "( "^(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 ?def_syntax ctkind = + method html_of_class_type_kind father ctkind = match ctkind with Class_type cta -> - (match def_syntax with - None -> "" - | Some s -> " "^s^" ")^ ( match cta.cta_type_parameters with [] -> "" @@ -1294,73 +1307,88 @@ class html = "<a href=\""^html_file^"\">"^cl.cl_name^"</a>" ) | Class_signature _ -> - (match def_syntax with - None -> "" - | Some s -> " "^s^" ")^ - (self#html_of_code ~with_pre: false Odoc_messages.object_end) + 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 = Odoc_info.reset_type_names (); + let buf = Buffer.create 32 in let (html_file, _) = Naming.html_files c.cl_name in - "<pre>"^(self#keyword "class")^" "^ + let p = Printf.bprintf in + p buf "<pre>%s " (self#keyword "class"); (* we add a html tag, the same as for a type so we can go directly here when the class name is used as a type name *) - "<a name=\""^(Naming.type_target - { ty_name = c.cl_name ; - ty_info = None ; ty_parameters = [] ; - ty_kind = Type_abstract ; ty_manifest = None ; - ty_loc = Odoc_info.dummy_loc })^ - "\"></a>"^ - (print_DEBUG "html#html_of_class : virtual or not" ; "")^ - (if c.cl_virtual then (self#keyword "virtual")^" " else "")^ + p buf "<a name=\"%s\"></a>" + (Naming.type_target + { ty_name = c.cl_name ; + ty_info = None ; ty_parameters = [] ; + ty_kind = Type_abstract ; ty_manifest = None ; + ty_loc = Odoc_info.dummy_loc }); + print_DEBUG "html#html_of_class : virtual or not" ; + if c.cl_virtual then p buf "%s " (self#keyword "virtual") else (); ( match c.cl_type_parameters with - [] -> "" - | l -> "["^(self#html_of_type_expr_list (Name.father c.cl_name) ", " l)^"] " - )^ - (print_DEBUG "html#html_of_class : with link or not" ; "")^ + [] -> () + | l -> + p buf "[%s] " + (self#html_of_type_expr_list (Name.father c.cl_name) ", " l) + ); + print_DEBUG "html#html_of_class : with link or not" ; ( if with_link then - "<a href=\""^html_file^"\">"^(Name.simple c.cl_name)^"</a>" + p buf "<a href=\"%s\">%s</a>" html_file (Name.simple c.cl_name) else - Name.simple c.cl_name - )^ - (match c.cl_parameters with [] -> "" | _ -> " ... ")^ - (print_DEBUG "html#html_of_class : class kind" ; "")^ - (self#html_of_class_kind (Name.father c.cl_name) c.cl_kind)^ - "</pre>"^ - (print_DEBUG "html#html_of_class : info" ; "")^ - ((if complete then self#html_of_info else self#html_of_info_first_sentence) c.cl_info) + p buf "%s" (Name.simple c.cl_name) + ); + + 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 "</pre>" ; + print_DEBUG "html#html_of_class : info" ; + Buffer.add_string buf + ((if complete then self#html_of_info else self#html_of_info_first_sentence) c.cl_info); + Buffer.contents buf (** Return html code for a class type. *) method html_of_class_type ?(complete=true) ?(with_link=true) ct = Odoc_info.reset_type_names (); + let buf = Buffer.create 32 in + let p = Printf.bprintf in let (html_file, _) = Naming.html_files ct.clt_name in - "<pre>"^(self#keyword "class type")^" "^ + p buf "<pre>%s " (self#keyword "class type"); (* we add a html tag, the same as for a type so we can go directly here when the class type name is used as a type name *) - "<a name=\""^(Naming.type_target - { ty_name = ct.clt_name ; - ty_info = None ; ty_parameters = [] ; - ty_kind = Type_abstract ; ty_manifest = None ; - ty_loc = Odoc_info.dummy_loc })^ - "\"></a>"^ - (if ct.clt_virtual then (self#keyword "virtual")^" " else "")^ + p buf "<a name=\"%s\"></a>" + (Naming.type_target + { ty_name = ct.clt_name ; + ty_info = None ; ty_parameters = [] ; + ty_kind = Type_abstract ; ty_manifest = None ; + ty_loc = Odoc_info.dummy_loc }); + if ct.clt_virtual then p buf "%s "(self#keyword "virtual") else (); ( match ct.clt_type_parameters with - [] -> "" - | l -> "["^(self#html_of_type_expr_list (Name.father ct.clt_name) ", " l)^"] " - )^ - ( - if with_link then - "<a href=\""^html_file^"\">"^(Name.simple ct.clt_name)^"</a>" - else - Name.simple ct.clt_name - )^ - (self#html_of_class_type_kind (Name.father ct.clt_name) ~def_syntax: ":" ct.clt_kind)^ - "</pre>"^ - ((if complete then self#html_of_info else self#html_of_info_first_sentence) ct.clt_info) + [] -> () + | l -> p buf "[%s] " (self#html_of_type_expr_list (Name.father ct.clt_name) ", " l) + ); + + if with_link then + p buf "<a href=\"%s\">%s</a>" html_file (Name.simple ct.clt_name) + else + 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 "</pre>"; + Buffer.add_string buf ((if complete then self#html_of_info else self#html_of_info_first_sentence) ct.clt_info); + + Buffer.contents buf (** Return html code to represent a dag, represented as in Odoc_dag2html. *) method html_of_dag dag = @@ -1505,7 +1533,7 @@ class html = | Class_comment t -> output_string chanout (self#html_of_class_comment t) ) - (Class.class_elements cl); + (Class.class_elements ~trans:false cl); output_string chanout "</html>"; close_out chanout; @@ -1557,7 +1585,7 @@ class html = | Class_comment t -> output_string chanout (self#html_of_class_comment t) ) - (Class.class_type_elements clt); + (Class.class_type_elements ~trans: false clt); output_string chanout "</html>"; close_out chanout; diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index d52ff1704..08ed45cae 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -150,6 +150,8 @@ let first_sentence_and_rest_of_text = Odoc_misc.first_sentence_and_rest_of_text let create_index_lists = Odoc_misc.create_index_lists +let remove_option = Odoc_misc.remove_option + let use_hidden_modules n = Odoc_name.hide_given_modules !Odoc_args.hidden_modules n diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index 318ff117e..620b21c12 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -136,7 +136,7 @@ module Parameter : | Tuple of param_info list * Types.type_expr (** A parameter is just a param_info value. *) - type parameter = param_info + type parameter = param_info * Asttypes.label (** A module parameter is just a name and a module type.*) type module_parameter = Odoc_parameter.module_parameter = @@ -294,7 +294,8 @@ module Class : and class_constr = Odoc_class.class_constr = { cco_name : Name.t ; (** The complete name of the applied class. *) - mutable cco_class : t_class option; (** The associated t_class if we found it. *) + mutable cco_class : cct option; + (** The associated class or class type if we found it. *) cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed. *) } @@ -650,6 +651,11 @@ val first_sentence_and_rest_of_text : begin with a letter should be in the first returned list.*) val create_index_lists : 'a list -> ('a -> string) -> 'a list list +(** Take a type and remove the option top constructor. This is + useful when printing labels, we we then remove the top option contructor + for optional labels.*) +val remove_option : Types.type_expr -> Types.type_expr + (** Return the given name where the module name or part of it was removed, according to the list of modules which must be hidden (cf {!Odoc_args.hidden_modules})*) diff --git a/ocamldoc/odoc_iso.ml b/ocamldoc/odoc_iso.ml index f9d5e64a5..56fc9c1be 100644 --- a/ocamldoc/odoc_iso.ml +++ b/ocamldoc/odoc_iso.ml @@ -77,7 +77,7 @@ class iso = | Parameter.Tuple (l, _) -> List.for_all iter l in - List.for_all iter l + List.for_all (fun (pi,label) -> iter pi) l method check_type_fields l = List.for_all (fun f -> f.rf_text <> None) l diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 30566d5e5..af633aa64 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -520,7 +520,8 @@ class latex = p f "%s" (match cco.cco_class with None -> cco.cco_name - | Some cl -> cl.cl_name + | Some (Cl cl) -> cl.cl_name + | Some (Cltype (clt, _)) -> clt.clt_name ); Format.flush_str_formatter () diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index d295559d3..b287b8405 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -458,7 +458,8 @@ class man = ( match cco.cco_class with None -> cco.cco_name - | Some cl -> cl.cl_name^" " + | Some (Cl cl) -> cl.cl_name^" " + | Some (Cltype (clt, _)) -> clt.clt_name^" " ) | Class_constraint (ck, ctk) -> (if with_def_syntax then " = " else "")^ diff --git a/ocamldoc/odoc_merge.ml b/ocamldoc/odoc_merge.ml index aa01c77d3..ebe62945b 100644 --- a/ocamldoc/odoc_merge.ml +++ b/ocamldoc/odoc_merge.ml @@ -291,9 +291,9 @@ let rec merge_parameters param_mli param_ml = match (param_mli, param_ml) with ([], []) -> [] | (l, []) | ([], l) -> l - | (pi_mli :: li, pi_ml :: l) -> - (merge_param_info pi_mli pi_ml) :: merge_parameters li l - + | ((pi_mli, label) :: li, (pi_ml,_) :: l) -> + ((merge_param_info pi_mli pi_ml), label) :: merge_parameters li l + (** Merge of two t_class, one for a .mli, another for the .ml. The .mli class is completed with the information in the .ml class. *) let merge_classes merge_options mli ml = diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index c2e739117..38fc6e3fe 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -76,7 +76,8 @@ let string_of_module_type t = let s = Format.flush_str_formatter () in s -let string_of_class_type t = +let string_of_class_type t = + (* A VOIR : ma propre version de Printtyp.class_type pour ne pas faire reset_names *) Printtyp.class_type Format.str_formatter t; let s = Format.flush_str_formatter () in s @@ -340,3 +341,30 @@ let create_index_lists elements string_of_ele = f current (acc0 @ [ele]) acc1 acc2 q in f '_' [] [] [] elements + + +let remove_option typ = + let rec iter t = + match t with + | Types.Tconstr (p,tlist,_) -> + ( + match p with + Path.Pident id when Ident.name id = "option" -> + ( + match tlist with + [t2] -> t2.Types.desc + | _ -> t + ) + | _ -> t + ) + | Types.Tvar + | Types.Tarrow _ + | Types.Ttuple _ + | Types.Tobject _ + | Types.Tfield _ + | Types.Tnil + | Types.Tvariant _ -> t + | Types.Tlink t2 + | Types.Tsubst t2 -> iter t2.Types.desc + in + { typ with Types.desc = iter typ.Types.desc } diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli index c54481cf6..dd4730b97 100644 --- a/ocamldoc/odoc_misc.mli +++ b/ocamldoc/odoc_misc.mli @@ -88,3 +88,8 @@ val first_sentence_and_rest_of_text : Since the original list is sorted, elements whose name does not begin with a letter should be in the first returned list.*) val create_index_lists : 'a list -> ('a -> string) -> 'a list list + +(** Take a type and remove the option top constructor. This is + useful when printing labels, we we then remove the top option contructor + for optional labels.*) +val remove_option : Types.type_expr -> Types.type_expr diff --git a/ocamldoc/odoc_parameter.ml b/ocamldoc/odoc_parameter.ml index adf035d3d..8aea276d1 100644 --- a/ocamldoc/odoc_parameter.ml +++ b/ocamldoc/odoc_parameter.ml @@ -31,7 +31,7 @@ type param_info = | Tuple of param_info list * Types.type_expr (** A parameter is just a param_info value. *) -type parameter = param_info +type parameter = param_info * Asttypes.label (** A module parameter is just a name and a module type.*) type module_parameter = { @@ -53,29 +53,29 @@ let complete_name p = | Tuple (pi_list, _) -> "("^(String.concat "," (List.map iter pi_list))^")" in - iter p + iter (fst p) (** access to the complete type *) -let typ p = - match p with +let typ (pi, label) = + match pi with Simple_name sn -> sn.sn_type | Tuple (_, typ) -> typ (** Update the text of a parameter using a function returning the optional text associated to a parameter name.*) let update_parameter_text f p = - let rec iter p = - match p with + let rec iter pi= + match pi with Simple_name sn -> sn.sn_text <- f sn.sn_name | Tuple (l, _) -> List.iter iter l in - iter p + iter (fst p) (** access to the description of a specific name. @raise Not_found if no description is associated to the given name. *) -let desc_by_name p name = +let desc_by_name (pi,label) name = let rec iter acc pi = match pi with Simple_name sn -> @@ -83,13 +83,13 @@ let desc_by_name p name = | Tuple (pi_list, _) -> List.fold_left iter acc pi_list in - let l = iter [] p in + let l = iter [] pi in List.assoc name l (** acces to the list of names ; only one for a simple parameter, or a list for tuples. *) -let names p = +let names (pi,label) = let rec iter acc pi = match pi with Simple_name sn -> @@ -97,11 +97,11 @@ let names p = | Tuple (pi_list, _) -> List.fold_left iter acc pi_list in - iter [] p + iter [] pi (** access to the type of a specific name. @raise Not_found if no type is associated to the given name. *) -let type_by_name p name = +let type_by_name (pi,label) name = let rec iter acc pi = match pi with Simple_name sn -> @@ -109,7 +109,7 @@ let type_by_name p name = | Tuple (pi_list, _) -> List.fold_left iter acc pi_list in - let l = iter [] p in + let l = iter [] pi in List.assoc name l (** access to the optional description of a parameter name from an optional info structure.*) diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 51b8f66ef..43d44f875 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -1071,10 +1071,12 @@ module Analyser = (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *), Types.Tcty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> print_DEBUG "Tcty_constr _"; + let path_name = Name.from_path p in + let name = Odoc_env.full_class_or_class_type_name env path_name in let k = Class_constr { - cco_name = Odoc_env.full_class_name env (Name.from_path p) ; + cco_name = name ; cco_class = None ; cco_type_parameters = List.map (Odoc_env.subst_type env) typ_list } @@ -1098,16 +1100,17 @@ module Analyser = | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) -> (* label = string. Dans les signatures, pas de nom de paramètres à l'intérieur des tuples *) - (* si label = "", pas de label. A VOIR : ici on a l'information pour savoir si on a un label explicite. *) + (* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *) if parse_label = label then ( let new_param = - Simple_name - { - sn_name = label ; - sn_type = Odoc_env.subst_type env type_expr ; - sn_text = None ; (* will be updated when the class will be created *) - } + (Simple_name + { + sn_name = label ; + sn_type = Odoc_env.subst_type env type_expr ; + sn_text = None ; (* will be updated when the class will be created *) + }, + label) in let (l, k) = analyse_class_kind env current_class_name last_pos pclass_type class_type in ( (new_param :: l), k ) diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml index d59a5bf1e..fedca03f9 100644 --- a/ocamldoc/odoc_to_text.ml +++ b/ocamldoc/odoc_to_text.ml @@ -401,7 +401,8 @@ class virtual to_text = [Code ( match cco.cco_class with None -> cco.cco_name - | Some cl -> cl.cl_name + | Some (Cl cl) -> cl.cl_name + | Some (Cltype (clt,_)) -> clt.clt_name ) ] diff --git a/ocamldoc/odoc_value.ml b/ocamldoc/odoc_value.ml index 6c5e71637..eba64422c 100644 --- a/ocamldoc/odoc_value.ml +++ b/ocamldoc/odoc_value.ml @@ -44,14 +44,14 @@ type t_method = { (** Functions *) -(** Returns the text associated to the given parameter label +(** Returns the text associated to the given parameter name in the given value, or None. *) -let value_parameter_text_by_name v label = +let value_parameter_text_by_name v name = match v.val_info with None -> None | Some i -> try - let t = List.assoc label i.Odoc_types.i_params in + let t = List.assoc name i.Odoc_types.i_params in Some t with Not_found -> @@ -87,7 +87,7 @@ let dummy_parameter_list typ = "" -> s | _ -> match s.[0] with - '?' -> String.sub s 1 ((String.length s) - 1) + '?' -> String.sub s 1 ((String.length s) - 1) | _ -> s in Printtyp.mark_loops typ; @@ -97,7 +97,7 @@ let dummy_parameter_list typ = | Types.Ttuple l -> if label = "" then Odoc_parameter.Tuple - ((List.map (fun t2 -> iter ("", t2)) l), t) + (List.map (fun t2 -> iter ("", t2)) l, t) else (* if there is a label, then we don't want to decompose the tuple *) Odoc_parameter.Simple_name @@ -106,15 +106,15 @@ let dummy_parameter_list typ = Odoc_parameter.sn_text = None } | Types.Tlink t2 | Types.Tsubst t2 -> - (iter (normal_name label, t2)) + (iter (label, t2)) | _ -> Odoc_parameter.Simple_name { Odoc_parameter.sn_name = normal_name label ; - Odoc_parameter.sn_type = t ; + Odoc_parameter.sn_type = t ; Odoc_parameter.sn_text = None } in - List.map iter liste_param + List.map (fun (label,t) -> (iter (label, t), label)) liste_param (** Return true if the value is a function, i.e. has a functional type.*) let is_function v = |