Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve display of functor parameters, added mp_type_code field to functor parameter 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6173 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Maxence Guesdon 2004-03-26 09:09:50 +00:00
parent f415853a11
commit df89e7e0d2
10 changed files with 183 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
ocamldoc/.depend
View File

@ -56,11 +56,11 @@ odoc_config.cmo: ../utils/config.cmi odoc_config.cmi
odoc_config.cmx: ../utils/config.cmx odoc_config.cmi
odoc_cross.cmo: odoc_class.cmo odoc_exception.cmo odoc_messages.cmo \
odoc_misc.cmi odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \
odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \
odoc_scan.cmo odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \
odoc_cross.cmi
odoc_cross.cmx: odoc_class.cmx odoc_exception.cmx odoc_messages.cmx \
odoc_misc.cmx odoc_module.cmx odoc_name.cmx odoc_parameter.cmx \
odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
odoc_scan.cmx odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
odoc_cross.cmi
odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi
odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi
@ -104,8 +104,10 @@ odoc_lexer.cmo: odoc_args.cmi odoc_comments_global.cmi odoc_messages.cmo \
odoc_parser.cmi
odoc_lexer.cmx: odoc_args.cmx odoc_comments_global.cmx odoc_messages.cmx \
odoc_parser.cmx
odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_str.cmi
odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_str.cmx
odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_print.cmi \
odoc_str.cmi
odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_print.cmx \
odoc_str.cmx
odoc_merge.cmo: odoc_args.cmi odoc_class.cmo odoc_exception.cmo \
odoc_messages.cmo odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \
odoc_type.cmo odoc_types.cmi odoc_value.cmo odoc_merge.cmi
@ -168,16 +170,16 @@ odoc_sig.cmo: ../parsing/asttypes.cmi ../typing/btype.cmi \
../parsing/location.cmi ../utils/misc.cmi odoc_args.cmi odoc_class.cmo \
odoc_env.cmi odoc_exception.cmo odoc_global.cmi odoc_merge.cmi \
odoc_messages.cmo odoc_misc.cmi odoc_module.cmo odoc_name.cmi \
odoc_parameter.cmo odoc_type.cmo odoc_types.cmi odoc_value.cmo \
../parsing/parsetree.cmi ../typing/path.cmi ../typing/typedtree.cmi \
../typing/types.cmi odoc_sig.cmi
odoc_parameter.cmo odoc_print.cmi odoc_type.cmo odoc_types.cmi \
odoc_value.cmo ../parsing/parsetree.cmi ../typing/path.cmi \
../typing/typedtree.cmi ../typing/types.cmi odoc_sig.cmi
odoc_sig.cmx: ../parsing/asttypes.cmi ../typing/btype.cmx \
../parsing/location.cmx ../utils/misc.cmx odoc_args.cmx odoc_class.cmx \
odoc_env.cmx odoc_exception.cmx odoc_global.cmx odoc_merge.cmx \
odoc_messages.cmx odoc_misc.cmx odoc_module.cmx odoc_name.cmx \
odoc_parameter.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
../parsing/parsetree.cmi ../typing/path.cmx ../typing/typedtree.cmx \
../typing/types.cmx odoc_sig.cmi
odoc_parameter.cmx odoc_print.cmx odoc_type.cmx odoc_types.cmx \
odoc_value.cmx ../parsing/parsetree.cmi ../typing/path.cmx \
../typing/typedtree.cmx ../typing/types.cmx odoc_sig.cmi
odoc_str.cmo: odoc_exception.cmo odoc_messages.cmo odoc_misc.cmi \
odoc_name.cmi odoc_print.cmi odoc_type.cmo odoc_value.cmo \
../typing/printtyp.cmi ../typing/types.cmi odoc_str.cmi

89
ocamldoc/odoc_ast.ml
View File

