on master help sign in
Remove the parent pointer from EventF
commit3744363427ec5c3b5adecc051914d1b8bc1282df authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 8 Jun 2017, 01:23 (9 years ago) parent45e8204
3 files changed+17−18
src/Duct/AsyncT.hs+3−3 src/Duct/Event.hs+7−8 src/Duct/Threads.hs+7−7
src/Duct/AsyncT.hs+3−3
@@ -362,14 +362,14 @@ waitForChildren chan pendingRef = do
362362-- | Run a transient computation with a default initial state
363363runTransient :: forall m a. MonadIO m => AsyncT m a -> m (Maybe a, EventF)
364364runTransient t = do
365− zombieChan <- liftIO $ atomically newTChan
365+ childChan <- liftIO $ atomically newTChan
366366 pendingRef <- liftIO $ newIORef []
367367 credit <- liftIO $ newIORef maxBound
368368
369369 r <- runStateT (runAsyncT t) $ initEventF
370− (empty :: AsyncT m a) zombieChan pendingRef credit
370+ (empty :: AsyncT m a) childChan pendingRef credit
371371
372− waitForChildren zombieChan pendingRef
372+ waitForChildren childChan pendingRef
373373 return r
374374
375375-- | Run an 'AsyncT m' computation. Returns the result of the computation or
src/Duct/Event.hs+7−8
@@ -41,9 +41,8 @@ data EventF = forall m a b. EventF
4141
4242 , mfSequence :: Int
4343
44− , parent :: Maybe EventF -- We need the channel of the parent, but do we
45− -- need the parent itself?
46− -- ^ The parent of this thread
44+ , parentChannel :: Maybe (TChan ThreadId)
45+ -- ^ Our parent thread's channel to communicate to when we die
4746
4847 -- Thread creation and cleanup handling. When a new thread is created the
4948 -- parent records it in the 'children' field and 'threadCredit' is
@@ -55,8 +54,8 @@ data EventF = forall m a b. EventF
5554 -- parent thread waits on the channel until all its children are cleaned
5655 -- up.
5756
58− , zombieChannel :: TChan ThreadId
59− -- ^ A channel for the immediate children to communicate to when they die.
57+ , childChannel :: TChan ThreadId
58+ -- ^ A channel for the immediate children to communicate to us when they die.
6059 -- Each thread has its own dedicated channel for its children
6160
6261 -- We always track the child threads, otherwise the programmer needs to
@@ -90,14 +89,14 @@ initEventF
9089 -> IORef [ThreadId]
9190 -> IORef Int
9291 -> EventF
93−initEventF x zombieChan pending credit =
92+initEventF x childChan pending credit =
9493 EventF { event = mempty
9594 , xcomp = x
9695 , fcomp = []
9796 , mfData = mempty
9897 , mfSequence = 0
99− , parent = Nothing
100− , zombieChannel = zombieChan
98+ , parentChannel = Nothing
99+ , childChannel = childChan
101100 , pendingThreads = pending
102101 , threadCredit = credit }
103102
src/Duct/Threads.hs+7−7
@@ -129,16 +129,16 @@ forkIt current proc = do
129129 -- update the new thread before reclaiming zombies so that if it exited
130130 -- already reclaim finds it in the list and does not panic.
131131 liftIO $ modifyIORef (pendingThreads cur) $ (\ts -> tid:ts)
132− tryReclaimZombies (zombieChannel cur) (pendingThreads cur)
132+ tryReclaimZombies (childChannel cur) (pendingThreads cur)
133133
134134 newChildCont cur = do
135135 pendingRef <- liftIO $ newIORef []
136136 chan <- liftIO $ atomically newTChan
137137 -- shares the threadCredit of the parent by default
138138 return $ cur
139− { parent = Just cur
139+ { parentChannel = Just (childChannel cur)
140140 , pendingThreads = pendingRef
141− , zombieChannel = chan
141+ , childChannel = chan
142142 }
143143
144144 beforeExit cur res = do
@@ -148,13 +148,13 @@ forkIt current proc = do
148148 Right _ -> -- collect the results?
149149 return ()
150150
151− waitForChildren (zombieChannel cur) (pendingThreads cur)
151+ waitForChildren (childChannel cur) (pendingThreads cur)
152152 signalQSemB (threadCredit cur)
153153 -- We are guaranteed to have a parent because we have been explicitly
154154 -- forked by some parent.
155− let p = fromJust (parent cur)
155+ let p = fromJust (parentChannel cur)
156156 tid <- myThreadId
157− liftIO $ atomically $ writeTChan (zombieChannel p) tid
157+ liftIO $ atomically $ writeTChan p tid
158158
159159forkMaybe :: (MonadBaseControl IO m, MonadIO m) => EventF -> (EventF -> m ()) -> m ()
160160forkMaybe current toRun = do
@@ -169,7 +169,7 @@ forkMaybe current toRun = do
169169 -- special handling for those cases. Add those to
170170 -- unreclaimable list? And always execute them in an
171171 -- async thread, cannot use sync for those.
172− waitForOneChild (zombieChannel current)
172+ waitForOneChild (childChannel current)
173173 (pendingThreads current)
174174 forkMaybe current toRun
175175 True -> forkIt current toRun