1 files changed, 45 insertions, 13 deletions
diff --git a/common.sml b/common.sml
index c186377..d00b1a8 100644
--- a/common.sml
+++ b/common.sml
@@ -96,21 +96,53 @@ fun % (a, f) = f a
 val s = FRU.set
 val u = FRU.upd
 
-fun output s = TextIO.output (TextIO.stdOut, s)
+fun sysExit code = Posix.Process.exit $ Word8.fromInt code
+
+fun exit code = (
+  TextIO.closeOut TextIO.stdOut;
+  TextIO.closeOut TextIO.stdErr;
+  sysExit code
+)
+
+fun output stream s = TextIO.output (stream, s)
+
+fun fprint stream g = Fold.fold ((false, output stream), fn _ => ()) g
+fun printf g = fprint TextIO.stdOut g
+fun Printf output g = Fold.fold ((false, output), fn _ => ()) g
+
 local
-  fun printBuffer _ [] = ()
-    | printBuffer stream (s :: acc) =
-      (TextIO.output (stream, s); printBuffer stream acc)
+  fun ifF flag cl = if not flag then cl () else ()
 in
-  fun fprintf stream f = Fold.fold
-    ((stream, []), fn (stream, acc) => printBuffer stream (rev acc)) f
-  fun printf f = fprintf TextIO.stdOut f
+  fun ` z = Fold.step1 (fn (s, (ign, output)) =>
+    (ifF ign (fn () => output s); (ign, output))) z
+
+  fun A0 z = Fold.step1 (fn (f, (ign, output)) =>
+    (ifF ign (fn () => f output); (ign, output))) z
+  fun A1 z = Fold.step2 (fn (f, v, (ign, output)) =>
+    (ifF ign (fn () => f (output, v)); (ign, output))) z
+end
 
-  fun ` z = Fold.step1 (fn (str, (s, acc)) => (s, str :: acc)) z
-  fun A0 z = Fold.step1 (fn (f, (s, a)) => (s, f () :: a)) z
-  fun A1 z = Fold.step2 (fn (f, v, (s, a)) => (s, f v :: a)) z
-  fun bind A f = fn z => Fold.fold z A f
+fun Ign z = Fold.step1 (fn (_, (_, output)) => (true, output)) z
 
-  val C = fn z => bind A1 str z
-  val I = fn z => bind A1 Int.toString z
+fun bind A f = fn z => Fold.fold z A f
+fun bindWith2str to = bind A1 (fn (output, v) => output (to v))
+
+val I = fn z => bindWith2str Int.toString z
+val C = fn z => bindWith2str str z
+val B = fn z => bindWith2str (fn true => "true" | false => "false") z
+val R = fn z => bind A1 (fn (output, n) => app (fn f => f ())
+        (List.tabulate (n, fn _ => fn () => output "\t"))) z
+
+type ('t, 'a, 'b) a1printer = (bool * (string -> unit)) * 'a -> 't ->
+        ((bool * (string -> unit)) * 'a -> 'b) -> 'b
+
+fun die code g =
+let
+  fun finish (true, _) = raise Unreachable
+    | finish (false, output) = (
+        output "\n";
+        exit code
+    )
+in
+  printf `"error: " (fn (a, _) => g (a, finish))
 end