@ -1384,6 +1384,15 @@ module Analyser =
let pos_start = p_module_expr.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
let pos_end = p_module_expr.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
let modtype = tt_module_expr.Typedtree.mod_type in
let m_code_intf =
match p_module_expr.Parsetree.pmod_desc with
Parsetree.Pmod_constraint (_, pmodule_type) ->
let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
Some (get_string_of_file loc_start loc_end)
| _ ->
None
in
let m_base =
{
m_name = complete_name ;
@ -1395,7 +1404,7 @@ module Analyser =
m_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ;
m_top_deps = [] ;
m_code = None ; (* code is set by the caller, after the module is created *)
m_code_intf = None ;
m_code_intf = m_code_intf ;
}
in
match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with
@ -1411,30 +1420,35 @@ module Analyser =
let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
{ m_base with m_kind = Module_struct elements2 }
| (Parsetree.Pmod_functor (_, _, p_module_expr2),
| (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2),
Typedtree.Tmod_functor (ident, mtyp, tt_module_expr2)) ->
let param =
{
mp_name = Name.from_ident ident ;
mp_type = Odoc_env.subst_module_type env mtyp ;
}
in
let dummy_complete_name = Name.concat "__" param.mp_name in
let new_env = Odoc_env.add_module env dummy_complete_name in
let m_base2 = analyse_module
new_env
current_module_name
module_name
None
p_module_expr2
tt_module_expr2
in
let kind =
match m_base2.m_kind with
Module_functor (params, k) -> Module_functor (param :: params, m_base2.m_kind)
| k -> Module_functor ([param], k)
in
{ m_base with m_kind = kind }
let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
let param =
{
mp_name = Name.from_ident ident ;
mp_type = Odoc_env.subst_module_type env mtyp ;
mp_type_code = mp_type_code ;
}
in
let dummy_complete_name = Name.concat "__" param.mp_name in
let new_env = Odoc_env.add_module env dummy_complete_name in
let m_base2 = analyse_module
new_env
current_module_name
module_name
None
p_module_expr2
tt_module_expr2
in
let kind =
match m_base2.m_kind with
Module_functor (params, k) -> Module_functor (param :: params, m_base2.m_kind)
| k -> Module_functor ([param], k)
in
{ m_base with m_kind = kind }
| (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _))
@ -1552,21 +1566,18 @@ module Analyser =
let included_modules_from_tt = tt_get_included_module_list tree_structure in
let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
let kind = Module_struct elements2 in
let m =
{
m_name = mod_name ;
m_type = Types.Tmty_signature [] ;
m_info = info_opt ;
m_is_interface = false ;
m_file = !file_name ;
m_kind = kind ;
m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ;
m_top_deps = [] ;
m_code = (if !Odoc_args.keep_code then Some !file else None) ;
m_code_intf = None ;
}
in
m
{
m_name = mod_name ;
m_type = Types.Tmty_signature [] ;
m_info = info_opt ;
m_is_interface = false ;
m_file = !file_name ;
m_kind = kind ;
m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ;
m_top_deps = [] ;
m_code = (if !Odoc_args.keep_code then Some !file else None) ;
m_code_intf = None ;
}
end

37
ocamldoc/odoc_html.ml
View File

