[MLton] Fold: stepN == step T ... T $

[Stephen Weeks]

> it would nevertheless be nice to avoid such indexed functions. As
> usual, we can get a fairly convenient alternative with a constant
> number of functions (two in this case) using infix products and CPS:
...
> I think that the optional arguments formulation could also use a similar
> reform.

Good idea.  As a reminder, I sent two different ways of doing optional
arguments.  One inductively builds a single update function and uses a
path to tell it which component to update:

  http://mlton.org/pipermail/mlton/2005-September/027934.html

The other builds a product of update functions:

  http://mlton.org/pipermail/mlton/2005-September/027938.html

I can see how to use fold to close the single-update-function
approach.

----------------------------------------------------------------------
local
   datatype ('x, 'y) u = X of 'x | Y of 'y
in
   fun makeOpt $ =
      Fold.fold
      (((), (), fn f => f o X, fn (a, u) => case u of X x => x | _ => a),
       fn (p, up, _, _) => fn (p2r, p2r', r2p) => fn (f, r0) =>
       Fold.fold ((p2r' (p id), up, r2p r0), fn (_, _, p) => f (p2r p)))
      $
   fun A z =
      Fold.step0
      (fn (_, _, p, up) =>
       (p, up,
        fn f => p (f o X) & f o Y,
        fn (a & b, u) =>
        (case u of X x => up (a, x) | _ => a)
        & (case u of Y y => y | _ => b)))
      z
   fun makeOpt2 z = makeOpt A A $ z
   fun makeOpt3 z = makeOpt A A A $ z
   fun makeOpt4 z = makeOpt A A A A $ z
end
----------------------------------------------------------------------

I can't figure out how to use fold to close the
product-of-update-functions approach.  Here's a cleaned up version of
that approach.

----------------------------------------------------------------------
local
   fun lift u (p & v', v) = u (p, v) & v'
   fun next ((m, _, u), (_, u', u'')) =
      (fn f => m (f & u), lift u', lift u'')
   fun mu1 () = (id, fn (_, v) => v, fn (v2 & _, v) => v2 & v)
   fun mu2 () = next (mu1 (), mu1 ())
   fun mu3 () = next (mu2 (), mu2 ())
   fun mu4 () = next (mu3 (), mu3 ())
   fun make (m, u, _) (p2r, p2r', r2p) (f, r0) =
      Fold.fold ((p2r' (m u), r2p r0), fn (_, p) => f (p2r p))
in
   fun makeOpt2 $ = make (mu2 ()) $
   fun makeOpt3 $ = make (mu3 ()) $
   fun makeOpt4 $ = make (mu4 ()) $
end
----------------------------------------------------------------------

The reason that fold can't be used, as far as I can tell, is that each
level needs to use the previous level at two different types.  Since
SML doesn't have first-class polymorphism, I don't see how to do this
without having each level be syntactically within the let-bound
previous level.  Trying to abstract that into a fold means that the
stepper loses the polymorphism.  I'd love to hear a trick to work
around this (in SML).

BTW, apropos my earlier point about using step0 instead of stepN, I
think the best way to define the optional-argument/FRU stepper is

  fun O s v = Fold.step0 (fn (ups, p) => (ups, s ups (p, v)))

Then, the examples look like the following.

----------------------------------------------------------------------
fun makeOptAB $ =
   let
      fun p2r (v1 & v2) = {a = v1, b = v2}
      fun r2p {a = v1, b = v2} = (v1 & v2)
   in
      makeOpt2 (p2r, p2r, r2p) $
   end

fun makeOptBCD $ =
   let
      fun p2r (v1 & v2 & v3) = {b = v1, c = v2, d = v3}
      fun r2p {b = v1, c = v2, d = v3} = (v1 & v2 & v3)
   in
      makeOpt3 (p2r, p2r, r2p) $
   end

fun updateAB r = makeOptAB (id, r)
fun updateBCD r = makeOptBCD (id, r)

val _ = updateAB {a = 13, b = "hello"} (O#b "goodbye") $
val _ = updateAB {a = 13.5, b = true} (O#b false) (O#a 12.5) $
val _ = updateBCD {b = 1, c = 2, d = 3} (O#c 4) (O#c 5) $
   
fun f1 $ = makeOptAB (fn {a, b} => print (concat [Int.toString a, " ",
                                                  Real.toString b, "\n"]),
                      {a = 0, b = 0.0}) $
   
fun f2 $ =
   makeOptBCD (fn {b, c, d} =>
               print (concat [Int.toString b, " ",
                              Real.toString c, " ",
                              d, "\n"]),
               {b = 0, c = 0.0, d = "<>"}) $

val () = f1 $
val () = f1 (O#a 13) (O#a 12) $
val () = f1 (O#a 13) (O#b 17.5) $
val () = f2 $
val () = f2 (O#d "goodbye") $
val () = f2 (O#d "hello") (O#b 17) (O#c 19.3) $