Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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 \

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamldep
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

8
driver/compile.ml
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;

2
driver/compmisc.ml
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)

3
driver/main.ml
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

11
driver/main_args.ml
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;

2
driver/main_args.mli
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

6
driver/optcompile.ml
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;

2
driver/optmain.ml
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

48
driver/pparse.ml
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

8
driver/pparse.mli
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

13
ocamldoc/odoc_analyse.ml
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)

155
parsing/ast_mapper.ml
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)]

18
parsing/ast_mapper.mli
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. *)

3
parsing/location.ml
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})))

3
parsing/location.mli
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

2
tools/Makefile.shared
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)

1
tools/ocamlcp.ml
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

9
tools/ocamldep.ml
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";

2
toplevel/toploop.ml
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;

2
toplevel/topmain.ml
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

2
utils/clflags.ml
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 *)

2
utils/clflags.mli
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