Cherry-pick 15062,15063,15064 from 4.02 (#6497).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15068 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2014-08-07 09:46:34 +00:00
parent cc9cbfc755
commit 047e09748c
25 changed files with 323 additions and 113 deletions

134
.depend
View File

@ -44,11 +44,13 @@ parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \
parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \
parsing/location.cmx parsing/asttypes.cmi parsing/ast_helper.cmi
parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \
parsing/location.cmi utils/config.cmi parsing/asttypes.cmi \
parsing/ast_helper.cmi parsing/ast_mapper.cmi
parsing/longident.cmi parsing/location.cmi utils/config.cmi \
utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
parsing/ast_mapper.cmi
parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \
parsing/location.cmx utils/config.cmx parsing/asttypes.cmi \
parsing/ast_helper.cmx parsing/ast_mapper.cmi
parsing/longident.cmx parsing/location.cmx utils/config.cmx \
utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
parsing/ast_mapper.cmi
parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
parsing/location.cmi parsing/lexer.cmi
parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \
@ -207,15 +209,17 @@ typing/includecore.cmx : typing/types.cmx typing/typedtree.cmx \
typing/env.cmx typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/includecore.cmi
typing/includemod.cmo : typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \
typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \
utils/misc.cmi parsing/location.cmi typing/includecore.cmi \
typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
typing/cmt_format.cmi utils/clflags.cmi typing/includemod.cmi
typing/subst.cmi typing/printtyp.cmi typing/primitive.cmi typing/path.cmi \
typing/mtype.cmi utils/misc.cmi parsing/location.cmi \
typing/includecore.cmi typing/includeclass.cmi typing/ident.cmi \
typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi utils/clflags.cmi \
typing/includemod.cmi
typing/includemod.cmx : typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \
typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \
utils/misc.cmx parsing/location.cmx typing/includecore.cmx \
typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
typing/cmt_format.cmx utils/clflags.cmx typing/includemod.cmi
typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx typing/path.cmx \
typing/mtype.cmx utils/misc.cmx parsing/location.cmx \
typing/includecore.cmx typing/includeclass.cmx typing/ident.cmx \
typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx utils/clflags.cmx \
typing/includemod.cmi
typing/mtype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \
utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \
typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
@ -278,8 +282,8 @@ typing/subst.cmx : typing/types.cmx utils/tbl.cmx typing/path.cmx \
typing/btype.cmx parsing/ast_mapper.cmx typing/subst.cmi
typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \
typing/printtyp.cmi typing/predef.cmi typing/path.cmi \
typing/typecore.cmi parsing/syntaxerr.cmi typing/subst.cmi \
typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi typing/path.cmi \
parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
@ -287,43 +291,43 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
parsing/ast_helper.cmi typing/typeclass.cmi
typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \
typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \
typing/printtyp.cmx typing/predef.cmx typing/path.cmx \
typing/typecore.cmx parsing/syntaxerr.cmx typing/subst.cmx \
typing/stypes.cmx typing/printtyp.cmx typing/predef.cmx typing/path.cmx \
parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
parsing/ast_helper.cmx typing/typeclass.cmi
typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \
typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
typing/cmt_format.cmi utils/clflags.cmi typing/btype.cmi \
parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \
typing/typecore.cmi
typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
typing/primitive.cmi typing/predef.cmi typing/path.cmi \
parsing/parsetree.cmi typing/parmatch.cmi typing/oprint.cmi \
utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
parsing/ast_helper.cmi typing/annot.cmi typing/typecore.cmi
typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \
typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \
typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
typing/cmt_format.cmx utils/clflags.cmx typing/btype.cmx \
parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \
typing/typecore.cmi
typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \
typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
typing/primitive.cmx typing/predef.cmx typing/path.cmx \
parsing/parsetree.cmi typing/parmatch.cmx typing/oprint.cmx \
utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
parsing/ast_helper.cmx typing/annot.cmi typing/typecore.cmi
typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi typing/subst.cmi \
typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \
typing/subst.cmi typing/printtyp.cmi typing/primitive.cmi \
typing/predef.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
parsing/ast_helper.cmi typing/typedecl.cmi
typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/types.cmx typing/typedtree.cmx typing/subst.cmx \
typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \
typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx \
typing/predef.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
@ -369,17 +373,17 @@ typing/types.cmx : typing/primitive.cmx typing/path.cmx \
parsing/parsetree.cmi parsing/longident.cmx parsing/location.cmx \
typing/ident.cmx parsing/asttypes.cmi typing/types.cmi
typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \
typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/path.cmi \
parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
typing/btype.cmi parsing/asttypes.cmi parsing/ast_mapper.cmi \
parsing/ast_helper.cmi typing/typetexp.cmi
typing/typedtree.cmi utils/tbl.cmi parsing/syntaxerr.cmi \
typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/env.cmi \
typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
parsing/ast_mapper.cmi parsing/ast_helper.cmi typing/typetexp.cmi
typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \
typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/path.cmx \
parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \
typing/btype.cmx parsing/asttypes.cmi parsing/ast_mapper.cmx \
parsing/ast_helper.cmx typing/typetexp.cmi
typing/typedtree.cmx utils/tbl.cmx parsing/syntaxerr.cmx \
typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/env.cmx \
typing/ctype.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
parsing/ast_mapper.cmx parsing/ast_helper.cmx typing/typetexp.cmi
bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi
bytecomp/bytelibrarian.cmi :
bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi
@ -860,7 +864,8 @@ driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \
parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \
utils/misc.cmi parsing/location.cmi typing/includemod.cmi typing/env.cmi \
bytecomp/emitcode.cmi driver/compmisc.cmi driver/compenv.cmi \
utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi
utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi \
parsing/ast_mapper.cmi driver/compile.cmi
driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@ -868,7 +873,8 @@ driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \
utils/misc.cmx parsing/location.cmx typing/includemod.cmx typing/env.cmx \
bytecomp/emitcode.cmx driver/compmisc.cmx driver/compenv.cmx \
utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx \
parsing/ast_mapper.cmx driver/compile.cmi
driver/compmisc.cmo : typing/typemod.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
typing/env.cmi utils/config.cmi driver/compenv.cmi utils/clflags.cmi \
@ -898,7 +904,8 @@ driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \
parsing/pprintast.cmi driver/pparse.cmi utils/misc.cmi \
typing/includemod.cmi typing/env.cmi utils/config.cmi driver/compmisc.cmi \
asmcomp/compilenv.cmi driver/compenv.cmi utils/clflags.cmi \
utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi
utils/ccomp.cmi parsing/ast_mapper.cmi asmcomp/asmgen.cmi \
driver/optcompile.cmi
driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@ -906,7 +913,8 @@ driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
parsing/pprintast.cmx driver/pparse.cmx utils/misc.cmx \
typing/includemod.cmx typing/env.cmx utils/config.cmx driver/compmisc.cmx \
asmcomp/compilenv.cmx driver/compenv.cmx utils/clflags.cmx \
utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
utils/ccomp.cmx parsing/ast_mapper.cmx asmcomp/asmgen.cmx \
driver/optcompile.cmi
driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi
driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi
driver/optmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
@ -921,10 +929,14 @@ driver/optmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
driver/compenv.cmx utils/clflags.cmx asmcomp/asmpackager.cmx \
asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx asmcomp/arch.cmx \
driver/optmain.cmi
driver/pparse.cmo : parsing/parse.cmi utils/misc.cmi parsing/location.cmi \
utils/config.cmi utils/clflags.cmi utils/ccomp.cmi driver/pparse.cmi
driver/pparse.cmx : parsing/parse.cmx utils/misc.cmx parsing/location.cmx \
utils/config.cmx utils/clflags.cmx utils/ccomp.cmx driver/pparse.cmi
driver/pparse.cmo : parsing/parsetree.cmi parsing/parse.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi utils/config.cmi \
utils/clflags.cmi utils/ccomp.cmi parsing/asttypes.cmi \
parsing/ast_mapper.cmi parsing/ast_helper.cmi driver/pparse.cmi
driver/pparse.cmx : parsing/parsetree.cmi parsing/parse.cmx utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx utils/config.cmx \
utils/clflags.cmx utils/ccomp.cmx parsing/asttypes.cmi \
parsing/ast_mapper.cmx parsing/ast_helper.cmx driver/pparse.cmi
toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \
typing/outcometree.cmi typing/env.cmi
toplevel/opttopdirs.cmi : parsing/longident.cmi
@ -988,11 +1000,13 @@ toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \
toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
toplevel/opttoploop.cmi toplevel/opttopdirs.cmi utils/misc.cmi \
driver/main_args.cmi parsing/location.cmi utils/config.cmi \
driver/compenv.cmi utils/clflags.cmi toplevel/opttopmain.cmi
driver/compenv.cmi utils/clflags.cmi parsing/ast_mapper.cmi \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
toplevel/opttoploop.cmx toplevel/opttopdirs.cmx utils/misc.cmx \
driver/main_args.cmx parsing/location.cmx utils/config.cmx \
driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi
driver/compenv.cmx utils/clflags.cmx parsing/ast_mapper.cmx \
toplevel/opttopmain.cmi
toplevel/opttopstart.cmo : toplevel/opttopmain.cmi
toplevel/opttopstart.cmx : toplevel/opttopmain.cmx
toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.cmi \
@ -1042,11 +1056,11 @@ toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \
toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \
toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \
parsing/location.cmi utils/config.cmi driver/compenv.cmi \
utils/clflags.cmi toplevel/topmain.cmi
utils/clflags.cmi parsing/ast_mapper.cmi toplevel/topmain.cmi
toplevel/topmain.cmx : utils/warnings.cmx toplevel/toploop.cmx \
toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \
parsing/location.cmx utils/config.cmx driver/compenv.cmx \
utils/clflags.cmx toplevel/topmain.cmi
utils/clflags.cmx parsing/ast_mapper.cmx toplevel/topmain.cmi
toplevel/topstart.cmo : toplevel/topmain.cmi
toplevel/topstart.cmx : toplevel/topmain.cmx
toplevel/trace.cmo : typing/types.cmi toplevel/toploop.cmi \

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -21,12 +21,14 @@ open Compenv
(* Keep in sync with the copy in optcompile.ml *)
let tool_name = "ocamlc"
let interface ppf sourcefile outputprefix =
Compmisc.init_path false;
let modulename = module_of_filename ppf sourcefile outputprefix in
Env.set_unit_name modulename;
let initial_env = Compmisc.initial_env () in
let ast = Pparse.parse_interface ppf sourcefile in
let ast = Pparse.parse_interface ~tool_name ppf sourcefile in
if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast;
let tsg = Typemod.type_interface initial_env ast in
@ -70,7 +72,7 @@ let implementation ppf sourcefile outputprefix =
Warnings.check_fatal ();
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try comp (Pparse.parse_implementation ppf sourcefile)
try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
with x ->
Stypes.dump (Some (outputprefix ^ ".annot"));
raise x
@ -95,7 +97,7 @@ let implementation ppf sourcefile outputprefix =
close_out oc;
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try comp (Pparse.parse_implementation ppf sourcefile)
try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
with x ->
close_out oc;
remove_file objfile;

View File

@ -57,4 +57,4 @@ let initial_env () =
in
List.fold_left (fun env m ->
open_implicit_module m env
) env (!implicit_modules @ List.rev !Clflags.open_module)
) env (!implicit_modules @ List.rev !Clflags.open_modules)

