Here's the latest and greatest version put together with Einar's help. The seconds portion of ClockTime and a counter are used as the key now and the counter wraps around. This would make two distinct timers even if there expiration times were the same. {-# OPTIONS_GHC -fglasgow-exts -fno-cse #-} module Timer ( startTimer, stopTimer ) where import qualified Data.Map as M import Data.IORef import System.Time import System.IO.Unsafe import Control.Exception import Control.Concurrent type Timers = M.Map (Integer, Int) (IO ()) timeout :: Int timeout = 5000000 -- 1 second {-# NOINLINE timers #-} {-# NOINLINE counter #-} timers :: MVar Timers counter :: IORef Int (timers, counter) = unsafePerformIO $ do mv <- newMVar M.empty c <- newIORef 0 forkIO $ checkTimers return (mv, c) startTimer :: Integer -> (IO ()) -> IO (Integer, Int) startTimer seconds io = do TOD now _ <- getClockTime let expiration = now + seconds id <- atomicModifyIORef counter $ \x -> (x + 1, x) modifyMVar_ timers $ \a -> return $! M.insert (expiration, id) io a return (expiration, id) stopTimer :: (Integer, Int) -> IO () stopTimer key = modifyMVar_ timers $ \a -> return $! M.delete key a 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 TOD now _ <- getClockTime if (time <= now) then do stopTimer key try $ io -- don't think we care return () else threadDelay timeout checkTimers -- http://wagerlabs.com/