From d9c809a5550b2fe23b2fd1e66672b503730d55f1 Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Sun, 25 May 2025 19:59:56 +0200
Subject: Expression parsing

---
 exn_handler.sml | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 exn_handler.sml

(limited to 'exn_handler.sml')

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
-- 
cgit v1.2.3