
Hi, Thanks to the responses earlier from the list, the core of my simulator now happy processes tens of millions of state updates without running out of stack. The goal of the simulator is to produce a log of tag states, which can be analyzed to find statistics of how often the sensor tags in a particular state. (In the toy model below there is no external signal, so the log isn't very interesting yet.) For the moment, I am using the "big stick" approach of unsafeIOToST to write log messages. Since the only outputs of the program are the log messages, and invocations of "step" are ordered by the ST monad, it seems that unsafeIOToST is safe in this case, in the sense that the outputs will all be ordered the same as the actual state updates. I've tested the program test1.hs below and it quite fast (runs in just under 10 s, or about 10^6 state updates per second). I've considered using a WriterT monad to wrap the ST monad to produce a log. The problem with this seems to be ensuring that the log output is generated lazily so it can be incrementally output. A somewhat broken sketch is the program test2.hs below. I used a function from [String] -> [String] as the monoid to avoid the O(n^2) inefficiency of appending to a list, but my implementation of this may well be faulty. To my eye, the Writer monad should be a better way, since it encapsulates the logging process, separating it from other I/O that the program may do. On the other hand, I don't see an easy way to ensure that the log output is generated lazily so that it can be output incrementally. I think that the main issue is that until_ is building up a list of log strings, but that these aren't passed to the putStrLn until after the completion of the whole runTag function. ATM, running test2 gives a stack overflow. Could someone point out how the Writer monad could be adapted to this, or tell me that, "Real programmers just use unsafe* and get on with it" ? Best, greg ------------------------------------------------------------------------ ------------------------------ test1.hs, the big stick (unsafeIOToST): -- -- test1.hs, state updating with logging via unsafeIOToST. -- module Main where import Control.Monad.ST import Data.STRef import Maybe data TagState = Syncing | Listening | Sleeping deriving (Eq, Show) -- A structure with internal state: -- data Tag s = Tag { tagID :: ! Int, state :: ! (STRef s TagState), count :: ! (STRef s Integer) } data FrozenTag = FrozenTag { ft_tagID :: Int, ft_state :: TagState, ft_count :: Integer } deriving Show -- Repeat a computation until it returns Nothing: -- until_ :: Monad m => m (Maybe a) -> m () until_ action = do result <- action if isNothing result then return () else until_ action -- Here is a toy stateful computation: -- runTag :: ST s (FrozenTag) runTag = do tag <- initialize until_ (step tag) freezeTag tag initialize :: ST s (Tag s) initialize = do init_count <- newSTRef 1000000 init_state <- newSTRef Syncing return (Tag { tagID = 1, state = init_state, count = init_count }) step :: Tag s -> ST s (Maybe Integer) step t = do c <- readSTRef (count t) s <- readSTRef (state t) writeSTRef (count t) $! (c - 1) writeSTRef (state t) $! (nextState s) unsafeIOToST $! putStrLn ("next state is " ++ show s) if (c <= 0) then return Nothing else return (Just c) nextState :: TagState -> TagState nextState s = case s of Syncing -> Listening Listening -> Sleeping Sleeping -> Syncing freezeTag :: Tag s -> ST s (FrozenTag) freezeTag t = do frozen_count <- readSTRef (count t) frozen_state <- readSTRef (state t) return (FrozenTag { ft_tagID = tagID t, ft_count = frozen_count, ft_state = frozen_state }) main :: IO () main = do print $ runST (runTag) ------------------------------------------------------------------------ ----------------------------------------- test2.hs: stacked WriterT and ST monads: -- -- test2.hs, state updating with logging via the WriterT monad. -- module Main where import Control.Monad.ST import Control.Monad.Writer import Data.STRef import Maybe data TagState = Syncing | Listening | Sleeping deriving (Eq, Show) -- A type for combined logging and state transformation: -- type LogMonoid = [String] -> [String] type LogST s a = WriterT LogMonoid (ST s) a -- A structure with internal state: -- data Tag s = Tag { tagID :: ! Int, state :: ! (STRef s TagState), count :: ! (STRef s Integer) } data FrozenTag = FrozenTag { ft_tagID :: Int, ft_state :: TagState, ft_count :: Integer } deriving Show -- Repeat a computation until it returns Nothing: -- until_ :: Monad m => m (Maybe a) -> m () until_ action = do result <- action if isNothing result then return () else until_ action -- Here is a toy stateful computation: -- runTag :: LogST s (FrozenTag) runTag = do tag <- initialize until_ (step tag) freezeTag tag initialize :: LogST s (Tag s) initialize = do init_count <- lift $ newSTRef 1000000 init_state <- lift $ newSTRef Syncing return (Tag { tagID = 1, state = init_state, count = init_count }) step :: Tag s -> LogST s (Maybe Integer) step t = do c <- lift $ readSTRef (count t) s <- lift $ readSTRef (state t) lift $ writeSTRef (count t) $! (c - 1) lift $ writeSTRef (state t) $! (nextState s) tell (("next state is " ++ show s) : ) if (c <= 0) then return Nothing else return (Just c) nextState :: TagState -> TagState nextState s = case s of Syncing -> Listening Listening -> Sleeping Sleeping -> Syncing freezeTag :: Tag s -> LogST s (FrozenTag) freezeTag t = do frozen_count <- lift $ readSTRef (count t) frozen_state <- lift $ readSTRef (state t) return (FrozenTag { ft_tagID = tagID t, ft_count = frozen_count, ft_state = frozen_state }) main :: IO () main = do let (t, l) = runST (runWriterT runTag) putStrLn (show t) putStrLn (unlines (l []))