ocaml/stdlib/printexc.ml

58 lines
1.9 KiB
OCaml
Raw Normal View History

(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
let print_exn = function
Out_of_memory ->
prerr_string "Out of memory\n"
| Match_failure(file, first_char, last_char) ->
prerr_string "Pattern matching failed, file ";
prerr_string file;
prerr_string ", chars "; prerr_int first_char;
prerr_char '-'; prerr_int last_char; prerr_char '\n'
| x ->
prerr_string "Uncaught exception: ";
prerr_string (Obj.magic(Obj.field (Obj.field (Obj.repr x) 0) 0));
if Obj.size (Obj.repr x) > 1 then begin
prerr_char '(';
for i = 1 to Obj.size (Obj.repr x) - 1 do
if i > 1 then prerr_string ", ";
let arg = Obj.field (Obj.repr x) i in
if not (Obj.is_block arg) then
prerr_int (Obj.magic arg : int)
else if Obj.tag arg = 252 then begin
prerr_char '"';
prerr_string (Obj.magic arg : string);
prerr_char '"'
end else
prerr_char '_'
done;
prerr_char ')'
end;
prerr_char '\n'
let print fct arg =
try
fct arg
with x ->
print_exn x;
flush stderr;
raise x
let catch fct arg =
try
fct arg
with x ->
flush stdout;
print_exn x;
exit 2