From 5edd85474d6d8f3a0cc06cc0250ed3db8b26fcfa Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Sat, 17 May 2025 14:45:50 +0200
Subject: Function-like macros

---
 exn_handler.fun | 26 ++++++++++++--------------
 1 file changed, 12 insertions(+), 14 deletions(-)

(limited to 'exn_handler.fun')

diff --git a/exn_handler.fun b/exn_handler.fun
index 078225f..b4e7275 100644
--- a/exn_handler.fun
+++ b/exn_handler.fun
@@ -2,44 +2,42 @@ functor ExnHandler(structure T: TOKENIZER; structure P: PPC):
     EXN_HANDLER =
 struct
 
-  fun eprint s = printf `"error: " `s %
+  val eprintf = fn z => printf `"error: " z
 
   fun otherExn e =
   let
     val hist = MLton.Exn.history e
   in
-    eprint $ "exception " ^ exnMessage e ^ " was raised\n";
+    eprintf `"exception " `(exnMessage e) `" was raised\n";
     if hist = [] then
-      (output "No stack trace is avaliable\n";
-      output "Recompile with -const \"Exn.keepHistory true\"\n")
+      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 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
-    printf `prefix `reason `"\n" %
+    eprintf `name `": " `reason `"\n" %
   end
-    | ioExn _ = (output "ioExn: unreachable\n"; exit 254)
+    | ioExn _ = die 126 `"ioExn: unreachable\n" %
 
   fun handler e = (
-    printf `"\n" %;
+    printf `"\n";
     case e of
       T.FsmTableIsTooSmall =>
-          eprint "fsm table is too small. Increate 'maxState' value"
+          eprintf `"fsm table is too small. Increate 'maxState' value\n" %
     | IO.Io _ => ioExn e
-    | T.TkErrorAug (pos, msg) => eprint $ T.S.pos2str pos ^ ": " ^ msg
+    | T.TkErrorAug (pos, msg) => eprintf T.S.Ppos pos `": " `msg `"\n" %
     | P.TkError v => P.tkErrorPrint v
     | P.TkClassError v => P.tkClassErrorPrint v
     | _ => otherExn e;
-    exit 255
-  )
+    exit 1
+  ) handle _ => sysExit 127
 end
-- 
cgit v1.2.3