diff options
Diffstat (limited to 'lib/cErrors.ml')
| -rw-r--r-- | lib/cErrors.ml | 45 |
1 files changed, 12 insertions, 33 deletions
diff --git a/lib/cErrors.ml b/lib/cErrors.ml index 5c56192fc5..99b763602d 100644 --- a/lib/cErrors.ml +++ b/lib/cErrors.ml @@ -16,16 +16,6 @@ let push = Backtrace.add_backtrace exception Anomaly of string option * std_ppcmds (* System errors *) -(* XXX: To move to common tagging functions in Pp, blocked on tag - * system cleanup as we cannot define generic error tags now. - * - * Anyways, tagging should not happen here, but in the specific - * listener to the msg_* stuff. - *) -let tag_err_str s = tag Ppstyle.(Tag.inj error_tag tag) (str s) ++ spc () -let err_str = tag_err_str "Error:" -let ann_str = tag_err_str "Anomaly:" - let _ = let pr = function | Anomaly (s, pp) -> Some ("\"Anomaly: " ^ string_of_ppcmds pp ^ "\"") @@ -36,25 +26,24 @@ let _ = 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 anomaly ?loc ?label pp = + 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)) +exception UserError of string option * std_ppcmds (* User errors *) 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) +let user_err ?loc ?hdr strm = Loc.raise ?loc (UserError (hdr, 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 @@ -103,7 +92,7 @@ let print_backtrace e = match Backtrace.get_backtrace e with let print_anomaly askreport e = if askreport then - hov 0 (ann_str ++ raw_anomaly e ++ spc () ++ + hov 0 (raw_anomaly e ++ spc () ++ strbrk "Please report at " ++ str Coq_config.wwwbugtracker ++ str ".") else @@ -125,7 +114,7 @@ let iprint_no_report (e, info) = let _ = register_handler begin function | UserError(s, pps) -> - hov 0 (err_str ++ where (Some s) ++ pps) + hov 0 (where s ++ pps) | _ -> raise Unhandled end @@ -148,13 +137,3 @@ 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) |