1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Caml Special Light *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1995 Institut National de Recherche en Informatique et *)
|
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
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)
|
1995-07-28 05:23:42 -07:00
|
|
|
else if Obj.tag arg = 252 then begin
|
1995-05-04 03:15:53 -07:00
|
|
|
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;
|
1995-11-15 01:33:15 -08:00
|
|
|
flush stderr;
|
1995-05-04 03:15:53 -07:00
|
|
|
raise x
|
|
|
|
|
|
|
|
let catch fct arg =
|
|
|
|
try
|
|
|
|
fct arg
|
|
|
|
with x ->
|
|
|
|
flush stdout;
|
|
|
|
print_exn x;
|
|
|
|
exit 2
|