View File

@ -85,6 +85,7 @@ module Options = Main_args.Make_bytecomp_options (struct
let _custom = set custom_runtime
let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs
let _dllpath s = dllpaths := !dllpaths @ [s]
let _for_pack s = for_package := Some s
let _g = set debug
let _i () = print_types := true; compile_only := true
let _I s = include_dirs := s :: !include_dirs
@ -103,7 +104,7 @@ module Options = Main_args.Make_bytecomp_options (struct
let _noautolink = set no_auto_link
let _nostdlib = set no_std_include
let _o s = output_name := Some s
let _open s = open_module := s :: !open_module
let _open s = open_modules := s :: !open_modules
let _output_obj () = output_c_object := true; custom_runtime := true
let _pack = set make_package
let _pp s = preprocessor := Some s

View File

@ -73,9 +73,10 @@ let mk_dtypes f =
"-dtypes", Arg.Unit f, " (deprecated) same as -annot"
;;
let mk_for_pack_byt () =
"-for-pack", Arg.String ignore,
"<ident> Ignored (for compatibility with ocamlopt)"
let mk_for_pack_byt f =
"-for-pack", Arg.String f,
"<ident> Generate code that can later be `packed' with\n\
\ ocamlc -pack -o <ident>.cmo"
;;
let mk_for_pack_opt f =
@ -492,6 +493,7 @@ module type Compiler_options = sig
val _cclib : string -> unit
val _ccopt : string -> unit
val _config : unit -> unit
val _for_pack : string -> unit
val _g : unit -> unit
val _i : unit -> unit
val _impl : string -> unit
@ -570,7 +572,6 @@ module type Optcomp_options = sig
include Common_options
include Compiler_options
include Optcommon_options
val _for_pack : string -> unit
val _no_float_const_prop : unit -> unit
val _nodynlink : unit -> unit
val _p : unit -> unit
@ -611,7 +612,7 @@ struct
mk_dllib F._dllib;
mk_dllpath F._dllpath;
mk_dtypes F._annot;
mk_for_pack_byt ();
mk_for_pack_byt F._for_pack;
mk_g_byt F._g;
mk_i F._i;
mk_I F._I;

View File

@ -52,6 +52,7 @@ module type Compiler_options = sig
val _cclib : string -> unit
val _ccopt : string -> unit
val _config : unit -> unit
val _for_pack : string -> unit
val _g : unit -> unit
val _i : unit -> unit
val _impl : string -> unit
@ -130,7 +131,6 @@ module type Optcomp_options = sig
include Common_options
include Compiler_options
include Optcommon_options
val _for_pack : string -> unit
val _no_float_const_prop : unit -> unit
val _nodynlink : unit -> unit
val _p : unit -> unit

View File

@ -22,12 +22,14 @@ open Compenv
(* Keep in sync with the copy in compile.ml *)
let tool_name = "ocamlopt"
let interface ppf sourcefile outputprefix =
Compmisc.init_path false;
let modulename = module_of_filename ppf sourcefile outputprefix in
Env.set_unit_name modulename;
let initial_env = Compmisc.initial_env () in
let ast = Pparse.parse_interface ppf sourcefile in
let ast = Pparse.parse_interface ~tool_name ppf sourcefile in
if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast;
let tsg = Typemod.type_interface initial_env ast in
@ -90,7 +92,7 @@ let implementation ppf sourcefile outputprefix =
Warnings.check_fatal ();
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try comp (Pparse.parse_implementation ppf sourcefile)
try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
with x ->
Stypes.dump (Some (outputprefix ^ ".annot"));
remove_file objfile;

View File

@ -102,7 +102,7 @@ module Options = Main_args.Make_optcomp_options (struct
let _nolabels = set classic
let _nostdlib = set no_std_include
let _o s = output_name := Some s
let _open s = open_module := s :: !open_module
let _open s = open_modules := s :: !open_modules
let _output_obj = set output_c_object
let _p = set gprofile
let _pack = set make_package

View File

@ -87,21 +87,47 @@ let read_ast magic fn =
Misc.remove_file fn;
raise exn
let apply_rewriters magic ast =
let apply_rewriters ~tool_name magic ast =
let ctx = Ast_mapper.ppx_context ~tool_name () in
match !Clflags.all_ppx with
| [] -> ast
| ppxs ->
let ast =
if magic = Config.ast_impl_magic_number
then Obj.magic (Ast_helper.Str.attribute ctx :: (Obj.magic ast))
else Obj.magic (Ast_helper.Sig.attribute ctx :: (Obj.magic ast))
in
let fn =
List.fold_left (apply_rewriter magic) (write_ast magic ast)
(List.rev ppxs)
in
read_ast magic fn
let ast = read_ast magic fn in
let open Parsetree in
if magic = Config.ast_impl_magic_number then
let ast =
match Obj.magic ast with
| {pstr_desc = Pstr_attribute({Location.txt = "ocaml.ppx.context"}, _)}
:: items ->
items
| items -> items
in
Obj.magic ast
else
let ast =
match Obj.magic ast with
| {psig_desc = Psig_attribute({Location.txt = "ocaml.ppx.context"}, _)}
:: items ->
items
| items -> items
in
Obj.magic ast
(* Parse a file or get a dumped syntax tree from it *)
exception Outdated_version
let file ppf inputfile parse_fun ast_magic =
let file ppf ~tool_name inputfile parse_fun ast_magic =
let ic = open_in_bin inputfile in
let is_ast_file =
try
@ -134,7 +160,7 @@ let file ppf inputfile parse_fun ast_magic =
with x -> close_in ic; raise x
in
close_in ic;
apply_rewriters ast_magic ast
apply_rewriters ~tool_name ast_magic ast
let report_error ppf = function
| CannotRun cmd ->
@ -151,11 +177,11 @@ let () =
| _ -> None
)
let parse_all parse_fun magic ppf sourcefile =
let parse_all ~tool_name parse_fun magic ppf sourcefile =
Location.input_name := sourcefile;
let inputfile = preprocess sourcefile in
let ast =
try file ppf inputfile parse_fun magic
try file ppf ~tool_name inputfile parse_fun magic
with exn ->
remove_preprocessed inputfile;
raise exn
@ -163,7 +189,9 @@ let parse_all parse_fun magic ppf sourcefile =
remove_preprocessed inputfile;
ast
let parse_implementation ppf sourcefile =
parse_all Parse.implementation Config.ast_impl_magic_number ppf sourcefile
let parse_interface ppf sourcefile =
parse_all Parse.interface Config.ast_intf_magic_number ppf sourcefile
let parse_implementation ppf ~tool_name sourcefile =
parse_all ~tool_name Parse.implementation
Config.ast_impl_magic_number ppf sourcefile
let parse_interface ppf ~tool_name sourcefile =
parse_all ~tool_name Parse.interface
Config.ast_intf_magic_number ppf sourcefile

View File

@ -20,10 +20,10 @@ exception Error of error
val preprocess : string -> string
val remove_preprocessed : string -> unit
val file : formatter -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a
val apply_rewriters : string -> 'a -> 'a
val file : formatter -> tool_name:string -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a
val apply_rewriters : tool_name:string -> string -> 'a -> 'a
val report_error : formatter -> error -> unit
val parse_implementation: formatter -> string -> Parsetree.structure
val parse_interface: formatter -> string -> Parsetree.signature
val parse_implementation: formatter -> tool_name:string -> string -> Parsetree.structure
val parse_interface: formatter -> tool_name:string -> string -> Parsetree.signature

View File

@ -56,6 +56,9 @@ let (++) x f = f x
(** Analysis of an implementation file. Returns (Some typedtree) if
no error occured, else None and an error message is printed.*)
let tool_name = "ocamldoc"
let process_implementation_file ppf sourcefile =
init_path ();
let prefixname = Filename.chop_extension sourcefile in
@ -64,7 +67,10 @@ let process_implementation_file ppf sourcefile =
let inputfile = preprocess sourcefile in
let env = initial_env () in
try
let parsetree = Pparse.file Format.err_formatter inputfile Parse.implementation ast_impl_magic_number in
let parsetree =
Pparse.file ~tool_name Format.err_formatter inputfile
Parse.implementation ast_impl_magic_number
in
let typedtree =
Typemod.type_implementation
sourcefile prefixname modulename env parsetree
@ -92,7 +98,10 @@ let process_interface_file ppf sourcefile =
let modulename = String.capitalize(Filename.basename prefixname) in
Env.set_unit_name modulename;
let inputfile = preprocess sourcefile in
let ast = Pparse.file Format.err_formatter inputfile Parse.interface ast_intf_magic_number in
let ast =
Pparse.file ~tool_name Format.err_formatter inputfile
Parse.interface ast_intf_magic_number
in
let sg = Typemod.type_interface (initial_env()) ast in
Warnings.check_fatal ();
(ast, sg, inputfile)

View File

@ -18,6 +18,8 @@
*)
open Asttypes
open Longident
open Parsetree
open Ast_helper
open Location
@ -615,13 +617,85 @@ let default_mapper =
let rec extension_of_error {loc; msg; if_highlight; sub} =
{ loc; txt = "ocaml.error" },
PStr ([Str.eval (Exp.constant (Asttypes.Const_string (msg, None)));
Str.eval (Exp.constant (Asttypes.Const_string (if_highlight, None)))] @
PStr ([Str.eval (Exp.constant (Const_string (msg, None)));
Str.eval (Exp.constant (Const_string (if_highlight, None)))] @
(List.map (fun ext -> Str.extension (extension_of_error ext)) sub))
let attribute_of_warning loc s =
{ loc; txt = "ocaml.ppwarning" },
PStr ([Str.eval ~loc (Exp.constant (Asttypes.Const_string (s, None)))])
PStr ([Str.eval ~loc (Exp.constant (Const_string (s, None)))])
let tool_name_ref = ref "_none_"
let tool_name () = !tool_name_ref
let restore_ppx_context payload =
let fields =
match payload with
| PStr [{pstr_desc = Pstr_eval
({ pexp_desc = Pexp_record (fields, None) }, [])}] ->
fields
| _ ->
raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax"
in
let field name payload =
let rec get_string = function
| { pexp_desc = Pexp_constant (Const_string (str, None)) } -> str
| _ ->
raise_errorf
"Internal error: invalid [@@@ocaml.ppx.context { %s }] string syntax"
name
and get_bool pexp =
match pexp with
| {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, None)} ->
true
| {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, None)} ->
false
| _ ->
raise_errorf
"Internal error: invalid [@@@ocaml.ppx.context { %s }] bool syntax"
name
and get_list elem = function
| {pexp_desc =
Pexp_construct ({txt = Longident.Lident "::"},
Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
elem exp :: get_list elem rest
| {pexp_desc =
Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
[]
| _ ->
raise_errorf
"Internal error: invalid [@@@ocaml.ppx.context { %s }] list syntax"
name
and get_option elem = function
| { pexp_desc =
Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } ->
Some (elem exp)
| { pexp_desc =
Pexp_construct ({ txt = Longident.Lident "None" }, None) } ->
None
| _ ->
raise_errorf
"Internal error: invalid [@@@ocaml.ppx.context { %s }] option syntax"
name
in
match name with
| "tool_name" ->
tool_name_ref := get_string payload
| "include_dirs" ->
Clflags.include_dirs := get_list get_string payload
| "load_path" ->
Config.load_path := get_list get_string payload
| "open_modules" ->
Clflags.open_modules := get_list get_string payload
| "for_package" ->
Clflags.for_package := get_option get_string payload
| "debug" ->
Clflags.debug := get_bool payload
| _ ->
()
in
List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields
let apply ~source ~target mapper =
let ic = open_in_bin source in
@ -635,23 +709,41 @@ let apply ~source ~target mapper =
let ast = input_value ic in
close_in ic;
let ast =
let implem ast =
try
if magic = Config.ast_impl_magic_number
then Obj.magic (mapper.structure mapper (Obj.magic ast))
else Obj.magic (mapper.signature mapper (Obj.magic ast))
begin match ast with
| {pstr_desc = Pstr_attribute ({txt = "ocaml.ppx.context"}, x)} :: _ ->
restore_ppx_context x
| _ -> ()
end;
mapper.structure mapper ast
with exn ->
match error_of_exn exn with
| Some error ->
if magic = Config.ast_impl_magic_number
then Obj.magic [{pstr_desc = Pstr_extension (extension_of_error error,
[]);
pstr_loc = Location.none}]
else Obj.magic [{psig_desc = Psig_extension (extension_of_error error,
[]);
psig_loc = Location.none}]
[{pstr_desc = Pstr_extension (extension_of_error error, []);
pstr_loc = Location.none}]
| None -> raise exn
in
let iface ast =
try
begin match ast with
| {psig_desc = Psig_attribute ({txt = "ocaml.ppx.context"}, x)} :: _ ->
restore_ppx_context x
| _ -> ()
end;
mapper.signature mapper ast
with exn ->
match error_of_exn exn with
| Some error ->
[{psig_desc = Psig_extension (extension_of_error error, []);
psig_loc = Location.none}]
| None -> raise exn
in
let ast =
if magic = Config.ast_impl_magic_number
then Obj.magic (implem (Obj.magic ast))
else Obj.magic (iface (Obj.magic ast))
in
let oc = open_out_bin target in
output_string oc magic;
output_value oc !Location.input_name;
@ -682,3 +774,38 @@ let run_main mapper =
let register_function = ref (fun _name f -> run_main f)
let register name f = !register_function name f
let ppx_context ~tool_name () =
let open Longident in
let open Asttypes in
let open Ast_helper in
let lid name = { txt = Lident name; loc = Location.none } in
let make_string x = Exp.constant (Const_string (x, None)) in
let make_bool x =
if x
then Exp.construct (lid "true") None
else Exp.construct (lid "false") None
in
let rec make_list f lst =
match lst with
| x :: rest ->
Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest]))
| [] ->
Exp.construct (lid "[]") None
in
let make_option f opt =
match opt with
| Some x -> Exp.construct (lid "Some") (Some (f x))
| None -> Exp.construct (lid "None") None
in
{ txt = "ocaml.ppx.context"; loc = Location.none },
Parsetree.PStr [Str.eval (
Exp.record ([
lid "tool_name", make_string tool_name;
lid "include_dirs", make_list make_string !Clflags.include_dirs;
lid "load_path", make_list make_string !Config.load_path;
lid "open_modules", make_list make_string !Clflags.open_modules;
lid "for_package", make_option make_string !Clflags.for_package;
lid "debug", make_bool !Clflags.debug;
]) None)]

