aboutsummaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
authorGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2016-08-19 01:58:04 +0200
committerGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2016-08-19 02:01:56 +0200
commit543ee0c7ad43874c577416af9f2e5a94d7d1e4d3 (patch)
treecaf22d0e607ed9e0bf9ba64d76b4c2aebce63d5a /lib
parentde038270f72214b169d056642eb7144a79e6f126 (diff)
Remove errorlabstrm in favor of user_err
As noted by @ppedrot, the first is redundant. The patch is basically a renaming. We didn't make the component optional yet, but this could happen in a future patch.
Diffstat (limited to 'lib')
-rw-r--r--lib/cErrors.ml10
-rw-r--r--lib/cErrors.mli7
-rw-r--r--lib/system.ml14
3 files changed, 17 insertions, 14 deletions
diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index c5f262373..830a9e3ce 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -34,17 +34,17 @@ let is_anomaly = function
| _ -> 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 s strm = Loc.raise ?loc (UserError (s,strm))
+let error string = user_err "_" (str string)
+
let invalid_arg ?loc s = Loc.raise ?loc (Invalid_argument s)
+exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *)
+let alreadydeclared pps = raise (AlreadyDeclared(pps))
+
exception Timeout
exception Drop
exception Quit
diff --git a/lib/cErrors.mli b/lib/cErrors.mli
index 291c39b84..ad17be393 100644
--- a/lib/cErrors.mli
+++ b/lib/cErrors.mli
@@ -34,10 +34,13 @@ val is_anomaly : exn -> bool
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
+(** Main error raising primitive. [user_err ?loc c pp] signals an
+ error [pp] in component [c], with optional location [loc] *)
+
+val error : string -> 'a
+(** [error s] just calls [user_error "_" (str s)] *)
exception AlreadyDeclared of std_ppcmds
val alreadydeclared : std_ppcmds -> 'a
diff --git a/lib/system.ml b/lib/system.ml
index af9aa5c07..916c08795 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -132,7 +132,7 @@ let find_file_in_path ?(warn=true) paths filename =
let root = Filename.dirname filename in
root, filename
else
- CErrors.errorlabstrm "System.find_file_in_path"
+ CErrors.user_err "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
@@ -140,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 ->
- CErrors.errorlabstrm "System.find_file_in_path"
+ CErrors.user_err "System.find_file_in_path"
(hov 0 (str "Can't find file" ++ spc () ++ str filename ++ spc () ++
str "on loadpath"))
@@ -163,7 +163,7 @@ let is_in_system_path filename =
let open_trapping_failure name =
try open_out_bin name
with e when CErrors.noncritical e ->
- CErrors.errorlabstrm "System.open" (str "Can't open " ++ str name)
+ CErrors.user_err "System.open" (str "Can't open " ++ str name)
let warn_cannot_remove_file =
CWarnings.create ~name:"cannot-remove-file" ~category:"filesystem"
@@ -175,7 +175,7 @@ let try_remove filename =
warn_cannot_remove_file filename
let error_corrupted file s =
- CErrors.errorlabstrm "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
+ CErrors.user_err "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
let input_binary_int f ch =
try input_binary_int ch
@@ -252,7 +252,7 @@ let extern_state magic filename val_0 =
let () = try_remove filename in
iraise reraise
with Sys_error s ->
- CErrors.errorlabstrm "System.extern_state" (str "System error: " ++ str s)
+ CErrors.user_err "System.extern_state" (str "System error: " ++ str s)
let intern_state magic filename =
try
@@ -261,12 +261,12 @@ let intern_state magic filename =
close_in channel;
v
with Sys_error s ->
- CErrors.errorlabstrm "System.intern_state" (str "System error: " ++ str s)
+ CErrors.user_err "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} ->
- CErrors.errorlabstrm "with_magic_number_check"
+ CErrors.user_err "with_magic_number_check"
(str"File " ++ str fname ++ strbrk" has bad magic number " ++
int actual ++ str" (expected " ++ int expected ++ str")." ++
spc () ++