New printf combinator interface

1 files changed, 27 insertions, 11 deletions

diff --git a/common.sml b/common.sml
index d039471..788c28b 100644
--- a/common.sml
+++ b/common.sml
@@ -37,6 +37,7 @@ structure Fold = struct
   fun step1 h (a, f) b = fold (h (b, a), f)
   fun step2 h (a, f) b c = fold (h (b, c, a), f)
   fun step3 h (a, f) b c d = fold (h (b, c, d, a), f)
+  fun step4 h (a, f) b c d e = fold (h (b, c, d, e, a), f)
 end
 
 structure FRU = struct
@@ -127,6 +128,8 @@ in
   (output', mf)
 end
 
+type 'a acc = (string -> unit) * 'a
+
 local
   val ctx = ((false, makePrintfBase $ output TextIO.stdOut),
     fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
@@ -154,22 +157,24 @@ in
   fun A0 z = Fold.step1 (fn (f, (ign, out)) =>
     (ifF ign (fn () => f out); (ign, out))) z
   fun A1 z = Fold.step2 (fn (f, v, (ign, out)) =>
-    (ifF ign (fn () => f (out, v)); (ign, out))) z
+    (ifF ign (fn () => f v out); (ign, out))) z
   fun A2 z = Fold.step3 (fn (f, v1, v2, (ign, out)) =>
-    (ifF ign (fn () => f (out, v1, v2)); (ign, out))) z
+    (ifF ign (fn () => f v1 v2 out); (ign, out))) z
+  fun A3 z = Fold.step4 (fn (f, v1, v2, v3, (ign, out)) =>
+    (ifF ign (fn () => f v1 v2 v3 out); (ign, out))) z
 end
 
 fun Ign z = Fold.step0 (fn (_, out) => (true, out)) z
 
 fun bind A f = fn z => Fold.fold z A f
-fun bindWith2str to = bind A1 (fn ((output, _), v) => output $ to v)
+fun bindWith2str to = bind A1 (fn v => fn (output, _) => output $ to v)
 
 fun F z = bind A0 (fn (_, mf) => mf ()) z
 
 val I = fn z => bindWith2str Int.toString z
 val C = fn z => bindWith2str str z
 val B = fn z => bindWith2str Bool.toString z
-val R = fn z => bind A1 (fn ((output, _), n) => app (fn f => f ())
+val R = fn z => bind A1 (fn n => fn (output, _) => app (fn f => f ())
         (List.tabulate (n, fn _ => fn () => output "    "))) z
 
 type ('t, 'a, 'b, 'c) a1printer = (bool * ((string -> unit) * 'a)) * 'b
@@ -179,15 +184,26 @@ type ('t1, 't2, 'a, 'b, 'c) a2printer =
     (bool * ((string -> unit) * 'a)) * 'b -> 't1 -> 't2 ->
         ((bool * ((string -> unit) * 'a)) * 'b -> 'c) -> 'c
 
-val Popt = fn z =>
+fun popt p v out =
+  case v of
+    NONE => Printf out `"none" %
+  | SOME v => Printf out A1 p v %
+val Popt = fn z => bind A2 popt z
+
+fun plist p l (s, parens) out =
 let
-  fun f (out, p, v) =
-    case v of
-      NONE => Printf out `"none" %
-    | SOME v => Printf out p v %
+  fun f [] _ = ()
+    | f [e] out = Printf out A1 p e %
+    | f (e1 :: e2 :: tail) out =
+      (Printf out A1 p e1 %; Printf out `s A1 f (e2 :: tail) %)
 in
-  bind A2 f
-end z
+  if parens andalso length l > 1 then
+    Printf out `"(" A1 f l `")" %
+  else
+    Printf out A1 f l %
+end
+
+val Plist = fn z => bind A3 plist z
 
 fun die code g =
 let