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 []))
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
