diff --git a/Control/Monad/Conc/CVar.hs b/Control/Monad/Conc/CVar.hs index c8dbe9a..b61dc4f 100644 --- a/Control/Monad/Conc/CVar.hs +++ b/Control/Monad/Conc/CVar.hs @@ -23,7 +23,7 @@ module Control.Monad.Conc.CVar , unlock ) where -import Control.Monad (liftM, void) +import Control.Monad (liftM) import Control.Monad.Conc.Class -- | Create a new @CVar@ containing a value. diff --git a/Control/Monad/Conc/Class.hs b/Control/Monad/Conc/Class.hs index 2c2ea2f..f91822d 100755 --- a/Control/Monad/Conc/Class.hs +++ b/Control/Monad/Conc/Class.hs @@ -15,7 +15,6 @@ module Control.Monad.Conc.Class where import Control.Concurrent (forkIO) import Control.Concurrent.MVar (MVar, readMVar, newEmptyMVar, putMVar, tryPutMVar, takeMVar, tryTakeMVar) import Control.Monad (void) -import Data.Maybe (maybe) -- | @ConcFuture@ is the monad-conc alternative of 'ParFuture'. It -- abstracts Conc monads which support futures. In itself, this is not diff --git a/Control/Monad/Conc/Fixed.hs b/Control/Monad/Conc/Fixed.hs index 8691ff8..81a5b66 100755 --- a/Control/Monad/Conc/Fixed.hs +++ b/Control/Monad/Conc/Fixed.hs @@ -35,8 +35,8 @@ import Control.Applicative (Applicative(..), (<$>)) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar) import Control.Monad.Cont (Cont, cont, runCont) import Data.Map (Map) -import Data.Maybe (fromJust, fromMaybe, isNothing, isJust) -import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef') +import Data.Maybe (fromJust, isNothing) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.Random (RandomGen, randomR) import qualified Control.Monad.Conc.Class as C @@ -197,9 +197,9 @@ randomSchedNP = makeNP randomSched -- | A round-robin scheduler which, at every step, schedules the -- thread with the next 'ThreadId'. roundRobinSched :: Scheduler () -roundRobinSched _ last threads - | last >= maximum threads = (minimum threads, ()) - | otherwise = (minimum $ filter (>last) threads, ()) +roundRobinSched _ prior threads + | prior >= maximum threads = (minimum threads, ()) + | otherwise = (minimum $ filter (>prior) threads, ()) -- | A round-robin scheduler which doesn't pre-empt the running -- thread. @@ -210,9 +210,9 @@ roundRobinSchedNP = makeNP roundRobinSched -- one. makeNP :: Scheduler s -> Scheduler s makeNP sched = newsched where - newsched s last threads - | last `elem` threads = (last, s) - | otherwise = sched s last threads + newsched s prior threads + | prior `elem` threads = (prior, s) + | otherwise = sched s prior threads -------------------- Internal stuff -------------------- @@ -224,7 +224,7 @@ data Block = WaitFull ThreadId | WaitEmpty ThreadId deriving Eq -- -- A thread is represented as a tuple of (next action, is blocked). runThreads :: ThreadId -> Scheduler s -> s -> Map ThreadId (Action, Bool) -> MVar (Maybe a) -> IO s -runThreads last sched s threads mvar +runThreads prior sched s threads mvar | isTerminated = return s | isDeadlocked = putMVar mvar Nothing >> return s | isBlocked = putStrLn "Attempted to run a blocked thread, assuming deadlock." >> putMVar mvar Nothing >> return s @@ -234,7 +234,7 @@ runThreads last sched s threads mvar runThreads chosen sched s' threads' mvar where - (chosen, s') = if last == -1 then (0, s) else sched s last $ M.keys runnable + (chosen, s') = if prior == -1 then (0, s) else sched s prior $ M.keys runnable runnable = M.filter (not . snd) threads thread = M.lookup chosen threads isBlocked = snd . fromJust $ M.lookup chosen threads @@ -313,13 +313,13 @@ kill = M.delete -- | Wake every thread blocked on a 'CVar' read. wake :: Ord k => CVar t v -> (k -> Block) -> Map k (a, Bool) -> IO (Map k (a, Bool)) -wake (V ref) typ = fmap M.fromList . mapM wake . M.toList where - wake a@(tid, (act, True)) = do - let block = typ tid +wake (V ref) typ = fmap M.fromList . mapM wake' . M.toList where + wake' a@(tid, (act, True)) = do + let blck = typ tid (val, blocks) <- readIORef ref - if block `elem` blocks - then writeIORef ref (val, filter (/= block) blocks) >> return (tid, (act, False)) + if blck `elem` blocks + then writeIORef ref (val, filter (/= blck) blocks) >> return (tid, (act, False)) else return a - wake a = return a + wake' a = return a diff --git a/Control/Monad/Conc/SCT.hs b/Control/Monad/Conc/SCT.hs index c83a2b3..e81d32e 100644 --- a/Control/Monad/Conc/SCT.hs +++ b/Control/Monad/Conc/SCT.hs @@ -48,7 +48,7 @@ module Control.Monad.Conc.SCT ) where import Control.Monad.Conc.Fixed -import System.Random (RandomGen, randomR) +import System.Random (RandomGen) -- | An @SCTScheduler@ is like a regular 'Scheduler', except it builds -- a trace of scheduling decisions made. @@ -80,12 +80,11 @@ data Decision = -- so it is important that the scheduler actually maintain some -- internal state, or all the results will be identical. runSCT :: SCTScheduler s -> s -> Int -> (forall t. Conc t a) -> IO [(Maybe a, Trace)] -runSCT sched s runs c = runSCT' s runs where - runSCT' _ 0 = return [] - runSCT' s n = do - (res, (s', log)) <- runConc' sched (s, [(Start 0, [])]) c - rest <- runSCT' s' $ n - 1 - return $ (res, log) : rest +runSCT _ _ 0 _ = return [] +runSCT sched s n c = do + (res, (s', trace)) <- runConc' sched (s, [(Start 0, [])]) c + rest <- runSCT sched s' (n - 1) c + return $ (res, trace) : rest -- | A simple pre-emptive random scheduler. sctRandom :: RandomGen g => SCTScheduler g @@ -98,24 +97,23 @@ sctRandomNP = toSCT randomSchedNP -- | Convert a 'Scheduler' to an 'SCTScheduler' by recording the -- trace. toSCT :: Scheduler s -> SCTScheduler s -toSCT sched (s, log) last threads = (tid, (s', log ++ [(decision, alters)])) where - (tid, s') = sched s last threads +toSCT sched (s, trace) prior threads = (tid, (s', trace ++ [(decision, alters)])) where + (tid, s') = sched s prior threads - decision | tid == last = Continue - | last `elem` threads = SwitchTo tid - | otherwise = Start tid + decision | tid == prior = Continue + | prior `elem` threads = SwitchTo tid + | otherwise = Start tid - alters | tid == last = map SwitchTo $ filter (/=last) threads - | last `elem` threads = Continue : map SwitchTo (filter (\t -> t /= last && t /= tid) threads) - | otherwise = map Start $ filter (/=tid) threads + alters | tid == prior = map SwitchTo $ filter (/=prior) threads + | prior `elem` threads = Continue : map SwitchTo (filter (\t -> t /= prior && t /= tid) threads) + | otherwise = map Start $ filter (/=tid) threads -- | Pretty-print a scheduler trace. showTrace :: Trace -> String showTrace = trace "" 0 . map fst where - trace log num (Start tid:ds) = thread log num ++ trace ("S" ++ show tid) 1 ds - trace log num (Continue:ds) = trace log (num + 1) ds - trace log num (SwitchTo tid:ds) = thread log num ++ trace ("P" ++ show tid) 1 ds - trace log num [] = thread log num + trace prefix num (Start tid:ds) = thread prefix num ++ trace ("S" ++ show tid) 1 ds + trace prefix num (SwitchTo tid:ds) = thread prefix num ++ trace ("P" ++ show tid) 1 ds + trace prefix num (Continue:ds) = trace prefix (num + 1) ds + trace prefix num [] = thread prefix num - thread "" _ = "" - thread log num = log ++ replicate num '-' + thread prefix num = prefix ++ replicate num '-' diff --git a/monad-conc.cabal b/monad-conc.cabal index c708335..4f1f051 100755 --- a/monad-conc.cabal +++ b/monad-conc.cabal @@ -29,4 +29,5 @@ library , random , transformers -- hs-source-dirs: - default-language: Haskell2010 \ No newline at end of file + default-language: Haskell2010 + ghc-options: -Wall \ No newline at end of file