[Haskell-cafe] State monad strictness - how?
Dean Herington
heringtonlacey at mindspring.com
Tue Jan 9 23:26:10 EST 2007
I can't seem to figure out how to achieve strictness in the context
of the State monad. Consider:
> import Control.Monad.State
> try count = print final
> where (_,final) = runState prog 0
> prog = sequence_ (replicate count tick)
> tick :: State Int Int
> tick = do n <- get
> put (n+1)
> return n
(try 1000000) overflows the stack.
It doesn't help to use:
> put $! (n+1)
The only way I've been able to get the necessary strictness is to add
use of ($!) in the definition of (>>=):
> data SState s a = SState (s -> (a,s))
> instance Monad (SState s) where
> return x = SState (\s -> (x,s))
> m >>= f = SState (\s -> let SState m' = m
> (x,s1) = m' s
> SState f' = f x
> (y,s2) = f' $! s1
> in (y,s2))
> runSState (SState m) s = m s
> sget = SState (\s -> (s,s))
> sput s' = SState (\s -> ((),s'))
> stry count = print final
> where (_,final) = runSState prog 0
> prog = sequence_ (replicate count stick)
> stick :: SState Int Int
> stick = do n <- sget
> sput (n+1)
> return n
Is there no way to get strictness using the standard State monad?
Dean
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070109/f1334722/attachment.htm
More information about the Haskell-Cafe
mailing list