summaryrefslogtreecommitdiff
path: root/ocamldoc/odoc_sig.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ocamldoc/odoc_sig.ml')
-rw-r--r--ocamldoc/odoc_sig.ml117
1 files changed, 55 insertions, 62 deletions
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index cb025f22d1..20ee0ed693 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -51,13 +51,13 @@ module Signature_search =
Hashtbl.add table (V (Name.from_ident ident)) signat
| Types.Tsig_exception (ident, _) ->
Hashtbl.add table (E (Name.from_ident ident)) signat
- | Types.Tsig_type (ident, _) ->
+ | Types.Tsig_type (ident, _, _) ->
Hashtbl.add table (T (Name.from_ident ident)) signat
- | Types.Tsig_class (ident,_) ->
+ | Types.Tsig_class (ident, _, _) ->
Hashtbl.add table (C (Name.from_ident ident)) signat
- | Types.Tsig_cltype (ident, _) ->
+ | Types.Tsig_cltype (ident, _, _) ->
Hashtbl.add table (CT (Name.from_ident ident)) signat
- | Types.Tsig_module (ident, _) ->
+ | Types.Tsig_module (ident, _, _) ->
Hashtbl.add table (M (Name.from_ident ident)) signat
| Types.Tsig_modtype (ident,_) ->
Hashtbl.add table (MT (Name.from_ident ident)) signat
@@ -80,22 +80,22 @@ module Signature_search =
let search_type table name =
match Hashtbl.find table (T name) with
- | (Types.Tsig_type (_, type_decl)) -> type_decl
+ | (Types.Tsig_type (_, type_decl, _)) -> type_decl
| _ -> assert false
let search_class table name =
match Hashtbl.find table (C name) with
- | (Types.Tsig_class (_, class_decl)) -> class_decl
+ | (Types.Tsig_class (_, class_decl, _)) -> class_decl
| _ -> assert false
let search_class_type table name =
match Hashtbl.find table (CT name) with
- | (Types.Tsig_cltype (_, cltype_decl)) -> cltype_decl
+ | (Types.Tsig_cltype (_, cltype_decl, _)) -> cltype_decl
| _ -> assert false
let search_module table name =
match Hashtbl.find table (M name) with
- | (Types.Tsig_module (ident, module_type)) -> module_type
+ | (Types.Tsig_module (ident, module_type, _)) -> module_type
| _ -> assert false
let search_module_type table name =
@@ -285,7 +285,7 @@ module Analyser =
let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
print_DEBUG ("Type de la classe "^current_class_name^" : ");
- print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+ print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
let get_pos_limit2 q =
match q with
[] -> pos_limit
@@ -1077,23 +1077,31 @@ 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 mp_kind = analyse_module_type_kind env
+ current_module_name pmodule_type2 param_module_type
+ in
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
- (
- match analyse_module_type_kind env current_module_name module_type2 body_module_type with
- Module_type_functor (params, k) ->
- Module_type_functor (param :: params, k)
- | k ->
- Module_type_functor ([param], k)
- )
+ let k = analyse_module_type_kind env
+ current_module_name
+ module_type2
+ body_module_type
+ in
+ Module_type_functor (param, k)
| _ ->
(* if we're here something's wrong *)
@@ -1140,23 +1148,31 @@ 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 mp_kind = analyse_module_type_kind env
+ current_module_name pmodule_type2 param_module_type
+ in
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
- (
- match analyse_module_kind env current_module_name module_type2 body_module_type with
- Module_functor (params, k) ->
- Module_functor (param :: params, k)
- | k ->
- Module_functor ([param], k)
- )
+ 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 *)
@@ -1196,7 +1212,7 @@ module Analyser =
let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
print_DEBUG ("Type de la classe "^current_class_name^" : ");
- print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+ 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
last_pos
@@ -1250,7 +1266,7 @@ module Analyser =
let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
print_DEBUG ("Type de la classe "^current_class_name^" : ");
- print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+ 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
last_pos
@@ -1321,41 +1337,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
View Lorry Controller Status