diff --git a/driver/compile.ml b/driver/compile.ml index b790a0c18..bc9201e26 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -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; diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 95d46d17d..625c0223e 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -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; diff --git a/driver/pparse.ml b/driver/pparse.ml index 6d0025034..17ec3b68e 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -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 diff --git a/driver/pparse.mli b/driver/pparse.mli index dbcd80517..6a53f3fa9 100644 --- a/driver/pparse.mli +++ b/driver/pparse.mli @@ -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