[MLton] Monadic MLton.Vector.create with update

[Vesa Karvonen]

The earlier monadic vector create interface didn't allow updates during the
construction of the vector.  Below is an improved interface and a similar
inefficient mock implementation, because I can't easily get to the MLton
Primitive stuff when testing my snippets of code on the SML/NJ top-level...
I tested that update works, but I don't have any example actually using update.
Maybe Stephen and/or Henry has an example in mind?

It is impossible to circumvent the interface (except through callcc and other
similar operators) and make updates to the vector after it has been constructed.
This is simply because only the create function can execute the constructed
monad and each time you call create a fresh vector is allocated.

I think that a monadic interface has some pleasing properties compared to an
interface that simply passes sub and update to the function.  For instance,
there is no need to poison the sub and update functions after the vector has
been created.

-Vesa Karvonen

infix >>=
fun K x _ = x
fun fail msg _ = raise Fail msg

signature CREATE =
   sig
      type ('a, 'e) m

      val create : int * (int -> ('e, 'e) m) -> 'e vector

      val return : 'e -> ('e, 'e) m
      val >>= : ('a, 'e) m * ('a -> ('b, 'e) m) -> ('b, 'e) m

      val sub : int -> ('e, 'e) m
      val update : int * 'e -> (unit, 'e) m
   end

structure Create :> CREATE =
   struct
      structure A = Array

      type ('a, 'e) m = int * 'e A.array -> 'a

      fun create (n, f) =
          let
             val a = A.tabulate (n, K (f 0 (0, A.tabulate (0, fail "BUG"))))
          in
             A.modifyi (fn (i, _) => f i (i, a)) a
           ; Vector.tabulate (n, fn i => A.sub (a, i))
          end

      fun return x _ = x
      fun (mA >>= a2mB) mv = a2mB (mA mv) mv
      fun sub i (m, v) = if i<m then A.sub (v, i) else raise Subscript
      fun update (i, e) (m, v) = if i<m then A.update (v, i, e) else raise Subscript
   end

local
   open Create
in
   fun fib n =
       create (n,
               fn i =>
                  if i <= 1 then
                     return (IntInf.fromInt i)
                  else
                     sub (i-1) >>= (fn x =>
                     sub (i-2) >>= (fn y =>
                     return (x+y))))
end