[MLton] printf via fold
Vesa Karvonen
vesa.karvonen@cs.helsinki.fi
Wed, 31 Aug 2005 19:04:32 +0300
Quoting Stephen Weeks <sweeks@sweeks.com>:
[...]
> One can also use the techniques in this note to build a nicer version
> of functional record update and optional arguments requiring only a
> single global "setter" instead of the per-function or
> per-optional-argument approaches we discussed earlier. I'll save that
> for a separate note.
Interesting. I also did some experiments on FRU/OA (last changes seem to
be dated the 25th), but forgot about it. Here are snippets of the code I
came up with:
(* 3-tuple update *)
datatype ('v1, 'v2, 'v3) t = V1 of 'v1 | V2 of 'v2 | V3 of 'v3
fun set3 f v (v1, v2, v3) =
let fun g h v =
(case h v of V1 v1 => v1 | _ => v1,
case h v of V2 v2 => v2 | _ => v2,
case h v of V3 v3 => v3 | _ => v3)
in f (g V1, g V2, g V3) v end
(* FRU/OA stuff *)
fun pass x f = f x
fun $> x = x
fun <$ k = k $>
fun wrapArg (set, t2r, t2r', r2t) t f v = pass (t o t2r o set (f o t2r') v o r2t)
(* updater for {a, b, c} *)
local
fun t2r (v1, v2, v3) = {a = v1, b = v2, c = v3}
fun r2t {a = v1, b = v2, c = v3} = (v1, v2, v3)
in
fun arg t f = wrapArg (set3, t2r, t2r, r2t) t f
end
(* testing *)
val r = <$arg#a 1 arg#b 2.0 arg#c "3"$> {a=0, b=0.0, c="0"}
[...]
> I defined "$" at the top level because it will be useful as the
> end-of-arguments terminator in all situations, not just fold left.
[...]
> Nicely, the same end-of-argument terminator ($) that we used before
> still works. This will be true throughout this note. It's probably worth
> exposing $ at the top-level in the basis that exports all this stuff.
Yes, I can't see how it would cause harm. I would probably make it so.
OTOH, it doesn't seem imperative to expose $ at the top level, because it
isn't an infix operator and it could just as well be bound in each module
that uses the technique. Of course, exposing $ at the top level saves some
work. In other words, instead of
Library code:
fun $ (*...*)
structure DSL = struct (* no $ *) ... end
User code:
let open DSL in ... $ ... end
you could have
Library code:
structure DSL = struct fun $ (*...*) ... end
User code:
let open DSL in ... $ ... end
and the user code stays the same.
> ----------------------------------------------------------------------
> structure MakeFold =
> struct
> fun makeFold (a, g, f) = Foldr.foldr ((g, f), fn (_, f) => f a)
> fun step_0_1 h =
> Foldr.step0 (fn (g, r) => (g, fn a => fn d1 => r (g (h d1, a))))
> fun step_1_0 z =
> Foldr.step1 (fn (b, (g, r)) => (g, fn a => r (g (b, a)))) z
> fun step_1_1 h =
> Foldr.step1 (fn (z, (g, r)) =>
> (g, fn a => fn d1 => r (g (h (z, d1), a))))
> end
> ----------------------------------------------------------------------
>
> By plugging in the definitions and using the Foldr equations, one can
> see that the MakeFold library satisfies the following equations.
>
> makeFold (a, g, f)
> (step_1_0 h1) b1 (step_1_0 h2) b2 ... (step_1_0 hn) bn $
> === g (hn bn, ... g (h2 b2, g (h1 b1, a))
>
> makeFold (a, g, f)
> (step_0_1 h1) (step_0_1 h2) ... (step_0_1 hn) $
> b1 b2 ... bn
> === g (hn bn, ... g (h2 b2, g (h1 b1, a))
>
> makeFold (a, g, f)
> (step_1_1 h1) b1 (step_1_1 h2) b2 ... (step_1_1 hn) bn $
> c1 c2 ... cn
> === g (hn (bn, cn), ... g (h2 (b2, c2), g (h1 (b1, c1), a)))
The above definition of step_1_0 seems to be wrong. Shouldn't it be:
fun step_1_0 h =
Foldr.step1 (fn (b, (g, r)) => (g, fn a => r (g (h b, a))))
Also, I wonder if it would make sense to use curried functions and to make
it so that the "inline argument" (to step1, step_1_0, and step_1_1) is
used "inline" (immediately) rather than after applying $. This would allow
you to use partial application (evaluation) to avoid repeated computation
(similar to e.g. the Char.contains function of the SML Basis library:
http://www.standardml.org/Basis/char.html#SIG:CHAR.contains:VAL). The
syntax may be slightly more verbose, but the ability to take advantage of
partial application might be useful in some circumstances. The end of this
message contains an implementation of this idea and a simple Scanf
implementation that uses the (curried) Fold library.
> One could define fprintf in the following simpler way.
>
> fun fprintf out =
> MakeFold.makeFold ((),
> fn (s, f) => (f (); TextIO.output (out, s)),
> fn () => ())
>
> However, I think the first way I gave is better because none of the
> printing happens until fprintf is fully applied. Thus partial
> applications will work as expected and it will be easier to avoid
> errors where fprintf isn't fully applied (since nothing displays until
> it is).
Looking at the Ocaml Printf documentation, it seems that the simpler thing
is the wrong thing to do:
http://caml.inria.fr/pub/docs/manual-ocaml/libref/Printf.html
In other words, the warning would disappear from the documentation (and
the gotcha, of course) if printing was delayed.
> In any case, MLton should still do the right thing.
Is there a simple way to verify this?
> That's it. Less than forty lines of code to define printf along with
> a few useful libraries for handling variable-number of arguments,
> optional arguments, and other generic folders.
Very nice work!
> All that remains is the signatures. Sadly, these are not so nice
> because of the large number of type variables involved. I'd love to
> hear suggestions for improvements, but I'm not optimistic.
The type abbreviations seem about as concise as they can be. It might be
possible to make them more readable by using more descriptive (mnemonic)
names for the type variables, but that's about it.
-Vesa Karvonen
(************************************************************************)
infix <\ fun x <\f = fn y => f (x, y)
infix /> fun f/> y = fn x => f (x, y)
fun pass x f = f x
fun id x = x
fun const x _ = x
fun curry f x y = f (x, y)
fun uncurry f (x, y) = f x y
datatype ('a, 'b) product = & of 'a * 'b
infix &
(************************************************************************)
fun $ (a, f) = f a
structure Fold =
struct
val fold = pass
fun step0 h (a1, f) = fold (h a1, f)
fun step1 h u x = step0 (h x) u
end
(************************************************************************)
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")
(************************************************************************)
fun C $ = Fold.step0 (1 <\op+) $
fun f $ = Fold.fold (0, pi) $
val () = f $
val () = f C C $
val () = f C C C C C $
(************************************************************************)
fun C $ = Fold.step1 (curry op::) $
fun f $ = Fold.fold ([], pis) $
val () = f C 1 $
val () = f C 1 C 2 C 3 $
(************************************************************************)
fun C $ = Fold.step0 const $
fun f $ = Fold.fold ((), id) $
val () = f C $ ()
val () = f C C C $ () () ()
(************************************************************************)
fun L $ = Fold.fold ([], rev) $
fun X $ = Fold.fold ([], Fold.step1 (curry op::) $ o rev)
fun Y $ = Fold.step1 (curry op::) $
val () = List.app pis (L X Y 1 Y 2 Y 3 $
X Y 4 Y 5 $
X Y 6 $
$)
(************************************************************************)
structure Foldr =
struct
fun foldr (c, f) = Fold.fold (f, pass c)
fun step0 h = Fold.step0 (op o/> h)
fun step1 h = Fold.step1 (fn x => op o/> h x)
end
(************************************************************************)
fun C $ = Foldr.step1 (curry op::) $
fun f $ = Foldr.foldr ([], pis) $
val () = f C 1 $
val () = f C 1 C 2 C 3 $
(************************************************************************)
structure MakeFold =
struct
fun makeFold (a, g, f) = Foldr.foldr ((g, f), fn (_, f) => f a)
fun step_0_0 b1 =
Foldr.step0 (fn (g, r) => (g, fn a => r (g (b1, a))))
fun step_0_1 h =
Foldr.step0 (fn (g, r) => (g, fn a => fn c1 => r (g (h c1, a))))
fun step_1_0 h $ b1 = step_0_0 (h b1) $
fun step_1_1 h $ b1 = step_0_1 (h b1) $
end
(************************************************************************)
structure Printf =
struct
fun format $ = MakeFold.makeFold ([], op ::, concat o rev) $
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
(************************************************************************)
local
open Printf
val f = printf`"A real "G`" and a real "G`".\n"$ 13.1
val g = fprintf TextIO.stdErr`"A string"
val () = printf`"Hello.\n"$
val () = printf`"An int "D`" and an int "D`".\n"$ 13 14
val () = print (format`"An int "D`" and a real "G`".\n"$ 13 3.1415)
val () = f 3.1415
val () = g `" - followed by another.\n"$
val () = printf $
val () = printf G D`"\n"$ 1.0 13
in end
(************************************************************************)
structure Scanf =
struct
exception Scanf
fun fromString s = (Substring.getc, Substring.full s)
fun scanf (g, s) = Fold.fold ((g, s, id), fn (_, s, vs) => pass (vs s))
fun sscanf $ = (scanf o fromString) $
fun newScanner scan =
Fold.step0 (fn (g, s, vs) =>
case scan (g, s) of
NONE => raise Scanf
| SOME (v, s) =>
(g, s, case vs v of vs_v => fn v => vs_v & v))
fun newSkipper scan =
Fold.step1 (fn a1 =>
case scan a1 of
scan_a1 =>
fn (g, s, vs) =>
case scan_a1 (g, s) of
NONE => raise Scanf
| SOME s => (g, s, vs))
fun ` $ =
newSkipper
(fn s' =>
fn (g, s) => let
fun loop (s, s') =
case g s & Substring.getc s' of
SOME (c, s) & SOME (c', s') =>
if c = c' then
loop (s, s')
else
NONE
| _ & NONE => SOME s
| _ & SOME _ => NONE
in loop (s, Substring.full s') end)
$
fun D $ = newScanner (uncurry (Int.scan StringCvt.DEC)) $
fun G $ = newScanner (uncurry Real.scan) $
end
(************************************************************************)
val () =
let open Scanf in
sscanf "An int 25 and a real 3.141\n"
`"An int "D`" and a real "G`"\n"$ end
let open Printf in
fn i & r & _ =>
printf `"Got an int "D`" and a real "G`".\n"$ i r end
(************************************************************************)