wrapper/error.ml

   1 let exit_flag = ref true
   2
   3 let exit_if_error () = exit_flag := true
   4
   5 let resume_if_error () = exit_flag := false
   6
   7 exception Error of Position.t list * string
   8
   9 let print_error positions msg =
  10   Printf.sprintf "%s%s"
  11     (String.concat "\n"
  12        (List.map (fun p -> Position.string_of_pos p ^": ") positions))
  13     msg
  14
  15 let error_alert positions msg =
  16   if !exit_flag then (
  17     output_string stderr (print_error positions msg);
  18     exit 1
  19   )
  20   else raise (Error (positions, msg))
  21
  22 let global_error kind msg =
  23   error_alert [] (Printf.sprintf "Global Error (%s):\n  %s\n"  kind msg)
  24
  25 let error kind pos msg =
  26   error_alert [pos] (Printf.sprintf "Error (%s):\n  %s\n" kind msg)
  27
  28 let error2 kind pos1 pos2 msg =
  29   error_alert [pos1; pos2] (Printf.sprintf "Error (%s):\n  %s\n" kind msg)
  30
  31 let warning kind msg =
  32   let mem_flag = !exit_flag in
  33   exit_flag := false;
  34   (try
  35     error_alert [] (Printf.sprintf "Warning (%s):\n  %s\n"  kind msg)
  36   with Error (positions, msg) ->
  37     output_string stderr (print_error positions msg));
  38   exit_flag := mem_flag