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?

-- 
Gracjan


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

Reply via email to