Gregory Wright wrote:
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.
(Writer [String] [Int]) can produce the log lazily. (WriterT [String] Identity [Int]) cannot produce the log lazily. But (Identity [Int]) can produce its output lazily. Using ST.Lazy and Either instead of WriterT, I can get the streaming behavior. But I have to use a continuation passing style
module Main where
import Control.Monad.ST.Lazy import Data.STRef.Lazy import Control.Monad.Writer import Control.Monad.Identity import Maybe import Debug.Trace
type LogMonoid = [String] -> [String]
loop :: Int -> Writer [String] [Int] loop 0 = trace "end of loop" (return [0]) loop x = do let msg = "loop now "++ show x tell [msg] liftM (x:) (loop (pred x))
loop' :: Int -> WriterT [String] Identity [Int] loop' 0 = trace "end of loop'" (return [0]) loop' x = do let msg = "loop' now "++ show x tell [msg] liftM (x:) (loop' (pred x))
loopI :: Int -> Identity [Int] loopI 0 = trace "end of loopI" (return [0]) loopI x = liftM (x:) (loopI (pred x))
loopM :: Int -> WriterT LogMonoid Identity [Int] loopM 0 = trace "end of loopM" (return [0]) loopM x = do let msg = "loopM now "++ show x tell (msg:) liftM (x:) (loopM (pred x))
loopST :: Int -> ST s [Either String Int] loopST init = do ref <- newSTRef init let loop = do x <- readSTRef ref writeSTRef ref $! (pred x) let msg = Left ("loopST now "++ show x) cont = if x==0 then trace "end of loopST" (return [Right 0]) else loop liftM (msg :) cont loop
loopST2 :: Int -> ST s [Either String Int] loopST2 init = do ref <- newSTRef init let loop = do x <- readSTRef ref writeSTRef ref $! (pred x) let msg = Left ("loopST now "++ show x) cont = if x==0 then trace "end of loopST" (return [Right 0]) else loop rest <- cont return (msg : rest) loop
main :: IO () main = do let log = execWriter (loop 100) print (head log) print (last log) let log' = runIdentity (execWriterT (loop' 100)) print (head log') print (last log') let logI = runIdentity (loopI 100) print (head logI) print (last logI) let logMf = runIdentity (execWriterT (loopM 100)) logM = logMf [] print (head logM) print (last logM) let logst = runST (loopST 100) print (head logst) print (last logst) let logst2 = runST (loopST2 100) print (head logst2) print (last logst2)
Edited output is $ ./maindemo "loop now 100" end of loop "loop now 1" end of loop' "loop' now 100" "loop' now 1" 100 end of loopI 0 end of loopM "loopM now 100" "loopM now 1" Left "loopST now 100" end of loopST Right 0 Left "loopST now 100" end of loopST Right 0 From the above the WriterT in loop' and loopM are not lazy but the other examples are.