Fixed a rounding error in threadDelay

diff --git a/System/Event/Manager.hs b/System/Event/Manager.hs
index dfa99f5..a4579f6 100644 (file)
--- a/System/Event/Manager.hs
+++ b/System/Event/Manager.hs
@@ -344,14 +344,14 @@ fdWasClosed mgr fd =
 ------------------------------------------------------------------------
 -- Registering interest in timeout events
 
--- | Register a timeout in the given number of milliseconds.
+-- | Register a timeout in the given number of microseconds.
 registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey
-registerTimeout mgr ms cb = do
+registerTimeout mgr us cb = do
   !key <- newUnique (emUniqueSource mgr)
-  if ms <= 0 then cb
+  if us <= 0 then cb
     else do
       now <- getCurrentTime
-      let expTime = fromIntegral ms / 1000.0 + now
+      let expTime = fromIntegral us / 1000000.0 + now
 
       -- We intentionally do not evaluate the modified map to WHNF here.
       -- Instead, we leave a thunk inside the IORef and defer its
@@ -370,9 +370,9 @@ unregisterTimeout mgr (TK key) = do
   wakeManager mgr
 
 updateTimeout :: EventManager -> TimeoutKey -> Int -> IO ()
-updateTimeout mgr (TK key) ms = do
+updateTimeout mgr (TK key) us = do
   now <- getCurrentTime
-  let expTime = fromIntegral ms / 1000.0 + now
+  let expTime = fromIntegral us / 1000000.0 + now
 
   atomicModifyIORef (emTimeouts mgr) $ \f ->
       let f' = (Q.adjust (const expTime) key) . f in (f', ())

diff --git a/System/Event/Thread.hs b/System/Event/Thread.hs
index 342c914..ae3a71a 100644 (file)
--- a/System/Event/Thread.hs
+++ b/System/Event/Thread.hs
@@ -17,8 +17,6 @@ import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
                       labelThread, modifyMVar_, newTVar, sharedCAF,
                       threadStatus, writeTVar)
 import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
-import GHC.Num (fromInteger)
-import GHC.Real (div)
 import System.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
                              new, registerFd, unregisterFd_, registerTimeout)
 import System.IO.Unsafe (unsafePerformIO)
@@ -34,7 +32,7 @@ threadDelay :: Int -> IO ()
 threadDelay usecs = do
   Just mgr <- readIORef eventManager
   m <- newEmptyMVar
-  _ <- registerTimeout mgr (usecs `div` 1000) (putMVar m ())
+  _ <- registerTimeout mgr usecs (putMVar m ())
   takeMVar m
 
 -- | Set the value of returned TVar to True after a given number of
@@ -44,7 +42,7 @@ registerDelay :: Int -> IO (TVar Bool)
 registerDelay usecs = do
   t <- atomically $ newTVar False
   Just mgr <- readIORef eventManager
-  _ <- registerTimeout mgr (usecs `div` 1000) . atomically $ writeTVar t True
+  _ <- registerTimeout mgr usecs . atomically $ writeTVar t True
   return t
 
 -- | Block the current thread until data is available to read from the