More direct style, remove the temporary file created by -pp processor right after it has been read.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14085 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-09-10 13:48:43 +00:00
parent 0769ab46a7
commit e01f145c2e
4 changed files with 54 additions and 60 deletions

View File

@ -28,26 +28,24 @@ let interface ppf sourcefile outputprefix =
check_unit_name ppf sourcefile modulename;
Env.set_unit_name modulename;
let initial_env = Compmisc.initial_env () in
Pparse.parse_interface ppf sourcefile
(fun ast ->
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.transl_signature initial_env ast in
if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
if !Clflags.print_types then
Printtyp.wrap_printing_env initial_env (fun () ->
fprintf std_formatter "%a@."
Printtyp.signature (Typemod.simplify_signature sg));
ignore (Includemod.signatures initial_env sg sg);
Typecore.force_delayed_checks ();
Warnings.check_fatal ();
if not !Clflags.print_types then begin
let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in
Typemod.save_signature modulename tsg outputprefix sourcefile
initial_env sg ;
end
)
let ast = Pparse.parse_interface 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.transl_signature initial_env ast in
if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
if !Clflags.print_types then
Printtyp.wrap_printing_env initial_env (fun () ->
fprintf std_formatter "%a@."
Printtyp.signature (Typemod.simplify_signature sg));
ignore (Includemod.signatures initial_env sg sg);
Typecore.force_delayed_checks ();
Warnings.check_fatal ();
if not !Clflags.print_types then begin
let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in
Typemod.save_signature modulename tsg outputprefix sourcefile
initial_env sg ;
end
(* Compile a .ml file *)
@ -76,7 +74,7 @@ let implementation ppf sourcefile outputprefix =
Warnings.check_fatal ();
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try Pparse.parse_implementation ppf sourcefile comp
try comp (Pparse.parse_implementation ppf sourcefile)
with x ->
Stypes.dump (Some (outputprefix ^ ".annot"));
raise x
@ -101,7 +99,7 @@ let implementation ppf sourcefile outputprefix =
close_out oc;
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try Pparse.parse_implementation ppf sourcefile comp
try comp (Pparse.parse_implementation ppf sourcefile)
with x ->
close_out oc;
remove_file objfile;

View File

@ -29,26 +29,24 @@ let interface ppf sourcefile outputprefix =
check_unit_name ppf sourcefile modulename;
Env.set_unit_name modulename;
let initial_env = Compmisc.initial_env () in
Pparse.parse_interface ppf sourcefile
(fun ast ->
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.transl_signature initial_env ast in
if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
if !Clflags.print_types then
Printtyp.wrap_printing_env initial_env (fun () ->
fprintf std_formatter "%a@."
Printtyp.signature (Typemod.simplify_signature sg));
ignore (Includemod.signatures initial_env sg sg);
Typecore.force_delayed_checks ();
Warnings.check_fatal ();
if not !Clflags.print_types then begin
let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in
Typemod.save_signature modulename tsg outputprefix sourcefile
initial_env sg ;
end
)
let ast = Pparse.parse_interface 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.transl_signature initial_env ast in
if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
let sg = tsg.sig_type in
if !Clflags.print_types then
Printtyp.wrap_printing_env initial_env (fun () ->
fprintf std_formatter "%a@."
Printtyp.signature (Typemod.simplify_signature sg));
ignore (Includemod.signatures initial_env sg sg);
Typecore.force_delayed_checks ();
Warnings.check_fatal ();
if not !Clflags.print_types then begin
let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in
Typemod.save_signature modulename tsg outputprefix sourcefile
initial_env sg ;
end
(* Compile a .ml file *)
@ -96,7 +94,7 @@ let implementation ppf sourcefile outputprefix =
Warnings.check_fatal ();
Stypes.dump (Some (outputprefix ^ ".annot"))
in
try Pparse.parse_implementation ppf sourcefile comp
try comp (Pparse.parse_implementation ppf sourcefile)
with x ->
Stypes.dump (Some (outputprefix ^ ".annot"));
remove_file objfile;

View File

@ -142,19 +142,19 @@ let report_error ppf = function
Command line: %s@." cmd
let parse_all parse_fun magic ppf sourcefile k =
let parse_all parse_fun magic ppf sourcefile =
Location.input_name := sourcefile;
let inputfile = preprocess sourcefile in
try
let ast = file ppf inputfile parse_fun magic in
let res = k ast in
remove_preprocessed inputfile;
res
with exn ->
remove_preprocessed inputfile;
raise exn
let ast =
try file ppf inputfile parse_fun magic
with exn ->
remove_preprocessed inputfile;
raise exn
in
remove_preprocessed inputfile;
ast
let parse_implementation ppf sourcefile k =
parse_all Parse.implementation Config.ast_impl_magic_number ppf sourcefile k
let parse_interface ppf sourcefile k =
parse_all Parse.interface Config.ast_intf_magic_number ppf sourcefile k
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

View File

@ -25,7 +25,5 @@ val apply_rewriters : string -> 'a -> 'a
val report_error : formatter -> error -> unit
val parse_implementation:
formatter -> string -> (Parsetree.structure -> 'a) -> 'a
val parse_interface:
formatter -> string -> (Parsetree.signature -> 'a) -> 'a
val parse_implementation: formatter -> string -> Parsetree.structure
val parse_interface: formatter -> string -> Parsetree.signature