From f14b6f1a17652566f0cbc00ce81421ba0684dad5 Mon Sep 17 00:00:00 2001 From: Pierre Letouzey Date: Mon, 27 Jun 2016 11:03:43 +0200 Subject: errors.ml renamed into cErrors.ml (avoid clash with an OCaml compiler-lib module) For the moment, there is an Error module in compilers-lib/ocamlbytecomp.cm(x)a --- lib/cErrors.ml | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++ lib/cErrors.mli | 99 ++++++++++++++++++++++++++++++++++ lib/cWarnings.ml | 4 +- lib/errors.ml | 148 --------------------------------------------------- lib/errors.mli | 99 ---------------------------------- lib/future.ml | 18 +++---- lib/genarg.ml | 6 +-- lib/lib.mllib | 2 +- lib/profile.ml | 2 +- lib/remoteCounter.ml | 4 +- lib/spawn.ml | 4 +- lib/system.ml | 21 ++++---- 12 files changed, 277 insertions(+), 278 deletions(-) create mode 100644 lib/cErrors.ml create mode 100644 lib/cErrors.mli delete mode 100644 lib/errors.ml delete mode 100644 lib/errors.mli (limited to 'lib') diff --git a/lib/cErrors.ml b/lib/cErrors.ml new file mode 100644 index 0000000000..1459141d1e --- /dev/null +++ b/lib/cErrors.ml @@ -0,0 +1,148 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* Some ("\"Anomaly: " ^ string_of_ppcmds pp ^ "\"") + | _ -> None + in + Printexc.register_printer pr + +let make_anomaly ?label pp = + Anomaly (label, pp) + +let anomaly ?loc ?label pp = match loc with + | None -> raise (Anomaly (label, pp)) + | Some loc -> Loc.raise loc (Anomaly (label, pp)) + +let is_anomaly = function +| Anomaly _ -> true +| _ -> false + +exception UserError of string * std_ppcmds (* User errors *) +let error string = raise (UserError("_", str string)) +let errorlabstrm l pps = raise (UserError(l,pps)) + +exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *) +let alreadydeclared pps = raise (AlreadyDeclared(pps)) + +let todo s = prerr_string ("TODO: "^s^"\n") + +let user_err_loc (loc,s,strm) = Loc.raise loc (UserError (s,strm)) +let invalid_arg_loc (loc,s) = Loc.raise loc (Invalid_argument s) + +exception Timeout +exception Drop +exception Quit + +let handle_stack = ref [] + +exception Unhandled + +let register_handler h = handle_stack := h::!handle_stack + +(** [print_gen] is a general exception printer which tries successively + all the handlers of a list, and finally a [bottom] handler if all + others have failed *) + +let rec print_gen bottom stk e = + match stk with + | [] -> bottom e + | h::stk' -> + try h e + with + | Unhandled -> print_gen bottom stk' e + | any -> print_gen bottom stk' any + +(** Only anomalies should reach the bottom of the handler stack. + In usual situation, the [handle_stack] is treated as it if was always + non-empty with [print_anomaly] as its bottom handler. *) + +let where = function +| None -> mt () +| Some s -> + if !Flags.debug then str "in " ++ str s ++ str ":" ++ spc () else mt () + +let raw_anomaly e = match e with + | Anomaly (s, pps) -> where s ++ pps ++ str "." + | Assert_failure _ | Match_failure _ -> str (Printexc.to_string e) ++ str "." + | _ -> str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "." + +let print_backtrace e = match Backtrace.get_backtrace e with +| None -> mt () +| Some bt -> + let bt = Backtrace.repr bt in + let pr_frame f = str (Backtrace.print_frame f) in + let bt = prlist_with_sep fnl pr_frame bt in + fnl () ++ hov 0 bt + +let print_anomaly askreport e = + if askreport then + hov 0 (str "Anomaly: " ++ raw_anomaly e ++ spc () ++ str "Please report.") + else + hov 0 (raw_anomaly e) + +(** The standard exception printer *) +let print ?(info = Exninfo.null) e = + print_gen (print_anomaly true) !handle_stack e ++ print_backtrace info + +let iprint (e, info) = print ~info e + +(** Same as [print], except that the "Please report" part of an anomaly + isn't printed (used in Ltac debugging). *) +let print_no_report e = print_gen (print_anomaly false) !handle_stack e +let iprint_no_report (e, info) = + print_gen (print_anomaly false) !handle_stack e ++ print_backtrace info + +(** Predefined handlers **) + +let _ = register_handler begin function + | UserError(s, pps) -> + hov 0 (str "Error: " ++ where (Some s) ++ pps) + | _ -> raise Unhandled +end + +(** Critical exceptions should not be caught and ignored by mistake + by inner functions during a [vernacinterp]. They should be handled + only at the very end of interp, to be displayed to the user. *) + +let noncritical = function + | Sys.Break | Out_of_memory | Stack_overflow + | Assert_failure _ | Match_failure _ | Anomaly _ + | Timeout | Drop | Quit -> false + | Invalid_argument "equal: functional value" -> false + | _ -> true + +(** Check whether an exception is handled *) + +exception Bottom + +let handled e = + let bottom _ = raise Bottom in + try let _ = print_gen bottom !handle_stack e in true + with Bottom -> false + +(** Prints info which is either an error or + an anomaly and then exits with the appropriate + error code *) + +let fatal_error info anomaly = + let msg = info ++ fnl () in + pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft msg; + Format.pp_print_flush !Pp_control.err_ft (); + exit (if anomaly then 129 else 1) diff --git a/lib/cErrors.mli b/lib/cErrors.mli new file mode 100644 index 0000000000..e5dad93fd0 --- /dev/null +++ b/lib/cErrors.mli @@ -0,0 +1,99 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* Exninfo.iexn +(** Alias for [Backtrace.add_backtrace]. *) + +(** {6 Generic errors.} + + [Anomaly] is used for system errors and [UserError] for the + user's ones. *) + +val make_anomaly : ?label:string -> std_ppcmds -> exn +(** Create an anomaly. *) + +val anomaly : ?loc:Loc.t -> ?label:string -> std_ppcmds -> 'a +(** Raise an anomaly, with an optional location and an optional + label identifying the anomaly. *) + +val is_anomaly : exn -> bool +(** Check whether a given exception is an anomaly. + This is mostly provided for compatibility. Please avoid doing specific + tricks with anomalies thanks to it. See rather [noncritical] below. *) + +exception UserError of string * std_ppcmds +val error : string -> 'a +val errorlabstrm : string -> std_ppcmds -> 'a +val user_err_loc : Loc.t * string * std_ppcmds -> 'a + +exception AlreadyDeclared of std_ppcmds +val alreadydeclared : std_ppcmds -> 'a + +val invalid_arg_loc : Loc.t * string -> 'a + +(** [todo] is for running of an incomplete code its implementation is + "do nothing" (or print a message), but this function should not be + used in a released code *) + +val todo : string -> unit + +exception Timeout +exception Drop +exception Quit + +(** [register_handler h] registers [h] as a handler. + When an expression is printed with [print e], it + goes through all registered handles (the most + recent first) until a handle deals with it. + + Handles signal that they don't deal with some exception + by raising [Unhandled]. + + Handles can raise exceptions themselves, in which + case, the exception is passed to the handles which + were registered before. + + The exception that are considered anomalies should not be + handled by registered handlers. +*) + +exception Unhandled + +val register_handler : (exn -> Pp.std_ppcmds) -> unit + +(** The standard exception printer *) +val print : ?info:Exninfo.info -> exn -> Pp.std_ppcmds +val iprint : Exninfo.iexn -> Pp.std_ppcmds + +(** Same as [print], except that the "Please report" part of an anomaly + isn't printed (used in Ltac debugging). *) +val print_no_report : exn -> Pp.std_ppcmds +val iprint_no_report : Exninfo.iexn -> Pp.std_ppcmds + +(** Critical exceptions should not be caught and ignored by mistake + by inner functions during a [vernacinterp]. They should be handled + only in [Toplevel.do_vernac] (or Ideslave), to be displayed to the user. + Typical example: [Sys.Break], [Assert_failure], [Anomaly] ... +*) +val noncritical : exn -> bool + +(** Check whether an exception is handled by some toplevel printer. The + [Anomaly] exception is never handled. *) +val handled : exn -> bool + +(** Prints info which is either an error or + an anomaly and then exits with the appropriate + error code *) +val fatal_error : Pp.std_ppcmds -> bool -> 'a diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 68442bd7cc..7b8dc2b9b5 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -45,7 +45,7 @@ let create ~name ~category ?(default=Enabled) pp = | Disabled -> () | AsError -> let loc = Option.default !current_loc loc in - Errors.user_err_loc (loc,"_",pp x) + CErrors.user_err_loc (loc,"_",pp x) | Enabled -> let msg = pp x ++ str " [" ++ str name ++ str "," ++ @@ -80,7 +80,7 @@ let parse_flag s = | '+' -> (AsError, String.sub s 1 (String.length s - 1)) | '-' -> (Disabled, String.sub s 1 (String.length s - 1)) | _ -> (Enabled, s) - else Errors.error "Invalid warnings flag" + else CErrors.error "Invalid warnings flag" let rec do_all_keyword = function | [] -> [] diff --git a/lib/errors.ml b/lib/errors.ml deleted file mode 100644 index 1459141d1e..0000000000 --- a/lib/errors.ml +++ /dev/null @@ -1,148 +0,0 @@ -(***********************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Some ("\"Anomaly: " ^ string_of_ppcmds pp ^ "\"") - | _ -> None - in - Printexc.register_printer pr - -let make_anomaly ?label pp = - Anomaly (label, pp) - -let anomaly ?loc ?label pp = match loc with - | None -> raise (Anomaly (label, pp)) - | Some loc -> Loc.raise loc (Anomaly (label, pp)) - -let is_anomaly = function -| Anomaly _ -> true -| _ -> false - -exception UserError of string * std_ppcmds (* User errors *) -let error string = raise (UserError("_", str string)) -let errorlabstrm l pps = raise (UserError(l,pps)) - -exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *) -let alreadydeclared pps = raise (AlreadyDeclared(pps)) - -let todo s = prerr_string ("TODO: "^s^"\n") - -let user_err_loc (loc,s,strm) = Loc.raise loc (UserError (s,strm)) -let invalid_arg_loc (loc,s) = Loc.raise loc (Invalid_argument s) - -exception Timeout -exception Drop -exception Quit - -let handle_stack = ref [] - -exception Unhandled - -let register_handler h = handle_stack := h::!handle_stack - -(** [print_gen] is a general exception printer which tries successively - all the handlers of a list, and finally a [bottom] handler if all - others have failed *) - -let rec print_gen bottom stk e = - match stk with - | [] -> bottom e - | h::stk' -> - try h e - with - | Unhandled -> print_gen bottom stk' e - | any -> print_gen bottom stk' any - -(** Only anomalies should reach the bottom of the handler stack. - In usual situation, the [handle_stack] is treated as it if was always - non-empty with [print_anomaly] as its bottom handler. *) - -let where = function -| None -> mt () -| Some s -> - if !Flags.debug then str "in " ++ str s ++ str ":" ++ spc () else mt () - -let raw_anomaly e = match e with - | Anomaly (s, pps) -> where s ++ pps ++ str "." - | Assert_failure _ | Match_failure _ -> str (Printexc.to_string e) ++ str "." - | _ -> str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "." - -let print_backtrace e = match Backtrace.get_backtrace e with -| None -> mt () -| Some bt -> - let bt = Backtrace.repr bt in - let pr_frame f = str (Backtrace.print_frame f) in - let bt = prlist_with_sep fnl pr_frame bt in - fnl () ++ hov 0 bt - -let print_anomaly askreport e = - if askreport then - hov 0 (str "Anomaly: " ++ raw_anomaly e ++ spc () ++ str "Please report.") - else - hov 0 (raw_anomaly e) - -(** The standard exception printer *) -let print ?(info = Exninfo.null) e = - print_gen (print_anomaly true) !handle_stack e ++ print_backtrace info - -let iprint (e, info) = print ~info e - -(** Same as [print], except that the "Please report" part of an anomaly - isn't printed (used in Ltac debugging). *) -let print_no_report e = print_gen (print_anomaly false) !handle_stack e -let iprint_no_report (e, info) = - print_gen (print_anomaly false) !handle_stack e ++ print_backtrace info - -(** Predefined handlers **) - -let _ = register_handler begin function - | UserError(s, pps) -> - hov 0 (str "Error: " ++ where (Some s) ++ pps) - | _ -> raise Unhandled -end - -(** Critical exceptions should not be caught and ignored by mistake - by inner functions during a [vernacinterp]. They should be handled - only at the very end of interp, to be displayed to the user. *) - -let noncritical = function - | Sys.Break | Out_of_memory | Stack_overflow - | Assert_failure _ | Match_failure _ | Anomaly _ - | Timeout | Drop | Quit -> false - | Invalid_argument "equal: functional value" -> false - | _ -> true - -(** Check whether an exception is handled *) - -exception Bottom - -let handled e = - let bottom _ = raise Bottom in - try let _ = print_gen bottom !handle_stack e in true - with Bottom -> false - -(** Prints info which is either an error or - an anomaly and then exits with the appropriate - error code *) - -let fatal_error info anomaly = - let msg = info ++ fnl () in - pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft msg; - Format.pp_print_flush !Pp_control.err_ft (); - exit (if anomaly then 129 else 1) diff --git a/lib/errors.mli b/lib/errors.mli deleted file mode 100644 index e5dad93fd0..0000000000 --- a/lib/errors.mli +++ /dev/null @@ -1,99 +0,0 @@ -(***********************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Exninfo.iexn -(** Alias for [Backtrace.add_backtrace]. *) - -(** {6 Generic errors.} - - [Anomaly] is used for system errors and [UserError] for the - user's ones. *) - -val make_anomaly : ?label:string -> std_ppcmds -> exn -(** Create an anomaly. *) - -val anomaly : ?loc:Loc.t -> ?label:string -> std_ppcmds -> 'a -(** Raise an anomaly, with an optional location and an optional - label identifying the anomaly. *) - -val is_anomaly : exn -> bool -(** Check whether a given exception is an anomaly. - This is mostly provided for compatibility. Please avoid doing specific - tricks with anomalies thanks to it. See rather [noncritical] below. *) - -exception UserError of string * std_ppcmds -val error : string -> 'a -val errorlabstrm : string -> std_ppcmds -> 'a -val user_err_loc : Loc.t * string * std_ppcmds -> 'a - -exception AlreadyDeclared of std_ppcmds -val alreadydeclared : std_ppcmds -> 'a - -val invalid_arg_loc : Loc.t * string -> 'a - -(** [todo] is for running of an incomplete code its implementation is - "do nothing" (or print a message), but this function should not be - used in a released code *) - -val todo : string -> unit - -exception Timeout -exception Drop -exception Quit - -(** [register_handler h] registers [h] as a handler. - When an expression is printed with [print e], it - goes through all registered handles (the most - recent first) until a handle deals with it. - - Handles signal that they don't deal with some exception - by raising [Unhandled]. - - Handles can raise exceptions themselves, in which - case, the exception is passed to the handles which - were registered before. - - The exception that are considered anomalies should not be - handled by registered handlers. -*) - -exception Unhandled - -val register_handler : (exn -> Pp.std_ppcmds) -> unit - -(** The standard exception printer *) -val print : ?info:Exninfo.info -> exn -> Pp.std_ppcmds -val iprint : Exninfo.iexn -> Pp.std_ppcmds - -(** Same as [print], except that the "Please report" part of an anomaly - isn't printed (used in Ltac debugging). *) -val print_no_report : exn -> Pp.std_ppcmds -val iprint_no_report : Exninfo.iexn -> Pp.std_ppcmds - -(** Critical exceptions should not be caught and ignored by mistake - by inner functions during a [vernacinterp]. They should be handled - only in [Toplevel.do_vernac] (or Ideslave), to be displayed to the user. - Typical example: [Sys.Break], [Assert_failure], [Anomaly] ... -*) -val noncritical : exn -> bool - -(** Check whether an exception is handled by some toplevel printer. The - [Anomaly] exception is never handled. *) -val handled : exn -> bool - -(** Prints info which is either an error or - an anomaly and then exits with the appropriate - error code *) -val fatal_error : Pp.std_ppcmds -> bool -> 'a diff --git a/lib/future.ml b/lib/future.ml index 9cdc1c20e3..ea0382a63d 100644 --- a/lib/future.ml +++ b/lib/future.ml @@ -30,10 +30,10 @@ let customize_not_here_msg f = not_here_msg := f exception NotReady of string exception NotHere of string -let _ = Errors.register_handler (function +let _ = CErrors.register_handler (function | NotReady name -> !not_ready_msg name | NotHere name -> !not_here_msg name - | _ -> raise Errors.Unhandled) + | _ -> raise CErrors.Unhandled) type fix_exn = Exninfo.iexn -> Exninfo.iexn let id x = prerr_endline "Future: no fix_exn.\nYou have probably created a Future.computation from a value without passing the ~fix_exn argument. You probably want to chain with an already existing future instead."; x @@ -136,7 +136,7 @@ let rec compute ~pure ck : 'a value = let state = if pure then None else Some (!freeze ()) in c := Val (data, state); `Val data with e -> - let e = Errors.push e in + let e = CErrors.push e in let e = fix_exn e in match e with | (NotReady _, _) -> `Exn e @@ -156,9 +156,9 @@ let chain ~pure ck f = | Val (v, Some state) -> Closure (fun () -> !unfreeze state; f v) | Val (v, None) -> match !ck with - | Finished _ -> Errors.anomaly(Pp.str + | Finished _ -> CErrors.anomaly(Pp.str "Future.chain ~pure:false call on an already joined computation") - | Ongoing _ -> Errors.anomaly(Pp.strbrk( + | Ongoing _ -> CErrors.anomaly(Pp.strbrk( "Future.chain ~pure:false call on a pure computation. "^ "This can happen if the computation was initial created with "^ "Future.from_val or if it was Future.chain ~pure:true with a "^ @@ -170,7 +170,7 @@ let replace kx y = let _, _, _, x = get kx in match !x with | Exn _ -> x := Closure (fun () -> force ~pure:false y) - | _ -> Errors.anomaly + | _ -> CErrors.anomaly (Pp.str "A computation can be replaced only if is_exn holds") let purify f x = @@ -180,13 +180,13 @@ let purify f x = !unfreeze state; v with e -> - let e = Errors.push e in !unfreeze state; Exninfo.iraise e + let e = CErrors.push e in !unfreeze state; Exninfo.iraise e let transactify f x = let state = !freeze () in try f x with e -> - let e = Errors.push e in !unfreeze state; Exninfo.iraise e + let e = CErrors.push e in !unfreeze state; Exninfo.iraise e let purify_future f x = if is_over x then f x else purify f x let compute x = purify_future (compute ~pure:false) x @@ -213,7 +213,7 @@ let map2 ?greedy f x l = let xi = chain ?greedy ~pure:true x (fun x -> try List.nth x i with Failure _ | Invalid_argument _ -> - Errors.anomaly (Pp.str "Future.map2 length mismatch")) in + CErrors.anomaly (Pp.str "Future.map2 length mismatch")) in f xi y) 0 l let print f kx = diff --git a/lib/genarg.ml b/lib/genarg.ml index 69408fb1a5..05c828d5f9 100644 --- a/lib/genarg.ml +++ b/lib/genarg.ml @@ -159,7 +159,7 @@ let create_arg name = match ArgT.name name with | None -> ExtraArg (ArgT.create name) | Some _ -> - Errors.anomaly (str "generic argument already declared: " ++ str name) + CErrors.anomaly (str "generic argument already declared: " ++ str name) let make0 = create_arg @@ -181,7 +181,7 @@ struct | ExtraArg s -> if GenMap.mem s !arg0_map then let msg = str M.name ++ str " function already registered: " ++ str (ArgT.repr s) in - Errors.anomaly msg + CErrors.anomaly msg else arg0_map := GenMap.add s (GenMap.Pack f) !arg0_map | _ -> assert false @@ -192,7 +192,7 @@ struct with Not_found -> match M.default (ExtraArg name) with | None -> - Errors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name)) + CErrors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name)) | Some obj -> obj (** For now, the following function is quite dummy and should only be applied diff --git a/lib/lib.mllib b/lib/lib.mllib index 4b13156d60..8791f07417 100644 --- a/lib/lib.mllib +++ b/lib/lib.mllib @@ -1,4 +1,4 @@ -Errors +CErrors CWarnings Bigint Segmenttree diff --git a/lib/profile.ml b/lib/profile.ml index 2350cd43ac..0910db3fe2 100644 --- a/lib/profile.ml +++ b/lib/profile.ml @@ -260,7 +260,7 @@ let time_overhead_B_C () = let _dw = dummy_spent_alloc () in let _dt = get_time () in () - with e when Errors.noncritical e -> assert false + with e when CErrors.noncritical e -> assert false done; let after = get_time () in let beforeloop = get_time () in diff --git a/lib/remoteCounter.ml b/lib/remoteCounter.ml index 6cc48c8745..e7646fb796 100644 --- a/lib/remoteCounter.ml +++ b/lib/remoteCounter.ml @@ -25,7 +25,7 @@ let new_counter ~name a ~incr ~build = (* - in the main process there is a race condition between slave managers (that are threads) and the main thread, hence the mutex *) if Flags.async_proofs_is_worker () then - Errors.anomaly(Pp.str"Slave processes must install remote counters"); + CErrors.anomaly(Pp.str"Slave processes must install remote counters"); Mutex.lock m; let x = f () in Mutex.unlock m; build x in let mk_thsafe_remote_getter f () = @@ -33,7 +33,7 @@ let new_counter ~name a ~incr ~build = let getter = ref(mk_thsafe_local_getter (fun () -> !data := incr !!data; !!data)) in let installer f = if not (Flags.async_proofs_is_worker ()) then - Errors.anomaly(Pp.str"Only slave processes can install a remote counter"); + CErrors.anomaly(Pp.str"Only slave processes can install a remote counter"); getter := mk_thsafe_remote_getter f in (fun () -> !getter ()), installer diff --git a/lib/spawn.ml b/lib/spawn.ml index 2b9c4ccac1..4791769735 100644 --- a/lib/spawn.ml +++ b/lib/spawn.ml @@ -43,7 +43,7 @@ module type MainLoopModel = sig end (* Common code *) -let assert_ b s = if not b then Errors.anomaly (Pp.str s) +let assert_ b s = if not b then CErrors.anomaly (Pp.str s) (* According to http://caml.inria.fr/mantis/view.php?id=5325 * you can't use the same socket for both writing and reading (may change @@ -192,7 +192,7 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ()) let live = callback cl ~read_all:(fun () -> ML.read_all gchan) in if not live then kill p; live - with e when Errors.noncritical e -> + with e when CErrors.noncritical e -> pr_err ("Async reader raised: " ^ (Printexc.to_string e)); kill p; false) gchan diff --git a/lib/system.ml b/lib/system.ml index b27918522c..af9aa5c074 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -9,7 +9,6 @@ (* $Id$ *) open Pp -open Errors open Util include Minisys @@ -133,7 +132,7 @@ let find_file_in_path ?(warn=true) paths filename = let root = Filename.dirname filename in root, filename else - errorlabstrm "System.find_file_in_path" + CErrors.errorlabstrm "System.find_file_in_path" (hov 0 (str "Can't find file" ++ spc () ++ str filename)) else (* the name is considered to be the transcription as a relative @@ -141,7 +140,7 @@ let find_file_in_path ?(warn=true) paths filename = to be locate respecting case *) try where_in_path ~warn paths filename with Not_found -> - errorlabstrm "System.find_file_in_path" + CErrors.errorlabstrm "System.find_file_in_path" (hov 0 (str "Can't find file" ++ spc () ++ str filename ++ spc () ++ str "on loadpath")) @@ -163,8 +162,8 @@ let is_in_system_path filename = let open_trapping_failure name = try open_out_bin name - with e when Errors.noncritical e -> - errorlabstrm "System.open" (str "Can't open " ++ str name) + with e when CErrors.noncritical e -> + CErrors.errorlabstrm "System.open" (str "Can't open " ++ str name) let warn_cannot_remove_file = CWarnings.create ~name:"cannot-remove-file" ~category:"filesystem" @@ -172,11 +171,11 @@ let warn_cannot_remove_file = let try_remove filename = try Sys.remove filename - with e when Errors.noncritical e -> + with e when CErrors.noncritical e -> warn_cannot_remove_file filename let error_corrupted file s = - errorlabstrm "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.") + CErrors.errorlabstrm "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.") let input_binary_int f ch = try input_binary_int ch @@ -249,11 +248,11 @@ let extern_state magic filename val_0 = marshal_out channel val_0; close_out channel with reraise -> - let reraise = Errors.push reraise in + let reraise = CErrors.push reraise in let () = try_remove filename in iraise reraise with Sys_error s -> - errorlabstrm "System.extern_state" (str "System error: " ++ str s) + CErrors.errorlabstrm "System.extern_state" (str "System error: " ++ str s) let intern_state magic filename = try @@ -262,12 +261,12 @@ let intern_state magic filename = close_in channel; v with Sys_error s -> - errorlabstrm "System.intern_state" (str "System error: " ++ str s) + CErrors.errorlabstrm "System.intern_state" (str "System error: " ++ str s) let with_magic_number_check f a = try f a with Bad_magic_number {filename=fname;actual=actual;expected=expected} -> - errorlabstrm "with_magic_number_check" + CErrors.errorlabstrm "with_magic_number_check" (str"File " ++ str fname ++ strbrk" has bad magic number " ++ int actual ++ str" (expected " ++ int expected ++ str")." ++ spc () ++ -- cgit v1.2.3