rename variable

This commit is contained in:
Harendra Kumar 2017-09-03 16:25:28 +05:30
parent a0d9419533
commit 3946e8f062

View File

@ -97,7 +97,7 @@ data ChildEvent a =
-- exceptions or using atomicModify -- exceptions or using atomicModify
data Context m a = data Context m a =
Context { outputQueue :: IORef [ChildEvent a] Context { outputQueue :: IORef [ChildEvent a]
, synchOutQ :: MVar Bool -- wakeup mechanism for outQ , doorBell :: MVar Bool -- wakeup mechanism for outQ
, enqueue :: AsyncT m a -> IO () , enqueue :: AsyncT m a -> IO ()
, runqueue :: m () , runqueue :: m ()
, runningThreads :: IORef (Set ThreadId) , runningThreads :: IORef (Set ThreadId)
@ -219,7 +219,7 @@ send ctx msg = liftIO $ do
atomicModifyIORefCAS_ (outputQueue ctx) $ \es -> msg : es atomicModifyIORefCAS_ (outputQueue ctx) $ \es -> msg : es
-- XXX need a memory barrier? The wake up must happen only after the -- XXX need a memory barrier? The wake up must happen only after the
-- store has finished otherwise we can have lost wakeup problems. -- store has finished otherwise we can have lost wakeup problems.
void $ tryPutMVar (synchOutQ ctx) True void $ tryPutMVar (doorBell ctx) True
{-# INLINE sendStop #-} {-# INLINE sendStop #-}
sendStop :: MonadIO m => Context m a -> m () sendStop :: MonadIO m => Context m a -> m ()
@ -319,13 +319,13 @@ sendWorkerWait ctx = do
-- sending a worker in a loop running into a livelock -- sending a worker in a loop running into a livelock
done <- queueEmpty ctx done <- queueEmpty ctx
when (not done) (pushWorker ctx) when (not done) (pushWorker ctx)
void $ liftIO $ takeMVar (synchOutQ ctx) void $ liftIO $ takeMVar (doorBell ctx)
-- Note: This is performance sensitive code. -- Note: This is performance sensitive code.
{-# NOINLINE pullWorker #-} {-# NOINLINE pullWorker #-}
pullWorker :: MonadAsync m => Context m a -> AsyncT m a pullWorker :: MonadAsync m => Context m a -> AsyncT m a
pullWorker ctx = AsyncT $ \pctx stp yld -> do pullWorker ctx = AsyncT $ \pctx stp yld -> do
res <- liftIO $ tryTakeMVar (synchOutQ ctx) res <- liftIO $ tryTakeMVar (doorBell ctx)
when (isNothing res) $ sendWorkerWait ctx when (isNothing res) $ sendWorkerWait ctx
list <- liftIO $ atomicModifyIORefCAS (outputQueue ctx) $ \x -> ([], x) list <- liftIO $ atomicModifyIORefCAS (outputQueue ctx) $ \x -> ([], x)
(runAsyncT $ processEvents list) pctx stp yld (runAsyncT $ processEvents list) pctx stp yld
@ -377,7 +377,7 @@ pullFork m1 m2 fifo = AsyncT $ \_ stp yld -> do
pushL q m1 >> pushL q m2 pushL q m1 >> pushL q m2
let ctx = let ctx =
Context { outputQueue = outQ Context { outputQueue = outQ
, synchOutQ = outQMv , doorBell = outQMv
, runningThreads = running , runningThreads = running
, runqueue = runqueueFIFO ctx q , runqueue = runqueueFIFO ctx q
, enqueue = pushL q , enqueue = pushL q
@ -390,7 +390,7 @@ pullFork m1 m2 fifo = AsyncT $ \_ stp yld -> do
let checkEmpty = liftIO (readIORef q) >>= return . null let checkEmpty = liftIO (readIORef q) >>= return . null
let ctx = let ctx =
Context { outputQueue = outQ Context { outputQueue = outQ
, synchOutQ = outQMv , doorBell = outQMv
, runningThreads = running , runningThreads = running
, runqueue = runqueueLIFO ctx q , runqueue = runqueueLIFO ctx q
, enqueue = enqueueLIFO q , enqueue = enqueueLIFO q