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