@ -964,11 +964,17 @@ class html =
method create_fully_qualified_module_idents_links m_name s =
let f str_t =
let match_s = Str.matched_string str_t in
let rel = Name.get_relative m_name match_s in
let s_final = Odoc_info.apply_if_equal
Odoc_info.use_hidden_modules
match_s
rel
in
if StringSet.mem match_s known_modules_names then
let (html_file, _) = Naming.html_files match_s in
"<a href=\""^html_file^"\">"^(Name.get_relative m_name match_s)^"</a>"
"<a href=\""^html_file^"\">"^s_final^"</a>"
else
match_s
s_final
in
let s2 = Str.global_substitute
(Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)")
@ -1022,12 +1028,16 @@ class html =
bs b "</code>"
(** Print html code to display a [Types.module_type]. *)
method html_of_module_type b m_name t =
let s = remove_last_newline (Odoc_info.string_of_module_type t) in
method html_of_module_type b ?code m_name t =
let s = remove_last_newline (Odoc_info.string_of_module_type ?code t) in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_module_idents_links m_name s);
bs b "</code>"
(** Print html code to display the type of a module parameter.. *)
method html_of_module_parameter_type b m_name p =
self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type
(** Generate a file containing the module type in the given file name. *)
method output_module_type in_title file mtyp =
let s = remove_last_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in
@ -1378,7 +1388,7 @@ class html =
bs b "</code></td>\n" ;
bs b "<td align=\"center\" valign=\"top\">:</td>\n";
bs b "<td>" ;
self#html_of_module_type b m_name p.mp_type;
self#html_of_module_parameter_type b m_name p;
bs b "\n";
(
match desc_opt with
@ -1857,7 +1867,9 @@ class html =
self#html_of_modtype b ~with_link: false mt;
(* parameters for functors *)
self#html_of_module_parameter_list b "" (Module.module_type_parameters mt);
self#html_of_module_parameter_list b
(Name.father mt.mt_name)
(Module.module_type_parameters mt);
(* a horizontal line *)
bs b "<hr width=\"100%\">\n";
(* module elements *)
@ -1950,7 +1962,9 @@ class html =
self#html_of_module b ~with_link: false modu;
(* parameters for functors *)
self#html_of_module_parameter_list b "" (Module.module_parameters modu);
self#html_of_module_parameter_list b
(Name.father modu.m_name)
(Module.module_parameters modu);
(* a horizontal line *)
bs b "<hr width=\"100%\">\n";
@ -2192,12 +2206,17 @@ class html =
(* Get the names of all known modules and module types. *)
let module_types = Odoc_info.Search.module_types module_list in
let modules = Odoc_info.Search.modules module_list in
let module_type_names = List.map (fun mt -> mt.mt_name) module_types in
known_modules_names <-
List.fold_left
(fun acc m -> StringSet.add m.m_name acc)
known_modules_names
modules ;
known_modules_names <-
List.fold_left
(fun acc mt -> StringSet.add mt.mt_name acc)
known_modules_names
module_types ;
(* generate html for each module *)
if not !Args.index_only then
self#generate_elements self#generate_for_module module_list ;

5
ocamldoc/odoc_info.mli
View File

@ -143,6 +143,7 @@ module Parameter :
{
mp_name : string ;
mp_type : Types.module_type ;
mp_type_code : string ;
}
(** {3 Functions} *)
@ -632,8 +633,10 @@ val string_of_class_type_param_list : Types.type_expr list -> 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].
@param code if [complete = false] and the type contains something else
than identificators and functors, then the given code is used.
*)
val string_of_module_type : ?complete: bool -> Types.module_type -> string
val string_of_module_type : ?code: string -> ?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

40
ocamldoc/odoc_name.ml
View File

@ -79,10 +79,28 @@ let father name = fst (cut name)
let concat n1 n2 = n1^"."^n2
let head n =
match Str.split (Str.regexp "\\.") n with
[] -> n
| h :: _ -> h
let head_and_tail n =
try
let pos = String.index n '.' in
if pos > 0 then
let h = String.sub n 0 pos in
try
ignore (String.index h '(');
(n, "")
with
Not_found ->
let len = String.length n in
if pos >= (len - 1) then
(h, "")
else
(h, String.sub n (pos + 1) (len - pos - 1))
else
(n, "")
with
Not_found -> (n, "")
let head n = fst (head_and_tail n)
let tail n = snd (head_and_tail n)
let depth name =
try
@ -98,6 +116,20 @@ let prefix n1 n2 =
(n2.[len1] = '.')
with _ -> false)
let rec get_relative_raw n1 n2 =
let (f1,s1) = head_and_tail n1 in
let (f2,s2) = head_and_tail n2 in
if f1 = f2 then
if f2 = s2 or s2 = "" then
s2
else
if f1 = s1 or s1 = "" then
s2
else
get_relative_raw s1 s2
else
n2
let get_relative n1 n2 =
if prefix n1 n2 then
let len1 = String.length n1 in

5
ocamldoc/odoc_name.mli
View File

@ -41,9 +41,12 @@ val prefix : t -> t -> bool
(** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *)
val get_relative : t -> t -> t
(** Take two names n1=n3.n4 and n2 = n5.n6 and return n6 if n3=n5 or else n2. *)
val get_relative_raw : t -> t -> t
(** Take a list of module names to hide and a name,
and return the name when the module name (or part of it)
was removedn, according to the list of module names to hide.*)
was removed, according to the list of module names to hide.*)
val hide_given_modules : t list -> t -> t
(** Indicate if a name if qualified or not. *)

