[MLton] Monadic MLton.Vector.create

Vesa Karvonen vesa.karvonen@cs.helsinki.fi
Wed, 29 Mar 2006 01:53:55 +0300


Quoting Henry Cejtin <henry.cejtin@sbcglobal.net>:
> No,  I  don't believe that monads are powerful enough in a language with side
> effects.  The function that is passed update can put it in a ref cell.

Hmm...  I'm not sure what you mean.  The idea of the monadic interface is
that the function (of type int -> 'a m) passed to create constructs a monad
from the index given to it by create.  The monad is essentially an operation
that computes the value to be stored to the vector.  The create function then
runs the monad to yield the value (of type 'a) to be stored into the vector.
The only way to construct a suitable monadic value is through the combinators
return, >>=, and sub.  Neither the combinators nor create allow the vector to
be mutated after it has been created (exluding callcc).

At any rate, below is a revised interface (the earlier was too liberal) and
an inefficient mock implementation that isn't using the Primitive stuff.

-Vesa Karvonen

infix >>=

signature CREATE =
   sig
      type 'a m

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

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

      val sub : int -> 'a m
   end

structure Create :> CREATE =
   struct
      type 'a m = 'a array option -> 'a

      fun create (n, f) =
          let
             val a = Array.tabulate (n, fn i => f 0 NONE)
          in
             Array.modifyi (fn (i, _) => f i (SOME a)) a
           ; Vector.tabulate (n, fn i => Array.sub (a, i))
          end

      fun return x = fn _ => x
      fun  mA >>= a2mB = fn v => a2mB (mA v) v
      fun sub i = fn SOME v => Array.sub (v,i) | _ => raise Match
   end

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

val fib10 = fib 10