summaryrefslogtreecommitdiff
path: root/exn_handler.fun
blob: b95e847995ec050573ce7ea5699546b64dcd76d4 (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
functor ExnHandler(structure T: TOKENIZER; structure P: PPC):
    EXN_HANDLER =
struct

  fun eprint s = printf `"error: " `s %

  fun otherExn e =
  let
    val hist = MLton.Exn.history e
  in
    eprint $ "exception " ^ exnMessage e ^ " was raised";
    if hist = [] then
      (output "No stack trace is avaliable\n";
      output "Recompile with -const \"Exn.keepHistory true\"\n")
    else
      List.app (fn x => printf `"\t" `x `"\n" %) 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
    printf `prefix `reason `"\n" %
  end
    | ioExn _ = (output "ioExn: unreachable\n"; exit 254)

  fun handler e =
    (case e of
      T.FsmTableIsTooSmall =>
          eprint "fsm table is too small. Increate 'maxState' value"
    | IO.Io _ => ioExn e
    | T.TkErrorAug (pos, msg) => eprint $ T.S.pos2str pos ^ ": " ^ msg
    | P.TkError v => P.tkErrorPrint v
    | _ => otherExn e;
    exit 255)
end