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