62498
|
1 |
(* Title: Pure/ML/exn_debugger.ML
|
|
2 |
Author: Makarius
|
|
3 |
|
|
4 |
Detailed exception trace via ML debugger.
|
|
5 |
*)
|
|
6 |
|
|
7 |
signature EXN_DEBUGGER =
|
|
8 |
sig
|
|
9 |
val capture_exception_trace: (unit -> 'a) -> (string * ML_Debugger.location) list * 'a Exn.result
|
|
10 |
end;
|
|
11 |
|
|
12 |
structure Exn_Debugger: EXN_DEBUGGER =
|
|
13 |
struct
|
|
14 |
|
|
15 |
(* thread data *)
|
|
16 |
|
|
17 |
local
|
|
18 |
val tag = Universal.tag () : ((string * ML_Debugger.location) * exn) list option Universal.tag;
|
|
19 |
in
|
|
20 |
|
|
21 |
fun start_trace () = Thread.setLocal (tag, SOME []);
|
|
22 |
|
|
23 |
fun update_trace entry exn =
|
|
24 |
(case Thread.getLocal tag of
|
|
25 |
SOME (SOME trace) => Thread.setLocal (tag, SOME ((entry, exn) :: trace))
|
|
26 |
| _ => ());
|
|
27 |
|
|
28 |
fun stop_trace () =
|
|
29 |
let
|
|
30 |
val trace = (case Thread.getLocal tag of SOME (SOME trace) => trace | _ => []);
|
|
31 |
val _ = Thread.setLocal (tag, NONE);
|
|
32 |
in trace end;
|
|
33 |
|
|
34 |
val _ = ML_Debugger.on_exit_exception (SOME update_trace);
|
|
35 |
|
|
36 |
end;
|
|
37 |
|
|
38 |
|
|
39 |
(* capture exception trace *)
|
|
40 |
|
|
41 |
local
|
|
42 |
fun eq_exn exns =
|
62516
|
43 |
op = (apply2 General.exnName exns) andalso op = (apply2 Exn_Properties.position exns);
|
62498
|
44 |
in
|
|
45 |
|
|
46 |
fun capture_exception_trace e =
|
|
47 |
uninterruptible (fn restore_attributes => fn () =>
|
|
48 |
let
|
|
49 |
val _ = start_trace ();
|
|
50 |
val result = Exn.interruptible_capture (restore_attributes e) ();
|
|
51 |
val trace = stop_trace ();
|
|
52 |
val trace' =
|
|
53 |
(case result of
|
|
54 |
Exn.Res _ => []
|
|
55 |
| Exn.Exn exn =>
|
|
56 |
trace
|
|
57 |
|> map_filter (fn (entry, e) => if eq_exn (exn, e) then SOME entry else NONE)
|
|
58 |
|> rev);
|
|
59 |
in (trace', result) end) ();
|
|
60 |
|
|
61 |
end;
|
|
62 |
|
|
63 |
end;
|