[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.  The implementation defines a
family of functions, makeOpt<i>, and a single combinator, "O", with
nothing infix (other than product).  One can define a function f
taking optional arguments using

  fun f $ = makeOpt<i> (p2r, p2r, r2p) (f', r0) $

Here, r0 is a record of the default values of the optional arguments,
f' is the final function to be called on the record, i is the number
of record fields, and (p2r, r2p) is the isomorphism between the
optional-arguments record the corresponding product (just as we used
to use an isomorphism between a record and a tuple).  The usual
problem with lack of first-class polymorphism requires us to pass the
additional copy of p2r.

One can call f, supplying values for optional arguments "a" and "b",
like this:

  f O#a va O#b vb $

Functional record update is simply optional arguments with an identity
function applied at the end.  That is,

  fun update r $ = makeOpt<i> (p2r, p2r, r2p) (id, r) $

If updateAB were defined this way, supplying the isomorphism on
records with fields "a" and "b", then we could do

  updateAB {a = 13, b = "hello"} O#b "goodbye"$

Because everything is polymorphic in the field values, the same update
function works here too.

  updateAB {a = 13.5, b = true} O#b false O#a 12.5$


The thing I most like about from this approach is that the optional
arguments (or record updates) and end of arguments terminator are the
same for every use (and should hence probably be global).  The only
thing that changes is the function.  This works well and avoids
having to open a DSL or use long names for each optional argument.

New in this approach too is the use of products allowing concise
definition of the internal update functions.

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

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
   datatype ('a, 'b) u = A of 'a | B of 'b
   fun next (p, up) =
      (fn f => p (f o A) & f o B,
       fn (a & b, u) =>
       (case u of A u => up (a, u) | _ => a)
       & (case u of B b => b | _ => b))
   fun n1 () = (fn f => f o A, fn (a, u) => case u of A a => a | _ => a)
   fun n2 () = next (n1 ())
   fun n3 () = next (n2 ())
   fun n4 () = next (n3 ())
   fun make n =
      let
         val (p, up) = n ()
      in
         fn (p2r, p2r', r2p) =>
         fn (f, r0) =>
         Fold.fold ((p2r' (p id), up, r2p r0), fn (_, _, p) => f (p2r p))
      end
in
   fun makeOpt2 $ = make n2 $
   fun makeOpt3 $ = make n3 $
   fun makeOpt4 $ = make n4 $
end

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

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 $