From 87217fe5ba58f5199d30586b5d9bec104dece445 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Mon, 24 Mar 2025 21:51:16 +0100 Subject: Partition into structures --- exn_handler.sml | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 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..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 -- cgit v1.2.3