summaryrefslogtreecommitdiff
path: root/exn_handler.fun
diff options
context:
space:
mode:
authorVladimir Azarov <avm@intermediate-node.net>2025-04-04 20:53:56 +0200
committerVladimir Azarov <avm@intermediate-node.net>2025-04-04 20:53:56 +0200
commit9d724f17e813fa344d485329d33b5f5ecf8197a3 (patch)
tree5061e604ea88a379db975b13c1d20688007cacc8 /exn_handler.fun
parent7b29b31648fd737e7bbc007f480b799add91bc6b (diff)
Functorization
Diffstat (limited to 'exn_handler.fun')
-rw-r--r--exn_handler.fun42
1 files changed, 42 insertions, 0 deletions
diff --git a/exn_handler.fun b/exn_handler.fun
new file mode 100644
index 0000000..6e069d6
--- /dev/null
+++ b/exn_handler.fun
@@ -0,0 +1,42 @@
+functor ExnHandler(structure T: TOKENIZER; structure P: CPP):
+ EXN_HANDLER =
+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
+ val prefix = name ^ ": "
+ val reason =
+ case cause of
+ OS.SysErr (str, _) => str
+ | _ => exnMessage cause
+ in
+ printLn $ prefix ^ reason
+ end
+ | ioExn _ = (printLn "ioExn: unreachable"; 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.ppos2str pos ^ ": " ^ msg
+ | P.TkExpected v => P.tkExpectedPrint v
+ | _ => otherExn e;
+ exit 255)
+end