blob: b4e727525f57b2e588fc2bc2c92f3bdb7a0a74b7 (
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
|
functor ExnHandler(structure T: TOKENIZER; structure P: PPC):
EXN_HANDLER =
struct
val eprintf = fn z => printf `"error: " z
fun otherExn e =
let
val hist = MLton.Exn.history e
in
eprintf `"exception " `(exnMessage e) `" was raised\n";
if hist = [] then
printf
`"No stack trace is avaliable\n"
`"Recompile with -const \"Exn.keepHistory true\"\n" %
else
List.app (fn x => printf `"\t" `x `"\n" %) hist
end
fun ioExn (IO.Io { name, function = _, cause }) =
let
val reason =
case cause of
OS.SysErr (str, _) => str
| _ => exnMessage cause
in
eprintf `name `": " `reason `"\n" %
end
| ioExn _ = die 126 `"ioExn: unreachable\n" %
fun handler e = (
printf `"\n";
case e of
T.FsmTableIsTooSmall =>
eprintf `"fsm table is too small. Increate 'maxState' value\n" %
| IO.Io _ => ioExn e
| T.TkErrorAug (pos, msg) => eprintf T.S.Ppos pos `": " `msg `"\n" %
| P.TkError v => P.tkErrorPrint v
| P.TkClassError v => P.tkClassErrorPrint v
| _ => otherExn e;
exit 1
) handle _ => sysExit 127
end
|
