OK thanks for the example. That makes sense. The state is being used locally
and not exported, which if you were using the IO monad you would be forced
to do

cheers

-s


"Iavor Diatchki" <[EMAIL PROTECTED]> wrote in message
news:[EMAIL PROTECTED]
Hello,

On 8/3/05, Srinivas Nedunuri <[EMAIL PROTECTED]> wrote:
> > The most obvious disadvantage is that the IO monad has no equivalent
> > of runST.
> OK, I'm missing something here. What is the big deal about runST? Can I
not
> get the IO equivalent by simply running the program at the top level
> (assuming I don't have multiple threads going). Do you have a practical
> example of needing runST in several places in your program?

Here is an example (not that I am suggesting that this is how we
should write the function 'fib').  Notice the type of 'fib' --- there
are no monads, even though the implementation internally uses state.

import Control.Monad.ST
import Data.STRef

fib  :: Int -> Int
fib n = runST (do x <- newSTRef 1
                  y <- newSTRef 1
                  let loop n | n < 1 = return ()
                      loop n  = do x' <- readSTRef x
                                   y' <- readSTRef y
                                   writeSTRef x y'
                                   writeSTRef y (x' + y')
                                   loop (n-1)
                  loop n
                  readSTRef x)

-Iavor



_______________________________________________
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell

Reply via email to