Expression parsing

1 files changed, 36 insertions, 0 deletions

diff --git a/exn_handler.sml b/exn_handler.sml
new file mode 100644
index 0000000..c0a2d7a
--- /dev/null
+++ b/exn_handler.sml
@@ -0,0 +1,36 @@
+structure ExnHandler: 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
+      IO.Io _ => ioExn e
+    | _ => otherExn e;
+    exit 1
+  ) handle _ => sysExit 127
+end