Partition into structures

1 files changed, 46 insertions, 0 deletions

diff --git a/exn_handler.sml b/exn_handler.sml
new file mode 100644
index 0000000..2e3a0b2
--- /dev/null
+++ b/exn_handler.sml
@@ -0,0 +1,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
+    open OS
+    val prefix = name ^ ": "
+    val reason =
+      case cause of
+        SysErr (str, _) => str
+      | _ => exnMessage cause
+  in
+    printLn $ prefix ^ reason
+  end
+    | ioExn _ = (printLn "ioExn: unreachable"; exit 254)
+
+  fun handler e =
+  let
+    open Tokenizer
+  in
+    (case e of
+      FsmTableIsTooSmall =>
+          eprint "fsm table is too small. Increate 'maxState' value"
+    | IO.Io _ => ioExn e
+    | TkErrorAug (pos, msg) => eprint $ Stream.pos2str pos ^ ": " ^ msg
+    | _ => otherExn e;
+    exit 255)
+  end
+end
+
+val () = MLton.Exn.setTopLevelHandler GlobalExnHandler.handler