summaryrefslogtreecommitdiff
path: root/ocamldoc
diff options
context:
space:
mode:
Diffstat (limited to 'ocamldoc')
-rw-r--r--ocamldoc/odoc_ast.ml118
-rw-r--r--ocamldoc/odoc_env.ml14
-rw-r--r--ocamldoc/odoc_print.ml14
-rw-r--r--ocamldoc/odoc_sig.ml151
4 files changed, 185 insertions, 112 deletions
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index bd13c1ff0d..0203752dec 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -60,12 +60,15 @@ module Typedtree_search =
let add_to_hashes table table_values tt =
match tt with
| Typedtree.Tstr_module mb ->
- Hashtbl.add table (M (Name.from_ident mb.mb_id)) tt
+ Option.iter (fun id ->
+ Hashtbl.add table (M (Name.from_ident id)) tt) mb.mb_id
| Typedtree.Tstr_recmodule mods ->
List.iter
(fun mb ->
- Hashtbl.add table (M (Name.from_ident mb.mb_id))
- (Typedtree.Tstr_module mb)
+ Option.iter (fun id ->
+ Hashtbl.add table (M (Name.from_ident id))
+ (Typedtree.Tstr_module mb)
+ ) mb.mb_id
)
mods
| Typedtree.Tstr_modtype mtd ->
@@ -1395,15 +1398,18 @@ module Analyser =
in
(0, new_env, [ Element_exception new_ext ])
- | Parsetree.Pstr_module {Parsetree.pmb_name=name; pmb_expr=module_expr} ->
+ | Parsetree.Pstr_module {Parsetree.pmb_name={txt=None}} ->
+ (0, env, [])
+
+ | Parsetree.Pstr_module {Parsetree.pmb_name={txt=Some name}; pmb_expr=module_expr} ->
(
(* of string * module_expr *)
try
- let tt_module_expr = Typedtree_search.search_module table name.txt in
+ let tt_module_expr = Typedtree_search.search_module table name in
let new_module_pre = analyse_module
env
current_module_name
- name.txt
+ name
comment_opt
module_expr
tt_module_expr
@@ -1433,7 +1439,7 @@ module Analyser =
(0, new_env2, [ Element_module new_module ])
with
Not_found ->
- let complete_name = Name.concat current_module_name name.txt in
+ let complete_name = Name.concat current_module_name name in
raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
)
@@ -1443,26 +1449,29 @@ module Analyser =
let new_env =
List.fold_left
(fun acc_env {Parsetree.pmb_name=name;pmb_expr=mod_exp} ->
- let complete_name = Name.concat current_module_name name.txt in
- let e = Odoc_env.add_module acc_env complete_name in
- let tt_mod_exp =
- try Typedtree_search.search_module table name.txt
- with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
- in
- let new_module = analyse_module
- e
- current_module_name
- name.txt
- None
- mod_exp
- tt_mod_exp
- in
- match new_module.m_type with
- Types.Mty_signature s ->
- Odoc_env.add_signature e new_module.m_name
- ~rel: (Name.simple new_module.m_name) s
- | _ ->
- e
+ match name.txt with
+ | None -> acc_env
+ | Some name ->
+ 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
+ with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name))
+ in
+ let new_module = analyse_module
+ e
+ current_module_name
+ name
+ None
+ mod_exp
+ tt_mod_exp
+ in
+ match new_module.m_type with
+ Types.Mty_signature s ->
+ Odoc_env.add_signature e new_module.m_name
+ ~rel: (Name.simple new_module.m_name) s
+ | _ ->
+ e
)
env
mods
@@ -1470,12 +1479,23 @@ module Analyser =
let rec f ?(first=false) last_pos name_mod_exp_list =
match name_mod_exp_list with
[] -> []
- | {Parsetree.pmb_name=name;pmb_expr=mod_exp} :: q ->
- let complete_name = Name.concat current_module_name name.txt in
+ | {Parsetree.pmb_name={txt=None};pmb_expr=mod_exp} :: q ->
+ 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 (_, ele_comments) = (* the comment for the first type was already retrieved *)
+ if first then
+ (None, [])
+ else
+ get_comments_in_module last_pos loc_start
+ in
+ let eles = f loc_end q in
+ ele_comments @ eles
+ | {Parsetree.pmb_name={txt=Some name};pmb_expr=mod_exp} :: q ->
+ 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 tt_mod_exp =
- try Typedtree_search.search_module table name.txt
+ 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 *)
@@ -1487,7 +1507,7 @@ module Analyser =
let new_module = analyse_module
new_env
current_module_name
- name.txt
+ name
com_opt
mod_exp
tt_mod_exp
@@ -1709,29 +1729,33 @@ 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),
- Typedtree.Tmod_functor (ident, _, mtyp, tt_module_expr2)) ->
- let loc = match pmodule_type with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ | (Parsetree.Pmod_functor (param2, p_module_expr2),
+ Typedtree.Tmod_functor (param, tt_module_expr2)) ->
+ let loc, mp_name, mp_kind, mp_type =
+ match param2, param with
+ | Parsetree.Unit, Typedtree.Unit ->
+ Location.none, "*", Module_type_struct [], None
+ | Parsetree.Named (_, pmty), Typedtree.Named (ident, _, mty) ->
+ let loc = pmty.Parsetree.pmty_loc in
+ let mp_name = Option.fold ~none:"*" ~some:Name.from_ident ident in
+ let mp_kind =
+ Sig.analyse_module_type_kind env current_module_name pmty
+ mty.mty_type
+ in
+ let mp_type = Odoc_env.subst_module_type env mty.mty_type in
+ loc, mp_name, mp_kind, Some mp_type
+ | _, _ -> assert false
+ in
let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = 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 =
- match pmodule_type, mtyp with
- Some pmty, Some mty ->
- Sig.analyse_module_type_kind env current_module_name pmty
- mty.mty_type
- | _ -> Module_type_struct []
- in
let param =
{
- mp_name = mp_name ;
- mp_type = Option.map
- (fun m -> Odoc_env.subst_module_type env m.mty_type) mtyp ;
+ mp_name ;
+ mp_type ;
mp_type_code = mp_type_code ;
- mp_kind = mp_kind ;
+ mp_kind ;
}
in
let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml
index 97a215e922..79928f26c9 100644
--- a/ocamldoc/odoc_env.ml
+++ b/ocamldoc/odoc_env.ml
@@ -216,15 +216,17 @@ let subst_type env t =
let subst_module_type env t =
let rec iter t =
+ let open Types in
match t with
- Types.Mty_ident p ->
+ Mty_ident p ->
let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
- Types.Mty_ident new_p
- | Types.Mty_alias _
- | Types.Mty_signature _ ->
+ Mty_ident new_p
+ | Mty_alias _
+ | Mty_signature _ ->
t
- | Types.Mty_functor (id, mt1, mt2) ->
- Types.Mty_functor (id, Option.map iter mt1, iter mt2)
+ | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+ | Mty_functor (Named (name, mt1), mt2) ->
+ Mty_functor (Named (name, iter mt1), iter mt2)
in
iter t
diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml
index 1c660d3e0c..5612e5b7e3 100644
--- a/ocamldoc/odoc_print.ml
+++ b/ocamldoc/odoc_print.ml
@@ -52,18 +52,20 @@ exception Use_code of string
than the "emptied" type.
*)
let simpl_module_type ?code t =
+ let open Types in
let rec iter t =
match t with
- Types.Mty_ident _
- | Types.Mty_alias _ -> t
- | Types.Mty_signature _ ->
+ Mty_ident _
+ | Mty_alias _ -> t
+ | Mty_signature _ ->
(
match code with
- None -> Types.Mty_signature []
+ None -> Mty_signature []
| Some s -> raise (Use_code s)
)
- | Types.Mty_functor (id, mt1, mt2) ->
- Types.Mty_functor (id, Option.map iter mt1, iter mt2)
+ | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt)
+ | Mty_functor (Named (name, mt1), mt2) ->
+ Mty_functor (Named (name, iter mt1), iter mt2)
in
iter t
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index c895d0f850..b695338e2a 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -491,10 +491,11 @@ module Analyser =
| [] -> acc
| types -> take_item (Parsetree.Psig_type (rf, types)))
| Parsetree.Psig_modsubst _ -> acc
- | Parsetree.Psig_module ({Parsetree.pmd_name=name;
+ | Parsetree.Psig_module {Parsetree.pmd_name={ txt = None }} -> acc
+ | Parsetree.Psig_module ({Parsetree.pmd_name={txt = Some name };
pmd_type=module_type} as r)
as m ->
- begin match Name.Map.find name.txt erased with
+ begin match Name.Map.find name erased with
| exception Not_found -> take_item m
| `Removed -> acc
| `Constrained constraints ->
@@ -507,9 +508,15 @@ module Analyser =
| Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
if is_erased name.txt erased then acc else take_item m
| Parsetree.Psig_recmodule mods ->
- (match List.filter (fun pmd -> not (is_erased pmd.Parsetree.pmd_name.txt erased)) mods with
- | [] -> acc
- | mods -> take_item (Parsetree.Psig_recmodule mods)))
+ (match List.filter
+ (fun pmd ->
+ match pmd.Parsetree.pmd_name.txt with
+ | None -> false
+ | Some name -> not (is_erased name erased))
+ mods
+ with
+ | [] -> acc
+ | mods -> take_item (Parsetree.Psig_recmodule mods)))
signature []
(** Analysis of the elements of a class, from the information in the parsetree and in the class
@@ -1141,13 +1148,16 @@ module Analyser =
| Parsetree.Psig_modsubst _ -> (* FIXME *)
(0, env, [])
- | Parsetree.Psig_module {Parsetree.pmd_name=name; pmd_type=module_type} ->
- let complete_name = Name.concat current_module_name name.txt in
+ | Parsetree.Psig_module {Parsetree.pmd_name={txt=None}} ->
+ (0, env, [])
+
+ | Parsetree.Psig_module {Parsetree.pmd_name={txt=Some name}; pmd_type=module_type} ->
+ let complete_name = Name.concat current_module_name name in
(* get the module type in the signature by the module name *)
let sig_module_type =
- try Signature_search.search_module table name.txt
+ try Signature_search.search_module table name
with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
+ 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 =
@@ -1193,31 +1203,60 @@ module Analyser =
let new_env =
List.fold_left
(fun acc_env {Parsetree.pmd_name={txt=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
- with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name))
- in
- match sig_module_type with
- (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
- Types.Mty_signature s ->
- Odoc_env.add_signature e complete_name ~rel: name s
- | _ ->
- print_DEBUG "not a Tmty_signature";
- e
- )
- env
- decls
+ match name with
+ | None -> acc_env
+ | Some 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
+ with Not_found ->
+ raise (Failure (Odoc_messages.module_not_found current_module_name name))
+ in
+ match sig_module_type with
+ (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *)
+ Types.Mty_signature s ->
+ Odoc_env.add_signature e complete_name ~rel: name s
+ | _ ->
+ print_DEBUG "not a Tmty_signature";
+ e
+ )
+ env
+ decls
in
let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list =
match name_mtype_list with
[] ->
(acc_maybe_more, [])
- | {Parsetree.pmd_name=name; pmd_type=modtype} :: q ->
- let complete_name = Name.concat current_module_name name.txt in
+ | {Parsetree.pmd_name={txt = None}; pmd_type=modtype} :: q ->
+ let loc = modtype.Parsetree.pmty_loc in
+ let loc_start = Loc.start loc in
+ let loc_end = Loc.end_ loc in
+ let _, ele_comments =
+ if first then (None, [])
+ else get_comments_in_module last_pos loc_start
+ in
+ let pos_limit2 =
+ match q with
+ [] -> pos_limit
+ | _ :: _ -> Loc.start loc
+ in
+ let (maybe_more, _) =
+ My_ir.just_after_special
+ !file_name
+ (get_string_of_file loc_end pos_limit2)
+ in
+
+ let (maybe_more2, eles) = f
+ maybe_more
+ (loc_end + maybe_more)
+ q
+ in
+ (maybe_more2, ele_comments @ eles)
+
+ | {Parsetree.pmd_name={txt = Some name}; pmd_type=modtype} :: q ->
+ let complete_name = Name.concat current_module_name name in
let loc = modtype.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc in
@@ -1236,9 +1275,9 @@ module Analyser =
in
(* get the information for the module in the signature *)
let sig_module_type =
- try Signature_search.search_module table name.txt
+ try Signature_search.search_module table name
with Not_found ->
- raise (Failure (Odoc_messages.module_not_found current_module_name name.txt))
+ 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
@@ -1543,28 +1582,31 @@ module Analyser =
raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
)
- | Parsetree.Pmty_functor (_, pmodule_type2, module_type2) ->
+ | Parsetree.Pmty_functor (param2, module_type2) ->
(
- let loc = match pmodule_type2 with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ let loc = match param2 with Parsetree.Unit -> Location.none
+ | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc 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.Mty_functor (ident, param_module_type, body_module_type) ->
- let mp_kind =
- match pmodule_type2, param_module_type with
- Some pmty, Some mty ->
+ Types.Mty_functor (param, body_module_type) ->
+ let mp_name, mp_kind =
+ match param2, param with
+ Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+ Name.from_ident ident,
analyse_module_type_kind env current_module_name pmty mty
- | _ -> Module_type_struct []
+ | _ -> "*", Module_type_struct []
in
let param =
{
- mp_name = Name.from_ident ident ;
+ mp_name = mp_name;
mp_type =
- Option.map (Odoc_env.subst_module_type env)
- param_module_type;
+ (match param with
+ | Types.Unit -> None
+ | Types.Named (_, mty) ->
+ Some (Odoc_env.subst_module_type env mty));
mp_type_code = mp_type_code ;
mp_kind = mp_kind ;
}
@@ -1638,27 +1680,30 @@ module Analyser =
(* if we're here something's wrong *)
raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat")
)
- | Parsetree.Pmty_functor (_, pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
+ | Parsetree.Pmty_functor (param2,module_type2) (* of string * module_type * module_type *) ->
(
match sig_module_type with
- Types.Mty_functor (ident, param_module_type, body_module_type) ->
- let loc = match pmodule_type2 with None -> Location.none
- | Some pmty -> pmty.Parsetree.pmty_loc in
+ Types.Mty_functor (param, body_module_type) ->
+ let loc = match param2 with Parsetree.Unit -> Location.none
+ | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in
let loc_start = Loc.start loc in
let loc_end = Loc.end_ loc 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 =
- match pmodule_type2, param_module_type with
- Some pmty, Some mty ->
+ let mp_name, mp_kind =
+ match param2, param with
+ Parsetree.Named (_, pmty), Types.Named (Some ident, mty) ->
+ Name.from_ident ident,
analyse_module_type_kind env current_module_name pmty mty
- | _ -> Module_type_struct []
+ | _ -> "*", Module_type_struct []
in
let param =
{
- mp_name = Name.from_ident ident ;
- mp_type = Option.map
- (Odoc_env.subst_module_type env) param_module_type ;
+ mp_name;
+ mp_type =
+ (match param with
+ | Types.Unit -> None
+ | Types.Named(_, mty) -> Some (Odoc_env.subst_module_type env mty));
mp_type_code = mp_type_code ;
mp_kind = mp_kind ;
}
View Lorry Controller Status