1
ocamldoc/odoc_parameter.ml
View File

@ -38,6 +38,7 @@ type parameter = param_info
type module_parameter = {
mp_name : string ;
mp_type : Types.module_type ;
mp_type_code : string ;
}

28
ocamldoc/odoc_print.ml
View File

@ -44,22 +44,36 @@ let string_of_type_expr t =
Printtyp.type_scheme_max ~b_reset_names: false type_fmt t;
flush_type_fmt ()
exception Use_code of string
(** 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 =
from the signatures. Used when we don't want to print a too long module type.
@param code when the code is given, we raise the [Use_code] exception is we
encouter a signature, to that the calling function can use the code rather
than the "emptied" type.
*)
let simpl_module_type ?code t =
let rec iter t =
match t with
Types.Tmty_ident p -> t
| Types.Tmty_signature _ -> Types.Tmty_signature []
| Types.Tmty_signature _ ->
(
match code with
None -> Types.Tmty_signature []
| Some s -> raise (Use_code s)
)
| 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 modtype_fmt t2;
flush_modtype_fmt ()
let string_of_module_type ?code ?(complete=false) t =
try
let t2 = if complete then t else simpl_module_type ?code t in
Printtyp.modtype modtype_fmt t2;
flush_modtype_fmt ()
with
Use_code s -> s
(** 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.*)

4
ocamldoc/odoc_print.mli
View File

@ -20,8 +20,10 @@ val string_of_type_expr : Types.type_expr -> 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].
@param code if [complete = false] and the type contains something else
than identificators and functors, then the given code is used.
*)
val string_of_module_type : ?complete: bool -> Types.module_type -> string
val string_of_module_type : ?code: string -> ?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

61
ocamldoc/odoc_sig.ml
View File

@ -1077,14 +1077,19 @@ module Analyser =
raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
)
| Parsetree.Pmty_functor (_,_, module_type2) ->
| Parsetree.Pmty_functor (_,pmodule_type2, module_type2) ->
(
let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
match sig_module_type with
Types.Tmty_functor (ident, param_module_type, body_module_type) ->
let param =
{
mp_name = Name.from_ident ident ;
mp_type = Odoc_env.subst_module_type env param_module_type ;
mp_type_code = mp_type_code ;
}
in
(
@ -1140,14 +1145,19 @@ module Analyser =
(* if we're here something's wrong *)
raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
)
| Parsetree.Pmty_functor (_,_,module_type2) (* of string * module_type * module_type *) ->
| Parsetree.Pmty_functor (_,pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
(
match sig_module_type with
Types.Tmty_functor (ident, param_module_type, body_module_type) ->
let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
let mp_type_code = get_string_of_file loc_start loc_end in
print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
let param =
{
mp_name = Name.from_ident ident ;
mp_type = Odoc_env.subst_module_type env param_module_type ;
mp_type_code = mp_type_code ;
}
in
(
@ -1321,41 +1331,18 @@ module Analyser =
else
None
in
let m =
{
m_name = mod_name ;
m_type = Types.Tmty_signature signat ;
m_info = info_opt ;
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_top_deps = [] ;
m_code = None ;
m_code_intf = code_intf ;
}
in
print_DEBUG "Eléments du module:";
let f e =
let s =
match e with
Element_module m -> "module "^m.m_name
| Element_module_type mt -> "module type "^mt.mt_name
| Element_included_module im -> "included module "^im.im_name
| Element_class c -> "class "^c.cl_name
| Element_class_type ct -> "class type "^ct.clt_name
| Element_value v -> "value "^v.val_name
| Element_exception e -> "exception "^e.ex_name
| Element_type t -> "type "^t.ty_name
| Element_module_comment t -> Odoc_misc.string_of_text t
in
print_DEBUG s;
()
in
List.iter f elements;
m
{
m_name = mod_name ;
m_type = Types.Tmty_signature signat ;
m_info = info_opt ;
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_top_deps = [] ;
m_code = None ;
m_code_intf = code_intf ;
}
end