Enable -Wall and fix all warnings

This commit is contained in:
Michael Walker 2014-12-21 16:34:55 +00:00
parent 7819a3c7b0
commit 554fa84ec7
5 changed files with 38 additions and 40 deletions

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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 '-'

View File

@ -29,4 +29,5 @@ library
, random
, transformers
-- hs-source-dirs:
default-language: Haskell2010
default-language: Haskell2010
ghc-options: -Wall