blob: 50fb8dcbfdc002fb026cb57f9730d2b3f666d3fd (
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
|
structure GlobalExnHandler: sig val handler: exn -> unit end = struct
fun eprint s = printLn $ "error: " ^ s
fun otherExn e =
let
val hist = MLton.Exn.history e
in
eprint $ "exception " ^ exnMessage e ^ " was raised";
if hist = [] then
(printLn "No stack trace is avaliable";
printLn "Recompile with -const \"Exn.keepHistory true\"")
else
List.app (fn x => printLn $ "\t" ^ x) hist
end
fun exit code = Posix.Process.exit $ Word8.fromInt code
fun ioExn (IO.Io { name, function = _, cause }) =
let
val prefix = name ^ ": "
val reason =
case cause of
OS.SysErr (str, _) => str
| _ => exnMessage cause
in
printLn $ prefix ^ reason
end
| ioExn _ = (printLn "ioExn: unreachable"; exit 254)
fun handler e =
let
open Tokenizer Cpp
in
(case e of
FsmTableIsTooSmall =>
eprint "fsm table is too small. Increate 'maxState' value"
| IO.Io _ => ioExn e
| TkErrorAug (pos, msg) => eprint $ Stream.ppos2str pos ^ ": " ^ msg
| TkExpected v => tkExpectedPrint v
| _ => otherExn e;
exit 255)
end
end
val () = MLton.Exn.setTopLevelHandler GlobalExnHandler.handler
|
