diff options
| -rw-r--r-- | bytecomp/bytelibrarian.ml | 10 | ||||
| -rw-r--r-- | bytecomp/bytelibrarian.mli | 2 | ||||
| -rw-r--r-- | bytecomp/bytelink.ml | 38 | ||||
| -rw-r--r-- | bytecomp/bytelink.mli | 5 | ||||
| -rw-r--r-- | bytecomp/bytepackager.ml | 20 | ||||
| -rw-r--r-- | bytecomp/bytepackager.mli | 2 | ||||
| -rw-r--r-- | driver/compmisc.ml | 4 | ||||
| -rw-r--r-- | driver/compmisc.mli | 2 | ||||
| -rw-r--r-- | driver/main.ml | 9 | ||||
| -rw-r--r-- | driver/optmain.ml | 2 | ||||
| -rw-r--r-- | middle_end/middle_end.ml | 4 |
11 files changed, 48 insertions, 50 deletions
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index a905801fe6..c380dbc5eb 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 04a0316a8f..3670730d69 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 5745b9f1d0..1337cfcd18 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 56439e26cc..e3cf98dad7 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 ac78c34436..4cb13e064f 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 c856b632ce..ae8663a67d 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 9177076ac1..2869db0d43 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 3dbcdaebdd..fb29ff57c1 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 a9a7e1650a..e9567a46f4 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 7ae30b28b9..0255e8fea7 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -247,7 +247,7 @@ let main () = "<options> 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 457efde03b..b3461f18c3 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 |