[MLton] optional arguments and functional record update via fold

[Stephen Weeks]

> Here is an implementation of optional arguments and functional record
> update using fold and product types.

Here is a slightly simpler implementation of the same interface.
The difference is that it uses a product of update functions, while
the previous implementation used a single update function that
interpreted a "path" to tell it which component to update.  I doubt
there is any difference in practice, since everything should be
simplified away.  But this one requires fewer simplifications to get
that point, so to my eye it is slightly nicer.

I forgot to mention in the previous mail that that implementation is an
improvement over earlier efforts in that the record is converted to a
product once, then all the updates are done, then the product is
converted back to a record, where earlier implementations did a pair
of conversions for each update.  This implementation still has that
property.  Again, this probably just means fewer simplifications to
generate the desired code.

Finally, I'll mention that all of this code is teetering on the brink
of needing first-class polymorphism, and it could certainly be cleaner
if we had it.

----------------------------------------------------------------------

datatype ('a, 'b) product = & of 'a * 'b
infix &
fun $ (a, f) = f a
fun curry f x y = f (x, y)
fun id x = x
fun pass x f = f x

structure Fold =
   struct
      val fold = pass
      fun step0 h (a1, f) = fold (h a1, f)
      fun step1 h $ a1 = step0 (curry h a1) $
      fun step2 h $ a1 a2 = step0 (fn x => h (a1, a2, x)) $
   end

local
   local
      fun lift u (p & v', v) = u (p, v) & v'
      fun next f = let val (u, u') = f () in (lift u, lift u') end
   in
      fun u1 () = (fn (_, v) => v, fn (v2 & _, v) => v2 & v)
      fun u2 () = next u1
      fun u3 () = next u2
      fun u4 () = next u3
   end
   local
      fun next (m, u: unit -> 'a * 'b) f = m (f & #2 (u ()))
   in
      fun m1 f = f
      fun m2 $ = next (m1, u1) $
      fun m3 $ = next (m2, u2) $
      fun m4 $ = next (m3, u3) $
   end
   fun make (m, u: unit -> 'a * 'b) (p2r, p2r', r2p) (f, r0) =
      Fold.fold ((p2r' (m (#1 (u ()))), r2p r0), fn (_, p) => f (p2r p))
in
   fun makeOpt2 $ = make (m2, u2) $
   fun makeOpt3 $ = make (m3, u3) $
   fun makeOpt4 $ = make (m4, u4) $
end

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