diff options
| -rw-r--r-- | asmcomp/asmgen.ml | 72 | ||||
| -rw-r--r-- | asmcomp/asmgen.mli | 4 | ||||
| -rw-r--r-- | asmcomp/asmlink.ml | 16 | ||||
| -rw-r--r-- | asmcomp/asmlink.mli | 4 | ||||
| -rw-r--r-- | asmcomp/asmpackager.ml | 12 | ||||
| -rw-r--r-- | asmcomp/asmpackager.mli | 2 | ||||
| -rw-r--r-- | asmcomp/liveness.ml | 4 | ||||
| -rw-r--r-- | asmcomp/liveness.mli | 2 | ||||
| -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 | 4 | ||||
| -rw-r--r-- | bytecomp/bytepackager.ml | 20 | ||||
| -rw-r--r-- | bytecomp/bytepackager.mli | 2 | ||||
| -rw-r--r-- | driver/compile.ml | 36 | ||||
| -rw-r--r-- | driver/compile.mli | 4 | ||||
| -rw-r--r-- | driver/main.ml | 31 | ||||
| -rw-r--r-- | driver/optcompile.ml | 36 | ||||
| -rw-r--r-- | driver/optcompile.mli | 4 | ||||
| -rw-r--r-- | driver/optmain.ml | 29 | ||||
| -rw-r--r-- | driver/pparse.ml | 4 | ||||
| -rw-r--r-- | driver/pparse.mli | 2 | ||||
| -rw-r--r-- | parsing/location.mli | 3 | ||||
| -rw-r--r-- | toplevel/opttopdirs.ml | 2 | ||||
| -rw-r--r-- | toplevel/opttoploop.ml | 2 | ||||
| -rw-r--r-- | typing/typecore.ml | 5 |
26 files changed, 175 insertions, 175 deletions
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index c14c0006d..a25ff300a 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -24,77 +24,77 @@ type error = Assembler_error of string exception Error of error -let liveness ppf phrase = - Liveness.fundecl ppf phrase; phrase +let liveness phrase = + Liveness.fundecl phrase; phrase -let dump_if ppf flag message phrase = - if !flag then Printmach.phase message ppf phrase +let dump_if flag message phrase = + if !flag then Printmach.phase message Format.err_formatter phrase -let pass_dump_if ppf flag message phrase = - dump_if ppf flag message phrase; phrase +let pass_dump_if flag message phrase = + dump_if flag message phrase; phrase -let pass_dump_linear_if ppf flag message phrase = - if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase; +let pass_dump_linear_if flag message phrase = + if !flag then fprintf Format.err_formatter "*** %s@.%a@." message Printlinear.fundecl phrase; phrase -let rec regalloc ppf round fd = +let rec regalloc round fd = if round > 50 then fatal_error(fd.Mach.fun_name ^ ": function too complex, cannot complete register allocation"); - dump_if ppf dump_live "Liveness analysis" fd; + dump_if dump_live "Liveness analysis" fd; Interf.build_graph fd; - if !dump_interf then Printmach.interferences ppf (); - if !dump_prefer then Printmach.preferences ppf (); + if !dump_interf then Printmach.interferences Format.err_formatter (); + if !dump_prefer then Printmach.preferences Format.err_formatter (); Coloring.allocate_registers(); - dump_if ppf dump_regalloc "After register allocation" fd; + dump_if dump_regalloc "After register allocation" fd; let (newfd, redo_regalloc) = Reload.fundecl fd in - dump_if ppf dump_reload "After insertion of reloading code" newfd; + dump_if dump_reload "After insertion of reloading code" newfd; if redo_regalloc then begin - Reg.reinit(); Liveness.fundecl ppf newfd; regalloc ppf (round + 1) newfd + Reg.reinit(); Liveness.fundecl newfd; regalloc (round + 1) newfd end else newfd let (++) x f = f x -let compile_fundecl (ppf : formatter) fd_cmm = +let compile_fundecl fd_cmm = Reg.reset(); fd_cmm ++ Selection.fundecl - ++ pass_dump_if ppf dump_selection "After instruction selection" + ++ pass_dump_if dump_selection "After instruction selection" ++ Comballoc.fundecl - ++ pass_dump_if ppf dump_combine "After allocation combining" - ++ liveness ppf - ++ pass_dump_if ppf dump_live "Liveness analysis" + ++ pass_dump_if dump_combine "After allocation combining" + ++ liveness + ++ pass_dump_if dump_live "Liveness analysis" ++ Spill.fundecl - ++ liveness ppf - ++ pass_dump_if ppf dump_spill "After spilling" + ++ liveness + ++ pass_dump_if dump_spill "After spilling" ++ Split.fundecl - ++ pass_dump_if ppf dump_split "After live range splitting" - ++ liveness ppf - ++ regalloc ppf 1 + ++ pass_dump_if dump_split "After live range splitting" + ++ liveness + ++ regalloc 1 ++ Linearize.fundecl - ++ pass_dump_linear_if ppf dump_linear "Linearized code" + ++ pass_dump_linear_if dump_linear "Linearized code" ++ Scheduling.fundecl - ++ pass_dump_linear_if ppf dump_scheduling "After instruction scheduling" + ++ pass_dump_linear_if dump_scheduling "After instruction scheduling" ++ Emit.fundecl -let compile_phrase ppf p = - if !dump_cmm then fprintf ppf "%a@." Printcmm.phrase p; +let compile_phrase p = + if !dump_cmm then eprintf "%a@." Printcmm.phrase p; match p with - | Cfunction fd -> compile_fundecl ppf fd + | Cfunction fd -> compile_fundecl fd | Cdata dl -> Emit.data dl (* For the native toplevel: generates generic functions unless they are already available in the process *) -let compile_genfuns ppf f = +let compile_genfuns f = List.iter (function | (Cfunction {fun_name = name}) as ph when f name -> - compile_phrase ppf ph + compile_phrase ph | _ -> ()) (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()]) -let compile_implementation ?toplevel prefixname ppf (size, lam) = +let compile_implementation ?toplevel prefixname (size, lam) = let asmfile = if !keep_asm_file then prefixname ^ ext_asm @@ -105,8 +105,8 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) = Emit.begin_assembly(); Closure.intro size lam ++ Cmmgen.compunit size - ++ List.iter (compile_phrase ppf) ++ (fun () -> ()); - (match toplevel with None -> () | Some f -> compile_genfuns ppf f); + ++ List.iter compile_phrase ++ (fun () -> ()); + (match toplevel with None -> () | Some f -> compile_genfuns f); (* We add explicit references to external primitive symbols. This is to ensure that the object files that define these symbols, @@ -114,7 +114,7 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) = This is important if a module that uses such a symbol is later dynlinked. *) - compile_phrase ppf + compile_phrase (Cmmgen.reference_symbols (List.filter (fun s -> s <> "" && s.[0] <> '%') (List.map Primitive.native_name !Translmod.primitive_declarations)) diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli index f71cba8f7..b3577e7f4 100644 --- a/asmcomp/asmgen.mli +++ b/asmcomp/asmgen.mli @@ -16,9 +16,9 @@ val compile_implementation : ?toplevel:(string -> bool) -> - string -> Format.formatter -> int * Lambda.lambda -> unit + string -> int * Lambda.lambda -> unit val compile_phrase : - Format.formatter -> Cmm.phrase -> unit + Cmm.phrase -> unit type error = Assembler_error of string exception Error of error diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 8a1109fd6..1edb27082 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -197,8 +197,8 @@ let scan_file obj_name tolink = match read_file obj_name with (* Second pass: generate the startup file and link it with everything else *) -let make_startup_file ppf filename units_list = - let compile_phrase p = Asmgen.compile_phrase ppf p in +let make_startup_file filename units_list = + let compile_phrase = Asmgen.compile_phrase in let oc = open_out filename in Emitaux.output_channel := oc; Location.input_name := "caml_startup"; (* set name of "current" input *) @@ -230,8 +230,8 @@ let make_startup_file ppf filename units_list = Emit.end_assembly(); close_out oc -let make_shared_startup_file ppf units filename = - let compile_phrase p = Asmgen.compile_phrase ppf p in +let make_shared_startup_file units filename = + let compile_phrase = Asmgen.compile_phrase in let oc = open_out filename in Emitaux.output_channel := oc; Location.input_name := "caml_startup"; @@ -254,7 +254,7 @@ let call_linker_shared file_list output_name = if not (Ccomp.call_linker Ccomp.Dll output_name file_list "") then raise(Error Linking_error) -let link_shared ppf objfiles output_name = +let link_shared objfiles output_name = let units_tolink = List.fold_right scan_file objfiles [] in List.iter (fun (info, file_name, crc) -> check_consistency file_name info crc) @@ -268,7 +268,7 @@ let link_shared ppf objfiles output_name = if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm else Filename.temp_file "camlstartup" ext_asm in - make_shared_startup_file ppf + make_shared_startup_file (List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink) startup; let startup_obj = output_name ^ ".startup" ^ ext_obj in if Proc.assemble_file startup startup_obj <> 0 @@ -299,7 +299,7 @@ let call_linker file_list startup_file output_name = (* Main entry point *) -let link ppf objfiles output_name = +let link objfiles output_name = let stdlib = if !Clflags.gprofile then "stdlib.p.cmxa" else "stdlib.cmxa" in let stdexit = @@ -322,7 +322,7 @@ let link ppf objfiles output_name = let startup = if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm else Filename.temp_file "camlstartup" ext_asm in - make_startup_file ppf startup units_tolink; + make_startup_file startup units_tolink; let startup_obj = Filename.temp_file "camlstartup" ext_obj in if Proc.assemble_file startup startup_obj <> 0 then raise(Error(Assembler_error startup)); diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli index b9465f809..0d88bd424 100644 --- a/asmcomp/asmlink.mli +++ b/asmcomp/asmlink.mli @@ -16,9 +16,9 @@ open Format -val link: formatter -> string list -> string -> unit +val link: string list -> string -> unit -val link_shared: formatter -> string list -> string -> unit +val link_shared: string list -> string -> unit val call_linker_shared: string list -> string -> unit diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 548a0a3d5..c375bf768 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -79,7 +79,7 @@ let check_units members = (* Make the .o file for the package *) -let make_package_object ppf members targetobj targetname coercion = +let make_package_object members targetobj targetname coercion = let objtemp = if !Clflags.keep_asm_file then chop_extension_if_any targetobj ^ ".pack" ^ Config.ext_obj @@ -96,7 +96,7 @@ let make_package_object ppf members targetobj targetname coercion = | PM_impl _ -> Some(Ident.create_persistent m.pm_name)) members in Asmgen.compile_implementation - (chop_extension_if_any objtemp) ppf + (chop_extension_if_any objtemp) (Translmod.transl_store_package components (Ident.create_persistent targetname) coercion); let objfiles = @@ -152,7 +152,7 @@ let build_package_cmx members cmxfile = (* Make the .cmx and the .o for the package *) -let package_object_files ppf files targetcmx +let package_object_files files targetcmx targetobj targetname coercion = let pack_path = match !Clflags.for_package with @@ -160,12 +160,12 @@ let package_object_files ppf files targetcmx | Some p -> p ^ "." ^ targetname in let members = map_left_right (read_member_info pack_path) files in check_units members; - make_package_object ppf members targetobj targetname coercion; + make_package_object members targetobj targetname coercion; build_package_cmx members targetcmx (* The entry point *) -let package_files ppf files targetcmx = +let package_files files targetcmx = let files = List.map (fun f -> @@ -182,7 +182,7 @@ let package_files ppf files targetcmx = Compilenv.reset ?packname:!Clflags.for_package targetname; try let coercion = Typemod.package_units files targetcmi targetname in - package_object_files ppf files targetcmx targetobj targetname coercion + package_object_files files targetcmx targetobj targetname coercion with x -> remove_file targetcmx; remove_file targetobj; raise x diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli index fafccfea3..86cc5cf15 100644 --- a/asmcomp/asmpackager.mli +++ b/asmcomp/asmpackager.mli @@ -15,7 +15,7 @@ (* "Package" a set of .cmx/.o files into one .cmx/.o file having the original compilation units as sub-modules. *) -val package_files: Format.formatter -> string list -> string -> unit +val package_files: string list -> string -> unit type error = Illegal_renaming of string * string diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml index 74a034fb3..ded9e88c7 100644 --- a/asmcomp/liveness.ml +++ b/asmcomp/liveness.ml @@ -110,11 +110,11 @@ let rec live i finally = i.live <- across; Reg.add_set_array across i.arg -let fundecl ppf f = +let fundecl f = let initially_live = live f.fun_body Reg.Set.empty in (* Sanity check: only function parameters can be live at entrypoint *) let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in if not (Reg.Set.is_empty wrong_live) then begin - Format.fprintf ppf "%a@." Printmach.regset wrong_live; + Format.eprintf "%a@." Printmach.regset wrong_live; Misc.fatal_error "Liveness.fundecl" end diff --git a/asmcomp/liveness.mli b/asmcomp/liveness.mli index 8a25a27bc..32d7c1855 100644 --- a/asmcomp/liveness.mli +++ b/asmcomp/liveness.mli @@ -17,4 +17,4 @@ open Format -val fundecl: formatter -> Mach.fundecl -> unit +val fundecl: Mach.fundecl -> unit diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index 767a3dca6..62d900023 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 @@ -69,7 +69,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] @@ -78,7 +78,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; @@ -89,13 +89,13 @@ 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 + let units = 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 242011159..a4250f96d 100644 --- a/bytecomp/bytelibrarian.mli +++ b/bytecomp/bytelibrarian.mli @@ -21,7 +21,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 aa4c3d45a..9bd226e5c 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -164,7 +164,7 @@ let scan_file obj_name tolink = let crc_interfaces = Consistbl.create () 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, crc) -> @@ -177,7 +177,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, file_name, source)) with Not_found -> () end; @@ -193,8 +193,8 @@ let debug_info = ref ([] : (int * string) 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 = String.create compunit.cu_codesize in really_input inchan code_block 0 compunit.cu_codesize; @@ -211,10 +211,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 -> @@ -224,14 +224,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; @@ -240,11 +240,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: @@ -276,7 +276,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 = Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *) let outchan = open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] @@ -314,7 +314,7 @@ let link_bytecode ppf tolink exec_name standalone = end; let output_fun = output_string 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 standalone then Dll.close_all_dlls(); (* The final STOP instruction *) output_byte outchan Opcodes.opSTOP; @@ -413,7 +413,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 *) @@ -435,7 +435,7 @@ let link_bytecode_as_c ppf tolink outfile = output_code_string outchan code; currpos := !currpos + String.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 *) @@ -502,7 +502,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 @@ -512,12 +512,12 @@ let link ppf objfiles output_name = Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* 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 = 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 output_string poc "\ #ifdef __cplusplus\n\ @@ -555,7 +555,7 @@ let link ppf objfiles output_name = if Sys.file_exists c_file then raise(Error(File_exists c_file)); let temps = ref [] 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 c_file <> 0 then raise(Error Custom_runtime); diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli index 1366a1686..2fd700e3c 100644 --- a/bytecomp/bytelink.mli +++ b/bytecomp/bytelink.mli @@ -14,9 +14,9 @@ (* Link .cmo files and produce a bytecode executable. *) -val link : Format.formatter -> string list -> string -> unit +val link : string list -> string -> 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) list diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index fc53d54d6..45457ee38 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -124,10 +124,10 @@ 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 objfile compunit = +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; @@ -148,20 +148,20 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst o (* 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 prefix subst = function +let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function [] -> ofs | m :: rem -> match m.pm_kind with | PM_intf -> - rename_append_bytecode_list ppf packagename oc mapping defined ofs prefix subst rem + 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 prefix subst + 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 + 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) rem @@ -186,7 +186,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 unit_names = @@ -203,7 +203,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 targetname Subst.identity members in + 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 if !Clflags.debug && !events <> [] then @@ -233,7 +233,7 @@ let package_object_files ppf files targetfile targetname coercion = (* The entry point *) -let package_files ppf files targetfile = +let package_files files targetfile = let files = List.map (fun f -> @@ -245,7 +245,7 @@ let package_files ppf files targetfile = let targetname = String.capitalize(Filename.basename prefix) in try let coercion = Typemod.package_units files targetcmi targetname in - let ret = package_object_files ppf files targetfile targetname coercion in + let ret = package_object_files files targetfile targetname coercion in ret with x -> remove_file targetfile; raise x diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli index 696b12aa0..2a599d9f9 100644 --- a/bytecomp/bytepackager.mli +++ b/bytecomp/bytepackager.mli @@ -15,7 +15,7 @@ (* "Package" a set of .cmo files into one .cmo file having the original compilation units as sub-modules. *) -val package_files: Format.formatter -> string list -> string -> unit +val package_files: string list -> string -> unit type error = Forward_reference of string * Ident.t diff --git a/driver/compile.ml b/driver/compile.ml index a27ffaa19..8d9d2aa16 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -49,12 +49,12 @@ let initial_env () = fatal_error "cannot open pervasives.cmi" (* Note: this function is duplicated in optcompile.ml *) -let check_unit_name ppf filename name = +let check_unit_name filename name = try begin match name.[0] with | 'A'..'Z' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf + Location.prerr_warning (Location.in_file filename) (Warnings.Bad_module_name name); raise Exit; end; @@ -62,7 +62,7 @@ let check_unit_name ppf filename name = match name.[i] with | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf + Location.prerr_warning (Location.in_file filename) (Warnings.Bad_module_name name); raise Exit; done; @@ -71,18 +71,18 @@ let check_unit_name ppf filename name = (* Compile a .mli file *) -let interface ppf sourcefile outputprefix = +let interface sourcefile outputprefix = Location.input_name := sourcefile; init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in - check_unit_name ppf sourcefile modulename; + check_unit_name sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in try let ast = - Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in - if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; + Pparse.file inputfile Parse.interface ast_intf_magic_number in + if !Clflags.dump_parsetree then eprintf "%a@." Printast.interface ast; let sg = Typemod.transl_signature (initial_env()) ast in if !Clflags.print_types then fprintf std_formatter "%a@." Printtyp.signature @@ -97,25 +97,25 @@ let interface ppf sourcefile outputprefix = (* Compile a .ml file *) -let print_if ppf flag printer arg = - if !flag then fprintf ppf "%a@." printer arg; +let print_if flag printer arg = + if !flag then eprintf "%a@." printer arg; arg let (++) x f = f x -let implementation ppf sourcefile outputprefix = +let implementation sourcefile outputprefix = Location.input_name := sourcefile; init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in - check_unit_name ppf sourcefile modulename; + check_unit_name sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in let env = initial_env() in if !Clflags.print_types then begin try ignore( - Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number - ++ print_if ppf Clflags.dump_parsetree Printast.implementation + Pparse.file inputfile Parse.implementation ast_impl_magic_number + ++ print_if Clflags.dump_parsetree Printast.implementation ++ Typemod.type_implementation sourcefile outputprefix modulename env) with x -> Pparse.remove_preprocessed_if_ast inputfile; @@ -124,15 +124,15 @@ let implementation ppf sourcefile outputprefix = let objfile = outputprefix ^ ".cmo" in let oc = open_out_bin objfile in try - Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number - ++ print_if ppf Clflags.dump_parsetree Printast.implementation + Pparse.file inputfile Parse.implementation ast_impl_magic_number + ++ print_if Clflags.dump_parsetree Printast.implementation ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ Translmod.transl_implementation modulename - ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda + ++ print_if Clflags.dump_rawlambda Printlambda.lambda ++ Simplif.simplify_lambda - ++ print_if ppf Clflags.dump_lambda Printlambda.lambda + ++ print_if Clflags.dump_lambda Printlambda.lambda ++ Bytegen.compile_implementation modulename - ++ print_if ppf Clflags.dump_instr Printinstr.instrlist + ++ print_if Clflags.dump_instr Printinstr.instrlist ++ Emitcode.to_file oc modulename; Warnings.check_fatal (); close_out oc; diff --git a/driver/compile.mli b/driver/compile.mli index 779239a8c..d1e4c963d 100644 --- a/driver/compile.mli +++ b/driver/compile.mli @@ -16,8 +16,8 @@ open Format -val interface: formatter -> string -> string -> unit -val implementation: formatter -> string -> string -> unit +val interface: string -> string -> unit +val implementation: string -> string -> unit val c_file: string -> unit val initial_env: unit -> Env.t diff --git a/driver/main.ml b/driver/main.ml index 5c47a74dd..f1d65f339 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -22,24 +22,24 @@ let output_prefix name = | Some n -> if !compile_only then (output_name := None; n) else name in Misc.chop_extension_if_any oname -let process_interface_file ppf name = - Compile.interface ppf name (output_prefix name) +let process_interface_file name = + Compile.interface name (output_prefix name) -let process_implementation_file ppf name = +let process_implementation_file name = let opref = output_prefix name in - Compile.implementation ppf name opref; + Compile.implementation name opref; objfiles := (opref ^ ".cmo") :: !objfiles -let process_file ppf name = +let process_file name = if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mlt" then begin let opref = output_prefix name in - Compile.implementation ppf name opref; + Compile.implementation name opref; objfiles := (opref ^ ".cmo") :: !objfiles end else if Filename.check_suffix name !Config.interface_suffix then begin let opref = output_prefix name in - Compile.interface ppf name opref; + Compile.interface name opref; if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles end else if Filename.check_suffix name ".cmo" @@ -75,12 +75,10 @@ let print_standard_library () = let usage = "Usage: ocamlc <options> <files>\nOptions are:" -let ppf = Format.err_formatter - (* Error messages to standard error formatter *) -let anonymous = process_file ppf;; -let impl = process_implementation_file ppf;; -let intf = process_interface_file ppf;; +let anonymous = process_file;; +let impl = process_implementation_file;; +let intf = process_interface_file;; let show_config () = Config.print_config stdout; @@ -172,15 +170,14 @@ let main () = if !make_archive then begin Compile.init_path(); - Bytelibrarian.create_archive ppf (List.rev !objfiles) + Bytelibrarian.create_archive (List.rev !objfiles) (extract_output !output_name) end else if !make_package then begin Compile.init_path(); let exctracted_output = extract_output !output_name in let revd = List.rev !objfiles in - Bytepackager.package_files ppf (revd) - (exctracted_output) + Bytepackager.package_files revd exctracted_output end else if not !compile_only && !objfiles <> [] then begin let target = @@ -200,11 +197,11 @@ let main () = default_output !output_name in Compile.init_path(); - Bytelink.link ppf (List.rev !objfiles) target + Bytelink.link (List.rev !objfiles) target end; exit 0 with x -> - Errors.report_error ppf x; + Errors.report_error Format.err_formatter x; exit 2 let _ = main () diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 1e6ab0ce3..de736294b 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -46,12 +46,12 @@ let initial_env () = fatal_error "cannot open pervasives.cmi" (* Note: this function is duplicated in compile.ml *) -let check_unit_name ppf filename name = +let check_unit_name filename name = try begin match name.[0] with | 'A'..'Z' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf + Location.prerr_warning (Location.in_file filename) (Warnings.Bad_module_name name); raise Exit; end; @@ -59,7 +59,7 @@ let check_unit_name ppf filename name = match name.[i] with | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf + Location.prerr_warning (Location.in_file filename) (Warnings.Bad_module_name name); raise Exit; done; @@ -68,18 +68,18 @@ let check_unit_name ppf filename name = (* Compile a .mli file *) -let interface ppf sourcefile outputprefix = +let interface sourcefile outputprefix = Location.input_name := sourcefile; init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in - check_unit_name ppf sourcefile modulename; + check_unit_name sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in try let ast = - Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in - if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; + Pparse.file inputfile Parse.interface ast_intf_magic_number in + if !Clflags.dump_parsetree then eprintf "%a@." Printast.interface ast; let sg = Typemod.transl_signature (initial_env()) ast in if !Clflags.print_types then fprintf std_formatter "%a@." Printtyp.signature @@ -96,19 +96,19 @@ let interface ppf sourcefile outputprefix = (* Compile a .ml file *) -let print_if ppf flag printer arg = - if !flag then fprintf ppf "%a@." printer arg; +let print_if flag printer arg = + if !flag then eprintf "%a@." printer arg; arg let (++) x f = f x let (+++) (x, y) f = (x, f y) -let implementation ppf sourcefile outputprefix = +let implementation sourcefile outputprefix = Location.input_name := sourcefile; init_path (); let modulename = String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in - check_unit_name ppf sourcefile modulename; + check_unit_name sourcefile modulename; Env.set_unit_name modulename; let inputfile = Pparse.preprocess sourcefile in let env = initial_env() in @@ -117,18 +117,18 @@ let implementation ppf sourcefile outputprefix = let objfile = outputprefix ^ ext_obj in try if !Clflags.print_types then ignore( - Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number - ++ print_if ppf Clflags.dump_parsetree Printast.implementation + Pparse.file inputfile Parse.implementation ast_impl_magic_number + ++ print_if Clflags.dump_parsetree Printast.implementation ++ Typemod.type_implementation sourcefile outputprefix modulename env) else begin - Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number - ++ print_if ppf Clflags.dump_parsetree Printast.implementation + Pparse.file inputfile Parse.implementation ast_impl_magic_number + ++ print_if Clflags.dump_parsetree Printast.implementation ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ Translmod.transl_store_implementation modulename - +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda + +++ print_if Clflags.dump_rawlambda Printlambda.lambda +++ Simplif.simplify_lambda - +++ print_if ppf Clflags.dump_lambda Printlambda.lambda - ++ Asmgen.compile_implementation outputprefix ppf; + +++ print_if Clflags.dump_lambda Printlambda.lambda + ++ Asmgen.compile_implementation outputprefix; Compilenv.save_unit_info cmxfile; end; Warnings.check_fatal (); diff --git a/driver/optcompile.mli b/driver/optcompile.mli index 779239a8c..d1e4c963d 100644 --- a/driver/optcompile.mli +++ b/driver/optcompile.mli @@ -16,8 +16,8 @@ open Format -val interface: formatter -> string -> string -> unit -val implementation: formatter -> string -> string -> unit +val interface: string -> string -> unit +val implementation: string -> string -> unit val c_file: string -> unit val initial_env: unit -> Env.t diff --git a/driver/optmain.ml b/driver/optmain.ml index be3f8b240..e52b11d35 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -22,21 +22,21 @@ let output_prefix name = | Some n -> if !compile_only then (output_name := None; n) else name in Misc.chop_extension_if_any oname -let process_interface_file ppf name = - Optcompile.interface ppf name (output_prefix name) +let process_interface_file name = + Optcompile.interface name (output_prefix name) -let process_implementation_file ppf name = +let process_implementation_file name = let opref = output_prefix name in - Optcompile.implementation ppf name opref; + Optcompile.implementation name opref; objfiles := (opref ^ ".cmx") :: !objfiles -let process_file ppf name = +let process_file name = if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mlt" then - process_implementation_file ppf name + process_implementation_file name else if Filename.check_suffix name !Config.interface_suffix then begin let opref = output_prefix name in - Optcompile.interface ppf name opref; + Optcompile.interface name opref; if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles end else if Filename.check_suffix name ".cmx" @@ -84,9 +84,9 @@ let default_output = function let usage = "Usage: ocamlopt <options> <files>\nOptions are:" (* Error messages to standard error formatter *) -let anonymous = process_file Format.err_formatter;; -let impl = process_implementation_file Format.err_formatter;; -let intf = process_interface_file Format.err_formatter;; +let anonymous = process_file;; +let impl = process_implementation_file;; +let intf = process_interface_file;; let show_config () = Config.print_config stdout; @@ -167,7 +167,6 @@ end);; let main () = native_code := true; - let ppf = Format.err_formatter in try Arg.parse (Arch.command_line_options @ Options.list) anonymous usage; if @@ -184,12 +183,12 @@ let main () = else if !make_package then begin Optcompile.init_path(); let target = extract_output !output_name in - Asmpackager.package_files ppf (List.rev !objfiles) target; + Asmpackager.package_files (List.rev !objfiles) target; end else if !shared then begin Optcompile.init_path(); let target = extract_output !output_name in - Asmlink.link_shared ppf (List.rev !objfiles) target; + Asmlink.link_shared (List.rev !objfiles) target; end else if not !compile_only && !objfiles <> [] then begin let target = @@ -208,11 +207,11 @@ let main () = default_output !output_name in Optcompile.init_path(); - Asmlink.link ppf (List.rev !objfiles) target + Asmlink.link (List.rev !objfiles) target end; exit 0 with x -> - Opterrors.report_error ppf x; + Opterrors.report_error Format.err_formatter x; exit 2 let _ = main () diff --git a/driver/pparse.ml b/driver/pparse.ml index 5d27beeb4..f5ed2d5a6 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -47,7 +47,7 @@ let remove_preprocessed_if_ast inputfile = exception Outdated_version -let file ppf inputfile parse_fun ast_magic = +let file inputfile parse_fun ast_magic = let ic = open_in_bin inputfile in let is_ast_file = try @@ -66,7 +66,7 @@ let file ppf inputfile parse_fun ast_magic = try if is_ast_file then begin if !Clflags.fast then - fprintf ppf "@[Warning: %s@]@." + eprintf "@[Warning: %s@]@." "option -unsafe used with a preprocessor returning a syntax tree"; Location.input_name := input_value ic; input_value ic diff --git a/driver/pparse.mli b/driver/pparse.mli index 96c2594f1..0c70a1db4 100644 --- a/driver/pparse.mli +++ b/driver/pparse.mli @@ -19,4 +19,4 @@ exception Error val preprocess : string -> string val remove_preprocessed : string -> unit val remove_preprocessed_if_ast : string -> unit -val file : formatter -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a +val file : string -> (Lexing.lexbuf -> 'a) -> string -> 'a diff --git a/parsing/location.mli b/parsing/location.mli index 0303c0add..7a07b80f5 100644 --- a/parsing/location.mli +++ b/parsing/location.mli @@ -51,6 +51,9 @@ val print_loc: formatter -> t -> unit val print_error: formatter -> t -> unit val print_error_cur_file: formatter -> unit val print_warning: t -> formatter -> Warnings.t -> unit + (** Used only in the toplevels, for Toploop.print_warning. Do not + use to report warnings in the compiler. *) + val prerr_warning: t -> Warnings.t -> unit val echo_eof: unit -> unit val reset: unit -> unit diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml index 8655ef96b..74de15ee3 100644 --- a/toplevel/opttopdirs.ml +++ b/toplevel/opttopdirs.ml @@ -62,7 +62,7 @@ let load_file ppf name0 = if Filename.check_suffix name ".cmx" || Filename.check_suffix name ".cmxa" then let cmxs = Filename.temp_file "caml" ".cmxs" in - Asmlink.link_shared ppf [name] cmxs; + Asmlink.link_shared [name] cmxs; cmxs,true else name,false in diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 1fa5a3fd0..2321749b4 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -137,7 +137,7 @@ let load_lambda ppf (size, lam) = else Filename.temp_file ("caml" ^ !phrase_name) ext_dll in let fn = Filename.chop_extension dll in - Asmgen.compile_implementation ~toplevel:need_symbol fn ppf (size, lam); + Asmgen.compile_implementation ~toplevel:need_symbol fn (size, lam); Asmlink.call_linker_shared [fn ^ ext_obj] dll; Sys.remove (fn ^ ext_obj); diff --git a/typing/typecore.ml b/typing/typecore.ml index b141d4ed6..1687cf094 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -189,7 +189,8 @@ let iter_expression f e = let free_idents el = let idents = Hashtbl.create 8 in let f = function - | {pexp_desc=Pexp_ident (Longident.Lident id); _} -> Hashtbl.replace idents id () + | {pexp_desc=Pexp_ident (Longident.Lident id); _} -> + Hashtbl.replace idents id () | _ -> () in List.iter (iter_expression f) el; @@ -1382,7 +1383,7 @@ let duplicate_ident_types loc caselist env = let desc = {desc with val_type = correct_levels desc.val_type} in Env.add_value id desc env | _ -> env - with Not_found -> env) + with Not_found | Typetexp.Error (_, Typetexp.Unbound_value _) -> env) env idents (* Typing of expressions *) |