diff options
author | Maxime Dénès <mail@maximedenes.fr> | 2016-07-03 18:54:06 +0200 |
---|---|---|
committer | Maxime Dénès <mail@maximedenes.fr> | 2016-07-03 18:54:06 +0200 |
commit | e278d031a1d9a7bf3de463d3d415065299c99395 (patch) | |
tree | ddd3a123e1887a9fa4634af7559bc7bb67b0cc25 /lib | |
parent | d7664c0530edd196d52e9fd8a4b925dbfefd1b9b (diff) | |
parent | 3ce70f21a18cc19e720e8ac54b93652527881942 (diff) |
Merge branch 'cerrors-cclosure' into trunk
Was PR#226: CErrors & CClosure
Diffstat (limited to 'lib')
-rw-r--r-- | lib/cErrors.ml (renamed from lib/errors.ml) | 0 | ||||
-rw-r--r-- | lib/cErrors.mli (renamed from lib/errors.mli) | 0 | ||||
-rw-r--r-- | lib/cWarnings.ml | 4 | ||||
-rw-r--r-- | lib/future.ml | 18 | ||||
-rw-r--r-- | lib/genarg.ml | 6 | ||||
-rw-r--r-- | lib/lib.mllib | 2 | ||||
-rw-r--r-- | lib/profile.ml | 2 | ||||
-rw-r--r-- | lib/remoteCounter.ml | 4 | ||||
-rw-r--r-- | lib/spawn.ml | 4 | ||||
-rw-r--r-- | lib/system.ml | 21 |
10 files changed, 30 insertions, 31 deletions
diff --git a/lib/errors.ml b/lib/cErrors.ml index 1459141d1..1459141d1 100644 --- a/lib/errors.ml +++ b/lib/cErrors.ml diff --git a/lib/errors.mli b/lib/cErrors.mli index e5dad93fd..e5dad93fd 100644 --- a/lib/errors.mli +++ b/lib/cErrors.mli diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 68442bd7c..7b8dc2b9b 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/future.ml b/lib/future.ml index 9cdc1c20e..ea0382a63 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 69408fb1a..05c828d5f 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 4b13156d6..8791f0741 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 2350cd43a..0910db3fe 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 6cc48c874..e7646fb79 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 2b9c4ccac..479176973 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 b27918522..af9aa5c07 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 () ++ |