@@ -1,4 +1,5 @@
11{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE BangPatterns #-}
23
34-- | This module provides the ability to create reapers: dedicated cleanup
45-- threads. These threads will automatically spawn and die based on the
@@ -133,10 +134,10 @@ add settings@ReaperSettings{..} stateRef item =
133134 next <- atomicModifyIORef' stateRef cons
134135 next
135136 where
136− cons NoReaper = (Workload $ reaperCons item reaperEmpty
137− ,spawn settings stateRef)
138− cons (Workload wl) = (Workload $ reaperCons item wl
139− ,return ())
137+ cons NoReaper = let !wl = reaperCons item reaperEmpty
138+ in (Workload wl, spawn settings stateRef)
139+ cons (Workload wl) = let wl' = reaperCons item wl
140+ in (Workload wl', return ())
140141
141142spawn :: ReaperSettings workload item -> IORef (State workload) -> IO ()
142143spawn settings stateRef = void . forkIO $ reaper settings stateRef
@@ -148,7 +149,7 @@ reaper settings@ReaperSettings{..} stateRef = do
148149 wl <- atomicModifyIORef' stateRef swapWithEmpty
149150 -- Do the jobs. A function to merge the left jobs and
150151 -- new jobs is returned.
151− merge <- reaperAction wl
152+ !merge <- reaperAction wl
152153 -- Merging the left jobs and new jobs.
153154 -- If there is no jobs, this thread finishes.
154155 next <- atomicModifyIORef' stateRef (check merge)
@@ -178,8 +179,8 @@ mkListAction :: (item -> IO (Maybe item'))
178179mkListAction f =
179180 go id
180181 where
181− go front [] = return front
182− go front (x:xs) = do
182+ go !front [] = return front
183+ go !front (x:xs) = do
183184 my <- f x
184185 let front' =
185186 case my of