Source

spotlib / lib / exn.ml

let failwithf fmt = Printf.kprintf failwith fmt
let invalid_argf fmt = Printf.kprintf invalid_arg fmt

exception Finally of exn * exn
;;

(* CR jfuruse: looks lousy... *)
let protect ~f v ~(finally : 'a -> unit) =
  let res =
    try f v
    with exn ->
      (try finally v with final_exn -> raise (Finally (exn, final_exn)));
      raise exn
  in
  finally v;
  res
;;

let catch ~f v = try `Ok (f v) with e -> `Error e;;
let try_ignore ~f v = try f v with _ -> ();;
let try_default ~default ~f v = try f v with _ -> default v;;
let try_bool ~f v = try ignore (f v); true with _ -> false

let with_final v f final = protect ~f ~finally:final v

let protect' f ~(finally : unit -> unit) =
  let res =
    try f ()
    with exn ->
      (try finally () with final_exn -> raise (Finally (exn, final_exn)));
      raise exn
  in
  finally ();
  res
;;

let catch' f = try `Ok (f ()) with e -> `Error e
let try_ignore' f = try f () with _ -> ()
let try_default' ~default f = try f () with _ -> default ();;
let try_bool' f = try ignore (f ()); true with _ -> false

(* Printexc 

   Printexc has a very bad name. Printexc for exn ?
*)
let to_string        = Printexc.to_string
let format ppf t     = Format.pp_print_string ppf (Printexc.to_string t)
let print_backtrace  = Printexc.print_backtrace
let get_backtrace    = Printexc.get_backtrace
let register_printer = Printexc.register_printer