[MLton] Fold01N

[Stephen Weeks]

There is an idiom that we have now seen several times when using
varargs fold with products, where one wants to treat the cases of zero
or one arguments specially.  One typically has a combinator "g" and
finisher "z" in mind and wants to define a folder "f" and stepper "`"
such that the following evaluations hold.

   f $            -->  z ()
   f`x1 $         -->  z x1
   f`x1 ...`xn $  -->  z (g (... (g (g (x1, x2), x3) ...), xn))

Here is a module, Fold01N, that expresses the idiom, defined using
Fold.

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

structure Fold =
   struct
      type ('a, 'b, 'c, 'd) step = 'a * ('b -> 'c) -> 'd
      type ('a, 'b, 'c, 'd) t = ('a, 'b, 'c, 'd) step -> 'd
      type ('a1, 'a2, 'b, 'c, 'd) step0 =
         ('a1, 'b, 'c, ('a2, 'b, 'c, 'd) t) step
      type ('a1, 'a2, 'a3, 'b, 'c, 'd) step1 =
         ('a2, 'b, 'c, 'a1 -> ('a3, 'b, 'c, 'd) t) step

      val fold = pass
      fun step0 h (a1, f) = fold (h a1, f)
      fun step1 h $ x = step0 (curry h x) $
   end

structure Fold01N =
   struct
      type ('a, 'b, 'c, 'd, 'e) t =
         ((unit -> unit) * ('c -> 'c), (unit -> 'a) * 'd, 'b, 'e) Fold.t
      type ('a, 'b, 'c, 'z1, 'z2, 'z3, 'z4, 'z5) step1 =
         ('z1,
          'z2 * ('z1 -> 'a),
          (unit -> 'a) * ('b -> 'c),
          'z3, 'z4, 'z5) Fold.step1
          
      val fold: ('a -> 'b) -> ('a, 'b, 'c, 'd, 'e) t =
         fn finish =>
         Fold.fold ((ignore, id), fn (p, _) => finish (p ()))
         
      val step1
         : ('a * 'b -> 'c) -> ('a, 'b, 'c, 'z1, 'z2, 'z3, 'z4, 'z5) step1 =
         fn combine =>
         Fold.step1 (fn (x, (_, f)) =>
                     (fn () => f x, fn x' => combine (f x, x')))
   end
----------------------------------------------------------------------

As a simple example, one can define an f (and `) that creates the
product of all its arguments.

----------------------------------------------------------------------
val f = fn $ => Fold01N.fold id $
val ` = fn $ => Fold01N.step1 (op &) $
val () = f $
val 13 = f`13 $
val 1 & 2 & 3 = f`1`2`3 $
----------------------------------------------------------------------

Perhaps Fold01N should be generalized slightly to allow more varied
behavior in the zero and one cases.