View File

@ -72,6 +72,16 @@ val default_mapper: mapper
(** {2 Apply mappers to compilation units} *)
val tool_name: unit -> string
(** Can be used within a ppx preprocessor to know which tool is
calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
["ocaml"], ... Some global variables that reflect command-line
options are automatically synchronized between the calling tool
and the ppx preprocessor: [Clflags.include_dirs],
[Config.load_path], [Clflags.open_modules], [Clflags.for_package],
[Clflags.debug]. *)
val apply: source:string -> target:string -> mapper -> unit
(** Apply a mapper (parametrized by the unit name) to a dumped
parsetree found in the [source] file and put the result in the
@ -121,3 +131,11 @@ val attribute_of_warning: Location.t -> string -> attribute
(** Encode a warning message into an 'ocaml.ppwarning' attribute which can be
inserted in a generated Parsetree. The compiler will be
responsible for reporting the warning. *)
(** {2 Helper functions to call external mappers} *)
val ppx_context: tool_name:string -> unit -> Parsetree.attribute
(** Extract information from the current environment and encode it
into an attribute an attribute which can be prepended to
signature/structure items of an AST to pass the information to an
external processor. *)

View File

@ -377,3 +377,6 @@ let () =
| Error e -> Some e
| _ -> None
)
let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") =
Printf.ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight})))

