stdlib/printexc.ml


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

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;
    raise x

let catch fct arg =
  try
    fct arg
  with x ->
    flush stdout;
    print_exn x;
    exit 2