After a chat with Einar on #haskell I realized that I would have,
say, 4k expiring timers and maybe 12k timers that are started and
then killed. That would make a 16k element map on which 3/4 of the
operations are O(n=16k) (Einar).
I need a better abstraction I guess. I also need to be able to find
timers by id instead of by name like now since each bot will use the
same timer name for the same operation. I should have starTimer
return X and then kill the timer using the same X.
I'm looking for suggestions. Here's the improved code:
---
{-# OPTIONS_GHC -fglasgow-exts -fno-cse #-}
module Timer
(
startTimer,
stopTimer
)
where
import qualified Data.Map as M
import System.Time
import System.IO.Unsafe
import Control.Exception
import Control.Concurrent
--- Map timer name and kick-off time to action
type Timers = M.Map (ClockTime, String) (IO ())
timeout :: Int
timeout = 5000000 -- 1 second
{-# NOINLINE timers #-}
timers :: MVar Timers
timers = unsafePerformIO $ do mv <- newMVar M.empty
forkIO $ checkTimers
return mv
--- Not sure if this is the most efficient way to do it
startTimer :: String -> Int -> (IO ()) -> IO ()
startTimer name delay io =
do stopTimer name
now <- getClockTime
let plus = TimeDiff 0 0 0 0 0 delay 0
future = addToClockTime plus now
block $ do t <- takeMVar timers
putMVar timers $ M.insert (future, name) io t
--- The filter expression is kind of long...
stopTimer :: String -> IO ()
stopTimer name =
block $ do t <- takeMVar timers
putMVar timers $
M.filterWithKey (\(_, k) _ -> k /= name) t
--- Now runs unblocked
checkTimers :: IO ()
checkTimers =
do t <- readMVar timers -- takes it and puts it back
case M.size t of
-- no timers
0 -> threadDelay timeout
-- some timers
_ -> do let (key@(time, _), io) = M.findMin t
now <- getClockTime
if (time <= now)
then do modifyMVar_ timers $ \a ->
return $! M.delete key a
try $ io -- don't think we care
return ()
else threadDelay timeout
checkTimers
--
http://wagerlabs.com/
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
