Gracjan Polak wrote:
Hi,

I stumbled at some interaction of Control.Monad.State.Strict, mdo and let I do
not understand. The following program:


{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where
import Control.Monad.State.Strict

thenumber :: Float
thenumber = flip execState 1.3 $ mdo
c <- donothing [] let donothing x = return x
    return ()

main = print thenumber

Says (in GHC 6.6.1):

Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.

Why is this so?


This mdo block goes into an infinite loop if the body is strict on donothing.

In Control.Monad.State.Strict, m>>=k is strict on m. This m happens to be donothing[]. So the body is strict on donothing, and mdo goes into an infinite loop.

(Control.Monad.State.Lazy postpones m until k really wants m's return value. If, like this example, k doesn't want it, everyone happily goes home.)

It takes a lot more analysis and peaking into the implementation of Control.Monad.State.Strict to see why this infinite loop also consumes infinite stack space.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to