[Haskell-cafe] Lazy Evaluation in Monads
Antoine Latter
aslatter at gmail.com
Wed Jun 1 01:10:33 CEST 2011
On Tue, May 31, 2011 at 2:49 PM, Scott Lawrence <bytbox at gmail.com> wrote:
> I was under the impression that operations performed in monads (in this
> case, the IO monad) were lazy. (Certainly, every time I make the
> opposite assumption, my code fails :P .) Which doesn't explain why the
> following code fails to terminate:
>
> iRecurse :: (Num a) => IO a
> iRecurse = do
> recurse <- iRecurse
> return 1
>
> main = (putStrLn . show) =<< iRecurse
>
> Any pointers to a good explanation of when the IO monad is lazy?
>
>
> === The long story ===
>
> I wrote a function unfold with type signature (([a] -> a) -> [a]), for
> generating a list in which each element can be calculated from all of
> the previous elements.
>
> unfold :: ([a] -> a) -> [a]
> unfold f = unfold1 f []
>
> unfold1 :: ([a] -> a) -> [a] -> [a]
> unfold1 f l = f l : unfold1 f (f l : l)
>
> Now I'm attempting to do the same thing, except where f returns a monad.
> (My use case is when f randomly selects the next element, i.e. text
> generation from markov chains.) So I want
>
> unfoldM1 :: (Monad m) => ([a] -> m a) -> [a] -> m [a]
>
> My instinct, then, would be to do something like:
>
> unfoldM1 f l = do
> next <- f l
> rest <- unfoldM1 f (next : l)
> return (next : rest)
>
> But that, like iRecurse above, doesn't work.
>
You could use a different type:
> type IOStream a = (a, IO (IOStream a))
> unfold :: ([a] -> IO a) -> IO (IOStream a)
> unfold f =
> let go prev = do
> next <- f prev
> return (next, go (next:prev))
> in do
> z <- f []
> go [z]
> toList :: Int -> IOStream a -> IO [a]
> toList 0 _ = return []
> toList n (x,rest) = do
> xs <- toList (n-1) rest
> return (x:xs)
Antoine
More information about the Haskell-Cafe
mailing list