View File

@ -96,6 +96,9 @@ val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error
val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string
-> ('a, unit, string, error) format4 -> 'a
val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string
-> ('a, unit, string, 'b) format4 -> 'a
val error_of_printer: t -> (formatter -> 'a -> unit) -> 'a -> error
val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error

View File

@ -39,7 +39,7 @@ CAMLDEP_OBJ=depend.cmo ocamldep.cmo
CAMLDEP_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
warnings.cmo location.cmo longident.cmo \
syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
ccomp.cmo pparse.cmo compenv.cmo
ccomp.cmo ast_mapper.cmo pparse.cmo compenv.cmo
ocamldep: depend.cmi $(CAMLDEP_OBJ)
$(CAMLC) $(LINKFLAGS) -compat-32 -o ocamldep $(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ)

View File

@ -54,6 +54,7 @@ module Options = Main_args.Make_bytecomp_options (struct
let _dllib = option_with_arg "-dllib"
let _dllpath = option_with_arg "-dllpath"
let _dtypes = option "-dtypes"
let _for_pack = option_with_arg "-for-pack"
let _g = option "-g"
let _i = option "-i"
let _I s = option_with_arg "-I" s

View File

@ -18,7 +18,6 @@ let ppf = Format.err_formatter
type file_kind = ML | MLI;;
let include_dirs = ref []
let load_path = ref ([] : (string * string array) list)
let ml_synonyms = ref [".ml"]
let mli_synonyms = ref [".mli"]
@ -213,13 +212,15 @@ let report_err exn =
Location.report_error err
| None -> raise x
let tool_name = "ocamldep"
let read_parse_and_extract parse_function extract_function magic source_file =
Depend.free_structure_names := Depend.StringSet.empty;
try
let input_file = Pparse.preprocess source_file in
begin try
let ast =
Pparse.file Format.err_formatter input_file parse_function magic in
Pparse.file ~tool_name Format.err_formatter input_file parse_function magic in
extract_function Depend.StringSet.empty ast;
Pparse.remove_preprocessed input_file;
!Depend.free_structure_names
@ -295,7 +296,7 @@ let file_dependencies_as kind source_file =
load_path := [];
List.iter add_to_load_path (
(!Compenv.last_include_dirs @
!include_dirs @
!Clflags.include_dirs @
!Compenv.first_include_dirs
));
Location.input_name := source_file;
@ -411,7 +412,7 @@ let _ =
" Show absolute filenames in error messages";
"-all", Arg.Set all_dependencies,
" Generate dependencies on all files";
"-I", Arg.String (fun s -> include_dirs := s :: !include_dirs),
"-I", Arg.String (fun s -> Clflags.include_dirs := s :: !Clflags.include_dirs),
"<dir> Add <dir> to the list of include directories";
"-impl", Arg.String (file_dependencies_as ML),
"<f> Process <f> as a .ml file";

View File

@ -327,7 +327,7 @@ let phrase ppf phr =
let phr =
match phr with
| Ptop_def str ->
Ptop_def (Pparse.apply_rewriters ast_impl_magic_number str)
Ptop_def (Pparse.apply_rewriters ~tool_name:"ocaml" ast_impl_magic_number str)
| phr -> phr
in
if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;

View File

@ -74,7 +74,7 @@ module Options = Main_args.Make_bytetop_options (struct
let _noprompt = set noprompt
let _nopromptcont = set nopromptcont
let _nostdlib = set no_std_include
let _open s = open_module := s :: !open_module
let _open s = open_modules := s :: !open_modules
let _ppx s = first_ppx := s :: !first_ppx
let _principal = set principal
let _rectypes = set recursive_types

View File

@ -43,7 +43,7 @@ and noprompt = ref false (* -noprompt *)
and nopromptcont = ref false (* -nopromptcont *)
and init_file = ref (None : string option) (* -init *)
and noinit = ref false (* -noinit *)
and open_module = ref [] (* -open *)
and open_modules = ref [] (* -open *)
and use_prims = ref "" (* -use-prims ... *)
and use_runtime = ref "" (* -use-runtime ... *)
and principal = ref false (* -principal *)

View File

@ -28,7 +28,7 @@ val output_c_object : bool ref
val all_ccopts : string list ref
val classic : bool ref
val nopervasives : bool ref
val open_module : string list ref
val open_modules : string list ref
val preprocessor : string option ref
val all_ppx : string list ref
val annotations : bool ref