From 0444eac687ef803a63f39081039784f33bc535eb Mon Sep 17 00:00:00 2001 From: Valentin Gatien-Baron Date: Sun, 15 Jul 2018 15:00:47 -0400 Subject: [PATCH] Print warnings on the warnings formatter in the couple of places that don't Except the OCAMLPARAM stuff, as that runs before the command line warning settings are even parsed, so while they are reported using the normal warnings code, they don't look like normal warnings. --- bytecomp/bytelibrarian.ml | 10 +++++----- bytecomp/bytelibrarian.mli | 2 +- bytecomp/bytelink.ml | 38 +++++++++++++++++++------------------- bytecomp/bytelink.mli | 5 ++--- bytecomp/bytepackager.ml | 20 ++++++++++---------- bytecomp/bytepackager.mli | 2 +- driver/compmisc.ml | 4 ++-- driver/compmisc.mli | 2 +- driver/main.ml | 9 ++++----- driver/optmain.ml | 2 +- middle_end/middle_end.ml | 4 ++-- 11 files changed, 48 insertions(+), 50 deletions(-) diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index a905801fe..c380dbc5e 100644 --- a/bytecomp/bytelibrarian.ml +++ b/bytecomp/bytelibrarian.ml @@ -55,7 +55,7 @@ let add_ccobjs l = lib_dllibs := !lib_dllibs @ l.lib_dllibs end -let copy_object_file ppf oc name = +let copy_object_file oc name = let file_name = try find_in_path !load_path name @@ -68,7 +68,7 @@ let copy_object_file ppf oc name = let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; let compunit = (input_value ic : compilation_unit) in - Bytelink.check_consistency ppf file_name compunit; + Bytelink.check_consistency file_name compunit; copy_compunit ic oc compunit; close_in ic; [compunit] @@ -77,7 +77,7 @@ let copy_object_file ppf oc name = let toc_pos = input_binary_int ic in seek_in ic toc_pos; let toc = (input_value ic : library) in - List.iter (Bytelink.check_consistency ppf file_name) toc.lib_units; + List.iter (Bytelink.check_consistency file_name) toc.lib_units; add_ccobjs toc; List.iter (copy_compunit ic oc) toc.lib_units; close_in ic; @@ -88,14 +88,14 @@ let copy_object_file ppf oc name = End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name)) | x -> close_in ic; raise x -let create_archive ppf file_list lib_name = +let create_archive file_list lib_name = let outchan = open_out_bin lib_name in try output_string outchan cma_magic_number; let ofs_pos_toc = pos_out outchan in output_binary_int outchan 0; let units = - List.flatten(List.map (copy_object_file ppf outchan) file_list) in + List.flatten(List.map (copy_object_file outchan) file_list) in let toc = { lib_units = units; lib_custom = !Clflags.custom_runtime; diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli index 04a0316a8..3670730d6 100644 --- a/bytecomp/bytelibrarian.mli +++ b/bytecomp/bytelibrarian.mli @@ -22,7 +22,7 @@ content table = list of compilation units *) -val create_archive: Format.formatter -> string list -> string -> unit +val create_archive: string list -> string -> unit type error = File_not_found of string diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 5745b9f1d..1337cfcd1 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -169,7 +169,7 @@ let crc_interfaces = Consistbl.create () let interfaces = ref ([] : string list) let implementations_defined = ref ([] : (string * string) list) -let check_consistency ppf file_name cu = +let check_consistency file_name cu = begin try List.iter (fun (name, crco) -> @@ -186,7 +186,7 @@ let check_consistency ppf file_name cu = end; begin try let source = List.assoc cu.cu_name !implementations_defined in - Location.print_warning (Location.in_file file_name) ppf + Location.prerr_warning (Location.in_file file_name) (Warnings.Multiple_definition(cu.cu_name, Location.show_filename file_name, Location.show_filename source)) @@ -208,8 +208,8 @@ let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list) (* Link in a compilation unit *) -let link_compunit ppf output_fun currpos_fun inchan file_name compunit = - check_consistency ppf file_name compunit; +let link_compunit output_fun currpos_fun inchan file_name compunit = + check_consistency file_name compunit; seek_in inchan compunit.cu_pos; let code_block = LongString.input_bytes inchan compunit.cu_codesize in Symtable.patch_object code_block compunit.cu_reloc; @@ -230,10 +230,10 @@ let link_compunit ppf output_fun currpos_fun inchan file_name compunit = (* Link in a .cmo file *) -let link_object ppf output_fun currpos_fun file_name compunit = +let link_object output_fun currpos_fun file_name compunit = let inchan = open_in_bin file_name in try - link_compunit ppf output_fun currpos_fun inchan file_name compunit; + link_compunit output_fun currpos_fun inchan file_name compunit; close_in inchan with Symtable.Error msg -> @@ -243,14 +243,14 @@ let link_object ppf output_fun currpos_fun file_name compunit = (* Link in a .cma file *) -let link_archive ppf output_fun currpos_fun file_name units_required = +let link_archive output_fun currpos_fun file_name units_required = let inchan = open_in_bin file_name in try List.iter (fun cu -> let name = file_name ^ "(" ^ cu.cu_name ^ ")" in try - link_compunit ppf output_fun currpos_fun inchan name cu + link_compunit output_fun currpos_fun inchan name cu with Symtable.Error msg -> raise(Error(Symbol_error(name, msg)))) units_required; @@ -259,11 +259,11 @@ let link_archive ppf output_fun currpos_fun file_name units_required = (* Link in a .cmo or .cma file *) -let link_file ppf output_fun currpos_fun = function +let link_file output_fun currpos_fun = function Link_object(file_name, unit) -> - link_object ppf output_fun currpos_fun file_name unit + link_object output_fun currpos_fun file_name unit | Link_archive(file_name, units) -> - link_archive ppf output_fun currpos_fun file_name units + link_archive output_fun currpos_fun file_name units (* Output the debugging information *) (* Format is: @@ -298,7 +298,7 @@ let make_absolute file = (* Create a bytecode executable file *) -let link_bytecode ppf tolink exec_name standalone = +let link_bytecode tolink exec_name standalone = (* Avoid the case where the specified exec output file is the same as one of the objects to be linked *) List.iter (function @@ -343,7 +343,7 @@ let link_bytecode ppf tolink exec_name standalone = end; let output_fun = output_bytes outchan and currpos_fun () = pos_out outchan - start_code in - List.iter (link_file ppf output_fun currpos_fun) tolink; + List.iter (link_file output_fun currpos_fun) tolink; if check_dlls then Dll.close_all_dlls(); (* The final STOP instruction *) output_byte outchan Opcodes.opSTOP; @@ -444,7 +444,7 @@ let output_cds_file outfile = (* Output a bytecode executable as a C file *) -let link_bytecode_as_c ppf tolink outfile = +let link_bytecode_as_c tolink outfile = let outchan = open_out outfile in begin try (* The bytecode *) @@ -464,7 +464,7 @@ let link_bytecode_as_c ppf tolink outfile = output_code_string outchan code; currpos := !currpos + Bytes.length code and currpos_fun () = !currpos in - List.iter (link_file ppf output_fun currpos_fun) tolink; + List.iter (link_file output_fun currpos_fun) tolink; (* The final STOP instruction *) Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP; (* The table of global data *) @@ -565,7 +565,7 @@ let fix_exec_name name = (* Main entry point (build a custom runtime if needed) *) -let link ppf objfiles output_name = +let link objfiles output_name = let objfiles = if !Clflags.nopervasives then objfiles else if !Clflags.output_c_object then "stdlib.cma" :: objfiles @@ -584,7 +584,7 @@ let link ppf objfiles output_name = (* put user's opts first *) Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *) if not !Clflags.custom_runtime then - link_bytecode ppf tolink output_name true + link_bytecode tolink output_name true else if not !Clflags.output_c_object then begin let bytecode_name = Filename.temp_file "camlcode" "" in let prim_name = @@ -593,7 +593,7 @@ let link ppf objfiles output_name = else Filename.temp_file "camlprim" ".c" in try - link_bytecode ppf tolink bytecode_name false; + link_bytecode tolink bytecode_name false; let poc = open_out prim_name in (* note: builds will not be reproducible if the C code contains macros such as __FILE__. *) @@ -646,7 +646,7 @@ let link ppf objfiles output_name = else basename ^ Config.ext_obj in try - link_bytecode_as_c ppf tolink c_file; + link_bytecode_as_c tolink c_file; if not (Filename.check_suffix output_name ".c") then begin temps := c_file :: !temps; if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli index 56439e26c..e3cf98dad 100644 --- a/bytecomp/bytelink.mli +++ b/bytecomp/bytelink.mli @@ -15,11 +15,10 @@ (* Link .cmo files and produce a bytecode executable. *) -val link : Format.formatter -> string list -> string -> unit +val link : string list -> string -> unit val reset : unit -> unit -val check_consistency: - Format.formatter -> string -> Cmo_format.compilation_unit -> unit +val check_consistency: string -> Cmo_format.compilation_unit -> unit val extract_crc_interfaces: unit -> (string * Digest.t option) list diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index ac78c3443..4cb13e064 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -132,11 +132,11 @@ let read_member_info file = ( Accumulate relocs, debug info, etc. Return size of bytecode. *) -let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst +let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfile compunit = let ic = open_in_bin objfile in try - Bytelink.check_consistency ppf objfile compunit; + Bytelink.check_consistency objfile compunit; List.iter (rename_relocation packagename objfile mapping defined ofs) compunit.cu_reloc; @@ -161,7 +161,7 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst (* Same, for a list of .cmo and .cmi files. Return total size of bytecode. *) -let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs +let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function [] -> @@ -169,15 +169,15 @@ let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs | m :: rem -> match m.pm_kind with | PM_intf -> - rename_append_bytecode_list ppf packagename oc mapping defined ofs + rename_append_bytecode_list packagename oc mapping defined ofs prefix subst rem | PM_impl compunit -> let size = - rename_append_bytecode ppf packagename oc mapping defined ofs + rename_append_bytecode packagename oc mapping defined ofs prefix subst m.pm_file compunit in let id = Ident.create_persistent m.pm_name in let root = Path.Pident (Ident.create_persistent prefix) in - rename_append_bytecode_list ppf packagename oc mapping (id :: defined) + rename_append_bytecode_list packagename oc mapping (id :: defined) (ofs + size) prefix (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) subst) @@ -206,7 +206,7 @@ let build_global_target oc target_name members mapping pos coercion = (* Build the .cmo file obtained by packaging the given .cmo files. *) -let package_object_files ppf files targetfile targetname coercion = +let package_object_files files targetfile targetname coercion = let members = map_left_right read_member_info files in let required_globals = @@ -241,7 +241,7 @@ let package_object_files ppf files targetfile targetname coercion = let pos_depl = pos_out oc in output_binary_int oc 0; let pos_code = pos_out oc in - let ofs = rename_append_bytecode_list ppf targetname oc mapping [] 0 + let ofs = rename_append_bytecode_list targetname oc mapping [] 0 targetname Subst.identity members in build_global_target oc targetname members mapping ofs coercion; let pos_debug = pos_out oc in @@ -278,7 +278,7 @@ let package_object_files ppf files targetfile targetname coercion = (* The entry point *) -let package_files ppf initial_env files targetfile = +let package_files initial_env files targetfile = let files = List.map (fun f -> @@ -291,7 +291,7 @@ let package_files ppf initial_env files targetfile = try let coercion = Typemod.package_units initial_env files targetcmi targetname in - package_object_files ppf files targetfile targetname coercion + package_object_files files targetfile targetname coercion with x -> remove_file targetfile; raise x diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli index c856b632c..ae8663a67 100644 --- a/bytecomp/bytepackager.mli +++ b/bytecomp/bytepackager.mli @@ -16,7 +16,7 @@ (* "Package" a set of .cmo files into one .cmo file having the original compilation units as sub-modules. *) -val package_files: Format.formatter -> Env.t -> string list -> string -> unit +val package_files: Env.t -> string list -> string -> unit type error = Forward_reference of string * Ident.t diff --git a/driver/compmisc.ml b/driver/compmisc.ml index 9177076ac..2869db0d4 100644 --- a/driver/compmisc.ml +++ b/driver/compmisc.ml @@ -57,11 +57,11 @@ let initial_env () = ~initially_opened_module ~open_implicit_modules:(List.rev !Clflags.open_modules) -let read_color_env ppf = +let read_color_env () = try match Clflags.parse_color_setting (Sys.getenv "OCAML_COLOR") with | None -> - Location.print_warning Location.none ppf + Location.prerr_warning Location.none (Warnings.Bad_env_variable ("OCAML_COLOR", "expected \"auto\", \"always\" or \"never\"")); diff --git a/driver/compmisc.mli b/driver/compmisc.mli index 3dbcdaebd..fb29ff57c 100644 --- a/driver/compmisc.mli +++ b/driver/compmisc.mli @@ -16,4 +16,4 @@ val init_path : ?dir:string -> bool -> unit val initial_env : unit -> Env.t -val read_color_env : Format.formatter -> unit +val read_color_env : unit -> unit diff --git a/driver/main.ml b/driver/main.ml index a9a7e1650..e9567a46f 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -134,7 +134,7 @@ let main () = try readenv ppf Before_args; Clflags.parse_arguments anonymous usage; - Compmisc.read_color_env ppf; + Compmisc.read_color_env (); begin try Compenv.process_deferred_actions (ppf, @@ -162,8 +162,7 @@ let main () = if !make_archive then begin Compmisc.init_path false; - Bytelibrarian.create_archive ppf - (Compenv.get_objfiles ~with_ocamlparam:false) + Bytelibrarian.create_archive (Compenv.get_objfiles ~with_ocamlparam:false) (extract_output !output_name); Warnings.check_fatal (); end @@ -171,7 +170,7 @@ let main () = Compmisc.init_path false; let extracted_output = extract_output !output_name in let revd = get_objfiles ~with_ocamlparam:false in - Bytepackager.package_files ppf (Compmisc.initial_env ()) + Bytepackager.package_files (Compmisc.initial_env ()) revd (extracted_output); Warnings.check_fatal (); end @@ -193,7 +192,7 @@ let main () = default_output !output_name in Compmisc.init_path false; - Bytelink.link ppf (get_objfiles ~with_ocamlparam:true) target; + Bytelink.link (get_objfiles ~with_ocamlparam:true) target; Warnings.check_fatal (); end; with x -> diff --git a/driver/optmain.ml b/driver/optmain.ml index 7ae30b28b..0255e8fea 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -247,7 +247,7 @@ let main () = " Compute dependencies \ (use 'ocamlopt -depend -help' for details)"]; Clflags.parse_arguments anonymous usage; - Compmisc.read_color_env ppf; + Compmisc.read_color_env (); if !gprofile && not Config.profiling then fatal "Profiling with \"gprof\" is not supported on this platform."; begin try diff --git a/middle_end/middle_end.ml b/middle_end/middle_end.ml index 457efde03..b3461f18c 100644 --- a/middle_end/middle_end.ml +++ b/middle_end/middle_end.ml @@ -45,11 +45,11 @@ let middle_end ppf ~prefixname ~backend end) in let warning_set = ref WarningSet.empty in - let flambda_warning_printer loc _fmt w = + let flambda_warning_printer loc ppf w = let elt = loc, w in if not (WarningSet.mem elt !warning_set) then begin warning_set := WarningSet.add elt !warning_set; - previous_warning_printer loc !Location.formatter_for_warnings w + previous_warning_printer loc ppf w end; in Misc.protect_refs