blob: bb0be8b449bf8991f0715d6045156e6167a8d184 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
(***********************************************************************)
(* *)
(* 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
|
