summaryrefslogtreecommitdiff
path: root/ocamldoc
diff options
context:
space:
mode:
authorMaxence Guesdon <maxence.guesdon@inria.fr>2004-11-03 09:31:19 +0000
committerMaxence Guesdon <maxence.guesdon@inria.fr>2004-11-03 09:31:19 +0000
commit6f3977d7a2585ff5846ac3cceba9c225e564a91e (patch)
treeb13443a7ae640e3552df4ef840430230d156774f /ocamldoc
parent041523b74b6b239a52a396a45d14c89bf7586c7f (diff)
downloadocaml-6f3977d7a2585ff5846ac3cceba9c225e564a91e.tar.gz
use locations in variant to associate comments correctly
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6661 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'ocamldoc')
-rw-r--r--ocamldoc/odoc_ast.ml392
-rw-r--r--ocamldoc/odoc_sig.ml372
-rw-r--r--ocamldoc/odoc_sig.mli69
3 files changed, 404 insertions, 429 deletions
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index fda03a08d8..c73d3f567c 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -37,13 +37,13 @@ let blank = "[ \010\013\009\012']"
let simple_blank = "[ \013\009\012]"
-(** This module is used to search for structure items by name in a Typedtree.structure.
+(** This module is used to search for structure items by name in a Typedtree.structure.
One function creates two hash tables, which can then be used to search for elements.
Class elements do not use tables.
*)
module Typedtree_search =
struct
- type ele =
+ type ele =
| M of string
| MT of string
| T of string
@@ -63,18 +63,18 @@ module Typedtree_search =
| Typedtree.Tpat_tuple _ -> None (* A VOIR quand on traitera les tuples *)
| _ -> None
- let add_to_hashes table table_values tt =
+ let add_to_hashes table table_values tt =
match tt with
- | Typedtree.Tstr_module (ident, _) ->
+ | Typedtree.Tstr_module (ident, _) ->
Hashtbl.add table (M (Name.from_ident ident)) tt
| Typedtree.Tstr_recmodule mods ->
List.iter
- (fun (ident,mod_expr) ->
+ (fun (ident,mod_expr) ->
Hashtbl.add table (M (Name.from_ident ident))
(Typedtree.Tstr_module (ident,mod_expr))
)
mods
- | Typedtree.Tstr_modtype (ident, _) ->
+ | Typedtree.Tstr_modtype (ident, _) ->
Hashtbl.add table (MT (Name.from_ident ident)) tt
| Typedtree.Tstr_exception (ident, _) ->
Hashtbl.add table (E (Name.from_ident ident)) tt
@@ -82,19 +82,19 @@ module Typedtree_search =
Hashtbl.add table (ER (Name.from_ident ident)) tt
| Typedtree.Tstr_type ident_type_decl_list ->
List.iter
- (fun (id, e) ->
- Hashtbl.add table (T (Name.from_ident id))
+ (fun (id, e) ->
+ Hashtbl.add table (T (Name.from_ident id))
(Typedtree.Tstr_type [(id,e)]))
ident_type_decl_list
| Typedtree.Tstr_class info_list ->
List.iter
- (fun ((id,_,_,_) as ci) ->
+ (fun ((id,_,_,_) as ci) ->
Hashtbl.add table (C (Name.from_ident id))
(Typedtree.Tstr_class [ci]))
info_list
| Typedtree.Tstr_cltype info_list ->
List.iter
- (fun ((id,_) as ci) ->
+ (fun ((id,_) as ci) ->
Hashtbl.add table
(CT (Name.from_ident id))
(Typedtree.Tstr_cltype [ci]))
@@ -162,7 +162,7 @@ module Typedtree_search =
| (Typedtree.Tstr_cltype [(_,cltype_decl)]) -> cltype_decl
| _ -> assert false
- let search_value table name = Hashtbl.find table name
+ let search_value table name = Hashtbl.find table name
let search_primitive table name =
match Hashtbl.find table (P name) with
@@ -184,7 +184,7 @@ module Typedtree_search =
let rec iter = function
| [] ->
raise Not_found
- | Typedtree.Cf_val (_, ident, exp) :: q
+ | Typedtree.Cf_val (_, ident, exp) :: q
when Name.from_ident ident = name ->
exp.Typedtree.exp_type
| _ :: q ->
@@ -204,7 +204,7 @@ module Typedtree_search =
iter cls.Typedtree.cl_field
end
-module Analyser =
+module Analyser =
functor (My_ir : Odoc_sig.Info_retriever) ->
struct
@@ -231,7 +231,7 @@ module Analyser =
(** The function used to get the comments in a module. *)
let get_comments_in_module = Sig.get_comments_in_module
- (** This function takes a parameter pattern and builds the
+ (** 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 parameter name.
@@ -244,8 +244,8 @@ module Analyser =
Simple_name { sn_name = name ;
sn_text = f_desc name ;
sn_type = Odoc_env.subst_type env pat.pat_type
- }
-
+ }
+
| Typedtree.Tpat_alias (pat, _) ->
iter_pattern pat
@@ -253,12 +253,12 @@ module Analyser =
Tuple
(List.map iter_pattern patlist,
Odoc_env.subst_type env pat.pat_type)
-
- | Typedtree.Tpat_construct (cons_desc, _) when
+
+ | Typedtree.Tpat_construct (cons_desc, _) when
(* we give a name to the parameter only if it unit *)
(match cons_desc.cstr_res.desc with
Tconstr (p, _, _) ->
- Path.same p Predef.path_unit
+ Path.same p Predef.path_unit
| _ ->
false)
->
@@ -266,16 +266,16 @@ module Analyser =
Simple_name { sn_name = "()" ;
sn_text = None ;
sn_type = Odoc_env.subst_type env pat.pat_type
- }
+ }
| _ ->
(* implicit pattern matching -> anonymous parameter *)
Simple_name { sn_name = "()" ;
sn_text = None ;
sn_type = Odoc_env.subst_type env pat.pat_type
- }
+ }
in
- iter_pattern pat
+ iter_pattern pat
(** Analysis of the parameter of a function. Return a list of t_parameter created from
the (pattern, expression) structures encountered. *)
@@ -292,17 +292,17 @@ module Analyser =
[ parameter ]
| (pattern_param, func_body) :: [] ->
- let parameter =
- tt_param_info_from_pattern
+ let parameter =
+ tt_param_info_from_pattern
env
- (Odoc_parameter.desc_from_info_opt current_comment_opt)
+ (Odoc_parameter.desc_from_info_opt current_comment_opt)
pattern_param
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) =
+ let (p, next_exp) =
match parameter with
Simple_name { sn_name = "*opt*" } ->
(
@@ -310,7 +310,7 @@ module Analyser =
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
+ 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
@@ -352,12 +352,12 @@ module Analyser =
val_parameters = tt_analyse_function_parameters env comment_opt pat_exp_list2 ;
val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ;
val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
- }
+ }
in
[ new_value ]
-
+
| (Typedtree.Tpat_var ident, _) ->
- (* a new value is defined *)
+ (* a new value is defined *)
let name_pre = Name.from_ident ident in
let name = Name.parens_if_infix name_pre in
let complete_name = Name.concat current_module_name name in
@@ -369,15 +369,15 @@ module Analyser =
val_parameters = [] ;
val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ;
val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
- }
+ }
in
[ new_value ]
-
+
| (Typedtree.Tpat_tuple lpat, _) ->
(* new identifiers are defined *)
(* A VOIR : by now we don't accept to have global variables defined in tuples *)
[]
-
+
| _ ->
(* something else, we don't care ? A VOIR *)
[]
@@ -406,7 +406,7 @@ module Analyser =
*)
| _ -> Odoc_messages.object_end
- (** Analysis of a method expression to get the method parameters.
+ (** Analysis of a method expression to get the method parameters.
@param first indicates if we're analysing the method for
the first time ; in that case we must not keep the first parameter,
which is "self-*", the object itself.
@@ -429,25 +429,25 @@ module Analyser =
(* 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_name = "??" ; sn_text = None;
sn_type = Odoc_env.subst_type env pattern_param.Typedtree.pat_type }
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 =
+ let parameter =
tt_param_info_from_pattern
env
- (Odoc_parameter.desc_from_info_opt comment_opt)
+ (Odoc_parameter.desc_from_info_opt comment_opt)
pattern_param
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) =
+ let (current_param, next_exp) =
match parameter with
Simple_name { sn_name = "*opt*"} ->
(
@@ -455,10 +455,10 @@ module Analyser =
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
+ 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 ;
+ sn_type = Odoc_env.subst_type env exp.Typedtree.exp_type ;
}
in
(new_param, body2)
@@ -480,11 +480,11 @@ module Analyser =
(* no more parameter *)
[]
- (** Analysis of a [Parsetree.class_struture] and a [Typedtree.class_structure] to get a couple
+ (** Analysis of a [Parsetree.class_struture] and a [Typedtree.class_structure] to get a couple
(inherited classes, class elements). *)
let analyse_class_structure env current_class_name tt_class_sig last_pos pos_limit p_cls tt_cls =
let rec iter acc_inher acc_fields last_pos = function
- | [] ->
+ | [] ->
let s = get_string_of_file last_pos pos_limit in
let (_, ele_coms) = My_ir.all_special !file_name s in
let ele_comments =
@@ -507,17 +507,17 @@ module Analyser =
with Not_found -> raise (Failure (Odoc_messages.inherit_classexp_not_found_in_typedtree n))
in
let (info_opt, ele_comments) =
- get_comments_in_class last_pos
- p_clexp.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum
+ get_comments_in_class last_pos
+ p_clexp.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum
in
let text_opt = match info_opt with None -> None | Some i -> i.Odoc_types.i_desc in
let name = tt_name_of_class_expr tt_clexp in
let inher =
- {
- ic_name = Odoc_env.full_class_or_class_type_name env name ;
- ic_class = None ;
+ {
+ ic_name = Odoc_env.full_class_or_class_type_name env name ;
+ ic_class = None ;
ic_text = text_opt ;
- }
+ }
in
iter (acc_inher @ [ inher ]) (acc_fields @ ele_comments)
p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
@@ -532,24 +532,24 @@ module Analyser =
in
let att =
{
- att_value = { val_name = complete_name ;
+ att_value = { val_name = complete_name ;
val_info = info_opt ;
val_type = Odoc_env.subst_type env type_exp ;
val_recursive = false ;
- val_parameters = [] ;
+ val_parameters = [] ;
val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ;
val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
} ;
att_mutable = mutable_flag = Asttypes.Mutable ;
- }
+ }
in
iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q
-
+
| (Parsetree.Pcf_virt (label, private_flag, _, loc)) :: q ->
let complete_name = Name.concat current_class_name label in
let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
- let met_type =
- try Odoc_sig.Signature_search.search_method_type label tt_class_sig
+ let met_type =
+ try Odoc_sig.Signature_search.search_method_type label tt_class_sig
with Not_found -> raise (Failure (Odoc_messages.method_type_not_found current_class_name label))
in
let real_type =
@@ -560,7 +560,7 @@ module Analyser =
(* ?!? : not an arrow type ! return the original type *)
met_type
in
- let met =
+ let met =
{
met_value = { val_name = complete_name ;
val_info = info_opt ;
@@ -572,7 +572,7 @@ module Analyser =
} ;
met_private = private_flag = Asttypes.Private ;
met_virtual = true ;
- }
+ }
in
(* update the parameter description *)
Odoc_value.update_value_parameters_text met.met_value;
@@ -582,7 +582,7 @@ module Analyser =
| (Parsetree.Pcf_meth (label, private_flag, _, loc)) :: q ->
let complete_name = Name.concat current_class_name label in
let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
- let exp =
+ let exp =
try Typedtree_search.search_method_expression tt_cls label
with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name))
in
@@ -594,7 +594,7 @@ module Analyser =
(* ?!? : not an arrow type ! return the original type *)
exp.Typedtree.exp_type
in
- let met =
+ let met =
{
met_value = { val_name = complete_name ;
val_info = info_opt ;
@@ -606,13 +606,13 @@ module Analyser =
} ;
met_private = private_flag = Asttypes.Private ;
met_virtual = false ;
- }
+ }
in
(* update the parameter description *)
Odoc_value.update_value_parameters_text met.met_value;
iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
-
+
| Parsetree.Pcf_cstr (_, _, loc) :: q ->
(* don't give a $*%@ ! *)
iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
@@ -625,14 +625,14 @@ module Analyser =
iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q
in
iter [] [] last_pos (snd p_cls)
-
+
(** Analysis of a [Parsetree.class_expr] and a [Typedtree.class_expr] to get a a couple (class parameters, class kind). *)
let rec analyse_class_kind env current_class_name comment_opt last_pos p_class_expr tt_class_exp =
match (p_class_expr.Parsetree.pcl_desc, tt_class_exp.Typedtree.cl_desc) with
- (Parsetree.Pcl_constr (lid, _), tt_class_exp_desc ) ->
- let name =
+ (Parsetree.Pcl_constr (lid, _), tt_class_exp_desc ) ->
+ let name =
match tt_class_exp_desc with
- Typedtree.Tclass_ident p -> Name.from_path p
+ Typedtree.Tclass_ident p -> Name.from_path p
| _ ->
(* we try to get the name from the environment. *)
(* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *)
@@ -640,7 +640,7 @@ module Analyser =
in
(* On n'a pas ici les paramètres de type sous forme de Types.type_expr,
par contre on peut les trouver dans le class_type *)
- let params =
+ let params =
match tt_class_exp.Typedtree.cl_type with
Types.Tcty_constr (p2, type_exp_list, cltyp) ->
(* cltyp is the class type for [type_exp_list] p *)
@@ -648,24 +648,24 @@ module Analyser =
| _ ->
[]
in
- ([],
+ ([],
Class_constr
{
cco_name = Odoc_env.full_class_name env name ;
cco_class = None ;
- cco_type_parameters = List.map (Odoc_env.subst_type env) params ;
+ cco_type_parameters = List.map (Odoc_env.subst_type env) params ;
} )
| (Parsetree.Pcl_structure p_class_structure, Typedtree.Tclass_structure tt_class_structure) ->
(* we need the class signature to get the type of methods in analyse_class_structure *)
- let tt_class_sig =
+ let tt_class_sig =
match tt_class_exp.Typedtree.cl_type with
Types.Tcty_signature class_sig -> class_sig
| _ -> raise (Failure "analyse_class_kind: no class signature for a class structure.")
in
- let (inherited_classes, class_elements) = analyse_class_structure
+ let (inherited_classes, class_elements) = analyse_class_structure
env
- current_class_name
+ current_class_name
tt_class_sig
last_pos
p_class_expr.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
@@ -674,7 +674,7 @@ module Analyser =
in
([],
Class_structure (inherited_classes, class_elements) )
-
+
| (Parsetree.Pcl_fun (label, expression_opt, pattern, p_class_expr2),
Typedtree.Tclass_fun (pat, ident_exp_list, tt_class_expr2, partial)) ->
(* we check that this is not an optional parameter with
@@ -701,7 +701,7 @@ module Analyser =
)
| _ ->
(* no optional parameter with default value, we create the parameter *)
- let new_param =
+ let new_param =
tt_param_info_from_pattern
env
(Odoc_parameter.desc_from_info_opt comment_opt)
@@ -718,7 +718,7 @@ module Analyser =
because if the class applied has no name, the code is kinda ugly, isn't it ? *)
match tt_class_expr2.Typedtree.cl_desc with
Typedtree.Tclass_ident p -> Name.from_path p (* A VOIR : obtenir le nom complet *)
- | _ ->
+ | _ ->
(* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *)
match p_class_expr2.Parsetree.pcl_desc with
Parsetree.Pcl_constr (lid, _) ->
@@ -728,17 +728,17 @@ module Analyser =
Odoc_messages.object_end
in
let param_exps = List.fold_left
- (fun acc -> fun (exp_opt, _) ->
- match exp_opt with
+ (fun acc -> fun (exp_opt, _) ->
+ match exp_opt with
None -> acc
| Some e -> acc @ [e])
[]
exp_opt_optional_list
in
let param_types = List.map (fun e -> e.Typedtree.exp_type) param_exps in
- let params_code =
- List.map
- (fun e -> get_string_of_file
+ let params_code =
+ List.map
+ (fun e -> get_string_of_file
e.exp_loc.Location.loc_start.Lexing.pos_cnum
e.exp_loc.Location.loc_end.Lexing.pos_cnum)
param_exps
@@ -754,12 +754,12 @@ module Analyser =
| (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tclass_let (_, _, _, tt_class_expr2)) ->
(* we don't care about these lets *)
analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2
-
- | (Parsetree.Pcl_constraint (p_class_expr2, p_class_type2),
+
+ | (Parsetree.Pcl_constraint (p_class_expr2, p_class_type2),
Typedtree.Tclass_constraint (tt_class_expr2, _, _, _)) ->
let (l, class_kind) = analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2 in
(* A VOIR : analyse du class type ? on n'a pas toutes les infos. cf. Odoc_sig.analyse_class_type_kind *)
- let class_type_kind =
+ let class_type_kind =
(*Sig.analyse_class_type_kind
env
""
@@ -783,7 +783,7 @@ module Analyser =
let type_parameters = tt_type_params in
let virt = p_class_decl.Parsetree.pci_virt = Asttypes.Virtual in
let cltype = Odoc_env.subst_class_type env tt_class_exp.Typedtree.cl_type in
- let (parameters, kind) = analyse_class_kind
+ let (parameters, kind) = analyse_class_kind
env
complete_name
comment_opt
@@ -801,7 +801,7 @@ module Analyser =
cl_kind = kind ;
cl_parameters = parameters ;
cl_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ;
- }
+ }
in
cl
@@ -812,7 +812,7 @@ module Analyser =
Typedtree.Tmod_ident p -> Name.from_path p
| Typedtree.Tmod_constraint (m_exp, _, _) -> tt_name_from_module_expr m_exp
| Typedtree.Tmod_structure _
- | Typedtree.Tmod_functor _
+ | Typedtree.Tmod_functor _
| Typedtree.Tmod_apply _ ->
Odoc_messages.struct_end
@@ -826,8 +826,8 @@ module Analyser =
im_name = tt_name_from_module_expr mod_expr ;
im_module = None ;
im_info = None ;
- }
- ]
+ }
+ ]
| _ ->
acc
in
@@ -840,7 +840,7 @@ module Analyser =
| ([], _) ->
[]
| ((Element_included_module im) :: q, (im_repl :: im_q)) ->
- (Element_included_module { im_repl with im_info = im.im_info })
+ (Element_included_module { im_repl with im_info = im.im_info })
:: (f (q, im_q))
| ((Element_included_module im) :: q, []) ->
(Element_included_module im) :: q
@@ -850,11 +850,11 @@ module Analyser =
f (module_elements, included_modules)
(** Analysis of a parse tree structure with a typed tree, to return module elements.*)
- let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree =
+ let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree =
print_DEBUG "Odoc_ast:analyse_struture";
let (table, table_values) = Typedtree_search.tables typedtree in
let rec iter env last_pos = function
- [] ->
+ [] ->
let s = get_string_of_file last_pos pos_limit in
let (_, ele_coms) = My_ir.all_special !file_name s in
let ele_comments =
@@ -869,9 +869,9 @@ module Analyser =
ele_coms
in
ele_comments
- | item :: q ->
- let (comment_opt, ele_comments) =
- get_comments_in_module last_pos item.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum
+ | item :: q ->
+ let (comment_opt, ele_comments) =
+ get_comments_in_module last_pos item.Parsetree.pstr_loc.Location.loc_start.Lexing.pos_cnum
in
let pos_limit2 =
match q with
@@ -886,7 +886,7 @@ module Analyser =
comment_opt
item.Parsetree.pstr_desc
typedtree
- table
+ table
table_values
in
ele_comments @ elements @ (iter new_env (item.Parsetree.pstr_loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q)
@@ -894,8 +894,8 @@ module Analyser =
iter env last_pos parsetree
(** Analysis of a parse tree structure item to obtain a new environment and a list of elements.*)
- and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc typedtree
- table table_values =
+ and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc typedtree
+ table table_values =
print_DEBUG "Odoc_ast:analyse_struture_item";
match parsetree_item_desc with
Parsetree.Pstr_eval _ ->
@@ -932,10 +932,10 @@ module Analyser =
(comment_opt, [])
else
get_comments_in_module
- last_pos
+ last_pos
pat.Parsetree.ppat_loc.Location.loc_start.Lexing.pos_cnum
in
- let l_values = tt_analyse_value
+ let l_values = tt_analyse_value
env
current_module_name
info_opt
@@ -943,7 +943,7 @@ module Analyser =
pat_exp
rec_flag
in
- let new_env = List.fold_left
+ let new_env = List.fold_left
(fun e -> fun v ->
Odoc_env.add_value e v.val_name
)
@@ -951,9 +951,9 @@ module Analyser =
l_values
in
let l_ele = List.map (fun v -> Element_value v) l_values in
- iter
- new_last_pos
- new_env
+ iter
+ new_last_pos
+ new_env
(acc @ ele_comments @ l_ele)
q
with
@@ -977,7 +977,7 @@ module Analyser =
val_parameters = [] ;
val_code = Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum) ;
val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
- }
+ }
in
let new_env = Odoc_env.add_value env new_value.val_name in
(0, new_env, [Element_value new_value])
@@ -986,7 +986,7 @@ module Analyser =
(* of (string * type_declaration) list *)
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun (name, _) ->
let complete_name = Name.concat current_module_name name in
Odoc_env.add_type acc_env complete_name
@@ -1001,19 +1001,19 @@ module Analyser =
let complete_name = Name.concat current_module_name name in
let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum in
- let pos_limit2 =
- match q with
+ let pos_limit2 =
+ match q with
[] -> pos_limit
| (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
in
- let (maybe_more, name_comment_list) =
+ let (maybe_more, name_comment_list) =
Sig.name_comment_from_type_kind
- loc_start loc_end
+ loc_end
pos_limit2
type_decl.Parsetree.ptype_kind
in
- let tt_type_decl =
- try Typedtree_search.search_type_declaration table name
+ let tt_type_decl =
+ try Typedtree_search.search_type_declaration table name
with Not_found -> raise (Failure (Odoc_messages.type_not_found_in_typedtree complete_name))
in
let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *)
@@ -1031,7 +1031,7 @@ module Analyser =
{
ty_name = complete_name ;
ty_info = com_opt ;
- ty_parameters =
+ ty_parameters =
List.map2
(fun p (co,cn,_) ->
(Odoc_env.subst_type new_env p,
@@ -1045,16 +1045,16 @@ module Analyser =
None -> None
| Some t -> Some (Odoc_env.subst_type new_env t));
ty_loc = { loc_impl = Some (!file_name, loc_start) ; loc_inter = None } ;
- ty_code =
+ ty_code =
(
if !Odoc_args.keep_code then
- Some (get_string_of_file loc_start new_end)
+ Some (get_string_of_file loc_start new_end)
else
None
) ;
- }
+ }
in
- let (maybe_more2, info_after_opt) =
+ let (maybe_more2, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file new_end pos_limit2)
@@ -1070,29 +1070,29 @@ module Analyser =
(* a new exception is defined *)
let complete_name = Name.concat current_module_name name in
(* we get the exception declaration in the typed tree *)
- let tt_excep_decl =
- try Typedtree_search.search_exception table name
- with Not_found ->
+ let tt_excep_decl =
+ try Typedtree_search.search_exception table name
+ with Not_found ->
raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name))
in
let new_env = Odoc_env.add_exception env complete_name in
let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
- let new_ex =
+ let new_ex =
{
ex_name = complete_name ;
ex_info = comment_opt ;
ex_args = List.map (Odoc_env.subst_type new_env) tt_excep_decl ;
ex_alias = None ;
ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
- ex_code =
+ ex_code =
(
if !Odoc_args.keep_code then
Some (get_string_of_file loc_start loc_end)
else
None
) ;
- }
+ }
in
(0, new_env, [ Element_exception new_ex ])
@@ -1100,13 +1100,13 @@ module Analyser =
(* a new exception is defined *)
let complete_name = Name.concat current_module_name name in
(* we get the exception rebind in the typed tree *)
- let tt_path =
- try Typedtree_search.search_exception_rebind table name
- with Not_found ->
+ let tt_path =
+ try Typedtree_search.search_exception_rebind table name
+ with Not_found ->
raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name))
in
let new_env = Odoc_env.add_exception env complete_name in
- let new_ex =
+ let new_ex =
{
ex_name = complete_name ;
ex_info = comment_opt ;
@@ -1115,7 +1115,7 @@ module Analyser =
ea_ex = None ; } ;
ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
ex_code = None ;
- }
+ }
in
(0, new_env, [ Element_exception new_ex ])
@@ -1124,7 +1124,7 @@ module Analyser =
(* of string * module_expr *)
try
let tt_module_expr = Typedtree_search.search_module table name in
- let new_module_pre = analyse_module
+ let new_module_pre = analyse_module
env
current_module_name
name
@@ -1132,7 +1132,7 @@ module Analyser =
module_expr
tt_module_expr
in
- let code =
+ let code =
if !Odoc_args.keep_code then
let loc = module_expr.Parsetree.pmod_loc in
let st = loc.Location.loc_start.Lexing.pos_cnum in
@@ -1145,13 +1145,13 @@ module Analyser =
{ new_module_pre with m_code = code }
in
let new_env = Odoc_env.add_module env new_module.m_name in
- let new_env2 =
+ 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 *)
- 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
- | _ ->
+ | _ ->
new_env
in
(0, new_env2, [ Element_module new_module ])
@@ -1162,18 +1162,18 @@ module Analyser =
)
| Parsetree.Pstr_recmodule mods ->
- (* A VOIR ICI ca merde avec /work/tmp/graph.ml: pas de lien avec les module type
+ (* A VOIR ICI ca merde avec /work/tmp/graph.ml: pas de lien avec les module type
dans les contraintes sur les modules *)
let new_env =
- List.fold_left
+ 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
+ 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
+ let new_module = analyse_module
e
current_module_name
name
@@ -1182,10 +1182,10 @@ module Analyser =
tt_mod_exp
in
match new_module.m_type with
- Types.Tmty_signature s ->
+ Types.Tmty_signature s ->
Odoc_env.add_signature e new_module.m_name
~rel: (Name.simple new_module.m_name) s
- | _ ->
+ | _ ->
e
)
env
@@ -1198,13 +1198,13 @@ module Analyser =
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
+ 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
+ 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 *)
@@ -1213,7 +1213,7 @@ module Analyser =
else
get_comments_in_module last_pos loc_start
in
- let new_module = analyse_module
+ let new_module = analyse_module
new_env
current_module_name
name
@@ -1231,34 +1231,34 @@ module Analyser =
let complete_name = Name.concat current_module_name name in
let tt_module_type =
try Typedtree_search.search_module_type table name
- with Not_found ->
+ with Not_found ->
raise (Failure (Odoc_messages.module_type_not_found_in_typedtree complete_name))
in
let kind = Sig.analyse_module_type_kind env complete_name
modtype tt_module_type
in
- let mt =
+ let mt =
{
mt_name = complete_name ;
mt_info = comment_opt ;
mt_type = Some tt_module_type ;
mt_is_interface = false ;
mt_file = !file_name ;
- mt_kind = Some kind ;
+ mt_kind = Some kind ;
mt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
- }
+ }
in
let new_env = Odoc_env.add_module_type env mt.mt_name in
let new_env2 =
- match tt_module_type with
+ match tt_module_type with
(* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on n'aurait pas la signature *)
- Types.Tmty_signature s ->
+ Types.Tmty_signature s ->
Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
- | _ ->
+ | _ ->
new_env
in
(0, new_env2, [ Element_module_type mt ])
-
+
| Parsetree.Pstr_open longident ->
(* A VOIR : enrichir l'environnement quand open ? *)
let ele_comments = match comment_opt with
@@ -1273,7 +1273,7 @@ module Analyser =
| Parsetree.Pstr_class class_decl_list ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun class_decl ->
let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in
Odoc_env.add_class acc_env complete_name
@@ -1287,7 +1287,7 @@ module Analyser =
[]
| class_decl :: q ->
let (tt_class_exp, tt_type_params) =
- try Typedtree_search.search_class_exp table class_decl.Parsetree.pci_name
+ try Typedtree_search.search_class_exp table class_decl.Parsetree.pci_name
with Not_found ->
let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in
raise (Failure (Odoc_messages.class_not_found_in_typedtree complete_name))
@@ -1296,10 +1296,10 @@ module Analyser =
if first then
(comment_opt, [])
else
- get_comments_in_module last_pos class_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
+ get_comments_in_module last_pos class_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
in
let last_pos2 = class_decl.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
- let new_class = analyse_class
+ let new_class = analyse_class
new_env
current_module_name
com_opt
@@ -1314,7 +1314,7 @@ module Analyser =
| Parsetree.Pstr_class_type class_type_decl_list ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun class_type_decl ->
let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name in
Odoc_env.add_class_type acc_env complete_name
@@ -1331,8 +1331,8 @@ module Analyser =
let complete_name = Name.concat current_module_name name in
let virt = class_type_decl.Parsetree.pci_virt = Asttypes.Virtual in
let tt_cltype_declaration =
- try Typedtree_search.search_class_type_declaration table name
- with Not_found ->
+ try Typedtree_search.search_class_type_declaration table name
+ with Not_found ->
raise (Failure (Odoc_messages.class_type_not_found_in_typedtree complete_name))
in
let type_params = tt_cltype_declaration.Types.clty_params in
@@ -1347,7 +1347,7 @@ module Analyser =
if first then
(comment_opt, [])
else
- get_comments_in_module last_pos class_type_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
+ get_comments_in_module last_pos class_type_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
in
let last_pos2 = class_type_decl.Parsetree.pci_loc.Location.loc_end.Lexing.pos_cnum in
let new_ele =
@@ -1359,9 +1359,9 @@ module Analyser =
clt_type_parameters = List.map (Odoc_env.subst_type new_env) type_params ;
clt_virtual = virt ;
clt_kind = kind ;
- clt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ;
+ clt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ;
loc_inter = None } ;
- }
+ }
in
ele_comments @ (new_ele :: (f last_pos2 q))
in
@@ -1371,12 +1371,12 @@ module Analyser =
(* we add a dummy included module which will be replaced by a correct
one at the end of the module analysis,
to use the Path.t of the included modules in the typdtree. *)
- let im =
+ let im =
{
im_name = "dummy" ;
im_module = None ;
im_info = comment_opt ;
- }
+ }
in
(0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *)
@@ -1385,9 +1385,9 @@ module Analyser =
let complete_name = Name.concat current_module_name module_name in
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 =
+ let modtype =
(* A VOIR : Odoc_env.subst_module_type env ? *)
- tt_module_expr.Typedtree.mod_type
+ tt_module_expr.Typedtree.mod_type
in
let m_code_intf =
match p_module_expr.Parsetree.pmod_desc with
@@ -1410,14 +1410,14 @@ module Analyser =
m_top_deps = [] ;
m_code = None ; (* code is set by the caller, after the module is created *)
m_code_intf = m_code_intf ;
- }
+ }
in
match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with
(Parsetree.Pmod_ident longident, Typedtree.Tmod_ident path) ->
let alias_name = Odoc_env.full_module_name env (Name.from_path path) in
- { m_base with m_kind = Module_alias { ma_name = alias_name ;
+ { m_base with m_kind = Module_alias { ma_name = alias_name ;
ma_module = None ; } }
-
+
| (Parsetree.Pmod_structure p_structure, Typedtree.Tmod_structure tt_structure) ->
let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
(* we must complete the included modules *)
@@ -1425,14 +1425,14 @@ 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 (_, pmodule_type, p_module_expr2),
+ | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2),
Typedtree.Tmod_functor (ident, mtyp, tt_module_expr2)) ->
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 mp_name = Name.from_ident ident in
- let mp_kind = Sig.analyse_module_type_kind env
+ let mp_kind = Sig.analyse_module_type_kind env
current_module_name pmodule_type mtyp
in
let param =
@@ -1441,12 +1441,12 @@ module Analyser =
mp_type = Odoc_env.subst_module_type env mtyp ;
mp_type_code = mp_type_code ;
mp_kind = mp_kind ;
- }
+ }
in
let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
(* TODO: A VOIR CE __ *)
let new_env = Odoc_env.add_module env dummy_complete_name in
- let m_base2 = analyse_module
+ let m_base2 = analyse_module
new_env
current_module_name
module_name
@@ -1457,14 +1457,14 @@ module Analyser =
let kind = m_base2.m_kind in
{ m_base with m_kind = Module_functor (param, kind) }
- | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
+ | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _))
| (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2),
- Typedtree.Tmod_constraint
- ({ Typedtree.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)},
+ Typedtree.Tmod_constraint
+ ({ Typedtree.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)},
_, _)
) ->
- let m1 = analyse_module
+ let m1 = analyse_module
env
current_module_name
module_name
@@ -1482,15 +1482,15 @@ module Analyser =
in
{ m_base with m_kind = Module_apply (m1.m_kind, m2.m_kind) }
- | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype),
+ | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype),
Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) ->
print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name);
- (* we create the module with p_module_expr2 and tt_module_expr2
- but we change its type according to the constraint.
+ (* we create the module with p_module_expr2 and tt_module_expr2
+ but we change its type according to the constraint.
A VOIR : est-ce que c'est bien ?
*)
- let m_base2 = analyse_module
+ let m_base2 = analyse_module
env
current_module_name
module_name
@@ -1498,25 +1498,25 @@ module Analyser =
p_module_expr2
tt_module_expr2
in
- let mtkind = Sig.analyse_module_type_kind
- env
+ let mtkind = Sig.analyse_module_type_kind
+ env
(Name.concat current_module_name "??")
p_modtype tt_modtype
in
- {
+ {
m_base with
- m_type = Odoc_env.subst_module_type env tt_modtype ;
- m_kind = Module_constraint (m_base2.m_kind,
+ m_type = Odoc_env.subst_module_type env tt_modtype ;
+ m_kind = Module_constraint (m_base2.m_kind,
mtkind)
(* Module_type_alias { mta_name = "Not analyzed" ;
mta_module = None })
*)
}
-
+
| (Parsetree.Pmod_structure p_structure,
- Typedtree.Tmod_constraint
- ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure},
+ Typedtree.Tmod_constraint
+ ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure},
tt_modtype, _)
) ->
(* needed for recursive modules *)
@@ -1526,13 +1526,13 @@ module Analyser =
(* 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_base with
m_type = Odoc_env.subst_module_type env tt_modtype ;
m_kind = Module_struct elements2 ;
}
| (parsetree, typedtree) ->
- let s_parse =
+ let s_parse =
match parsetree with
Parsetree.Pmod_ident _ -> "Pmod_ident"
| Parsetree.Pmod_structure _ -> "Pmod_structure"
@@ -1540,7 +1540,7 @@ module Analyser =
| Parsetree.Pmod_apply _ -> "Pmod_apply"
| Parsetree.Pmod_constraint _ -> "Pmod_constraint"
in
- let s_typed =
+ let s_typed =
match typedtree with
Typedtree.Tmod_ident _ -> "Tmod_ident"
| Typedtree.Tmod_structure _ -> "Tmod_structure"
@@ -1550,11 +1550,11 @@ module Analyser =
in
let code = get_string_of_file pos_start pos_end in
print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed);
-
+
raise (Failure "analyse_module: parsetree and typedtree don't match.")
- let analyse_typed_tree source_file input_file
- (parsetree : Parsetree.structure) (typedtree : typedtree) =
+ let analyse_typed_tree source_file input_file
+ (parsetree : Parsetree.structure) (typedtree : typedtree) =
let (tree_structure, _) = typedtree in
let complete_source_file =
try
@@ -1574,7 +1574,7 @@ module Analyser =
(* We create the t_module for this file. *)
let mod_name = String.capitalize (Filename.basename (Filename.chop_extension source_file)) in
let (len,info_opt) = My_ir.first_special !file_name !file in
-
+
(* we must complete the included modules *)
let elements = analyse_structure Odoc_env.empty mod_name len (String.length !file) parsetree tree_structure in
let included_modules_from_tt = tt_get_included_module_list tree_structure in
@@ -1591,7 +1591,7 @@ module Analyser =
m_top_deps = [] ;
m_code = (if !Odoc_args.keep_code then Some !file else None) ;
m_code_intf = None ;
- }
+ }
end
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index 23be6e8dd3..f3236137ca 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -32,7 +32,7 @@ open Odoc_types
module Signature_search =
struct
- type ele =
+ type ele =
| M of string
| MT of string
| V of string
@@ -109,7 +109,7 @@ module Signature_search =
let search_attribute_type name class_sig =
let (_, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
type_expr
-
+
let search_method_type name class_sig =
let fields = Odoc_misc.get_fields class_sig.Types.cty_self in
List.assoc name fields
@@ -121,11 +121,11 @@ module type Info_retriever =
val blank_line_outside_simple : string -> string -> bool
val just_after_special : string -> string -> (int * Odoc_types.info option)
val first_special : string -> string -> (int * Odoc_types.info option)
- val get_comments :
+ val get_comments :
(Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
end
-module Analyser =
+module Analyser =
functor (My_ir : Info_retriever) ->
struct
(** This variable is used to load a file as a string and retrieve characters from it.*)
@@ -158,71 +158,46 @@ module Analyser =
(** The function used to get the comments in a class. *)
let get_comments_in_class pos_start pos_end =
- My_ir.get_comments (fun t -> Class_comment t)
+ My_ir.get_comments (fun t -> Class_comment t)
!file_name
(get_string_of_file pos_start pos_end)
(** The function used to get the comments in a module. *)
let get_comments_in_module pos_start pos_end =
- My_ir.get_comments (fun t -> Element_module_comment t)
+ My_ir.get_comments (fun t -> Element_module_comment t)
!file_name
(get_string_of_file pos_start pos_end)
- let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options
+ let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options
- let name_comment_from_type_kind pos_start pos_end pos_limit tk =
+ let name_comment_from_type_kind pos_end pos_limit tk =
match tk with
Parsetree.Ptype_abstract ->
(0, [])
- | Parsetree.Ptype_variant (cons_core_type_list_list, _) ->
- (*of (string * core_type list) list *)
- let rec f acc last_pos cons_core_type_list_list =
+ | Parsetree.Ptype_variant (cons_core_type_list_list, _) ->
+ let rec f acc cons_core_type_list_list =
match cons_core_type_list_list with
[] ->
(0, acc)
- | (name, core_type_list, xxloc) :: [] ->
- let pos = Str.search_forward (Str.regexp_string name) !file last_pos in
- let s = get_string_of_file pos_end pos_limit in
+ | (name, core_type_list, loc) :: [] ->
+ let s = get_string_of_file
+ loc.Location.loc_end.Lexing.pos_cnum
+ pos_limit
+ in
let (len, comment_opt) = My_ir.just_after_special !file_name s in
(len, acc @ [ (name, comment_opt) ])
- | (name, core_type_list, xxloc) :: (name2, core_type_list2, loc2)
+ | (name, core_type_list, loc) :: (name2, core_type_list2, loc2)
:: q ->
- match (List.rev core_type_list, core_type_list2) with
- ([], []) ->
- let pos = Str.search_forward (Str.regexp_string name) !file last_pos in
- let pos' = pos + (String.length name) in
- let pos2 = Str.search_forward (Str.regexp_string name2) !file pos' in
- let s = get_string_of_file pos' pos2 in
- let (_,comment_opt) = My_ir.just_after_special !file_name s in
- f (acc @ [name, comment_opt]) pos2
- ((name2, core_type_list2, loc2) :: q)
-
- | ([], (ct2 :: _)) ->
- let pos = Str.search_forward (Str.regexp_string name) !file last_pos in
- let pos' = pos + (String.length name) in
- let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
- let pos2' = Str.search_backward (Str.regexp_string name2) !file pos2 in
- let s = get_string_of_file pos' pos2' in
- let (_,comment_opt) = My_ir.just_after_special !file_name s in
- f (acc @ [name, comment_opt]) pos2'
- ((name2, core_type_list2, loc2) :: q)
-
- | ((ct :: _), _) ->
- let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
- let pos2 = Str.search_forward (Str.regexp_string name2) !file pos in
- let s = get_string_of_file pos pos2 in
- let (_,comment_opt) = My_ir.just_after_special !file_name s in
- let new_pos_end =
- match comment_opt with
- None -> ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum
- | Some _ -> Str.search_forward (Str.regexp "*)") !file pos
- in
- f (acc @ [name, comment_opt]) new_pos_end
- ((name2, core_type_list2, loc2) :: q)
+ let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in
+ let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in
+ let s = get_string_of_file pos_end_first pos_start_second in
+ let (_,comment_opt) = My_ir.just_after_special !file_name s in
+ f (acc @ [name, comment_opt])
+ ((name2, core_type_list2, loc2) :: q)
in
- f [] pos_start cons_core_type_list_list
-
+ f [] cons_core_type_list_list
+
| Parsetree.Ptype_record (name_mutable_type_list, _) (* of (string * mutable_flag * core_type) list*) ->
let rec f = function
[] ->
@@ -248,8 +223,8 @@ module Analyser =
| Types.Type_variant (l, priv) ->
let f (constructor_name, type_expr_list) =
- let comment_opt =
- try
+ let comment_opt =
+ try
match List.assoc constructor_name name_comment_list with
None -> None
| Some d -> d.Odoc_types.i_desc
@@ -259,14 +234,14 @@ module Analyser =
vc_name = constructor_name ;
vc_args = List.map (Odoc_env.subst_type env) type_expr_list ;
vc_text = comment_opt
- }
+ }
in
Odoc_type.Type_variant (List.map f l, priv = Asttypes.Private)
| Types.Type_record (l, _, priv) ->
let f (field_name, mutable_flag, type_expr) =
- let comment_opt =
- try
+ let comment_opt =
+ try
match List.assoc field_name name_comment_list with
None -> None
| Some d -> d.Odoc_types.i_desc
@@ -277,13 +252,13 @@ module Analyser =
rf_mutable = mutable_flag = Mutable ;
rf_type = Odoc_env.subst_type env type_expr ;
rf_text = comment_opt
- }
+ }
in
Odoc_type.Type_record (List.map f l, priv = Asttypes.Private)
(** Analysis of the elements of a class, from the information in the parsetree and in the class
signature. @return the couple (inherited_class list, elements).*)
- let analyse_class_elements env current_class_name last_pos pos_limit
+ let analyse_class_elements env current_class_name last_pos pos_limit
class_type_field_list class_signature =
print_DEBUG "Types.Tcty_signature class_signature";
let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
@@ -295,7 +270,7 @@ module Analyser =
[] -> pos_limit
| ele2 :: _ ->
match ele2 with
- Parsetree.Pctf_val (_, _, _, loc)
+ Parsetree.Pctf_val (_, _, _, loc)
| Parsetree.Pctf_virt (_, _, _, loc)
| Parsetree.Pctf_meth (_, _, _, loc)
| Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum
@@ -304,7 +279,7 @@ module Analyser =
in
let get_method name comment_opt private_flag loc q =
let complete_name = Name.concat current_class_name name in
- let typ =
+ let typ =
try Signature_search.search_method_type name class_signature
with Not_found ->
raise (Failure (Odoc_messages.method_type_not_found current_class_name name))
@@ -312,7 +287,7 @@ module Analyser =
let subst_typ = Odoc_env.subst_type env typ in
let met =
{
- met_value =
+ met_value =
{
val_name = complete_name ;
val_info = comment_opt ;
@@ -328,7 +303,7 @@ module Analyser =
in
let pos_limit2 = get_pos_limit2 q in
let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end pos_limit2)
@@ -360,7 +335,7 @@ module Analyser =
(* of (string * mutable_flag * core_type option * Location.t)*)
let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
let complete_name = Name.concat current_class_name name in
- let typ =
+ let typ =
try Signature_search.search_attribute_type name class_signature
with Not_found ->
raise (Failure (Odoc_messages.attribute_type_not_found current_class_name name))
@@ -368,7 +343,7 @@ module Analyser =
let subst_typ = Odoc_env.subst_type env typ in
let att =
{
- att_value =
+ att_value =
{
val_name = complete_name ;
val_info = comment_opt ;
@@ -379,11 +354,11 @@ module Analyser =
val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ;
} ;
att_mutable = mutable_flag = Asttypes.Mutable ;
- }
+ }
in
let pos_limit2 = get_pos_limit2 q in
let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end pos_limit2)
@@ -413,36 +388,36 @@ module Analyser =
let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
let (inher_l, eles) = f loc.Location.loc_end.Lexing.pos_cnum q in
(inher_l, eles_comments @ eles)
-
+
| Parsetree.Pctf_inher class_type :: q ->
let loc = class_type.Parsetree.pcty_loc in
- let (comment_opt, eles_comments) =
+ let (comment_opt, eles_comments) =
get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum
in
let pos_limit2 = get_pos_limit2 q in
let pos_end = loc.Location.loc_end.Lexing.pos_cnum in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end pos_limit2)
in
let comment_opt2 = merge_infos comment_opt info_after_opt in
let text_opt = match comment_opt2 with None -> None | Some i -> i.Odoc_types.i_desc in
- let inh =
+ let inh =
match class_type.Parsetree.pcty_desc with
Parsetree.Pcty_constr (longident, _) ->
(*of Longident.t * core_type list*)
let name = Name.from_longident longident in
- let ic =
+ let ic =
{
ic_name = Odoc_env.full_class_or_class_type_name env name ;
ic_class = None ;
ic_text = text_opt ;
- }
+ }
in
ic
-
- | Parsetree.Pcty_signature _
+
+ | Parsetree.Pcty_signature _
| Parsetree.Pcty_fun _ ->
(* we don't have a name for the class signature, so we call it "object ... end" *)
{
@@ -480,7 +455,7 @@ module Analyser =
acc_eles @ ele_comments
| ele :: q ->
- let (assoc_com, ele_comments) = get_comments_in_module
+ let (assoc_com, ele_comments) = get_comments_in_module
last_pos
ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
in
@@ -491,8 +466,8 @@ module Analyser =
current_module_name
ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum
- (match q with
- [] -> pos_limit
+ (match q with
+ [] -> pos_limit
| ele2 :: _ -> ele2.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum
)
assoc_com
@@ -500,8 +475,8 @@ module Analyser =
in
f (acc_eles @ (ele_comments @ elements))
new_env
- (ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum + maybe_more)
- (* for the comments of constructors in types,
+ (ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum + maybe_more)
+ (* for the comments of constructors in types,
which are after the constructor definition and can
go beyond ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum *)
q
@@ -510,18 +485,18 @@ module Analyser =
(** Analyse the given signature_item_desc to create the corresponding module element
(with the given attached comment).*)
- and analyse_signature_item_desc env signat table current_module_name
+ and analyse_signature_item_desc env signat table current_module_name
pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc =
match sig_item_desc with
Parsetree.Psig_value (name_pre, value_desc) ->
- let type_expr =
+ let type_expr =
try Signature_search.search_value table name_pre
with Not_found ->
raise (Failure (Odoc_messages.value_not_found current_module_name name_pre))
in
let name = Name.parens_if_infix name_pre in
let subst_typ = Odoc_env.subst_type env type_expr in
- let v =
+ let v =
{
val_name = Name.concat current_module_name name ;
val_info = comment_opt ;
@@ -530,9 +505,9 @@ module Analyser =
val_parameters = Odoc_value.dummy_parameter_list subst_typ ;
val_code = None ;
val_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele)}
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end_ele pos_limit)
@@ -545,28 +520,28 @@ module Analyser =
(maybe_more, new_env, [ Element_value v ])
| Parsetree.Psig_exception (name, exception_decl) ->
- let types_excep_decl =
- try Signature_search.search_exception table name
- with Not_found ->
+ let types_excep_decl =
+ try Signature_search.search_exception table name
+ with Not_found ->
raise (Failure (Odoc_messages.exception_not_found current_module_name name))
in
let e =
- {
+ {
ex_name = Name.concat current_module_name name ;
ex_info = comment_opt ;
ex_args = List.map (Odoc_env.subst_type env) types_excep_decl ;
ex_alias = None ;
ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
- ex_code =
+ ex_code =
(
if !Odoc_args.keep_code then
Some (get_string_of_file pos_start_ele pos_end_ele)
else
None
) ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end_ele pos_limit)
@@ -578,7 +553,7 @@ module Analyser =
| Parsetree.Psig_type name_type_decl_list ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun (name, _) ->
let complete_name = Name.concat current_module_name name in
Odoc_env.add_type acc_env complete_name
@@ -588,7 +563,7 @@ module Analyser =
in
let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
match name_type_decl_list with
- [] ->
+ [] ->
(acc_maybe_more, [])
| (name, type_decl) :: q ->
let (assoc_com, ele_comments) =
@@ -604,9 +579,8 @@ module Analyser =
[] -> pos_limit
| (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
in
- let (maybe_more, name_comment_list) =
+ let (maybe_more, name_comment_list) =
name_comment_from_type_kind
- type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum
pos_limit2
type_decl.Parsetree.ptype_kind
@@ -615,8 +589,8 @@ module Analyser =
let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
List.iter f_DEBUG name_comment_list;
(* get the information for the type in the signature *)
- let sig_type_decl =
- try Signature_search.search_type table name
+ let sig_type_decl =
+ try Signature_search.search_type table name
with Not_found ->
raise (Failure (Odoc_messages.type_not_found current_module_name name))
in
@@ -629,38 +603,38 @@ module Analyser =
{
ty_name = Name.concat current_module_name name ;
ty_info = assoc_com ;
- ty_parameters =
+ ty_parameters =
List.map2 (fun p (co,cn,_) ->
(Odoc_env.subst_type new_env p,
co, cn)
- )
- sig_type_decl.Types.type_params
+ )
+ sig_type_decl.Types.type_params
sig_type_decl.Types.type_variance;
ty_kind = type_kind ;
- ty_manifest =
+ ty_manifest =
(match sig_type_decl.Types.type_manifest with
None -> None
| Some t -> Some (Odoc_env.subst_type new_env t));
- ty_loc =
- { loc_impl = None ;
+ ty_loc =
+ { loc_impl = None ;
loc_inter = Some (!file_name,loc_start) ;
};
- ty_code =
+ ty_code =
(
if !Odoc_args.keep_code then
- Some (get_string_of_file loc_start new_end)
+ Some (get_string_of_file loc_start new_end)
else
None
) ;
}
in
- let (maybe_more2, info_after_opt) =
+ let (maybe_more2, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file new_end pos_limit2)
in
new_type.ty_info <- merge_infos new_type.ty_info info_after_opt ;
- let (new_maybe_more, eles) = f
+ let (new_maybe_more, eles) = f
(maybe_more + maybe_more2)
(new_end + maybe_more2)
q
@@ -669,7 +643,7 @@ module Analyser =
in
let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
(maybe_more, new_env, types)
-
+
| Parsetree.Psig_open _ -> (* A VOIR *)
let ele_comments = match comment_opt with
None -> []
@@ -683,13 +657,13 @@ module Analyser =
| Parsetree.Psig_module (name, module_type) ->
let complete_name = Name.concat current_module_name name in
(* get the the module type in the signature by the module name *)
- let sig_module_type =
- try Signature_search.search_module table name
+ 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
let module_kind = analyse_module_kind env complete_name module_type sig_module_type in
- let code_intf =
+ let code_intf =
if !Odoc_args.keep_code then
let loc = module_type.Parsetree.pmty_loc in
let st = loc.Location.loc_start.Lexing.pos_cnum in
@@ -698,7 +672,7 @@ module Analyser =
else
None
in
- let new_module =
+ let new_module =
{
m_name = complete_name ;
m_type = sig_module_type;
@@ -710,16 +684,16 @@ module Analyser =
m_top_deps = [] ;
m_code = None ;
m_code_intf = code_intf ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end_ele pos_limit)
in
new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
let new_env = Odoc_env.add_module env new_module.m_name in
- let new_env2 =
+ 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 *)
Types.Tmty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
| _ -> new_env
@@ -729,21 +703,21 @@ module Analyser =
| Parsetree.Psig_recmodule decls ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ 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
+ 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 ->
+ Types.Tmty_signature s ->
Odoc_env.add_signature e complete_name ~rel: name s
- | _ ->
+ | _ ->
print_DEBUG "not a Tmty_signature";
e
)
@@ -752,7 +726,7 @@ module Analyser =
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
@@ -772,14 +746,14 @@ module Analyser =
| (_, 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
+ 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 code_intf =
+ let code_intf =
if !Odoc_args.keep_code then
let loc = modtype.Parsetree.pmty_loc in
let st = loc.Location.loc_start.Lexing.pos_cnum in
@@ -788,7 +762,7 @@ module Analyser =
else
None
in
- let new_module =
+ let new_module =
{
m_name = complete_name ;
m_type = sig_module_type;
@@ -800,16 +774,16 @@ module Analyser =
m_top_deps = [] ;
m_code = None ;
m_code_intf = code_intf ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ 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
+ let (maybe_more2, eles) = f
maybe_more
(loc_end + maybe_more)
q
@@ -817,11 +791,11 @@ module Analyser =
(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)
+ (maybe_more, new_env, mods)
| Parsetree.Psig_modtype (name, Parsetree.Pmodtype_abstract) ->
- let sig_mtype =
- try Signature_search.search_module_type table name
+ let sig_mtype =
+ try Signature_search.search_module_type table name
with Not_found ->
raise (Failure (Odoc_messages.module_type_not_found current_module_name name))
in
@@ -835,9 +809,9 @@ module Analyser =
mt_file = !file_name ;
mt_kind = None ;
mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end_ele pos_limit)
@@ -848,8 +822,8 @@ module Analyser =
| Parsetree.Psig_modtype (name, Parsetree.Pmodtype_manifest module_type) ->
let complete_name = Name.concat current_module_name name in
- let sig_mtype_opt =
- try Signature_search.search_module_type table name
+ let sig_mtype_opt =
+ try Signature_search.search_module_type table name
with Not_found ->
raise (Failure (Odoc_messages.module_type_not_found current_module_name name))
in
@@ -858,7 +832,7 @@ module Analyser =
| Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
| None -> None
in
- let mt =
+ let mt =
{
mt_name = complete_name ;
mt_info = comment_opt ;
@@ -867,9 +841,9 @@ module Analyser =
mt_file = !file_name ;
mt_kind = module_type_kind ;
mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end_ele pos_limit)
@@ -887,7 +861,7 @@ module Analyser =
let rec f = function
Parsetree.Pmty_ident longident ->
Name.from_longident longident
- | Parsetree.Pmty_signature _ ->
+ | Parsetree.Pmty_signature _ ->
"??"
| Parsetree.Pmty_functor _ ->
"??"
@@ -896,19 +870,19 @@ module Analyser =
in
let name = (f module_type.Parsetree.pmty_desc) in
let full_name = Odoc_env.full_module_or_module_type_name env name in
- let im =
+ let im =
{
im_name = full_name ;
im_module = None ;
im_info = comment_opt;
- }
+ }
in
(0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *)
| Parsetree.Psig_class class_description_list ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun class_desc ->
let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name in
Odoc_env.add_class acc_env complete_name
@@ -937,13 +911,13 @@ module Analyser =
in
let name = class_desc.Parsetree.pci_name in
let complete_name = Name.concat current_module_name name in
- let sig_class_decl =
+ let sig_class_decl =
try Signature_search.search_class table name
with Not_found ->
raise (Failure (Odoc_messages.class_not_found current_module_name name))
in
let sig_class_type = sig_class_decl.Types.cty_type in
- let (parameters, class_kind) =
+ let (parameters, class_kind) =
analyse_class_kind
new_env
complete_name
@@ -961,22 +935,22 @@ module Analyser =
cl_kind = class_kind ;
cl_parameters = parameters ;
cl_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end pos_limit2)
in
new_class.cl_info <- merge_infos new_class.cl_info info_after_opt ;
Odoc_class.class_update_parameters_text new_class ;
- let (new_maybe_more, eles) =
+ let (new_maybe_more, eles) =
f maybe_more (pos_end + maybe_more) q
in
(new_maybe_more,
ele_comments @ (( Element_class new_class ) :: eles))
in
- let (maybe_more, eles) =
+ let (maybe_more, eles) =
f ~first: true 0 pos_start_ele class_description_list
in
(maybe_more, new_env, eles)
@@ -984,7 +958,7 @@ module Analyser =
| Parsetree.Psig_class_type class_type_declaration_list ->
(* we start by extending the environment *)
let new_env =
- List.fold_left
+ List.fold_left
(fun acc_env -> fun class_type_decl ->
let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name in
Odoc_env.add_class_type acc_env complete_name
@@ -1013,7 +987,7 @@ module Analyser =
in
let name = ct_decl.Parsetree.pci_name in
let complete_name = Name.concat current_module_name name in
- let sig_cltype_decl =
+ let sig_cltype_decl =
try Signature_search.search_class_type table name
with Not_found ->
raise (Failure (Odoc_messages.class_type_not_found current_module_name name))
@@ -1021,12 +995,12 @@ module Analyser =
let sig_class_type = sig_cltype_decl.Types.clty_type in
let kind = analyse_class_type_kind
new_env
- complete_name
+ complete_name
ct_decl.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum
ct_decl.Parsetree.pci_expr
sig_class_type
in
- let ct =
+ let ct =
{
clt_name = complete_name ;
clt_info = assoc_com ;
@@ -1035,21 +1009,21 @@ module Analyser =
clt_virtual = ct_decl.Parsetree.pci_virt = Asttypes.Virtual ;
clt_kind = kind ;
clt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ;
- }
+ }
in
- let (maybe_more, info_after_opt) =
+ let (maybe_more, info_after_opt) =
My_ir.just_after_special
!file_name
(get_string_of_file pos_end pos_limit2)
in
ct.clt_info <- merge_infos ct.clt_info info_after_opt ;
- let (new_maybe_more, eles) =
+ let (new_maybe_more, eles) =
f maybe_more (pos_end + maybe_more) q
in
(new_maybe_more,
ele_comments @ (( Element_class_type ct) :: eles))
in
- let (maybe_more, eles) =
+ let (maybe_more, eles) =
f ~first: true 0 pos_start_ele class_type_declaration_list
in
(maybe_more, new_env, eles)
@@ -1058,13 +1032,13 @@ module Analyser =
and analyse_module_type_kind env current_module_name module_type sig_module_type =
match module_type.Parsetree.pmty_desc with
Parsetree.Pmty_ident longident ->
- let name =
+ let name =
match sig_module_type with
Types.Tmty_ident path -> Name.from_path path
- | _ -> Name.from_longident longident
+ | _ -> Name.from_longident longident
(* A VOIR cela arrive quand on fait module type F : functor ... -> Toto, Toto n'est pas un ident mais une structure *)
in
- Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
+ Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ;
mta_module = None }
| Parsetree.Pmty_signature ast ->
@@ -1079,7 +1053,7 @@ module Analyser =
| _ ->
raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
)
-
+
| Parsetree.Pmty_functor (_,pmodule_type2, module_type2) ->
(
let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
@@ -1088,21 +1062,21 @@ module Analyser =
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 mp_kind = analyse_module_type_kind env
- current_module_name pmodule_type2 param_module_type
+ let mp_kind = analyse_module_type_kind env
+ current_module_name pmodule_type2 param_module_type
in
- let param =
+ 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 ;
mp_kind = mp_kind ;
- }
+ }
in
- let k = analyse_module_type_kind env
- current_module_name
- module_type2
- body_module_type
+ let k = analyse_module_type_kind env
+ current_module_name
+ module_type2
+ body_module_type
in
Module_type_functor (param, k)
@@ -1133,7 +1107,7 @@ module Analyser =
match sig_module_type with
Types.Tmty_signature signat ->
Module_struct
- (analyse_parsetree
+ (analyse_parsetree
env
signat
current_module_name
@@ -1153,24 +1127,24 @@ module Analyser =
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 mp_kind = analyse_module_type_kind env
- current_module_name pmodule_type2 param_module_type
+ let mp_kind = analyse_module_type_kind env
+ current_module_name pmodule_type2 param_module_type
in
- let param =
+ 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 ;
mp_kind = mp_kind ;
- }
+ }
in
- let k = analyse_module_kind env
- current_module_name
- module_type2
- body_module_type
+ let k = analyse_module_kind env
+ current_module_name
+ module_type2
+ body_module_type
in
Module_functor (param, k)
-
+
| _ ->
(* if we're here something's wrong *)
raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _")
@@ -1194,13 +1168,13 @@ module Analyser =
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
+ let k =
+ Class_constr
{
cco_name = name ;
cco_class = None ;
cco_type_parameters = List.map (Odoc_env.subst_type env) typ_list
- }
+ }
in
([], k)
@@ -1211,7 +1185,7 @@ module Analyser =
print_DEBUG ("Type de la classe "^current_class_name^" : ");
print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
(* we get the elements of the class in class_type_field_list *)
- let (inher_l, ele) = analyse_class_elements env current_class_name
+ let (inher_l, ele) = analyse_class_elements env current_class_name
last_pos
parse_class_type.Parsetree.pcty_loc.Location.loc_end.Lexing.pos_cnum
class_type_field_list
@@ -1219,12 +1193,12 @@ module Analyser =
in
([], Class_structure (inher_l, ele))
- | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
+ | (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. ici on a l'information pour savoir si on a un label explicite. *)
if parse_label = label then
(
- let new_param = Simple_name
+ let new_param = Simple_name
{
sn_name = Btype.label_name label ;
sn_type = Odoc_env.subst_type env type_expr ;
@@ -1238,7 +1212,7 @@ module Analyser =
(
raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents")
)
-
+
| _ ->
raise (Failure "analyse_class_kind pas de correspondance dans le match")
@@ -1248,13 +1222,13 @@ 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 k =
- Class_type
+ let k =
+ Class_type
{
cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ;
cta_class = None ;
cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list
- }
+ }
in
k
@@ -1273,16 +1247,16 @@ module Analyser =
in
Class_signature (inher_l, ele)
- | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
+ | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Tcty_fun (label, type_expr, class_type)) ->
raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Tcty_fun (...)")
(*
| (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
Types.Tcty_signature class_signature) ->
- (* A VOIR : c'est pour le cas des contraintes de classes :
+ (* A VOIR : c'est pour le cas des contraintes de classes :
class type cons = object
method m : int
end
-
+
class ['a] maxou x =
(object
val a = (x : 'a)
@@ -1290,13 +1264,13 @@ module Analyser =
end : cons )
^^^^^^
*)
- let k =
- Class_type
+ let k =
+ Class_type
{
cta_name = Odoc_env.full_class_name env (Name.from_longident longident) ;
cta_class = None ;
cta_type_parameters = List.map (Odoc_env.subst_type env) typ_list (* ?? *)
- }
+ }
in
([], k)
*)
@@ -1304,7 +1278,7 @@ module Analyser =
raise (Failure "analyse_class_type_kind pas de correspondance dans le match")
let analyse_signature source_file input_file
- (ast : Parsetree.signature) (signat : Types.signature) =
+ (ast : Parsetree.signature) (signat : Types.signature) =
let complete_source_file =
try
let curdir = Sys.getcwd () in
@@ -1322,13 +1296,13 @@ module Analyser =
prepare_file complete_source_file input_file;
(* We create the t_module for this file. *)
let mod_name = String.capitalize
- (Filename.basename (try Filename.chop_extension source_file with _ -> source_file))
+ (Filename.basename (try Filename.chop_extension source_file with _ -> source_file))
in
let (len,info_opt) = My_ir.first_special !file_name !file in
- let elements =
- analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast
+ let elements =
+ analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast
in
- let code_intf =
+ let code_intf =
if !Odoc_args.keep_code then
Some !file
else
@@ -1345,8 +1319,8 @@ module Analyser =
m_top_deps = [] ;
m_code = None ;
m_code_intf = code_intf ;
- }
-
+ }
+
end
(* eof $Id$ *)
diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli
index bbd946420d..71e68d6fee 100644
--- a/ocamldoc/odoc_sig.mli
+++ b/ocamldoc/odoc_sig.mli
@@ -24,53 +24,53 @@ module Signature_search :
val table : Types.signature -> tab
(** This function returns the type expression for the value whose name is given,
- in the given signature.
+ in the given signature.
@raise Not_found if error.*)
val search_value : tab -> string -> Types.type_expr
(** This function returns the type expression list for the exception whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_exception : tab -> string -> Types.exception_declaration
-
+
(** This function returns the Types.type_declaration for the type whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_type : tab -> string -> Types.type_declaration
-
+
(** This function returns the Types.class_declaration for the class whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_class : tab -> string -> Types.class_declaration
(** This function returns the Types.cltype_declaration for the class type whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_class_type : tab -> string -> Types.cltype_declaration
(** This function returns the Types.module_type for the module whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_module : tab -> string -> Types.module_type
(** This function returns the optional Types.module_type for the module type whose name is given,
- in the given table.
+ in the given table.
@raise Not_found if error.*)
val search_module_type : tab -> string -> Types.module_type option
(** This function returns the Types.type_expr for the given val name
- in the given class signature.
+ in the given class signature.
@raise Not_found if error.*)
val search_attribute_type :
Types.Vars.key -> Types.class_signature -> Types.type_expr
(** This function returns the Types.type_expr for the given method name
- in the given class signature.
+ in the given class signature.
@raise Not_found if error.*)
val search_method_type :
string -> Types.class_signature -> Types.type_expr
end
-
+
(** Functions to retrieve simple and special comments from strings. *)
module type Info_retriever =
sig
@@ -85,24 +85,24 @@ module type Info_retriever =
string -> string -> bool
(** [just_after_special file str] return the pair ([length], [info_opt])
- where [info_opt] is the first optional special comment found
+ where [info_opt] is the first optional special comment found
in [str], without any blank line before. [length] is the number
of chars from the beginning of [str] to the end of the special comment. *)
val just_after_special :
string -> string -> (int * Odoc_types.info option)
(** [first_special file str] return the pair ([length], [info_opt])
- where [info_opt] is the first optional special comment found
+ where [info_opt] is the first optional special comment found
in [str]. [length] is the number of chars from the beginning of [str]
to the end of the special comment. *)
val first_special :
string -> string -> (int * Odoc_types.info option)
(** Return a pair [(comment_opt, element_comment_list)], where [comment_opt] is the last special
- comment found in the given string and not followed by a blank line,
+ comment found in the given string and not followed by a blank line,
and [element_comment_list] the list of values built from the other
special comments found and the given function. *)
- val get_comments :
+ val get_comments :
(Odoc_types.text -> 'a) -> string -> string -> (Odoc_types.info option * 'a list)
end
@@ -111,7 +111,7 @@ module Analyser :
functor (My_ir : Info_retriever) ->
sig
(** This variable is used to load a file as a string and retrieve characters from it.*)
- val file : string ref
+ val file : string ref
(** The name of the analysed file. *)
val file_name : string ref
@@ -120,42 +120,43 @@ module Analyser :
corresponding to the indexes in the file global variable. The function
prepare_file must have been called to fill the file global variable.*)
val get_string_of_file : int -> int -> string
-
+
(** [prepare_file f input_f] sets [file_name] with [f] and loads the file
[input_f] into [file].*)
val prepare_file : string -> string -> unit
-
+
(** The function used to get the comments in a class. *)
- val get_comments_in_class : int -> int ->
+ val get_comments_in_class : int -> int ->
(Odoc_types.info option * Odoc_class.class_element list)
(** The function used to get the comments in a module. *)
- val get_comments_in_module : int -> int ->
+ val get_comments_in_module : int -> int ->
(Odoc_types.info option * Odoc_module.module_element list)
- (** This function takes a [Parsetree.type_kind] and returns the list of
- (name, optional comment) for the various fields/constructors of the type,
+ (** [name_comment_from_type_kind pos_end pos_limit type_kind].
+ This function takes a [Parsetree.type_kind] and returns the list of
+ (name, optional comment) for the various fields/constructors of the type,
or an empty list for an abstract type.
- [pos_start] and [pos_end] are the first and last char of the complete type definition.
+ [pos_end] is last char of the complete type definition.
[pos_limit] is the position of the last char we could use to look for a comment,
i.e. usually the beginning on the next element.*)
- val name_comment_from_type_kind :
- int -> int -> int -> Parsetree.type_kind -> int * (string * Odoc_types.info option) list
+ val name_comment_from_type_kind :
+ int -> int -> Parsetree.type_kind -> int * (string * Odoc_types.info option) list
(** This function converts a [Types.type_kind] into a [Odoc_type.type_kind],
by associating the comment found in the parsetree of each constructor/field, if any.*)
- val get_type_kind :
- Odoc_env.env -> (string * Odoc_types.info option) list ->
+ val get_type_kind :
+ Odoc_env.env -> (string * Odoc_types.info option) list ->
Types.type_kind -> Odoc_type.type_kind
(** This function merge two optional info structures. *)
- val merge_infos :
- Odoc_types.info option -> Odoc_types.info option ->
+ val merge_infos :
+ Odoc_types.info option -> Odoc_types.info option ->
Odoc_types.info option
(** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *)
- val analyse_module_type_kind :
- Odoc_env.env -> Odoc_name.t ->
+ val analyse_module_type_kind :
+ Odoc_env.env -> Odoc_name.t ->
Parsetree.module_type -> Types.module_type ->
Odoc_module.module_type_kind
@@ -165,12 +166,12 @@ module Analyser :
Odoc_name.t -> int -> Parsetree.class_type -> Types.class_type ->
Odoc_class.class_type_kind
- (** This function takes an interface file name, a file containg the code, a parse tree
+ (** This function takes an interface file name, a file containg the code, a parse tree
and the signature obtained from the compiler.
It goes through the parse tree, creating values for encountered
functions, modules, ..., looking in the source file for comments,
and in the signature for types information. *)
- val analyse_signature :
+ val analyse_signature :
string -> string ->
Parsetree.signature -> Types.signature -> Odoc_module.t_module
end
View Lorry Controller Status