[MLton] printf via fold
Stephen Weeks
sweeks@sweeks.com
Fri, 2 Sep 2005 16:49:11 -0700
Here's a few more thoughts on Fold and Printf. In short, this note
contains the following ideas.
1. An idiom for naming sequences of directives.
2. An extension of Fold that the capability to handle exceptions
that steppers might raise, and an example of this to implement
short-circuit multiplication when one of the arguments is zero.
3. A structure, FoldBoth, that is a combination of Fold and Foldr
that first folds left and then folds right.
4. A syntax for array and vector literals, implemented using
FoldBoth.
5. An improvement to MakeFold that generates functions that first
fold left and then fold right.
6. An improvement to Printf using the new MakeFold. In particular,
format uses makeFoldr and hence no longer needs a list reversal.
All of this note uses the following globals, which include Fold with
an uncurried step1.
infix <\ fun x <\f = fn y => f (x, y)
infix /> fun f/> y = fn x => f (x, y)
fun $ (a, f) = f a
fun const x _ = x
fun curry f x y = f (x, y)
fun id x = x
fun pass x f = f x
fun uncurry f (x, y) = f x y
fun pi' i = print (Int.toString i)
fun pi i = (pi' i; print "\n")
fun pis is =
(print "["
; (case is of
[] => ()
| i :: is => (pi' i; List.app (fn i => (print ", "; pi' i)) is))
; print "]\n")
structure Fold =
struct
val fold = pass
fun step0 h (a1, f) = fold (h a1, f)
fun step1 h $ x = step0 (fn a => h (x, a)) $
end
----------------------------------------------------------------------
1. An idiom for naming sequences of directives.
----------------------------------------------------------------------
With any of the folds, one can name sequences of directives with the
following idiom
fn z => pass z D0 D1 D2 ...
For example, with Printf, one could build a new directive, DD, that
formats a tuple of integers. Then, one can use DD just as any other
directive.
val DD = fn z => pass z `"("D`", "D`")"
val () = printf DD DD`"\n"$ 7 13 17 19
----------------------------------------------------------------------
2. An extension of Fold that supports exception handling.
----------------------------------------------------------------------
structure FoldHandle =
struct
structure E =
struct
datatype 'a t = E of exn | V of 'a
fun wrap f = V (f ()) handle e => E e
end
fun fold (v: 'a, {finish, handler}) =
Fold.fold (E.V v, fn E.E e => handler e | E.V v => finish v)
fun step0 h (e, f) =
Fold.fold (case e of E.E _ => e | E.V a => E.wrap (fn () => h a), f)
fun step1 h $ x = step0 (fn a => h (x, a)) $
end
local
exception Zero
in
fun mul $ =
FoldHandle.fold (1, {finish = id,
handler = fn Zero => 0 | e => raise e}) $
fun ` $ =
FoldHandle.step1 (fn (i, j) => if 0 = i then raise Zero else i * j) $
end
val _ = pi (mul `1`2`3$)
val _ = pi (mul `1`0`3$)
----------------------------------------------------------------------
3. A structure, FoldBoth, that is a combination of Fold and Foldr
that first folds left and then folds right.
----------------------------------------------------------------------
structure FoldBoth =
struct
fun fold (a, t, f) = Fold.fold ((a, id), fn (a, g) => f (g (t a)))
fun step0 h = Fold.step0 (fn (a, g) =>
let
val (a, g') = h a
in
(a, g o g')
end)
fun step1 h $ x = step0 (fn a => h (x, a)) $
end
structure Foldr =
struct
fun foldr (a, f) = FoldBoth.fold ((), const a, f)
fun step0 h = FoldBoth.step0 (fn () => ((), h))
fun step1 h = FoldBoth.step1 (fn (x, ()) => ((), curry h x))
end
----------------------------------------------------------------------
4. A syntax for array and vector literals.
----------------------------------------------------------------------
fun array0 () = Array.tabulate (0, fn _ => raise Fail "array0")
local
fun make f =
FoldBoth.fold ((0, NONE),
fn (n, opt) =>
if 0 = n then array0 () else Array.array (n, valOf opt),
f)
in
fun A $ = make id $
fun V $ = make Array.vector $
end
(* The implementation of vector literals is a bit annoying because of the
* array copy. If we did this inside the MLton basis, we could safely
* use MLton's (in general unsafe) Array_toVector primitive. We could
* also avoid carrying along the dummy element by using Array_array.
*)
fun ` $ = FoldBoth.step1 (fn (x, (i, _)) =>
((i + 1, SOME x),
fn a => (Array.update (a, i, x); a))) $
val a = A `1`2`3`4$
val () = Array.app pi a
val v = V `1`2`3`4`5$
val () = Vector.app pi v
----------------------------------------------------------------------
5. An improvement to MakeFold that generates functions that first
fold left and then fold right.
----------------------------------------------------------------------
structure MakeFold =
struct
fun makeFoldBoth (a, h, t, f) =
Foldr.foldr ((h, fn (a, g) => f (g (t a))),
fn (_, f) => f (a, id))
fun makeFold (a, h, f) =
makeFoldBoth (a, fn (b, a) => (h (b, a), id), f, id)
fun makeFoldr (a, h, f) =
makeFoldBoth ((), fn (b, ()) => ((), curry h b), const a, f)
local
fun make z =
Foldr.step0
(fn (h, r) =>
(h, fn (a, g) =>
z (fn b => let val (a, g') = h (b, a) in r (a, g o g') end)))
in
fun step_0_0 b = make (pass b)
fun step_0_1 h = make (op o/> h)
end
fun step_1_0 h $ b = step_0_0 (h b) $
fun step_1_1 h $ b = step_0_1 (h b) $
end
----------------------------------------------------------------------
6. An improvement to Printf using the new MakeFold.
----------------------------------------------------------------------
structure Printf =
struct
fun format $ = MakeFold.makeFoldr ([], op ::, concat) $
fun fprintf out =
MakeFold.makeFold
(id,
fn (s, f) => fn () => (f (); TextIO.output (out, s)),
pass ())
fun printf $ = fprintf TextIO.stdOut $
fun ` $ = MakeFold.step_1_0 id $
val newSpec = MakeFold.step_0_1
fun D $ = newSpec Int.toString $
fun G $ = newSpec Real.toString $
end