diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2012-08-21 07:10:35 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2012-08-21 07:10:35 +0000 |
commit | 35185d610b16e81ea11834963be61cecab7147c9 (patch) | |
tree | 56307d76b703e694cf582e40c28f5b558c7d878e /ocamldoc | |
parent | de7262e181af27ecba9c2f356bc80905e7262b66 (diff) | |
download | ocaml-35185d610b16e81ea11834963be61cecab7147c9.tar.gz |
merge version/4.00 at revision 12866
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/short-paths@12869 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'ocamldoc')
45 files changed, 1374 insertions, 863 deletions
diff --git a/ocamldoc/.depend b/ocamldoc/.depend index 6467d445b3..f8e0d35704 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -1,12 +1,12 @@ -odoc.cmo: ../typing/typedtree.cmi odoc_messages.cmo odoc_info.cmi \ +odoc.cmo : ../typing/typedtree.cmi odoc_messages.cmo odoc_info.cmi \ odoc_global.cmi odoc_gen.cmi odoc_config.cmi odoc_args.cmi \ odoc_analyse.cmi ../utils/misc.cmi ../utils/config.cmi \ ../utils/clflags.cmi -odoc.cmx: ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \ +odoc.cmx : ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \ odoc_global.cmx odoc_gen.cmx odoc_config.cmx odoc_args.cmx \ odoc_analyse.cmx ../utils/misc.cmx ../utils/config.cmx \ ../utils/clflags.cmx -odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ +odoc_analyse.cmo : ../utils/warnings.cmi ../typing/typetexp.cmi \ ../typing/types.cmi ../typing/typemod.cmi ../typing/typedtree.cmi \ ../typing/typedecl.cmi ../typing/typecore.cmi ../typing/typeclass.cmi \ ../bytecomp/translcore.cmi ../bytecomp/translclass.cmi \ @@ -16,9 +16,9 @@ odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ odoc_cross.cmi odoc_comments.cmi odoc_class.cmo odoc_ast.cmi \ ../utils/misc.cmi ../parsing/location.cmi ../parsing/lexer.cmi \ ../typing/includemod.cmi ../typing/env.cmi ../typing/ctype.cmi \ - ../utils/config.cmi ../utils/clflags.cmi ../utils/ccomp.cmi \ - odoc_analyse.cmi -odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ + ../utils/config.cmi ../typing/cmi_format.cmi ../utils/clflags.cmi \ + ../utils/ccomp.cmi odoc_analyse.cmi +odoc_analyse.cmx : ../utils/warnings.cmx ../typing/typetexp.cmx \ ../typing/types.cmx ../typing/typemod.cmx ../typing/typedtree.cmx \ ../typing/typedecl.cmx ../typing/typecore.cmx ../typing/typeclass.cmx \ ../bytecomp/translcore.cmx ../bytecomp/translclass.cmx \ @@ -28,226 +28,229 @@ odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ odoc_cross.cmx odoc_comments.cmx odoc_class.cmx odoc_ast.cmx \ ../utils/misc.cmx ../parsing/location.cmx ../parsing/lexer.cmx \ ../typing/includemod.cmx ../typing/env.cmx ../typing/ctype.cmx \ - ../utils/config.cmx ../utils/clflags.cmx ../utils/ccomp.cmx \ - odoc_analyse.cmi -odoc_args.cmo: odoc_types.cmi odoc_texi.cmo odoc_messages.cmo odoc_man.cmo \ + ../utils/config.cmx ../typing/cmi_format.cmx ../utils/clflags.cmx \ + ../utils/ccomp.cmx odoc_analyse.cmi +odoc_args.cmo : odoc_types.cmi odoc_texi.cmo odoc_messages.cmo odoc_man.cmo \ odoc_latex.cmo odoc_html.cmo odoc_global.cmi odoc_gen.cmi odoc_dot.cmo \ odoc_config.cmi ../utils/misc.cmi ../utils/config.cmi odoc_args.cmi -odoc_args.cmx: odoc_types.cmx odoc_texi.cmx odoc_messages.cmx odoc_man.cmx \ +odoc_args.cmx : odoc_types.cmx odoc_texi.cmx odoc_messages.cmx odoc_man.cmx \ odoc_latex.cmx odoc_html.cmx odoc_global.cmx odoc_gen.cmx odoc_dot.cmx \ odoc_config.cmx ../utils/misc.cmx ../utils/config.cmx odoc_args.cmi -odoc_ast.cmo: ../typing/types.cmi ../typing/typedtree.cmi \ +odoc_ast.cmo : ../typing/types.cmi ../typing/typedtree.cmi \ ../typing/predef.cmi ../typing/path.cmi ../parsing/parsetree.cmi \ odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_sig.cmi \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_exception.cmo odoc_env.cmi odoc_class.cmo \ ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \ ../parsing/asttypes.cmi odoc_ast.cmi -odoc_ast.cmx: ../typing/types.cmx ../typing/typedtree.cmx \ +odoc_ast.cmx : ../typing/types.cmx ../typing/typedtree.cmx \ ../typing/predef.cmx ../typing/path.cmx ../parsing/parsetree.cmi \ odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_sig.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ odoc_global.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \ ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \ ../parsing/asttypes.cmi odoc_ast.cmi -odoc_class.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ +odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_parameter.cmo odoc_name.cmi -odoc_class.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ +odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_parameter.cmx odoc_name.cmx -odoc_comments.cmo: odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ +odoc_comments.cmo : odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ odoc_parser.cmi odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi \ odoc_lexer.cmo odoc_global.cmi odoc_cross.cmi odoc_comments_global.cmi \ odoc_comments.cmi -odoc_comments.cmx: odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ +odoc_comments.cmx : odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx \ odoc_lexer.cmx odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx \ odoc_comments.cmi -odoc_comments_global.cmo: odoc_comments_global.cmi -odoc_comments_global.cmx: odoc_comments_global.cmi -odoc_config.cmo: ../utils/config.cmi odoc_config.cmi -odoc_config.cmx: ../utils/config.cmx odoc_config.cmi -odoc_control.cmo: -odoc_control.cmx: -odoc_cross.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \ +odoc_comments_global.cmo : odoc_comments_global.cmi +odoc_comments_global.cmx : odoc_comments_global.cmi +odoc_config.cmo : ../utils/config.cmi odoc_config.cmi +odoc_config.cmx : ../utils/config.cmx odoc_config.cmi +odoc_control.cmo : +odoc_control.cmx : +odoc_cross.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \ odoc_scan.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \ odoc_class.cmo odoc_cross.cmi -odoc_cross.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \ +odoc_cross.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \ odoc_scan.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \ odoc_class.cmx odoc_cross.cmi -odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi -odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi -odoc_dep.cmo: ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \ +odoc_dag2html.cmo : odoc_info.cmi odoc_dag2html.cmi +odoc_dag2html.cmx : odoc_info.cmx odoc_dag2html.cmi +odoc_dep.cmo : ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \ odoc_module.cmo ../tools/depend.cmi -odoc_dep.cmx: ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ +odoc_dep.cmx : ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ odoc_module.cmx ../tools/depend.cmx -odoc_dot.cmo: odoc_messages.cmo odoc_info.cmi -odoc_dot.cmx: odoc_messages.cmx odoc_info.cmx -odoc_env.cmo: ../typing/types.cmi ../typing/printtyp.cmi ../typing/predef.cmi \ - ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi odoc_env.cmi -odoc_env.cmx: ../typing/types.cmx ../typing/printtyp.cmx ../typing/predef.cmx \ - ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx odoc_env.cmi -odoc_exception.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi -odoc_exception.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx -odoc_gen.cmo: odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ +odoc_dot.cmo : odoc_messages.cmo odoc_info.cmi +odoc_dot.cmx : odoc_messages.cmx odoc_info.cmx +odoc_env.cmo : ../typing/types.cmi ../typing/printtyp.cmi \ + ../typing/predef.cmi ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi \ + odoc_env.cmi +odoc_env.cmx : ../typing/types.cmx ../typing/printtyp.cmx \ + ../typing/predef.cmx ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx \ + odoc_env.cmi +odoc_exception.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi +odoc_exception.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx +odoc_gen.cmo : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ odoc_html.cmo odoc_dot.cmo odoc_gen.cmi -odoc_gen.cmx: odoc_texi.cmx odoc_module.cmx odoc_man.cmx odoc_latex.cmx \ +odoc_gen.cmx : odoc_texi.cmx odoc_module.cmx odoc_man.cmx odoc_latex.cmx \ odoc_html.cmx odoc_dot.cmx odoc_gen.cmi -odoc_global.cmo: odoc_types.cmi odoc_messages.cmo odoc_config.cmi \ +odoc_global.cmo : odoc_types.cmi odoc_messages.cmo odoc_config.cmi \ ../utils/clflags.cmi odoc_global.cmi -odoc_global.cmx: odoc_types.cmx odoc_messages.cmx odoc_config.cmx \ +odoc_global.cmx : odoc_types.cmx odoc_messages.cmx odoc_config.cmx \ ../utils/clflags.cmx odoc_global.cmi -odoc_html.cmo: odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ +odoc_html.cmo : odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ odoc_info.cmi odoc_global.cmi odoc_dag2html.cmi ../parsing/asttypes.cmi -odoc_html.cmx: odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ +odoc_html.cmx : odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ odoc_info.cmx odoc_global.cmx odoc_dag2html.cmx ../parsing/asttypes.cmi -odoc_info.cmo: ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ +odoc_info.cmo : ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \ odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ odoc_misc.cmi odoc_global.cmi odoc_exception.cmo odoc_dep.cmo \ odoc_config.cmi odoc_comments.cmi odoc_class.cmo odoc_analyse.cmi \ - odoc_info.cmi -odoc_info.cmx: ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \ + ../parsing/location.cmi odoc_info.cmi +odoc_info.cmx : ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \ odoc_type.cmx odoc_text.cmx odoc_str.cmx odoc_search.cmx odoc_scan.cmx \ odoc_print.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ odoc_misc.cmx odoc_global.cmx odoc_exception.cmx odoc_dep.cmx \ odoc_config.cmx odoc_comments.cmx odoc_class.cmx odoc_analyse.cmx \ - odoc_info.cmi -odoc_inherit.cmo: -odoc_inherit.cmx: -odoc_latex.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \ + ../parsing/location.cmx odoc_info.cmi +odoc_inherit.cmo : +odoc_inherit.cmx : +odoc_latex.cmo : odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \ odoc_info.cmi ../parsing/asttypes.cmi -odoc_latex.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_latex_style.cmx \ +odoc_latex.cmx : odoc_to_text.cmx odoc_messages.cmx odoc_latex_style.cmx \ odoc_info.cmx ../parsing/asttypes.cmi -odoc_latex_style.cmo: -odoc_latex_style.cmx: -odoc_lexer.cmo: odoc_parser.cmi odoc_messages.cmo odoc_global.cmi \ +odoc_latex_style.cmo : +odoc_latex_style.cmx : +odoc_lexer.cmo : odoc_parser.cmi odoc_messages.cmo odoc_global.cmi \ odoc_comments_global.cmi -odoc_lexer.cmx: odoc_parser.cmx odoc_messages.cmx odoc_global.cmx \ +odoc_lexer.cmx : odoc_parser.cmx odoc_messages.cmx odoc_global.cmx \ odoc_comments_global.cmx -odoc_man.cmo: odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ +odoc_man.cmo : odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ odoc_info.cmi ../parsing/asttypes.cmi -odoc_man.cmx: odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ +odoc_man.cmx : odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ odoc_info.cmx ../parsing/asttypes.cmi -odoc_merge.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ +odoc_merge.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_exception.cmo odoc_class.cmo odoc_merge.cmi -odoc_merge.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ +odoc_merge.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ odoc_global.cmx odoc_exception.cmx odoc_class.cmx odoc_merge.cmi -odoc_messages.cmo: ../utils/config.cmi -odoc_messages.cmx: ../utils/config.cmx -odoc_misc.cmo: ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ +odoc_messages.cmo : ../utils/config.cmi +odoc_messages.cmx : ../utils/config.cmx +odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ odoc_types.cmi odoc_messages.cmo ../parsing/longident.cmi \ ../typing/ctype.cmi ../typing/btype.cmi odoc_misc.cmi -odoc_misc.cmx: ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \ +odoc_misc.cmx : ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \ odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \ ../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi -odoc_module.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ +odoc_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo -odoc_module.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ +odoc_module.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx -odoc_name.cmo: ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \ +odoc_name.cmo : ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \ odoc_name.cmi -odoc_name.cmx: ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \ +odoc_name.cmx : ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \ odoc_name.cmi -odoc_ocamlhtml.cmo: -odoc_ocamlhtml.cmx: -odoc_parameter.cmo: ../typing/types.cmi odoc_types.cmi -odoc_parameter.cmx: ../typing/types.cmx odoc_types.cmx -odoc_parser.cmo: odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi -odoc_parser.cmx: odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi -odoc_print.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi -odoc_print.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi -odoc_scan.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ +odoc_ocamlhtml.cmo : +odoc_ocamlhtml.cmx : +odoc_parameter.cmo : ../typing/types.cmi odoc_types.cmi +odoc_parameter.cmx : ../typing/types.cmx odoc_types.cmx +odoc_parser.cmo : odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi +odoc_parser.cmx : odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi +odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi +odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi +odoc_scan.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ odoc_exception.cmo odoc_class.cmo -odoc_scan.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ +odoc_scan.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ odoc_exception.cmx odoc_class.cmx -odoc_search.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ +odoc_search.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_exception.cmo \ odoc_class.cmo odoc_search.cmi -odoc_search.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ +odoc_search.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_exception.cmx \ odoc_class.cmx odoc_search.cmi -odoc_see_lexer.cmo: odoc_parser.cmi -odoc_see_lexer.cmx: odoc_parser.cmx -odoc_sig.cmo: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi odoc_type.cmo \ - odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_misc.cmi \ - odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_exception.cmo \ - odoc_env.cmi odoc_class.cmo ../utils/misc.cmi ../parsing/location.cmi \ - ../typing/btype.cmi ../parsing/asttypes.cmi odoc_sig.cmi -odoc_sig.cmx: ../typing/types.cmx ../typing/typedtree.cmx ../typing/path.cmx \ - ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx odoc_type.cmx \ - odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_misc.cmx \ - odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_exception.cmx \ - odoc_env.cmx odoc_class.cmx ../utils/misc.cmx ../parsing/location.cmx \ - ../typing/btype.cmx ../parsing/asttypes.cmi odoc_sig.cmi -odoc_str.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \ +odoc_see_lexer.cmo : odoc_parser.cmi +odoc_see_lexer.cmx : odoc_parser.cmx +odoc_sig.cmo : ../typing/types.cmi ../typing/typedtree.cmi \ + ../typing/path.cmi ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi \ + odoc_type.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ + odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi odoc_global.cmi \ + odoc_exception.cmo odoc_env.cmi odoc_class.cmo ../utils/misc.cmi \ + ../parsing/location.cmi ../typing/ident.cmi ../typing/btype.cmi \ + ../parsing/asttypes.cmi odoc_sig.cmi +odoc_sig.cmx : ../typing/types.cmx ../typing/typedtree.cmx \ + ../typing/path.cmx ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx \ + odoc_type.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ + odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx odoc_global.cmx \ + odoc_exception.cmx odoc_env.cmx odoc_class.cmx ../utils/misc.cmx \ + ../parsing/location.cmx ../typing/ident.cmx ../typing/btype.cmx \ + ../parsing/asttypes.cmi odoc_sig.cmi +odoc_str.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \ odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \ odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \ ../parsing/asttypes.cmi odoc_str.cmi -odoc_str.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \ +odoc_str.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \ odoc_type.cmx odoc_print.cmx odoc_name.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \ ../parsing/asttypes.cmi odoc_str.cmi -odoc_test.cmo: odoc_info.cmi odoc_gen.cmi odoc_args.cmi -odoc_test.cmx: odoc_info.cmx odoc_gen.cmx odoc_args.cmx -odoc_texi.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_info.cmi \ - ../parsing/asttypes.cmi -odoc_texi.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_info.cmx \ - ../parsing/asttypes.cmi -odoc_text.cmo: odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ +odoc_test.cmo : odoc_info.cmi odoc_gen.cmi odoc_args.cmi +odoc_test.cmx : odoc_info.cmx odoc_gen.cmx odoc_args.cmx +odoc_texi.cmo : ../typing/types.cmi odoc_to_text.cmo odoc_messages.cmo \ + odoc_info.cmi ../parsing/asttypes.cmi +odoc_texi.cmx : ../typing/types.cmx odoc_to_text.cmx odoc_messages.cmx \ + odoc_info.cmx ../parsing/asttypes.cmi +odoc_text.cmo : odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ odoc_text.cmi -odoc_text.cmx: odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ +odoc_text.cmx : odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ odoc_text.cmi -odoc_text_lexer.cmo: odoc_text_parser.cmi odoc_misc.cmi -odoc_text_lexer.cmx: odoc_text_parser.cmx odoc_misc.cmx -odoc_text_parser.cmo: odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi -odoc_text_parser.cmx: odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi -odoc_to_text.cmo: odoc_module.cmo odoc_messages.cmo odoc_info.cmi -odoc_to_text.cmx: odoc_module.cmx odoc_messages.cmx odoc_info.cmx -odoc_type.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi \ +odoc_text_lexer.cmo : odoc_text_parser.cmi odoc_misc.cmi +odoc_text_lexer.cmx : odoc_text_parser.cmx odoc_misc.cmx +odoc_text_parser.cmo : odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi +odoc_text_parser.cmx : odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi +odoc_to_text.cmo : odoc_module.cmo odoc_messages.cmo odoc_info.cmi +odoc_to_text.cmx : odoc_module.cmx odoc_messages.cmx odoc_info.cmx +odoc_type.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi \ ../parsing/asttypes.cmi -odoc_type.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx \ +odoc_type.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx \ ../parsing/asttypes.cmi -odoc_types.cmo: odoc_messages.cmo odoc_types.cmi -odoc_types.cmx: odoc_messages.cmx odoc_types.cmi -odoc_value.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_types.cmi \ +odoc_types.cmo : odoc_messages.cmo ../parsing/location.cmi odoc_types.cmi +odoc_types.cmx : odoc_messages.cmx ../parsing/location.cmx odoc_types.cmi +odoc_value.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_types.cmi \ odoc_parameter.cmo odoc_name.cmi -odoc_value.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \ +odoc_value.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \ odoc_parameter.cmx odoc_name.cmx -t.cmo: -t.cmx: -odoc_analyse.cmi: odoc_module.cmo odoc_global.cmi -odoc_args.cmi: odoc_gen.cmi -odoc_ast.cmi: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo -odoc_comments.cmi: odoc_types.cmi odoc_module.cmo -odoc_comments_global.cmi: -odoc_config.cmi: -odoc_cross.cmi: odoc_types.cmi odoc_module.cmo -odoc_dag2html.cmi: odoc_info.cmi -odoc_env.cmi: ../typing/types.cmi odoc_name.cmi -odoc_gen.cmi: odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ +odoc_analyse.cmi : odoc_module.cmo odoc_global.cmi +odoc_args.cmi : odoc_gen.cmi +odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.cmi \ + ../typing/path.cmi ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi \ + odoc_module.cmo +odoc_comments.cmi : odoc_types.cmi odoc_module.cmo +odoc_comments_global.cmi : +odoc_config.cmi : +odoc_cross.cmi : odoc_types.cmi odoc_module.cmo +odoc_dag2html.cmi : odoc_info.cmi +odoc_env.cmi : ../typing/types.cmi odoc_name.cmi +odoc_gen.cmi : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ odoc_html.cmo odoc_dot.cmo -odoc_global.cmi: odoc_types.cmi -odoc_info.cmi: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ +odoc_global.cmi : odoc_types.cmi +odoc_info.cmi : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_search.cmi odoc_parameter.cmo odoc_module.cmo \ - odoc_global.cmi odoc_exception.cmo odoc_class.cmo -odoc_merge.cmi: odoc_types.cmi odoc_module.cmo -odoc_misc.cmi: ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi -odoc_name.cmi: ../typing/path.cmi ../parsing/longident.cmi \ + odoc_global.cmi odoc_exception.cmo odoc_class.cmo ../parsing/location.cmi +odoc_merge.cmi : odoc_types.cmi odoc_module.cmo +odoc_misc.cmi : ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi +odoc_name.cmi : ../typing/path.cmi ../parsing/longident.cmi \ ../typing/ident.cmi -odoc_parser.cmi: odoc_types.cmi -odoc_print.cmi: ../typing/types.cmi -odoc_search.cmi: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo -odoc_sig.cmi: ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \ +odoc_parser.cmi : odoc_types.cmi +odoc_print.cmi : ../typing/types.cmi +odoc_search.cmi : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ + odoc_module.cmo odoc_exception.cmo odoc_class.cmo +odoc_sig.cmi : ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \ odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo -odoc_str.cmi: ../typing/types.cmi odoc_value.cmo odoc_type.cmo \ +odoc_str.cmi : ../typing/types.cmi odoc_value.cmo odoc_type.cmo \ odoc_exception.cmo odoc_class.cmo -odoc_text.cmi: odoc_types.cmi -odoc_text_parser.cmi: odoc_types.cmi -odoc_types.cmi: +odoc_text.cmi : odoc_types.cmi +odoc_text_parser.cmi : odoc_types.cmi +odoc_types.cmi : ../parsing/location.cmi diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt index 3707d265bd..49ed84d24d 100644 --- a/ocamldoc/Changes.txt +++ b/ocamldoc/Changes.txt @@ -6,8 +6,8 @@ TODO: module type M = sig type u end module N : sig include M val f: u -> unit end Here, in html for example, f in displayed being of type Foo.u instead of Foo.M.u - - latex: types variant polymorphes dépassent de la page quand ils sont trop longs - - utilisation nouvelles infos de Xavier: "début de rec", etc. + - latex: types variant polymorphes depassent de la page quand ils sont trop longs + - utilisation nouvelles infos de Xavier: "debut de rec", etc. - xml generator ===== @@ -61,12 +61,12 @@ Release 3.08.1: Release 3.08.0: - fix: method parameters names in signature are now retrieved correctly (fix of Odoc_value.parameter_list_from_arrows to handle Tpoly for methods) - - ajout à la doc de Module_list et Index_list (utilisé dans le html seulement) - - ajout à la doc: fichier de l'option -intro utilisé pour l'index en html + - ajout a la doc de Module_list et Index_list (utilise dans le html seulement) + - ajout a la doc: fichier de l'option -intro utilise pour l'index en html - fix: create a Module_with instead of a Module_alias when we encounter module A : Foo in a signature - latex: style latex pour indenter dans les module kind et les class kind - - latex: il manque la génération des paramètres de classe + - latex: il manque la generation des parametres de classe - parse des {!modules: } et {!indexlist} - gestion des Module_list et Index_list - no need to Dynlink.add_available_units any more diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index d04809aa31..573d9af8f6 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -50,7 +50,9 @@ ODOC_TEST=odoc_test.cmo GENERATORS_CMOS= \ generators/odoc_todo.cmo \ generators/odoc_literate.cmo -GENERATORS_CMXS=$(GENERATORS_CMOS:.cmo=.cmxs) +GENERATORS_CMXS_TMP1=$(GENERATORS_CMOS:.cmo=.cmxs) +GENERATORS_CMXS_TMP2=$(NATDYNLINK:false=) +GENERATORS_CMXS=$(GENERATORS_CMXS_TMP2:true=$(GENERATORS_CMXS_TMP1)) # Compilation @@ -158,6 +160,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \ $(OCAMLSRCDIR)/typing/predef.cmo \ $(OCAMLSRCDIR)/typing/datarepr.cmo \ $(OCAMLSRCDIR)/typing/subst.cmo \ + $(OCAMLSRCDIR)/typing/cmi_format.cmo \ $(OCAMLSRCDIR)/typing/env.cmo \ $(OCAMLSRCDIR)/typing/ctype.cmo \ $(OCAMLSRCDIR)/typing/primitive.cmo \ @@ -168,6 +171,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \ $(OCAMLSRCDIR)/typing/typedtree.cmo \ $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/stypes.cmo \ + $(OCAMLSRCDIR)/typing/cmt_format.cmo \ $(OCAMLSRCDIR)/typing/typecore.cmo \ $(OCAMLSRCDIR)/typing/includeclass.cmo \ $(OCAMLSRCDIR)/typing/typedecl.cmo \ @@ -205,17 +209,17 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) generatorsopt: $(GENERATORS_CMXS) debug: - make OCAMLPP="" + $(MAKE) OCAMLPP="" $(OCAMLDOC): $(EXECMOFILES) $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) $(OCAMLDOC_OPT): $(EXECMXFILES) - $(OCAMLOPT) -o $@ unix.cmxa str.cmxa dynlink.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) + $(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) $(OCAMLDOC_LIBCMA): $(LIBCMOFILES) - $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLCMOFILES) $(LIBCMOFILES) + $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES) $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) - $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES) + $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES) manpages: stdlib_man/Pervasives.3o @@ -305,6 +309,13 @@ test_stdlib: dummy ../otherlibs/unix/unix.mli \ ../otherlibs/str/str.mli +test_stdlib_code: dummy + $(MKDIR) $@ + $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/stdlib.odoc -keep-code \ + `ls ../stdlib/*.ml | grep -v Labels` \ + ../otherlibs/unix/unix.ml \ + ../otherlibs/str/str.ml + test_framed: dummy $(MKDIR) $@ $(OCAMLDOC_RUN) -g odoc_fhtml.cmo -sort -colorize-code -d $@ $(INCLUDES) odoc*.ml odoc*.mli diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index a65b59738c..07a7571b07 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -148,6 +148,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \ $(OCAMLSRCDIR)/typing/predef.cmo \ $(OCAMLSRCDIR)/typing/datarepr.cmo \ $(OCAMLSRCDIR)/typing/subst.cmo \ + $(OCAMLSRCDIR)/typing/cmi_format.cmo \ $(OCAMLSRCDIR)/typing/env.cmo \ $(OCAMLSRCDIR)/typing/ctype.cmo \ $(OCAMLSRCDIR)/typing/primitive.cmo \ @@ -155,9 +156,10 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \ $(OCAMLSRCDIR)/typing/printtyp.cmo \ $(OCAMLSRCDIR)/typing/includecore.cmo \ $(OCAMLSRCDIR)/typing/typetexp.cmo \ - $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/typedtree.cmo \ + $(OCAMLSRCDIR)/typing/parmatch.cmo \ $(OCAMLSRCDIR)/typing/stypes.cmo \ + $(OCAMLSRCDIR)/typing/cmt_format.cmo \ $(OCAMLSRCDIR)/typing/typecore.cmo \ $(OCAMLSRCDIR)/typing/includeclass.cmo \ $(OCAMLSRCDIR)/typing/typedecl.cmo \ @@ -185,7 +187,7 @@ opt.opt: exeopt libopt exeopt: $(OCAMLDOC_OPT) libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) debug: - make OCAMLPP="" + $(MAKE) OCAMLPP="" $(OCAMLDOC): $(EXECMOFILES) $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) diff --git a/ocamldoc/generators/odoc_literate.ml b/ocamldoc/generators/odoc_literate.ml index e79b4f1a21..6a1e0783e8 100644 --- a/ocamldoc/generators/odoc_literate.ml +++ b/ocamldoc/generators/odoc_literate.ml @@ -9,7 +9,7 @@ (* *) (***********************************************************************) -(* $Id: odoc_literate.ml,v 1.1 2008/02/28 11:09:33 guesdon Exp $ *) +(* $Id$ *) open Odoc_info module Naming = Odoc_html.Naming diff --git a/ocamldoc/generators/odoc_todo.ml b/ocamldoc/generators/odoc_todo.ml index 23e6c8892d..626236cf1a 100644 --- a/ocamldoc/generators/odoc_todo.ml +++ b/ocamldoc/generators/odoc_todo.ml @@ -9,7 +9,7 @@ (* *) (***********************************************************************) -(* $Id: odoc_todo.ml 411 2004-08-03 13:08:20Z guesdon $ *) +(* $Id$ *) (** An OCamldoc generator to retrieve information in "todo" tags and generate an html page with all todo items. *) @@ -48,7 +48,7 @@ struct method private gen_if_tag name target info_opt = match info_opt with None -> () - | Some i -> + | Some i -> let l = List.fold_left (fun acc (t, text) -> @@ -69,7 +69,7 @@ struct | _ -> (None, text) :: acc end - | _ -> acc + | _ -> acc ) [] i.i_custom diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index 2091dd3967..a2a7dc6a4c 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -46,7 +46,7 @@ let preprocess sourcefile = match !Clflags.preprocessor with None -> sourcefile | Some pp -> - let tmpfile = Filename.temp_file "camlpp" "" in + let tmpfile = Filename.temp_file "ocamldocpp" "" in let comm = Printf.sprintf "%s %s > %s" pp sourcefile tmpfile in if Ccomp.command comm <> 0 then begin remove_file tmpfile; @@ -73,15 +73,14 @@ let parse_file inputfile parse_fun ast_magic = let ic = open_in_bin inputfile in let is_ast_file = try - let buffer = String.create (String.length ast_magic) in - really_input ic buffer 0 (String.length ast_magic); + let buffer = Misc.input_bytes ic (String.length ast_magic) in if buffer = ast_magic then true else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then raise Outdated_version else false with Outdated_version -> - fatal_error "Ocaml and preprocessor have incompatible versions" + fatal_error "OCaml and preprocessor have incompatible versions" | _ -> false in let ast = @@ -114,7 +113,10 @@ let process_implementation_file ppf sourcefile = let env = initial_env () in try let parsetree = parse_file inputfile Parse.implementation ast_impl_magic_number in - let typedtree = Typemod.type_implementation sourcefile prefixname modulename env parsetree in + let typedtree = + Typemod.type_implementation + sourcefile prefixname modulename env parsetree + in (Some (parsetree, typedtree), inputfile) with e -> @@ -165,13 +167,16 @@ let process_error exn = | Env.Error err -> Location.print_error_cur_file ppf; Env.report_error ppf err + | Cmi_format.Error err -> + Location.print_error_cur_file ppf; + Cmi_format.report_error ppf err | Ctype.Tags(l, l') -> Location.print_error_cur_file ppf; fprintf ppf "In this program,@ variant constructors@ `%s and `%s@ \ have the same hash value." l l' - | Typecore.Error(loc, err) -> - Location.print_error ppf loc; Typecore.report_error ppf err + | Typecore.Error(loc, env, err) -> + Location.print_error ppf loc; Typecore.report_error env ppf err | Typetexp.Error(loc, err) -> Location.print_error ppf loc; Typetexp.report_error ppf err | Typedecl.Error(loc, err) -> @@ -179,15 +184,15 @@ let process_error exn = | Includemod.Error err -> Location.print_error_cur_file ppf; Includemod.report_error ppf err - | Typemod.Error(loc, err) -> - Location.print_error ppf loc; Typemod.report_error ppf err + | Typemod.Error(loc, env, err) -> + Location.print_error ppf loc; Typemod.report_error env ppf err | Translcore.Error(loc, err) -> Location.print_error ppf loc; Translcore.report_error ppf err | Sys_error msg -> Location.print_error_cur_file ppf; fprintf ppf "I/O error: %s" msg - | Typeclass.Error(loc, err) -> - Location.print_error ppf loc; Typeclass.report_error ppf err + | Typeclass.Error(loc, env, err) -> + Location.print_error ppf loc; Typeclass.report_error env ppf err | Translclass.Error(loc, err) -> Location.print_error ppf loc; Translclass.report_error ppf err | Warnings.Errors (n) -> @@ -252,7 +257,7 @@ let process_file ppf sourcefile = try let (ast, signat, input_file) = process_interface_file ppf file in let file_module = Sig_analyser.analyse_signature file - !Location.input_name ast signat + !Location.input_name ast signat.sig_type in file_module.Odoc_module.m_top_deps <- Odoc_dep.intf_dependencies ast ; @@ -279,7 +284,11 @@ let process_file ppf sourcefile = Location.input_name := file; try let mod_name = - String.capitalize (Filename.basename (Filename.chop_extension file)) + let s = + try Filename.chop_extension file + with _ -> file + in + String.capitalize (Filename.basename s) in let txt = try Odoc_text.Texter.text_of_string (Odoc_misc.input_file_as_string file) @@ -289,7 +298,7 @@ let process_file ppf sourcefile = let m = { Odoc_module.m_name = mod_name ; - Odoc_module.m_type = Types.Tmty_signature [] ; + Odoc_module.m_type = Types.Mty_signature [] ; Odoc_module.m_info = None ; Odoc_module.m_is_interface = true ; Odoc_module.m_file = file ; @@ -297,7 +306,7 @@ let process_file ppf sourcefile = [Odoc_module.Element_module_comment txt] ; Odoc_module.m_loc = { Odoc_types.loc_impl = None ; - Odoc_types.loc_inter = Some (file, 0) } ; + Odoc_types.loc_inter = Some (Location.in_file file) } ; Odoc_module.m_top_deps = [] ; Odoc_module.m_code = None ; Odoc_module.m_code_intf = None ; diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index 2979dea051..bee38930ad 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -17,6 +17,96 @@ module M = Odoc_messages let current_generator = ref (None : Odoc_gen.generator option) +let get_html_generator () = + match !current_generator with + None -> (module Odoc_html.Generator : Odoc_html.Html_generator) + | Some (Odoc_gen.Html m) -> m + | Some _ -> failwith (M.current_generator_is_not "html") +;; + +let get_latex_generator () = + match !current_generator with + None -> (module Odoc_latex.Generator : Odoc_latex.Latex_generator) + | Some (Odoc_gen.Latex m) -> m + | Some _ -> failwith (M.current_generator_is_not "latex") +;; + +let get_texi_generator () = + match !current_generator with + None -> (module Odoc_texi.Generator : Odoc_texi.Texi_generator) + | Some (Odoc_gen.Texi m) -> m + | Some _ -> failwith (M.current_generator_is_not "texi") +;; + +let get_man_generator () = + match !current_generator with + None -> (module Odoc_man.Generator : Odoc_man.Man_generator) + | Some (Odoc_gen.Man m) -> m + | Some _ -> failwith (M.current_generator_is_not "man") +;; + +let get_dot_generator () = + match !current_generator with + None -> (module Odoc_dot.Generator : Odoc_dot.Dot_generator) + | Some (Odoc_gen.Dot m) -> m + | Some _ -> failwith (M.current_generator_is_not "dot") +;; + +let get_base_generator () = + match !current_generator with + None -> (module Odoc_gen.Base_generator : Odoc_gen.Base) + | Some (Odoc_gen.Base m) -> m + | Some _ -> failwith (M.current_generator_is_not "base") +;; + +let extend_html_generator f = + let current = get_html_generator () in + let module Current = (val current : Odoc_html.Html_generator) in + let module F = (val f : Odoc_gen.Html_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Html (module M : Odoc_html.Html_generator)) +;; + +let extend_latex_generator f = + let current = get_latex_generator () in + let module Current = (val current : Odoc_latex.Latex_generator) in + let module F = (val f : Odoc_gen.Latex_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Latex (module M : Odoc_latex.Latex_generator)) +;; + +let extend_texi_generator f = + let current = get_texi_generator () in + let module Current = (val current : Odoc_texi.Texi_generator) in + let module F = (val f : Odoc_gen.Texi_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Texi (module M : Odoc_texi.Texi_generator)) +;; + +let extend_man_generator f = + let current = get_man_generator () in + let module Current = (val current : Odoc_man.Man_generator) in + let module F = (val f : Odoc_gen.Man_functor) in + let module M = F(Current) in + current_generator := Some(Odoc_gen.Man (module M : Odoc_man.Man_generator)) +;; + +let extend_dot_generator f = + let current = get_dot_generator () in + let module Current = (val current : Odoc_dot.Dot_generator) in + let module F = (val f : Odoc_gen.Dot_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Dot (module M : Odoc_dot.Dot_generator)) +;; + +let extend_base_generator f = + let current = get_base_generator () in + let module Current = (val current : Odoc_gen.Base) in + let module F = (val f : Odoc_gen.Base_functor) in + let module M = F(Current) in + current_generator := Some (Odoc_gen.Base (module M : Odoc_gen.Base)) +;; + (** Analysis of a string defining options. Return the list of options according to the list giving associations between [(character, _)] and a list of options. *) @@ -225,7 +315,7 @@ let help_action () = let msg = Arg.usage_string (!options @ !help_options) - (M.usage ^ M.options_are) in + (M.usage ^ M.options_are) in print_string msg let () = help_options := [ diff --git a/ocamldoc/odoc_args.mli b/ocamldoc/odoc_args.mli index 2f190ef756..1d55de7477 100644 --- a/ocamldoc/odoc_args.mli +++ b/ocamldoc/odoc_args.mli @@ -19,6 +19,30 @@ val current_generator : Odoc_gen.generator option ref (** To set the documentation generator. *) val set_generator : Odoc_gen.generator -> unit +(** Extend current HTML generator. + @raise Failure if another kind of generator is already set.*) +val extend_html_generator : (module Odoc_gen.Html_functor) -> unit + +(** Extend current LaTeX generator. + @raise Failure if another kind of generator is already set.*) +val extend_latex_generator : (module Odoc_gen.Latex_functor) -> unit + +(** Extend current Texi generator. + @raise Failure if another kind of generator is already set.*) +val extend_texi_generator : (module Odoc_gen.Texi_functor) -> unit + +(** Extend current man generator. + @raise Failure if another kind of generator is already set.*) +val extend_man_generator : (module Odoc_gen.Man_functor) -> unit + +(** Extend current dot generator. + @raise Failure if another kind of generator is already set.*) +val extend_dot_generator : (module Odoc_gen.Dot_functor) -> unit + +(** Extend current base generator. + @raise Failure if another kind of generator is already set.*) +val extend_base_generator : (module Odoc_gen.Base_functor) -> unit + (** Add an option specification. *) val add_option : string * Arg.spec * string -> unit diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index f436e646cf..eb7f736ece 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -54,50 +54,50 @@ module Typedtree_search = | P of string | IM of string - type tab = (ele, Typedtree.structure_item) Hashtbl.t + type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t type tab_values = (Odoc_module.Name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t let iter_val_pattern = function | Typedtree.Tpat_any -> None - | Typedtree.Tpat_var name -> Some (Name.from_ident name) + | Typedtree.Tpat_var (name, _) -> Some (Name.from_ident name) | Typedtree.Tpat_tuple _ -> None (* A VOIR quand on traitera les tuples *) | _ -> None 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,ident_loc, _, mod_expr) -> Hashtbl.add table (M (Name.from_ident ident)) - (Typedtree.Tstr_module (ident,mod_expr)) + (Typedtree.Tstr_module (ident,ident_loc, mod_expr)) ) mods - | Typedtree.Tstr_modtype (ident, _) -> + | Typedtree.Tstr_modtype (ident, _, _) -> Hashtbl.add table (MT (Name.from_ident ident)) tt - | Typedtree.Tstr_exception (ident, _) -> + | Typedtree.Tstr_exception (ident, _, _) -> Hashtbl.add table (E (Name.from_ident ident)) tt - | Typedtree.Tstr_exn_rebind (ident, _) -> + | Typedtree.Tstr_exn_rebind (ident, _, _, _) -> Hashtbl.add table (ER (Name.from_ident ident)) tt | Typedtree.Tstr_type ident_type_decl_list -> List.iter - (fun (id, e) -> + (fun (id, id_loc, e) -> Hashtbl.add table (T (Name.from_ident id)) - (Typedtree.Tstr_type [(id,e)])) + (Typedtree.Tstr_type [(id,id_loc,e)])) ident_type_decl_list | Typedtree.Tstr_class info_list -> List.iter - (fun ((id,_,_,_,_) as ci) -> - Hashtbl.add table (C (Name.from_ident id)) - (Typedtree.Tstr_class [ci])) + (fun (ci, m, s) -> + Hashtbl.add table (C (Name.from_ident ci.ci_id_class)) + (Typedtree.Tstr_class [ci, m, s])) info_list - | Typedtree.Tstr_cltype info_list -> + | Typedtree.Tstr_class_type info_list -> List.iter - (fun ((id,_) as ci) -> + (fun ((id,id_loc,_) as ci) -> Hashtbl.add table (CT (Name.from_ident id)) - (Typedtree.Tstr_cltype [ci])) + (Typedtree.Tstr_class_type [ci])) info_list | Typedtree.Tstr_value (_, pat_exp_list) -> List.iter @@ -107,7 +107,7 @@ module Typedtree_search = | Some n -> Hashtbl.add table_values n (pat,exp) ) pat_exp_list - | Typedtree.Tstr_primitive (ident, _) -> + | Typedtree.Tstr_primitive (ident, _, _) -> Hashtbl.add table (P (Name.from_ident ident)) tt | Typedtree.Tstr_open _ -> () | Typedtree.Tstr_include _ -> () @@ -116,41 +116,42 @@ module Typedtree_search = let tables typedtree = let t = Hashtbl.create 13 in let t_values = Hashtbl.create 13 in - List.iter (add_to_hashes t t_values) typedtree; + List.iter (fun str -> add_to_hashes t t_values str.str_desc) typedtree; (t, t_values) let search_module table name = match Hashtbl.find table (M name) with - (Typedtree.Tstr_module (_, module_expr)) -> module_expr + (Typedtree.Tstr_module (_, _, module_expr)) -> module_expr | _ -> assert false let search_module_type table name = match Hashtbl.find table (MT name) with - | (Typedtree.Tstr_modtype (_, module_type)) -> module_type + | (Typedtree.Tstr_modtype (_, _, module_type)) -> module_type | _ -> assert false let search_exception table name = match Hashtbl.find table (E name) with - | (Typedtree.Tstr_exception (_, excep_decl)) -> excep_decl + | (Typedtree.Tstr_exception (_, _, excep_decl)) -> excep_decl | _ -> assert false let search_exception_rebind table name = match Hashtbl.find table (ER name) with - | (Typedtree.Tstr_exn_rebind (_, p)) -> p + | (Typedtree.Tstr_exn_rebind (_, _, p, _)) -> p | _ -> assert false let search_type_declaration table name = match Hashtbl.find table (T name) with - | (Typedtree.Tstr_type [(_,decl)]) -> decl + | (Typedtree.Tstr_type [(_,_, decl)]) -> decl | _ -> assert false let search_class_exp table name = match Hashtbl.find table (C name) with - | (Typedtree.Tstr_class [(_,_,_,ce,_)]) -> + | (Typedtree.Tstr_class [(ci, _, _ )]) -> + let ce = ci.ci_expr in ( try let type_decl = search_type_declaration table name in - (ce, type_decl.Types.type_params) + (ce, type_decl.typ_type.Types.type_params) with Not_found -> (ce, []) @@ -159,50 +160,50 @@ module Typedtree_search = let search_class_type_declaration table name = match Hashtbl.find table (CT name) with - | (Typedtree.Tstr_cltype [(_,cltype_decl)]) -> cltype_decl + | (Typedtree.Tstr_class_type [(_,_,cltype_decl)]) -> cltype_decl | _ -> assert false let search_value table name = Hashtbl.find table name let search_primitive table name = match Hashtbl.find table (P name) with - Tstr_primitive (ident, val_desc) -> val_desc.Types.val_type + Tstr_primitive (ident, _, val_desc) -> val_desc.val_val.Types.val_type | _ -> assert false let get_nth_inherit_class_expr cls n = let rec iter cpt = function | [] -> raise Not_found - | Typedtree.Cf_inher (clexp, _, _) :: q -> + | { cf_desc = Typedtree.Tcf_inher (_, clexp, _, _, _) } :: q -> if n = cpt then clexp else iter (cpt+1) q | _ :: q -> iter cpt q in - iter 0 cls.Typedtree.cl_field + iter 0 cls.Typedtree.cstr_fields let search_attribute_type cls name = let rec iter = function | [] -> raise Not_found - | Typedtree.Cf_val (_, ident, Some exp, _) :: q + | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_concrete exp, _) } :: q when Name.from_ident ident = name -> exp.Typedtree.exp_type | _ :: q -> iter q in - iter cls.Typedtree.cl_field + iter cls.Typedtree.cstr_fields let class_sig_of_cltype_decl = let rec iter = function - Types.Tcty_constr (_, _, cty) -> iter cty - | Types.Tcty_signature s -> s - | Types.Tcty_fun (_,_, cty) -> iter cty + Types.Cty_constr (_, _, cty) -> iter cty + | Types.Cty_signature s -> s + | Types.Cty_fun (_,_, cty) -> iter cty in fun ct_decl -> iter ct_decl.Types.clty_type let search_virtual_attribute_type table ctname name = let ct_decl = search_class_type_declaration table ctname in - let cls_sig = class_sig_of_cltype_decl ct_decl in + let cls_sig = class_sig_of_cltype_decl ct_decl.ci_type_decl in let (_,_,texp) = Types.Vars.find name cls_sig.cty_vars in texp @@ -210,12 +211,12 @@ module Typedtree_search = let rec iter = function | [] -> raise Not_found - | Typedtree.Cf_meth (label, exp) :: q when label = name -> + | { cf_desc = Typedtree.Tcf_meth (label, _, _, Tcfk_concrete exp, _) } :: q when label = name -> exp | _ :: q -> iter q in - iter cls.Typedtree.cl_field + iter cls.Typedtree.cstr_fields end module Analyser = @@ -253,14 +254,14 @@ module Analyser = let tt_param_info_from_pattern env f_desc pat = let rec iter_pattern pat = match pat.pat_desc with - Typedtree.Tpat_var ident -> + Typedtree.Tpat_var (ident, _) -> let name = Name.from_ident ident in Simple_name { sn_name = name ; sn_text = f_desc name ; sn_type = Odoc_env.subst_type env pat.pat_type } - | Typedtree.Tpat_alias (pat, _) -> + | Typedtree.Tpat_alias (pat, _, _) -> iter_pattern pat | Typedtree.Tpat_tuple patlist -> @@ -268,7 +269,7 @@ module Analyser = (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, _, _) -> @@ -322,7 +323,7 @@ module Analyser = ( ( match func_body.exp_desc with - Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, func_body2) -> + Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, func_body2) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -341,7 +342,7 @@ module Analyser = in (* continue if the body is still a function *) match next_exp.exp_desc with - Texp_function (pat_exp_list, _) -> + Texp_function (_, pat_exp_list, _) -> p :: (tt_analyse_function_parameters env current_comment_opt pat_exp_list) | _ -> (* something else ; no more parameter *) @@ -352,11 +353,18 @@ module Analyser = let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag = let (pat, exp) = pat_exp in match (pat.pat_desc, exp.exp_desc) with - (Typedtree.Tpat_var ident, Typedtree.Texp_function (pat_exp_list2, partial)) -> + (Typedtree.Tpat_var (ident, _), Typedtree.Texp_function (_, pat_exp_list2, partial)) -> (* a new function 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 + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in (* create the value *) let new_value = { val_name = complete_name ; @@ -364,25 +372,32 @@ module Analyser = val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ; val_recursive = rec_flag = Asttypes.Recursive ; 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 } ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; } in [ new_value ] - | (Typedtree.Tpat_var ident, _) -> + | (Typedtree.Tpat_var (ident, _), _) -> (* 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 + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in let new_value = { val_name = complete_name ; val_info = comment_opt ; val_type = Odoc_env.subst_type env pat.Typedtree.pat_type ; val_recursive = rec_flag = Asttypes.Recursive ; 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 } ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; } in [ new_value ] @@ -411,9 +426,9 @@ module Analyser = ); *) match clexp.Typedtree.cl_desc with - Typedtree.Tclass_ident p -> Name.from_path p - | Typedtree.Tclass_constraint (class_expr, _, _, _) - | Typedtree.Tclass_apply (class_expr, _) -> tt_name_of_class_expr class_expr + Typedtree.Tcl_ident (p, _, _) -> Name.from_path p + | Typedtree.Tcl_constraint (class_expr, _, _, _, _) + | Typedtree.Tcl_apply (class_expr, _) -> tt_name_of_class_expr class_expr (* | Typedtree.Tclass_fun (_, _, class_expr, _) -> tt_name_of_class_expr class_expr | Typedtree.Tclass_let (_,_,_, class_expr) -> tt_name_of_class_expr class_expr @@ -427,7 +442,7 @@ module Analyser = *) let rec tt_analyse_method_expression env current_method_name comment_opt ?(first=true) exp = match exp.Typedtree.exp_desc with - Typedtree.Texp_function (pat_exp_list, _) -> + Typedtree.Texp_function (_, pat_exp_list, _) -> ( match pat_exp_list with [] -> @@ -437,7 +452,7 @@ module Analyser = | l -> match l with [] -> - (* cas impossible, on l'a filtré avant *) + (* cas impossible, on l'a filtre avant *) assert false | (pattern_param, exp) :: second_ele :: q -> (* implicit pattern matching -> anonymous parameter *) @@ -467,7 +482,7 @@ module Analyser = ( ( match body.exp_desc with - Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, body2) -> + Typedtree.Texp_let (_, ({pat_desc = Typedtree.Tpat_var (id, _) } , exp) :: _, body2) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -513,8 +528,10 @@ module Analyser = ele_coms in (acc_inher, acc_fields @ ele_comments) - - | (Parsetree.Pcf_inher (_, p_clexp, _)) :: q -> + | item :: q -> + let loc = item.Parsetree.pcf_loc in + match item.Parsetree.pcf_desc with + | (Parsetree.Pcf_inher (_, p_clexp, _)) -> let tt_clexp = let n = List.length acc_inher in try Typedtree_search.get_nth_inherit_class_expr tt_cls n @@ -541,113 +558,135 @@ module Analyser = p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum q - | ((Parsetree.Pcf_val (label, mutable_flag, _, _, loc) | - Parsetree.Pcf_valvirt (label, mutable_flag, _, loc) ) as x) :: q -> - let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in - 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 type_exp = + | ((Parsetree.Pcf_val ({ txt = label }, mutable_flag, _, _) | + Parsetree.Pcf_valvirt ({ txt = label }, mutable_flag, _) ) as x) -> + let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in + 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 type_exp = try if virt then Typedtree_search.search_virtual_attribute_type table - (Name.simple current_class_name) label + (Name.simple current_class_name) label else Typedtree_search.search_attribute_type tt_cls label with Not_found -> raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name)) - in - let att = - { - 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_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 ; - att_virtual = virt ; - } - 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 - with Not_found -> raise (Failure (Odoc_messages.method_type_not_found current_class_name label)) - in - let real_type = + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let att = + { + 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_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + att_mutable = mutable_flag = Asttypes.Mutable ; + att_virtual = virt ; + } + in + iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q + + | (Parsetree.Pcf_virt ({ txt = label }, private_flag, _)) -> + 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 + with Not_found -> raise (Failure (Odoc_messages.method_type_not_found current_class_name label)) + in + let real_type = match met_type.Types.desc with - Tarrow (_, _, t, _) -> - t - | _ -> + Tarrow (_, _, t, _) -> + t + | _ -> (* ?!? : not an arrow type ! return the original type *) - met_type - in - let met = - { - met_value = { val_name = complete_name ; - val_info = info_opt ; - val_type = Odoc_env.subst_type env real_type ; - val_recursive = false ; - 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 } ; - } ; - met_private = private_flag = Asttypes.Private ; - met_virtual = true ; - } - in - (* update the parameter description *) - Odoc_value.update_value_parameters_text met.met_value; + met_type + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let met = + { + met_value = { + val_name = complete_name ; + val_info = info_opt ; + val_type = Odoc_env.subst_type env real_type ; + val_recursive = false ; + val_parameters = [] ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + met_private = private_flag = Asttypes.Private ; + met_virtual = true ; + } + 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 + iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q - | (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 = + | (Parsetree.Pcf_meth ({ txt = label }, private_flag, _, _)) -> + 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 = try Typedtree_search.search_method_expression tt_cls label - with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name)) - in - let real_type = - match exp.exp_type.desc with - Tarrow (_, _, t,_) -> - t - | _ -> + with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name)) + in + let real_type = + match exp.exp_type.desc with + Tarrow (_, _, t,_) -> + t + | _ -> (* ?!? : not an arrow type ! return the original type *) - exp.Typedtree.exp_type - in - let met = - { - met_value = { val_name = complete_name ; - val_info = info_opt ; - val_type = Odoc_env.subst_type env real_type ; - val_recursive = false ; - val_parameters = tt_analyse_method_expression env complete_name info_opt exp ; - 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 } ; - } ; - met_private = private_flag = Asttypes.Private ; - met_virtual = false ; + exp.Typedtree.exp_type + in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let met = + { + met_value = { val_name = complete_name ; + val_info = info_opt ; + val_type = Odoc_env.subst_type env real_type ; + val_recursive = false ; + val_parameters = tt_analyse_method_expression env complete_name info_opt exp ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } ; + met_private = private_flag = Asttypes.Private ; + met_virtual = false ; } - in - (* update the parameter description *) - Odoc_value.update_value_parameters_text met.met_value; + 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 + iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q - | Parsetree.Pcf_cstr (_, _, loc) :: q -> + | Parsetree.Pcf_constr (_, _) -> (* don't give a $*%@ ! *) iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q - | (Parsetree.Pcf_init exp) :: q -> + | (Parsetree.Pcf_init exp) -> iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q in - iter [] [] last_pos (snd p_cls) + iter [] [] last_pos (p_cls.Parsetree.pcstr_fields) (** 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 table = @@ -655,17 +694,17 @@ module Analyser = (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.Tcl_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 *) - Name.from_longident lid + (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *) + Name.from_longident lid.txt in - (* On n'a pas ici les paramètres de type sous forme de Types.type_expr, + (* On n'a pas ici les parametres de type sous forme de Types.type_expr, par contre on peut les trouver dans le class_type *) let params = match tt_class_exp.Typedtree.cl_type with - Types.Tcty_constr (p2, type_exp_list, cltyp) -> + Types.Cty_constr (p2, type_exp_list, cltyp) -> (* cltyp is the class type for [type_exp_list] p *) type_exp_list | _ -> @@ -679,11 +718,11 @@ module Analyser = cco_type_parameters = List.map (Odoc_env.subst_type env) params ; } ) - | (Parsetree.Pcl_structure p_class_structure, Typedtree.Tclass_structure tt_class_structure) -> + | (Parsetree.Pcl_structure p_class_structure, Typedtree.Tcl_structure tt_class_structure) -> (* we need the class signature to get the type of methods in analyse_class_structure *) let tt_class_sig = match tt_class_exp.Typedtree.cl_type with - Types.Tcty_signature class_sig -> class_sig + Types.Cty_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 @@ -700,16 +739,16 @@ module Analyser = 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)) -> + Typedtree.Tcl_fun (_, pat, ident_exp_list, tt_class_expr2, partial)) -> (* we check that this is not an optional parameter with a default value. In this case, we look for the good parameter pattern *) let (parameter, next_tt_class_exp) = match pat.Typedtree.pat_desc with - Typedtree.Tpat_var ident when Name.from_ident ident = "*opt*" -> + Typedtree.Tpat_var (ident, _) when Name.from_ident ident = "*opt*" -> ( - (* there must be a Tclass_let just after *) + (* there must be a Tcl_let just after *) match tt_class_expr2.Typedtree.cl_desc with - Typedtree.Tclass_let (_, ({pat_desc = Typedtree.Tpat_var id } , exp) :: _, _, tt_class_expr3) -> + Typedtree.Tcl_let (_, ({pat_desc = Typedtree.Tpat_var (id,_) } , exp) :: _, _, tt_class_expr3) -> let name = Name.from_ident id in let new_param = Simple_name { sn_name = name ; @@ -739,23 +778,23 @@ module Analyser = in (parameter :: params, k) - | (Parsetree.Pcl_apply (p_class_expr2, _), Tclass_apply (tt_class_expr2, exp_opt_optional_list)) -> + | (Parsetree.Pcl_apply (p_class_expr2, _), Tcl_apply (tt_class_expr2, exp_opt_optional_list)) -> let applied_name = (* we want an ident, or else the class applied will appear in the form object ... end, 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 *) + Typedtree.Tcl_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 *) + (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *) match p_class_expr2.Parsetree.pcl_desc with Parsetree.Pcl_constr (lid, _) -> (* we try to get the name from the environment. *) - Name.from_longident lid + Name.from_longident lid.txt | _ -> Odoc_messages.object_end in let param_exps = List.fold_left - (fun acc -> fun (exp_opt, _) -> + (fun acc -> fun (_, exp_opt, _) -> match exp_opt with None -> acc | Some e -> acc @ [e]) @@ -778,14 +817,14 @@ module Analyser = capp_params_code = params_code ; } ) - | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tclass_let (_, _, _, tt_class_expr2)) -> + | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tcl_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 table | (Parsetree.Pcl_constraint (p_class_expr2, p_class_type2), - Typedtree.Tclass_constraint (tt_class_expr2, _, _, _)) -> + Typedtree.Tcl_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 table @@ -810,8 +849,9 @@ module Analyser = (** Analysis of a [Parsetree.class_declaration] and a [Typedtree.class_expr] to return a [t_class].*) let analyse_class env current_module_name comment_opt p_class_decl tt_type_params tt_class_exp table = let name = p_class_decl.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in - let pos_start = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum in + let complete_name = Name.concat current_module_name name.txt in + let loc = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc in + let pos_start = loc.Location.loc_start.Lexing.pos_cnum in 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 @@ -833,7 +873,7 @@ module Analyser = cl_type_parameters = type_parameters ; cl_kind = kind ; cl_parameters = parameters ; - cl_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ; + cl_loc = { loc_impl = Some loc ; loc_inter = None } ; } in cl @@ -842,8 +882,8 @@ module Analyser = is not an ident of a constraint on an ident. *) let rec tt_name_from_module_expr mod_expr = match mod_expr.Typedtree.mod_desc with - Typedtree.Tmod_ident p -> Name.from_path p - | Typedtree.Tmod_constraint (m_exp, _, _) -> tt_name_from_module_expr m_exp + 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_apply _ @@ -853,7 +893,7 @@ module Analyser = (** Get the list of included modules in a module structure of a typed tree. *) let tt_get_included_module_list tt_structure = let f acc item = - match item with + match item.str_desc with Typedtree.Tstr_include (mod_expr, _) -> acc @ [ { (* A VOIR : chercher dans les modules et les module types, avec quel env ? *) @@ -865,7 +905,7 @@ module Analyser = | _ -> acc in - List.fold_left f [] tt_structure + List.fold_left f [] tt_structure.str_items (** This function takes a [module element list] of a module and replaces the "dummy" included modules with the ones found in typed tree structure of the module. *) @@ -888,7 +928,7 @@ module Analyser = and the module has a "structure" kind. *) let rec filter_module_with_module_type_constraint m mt = match m.m_kind, mt with - Module_struct l, Types.Tmty_signature lsig -> + Module_struct l, Types.Mty_signature lsig -> m.m_kind <- Module_struct (filter_module_elements_with_module_type_constraint l lsig); m.m_type <- mt; | _ -> () @@ -898,7 +938,7 @@ module Analyser = and the module type has a "structure" kind. *) and filter_module_type_with_module_type_constraint mtyp mt = match mtyp.mt_kind, mt with - Some Module_type_struct l, Types.Tmty_signature lsig -> + Some Module_type_struct l, Types.Mty_signature lsig -> mtyp.mt_kind <- Some (Module_type_struct (filter_module_elements_with_module_type_constraint l lsig)); mtyp.mt_type <- Some mt; | _ -> () @@ -908,7 +948,7 @@ module Analyser = let f = match ele with Element_module m -> (function - Types.Tsig_module (ident,t,_) -> + Types.Sig_module (ident,t,_) -> let n1 = Name.simple m.m_name and n2 = Ident.name ident in ( @@ -919,7 +959,7 @@ module Analyser = | _ -> false) | Element_module_type mt -> (function - Types.Tsig_modtype (ident,Types.Tmodtype_manifest t) -> + Types.Sig_modtype (ident,Types.Modtype_manifest t) -> let n1 = Name.simple mt.mt_name and n2 = Ident.name ident in ( @@ -930,36 +970,36 @@ module Analyser = | _ -> false) | Element_value v -> (function - Types.Tsig_value (ident,_) -> + Types.Sig_value (ident,_) -> let n1 = Name.simple v.val_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_type t -> (function - Types.Tsig_type (ident,_,_) -> - (* A VOIR: il est possible que le détail du type soit caché *) + Types.Sig_type (ident,_,_) -> + (* A VOIR: il est possible que le detail du type soit cache *) let n1 = Name.simple t.ty_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_exception e -> (function - Types.Tsig_exception (ident,_) -> + Types.Sig_exception (ident,_) -> let n1 = Name.simple e.ex_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_class c -> (function - Types.Tsig_class (ident,_,_) -> + Types.Sig_class (ident,_,_) -> let n1 = Name.simple c.cl_name and n2 = Ident.name ident in n1 = n2 | _ -> false) | Element_class_type ct -> (function - Types.Tsig_cltype (ident,_,_) -> + Types.Sig_class_type (ident,_,_) -> let n1 = Name.simple ct.clt_name and n2 = Ident.name ident in n1 = n2 @@ -974,7 +1014,7 @@ module Analyser = (** 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 = print_DEBUG "Odoc_ast:analyse_struture"; - let (table, table_values) = Typedtree_search.tables typedtree in + let (table, table_values) = Typedtree_search.tables typedtree.str_items in let rec iter env last_pos = function [] -> let s = get_string_of_file last_pos pos_limit in @@ -1047,7 +1087,7 @@ module Analyser = iter new_last_pos acc_env acc q | Some name -> try - let pat_exp = Typedtree_search.search_value table_values name in + let pat_exp = Typedtree_search.search_value table_values name.txt in let (info_opt, ele_comments) = (* we already have the optional comment for the first value. *) if first then @@ -1085,116 +1125,125 @@ module Analyser = let (new_env, l_ele) = iter ~first: true loc.Location.loc_start.Lexing.pos_cnum env [] pat_exp_list in (0, new_env, l_ele) - | Parsetree.Pstr_primitive (name_pre, val_desc) -> - (* of string * value_description *) - print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]"); - let typ = Typedtree_search.search_primitive table name_pre in - let name = Name.parens_if_infix name_pre in - let complete_name = Name.concat current_module_name name in - let new_value = { - val_name = complete_name ; - val_info = comment_opt ; - val_type = Odoc_env.subst_type env typ ; - val_recursive = false ; - 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]) + | Parsetree.Pstr_primitive ({ txt = name_pre }, val_desc) -> + (* of string * value_description *) + print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]"); + let typ = Typedtree_search.search_primitive table name_pre in + let name = Name.parens_if_infix name_pre in + let complete_name = Name.concat current_module_name name in + let code = + if !Odoc_global.keep_code then + Some (get_string_of_file loc.Location.loc_start.Lexing.pos_cnum + loc.Location.loc_end.Lexing.pos_cnum) + else + None + in + let new_value = { + val_name = complete_name ; + val_info = comment_opt ; + val_type = Odoc_env.subst_type env typ ; + val_recursive = false ; + val_parameters = [] ; + val_code = code ; + val_loc = { loc_impl = Some loc ; loc_inter = None } ; + } + in + let new_env = Odoc_env.add_value env new_value.val_name in + (0, new_env, [Element_value new_value]) - | Parsetree.Pstr_type name_typedecl_list -> - (* of (string * type_declaration) list *) - (* we start by extending the environment *) - let new_env = - 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 + | Parsetree.Pstr_type name_typedecl_list -> + (* of (string * type_declaration) list *) + (* we start by extending the environment *) + let new_env = + List.fold_left + (fun acc_env -> fun ({ txt = name }, _) -> + let complete_name = Name.concat current_module_name name in + Odoc_env.add_type acc_env complete_name ) env name_typedecl_list - in - let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list = - match name_type_decl_list with - [] -> (maybe_more_acc, []) - | (name, type_decl) :: q -> - 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 = + in + let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list = + match name_type_decl_list with + [] -> (maybe_more_acc, []) + | ({ txt = name }, type_decl) :: q -> + let complete_name = Name.concat current_module_name name in + let loc = type_decl.Parsetree.ptype_loc in + let loc_start = loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = loc.Location.loc_end.Lexing.pos_cnum in + 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) = + [] -> pos_limit + | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum + in + let (maybe_more, name_comment_list) = Sig.name_comment_from_type_kind - loc_end - pos_limit2 - type_decl.Parsetree.ptype_kind - in - 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 *) - if first then - (comment_opt , []) - else - get_comments_in_module last_pos loc_start - in - let kind = Sig.get_type_kind + loc_end + pos_limit2 + type_decl.Parsetree.ptype_kind + in + 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 tt_type_decl = tt_type_decl.Typedtree.typ_type in + let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) + if first then + (comment_opt , []) + else + get_comments_in_module last_pos loc_start + in + let kind = Sig.get_type_kind new_env name_comment_list tt_type_decl.Types.type_kind - in - let new_end = loc_end + maybe_more in - let t = - { - ty_name = complete_name ; - ty_info = com_opt ; - ty_parameters = + in + let new_end = loc_end + maybe_more in + let t = + { + ty_name = complete_name ; + ty_info = com_opt ; + ty_parameters = List.map2 - (fun p (co,cn,_) -> - (Odoc_env.subst_type new_env p, - co, cn) - ) + (fun p (co,cn,_) -> + (Odoc_env.subst_type new_env p, + co, cn) + ) tt_type_decl.Types.type_params tt_type_decl.Types.type_variance ; - ty_kind = kind ; - ty_private = tt_type_decl.Types.type_private; - ty_manifest = - (match tt_type_decl.Types.type_manifest with - 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_kind = kind ; + ty_private = tt_type_decl.Types.type_private; + ty_manifest = + (match tt_type_decl.Types.type_manifest with + None -> None + | Some t -> Some (Odoc_env.subst_type new_env t)); + ty_loc = { loc_impl = Some loc ; loc_inter = None } ; + ty_code = ( if !Odoc_global.keep_code then Some (get_string_of_file loc_start new_end) else None ) ; - } - in - let (maybe_more2, info_after_opt) = - My_ir.just_after_special + } + in + let (maybe_more2, info_after_opt) = + My_ir.just_after_special !file_name (get_string_of_file new_end pos_limit2) - in - t.ty_info <- Sig.merge_infos t.ty_info info_after_opt ; - let (maybe_more3, eles) = f (maybe_more + maybe_more2) (new_end + maybe_more2) q in - (maybe_more3, ele_comments @ ((Element_type t) :: eles)) - in - let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in - (maybe_more, new_env, eles) + in + t.ty_info <- Sig.merge_infos t.ty_info info_after_opt ; + let (maybe_more3, eles) = f (maybe_more + maybe_more2) (new_end + maybe_more2) q in + (maybe_more3, ele_comments @ ((Element_type t) :: eles)) + in + let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in + (maybe_more, new_env, eles) | Parsetree.Pstr_exception (name, excep_decl) -> (* a new exception is defined *) - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in (* we get the exception declaration in the typed tree *) let tt_excep_decl = - try Typedtree_search.search_exception table name + try Typedtree_search.search_exception table name.txt with Not_found -> raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name)) in @@ -1205,9 +1254,11 @@ module Analyser = { ex_name = complete_name ; ex_info = comment_opt ; - ex_args = List.map (Odoc_env.subst_type new_env) tt_excep_decl ; + ex_args = List.map (fun ctyp -> + Odoc_env.subst_type new_env ctyp.ctyp_type) + tt_excep_decl.exn_params ; ex_alias = None ; - ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + ex_loc = { loc_impl = Some loc ; loc_inter = None } ; ex_code = ( if !Odoc_global.keep_code then @@ -1219,12 +1270,12 @@ module Analyser = in (0, new_env, [ Element_exception new_ex ]) - | Parsetree.Pstr_exn_rebind (name, _) -> + | Parsetree.Pstr_exn_rebind (name, _) -> (* a new exception is defined *) - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in (* we get the exception rebind in the typed tree *) let tt_path = - try Typedtree_search.search_exception_rebind table name + try Typedtree_search.search_exception_rebind table name.txt with Not_found -> raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name)) in @@ -1236,7 +1287,7 @@ module Analyser = ex_args = [] ; ex_alias = Some { ea_name = (Odoc_env.full_exception_name env (Name.from_path tt_path)) ; ea_ex = None ; } ; - ex_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + ex_loc = { loc_impl = Some loc ; loc_inter = None } ; ex_code = None ; } in @@ -1246,11 +1297,11 @@ module Analyser = ( (* of string * module_expr *) try - let tt_module_expr = Typedtree_search.search_module table name in + let tt_module_expr = Typedtree_search.search_module table name.txt in let new_module_pre = analyse_module env current_module_name - name + name.txt comment_opt module_expr tt_module_expr @@ -1270,8 +1321,8 @@ module Analyser = let new_env = Odoc_env.add_module env new_module.m_name in 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 -> + (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> @@ -1280,7 +1331,7 @@ module Analyser = (0, new_env2, [ Element_module new_module ]) with Not_found -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) ) @@ -1290,22 +1341,22 @@ module Analyser = let new_env = List.fold_left (fun acc_env (name, _, mod_exp) -> - let complete_name = Name.concat current_module_name name in + 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 + 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 + name.txt None mod_exp tt_mod_exp in match new_module.m_type with - Types.Tmty_signature s -> + Types.Mty_signature s -> Odoc_env.add_signature e new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> @@ -1318,11 +1369,11 @@ module Analyser = match name_mod_exp_list with [] -> [] | (name, _, mod_exp) :: q -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt 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 + try Typedtree_search.search_module table name.txt 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 *) @@ -1334,7 +1385,7 @@ module Analyser = let new_module = analyse_module new_env current_module_name - name + name.txt com_opt mod_exp tt_mod_exp @@ -1346,31 +1397,31 @@ module Analyser = (0, new_env, eles) | Parsetree.Pstr_modtype (name, modtype) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let tt_module_type = - try Typedtree_search.search_module_type table name + try Typedtree_search.search_module_type table name.txt 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 + modtype tt_module_type.mty_type in let mt = { mt_name = complete_name ; mt_info = comment_opt ; - mt_type = Some tt_module_type ; + mt_type = Some tt_module_type.mty_type ; mt_is_interface = false ; mt_file = !file_name ; mt_kind = Some kind ; - mt_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ; + mt_loc = { loc_impl = Some loc ; 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 - (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on n'aurait pas la signature *) - Types.Tmty_signature s -> + match tt_module_type.mty_type with + (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on n'aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s | _ -> new_env @@ -1393,7 +1444,7 @@ module Analyser = let new_env = List.fold_left (fun acc_env -> fun class_decl -> - let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in Odoc_env.add_class acc_env complete_name ) env @@ -1405,9 +1456,9 @@ 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.txt with Not_found -> - let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_decl.Parsetree.pci_name.txt in raise (Failure (Odoc_messages.class_not_found_in_typedtree complete_name)) in let (com_opt, ele_comments) = @@ -1435,7 +1486,7 @@ module Analyser = let new_env = 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 + let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in Odoc_env.add_class_type acc_env complete_name ) env @@ -1447,13 +1498,14 @@ module Analyser = [] | class_type_decl :: q -> let name = class_type_decl.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt 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 + try Typedtree_search.search_class_type_declaration table name.txt with Not_found -> raise (Failure (Odoc_messages.class_type_not_found_in_typedtree complete_name)) - in + in + let tt_cltype_declaration = tt_cltype_declaration.ci_type_decl in let type_params = tt_cltype_declaration.Types.clty_params in let kind = Sig.analyse_class_type_kind new_env @@ -1478,7 +1530,7 @@ 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 loc ; loc_inter = None } ; } in @@ -1497,13 +1549,14 @@ module Analyser = im_info = comment_opt ; } in - (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *) + (0, env, [ Element_included_module im ]) (* A VOIR : etendre l'environnement ? avec quoi ? *) (** Analysis of a [Parsetree.module_expr] and a name to return a [t_module].*) and analyse_module env current_module_name module_name comment_opt p_module_expr tt_module_expr = 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 loc = p_module_expr.Parsetree.pmod_loc in + let pos_start = loc.Location.loc_start.Lexing.pos_cnum in + let pos_end = loc.Location.loc_end.Lexing.pos_cnum in let modtype = (* A VOIR : Odoc_env.subst_module_type env ? *) tt_module_expr.Typedtree.mod_type @@ -1525,7 +1578,7 @@ module Analyser = m_is_interface = false ; m_file = !file_name ; m_kind = Module_struct [] ; - m_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ; + m_loc = { loc_impl = Some loc ; loc_inter = None } ; m_top_deps = [] ; m_code = None ; (* code is set by the caller, after the module is created *) m_code_intf = m_code_intf ; @@ -1533,7 +1586,7 @@ module Analyser = } in match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with - (Parsetree.Pmod_ident longident, Typedtree.Tmod_ident path) -> + (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 ; ma_module = None ; } } @@ -1546,19 +1599,19 @@ module Analyser = { m_base with m_kind = Module_struct elements2 } | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2), - Typedtree.Tmod_functor (ident, mtyp, tt_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 - current_module_name pmodule_type mtyp + current_module_name pmodule_type mtyp.mty_type in let param = { mp_name = mp_name ; - mp_type = Odoc_env.subst_module_type env mtyp ; + mp_type = Odoc_env.subst_module_type env mtyp.mty_type ; mp_type_code = mp_type_code ; mp_kind = mp_kind ; } @@ -1581,7 +1634,7 @@ module Analyser = 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.mod_desc = Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)}, _, _, _) ) -> let m1 = analyse_module @@ -1603,7 +1656,7 @@ module Analyser = { m_base with m_kind = Module_apply (m1.m_kind, m2.m_kind) } | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), - Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) -> + Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _, _)) -> print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name); let m_base2 = analyse_module env @@ -1629,7 +1682,7 @@ module Analyser = | (Parsetree.Pmod_structure p_structure, Typedtree.Tmod_constraint ({ Typedtree.mod_desc = Typedtree.Tmod_structure tt_structure}, - tt_modtype, _) + tt_modtype, _, _) ) -> (* needed for recursive modules *) @@ -1643,7 +1696,7 @@ module Analyser = m_kind = Module_struct elements2 ; } - | (Parsetree.Pmod_unpack (p_exp), + | (Parsetree.Pmod_unpack p_exp, Typedtree.Tmod_unpack (t_exp, tt_modtype)) -> print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name); let code = @@ -1657,7 +1710,7 @@ module Analyser = (* let name = Odoc_env.full_module_type_name env (Name.from_path (fst pkg_type)) in *) let name = match tt_modtype with - | Tmty_ident p -> + | Mty_ident p -> Odoc_env.full_module_type_name env (Name.from_path p) | _ -> "" in @@ -1720,12 +1773,12 @@ module Analyser = let kind = Module_struct elements2 in { m_name = mod_name ; - m_type = Types.Tmty_signature [] ; + m_type = Types.Mty_signature [] ; m_info = info_opt ; m_is_interface = false ; m_file = !file_name ; m_kind = kind ; - m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ; + m_loc = { loc_impl = Some (Location.in_file !file_name) ; loc_inter = None } ; m_top_deps = [] ; m_code = (if !Odoc_global.keep_code then Some !file else None) ; m_code_intf = None ; diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli index 48ba98bfb3..d7c111f85b 100644 --- a/ocamldoc/odoc_ast.mli +++ b/ocamldoc/odoc_ast.mli @@ -20,7 +20,7 @@ module Typedtree_search : sig type ele - type tab = (ele, Typedtree.structure_item) Hashtbl.t + type tab = (ele, Typedtree.structure_item_desc) Hashtbl.t type tab_values = (Odoc_name.t, Typedtree.pattern * Typedtree.expression) Hashtbl.t (** Create hash tables used to search by some of the functions below. *) @@ -34,12 +34,12 @@ module Typedtree_search : (** This function returns the [Types.module_type] associated to the given module type name, in the given table. @raise Not_found if the module type was not found.*) - val search_module_type : tab -> string -> Types.module_type + val search_module_type : tab -> string -> Typedtree.module_type (** This function returns the [Types.exception_declaration] associated to the given exception name, in the given table. @raise Not_found if the exception was not found.*) - val search_exception : tab -> string -> Types.exception_declaration + val search_exception : tab -> string -> Typedtree.exception_declaration (** This function returns the [Path.t] associated to the given exception rebind name, in the table. @@ -49,7 +49,7 @@ module Typedtree_search : (** This function returns the [Typedtree.type_declaration] associated to the given type name, in the given table. @raise Not_found if the type was not found. *) - val search_type_declaration : tab -> string -> Types.type_declaration + val search_type_declaration : tab -> string -> Typedtree.type_declaration (** This function returns the [Typedtree.class_expr] and type parameters associated to the given class name, in the given table. @@ -59,7 +59,7 @@ module Typedtree_search : (** This function returns the [Types.cltype_declaration] associated to the given class type name, in the given table. @raise Not_found if the class type was not found. *) - val search_class_type_declaration : tab -> string -> Types.cltype_declaration + val search_class_type_declaration : tab -> string -> Typedtree.class_type_declaration (** This function returns the couple (pat, exp) for the given value name, in the given table of values. diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml index 676d0ebc37..5d696819fb 100644 --- a/ocamldoc/odoc_class.ml +++ b/ocamldoc/odoc_class.ml @@ -115,7 +115,7 @@ let rec class_elements ?(trans=true) cl = | Class_constraint (c_kind, ct_kind) -> iter_kind c_kind (* A VOIR : utiliser le c_kind ou le ct_kind ? - Pour l'instant, comme le ct_kind n'est pas analysé, + Pour l'instant, comme le ct_kind n'est pas analyse, on cherche dans le c_kind class_type_elements ~trans: trans { clt_name = "" ; clt_info = None ; diff --git a/ocamldoc/odoc_comments.ml b/ocamldoc/odoc_comments.ml index ea5427e077..af524eefaf 100644 --- a/ocamldoc/odoc_comments.ml +++ b/ocamldoc/odoc_comments.ml @@ -38,7 +38,7 @@ module Info_retriever = | Odoc_text.Text_syntax (l, c, s) -> raise (Failure (Odoc_messages.text_parse_error l c s)) | _ -> - raise (Failure ("Erreur inconnue lors du parse de see : "^s)) + raise (Failure ("Unknown error while parsing @see tag: "^s)) let retrieve_info fun_lex file (s : string) = try diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index 39965f83b2..cd79790d24 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -58,7 +58,9 @@ module P_alias = let p_class c _ = (false, false) let p_class_type ct _ = (false, false) let p_value v _ = false - let p_type t _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type t _ = (false, false) let p_exception e _ = e.ex_alias <> None let p_attribute a _ = false let p_method m _ = false @@ -178,7 +180,7 @@ let kind_name_exists kind = match kind with RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false) | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false) - | RK_class -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) + | RK_class -> (fun e -> match e with Odoc_search.Res_class _ -> true | _ -> false) | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false) | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false) @@ -186,6 +188,8 @@ let kind_name_exists kind = | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false) | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false) | RK_section _ -> assert false + | RK_recfield -> (fun e -> match e with Odoc_search.Res_recfield _ -> true | _ -> false) + | RK_const -> (fun e -> match e with Odoc_search.Res_const _ -> true | _ -> false) in fun name -> try List.exists pred (get_known_elements name) @@ -200,6 +204,8 @@ let type_exists = kind_name_exists RK_type let exception_exists = kind_name_exists RK_exception let attribute_exists = kind_name_exists RK_attribute let method_exists = kind_name_exists RK_method +let recfield_exists = kind_name_exists RK_recfield +let const_exists = kind_name_exists RK_const let lookup_module name = match List.find @@ -246,8 +252,17 @@ class scan = inherit Odoc_scan.scanner method! scan_value v = add_known_element v.val_name (Odoc_search.Res_value v) - method! scan_type t = - add_known_element t.ty_name (Odoc_search.Res_type t) + method! scan_type_recfield t f = + add_known_element + (Printf.sprintf "%s.%s" t.ty_name f.rf_name) + (Odoc_search.Res_recfield (t, f)) + method! scan_type_const t f = + add_known_element + (Printf.sprintf "%s.%s" t.ty_name f.vc_name) + (Odoc_search.Res_const (t, f)) + method! scan_type_pre t = + add_known_element t.ty_name (Odoc_search.Res_type t); + true method! scan_exception e = add_known_element e.ex_name (Odoc_search.Res_exception e) method! scan_attribute a = @@ -620,6 +635,8 @@ let not_found_of_kind kind name = | RK_attribute -> Odoc_messages.cross_attribute_not_found | RK_method -> Odoc_messages.cross_method_not_found | RK_section _ -> Odoc_messages.cross_section_not_found + | RK_recfield -> Odoc_messages.cross_recfield_not_found + | RK_const -> Odoc_messages.cross_const_not_found ) name let rec assoc_comments_text_elements parent_name module_list t_ele = @@ -675,6 +692,10 @@ let rec assoc_comments_text_elements parent_name module_list t_ele = | Odoc_search.Res_attribute a -> (a.att_value.val_name, RK_attribute) | Odoc_search.Res_method m -> (m.met_value.val_name, RK_method) | Odoc_search.Res_section (_ ,t)-> assert false + | Odoc_search.Res_recfield (t, f) -> + (Printf.sprintf "%s.%s" t.ty_name f.rf_name, RK_recfield) + | Odoc_search.Res_const (t, f) -> + (Printf.sprintf "%s.%s" t.ty_name f.vc_name, RK_const) in add_verified (name, Some kind) ; (name, Some kind) @@ -731,6 +752,8 @@ let rec assoc_comments_text_elements parent_name module_list t_ele = | RK_attribute -> attribute_exists | RK_method -> method_exists | RK_section _ -> assert false + | RK_recfield -> recfield_exists + | RK_const -> const_exists in if f name then ( diff --git a/ocamldoc/odoc_dot.ml b/ocamldoc/odoc_dot.ml index a0d5ee2224..bf35e86218 100644 --- a/ocamldoc/odoc_dot.ml +++ b/ocamldoc/odoc_dot.ml @@ -143,4 +143,3 @@ class dot = end module type Dot_generator = module type of Generator - diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index a108cf416a..3621a3ca78 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -51,30 +51,30 @@ let rec add_signature env root ?rel signat = in let f env item = match item with - Types.Tsig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values } - | Types.Tsig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } - | Types.Tsig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions } - | Types.Tsig_module (ident, modtype, _) -> + Types.Sig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values } + | Types.Sig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } + | Types.Sig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions } + | Types.Sig_module (ident, modtype, _) -> let env2 = - match modtype with (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *) - Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s + match modtype with (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *) + Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s | _ -> env in { env2 with env_modules = (rel_name ident, qualify ident) :: env2.env_modules } - | Types.Tsig_modtype (ident, modtype_decl) -> + | Types.Sig_modtype (ident, modtype_decl) -> let env2 = match modtype_decl with - Types.Tmodtype_abstract -> + Types.Modtype_abstract -> env - | Types.Tmodtype_manifest modtype -> + | Types.Modtype_manifest modtype -> match modtype with - (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *) - Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s + (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *) + Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s | _ -> env in { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types } - | Types.Tsig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } - | Types.Tsig_cltype (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } + | Types.Sig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } + | Types.Sig_class_type (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } in List.fold_left f env signat @@ -218,31 +218,31 @@ let subst_type env t = let subst_module_type env t = let rec iter t = match t with - Types.Tmty_ident p -> + Types.Mty_ident p -> let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in - Types.Tmty_ident new_p - | Types.Tmty_signature _ -> + Types.Mty_ident new_p + | Types.Mty_signature _ -> t - | Types.Tmty_functor (id, mt1, mt2) -> - Types.Tmty_functor (id, iter mt1, iter mt2) + | Types.Mty_functor (id, mt1, mt2) -> + Types.Mty_functor (id, iter mt1, iter mt2) in iter t let subst_class_type env t = let rec iter t = match t with - Types.Tcty_constr (p,texp_list,ct) -> + Types.Cty_constr (p,texp_list,ct) -> let new_p = Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in let new_texp_list = List.map (subst_type env) texp_list in let new_ct = iter ct in - Types.Tcty_constr (new_p, new_texp_list, new_ct) - | Types.Tcty_signature cs -> + Types.Cty_constr (new_p, new_texp_list, new_ct) + | Types.Cty_signature cs -> (* on ne s'occupe pas des vals et methods *) t - | Types.Tcty_fun (l, texp, ct) -> + | Types.Cty_fun (l, texp, ct) -> let new_texp = subst_type env texp in let new_ct = iter ct in - Types.Tcty_fun (l, new_texp, new_ct) + Types.Cty_fun (l, new_texp, new_ct) in iter t diff --git a/ocamldoc/odoc_gen.ml b/ocamldoc/odoc_gen.ml index b77b186d4c..b1909e786d 100644 --- a/ocamldoc/odoc_gen.ml +++ b/ocamldoc/odoc_gen.ml @@ -18,13 +18,24 @@ module type Base = sig class generator : doc_generator end;; +module Base_generator : Base = struct + class generator : doc_generator = object method generate l = () end + end;; + +module type Base_functor = functor (G: Base) -> Base +module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator +module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator +module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator +module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator +module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator + type generator = | Html of (module Odoc_html.Html_generator) | Latex of (module Odoc_latex.Latex_generator) | Texi of (module Odoc_texi.Texi_generator) | Man of (module Odoc_man.Man_generator) | Dot of (module Odoc_dot.Dot_generator) - | Other of (module Base) + | Base of (module Base) ;; let get_minimal_generator = function @@ -43,7 +54,7 @@ let get_minimal_generator = function | Dot m -> let module M = (val m : Odoc_dot.Dot_generator) in (new M.dot :> doc_generator) -| Other m -> +| Base m -> let module M = (val m : Base) in new M.generator ;; diff --git a/ocamldoc/odoc_gen.mli b/ocamldoc/odoc_gen.mli index 4649c9504b..37768c008d 100644 --- a/ocamldoc/odoc_gen.mli +++ b/ocamldoc/odoc_gen.mli @@ -20,6 +20,15 @@ module type Base = sig class generator : doc_generator end;; +module Base_generator : Base + +module type Base_functor = functor (P: Base) -> Base +module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator +module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator +module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator +module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator +module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator + (** Various ways to create a generator. *) type generator = | Html of (module Odoc_html.Html_generator) @@ -27,7 +36,7 @@ type generator = | Texi of (module Odoc_texi.Texi_generator) | Man of (module Odoc_man.Man_generator) | Dot of (module Odoc_dot.Dot_generator) - | Other of (module Base) + | Base of (module Base) ;; val get_minimal_generator : generator -> doc_generator diff --git a/ocamldoc/odoc_global.ml b/ocamldoc/odoc_global.ml index b2d7bf872f..11273a84b9 100644 --- a/ocamldoc/odoc_global.ml +++ b/ocamldoc/odoc_global.ml @@ -84,6 +84,3 @@ let with_trailer = ref true let with_toc = ref true let with_index = ref true - - - diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 369114d74c..85b052e305 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -37,6 +37,9 @@ module Naming = (** The prefix for types marks. *) let mark_type = "TYPE" + (** The prefix for types elements (record fields or constructors). *) + let mark_type_elt = "TYPEELT" + (** The prefix for functions marks. *) let mark_function = "FUN" @@ -89,9 +92,25 @@ module Naming = (** Return the link target for the given type. *) let type_target t = target mark_type (Name.simple t.ty_name) + (** Return the link target for the given variant constructor. *) + let const_target t f = + let name = Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.vc_name in + target mark_type_elt name + + (** Return the link target for the given record field. *) + let recfield_target t f = target mark_type_elt + (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.rf_name) + (** Return the complete link target for the given type. *) let complete_type_target t = complete_target mark_type t.ty_name + let complete_recfield_target name = + let typ = Name.father name in + let field = Name.simple name in + Printf.sprintf "%s.%s" (complete_target mark_type_elt typ) field + + let complete_const_target = complete_recfield_target + (** Return the link target for the given exception. *) let exception_target e = target mark_exception (Name.simple e.ex_name) @@ -316,14 +335,10 @@ class virtual text = in fun b s -> if !colorize_code then - ( - bs b "<pre></pre>"; - self#html_of_code b (remove_useless_newlines s); - bs b "<pre></pre>" - ) + self#html_of_code b (remove_useless_newlines s) else ( - bs b "<pre><code class=\""; + bs b "<pre class=\"codepre\"><code class=\""; bs b Odoc_ocamlhtml.code_class; bs b "\">" ; bs b (self#escape (remove_useless_newlines s)); @@ -331,7 +346,7 @@ class virtual text = ) method html_of_Verbatim b s = - bs b "<pre>"; + bs b "<pre class=\"verbatim\">"; bs b (self#escape s); bs b "</pre>" @@ -440,6 +455,8 @@ class virtual text = | Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name) | Odoc_info.RK_section t -> (Naming.complete_label_target name, Odoc_info.Italic [Raw (Odoc_info.string_of_text t)]) + | Odoc_info.RK_recfield -> (Naming.complete_recfield_target name, h name) + | Odoc_info.RK_const -> (Naming.complete_const_target name, h name) in let text = match text_opt with @@ -466,7 +483,7 @@ class virtual text = bs b "<br>\n<table class=\"indextable\">\n"; List.iter (fun name -> - bs b "<tr><td>"; + bs b "<tr><td class=\"module\">"; ( try let m = @@ -490,8 +507,9 @@ class virtual text = let index_if_not_empty l url m = match l with [] -> () - | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m + | _ -> bp b "<li><a href=\"%s\">%s</a></li>\n" url m in + bp b "<ul class=\"indexlist\">\n"; index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types; index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions; index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values; @@ -500,7 +518,8 @@ class virtual text = index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes; index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types; index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules; - index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types + index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types; + bp b "</ul>\n" method virtual list_types : Odoc_info.Type.t_type list method virtual index_types : string @@ -690,7 +709,7 @@ class virtual info = let module M = Odoc_info in let dep = info.M.i_deprecated <> None in bs b "<div class=\"info\">\n"; - if dep then bs b "<font color=\"#CCCCCC\">"; + if dep then bs b "<span class=\"deprecated\">"; ( match info.M.i_desc with None -> () @@ -701,7 +720,7 @@ class virtual info = (Odoc_info.first_sentence_of_text d)); bs b "\n" ); - if dep then bs b "</font>"; + if dep then bs b "</span>"; bs b "</div>\n" end @@ -748,11 +767,7 @@ class html = (** The default style options. *) val mutable default_style_options = - ["a:visited {color : #416DFF; text-decoration : none; }" ; - "a:link {color : #416DFF; text-decoration : none;}" ; - "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ; - "a:active {color : Red; text-decoration : underline; }" ; - ".keyword { font-weight : bold ; color : Red }" ; + [ ".keyword { font-weight : bold ; color : Red }" ; ".keywordsign { color : #C04600 }" ; ".superscript { font-size : 4 }" ; ".subscript { font-size : 4 }" ; @@ -761,9 +776,18 @@ class html = ".type { color : #5C6585 }" ; ".string { color : Maroon }" ; ".warning { color : Red ; font-weight : bold }" ; - ".info { margin-left : 3em; margin-right : 3em }" ; + ".info { margin-left : 3em; margin-right: 3em }" ; ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ; ".code { color : #465F91 ; }" ; + ".typetable { border-style : hidden }" ; + ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; + "tr { background-color : White }" ; + "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; + "div.sig_block {margin-left: 2em}" ; + "*:target { background: yellow; }" ; + + "body {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}"; + "h1 { font-size : 20pt ; text-align: center; }" ; "h2 { font-size : 20pt ; border: 1px solid #000000; "^ @@ -788,7 +812,7 @@ class html = "h6 { font-size : 20pt ; border: 1px solid #000000; "^ "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #C0FFFF ; "^ + "text-align: center; background-color: #90BDFF ; "^ "padding: 2px; }" ; "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^ @@ -806,17 +830,22 @@ class html = "text-align: center; background-color: #FFFFFF ; "^ "padding: 2px; }" ; - ".typetable { border-style : hidden }" ; - ".indextable { border-style : hidden }" ; - ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; - "body { background-color : White }" ; - "tr { background-color : White }" ; - "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; - "pre { margin-bottom: 4px }" ; + "a {color: #416DFF; text-decoration: none}"; + "a:hover {background-color: #ddd; text-decoration: underline}"; + "pre { margin-bottom: 4px; font-family: monospace; }" ; + "pre.verbatim, pre.codepre { }"; - "div.sig_block {margin-left: 2em}" ; + ".indextable {border: 1px #ddd solid; border-collapse: collapse}"; + ".indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}"; + ".indextable td.module {background-color: #eee ; padding-left: 2px; padding-right: 2px}"; + ".indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}"; + ".indextable td.module a:hover {text-decoration: underline; background-color: transparent}"; + ".deprecated {color: #888; font-style: italic}" ; + + ".indextable tr td div.info { margin-left: 2px; margin-right: 2px }" ; - "*:target { background: yellow; } " ; + "ul.indexlist { margin-left: 0; padding-left: 0;}"; + "ul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }"; ] (** The style file for all pages. *) @@ -1052,21 +1081,24 @@ class html = match pre with None -> () | Some name -> - bp b "<a href=\"%s\">%s</a>\n" + bp b "<a class=\"pre\" href=\"%s\" title=\"%s\">%s</a>\n" (fst (Naming.html_files name)) + name Odoc_messages.previous ); bs b " "; let father = Name.father name in let href = if father = "" then self#index else fst (Naming.html_files father) in - bp b "<a href=\"%s\">%s</a>\n" href Odoc_messages.up; + let father_name = if father = "" then "Index" else father in + bp b "<a class=\"up\" href=\"%s\" title=\"%s\">%s</a>\n" href father_name Odoc_messages.up; bs b " "; ( match post with None -> () | Some name -> - bp b "<a href=\"%s\">%s</a>\n" + bp b "<a class=\"post\" href=\"%s\" title=\"%s\">%s</a>\n" (fst (Naming.html_files name)) + name Odoc_messages.next ); bs b "</div>\n" @@ -1244,7 +1276,7 @@ class html = self#html_of_module_kind b father k2; self#html_of_text b [Code ")"] | Module_with (k, s) -> - (* TODO: à modifier quand Module_with sera plus détaillé *) + (* TODO: modify when Module_with will be more detailed *) self#html_of_module_type_kind b father ?modu k; bs b "<code class=\"type\"> "; bs b (self#create_fully_qualified_module_idents_links father s); @@ -1427,7 +1459,7 @@ class html = (match t.ty_manifest, t.ty_kind with None, Type_abstract -> "<pre>" | None, Type_variant _ - | None, Type_record _ -> "<br><code>" + | None, Type_record _ -> "<pre><code>" | Some _, Type_abstract -> "<pre>" | Some _, Type_variant _ | Some _, Type_record _ -> "<pre>" @@ -1456,7 +1488,7 @@ class html = bs b ( match t.ty_manifest with - None -> "</code>" + None -> "</code></pre>" | Some _ -> "</pre>" ); bs b "<table class=\"typetable\">\n"; @@ -1466,7 +1498,9 @@ class html = bs b (self#keyword "|"); bs b "</code></td>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code>"; - bs b (self#constructor constr.vc_name); + bp b "<span id=\"%s\">%s</span>" + (Naming.const_target t constr) + (self#constructor constr.vc_name); ( match constr.vc_args, constr.vc_ret with [], None -> () @@ -1479,8 +1513,8 @@ class html = | l,Some r -> bs b (" " ^ (self#keyword ":") ^ " "); self#html_of_type_expr_list ~par: false b father " * " l; - bs b (" " ^ (self#keyword "->") ^ " "); - self#html_of_type_expr b father r; + bs b (" " ^ (self#keyword "->") ^ " "); + self#html_of_type_expr b father r; ); bs b "</code></td>\n"; ( @@ -1511,7 +1545,7 @@ class html = bs b ( match t.ty_manifest with - None -> "</code>" + None -> "</code></pre>" | Some _ -> "</pre>" ); bs b "<table class=\"typetable\">\n" ; @@ -1521,7 +1555,9 @@ class html = bs b "</td>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code>"; if r.rf_mutable then bs b (self#keyword "mutable ") ; - bs b (r.rf_name ^ " : ") ; + bp b "<span id=\"%s\">%s</span> :" + (Naming.recfield_target t r) + r.rf_name; self#html_of_type_expr b father r.rf_type; bs b ";</code></td>\n"; ( @@ -1834,7 +1870,7 @@ class html = self#html_of_text b [Code "end"] | Class_apply capp -> - (* TODO: afficher le type final à partir du typedtree *) + (* TODO: display final type from typedtree *) self#html_of_text b [Raw "class application not handled yet"] | Class_constr cco -> @@ -2085,9 +2121,11 @@ class html = let b = new_buf () in bs b "<html>\n"; self#print_header b (self#inner_title title); - bs b "<body>\n<center><h1>"; + bs b "<body>\n"; + self#print_navbar b None None ""; + bs b "<h1>"; bs b title; - bs b "</h1></center>\n" ; + bs b "</h1>\n" ; let sorted_elements = List.sort (fun e1 e2 -> compare (Name.simple (name e1)) (Name.simple (name e2))) @@ -2120,7 +2158,7 @@ class html = in bs b "<table>\n"; List.iter f_group groups ; - bs b "</table><br>\n" ; + bs b "</table>\n" ; bs b "</body>\n</html>"; Buffer.output_buffer chanout b; close_out chanout @@ -2159,11 +2197,11 @@ class html = (self#inner_title cl.cl_name); bs b "<body>\n"; self#print_navbar b pre_name post_name cl.cl_name; - bs b "<center><h1>"; + bs b "<h1>"; bs b (Odoc_messages.clas^" "); if cl.cl_virtual then bs b "virtual " ; bp b "<a href=\"%s\">%s</a>" type_file cl.cl_name; - bs b "</h1></center>\n<br>\n"; + bs b "</h1>\n"; self#html_of_class b ~with_link: false cl; (* parameters *) self#html_of_described_parameter_list b @@ -2207,11 +2245,11 @@ class html = bs b "<body>\n"; self#print_navbar b pre_name post_name clt.clt_name; - bs b "<center><h1>"; + bs b "<h1>"; bs b (Odoc_messages.class_type^" "); if clt.clt_virtual then bs b "virtual "; bp b "<a href=\"%s\">%s</a>" type_file clt.clt_name; - bs b "</h1></center>\n<br>\n"; + bs b "</h1>\n"; self#html_of_class_type b ~with_link: false clt; (* class inheritance *) @@ -2252,14 +2290,14 @@ class html = (self#inner_title mt.mt_name); bs b "<body>\n"; self#print_navbar b pre_name post_name mt.mt_name; - bp b "<center><h1>"; + bp b "<h1>"; bs b (Odoc_messages.module_type^" "); ( match mt.mt_type with Some _ -> bp b "<a href=\"%s\">%s</a>" type_file mt.mt_name | None-> bs b mt.mt_name ); - bs b "</h1></center>\n<br>\n" ; + bs b "</h1>\n" ; self#html_of_modtype b ~with_link: false mt; (* parameters for functors *) @@ -2320,7 +2358,7 @@ class html = (self#inner_title modu.m_name); bs b "<body>\n" ; self#print_navbar b pre_name post_name modu.m_name ; - bs b "<center><h1>"; + bs b "<h1>"; if modu.m_text_only then bs b modu.m_name else @@ -2339,7 +2377,7 @@ class html = | Some _ -> bp b " (<a href=\"%s\">.ml</a>)" code_file ) ); - bs b "</h1></center>\n<br>\n"; + bs b "</h1>\n"; if not modu.m_text_only then self#html_of_module b ~with_link: false modu; @@ -2397,9 +2435,10 @@ class html = bs b "<html>\n"; self#print_header b self#title; bs b "<body>\n"; - bs b "<center><h1>"; + + bs b "<h1>"; bs b title; - bs b "</h1></center>\n" ; + bs b "</h1>\n" ; let info = Odoc_info.apply_opt (Odoc_info.info_of_comment_file module_list) !Odoc_info.Global.intro_file diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index 047fa2b5bb..769aade9ca 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -24,6 +24,8 @@ type ref_kind = Odoc_types.ref_kind = | RK_attribute | RK_method | RK_section of text + | RK_recfield + | RK_const and text_element = Odoc_types.text_element = | Raw of string @@ -81,8 +83,8 @@ type info = Odoc_types.info = { } type location = Odoc_types.location = { - loc_impl : (string * int) option ; - loc_inter : (string * int) option ; + loc_impl : Location.t option ; + loc_inter : Location.t option ; } let dummy_loc = { loc_impl = None ; loc_inter = None } @@ -293,6 +295,8 @@ module Search = | Res_attribute of Value.t_attribute | Res_method of Value.t_method | Res_section of string * text + | Res_recfield of Type.t_type * Type.record_field + | Res_const of Type.t_type * Type.variant_constructor type search_result = result_element list diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index 0ab1fa815a..15332fd539 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -25,6 +25,8 @@ type ref_kind = Odoc_types.ref_kind = | RK_attribute | RK_method | RK_section of text + | RK_recfield + | RK_const and text_element = Odoc_types.text_element = | Raw of string (** Raw text. *) @@ -98,8 +100,8 @@ type info = Odoc_types.info = { (** Location of elements in implementation and interface files. *) type location = Odoc_types.location = { - loc_impl : (string * int) option ; (** implementation file name and position *) - loc_inter : (string * int) option ; (** interface file name and position *) + loc_impl : Location.t option ; (** implementation location *) + loc_inter : Location.t option ; (** interface location *) } (** A dummy location. *) @@ -201,7 +203,7 @@ module Type : { vc_name : string ; (** Name of the constructor. *) vc_args : Types.type_expr list ; (** Arguments of the constructor. *) - vc_ret : Types.type_expr option ; + vc_ret : Types.type_expr option ; mutable vc_text : text option ; (** Optional description in the associated comment. *) } @@ -792,6 +794,8 @@ module Search : | Res_attribute of Value.t_attribute | Res_method of Value.t_method | Res_section of string * text + | Res_recfield of Type.t_type * Type.record_field + | Res_const of Type.t_type * Type.variant_constructor (** The type representing a research result.*) type search_result = result_element list @@ -836,6 +840,10 @@ module Scan : (** Scan of 'leaf elements'. *) method scan_value : Value.t_value -> unit + + method scan_type_pre : Type.t_type -> bool + method scan_type_const : Type.t_type -> Type.variant_constructor -> unit + method scan_type_recfield : Type.t_type -> Type.record_field -> unit method scan_type : Type.t_type -> unit method scan_exception : Exception.t_exception -> unit method scan_attribute : Value.t_attribute -> unit diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 6d29acedff..901be36c17 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -37,6 +37,7 @@ let latex_titles = ref [ let latex_value_prefix = ref Odoc_messages.default_latex_value_prefix let latex_type_prefix = ref Odoc_messages.default_latex_type_prefix +let latex_type_elt_prefix = ref Odoc_messages.default_latex_type_elt_prefix let latex_exception_prefix = ref Odoc_messages.default_latex_exception_prefix let latex_module_prefix = ref Odoc_messages.default_latex_module_prefix let latex_module_type_prefix = ref Odoc_messages.default_latex_module_type_prefix @@ -86,77 +87,87 @@ class text = "\\"^sec^"{"^s^"}\n" with Not_found -> s - (** Associations of strings to subsitute in latex code. *) - val mutable subst_strings = [ - ("MAXENCE"^"ZZZ", "\\$"); - ("MAXENCE"^"YYY", "\\&"); - ("MAXENCE"^"XXX", "{\\textbackslash}") ; - ("à", "\\`a") ; - ("â", "\\^a") ; - ("é", "\\'e") ; - ("è", "\\`e") ; - ("ê", "\\^e") ; - ("ë", "\\\"e") ; - ("ç", "\\c{c}") ; - ("ô", "\\^o") ; - ("ö", "\\\"o") ; - ("î", "\\^i") ; - ("ï", "\\\"i") ; - ("ù", "\\`u") ; - ("û", "\\^u") ; - ("%", "\\%") ; - ("_", "\\_"); - ("\\.\\.\\.", "$\\ldots$"); - ("~", "\\~{}"); - ("#", "\\verb`#`"); - ("}", "\\}"); - ("{", "\\{"); - ("&", "\\&"); - (">", "$>$"); - ("<", "$<$"); - ("=", "$=$"); - (">=", "$\\geq$"); - ("<=", "$\\leq$"); - ("->", "$\\rightarrow$") ; - ("<-", "$\\leftarrow$"); - ("|", "\\textbar "); - ("\\^", "\\textasciicircum ") ; - ("\\.\\.\\.", "$\\ldots$"); - ("\\\\", "MAXENCE"^"XXX") ; - ("&", "MAXENCE"^"YYY") ; - ("\\$", "MAXENCE"^"ZZZ"); - ] - - val mutable subst_strings_simple = + (** Associations of strings to substitute in latex code. *) + val subst_strings = List.map (fun (x, y) -> (Str.regexp x, y)) [ - ("MAXENCE"^"XXX", "{\\textbackslash}") ; - "}", "\\}" ; - "{", "\\{" ; - ("\\\\", "MAXENCE"^"XXX") ; + "\001", "\001\002"; + "\\\\", "\001b"; + + "{", "\\\\{"; + "}", "\\\\}"; + "\\$", "\\\\$"; + "\\^", "{\\\\textasciicircum}"; + "\xE0", "\\\\`a"; + "\xE2", "\\\\^a"; + "\xE9", "\\\\'e"; + "\xE8", "\\\\`e"; + "\xEA", "\\\\^e"; + "\xEB", "\\\\\"e"; + "\xE7", "\\\\c{c}"; + "\xF4", "\\\\^o"; + "\xF6", "\\\\\"o"; + "\xEE", "\\\\^i"; + "\xEF", "\\\\\"i"; + "\xF9", "\\\\`u"; + "\xFB", "\\\\^u"; + "%", "\\\\%"; + "_", "\\\\_"; + "~", "\\\\~{}"; + "#", "{\\char35}"; + "->", "$\\\\rightarrow$"; + "<-", "$\\\\leftarrow$"; + ">=", "$\\\\geq$"; + "<=", "$\\\\leq$"; + ">", "$>$"; + "<", "$<$"; + "=", "$=$"; + "|", "{\\\\textbar}"; + "\\.\\.\\.", "$\\\\ldots$"; + "&", "\\\\&"; + + "\001b", "{\\\\char92}"; + "\001\002", "\001"; ] - val mutable subst_strings_code = [ - ("MAXENCE"^"ZZZ", "\\$"); - ("MAXENCE"^"YYY", "\\&"); - ("MAXENCE"^"XXX", "{\\textbackslash}") ; - ("%", "\\%") ; - ("_", "\\_"); - ("~", "\\~{}"); - ("#", "\\verb`#`"); - ("}", "\\}"); - ("{", "\\{"); - ("&", "\\&"); - ("\\^", "\\textasciicircum ") ; - ("&", "MAXENCE"^"YYY") ; - ("\\$", "MAXENCE"^"ZZZ") ; - ("\\\\", "MAXENCE"^"XXX") ; - ] + val subst_strings_simple = List.map (fun (x, y) -> (Str.regexp x, y)) + [ + "\001", "\001\002"; + "\\\\", "\001b"; + "{", "\001l"; + + "}", "{\\\\char125}"; + "'", "{\\\\textquotesingle}"; + "`", "{\\\\textasciigrave}"; + + "\001b", "{\\\\char92}"; + "\001l", "{\\\\char123}"; + "\001\002", "\001"; + ] + + val subst_strings_code = List.map (fun (x, y) -> (Str.regexp x, y)) + [ + "\001", "\001\002"; + "\\\\", "\001b"; + "{", "\001l"; + + "}", "{\\\\char125}"; + "'", "{\\\\textquotesingle}"; + "`", "{\\\\textasciigrave}"; + "%", "\\\\%"; + "_", "\\\\_"; + "~", "{\\\\char126}"; + "#", "{\\\\char35}"; + "&", "\\\\&"; + "\\$", "\\\\$"; + "\\^", "{\\\\char94}"; + + "\001b", "{\\\\char92}"; + "\001l", "{\\\\char123}"; + "\001\002", "\001"; + ] method subst l s = - List.fold_right - (fun (s, s2) -> fun acc -> Str.global_replace (Str.regexp s) s2 acc) - l - s + List.fold_left (fun acc (re, st) -> Str.global_replace re st acc) s l (** Escape the strings which would clash with LaTeX syntax. *) method escape s = self#subst subst_strings s @@ -230,6 +241,12 @@ class text = (** Make a correct label from a type name. *) method type_label ?no_ name = !latex_type_prefix^(self#label ?no_ name) + (** Make a correct label from a record field. *) + method recfield_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name) + + (** Make a correct label from a variant constructor. *) + method const_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name) + (** Return latex code for the label of a given label. *) method make_label label = "\\label{"^label^"}" @@ -291,9 +308,9 @@ class text = ps fmt "\n\\end{ocamldoccode}\n" method latex_of_Verbatim fmt s = - ps fmt "\\begin{verbatim}"; + ps fmt "\n\\begin{verbatim}\n"; ps fmt s; - ps fmt "\\end{verbatim}" + ps fmt "\n\\end{verbatim}\n" method latex_of_Bold fmt t = ps fmt "{\\bf "; @@ -399,6 +416,8 @@ class text = | Odoc_info.RK_attribute -> self#attribute_label | Odoc_info.RK_method -> self#method_label | Odoc_info.RK_section _ -> assert false + | Odoc_info.RK_recfield -> self#recfield_label + | Odoc_info.RK_const -> self#const_label in let text = match text_opt with @@ -555,8 +574,8 @@ class latex = p fmt2 " %s@ %s@ %s@ %s" ":" (self#normal_type_list ~par: false mod_name " * " l) - "->" - (self#normal_type mod_name r) + "->" + (self#normal_type mod_name r) ); flush2 () in @@ -684,7 +703,7 @@ class latex = self#latex_of_module_kind fmt father k2; self#latex_of_text fmt [Code ")"] | Module_with (k, s) -> - (* TODO: à modifier quand Module_with sera plus détaillé *) + (* TODO: a modifier quand Module_with sera plus detaille *) self#latex_of_module_type_kind fmt father k; self#latex_of_text fmt [ Code " "; @@ -713,7 +732,7 @@ class latex = self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"] | Class_apply capp -> - (* TODO: afficher le type final à partir du typedtree *) + (* TODO: afficher le type final a partir du typedtree *) self#latex_of_text fmt [Raw "class application not handled yet"] | Class_constr cco -> @@ -1112,6 +1131,7 @@ class latex = ps fmt "\\documentclass[11pt]{article} \n"; ps fmt "\\usepackage[latin1]{inputenc} \n"; ps fmt "\\usepackage[T1]{fontenc} \n"; + ps fmt "\\usepackage{textcomp}\n"; ps fmt "\\usepackage{fullpage} \n"; ps fmt "\\usepackage{url} \n"; ps fmt "\\usepackage{ocamldoc}\n"; diff --git a/ocamldoc/odoc_lexer.mll b/ocamldoc/odoc_lexer.mll index 318a839fff..4a534e1c3d 100644 --- a/ocamldoc/odoc_lexer.mll +++ b/ocamldoc/odoc_lexer.mll @@ -22,10 +22,10 @@ let line_number = ref 0 let string_buffer = Buffer.create 32 -(** Fonction de remise à zéro de la chaine de caractères tampon *) +(** Fonction de remise a zero de la chaine de caracteres tampon *) let reset_string_buffer () = Buffer.reset string_buffer -(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *) +(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *) let ajout_char_string = Buffer.add_char string_buffer (** Add a string to the buffer. *) diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 037dee02da..e6a3ed3d10 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -478,10 +478,10 @@ class man = bs b "(* "; self#man_of_text b t; bs b " *)\n " - | [], None, Some r -> + | [], None, Some r -> bs b "\n.B : "; self#man_of_type_expr b father r; - bs b " " + bs b " " | [], (Some t), Some r -> bs b "\n.B : "; self#man_of_type_expr b father r; @@ -492,13 +492,13 @@ class man = | l, None, Some r -> bs b "\n.B : "; self#man_of_type_expr_list ~par: false b father " * " l; - bs b ".B -> "; + bs b ".B -> "; self#man_of_type_expr b father r; bs b " " | l, (Some t), Some r -> bs b "\n.B of "; self#man_of_type_expr_list ~par: false b father " * " l; - bs b ".B -> "; + bs b ".B -> "; self#man_of_type_expr b father r; bs b ".I \" \"\n"; bs b "(* "; @@ -999,6 +999,8 @@ class man = | Res_attribute a -> Name.simple a.att_value.val_name | Res_method m -> Name.simple m.met_value.val_name | Res_section _ -> assert false + | Res_recfield (_,f) -> f.rf_name + | Res_const (_,f) -> f.vc_name in let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*") in let all_items = List.filter @@ -1040,6 +1042,8 @@ class man = | Res_attribute a -> a.att_value.val_name | Res_method m -> m.met_value.val_name | Res_section (s,_) -> s + | Res_recfield (_,f) -> f.rf_name + | Res_const (_,f) -> f.vc_name ) in let date = Unix.time () in diff --git a/ocamldoc/odoc_merge.mli b/ocamldoc/odoc_merge.mli index 4f580ee899..748a8b2fe1 100644 --- a/ocamldoc/odoc_merge.mli +++ b/ocamldoc/odoc_merge.mli @@ -13,7 +13,7 @@ (** Merge of information from [.ml] and [.mli] for a module.*) -(** Merging \@before tags. *) +(** Merging \@before tags. *) val merge_before_tags : (string * Odoc_types.text) list -> (string * Odoc_types.text) list diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml index 1f27d5763f..7dfdff4907 100644 --- a/ocamldoc/odoc_messages.ml +++ b/ocamldoc/odoc_messages.ml @@ -127,6 +127,11 @@ let latex_type_prefix = "<string>\n\t\tUse <string> as prefix for the LaTeX labels of types.\n"^ "\t\t(default is \""^default_latex_type_prefix^"\")" +let default_latex_type_elt_prefix = "typeelt:" +let latex_type_elt_prefix = + "<string>\n\t\tUse <string> as prefix for the LaTeX labels of type elements.\n"^ + "\t\t(default is \""^default_latex_type_elt_prefix^"\")" + let default_latex_exception_prefix = "exception:" let latex_exception_prefix = "<string>\n\t\tUse <string> as prefix for the LaTeX labels of exceptions.\n"^ @@ -244,7 +249,7 @@ let tag_not_handled tag = "Tag @"^tag^" not handled by this generator" let bad_tree = "Incorrect tree structure." let not_a_valid_tag s = s^" is not a valid tag." let fun_without_param f = "Function "^f^" has no parameter.";; -let method_without_param f = "Méthode "^f^" has no parameter.";; +let method_without_param f = "Method "^f^" has no parameter.";; let anonymous_parameters f = "Function "^f^" has anonymous parameters." let function_colon f = "Function "^f^": " let implicit_match_in_parameter = "Parameters contain implicit pattern matching." @@ -294,11 +299,17 @@ let cross_attribute_not_found n = "Attribute "^n^" not found" let cross_section_not_found n = "Section "^n^" not found" let cross_value_not_found n = "Value "^n^" not found" let cross_type_not_found n = "Type "^n^" not found" +let cross_recfield_not_found n = Printf.sprintf "Record field %s not found" n +let cross_const_not_found n = Printf.sprintf "Constructor %s not found" n let object_end = "object ... end" let struct_end = "struct ... end" let sig_end = "sig ... end" +let current_generator_is_not kind = + Printf.sprintf "Current generator is not a %s generator" kind +;; + (** Messages for verbose mode. *) let analysing f = "Analysing file "^f^"..." diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index c48c1f6a56..f3de94858b 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -334,7 +334,7 @@ let rec get_before_dot s = let len = String.length s in let n = String.index s '.' in if n + 1 >= len then - (* le point est le dernier caractère *) + (* le point est le dernier caractere *) (true, s, "") else match s.[n+1] with diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index cc1fe02ca8..0cbc2cc6ac 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -238,7 +238,7 @@ let rec module_elements ?(trans=true) m = module_elements ~trans: trans { m_name = "" ; m_info = None ; - m_type = Types.Tmty_signature [] ; + m_type = Types.Mty_signature [] ; m_is_interface = false ; m_file = "" ; m_kind = k ; m_loc = Odoc_types.dummy_loc ; m_top_deps = [] ; diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml index b82cf87458..9a934d7522 100644 --- a/ocamldoc/odoc_name.ml +++ b/ocamldoc/odoc_name.ml @@ -52,11 +52,11 @@ let strip_string s = else match s.[n] with ' ' | '\t' | '\n' | '\r' -> iter_last (n-1) - | _ -> Some n + | _ -> Some n in match iter_last (len-1) with None -> String.sub s first 1 - | Some last -> String.sub s first ((last-first)+1) + | Some last -> String.sub s first ((last-first)+1) let parens_if_infix name = match strip_string name with @@ -215,3 +215,9 @@ let to_path n = | Some p -> p let from_longident = Odoc_misc.string_of_longident + +module Set = Set.Make (struct + type z = t + type t = z + let compare = String.compare +end) diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli index e3b43a7867..9bff7c22ff 100644 --- a/ocamldoc/odoc_name.mli +++ b/ocamldoc/odoc_name.mli @@ -67,3 +67,6 @@ val to_path : t -> Path.t (** Get a name from a [Longident.t].*) val from_longident : Longident.t -> t + +(** Set of Name.t *) +module Set : Set.S with type elt = t diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml index 5cc8e038c7..f8c0e09fe9 100644 --- a/ocamldoc/odoc_print.ml +++ b/ocamldoc/odoc_print.ml @@ -55,15 +55,15 @@ exception Use_code of string let simpl_module_type ?code t = let rec iter t = match t with - Types.Tmty_ident p -> t - | Types.Tmty_signature _ -> + Types.Mty_ident p -> t + | Types.Mty_signature _ -> ( match code with - None -> Types.Tmty_signature [] + None -> Types.Mty_signature [] | Some s -> raise (Use_code s) ) - | Types.Tmty_functor (id, mt1, mt2) -> - Types.Tmty_functor (id, iter mt1, iter mt2) + | Types.Mty_functor (id, mt1, mt2) -> + Types.Mty_functor (id, iter mt1, iter mt2) in iter t @@ -80,20 +80,20 @@ let string_of_module_type ?code ?(complete=false) t = let simpl_class_type t = let rec iter t = match t with - Types.Tcty_constr (p,texp_list,ct) -> t - | Types.Tcty_signature cs -> - (* on vire les vals et methods pour ne pas qu'elles soient imprimées + Types.Cty_constr (p,texp_list,ct) -> t + | Types.Cty_signature cs -> + (* on vire les vals et methods pour ne pas qu'elles soient imprimees quand on affichera le type *) let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in - Types.Tcty_signature { Types.cty_self = { cs.Types.cty_self with + Types.Cty_signature { Types.cty_self = { cs.Types.cty_self with Types.desc = Types.Tobject (tnil, ref None) }; Types.cty_vars = Types.Vars.empty ; Types.cty_concr = Types.Concr.empty ; Types.cty_inher = [] } - | Types.Tcty_fun (l, texp, ct) -> + | Types.Cty_fun (l, texp, ct) -> let new_ct = iter ct in - Types.Tcty_fun (l, texp, new_ct) + Types.Cty_fun (l, texp, new_ct) in iter t diff --git a/ocamldoc/odoc_scan.ml b/ocamldoc/odoc_scan.ml index 29e1ca2724..b5e0371d94 100644 --- a/ocamldoc/odoc_scan.ml +++ b/ocamldoc/odoc_scan.ml @@ -28,7 +28,18 @@ class scanner = (** Scan of 'leaf elements'. *) method scan_value (v : Odoc_value.t_value) = () - method scan_type (t : Odoc_type.t_type) = () + + method scan_type_pre (t : Odoc_type.t_type) = true + + method scan_type_recfield t (f : Odoc_type.record_field) = () + method scan_type_const t (f : Odoc_type.variant_constructor) = () + method scan_type (t : Odoc_type.t_type) = + if self#scan_type_pre t then + match t.Odoc_type.ty_kind with + Odoc_type.Type_abstract -> () + | Odoc_type.Type_variant l -> List.iter (self#scan_type_const t) l + | Odoc_type.Type_record l -> List.iter (self#scan_type_recfield t) l + method scan_exception (e : Odoc_exception.t_exception) = () method scan_attribute (a : Odoc_value.t_attribute) = () method scan_method (m : Odoc_value.t_method) = () @@ -45,7 +56,7 @@ class scanner = method scan_class_pre (c : Odoc_class.t_class) = true (** This method scan the elements of the given class. - A VOIR : scan des classes héritées.*) + A VOIR : scan des classes heritees.*) method scan_class_elements c = List.iter (fun ele -> @@ -71,7 +82,7 @@ class scanner = method scan_class_type_pre (ct : Odoc_class.t_class_type) = true (** This method scan the elements of the given class type. - A VOIR : scan des classes héritées.*) + A VOIR : scan des classes heritees.*) method scan_class_type_elements ct = List.iter (fun ele -> diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml index 65d602d3b9..91b1d13c89 100644 --- a/ocamldoc/odoc_search.ml +++ b/ocamldoc/odoc_search.ml @@ -32,6 +32,8 @@ type result_element = | Res_attribute of t_attribute | Res_method of t_method | Res_section of string * Odoc_types.text + | Res_recfield of t_type * record_field + | Res_const of t_type * variant_constructor type result = result_element list @@ -43,7 +45,9 @@ module type Predicates = val p_class : t_class -> t -> bool * bool val p_class_type : t_class_type -> t -> bool * bool val p_value : t_value -> t -> bool - val p_type : t_type -> t -> bool + val p_recfield : t_type -> record_field -> t -> bool + val p_const : t_type -> variant_constructor -> t -> bool + val p_type : t_type -> t -> (bool * bool) val p_exception : t_exception -> t -> bool val p_attribute : t_attribute -> t -> bool val p_method : t_method -> t -> bool @@ -92,7 +96,26 @@ module Search = let search_value va v = if P.p_value va v then [Res_value va] else [] - let search_type t v = if P.p_type t v then [Res_type t] else [] + let search_recfield t f v = + if P.p_recfield t f v then [Res_recfield (t,f)] else [] + + let search_const t f v = + if P.p_const t f v then [Res_const (t,f)] else [] + + let search_type t v = + let (go_deeper, ok) = P.p_type t v in + let l = + match go_deeper with + false -> [] + | true -> + match t.ty_kind with + Type_abstract -> [] + | Type_record l -> + List.flatten (List.map (fun rf -> search_recfield t rf v) l) + | Type_variant l -> + List.flatten (List.map (fun rf -> search_const t rf v) l) + in + if ok then (Res_type t) :: l else l let search_exception e v = if P.p_exception e v then [Res_exception e] else [] @@ -305,7 +328,13 @@ module P_name = let p_class c r = (true, c.cl_name =~ r) let p_class_type ct r = (true, ct.clt_name =~ r) let p_value v r = v.val_name =~ r - let p_type t r = t.ty_name =~ r + let p_recfield t f r = + let name = Printf.sprintf "%s.%s" t.ty_name f.rf_name in + name =~ r + let p_const t f r = + let name = Printf.sprintf "%s.%s" t.ty_name f.vc_name in + name =~ r + let p_type t r = (true, t.ty_name =~ r) let p_exception e r = e.ex_name =~ r let p_attribute a r = a.att_value.val_name =~ r let p_method m r = m.met_value.val_name =~ r @@ -322,7 +351,9 @@ module P_values = let p_class _ _ = (false, false) let p_class_type _ _ = (false, false) let p_value _ _ = true - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false @@ -347,7 +378,9 @@ module P_exceptions = let p_class _ _ = (false, false) let p_class_type _ _ = (false, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = true let p_attribute _ _ = false let p_method _ _ = false @@ -372,7 +405,9 @@ module P_types = let p_class _ _ = (false, false) let p_class_type _ _ = (false, false) let p_value _ _ = false - let p_type _ _ = true + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, true) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false @@ -397,7 +432,9 @@ module P_attributes = let p_class _ _ = (true, false) let p_class_type _ _ = (true, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = true let p_method _ _ = false @@ -422,7 +459,9 @@ module P_methods = let p_class _ _ = (true, false) let p_class_type _ _ = (true, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = true @@ -447,7 +486,9 @@ module P_classes = let p_class _ _ = (false, true) let p_class_type _ _ = (false, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false @@ -472,7 +513,9 @@ module P_class_types = let p_class _ _ = (false, false) let p_class_type _ _ = (false, true) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false @@ -497,7 +540,9 @@ module P_modules = let p_class _ _ = (false, false) let p_class_type _ _ = (false, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false @@ -522,7 +567,9 @@ module P_module_types = let p_class _ _ = (false, false) let p_class_type _ _ = (false, false) let p_value _ _ = false - let p_type _ _ = false + let p_recfield _ _ _ = false + let p_const _ _ _ = false + let p_type _ _ = (false, false) let p_exception _ _ = false let p_attribute _ _ = false let p_method _ _ = false diff --git a/ocamldoc/odoc_search.mli b/ocamldoc/odoc_search.mli index d7ace5831a..2f882d5246 100644 --- a/ocamldoc/odoc_search.mli +++ b/ocamldoc/odoc_search.mli @@ -25,6 +25,8 @@ type result_element = | Res_attribute of Odoc_value.t_attribute | Res_method of Odoc_value.t_method | Res_section of string * Odoc_types.text + | Res_recfield of Odoc_type.t_type * Odoc_type.record_field + | Res_const of Odoc_type.t_type * Odoc_type.variant_constructor (** The type representing a research result.*) type result = result_element list @@ -42,7 +44,9 @@ module type Predicates = val p_class : Odoc_class.t_class -> t -> bool * bool val p_class_type : Odoc_class.t_class_type -> t -> bool * bool val p_value : Odoc_value.t_value -> t -> bool - val p_type : Odoc_type.t_type -> t -> bool + val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> t -> bool + val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> t -> bool + val p_type : Odoc_type.t_type -> t -> (bool * bool) val p_exception : Odoc_exception.t_exception -> t -> bool val p_attribute : Odoc_value.t_attribute -> t -> bool val p_method : Odoc_value.t_method -> t -> bool @@ -59,6 +63,14 @@ module Search : (** search in a value *) val search_value : Odoc_value.t_value -> P.t -> result_element list + (** search in a record field *) + val search_recfield : + Odoc_type.t_type -> Odoc_type.record_field -> P.t -> result_element list + + (** search in a variant constructor *) + val search_const : + Odoc_type.t_type -> Odoc_type.variant_constructor -> P.t -> result_element list + (** search in a type *) val search_type : Odoc_type.t_type -> P.t -> result_element list @@ -102,7 +114,9 @@ module P_name : val p_class : Odoc_class.t_class -> Str.regexp -> bool * bool val p_class_type : Odoc_class.t_class_type -> Str.regexp -> bool * bool val p_value : Odoc_value.t_value -> Str.regexp -> bool - val p_type : Odoc_type.t_type -> Str.regexp -> bool + val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> Str.regexp -> bool + val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> Str.regexp -> bool + val p_type : Odoc_type.t_type -> Str.regexp -> (bool * bool) val p_exception : Odoc_exception.t_exception -> Str.regexp -> bool val p_attribute : Odoc_value.t_attribute -> Str.regexp -> bool val p_method : Odoc_value.t_method -> Str.regexp -> bool @@ -113,6 +127,8 @@ module Search_by_name : sig val search_section : Odoc_types.text -> string -> P_name.t -> result_element list val search_value : Odoc_value.t_value -> P_name.t -> result_element list + val search_recfield : Odoc_type.t_type -> Odoc_type.record_field -> P_name.t -> result_element list + val search_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> P_name.t -> result_element list val search_type : Odoc_type.t_type -> P_name.t -> result_element list val search_exception : Odoc_exception.t_exception -> P_name.t -> result_element list diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 44fce22e52..2d69f76df8 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -47,19 +47,19 @@ module Signature_search = let add_to_hash table signat = match signat with - Types.Tsig_value (ident, _) -> + Types.Sig_value (ident, _) -> Hashtbl.add table (V (Name.from_ident ident)) signat - | Types.Tsig_exception (ident, _) -> + | Types.Sig_exception (ident, _) -> Hashtbl.add table (E (Name.from_ident ident)) signat - | Types.Tsig_type (ident, _, _) -> + | Types.Sig_type (ident, _, _) -> Hashtbl.add table (T (Name.from_ident ident)) signat - | Types.Tsig_class (ident, _, _) -> + | Types.Sig_class (ident, _, _) -> Hashtbl.add table (C (Name.from_ident ident)) signat - | Types.Tsig_cltype (ident, _, _) -> + | Types.Sig_class_type (ident, _, _) -> Hashtbl.add table (CT (Name.from_ident ident)) signat - | Types.Tsig_module (ident, _, _) -> + | Types.Sig_module (ident, _, _) -> Hashtbl.add table (M (Name.from_ident ident)) signat - | Types.Tsig_modtype (ident,_) -> + | Types.Sig_modtype (ident,_) -> Hashtbl.add table (MT (Name.from_ident ident)) signat let table signat = @@ -69,40 +69,40 @@ module Signature_search = let search_value table name = match Hashtbl.find table (V name) with - | (Types.Tsig_value (_, val_desc)) -> val_desc.Types.val_type + | (Types.Sig_value (_, val_desc)) -> val_desc.Types.val_type | _ -> assert false let search_exception table name = match Hashtbl.find table (E name) with - | (Types.Tsig_exception (_, type_expr_list)) -> + | (Types.Sig_exception (_, type_expr_list)) -> type_expr_list | _ -> assert false let search_type table name = match Hashtbl.find table (T name) with - | (Types.Tsig_type (_, type_decl, _)) -> type_decl + | (Types.Sig_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.Sig_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.Sig_class_type (_, 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.Sig_module (ident, module_type, _)) -> module_type | _ -> assert false let search_module_type table name = match Hashtbl.find table (MT name) with - | (Types.Tsig_modtype (_, Types.Tmodtype_manifest module_type)) -> + | (Types.Sig_modtype (_, Types.Modtype_manifest module_type)) -> Some module_type - | (Types.Tsig_modtype (_, Types.Tmodtype_abstract)) -> + | (Types.Sig_modtype (_, Types.Modtype_abstract)) -> None | _ -> assert false @@ -185,14 +185,14 @@ module Analyser = pos_limit in let (len, comment_opt) = My_ir.just_after_special !file_name s in - (len, acc @ [ (name, comment_opt) ]) + (len, acc @ [ (name.txt, comment_opt) ]) | (name, _, _, loc) :: (name2, core_type_list2, ret_type2, 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]) + f (acc @ [name.txt, comment_opt]) ((name2, core_type_list2, ret_type2, loc2) :: q) in f [] cons_core_type_list_list @@ -205,13 +205,13 @@ module Analyser = let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in let s = get_string_of_file pos pos_end in let (_,comment_opt) = My_ir.just_after_special !file_name s in - [name, comment_opt] + [name.txt, comment_opt] | (name,_,ct,xxloc) :: ((name2,_,ct2,xxloc2) as ele2) :: q -> let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in let s = get_string_of_file pos pos2 in let (_,comment_opt) = My_ir.just_after_special !file_name s in - (name, comment_opt) :: (f (ele2 :: q)) + (name.txt, comment_opt) :: (f (ele2 :: q)) in (0, f name_mutable_type_list) @@ -221,6 +221,7 @@ module Analyser = Odoc_type.Type_abstract | Types.Type_variant l -> let f (constructor_name, type_expr_list, ret_type) = + let constructor_name = Ident.name constructor_name in let comment_opt = try match List.assoc constructor_name name_comment_list with @@ -231,7 +232,7 @@ module Analyser = { vc_name = constructor_name ; vc_args = List.map (Odoc_env.subst_type env) type_expr_list ; - vc_ret = may_map (Odoc_env.subst_type env) ret_type; + vc_ret = may_map (Odoc_env.subst_type env) ret_type; vc_text = comment_opt } in @@ -239,6 +240,7 @@ module Analyser = | Types.Type_record (l, _) -> let f (field_name, mutable_flag, type_expr) = + let field_name = Ident.name field_name in let comment_opt = try match List.assoc field_name name_comment_list with @@ -255,6 +257,38 @@ module Analyser = in Odoc_type.Type_record (List.map f l) + let erased_names_of_constraints constraints acc = + List.fold_right (fun (longident, constraint_) acc -> + match constraint_ with + | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc + | Parsetree.Pwith_typesubst _ | Parsetree.Pwith_modsubst _ -> + Name.Set.add (Name.from_longident longident.txt) acc) + constraints acc + + let filter_out_erased_items_from_signature erased signature = + if Name.Set.is_empty erased then signature + else List.fold_right (fun sig_item acc -> + let take_item psig_desc = { sig_item with Parsetree.psig_desc } :: acc in + match sig_item.Parsetree.psig_desc with + | Parsetree.Psig_value (_, _) + | Parsetree.Psig_exception (_, _) + | Parsetree.Psig_open _ + | Parsetree.Psig_include _ + | Parsetree.Psig_class _ + | Parsetree.Psig_class_type _ as tp -> take_item tp + | Parsetree.Psig_type types -> + (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt erased)) types with + | [] -> acc + | types -> take_item (Parsetree.Psig_type types)) + | Parsetree.Psig_module (name, _) + | Parsetree.Psig_modtype (name, _) as m -> + if Name.Set.mem name.txt erased then acc else take_item m + | Parsetree.Psig_recmodule mods -> + (match List.filter (fun (name, _) -> not (Name.Set.mem name.txt 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 signature. @return the couple (inherited_class list, elements).*) let analyse_class_elements env current_class_name last_pos pos_limit @@ -262,12 +296,13 @@ module Analyser = let get_pos_limit2 q = match q with [] -> pos_limit - | ele2 :: _ -> - match ele2 with - Parsetree.Pctf_val (_, _, _, _, loc) - | Parsetree.Pctf_virt (_, _, _, loc) - | Parsetree.Pctf_meth (_, _, _, loc) - | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum + | ele2 :: _ -> + let loc = ele2.Parsetree.pctf_loc in + match ele2.Parsetree.pctf_desc with + Parsetree.Pctf_val (_, _, _, _) + | Parsetree.Pctf_virt (_, _, _) + | Parsetree.Pctf_meth (_, _, _) + | Parsetree.Pctf_cstr (_, _) -> loc.Location.loc_start.Lexing.pos_cnum | Parsetree.Pctf_inher class_type -> class_type.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum in @@ -289,7 +324,7 @@ module Analyser = val_recursive = false ; val_parameters = Odoc_value.dummy_parameter_list subst_typ ; val_code = None ; - val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) }; + val_loc = { loc_impl = None ; loc_inter = Some loc }; } ; met_private = private_flag = Asttypes.Private ; met_virtual = false ; @@ -325,7 +360,11 @@ module Analyser = in ([], ele_comments) - | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _, loc) :: q -> + | item :: q -> + let loc = item.Parsetree.pctf_loc in + match item.Parsetree.pctf_desc with + + | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _) -> (* 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 @@ -345,7 +384,7 @@ module Analyser = val_recursive = false ; val_parameters = [] ; val_code = None ; - val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ; + val_loc = { loc_impl = None ; loc_inter = Some loc} ; } ; att_mutable = mutable_flag = Asttypes.Mutable ; att_virtual = virtual_flag = Asttypes.Virtual ; @@ -362,7 +401,7 @@ module Analyser = let (inher_l, eles) = f (pos_end + maybe_more) q in (inher_l, eles_comments @ ((Class_attribute att) :: eles)) - | Parsetree.Pctf_virt (name, private_flag, _, loc) :: q -> + | Parsetree.Pctf_virt (name, private_flag, _) -> (* of (string * private_flag * core_type * Location.t) *) let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in let (met, maybe_more) = get_method name comment_opt private_flag loc q in @@ -370,21 +409,21 @@ module Analyser = let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in (inher_l, eles_comments @ ((Class_method met2) :: eles)) - | Parsetree.Pctf_meth (name, private_flag, _, loc) :: q -> + | Parsetree.Pctf_meth (name, private_flag, _) -> (* of (string * private_flag * core_type * Location.t) *) let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in let (met, maybe_more) = get_method name comment_opt private_flag loc q in let (inher_l, eles) = f (loc.Location.loc_end.Lexing.pos_cnum + maybe_more) q in (inher_l, eles_comments @ ((Class_method met) :: eles)) - | (Parsetree.Pctf_cstr (_, _, loc)) :: q -> + | (Parsetree.Pctf_cstr (_, _)) -> (* of (core_type * core_type * Location.t) *) (* A VOIR : cela correspond aux contraintes, non ? on ne les garde pas pour l'instant *) 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 -> + | Parsetree.Pctf_inher class_type -> let loc = class_type.Parsetree.pcty_loc in let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum @@ -402,7 +441,7 @@ module Analyser = 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 name = Name.from_longident longident.txt in let ic = { ic_name = Odoc_env.full_class_or_class_type_name env name ; @@ -414,7 +453,7 @@ module Analyser = | Parsetree.Pcty_signature _ | Parsetree.Pcty_fun _ -> - (* we don't have a name for the class signature, so we call it "object ... end" *) + (* we don't have a name for the class signature, so we call it "object ... end" *) { ic_name = Odoc_messages.object_end ; ic_class = None ; @@ -459,6 +498,7 @@ module Analyser = signat table current_module_name + ele.Parsetree.psig_loc ele.Parsetree.psig_loc.Location.loc_start.Lexing.pos_cnum ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum (match q with @@ -481,15 +521,15 @@ 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 - pos_start_ele pos_end_ele pos_limit comment_opt sig_item_desc = + sig_item_loc 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 = - try Signature_search.search_value table name_pre + try Signature_search.search_value table name_pre.txt with Not_found -> - raise (Failure (Odoc_messages.value_not_found current_module_name name_pre)) + raise (Failure (Odoc_messages.value_not_found current_module_name name_pre.txt)) in - let name = Name.parens_if_infix name_pre in + let name = Name.parens_if_infix name_pre.txt in let subst_typ = Odoc_env.subst_type env type_expr in let v = { @@ -499,7 +539,7 @@ module Analyser = val_recursive = false ; 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)} + val_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; } in let (maybe_more, info_after_opt) = @@ -516,17 +556,17 @@ module Analyser = | Parsetree.Psig_exception (name, exception_decl) -> let types_excep_decl = - try Signature_search.search_exception table name + try Signature_search.search_exception table name.txt with Not_found -> - raise (Failure (Odoc_messages.exception_not_found current_module_name name)) + raise (Failure (Odoc_messages.exception_not_found current_module_name name.txt)) in let e = { - ex_name = Name.concat current_module_name name ; + ex_name = Name.concat current_module_name name.txt ; ex_info = comment_opt ; - ex_args = List.map (Odoc_env.subst_type env) types_excep_decl ; + ex_args = List.map (Odoc_env.subst_type env) types_excep_decl.exn_args ; ex_alias = None ; - ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; ex_code = ( if !Odoc_global.keep_code then @@ -550,7 +590,7 @@ module Analyser = let new_env = List.fold_left (fun acc_env -> fun (name, _) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in Odoc_env.add_type acc_env complete_name ) env @@ -572,7 +612,7 @@ module Analyser = let pos_limit2 = match q with [] -> pos_limit - | (_, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum + | ( _, td) :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in let (maybe_more, name_comment_list) = name_comment_from_type_kind @@ -580,14 +620,14 @@ module Analyser = pos_limit2 type_decl.Parsetree.ptype_kind in - print_DEBUG ("Type "^name^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)); + print_DEBUG ("Type "^name.txt^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)); 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 + try Signature_search.search_type table name.txt with Not_found -> - raise (Failure (Odoc_messages.type_not_found current_module_name name)) + raise (Failure (Odoc_messages.type_not_found current_module_name name.txt)) in (* get the type kind with the associated comments *) let type_kind = get_type_kind new_env name_comment_list sig_type_decl.Types.type_kind in @@ -596,7 +636,7 @@ module Analyser = (* associate the comments to each constructor and build the [Type.t_type] *) let new_type = { - ty_name = Name.concat current_module_name name ; + ty_name = Name.concat current_module_name name.txt ; ty_info = assoc_com ; ty_parameters = List.map2 (fun p (co,cn,_) -> @@ -611,10 +651,7 @@ module Analyser = (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 ; - loc_inter = Some (!file_name,loc_start) ; - }; + ty_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; ty_code = ( if !Odoc_global.keep_code then @@ -651,12 +688,12 @@ module Analyser = (0, env, ele_comments) | Parsetree.Psig_module (name, module_type) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in (* get the the module type in the signature by the module name *) let sig_module_type = - try Signature_search.search_module table name + try Signature_search.search_module table name.txt with Not_found -> - raise (Failure (Odoc_messages.module_not_found current_module_name name)) + raise (Failure (Odoc_messages.module_not_found current_module_name name.txt)) in let module_kind = analyse_module_kind env complete_name module_type sig_module_type in let code_intf = @@ -676,7 +713,7 @@ module Analyser = m_is_interface = true ; m_file = !file_name ; m_kind = module_kind ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + m_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; @@ -691,8 +728,8 @@ module Analyser = 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 = - 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 + match new_module.m_type with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s | _ -> new_env in (maybe_more, new_env2, [ Element_module new_module ]) @@ -701,7 +738,7 @@ module Analyser = (* we start by extending the environment *) let new_env = List.fold_left - (fun acc_env -> fun (name, _) -> + (fun acc_env -> fun ({ 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 *) @@ -711,8 +748,8 @@ module Analyser = 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 -> + (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *) + Types.Mty_signature s -> Odoc_env.add_signature e complete_name ~rel: name s | _ -> print_DEBUG "not a Tmty_signature"; @@ -726,9 +763,10 @@ module Analyser = [] -> (acc_maybe_more, []) | (name, modtype) :: q -> - let complete_name = Name.concat current_module_name name in - let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in - let loc_end = modtype.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let complete_name = Name.concat current_module_name name.txt in + let loc = modtype.Parsetree.pmty_loc in + let loc_start = loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = loc.Location.loc_end.Lexing.pos_cnum in let (assoc_com, ele_comments) = if first then (comment_opt, []) @@ -740,19 +778,18 @@ module Analyser = let pos_limit2 = match q with [] -> pos_limit - | (_, mty) :: _ -> mty.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum + | (_, mty) :: _ -> 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 + try Signature_search.search_module table name.txt with Not_found -> - raise (Failure (Odoc_messages.module_not_found current_module_name name)) + raise (Failure (Odoc_messages.module_not_found current_module_name name.txt)) 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 = if !Odoc_global.keep_code then - let loc = modtype.Parsetree.pmty_loc in let st = loc.Location.loc_start.Lexing.pos_cnum in let en = loc.Location.loc_end.Lexing.pos_cnum in Some (get_string_of_file st en) @@ -767,7 +804,7 @@ module Analyser = m_is_interface = true ; m_file = !file_name ; m_kind = module_kind ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + m_loc = { loc_impl = None ; loc_inter = Some loc } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; @@ -792,11 +829,11 @@ module Analyser = (maybe_more, new_env, mods) | Parsetree.Psig_modtype (name, pmodtype_decl) -> - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let sig_mtype = - try Signature_search.search_module_type table name + try Signature_search.search_module_type table name.txt with Not_found -> - raise (Failure (Odoc_messages.module_type_not_found current_module_name name)) + raise (Failure (Odoc_messages.module_type_not_found current_module_name name.txt)) in let module_type_kind = match pmodtype_decl with @@ -815,7 +852,7 @@ module Analyser = mt_is_interface = true ; mt_file = !file_name ; mt_kind = module_type_kind ; - mt_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + mt_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; } in let (maybe_more, info_after_opt) = @@ -826,8 +863,8 @@ module Analyser = mt.mt_info <- merge_infos mt.mt_info info_after_opt ; let new_env = Odoc_env.add_module_type env mt.mt_name in let new_env2 = - match sig_mtype with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) - Some (Types.Tmty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s + match sig_mtype with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *) + Some (Types.Mty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s | _ -> new_env in (maybe_more, new_env2, [ Element_module_type mt ]) @@ -835,7 +872,7 @@ module Analyser = | Parsetree.Psig_include module_type -> let rec f = function Parsetree.Pmty_ident longident -> - Name.from_longident longident + Name.from_longident longident.txt | Parsetree.Pmty_signature _ -> "??" | Parsetree.Pmty_functor _ -> @@ -844,7 +881,7 @@ module Analyser = f mt.Parsetree.pmty_desc | Parsetree.Pmty_typeof mexpr -> match mexpr.Parsetree.pmod_desc with - Parsetree.Pmod_ident longident -> Name.from_longident longident + Parsetree.Pmod_ident longident -> Name.from_longident longident.txt | _ -> "??" in let name = f module_type.Parsetree.pmty_desc in @@ -856,14 +893,14 @@ module Analyser = im_info = comment_opt; } in - (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *) + (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 (fun acc_env -> fun class_desc -> - let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name in + let complete_name = Name.concat current_module_name class_desc.Parsetree.pci_name.txt in Odoc_env.add_class acc_env complete_name ) env @@ -889,11 +926,11 @@ module Analyser = | cd :: _ -> cd.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum in let name = class_desc.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let sig_class_decl = - try Signature_search.search_class table name + try Signature_search.search_class table name.txt with Not_found -> - raise (Failure (Odoc_messages.class_not_found current_module_name name)) + raise (Failure (Odoc_messages.class_not_found current_module_name name.txt)) in let sig_class_type = sig_class_decl.Types.cty_type in let (parameters, class_kind) = @@ -913,7 +950,7 @@ module Analyser = cl_virtual = class_desc.Parsetree.pci_virt = Asttypes.Virtual ; cl_kind = class_kind ; cl_parameters = parameters ; - cl_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; + cl_loc = { loc_impl = None ; loc_inter = Some class_desc.Parsetree.pci_loc } ; } in let (maybe_more, info_after_opt) = @@ -939,7 +976,7 @@ module Analyser = let new_env = 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 + let complete_name = Name.concat current_module_name class_type_decl.Parsetree.pci_name.txt in Odoc_env.add_class_type acc_env complete_name ) env @@ -965,11 +1002,11 @@ module Analyser = | ct_decl2 :: _ -> ct_decl2.Parsetree.pci_loc.Location.loc_start.Lexing.pos_cnum in let name = ct_decl.Parsetree.pci_name in - let complete_name = Name.concat current_module_name name in + let complete_name = Name.concat current_module_name name.txt in let sig_cltype_decl = - try Signature_search.search_class_type table name + try Signature_search.search_class_type table name.txt with Not_found -> - raise (Failure (Odoc_messages.class_type_not_found current_module_name name)) + raise (Failure (Odoc_messages.class_type_not_found current_module_name name.txt)) in let sig_class_type = sig_cltype_decl.Types.clty_type in let kind = analyse_class_type_kind @@ -987,7 +1024,7 @@ module Analyser = clt_type_parameters = sig_cltype_decl.clty_params ; 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) } ; + clt_loc = { loc_impl = None ; loc_inter = Some ct_decl.Parsetree.pci_loc } ; } in let (maybe_more, info_after_opt) = @@ -1008,13 +1045,14 @@ module Analyser = (maybe_more, new_env, eles) (** Return a module_type_kind from a Parsetree.module_type and a Types.module_type *) - and analyse_module_type_kind env current_module_name module_type sig_module_type = + and analyse_module_type_kind + ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type = match module_type.Parsetree.pmty_desc with Parsetree.Pmty_ident longident -> let name = match sig_module_type with - Types.Tmty_ident path -> Name.from_path path - | _ -> Name.from_longident longident + Types.Mty_ident path -> Name.from_path path + | _ -> Name.from_longident longident.txt (* 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 ; @@ -1022,25 +1060,26 @@ module Analyser = | Parsetree.Pmty_signature ast -> ( + let ast = filter_out_erased_items_from_signature erased ast in (* we must have a signature in the module type *) match sig_module_type with - Types.Tmty_signature signat -> + Types.Mty_signature signat -> let pos_start = module_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in let pos_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let elements = analyse_parsetree env signat current_module_name pos_start pos_end ast in Module_type_struct elements | _ -> - raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat") + raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat") ) - | Parsetree.Pmty_functor (_,pmodule_type2, 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) -> + Types.Mty_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 @@ -1052,7 +1091,7 @@ module Analyser = mp_kind = mp_kind ; } in - let k = analyse_module_type_kind env + let k = analyse_module_type_kind ~erased env current_module_name module_type2 body_module_type @@ -1061,16 +1100,18 @@ module Analyser = | _ -> (* if we're here something's wrong *) - raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _") + raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _") ) - | Parsetree.Pmty_with (module_type2, _) -> + | Parsetree.Pmty_with (module_type2, constraints) -> (* of module_type * (Longident.t * with_constraint) list *) ( let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let s = get_string_of_file loc_start loc_end in - let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + let erased = erased_names_of_constraints constraints erased in + let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in + Module_type_with (k, s) ) @@ -1081,7 +1122,8 @@ module Analyser = Module_type_typeof s (** analyse of a Parsetree.module_type and a Types.module_type.*) - and analyse_module_kind env current_module_name module_type sig_module_type = + and analyse_module_kind + ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type = match module_type.Parsetree.pmty_desc with Parsetree.Pmty_ident longident -> let k = analyse_module_type_kind env current_module_name module_type sig_module_type in @@ -1089,8 +1131,9 @@ module Analyser = | Parsetree.Pmty_signature signature -> ( + let signature = filter_out_erased_items_from_signature erased signature in match sig_module_type with - Types.Tmty_signature signat -> + Types.Mty_signature signat -> Module_struct (analyse_parsetree env @@ -1102,12 +1145,12 @@ module Analyser = ) | _ -> (* if we're here something's wrong *) - raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat") + 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 (_, 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) -> + Types.Mty_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 @@ -1123,7 +1166,7 @@ module Analyser = mp_kind = mp_kind ; } in - let k = analyse_module_kind env + let k = analyse_module_kind ~erased env current_module_name module_type2 body_module_type @@ -1132,15 +1175,16 @@ module Analyser = | _ -> (* if we're here something's wrong *) - raise (Failure "Parsetree.Pmty_functor _ but not Types.Tmty_functor _") + raise (Failure "Parsetree.Pmty_functor _ but not Types.Mty_functor _") ) - | Parsetree.Pmty_with (module_type2, _) -> + | Parsetree.Pmty_with (module_type2, constraints) -> (*of module_type * (Longident.t * with_constraint) list*) ( let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let s = get_string_of_file loc_start loc_end in - let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + let erased = erased_names_of_constraints constraints erased in + let k = analyse_module_type_kind ~erased env current_module_name module_type2 sig_module_type in Module_with (k, s) ) | Parsetree.Pmty_typeof module_expr -> @@ -1154,8 +1198,8 @@ module Analyser = and analyse_class_kind env current_class_name last_pos parse_class_type sig_class_type = match parse_class_type.Parsetree.pcty_desc, sig_class_type with (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 _"; + Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> + print_DEBUG "Cty_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 = @@ -1168,7 +1212,7 @@ module Analyser = in ([], k) - | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) -> + | (Parsetree.Pcty_signature { Parsetree.pcsig_fields = class_type_field_list }, Types.Cty_signature class_signature) -> (* 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 @@ -1178,8 +1222,8 @@ module Analyser = in ([], Class_structure (inher_l, ele)) - | (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 *) + | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) -> + (* label = string. Dans les signatures, pas de nom de parametres a l'interieur 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 ( @@ -1195,7 +1239,7 @@ module Analyser = ) else ( - raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents") + raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels différents") ) | _ -> @@ -1205,8 +1249,8 @@ module Analyser = and analyse_class_type_kind env current_class_name last_pos parse_class_type sig_class_type = match parse_class_type.Parsetree.pcty_desc, sig_class_type with (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 _"; + Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> + print_DEBUG "Cty_constr _"; let k = Class_type { @@ -1217,7 +1261,9 @@ module Analyser = in k - | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) -> + | (Parsetree.Pcty_signature { + Parsetree.pcsig_fields = class_type_field_list; + }, Types.Cty_signature class_signature) -> (* 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 @@ -1227,11 +1273,11 @@ module Analyser = in Class_signature (inher_l, ele) - | (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_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) -> + raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Cty_fun (...)") (* | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *), - Types.Tcty_signature class_signature) -> + Types.Cty_signature class_signature) -> (* A VOIR : c'est pour le cas des contraintes de classes : class type cons = object method m : int @@ -1290,12 +1336,12 @@ module Analyser = in { m_name = mod_name ; - m_type = Types.Tmty_signature signat ; + m_type = Types.Mty_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_loc = { loc_impl = None ; loc_inter = Some (Location.in_file !file_name) } ; m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli index 65ee128fc5..766994d717 100644 --- a/ocamldoc/odoc_sig.mli +++ b/ocamldoc/odoc_sig.mli @@ -46,7 +46,7 @@ module Signature_search : (** This function returns the Types.cltype_declaration for the class type whose name is given, in the given table. @raise Not_found if error.*) - val search_class_type : tab -> string -> Types.cltype_declaration + val search_class_type : tab -> string -> Types.class_type_declaration (** This function returns the Types.module_type for the module whose name is given, in the given table. @@ -156,7 +156,7 @@ module Analyser : (** 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 -> + ?erased:Odoc_name.Set.t -> Odoc_env.env -> Odoc_name.t -> Parsetree.module_type -> Types.module_type -> Odoc_module.module_type_kind diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml index d420c05971..0360e3f0e6 100644 --- a/ocamldoc/odoc_str.ml +++ b/ocamldoc/odoc_str.ml @@ -126,7 +126,7 @@ let string_of_class_type_param_list l = let string_of_class_params c = let b = Buffer.create 256 in let rec iter = function - Types.Tcty_fun (label, t, ctype) -> + Types.Cty_fun (label, t, ctype) -> let parent = is_arrow_type t in Printf.bprintf b "%s%s%s%s -> " ( @@ -144,8 +144,8 @@ let string_of_class_params c = ) (if parent then ")" else ""); iter ctype - | Types.Tcty_signature _ - | Types.Tcty_constr _ -> () + | Types.Cty_signature _ + | Types.Cty_constr _ -> () in iter c.Odoc_class.cl_type; Buffer.contents b diff --git a/ocamldoc/odoc_test.ml b/ocamldoc/odoc_test.ml index 7b455f45bf..a903b1c151 100644 --- a/ocamldoc/odoc_test.ml +++ b/ocamldoc/odoc_test.ml @@ -22,12 +22,13 @@ type test_kind = let p = Format.fprintf -module Generator = +module Generator (G : Odoc_gen.Base) = struct -class string_gen = + class string_gen = object(self) inherit Odoc_info.Scan.scanner + val mutable test_kinds = [] val mutable fmt = Format.str_formatter @@ -111,8 +112,12 @@ class string_gen = class generator = let g = new string_gen in object - method generate = g#generate + inherit G.generator as base + + method generate l = + base#generate l; + g#generate l end end;; -let _ = Odoc_args.set_generator (Odoc_gen.Other (module Generator : Odoc_gen.Base)) +let _ = Odoc_args.extend_base_generator (module Generator : Odoc_gen.Base_functor);; diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml index 5c75b4fdfa..eeb4d9e239 100644 --- a/ocamldoc/odoc_texi.ml +++ b/ocamldoc/odoc_texi.ml @@ -149,23 +149,23 @@ struct ] @ (if !esc_8bits then [ - (Str.regexp "à", "@`a") ; - (Str.regexp "â", "@^a") ; - (Str.regexp "é", "@'e") ; - (Str.regexp "è", "@`e") ; - (Str.regexp "ê", "@^e") ; - (Str.regexp "ë", "@\"e") ; - (Str.regexp "ç", "@,{c}") ; - (Str.regexp "ô", "@^o") ; - (Str.regexp "ö", "@\"o") ; - (Str.regexp "î", "@^i") ; - (Str.regexp "ï", "@\"i") ; - (Str.regexp "ù", "@`u") ; - (Str.regexp "û", "@^u") ; - (Str.regexp "æ", "@ae{}" ) ; - (Str.regexp "Æ", "@AE{}" ) ; - (Str.regexp "ß", "@ss{}" ) ; - (Str.regexp "©", "@copyright{}" ) ; + (Str.regexp "\xE0", "@`a") ; + (Str.regexp "\xE2", "@^a") ; + (Str.regexp "\xE9", "@'e") ; + (Str.regexp "\xE8", "@`e") ; + (Str.regexp "\xEA", "@^e") ; + (Str.regexp "\xEB", "@\"e") ; + (Str.regexp "\xF7", "@,{c}") ; + (Str.regexp "\xF4", "@^o") ; + (Str.regexp "\xF6", "@\"o") ; + (Str.regexp "\xEE", "@^i") ; + (Str.regexp "\xEF", "@\"i") ; + (Str.regexp "\xF9", "@`u") ; + (Str.regexp "\xFB", "@^u") ; + (Str.regexp "\xE6", "@ae{}" ) ; + (Str.regexp "\xC6", "@AE{}" ) ; + (Str.regexp "\xDF", "@ss{}" ) ; + (Str.regexp "\xA9", "@copyright{}" ) ; ] else []) @@ -640,13 +640,13 @@ class texi = Printf.sprintf "(%s) " (String.concat ", " (List.map f l)) - method string_of_type_args (args:Types.type_expr list) (ret:Types.type_expr option) = + method string_of_type_args (args:Types.type_expr list) (ret:Types.type_expr option) = match args, ret with | [], None -> "" | args, None -> " of " ^ (Odoc_info.string_of_type_list " * " args) | [], Some r -> " : " ^ (Odoc_info.string_of_type_expr r) - | args, Some r -> " : " ^ (Odoc_info.string_of_type_list " * " args) ^ - " -> " ^ (Odoc_info.string_of_type_expr r) + | args, Some r -> " : " ^ (Odoc_info.string_of_type_list " * " args) ^ + " -> " ^ (Odoc_info.string_of_type_expr r) (** Return Texinfo code for a type. *) method texi_of_type ty = diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml index b50a2dbd17..e80b680ed4 100644 --- a/ocamldoc/odoc_text.ml +++ b/ocamldoc/odoc_text.ml @@ -133,6 +133,8 @@ module Texter = | RK_attribute -> "attribute" | RK_method -> "method" | RK_section _ -> "section" + | RK_recfield -> "recfield" + | RK_const -> "const" in s^":" ) diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll index f229f08a66..4c92834f41 100644 --- a/ocamldoc/odoc_text_lexer.mll +++ b/ocamldoc/odoc_text_lexer.mll @@ -22,10 +22,10 @@ let char_number = ref 0 let string_buffer = Buffer.create 32 -(** Fonction de remise à zéro de la chaine de caractères tampon *) +(** Fonction de remise a zero de la chaine de caracteres tampon *) let reset_string_buffer () = Buffer.reset string_buffer -(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *) +(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *) let ajout_char_string = Buffer.add_char string_buffer (** Add a string to the buffer. *) @@ -161,6 +161,8 @@ let begin_clt_ref = "{!classtype:"blank_nl | "{!classtype:" let begin_att_ref = "{!attribute:"blank_nl | "{!attribute:" let begin_met_ref = "{!method:"blank_nl | "{!method:" let begin_sec_ref = "{!section:"blank_nl | "{!section:" +let begin_recf_ref = "{!recfield:"blank_nl | "{!recfield:" +let begin_const_ref = "{!const:"blank_nl | "{!const:" let begin_mod_list_ref = "{!modules:"blank_nl | "{!modules:" let index_list = "{!indexlist}" let begin_custom = "{"['a'-'z''A'-'Z']['a'-'z''A'-'Z''0'-'9']* @@ -664,7 +666,38 @@ rule main = parse Char (Lexing.lexeme lexbuf) ) } - +| begin_recf_ref + { + incr_cpts lexbuf ; + if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then + Char (Lexing.lexeme lexbuf) + else + if not !ele_ref_mode then + ( + ele_ref_mode := true; + RECF_REF + ) + else + ( + Char (Lexing.lexeme lexbuf) + ) + } +| begin_const_ref + { + incr_cpts lexbuf ; + if !verb_mode or !target_mode or !code_pre_mode or !open_brackets >= 1 then + Char (Lexing.lexeme lexbuf) + else + if not !ele_ref_mode then + ( + ele_ref_mode := true; + CONST_REF + ) + else + ( + Char (Lexing.lexeme lexbuf) + ) + } | begin_mod_list_ref { incr_cpts lexbuf ; @@ -720,7 +753,10 @@ rule main = parse | shortcut_list_item { incr_cpts lexbuf ; - if !shortcut_list_mode then + if !target_mode || (!open_brackets >= 1) || !code_pre_mode + || !ele_ref_mode || !verb_mode then + Char (Lexing.lexeme lexbuf) + else if !shortcut_list_mode then ( SHORTCUT_LIST_ITEM ) @@ -734,7 +770,10 @@ rule main = parse | shortcut_enum_item { incr_cpts lexbuf ; - if !shortcut_list_mode then + if !target_mode || (!open_brackets >= 1) || !code_pre_mode + || !ele_ref_mode || !verb_mode then + Char (Lexing.lexeme lexbuf) + else if !shortcut_list_mode then SHORTCUT_ENUM_ITEM else ( diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly index 478cfa074e..6efc32f54d 100644 --- a/ocamldoc/odoc_text_parser.mly +++ b/ocamldoc/odoc_text_parser.mly @@ -62,6 +62,8 @@ let print_DEBUG s = print_string s; print_newline () %token ATT_REF %token MET_REF %token SEC_REF +%token RECF_REF +%token CONST_REF %token MOD_LIST_REF %token INDEX_LIST @@ -80,8 +82,9 @@ let print_DEBUG s = print_string s; print_newline () %token <string> Char /* Start Symbols */ -%start main +%start main located_element_list %type <Odoc_types.text> main +%type <(int * int * Odoc_types.text_element) list> located_element_list %% main: @@ -98,6 +101,16 @@ text_element_list: | text_element text_element_list { $1 :: $2 } ; +located_element_list: + located_element { [ $1 ] } +| located_element located_element_list { $1 :: $2 } +; + +located_element: + text_element { Parsing.symbol_start (), Parsing.symbol_end (), $1} +; + + ele_ref_kind: ELE_REF { None } | VAL_REF { Some RK_value } @@ -110,6 +123,8 @@ ele_ref_kind: | ATT_REF { Some RK_attribute } | MET_REF { Some RK_method } | SEC_REF { Some (RK_section [])} +| RECF_REF { Some RK_recfield } +| CONST_REF { Some RK_const } ; text_element: diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml index 53a1ca5f9c..d1ae70ef2d 100644 --- a/ocamldoc/odoc_types.ml +++ b/ocamldoc/odoc_types.ml @@ -22,6 +22,8 @@ type ref_kind = | RK_attribute | RK_method | RK_section of text + | RK_recfield + | RK_const and text_element = | Raw of string @@ -91,8 +93,8 @@ let dummy_info = { } type location = { - loc_impl : (string * int) option ; - loc_inter : (string * int) option ; + loc_impl : Location.t option ; + loc_inter : Location.t option ; } let dummy_loc = { loc_impl = None ; loc_inter = None } diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli index d4affb5039..f6eca5d96c 100644 --- a/ocamldoc/odoc_types.mli +++ b/ocamldoc/odoc_types.mli @@ -25,6 +25,8 @@ type ref_kind = | RK_attribute | RK_method | RK_section of text + | RK_recfield + | RK_const and text_element = | Raw of string (** Raw text. *) @@ -94,8 +96,8 @@ val dummy_info : info (** Location of elements in implementation and interface files. *) type location = { - loc_impl : (string * int) option ; (** implementation file name and position *) - loc_inter : (string * int) option ; (** interface file name and position *) + loc_impl : Location.t option ; (** implementation location *) + loc_inter : Location.t option ; (** interface location *) } (** A dummy location. *) |